4 (* ------------------------------------------------------------------------- *
6 * ------------------------------------------------------------------------- *)
7 let default_f = 0.01 (* Probability of spontaneous ignition *)
8 let default_p = 1.0 (* Probability of spontaneous growth *)
10 let default_interval = 0.1 (* Induced interval between generations *)
17 let char_burning = '#'
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"
23 let ansi_code_clear = "\027[2J" (* Clear screen *)
24 let ansi_code_reset = "\027[1;1H" (* Reset cursor position *)
27 (* ------------------------------------------------------------------------- *
29 * ------------------------------------------------------------------------- *)
31 | Empty | Tree | Burning
35 | N | NE | E | SE | S | SW | W | NW
40 ; prob : float * float
45 (* ------------------------------------------------------------------------- *
47 * ------------------------------------------------------------------------- *)
49 (* Hack to sleep less than 1 sec *)
50 let minisleep subsec =
51 ignore (Unix.select [] [] [] subsec)
55 print_string ansi_code_clear
59 print_string ansi_code_reset
65 and interval = ref default_interval
69 and y = ref default_y in
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.")
81 Arg.parse speclist (fun _ -> ()) usage;
85 ; interval = !interval
89 (* ------------------------------------------------------------------------- *
91 * ------------------------------------------------------------------------- *)
93 [N; NE; E; SE; S; SW; W; NW]
96 let offset_of_direction = function
97 (* Direction -> x, y *)
109 List.map (offset_of_direction) directions
112 let is_probable = function
113 | probability when (Random.float 1.0) <= probability -> true
117 let init_cell_state (_, p) = function
118 | () when is_probable p -> Tree
122 let init_forest (x, y) prob =
123 Array.map (Array.map (init_cell_state prob)) (Array.make_matrix y x ())
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
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
140 let print_forest forest =
149 print_string (string_of_state state)
157 let is_onside width height (x, y) =
158 x >= 0 && y >= 0 && x < width && y < height
161 let next_generation forest (width, height) prob =
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)
179 let rec burn forest size prob interval =
182 if interval > 0.0 then minisleep interval;
184 let next_forest = next_generation forest size prob in
185 burn next_forest size prob interval
191 let opts = get_opts argv in
192 let forest = init_forest opts.size opts.prob in
196 burn forest opts.size opts.prob opts.interval
199 let () = main Sys.argv