Fix corner case
[llpp.git] / lablGL / ml_gl.c
blobc9b04ad2142f1a287a9ee07fbe632b2a33eb2e8d
1 /* $Id: ml_gl.c,v 1.51 2007-04-13 02:48:43 garrigue Exp $ */
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"
26 #if !defined(GL_VERSION_1_4)
27 #define GL_GENERATE_MIPMAP 0x8191
28 #endif
30 /* #include <stdio.h> */
32 void ml_raise_gl(const char *errmsg)
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);
40 value copy_string_check (const char *str)
42 if (!str) ml_raise_gl("Null string");
43 return copy_string ((char*) str);
46 struct record {
47 value key;
48 GLenum data;
51 static struct record input_table[] = {
52 #include "gl_tags.c"
55 static struct record *tag_table = NULL;
57 #define TABLE_SIZE (TAG_NUMBER*2+1)
59 CAMLprim value ml_gl_make_table (value unit)
61 int i;
62 unsigned int hash;
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;
72 tag_table[hash].key = input_table[i].key;
73 tag_table[hash].data = input_table[i].data;
75 return Val_unit;
78 GLenum GLenum_val(value tag)
80 unsigned int hash = (unsigned long) tag % TABLE_SIZE;
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;
89 fprintf(stderr, "Converted %ld to %d", Int_val(tag), tag_table[hash].data);
91 return tag_table[hash].data;
95 GLenum GLenum_val(value tag)
97 switch(tag)
99 #include "gl_tags.c"
101 ml_raise_gl("Unknown tag");
105 ML_2 (glAccum, GLenum_val, Float_val)
106 ML_2 (glAlphaFunc, GLenum_val, Float_val)
108 ML_1 (glBegin, GLenum_val)
110 ML_5 (glBitmap, Int_val, Int_val, Pair(arg3,Float_val,Float_val),
111 Pair(arg4,Float_val,Float_val), Void_raw)
113 ML_2 (glBlendFunc, GLenum_val, GLenum_val)
115 CAMLprim value ml_glClipPlane(value plane, value equation) /* ML */
117 double eq[4];
118 int i;
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;
126 CAMLprim value ml_glClear(value bit_list) /* ML */
128 GLbitfield accu = 0;
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;
141 bit_list = Field (bit_list, 1);
143 glClear (accu);
144 return Val_unit;
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)
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)
162 CAMLprim value ml_glDrawBuffer (value buffer)
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);
170 else glDrawBuffer (GLenum_val(buffer));
171 return Val_unit;
174 ML_4 (glDrawPixels, Int_val, Int_val, GLenum_val, Type_void_raw)
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)
187 ML_3 (glFeedbackBuffer, Int_val, GLenum_val, (GLfloat*)Addr_raw)
189 CAMLprim value ml_glFog (value param) /* ML */
191 float params[4];
192 int i;
194 switch (Field(param,0))
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;
216 return Val_unit;
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))
225 ML_1_ (glGetString, GLenum_val, copy_string_check)
226 ML_2 (glGetDoublev, GLenum_val, Double_raw)
228 CAMLprim value ml_glGetError(value unit)
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");
245 CAMLprim value ml_glHint (value target, value hint)
247 GLenum targ = 0U;
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;
257 glHint (targ, GLenum_val(hint));
258 return Val_unit;
261 ML_1 (glIndexMask, Int_val)
262 ML_1 (glIndexd, Double_val)
263 ML_0 (glInitNames)
264 ML_1_ (glIsEnabled, GLenum_val, Val_int)
266 CAMLprim value ml_glLight (value n, value param) /* ML */
268 float params[4];
269 int i;
271 if (Int_val(n) >= GL_MAX_LIGHTS) invalid_argument ("Gl.light");
272 switch (Field(param,0))
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));
288 glLightfv (GL_LIGHT0 + Int_val(n), GLenum_val(Field(param,0)), params);
289 return Val_unit;
292 CAMLprim value ml_glLightModel (value param) /* ML */
294 float params[4];
295 int i;
297 switch (Field(param,0))
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))
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;
325 #else
326 ml_raise_gl ("Parameter: GL_LIGHT_MODEL_COLOR_CONTROL not available");
327 #endif
328 break;
330 return Val_unit;
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)
339 #ifdef GL_VERSION_1_3
340 ML_1 (glLoadTransposeMatrixd, Double_raw)
341 #else
342 CAMLprim void ml_glLoadTransposeMatrixd (value raw)
344 ml_raise_gl ("Function: glLoadTransposeMatrixd not available");
346 #endif
347 ML_1 (glLogicOp, GLenum_val)
349 CAMLprim value ml_glMap1d (value target, value *u, value order, value raw)
351 int ustride = 0;
352 GLenum targ = 0U;
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;
374 glMap1d (targ, Double_val(u[0]), Double_val(u[1]),
375 ustride, Int_val(order), Double_raw(raw));
376 return Val_unit;
379 CAMLprim value ml_glMap2d (value target, value u, value uorder,
380 value v, value vorder, value raw)
382 int ustride = 0;
383 GLenum targ = 0U;
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;
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;
411 ML_bc6 (ml_glMap2d)
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))
417 CAMLprim value ml_glMaterial (value face, value param) /* ML */
419 float params[4];
420 int i;
422 switch (Field(param,0))
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;
436 glMaterialfv (GLenum_val(face), GLenum_val(Field(param,0)), params);
437 return Val_unit;
440 ML_1 (glMatrixMode, GLenum_val)
441 ML_1 (glMultMatrixd, Double_raw)
443 #ifdef GL_VERSION_1_3
444 ML_1 (glMultTransposeMatrixd, Double_raw)
445 #else
446 CAMLprim void ml_glMultTransposeMatrixd (value raw)
448 ml_raise_gl ("Function: glMultTransposeMatrixd not available");
450 #endif
452 ML_3 (glNormal3d, Double_val, Double_val, Double_val)
454 ML_1 (glPassThrough, Float_val)
456 CAMLprim value ml_glPixelMapfv (value map, value raw)
458 glPixelMapfv (GLenum_val(map), Int_val(Size_raw(raw))/sizeof(GLfloat),
459 Float_raw(raw));
460 return Val_unit;
463 ML_3 (glOrtho, Pair(arg1,Double_val,Double_val),
464 Pair(arg2,Double_val,Double_val), Pair(arg3,Double_val,Double_val))
466 ML_1 (glPixelStorei, Pair(arg1,GLenum_val,Int_val))
468 CAMLprim value ml_glPixelTransfer (value param)
470 GLenum pname = GLenum_val (Field(param,0));
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)));
482 return Val_unit;
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)
494 CAMLprim value ml_glPushAttrib (value list)
496 GLbitfield mask = 0;
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;
521 list = Field(list,1);
523 glPushAttrib (mask);
524 return Val_unit;
527 ML_0 (glPushMatrix)
528 ML_1 (glPushName, Int_val)
530 CAMLprim value ml_glRasterPos(value x, value y, value z, value w) /* ML */
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;
541 CAMLprim value ml_glReadBuffer (value buffer)
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);
549 else glReadBuffer (GLenum_val(buffer));
550 return Val_unit;
553 CAMLprim value ml_glReadPixels(value x, value y, value w, value h, value format , value raw) /* ML */
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;
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)
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)
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)
581 CAMLprim value ml_glTexEnv (value param)
583 value params = Field(param,1);
584 GLfloat color[4];
585 int i;
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;
596 return Val_unit;
599 CAMLprim value ml_glTexGen (value coord, value param)
601 value params = Field(param,1);
602 GLdouble point[4];
603 int i;
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);
611 return Val_unit;
614 CAMLprim value ml_glTexImage1D (value proxy, value level, value internal,
615 value width, value border, value format,
616 value data)
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;
626 ML_bc7 (ml_glTexImage1D)
628 CAMLprim value ml_glTexImage2D (value proxy, value level, value internal,
629 value width, value height, value border,
630 value format, value data)
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;
642 ML_bc8 (ml_glTexImage2D)
644 CAMLprim value ml_glTexParameter (value target, value param)
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;
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;
671 return Val_unit;
674 ML_2 (glGenTextures, Int_val, Int_raw)
675 ML_2 (glBindTexture, GLenum_val, Nativeint_val)
677 CAMLprim value ml_glDeleteTexture (value texture_id)
679 GLuint id = Nativeint_val(texture_id);
680 glDeleteTextures(1,&id);
681 return Val_unit;
684 ML_3 (glTranslated, Double_val, Double_val, Double_val)
686 CAMLprim value ml_glVertex(value x, value y, value z, value w) /* ML */
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;
697 ML_4 (glViewport, Int_val, Int_val, Int_val, Int_val)
700 /* List functions */
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)
710 CAMLprim value ml_glCallLists (value indexes) /* ML */
712 int len,i;
713 int * table;
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;
729 return Val_unit;