Initial data commit

Task/Forest-fire/GFA-Basic/forest-fire.basic

@@ -0,0 +1,138 @@
+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