Commits

Reid van Melle committed 3935dd4

Got most of the COGL calls wrapped and a working example

Comments (0)

Files changed (14)

+- update make_val_final for clutter/cogl i.e. remove /2.0/
+- put guards around all header files
+- remove extraneous headers when possible
+- find best to inline c-macro conversions
 - create a coglbox actor which to be used from ocaml
 - check out the "Make_Val_final_pointer" ---> what is that all about
 - make usage of ClutterFixed type-safe... i.e. distinguish from int
 - ensure that we are OK with using Val_int for the  ClutterUnit which are guint32
 - MEMORY MEMORY MEMORY
    - are cairo actor deallocated properly?
+   - are the malloc'ed structs being dallocated
    - are regular clutter objects deref'ed properly
    - are properly objects ref'ed and deref'ed properly
+   - what about cogl textures... ver important!
 - check out when to use copy_int32
 - implement struct types for points, colors, vertices, knots
   - or not... decide on best model in each case
 <*>: use_clutter, use_cluttercairo
 <clutterEnums.*> or <clutterProps.*> or <oclutterProps.*>: use_gtk, use_cairo
 <pangolibEnums.*>: use_gtk
+<coglEnums.*>: use_gtk
 <clutterActor.*> or <clutterEllipse.*> or <clutterTimeline.*> or <clutterData.*>: use_gtk
 <clutter.*> or <structs.*>: use_gtk
 <ml_clutter.*>: use_gtk2
+open CoglEnums
+
 type handle
 type units = Clutter.units
 type angle = Clutter.angle
 
 module Util = struct
   type feature_flag 
-  external create_context : unit -> bool = "cogl_create_context"
-  external destroy_context : unit -> bool = "cogl_destroy_context"
-  external cogl_paint_init : Clutter.Color.t -> unit = "cogl_pain_init"
+  external create_context : unit -> bool = "ml_cogl_create_context"
+  external destroy_context : unit -> bool = "ml_cogl_destroy_context"
+  external paint_init : Clutter.Color.t -> unit = "ml_cogl_paint_init"
+  external check_extension : string -> string -> bool
+    = "ml_cogl_check_extension"
   external features_available : feature_flag list -> bool
-    = "cogl_features_available"
+    = "ml_cogl_features_available"
 end
   
     
     -> auto_mipmap:bool -> format:pixel_format -> handle
     = "ml_cogl_texture_new_from_file"
 
-  external new_from_data : width:int -> height:Int -> max_waste:int
+  external new_from_data : width:int -> height:int -> max_waste:int
     -> auto_mipmap:bool -> format:pixel_format -> internal_format:pixel_format
     -> rowstride:int -> data:region -> handle
-    = "ml_cogl_texture_new_from_data"
+    = "ml_cogl_texture_new_from_data_bc" "ml_cogl_texture_new_from_data"
 
   external is_texture : handle -> bool = "ml_cogl_is_texture"
   external width : handle -> int = "ml_cogl_texture_get_width"
 end
 
 module Path = struct
-  external color : Clutter.Color.t -> unit = "cogl_color"
-  external fill : unit -> unit = "cogl_path_fill"
-  external stroke : unit -> unit = "cogl_path_stroke"
-  external move_to : x:units -> y:units -> unit = "cogl_path_move_to"
-  external close : unit -> unit = "cogl_close"
-  external line_to : x:units -> y:units -> unit "cogl_path_line_to"
+  external color : Clutter.Color.t -> unit = "ml_cogl_color"
+  external fill : unit -> unit = "ml_cogl_path_fill"
+  external stroke : unit -> unit = "ml_cogl_path_stroke"
+  external move_to : x:units -> y:units -> unit = "ml_cogl_path_move_to"
+  external close : unit -> unit = "ml_cogl_close"
+  external line_to : x:units -> y:units -> unit = "ml_cogl_path_line_to"
   external curve_to : x1:units -> y1:units -> x2:units -> y2:units ->
-    x3:units -> y3:units -> unit = "cogl_path_curve_to"
+    x3:units -> y3:units -> unit = "ml_cogl_path_curve_to_bc" "ml_cogl_path_curve_to"
     (* FIXME: find out type of angle *)
   external arc : cx:units -> cy:units -> rx:units -> ry:units -> angle1:angle ->
-    angle2:angle -> unit = "cogl_path_arc"
-  external rel_move_to : x:units -> y:units -> unit = "cogl_path_rel_move_to"
-  external rel_line_to : x:units -> y:units -> unit = "cogl_path_rel_line_to"
+    angle2:angle -> unit = "ml_cogl_path_arc_bc" "ml_cogl_path_arc"
+  external rel_move_to : x:units -> y:units -> unit = "ml_cogl_path_rel_move_to"
+  external rel_line_to : x:units -> y:units -> unit = "ml_cogl_path_rel_line_to"
   external rel_curve_to : x1:units -> y1:units -> x2:units ->
-    y2:units -> x3:units -> y3:units -> unit = "cogl_path_rel_curve_to"
+    y2:units -> x3:units -> y3:units -> unit
+    = "ml_cogl_path_rel_curve_to_bc" "ml_cogl_path_rel_curve_to"
   external line : x1:units -> y1:units -> x2:units -> y2:units -> unit
