(***********************************************************************)
(*                                                                     *)
(*                           Objective Caml                            *)
(*                                                                     *)
(*            François Pessaux, projet Cristal, INRIA Rocquencourt     *)
(*            Pierre Weis, projet Cristal, INRIA Rocquencourt          *)
(*            Jun Furuse, projet Cristal, INRIA Rocquencourt           *)
(*                                                                     *)
(*  Copyright 1999,2000,2001,2002,2001,2002                            *)
(*  Institut National de Recherche en Informatique et en Automatique.  *)
(*  Distributed only by permission.                                    *)
(*                                                                     *)
(***********************************************************************)

open Image;;
open Format;;

let capabilities () =
  printf "*******************************************************@.";
  printf "Camlimages library capabilities currently available@.";

  printf "bmp\t: %s@."
   (if Camlimages.lib_bmp then "supported" else "not supported");

  printf "ppm\t: %s@."
   (if Camlimages.lib_ppm then "supported" else "not supported");

  printf "gif\t: %s@."
   (if Camlimages.lib_gif then "supported" else "not supported");

  printf "jpeg\t: %s@."
   (if Camlimages.lib_jpeg then "supported" else "not supported");

  printf "tiff\t: %s@."
   (if Camlimages.lib_tiff then "supported" else "not supported");

  printf "png\t: %s@."
   (if Camlimages.lib_png then "supported" else "not supported");

  printf "xv thumbnails\t: %s@."
   (if Camlimages.lib_xvthumb then "supported" else "not supported");

  printf "postscript\t: %s@."
   (if Camlimages.lib_ps then "supported" else "not supported");

  printf "freetype\t: %s@."
   (if Camlimages.lib_freetype then "supported" else "not supported");

  printf "*******************************************************@.";
;;

let show_image img x y =
  let gr_img = Graphics.make_image (Graphic_image.array_of_image img) in
  Graphics.draw_image gr_img x y
;;

module FtDraw = Fttext.Make(Rgb24);;

let draw_string =
  if Camlimages.lib_freetype then begin
    (* Freetype library initialization *)
    let library = Freetype.init () in
    let face, face_info = Freetype.new_face library "micap.ttf" 0 in
    Freetype.set_char_size face 18.0 18.0 72 72;
  
    fun str x y ->
      let str = Fttext.unicode_of_latin str in
      let x1,y1,x2,y2 = Fttext.size face str in
      let w = truncate (x2 -. x1) + 2
      and h = truncate (y2 -. y1) + 2
      in
      let tmpbitmap = Rgb24.create w h in
      for x = 0 to w - 1 do
  	for y = 0 to h - 1 do
  	  Rgb24.unsafe_set tmpbitmap x y { r = 255; g = 255; b = 255 } 
  	done
      done;
      FtDraw.draw_text face Fttext.func_darken_only tmpbitmap 
  	(- (truncate x1)) (truncate y2) str;
      show_image (Rgb24 tmpbitmap) x (y - h)
  end else begin
    fun _ _ _ -> ()
  end
;;

let go_on () =
 prerr_endline "Press return to proceed, s: save a screenshot, q: quit";
 let s = input_char stdin in
 (* save screen shot *)
 if s = 's' then begin
   prerr_endline "Saving screenshot";
   let gr_img =
     Graphic_image.get_image 0 0 (Graphics.size_x ()) (Graphics.size_y ()) in
   Image.save "screen.bmp" (Some Bmp) [] (Rgb24 gr_img);
   prerr_endline "done"
 end;
 s <> 'q';;

let images_default = [
  "apbm.pbm"; "apgm.pgm"; "appm.ppm";
  "pbm.pbm"; "pgm.pgm"; "ppm.ppm";
  "jpg.jpg"; "png.png"; "bmp.bmp"; "tif.tif";
  "xpm.xpm"; "eps.eps"; "gif.gif"; "mmm.anim.gif"
];;

let images =
  let images = ref [] in
  Arg.parse [] (fun x -> images := x :: !images) "test images";
  if !images <> [] then List.rev !images 
  else List.map (fun x -> Filename.concat "images" x) images_default
;;

open Gif;;

let main () =
  capabilities ();
  Graphics.open_graph "";
  try 
    List.iter (fun name ->
      prerr_endline name;
      try
        prerr_endline "Analysing header...";
	let format, header = Image.file_format name in
	prerr_endline (Printf.sprintf "%s: %s format, %dx%d" 
			 name (extension format)
			 header.header_width header.header_height);
	begin match format with
	| Gif ->
	    prerr_endline ("Loading " ^ name ^ "...");
	    let sequence = Gif.load name [] in
	    prerr_endline "Loaded";
	    let w = sequence.screen_width
	    and h = sequence.screen_height in
            let w' = Graphics.size_x () - w
            and h' = Graphics.size_y () - h in
            let x = if w' > 0 then Random.int w' else 0
            and y = if h' > 0 then Random.int h' else 0 in
            draw_string name x y;
	    List.iter (fun frame ->
	      let put_x = x + frame.frame_left
	      and put_y = y + frame.frame_top in
	      show_image (Index8 frame.frame_bitmap) put_x put_y;
	      (* if not (go_on ()) then raise Exit *) )
	      sequence.frames;
	    begin
	      try
		Gif.save "out.image" [] sequence;
	    	prerr_endline "Saved";
	      with
	      |	_ -> prerr_endline "Save failed"
	    end;
	    if not (go_on ()) then raise Exit
	| _ ->
	    prerr_endline ("Loading " ^ name ^ "...");
            let img = Image.load name [] in
	    prerr_endline "Loaded";
            let w, h = Image.size img in
            let w' = Graphics.size_x () - w
            and h' = Graphics.size_y () - h in
            let x = if w' > 0 then Random.int w' else 0
            and y = if h' > 0 then Random.int h' else 0 in
            show_image img x y;
            draw_string name x y;
	    begin
	      try
		Image.save "out.image" (Some format) [] img;
	      	prerr_endline "Saved";
	      with
	      |	_ -> prerr_endline "Save failed"
	    end;
            if not (go_on ()) then raise Exit
	end;
      with
      | Failure s -> prerr_endline s) images
  with
  | Exit -> exit 0
  | End_of_file -> exit 0
  | Sys.Break -> exit 2
;;

main ();;
