Commits

Reid van Melle committed 7d03c45

I think the event stuff is improved... seems the object is not curried after all

Comments (0)

Files changed (11)

clutter/clutter.props

   "width"                    gint                  : Read / Write
   "x"                        gint                  : Read / Write
   "y"                        gint                  : Read / Write
-  signal button_press_event : ClutterActor ClutterEvent -> bool
-  signal button_release_event : ClutterActor ClutterEvent -> bool
-  signal captured_event : ClutterActor ClutterEvent -> bool
-  signal destroy : ClutterActor
-  signal enter_event : ClutterActor ClutterEvent -> bool
-  signal event : ClutterActor ClutterEvent -> bool
-  signal focus_in : ClutterActor
-  signal focus_out : ClutterActor
-  signal hide : ClutterActor
-  signal key_press_event : ClutterActor ClutterEvent -> bool
-  signal key_release_event : ClutterActor ClutterEvent -> bool
-  signal leave_event : ClutterActor ClutterEvent -> bool
-  signal motion_event : ClutterActor ClutterEvent -> bool
-  signal parent_set : ClutterActor ClutterActor
-  signal scroll_event : ClutterActor ClutterEvent -> bool
-  signal show : ClutterActor
+  signal button_press_event : ClutterEvent -> bool
+  signal button_release_event : ClutterEvent -> bool
+  signal captured_event : ClutterEvent -> bool
+  signal destroy
+  signal enter_event : ClutterEvent -> bool
+  signal event : ClutterEvent -> bool
+  signal focus_in
+  signal focus_out
+  signal hide
+  signal key_press_event : ClutterEvent -> bool
+  signal key_release_event : ClutterEvent -> bool
+  signal leave_event : ClutterEvent -> bool
+  signal motion_event : ClutterEvent -> bool
+  signal parent_set : ClutterActor
+  signal scroll_event : ClutterEvent -> bool
+  signal show
   method show : "unit"
   method show_all : "unit"
   method hide : "unit"

clutter/clutterData.ml

 let marshal1 conv1 name f argv =
   let arg1 =
     try Data.of_value conv1 (Closure.nth argv 0)
-    with _ -> failwith ("GtkSignal.marhsal1 : " ^ name)
+    with _ -> failwith ("GtkSignal.marshal1 : " ^ name)
   in f arg1
 
 let marshal2 conv1 conv2 name f argv =
   let get conv pos = Data.of_value conv (Closure.nth argv ~pos) in
   let arg1, arg2 =
     try get conv1 0, get conv2 1
-    with _ -> failwith ("GtkSignal.marhsal2 : " ^ name)
+    with _ -> failwith ("GtkSignal.marshal2 : " ^ name)
   in f arg1 arg2
 
 let marshal3 conv1 conv2 conv3 name f argv =
   let get conv pos = Data.of_value conv (Closure.nth argv ~pos) in
   let arg1, arg2, arg3 =
     try get conv1 0, get conv2 1, get conv3 2
-    with _ -> failwith ("GtkSignal.marhsal3 : " ^ name)
+    with _ -> failwith ("GtkSignal.marshal3 : " ^ name)
   in f arg1 arg2 arg3
 
 let marshal4 conv1 conv2 conv3 conv4 name f argv =
   let arg1, arg2, arg3, arg4 =
     try
       get conv1 0, get conv2 1, get conv3 2, get conv4 3
-    with _ -> failwith ("GtkSignal.marhsal4 : " ^ name)
+    with _ -> failwith ("GtkSignal.marshal4 : " ^ name)
   in f arg1 arg2 arg3 arg4
 
 let marshal5 conv1 conv2 conv3 conv4 conv5 name f argv =
   let arg1, arg2, arg3, arg4, arg5 =
     try
       get conv1 0, get conv2 1, get conv3 2, get conv4 3, get conv5 4
-    with _ -> failwith ("GtkSignal.marhsal5 : " ^ name)
+    with _ -> failwith ("GtkSignal.marshal5 : " ^ name)
   in f arg1 arg2 arg3 arg4 arg5

