74 lines
2.4 KiB
Plaintext
74 lines
2.4 KiB
Plaintext
link graphics,printf
|
|
|
|
$define EDGE 0
|
|
$define EMPTY 1
|
|
$define TREE 2
|
|
$define FIRE 3
|
|
|
|
global Colours,Width,Height,ProbTree,ProbFire,ProbInitialTree,Forest,oldForest
|
|
|
|
procedure main() # forest fire
|
|
|
|
Height := 400 # Window height
|
|
Width := 400 # Window width
|
|
ProbInitialTree := .10 # intial probability of trees
|
|
ProbTree := .01 # ongoing probability of trees
|
|
ProbFire := ProbTree/50. # probability of fire
|
|
Rounds := 500 # rounds to evolve
|
|
|
|
setup_forest()
|
|
every 1 to Rounds do {
|
|
show_forest()
|
|
evolve_forest()
|
|
}
|
|
printf("Forest fire %d x %d rounds=%d p.initial=%r p/f=%r/%r fps=%r\n",
|
|
Width,Height,Rounds,ProbInitialTree,ProbTree,ProbFire,
|
|
Rounds/(&time/1000.)) # stats
|
|
WDone()
|
|
end
|
|
|
|
procedure setup_forest() #: setup the forest
|
|
|
|
Colours := table() # define colours
|
|
Colours[EDGE] := "black"
|
|
Colours[EMPTY] := "grey"
|
|
Colours[TREE] := "green"
|
|
Colours[FIRE] := "red"
|
|
|
|
WOpen("label=Forest Fire", "bg=black",
|
|
"size=" || Width+2 || "," || Height+2) | # add for border
|
|
stop("Unable to open Window")
|
|
every !(Forest := list(Height)) := list(Width,EMPTY) # default
|
|
every ( Forest[1,1 to Width] | Forest[Height,1 to Width] |
|
|
Forest[1 to Height,1] | Forest[1 to Height,Width] ) := EDGE
|
|
every r := 2 to Height-1 & c := 2 to Width-1 do
|
|
if probability(ProbInitialTree) then Forest[r,c] := TREE
|
|
end
|
|
|
|
procedure show_forest() #: show Forest - drawn changes only
|
|
every r := 2 to *Forest-1 & c := 2 to *Forest[r]-1 do
|
|
if /oldForest | oldForest[r,c] ~= Forest[r,c] then {
|
|
WAttrib("fg=" || Colours[Forest[r,c]])
|
|
DrawPoint(r,c)
|
|
}
|
|
end
|
|
|
|
procedure evolve_forest() #: evolve forest
|
|
old := oldForest := list(*Forest) # freeze copy
|
|
every old[i := 1 to *Forest] := copy(Forest[i]) # deep copy
|
|
|
|
every r := 2 to *Forest-1 & c := 2 to *Forest[r]-1 do
|
|
Forest[r,c] := case old[r,c] of { # apply rules
|
|
FIRE : EMPTY
|
|
TREE : if probability(ProbFire) |
|
|
( old[r-1, c-1 to c+1] |
|
|
old[r,c-1|c+1] |
|
|
old[r+1,c-1 to c+1] ) = FIRE then FIRE
|
|
EMPTY: if probability(ProbTree) then TREE
|
|
}
|
|
end
|
|
|
|
procedure probability(P) #: succeed with probability P
|
|
if ?0 <= P then return
|
|
end
|