open Printf
open Tk
open Tkanim
open Www
open Uri
open Hyper
open Maps
open Embed
open Img
open Viewers

(* Images are embedded objects, with a twist *)
(* TODO: maps *)

type mode =
    DuringDoc
  | AfterDocAuto
  | AfterDocManual

let mode = ref AfterDocManual
let no_images = ref false

let gif_anim_auto = ref false

(* Utilities *)
(* activate *)
let display emb i =
  match emb.embed_map with
    ClientSide hlink -> (* kill'em all *)
      begin try
	List.iter destroy (Winfo.children emb.embed_frame);
	let w, h =
	 match i with
	   Still x -> 
	     begin match x with
	       ImageBitmap i -> Imagebitmap.width i, Imagebitmap.height i
	     | ImagePhoto  i -> Imagephoto.width i, Imagephoto.height i
	     | _ -> failwith "invalid image" 
	     end
	 | Animated anm -> Tkanim.width anm, Tkanim.height anm in
	let c = Canvas.create emb.embed_frame 
		   [Width (Pixels w); Height (Pixels h)] in
	  pack [c][];
	let ii = Canvas.create_image c (Pixels 0) (Pixels 0)
			       [Anchor NW] in
	begin
	  match i with
	    Still x -> Canvas.configure_image c ii [x]
	  | Animated anm -> 
	      begin
		let f = Tkanim.animate_canvas_item c ii anm in
		(* binding on c is bad... *)
		bind c [[], ButtonPressDetail 2] (BindSet ([], (fun _ ->
		  f false)));
		bind c [[Shift], ButtonPressDetail 2] (BindSet ([], (fun _ ->
		  f true)));
		(* I am sure it doesn't work *)
		Canvas.configure c [Cursor (XCursor "watch")];
		if !gif_anim_auto then f false
	      end
	end;
	(* now we have the image displayed in a canvas.
	   and we can create the client side map *)
	let uri = Hyper.resolve hlink in
	let name =
	  match uri.uri_frag with 
	    None -> uri.uri_url
	  | Some frag -> sprintf "%s#%s" uri.uri_url frag
	in
	  match Maps.get name with
	    KnownMap m -> Cmap.gfx_mode emb m c
	  | RequestedMap event ->
	     Frx_synth.bind c event 
		 (fun c -> 
		    match Maps.get name with
		      RequestedMap _ ->
			 Log.f "INTERNAL ERROR: delayed_client_side"
		    | KnownMap m -> Cmap.gfx_mode emb m c)
      with
	_ -> Log.f "INTERNAL ERROR in display"
      end

  | _ ->
    (* in all other cases, get the alt label, and configure it *)
    (* WARNING: there may be an hypermenu here *)
    List.iter (function w when Winfo.class_name w = "Label" ->
      match i with
	Still x -> Label.configure w [x]
      | Animated anm -> 
	  begin
	    let f = Tkanim.animate w anm in
	    bind w [[], ButtonPressDetail 2] (BindSet ([], (fun _ ->
	      f false)));
	    bind w [[Shift], ButtonPressDetail 2] (BindSet ([], (fun _ ->
	      f true)));
	    Label.configure w [Cursor (XCursor "watch")];
	    if !gif_anim_auto then f false
	  end
      | _ -> ())
      (Winfo.children emb.embed_frame)

let activate emb =
  Log.debug "Activating image";
  try
    Img.get emb.embed_context.viewer_base
	    emb.embed_hlink
	    (display emb)
  with
     _ -> Log.f "Can't load image"

(* put up the alternate text *)
let put_alt emb =
  let m = Label.create_named emb.embed_frame "alt" [Text emb.embed_alt] in
  (* make sure all bindings we put on the frame are attached there *)
  Tk.bindtags m ((WidgetBindings emb.embed_frame)::Tk.bindtags_get m);
  pack [m][Fill Fill_Both; Expand true]


(* for delayed load, add binding *)
let make_auto delayed emb =
  try
    let url = (Www.make emb.embed_hlink).www_url in
    bind emb.embed_frame
      [[Shift], ButtonPressDetail 1] 
      (BindSet ([], (fun _ -> Img.ImageScheduler.flush_one delayed url)))
  with
    _ -> Log.f "Can't compute image link"

(* for manual load, add binding *)
let make_manual emb =
  try
    let url = (Www.make emb.embed_hlink).www_url in
    bind emb.embed_frame
      [[Shift], ButtonPressDetail 1] 
      (BindSet ([], (fun _ -> activate emb)))
  with
    _ -> Log.f "Can't compute image link"

(* If the object is clickable, make it visible *)
let visible = [BorderWidth (Pixels 2); Relief Raised; 
	       Cursor (XCursor "hand2")]
let visible_map = [BorderWidth (Pixels 2); Relief Raised; 
	           Cursor (XCursor "left_ptr")]


let make_map emb =
  match emb.embed_map with
    ClientSide hlink ->
      Frame.configure emb.embed_frame visible_map;
     (* At this moment, we assume that we are in alt mode.
	If the image gets loaded, the label gets destroyed and
	the callback will never be invoked. Instead, it will
	be called from "display" *)
      begin try
       match Winfo.children emb.embed_frame with
	[l] when Winfo.class_name l = "Label" ->
	  let uri = Hyper.resolve hlink in
	  let name =
	    match uri.uri_frag with 
	      None -> uri.uri_url
	    | Some frag -> sprintf "%s#%s" uri.uri_url frag in
	  begin match Maps.get name with
	    KnownMap m -> Cmap.alt_mode emb m l
	  | RequestedMap event ->
	     Frx_synth.bind l event 
		 (fun l -> 
		    match Maps.get name with
		      RequestedMap _ -> Log.f 
			 "INTERNAL ERROR: delayed_client_side"
		    | KnownMap m -> Cmap.alt_mode emb m l)
	  end
       | _ -> Log.f "make_map. children not a label"
      with
	_ -> ()
      end
  | ServerSide link ->
      Frame.configure emb.embed_frame visible;
      (new Htbind.servermap (emb.embed_frame, link))#init emb.embed_context
  | Direct link -> 
      Frame.configure emb.embed_frame visible;
      (new Htbind.directmap (emb.embed_frame, link))#init emb.embed_context
  | NoMap -> ()
  | FormMap getlink ->
      Frame.configure emb.embed_frame visible;
      (new Htbind.formmap (emb.embed_frame, getlink))#init emb.embed_context

(* The various managers *)
class loader () =
  method add_image emb =
    put_alt emb; make_map emb
  method flush_images = ()
  method load_images = ()
end

class synchronous () =
  inherit loader () as super

  method add_image emb =
    super#add_image emb; activate emb
end

class auto () =
  inherit loader () as super
  val q = ImageScheduler.new_delayed()

  method add_image emb =
     super#add_image emb;
     try
       ImageScheduler.add_delayed q
       (Www.make emb.embed_hlink)
       emb.embed_context.viewer_base
       (display emb)
     with
       _ -> Log.f "Can't compute image link"

  method flush_images = ImageScheduler.flush_delayed q
end

class manual () =
  inherit auto () as super

  method add_image emb =
    super#add_image emb;
    make_auto q emb
 
  method flush_images = ()

  method load_images = ImageScheduler.flush_delayed q
end

let create () =
  if !no_images then new loader ()
  else match !mode with
     DuringDoc -> new synchronous ()
   | AfterDocAuto -> new auto()
   | AfterDocManual -> new manual()

