2016 Update
This commit is contained in:
Tina Müller
parent
948b86eafa
commit
dcf5d15da3
7965 changed files with 139854 additions and 31002 deletions
|
|
@ -1,96 +1,108 @@
|
|||
'[RC] Forest Fire
|
||||
'written for FreeBASIC v16
|
||||
'written for FreeBASIC
|
||||
'Program code based on BASIC256 from Rosettacode website
|
||||
'http://rosettacode.org/wiki/Forest_fire#BASIC256
|
||||
'06-10-2016 updated/tweaked the code
|
||||
'compile with fbc -s gui
|
||||
|
||||
dim fire as double
|
||||
dim p as single
|
||||
P = 0.003 : fire = 0.00003
|
||||
gen = 0
|
||||
N = 400 : M = 400
|
||||
#Define M 400
|
||||
#Define N 640
|
||||
|
||||
dim f0(-1 to N+2,-1 to M+2)
|
||||
dim fn(-1 to N+2,-1 to M+2)
|
||||
dim number1 as double
|
||||
Dim As Double p = 0.003
|
||||
Dim As Double fire = 0.00003
|
||||
'Dim As Double number1
|
||||
Dim As Integer gen, x, y
|
||||
Dim As String press
|
||||
|
||||
white = 15 'color 15 is white
|
||||
yellow = 14 'color 14 is yellow
|
||||
black = 0 'color 0 is black
|
||||
green = 2 'color 2 is green
|
||||
red = 4 'color 4 is red
|
||||
'f0() and fn() use memory from the memory pool
|
||||
Dim As UByte f0(), fn()
|
||||
ReDim f0(-1 To N +2, -1 To M +2)
|
||||
ReDim fn(-1 To N +2, -1 To M +2)
|
||||
|
||||
screen 18 'Resolution 640x480 with at least 256 colors
|
||||
randomize timer
|
||||
Dim As UByte white = 15 'color 15 is white
|
||||
Dim As UByte yellow = 14 'color 14 is yellow
|
||||
Dim As UByte black = 0 'color 0 is black
|
||||
Dim As UByte green = 2 'color 2 is green
|
||||
Dim As UByte red = 4 'color 4 is red
|
||||
|
||||
locate 28,1
|
||||
BEEP
|
||||
Screen 18 'Resolution 640x480 with at least 256 colors
|
||||
Randomize Timer
|
||||
|
||||
Locate 28,1
|
||||
Beep
|
||||
Print " Welcome to Forest Fire"
|
||||
locate 29,1
|
||||
print " press any key to start"
|
||||
sleep
|
||||
locate 28,1
|
||||
Print " Welcome to Forest Fire"
|
||||
locate 29,1
|
||||
print " "
|
||||
Locate 29,1
|
||||
Print " press any key to start"
|
||||
Sleep
|
||||
'Locate 28,1
|
||||
'Print " Welcome to Forest Fire"
|
||||
Locate 29,1
|
||||
Print " "
|
||||
|
||||
' 1 tree, 0 empty, 2 fire
|
||||
color green ' this is green color for trees
|
||||
for x = 1 to N
|
||||
for y = 1 to M
|
||||
if rnd < 0.5 then 'populate original tree density
|
||||
f0(x,y) = 1
|
||||
pset (x,y)
|
||||
end if
|
||||
next y
|
||||
next x
|
||||
Color green ' this is green color for trees
|
||||
For x = 1 To N
|
||||
For y = 1 To M
|
||||
If Rnd < 0.5 Then 'populate original tree density
|
||||
f0(x,y) = 1
|
||||
PSet (x,y)
|
||||
End If
|
||||
Next y
|
||||
Next x
|
||||
|
||||
color white
|
||||
locate 29,1
|
||||
Print " Press any key to continue "
|
||||
sleep
|
||||
locate 29,1
|
||||
Color white
|
||||
Locate 29,1
|
||||
Print " Press any key to continue "
|
||||
Sleep
|
||||
Locate 29,1
|
||||
Print " Press 'space bar' to continue/pause, ESC to stop "
|
||||
|
||||
do
|
||||
press$ = inkey$
|
||||
for x = 1 to N
|
||||
for y = 1 to M
|
||||
if not f0(x,y) and rnd<P then fn(x,y)=1
|
||||
if f0(x,y)=2 then fn(x,y)=0
|
||||
if f0(x,y)=1 then
|
||||
fn(x,y) = 1
|
||||
if f0(x-1,y-1)=2 or f0(x,y-1)=2 or f0(x+1,y-1)=2 then fn(x,y)=2
|
||||
if f0(x-1,y)=2 or f0(x+1,y)=2 or rnd<fire then fn(x,y)=2
|
||||
if f0(x-1,y+1)=2 or f0(x,y+1)=2 or f0(x+1,y+1)=2 then fn(x,y)=2
|
||||
end if
|
||||
'set up color and drawing
|
||||
'0 empty (black), 1 tree (green), 2 fire (white)
|
||||
if fn(x,y)=0 then color black 'empty
|
||||
if fn(x,y)=1 then color green 'tree
|
||||
if fn(x,y)=2 then color white 'fire
|
||||
'plot x-1,y-1
|
||||
pset (x-1,y-1)
|
||||
next y
|
||||
next x
|
||||
'print generation number
|
||||
gen = gen + 1
|
||||
locate 28,1
|
||||
color white 'this is white color
|
||||
Print " Generation number # ";gen
|
||||
'transfer new generation to current generation
|
||||
for x = 1 to N
|
||||
for y = 1 to M
|
||||
f0(x,y) = fn(x,y)
|
||||
next y
|
||||
next x
|
||||
Do
|
||||
press = InKey
|
||||
ScreenLock
|
||||
For x = 1 To N
|
||||
For y = 1 To M
|
||||
If Not f0(x,y) And Rnd<P Then fn(x,y)=1
|
||||
If f0(x,y)=2 Then fn(x,y)=0
|
||||
If f0(x,y)=1 Then
|
||||
fn(x,y) = 1
|
||||
If f0(x-1,y-1)=2 OrElse f0(x,y-1)=2 OrElse f0(x+1,y-1)=2 Then fn(x,y)=2
|
||||
If f0(x-1,y)=2 OrElse f0(x+1,y)=2 OrElse Rnd<fire Then fn(x,y)=2
|
||||
If f0(x-1,y+1)=2 OrElse f0(x,y+1)=2 OrElse f0(x+1,y+1)=2 Then fn(x,y)=2
|
||||
End If
|
||||
'set up color and drawing
|
||||
'0 empty (black), 1 tree (green), 2 fire (white)
|
||||
If fn(x,y)=0 Then Color black 'empty
|
||||
If fn(x,y)=1 Then Color green 'tree
|
||||
If fn(x,y)=2 Then Color red 'fire
|
||||
'plot x-1,y-1
|
||||
PSet (x-1,y-1)
|
||||
Next y
|
||||
Next x
|
||||
'print generation number
|
||||
gen = gen + 1
|
||||
Locate 28,1
|
||||
Color white 'this is white color
|
||||
Print " Generation number # ";gen
|
||||
'transfer new generation to current generation
|
||||
For x = 1 To N
|
||||
For y = 1 To M
|
||||
f0(x,y) = fn(x,y)
|
||||
Next y
|
||||
Next x
|
||||
ScreenUnlock
|
||||
|
||||
sleep 3 ' slow down a little ... goes too fast otherwise
|
||||
if press$ = " " then sleep : press$ = inkey$
|
||||
if press$ = "s" then sleep
|
||||
LOOP UNTIL press$ = CHR$(27) 'return to do loop up top until "esc" key is pressed.
|
||||
' amount for sleep is in milliseconds, 1 = ignore key press
|
||||
Sleep 50, 1 ' slow down a little ... goes too fast otherwise
|
||||
If press = " " Then Sleep : press = InKey
|
||||
If press = "s" Then Sleep
|
||||
' return to do loop up top until "esc" key is pressed.
|
||||
' clicking close windows "X", closes the window immediately
|
||||
Loop Until press = Chr(27) OrElse press = Chr(255)+"k"
|
||||
If press = Chr(255) + "k" Then End
|
||||
|
||||
locate 28,1
|
||||
color white
|
||||
Print " You entered ESC - goodbye "
|
||||
Print " Press any key to exit "
|
||||
sleep
|
||||
Locate 28,1
|
||||
Color white
|
||||
Print " You entered ESC - goodbye "
|
||||
Print " Press any key to exit "
|
||||
Sleep
|
||||
|
|
|
|||
|
|
@ -1,167 +1,138 @@
|
|||
; Some systems reports high CPU-load while running this code.
|
||||
; This may likely be due to the graphic driver used in the
|
||||
; 2D-function Plot().
|
||||
; If experiencing this problem, please reduce the #Width & #Height
|
||||
; or activate the parameter #UnLoadCPU below with a parameter 1 or 2.
|
||||
;
|
||||
; This code should work with the demo version of PureBasic on both PC & Linux
|
||||
|
||||
; General parameters for the world
|
||||
#f = 1e-6
|
||||
#p = 1e-2
|
||||
#SeedATree = 0.005
|
||||
#Width = 400
|
||||
#Height = 400
|
||||
|
||||
; Setting up colours
|
||||
#Fire = $080CF7
|
||||
#BackGround = $BFD5D3
|
||||
#YoungTree = $00E300
|
||||
#NormalTree = $00AC00
|
||||
#MatureTree = $009500
|
||||
#OldTree = $007600
|
||||
#Black = $000000
|
||||
|
||||
; Depending on your hardware, use this to control the speed/CPU-load.
|
||||
; 0 = No load reduction
|
||||
; 1 = Only active about every second frame
|
||||
; 2 = '1' & release the CPU after each horizontal line.
|
||||
#UnLoadCPU = 0
|
||||
|
||||
Enumeration
|
||||
#Empty =0
|
||||
#Ignited
|
||||
#Burning
|
||||
#Tree
|
||||
#Old=#Tree+20
|
||||
EndEnumeration
|
||||
|
||||
Global Dim Forest.i(#Width, #Height)
|
||||
Global Title$="Forest fire in PureBasic"
|
||||
Global Cnt
|
||||
|
||||
Macro Rnd()
|
||||
(Random(2147483647)/2147483647.0)
|
||||
EndMacro
|
||||
|
||||
Procedure Limit(n, min, max)
|
||||
If n<min
|
||||
n=min
|
||||
ElseIf n>max
|
||||
n=max
|
||||
EndIf
|
||||
ProcedureReturn n
|
||||
EndProcedure
|
||||
|
||||
Procedure SpreadFire(x,y)
|
||||
Protected cnt=0, i, j
|
||||
For i=Limit(x-1, 0, #Width) To Limit(x+1, 0, #Width)
|
||||
For j=Limit(y-1, 0, #Height) To Limit(y+1, 0, #Height)
|
||||
If Forest(i,j)>=#Tree
|
||||
Forest(i,j)=#Ignited
|
||||
EndIf
|
||||
Next
|
||||
Next
|
||||
EndProcedure
|
||||
|
||||
Procedure InitMap()
|
||||
Protected x, y, type
|
||||
For y=1 To #Height
|
||||
For x=1 To #Width
|
||||
If Rnd()<=#SeedATree
|
||||
type=#Tree
|
||||
Else
|
||||
type=#Empty
|
||||
EndIf
|
||||
Forest(x,y)=type
|
||||
Next
|
||||
Next
|
||||
EndProcedure
|
||||
|
||||
Procedure UpdateMap()
|
||||
Protected x, y
|
||||
For y=1 To #Height
|
||||
For x=1 To #Width
|
||||
Select Forest(x,y)
|
||||
Case #Burning
|
||||
Forest(x,y)=#Empty
|
||||
SpreadFire(x,y)
|
||||
Case #Ignited
|
||||
Forest(x,y)=#Burning
|
||||
Case #Empty
|
||||
If Rnd()<=#p
|
||||
Forest(x,y)=#Tree
|
||||
EndIf
|
||||
Default
|
||||
If Rnd()<=#f
|
||||
Forest(x,y)=#Burning
|
||||
Else
|
||||
Forest(x,y)+1
|
||||
EndIf
|
||||
EndSelect
|
||||
Next
|
||||
Next
|
||||
EndProcedure
|
||||
|
||||
Procedure PresentMap()
|
||||
Protected x, y, c
|
||||
cnt+1
|
||||
SetWindowTitle(0,Title$+", time frame="+Str(cnt))
|
||||
StartDrawing(ImageOutput(1))
|
||||
For y=0 To OutputHeight()-1
|
||||
For x=0 To OutputWidth()-1
|
||||
Select Forest(x,y)
|
||||
Case #Empty
|
||||
c=#BackGround
|
||||
Case #Burning, #Ignited
|
||||
c=#Fire
|
||||
Default
|
||||
If Forest(x,y)<#Tree+#Old
|
||||
c=#YoungTree
|
||||
ElseIf Forest(x,y)<#Tree+2*#Old
|
||||
c=#NormalTree
|
||||
ElseIf Forest(x,y)<#Tree+3*#Old
|
||||
c=#MatureTree
|
||||
ElseIf Forest(x,y)<#Tree+4*#Old
|
||||
c=#OldTree
|
||||
Else ; Tree died of old age
|
||||
Forest(x,y)=#Empty
|
||||
c=#Black
|
||||
EndIf
|
||||
EndSelect
|
||||
Plot(x,y,c)
|
||||
Next
|
||||
CompilerIf #UnLoadCPU>1
|
||||
Delay(1)
|
||||
CompilerEndIf
|
||||
Next
|
||||
StopDrawing()
|
||||
ImageGadget(1, 0, 0, #Width, #Height, ImageID(1))
|
||||
EndProcedure
|
||||
|
||||
If OpenWindow(0, 10, 30, #Width, #Height, Title$, #PB_Window_MinimizeGadget)
|
||||
SmartWindowRefresh(0, 1)
|
||||
If CreateImage(1, #Width, #Height)
|
||||
Define Event, freq
|
||||
If ExamineDesktops() And DesktopFrequency(0)
|
||||
freq=DesktopFrequency(0)
|
||||
Else
|
||||
freq=60
|
||||
EndIf
|
||||
AddWindowTimer(0,0,5000/freq)
|
||||
InitMap()
|
||||
Repeat
|
||||
Event = WaitWindowEvent()
|
||||
Select Event
|
||||
Case #PB_Event_CloseWindow
|
||||
End
|
||||
Case #PB_Event_Timer
|
||||
CompilerIf #UnLoadCPU>0
|
||||
Delay(25)
|
||||
CompilerEndIf
|
||||
UpdateMap()
|
||||
PresentMap()
|
||||
EndSelect
|
||||
ForEver
|
||||
EndIf
|
||||
EndIf
|
||||
width%=80
|
||||
height%=50
|
||||
DIM world%(width%+2,height%+2,2)
|
||||
clock%=0
|
||||
'
|
||||
empty%=0 ! some mnemonic codes for the different states
|
||||
burning%=1
|
||||
tree%=2
|
||||
'
|
||||
f=0.0003
|
||||
p=0.03
|
||||
max_clock%=100
|
||||
'
|
||||
@open_window
|
||||
@setup_world
|
||||
DO
|
||||
clock%=clock%+1
|
||||
EXIT IF clock%>max_clock%
|
||||
@display_world
|
||||
@update_world
|
||||
LOOP
|
||||
@close_window
|
||||
'
|
||||
' Setup the world
|
||||
'
|
||||
PROCEDURE setup_world
|
||||
LOCAL i%,j%
|
||||
'
|
||||
RANDOMIZE 0
|
||||
ARRAYFILL world%(),empty%
|
||||
' with Probability 0.5, create tree in cells
|
||||
FOR i%=1 TO width%
|
||||
FOR j%=1 TO height%
|
||||
IF RND>0.5
|
||||
world%(i%,j%,0)=tree%
|
||||
ENDIF
|
||||
NEXT j%
|
||||
NEXT i%
|
||||
'
|
||||
cur%=0
|
||||
new%=1
|
||||
RETURN
|
||||
'
|
||||
' Display world on window
|
||||
'
|
||||
PROCEDURE display_world
|
||||
LOCAL size%,i%,j%,offsetx%,offsety%,x%,y%
|
||||
'
|
||||
size%=5
|
||||
offsetx%=10
|
||||
offsety%=20
|
||||
'
|
||||
VSETCOLOR 0,15,15,15 ! colour for empty
|
||||
VSETCOLOR 1,15,0,0 ! colour for burning
|
||||
VSETCOLOR 2,0,15,0 ! colour for tree
|
||||
VSETCOLOR 3,0,0,0 ! colour for text
|
||||
DEFTEXT 3
|
||||
PRINT AT(1,1);"Clock: ";clock%
|
||||
'
|
||||
FOR i%=1 TO width%
|
||||
FOR j%=1 TO height%
|
||||
x%=offsetx%+size%*i%
|
||||
y%=offsety%+size%*j%
|
||||
SELECT world%(i%,j%,cur%)
|
||||
CASE empty%
|
||||
DEFFILL 0
|
||||
CASE tree%
|
||||
DEFFILL 2
|
||||
CASE burning%
|
||||
DEFFILL 1
|
||||
ENDSELECT
|
||||
PBOX x%,y%,x%+size%,y%+size%
|
||||
NEXT j%
|
||||
NEXT i%
|
||||
RETURN
|
||||
'
|
||||
' Check if a neighbour is burning
|
||||
'
|
||||
FUNCTION neighbour_burning(i%,j%)
|
||||
LOCAL x%
|
||||
'
|
||||
IF world%(i%,j%-1,cur%)=burning%
|
||||
RETURN TRUE
|
||||
ENDIF
|
||||
IF world%(i%,j%+1,cur%)=burning%
|
||||
RETURN TRUE
|
||||
ENDIF
|
||||
FOR x%=-1 TO 1
|
||||
IF world%(i%-1,j%+x%,cur%)=burning% OR world%(i%+1,j%+x%,cur%)=burning%
|
||||
RETURN TRUE
|
||||
ENDIF
|
||||
NEXT x%
|
||||
RETURN FALSE
|
||||
ENDFUNC
|
||||
'
|
||||
' Update the world state
|
||||
'
|
||||
PROCEDURE update_world
|
||||
LOCAL i%,j%
|
||||
'
|
||||
FOR i%=1 TO width%
|
||||
FOR j%=1 TO height%
|
||||
world%(i%,j%,new%)=world%(i%,j%,cur%)
|
||||
SELECT world%(i%,j%,cur%)
|
||||
CASE empty%
|
||||
IF RND>1-p
|
||||
world%(i%,j%,new%)=tree%
|
||||
ENDIF
|
||||
CASE tree%
|
||||
IF @neighbour_burning(i%,j%) OR RND>1-f
|
||||
world%(i%,j%,new%)=burning%
|
||||
ENDIF
|
||||
CASE burning%
|
||||
world%(i%,j%,new%)=empty%
|
||||
ENDSELECT
|
||||
NEXT j%
|
||||
NEXT i%
|
||||
'
|
||||
cur%=1-cur%
|
||||
new%=1-new%
|
||||
RETURN
|
||||
'
|
||||
' open and clear window
|
||||
'
|
||||
PROCEDURE open_window
|
||||
OPENW 1
|
||||
CLEARW 1
|
||||
VSETCOLOR 4,8,8,0
|
||||
DEFFILL 4
|
||||
PBOX 0,0,500,400
|
||||
RETURN
|
||||
'
|
||||
' close the window after keypress
|
||||
'
|
||||
PROCEDURE close_window
|
||||
~INP(2)
|
||||
CLOSEW 1
|
||||
RETURN
|
||||
|
|
|
|||
|
|
@ -1,65 +1,167 @@
|
|||
Sub Run()
|
||||
//Handy named constants
|
||||
Const empty = 0
|
||||
Const tree = 1
|
||||
Const fire = 2
|
||||
Const ablaze = &cFF0000 //Using the &c numeric operator to indicate a color in hex
|
||||
Const alive = &c00FF00
|
||||
Const dead = &c804040
|
||||
; Some systems reports high CPU-load while running this code.
|
||||
; This may likely be due to the graphic driver used in the
|
||||
; 2D-function Plot().
|
||||
; If experiencing this problem, please reduce the #Width & #Height
|
||||
; or activate the parameter #UnLoadCPU below with a parameter 1 or 2.
|
||||
;
|
||||
; This code should work with the demo version of PureBasic on both PC & Linux
|
||||
|
||||
//Our forest
|
||||
Dim worldPic As New Picture(480, 480, 32)
|
||||
Dim newWorld(120, 120) As Integer
|
||||
Dim oldWorld(120, 120) As Integer
|
||||
; General parameters for the world
|
||||
#f = 1e-6
|
||||
#p = 1e-2
|
||||
#SeedATree = 0.005
|
||||
#Width = 400
|
||||
#Height = 400
|
||||
|
||||
//Initialize forest
|
||||
Dim rand As New Random
|
||||
For x as Integer = 0 to 119
|
||||
For y as Integer = 0 to 119
|
||||
if rand.InRange(0, 2) = 0 Or x = 119 or y = 119 or x = 0 or y = 0 Then
|
||||
newWorld(x, y) = empty
|
||||
worldPic.Graphics.ForeColor = dead
|
||||
worldPic.Graphics.FillRect(x*4, y*4, 4, 4)
|
||||
Else
|
||||
newWorld(x, y) = tree
|
||||
worldPic.Graphics.ForeColor = alive
|
||||
worldPic.Graphics.FillRect(x*4, y*4, 4, 4)
|
||||
end if
|
||||
; Setting up colours
|
||||
#Fire = $080CF7
|
||||
#BackGround = $BFD5D3
|
||||
#YoungTree = $00E300
|
||||
#NormalTree = $00AC00
|
||||
#MatureTree = $009500
|
||||
#OldTree = $007600
|
||||
#Black = $000000
|
||||
|
||||
; Depending on your hardware, use this to control the speed/CPU-load.
|
||||
; 0 = No load reduction
|
||||
; 1 = Only active about every second frame
|
||||
; 2 = '1' & release the CPU after each horizontal line.
|
||||
#UnLoadCPU = 0
|
||||
|
||||
Enumeration
|
||||
#Empty =0
|
||||
#Ignited
|
||||
#Burning
|
||||
#Tree
|
||||
#Old=#Tree+20
|
||||
EndEnumeration
|
||||
|
||||
Global Dim Forest.i(#Width, #Height)
|
||||
Global Title$="Forest fire in PureBasic"
|
||||
Global Cnt
|
||||
|
||||
Macro Rnd()
|
||||
(Random(2147483647)/2147483647.0)
|
||||
EndMacro
|
||||
|
||||
Procedure Limit(n, min, max)
|
||||
If n<min
|
||||
n=min
|
||||
ElseIf n>max
|
||||
n=max
|
||||
EndIf
|
||||
ProcedureReturn n
|
||||
EndProcedure
|
||||
|
||||
Procedure SpreadFire(x,y)
|
||||
Protected cnt=0, i, j
|
||||
For i=Limit(x-1, 0, #Width) To Limit(x+1, 0, #Width)
|
||||
For j=Limit(y-1, 0, #Height) To Limit(y+1, 0, #Height)
|
||||
If Forest(i,j)>=#Tree
|
||||
Forest(i,j)=#Ignited
|
||||
EndIf
|
||||
Next
|
||||
Next
|
||||
oldWorld = newWorld
|
||||
EndProcedure
|
||||
|
||||
//Burn, baby burn!
|
||||
While Window1.stop = False
|
||||
For x as Integer = 0 To 119
|
||||
For y As Integer = 0 to 119
|
||||
Dim willBurn As Integer = rand.InRange(0, Window1.burnProb.Value)
|
||||
Dim willGrow As Integer = rand.InRange(0, Window1.growProb.Value)
|
||||
if x = 119 or y = 119 or x = 0 or y = 0 Then
|
||||
Continue
|
||||
end if
|
||||
Select Case oldWorld(x, y)
|
||||
Case empty
|
||||
If willGrow = (Window1.growProb.Value) Then
|
||||
newWorld(x, y) = tree
|
||||
worldPic.Graphics.ForeColor = alive
|
||||
worldPic.Graphics.FillRect(x*4, y*4, 4, 4)
|
||||
end if
|
||||
Case tree
|
||||
if oldWorld(x - 1, y) = fire Or oldWorld(x, y - 1) = fire Or oldWorld(x + 1, y) = fire Or oldWorld(x, y + 1) = fire Or oldWorld(x + 1, y + 1) = fire Or oldWorld(x - 1, y - 1) = fire Or oldWorld(x - 1, y + 1) = fire Or oldWorld(x + 1, y - 1) = fire Or willBurn = (Window1.burnProb.Value) Then
|
||||
newWorld(x, y) = fire
|
||||
worldPic.Graphics.ForeColor = ablaze
|
||||
worldPic.Graphics.FillRect(x*4, y*4, 4, 4)
|
||||
end if
|
||||
Case fire
|
||||
newWorld(x, y) = empty
|
||||
worldPic.Graphics.ForeColor = dead
|
||||
worldPic.Graphics.FillRect(x*4, y*4, 4, 4)
|
||||
End Select
|
||||
Next
|
||||
Procedure InitMap()
|
||||
Protected x, y, type
|
||||
For y=1 To #Height
|
||||
For x=1 To #Width
|
||||
If Rnd()<=#SeedATree
|
||||
type=#Tree
|
||||
Else
|
||||
type=#Empty
|
||||
EndIf
|
||||
Forest(x,y)=type
|
||||
Next
|
||||
Window1.Canvas1.Graphics.DrawPicture(worldPic, 0, 0)
|
||||
oldWorld = newWorld
|
||||
me.Sleep(Window1.speed.Value)
|
||||
Wend
|
||||
End Sub
|
||||
Next
|
||||
EndProcedure
|
||||
|
||||
Procedure UpdateMap()
|
||||
Protected x, y
|
||||
For y=1 To #Height
|
||||
For x=1 To #Width
|
||||
Select Forest(x,y)
|
||||
Case #Burning
|
||||
Forest(x,y)=#Empty
|
||||
SpreadFire(x,y)
|
||||
Case #Ignited
|
||||
Forest(x,y)=#Burning
|
||||
Case #Empty
|
||||
If Rnd()<=#p
|
||||
Forest(x,y)=#Tree
|
||||
EndIf
|
||||
Default
|
||||
If Rnd()<=#f
|
||||
Forest(x,y)=#Burning
|
||||
Else
|
||||
Forest(x,y)+1
|
||||
EndIf
|
||||
EndSelect
|
||||
Next
|
||||
Next
|
||||
EndProcedure
|
||||
|
||||
Procedure PresentMap()
|
||||
Protected x, y, c
|
||||
cnt+1
|
||||
SetWindowTitle(0,Title$+", time frame="+Str(cnt))
|
||||
StartDrawing(ImageOutput(1))
|
||||
For y=0 To OutputHeight()-1
|
||||
For x=0 To OutputWidth()-1
|
||||
Select Forest(x,y)
|
||||
Case #Empty
|
||||
c=#BackGround
|
||||
Case #Burning, #Ignited
|
||||
c=#Fire
|
||||
Default
|
||||
If Forest(x,y)<#Tree+#Old
|
||||
c=#YoungTree
|
||||
ElseIf Forest(x,y)<#Tree+2*#Old
|
||||
c=#NormalTree
|
||||
ElseIf Forest(x,y)<#Tree+3*#Old
|
||||
c=#MatureTree
|
||||
ElseIf Forest(x,y)<#Tree+4*#Old
|
||||
c=#OldTree
|
||||
Else ; Tree died of old age
|
||||
Forest(x,y)=#Empty
|
||||
c=#Black
|
||||
EndIf
|
||||
EndSelect
|
||||
Plot(x,y,c)
|
||||
Next
|
||||
CompilerIf #UnLoadCPU>1
|
||||
Delay(1)
|
||||
CompilerEndIf
|
||||
Next
|
||||
StopDrawing()
|
||||
ImageGadget(1, 0, 0, #Width, #Height, ImageID(1))
|
||||
EndProcedure
|
||||
|
||||
If OpenWindow(0, 10, 30, #Width, #Height, Title$, #PB_Window_MinimizeGadget)
|
||||
SmartWindowRefresh(0, 1)
|
||||
If CreateImage(1, #Width, #Height)
|
||||
Define Event, freq
|
||||
If ExamineDesktops() And DesktopFrequency(0)
|
||||
freq=DesktopFrequency(0)
|
||||
Else
|
||||
freq=60
|
||||
EndIf
|
||||
AddWindowTimer(0,0,5000/freq)
|
||||
InitMap()
|
||||
Repeat
|
||||
Event = WaitWindowEvent()
|
||||
Select Event
|
||||
Case #PB_Event_CloseWindow
|
||||
End
|
||||
Case #PB_Event_Timer
|
||||
CompilerIf #UnLoadCPU>0
|
||||
Delay(25)
|
||||
CompilerEndIf
|
||||
UpdateMap()
|
||||
PresentMap()
|
||||
EndSelect
|
||||
ForEver
|
||||
EndIf
|
||||
EndIf
|
||||
|
|
|
|||
|
|
@ -1,11 +1,65 @@
|
|||
Sub Open()
|
||||
//First method to run on the creation of a new Window. We instantiate an instance of our forestFire thread and run it.
|
||||
Dim fire As New forestFire
|
||||
fire.Run()
|
||||
End Sub
|
||||
Sub Run()
|
||||
//Handy named constants
|
||||
Const empty = 0
|
||||
Const tree = 1
|
||||
Const fire = 2
|
||||
Const ablaze = &cFF0000 //Using the &c numeric operator to indicate a color in hex
|
||||
Const alive = &c00FF00
|
||||
Const dead = &c804040
|
||||
|
||||
stop As Boolean //a globally accessible property of Window1. Boolean properties default to False.
|
||||
//Our forest
|
||||
Dim worldPic As New Picture(480, 480, 32)
|
||||
Dim newWorld(120, 120) As Integer
|
||||
Dim oldWorld(120, 120) As Integer
|
||||
|
||||
Sub Pushbutton1.Action()
|
||||
stop = True
|
||||
//Initialize forest
|
||||
Dim rand As New Random
|
||||
For x as Integer = 0 to 119
|
||||
For y as Integer = 0 to 119
|
||||
if rand.InRange(0, 2) = 0 Or x = 119 or y = 119 or x = 0 or y = 0 Then
|
||||
newWorld(x, y) = empty
|
||||
worldPic.Graphics.ForeColor = dead
|
||||
worldPic.Graphics.FillRect(x*4, y*4, 4, 4)
|
||||
Else
|
||||
newWorld(x, y) = tree
|
||||
worldPic.Graphics.ForeColor = alive
|
||||
worldPic.Graphics.FillRect(x*4, y*4, 4, 4)
|
||||
end if
|
||||
Next
|
||||
Next
|
||||
oldWorld = newWorld
|
||||
|
||||
//Burn, baby burn!
|
||||
While Window1.stop = False
|
||||
For x as Integer = 0 To 119
|
||||
For y As Integer = 0 to 119
|
||||
Dim willBurn As Integer = rand.InRange(0, Window1.burnProb.Value)
|
||||
Dim willGrow As Integer = rand.InRange(0, Window1.growProb.Value)
|
||||
if x = 119 or y = 119 or x = 0 or y = 0 Then
|
||||
Continue
|
||||
end if
|
||||
Select Case oldWorld(x, y)
|
||||
Case empty
|
||||
If willGrow = (Window1.growProb.Value) Then
|
||||
newWorld(x, y) = tree
|
||||
worldPic.Graphics.ForeColor = alive
|
||||
worldPic.Graphics.FillRect(x*4, y*4, 4, 4)
|
||||
end if
|
||||
Case tree
|
||||
if oldWorld(x - 1, y) = fire Or oldWorld(x, y - 1) = fire Or oldWorld(x + 1, y) = fire Or oldWorld(x, y + 1) = fire Or oldWorld(x + 1, y + 1) = fire Or oldWorld(x - 1, y - 1) = fire Or oldWorld(x - 1, y + 1) = fire Or oldWorld(x + 1, y - 1) = fire Or willBurn = (Window1.burnProb.Value) Then
|
||||
newWorld(x, y) = fire
|
||||
worldPic.Graphics.ForeColor = ablaze
|
||||
worldPic.Graphics.FillRect(x*4, y*4, 4, 4)
|
||||
end if
|
||||
Case fire
|
||||
newWorld(x, y) = empty
|
||||
worldPic.Graphics.ForeColor = dead
|
||||
worldPic.Graphics.FillRect(x*4, y*4, 4, 4)
|
||||
End Select
|
||||
Next
|
||||
Next
|
||||
Window1.Canvas1.Graphics.DrawPicture(worldPic, 0, 0)
|
||||
oldWorld = newWorld
|
||||
me.Sleep(Window1.speed.Value)
|
||||
Wend
|
||||
End Sub
|
||||
|
|
|
|||
|
|
@ -1,25 +1,11 @@
|
|||
graphic #g, 200,200
|
||||
dim preGen(200,200)
|
||||
dim newGen(200,200)
|
||||
Sub Open()
|
||||
//First method to run on the creation of a new Window. We instantiate an instance of our forestFire thread and run it.
|
||||
Dim fire As New forestFire
|
||||
fire.Run()
|
||||
End Sub
|
||||
|
||||
for gen = 1 to 200
|
||||
for x = 1 to 199
|
||||
for y = 1 to 199
|
||||
select case preGen(x,y)
|
||||
case 0
|
||||
if rnd(0) > .99 then newGen(x,y) = 1 : #g "color green ; set "; x; " "; y
|
||||
case 2
|
||||
newGen(x,y) = 0 : #g "color brown ; set "; x; " "; y
|
||||
case 1
|
||||
if preGen(x-1,y-1) = 2 or preGen(x-1,y) = 2 or preGen(x-1,y+1) = 2 _
|
||||
or preGen(x,y-1) = 2 or preGen(x,y+1) = 2 or preGen(x+1,y-1) = 2 _
|
||||
or preGen(x+1,y) = 2 or preGen(x+1,y+1) = 2 or rnd(0) > .999 then
|
||||
#g "color red ; set "; x; " "; y
|
||||
newGen(x,y) = 2
|
||||
end if
|
||||
end select
|
||||
preGen(x-1,y-1) = newGen(x-1,y-1)
|
||||
next y
|
||||
next x
|
||||
next gen
|
||||
render #g
|
||||
stop As Boolean //a globally accessible property of Window1. Boolean properties default to False.
|
||||
|
||||
Sub Pushbutton1.Action()
|
||||
stop = True
|
||||
End Sub
|
||||
|
|
|
|||
|
|
@ -1,104 +1,25 @@
|
|||
Public Class ForestFire
|
||||
Private _forest(,) As ForestState
|
||||
Private _isBuilding As Boolean
|
||||
Private _bm As Bitmap
|
||||
Private _gen As Integer
|
||||
Private _sw As Stopwatch
|
||||
graphic #g, 200,200
|
||||
dim preGen(200,200)
|
||||
dim newGen(200,200)
|
||||
|
||||
Private Const _treeStart As Double = 0.5
|
||||
Private Const _f As Double = 0.00001
|
||||
Private Const _p As Double = 0.001
|
||||
|
||||
Private Const _winWidth As Integer = 300
|
||||
Private Const _winHeight As Integer = 300
|
||||
|
||||
Private Enum ForestState
|
||||
Empty
|
||||
Burning
|
||||
Tree
|
||||
End Enum
|
||||
|
||||
Private Sub ForestFire_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
|
||||
Me.ClientSize = New Size(_winWidth, _winHeight)
|
||||
ReDim _forest(_winWidth, _winHeight)
|
||||
|
||||
Dim rnd As New Random()
|
||||
For i As Integer = 0 To _winHeight - 1
|
||||
For j As Integer = 0 To _winWidth - 1
|
||||
_forest(j, i) = IIf(rnd.NextDouble <= _treeStart, ForestState.Tree, ForestState.Empty)
|
||||
Next
|
||||
Next
|
||||
|
||||
_sw = New Stopwatch
|
||||
_sw.Start()
|
||||
DrawForest()
|
||||
Timer1.Start()
|
||||
End Sub
|
||||
|
||||
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
|
||||
If _isBuilding Then Exit Sub
|
||||
|
||||
_isBuilding = True
|
||||
GetNextGeneration()
|
||||
|
||||
DrawForest()
|
||||
_isBuilding = False
|
||||
End Sub
|
||||
|
||||
Private Sub GetNextGeneration()
|
||||
Dim forestCache(_winWidth, _winHeight) As ForestState
|
||||
Dim rnd As New Random()
|
||||
|
||||
For i As Integer = 0 To _winHeight - 1
|
||||
For j As Integer = 0 To _winWidth - 1
|
||||
Select Case _forest(j, i)
|
||||
Case ForestState.Tree
|
||||
If forestCache(j, i) <> ForestState.Burning Then
|
||||
forestCache(j, i) = IIf(rnd.NextDouble <= _f, ForestState.Burning, ForestState.Tree)
|
||||
End If
|
||||
|
||||
Case ForestState.Burning
|
||||
For i2 As Integer = i - 1 To i + 1
|
||||
If i2 = -1 OrElse i2 >= _winHeight Then Continue For
|
||||
For j2 As Integer = j - 1 To j + 1
|
||||
If j2 = -1 OrElse i2 >= _winWidth Then Continue For
|
||||
If _forest(j2, i2) = ForestState.Tree Then forestCache(j2, i2) = ForestState.Burning
|
||||
Next
|
||||
Next
|
||||
forestCache(j, i) = ForestState.Empty
|
||||
|
||||
Case Else
|
||||
forestCache(j, i) = IIf(rnd.NextDouble <= _p, ForestState.Tree, ForestState.Empty)
|
||||
End Select
|
||||
Next
|
||||
Next
|
||||
|
||||
_forest = forestCache
|
||||
_gen += 1
|
||||
End Sub
|
||||
|
||||
Private Sub DrawForest()
|
||||
Dim bmCache As New Bitmap(_winWidth, _winHeight)
|
||||
|
||||
For i As Integer = 0 To _winHeight - 1
|
||||
For j As Integer = 0 To _winWidth - 1
|
||||
Select Case _forest(j, i)
|
||||
Case ForestState.Tree
|
||||
bmCache.SetPixel(j, i, Color.Green)
|
||||
|
||||
Case ForestState.Burning
|
||||
bmCache.SetPixel(j, i, Color.Red)
|
||||
End Select
|
||||
Next
|
||||
Next
|
||||
|
||||
_bm = bmCache
|
||||
Me.Refresh()
|
||||
End Sub
|
||||
|
||||
Private Sub ForestFire_Paint(ByVal sender As System.Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles MyBase.Paint
|
||||
e.Graphics.DrawImage(_bm, 0, 0)
|
||||
|
||||
Me.Text = "Gen " & _gen.ToString() & " @ " & (_gen / (_sw.ElapsedMilliseconds / 1000)).ToString("F02") & " FPS: Forest Fire"
|
||||
End Sub
|
||||
End Class
|
||||
for gen = 1 to 200
|
||||
for x = 1 to 199
|
||||
for y = 1 to 199
|
||||
select case preGen(x,y)
|
||||
case 0
|
||||
if rnd(0) > .99 then newGen(x,y) = 1 : #g "color green ; set "; x; " "; y
|
||||
case 2
|
||||
newGen(x,y) = 0 : #g "color brown ; set "; x; " "; y
|
||||
case 1
|
||||
if preGen(x-1,y-1) = 2 or preGen(x-1,y) = 2 or preGen(x-1,y+1) = 2 _
|
||||
or preGen(x,y-1) = 2 or preGen(x,y+1) = 2 or preGen(x+1,y-1) = 2 _
|
||||
or preGen(x+1,y) = 2 or preGen(x+1,y+1) = 2 or rnd(0) > .999 then
|
||||
#g "color red ; set "; x; " "; y
|
||||
newGen(x,y) = 2
|
||||
end if
|
||||
end select
|
||||
preGen(x-1,y-1) = newGen(x-1,y-1)
|
||||
next y
|
||||
next x
|
||||
next gen
|
||||
render #g
|
||||
|
|
|
|||
104
Task/Forest-fire/BASIC/forest-fire-9.basic
Normal file
104
Task/Forest-fire/BASIC/forest-fire-9.basic
Normal file
|
|
@ -0,0 +1,104 @@
|
|||
Public Class ForestFire
|
||||
Private _forest(,) As ForestState
|
||||
Private _isBuilding As Boolean
|
||||
Private _bm As Bitmap
|
||||
Private _gen As Integer
|
||||
Private _sw As Stopwatch
|
||||
|
||||
Private Const _treeStart As Double = 0.5
|
||||
Private Const _f As Double = 0.00001
|
||||
Private Const _p As Double = 0.001
|
||||
|
||||
Private Const _winWidth As Integer = 300
|
||||
Private Const _winHeight As Integer = 300
|
||||
|
||||
Private Enum ForestState
|
||||
Empty
|
||||
Burning
|
||||
Tree
|
||||
End Enum
|
||||
|
||||
Private Sub ForestFire_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
|
||||
Me.ClientSize = New Size(_winWidth, _winHeight)
|
||||
ReDim _forest(_winWidth, _winHeight)
|
||||
|
||||
Dim rnd As New Random()
|
||||
For i As Integer = 0 To _winHeight - 1
|
||||
For j As Integer = 0 To _winWidth - 1
|
||||
_forest(j, i) = IIf(rnd.NextDouble <= _treeStart, ForestState.Tree, ForestState.Empty)
|
||||
Next
|
||||
Next
|
||||
|
||||
_sw = New Stopwatch
|
||||
_sw.Start()
|
||||
DrawForest()
|
||||
Timer1.Start()
|
||||
End Sub
|
||||
|
||||
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
|
||||
If _isBuilding Then Exit Sub
|
||||
|
||||
_isBuilding = True
|
||||
GetNextGeneration()
|
||||
|
||||
DrawForest()
|
||||
_isBuilding = False
|
||||
End Sub
|
||||
|
||||
Private Sub GetNextGeneration()
|
||||
Dim forestCache(_winWidth, _winHeight) As ForestState
|
||||
Dim rnd As New Random()
|
||||
|
||||
For i As Integer = 0 To _winHeight - 1
|
||||
For j As Integer = 0 To _winWidth - 1
|
||||
Select Case _forest(j, i)
|
||||
Case ForestState.Tree
|
||||
If forestCache(j, i) <> ForestState.Burning Then
|
||||
forestCache(j, i) = IIf(rnd.NextDouble <= _f, ForestState.Burning, ForestState.Tree)
|
||||
End If
|
||||
|
||||
Case ForestState.Burning
|
||||
For i2 As Integer = i - 1 To i + 1
|
||||
If i2 = -1 OrElse i2 >= _winHeight Then Continue For
|
||||
For j2 As Integer = j - 1 To j + 1
|
||||
If j2 = -1 OrElse i2 >= _winWidth Then Continue For
|
||||
If _forest(j2, i2) = ForestState.Tree Then forestCache(j2, i2) = ForestState.Burning
|
||||
Next
|
||||
Next
|
||||
forestCache(j, i) = ForestState.Empty
|
||||
|
||||
Case Else
|
||||
forestCache(j, i) = IIf(rnd.NextDouble <= _p, ForestState.Tree, ForestState.Empty)
|
||||
End Select
|
||||
Next
|
||||
Next
|
||||
|
||||
_forest = forestCache
|
||||
_gen += 1
|
||||
End Sub
|
||||
|
||||
Private Sub DrawForest()
|
||||
Dim bmCache As New Bitmap(_winWidth, _winHeight)
|
||||
|
||||
For i As Integer = 0 To _winHeight - 1
|
||||
For j As Integer = 0 To _winWidth - 1
|
||||
Select Case _forest(j, i)
|
||||
Case ForestState.Tree
|
||||
bmCache.SetPixel(j, i, Color.Green)
|
||||
|
||||
Case ForestState.Burning
|
||||
bmCache.SetPixel(j, i, Color.Red)
|
||||
End Select
|
||||
Next
|
||||
Next
|
||||
|
||||
_bm = bmCache
|
||||
Me.Refresh()
|
||||
End Sub
|
||||
|
||||
Private Sub ForestFire_Paint(ByVal sender As System.Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles MyBase.Paint
|
||||
e.Graphics.DrawImage(_bm, 0, 0)
|
||||
|
||||
Me.Text = "Gen " & _gen.ToString() & " @ " & (_gen / (_sw.ElapsedMilliseconds / 1000)).ToString("F02") & " FPS: Forest Fire"
|
||||
End Sub
|
||||
End Class
|
||||
Loading…
Add table
Add a link
Reference in a new issue