diff --git a/extras/graphics/mercury_glut/glut.callback.m b/extras/graphics/mercury_glut/glut.callback.m index 7dd4cd629..f9b3459ea 100644 --- a/extras/graphics/mercury_glut/glut.callback.m +++ b/extras/graphics/mercury_glut/glut.callback.m @@ -1,7 +1,7 @@ %-----------------------------------------------------------------------------% % vim: ft=mercury ts=4 sw=4 et %-----------------------------------------------------------------------------% -% Copyright (C) 2004-2006 The University of Melbourne. +% Copyright (C) 2004-2007 The University of Melbourne. % This file may only be copied under the terms of the GNU Library General % Public License - see the file COPYING.LIB in the Mercury distribution. %-----------------------------------------------------------------------------% @@ -56,9 +56,14 @@ % :- pred callback.disable_keyboard_func(io::di, io::uo) is det. -:- type button ---> left ; middle ; right. +:- type button + ---> left + ; middle + ; right. -:- type button_state ---> up ; down. +:- 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 @@ void MGLUT_mouse_callback(int button, int state, int x, int y) 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). +do_mouse_callback(MouseFunc, Button, ButtonState, X, Y, !IO) :- + MouseFunc(Button, ButtonState, 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; -"). +:- pragma foreign_enum("C", button/0, +[ + left - "GLUT_LEFT_BUTTON", + middle - "GLUT_MIDDLE_BUTTON", + right - "GLUT_RIGHT_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; -"). +:- pragma foreign_enum("C", button_state/0, +[ + up - "GLUT_UP", + down - "GLUT_DOWN" +]). -:- 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; -"). - -:- 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 @@ void MGLUT_entry_callback(int state) :- 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 @@ do_entry_callback(EntryFunc, State0, !IO) :- 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 @@ void MGLUT_visibility_callback(int state) :- 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 @@ do_visibility_callback(VisibilityFunc, State0, !IO) :- :- 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 @@ do_idle_callback(IdleFunc, !IO) :- IdleFunc(!IO). :- 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 @@ void MGLUT_special_callback(int key, int x, int y) 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 @@ void MGLUT_special_up_callback(int key, int x, int y) 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 @@ do_special_up_callback(SpecialUpFunc, Key, X, Y, !IO) :- "). %-----------------------------------------------------------------------------% -% -% 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. diff --git a/extras/graphics/mercury_glut/glut.color_map.m b/extras/graphics/mercury_glut/glut.color_map.m index 1cb5d3297..50f7e9e87 100644 --- a/extras/graphics/mercury_glut/glut.color_map.m +++ b/extras/graphics/mercury_glut/glut.color_map.m @@ -1,7 +1,7 @@ %-----------------------------------------------------------------------------% % vim: ft=mercury ts=4 sw=4 et %-----------------------------------------------------------------------------% -% Copyright (C) 2004-2006 The University of Melbourne. +% Copyright (C) 2004-2007 The University of Melbourne. % This file may only be copied under the terms of the GNU Library General % Public License - see the file COPYING.LIB in the Mercury distribution. %-----------------------------------------------------------------------------% @@ -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" +]). %-----------------------------------------------------------------------------% diff --git a/extras/graphics/mercury_glut/glut.font.m b/extras/graphics/mercury_glut/glut.font.m index 6cda097d1..ade710b88 100644 --- a/extras/graphics/mercury_glut/glut.font.m +++ b/extras/graphics/mercury_glut/glut.font.m @@ -1,7 +1,7 @@ %-----------------------------------------------------------------------------% % vim: ft=mercury ts=4 sw=4 et %-----------------------------------------------------------------------------% -% Copyright (C) 2004-2006 The University of Melbourne. +% Copyright (C) 2004-2007 The University of Melbourne. % This file may only be copied under the terms of the GNU Library General % Public License - see the file COPYING.LIB in the Mercury distribution. %-----------------------------------------------------------------------------% @@ -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]). %----------------------------------------------------------------------------% % diff --git a/extras/graphics/mercury_glut/glut.m b/extras/graphics/mercury_glut/glut.m index 5d2fdfdf9..3393d8fa6 100644 --- a/extras/graphics/mercury_glut/glut.m +++ b/extras/graphics/mercury_glut/glut.m @@ -1,7 +1,7 @@ %-----------------------------------------------------------------------------% % vim: ft=mercury ts=4 sw=4 et %-----------------------------------------------------------------------------% -% Copyright (C) 2004-2006 The University of Melbourne. +% Copyright (C) 2004-2007 The University of Melbourne. % This file may only be copied under the terms of the GNU Library General % Public License - see the file COPYING.LIB in the Mercury distribution. %-----------------------------------------------------------------------------% @@ -335,77 +335,38 @@ display_mode_to_int(luminance) = glut_luminance. %-----------------------------------------------------------------------------% -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 @@ glut.has_device(Device, Result, !IO) :- 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", diff --git a/extras/graphics/mercury_glut/glut.overlay.m b/extras/graphics/mercury_glut/glut.overlay.m index 3035f1747..fdab9474f 100644 --- a/extras/graphics/mercury_glut/glut.overlay.m +++ b/extras/graphics/mercury_glut/glut.overlay.m @@ -1,7 +1,7 @@ %-----------------------------------------------------------------------------% % vim: ft=mercury ts=4 sw=4 et %-----------------------------------------------------------------------------% -% Copyright (C) 2004-2006 The University of Melbourne. +% Copyright (C) 2004-2007 The University of Melbourne. % This file may only be copied under the terms of the GNU Library General % Public License - see the file COPYING.LIB in the Mercury distribution. %-----------------------------------------------------------------------------% @@ -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.establish(Result, !IO) :- %-----------------------------------------------------------------------------% 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.use_layer(Layer, Result, !IO) :- %-----------------------------------------------------------------------------% -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); diff --git a/extras/graphics/mercury_glut/glut.window.m b/extras/graphics/mercury_glut/glut.window.m index 4e0a97fcc..88247ce32 100644 --- a/extras/graphics/mercury_glut/glut.window.m +++ b/extras/graphics/mercury_glut/glut.window.m @@ -1,7 +1,7 @@ %-----------------------------------------------------------------------------% % vim: ft=mercury ts=4 sw=4 et %-----------------------------------------------------------------------------% -% Copyright (C) 2004-2006 The University of Melbourne. +% Copyright (C) 2004-2007 The University of Melbourne. % This file may only be copied under the terms of the GNU Library General % Public License - see the file COPYING.LIB in the Mercury distribution. %-----------------------------------------------------------------------------% @@ -430,6 +430,9 @@ window.id(MaybeWindow, !IO) :- 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 @@ window.set_cursor(Cursor, !IO) :- %-----------------------------------------------------------------------------% -:- 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 @@ window.get(State, Value, !IO) :- %-----------------------------------------------------------------------------% -:- 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],