langs a-z

Task/Forest-fire/OCaml/forest-fire.ocaml

@@ -0,0 +1,73 @@
+open Curses
+
+let ignite_prob = 0.02
+let sprout_prob = 0.01
+
+type cell = Empty | Burning | Tree
+
+let get w x y =
+  try w.(x).(y)
+  with Invalid_argument _ -> Empty
+
+let neighborhood_burning w x y =
+  try
+    for _x = pred x to succ x do
+      for _y = pred y to succ y do
+        if get w _x _y = Burning then raise Exit
+      done
+    done
+    ; false
+  with Exit -> true
+
+let evolves w x y =
+  match w.(x).(y) with
+  | Burning -> Empty
+  | Tree ->
+      if neighborhood_burning w x y
+      then Burning
+      else begin
+        if (Random.float 1.0) < ignite_prob
+        then Burning
+        else Tree
+      end
+  | Empty ->
+      if (Random.float 1.0) < sprout_prob
+      then Tree
+      else Empty
+
+let step width height w =
+  for x = 0 to pred width do
+    for y = 0 to pred height do
+      w.(x).(y) <- evolves w x y
+    done
+  done
+
+let i = int_of_char
+let repr = function
+  | Empty -> i ' ' | Burning -> i '#' | Tree -> i 't'
+
+let draw width height w =
+  for x = 0 to pred width do
+    for y = 0 to pred height do
+      ignore(move y x);
+      ignore(delch ());
+      ignore(insch (repr w.(x).(y)));
+    done;
+  done;
+  ignore(refresh ())
+
+let () =
+  Random.self_init ();
+  let wnd = initscr () in
+  ignore(cbreak ());
+  ignore(noecho ());
+  let height, width = getmaxyx wnd in
+  let w = Array.make_matrix width height Empty in
+  clear ();
+  ignore(refresh ());
+  while true do
+    draw width height w;
+    step width height w;
+    Unix.sleep 1;
+  done;
+  endwin()

Task/Forest-fire/Perl-6/forest-fire.pl6

@@ -0,0 +1,70 @@
+constant RED = "\e[1;31m";
+constant CLEAR = "\e[0m";
+
+enum Cell-State <Empty Tree Burning>;
+my @show = ('  ', '木', RED ~ '木' ~ CLEAR);
+
+class Forest {
+    has Cell-State @!grid;
+    has @!neighbors;
+    has Int $.height;
+    has Int $.width;
+    has $.p;
+    has $.f;
+
+    method new(Int $height, Int $width, $p=0.01, $f=0.001) {
+        my $c = self.bless(*, :$height, :$width, :$p, :$f);
+        $c!init-grid;
+        $c!init-neighbors;
+        return $c;
+    }
+
+    method !init-grid {
+	@!grid = [ (Bool.pick ?? Tree !! Empty) xx $!width ] xx $!height;
+    }
+
+    method !init-neighbors {
+        for ^$!height X ^$!width -> $i, $j {
+            @!neighbors[$i][$j] = gather for
+                    [-1,-1],[+0,-1],[+1,-1],
+                    [-1,+0],(     ),[+1,+0],
+                    [-1,+1],[+0,+1],[+1,+1]
+	    {
+		take-rw @!grid[$i + .[0]][$j + .[1]] // next;
+	    }
+        }
+    }
+
+    method step {
+        my @new;
+        for ^$!height X ^$!width -> $i, $j {
+            given @!grid[$i][$j] {
+                when Empty   { @new[$i][$j] = rand < $!p ?? Tree !! Empty }
+                when Tree    { @new[$i][$j] =
+                     (@!neighbors[$i][$j].any === Burning or rand < $!f) ?? Burning !! Tree;
+                }
+                when Burning { @new[$i][$j] = Empty }
+            }
+        }
+        for ^$!height X ^$!width -> $i, $j {
+            @!grid[$i][$j] = @new[$i][$j];
+        }
+    }
+
+    method Str {
+        join '', gather for ^$!height -> $i {
+            take @show[@!grid[$i].list], "\n";
+        }
+    }
+}
+
+my Forest $f .= new(20,30);
+print "\e[2J";      # ANSI clear screen
+
+my $i = 0;
+loop {
+    print "\e[H";   # ANSI home
+    say $i++;
+    say $f.Str;
+    $f.step;
+}

