[m-rev.] for review: more bits and pieces for the opengl binding

[Julien Fischer]

Estimated hours taken: 0.5
Branches: main

extras/graphics/mercury_opengl/mogl.m:
	Add bindings for glRect(), glHint() and glIsEnabled().

Julien.


Index: mogl.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/graphics/mercury_opengl/mogl.m,v
retrieving revision 1.4
diff -u -r1.4 mogl.m
--- mogl.m	21 Oct 2003 08:21:14 -0000	1.4
+++ mogl.m	12 Jan 2004 04:52:44 -0000
@@ -77,6 +77,9 @@
 :- pred vertex4(float, float, float, float, io, io).
 :- mode vertex4(in, in, in, in, di, uo) is det.

+:- pred rect(float, float, float, float, io, io).
+:- mode rect(in, in, in, in, di, uo) is det.
+
 :- pred tex_coord1(float, io, io).
 :- mode tex_coord1(in, di, uo) is det.

@@ -98,6 +101,9 @@
 :- pred color4(float, float, float, float, io, io).
 :- mode color4(in, in, in, in, di, uo) is det.

+:- pred index(float, io, io).
+:- mode index(in, di, uo) is det.
+
 %------------------------------------------------------------------------------%
 %
 % Coordinate transformations.
@@ -676,6 +682,29 @@
 :- pred disable(control_flag, io, io).
 :- mode disable(in, di, uo) is det.

+:- pred is_enabled(control_flag, bool, io, io).
+:- mode is_enabled(in, out, di, uo) is det.
+
+%------------------------------------------------------------------------------%
+%
+% Hints.
+%
+
+:- type hint_target
+	--->    perspective_correction
+	;	point_smooth
+	;	line_smooth
+	;	polygon_smooth
+	;	fog.
+
+:- type hint_mode
+	--->    fastest
+	;       nicest
+	;       do_not_care.
+
+:- pred hint(hint_target, hint_mode, io, io).
+:- mode hint(in, in, di, uo) is det.
+
 %------------------------------------------------------------------------------%
 %------------------------------------------------------------------------------%

@@ -689,6 +718,8 @@
 	#include <GL/gl.h>
 ").

+:- pragma foreign_import_module("C", bool).
+
 %------------------------------------------------------------------------------%
 %
 % GL Errors.
@@ -869,6 +900,22 @@
 	IO = IO0;
 ").

+:- pragma foreign_proc("C",
+	rect(X1::in, Y1::in, X2::in, Y2::in, IO0::di, IO::uo),
+	[will_not_call_mercury, promise_pure],
+"
+	if(sizeof(MR_Float) == sizeof(GLfloat))
+	{
+		glRectf((GLfloat) X1, (GLfloat) Y1, (GLfloat) X2, (GLfloat) Y2);
+	}
+	else
+	{
+		glRectd((GLdouble) X1, (GLdouble) Y1, (GLdouble) X2,
+			(GLdouble) Y2);
+	}
+	IO = IO0;
+").
+
 %------------------------------------------------------------------------------%

 :- pragma foreign_proc("C",
@@ -983,6 +1030,21 @@
 	IO = IO0;
 ").

+:- pragma foreign_proc("C",
+	index(I::in, IO0::di, IO::uo),
+	[will_not_call_mercury, promise_pure],
+"
+	if(sizeof(MR_Float) == sizeof(GLfloat))
+	{
+		glIndexf((GLfloat) I);
+	}
+	else
+	{
+		glIndexd((GLdouble) I);
+	}
+	IO = IO0;
+").
+
 %------------------------------------------------------------------------------%
 %
 % Coordinate transformations.
@@ -2853,6 +2915,98 @@
 	[will_not_call_mercury, promise_pure],
 "
 	glDisable(control_flag_flags[I]+J);
+	IO = IO0;
+").
+
+is_enabled(Flag, IsEnabled, !IO) :-
+	( Flag = clip_plane(I) ->
+	  	is_enabled_3(control_flag_to_int(Flag), I, IsEnabled, !IO)
+	; Flag = light(I) ->
+	  	is_enabled_3(control_flag_to_int(Flag), I, IsEnabled, !IO)
+	;
+		is_enabled_2(control_flag_to_int(Flag), IsEnabled, !IO)
+	).
+
+:- pred is_enabled_2(int::in, bool::out, io::di, io::uo) is det.
+:- pragma foreign_proc("C",
+	is_enabled_2(I::in, R::out, IO0::di, IO::uo),
+	[may_call_mercury, promise_pure],
+"
+	if(glIsEnabled(control_flag_flags[I]))
+		R = ML_bool_return_yes();
+	else
+		R = ML_bool_return_no();
+	IO = IO0;
+").
+
+:- pred is_enabled_3(int::in, int::in, bool::out, io::di, io::uo) is det.
+:- pragma foreign_proc("C",
+	is_enabled_3(I::in, J::in, R::out, IO0::di, IO::uo),
+	[may_call_mercury, promise_pure],
+"
+	if(glIsEnabled(control_flag_flags[I] + J))
+		R = ML_bool_return_yes();
+	else
+		R = ML_bool_return_no();
+	IO = IO0;
+").
+%------------------------------------------------------------------------------%
+%
+% Hints.
+%
+
+:- pragma foreign_decl("C", "
+	extern const GLenum hint_target_flags[];
+").
+
+:- pragma foreign_code("C", "
+	const GLenum hint_target_flags[] = {
+		GL_PERSPECTIVE_CORRECTION_HINT,
+		GL_POINT_SMOOTH_HINT,
+		GL_LINE_SMOOTH_HINT,
+		GL_POLYGON_SMOOTH_HINT,
+		GL_FOG_HINT
+	};
+").
+
+:- pragma foreign_decl("C", "
+	extern const GLenum hint_mode_flags[];
+").
+
+:- pragma foreign_code("C", "
+	const GLenum hint_mode_flags[] = {
+		GL_FASTEST,
+		GL_NICEST,
+		GL_DONT_CARE
+	};
+").
+
+:- func hint_target_to_int(hint_target) = int.
+
+hint_target_to_int(perspective_correction) = 0.
+hint_target_to_int(point_smooth) = 1.
+hint_target_to_int(line_smooth) = 2.
+hint_target_to_int(polygon_smooth) = 3.
+hint_target_to_int(fog) = 4.
+
+:- pred hint_mode_to_int(hint_mode, int).
+:- mode hint_mode_to_int(in, out) is det.
+
+hint_mode_to_int(fastest, 0).
+hint_mode_to_int(nicest, 1).
+hint_mode_to_int(do_not_care, 2).
+
+hint(Target0, Mode0, !IO) :-
+	Target = hint_target_to_int(Target0),
+	hint_mode_to_int(Mode0, Mode),
+	set_hint(Target, Mode, !IO).
+
+:- pred set_hint(int::in, int::in, io::di, io::uo) is det.
+:- pragma foreign_proc("C",
+	set_hint(Target::in, Mode::in, IO0::di, IO::uo),
+	[will_not_call_mercury, promise_pure],
+"
+	glHint(hint_target_flags[Target], hint_mode_flags[Mode]);
 	IO = IO0;
 ").


--------------------------------------------------------------------------
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
--------------------------------------------------------------------------