forest-fire/001/src/forest_fire.ml

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