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