Initial data commit

Task/Forest-fire/FreeBASIC/forest-fire.basic

@@ -0,0 +1,108 @@
+'[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