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.