Hidden Surface Removal

                    嬪様様様様様様様様様様様様様様様
                             W E L C O M E         
                      To the VGA Trainer Program    
                                  By                
                          DENTHOR of ASPHYXIA        
                    塒様様様様様様様様様様様様様様様  
                      陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳 
                        陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳

                            --==[ PART 20 ]==--

 =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  Introduction

 Hi all! It has been a _long_ time since my last trainer (as I am sure many
 of you have noticed) A lot has happened between now and the last trainer...
 but for once I won't bore you with the details ;) I do have a full time job
 though, coding C++ applications.

 I have taken over the production of the PCGPE from Mark Feldman. He is
 mailing all the articles written so far, and as soon as I get them I will
 get to work on releasing the PCGPE II. Mark is working on the Windows GPE.

 This trainer is on 3d hidden face removal and face sorting. I was going to
 add shading, but that can wait until a later trainer. For conveniance I
 will build on the 3d code from tut 16(?). The maths for face removal is a
 bit tricky, but just think back to your old High School trig classes.

 I have noticed that in my absence, one or two people have started their own
 trainer series. Read Hornet DemoNews for a great column by Trixter covering
 some of the more tricky demo effects.

 Well, on with the trainer!

 If you would like to contact me, or the team, there are many ways you
 can do it : 1) Write a message to Grant Smith/Denthor/Asphyxia in private mail
                   on the ASPHYXIA BBS.
             2) Write to :  Grant Smith
                            P.O.Box 270 Kloof
                            3640
                            Natal
                            South Africa
             3) Call me (Grant Smith) at (031) 73 2129 (leave a message if you
                   call during varsity). Call +27-31-73-2129 if you call
                   from outside South Africa. (It's YOUR phone bill ;-))
             4) Write to denthor@beastie.cs.und.ac.za in E-Mail.
             5) Write to asphyxia@beastie.cs.und.ac.za to get to all of
                us at once.

 NB : If you are a representative of a company or BBS, and want ASPHYXIA
        to do you a demo, leave mail to me; we can discuss it.
 NNB : If you have done/attempted a demo, SEND IT TO ME! We are feeling
         quite lonely and want to meet/help out/exchange code with other demo
         groups. What do you have to lose? Leave a message here and we can work
         out how to transfer it. We really want to hear from you!

 http://goth.vironix.co.za/~denthor                     (WWW)
 ftp.eng.ufl.edu pub/msdos/demos/code/graph/tutor       (FTP)

 =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
   Face Sorting

 There are many ways to sort faces in a 3d object. For now, I will show you
 just about the easiest one of the lot.

 Say you have to polygons....

                 ------P1

            ------------------P2

                    Eye

 As you can see, P1 has to be drawn before P2. The easiest way to do this is
 as follows:

 On startup, find the mid point of each of the polys, through the easy
 equations,
         x = (P2.1.x + P2.2.x + P2.3.x + p2.4.x)/4
         y = (P2.1.y + P2.2.y + P2.3.y + p2.4.y)/4
         z = (P2.1.z + P2.2.z + P2.3.z + p2.4.z)/4

 NOTE : For a triangle you would obviously only use three points and divide
 by three.

 Anyway, now you have the X,Y,Z of the midpoint of the polygon. You can then
 rotate this point with the others. When it comes time to draw, you can
 compare the resulting Z of the midpoint, sort all of the Z items, and then
 draw them from back to front.

 In the sample program I use a simple bubble sort... basically, I check the
 first two values against each other, and swap them if the first is bigger
 then the second. I continue doing this to all the numbers until I run
 through the entire list without swapping once. Bubble sorts are standard
 seven computer science topics... perhaps borrow a text book to find out
 more about them and other (better) sorting methods.

 The above isn't perfect, but it should work 90% of the time. But it still
 means that when you are drawing a cube, you have to draw all 6 sides every
 frame, even though only three or so are visible. That is where hidden face
 removal comes in...

 =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
   Hidden Face Removal

 Pick up something square. A stiffy disk will do fine. Face it towards you,
 and number all the corners from one to four in a clockwise direction.

                 1 +-------------+ 2
                   |             |
                   |             |
                   |             |
                   |             |
                 4 +-------------+ 3

 Now rotate the stiffy disk on all three axese, making sure that you can
 still see the front of the disk. You will notice that whenever you can see
 the front of the disk, the four points are still in alphabetical order. Now
 rotate it so that you can see the back of the stiffy. Your points will now
 be :

                 2 +-------------+ 1
                   |             |
                   |             |
                   |             |
                   |             |
                 3 +-------------+ 4

 The points are now anti-clockwise! This means, in it's simplest form, that
 if you define all your poygon points in a clockwise order, when drawing you
 ignore the polys that are anticlockwise. (Obviously when you define the 3d
 object, you define the polygons facing away from you in an anticlockwise
 order)

 To find out weather a poly's points are clockwise or not, we need to find
 it's normal. Here is where things start getting fun.

 In school, you are told that a normal is perpendicular to the plane. In
 ascii :
                       | Normal
                       |
                       |
         --------------------------- Polygon

 As you can see, the normal is at 90 degrees to the surface of the poly. We
 must extend this to three dimensions for our polygons. You'll have to trust
 me on that, I can't draw it in ascii :)

 To find a normal, you only need three points from your poly (ABC) :
 A(x0,y0,z0), B(X1,Y1,Z1), C(X2,Y2,Z2)

 then the vector normal = AB^AC = (Xn,Yn,Zn) with
         Xn=(y1-y0)(z0-z2)-(z1-z0)(y0-y2)
         Yn=(z1-z0)(x0-x2)-(x1-x0)(z0-z2)
         Zn=(x1-x0)(y0-y2)-(y1-y0)(x0-x2)

 We are interested in the Z normal, so we will use the function :
   normal:=(x1-x0)(y0-y2)-(y1-y0)(x0-x2);

 The result is something of a sine wave when you rotate the poly in three
 dimensions. A negative value means that the poly is facing you, a posotive
 value means that it is pointing away.

 The above means that with a mere two muls you can discount an entire poly
 and not draw it. This method is perfect for "closed" objects such as cubes
 etc.

 I am anything but a maths teacher, so go borrow someones math book to find
 out more about surface normals. Trust me, there is a lot more written about
 them then you think.

 An extension of calculating your normal is finding out about light-sourcing
 your polygons. Watch for more information in one of the next few tutors.

 A combination of the above two routines should work quite nicely in
 creating 3d objects with little or no overlapping. The example file will
 show you the two methods and how well they work.

 =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
   In closing

 As you can see, the above was quite easy. I have a few ideas for tut 21, so
 keep watch for it. Also keep an eye open for PCGPE ][ (but don't mail me
 asking when it's due! I already get too many of those! ;-)

 My sister got married a few days ago. The worst part was that I was forced
 to cut my hair. My hair was quite long (slightly longer then when the pic
 on my web page was taken), and it is all quite depressing. Anyway, the
 wedding was great, so it wasn't all for nothing.

 I hope to get tut 21 and possibly 22 out before christmas, but I will be on
 holiday from the 18th. I will be in Cape Town sometime after christmas day
 for a week or two, so if you're there I'll meet you on the cable car :-)

 I wrote a quote for this tut, but I have decided I didn't like it. I'll try
 do better for tut 21 ;)

 Byeeeee.....
   - Denthor
       14-12-95

 PS. I seem to have lost my list of distribution sites... could you all
 re-mail me your details? Thanks.
 Unit GFX3;

 INTERFACE

 USES crt;
 CONST VGA = $A000;

 TYPE Virtual = Array [1..64000] of byte;  { The size of our Virtual Screen }
      VirtPtr = ^Virtual;                  { Pointer to the virtual screen }

 VAR Virscr : VirtPtr;                     { Our first Virtual screen }
     Vaddr  : word;                        { The segment of our virtual screen}
     Scr_Ofs : Array[0..199] of Word;

 Procedure SetMCGA;
    { This procedure gets you into 320x200x256 mode. }
 Procedure SetText;
    { This procedure returns you to text mode.  }
 Procedure Cls (Where:word;Col : Byte);
    { This clears the screen to the specified color }
 Procedure SetUpVirtual;
    { This sets up the memory needed for the virtual screen }
 Procedure ShutDown;
    { This frees the memory used by the virtual screen }
 procedure flip(source,dest:Word);
    { This copies the entire screen at "source" to destination }
 Procedure Pal(Col,R,G,B : Byte);
    { This sets the Red, Green and Blue values of a certain color }
 Procedure GetPal(Col : Byte; Var R,G,B : Byte);
   { This gets the Red, Green and Blue values of a certain color }
 procedure WaitRetrace;
    {  This waits for a vertical retrace to reduce snow on the screen }
 Procedure Hline (x1,x2,y:word;col:byte;where:word);
    { This draws a horizontal line from x1 to x2 on line y in color col }
 Procedure Line(a,b,c,d:integer;col:byte;where:word);
   { This draws a solid line from a,b to c,d in colour col }
 Procedure DrawPoly(x1,y1,x2,y2,x3,y3,x4,y4:integer;color:byte;where:word);
    { This draw a polygon with 4 points at x1,y1 , x2,y2 , x3,y3 , x4,y4
      in color col }
 Function rad (theta : real) : real;
    {  This calculates the degrees of an angle }
 Procedure Putpixel (X,Y : Integer; Col : Byte; where:word);
    { This puts a pixel on the screen by writing directly to memory. }
 Function Getpixel (X,Y : Integer; where:word) :Byte;
    { This gets the pixel on the screen by reading directly to memory. }
 Procedure LoadCEL (FileName :  string; ScrPtr : pointer);
   { This loads the cel 'filename' into the pointer scrptr }
 Procedure LoadPal (FileName : string);
   { This loads in an Autodesk Animator V1 pallette file }

 IMPLEMENTATION

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 Procedure SetMCGA;  { This procedure gets you into 320x200x256 mode. }
 BEGIN
   asm
      mov        ax,0013h
      int        10h
   end;
 END;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 Procedure SetText;  { This procedure returns you to text mode.  }
 BEGIN
   asm
      mov        ax,0003h
      int        10h
   end;
 END;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 Procedure Cls (Where:word;Col : Byte); assembler;
    { This clears the screen to the specified color }
 asm
    push    es
    mov     cx, 32000;
    mov     es,[where]
    xor     di,di
    mov     al,[col]
    mov     ah,al
    rep     stosw
    pop     es
 End;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 Procedure SetUpVirtual;
    { This sets up the memory needed for the virtual screen }
 BEGIN
   GetMem (VirScr,64000);
   vaddr := seg (virscr^);
 END;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 Procedure ShutDown;
    { This frees the memory used by the virtual screen }
 BEGIN
   FreeMem (VirScr,64000);
 END;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 procedure flip(source,dest:Word); assembler;
   { This copies the entire screen at "source" to destination }
 asm
   push    ds
   mov     ax, [Dest]
   mov     es, ax
   mov     ax, [Source]
   mov     ds, ax
   xor     si, si
   xor     di, di
   mov     cx, 32000
   rep     movsw
   pop     ds
 end;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 Procedure Pal(Col,R,G,B : Byte); assembler;
   { This sets the Red, Green and Blue values of a certain color }
 asm
    mov    dx,3c8h
    mov    al,[col]
    out    dx,al
    inc    dx
    mov    al,[r]
    out    dx,al
    mov    al,[g]
    out    dx,al
    mov    al,[b]
    out    dx,al
 end;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 Procedure GetPal(Col : Byte; Var R,G,B : Byte);
   { This gets the Red, Green and Blue values of a certain color }
 Var
    rr,gg,bb : Byte;
 Begin
    asm
       mov    dx,3c7h
       mov    al,col
       out    dx,al

       add    dx,2

       in     al,dx
       mov    [rr],al
       in     al,dx
       mov    [gg],al
       in     al,dx
       mov    [bb],al
    end;
    r := rr;
    g := gg;
    b := bb;
 end;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 procedure WaitRetrace; assembler;
   {  This waits for a vertical retrace to reduce snow on the screen }
 label
   l1, l2;
 asm
     mov dx,3DAh
 l1:
     in al,dx
     and al,08h
     jnz l1
 l2:
     in al,dx
     and al,08h
     jz  l2
 end;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 Procedure Hline (x1,x2,y:word;col:byte;where:word); assembler;
   { This draws a horizontal line from x1 to x2 on line y in color col }
 asm
   mov   ax,where
   mov   es,ax
   mov   ax,y
   mov   di,ax
   shl   ax,8
   shl   di,6
   add   di,ax
   add   di,x1

   mov   al,col
   mov   ah,al
   mov   cx,x2
   sub   cx,x1
   shr   cx,1
   jnc   @start
   stosb
 @Start :
   rep   stosw
 end;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 Procedure Line(a,b,c,d:integer;col:byte;where:word);
   { This draws a solid line from a,b to c,d in colour col }
   function sgn(a:real):integer;
   begin
        if a>0 then sgn:=+1;
        if a<0 then sgn:=-1;
        if a=0 then sgn:=0;
   end;
 var i,s,d1x,d1y,d2x,d2y,u,v,m,n:integer;
 begin
      u:= c - a;
      v:= d - b;
      d1x:= SGN(u);
      d1y:= SGN(v);
      d2x:= SGN(u);
      d2y:= 0;
      m:= ABS(u);
      n := ABS(v);
      IF NOT (M>N) then
      BEGIN
           d2x := 0 ;
           d2y := SGN(v);
           m := ABS(v);
           n := ABS(u);
      END;
      s := m shr 1;
      FOR i := 0 TO m DO
      BEGIN
           putpixel(a,b,col,where);
           s := s + n;
           IF not (smxy then mxy:=y2;
   if y3mxy then mxy:=y3;    { Choose the min y mny and max y mxy }
   if y4mxy then mxy:=y4;

   if mny<0 then mny:=0;
   if mxy>199 then mxy:=199;
   if mny>199 then exit;
   if mxy<0 then exit;        { Verticle range checking }

   mul1:=x1-x4; div1:=y1-y4;
   mul2:=x2-x1; div2:=y2-y1;
   mul3:=x3-x2; div3:=y3-y2;
   mul4:=x4-x3; div4:=y4-y3;  { Constansts needed for intersection calc }

   for yc:=mny to mxy do
     begin
       mnx:=320;
       mxx:=-1;
       if (y4>=yc) or (y1>=yc) then
         if (y4<=yc) or (y1<=yc) then   { Check that yc is between y1 and y4 }
           if not(y4=y1) then
             begin
               x:=(yc-y4)*mul1 div div1+x4; { Point of intersection on x axis }
               if xmxx then
                 mxx:=x;       { Set point as start or end of horiz line }
             end;
       if (y1>=yc) or (y2>=yc) then
         if (y1<=yc) or (y2<=yc) then   { Check that yc is between y1 and y2 }
           if not(y1=y2) then
             begin
               x:=(yc-y1)*mul2 div div2+x1; { Point of intersection on x axis }
               if xmxx then
                 mxx:=x;       { Set point as start or end of horiz line }
             end;
       if (y2>=yc) or (y3>=yc) then
         if (y2<=yc) or (y3<=yc) then   { Check that yc is between y2 and y3 }
           if not(y2=y3) then
             begin
               x:=(yc-y2)*mul3 div div3+x2; { Point of intersection on x axis }
               if xmxx then
                 mxx:=x;       { Set point as start or end of horiz line }
             end;
       if (y3>=yc) or (y4>=yc) then
         if (y3<=yc) or (y4<=yc) then   { Check that yc is between y3 and y4 }
           if not(y3=y4) then
             begin
               x:=(yc-y3)*mul4 div div4+x3; { Point of intersection on x axis }
               if xmxx then
                 mxx:=x;       { Set point as start or end of horiz line }
             end;
       if mnx<0 then
         mnx:=0;
       if mxx>319 then
         mxx:=319;          { Range checking on horizontal line }
       if mnx<=mxx then
         hline (mnx,mxx,yc,color,where);   { Draw the horizontal line }
     end;
   end;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 Function rad (theta : real) : real;
   {  This calculates the degrees of an angle }
 BEGIN
   rad := theta * pi / 180
 END;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 Procedure Putpixel (X,Y : Integer; Col : Byte; where:word); assembler;
   { This puts a pixel on the screen by writing directly to memory. }
 asm
    mov  ax,where
    mov  es,ax
    mov  bx,[y]
    shl  bx,1
    mov  di,word ptr [Scr_Ofs + bx]
    add  di,[x]
    mov  al,[col]
    mov  es:[di],al
 end;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 Function Getpixel (X,Y : Integer; where:word):byte; assembler;
   { This puts a pixel on the screen by writing directly to memory. }
 asm
    mov  ax,where
    mov  es,ax
    mov  bx,[y]
    shl  bx,1
    mov  di,word ptr [Scr_Ofs + bx]
    add  di,[x]
    mov  al,es:[di]
 end;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 Procedure LoadCEL (FileName :  string; ScrPtr : pointer);
   { This loads the cel 'filename' into the pointer scrptr }
 var
   Fil : file;
   Buf : array [1..1024] of byte;
   BlocksRead, Count : word;
 begin
   assign (Fil, FileName);
   reset (Fil, 1);
   BlockRead (Fil, Buf, 800);    { Read and ignore the 800 byte header }
   Count := 0;
   BlocksRead := $FFFF;
   while (not eof (Fil)) and (BlocksRead <> 0) do begin
     BlockRead (Fil, mem [seg (ScrPtr^): ofs (ScrPtr^) + Count], 1024, BlocksRead);
     Count := Count + 1024;
   end;
   close (Fil);
 end;

 procedure LoadPal (FileName : string);
 var
   F:file;
   loop1:integer;
   pall:array[0..255,1..3] of byte;
 begin
   assign (F, FileName);
   reset (F,1);
   blockread (F, pall,768);
   close (F);
   for loop1 := 0 to 255 do
     Pal(loop1,pall[loop1,1],pall[loop1,2],pall[loop1,3]);
 end;

 VAR Loop1:integer;

 BEGIN
   For Loop1 := 0 to 199 do
     Scr_Ofs[Loop1] := Loop1 * 320;
 END.{$X+}
 USES Crt,GFX3;

 CONST VGA = $A000;
       maxpolys = 18;

             A : Array [1..maxpolys,1..4,1..3] of integer =
         (
          ((-10, -10, 10 ),
           (10 , -10, 10 ),
           (10 , 10 , 10 ),
           (-10, 10 , 10 )),

          ((-10, 10 , -10),
           (10 , 10 , -10),
           (10 , -10, -10),
           (-10, -10, -10)),

          ((-10, 10 , 10 ),
           (-10, 10 , -10),
           (-10, -10, -10),
           (-10, -10, 10 )),

          ((10 , -10, 10 ),
           (10 , -10, -10),
           (10 , 10 , -10),
           (10 , 10 , 10 )),

          ((10 , 10 , 10 ),
           (10 , 10 , -10),
           (-10, 10 , -10),
           (-10, 10 , 10 )),

          ((-10, -10, 10 ),
           (-10, -10, -10),
           (10 , -10, -10),
           (10 , -10, 10 )),

 (*********)

          ((-10, -10,-20 ),
           (10 , -10,-20 ),
           (10 , 10 ,-20 ),
           (-10, 10 ,-20 )),

          ((-10, 10 , -30),
           (10 , 10 , -30),
           (10 , -10, -30),
           (-10, -10, -30)),

          ((-10, 10 ,-20 ),
           (-10, 10 , -30),
           (-10, -10, -30),
           (-10, -10,-20 )),

          ((10 , -10,-20 ),
           (10 , -10, -30),
           (10 , 10 , -30),
           (10 , 10 ,-20 )),

          ((10 , 10 ,-20 ),
           (10 , 10 , -30),
           (-10, 10 , -30),
           (-10, 10 ,-20 )),

          ((-10, -10,-20 ),
           (-10, -10, -30),
           (10 , -10, -30),
           (10 , -10,-20 )),

 (*********)

          ((-30, -10, 10 ),
           (-20, -10, 10 ),
           (-20, 10 , 10 ),
           (-30, 10 , 10 )),

          ((-30, 10 , -10),
           (-20, 10 , -10),
           (-20, -10, -10),
           (-30, -10, -10)),

          ((-30, 10 , 10 ),
           (-30, 10 , -10),
           (-30, -10, -10),
           (-30, -10, 10 )),

          ((-20, -10, 10 ),
           (-20, -10, -10),
           (-20, 10 , -10),
           (-20, 10 , 10 )),

          ((-20, 10 , 10 ),
           (-20, 10 , -10),
           (-30, 10 , -10),
           (-30, 10 , 10 )),

          ((-30, -10, 10 ),
           (-30, -10, -10),
           (-20, -10, -10),
           (-20, -10, 10 ))
         );  { The 3-D coordinates of our object ... stored as (X1,Y1,Z1), }
             { (X2,Y2,Z2) ... for the 4 points of a poly }

       XOfs = 100;
       YOfs = 160;

 Type Point = Record
                x,y,z:integer;                { The data on every point we rotate}
              END;

 VAR Lines : Array [1..maxpolys,1..4] of Point; { The base object to be rotated }
     Translated : Array [1..maxpolys,1..4] of Point; { The rotated object }
     centre, tcentre : Array [1..maxpolys] of Point;
     Order : Array[1..maxpolys] of integer;
     lookup : Array [0..360,1..2] of integer; { Our sin and cos lookup table }
     poly : array [0..199,1..2] of integer;
     ytopclip,ybotclip:integer;  {where to clip our polys to}
     xoff,yoff,zoff:integer;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 Procedure SetMCGA;  { This procedure gets you into 320x200x256 mode. }
 BEGIN
   asm
      mov        ax,0013h
      int        10h
   end;
 END;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 Procedure Hline (x1,x2,y:integer;col:byte;where:word); assembler;
   { This draws a horizontal line from x1 to x2 on line y in color col }
 asm
   mov   ax,x1
   cmp   ax,0
   jge   @X1Okay
   mov   x1,0
 @X1Okay :

   mov   ax,x2
   cmp   ax,319
   jle   @X2Okay
   mov   x2,319
 @X2Okay :

   mov   ax,x1
   cmp   ax,x2
   jg    @Exit

   mov   ax,where
   mov   es,ax
   mov   ax,y
   mov   di,ax
   shl   ax,8
   shl   di,6
   add   di,ax
   add   di,x1

   mov   al,col
   mov   ah,al
   mov   cx,x2
   sub   cx,x1
   shr   cx,1
   jnc   @start
   stosb
 @Start :
   rep   stosw
 @Exit :
 end;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 Procedure DrawPoly(x1,y1,x2,y2,x3,y3,x4,y4:integer;color:byte;where:word);
   { This draw a polygon with 4 points at x1,y1 , x2,y2 , x3,y3 , x4,y4
     in color col }
 var miny,maxy:integer;
     loop1:integer;

 Procedure doside (x1,y1,x2,y2:integer);
   { This scans the side of a polygon and updates the poly variable }
 VAR temp:integer;
     x,xinc:integer;
     loop1:integer;
 BEGIN
   if y1=y2 then exit;
   if y2(ytopclip)) and (loop1<(ybotclip)) then BEGIN
       if (x shr 7poly[loop1,2]) then poly[loop1,2]:=x shr 7;
     END;
     x:=x+xinc;
   END;
 END;

 begin
   asm
     mov   si,offset poly
     mov   cx,200
 @Loop1:
     mov   ax,32766
     mov   ds:[si],ax
     inc   si
     inc   si
     mov   ax,-32767
     mov   ds:[si],ax
     inc   si
     inc   si
     loop  @loop1
   end;     { Setting the minx and maxx values to extremes }
   miny:=y1;
   maxy:=y1;
   if y2maxy then maxy:=y2;
   if y3>maxy then maxy:=y3;
   if y4>maxy then maxy:=y4;
   if minyybotclip then maxy:=ybotclip;
   if (miny>199) or (maxy<0) then exit;

   Doside (x1,y1,x2,y2);
   Doside (x2,y2,x3,y3);
   Doside (x3,y3,x4,y4);
   Doside (x4,y4,x1,y1);

   for loop1:= miny to maxy do
     hline (poly[loop1,1],poly[loop1,2],loop1,color,where);
 end;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 Procedure SetUpPoints;
   { This creates the lookup table }
 VAR loop1,loop2:integer;
 BEGIN
   For loop1:=0 to 360 do BEGIN
     lookup [loop1,1]:=round(sin (rad (loop1))*16384);
     lookup [loop1,2]:=round(cos (rad (loop1))*16384);
   END;
   For loop1:=1 to maxpolys do BEGIN
     centre[loop1].x := (lines[loop1,1].x + lines[loop1,2].x +
                         lines[loop1,3].x + lines[loop1,4].x) div 4;
     centre[loop1].y := (lines[loop1,1].y + lines[loop1,2].y +
                         lines[loop1,3].y + lines[loop1,4].y) div 4;
     centre[loop1].z := (lines[loop1,1].z + lines[loop1,2].z +
                         lines[loop1,3].z + lines[loop1,4].z) div 4;
   END;
 END;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 Procedure RotatePoints (x,Y,z:Integer);
   { This rotates the objecct in lines to translated }
 VAR loop1,loop2:integer;
     a,b,c:integer;
 BEGIN
   For loop1:=1 to maxpolys do BEGIN
     for loop2:=1 to 4 do BEGIN
       b:=lookup[y,2];
       c:=lines[loop1,loop2].x;
       asm
         mov   ax,b
         imul  c
         sal   ax,1
         rcl   dx,1
         sal   ax,1
         rcl   dx,1
         mov   a,dx
       end;
       b:=lookup[y,1];
       c:=lines[loop1,loop2].z;
       asm
         mov   ax,b
         imul  c
         sal   ax,1
         rcl   dx,1
         sal   ax,1
         rcl   dx,1
         add   a,dx
       end;
       translated[loop1,loop2].x:=a;
       translated[loop1,loop2].y:=lines[loop1,loop2].y;
       b:=-lookup[y,1];
       c:=lines[loop1,loop2].x;
       asm
         mov   ax,b
         imul  c
         sal   ax,1
         rcl   dx,1
         sal   ax,1
         rcl   dx,1
         mov   a,dx
       end;
       b:=lookup[y,2];
       c:=lines[loop1,loop2].z;
       asm
         mov   ax,b
         imul  c
         sal   ax,1
         rcl   dx,1
         sal   ax,1
         rcl   dx,1
         add   a,dx
       end;
       translated[loop1,loop2].z:=a;

       if x<>0 then BEGIN
         b:=lookup[x,2];
         c:=translated[loop1,loop2].y;
         asm
           mov   ax,b
           imul  c
           sal   ax,1
           rcl   dx,1
           sal   ax,1
           rcl   dx,1
           mov   a,dx
         end;
         b:=lookup[x,1];
         c:=translated[loop1,loop2].z;
         asm
           mov   ax,b
           imul  c
           sal   ax,1
           rcl   dx,1
           sal   ax,1
           rcl   dx,1
           sub   a,dx
         end;
         b:=lookup[x,1];
         c:=translated[loop1,loop2].y;
         translated[loop1,loop2].y:=a;
         asm
           mov   ax,b
           imul  c
           sal   ax,1
           rcl   dx,1
           sal   ax,1
           rcl   dx,1
           mov   a,dx
         end;
         b:=lookup[x,2];
         c:=translated[loop1,loop2].z;
         asm
           mov   ax,b
           imul  c
           sal   ax,1
           rcl   dx,1
           sal   ax,1
           rcl   dx,1
           add   a,dx
         end;
         translated[loop1,loop2].z:=a;
       END;

       if z<>0 then BEGIN
         b:=lookup[z,2];
         c:=translated[loop1,loop2].x;
         asm
           mov   ax,b
           imul  c
           sal   ax,1
           rcl   dx,1
           sal   ax,1
           rcl   dx,1
           mov   a,dx
         end;
         b:=lookup[z,1];
         c:=translated[loop1,loop2].y;
         asm
           mov   ax,b
           imul  c
           sal   ax,1
           rcl   dx,1
           sal   ax,1
           rcl   dx,1
           sub   a,dx
         end;
         b:=lookup[z,1];
         c:=translated[loop1,loop2].x;
         translated[loop1,loop2].x:=a;
         asm
           mov   ax,b
           imul  c
           sal   ax,1
           rcl   dx,1
           sal   ax,1
           rcl   dx,1
           mov   a,dx
         end;
         b:=lookup[z,2];
         c:=translated[loop1,loop2].y;
         asm
           mov   ax,b
           imul  c
           sal   ax,1
           rcl   dx,1
           sal   ax,1
           rcl   dx,1
           add   a,dx
         end;
         translated[loop1,loop2].y:=a;
       END;
     END;
   END;

 {******************}
   For loop1:=1 to maxpolys do BEGIN
     b:=lookup[y,2];
     c:=centre[loop1].x;
     asm
       mov   ax,b
       imul  c
       sal   ax,1
       rcl   dx,1
       sal   ax,1
       rcl   dx,1
       mov   a,dx
     end;
     b:=lookup[y,1];
     c:=centre[loop1].z;
     asm
       mov   ax,b
       imul  c
       sal   ax,1
       rcl   dx,1
       sal   ax,1
       rcl   dx,1
       add   a,dx
     end;
     tcentre[loop1].x:=a;
     tcentre[loop1].y:=centre[loop1].y;
     b:=-lookup[y,1];
     c:=centre[loop1].x;
     asm
       mov   ax,b
       imul  c
       sal   ax,1
       rcl   dx,1
       sal   ax,1
       rcl   dx,1
       mov   a,dx
     end;
     b:=lookup[y,2];
     c:=centre[loop1].z;
     asm
       mov   ax,b
       imul  c
       sal   ax,1
       rcl   dx,1
       sal   ax,1
       rcl   dx,1
       add   a,dx
     end;
     tcentre[loop1].z:=a;

     if x<>0 then BEGIN
       b:=lookup[x,2];
       c:=tcentre[loop1].y;
       asm
         mov   ax,b
         imul  c
         sal   ax,1
         rcl   dx,1
         sal   ax,1
         rcl   dx,1
         mov   a,dx
       end;
       b:=lookup[x,1];
       c:=tcentre[loop1].z;
       asm
         mov   ax,b
         imul  c
         sal   ax,1
         rcl   dx,1
         sal   ax,1
         rcl   dx,1
         sub   a,dx
       end;
       b:=lookup[x,1];
       c:=tcentre[loop1].y;
       tcentre[loop1].y:=a;
       asm
         mov   ax,b
         imul  c
         sal   ax,1
         rcl   dx,1
         sal   ax,1
         rcl   dx,1
         mov   a,dx
       end;
       b:=lookup[x,2];
       c:=tcentre[loop1].z;
       asm
         mov   ax,b
         imul  c
         sal   ax,1
         rcl   dx,1
         sal   ax,1
         rcl   dx,1
         add   a,dx
       end;
       tcentre[loop1].z:=a;
     END;

     if z<>0 then BEGIN
       b:=lookup[z,2];
       c:=tcentre[loop1].x;
       asm
         mov   ax,b
         imul  c
         sal   ax,1
         rcl   dx,1
         sal   ax,1
         rcl   dx,1
         mov   a,dx
       end;
       b:=lookup[z,1];
       c:=tcentre[loop1].y;
       asm
         mov   ax,b
         imul  c
         sal   ax,1
         rcl   dx,1
         sal   ax,1
         rcl   dx,1
         sub   a,dx
       end;
       b:=lookup[z,1];
       c:=tcentre[loop1].x;
       tcentre[loop1].x:=a;
       asm
         mov   ax,b
         imul  c
         sal   ax,1
         rcl   dx,1
         sal   ax,1
         rcl   dx,1
         mov   a,dx
       end;
       b:=lookup[z,2];
       c:=tcentre[loop1].y;
       asm
         mov   ax,b
         imul  c
         sal   ax,1
         rcl   dx,1
         sal   ax,1
         rcl   dx,1
         add   a,dx
       end;
       tcentre[loop1].y:=a;
     END;
   END;
 END;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 Procedure DrawPoints;
   { This draws the translated object to the virtual screen }
 VAR loop1,loop2:Integer;
     temp, normal:integer;
     nx:integer;
     tx1,ty1,tx2,ty2,tx3,ty3,tx4,ty4:integer;
 BEGIN
   For loop2:=1 to maxpolys do BEGIN
     loop1:=order[loop2];
     If (translated[loop1,1].z+zoff<0) and (translated[loop1,2].z+zoff<0)
        and (translated[loop1,3].z+zoff<0) and (translated[loop1,4].z+zoff<0)
        then BEGIN
       temp:=round (translated[loop1,1].z)+zoff;
       nx:=translated[loop1,1].X;
       asm
         mov   ax,nx
         mov   dx,ax
         sal   ax,8
         sar   dx,8
         idiv  temp
         add   ax,YOfs
         mov   nx,ax
       end;
       tx1:=nx;
       nx:=translated[loop1,1].Y;
       asm
         mov   ax,nx
         mov   dx,ax
         sal   ax,8
         sar   dx,8
         idiv  temp
         add   ax,XOfs
         mov   nx,ax
       end;
       ty1:=nx;

       temp:=round (translated[loop1,2].z)+zoff;
       nx:=translated[loop1,2].X;
       asm
         mov   ax,nx
         mov   dx,ax
         sal   ax,8
         sar   dx,8
         idiv  temp
         add   ax,YOfs
         mov   nx,ax
       end;
       tx2:=nx;
       nx:=translated[loop1,2].Y;
       asm
         mov   ax,nx
         mov   dx,ax
         sal   ax,8
         sar   dx,8
         idiv  temp
         add   ax,XOfs
         mov   nx,ax
       end;
       ty2:=nx;

       temp:=round (translated[loop1,3].z)+zoff;
       nx:=translated[loop1,3].X;
       asm
         mov   ax,nx
         mov   dx,ax
         sal   ax,8
         sar   dx,8
         idiv  temp
         add   ax,YOfs
         mov   nx,ax
       end;
       tx3:=nx;
       nx:=translated[loop1,3].Y;
       asm
         mov   ax,nx
         mov   dx,ax
         sal   ax,8
         sar   dx,8
         idiv  temp
         add   ax,XOfs
         mov   nx,ax
       end;
       ty3:=nx;

       temp:=round (translated[loop1,4].z)+zoff;
       nx:=translated[loop1,4].X;
       asm
         mov   ax,nx
         mov   dx,ax
         sal   ax,8
         sar   dx,8
         idiv  temp
         add   ax,YOfs
         mov   nx,ax
       end;
       tx4:=nx;
       nx:=translated[loop1,4].Y;
       asm
         mov   ax,nx
         mov   dx,ax
         sal   ax,8
         sar   dx,8
         idiv  temp
         add   ax,XOfs
         mov   nx,ax
       end;
       ty4:=nx;

       normal:=(ty1-ty3)*(tx2-tx1)-(tx1-tx3)*(ty2-ty1);
       if normal<0 then
         drawpoly (tx1,ty1,tx2,ty2,tx3,ty3,tx4,ty4,loop1,vaddr);
     END;
   END;
 END;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 Procedure SortPoints;
 VAR loop1,curpos, temp:integer;
 BEGIN
   for loop1:=1 to maxpolys do BEGIN
     order[loop1]:=loop1;
   END;
   curpos := 1;
   while curpos tcentre[curpos+1].z then BEGIN
       temp := tcentre[curpos+1].x;
       tcentre[curpos+1].x := tcentre[curpos].x;
       tcentre[curpos].x := temp;

       temp := tcentre[curpos+1].y;
       tcentre[curpos+1].y := tcentre[curpos].y;
       tcentre[curpos].y := temp;

       temp := tcentre[curpos+1].z;
       tcentre[curpos+1].z := tcentre[curpos].z;
       tcentre[curpos].z := temp;

       temp := order[curpos+1];
       order[curpos+1] := order[curpos];
       order[curpos] := temp;

       curpos:=0;
     END;
     curpos:=curpos+1;
   END;
 END;

 {陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳}
 Procedure MoveAround;
   { This is the main display procedure. }
 VAR deg,deg2,loop1,loop2:integer;
     ch:char;

 BEGIN
   pal (1,  0, 0,63);
   pal (2,  0,32,63);
   pal (3, 32, 0,63);
   pal (4, 32,32,63);
   pal (5,  0,63,63);
   pal (6, 32,63,63);

   pal ( 7,  0,63, 0);
   pal ( 8,  0,63,32);
   pal ( 9, 32,63, 0);
   pal (10, 32,63,32);
   pal (11,  0,63,63);
   pal (12, 32,63,63);

   pal (13, 63, 0, 0);
   pal (14, 63,32, 0);
   pal (15, 63, 0,32);
   pal (16, 63,32,32);
   pal (17, 63,63, 0);
   pal (18, 63,63,32);
 {  for loop1:=1 to 15 do
     pal (loop1,0,loop1*4+3,63-(loop1*4+3));}
   pal (100,50,50,50);

   deg:=0;
   deg2:=0;
   ch:=#0;
   Cls (vaddr,0);
   For loop1:=1 to maxpolys do
     For loop2:=1 to 4 do BEGIN
       Lines [loop1,loop2].x:=a [loop1,loop2,1]*8;
       Lines [loop1,loop2].y:=a [loop1,loop2,2]*8;
       Lines [loop1,loop2].z:=a [loop1,loop2,3]*8;
     END;

   SetUpPoints;

   cls (vaddr,0);
   cls (vga,0);
   Xoff := 160;
   Yoff:=100;
   zoff:=-500;

   ytopclip:=101;
   ybotclip:=100;
   line (0,100,319,100,100,vga);
   delay (2000);
   for loop1:=1 to 25 do BEGIN
     RotatePoints (deg2,deg,deg2);
     SortPoints;
     DrawPoints;
     line (0,ytopclip,319,ytopclip,100,vaddr);
     line (0,ybotclip,319,ybotclip,100,vaddr);
     flip (vaddr,vga);
     cls (vaddr,0);
     deg:=(deg+5) mod 360;
     deg2:=(deg2+1) mod 360;
     ytopclip:=ytopclip-4;
     ybotclip:=ybotclip+4;
   END;
   Repeat
     if keypressed then ch:=upcase (Readkey);
     RotatePoints (deg2,deg,deg2);
     SortPoints;
     DrawPoints;
     line (0,0,319,0,100,vaddr);
     line (0,199,319,199,100,vaddr);
     flip (vaddr,vga);
     cls (vaddr,0);
     deg:=(deg+5) mod 360;
     deg2:=(deg2+3) mod 360;
   Until ch=#27;
   for loop1:=1 to 25 do BEGIN
     ytopclip:=ytopclip+4;
     ybotclip:=ybotclip-4;
     RotatePoints (deg2,deg,deg2);
     SortPoints;
     DrawPoints;
     line (0,ytopclip,319,ytopclip,100,vaddr);
     line (0,ybotclip,319,ybotclip,100,vaddr);
     flip (vaddr,vga);
     cls (vaddr,0);
     deg:=(deg+5) mod 360;
     deg2:=(deg2+1) mod 360;
   END;
 END;

 BEGIN
   clrscr;
   writeln ('Welcome to the twentieth(sp) trainer! This one is on face sorting');
   writeln ('and back face removal.');
   writeln;
   writeln ('Just hit a key to view the 3d shape. You will notice that you');
   writeln ('won''t see any of the faces you shouldn''t see :-)');
   writeln ('The code is based on that from the glenzing tut, so you should');
   writeln ('be able to understand it fairly quickly.');
   writeln;
   writeln;
   writeln;
   write ('Hit any key to continue ...');
   readkey;
   SetUpVirtual;
   SetMCGA;
   MoveAround;
   SetText;
   ShutDown;
   Writeln ('All done. This concludes the twentieth sample program in the ASPHYXIA');
   Writeln ('Training series. You may reach DENTHOR under the names of GRANT');
   Writeln ('SMITH/DENTHOR/ASPHYXIA on the ASPHYXIA BBS.I also occasinally');
   Writeln ('RSAProg, comp.lang.pascal and comp.sys.ibm.pc.demos. E-mail me at :');
   Writeln ('    denthor@goth.vironix.co.za');
   Writeln ('The numbers are available in the main text. You may also write to me at:');
   Writeln ('             Grant Smith');
   Writeln ('             P.O. Box 270');
   Writeln ('             Kloof');
   Writeln ('             3640');
   Writeln ('             Natal');
   Writeln ('             South Africa');
   Writeln ('I hope to hear from you soon!');
   Writeln; Writeln;
   Write   ('Hit any key to exit ...');
   readkey;
 END.

 [BACK] Back

Discuss this article in the forums


Date this article was posted to GameDev.net: 7/16/1999
(Note that this date does not necessarily correspond to the date the article was written)

See Also:
Denthor's Asphyxia Tutorials

© 1999-2011 Gamedev.net. All rights reserved. Terms of Use Privacy Policy
Comments? Questions? Feedback? Click here!