summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--CHANGES9
-rw-r--r--LablGlut/src/wrap_gl.c310
-rw-r--r--LablGlut/src/wrap_glut.c56
-rw-r--r--Makefile.config.ex6
-rw-r--r--Makefile.config.osx6
-rw-r--r--README13
-rw-r--r--Togl/src/ml_togl.c2
-rw-r--r--debian/changelog6
-rw-r--r--debian/control2
-rw-r--r--debian/watch2
-rw-r--r--src/Makefile10
-rw-r--r--src/ml_gl.c14
-rw-r--r--src/ml_glarray.c2
-rw-r--r--src/ml_glu.c22
-rw-r--r--src/ml_glutess.c16
-rw-r--r--src/ml_raw.c54
-rw-r--r--src/ml_shader.c5
17 files changed, 289 insertions, 246 deletions
diff --git a/CHANGES b/CHANGES
index bff0a05..d736801 100644
--- a/CHANGES
+++ b/CHANGES
@@ -1,3 +1,12 @@
+LablGL 1.07:
+------------
+2023-02-21:
+* Update Makefile.config.osx [Jacques]
+* Add support for OCaml 5.0.0 (#3) [Kate Deplaix]
+
+2022-04-21:
+* Activate CAML_NAME_SPACE (#2) [Kate Deplaix]
+
LablGL 1.06:
------------
2019-08-07:
diff --git a/LablGlut/src/wrap_gl.c b/LablGlut/src/wrap_gl.c
index 009ca48..836d3cf 100644
--- a/LablGlut/src/wrap_gl.c
+++ b/LablGlut/src/wrap_gl.c
@@ -1,154 +1,156 @@
-#ifdef __APPLE__
-#include <GLUT/glut.h>
-#else
-#include <GL/glut.h>
-#endif
-#include <stdio.h>
-#include <stdlib.h>
-
-#include <caml/mlvalues.h>
-#include <caml/callback.h>
-
-static void ocaml_gl_warning(const char msg[])
-{
- fprintf(stderr, "OCaml Open GL warning : %s", msg);
- fflush(stderr);
-}
-
-value ocaml_glClear (
- value will_clear_color_buffer,
- value will_clear_depth_buffer)
-{
- GLbitfield mask = 0;
- mask |= (Bool_val(will_clear_color_buffer) ? GL_COLOR_BUFFER_BIT : 0);
- mask |= (Bool_val(will_clear_depth_buffer) ? GL_DEPTH_BUFFER_BIT : 0);
- glClear(mask);
- return Val_unit;
-}
-
-value ocaml_glClearColor (value r, value g, value b, value a)
-{
- glClearColor(Double_val(r), Double_val(g), Double_val(b), Double_val(a));
- return Val_unit;
-}
-
-value ocaml_glBegin (value primitive_type)
-{
- switch( Int_val(primitive_type) )
- {
- case 0: glBegin(GL_POINTS); break;
- case 1: glBegin(GL_LINES); break;
- case 2: glBegin(GL_LINE_LOOP); break;
- case 3: glBegin(GL_LINE_STRIP); break;
- case 4: glBegin(GL_TRIANGLES); break;
- case 5: glBegin(GL_TRIANGLE_STRIP); break;
- case 6: glBegin(GL_TRIANGLE_FAN); break;
- case 7: glBegin(GL_QUADS); break;
- case 8: glBegin(GL_QUAD_STRIP); break;
- case 9: glBegin(GL_POLYGON); break;
- default:
- ocaml_gl_warning("Unrecognized primitive type in ocaml_glBegin()\n");
- }
- return Val_unit;
-}
-
-value ocaml_glVertex3d (value vx, value vy, value vz)
-{
- double x,y,z;
- x = Double_val(vx);
- y = Double_val(vy);
- z = Double_val(vz);
- glVertex3d(x,y,z);
- return Val_unit;
-}
-
-value ocaml_glVertex2d (value vx, value vy)
-{
- double x,y;
- x = Double_val(vx);
- y = Double_val(vy);
- glVertex2d(x,y);
- return Val_unit;
-}
-
-
-value ocaml_glColor3d (value r, value g, value b)
-{
- glColor3d(Double_val(r), Double_val(g), Double_val(b));
- return Val_unit;
-}
-
-// TexCoord
-
-// Normal
-
-value ocaml_glEnd ()
-{
- glEnd();
- return Val_unit;
-}
-
-value ocaml_glFlush ()
-{
- glFlush();
- return Val_unit;
-}
-
-value ocaml_glViewport (value vx, value vy, value vwidth, value vheight)
-{
- int x,y,w,h;
- x=Int_val(vx);
- y=Int_val(vy);
- w=Int_val(vwidth);
- h=Int_val(vheight);
- glViewport(x, y, w, h);
- return Val_unit;
-}
-
-value ocaml_glMatrixMode (value mode)
-{
- int imode = Int_val(mode);
- switch(imode)
- {
- case 0: glMatrixMode(GL_MODELVIEW); break;
- case 1: glMatrixMode(GL_PROJECTION); break;
- case 2: glMatrixMode(GL_TEXTURE); break;
- default:
- ocaml_gl_warning("Unrecognized mode in ocaml_glMatrixMode()\n");
- }
- return Val_unit;
-}
-
-value ocaml_glLoadIdentity ()
-{
- glLoadIdentity();
- return Val_unit;
-}
-
-value ocaml_glShadeModel (value model)
-{
- switch(Int_val(model))
- {
- case 0: glShadeModel(GL_FLAT); break;
- case 1: glShadeModel(GL_SMOOTH); break;
- default:
- ocaml_gl_warning("Unrecognized mode in ocaml_glShadeModel()\n");
- }
- return Val_unit;
-}
-
-value native_ocaml_glOrtho(
- value left, value right, value bot, value top, value znear, value zfar)
-{
- glOrtho(Double_val(left), Double_val(right), Double_val(bot), Double_val(top),
- Double_val(znear), Double_val(zfar));
- return Val_unit;
-}
-
-value bytecode_ocaml_glOrtho(value * args, int num_args)
-{
- native_ocaml_glOrtho(args[0], args[1], args[2], args[3], args[4], args[5]);
- return Val_unit;
-}
-
-
+#define CAML_NAME_SPACE
+
+#ifdef __APPLE__
+#include <GLUT/glut.h>
+#else
+#include <GL/glut.h>
+#endif
+#include <stdio.h>
+#include <stdlib.h>
+
+#include <caml/mlvalues.h>
+#include <caml/callback.h>
+
+static void ocaml_gl_warning(const char msg[])
+{
+ fprintf(stderr, "OCaml Open GL warning : %s", msg);
+ fflush(stderr);
+}
+
+value ocaml_glClear (
+ value will_clear_color_buffer,
+ value will_clear_depth_buffer)
+{
+ GLbitfield mask = 0;
+ mask |= (Bool_val(will_clear_color_buffer) ? GL_COLOR_BUFFER_BIT : 0);
+ mask |= (Bool_val(will_clear_depth_buffer) ? GL_DEPTH_BUFFER_BIT : 0);
+ glClear(mask);
+ return Val_unit;
+}
+
+value ocaml_glClearColor (value r, value g, value b, value a)
+{
+ glClearColor(Double_val(r), Double_val(g), Double_val(b), Double_val(a));
+ return Val_unit;
+}
+
+value ocaml_glBegin (value primitive_type)
+{
+ switch( Int_val(primitive_type) )
+ {
+ case 0: glBegin(GL_POINTS); break;
+ case 1: glBegin(GL_LINES); break;
+ case 2: glBegin(GL_LINE_LOOP); break;
+ case 3: glBegin(GL_LINE_STRIP); break;
+ case 4: glBegin(GL_TRIANGLES); break;
+ case 5: glBegin(GL_TRIANGLE_STRIP); break;
+ case 6: glBegin(GL_TRIANGLE_FAN); break;
+ case 7: glBegin(GL_QUADS); break;
+ case 8: glBegin(GL_QUAD_STRIP); break;
+ case 9: glBegin(GL_POLYGON); break;
+ default:
+ ocaml_gl_warning("Unrecognized primitive type in ocaml_glBegin()\n");
+ }
+ return Val_unit;
+}
+
+value ocaml_glVertex3d (value vx, value vy, value vz)
+{
+ double x,y,z;
+ x = Double_val(vx);
+ y = Double_val(vy);
+ z = Double_val(vz);
+ glVertex3d(x,y,z);
+ return Val_unit;
+}
+
+value ocaml_glVertex2d (value vx, value vy)
+{
+ double x,y;
+ x = Double_val(vx);
+ y = Double_val(vy);
+ glVertex2d(x,y);
+ return Val_unit;
+}
+
+
+value ocaml_glColor3d (value r, value g, value b)
+{
+ glColor3d(Double_val(r), Double_val(g), Double_val(b));
+ return Val_unit;
+}
+
+// TexCoord
+
+// Normal
+
+value ocaml_glEnd ()
+{
+ glEnd();
+ return Val_unit;
+}
+
+value ocaml_glFlush ()
+{
+ glFlush();
+ return Val_unit;
+}
+
+value ocaml_glViewport (value vx, value vy, value vwidth, value vheight)
+{
+ int x,y,w,h;
+ x=Int_val(vx);
+ y=Int_val(vy);
+ w=Int_val(vwidth);
+ h=Int_val(vheight);
+ glViewport(x, y, w, h);
+ return Val_unit;
+}
+
+value ocaml_glMatrixMode (value mode)
+{
+ int imode = Int_val(mode);
+ switch(imode)
+ {
+ case 0: glMatrixMode(GL_MODELVIEW); break;
+ case 1: glMatrixMode(GL_PROJECTION); break;
+ case 2: glMatrixMode(GL_TEXTURE); break;
+ default:
+ ocaml_gl_warning("Unrecognized mode in ocaml_glMatrixMode()\n");
+ }
+ return Val_unit;
+}
+
+value ocaml_glLoadIdentity ()
+{
+ glLoadIdentity();
+ return Val_unit;
+}
+
+value ocaml_glShadeModel (value model)
+{
+ switch(Int_val(model))
+ {
+ case 0: glShadeModel(GL_FLAT); break;
+ case 1: glShadeModel(GL_SMOOTH); break;
+ default:
+ ocaml_gl_warning("Unrecognized mode in ocaml_glShadeModel()\n");
+ }
+ return Val_unit;
+}
+
+value native_ocaml_glOrtho(
+ value left, value right, value bot, value top, value znear, value zfar)
+{
+ glOrtho(Double_val(left), Double_val(right), Double_val(bot), Double_val(top),
+ Double_val(znear), Double_val(zfar));
+ return Val_unit;
+}
+
+value bytecode_ocaml_glOrtho(value * args, int num_args)
+{
+ native_ocaml_glOrtho(args[0], args[1], args[2], args[3], args[4], args[5]);
+ return Val_unit;
+}
+
+
diff --git a/LablGlut/src/wrap_glut.c b/LablGlut/src/wrap_glut.c
index c869e17..499e0a4 100644
--- a/LablGlut/src/wrap_glut.c
+++ b/LablGlut/src/wrap_glut.c
@@ -7,6 +7,8 @@
*
*/
+#define CAML_NAME_SPACE
+
#ifdef _WIN32
#define GLUT_DISABLE_ATEXIT_HACK
#include <windows.h>
@@ -35,9 +37,9 @@
/* ML_0(glutMainLoop) */
CAMLprim value ml_glutMainLoop (value unit) \
{
- enter_blocking_section ();
+ caml_enter_blocking_section ();
glutMainLoop ();
- leave_blocking_section ();
+ caml_leave_blocking_section ();
return Val_unit;
}
@@ -79,7 +81,7 @@ ML_1(glutRemoveMenuItem, Int_val)
ML_1(glutAttachMenu, Int_val)
ML_1(glutDetachMenu, Int_val)
ML_4(glutSetColor, Int_val, Float_val, Float_val, Float_val)
-ML_2_(glutGetColor, Int_val, Int_val, copy_double)
+ML_2_(glutGetColor, Int_val, Int_val, caml_copy_double)
ML_1(glutCopyColormap, Int_val)
ML_1_(glutGet, Int_val, Val_int)
ML_1_(glutDeviceGet, Int_val, Val_int)
@@ -215,18 +217,18 @@ CAMLprim value bytecode_glutInitDisplayMode ( value * args, int num_args)
#define CB_0(glut_func) \
value glut_func##_value = 0; \
static void glut_func##_cb( void ) { \
- leave_blocking_section (); \
- callback(glut_func##_value, Val_unit); \
- enter_blocking_section (); \
+ caml_leave_blocking_section (); \
+ caml_callback(glut_func##_value, Val_unit); \
+ caml_enter_blocking_section (); \
} \
REGISTER_CB(glut_func)
#define CB_1(glut_func, type1, conv1) \
value glut_func##_value = 0; \
static void glut_func##_cb( type1 arg1 ) { \
- leave_blocking_section (); \
- callback(glut_func##_value, conv1(arg1)); \
- enter_blocking_section (); \
+ caml_leave_blocking_section (); \
+ caml_callback(glut_func##_value, conv1(arg1)); \
+ caml_enter_blocking_section (); \
} \
REGISTER_CB(glut_func)
@@ -234,27 +236,27 @@ CAMLprim value bytecode_glutInitDisplayMode ( value * args, int num_args)
#define CB_1_(glut_func, type1, conv1, conv) \
value glut_func##_value = 0; \
static void glut_func##_cb( type1 arg1 ) { \
- leave_blocking_section (); \
- callback(glut_func##_value, conv1(arg1)); \
- enter_blocking_section (); \
+ caml_leave_blocking_section (); \
+ caml_callback(glut_func##_value, conv1(arg1)); \
+ caml_enter_blocking_section (); \
} \
REGISTER_CB_(glut_func, conv)
#define CB_2(glut_func, type1, conv1, type2, conv2) \
value glut_func##_value = 0; \
static void glut_func##_cb( type1 arg1, type2 arg2 ) { \
- leave_blocking_section (); \
- callback2(glut_func##_value, conv1(arg1), conv2(arg2)); \
- enter_blocking_section (); \
+ caml_leave_blocking_section (); \
+ caml_callback2(glut_func##_value, conv1(arg1), conv2(arg2)); \
+ caml_enter_blocking_section (); \
} \
REGISTER_CB(glut_func)
#define CB_3(glut_func, type1, conv1, type2, conv2, type3, conv3) \
value glut_func##_value = 0; \
static void glut_func##_cb( type1 arg1, type2 arg2, type3 arg3 ) { \
- leave_blocking_section (); \
- callback3(glut_func##_value, conv1(arg1), conv2(arg2), conv3(arg3)); \
- enter_blocking_section (); \
+ caml_leave_blocking_section (); \
+ caml_callback3(glut_func##_value, conv1(arg1), conv2(arg2), conv3(arg3)); \
+ caml_enter_blocking_section (); \
} \
REGISTER_CB(glut_func)
@@ -263,13 +265,13 @@ CAMLprim value bytecode_glutInitDisplayMode ( value * args, int num_args)
static void glut_func##_cb( type1 arg1, type2 arg2, type3 arg3, type4 arg4 )\
{ \
value args[4]; \
- leave_blocking_section (); \
+ caml_leave_blocking_section (); \
args[0] = conv1(arg1); \
args[1] = conv2(arg2); \
args[2] = conv3(arg3); \
args[3] = conv4(arg4); \
- callbackN (glut_func##_value, 4, args); \
- enter_blocking_section (); \
+ caml_callbackN (glut_func##_value, 4, args); \
+ caml_enter_blocking_section (); \
} \
REGISTER_CB(glut_func)
@@ -279,13 +281,13 @@ CAMLprim value bytecode_glutInitDisplayMode ( value * args, int num_args)
static void glut_func##_cb( type1 arg1, type2 arg2, type3 arg3, type4 arg4 )\
{ \
value args[4]; \
- leave_blocking_section (); \
+ caml_leave_blocking_section (); \
args[0] = conv1(arg1); \
args[1] = conv2(arg2); \
args[2] = conv3(arg3); \
args[3] = conv4(arg4); \
- callbackN (glut_func##_value, 4, args); \
- enter_blocking_section (); \
+ caml_callbackN (glut_func##_value, 4, args); \
+ caml_enter_blocking_section (); \
} \
REGISTER__CB(glut_func, conv)
@@ -330,9 +332,9 @@ CAMLprim void init_glutTimerFunc_cb(value v)
static void glutTimerFunc_cb(int val)
{
- leave_blocking_section ();
- callback (caml_glutTimerFunc_cb, (value) val);
- enter_blocking_section ();
+ caml_leave_blocking_section ();
+ caml_callback (caml_glutTimerFunc_cb, (value) val);
+ caml_enter_blocking_section ();
}
CAMLprim value ml_glutTimerFunc(value millis, value timer_count) // set Timer callback
diff --git a/Makefile.config.ex b/Makefile.config.ex
index 87febe5..d11a9e8 100644
--- a/Makefile.config.ex
+++ b/Makefile.config.ex
@@ -6,7 +6,7 @@
##### Adjust these always
-# Uncomment if you have the fast ".opt" compilers
+# Uncomment if you have the fast ".opt" compilers and are not using findlib
#CAMLC = ocamlc.opt
#CAMLOPT = ocamlopt.opt
@@ -66,3 +66,7 @@ RANLIB = :
# C Compiler options
#COPTS = -c -O
+
+# Which camlp4o to use: camlp4o or camlp5o
+# It is only required when modifying .ml4 files
+#CAMLP4O=camlp5o pr_o.cmo
diff --git a/Makefile.config.osx b/Makefile.config.osx
index 404f8d1..5956932 100644
--- a/Makefile.config.osx
+++ b/Makefile.config.osx
@@ -6,9 +6,9 @@
##### Adjust these always
-# Uncomment if you have the fast ".opt" compilers
-CAMLC = ocamlc.opt
-CAMLOPT = ocamlopt.opt
+# Uncomment if you have the fast ".opt" compilers and are not using findlib
+#CAMLC = ocamlc.opt
+#CAMLOPT = ocamlopt.opt
# Where to put the lablgl script
BINDIR = /usr/local/bin
diff --git a/README b/README
index d9dd8df..90ff0a6 100644
--- a/README
+++ b/README
@@ -1,5 +1,5 @@
- LablGL 1.06: Installation and Use instructions
+ LablGL 1.07: Installation and Use instructions
1. Description
@@ -12,9 +12,9 @@ LablGlut for standalone applications not using Tcl/Tk.
2. Requisites
- * Objective Caml 3.05 to 4.08
- * Compatible version of Camlp5 (or Camlp4, see Makefile.common)
+ * Objective Caml since 4.14
* LablTk (included in Objective Caml, requires Tcl/Tk) for Togl support
+ (only works for Tcl/Tk older than 8.4)
* OpenGL
* glut (included in Mesa) for glut support
* GNU make (for conditionals)
@@ -35,9 +35,10 @@ everything.
in this distribution (version 1.7). You may obtain more information
about Togl at:
http://www.mesa3d.org/brianp/Togl.html
-Note that Togl is only compatible with vanilla Tcl/Tk: specially
-patched versions may not work. For instance 8.2.3+ included in old
-debian distributions does not work.
+Note that Togl is only compatible with vanilla Tcl/Tk older than 8.4:
+specially patched versions may not work. For instance 8.2.3+ included
+in old debian distributions does not work, and recent versions do not
+work either.
LablGlut requires glut, which is already included in recent versions
of Mesa and XFree86. For windows you need to obtain it from
diff --git a/Togl/src/ml_togl.c b/Togl/src/ml_togl.c
index 17e2ff7..2f833db 100644
--- a/Togl/src/ml_togl.c
+++ b/Togl/src/ml_togl.c
@@ -1,5 +1,7 @@
/* $Id: ml_togl.c,v 1.16 2006-03-23 06:01:55 garrigue Exp $ */
+#define CAML_NAME_SPACE
+
#ifdef _WIN32
#include <wtypes.h>
#endif
diff --git a/debian/changelog b/debian/changelog
index b2593e5..8f02bee 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,9 @@
+lablgl (1:1.07-1) unstable; urgency=medium
+
+ * New upstream release
+
+ -- Stéphane Glondu <glondu@debian.org> Sat, 30 Sep 2023 21:27:30 +0200
+
lablgl (1:1.06-2) unstable; urgency=medium
[ Stéphane Glondu ]
diff --git a/debian/control b/debian/control
index 8e7caa4..9238f67 100644
--- a/debian/control
+++ b/debian/control
@@ -12,6 +12,8 @@ Build-Depends:
tcl-dev,
tk-dev,
liblabltk-ocaml-dev,
+ libcamlp-streams-ocaml-dev,
+ ocaml-findlib,
libgl-dev,
libglu1-mesa-dev | libglu-dev,
freeglut3-dev,
diff --git a/debian/watch b/debian/watch
index dcba3b1..9c7f25d 100644
--- a/debian/watch
+++ b/debian/watch
@@ -1,2 +1,2 @@
version=4
-https://github.com/garrigue/lablgl/releases .*/archive/v(.*)\.tar\.gz
+https://github.com/garrigue/lablgl/tags .*/v(.*)\.tar\.gz
diff --git a/src/Makefile b/src/Makefile
index 42af55f..7ef36e4 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -31,11 +31,17 @@ opt: lablgl.cmxa
tools: var2def$(XE) var2switch$(XE)
+var2def.cmo: var2def.ml
+ $(OCAMLFIND) $(COMPILER) -package camlp-streams $<
+
var2def$(XE): var2def.cmo
- $(LINKER) $< -o $@
+ $(OCAMLFIND) $(LINKER) -package camlp-streams -linkpkg $< -o $@
+
+var2switch.cmo: var2switch.ml
+ $(OCAMLFIND) $(COMPILER) -package camlp-streams $<
var2switch$(XE): var2switch.cmo
- $(LINKER) $< -o $@
+ $(OCAMLFIND) $(LINKER) -package camlp-streams -linkpkg $< -o $@
ifeq ($(TOOLCHAIN), msvc)
liblablgl$(XA): $(COBJS)
diff --git a/src/ml_gl.c b/src/ml_gl.c
index c9b04ad..3080a5b 100644
--- a/src/ml_gl.c
+++ b/src/ml_gl.c
@@ -1,5 +1,7 @@
/* $Id: ml_gl.c,v 1.51 2007-04-13 02:48:43 garrigue Exp $ */
+#define CAML_NAME_SPACE
+
#ifdef _WIN32
#include <wtypes.h>
#endif
@@ -31,16 +33,16 @@
void ml_raise_gl(const char *errmsg)
{
- static value * gl_exn = NULL;
+ const static value * gl_exn = NULL;
if (gl_exn == NULL)
gl_exn = caml_named_value("glerror");
- raise_with_string(*gl_exn, (char*)errmsg);
+ caml_raise_with_string(*gl_exn, (char*)errmsg);
}
value copy_string_check (const char *str)
{
if (!str) ml_raise_gl("Null string");
- return copy_string ((char*) str);
+ return caml_copy_string ((char*) str);
}
struct record {
@@ -61,7 +63,7 @@ CAMLprim value ml_gl_make_table (value unit)
int i;
unsigned int hash;
- tag_table = stat_alloc (TABLE_SIZE * sizeof(struct record));
+ tag_table = caml_stat_alloc (TABLE_SIZE * sizeof(struct record));
memset ((char *) tag_table, 0, TABLE_SIZE * sizeof(struct record));
for (i = 0; i < TAG_NUMBER; i++) {
hash = (unsigned long) input_table[i].key % TABLE_SIZE;
@@ -268,7 +270,7 @@ CAMLprim value ml_glLight (value n, value param) /* ML */
float params[4];
int i;
- if (Int_val(n) >= GL_MAX_LIGHTS) invalid_argument ("Gl.light");
+ if (Int_val(n) >= GL_MAX_LIGHTS) caml_invalid_argument ("Gl.light");
switch (Field(param,0))
{
case MLTAG_ambient:
@@ -714,7 +716,7 @@ CAMLprim value ml_glCallLists (value indexes) /* ML */
switch (Field(indexes,0)) {
case MLTAG_byte:
- glCallLists (string_length(Field(indexes,1)),
+ glCallLists (caml_string_length(Field(indexes,1)),
GL_UNSIGNED_BYTE,
String_val(Field(indexes,1)));
break;
diff --git a/src/ml_glarray.c b/src/ml_glarray.c
index 275a262..4a77496 100644
--- a/src/ml_glarray.c
+++ b/src/ml_glarray.c
@@ -1,4 +1,6 @@
+#define CAML_NAME_SPACE
+
#ifdef _WIN32
#include <wtypes.h>
#endif
diff --git a/src/ml_glu.c b/src/ml_glu.c
index 2efcaff..8f689b4 100644
--- a/src/ml_glu.c
+++ b/src/ml_glu.c
@@ -1,5 +1,7 @@
/* $Id: ml_glu.c,v 1.28 2004-11-02 07:03:34 garrigue Exp $ */
+#define CAML_NAME_SPACE
+
#ifdef _WIN32
#include <wtypes.h>
#endif
@@ -102,14 +104,14 @@ ML_3 (gluLookAt, Triple(arg1,Double_val,Double_val,Double_val),
CAMLprim value ml_gluNewNurbsRenderer (void)
{
- value struc = alloc_final (2, ml_gluDeleteNurbsRenderer, 1, 32);
+ value struc = caml_alloc_final (2, ml_gluDeleteNurbsRenderer, 1, 32);
Store_addr(struc, gluNewNurbsRenderer());
return struc;
}
CAMLprim value ml_gluNewQuadric (void)
{
- value struc = alloc_final (2, ml_gluDeleteQuadric, 1, 32);
+ value struc = caml_alloc_final (2, ml_gluDeleteQuadric, 1, 32);
Store_addr(struc, gluNewQuadric());
return struc;
}
@@ -241,10 +243,10 @@ CAMLprim value ml_gluProject (value object)
gluProject (Double_val(Field(object,0)), Double_val(Field(object,1)),
Double_val(Field(object,2)), model, proj, viewport,
&winX, &winY, &winZ);
- win0 = copy_double(winX);
- win1 = copy_double(winY);
- win2 = copy_double(winZ);
- win = alloc_small(3, 0);
+ win0 = caml_copy_double(winX);
+ win1 = caml_copy_double(winY);
+ win2 = caml_copy_double(winZ);
+ win = caml_alloc_small(3, 0);
Field(win,0) = win0;
Field(win,1) = win1;
Field(win,2) = win2;
@@ -296,10 +298,10 @@ CAMLprim value ml_gluUnProject (value win)
Double_val(Field(win,2)), model, proj, viewport,
&objX, &objY, &objZ);
if (!ok) ml_raise_gl ("Glu.unproject : point out of window");
- obj0 = copy_double(objX);
- obj1 = copy_double(objY);
- obj2 = copy_double(objZ);
- obj = alloc_small (3, 0);
+ obj0 = caml_copy_double(objX);
+ obj1 = caml_copy_double(objY);
+ obj2 = caml_copy_double(objZ);
+ obj = caml_alloc_small (3, 0);
Field(obj,0) = obj0;
Field(obj,1) = obj1;
Field(obj,2) = obj2;
diff --git a/src/ml_glutess.c b/src/ml_glutess.c
index ac8ee25..eccb86b 100644
--- a/src/ml_glutess.c
+++ b/src/ml_glutess.c
@@ -1,6 +1,8 @@
/* $Id: ml_glutess.c,v 1.7 2008-02-25 01:52:20 garrigue Exp $ */
/* Code contributed by Jon Harrop */
+#define CAML_NAME_SPACE
+
#include <stdio.h>
#include <stdlib.h>
#ifdef _WIN32
@@ -95,24 +97,24 @@ static void push_vert(value root, double x, double y, double z)
CAMLparam1(root);
CAMLlocal4(vert, xx, yy, zz);
value cons;
- xx = copy_double(x); yy = copy_double(y); zz = copy_double(z);
- vert = alloc_tuple(3);
+ xx = caml_copy_double(x); yy = caml_copy_double(y); zz = caml_copy_double(z);
+ vert = caml_alloc_tuple(3);
Field(vert,0) = xx;
Field(vert,1) = yy;
Field(vert,2) = zz;
- cons = alloc_tuple(2);
+ cons = caml_alloc_tuple(2);
Field(cons, 0) = vert;
Field(cons, 1) = Field(root,0);
- modify(&Field(root,0), cons);
+ caml_modify(&Field(root,0), cons);
CAMLreturn0;
}
static void push_list()
{
- value cons = alloc_tuple(2);
+ value cons = caml_alloc_tuple(2);
Field(cons,0) = Val_unit;
Field(cons,1) = Field(*prim,kind);
- modify(&Field(*prim,kind), cons);
+ caml_modify(&Field(*prim,kind), cons);
}
static void CALLBACK beginCallback(GLenum type)
@@ -195,7 +197,7 @@ CAMLprim value ml_gluTesselateAndReturn(value winding, value tolerance,
CAMLparam1(contours);
CAMLlocal1(res);
- res = alloc_tuple(3);
+ res = caml_alloc_tuple(3);
Field(res,0) = Field(res,1) = Field(res,2) = Val_unit;
prim = &res;
diff --git a/src/ml_raw.c b/src/ml_raw.c
index 35d163b..012c71c 100644
--- a/src/ml_raw.c
+++ b/src/ml_raw.c
@@ -1,11 +1,14 @@
/* $Id: ml_raw.c,v 1.16 2007-04-13 02:48:43 garrigue Exp $ */
+#define CAML_NAME_SPACE
+
#include <string.h>
#include <caml/misc.h>
#include <caml/mlvalues.h>
#include <caml/memory.h>
#include <caml/alloc.h>
#include <caml/config.h>
+#include <caml/fail.h>
#include "raw_tags.h"
#include "ml_raw.h"
@@ -16,9 +19,6 @@
#define SIZE_FLOAT sizeof(float)
#define SIZE_DOUBLE sizeof(double)
-extern void invalid_argument (char *) Noreturn;
-extern void raise_out_of_memory (void) Noreturn;
-
static int raw_sizeof (value kind)
{
switch (kind) {
@@ -52,7 +52,7 @@ static void check_size (value raw, long pos, char *msg)
{
if (pos < 0 ||
(pos+1) * raw_sizeof(Kind_raw(raw)) > Int_val(Size_raw(raw)))
- invalid_argument (msg);
+ caml_invalid_argument (msg);
}
CAMLprim value ml_raw_get (value raw, value pos) /* ML */
@@ -89,8 +89,8 @@ CAMLprim value ml_raw_read (value raw, value pos, value len) /* ML */
value ret;
check_size (raw,s+l-1,"Raw.read");
- if (l<0 || s<0) invalid_argument("Raw.read");
- ret = alloc_shr (l, 0);
+ if (l<0 || s<0) caml_invalid_argument("Raw.read");
+ ret = caml_alloc_shr (l, 0);
switch (Kind_raw(raw)) {
case MLTAG_bitmap:
case MLTAG_ubyte:
@@ -161,19 +161,19 @@ CAMLprim value ml_raw_read_string (value raw, value pos, value len) /* ML */
value ret;
if (l<0 || s<0 || s+l > Int_val(Size_raw(raw)))
- invalid_argument("Raw.read_string");
- ret = alloc_string (l);
- memcpy (String_val(ret), Bp_val(Addr_raw(raw))+s, l);
+ caml_invalid_argument("Raw.read_string");
+ ret = caml_alloc_string (l);
+ memcpy (Bytes_val(ret), Bp_val(Addr_raw(raw))+s, l);
CAMLreturn(ret);
}
CAMLprim value ml_raw_write_string (value raw, value pos, value data) /* ML */
{
int s = Int_val(pos);
- int l = string_length(data);
+ int l = caml_string_length(data);
if (s<0 || s+l > Int_val(Size_raw(raw)))
- invalid_argument("Raw.write_string");
+ caml_invalid_argument("Raw.write_string");
memcpy (Bp_val(Addr_raw(raw))+s, String_val(data), l);
return Val_unit;
}
@@ -215,7 +215,7 @@ CAMLprim value ml_raw_write (value raw, value pos, value data) /* ML */
int i, l = Wosize_val(data);
check_size (raw,s+l-1,"Raw.write");
- if (s<0) invalid_argument("Raw.write");
+ if (s<0) caml_invalid_argument("Raw.write");
switch (Kind_raw(raw)) {
case MLTAG_bitmap:
@@ -273,9 +273,9 @@ CAMLprim value ml_raw_get_float (value raw, value pos) /* ML */
check_size (raw,i,"Raw.get_float");
if (Kind_raw(raw) == MLTAG_float)
- return copy_double ((double) Float_raw(raw)[i]);
+ return caml_copy_double ((double) Float_raw(raw)[i]);
else
- return copy_double (Double_raw(raw)[i]);
+ return caml_copy_double (Double_raw(raw)[i]);
}
CAMLprim value ml_raw_read_float (value raw, value pos, value len) /* ML */
@@ -285,8 +285,8 @@ CAMLprim value ml_raw_read_float (value raw, value pos, value len) /* ML */
value ret = Val_unit;
check_size (raw,s+l-1,"Raw.read_float");
- if (l<0 || s<0) invalid_argument("Raw.read_float");
- ret = alloc_shr (l*sizeof(double)/sizeof(value), Double_array_tag);
+ if (l<0 || s<0) caml_invalid_argument("Raw.read_float");
+ ret = caml_alloc_shr (l*sizeof(double)/sizeof(value), Double_array_tag);
if (Kind_raw(raw) == MLTAG_float) {
float *float_raw = Float_raw(raw)+s;
for (i = 0; i < l; i++)
@@ -317,7 +317,7 @@ CAMLprim value ml_raw_write_float (value raw, value pos, value data) /* ML */
int i, l = Wosize_val(data)*sizeof(value)/sizeof(double);
check_size (raw,s+l-1,"Raw.write_float");
- if (s<0) invalid_argument("Raw.write_float");
+ if (s<0) caml_invalid_argument("Raw.write_float");
if (Kind_raw(raw) == MLTAG_float) {
float *float_raw = Float_raw(raw)+s;
for (i = 0; i < l; i++)
@@ -428,10 +428,10 @@ CAMLprim value ml_raw_get_long (value raw, value pos) /* ML */
switch (Kind_raw(raw)) {
case MLTAG_int:
case MLTAG_uint:
- return copy_nativeint (Int_raw(raw)[i]);
+ return caml_copy_nativeint (Int_raw(raw)[i]);
case MLTAG_long:
case MLTAG_ulong:
- return copy_nativeint (Long_raw(raw)[i]);
+ return caml_copy_nativeint (Long_raw(raw)[i]);
}
return Val_unit;
}
@@ -463,10 +463,10 @@ CAMLprim value ml_raw_alloc (value kind, value len) /* ML */
int offset = 0;
if (kind == MLTAG_double && sizeof(double) > sizeof(value)) {
- data = alloc_shr ((size-1)/sizeof(value)+2, Abstract_tag);
+ data = caml_alloc_shr ((size-1)/sizeof(value)+2, Abstract_tag);
offset = (data % sizeof(double) ? sizeof(value) : 0);
- } else data = alloc_shr ((size-1)/sizeof(value)+1, Abstract_tag);
- raw = alloc_small (SIZE_RAW,0);
+ } else data = caml_alloc_shr ((size-1)/sizeof(value)+1, Abstract_tag);
+ raw = caml_alloc_small (SIZE_RAW,0);
Kind_raw(raw) = kind;
Size_raw(raw) = Val_int(size);
Base_raw(raw) = data;
@@ -483,10 +483,10 @@ CAMLprim value ml_raw_alloc_static (value kind, value len) /* ML */
int offset = 0;
if (kind == MLTAG_double && sizeof(double) > sizeof(long)) {
- data = stat_alloc (size+sizeof(long));
+ data = caml_stat_alloc (size+sizeof(long));
offset = ((long)data % sizeof(double) ? sizeof(value) : 0);
- } else data = stat_alloc (size);
- raw = alloc_small (SIZE_RAW, 0);
+ } else data = caml_stat_alloc (size);
+ raw = caml_alloc_small (SIZE_RAW, 0);
Kind_raw(raw) = kind;
Size_raw(raw) = Val_int(size);
Base_raw(raw) = (value) data;
@@ -497,8 +497,8 @@ CAMLprim value ml_raw_alloc_static (value kind, value len) /* ML */
CAMLprim value ml_raw_free_static (value raw) /* ML */
{
- if (Static_raw(raw) != Val_int(1)) invalid_argument ("Raw.free_static");
- stat_free (Void_raw(raw));
+ if (Static_raw(raw) != Val_int(1)) caml_invalid_argument ("Raw.free_static");
+ caml_stat_free (Void_raw(raw));
Base_raw(raw) = Val_unit;
Size_raw(raw) = Val_unit;
Offset_raw(raw) = Val_unit;
diff --git a/src/ml_shader.c b/src/ml_shader.c
index 1fe374f..5baaace 100644
--- a/src/ml_shader.c
+++ b/src/ml_shader.c
@@ -2,6 +2,7 @@
/* Code contributed by Florent Monnier */
#define GL_GLEXT_PROTOTYPES
+#define CAML_NAME_SPACE
#ifdef _WIN32
#include <wtypes.h>
@@ -1214,7 +1215,7 @@ CAMLprim value ml_glgetshaderinfolog(value shader)
{
LOAD_FUNC(glGetShaderInfoLog, PFNGLGETSHADERINFOLOGPROC)
value infoLog = caml_alloc_string(infologLength);
- glGetShaderInfoLog(Shader_object_val(shader), infologLength, &charsWritten, String_val(infoLog));
+ glGetShaderInfoLog(Shader_object_val(shader), infologLength, &charsWritten, Bytes_val(infoLog));
return infoLog;
} else {
return caml_copy_string("");
@@ -1238,7 +1239,7 @@ CAMLprim value ml_glgetprograminfolog(value program)
{
LOAD_FUNC(glGetProgramInfoLog, PFNGLGETPROGRAMINFOLOGPROC)
value infoLog = caml_alloc_string(infologLength);
- glGetProgramInfoLog(Shader_program_val(program), infologLength, &charsWritten, String_val(infoLog));
+ glGetProgramInfoLog(Shader_program_val(program), infologLength, &charsWritten, Bytes_val(infoLog));
return infoLog;
} else {
return caml_copy_string("");
generated by cgit v1.2.3 (git 2.25.1) at 2024-06-02 07:10:22 +0000