Source

clutter-ocaml / tests / test-behave.ml

Full commit

let magic = 0.551784
let radius = 200

open Clutter
open Printf
module Texture = ClutterTexture
module Behaviour = ClutterBehaviour
module Group = ClutterGroup
module Stage = ClutterStage
module Rectangle = ClutterRectangle
module Timeline = ClutterTimeline
module Alpha = ClutterAlpha
module Actor = ClutterActor

let _ =
  let stage_color = Color.rgb (0xcc, 0xcc, 0xcc)
  and rect_bg_color = Color.rgb (0x33, 0x22, 0x22)
  and rect_border_color = Color.parse "DarkSlateGray" in
  let knots_poly = [|(0,0); (0,300); (300,300); (300,0); (0,0)|] in
  let pos x = int_of_float ((float radius) *. x) in
  let knots_bspline = [| (-radius,0);
			 (-radius,pos magic);
			 (-(pos magic), radius);
			 (0, radius);
			 (pos magic, radius);
			 (radius, pos magic);
			 (radius, 0);
			 (radius, -(pos magic));
			 (pos magic, -radius);
			 (0, -radius);
			 (-(pos magic), -radius);
			 (-radius, -(pos magic));
			 (-radius, 0) |] in

  let path_type =
    if (Array.length Sys.argv) > 2 then begin
      assert (Sys.argv.(1) = "--path");
      match Sys.argv.(2) with
	  "poly" | "bspline" | "ellipse" -> Sys.argv.(2)
	| _ -> failwith "allowed paths are poly|bspline|ellipse"
    end else "poly"
  in
  let stage = Stage.get_default () in
  stage#hide_cursor;

  let _ = stage#connect#button_press_event
    (fun evt ->
       let mods = Event.get_state evt in
       List.iter (function
		      `SHIFT_MASK -> printf "SHIFT\n%!"
		    | `CONTROL_MASK -> printf "CONTROL\n%!";
		    | `LOCK_MASK -> printf "LOCK\n%!";
		    | _ -> printf "other\n%!"
		 ) mods;
       let evt = Event.cast [`BUTTON_PRESS] evt in
       let click_type = match Event.Button.get_click_count evt with
	   2 -> "double" | 3 -> "triple" | _ -> "single" in
       printf "%s button press event\n%!" click_type;
       false
    )
  and _ = stage#connect#scroll_event
    (fun evt ->
       let evt = Event.cast [`SCROLL] evt in
       printf "scroll direction: %s\n%!"
	 (if Event.Scroll.get_direction evt = `SCROLL_UP then "up" else "down");
       false
    )
  and _ = stage#connect#key_press_event
    (fun _ -> main_quit (); true ) in

  stage#set_color stage_color;
  let group = Group.create () in
  stage#add_actor group;
  group#show;

  let hand = try
    Texture.new_from_file "./examples/redhand.png" ()
  with GError _ -> exit (-1)
  in

  hand#set_position ~x:0 ~y:0;
  hand#show;

  let rect = Rectangle.create () in
  rect#set_position ~x:0 ~y:0;
  rect#set_size ~width:(hand#width) ~height:(hand#height);
  rect#set_color rect_bg_color;
  rect#set_border_width 10;
  rect#set_border_color rect_border_color;
  rect#show;

  group#add_many [| Actor.to_actor rect; Actor.to_actor hand |];
  let timeline = Timeline.new_for_duration 4000 () in
  timeline#set_loop true;
  let _ = timeline#connect#completed
    (fun t ->
       let t = new ClutterTimeline.timeline t in
       match t#direction with
	   `FORWARD -> t#set_direction `BACKWARD
	 | `BACKWARD -> t#set_direction `FORWARD
    ) in
  let alpha = Alpha.create ~timeline ~alpha_func:`RAMP_INC in
  let o_behave = Behaviour.opacity ~alpha:alpha#obj ~opacity_start:0x33
    ~opacity_end:0xff () in

  o_behave#apply group;

  let p_behave = match path_type with
      "poly" ->
	((Behaviour.path ~alpha ~knots:knots_poly) :> Behaviour.behaviour_skel)
    | "bspline" ->
	let b = Behaviour.ellipse ~alpha:alpha#obj
	  ~center:(200,200) ~width:400 ~height:300
	  ~direction:`ROTATE_CW ~angle_start:0. ~angle_end:360. () in
	b#set_angle_tilt_x 45.; (*`X_AXIS 45.;  annoying *)
	b#set_angle_tilt_y 45.; (*`Z_AXIS 45.;  annoying *)
	(b :> Behaviour.behaviour_skel)
    | "ellipse" ->
	let b = Behaviour.bspline ~alpha ~knots:knots_bspline in
	b#set_origin (0, radius);
	(b :> Behaviour.behaviour_skel)
    | _ -> assert false
  in
  p_behave#apply group;

  timeline#start;
  stage#show_all;
  clutter_main ()