[m-rev.] diff: use foreign enumerations in glut binding
Julien Fischer
juliensf at csse.unimelb.edu.au
Fri Aug 31 18:42:44 AEST 2007
Estimated hours taken: 1
Branches: main
Use foreign enumerations in (most of) the GLUT binding.
This reduces the number of lines of source code by approx. 13%.
extras/graphics/mercury_glut/glut.m:
extras/graphics/mercury_glut/glut.callback.m:
extras/graphics/mercury_glut/glut.color_map.m:
extras/graphics/mercury_glut/glut.font.m:
extras/graphics/mercury_glut/glut.overlay.m:
extras/graphics/mercury_glut/glut.window.m:
Use foreign enumerations to translate between Mercury and C
enumerations.
Add some missing `tabled_for_io' attributes.
Add a `can_pass_as_mercury_type' attribute to a foreign type.
Julien.
Index: glut.callback.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/extras/graphics/mercury_glut/glut.callback.m,v
retrieving revision 1.5
diff -u -r1.5 glut.callback.m
--- glut.callback.m 31 Aug 2006 11:09:50 -0000 1.5
+++ glut.callback.m 31 Aug 2007 08:26:37 -0000
@@ -56,9 +56,14 @@
%
:- pred callback.disable_keyboard_func(io::di, io::uo) is det.
-:- type button ---> left ; middle ; right.
-
-:- type button_state ---> up ; down.
+:- type button
+ ---> left
+ ; middle
+ ; right.
+
+:- type button_state
+ ---> up
+ ; down.
% Registers the mouse callback for the current window.
% This is called whenever the state of one of the mouse buttons
@@ -100,7 +105,9 @@
%
:- pred callback.disable_passive_motion_func(io::di, io::uo) is det.
-:- type entry_state ---> left ; entered.
+:- type entry_state
+ ---> left
+ ; entered.
% Registers the entry callback for the current window.
% This is called whenever the mouse pointer enters/leaves the
@@ -113,7 +120,9 @@
%
:- pred callback.disable_entry_func(io::di, io::uo) is det.
-:- type visibility ---> visible ; not_visible.
+:- type visibility
+ ---> visible
+ ; not_visible.
% Register the visibility callback for the current window.
% This visibility callback is whenever the visibility of a
@@ -433,54 +442,30 @@
in, in, in, in, di, uo),
"MGLUT_do_mouse_callback").
:- pred do_mouse_callback(pred(button, button_state, int, int, io, io),
- int, int, int, int, io, io).
+ button, button_state, int, int, io, io).
:- mode do_mouse_callback(pred(in, in, in, in, di, uo) is det, in, in, in,
in, di, uo) is det.
-do_mouse_callback(MouseFunc, Button0, State0, X, Y, !IO) :-
- ( if Button0 = glut_left_button then Button = left
- else if Button0 = glut_middle_button then Button = middle
- else if Button0 = glut_right_button then Button = right
- else error("Unknown mouse button.")
- ),
- ( if State0 = glut_up then State = up
- else if State0 = glut_down then State = down
- else error("Unknown mouse button state.")
- ),
- MouseFunc(Button, State, X, Y, !IO).
-
-:- func glut_left_button = int.
-:- pragma foreign_proc("C", glut_left_button = (V::out),
- [will_not_call_mercury, promise_pure, thread_safe], "
- V = (MR_Integer) GLUT_LEFT_BUTTON;
-").
-
-:- func glut_middle_button = int.
-:- pragma foreign_proc("C", glut_middle_button = (V::out),
- [will_not_call_mercury, promise_pure, thread_safe], "
- V = (MR_Integer) GLUT_MIDDLE_BUTTON;
-").
-
-:- func glut_right_button = int.
-:- pragma foreign_proc("C", glut_right_button = (V::out),
- [will_not_call_mercury, promise_pure, thread_safe], "
- V = (MR_Integer) GLUT_RIGHT_BUTTON;
-").
-
-:- func glut_up = int.
-:- pragma foreign_proc("C", glut_up = (V::out),
- [will_not_call_mercury, promise_pure, thread_safe], "
- V = (MR_Integer) GLUT_UP;
-").
-
-:- func glut_down = int.
-:- pragma foreign_proc("C", glut_down = (V::out),
- [will_not_call_mercury, promise_pure, thread_safe], "
- V = (MR_Integer) GLUT_DOWN;
-").
+do_mouse_callback(MouseFunc, Button, ButtonState, X, Y, !IO) :-
+ MouseFunc(Button, ButtonState, X, Y, !IO).
+
+:- pragma foreign_enum("C", button/0,
+[
+ left - "GLUT_LEFT_BUTTON",
+ middle - "GLUT_MIDDLE_BUTTON",
+ right - "GLUT_RIGHT_BUTTON"
+]).
+
+:- pragma foreign_enum("C", button_state/0,
+[
+ up - "GLUT_UP",
+ down - "GLUT_DOWN"
+]).
-:- pragma foreign_proc("C", disable_mouse_func(IO0::di, IO::uo),
- [will_not_call_mercury, promise_pure], "
+:- pragma foreign_proc("C",
+ disable_mouse_func(IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
+"
glutMouseFunc(NULL);
IO = IO0;
").
@@ -585,15 +570,11 @@
:- pragma foreign_export("C",
do_entry_callback(pred(in, di, uo) is det, in, di, uo),
"MGLUT_do_entry_callback").
-:- pred do_entry_callback(pred(entry_state, io, io), int, io, io).
+:- pred do_entry_callback(pred(entry_state, io, io), entry_state, io, io).
:- mode do_entry_callback(pred(in, di, uo) is det, in, di, uo) is det.
-do_entry_callback(EntryFunc, State0, !IO) :-
- ( if State0 = glut_left then State = left
- else if State0 = glut_entered then State = entered
- else error("Unable to determine entry state.")
- ),
- EntryFunc(State, !IO).
+do_entry_callback(EntryFunc, EntryState, !IO) :-
+ EntryFunc(EntryState, !IO).
:- pragma foreign_proc("C",
disable_entry_func(IO0::di, IO::uo),
@@ -603,26 +584,18 @@
IO = IO0;
").
-:- func glut_left = int.
-:- pragma foreign_proc("C", glut_left = (Value::out),
- [will_not_call_mercury, promise_pure],
-"
- Value = (MR_Integer) GLUT_LEFT;
-").
-
-:- func glut_entered = int.
-:- pragma foreign_proc("C", glut_entered = (Value::out),
- [will_not_call_mercury, promise_pure],
-"
- Value = (MR_Integer) GLUT_ENTERED;
-").
+:- pragma foreign_enum("C", entry_state/0,
+[
+ left - "GLUT_LEFT",
+ entered - "GLUT_ENTERED"
+]).
%-----------------------------------------------------------------------------%
:- pragma foreign_proc("C",
visibility_func(VisibilityFunc::pred(in, di, uo) is det, IO0::di,
IO::uo),
- [will_not_call_mercury, tabled_for_io, promise_pure],
+ [will_not_call_mercury, tabled_for_io, promise_pure],
"
mglut_visibility_callback = VisibilityFunc;
glutVisibilityFunc(MGLUT_visibility_callback);
@@ -638,37 +611,25 @@
:- pragma foreign_export("C",
do_visibility_callback(pred(in, di, uo) is det, in, di, uo),
"MGLUT_do_visibility_callback").
-:- pred do_visibility_callback(pred(visibility, io, io), int, io, io).
+:- pred do_visibility_callback(pred(visibility, io, io), visibility, io, io).
:- mode do_visibility_callback(pred(in, di, uo) is det, in, di, uo) is det.
-do_visibility_callback(VisibilityFunc, State0, !IO) :-
- ( if State0 = glut_visible then State = visible
- else if State0 = glut_not_visible then State = not_visible
- else error("Unable to determine visibility.")
- ),
- VisibilityFunc(State, !IO).
+do_visibility_callback(VisibilityFunc, Visibility, !IO) :-
+ VisibilityFunc(Visibility, !IO).
:- pragma foreign_proc("C",
disable_visibility_func(IO0::di, IO::uo),
- [will_not_call_mercury, tabled_for_io, promise_pure],
+ [will_not_call_mercury, tabled_for_io, promise_pure, tabled_for_io],
"
glutVisibilityFunc(NULL);
IO = IO0;
").
-:- func glut_visible = int.
-:- pragma foreign_proc("C", glut_visible = (Value::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- Value = (MR_Integer) GLUT_VISIBLE;
-").
-
-:- func glut_not_visible = int.
-:- pragma foreign_proc("C", glut_not_visible = (Value::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- Value = (MR_Integer) GLUT_NOT_VISIBLE;
-").
+:- pragma foreign_enum("C", visibility/0,
+[
+ visible - "GLUT_VISIBLE",
+ not_visible - "GLUT_NOT_VISIBLE"
+]).
%-----------------------------------------------------------------------------%
%
@@ -677,7 +638,7 @@
:- pragma foreign_proc("C",
idle_func(Closure::pred(di, uo) is det, IO0::di, IO::uo),
- [will_not_call_mercury, tabled_for_io, promise_pure],
+ [will_not_call_mercury, tabled_for_io, promise_pure, tabled_for_io],
"
mglut_idle_callback = Closure;
glutIdleFunc(MGLUT_idle_callback);
@@ -700,7 +661,7 @@
:- pragma foreign_proc("C",
disable_idle_func(IO0::di, IO::uo),
- [will_not_call_mercury, tabled_for_io, promise_pure],
+ [will_not_call_mercury, tabled_for_io, promise_pure, tabled_for_io],
"
glutIdleFunc(NULL);
IO = IO0;
@@ -813,12 +774,12 @@
in, in, in, di, uo),
"MGLUT_do_special_callback").
:- pred do_special_callback(pred(special_key, int, int, io, io),
- int, int, int, io, io).
-:- mode do_special_callback(pred(in,in,in,di,uo) is det, in, in, in, di, uo)
- is det.
+ special_key, int, int, io, io).
+:- mode do_special_callback(pred(in, in, in, di, uo) is det,
+ in, in, in, di, uo) is det.
do_special_callback(Special, Key, X, Y, !IO) :-
- Special(int_to_special_key(Key), X, Y, !IO).
+ Special(Key, X, Y, !IO).
:- pragma foreign_proc("C",
callback.disable_special_func(IO0::di, IO::uo),
@@ -855,12 +816,12 @@
in, in, in, di, uo),
"MGLUT_do_special_up_callback").
:- pred do_special_up_callback(pred(special_key, int, int, io, io),
- int, int, int, io, io).
+ special_key, int, int, io, io).
:- mode do_special_up_callback(pred(in,in,in,di,uo) is det, in, in, in, di, uo)
is det.
do_special_up_callback(SpecialUpFunc, Key, X, Y, !IO) :-
- SpecialUpFunc(int_to_special_key(Key), X, Y, !IO).
+ SpecialUpFunc(Key, X, Y, !IO).
:- pragma foreign_proc("C",
callback.disable_special_up_func(IO0::di, IO::uo),
@@ -871,184 +832,31 @@
").
%-----------------------------------------------------------------------------%
-%
-% Constants for special keyboard callbacks
-%
-
-:- func int_to_special_key(int) = special_key.
-
-int_to_special_key(KeyCode) = Key :-
- ( if KeyCode = glut_key_f1 then Key = f1
- else if KeyCode = glut_key_f2 then Key = f2
- else if KeyCode = glut_key_f3 then Key = f3
- else if KeyCode = glut_key_f4 then Key = f4
- else if KeyCode = glut_key_f5 then Key = f5
- else if KeyCode = glut_key_f6 then Key = f6
- else if KeyCode = glut_key_f7 then Key = f7
- else if KeyCode = glut_key_f8 then Key = f8
- else if KeyCode = glut_key_f9 then Key = f9
- else if KeyCode = glut_key_f10 then Key = f10
- else if KeyCode = glut_key_f11 then Key = f11
- else if KeyCode = glut_key_f12 then Key = f12
- else if KeyCode = glut_key_left then Key = left
- else if KeyCode = glut_key_up then Key = up
- else if KeyCode = glut_key_right then Key = right
- else if KeyCode = glut_key_down then Key = down
- else if KeyCode = glut_key_page_up then Key = page_up
- else if KeyCode = glut_key_page_down then Key = page_down
- else if KeyCode = glut_key_home then Key = home
- else if KeyCode = glut_key_end then Key = end
- else if KeyCode = glut_key_insert then Key = insert
-
- else error("Unknown special key encountered.")
- ).
-
-:- func glut_key_f1 = int.
-:- pragma foreign_proc("C", glut_key_f1 = (V::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- V = (MR_Integer) GLUT_KEY_F1;
-").
-
-:- func glut_key_f2 = int.
-:- pragma foreign_proc("C", glut_key_f2 = (V::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- V = (MR_Integer) GLUT_KEY_F2;
-").
-
-:- func glut_key_f3 = int.
-:- pragma foreign_proc("C", glut_key_f3 = (V::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- V = (MR_Integer) GLUT_KEY_F3;
-").
-
-:- func glut_key_f4 = int.
-:- pragma foreign_proc("C", glut_key_f4 = (V::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- V = (MR_Integer) GLUT_KEY_F4;
-").
-
-:- func glut_key_f5 = int.
-:- pragma foreign_proc("C", glut_key_f5 = (V::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- V = (MR_Integer) GLUT_KEY_F5;
-").
-
-:- func glut_key_f6 = int.
-:- pragma foreign_proc("C", glut_key_f6 = (V::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- V = (MR_Integer) GLUT_KEY_F6;
-").
-:- func glut_key_f7 = int.
-:- pragma foreign_proc("C", glut_key_f7 = (V::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- V = (MR_Integer) GLUT_KEY_F7;
-").
-
-:- func glut_key_f8 = int.
-:- pragma foreign_proc("C", glut_key_f8 = (V::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- V = (MR_Integer) GLUT_KEY_F8;
-").
-
-:- func glut_key_f9 = int.
-:- pragma foreign_proc("C", glut_key_f9 = (V::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- V = (MR_Integer) GLUT_KEY_F9;
-").
-
-:- func glut_key_f10 = int.
-:- pragma foreign_proc("C", glut_key_f10 = (V::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- V = (MR_Integer) GLUT_KEY_F10;
-").
-
-:- func glut_key_f11 = int.
-:- pragma foreign_proc("C", glut_key_f11 = (V::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- V = (MR_Integer) GLUT_KEY_F11;
-").
-
-:- func glut_key_f12 = int.
-:- pragma foreign_proc("C", glut_key_f12 = (V::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- V = (MR_Integer) GLUT_KEY_F12;
-").
-
-:- func glut_key_left = int.
-:- pragma foreign_proc("C", glut_key_left = (V::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- V = (MR_Integer) GLUT_KEY_LEFT;
-").
-
-:- func glut_key_up = int.
-:- pragma foreign_proc("C", glut_key_up = (V::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- V = (MR_Integer) GLUT_KEY_UP;
-").
-
-:- func glut_key_right = int.
-:- pragma foreign_proc("C", glut_key_right = (V::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- V = (MR_Integer) GLUT_KEY_RIGHT;
-").
-
-:- func glut_key_down = int.
-:- pragma foreign_proc("C", glut_key_down = (V::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- V = (MR_Integer) GLUT_KEY_DOWN;
-").
-
-:- func glut_key_page_up = int.
-:- pragma foreign_proc("C", glut_key_page_up = (V::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- V = (MR_Integer) GLUT_KEY_PAGE_UP;
-").
-
-:- func glut_key_page_down = int.
-:- pragma foreign_proc("C", glut_key_page_down = (V::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- V = (MR_Integer) GLUT_KEY_PAGE_DOWN;
-").
-
-:- func glut_key_home = int.
-:- pragma foreign_proc("C", glut_key_home = (V::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- V = (MR_Integer) GLUT_KEY_HOME;
-").
-
-:- func glut_key_end = int.
-:- pragma foreign_proc("C", glut_key_end = (V::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- V = (MR_Integer) GLUT_KEY_END;
-").
-
-:- func glut_key_insert = int.
-:- pragma foreign_proc("C", glut_key_insert = (V::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- V = (MR_Integer) GLUT_KEY_INSERT;
-").
+:- pragma foreign_enum("C", special_key/0,
+[
+ f1 - "GLUT_KEY_F1",
+ f2 - "GLUT_KEY_F2",
+ f3 - "GLUT_KEY_F3",
+ f4 - "GLUT_KEY_F4",
+ f5 - "GLUT_KEY_F5",
+ f6 - "GLUT_KEY_F6",
+ f7 - "GLUT_KEY_F7",
+ f8 - "GLUT_KEY_F8",
+ f9 - "GLUT_KEY_F9",
+ f10 - "GLUT_KEY_F10",
+ f11 - "GLUT_KEY_F11",
+ f12 - "GLUT_KEY_F12",
+ left - "GLUT_KEY_LEFT",
+ up - "GLUT_KEY_UP",
+ right - "GLUT_KEY_RIGHT",
+ down - "GLUT_KEY_DOWN",
+ page_up - "GLUT_KEY_PAGE_UP",
+ page_down - "GLUT_KEY_PAGE_DOWN",
+ home - "GLUT_KEY_HOME",
+ end - "GLUT_KEY_END",
+ insert - "GLUT_KEY_INSERT"
+]).
%-----------------------------------------------------------------------------%
:- end_module glut.callback.
Index: glut.color_map.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/extras/graphics/mercury_glut/glut.color_map.m,v
retrieving revision 1.4
diff -u -r1.4 glut.color_map.m
--- glut.color_map.m 20 Apr 2006 03:14:56 -0000 1.4
+++ glut.color_map.m 31 Aug 2007 08:18:08 -0000
@@ -70,44 +70,20 @@
IO = IO0;
").
-color_map.get_color(Index, Component, Value, !IO) :-
- get_color_2(Index, component_to_int(Component), Value, !IO).
-
-:- pred get_color_2(int::in, int::in, float::out, io::di, io::uo) is det.
:- pragma foreign_proc("C",
- get_color_2(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;
").
-:- func component_to_int(component) = int.
-
-component_to_int(red) = glut_red.
-component_to_int(green) = glut_green.
-component_to_int(blue) = glut_blue.
-
-:- func glut_red = int.
-:- pragma foreign_proc("C", glut_red = (Value::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- Value = (MR_Integer) GLUT_RED;
-").
-
-:- func glut_green = int.
-:- pragma foreign_proc("C", glut_green = (Value::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- Value = (MR_Integer) GLUT_GREEN;
-").
-
-:- func glut_blue = int.
-:- pragma foreign_proc("C", glut_blue = (Value::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- Value = (MR_Integer) GLUT_BLUE;
-").
+:- pragma foreign_enum("C", component/0,
+[
+ red - "GLUT_RED",
+ green - "GLUT_GREEN",
+ blue - "GLUT_BLUE"
+]).
%-----------------------------------------------------------------------------%
Index: glut.font.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/extras/graphics/mercury_glut/glut.font.m,v
retrieving revision 1.4
diff -u -r1.4 glut.font.m
--- glut.font.m 20 Apr 2006 03:14:57 -0000 1.4
+++ glut.font.m 31 Aug 2007 08:18:54 -0000
@@ -87,7 +87,7 @@
").
:- type font_ptr.
-:- pragma foreign_type("C", font_ptr, "void *").
+:- pragma foreign_type("C", font_ptr, "void *", [can_pass_as_mercury_type]).
%----------------------------------------------------------------------------%
%
Index: glut.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/extras/graphics/mercury_glut/glut.m,v
retrieving revision 1.8
diff -u -r1.8 glut.m
--- glut.m 20 Apr 2006 03:14:57 -0000 1.8
+++ glut.m 31 Aug 2007 07:46:47 -0000
@@ -335,77 +335,38 @@
%-----------------------------------------------------------------------------%
-glut.get(State, Value, !IO) :-
- glut.get_2(state_to_int(State), Value, !IO).
+:- pragma foreign_enum("C", glut.state/0,
+[
+ screen_width - "GLUT_SCREEN_WIDTH",
+ screen_height - "GLUT_SCREEN_HEIGHT",
+ screen_width_mm - "GLUT_SCREEN_WIDTH_MM",
+ screen_height_mm - "GLUT_SCREEN_HEIGHT_MM",
+ init_window_x - "GLUT_INIT_WINDOW_X",
+ init_window_y - "GLUT_INIT_WINDOW_Y"
+]).
-:- pred glut.get_2(int::in, int::out, io::di, io::uo) is det.
:- pragma foreign_proc("C",
- glut.get_2(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;
").
-:- func state_to_int(glut.state) = int.
-
-state_to_int(screen_width) = glut_screen_width.
-state_to_int(screen_height) = glut_screen_height.
-state_to_int(screen_width_mm) = glut_screen_width_mm.
-state_to_int(screen_height_mm) = glut_screen_height_mm.
-state_to_int(init_window_x) = glut_init_window_x.
-state_to_int(init_window_y) = glut_init_window_y.
-
-:- func glut_screen_width = int.
-:- pragma foreign_proc("C", glut_screen_width = (Value::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- Value = (MR_Integer) GLUT_SCREEN_WIDTH;
-").
-
-:- func glut_screen_height = int.
-:- pragma foreign_proc("C", glut_screen_height = (Value::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- Value = (MR_Integer) GLUT_SCREEN_HEIGHT;
-").
-
-:- func glut_screen_width_mm = int.
-:- pragma foreign_proc("C", glut_screen_width_mm = (Value::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- Value = (MR_Integer) GLUT_SCREEN_WIDTH_MM;
-").
-
-:- func glut_screen_height_mm = int.
-:- pragma foreign_proc("C", glut_screen_height_mm = (Value::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- Value = (MR_Integer) GLUT_SCREEN_HEIGHT_MM;
-").
-
-:- func glut_init_window_x = int.
-:- pragma foreign_proc("C", glut_init_window_x = (Value::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- Value = (MR_Integer) GLUT_INIT_WINDOW_X;
-").
-
-:- func glut_init_window_y = int.
-:- pragma foreign_proc("C", glut_init_window_y = (Value::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- Value = (MR_Integer) GLUT_INIT_WINDOW_Y;
-").
-
%-----------------------------------------------------------------------------%
+
+:- pragma foreign_enum("C", glut.device/0,
+[
+ keyboard - "GLUT_HAS_KEYBOARD",
+ mouse - "GLUT_HAS_MOUSE",
+ spaceball - "GLUT_HAS_SPACEBALL",
+ dial_and_button_box - "GLUT_HAS_DIAL_AND_BUTTON_BOX",
+ tablet - "GLUT_HAS_TABLET",
+ joystick - "GLUT_HAS_JOYSTICK"
+]).
-glut.has_device(Device, Result, !IO) :-
- glut.has_device_2(device_to_int(Device), Result, !IO).
-
-:- pred glut.has_device_2(int::in, bool::out, io::di, io::uo) is det.
:- pragma foreign_proc("C",
- glut.has_device_2(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)) {
@@ -416,59 +377,6 @@
IO = IO0;
").
-:- func device_to_int(device) = int.
-
-device_to_int(keyboard) = glut_has_keyboard.
-device_to_int(mouse) = glut_has_mouse.
-device_to_int(spaceball) = glut_has_spaceball.
-device_to_int(dial_and_button_box) = glut_has_dial_and_button_box.
-device_to_int(tablet) = glut_has_tablet.
-device_to_int(joystick) = glut_has_joystick.
-
-:- func glut_has_keyboard = int.
-:- pragma foreign_proc("C", glut_has_keyboard = (Value::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- Value = (MR_Integer) GLUT_HAS_KEYBOARD;
-").
-
-:- func glut_has_mouse = int.
-:- pragma foreign_proc("C", glut_has_mouse = (Value::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- Value = (MR_Integer) GLUT_HAS_MOUSE;
-").
-
-:- func glut_has_spaceball = int.
-:- pragma foreign_proc("C", glut_has_spaceball = (Value::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- Value = (MR_Integer) GLUT_HAS_SPACEBALL;
-").
-
-:- func glut_has_dial_and_button_box = int.
-:- pragma foreign_proc("C", glut_has_dial_and_button_box = (Value::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- Value = (MR_Integer) GLUT_HAS_DIAL_AND_BUTTON_BOX;
-").
-
-:- func glut_has_tablet = int.
-:- pragma foreign_proc("C",
- glut_has_tablet = (Value::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- Value = (MR_Integer) GLUT_HAS_TABLET;
-").
-
-:- func glut_has_joystick = int.
-:- pragma foreign_proc("C",
- glut_has_joystick = (Value::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- Value = (MR_Integer) GLUT_HAS_JOYSTICK;
-").
-
%-----------------------------------------------------------------------------%
:- pragma foreign_proc("C",
Index: glut.overlay.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/extras/graphics/mercury_glut/glut.overlay.m,v
retrieving revision 1.5
diff -u -r1.5 glut.overlay.m
--- glut.overlay.m 20 Apr 2006 03:14:57 -0000 1.5
+++ glut.overlay.m 31 Aug 2007 08:21:14 -0000
@@ -105,26 +105,11 @@
%-----------------------------------------------------------------------------%
-:- func glut_normal = int.
-:- pragma foreign_proc("C",
- glut_normal = (Value::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- Value = (MR_Integer) GLUT_NORMAL;
-").
-
-:- func glut_overlay = int.
-:- pragma foreign_proc("C",
- glut_overlay = (Value::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- Value = (MR_Integer) GLUT_OVERLAY;
-").
-
-:- func layer_to_int(layer) = int.
-
-layer_to_int(normal) = glut_normal.
-layer_to_int(overlay) = glut_overlay.
+:- pragma foreign_enum("C", layer/0,
+[
+ normal - "GLUT_NORMAL",
+ overlay - "GLUT_OVERLAY"
+]).
%-----------------------------------------------------------------------------%
@@ -201,13 +186,13 @@
%-----------------------------------------------------------------------------%
overlay.use_layer(Layer, Result, !IO) :-
- overlay.use_layer_2(layer_to_int(Layer), Result0, !IO),
+ overlay.use_layer_2(Layer, Result0, !IO),
( Result0 = 1 -> Result = ok
; Result0 = 0 -> Result = error("Unable to change layer.")
; error("Unknown result from layer change.")
).
-:- pred overlay.use_layer_2(int::in, int::out, io::di, io::uo) is det.
+:- pred overlay.use_layer_2(layer::in, int::out, io::di, io::uo) is det.
:- pragma foreign_proc("C",
overlay.use_layer_2(Layer::in, Result::out, IO0::di, IO::uo),
[will_not_call_mercury, tabled_for_io, promise_pure],
@@ -228,16 +213,8 @@
%-----------------------------------------------------------------------------%
-overlay.layer_in_use(Layer, !IO) :-
- overlay.layer_in_use_2(Layer0, !IO),
- ( Layer0 = glut_normal -> Layer = normal
- ; Layer0 = glut_overlay -> Layer = overlay
- ; error("Unable to determine which layer is in use.")
- ).
-
-:- pred overlay.layer_in_use_2(int::out, io::di, io::uo) is det.
:- pragma foreign_proc("C",
- overlay.layer_in_use_2(Layer::out, IO0::di, IO::uo),
+ overlay.layer_in_use(Layer::out, IO0::di, IO::uo),
[will_not_call_mercury, tabled_for_io, promise_pure],
"
Layer = (MR_Integer) glutLayerGet(GLUT_LAYER_IN_USE);
Index: glut.window.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/extras/graphics/mercury_glut/glut.window.m,v
retrieving revision 1.5
diff -u -r1.5 glut.window.m
--- glut.window.m 20 Apr 2006 03:14:57 -0000 1.5
+++ glut.window.m 31 Aug 2007 07:57:17 -0000
@@ -430,6 +430,9 @@
IO = IO0;
").
+ % NOTE: we don't use a foreign enumeration for this type because we
+ % may eventually support user-defined cursors.
+ %
:- func cursor_to_int(cursor) = int.
cursor_to_int(right_arrow) = glut_cursor_right_arrow.
@@ -689,33 +692,30 @@
%-----------------------------------------------------------------------------%
-:- func window_state_to_int(window.state) = int.
-
-window_state_to_int(x) = glut_window_x.
-window_state_to_int(y) = glut_window_y.
-window_state_to_int(window_width) = glut_window_width.
-window_state_to_int(window_height) = glut_window_height.
-window_state_to_int(buffer_size) = glut_window_buffer_size.
-window_state_to_int(stencil_size) = glut_window_stencil_size.
-window_state_to_int(depth_size) = glut_window_depth_size.
-window_state_to_int(red_size) = glut_window_red_size.
-window_state_to_int(green_size) = glut_window_green_size.
-window_state_to_int(blue_size) = glut_window_blue_size.
-window_state_to_int(alpha_size) = glut_window_alpha_size.
-window_state_to_int(accum_red_size) = glut_window_accum_red_size.
-window_state_to_int(accum_green_size) = glut_window_accum_green_size.
-window_state_to_int(accum_blue_size) = glut_window_accum_blue_size.
-window_state_to_int(accum_alpha_size) = glut_window_accum_alpha_size.
-window_state_to_int(colormap_size) = glut_window_colormap_size.
-window_state_to_int(number_samples) = glut_window_num_samples.
-window_state_to_int(format_id) = glut_window_format_id.
-
-window.get(State, Value, !IO) :-
- window.get_2(window_state_to_int(State), Value, !IO).
-
-:- pred window.get_2(int::in, int::out, io::di, io::uo) is det.
+:- pragma foreign_enum("C", window.state/0,
+[
+ x - "GLUT_WINDOW_X",
+ y - "GLUT_WINDOW_Y",
+ window_width - "GLUT_WINDOW_WIDTH",
+ window_height - "GLUT_WINDOW_HEIGHT",
+ buffer_size - "GLUT_WINDOW_BUFFER_SIZE",
+ stencil_size - "GLUT_WINDOW_STENCIL_SIZE",
+ depth_size - "GLUT_WINDOW_DEPTH_SIZE",
+ red_size - "GLUT_WINDOW_RED_SIZE",
+ green_size - "GLUT_WINDOW_GREEN_SIZE",
+ blue_size - "GLUT_WINDOW_BLUE_SIZE",
+ alpha_size - "GLUT_WINDOW_ALPHA_SIZE",
+ accum_red_size - "GLUT_WINDOW_ACCUM_RED_SIZE",
+ accum_green_size - "GLUT_WINDOW_ACCUM_GREEN_SIZE",
+ accum_blue_size - "GLUT_WINDOW_ACCUM_BLUE_SIZE",
+ accum_alpha_size - "GLUT_WINDOW_ACCUM_ALPHA_SIZE",
+ colormap_size - "GLUT_WINDOW_COLORMAP_SIZE",
+ number_samples - "GLUT_WINDOW_NUM_SAMPLES",
+ format_id - "GLUT_WINDOW_FORMAT_ID"
+]).
+
:- pragma foreign_proc("C",
- window.get_2(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);
@@ -724,134 +724,6 @@
%-----------------------------------------------------------------------------%
-:- func glut_window_x = int.
-:- pragma foreign_proc("C", glut_window_x = (Value::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- Value = (MR_Integer) GLUT_WINDOW_X;
-").
-
-:- func glut_window_y = int.
-:- pragma foreign_proc("C", glut_window_y = (Value::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- Value = (MR_Integer) GLUT_WINDOW_Y;
-").
-
-:- func glut_window_width = int.
-:- pragma foreign_proc("C", glut_window_width = (Value::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- Value = (MR_Integer) GLUT_WINDOW_WIDTH;
-").
-
-:- func glut_window_height = int.
-:- pragma foreign_proc("C", glut_window_height = (Value::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- Value = (MR_Integer) GLUT_WINDOW_HEIGHT;
-").
-
-:- func glut_window_buffer_size = int.
-:- pragma foreign_proc("C", glut_window_buffer_size = (Value::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- Value = (MR_Integer) GLUT_WINDOW_BUFFER_SIZE;
-").
-
-:- func glut_window_stencil_size = int.
-:- pragma foreign_proc("C", glut_window_stencil_size = (Value::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- Value = (MR_Integer) GLUT_WINDOW_STENCIL_SIZE;
-").
-
-:- func glut_window_depth_size = int.
-:- pragma foreign_proc("C", glut_window_depth_size = (Value::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- Value = (MR_Integer) GLUT_WINDOW_DEPTH_SIZE;
-").
-
-:- func glut_window_red_size = int.
-:- pragma foreign_proc("C", glut_window_red_size = (Value::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- Value = (MR_Integer) GLUT_WINDOW_RED_SIZE;
-").
-
-:- func glut_window_green_size = int.
-:- pragma foreign_proc("C", glut_window_green_size = (Value::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- Value = (MR_Integer) GLUT_WINDOW_GREEN_SIZE;
-").
-
-:- func glut_window_blue_size = int.
-:- pragma foreign_proc("C", glut_window_blue_size = (Value::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- Value = (MR_Integer) GLUT_WINDOW_BLUE_SIZE;
-").
-
-:- func glut_window_alpha_size = int.
-:- pragma foreign_proc("C", glut_window_alpha_size = (Value::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- Value = (MR_Integer) GLUT_WINDOW_ALPHA_SIZE;
-").
-
-:- func glut_window_accum_red_size = int.
-:- pragma foreign_proc("C", glut_window_accum_red_size = (Value::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- Value = (MR_Integer) GLUT_WINDOW_ACCUM_RED_SIZE;
-").
-
-:- func glut_window_accum_green_size = int.
-:- pragma foreign_proc("C", glut_window_accum_green_size = (Value::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- Value = (MR_Integer) GLUT_WINDOW_ACCUM_GREEN_SIZE;
-").
-
-:- func glut_window_accum_blue_size = int.
-:- pragma foreign_proc("C", glut_window_accum_blue_size = (Value::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- Value = (MR_Integer) GLUT_WINDOW_ACCUM_BLUE_SIZE;
-").
-
-:- func glut_window_accum_alpha_size = int.
-:- pragma foreign_proc("C", glut_window_accum_alpha_size = (Value::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- Value = (MR_Integer) GLUT_WINDOW_ACCUM_ALPHA_SIZE;
-").
-
-:- func glut_window_colormap_size = int.
-:- pragma foreign_proc("C", glut_window_colormap_size = (Value::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- Value = (MR_Integer) GLUT_WINDOW_COLORMAP_SIZE;
-").
-
-:- func glut_window_num_samples = int.
-:- pragma foreign_proc("C", glut_window_num_samples = (Value::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- Value = (MR_Integer) GLUT_WINDOW_NUM_SAMPLES;
-").
-
-:- func glut_window_format_id = int.
-:- pragma foreign_proc("C", glut_window_format_id = (Value::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- Value = (MR_Integer) GLUT_WINDOW_FORMAT_ID;
-").
-
-%-----------------------------------------------------------------------------%
-
:- pragma foreign_proc("C",
window.has_overlay(Result::out, IO0::di, IO::uo),
[will_not_call_mercury, tabled_for_io, promise_pure],
--------------------------------------------------------------------------
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