#open "windows";;
#open "camlwin";;

#open "sys";;

#open "readpbm";;




let ascii_0 = int_of_char `0`;;
let ascii_A = int_of_char `A`;;

let ascii_of_hexa x =
  if x < 10 
  then char_of_int (x+ascii_0)
  else char_of_int ((x-10)+ascii_A)
;;

let hex_of_int x =
  let result = create_string 8 in
    let rec encode_loop pos x =
      if pos = 1
      then ()
      else
      (
        set_nth_char result pos (ascii_of_hexa (x mod 16));
        encode_loop (pos-1) (x / 16)
      )
   in
    encode_loop 7 x;
    set_nth_char result 1 `x`;
    set_nth_char result 0 `0`;
    result
;;

let read_int Channel =
  let rec decode x start =
    let a = input_char Channel in
      if a = ` ` or a = `\n`
      then if start then decode x true else x
      else decode (10*x+(int_of_char a) -ascii_0) false
  in
    decode 0 true
;;


let convert_ascii_color in_file out_file width height in_name max_color =
   output_string out_file ("let " ^ in_name ^ " = \n[|\n");
    let x = ref 0
    and y = ref 0 
    and read = ref 0 in
      output_string out_file "  [|";
      while(!y<height) do
        let r = (read_int in_file) * 255 / max_color
        and g = (read_int in_file) * 255 / max_color
        and b = (read_int in_file) * 255 / max_color in
          let col = (r lsl 16) lor (g lsl 8) lor b in
            let out = hex_of_int col in
              if !x = width-1 
              then
              ( 
                   output_string out_file ( out ^ " |]"); 
                   if not !y = height-1 
                   then output_string out_file ";\n  [|"
                   else output_string out_file "\n"
              )
              else output_string out_file ( out ^ "; ");
             
              if !x<width-1 then x := !x+1 else (x := 0; y:= !y + 1)
    done;
    output_string out_file "|];;\n"
;;

let convert_ascii_grey  in_file out_file width height in_name max_color =
   output_string out_file ("let " ^ in_name ^ " = \n[|\n");
    let x = ref 0
    and y = ref 0 
    and read = ref 0 in
      output_string out_file "  [|";
      while(!y<height) do
        let read = (read_int in_file) * 255 / max_color in
          let col = (read lsl 16) lor (read lsl 8) lor read in
            let out = hex_of_int col in
              if !x = width-1 
              then
              ( 
                   output_string out_file ( out ^ " |]"); 
                   if not !y = height-1 
                   then output_string out_file ";\n  [|"
                   else output_string out_file "\n"
              )
              else output_string out_file ( out ^ "; ");
             
              if !x<width-1 then x := !x+1 else (x := 0; y:= !y + 1)
    done;
    output_string out_file "|];;\n"
;;

let convert_ascii_blackwhite  in_file out_file width height in_name =
   output_string out_file ("let " ^ in_name ^ " = \n[|\n");
    let x = ref 0
    and y = ref 0 
    and read = ref 0 in
      output_string out_file "  [|";
      while(!y<height) do
            let out = if read_int in_file = 0 then "white" else "black" in
              if !x = width-1 
              then
              ( 
                   output_string out_file ( out ^ " |]"); 
                   if not !y = height-1 
                   then output_string out_file ";\n  [|"
                   else output_string out_file "\n"
              )
              else output_string out_file ( out ^ "; ");
             
              if !x<width-1 then x := !x+1 else (x := 0; y:= !y + 1)
    done;
    output_string out_file "|];;\n"
;;

let convert_raw_color in_file out_file width height in_name max_color =
   output_string out_file ("let " ^ in_name ^ " = \n[|\n");
    let x = ref 0
    and y = ref 0 
    and read = ref 0 in
      output_string out_file "  [|";
      while(!y<height) do
        let r = (int_of_char (input_char in_file)) * 255 / max_color
        and g = (int_of_char (input_char in_file)) * 255 / max_color
        and b = (int_of_char (input_char in_file)) * 255 / max_color in
          let col = (r lsl 16) lor (g lsl 8) lor b in
            let out = hex_of_int col in
              if !x = width-1 
              then
              ( 
                   output_string out_file ( out ^ " |]"); 
                   if not !y = height-1 
                   then output_string out_file ";\n  [|"
                   else output_string out_file "\n"
              )
              else output_string out_file ( out ^ "; ");
             
              if !x<width-1 then x := !x+1 else (x := 0; y:= !y + 1)
    done;
    output_string out_file "|];;\n"
;;

let convert_raw_grey  in_file out_file width height in_name max_color =
   output_string out_file ("let " ^ in_name ^ " = \n[|\n");
    let x = ref 0
    and y = ref 0 
    and read = ref 0 in
      output_string out_file "  [|";
      while(!y<height) do
        let read = (int_of_char (input_char in_file)) * 255 / max_color in
          let col = (read lsl 16) lor (read lsl 8) lor read in
            let out = hex_of_int col in
              if !x = width-1 
              then
              ( 
                   output_string out_file ( out ^ " |]"); 
                   if not !y = height-1 
                   then output_string out_file ";\n  [|"
                   else output_string out_file "\n"
              )
              else output_string out_file ( out ^ "; ");
             
              if !x<width-1 then x := !x+1 else (x := 0; y:= !y + 1)
    done;
    output_string out_file "|];;\n"
