'[RC] Forest Fire
'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

#Define M 400
#Define N 640

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

'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)

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

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 "                       "

' 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 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
  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

  ' 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