-    = "cogl_path_line"
-  external polyline : units array -> unit = "cogl_path_polyline"
-  external polygon : units array -> unit = "cogl_path_polygon"
+    = "ml_cogl_path_line"
+  external polyline : units array -> unit = "ml_cogl_path_polyline"
+  external polygon : units array -> unit = "ml_cogl_path_polygon"
   external rectangle : x:units -> y:units -> width:units
-    -> height:units -> unit = "cogl_path_rectangle"
+    -> height:units -> unit = "ml_cogl_path_rectangle"
   external round_rectangle : x:units -> y:units -> width:units ->
-    height:units -> radius:units -> arc_step:angle
-    = "cogl_path_round_rectangle"
+    height:units -> radius:units -> arc_step:angle -> unit
+    = "ml_cogl_path_round_rectangle_bc" "ml_cogl_path_round_rectangle"
   external ellipse : cx:units -> cy:units -> rx:units -> ry:units -> unit
-    = "cogl_path_ellipse"
+    = "ml_cogl_path_ellipse"
 end
 
 module Offscreen = struct
 end
 
 external rectangle : x:int -> y:int -> width:int -> height:int -> unit
-  = "cogl_rectangle"
+  = "ml_cogl_rectangle"
 external rectanglex : x:units -> y:units -> width:units -> height:units -> unit
-  = "cogl_rectanglex"
+  = "ml_cogl_rectanglex"
 external perspective : fovy:units -> aspect:units -> z_near:units ->
-  z_far:units -> unit = "cogl_perspective"
+  z_far:units -> unit = "ml_cogl_perspective"
 external setup_viewport : width:units -> height:units -> fovy:units ->
-  aspect:units -> z_near:units -> z_far:units -> unit = "cogl_setup_viewport"
+  aspect:units -> z_near:units -> z_far:units -> unit
+  = "ml_cogl_setup_viewport_bc" "ml_cogl_setup_viewport"
   (* FIXME: these are actually 4x4 arrays *)
 external get_modelview_matrix : unit -> units array
-  = "cogl_get_modelview_matrix"
+  = "ml_cogl_get_modelview_matrix"
 external get_projection_matrix : unit -> units array
-  = "cogl_get_projection_matrix"
-external get_viewport : unit -> (units*units*units*units) = "cogl_get_viewport"
-external push_matrix : unit -> unit = "cogl_push_matrix"
-external pop_matrix : unit -> unit = "cogl_pop_matrix"
-external scale : x:units -> y:units -> unit = "cogl_scale"
-external translatex : x:units -> y:units -> z:units -> unit = "cogl_translatex"
-external translate : x:int -> y:int -> z:int -> unit = "cogl_translate"
+  = "ml_cogl_get_projection_matrix"
+external get_viewport : unit -> (units*units*units*units) = "ml_cogl_get_viewport"
+external push_matrix : unit -> unit = "ml_cogl_push_matrix"
+external pop_matrix : unit -> unit = "ml_cogl_pop_matrix"
+external scale : x:units -> y:units -> unit = "ml_cogl_scale"
+external translatex : x:units -> y:units -> z:units -> unit = "ml_cogl_translatex"
+external translate : x:int -> y:int -> z:int -> unit = "ml_cogl_translate"
 external rotatex: angle:units -> x:int -> y:int -> z:int -> unit
-  = "cogl_rotatex"
-external rotate: angle:int -> x:int -> y:int -> z:int -> unit = "cogl_rotatex"
-external cogl_clip_set : x_offset:units -> y_offset:units -> width:units ->
-  height:units -> unit = "cogl_clip_set"
-external clip_unset : unit -> unit = "cogl_clip_unset"
-external enable_depth_test : bool -> unit = "cogl_enable_depth_test"
-external alpha_func : func:alpha_func -> ref:units -> unit = "cogl_alpha_func"
+  = "ml_cogl_rotatex"
+external rotate: angle:int -> x:int -> y:int -> z:int -> unit = "ml_cogl_rotatex"
+external clip_set : x_offset:units -> y_offset:units -> width:units ->
+  height:units -> unit = "ml_cogl_clip_set"
+external clip_unset : unit -> unit = "ml_cogl_clip_unset"
+external enable_depth_test : bool -> unit = "ml_cogl_enable_depth_test"
+external alpha_func : func:alpha_func -> ref:units -> unit = "ml_cogl_alpha_func"
 external fog_set : color:Clutter.Color.t -> density:units ->
