home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Misc / The_SOURCE#7.LHA / Source / Articles / Fire.pas
Encoding:
Pascal/Delphi Source File  |  1994-06-24  |  2.7 KB  |  126 lines
  1. {
  2. and here's the pas code.. sorry its way crap.. I was just testing it out
  3. when I wrote it.. so understand the effect, you should see the text mode
  4. version! :))
  5. }
  6. PROGRAM Testfireball;
  7.  
  8. Uses Dos,Crt;
  9.   {$M $4000,0,0 }   { 16K stack, no heap }
  10. CONST MAX=319;
  11.       MAY=199;
  12.  
  13. VAR
  14.    OldArray:Array [0..MAy,0..MAx]of byte;
  15.    NewArray:Array [0..MAy,0..MAx]of byte absolute $a000:0000;
  16.    pal:array[0..256,0..2]of byte;
  17.    i,j:integer;
  18.  
  19.  
  20. PROCEDURE Initarrays;     {clear both arrays to 0}
  21. Var i,j:integer;
  22. begin
  23.      for i:= 0 to may do
  24.          begin
  25.               for j:=0 to max do
  26.                   begin
  27.                        oldarray[i,j]:=0;
  28.                        newarray[i,j]:=0;
  29.                   end;
  30.          end;
  31. end;
  32.  
  33. procedure PAL1;   {crap way to set a palette} {change this}
  34. BEGIN
  35.      SWAPVECTORS;
  36.      exec('pal1.exe','');
  37.      swapvectors;
  38. end;
  39.  
  40.  
  41. PROCEDURE Sumnewarray;  {calc new point value by averaging surrounding pixels}
  42. var i,j:integer;
  43.     newval:word;
  44. begin
  45.      for i:= 1 to (may-1) do
  46.          begin
  47.               for j:=1 to (max-1) do
  48.                   begin
  49.                       newval:=
  50.                       (oldarray[i+1,j-1]+
  51.                        oldarray[i+1,j  ]+
  52.                        oldarray[i+1,j+1]+
  53.                        oldarray[i+2,j-1]+
  54.                        oldarray[i+2,j+1]+
  55.                        oldarray[i+3,j-1]+
  56.                        oldarray[i+3,j+1]+
  57.                        oldarray[i+3,j  ]);
  58.                        newval:=(newval shr 3);   {faster div by 8}
  59.                        if (newval>0) then dec(newval); {decrement (fadeout)}
  60.  
  61.                        newarray[i,j]:=(lo(newval));
  62.  
  63.                   end;
  64.          end;
  65.  
  66.  
  67. end;
  68.  
  69. PROCEDURE CopyNewtoold; {save new(updated) array to old}
  70. var i,j:integer;
  71. begin
  72.      for i:= 0 to may do
  73.          begin
  74.               for j:=0 to max do
  75.                   begin
  76.                        oldarray[i,j]:=newarray[i,j];
  77.                   end;
  78.          end;
  79. end;
  80.  
  81. PROCEDURE Putrandomhotspots;        {puts random hotspots on bottom line}
  82. var i,j:integer;
  83.     hotspot:integer;
  84. begin
  85. randomize;
  86. for hotspot:=0 to 60 do                 {60 hotspots.. }
  87.     begin
  88.          i:=(random(max));
  89.          j:=(may-3);
  90.          oldarray[j,i]:=255;
  91.          oldarray[j-1,i]:=255;
  92.          oldarray[j+1,i]:=255;
  93.          oldarray[j,i+1]:=255;
  94.          oldarray[j,i-1]:=255;
  95.          oldarray[j+1,i+1]:=255;
  96.          oldarray[j,i+2]:=255;
  97.     end;
  98.  
  99.  
  100. end;
  101.  
  102. Procedure Initmode(n:byte);assembler; {sets the vid mode}
  103. asm
  104.    mov  ah,0h
  105.    mov  al,n
  106.    int  10h
  107. end;
  108.  
  109.  
  110.  
  111. BEGIN
  112.     initmode(19);
  113.     Initarrays;
  114.     pal1;
  115.     repeat
  116.     putrandomhotspots;
  117.     sumnewarray;
  118.     copynewtoold;
  119.     until keypressed;
  120.     initmode(3);
  121. END.
  122. {
  123. as you can see, you need a palette procedure... but I should hope you
  124. can do that.. :))
  125. }
  126.