Outils pour utilisateurs

Outils du site


back2root:archives:denthor:part-09

Différences

Ci-dessous, les différences entre deux révisions de la page.

Lien vers cette vue comparative

Les deux révisions précédentesRévision précédente
back2root:archives:denthor:part-09 [2021/09/02 11:49] fraterback2root:archives:denthor:part-09 [2021/09/05 14:09] (Version actuelle) – [In closing] frater
Ligne 206: Ligne 206:
  
 Does no other BBS's ANYWHERE carry the trainer? Am I writing this for three people who get it from one of these BBS's each week? Should I go on? (Hehehehe ... I was pleased to note that Tut 8 was THE most downloaded file from ASPHYXIA BBS last month ... ) Does no other BBS's ANYWHERE carry the trainer? Am I writing this for three people who get it from one of these BBS's each week? Should I go on? (Hehehehe ... I was pleased to note that Tut 8 was THE most downloaded file from ASPHYXIA BBS last month ... )
 +
 +==== Code Source ====
 +
 +=== PaSCAL ===
 +
 +<code pascal>
 +(*****************************************************************************)
 +(*                                                                           *)
 +(* TUT9.PAS - VGA Trainer Program 9 (in Pascal)                              *)
 +(*                                                                           *)
 +(* "The VGA Trainer Program" is written by Denthor of Asphyxia.  However it  *)
 +(* was limited to Pascal only in its first run.  All I have done is taken    *)
 +(* his original release, translated it to C++, and touched up a few things.  *)
 +(* I take absolutely no credit for the concepts presented in this code.      *)
 +(*        -Christopher G. Mann (Snowman)                                     *)
 +(*                                                                           *)
 +(* Program Notes : This program presents polygons.                           *)
 +(*                                                                           *)
 +(* Author        : Grant Smith (Denthor)  - denthor@beastie.cs.und.ac.za     *)
 +(*                                                                           *)
 +(*****************************************************************************)
 +
 +{$X+}
 +USES Crt;
 +
 +CONST VGA = $A000;
 +      maxpolys = 5;
 +      A : Array [1..maxpolys,1..4,1..3] of integer =
 +        (
 +         ((-10,10,0),(-2,-10,0),(0,-10,0),(-5,10,0)),
 +         ((10,10,0),(2,-10,0),(0,-10,0),(5,10,0)),
 +         ((-2,-10,0),(2,-10,0),(2,-5,0),(-2,-5,0)),
 +         ((-6,0,0),(6,0,0),(7,5,0),(-7,5,0)),
 +         ((0,0,0),(0,0,0),(0,0,0),(0,0,0))
 +        );  { The 3-D coordinates of our object ... stored as (X1,Y1,Z1), }
 +            { (X2,Y2,Z2) ... for the 4 points of a poly }
 +     S : Array [1..maxpolys,1..4,1..3] of integer =
 +        (
 +         ((-10,-10,0),(10,-10,0),(10,-7,0),(-10,-7,0)),
 +         ((-10,10,0),(10,10,0),(10,7,0),(-10,7,0)),
 +         ((-10,1,0),(10,1,0),(10,-2,0),(-10,-2,0)),
 +         ((-10,-8,0),(-7,-8,0),(-7,0,0),(-10,0,0)),
 +         ((10,8,0),(7,8,0),(7,0,0),(10,0,0))
 +        );  { The 3-D coordinates of our object ... stored as (X1,Y1,Z1), }
 +            { (X2,Y2,Z2) ... for the 4 points of a poly }
 +     P : Array [1..maxpolys,1..4,1..3] of integer =
 +        (
 +         ((-10,-10,0),(-7,-10,0),(-7,10,0),(-10,10,0)),
 +         ((10,-10,0),(7,-10,0),(7,0,0),(10,0,0)),
 +         ((-9,-10,0),(9,-10,0),(9,-7,0),(-9,-7,0)),
 +         ((-9,-1,0),(9,-1,0),(9,2,0),(-9,2,0)),
 +         ((0,0,0),(0,0,0),(0,0,0),(0,0,0))
 +        );  { The 3-D coordinates of our object ... stored as (X1,Y1,Z1), }
 +            { (X2,Y2,Z2) ... for the 4 points of a poly }
 +     H : Array [1..maxpolys,1..4,1..3] of integer =
 +        (
 +         ((-10,-10,0),(-7,-10,0),(-7,10,0),(-10,10,0)),
 +         ((10,-10,0),(7,-10,0),(7,10,0),(10,10,0)),
 +         ((-9,-1,0),(9,-1,0),(9,2,0),(-9,2,0)),
 +         ((0,0,0),(0,0,0),(0,0,0),(0,0,0)),
 +         ((0,0,0),(0,0,0),(0,0,0),(0,0,0))
 +        );  { The 3-D coordinates of our object ... stored as (X1,Y1,Z1), }
 +            { (X2,Y2,Z2) ... for the 4 points of a poly }
 +     Y : Array [1..maxpolys,1..4,1..3] of integer =
 +        (
 +         ((-7,-10,0),(0,-3,0),(0,0,0),(-10,-7,0)),
 +         ((7,-10,0),(0,-3,0),(0,0,0),(10,-7,0)),
 +         ((-2,-3,0),(2,-3,0),(2,10,0),(-2,10,0)),
 +         ((0,0,0),(0,0,0),(0,0,0),(0,0,0)),
 +         ((0,0,0),(0,0,0),(0,0,0),(0,0,0))
 +        );  { The 3-D coordinates of our object ... stored as (X1,Y1,Z1), }
 +            { (X2,Y2,Z2) ... for the 4 points of a poly }
 +     X : Array [1..maxpolys,1..4,1..3] of integer =
 +        (
 +         ((-7,-10,0),(10,7,0),(7,10,0),(-10,-7,0)),
 +         ((7,-10,0),(-10,7,0),(-7,10,0),(10,-7,0)),
 +         ((0,0,0),(0,0,0),(0,0,0),(0,0,0)),
 +         ((0,0,0),(0,0,0),(0,0,0),(0,0,0)),
 +         ((0,0,0),(0,0,0),(0,0,0),(0,0,0))
 +        );  { The 3-D coordinates of our object ... stored as (X1,Y1,Z1), }
 +            { (X2,Y2,Z2) ... for the 4 points of a poly }
 +     I : Array [1..maxpolys,1..4,1..3] of integer =
 +        (
 +         ((-10,-10,0),(10,-10,0),(10,-7,0),(-10,-7,0)),
 +         ((-10,10,0),(10,10,0),(10,7,0),(-10,7,0)),
 +         ((-2,-9,0),(2,-9,0),(2,9,0),(-2,9,0)),
 +         ((0,0,0),(0,0,0),(0,0,0),(0,0,0)),
 +         ((0,0,0),(0,0,0),(0,0,0),(0,0,0))
 +        );  { The 3-D coordinates of our object ... stored as (X1,Y1,Z1), }
 +            { (X2,Y2,Z2) ... for the 4 points of a poly }
 +
 +
 +Type Point = Record
 +               x,y,z:real;                { The data on every point we rotate}
 +             END;
 +     Virtual = Array [1..64000] of byte;  { The size of our Virtual Screen }
 +     VirtPtr = ^Virtual;                  { Pointer to the virtual screen }
 +
 +
 +VAR Lines : Array [1..maxpolys,1..4] of Point;  { The base object rotated }
 +    Translated : Array [1..maxpolys,1..4] of Point; { The rotated object }
 +    Xoff,Yoff,Zoff:Integer;               { Used for movement of the object }
 +    lookup : Array [0..360,1..2] of real; { Our sin and cos lookup table }
 +    Virscr : VirtPtr;                     { Our first Virtual screen }
 +    Vaddr  : word;                        { The segment of our virtual screen}
 +
 +
 +{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
 +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);
 +   { This clears the screen to the specified color }
 +BEGIN
 +     asm
 +        push    es
 +        mov     cx, 32000;
 +        mov     es,[where]
 +        xor     di,di
 +        mov     al,[col]
 +        mov     ah,al
 +        rep     stosw
 +        pop     es
 +     End;
 +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);
 +  { This copies the entire screen at "source" to destination }
 +begin
 +  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;
 +end;
 +
 +
 +{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
 +Procedure Pal(Col,R,G,B : Byte);
 +  { This sets the Red, Green and Blue values of a certain color }
 +Begin
 +   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;
 +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 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
 +  x:integer;
 +  mny,mxy:integer;
 +  mnx,mxx,yc:integer;
 +  mul1,div1,
 +  mul2,div2,
 +  mul3,div3,
 +  mul4,div4:integer;
 +
 +begin
 +  mny:=y1; mxy:=y1;
 +  if y2<mny then mny:=y2;
 +  if y2>mxy then mxy:=y2;
 +  if y3<mny then mny:=y3;
 +  if y3>mxy then mxy:=y3;    { Choose the min y mny and max y mxy }
 +  if y4<mny then mny:=y4;
 +  if y4>mxy 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 x<mnx then
 +                mnx:=x;
 +              if x>mxx 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 x<mnx then
 +                mnx:=x;
 +              if x>mxx 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 x<mnx then
 +                mnx:=x;
 +              if x>mxx 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 x<mnx then
 +                mnx:=x;
 +              if x>mxx 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 SetUpPoints;
 +  { This creates the lookup table }
 +VAR loop1,loop2:integer;
 +BEGIN
 +  For loop1:=0 to 360 do BEGIN
 +    lookup [loop1,1]:=sin (rad (loop1));
 +    lookup [loop1,2]:=cos (rad (loop1));
 +  END;
 +END;
 +
 +
 +{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
 +Procedure Putpixel (X,Y : Integer; Col : Byte; where:word);
 +  { This puts a pixel on the screen by writing directly to memory. }
 +BEGIN
 +  Asm
 +    mov     ax,[where]
 +    mov     es,ax
 +    mov     bx,[X]
 +    mov     dx,[Y]
 +    mov     di,bx
 +    mov     bx, dx                  {; bx = dx}
 +    shl     dx, 8
 +    shl     bx, 6
 +    add     dx, bx                  {; dx = dx + bx (ie y*320)}
 +    add     di, dx                  {; finalise location}
 +    mov     al, [Col]
 +    stosb
 +  End;
 +END;
 +
 +
 +
 +{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
 +Procedure RotatePoints (X,Y,Z:Integer);
 +  { This rotates object lines by X,Y and Z; then places the result in
 +    TRANSLATED }
 +VAR loop1,loop2:integer;
 +    temp:point;
 +BEGIN
 +  For loop1:=1 to maxpolys do BEGIN
 +    For loop2:=1 to 4 do BEGIN
 +      temp.x:=lines[loop1,loop2].x;
 +      temp.y:=lookup[x,2]*lines[loop1,loop2].y - lookup[x,1]*lines[loop1,loop2].z;
 +      temp.z:=lookup[x,1]*lines[loop1,loop2].y + lookup[x,2]*lines[loop1,loop2].z;
 +
 +      translated[loop1,loop2]:=temp;
 +
 +      If y>0 then BEGIN
 +        temp.x:=lookup[y,2]*translated[loop1,loop2].x - lookup[y,1]*translated[loop1,loop2].y;
 +        temp.y:=lookup[y,1]*translated[loop1,loop2].x + lookup[y,2]*translated[loop1,loop2].y;
 +        temp.z:=translated[loop1,loop2].z;
 +        translated[loop1,loop2]:=temp;
 +      END;
 +
 +      If z>0 then BEGIN
 +        temp.x:=lookup[z,2]*translated[loop1,loop2].x + lookup[z,1]*translated[loop1,loop2].z;
 +        temp.y:=translated[loop1,loop2].y;
 +        temp.z:=-lookup[z,1]*translated[loop1,loop2].x + lookup[z,2]*translated[loop1,loop2].z;
 +        translated[loop1,loop2]:=temp;
 +      END;
 +    END;
 +  END;
 +END;
 +
 +
 +
 +{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
 +Procedure DrawPoints;
 +  { This draws the translated object to the virtual screen }
 +VAR loop1:Integer;
 +    nx,ny,nx2,ny2,nx3,ny3,nx4,ny4:integer;
 +    temp:integer;
 +BEGIN
 +  For loop1:=1 to maxpolys do BEGIN
 +    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 :=round (256*translated[loop1,1].X) div temp+xoff;
 +      ny :=round (256*translated[loop1,1].Y) div temp+yoff;
 +      temp:=round (translated[loop1,2].z+zoff);
 +      nx2:=round (256*translated[loop1,2].X) div temp+xoff;
 +      ny2:=round (256*translated[loop1,2].Y) div temp+yoff;
 +      temp:=round (translated[loop1,3].z+zoff);
 +      nx3:=round (256*translated[loop1,3].X) div temp+xoff;
 +      ny3:=round (256*translated[loop1,3].Y) div temp+yoff;
 +      temp:=round (translated[loop1,4].z+zoff);
 +      nx4:=round (256*translated[loop1,4].X) div temp+xoff;
 +      ny4:=round (256*translated[loop1,4].Y) div temp+yoff;
 +      drawpoly (nx,ny,nx2,ny2,nx3,ny3,nx4,ny4,13,vaddr);
 +    END;
 +  END;
 +END;
 +
 +
 +
 +{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
 +Procedure MoveAround;
 +  { This is the main display procedure. Firstly it brings the object towards
 +    the viewer by increasing the Zoff, then passes control to the user }
 +VAR deg,loop1,loop2:integer;
 +    ch:char;
 +
 +  Procedure Whizz (sub:boolean);
 +  VAR loop1:integer;
 +  BEGIN
 +    For loop1:=-64 to -5 do BEGIN
 +      zoff:=loop1*8;
 +      if sub then xoff:=xoff-7 else xoff:=xoff+7;
 +      RotatePoints (deg,deg,deg);
 +      DrawPoints;
 +      flip (vaddr,vga);
 +      Cls (vaddr,0);
 +      deg:=(deg+5) mod 360;
 +    END;
 +  END;
 +
 +BEGIN
 +  deg:=0;
 +  ch:=#0;
 +  Yoff:=100;
 +  Xoff:=350;
 +  Cls (vaddr,0);
 +  For loop1:=1 to maxpolys do
 +    For loop2:=1 to 4 do BEGIN
 +      Lines [loop1,loop2].x:=a [loop1,loop2,1];
 +      Lines [loop1,loop2].y:=a [loop1,loop2,2];
 +      Lines [loop1,loop2].z:=a [loop1,loop2,3];
 +    END;
 +  Whizz (TRUE);
 +
 +  For loop1:=1 to maxpolys do
 +    For loop2:=1 to 4 do BEGIN
 +      Lines [loop1,loop2].x:=s [loop1,loop2,1];
 +      Lines [loop1,loop2].y:=s [loop1,loop2,2];
 +      Lines [loop1,loop2].z:=s [loop1,loop2,3];
 +    END;
 +  Whizz (FALSE);
 +
 +  For loop1:=1 to maxpolys do
 +    For loop2:=1 to 4 do BEGIN
 +      Lines [loop1,loop2].x:=p [loop1,loop2,1];
 +      Lines [loop1,loop2].y:=p [loop1,loop2,2];
 +      Lines [loop1,loop2].z:=p [loop1,loop2,3];
 +    END;
 +  Whizz (TRUE);
 +
 +  For loop1:=1 to maxpolys do
 +    For loop2:=1 to 4 do BEGIN
 +      Lines [loop1,loop2].x:=h [loop1,loop2,1];
 +      Lines [loop1,loop2].y:=h [loop1,loop2,2];
 +      Lines [loop1,loop2].z:=h [loop1,loop2,3];
 +    END;
 +  Whizz (FALSE);
 +
 +  For loop1:=1 to maxpolys do
 +    For loop2:=1 to 4 do BEGIN
 +      Lines [loop1,loop2].x:=y [loop1,loop2,1];
 +      Lines [loop1,loop2].y:=y [loop1,loop2,2];
 +      Lines [loop1,loop2].z:=y [loop1,loop2,3];
 +    END;
 +  Whizz (TRUE);
 +
 +  For loop1:=1 to maxpolys do
 +    For loop2:=1 to 4 do BEGIN
 +      Lines [loop1,loop2].x:=x [loop1,loop2,1];
 +      Lines [loop1,loop2].y:=x [loop1,loop2,2];
 +      Lines [loop1,loop2].z:=x [loop1,loop2,3];
 +    END;
 +  Whizz (FALSE);
 +
 +  For loop1:=1 to maxpolys do
 +    For loop2:=1 to 4 do BEGIN
 +      Lines [loop1,loop2].x:=i [loop1,loop2,1];
 +      Lines [loop1,loop2].y:=i [loop1,loop2,2];
 +      Lines [loop1,loop2].z:=i [loop1,loop2,3];
 +    END;
 +  Whizz (TRUE);
 +
 +  For loop1:=1 to maxpolys do
 +    For loop2:=1 to 4 do BEGIN
 +      Lines [loop1,loop2].x:=a [loop1,loop2,1];
 +      Lines [loop1,loop2].y:=a [loop1,loop2,2];
 +      Lines [loop1,loop2].z:=a [loop1,loop2,3];
 +    END;
 +  Whizz (FALSE);
 +
 +  cls (vaddr,0);
 +  cls (vga,0);
 +  Xoff := 160;
 +
 +  Repeat
 +    if keypressed then BEGIN
 +      ch:=upcase (Readkey);
 +      Case ch of 'A' : zoff:=zoff+5;
 +                 'Z' : zoff:=zoff-5;
 +                 ',' : xoff:=xoff-5;
 +                 '.' : xoff:=xoff+5;
 +                 'S' : yoff:=yoff-5;
 +                 'X' : yoff:=yoff+5;
 +      END;
 +    END;
 +    DrawPoints;
 +    flip (vaddr,vga);
 +    cls (vaddr,0);
 +    RotatePoints (deg,deg,deg);
 +    deg:=(deg+5) mod 360;
 +  Until ch=#27;
 +END;
 +
 +
 +BEGIN
 +  SetUpVirtual;
 +  clrscr;
 +  Writeln ('Hello there! Varsity has begun once again, so it is once again');
 +  Writeln ('back to the grindstone ;-) ... anyway, this tutorial is, by');
 +  Writeln ('popular demand, on poly-filling, in relation to 3-D solids.');
 +  Writeln;
 +  Writeln ('In this program, the letters of ASPHYXIA will fly past you. As you');
 +  Writeln ('will see, they are solid, not wireframe. After the last letter has');
 +  Writeln ('flown by, a large A will be left in the middle of the screen.');
 +  Writeln;
 +  Writeln ('You will be able to move it around the screen, and you will notice');
 +  Writeln ('that it may have bits only half on the screen, i.e. clipping is');
 +  Writeln ('perfomed. To control it use the following : "A" and "Z" control the Z');
 +  Writeln ('movement, "," and "." control the X movement, and "S" and "X"');
 +  Writeln ('control the Y movement. I have not included rotation control, but');
 +  Writeln ('it should be easy enough to put in yourself ... if you have any');
 +  Writeln ('hassles, leave me mail.');
 +  Writeln;
 +  Writeln ('I hope this is what you wanted...leave me mail for new ideas.');
 +  writeln;
 +  writeln;
 +  Write ('  Hit any key to contine ...');
 +  Readkey;
 +  SetMCGA;
 +  SetUpPoints;
 +  MoveAround;
 +  SetText;
 +  ShutDown;
 +  Writeln ('All done. This concludes the ninth 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 am also an avid');
 +  Writeln ('Connectix BBS user, and occasionally read RSAProg.');
 +  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 ('I hope to hear from you soon!');
 +  Writeln; Writeln;
 +  Write   ('Hit any key to exit ...');
 +  Readkey;
 +END.
 +</code>
 +
 +=== C ===
 +
 +<code c file:tut9.cpp>
 +/////////////////////////////////////////////////////////////////////////////
 +//                                                                         //
 +// TUTPROG9.CPP - VGA Trainer Program 9 (in Turbo C++ 3.0)                 //
 +//                                                                         //
 +// "The VGA Trainer Program" is written by Denthor of Asphyxia. However it //
 +// was limited to only Pascal in its first run.  All I have done is taken  //
 +// his original release, translated it to C++ and touched up a few things. //
 +// I take absolutely no credit for the concepts presented in this code.    //
 +//                                                                         //
 +// Program Notes : This program demonstrates polygon moving and rotation.  //
 +//                                                                         //
 +//                 If you are compiling this program from within the       //
 +//                 Turbo C++ environment, you must go under Options,       //
 +//                 Debugger, and change the "Program Heap Size" to a value //
 +//                 80 or greater.  If you are going to be fooling around   //
 +//                 with the code a bit, I suggest raising this to about    //
 +//                 100 just to be on the safe side.  You don't have to     //
 +//                 worry about this if you are compiling command line.     //
 +//                                                                         //
 +//                 Just for reference, this is what I use:                 //
 +//                                                                         //
 +//                    tcc -mc -a -G -2 -O tut9.cpp                         //
 +//                                                                         //
 +//                 The way things are set up, there is no need to compile  //
 +//                 or link tut9.cpp and gfx2.cpp seperately.               //
 +//                                                                         //
 +//                 The Compact memory model (-mc) seems to provide the     //
 +//                 best results for this tutorial.  Remember, use this     //
 +//                 memory model when you have little code (less than 64k)  //
 +//                 and lots of data.                                       //
 +//                                                                         //
 +// Author        : Grant Smith (Denthor) - denthor@beastie.cs.und.ac.za    //
 +// Translator    : Christopher G. Mann   - r3cgm@dax.cc.uakron.edu         //
 +//                                                                         //
 +// Last Modified : January 21, 1995                                        //
 +//                                                                         //
 +/////////////////////////////////////////////////////////////////////////////
 +
 +//               //
 +// INCLUDE FILES //
 +//               //
 +
 +  #include <conio.h>
 +                             // clrscr(), getch(), kbhit()
 +  #include <iostream.h>
 +                             // cout()
 +  #include <math.h>
 +                             // sin(), cos()
 +  #include <stdlib.h>
 +                             // exit()
 +  #include "gfx2.cpp"
 +                             // our graphics library tools
 +
 +//          //
 +// TYPEDEFS //
 +//          //
 +
 +  typedef unsigned char byte;
 +  typedef unsigned int  word;
 +
 +//           //
 +// CONSTANTS //
 +//           //
 +
 +  const MAXPOLYS   = 5;
 +  const POLYPOINTS = 4;
 +  const POLYCORDS  = 3;
 +
 +//             //
 +// LETTER DATA //
 +//             //
 +
 +  // The 3-D coordinates of our object ... stored as {X1,Y1,Z1},
 +  // {X2,Y2,Z2} ... for the 4 points of a poly.
 +  const int A[MAXPOLYS][POLYPOINTS][POLYCORDS] =
 +            { {{-10, 10, 0},{ -2,-10, 0},{ 0,-10, 0},{ -5,10, 0}},   // 1
 +              {{ 10, 10, 0},{  2,-10, 0},{ 0,-10, 0},{  5,10, 0}},   // 2
 +              {{ -2,-10, 0},{  2,-10, 0},{ 2, -5, 0},{ -2,-5, 0}},   // 3
 +              {{ -6,  0, 0},{  6,  0, 0},{ 7,  5, 0},{ -7, 5, 0}},   // 4
 +              {{  0,  0, 0},{  0,  0, 0},{ 0,  0, 0},{  0, 0, 0}} }; // 5
 +
 +  //                             1----1    +    2----2
 +  //                             |....|    |    |....|
 +  //                             |....|    |    |....|
 +  //                             `....`    |    '....'
 +  //                              |....|     |....|
 +  //                              `.4------+------4.'
 +  //                               ||......|......||
 +  //                               ``......|......''
 +  //                                ||.....|.....||
 +  //                                ||.....|.....||
 +  //                      -------+---4+----+----+4---+-------
 +  //                                 |...| | |...|
 +  //                                 `...` | '...'
 +  //                                  |...|||...|
 +  //                                   |...|...|
 +  //                                   |.3-+-3.|
 +  //                                   `.|.|.|.'
 +  //                                    ||.|.||
 +  //                                    ||.|.||
 +  //                                    `|.|.|'
 +  //                                     3-2-3
 +
 +  const int S[MAXPOLYS][POLYPOINTS][POLYCORDS] =
 +            { {{-10,-10, 0},{ 10,-10, 0},{10, -7, 0},{-10, -7, 0}},
 +              {{-10, 10, 0},{ 10, 10, 0},{10,  7, 0},{-10,  7, 0}},
 +              {{-10,  1, 0},{ 10,  1, 0},{10, -2, 0},{-10, -2, 0}},
 +              {{-10, -8, 0},{ -7, -8, 0},{-7,  0, 0},{-10,  0, 0}},
 +              {{ 10,  8, 0},{  7,  8, 0},{ 7,  0, 0},{ 10,  0, 0}} };
 +
 +  const int P[MAXPOLYS][POLYPOINTS][POLYCORDS] =
 +            { {{-10,-10,0},{-7,-10,0},{-7,10,0},{-10,10,0}},
 +              {{10,-10,0},{7,-10,0},{7,0,0},{10,0,0}},
 +              {{-9,-10,0},{9,-10,0},{9,-7,0},{-9,-7,0}},
 +              {{-9,-1,0},{9,-1,0},{9,2,0},{-9,2,0}},
 +              {{0,0,0},{0,0,0},{0,0,0},{0,0,0}} };
 +
 +  const int H[MAXPOLYS][POLYPOINTS][POLYCORDS] =
 +            { {{-10,-10,0},{-7,-10,0},{-7,10,0},{-10,10,0}},
 +              {{10,-10,0},{7,-10,0},{7,10,0},{10,10,0}},
 +              {{-9,-1,0},{9,-1,0},{9,2,0},{-9,2,0}},
 +              {{0,0,0},{0,0,0},{0,0,0},{0,0,0}},
 +              {{0,0,0},{0,0,0},{0,0,0},{0,0,0}} };
 +
 +  const int Y[MAXPOLYS][POLYPOINTS][POLYCORDS] =
 +            { {{-7,-10,0},{0,-3,0},{0,0,0},{-10,-7,0}},
 +              {{7,-10,0},{0,-3,0},{0,0,0},{10,-7,0}},
 +              {{-2,-3,0},{2,-3,0},{2,10,0},{-2,10,0}},
 +              {{0,0,0},{0,0,0},{0,0,0},{0,0,0}},
 +              {{0,0,0},{0,0,0},{0,0,0},{0,0,0}} };
 +
 +  const int X[MAXPOLYS][POLYPOINTS][POLYCORDS] =
 +            { {{-7,-10,0},{10,7,0},{7,10,0},{-10,-7,0}},
 +              {{7,-10,0},{-10,7,0},{-7,10,0},{10,-7,0}},
 +              {{0,0,0},{0,0,0},{0,0,0},{0,0,0}},
 +              {{0,0,0},{0,0,0},{0,0,0},{0,0,0}},
 +              {{0,0,0},{0,0,0},{0,0,0},{0,0,0}} };
 +
 +  const int I[MAXPOLYS][POLYPOINTS][POLYCORDS] =
 +            { {{-10,-10,0},{10,-10,0},{10,-7,0},{-10,-7,0}},
 +              {{-10,10,0},{10,10,0},{10,7,0},{-10,7,0}},
 +              {{-2,-9,0},{2,-9,0},{2,9,0},{-2,9,0}},
 +              {{0,0,0},{0,0,0},{0,0,0},{0,0,0}},
 +              {{0,0,0},{0,0,0},{0,0,0},{0,0,0}} };
 +
 +//                     //
 +// FUNCTION PROTOTYPES //
 +//                     //
 +
 +  void DrawPoly     (int x1, int y1, int x2, int y2,
 +                     int x3, int y3, int x4, int y4,
 +                     byte Col, word Where);
 +  void SetUpPoints  ();
 +  void RotatePoints (int X, int Y, int Z);
 +  void DrawPoints   ();
 +  void Whizz        (int sub, int &deg);
 +  void MoveAround   ();
 +
 +//            //
 +// STRUCTURES //
 +//            //
 +
 +  // The data for every point we rotate
 +  struct Point {
 +    float x;
 +    float y;
 +    float z;
 +  };
 +
 +//                              //
 +// GLOBAL VARIABLE DECLARATIONS //
 +//                              //
 +
 +  byte far *Virscr=NULL;           // Pointer to our virtual screen
 +  word Vaddr;                      // Segment of our virtual screen
 +  float Lookup[360][2];            // Our sin and cos lookup tables
 +  int Xoff, Yoff, Zoff;            // Used for movement of the object
 +  Point Lines[MAXPOLYS][4];        // The base object being rotated
 +  Point Translated[MAXPOLYS][4];   // The rotated object
 +
 +
 +///////////////////////////////////////////////////////////////////////////////
 +//                                                                           //
 +//                                MAIN FUNCTION                              //
 +//                                                                           //
 +///////////////////////////////////////////////////////////////////////////////
 +
 +void main() {
 +
 +  SetUpVirtual(Virscr,Vaddr);
 +  // always check to see if enough memory was allocated
 +  if (Virscr == NULL) {
 +    SetText();
 +    cout << "Insufficient memory for virtual screens, exiting...";
 +    exit(1);
 +  }
 +
 +  clrscr();
 +  cout
 +    << "Hello there! Varsity has begun once again, so it is once again\n"
 +    << "back to the grindstone ;-) ... anyway, this tutorial is, by\n"
 +    << "popular demand, on poly-filling, in relation to 3-D solids.\n\n"
 +    << "In this program, the letters of ASPHYXIA will fly past you. As you\n"
 +    << "will see, they are solid, not wireframe. After the last letter has\n"
 +    << "flown by, a large A will be left in the middle of the screen.\n\n"
 +    << "You will be able to move it around the screen, and you will notice\n"
 +    << "that it may have bits only half on the screen, i.e. clipping is\n"
 +    << "perfomed. To control it use the following : ""A"" and ""Z"" control the Z\n"
 +    << "movement, "","" and ""."" control the X movement, and ""S"" and ""X""\n"
 +    << "control the Y movement. I have not included rotation control, but\n"
 +    << "it should be easy enough to put in yourself ... if you have any\n"
 +    << "hassles, leave me mail.\n\n";
 +  cout << "Hit any key to continue ...\n";
 +  getch();
 +  SetMCGA();
 +
 +  SetUpPoints();
 +
 +  MoveAround();
 +  SetText();
 +
 +  ShutDown(Virscr);
 +
 +  cout
 +    << "All done. This concludes the ninth sample program in the ASPHYXIA\n"
 +    << "Training series. You may reach DENTHOR under the names of GRANT\n"
 +    << "SMITH/DENTHOR/ASPHYXIA on the ASPHYXIA BBS. I am also an avid\n"
 +    << "Connectix BBS user, and occasionally read RSAProg.\n"
 +    << "The numbers are available in the main text. You may also write to me at:\n"
 +    << "             Grant Smith\n"
 +    << "             P.O. Box 270\n"
 +    << "             Kloof\n"
 +    << "             3640\n"
 +    << "I hope to hear from you soon!\n\n";
 +  cout << "Hit any key to exit ...\n";
 +  getch();
 +
 +}
 +
 +
 +/////////////////////////////////////////////////////////////////////////////
 +//                                                                         //
 +// DrawPoly() - This draws a polygon with 4 points at x1,y1, x2,y2, x3,y3, //
 +//              x4,y4 in color Col at location Where                       //
 +//                                                                         //
 +/////////////////////////////////////////////////////////////////////////////
 +
 +void DrawPoly(int x1, int y1, int x2, int y2, int x3, int y3, int x4, int y4,
 +              byte Col, word Where) {
 +
 +  int x, mny, mxy, mnx, mxx, yc;
 +  int mul1, div1, mul2, div2, mul3, div3, mul4, div4;
 +
 +  // find the maximum y (mny) and minimum y (mny)
 +              mny = y1;
 +              mxy = y1;
 +  if (y2<mny) mny = y2;
 +  if (y2>mxy) mxy = y2;
 +  if (y3<mny) mny = y3;
 +  if (y3>mxy) mxy = y3;
 +  if (y4<mny) mny = y4;
 +  if (y4>mxy) mxy = y4;
 +
 +  // if the mimimum or maximum is out of bounds, bring it back in
 +  if (mny<  0) mny =   0;
 +  if (mxy>199) mxy = 199;
 +
 +  // verticle range checking
 +  if (mny>199) return;
 +  if (mxy<  0) return;
 +
 +  // constants needed for intersection calculations
 +  mul1 = x1-x4;  div1 = y1-y4;
 +  mul2 = x2-x1;  div2 = y2-y1;
 +  mul3 = x3-x2;  div3 = y3-y2;
 +  mul4 = x4-x3;  div4 = y4-y3;
 +
 +  for (yc=mny; yc<mxy; yc++) {
 +    mnx = 320;
 +    mxx =  -1;
 +
 +    if ((y4 >= yc) || (y1 >= yc))
 +      if ((y4 <= yc) || (y1 <= yc))
 +        if (y4 != y1) {
 +          x = ((yc-y4) * mul1 / div1) + x4;
 +          if (x<mnx) mnx = x;
 +          if (x>mxx) mxx = x;
 +        }
 +
 +    if ((y1 >= yc) || (y2 >= yc))
 +      if ((y1 <= yc) || (y2 <= yc))
 +        if (y1 != y2) {
 +          x = ((yc-y1) * mul2 / div2) + x1;
 +          if (x<mnx) mnx = x;
 +          if (x>mxx) mxx = x;
 +        }
 +
 +    if ((y2 >= yc) || (y3 >= yc))
 +      if ((y2 <= yc) || (y3 <= yc))
 +        if (y2 != y3) {
 +          x = ((yc-y2) * mul3 / div3) + x2;
 +          if (x<mnx) mnx = x;
 +          if (x>mxx) mxx = x;
 +        }
 +
 +    if ((y3 >= yc) || (y4 >= yc))
 +      if ((y3 <= yc) || (y4 <= yc))
 +        if (y3 != y4) {
 +          x = ((yc-y3) * mul4 / div4) + x3;
 +          if (x<mnx) mnx = x;
 +          if (x>mxx) mxx = x;
 +        }
 +
 +    // horizontal range checking
 +    if (mnx<  0)  mnx =   0;
 +    if (mxx>319)  mxx = 319;
 +
 +    if (mnx<=mxx)
 +      // draw the horizontal line
 +      Hline(mnx,mxx,yc,Col,Where);
 +
 +  }
 +}
 +
 +/////////////////////////////////////////////////////////////////////////////
 +//                                                                         //
 +// SetUpPoints() - This creates the lookup table.                          //
 +//                                                                         //
 +/////////////////////////////////////////////////////////////////////////////
 +
 +void SetUpPoints() {
 +
 +  int loop1;
 +
 +  // generate the sin() and cos() tables
 +  for (loop1=0; loop1<360; loop1++) {
 +    Lookup [loop1][0] = sin(rad(loop1));
 +    Lookup [loop1][1] = cos(rad(loop1));
 +  }
 +}
 +
 +/////////////////////////////////////////////////////////////////////////////
 +//                                                                         //
 +// RotatePoints() - This rotates object lines by X,Y and Z, then places    //
 +//                  the result in Translated[]                             //
 +//                                                                         //
 +/////////////////////////////////////////////////////////////////////////////
 +
 +void RotatePoints(int X, int Y, int Z) {
 +
 +  int loop1, loop2;
 +  Point temp;
 +
 +  for (loop1=0; loop1<MAXPOLYS; loop1++) {
 +    for (loop2=0; loop2<4; loop2++) {
 +      temp.x = Lines[loop1][loop2].x;
 +      temp.y = Lookup[X][1] * Lines[loop1][loop2].y - Lookup[X][0] * Lines[loop1][loop2].z;
 +      temp.z = Lookup[X][0] * Lines[loop1][loop2].y + Lookup[X][1] * Lines[loop1][loop2].z;
 +      Translated[loop1][loop2] = temp;
 +
 +      if (Y>0) {
 +        temp.x = Lookup[Y][1] * Translated[loop1][loop2].x - Lookup[Y][0] * Translated[loop1][loop2].y;
 +        temp.y = Lookup[Y][0] * Translated[loop1][loop2].x + Lookup[Y][1] * Translated[loop1][loop2].y;
 +        temp.z = Translated[loop1][loop2].z;
 +        Translated[loop1][loop2] = temp;
 +      }
 +
 +      if (Z>0) {
 +        temp.x = Lookup[Z][1] * Translated[loop1][loop2].x + Lookup[Z][0] * Translated[loop1][loop2].z;
 +        temp.y = Translated[loop1][loop2].y;
 +        temp.z = Lookup[Z][0] * Translated[loop1][loop2].x + Lookup[Z][1] * Translated[loop1][loop2].z;
 +        Translated[loop1][loop2] = temp;
 +      }
 +    }
 +  }
 +}
 +
 +/////////////////////////////////////////////////////////////////////////////
 +//                                                                         //
 +// DrawPoints() - This draws the translated object to the virtual screen.  //
 +//                                                                         //
 +/////////////////////////////////////////////////////////////////////////////
 +
 +void DrawPoints() {
 +
 +  int nx, ny, nx2, ny2, nx3, ny3, nx4, ny4, temp, loop1;
 +
 +  for (loop1=0; loop1<MAXPOLYS; loop1++) {
 +    if ((Translated[loop1][0].z+Zoff<0) && (Translated[loop1][1].z+Zoff<0) &&
 +        (Translated[loop1][2].z+Zoff<0) && (Translated[loop1][4].z+Zoff<0)) {
 +
 +      temp = Translated[loop1][0].z + Zoff;
 +      nx   = ((256*Translated[loop1][0].x) / temp) + Xoff;
 +      ny   = ((256*Translated[loop1][0].y) / temp) + Yoff;
 +
 +      temp = Translated[loop1][1].z + Zoff;
 +      nx2  = ((256*Translated[loop1][1].x) / temp) + Xoff;
 +      ny2  = ((256*Translated[loop1][1].y) / temp) + Yoff;
 +
 +      temp = Translated[loop1][2].z + Zoff;
 +      nx3  = ((256*Translated[loop1][2].x) / temp) + Xoff;
 +      ny3  = ((256*Translated[loop1][2].y) / temp) + Yoff;
 +
 +      temp = Translated[loop1][3].z + Zoff;
 +      nx4  = ((256*Translated[loop1][3].x) / temp) + Xoff;
 +      ny4  = ((256*Translated[loop1][3].y) / temp) + Yoff;
 +
 +      DrawPoly(nx,ny,nx2,ny2,nx3,ny3,nx4,ny4,13,Vaddr);
 +    }
 +  }
 +}
 +
 +/////////////////////////////////////////////////////////////////////////////
 +//                                                                         //
 +// Whizz() - This function moves the letters from one side of the screen   //
 +//           to the other and also zooms them closer as they move.         //
 +//                                                                         //
 +/////////////////////////////////////////////////////////////////////////////
 +
 +void Whizz(int sub, int &deg) {
 +
 +  int loop1;
 +
 +  for (loop1=(-64); loop1<(-4); loop1++) {
 +
 +    Zoff = (loop1 * 8) - 15;
 +    if (sub == 1) Xoff -= 7; else Xoff += 7;
 +    RotatePoints(deg,deg,deg);
 +    DrawPoints();
 +    Flip(Vaddr,VGA);
 +    Cls(0,Vaddr);
 +    deg = (deg + 5) % 360;
 +  }
 +}
 +
 +/////////////////////////////////////////////////////////////////////////////
 +//                                                                         //
 +// MoveAround() - This is the main display function.  First it brings the  //
 +//                object towards the viewer by increasing the Zoff, then   //
 +//                it passes control to the user.                           //
 +//                                                                         //
 +/////////////////////////////////////////////////////////////////////////////
 +
 +void MoveAround() {
 +
 +  int deg=0, loop1, loop2;
 +  byte ch=1; // assign a dummy value to ch
 +
 +  Yoff = 100;
 +  Xoff = 350;
 +  Cls(0,Vaddr);
 +
 +  for (loop1=0; loop1<MAXPOLYS; loop1++)
 +    for (loop2=0; loop2<POLYPOINTS; loop2++) {
 +      Lines[loop1][loop2].x = A[loop1][loop2][0];
 +      Lines[loop1][loop2].y = A[loop1][loop2][1];
 +      Lines[loop1][loop2].z = A[loop1][loop2][2];
 +    }
 +  Whizz(1,deg);
 +
 +  for (loop1=0; loop1<MAXPOLYS; loop1++)
 +    for (loop2=0; loop2<POLYPOINTS; loop2++) {
 +      Lines[loop1][loop2].x = S[loop1][loop2][0];
 +      Lines[loop1][loop2].y = S[loop1][loop2][1];
 +      Lines[loop1][loop2].z = S[loop1][loop2][2];
 +    }
 +  Whizz(0,deg);
 +
 +  for (loop1=0; loop1<MAXPOLYS; loop1++)
 +    for (loop2=0; loop2<POLYPOINTS; loop2++) {
 +      Lines[loop1][loop2].x = P[loop1][loop2][0];
 +      Lines[loop1][loop2].y = P[loop1][loop2][1];
 +      Lines[loop1][loop2].z = P[loop1][loop2][2];
 +    }
 +  Whizz(1,deg);
 +
 +  for (loop1=0; loop1<MAXPOLYS; loop1++)
 +    for (loop2=0; loop2<POLYPOINTS; loop2++) {
 +      Lines[loop1][loop2].x = H[loop1][loop2][0];
 +      Lines[loop1][loop2].y = H[loop1][loop2][1];
 +      Lines[loop1][loop2].z = H[loop1][loop2][2];
 +    }
 +  Whizz(0,deg);
 +
 +  for (loop1=0; loop1<MAXPOLYS; loop1++)
 +    for (loop2=0; loop2<POLYPOINTS; loop2++) {
 +      Lines[loop1][loop2].x = Y[loop1][loop2][0];
 +      Lines[loop1][loop2].y = Y[loop1][loop2][1];
 +      Lines[loop1][loop2].z = Y[loop1][loop2][2];
 +    }
 +  Whizz(1,deg);
 +
 +  for (loop1=0; loop1<MAXPOLYS; loop1++)
 +    for (loop2=0; loop2<POLYPOINTS; loop2++) {
 +      Lines[loop1][loop2].x = X[loop1][loop2][0];
 +      Lines[loop1][loop2].y = X[loop1][loop2][1];
 +      Lines[loop1][loop2].z = X[loop1][loop2][2];
 +    }
 +  Whizz(0,deg);
 +
 +  for (loop1=0; loop1<MAXPOLYS; loop1++)
 +    for (loop2=0; loop2<POLYPOINTS; loop2++) {
 +      Lines[loop1][loop2].x = I[loop1][loop2][0];
 +      Lines[loop1][loop2].y = I[loop1][loop2][1];
 +      Lines[loop1][loop2].z = I[loop1][loop2][2];
 +    }
 +  Whizz(1,deg);
 +
 +  for (loop1=0; loop1<MAXPOLYS; loop1++)
 +    for (loop2=0; loop2<POLYPOINTS; loop2++) {
 +      Lines[loop1][loop2].x = A[loop1][loop2][0];
 +      Lines[loop1][loop2].y = A[loop1][loop2][1];
 +      Lines[loop1][loop2].z = A[loop1][loop2][2];
 +    }
 +  Whizz(0,deg);
 +
 +  Cls(0,Vaddr);
 +  Cls(0,VGA);
 +
 +  Xoff = 160;
 +
 +  do {
 +    if (kbhit()) {
 +      ch = getch();
 +      switch (ch) {
 +        case 'A': case 'a': Zoff += 5; break;  // away
 +        case 'Z': case 'z': Zoff -= 5; break;  // toward
 +        case ',':           Xoff -= 5; break;  // left
 +        case '.':           Xoff += 5; break;  // right
 +        case 'S': case 's': Yoff -= 5; break;  // down
 +        case 'X': case 'x': Yoff += 5; break;  // up
 +      }
 +    }
 +    DrawPoints();
 +    Flip(Vaddr,VGA);
 +    Cls(0,Vaddr);
 +    RotatePoints(deg,deg,deg);
 +    deg = (deg + 5) % 360;
 +
 +    // if the key pressed above was 0 (i.e. a control character) then
 +    // read the character code
 +    if (ch == 0) ch = getch();
 +
 +  } while (ch != 27); // if the escape code was 27 (escape key) then exit
 +
 +}
 +</code>
 +
 +<code c file:gfx2.cpp>
 +/////////////////////////////////////////////////////////////////////////////
 +//                                                                         //
 +// GFX2.CPP - VGA Trainer Program secondary module containing graphics     //
 +//            functions.  Note: This module does not follow a lot of good  //
 +//            programming practices.  It was built to be used with the     //
 +//            VGA tutorial series.  If you are planning on using this      //
 +//            module with a different source file, some modifications may  //
 +//            be necessary.                                                //
 +//                                                                         //
 +// Author        : Grant Smith (Denthor) - denthor@beastie.cs.und.ac.za    //
 +// Translator    : Christopher G. Mann   - r3cgm@dax.cc.uakron.edu         //
 +//                                                                         //
 +// Last Modified : January 21, 1995                                        //
 +//                                                                         //
 +/////////////////////////////////////////////////////////////////////////////
 +
 +//               //
 +// INCLUDE FILES //
 +//               //
 +
 +  #include <alloc.h>
 +                           // farcalloc(), farfree()
 +  #include <dos.h>
 +                           // geninterrupt(), FP_SEG
 +
 +//         //
 +// DEFINES //
 +//         //
 +
 +  #if !defined(PI)
 +    #define PI 3.1415927
 +  #endif
 +
 +  #if !defined(VGA)
 +    #define VGA 0xA000
 +  #endif
 +
 +//          //
 +// TYPEDEFS //
 +//          //
 +
 +  typedef unsigned char byte;
 +  typedef unsigned int  word;
 +
 +//                     //
 +// FUNCTION PROTOTYPES //
 +//                     //
 +
 +  // VIRTUAL SCREEN FUNCTIONS
 +  void  SetUpVirtual(byte far *&Virscr, word &Vaddr);
 +  void  ShutDown    (byte far *&Virscr);
 +  void  Cls         (byte Col, word Where);
 +  void  Flip        (word source, word dest);
 +
 +  // MODE SETTING FUNCTIONS
 +  void  SetMCGA     ();
 +  void  SetText     ();
 +
 +  // PALLETTE CLASS (DATA OBJECT AND RELATED FUNCTIONS)
 +  class Pal {
 +    public:
 +      Pal();
 +      void PalSet   (byte Rset, byte Gset, byte Bset);
 +      void PalGet   (byte Col);
 +      void PalPut   (byte Col);
 +      void PalInc   ();
 +      void PalDec   ();
 +    private:
 +      byte R;   // 0-63
 +      byte G;   // 0-63
 +      byte B;   // 0-63
 +  };
 +
 +  // MATH-LIKE FUNCTIONS
 +  float rad         (float theta);
 +  int   sgn         (int a);
 +
 +  template<class T>
 +  T abso(T value) {  if (value >= 0) return value;  else return -value; }
 +
 +  // DRAWING FUNCTIONS
 +  void  Putpixel    (word X, word Y, byte Col, word Where);
 +  void  PutpixelVGA (word X, word Y, byte Col);
 +  void  Line        (int a, int b, int c, int  d, int col, word Where);
 +  void  Hline       (word X1, word X2, word Y, byte Col, word Where);
 +
 +
 +//-------------------------VIRTUAL SCREEN FUNCTIONS------------------------//
 +
 +/////////////////////////////////////////////////////////////////////////////
 +//                                                                         //
 +// SetUpVirtual() - This sets up the memory needed for a virtual screen.   //
 +//                                                                         //
 +/////////////////////////////////////////////////////////////////////////////
 +
 +void SetUpVirtual(byte far *&Virscr, word &Vaddr) {
 +  Virscr = (byte far *) farcalloc(64000,1);
 +  Vaddr = FP_SEG(Virscr);
 +}
 +
 +/////////////////////////////////////////////////////////////////////////////
 +//                                                                         //
 +// ShutDown() - This frees the memory used by a virtual screen.            //
 +//                                                                         //
 +/////////////////////////////////////////////////////////////////////////////
 +
 +void ShutDown(byte far *&Virscr) {
 +  farfree(Virscr);
 +}
 +
 +/////////////////////////////////////////////////////////////////////////////
 +//                                                                         //
 +// Cls() - This clears the screen at Where to color Col.                   //
 +//                                                                         //
 +/////////////////////////////////////////////////////////////////////////////
 +
 +void Cls(byte Col, word Where) {
 +  asm {
 +    push    es           // save ES
 +    mov     cx, 32000    // this is our loop counter.  we want to clear
 +                         //   64000 bytes of memory, so why do we use 32000?
 +                         //   1 word = 2 bytes, and we are moving a word at
 +                         //   a time
 +    mov     es, [Where]  // move address in Where to ES
 +    xor     di, di       // zero out DI
 +    mov     al, [Col]    // move color to AL
 +    mov     ah, al       // move color to AH (Remember, will be moving
 +                         //   a WORDS, so we need two copies
 +    rep     stosw        // copy AX to Where and drecrement CX by 1
 +                         //   until CX equals 0
 +    pop     es           // restore ES
 +  }
 +}
 +
 +/////////////////////////////////////////////////////////////////////////////
 +//                                                                         //
 +// Flip() - This copies 64000 bytes from "source" to "destination"       //
 +//                                                                         //
 +/////////////////////////////////////////////////////////////////////////////
 +
 +void Flip(word source, word dest) {
 +  asm {
 +    push    ds           // save DS
 +    mov     ax, [dest]   // copy segment of destination to AX
 +    mov     es, ax       // set ES to point to destination
 +    mov     ax, [source] // copy segment of source to AX
 +    mov     ds, ax       // set DS to point to source
 +    xor     si, si       // zero out SI
 +    xor     di, di       // zero out DI
 +    mov     cx, 32000    // set our counter to 32000
 +    rep     movsw        // move source to destination by words.  decrement
 +                         //   CX by 1 each time until CX is 0
 +    pop     ds           // restore DS
 +  }
 +}
 +
 +
 +//--------------------------MODE SETTING FUNCTIONS-------------------------//
 +
 +/////////////////////////////////////////////////////////////////////////////
 +//                                                                         //
 +// SetMCGA() - This function gets you into 320x200x256 mode.               //
 +//                                                                         //
 +/////////////////////////////////////////////////////////////////////////////
 +
 +void SetMCGA() {
 +  _AX = 0x0013;
 +  geninterrupt (0x10);
 +}
 +
 +/////////////////////////////////////////////////////////////////////////////
 +//                                                                         //
 +// SetText() - This function gets you into text mode.                      //
 +//                                                                         //
 +/////////////////////////////////////////////////////////////////////////////
 +
 +void SetText() {
 +  _AX = 0x0003;
 +  geninterrupt (0x10);
 +}
 +
 +
 +//----------------------------PALLETTE FUNCTIONS---------------------------//
 +
 +/////////////////////////////////////////////////////////////////////////////
 +//                                                                         //
 +// Pal() - This constructor initializes all Pal variables (R, G, and B) to //
 +//         zero.  This ensures that all Pal objects start in a consistent  //
 +//         state.                                                          //
 +//                                                                         //
 +/////////////////////////////////////////////////////////////////////////////
 +
 +Pal::Pal() { R = B = G = 0; }
 +
 +/////////////////////////////////////////////////////////////////////////////
 +//                                                                         //
 +// PalSet() - This sets the Red, Green, and Blue values of a given color.  //
 +//            Set invalid colors ( >63 ) equal to 0.                       //
 +//                                                                         //
 +/////////////////////////////////////////////////////////////////////////////
 +
 +void Pal::PalSet(byte Rset, byte Gset, byte Bset) {
 +
 +   R = (Rset < 64) ? Rset : 0;
 +   G = (Gset < 64) ? Gset : 0;
 +   B = (Bset < 64) ? Bset : 0;
 +
 +}
 +
 +/////////////////////////////////////////////////////////////////////////////
 +//                                                                         //
 +// PalGet() - This reads the values of the Red, Green, and Blue values of  //
 +//            a certain color.                                             //
 +//                                                                         //
 +/////////////////////////////////////////////////////////////////////////////
 +
 +void Pal::PalGet(byte Col) {
 +
 +  byte Rtemp, Gtemp, Btemp;
 +
 +  asm {
 +    mov     dx, 0x03C7   // load DX with 3C7 (read pallette function)
 +    mov     al, [Col]    // move color to AL
 +    out     dx, al       // write DX to the VGA (tell VGA that we want to
 +                         //   work with the color in AL
 +    add     dx, 2        // load DX with 3C9 (read RGB colors)
 +    in      al, dx       // read Red   to AL
 +    mov     [Rtemp],al   // copy AL to rr
 +    in      al, dx       // read Green to AL
 +    mov     [Gtemp],al   // copy AL to gg
 +    in      al, dx       // read Blue  to AL
 +    mov     [Btemp],al   // copy AL to bb
 +  }
 +
 +  R = Rtemp;
 +  G = Gtemp;
 +  B = Btemp;
 +
 +}
 +
 +/////////////////////////////////////////////////////////////////////////////
 +//                                                                         //
 +// PalPut() - This sets the Red, Green, and Blue values of a color.        //
 +//                                                                         //
 +/////////////////////////////////////////////////////////////////////////////
 +
 +void Pal::PalPut (byte Col) {
 +
 +  byte Rtemp = R, Gtemp = G, Btemp = B;
 +
 +  asm {
 +    mov     dx, 0x3C8    // load DX with 3C8 (write pallette function)
 +    mov     al, [Col]    // move color to AL
 +    out     dx, al       // write DX to the VGA (tell VGA that we want to
 +                         //   work with the color in AL
 +    inc     dx           // load DX with 3C9 (write RGB colors)
 +    mov     al, [Rtemp]  // move Red   to AL
 +    out     dx, al       // write DX to VGA (tell VGA that we want to use
 +                         //   the Red value in AL
 +    mov     al, [Gtemp]  // move Green to AL
 +    out     dx, al       // write DX to VGA
 +    mov     al, [Btemp]  // move Blue  to AL
 +    out     dx, al       // write DX to VGA
 +  }
 +}
 +
 +/////////////////////////////////////////////////////////////////////////////
 +//                                                                         //
 +// PalInc() - This increments the R, G, and B values of a given Pal        //
 +//            variable, keeping all values less than 64.                   //
 +//                                                                         //
 +/////////////////////////////////////////////////////////////////////////////
 +
 +void Pal::PalInc() {
 +
 +  // if (R < 63) R = R + 1; else R = 63;
 +  R = (R < 63) ? (R + 1) : 63;
 +  G = (G < 63) ? (G + 1) : 63;
 +  B = (B < 63) ? (B + 1) : 63;
 +
 +}
 +
 +/////////////////////////////////////////////////////////////////////////////
 +//                                                                         //
 +// PalDec() - This decrements the R, G, and B values of a given Pal        //
 +//            variable, keeping all values greater than or equal to zero.  //
 +//                                                                         //
 +/////////////////////////////////////////////////////////////////////////////
 +
 +void Pal::PalDec() {
 +
 +  // if (R > 0) R = R - 1; else R = 0;
 +  R = (R > 0) ? (R - 1) : 0;
 +  G = (G > 0) ? (G - 1) : 0;
 +  B = (B > 0) ? (B - 1) : 0;
 +
 +}
 +
 +
 +//----------------------------MATH-LIKE FUNCTIONS--------------------------//
 +
 +/////////////////////////////////////////////////////////////////////////////
 +//                                                                         //
 +// rad() - This calculates the degrees of an angle.                        //
 +//                                                                         //
 +/////////////////////////////////////////////////////////////////////////////
 +
 +float rad(float theta) {
 +  return ((theta * PI)/180);
 +}
 +
 +/////////////////////////////////////////////////////////////////////////////
 +//                                                                         //
 +// sgn() - This checks the sign of an integer and returns a 1, -1, or 0.   //
 +//                                                                         //
 +/////////////////////////////////////////////////////////////////////////////
 +
 +int sgn (int a) {
 +
 +  if (a > 0)  return +1;
 +  if (a < 0)  return -1;
 +  return 0;
 +}
 +
 +
 +//-----------------------------DRAWING FUNCTIONS---------------------------//
 +
 +/////////////////////////////////////////////////////////////////////////////
 +//                                                                         //
 +// Putpixel() - This puts a pixel on the screen by writing directly to     //
 +//              memory.                                                    //
 +//                                                                         //
 +/////////////////////////////////////////////////////////////////////////////
 +
 +void Putpixel (word X, word Y, byte Col, word Where) {
 +  asm {
 +    mov     ax, [Where]  // move segment of Where to AX
 +    mov     es, ax       // ES = VGA
 +    mov     bx, [X]      // BX = X
 +    mov     dx, [Y]      // DX = Y
 +    mov     ah, dl       // AH = Y*256
 +    xor     al, al       // AX = Y*256
 +    shl     dx, 6        // DX = Y*64
 +    add     dx, ax       // DX = Y*320
 +    add     bx, dx       // BX = Y*320 + X
 +    mov     ah, [Col]    // move value of Col into AH
 +    mov     byte ptr es:[bx], ah  // move Col to the offset in memory (DI)
 +  }
 +}
 +
 +/////////////////////////////////////////////////////////////////////////////
 +//                                                                         //
 +// PutpixelVGA() - This puts a pixel on the screen by writing directly to  //
 +//                 VGA memory.                                             //
 +//                                                                         //
 +/////////////////////////////////////////////////////////////////////////////
 +
 +void PutpixelVGA (word X, word Y, byte Col) {
 +  asm {
 +    mov     ax, 0xA000   // AX = VGA Segment
 +    mov     es, ax       // ES = VGA Segment
 +    mov     bx, [X]      // BX = X
 +    mov     dx, [Y]      // DX = Y
 +    mov     ah, dl       // AX = Y*256 (AL is already 0 from A000 address)
 +    shl     dx, 6        // DX = Y*64
 +    add     dx, ax       // DX = Y*320
 +    add     bx, dx       // BX = Y*320 + X
 +    mov     ah, [Col]    // move value of Col into AH
 +    mov     byte ptr es:[bx], ah  // move Col to the offset in memory (DI)
 +  }
 +}
 +
 +/////////////////////////////////////////////////////////////////////////////
 +//                                                                         //
 +// Line() - This draws a line from a,b to c,d of color col on screne Where //
 +//                                                                         //
 +/////////////////////////////////////////////////////////////////////////////
 +
 +void Line(int a, int b, int c, int d, int col, word Where) {
 +
 +  int i,u,s,v,d1x,d1y,d2x,d2y,m,n;
 +
 +  u   = c-a;       // x2-x1
 +  v   = d-b;       // y2-y1
 +  d1x = sgn(u);    // d1x is the sign of u (x2-x1) (VALUE -1,0,1)
 +  d1y = sgn(v);    // d1y is the sign of v (y2-y1) (VALUE -1,0,1)
 +  d2x = sgn(u);    // d2x is the sign of u (x2-x1) (VALUE -1,0,1)
 +  d2y = 0;
 +  m   = abso(u);   // m is the distance between x1 and x2
 +  n   = abso(v);   // n is the distance between y1 and y2
 +
 +  if (m<=n) {      // if the x distance is greater than the y distance
 +    d2x = 0;
 +    d2y = sgn(v);  // d2y is the sign of v (x2-x1) (VALUE -1,0,1)
 +    m   = abso(v); // m is the distance between y1 and y2
 +    n   = abso(u); // n is the distance between x1 and x2
 +  }
 +
 +  s = m / 2; // s is the m distance (either x or y) divided by 2
 +
 +  for (i=0;i<m+1;i++) { // repeat this loop until it
 +                 // is = to m (y or x distance)
 +    Putpixel(a,b,col,Where); // plot a pixel at the original x1, y1
 +    s += n;                  // add n (dis of x or y) to s (dis of x of y)
 +    if (s >= m) {            // if s is >= m (distance between y1 and y2)
 +      s -= m;
 +      a += d1x;
 +      b += d1y;
 +    }
 +    else {
 +      a += d2x;
 +      b += d2y;
 +    }
 +  }
 +
 +}
 +
 +/////////////////////////////////////////////////////////////////////////////
 +//                                                                         //
 +// Hline() - This draws a horizontal line from X1 to X2 on line Y in color //
 +//           Col at memory location Where.                                 //
 +//                                                                         //
 +/////////////////////////////////////////////////////////////////////////////
 +
 +void Hline (word X1, word X2, word Y, byte Col, word Where) {
 +  asm {
 +    mov     ax, [Where]  // move segment of Where to AX
 +    mov     es, ax       // set ES to segment of Where
 +    mov     ax, [Y]      // set AX to Y
 +    mov     di, ax       // set DI to Y
 +    shl     ax, 8        // shift AX left 8 places (multiply Y by 256)
 +    shl     di, 6        // shift DI left 6 places (multiply Y by 64)
 +    add     di, ax       // add AX to DI (Y*64 + Y*256 = Y*320)
 +    add     di, [X1]     // add the X1 offset to DI
 +    mov     al, [Col]    // move Col to AL
 +    mov     ah, al       // move Col to AH (we want 2 copies for word moving)
 +    mov     cx, [X2]     // move X2 to CX
 +    sub     cx, [X1]     // move the change in X to CX
 +    shr     cx, 1        // divide change in X by 2 (for word moving)
 +    jnc     Start        // if we have an even number of moves, go to Start
 +    stosb                // otherwise, move one byte more
 +  }
 +  Start: asm {
 +    rep     stosw        // do it!
 +  }
 +}
 +</code>
  
 <nspages back2root/archives/denthor -simpleList -title -h1 -exclude:start -textPages="Denthor VGA Trainer"> <nspages back2root/archives/denthor -simpleList -title -h1 -exclude:start -textPages="Denthor VGA Trainer">
  
back2root/archives/denthor/part-09.txt · Dernière modification : 2021/09/05 14:09 de frater