-  z_near:units -> z_far:units -> unit = "cogl_fog_set"
+  z_near:units -> z_far:units -> unit = "ml_cogl_fog_set"
 
 
   (*

clutter/coglEnums.ml

+(** cogl enums *)
+
+open Gpointer
+
+type pixel_format =
+  [ `ANY | `A_8 | `RGB_565 | `RGBA_4444 | `RGBA_5551 | `YUV | `G_8 | `RGB_888
+  | `BGR_888 | `RGBA_8888 | `BGRA_8888 | `ARGB_8888 | `ABGR_8888
+  | `RGBA_8888_PRE | `BGRA_8888_PRE | `ARGB_8888_PRE | `ABGR_8888_PRE
+  | `RGBA_4444_PRE | `RGBA_5551_PRE ]
+type feature_flag =
+  [ `TEXTURE_RECTANGLE | `TEXTURE_NPOT | `TEXTURE_YUV | `TEXTURE_READ_PIXELS
+  | `SHADERS_GLSL | `OFFSCREEN | `OFFSCREEN_MULTISAMPLE | `OFFSCREEN_BLIT
+  | `FOUR_CLIP_PLANES | `STENCIL_BUFFER ]
+type buffer_target = [ `WINDOW_BUFFER | `MASK_BUFFER | `OFFSCREEN_BUFFER ]
+type alpha_func =
+  [ `NEVER | `LESS | `EQUAL | `LEQUAL | `GREATER | `NOTEQUAL | `GEQUAL
+  | `ALWAYS ]
+
+(**/**)
+
+external _get_tables : unit ->
+    pixel_format variant_table
+  * feature_flag variant_table
+  * buffer_target variant_table
+  * alpha_func variant_table
+  = "ml_cogl_get_tables"
+
+
+let pixel_format, feature_flag, buffer_target, alpha_func = _get_tables ()
+
+let pixel_format_conv = Gobject.Data.enum pixel_format
+let feature_flag_conv = Gobject.Data.enum feature_flag
+let buffer_target_conv = Gobject.Data.enum buffer_target
+let alpha_func_conv = Gobject.Data.enum alpha_func

clutter/cogl_tags.c

+/* pixel_format : conversion table */
+const lookup_info ml_table_pixel_format[] = {
+  { 0, 19 },
+  { MLTAG_ABGR_8888_PRE, COGL_PIXEL_FORMAT_ABGR_8888_PRE },
+  { MLTAG_ARGB_8888_PRE, COGL_PIXEL_FORMAT_ARGB_8888_PRE },
+  { MLTAG_RGBA_8888_PRE, COGL_PIXEL_FORMAT_RGBA_8888_PRE },
+  { MLTAG_BGRA_8888, COGL_PIXEL_FORMAT_BGRA_8888 },
+  { MLTAG_RGBA_4444_PRE, COGL_PIXEL_FORMAT_RGBA_4444_PRE },
+  { MLTAG_RGB_565, COGL_PIXEL_FORMAT_RGB_565 },
+  { MLTAG_RGB_888, COGL_PIXEL_FORMAT_RGB_888 },
+  { MLTAG_ABGR_8888, COGL_PIXEL_FORMAT_ABGR_8888 },
+  { MLTAG_RGBA_4444, COGL_PIXEL_FORMAT_RGBA_4444 },
+  { MLTAG_RGBA_5551, COGL_PIXEL_FORMAT_RGBA_5551 },
+  { MLTAG_RGBA_8888, COGL_PIXEL_FORMAT_RGBA_8888 },
+  { MLTAG_ANY, COGL_PIXEL_FORMAT_ANY },
+  { MLTAG_A_8, COGL_PIXEL_FORMAT_A_8 },
+  { MLTAG_G_8, COGL_PIXEL_FORMAT_G_8 },
+  { MLTAG_YUV, COGL_PIXEL_FORMAT_YUV },
+  { MLTAG_RGBA_5551_PRE, COGL_PIXEL_FORMAT_RGBA_5551_PRE },
+  { MLTAG_BGR_888, COGL_PIXEL_FORMAT_BGR_888 },
+  { MLTAG_BGRA_8888_PRE, COGL_PIXEL_FORMAT_BGRA_8888_PRE },
+  { MLTAG_ARGB_8888, COGL_PIXEL_FORMAT_ARGB_8888 },
+};
+
+/* feature_flag : conversion table */
+const lookup_info ml_table_feature_flag[] = {
+  { 0, 10 },
+  { MLTAG_STENCIL_BUFFER, COGL_FEATURE_STENCIL_BUFFER },
+  { MLTAG_TEXTURE_NPOT, COGL_FEATURE_TEXTURE_NPOT },
+  { MLTAG_TEXTURE_YUV, COGL_FEATURE_TEXTURE_YUV },
+  { MLTAG_OFFSCREEN_BLIT, COGL_FEATURE_OFFSCREEN_BLIT },
+  { MLTAG_FOUR_CLIP_PLANES, COGL_FEATURE_FOUR_CLIP_PLANES },
+  { MLTAG_TEXTURE_READ_PIXELS, COGL_FEATURE_TEXTURE_READ_PIXELS },
+  { MLTAG_OFFSCREEN, COGL_FEATURE_OFFSCREEN },
+  { MLTAG_TEXTURE_RECTANGLE, COGL_FEATURE_TEXTURE_RECTANGLE },
+  { MLTAG_OFFSCREEN_MULTISAMPLE, COGL_FEATURE_OFFSCREEN_MULTISAMPLE },
+  { MLTAG_SHADERS_GLSL, COGL_FEATURE_SHADERS_GLSL },
+};
+
+/* buffer_target : conversion table */
+const lookup_info ml_table_buffer_target[] = {
+  { 0, 3 },
+  { MLTAG_WINDOW_BUFFER, COGL_WINDOW_BUFFER },
+  { MLTAG_OFFSCREEN_BUFFER, COGL_OFFSCREEN_BUFFER },
+  { MLTAG_MASK_BUFFER, COGL_MASK_BUFFER },
+};
+
+/* alpha_func : conversion table */
+const lookup_info ml_table_alpha_func[] = {
+  { 0, 8 },
+  { MLTAG_NOTEQUAL, CGL_NOTEQUAL },
+  { MLTAG_LEQUAL, CGL_LEQUAL },
+  { MLTAG_GEQUAL, CGL_GEQUAL },
+  { MLTAG_EQUAL, CGL_EQUAL },
+  { MLTAG_ALWAYS, CGL_ALWAYS },
+  { MLTAG_NEVER, CGL_NEVER },
+  { MLTAG_LESS, CGL_LESS },
+  { MLTAG_GREATER, CGL_GREATER },
+};
+
+CAMLprim value ml_cogl_get_tables ()
+{
+  static const lookup_info *ml_lookup_tables[] = {
+    ml_table_pixel_format,
+    ml_table_feature_flag,
+    ml_table_buffer_target,
+    ml_table_alpha_func,
+  };
+  return (value)ml_lookup_tables;}

clutter/cogl_tags.h

+/* pixel_format : tags and macros */
+#define MLTAG_ANY	Val_int(3249868)
+#define MLTAG_A_8	Val_int(3253626)
+#define MLTAG_RGB_565	Val_int(-191062750)
+#define MLTAG_RGBA_4444	Val_int(-106679893)
+#define MLTAG_RGBA_5551	Val_int(-95540377)
+#define MLTAG_YUV	Val_int(4444922)
+#define MLTAG_G_8	Val_int(3552000)
+#define MLTAG_RGB_888	Val_int(-190913114)
+#define MLTAG_BGR_888	Val_int(296796582)
+#define MLTAG_RGBA_8888	Val_int(-62121813)
+#define MLTAG_BGRA_8888	Val_int(-426969941)
+#define MLTAG_ARGB_8888	Val_int(632665363)
+#define MLTAG_ABGR_8888	Val_int(-129738477)
+#define MLTAG_RGBA_8888_PRE	Val_int(-456815825)
+#define MLTAG_BGRA_8888_PRE	Val_int(379873071)
+#define MLTAG_ARGB_8888_PRE	Val_int(-623281257)
+#define MLTAG_ABGR_8888_PRE	Val_int(-1014358121)
+#define MLTAG_RGBA_4444_PRE	Val_int(-224517073)
+#define MLTAG_RGBA_5551_PRE	Val_int(26061803)
+
+extern const lookup_info ml_table_pixel_format[];
+#define Val_pixel_format(data) ml_lookup_from_c (ml_table_pixel_format, data)
+#define Pixel_format_val(key) ml_lookup_to_c (ml_table_pixel_format, key)
+
+/* feature_flag : tags and macros */
+#define MLTAG_TEXTURE_RECTANGLE	Val_int(603960395)
+#define MLTAG_TEXTURE_NPOT	Val_int(-324069589)
+#define MLTAG_TEXTURE_YUV	Val_int(-164614602)
+#define MLTAG_TEXTURE_READ_PIXELS	Val_int(209340274)
+#define MLTAG_SHADERS_GLSL	Val_int(955776399)
+#define MLTAG_OFFSCREEN	Val_int(352910331)
+#define MLTAG_OFFSCREEN_MULTISAMPLE	Val_int(824102335)
+#define MLTAG_OFFSCREEN_BLIT	Val_int(-66596295)
+#define MLTAG_FOUR_CLIP_PLANES	Val_int(27700813)
+#define MLTAG_STENCIL_BUFFER	Val_int(-459989949)
+
+extern const lookup_info ml_table_feature_flag[];
+#define Val_feature_flag(data) ml_lookup_from_c (ml_table_feature_flag, data)
+#define Feature_flag_val(key) ml_lookup_to_c (ml_table_feature_flag, key)
+
+/* buffer_target : tags and macros */
+#define MLTAG_WINDOW_BUFFER	Val_int(-977266513)
+#define MLTAG_MASK_BUFFER	Val_int(761898803)
+#define MLTAG_OFFSCREEN_BUFFER	Val_int(400606212)
+
+extern const lookup_info ml_table_buffer_target[];
+#define Val_buffer_target(data) ml_lookup_from_c (ml_table_buffer_target, data)
+#define Buffer_target_val(key) ml_lookup_to_c (ml_table_buffer_target, key)
+
+/* alpha_func : tags and macros */
+#define MLTAG_NEVER	Val_int(387872364)
+#define MLTAG_LESS	Val_int(846256985)
+#define MLTAG_EQUAL	Val_int(-261027948)
+#define MLTAG_LEQUAL	Val_int(-745507896)
+#define MLTAG_GREATER	Val_int(932472026)
+#define MLTAG_NOTEQUAL	Val_int(-924204607)
+#define MLTAG_GEQUAL	Val_int(-741890579)
+#define MLTAG_ALWAYS	Val_int(-111559985)
+
+extern const lookup_info ml_table_alpha_func[];
+#define Val_alpha_func(data) ml_lookup_from_c (ml_table_alpha_func, data)
+#define Alpha_func_val(key) ml_lookup_to_c (ml_table_alpha_func, key)
+

clutter/coglbox.c

 #include <glib.h>
 #include <stdlib.h>
 #include <clutter/clutter.h>
-#include <cogl/cogl.h>
 
 #include "wrappers.h"
 
 #include "ml_actor.h"
-/* Coglbox declaration
- *--------------------------------------------------*/
-
-G_BEGIN_DECLS
-  
-#define CAML_TYPE_COGLBOX caml_coglbox_get_type()
-
-#define CAML_COGLBOX(obj) \
-  (G_TYPE_CHECK_INSTANCE_CAST ((obj), \
-  CAML_TYPE_COGLBOX, CamlCoglboxClass))
-
-#define CAML_COGLBOX_CLASS(klass) \
-  (G_TYPE_CHECK_CLASS_CAST ((klass), \
-  CAML_TYPE_COGLBOX, CamlCoglboxClass))
-
-#define CAML_IS_COGLBOX(obj) \
-  (G_TYPE_CHECK_INSTANCE_TYPE ((obj), \
-  CAML_TYPE_COGLBOX))
-
-#define CAML_IS_COGLBOX_CLASS(klass) \
-  (G_TYPE_CHECK_CLASS_TYPE ((klass), \
-  CAML_TYPE_COGLBOX))
-
-#define CAML_COGLBOX_GET_CLASS(obj) \
-  (G_TYPE_INSTANCE_GET_CLASS ((obj), \
-  CAML_TYPE_COGLBOX, CamlCoglboxClass))
-
-typedef struct _CamlCoglbox        CamlCoglbox;
-typedef struct _CamlCoglboxClass   CamlCoglboxClass;
-typedef struct _CamlCoglboxPrivate CamlCoglboxPrivate;
-
-struct _CamlCoglbox
-{
-  ClutterActor           parent;
-
-  /*< private >*/
-  CamlCoglboxPrivate *priv;
-};
-
-struct _CamlCoglboxClass 
-{
-  ClutterActorClass parent_class;
-
-  /* padding for future expansion */
-  void (*_caml_coglbox1) (void);
-  void (*_caml_coglbox2) (void);
-  void (*_caml_coglbox3) (void);
-  void (*_caml_coglbox4) (void);
-};
-
-GType caml_coglbox_get_type (void) G_GNUC_CONST;
-
-G_END_DECLS
+#include "coglbox.h"
 
 /* Coglbox private declaration
  *--------------------------------------------------*/
 
 G_DEFINE_TYPE (CamlCoglbox, caml_coglbox, CLUTTER_TYPE_ACTOR);
 
-#define CAML_COGLBOX_GET_PRIVATE(obj) \
-(G_TYPE_INSTANCE_GET_PRIVATE ((obj), CAML_TYPE_COGLBOX, CamlCoglboxPrivate))
-
-struct _CamlCoglboxPrivate
-{
-  void (*_caml_coglbox_priv1) (void);
-  value *paint_clos;
-};
 
 /* Coglbox implementation
  *--------------------------------------------------*/
 static void
 caml_coglbox_paint(ClutterActor *self)
 {
-  printf("caml_coglbox_paint\n");
   CamlCoglboxPrivate *priv = CAML_COGLBOX_GET_PRIVATE (self);
   value val = Val_ClutterActor(self);
 
-  ClutterColor cfill;
+  /*ClutterColor cfill;
   ClutterColor cstroke;
   cfill.red    = 0;
   cfill.green  = 160;
                   CLUTTER_INT_TO_FIXED (25));
   cogl_path_fill ();
   
-  cogl_pop_matrix();
+  cogl_pop_matrix();*/
 
   callback_exn (*(priv->paint_clos), val);
 }
   return g_object_new (CAML_TYPE_COGLBOX, NULL);
 }
 
-/// OCAML stuff
 
-#define CamlCoglbox_val(val)       (check_cast(CAML_COGLBOX, val))
-value Val_CamlCoglbox_ (CamlCoglbox *, gboolean);
-#define Val_CamlCoglbox(p)         Val_CamlCoglbox_(p, TRUE)
-#define Val_CamlCoglbox_new(p)     Val_CamlCoglbox_(p, FALSE)
-
-static struct custom_operations ml_clutter_stage_ops = {
-  "CamlCoglbox",
-  custom_finalize_default,
-  custom_compare_default,
-  custom_hash_default,
-  custom_serialize_default,
-  custom_deserialize_default
-};
-
-value Val_CamlCoglbox_ (CamlCoglbox *t, gboolean ref)
-{ 
-  CamlCoglbox **p;
-  value ret; 
-  if (t == NULL) ml_raise_null_pointer(); 
-  ret = alloc_custom (&ml_clutter_stage_ops, sizeof t, 
-		      100, 1000);
-  p = Data_custom_val (ret);
-  *p = ref ? g_object_ref (t) : t;
-  return ret; 
-}
-
-CAMLprim value
-ml_caml_coglbox_new (value _paint)
-{
-  CamlCoglbox *self = g_object_new (CAML_TYPE_COGLBOX, NULL);
-  CamlCoglboxPrivate *priv;
-  priv = CAML_COGLBOX_GET_PRIVATE (self);
-  priv->paint_clos = ml_global_root_new(_paint);
-  return Val_CamlCoglbox(self);
-}
-

clutter/coglbox.h

+#ifndef _HAVE_COGLBOX_ACTOR_H
+#define _HAVE_COGLBOX_ACTOR_H
+
+#include <glib-object.h>
+#include <cogl/cogl.h>
+
+/* Coglbox declaration
+ *--------------------------------------------------*/
+
+G_BEGIN_DECLS
+  
+#define CAML_TYPE_COGLBOX caml_coglbox_get_type()
+
+#define CAML_COGLBOX(obj) \
+  (G_TYPE_CHECK_INSTANCE_CAST ((obj), \
+  CAML_TYPE_COGLBOX, CamlCoglboxClass))
+
+#define CAML_COGLBOX_CLASS(klass) \
+  (G_TYPE_CHECK_CLASS_CAST ((klass), \
+  CAML_TYPE_COGLBOX, CamlCoglboxClass))
+
+#define CAML_IS_COGLBOX(obj) \
+  (G_TYPE_CHECK_INSTANCE_TYPE ((obj), \
+  CAML_TYPE_COGLBOX))
+
+#define CAML_IS_COGLBOX_CLASS(klass) \
+  (G_TYPE_CHECK_CLASS_TYPE ((klass), \
+  CAML_TYPE_COGLBOX))
+
+#define CAML_COGLBOX_GET_CLASS(obj) \
+  (G_TYPE_INSTANCE_GET_CLASS ((obj), \
+  CAML_TYPE_COGLBOX, CamlCoglboxClass))
+
+typedef struct _CamlCoglbox        CamlCoglbox;
+typedef struct _CamlCoglboxClass   CamlCoglboxClass;
+typedef struct _CamlCoglboxPrivate CamlCoglboxPrivate;
+
+#define CAML_COGLBOX_GET_PRIVATE(obj) \
+(G_TYPE_INSTANCE_GET_PRIVATE ((obj), CAML_TYPE_COGLBOX, CamlCoglboxPrivate))
+
+struct _CamlCoglboxPrivate
+{
+  void (*_caml_coglbox_priv1) (void);
+  value *paint_clos;
+};
+
+struct _CamlCoglbox
+{
+  ClutterActor           parent;
+
+  /*< private >*/
+  CamlCoglboxPrivate *priv;
+};
+
+struct _CamlCoglboxClass 
+{
+  ClutterActorClass parent_class;
+
+  /* padding for future expansion */
+  void (*_caml_coglbox1) (void);
+  void (*_caml_coglbox2) (void);
+  void (*_caml_coglbox3) (void);
+  void (*_caml_coglbox4) (void);
+};
+
+GType caml_coglbox_get_type (void) G_GNUC_CONST;
+
+G_END_DECLS
+
+#endif

clutter/ml_clutter.c

 int clutter_float_to_units(double x) { return CLUTTER_UNITS_FROM_FLOAT(x); }
 int clutter_units_to_int(int x) { return CLUTTER_UNITS_TO_INT(x); }
 int clutter_int_to_units(int x) { return CLUTTER_UNITS_FROM_INT(x); }
+int clutter_angle_from_deg(float x) { return CLUTTER_ANGLE_FROM_DEG(x); }
 ML_1(clutter_units_to_float, Int_val, copy_double);
 ML_1(clutter_float_to_units, Double_val, Val_int);
 ML_1(clutter_units_to_int, Int_val, Val_int);
 ML_1(clutter_int_to_units, Int_val, Val_int);
+ML_1(clutter_angle_from_deg, Float_val, Val_int);
 
 // ClutterVertex
-#define ClutterVertex_val(val) ((ClutterVertex *)Pointer_val(val))
-#define Val_ClutterVertex(val) (Val_pointer(val))
+// FIXME: where's the free?... use Pointer_val_final?
 Make_Extractor (clutter_vertex_get, ClutterVertex_val, x, Val_int)
 Make_Extractor (clutter_vertex_get, ClutterVertex_val, y, Val_int)
 Make_Extractor (clutter_vertex_get, ClutterVertex_val, z, Val_int)
 }
 
 // ClutterColor
