(***********************************************************************)
(*                                                                     *)
(*                           Objective Caml                            *)
(*                                                                     *)
(*               Pierre Weis, projet Cristal, INRIA Rocquencourt       *)
(*                                                                     *)
(*  Copyright 2001 Institut National de Recherche en Informatique et   *)
(*  en Automatique.  All rights reserved.  This file is distributed    *)
(*  only by permission.                                                *)
(*                                                                     *)
(***********************************************************************)

let blancs n = String.make n ' ';;

let disque taille =
    let moitié_droite = String.make taille '>'
    and moitié_gauche = String.make taille '<' in
    moitié_gauche ^ "|" ^ moitié_droite;;

let disque_numéro n taille_grand_disque =
    let partie_blanche = blancs (taille_grand_disque + 1 - n) in
    partie_blanche ^ disque n ^ partie_blanche;;

let base_de_tige taille_grand_disque =
    let moitié = String.make taille_grand_disque '_' in
    " " ^ moitié ^ "|" ^ moitié ^ " ";;

let rec tige taille_grand_disque = function
  | (0, []) -> []
  | (0, tête :: reste) ->
      disque_numéro tête taille_grand_disque ::
      tige taille_grand_disque (0, reste)
  | (décalage, liste) ->
      disque_numéro 0 taille_grand_disque ::
      tige taille_grand_disque (décalage - 1, liste);;

let rec recolle l1 l2 l3 =
  match (l1, l2, l3) with
  | ([], [], []) -> []
  | (t1 :: r1, t2 :: r2, t3 :: r3) -> (t1 ^ t2 ^ t3) :: recolle r1 r2 r3
  | _ -> failwith "recolle";;

let imprime ligne = print_string ligne; print_newline();;

let imprime_jeu nombre_de_disques départ milieu arrivée =
    let dessin =
        recolle (tige nombre_de_disques départ)
                (tige nombre_de_disques milieu)
                (tige nombre_de_disques arrivée) in
    List.iter imprime dessin;
    let b = base_de_tige nombre_de_disques in imprime (b ^ b ^ b);;

let ajoute_disque disque (décalage, disques as tige) =
    (décalage - 1, disque :: disques);;

let sommet = function
  | (décalage, sommet :: reste) -> sommet
  | (décalage, []) -> failwith "sommet: tige vide";;

let enlève_sommet = function
  | (décalage, sommet :: reste) -> (décalage + 1, reste)
  | (décalage, []) -> failwith "enlève_sommet: tige vide";;

let déplace (nom_départ, tige_départ) (nom_arrivée, tige_arrivée) =
    imprime ("Je déplace un disque de " ^ nom_départ ^ " à " ^ nom_arrivée);
    let disque_déplacé = sommet !tige_départ in
    tige_départ := enlève_sommet !tige_départ;
    tige_arrivée := ajoute_disque disque_déplacé !tige_arrivée;;

let tige_vide nombre_de_disques = (nombre_de_disques, []);;

let tige_pleine nombre_de_disques =
    let rec liste_des_disques i =
        if i <= nombre_de_disques
        then i :: liste_des_disques (i + 1)
        else [] in
    (0, liste_des_disques 1);;

let attend () =
    print_string "Appuyer sur return pour continuer"; print_newline ();
    ignore (read_line ());;

let jeu nombre_de_disques =
    let gauche = ref (tige_pleine nombre_de_disques)
    and milieu = ref (tige_vide nombre_de_disques)
    and droite = ref (tige_vide nombre_de_disques) in
    let rec hanoi hauteur départ intermédiaire destination =
        if hauteur > 0 then
         begin
           hanoi (hauteur - 1) départ destination intermédiaire;
           attend ();
           déplace départ destination;
           imprime_jeu nombre_de_disques !gauche !milieu !droite;
           hanoi (hauteur - 1) intermédiaire départ destination
         end in
    imprime "J'appelle les tiges A, B et C.";
    imprime "La position de départ est";
    imprime_jeu nombre_de_disques !gauche !milieu !droite;
    hanoi nombre_de_disques
          ("A", gauche) ("B", milieu) ("C", droite);;

if !Sys.interactive then () else begin
   let usage () =
     prerr_endline "Usage: hanoi <nombre de disques>";
     exit 2 in
   let l = Array.length Sys.argv in
   if l <= 1 then usage () else
   let n = int_of_string (Sys.argv.(1)) in
   if n <= 0 then usage () else
   jeu n;
   attend ();
   exit 0
end;;