169 lines
3.4 KiB
ObjectPascal
169 lines
3.4 KiB
ObjectPascal
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.
|
|
|
|
|