[m-rev.] for review: add binding to glGetString() to opengl interface.

[Julien Fischer]

For review by anyone.

Estimated hours taken: 1.5
Branches main.

extras/graphics/mercury_opengl/mogl.m:
	Provide a binding for glGetString().

	Fix the foreign proc attributes on
	mogl.is_list/4.  It doesn't make calls
	back to Mercury.

	Fix some typos in some comments.

extras/graphics/samples/gears/gears.m:
	Use mogl.get_string/4 to print out various
	details of the GL implementation at the
	beginning of this demo.

Julien.

Workspace:/home/earth/juliensf/ws54
Index: mercury_opengl/mogl.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/graphics/mercury_opengl/mogl.m,v
retrieving revision 1.13
diff -u -r1.13 mogl.m
--- mercury_opengl/mogl.m	1 Dec 2004 01:45:30 -0000	1.13
+++ mercury_opengl/mogl.m	5 Jan 2005 05:44:27 -0000
@@ -14,7 +14,7 @@
 %
 % TODO:
 % 	- finish texture mapping stuff
-% 	- finsh pixel rectangle stuff
+% 	- finish pixel rectangle stuff
 % 	- vertex arrays
 % 	- evaluators
 % 	- various state queries
@@ -31,7 +31,7 @@

 :- interface.

-:- import_module io, int, float, list, bool.
+:- import_module io, int, float, list, bool, std_util.

 %------------------------------------------------------------------------------%
 %
@@ -649,7 +649,7 @@
 % Evaluators.
 %

-% Evalutators not implemented
+% Evaluators not implemented

 %------------------------------------------------------------------------------%
 %
@@ -791,7 +791,8 @@
 :- pred get_boolean(single_boolean_state::in, bool::out, io::di, io::uo)
 	is det.

-:- pred get_boolean(quad_boolean_state::in, bool::out, bool::out, bool::out, bool::out,
+:- pred get_boolean(quad_boolean_state::in,
+	bool::out, bool::out, bool::out, bool::out,
 	io::di, io::uo) is det.

 :- type single_integer_state
@@ -919,6 +920,19 @@
 :- pred get_float(quad_float_state::in, float::out, float::out, float::out,
 	float::out, io::di, io::uo) is det.

+:- type string_name
+	--->	vendor
+	;	renderer
+	;	version
+	;	extensions.
+
+	% get_string(StrName, MaybeResult, !IO).
+	% MaybeResult is yes(Result) where Result is a string containing
+	% the requested information.  If the requested information is
+	% not available then MaybeResult is no.
+	%
+:- pred get_string(string_name::in, maybe(string)::out, io::di, io::uo) is det.
+
 %------------------------------------------------------------------------------%
 %
 % Server attribute stack.
@@ -3508,10 +3522,9 @@
 	IO = IO0;
 ").

-	% XXX Add `terminates' attribute.
 :- pragma foreign_proc("C",
 	is_list(L::in, R::out, IO0::di, IO::uo),
-	[may_call_mercury, promise_pure],
+	[will_not_call_mercury, promise_pure],
 "
 	if (glIsList((GLuint) L)) {
 		R = MR_YES;
@@ -4250,6 +4263,58 @@
 	V3 = (MR_Float) values[3];
 	IO = IO0;
 ").
+
+%------------------------------------------------------------------------------%
+
+:- pragma foreign_decl("C", "
+	extern const GLenum string_name_flags[];
+").
+
+:- pragma foreign_code("C", "
+	const GLenum string_name_flags[] = {
+		GL_VENDOR,
+		GL_RENDERER,
+		GL_VERSION,
+		GL_EXTENSIONS
+	};
+").
+:- func string_name_to_int(string_name) = int.
+
+string_name_to_int(vendor)     = 0.
+string_name_to_int(renderer)   = 1.
+string_name_to_int(version)    = 2.
+string_name_to_int(extensions) = 3.
+
+get_string(StringName, Result, !IO) :-
+	get_string_2(string_name_to_int(StringName), Result, !IO).
+
+:- pred get_string_2(int::in, maybe(string)::out, io::di, io::uo) is det.
+:- pragma foreign_proc("C",
+	get_string_2(StrFlag::in, Result::out, IO0::di, IO::uo),
+	[may_call_mercury, promise_pure, terminates],
+"
+	const GLubyte *c_str;
+	MR_String mer_str;
+
+	c_str = glGetString(string_name_flags[StrFlag]);
+
+	if (c_str == NULL) {
+		Result = MOGL_get_string_no();
+	} else {
+		MR_make_aligned_string_copy(mer_str, c_str);
+		Result = MOGL_get_string_yes(mer_str);
+	}
+
+	IO = IO0;
+").
+
+:- func get_string_no = maybe(string).
+:- pragma export(get_string_no = out, "MOGL_get_string_no").
+get_string_no = no.
+
+:- func get_string_yes(string) = maybe(string).
+:- pragma export(get_string_yes(in) = out, "MOGL_get_string_yes").
+get_string_yes(Str) = yes(Str).

 %------------------------------------------------------------------------------%
 %
Index: samples/gears/gears.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/graphics/samples/gears/gears.m,v
retrieving revision 1.1
diff -u -r1.1 gears.m
--- samples/gears/gears.m	14 Jun 2004 11:34:06 -0000	1.1
+++ samples/gears/gears.m	5 Jan 2005 05:38:30 -0000
@@ -29,7 +29,7 @@
 :- import_module glut, glut.window, glut.callback.
 :- import_module globals.

-:- import_module char, float, int, list, math, string.
+:- import_module std_util, char, float, int, list, math, string.

 %-----------------------------------------------------------------------------%

@@ -57,7 +57,26 @@
 	glut.init(!IO),
 	glut.init_display_mode([rgba, depth, double], !IO),
 	glut.window.create("Gears", !IO),
+
+	mogl.get_string(version,    VersionResult, !IO),
+	mogl.get_string(vendor,     VendorResult, !IO),
+	mogl.get_string(renderer,   RendererResult, !IO),
+	mogl.get_string(extensions, ExtensionsResult, !IO),
+
+	io.write_string("GL Version: ", !IO),
+	write_maybe(VersionResult, !IO),
+
+	io.write_string("GL Vendor: ", !IO),
+	write_maybe(VendorResult, !IO),

+	io.write_string("Renderer: ", !IO),
+	write_maybe(RendererResult, !IO),
+
+	% XXX We could format the extensions list a bit
+	% better than this.
+	io.write_string("Available Extensions: ", !IO),
+	write_maybe(ExtensionsResult, !IO),
+
 	gears.init(Limit, !IO),

 	glut.callback.display_func(gears.draw, !IO),
@@ -66,6 +85,11 @@
 	glut.callback.special_func(gears.special, !IO),
 	glut.callback.visibility_func(gears.visible, !IO),
 	glut.main_loop(!IO).
+
+:- pred write_maybe(maybe(string)::in, io::di, io::uo) is det.
+
+write_maybe(no, !IO) :- io.write_string("unknown.\n", !IO).
+write_maybe(yes(Str), !IO) :- io.write_string(Str ++ ".\n", !IO).

 :- pred gears.gear(float::in, float::in, float::in, int::in, float::in,
 	io::di, io::uo) is det.

--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------