#directory "+libMagick/"
#load "magick.cma"
type layer = Magick.image_handle
type parameters = (string * string) list
type source = (parameters -> layer)
type filter = (layer -> parameters -> layer)
type compositor = (layer -> layer -> parameters -> layer)
type tree =
| Source of source * parameters
| Filter of filter * parameters * tree
| Compositor of compositor * parameters * tree * tree
let src_from_img = (fun params ->
let filename =
try List.assoc "filename" params
with Not_found -> invalid_arg "filename"
in
Magick.read_image ~filename : source)
let src_create_image = (fun params ->
let width =
try int_of_string (List.assoc "width" params)
with Not_found -> invalid_arg "width"
in
let height =
try int_of_string (List.assoc "height" params)
with Not_found -> invalid_arg "height"
in
let pseudo_format =
try List.assoc "pseudo_format" params
with Not_found -> invalid_arg "pseudo_format"
in
Magick.create_image ~width ~height ~pseudo_format : source)
let sources = [
("read_file", src_from_img);
("create_image", src_create_image);
]
let flt_blur = (fun layout params ->
let radius =
try float_of_string (List.assoc "radius" params)
with Not_found -> 0.0
in
let sigma =
try float_of_string (List.assoc "sigma" params)
with Not_found -> invalid_arg "sigma"
in
Magick.Fun.blur ~radius ~sigma () ~img:layout;
: filter)
let flt_edge = (fun layout params ->
let radius =
try float_of_string (List.assoc "radius" params)
with Not_found -> 0.0
in
Magick.Fun.edge ~radius () ~img:layout;
: filter)
let flt_modulate = (fun layout params ->
let brightness =
try int_of_string (List.assoc "brightness" params)
with Not_found -> 100
in
let saturation =
try int_of_string (List.assoc "saturation" params)
with Not_found -> 100
in
let hue =
try int_of_string (List.assoc "hue" params)
with Not_found -> 100
in
Magick.Fun.modulate ~brightness ~saturation ~hue () ~img:layout;
: filter)
let filters = [
("blur", flt_blur);
("edge", flt_edge);
("modulate", flt_modulate);
]
let cmp_composite = (fun layout_1 layout_2 params ->
let x =
try int_of_string (List.assoc "x" params)
with Not_found -> 0
in
let y =
try int_of_string (List.assoc "y" params)
with Not_found -> 0
in
let compose =
try Magick.Imper.composite_operator_of_string (List.assoc "compose" params)
with Not_found -> invalid_arg "compose"
in
Magick.Imper.composite_image layout_1 layout_2 ~compose ~x ~y ();
layout_1 : compositor)
let compositors = [
("composite", cmp_composite);
]
let get_src_fun ~fun_name =
List.assoc fun_name sources
let get_flt_fun ~fun_name =
List.assoc fun_name filters
let get_cmp_fun ~fun_name =
List.assoc fun_name compositors
let rec process_tree tree =
let rec dig tree = match tree with
| Source (src_fun, params) -> src_fun params
| Filter (flt_fun, params, tree) -> flt_fun (dig tree) params
| Compositor (cmp_fun, params, tree1, tree2) -> cmp_fun (dig tree1) (dig tree2) params
in
dig tree
let _ =
let tree =
(Filter (flt_edge, [("radius","9.6")],
(Filter (flt_modulate, [("saturation","60")],
(Filter (flt_blur, [("sigma","4.0")],
(Filter (flt_edge, [("radius","8.0")],
(Source (src_create_image,
[("width","300"); ("height","200"); ("pseudo_format","plasma:#F73-#4F3")]
))
))
))
))
))
in
let img = process_tree tree in
Magick.display img;