98dad01062ed80d050a23b8730b79d4aeac962af
[cellular-automata.git] / 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
This page took 0.077256 seconds and 3 git commands to generate.