[Back to EGAVGA SWAG index] [Back to Main SWAG index] [Original]
{
> All this posting about programming flame and which 3x3 grid thing gives
> the best results has got me interested. Can anyone post some _FAST_ flame
> code?
Here is a routine I wrote a while ago. It is PAS with a lot of ASM for
speed, but we are still on topic :-). It draws a fire from the right side
of the screen to the left. I was going to use this as a scroller type
thing but didn't get around to it so far.
}
program fire01; {$g+,x+}
uses crt;
type
pal=array[0..255,1..3]of byte;
color=array[1..3] of byte;
pplanes=^tplanes;
tplanes=array[0..3,0..199,0..79]of byte;
pfire=^tfire;
tfire=array[0..99,0..159]of byte;
var
i,j,origmode:integer;
palette,firepal,zeropal:pal;
planes:pplanes;
fire:pfire;
Procedure WaitRetrace; Assembler;
Asm
Mov DX,3DAh
@L1:
In AL,DX
Test AL,08
Jne @L1
@L2:
In AL,DX
Test AL,08
Je @L2
End;
procedure vmode13h;assembler;
asm
mov ax,0013h
int 10h
end;
procedure vmodeuc;assembler;
asm
call vmode13h
mov ax,0604h
mov dx,3c4h
out dx,ax
mov dx,3d4h
mov ax,0e317h
out dx,ax
mov ax,0014h
out dx,ax
end;
procedure vselectbitplanes(i:byte);assembler;
asm
mov ah,i
mov al,2
mov dx,3c4h
out dx,ax
end;
procedure vputpix(x,y:word;color:byte);assembler;
asm
mov cx,x
shl cx,6
shr cl,6
mov ax,102h
shl ah,cl
mov dx,3c4h
out dx,ax
mov ax, $a000
mov es,ax
shr cx,8
mov ax,y
mov bx,ax
shl bx,4
shl ax,6
add ax,bx
mov di,ax
add di,cx
mov bl,color
mov [es:di],bl
end;
procedure writeplanes(planes:pplanes);assembler;
asm
cld
push ds
mov cx,4
mov ax,$a000
mov es,ax
@loop1:
push cx
neg cl
add cl,4
mov ax,0102h
shl ah,cl
mov dx,3c4h
out dx,ax
mov di,0
mov ax,word ptr planes[2]
mov ds,ax
mov ax,word ptr planes
or cl,cl
jz @1
@2:
add ax,16000
loop @2
@1:
mov si,ax
mov cx,16000
rep movsb
pop cx
loop @loop1
pop ds
end;
procedure vclrscr(i:byte);
begin
vselectbitplanes(15);
fillchar(ptr($a000,0000)^,65535,i);
end;
procedure getpal(var l:pal);
var i,j:byte;
begin
for i:=0 to 255 do begin
port[$3c7]:=i;
for j:=1 to 3 do l[i,j]:=port[$3c9];
end;
end;
procedure setpal(l:pal);
var i,j:byte;
begin
for i:=0 to 255 do begin
port[$3c8]:=i;
for j:=1 to 3 do port[$3c9]:=l[i,j];
end;
end;
procedure loadpal(s:string;var palette:pal);
var f:file;
begin
assign(f,s);
reset(f,1);
blockread(f,palette,768);
close(f);
end;
procedure fadeto(start,stop:byte;dest:pal);
var
i,j:byte;
c:color;
begin
for i:=start to stop do begin
port[$3c7]:=i;
for j:=1 to 3 do begin
c[j]:=port[$3c9];
if c[j]>dest[i,j] then dec(c[j]);
if c[j]<dest[i,j] then inc(c[j]);
end;
port[$3c8]:=i;
for j:=1 to 3 do port[$3c9]:=c[j];
end;
end;
procedure fadeout(start,stop:byte);
var i,j:byte;
c:color;
begin
for i:=start to stop do begin
port[$3c7]:=i;
for j:=1 to 3 do begin
c[j]:=port[$3c9];
if c[j]>1 then dec(c[j]) else c[j]:=0;
end;
port[$3c8]:=i;
for j:=1 to 3 do port[$3c9]:=c[j];
end;
end;
procedure calcfire(fire:pfire);assembler;
asm
les di,fire
mov cx,159
add di,1
xor ax,ax
xor bx,bx
xor dx,dx
@loop1:
push cx
mov cx,98
@loop2:
add di,159
xor ax,ax
mov al,[es:di+2]
add al,[es:di+1]
adc ah,0
add al,[es:di-159]
adc ah,0
add al,[es:di+161]
adc ah,0
add ax,1
shr ax,2
stosb
loop @loop2
sub di,160*98-1
pop cx
loop @loop1
mov cx,80
mov ax,0
mov di,0
rep stosw
mov cx,80
mov di,16000-160
rep stosw
mov cx,100
mov di,0
@loop3:
add di,159
stosb
loop @loop3
end;
procedure writefire(fire:pfire);assembler;
asm
push ds
lds si,fire
add si,160
mov ax,$a000
mov es,ax
mov di,160
mov ax,0302h
mov dx,3c4h
out dx,ax
mov cx,98
@loopa:
push cx
mov cx,80
@loop1:
lodsw
stosb
loop @loop1
sub si,160
mov cx,80
@loop2:
lodsw
stosb
loop @loop2
pop cx
loop @loopa
lds si,fire
add si,160
mov ax,$a000
mov es,ax
mov di,160
mov ax,0c02h
out dx,ax
mov cx,98
@loopb:
push cx
mov cx,80
@loop3:
lodsw
shr ax,8
stosb
loop @loop3
sub si,160
mov cx,80
@loop4:
lodsw
shr ax,8
stosb
loop @loop4
pop cx
loop @loopb
pop ds
end;
begin
origmode:=lastmode;
getpal(palette);
fillchar(zeropal,768,0);
for i:=1 to 64 do begin
fadeto(0,255,zeropal);
delay(10);
end;
loadpal('pal1.pal',firepal);
vmodeuc;
vclrscr(0);
randomize;
setpal(firepal);
new(fire);
fillchar(fire^,16000,0);
writefire(fire);
readkey;
repeat
for i:=20 to 70 do fire^[i,159]:=random(30);
for i:=1 to 20 do fire^[20+random(50),159]:=255;
calcfire(fire);
writefire(fire);
until keypressed;
readkey;
for i:=1 to 64 do begin
fadeto(0,255,zeropal);
delay(10);
end;
textmode (origmode);
end.
-------------------------------------------
And here is pal1.pal which is needed by the program. Well, you could
include it in the code, but what the heck...
----------------------------------------------
section 1 of uuencode 4.02 of file pal1.pal by R.E.M.
begin 644 pal1.pal
M```````!`0`"`0`#`@$$`P$&!`$'!0$(!@$*!P(+"`(-"0(."@,/"@,1"P,2O
M#`03#005#@06#P48$`49$04:$@8<$P8<%08=%@8>&`8>&@8?'`8@'08@'P<AY
M(0<A(@<A(P<@(P<?)`<?)0<>)0<=)@<<)P<;)P@:*`@8*0@7*0@6*@@5*P@3]
M*P@2+`@0+`@/+0@-+@@++@D*+PD(,`L),`X),0\),A(),Q,),Q,),Q,),Q,)T
M,Q,),Q0),Q0),Q0*,Q0*,Q0*,Q4*,Q4*,Q4*,Q4*,Q4+,Q8+,Q8+,Q8+,Q8++
M,Q8+,Q<+,Q<+,Q<+,Q<,,Q<,,Q@,,Q@,,Q@,-!@,-!@,-!D,-!D,-!D--!D-_
M-!D--!D--!H--!H--!H--!H.-!H.-!H.-!L.-!L.-!L.-!L.-!L/-!P/-!P/6
M-!P/-!P/-!P/-!P/-!T/-!T/-!T0-!T0-!T0-!X0-1X0-1X0-1X0-1X1-1X1B
M-1X1-1\1-1\1-1\1-1\1-1\1-2`1-2`2-2`2-2`2-2`2-2$2-2$2-2$2-2$3'
M-2$3-2$3-2$3-2(3-2(3-2(3-2(4-2(4-2(4-2,4-2,4-2,4-B,4-B,5-B,5M
M-B05-B05-B06-B06-B46-B46-B47-B47-B88-B88-B88-R89-R89-R<9-R<:>
M-R<:-R<:-R@;-R@;-R@<-R@<-R@<."D=."D=."D=."H>."H>."H>."H?."H?R
M."L?."L@."L@."LA.2PA.2PB.2PB.2TB.2TC.2TC.2TC.2TD.2XD.2XD.2XE-
M.2XE.B\F.B\F.B\F.B\G.C`G.C`H.C`H.C`H.C$I.C$I.C$J.S(J.S(J.S(K>
M.S(K.S,L.S,L.S,L.S,M.S,M.S0N.S0N.S0N/#4O/#4O/#4P/#4P/#8Q/#8Q<
M/#8R/#8R/#<R/#<S/#<S/#<S/3@T/3@T/3@U/3DU/3DV/3DV/3HW/3HW/3HW4
M/3HX/3LX/CLY/CLY/CLY/CPZ/CPZ/CP[/CT[/CT\/CT\/CT]/CX]/CX]/SX^P
#/S\_]
``
end
sum -r/size 33571/1104 section (from "begin" to "end")
sum -r/size 13047/768 entire input file
[Back to EGAVGA SWAG index] [Back to Main SWAG index] [Original]