#! /usr/bin/env ocaml
#directory "+libMagick/"
#load "magick.cma"

(* Types *)

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


(* Sources *)

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)


(* list of available sources *)

let sources = [
  ("read_file",    src_from_img);
  ("create_image", src_create_image);
]



(* Filters *)

let flt_blur = (fun layout params ->
  let radius =
    try float_of_string (List.assoc "radius" params)
    with Not_found -> 0.0  (* default *)
  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  (* default *)
  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  (* default *)
  in
  let saturation =
    try int_of_string (List.assoc "saturation" params)
    with Not_found -> 100  (* default *)
  in
  let hue =
    try int_of_string (List.assoc "hue" params)
    with Not_found -> 100  (* default *)
  in
  Magick.Fun.modulate ~brightness ~saturation ~hue () ~img:layout;
  : filter)


(* list of available filters *)

let filters = [
  ("blur",     flt_blur);
  ("edge",     flt_edge);
  ("modulate", flt_modulate);
]



(* Compositors *)

let cmp_composite = (fun layout_1  layout_2  params ->
  let x =
    try int_of_string (List.assoc "x" params)
    with Not_found -> 0  (* default *)
  in
  let y =
    try int_of_string (List.assoc "y" params)
    with Not_found -> 0  (* default *)
  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)


(* list of available compositors *)

let compositors = [
  ("composite", cmp_composite);
]


(* get a function from its name *)

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


(* process_tree *)

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


(* main *)

let _ =
  (* tree datas *)
  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;


(* vim: sw=2 sts=2 ts=2 et fdm=marker
 *)