(* Utilise Graphics *)

type labyrinthe = bool array array

let maze1 =
  [|[| false; false; false; false; false; false; false |]
  ; [| false; true ; true; false; true; true; false |]
  ; [| false; true; false; false; true; false; false |]
  ; [| false; true; true; true; true; true; false |]
  ; [| false; false; false; false; false; false; false |]
  |]

let step = 20

let draw_square (i,j) c =
  Graphics.set_color c;
  Graphics.fill_rect (100+i*step) (100+j*step) step step

(* trace un rectangle vide de coté m *)
let draw_rect ~color (i,j) m =
  Graphics.set_color color;
  let x, y = 100+i*step, 100+j*step in
  Graphics.draw_rect x y (m*step) (m*step)

let draw_maze m =
  Array.iteri
    (fun j line ->
      Array.iteri
        (fun i case ->
          let color = if case then Graphics.white else Graphics.black in
          draw_square (i,j) color
        ) line
    ) m

let rec draw_path ~color p = match p with
  | [] -> ()
  | (i,j) :: p' ->
      draw_square (i,j) color; draw_path ~color p'

let next maze (i,j) =
  if maze.(j).(i+1) then Some (i+1, j)
  else if maze.(j).(i-1) then Some (i-1, j)
  else if maze.(j-1).(i) then Some (i, j-1)
  else if maze.(j+1).(i) then Some (i, j+1)
  else None

let copy_matrix m =
  Array.init (Array.length m) (fun i -> Array.copy m.(i))

(* traverse le graphe et appelle [each] à chaque endroit parcouru *)
let walk ?(each=(fun _ _ -> ())) maze start stop =
  let maze = copy_matrix maze in
  let p = ref [] in
  let pos = ref start in
  while !pos <> stop do
    each !pos !p;
    (* position suivante *)
    match next maze !pos with
    | None ->
        begin match !p with
        | [] -> failwith "pas de chemin"
        | pos' :: p' ->
            p := p';
            pos := pos'
        end
    | Some pos' ->
        maze.(snd pos').(fst pos') <- false;  (* case explorée *)
        p := !pos :: !p;
        pos := pos'
  done;
  assert (!pos = stop);
  each !pos !p;
  !p

let minisleep sec =
  ignore (Unix.system (Printf.sprintf "sleep %.3f" sec))

