(* {{{ COPYING *)
(*
 * +-----------------------------------------------------------------+
 * | Copyright (C) 2006 Florent Monnier                              |
 * +-----------------------------------------------------------------+
 * | This is a sandbox to provide higher level UI to OCaml-libMagick |
 * +-----------------------------------------------------------------+
 * |                                                                 |
 * | This program is free software; you can redistribute it and/or   |
 * | modify it under the terms of the GNU General Public License     |
 * | as published by the Free Software Foundation; either version 2  |
 * | of the License, or (at your option) any later version.          |
 * |                                                                 |
 * | This program is distributed in the hope that it will be useful, |
 * | but WITHOUT ANY WARRANTY; without even the implied warranty of  |
 * | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the   |
 * | GNU General Public License for more details.                    |
 * |                                                                 |
 * | http://www.fsf.org/licensing/licenses/gpl.html                  |
 * |                                                                 |
 * | You should have received a copy of the GNU General Public       |
 * | License along with this program; if not,                        |
 * | write to the Free Software Foundation, Inc.,                    |
 * | 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA    |
 * |                                                                 |
 * +-----------------------------------------------------------------+
 * | Author: Florent Monnier <monnier.florent(_)gmail.com>           |
 * +-----------------------------------------------------------------+
 *
 * }}} *)