-#define ClutterColor_val(val) ((ClutterColor *)Pointer_val(val))
-#define Val_ClutterColor(val) (Val_pointer(val))
+// FIXME: where's the free?... use Pointer_val_final?
 Make_Extractor (clutter_color_get, ClutterColor_val, red, Val_int)
 Make_Extractor (clutter_color_get, ClutterColor_val, green, Val_int)
 Make_Extractor (clutter_color_get, ClutterColor_val, blue, Val_int)
 }
 
 // ClutterKnot
-#define ClutterKnot_val(val) ((ClutterKnot *)Pointer_val(val))
-#define Val_ClutterKnot(val) (Val_pointer(val))
+// FIXME: where's the free?... use Pointer_val_final?
 Make_Extractor (clutter_knot_get, ClutterKnot_val, x, Val_int)
 Make_Extractor (clutter_knot_get, ClutterKnot_val, y, Val_int)
 Make_Setter (clutter_knot_set, ClutterKnot_val, Int_val, x)

clutter/ml_clutter.h

+CAMLexport void ml_raise_gerror(GError *) Noreturn;
+
 #define ClutterEvent_val (ClutterEvent*)MLPointer_val
 CAMLexport int Flags_Event_mask_val (value);
+
+#define ClutterColor_val(val) ((ClutterColor *)Pointer_val(val))
+#define Val_ClutterColor(val) (Val_pointer(val))
+
+#define ClutterVertex_val(val) ((ClutterVertex *)Pointer_val(val))
+#define Val_ClutterVertex(val) (Val_pointer(val))
+
+#define ClutterKnot_val(val) ((ClutterKnot *)Pointer_val(val))
+#define Val_ClutterKnot(val) (Val_pointer(val))

