home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / PHRO.ZIP / FIRE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-07-21  |  6.1 KB  |  286 lines
  1. {   Intro Fire Rountes Source File             }
  2. {   PHRO!                                      }
  3. {   Phred/OTM                                  }
  4. {   achalfin@uceng.uc.edu                      }
  5. {   DO NOT DISTRIBUTE THIS SOURCE FILE         }
  6. Unit Fire;
  7. {$G+}
  8.  
  9. Interface
  10.  
  11. Procedure StartFire;
  12. Procedure ENVPhro;
  13.  
  14. Implementation
  15.  
  16. Uses Palettes, Pcx, VecData, Vector;
  17.  
  18. Type
  19.   tBuffer = Array[0..75*320] of Byte;
  20.   pBuffer = ^tBuffer;
  21.  
  22. Var
  23.   FireBuffer : pBuffer;
  24.  
  25. Procedure SetFPalette(P : Pointer);
  26.  
  27. Type
  28.   RGB = Record
  29.     r, g, b : Byte;
  30.   End;
  31.   Pal = Array[0..255] of RGB;
  32.  
  33. Var
  34.   Palette : Pal;
  35.   Count : Integer;
  36.  
  37. Begin
  38.   Move(P^, Palette, 768);
  39.   For Count := 0 to 255 do
  40.     Begin
  41.       Port[$3c8] := Count;
  42.       Port[$3c9] := Palette[Count].r;
  43.       Port[$3c9] := Palette[Count].g;
  44.       Port[$3c9] := Palette[Count].b;
  45.     End;
  46. End;
  47.  
  48. Procedure DoPhire(StartFire : Byte);
  49.  
  50. Var
  51.   Count : Integer;
  52.   Temp : Byte;
  53.   xCount, yCount : Integer;
  54.  
  55. Begin
  56.   For Count := 0 to 319 do
  57.     FireBuffer^[74*320+Count] := Random(2)*StartFire;
  58.   Asm
  59.     Les  di,FireBuffer
  60.     Mov  dx,di
  61.     Add  di,74*320-1
  62.     Xor  ax,ax
  63.     Xor  bx,bx
  64.    @Looper:
  65.     Mov  al,es:[di+319]
  66.     Mov  bl,es:[di+320]
  67.     Add  ax,bx
  68.     Mov  bl,es:[di+321]
  69.     Add  ax,bx
  70.     Mov  bl,es:[di]
  71.     Add  ax,bx
  72.     Shr  ax,2
  73.     Jz @SkipDec
  74.     Dec  ax
  75.    @SkipDec:
  76.     Mov  es:[di],al
  77.     Dec  di
  78.     Cmp  dx,di
  79.     Jne @Looper
  80.   End;
  81.   For Count := 0 to 74 do
  82.     Move(FireBuffer^[Count*320], Mem[$A000:(125+Count)*320], 320);
  83. End;
  84.  
  85. Procedure StartFire;
  86.  
  87. Var
  88.   Count : Integer;
  89.  
  90. Begin
  91.   Asm
  92.     Mov  ax,13h  { Initialize GFX mode }
  93.     Int  10h
  94.   End;
  95.   New(FireBuffer);
  96.   FillChar(FireBuffer^[0], 75*320, 0);
  97.   SetFPalette(FirePalettePtr);
  98.   For Count := 0 to 255 do
  99.     DoPhire(Count);
  100.   For Count := 0 to 255 do
  101.     DoPhire(255);
  102.   For Count := 255 downto 0 do
  103.     DoPhire(Count);
  104.   Dispose(FireBuffer);
  105. End;
  106.  
  107. Procedure ClearPage(P : Pointer); Assembler;
  108.  
  109. Asm
  110.   Les  di,P
  111.   Mov  cx,16000
  112.   db 66h; Xor  ax,ax
  113.   db 66h; Rep Stosw
  114. End;
  115.  
  116. Procedure CopyPage(P : Pointer); Assembler;
  117.  
  118. Asm
  119.   Push  ds
  120.   Mov   ax,$A000
  121.   Mov   es,ax
  122.   Xor   di,di
  123.   Lds   si,P
  124.   db 66h; Mov   cx,16000; dw 0;
  125.   db 66h; Rep Movsw
  126.   Pop   ds
  127. End;
  128.  
  129. Procedure PhroVector(eMap, vPage : Pointer);
  130.  
  131. Type
  132.   RGB = Record
  133.     r, g, b : Byte;
  134.   End;
  135.   Palette = Array[0..255] of RGB;
  136.  
  137.  
  138. Var
  139.   R : Word;
  140.   NumInPath : Integer;
  141.   Zoom : Longint;
  142.   Angle : Longint;
  143.   AngleStep : Longint;
  144.   Pal : Palette;
  145.   Count : Integer;
  146.  
  147. Begin
  148.   NumInPath := 50;
  149.   SetFPalette(EnvFirePalettePtr);
  150.   Move(EnvFirePalettePtr^, Pal, 768);
  151.   InitVectorRoutines(900);
  152.   LoadVectorObject(PhroVOPtr, 0, cPhongPoly);
  153.   SelectEnable(0, 1, eMap);   { Enable Phro object }
  154.   LoadVectorObject(DonutVOPtr, 1, cGouraudPoly);
  155.   SelectEnable(1, 0, Nil);
  156.   Angle := 0;
  157.   AngleStep := ((2000-400) Shl 8) Div 512;
  158.   Zoom := 2000;
  159.   While Zoom > 360 do
  160.     Begin
  161.       Location(0, 0, 0, Zoom, 0, (Angle Shr 8) and 511, (Angle Shr 8) and 511);
  162.       ClearPage(VPage);
  163.       DisplayVectorObjects(Seg(VPage^));
  164.       CopyPage(VPage);
  165.       Angle := (Angle+AngleStep);
  166.       Zoom := Zoom - 10;
  167.     End;
  168.   Location(0, 0, 0, 360, 0, 0, 1);
  169.   ClearPage(VPage);
  170.   DisplayVectorObjects(Seg(VPage^));
  171.   CopyPage(VPage);
  172.  
  173.   SelectEnable(1, 1, Nil); { Enable Toroid }
  174.   Zoom := -400;
  175.   Angle := 0;
  176.   AngleStep := 4;
  177.   While (Angle < 511) do
  178.     Begin
  179.       Location(1, Zoom, 0, 360, Angle And 511, 0, Angle And 511);
  180.       ClearPage(VPage);
  181.       DisplayVectorObjects(Seg(VPage^));
  182.       CopyPage(VPage);
  183.       Angle := (Angle+AngleStep);
  184.       Zoom := Zoom + 5;
  185.       If Zoom >= 0
  186.         Then Zoom := 0;
  187.     End;
  188.   Angle := 0;
  189.   AngleStep := 4;
  190.   For Zoom := 0 to 256 do
  191.     Begin
  192.       Location(0, 0, 0, 360, Angle And 511, Angle And 511, Angle And 511); { Phro rotate }
  193.       Location(1, 0, 0, 360, Angle And 511, 0, Angle And 511);
  194.       ClearPage(VPage);
  195.       DisplayVectorObjects(Seg(VPage^));
  196.       CopyPage(VPage);
  197.       Angle := (Angle+AngleStep);
  198.     End;
  199.   Zoom := 0;
  200.   Angle := 0;
  201.   While (Zoom < 400) do
  202.     Begin
  203.       Location(0, 0, Zoom, 360, 0, 0, Angle And 511);
  204.       ClearPage(VPage);
  205.       DisplayVectorObjects(Seg(VPage^));
  206.       CopyPage(VPage);
  207.       Angle := Angle + AngleStep;
  208.       Zoom := Zoom + 5;
  209.     End;
  210.   SelectEnable(0, 0, Nil); { Disable "Phro" }
  211.   { do toroid Zoom in and Palette fade to white }
  212.   Zoom := 360;
  213.   Angle := 0;
  214.   While Zoom > 213 do
  215.     Begin
  216.       Location(1, 0, 0, Zoom, Angle and 511, 0, Angle And 511);
  217.       ClearPage(VPage);
  218.       DisplayVectorObjects(Seg(VPage^));
  219.       CopyPage(VPage);
  220.       Angle := Angle + AngleStep;
  221.       Zoom := Zoom - 3;
  222.     End;
  223.   While Zoom > 150 do
  224.     Begin
  225.       For Count := 0 to 255 do
  226.         Begin
  227.           If Pal[Count].r < 63
  228.             Then Inc(Pal[Count].r);
  229.           If Pal[Count].g < 63
  230.             Then Inc(Pal[Count].g);
  231.           If Pal[Count].b < 63
  232.             Then Inc(Pal[Count].b);
  233.         End;
  234.       Location(1, 0, 0, Zoom, Angle and 511, 0, Angle And 511);
  235.       ClearPage(VPage);
  236.       DisplayVectorObjects(Seg(VPage^));
  237.       CopyPage(VPage);
  238.       Asm
  239.         Mov  dx,$3da
  240.        @Looper:
  241.         In   al,dx
  242.         And  al,8
  243.         Jz  @Looper
  244.       End;
  245.       For Count := 0 to 255 do
  246.         Begin
  247.           Port[$3c8] := Count;
  248.           Port[$3c9] := Pal[Count].r;
  249.           Port[$3c9] := Pal[Count].g;
  250.           Port[$3c9] := Pal[Count].b;
  251.         End;
  252.       Angle := Angle + AngleStep;
  253.       Zoom := Zoom - 1;
  254.     End;
  255.   For Count := 0 to 255 do
  256.     Begin
  257.       Port[$3c8] := Count;
  258.       Port[$3c9] := 63;
  259.       Port[$3c9] := 63;
  260.       Port[$3c9] := 63;
  261.     End;
  262.   FreeVectorObject(0);
  263.   FreeVectorObject(1);
  264.   CloseVectorRoutines;
  265. End;
  266.  
  267. Procedure EnvPhro;
  268.  
  269. Type
  270.   tMap = Array[0..256*256-2] of Byte;
  271.   pMap = ^TMap;
  272.  
  273. Var
  274.   EnvMap : pMap;
  275.   VPage : pMap;
  276.  
  277. Begin
  278.   New(EnvMap);
  279.   New(VPage);
  280.   DeCompressPCX(EnvMap^, PhirePCXPtr^);
  281.   PhroVector(EnvMap, VPage);
  282.   Dispose(VPage);
  283.   Dispose(EnvMap);
  284. End;
  285.  
  286. End.