Alexander Alexeev avatar Alexander Alexeev committed 4a82d53

Initial commit

Comments (0)

Files changed (3)

+*.cmx
+*.cmi
+*.o
+maze
+build:
+	ocamlopt maze.ml -o maze
+(*
+  Генератор лабиринтов
+  (с) 2013 Александр Алексеев
+  http://eax.me/
+*)
+
+(* Ячейка лабиринта *)
+type cell = {
+  mutable move_up : bool;
+  mutable move_left : bool;
+}
+
+(* Лабиринт --- это матрица ячеек *)
+type maze = cell array array
+
+(* Функции для определения размеров лабиринта *)
+let maze_width m = Array.length m
+let maze_max_x m = (maze_width m) - 1
+let maze_height m = Array.length m.(0)
+let maze_max_y m = (maze_height m) - 1
+
+(* Вывод лабиринта *)
+let print_maze_row m y =
+  let width = maze_width m in
+    let top_str = String.create (width*2)
+    and middle_str = String.create (width*2) in
+      for x = 0 to width-1 do
+        let c = m.(x).(y) in
+          let top_char = if c.move_up then ' ' else '-'
+          and left_char = if c.move_left then ' ' else '|' in
+            String.set top_str (x*2) '+';
+            String.set top_str (x*2 + 1) top_char;
+
+            String.set middle_str (x*2) left_char;
+            String.set middle_str (x*2 + 1) ' '
+      done;
+      print_string top_str;
+      print_endline "+";
+      print_string middle_str;
+      print_endline "|"
+
+let print_maze m =
+  for y = 0 to (maze_max_y m) do
+    print_maze_row m y
+  done;
+  for x = 0 to (maze_max_x m) do
+    print_string "+-"
+  done;
+  print_endline "+"
+ 
+(* "Пустой" лабиринт, в котром ни из одной ячейки
+   нельзя попасть ни в одну другую *)
+let empty_maze width height =
+  if width <= 0 then raise (Invalid_argument "width")
+  else if height <= 0 then raise (Invalid_argument "height")
+  else Array.init width (
+         fun(_) ->
+           Array.init height (
+             fun (_) ->
+               { move_up = false; move_left = false }
+           )
+       )
+
+(* Генерируем список с координатами всех ячеек
+   в лабиринте заданного размера *)
+let not_visited_cells_list width height =
+  let max_x = width - 1
+  and max_y = height - 1 in
+    let rec not_visited_cells_list' x y acc =
+      if x == 0
+      then if y == 0
+           then (0,0) :: acc
+           else not_visited_cells_list' max_x (y-1) ( (0,y) :: acc )
+      else not_visited_cells_list' (x-1) y ( (x,y) :: acc )
+    in
+      not_visited_cells_list' max_x max_y []
+
+(* Верно ли, что заданная ячейка не соединена
+   ни с одной другой? *)
+let is_standalone_cell m x y =
+  let c = m.(x).(y) in
+    c.move_up == false &&
+    c.move_left == false && 
+    ( if x >= maze_max_x m
+        then true
+        else m.(x+1).(y).move_left == false ) &&
+    ( if y >= maze_max_y m
+        then true
+        else m.(x).(y+1).move_up == false )
+
+(* "Роем" в лабиринте путь с началом в (start_x, start_y), пока
+    а) не упремся в "прорытую" кем-то еще ячейку
+    б) не сделаем max_len переходов между ячейками
+    в) не упремся в угол
+    В случае (а) возвращаем true, в случаях (б) и (в) -- false *)
+let rec make_random_path_part m x y visited max_len = 
+  let next_step new_x new_y =
+        make_random_path_part m new_x new_y visited (max_len - 1)
+  and was_visited x y =
+      try
+        Hashtbl.find visited (x,y)
+      with
+        Not_found -> false
+  and mark_visited x y =
+        Hashtbl.add visited (x,y) true
+  in let do_nothing () = next_step x y
+  in let connect_cell x y modify_maze =
+         if was_visited x y
+         then do_nothing ()
+         else
+           let standalone = is_standalone_cell m x y in (
+             modify_maze ();
+             if standalone
+             then ( mark_visited x y; next_step x y )
+             else true
+           )
+  in let move_left () =
+    if x > 0
+    then connect_cell (x-1) y (fun () -> m.(x).(y).move_left <- true)
+    else do_nothing ()
+  and move_right () =
+    if x < maze_max_x m
+    then connect_cell (x+1) y (fun () -> m.(x+1).(y).move_left <- true)
+    else do_nothing ()
+  and move_up () = 
+    if y > 0
+    then connect_cell x (y-1) (fun () -> m.(x).(y).move_up <- true)
+    else do_nothing ()
+  and move_down () =
+    if y < maze_max_y m 
+    then connect_cell x (y+1) (fun () -> m.(x).(y+1).move_up <- true)
+    else do_nothing ()
+  in
+     if max_len <= 0 then false
+     else match Random.int 4 with
+          | 0 -> move_left ()
+          | 1 -> move_right ()
+          | 2 -> move_down ()
+          | _ -> move_up ()
+
+let rec gen_maze' m lst htbl part_len =
+  if lst == [] then m
+  else let (x, y) = List.hd lst in
+    if is_standalone_cell m x y
+    then (
+      Hashtbl.clear htbl;
+      Hashtbl.add htbl (x,y) true;
+      if make_random_path_part m x y htbl part_len
+      then ()
+      else  (* получиля ни с чем не соединенная часть пути,
+               соединям вручную *)
+        if y > 0 && not m.(x).(y).move_up
+        then m.(x).(y).move_up <- true
+        else m.(x).(y).move_left <- true
+    ) else ();
+    gen_maze' m (List.tl lst) htbl part_len
+
+let gen_maze width height part_len =
+  let m0 = empty_maze width height
+  and not_visited = not_visited_cells_list width height
+  and htbl = Hashtbl.create (part_len*2) in
+    Hashtbl.add htbl (0,0) true;
+    let _ = make_random_path_part m0 0 0 htbl part_len in
+    gen_maze' m0 not_visited htbl part_len
+
+let main =
+  Random.self_init ();
+  let m = gen_maze 10 10 7 in
+  print_maze m; 
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.