clutter/ml_cogl.c

+#include "wrappers.h"
+#include "cogl_tags.h"
+#include "cogl_tags.c"
+#include "ml_coglbox.h"
+#include "ml_clutter.h"
+
+#define Fixed_val Int_val
+#define Angle_val Int_val
+
+/** Util API */
+ML_0(cogl_create_context, Val_bool)
+ML_0(cogl_destroy_context, Unit)
+ML_1(cogl_paint_init, ClutterColor_val, Unit)
+ML_2(cogl_check_extension, String_val, String_val, Val_bool)
+// cogl_features_available
+
+/** General API */
+ML_4(cogl_perspective, Fixed_val, Fixed_val, Fixed_val, Fixed_val, Unit)
+ML_6(cogl_setup_viewport, Int_val, Int_val, Fixed_val, Fixed_val, Fixed_val, Fixed_val, Unit)
+ML_bc6(ml_cogl_setup_viewport)
+// get_modelview_matrix,
+// get_projection_matrix
+// get_viewport
+ML_0(cogl_pop_matrix, Unit)
+ML_0(cogl_push_matrix, Unit)
+ML_2(cogl_scale, Fixed_val, Fixed_val, Unit)
+ML_3(cogl_translatex, Fixed_val, Fixed_val, Fixed_val, Unit)
+ML_3(cogl_translate, Int_val, Int_val, Int_val, Unit)
+ML_4(cogl_rotatex, Fixed_val, Int_val, Int_val, Int_val, Unit)
+ML_4(cogl_rotate, Int_val, Int_val, Int_val, Int_val, Unit)
+ML_4(cogl_clip_set, Fixed_val, Fixed_val, Fixed_val, Fixed_val, Unit)
+ML_0(cogl_clip_unset, Unit)
+ML_1(cogl_enable_depth_test, Bool_val, Unit)
+ML_2(cogl_alpha_func, Alpha_func_val, Fixed_val, Unit)
+ML_4(cogl_fog_set, ClutterColor_val, Fixed_val, Fixed_val, Fixed_val, Unit)
+
+/** PATH API */
+ML_1(cogl_color, ClutterColor_val, Unit)
+ML_0(cogl_path_fill, Unit)
+ML_0(cogl_path_stroke, Unit)
+ML_2(cogl_path_move_to, Fixed_val, Fixed_val, Unit)
+ML_0(cogl_path_close, Unit)
+ML_2(cogl_path_line_to, Fixed_val, Fixed_val, Unit)
+ML_6(cogl_path_curve_to, Fixed_val, Fixed_val, Fixed_val, Fixed_val, Fixed_val, Fixed_val, Unit)
+ML_bc6(ml_cogl_path_curve_to)
+ML_6(cogl_path_arc, Fixed_val, Fixed_val, Fixed_val, Fixed_val, Angle_val, Angle_val, Unit)
+ML_bc6(ml_cogl_path_arc)
+ML_2(cogl_path_rel_move_to, Fixed_val, Fixed_val, Unit)
+ML_2(cogl_path_rel_line_to, Fixed_val, Fixed_val, Unit)
+ML_6(cogl_path_rel_curve_to, Fixed_val, Fixed_val, Fixed_val, Fixed_val, Fixed_val, Fixed_val, Unit)
+ML_bc6(ml_cogl_path_rel_curve_to)
+ML_4(cogl_path_line, Fixed_val, Fixed_val, Fixed_val, Fixed_val, Unit)
+// cogl_path_polyline
+// cogl_path_polygon
+ML_4(cogl_path_rectangle, Fixed_val, Fixed_val, Fixed_val, Fixed_val, Unit)
+ML_6(cogl_path_round_rectangle, Fixed_val, Fixed_val, Fixed_val, Fixed_val, Fixed_val, Angle_val, Unit)
+ML_bc6(ml_cogl_path_round_rectangle)
+ML_4(cogl_path_ellipse, Fixed_val, Fixed_val, Fixed_val, Fixed_val, Unit)
+ML_4(cogl_rectangle, Int_val, Int_val, Int_val, Int_val, Unit)
+ML_4(cogl_rectanglex, Fixed_val, Fixed_val, Fixed_val, Fixed_val, Unit)
+
+/** Texture API */
+Make_Val_final_pointer_ext(CoglHandle, _new, Ignore, cogl_texture_unref, 5)
+ML_5(cogl_texture_new_with_size, Int_val, Int_val, Int_val, Bool_val, Pixel_format_val, Val_CoglHandle_new)
+
+CAMLprim value
+ml_cogl_texture_new_from_file(value file, value max_waste, value mipmap, value format) {
+  CAMLparam4(file, max_waste, mipmap, format);
+  GError *err = NULL;
+  CoglHandle h = cogl_texture_new_from_file
+    (String_val(file), Int_val(max_waste), Bool_val(mipmap),
+     Pixel_format_val(format), &err);
+  if (err) ml_raise_gerror(err);
+  CAMLreturn(Val_CoglHandle_new(h));
+}
+// IS pointer_val what we want here? or just an opaque type?
+ML_8(cogl_texture_new_from_data, Int_val, Int_val, Int_val, Bool_val, Pixel_format_val, Pixel_format_val, Int_val, Pointer_val, Val_CoglHandle_new)
+ML_bc8(ml_cogl_texture_new_from_data)
+// cogl_texture_new_from_foreign
+ML_1(cogl_is_texture, Pointer_val, Val_bool)
+ML_1(cogl_texture_get_width, Pointer_val, Val_int)
+ML_1(cogl_texture_get_height, Pointer_val, Val_int)
+ML_1(cogl_texture_get_format, Pointer_val, Val_pixel_format)
+ML_1(cogl_texture_get_rowstride, Pointer_val, Val_int)
+ML_1(cogl_texture_get_max_waste, Pointer_val, Val_int)
+// get_min_filter
+// get_max_filter
+ML_1(cogl_texture_is_sliced, Pointer_val, Val_bool)
+// get_gl_texture
+// get_data
+// set_filters
+// set_region
+ML_1(cogl_texture_ref, Pointer_val, Val_CoglHandle_new) // ? 
+ML_1(cogl_texture_unref, Pointer_val, Unit)
+ML_9(cogl_texture_rectangle, Pointer_val, Fixed_val, Fixed_val, Fixed_val, Fixed_val, Fixed_val, Fixed_val, Fixed_val, Fixed_val, Unit)
+ML_bc9(ml_cogl_texture_rectangle)
+// texture_polygon
+
+

