[m-rev.] diff: improvements for building extras/curses
Julien Fischer
jfischer at opturion.com
Sun Jan 23 22:02:28 AEDT 2022
Improvements for building extras/curses.
Separate out the configuration for linking against ncurses as has just be done
for extras/curs.
Update programming style.
extras/curses/Ncurses.options:
extras/curses/Mmakefile:
extras/curses/sample/Mmakefile:
Shift the flags for linking against ncurses to Ncurses.options.
Document how to use the ncursesN-config and pkg-config tools to find
the appropriate flags for a system.
extras/curses/mcurses.basics.m:
extras/curses/mcurses.user.m:
Update syntax and programming style.
Replace tabs with spaces and delete trailing whitespace.
Julien.
diff --git a/extras/curses/Mmakefile b/extras/curses/Mmakefile
index bc238e020..39d9eef2d 100644
--- a/extras/curses/Mmakefile
+++ b/extras/curses/Mmakefile
@@ -2,18 +2,20 @@
# vim: ts=8 sw=8 noexpandtab
#-----------------------------------------------------------------------------#
# Copyright (C) 2000-2003 The University of Melbourne.
-# Copyright (C) 2015-2018 The Mercury team.
+# Copyright (C) 2015-2018, 2022 The Mercury team.
# This file is distributed under the terms specified in COPYING.LIB.
#-----------------------------------------------------------------------------#
+include Ncurses.options
+
# This is needed to avoid conflicts with `bool'
CFLAGS = -DMERCURY_BOOTSTRAP_H
INSTALL_PREFIX := $(INSTALL_PREFIX)/extras
-# The following definition is correct for Linux. You may need to change
-# this line to include the appropriate curses library for your OS.
-MLLIBS = -lncurses
+# Check that the values in the file Ncurses.options are appropriate for
+# linking against ncurses on your system.
+MLLIBS = $(NCURSES_LIBS)
-include ../Mmake.params
diff --git a/extras/curses/Ncurses.options b/extras/curses/Ncurses.options
index e69de29bb..3241a26d5 100644
--- a/extras/curses/Ncurses.options
+++ b/extras/curses/Ncurses.options
@@ -0,0 +1,26 @@
+# The flags for linking against ncurses.
+#
+# The default value below should work on most systems. If it does not you can
+# find the exact value for you system by either:
+#
+# 1. Running the command:
+#
+# $ ncursesN-config --libs
+#
+# where N is the version of ncurses installed on your system
+# (e.g. 6, 5, 5.4 etc).
+#
+# 2. Running the command:
+#
+# $ pkg-config --libs --static ncurses
+#
+# This second method will only work if the pkg-config utility is available
+# on your system.
+#
+# You can override this variable directly on the command line with the output
+# of one of the above methods by doing, for example:
+#
+# $ mmake depend NCURSES_LIBS="$(ncurses6-config --libs)"
+# $ mmake NCURSES_LIBS="(ncurses6-config --libs$)"
+#
+NCURSES_LIBS = -lncurses
diff --git a/extras/curses/mcurses.basics.m b/extras/curses/mcurses.basics.m
index 09004ad66..501f83432 100644
--- a/extras/curses/mcurses.basics.m
+++ b/extras/curses/mcurses.basics.m
@@ -2,11 +2,12 @@
% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
%-----------------------------------------------------------------------------%
% Copyright (C) 1994-2000, 2010 The University of Melbourne.
+% Copyright (C) 2019, 2022 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury Distribution.
%----------------------------------------------------------------------------%
%
-% File: basics.m
+% File: mcurses.basics.m
% Main author: conway
% Maintained by: rejj
% Stability: Medium
@@ -36,65 +37,66 @@
%----------------------------------------------------------------------------%
- % Initialise curses.
- % This is used by user.m, and should not be called by the programmer.
- %
+ % Initialise curses.
+ % This is used by user.m, and should not be called by the programmer.
+ %
:- pred init(io::di, io::uo) is det.
- % Shutdown curses. This is required before exiting your program, or else you
- % will be left with a practically unusable terminal.
- %
+ % Shutdown curses.
+ % This is required before exiting your program, or else you will be left
+ % with a practically unusable terminal.
+ %
:- pred endwin(io::di, io::uo) is det.
- % Initialise the colour mode for curses.
- % This must be called before attempting to use anything with colour.
- %
+ % Initialise the colour mode for curses.
+ % This must be called before attempting to use anything with colour.
+ %
:- pred start_colour(io::di, io::uo) is det.
- % Update the curses screen.
- %
+ % Update the curses screen.
+ %
:- pred update(io::di, io::uo) is det.
- % Perform a doupdate.
- % (see the curses man page for descriptions of update and doupdate)
+ % Perform a doupdate.
+ % (see the curses man page for descriptions of update and doupdate)
:- pred doupdate(io::di, io::uo) is det.
- % Clear the curses screen.
- %
+ % Clear the curses screen.
+ %
:- pred clear(io::di, io::uo) is det.
- % cursor(X, Y, !IO):
- % Places the cursor at position X, Y.
- %
+ % cursor(X, Y, !IO):
+ % Places the cursor at position X, Y.
+ %
:- pred cursor(int::in, int::in, io::di, io::uo) is det.
- % Place a string on the screen, starting at the current cursor position.
- %
+ % Place a string on the screen, starting at the current cursor position.
+ %
:- pred putstr(string::in, io::di, io::uo) is det.
- % Place a single character on the screen at the current cursor position.
- %
+ % Place a single character on the screen at the current cursor position.
+ %
:- pred putchar(char::in, io::di, io::uo) is det.
- % cols(Cols, !IO):
- % Retrieves the number of columns in the screen.
- %
+ % cols(Cols, !IO):
+ % Retrieves the number of columns in the screen.
+ %
:- pred cols(int::out, io::di, io::uo) is det.
- % rows(Rows, !IO):
- % Retrieves the number of rows in the screen.
- %
+ % rows(Rows, !IO):
+ % Retrieves the number of rows in the screen.
+ %
:- pred rows(int::out, io::di, io::uo) is det.
- % getkey(Key, !IO):
- % Wait for the next keypress from the user, and return it as Key.
- %
+ % getkey(Key, !IO):
+ % Wait for the next keypress from the user, and return it as Key.
+ %
:- pred getkey(int::out, io::di, io::uo) is det.
%----------------------------------------------------------------------------%
- % Functions to return scancodes for some common keypresses
-
+ % Functions to return scancodes for some common keypresses.
+ %
:- func break = int.
:- func down = int.
:- func up = int.
@@ -108,8 +110,8 @@
%----------------------------------------------------------------------------%
- % Functions to return colours for characters
-
+ % Functions to return colours for characters.
+ %
:- func black = int.
:- func green = int.
:- func red = int.
@@ -119,8 +121,8 @@
:- func blue = int.
:- func yellow = int.
- % Functions to return attributes for characters
-
+ % Functions to return attributes for characters.
+ %
:- func normal = int.
:- func standout = int.
:- func underline = int.
@@ -149,32 +151,30 @@
%----------------------------------------------------------------------------%
:- pragma foreign_proc("C",
- init(IO0::di, IO::uo),
- [promise_pure, will_not_call_mercury],
+ init(_IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
"
WINDOW *w;
w = initscr();
noecho();
cbreak();
keypad(w, TRUE);
- IO = IO0;
").
%----------------------------------------------------------------------------%
:- pragma foreign_proc("C",
- endwin(IO0::di, IO::uo),
- [promise_pure, will_not_call_mercury],
+ endwin(_IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
"
endwin();
- IO = IO0;
").
%----------------------------------------------------------------------------%
:- pragma foreign_proc("C",
- start_colour(IO0::di, IO::uo),
- [promise_pure, will_not_call_mercury],
+ start_colour(_IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
"
start_color();
init_pair(COLOR_BLACK, COLOR_BLACK, COLOR_BLACK);
@@ -185,97 +185,87 @@
init_pair(COLOR_MAGENTA, COLOR_MAGENTA, COLOR_BLACK);
init_pair(COLOR_BLUE, COLOR_BLUE, COLOR_BLACK);
init_pair(COLOR_YELLOW, COLOR_YELLOW, COLOR_BLACK);
- IO = IO0;
").
%----------------------------------------------------------------------------%
:- pragma foreign_proc("C",
- doupdate(IO0::di, IO::uo),
- [promise_pure, will_not_call_mercury],
+ doupdate(_IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
"
doupdate();
- IO = IO0;
").
%----------------------------------------------------------------------------%
:- pragma foreign_proc("C",
- update(IO0::di, IO::uo),
- [promise_pure, will_not_call_mercury],
+ update(_IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
"
refresh();
- IO = IO0;
").
%----------------------------------------------------------------------------%
:- pragma foreign_proc("C",
- clear(IO0::di, IO::uo),
- [promise_pure, will_not_call_mercury],
+ clear(_IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
"
clear();
- IO = IO0;
").
%----------------------------------------------------------------------------%
:- pragma foreign_proc("C",
- cursor(X::in, Y::in, IO0::di, IO::uo),
- [promise_pure, will_not_call_mercury],
+ cursor(X::in, Y::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
"
move(Y, X);
- IO = IO0;
").
%----------------------------------------------------------------------------%
:- pragma foreign_proc("C",
- putstr(Str::in, IO0::di, IO::uo),
- [promise_pure, will_not_call_mercury],
+ putstr(Str::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
"
addstr(Str);
- IO = IO0;
").
%----------------------------------------------------------------------------%
:- pragma foreign_proc("C",
- putchar(C::in, IO0::di, IO::uo),
- [promise_pure, will_not_call_mercury],
+ putchar(C::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
"
addch((chtype) C);
- IO = IO0;
").
%----------------------------------------------------------------------------%
:- pragma foreign_proc("C",
- cols(C::out, IO0::di, IO::uo),
- [promise_pure, will_not_call_mercury],
+ cols(C::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
"
C = tigetnum((char *) ""cols"");
- IO = IO0;
").
%----------------------------------------------------------------------------%
:- pragma foreign_proc("C",
- rows(R::out, IO0::di, IO::uo),
- [promise_pure, will_not_call_mercury],
+ rows(R::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
"
R = tigetnum((char *) ""lines"");
- IO = IO0;
").
%----------------------------------------------------------------------------%
:- pragma foreign_proc("C",
- getkey(C::out, IO0::di, IO::uo),
- [promise_pure, will_not_call_mercury],
+ getkey(C::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
"
C = getch();
- IO = IO0;
").
%----------------------------------------------------------------------------%
diff --git a/extras/curses/mcurses.m b/extras/curses/mcurses.m
index 693b70d5d..3db401f7c 100644
--- a/extras/curses/mcurses.m
+++ b/extras/curses/mcurses.m
@@ -9,7 +9,7 @@
% Please note that this is still a partial binding; it does not provide
% complete curses functionality.
% Major things this binding implements:
-% * Creation, destruction, clearing, raising, and lowering of arbitary
+% * Creation, destruction, clearing, raising, and lowering of arbitrary
% windows.
% * Scrolling.
% * Colour on a character by character basis.
diff --git a/extras/curses/mcurses.user.m b/extras/curses/mcurses.user.m
index 89b35ae5a..8c221559d 100644
--- a/extras/curses/mcurses.user.m
+++ b/extras/curses/mcurses.user.m
@@ -1,12 +1,13 @@
+%-----------------------------------------------------------------------------%
+% vim: ts=4 sw=4 et tw=0 wm=0 ff=unix ft=mercury
%----------------------------------------------------------------------------%
% Copyright (C) 1994-2000, 2005-2006, 2011 The University of Melbourne.
+% Copyright (C) 2014, 2021-2022 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury Distribution.
-%----------------------------------------------------------------------------%
-
%----------------------------------------------------------------------------%
%
-% File: user.m
+% File: mcurses.user.m
% Main author: conway
% Maintained by: rejj
% Stability: Medium
@@ -16,134 +17,149 @@
% Please note that this is still a partial binding; it does not provide
% complete curses functionality.
% Major things this binding implements:
-% * Creation, destruction, clearing, raising, and lowering of arbitary
+% * Creation, destruction, clearing, raising, and lowering of arbitrary
% windows.
% * Scrolling.
% * Colour on a character by character basis.
%
%----------------------------------------------------------------------------%
+
:- module mcurses.user.
:- interface.
-:- import_module char, io, list, pair.
+:- import_module char.
+:- import_module io.
+:- import_module list.
+:- import_module pair.
+
+%----------------------------------------------------------------------------%
- % The ADT used to represent a curses window.
+ % The ADT used to represent a curses window.
+ %
:- type win.
- % Window options.
+ % Window options.
+ %
:- type wopt
- ---> border % Place a border around the window
- ; title(string) % Give the window a title
- .
+ ---> border % Place a border around the window.
+ ; title(string). % Give the window a title.
- % Character attributes.
- % These modify the way a character is drawn on the screen. See the curses
- % documentation for a detailed description of each attribute.
+ % Character attributes.
+ % These modify the way a character is drawn on the screen. See the curses
+ % documentation for a detailed description of each attribute.
+ %
:- type cattr
- --->
- normal;
- standout;
- underline;
- reverse;
- blink;
- dim;
- bold;
- protect;
- invis;
- altcharset;
- chartext;
- colour(colour).
-
- % Colours available for use in displaying characters.
- %
- % XXX Currently, there is no functionality provided for the customisation of
- % colours, only the 8 default colours from curses can be used.
+ ---> normal
+ ; standout
+ ; underline
+ ; reverse
+ ; blink
+ ; dim
+ ; bold
+ ; protect
+ ; invis
+ ; altcharset
+ ; chartext
+ ; colour(colour).
+
+ % Colours available for use in displaying characters.
+ %
+ % XXX Currently, there is no functionality provided for the customisation
+ % of colours, only the 8 default colours from curses can be used.
+ %
:- type colour
- --->
- black;
- green;
- red;
- cyan;
- white;
- magenta;
- blue;
- yellow.
-
- % The type used to represent a character with its attributes.
+ ---> black
+ ; green
+ ; red
+ ; cyan
+ ; white
+ ; magenta
+ ; blue
+ ; yellow.
+
+ % The type used to represent a character with its attributes.
+ %
:- type chtype == pair(char, list(cattr)).
- % init(Root, IO0, IO)
- % Initialise curses, giving back the root window.
- % The initialisation procedures in this library turn off echoing, and
- % enable character-at-a-time input.
-:- pred init(win, io, io).
-:- mode init(out, di, uo) is det.
-
- % Redraw the screen
-:- pred redraw(io, io).
-:- mode redraw(di, uo) is det.
-
- % Refresh the screen.
-:- pred refresh(io, io).
-:- mode refresh(di, uo) is det.
-
- % create(Parent, Options, ParentX, ParentY, NumCols, NumRows, Child, IO0, IO)
- % create a new window, which will be a child of the window Parent. It is
- % created at position ParentX, ParentY in the parent window, and is of size
- % NumCols, NumRows.
-:- pred create(win, list(wopt), int, int, int, int, win, io, io).
-:- mode create(in, in, in, in, in, in, out, di, uo) is det.
-
- % destroy the specified window.
-:- pred destroy(win, io, io).
-:- mode destroy(in, di, uo) is det.
-
- % Hide the specified window.
-:- pred hide(win, io, io).
-:- mode hide(in, di, uo) is det.
-
- % Show the (previously hidden) specified window
-:- pred show(win, io, io).
-:- mode show(in, di, uo) is det.
-
- % Raise the specified window.
-:- pred raise(win, io, io).
-:- mode raise(in, di, uo) is det.
-
- % Lower the specified window.
-:- pred lower(win, io, io).
-:- mode lower(in, di, uo) is det.
-
- % Clear the specified window. Fills the window with spaces.
-:- pred clear(win, io, io).
-:- mode clear(in, di, uo) is det.
-
- % place_char(Window, X, Y, (Char - Attributes), IO0, IO)
- % Place a character into Window at position X, Y.
-:- pred place_char(win, int, int, chtype, io, io).
-:- mode place_char(in, in, in, in, di, uo) is det.
-
- % place_string(Window, X, Y, String, IO0, IO)
- % Place a string into Window at position X, Y.
- %
- % XXX Note that presently, character attributes are not supported for
- % strings
-:- pred place_string(win, int, int, string, io, io).
-:- mode place_string(in, in, in, in, di, uo) is det.
-
- % scroll(Window, Amount, IO0, IO)
- % Scroll Window upwards by Amount lines.
-:- pred scroll(win, int, io, io).
-:- mode scroll(in, in, di, uo) is det.
+ % init(Root, !IO):
+ %
+ % Initialise curses, giving back the root window.
+ % The initialisation procedures in this library turn off echoing, and
+ % enable character-at-a-time input.
+ %
+:- pred init(win::out, io::di, io::uo) is det.
+
+ % Redraw the screen.
+ %
+:- pred redraw(io::di, io::uo) is det.
+
+ % Refresh the screen.
+ %
+:- pred refresh(io::di, io::uo) is det.
+
+ % create(Parent, Options, ParentX, ParentY, NumCols, NumRows, Child, !IO):
+ %
+ % Create a new window, which will be a child of the window Parent. It is
+ % created at position ParentX, ParentY in the parent window, and is of size
+ % NumCols, NumRows.
+ %
+:- pred create(win::in, list(wopt)::in, int::in, int::in, int::in, int::in,
+ win::out, io::di, io::uo) is det.
+
+ % Destroy the specified window.
+ %
+:- pred destroy(win::in, io::di, io::uo) is det.
+
+ % Hide the specified window.
+ %
+:- pred hide(win::in, io::di, io::uo) is det.
+
+ % Show the (previously hidden) specified window.
+ %
+:- pred show(win::in, io::di, io::uo) is det.
+
+ % Raise the specified window.
+ %
+:- pred raise(win::in, io::di, io::uo) is det.
+
+ % Lower the specified window.
+ %
+:- pred lower(win::in, io::di, io::uo) is det.
+
+ % Clear the specified window. Fills the window with spaces.
+ %
+:- pred clear(win::in, io::di, io::uo) is det.
+
+ % place_char(Window, X, Y, (Char - Attributes), !IO):
+ % Place a character into Window at position X, Y.
+ %
+:- pred place_char(win::in, int::in, int::in, chtype::in,
+ io::di, io::uo) is det.
+
+ % place_string(Window, X, Y, String, !IO):
+ %
+ % Place a string into Window at position X, Y.
+ %
+ % XXX Note that presently, character attributes are not supported for
+ % strings
+ %
+:- pred place_string(win::in, int::in, int::in, string::in,
+ io::di, io::uo) is det.
+
+ % scroll(Window, Amount, !IO):
+ %
+ % Scroll Window upwards by Amount lines.
+ %
+:- pred scroll(win::in, int::in, io::di, io::uo) is det.
+%----------------------------------------------------------------------------%
%----------------------------------------------------------------------------%
:- implementation.
:- pragma foreign_decl("C", "
-
- #include <curses.h>
- #include <term.h>
+ #include <curses.h>
+ #include <term.h>
").
%----------------------------------------------------------------------------%
@@ -158,250 +174,250 @@
:- import_module store.
:- import_module string.
-:- type curse_store_type ---> curse_store_type.
+%----------------------------------------------------------------------------%
+
+:- type curse_store_type
+ ---> curse_store_type.
+
:- type curse_store == store(curse_store_type).
-:- type win == store_mutvar(window, curse_store_type).
+
+:- type win == store_mutvar(window, curse_store_type).
:- type window
- ---> win(
- win, % parent
- int, % width
- int, % height
- list(wopt),
- array(chtype), % contents
- list(child), % visible
- list(child) % hidden
- ).
+ ---> win(
+ win, % parent
+ int, % width
+ int, % height
+ list(wopt),
+ array(chtype), % contents
+ list(child), % visible
+ list(child) % hidden
+ ).
:- type child
- ---> child(
- int, % x
- int, % y
- win
- ).
+ ---> child(
+ int, % x
+ int, % y
+ win
+ ).
:- type cursor
- ---> cursor(int, int). % X, Y
+ ---> cursor(int, int). % X, Y
%----------------------------------------------------------------------------%
-init(Win) -->
- init,
- cols(Cols),
- rows(Rows),
- { array.init(Cols*Rows, ' ' - [], Data) },
- { MakeWin = (func(Self) = win(Self, Cols, Rows, [], Data, [], [])) },
- { init_curse_store(Curse0) },
- { store.new_cyclic_mutvar(MakeWin, Win, Curse0, Curse) },
- set_curse_store(Curse),
- set_root(Win),
- refresh.
+init(Win, !IO) :-
+ init(!IO),
+ cols(Cols, !IO),
+ rows(Rows, !IO),
+ array.init(Cols * Rows, ' ' - [], Data),
+ MakeWin = (func(Self) = win(Self, Cols, Rows, [], Data, [], [])),
+ init_curse_store(Curse0),
+ store.new_cyclic_mutvar(MakeWin, Win, Curse0, Curse),
+ set_curse_store(Curse, !IO),
+ set_root(Win, !IO),
+ refresh(!IO).
%----------------------------------------------------------------------------%
-create(Parent, Opts, X, Y, W, H, Child) -->
- get_win(Parent, PWindow0),
- { PWindow0 = win(P0, W0, H0, Opts0, PData, Visi0, Hidden) },
- { require(((pred) is semidet :-
- X >= 0, Y >= 0,
- X+W =< W0,
- Y+H =< H0
- ), "create: window out of range!") },
- { array.init(W*H, ' ' -[], Data) },
- { CWindow = win(P0, W, H, Opts, Data, [], []) },
- new_win(CWindow, Child),
- { list.append(Visi0, [child(X, Y, Child)], Visi) },
- { PWindow = win(Parent, W0, H0, Opts0, PData, Visi, Hidden) },
- set_win(Parent, PWindow).
+create(Parent, Opts, X, Y, W, H, Child, !IO) :-
+ get_win(Parent, PWindow0, !IO),
+ PWindow0 = win(P0, W0, H0, Opts0, PData, Visi0, Hidden),
+ require(((pred) is semidet :-
+ X >= 0, Y >= 0,
+ X+W =< W0,
+ Y+H =< H0
+ ), "create: window out of range!"),
+ array.init(W * H, ' ' - [], Data),
+ CWindow = win(P0, W, H, Opts, Data, [], []),
+ new_win(CWindow, Child, !IO),
+ list.append(Visi0, [child(X, Y, Child)], Visi),
+ PWindow = win(Parent, W0, H0, Opts0, PData, Visi, Hidden),
+ set_win(Parent, PWindow, !IO).
%----------------------------------------------------------------------------%
-destroy(Win) -->
- get_win(Win, Window),
- { Window = win(Parent, _, _, _, _, _, _) },
- ( { Parent \= Win } -> % can't kill the root window
- get_win(Parent, PWindow0),
- { PWindow0 = win(PP, PC, PR, PO, PD, Visi0, Hidden) },
- { filter((pred(Child::in) is semidet :-
- \+ Child = child(_, _, Win)
- ), Visi0, Visi) },
- { PWindow = win(PP, PC, PR, PO, PD, Visi, Hidden) },
- set_win(Parent, PWindow)
- ;
- []
- ).
+destroy(Win, !IO) :-
+ get_win(Win, Window, !IO),
+ Window = win(Parent, _, _, _, _, _, _),
+ ( if Parent \= Win then % Cannot kill the root window.
+ get_win(Parent, PWindow0, !IO),
+ PWindow0 = win(PP, PC, PR, PO, PD, Visi0, Hidden),
+ filter((pred(Child::in) is semidet :-
+ \+ Child = child(_, _, Win)
+ ), Visi0, Visi),
+ PWindow = win(PP, PC, PR, PO, PD, Visi, Hidden),
+ set_win(Parent, PWindow, !IO)
+ else
+ true
+ ).
%----------------------------------------------------------------------------%
-redraw -->
- get_root(Root),
- set_cursor(cursor(0, 0)),
- refresh(Root),
- doupdate.
+redraw(!IO) :-
+ get_root(Root, !IO),
+ set_cursor(cursor(0, 0), !IO),
+ refresh(Root, !IO),
+ doupdate(!IO).
%----------------------------------------------------------------------------%
-refresh -->
- get_root(Root),
- clear,
- set_cursor(cursor(0, 0)),
- refresh(Root),
- update.
-
-:- pred refresh(win, io, io).
-:- mode refresh(in, di, uo) is det.
-
-refresh(Win) -->
- get_win(Win, Window),
- { Window = win(_Parent, Cols, Rows, Opts, Data, Visi, _Hidden) },
- get_cursor(cursor(X0, Y0)),
- { solutions((pred(Ti::out) is nondet :-
- list.member(ZZ, Opts),
- ZZ = title(Ti)
- ), Titles) },
- ( { list.member(border, Opts) } ->
- for(Y0+1, Y0+Rows, (pred(By::in, di, uo) is det -->
- cursor(X0, By),
- putchar('|'),
- cursor(X0+Cols+1, By),
- putchar('|')
- )),
- for(X0+1, X0+Cols, (pred(Bx::in, di, uo) is det -->
- cursor(Bx, Y0),
- (
- { Titles = [] },
- putchar('-')
- ;
- { Titles = [_|_] },
- putchar('=')
- ),
- cursor(Bx, Y0+Rows+1),
- putchar('-')
- )),
- cursor(X0, Y0), putchar('+'),
- cursor(X0+Cols+1, Y0), putchar('+'),
- cursor(X0, Y0+Rows+1), putchar('+'),
- cursor(X0+Cols+1, Y0+Rows+1), putchar('+'),
- ( { Titles = [Title0|_] } ->
- { string.length(Title0, N0) },
- ( { N0 > Cols-2 } ->
- { N = Cols - 2 },
- { split(Title0, N, Title, _) }
- ;
- { N = N0 },
- { Title = Title0 }
- ),
- { Xst = X0 + (Cols - N)//2 },
- cursor(Xst, Y0),
- putstr(Title)
- ;
- []
- ),
- { A = 1 }
- ;
- { A = 0 }
- ),
- { Xb = X0+A },
- { Yb = Y0+A },
- for(0, Rows-1, (pred(Y::in, di, uo) is det -->
- { Offset = Y*Cols },
- for(0, Cols-1, (pred(X::in, di, uo) is det -->
- cursor(Xb+X, Yb+Y),
- { lookup(Data, X+Offset, Char - Attribs) },
- putch(Char, Attribs)
- ))
- )),
- foldl(refresh_child, Visi).
-
-:- pred refresh_child(child, io, io).
-:- mode refresh_child(in, di, uo) is det.
-
-refresh_child(child(X, Y, Win)) -->
- get_cursor(cursor(X0, Y0)),
- set_cursor(cursor(X0+X, Y0+Y)),
- refresh(Win),
- set_cursor(cursor(X0, Y0)).
+refresh(!IO) :-
+ get_root(Root, !IO),
+ clear(!IO),
+ set_cursor(cursor(0, 0), !IO),
+ refresh(Root, !IO),
+ update(!IO).
+
+:- pred refresh(win::in, io::di, io::uo) is det.
+
+refresh(Win, !IO) :-
+ get_win(Win, Window, !IO),
+ Window = win(_Parent, Cols, Rows, Opts, Data, Visi, _Hidden),
+ get_cursor(cursor(X0, Y0), !IO),
+ solutions((pred(Ti::out) is nondet :-
+ list.member(ZZ, Opts),
+ ZZ = title(Ti)
+ ), Titles),
+ ( if list.member(border, Opts) then
+ for(Y0+1, Y0+Rows, (pred(By::in, !.IO::di, !:IO::uo) is det :-
+ cursor(X0, By, !IO),
+ putchar('|', !IO),
+ cursor(X0 + Cols + 1, By, !IO),
+ putchar('|', !IO)
+ ), !IO),
+ for(X0 + 1, X0 + Cols, (pred(Bx::in, !.IO::di, !:IO::uo) is det :-
+ cursor(Bx, Y0, !IO),
+ (
+ Titles = [],
+ putchar('-', !IO)
+ ;
+ Titles = [_ | _],
+ putchar('=', !IO)
+ ),
+ cursor(Bx, Y0 + Rows + 1, !IO),
+ putchar('-', !IO)
+ ), !IO),
+ cursor(X0, Y0, !IO), putchar('+', !IO),
+ cursor(X0 + Cols + 1, Y0, !IO), putchar('+', !IO),
+ cursor(X0, Y0 + Rows + 1, !IO), putchar('+', !IO),
+ cursor(X0 + Cols + 1, Y0 + Rows + 1, !IO), putchar('+', !IO),
+ ( if Titles = [Title0 | _] then
+ string.length(Title0, N0),
+ ( if N0 > Cols - 2 then
+ N = Cols - 2,
+ split(Title0, N, Title, _)
+ else
+ N = N0,
+ Title = Title0
+ ),
+ Xst = X0 + (Cols - N) // 2,
+ cursor(Xst, Y0, !IO),
+ putstr(Title, !IO)
+ else
+ true
+ ),
+ A = 1
+ else
+ A = 0
+ ),
+ Xb = X0 + A,
+ Yb = Y0 + A,
+ for(0, Rows - 1, (pred(Y::in, !.IO::di, !:IO::uo) is det :-
+ Offset = Y*Cols,
+ for(0, Cols - 1, (pred(X::in, !.IO::di, !:IO::uo) is det :-
+ cursor(Xb + X, Yb + Y, !IO),
+ lookup(Data, X + Offset, Char - Attribs),
+ putch(Char, Attribs, !IO)
+ ), !IO)
+ ), !IO),
+ foldl(refresh_child, Visi, !IO).
+
+:- pred refresh_child(child::in, io::di, io::uo) is det.
+
+refresh_child(child(X, Y, Win), !IO):-
+ get_cursor(cursor(X0, Y0), !IO),
+ set_cursor(cursor(X0 + X, Y0 + Y), !IO),
+ refresh(Win, !IO),
+ set_cursor(cursor(X0, Y0), !IO).
%----------------------------------------------------------------------------%
-:- pred putch(char, list(cattr), io, io).
-:- mode putch(in, in, di, uo) is det.
-
-putch(Char, []) --> putchar(Char).
-putch(Char, [A|B]) -->
- { chtype(Char, Chtype) },
- putch2(Chtype, [A|B]).
-
-:- pred putch2(int, list(cattr), io, io).
-:- mode putch2(in, in, di, uo) is det.
-
-putch2(Chtype, []) --> putch3(Chtype).
-putch2(Chtype0, [Attrib | Attribs], IO0, IO) :-
- (
- Attrib = normal,
- mod_chtype(Chtype0, normal, Chtype),
- putch2(Chtype, Attribs, IO0, IO)
- ;
- Attrib = standout,
- mod_chtype(Chtype0, standout, Chtype),
- putch2(Chtype, Attribs, IO0, IO)
- ;
- Attrib = underline,
- mod_chtype(Chtype0, underline, Chtype),
- putch2(Chtype, Attribs, IO0, IO)
- ;
- Attrib = reverse,
- mod_chtype(Chtype0, reverse, Chtype),
- putch2(Chtype, Attribs, IO0, IO)
- ;
- Attrib = blink,
- mod_chtype(Chtype0, blink, Chtype),
- putch2(Chtype, Attribs, IO0, IO)
- ;
- Attrib = dim,
- mod_chtype(Chtype0, dim, Chtype),
- putch2(Chtype, Attribs, IO0, IO)
- ;
- Attrib = bold,
- mod_chtype(Chtype0, bold, Chtype),
- putch2(Chtype, Attribs, IO0, IO)
- ;
- Attrib = protect,
- mod_chtype(Chtype0, protect, Chtype),
- putch2(Chtype, Attribs, IO0, IO)
- ;
- Attrib = invis,
- mod_chtype(Chtype0, invis, Chtype),
- putch2(Chtype, Attribs, IO0, IO)
- ;
- Attrib = altcharset,
- mod_chtype(Chtype0, altcharset, Chtype),
- putch2(Chtype, Attribs, IO0, IO)
- ;
- Attrib = chartext,
- mod_chtype(Chtype0, chartext, Chtype),
- putch2(Chtype, Attribs, IO0, IO)
- ;
- Attrib = colour(Colour0),
- get_colour(Colour0, Colour),
- mod_chtype(Chtype0, colour(Colour), Chtype),
- putch2(Chtype, Attribs, IO0, IO)
- ).
-
-:- pred putch3(int, io, io).
-:- mode putch3(in, di, uo) is det.
+:- pred putch(char::in, list(cattr)::in, io::di, io::uo) is det.
+
+putch(Char, [], !IO) :-
+ putchar(Char, !IO).
+putch(Char, [A | B], !IO) :-
+ chtype(Char, Chtype),
+ putch2(Chtype, [A | B], !IO).
+
+:- pred putch2(int::in, list(cattr)::in, io::di, io::uo) is det.
+
+putch2(Chtype, [], !IO) :-
+ putch3(Chtype, !IO).
+putch2(Chtype0, [Attrib | Attribs], !IO) :-
+ (
+ Attrib = normal,
+ mod_chtype(Chtype0, normal, Chtype),
+ putch2(Chtype, Attribs, !IO)
+ ;
+ Attrib = standout,
+ mod_chtype(Chtype0, standout, Chtype),
+ putch2(Chtype, Attribs, !IO)
+ ;
+ Attrib = underline,
+ mod_chtype(Chtype0, underline, Chtype),
+ putch2(Chtype, Attribs, !IO)
+ ;
+ Attrib = reverse,
+ mod_chtype(Chtype0, reverse, Chtype),
+ putch2(Chtype, Attribs, !IO)
+ ;
+ Attrib = blink,
+ mod_chtype(Chtype0, blink, Chtype),
+ putch2(Chtype, Attribs, !IO)
+ ;
+ Attrib = dim,
+ mod_chtype(Chtype0, dim, Chtype),
+ putch2(Chtype, Attribs, !IO)
+ ;
+ Attrib = bold,
+ mod_chtype(Chtype0, bold, Chtype),
+ putch2(Chtype, Attribs, !IO)
+ ;
+ Attrib = protect,
+ mod_chtype(Chtype0, protect, Chtype),
+ putch2(Chtype, Attribs, !IO)
+ ;
+ Attrib = invis,
+ mod_chtype(Chtype0, invis, Chtype),
+ putch2(Chtype, Attribs, !IO)
+ ;
+ Attrib = altcharset,
+ mod_chtype(Chtype0, altcharset, Chtype),
+ putch2(Chtype, Attribs, !IO)
+ ;
+ Attrib = chartext,
+ mod_chtype(Chtype0, chartext, Chtype),
+ putch2(Chtype, Attribs, !IO)
+ ;
+ Attrib = colour(Colour0),
+ get_colour(Colour0, Colour),
+ mod_chtype(Chtype0, colour(Colour), Chtype),
+ putch2(Chtype, Attribs, !IO)
+ ).
+
+:- pred putch3(int::in, io::di, io::uo) is det.
:- pragma foreign_proc("C",
- putch3(C::in, IO0::di, IO::uo),
- [promise_pure, will_not_call_mercury],
+ putch3(C::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
"
- addch((chtype) C);
- IO = IO0;
+ addch((chtype) C);
").
%----------------------------------------------------------------------------%
-:- pred get_colour(colour, int).
-:- mode get_colour(in, out) is det.
+:- pred get_colour(colour::in, int::out) is det.
get_colour(black, black).
get_colour(green, green).
@@ -412,240 +428,232 @@ get_colour(magenta, magenta).
get_colour(blue, blue).
get_colour(yellow, yellow).
-:- pred chtype(char, int).
-:- mode chtype(in, out) is det.
+:- pred chtype(char::in, int::out) is det.
:- pragma foreign_proc("C",
- chtype(C::in, Ch::out),
- [promise_pure, will_not_call_mercury],
+ chtype(C::in, Ch::out),
+ [promise_pure, will_not_call_mercury],
"
- Ch = (chtype) C;
+ Ch = (chtype) C;
").
-:- pred mod_chtype(int, int, int).
-:- mode mod_chtype(in, in, out) is det.
+:- pred mod_chtype(int::in, int::in, int::out) is det.
:- pragma foreign_proc("C",
- mod_chtype(Ch0::in, Attr::in, Ch::out),
- [promise_pure, will_not_call_mercury],
+ mod_chtype(Ch0::in, Attr::in, Ch::out),
+ [promise_pure, will_not_call_mercury],
"
- Ch = (chtype) Ch0 | Attr;
+ Ch = (chtype) Ch0 | Attr;
").
%----------------------------------------------------------------------------%
-hide(Win) -->
- get_win(Win, Window),
- { Window = win(Parent, _, _, _, _, _, _) },
- get_win(Parent, PWindow0),
- { PWindow0 = win(PP, PC, PR, PO, PD, Visi0, Hidden0) },
- { filter((pred(Child::in) is semidet :-
- Child = child(_, _, Win)
- ), Visi0, This, Visi) },
- { append(This, Hidden0, Hidden) },
- { PWindow = win(PP, PC, PR, PO, PD, Visi, Hidden) },
- set_win(Parent, PWindow).
+hide(Win, !IO) :-
+ get_win(Win, Window, !IO),
+ Window = win(Parent, _, _, _, _, _, _),
+ get_win(Parent, PWindow0, !IO),
+ PWindow0 = win(PP, PC, PR, PO, PD, Visi0, Hidden0),
+ filter((pred(Child::in) is semidet :-
+ Child = child(_, _, Win)
+ ), Visi0, This, Visi),
+ append(This, Hidden0, Hidden),
+ PWindow = win(PP, PC, PR, PO, PD, Visi, Hidden),
+ set_win(Parent, PWindow, !IO).
%----------------------------------------------------------------------------%
-show(Win) -->
- get_win(Win, Window),
- { Window = win(Parent, _, _, _, _, _, _) },
- get_win(Parent, PWindow0),
- { PWindow0 = win(PP, PC, PR, PO, PD, Visi0, Hidden0) },
- { filter((pred(Child::in) is semidet :-
- Child = child(_, _, Win)
- ), Hidden0, This, Hidden) },
- { append(Visi0, This, Visi) },
- { PWindow = win(PP, PC, PR, PO, PD, Visi, Hidden) },
- set_win(Parent, PWindow).
+show(Win, !IO) :-
+ get_win(Win, Window, !IO),
+ Window = win(Parent, _, _, _, _, _, _),
+ get_win(Parent, PWindow0, !IO),
+ PWindow0 = win(PP, PC, PR, PO, PD, Visi0, Hidden0),
+ filter((pred(Child::in) is semidet :-
+ Child = child(_, _, Win)
+ ), Hidden0, This, Hidden),
+ append(Visi0, This, Visi),
+ PWindow = win(PP, PC, PR, PO, PD, Visi, Hidden),
+ set_win(Parent, PWindow, !IO).
%----------------------------------------------------------------------------%
-raise(Win) -->
- get_win(Win, Window),
- { Window = win(Parent, _, _, _, _, _, _) },
- get_win(Parent, PWindow0),
- { PWindow0 = win(PP, PC, PR, PO, PD, Visi0, Hidden) },
- { filter((pred(Child::in) is semidet :-
- Child = child(_, _, Win)
- ), Visi0, This, Rest) },
- { append(Rest, This, Visi) },
- { PWindow = win(PP, PC, PR, PO, PD, Visi, Hidden) },
- set_win(Parent, PWindow).
+raise(Win, !IO) :-
+ get_win(Win, Window, !IO),
+ Window = win(Parent, _, _, _, _, _, _),
+ get_win(Parent, PWindow0, !IO),
+ PWindow0 = win(PP, PC, PR, PO, PD, Visi0, Hidden),
+ filter((pred(Child::in) is semidet :-
+ Child = child(_, _, Win)
+ ), Visi0, This, Rest),
+ append(Rest, This, Visi),
+ PWindow = win(PP, PC, PR, PO, PD, Visi, Hidden),
+ set_win(Parent, PWindow, !IO).
%----------------------------------------------------------------------------%
-lower(Win) -->
- get_win(Win, Window),
- { Window = win(Parent, _, _, _, _, _, _) },
- get_win(Parent, PWindow0),
- { PWindow0 = win(PP, PC, PR, PO, PD, Visi0, Hidden) },
- { filter((pred(Child::in) is semidet :-
- Child = child(_, _, Win)
- ), Visi0, This, Rest) },
- { append(This, Rest, Visi) },
- { PWindow = win(PP, PC, PR, PO, PD, Visi, Hidden) },
- set_win(Parent, PWindow).
+lower(Win, !IO) :-
+ get_win(Win, Window, !IO),
+ Window = win(Parent, _, _, _, _, _, _),
+ get_win(Parent, PWindow0, !IO),
+ PWindow0 = win(PP, PC, PR, PO, PD, Visi0, Hidden),
+ filter((pred(Child::in) is semidet :-
+ Child = child(_, _, Win)
+ ), Visi0, This, Rest),
+ append(This, Rest, Visi),
+ PWindow = win(PP, PC, PR, PO, PD, Visi, Hidden),
+ set_win(Parent, PWindow, !IO).
%----------------------------------------------------------------------------%
-clear(Win) -->
- get_win(Win, win(Parent, Cols, Rows, Opts, Data0, Visi, Hidden)),
- { for(0, Rows-1, (pred(Y::in, array_di, array_uo) is det -->
- for(0, Cols-1, (pred(X::in, D0::array_di, D::array_uo) is det :-
- set(X+Y*Cols, ' ' - [], D0, D)
- ))
- ), u(Data0), Data) },
- set_win(Win, win(Parent, Cols, Rows, Opts, Data, Visi, Hidden)).
+clear(Win, !IO) :-
+ get_win(Win, win(Parent, Cols, Rows, Opts, Data0, Visi, Hidden), !IO),
+ for(0, Rows - 1, (pred(Y::in, array_di, array_uo) is det -->
+ for(0, Cols - 1, (pred(X::in, D0::array_di, D::array_uo) is det :-
+ set(X + Y * Cols, ' ' - [], D0, D)
+ ))
+ ), u(Data0), Data),
+ set_win(Win, win(Parent, Cols, Rows, Opts, Data, Visi, Hidden), !IO).
%----------------------------------------------------------------------------%
-scroll(Win, N) -->
- get_win(Win, win(Parent, Cols, Rows, Opts, Data0, Visi, Hidden)),
- { require(((pred) is semidet :-
- N > 0,
- N < Cols
- ), "scroll: out of range") },
- { for(0, Rows-N-1, (pred(Y::in, array_di, array_uo) is det -->
- for(0, Cols-1, (pred(X::in, D0::array_di, D::array_uo) is det :-
- lookup(D0, X+(Y+N)*Cols, C),
- set(X+Y*Cols, C, D0, D)
- ))
- ), u(Data0), Data1) },
- { for(Rows-N, Rows-1, (pred(Y::in, array_di, array_uo) is det -->
- for(0, Cols-1, (pred(X::in, D1::array_di, Q::array_uo) is det :-
- set(X+Y*Cols, ' ' - [], D1, Q)
- ))
- ), Data1, Data) },
- set_win(Win, win(Parent, Cols, Rows, Opts, Data, Visi, Hidden)).
+scroll(Win, N, !IO) :-
+ get_win(Win, win(Parent, Cols, Rows, Opts, Data0, Visi, Hidden), !IO),
+ require(((pred) is semidet :-
+ N > 0,
+ N < Cols
+ ), "scroll: out of range"),
+ for(0, Rows - N - 1, (pred(Y::in, array_di, array_uo) is det -->
+ for(0, Cols - 1, (pred(X::in, D0::array_di, D::array_uo) is det :-
+ lookup(D0, X + (Y + N) * Cols, C),
+ set(X + Y * Cols, C, D0, D)
+ ))
+ ), u(Data0), Data1),
+ for(Rows - N, Rows - 1, (pred(Y::in, array_di, array_uo) is det -->
+ for(0, Cols - 1, (pred(X::in, D1::array_di, Q::array_uo) is det :-
+ set(X + Y * Cols, ' ' - [], D1, Q)
+ ))
+ ), Data1, Data),
+ set_win(Win, win(Parent, Cols, Rows, Opts, Data, Visi, Hidden), !IO).
%----------------------------------------------------------------------------%
-place_char(Win, X, Y, C - As) -->
- get_win(Win, win(Parent, Cols, Rows, Opts, Data0, Visi, Hidden)),
- { require(((pred) is semidet :-
- X >= 0, Y >= 0,
- X < Cols, Y < Cols
- ), "place_char: out of range") },
- { set(X+Y*Cols, C - As, u(Data0), Data) },
- set_win(Win, win(Parent, Cols, Rows, Opts, Data, Visi, Hidden)).
+place_char(Win, X, Y, C - As, !IO) :-
+ get_win(Win, win(Parent, Cols, Rows, Opts, Data0, Visi, Hidden), !IO),
+ require(((pred) is semidet :-
+ X >= 0, Y >= 0,
+ X < Cols, Y < Cols
+ ), "place_char: out of range"),
+ set(X + Y * Cols, C - As, u(Data0), Data),
+ set_win(Win, win(Parent, Cols, Rows, Opts, Data, Visi, Hidden), !IO).
:- func u(array(T)) = array(T).
:- mode (u(in) = array_uo) is det.
:- pragma foreign_proc("C",
- u(A::in) = (B::array_uo),
- [promise_pure, will_not_call_mercury],
+ u(A::in) = (B::array_uo),
+ [promise_pure, will_not_call_mercury],
"
- B = A;
+ B = A;
").
%----------------------------------------------------------------------------%
-place_string(Win, X, Y, Str) -->
- get_win(Win, win(Parent, Cols, Rows, Opts, Data0, Visi, Hidden)),
- { require(((pred) is semidet :-
- X >= 0, Y >= 0,
- X < Cols, Y < Cols
- ), "place_string: out of range") },
- { string.to_char_list(Str, Chars) },
- { update_data(Chars, Y*Cols, X, X+Cols, u(Data0), Data) },
- set_win(Win, win(Parent, Cols, Rows, Opts, Data, Visi, Hidden)).
-
-:- pred update_data(list(char), int, int, int, array(pair(char, list(cattr))),
- array(pair(char, list(cattr)))).
-:- mode update_data(in, in, in, in, array_di, array_uo) is det.
-
-update_data([], _, _, _, Data, Data).
-update_data([C|Cs], Y, X, Xmax, Data0, Data) :-
- ( X < Xmax ->
- set(X+Y, C - [], Data0, Data1),
- update_data(Cs, Y, X+1, Xmax, Data1, Data)
- ;
- Data = Data0
- ).
+place_string(Win, X, Y, Str, !IO) :-
+ get_win(Win, win(Parent, Cols, Rows, Opts, Data0, Visi, Hidden), !IO),
+ require(((pred) is semidet :-
+ X >= 0, Y >= 0,
+ X < Cols, Y < Cols
+ ), "place_string: out of range"),
+ string.to_char_list(Str, Chars),
+ update_data(Chars, Y * Cols, X, X + Cols, u(Data0), Data),
+ set_win(Win, win(Parent, Cols, Rows, Opts, Data, Visi, Hidden), !IO).
+
+:- pred update_data(list(char)::in, int::in, int::in, int::in,
+ array(pair(char, list(cattr)))::array_di,
+ array(pair(char, list(cattr)))::array_uo) is det.
+
+update_data([], _, _, _, !Data).
+update_data([C | Cs], Y, X, Xmax, !Data) :-
+ ( if X < Xmax then
+ array.set(X + Y, C - [], !Data),
+ update_data(Cs, Y, X + 1, Xmax, !Data)
+ else
+ true
+ ).
%----------------------------------------------------------------------------%
-:- pred get_root(win, io, io).
-:- mode get_root(out, di, uo) is det.
-
-:- pred set_root(win, io, io).
-:- mode set_root(in, di, uo) is det.
-
:- pragma foreign_decl("C", "
- extern MR_Word curse_root;
+ extern MR_Word curse_root;
").
:- pragma foreign_code("C", "
- MR_Word curse_root;
+ MR_Word curse_root;
").
+:- pred get_root(win::out, io::di, io::uo) is det.
+
:- pragma foreign_proc("C",
- get_root(W::out, IO0::di, IO::uo),
- [promise_pure, will_not_call_mercury],
+ get_root(W::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
"
- W = curse_root;
- IO = IO0;
+ W = curse_root;
").
+:- pred set_root(win::in, io::di, io::uo) is det.
+
:- pragma foreign_proc("C",
- set_root(W::in, IO0::di, IO::uo),
- [promise_pure, will_not_call_mercury],
+ set_root(W::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
"
- curse_root = W;
- IO = IO0;
+ curse_root = W;
").
%----------------------------------------------------------------------------%
:- pred new_win(window::in, win::out, io::di, io::uo) is det.
-new_win(Window, Win) -->
- get_curse_store(Curse0),
- { store.new_mutvar(Window, Win, Curse0, Curse) },
- set_curse_store(Curse).
+new_win(Window, Win, !IO) :-
+ get_curse_store(Curse0, !IO),
+ store.new_mutvar(Window, Win, Curse0, Curse),
+ set_curse_store(Curse, !IO).
:- pred get_win(win::in, window::out, io::di, io::uo) is det.
-get_win(Win, Window) -->
- get_curse_store(Curse0),
- { store.get_mutvar(Win, Window, Curse0, Curse) },
- set_curse_store(Curse).
+get_win(Win, Window, !IO) :-
+ get_curse_store(Curse0, !IO),
+ store.get_mutvar(Win, Window, Curse0, Curse),
+ set_curse_store(Curse, !IO).
:- pred set_win(win::in, window::in, io::di, io::uo) is det.
-set_win(Win, Window) -->
- get_curse_store(Curse0),
- { store.set_mutvar(Win, Window, Curse0, Curse) },
- set_curse_store(Curse).
+set_win(Win, Window, !IO) :-
+ get_curse_store(Curse0, !IO),
+ store.set_mutvar(Win, Window, Curse0, Curse),
+ set_curse_store(Curse, !IO).
%----------------------------------------------------------------------------%
-:- pred get_cursor(cursor::out, io::di, io::uo) is det.
-
-:- pred set_cursor(cursor::in, io::di, io::uo) is det.
-
:- pragma foreign_decl("C", "
- extern MR_Word curse_cursor;
+ extern MR_Word curse_cursor;
").
:- pragma foreign_code("C", "
- MR_Word curse_cursor;
+ MR_Word curse_cursor;
").
+:- pred get_cursor(cursor::out, io::di, io::uo) is det.
+
:- pragma foreign_proc("C",
- get_cursor(C::out, I0::di, I::uo),
- [promise_pure, will_not_call_mercury],
+ get_cursor(C::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
"
- C = curse_cursor;
- I = I0;
+ C = curse_cursor;
").
+:- pred set_cursor(cursor::in, io::di, io::uo) is det.
+
:- pragma foreign_proc("C",
- set_cursor(C::in, I0::di, I::uo),
- [promise_pure, will_not_call_mercury],
+ set_cursor(C::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
"
- curse_cursor = C;
- I = I0;
+ curse_cursor = C;
").
%----------------------------------------------------------------------------%
@@ -654,47 +662,43 @@ set_win(Win, Window) -->
% You need to be careful to ensure that get_curse_store
% and set_curse_store are only ever used in pairs.
-:- pred init_curse_store(curse_store::uo) is det.
-
-:- pred get_curse_store(curse_store::uo, io::di, io::uo) is det.
-
-:- pred set_curse_store(curse_store::di, io::di, io::uo) is det.
-
:- pragma foreign_decl("C", "
- extern MR_Word curse_store;
+ extern MR_Word curse_store;
").
:- pragma foreign_code("C", "
- MR_Word curse_store;
+ MR_Word curse_store;
").
+:- pred init_curse_store(curse_store::uo) is det.
+
:- pragma foreign_proc("C",
- init_curse_store(C::uo),
- [promise_pure, will_not_call_mercury],
+ init_curse_store(C::uo),
+ [promise_pure, will_not_call_mercury],
"
- /*
- ** Here we rely on the fact that stores have no
- ** real representation, so we can fill in any
- ** dummy value for C.
- */
- C = 0;
+ // Here we rely on the fact that stores have no real representation, so we
+ // can fill in any dummy value for C.
+ C = 0;
").
+:- pred get_curse_store(curse_store::uo, io::di, io::uo) is det.
+
:- pragma foreign_proc("C",
- get_curse_store(C::uo, I0::di, I::uo),
- [promise_pure, will_not_call_mercury],
+ get_curse_store(C::uo, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
"
- C = curse_store;
- I = I0;
+ C = curse_store;
").
+:- pred set_curse_store(curse_store::di, io::di, io::uo) is det.
+
:- pragma foreign_proc("C",
- set_curse_store(C::di, I0::di, I::uo),
- [promise_pure, will_not_call_mercury],
+ set_curse_store(C::di, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
"
- curse_store = C;
- I = I0;
+ curse_store = C;
").
%----------------------------------------------------------------------------%
-
+:- end_module mcurses.user.
+%----------------------------------------------------------------------------%
diff --git a/extras/curses/sample/Mmakefile b/extras/curses/sample/Mmakefile
index 5195cbd3b..fca820421 100644
--- a/extras/curses/sample/Mmakefile
+++ b/extras/curses/sample/Mmakefile
@@ -2,6 +2,8 @@
# vim: ts=8 sw=8 noexpandtab
#-----------------------------------------------------------------------------#
+include ../Ncurses.options
+
# Specify location of the mcurses library
MCURSES_DIR = ..
@@ -14,7 +16,7 @@ MLFLAGS = -R$(MCURSES_DIR) $(EXTRA_MLFLAGS) \
# Note that you have to tell the linker to use the mcurses library
# AND the ncurses library (which mcurses is an interface for)
-MLLIBS = -lmcurses -lncurses $(EXTRA_MLLIBS)
+MLLIBS = -lmcurses $(NCURSES_LIBS) $(EXTRA_MLLIBS)
C2INITARGS = $(MCURSES_DIR)/mcurses.init
default_target: smalltest
More information about the reviews
mailing list