(* #load "graphics.cma";; *)
(* #use "o_sudoku3.ml";; *)
open List;;
open Graphics;;
open Sys;;
(* *) open O_sudoku;;  (* *)
(* *) open O_sudoku2;; (* *)
(* *) open O_sudoku3;; (* *)


(* Interface graphique part. 2 *)


let sudoku () =

let speed =
        chdir dir;
        try
                let f = open_in "sudoku_speed.txt" in
                let speed = int_of_string (input_line f) in
                close_in f;
                speed;
        with _ -> 8770000
in

open_graph "  1024x768";

try
while true do

reset [];
let mm = copy_trinityx m
and caseposs = ref true in


let acquisition clear boutons action_grille_av action_grille_ap =
        if clear then clear_boutons();
        let key = ref '@' in

        let acquisition_grille i j key =

                let rec maj_nc i j = function
                        | [] -> []
                        | (a::q) -> let x,y,_ = a in
                                    if (x = i && y = j) then q else a :: (maj_nc i j q)
                in

                let rec isin i j = function
                        | [] -> false
                        | ((x,y,_)::q) -> if (x = i && y = j) then true else isin i j q
                in

                if key >= '0' && key <= '9' then (
                        action_grille_av();
                        let z = int_of_char key - 48 in
                        if !caseposs then (
                                nc:= maj_nc i j !nc;
                                if z <> 0 then nc:= (i,j,z) :: !nc
                                          else mm.(i).(j) <- Array.make 10 true;
                                draw_case i j z;
                        ) else (
                                if not (isin i j !nc) then (
                                        if z<> 0 then (
                                                if mm.(i).(j).(z) then mm.(i).(j).(z) <- false
                                                                  else mm.(i).(j).(z) <- true;
                                        ) else (
                                                mm.(i).(j) <- Array.make 10 true;
                                        );
                                        draw_poss i j z (not mm.(i).(j).(z)) false false;
                                );
                        );
                        action_grille_ap();
                );
        in

        let x0 = x+10*e and i0,labels,actions = boutons
        and x1,x2,x4,y1,y2,y4 = ref 0, ref 0, ref 0, ref 0, ref 0, ref 0 in

        let y0 = y-17*h*i0 in

        while true do
                set_color black;
                draw_boutons i0 labels;
                let s = wait_next_event [Key_pressed ; Button_down] in
                if s.keypressed then (
                        key:= s.key;
                        let i = (y+e/2-s.mouse_y)/e+1 and j = (s.mouse_x-x+e/2)/e+1 in
                        if (i > 0 && i < 10 && j > 0 && j < 10) then (
                                acquisition_grille i j !key;
                        );
                ) else (
                        x1:= s.mouse_x ; y1:= s.mouse_y;
                        let s = wait_next_event [Button_up] in
                        x4:= !x2 ; y4:= !y2;
                        x2:= s.mouse_x ; y2:= s.mouse_y;
                        if !x1 >= x0 && !x1 <= (x0+100) && !x2 >= x0 && !x2 <= (x0+100) &&
                                !y1 <= y0 && (y0 - !y1) mod (17*h) <= (10*h) &&
                                !y2 <= y0 && (y0 - !y2) mod (17*h) <= (10*h) &&
                                        (y0 - !y1)/(17*h) = (y0 - !y2)/(17*h) then (
                                                let i = (y0 - !y1)/(17*h) in
                                                try
                                                        (actions.(i))();
                                                with Invalid_argument "index out of bounds" -> ()
                        ) else (
                                let i1 = (y + e/2 - !y1)/e+1 and j1 = (!x1 - x + e/2)/e+1
                                and i2 = (y + e/2 - !y2)/e+1 and j2 = (!x2 - x + e/2)/e+1
                                and i4 = (y + e/2 - !y4)/e+1 and j4 = (!x4 - x + e/2)/e+1 in
                                if i1 > 0 && i1 < 10 && j1 > 0 && j1 < 10 &&
                                        i1 = i2 && j1 = j2 && i2 = i4 && j2 = j4 then (
                                                acquisition_grille i1 j1 !key;
                                );
                        );
                );
        done;
in


let deb = ref [] and resoudre_de_force = ref false
and niveau_indice = ref 0 and donner_indice = ref false and nbbarres = ref 0
and boutons = [|"résoudre"; "vérifier"; "indice"; "opt:          "; "case"; "calcul poss.";
                ""; "sauver"; "reset"; "new"; "quit"|] in


let generer () =
        set_color green;
        draw_bouton y 0 "générer";
        generation();
        set_color black;
        draw_cases !nc;
        failwith "ok";
in

let init_random () =
        clear_boutons();
        set_color blue;
        draw_str 1 "tapez un nombre";
        set_color black;
        Random.init (get_champ_int 1);
        clear_boutons();
        generer();
in

let charger () =
        clear_boutons();
        set_color blue;
        draw_str 3 "nom du fichier ?";
        set_color black;
        try
                let s = get_champ 3 in
                load s;
                deb:= !nc;
                draw_cases !nc;
                try
                        let nc2, m3 = load1 s in
                        nc:= !nc @ nc2;
                        copy_trinityx2 mm m3;
                        set_color green;
                        draw_cases nc2;
                        for i = 1 to 9 do
                        for j = 1 to 9 do
                        for z = 1 to 9 do
                                if not mm.(i).(j).(z) then draw_poss i j z true false false;
                        done;
                        done;
                        done;
                        failwith "ook";
                with Sys_error _ -> failwith "ook"
        with Sys_error _ -> clear_boutons()
in

let void () = () in

let grille () = failwith "grille" in

let valider () = failwith "ok" in

let effacer () =
        clear_graph();
        draw_grille black gris;
        nc:= [];
in

let color () = match !niveau_indice with
                | 1 -> if !donner_indice then niveau_indice:= 2 ; cyan
                | 2 -> blue
                | 3 -> bleuvert
                | 4 -> orange
                | _ -> green
in

let grille2 () =
        set_color (if !caseposs then color() else green);
        resoudre_de_force:= false;
        donner_indice:= false;
in

let grille3 () =
        if length !nc = 81 then
        draw_grille (match !opt with 0 -> darkgrey | 1 -> blue | 2 -> green | 3 -> yellow | 4 -> orange | _ -> red) transp;
in

let verifier () =
        let confirmer color =
                set_color color;
                draw_bouton y 1 "vérifier";
                for t = 1 to speed do () done;
        in
        let mm = copy_trinityx m and cc = copy_trinityx c and nncc = !nc in
        let retour () = copy_trinityx2 m mm ; copy_trinityx2 c cc ; nc:= nncc in
        try
                if solution_unique() then confirmer green
                                     else confirmer orange;
                retour();
        with _ -> confirmer red ; retour()
in

let indice () =
        let confirmer color =
                set_color color;
                draw_bouton y 2 "indice";
                for t = 1 to speed do () done;
        in
        let donne_indice nncc color =
                let i,j,z = hd !nncc in
                nc:= (i,j,z) :: !nc;
                set_color color;
                for r = 1 to 2 do
                        draw_case i j z;
                        for t = 1 to speed/4 do () done;
                        draw_case i j 0;
                        for t = 1 to speed/4 do () done;
                        draw_case i j z;
                done;
        in
        let m3 = copy_trinityx m and cc = copy_trinityx c and nc2 = ref !nc in
        try
                elimine m3 cc nc2;
                if !nc2 <> [] then (
                        let color = color() in
                        if !donner_indice then (
                                donne_indice nc2 color;
                                donner_indice:= false;
                        ) else (
                                confirmer color;
                                donner_indice:= true;
                        );
                ) else (
                        copy_trinityx2 m m3 ; copy_trinityx2 c cc;
                        let s = let s = strategie1() in if s <> [] then s else strategie2() in
                        if s <> [] then (
                                if !donner_indice then (
                                        let barre, preuve = hd s in
                                        let color = function
                                                | 0 -> red
                                                | 1 -> yellow
                                                | 2 -> cyan
                                                | 3 -> magenta
                                                | 4 -> bleuvert
                                                | 5 -> orange
                                                | 6 -> green
                                                | _ -> darkgrey
                                        in
                                        let rec barrer = function
                                                | [] -> ()
                                                | ((i,j,z)::q) -> m.(i).(j).(z) <- false;
                                                                  mm.(i).(j).(z) <- true;
                                                                  draw_poss i j z false true false;
                                                                  barrer q
                                        in
                                        let rec entourer = function
                                                | [] -> ()
                                                | ((i,j,z)::q) -> draw_poss i j z true false true ; entourer q
                                        in
                                        set_color (color (!nbbarres mod 8));
                                        incr nbbarres;
                                        barrer barre;
                                        entourer preuve;
                                        niveau_indice:= 1;
                                        donner_indice:= false;
                                ) else (
                                        confirmer darkgrey;
                                        donner_indice:= true;
                                );
                        ) else (
                                let sol = if !opt = 0 then snd (solution_largeur 1)
                                                      else snd (solution_largeur 2) in
                                copy_trinityx2 m m3;
                                copy_trinityx2 c cc;
                                let sol = tl sol in
                                if sol <> [] then (
                                        if !donner_indice then (
                                                donne_indice (ref (fst (hd sol))) yellow;
                                                niveau_indice:= 3;
                                                donner_indice:= false
                                        ) else (
                                                confirmer yellow;
                                                donner_indice:= true;
                                        );
                                ) else (
                                        if not m.(0).(0).(0) then (
                                                if !donner_indice then (
                                                        let b, sol = match !opt with
                                                                | 0 -> parcours_profondeur (poss3 1)
                                                                | 1 -> parcours_profondeur (poss3 2)
                                                                | _ -> parcours_prof()
                                                        in
                                                        nc2:= hd sol;
                                                        donne_indice nc2 (if solution_unique() then red else magenta);
                                                        niveau_indice:= 4;
                                                        donner_indice:= false;
                                                ) else (
                                                        confirmer magenta;
                                                        donner_indice:= true;
                                                );
                                        ) else (
                                                draw_grille (match !opt with 0 -> darkgrey | 1 -> blue | 2 -> green
                                                                           | 3 -> yellow | 4 -> orange | _ -> red) transp;
                                        );
                                );
                        );
                );
        with _ -> confirmer red
in

let optim () =
        let i,j = mouse_pos() and y = y-3*17*h in
        if j > y-8*h-2 && j < y-8*h+14 then (
                if i > x+10*e+85 && i < x+10*e+99 then (
                        incr opt;
                        opt:= min !opt 5;
                );
                if i > x+10*e+28 && i < x+10*e+42 then (
                        decr opt;
                        opt:= max !opt 0
                );
        );
in

let case_poss () =
        if !caseposs then (
                caseposs:= false;
                boutons.(4) <- "possibilité";
        ) else (
                caseposs:= true;
                boutons.(4) <- "case";
        );
in

let calcul_poss () =
        let confirmer color =
                set_color color;
                draw_bouton y 5 "calcul poss.";
                for t = 1 to speed do () done;
        in
        let maj1case m i j z =
                if not m.(i).(j).(z) then
                        failwith ("case "^(string_of_int i)^","^(string_of_int j)^" cas "^(string_of_int z)^" repoussé");
                if m.(i).(j).(0) then (
                        for k = 0 to z-1 do m.(i).(j).(k) <- false done;
                        for k = z+1 to 9 do m.(i).(j).(k) <- false done;
                        for x = 0 to i-1 do m.(x).(j).(z) <- false done;
                        for x = i+1 to 9 do m.(x).(j).(z) <- false done;
                        for y = 0 to j-1 do m.(i).(y).(z) <- false done;
                        for y = j+1 to 9 do m.(i).(y).(z) <- false done;
                        for xx = 1 to 3 do
                        for yy = 1 to 3 do
                                let ii = (i-1)/3*3+xx and jj = (j-1)/3*3+yy in
                                if (ii <> i || jj <> j) then m.(ii).(jj).(z) <- false;
                        done;
                        done;
                );
        in
        let rec maj m = function
                | [] -> ()
                | ((i,j,z)::q) -> maj1case m i j z ; maj m q
        in
        let m3 = copy_trinityx m in
        try
                maj m3 !nc;
                let b = ref false in
                set_color blue;
                for i = 1 to 9 do
                for j = 1 to 9 do
                        if m3.(i).(j).(0) then (
                                for z = 1 to 9 do
                                        if m3.(i).(j).(z) && mm.(i).(j).(z) then (
                                                mm.(i).(j).(z) <- false;
                                                draw_poss i j z true false false;
                                                b:= true;
                                        );
                                        if not m3.(i).(j).(z) && not mm.(i).(j).(z) then (
                                                mm.(i).(j).(z) <- true;
                                                draw_poss i j z false true false;
                                                b:= true;
                                        );
                                done;
                        );
                done;
                done;
                if !b then confirmer blue else confirmer green;
        with _ -> confirmer red
in

let sauver () =
        let confirmer color text i b =
                set_color color;
                draw_bouton y i text;
                if b then for t = 1 to speed do () done;
        in
        let photo s =
                (try
                        confirmer green "ok" 8 false;
(* *)                   O_img.save_png (x-e) (y-9*e) (10*e) (10*e) s;     (*  *)
(*                      save_png (x-e) (y-9*e) (10*e) (10*e) s;               *)
                with _ -> confirmer red "erreur" 8 true);
                failwith "grille";
        in
        clear_boutons();
        set_color blue;
        draw_str 7 "nom du fichier ?";
        set_color black;
        try
                let s = get_champ 7 in
                save0 m !deb s;
                if !nc <> !deb || haschanged mm then save1 !nc (filter (fun x -> not (mem x !deb)) !nc) mm s;
                confirmer green "sauvé" 7 true;
                try
                        clear_boutons();
                        set_color blue;
                        draw_str 7 "print ?";
                        acquisition false (7, [|"non" ; "oui"|], [|grille ; fun () -> photo s|]) grille2 grille;
                with Failure "grille" -> clear_boutons()
        with Sys_error _ -> confirmer red "erreur" 7 true
in

let reset () =
        clear_graph();
        draw_grille black gris;
        reset !deb;
        draw_cases !nc;
        init_mc mm;
        resoudre_de_force:= false;
        niveau_indice:= 0;
        donner_indice:= false;
        nbbarres:= 0;
        caseposs:= true;
        boutons.(4) <- "case";
in

let nouveau () = failwith "new" in

let quit () = failwith "quit" in

let nncc = ref [] and barrsjj = ref [] in

let resoudre () =
        let confirmer color b =
                set_color color;
                draw_bouton y 0 "résoudre";
                if b then for t = 1 to speed do () done;
        in
        try
                let u = if !resoudre_de_force then false
                        else (
                                confirmer green false;
                                let u = solution_unique() in
                                if !nc <> [] then (
                                        set_color (color());
                                        draw_cases [hd !nc];
                                        set_color (color());
                                        draw_cases (tl !nc);
                                        nncc:= !nc;
                                );
                                u;
                        ) in
                let bar () = if !opt > 3 then (
                        confirmer cyan false;
                        dedexl2();
                ) else [] in
                let sj () = if !opt = 3 || !opt = 5 then (
                        confirmer yellow false;
                        let sj = solution_largeur_opt() in
                        tl sj;
                ) else [] in
                let barsj = if not !resoudre_de_force then barrsjj:= (
                                    if !opt > 3 then (
                                            let barr = bar() and sjj = sj() in
                                            let barsj = ref [barr, sjj] in
                                            while snd (hd !barsj) <> [] do
                                                    let barr = bar() and sjj = sj() in
                                                    barsj:= (barr, sjj) :: !barsj;
                                            done;
                                            rev !barsj;
                                    ) else [[], sj()]
                            );
                            !barrsjj in
                let youpi () =
                        let barrsjj = ref barsj and n = ref 0 in
                        while !barrsjj <> [] do
                                let barr = fst (hd !barrsjj) in
                                set_color cyan;
                                iter draw_cases (map fst barr);
                                set_color blue;
                                iter draw_cases (map snd barr);
                                n:= if draw_coins6 (!n + length barr < 36) !n (length barsj > 2) barr
                                        = !n then !n else !n+1;
                                let sjj = ref (snd (hd !barrsjj)) in
                                while !sjj <> [] do
                                        let a, b, c = hd !sjj in
                                        set_color yellow;
                                        iter draw_cases a;
                                        draw_cases b;
                                        set_color bleuvert;
                                        draw_cases c;
                                        sjj:= tl !sjj;
                                done;
                                n:= if draw_coins4 !n (length barsj > 2) (snd (hd !barrsjj)) = !n then !n else !n+1;
                                barrsjj:= tl !barrsjj;
                        done;
                in
                if not !resoudre_de_force then youpi();
                if not m.(0).(0).(0) then (
                        if u || !resoudre_de_force then (
                                if not u then confirmer magenta false;
                                let m3 = copy_trinityx m and cc = copy_trinityx c in
                                let b, s = match !opt with
                                        | 0 -> parcours_profondeur (poss m)
                                        | 1 -> parcours_profondeur (poss3 2)
                                        | _ -> parcours_prof()
                                in
                                let h = hd s and l = length s in
                                set_color (if u then red else magenta);
                                let youpi2 h =
                                        nc:= h;
                                        draw_cases !nc;
                                        elimine m c nc;
                                        set_color orange;
                                        draw_cases !nc;
                                        if !opt > 0 && length h > 1 then (
                                                copy_trinityx2 m m3 ; copy_trinityx2 c cc;
                                                let ded = dedexl h in
                                                draw_coins2 0 ded;
                                        );
                                        draw_grille (match !opt with 0 -> darkgrey | 1 -> blue | 2 -> green
                                                                   | 3 -> yellow | 4 -> orange | _ -> red) transp;
                                in
                                youpi2 h;
                                if l > 1 then (
                                        clear_boutons();
                                        let n = ref 1 and s1 = ref s and s2 = ref [] in
                                        set_color (if b then red else magenta);
                                        draw_str 0 ((string_of_int !n)^" / "^(string_of_int l));
                                        let youpi3 h =
                                                clear_graph();
                                                draw_grille black gris;
                                                draw_cases !deb;
                                                set_color green;
                                                draw_cases !nncc;
                                                youpi();
                                                set_color magenta;
                                                copy_trinityx2 m m3 ; copy_trinityx2 c cc;
                                                youpi2 h;
                                                set_color (if b then red else magenta);
                                                draw_str 0 "                ";
                                                draw_str 0 ((string_of_int !n)^" / "^(string_of_int l));
                                        in
                                        let suivant () =
                                                if length !s1 > 1 then (
                                                        incr n;
                                                        let h = hd !s1 in
                                                        s1:= tl !s1;
                                                        s2:= h :: !s2;
                                                        youpi3 (hd !s1);
                                                );
                                        in
                                        let precedent () =
                                                if !s2 <> [] then (
                                                        decr n;
                                                        let h = hd !s2 in
                                                        s2:= tl !s2;
                                                        s1:= h :: !s1;
                                                        youpi3 h;
                                                );
                                        in
                                        let reset2 () = failwith "reset" in
                                        try
                                        acquisition false (0, [|"suivant"; "précédent"; ""; ""; ""; ""; ""; "sauver";
                                                                "reset"; "new"; "quit"|],
                                                              [|suivant; precedent; void; void; void; void; void; sauver;
                                                                reset2; nouveau; quit|])
                                                    grille2 grille;
                                        with Failure "grille" -> ()
                                );
                        ) else (
                                resoudre_de_force:= true;
                                confirmer orange true;
                        ); 
                );
                draw_grille (match !opt with 0 -> darkgrey | 1 -> blue | 2 -> green | 3 -> yellow
                                           | 4 -> orange | _ -> red) transp;
        with | Failure "reset" -> reset()
             | Failure "new" -> failwith "new"
             | Failure "quit" -> failwith "quit"
             | _ -> confirmer red true
in


clear_graph();
draw_grille black gris;

(try

(try
        try
                acquisition false (0, [|"générer"; "init random"; ""; "charger"|], [|generer; init_random; void; charger|])
                                   void grille;
        with Failure "grille" -> acquisition true (0, [|"valider"; "effacer"|], [|valider; effacer|]) void void
with | Failure "ok" -> deb:= !nc
     | Failure "ook" -> ());
     
acquisition true (0, boutons,
                  [|resoudre; verifier; indice; optim; case_poss; calcul_poss; void; sauver; reset; nouveau; quit|])
                  grille2 grille3;

with Failure "new" -> ()
);

done;

with Failure "quit" -> close_graph()
;;

if not !interactive then (
        print_string "sudoku [-v]";
        flush stdout;
        if Array.length argv > 1 && argv.(1) = "-v" then aff:= true;
        try
                sudoku();
                exit 0;
        with _ -> exit 1
);;