Commits

Reid van Melle committed eed8842

added test-unproject (minor bug in comparing actor objs)

Comments (0)

Files changed (7)

 external angle_to_degx : angle -> units = "ml_clutter_angle_to_degx"
 let units_from_float = float_to_units
 let units_from_int = int_to_units
+let units_from_device = int_to_units
+let units_to_device = units_to_int
 let to_device = units_to_int
 let from_device = int_to_units
 external from_stage_width_percentage : int -> units

src/clutter.props

   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:int -> y:int -> (int*int)"
+  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 get_transformed_position : "int*int"
   method get_transformed_size : "int*int"

src/clutterActor.ml

   method move_anchor_point = Actor.move_anchor_point obj
   method move_anchor_point_from_gravity =
     Actor.move_anchor_point_from_gravity obj
+  method transform_stage_point = Actor.transform_stage_point obj
   method id = Gobject.get_oid obj
   method as_actor = obj
   method allocate box = Actor.allocate obj (ActorBox.unwrap box)

src/clutterLabel.ml

        let t = Label.create pl in
        new label t)
 
+let new_with_text font_name text = label ~font_name ~text
+
   CAMLreturn(result);
 }
 
+CAMLprim value ml_clutter_actor_transform_stage_point(value _a, value _x,
+						      value _y)
+{
+  CAMLparam3(_a, _x, _y);
+  CAMLlocal1(result);
+  ClutterActor* a = ClutterActor_val(_a);
+  result = caml_alloc(3,0);
+  ClutterUnit x_out, y_out;
+  gboolean success = clutter_actor_transform_stage_point
+    (a, Int_val(_x), Int_val(_y), &x_out, &y_out);
+  Store_field(result, 0, Val_bool(success));
+  Store_field(result, 1, Val_int(x_out));
+  Store_field(result, 2, Val_int(y_out));
+  CAMLreturn(result);
+}
+
 CAMLprim value ml_clutter_actor_apply_transform_to_point(value _a, value _point) {
   CAMLparam2(_a, _point);
   CAMLlocal1(result);

tests/Makefile.in

 # test-cogl-tex-file --> need to finish this one test-events
 TARGETS	:= test-behave test-events test-cogl-primitives \
 	test-depth test-effect test-entry test-project \
-	test-rotate test-score test-scale
+	test-rotate test-score test-scale test-unproject
 BYTE_TARGETS    := $(TARGETS:=.byte)
 OPT_TARGETS	:= $(TARGETS:=.opt)
 
 all: $(OPT_TARGETS) ../src/mlclutter.cmxa
 byte: $(BYTE_TARGETS)
 
+test-unproject: test-unproject.cmo
+	ocamlfind ocamlc $(OCAMLCPACKAGES) $(OCAMLCFLAGS) $(OCAMLCLIBS) -o $@ $^
+
+test-unproject.opt: test-unproject.cmx
+	ocamlfind ocamlopt $(OCAMLOPTPACKAGES) $(OCAMLOPTFLAGS) $(OCAMLOPTLIBS) -o $@ $^
+
 test-behave: test-behave.cmo
 	ocamlfind ocamlc $(OCAMLCPACKAGES) $(OCAMLCFLAGS) $(OCAMLCLIBS) -o $@ $^
 

tests/test-unproject.ml

+
+open Clutter
+module Stage = ClutterStage
+module Rectangle = ClutterRectangle
+module Label = ClutterLabel
+
+let _ =
+  let rect_l = 200 and rect_t = 150 and rect_w = 320 and rect_h = 240 in
+  let stage_clr = Color.rgb (0x0, 0x0, 0x0)
+  and white = Color.rgb (0xff, 0xff, 0xff)
+  and blue = Color.rgb (0, 0xff, 0xff) in
+
+  let rotate_x = ref 0. and rotate_y = ref 60. and rotate_z = ref 0. in
+
+  Array.iteri (fun i arg -> match arg with
+		   "--rotate-x" -> rotate_x := float_of_string Sys.argv.(i+1)
+		 | "--rotate-y" -> rotate_y := float_of_string Sys.argv.(i+1)
+		 | "--rotate-z" -> rotate_z := float_of_string Sys.argv.(i+1)
+		 | "--help" ->
+		     Printf.printf "%s\n%!"
+		       (Sys.argv.(0) ^ " [--rotate-x degrees] " ^
+		       "[--rotate-y degrees]" ^
+		       "[--rotate-z degrees]");
+		     exit 0
+		 | _ -> ()
+	      ) Sys.argv;
+  
+  let stage = Stage.get_default () in
+  stage#set_color stage_clr;
+  stage#set_size 640 480;
+
+  let rect = Rectangle.new_with_color white () in
+  rect#set_size rect_w rect_h;
+  rect#set_position rect_l rect_t;
+  rect#set_rotation `X_AXIS !rotate_x 0 0 0;
+  rect#set_rotation `Y_AXIS !rotate_y 0 0 0;
+  rect#set_rotation `Z_AXIS !rotate_z 0 0 0;
+
+  stage#add rect;
+
+  let txt = Printf.sprintf "Rectangle: L %d, R %d, T %d, B %d\n
+    Rotation: x %g, y %g, z %g" rect_l (rect_l + rect_w)
+    rect_t (rect_t + rect_h) !rotate_x !rotate_y !rotate_z in
+  let label0 = Label.new_with_text "Mono 8pt" txt () in
+  label0#set_color white;
+  label0#set_position 10 10;
+  stage#add label0;
+
+  let label = Label.new_with_text "Mono 8pt" "Click around!" () in
+  label#set_color blue;
+  label#set_position 10 50;
+  stage#add label;
+
+  stage#show_all;
+
+  let _ = stage#connect#event
+    (fun evt ->
+       match Event.get_type evt with
+	   `BUTTON_PRESS ->
+	     let x,y = Event.get_coords evt in
+	     let actor = stage#get_actor_at_pos x y in
+
+	     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 txt =
+		 Printf.sprintf "Click on %s\n
+		   Screen coords: [%d, %d]\n
+		   Local coords: [%d, %d]" what x y
+		   (units_to_device xu2)
+		   (units_to_device yu2)
+	       in
+	       label#set_text txt;
+	     end else
+	       label#set_text "Unprojection failed";
+	     true
+	 | _ -> false
+    ) in
+  
+  clutter_main ()
+    
+