Commits

Reid van Melle committed 1900986

Got some basic enumeration registration and lookup working.

Comments (0)

Files changed (11)

 <*>: use_clutter
-<clutter.*>: use_gtk
+<clutter.*> or <clutterEnums.*>: use_gtk

clutter/clutter.ml

 external main : unit -> unit = "clutter_main"
     
 module Actor = struct
+  module E = ClutterEnums
   external set_position : actor -> int -> int -> unit
     = "ml_clutter_actor_set_position"
-  (*external rotate_z : actor -> float -> float -> float -> unit
-    = "clutter_actor_rotate_z"*)
+  external set_rotation : actor -> int -> float -> int ->
+    int -> int -> unit = "ml_clutter_actor_set_rotation_bc"
+    "ml_clutter_actor_set_rotation"
   external show_all : actor -> unit = "ml_clutter_actor_show_all"
   external get_width : actor -> int = "ml_clutter_actor_get_width"
   external get_height : actor -> int = "ml_clutter_actor_get_height"    

clutter/clutterEnums.ml

+
+type rotate_axis_type = [ `X_AXIS | `Y_AXIS | `Z_AXIS ]
+type rotate_direction_type = [ `ROTATE_CW | `ROTATE_CCW ]
+
+(**/**)
+
+(* Variant tables *)
+
+type 'a variant_table constraint 'a = [> ]
+
+external decode_variant : 'a variant_table -> int -> 'a
+  = "ml_ml_clutter_lookup_from_c"
+external encode_variant : 'a variant_table -> 'a -> int
+  = "ml_ml_clutter_lookup_to_c"
+    
+module Data = struct
+  let enum tbl =
+    { Gobject.kind = `ENUM;
+      proj = (function `INT c -> decode_variant tbl c
+             | _ -> failwith "Clutter.get_enum");
+      inj = (fun c -> `INT (encode_variant tbl c)) }
+end;;
+
+external _get_tables : unit ->
+  rotate_axis_type variant_table
+  * rotate_direction_type variant_table
+  = "ml_clutter_get_tables"
+
+let rotate_axis_type, rotate_direction_type = _get_tables ()
+
+let _make_enum = Data.enum
+let rotate_axis_type_conv = _make_enum rotate_axis_type
+let rotate_direction_type_conv = _make_enum rotate_direction_type

clutter/clutter_tags.c

+#include "wrappers.h"
+#include "clutter_tags.h"
+
+/* attach_options : conversion table */
+const lookup_info ml_table_rotate_axis_type[] = {
+  { 0, 3 },
+  { MLTAG_X_AXIS, CLUTTER_X_AXIS },
+  { MLTAG_Z_AXIS, CLUTTER_Z_AXIS },
+  { MLTAG_Y_AXIS, CLUTTER_Y_AXIS },
+};
+
+/* attach_options : conversion table */
+const lookup_info ml_table_rotate_direction_type[] = {
+  { 0, 2 },
+  { MLTAG_ROTATE_CCW, CLUTTER_ROTATE_CCW },
+  { MLTAG_ROTATE_CW, CLUTTER_ROTATE_CW },
+};
+
+CAMLprim value ml_clutter_get_tables ()
+{
+  static const lookup_info *ml_clutter_lookup_tables[] = {
+    ml_table_rotate_axis_type,
+    ml_table_rotate_direction_type,
+  };
+  return (value)ml_clutter_lookup_tables;
+}

clutter/clutter_tags.h

+
+
+/* rotate_axis_type : tags and macros */
+#define MLTAG_X_AXIS	Val_int(229818664)
+#define MLTAG_Y_AXIS	Val_int(873340295)
+#define MLTAG_Z_AXIS	Val_int(443120102)
+
+extern const lookup_info ml_table_rotate_axis_type[];
+#define Val_rotate_axis_type(data) ml_clutter_lookup_from_c (ml_rotate_axis_type, data)
+#define Rotate_Axis_type_val(key) ml_clutter_lookup_to_c (ml_table_rotate_axis_type, key)
+
+/* rotate_direction_type : tags and macros */
+#define MLTAG_ROTATE_CW  Val_int(632228184)
+#define MLTAG_ROTATE_CCW Val_int(326701715)
+
+extern const lookup_info ml_table_rotate_direction_type[];
+#define Val_rotate_direction_type(data) ml_clutter_lookup_from_c (ml_table_rotate_direction_type, data)
+#define Rotate_Direction_type_val(key) ml_clutter_lookup_to_c (ml_table_rotate_direction_type, key)

