Commits

Reid van Melle committed 82d3758

Got the test-rotate working

  • Participants
  • Parent commits 6e6127f

Comments (0)

Files changed (9)

 examples/ripples.native
 tests/test-effect.native
 tests/test-entry.native
+tests/test-rotate.native
 tests/test-behave.native
 tests/test-project.native
 tests/test-cogl-tex-file.native

File clutter/clutterActor.ml

   method connect = new actor_signals_impl obj
 end
 
+(** ClutterEntry: A single line text entry actor *)
 module Entry = struct
   class entry_skel obj = object (self)
     inherit ['a] actor_skel (as_actor obj)
 	 let t = Entry.create pl in
 	 new entry t)
 end
+
+(** ClutterLabel: Actor for displaying text *)
+module Label = struct
+  class label_skel obj = object (self)
+    inherit ['a] actor_skel (as_actor obj)
+    inherit label_props 
+    method obj : label Clutter.obj = obj
+  end
+
+  class label obj = object
+    inherit label_skel (obj : [> `label] Clutter.obj)
+    method connect = new actor_signals_impl obj
+  end
+    
+  let make_label ~create =
+    Label.make_params ~cont:
+      (fun pl ->
+	 Actor.make_params pl ~cont:
+	   (fun pl () ->
+	      let (e : #label_skel) = create pl in
+	      e)
+      )
+      
+  let create =
+    make_label [] ~create:
+      (fun pl ->
+	 let t = Label.create pl in
+	 new label t)
+end

File clutter/clutterBehaviour.ml

 
 class virtual behaviour_skel (obj : behaviour obj) = object(self)
   inherit behaviour_props
-  method apply = Behaviour.apply obj
+  method apply : 'a. (#ClutterActor.actor_o as 'a) -> unit =
+    fun a -> Behaviour.apply obj a#as_actor
 end
 
 (** Behaviour controlling the opacity *)
     inherit behaviour_rotate_props
     inherit behaviour_skel (as_behaviour obj)
     method obj : behaviour_rotate obj = obj
+    method set_center ~x ~y ~z =
+      self#set_center_x x;
+      self#set_center_y y;
+      self#set_center_z z
   end
 
   class rotate obj = object
 	   (fun pl () ->
 	      let (e : #rotate_skel) = create pl in e))
 
-  let create =
-    make_rotate [] ~create:(fun pl -> new rotate (BehaviourRotate.create pl))
+  let create ~alpha =
+    make_rotate [] ~alpha:(alpha#obj) ~create:(fun pl -> new rotate (BehaviourRotate.create pl))
 
 end
 

File clutter/clutterTexture.ml

        let t = ClutterProps.Texture.create pl in
        new texture t)
 
-let from_file fn =
-  texture ~filename:fn ()
+let new_from_file fn = texture ~filename:fn ()
 

File clutter/clutterTimeline.ml

     (fun pl ->
        let t = Timeline.create pl in
        new timeline t)
+let create = timeline
 
 let for_duration duration = timeline ~duration ()

File examples/behave.ml

   let ellipse = Behaviour.ellipse ~alpha:alpha#obj
     ~center:(200,200) ~width:400
     ~height:300 ~direction:`ROTATE_CW ~angle_start:0. ~angle_end:360. () in
-  ellipse#apply actor#as_actor;
+  ellipse#apply actor;
   let behave = Behaviour.opacity ~alpha:alpha#obj ~opacity_start:0
     ~opacity_end:0xff () in
-  behave#apply actor#as_actor;
+  behave#apply actor;
   stage#show_all;
   timeline#start;
   main ()

File tests/test-behave.ml

   group#show;
 
   let hand = try
-    Texture.from_file "./examples/redhand.png"
+    Texture.new_from_file "./examples/redhand.png"
   with GError _ -> exit (-1)
   in
 
   let o_behave = Behaviour.opacity ~alpha:alpha#obj ~opacity_start:0x33
     ~opacity_end:0xff () in
 
-  o_behave#apply group#as_actor;
+  o_behave#apply group;
 
   let p_behave = match path_type with
       "poly" ->
 	(b :> Behaviour.behaviour_skel)
     | _ -> assert false
   in
-  p_behave#apply group#as_actor;
+  p_behave#apply group;
 
   timeline#start;
   stage#show_all;

File tests/test-entry.ml

   stage#set_color stage_color;
   stage#set_title "ClutterEntry Test";
 
-  let entry = Entry.create ~text:("Sans 14 Type something, be sure to use " ^
-    "the left/right arrow keys to move the cursor position.")
+  let entry = Entry.create ~font_name:"Sans 14"
+    ~text:("Type something, be sure to use " ^
+	     "the left/right arrow keys to move the cursor position.")
     ~color:entry_color ~width:600 ~height:15 ~x:100 ~y:100 () in
   stage#add entry;
   stage#set_key_focus entry;

File tests/test-rotate.ml

+
+
+open Printf
+open Clutter
+module Stage = ClutterStage
+module Texture = ClutterTexture
+module Timeline = ClutterTimeline
+module Alpha = ClutterAlpha
+module Label = ClutterActor.Label
+module Behaviour = ClutterBehaviour
+
+let _ =
+
+  let stage_color = Color.rgb (0xcc, 0xcc, 0xcc) in
+  let stage = Stage.get_default () in
+  stage#set_color stage_color;
+  let hand = try
+    Texture.new_from_file "./examples/redhand.png"
+  with GError _ -> assert(false) in
+  hand#set_position ~x:240 ~y:140;
+  hand#show;
+  stage#add_actor hand;
+
+  let label = Label.create ~font_name:"Mono 16"
+    ~text:"The Wonder of the Spinning Hand" ~alignment:`CENTER
+    ~x:150 ~y:150 ~width:500 ~height:100 () in
+  label#show;
+  stage#add_actor label;
+
+  let timeline = Timeline.create ~num_frames:200 ~fps:26 ~loop:true () in
+  let alpha = Alpha.create ~timeline ~alpha_func:`RAMP_INC in
+  let r_behave = Behaviour.Rotate.create ~alpha ~axis:`Z_AXIS
+    ~direction:`ROTATE_CW
+    ~angle_start:0. ~angle_end:360. () in
+  r_behave#set_center ~x:86 ~y:125 ~z:0;
+
+  r_behave#apply hand;
+  r_behave#apply label;
+
+  timeline#start;
+  stage#show_all;
+
+  clutter_main ()
+  
+