clutter/clutterProps.ml

     open ClutterData
     let button_press_event =
       {name="button_press_event"; classe=`actor; marshaller=fun f ->
-       marshal2_ret ~ret:boolean (gobject : Clutter.actor obj data_conv)
-         (unsafe_pointer : Event.any data_conv)
+       marshal1_ret ~ret:boolean (unsafe_pointer : Event.any data_conv)
          "ClutterActor::button_press_event" f}
     let button_release_event =
       {name="button_release_event"; classe=`actor; marshaller=fun f ->
-       marshal2_ret ~ret:boolean (gobject : Clutter.actor obj data_conv)
-         (unsafe_pointer : Event.any data_conv)
+       marshal1_ret ~ret:boolean (unsafe_pointer : Event.any data_conv)
          "ClutterActor::button_release_event" f}
     let captured_event =
       {name="captured_event"; classe=`actor; marshaller=fun f ->
-       marshal2_ret ~ret:boolean (gobject : Clutter.actor obj data_conv)
-         (unsafe_pointer : Event.any data_conv)
+       marshal1_ret ~ret:boolean (unsafe_pointer : Event.any data_conv)
          "ClutterActor::captured_event" f}
-    let destroy =
-      {name="destroy"; classe=`actor; marshaller=fun f ->
-       marshal1 (gobject : Clutter.actor obj data_conv)
-         "ClutterActor::destroy" f}
+    let destroy = {name="destroy"; classe=`actor; marshaller=marshal_unit}
     let enter_event =
       {name="enter_event"; classe=`actor; marshaller=fun f ->
-       marshal2_ret ~ret:boolean (gobject : Clutter.actor obj data_conv)
-         (unsafe_pointer : Event.any data_conv) "ClutterActor::enter_event" f}
+       marshal1_ret ~ret:boolean (unsafe_pointer : Event.any data_conv)
+         "ClutterActor::enter_event" f}
     let event =
       {name="event"; classe=`actor; marshaller=fun f ->
-       marshal2_ret ~ret:boolean (gobject : Clutter.actor obj data_conv)
-         (unsafe_pointer : Event.any data_conv) "ClutterActor::event" f}
-    let focus_in =
-      {name="focus_in"; classe=`actor; marshaller=fun f ->
-       marshal1 (gobject : Clutter.actor obj data_conv)
-         "ClutterActor::focus_in" f}
+       marshal1_ret ~ret:boolean (unsafe_pointer : Event.any data_conv)
+         "ClutterActor::event" f}
+    let focus_in = {name="focus_in"; classe=`actor; marshaller=marshal_unit}
     let focus_out =
-      {name="focus_out"; classe=`actor; marshaller=fun f ->
-       marshal1 (gobject : Clutter.actor obj data_conv)
-         "ClutterActor::focus_out" f}
-    let hide =
-      {name="hide"; classe=`actor; marshaller=fun f ->
-       marshal1 (gobject : Clutter.actor obj data_conv)
-         "ClutterActor::hide" f}
+      {name="focus_out"; classe=`actor; marshaller=marshal_unit}
+    let hide = {name="hide"; classe=`actor; marshaller=marshal_unit}
     let key_press_event =
       {name="key_press_event"; classe=`actor; marshaller=fun f ->
-       marshal2_ret ~ret:boolean (gobject : Clutter.actor obj data_conv)
-         (unsafe_pointer : Event.any data_conv)
+       marshal1_ret ~ret:boolean (unsafe_pointer : Event.any data_conv)
          "ClutterActor::key_press_event" f}
     let key_release_event =
       {name="key_release_event"; classe=`actor; marshaller=fun f ->
-       marshal2_ret ~ret:boolean (gobject : Clutter.actor obj data_conv)
-         (unsafe_pointer : Event.any data_conv)
+       marshal1_ret ~ret:boolean (unsafe_pointer : Event.any data_conv)
          "ClutterActor::key_release_event" f}
     let leave_event =
       {name="leave_event"; classe=`actor; marshaller=fun f ->
-       marshal2_ret ~ret:boolean (gobject : Clutter.actor obj data_conv)
-         (unsafe_pointer : Event.any data_conv) "ClutterActor::leave_event" f}
+       marshal1_ret ~ret:boolean (unsafe_pointer : Event.any data_conv)
+         "ClutterActor::leave_event" f}
     let motion_event =
       {name="motion_event"; classe=`actor; marshaller=fun f ->
-       marshal2_ret ~ret:boolean (gobject : Clutter.actor obj data_conv)
-         (unsafe_pointer : Event.any data_conv)
+       marshal1_ret ~ret:boolean (unsafe_pointer : Event.any data_conv)
          "ClutterActor::motion_event" f}
     let parent_set =
       {name="parent_set"; classe=`actor; marshaller=fun f ->
-       marshal2 (gobject : Clutter.actor obj data_conv)
-         (gobject : Clutter.actor obj data_conv) "ClutterActor::parent_set" f}
+       marshal1 (gobject : Clutter.actor obj data_conv)
+         "ClutterActor::parent_set" f}
     let scroll_event =
       {name="scroll_event"; classe=`actor; marshaller=fun f ->
-       marshal2_ret ~ret:boolean (gobject : Clutter.actor obj data_conv)
-         (unsafe_pointer : Event.any data_conv)
+       marshal1_ret ~ret:boolean (unsafe_pointer : Event.any data_conv)
          "ClutterActor::scroll_event" f}
-    let show =
-      {name="show"; classe=`actor; marshaller=fun f ->
-       marshal1 (gobject : Clutter.actor obj data_conv)
-         "ClutterActor::show" f}
+    let show = {name="show"; classe=`actor; marshaller=marshal_unit}
   end
   external show : [>`actor] obj -> unit = "ml_clutter_actor_show"
   external show_all : [>`actor] obj -> unit = "ml_clutter_actor_show_all"

clutter/clutterScore.ml

     fun ~parent ~marker t ->
       Score.append_at_marker obj ~parent:parent#obj ~marker t#obj
   method list_timelines = Score.list_timelines obj
+  method remove = Score.remove obj
+  method remove_all = Score.remove_all obj
+  method get_timeline = Score.get_timeline obj
   method start = Score.start obj
+  method pause = Score.pause obj
+  method stop = Score.stop obj
+  method is_playing = Score.is_playing obj
+  method rewind = Score.rewind obj
 end
 
 let make_score ~create =

clutter/ml_score.c

 #include "ml_score.h"
 #include "ml_timeline.h"
 
+#define gobject_list_of_GSList_free(l)  Val_GSList_free (l, (value_in) Val_GObject)
+
 static struct custom_operations ml_clutter_score_ops = {
   "ClutterScore",
   custom_finalize_default,
 				   ClutterTimeline_val(t))));
 }
 
+#define Val_GtkTextTag_new(val) (Val_GObject_new((GObject*)val))
 // FIXME: ensure this use of Val_ClutterTimeline_ is OK
 CAMLprim value ml_clutter_score_list_timelines(value score)
 {
   CAMLparam1(score);
   GSList* ts = clutter_score_list_timelines(ClutterScore_val(score));
-  CAMLreturn(Val_GSList(ts, Val_ClutterTimeline_));
+  CAMLreturn(gobject_list_of_GSList_free(ts));
+  /// of should I use Val_GSList_free ? I assume this is a memory leak
+  //CAMLreturn(Val_GSList_free(ts, (value_in)Val_ClutterTimeline));
 }
 
 ML_4(clutter_score_append_at_marker, ClutterScore_val, ClutterTimeline_val,

clutter/wrappers.h

 CAMLexport void ml_register_exn_map (GQuark domain, char *caml_name);
 CAMLexport void ml_raise_gerror(GError *) Noreturn;
 
+// taken from ml_gobject.h
+CAMLexport value Val_GObject (GObject *);
+CAMLexport value Val_GObject_new (GObject *);
+
 #endif /* _wrappers */

examples/flowers.ml

     ) in
   let _ = GMain.Timeout.add 50 (fun _ -> tick flowers) in
   stage#show_all;
-  let _ = stage#connect#key_press_event (fun _ _ -> clutter_quit (); true) in
+  let _ = stage#connect#key_press_event (fun _ -> clutter_quit (); true) in
   clutter_main ()
 
     

tests/test-behave.ml

   stage#hide_cursor;
 
   let _ = stage#connect#button_press_event
-    (fun _ evt ->
+    (fun evt ->
        let mods = Event.get_state evt in
        List.iter (function
 		      `SHIFT_MASK -> printf "SHIFT\n%!"
        false
     )
   and _ = stage#connect#scroll_event
