Code archives/Miscellaneous/Forrest fire model

This code has been declared by its author to be Public Domain code.

Download source code

Forrest fire model by DarkNature2004
A simple fire spread model based on a cellular automaton.
Graphics 640,480,16,0

SetBuffer BackBuffer()



Global sWidth=GraphicsWidth()

Global sHeight=GraphicsHeight()

Global bWidth=160

Global bHeight=120

Global tSize=4

Global p



Dim b0(bwidth,bheight)

Dim b1(bwidth,bheight)

Dim c(bwidth,bheight)



SeedRnd(MilliSecs())



Function setup()



	For y=0 To bheight-1

		For x=0 To bwidth-1

			b0(x,y)=1

			b1(x,y)=1

		Next

	Next



	For i=0 To 1+Rnd(3)

		b0(Rnd(bwidth),Rnd(bheight))=2

	Next

	
End Function



Function switchem()



	For y=0 To bheight-1

		For x=0 To bwidth-1

			b0(x,y)=b1(x,y)

		Next

	Next



End Function



Function drawboard()



	For y=0 To bheight-1

		For x=0 To bwidth-1

			
			If c(x,y)>5

				Color c(x,y),c(x,y),0

				Rect x*tsize,y*tsize,tsize,tsize,1

				c(x,y)=c(x,y)-5

			Else c(x,y)=0

			End If

							
		Next

	Next

	
End Function



Function burn()

	
	p=0

	
	For y=0 To bheight-1

		For x=0 To bwidth-1

			
			ncount=0

			For y1=y-1 To y+1

				For x1=x-1 To x+1

					If (x1>=0 And x1<=bwidth-1) And (y1>=0 And y<=bheight-1)

						If (Not(x1=x And y1=y))

							If b0(x1,y1)=2 ncount=ncount+1

						End If

					End If

				Next

			Next

			
			prob=55

			
			If b0(x,y)=2 b1(x,y)=3

			
			If ncount>0 And b0(x,y)=1

				ignite=Rnd(100)

				If ignite>prob And b0(x,y)=1

					b1(x,y)=2

					c(x,y)=255

					p=p+1

				End If

			End If

						
		Next

	Next

	
	
End Function



;ClsColor 0,0,100

setup()

t=CreateTimer(75)

While Not KeyHit(1)



	Cls



	drawboard()

	burn()

	switchem()

		
	Flip

	
	If p=0 setup()

	WaitTimer(t)



Wend

End

Comments

Diablo2004
looks good


Baystep Productions2004
I'd put burn out function like real fires, you know, when a wave meets it either gets bigger or burns out.


Code Archives Forum