Commits

Reid van Melle committed aba7361

A number of fixme's... mostly around comparing pointer values and dealing
with null actor objects

Comments (0)

Files changed (8)

 external cfx_one : unit -> units = "ml_clutter_cfx_one"
 external cfx_qmul : units -> units -> units = "ml_clutter_cfx_qmul"
   
+(** comparing boxed pointer values for actors *)
+let actor_objs_equal (a:[> `actor] obj) (b:[> `actor] obj) =
+  (Gpointer.peek_int (Obj.magic a)) = (Gpointer.peek_int (Obj.magic b))
+let actors_equal a b = actor_objs_equal (a#obj) (b#obj)
+let null_actor_obj : [`actor] obj = Obj.magic Gpointer.boxed_null
+
 (* FIXME: put some correct enforcement here *)
 external as_stage : 'a obj -> stage obj = "ml_clutter_as_container"
 external as_container : 'a obj -> container obj = "ml_clutter_as_container"

src/clutter.props

   method has_clip: "bool"
   (* method get_clip: "*)
   method set_parent : "unit"
-  method get_parent : "Clutter.actor"
-  method reparent : "Clutter.actor -> unit"
+  method get_parent : "Clutter.actor obj"
+  method reparent : "Clutter.actor obj -> unit"
   method unparent : "unit"
-  method raise : "Clutter.actor -> unit"
-  method lower : "Clutter.actor -> unit"
+  method raise : "Clutter.actor obj -> unit"
+  method lower : "Clutter.actor obj -> unit"
   method raise_top: "unit"
   method lower_bottom: "unit"
   
-  method get_stage : "Clutter.actor"
+  method get_stage : "Clutter.actor obj"
   method set_scale : "xscale:float -> yscale:float -> unit"
   method is_scaled : "bool"
   method apply_transform_to_point : "Clutter.vertex -> Clutter.vertex"
   method transform_stage_point : "x:Clutter.units -> y:Clutter.units -> (units*units*bool)"
-  method apply_relative_transform_to_point : "ancestor:Clutter.actor -> point:Clutter.vertex -> vertex:Clutter.vertex -> unit"
+  method apply_relative_transform_to_point : "ancestor:Clutter.actor obj -> point:Clutter.vertex -> vertex:Clutter.vertex -> unit"
   method get_transformed_position : "int*int"
   method get_transformed_size : "int*int"
   method get_paint_opacity : "int"

src/clutterActor.ml

   method queue_redraw = Actor.queue_redraw obj
   method queue_relayout = Actor.queue_relayout obj
   method destroy = Actor.destroy obj
-  
+
 end
 
 let to_actor a = (a :> [< `actor] actor_skel)
 
-class actor obj = object
+class actor obj = object(self)
   inherit ['a] actor_skel (obj : [> `actor] Clutter.obj)
   method obj = obj
   method connect = new actor_signals_impl obj

src/clutterGroup.ml

   inherit ClutterContainer.container_skel (as_container obj)
   inherit ['a] ClutterActor.actor_skel (as_actor obj)
   method private obj : group Clutter.obj = obj
-  method add_many : 'a. (#ClutterActor.actor_o as 'a) array -> unit =
+  (*method add_many : 'a. (#ClutterActor.actor_o as 'a) array -> unit =
     fun items ->
-      ClutterProps.Group.add_many obj (Array.map (fun x -> x#as_actor) items)
+      Group.add_many obj (Array.map (fun x -> x#as_actor) items)*)
+  method add_many : [> `actor] obj array -> unit = Group.add_many obj
 end
 
 class group_signals_impl obj = object
 end
 
 let create ?(actors=[]) () =
-  let obj = ClutterProps.Group.create [] in
+  let obj = Group.create [] in
   let g = new group obj in
   List.iter g#add_actor actors;
   g

src/clutterStage.ml

     new ClutterActor.actor (Stage.get_actor_at_pos obj ~x ~y)
   method show_cursor = self#set_cursor_visible true
   method hide_cursor = self#set_cursor_visible false
-  method set_key_focus : 'a. (#ClutterActor.actor_o as 'a) -> unit =
-    fun a -> Stage.set_key_focus obj a#as_actor
+  method set_key_focus : 'a. (#ClutterActor.actor_o as 'a) option -> unit =
+    fun a -> match a with
+	Some a -> Stage.set_key_focus obj a#as_actor
+      | None -> Stage.set_key_focus obj null_actor_obj
   method set_fog = Stage.set_fog obj
   method get_fog = Stage.get_fog obj
   method set_perspective = Stage.set_perspective obj

tests/test-depth.ml

 
   rectangle#set_size ~width ~height;
   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|];
+  (* FIXME ? :
+  group#add_many [|back; rectangle; front|];
+  group#add_many [|to_actor back; to_actor rectangle; to_actor front|];*)
+  group#add_many [|back#as_actor; rectangle#as_actor; front#as_actor|];
   group#show_all;
   group
 

tests/test-events.ml

   false
 
 let key_focus_in_cb focus_box actor () =
-  (* FIXME
-    if actor#obj = Stage.get_default () then
+  if actors_equal actor (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
+  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
+  end
 
 let fill_keybuf key_event =
   let result = List.fold_left
 		(*(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;
+	if actor_objs_equal (Event.get_source event) stage#obj then
+	  stage#set_key_focus None
+	else if (actor_objs_equal (Event.get_source event) actor#obj) &&
+	  (actor_objs_equal actor#get_parent stage#obj) then
+	    stage#set_key_focus (Some 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
 
   (* Toggle motion - enter/leave capture *)
   and _ = actor#connect#button_press_event (red_button_cb actor) in
-  stage#set_key_focus actor;
+  stage#set_key_focus (Some actor);
   let actor = Rectangle.new_with_color gcol () in
   actor#set_size 100 100;
   actor#set_position 250 100;

tests/test-unproject.ml

 
 	     let xu2, yu2, success = actor#transform_stage_point
 	       (units_from_device x) (units_from_device y) in
+	     
 	     if success then begin
-	       (* FIXME:
-		  let what = if actor#obj == stage#obj
-		  then "rectangle" else "stage" in
-	       *)
-	       let what = "rectangle" in
-
+	       let what = if actors_equal actor stage
+	       then "stage" else "rectangle" in
 	       let txt =
 		 Printf.sprintf "Click on %s\n
 		   Screen coords: [%d, %d]\n