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

type rgb = { mutable r: int; mutable g: int; mutable b: int }

type rgba = { color: rgb; mutable alpha: int }

type cmyk = { mutable c : int; mutable m : int; mutable y : int;
	      mutable k : int }

type map = {
    mutable max: int;  
      (* maximum number allowed in the color map (-1 = unlimited) *)
    mutable map: rgb array
  } 

let rgb_square_distance c1 c2 =
  let dr = c1.r - c2.r 
  and dg = c1.g - c2.g
  and db = c1.b - c2.b in 
  dr * dr + dg * dg + db * db
;;

let plus rgb rgb' =
  { r= rgb.r + rgb'.r;
    g= rgb.g + rgb'.g;
    b= rgb.b + rgb'.b }

let minus rgb rgb' =
  { r= rgb.r - rgb'.r;
    g= rgb.g - rgb'.g;
    b= rgb.b - rgb'.b }

let size cmap = Array.length cmap.map
;;

let find_exact cmap rgb =
  let found = ref 0 in
  let map = cmap.map in
  try for i = 0 to Array.length map - 1 do
    let rgb' = map.(i) in
    if rgb = rgb' then begin found := i; raise Exit end
  done; raise Not_found
  with Exit -> !found
;;

let find_nearest cmap rgb =
  let found = ref (-1) in
  let diff = ref (-1) in
  let map = cmap.map in
  for i = 0 to Array.length map - 1 do
    let rgb' = map.(i) in
    let d = rgb_square_distance rgb rgb' in
    if !diff < 0 || d < !diff then begin
      diff := d;
      found := i
    end
  done;
  if !found = -1 then raise Not_found else !found
;;

let add_color cmap c1 =
  try
    find_exact cmap c1
  with
    Not_found ->
      let len = size cmap in
      if cmap.max >= 0 && len = cmap.max then raise Too_many_colors;
      cmap.map <- Array.append cmap.map [|c1|];
      len

let add_colors cmap cs =
  let ret, not_exist =
    List.fold_right (fun c (ret,not_exist) ->
      try 
	let found = find_exact cmap c in
	(Some found :: ret), not_exist
      with
	Not_found -> (None :: ret), (c :: not_exist)) cs ([],[])
  in
  let len = size cmap in
  if cmap.max >= 0 && len + List.length not_exist > cmap.max then 
    raise Too_many_colors;
  cmap.map <- Array.append cmap.map (Array.of_list not_exist);
  let cntr = ref len in
  List.map (function
      (Some x) -> x
    | None -> let x = !cntr in incr cntr; x) ret

let copy cmap = 
  { max= cmap.max;
    map= Array.copy cmap.map }
(*
let brightness c = (c.r * 88 + c.g * 127 + c.b * 40) / 255 

XV setting
*)

let brightness c = (c.r * 54 + c.g * 182 + c.b * 19) / 255 
(*
  Y = 0.212671 * R + 0.715160 * G + 0.072169 * B;

ITU-R Recommendation BT.709, Basic Parameter Values for the HDTV
Standard for the Studio and for International Programme Exchange (1990),
[formerly CCIR Rec. 709], ITU, 1211 Geneva 20, Switzerland.
*)

(********************************************************* Color name parser *)

let color_name_table = ref None

let color_table_load () =
  let ic = open_in Camlimages.path_rgb_txt in
  let table = Hashtbl.create 107 in
  try while true do
    let s = input_line ic in
    if s.[0] = '!' then ()
    else begin
      let tokens = 
	Mstring.split_str (function ' ' | '\t' -> true | _ -> false) s
      in
      match tokens with
	r :: g :: b :: rest ->
	  Hashtbl.add table (Mstring.catenate_sep " " rest) 
	    {r= int_of_string r; g= int_of_string g; b= int_of_string b}
      |	_ -> assert false
    end
  done; raise Exit with
  | End_of_file -> 
      close_in ic;
      color_name_table := Some table;
      table

let color_name_query c =
  let table = 
    match !color_name_table with
      Some t -> t
    | None -> color_table_load ()
  in
  Hashtbl.find table c

let color_parse c =
  try
    if c = "none" || c = "None" then {r= -1; g= -1; b= -1}
    else if c.[0] = '#' then begin
      match String.length c with
      |	7 ->
  	  let r = int_of_string ("0x" ^ String.sub c 1 2)
  	  and g = int_of_string ("0x" ^ String.sub c 3 2)
  	  and b = int_of_string ("0x" ^ String.sub c 5 2)
  	  in
  	  {r= r; g= g; b= b} 
      | 13 ->
  	  let r = int_of_string ("0x" ^ String.sub c 1 4) / 256
  	  and g = int_of_string ("0x" ^ String.sub c 5 4) / 256
  	  and b = int_of_string ("0x" ^ String.sub c 9 4) / 256
  	  in
  	  {r= r; g= g; b= b} 
      | _ ->
  	  raise Exit
    end else
      color_name_query c
  with
  | _ -> raise (Failure (Printf.sprintf "Color parse %s failed" c))
	
let colormap_parse cmap =
  let transparent = ref (-1) in
  let cmap = Array.map color_parse cmap in
  for i = 0 to Array.length cmap - 1 do
    let c = cmap.(i) in
    if c.r < 0 then begin
      c.r <- 0; c.g <- 255; c.b <- 0;
      transparent := i;
      prerr_endline (Printf.sprintf "transparent= %d" i);
    end
  done;
  cmap, !transparent
