Module Magick


module Magick: sig .. end

val sizeof_quantum : unit -> int
val sizeof_quantum_bit : unit -> int
type image_handle 
val read_image : filename:string -> image_handle
val get_canvas : width:int -> height:int -> color:string -> image_handle
val create_image : width:int -> height:int -> pseudo_format:string -> image_handle
val clone_image : image_handle -> image_handle
val write_image : image_handle -> filename:string -> unit
val display : image_handle -> unit
val image_to_stdout : image_handle -> unit
val blob_of_image : image_handle -> int list
val dump_to_stdout : image_handle -> unit
val get_image_width : image_handle -> int
val get_image_height : image_handle -> int
val get_image_depth : image_handle -> int
val get_image_quality : image_handle -> int
val get_image_mimetype : image_handle -> string
val get_image_size : image_handle -> string
val get_image_colors : image_handle -> int
val get_image_colorspace : image_handle -> int
val ping_image_infos : string -> int * int * int * int * int * string
val ping_image : string -> bool
val get_number_colors : image_handle -> int
val get_image_histogram : image_handle -> histogram_file:string -> int
val get_max_colormap : unit -> int

type image_type =
| Undefined_image_type
| Bilevel
| Grayscale
| GrayscaleMatte
| Palette
| PaletteMatte
| TrueColor
| TrueColorMatte
| ColorSeparation
| ColorSeparationMatte
| Optimize
val get_image_type : image_handle -> image_type
val string_of_image_type : image_type -> string

type magick_boolean =
| MagickFalse
| MagickTrue
val magick_boolean_of_string : string -> magick_boolean

type noise_type =
| UndefinedNoise
| UniformNoise
| GaussianNoise
| MultiplicativeGaussianNoise
| ImpulseNoise
| LaplacianNoise
| PoissonNoise

type resize_filter =
| Undefined_resize_filter
| Point
| Box
| Triangle
| Hermite
| Hanning
| Hamming
| Blackman
| Gaussian
| Quadratic
| Cubic
| Catrom
| Mitchell
| Lanczos
| Bessel
| Sinc
val resize_filter_of_string : string -> resize_filter
val resize_filter_of_string' : string -> resize_filter
val string_of_resize_filter : resize_filter -> string

type channel_type =
| Undefined_Channel
| Red
| Gray
| Cyan
| Green
| Magenta
| Blue
| Yellow
| Alpha
| Opacity
| Black
| Index
| All_Channels
| Default_Channels
val channel_type_of_string : string -> channel_type
val channel_type_of_string' : string -> channel_type
val string_of_channel_type : channel_type -> string

type composite_operator =
| Undefined_composite_operator
| No_composite_operator
| Add
| Atop
| Blend
| Bumpmap
| Clear
| ColorBurn
| ColorDodge
| Colorize
| CopyBlack
| CopyBlue
| Copy
| CopyCyan
| CopyGreen
| CopyMagenta
| CopyOpacity
| CopyRed
| CopyYellow
| Darken
| DstAtop
| Dst
| DstIn
| DstOut
| DstOver
| Difference
| Displace
| Dissolve
| Exclusion
| HardLight
| Hue
| In
| Lighten
| Luminize
| Minus
| Modulate
| Multiply
| Out
| Over
| Overlay
| Plus
| Replace
| Saturate
| Screen
| SoftLight
| SrcAtop
| Src
| SrcIn
| SrcOut
| SrcOver
| Subtract
| Threshold
| Xor
val composite_operator_of_string : string -> composite_operator
val composite_operator_of_string' : string -> composite_operator
val string_of_composite_operator : composite_operator -> string
module Imper: sig .. end
module Fun: sig .. end
val get_magick_copyright : unit -> string
val get_magick_home_url : unit -> string
val get_magick_release_date : unit -> string
val get_magick_version : unit -> int * string
val get_magick_quantum_depth : unit -> int * string
val get_magick_quantum_range : unit -> int * string
val get_binding_version : unit -> string

type shared_data =
| UI8 of (int, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array3.t
| UI16 of (int, Bigarray.int16_unsigned_elt, Bigarray.c_layout) Bigarray.Array3.t
| UI32 of (int, Bigarray.int32_elt, Bigarray.c_layout) Bigarray.Array3.t
| UI64 of (int, Bigarray.int64_elt, Bigarray.c_layout) Bigarray.Array3.t
val inspect_big_array : ('a, 'b, 'c) Bigarray.Array2.t -> unit
val select : unit -> int
val big_array2_dump : (int, 'a, 'b) Bigarray.Array2.t -> unit
val image_of_bigarray : ('a, 'b, 'c) Bigarray.Array3.t -> image_handle

type coords_2d = {
   x : int;
   y : int;
}
type dimentions = {
   width : int;
   height : int;
}
type bounding_box = {
   pos : coords_2d;
   dims : dimentions;
}
type gradient_spreadMethod =
| Pad_spread
| Repeat_spread
| Reflect_spread
val _linear_gradient : width:int ->
height:int ->
a:coords_2d ->
b:coords_2d ->
?spread_method:gradient_spreadMethod ->
?bounding_box:bounding_box -> unit -> image_handle
val linear_gradient : image_handle ->
a:coords_2d ->
b:coords_2d ->
stop:(float * string) list ->
?matrix:(float * float * float) * (float * float * float) *
(float * float * float) ->
?spread_method:gradient_spreadMethod ->
?bounding_box:bounding_box -> unit -> unit