lablGL/ml_gl.c

   1 /* $Id: ml_gl.c,v 1.51 2007-04-13 02:48:43 garrigue Exp $ */
   2
   3 #ifdef _WIN32
   4 #include <wtypes.h>
   5 #endif
   6 #include <string.h>
   7 #ifdef __APPLE__
   8 #include <OpenGL/gl.h>
   9 #else
  10 #include <GL/gl.h>
  11 #endif
  12 #ifdef HAS_GLEXT_H
  13 #include <GL/glext.h>
  14 #undef GL_VERSION_1_3
  15 #endif
  16 #include <caml/misc.h>
  17 #include <caml/mlvalues.h>
  18 #include <caml/callback.h>
  19 #include <caml/memory.h>
  20 #include <caml/alloc.h>
  21 #include <caml/fail.h>
  22 #include "ml_raw.h"
  23 #include "gl_tags.h"
  24 #include "ml_gl.h"
  25
  26 #if !defined(GL_VERSION_1_4)
  27 #define GL_GENERATE_MIPMAP 0x8191
  28 #endif
  29
  30 /* #include <stdio.h> */
  31
  32 void ml_raise_gl(const char *errmsg)
  33 {
  34   static value * gl_exn = NULL;
  35   if (gl_exn == NULL)
  36       gl_exn = caml_named_value("glerror");
  37   raise_with_string(*gl_exn, (char*)errmsg);
  38 }
  39
  40 value copy_string_check (const char *str)
  41 {
  42     if (!str) ml_raise_gl("Null string");
  43     return copy_string ((char*) str);
  44 }
  45
  46 struct record {
  47     value key;
  48     GLenum data;
  49 };
  50
  51 static struct record input_table[] = {
  52 #include "gl_tags.c"
  53 };
  54
  55 static struct record *tag_table = NULL;
  56
  57 #define TABLE_SIZE (TAG_NUMBER*2+1)
  58
  59 CAMLprim value ml_gl_make_table (value unit)
  60 {
  61     int i;
  62     unsigned int hash;
  63
  64     tag_table = stat_alloc (TABLE_SIZE * sizeof(struct record));
  65     memset ((char *) tag_table, 0, TABLE_SIZE * sizeof(struct record));
  66     for (i = 0; i < TAG_NUMBER; i++) {
  67         hash = (unsigned long) input_table[i].key % TABLE_SIZE;
  68         while (tag_table[hash].key != 0) {
  69             hash ++;
  70             if (hash == TABLE_SIZE) hash = 0;
  71         }
  72         tag_table[hash].key = input_table[i].key;
  73         tag_table[hash].data = input_table[i].data;
  74     }
  75     return Val_unit;
  76 }
  77
  78 GLenum GLenum_val(value tag)
  79 {
  80     unsigned int hash = (unsigned long) tag % TABLE_SIZE;
  81
  82     if (!tag_table) ml_gl_make_table (Val_unit);
  83     while (tag_table[hash].key != tag) {
  84         if (tag_table[hash].key == 0) ml_raise_gl ("Unknown tag");
  85         hash++;
  86         if (hash == TABLE_SIZE) hash = 0;
  87     }
  88     /*
  89     fprintf(stderr, "Converted %ld to %d", Int_val(tag), tag_table[hash].data);
  90     */
  91     return tag_table[hash].data;
  92 }
  93
  94 /*
  95 GLenum GLenum_val(value tag)
  96 {
  97     switch(tag)
  98     {
  99 #include "gl_tags.c"
 100     }
 101     ml_raise_gl("Unknown tag");
 102 }
 103 */
 104
 105 ML_2 (glAccum, GLenum_val, Float_val)
 106 ML_2 (glAlphaFunc, GLenum_val, Float_val)
 107
 108 ML_1 (glBegin, GLenum_val)
 109
 110 ML_5 (glBitmap, Int_val, Int_val, Pair(arg3,Float_val,Float_val),
 111       Pair(arg4,Float_val,Float_val), Void_raw)
 112
 113 ML_2 (glBlendFunc, GLenum_val, GLenum_val)
 114
 115 CAMLprim value ml_glClipPlane(value plane, value equation)  /* ML */
 116 {
 117     double eq[4];
 118     int i;
 119
 120     for (i = 0; i < 4; i++)
 121         eq[i] = Double_val (Field(equation,i));
 122     glClipPlane (GL_CLIP_PLANE0 + Int_val(plane), eq);
 123     return Val_unit;
 124 }
 125
 126 CAMLprim value ml_glClear(value bit_list)  /* ML */
 127 {
 128     GLbitfield accu = 0;
 129
 130     while (bit_list != Val_int(0)) {
 131         switch (Field (bit_list, 0)) {
 132         case MLTAG_color:
 133             accu |= GL_COLOR_BUFFER_BIT; break;
 134         case MLTAG_depth:
 135             accu |= GL_DEPTH_BUFFER_BIT; break;
 136         case MLTAG_accum:
 137             accu |= GL_ACCUM_BUFFER_BIT; break;
 138         case MLTAG_stencil:
 139             accu |= GL_STENCIL_BUFFER_BIT; break;
 140         }
 141         bit_list = Field (bit_list, 1);
 142     }
 143     glClear (accu);
 144     return Val_unit;
 145 }
 146 ML_4 (glClearAccum, Float_val, Float_val, Float_val, Float_val)
 147 ML_4 (glClearColor, Double_val, Double_val, Double_val, Double_val)
 148 ML_1 (glClearDepth, Double_val)
 149 ML_1 (glClearIndex, Float_val)
 150 ML_1 (glClearStencil, Int_val)
 151 ML_4 (glColor4d, Double_val, Double_val, Double_val, Double_val)
 152 ML_4 (glColorMask, Int_val, Int_val, Int_val, Int_val)
 153 ML_2 (glColorMaterial, GLenum_val, GLenum_val)
 154 ML_5 (glCopyPixels, Int_val, Int_val, Int_val, Int_val, GLenum_val)
 155 ML_1 (glCullFace, GLenum_val)
 156
 157 ML_1 (glDisable, GLenum_val)
 158 ML_1 (glDepthFunc, GLenum_val)
 159 ML_1 (glDepthMask, Int_val)
 160 ML_2 (glDepthRange, Double_val, Double_val)
 161
 162 CAMLprim value ml_glDrawBuffer (value buffer)
 163 {
 164     if (Is_block(buffer)) {
 165         int n = Int_val (Field(buffer,1));
 166         if (n >= GL_AUX_BUFFERS)
 167             ml_raise_gl ("GlFunc.draw_buffer : no such auxiliary buffer");
 168         glDrawBuffer (GL_AUX0 + n);
 169     }
 170     else glDrawBuffer (GLenum_val(buffer));
 171     return Val_unit;
 172 }
 173
 174 ML_4 (glDrawPixels, Int_val, Int_val, GLenum_val, Type_void_raw)
 175
 176 ML_1 (glEdgeFlag, Int_val)
 177 ML_1 (glEnable, GLenum_val)
 178 ML_0 (glEnd)
 179 ML_1 (glEvalCoord1d, Double_val)
 180 ML_2 (glEvalCoord2d, Double_val, Double_val)
 181 ML_3 (glEvalMesh1, GLenum_val, Int_val, Int_val)
 182 ML_5 (glEvalMesh2, GLenum_val, Int_val, Int_val, Int_val, Int_val)
 183 ML_1 (glEvalPoint1, Int_val)
 184 ML_2 (glEvalPoint2, Int_val, Int_val)
 185
 186
 187 ML_3 (glFeedbackBuffer, Int_val, GLenum_val, (GLfloat*)Addr_raw)
 188
 189 CAMLprim value ml_glFog (value param) /* ML */
 190 {
 191     float params[4];
 192     int i;
 193
 194     switch (Field(param,0))
 195     {
 196     case MLTAG_mode:
 197         glFogi(GL_FOG_MODE, GLenum_val(Field(param,1)));
 198         break;
 199     case MLTAG_density:
 200         glFogf(GL_FOG_DENSITY, Float_val(Field(param,1)));
 201         break;
 202     case MLTAG_start:
 203         glFogf(GL_FOG_START, Float_val(Field(param,1)));
 204         break;
 205     case MLTAG_End:
 206         glFogf(GL_FOG_END, Float_val(Field(param,1)));
 207         break;
 208     case MLTAG_index:
 209         glFogf(GL_FOG_INDEX, Float_val(Field(param,1)));
 210         break;
 211     case MLTAG_color:
 212       for (i = 0; i < 4; i++) params[i] = Float_val(Field(Field(param,1),i));
 213         glFogfv(GL_FOG_COLOR, params);
 214         break;
 215     }
 216     return Val_unit;
 217 }
 218
 219 ML_0 (glFlush)
 220 ML_0 (glFinish)
 221 ML_1 (glFrontFace, GLenum_val)
 222 ML_3 (glFrustum, Pair(arg1,Double_val,Double_val),
 223       Pair(arg2,Double_val,Double_val), Pair(arg3,Double_val,Double_val))
 224
 225 ML_1_ (glGetString, GLenum_val, copy_string_check)
 226 ML_2 (glGetDoublev, GLenum_val, Double_raw)
 227
 228 CAMLprim value ml_glGetError(value unit)
 229 {
 230     switch (glGetError()) {
 231     case GL_NO_ERROR:       return MLTAG_no_error;
 232     case GL_INVALID_ENUM:   return MLTAG_invalid_enum;
 233     case GL_INVALID_VALUE:  return MLTAG_invalid_value;
 234     case GL_INVALID_OPERATION:  return MLTAG_invalid_operation;
 235     case GL_STACK_OVERFLOW: return MLTAG_stack_overflow;
 236     case GL_STACK_UNDERFLOW: return MLTAG_stack_underflow;
 237     case GL_OUT_OF_MEMORY:  return MLTAG_out_of_memory;
 238 #if defined(GL_VERSION_1_2) || defined(GL_TABLE_TOO_LARGE)
 239     case GL_TABLE_TOO_LARGE: return MLTAG_table_too_large;
 240 #endif
 241     default: ml_raise_gl("glGetError: unknown error");
 242     }
 243 }
 244
 245 CAMLprim value ml_glHint (value target, value hint)
 246 {
 247     GLenum targ = 0U;
 248
 249     switch (target) {
 250     case MLTAG_fog:     targ = GL_FOG_HINT; break;
 251     case MLTAG_line_smooth:     targ = GL_LINE_SMOOTH_HINT; break;
 252     case MLTAG_perspective_correction:
 253         targ = GL_PERSPECTIVE_CORRECTION_HINT; break;
 254     case MLTAG_point_smooth:    targ = GL_POINT_SMOOTH_HINT; break;
 255     case MLTAG_polygon_smooth:  targ = GL_POLYGON_SMOOTH_HINT; break;
 256     }
 257     glHint (targ, GLenum_val(hint));
 258     return Val_unit;
 259 }
 260
 261 ML_1 (glIndexMask, Int_val)
 262 ML_1 (glIndexd, Double_val)
 263 ML_0 (glInitNames)
 264 ML_1_ (glIsEnabled, GLenum_val, Val_int)
 265
 266 CAMLprim value ml_glLight (value n, value param)  /* ML */
 267 {
 268     float params[4];
 269     int i;
 270
 271     if (Int_val(n) >= GL_MAX_LIGHTS) invalid_argument ("Gl.light");
 272     switch (Field(param,0))
 273     {
 274     case MLTAG_ambient:
 275     case MLTAG_diffuse:
 276     case MLTAG_specular:
 277     case MLTAG_position:
 278         for (i = 0; i < 4; i++)
 279             params[i] = Float_val (Field(Field(param, 1), i));
 280         break;
 281     case MLTAG_spot_direction:
 282         for (i = 0; i < 3; i++)
 283             params[i] = Float_val (Field(Field(param, 1), i));
 284         break;
 285     default:
 286         params[0] = Float_val (Field(param, 1));
 287     }
 288     glLightfv (GL_LIGHT0 + Int_val(n), GLenum_val(Field(param,0)), params);
 289     return Val_unit;
 290 }
 291
 292 CAMLprim value ml_glLightModel (value param)  /* ML */
 293 {
 294     float params[4];
 295     int i;
 296
 297     switch (Field(param,0))
 298     {
 299     case MLTAG_ambient:
 300         for (i = 0; i < 4; i++)
 301             params[i] = Float_val (Field(Field(param,1),i));
 302         glLightModelfv (GL_LIGHT_MODEL_AMBIENT, params);
 303         break;
 304     case MLTAG_local_viewer:
 305         glLightModelf (GL_LIGHT_MODEL_LOCAL_VIEWER,
 306                        Int_val(Field(param,1)));
 307         break;
 308     case MLTAG_two_side:
 309         glLightModeli (GL_LIGHT_MODEL_TWO_SIDE,
 310                        Int_val(Field(param,1)));
 311         break;
 312     case MLTAG_color_control:
 313 #ifdef GL_VERSION_1_2
 314         switch (Field(param,1))
 315         {
 316           case MLTAG_separate_specular_color:
 317                 glLightModeli (GL_LIGHT_MODEL_COLOR_CONTROL,
 318                                GL_SEPARATE_SPECULAR_COLOR);
 319                 break;
 320            case MLTAG_single_color:
 321                 glLightModeli (GL_LIGHT_MODEL_COLOR_CONTROL,
 322                                GL_SINGLE_COLOR);
 323                 break;
 324         }
 325 #else
 326         ml_raise_gl ("Parameter: GL_LIGHT_MODEL_COLOR_CONTROL not available");
 327 #endif
 328         break;
 329     }
 330     return Val_unit;
 331 }
 332
 333 ML_1 (glLineWidth, Float_val)
 334 ML_1 (glLoadName, Int_val)
 335 ML_0 (glLoadIdentity)
 336
 337 #ifdef GL_VERSION_1_3
 338 ML_1 (glLoadTransposeMatrixd, Double_raw)
 339 #else
 340 CAMLprim void ml_glLoadTransposeMatrixd (value raw)
 341 {
 342     ml_raise_gl ("Function: glLoadTransposeMatrixd not available");
 343 }
 344 #endif
 345 ML_1 (glLogicOp, GLenum_val)
 346
 347 CAMLprim value ml_glMap1d (value target, value *u, value order, value raw)
 348 {
 349     int ustride = 0;
 350     GLenum targ = 0U;
 351
 352     switch (target) {
 353     case MLTAG_vertex_3:
 354         targ = GL_MAP1_VERTEX_3; ustride = 3; break;
 355     case MLTAG_vertex_4:
 356         targ = GL_MAP1_VERTEX_4; ustride = 4; break;
 357     case MLTAG_index:
 358         targ = GL_MAP1_INDEX; ustride = 1; break;
 359     case MLTAG_color_4:
 360         targ = GL_MAP1_COLOR_4; ustride = 4; break;
 361     case MLTAG_normal:
 362         targ = GL_MAP1_NORMAL; ustride = 3; break;
 363     case MLTAG_texture_coord_1:
 364         targ = GL_MAP1_TEXTURE_COORD_1; ustride = 1; break;
 365     case MLTAG_texture_coord_2:
 366         targ = GL_MAP1_TEXTURE_COORD_2; ustride = 2; break;
 367     case MLTAG_texture_coord_3:
 368         targ = GL_MAP1_TEXTURE_COORD_3; ustride = 3; break;
 369     case MLTAG_texture_coord_4:
 370         targ = GL_MAP1_TEXTURE_COORD_4; ustride = 4; break;
 371     }
 372     glMap1d (targ, Double_val(u[0]), Double_val(u[1]),
 373              ustride, Int_val(order), Double_raw(raw));
 374     return Val_unit;
 375 }
 376
 377 CAMLprim value ml_glMap2d (value target, value u, value uorder,
 378                            value v, value vorder, value raw)
 379 {
 380     int ustride = 0;
 381     GLenum targ = 0U;
 382
 383     switch (target) {
 384     case MLTAG_vertex_3:
 385         targ = GL_MAP2_VERTEX_3; ustride = 3; break;
 386     case MLTAG_vertex_4:
 387         targ = GL_MAP2_VERTEX_4; ustride = 4; break;
 388     case MLTAG_index:
 389         targ = GL_MAP2_INDEX; ustride = 1; break;
 390     case MLTAG_color_4:
 391         targ = GL_MAP2_COLOR_4; ustride = 4; break;
 392     case MLTAG_normal:
 393         targ = GL_MAP2_NORMAL; ustride = 3; break;
 394     case MLTAG_texture_coord_1:
 395         targ = GL_MAP2_TEXTURE_COORD_1; ustride = 1; break;
 396     case MLTAG_texture_coord_2:
 397         targ = GL_MAP2_TEXTURE_COORD_2; ustride = 2; break;
 398     case MLTAG_texture_coord_3:
 399         targ = GL_MAP2_TEXTURE_COORD_3; ustride = 3; break;
 400     case MLTAG_texture_coord_4:
 401         targ = GL_MAP2_TEXTURE_COORD_4; ustride = 4; break;
 402     }
 403     glMap2d (targ, Double_val(Field(u,0)), Double_val(Field(u,1)), ustride,
 404              Int_val(uorder), Double_val(Field(v,0)), Double_val(Field(v,1)),
 405              Int_val(uorder)*ustride, Int_val(vorder), Double_raw(raw));
 406     return Val_unit;
 407 }
 408
 409 ML_bc6 (ml_glMap2d)
 410
 411 ML_2 (glMapGrid1d, Int_val, Pair(arg2,Double_val,Double_val))
 412 ML_4 (glMapGrid2d, Int_val, Pair(arg2,Double_val,Double_val),
 413       Int_val, Pair(arg4,Double_val,Double_val))
 414
 415 CAMLprim value ml_glMaterial (value face, value param)  /* ML */
 416 {
 417     float params[4];
 418     int i;
 419
 420     switch (Field(param,0))
 421     {
 422     case MLTAG_shininess:
 423         params[0] = Float_val (Field(param, 1));
 424         break;
 425     case MLTAG_color_indexes:
 426         for (i = 0; i < 3; i++)
 427             params[i] = Float_val (Field(Field(param, 1), i));
 428         break;
 429     default:
 430         for (i = 0; i < 4; i++)
 431             params[i] = Float_val (Field(Field(param, 1), i));
 432         break;
 433     }
 434     glMaterialfv (GLenum_val(face), GLenum_val(Field(param,0)), params);
 435     return Val_unit;
 436 }
 437
 438 ML_1 (glMatrixMode, GLenum_val)
 439 ML_3 (glNormal3d, Double_val, Double_val, Double_val)
 440 ML_1 (glPassThrough, Float_val)
 441
 442 CAMLprim value ml_glPixelMapfv (value map, value raw)
 443 {
 444     glPixelMapfv (GLenum_val(map), Int_val(Size_raw(raw))/sizeof(GLfloat),
 445                   Float_raw(raw));
 446     return Val_unit;
 447 }
 448
 449 ML_1 (glPixelStorei, Pair(arg1,GLenum_val,Int_val))
 450
 451 CAMLprim value ml_glPixelTransfer (value param)
 452 {
 453     GLenum pname = GLenum_val (Field(param,0));
 454
 455     switch (pname) {
 456     case GL_MAP_COLOR:
 457     case GL_MAP_STENCIL:
 458     case GL_INDEX_SHIFT:
 459     case GL_INDEX_OFFSET:
 460         glPixelTransferi (pname, Int_val (Field(param,1)));
 461         break;
 462     default:
 463         glPixelTransferf (pname, Float_val (Field(param,1)));
 464     }
 465     return Val_unit;
 466 }
 467
 468 ML_2 (glPixelZoom, Float_val, Float_val)
 469 ML_0 (glPopAttrib)
 470 ML_0 (glPopMatrix)
 471 ML_0 (glPopName)
 472
 473 CAMLprim value ml_glPushAttrib (value list)
 474 {
 475     GLbitfield mask = 0;
 476
 477     while (list != Val_int(0)) {
 478         switch (Field(list,0)) {
 479         case MLTAG_accum_buffer:mask |= GL_ACCUM_BUFFER_BIT; break;
 480         case MLTAG_color_buffer:mask |= GL_COLOR_BUFFER_BIT; break;
 481         case MLTAG_current:     mask |= GL_CURRENT_BIT; break;
 482         case MLTAG_depth_buffer:mask |= GL_DEPTH_BUFFER_BIT; break;
 483         case MLTAG_enable:      mask |= GL_ENABLE_BIT; break;
 484         case MLTAG_eval:        mask |= GL_EVAL_BIT; break;
 485         case MLTAG_fog:                 mask |= GL_FOG_BIT; break;
 486         case MLTAG_hint:        mask |= GL_HINT_BIT; break;
 487         case MLTAG_lighting:    mask |= GL_LIGHTING_BIT; break;
 488         case MLTAG_line:        mask |= GL_LINE_BIT; break;
 489         case MLTAG_list:        mask |= GL_LIST_BIT; break;
 490         case MLTAG_pixel_mode:  mask |= GL_PIXEL_MODE_BIT; break;
 491         case MLTAG_point:       mask |= GL_POINT_BIT; break;
 492         case MLTAG_polygon:     mask |= GL_POLYGON_BIT; break;
 493         case MLTAG_polygon_stipple:mask |= GL_POLYGON_STIPPLE_BIT; break;
 494         case MLTAG_scissor:     mask |= GL_SCISSOR_BIT; break;
 495         case MLTAG_stencil_buffer:mask |= GL_STENCIL_BUFFER_BIT; break;
 496         case MLTAG_texture:     mask |= GL_TEXTURE_BIT; break;
 497         case MLTAG_transform:   mask |= GL_TRANSFORM_BIT; break;
 498         case MLTAG_viewport:    mask |= GL_VIEWPORT_BIT; break;
 499         }
 500         list = Field(list,1);
 501     }
 502     glPushAttrib (mask);
 503     return Val_unit;
 504 }
 505
 506 ML_0 (glPushMatrix)
 507 ML_1 (glPushName, Int_val)
 508
 509 CAMLprim value ml_glRasterPos(value x, value y, value z, value w)  /* ML */
 510 {
 511     if (z == Val_int(0)) glRasterPos2d (Double_val(x), Double_val(y));
 512     else if (w == Val_int(0))
 513         glRasterPos3d (Double_val(x), Double_val(y), Double_val(Field(z, 0)));
 514     else
 515         glRasterPos4d (Double_val(x), Double_val(y), Double_val(Field(z, 0)),
 516                     Double_val(Field(w, 0)));
 517     return Val_unit;
 518 }
 519
 520 CAMLprim value ml_glReadBuffer (value buffer)
 521 {
 522     if (Is_block(buffer)) {
 523         int n = Int_val (Field(buffer,1));
 524         if (n >= GL_AUX_BUFFERS)
 525             ml_raise_gl ("GlFunc.read_buffer : no such auxiliary buffer");
 526         glReadBuffer (GL_AUX0 + n);
 527     }
 528     else glReadBuffer (GLenum_val(buffer));
 529     return Val_unit;
 530 }
 531
 532 CAMLprim value ml_glReadPixels(value x, value y, value w, value h, value format , value raw)  /* ML */
 533 {
 534   glPixelStorei(GL_PACK_SWAP_BYTES, 0);
 535   glPixelStorei(GL_PACK_ALIGNMENT, 1);
 536   glReadPixels(Int_val(x),Int_val(y),Int_val(w),Int_val(h),GLenum_val(format),
 537                Type_void_raw(raw));
 538   return Val_unit;
 539 }
 540
 541 ML_bc6 (ml_glReadPixels)
 542 ML_2 (glRectd, Pair(arg1,Double_val,Double_val),
 543       Pair(arg2,Double_val,Double_val))
 544 ML_1_ (glRenderMode, GLenum_val, Val_int)
 545 ML_4 (glRotated, Double_val, Double_val, Double_val, Double_val)
 546 ML_3 (glScaled, Double_val, Double_val, Double_val)
 547
 548 ML_4 (glScissor, Int_val, Int_val, Int_val, Int_val)
 549 ML_2 (glSelectBuffer, Int_val, (GLuint*)Addr_raw)
 550 ML_1 (glShadeModel, GLenum_val)
 551 ML_3 (glStencilFunc, GLenum_val, Int_val, Int_val)
 552 ML_1 (glStencilMask, Int_val)
 553 ML_3 (glStencilOp, GLenum_val, GLenum_val, GLenum_val)
 554
 555 ML_1 (glTexCoord1d, Double_val)
 556 ML_2 (glTexCoord2d, Double_val, Double_val)
 557 ML_3 (glTexCoord3d, Double_val, Double_val, Double_val)
 558 ML_4 (glTexCoord4d, Double_val, Double_val, Double_val, Double_val)
 559
 560 CAMLprim value ml_glTexEnv (value param)
 561 {
 562     value params = Field(param,1);
 563     GLfloat color[4];
 564     int i;
 565
 566     switch (Field(param,0)) {
 567     case MLTAG_mode:
 568         glTexEnvi (GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GLenum_val(params));
 569         break;
 570     case MLTAG_color:
 571         for (i = 0; i < 4; i++) color[i] = Float_val(Field(params,i));
 572         glTexEnvfv (GL_TEXTURE_ENV, GL_TEXTURE_ENV_COLOR, color);
 573         break;
 574     }
 575     return Val_unit;
 576 }
 577
 578 CAMLprim value ml_glTexGen (value coord, value param)
 579 {
 580     value params = Field(param,1);
 581     GLdouble point[4];
 582     int i;
 583
 584     if (Field(param,0) == MLTAG_mode)
 585         glTexGeni (GLenum_val(coord), GL_TEXTURE_GEN_MODE, GLenum_val(params));
 586     else {
 587         for (i = 0; i < 4; i++) point[i] = Double_val(Field(params,i));
 588         glTexGendv (GLenum_val(coord), GLenum_val(Field(param,0)), point);
 589     }
 590     return Val_unit;
 591 }
 592
 593 CAMLprim value ml_glTexImage1D (value proxy, value level, value internal,
 594                                 value width, value border, value format,
 595                                 value data)
 596 {
 597     glTexImage1D (proxy == Val_int(1)
 598                   ? GL_PROXY_TEXTURE_1D : GL_TEXTURE_1D,
 599                   Int_val(level), Int_val(internal), Int_val(width),
 600                   Int_val(border), GLenum_val(format),
 601                   Type_raw(data), Void_raw(data));
 602     return Val_unit;
 603 }
 604
 605 ML_bc7 (ml_glTexImage1D)
 606
 607 CAMLprim value ml_glTexImage2D (value proxy, value level, value internal,
 608                                 value width, value height, value border,
 609                                 value format, value data)
 610 {
 611     /* printf("p=%x,l=%d,i=%d,w=%d,h=%d,b=%d,f=%x,t=%x,d=%x\n", */
 612     glTexImage2D (proxy == Val_int(1)
 613                   ? GL_PROXY_TEXTURE_2D : GL_TEXTURE_2D,
 614                   Int_val(level), Int_val(internal), Int_val(width),
 615                   Int_val(height), Int_val(border), GLenum_val(format),
 616                   Type_raw(data), Void_raw(data));
 617     /*  flush(stdout); */
 618     return Val_unit;
 619 }
 620
 621 ML_bc8 (ml_glTexImage2D)
 622
 623 CAMLprim value ml_glTexParameter (value target, value param)
 624 {
 625     GLenum targ = GLenum_val(target);
 626     GLenum pname = GLenum_val(Field(param,0));
 627     value params = Field(param,1);
 628     GLfloat color[4];
 629     int i;
 630
 631     switch (pname) {
 632     case GL_TEXTURE_BORDER_COLOR:
 633         for (i = 0; i < 4; i++) color[i] = Float_val(Field(params,i));
 634         glTexParameterfv (targ, pname, color);
 635         break;
 636     case GL_TEXTURE_PRIORITY:
 637         glTexParameterf (targ, pname, Float_val(params));
 638         break;
 639     case GL_GENERATE_MIPMAP:
 640 #ifdef GL_VERSION_1_4
 641         glTexParameteri (targ, pname, Int_val(params));
 642 #else
 643         ml_raise_gl ("Parameter: GL_GENERATE_MIPMAP not available");
 644 #endif
 645         break;
 646     default:
 647         glTexParameteri (targ, pname, GLenum_val(params));
 648         break;
 649     }
 650     return Val_unit;
 651 }
 652
 653 ML_2 (glGenTextures, Int_val, Int_raw)
 654 ML_2 (glBindTexture, GLenum_val, Nativeint_val)
 655
 656 CAMLprim value ml_glDeleteTexture (value texture_id)
 657 {
 658     GLuint id = Nativeint_val(texture_id);
 659     glDeleteTextures(1,&id);
 660     return Val_unit;
 661 }
 662
 663 ML_3 (glTranslated, Double_val, Double_val, Double_val)
 664
 665 CAMLprim value ml_glVertex(value x, value y, value z, value w)  /* ML */
 666 {
 667     if (z == Val_int(0)) glVertex2d (Double_val(x), Double_val(y));
 668     else if (w == Val_int(0))
 669         glVertex3d (Double_val(x), Double_val(y), Double_val(Field(z, 0)));
 670     else
 671         glVertex4d (Double_val(x), Double_val(y), Double_val(Field(z, 0)),
 672                     Double_val(Field(w, 0)));
 673     return Val_unit;
 674 }
 675
 676 ML_4 (glViewport, Int_val, Int_val, Int_val, Int_val)
 677
 678
 679 /* List functions */
 680
 681 ML_1_ (glIsList, Int_val, Val_int)
 682 ML_2 (glDeleteLists, Int_val, Int_val)
 683 ML_1_ (glGenLists, Int_val, Val_int)
 684 ML_2 (glNewList, Int_val, GLenum_val)
 685 ML_0 (glEndList)
 686 ML_1 (glCallList, Int_val)
 687 ML_1 (glListBase, Int_val)
 688
 689 CAMLprim value ml_glCallLists (value indexes)  /* ML */
 690 {
 691     int len,i;
 692     int * table;
 693
 694     switch (Field(indexes,0)) {
 695     case MLTAG_byte:
 696         glCallLists (string_length(Field(indexes,1)),
 697                      GL_UNSIGNED_BYTE,
 698                      String_val(Field(indexes,1)));
 699         break;
 700     case MLTAG_int:
 701         len = Wosize_val (indexes);
 702         table = calloc (len, sizeof (GLint));
 703         for (i = 0; i < len; i++) table[i] = Int_val (Field(indexes,i));
 704         glCallLists (len, GL_INT, table);
 705         free (table);
 706         break;
 707     }
 708     return Val_unit;
 709 }