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_2 (glLineStipple, Int_val, Int_val)
 335 ML_1 (glLoadName, Int_val)
 336 ML_0 (glLoadIdentity)
 337 ML_1 (glLoadMatrixd, Double_raw)
 338
 339 #ifdef GL_VERSION_1_3
 340 ML_1 (glLoadTransposeMatrixd, Double_raw)
 341 #else
 342 CAMLprim void ml_glLoadTransposeMatrixd (value raw)
 343 {
 344     ml_raise_gl ("Function: glLoadTransposeMatrixd not available");
 345 }
 346 #endif
 347 ML_1 (glLogicOp, GLenum_val)
 348
 349 CAMLprim value ml_glMap1d (value target, value *u, value order, value raw)
 350 {
 351     int ustride = 0;
 352     GLenum targ = 0U;
 353
 354     switch (target) {
 355     case MLTAG_vertex_3:
 356         targ = GL_MAP1_VERTEX_3; ustride = 3; break;
 357     case MLTAG_vertex_4:
 358         targ = GL_MAP1_VERTEX_4; ustride = 4; break;
 359     case MLTAG_index:
 360         targ = GL_MAP1_INDEX; ustride = 1; break;
 361     case MLTAG_color_4:
 362         targ = GL_MAP1_COLOR_4; ustride = 4; break;
 363     case MLTAG_normal:
 364         targ = GL_MAP1_NORMAL; ustride = 3; break;
 365     case MLTAG_texture_coord_1:
 366         targ = GL_MAP1_TEXTURE_COORD_1; ustride = 1; break;
 367     case MLTAG_texture_coord_2:
 368         targ = GL_MAP1_TEXTURE_COORD_2; ustride = 2; break;
 369     case MLTAG_texture_coord_3:
 370         targ = GL_MAP1_TEXTURE_COORD_3; ustride = 3; break;
 371     case MLTAG_texture_coord_4:
 372         targ = GL_MAP1_TEXTURE_COORD_4; ustride = 4; break;
 373     }
 374     glMap1d (targ, Double_val(u[0]), Double_val(u[1]),
 375              ustride, Int_val(order), Double_raw(raw));
 376     return Val_unit;
 377 }
 378
 379 CAMLprim value ml_glMap2d (value target, value u, value uorder,
 380                            value v, value vorder, value raw)
 381 {
 382     int ustride = 0;
 383     GLenum targ = 0U;
 384
 385     switch (target) {
 386     case MLTAG_vertex_3:
 387         targ = GL_MAP2_VERTEX_3; ustride = 3; break;
 388     case MLTAG_vertex_4:
 389         targ = GL_MAP2_VERTEX_4; ustride = 4; break;
 390     case MLTAG_index:
 391         targ = GL_MAP2_INDEX; ustride = 1; break;
 392     case MLTAG_color_4:
 393         targ = GL_MAP2_COLOR_4; ustride = 4; break;
 394     case MLTAG_normal:
 395         targ = GL_MAP2_NORMAL; ustride = 3; break;
 396     case MLTAG_texture_coord_1:
 397         targ = GL_MAP2_TEXTURE_COORD_1; ustride = 1; break;
 398     case MLTAG_texture_coord_2:
 399         targ = GL_MAP2_TEXTURE_COORD_2; ustride = 2; break;
 400     case MLTAG_texture_coord_3:
 401         targ = GL_MAP2_TEXTURE_COORD_3; ustride = 3; break;
 402     case MLTAG_texture_coord_4:
 403         targ = GL_MAP2_TEXTURE_COORD_4; ustride = 4; break;
 404     }
 405     glMap2d (targ, Double_val(Field(u,0)), Double_val(Field(u,1)), ustride,
 406              Int_val(uorder), Double_val(Field(v,0)), Double_val(Field(v,1)),
 407              Int_val(uorder)*ustride, Int_val(vorder), Double_raw(raw));
 408     return Val_unit;
 409 }
 410
 411 ML_bc6 (ml_glMap2d)
 412
 413 ML_2 (glMapGrid1d, Int_val, Pair(arg2,Double_val,Double_val))
 414 ML_4 (glMapGrid2d, Int_val, Pair(arg2,Double_val,Double_val),
 415       Int_val, Pair(arg4,Double_val,Double_val))
 416
 417 CAMLprim value ml_glMaterial (value face, value param)  /* ML */
 418 {
 419     float params[4];
 420     int i;
 421
 422     switch (Field(param,0))
 423     {
 424     case MLTAG_shininess:
 425         params[0] = Float_val (Field(param, 1));
 426         break;
 427     case MLTAG_color_indexes:
 428         for (i = 0; i < 3; i++)
 429             params[i] = Float_val (Field(Field(param, 1), i));
 430         break;
 431     default:
 432         for (i = 0; i < 4; i++)
 433             params[i] = Float_val (Field(Field(param, 1), i));
 434         break;
 435     }
 436     glMaterialfv (GLenum_val(face), GLenum_val(Field(param,0)), params);
 437     return Val_unit;
 438 }
 439
 440 ML_1 (glMatrixMode, GLenum_val)
 441 ML_1 (glMultMatrixd, Double_raw)
 442
 443 #ifdef GL_VERSION_1_3
 444 ML_1 (glMultTransposeMatrixd, Double_raw)
 445 #else
 446 CAMLprim void ml_glMultTransposeMatrixd (value raw)
 447 {
 448   ml_raise_gl ("Function: glMultTransposeMatrixd not available");
 449 }
 450 #endif
 451
 452 ML_3 (glNormal3d, Double_val, Double_val, Double_val)
 453
 454 ML_1 (glPassThrough, Float_val)
 455
 456 CAMLprim value ml_glPixelMapfv (value map, value raw)
 457 {
 458     glPixelMapfv (GLenum_val(map), Int_val(Size_raw(raw))/sizeof(GLfloat),
 459                   Float_raw(raw));
 460     return Val_unit;
 461 }
 462
 463 ML_3 (glOrtho, Pair(arg1,Double_val,Double_val),
 464       Pair(arg2,Double_val,Double_val), Pair(arg3,Double_val,Double_val))
 465
 466 ML_1 (glPixelStorei, Pair(arg1,GLenum_val,Int_val))
 467
 468 CAMLprim value ml_glPixelTransfer (value param)
 469 {
 470     GLenum pname = GLenum_val (Field(param,0));
 471
 472     switch (pname) {
 473     case GL_MAP_COLOR:
 474     case GL_MAP_STENCIL:
 475     case GL_INDEX_SHIFT:
 476     case GL_INDEX_OFFSET:
 477         glPixelTransferi (pname, Int_val (Field(param,1)));
 478         break;
 479     default:
 480         glPixelTransferf (pname, Float_val (Field(param,1)));
 481     }
 482     return Val_unit;
 483 }
 484
 485 ML_2 (glPixelZoom, Float_val, Float_val)
 486 ML_1 (glPointSize, Float_val)
 487 ML_2 (glPolygonOffset, Float_val, Float_val)
 488 ML_2 (glPolygonMode, GLenum_val, GLenum_val)
 489 ML_1 (glPolygonStipple, (unsigned char *)Byte_raw)
 490 ML_0 (glPopAttrib)
 491 ML_0 (glPopMatrix)
 492 ML_0 (glPopName)
 493
 494 CAMLprim value ml_glPushAttrib (value list)
 495 {
 496     GLbitfield mask = 0;
 497
 498     while (list != Val_int(0)) {
 499         switch (Field(list,0)) {
 500         case MLTAG_accum_buffer:mask |= GL_ACCUM_BUFFER_BIT; break;
 501         case MLTAG_color_buffer:mask |= GL_COLOR_BUFFER_BIT; break;
 502         case MLTAG_current:     mask |= GL_CURRENT_BIT; break;
 503         case MLTAG_depth_buffer:mask |= GL_DEPTH_BUFFER_BIT; break;
 504         case MLTAG_enable:      mask |= GL_ENABLE_BIT; break;
 505         case MLTAG_eval:        mask |= GL_EVAL_BIT; break;
 506         case MLTAG_fog:         mask |= GL_FOG_BIT; break;
 507         case MLTAG_hint:        mask |= GL_HINT_BIT; break;
 508         case MLTAG_lighting:    mask |= GL_LIGHTING_BIT; break;
 509         case MLTAG_line:        mask |= GL_LINE_BIT; break;
 510         case MLTAG_list:        mask |= GL_LIST_BIT; break;
 511         case MLTAG_pixel_mode:  mask |= GL_PIXEL_MODE_BIT; break;
 512         case MLTAG_point:       mask |= GL_POINT_BIT; break;
 513         case MLTAG_polygon:     mask |= GL_POLYGON_BIT; break;
 514         case MLTAG_polygon_stipple:mask |= GL_POLYGON_STIPPLE_BIT; break;
 515         case MLTAG_scissor:     mask |= GL_SCISSOR_BIT; break;
 516         case MLTAG_stencil_buffer:mask |= GL_STENCIL_BUFFER_BIT; break;
 517         case MLTAG_texture:     mask |= GL_TEXTURE_BIT; break;
 518         case MLTAG_transform:   mask |= GL_TRANSFORM_BIT; break;
 519         case MLTAG_viewport:    mask |= GL_VIEWPORT_BIT; break;
 520         }
 521         list = Field(list,1);
 522     }
 523     glPushAttrib (mask);
 524     return Val_unit;
 525 }
 526
 527 ML_0 (glPushMatrix)
 528 ML_1 (glPushName, Int_val)
 529
 530 CAMLprim value ml_glRasterPos(value x, value y, value z, value w)  /* ML */
 531 {
 532     if (z == Val_int(0)) glRasterPos2d (Double_val(x), Double_val(y));
 533     else if (w == Val_int(0))
 534         glRasterPos3d (Double_val(x), Double_val(y), Double_val(Field(z, 0)));
 535     else
 536         glRasterPos4d (Double_val(x), Double_val(y), Double_val(Field(z, 0)),
 537                     Double_val(Field(w, 0)));
 538     return Val_unit;
 539 }
 540
 541 CAMLprim value ml_glReadBuffer (value buffer)
 542 {
 543     if (Is_block(buffer)) {
 544         int n = Int_val (Field(buffer,1));
 545         if (n >= GL_AUX_BUFFERS)
 546             ml_raise_gl ("GlFunc.read_buffer : no such auxiliary buffer");
 547         glReadBuffer (GL_AUX0 + n);
 548     }
 549     else glReadBuffer (GLenum_val(buffer));
 550     return Val_unit;
 551 }
 552
 553 CAMLprim value ml_glReadPixels(value x, value y, value w, value h, value format , value raw)  /* ML */
 554 {
 555   glPixelStorei(GL_PACK_SWAP_BYTES, 0);
 556   glPixelStorei(GL_PACK_ALIGNMENT, 1);
 557   glReadPixels(Int_val(x),Int_val(y),Int_val(w),Int_val(h),GLenum_val(format),
 558                Type_void_raw(raw));
 559   return Val_unit;
 560 }
 561
 562 ML_bc6 (ml_glReadPixels)
 563 ML_2 (glRectd, Pair(arg1,Double_val,Double_val),
 564       Pair(arg2,Double_val,Double_val))
 565 ML_1_ (glRenderMode, GLenum_val, Val_int)
 566 ML_4 (glRotated, Double_val, Double_val, Double_val, Double_val)
 567 ML_3 (glScaled, Double_val, Double_val, Double_val)
 568
 569 ML_4 (glScissor, Int_val, Int_val, Int_val, Int_val)
 570 ML_2 (glSelectBuffer, Int_val, (GLuint*)Addr_raw)
 571 ML_1 (glShadeModel, GLenum_val)
 572 ML_3 (glStencilFunc, GLenum_val, Int_val, Int_val)
 573 ML_1 (glStencilMask, Int_val)
 574 ML_3 (glStencilOp, GLenum_val, GLenum_val, GLenum_val)
 575
 576 ML_1 (glTexCoord1d, Double_val)
 577 ML_2 (glTexCoord2d, Double_val, Double_val)
 578 ML_3 (glTexCoord3d, Double_val, Double_val, Double_val)
 579 ML_4 (glTexCoord4d, Double_val, Double_val, Double_val, Double_val)
 580
 581 CAMLprim value ml_glTexEnv (value param)
 582 {
 583     value params = Field(param,1);
 584     GLfloat color[4];
 585     int i;
 586
 587     switch (Field(param,0)) {
 588     case MLTAG_mode:
 589         glTexEnvi (GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GLenum_val(params));
 590         break;
 591     case MLTAG_color:
 592         for (i = 0; i < 4; i++) color[i] = Float_val(Field(params,i));
 593         glTexEnvfv (GL_TEXTURE_ENV, GL_TEXTURE_ENV_COLOR, color);
 594         break;
 595     }
 596     return Val_unit;
 597 }
 598
 599 CAMLprim value ml_glTexGen (value coord, value param)
 600 {
 601     value params = Field(param,1);
 602     GLdouble point[4];
 603     int i;
 604
 605     if (Field(param,0) == MLTAG_mode)
 606         glTexGeni (GLenum_val(coord), GL_TEXTURE_GEN_MODE, GLenum_val(params));
 607     else {
 608         for (i = 0; i < 4; i++) point[i] = Double_val(Field(params,i));
 609         glTexGendv (GLenum_val(coord), GLenum_val(Field(param,0)), point);
 610     }
 611     return Val_unit;
 612 }
 613
 614 CAMLprim value ml_glTexImage1D (value proxy, value level, value internal,
 615                                 value width, value border, value format,
 616                                 value data)
 617 {
 618     glTexImage1D (proxy == Val_int(1)
 619                   ? GL_PROXY_TEXTURE_1D : GL_TEXTURE_1D,
 620                   Int_val(level), Int_val(internal), Int_val(width),
 621                   Int_val(border), GLenum_val(format),
 622                   Type_raw(data), Void_raw(data));
 623     return Val_unit;
 624 }
 625
 626 ML_bc7 (ml_glTexImage1D)
 627
 628 CAMLprim value ml_glTexImage2D (value proxy, value level, value internal,
 629                                 value width, value height, value border,
 630                                 value format, value data)
 631 {
 632     /* printf("p=%x,l=%d,i=%d,w=%d,h=%d,b=%d,f=%x,t=%x,d=%x\n", */
 633     glTexImage2D (proxy == Val_int(1)
 634                   ? GL_PROXY_TEXTURE_2D : GL_TEXTURE_2D,
 635                   Int_val(level), Int_val(internal), Int_val(width),
 636                   Int_val(height), Int_val(border), GLenum_val(format),
 637                   Type_raw(data), Void_raw(data));
 638     /*  flush(stdout); */
 639     return Val_unit;
 640 }
 641
 642 ML_bc8 (ml_glTexImage2D)
 643
 644 CAMLprim value ml_glTexParameter (value target, value param)
 645 {
 646     GLenum targ = GLenum_val(target);
 647     GLenum pname = GLenum_val(Field(param,0));
 648     value params = Field(param,1);
 649     GLfloat color[4];
 650     int i;
 651
 652     switch (pname) {
 653     case GL_TEXTURE_BORDER_COLOR:
 654         for (i = 0; i < 4; i++) color[i] = Float_val(Field(params,i));
 655         glTexParameterfv (targ, pname, color);
 656         break;
 657     case GL_TEXTURE_PRIORITY:
 658         glTexParameterf (targ, pname, Float_val(params));
 659         break;
 660     case GL_GENERATE_MIPMAP:
 661 #ifdef GL_VERSION_1_4
 662         glTexParameteri (targ, pname, Int_val(params));
 663 #else
 664         ml_raise_gl ("Parameter: GL_GENERATE_MIPMAP not available");
 665 #endif
 666         break;
 667     default:
 668         glTexParameteri (targ, pname, GLenum_val(params));
 669         break;
 670     }
 671     return Val_unit;
 672 }
 673
 674 ML_2 (glGenTextures, Int_val, Int_raw)
 675 ML_2 (glBindTexture, GLenum_val, Nativeint_val)
 676
 677 CAMLprim value ml_glDeleteTexture (value texture_id)
 678 {
 679     GLuint id = Nativeint_val(texture_id);
 680     glDeleteTextures(1,&id);
 681     return Val_unit;
 682 }
 683
 684 ML_3 (glTranslated, Double_val, Double_val, Double_val)
 685
 686 CAMLprim value ml_glVertex(value x, value y, value z, value w)  /* ML */
 687 {
 688     if (z == Val_int(0)) glVertex2d (Double_val(x), Double_val(y));
 689     else if (w == Val_int(0))
 690         glVertex3d (Double_val(x), Double_val(y), Double_val(Field(z, 0)));
 691     else
 692         glVertex4d (Double_val(x), Double_val(y), Double_val(Field(z, 0)),
 693                     Double_val(Field(w, 0)));
 694     return Val_unit;
 695 }
 696
 697 ML_4 (glViewport, Int_val, Int_val, Int_val, Int_val)
 698
 699
 700 /* List functions */
 701
 702 ML_1_ (glIsList, Int_val, Val_int)
 703 ML_2 (glDeleteLists, Int_val, Int_val)
 704 ML_1_ (glGenLists, Int_val, Val_int)
 705 ML_2 (glNewList, Int_val, GLenum_val)
 706 ML_0 (glEndList)
 707 ML_1 (glCallList, Int_val)
 708 ML_1 (glListBase, Int_val)
 709
 710 CAMLprim value ml_glCallLists (value indexes)  /* ML */
 711 {
 712     int len,i;
 713     int * table;
 714
 715     switch (Field(indexes,0)) {
 716     case MLTAG_byte:
 717         glCallLists (string_length(Field(indexes,1)),
 718                      GL_UNSIGNED_BYTE,
 719                      String_val(Field(indexes,1)));
 720         break;
 721     case MLTAG_int:
 722         len = Wosize_val (indexes);
 723         table = calloc (len, sizeof (GLint));
 724         for (i = 0; i < len; i++) table[i] = Int_val (Field(indexes,i));
 725         glCallLists (len, GL_INT, table);
 726         free (table);
 727         break;
 728     }
 729     return Val_unit;
 730 }