(***********************************************************************)
(*                                                                     *)
(*                           Objective Caml                            *)
(*                                                                     *)
(*            François Pessaux, projet Cristal, INRIA Rocquencourt     *)
(*            Pierre Weis, projet Cristal, INRIA Rocquencourt          *)
(*            Jun Furuse, projet Cristal, INRIA Rocquencourt           *)
(*                                                                     *)
(*  Copyright 1999-2004,                                               *)
(*  Institut National de Recherche en Informatique et en Automatique.  *)
(*  Distributed only by permission.                                    *)
(*                                                                     *)
(***********************************************************************)

(* $Id: cmyk32.ml,v 1.4 2009/07/04 03:39:28 furuse Exp $*)

(* CMYK 32 bit depth image format *)

module E = struct
  open Color
  type t = Color.cmyk
  let bytes_per_pixel = 4
  let get str pos =
    { c = int_of_char str.[pos    ];
      m = int_of_char str.[pos + 1];
      y = int_of_char str.[pos + 2];
      k = int_of_char str.[pos + 3]; }
  let set str pos t =
    str.[pos    ] <- char_of_int t.c;
    str.[pos + 1] <- char_of_int t.m;
    str.[pos + 2] <- char_of_int t.y;
    str.[pos + 3] <- char_of_int t.k
  let make t =
    let str = String.create bytes_per_pixel in
    set str 0 t;
    str
end;;

module RI = Genimage.MakeRawImage(E);;

type rawimage = RI.t;;
type elt = Color.cmyk;;
type t = {
  width : int;
  height : int;
  rawimage : RI.t;
  mutable infos : Info.info list;
 };;

module C = struct
  type rawimage = RI.t
  type container = t
  let rawimage x = x.rawimage
  let create_default width height rawimage =
    { width = width;
      height = height;
      rawimage = rawimage;
      infos = []; }
  let create_duplicate src width height rawimage =
    { width = width;
      height = height;
      rawimage = rawimage;
      infos = src.infos; }
end;;

module IMAGE = Genimage.Make(RI)(C);;

let create_with width height infos data =
  { width = width;
    height = height;
    rawimage = RI.create_with width height data;
    infos = infos; };;

let create_with_scanlines width height infos data =
  { width = width;
    height = height;
    rawimage = RI.create_with_scanlines width height data;
    infos = infos; };;

let rawimage = C.rawimage;;
let create = IMAGE.create;;
let make = IMAGE.make;;
let dump = IMAGE.dump;;
let unsafe_access = IMAGE.unsafe_access;;
let get_strip = IMAGE.get_strip;;
let set_strip = IMAGE.set_strip;;
let get_scanline = IMAGE.get_scanline;;
let set_scanline = IMAGE.set_scanline;;
let unsafe_get = IMAGE.unsafe_get;;
let unsafe_set = IMAGE.unsafe_set;;
let get = IMAGE.get;;
let set = IMAGE.set;;
let destroy = IMAGE.destroy;;
let copy = IMAGE.copy;;
let sub = IMAGE.sub;;
let blit = IMAGE.blit;;
let map = IMAGE.map;;
let blocks = IMAGE.blocks;;
let dump_block = IMAGE.dump_block;;
 
open Color;;

(* 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 start_x = truncate (float x /. xscale)
      and start_y = truncate (float y /. yscale)
      in
      let end_x = truncate ((float x +. 0.99) /. xscale)
      and end_y = truncate ((float y +. 0.99) /. yscale) in
      let size = (end_x - start_x + 1) * (end_y - start_y + 1) in
      let sc = ref 0
      and sm = ref 0
      and sy = ref 0
      and sk = ref 0 in
      for xx = start_x to end_x do
        for yy = start_y to end_y do
          let c = unsafe_get img xx yy in
          sc := !sc + c.c;
          sm := !sm + c.m;
          sy := !sy + c.y;
          sk := !sk + c.k;
        done
      done;
      unsafe_set newimage x y
        { c = !sc / size;
          m = !sm / size;
          y = !sy / size;
          k = !sk / size; }
    done;
    match prog with
    | Some p -> p (float (y + 1) /. float nh)
    | None -> ()
  done;
  newimage;;
