(***********************************************************************)
(*                                                                     *)
(*                           Objective Caml                            *)
(*                                                                     *)
(*            Franois 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: oImage.ml,v 1.18 2004/09/24 10:02:53 weis Exp $*)

(* Class interface for Images *)

open Images;;

exception Non_supported_method;;
exception Wrong_image_class;;

type image_class =
   | ClassRgb24
   | ClassIndex8
   | ClassIndex16
   | ClassRgba32
   | ClassCmyk32;;

class type imgsize = object
  method width : int
  method height : int
end;;

class type ['a] map = object
  inherit imgsize

  method unsafe_get : int -> int -> 'a
  method unsafe_set : int -> int -> 'a -> unit
  method get : int -> int -> 'a
  method set : int -> int -> 'a -> unit
  method unsafe_access : int -> int -> string * int
end;;

class type oimage = object
  inherit imgsize

  method infos : info list
  method set_infos : info list -> unit

  method image_class : image_class
  method image : Images.t

  method destroy : unit
  method dump : string

  method save : string -> format option -> save_option list -> unit

  method coerce : oimage
end;;

class type rgba32_class = object
  inherit oimage
  inherit [Color.rgba] map

  method sub : int -> int -> int -> int -> rgba32_class
  method blit : int -> int -> rgba32_class -> int -> int -> int -> int -> unit
  method resize : (float -> unit) option -> int -> int -> rgba32_class
end;;

(* Implementation *)

class virtual oimage_impl = object (self)
  method virtual  image_class : image_class
  method virtual image : Images.t

  method virtual width : int
  method virtual height : int

  method virtual infos : info list
  method virtual set_infos : info list -> unit

  method virtual destroy : unit
  method virtual dump : string

  method virtual save : string -> format option -> save_option list -> unit

  method coerce =
    (self :> < image : _; image_class : _; width : _; height : _;
               infos : _; set_infos : _;
               destroy : _; dump : _; save : _; coerce : _ >)
end;;

open Rgba32;;

class rgba32_wrapper img = object (self)
  inherit oimage_impl

  method image_class = ClassRgba32
  method image = Images.Rgba32 img

  method width = img.width
  method height = img.height
  method infos = img.infos
  method dump = dump img

  method set_infos infos = img.infos <- infos

  method unsafe_access = unsafe_access img
  method unsafe_get = unsafe_get img
  method unsafe_set = unsafe_set img
  method get = get img
  method set = set img

  method destroy = destroy img

  method sub x y w h = new rgba32_wrapper (sub img x y w h)
  method blit sx sy (dst : rgba32_class) =
    Images.blit (Rgba32 img) sx sy dst#image
  method resize prog nw nh = new rgba32_wrapper (resize prog img nw nh)

  method save name format opts = Images.save name format opts (Rgba32 img)
end;;

class rgba32 width height = object
  inherit rgba32_wrapper (create width height)
end;;

class rgba32_filled width height init = object
  inherit rgba32_wrapper (make width height init)
end;;

class rgba32_with width height data bitmap = object
  inherit rgba32_wrapper (create_with width height data bitmap)
end;;

open Rgb24;;

class type rgb24_class = object
  inherit oimage
  inherit [Color.rgb] map

  method sub : int -> int -> int -> int -> rgb24_class
  method blit : int -> int -> rgb24_class -> int -> int -> int -> int -> unit
  method resize : (float -> unit) option -> int -> int -> rgb24_class
  method to_rgba32 : rgba32_class
end;;

class rgb24_wrapper img = object (self)
  inherit oimage_impl

  method image_class = ClassRgb24
  method image = Images.Rgb24 img

  method width = img.width
  method height = img.height
  method infos = img.infos
  method dump = dump img

  method set_infos infos = img.infos <- infos

  method unsafe_access = unsafe_access img
  method unsafe_get = unsafe_get img
  method unsafe_set = unsafe_set img
  method get = get img
  method set = set img

  method destroy = destroy img

  method sub x y w h = new rgb24_wrapper (sub img x y w h)
  method blit sx sy (dst : rgb24_class) =
    Images.blit (Rgb24 img) sx sy dst#image
  method resize prog nw nh = new rgb24_wrapper (resize prog img nw nh)

  method save name format opts = Images.save name format opts (Rgb24 img)

  method to_rgba32 = new rgba32_wrapper (Rgb24.to_rgba32 img)
end;;

class rgb24 width height = object
  inherit rgb24_wrapper (create width height)
end;;

class rgb24_filled width height init = object
  inherit rgb24_wrapper (make width height init)
end;;

class rgb24_with width height data bitmap = object
  inherit rgb24_wrapper (create_with width height data bitmap)
end;;

open Index8;;

class type index8_class = object
  inherit oimage
  inherit [Index8.elt] map
  inherit OColor.rgbmap

  method sub : int -> int -> int -> int -> index8_class
  method blit : int -> int -> index8_class -> int -> int -> int -> int -> unit
  method get_color : int -> int -> Color.rgb
  method unsafe_get_color : int -> int -> Color.rgb
  method transparent : Index8.elt
  method set_transparent : Index8.elt -> unit

  method to_rgb24 : rgb24_class
  method to_rgba32 : rgba32_class
end;;

class index8_wrapper img = object (self)
  inherit oimage_impl
  inherit OColor.rgbmap img.colormap as colormap

  method image_class = ClassIndex8
  method image = Index8 img

  method width = img.width
  method height = img.height
  method transparent = img.transparent
  method infos = img.infos
  method dump = dump img

  method set_transparent c = img.transparent <- c
  method set_infos infos = img.infos <- infos

  method unsafe_access = unsafe_access img
  method unsafe_get = unsafe_get img
  method unsafe_set = unsafe_set img
  method get = get img
  method set = set img

  method get_color x y = self#query_color (self#get x y)
  method unsafe_get_color x y = self#query_color (self#unsafe_get x y)

  method destroy = destroy img

  method sub x y w h = new index8_wrapper (Index8.sub img x y w h)
  method blit sx sy (dst : index8_class) =
    Images.blit (Index8 img) sx sy dst#image

  method save name format opts = Images.save name format opts (Index8 img)

  method to_rgb24 = new rgb24_wrapper (Index8.to_rgb24 img)
  method to_rgba32 = new rgba32_wrapper (Index8.to_rgba32 img)
end;;

class index8 width height = object
  inherit index8_wrapper (create width height)
end;;

class index8_filled width height init = object
  inherit index8_wrapper (make width height init)
end;;

class index8_with width height infos cmap trans bitmap = object
  inherit index8_wrapper (create_with width height infos cmap trans bitmap)
end;;

open Index16;;

class type index16_class = object
  inherit oimage
  inherit [Index16.elt] map
  inherit OColor.rgbmap

  method sub : int -> int -> int -> int -> index8_class
  method blit : int -> int -> index8_class -> int -> int -> int -> int -> unit
  method get_color : int -> int -> Color.rgb
  method unsafe_get_color : int -> int -> Color.rgb
  method transparent : Index16.elt
  method set_transparent : Index16.elt -> unit

  method to_rgb24 : rgb24_class
  method to_rgba32 : rgba32_class
end;;

class index16_wrapper img = object (self)
  inherit oimage_impl
  inherit OColor.rgbmap img.colormap as colormap

  method image_class = ClassIndex16
  method image = Index16 img

  method width = img.width
  method height = img.height
  method transparent = img.transparent
  method infos = img.infos
  method dump = dump img

  method set_transparent c = img.transparent <- c
  method set_infos infos = img.infos <- infos

  method unsafe_access = unsafe_access img
  method unsafe_get = unsafe_get img
  method unsafe_set = unsafe_set img
  method get = get img
  method set = set img

  method get_color x y = self#query_color (self#get x y)
  method unsafe_get_color x y = self#query_color (self#unsafe_get x y)

  method destroy = destroy img

  method sub x y w h = new index16_wrapper (Index16.sub img x y w h)
  method blit sx sy (dst : index16_class) =
    Images.blit (Index16 img) sx sy dst#image

  method to_rgb24 = new rgb24_wrapper (Index16.to_rgb24 img)
  method to_rgba32 = new rgba32_wrapper (Index16.to_rgba32 img)

  method save name format opts = Images.save name format opts (Index16 img)
end;;

class index16 width height = object
  inherit index16_wrapper (create width height)
end;;

class index16_filled width height init = object
  inherit index16_wrapper (make width height init)
end;;

class index16_with width height infos cmap trans bitmap = object
  inherit index16_wrapper (create_with width height infos cmap trans bitmap)
end;;

open Cmyk32;;

class type cmyk32_class = object
  inherit oimage
  inherit [Color.cmyk] map

  method sub : int -> int -> int -> int -> cmyk32_class
  method blit : int -> int -> cmyk32_class -> int -> int -> int -> int -> unit
  method resize : (float -> unit) option -> int -> int -> cmyk32_class
end;;

class cmyk32_wrapper img = object (self)
  inherit oimage_impl

  method image_class = ClassCmyk32
  method image = Images.Cmyk32 img

  method width = img.width
  method height = img.height
  method infos = img.infos
  method dump = dump img

  method set_infos infos = img.infos <- infos

  method unsafe_access = unsafe_access img
  method unsafe_get = unsafe_get img
  method unsafe_set = unsafe_set img
  method get = get img
  method set = set img

  method destroy = destroy img

  method sub x y w h = new cmyk32_wrapper (sub img x y w h)
  method blit sx sy (dst : cmyk32_class) =
    Images.blit (Cmyk32 img) sx sy dst#image
  method resize prog nw nh = new cmyk32_wrapper (resize prog img nw nh)

  method save name format opts = Images.save name format opts (Cmyk32 img)
end;;

class cmyk32 width height = object
  inherit cmyk32_wrapper (create width height)
end;;

class cmyk32_filled width height init = object
  inherit cmyk32_wrapper (make width height init)
end;;

class cmyk32_with width height data bitmap = object
  inherit cmyk32_wrapper (create_with width height data bitmap)
end;;

type tagged =
   | Rgb24 of rgb24_class
   | Index8 of index8_class
   | Index16 of index16_class
   | Rgba32 of rgba32_class
   | Cmyk32 of cmyk32_class;;

let rgb24 oimage =
  if oimage#image_class = ClassRgb24 then (Obj.magic oimage : rgb24_class)
  else raise Wrong_image_class;;

let index8 oimage =
  if oimage#image_class = ClassIndex8 then (Obj.magic oimage : index8_class)
  else raise Wrong_image_class;;

let index16 oimage =
  if oimage#image_class = ClassIndex16 then (Obj.magic oimage : index16_class)
  else raise Wrong_image_class;;

let rgba32 oimage =
  if oimage#image_class = ClassRgba32 then (Obj.magic oimage : rgba32_class)
  else raise Wrong_image_class;;

let cmyk32 oimage =
  if oimage#image_class = ClassCmyk32 then (Obj.magic oimage : cmyk32_class)
  else raise Wrong_image_class;;

let tag img =
  match img#image_class with
  | ClassRgb24 -> Rgb24 (Obj.magic img : rgb24_class)
  | ClassIndex8 -> Index8 (Obj.magic img : index8_class)
  | ClassIndex16 -> Index16 (Obj.magic img : index16_class)
  | ClassRgba32 -> Rgba32 (Obj.magic img : rgba32_class)
  | ClassCmyk32 -> Cmyk32 (Obj.magic img : cmyk32_class);;

let make = function
  | Images.Index8 img -> (new index8_wrapper img)#coerce
  | Images.Rgb24 img -> (new rgb24_wrapper img)#coerce
  | Images.Index16 img -> (new index16_wrapper img)#coerce
  | Images.Rgba32 img -> (new rgba32_wrapper img)#coerce
  | Images.Cmyk32 img -> (new cmyk32_wrapper img)#coerce;;

let sub img x y w h =
  match tag img with
  | Rgb24 i -> (i#sub x y w h)#coerce
  | Index8 i -> (i#sub x y w h)#coerce
  | Index16 i -> (i#sub x y w h)#coerce
  | Rgba32 i -> (i#sub x y w h)#coerce
  | Cmyk32 i -> (i#sub x y w h)#coerce;;

let load filename load_options = make (Images.load filename load_options);;