home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 18 / CD_ASCQ_18_111294_W.iso / dos / prg / pas / pasgraph / vector3d.pas < prev    next >
Pascal/Delphi Source File  |  1994-06-20  |  23KB  |  584 lines
  1. Program TrnsVect; { Transparent Vectors }
  2. {$G+} { 286 Instructions Enabled }
  3.  
  4. {  Transparent 3D Vectors Example  }
  5. {     Programmed by David Dahl     }
  6. {  This program is PUBLIC DOMAIN   }
  7.  
  8. Uses CRT;
  9. Const ViewerDist = 200;
  10. Type VGAArray = Array [0..199, 0..319] of Byte;
  11.      VGAPtr   = ^VGAArray;
  12.      PaletteRec  = Record
  13.                          Red   : Byte;
  14.                          Green : Byte;
  15.                          Blue  : Byte;
  16.                    End;
  17.      PaletteType = Array [0..255] of PaletteRec;
  18.      PalettePtr  = ^PaletteType;
  19.      PolyRaster  = Record
  20.                          X1 : Word;
  21.                          X2 : Word;
  22.                    End;
  23.      PolyFill    = Array [0..199] of PolyRaster;
  24.      PolyFillPtr = ^PolyFill;
  25.      FacetPtr     = ^PolyFacet;
  26.      PolyFacet    = Record
  27.                           Color       : Byte;
  28.                           X1, Y1, Z1,
  29.                           X2, Y2, Z2,
  30.                           X3, Y3, Z3,
  31.                           X4, Y4, Z4  : Integer;
  32.                           NextFacet   : FacetPtr;
  33.                     End;
  34.      PolyHPtr     = ^PolygonHead;
  35.      PolygonHead  = Record
  36.                           X, Y, Z    : Integer;
  37.                           AX, AY, AZ : Integer;
  38.                           FirstFacet : FacetPtr;
  39.                     End;
  40. Var  VGAMEM   : VGAPtr;
  41.      WorkPage : VGAPtr;
  42.      BkgPage  : VGAPtr;
  43.      Palette  : PalettePtr;
  44.      PolyList : PolyFillPtr;
  45. {-[ Initialize 320 X 200 X 256 VGA ]---------------------------------------}
  46. Procedure GoMode13h; Assembler;
  47. ASM
  48.    MOV AX, $0013
  49.    INT $10
  50. End;
  51. {=[ Convex Polygon Drawing Routines ]======================================}
  52. {-[ Clear Polygon Raster List ]--------------------------------------------}
  53. Procedure ClearPolyList (Var ListIn : PolyFill);
  54. Begin
  55.      FillChar (ListIn, SizeOf(ListIn), $FF);
  56. End;
  57. {-[ OR VariableIn with Value -- Modeled after FillChar ]-------------------}
  58. Procedure ORChar (Var VariableIn;
  59.                       Size       : Word;
  60.                       Value      : Byte); Assembler;
  61. ASM
  62.    PUSH DS
  63.    MOV CX, Size
  64.    OR  CX, CX
  65.    JZ  @Done
  66.    LDS SI, VariableIn
  67.    MOV AL, Value
  68.    @ORLoop:
  69.       OR DS:[SI], AL
  70.       INC SI
  71.    LOOP @ORLoop
  72.    @Done:
  73.    POP DS
  74. End;
  75. {-[ Draw Polygon From Raster List To Work Buffer ]-------------------------}
  76. Procedure DrawPolyFromList (Var ListIn      : PolyFill;
  77.                             Var FrameBuffer : VGAArray;
  78.                                 Color       : Byte);
  79. Var YCount : Word;
  80.     TempX1 : Word;
  81.     TempX2 : Word;
  82. Begin
  83.      For YCount := 0 to 199 do
  84.      Begin
  85.           TempX1 := ListIn[YCount].X1;
  86.           TempX2 := ListIn[YCount].X2;
  87.           If (TempX1 <= 319) AND (TempX2 <= 319)
  88.           Then
  89.               ORChar (FrameBuffer[YCount, TempX1],
  90.                       TempX2 - TempX1 + 1, Color);
  91.      End;
  92. End;
  93. {-[ Add An Element To The Raster List ]------------------------------------}
  94. Procedure AddRasterToPoly (Var ListIn : PolyFill;
  95.                                X, Y   : Integer);
  96. Begin
  97.      { Clip X }
  98.      If X < 0
  99.      Then
  100.          X := 0
  101.      Else
  102.          If X > 319
  103.          Then
  104.              X := 319;
  105.     { If Y in bounds, add to list }
  106.     If ((Y >= 0) AND (Y <= 199))
  107.     Then
  108.     Begin
  109.          If (ListIn[Y].X1 > 319)
  110.          Then
  111.          Begin
  112.              ListIn[Y].X1 := X;
  113.              ListIn[Y].X2 := X;
  114.          End
  115.          Else
  116.              If (X < ListIn[Y].X1)
  117.              Then
  118.                  ListIn[Y].X1 := X
  119.              Else
  120.                  If (X > ListIn[Y].X2)
  121.                  Then
  122.                      ListIn[Y].X2 := X;
  123.     End;
  124. End;
  125. {=[ Polygon ]==============================================================}
  126. {-[ Add A Facet To Current Polygon ]---------------------------------------}
  127. Procedure AddFacet (Polygon          : PolyHPtr;
  128.                     Color            : Byte;
  129.                     X1In, Y1In, Z1In : Integer;
  130.                     X2In, Y2In, Z2In : Integer;
  131.                     X3In, Y3In, Z3In : Integer;
  132.                     X4In, Y4In, Z4In : Integer);
  133. Var CurrentFacet : FacetPtr;
  134. Begin
  135.      If Polygon^.FirstFacet = Nil
  136.      Then
  137.      Begin
  138.           New(Polygon^.FirstFacet);
  139.           CurrentFacet := Polygon^.FirstFacet;
  140.      End
  141.      Else
  142.      Begin
  143.           CurrentFacet := Polygon^.FirstFacet;
  144.           While CurrentFacet^.NextFacet <> Nil do
  145.                 CurrentFacet := CurrentFacet^.NextFacet;
  146.           New(CurrentFacet^.NextFacet);
  147.           CurrentFacet := CurrentFacet^.NextFacet;
  148.      End;
  149.      CurrentFacet^.Color := Color;
  150.      CurrentFacet^.X1 := X1In;
  151.      CurrentFacet^.X2 := X2In;
  152.      CurrentFacet^.X3 := X3In;
  153.      CurrentFacet^.X4 := X4In;
  154.      CurrentFacet^.Y1 := Y1In;
  155.      CurrentFacet^.Y2 := Y2In;
  156.      CurrentFacet^.Y3 := Y3In;
  157.      CurrentFacet^.Y4 := Y4In;
  158.      CurrentFacet^.Z1 := Z1In;
  159.      CurrentFacet^.Z2 := Z2In;
  160.      CurrentFacet^.Z3 := Z3In;
  161.      CurrentFacet^.Z4 := Z4In;
  162.      CurrentFacet^.NextFacet := Nil;
  163. End;
  164. {-[ Initialize a New Polygon ]---------------------------------------------}
  165. Procedure InitializePolygon (Var PolyHead               : PolyHPtr;
  166.                                  XIn, YIn, ZIn          : Integer;
  167.                                  RollIn, PitchIn, YawIn : Integer);
  168. Begin
  169.      If PolyHead = Nil
  170.      Then
  171.      Begin
  172.           New(PolyHead);
  173.           PolyHead^.X := XIn;
  174.           PolyHead^.Y := YIn;
  175.           PolyHead^.Z := ZIn;
  176.           PolyHead^.AX := RollIn;
  177.           PolyHead^.AY := PitchIn;
  178.           PolyHead^.AZ := YawIn;
  179.           PolyHead^.FirstFacet := Nil;
  180.      End;
  181. End;
  182. {-[ Dispose Polygon ]------------------------------------------------------}
  183. Procedure DisposePolygon (Var PolyHead : PolyHPtr);
  184. Var TempPtr : FacetPtr;
  185.     TP2     : FacetPtr;
  186. Begin
  187.      TempPtr := PolyHead^.FirstFacet;
  188.      While TempPtr <> Nil do
  189.      Begin
  190.           TP2 := TempPtr^.NextFacet;
  191.           Dispose (TempPtr);
  192.           TempPtr := TP2;
  193.      End;
  194.      Dispose (PolyHead);
  195.      PolyHead := Nil;
  196. End;
  197. {-[ Rotate Polygon About Axies ]-------------------------------------------}
  198. Procedure RotatePolygon (Var PolyHead   : PolyHPtr;
  199.                              DX, DY, DZ : Integer);
  200. Begin
  201.      INC (PolyHead^.AX, DX);
  202.      INC (PolyHead^.AY, DY);
  203.      INC (PolyHead^.AZ, DZ);
  204.      While (PolyHead^.AX > 360) do
  205.            DEC(PolyHead^.AX, 360);
  206.      While (PolyHead^.AY > 360) do
  207.            DEC(PolyHead^.AY, 360);
  208.      While (PolyHead^.AZ > 360) do
  209.            DEC(PolyHead^.AZ, 360);
  210.      While (PolyHead^.AX < -360) do
  211.            INC(PolyHead^.AX, 360);
  212.      While (PolyHead^.AY < -360) do
  213.            INC(PolyHead^.AY, 360);
  214.      While (PolyHead^.AZ < -360) do
  215.            INC(PolyHead^.AZ, 360);
  216. End;
  217. {=[ Graphics Related Routines ]============================================}
  218. {-[ Build Facet Edge ]-----------------------------------------------------}
  219. Procedure DrawLine (X1In, Y1In,
  220.                     X2In, Y2In  : Integer;
  221.                     Color       : Byte);
  222. Var dx, dy : Integer;
  223.     ix, iy : Integer;
  224.     X,  Y  : Integer;
  225.     PX, PY : Integer;
  226.     i      : Integer;
  227.     incc   : Integer;
  228.     plot   : Boolean;
  229. Begin
  230.      dx := X1In - X2In;
  231.      dy := Y1In - Y2In;
  232.      ix := abs(dx);
  233.      iy := abs(dy);
  234.      X  := 0;
  235.      Y  := 0;
  236.      PX := X1In;
  237.      PY := Y1In;
  238.      AddRasterToPoly (PolyList^, PX, PY);
  239.      If ix > iy
  240.      Then
  241.          incc := ix
  242.      Else
  243.          incc := iy;
  244.      i := 0;
  245.      While (i <= incc) do
  246.      Begin
  247.           Inc (X, ix);
  248.           Inc (Y, iy);
  249.           Plot := False;
  250.           If X > incc
  251.           Then
  252.           Begin
  253.                Plot := True;
  254.                Dec (X, incc);
  255.                If dx < 0
  256.                Then
  257.                    Inc(PX)
  258.                Else
  259.                    Dec(PX);
  260.           End;
  261.           If Y > incc
  262.           Then
  263.           Begin
  264.                Plot := True;
  265.                Dec (Y, incc);
  266.                If dy < 0
  267.                Then
  268.                    Inc(PY)
  269.                Else
  270.                    Dec(PY);
  271.           End;
  272.           If Plot
  273.           Then
  274.               AddRasterToPoly (PolyList^, PX, PY);
  275.           Inc(i);
  276.      End;
  277. End;
  278. {-[ Draw Polygon ]---------------------------------------------------------}
  279. Procedure DrawPolygon3D (PolyHead : PolyHPtr;
  280.                          Buffer   : VGAPtr);
  281. Var CurrentFacet               : FacetPtr;
  282.     CalcX1, CalcY1, CalcZ1,
  283.     CalcX2, CalcY2, CalcZ2,
  284.     CalcX3, CalcY3, CalcZ3,
  285.     CalcX4, CalcY4, CalcZ4     : Integer;
  286.     XPrime1, YPrime1, ZPrime1,
  287.     XPrime2, YPrime2, ZPrime2,
  288.     XPrime3, YPrime3, ZPrime3,
  289.     XPrime4, YPrime4, ZPrime4  : Integer;
  290.     Temp                       : Integer;
  291.     CTX, STX,
  292.     CTY, STY,
  293.     CTZ, STZ  : Real;
  294. Begin
  295.      CurrentFacet := PolyHead^.FirstFacet;
  296.      While CurrentFacet <> Nil do
  297.        With CurrentFacet^ do
  298.        Begin
  299.             ClearPolyList (PolyList^);
  300.             XPrime1 := X1; YPrime1 := Y1; ZPrime1 := Z1;
  301.             XPrime2 := X2; YPrime2 := Y2; ZPrime2 := Z2;
  302.             XPrime3 := X3; YPrime3 := Y3; ZPrime3 := Z3;
  303.             XPrime4 := X4; YPrime4 := Y4; ZPrime4 := Z4;
  304.             { Rotate Coords }
  305.             CTX := COS(PolyHead^.AX * PI / 180);
  306.             STX := SIN(PolyHead^.AX * PI / 180);
  307.             CTY := COS(PolyHead^.AY * PI / 180);
  308.             STY := SIN(PolyHead^.AY * PI / 180);
  309.             CTZ := COS(PolyHead^.AZ * PI / 180);
  310.             STZ := SIN(PolyHead^.AZ * PI / 180);
  311.             Temp    := Round((YPrime1 * CTX) - (ZPrime1 * STX));
  312.             ZPrime1 := Round((YPrime1 * STX) + (ZPrime1 * CTX));
  313.             YPrime1 := Temp;
  314.             Temp    := Round((XPrime1 * CTY) - (ZPrime1 * STY));
  315.             ZPrime1 := Round((XPrime1 * STY) + (ZPrime1 * CTY));
  316.             XPrime1 := Temp;
  317.             Temp    := Round((XPrime1 * CTZ) - (YPrime1 * STZ));
  318.             YPrime1 := Round((XPrime1 * STZ) + (YPrime1 * CTZ));
  319.             XPrime1 := Temp;
  320.             Temp    := Round((YPrime2 * CTX) - (ZPrime2 * STX));
  321.             ZPrime2 := Round((YPrime2 * STX) + (ZPrime2 * CTX));
  322.             YPrime2 := Temp;
  323.             Temp    := Round((XPrime2 * CTY) - (ZPrime2 * STY));
  324.             ZPrime2 := Round((XPrime2 * STY) + (ZPrime2 * CTY));
  325.             XPrime2 := Temp;
  326.             Temp    := Round((XPrime2 * CTZ) - (YPrime2 * STZ));
  327.             YPrime2 := Round((XPrime2 * STZ) + (YPrime2 * CTZ));
  328.             XPrime2 := Temp;
  329.             Temp    := Round((YPrime3 * CTX) - (ZPrime3 * STX));
  330.             ZPrime3 := Round((YPrime3 * STX) + (ZPrime3 * CTX));
  331.             YPrime3 := Temp;
  332.             Temp    := Round((XPrime3 * CTY) - (ZPrime3 * STY));
  333.             ZPrime3 := Round((XPrime3 * STY) + (ZPrime3 * CTY));
  334.             XPrime3 := Temp;
  335.             Temp    := Round((XPrime3 * CTZ) - (YPrime3 * STZ));
  336.             YPrime3 := Round((XPrime3 * STZ) + (YPrime3 * CTZ));
  337.             XPrime3 := Temp;
  338.             Temp    := Round((YPrime4 * CTX) - (ZPrime4 * STX));
  339.             ZPrime4 := Round((YPrime4 * STX) + (ZPrime4 * CTX));
  340.             YPrime4 := Temp;
  341.             Temp    := Round((XPrime4 * CTY) - (ZPrime4 * STY));
  342.             ZPrime4 := Round((XPrime4 * STY) + (ZPrime4 * CTY));
  343.             XPrime4 := Temp;
  344.             Temp    := Round((XPrime4 * CTZ) - (YPrime4 * STZ));
  345.             YPrime4 := Round((XPrime4 * STZ) + (YPrime4 * CTZ));
  346.             XPrime4 := Temp;
  347.             { Translate Coords }
  348.             XPrime1 := PolyHead^.X + XPrime1;
  349.             YPrime1 := PolyHead^.Y + YPrime1;
  350.             ZPrime1 := PolyHead^.Z + ZPrime1;
  351.             XPrime2 := PolyHead^.X + XPrime2;
  352.             YPrime2 := PolyHead^.Y + YPrime2;
  353.             ZPrime2 := PolyHead^.Z + ZPrime2;
  354.             XPrime3 := PolyHead^.X + XPrime3;
  355.             YPrime3 := PolyHead^.Y + YPrime3;
  356.             ZPrime3 := PolyHead^.Z + ZPrime3;
  357.             XPrime4 := PolyHead^.X + XPrime4;
  358.             YPrime4 := PolyHead^.Y + YPrime4;
  359.             ZPrime4 := PolyHead^.Z + ZPrime4;
  360.             { Translate 3D Vectorspace to 2D Framespace }
  361.             CalcX1 := 160 + ((LongInt(XPrime1)*ViewerDist) DIV
  362.                              (ZPrime1+ViewerDist));
  363.             CalcY1 := 100 + ((LongInt(YPrime1)*ViewerDist) DIV
  364.                              (ZPrime1+ViewerDist));
  365.             CalcX2 := 160 + ((LongInt(XPrime2)*ViewerDist) DIV
  366.                              (ZPrime2+ViewerDist));
  367.             CalcY2 := 100 + ((LongInt(YPrime2)*ViewerDist) DIV
  368.                              (ZPrime2+ViewerDist));
  369.             CalcX3 := 160 + ((LongInt(XPrime3)*ViewerDist) DIV
  370.                              (ZPrime3+ViewerDist));
  371.             CalcY3 := 100 + ((LongInt(YPrime3)*ViewerDist) DIV
  372.                              (ZPrime3+ViewerDist));
  373.             CalcX4 := 160 + ((LongInt(XPrime4)*ViewerDist) DIV
  374.                              (ZPrime4+ViewerDist));
  375.             CalcY4 := 100 + ((LongInt(YPrime4)*ViewerDist) DIV
  376.                              (ZPrime4+ViewerDist));
  377.             { Draw Shape }
  378.             DrawLine (CalcX1, CalcY1, CalcX2, CalcY2, Color);
  379.             DrawLine (CalcX2, CalcY2, CalcX3, CalcY3, Color);
  380.             DrawLine (CalcX3, CalcY3, CalcX4, CalcY4, Color);
  381.             DrawLine (CalcX4, CalcY4, CalcX1, CalcY1, Color);
  382.             DrawPolyFromList (PolyList^, WorkPage^, Color);
  383.             CurrentFacet := CurrentFacet^.NextFacet;
  384.        End;
  385. End;
  386. {-[ Build Background ]-----------------------------------------------------}
  387. Procedure BuildBackground (Var BufferIn : VGAArray);
  388. Var CounterX,
  389.     CounterY  : Integer;
  390. Begin
  391.      For CounterY := 0 to 199 do
  392.       For CounterX := 0 to 319 do
  393.           BufferIn[CounterY, CounterX] := 1 + ((CounterY MOD 5) * 5) +
  394.                                                (CounterX MOD 5);
  395. End;
  396. {-[ Build Palette ]--------------------------------------------------------}
  397. Procedure BuildPalette (Var PaletteOut : PaletteType);
  398. Const BC = 16;
  399. Var Counter1,
  400.     Counter2  : Integer;
  401.  
  402. Begin
  403.      FillChar (PaletteOut, SizeOf(PaletteOut), 0);
  404.      For Counter1 := 0 to 4 do
  405.      For Counter2 := 1 to 2 do
  406.      Begin
  407.           PaletteOut[1+(Counter1 * 5)+Counter2].Red   := BC+(Counter2 * 5);
  408.           PaletteOut[1+(Counter1 * 5)+Counter2].Green := BC+(Counter2 * 5);
  409.           PaletteOut[1+(Counter1 * 5)+Counter2].Blue  := BC+(Counter2 * 5);
  410.           PaletteOut[1+(Counter1 * 5)+4-Counter2].Red   := BC+(Counter2 * 5);
  411.           PaletteOut[1+(Counter1 * 5)+4-Counter2].Green := BC+(Counter2 * 5);
  412.           PaletteOut[1+(Counter1 * 5)+4-Counter2].Blue  := BC+(Counter2 * 5);
  413.      End;
  414.      For Counter1 := 0 to 4 do
  415.      Begin
  416.           If PaletteOut[1+(5 * 1)+Counter1].Red < BC + 5
  417.           Then
  418.           Begin
  419.               PaletteOut[1+(5 * 1)+Counter1].Red   := BC + 5;
  420.               PaletteOut[1+(5 * 1)+Counter1].Green := BC + 5;
  421.               PaletteOut[1+(5 * 1)+Counter1].Blue  := BC + 5;
  422.               PaletteOut[1+(5 * 3)+Counter1].Red   := BC + 5;
  423.               PaletteOut[1+(5 * 3)+Counter1].Green := BC + 5;
  424.               PaletteOut[1+(5 * 3)+Counter1].Blue  := BC + 5;
  425.           End;
  426.           PaletteOut[1+(5 * 2)+Counter1].Red   := BC + 10;
  427.           PaletteOut[1+(5 * 2)+Counter1].Green := BC + 10;
  428.           PaletteOut[1+(5 * 2)+Counter1].Blue  := BC + 10;
  429.      End;
  430.      For Counter1 := 0 to 24 do
  431.      Begin
  432.       PaletteOut[32+Counter1].Red   := ((PaletteOut[Counter1].Red* 8)+
  433.                                         (26 * 24)) DIV 32;
  434.       PaletteOut[32+Counter1].Green := ((PaletteOut[Counter1].Green* 8)+
  435.                                         (0  * 24)) DIV 32;
  436.       PaletteOut[32+Counter1].Blue  := ((PaletteOut[Counter1].Blue* 8)+
  437.                                         (0  * 24)) DIV 32;
  438.       PaletteOut[64+Counter1].Red   := ((PaletteOut[Counter1].Red* 8)+
  439.                                         (0  * 24)) DIV 32;
  440.       PaletteOut[64+Counter1].Green := ((PaletteOut[Counter1].Green* 8)+
  441.                                         (26 * 24)) DIV 32;
  442.       PaletteOut[64+Counter1].Blue  := ((PaletteOut[Counter1].Blue* 8)+
  443.                                         (0  * 24)) DIV 32;
  444.       PaletteOut[128+Counter1].Red   := ((PaletteOut[Counter1].Red* 8)+
  445.                                         (0  * 24)) DIV 32;
  446.       PaletteOut[128+Counter1].Green := ((PaletteOut[Counter1].Green* 8)+
  447.                                         (0  * 24)) DIV 32;
  448.       PaletteOut[128+Counter1].Blue  := ((PaletteOut[Counter1].Blue* 8)+
  449.                                         (26 * 24)) DIV 32;
  450.       PaletteOut[32+64+Counter1].Red   := ((PaletteOut[Counter1].Red* 6)+
  451.                                         (23 * 26)) DIV 32;
  452.       PaletteOut[32+64+Counter1].Green := ((PaletteOut[Counter1].Green* 6)+
  453.                                         (23 * 26)) DIV 32;
  454.       PaletteOut[32+64+Counter1].Blue  := ((PaletteOut[Counter1].Blue* 6)+
  455.                                         (0  * 26)) DIV 32;
  456.       PaletteOut[32+128+Counter1].Red   := ((PaletteOut[Counter1].Red* 6)+
  457.                                         (23 * 26)) DIV 32;
  458.       PaletteOut[32+128+Counter1].Green := ((PaletteOut[Counter1].Green* 6)+
  459.                                         (0  * 26)) DIV 32;
  460.       PaletteOut[32+128+Counter1].Blue  := ((PaletteOut[Counter1].Blue* 6)+
  461.                                         (23 * 26)) DIV 32;
  462.       PaletteOut[64+128+Counter1].Red   := ((PaletteOut[Counter1].Red* 6)+
  463.                                         (0  * 26)) DIV 32;
  464.       PaletteOut[64+128+Counter1].Green := ((PaletteOut[Counter1].Green* 6)+
  465.                                         (23 * 26)) DIV 32;
  466.       PaletteOut[64+128+Counter1].Blue  := ((PaletteOut[Counter1].Blue* 6)+
  467.                                         (23 * 26)) DIV 32;
  468.      End;
  469. End;
  470. {-[ Move Background by Moving Palette ]------------------------------------}
  471. Procedure MoveBackground (Var PaletteIn : PaletteType);
  472. Var TempPal : Array[0..5] of PaletteRec;
  473. Begin
  474.      {-- Move Background Colors --}
  475.      Move (PaletteIn[1], TempPal[0], 5 * 3);
  476.      Move (PaletteIn[1+5], PaletteIn[1], ((5 * 4) * 3));
  477.      Move (TempPal[0], PaletteIn[1 + (5 * 4)], 5 * 3);
  478.      {-- Move See-Through Colors --}
  479.      { Red }
  480.      Move (PaletteIn[32], TempPal[0], 6 * 3);
  481.      Move (PaletteIn[32+5], PaletteIn[32], ((5 * 4) * 3));
  482.      Move (TempPal[0], PaletteIn[32 + (5 * 4)], 6 * 3);
  483.      { Green }
  484.      Move (PaletteIn[64], TempPal[0], 6 * 3);
  485.      Move (PaletteIn[64+5], PaletteIn[64], ((5 * 4) * 3));
  486.      Move (TempPal[0], PaletteIn[64 + (5 * 4)], 6 * 3);
  487.      { Blue }
  488.      Move (PaletteIn[128], TempPal[0], 6 * 3);
  489.      Move (PaletteIn[128+5], PaletteIn[128], ((5 * 4) * 3));
  490.      Move (TempPal[0], PaletteIn[128 + (5 * 4)], 6 * 3);
  491.      { Red + Green }
  492.      Move (PaletteIn[(32 OR 64)], TempPal[0], 6 * 3);
  493.      Move (PaletteIn[(32 OR 64)+5], PaletteIn[(32 OR 64)], ((5 * 4) * 3));
  494.      Move (TempPal[0], PaletteIn[(32 OR 64) + (5 * 4)], 6 * 3);
  495.      { Red + Blue }
  496.      Move (PaletteIn[(32 OR 128)], TempPal[0], 6 * 3);
  497.      Move (PaletteIn[(32 OR 128)+5], PaletteIn[(32 OR 128)], ((5 * 4) * 3));
  498.      Move (TempPal[0], PaletteIn[(32 OR 128) + (5 * 4)], 6 * 3);
  499.      { Green + Blue }
  500.      Move (PaletteIn[(64 OR 128)], TempPal[0], 6 * 3);
  501.      Move (PaletteIn[(64 OR 128)+5], PaletteIn[(64 OR 128)], ((5 * 4) * 3));
  502.      Move (TempPal[0], PaletteIn[(64 OR 128) + (5 * 4)], 6 * 3);
  503. End;
  504. {-[ Set Palette ]----------------------------------------------------------}
  505. Procedure SetPalette (Var PaletteIn : PaletteType); Assembler;
  506. ASM
  507.    PUSH DS
  508.    LDS SI, PaletteIn { Sets whole palette at once...       }
  509.    MOV CX, 256 * 3   {  *NOT* good practice since many VGA }
  510.    MOV DX, 03DAh     {  cards will show snow at the top of }
  511.    @WaitNotVSync:    {  of the screen.  It's done here     }
  512.      IN  AL, DX      {  'cause the background animation    }
  513.      AND AL, 8       {  requires large ammounts of the     }
  514.    JNZ @WaitNotVSync {  palette to be updated every new    }
  515.    @WaitVSync:       {  frame.                             }
  516.      IN  AL, DX
  517.      AND AL, 8
  518.    JZ @WaitVSync
  519.    XOR AX, AX
  520.    MOV DX, 03C8h
  521.    OUT DX, AL
  522.    INC DX
  523.    @PaletteLoop:
  524.      LODSB
  525.      OUT DX, AL
  526.    LOOP @PaletteLoop
  527.    POP DS
  528. End;
  529. {=[ Main Program ]=========================================================}
  530. Var Polygon1 : PolyHPtr;
  531. Begin
  532.      VGAMEM := Ptr($A000, $0000);
  533.      New (WorkPage);
  534.      New (BkgPage);
  535.      New (Palette);
  536.      New (PolyList);
  537.      ClearPolyList (PolyList^);
  538.      GoMode13h;
  539.      BuildBackground (BkgPage^);
  540.      BuildPalette    (Palette^);
  541.      SetPalette (Palette^);
  542.      Polygon1 := Nil;
  543.      InitializePolygon (Polygon1,  { Polygon List Head         }
  544.                         0, 0, 60,  { X, Y, Z of polygon        }
  545.                         0, 0, 0);  { Iniitial Roll, Pitch, Yaw }
  546.      AddFacet (Polygon1,       { Polygon List Head        }
  547.                 32,            { Color                    }
  548.                -40, -40,  50,  { One Corner of Polygon    }
  549.                 40, -40,  50,  { Second Corner of Polygon }
  550.                 40,  40,  50,  { Third Corner of Polygon  }
  551.                -40,  40,  50); { Last Corner of Polygon   }
  552.      AddFacet (Polygon1,
  553.                 64,
  554.                -50, -40, -40,
  555.                -50, -40,  40,
  556.                -50,  40,  40,
  557.                -50,  40, -40);
  558.      AddFacet (Polygon1,
  559.                128,
  560.                 40, -50, -40,
  561.                 40, -50,  40,
  562.                -40, -50,  40,
  563.                -40, -50, -40);
  564.      Repeat
  565.            { Clear Workpage }
  566.            WorkPage^ := BkgPage^;
  567.            ClearPolyList (PolyList^);
  568.            DrawPolygon3D (Polygon1,    { Polygon Definition }
  569.                           WorkPage);   { Work buffer        }
  570.            MoveBackground (Palette^);
  571.            SetPalette     (Palette^);
  572.            { Display Work Buffer }
  573.            VGAMEM^ := WorkPage^;
  574.            RotatePolygon (Polygon1,
  575.                           5, 10, 1);
  576.      Until Keypressed;
  577.      DisposePolygon (Polygon1);
  578.      Dispose (PolyList);
  579.      Dispose (Palette);
  580.      Dispose (BkgPage);
  581.      Dispose (WorkPage);
  582.      TextMode (C80);
  583. End.
  584.