Original source code back to 1994

SRC/FIRE.PAS

@@ -0,0 +1,169 @@
+Unit Fire;
+Interface
+  Procedure Greetings;
+Implementation
+
+{ need a "lot" of memory (3*64Kb=196605 Bytes) 191Kb free conventional mem }
+Uses
+  CRT,DOS,GRAPHVGA,LibUses;
+Const
+  MAxC   = $40;
+  {  Torche   }
+  BaseX  = 30;
+  BaseY  = 50;
+  MaxX   = 20;
+  SizeX  = 20;
+  maxXd2 = SizeX shr 1;
+  maxXd3 = SizeX shr 2;
+  AddX   = MaxX;
+  MaxY   = 30;
+  count1 : Word = 20;
+  debut  = (BaseY*320)+BaseX;
+  BaseC  = MaxY;
+
+Var
+  Buffer  : Pointer;
+  AddX1   : Integer;
+  Vbuf1   : Word;
+  im, Im2 : ImageInfo;
+
+Procedure Pixel(VB,MX,My,X,Y : Word; C : Byte);
+begin
+  If (X<1) OR (X>MX) OR (Y<1) Or (Y>MY) Then
+    exit;
+  Mem[VB:(Y-1)*MX+(x-1)] := C;
+End;
+
+Procedure Init;
+Var
+  X,Y : Word;
+Begin
+  Simplebuffer;
+  LoadImage(Greetings1,Im);
+  LoadImage(Greetings2,Im2);
+  PutImage(Im,0);
+  Freeimage(Im);
+  GetMem(Buffer,$FFFF);
+  FillChar(Buffer^,$FFFF,0);
+  VBuf1 := seg(Buffer^);
+End;
+
+Procedure Outit;
+Begin
+  FreeMem(Buffer,$FFFF);
+End;
+
+Procedure FireTorch;
+Var
+  X,Y : Word;
+Begin
+  For X:=1 to Count1 do
+    Pixel(VBuf1,MaxX,MaxY,Random(maxxd2)+(maxxd3),MaxY,MaxC);
+  for X:=1 to count1 shr 1 do
+    Pixel(VBuf1,MaxX,MaxY,Random(SizeX-maxxD2)+MaxxD3,maxy-5,MaxC-12);
+  for X:=1 to count1 shr 2 do
+    Pixel(VBuf1,MaxX,MaxY,Random(SizeX-MaxxD2)+MaxxD3,maxy-13,MaxC-15);
+  for X:=1 to count1 shr 3 do
+    Pixel(VBuf1,MaxX,MaxY,Random(SizeX-MaxxD2)+MaxxD3,maxy-20,MaxC-15);        asm
+          cli
+          Push  DS
+          mov   AX,VBuf1
+          mov   DS,AX
+          mov   cx,BaseC*MaxX
+          Mov   SI,0  {(MaxY-baseC+1)*maxX}
+@@BCL:    xor   AX,AX
+          xor   BX,BX
+          mov   bl,[si-1]
+          add   ax,bx
+          mov   bl,[si+1]
+          add   ax,bx
+          mov   bl,[si+MaxX]
+          add   ax,bx
+          mov   bl,[si-MaxX]
+          add   ax,bx
+
+          mov   bl,[SI+MaxX-1]
+          add   ax,bx
+          mov   bl,[SI-MaxX-1]
+          add   ax,bx
+          mov   bl,[SI-MaxX+1]
+          add   ax,bx
+          mov   bl,[SI+MaxX+1]
+          add   ax,bx
+
+          shr   Ax,3
+          or    ax,ax
+          je    @@ne
+          dec   AX
+@@Ne:     mov   [SI-AddX],al
+          inc   SI
+          dec   CX
+          jnz   @@BCL
+          Pop   DS
+          sti
+        end;
+End;
+
+Procedure PutTorche(X,Y : Word); Assembler;
+Asm
+          cli
+          push  DS
+          mov   DX,VBuf1
+          mov   DS,DX
+          Mov   AX,0A000h
+          mov   ES,AX
+          Xor   SI,SI
+          Mov   AX,Y
+          Mov   BX,320
+          Mul   BX
+          Add   AX,X
+          Mov   DI,AX
+          Mov   DX,MaxX
+          mov   BX,MaxY-3
+@@Bcl1:   Mov   CX,DX
+          Rep   Movsb
+          Add   DI,320-MaxX
+          dec   BX
+          Jnz   @@Bcl1
+          pop   DS
+          sti
+        end;
+
+Procedure Greetings;
+var
+  C : Word;
+Begin
+  Init;
+  C := 0;
+  While (C <=500) do
+    begin
+      FireTorch;
+      PutTorche(35,80);
+      PutTorche(270,80);
+      WaitVbl;
+      WaitVbl;
+      inc(C);
+    end;
+  FadeOut(0,$ff,1);
+  PutImage(im2,3);
+  PutTorche(35,80);
+  PutTorche(270,80);
+  FadeIn(0,$FF,Im2.palette,1);
+  FreeImage(Im2);
+  c := 0;
+  While (C <=500) do
+    begin
+      FireTorch;
+      PutTorche(35,80);
+      PutTorche(270,80);
+      WaitVbl;
+      WaitVbl;
+      inc(C);
+    end;
+  Outit;
+  FadeOut(0,$FF,1);
+end;
+
+End.
+
+