[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]