(* {{{ 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>           |
 * +-----------------------------------------------------------------+
 *
 * }}} *)

(* {{{ types *)

type layer = Magick.image_handle

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

type filter =
  | Filter_0  of (img:layer -> layer)
  | Filter_1s of (string -> img:layer -> layer) * string
  | Filter_1f of (float -> img:layer -> layer) * float
  | Filter_2f of (float -> float -> img:layer -> layer) * float * float
  | Filter_3f of (float -> float -> float -> img:layer -> layer) * float * float * float
  | Filter_2i of (int -> int -> img:layer -> layer) * int * int
  | Filter_3i of (int -> int -> int -> img:layer -> layer) * int * int * int
  | Filter_4i of (int -> int -> int -> int -> img:layer -> layer) * int * int * int * int

type compositor =
  | Compose_0 of (img_a:layer -> img_b:layer -> layer)
  | Compose_1 of (Magick.composite_operator -> img_a:layer -> img_b:layer -> layer) * Magick.composite_operator

type layers_tree =
  | Leaf of (source)
  | Node of (filter * layers_tree)
  | Comp of (compositor * layers_tree * layers_tree)

(* }}} *)
(* {{{ processings *)

let process_source src =
  match src with
  | Source_e layer -> layer
  | Source_A (func, a, b, c) -> func a b c ()
  | Source_B (func, a) -> func a ()
;;

let process_filter flt =
  match flt with
  | Filter_0  func -> func
  | Filter_1s (func, a) -> func a
  | Filter_1f (func, a) -> func a
  | Filter_2f (func, a, b) -> func a b
  | Filter_2i (func, a, b) -> func a b
  | Filter_3f (func, a, b, c) -> func a b c
  | Filter_3i (func, a, b, c) -> func a b c
  | Filter_4i (func, a, b, c, d) -> func a b c d
;;

let process_compositor cmp =
  match cmp with
  | Compose_0 func -> func
  | Compose_1 (func, a) -> func a
;;

let rec process_layers layers =
  match layers with
  | Leaf (src) -> (process_source src)
  | Node (flt, t) -> (process_filter flt) ~img:(process_layers t)
  | Comp (cmp, t1, t2) -> (process_compositor cmp) ~img_a:(process_layers t1) ~img_b:(process_layers t2)
;;

(* }}} *)
(* {{{ wraps *)

(* Source_A *)
let _create a b c = Magick.Fun.create_image ~width:a ~height:b ~pseudo_format:c
(* Source_B *)
let _read c = Magick.Fun.read_image ~filename:c

(* 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 ()

(* 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 ()

(* 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_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 ()

(* 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 ()

(* Compose_1 *)
let _compose a ~img_a ~img_b = Magick.Fun.composite_image ~compose:a () ~img_above:img_a ~img_below:img_b
(* Compose_0 *)
let _texture ~img_a ~img_b = Magick.Fun.texture_image ~img:img_b ~tex_img:img_a

(* }}} *)
(* {{{ datas *)

let width = 628
let height = 478
let border = 14
let frames = 32

let i = ref 0

let through_time  t bg =
  Printf.printf " %d%!" t;
  let percent = (float t) /. (float frames) in
  let percent_inv = 1.0 -. percent in
  let my_tree =
    (Node( (Filter_4i(_crop, border, border, width - 2*border, height - 2*border)),
      (Comp( (Compose_1(_compose, Magick.HardLight)),
        (Node( (Filter_2f(_shade, 30., 30.)),
          (Node( (Filter_2f(_blur, 3., 5.)),
            (Node( (Filter_1f(_swirl, percent *. 120.0)),
              (Leaf(Source_A(_create, width, height, "pattern:hexagons")))
            ))
          ))
        )),
        (Node( (Filter_1f(_swirl, percent_inv *. -180.0)),
          (Node( (Filter_2f(_emboss, 4., 2.)),
            (Node( (Filter_2f(_blur, 8., 12.)),
              (Leaf(Source_e(bg)))
            ))
          ))
        ))
      ))
    ))
  in
  (* {{{ save frames *(

  let frame_filename = Printf.sprintf "/mnt/ramdisk/frame-%04d.jpg" !i in
  let my_tree = (Node( (Filter_1s(_write, frame_filename)), my_tree )) in
  incr i;
  )* }}} *)
  process_layers my_tree
;;

(* }}} *)
(* {{{ main *)

let _ =
  let anim = Magick.Imper.new_image_list ()
  in
  let bg =
    process_layers (Leaf(Source_A(_create, width, height, "plasma:fractal")))
  in
  let preserve_frames = ref [] in

  for t = 0 to frames do
    let frame = through_time  t bg in
    Magick.Imper.append_image_to_list  anim  frame ~delay:4 ();
    preserve_frames := frame :: !preserve_frames;
  done;

  for t = frames downto 0 do
    let frame = through_time  t bg in
    Magick.Imper.append_image_to_list  anim  frame ~delay:4 ();
    preserve_frames := frame :: !preserve_frames;
  done;

  print_newline();

  Magick.Imper.animate_images anim;
  (* Magick.Imper.write_images anim "grinnm.gif"; *)

  List.iter (fun frame -> Magick.Imper.no_op frame) !preserve_frames;
;;

(* }}} *)

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