home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / PHRO.ZIP / TUNNEL.PAS < prev    next >
Pascal/Delphi Source File  |  1995-07-21  |  11KB  |  453 lines
  1. {   Gouruad Tunnel Source File                 }
  2. {   PHRO!                                      }
  3. {   Phred/OTM                                  }
  4. {   achalfin@uceng.uc.edu                      }
  5. {   DO NOT DISTRIBUTE THIS SOURCE FILE         }
  6. Unit Tunnel;
  7. {$G+}
  8.  
  9. Interface
  10.  
  11. Procedure DoTunnel;
  12.  
  13. Implementation
  14.  
  15. Uses Polygons;
  16.  
  17. Type
  18.   RGB = Record
  19.     r, g, b : Byte;
  20.   End;
  21.   Palette = Array[0..255] of RGB;
  22.   SCoord = Record
  23.     x, y : Integer;
  24.   End;
  25.   LCoord = Record
  26.     x, y, z : Integer;
  27.     t : Integer;
  28.   End;
  29.   PathRec = Array[0..14] of LCoord;
  30.   TCircle = Array[0..15] of SCoord;
  31.   tType = Array[0..65534] of Byte;
  32.   pType = ^tType;
  33.  
  34. Var
  35.   Pal : Palette;
  36.   Circle : Array[0..14] of TCircle;
  37.   TwistCount : Integer;
  38.   Path : PathRec;
  39.   HorizontalSway : Array[0..255] of Integer;
  40.   VerticalSway : Array[0..255] of Integer;
  41.   vPage : pType;
  42.  
  43. Procedure CalcCircle;
  44.  
  45. Var
  46.   Count : Integer;
  47.   Count2 : Integer;
  48.  
  49. Begin
  50.   For Count2 := 0 to 14 do
  51.     For Count := 0 to 11 do
  52.       Begin
  53.         Circle[Count2][Count].x := Round(50*Cos((Count2*2*Pi/(15*5.2))+(Count*2*Pi/12)));
  54.         Circle[Count2][Count].y := Round(50*Sin((Count2*2*Pi/(15*5.2))+(Count*2*Pi/12)));
  55.       End;
  56. End;
  57.  
  58. Procedure DrawPath(ViewerZ : Integer);
  59.  
  60. Var
  61.   sx, sy : Integer;
  62.   CircleCount, Count : Integer;
  63.   Polygon : Array[0..3] of SCoord;
  64.   Div1, Div2 : Integer;
  65.   Color1, Color2 : Integer;
  66.   Base : Byte;
  67.  
  68. Begin
  69.   For CircleCount := 14 downto 1 do
  70.     Begin
  71.       Div1 := Path[CircleCount].z-ViewerZ;
  72.       Div2 := Path[CircleCount-1].z-ViewerZ;
  73.       Color1 := Div1 Shr 2;
  74.       Color2 := Div2 Shr 2;
  75.       
  76.       For Count := 0 to 10 do
  77.         Begin
  78.           Asm
  79.             Mov  bl,0
  80.             Mov  ax,Count
  81.             Test ax,1
  82.             Jne @SkipBase
  83.             Mov  bl,64
  84.            @SkipBase:
  85.             Mov  Base,bl
  86.  
  87.             Mov  bx,TwistCount
  88.             Shl  bx,6            { Get to vertex information }
  89.             Mov  dx,Count
  90.             Shl  dx,2
  91.             Add  bx,dx
  92.  
  93.             Mov  di,CircleCount
  94.             Shl  di,3
  95.  
  96.             { Polygon[0] }
  97.  
  98.             Mov  cx,Div1
  99.  
  100.             Mov  ax,Word Ptr [Circle+bx]
  101.             Cwd
  102.             Shl  ax,8
  103.             IDiv cx
  104.             Add  ax,Word Ptr [Path+di]
  105.             Mov  Word Ptr [Polygon],ax
  106.             Mov  ax,Word Ptr [Circle+bx+2]
  107.             Cwd
  108.             Shl  ax,8
  109.             IDiv cx
  110.             Add  ax,Word Ptr [Path+di+2]
  111.             Mov  Word Ptr [Polygon+2],ax
  112.  
  113.             { Do Polygon[1] }
  114.  
  115.             Mov  ax,Word Ptr [Circle+bx+4]
  116.             Cwd
  117.             Shl  ax,8
  118.             IDiv cx
  119.             Add  ax,Word Ptr [Path+di]
  120.             Mov  Word Ptr [Polygon+4],ax
  121.             Mov  ax,Word Ptr [Circle+bx+6]
  122.             Cwd
  123.             Shl  ax,8
  124.             IDiv cx
  125.             Add  ax,Word Ptr [Path+di+2]
  126.             Mov  Word Ptr [Polygon+6],ax
  127.  
  128.             { Polygon[2] }
  129.  
  130.             Sub  bx,64
  131.             Sub  di,8
  132.             Mov  cx,Div2
  133.  
  134.             Mov  ax,Word Ptr [Circle+bx+4]
  135.             Cwd
  136.             Shl  ax,8
  137.             IDiv cx
  138.             Add  ax,Word Ptr [Path+di]
  139.             Mov  Word Ptr [Polygon+8],ax
  140.             Mov  ax,Word Ptr [Circle+bx+6]
  141.             Cwd
  142.             Shl  ax,8
  143.             IDiv cx
  144.             Add  ax,Word Ptr [Path+di+2]
  145.             Mov  Word Ptr [Polygon+10],ax
  146.  
  147.             Mov  ax,Word Ptr [Circle+bx]
  148.             Cwd
  149.             Shl  ax,8
  150.             IDiv cx
  151.             Add  ax,Word Ptr [Path+di]
  152.             Mov  Word Ptr [Polygon+12],ax
  153.             Mov  ax,Word Ptr [Circle+bx+2]
  154.             Cwd
  155.             Shl  ax,8
  156.             IDiv cx
  157.             Add  ax,Word Ptr [Path+di+2]
  158.             Mov  Word Ptr [Polygon+14],ax
  159.           End;
  160.           GouraudClipPolygon(Polygon[0].x, Polygon[0].y,
  161.                       Polygon[1].x, Polygon[1].y,
  162.                       Polygon[2].x, Polygon[2].y,
  163.                       Color1 + Base, Color1 + Base, Color2 + Base, Seg(VPage^));
  164.           GouraudClipPolygon(Polygon[0].x, Polygon[0].y,
  165.                       Polygon[2].x, Polygon[2].y,
  166.                       Polygon[3].x, Polygon[3].y,
  167.                       Color1 + Base, Color2 + Base, Color2 + Base, Seg(VPage^));
  168.         End;
  169.         Polygon[0].x := (Circle[TwistCount][11].x) Shl 8 Div Div1 + Path[CircleCount].x;
  170.         Polygon[0].y := (Circle[TwistCount][11].y) Shl 8 Div Div1 + Path[CircleCount].y;
  171.         Polygon[1].x := (Circle[TwistCount][0].x) Shl 8 Div Div1 + Path[CircleCount].x;
  172.         Polygon[1].y := (Circle[TwistCount][0].y) Shl 8 Div Div1 + Path[CircleCount].y;
  173.         Polygon[2].x := (Circle[TWistCount-1][0].x) Shl 8 Div Div2 + Path[CircleCount-1].x;
  174.         Polygon[2].y := (Circle[TwistCount-1][0].y) Shl 8 Div Div2 + Path[CircleCount-1].y;
  175.         Polygon[3].x := (Circle[TwistCount-1][11].x) Shl 8 Div Div2 + Path[CircleCount-1].x;
  176.         Polygon[3].y := (Circle[TwistCount-1][11].y) Shl 8 Div Div2 + Path[CircleCount-1].y;
  177.  
  178.         GouraudClipPolygon(Polygon[0].x, Polygon[0].y,
  179.                     Polygon[1].x, Polygon[1].y,
  180.                     Polygon[2].x, Polygon[2].y,
  181.                     Color1, Color1, Color2, Seg(VPage^));
  182.         GouraudClipPolygon(Polygon[0].x, Polygon[0].y,
  183.                     Polygon[2].x, Polygon[2].y,
  184.                     Polygon[3].x, Polygon[3].y,
  185.                     Color1, Color2, Color2, Seg(VPage^));
  186.  
  187.         TwistCount := TwistCount - 1;
  188.         If TwistCount <= 1
  189.           Then TwistCount := 14;
  190.       End;
  191. End;
  192.  
  193. Procedure MakePath;
  194.  
  195. Var
  196.   Count : Integer;
  197.  
  198. Begin
  199.   For Count := 0 to 255 do
  200.     Begin
  201.       HorizontalSway[Count] := Round(50*Sin(Count*2*Pi/256)) + 160;
  202.       VerticalSway[Count] := Round(45*Sin(Count*2*Pi/256)) + 100;
  203.     End;
  204.   For Count := 0 to 14 do
  205.     Begin
  206.       Path[Count].z := (Count+1) * 20;
  207.       Path[Count].x := 160;
  208.       Path[Count].y := 100;
  209.     End;
  210. End;
  211.  
  212. Procedure ClearPage(P : Pointer); Assembler;
  213.  
  214. Asm
  215.   Les  di,P
  216.   Mov  cx,16000
  217.   db 66h; Xor  ax,ax
  218.   db 66h; Rep Stosw
  219. End;
  220.  
  221. Procedure CopyPage(P : Pointer); Assembler;
  222.  
  223. Asm
  224.   Push  ds
  225.   Mov   ax,$A000
  226.   Mov   es,ax
  227.   Xor   di,di
  228.   Lds   si,P
  229.   db 66h; Mov   cx,16000; dw 0;
  230.   db 66h; Rep Movsw
  231.   Pop   ds
  232. End;
  233.  
  234. Procedure DoAnim;
  235.  
  236. Var
  237.   Count : Integer;
  238.   Angle1 : Integer;
  239.   Angle2 : Integer;
  240.   FrameCount : Integer;
  241.   Pal1 : Palette;
  242.  
  243. Begin
  244.   ClearPage(VPage);
  245.   TwistCount := 14;
  246.   Angle1 := 0;
  247.   Angle2 := 0;
  248.   FillChar(Pal1, 768, 63);
  249.   Pal[0].r := 0;
  250.   Pal[0].g := 0;
  251.   Pal[0].b := 0;
  252.   For FrameCount := 0 to 63 do
  253.     Begin
  254.       For Count := 0 to 255 do
  255.         Begin
  256.           If Pal1[Count].r < Pal[Count].r
  257.             Then Inc(Pal1[Count].r);
  258.           If Pal1[Count].r > Pal[Count].r
  259.             Then Dec(Pal1[Count].r);
  260.           If Pal1[Count].g < Pal[Count].g
  261.             Then Inc(Pal1[Count].g);
  262.           If Pal1[Count].g > Pal[Count].g
  263.             Then Dec(Pal1[Count].g);
  264.           If Pal1[Count].b < Pal[Count].b
  265.             Then Inc(Pal1[Count].b);
  266.           If Pal1[Count].b > Pal[Count].b
  267.             Then Dec(Pal1[Count].b);
  268.         End;
  269.       Asm
  270.         Mov  dx,$3da
  271.        @Looper:
  272.         In   al,dx
  273.         And  al,8
  274.         Jz  @Looper
  275.       End;
  276.       Asm
  277.         Mov  dx,$3c8
  278.         Xor  al,al
  279.         Out  dx,al
  280.         Inc  dx
  281.         Mov  si,0
  282.         Mov  cx,768
  283.  
  284.        @Looper:
  285.         Mov  al,Byte Ptr [Pal1+si]
  286.         Out  dx,al
  287.         Inc  si
  288.         Dec  cx
  289.         Jnz @Looper
  290.       End;
  291.       For Count := 0 to 1 do
  292.         Begin
  293.           DrawPath(Count*10);
  294.           CopyPage(VPage);
  295.           ClearPage(VPage);
  296.         End;
  297.       Asm
  298.         Mov  cx,14
  299.         Mov  di,8
  300.        @Looper:
  301.         db 66h; Mov  ax,Word Ptr [Path+di]
  302.         Sub  di,8
  303.         db 66h; Mov  Word Ptr [Path+di],ax
  304.         Add  di,16
  305.         Dec  cx
  306.         Jnz @Looper
  307.       End;
  308.       Path[14].x := HorizontalSway[Angle1];
  309.       Path[14].y := VerticalSway[Angle2];
  310.       Angle1 := (Angle1 + 0) And 255;
  311.       Angle2 := (Angle2 + 0) And 255;
  312.     End;
  313.  
  314.   For FrameCount := 0 to 128 do
  315.     Begin
  316.       
  317.       For Count := 0 to 1 do
  318.         Begin
  319.           DrawPath(Count*10);
  320.           Asm
  321.             Mov  dx,$3da
  322.            @Looper:
  323.             In   al,dx
  324.             And  al,8
  325.             Jz  @Looper
  326.           End;
  327.           CopyPage(VPage);
  328.           ClearPage(VPage);
  329.         End;
  330.       Asm
  331.         Mov  cx,14
  332.         Mov  di,8
  333.        @Looper:
  334.         db 66h; Mov  ax,Word Ptr [Path+di]
  335.         Sub  di,8
  336.         db 66h; Mov  Word Ptr [Path+di],ax
  337.         Add  di,16
  338.         Dec  cx
  339.         Jnz @Looper
  340.       End;
  341.       Path[14].x := HorizontalSway[Angle1];
  342.       Path[14].y := VerticalSway[Angle2];
  343.       Angle1 := (Angle1 + 10) And 255;
  344.       Angle2 := (Angle2 + 5) And 255;
  345.     End;
  346.   For FrameCount := 0 to 63 do
  347.     Begin
  348.       For Count := 0 to 255 do
  349.         Begin
  350.           If Pal1[Count].r > 0
  351.             Then Dec(Pal1[Count].r);
  352.           If Pal1[Count].g > 0
  353.             Then Dec(Pal1[Count].g);
  354.           If Pal1[Count].b > 0
  355.             Then Dec(Pal1[Count].b);
  356.         End;
  357.  
  358.       For Count := 0 to 1 do
  359.         Begin
  360.           DrawPath(Count*10);
  361.           Asm
  362.             Mov  dx,$3da
  363.            @Looper:
  364.             In   al,dx
  365.             And  al,8
  366.             Jz  @Looper
  367.           End;
  368.           CopyPage(VPage);
  369.           ClearPage(VPage);
  370.         End;
  371.       Asm
  372.         Mov  dx,$3c8
  373.         Xor  al,al
  374.         Out  dx,al
  375.         Inc  dx
  376.         Mov  si,0
  377.         Mov  cx,768
  378.  
  379.        @Looper:
  380.         Mov  al,Byte Ptr [Pal1+si]
  381.         Out  dx,al
  382.         Inc  si
  383.         Dec  cx
  384.         Jnz @Looper
  385.       End;
  386.  
  387.       Asm
  388.         Mov  cx,14
  389.         Mov  di,8
  390.        @Looper:
  391.         db 66h; Mov  ax,Word Ptr [Path+di]
  392.         Sub  di,8
  393.         db 66h; Mov  Word Ptr [Path+di],ax
  394.         Add  di,16
  395.         Dec  cx
  396.         Jnz @Looper
  397.       End;
  398.       Path[14].x := HorizontalSway[Angle1];
  399.       Path[14].y := VerticalSway[Angle2];
  400.       Angle1 := (Angle1 + 10) And 255;
  401.       Angle2 := (Angle2 + 5) And 255;
  402.     End;
  403.   For Count := 0 to 255 do
  404.     Begin
  405.       Port[$3c8] := Count;
  406.       Port[$3c9] := 0;
  407.       Port[$3c9] := 0;
  408.       Port[$3c9] := 0;
  409.     End;
  410.   FillChar(Mem[$A000:0], 64000, 0);
  411. End;
  412.  
  413. Procedure SetFadePalette(r1, g1, b1, r2, g2, b2, CStart, CEnd : Byte);
  414.  
  415. Var
  416.   RStep, GStep, BStep : Longint;
  417.   RVal, GVal, BVal : Longint;
  418.   Count : Integer;
  419.  
  420. Begin
  421.   RVal := Longint(R1) Shl 8;
  422.   GVal := Longint(G1) Shl 8;
  423.   BVal := Longint(B1) Shl 8;
  424.   RStep := Longint(R2-R1+1) Shl 8 Div (CEnd-CStart+1);
  425.   GStep := Longint(G2-G1+1) Shl 8 Div (CEnd-CStart+1);
  426.   BStep := Longint(B2-B1+1) Shl 8 Div (CEnd-CStart+1);
  427.   For Count := CStart to CEnd do
  428.     Begin
  429.       Pal[Count].r := RVal Div 256;
  430.       Pal[Count].g := GVal Div 256;
  431.       Pal[Count].b := BVal Div 256;
  432.       RVal := RVal + RStep;
  433.       GVal := GVal + gStep;
  434.       BVal := BVal + bStep;
  435.     End;
  436. End;
  437.  
  438. Procedure DoTunnel;
  439.  
  440. Begin
  441.   New(VPage);
  442.   SetFadePalette(63, 63, 0, 0, 0, 0, 1, 75);
  443.   SetFadePalette(63, 0, 0, 0, 0, 0, 76, 150);
  444.   DoAnim;
  445.   Dispose(VPage);
  446. End;
  447.  
  448.  
  449.  
  450. Begin
  451.   CalcCircle;
  452.   MakePath;
  453. End.