(* {{{ Utilities *)

(* {{{ is_dir_writable *)

let is_dir_writable ~path =
  let stats = Unix.stat path in
  if stats.Unix.st_kind <> Unix.S_DIR  (* is it a directory? *)
  then false
  else if (stats.Unix.st_perm land 0o200) = 0  (* is the directory writable? *)
    then false
    else true
;;
(* }}} *)

(* }}} *)
(* {{{ Types *)

(* {{{ parameters types *)

type int_t =
  | Int of int
  | Int_t of (t:int -> int)
  | Int_p of (percent:float -> int)
  | Int_ft of (frames:int -> t:int -> int)

type float_t =
  | Float of float
  | Float_t of (t:int -> float)
  | Float_p of (percent:float -> float)
  | Float_ft of (frames:int -> t:int -> float)

type string_t =
  | String of string
  | String_t of (t:int -> string)
  | String_p of (percent:float -> string)
  | String_ft of (frames:int -> t:int -> string)

type bz_t =
  | BZ of (int * int) array
  | BZ_t of (t:int -> (int * int) array)
  | BZ_p of (percent:float -> (int * int) array)
  | BZ_ft of (frames:int -> t:int -> (int * int) array)

(* }}} *)
(* {{{ layer tree types *)

type layer = Magick.image_handle

type source =
  | Source_A of (int -> int -> string -> unit -> layer) * int_t * int_t * string_t
  | Source_B of (string -> unit -> layer) * string_t
  | Source_ext of layer

type filter =
  | Filter_0  of (img:layer -> layer)
  | Filter_1i of (int -> img:layer -> layer) * int_t
  | Filter_1s of (string -> img:layer -> layer) * string_t
  | Filter_1f of (float -> img:layer -> layer) * float_t
  | Filter_2f of (float -> float -> img:layer -> layer) * float_t * float_t
  | Filter_3f of (float -> float -> float -> img:layer -> layer) * float_t * float_t * float_t
  | Filter_2i of (int -> int -> img:layer -> layer) * int_t * int_t
  | Filter_3i of (int -> int -> int -> img:layer -> layer) * int_t * int_t * int_t
  | Filter_4i of (int -> int -> int -> int -> img:layer -> layer) * int_t * int_t * int_t * int_t
  | Filter_BZ of (string -> float -> (int * int) array -> img:layer -> layer) * string_t * float_t * bz_t
  | Filter_sf4i of (string -> float -> int -> int -> int -> int -> img:layer -> layer)
                   * string_t * float_t * int_t * int_t * int_t * int_t
  | Filter_1T of (Magick.image_type -> img:layer -> layer) * Magick.image_type

type compositor =
  | Compose_0  of (img_a:layer -> img_b:layer -> layer)
  | Compose_1C of (Magick.composite_operator -> img_a:layer -> img_b:layer -> layer) * Magick.composite_operator
  | Compose_1f of (float -> img_a:layer -> img_b:layer -> layer) * float_t

type clipper =
  | Clipper_0 of (img_a:layer -> img_b:layer -> img_c:layer -> layer)

type layers_tree =
  | Leaf of (source)
  | Edge of (filter * layers_tree)
  | Node2 of (compositor * layers_tree * layers_tree)
  | Node3 of (clipper * layers_tree * layers_tree * layers_tree)
  | Cached of layer

(* }}} *)

(* }}} *)
(* {{{ Main *)

(* {{{ get_frame_at_t *)

let get_frame_at_t ~layers ~t ~frames =
  (* {{{ process parameters *)
  (* the first rendered ~t = 0 *)
  (* the last rendered ~t = (pred frames) *)
  let percent = (float t)/.(float(pred frames))
  in
  let process_param_i = function
    | Int p -> p
    | Int_t func -> func ~t
    | Int_p func -> func ~percent
    | Int_ft func -> func ~frames ~t
  in
  let process_param_f = function
    | Float p -> p
    | Float_t func -> func ~t
    | Float_p func -> func ~percent
    | Float_ft func -> func ~frames ~t
  in
  let process_param_s = function
    | String p -> p
    | String_t func -> func ~t
    | String_p func -> func ~percent
    | String_ft func -> func ~frames ~t
  in
  let process_param_bz = function
    | BZ p -> p
    | BZ_t func -> func ~t
    | BZ_p func -> func ~percent
    | BZ_ft func -> func ~frames ~t
  in
  let _f, _i, _s, _bz = process_param_f, process_param_i, process_param_s, process_param_bz
  in
  (* }}} *)
  (* {{{ process the layer tree *)
  let process_source = function
    | Source_ext layer -> layer
    | Source_A (func, a, b, c) -> func (_i a) (_i b) (_s c) ()
    | Source_B (func, a) -> func (_s a) ()
  in
  let process_filter = function
    | Filter_0  func -> func
    | Filter_1T (func, a) -> func a
    | Filter_1s (func, a) -> func (_s a)
    | Filter_1i (func, a) -> func (_i a)
    | Filter_1f (func, a) -> func (_f a)
    | Filter_2f (func, a, b) -> func (_f a) (_f b)
    | Filter_2i (func, a, b) -> func (_i a) (_i b)
    | Filter_3f (func, a, b, c) -> func (_f a) (_f b) (_f c)
    | Filter_3i (func, a, b, c) -> func (_i a) (_i b) (_i c)
    | Filter_BZ (func, a, b, c) -> func (_s a) (_f b) (_bz c)
    | Filter_4i (func, a, b, c, d) -> func (_i a) (_i b) (_i c) (_i d)
    | Filter_sf4i (func, a, b, c, d, e, f) -> func (_s a) (_f b) (_i c) (_i d) (_i e) (_i f)
  in
  let process_compositor = function
    | Compose_0  (func) -> func
    | Compose_1C (func, a) -> func a
    | Compose_1f (func, a) -> func (_f a)
  in
  let process_clipper = function
    | Clipper_0 (func) -> func
  in
  let rec process_layer = function
    | Cached layer -> layer
    | Leaf (src) -> (process_source src)
    | Edge (flt, lay) -> (process_filter flt) ~img:(process_layer lay)
    | Node2 (cmp, lay_a, lay_b) ->
        (process_compositor cmp)
            ~img_a:(process_layer lay_a)
            ~img_b:(process_layer lay_b)
    | Node3 (cmp, lay_a, lay_b, lay_c) ->
        (process_clipper cmp)
            ~img_a:(process_layer lay_a)
            ~img_b:(process_layer lay_b)
            ~img_c:(process_layer lay_c)
  in
  (* }}} *)
  process_layer layers;
;;

(* }}} *)
(* {{{ BOOT: render_layers *)

let render_layers ?(frames=1) ?(save=None) ?(animate=false) ?(delay=50) ~layers () =
  (* ~frames is the number of frames to be rendered *)
  if frames <= 0 then invalid_arg "~frames should be positive strict";
  (* {{{ save *)
  let save, path =
    match save with
    | None -> (false, "")
    | Some _save ->
        match _save with `where path
        | `path path -> if is_dir_writable ~path
            then (true, path) else failwith (Printf.sprintf "cannot write in path %s" path)
        | `tmp -> if is_dir_writable ~path:"/tmp"
            then (true, "/tmp") else (false, "")
  in
  (* }}} *)
  let rec aux ~t acc =
    if t >= frames then begin print_newline(); List.rev acc end
    else let layer = get_frame_at_t ~layers ~frames ~t in
      (* {{{ save frames *)
      if save then begin
        Magick.Imper.set_compression_quality layer 96;
        Magick.write_image layer (Printf.sprintf "%s/frame-%d.jpg" path t)
      end;
      (* }}} *)
      Printf.printf " %d%!" t;
      aux ~t:(succ t) (layer::acc)
  in
  if not animate then
    aux ~t:0 []
  else
    (* show the result with 'animate' *)
    begin
      let frames = aux ~t:0 []
      and preserve_frames = ref []
      and anim = Magick.Imper.new_image_list ()
      in
      List.iter (fun frame ->
        Magick.Imper.append_image_to_list  anim  frame ~delay ();
        preserve_frames := frame :: !preserve_frames;
      ) frames;
      Magick.Imper.animate_images  anim;
      List.iter (fun frame -> Magick.Imper.no_op frame) !preserve_frames; (* work-around for the GC *)
      frames
    end;
;;

(* }}} *)

(* }}} *)
(* {{{ Wraps *)
(* Wraps the functions of the libMagick interface *)

(* {{{ Sources *)

(* Source_A *)
let _create a b c = Magick.Fun.create_image ~width:a ~height:b ~pseudo_format:c
let _canvas a b c = Magick.Fun.get_canvas ~width:a ~height:b ~color:c

(* Source_B *)
let _read c = Magick.Fun.read_image ~filename:c

(* }}} *)
(* {{{ Composers *)

(* Compose_0 *)
let _texture ~img_a ~img_b = Magick.Fun.texture_image ~img:img_b ~tex_img:img_a
(* Compose_1C *)
let _compose a ~img_a ~img_b = Magick.Fun.composite_image ~compose:a () ~img_above:img_a ~img_below:img_b
(* Compose_1f *)
(* {{{ transition `Macro *)

let _transition a ~img_a ~img_b =
  let _img_a = Magick.clone_image img_a
  and _img_b = Magick.clone_image img_b
  in
  if a < 0.0 then invalid_arg "less than 0.0";
  if a > 1.0 then invalid_arg "more than 1.0";
  let v_a = int_of_float(a *. 255.) in
  let v_b = 255 - v_a in
  let sub_layer itn img =
    let color = Printf.sprintf "#%02X%02X%02X" itn itn itn
    and width  = Magick.get_image_width  img
    and height = Magick.get_image_height img
    in
    Magick.get_canvas ~width ~height ~color
  in

  let sub_a = sub_layer v_a _img_a in
  Magick.Imper.composite_image _img_a sub_a Magick.Lighten ();

  let sub_b = sub_layer v_b _img_b in
  Magick.Imper.composite_image _img_b sub_b Magick.Lighten ();

  Magick.Imper.composite_image _img_a _img_b Magick.Multiply ();

  _img_a
;;
(* }}} *)
(* Compose_1s *)
(* {{{ threshold_negate `Macro *)

let _threshold_negate a ~img =
  if a < 0.0 then invalid_arg "less than 0.0";
  if a > 1.0 then invalid_arg "more than 1.0";
  let max = float 65535 in
  let level = int_of_float(max *. a) in
  let threshold = Printf.sprintf "%d,%d,%d" level level level in
  let new_img = Magick.Fun.black_threshold ~threshold () ~img in
  Magick.Imper.negate new_img ();
  let level = 65535 - level in
  let threshold = Printf.sprintf "%d,%d,%d" level level level in
  Magick.Imper.black_threshold new_img ~threshold;
  new_img
;;
(* }}} *)
(* Clipper_0 *)
(* {{{ mask_transition `Macro *)


let _mask_transition_V1 ~img_a ~img_b ~img_c =
  let _img_a = Magick.Fun.negate () ~img:img_a
  and _img_b = Magick.clone_image img_b
  and _img_c = Magick.clone_image img_c in
  Magick.Imper.composite_image _img_b  img_a Magick.Lighten ();
  Magick.Imper.composite_image _img_c _img_a Magick.Lighten ();
  Magick.Imper.composite_image _img_b _img_c Magick.Multiply ();
  _img_b
;;

let _mask_transition_V2 ~img_a ~img_b ~img_c =
  let _img_b = Magick.clone_image img_b
  and _img_c = Magick.clone_image img_c in
  Magick.Imper.composite_image _img_b  img_a Magick.Lighten ();
  Magick.Imper.negate _img_c ();
  Magick.Imper.composite_image _img_c  img_a Magick.Multiply ();
  Magick.Imper.negate _img_c ();
  Magick.Imper.composite_image _img_b _img_c Magick.Multiply ();
  _img_b
;;

let _mask_transition = _mask_transition_V1 ;;
let _mask_transition = _mask_transition_V2 ;;

(* }}} *)

(* }}} *)
(* {{{ Filters *)

(* Filter_0 *)
let _view = Magick.Fun.view ()
let _negate = Magick.Fun.negate ()
let _enhance = Magick.Fun.enhance ()
let _equalize = Magick.Fun.equalize ()
let _normalize = Magick.Fun.normalize ()
(* {{{ check `Macro *)
let _check ~img =
  let width = Magick.get_image_width img
  and height = Magick.get_image_height img in
  let tmp = Magick.create_image ~width ~height ~pseudo_format:"pattern:checkerboard" in
  Magick.Imper.composite_image tmp img Magick.Over ();
  Magick.display tmp; img;;
(* }}} *)
let _minify ~img =
  let new_img = Magick.clone_image img in
  Magick.Imper.minify new_img; new_img;;
let _magnify ~img =
  let new_img = Magick.clone_image img in
  Magick.Imper.magnify new_img; new_img;;

(* Filter_1f *)
let _medianfilter a = Magick.Fun.medianfilter ~radius:a ()
let _radial_blur a = Magick.Fun.radial_blur ~angle:a ()
let _oilpaint a = Magick.Fun.oilpaint ~radius:a ()
let _implode a = Magick.Fun.implode ~amount:a ()
let _rotate a = Magick.Fun.rotate ~degrees:a ()
let _spread a = Magick.Fun.spread ~radius:a ()
let _swirl a = Magick.Fun.swirl ~degrees:a ()
let _edge a = Magick.Fun.edge ~radius:a ()
(* {{{ rotate_middle_crop `Macro *)

let _rotate_middle_crop a ~img =
  let get_dim func g =
    let dim = func g in
    let half_dim = dim / 2 in
    (dim, half_dim)
  in
  let new_img = Magick.Fun.rotate ~degrees:a () ~img
  in
  let orig_width,  orig_half_width  = get_dim Magick.get_image_width  img
  and orig_height, orig_half_height = get_dim Magick.get_image_height img
  in
  let new_width,  new_half_width  = get_dim Magick.get_image_width  new_img
  and new_height, new_half_height = get_dim Magick.get_image_height new_img
  in
  let x = new_half_width  - orig_half_width
  and y = new_half_height - orig_half_height
  in
  Magick.Fun.crop ~x ~y ~width:orig_width ~height:orig_height () ~img:new_img;
;;
(* }}} *)

(* Filter_1s *)
let _black_threshold a = Magick.Fun.black_threshold ~threshold:a ()
let _white_threshold a = Magick.Fun.white_threshold ~threshold:a ()
let _write a ~img = Magick.write_image img ~filename:a; img
let _level a = Magick.Fun.level ~levels:a ()

(* Filter_1i *)
let _set_quality a ~img = Magick.Imper.set_compression_quality img a; img

(* Filter_2f *)
let _charcoal a b = Magick.Fun.charcoal ~radius:a ~sigma:b ()
let _sharpen a b = Magick.Fun.sharpen ~radius:a ~sigma:b ()
let _emboss a b = Magick.Fun.emboss ~radius:a ~sigma:b ()
let _shade a b = Magick.Fun.shade ~azimuth:a ~elevation:b ()
let _blur a b = Magick.Fun.blur ~radius:a ~sigma:b ()
let _gaussian_blur a b = Magick.Fun.gaussian_blur ~radius:a ~sigma:b ()
(* {{{ swirl `Macro *)

let _swirl_m a b ~img =
  let width = Magick.get_image_width img
  and height = Magick.get_image_height img
  in
  if width = height then
    Magick.Fun.swirl ~degrees:a () ~img
  else if width > height then
    (let x = int_of_float (b *. float(width - height)) in
     let rectangle_swirled =
       Magick.Fun.swirl ~degrees:a ()
          ~img:(Magick.Fun.crop ~x ~y:0 ~width:height ~height () ~img)
     in
     Magick.display rectangle_swirled;
     Magick.Fun.composite_image ~compose:Magick.Replace ~x ~y:0 ()
           ~img_above:rectangle_swirled
           ~img_below:img
    )
  else
    (let y = int_of_float (b *. float(height - width)) in
     let rectangle_swirled =
       Magick.Fun.swirl ~degrees:a ()
          ~img:(Magick.Fun.crop ~x:0 ~y ~width ~height:width () ~img)
     in
     Magick.Fun.composite_image ~compose:Magick.Replace ~x:0 ~y ()
           ~img_above:rectangle_swirled
           ~img_below:img
    )
;;
(* }}} *)

(* Filter_3f *)
let _motion_blur a b c = Magick.Fun.motion_blur ~radius:a ~sigma:b ~angle:c ()

(* Filter_2i *)
let _sample a b = Magick.Fun.sample ~width:a ~height:b ()
let _scale a b = Magick.Fun.scale ~width:a ~height:b ()
let _roll a b = Magick.Fun.roll ~x:a ~y:b ()

(* Filter_3i *)
let _modulate a b c = Magick.Fun.modulate ~brightness:a ~saturation:b ~hue:c ()

(* Filter_4i *)
let _crop a b c d = Magick.Fun.crop ~x:a ~y:b ~width:c ~height:d ()

(* Filter_1T *)
let _set_type a ~img =
  let new_img = Magick.clone_image img in
  Magick.Imper.set_image_type img ~image_type:a; new_img;;

(* Filter_sf4i *)
let _draw_line a b c d e f ~img =
  let new_img = Magick.clone_image img in
  Magick.Imper.draw_line  new_img
      ~stroke_color:(Magick.Imper.color_of_string a)
      ~stroke_width:b ~x0:c ~y0:d ~x1:e ~y1:f (); new_img;;

let _draw_circle a b c d e f ~img =
  let new_img = Magick.clone_image img in
  Magick.Imper.draw_circle  new_img
      ~fill_color:(Magick.Imper.color_of_string a)
      ~stroke_width:b ~x0:c ~y0:d ~x1:e ~y1:f (); new_img;;

let _draw_rectangle a b c d e f ~img =
  let new_img = Magick.clone_image img in
  Magick.Imper.draw_rectangle  new_img
      ~fill_color:(Magick.Imper.color_of_string a)
      ~stroke_width:b ~x0:c ~y0:d ~x1:e ~y1:f (); new_img;;

(* Filter_BZ *)
let _draw_bezier a b c ~img =
  let new_img = Magick.clone_image img in
  Magick.Imper.draw_bezier  new_img
      ~stroke_color:(Magick.Imper.color_of_string a)
      ~stroke_width:b  ~coords:c (); new_img;;

(* }}} *)

(* }}} *)
(* {{{ Facilities *)

(* Provides functions to make parameters evolve through time *)
(* {{{ ._param_evolve *)

let _PI = 4.0 *. atan 1.0 ;;

(* {{{ doc *)
(*
  ~param  specifies the value of the parameter to make evolve
    `min_max   gives the minimum and the maximum value of the parameter
    `min_amplitude  gives the minimum value and the amplitude of the parameter
     with `amplitude  or `max  the minimum value is 0

  ~cycles_nb  is the number of cycles to do

  ~cycle_type  is the type of cycle to do
     `COS_01  is cosinus function which returns 0 at the first frame
              and the max parameter value at the end
     `COS_010 is cosinus function which returns 0 at the first and
              at the last frame, and the max parameter value in the middle
*)
(* }}} *)
let f_param_evolve ?(param=`max 1.0) ?(cycle_type=`ID) ?(cycles_nb=1.0) () =
  (* {{{ let min, amplitude = match param with *)
  let min, amplitude = match param with
  | `min_amplitude (_min, amplit) -> (_min, amplit)
  | `amplitude amplit -> (0.0, amplit)
  | `max _max -> (0.0, _max)
  | `min_max (_min, _max) -> (_min, _max -. _min)
  in
  (* }}} *)
  match cycle_type with
  (* {{{ more readable version without optimisations *(
  | `COS_01 ->
      (fun ~frames ~t ->
        let angle = (_PI ) *. cycles_nb *. (float t) /. (float frames) in
        amplitude *. ((cos angle) /. (-2.) +. 0.5) +. min
      )
  | `COS_10 ->
      (fun ~frames ~t ->
        let angle = (_PI ) *. cycles_nb *. (float t) /. (float frames) in
        amplitude *. ((cos angle) /. (2.) +. 0.5) +. min
      )
  | `COS_101 ->
      (fun ~frames ~t ->
        let angle = (_PI *. 2.) *. cycles_nb *. (float t) /. (float frames) in
        amplitude *. ((cos angle) /. (2.) +. 0.5) +. min
      )
  | `COS_010 ->
      (fun ~frames ~t ->
        let angle = (_PI *. 2.) *. cycles_nb *. (float t) /. (float frames) in
        amplitude *. ((cos angle) /. (-2.) +. 0.5) +. min
      )
  )* }}} *)
  | `COS_01 ->
      (* {{{ *)
      let _ng = (_PI ) *. cycles_nb
      and cache1 = amplitude /. (-2.) and cache2 = (amplitude *. 0.5) +. min in
      (fun ~frames ~t ->
        let angle = _ng *. (float t) /. (float frames) in
        ((cos angle) *. cache1) +. cache2
      )
      (* }}} *)
  | `COS_10 ->
      (* {{{ *)
      let _ng = (_PI ) *. cycles_nb
      and cache1 = amplitude /. (2.) and cache2 = (amplitude *. 0.5) +. min in
      (fun ~frames ~t ->
        let angle = _ng *. (float t) /. (float frames) in
        ((cos angle) *. cache1) +. cache2
      )
      (* }}} *)
  | `COS_101 ->
      (* {{{ *)
      let _ng = (_PI *. 2.) *. cycles_nb
      and cache1 = amplitude /. (2.) and cache2 = (amplitude *. 0.5) +. min in
      (fun ~frames ~t ->
        let angle = _ng *. (float t) /. (float frames) in
        ((cos angle) *. cache1) +. cache2
      )
      (* }}} *)
  | `COS_010 ->
      (* {{{ *)
      let _ng = (_PI *. 2.) *. cycles_nb
      and cache1 = amplitude /. (-2.) and cache2 = (amplitude *. 0.5) +. min in
      (fun ~frames ~t ->
        let angle = _ng *. (float t) /. (float frames) in
        ((cos angle) *. cache1) +. cache2
      )
      (* }}} *)
  | `COS_010_decal decal ->
      (* {{{ *)
      let _ng = (_PI *. 2.) *. cycles_nb in
      let decal_ng = decal *. _ng
      and cache1 = amplitude /. (-2.) and cache2 = (amplitude *. 0.5) +. min in
      (fun ~frames ~t ->
        let angle = _ng *. (float t) /. (float frames) -. decal_ng in
        ((cos angle) *. cache1) +. cache2
      )
      (* }}} *)
  | `COS_10_disc ->
      (* {{{ *)
      let _ng = (_PI ) *. cycles_nb
      and cache1 = amplitude /. (2.) and cache2 = (amplitude *. 0.5) +. min in
      (fun ~frames ~t ->
        let f_frames = float (succ frames) and f_t = float (t) in
        let segment = f_frames /. cycles_nb in
        let f_t = mod_float  f_t  segment
        in
        let angle = _ng *. f_t /. f_frames in
        ((cos angle) *. cache1) +. cache2
      )
      (* }}} *)
  | `COS_01_disc ->
      (* {{{ *)
      let _ng = (_PI ) *. cycles_nb
      and cache1 = amplitude /. (-2.) and cache2 = (amplitude *. 0.5) +. min in
      (fun ~frames ~t ->
        let f_frames = float (succ frames) and f_t = float (t) in
        let segment = f_frames /. cycles_nb in
        let f_t = mod_float  f_t  segment
        in
        let angle = _ng *. f_t /. f_frames in
        ((cos angle) *. cache1) +. cache2
      )
      (* }}} *)
  | `LINEAR_01_disc ->
      (* {{{ *)
      let cache = (amplitude *. cycles_nb) in
      (fun ~frames ~t ->
        let f_frames = float (succ frames) and f_t = float (t)
        in
        let segment = f_frames /. cycles_nb in
        let f_t = mod_float  f_t  segment
        in
        let percent_pos = (f_t /. f_frames) in
        (cache *. percent_pos) +. min
      )
      (* }}} *)
  | `LINEAR_01_decal decal ->
      (* {{{ *)
      let cache = (amplitude *. cycles_nb) in
      (fun ~frames ~t ->
        let f_frames = float (succ frames) and f_t = float (t)
        in
        let segment = f_frames /. cycles_nb in
        let f_t = f_t +. (segment *. decal) in
        let f_t = mod_float  f_t  segment
        in
        let percent_pos = (f_t /. f_frames) in
        (cache *. percent_pos) +. min
      )
      (* }}} *)
  | `ID -> (fun ~frames ~t -> amplitude)
;;

let i_param_evolve ?(param=`max 1) ?(cycle_type=`ID) ?(cycles_nb=1.0) () =
  (* {{{ param => float *)
  let param = match param with
  | `max prm -> `max (float prm)
  | `amplitude prm -> `amplitude (float prm)
  | `min_max (min, prm) -> `min_max (float min, float prm)
  | `min_amplitude (min, prm) -> `min_amplitude (float min, float prm)
  in
  (* }}} *)
  let func = (f_param_evolve ~param ~cycle_type ~cycles_nb ()) in
  (fun ~frames ~t ->
    int_of_float (func ~frames ~t)
  )
;;

let i_id prm =
  (i_param_evolve ~param:(`max prm) ())
;;

let f_id prm =
  (f_param_evolve ~param:(`max prm) ())
;;

(* }}} *)
(* Show as a curve a function which makes evolve a parameter through the time *)
(* {{{ test_func *)

let test_func ~func ~frames ~width ~height =
  let rec aux_xs x acc =
    if x < 0 then acc
    else aux_xs (pred x) (x::acc)
  in
  let xs = aux_xs frames [] in

  let img = Magick.get_canvas ~width ~height ~color:"#FFF" in
  let dot ~x ~y =
    Magick.Imper.draw_circle img ~x0:x ~y0:y ~x1:x ~y1:(y+2) ~fill_color:(Magick.Imper.color_of_string "#F009") ()
  in
  let line ~x0 ~y0 ~x1 ~y1 =
    Magick.Imper.draw_line img ~x0 ~y0 ~x1 ~y1 ~stroke_color:(Magick.Imper.color_of_string "#000") ()
  in
  let rec apply_func xs acc = match xs with
    | [] -> acc
    | x::xtl ->
        let x = int_of_float(float(x*width)/.(float frames))
        and y = match func with
        | `Int func -> (func ~frames ~t:x)
        | `Float func -> int_of_float(func ~frames ~t:x)
        in
        let y = height - y in
        apply_func xtl ((x,y)::acc)
  in
  let xys = apply_func xs [] in
  let rec draw_line (x0,y0) l = match l with
    | [] -> ()
    | (x1,y1)::tl -> line ~x0 ~y0 ~x1 ~y1; draw_line (x1,y1) tl
  in
  draw_line (List.hd xys) (List.tl xys);

  let rec draw_dots l = match l with
    | [] -> ()
    | (x,y)::tl -> dot ~x ~y; draw_dots tl
  in
  draw_dots xys;
  Magick.display img;
;;
(* }}} *)

(* Facilities to build structures *)
(* {{{ Leaves *)

let extern source =
  (Leaf( Source_ext(source) ))

let create_source ~width ~height ~pseudo_format =
  (Leaf( Source_A(_create, Int width, Int height, String pseudo_format) ))

let create_canvas ~width ~height ~color =
  (Leaf( Source_A(_canvas, Int width, Int height, String color) ))

let read ~filename =
  (Leaf( Source_B(_read, String filename) ))

let read_t ~filename =
  (Leaf( Source_B(_read, String_t filename) ))

(* }}} *)
(* {{{ Edges *)

let blur ~radius ~sigma lay =
  (Edge( (Filter_2f(_blur, Float radius, Float sigma)), lay ))

let emboss ~radius ~sigma lay =
  (Edge( (Filter_2f(_emboss, Float radius, Float sigma)), lay ))

let shade ~azimuth ~elevation lay =
  (Edge( (Filter_2f(_shade, Float azimuth, Float elevation)), lay ))

let sample ~width ~height lay =
  (Edge( (Filter_2i(_sample, Int width, Int height)), lay ))

let scale ~width ~height lay =
  (Edge( (Filter_2i(_scale, Int width, Int height)), lay ))

let minify lay =
  (Edge( (Filter_0(_minify)), lay ))

let magnify lay =
  (Edge( (Filter_0(_magnify)), lay ))

let roll ~x ~y lay =
  (Edge( (Filter_2i(_roll, Int x, Int y)), lay ))

let roll_ft ~x ~y lay =
  (Edge( (Filter_2i(_roll, Int_ft x, Int_ft y)), lay ))

let crop ~x ~y ~width ~height lay =
  (Edge( (Filter_4i(_crop, Int x, Int y, Int width, Int height)), lay ))

let crop_ft ~x ~y ~width ~height lay =
  (Edge( (Filter_4i(_crop, Int_ft x, Int_ft y, Int_ft width, Int_ft height)), lay ))

let swirl ~degrees lay =
  (Edge( (Filter_1f(_swirl, Float degrees)), lay ))

let swirl_t ~degrees lay =
  (Edge( (Filter_1f(_swirl, Float_t degrees)), lay ))

let swirl_ft ~degrees lay =
  (Edge( (Filter_1f(_swirl, Float_ft degrees)), lay ))

let rotate ~degrees lay =
  (Edge( (Filter_1f(_rotate, Float degrees)), lay ))

let rotate_t ~degrees lay =
  (Edge( (Filter_1f(_rotate, Float_t degrees)), lay ))

let rotate_ft ~degrees lay =
  (Edge( (Filter_1f(_rotate, Float_ft degrees)), lay ))

let rotate_middle_crop ~degrees lay =
  (Edge( (Filter_1f(_rotate_middle_crop, Float degrees)), lay ))

let rotate_middle_crop_ft ~degrees lay =
  (Edge( (Filter_1f(_rotate_middle_crop, Float_ft degrees)), lay ))

let view lay =
  (Edge( (Filter_0(_view)), lay ))

let check lay =
  (Edge( (Filter_0(_check)), lay ))

let write ~filename lay =
  (Edge( (Filter_1s(_write, String filename)), lay ))

let set_type ~image_type lay =
  (Edge( (Filter_1T(_set_type, image_type)), lay ))

let threshold_negate ~percent lay =
  (Edge( (Filter_1f(_threshold_negate, Float percent)), lay ))

let threshold_negate_t ~percent lay =
  (Edge( (Filter_1f(_threshold_negate, Float_t percent)), lay ))

let threshold_negate_ft ~percent lay =
  (Edge( (Filter_1f(_threshold_negate, Float_ft percent)), lay ))

(* }}} *)
(* {{{ Nodes *)

let composite ~compose ~img_above ~img_below =
  (Node2( (Compose_1C(_compose, compose)), img_above, img_below ))

let compose ~op (img_above, img_below) =
  (Node2( (Compose_1C(_compose, op)), img_above, img_below ))

let transition ~percent img_above img_below =
  (Node2( (Compose_1f(_transition, Float percent)), img_above, img_below ))

let transition_t ~percent img_above img_below =
  (Node2( (Compose_1f(_transition, Float_t percent)), img_above, img_below ))

let transition_ft ~percent img_above img_below =
  (Node2( (Compose_1f(_transition, Float_ft percent)), img_above, img_below ))

let mask_transition ~img_mask ~img_above ~img_below =
  (Node3( (Clipper_0(_mask_transition)), img_mask, img_above, img_below ))

(* }}} *)

(* }}} *)

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