(* Acquisition et sauvegarde d'images *)

#open "sys";;
#open "graphics";;

let ext = ".exe" ;;   (* pour windows *)
(* let ext = "" ;;     pour linux *)

(* Conversion d'image vers pnm, les 3 premiers formats sont réservés aux toutes petites images *)

let torgb c = c/256/256, c/256 mod 256, c mod 256 ;;

(* image noir et blanc sauvegardée en pbm P1 *)

let imgtopbm1_cv t s =
        try
                let file = open_out_bin (s^".pnm") in
                try
                        let w = vect_length t.(0) and h = vect_length t in
                        output_string file "P1\n";
                        output_string file ((string_of_int w) ^ " " ^ (string_of_int h) ^ "\n");
                        for i = 0 to h - 1 do
                                for j = 0 to w - 1 do
                                        match t.(i).(j) with
                                                | c when c = black -> output_string file "1 "
                                                | c when c = white -> output_string file "0 "
                                                | _ -> failwith "image pas en noir et blanc"
                                done;
                                output_string file "\n";
                        done;
                        close_out file;
                with Failure f -> close_out file ; remove (s^".pnm") ; print_endline f
        with Sys_error f -> print_endline f
;;

let imgtopbm1_im im = imgtopbm1_cv (dump_image im) ;;
let imgtopbm1 x y w h = imgtopbm1_im (get_image x y w h) ;;

(* image noir et blanc sauvegardée en pgm P2 *)

let imgtopgm1_cv t s =
        try
                let file = open_out_bin (s^".pnm") in
                try
                        let w = vect_length t.(0) and h = vect_length t in
                        output_string file "P2\n";
                        output_string file ((string_of_int w) ^ " " ^ (string_of_int h) ^ "\n1\n");
                        for i = 0 to h - 1 do
                                for j = 0 to w - 1 do
                                        match t.(i).(j) with
                                                | c when c = black -> output_string file "0 "
                                                | c when c = white -> output_string file "1 "
                                                | _ -> failwith "image pas en noir et blanc"
                                done;
                                output_string file "\n";
                        done;
                        close_out file;
                with Failure f -> close_out file ; remove (s^".pnm") ; print_endline f
        with Sys_error f -> print_endline f
;;

let imgtopgm1_im im = imgtopgm1_cv (dump_image im) ;;
let imgtopgm1 x y w h = imgtopgm1_im (get_image x y w h) ;;

(* image en couleur sauvegardée en ppm P3 *)

let imgtoppm1_cv t s =
        try
                let file = open_out_bin (s^".pnm") in
                let w = vect_length t.(0) and h = vect_length t in
                output_string file "P3\n";
                output_string file ((string_of_int w) ^ " " ^ (string_of_int h) ^ "\n255\n");
                let output_str_align rgb =
                        let rgb = string_of_int rgb in
                        output_string file ((make_string (3-(string_length rgb)) ` `) ^ rgb ^ " ");
                in
                for i = 0 to h - 1 do
                        for j = 0 to w - 1 do
                                let r,g,b = torgb t.(i).(j) in
                                output_str_align r;
                                output_str_align g;
                                output_str_align b;
                                output_string file "  ";
                        done;
                        output_string file "\n";
                done;
                close_out file;
        with Sys_error f -> print_endline f
;;

let imgtoppm1_im im = imgtoppm1_cv (dump_image im) ;;
let imgtoppm1 x y w h = imgtoppm1_im (get_image x y w h) ;;

(* image en noir et blanc sauvegardée en pbm P4 *)

let imgtopbm2_cv t s =
        try
                let file = open_out_bin (s^".pnm") in
                try
                        let w = vect_length t.(0) and h = vect_length t in
                        output_string file "P4\n";
                        output_string file ((string_of_int w) ^ " " ^ (string_of_int h) ^ "\n");
                        for i = 0 to h - 1 do
                                for j = 0 to w/8 do
                                        let y = ref 0 in
                                        for k = 0 to 7 do
                                                y:= !y * 2;
                                                if (j < w/8) || (k < w mod 8) then (
                                                        if t.(i).(j*8+k) = black then incr y
                                                        else if t.(i).(j*8+k) <> white then
                                                                failwith "image pas en noir et blanc";
                                                );
                                        done;
                                        if (j < w/8) || (w mod 8 > 0) then output_byte file !y;
                                done;
                        done;
                        close_out file;
                with Failure f -> close_out file ; remove (s^".pnm") ; print_endline f
        with Sys_error f -> print_endline f
;;

let imgtopbm2_im im = imgtopbm2_cv (dump_image im) ;;
let imgtopbm2 x y w h = imgtopbm2_im (get_image x y w h) ;;

(* image en dégradé de gris sauvegardée en pgm P5 *)

let imgtopgm2_cv t s =
        try
                let file = open_out_bin (s^".pnm") in
                let w = vect_length t.(0) and h = vect_length t in
                output_string file "P5\n";
                output_string file ((string_of_int w) ^ " " ^ (string_of_int h) ^ "\n255\n");
                for i = 0 to h - 1 do
                        for j = 0 to w - 1 do
                                let r,g,b = torgb t.(i).(j) in
                                let r = float_of_int r and g = float_of_int g and b = float_of_int b in
                                let y = 0.299*.r +. 0.587*.g +. 0.114*.b in
                                let y = int_of_float (y+.0.5) in
                                output_byte file y;
                        done;
                done;
                close_out file;
        with Sys_error f -> print_endline f
;;

let imgtopgm2_im im = imgtopgm2_cv (dump_image im) ;;
let imgtopgm2 x y w h = imgtopgm2_im (get_image x y w h) ;;

(* image en couleur sauvegardée en ppm P6 *)

let imgtoppm2_cv t s =
        try
                let file = open_out_bin (s^".pnm") in
                let w = vect_length t.(0) and h = vect_length t in
                output_string file "P6\n";
                output_string file ((string_of_int w) ^ " " ^ (string_of_int h) ^ "\n255\n");
                for i = 0 to h - 1 do
                        for j = 0 to w - 1 do
                                let r,g,b = torgb t.(i).(j) in
                                output_byte file r;
                                output_byte file g;
                                output_byte file b;
                        done;
                done;
                close_out file;
        with Sys_error f -> print_endline f
;;

let imgtoppm2_im im = imgtoppm2_cv (dump_image im) ;;
let imgtoppm2 x y w h = imgtoppm2_im (get_image x y w h) ;;

let typeimg_cv t =
        try
                let typ = ref 0 in
                let w = vect_length t.(0) and h = vect_length t in
                for i = 0 to h - 1 do
                        for j = 0 to w - 1 do
                                match torgb t.(i).(j) with
                                        | 0,0,0 -> ()
                                        | 255,255,255 -> ()
                                        | r,g,b when r = g & g = b -> typ:= 1
                                        | _ -> raise Exit
                        done;
                done;
                !typ;
        with Exit -> 2
;;

let typeimg_im im = typeimg_cv (dump_image im) ;;
let typeimg x y w h = typeimg_im (get_image x y w h) ;;

let imgtopnm_cv t =
        match typeimg_cv t with
                | 0 -> imgtopbm2_cv t
                | 1 -> imgtopgm2_cv t
                | _ -> imgtoppm2_cv t
;;

let imgtopnm_im im = imgtopnm_cv (dump_image im) ;;
let imgtopnm x y w h = imgtopnm_im (get_image x y w h) ;;


(* Fonctions générales de sauvegarde, netb pour noir et blanc, en dégradé de gris en fait *)

let save_cv = imgtopnm_cv ;;
let save_im = imgtopnm_im ;;
let save = imgtopnm ;;

let save_netb_cv = imgtopgm2_cv ;;
let save_netb_im = imgtopgm2_im ;;
let save_netb = imgtopgm2 ;;


let save_png_cv t s =
        imgtopnm_cv t s;
        if system_command ("pnmtopng"^ext^" "^s^".pnm > "^s^".png") > 0 then print_endline "pb de conversion";
        remove (s^".pnm");
;;

let save_png_im im = save_png_cv (dump_image im) ;;
let save_png x y w h = save_png_im (get_image x y w h) ;;

let save_png_netb_cv t s =
        imgtopgm2_cv t s;
        if system_command ("pnmtopng"^ext^" "^s^".pnm > "^s^".png") > 0 then print_endline "pb de conversion";
        remove (s^".pnm");
;;

let save_png_netb_im im = save_png_netb_cv (dump_image im) ;;
let save_png_netb x y w h = save_png_netb_im (get_image x y w h) ;;


let save_jpg_cv t s =
        imgtopnm_cv t s;
        if system_command ("pnmtojpeg"^ext^" "^s^".pnm > "^s^".jpg") > 0 then print_endline "pb de conversion";
        remove (s^".pnm");
;;


let save_jpg_im im = save_jpg_cv (dump_image im) ;;
let save_jpg x y w h = save_jpg_im (get_image x y w h) ;;

let save_jpg_netb_cv t s =
        imgtopgm2_cv t s;
        if system_command ("pnmtojpeg"^ext^" "^s^".pnm > "^s^".jpg") > 0 then print_endline "pb de conversion";
        remove (s^".pnm");
;;

let save_jpg_netb_im im = save_jpg_netb_cv (dump_image im) ;;
let save_jpg_netb x y w h = save_jpg_netb_im (get_image x y w h) ;;



(* Acquisition d'images pnm *)

let pnmtoimg0_cv background s =
        let file = open_in_bin (s^".pnm") in
        let typeimg = input_line file in
        let wh = input_line file and e = ref 0 in
        let n = string_length wh in
        for i = 0 to n - 1 do if wh.[i] = ` ` then e:= i done;
        let w = int_of_string (sub_string wh 0 !e) and h = int_of_string (sub_string wh (!e+1) (n-1- !e)) in
        let t = make_matrix h w background in
        if typeimg = "P1" then (
                for i = 0 to h - 1 do
                        let y = input_line file and k = ref 0 in
                        for j = 0 to w - 1 do
                                while y.[!k] = ` ` do incr k done;
                                if y.[!k] = `1` then t.(i).(j) <- black
                                else if y.[!k] <> `0` then failwith "image P1 erronée";
                                incr k;
                        done;
                done;
        );
        if typeimg = "P2" then (
                let nbcol = int_of_string (input_line file) in
                for i = 0 to h - 1 do
                        let y = input_line file and k = ref 0 in
                        for j = 0 to w - 1 do
                                while y.[!k] = ` ` do incr k done;
                                let kk = !k in
                                while !k < string_length y && y.[!k] <> ` ` do incr k done;
                                let yy = int_of_string (sub_string y kk (!k-kk)) in
                                let yy = let yy = 256*yy/nbcol in if yy <> 256 then yy else 255 in
                                t.(i).(j) <- rgb yy yy yy;
                        done;
                done;
        );
        if typeimg = "P3" then (
                let nbcol = int_of_string (input_line file) in
                for i = 0 to h - 1 do
                        let y = input_line file and k = ref 0 in
                        for j = 0 to w - 1 do
                                while y.[!k] = ` ` do incr k done;
                                let kk = !k in
                                while y.[!k] <> ` ` do incr k done;
                                let r = int_of_string (sub_string y kk (!k-kk)) in
                                while y.[!k] = ` ` do incr k done;
                                let kk = !k in
                                while y.[!k] <> ` ` do incr k done;
                                let g = int_of_string (sub_string y kk (!k-kk)) in
                                while y.[!k] = ` ` do incr k done;
                                let kk = !k in
                                while !k < string_length y && y.[!k] <> ` ` do incr k done;
                                let b = int_of_string (sub_string y kk (!k-kk)) in
                                let r = let r = 256*r/nbcol in if r <> 256 then r else 255 in
                                let g = let g = 256*g/nbcol in if g <> 256 then g else 255 in
                                let b = let b = 256*b/nbcol in if b <> 256 then b else 255 in
                                t.(i).(j) <- rgb r g b;
                        done;
                done;
        );
        if typeimg = "P4" then (
                for i = 0 to h - 1 do
                        for j = 0 to w/8 do
                                let y = ref (if (j = w/8) && (w mod 8 = 0) then 0 else input_byte file) in
                                for k = 7 downto 0 do
                                        if (j < w/8) || (k < w mod 8) then (
                                                if !y mod 2 = 1 then t.(i).(j*8+k) <- black;
                                                y:= !y / 2;
                                        );
                                done;
                        done;
                done;
        );
        if typeimg = "P5" then (
                let nbcol = int_of_string (input_line file) in
                if nbcol < 256 then (
                        for i = 0 to h - 1 do
                                for j = 0 to w - 1 do
                                        let y = input_byte file in
                                        let y = let y = 256*y/nbcol in if y <> 256 then y else 255 in
                                        t.(i).(j) <- rgb y y y;
                                done;
                        done;
                )
                else (
                        for i = 0 to h - 1 do
                                for j = 0 to w - 1 do
                                        let y = (input_byte file) * 256 + (input_byte file) in
                                        let y = let y = 256*y/nbcol in if y <> 256 then y else 255 in
                                        t.(i).(j) <- rgb y y y;
                                done;
                        done;
                );
        );
        if typeimg = "P6" then (
                let nbcol = int_of_string (input_line file) in
                if nbcol < 256 then (
                        for i = 0 to h - 1 do
                                for j = 0 to w - 1 do
                                        let r = input_byte file
                                        and g = input_byte file
                                        and b = input_byte file in
                                        let r = let r = 256*r/nbcol in if r <> 256 then r else 255
                                        and g = let g = 256*g/nbcol in if g <> 256 then g else 255
                                        and b = let b = 256*b/nbcol in if b <> 256 then b else 255 in
                                        t.(i).(j) <- rgb r g b;
                                done;
                        done;
                )
                else (
                        for i = 0 to h - 1 do
                                for j = 0 to w - 1 do
                                        let r = (input_byte file) * 256 + (input_byte file)
                                        and g = (input_byte file) * 256 + (input_byte file)
                                        and b = (input_byte file) * 256 + (input_byte file) in
                                        let r = let r = 256*r/nbcol in if r <> 256 then r else 255
                                        and g = let g = 256*g/nbcol in if g <> 256 then g else 255
                                        and b = let b = 256*b/nbcol in if b <> 256 then b else 255 in
                                        t.(i).(j) <- rgb r g b;
                                done;
                        done;
                );
        );
        close_in file;
        t;
;;

let pnmtoimg0 background s = make_image (pnmtoimg0_cv background s) ;;
let pnmtoimg_cv = pnmtoimg0_cv white ;;
let pnmtoimg = pnmtoimg0 white ;;
let pnmtoimg1_cv = pnmtoimg0_cv transp ;;
let pnmtoimg1 = pnmtoimg0 transp ;;


(* Fonctions générales d'acquisition *)

let load_pnm0_cv = pnmtoimg0_cv ;;
let load_pnm0 = pnmtoimg0 ;;
let load_pnm_cv = pnmtoimg_cv ;;
let load_pnm = pnmtoimg ;;
let load_pnm1_cv = pnmtoimg1_cv ;;
let load_pnm1 = pnmtoimg1 ;;

let load_png0_cv b s =
        let c = open_in (s^".png") in
        close_in c;
        if system_command ("pngtopnm"^ext^" "^s^".png > "^s^".pnm") > 0 then failwith "pb de conversion";
        let t = pnmtoimg0_cv b s in
        remove (s^".pnm");
        t;
;;

let load_png0 b s = make_image (load_png0_cv b s) ;;
let load_png_cv = load_png0_cv white ;;
let load_png = load_png0 white ;;
let load_png1_cv = load_png0_cv transp ;;
let load_png1 = load_png0 transp ;;

let load_jpg0_cv b s =
        let c = open_in (s^".jpg") in
        close_in c;
        if system_command ("jpegtopnm"^ext^" "^s^".jpg > "^s^".pnm") > 0 then failwith "pb de conversion";
        let t = pnmtoimg0_cv b s in
        remove (s^".pnm");
        t;
;;

let load_jpg0 b s = make_image (load_jpg0_cv b s) ;;
let load_jpg_cv = load_jpg0_cv white ;;
let load_jpg = load_jpg0 white ;;
let load_jpg1_cv = load_jpg0_cv transp ;;
let load_jpg1 = load_jpg0 transp ;;

let load_bmp0_cv b s =
        let c = open_in (s^".bmp") in
        close_in c;
        if system_command ("bmptopnm"^ext^" "^s^".bmp > "^s^".pnm") > 0 then failwith "pb de conversion";
        let t = pnmtoimg0_cv b s in
        remove (s^".pnm");
        t;
;;

let load_bmp0 b s = make_image (load_bmp0_cv b s) ;;
let load_bmp_cv = load_bmp0_cv white ;;
let load_bmp = load_bmp0 white ;;
let load_bmp1_cv = load_bmp0_cv transp ;;
let load_bmp1 = load_bmp0 transp ;;

let load_gif0_cv b s =
        let c = open_in (s^".gif") in
        close_in c;
        if system_command ("giftopnm"^ext^" "^s^".gif > "^s^".pnm") > 0 then failwith "pb de conversion";
        let t = pnmtoimg0_cv b s in
        remove (s^".pnm");
        t;
;;

let load_gif0 b s = make_image (load_gif0_cv b s) ;;
let load_gif_cv = load_gif0_cv white ;;
let load_gif = load_gif0 white ;;
let load_gif1_cv = load_gif0_cv transp ;;
let load_gif1 = load_gif0 transp ;;

let load0_cv b s =
        let n = string_length s in
        let basename = sub_string s 0 (n-4) in
        match sub_string s (n-3) 3 with
                | "pnm" -> load_pnm0_cv b basename
                | "png" -> load_png0_cv b basename
                | "jpg" -> load_jpg0_cv b basename
                | "bmp" -> load_bmp0_cv b basename
                | "gif" -> load_gif0_cv b basename
                | _ -> failwith "format pas pris en charge"
;;

let load0 b s = make_image (load0_cv b s) ;;
let load_cv = load0_cv white ;;
let load = load0 white ;;
let load1_cv = load0_cv transp ;;
let load1 = load0 transp ;;