No subject
Julien Fischer
juliensf at students.cs.mu.OZ.AU
Mon Oct 13 14:26:04 AEST 2003
Estimated hours taken: 3
Branches: main
Add a little more functionality to the OpenGL binding. In particular,
add bindings for vertex fragment operations and (some) support for
selection. Make some trivial changes to the binding for mogl.get_error/3.
extras/graphics/mercury_opengl/mogl.m:
Add bindings for vertex fragment operations and selection.
s/Integer/int/ in binding of glError().
extras/graphics/mercury_opengl/mglu.m:
Add a binding for gluOrtho2D().
Index: mglu.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/graphics/mercury_opengl/mglu.m,v
retrieving revision 1.3
diff -u -r1.3 mglu.m
--- mglu.m 10 Oct 2003 06:00:24 -0000 1.3
+++ mglu.m 13 Oct 2003 04:15:19 -0000
@@ -29,6 +29,9 @@
:- pred perspective(float, float, float, float, io, io).
:- mode perspective(in, in, in, in, di, uo) is det.
+:- pred ortho_2d(float, float, float, float, io, io).
+:- mode ortho_2d(in, in, in, in, di, uo) is det.
+
%-----------------------------------------------------------------------------%
%
% Quadric functions
@@ -117,6 +120,16 @@
"
gluPerspective((GLdouble) Fovy, (GLdouble) Asp,
(GLdouble) N, (GLdouble) F);
+ IO = IO0;
+").
+
+
+:- pragma foreign_proc("C",
+ ortho_2d(Left::in, Right::in, Bottom::in, Top::in, IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure],
+"
+ gluOrtho2D((GLdouble) Left, (GLdouble) Right, (GLdouble) Bottom,
+ (GLdouble) Top);
IO = IO0;
").
Index: mogl.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/graphics/mercury_opengl/mogl.m,v
retrieving revision 1.3
diff -u -r1.3 mogl.m
--- mogl.m 10 Oct 2003 06:00:24 -0000 1.3
+++ mogl.m 13 Oct 2003 04:16:13 -0000
@@ -431,8 +431,7 @@
% Per-fragment operations.
%
-/*
-:- pred scissor(int, int, int, int, io__state, io__state).
+:- pred scissor(int, int, int, int, io, io).
:- mode scissor(in, in, in, in, di, uo) is det.
:- type test_func
@@ -443,13 +442,12 @@
; equal
; gequal
; greater
- ; notequal
- .
+ ; not_equal.
-:- pred alpha_func(test_func, float, io__state, io__state).
+:- pred alpha_func(test_func, float, io, io).
:- mode alpha_func(in, in, di, uo) is det.
-:- pred stencil_func(test_func, float, int, io__state, io__state).
+:- pred stencil_func(test_func, float, int, io, io).
:- mode stencil_func(in, in, in, di, uo) is det.
:- type stencil_op
@@ -458,13 +456,12 @@
; replace
; incr
; decr
- ; invert
- .
+ ; invert.
-:- pred stencil_op(stencil_op, stencil_op, stencil_op, io__state, io__state).
+:- pred stencil_op(stencil_op, stencil_op, stencil_op, io, io).
:- mode stencil_op(in, in, in, di, uo) is det.
-:- pred depth_func(test_func, io__state, io__state).
+:- pred depth_func(test_func, io, io).
:- mode depth_func(in, di, uo) is det.
:- type blend_src
@@ -476,8 +473,7 @@
; one_minus_src_alpha
; dst_alpha
; one_minus_dst_alpha
- ; src_alpha_saturate
- .
+ ; src_alpha_saturate.
:- type blend_dst
---> zero
@@ -487,19 +483,18 @@
; src_alpha
; one_minus_src_alpha
; dst_alpha
- ; one_minus_dst_alpha
- .
+ ; one_minus_dst_alpha.
-:- pred blend_func(blend_src, blend_dst, io__state, io__state).
+:- pred blend_func(blend_src, blend_dst, io, io).
:- mode blend_func(in, in, di, uo) is det.
-:- type logical_operation
+:- type logical_op
---> clear
; (and)
; and_reverse
; copy
; and_inverted
- ; noop
+ ; no_op
; xor
; (or)
; nor
@@ -509,9 +504,10 @@
; copy_inverted
; or_inverted
; nand
- ; set
- .
-*/
+ ; set.
+
+:- pred logical_op(logical_op, io, io).
+:- mode logical_op(in, di, uo) is det.
%------------------------------------------------------------------------------%
%
@@ -592,31 +588,26 @@
% Selection.
%
-/*
-
-:- pred init_names(io__state, io__state).
+:- pred init_names(io, io).
:- mode init_names(di, uo) is det.
-:- pred pop_name(io__state, io__state).
+:- pred pop_name(io, io).
:- mode pop_name(di, uo) is det.
-:- pred push_name(int, io__state, io__state).
+:- pred push_name(int, io, io).
:- mode push_name(in, di, uo) is det.
-:- pred load_name(int, io__state, io__state).
+:- pred load_name(int, io, io).
:- mode load_name(in, di, uo) is det.
:- type render_mode
---> render
; select
- ; feedback
- .
+ ; feedback.
-:- pred render_mode(render_mode, int, io__state, io__state).
+:- pred render_mode(render_mode, int, io, io).
:- mode render_mode(in, out, di, uo) is det.
-*/
-
%------------------------------------------------------------------------------%
%
% Display lists.
@@ -736,10 +727,9 @@
GL_STACK_UNDERFLOW,
GL_OUT_OF_MEMORY
};
- GLenum err;
- Integer i;
-
- Err = 0;
+
+ GLenum err = 0;
+ int i;
err = glGetError();
@@ -2136,89 +2126,243 @@
% Per-fragment operations.
%
-/*
+:- pragma foreign_proc("C",
+ scissor(X::in, Y::in, Width::in, Height::in, IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure],
+"
+ glScissor((GLint)X, (GLint)Y, (GLsizei)Width, (GLsizei)Height);
+ IO = IO0;
+").
-:- pred scissor(int, int, int, int, io__state, io__state).
-:- mode scissor(in, in, in, in, di, uo) is det.
+:- func test_func_to_int(test_func) = int.
-:- type test_func
- ---> never
- ; always
- ; less
- ; lequal
- ; equal
- ; gequal
- ; greater
- ; notequal
- .
+test_func_to_int(never) = 0.
+test_func_to_int(always) = 1.
+test_func_to_int(less) = 2.
+test_func_to_int(lequal) = 3.
+test_func_to_int(equal) = 4.
+test_func_to_int(gequal) = 5.
+test_func_to_int(greater) = 6.
+test_func_to_int(not_equal) = 7.
-:- pred alpha_func(test_func, float, io__state, io__state).
-:- mode alpha_func(in, in, di, uo) is det.
+:- pragma foreign_decl("C", "
+ extern const GLenum comparison_mode_flags[];
+").
-:- pred stencil_func(test_func, float, int, io__state, io__state).
-:- mode stencil_func(in, in, in, di, uo) is det.
+:- pragma foreign_code("C", "
+ const GLenum comparison_mode_flags[] = {
+ GL_NEVER,
+ GL_ALWAYS,
+ GL_LESS,
+ GL_LEQUAL,
+ GL_EQUAL,
+ GL_GEQUAL,
+ GL_GREATER,
+ GL_NOTEQUAL
+ };
+").
-:- type stencil_op
- ---> keep
- ; zero
- ; replace
- ; incr
- ; decr
- ; invert
- .
+alpha_func(TestFunc, Ref, !IO) :-
+ alpha_func_2(test_func_to_int(TestFunc), Ref, !IO).
-:- pred stencil_op(stencil_op, stencil_op, stencil_op, io__state, io__state).
-:- mode stencil_op(in, in, in, di, uo) is det.
+:- pred alpha_func_2(int::in, float::in, io::di, io::uo) is det.
+:- pragma foreign_proc("C",
+ alpha_func_2(TestFunc::in, Ref::in, IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure],
+"
+ glAlphaFunc(comparison_mode_flags[TestFunc], (GLclampf)Ref);
+ IO = IO0;
-:- pred depth_func(test_func, io__state, io__state).
-:- mode depth_func(in, di, uo) is det.
+").
-:- type blend_src
- ---> zero
- ; one
- ; dst_color
- ; one_minus_dst_color
- ; src_alpha
- ; one_minus_src_alpha
- ; dst_alpha
- ; one_minus_dst_alpha
- ; src_alpha_saturate
- .
+stencil_func(TestFunc, Ref, Mask, !IO) :-
+ stencil_func_2(test_func_to_int(TestFunc), Ref, Mask, !IO).
-:- type blend_dst
- ---> zero
- ; one
- ; src_color
- ; one_minus_src_color
- ; src_alpha
- ; one_minus_src_alpha
- ; dst_alpha
- ; one_minus_dst_alpha
- .
+:- pred stencil_func_2(int::in, float::in, int::in, io::di, io::uo) is det.
+:- pragma foreign_proc("C",
+ stencil_func_2(TestFunc::in, Ref::in, Mask::in, IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure],
+"
+ glStencilFunc(comparison_mode_flags[TestFunc], (GLint)Ref,
+ (GLuint)Mask);
+ IO = IO0;
+").
-:- pred blend_func(blend_src, blend_dst, io__state, io__state).
-:- mode blend_func(in, in, di, uo) is det.
+:- func stencil_op_to_int(stencil_op) = int.
-:- type logical_operation
- ---> clear
- ; (and)
- ; and_reverse
- ; copy
- ; and_inverted
- ; noop
- ; xor
- ; (or)
- ; nor
- ; equiv
- ; invert
- ; or_reverse
- ; copy_inverted
- ; or_inverted
- ; nand
- ; set
- .
+stencil_op_to_int(keep) = 0.
+stencil_op_to_int(zero) = 1.
+stencil_op_to_int(replace) = 2.
+stencil_op_to_int(incr) = 3.
+stencil_op_to_int(decr) = 4.
+stencil_op_to_int(invert) = 5.
+
+:- pragma foreign_decl("C", "
+ extern const GLenum stencil_op_mode_flags[];
+").
-*/
+:- pragma foreign_code("C", "
+ const GLenum stencil_op_mode_flags[] = {
+ GL_KEEP,
+ GL_ZERO,
+ GL_REPLACE,
+ GL_INCR,
+ GL_DECR,
+ GL_INVERT
+ };
+").
+
+stencil_op(Fail, ZFail, ZPass, !IO) :-
+ stencil_op_2(stencil_op_to_int(Fail), stencil_op_to_int(ZFail),
+ stencil_op_to_int(ZPass), !IO).
+
+:- pred stencil_op_2(int::in, int::in, int::in, io::di, io::uo) is det.
+:- pragma foreign_proc("C",
+ stencil_op_2(Fail::in, ZFail::in, ZPass::in, IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure],
+"
+ glStencilOp(stencil_op_mode_flags[Fail], stencil_op_mode_flags[ZFail],
+ stencil_op_mode_flags[ZPass]);
+ IO = IO0;
+").
+
+depth_func(TestFunc, !IO) :-
+ depth_func_2(test_func_to_int(TestFunc), !IO).
+
+:- pred depth_func_2(int::in, io::di, io::uo) is det.
+:- pragma foreign_proc("C",
+ depth_func_2(Func::in, IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure],
+"
+ glDepthFunc(comparison_mode_flags[Func]);
+ IO = IO0;
+").
+
+:- func blend_src_to_int(blend_src) = int.
+
+blend_src_to_int(zero) = 0.
+blend_src_to_int(one) = 1.
+blend_src_to_int(dst_color) = 2.
+blend_src_to_int(one_minus_dst_color) = 3.
+blend_src_to_int(src_alpha) = 4.
+blend_src_to_int(one_minus_src_alpha) = 5.
+blend_src_to_int(dst_alpha) = 6.
+blend_src_to_int(one_minus_dst_alpha) = 7.
+blend_src_to_int(src_alpha_saturate) = 8.
+
+:- pragma foreign_decl("C", "
+ extern const GLenum blend_src_flags[];
+").
+
+:- pragma foreign_code("C", "
+ const GLenum blend_src_flags[] = {
+ GL_ZERO,
+ GL_ONE,
+ GL_DST_COLOR,
+ GL_ONE_MINUS_DST_COLOR,
+ GL_SRC_ALPHA,
+ GL_ONE_MINUS_SRC_ALPHA,
+ GL_DST_ALPHA,
+ GL_ONE_MINUS_DST_ALPHA,
+ GL_SRC_ALPHA_SATURATE
+ };
+").
+
+:- func blend_dst_to_int(blend_dst) = int.
+
+blend_dst_to_int(zero) = 0.
+blend_dst_to_int(one) = 1.
+blend_dst_to_int(src_color) = 2.
+blend_dst_to_int(one_minus_src_color) = 3.
+blend_dst_to_int(src_alpha) = 4.
+blend_dst_to_int(one_minus_src_alpha) = 5.
+blend_dst_to_int(dst_alpha) = 6.
+blend_dst_to_int(one_minus_dst_alpha) = 7.
+
+:- pragma foreign_decl("C", "
+ extern const GLenum blend_dst_flags[];
+").
+
+:- pragma foreign_code("C", "
+ const GLenum blend_dst_flags[] = {
+ GL_ZERO,
+ GL_ONE,
+ GL_SRC_COLOR,
+ GL_ONE_MINUS_SRC_COLOR,
+ GL_SRC_ALPHA,
+ GL_ONE_MINUS_SRC_ALPHA,
+ GL_DST_ALPHA,
+ GL_ONE_MINUS_DST_ALPHA
+ };
+").
+
+blend_func(Src, Dst, !IO) :-
+ blend_func_2(blend_src_to_int(Src), blend_dst_to_int(Dst), !IO).
+
+:- pred blend_func_2(int::in, int::in, io::di, io::uo) is det.
+:- pragma foreign_proc("C",
+ blend_func_2(Src::in, Dst::in, IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure],
+"
+ glBlendFunc(blend_src_flags[Src], blend_dst_flags[Dst]);
+ IO = IO0;
+").
+
+:- func logical_op_to_int(logical_op) = int.
+
+logical_op_to_int(clear) = 0.
+logical_op_to_int((and)) = 1.
+logical_op_to_int(and_reverse) = 2.
+logical_op_to_int(copy) = 3.
+logical_op_to_int(and_inverted) = 4.
+logical_op_to_int(no_op) = 5.
+logical_op_to_int(xor) = 6.
+logical_op_to_int((or)) = 7.
+logical_op_to_int(nor) = 8.
+logical_op_to_int(equiv) = 9.
+logical_op_to_int(invert) = 10.
+logical_op_to_int(or_reverse) = 11.
+logical_op_to_int(copy_inverted) = 12.
+logical_op_to_int(or_inverted) = 13.
+logical_op_to_int(nand) = 14.
+logical_op_to_int(set) = 15.
+
+:- pragma foreign_decl("C", "
+ extern const GLenum logical_op_flags[];
+").
+
+:- pragma foreign_code("C", "
+ const GLenum logical_op_flags[] = {
+ GL_CLEAR,
+ GL_AND,
+ GL_AND_REVERSE,
+ GL_COPY,
+ GL_AND_INVERTED,
+ GL_NOOP,
+ GL_XOR,
+ GL_OR,
+ GL_NOR,
+ GL_EQUIV,
+ GL_INVERT,
+ GL_OR_REVERSE,
+ GL_COPY_INVERTED,
+ GL_OR_INVERTED,
+ GL_NAND,
+ GL_SET
+ };
+").
+
+logical_op(Op, !IO) :-
+ logical_op_2(logical_op_to_int(Op), !IO).
+
+:- pred logical_op_2(int::in, io::di, io::uo) is det.
+:- pragma foreign_proc("C",
+ logical_op_2(Op::in, IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure],
+"
+ glLogicOp(logical_op_flags[Op]);
+ IO = IO0;
+").
%------------------------------------------------------------------------------%
%
@@ -2447,30 +2591,67 @@
% Selection.
%
-/*
+:- pragma foreign_proc("C",
+ init_names(IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure],
+"
+ glInitNames();
+ IO = IO0;
+").
-:- pred init_names(io__state, io__state).
-:- mode init_names(di, uo) is det.
+:- pragma foreign_proc("C",
+ pop_name(IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure],
+"
+ glPopName();
+ IO = IO0;
+").
-:- pred pop_name(io__state, io__state).
-:- mode pop_name(di, uo) is det.
+:- pragma foreign_proc("C",
+ push_name(Name::in, IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure],
+"
+ glPushName((GLuint)Name);
+ IO = IO0;
+").
-:- pred push_name(int, io__state, io__state).
-:- mode push_name(in, di, uo) is det.
+:- pragma foreign_proc("C",
+ load_name(Name::in, IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure],
+"
+ glLoadName((GLuint)Name);
+ IO = IO0;
+").
-:- pred load_name(int, io__state, io__state).
-:- mode load_name(in, di, uo) is det.
+:- func render_mode_to_int(render_mode) = int.
-:- type render_mode
- ---> render
- ; select
- ; feedback
- .
+render_mode_to_int(render) = 0.
+render_mode_to_int(select) = 1.
+render_mode_to_int(feedback) = 2.
-:- pred render_mode(render_mode, int, io__state, io__state).
-:- mode render_mode(in, out, di, uo) is det.
+:- pragma foreign_decl("C", "
+ extern const GLenum render_mode_flags[];
+").
-*/
+:- pragma foreign_code("C", "
+ const GLenum render_mode_flags[] = {
+ GL_RENDER,
+ GL_SELECT,
+ GL_FEEDBACK
+ };
+").
+
+render_mode(Mode, Output, !IO) :-
+ render_mode_2(render_mode_to_int(Mode), Output, !IO).
+
+:- pred render_mode_2(int::in, int::out, io::di, io::uo) is det.
+:- pragma foreign_proc("C",
+ render_mode_2(Mode::in, Output::out, IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure],
+"
+ Output = (MR_Integer) glRenderMode(render_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
--------------------------------------------------------------------------
More information about the reviews
mailing list