Source

clutter-ocaml / tests / test-events.ml

Full commit
module Stage = ClutterStage
module Actor = ClutterActor
module Rectangle = ClutterRectangle
module Group = ClutterGroup
open Clutter


let is_full_screen = ref false
let is_motion = ref true

let stage_state_cb detail stage =
  Printf.printf "[stage signal] %s\n%!" detail

let blue_button_cb actor evt =
  let stage = Stage.get_default () in
  is_full_screen := not !is_full_screen;
  stage#set_fullscreen !is_full_screen;
  Printf.printf "*** Fullscreen %s ***\n%!"
    (if !is_full_screen then "enabled" else "disabled");
  false

let red_button_cb actor evt =
  is_motion := not !is_motion;
  Clutter.set_motion_events_enabled !is_motion;
  Printf.printf "*** Per actor motion events %s ***\n%!"
    (if !is_motion then "enabled" else "disabled");
  false

let capture_cb actor evt =
  Printf.printf "* captured event for type '%s' *\n%!"
    (Gobject.Type.name (Gobject.get_type actor#obj));
  false

let key_focus_in_cb focus_box actor () =
  (*if actor#obj = Stage.get_default () then
    focus_box#hide
  else begin*)
  focus_box#set_position ~x:(actor#x - 5) ~y:(actor#y - 5);
  focus_box#set_size ~width:(actor#width + 10) ~height:(actor#height + 10);
  focus_box#show

let fill_keybuf key_event =
  let result = List.fold_left
    (fun acc m ->
       acc ^ (match m with
		  `SHIFT_MASK -> "<Shift>"
		| `LOCK_MASK  -> "<Lock>"
		| `CONTROL_MASK -> "<Control>"
		| `MOD1_MASK -> "<Mod1>"
		| `MOD2_MASK -> "<Mod2>"
		| `MOD3_MASK -> "<Mod3>"
		| `MOD4_MASK -> "<Mod4>"
		| `MOD5_MASK -> "<Mod5>"
		| _ -> "<ERROR>")) "" (Event.get_state key_event) in
  (string_of_int (Event.Key.get_code key_event)) ^ result

let input_cb data actor (event:Event.any) =
  Printf.printf "input_cb\n%!";
  let stage = Stage.get_default () in
  let () = match Event.get_type event with
      `KEY_PRESS -> Printf.printf "[%s] KEY PRESS %s" data
	(fill_keybuf (Event.Key.cast event))
    | `KEY_RELEASE -> Printf.printf "[%s] KEY RELEASE %s" data
	(fill_keybuf (Event.Key.cast event))
    | `MOTION -> Printf.printf "[%s] MOTION" data
    | `ENTER -> Printf.printf "[%s] ENTER" data
    | `LEAVE -> Printf.printf "[%s] LEAVE" data
    | `BUTTON_PRESS -> Printf.printf "[%s] BUTTON PRESS (click count:%d)"
	data (Event.Button.get_click_count (Event.Button.cast event))
		(*(Event.cast `BUTTON_PRESS event))*)
    | `BUTTON_RELEASE -> Printf.printf "[%s] BUTTON RELEASE (click count:%d)"
	data (Event.Button.get_click_count (Event.Button.cast event));
	if (Event.get_source event) = stage#as_actor then
	  stage#set_key_focus stage
	  (* FIXME: stage#set_key_focus None*)
	else if (Event.get_source event) = actor#obj then
	  (* FIXME: && (Gobject.coerce actor#get_parent#obj) =
	     (Gobject.coerce stage#obj) then *)
	    stage#set_key_focus actor;
    | `SCROLL -> Printf.printf "[%s] BUTTON SCROLL (click count:%d)"
	data (Event.Button.get_click_count (Event.Button.cast event))
    | `STAGE_STATE -> Printf.printf "[%s] STAGE STAGE" data
    | `DESTROY_NOTIFY -> Printf.printf "[%s] DESTROY NOTIFY" data
    | `CLIENT_MESSAGE -> Printf.printf "[%s] CLIENT MESSAGE" data
    | `DELETE -> Printf.printf "[%s] DELETE" data
    | `NOTHING -> ()
  in
  if Event.get_source event = actor#obj then
    Printf.printf " *source* ";
  Printf.printf "\n%!";
  false

let _ = 
  let rcol = Color.rgba (0xff,0,0,0xff)
  and bcol = Color.rgba (0,0,0xff,0xff)
  and gcol = Color.rgba (0,0xff,0,0xff)
  and ycol = Color.rgba (0xff,0xff,0,0xff)
  and ncol = Color.rgba (0,0,0,0xff) in
    
  let stage = Stage.get_default () in
  let _ = stage#connect#event (input_cb "stage" (stage :> Actor.actor))
  and _ = stage#connect#fullscreen (stage_state_cb "fullscreen")
  and _ = stage#connect#unfullscreen (stage_state_cb "unfullscreen")
  and _ = stage#connect#activate (stage_state_cb "activate")
  and _ = stage#connect#deactivate (stage_state_cb "deactivate")
  and _ = stage#connect#captured_event (capture_cb stage) in
    (*(fun x -> stage_state_cb "captured_event" x; false) in*)

  let focus_box = Rectangle.new_with_color ncol () in
  stage#add focus_box;
  let actor = Rectangle.new_with_color rcol () in
  actor#set_size 100 100;
  actor#set_position ~x:100 ~y:100;
  actor#set_reactive true;
  
  stage#add actor;
  let _ = actor#connect#event (input_cb "red box" (actor :> Actor.actor))
  and _ = actor#connect#focus_in (key_focus_in_cb focus_box actor)

  (* Toggle motion - enter/leave capture *)
  and _ = actor#connect#button_press_event (red_button_cb actor) in
  stage#set_key_focus actor;
  let actor = Rectangle.new_with_color gcol () in
  actor#set_size 100 100;
  actor#set_position 250 100;
  actor#set_reactive true;
  stage#add actor;

  let _ = actor#connect#event (input_cb "green box" (actor :> Actor.actor))
  and _ = actor#connect#focus_in (key_focus_in_cb focus_box actor)
  and _ = actor#connect#captured_event (capture_cb actor) in

  let actor = Rectangle.new_with_color bcol () in
  actor#set_size 100 100;
  actor#set_position 400 100;
  actor#set_reactive true;
  stage#add actor;

  let _ = actor#connect#event (input_cb "blue box" (actor :> Actor.actor))
  and _ = actor#connect#focus_in (key_focus_in_cb focus_box actor)
    (* Fullscreen *)
  and _ = actor#connect#button_press_event (blue_button_cb actor) in

  (* non reactive *)
  let actor = Rectangle.new_with_color ncol () in
  actor#set_size 400 50;
  actor#set_position 100 250;
  stage#add actor;

  let _ = actor#connect#event (input_cb "white? box" (actor :> Actor.actor))
  and _ = actor#connect#focus_in (key_focus_in_cb focus_box actor) in

  (* non reactive group, with reactive child *)
  let actor = Rectangle.new_with_color ycol () in
  actor#set_size 100 100;
  actor#set_reactive true;
  let _ = actor#connect#event (input_cb "yellow box" (actor :> Actor.actor)) in
  
  (* note group not reactive *)
  let group = Group.create () in
  group#add actor;
  stage#add group;
  group#set_position 100 350;
  group#show_all;
  stage#show_all;

  clutter_main ()