[m-rev.] diff: optionally support some freeglut extensions in the GLUT binding
Julien Fischer
juliensf at csse.unimelb.edu.au
Tue Mar 27 17:01:59 AEDT 2012
There appear to be some (non-Mercury related) issues with using freeglut
on Mac OS X, I have a possible fix in mind, so I will update things like
the NEWS file and so forth after I have tried it out.
-------------
Extend the Mercury GLUT binding to make some of the freeglut extensions
available if the GLUT implementation being used is freeglut.
Using these extensions in the absence of freeglut will cause an exception to
be thrown.
extras/graphics/mercury_glut/glut.m:
Add a predicate have_freeglut/0 for testing whether freeglut
is being used.
Fix the description of glut.quit/2 - it shuts things down
gracefully rather than simply aborting.
Provide bindings to the following freeglut extensions:
* glutMainLoopEvent
* glutLeaveMainLoop
* glutGet with GLUT_FULL_SCREEN
extras/graphics/mercury_glut/glut.model.m:
Provide bindings to the following freeglut extensions:
* glutWireRhombicDodecahedron
* glutSolidRhombicDodecahedron
extras/graphics/mercury_glut/glut.window.m:
Provide bindings to the following freeglut extennsions:
* glutFullScreenToggle
* glutLeaveFullScreeen
(The latter doesn't appear to be available in the versions
of freeglut that are on the Linux machines I tested this on,
I've commented it out for the time being.)
extras/graphics/mercury_glut/*.m:
Use don't-care variables for handling the I/O state in
foreign_procs. This avoids warnings from MSVC.
extras/graphics/mercury_glut/README:
Mention that some of the freeglut extensions are now optionally
supported.
Julien.
Index: README
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/extras/graphics/mercury_glut/README,v
retrieving revision 1.2
diff -u -r1.2 README
--- README 29 Jun 2005 05:21:42 -0000 1.2
+++ README 27 Mar 2012 05:47:30 -0000
@@ -5,6 +5,9 @@
writing OpenGL applications. It provides most of the system
dependent bits, such as window management, that the OpenGL API doesn't.
+If freeglut is being used to provide GLUT then `mercury_glut' also
+provides a interface to a number of freeglut specific extensions.
+
See <http://www.opengl.org/resources/libraries/glut.html> for further
details.
Index: glut.color_map.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/extras/graphics/mercury_glut/glut.color_map.m,v
retrieving revision 1.5
diff -u -r1.5 glut.color_map.m
--- glut.color_map.m 31 Aug 2007 08:43:05 -0000 1.5
+++ glut.color_map.m 27 Mar 2012 05:46:37 -0000
@@ -63,19 +63,17 @@
%-----------------------------------------------------------------------------%
:- pragma foreign_proc("C",
- color_map.set_color(I::in, R::in, G::in, B::in, IO0::di, IO::uo),
+ color_map.set_color(I::in, R::in, G::in, B::in, _IO0::di, _IO::uo),
[will_not_call_mercury, tabled_for_io, promise_pure],
"
glutSetColor((int) I, (GLfloat) R, (GLfloat) G, (GLfloat) B);
- IO = IO0;
").
:- pragma foreign_proc("C",
- get_color(I::in, C::in, V::out, IO0::di, IO::uo),
+ get_color(I::in, C::in, V::out, _IO0::di, _IO::uo),
[will_not_call_mercury, tabled_for_io, promise_pure],
"
V = (MR_Float) glutGetColor((int) I, (int) C);
- IO = IO0;
").
:- pragma foreign_enum("C", component/0,
@@ -88,11 +86,10 @@
%-----------------------------------------------------------------------------%
:- pragma foreign_proc("C",
- color_map.copy(WinId::in, IO0::di, IO::uo),
+ color_map.copy(WinId::in, _IO0::di, _IO::uo),
[will_not_call_mercury, tabled_for_io, promise_pure],
"
glutCopyColormap((int) WinId);
- IO = IO0;
").
%-----------------------------------------------------------------------------%
Index: glut.font.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/extras/graphics/mercury_glut/glut.font.m,v
retrieving revision 1.5
diff -u -r1.5 glut.font.m
--- glut.font.m 31 Aug 2007 08:43:05 -0000 1.5
+++ glut.font.m 27 Mar 2012 05:48:28 -0000
@@ -204,11 +204,10 @@
:- pred stroke_character_2(font_ptr::in, char::in, io::di, io::uo) is det.
:- pragma foreign_proc("C",
- stroke_character_2(StrokeFntPtr::in, C::in, IO0::di, IO::uo),
+ stroke_character_2(StrokeFntPtr::in, C::in, _IO0::di, _IO::uo),
[will_not_call_mercury, tabled_for_io, promise_pure],
"
glutStrokeCharacter(StrokeFntPtr, (int) C);
- IO = IO0;
").
font.stroke_width(Font, Char) = Width :-
Index: glut.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/extras/graphics/mercury_glut/glut.m,v
retrieving revision 1.9
diff -u -r1.9 glut.m
--- glut.m 31 Aug 2007 08:43:05 -0000 1.9
+++ glut.m 27 Mar 2012 05:41:45 -0000
@@ -11,6 +11,13 @@
%
% This is partial Mercury binding to the GL Utility Library (GLUT).
%
+% If used with freeglut then some of the extensions available in freeglut will
+% also be available. Calling the freeglut extensions when freeglut is *not*
+% available will result in a software_error1/ exception being thrown.
+%
+% You can use the predicate glut.have_freeglut/0 to test for the presence
+% of freeglut.
+%
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -37,9 +44,13 @@
%-----------------------------------------------------------------------------%
%
-% Initialisation
+% Initialisation.
%
+ % Succeeds if this binding was compiled against freeglut.
+ %
+:- pred have_freeglut is semidet.
+
:- type display_mode
---> rgba
; index
@@ -75,19 +86,36 @@
%
:- pred glut.init_window_size(int::in, int::in, io::di, io::uo) is det.
- % Enter the GLUT event processing loop.
- % You need to use glut.quit/2 to get out of this.
+%-----------------------------------------------------------------------------%
+%
+% Event processing.
+%
+
+ % Enter the GLUT event processing loop.
%
:- pred glut.main_loop(io::di, io::uo) is det.
- % Notify GLUT that you want quit the event processing loop
- % and abort execution.
+ % Notify GLUT that you want quit the event processing loop.
+ % This predicate will cause the Mercury runtime to terminate and then cause
+ % the process to exit.
%
:- pred glut.quit(io::di, io::uo) is det.
+
+% Freeglut extensions.
+% ====================
+
+ % Perform a single iteration of the GLUT event processing loop.
+ %
+:- pred glut.main_loop_event(io::di, io::uo) is det.
+
+ % Halt the GLUT event processing loop.
+ %
+:- pred glut.leave_main_loop(io::di, io::uo) is det.
+
%-----------------------------------------------------------------------------%
%
-% State retrieval
+% State retrieval.
%
% Return the number of milliseconds since GLUT was initialised (or
@@ -140,6 +168,15 @@
%
:- pred glut.has_device(device::in, bool::out, io::di, io::uo) is det.
+
+% Freeglut extensions.
+% ====================
+
+ % Returns `yes' if we are currently in fullscreen mode and `no'
+ % otherwise.
+ %
+:- pred glut.full_screen(bool::out, io::di, io::uo) is det.
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -154,18 +191,34 @@
#include <GLUT/glut.h>
#else
#include <GL/glut.h>
+ #endif
+ #if defined(FREEGLUT)
+ #include <GL/freeglut_ext.h>
#endif
").
:- initialise glut.init/2.
%-----------------------------------------------------------------------------%
+
+:- pragma foreign_proc("C",
+ have_freeglut,
+ [will_not_call_mercury, promise_pure],
+"
+#if defined(FREEGLUT)
+ SUCCESS_INDICATOR = MR_TRUE;
+#else
+ SUCCESS_INDICATOR = MR_FALSE;
+#endif
+").
+
+%-----------------------------------------------------------------------------%
:- pred glut.init(io::di, io::uo) is det.
:- pragma foreign_proc("C",
- glut.init(IO0::di, IO::uo),
+ glut.init(_IO0::di, _IO::uo),
[will_not_call_mercury, tabled_for_io, promise_pure],
"
int argc;
@@ -173,7 +226,6 @@
argc = mercury_argc + 1;
glutInit(&argc, (char **) (mercury_argv - 1));
- IO = IO0;
").
%-----------------------------------------------------------------------------%
@@ -184,11 +236,10 @@
:- pred glut.init_display_mode_2(int::in, io::di, io::uo) is det.
:- pragma foreign_proc("C",
- glut.init_display_mode_2(Flags::in, IO0::di, IO::uo),
+ glut.init_display_mode_2(Flags::in, _IO0::di, _IO::uo),
[will_not_call_mercury, promise_pure],
"
glutInitDisplayMode((unsigned) Flags);
- IO = IO0;
").
:- func display_mode_to_int(display_mode) = int.
@@ -289,39 +340,35 @@
%-----------------------------------------------------------------------------%
:- pragma foreign_proc("C",
- glut.init_display_string(CtrlStr::in, IO0::di, IO::uo),
+ glut.init_display_string(CtrlStr::in, _IO0::di, _IO::uo),
[will_not_call_mercury, tabled_for_io, promise_pure],
"
glutInitDisplayString((char *) CtrlStr);
- IO = IO0;
").
%-----------------------------------------------------------------------------%
:- pragma foreign_proc("C",
- glut.init_window_position(X::in, Y::in, IO0::di, IO::uo),
+ glut.init_window_position(X::in, Y::in, _IO0::di, _IO::uo),
[will_not_call_mercury, tabled_for_io, promise_pure],
"
glutInitWindowPosition(X, Y);
- IO = IO0;
").
:- pragma foreign_proc("C",
- glut.init_window_size(W::in, S::in, IO0::di, IO::uo),
+ glut.init_window_size(W::in, S::in, _IO0::di, _IO::uo),
[will_not_call_mercury, tabled_for_io, promise_pure],
"
glutInitWindowSize(W, S);
- IO = IO0;
").
%-----------------------------------------------------------------------------%
:- pragma foreign_proc("C",
- glut.main_loop(IO0::di, IO::uo),
+ glut.main_loop(_IO0::di, _IO::uo),
[may_call_mercury, tabled_for_io, promise_pure],
"
glutMainLoop();
- IO = IO0;
").
%-----------------------------------------------------------------------------%
@@ -335,8 +382,43 @@
%-----------------------------------------------------------------------------%
-:- pragma foreign_enum("C", glut.state/0,
-[
+glut.main_loop_event(!IO) :-
+ ( if have_freeglut then
+ main_loop_event_2(!IO)
+ else
+ error("glut.main_loop_event/2: freeglut is required")
+ ).
+
+:- pred main_loop_event_2(io::di, io::uo) is det.
+:- pragma foreign_proc("C",
+ main_loop_event_2(_IO0::di, _IO::uo),
+ [promise_pure, may_call_mercury],
+"
+#if defined(FREEGLUT)
+ glutMainLoopEvent();
+#endif
+").
+
+glut.leave_main_loop(!IO) :-
+ ( if have_freeglut then
+ leave_main_loop_2(!IO)
+ else
+ error("glut.leave_main_loop/2: freeglut is required")
+ ).
+
+:- pred leave_main_loop_2(io::di, io::uo) is det.
+:- pragma foreign_proc("C",
+ leave_main_loop_2(_IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+#if defined(FREEGLUT)
+ glutLeaveMainLoop();
+#endif
+").
+
+%-----------------------------------------------------------------------------%
+
+:- pragma foreign_enum("C", glut.state/0, [
screen_width - "GLUT_SCREEN_WIDTH",
screen_height - "GLUT_SCREEN_HEIGHT",
screen_width_mm - "GLUT_SCREEN_WIDTH_MM",
@@ -346,17 +428,15 @@
]).
:- pragma foreign_proc("C",
- glut.get(State::in, Value::out, IO0::di, IO::uo),
+ glut.get(State::in, Value::out, _IO0::di, _IO::uo),
[will_not_call_mercury, tabled_for_io, promise_pure],
"
Value = (MR_Integer) glutGet((GLenum) State);
- IO = IO0;
").
%-----------------------------------------------------------------------------%
-:- pragma foreign_enum("C", glut.device/0,
-[
+:- pragma foreign_enum("C", glut.device/0, [
keyboard - "GLUT_HAS_KEYBOARD",
mouse - "GLUT_HAS_MOUSE",
spaceball - "GLUT_HAS_SPACEBALL",
@@ -366,7 +446,7 @@
]).
:- pragma foreign_proc("C",
- glut.has_device(Device::in, Res::out, IO0::di, IO::uo),
+ glut.has_device(Device::in, Res::out, _IO0::di, _IO::uo),
[will_not_call_mercury, promise_pure],
"
if(glutDeviceGet((GLenum) Device)) {
@@ -374,21 +454,19 @@
} else {
Res = MR_NO;
}
- IO = IO0;
").
%-----------------------------------------------------------------------------%
:- pragma foreign_proc("C",
- glut.elapsed_time(Time::out, IO0::di, IO::uo),
+ glut.elapsed_time(Time::out, _IO0::di, _IO::uo),
[will_not_call_mercury, tabled_for_io, promise_pure],
"
Time = (MR_Integer) glutGet(GLUT_ELAPSED_TIME);
- IO = IO0;
").
:- pragma foreign_proc("C",
- glut.display_mode_possible(IsPossible::out, IO0::di, IO::uo),
+ glut.display_mode_possible(IsPossible::out, _IO0::di, _IO::uo),
[will_not_call_mercury, tabled_for_io, promise_pure],
"
if(glutGet(GLUT_DISPLAY_MODE_POSSIBLE)) {
@@ -396,7 +474,32 @@
} else {
IsPossible = MR_NO;
}
- IO = IO0;
+").
+
+%-----------------------------------------------------------------------------%
+
+glut.full_screen(FullScreen, !IO) :-
+ ( if have_freeglut then
+ full_screen_2(FullScreen, !IO)
+ else
+ error("glut.full_screen/3: freeglut required")
+ ).
+
+:- pred full_screen_2(bool::out, io::di, io::uo) is det.
+:- pragma foreign_proc("C",
+ full_screen_2(FullScreen::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, tabled_for_io, promise_pure],
+"
+#if defined(FREEGLUT)
+ if(glutGet(GLUT_FULL_SCREEN)) {
+ FullScreen = MR_YES;
+ } else {
+ FullScreen = MR_NO;
+ }
+#else
+ FullScreen = MR_NO;
+#endif
+
").
%-----------------------------------------------------------------------------%
Index: glut.model.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/extras/graphics/mercury_glut/glut.model.m,v
retrieving revision 1.4
diff -u -r1.4 glut.model.m
--- glut.model.m 20 Apr 2006 03:14:57 -0000 1.4
+++ glut.model.m 27 Mar 2012 05:43:57 -0000
@@ -79,6 +79,13 @@
:- pred model.wire_dodecahedron(io::di, io::uo) is det.
:- pred model.solid_dodecahedron(io::di, io::uo) is det.
+
+% Freeglut extensions.
+% ====================
+
+:- pred model.wire_rhombic_dodecahedron(io::di, io::uo) is det.
+:- pred model.solid_rhombic_dodecahedron(io::di, io::uo) is det.
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -90,164 +97,185 @@
#include <GLUT/glut.h>
#else
#include <GL/glut.h>
+ #endif
+ #if defined(FREEGLUT)
+ #include <GL/freeglut_ext.h>
#endif
").
%-----------------------------------------------------------------------------%
:- pragma foreign_proc("C",
- glut.model.wire_cube(Size::in, IO0::di, IO::uo),
+ glut.model.wire_cube(Size::in, _IO0::di, _IO::uo),
[will_not_call_mercury, tabled_for_io, promise_pure],
"
glutWireCube((GLdouble) Size);
- IO = IO0;
").
:- pragma foreign_proc("C",
- glut.model.solid_cube(Size::in, IO0::di, IO::uo),
+ glut.model.solid_cube(Size::in, _IO0::di, _IO::uo),
[will_not_call_mercury, tabled_for_io, promise_pure],
"
glutSolidCube((GLdouble) Size);
- IO = IO0;
").
:- pragma foreign_proc("C",
- glut.model.wire_sphere(Radius::in, Slices::in, Stacks::in, IO0::di,
- IO::uo),
+ glut.model.wire_sphere(Radius::in, Slices::in, Stacks::in, _IO0::di,
+ _IO::uo),
[will_not_call_mercury, tabled_for_io, promise_pure],
"
glutWireSphere((GLdouble) Radius, (GLint) Slices, (GLint) Stacks);
- IO = IO0;
").
:- pragma foreign_proc("C",
- glut.model.solid_sphere(Radius::in, Slices::in, Stacks::in, IO0::di,
- IO::uo),
+ glut.model.solid_sphere(Radius::in, Slices::in, Stacks::in, _IO0::di,
+ _IO::uo),
[will_not_call_mercury, tabled_for_io, promise_pure],
"
glutSolidSphere((GLdouble) Radius, (GLint) Slices, (GLint) Stacks);
- IO = IO0;
").
:- pragma foreign_proc("C",
glut.model.wire_torus(InRad::in, OutRad::in, Sides::in, Rings::in,
- IO0::di, IO::uo),
+ _IO0::di, _IO::uo),
[will_not_call_mercury, tabled_for_io, promise_pure],
"
glutWireTorus((GLdouble) InRad, (GLdouble) OutRad, (GLint) Sides,
(GLint) Rings);
- IO = IO0;
").
:- pragma foreign_proc("C",
glut.model.solid_torus(InRad::in, OutRad::in, Sides::in, Rings::in,
- IO0::di, IO::uo),
+ _IO0::di, _IO::uo),
[will_not_call_mercury, tabled_for_io, promise_pure],
"
glutSolidTorus((GLdouble) InRad, (GLdouble) OutRad, (GLint) Sides,
(GLint) Rings);
- IO = IO0;
").
:- pragma foreign_proc("C",
- glut.model.wire_icosahedron(IO0::di, IO::uo),
+ glut.model.wire_icosahedron(_IO0::di, _IO::uo),
[will_not_call_mercury, tabled_for_io, promise_pure],
"
glutWireIcosahedron();
- IO = IO0;
").
:- pragma foreign_proc("C",
- glut.model.solid_icosahedron(IO0::di, IO::uo),
+ glut.model.solid_icosahedron(_IO0::di, _IO::uo),
[will_not_call_mercury, tabled_for_io, promise_pure],
"
glutSolidIcosahedron();
- IO = IO0;
").
:- pragma foreign_proc("C",
- glut.model.wire_octahedron(IO0::di, IO::uo),
+ glut.model.wire_octahedron(_IO0::di, _IO::uo),
[will_not_call_mercury, tabled_for_io, promise_pure],
"
glutWireOctahedron();
- IO = IO0;
").
:- pragma foreign_proc("C",
- glut.model.solid_octahedron(IO0::di, IO::uo),
+ glut.model.solid_octahedron(_IO0::di, _IO::uo),
[will_not_call_mercury, tabled_for_io, promise_pure],
"
glutSolidOctahedron();
- IO = IO0;
").
:- pragma foreign_proc("C",
- glut.model.wire_tetrahedron(IO0::di, IO::uo),
+ glut.model.wire_tetrahedron(_IO0::di, _IO::uo),
[will_not_call_mercury, tabled_for_io, promise_pure],
"
glutWireTetrahedron();
- IO = IO0;
").
:- pragma foreign_proc("C",
- glut.model.solid_tetrahedron(IO0::di, IO::uo),
+ glut.model.solid_tetrahedron(_IO0::di, _IO::uo),
[will_not_call_mercury, tabled_for_io, promise_pure],
"
glutSolidTetrahedron();
- IO = IO0;
").
:- pragma foreign_proc("C",
- glut.model.wire_dodecahedron(IO0::di, IO::uo),
+ glut.model.wire_dodecahedron(_IO0::di, _IO::uo),
[will_not_call_mercury, tabled_for_io, promise_pure],
"
glutWireDodecahedron();
- IO = IO0;
").
:- pragma foreign_proc("C",
- glut.model.solid_dodecahedron(IO0::di, IO::uo),
+ glut.model.solid_dodecahedron(_IO0::di, _IO::uo),
[will_not_call_mercury, tabled_for_io, promise_pure],
"
glutSolidDodecahedron();
- IO = IO0;
").
:- pragma foreign_proc("C",
glut.model.wire_cone(Base::in, Height::in, Slices::in, Stacks::in,
- IO0::di, IO::uo),
+ _IO0::di, _IO::uo),
[will_not_call_mercury, tabled_for_io, promise_pure],
"
glutWireCone((GLdouble) Base, (GLdouble) Height, (GLint) Slices,
(GLint) Stacks);
- IO = IO0;
").
:- pragma foreign_proc("C",
glut.model.solid_cone(Base::in, Height::in, Slices::in, Stacks::in,
- IO0::di, IO::uo),
+ _IO0::di, _IO::uo),
[will_not_call_mercury, tabled_for_io, promise_pure],
"
glutSolidCone((GLdouble) Base, (GLdouble) Height, (GLint) Slices,
(GLint) Stacks);
- IO = IO0;
").
:- pragma foreign_proc("C",
- glut.model.wire_teapot(Size::in, IO0::di, IO::uo),
+ glut.model.wire_teapot(Size::in, _IO0::di, _IO::uo),
[will_not_call_mercury, tabled_for_io, promise_pure],
"
glutWireTeapot((GLdouble) Size);
- IO = IO0;
").
:- pragma foreign_proc("C",
- glut.model.solid_teapot(Size::in, IO0::di, IO::uo),
+ glut.model.solid_teapot(Size::in, _IO0::di, _IO::uo),
[will_not_call_mercury, tabled_for_io, promise_pure],
"
glutSolidTeapot((GLdouble) Size);
- IO = IO0;
+").
+
+%-----------------------------------------------------------------------------%
+
+model.wire_rhombic_dodecahedron(!IO) :-
+ ( if have_freeglut then
+ wire_rhombic_dodecahedron_2(!IO)
+ else
+ error("glut.model.wire_rhombic_dodecahedron/2: freeglut required")
+ ).
+
+:- pred wire_rhombic_dodecahedron_2(io::di, io::uo) is det.
+:- pragma foreign_proc("C",
+ wire_rhombic_dodecahedron_2(_IO0::di, _IO::uo),
+ [will_not_call_mercury, tabled_for_io, promise_pure],
+"
+#if defined(FREEGLUT)
+ glutWireRhombicDodecahedron();
+#endif
+").
+
+model.solid_rhombic_dodecahedron(!IO) :-
+ ( if have_freeglut then
+ solid_rhombic_dodecahedron_2(!IO)
+ else
+ error("glut.model.solid_rhombic_dodecahedron/2: freeglut required")
+ ).
+
+:- pred solid_rhombic_dodecahedron_2(io::di, io::uo) is det.
+:- pragma foreign_proc("C",
+ solid_rhombic_dodecahedron_2(_IO0::di, _IO::uo),
+ [will_not_call_mercury, tabled_for_io, promise_pure],
+"
+#if defined(FREEGLUT)
+ glutSolidRhombicDodecahedron();
+#endif
").
%-----------------------------------------------------------------------------%
Index: glut.window.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/extras/graphics/mercury_glut/glut.window.m,v
retrieving revision 1.6
diff -u -r1.6 glut.window.m
--- glut.window.m 31 Aug 2007 08:43:05 -0000 1.6
+++ glut.window.m 27 Mar 2012 05:45:22 -0000
@@ -180,9 +180,24 @@
%
:- pred window.has_overlay(bool::out, io::di, io::uo) is det.
+
+% Freeglut extensions.
+% ====================
+
+ % Restore the window to the same size and position as it was
+ % before entering fullscreen mode.
+ % XXX Commented out because older versions of freeglut don't provide it.
+ % If yours does, then uncomment it.
+ %
+% :- pred window.leave_full_screen(io::di, io::uo) is det.
+
+ % Toggle between fullscreen and normal mode.
+ %
+:- pred window.full_screen_toggle(io::di, io::uo) is det.
+
%------------------------------------------------------------------------------%
%
-% Window state
+% Window state.
%
:- type window.state
@@ -268,6 +283,10 @@
#else
#include <GL/glut.h>
#endif
+
+ #if defined(FREEGLUT)
+ #include <GL/freeglut_ext.h>
+ #endif
").
:- type window == int.
@@ -715,17 +734,16 @@
]).
:- pragma foreign_proc("C",
- window.get(State::in, Value::out, IO0::di, IO::uo),
+ window.get(State::in, Value::out, _IO0::di, _IO::uo),
[will_not_call_mercury, tabled_for_io, promise_pure],
"
Value = (MR_Integer) glutGet((GLenum) State);
- IO = IO0;
").
%-----------------------------------------------------------------------------%
:- pragma foreign_proc("C",
- window.has_overlay(Result::out, IO0::di, IO::uo),
+ window.has_overlay(Result::out, _IO0::di, _IO::uo),
[will_not_call_mercury, tabled_for_io, promise_pure],
"
if (glutLayerGet(GLUT_HAS_OVERLAY)) {
@@ -733,7 +751,42 @@
} else {
Result = MR_NO;
}
- IO = IO0;
+").
+
+%-----------------------------------------------------------------------------%
+
+%window.leave_full_screen(!IO) :-
+% ( if have_freeglut then
+% leave_full_screen_2(!IO)
+% else
+% error("glut.window.leave_full_screen/2: freeglut required")
+% ).
+
+%:- pred leave_full_screen_2(io::di, io::uo) is det.
+%:- pragma foreign_proc("C",
+% leave_full_screen_2(_IO0::di, _IO::uo),
+% [promise_pure, will_not_call_mercury],
+%"
+%#if defined(FREEGLUT)
+% glutLeaveFullScreen();
+%#endif
+%").
+
+window.full_screen_toggle(!IO) :-
+ ( if have_freeglut then
+ full_screen_toggle_2(!IO)
+ else
+ error("glut.window.full_screen_toggle/2: freeglut required")
+ ).
+
+:- pred full_screen_toggle_2(io::di, io::uo) is det.
+:- pragma foreign_proc("C",
+ full_screen_toggle_2(_IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+#if defined(FREEGLUT)
+ glutFullScreenToggle();
+#endif
").
%-----------------------------------------------------------------------------%
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list