clutter/ml_coglbox.c

+#include "wrappers.h"
+#include "coglbox.h"
+#include "ml_coglbox.h"
+
+/// OCAML stuff
+
+static struct custom_operations ml_clutter_stage_ops = {
+  "CamlCoglbox",
+  custom_finalize_default,
+  custom_compare_default,
+  custom_hash_default,
+  custom_serialize_default,
+  custom_deserialize_default
+};
+
+value Val_CamlCoglbox_ (CamlCoglbox *t, gboolean ref)
+{ 
+  CamlCoglbox **p;
+  value ret; 
+  if (t == NULL) ml_raise_null_pointer(); 
+  ret = alloc_custom (&ml_clutter_stage_ops, sizeof t, 
+		      100, 1000);
+  p = Data_custom_val (ret);
+  *p = ref ? g_object_ref (t) : t;
+  return ret; 
+}
+
+CAMLprim value
+ml_caml_coglbox_new (value _paint)
+{
+  CamlCoglbox *self = g_object_new (CAML_TYPE_COGLBOX, NULL);
+  CamlCoglboxPrivate *priv;
+  priv = CAML_COGLBOX_GET_PRIVATE (self);
+  priv->paint_clos = ml_global_root_new(_paint);
+  return Val_CamlCoglbox(self);
+}

