4 (* ------------------------------------------------------------------------- *
6 * ------------------------------------------------------------------------- *)
7 let default_f = 0.01 (* Probability of spontaneous ignition *)
8 let default_p = 1.0 (* Probability of spontaneous growth *)
15 let char_burning = '#'
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"
21 let ansi_code_clear = "\027[2J" (* Clear screen *)
22 let ansi_code_reset = "\027[1;1H" (* Reset cursor position *)
25 (* ------------------------------------------------------------------------- *
27 * ------------------------------------------------------------------------- *)
29 | Empty | Tree | Burning
33 | N | NE | E | SE | S | SW | W | NW
38 ; prob : float * float
42 (* ------------------------------------------------------------------------- *
44 * ------------------------------------------------------------------------- *)
46 (* Hack to sleep less than 1 sec *)
47 let minisleep subsec =
48 ignore (Unix.select [] [] [] subsec)
52 print_string ansi_code_clear
56 print_string ansi_code_reset
65 and y = ref default_y in
69 [ ("-f", Arg.Set_float f, " Probability of spontaneous ignition.")
70 ; ("-p", Arg.Set_float p, " Probability of spontaneous growth.")
71 ; ("-x", Arg.Set_int x, " Forest width.")
72 ; ("-y", Arg.Set_int y, " Forest height.")
76 Arg.parse speclist (fun _ -> ()) usage;
83 (* ------------------------------------------------------------------------- *
85 * ------------------------------------------------------------------------- *)
87 [N; NE; E; SE; S; SW; W; NW]
90 let offset_of_direction = function
91 (* Direction -> x, y *)
103 List.map (offset_of_direction) directions
106 let is_probable = function
107 | probability when (Random.float 1.0) <= probability -> true
111 let init_cell_state (_, p) = function
112 | () when is_probable p -> Tree
116 let init_forest (x, y) prob =
117 Array.map (Array.map (init_cell_state prob)) (Array.make_matrix y x ())
120 let string_of_state = function
121 | Empty -> sprintf "%c" char_empty
122 | Tree -> sprintf "%s%c%s" ansi_color_tree char_tree ansi_color_off
123 | Burning -> sprintf "%s%c%s" ansi_color_burning char_burning ansi_color_off
126 let new_state = function
127 | Burning, _, _ -> Empty
128 | Tree, 0, (f, _) when is_probable f -> Burning
129 | Tree, n_burning, _ when n_burning > 0 -> Burning
130 | Empty, _, (_, p) when is_probable p -> Tree
131 | state, _, _ -> state
134 let print_forest forest =
141 print_string (string_of_state state)
149 let is_onside width height (x, y) =
150 x >= 0 && y >= 0 && x < width && y < height
153 let next_generation forest (width, height) prob =
160 let neighbors = List.map (fun (ox, oy) -> ox + ix, oy + iy) offsets in
161 let neighbors = List.filter (is_onside width height) neighbors in
162 let neighbor_states = List.map (fun (x, y) -> forest.(y).(x)) neighbors in
163 let burning_states = List.filter (fun s -> s == Burning) neighbor_states in
164 new_state (state, (List.length burning_states), prob)
171 let rec burn forest size prob =
175 burn (next_generation forest size prob) size prob
181 let opts = get_opts argv in
182 let forest = init_forest opts.size opts.prob in
185 burn forest opts.size opts.prob
188 let () = main Sys.argv