[m-rev.] diff: cleanups for extras/curs

Julien Fischer juliensf at cs.mu.OZ.AU
Fri Apr 21 13:35:18 AEST 2006


Estimated hours taken: 1
Branches: main, release

Cleanups for extras/curs.

extras/curs/samples/Mmakefile:
	Build all the demos in this directory.

extras/curs/curs.m:
	Define the type `panel' as a foreign type.  Remove casts from
	the C code that are now redundant because of this.

	Convert to four-space indentation.

extras/curs/curs.m:
extras/curs/samples/*.m:
	Fix overlong lines.

	s/io__state/io/

	Use state variables for passing around the I/O state.

	Format foreign_procs as per our coding standard.

Julien.

Index: curs.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/curs/curs.m,v
retrieving revision 1.6
diff -u -b -r1.6 curs.m
--- curs.m	26 Oct 2005 05:04:14 -0000	1.6
+++ curs.m	21 Apr 2006 03:24:51 -0000
@@ -1,15 +1,13 @@
-% ---------------------------------------------------------------------------- %
+%-----------------------------------------------------------------------------%
 % curs.m
 % Copyright (C) 2001 Ralph Becket <rbeck at microsoft.com>
 % Thu Jan 11 13:47:25 GMT 2001
 % vim: ts=4 sw=4 et tw=0 wm=0 ff=unix ft=mercury
 %
-%
 %   THIS FILE IS HEREBY CONTRIBUTED TO THE MERCURY PROJECT TO
 %   BE RELEASED UNDER WHATEVER LICENCE IS DEEMED APPROPRIATE
 %   BY THE ADMINISTRATORS OF THE MERCURY PROJECT.
 %
-%
 % Simplified Mercury interface to the ncurses and panel libraries.
 %
 % This is largely inspired by Tomas Conway and Robert Jeschofnik's
@@ -22,112 +20,106 @@
 % NOTE: you will need to include `-lpanel -lncurses' in MLLIBS when
 % linking against this module.
 %
-% ---------------------------------------------------------------------------- %
+%-----------------------------------------------------------------------------%

 :- module curs.
-
 :- interface.

-:- import_module bool, io, string, char, int.
-
+:- import_module bool.
+:- import_module char.
+:- import_module int.
+:- import_module io.
+:- import_module string.

+%-----------------------------------------------------------------------------%

     % Start a curses session (colour, unbuffered input, no echoing,
     % invisible cursor if possible, scrolling on when output past
     % the bottom of the main display and any windows).
     %
-:- pred start(io__state::di, io__state::uo) is det.
+:- pred start(io::di, io::uo) is det.

     % Enable or disable the no-delay option.  If enabled (first argument is
     % yes) then getch will be a non-blocking call, i.e. return immediately
     % if no input is ready rather than waiting for input.
     %
-:- pred nodelay(bool::in, io__state::di, io__state::uo) is det.
+:- pred nodelay(bool::in, io::di, io::uo) is det.

     % Close a curses session; necessary to return the tty to a sensible
     % state.
     %
-:- pred stop(io__state::di, io__state::uo) is det.
+:- pred stop(io::di, io::uo) is det.

     % A wrapper predicate that handles calling start and stop.
     %
-% :- pred session(pred(io__state::di, io__state::uo) is det,
-            % io__state::di, io__state::uo) is det.
-:- pred session(pred(io__state, io__state), io__state, io__state).
-:- mode session(pred(di, uo) is det, di, uo) is det.
+:- pred session(pred(io, io)::(pred(di, uo) is det), io::di, io::uo) is det.

     % Number of rows and columns on the physical screen.
     %
-:- pred rows_cols(int::out, int::out, io__state::di, io__state::uo) is det.
+:- pred rows_cols(int::out, int::out, io::di, io::uo) is det.

     % Move the virtual cursor to given row and column; (0, 0) are the
     % coordinates for the upper left hand corner of the display.
     %
-:- pred move(int::in, int::in, io__state::di, io__state::uo) is det.
+:- pred move(int::in, int::in, io::di, io::uo) is det.

     % Clear the whole display.
     %
-:- pred clear(io__state::di, io__state::uo) is det.
+:- pred clear(io::di, io::uo) is det.

     % Output a character (with the given attributes) and advance the cursor.
     % Note that char codes are passed rather than plain chars.
     %
-:- pred addch(attr::in, int::in, io__state::di, io__state::uo) is det.
+:- pred addch(attr::in, int::in, io::di, io::uo) is det.

     % Output a string (with the given attributes) and advance the cursor.
     %
-:- pred addstr(attr::in, string::in, io__state::di, io__state::uo) is det.
+:- pred addstr(attr::in, string::in, io::di, io::uo) is det.

     % Turn on/off or set attributes that will be applied by default.
     %
-:- pred attr_on(attr::in, io__state::di, io__state::uo) is det.
-:- pred attr_off(attr::in, io__state::di, io__state::uo) is det.
-:- pred attr_set(attr::in, io__state::di, io__state::uo) is det.
+:- pred attr_on(attr::in, io::di, io::uo) is det.
+:- pred attr_off(attr::in, io::di, io::uo) is det.
+:- pred attr_set(attr::in, io::di, io::uo) is det.

     % Update the display.  Changes made to the display are not made
     % visible until refresh is called.
     %
-:- pred refresh(io__state::di, io__state::uo) is det.
+:- pred refresh(io::di, io::uo) is det.

     % This was supposed to do what refresh does but without preceding calls
     % to wnoutrefresh it does nothing.
     %
 :- pragma obsolete(doupdate/2).
-:- pred doupdate(io__state::di, io__state::uo) is det.
+:- pred doupdate(io::di, io::uo) is det.

     % Read a character from the keyboard (unbuffered) and translate it
     % if necessary.  In no-delay mode, if no input is waiting, the value
     % curs__err is returned.
     %
-:- pred getch(int::out, io__state::di, io__state::uo) is det.
+:- pred getch(int::out, io::di, io::uo) is det.

     % Throw away any typeahead that has not yet been read by the program.
     %
-:- pred flushinp(io__state::di, io__state::uo) is det.
-
-
+:- pred flushinp(io::di, io::uo) is det.

     % Draws a border around the inside edge of the display.
     %
-:- pred border(io__state::di, io__state::uo) is det.
+:- pred border(io::di, io::uo) is det.

     % Draws an horizontal line of char codes C length N moving to the right.
     %
-:- pred hline(int::in, int::in, io__state::di, io__state::uo) is det.
+:- pred hline(int::in, int::in, io::di, io::uo) is det.

     % Draws a vertical line of char codes C length N moving down.
     %
-:- pred vline(int::in, int::in, io__state::di, io__state::uo) is det.
-
-
+:- pred vline(int::in, int::in, io::di, io::uo) is det.

     % Error code; currently only used as return value of getch to
     % indicate that no input is ready.
     %
 :- func err = int.

-
-
     % Various key code translations outside the normal ASCII range.
     %
 :- func key_down = int.
@@ -189,8 +181,6 @@
 :- func acs_urcorner = int.             % +         upper right-hand corner
 :- func acs_vline = int.                % |         vertical line

-
-
     % Character attributes.
     %
 :- type attr.
@@ -220,8 +210,8 @@
 :- func cyan = colour.
 :- func white = colour.

-    % ------------------------------------------------------------------------ %
-    % ------------------------------------------------------------------------ %
+    %-------------------------------------------------------------------------%
+    %-------------------------------------------------------------------------%

         % Panels are windows over the main display; they may be
         % stacked, moved, ordered and hidden.  Contents of panels
@@ -229,11 +219,8 @@
         % they overlap that are lower in the stack.
         %
     :- module panel.
-
     :- interface.

-
-
     :- type panel.

         % new(Rows, Cols, Row, Col, Attr, Panel) creates a new panel
@@ -243,82 +230,71 @@
         % for the panel are set to Attr.
         %
     :- pred new(int::in, int::in, int::in, int::in, attr::in, panel::out,
-                io__state::di, io__state::uo) is det.
+        io::di, io::uo) is det.

         % Destroy a panel.
         %
-    :- pred delete(panel::in, io__state::di, io__state::uo) is det.
+    :- pred delete(panel::in, io::di, io::uo) is det.

         % Raise/lower a panel to the top/bottom of the stack.
         %
-    :- pred raise(panel::in, io__state::di, io__state::uo) is det.
-
-    :- pred lower(panel::in, io__state::di, io__state::uo) is det.
+    :- pred raise(panel::in, io::di, io::uo) is det.
+    :- pred lower(panel::in, io::di, io::uo) is det.

         % Hide/reveal a panel (revealing places it at the top of the stack).
         %
