(***********************************************************************)
(*                                                                     *)
(*                           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 Color
open Bitmap

type elt = Color.rgb

type t = {
    width: int;
    height: int;
    mutable infos: Info.info list;
    data: Bitmap.t
  } 

let create_with width height init_buffer =
  { width= width;
    height= height;
    infos= [];
    data= Bitmap.create_with 3 width height init_buffer }
;;

let create width height =
  { width= width;
    height= height;
    infos= [];
    data= Bitmap.create 3 width height None }
;;

let make width height init =
  let init = 
    let s = String.create 3 in
    s.[0] <- char_of_int init.r;
    s.[1] <- char_of_int init.g;
    s.[2] <- char_of_int init.b;
    Some s
  in
  { width= width;
    height= height;
    infos= [];
    data= Bitmap.create 3 width height init }
;;

let unsafe_get_raw t = t.data.access;;

let unsafe_get t x y =
  let str, pos = t.data.access x y in
  { r= int_of_char str.[pos    ];
    g= int_of_char str.[pos + 1];
    b= int_of_char str.[pos + 2] }
;;

let unsafe_set t x y c =
  let str, pos = t.data.access x y in
  str.[pos    ] <- char_of_int c.r;
  str.[pos + 1] <- char_of_int c.g;
  str.[pos + 2] <- char_of_int c.b
;;

let get t x y = 
  Region.check t.width t.height x y;
  unsafe_get t x y
;;

let set t x y c =
  Region.check t.width t.height x y;
  unsafe_set t x y c
;;

let destroy t =
  Bitmap.destroy t.data
;;

let sub src x y w h =
  { width= w;
    height= h;
    infos= [];
    data= Bitmap.sub src.data x y w h }
;;

let blit src sx sy dst dx dy w h =
  Bitmap.blit src.data sx sy dst.data dx dy w h
;;

(* image resize with smoothing *)
(* good result for reducing *)
let resize_reduce prog img nw nh =
  let newimage = create nw nh in
  let xscale = float nw /. float img.width in  
  let yscale = float nh /. float img.height in  
  
  let xs = Array.init nw (fun x -> 
    let sx = truncate (float x /. xscale) in
    let ex = truncate ((float x +. 0.99) /. xscale) in
    let dx = ex - sx + 1 in
    (sx, ex, dx))
  in
  let ys = Array.init nh (fun y -> 
    let sy = truncate (float y /. yscale) in
    let ey = truncate ((float y +. 0.99) /. yscale) in
    let dy = ey - sy + 1 in
    (sy, ey, dy))
  in
  for x = 0 to nw - 1 do
    let sx,ex,dx = xs.(x) in
    for y = 0 to nh - 1 do
      let sy,ey,dy = ys.(y) in
      
      let size = dx * dy in
      let sr = ref 0
      and sg = ref 0
      and sb = ref 0
      in
      for xx = sx to ex do
  	for yy = sy to ey do
  	  let c = unsafe_get img xx yy in
  	  sr := !sr + c.r;
  	  sg := !sg + c.g;
  	  sb := !sb + c.b
  	done
      done;
      unsafe_set newimage x y { r=(!sr/size);
				g=(!sg/size);
				b=(!sb/size) }
    done;

    match prog with
      Some p -> p (float (x + 1) /. float nw)
    | None -> ()
  done;
  newimage
;;

let resize_enlarge prog img nw nh =
  let newimage = create nw nh in
  let xscale = float nw /. float img.width in  
  let yscale = float nh /. float img.height in  

  let ww = truncate (ceil xscale)
  and wh = truncate (ceil yscale)
  in

  let weight =
    Array.init ww (fun x ->
      Array.init wh (fun y ->
	let x0 = x - ww / 2 
	and y0 = y - wh / 2 in
	let x1 = x0 + ww - 1 
	and y1 = y0 + wh - 1 in
	let a = Array.init 3 (fun xx ->
	  Array.init 3 (fun yy ->
	    let mx0 = (xx-1) * ww 
	    and my0 = (yy-1) * ww in
	    let mx1 = mx0 + ww - 1 
	    and my1 = my0 + wh - 1 in

	    let cx0 = if x0 < mx0 then mx0 else x0 in 
	    let cy0 = if y0 < my0 then my0 else y0 in
	    let cx1 = if x1 > mx1 then mx1 else x1 in
	    let cy1 = if y1 > my1 then my1 else y1 in
	    
	    let dx = cx1 - cx0 + 1
	    and dy = cy1 - cy0 + 1
	    in
	    let w = if dx < 0 || dy < 0 then 0 else dx * dy in
	    w
	    ))
	in a ))
  in

  let wsum =
    Array.init ww (fun x ->
      Array.init wh (fun y ->
	let sum = ref 0 in
	Array.iter (Array.iter (fun w ->
	  sum := !sum + w)) weight.(x).(y);
	if !sum = 0 then raise (Failure "resize_enlarge wsum");
	!sum))
  in

  let xs = Array.init img.width (fun x -> 
    let sx = truncate (float x *. xscale) in
    let ex = truncate (float (x+1) *. xscale) - 1 in
    let dx = ex - sx + 1 in
    if dx > ww then raise (Failure "resize_enlarge");
    (sx, ex, dx))
  in
  let ys = Array.init img.height (fun y -> 
    let sy = truncate (float y *. yscale) in
    let ey = truncate ((float (y+1)) *. yscale) - 1 in
    let dy = ey - sy + 1 in
    if dy > wh then raise (Failure "resize_enlarge");
    (sy, ey, dy))
  in

  let query c x y =
    if x < 0 || y < 0 || x >= img.width || y >= img.height then
      c 
    else unsafe_get img x y 
  in
    
  for y = 0 to img.height - 1 do
    let sy,ey,dy = ys.(y) in

    
    for x = 0 to img.width - 1 do
      let sx,ex,dx = xs.(x) in
      
      let colors =
 	let c = unsafe_get img x y in
	Array.init 3 (fun dx ->
	  Array.init 3 (fun dy ->
	    query c (x+dx-1) (y+dy-1)))
      in

      for xx = 0 to dx - 1 do
	for yy = 0 to dy - 1 do
	  let sr = ref 0
	  and sg = ref 0
	  and sb = ref 0
	  in
	  let weight = weight.(xx).(yy) in
	  let wsum = wsum.(xx).(yy) in
	  for xxx = 0 to 2 do
	    for yyy = 0 to 2 do
	      let c = colors.(xxx).(yyy) in
	      sr := !sr + c.r * weight.(xxx).(yyy);
	      sg := !sg + c.g * weight.(xxx).(yyy);
	      sb := !sb + c.b * weight.(xxx).(yyy);
	    done
	  done;
	  unsafe_set newimage (sx + xx) (sy + yy)
	    {r= !sr / wsum; g= !sg / wsum; b= !sb / wsum} 
	done
      done
    done;

    match prog with
      Some p -> p (float (y + 1) /. float img.height)
    | None -> ()

  done;
  newimage
;;

(*
let resize_enlarge prog img nw nh =
  let newimage = create nw nh in
  let xscale = float nw /. float img.width in  
  let yscale = float nh /. float img.height in  

  let ww = truncate (ceil xscale)
  and wh = truncate (ceil yscale)
  in

  prerr_endline (Printf.sprintf "%d,%d" ww wh);
  let xs = Array.init img.width (fun x -> 
    let sx = truncate (float x *. xscale) in
    let ex = truncate (float (x+1) *. xscale) - 1 in
    let dx = ex - sx + 1 in
    if dx > ww then raise (Failure "resize_enlarge");
    (sx, ex, dx))
  in
  let ys = Array.init img.height (fun y -> 
    let sy = truncate (float y *. yscale) in
    let ey = truncate ((float (y+1)) *. yscale) - 1 in
    let dy = ey - sy + 1 in
    if dy > wh then raise (Failure "resize_enlarge");
    (sy, ey, dy))
  in

  for y = 0 to img.height - 1 do
    let sy,ey,dy = ys.(y) in

    
    for x = 0 to img.width - 1 do
      let sx,ex,dx = xs.(x) in
      
      let c = unsafe_get img x y in

      for xx = 0 to dx - 1 do
	for yy = 0 to dy - 1 do
	  unsafe_set newimage (sx + xx) (sy + yy) c
	done
      done
    done;

    match prog with
      Some p -> p (float (y + 1) /. float img.height)
    | None -> ()

  done;
  newimage
;;
*)

let resize prog img nw nh =
  let xscale = float nw /. float img.width in  
  let yscale = float nh /. float img.height in 
  if xscale >= 1.0 && yscale >= 1.0 then resize_enlarge prog img nw nh
  else if xscale <= 1.0 && yscale <= 1.0 then resize_reduce prog img nw nh
  else resize_reduce prog img nw nh
 
let to_rgba32 t =
  let rgba32 = Rgba32.create t.width t.height in
  for y = 0 to t.height - 1 do
    for x = 0 to t.width - 1 do
      Rgba32.unsafe_set rgba32 x y 
	{ color= unsafe_get t x y;
	  alpha= 255 }
    done
  done;
  rgba32
;;

