home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / graphics.swg / 0128_Transparent 3D Vectors.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-08-24  |  22.0 KB  |  584 lines
  1.  
  2. Program TrnsVect; { Transparent Vectors }
  3. {$G+} { 286 Instructions Enabled }
  4.  
  5. {  Transparent 3D Vectors Example  }
  6. {     Programmed by David Dahl     }
  7. {  This program is PUBLIC DOMAIN   }
  8.  
  9. Uses CRT;
  10. Const ViewerDist = 200;
  11. Type VGAArray = Array [0..199, 0..319] of Byte;
  12.      VGAPtr   = ^VGAArray;
  13.      PaletteRec  = Record
  14.                          Red   : Byte;
  15.                          Green : Byte;
  16.                          Blue  : Byte;
  17.                    End;
  18.      PaletteType = Array [0..255] of PaletteRec;
  19.      PalettePtr  = ^PaletteType;
  20.      PolyRaster  = Record
  21.                          X1 : Word;
  22.                          X2 : Word;
  23.                    End;
  24.      PolyFill    = Array [0..199] of PolyRaster;
  25.      PolyFillPtr = ^PolyFill;
  26.      FacetPtr     = ^PolyFacet;
  27.      PolyFacet    = Record
  28.                           Color       : Byte;
  29.                           X1, Y1, Z1,
  30.                           X2, Y2, Z2,
  31.                           X3, Y3, Z3,
  32.                           X4, Y4, Z4  : Integer;
  33.                           NextFacet   : FacetPtr;
  34.                     End;
  35.      PolyHPtr     = ^PolygonHead;
  36.      PolygonHead  = Record
  37.                           X, Y, Z    : Integer;
  38.                           AX, AY, AZ : Integer;
  39.                           FirstFacet : FacetPtr;
  40.                     End;
  41. Var  VGAMEM   : VGAPtr;
  42.      WorkPage : VGAPtr;
  43.      BkgPage  : VGAPtr;
  44.      Palette  : PalettePtr;
  45.      PolyList : PolyFillPtr;
  46. {-[ Initialize 320 X 200 X 256 VGA ]---------------------------------------}
  47. Procedure GoMode13h; Assembler;
  48. ASM
  49.    MOV AX, $0013
  50.    INT $10
  51. End;
  52. {=[ Convex Polygon Drawing Routines ]======================================}
  53. {-[ Clear Polygon Raster List ]--------------------------------------------}
  54. Procedure ClearPolyList (Var ListIn : PolyFill);
  55. Begin
  56.      FillChar (ListIn, SizeOf(ListIn), $FF);
  57. End;
  58. {-[ OR VariableIn with Value -- Modeled after FillChar ]-------------------}
  59. Procedure ORChar (Var VariableIn;
  60.                       Size       : Word;
  61.                       Value      : Byte); Assembler;
  62. ASM
  63.    PUSH DS
  64.    MOV CX, Size
  65.    OR  CX, CX
  66.    JZ  @Done
  67.    LDS SI, VariableIn
  68.    MOV AL, Value
  69.    @ORLoop:
  70.       OR DS:[SI], AL
  71.       INC SI
  72.    LOOP @ORLoop
  73.    @Done:
  74.    POP DS
  75. End;
  76. {-[ Draw Polygon From Raster List To Work Buffer ]-------------------------}
  77. Procedure DrawPolyFromList (Var ListIn      : PolyFill;
  78.                             Var FrameBuffer : VGAArray;
  79.                                 Color       : Byte);
  80. Var YCount : Word;
  81.     TempX1 : Word;
  82.     TempX2 : Word;
  83. Begin
  84.      For YCount := 0 to 199 do
  85.      Begin
  86.           TempX1 := ListIn[YCount].X1;
  87.           TempX2 := ListIn[YCount].X2;
  88.           If (TempX1 <= 319) AND (TempX2 <= 319)
  89.           Then
  90.               ORChar (FrameBuffer[YCount, TempX1],
  91.                       TempX2 - TempX1 + 1, Color);
  92.      End;
  93. End;
  94. {-[ Add An Element To The Raster List ]------------------------------------}
  95. Procedure AddRasterToPoly (Var ListIn : PolyFill;
  96.                                X, Y   : Integer);
  97. Begin
  98.      { Clip X }
  99.      If X < 0
  100.      Then
  101.          X := 0
  102.      Else
  103.          If X > 319
  104.          Then
  105.              X := 319;
  106.     { If Y in bounds, add to list }
  107.     If ((Y >= 0) AND (Y <= 199))
  108.     Then
  109.     Begin
  110.          If (ListIn[Y].X1 > 319)
  111.          Then
  112.          Begin
  113.              ListIn[Y].X1 := X;
  114.              ListIn[Y].X2 := X;
  115.          End
  116.          Else
  117.              If (X < ListIn[Y].X1)
  118.              Then
  119.                  ListIn[Y].X1 := X
  120.              Else
  121.                  If (X > ListIn[Y].X2)
  122.                  Then
  123.                      ListIn[Y].X2 := X;
  124.     End;
  125. End;
  126. {=[ Polygon ]==============================================================}
  127. {-[ Add A Facet To Current Polygon ]---------------------------------------}
  128. Procedure AddFacet (Polygon          : PolyHPtr;
  129.                     Color            : Byte;
  130.                     X1In, Y1In, Z1In : Integer;
  131.                     X2In, Y2In, Z2In : Integer;
  132.                     X3In, Y3In, Z3In : Integer;
  133.                     X4In, Y4In, Z4In : Integer);
  134. Var CurrentFacet : FacetPtr;
  135. Begin
  136.      If Polygon^.FirstFacet = Nil
  137.      Then
  138.      Begin
  139.           New(Polygon^.FirstFacet);
  140.           CurrentFacet := Polygon^.FirstFacet;
  141.      End
  142.      Else
  143.      Begin
  144.           CurrentFacet := Polygon^.FirstFacet;
  145.           While CurrentFacet^.NextFacet <> Nil do
  146.                 CurrentFacet := CurrentFacet^.NextFacet;
  147.           New(CurrentFacet^.NextFacet);
  148.           CurrentFacet := CurrentFacet^.NextFacet;
  149.      End;
  150.      CurrentFacet^.Color := Color;
  151.      CurrentFacet^.X1 := X1In;
  152.      CurrentFacet^.X2 := X2In;
  153.      CurrentFacet^.X3 := X3In;
  154.      CurrentFacet^.X4 := X4In;
  155.      CurrentFacet^.Y1 := Y1In;
  156.      CurrentFacet^.Y2 := Y2In;
  157.      CurrentFacet^.Y3 := Y3In;
  158.      CurrentFacet^.Y4 := Y4In;
  159.      CurrentFacet^.Z1 := Z1In;
  160.      CurrentFacet^.Z2 := Z2In;
  161.      CurrentFacet^.Z3 := Z3In;
  162.      CurrentFacet^.Z4 := Z4In;
  163.      CurrentFacet^.NextFacet := Nil;
  164. End;
  165. {-[ Initialize a New Polygon ]---------------------------------------------}
  166. Procedure InitializePolygon (Var PolyHead               : PolyHPtr;
  167.                                  XIn, YIn, ZIn          : Integer;
  168.                                  RollIn, PitchIn, YawIn : Integer);
  169. Begin
  170.      If PolyHead = Nil
  171.      Then
  172.      Begin
  173.           New(PolyHead);
  174.           PolyHead^.X := XIn;
  175.           PolyHead^.Y := YIn;
  176.           PolyHead^.Z := ZIn;
  177.           PolyHead^.AX := RollIn;
  178.           PolyHead^.AY := PitchIn;
  179.           PolyHead^.AZ := YawIn;
  180.           PolyHead^.FirstFacet := Nil;
  181.      End;
  182. End;
  183. {-[ Dispose Polygon ]------------------------------------------------------}
  184. Procedure DisposePolygon (Var PolyHead : PolyHPtr);
  185. Var TempPtr : FacetPtr;
  186.     TP2     : FacetPtr;
  187. Begin
  188.      TempPtr := PolyHead^.FirstFacet;
  189.      While TempPtr <> Nil do
  190.      Begin
  191.           TP2 := TempPtr^.NextFacet;
  192.           Dispose (TempPtr);
  193.           TempPtr := TP2;
  194.      End;
  195.      Dispose (PolyHead);
  196.      PolyHead := Nil;
  197. End;
  198. {-[ Rotate Polygon About Axies ]-------------------------------------------}
  199. Procedure RotatePolygon (Var PolyHead   : PolyHPtr;
  200.                              DX, DY, DZ : Integer);
  201. Begin
  202.      INC (PolyHead^.AX, DX);
  203.      INC (PolyHead^.AY, DY);
  204.      INC (PolyHead^.AZ, DZ);
  205.      While (PolyHead^.AX > 360) do
  206.            DEC(PolyHead^.AX, 360);
  207.      While (PolyHead^.AY > 360) do
  208.            DEC(PolyHead^.AY, 360);
  209.      While (PolyHead^.AZ > 360) do
  210.            DEC(PolyHead^.AZ, 360);
  211.      While (PolyHead^.AX < -360) do
  212.            INC(PolyHead^.AX, 360);
  213.      While (PolyHead^.AY < -360) do
  214.            INC(PolyHead^.AY, 360);
  215.      While (PolyHead^.AZ < -360) do
  216.            INC(PolyHead^.AZ, 360);
  217. End;
  218. {=[ Graphics Related Routines ]============================================}
  219. {-[ Build Facet Edge ]-----------------------------------------------------}
  220. Procedure DrawLine (X1In, Y1In,
  221.                     X2In, Y2In  : Integer;
  222.                     Color       : Byte);
  223. Var dx, dy : Integer;
  224.     ix, iy : Integer;
  225.     X,  Y  : Integer;
  226.     PX, PY : Integer;
  227.     i      : Integer;
  228.     incc   : Integer;
  229.     plot   : Boolean;
  230. Begin
  231.      dx := X1In - X2In;
  232.      dy := Y1In - Y2In;
  233.      ix := abs(dx);
  234.      iy := abs(dy);
  235.      X  := 0;
  236.      Y  := 0;
  237.      PX := X1In;
  238.      PY := Y1In;
  239.      AddRasterToPoly (PolyList^, PX, PY);
  240.      If ix > iy
  241.      Then
  242.          incc := ix
  243.      Else
  244.          incc := iy;
  245.      i := 0;
  246.      While (i <= incc) do
  247.      Begin
  248.           Inc (X, ix);
  249.           Inc (Y, iy);
  250.           Plot := False;
  251.           If X > incc
  252.           Then
  253.           Begin
  254.                Plot := True;
  255.                Dec (X, incc);
  256.                If dx < 0
  257.                Then
  258.                    Inc(PX)
  259.                Else
  260.                    Dec(PX);
  261.           End;
  262.           If Y > incc
  263.           Then
  264.           Begin
  265.                Plot := True;
  266.                Dec (Y, incc);
  267.                If dy < 0
  268.                Then
  269.                    Inc(PY)
  270.                Else
  271.                    Dec(PY);
  272.           End;
  273.           If Plot
  274.           Then
  275.               AddRasterToPoly (PolyList^, PX, PY);
  276.           Inc(i);
  277.      End;
  278. End;
  279. {-[ Draw Polygon ]---------------------------------------------------------}
  280. Procedure DrawPolygon3D (PolyHead : PolyHPtr;
  281.                          Buffer   : VGAPtr);
  282. Var CurrentFacet               : FacetPtr;
  283.     CalcX1, CalcY1, CalcZ1,
  284.     CalcX2, CalcY2, CalcZ2,
  285.     CalcX3, CalcY3, CalcZ3,
  286.     CalcX4, CalcY4, CalcZ4     : Integer;
  287.     XPrime1, YPrime1, ZPrime1,
  288.     XPrime2, YPrime2, ZPrime2,
  289.     XPrime3, YPrime3, ZPrime3,
  290.     XPrime4, YPrime4, ZPrime4  : Integer;
  291.     Temp                       : Integer;
  292.     CTX, STX,
  293.     CTY, STY,
  294.     CTZ, STZ  : Real;
  295. Begin
  296.      CurrentFacet := PolyHead^.FirstFacet;
  297.      While CurrentFacet <> Nil do
  298.        With CurrentFacet^ do
  299.        Begin
  300.             ClearPolyList (PolyList^);
  301.             XPrime1 := X1; YPrime1 := Y1; ZPrime1 := Z1;
  302.             XPrime2 := X2; YPrime2 := Y2; ZPrime2 := Z2;
  303.             XPrime3 := X3; YPrime3 := Y3; ZPrime3 := Z3;
  304.             XPrime4 := X4; YPrime4 := Y4; ZPrime4 := Z4;
  305.             { Rotate Coords }
  306.             CTX := COS(PolyHead^.AX * PI / 180);
  307.             STX := SIN(PolyHead^.AX * PI / 180);
  308.             CTY := COS(PolyHead^.AY * PI / 180);
  309.             STY := SIN(PolyHead^.AY * PI / 180);
  310.             CTZ := COS(PolyHead^.AZ * PI / 180);
  311.             STZ := SIN(PolyHead^.AZ * PI / 180);
  312.             Temp    := Round((YPrime1 * CTX) - (ZPrime1 * STX));
  313.             ZPrime1 := Round((YPrime1 * STX) + (ZPrime1 * CTX));
  314.             YPrime1 := Temp;
  315.             Temp    := Round((XPrime1 * CTY) - (ZPrime1 * STY));
  316.             ZPrime1 := Round((XPrime1 * STY) + (ZPrime1 * CTY));
  317.             XPrime1 := Temp;
  318.             Temp    := Round((XPrime1 * CTZ) - (YPrime1 * STZ));
  319.             YPrime1 := Round((XPrime1 * STZ) + (YPrime1 * CTZ));
  320.             XPrime1 := Temp;
  321.             Temp    := Round((YPrime2 * CTX) - (ZPrime2 * STX));
  322.             ZPrime2 := Round((YPrime2 * STX) + (ZPrime2 * CTX));
  323.             YPrime2 := Temp;
  324.             Temp    := Round((XPrime2 * CTY) - (ZPrime2 * STY));
  325.             ZPrime2 := Round((XPrime2 * STY) + (ZPrime2 * CTY));
  326.             XPrime2 := Temp;
  327.             Temp    := Round((XPrime2 * CTZ) - (YPrime2 * STZ));
  328.             YPrime2 := Round((XPrime2 * STZ) + (YPrime2 * CTZ));
  329.             XPrime2 := Temp;
  330.             Temp    := Round((YPrime3 * CTX) - (ZPrime3 * STX));
  331.             ZPrime3 := Round((YPrime3 * STX) + (ZPrime3 * CTX));
  332.             YPrime3 := Temp;
  333.             Temp    := Round((XPrime3 * CTY) - (ZPrime3 * STY));
  334.             ZPrime3 := Round((XPrime3 * STY) + (ZPrime3 * CTY));
  335.             XPrime3 := Temp;
  336.             Temp    := Round((XPrime3 * CTZ) - (YPrime3 * STZ));
  337.             YPrime3 := Round((XPrime3 * STZ) + (YPrime3 * CTZ));
  338.             XPrime3 := Temp;
  339.             Temp    := Round((YPrime4 * CTX) - (ZPrime4 * STX));
  340.             ZPrime4 := Round((YPrime4 * STX) + (ZPrime4 * CTX));
  341.             YPrime4 := Temp;
  342.             Temp    := Round((XPrime4 * CTY) - (ZPrime4 * STY));
  343.             ZPrime4 := Round((XPrime4 * STY) + (ZPrime4 * CTY));
  344.             XPrime4 := Temp;
  345.             Temp    := Round((XPrime4 * CTZ) - (YPrime4 * STZ));
  346.             YPrime4 := Round((XPrime4 * STZ) + (YPrime4 * CTZ));
  347.             XPrime4 := Temp;
  348.             { Translate Coords }
  349.             XPrime1 := PolyHead^.X + XPrime1;
  350.             YPrime1 := PolyHead^.Y + YPrime1;
  351.             ZPrime1 := PolyHead^.Z + ZPrime1;
  352.             XPrime2 := PolyHead^.X + XPrime2;
  353.             YPrime2 := PolyHead^.Y + YPrime2;
  354.             ZPrime2 := PolyHead^.Z + ZPrime2;
  355.             XPrime3 := PolyHead^.X + XPrime3;
  356.             YPrime3 := PolyHead^.Y + YPrime3;
  357.             ZPrime3 := PolyHead^.Z + ZPrime3;
  358.             XPrime4 := PolyHead^.X + XPrime4;
  359.             YPrime4 := PolyHead^.Y + YPrime4;
  360.             ZPrime4 := PolyHead^.Z + ZPrime4;
  361.             { Translate 3D Vectorspace to 2D Framespace }
  362.             CalcX1 := 160 + ((LongInt(XPrime1)*ViewerDist) DIV
  363.                              (ZPrime1+ViewerDist));
  364.             CalcY1 := 100 + ((LongInt(YPrime1)*ViewerDist) DIV
  365.                              (ZPrime1+ViewerDist));
  366.             CalcX2 := 160 + ((LongInt(XPrime2)*ViewerDist) DIV
  367.                              (ZPrime2+ViewerDist));
  368.             CalcY2 := 100 + ((LongInt(YPrime2)*ViewerDist) DIV
  369.                              (ZPrime2+ViewerDist));
  370.             CalcX3 := 160 + ((LongInt(XPrime3)*ViewerDist) DIV
  371.                              (ZPrime3+ViewerDist));
  372.             CalcY3 := 100 + ((LongInt(YPrime3)*ViewerDist) DIV
  373.                              (ZPrime3+ViewerDist));
  374.             CalcX4 := 160 + ((LongInt(XPrime4)*ViewerDist) DIV
  375.                              (ZPrime4+ViewerDist));
  376.             CalcY4 := 100 + ((LongInt(YPrime4)*ViewerDist) DIV
  377.                              (ZPrime4+ViewerDist));
  378.             { Draw Shape }
  379.             DrawLine (CalcX1, CalcY1, CalcX2, CalcY2, Color);
  380.             DrawLine (CalcX2, CalcY2, CalcX3, CalcY3, Color);
  381.             DrawLine (CalcX3, CalcY3, CalcX4, CalcY4, Color);
  382.             DrawLine (CalcX4, CalcY4, CalcX1, CalcY1, Color);
  383.             DrawPolyFromList (PolyList^, WorkPage^, Color);
  384.             CurrentFacet := CurrentFacet^.NextFacet;
  385.        End;
  386. End;
  387. {-[ Build Background ]-----------------------------------------------------}
  388. Procedure BuildBackground (Var BufferIn : VGAArray);
  389. Var CounterX,
  390.     CounterY  : Integer;
  391. Begin
  392.      For CounterY := 0 to 199 do
  393.       For CounterX := 0 to 319 do
  394.           BufferIn[CounterY, CounterX] := 1 + ((CounterY MOD 5) * 5) +
  395.                                                (CounterX MOD 5);
  396. End;
  397. {-[ Build Palette ]--------------------------------------------------------}
  398. Procedure BuildPalette (Var PaletteOut : PaletteType);
  399. Const BC = 16;
  400. Var Counter1,
  401.     Counter2  : Integer;
  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.