;;

let convert_raw_blackwhite  in_file out_file width height in_name =
   output_string out_file ("let " ^ in_name ^ " = \n[|\n");
    let x = ref 0
    and y = ref 0 
    and read = ref 0 in
      output_string out_file "  [|";
      while(!y<height) do
         let read = int_of_char(input_char in_file) in
          for i = 0 to 7 do
            let mask = 0x80 lsr i in
              let out = if read land mask = 0 then "white" else "black" in
                if !x<=width-1 
                then if !x = width -1
                     then
                     ( 
                        output_string out_file ( out ^ " |]"); 
                        if not !y = height-1 
                        then output_string out_file ";\n  [|"
                        else output_string out_file "\n";
                        x := !x+1
                      )
                      else 
                     ( 
                        output_string out_file ( out ^ "; "); 
                        x := !x+1
                      )
          done;
          if !x>=width-1 then (x := 0; y:= !y + 1)
    done;
    output_string out_file "|];;\n"
;;


let in_name = ref ""
and in_suffix = ref ""
and out_name = ref ""
and display = ref false
and value_save = ref false;;

let i = ref 1 
and len = vect_length command_line in  
  if len = 1
  then 
  (
    print_string "Usage: pbm2caml [-c | -d | -o | -i ] file_name";
    print_newline ();
    exit(1)
  );
  while(!i<len) do
    (
    match command_line.(!i) with
      "-c" -> i := !i + 1; 
              in_name := gr_without_suffix command_line.(!i); 
              in_suffix := gr_suffix_only command_line.(!i)
    | "-d" -> i := !i + 1; 
              in_name := gr_without_suffix command_line.(!i); 
              in_suffix := gr_suffix_only command_line.(!i); 
              display := true
    | "-o" -> i := !i + 1;
              out_name := gr_without_suffix command_line.(!i)
    | "-i" -> value_save := true
    | _    -> print_string ("Unknown option: " ^ command_line.(!i) ^ " => ignored\n");
              print_newline ()
    );
    i := !i + 1
  done;
  if !out_name = "" then out_name := !in_name
;;


let width = ref 0
and height = ref 0
;;




if not !display
then
(
  if !value_save 
  then 
  (
    let image_car = readpbm_head (!in_name ^ "." ^ !in_suffix) in
        let im = readpbm (!in_name ^ "." ^ !in_suffix) 
        and out_file = open_out (!out_name ^ ".iml") in
          output_value out_file im;
        close_out out_file
  )
  else
  (
    let in_file = open_in (!in_name ^ "." ^ !in_suffix) 
    and out_file = open_out (!out_name ^ ".ml") in
      let rec nb_comment n =
        let str = input_line in_file in
          if nth_char str 0 = `#` 
          then nb_comment (n+1)
          else ( seek_in in_file 0; n)
      in

      let format_type = input_line in_file in
        let n = nb_comment 0 in
          print_string "\ncomment: ";
          input_line in_file; (* reread format_type *)
          for i = 1 to n do
          print_string ((input_line in_file)^ "\n         ")
        done;
        width := read_int in_file;
        height :=  read_int in_file;
      let nb_color = if !in_suffix = "pbm" then 2 else read_int in_file in
        print_string "\nwidth =";
        print_int !width;
        print_string "; height =";
        print_int !height;
        print_string";\nnb_color =";
        print_int nb_color;
       (
        match format_type with
          "P1" -> 
             print_string "\nblack & white, ascii mode";
             print_newline ();
             convert_ascii_blackwhite in_file out_file 
                                      !width !height !out_name
        | "P2" ->  
             print_string "\ngrey scale, ascii mode";
             print_newline ();
             convert_ascii_grey in_file out_file 
                                !width !height !out_name nb_color
        | "P3" ->  
             print_string "\ncolor, ascii mode";
             print_newline ();
             convert_ascii_color in_file out_file 
                                 !width !height !out_name nb_color
        | "P4" ->  
             print_string "\nblack & white, row mode";
             print_newline ();
             convert_raw_blackwhite in_file out_file 
                                    !width !height !out_name
        | "P5" ->  
             print_string "\ngrey scale, row mode";
             print_newline ();
             convert_raw_grey in_file out_file 
                              !width !height !out_name nb_color
        | "P6" ->  
             print_string "\ncolor, row mode";
             print_newline ();
             convert_raw_color in_file out_file 
                               !width !height !out_name nb_color
        | _ -> 
             print_string ("Unknown format : " ^ format_type);
             print_newline ()
      );

    close_in in_file;
    close_out out_file
  )
);;


if !display 
then 
(
  let image_car = readpbm_head (!in_name ^ "." ^ !in_suffix) in
    width := image_car.pbm_width;
    height := image_car.pbm_height;
  open_graph ();
  let xscreen = screen_width ()
  and yscreen = screen_height () in
    let win = add_window ((xscreen - !width)/2) ((yscreen - !height)/2) !width !height "pbm2caml" in
      let im = make_image (readpbm (!in_name ^ "." ^ !in_suffix)) in
        draw_image im 0 0;
      while(true) do
        let ev = get_event [Button_up] in
          match ev.id_event with
            Redraw -> draw_image im 0 0
          | Button_up -> close_graph (); exit 0
          | Close ->  exit 0
          | _     -> ()
      done
);;