clutter/ml_coglbox.h

+#define CamlCoglbox_val(val)       (check_cast(CAML_COGLBOX, val))
+
+#define Val_CamlCoglbox(p)         Val_CamlCoglbox_(p, TRUE)
+#define Val_CamlCoglbox_new(p)     Val_CamlCoglbox_(p, FALSE)

examples/cogl-actor.ml

 let _ =
   let stage = ClutterStage.get_default () in
   stage#set_size ~width:800 ~height:600;
-  let c = CoglBox.create (fun _ -> printf "draw now!!!\n%!") in
+  let c = CoglBox.create
+    (fun _ ->
+       let color = Color.rgb (255,0,0) in
+       Cogl.Path.color color#obj;
+       Cogl.push_matrix ();
+       Cogl.Path.round_rectangle ~x:(from_device 5) ~y:(from_device 5)
+	 ~width:(from_device 790) ~height:(from_device 590)
+	 ~radius:(from_device 10)
+	 ~arc_step:(angle_from_deg 0.5);
+       Cogl.Path.stroke ();
+       
+       Cogl.translate 200 200 0;
+       
+       Cogl.Path.line ~x1:(from_device (-50)) ~y1:(from_device (-25))
+	 ~x2:(from_device 250) ~y2:(from_device 125);
+       (*Cogl.Path.fill ();*)
+       Cogl.Path.stroke ();
+       Cogl.pop_matrix ();
+    ) in
   let c = new ClutterActor.actor (as_actor c) in
   stage#add_actor c;
   let actor = ClutterTexture.texture ~filename:"./examples/ohpowers.png" () in