(* #load "graphics.cma";; *)
(* #use "o_gi.ml";; *)

open Graphics;;
open Sys;;
open List;;
(* *) open O_gi;; (* *)


let f = ref (try let c = open_in "hanoi_time.txt" in
                 let f = int_of_string (input_line c) in
                 close_in c;
                 f;
             with _ -> 20000) ;;
let ff = !f * 440 ;;


let hanoi n =

open_graph "";

let grey = rgb 192 192 192 and orange = rgb 252 128 0 in
let p = [|black ; orange ; grey ; cyan ; magenta ; green ; red ; blue ; yellow|]
and a1 = ref n and a2 = ref 0 and a3 = ref 0 and o = ref 0
and t = int_of_float (2.**(float_of_int n)) -1 in

clear_graph();
set_color black;
fill_rect 165 200 10 200;
fill_rect 395 200 10 200;
fill_rect 625 200 10 200;
moveto 60 200 ; lineto 280 200;
moveto 290 200 ; lineto 510 200;
moveto 520 200 ; lineto 740 200;

for i = 9-n to 8 do
        set_color p.(i);
        fill_rect (70+10*i) (200+20*(i+n-9)) (200-20*i) 20;
done;
set_color black;

moveto 100 150 ; lineto 356 150 ; lineto 356 161 ; lineto 100 161 ; lineto 100 150;
moveto 370 147 ; draw_string "0 %";
moveto 550 147 ; draw_string ("0 / "^(string_of_int t));

let inter () =
        let e = wait_next_event [Key_pressed ; Poll] in
        if e.key='+' || e.key='=' then f:= !f*9/10;
        if e.key='-' || e.key='6' then f:= !f*10/9+1;
        if e.key='q' then raise Exit;
        if e.key='p' then let _ = wait_next_event [Button_down] in ();
in

let wait () = for i = 1 to !f do () done in

let a = function
        | 1 -> !a1
        | 2 -> !a2
        | _ -> !a3
in

let soulevement n =
        inter();
        let im = get_image (70+230*(n-1)) (181+20*(a n)) 200 1 in
        for y = 181+20*(a n) to 400 do
                set_color white;
                moveto (70+230*(n-1)) y ; lineto (270+230*(n-1)) y;
                set_color black;
                moveto (165+230*(n-1)) y ; lineto (175+230*(n-1)) y;
                draw_image im (70+230*(n-1)) (y+20);
                wait();
        done;
        for y = 401 to 420 do
                set_color white;
                moveto (70+230*(n-1)) y ; lineto (270+230*(n-1)) y;
                draw_image im (70+230*(n-1)) (y+20);
                wait();
        done;
        set_color black;
        match n with
                | 1 -> decr a1
                | 2 -> decr a2
                | _ -> decr a3
in

let abaissement n =
        inter();
        let im = get_image (70+230*(n-1)) 421 200 1 in
        for y = 420 downto 381 do
                set_color white;
                moveto (70+230*(n-1)) (y+20) ; lineto (270+230*(n-1)) (y+20);
                draw_image im (70+230*(n-1)) y;
                wait();
        done;
        for y = 380 downto 201+20*(a n) do
                set_color white;
                moveto (70+230*(n-1)) (y+20) ; lineto (270+230*(n-1)) (y+20);
                set_color black;
                moveto (165+230*(n-1)) (y+20) ; lineto (175+230*(n-1)) (y+20);
                draw_image im (70+230*(n-1)) y;
                wait();
        done;

        incr o;
        set_color blue;
        fill_rect 101 150 (!o*255/t) 10;
        set_color white;
        fill_rect 370 147 250 18;
        set_color black;
        moveto 370 147 ; draw_string ((string_of_int (!o*100/t))^" %");
        moveto 550 147 ; draw_string ((string_of_int !o)^" / "^string_of_int t);

        match n with
                | 1 -> incr a1
                | 2 -> incr a2
                | _ -> incr a3
in

let deplacement n m =
        inter();
        let im = get_image (69+230*(n-1)) 421 202 20 in
        if m > n then ( for x = 1 to 230*(m-n) do draw_image im (69+230*(n-1)+x) 421 ; wait() done );
        if m < n then ( for x = 1 to 230*(n-m) do draw_image im (69+230*(n-1)-x) 421 ; wait() done );
in

let rec hanoi n a b c =
        if n = 1 then ( soulevement a ; deplacement a c ; abaissement c )
        else ( hanoi (n-1) a c b ; hanoi 1 a b c ; hanoi (n-1) b a c );
in

let s = "Veuillez taper sur une touche ou cliquer pour commencer" in
print_string s ; flush stdout ; moveto 276 450 ; draw_string s;
let _ = wait_next_event [Button_down ; Key_pressed] in
set_color white;
fill_rect 276 450 440 18;

try
        hanoi n 1 2 3;
        for i = 1 to ff do () done;
        close_graph();
with Exit -> close_graph();
;;


let jeu n =

open_graph "";

let grey = rgb 192 192 192 and orange = rgb 252 128 0 in
let p = [|black ; orange ; grey ; cyan ; magenta ; green ; red ; blue ; yellow|]
and a1 = ref n and a2 = ref 0 and a3 = ref 0 and o = ref 0
and t = int_of_float (2.**(float_of_int n)) -1 in

clear_graph();
set_color black;
fill_rect 165 200 10 200;
fill_rect 395 200 10 200;
fill_rect 625 200 10 200;
moveto 60 200 ; lineto 280 200;
moveto 290 200 ; lineto 510 200;
moveto 520 200 ; lineto 740 200;
moveto 166 170 ; draw_string "1";
moveto 396 170 ; draw_string "2";
moveto 626 170 ; draw_string "3";

for i = 9-n to 8 do
        set_color p.(i);
        fill_rect (70+10*i) (200+20*(i+n-9)) (200-20*i) 20;
done;
set_color black;

moveto 100 150 ; lineto 356 150 ; lineto 356 161 ; lineto 100 161 ; lineto 100 150;
moveto 370 147 ; draw_string "0 %";
moveto 550 147 ; draw_string ("0 / "^(string_of_int t));

let wait () = for i = 1 to !f do () done in

let a = function
        | 1 -> !a1
        | 2 -> !a2
        | _ -> !a3
in

let soulevement n =
        let im = get_image (70+230*(n-1)) (181+20*(a n)) 200 1 in
        for y = 181+20*(a n) to 400 do
                set_color white;
                moveto (70+230*(n-1)) y ; lineto (270+230*(n-1)) y;
                set_color black;
                moveto (165+230*(n-1)) y ; lineto (175+230*(n-1)) y;
                draw_image im (70+230*(n-1)) (y+20);
                wait();
        done;
        for y = 401 to 420 do
                set_color white;
                moveto (70+230*(n-1)) y ; lineto (270+230*(n-1)) y;
                draw_image im (70+230*(n-1)) (y+20);
                wait();
        done;
        set_color black;
        match n with
                | 1 -> decr a1
                | 2 -> decr a2
                | _ -> decr a3
in

let abaissement n inc =
        let im = get_image (70+230*(n-1)) 421 200 1 in
        for y = 420 downto 381 do
                set_color white;
                moveto (70+230*(n-1)) (y+20) ; lineto (270+230*(n-1)) (y+20);
                draw_image im (70+230*(n-1)) y;
                wait();
        done;
        for y = 380 downto 201+20*(a n) do
                set_color white;
                moveto (70+230*(n-1)) (y+20) ; lineto (270+230*(n-1)) (y+20);
                set_color black;
                moveto (165+230*(n-1)) (y+20) ; lineto (175+230*(n-1)) (y+20);
                draw_image im (70+230*(n-1)) y;
                wait();
        done;

        o:= !o + inc;
        if inc = -1 then (
                set_color white;
                fill_rect (101 + !o*255/t) 150 (255/t + 1) 10;
        )
        else (
                set_color blue;
                fill_rect 101 150 (!o*255/t) 10;
        );
        set_color white;
        fill_rect 370 147 250 18;
        set_color black;
        moveto 370 147 ; draw_string ((string_of_int (!o*100/t))^" % ");
        moveto 550 147 ; draw_string ((string_of_int !o)^" / "^string_of_int t^" ");

        match n with
                | 1 -> incr a1
                | 2 -> incr a2
                | _ -> incr a3
in

let deplacement n m =
        let im = get_image (69+230*(n-1)) 421 202 20 in
        if m > n then ( for x = 1 to 230*(m-n) do draw_image im (69+230*(n-1)+x) 421 ; wait() done );
        if m < n then ( for x = 1 to 230*(n-m) do draw_image im (69+230*(n-1)-x) 421 ; wait() done );
in

let rec hanoi n a b c =
        if n = 0 then []
        else ( (hanoi (n-1) a c b) @ [a,c] @ (hanoi (n-1) b a c) );
in

let c = ref 0 and d = ref 0
and b1 = ref [] and b2 = ref [] and b3 = ref []
and ss = ref [] and sol = hanoi n 1 2 3 in

for i = 1 to n do b1:= (n+1-i) :: !b1 done;

let ana_inc c d = match c,d with
        | c,d when c = d -> 0
        | c,d when !ss = [] -> ( ss:= [c,d] ; 1 )
        | c,d -> ( match hd !ss with
                        | a,b when (c,d) = (b,a) -> ( ss:= tl !ss ; -1 )
                        | a,b when b = c -> ( ss:= (a,d) :: (tl !ss) ; 0 )
                        | _ -> ( ss:= (c,d) :: !ss ; 1 )
                )
in

let coup_suivant () =
        let e = ref 0 and f = ref 0  and g = ref 0
        and s1 = ref sol and s2 = ref (rev !ss) in
        while ((!s2 <> []) && (hd !s1) = (hd !s2)) do ( s1:= tl !s1 ; s2:= tl !s2 ) done;
        if !s2 = [] then ( let a,b = hd !s1 in e:= a ; f:= b )
        else (
                if length !s2 = 1 then (
                        let a,b = hd !s2 and c,d = hd !s1 in
                        if a = c then ( e:= b ; f:= d )
                        else ( e:= b ; f:= a );
                )
                else ( let a,b = hd (rev !s2) in e:= b ; f:= a );
        );
        soulevement !e;
        (match !e with
                | 1 -> g:= hd !b1 ; b1:= tl !b1
                | 2 -> g:= hd !b2 ; b2:= tl !b2
                | _ -> g:= hd !b3 ; b3:= tl !b3
        );
        deplacement !e !f;
        let i = ana_inc !e !f in
        abaissement !f i;
        (match !f with
                | 1 -> b1:= !g :: !b1
                | 2 -> b2:= !g :: !b2
                | _ -> b3:= !g :: !b3
        );
        if !o = t then ( for i = 1 to ff do () done ; raise Exit);
in

try while !o < t do
        c:= 0;
        while !c = 0 do
                let e = wait_next_event [Key_pressed] in
                if ((e.key='1' || e.key='&') && !b1 <> []) then (
                        c:= 1;
                        d:= hd !b1;
                        b1:= tl !b1;
                        soulevement 1;
                );
                if ((e.key='2' || e.key='é') && !b2 <> []) then (
                        c:= 2;
                        d:= hd !b2;
                        b2:= tl !b2;
                        soulevement 2;
                );
                if ((e.key='3' || e.key='"') && !b3 <> []) then (
                        c:= 3;
                        d:= hd !b3;
                        b3:= tl !b3;
                        soulevement 3;
                );
                if e.key='q' then raise Exit;
                if e.key='+' || e.key='=' then f:= !f/5*4;
                if e.key='-' || e.key='6' then f:= !f/4*5+1;
                if e.key='\013' then coup_suivant();
        done;
        let b = ref true in
        while !b do
                let e = wait_next_event [Key_pressed] in
                if ((e.key='1' || e.key='&') && (!b1 = [] || !d < hd !b1)) then (
                        b1:= !d :: !b1;
                        deplacement !c 1;
                        let i = ana_inc !c 1 in
                        abaissement 1 i;
                        b:= false;
                );
                if ((e.key='2' || e.key='é') && (!b2 = [] || !d < hd !b2)) then (
                        b2:= !d :: !b2;
                        deplacement !c 2;
                        let i = ana_inc !c 2 in
                        abaissement 2 i;
                        b:= false;
                );
                if ((e.key='3' || e.key='"') && (!b3 = [] || !d < hd !b3)) then (
                        b3:= !d :: !b3;
                        deplacement !c 3;
                        let i = ana_inc !c 3 in
                        abaissement 3 i;
                        b:= false;
                );
                if e.key='q' then raise Exit;
                if e.key='+' || e.key='=' then f:= !f*4/5;
                if e.key='-' || e.key='6' then f:= !f*5/4+1;
        done;
done;
if length !b3 = n then (set_color blue ; moveto 336 450 ; draw_string "Félicitations !!");
for i = 1 to ff do () done;
close_graph();
with Exit -> close_graph();
;;


let save_speed () =
        set_color blue;
        moveto 200 300;
        draw_string "save";
        moveto 196 284;
        draw_string "speed";
        let im = get_image 196 284 40 34 in
        let im = transp_bg im in
        clear_graph();
        set_color (rgb 200 200 200);
        fill_rect 380 292 80 44;
        draw_image im 400 300;
        set_color blue;
        moveto 400 299 ; lineto 408 299;
        moveto 402 315 ; lineto 410 315;
        let im = get_image 380 292 80 44 in
        clear_graph();
        { pos = 100,296 ; taille = 80,44 ; image = im ; rac = 's' ; res = "save" };
;;


let main1 () =
        open_graph "";
        let nb = ref "?" and interactif = ref "oui"
        and ok = button_of_buttxt { apos = 350,300 ; texte = "ok" ; raccl = 1 } green
        and quitter = button_of_buttxt { apos = 450,300 ; texte = "quitter" ; raccl = 1 } red
        and save = save_speed() in

        let action = function
                | "quitter" -> raise Exit
                | "ok" -> (if !nb <> "?" then
                                if !interactif = "oui" then jeu (int_of_string !nb)
                                                       else hanoi (int_of_string !nb);
                                open_graph "";)
                | "save" -> (let c = open_out "hanoi_speed.txt" in
                             output_string c (string_of_int !f);
                             close_out c;)
                | _ -> ()
        in
        wait_event [|240,450,20,"nb de disques :",nb,[|"1";"2";"3";"4";"5";"6";"7";"8";"9"|] ;
                     216,400,40,"interactif ?",interactif,[|"oui";"non"|] |]
                   [|ok ; quitter ; save|] 0 action;
;;

let main argv =
        print_string "hanoi [[-i] <n>]";
        flush stdout;
        try
                let v = argv in
                try
                        if v.(1) = "-i" then jeu (int_of_string v.(2)) else hanoi (int_of_string v.(1));
                        exit 0;
                with _ -> main1()
        with Exit -> exit 0
;;

if not !interactive then main argv ;;