let walk_wait ~wait maze start stop =
  let traversed = ref [] in
  let each pos p =
    traversed := pos :: !traversed;
    Graphics.clear_graph ();
    draw_maze maze;  (* affiche l'ancien labyrinthe *)
    List.iter (fun pos -> draw_square pos (Graphics.rgb 170 170 170)) !traversed;
    draw_square stop Graphics.green;
    let color = if pos=stop then Graphics.red else Graphics.yellow in
    draw_path ~color p;
    draw_square pos Graphics.cyan ;
    Graphics.synchronize ();
    minisleep wait;
  in
  walk ~each maze start stop

type direction =
  | North
  | South
  | East
  | West

let _random_direction () =
  match Random.int 4 with
  | 0 -> North
  | 1 -> South
  | 2 -> East
  | 3 -> West
  | _ -> assert false

(* génère un labyrinthe aléatoire de taille 2^k + 1. [each] est appelé à
    chaque itération *)
let make_maze ?(each=fun _ _ _ _ -> ()) k =
  let maze = Array.make_matrix ((1 lsl k) + 1) ((1 lsl k) + 1) false in
  (* remplit le carré i,j -> i+2^m-1, j+2^m-1 *)
  let rec aux i j m =
    assert (m>0);
    if m=1 then maze.(j).(i) <- true
    else (
      let m2 = (1 lsl m) - 1 in  (* 2^m -1 *)
      each maze i j m;
      (* tracer les sous-labyrinthes *)
      aux i j (m-1);
      aux (i+m2/2+1) j (m-1);
      aux i (j+m2/2+1) (m-1);
      aux (i+m2/2+1) (j+m2/2+1) (m-1);
      (* tracer les trous dans les murs *)
      each maze i j m;
      let protected = _random_direction () in
      List.iter
        (fun dir ->
          if dir <> protected then
            let n = Random.int (m2/4 + 1) * 2 in
            let i,j = match dir with
              | North -> i + m2/2, j + m2/2 + 1 + n
              | South -> i + m2/2, j + n
              | East  -> i + m2/2 + 1 + n, j + m2/2
              | West  -> i + n, j + m2/2
            in
            maze.(j).(i) <- true
        ) [North; South; East; West]
    )
  in
  (* préserver la bordure, donc travailler dans une zone de taille 2^k-1 *)
  aux 1 1 k;
  maze

let make_maze_wait ~wait k =
  let wait = ref wait in
  let each maze i j m =
    Graphics.clear_graph ();
    draw_maze maze;  (* affiche l'ancien labyrinthe *)
    draw_rect ~color:Graphics.red (i, j) ((1 lsl m)-1); (* affiche une bordure rouge *)
    Graphics.synchronize ();
    minisleep !wait;
    if !wait > 0.1
      then wait := !wait *. 0.98;
  in
  make_maze ~each k

(* parcours avec une file *)
let walk_bfs ?(each=(fun _ _ _ -> ())) maze start stop =
  let maze = copy_matrix maze in
  let q = Queue.create () in
  Queue.push (start,[]) q;
  let found = ref None in
  while !found = None do
    if Queue.is_empty q then failwith "pas de chemin";
    let ((i,j) as pos), path = Queue.pop q in
    if pos = stop then (
      (* gagné *)
      found := Some (pos::path);
    )
    else if maze.(snd pos).(fst pos) then (
      each pos path q;
      maze.(j).(i) <- false;
      (* ajouter les voisins à la file *)
      let path' = pos::path in
      if maze.(j+1).(i)
        then Queue.push ((i,j+1), path') q;
      if maze.(j-1).(i)
        then Queue.push ((i,j-1), path') q;
      if maze.(j).(i+1)
        then Queue.push ((i+1,j), path') q;
      if maze.(j).(i-1)
        then Queue.push ((i-1,j), path') q;
    )
  done;
  match !found with
    | None -> assert false
    | Some p -> p

let walk_bfs_wait ~wait maze start stop =
  (* points traversés *)
  let traversed = ref [] in
  let each pos path q =
    traversed := pos :: !traversed;
    (* dessiner le labyrinthe *)
    Graphics.clear_graph ();
    draw_maze maze;  (* affiche l'ancien labyrinthe *)
    draw_square stop Graphics.green;
    List.iter (fun pos -> draw_square pos (Graphics.rgb 170 170 170)) !traversed;
    Queue.iter
      (fun (pos',p) ->
        List.iter (fun pos'' -> draw_square pos'' Graphics.yellow) p;
        draw_square pos' Graphics.cyan;
      ) q;
    draw_path ~color:Graphics.yellow path;
    draw_square pos Graphics.cyan;
    Graphics.synchronize ();
    minisleep wait;
  in
  walk_bfs ~each maze start stop


(* Début *)
let () =
  Graphics.open_graph "";
  Graphics.auto_synchronize false;

  Random.self_init ();  (* vrai aléatoire *)
  draw_maze maze1;
  Graphics.synchronize ();

  ignore (walk_bfs_wait ~wait:0.4 maze1 (2,1) (5,1));
  ignore (walk_wait ~wait:0.2 maze1 (2,1) (5,1));

  Graphics.clear_graph ();

  let m = make_maze_wait ~wait:0.3 5 in
  draw_maze m;
  Graphics.synchronize ();

  ignore (walk_wait ~wait:0.1 m (1,1) ((1 lsl 5)-1, (1 lsl 5)-1));
  ignore (Graphics.read_key ());

  let path = walk_bfs_wait ~wait:0.1 m (1,1) ((1 lsl 5)-1, (1 lsl 5)-1) in
  draw_maze m;
  draw_path ~color:Graphics.red path;
  Graphics.synchronize ();

  (* attendre *)
  ignore (Graphics.read_key ());
  ()