clutter/ml_actor.c

 #include "wrappers.h"
+#include "clutter_tags.h"
 
 static struct custom_operations ml_clutter_actor_ops = {
   "ClutterActor",
 ML_1(clutter_actor_get_width, ClutterActor_val, Val_int);
 ML_1(clutter_actor_get_height, ClutterActor_val, Val_int);
 ML_3(clutter_actor_set_position, ClutterActor_val, Int_val, Int_val, Unit);
+ML_6(clutter_actor_set_rotation, ClutterActor_val, Rotate_Axis_type_val, Float_val, Int_val, Int_val, Int_val, Unit);
+ML_bc6(ml_clutter_actor_set_rotation);

clutter/wrappers.c

 #include "wrappers.h"
 
-void ml_raise_null_pointer ()
+/*
+  Apparently, we can just pick this up from GTK
+  void ml_raise_null_pointer ()
 {
   static value * exn = NULL;
   if (exn == NULL)
       exn = caml_named_value ("null_pointer");
   raise_constant (*exn);
-}   
+  }
+*/
+
+value ml_clutter_lookup_from_c (const lookup_info table[], int data)
+{
+  int i;
+  for (i = table[0].data; i > 0; i--)
+    if (table[i].data == data) return table[i].key;
+  invalid_argument ("ml_clutter_lookup_from_c");
+}
+
+int ml_clutter_lookup_to_c (const lookup_info table[], value key)
+{
+  int first = 1, last = table[0].data, current;
+  //printf("%li %li %li\n", Val_int(229818664), Val_int(873340295), Val_int(443120102));
+  //printf("lookup: %li\n", key);
+  //int i;
+  //for (i=1; i<=last; i++) {
+  //  printf("table @ %d = %li\n", i, table[i].key);
+  //};
+  while (first < last) {
+    current = (first+last)/2;
+    if (table[current].key >= key) last = current;
+    else first = current + 1;
+  }
+  if (table[first].key == key) return table[first].data;
+  invalid_argument ("ml_clutter_lookup_to_c");
+}
+
+ML_2 (ml_clutter_lookup_from_c, (lookup_info*), Int_val, 0+)
+ML_2 (ml_clutter_lookup_to_c, (lookup_info*), 0+, Val_int)

clutter/wrappers.h

 #include <caml/custom.h>
 #include <caml/memory.h>
 
+/* enums <-> polymorphic variants */
+typedef struct { value key; int data; } lookup_info;
+value ml_clutter_lookup_from_c (const lookup_info table[], int data);
+int ml_clutter_lookup_to_c (const lookup_info table[], value key);
+value ml_lookup_flags_getter (const lookup_info table[], int data);
+
 void ml_raise_null_pointer (void) Noreturn;
 
+/* result conversion */
 #define Unit(x) ((x), Val_unit)
+#define Id(x) x
+#define Val_char Val_int
+
+/* parameter conversion */
+#define Bool_ptr(x) ((long) x - 1)
+#define Char_val Int_val
+#define Float_val(x) ((float)Double_val(x))
+#define SizedString_val(x) String_val(x), string_length(x)
+
+
 // The three definitions below are taken directly from
 // the lablbtk source tree:
 // Pointer_val, ML_3 --> wrappers.h
                        value arg5) \
 { return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), \
 		      conv5(arg5))); }
+#define ML_6(cname, conv1, conv2, conv3, conv4, conv5, conv6, conv) \
+CAMLprim value ml_##cname (value arg1, value arg2, value arg3, value arg4, \
+                           value arg5, value arg6) \
+{ return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), \
+		      conv5(arg5), conv6(arg6))); }
+#define ML_7(cname, conv1, conv2, conv3, conv4, conv5, conv6, conv7, conv) \
+CAMLprim value ml_##cname (value arg1, value arg2, value arg3, value arg4, \
+                           value arg5, value arg6, value arg7) \
+{ return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), \
+		      conv5(arg5), conv6(arg6), conv7(arg7))); }
+
+/* For more than 5 arguments */
+#define ML_bc6(cname) \
+CAMLprim value cname##_bc (value *argv, int argn) \
+{ return cname(argv[0],argv[1],argv[2],argv[3],argv[4],argv[5]); }
+#define ML_bc7(cname) \
+CAMLprim value cname##_bc (value *argv, int argn) \
+{ return cname(argv[0],argv[1],argv[2],argv[3],argv[4],argv[5],argv[6]); }
 
 #endif /* _wrappers */

