Source

ocaml-toys / maze / generator.ml

let shuffle lst = 
  let swap array i j = 
    let temp = array.(i) in array.(i) <- array.(j); array.(j) <- temp
  in
  let shuffle_array array = 
    Array.iteri (fun i _ -> swap array i (Random.int (i+1))) array;
    array
  in
  Array.to_list (shuffle_array (Array.of_list lst))

let rec select_point maze x1 y1 x2 y2 needle = 
  let x = x1 + Random.int (x2-x1)
  and y = y1 + Random.int (y2-y1) in
  if Maze.get maze (x, y) = needle then (x, y) 
  else select_point maze x1 y1 x2 y2 needle

let gen_recdiv width height divisions =
  let maze = Array.make_matrix width height ' ' in
  let minsize = 3 in
  let add_wall x1 y1 x2 y2 = 
    for x = x1 to x2 do
      for y = y1 to y2 do
        Maze.set maze (x, y) '#' 
      done
    done
  in
  let pierce_holes x1 y1 x2 y2 = 
    if x1 = x2 || y1 = y2 then ()
    else begin
	    let xhole1 = x1 + Random.int (x2-x1) 
		  and yhole1 = y1 + Random.int (y2-y1) in
		  Maze.set maze (x1, yhole1) ' ';
		  Maze.set maze (xhole1, y1) ' '
    end
  in
  let rec divide x1 y1 x2 y2 divisions =
    if divisions = 0 || (x2-x1) <= minsize || (y2-y1) <= minsize then
      pierce_holes x1 y1 x2 y2
    else begin
      let xwall = 2 + x1 + Random.int (x2-x1-3) 
      and ywall = 2 + y1 + Random.int (y2-y1-3) in
      add_wall x1 ywall x2 ywall;
      add_wall xwall y1 xwall y2;
      let divisions = (pred divisions) in   
      divide x1 y1 xwall ywall divisions;
      divide xwall y1 x2 ywall divisions;
      divide x1 ywall xwall y2 divisions;
      divide xwall ywall x2 y2 divisions;
    end
  in 
  divide 0 0 (width-1) (height-1) divisions;
  let start = select_point maze 0 0 (width/2) (height/2) ' ' in
  let goal = select_point maze (width/2) (height/2) (width-1) (height-1) ' ' in
  Maze.set maze start '@';
  Maze.set maze goal 'X';
  maze, start, goal    

(*Start at a particular cell and call it the "exit."                           *)
(*Mark the current cell as visited, and get a list of its neighbors.           *)
(*For each neighbor, starting with a randomly selected neighbor:               *)
(*  If that neighbor hasn't been visited, remove the wall between this cell    *)
(*  and that neighbor, and then recurse with that neighbor as the current cell.*)
  
let gen_backtracker width height =
  let maze = Array.make_matrix width height '#' in
  (* start with a random point, with even coords *)
  let start = select_point maze 0 0 (width-1) (height-1) '#' in
  let start = if (fst start) mod 2 <> 0 then (fst start)-1, snd start else start in
  let start = if (snd start) mod 2 <> 0 then fst start, (snd start)-1 else start in
  let remove_wall (x1, y1) (x2, y2) =
    if x1 <> x2 then Maze.set maze ((max x1 x2)-1, y1) ' '
    else if y1 <> y2 then Maze.set maze (x1, (max y1 y2)-1) ' '
  in
  let even_neighbors maze (x, y) =
	  let nodes = [] in
	  let nodes = if x > 1 then (x-2, y) :: nodes else nodes in
	  let nodes = if x < width - 2 then (x+2, y) :: nodes else nodes in
	  let nodes = if y > 1 then (x, y-2) :: nodes else nodes in
	  let nodes = if y < height - 2 then (x, y+2) :: nodes else nodes in
	  nodes
  in
  let visited = ref [] in
  let rec recurse previous current =
    if not (List.mem current !visited) then begin
	    Maze.set maze current ' ';
	    remove_wall previous current;
      visited := current :: !visited;      
	    let neighbors = shuffle (even_neighbors maze current) in
      List.iter (fun next -> recurse current next) neighbors
    end    
  in
  recurse start start;
  let goal = select_point maze 0 0 (width-1) (height-1) ' ' in
  Maze.set maze start '@';
  Maze.set maze goal 'X';  
  maze, start, goal

let rec add_holes maze n = match n with
  | 0 -> maze
  | _ -> 
    let x = Random.int ((Maze.width maze) -1)
    and y = Random.int ((Maze.height maze) -1) in
    if Maze.get maze (x, y) = '#' then Maze.set maze (x, y) ' ';
    add_holes maze (pred n)
    

let generate width height = gen_backtracker width height