forest-fire/001/src/forest_fire.ml

   1 open Printf
   2
   3
   4 (* ------------------------------------------------------------------------- *
   5  * Constants
   6  * ------------------------------------------------------------------------- *)
   7 let default_f = 0.01  (* Probability of spontaneous ignition *)
   8 let default_p = 1.0   (* Probability of spontaneous growth *)
   9
  10 let default_interval = 0.1  (* Induced interval between generations *)
  11
  12 let default_x = 80
  13 let default_y = 25
  14
  15 let char_empty   = ' '
  16 let char_tree    = 'T'
  17 let char_burning = '#'
  18
  19 let ansi_color_tree    = "\027[0;32m"  (* Green *)
  20 let ansi_color_burning = "\027[1;31m"  (* Red *)
  21 let ansi_color_off     = "\027[0m"
  22
  23 let ansi_code_clear = "\027[2J"    (* Clear screen *)
  24 let ansi_code_reset = "\027[1;1H"  (* Reset cursor position *)
  25
  26
  27 (* ------------------------------------------------------------------------- *
  28  * Types
  29  * ------------------------------------------------------------------------- *)
  30 type cell_state =
  31   | Empty | Tree | Burning
  32
  33
  34 type direction =
  35   | N | NE | E | SE | S | SW | W | NW
  36
  37
  38 type options =
  39   { size     : int * int
  40   ; prob     : float * float
  41   ; interval : float
  42   }
  43
  44
  45 (* ------------------------------------------------------------------------- *
  46  * Utils
  47  * ------------------------------------------------------------------------- *)
  48
  49 (* Hack to sleep less than 1 sec *)
  50 let minisleep subsec =
  51   ignore (Unix.select [] [] [] subsec)
  52
  53
  54 let term_clear () =
  55   print_string ansi_code_clear
  56
  57
  58 let term_reset () =
  59   print_string ansi_code_reset
  60
  61
  62 let get_opts argv =
  63   let usage = ""
  64
  65   and interval = ref default_interval
  66   and f = ref default_f
  67   and p = ref default_p
  68   and x = ref default_x
  69   and y = ref default_y in
  70
  71   let speclist =
  72     Arg.align
  73     [ ("-f", Arg.Set_float f, " Probability of spontaneous ignition.")
  74     ; ("-p", Arg.Set_float p, " Probability of spontaneous growth.")
  75     ; ("-x", Arg.Set_int x, " Forest width.")
  76     ; ("-y", Arg.Set_int y, " Forest height.")
  77     ; ("-i", Arg.Set_float interval, " Induced interval between generations.")
  78     ]
  79   in
  80
  81   Arg.parse speclist (fun _ -> ()) usage;
  82
  83   { size     = !x, !y
  84   ; prob     = !f, !p
  85   ; interval = !interval
  86   }
  87
  88
  89 (* ------------------------------------------------------------------------- *
  90  * Core
  91  * ------------------------------------------------------------------------- *)
  92 let directions =
  93   [N; NE; E; SE; S; SW; W; NW]
  94
  95
  96 let offset_of_direction = function
  97   (* Direction -> x, y *)
  98   | N  ->  0, -1
  99   | NE ->  1, -1
 100   | E  ->  1,  0
 101   | SE ->  1,  1
 102   | S  ->  0,  1
 103   | SW -> -1,  1
 104   | W  -> -1,  0
 105   | NW -> -1, -1
 106
 107
 108 let offsets =
 109   List.map (offset_of_direction) directions
 110
 111
 112 let is_probable = function
 113   | probability when (Random.float 1.0) <= probability -> true
 114   | _ -> false
 115
 116
 117 let init_cell_state (_, p) = function
 118   | () when is_probable p -> Tree
 119   | ()                    -> Empty
 120
 121
 122 let init_forest (x, y) prob =
 123   Array.map (Array.map (init_cell_state prob)) (Array.make_matrix y x ())
 124
 125
 126 let string_of_state = function
 127   | Empty   -> sprintf "%c" char_empty
 128   | Tree    -> sprintf "%s%c%s" ansi_color_tree char_tree ansi_color_off
 129   | Burning -> sprintf "%s%c%s" ansi_color_burning char_burning ansi_color_off
 130
 131
 132 let new_state = function
 133   | Burning, _, _                            -> Empty
 134   | Tree,    0, (f, _)    when is_probable f -> Burning
 135   | Tree,    n_burning, _ when n_burning > 0 -> Burning
 136   | Empty,   _, (_, p)    when is_probable p -> Tree
 137   | state,   _, _                            -> state
 138
 139
 140 let print_forest forest =
 141   term_reset ();
 142
 143   Array.iter
 144   (
 145     fun row ->
 146       Array.iter
 147       (
 148         fun state ->
 149           print_string (string_of_state state)
 150       )
 151       row;
 152       print_newline ()
 153   )
 154   forest
 155
 156
 157 let is_onside width height (x, y) =
 158   x >= 0 && y >= 0 && x < width && y < height
 159
 160
 161 let next_generation forest (width, height) prob =
 162   Array.mapi
 163   (
 164     fun iy row ->
 165       Array.mapi
 166       (
 167         fun ix state ->
 168           let neighbors = List.map (fun (ox, oy) -> ox + ix, oy + iy) offsets in
 169           let neighbors = List.filter (is_onside width height) neighbors in
 170           let neighbor_states = List.map (fun (x, y) -> forest.(y).(x)) neighbors in
 171           let burning_states = List.filter ((==) Burning) neighbor_states in
 172           new_state (state, (List.length burning_states), prob)
 173       )
 174       row
 175   )
 176   forest
 177
 178
 179 let rec burn forest size prob interval =
 180   print_forest forest;
 181
 182   if interval > 0.0 then minisleep interval;
 183
 184   let next_forest = next_generation forest size prob in
 185   burn next_forest size prob interval
 186
 187
 188 let main argv =
 189   Random.self_init ();
 190
 191   let opts = get_opts argv in
 192   let forest = init_forest opts.size opts.prob in
 193
 194   term_clear ();
 195
 196   burn forest opts.size opts.prob opts.interval
 197
 198
 199 let () = main Sys.argv