Source

clutter-ocaml / src / clutterBehaviour.ml

Full commit
open OclutterProps
open ClutterProps
open Clutter
open ClutterEnums

module BehaviourInternal = struct
  external path_new : alpha:alpha obj -> knots:knot array -> behaviour_path obj
    = "ml_clutter_behaviour_path_new"
  external bspline_new : alpha:alpha obj -> knots:knot array ->
    behaviour_bspline obj = "ml_clutter_behaviour_bspline_new"
end

class behaviour_signals_impl obj = object
  inherit ['a] gobject_signals obj
  inherit behaviour_sigs
end

class virtual behaviour_skel (obj : behaviour obj) = object(self)
  inherit behaviour_props
  method apply : 'a. (#ClutterActor.actor_o as 'a) -> unit =
    fun a -> Behaviour.apply obj a#as_actor
end

(** Behaviour controlling the opacity *)
module Opacity = struct
  class opacity_skel obj = object(self)
    inherit behaviour_opacity_props
    inherit behaviour_skel (as_behaviour obj)
    method obj : behaviour_opacity obj = obj
  end

  class opacity obj = object
    inherit opacity_skel (obj : behaviour_opacity obj)
    method connect = new behaviour_signals_impl obj
  end

  let make_opacity ~create =
    BehaviourOpacity.make_params ~cont:
      (fun pl ->
	 Behaviour.make_params pl ~cont:
	   (fun pl () ->
	      let (e : #opacity_skel) = create pl in e))

  let create =
    make_opacity [] ~create:(fun pl -> new opacity (BehaviourOpacity.create pl))
end

(** A behaviour interpolating position along an ellipse *)
module Ellipse = struct
  class ellipse_skel obj = object(self)
    inherit behaviour_ellipse_props
    inherit behaviour_skel (as_behaviour obj)
    method obj : behaviour_ellipse obj = obj
    (*method set_angle_tilt (axis:rotate_axis_type) v = function
	`X_AXIS -> self#set_angle_tilt_x v
      | `Y_AXIS -> self#set_angle_tilt_y v*)
  end

  class ellipse obj = object
    inherit ellipse_skel (obj : [> `behaviourellipse] obj)
    method connect = new behaviour_signals_impl obj
  end

  let make_ellipse ~create =
    BehaviourEllipse.make_params ~cont:
      (fun pl ->
	 Behaviour.make_params pl ~cont:
	   (fun pl () ->
	      let (e : #ellipse_skel) = create pl in e))

  let create =
    make_ellipse [] ~create:(fun pl -> new ellipse (BehaviourEllipse.create pl))
end

(** A behaviour interpolating position along a B-Spline *)
module Bspline = struct
  class bspline_skel obj = object(self)
    inherit behaviour_skel (as_behaviour obj)
    method obj : behaviour_bspline obj = obj
    method set_origin = BehaviourBspline.set_origin obj
  end

  class bspline_signals_impl obj = object
    inherit ['a] gobject_signals obj
    inherit behaviour_bspline_sigs
    inherit behaviour_sigs
  end

  class bspline obj = object
    inherit bspline_skel (obj : [> `behaviourbspline] obj)
    method connect = new bspline_signals_impl obj
  end

  let create ~alpha ~knots =
    let o = BehaviourInternal.bspline_new ~alpha:(alpha#obj) ~knots in
    new bspline o

end

(** A behaviour interpolating position along a path *)
module Path = struct
  class path_skel obj = object(self)
    inherit behaviour_path_props
    inherit behaviour_skel (as_behaviour obj)
    method obj : behaviour_path obj = obj
  end

  class path_signals_impl obj = object
    inherit ['a] gobject_signals obj
    inherit behaviour_path_sigs
    inherit behaviour_sigs
  end

  class path obj = object
    inherit path_skel (obj : [> `behaviourpath] obj)
    method connect = new path_signals_impl obj
  end

  let create ~alpha ~knots =
    let o = BehaviourInternal.path_new ~alpha:(alpha#obj) ~knots in
    new path o

end

(** A behaviour controlling the Z position *)
module Depth = struct
  class depth_skel obj = object(self)
    inherit behaviour_depth_props
    inherit behaviour_skel (as_behaviour obj)
    method obj : behaviour_depth obj = obj
  end

  class depth obj = object
    inherit depth_skel (obj : [> `behaviourdepth] obj)
    method connect = new behaviour_signals_impl obj
  end

  let make_depth ~create =
    BehaviourDepth.make_params ~cont:
      (fun pl ->
	 Behaviour.make_params pl ~cont:
	   (fun pl () ->
	      let (e : #depth_skel) = create pl in e))

  let create ~alpha =
    make_depth [] ~alpha:(alpha#obj)
      ~create:(fun pl -> new depth (BehaviourDepth.create pl))

end

(** A behaviour controlling rotation *)
module Rotate = struct
  class rotate_skel obj = object(self)
    inherit behaviour_rotate_props
    inherit behaviour_skel (as_behaviour obj)
    method obj : behaviour_rotate obj = obj
    method set_center ~x ~y ~z =
      self#set_center_x x;
      self#set_center_y y;
      self#set_center_z z
  end

  class rotate obj = object
    inherit rotate_skel (obj : [> `behaviourrotate] obj)
    method connect = new behaviour_signals_impl obj
  end

  let make_rotate ~create =
    BehaviourRotate.make_params ~cont:
      (fun pl ->
	 Behaviour.make_params pl ~cont:
	   (fun pl () ->
	      let (e : #rotate_skel) = create pl in e))

  let create ~alpha =
    make_rotate [] ~alpha:(alpha#obj) ~create:(fun pl -> new rotate (BehaviourRotate.create pl))

end

(** A behaviour controlling scale *)
module Scale = struct
  class scale_skel obj = object(self)
    inherit behaviour_scale_props
    inherit behaviour_skel (as_behaviour obj)
    method obj : behaviour_scale obj = obj
  end

  class scale obj = object
    inherit scale_skel (obj : [> `behaviourscale] obj)
    method connect = new behaviour_signals_impl obj
  end

  let make_scale ~create =
    BehaviourScale.make_params ~cont:
      (fun pl ->
	 Behaviour.make_params pl ~cont:
	   (fun pl () ->
	      let (e : #scale_skel) = create pl in e))

  let create ~alpha =
    make_scale [] ~alpha:(alpha#obj) ~create:(fun pl -> new scale (BehaviourScale.create pl))

end


(* A few shortcuts to the creation routines *)
let opacity = Opacity.create
let ellipse = Ellipse.create
let bspline = Bspline.create
let path = Path.create
let depth = Depth.create
let rotate = Rotate.create
let scale = Scale.create