Source

ml-maze-generator / maze.ml

(*
  Генератор лабиринтов
  (с) 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;