helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gtkgl.c

   1 /* $Id$ */
   2
   3 #include <gtk/gtk.h>
   4 #include <gtkgl/gtkglarea.h>
   5 #include <caml/mlvalues.h>
   6 #include <caml/alloc.h>
   7 #include <caml/memory.h>
   8 #include <caml/callback.h>
   9 #include <caml/fail.h>
  10
  11 #include "wrappers.h"
  12 #include "ml_glib.h"
  13 #include "ml_gdk.h"
  14 #include "ml_gtk.h"
  15 #include "gtkgl_tags.h"
  16
  17 /* Conversion functions */
  18 #include "gtkgl_tags.c"
  19
  20 #define GtkGLArea_val(val) ((GtkGLArea*)GtkObject_val(val))
  21
  22 value ml_gtk_gl_area_new (value list, value share)
  23 {
  24     value cursor, res;
  25     int len, i;
  26     int *attrs;
  27
  28     for (len = 0, cursor = list; cursor != Val_unit; cursor = Field(cursor,1))
  29     {
  30         if (Is_block(Field(cursor,0))) len += 2;
  31         else len++;
  32     }
  33
  34     attrs = (int*) stat_alloc ((len+1)*sizeof(int));
  35
  36     for (i = 0, cursor = list; cursor != Val_unit; cursor = Field(cursor,1))
  37     {
  38         value option = Field(cursor,0);
  39         if (Is_block(option)) {
  40             attrs[i++] = Visual_options_val(Field(option,0));
  41             attrs[i++] = Int_val(Field(option,1));
  42         }
  43         else attrs[i++] = Visual_options_val(option);
  44     }
  45     attrs[i] = GDK_GL_NONE;
  46
  47     res = Val_GtkObject
  48         ((GtkObject*)gtk_gl_area_share_new(attrs,GtkGLArea_val(share)));
  49     stat_free(attrs);
  50     return res;
  51 }
  52
  53 ML_1 (gtk_gl_area_make_current, GtkGLArea_val, Val_bool)
  54 ML_1 (gtk_gl_area_swapbuffers, GtkGLArea_val, Unit)