Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 283 lines (238 sloc) 10.121 kb
011010a martani Code commit of OCaml Maze square.ml and bee.ml
authored
1 (* MARTANI Fakhrou - http://martani.net - 2009 (modified April 2012) *)
207b1cd martani Code commit of OCaml Maze square.ml and bee.ml
authored
2
3 (*
4 To compile:
5 - Windows
6 ocamlc -thread unix.cma threads.cma graphics.cma -o square.exe square.ml
7 - Linux
8 ocamlc -thread unix.cma threads.cma graphics.cma -o square square.ml
9
10 - To change the size of the maze, change the parameters to the function "make_labyrinth width height" at the end of this file
11 - To change the starting/end point change the parameters of the function "solve" as follows:
12 solve laby start_x start_y end_x end_y
13 *)
14
15
16 open Graphics;;
17
18 type door = Left | Right | Top | Bottom;;
19 type cell = {mutable color : int ; mutable doors:door list};;
20 type labyrinth = {width : int; height : int; cells : cell array array};;
21
22 let new_labyrinth w h =
23 { width = w; height = h; cells =
24 Array.init w (fun y ->
25 Array.init h (fun x ->
26 {color = y * w + x + 10; doors = []}
27 )
28 )
29 };;
30
31 exception No_Cell of door;;
32 Random.self_init ();;
33
34 let open_door laby x y door =
35 let cl = laby.cells.(x).(y) in
36 if List.mem door cl.doors = false then
37 cl.doors <- door::cl.doors;;
38
39 let door_opened laby x y door =
40 let cl = laby.cells.(x).(y) in
41 List.mem door cl.doors;;
42
43 let door_closed laby x y door =
44 not (door_opened laby x y door);;
45
46 let neighbour laby x y door =
47 let newx, newy =
48 match door with
49 Left -> if x <1 or x >= laby.width or y < 0 or y >= laby.height then raise (No_Cell Top)
50 else
51 x-1, y
52 | Right -> if x < 0 or x >= laby.width - 1 or y < 0 or y >= laby.height then raise (No_Cell Top)
53 else
54 x + 1, y
55 | Bottom -> if y < 1 or y >= laby.height or x < 0 or x >= laby.width then
56 raise (No_Cell Top)
57 else
58 x, y-1
59 | Top -> if y < 0 or y >= laby.height - 1 or x < 0 or x >= laby.width then raise (No_Cell Top)
60 else
61 x, y+1
62 in
63 newx, newy;;
64
65 let opposite door =
66 match door with
67 Left -> Right
68 | Right -> Left
69 | Top -> Bottom
70 | Bottom -> Top;;
71
72 let all_doors = [Left; Right; Top; Bottom];;
73
74 let rec choose_door laby op =
75 try
76 let rnd_x = Random.int laby.width in
77 let rnd_y = Random.int laby.height in
78 let index = Random.int (List.length all_doors) in
79 let dr = List.nth all_doors index in
80 let _ = neighbour laby rnd_x rnd_y dr in
81 op rnd_x rnd_y dr
82 with
83 _ -> choose_door laby op
84 ;;
85
86 let rec change_color laby x y c =
87 let cl = laby.cells.(x).(y) in
88 cl.color <- c;
89 (* change the color of the neighbours of this cell to this cell's color *)
90 List.iter (fun dr ->
91 try
92 let nbx, nby = neighbour laby x y dr in
93 if laby.cells.(nbx).(nby).color <> c then
94 (
95 change_color laby nbx nby c;
96 )
97 with
98 _ -> ()
99 ) cl.doors
100 ;;
101
102 (* returns true if we could make the two cells (sharing door d) of the same color *)
103 let connect laby x y d =
104 try
105 let xn, yn = neighbour laby x y d in
106 let cl = laby.cells.(x).(y) in
107 let cl_new = laby.cells.(xn).(yn) in
108 if cl.color = cl_new.color then
109 raise (No_Cell Left)
110 else
111 (
112 change_color laby xn yn (cl.color);
113 open_door laby x y d;
114 open_door laby xn yn (opposite d);
115 true
116 )
117 with
118 _ -> false;;
119
120 let make_labyrinth width height =
121 let laby = new_labyrinth width height in
122
123 let colors_count = ref (width * height) in
124 while (!colors_count > 1) do
125 if (choose_door laby (connect laby)) then
126 colors_count := !colors_count - 1
127 done;
128 laby
129 ;;
130
131 (********************************* graphics *****************************************)
132 open_graph " 700x700";;
133 set_line_width 2;;
134
135 let get_closed_doors lst_doors all_doors =
136 List.fold_left (fun acc dr -> if List.mem dr lst_doors then acc else dr::acc) [] all_doors;;
137
138 (* draws the doors of a cell *)
139 let draw_cell laby x y =
140 let cl = laby.cells.(x).(y) in
141 let cell_width_tmp = 600 / laby.width in
142 let cell_height_tmp = 600 / laby.height in
143 let cell_width = if cell_width_tmp < cell_height_tmp then cell_width_tmp else cell_height_tmp in
144 set_color 4878475;
145 List.iter (fun dr ->
146 match dr with
147 Left -> moveto (50 + cell_width * x) (50 + cell_width * y);
148 lineto (50 + cell_width * x) (50 + cell_width * (y + 1))
149 |Right -> moveto (50 + cell_width * (x+1)) (50 + cell_width * y);
150 lineto (50 + cell_width * (x+1)) (50 + cell_width * (y+1))
151 |Top -> moveto (50 + cell_width * x) (50 + cell_width * (y + 1));
152 lineto (50 + cell_width * (x + 1)) (50 + cell_width * (y + 1))
153 |Bottom -> moveto (50 + cell_width * x) (50 + cell_width * y);
154 lineto (50 + cell_width * (x + 1)) (50 + cell_width * y)
155 ) (get_closed_doors cl.doors all_doors);;
156
157 let color_cell laby x y =
158 set_color (laby.cells.(x).(y).color);
159 let cell_width_tmp = 600 / laby.width in
160 let cell_height_tmp = 600 / laby.height in
161 let cell_width = if cell_width_tmp < cell_height_tmp then cell_width_tmp else cell_height_tmp in
162 fill_rect (50 + cell_width * x) (50 + cell_width * y) cell_width cell_width;;
163
164 (* iterate through a list with the index of the current element *)
165 let iteri f l =
166 let rec aux f i lst =
167 match lst with
168 [] -> ()
169 |hd::tl -> f i hd; aux f (i+1) tl
170 in aux f 0 l;;
171
172 (* make a uniform color of the maze *)
173 let reset_color laby =
174 Array.iter (fun array_cell ->
175 Array.iter (fun cl ->
176 cl.color <- 15461355
177 ) array_cell
178 ) laby.cells;;
179
180
181 exception Solved;;
182
183 (* once a door is used, we delete it from the list of doors associated to a cell so that we don't go through it again *)
184 let delete_door doors dr =
185 List.fold_left (fun acc x -> if x = dr then acc else x::acc ) [] doors;;
186
187 let solve laby public_x public_y ex ey =
188 (* color the source and destiation cells *)
189 laby.cells.(public_x).(public_y).color <- 0;
190 laby.cells.(ex).(ey).color <- 0;
191 color_cell laby public_x public_y;
192 draw_cell laby public_x public_y;
193 color_cell laby ex ey;
194 draw_cell laby ex ey;
195
196 try
197 let rec aux x y ex ey allowed_doors =
198 if x = ex && y = ey then
199 raise Solved
200 else
201 (
202 (* print_string "working : "; print_int x; print_string " | ";print_int y;print_string "\n"; *)
203 laby.cells.(x).(y).color <- 13467442;
204 color_cell laby x y;
205 draw_cell laby x y;
206
207 (*[fr] si la cellule a une seule porte alors elle est forcement pas dans le chemin de la solution,
208 on retourne false dans ce cas, true si elle l'est. On change sa couleur *)
209 if List.length laby.cells.(x).(y).doors = 1 && (x <> public_x or y <> public_y) then
210 (
211 laby.cells.(x).(y).color <- 6724044 ;
212 color_cell laby x y;
213 draw_cell laby x y;
c238019 martani adding try wrapper over Thread.delay to avoid crashes
authored
214
215 (* avoid Thread.delay exception: Fatal error: exception Unix.Unix_error(2, "select", "") *)
216 (try
217 Thread.delay 0.008
218 with
219 _ -> ()
220 );
221
207b1cd martani Code commit of OCaml Maze square.ml and bee.ml
authored
222 false
223 )
224 else
225 (
226 let res = ref true in
227 iteri (fun i dr ->
228 try
229 let nx, ny = neighbour laby x y dr in
230 let allowed_drs = delete_door laby.cells.(nx).(ny).doors (opposite dr) in
231
232 (*[fr] si la cellule suivante retourne false (pas dans le chemin) et on est dans la derniere porte
233 alors cette cellule aussi n'est pas dans le chemin *)
234 if (aux nx ny ex ey allowed_drs = false) && (List.length allowed_doors = i + 1) then
235 (
236 laby.cells.(x).(y).color <- 6724044 ;
237 laby.cells.(x).(y).color <- 6724044 ;
238 res := false;
239 )
240 else
241 res := true;
242
243 color_cell laby x y;
244 draw_cell laby x y;
c238019 martani adding try wrapper over Thread.delay to avoid crashes
authored
245
246 (* avoid Thread.delay exception: Fatal error: exception Unix.Unix_error(2, "select", "") *)
247 try
248 Thread.delay 0.008
249 with
250 _ -> ()
251
207b1cd martani Code commit of OCaml Maze square.ml and bee.ml
authored
252 with
253 No_Cell x -> ()
254 ) allowed_doors;
255 !res;
256 )
257 )
258 in
259 let _ = aux public_x public_y ex ey laby.cells.(public_x).(public_y).doors in ()
260 with
261 Solved -> print_string "solved";;
262
263
264 let show_labyrinth laby =
265 for i = 0 to laby.width - 1 do
266 for j = 0 to laby.height - 1 do
267 color_cell laby i j;
268 draw_cell laby i j;
269 done;
270 done;;
271
272
273 let laby = make_labyrinth 70 70;;
274
275 (* make a uniform color of the labyrinth *)
276 let _ = reset_color laby;;
277
278 show_labyrinth laby;;
279
280 solve laby 0 0 53 67;;
281
282 read_line ();;
Something went wrong with that request. Please try again.