-    :- pred hide(panel::in, io__state::di, io__state::uo) is det.
-
-    :- pred reveal(panel::in, io__state::di, io__state::uo) is det.
+    :- pred hide(panel::in, io::di, io::uo) is det.
+    :- pred reveal(panel::in, io::di, io::uo) is det.

         % Move a panel to (Row, Col) on the display.
         %
-    :- pred relocate(panel::in, int::in, int::in,
-                io__state::di, io__state::uo) is det.
+    :- pred relocate(panel::in, int::in, int::in, io::di, io::uo) is det.

         % Clear a panel.
         %
-    :- pred clear(panel::in, io__state::di, io__state::uo) is det.
+    :- pred clear(panel::in, io::di, io::uo) is det.

         % Move the virtual cursor to given row and column; (0, 0) are the
         % coordinates for the upper left hand corner of the panel.
         %
-    :- pred move(panel::in, int::in, int::in,
-                io__state::di, io__state::uo) is det.
+    :- pred move(panel::in, int::in, int::in, io::di, io::uo) is det.

         % Add a char/string to a panel with the given attributes.
         % Note that char codes are passed rather than plain chars.
         %
-    :- pred addch(panel::in, attr::in, int::in,
-                io__state::di, io__state::uo) is det.
-
-    :- pred addstr(panel::in, attr::in, string::in,
-                io__state::di, io__state::uo) is det.
+    :- pred addch(panel::in, attr::in, int::in, io::di, io::uo) is det.
+    :- pred addstr(panel::in, attr::in, string::in, io::di, io::uo) is det.

         % Turn on/off or set attributes that will be applied by default.
         %
-    :- pred attr_on(panel::in, attr::in, io__state::di, io__state::uo) is det.
-    :- pred attr_off(panel::in, attr::in, io__state::di, io__state::uo) is det.
-    :- pred attr_set(panel::in, attr::in, io__state::di, io__state::uo) is det.
+    :- pred attr_on(panel::in, attr::in, io::di, io::uo) is det.
+    :- pred attr_off(panel::in, attr::in, io::di, io::uo) is det.
+    :- pred attr_set(panel::in, attr::in, io::di, io::uo) is det.

         % Update the display (also calls doupdate).
-        % NOTE that doupdate does not call update_panels.
+        % NOTE: doupdate does not call update_panels.
         %
-    :- pred update_panels(io__state::di, io__state::uo) is det.
-
-
+    :- pred update_panels(io::di, io::uo) is det.

         % Draws a border around the inside edge of the display.
         %
-    :- pred border(panel::in, io__state::di, io__state::uo) is det.
+    :- pred border(panel::in, io::di, io::uo) is det.

         % Draws an horizontal line of length N moving to the right.
         %
-    :- pred hline(panel::in, int::in, int::in,
-                io__state::di, io__state::uo) is det.
+    :- pred hline(panel::in, int::in, int::in, io::di, io::uo) is det.

         % Draws a vertical line of length N moving down.
         %
-    :- pred vline(panel::in, int::in, int::in,
-                io__state::di, io__state::uo) is det.
+    :- pred vline(panel::in, int::in, int::in, io::di, io::uo) is det.

     :- end_module panel.

-    % ------------------------------------------------------------------------ %
-    % ------------------------------------------------------------------------ %
+    %-------------------------------------------------------------------------%
+    %-------------------------------------------------------------------------%

-% ---------------------------------------------------------------------------- %
-% ---------------------------------------------------------------------------- %
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%

 :- implementation.

@@ -373,7 +349,7 @@

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