-    (fun _ evt ->
+    (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
+    (fun _ -> main_quit (); true ) in
 
   stage#set_color stage_color;
   let group = Group.create () in

tests/test-depth.ml

   back#set_rotation `Y_AXIS ~angle:180. ~x:(width/2) ~y:0 ~z:0;
   (* FIXME:*)
   group#add_many [|to_actor back; to_actor rectangle; to_actor front|];
-  (*group#add back;
-  group#add rectangle;
-  group#add front;*)
   group#show_all;
   group
 
   stage#set_color stage_color;
   stage#set_use_fog true;
   stage#set_fog ~density:1. ~z_near:10. ~z_far:(-50.);
-  let _ = stage#connect#button_press_event (fun _ evt -> main_quit (); true) in
+  let _ = stage#connect#button_press_event (fun evt -> main_quit (); true) in
   let group = Group.create () in
   stage#add group;
   group#show;

tests/test-effect.ml

   let stage = ClutterStage.get_default () in
 
   let _ = stage#connect#button_press_event
-    (fun _ _ -> printf "got a button press\n%!"; Clutter.quit (); true) in
+    (fun _ -> printf "got a button press\n%!"; Clutter.quit (); true) in
   stage#set_color stage_color;
   stage#set_use_fog true;
   stage#set_size ~width:800 ~height:600;

tests/test-project.ml

   
 let on_event rect points stage =
   let dragging = ref None in
-  fun _ evt -> match Event.get_type evt with
+  fun evt -> match Event.get_type evt with
       `BUTTON_PRESS ->
 	let x,y = Event.get_coords evt in
 	printf "button_press: x=%d y=%d\n%!" x y;
     | `BUTTON_RELEASE ->
 	dragging := None;
 	true
+    | `ENTER -> printf "enter\n%!"; true
+    | `LEAVE -> printf "leave\n%!"; true
+    | `STAGE_STATE -> printf "stage_state\n%!"; true
     | _ ->
-	g_debug "received irrelevant event";
-	true
+	printf "irrelevant event\n%!"; true
+	(*g_debug "received irrelevant event";
+	true*)
 	  
   
 let _ =
   
   
   rect#set_rotation `Y_AXIS ~angle:60. ~x:0 ~y:0 ~z:0;
+  rect#set_reactive true;
+  let _ = rect#connect#enter_event (fun _ -> printf "rect enter\n%!"; true) in
+  let _ = rect#connect#leave_event (fun _ -> printf "rect leave\n%!"; true) in
+  let _ = rect#connect#button_press_event
+    (fun _ -> printf "rect press\n%!"; true) in
+  let _ = rect#connect#button_release_event
+    (fun _ -> printf "rect release\n%!"; true) in
+  let _ = rect#connect#destroy ( fun () -> printf "rect destroy\n%!") in
+  let _ = rect#connect#focus_in ( fun () -> printf "rect focusin\n%!") in
+  let _ = rect#connect#focus_out (fun () -> printf "rect focusout\n%!") in
+  let _ = rect#connect#parent_set (fun _ -> printf "rect parentset\n%!") in
+  let _ = rect#connect#key_press_event
+    (fun _ -> printf "rect keypress\n%!"; true) in
+  let _ = rect#connect#key_release_event
+    (fun _ -> printf "rect keyrelease\n%!"; true) in
   main_stage#add rect;
 
   let label = ClutterLabel.label ~font_name:"Mono 8pt"