(***********************************************************************)
(*                                                                     *)
(*                           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 OImage
open GBin
open GPack
open Ximage
open Gui
open Lvshtype
open Lvmisc

let dummy_pixmap =
  try
    GDraw.pixmap_from_xpm ~window: window
      ~file: (Pathfind.find ["~/.lv"; "/usr/lib/lv"; "/usr/local/lib/lv"; "."] 
	     	"FileUnknown.xpm") ()
  with
    _ -> raise (Failure "default icon does not exist...")

class virtual icon_creator = object (self)
  val mutable icons = []

  method virtual activate : unit -> unit
  method virtual set_text : string -> unit

  method add f =
    let was_empty = icons = [] in
    icons <- f :: icons;
    if was_empty then
      ignore (GMain.Timeout.add ~ms: 1 ~callback: self#make_icon);
    ()
	
  method make_icon () =
    begin match icons with
      [] -> 
	self#set_percentage 0.0; sync ()
    | f :: fs ->
    	icons <- fs;
    	f ();
	self#activate ();
	sync ();
	ignore (GMain.Timeout.add ~ms: 1 ~callback: self#make_icon)
    end;
    false

  method clear () = icons <- []
end

and icon ~dir ~name (req : icon_creator) =
  let ebox = GBin.event_box ~border_width: 0 ~width: 100 ~height: 100 () in
  let vbox = lazy (GPack.vbox (*~width: 100 ~height: 80*) ~packing: ebox#add ()) in
  let pressed = ref (fun () -> ()) 
  and enter = ref (fun () -> ()) 
  and leave = ref (fun () -> ()) 
  in
  let button = lazy begin
    let b = GButton.button ~width:84 ~height:64 ~border_width:0 
	                   ~packing: !!vbox#pack () in
    b#connect#pressed ~callback: !pressed;
    b#connect#enter ~callback: !enter;
    b#connect#leave ~callback: !leave;
    b
  end
  in
  let pix = lazy begin
    GMisc.pixmap dummy_pixmap ~width:80 ~height:60 ~packing: !!button#add ()
  end
  in
  let label = lazy begin
    GMisc.label ~text: name ~width:80 ~packing: !!vbox#pack ()
  end
  in
  let typ = lazy begin
    try
      let typ = Lvshtype.guess (Filename.concat dir name) in
      match typ with
      | ContentType x ->
	  begin match
	    Mstring.split_str (function '/' -> true | _ -> false) x
	  with
	  | [mj;mn] -> mj,mn
      	  | _ -> assert false
	  end
      | ContentEncoding x ->
	  "encoding", x
      | Special m ->
	  "special",m
    with
    | _ -> "?","?"
  end
  in

  object (self)
  inherit GObj.widget_full ebox#as_widget

  method connect_pressed f = pressed := f
  method connect_enter f = enter := f
  method connect_leave f = leave := f

  method typ = !!typ

  val info_icon = lazy begin
    (* prerr_endline (Printf.sprintf "Icon(%s)" name); *)
    let info, pixmap = Icon.load_icon (Filename.concat dir name) !!typ in
    prog#misc#unmap ();
    !!pix#set_pixmap pixmap;
    sync ();
    (* prerr_endline "done"; *)
    info, pixmap
  end

  method info = fst !!info_icon
  method icon = snd !!info_icon

  val mutable x = -1
  val mutable y = -1

  method position = x, y
  method set_position nx ny = x <- nx; y <- ny 

  method name = name

  initializer
    let callback v = fun _ ->
      (* we create vbox button pix and label if they are not available *)
      !!vbox; !!button; !!pix; !!label;
      begin match !info_icon with
      | Lazy.Delayed _ ->
	  req#add (fun () -> if !!button#misc#visible then 
	    (try self#icon; () with _ -> ()))
      | _ -> ()
      end; v
    in
    (* for the widget visible from the first *)
    ignore (ebox#misc#connect#draw ~callback: (fun _ ->
      (* prerr_endline (Printf.sprintf "draw(%s)" name); *)
      callback () ()));
    (* for newly appearing widgets *)
    ignore (ebox#event#connect#expose ~callback: (fun _ ->
      if ebox#misc#visible then begin
        (* prerr_endline (Printf.sprintf "expose(%s)" name); *)
      	callback true () 
      end else true));
end;;

class lvsh init_dir func = 
  (* widgets *)
  let win = GWindow.window ~allow_shrink: true
                               ~allow_grow: true
      ~width: 100 ~height: 100
      ~title: "lv shell" ()
  in
  let vbox = vbox ~packing: win#add () in
  let viewport = GBin.scrolled_window 
      ~hpolicy: `AUTOMATIC ~vpolicy: `ALWAYS 
      ~packing: (vbox#pack ~expand: true ~fill: true) ()
  in
  let fixed = GPack.fixed ~border_width: 2 ~width: 1 ~height: 1 () in
(*
  let fixed = GPack.layout ~border_width: 2 ~layout_width: 1000 ~layout_height: 1000 () in
*)
  let _ =
    viewport#add_with_viewport fixed#coerce;
  in

  let reconf_tout = ref None in

  object (self)
  inherit icon_creator
  inherit JWidget.status_bar 
      ~packing: (vbox#pack ~expand: false ~fill: false) 
      ~show: true () 

  val mutable dir = init_dir
  val mutable items = []
  val mutable prevw = -1
  val mutable prevh = -1

  method reconfigure () =
    let content_window = 
      Gdk.Window.get_parent (Gdk.Window.get_parent fixed#misc#window)    
    in
    let vw,vh = Gdk.Window.get_size content_window in
    if vw <> prevw || vh <> prevh then begin
      prevw <- vw;
      prevh <- vh;
      prerr_endline "RECONFIG";
      prerr_endline (Printf.sprintf "get size done (%d,%d)" vw vh);

      fixed#misc#unmap ();
      
      let mx = ref 0 and my = ref 0 in
      let x = ref 0 and y = ref 0 in
      let positions = 
	List.map (fun item ->
	  let px = !x and py = !y in
  	  if !mx < (!x + 100) then mx := !x + 100; 
  	  if !my < (!y + 120) then my := !y + 120;
  	  x := !x + 100;
  	  if !x + 80 > vw then begin
  	    x := 0;
  	    y := !y + 100
  	  end;
	  px, py) items
      in

      let adj = viewport#vadjustment in 
      adj#set_value 0.0;
      viewport#set_vadjustment adj;

      List.iter2 (fun item (x,y) ->
      	let ix, iy = item#position in
  	if ix < 0 then begin
  	  fixed#put item#coerce ~x ~y
  	end else begin
  	  fixed#move item#coerce ~x ~y
  	end;
	item#set_position x y) items positions;
      
      prerr_endline (Printf.sprintf "change <fixed> %dx%d" !mx !my);
      fixed#misc#set_geometry ~width: !mx ~height: !my ();
      fixed#misc#map ();
      
    end
	
  method force_reconfigure () =
    prevw <- -1;
    prevh <- -1;
    self#reconfigure ()

  method open_dir d =
    self#clear (); 
    let num_files = ref 0 in
    List.iter (fun item -> item#destroy ()) items;
    items <- [];

    self#set_text ("Opening "^d^" ...");
    let dh = Unix.opendir d in
    let files = 
      let files = ref [] in
      begin 
      	try while true do
      	  files := Unix.readdir dh :: !files;
	  self#activate ();
	  sync ();
	  incr num_files;
      	done with
      	  End_of_file -> ()
      end;
      Unix.closedir dh;
      !files
    in
    self#set_text "";
    self#set_percentage 0.0;
    
    (* successfully loaded *)
    dir <- d;

    self#set_text ("Scanning " ^d);
    let items_unsort =
      let cntr = ref 0 in
      List.fold_right (fun f acc ->
	incr cntr; 
	self#set_percentage (float !cntr /. float !num_files); sync ();
	if f = "." ||
	   f = ".xvpics"
	then acc
	else begin
      	  let box = new icon ~dir: dir ~name: f (self :> icon_creator) in
      	  ignore (box#connect_pressed (fun () ->
	    Lvmisc.after (fun () ->
	      if !active then begin
	      	active := false;
	      	let file = Lvmisc.normalize_filename (Filename.concat dir f) in
	      	let typ = box#typ in
	      	prerr_endline ("Pressed " ^ file ^ 
			       " ("^ fst typ ^ "/"^ snd typ ^")");
	      	match typ with
	      	| "special", "dir"
	      	| "special", "lnkdir" -> 
	      	    self#open_dir file;
	      	    self#force_reconfigure ()
	      	| t -> func file t
	      end) (fun () -> active := true)));
      	  box#connect_enter (fun () -> 
	    self#set_text (Filename.concat dir f));
      	  box#connect_leave (fun () -> self#set_text "");
      	  box :: acc
	end) files []
    in
    self#set_percentage 0.0;
    self#set_text "";

    let sortf a b =
      let typval i =
	match i#typ with
	| "special", "dir" -> 0
	| "special", "lnkdir" -> 0
	| "special", _ -> 10
	| _ -> 100
      in
      if typval a = typval b then a#name < b#name
      else typval a < typval b
    in

    items <-  Sort.list sortf items_unsort;

  initializer
      win#connect#destroy ~callback: (fun () ->
    	self#clear ();
    	match !reconf_tout with
    	| Some id -> GMain.Timeout.remove id
    	| None -> ());

      self#open_dir dir;
      (* This does not work well... 
        ignore (win#connect#after#event#configure ~callback: (fun _ -> 
      	  self#reconfigure (); true)); *)
      reconf_tout := Some (GMain.Timeout.add ~ms: 500 ~callback: (fun _ ->
      	  self#reconfigure (); true));
      win#set_default_size ~width: 640 ~height: 320;
      win#show ();
end
;;
