(***********************************************************************)
(*                                                                     *)
(*                           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.rgba

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 4 width height init_buffer }
;;

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

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

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

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

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 *)
let resize 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  
  for y = 0 to nh - 1 do
    for x = 0 to nw - 1 do
      let sx = truncate (float x /. xscale)
      and sy = truncate (float y /. yscale)
      in
      let ex = truncate ((float x +. 0.99) /. xscale)
      and ey = truncate ((float y +. 0.99) /. yscale)
      in
(*
      let ex = if ex >= img.width then img.width - 1 else ex
      and ey = if ey >= img.height then img.height - 1 else ey
      in
*)
      let size = (ex - sx + 1) * (ey - sy + 1) in
      let sr = ref 0
      and sg = ref 0
      and sb = ref 0
      and sa = 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.color.r;
  	  sg := !sg + c.color.g;
  	  sb := !sb + c.color.b;
	  sa := !sa + c.alpha
  	done
      done;
      unsafe_set newimage x y { color = { r=(!sr/size);
					  g=(!sg/size);
					  b=(!sb/size) };
				alpha = (!sa/size) }
    done;

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

  done;
  newimage
;;
