(***********************************************************************)
(*                                                                     *)
(*                           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 Lvmisc
open Gui
open Tout

open Gdk
open GDraw
open GMain

open Ximage
open OXimage

type filter = [ `TRANSPARENT_BORDER
              | `SIZE of int * int * [ `ATMOST | `ATLEAST | `ALWAYS ]
              |	`NORMALIZE | `ENHANCE  ]

let filters = (ref [] : filter list ref)

class type display = object
  method display : Ximage.t -> unit
end

class win = object
  val mutable backstore = (None : OXimage.ximage option)

  method display ximage =
    let oldbackstore = backstore in
    backstore <- None;
    darea#set_size ~width: ximage#width ~height: ximage#height;
    fixed#misc#set_geometry ~width: ximage#width ~height: ximage#height ();
    backstore <- Some ximage; 
    sync ();
    set_timeout ()

  initializer
    darea#event#connect#expose ~callback: (fun ev ->
      begin match backstore with
      |	Some ximage ->
	  let area = GdkEvent.Expose.area ev in
	  let x = Gdk.Rectangle.x area in 
	  let y = Gdk.Rectangle.y area in 
	  let width = 
	    min (ximage#width - x) (Gdk.Rectangle.width area)
	  in 
	  let height = 
	    min (ximage#height - y) (Gdk.Rectangle.height area)
	  in 
(*
	  prerr_endline (Printf.sprintf "Expose some (%d)%dx%d+%d+%d"
			   (GdkEvent.Expose.count ev)
			width height x y);
*)
	  drawing#put_image ~width ~height
   	                    ~xsrc: x ~ysrc: y 
	                    ~x: x ~y: y ximage#data
      |	None -> ()
      end; true);
    ()
end

let root_pixmap = lazy begin
  let pix = GDraw.pixmap ~window
      ~width: screen_width
      ~height: screen_height ()
  in
  pix#set_foreground `BLACK;
  pix#rectangle ~x:0 ~y:0 ~width: screen_width ~height: screen_height 
                ~filled: true ();
  pix#pixmap
end

let root_drawing = lazy begin
  new drawable !!root_pixmap
end
  
type root_geom = {
    width : int;
    height : int;
    xdest : int;
    xsrc : int;
    ydest : int;
    ysrc : int;
    put_width : int;
    put_height : int
  } 

let root_geom ximage x y =
  let width0 = ximage#width in
  let height0 = ximage#height in
  let xdest0 = if x < 0 then 0 else x in
  let xsrc0 = if x < 0 then -x else 0 in
  let put_width0 = 
    if x + width0 > screen_width then screen_width - xdest0
    else x + width0 - xdest0
  in
  let ydest0 = if y < 0 then 0 else y in
  let ysrc0 = if y < 0 then -y else 0 in
  let put_height0 =
    if y + height0 > screen_height then screen_height - ydest0
    else y + height0 - ydest0
  in
  { width= width0;
    height= height0;
    xdest= xdest0;
    ydest= ydest0;
    xsrc= xsrc0;
    ysrc= ysrc0;
    put_width= put_width0;
    put_height= put_height0;
  } 

class root = 
  object
    method display_at (ximage : OXimage.ximage) x y =
      let geom = root_geom ximage x y in
      !!root_drawing#put_image ximage#data
      	~xsrc: geom.xsrc ~ysrc: geom.ysrc 
      	~x: geom.xdest ~y: geom.ydest
      	~width: geom.put_width ~height: geom.put_height;
      Window.set_back_pixmap root_win (`PIXMAP(!!root_pixmap));
      Window.clear root_win;
      set_timeout ()
  end

(*

class virtual root_random = object (self)
  method virtual display_at : OXimage.ximage -> int -> int -> unit

  method display ximage =
    let w = screen_width - ximage#width
    and h = screen_height - ximage#height
    in
    let overwrap x y =
      match !root_prev_pos with
      |	None -> 0
      |	Some (pw,ph,px,py) ->
	  let w = min (x + w - 1) (px + pw - 1) - max x px in
	  let h = min (y + h - 1) (py + ph - 1) - max y py in
	  if w < 0 || h < 0 then 0 else w * h
    in
    let random_x_y () = 
      let x = if w <= 0 then w / 2 else Random.int w
      and y = if h <= 0 then h / 2 else Random.int h
      in (x,y),overwrap x y
    in
    let min = ref (random_x_y ()) in
    for i = 0 to 10 do
      let (x,y),over = random_x_y () in
      if snd !min > over then begin
	prerr_endline (Printf.sprintf "%d" over);
	min := (x,y),over
      end
    done;
    let x, y = fst !min in 
    root_prev_pos := Some (w,h,x,y);
    self#display_at ximage x y
end
  
class virtual root_center = object (self)
  method virtual display_at : OXimage.ximage -> int -> int -> unit
  method display ximage =
    let w = screen_width - ximage#width
    and h = screen_height - ximage#height
    in
    self#display_at ximage (w/2) (h/2)
end
*)
      
(* src will be modified *)
let transparent_border src geom dst =
  let width = src#width
  and height = src#height in
  let src = src#data in
  let dst = dst#data in

  let color_at image x y = quick_color_parser (Image.get_pixel image ~x ~y) in

  let border = min width height / 10 + 1 in
	
  let doit b x y ox oy =
    let cd = color_at src x y in
    let co = color_at dst ox oy in
    let red,green,blue = color_merge co cd (border + 1) b in
    let pixel = quick_color_create ~red ~green ~blue in
    Image.put_pixel src ~x: x ~y: y ~pixel
  in
  for b = 0 to border do
    let y = b in
    let oy = y - geom.ysrc in
    if oy < 0 || oy >= geom.put_height then ()
    else begin
      for x = b to width - b - 1 do
	let ox = x - geom.xsrc in
	if ox < 0 ||ox >= geom.put_width then ()
	else doit b x y ox oy
      done
    end;
    let y = height - b - 1 in
    let oy = y - geom.ysrc in
    if oy < 0 || oy >= geom.put_height then ()
    else begin
      for x = b to width - b - 1 do
	let ox = x - geom.xsrc in
	if ox < 0 ||ox >= geom.put_width then ()
	else doit b x y ox oy
      done
    end;
    let x = b in
    let ox = x - geom.xsrc in
    if ox < 0 || ox >= geom.put_height then ()
    else begin
      for y = b + 1 to height - b - 2 do
	let oy = y - geom.ysrc in
	if oy < 0 || oy >= geom.put_height then ()
	else doit b x y ox oy
      done
    end;
    let x = width - b - 1 in
    let ox = x - geom.xsrc in
    if ox < 0 || ox >= geom.put_width then ()
    else begin
      for y = b + 1 to height - b - 2 do
	let oy = y - geom.ysrc in
	if oy < 0 ||oy >= geom.put_height then ()
	else doit b x y ox oy
      done
    end;
  done
;;

class root_filter = 
  object
    inherit root as super
	
    method display_at ximage x y =
      let geom = root_geom ximage x y in
      let dst = lazy begin 
    	OXimage.get_image !!root_pixmap ~x: geom.xdest ~y: geom.ydest
	  ~width: geom.put_width ~height: geom.put_height;
      end
      in
      List.iter (function
	| `TRANSPARENT_BORDER -> 
	    transparent_border ximage geom !!dst
	| _ -> ()) !filters;
      super#display_at ximage x y 
  end
      
class root_myst = object
  inherit root_filter as super

  val mutable id = None
  val mutable finish = fun () -> ()

  method display_at ximage x y =
    let geom = root_geom ximage x y in
    let array =
      Array.init (geom.put_width * geom.put_height) 
      	 (fun x -> x mod geom.put_width, x / geom.put_width) 
    in
    for i = 0 to  geom.put_width * geom.put_height - 1 do
      let pos = Random.int (geom.put_width * geom.put_height - 1) in
      let tmp = array.(i) in
      array.(i) <- array.(pos);
      array.(pos) <- tmp
    done;

    let cntr = ref 0 in
    finish <- (fun () -> super#display_at ximage x y);  

    id <- Some (Timeout.add ~ms:100 ~callback: (fun () ->
      try
	for i = 0 to geom.put_width * geom.put_height / 10 do
	  let x, y = array.(!cntr) in
	  !!root_drawing#put_image ximage#data
	    ~xsrc: (geom.xsrc+x) ~ysrc: (geom.ysrc+y) 
	    ~x: (geom.xdest+x) ~y: (geom.ydest+y)
	    ~width: 1 ~height: 1;
	  incr cntr;
	  if !cntr = geom.put_width * geom.put_height then raise Exit
	done;
	Window.set_back_pixmap root_win (`PIXMAP(!!root_pixmap));
	Window.clear root_win;
	true
      with
	Exit ->
	  Window.set_back_pixmap root_win (`PIXMAP(!!root_pixmap));
	  Window.clear root_win;
prerr_endline "finished";
	  id <- None;
	  set_timeout ();
	  false))

  method force_finish =
    match id with
    | Some i ->
    	Timeout.remove i;
    	id <- None;
      	finish ();
	finish <- fun () -> ()
    | None -> ()
end

(*
class display_root_transparent ximage x y = 
  object (self)
  inherit display_root_myst ximage x y as super

  method display =
    let orgimg = self#orgimg in
    let tmpimg = self#tmpimg in
    self#init;

    let max = 4 in
    cntr <- 1; 
    id <- Some (Timeout.add ~ms:100 ~callback: (fun () ->
      for y = 0 to geom.put_height - 1 do
	for x = 0 to geom.put_width - 1 do
	  let cd = 
	    quick_color_parser (Image.get_pixel ximage#data 
				  ~x:(geom.xsrc+x) ~y:(geom.ysrc+y))
	  in
	  let co =
	    quick_color_parser (Image.get_pixel orgimg  ~x ~y) 
	  in
	  let red,green,blue = color_merge co cd max cntr in
	  let pixel =
	    quick_color_create ~red ~green ~blue
	  in
	  Image.put_pixel tmpimg ~x ~y ~pixel;
	done
      done;
      if cntr = max then begin
	drawing_root_pixmap#put_image tmpimg
	  ~xsrc:0 ~ysrc:0 ~xdest: geom.xdest ~ydest: geom.ydest 
	  ~width: geom.put_width ~height: geom.put_height;
	Window.set_back_pixmap root_win ~pixmap: (`PIXMAP(pix));
	Window.clear root_win;
	finished <- true;
	self#free_tmps;
	set_timeout ();
	false
      end else  begin
	drawing_root#put_image tmpimg
	  ~xsrc:0 ~ysrc:0 ~xdest: geom.xdest ~ydest: geom.ydest 
	  ~width: geom.put_width ~height: geom.put_height;
	cntr <- cntr + 1;
	true
      end))
end
*)

type root_mode = [`NONE|`CENTER|`RANDOM]
type transition = [`NONE|`MYST|`TRANSPARENT]

let root_mode = ref (`NONE : root_mode)
let transition = ref (`NONE : transition)

let win = new win
let root = new root_filter
let root_myst = new root_myst

let root_prev_pos = ref None

let display_ximage ximage =
  match !root_mode with
  | `CENTER | `RANDOM ->
      let x, y =
 	let w = screen_width - ximage#width
      	and h = screen_height - ximage#height
      	in
	match !root_mode with
	| `RANDOM ->
	    let w = screen_width - ximage#width
	    and h = screen_height - ximage#height
	    in
	    let overwrap x y =
	      match !root_prev_pos with
	      |	None -> 0
	      |	Some (pw,ph,px,py) ->
		  let w = min (x + w - 1) (px + pw - 1) - max x px in
		  let h = min (y + h - 1) (py + ph - 1) - max y py in
		  if w < 0 || h < 0 then 0 else w * h
	    in
	    let random_x_y () = 
	      let x = if w <= 0 then w / 2 else Random.int w
	      and y = if h <= 0 then h / 2 else Random.int h
	      in (x,y),overwrap x y
	    in
	    let min = ref (random_x_y ()) in
	    for i = 0 to 5 do
	      let (x,y),over = random_x_y () in
	      if snd !min > over then begin
		prerr_endline (Printf.sprintf "%d" over);
		min := (x,y),over
	      end
	    done;
	    let x,y = fst !min in
	    root_prev_pos := Some (w,h,x,y);
	    x,y
	| _ ->
	    w/2, h/2 
      in
      begin match !transition with
      	| `MYST ->
	    root_myst#display_at ximage x y 
(*
      	| `TRANSPARENT ->
	    new display_root_transparent ximage x y 
*)
      | _ ->
	  root#display_at ximage x y
      end
  | _ -> 
      win#display ximage
;;

let display image =
  let image = ref image in

  let get_hist img =
    prog#set_format_string "histgram";
    let hist = Colorhist.create () in
    
    let width = img#width in
    let height = img#height in
    let f_height = float height in
    for y = 0 to height - 1 do
      for x = 0 to width - 1 do
	Colorhist.store_sample hist (img#unsafe_get x y)
      done;
      prog#set_percentage (float (y+1) /. f_height)
    done;
    hist
  in

  List.iter  (function
    | `SIZE(w,h,cond) ->
	let old = !image in
	let mag = 
	  let mag =
	    let xmag = float w /. float old#width
	    and ymag = float h /. float old#height
	    in
	    if xmag > ymag then ymag else xmag
	  in
	  let mag =
	    match cond with
	    | `ALWAYS -> mag
	    | `ATMOST -> if mag > 1.0 then 1.0 else mag
	    | `ATLEAST -> if mag < 1.0 then 1.0 else mag
	  in
  	  let nw = truncate (float old#width *. mag)
  	  and nh = truncate (float old#height *. mag)
	  in
	  if nw > fst root_size || nh > snd root_size then begin
	    let xmag = float (fst root_size) /. float old#width
	    and ymag = float (snd root_size) /. float old#height
	    in
	    if xmag > ymag then ymag else xmag
	  end else mag
	in
	if mag = 1.0 then () 
	else begin
  	  let nw = truncate (float old#width *. mag)
  	  and nh = truncate (float old#height *. mag)
  	  in
	  prog#set_format_string begin
	    if mag > 1.0 then (Printf.sprintf "enlarging to %dx%d" nw nh)
	    else (Printf.sprintf "reducing to %dx%d" nw nh)
	  end;
	  image := old#resize (Some prog#set_percentage) nw nh;
	end
    | `NORMALIZE ->
  	let normalize img = 
        (* Make monochrome *)
	  let hist = get_hist img in
	  let normalizer = Colorhist.normalize 0.95 hist in
	  prog#set_format_string "normalizing...";
	  let width = img#width 
	  and height = img#height in
	  let f_height = float height in
	  for y = 0 to height - 1 do
	    for x = 0 to width - 1 do
	      let rgb = img#unsafe_get x y in
	      let new_rgb = normalizer rgb in
	      img#unsafe_set x y new_rgb;
	    done;
	    prog#set_percentage (float (y+1) /. f_height) 
	  done;
  	in
	normalize !image;
    | `ENHANCE ->
  	let enhance img = 
        (* Make monochrome *)
	  let hist = get_hist img in
	  let log, enhancer = Enhance.enhance 0.90 hist in
(*
	  if log > 0.7 && log < 1.2 then () 
	  else *) begin
	    prog#set_format_string "enhancing...";
	    let width = img#width 
	    and height = img#height in
	    let f_height = float height in
  	    for y = 0 to height - 1 do
  	      for x = 0 to width - 1 do
  		let rgb = img#unsafe_get x y in
  		let new_rgb = enhancer rgb in
  		img#unsafe_set x y new_rgb;
  	      done;
	      prog#set_percentage (float (y+1) /. f_height) 
  	    done;
	  end
  	in
	enhance !image;
    | _ -> () ) !filters;
  (* prerr_endline "display"; *)
  prog#set_format_string "mapping";
  let ximage = OXimage.of_image visual (Some prog#set_percentage) 
      (!image)#coerce in
  display_ximage ximage;
  ximage (* for cache *)
;;