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