Task/Forest-fire/PostScript/forest-fire.ps

@@ -0,0 +1,64 @@
+%!PS-Adobe-3.0
+%%BoundingBox: 0 0 400 400
+
+/size 400 def
+
+/rand1 { rand 2147483647 div } def
+
+/m { moveto } bind def
+/l { rlineto} bind def
+/drawforest {
+        0 1 n 1 sub { /y exch def
+        0 1 n 1 sub { /x exch def
+                forest x get y get dup 0 eq { pop } {
+                        1 eq { 0 1 0 } { 1 0 0 } ifelse setrgbcolor
+                        x c mul y c mul m
+                        c 0 l 0 c l c neg 0 l closepath fill
+                } ifelse
+        } for
+        } for
+} def
+
+/r1n { dup 0 ge exch n lt and } def
+
+/neighbors { /y exch def /x exch def /cnt 0 def
+        [
+        y 1 sub 1 y 1 add { /y1 exch def
+                y1 r1n {
+                        x 1 sub 1 x 1 add { /x1 exch def
+                                x1 r1n { forest x1 get y1 get } if
+                        } for
+                } if
+        } for]
+} def
+
+/iter {
+        /nf [ n {[ n {0} repeat]} repeat ] def
+        0 1 n 1 sub { /x exch def
+        0 1 n 1 sub { /y exch def
+                nf x get y
+                forest x get y get dup
+                0 eq { pop rand1 treeprob le {1}{0} ifelse
+                } {
+                        1 eq {  /fire false def
+                                x y neighbors {
+                                        -1 eq { /fire true def } if
+                                } forall
+                                fire {-1}{
+                                        rand1 burnprob lt {-1}{1} ifelse
+                                } ifelse
+                        }{0} ifelse
+                } ifelse
+                put
+        } for } for
+        /forest nf def
+} def
+
+/n 200 def
+/treeprob .05 def
+/burnprob .0001 def
+/c size n div def
+/forest [ n {[ n { rand1 treeprob le {1}{0} ifelse } repeat]} repeat ] def
+
+1000 { drawforest showpage iter } repeat
+%%EOF

Task/Forest-fire/PureBasic/forest-fire.purebasic

