[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