Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 270 lines (229 sloc) 9.779 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;
214 Thread.delay 0.008;
215 false
216 )
217 else
218 (
219 let res = ref true in
220 iteri (fun i dr ->
221 try
222 let nx, ny = neighbour laby x y dr in
223 let allowed_drs = delete_door laby.cells.(nx).(ny).doors (opposite dr) in
224
225 (*[fr] si la cellule suivante retourne false (pas dans le chemin) et on est dans la derniere porte
226 alors cette cellule aussi n'est pas dans le chemin *)
227 if (aux nx ny ex ey allowed_drs = false) && (List.length allowed_doors = i + 1) then
228 (
229 laby.cells.(x).(y).color <- 6724044 ;
230 laby.cells.(x).(y).color <- 6724044 ;
231 res := false;
232 )
233 else
234 res := true;
235
236 color_cell laby x y;
237 draw_cell laby x y;
238 Thread.delay 0.008;
239 with
240 No_Cell x -> ()
241 ) allowed_doors;
242 !res;
243 )
244 )
245 in
246 let _ = aux public_x public_y ex ey laby.cells.(public_x).(public_y).doors in ()
247 with
248 Solved -> print_string "solved";;
249
250
251 let show_labyrinth laby =
252 for i = 0 to laby.width - 1 do
253 for j = 0 to laby.height - 1 do
254 color_cell laby i j;
255 draw_cell laby i j;
256 done;
257 done;;
258
259
260 let laby = make_labyrinth 70 70;;
261
262 (* make a uniform color of the labyrinth *)
263 let _ = reset_color laby;;
264
265 show_labyrinth laby;;
266
267 solve laby 0 0 53 67;;
268
269 read_line ();;
Something went wrong with that request. Please try again.