Commit | Line | Data |
---|---|---|
debaffdd SK |
1 | open Printf |
2 | ||
3 | ||
4 | (* ------------------------------------------------------------------------- * | |
5 | * Constants | |
6 | * ------------------------------------------------------------------------- *) | |
8143820a SK |
7 | let default_f = 0.01 (* Probability of spontaneous ignition *) |
8 | let default_p = 1.0 (* Probability of spontaneous growth *) | |
debaffdd | 9 | |
0d55050e SK |
10 | let default_interval = 0.1 (* Induced interval between generations *) |
11 | ||
debaffdd SK |
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 = | |
0d55050e SK |
39 | { size : int * int |
40 | ; prob : float * float | |
41 | ; interval : float | |
debaffdd SK |
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 | ||
0d55050e | 65 | and interval = ref default_interval |
8143820a SK |
66 | and f = ref default_f |
67 | and p = ref default_p | |
debaffdd SK |
68 | and x = ref default_x |
69 | and y = ref default_y in | |
70 | ||
8143820a SK |
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.") | |
0d55050e | 77 | ; ("-i", Arg.Set_float interval, " Induced interval between generations.") |
8143820a SK |
78 | ] |
79 | in | |
debaffdd SK |
80 | |
81 | Arg.parse speclist (fun _ -> ()) usage; | |
82 | ||
0d55050e SK |
83 | { size = !x, !y |
84 | ; prob = !f, !p | |
85 | ; interval = !interval | |
debaffdd SK |
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 | ||
8143820a | 117 | let init_cell_state (_, p) = function |
debaffdd SK |
118 | | () when is_probable p -> Tree |
119 | | () -> Empty | |
120 | ||
121 | ||
8143820a SK |
122 | let init_forest (x, y) prob = |
123 | Array.map (Array.map (init_cell_state prob)) (Array.make_matrix y x ()) | |
debaffdd SK |
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 | |
8143820a SK |
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 | |
debaffdd SK |
138 | |
139 | ||
140 | let print_forest forest = | |
86e687a7 SK |
141 | term_reset (); |
142 | ||
debaffdd SK |
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 | ||
8143820a | 161 | let next_generation forest (width, height) prob = |
debaffdd SK |
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 | |
1361b30d | 171 | let burning_states = List.filter ((==) Burning) neighbor_states in |
8143820a | 172 | new_state (state, (List.length burning_states), prob) |
debaffdd SK |
173 | ) |
174 | row | |
175 | ) | |
176 | forest | |
177 | ||
178 | ||
0d55050e | 179 | let rec burn forest size prob interval = |
debaffdd | 180 | print_forest forest; |
86e687a7 | 181 | |
8cf59f0f | 182 | if interval > 0.0 then minisleep interval; |
86e687a7 SK |
183 | |
184 | let next_forest = next_generation forest size prob in | |
185 | burn next_forest size prob interval | |
debaffdd SK |
186 | |
187 | ||
188 | let main argv = | |
189 | Random.self_init (); | |
190 | ||
191 | let opts = get_opts argv in | |
8143820a | 192 | let forest = init_forest opts.size opts.prob in |
debaffdd SK |
193 | |
194 | term_clear (); | |
86e687a7 | 195 | |
0d55050e | 196 | burn forest opts.size opts.prob opts.interval |
debaffdd SK |
197 | |
198 | ||
199 | let () = main Sys.argv |