fire

[stef]

Hi!

A realtime firecode

code1 shows an app of the code. It is generating a 80x80  fire. (3 times 'enlarged',3 fire images)

code2 shows a 20X80 fire. with some blending/masking operations you can use this for torches or rocketpropulsion :)

PlayBASIC Code: [Select]

; PROJECT : fire1
; AUTHOR  : stef
; CREATED : 08.12.2005
; EDITED  : 15.01.2006
; ---------------------------------------------------------------------
openscreen 800,600,32,2
scale=3
f=200
loadfont "arial",2,4*80,1

im1=newimage(800,80*scale+20)
rendertoimage im1
boxc 0,0,800,80*3+20,1,rgb(0,0,2)
setfont 2
ink 0
centertext 400,-30,"FIRE"

firim=newimage(80*scale,80*scale)

Dim col(255)
Dim table(80,80);80x80

For x=0 To 85
col(x)=rgb(x*3,0,0)
col(x+85)=rgb(255,x*3,0)
col(x+170)=rgb(255,255,x*3)
Next
do
LockBuffer

For x=1 To 78
table(x,80)=128+Rnd(127)
For y=1 To 80
c=table(x,y)-Rnd(f)
If c>0
table(x+Rnd(2)-1,y-1)=c
EndIf
rendertoimage firim
circlec x*scale,y*scale,rndrange(3,6),1,col(table(x,y))
Next
Next
dec f
if f< 8 then f=8
UnlockBuffer

rendertoscreen

drawimage firim,40,100,1
drawimage firim,270,100,1
drawimage firim,500,100,1
drawimage im1,0,100,1

sync
loop
End

PlayBASIC Code: [Select]

; PROJECT : fire2
; AUTHOR  : stef
; CREATED : 08.12.2005
; EDITED  : 15.01.2006
; ---------------------------------------------------------------------


Dim col(255)
Dim table(20,80); 20x80 

For x=0 To 85
col(x)=rgb(x*3,0,0)
col(x+85)=rgb(255,x*3,0)
col(x+170)=rgb(255,255,x*3)
Next
do
   
LockBuffer

For x=1 To 18
table(x,80)=128+Rnd(127)
For y=1 To 80
c=table(x,y)-Rnd(10)
If c>0
table(x+Rnd(2)-1,y-1)=c
EndIf
;circlec x+100,y+100,rndrange(2,4),1,col(table(x,y));this is faster than 'dotc'
dotc x+100,y+100,col(table(x,y))
Next
Next

UnlockBuffer

sync
loop
End

[kevin]

Nice, again !

[Ian Price]

Smokin'!  :D

[medwayman]

Thanks for sharing this great example  :D