#load "graphics.cma" ;;

type laby = {
  p : int ;
  q : int ;
  h : bool array array ;
  v : bool array array
}

let new_laby p q v =
  let laby =
    {
      p = p ;
      q = q ;
      h = Array.make_matrix p q v ;
      v = Array.make_matrix p q v
    }
  in
    if v=true then begin
      for i=0 to p-1 do
        laby.h.(i).(0) <- false
      done ;
      for j=0 to q-1 do
        laby.v.(0).(j) <- false
      done
    end ;
    laby
                            
(* Module de dessin. *)
module Graph =
struct

  (* Largeur, hauteur et marge *)
  let w = 620
  let h = 620
  let margin = 10

  (* Création de la fenêtre graphique *)
  let _ =
    Graphics.open_graph (Printf.sprintf "%s %dx%d" (Sys.getenv "DISPLAY") w h)

  (* Attente du prochain clic *)
  let wait () =
    Printf.printf "Cliquez pour continuer...%!" ;
    ignore (Graphics.wait_next_event [Graphics.Button_down]) ;
    Printf.printf "ok.\n%!"

  (* Dessin d'un labyrinthe *)
  let draw laby =
    let lx = (w-2*margin) / laby.p in
    let ly = (h-2*margin) / laby.q in
    let p i j = margin + i*lx, margin + j*ly in
      (* On efface le tableau, et on dessine la grille des cases en gris *)
      Graphics.clear_graph () ;
      Graphics.set_color (Graphics.rgb 242 242 242) ;
      for i = 0 to laby.p-1 do
        Graphics.draw_poly_line [| p i 0 ; p i laby.q |]
      done ;
      for j = 0 to laby.q-1 do
        Graphics.draw_poly_line [| p 0 j ; p laby.p j |]
      done ;
      (* En noir le contour... *)
      Graphics.set_color Graphics.red ;
      Graphics.draw_rect margin margin (laby.p*lx) (laby.q*ly) ;
      Graphics.set_color Graphics.black ;
      (* ... puis les arêtes *)
      for i = 0 to laby.p-1 do
        for j = 0 to laby.q-1 do
          if laby.h.(i).(j) then
            Graphics.draw_poly_line [| p i j ; p (i+1) j |] ;
          if laby.v.(i).(j) then
            Graphics.draw_poly_line [| p i j ; p i (j+1) |]
        done
      done

  (* Selection d'une cellule *)
  let pick laby =
    Printf.printf "Cliquez dans une case...%!" ;
    let status = Graphics.wait_next_event [Graphics.Button_down] in
    let x,y = status.Graphics.mouse_x, status.Graphics.mouse_y in
    let lx = (w-2*margin) / laby.p in
    let ly = (h-2*margin) / laby.q in
      Printf.printf "ok.\n%!" ;
      (x-margin)/lx,(y-margin)/ly

  (* Marquage *)
  let mark laby i j =
    let lx = (w-2*margin) / laby.p in
    let ly = (h-2*margin) / laby.q in
    let p i j = margin + i*lx, margin + j*ly in
      Graphics.set_color Graphics.green ;
      let (i,j) = p i j in
        Graphics.fill_rect (i+1) (j+1) (lx-2) (ly-2)

end ;;

(* Représentation d'un ensemble variable mais dont la taille reste bornée
 * par un entier n donné à l'avance. *)
let set_new n elt = ref 0,Array.create n elt
let set_add (n,ar) elt = ar.(!n) <- elt ; incr n
let set_remove (n,ar) i = ar.(i) <- ar.(!n-1) ; decr n
let set_pick (n,ar) = assert (!n>0) ; ar.(Random.int !n)
let set_empty (n,ar) = !n=0
let set_remove_all (n,ar) f =
  (* Attention cela ne marche pas avec un for de 0 à n-1.
   * On peut faire avec des indices croissants, avec un while et quelques
   * precautions. *)
  for i = !n-1 downto 0 do
    if f ar.(i) then set_remove (n,ar) i
  done

(* Génération d'un labyrinthe.
 * La technique utilisée est d'enlever des murs (ajouter des arêtes si on
 * considère le labyrinthe comme une graphe, où les cellules sont les sommets)
 * jusqu'à obtenir un labyrinthe connexe.
 * On démarre avec tous les murs.
 * On initialise la partie "intérieure" du graphe à une seule cellule.
 * A chaque passe on choisit un mur au hasard qui isole l'intérieur d'une
 * cellule non accessible depuis l'intérieur.
 * Pour cela on maintient:
 * . la frontière de l'intérieur,
 *   pour pouvoir y choisir rapidement un mur à enlever
 * . un tableau indiquant si un sommet est dans l'intérieur
 * *)
let random p q =
  let laby = new_laby p q true in
  let front = set_new (p*q) (0,0) in
  let inside = Array.make_matrix p q false in
  let neighbours_outside (i,j) =
    let n = if i>0 && not inside.(i-1).(j) then [i-1,j] else [] in
    let n = if i<p-1 && not inside.(i+1).(j) then (i+1,j)::n else n in
    let n = if j<q-1 && not inside.(i).(j+1) then (i,j+1)::n else n in
      if j>0 && not inside.(i).(j-1) then (i,j-1)::n else n
  in
    inside.(0).(0) <- true ;
    set_add front (0,0) ;
    Random.self_init () ;
    while not (set_empty front) do
      let (i0,j0) = set_pick front in
      (* Choisir un voisin qui n'est pas dans l'intérieur *)
      let v = neighbours_outside (i0,j0) in
      let (i,j) = List.nth v (Random.int (List.length v)) in
        (* Enlever le mur entre (i,j) et (i0,j0),
         * ce qui fait pénétrer (i,j) à l'intérieur *)
        if i0=i then
          if j0<j then
            laby.h.(i0).(j0+1) <- false
          else
            laby.h.(i0).(j0) <- false
        else
          if i0<i then
            laby.v.(i0+1).(j0) <- false
          else
            laby.v.(i0).(j0) <- false ;
        inside.(i).(j) <- true ;
        (* Maintenir la frontière de l'intérieur:
         * on ajoute le nouveau candidat, et on filtre tout le monde. *)
        set_add front (i,j) ;
        set_remove_all front (fun e -> neighbours_outside e = [])
    done ;
    laby
;;

let chemin laby (i0,j0) (i,j) =
  let d = Array.make_matrix laby.p laby.q (-1) in
  let todo = ref [i0,j0] in
  let neighbours (i,j) =
    let n = if i>0 && not laby.v.(i).(j) then [i-1,j] else [] in
    let n = if i<laby.p-1 && not laby.v.(i+1).(j) then (i+1,j)::n else n in
    let n = if j<laby.q-1 && not laby.h.(i).(j+1) then (i,j+1)::n else n in
      if j>0 && not laby.h.(i).(j) then (i,j-1)::n else n
  in
    d.(i0).(j0) <- 0 ;
    while d.(i).(j) = -1 do
      todo :=
        List.concat
          (List.map
             (fun (i,j) ->
                let cur_d = d.(i).(j) in
                  List.filter
                    (fun (i,j) ->
                       if d.(i).(j) = -1 then begin
                         d.(i).(j) <- cur_d+1 ;
                         true
                       end else false)
                    (neighbours (i,j)))
             !todo)
    done ;
    let ij = ref (i,j) in
      while d.(fst !ij).(snd !ij) > 0 do
        let i,j = fst !ij, snd !ij in
          Graph.mark laby i j ;
          ij := List.find
                  (fun (ii,jj) -> d.(i).(j) = d.(ii).(jj)+1)
                  (neighbours !ij)
      done ;
      Graph.mark laby i0 j0
;;

Printf.printf
  "Generation en 100x100, selection de deux points et resolution.\n" ;;

let laby = random 100 100 ;;
Graph.draw laby ;;
let start = Graph.pick laby ;;
let stop = Graph.pick laby ;;
chemin laby start stop ;;

Printf.printf "La meme chose en taille 300x200 ?\n" ;;
Graph.wait () ;;

let laby = random 300 200 ;;
Graph.draw laby ;;
let start = Graph.pick laby ;;
let stop = Graph.pick laby ;;
chemin laby start stop ;;
Printf.printf "Regardez bien, le chemin vert est la.. C'est fini.\n" ;
Graph.wait ()