examples/actor1.ml

 
-(*
 
-int
-main (int argc, char *argv[])
-{
-  ClutterActor    *stage, *actor;
-  GdkPixbuf       *pixbuf;
-
-  clutter_init (&argc, &argv);
-  stage = clutter_stage_get_default ();
-  pixbuf = gdk_pixbuf_new_from_file ("ohpowers.png", NULL);
-  actor  = clutter_texture_new_from_pixbuf (pixbuf);
-  clutter_container_add_actor (CLUTTER_CONTAINER (stage), actor);
-  clutter_actor_set_position (actor, 100, 100);
-  clutter_actor_rotate_z (actor, 180.0, 
-			  clutter_actor_get_width (actor)/2,
-			  clutter_actor_get_height (actor)/2);
-
-  clutter_actor_show_all (stage);
-  clutter_main();
-  return 0;
-}
-  
-*)
 
 open Printf
-  (*Clutter.Actor.rotate_z actor 180.
-    ((Clutter.Actor.get_width actor) /. 2.)
-    ((Clutter.Actor.get_height actor) /. 2.);*)
+  
 let _ =
   let stage = Clutter.Stage.get_default () in
   let pixbuf = GdkPixbuf.from_file "./examples/ohpowers.png" in
   let actor = Clutter.Texture.from_pixbuf pixbuf in
   Clutter.Container.add_actor stage actor;
   Clutter.Actor.set_position actor 100 100;
+  Clutter.Actor.set_rotation actor (Hashtbl.hash `Z_AXIS) 180.
+    ((Clutter.Actor.get_width actor) / 2)
+    ((Clutter.Actor.get_height actor) / 2) 0;
   Clutter.Actor.show_all stage;
   Clutter.main ()
 

examples/actor2.ml

-(*
-
-  ClutterActor    *stage, *actor1, *actor2, *group;
-  GdkPixbuf       *pixbuf;
-
-  clutter_init (&argc, &argv);
-
-  stage = clutter_stage_get_default ();
-
-  pixbuf = gdk_pixbuf_new_from_file ("ohpowers.png", NULL);
-
-  group = clutter_group_new ();
-
-  actor1  = clutter_texture_new_from_pixbuf (pixbuf);
-  actor2  = clutter_texture_new_from_pixbuf (pixbuf);
-
-  clutter_container_add (CLUTTER_CONTAINER (group), actor1 ,actor2, NULL);
-  
-  clutter_actor_set_position (actor1, 0, 0);
-  clutter_actor_set_position (actor2, 200, 0);
-
-  clutter_container_add_actor (CLUTTER_CONTAINER (stage), group);
-  clutter_actor_set_position (group, 100, 100);
-
-  clutter_actor_rotate_z (group, 45.0, 
-			  clutter_actor_get_width (group)/2,
-			  clutter_actor_get_height (group)/2);
-
-  clutter_actor_show_all (group);
-  clutter_actor_show_all (stage);
-
-  clutter_main();
-*)
 
 let _ =
   let stage = Clutter.Stage.get_default () in
   Clutter.Container.add_actor stage group;
   Clutter.Actor.set_position group 100 100;
 
+  Clutter.Actor.set_rotation group (Hashtbl.hash `Z_AXIS) 45.
+    ((Clutter.Actor.get_width group) / 2)
+    ((Clutter.Actor.get_height group) / 2) 0;
+
   Clutter.Actor.show_all group;
   Clutter.Actor.show_all stage;
 

examples/behave.ml

   let stage = Stage.get_default () in
   let pixbuf = GdkPixbuf.from_file "./examples/ohpowers.png" in
   let actor = Texture.from_pixbuf pixbuf in
-  Clutter.Container.add stage [actor];
+  Container.add stage [actor];
   let timeline = Timeline.create ~n:100 ~fps:26 in
   Gobject.set Timeline.P.loop timeline true;