@@ -0,0 +1,167 @@
+; Some systems reports high CPU-load while running this code.
+; This may likely be due to the graphic driver used in the
+; 2D-function Plot().
+; If experiencing this problem, please reduce the #Width & #Height
+; or activate the parameter #UnLoadCPU below with a parameter 1 or 2.
+;
+; This code should work with the demo version of PureBasic on both PC & Linux
+
+; General parameters for the world
+#f    = 1e-6
+#p    = 1e-2
+#SeedATree  = 0.005
+#Width      = 400
+#Height     = 400
+
+; Setting up colours
+#Fire       = $080CF7
+#BackGround = $BFD5D3
+#YoungTree  = $00E300
+#NormalTree = $00AC00
+#MatureTree = $009500
+#OldTree    = $007600
+#Black      = $000000
+
+; Depending on your hardware, use this to control the speed/CPU-load.
+; 0 = No load reduction
+; 1 = Only active about every second frame
+; 2 = '1' & release the CPU after each horizontal line.
+#UnLoadCPU  = 0
+
+Enumeration
+  #Empty  =0
+  #Ignited
+  #Burning
+  #Tree
+  #Old=#Tree+20
+EndEnumeration
+
+Global Dim Forest.i(#Width, #Height)
+Global Title$="Forest fire in PureBasic"
+Global Cnt
+
+Macro Rnd()
+  (Random(2147483647)/2147483647.0)
+EndMacro
+
+Procedure Limit(n, min, max)
+  If n<min
+    n=min
+  ElseIf n>max
+    n=max
+  EndIf
+  ProcedureReturn n
+EndProcedure
+
+Procedure SpreadFire(x,y)
+  Protected cnt=0, i, j
+  For i=Limit(x-1, 0, #Width) To Limit(x+1, 0, #Width)
+    For j=Limit(y-1, 0, #Height) To Limit(y+1, 0, #Height)
+      If Forest(i,j)>=#Tree
+        Forest(i,j)=#Ignited
+      EndIf
+    Next
+  Next
+EndProcedure
+
+Procedure InitMap()
+  Protected x, y, type
+  For y=1 To #Height
+    For x=1 To #Width
+      If Rnd()<=#SeedATree
+        type=#Tree
+      Else
+        type=#Empty
+      EndIf
+      Forest(x,y)=type
+    Next
+  Next
+EndProcedure
+
+Procedure UpdateMap()
+  Protected x, y
+  For y=1 To #Height
+    For x=1 To #Width
+      Select Forest(x,y)
+        Case #Burning
+          Forest(x,y)=#Empty
+          SpreadFire(x,y)
+        Case #Ignited
+          Forest(x,y)=#Burning
+        Case #Empty
+          If Rnd()<=#p
+            Forest(x,y)=#Tree
+          EndIf
+        Default
+          If Rnd()<=#f
+            Forest(x,y)=#Burning
+          Else
+            Forest(x,y)+1
+          EndIf
+      EndSelect
+    Next
+  Next
+EndProcedure
+
+Procedure PresentMap()
+  Protected x, y, c
+  cnt+1
+  SetWindowTitle(0,Title$+", time frame="+Str(cnt))
+  StartDrawing(ImageOutput(1))
+  For y=0 To OutputHeight()-1
+    For x=0 To OutputWidth()-1
+      Select Forest(x,y)
+        Case #Empty
+          c=#BackGround
+        Case #Burning, #Ignited
+          c=#Fire
+        Default
+          If Forest(x,y)<#Tree+#Old
+            c=#YoungTree
+          ElseIf Forest(x,y)<#Tree+2*#Old
+            c=#NormalTree
+          ElseIf Forest(x,y)<#Tree+3*#Old
+            c=#MatureTree
+          ElseIf Forest(x,y)<#Tree+4*#Old
+            c=#OldTree
+          Else ; Tree died of old age
+            Forest(x,y)=#Empty
+            c=#Black
+          EndIf
+      EndSelect
+      Plot(x,y,c)
+    Next
+    CompilerIf #UnLoadCPU>1
+      Delay(1)
+    CompilerEndIf
+  Next
+  StopDrawing()
+  ImageGadget(1, 0, 0, #Width, #Height, ImageID(1))
+EndProcedure
+
+If OpenWindow(0, 10, 30, #Width, #Height, Title$, #PB_Window_MinimizeGadget)
+  SmartWindowRefresh(0, 1)
+  If CreateImage(1, #Width, #Height)
+    Define Event, freq
+    If ExamineDesktops() And DesktopFrequency(0)
+      freq=DesktopFrequency(0)
+    Else
+      freq=60
+    EndIf
+    AddWindowTimer(0,0,5000/freq)
+    InitMap()
+    Repeat
+      Event = WaitWindowEvent()
+      Select Event
+        Case #PB_Event_CloseWindow
+          End
+        Case #PB_Event_Timer
+          CompilerIf #UnLoadCPU>0
+            Delay(25)
+          CompilerEndIf
+          UpdateMap()
+          PresentMap()
+      EndSelect
+    ForEver
+  EndIf
+EndIf

Task/Forest-fire/REALbasic/forest-fire-1.realbasic

@@ -0,0 +1,65 @@
+Sub Run()
+  //Handy named constants
+  Const empty = 0
+  Const tree = 1
+  Const fire = 2
+  Const ablaze = &cFF0000    //Using the &c numeric operator to indicate a color in hex
+  Const alive = &c00FF00
+  Const dead = &c804040
+
+  //Our forest
+  Dim worldPic As New Picture(480, 480, 32)
+  Dim newWorld(120, 120) As Integer
+  Dim oldWorld(120, 120) As Integer
+
+  //Initialize forest
+  Dim rand As New Random
+  For x as Integer = 0 to 119
+    For y as Integer = 0 to 119
+      if rand.InRange(0, 2) = 0 Or x = 119 or y = 119 or x = 0 or y = 0 Then
+        newWorld(x, y) = empty
+        worldPic.Graphics.ForeColor = dead
+        worldPic.Graphics.FillRect(x*4, y*4, 4, 4)
+      Else
+        newWorld(x, y) = tree
+        worldPic.Graphics.ForeColor = alive
+        worldPic.Graphics.FillRect(x*4, y*4, 4, 4)
+      end if
+    Next
+  Next
+  oldWorld = newWorld
+
+  //Burn, baby burn!
+  While Window1.stop = False
+    For x as Integer = 0 To 119
+      For y As Integer = 0 to 119
+        Dim willBurn As Integer = rand.InRange(0, Window1.burnProb.Value)
+        Dim willGrow As Integer = rand.InRange(0, Window1.growProb.Value)
+        if x = 119 or y = 119 or x = 0 or y = 0 Then
+          Continue
+        end if
+        Select Case oldWorld(x, y)
+        Case empty
+          If willGrow = (Window1.growProb.Value) Then
+            newWorld(x, y) = tree
+            worldPic.Graphics.ForeColor = alive
+            worldPic.Graphics.FillRect(x*4, y*4, 4, 4)
+          end if
+        Case tree
+          if oldWorld(x - 1, y) = fire Or oldWorld(x, y - 1) = fire Or oldWorld(x + 1, y) = fire Or oldWorld(x, y + 1) = fire Or oldWorld(x + 1, y + 1) = fire Or oldWorld(x - 1, y - 1) = fire Or oldWorld(x - 1, y + 1) = fire Or oldWorld(x + 1, y - 1) = fire Or willBurn = (Window1.burnProb.Value) Then
+            newWorld(x, y) = fire
+            worldPic.Graphics.ForeColor = ablaze
+            worldPic.Graphics.FillRect(x*4, y*4, 4, 4)
+          end if
+        Case fire
+          newWorld(x, y) = empty
+          worldPic.Graphics.ForeColor = dead
+          worldPic.Graphics.FillRect(x*4, y*4, 4, 4)
+        End Select
+      Next
+    Next
+    Window1.Canvas1.Graphics.DrawPicture(worldPic, 0, 0)
+    oldWorld = newWorld
+    me.Sleep(Window1.speed.Value)
+  Wend
+End Sub

Task/Forest-fire/REALbasic/forest-fire-2.realbasic

@@ -0,0 +1,11 @@
+Sub Open()
+  //First method to run on the creation of a new Window. We instantiate an instance of our forestFire thread and run it.
+  Dim fire As New forestFire
+  fire.Run()
+End Sub
+
+stop As Boolean  //a globally accessible property of Window1. Boolean properties default to False.
+
+Sub Pushbutton1.Action()
+  stop = True
+End Sub

Task/Forest-fire/Run-BASIC/forest-fire.run

@@ -0,0 +1,25 @@
+graphic #g, 200,200
+dim preGen(200,200)
+dim newGen(200,200)
+
+for gen = 1 to 200
+  for x = 1 to 199
+    for y = 1 to 199
+      select case preGen(x,y)
+        case 0
+          if rnd(0) > .99 then newGen(x,y) = 1  : #g "color green ; set "; x; " "; y
+        case 2
+          newGen(x,y) = 0                       : #g "color brown ; set "; x; " "; y
+        case 1
+          if preGen(x-1,y-1) = 2 or preGen(x-1,y)   = 2 or preGen(x-1,y+1) = 2 _
+          or preGen(x,y-1)   = 2 or preGen(x,y+1)   = 2 or preGen(x+1,y-1) = 2 _
+          or preGen(x+1,y)   = 2 or preGen(x+1,y+1) = 2 or rnd(0) > .999 then
+              #g "color red ; set "; x; " "; y
+              newGen(x,y) = 2
+          end if
+      end select
+      preGen(x-1,y-1) = newGen(x-1,y-1)
+    next y
+  next x
+next gen
+render #g

Task/Forest-fire/Visual-Basic-.NET/forest-fire.visual

@@ -0,0 +1,104 @@
+Public Class ForestFire
+    Private _forest(,) As ForestState
+    Private _isBuilding As Boolean
+    Private _bm As Bitmap
+    Private _gen As Integer
+    Private _sw As Stopwatch
+
+    Private Const _treeStart As Double = 0.5
+    Private Const _f As Double = 0.00001
+    Private Const _p As Double = 0.001
+
+    Private Const _winWidth As Integer = 300
+    Private Const _winHeight As Integer = 300
+
+    Private Enum ForestState
+        Empty
+        Burning
+        Tree
+    End Enum
+
+    Private Sub ForestFire_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
+        Me.ClientSize = New Size(_winWidth, _winHeight)
+        ReDim _forest(_winWidth, _winHeight)
+
+        Dim rnd As New Random()
+        For i As Integer = 0 To _winHeight - 1
+            For j As Integer = 0 To _winWidth - 1
+                _forest(j, i) = IIf(rnd.NextDouble <= _treeStart, ForestState.Tree, ForestState.Empty)
+            Next
+        Next
+
+        _sw = New Stopwatch
+        _sw.Start()
+        DrawForest()
+        Timer1.Start()
+    End Sub
+
+    Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
+        If _isBuilding Then Exit Sub
+
+        _isBuilding = True
+        GetNextGeneration()
+
+        DrawForest()
+        _isBuilding = False
+    End Sub
+
+    Private Sub GetNextGeneration()
+        Dim forestCache(_winWidth, _winHeight) As ForestState
+        Dim rnd As New Random()
+
+        For i As Integer = 0 To _winHeight - 1
+            For j As Integer = 0 To _winWidth - 1
+                Select Case _forest(j, i)
+                    Case ForestState.Tree
+                        If forestCache(j, i) <> ForestState.Burning Then
+                            forestCache(j, i) = IIf(rnd.NextDouble <= _f, ForestState.Burning, ForestState.Tree)
+                        End If
+
+                    Case ForestState.Burning
+                        For i2 As Integer = i - 1 To i + 1
+                            If i2 = -1 OrElse i2 >= _winHeight Then Continue For
+                            For j2 As Integer = j - 1 To j + 1
+                                If j2 = -1 OrElse i2 >= _winWidth Then Continue For
+                                If _forest(j2, i2) = ForestState.Tree Then forestCache(j2, i2) = ForestState.Burning
+                            Next
+                        Next
+                        forestCache(j, i) = ForestState.Empty
+
+                    Case Else
+                        forestCache(j, i) = IIf(rnd.NextDouble <= _p, ForestState.Tree, ForestState.Empty)
+                End Select
+            Next
+        Next
+
+        _forest = forestCache
+        _gen += 1
+    End Sub
+
+    Private Sub DrawForest()
+        Dim bmCache As New Bitmap(_winWidth, _winHeight)
+
+        For i As Integer = 0 To _winHeight - 1
+            For j As Integer = 0 To _winWidth - 1
+                Select Case _forest(j, i)
+                    Case ForestState.Tree
+                        bmCache.SetPixel(j, i, Color.Green)
+
+                    Case ForestState.Burning
+                        bmCache.SetPixel(j, i, Color.Red)
+                End Select
+            Next
+        Next
+
+        _bm = bmCache
+        Me.Refresh()
+    End Sub
+
+    Private Sub ForestFire_Paint(ByVal sender As System.Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles MyBase.Paint
+        e.Graphics.DrawImage(_bm, 0, 0)
+
+        Me.Text = "Gen " & _gen.ToString() & " @ " & (_gen / (_sw.ElapsedMilliseconds / 1000)).ToString("F02") & " FPS: Forest Fire"
+    End Sub
+End Class