-:- pragma c_header_code("
+:- pragma foreign_decl("C", "

 #include <ncurses.h>
 #include <panel.h>
@@ -386,10 +362,12 @@

 ").

-% ---------------------------------------------------------------------------- %
+%-----------------------------------------------------------------------------%

-:- pragma foreign_proc("C", start(IO0::di, IO::uo),
-    [will_not_call_mercury, promise_pure], "
+:- pragma foreign_proc("C",
+    start(IO0::di, IO::uo),
+    [will_not_call_mercury, promise_pure],
+"

     initscr();                          /* Start the show */

@@ -471,136 +449,137 @@
     IO = IO0;
 ").

-% ---------------------------------------------------------------------------- %
-
-:- pragma foreign_proc("C", nodelay(BF::in, IO0::di, IO::uo),
-    [will_not_call_mercury, promise_pure], "
+%-----------------------------------------------------------------------------%

+:- pragma foreign_proc("C",
+    nodelay(BF::in, IO0::di, IO::uo),
+    [will_not_call_mercury, promise_pure],
+"
     nodelay(stdscr, BF);
     IO = IO0;
-
 ").

-% ---------------------------------------------------------------------------- %
-
-:- pragma foreign_proc("C", stop(IO0::di, IO::uo),
-    [will_not_call_mercury, promise_pure], "
+%----------------------------------------------------------------------------%

+:- pragma foreign_proc("C",
+    stop(IO0::di, IO::uo),
+    [will_not_call_mercury, promise_pure],
+"
     endwin();
     IO = IO0;
-
 ").

-% ---------------------------------------------------------------------------- %
+%-----------------------------------------------------------------------------%

-session(P) -->
-    start,
-    P,
-    stop.
+session(P, !IO) :-
+    start(!IO),
+    P(!IO),
+    stop(!IO).

-% ---------------------------------------------------------------------------- %
-
-:- pragma foreign_proc("C", rows_cols(Rows::out, Cols::out, IO0::di, IO::uo),
-    [will_not_call_mercury, promise_pure], "
+%----------------------------------------------------------------------------%

+:- pragma foreign_proc("C",
+    rows_cols(Rows::out, Cols::out, IO0::di, IO::uo),
+    [will_not_call_mercury, promise_pure],
+"
     getmaxyx(stdscr, Rows, Cols);
     IO = IO0;
-
 ").

-% ---------------------------------------------------------------------------- %
-
-:- pragma foreign_proc("C", move(Row::in, Col::in, IO0::di, IO::uo),
-    [will_not_call_mercury, promise_pure], "
+%----------------------------------------------------------------------------%

+:- pragma foreign_proc("C",
+    move(Row::in, Col::in, IO0::di, IO::uo),
+    [will_not_call_mercury, promise_pure],
+"
     move(Row, Col);
     IO = IO0;
-
 ").

-% ---------------------------------------------------------------------------- %
-
-:- pragma foreign_proc("C", clear(IO0::di, IO::uo),
-    [will_not_call_mercury, promise_pure], "
+%-----------------------------------------------------------------------------%

+:- pragma foreign_proc("C",
+    clear(IO0::di, IO::uo),
+    [will_not_call_mercury, promise_pure],
+"
     clear();
     IO = IO0;
-
 ").

-% ---------------------------------------------------------------------------- %
-
-:- pragma foreign_proc("C", addch(Attr::in, CharCode::in, IO0::di, IO::uo),
-    [will_not_call_mercury, promise_pure], "
+%-----------------------------------------------------------------------------%

+:- pragma foreign_proc("C",
+    addch(Attr::in, CharCode::in, IO0::di, IO::uo),
+    [will_not_call_mercury, promise_pure],
+"
     addch((chtype)Attr | (chtype)CharCode);
     IO = IO0;
-
 ").

-% ---------------------------------------------------------------------------- %
-
-addstr(Attr, Str) -->
-    string__foldl(
-        ( pred(Char::in, di, uo) is det --> addch(Attr, char__to_int(Char)) ),
-        Str
-    ).
-
-% ---------------------------------------------------------------------------- %
-
-:- pragma foreign_proc("C", attr_on(Attr::in, IO0::di, IO::uo),
-    [will_not_call_mercury, promise_pure], "
+%-----------------------------------------------------------------------------%

+addstr(Attr, Str, !IO) :-
+    string.foldl((pred(Char::in, !.IO::di, !:IO::uo) is det :-
+            addch(Attr, char.to_int(Char), !IO)
+        ), Str, !IO).
+
+%-----------------------------------------------------------------------------%
+
+:- pragma foreign_proc("C",
+    attr_on(Attr::in, IO0::di, IO::uo),
+    [will_not_call_mercury, promise_pure],
+"
     attron(Attr);
     IO = IO0;
-
 ").
-:- pragma foreign_proc("C", attr_off(Attr::in, IO0::di, IO::uo),
-    [will_not_call_mercury, promise_pure], "

+:- pragma foreign_proc("C",
+    attr_off(Attr::in, IO0::di, IO::uo),
+    [will_not_call_mercury, promise_pure],
+"
     attroff(Attr);
     IO = IO0;
-
 ").
-:- pragma foreign_proc("C", attr_set(Attr::in, IO0::di, IO::uo),
-    [will_not_call_mercury, promise_pure], "

+:- pragma foreign_proc("C",
+    attr_set(Attr::in, IO0::di, IO::uo),
+    [will_not_call_mercury, promise_pure],
+"
     attrset(Attr);
     IO = IO0;
-
 ").

-% ---------------------------------------------------------------------------- %
-
-:- pragma foreign_proc("C", refresh(IO0::di, IO::uo),
-    [will_not_call_mercury, promise_pure], "
+%-----------------------------------------------------------------------------%

+:- pragma foreign_proc("C",
+    refresh(IO0::di, IO::uo),
+    [will_not_call_mercury, promise_pure],
+"
     refresh();
     IO = IO0;
-
 ").

-% ---------------------------------------------------------------------------- %
-
-:- pragma foreign_proc("C", doupdate(IO0::di, IO::uo),
-    [will_not_call_mercury, promise_pure], "
+%-----------------------------------------------------------------------------%

+:- pragma foreign_proc("C",
+    doupdate(IO0::di, IO::uo),
+    [will_not_call_mercury, promise_pure],
+"
     doupdate();
     IO = IO0;
-
 ").

-% ---------------------------------------------------------------------------- %
-
-:- pragma foreign_proc("C", getch(CharCode::out, IO0::di, IO::uo),
-    [will_not_call_mercury, promise_pure], "
+%-----------------------------------------------------------------------------%

+:- pragma foreign_proc("C",
+    getch(CharCode::out, IO0::di, IO::uo),
+    [will_not_call_mercury, promise_pure],
+"
     CharCode = getch();
     IO = IO0;
-
 ").

-% ---------------------------------------------------------------------------- %
+%-----------------------------------------------------------------------------%

 :- pragma foreign_proc("C", flushinp(IO0::di, IO::uo),
     [will_not_call_mercury, promise_pure], "
@@ -610,233 +589,339 @@

 ").

-% ---------------------------------------------------------------------------- %
+%-----------------------------------------------------------------------------%

-:- pragma foreign_proc("C", err = (E::out),
-    [will_not_call_mercury, promise_pure], "
+:- pragma foreign_proc("C",
+    err = (E::out),
+    [will_not_call_mercury, promise_pure],
+"
     E = ERR;
 ").

-% ---------------------------------------------------------------------------- %
+%-----------------------------------------------------------------------------%

-:- pragma foreign_proc("C", key_down = (K::out),
-    [will_not_call_mercury, promise_pure], "
+:- pragma foreign_proc("C",
+    key_down = (K::out),
+    [will_not_call_mercury, promise_pure],
+"
     K = KEY_DOWN;
 ").
-:- pragma foreign_proc("C", key_up = (K::out),
-    [will_not_call_mercury, promise_pure], "
+:- pragma foreign_proc("C",
+    key_up = (K::out),
+    [will_not_call_mercury, promise_pure],
+"
     K = KEY_UP;
 ").
-:- pragma foreign_proc("C", key_left = (K::out),
-    [will_not_call_mercury, promise_pure], "
+:- pragma foreign_proc("C",
+    key_left = (K::out),
+    [will_not_call_mercury, promise_pure],
+"
     K = KEY_LEFT;
 ").
-:- pragma foreign_proc("C", key_right = (K::out),
-    [will_not_call_mercury, promise_pure], "
+:- pragma foreign_proc("C",
+    key_right = (K::out),
+    [will_not_call_mercury, promise_pure],
+"
     K = KEY_RIGHT;
 ").
-:- pragma foreign_proc("C", key_home = (K::out),
-    [will_not_call_mercury, promise_pure], "
+:- pragma foreign_proc("C",
+    key_home = (K::out),
+    [will_not_call_mercury, promise_pure],
+"
     K = KEY_HOME;
 ").
-:- pragma foreign_proc("C", key_backspace = (K::out),
-    [will_not_call_mercury, promise_pure], "
+:- pragma foreign_proc("C",
+    key_backspace = (K::out),
+    [will_not_call_mercury, promise_pure],
+"
     K = KEY_BACKSPACE;
 ").
-:- pragma foreign_proc("C", key_f(N::in) = (K::out),
-    [will_not_call_mercury, promise_pure], "
-    K = KEY_F( N);
-").
-:- pragma foreign_proc("C", key_del = (K::out),
-    [will_not_call_mercury, promise_pure], "
+:- pragma foreign_proc("C",
+    key_f(N::in) = (K::out),
+    [will_not_call_mercury, promise_pure],
+"
+    K = KEY_F(N);
+").
+:- pragma foreign_proc("C",
+    key_del = (K::out),
+    [will_not_call_mercury, promise_pure],
+"
     K = KEY_DC;
 ").
-:- pragma foreign_proc("C", key_ins = (K::out),
-    [will_not_call_mercury, promise_pure], "
+:- pragma foreign_proc("C",
+    key_ins = (K::out),
+    [will_not_call_mercury, promise_pure],
+"
     K = KEY_IC;
 ").
-:- pragma foreign_proc("C", key_pageup = (K::out),
-    [will_not_call_mercury, promise_pure], "
+
+:- pragma foreign_proc("C",
+    key_pageup = (K::out),
+    [will_not_call_mercury, promise_pure],
+"
     K = KEY_NPAGE;
 ").
-:- pragma foreign_proc("C", key_pagedown = (K::out),
-    [will_not_call_mercury, promise_pure], "
+
+:- pragma foreign_proc("C",
+    key_pagedown = (K::out),
+    [will_not_call_mercury, promise_pure],
+"
     K = KEY_PPAGE;
 ").
-:- pragma foreign_proc("C", key_a1 = (K::out),
-    [will_not_call_mercury, promise_pure], "
+
+:- pragma foreign_proc("C",
+    key_a1 = (K::out),
+    [will_not_call_mercury, promise_pure],
+"
     K = KEY_A1;
 ").
-:- pragma foreign_proc("C", key_a3 = (K::out),
-    [will_not_call_mercury, promise_pure], "
+
+:- pragma foreign_proc("C",
+    key_a3 = (K::out),
+    [will_not_call_mercury, promise_pure],
+"
     K = KEY_A3;
 ").
-:- pragma foreign_proc("C", key_b2 = (K::out),
-    [will_not_call_mercury, promise_pure], "
+
+:- pragma foreign_proc("C",
+    key_b2 = (K::out),
+    [will_not_call_mercury, promise_pure],
+"
     K = KEY_B2;
 ").
-:- pragma foreign_proc("C", key_c1 = (K::out),
-    [will_not_call_mercury, promise_pure], "
+
+:- pragma foreign_proc("C",
+    key_c1 = (K::out),
+    [will_not_call_mercury, promise_pure],
+"
     K = KEY_C1;
 ").
-:- pragma foreign_proc("C", key_c3 = (K::out),
-    [will_not_call_mercury, promise_pure], "
+
+:- pragma foreign_proc("C",
+    key_c3 = (K::out),
+    [will_not_call_mercury, promise_pure],
+"
     K = KEY_C3;
 ").
-:- pragma foreign_proc("C", key_enter = (K::out),
-    [will_not_call_mercury, promise_pure], "
+
+:- pragma foreign_proc("C",
+    key_enter = (K::out),
+    [will_not_call_mercury, promise_pure],
+"
     K = KEY_ENTER;
 ").
-:- pragma foreign_proc("C", key_end = (K::out),
-    [will_not_call_mercury, promise_pure], "
+
+:- pragma foreign_proc("C",
+    key_end = (K::out),
+    [will_not_call_mercury, promise_pure],
+"
     K = KEY_END;
 ").
-:- pragma foreign_proc("C", key_resize = (K::out),
-    [will_not_call_mercury, promise_pure], "
+
+:- pragma foreign_proc("C",
+    key_resize = (K::out),
+    [will_not_call_mercury, promise_pure],
+"
     K = KEY_RESIZE;
 ").

-% ---------------------------------------------------------------------------- %
+%-----------------------------------------------------------------------------%

-:- pragma foreign_proc("C", acs_block = (C::out),
-    [will_not_call_mercury, promise_pure], "
+:- pragma foreign_proc("C",
+    acs_block = (C::out),
+    [will_not_call_mercury, promise_pure],
+"
     C = ACS_BLOCK;
 ").
-:- pragma foreign_proc("C", acs_board = (C::out),
-    [will_not_call_mercury, promise_pure], "
+
+:- pragma foreign_proc("C",
+    acs_board = (C::out),
+    [will_not_call_mercury, promise_pure],
+"
     C = ACS_BOARD;
 ").
-:- pragma foreign_proc("C", acs_btee = (C::out),
-    [will_not_call_mercury, promise_pure], "
+
+:- pragma foreign_proc("C",
+    acs_btee = (C::out),
+    [will_not_call_mercury, promise_pure],
+"
     C = ACS_BTEE;
 ").
-:- pragma foreign_proc("C", acs_bullet = (C::out),
-    [will_not_call_mercury, promise_pure], "
+
+:- pragma foreign_proc("C",
+    acs_bullet = (C::out),
+    [will_not_call_mercury, promise_pure],
+"
     C = ACS_BULLET;
 ").
-:- pragma foreign_proc("C", acs_ckboard = (C::out),
-    [will_not_call_mercury, promise_pure], "
+
+:- pragma foreign_proc("C",
+    acs_ckboard = (C::out),
+    [will_not_call_mercury, promise_pure],
+"
     C = ACS_CKBOARD;
 ").
-:- pragma foreign_proc("C", acs_darrow = (C::out),
-    [will_not_call_mercury, promise_pure], "
+
+:- pragma foreign_proc("C",
+    acs_darrow = (C::out),
+    [will_not_call_mercury, promise_pure],
+"
     C = ACS_DARROW;
 ").
-:- pragma foreign_proc("C", acs_degree = (C::out),
-    [will_not_call_mercury, promise_pure], "
+
+:- pragma foreign_proc("C",
+    acs_degree = (C::out),
+    [will_not_call_mercury, promise_pure],
+"
     C = ACS_DEGREE;
 ").
-:- pragma foreign_proc("C", acs_diamond = (C::out),
-    [will_not_call_mercury, promise_pure], "
+
+:- pragma foreign_proc("C",
+    acs_diamond = (C::out),
+    [will_not_call_mercury, promise_pure],
+"
     C = ACS_DIAMOND;
 ").
-:- pragma foreign_proc("C", acs_gequal = (C::out),
-    [will_not_call_mercury, promise_pure], "
+
+:- pragma foreign_proc("C",
+    acs_gequal = (C::out),
+    [will_not_call_mercury, promise_pure],
+"
     C = ACS_GEQUAL;
 ").
-:- pragma foreign_proc("C", acs_hline = (C::out),
-    [will_not_call_mercury, promise_pure], "
+
+:- pragma foreign_proc("C",
+    acs_hline = (C::out),
+    [will_not_call_mercury, promise_pure],
+"
     C = ACS_HLINE;
 ").
-:- pragma foreign_proc("C", acs_lantern = (C::out),
-    [will_not_call_mercury, promise_pure], "
+
+:- pragma foreign_proc("C",
+    acs_lantern = (C::out),
+    [will_not_call_mercury, promise_pure],
+"
     C = ACS_LANTERN;
 ").
-:- pragma foreign_proc("C", acs_larrow = (C::out),
-    [will_not_call_mercury, promise_pure], "
+
+:- pragma foreign_proc("C",
+    acs_larrow = (C::out),
+    [will_not_call_mercury, promise_pure],
+"
     C = ACS_LARROW;
 ").
-:- pragma foreign_proc("C", acs_lequal = (C::out),
+
+:- pragma foreign_proc("C",
+    acs_lequal = (C::out),
     [will_not_call_mercury, promise_pure], "
     C = ACS_LEQUAL;
 ").
+
 :- pragma foreign_proc("C", acs_llcorner = (C::out),
     [will_not_call_mercury, promise_pure], "
     C = ACS_LLCORNER;
 ").
+
 :- pragma foreign_proc("C", acs_lrcorner = (C::out),
     [will_not_call_mercury, promise_pure], "
     C = ACS_LRCORNER;
 ").
+
 :- pragma foreign_proc("C", acs_ltee = (C::out),
     [will_not_call_mercury, promise_pure], "
     C = ACS_LTEE;
 ").
+
 :- pragma foreign_proc("C", acs_nequal = (C::out),
     [will_not_call_mercury, promise_pure], "
     C = ACS_NEQUAL;
 ").
+
 :- pragma foreign_proc("C", acs_pi = (C::out),
     [will_not_call_mercury, promise_pure], "
     C = ACS_PI;
 ").
+
 :- pragma foreign_proc("C", acs_plminus = (C::out),
     [will_not_call_mercury, promise_pure], "
     C = ACS_PLMINUS;
 ").
+
 :- pragma foreign_proc("C", acs_plus = (C::out),
     [will_not_call_mercury, promise_pure], "
     C = ACS_PLUS;
 ").
+
 :- pragma foreign_proc("C", acs_rarrow = (C::out),
     [will_not_call_mercury, promise_pure], "
     C = ACS_RARROW;
 ").
+
 :- pragma foreign_proc("C", acs_rtee = (C::out),
     [will_not_call_mercury, promise_pure], "
     C = ACS_RTEE;
 ").
+
 :- pragma foreign_proc("C", acs_s1 = (C::out),
     [will_not_call_mercury, promise_pure], "
     C = ACS_S1;
 ").
+
 :- pragma foreign_proc("C", acs_s3 = (C::out),
     [will_not_call_mercury, promise_pure], "
     C = ACS_S3;
 ").
+
 :- pragma foreign_proc("C", acs_s7 = (C::out),
     [will_not_call_mercury, promise_pure], "
     C = ACS_S7;
 ").
+
 :- pragma foreign_proc("C", acs_s9 = (C::out),
     [will_not_call_mercury, promise_pure], "
     C = ACS_S9;
 ").
+
 :- pragma foreign_proc("C", acs_sterling = (C::out),
     [will_not_call_mercury, promise_pure], "
     C = ACS_STERLING;
 ").
+
 :- pragma foreign_proc("C", acs_ttee = (C::out),
     [will_not_call_mercury, promise_pure], "
     C = ACS_TTEE;
 ").
+
 :- pragma foreign_proc("C", acs_uarrow = (C::out),
     [will_not_call_mercury, promise_pure], "
     C = ACS_UARROW;
 ").
+
 :- pragma foreign_proc("C", acs_ulcorner = (C::out),
     [will_not_call_mercury, promise_pure], "
     C = ACS_ULCORNER;
 ").
+
 :- pragma foreign_proc("C", acs_urcorner = (C::out),
     [will_not_call_mercury, promise_pure], "
     C = ACS_URCORNER;
 ").
+
 :- pragma foreign_proc("C", acs_vline = (C::out),
     [will_not_call_mercury, promise_pure], "
     C = ACS_VLINE;
 ").

-% ---------------------------------------------------------------------------- %
-
-:- pragma foreign_proc("C", curs.((Attr1::in) + (Attr2::in)) = (Attr::out),
-    [will_not_call_mercury, promise_pure], "
+%-----------------------------------------------------------------------------%

+:- pragma foreign_proc("C",
+    curs.((Attr1::in) + (Attr2::in)) = (Attr::out),
+    [will_not_call_mercury, promise_pure],
+"
     Attr = (chtype)Attr1 | (chtype)Attr2;
-
 ").

-% ---------------------------------------------------------------------------- %
+%-----------------------------------------------------------------------------%

 :- pragma foreign_proc("C", normal = (A::out),
     [will_not_call_mercury, promise_pure], "
@@ -875,280 +960,294 @@
     A = COLOR_PAIR(FG_BG(Fg, Bg));
 ").

-% ---------------------------------------------------------------------------- %
+%-----------------------------------------------------------------------------%

-:- pragma foreign_proc("C", black = (C::out),
-    [will_not_call_mercury, promise_pure], "
+:- pragma foreign_proc("C",
+    black = (C::out),
+    [will_not_call_mercury, promise_pure],
+"
     C = COLOR_BLACK;
 ").
-:- pragma foreign_proc("C", red = (C::out),
-    [will_not_call_mercury, promise_pure], "
+
+:- pragma foreign_proc("C",
+    red = (C::out),
+    [will_not_call_mercury, promise_pure],
+"
     C = COLOR_RED;
 ").
-:- pragma foreign_proc("C", green = (C::out),
-    [will_not_call_mercury, promise_pure], "
+
+:- pragma foreign_proc("C",
+    green = (C::out),
+    [will_not_call_mercury, promise_pure],
+"
     C = COLOR_GREEN;
 ").
-:- pragma foreign_proc("C", yellow = (C::out),
-    [will_not_call_mercury, promise_pure], "
+
+:- pragma foreign_proc("C",
+    yellow = (C::out),
+    [will_not_call_mercury, promise_pure],
+"
     C = COLOR_YELLOW;
 ").
-:- pragma foreign_proc("C", blue = (C::out),
-    [will_not_call_mercury, promise_pure], "
+
+:- pragma foreign_proc("C",
+    blue = (C::out),
+    [will_not_call_mercury, promise_pure],
+"
     C = COLOR_BLUE;
 ").
-:- pragma foreign_proc("C", magenta = (C::out),
-    [will_not_call_mercury, promise_pure], "
+
+:- pragma foreign_proc("C",
+    magenta = (C::out),
+    [will_not_call_mercury, promise_pure],
+"
     C = COLOR_MAGENTA;
 ").
-:- pragma foreign_proc("C", cyan = (C::out),
-    [will_not_call_mercury, promise_pure], "
+
+:- pragma foreign_proc("C",
+    cyan = (C::out),
+    [will_not_call_mercury, promise_pure],
+"
     C = COLOR_CYAN;
 ").
-:- pragma foreign_proc("C", white = (C::out),
-    [will_not_call_mercury, promise_pure], "
+
+:- pragma foreign_proc("C",
+    white = (C::out),
+    [will_not_call_mercury, promise_pure],
+"
     C = COLOR_WHITE;
 ").

-% ---------------------------------------------------------------------------- %
-
-:- pragma foreign_proc("C", border(IO0::di, IO::uo),
-    [will_not_call_mercury, promise_pure], "
+%-----------------------------------------------------------------------------%

+:- pragma foreign_proc("C",
+    border(IO0::di, IO::uo),
+    [will_not_call_mercury, promise_pure],
+"
     border(0, 0, 0, 0, 0, 0, 0, 0);
     IO = IO0;
-
 ").

-:- pragma foreign_proc("C", hline(C::in, N::in, IO0::di, IO::uo),
-    [will_not_call_mercury, promise_pure], "
-
+:- pragma foreign_proc("C",
+    hline(C::in, N::in, IO0::di, IO::uo),
+    [will_not_call_mercury, promise_pure],
+"
     hline(C, N);
     IO = IO0;
-
 ").

-:- pragma foreign_proc("C", vline(C::in, N::in, IO0::di, IO::uo),
-    [will_not_call_mercury, promise_pure], "
-
+:- pragma foreign_proc("C",
+    vline(C::in, N::in, IO0::di, IO::uo),
+    [will_not_call_mercury, promise_pure],
+"
     vline(C, N);
     IO = IO0;
-
 ").

-    % ------------------------------------------------------------------------ %
-    % ------------------------------------------------------------------------ %
+    %-------------------------------------------------------------------------%
+    %-------------------------------------------------------------------------%

     :- module panel.

     :- implementation.

-    :- type panel == c_pointer.
+    %-------------------------------------------------------------------------%

-    % ------------------------------------------------------------------------ %
-
-    :- pragma c_header_code("
+    :- pragma foreign_decl("C", "

     #include <ncurses.h>
     #include <panel.h>

     ").

-    % ------------------------------------------------------------------------ %
+    :- pragma foreign_type("C", panel, "PANEL *").

-    :- pragma foreign_proc("C", new(Rows::in, Cols::in, Row::in, Col::in, Attr::in,
-                            Panel::out, IO0::di, IO::uo),
-        [will_not_call_mercury, promise_pure], "
+    %-------------------------------------------------------------------------%

+    :- pragma foreign_proc("C",
+        new(Rows::in, Cols::in, Row::in, Col::in, Attr::in, Panel::out,
+            IO0::di, IO::uo),
+        [will_not_call_mercury, promise_pure],
+    "
         WINDOW *w = newwin(Rows, Cols, Row, Col);
         scrollok(w, TRUE);
         wattrset(w, Attr);
         wcolor_set(w, Attr, NULL);
         wclear(w);
-        (PANEL *)Panel = new_panel(w);
+            Panel = new_panel(w);

         IO = IO0;
-
     ").

-    % ------------------------------------------------------------------------ %
-
-    :- pragma foreign_proc("C", delete(Panel::in, IO0::di, IO::uo),
-        [will_not_call_mercury, promise_pure], "
+    %-------------------------------------------------------------------------%

-        delwin(panel_window((PANEL *)Panel));
-        del_panel((PANEL *)Panel);
+    :- pragma foreign_proc("C",
+        delete(Panel::in, IO0::di, IO::uo),
+        [will_not_call_mercury, promise_pure],
+    "
+        delwin(panel_window(Panel));
+        del_panel(Panel);

         IO = IO0;
-
     ").

-    % ------------------------------------------------------------------------ %
-
-    :- pragma foreign_proc("C", raise(Panel::in, IO0::di, IO::uo),
-        [will_not_call_mercury, promise_pure], "
-
-        top_panel((PANEL *)Panel);
+    %-------------------------------------------------------------------------%

+    :- pragma foreign_proc("C",
+        raise(Panel::in, IO0::di, IO::uo),
+        [will_not_call_mercury, promise_pure],
+    "
+        top_panel(Panel);
         IO = IO0;
-
     ").

-    % ------------------------------------------------------------------------ %
-
-    :- pragma foreign_proc("C", lower(Panel::in, IO0::di, IO::uo),
-        [will_not_call_mercury, promise_pure], "
-
-        bottom_panel((PANEL *)Panel);
+    %-------------------------------------------------------------------------%

+    :- pragma foreign_proc("C",
+        lower(Panel::in, IO0::di, IO::uo),
+        [will_not_call_mercury, promise_pure],
+    "
+        bottom_panel(Panel);
         IO = IO0;
-
     ").

-    % ------------------------------------------------------------------------ %
-
-    :- pragma foreign_proc("C", hide(Panel::in, IO0::di, IO::uo),
-        [will_not_call_mercury, promise_pure], "
-
-        hide_panel((PANEL *)Panel);
+    %-------------------------------------------------------------------------%

+    :- pragma foreign_proc("C",
+        hide(Panel::in, IO0::di, IO::uo),
+        [will_not_call_mercury, promise_pure],
+    "
+        hide_panel(Panel);
         IO = IO0;
-
     ").

-    % ------------------------------------------------------------------------ %
-
-    :- pragma foreign_proc("C", reveal(Panel::in, IO0::di, IO::uo),
-        [will_not_call_mercury, promise_pure], "
-
-        show_panel((PANEL *)Panel);
+    %-------------------------------------------------------------------------%

+    :- pragma foreign_proc("C",
+        reveal(Panel::in, IO0::di, IO::uo),
+        [will_not_call_mercury, promise_pure],
+    "
+        show_panel(Panel);
         IO = IO0;
-
     ").

-    % ------------------------------------------------------------------------ %
-
-    :- pragma foreign_proc("C", relocate(Panel::in, Row::in, Col::in, IO0::di, IO::uo),
-        [will_not_call_mercury, promise_pure], "
-
-        move_panel((PANEL *)Panel, Row, Col);
+    %-------------------------------------------------------------------------%

+    :- pragma foreign_proc("C",
+        relocate(Panel::in, Row::in, Col::in, IO0::di, IO::uo),
+        [will_not_call_mercury, promise_pure],
+    "
+        move_panel(Panel, Row, Col);
         IO = IO0;
-
     ").

-    % ------------------------------------------------------------------------ %
-
-    :- pragma foreign_proc("C", clear(Panel::in, IO0::di, IO::uo),
-        [will_not_call_mercury, promise_pure], "
-
-        wclear(panel_window((PANEL *)Panel));
+    %-------------------------------------------------------------------------%

+    :- pragma foreign_proc("C",
+        clear(Panel::in, IO0::di, IO::uo),
+        [will_not_call_mercury, promise_pure],
+    "
+        wclear(panel_window(Panel));
         IO = IO0;
-
     ").

-    % ------------------------------------------------------------------------ %
-
-    :- pragma foreign_proc("C", move(Panel::in, Row::in, Col::in, IO0::di, IO::uo),
-        [will_not_call_mercury, promise_pure], "
-
-        wmove(panel_window((PANEL *)Panel), Row, Col);
+    %-------------------------------------------------------------------------%

+    :- pragma foreign_proc("C",
+        move(Panel::in, Row::in, Col::in, IO0::di, IO::uo),
+        [will_not_call_mercury, promise_pure],
+    "
+        wmove(panel_window(Panel), Row, Col);
         IO = IO0;
-
     ").

-    % ------------------------------------------------------------------------ %
-
-    :- pragma foreign_proc("C", addch(Panel::in, Attr::in, CharCode::in, IO0::di, IO::uo),
-        [will_not_call_mercury, promise_pure], "
-
-        waddch(panel_window((PANEL *)Panel), (chtype)Attr | (chtype)CharCode);
+    %-------------------------------------------------------------------------%

+    :- pragma foreign_proc("C",
+        addch(Panel::in, Attr::in, CharCode::in, IO0::di, IO::uo),
+        [will_not_call_mercury, promise_pure],
+    "
+        waddch(panel_window(Panel), (chtype)Attr | (chtype)CharCode);
         IO = IO0;
-
     ").

-    % ------------------------------------------------------------------------ %
+    %-------------------------------------------------------------------------%

-    addstr(Panel, Attr, Str) -->
-        string__foldl(
-            ( pred(Char::in, di, uo) is det -->
-                addch(Panel, Attr, char__to_int(Char))
+    addstr(Panel, Attr, Str, !IO) :-
+        string.foldl(
+            ( pred(Char::in, !.IO::di, !:IO::uo) is det :-
+                addch(Panel, Attr, char.to_int(Char), !IO)
             ),
-            Str
+            Str, !IO
         ).

-    % ------------------------------------------------------------------------ %
-
-    :- pragma foreign_proc("C", attr_on(Panel::in, Attr::in, IO0::di, IO::uo),
-        [will_not_call_mercury, promise_pure], "
+    %-------------------------------------------------------------------------%

-        wattron(panel_window((PANEL *)Panel), Attr);
+    :- pragma foreign_proc("C",
+        attr_on(Panel::in, Attr::in, IO0::di, IO::uo),
+        [will_not_call_mercury, promise_pure],
+    "
+        wattron(panel_window(Panel), Attr);
         IO = IO0;
-
     ").
-    :- pragma foreign_proc("C", attr_off(Panel::in, Attr::in, IO0::di, IO::uo),
-        [will_not_call_mercury, promise_pure], "

-        wattroff(panel_window((PANEL *)Panel), Attr);
+    :- pragma foreign_proc("C",
+        attr_off(Panel::in, Attr::in, IO0::di, IO::uo),
+        [will_not_call_mercury, promise_pure],
+    "
+        wattroff(panel_window(Panel), Attr);
         IO = IO0;
-
     ").
-    :- pragma foreign_proc("C", attr_set(Panel::in, Attr::in, IO0::di, IO::uo),
-        [will_not_call_mercury, promise_pure], "

-        wattrset(panel_window((PANEL *)Panel), Attr);
+    :- pragma foreign_proc("C",
+        attr_set(Panel::in, Attr::in, IO0::di, IO::uo),
+        [will_not_call_mercury, promise_pure],
+    "
+        wattrset(panel_window(Panel), Attr);
         IO = IO0;
-
     ").

-    % ------------------------------------------------------------------------ %
-
-    :- pragma foreign_proc("C", update_panels(IO0::di, IO::uo),
-        [will_not_call_mercury, promise_pure], "
+    %-------------------------------------------------------------------------%

+    :- pragma foreign_proc("C",
+        update_panels(IO0::di, IO::uo),
+        [will_not_call_mercury, promise_pure],
+    "
         update_panels();
         doupdate();
-
         IO = IO0;
-
     ").

-    % ------------------------------------------------------------------------ %
-
-    :- pragma foreign_proc("C", border(Panel::in, IO0::di, IO::uo),
-        [will_not_call_mercury, promise_pure], "
+    %-------------------------------------------------------------------------%

-        wborder(panel_window((PANEL *)Panel), 0, 0, 0, 0, 0, 0, 0, 0);
+    :- pragma foreign_proc("C",
+        border(Panel::in, IO0::di, IO::uo),
+        [will_not_call_mercury, promise_pure],
+    "
+        wborder(panel_window(Panel), 0, 0, 0, 0, 0, 0, 0, 0);
         IO = IO0;
-
     ").

-    :- pragma foreign_proc("C", hline(Panel::in, C::in, N::in, IO0::di, IO::uo),
-        [will_not_call_mercury, promise_pure], "
-
-        whline(panel_window((PANEL *)Panel), C, N);
+    :- pragma foreign_proc("C",
+        hline(Panel::in, C::in, N::in, IO0::di, IO::uo),
+        [will_not_call_mercury, promise_pure],
+    "
+        whline(panel_window(Panel), C, N);
         IO = IO0;
-
     ").

-    :- pragma foreign_proc("C", vline(Panel::in, C::in, N::in, IO0::di, IO::uo),
-        [will_not_call_mercury, promise_pure], "
-
-        wvline(panel_window((PANEL *)Panel), C, N);
+    :- pragma foreign_proc("C",
+        vline(Panel::in, C::in, N::in, IO0::di, IO::uo),
+        [will_not_call_mercury, promise_pure],
+    "
+        wvline(panel_window(Panel), C, N);
         IO = IO0;
-
     ").

-    % ------------------------------------------------------------------------ %
-
+    %-------------------------------------------------------------------------%
     :- end_module panel.
+    %-------------------------------------------------------------------------%
+    %-------------------------------------------------------------------------%

-    % ------------------------------------------------------------------------ %
-    % ------------------------------------------------------------------------ %
-
-% ---------------------------------------------------------------------------- %
-% ---------------------------------------------------------------------------- %
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
Index: samples/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/curs/samples/Mmakefile,v
retrieving revision 1.1
diff -u -b -r1.1 Mmakefile
--- samples/Mmakefile	21 Feb 2001 16:55:16 -0000	1.1
+++ samples/Mmakefile	20 Apr 2006 08:10:45 -0000
@@ -5,17 +5,25 @@
 #   BY THE ADMINISTRATORS OF THE MERCURY PROJECT.


-
 # Specify the location of the `mypackage' and `myotherlib' directories
+#
 CURS_DIR = ..

+DEMOS = demo nibbles frogger
+
+depend:	$(DEMOS:%=%.depend)
+all: demos
+clean: $(DEMOS:%=%.clean)
+realclean: $(DEMOS:%=%.realclean)
+demos: $(DEMOS)
+
 # The following stuff tells Mmake to use the two libraries
 VPATH = $(CURS_DIR):$(MMAKE_VPATH)
 MCFLAGS = -I$(CURS_DIR) $(EXTRA_MCFLAGS)
+MGNUCFLAGS = -I$(CURS_DIR)
 MLFLAGS = -R$(CURS_DIR) $(EXTRA_MLFLAGS) \
           -L$(CURS_DIR)
 MLLIBS = -lcurs -lpanel -lncurses $(EXTRA_MLLIBS)
 C2INITARGS = $(CURS_DIR)/curs.init

-MAIN_TARGET = demo
-depend: $(MAIN_TARGET).depend
+MAIN_TARGET = all
Index: samples/demo.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/curs/samples/demo.m,v
retrieving revision 1.1
diff -u -b -r1.1 demo.m
--- samples/demo.m	21 Feb 2001 16:55:16 -0000	1.1
+++ samples/demo.m	20 Apr 2006 08:05:54 -0000
@@ -1,4 +1,4 @@
-% ---------------------------------------------------------------------------- %
+%-----------------------------------------------------------------------------%
 % Copyright (C) 2001 Ralph Becket <rbeck at microsoft.com>
 % Tue Jan 23 10:05:05 GMT 2001
 % vim: ts=4 sw=4 et tw=0 wm=0 ff=unix ft=mercury
@@ -8,25 +8,29 @@
 %   BE RELEASED UNDER WHATEVER LICENCE IS DEEMED APPROPRIATE
 %   BY THE ADMINISTRATORS OF THE MERCURY PROJECT.
 %
-%
-% ---------------------------------------------------------------------------- %
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%

 :- module demo.
-
 :- interface.

 :- import_module io.

+:- pred main(io::di, io::uo) is det.

+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%

-:- pred main(io__state::di, io__state::uo) is det.
+:- implementation.

-% ---------------------------------------------------------------------------- %
-% ---------------------------------------------------------------------------- %
+:- import_module curs.
+:- import_module curs.panel.

-:- implementation.
+:- import_module int.
+:- import_module list.
+:- import_module string.

-:- import_module int, list, string, curs, curs__panel.
+%-----------------------------------------------------------------------------%

 :- type panel_data
     --->    panel_data(
@@ -35,103 +39,110 @@
                 col     ::  int
             ).

-% ---------------------------------------------------------------------------- %
+%-----------------------------------------------------------------------------%

-main -->
+main(!IO) :-

-    start,
+    start(!IO),

-    rows_cols(Rows, Cols),
-    { MidRow = Rows // 2 },
-    { MidCol = Cols // 2 },
-    { PanelRows = MidRow // 2 },
-    { PanelCols = MidCol // 2 },
-
-    move(0, 0),
-    addstr(normal, string__format("display size: %dx%d", [i(Rows), i(Cols)])),
-    move(1, 0),
-    addstr(normal, "1 2 3 4 : select & raise panel"),
-    move(2, 0),
-    addch(normal, acs_larrow), addch(normal, 0' ),
-    addch(normal, acs_darrow), addch(normal, 0' ),
-    addch(normal, acs_uarrow), addch(normal, 0' ),
-    addch(normal, acs_rarrow), addch(normal, 0' ),
-    addstr(normal, ": move panel"),
-    move(3, 0),
-    addstr(normal, "      q : quit"),
-
-    { R1 = MidRow - PanelRows - 1, C1 = MidCol - PanelCols - 1 },
-    { R2 = MidRow - PanelRows - 2, C2 = MidCol             - 2 },
-    { R3 = MidRow             - 3, C3 = MidCol - PanelCols - 3 },
-    { R4 = MidRow             - 4, C4 = MidCol             - 4 },
-
-    new(PanelRows, PanelCols, R1, C1, fg_bg(black, yellow), Panel1),
-    new(PanelRows, PanelCols, R2, C2, fg_bg(white, blue  ), Panel2),
-    new(PanelRows, PanelCols, R3, C3, fg_bg(black, green ), Panel3),
-    new(PanelRows, PanelCols, R4, C4, fg_bg(white, red   ), Panel4),
-
-    border(Panel1), move(Panel1, 0, 1), addstr(Panel1, normal, " 1 "),
-    border(Panel2), move(Panel2, 0, 1), addstr(Panel2, normal, " 2 "),
-    border(Panel3), move(Panel3, 0, 1), addstr(Panel3, normal, " 3 "),
-    border(Panel4), move(Panel4, 0, 1), addstr(Panel4, normal, " 4 "),
+    rows_cols(Rows, Cols, !IO),
+    MidRow = Rows // 2,
+    MidCol = Cols // 2,
+    PanelRows = MidRow // 2,
+    PanelCols = MidCol // 2,
+
+    move(0, 0, !IO),
+    addstr(normal, string.format("display size: %dx%d", [i(Rows), i(Cols)]),
+        !IO),
+    move(1, 0, !IO),
+    addstr(normal, "1 2 3 4 : select & raise panel", !IO),
+    move(2, 0, !IO),
+    addch(normal, acs_larrow, !IO), addch(normal, 0' , !IO),
+    addch(normal, acs_darrow, !IO), addch(normal, 0' , !IO),
+    addch(normal, acs_uarrow, !IO), addch(normal, 0' , !IO),
+    addch(normal, acs_rarrow, !IO), addch(normal, 0' , !IO),
+    addstr(normal, ": move panel", !IO),
+    move(3, 0, !IO),
+    addstr(normal, "      q : quit", !IO),
+
+    R1 = MidRow - PanelRows - 1, C1 = MidCol - PanelCols - 1,
+    R2 = MidRow - PanelRows - 2, C2 = MidCol             - 2,
+    R3 = MidRow             - 3, C3 = MidCol - PanelCols - 3,
+    R4 = MidRow             - 4, C4 = MidCol             - 4,
+
+    new(PanelRows, PanelCols, R1, C1, fg_bg(black, yellow), Panel1, !IO),
+    new(PanelRows, PanelCols, R2, C2, fg_bg(white, blue  ), Panel2, !IO),
+    new(PanelRows, PanelCols, R3, C3, fg_bg(black, green ), Panel3, !IO),
+    new(PanelRows, PanelCols, R4, C4, fg_bg(white, red   ), Panel4, !IO),
+
+    border(Panel1, !IO),
+    move(Panel1, 0, 1, !IO),
+    addstr(Panel1, normal, " 1 ", !IO),
+
+    border(Panel2, !IO),
+    move(Panel2, 0, 1, !IO),
+    addstr(Panel2, normal, " 2 ", !IO),
+
+    border(Panel3, !IO),
+    move(Panel3, 0, 1, !IO),
+    addstr(Panel3, normal, " 3 ", !IO),
+
+    border(Panel4, !IO),
+    move(Panel4, 0, 1, !IO),
+    addstr(Panel4, normal, " 4 ", !IO),

-    { PanelData = [
+    PanelData = [
         panel_data(Panel1, R1, C1),
         panel_data(Panel2, R2, C2),
         panel_data(Panel3, R3, C3),
         panel_data(Panel4, R4, C4)
-    ] },
-
-    main_loop(1, PanelData),
-
-    stop.
-
-% ---------------------------------------------------------------------------- %
-
-:- pred main_loop(int, list(panel_data), io__state, io__state).
-:- mode main_loop(in, in, di, uo) is det.
+    ],

-main_loop(P, PanelData) -->
+    main_loop(1, PanelData, !IO),

-    update_panels,
+    stop(!IO).

-    getch(K),
+%-----------------------------------------------------------------------------%

-    (      if { K = key_left  } then move_panel(P, PanelData,  0, -1)
-      else if { K = key_right } then move_panel(P, PanelData,  0,  1)
-      else if { K = key_up    } then move_panel(P, PanelData, -1,  0)
-      else if { K = key_down  } then move_panel(P, PanelData,  1,  0)
-      else if { K = 0'1       } then raise_panel(1, PanelData)
-      else if { K = 0'2       } then raise_panel(2, PanelData)
-      else if { K = 0'3       } then raise_panel(3, PanelData)
-      else if { K = 0'4       } then raise_panel(4, PanelData)
-      else if { K = 0'q       } then []
-      else main_loop(P, PanelData)
+:- pred main_loop(int::in, list(panel_data)::in, io::di, io::uo) is det.
+
+main_loop(P, PanelData, !IO) :-
+    update_panels(!IO),
+    getch(K, !IO),
+    (      if K = key_left  then move_panel(P, PanelData,  0, -1, !IO)
+      else if K = key_right then move_panel(P, PanelData,  0,  1, !IO)
+      else if K = key_up    then move_panel(P, PanelData, -1,  0, !IO)
+      else if K = key_down  then move_panel(P, PanelData,  1,  0, !IO)
+      else if K = 0'1       then raise_panel(1, PanelData, !IO)
+      else if K = 0'2       then raise_panel(2, PanelData, !IO)
+      else if K = 0'3       then raise_panel(3, PanelData, !IO)
+      else if K = 0'4       then raise_panel(4, PanelData, !IO)
+      else if K = 0'q       then true
+      else main_loop(P, PanelData, !IO)
     ).

-% ---------------------------------------------------------------------------- %
+%-----------------------------------------------------------------------------%

-:- pred move_panel(int, list(panel_data), int, int, io__state, io__state).
-:- mode move_panel(in, in, in, in, di, uo) is det.
+:- pred move_panel(int::in, list(panel_data)::in, int::in, int::in,
+    io::di, io::uo) is det.

-move_panel(P, PanelData0, DR, DC) -->
-    { PD0 = list__index1_det(PanelData0, P) },
-    { PD  = ((PD0
+move_panel(P, PanelData0, DR, DC, !IO) :-
+    PD0 = list.det_index1(PanelData0, P),
+    PD  = ((PD0
                     ^ row := PD0 ^ row + DR)
-                    ^ col := PD0 ^ col + DC) },
-    { PanelData = list__replace_nth_det(PanelData0, P, PD) },
-    relocate(PD ^ panel, PD ^ row, PD ^ col),
-    main_loop(P, PanelData).
-
-% ---------------------------------------------------------------------------- %
-
-:- pred raise_panel(int, list(panel_data), io__state, io__state).
-:- mode raise_panel(in, in, di, uo) is det.
-
-raise_panel(P, PanelData) -->
-    { PD = list__index1_det(PanelData, P) },
-    raise(PD ^ panel),
-    main_loop(P, PanelData).
+                    ^ col := PD0 ^ col + DC),
+    PanelData = list.replace_nth_det(PanelData0, P, PD),
+    relocate(PD ^ panel, PD ^ row, PD ^ col, !IO),
+    main_loop(P, PanelData, !IO).
+
+%-----------------------------------------------------------------------------%
+
+:- pred raise_panel(int::in, list(panel_data)::in, io::di, io::uo) is det.
+
+raise_panel(P, PanelData, !IO) :-
+    PD = list.det_index1(PanelData, P),
+    raise(PD ^ panel, !IO),
+    main_loop(P, PanelData, !IO).

-% ---------------------------------------------------------------------------- %
-% ---------------------------------------------------------------------------- %
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
Index: samples/frogger.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/curs/samples/frogger.m,v
retrieving revision 1.1
diff -u -b -r1.1 frogger.m
--- samples/frogger.m	22 Feb 2006 05:09:14 -0000	1.1
+++ samples/frogger.m	20 Apr 2006 07:55:40 -0000
@@ -8,7 +8,6 @@
 %-----------------------------------------------------------------------------%

 :- module frogger.
-
 :- interface.

 :- import_module io.
@@ -16,12 +15,20 @@
 :- pred main(io::di, io::uo) is det.

 %-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%

 :- implementation.

-:- import_module bool, char, int, list, string.
+:- use_module curs.
+:- use_module sleep.

-:- use_module curs, sleep.
+:- import_module bool.
+:- import_module char.
+:- import_module int.
+:- import_module list.
+:- import_module string.
+
+%-----------------------------------------------------------------------------%

 :- type world
 	--->	world(
@@ -254,22 +261,22 @@
 %-----------------------------------------------------------------------------%

 :- pred move_world(world::in, world::out) is det.
-:- pred move_world_2(int::in, level::in, level::out, frog::in, frog::out)
-	is det.
-:- pred move_row(int::in, row::in, row::out, frog::in, frog::out) is det.
-
 move_world(World0, World) :-
 	move_world_2(0, World0 ^ level, Level, World0 ^ frog, Frog),
 	World = ((World0 ^ level := Level)
 			 ^ frog := Frog).

+:- pred move_world_2(int::in, level::in, level::out, frog::in, frog::out)
+	is det.
+
 move_world_2(_, [], [], Frog, Frog).
 move_world_2(RowNumber, [Row0 | Rows0], [Row | Rows], Frog0, Frog) :-
 	move_row(RowNumber, Row0, Row, Frog0, Frog1),
 	move_world_2(RowNumber+1, Rows0, Rows, Frog1, Frog).

-move_row(_RowNumber, Row @ row(stationary, _String), Row, Frog, Frog).
+:- pred move_row(int::in, row::in, row::out, frog::in, frog::out) is det.

+move_row(_RowNumber, Row @ row(stationary, _String), Row, Frog, Frog).
 move_row(RowNumber, row(leftwards(Speed, Counter, DragFrog), String), Row,
 		Frog0 @ frog(FrogX, FrogY), Frog) :-
 	(if Counter = Speed then
@@ -307,10 +314,6 @@
 %-----------------------------------------------------------------------------%

 :- pred handle_logic(world::in, world::out) is det.
-:- pred check_frog_in_goal(world::in, world::out) is semidet.
-:- pred check_frog_went_splat(world::in, world::out) is semidet.
-:- pred chars_at_frog(world::in, char::out, char::out) is det.
-:- pred stamp_frog_in_goal(world::in, world::out) is det.

 handle_logic(!World) :-
 	( check_frog_in_goal(!World) -> true
@@ -318,6 +321,8 @@
 	; true
 	).

+:- pred check_frog_in_goal(world::in, world::out) is semidet.
+
 check_frog_in_goal(World0, World) :-
 	chars_at_frog(World0, C1, C2),
 	goal_char(C1),
@@ -326,6 +331,8 @@
 	World = ((World1 ^ remaining_goals := World0 ^ remaining_goals-1)
 			 ^ frog := initial_frog).

+:- pred check_frog_went_splat(world::in, world::out) is semidet.
+
 check_frog_went_splat(World0, World) :-
 	chars_at_frog(World0, C1, C2),
 	( frog_cant_touch_1(C1)
@@ -335,20 +342,25 @@
 	World = ((World0 ^ lives := World0 ^ lives - 1)
 			 ^ frog := initial_frog).

+:- pred chars_at_frog(world::in, char::out, char::out) is det.
+
 chars_at_frog(World, C1, C2) :-
 	frog(X, Y) = World ^ frog,
 	Row = list.index0_det(World ^ level, Y),
 	C1 = string.index_det(Row ^ str, X),
-	C2 = string.index_det(Row ^ str, X+1).
+	C2 = string.index_det(Row ^ str, X + 1).
+
+:- pred stamp_frog_in_goal(world::in, world::out) is det.

 stamp_frog_in_goal(World0, World) :-
 	frog(X, Y) = World0 ^ frog,
 	Level = World0 ^ level,
 	Row = list.index0_det(Level, Y),
 	NewStr = string.set_char_det('<', X,
-		string.set_char_det('>', X+1, Row ^ str)),
+		string.set_char_det('>', X + 1, Row ^ str)),
 	NewRow = Row ^ str := NewStr,
-	NewLevel = list.replace_nth_det(Level, Y+1, NewRow),
+	NewLevel = list.replace_nth_det(Level, Y + 1, NewRow),
 	World = World0 ^ level := NewLevel.

 %-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
Index: samples/nibbles.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/curs/samples/nibbles.m,v
retrieving revision 1.1
diff -u -b -r1.1 nibbles.m
--- samples/nibbles.m	22 Feb 2006 05:09:14 -0000	1.1
+++ samples/nibbles.m	20 Apr 2006 08:11:56 -0000
@@ -6,7 +6,6 @@
 %-----------------------------------------------------------------------------%

 :- module nibbles.
-
 :- interface.

 :- import_module io.
@@ -14,12 +13,25 @@
 :- pred main(io::di, io::uo) is det.

 %-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%

 :- implementation.

-:- import_module assoc_list, bool, char, int, list, random, require.
-:- import_module std_util, string, time.
-:- use_module curs, sleep.
+:- use_module curs.
+:- use_module sleep.
+
+:- import_module assoc_list.
+:- import_module bool.
+:- import_module char.
+:- import_module int.
+:- import_module list.
+:- import_module random.
+:- import_module require.
+:- import_module std_util.
+:- import_module string.
+:- import_module time.
+
+%-----------------------------------------------------------------------------%

 :- type rs == random.supply.

@@ -120,10 +132,11 @@
 quit_key(27).	% escape

 :- pred direction_key(int::in, direction::out) is semidet.
-:- pred direction_key_2(int::in, direction::out) is cc_nondet.

 direction_key(Key, promise_only_solution(direction_key_2(Key))).

+:- pred direction_key_2(int::in, direction::out) is cc_nondet.
+
 direction_key_2(curs.key_up, up).
 direction_key_2(curs.key_down, down).
 direction_key_2(curs.key_left, left).
@@ -161,14 +174,17 @@
 	; Dir = right,  NewHead = {HeadX+1, HeadY}
 	),
 	Result = ordering(Growth, 0),
-	( Result = (>),
+	(
+		Result = (>),
 		World = World0 ^ snake :=
 			snake(Dir, NewHead, [Head | Tail], Growth-1)
-	; Result = (=),
+	;
+		Result = (=),
 		NewTail = list.take_upto(length(Tail)-1, Tail),
 		World = World0 ^ snake :=
 			snake(Dir, NewHead, [Head | NewTail], Growth)
-	; Result = (<),
+	;
+		Result = (<),
 		error("move_snake/2: Growth should be >= 0")
 	).

@@ -331,3 +347,4 @@
 	curs.nodelay(yes, !IO).

 %-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
Index: samples/sleep.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/curs/samples/sleep.m,v
retrieving revision 1.1
diff -u -b -r1.1 sleep.m
--- samples/sleep.m	22 Feb 2006 05:09:14 -0000	1.1
+++ samples/sleep.m	21 Apr 2006 03:25:45 -0000
@@ -1,7 +1,6 @@
 %-----------------------------------------------------------------------------%

 :- module sleep.
-
 :- interface.

 :- import_module io.
@@ -14,6 +13,7 @@
 :- pred usleep(int::in, io::di, io::uo) is det.

 %-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%

 :- implementation.

@@ -27,10 +27,11 @@
 :- pragma foreign_proc("C",
 	usleep(N::in, IO0::di, IO::uo),
 	[will_not_call_mercury, promise_pure],
-"{
+"
 	struct timeval tv = {0, N};
 	select(0, NULL, NULL, NULL, &tv);
 	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