(***********************************************************************)
(*                                                                     *)
(*                           Objective Caml                            *)
(*                                                                     *)
(*            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 OImage

(*
let _ =
  Bitmap.maximum_live := 15000000; (* 60MB *)
  Bitmap.maximum_block_size := !Bitmap.maximum_live / 16;
;;
*)

open Gdk
open GDraw
open GMain

open Lvmisc
open Gui
open Display
open Tout

open Gc

exception Skipped

let _ =
  let r = Gc.get () in r.max_overhead <- 0; Gc.set r;

  let files = ref [] in
  let random = ref false in
  let size = ref false in


  Random.init (truncate (Unix.time ()));
  Arg.parse 
    [
      "-random", Arg.Unit (fun () -> random := true), ": random mode";
      "-wait", Arg.Float (fun sec -> Tout.wait := sec), "sec : wait sec";
      "-root", Arg.String (function
	  "center" -> Display.root_mode := `CENTER
	| "random" -> Display.root_mode := `RANDOM
	| _ -> raise (Failure "root mode")), ": on root [center|random]";
      "-transition", Arg.String (function
	  "myst" -> Display.transition := `MYST
	| "transparent" -> Display.transition := `TRANSPARENT
	| _ -> raise (Failure "transition")), ": transition [myst|transparent]";
      "-transparentborder", Arg.Unit (fun () ->
	Display.filters := `TRANSPARENT_BORDER :: !Display.filters),
      ": transparent border filter";
      "-size", Arg.String (fun s ->
	match Mstring.split_str (function 'x' -> true | _ -> false) s with
	  [w;h] -> 
	    size := true; 
	    Display.filters := `SIZE (int_of_string w, int_of_string h,`ALWAYS) :: !Display.filters
  	| _ -> raise (Failure "size")), ": size [w]x[h]";
      "-atleast", Arg.String (fun s ->
	match Mstring.split_str (function 'x' -> true | _ -> false) s with
	  [w;h] -> 
	    size := true; 
	    Display.filters := `SIZE (int_of_string w, int_of_string h,`ATLEAST) :: !Display.filters
  	| _ -> raise (Failure "zoom")), ": zoom [w]x[h]";
      "-atmost", Arg.String (fun s ->
	match Mstring.split_str (function 'x' -> true | _ -> false) s with
	  [w;h] -> 
	    size := true; 
	    Display.filters := `SIZE (int_of_string w, int_of_string h,`ATMOST) :: !Display.filters
  	| _ -> raise (Failure "zoom")), ": zoom [w]x[h]";

      "-normalize", Arg.Unit (fun () ->
	Display.filters := `NORMALIZE :: !Display.filters), 
            ": normalize colormap";

      "-enhance", Arg.Unit (fun () ->
	Display.filters := `ENHANCE :: !Display.filters), 
            ": enhance colormap";

    ]  
    (fun s -> files := s :: !files)
    "lv files";

  let files =
    let fs = ref [] in
    List.iter (fun f ->
      try
      let st = Unix.stat f in
      match st.Unix.st_kind with
      |	Unix.S_DIR ->
	  Scandir.scan_dir (fun f -> 
	    try 
	      ignore (guess_extension (snd (Lvmisc.get_extension f)));
	      fs := f :: !fs;
	    with e -> (* prerr_endline ((f^": "^ Printexc.to_string e)) *) ()) f
      |	_ -> fs := f :: !fs
      with
	_ -> ()) !files;
    Array.of_list !fs 
  in

  if not !size then
    Display.filters := `SIZE (fst root_size, snd root_size, `ATMOST) 
                         :: !Display.filters;
  Display.filters := List.rev !Display.filters;
  
  let cur = ref (-1) in
  let curpath = ref "" in

  let disp_cur = ref (-1) in

  if !random then begin
    let num_files = Array.length files in
    for i = 0 to num_files - 1 do
      let tmp = files.(i) in
      let pos = Random.int num_files in
      files.(i) <- files.(pos);
      files.(pos) <- tmp
    done
  end;


  infowindow#show ();

  imglist#freeze ();
  Array.iter (fun file -> ignore (imglist#append [file])) files;
  imglist#thaw ();

  let cache = Cache.create 5 in

  let rename pos newname =
    let oldname = files.(pos) in
    let xvname s = Filename.dirname s ^ "/.xvpics/" ^ Filename.basename s in
    let oldxvname = xvname oldname in
    let newxvname = xvname newname in
    imglist#set_cell ~text: newname pos 0;
    let command s = prerr_endline s; Sys.command s in
    if Filename.dirname newname <> Filename.dirname oldname then begin
      ignore (command 
		(Printf.sprintf "mkdir -p %s" (Filename.dirname newname)));
    end;
    ignore (command 
	      (Printf.sprintf "yes no | mv %s %s" oldname newname));
    if Sys.file_exists oldxvname then begin
      ignore (command 
		(Printf.sprintf "mkdir -p %s" (Filename.dirname newxvname)));
	ignore (command 
		  (Printf.sprintf "yes no | mv %s %s" oldxvname newxvname))
    end;
    files.(pos) <- newname;
    Cache.rename cache oldname newname
  in

  let display_image reload file =
    prerr_endline file;
    remove_timeout ();

    let load_image () =
      prog#misc#map (); 
      prog#set_percentage 0.01; 
      prog#set_format_string ("loading...");
      let image = 
	try
  	  match tag (OImage.load file 
  		       [Load_Progress prog#set_percentage]) with
  	  | Rgb24 i -> i
  	  | Index8 i -> i#to_rgb24
  	  | Index16 i -> i#to_rgb24
  	  | _ -> raise (Failure "not supported")
	with 
	| _ -> raise (Failure "not supported")
      in
      prog#set_percentage 1.0; sync ();
      image
    in

    let ximage =
      try
      	if not reload then begin
      	  let ximage = Cache.find cache file in
	  display_ximage ximage;
	  ximage
	end else raise Not_found
      with
	Not_found ->
	  display (load_image ())
    in
    Cache.add cache file ximage;
    prog#set_format_string "done";
    prog#set_percentage 0.01;
    prog#misc#unmap ();
    window#set_title file;
    disp_cur := !cur;
    curpath := file;
    Gc.compact ()
  in

  let display_image reload file =
    try 
      display_image reload file 
    with _ ->
      try
	prerr_endline "guess type";
	let typ =
	  let typ = Lvshtype.guess file in
	  match typ with
	  | Lvshtype.ContentType x ->
	      begin match
		Mstring.split_str (function '/' -> true | _ -> false) x
	      with
	      | [mj;mn] -> mj,mn
      	      | _ -> assert false
	      end
	  | Lvshtype.ContentEncoding x ->
	      "encoding", x
	  | Lvshtype.Special m ->
	      "special",m
	in
	prerr_endline (fst typ ^ "/" ^ snd typ);  
	match typ with
	| "image", _ -> ignore (Sys.command (Printf.sprintf "xv %s &" file))
	| _ -> raise Wrong_file_type
      with
      | _ -> raise Wrong_file_type
  in

  let filter_toggle opt = 
	if List.mem opt !Display.filters then
	  Display.filters :=
	     List.fold_right (fun x st ->
	       if x = opt then st
	       else x :: st) !Display.filters []
	else
	  Display.filters := !Display.filters @ [opt]
  in

  let display_current reload =
    let f = 
      if !cur >= 0 && !cur < Array.length files then begin
    	imglist#unselect_all ();
    	imglist#select !cur 0;
    	if imglist#row_is_visible !cur <> `FULL then begin
	  imglist#moveto ~row_align: 0.5 ~col_align: 0.0 !cur 0
    	end;
      	files.(!cur)
      end else !curpath
    in
    display_image reload f;
    ()
  in


  let rec next () =
    if !cur >= 0 then begin
      let cur' = 
  	if !cur >= Array.length files - 1 then 0 else !cur + 1
      in
      if !cur = cur' then ()
      else begin
  	cur := cur';
  	try
  	  display_current false
      	with
      	| Sys_error s ->
  	    prerr_endline s;
  	    next ()
        | Wrong_file_type | Wrong_image_type -> next ()
      end
    end
  in

  let rec prev () =
    if !cur >= 0 then begin
      let cur' =
      	if !cur = 0 then Array.length files - 1 else !cur - 1
      in
      if !cur = cur' then ()
      else begin
      	cur := cur';
      	try
  	  display_current false
      	with
      	| Sys_error s ->
  	    prerr_endline s;
  	    prev ()
      	| Skipped -> prev ()
      	| Wrong_file_type | Wrong_image_type -> prev ()
      end
    end
  in

  let bind () =
    let callback = fun ev ->
      begin match GdkEvent.Key.string ev with
(*
      | "E" -> 
	  filter_toggle `ENHANCE;
	  display_current true

*)
      | "N" -> 
	  filter_toggle `NORMALIZE;
	  display_current true
	    
      |	"l" -> display_current true

      | " " | "n" | "f" -> next ()
      | "p" | "b" -> prev ()
      | "q" -> Main.quit ()
      | "v" -> 
	(* lv visual shell *)
  	  let rec func = fun file typ ->
	    match typ with
	    | "image", _ -> 
    	      	display_image false file
(*
            | "special", "dir" -> 
                new Lvsh.lvsh file func; ()
*)
	    | _ -> Gdk.X.beep ()
  	  in
	  (* where we should display ? *)
	  let dirname = 
	    if Array.length files = 0 then Unix.getcwd ()
	    else Filename.dirname files.(!cur) 
	  in
	  let dirname =
	    if Filename.is_relative dirname then begin
 	      let cwd = Unix.getcwd () in
	      Filename.concat cwd dirname
	    end else dirname
	  in
	  ignore (new Lvsh.lvsh dirname func)


      | _ -> () 
      end; false
    in
    window#event#connect#key_press ~callback: callback;
    infowindow#event#connect#key_press ~callback: callback;

    imglist#connect#select_row ~callback: (fun ~row ~column ~event ->
      if !cur <> row then begin
      	cur := row;
      	display_image false files.(!cur)
      end)
  in

  bind ();

  Tout.hook_next := next;

  window#show ();

  let starter = ref None in

  if Array.length files <> 0 then begin
    starter := Some (window#event#connect#after#configure ~callback: (fun ev ->
      may window#misc#disconnect !starter;
      cur := 0;
      prog#misc#unmap ();
      display_current false; false));
  end else begin
    display_image false (Pathfind.find [ "~/.lv"; 
					 "/usr/lib/lv"; 
					 "/usr/local/lib/lv";
					 "." ] "lv.jpg")
  end;

  Main.main ()
