Texture Mapping

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

                            --==[ PART 21 ]==--

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

 Hi there! It's been quite a long time (again) since the last tutorial ...
 I'll bet some of you had given up one me ;-)

 Today is my 21st birthday, so I decided it would be the perfect time to
 finish up this trainer which I have been meaning to send out for weeks.
 It's on texure mapping. I know, I know, I said light sourcing, then gourad,
 then texture mapping, but I got enough mail (a deluge in fact ;) telling me
 to do texure mapping...

 I'll be using the code from Tut 20 quite extensively, so make sure you know
 whats going on in there... well, on with the show!

 BTW, I've improved my web page quite a bit... give it a visit, I want to
 really ramp up that hit count :)

 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 work hours). Call +27-31-73-2129 if you call
                   from outside South Africa. (It's YOUR phone bill ;-))
             4) Write to denthor@goth.vironix.co.za in E-Mail.
             5) Write to asphyxia@beastie.cs.und.ac.za to get to all of
                us at once.

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

 =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
   Free Direction Texture Mapping

 There are two things you should know before we begin.

 Firstly, I am cheating. The texture mapping I am going to show you is not
 perspective-correct, with clever divides for z-placement etc. This method
 looks almost as good and is quite a bit faster too.

 Secondly, you will find it all rather easy. The reason for this is that it's
 all rather simple. I first made the routine by sitting down with some paper
 and a pencil and had it on the machine in a few hours. A while later when
 people on the net started discussing their methods, they were remarkably
 similar.

 Let me show you what I mean.

 Let us assume you have a texture of 128x128 (a straight array of bytes
 [0..127, 0..127]) which you want to map onto the side of a polygon. The
 problem of course being that the polygon can be all over the place, with
 one side longer then the other etc.

 Our first step is to make sure we know which end is up... let me
 demonstrate...
                       1
                     +
                  /    \
               /         \
           4 +            +  2
               \        /
                 \   /
                   +
                   3

 Let us say that the above is the chosen polygon. We have decided that point
 1 is the top left, point 3 is bottom right. This means that
   1 - 2   is the top of the texture
   2 - 3   is the right of the texture
   3 - 4   is the bottom of the texture
   4 - 1   is the left of the texture

 The same polygon, but rotated :

                       3
                     +
                  /    \
               /         \
           2 +            +  4
               \        /
                 \   /
                   +
                   1

 Although the positions of the points are different, point 1 is still the
 top left of our texture.

 =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
   How to put it to screen

 Okay, so now you have four points and know which one of them is also the top
 left of our texture. What next?

 If you think back to our tutorial on polygons, you will remember we draw it
 scanline by scanline. We do texture mapping the same way.

 Lets look at that picture again :

                       1
                     +
                a /    \  b
               /         \
           4 +            +  2
               \        /
                 \   /
                   +
                   3

 We know that point 1 is at [0,0] in our texture. Point 2 is at [127,0],
 Point 3 is at [127,127], and Point 4 is at [0,127].

 The clever bit, and the entire key to texture mapping, is making the
 logical leap that precisely half way between Point 1 and Point 2 (b), we are at
 [64,0] in our texture. (a) is in the same manner at [0,64].

 That's it. All we need to know per y scanline is :
 The starting position on the x axis of the polgon line
 The position on the x in the texture map referenced by that point
 The position on the y in the texture map referenced by that point

 The ending position on the x axis of the polgon line
 The position on the x in the texture map referenced by that point
 The position on the y in the texture map referenced by that point

 Let me give you an example. Let's sat that (a) and (b) from the above
 picture are on the same y scanline. We know that the x of that scanline is
 (say) 100 pixels at the start and 200 pixels at the end, making it's width
 100 pixels.

 We know that on the left hand side, the texture is at [0,64], and at the
 right hand side, the texture is at [64,0]. In 100 pixels we have to
 traverse our texture from [0,64] to [64,0].

 Assume at the start we have figured out the starting and ending points in
 the texture
   textureX = 0;
   textureY = 64;
   textureEndX = 64;
   textureEndY = 0;

   dx := (TextureEndX-TextureX)/(maxx-minx);
   dy := (TextureEndY-TextureY)/(maxx-minx);
   for loop1 := minx to maxx do BEGIN
     PutPixel (loop1, ypos, texture [textureX, textureY], VGA);
     textureX = textureX + dx;
     textureY = textureY + dy;
   END;

 Do the above for all the scanlines, and you have a texture mapped polygon!
 It's that simple.

 We find our beginning and ending positions in the usual fasion. We know
 that Point 1 is [0,0]. We know that Point 2 is [127,0]. We know the number
 of scanlines on the y axis between Point 1 and Point 2.

   textureDX = 127/abs (point2.y - point1.y)

 We run though all the y scanlines, starting from [0,0] and adding the above
 formula to the X every time. When we hit the last scanline, we will be at
 point [127,0] in the texure.

 Repeat for all four sides, and you have the six needed variables per
 scanline.

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

 As you can see, texture mapping (this type at least) is quite easy, and
 produces quite a good result. You will however notice a bit of distortion
 if you bring the polygon too close. This can be fixed by a) Subdividing the
 polygon, so the one is made up of four or more smaller polygons. Much
 bigger, but works; b) Using more accurate fixed point; or c) Figuring out
 perspective correct texture mapping, mapping along constant-z lines etc.

 When people write me, they often refer to my "tutes". This stems back to
 Mark Feldman calling them such in the PCGPE. I always though a "tute" was
 something you did with your car to gain someones attention. I dunno, maybe
 its an Australian thing ;-)

 I have been coding almost exclusively in C/C++ for the past year or so.
 Sorry guys, thats all they will pay me for ;) Anyway, the trainers will
 continue to be in Pascal for ease of understanding by beginners, but if
 someone (*ahem* Snowman) doesn't start converting them to C soon, I will do
 it myself. He also corrected any mistakes I made while he was converting,
 so I'd prefer he did it (sort of a proofreader after release...)

 Send me presents! It's my birthday!

 Byeeeee.....
   - Denthor
       16-04-96

 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;

      Pictype = array [0..127,0..127] of byte;

 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;

     pic : ^pictype;
     lefttable : array [-200..400,0..2] of integer;
     righttable : array [-200..400,0..2] of 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 LoadGFX;
   { This loads up our texture }
 VAR f1 : File;
     bob : array [0..255, 1..3] of byte;
     loop1 : Integer;
 BEGIN
   getmem (pic,sizeof(pic^));
   loadcel ('side1.cel',pic);

   assign (f1, 'side1.cel');
   reset (f1, 1);
   seek (f1, 32);
   blockread (f1, bob, 768);
   close (f1);
   for loop1:=0 to 255 do
     Pal (loop1, bob[loop1,1], bob[loop1,2], bob[loop1,3]);
 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 TextureMapPoly (x1,y1,x2,y2,x3,y3,x4,y4:integer;where:word);
   { The main procedure, contains various nested procedures }
 VAR miny, maxy, loop1 : integer;

 Procedure scanleftside (x1,x2,ytop,lineheight:integer;side:byte);
   { Scan in our needed variables ... X on the left, texturmap X, texturemap Y}
 VAR x,px,py,xadd,pxadd,pyadd:integer;
     y:integer;
 BEGIN
   lineheight:=lineheight+1;
   xadd:=(x2-x1) shl 7 div lineheight;
   if side = 1 then BEGIN
     px:=(127-1) shl 7;
     py:=0;
     pxadd:=(-127 shl 7) div lineheight;
     pyadd:=0;
   END;
   if side = 2 then BEGIN
     px:=127 shl 7;
     py:=127 shl 7;
     pxadd:=0;
     pyadd:=(-127 shl 7) div lineheight;
   END;
   if side = 3 then BEGIN
     px:=0;
     py:=127 shl 7;
     pxadd:=127 shl 7 div lineheight;
     pyadd:=0;
   END;
   if side = 4 then BEGIN
     px:=0;
     py:=0;
     pxadd:=0;
     pyadd:=127 shl 7 div lineheight;
   END;
   x:=x1 shl 7;
   for y:=0 to lineheight do BEGIN
     lefttable[ytop+y,0]:=x shr 7;
     lefttable[ytop+y,1]:=px shr 7;
     lefttable[ytop+y,2]:=py shr 7;
     x:=x+xadd;
     px:=px+pxadd;
     py:=py+pyadd;
   END;
 END;

 Procedure scanrightside (x1,x2,ytop,lineheight:integer;side:byte);
   { Scan in our needed variables ... X on the right, texturmap X, texturemap Y}
 VAR x,px,py,xadd,pxadd,pyadd:integer;
     y:integer;
 BEGIN
   lineheight:=lineheight+1;
   xadd:=(x2-x1) shl 7 div lineheight;
   if side = 1 then BEGIN
     px:=0;
     py:=0;
     pxadd:=127 shl 7 div lineheight;
     pyadd:=0;
   END;
   if side = 2 then BEGIN
     px:=127 shl 7;
     py:=0;
     pxadd:=0;
     pyadd:=127 shl 7 div lineheight;
   END;
   if side = 3 then BEGIN
     px:=127 shl 7;
     py:=127 shl 7;
     pxadd:=(-127) shl 7 div lineheight;
     pyadd:=0;
   END;
   if side = 4 then BEGIN
     px:=0;
     py:=127 shl 7;
     pxadd:=0;
     pyadd:=(-127) shl 7 div lineheight;
   END;
   x:=x1 shl 7;
   for y:=0 to lineheight do BEGIN
     righttable[ytop+y,0]:=x shr 7;
     righttable[ytop+y,1]:=px shr 7;
     righttable[ytop+y,2]:=py shr 7;
     x:=x+xadd;
     px:=px+pxadd;
     py:=py+pyadd;
   END;
 END;

 Procedure Texturemap;
   { This uses the tables we have created to actually draw the texture }
 VAR px1,py1:integer;
     px2,py2:integer;
     polyx1,polyx2,y,linewidth:integer;
     pxadd,pyadd:integer;
     bob, twhere :word;
 BEGIN
   bob:=seg (pic^);
   tWhere := Where;      { ds is used elsewhere ... variables are not accessable }
   if miny<0 then miny:=0;
   if maxy>199 then maxy:=199;
   if minyybotclip then maxy:=ybotclip;
   if maxy-miny<2 then exit;
   if miny>199 then exit;
   if maxy<0 then exit;
   for y:=miny to maxy do BEGIN
     polyx1:=lefttable[y,0];      { X Starting position }
     px1:=lefttable[y,1] shl 7;   { Texture X at start  }
     py1:=lefttable[y,2] shl 7;   { Texture Y at stary  }
     polyx2:=righttable[y,0];     { X Ending position   }
     px2:=righttable[y,1] shl 7;  { Texture X at end    }
     py2:=righttable[y,2] shl 7;  { Texture Y at end    }
     linewidth:=polyx2-polyx1;    { Width of line }
     if linewidth<=0 then linewidth:=1;
     pxadd:=(px2-px1) div linewidth;
     pyadd:=(py2-py1) div linewidth;
       asm
         push    ds
         mov     bx,polyx1
         mov     di,bx

         mov     dx,[Y]
         mov     bx, dx
         shl     dx, 8
         shl     bx, 6
         add     dx, bx
         add     di, dx
         mov     ax,twhere        { es:di points to start of line }
         mov     es,ax

         mov     bx, px1

         mov     cx,lineWidth
         mov     dx, bob
         mov     ds, dx

         mov     dx,py1
 @Loop1 :
         xor     si,si
         mov     ax,bx
         and     ax,1111111110000000b;   { Get rid of fixed point }
         add     si,ax
         mov     ax,dx
         shr     ax,7
         add     si,ax           { get the pixel in our texture }
         movsb                   { draw the pixel to the screen }
         mov     ax,pxadd
         add     bx,ax
         mov     ax,pyadd
         add     dx,ax           { increment our position in the texture }
         loop    @loop1
         pop     ds
       end;
   END;
 END;

 BEGIN
   miny:=32767;
   maxy:=0;

   if y1maxy then maxy:=y1;
   if y2maxy then maxy:=y2;
   if y3maxy then maxy:=y3;
   if y4maxy then maxy:=y4;

   if miny>maxy-5 then exit;     { Why paint slivers? }

   if (y2 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;
   LoadGFX;

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

   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 twenty first trainer! This one is on texure mapping.');
   writeln;
   writeln ('Just sit bak and watch, it''s non interactive. Total reuse of Tut 20''s');
   writeln ('code, aside from the texure mapping procedure. Have fun!');
   writeln;
   writeln;
   write ('Hit any key to continue ...');
   readkey;
   SetUpVirtual;
   SetMCGA;
   MoveAround;
   SetText;
   ShutDown;
   Writeln ('All done. This concludes the twenty first 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!