[m-rev.] diff: improvements for building extras/curs
Julien Fischer
jfischer at opturion.com
Sun Jan 23 19:19:38 AEDT 2022
Improvements for building extras/curs.
Separate out the details of how to link against ncurses and the panel library
into a separate file. Include this new file in both the top-level and samples
Mmakefiles and use the variables it defines to link against ncurses.
Document how to to use the ncursesN-config and pkg-config tools to find
the correct set of flags to link against ncurses. Using ncursesN-config
was suggested by Fabrice Nicol in a change he recently posted.
General cleanups.
extras/curs/Ncurses.options:
New file defining variables that control how to link against ncurses
and the panel library.
Document some ways of finding the correct set of flags.
Document how to override the contents of this file on the command line.
extras/curs/Mmakefile:
Include the Ncurses.options file.
Refer users to that file for controlling how to link against
ncurses.
extras/curs/samples/Mmakefile:
Import Ncurses.options instead of hardcoding the library flags here.
extras/curs/curs.m:
Shift vim modeline into our usual place.
Update copyright notice.
Point users to Ncurses.options.
extras/curs/samples/*.m:
Replace tabs with spaces.
Delete trailing whitespace.
Minor cleanups.
Julien.
diff --git a/extras/curs/Mmakefile b/extras/curs/Mmakefile
index e62552e2b..31cefd8d5 100644
--- a/extras/curs/Mmakefile
+++ b/extras/curs/Mmakefile
@@ -8,14 +8,20 @@
# BE RELEASED UNDER WHATEVER LICENCE IS DEEMED APPROPRIATE
# BY THE ADMINISTRATORS OF THE MERCURY PROJECT.
+include Ncurses.options
+
# To build, do the following:
#
-# $ mmake depend
-# $ mmake
+# Check that the values in the file Ncurses.options are appropriate
+# for linking against ncurses on your system.
+# Then do:
+#
+# $ mmake depend
+# $ mmake
#
# And to install...
#
-# $ mmake install
+# $ mmake install
# Omit this line if you want to install in the standard location.
# Edit this line if you want to install the library elsewhere.
@@ -30,11 +36,11 @@ INSTALL_PREFIX := $(INSTALL_PREFIX)/extras
#
#LIBGRADES = asm_fast.gc hlc.gc
-# The following standard libraries must be linked against in any
-# application using the curs library (i.e. MLLIBS must include
-# at least the following and in this order) :
+# The following libraries must be linked against in any application using the
+# curs library (i.e. MLLIBS must include at least the following and in this
+# order).
#
-MLLIBS = -lpanel -lncurses
+MLLIBS = $(PANEL_LIBS) $(NCURSES_LIBS)
# Any application using this library will also need the following
# in its Mmakefile:
diff --git a/extras/curs/Ncurses.options b/extras/curs/Ncurses.options
index e69de29bb..7a4e4614b 100644
--- a/extras/curs/Ncurses.options
+++ b/extras/curs/Ncurses.options
@@ -0,0 +1,30 @@
+# 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
+
+# The flags for linking against the ncurses panel library.
+#
+PANEL_LIBS = -lpanel
diff --git a/extras/curs/curs.m b/extras/curs/curs.m
index 30f26f9df..01b60fe57 100644
--- a/extras/curs/curs.m
+++ b/extras/curs/curs.m
@@ -1,8 +1,12 @@
%-----------------------------------------------------------------------------%
-% 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
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2001 Ralph Becket <rbeck at microsoft.com>
+% Copyright (C) 2001-2002, 2004-2006 The University of Melbourne.
+% Copyright (C) 2021-2022 The Mercury team.
+%---------------------------------------------------------------------------%
+%
+% File: curs.m
%
% THIS FILE IS HEREBY CONTRIBUTED TO THE MERCURY PROJECT TO
% BE RELEASED UNDER WHATEVER LICENCE IS DEEMED APPROPRIATE
@@ -10,15 +14,16 @@
%
% Simplified Mercury interface to the ncurses and panel libraries.
%
-% This is largely inspired by Tomas Conway and Robert Jeschofnik's
+% This is largely inspired by Thomas Conway and Robert Jeschofnik's
% mcurses module; it is intended to more closely match the facilities
% offered by the ncurses package and leave the issue of window management
% to the ncurses and panel libraries rather than doing so in Mercury.
%
-% XXX This module no error checking.
+% XXX This module does no error checking.
%
-% NOTE: you will need to include `-lpanel -lncurses' in MLLIBS when
-% linking against this module.
+% NOTE: you will need to include the correct flags for linking against
+% ncurses and the panel library in MLLIBS when linking against this module.
+% See Ncurses.options for details.
%
%-----------------------------------------------------------------------------%
@@ -1060,7 +1065,7 @@ addstr(Attr, Str, !IO) :-
#include <panel.h>
").
-
+
:- pragma foreign_type("C", panel, "PANEL *").
%-------------------------------------------------------------------------%
@@ -1191,7 +1196,7 @@ addstr(Attr, Str, !IO) :-
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],
@@ -1251,4 +1256,5 @@ addstr(Attr, Str, !IO) :-
%-------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
+:- end_module curs.
%-----------------------------------------------------------------------------%
diff --git a/extras/curs/samples/Mmakefile b/extras/curs/samples/Mmakefile
index ead0f1d34..2ab49395d 100644
--- a/extras/curs/samples/Mmakefile
+++ b/extras/curs/samples/Mmakefile
@@ -8,6 +8,8 @@
# BE RELEASED UNDER WHATEVER LICENCE IS DEEMED APPROPRIATE
# BY THE ADMINISTRATORS OF THE MERCURY PROJECT.
+include ../Ncurses.options
+
# Specify the location of the `mypackage' and `myotherlib' directories
#
CURS_DIR = ..
@@ -24,9 +26,11 @@ demos: $(DEMOS)
VPATH = $(CURS_DIR):$(MMAKE_VPATH)
MCFLAGS = -I$(CURS_DIR) $(EXTRA_MCFLAGS)
CFLAGS = -I$(CURS_DIR)
-MLFLAGS = -R$(CURS_DIR) $(EXTRA_MLFLAGS) \
- -L$(CURS_DIR)
-MLLIBS = -lcurs -lpanel -lncurses $(EXTRA_MLLIBS)
+MLFLAGS = -R$(CURS_DIR) $(EXTRA_MLFLAGS) -L$(CURS_DIR)
+
+# You should check that the definitions of PANEL_LIBS and NCURSES_LIBS
+# in ../Ncurses.options are correct for your system.
+MLLIBS = -lcurs $(PANEL_LIBS) $(NCURSES_LIBS) $(EXTRA_MLLIBS)
C2INITARGS = $(CURS_DIR)/curs.init
MAIN_TARGET = all
diff --git a/extras/curs/samples/demo.m b/extras/curs/samples/demo.m
index 60f996dd1..eb96385ce 100644
--- a/extras/curs/samples/demo.m
+++ b/extras/curs/samples/demo.m
@@ -1,8 +1,8 @@
%-----------------------------------------------------------------------------%
+% vim: ts=4 sw=4 et tw=0 wm=0 ff=unix ft=mercury
+%-----------------------------------------------------------------------------%
% 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
-%
%
% THIS FILE IS HEREBY CONTRIBUTED TO THE MERCURY PROJECT TO
% BE RELEASED UNDER WHATEVER LICENCE IS DEEMED APPROPRIATE
@@ -78,15 +78,15 @@ main(!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),
@@ -145,4 +145,5 @@ raise_panel(P, PanelData, !IO) :-
main_loop(P, PanelData, !IO).
%-----------------------------------------------------------------------------%
+:- end_module demo.
%-----------------------------------------------------------------------------%
diff --git a/extras/curs/samples/frogger.m b/extras/curs/samples/frogger.m
index 029c63006..127bcc943 100644
--- a/extras/curs/samples/frogger.m
+++ b/extras/curs/samples/frogger.m
@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
+% vim: ts=4 sw=4 et tw=0 wm=0 ff=unix ft=mercury
+%-----------------------------------------------------------------------------%
%
% A frogger clone, by Peter Wang.
% This source file is hereby placed in the public domain.
@@ -31,76 +33,77 @@
%-----------------------------------------------------------------------------%
:- type world
- ---> world(
- lives :: int,
- remaining_goals :: int,
- frog :: frog,
- level :: level
- ).
+ ---> world(
+ lives :: int,
+ remaining_goals :: int,
+ frog :: frog,
+ level :: level
+ ).
:- type frog
- ---> frog(
- frog_x :: int,
- frog_y :: int
- ).
+ ---> frog(
+ frog_x :: int,
+ frog_y :: int
+ ).
-:- type level == list(row).
+:- type level == list(row).
:- type row
- ---> row(
- scroll :: scroll,
- str :: string
- ).
+ ---> row(
+ scroll :: scroll,
+ str :: string
+ ).
:- type scroll
- ---> stationary
- ; leftwards(int, leftwards_counter::int, bool)
- ; rightwards(int, rightwards_counter::int, bool)
- .
+ ---> stationary
+ ; leftwards(int, leftwards_counter::int, bool)
+ ; rightwards(int, rightwards_counter::int, bool).
:- func initial_world = world.
initial_world = world(
- 3, % lives
- 5, % remaining_goals
- initial_frog,
- initial_level
+ 3, % lives
+ 5, % remaining_goals
+ initial_frog,
+ initial_level
).
:- func width = int.
-:- func height = int.
width = string.length(list.det_head(initial_level) ^ str).
+
+:- func height = int.
+
height = list.length(initial_level).
:- func initial_frog = frog.
-initial_frog = frog(width/2, height-1).
+initial_frog = frog(width / 2, height - 1).
:- func initial_level = level.
initial_level = [
- row(stationary, "............................"),
- row(stationary, ":gg::::gg::::gg::::gg::::gg:"),
- row(rightwards(5, 0, yes), "~LLLLLL~~~~LLLLLLL~~~LLLLLL~"),
- row(leftwards(4, 0, yes), "~~~TtTt~~~~TtTt~~TtTt~~~TtTt"),
- row(rightwards(6, 0, yes), "L~~~~~LLLLLLLLLL~~~~~~LLLLLL"),
- row(leftwards(7, 0, yes), "TtTt~~~TtTt~~~TtTt~~~~TtTt~~"),
- row(stationary, "============================"),
- row(leftwards(5, 0, no), " Cccc Cccc"),
- row(rightwards(1, 0, no), " cC "),
- row(leftwards(7, 0, no), " Cc Cc Cc"),
- row(rightwards(6, 0, no), " cC cC cC "),
- row(leftwards(8, 0, no), "Cc Cc Cc "),
- row(stationary, "============================")
+ row(stationary, "............................"),
+ row(stationary, ":gg::::gg::::gg::::gg::::gg:"),
+ row(rightwards(5, 0, yes), "~LLLLLL~~~~LLLLLLL~~~LLLLLL~"),
+ row(leftwards(4, 0, yes), "~~~TtTt~~~~TtTt~~TtTt~~~TtTt"),
+ row(rightwards(6, 0, yes), "L~~~~~LLLLLLLLLL~~~~~~LLLLLL"),
+ row(leftwards(7, 0, yes), "TtTt~~~TtTt~~~TtTt~~~~TtTt~~"),
+ row(stationary, "============================"),
+ row(leftwards(5, 0, no), " Cccc Cccc"),
+ row(rightwards(1, 0, no), " cC "),
+ row(leftwards(7, 0, no), " Cc Cc Cc"),
+ row(rightwards(6, 0, no), " cC cC cC "),
+ row(leftwards(8, 0, no), "Cc Cc Cc "),
+ row(stationary, "============================")
].
:- pred goal_char(char::in) is semidet.
goal_char('g').
- % Frog cannot touch even a single one of these chars.
- %
+ % Frog cannot touch even a single one of these chars.
+ %
:- pred frog_cant_touch_1(char::in) is semidet.
frog_cant_touch_1('<').
@@ -110,8 +113,8 @@ frog_cant_touch_1(':').
frog_cant_touch_1('C').
frog_cant_touch_1('c').
- % Frog can touch at most one of these chars.
- %
+ % Frog can touch at most one of these chars.
+ %
:- pred frog_cant_touch_2(char::in) is semidet.
frog_cant_touch_2('~').
@@ -124,76 +127,81 @@ game_loop_rate = 1000000 / 40.
%-----------------------------------------------------------------------------%
main(!IO) :-
- curs.start(!IO),
- curs.nodelay(yes, !IO),
- curs.flushinp(!IO),
- game_loop(initial_world, !IO),
- curs.stop(!IO).
+ curs.start(!IO),
+ curs.nodelay(yes, !IO),
+ curs.flushinp(!IO),
+ game_loop(initial_world, !IO),
+ curs.stop(!IO).
:- pred game_loop(world::in, io::di, io::uo) is det.
game_loop(!.World, !IO) :-
- (if !.World ^ lives < 1 then
- end_game(" G A M E O V E R ", !IO)
- else if !.World ^ remaining_goals < 1 then
- end_game(" Y O U W O N ! ", !IO)
- else
- handle_input(!World, !IO, Quit),
- (
- Quit = no,
- handle_logic(!World),
- draw_world(!.World, !IO),
- sleep.usleep(game_loop_rate, !IO),
- move_world(!World),
- game_loop(!.World, !IO)
- ;
- Quit = yes
- )
- ).
+ (if !.World ^ lives < 1 then
+ end_game(" G A M E O V E R ", !IO)
+ else if !.World ^ remaining_goals < 1 then
+ end_game(" Y O U W O N ! ", !IO)
+ else
+ handle_input(!World, !IO, Quit),
+ (
+ Quit = no,
+ handle_logic(!World),
+ draw_world(!.World, !IO),
+ sleep.usleep(game_loop_rate, !IO),
+ move_world(!World),
+ game_loop(!.World, !IO)
+ ;
+ Quit = yes
+ )
+ ).
%-----------------------------------------------------------------------------%
:- pred draw_world(world::in, io::di, io::uo) is det.
-:- pred draw_level(level::in, io::di, io::uo) is det.
-:- pred draw_level_2(int::in, level::in, io::di, io::uo) is det.
-:- pred draw_row(int::in, string::in, io::di, io::uo) is det.
-:- pred draw_frog(frog::in, io::di, io::uo) is det.
-:- pred draw_status(int::in, io::di, io::uo) is det.
draw_world(World, !IO) :-
- curs.clear(!IO),
- draw_level(World ^ level, !IO),
- draw_frog(World ^ frog, !IO),
- draw_status(World ^ lives, !IO).
+ curs.clear(!IO),
+ draw_level(World ^ level, !IO),
+ draw_frog(World ^ frog, !IO),
+ draw_status(World ^ lives, !IO).
+
+:- pred draw_level(level::in, io::di, io::uo) is det.
draw_level(Level, !IO) :-
- draw_level_2(0, Level, !IO).
+ draw_level_2(0, Level, !IO).
+
+:- pred draw_level_2(int::in, level::in, io::di, io::uo) is det.
draw_level_2(_RowNumber, [], !_IO).
draw_level_2(RowNumber, [Row | Rows], !IO) :-
- curs.move(RowNumber, 0, !IO),
- draw_row(0, Row ^ str, !IO),
- draw_level_2(RowNumber+1, Rows, !IO).
+ curs.move(RowNumber, 0, !IO),
+ draw_row(0, Row ^ str, !IO),
+ draw_level_2(RowNumber + 1, Rows, !IO).
+
+:- pred draw_row(int::in, string::in, io::di, io::uo) is det.
draw_row(N, Str, !IO) :-
- (if string.index(Str, N, C) then
- curs.addch(curs.normal, char.to_int(visualise(C)), !IO),
- draw_row(N+1, Str, !IO)
- else
- true
- ).
+ ( if string.index(Str, N, C) then
+ curs.addch(curs.normal, char.to_int(visualise(C)), !IO),
+ draw_row(N + 1, Str, !IO)
+ else
+ true
+ ).
+
+:- pred draw_frog(frog::in, io::di, io::uo) is det.
draw_frog(frog(X, Y), !IO) :-
- curs.move(Y, X, !IO),
- curs.addstr(curs.standout, "<>", !IO).
+ curs.move(Y, X, !IO),
+ curs.addstr(curs.standout, "<>", !IO).
+
+:- pred draw_status(int::in, io::di, io::uo) is det.
draw_status(Lives, !IO) :-
- curs.move(height, 0, !IO),
- curs.addstr(curs.normal, String, !IO),
- String = string.format(" Lives: %d ", [i(Lives)]).
+ curs.move(height, 0, !IO),
+ curs.addstr(curs.normal, String, !IO),
+ String = string.format(" Lives: %d ", [i(Lives)]).
- % On screen the 'g' goal tiles are drawn as blanks.
- %
+ % On screen the 'g' goal tiles are drawn as blanks.
+ %
:- func visualise(char) = char.
visualise(Char) = (if Char = 'g' then ' ' else Char).
@@ -203,34 +211,34 @@ visualise(Char) = (if Char = 'g' then ' ' else Char).
:- pred end_game(string::in, io::di, io::uo) is det.
end_game(Message, !IO) :-
- curs.rows_cols(Rows, Cols, !IO),
- curs.move(Rows/2, (Cols/2) - string.length(Message)/2, !IO),
- curs.addstr(curs.normal, Message, !IO),
- curs.refresh(!IO),
- sleep.usleep(1000000, !IO).
+ curs.rows_cols(Rows, Cols, !IO),
+ curs.move(Rows / 2, (Cols / 2) - string.length(Message) / 2, !IO),
+ curs.addstr(curs.normal, Message, !IO),
+ curs.refresh(!IO),
+ sleep.usleep(1000000, !IO).
%-----------------------------------------------------------------------------%
:- pred handle_input(world::in, world::out, io::di, io::uo, bool::out) is det.
handle_input(!World, !IO, Quit) :-
- curs.getch(K, !IO),
- (if is_quit(K) then
- Quit = yes
- else
- Quit = no,
- (if K = curs.key_left then
- move_frog_left(!World)
- else if K = curs.key_right then
- move_frog_right(!World)
- else if K = curs.key_up then
- move_frog_up(!World)
- else if K = curs.key_down then
- move_frog_down(!World)
- else
- true
- )
- ).
+ curs.getch(K, !IO),
+ ( if is_quit(K) then
+ Quit = yes
+ else
+ Quit = no,
+ ( if K = curs.key_left then
+ move_frog_left(!World)
+ else if K = curs.key_right then
+ move_frog_right(!World)
+ else if K = curs.key_up then
+ move_frog_up(!World)
+ else if K = curs.key_down then
+ move_frog_down(!World)
+ else
+ true
+ )
+ ).
:- pred is_quit(int::in) is semidet.
@@ -238,129 +246,137 @@ is_quit(char.to_int('q')).
is_quit(27). % escape
:- pred move_frog_left(world::in, world::out) is det.
-:- pred move_frog_right(world::in, world::out) is det.
-:- pred move_frog_up(world::in, world::out) is det.
-:- pred move_frog_down(world::in, world::out) is det.
move_frog_left(World0, World) :-
- World0 ^ frog = frog(X, Y),
- World = World0 ^ frog := frog(max(0, X-1), Y).
+ World0 ^ frog = frog(X, Y),
+ World = World0 ^ frog := frog(max(0, X - 1), Y).
+
+:- pred move_frog_right(world::in, world::out) is det.
move_frog_right(World0, World) :-
- World0 ^ frog = frog(X, Y),
- World = World0 ^ frog := frog(min(width-2, X+1), Y).
+ World0 ^ frog = frog(X, Y),
+ World = World0 ^ frog := frog(min(width - 2, X + 1), Y).
+
+:- pred move_frog_up(world::in, world::out) is det.
move_frog_up(World0, World) :-
- World0 ^ frog = frog(X, Y),
- World = World0 ^ frog := frog(X, max(0, Y-1)).
+ World0 ^ frog = frog(X, Y),
+ World = World0 ^ frog := frog(X, max(0, Y - 1)).
+
+:- pred move_frog_down(world::in, world::out) is det.
move_frog_down(World0, World) :-
- World0 ^ frog = frog(X, Y),
- World = World0 ^ frog := frog(X, min(height-1, Y+1)).
+ World0 ^ frog = frog(X, Y),
+ World = World0 ^ frog := frog(X, min(height - 1, Y + 1)).
%-----------------------------------------------------------------------------%
:- pred move_world(world::in, world::out) is det.
+
move_world(World0, World) :-
- move_world_2(0, World0 ^ level, Level, World0 ^ frog, Frog),
- World = ((World0 ^ level := Level)
- ^ frog := Frog).
+ 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.
+ 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, Row0, Row, Frog0, Frog1),
+ move_world_2(RowNumber+1, Rows0, Rows, Frog1, 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
- string.split(String, 1, Prefix, Suffix),
- Row = row(leftwards(Speed, 0, DragFrog), Suffix ++ Prefix),
- (if DragFrog = yes,
- RowNumber = FrogY
- then
- Frog = frog(max(0, FrogX-1), FrogY)
- else
- Frog = Frog0
- )
- else
- Row = row(leftwards(Speed, Counter+1, DragFrog), String),
- Frog = Frog0
- ).
-
-move_row(RowNumber, row(rightwards(Speed, Counter, DragFrog), String), Row,
- Frog0 @ frog(FrogX, FrogY), Frog) :-
- (if Counter = Speed then
- string.split(String, width-1, Prefix, Suffix),
- Row = row(rightwards(Speed, 0, DragFrog), Suffix ++ Prefix),
- (if DragFrog = yes,
- RowNumber = FrogY
- then
- Frog = frog(min(width-2, FrogX+1), FrogY)
- else
- Frog = Frog0
- )
- else
- Row = row(rightwards(Speed, Counter+1, DragFrog), String),
- Frog = Frog0
- ).
+ Frog0 @ frog(FrogX, FrogY), Frog) :-
+ ( if Counter = Speed then
+ string.split(String, 1, Prefix, Suffix),
+ Row = row(leftwards(Speed, 0, DragFrog), Suffix ++ Prefix),
+ (if DragFrog = yes,
+ RowNumber = FrogY
+ then
+ Frog = frog(max(0, FrogX-1), FrogY)
+ else
+ Frog = Frog0
+ )
+ else
+ Row = row(leftwards(Speed, Counter+1, DragFrog), String),
+ Frog = Frog0
+ ).
+
+move_row(RowNumber, row(rightwards(Speed, Counter, DragFrog), String), Row,
+ Frog0 @ frog(FrogX, FrogY), Frog) :-
+ ( if Counter = Speed then
+ string.split(String, width - 1, Prefix, Suffix),
+ Row = row(rightwards(Speed, 0, DragFrog), Suffix ++ Prefix),
+ ( if DragFrog = yes,
+ RowNumber = FrogY
+ then
+ Frog = frog(min(width-2, FrogX+1), FrogY)
+ else
+ Frog = Frog0
+ )
+ else
+ Row = row(rightwards(Speed, Counter+1, DragFrog), String),
+ Frog = Frog0
+ ).
%-----------------------------------------------------------------------------%
:- pred handle_logic(world::in, world::out) is det.
handle_logic(!World) :-
- ( check_frog_in_goal(!World) -> true
- ; check_frog_went_splat(!World) -> true
- ; true
- ).
+ ( if check_frog_in_goal(!World) then
+ true
+ else if check_frog_went_splat(!World) then
+ true
+ else
+ 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),
- goal_char(C2),
- stamp_frog_in_goal(World0, World1),
- World = ((World1 ^ remaining_goals := World0 ^ remaining_goals-1)
- ^ frog := initial_frog).
+ chars_at_frog(World0, C1, C2),
+ goal_char(C1),
+ goal_char(C2),
+ stamp_frog_in_goal(World0, World1),
+ 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)
- ; frog_cant_touch_1(C2)
- ; frog_cant_touch_2(C1), frog_cant_touch_2(C2)
- ),
- World = ((World0 ^ lives := World0 ^ lives - 1)
- ^ frog := initial_frog).
+ chars_at_frog(World0, C1, C2),
+ ( frog_cant_touch_1(C1)
+ ; frog_cant_touch_1(C2)
+ ; frog_cant_touch_2(C1), frog_cant_touch_2(C2)
+ ),
+ 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.det_index0(World ^ level, Y),
- C1 = string.det_index(Row ^ str, X),
- C2 = string.det_index(Row ^ str, X + 1).
+ frog(X, Y) = World ^ frog,
+ Row = list.det_index0(World ^ level, Y),
+ C1 = string.det_index(Row ^ str, X),
+ C2 = string.det_index(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.det_index0(Level, Y),
- NewStr = string.det_set_char('<', X,
- string.det_set_char('>', X + 1, Row ^ str)),
- NewRow = Row ^ str := NewStr,
- NewLevel = list.det_replace_nth(Level, Y + 1, NewRow),
- World = World0 ^ level := NewLevel.
+ frog(X, Y) = World0 ^ frog,
+ Level = World0 ^ level,
+ Row = list.det_index0(Level, Y),
+ NewStr = string.det_set_char('<', X,
+ string.det_set_char('>', X + 1, Row ^ str)),
+ NewRow = Row ^ str := NewStr,
+ NewLevel = list.det_replace_nth(Level, Y + 1, NewRow),
+ World = World0 ^ level := NewLevel.
%-----------------------------------------------------------------------------%
+:- end_module frogger.
%-----------------------------------------------------------------------------%
diff --git a/extras/curs/samples/nibbles.m b/extras/curs/samples/nibbles.m
index d08f262bd..5d7fc982c 100644
--- a/extras/curs/samples/nibbles.m
+++ b/extras/curs/samples/nibbles.m
@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
+% vim: ts=4 sw=4 et tw=0 wm=0 ff=unix ft=mercury
+%-----------------------------------------------------------------------------%
%
% A nibbles clone by Peter Wang.
% This source file is hereby placed in the public domain.
@@ -36,100 +38,100 @@
:- type rs == random.supply.
:- type world
- ---> world(
- cols :: int,
- rows :: int,
- snake :: snake,
- next_apple_num :: int,
- apple :: apple,
- score :: int
- ).
+ ---> world(
+ cols :: int,
+ rows :: int,
+ snake :: snake,
+ next_apple_num :: int,
+ apple :: apple,
+ score :: int
+ ).
:- type snake
- ---> snake(
- direction :: direction,
- head :: segment,
- tail :: list(segment),
- growth :: int
- ).
+ ---> snake(
+ direction :: direction,
+ head :: segment,
+ tail :: list(segment),
+ growth :: int
+ ).
:- type direction
- ---> up
- ; down
- ; left
- ; right.
+ ---> up
+ ; down
+ ; left
+ ; right.
-:- type segment == {int, int}.
+:- type segment == {int, int}.
:- type apple
- ---> no_apple
- ; apple(
- x :: int,
- y :: int,
- repr :: int
- ).
+ ---> no_apple
+ ; apple(
+ x :: int,
+ y :: int,
+ repr :: int
+ ).
%-----------------------------------------------------------------------------%
main(!IO) :-
- time.time(Now, !IO),
- time.localtime(Now, LocalNow, !IO),
- random.init(LocalNow ^ tm_min * 60 + LocalNow ^ tm_sec, RS),
- curs.start(!IO),
- curs.nodelay(yes, !IO),
- curs.rows_cols(Rows, Cols, !IO),
- curs.flushinp(!IO),
- play_game(Cols, Rows, !IO, RS, _RS1),
- curs.stop(!IO).
+ time.time(Now, !IO),
+ time.localtime(Now, LocalNow, !IO),
+ random.init(LocalNow ^ tm_min * 60 + LocalNow ^ tm_sec, RS),
+ curs.start(!IO),
+ curs.nodelay(yes, !IO),
+ curs.rows_cols(Rows, Cols, !IO),
+ curs.flushinp(!IO),
+ play_game(Cols, Rows, !IO, RS, _RS1),
+ curs.stop(!IO).
:- pred play_game(int::in, int::in, io::di, io::uo, rs::mdi, rs::muo) is det.
play_game(Cols, Rows, !IO, !RS) :-
- Snake = snake(right, {Cols/2, Rows/2}, [], 10),
- World = world(Cols, Rows, Snake, 1, no_apple, 0),
- game_loop(World, !IO, !RS).
+ Snake = snake(right, {Cols / 2, Rows / 2}, [], 10),
+ World = world(Cols, Rows, Snake, 1, no_apple, 0),
+ game_loop(World, !IO, !RS).
:- pred game_loop(world::in, io::di, io::uo, rs::mdi, rs::muo) is det.
game_loop(!.World, !IO, !RS) :-
- handle_input(!World, !IO, Quit),
- (
- Quit = no,
- move_snake(!World),
- maybe_eat_apple(!World),
- draw_world(!.World, !IO),
- (if snake_is_dead(!.World) then
- show_game_over(!IO)
- else
- sleep.usleep(50000, !IO),
- maybe_replenish_apple(!World, !RS),
- game_loop(!.World, !IO, !RS)
- )
- ;
- Quit = yes
- ).
+ handle_input(!World, !IO, Quit),
+ (
+ Quit = no,
+ move_snake(!World),
+ maybe_eat_apple(!World),
+ draw_world(!.World, !IO),
+ ( if snake_is_dead(!.World) then
+ show_game_over(!IO)
+ else
+ sleep.usleep(50000, !IO),
+ maybe_replenish_apple(!World, !RS),
+ game_loop(!.World, !IO, !RS)
+ )
+ ;
+ Quit = yes
+ ).
%-----------------------------------------------------------------------------%
:- pred handle_input(world::in, world::out, io::di, io::uo, bool::out) is det.
handle_input(!World, !IO, Quit) :-
- curs.getch(Key, !IO),
- (if quit_key(Key) then
- Quit = yes
- else
- Quit = no,
- (if direction_key(Key, Dir) then
- change_snake_direction(Dir, !World)
- else
- true
- )
- ).
+ curs.getch(Key, !IO),
+ ( if quit_key(Key) then
+ Quit = yes
+ else
+ Quit = no,
+ ( if direction_key(Key, Dir) then
+ change_snake_direction(Dir, !World)
+ else
+ true
+ )
+ ).
:- pred quit_key(int::in) is semidet.
quit_key(char.to_int('q')).
-quit_key(27). % escape
+quit_key(27). % escape
:- pred direction_key(int::in, direction::out) is semidet.
@@ -145,11 +147,11 @@ direction_key_2(curs.key_right, right).
:- pred change_snake_direction(direction::in, world::in, world::out) is det.
change_snake_direction(NewDir, World0, World) :-
- (if valid_direction_change(World0 ^ snake ^ direction, NewDir) then
- World = World0 ^ snake ^ direction := NewDir
- else
- World = World0
- ).
+ ( if valid_direction_change(World0 ^ snake ^ direction, NewDir) then
+ World = World0 ^ snake ^ direction := NewDir
+ else
+ World = World0
+ ).
:- pred valid_direction_change(direction::in, direction::in) is semidet.
@@ -167,97 +169,97 @@ valid_direction_change(right, down).
:- pred move_snake(world::in, world::out) is det.
move_snake(World0, World) :-
- World0 ^ snake = snake(Dir, Head @ {HeadX, HeadY}, Tail, Growth),
- ( Dir = up, NewHead = {HeadX, HeadY-1}
- ; Dir = down, NewHead = {HeadX, HeadY+1}
- ; Dir = left, NewHead = {HeadX-1, HeadY}
- ; Dir = right, NewHead = {HeadX+1, HeadY}
- ),
- Result = ordering(Growth, 0),
- (
- Result = (>),
- World = World0 ^ snake :=
- snake(Dir, NewHead, [Head | Tail], Growth-1)
- ;
- Result = (=),
- NewTail = list.take_upto(length(Tail)-1, Tail),
- World = World0 ^ snake :=
- snake(Dir, NewHead, [Head | NewTail], Growth)
- ;
- Result = (<),
- error("move_snake/2: Growth should be >= 0")
- ).
+ World0 ^ snake = snake(Dir, Head @ {HeadX, HeadY}, Tail, Growth),
+ ( Dir = up, NewHead = {HeadX, HeadY-1}
+ ; Dir = down, NewHead = {HeadX, HeadY+1}
+ ; Dir = left, NewHead = {HeadX-1, HeadY}
+ ; Dir = right, NewHead = {HeadX+1, HeadY}
+ ),
+ Result = ordering(Growth, 0),
+ (
+ Result = (>),
+ World = World0 ^ snake :=
+ snake(Dir, NewHead, [Head | Tail], Growth-1)
+ ;
+ Result = (=),
+ NewTail = list.take_upto(length(Tail)-1, Tail),
+ World = World0 ^ snake :=
+ snake(Dir, NewHead, [Head | NewTail], Growth)
+ ;
+ Result = (<),
+ error("move_snake/2: Growth should be >= 0")
+ ).
%-----------------------------------------------------------------------------%
:- pred maybe_eat_apple(world::in, world::out) is det.
maybe_eat_apple(World0, World) :-
- (
- World0 ^ apple = no_apple,
- World = World0
- ;
- World0 ^ apple = apple(X, Y, _),
- (if World0 ^ snake ^ head = {X, Y} then
- World = (((World0
- ^ apple := no_apple)
- ^ snake ^ growth := inc_growth(World0))
- ^ score := World0 ^ score + 10)
- else
- World = World0
- )
- ).
+ (
+ World0 ^ apple = no_apple,
+ World = World0
+ ;
+ World0 ^ apple = apple(X, Y, _),
+ (if World0 ^ snake ^ head = {X, Y} then
+ World = (((World0
+ ^ apple := no_apple)
+ ^ snake ^ growth := inc_growth(World0))
+ ^ score := World0 ^ score + 10)
+ else
+ World = World0
+ )
+ ).
:- func inc_growth(world) = int.
inc_growth(World) = NewGrowth :-
- Area = (World ^ cols-2) * (World ^ rows-2),
- Limit = Area/4,
- Snake = World ^ snake,
- CurrLength = length(Snake ^ tail) + Snake ^ growth,
- NewLength = CurrLength + 5,
- NewGrowth = (if NewLength > Limit
- then max(0, Limit - CurrLength)
- else NewLength - CurrLength).
+ Area = (World ^ cols-2) * (World ^ rows-2),
+ Limit = Area/4,
+ Snake = World ^ snake,
+ CurrLength = length(Snake ^ tail) + Snake ^ growth,
+ NewLength = CurrLength + 5,
+ NewGrowth = (if NewLength > Limit
+ then max(0, Limit - CurrLength)
+ else NewLength - CurrLength).
%-----------------------------------------------------------------------------%
:- pred snake_is_dead(world::in) is semidet.
snake_is_dead(World) :-
- Head @ {HeadX, HeadY} = World ^ snake ^ head,
- ( HeadX = 0
- ; HeadY = 0
- ; HeadX = World ^ cols-1
- ; HeadY = World ^ rows-1
- ; Head `member` World ^ snake ^ tail
- ).
+ Head @ {HeadX, HeadY} = World ^ snake ^ head,
+ ( HeadX = 0
+ ; HeadY = 0
+ ; HeadX = World ^ cols-1
+ ; HeadY = World ^ rows-1
+ ; Head `member` World ^ snake ^ tail
+ ).
%-----------------------------------------------------------------------------%
:- pred maybe_replenish_apple(world::in, world::out, rs::mdi, rs::muo) is det.
maybe_replenish_apple(World0, World, !RS) :-
- (if World0 ^ apple = no_apple then
- new_apple(World0, !RS, NewApple),
- NextAppleNum = inc_apple_num(World0 ^ next_apple_num),
- World = ((World0
- ^ apple := NewApple)
- ^ next_apple_num := NextAppleNum)
- else
- World = World0
- ).
+ ( if World0 ^ apple = no_apple then
+ new_apple(World0, !RS, NewApple),
+ NextAppleNum = inc_apple_num(World0 ^ next_apple_num),
+ World = ((World0
+ ^ apple := NewApple)
+ ^ next_apple_num := NextAppleNum)
+ else
+ World = World0
+ ).
:- pred new_apple(world::in, rs::mdi, rs::muo, apple::out) is det.
new_apple(World, !RS, Apple) :-
- random.random(1, World ^ cols-2, X, !RS),
- random.random(1, World ^ rows-2, Y, !RS),
- (if touches_snake(X, Y, World) then
- new_apple(World, !RS, Apple)
- else
- Apple = apple(X, Y, apple_char(World ^ next_apple_num))
- ).
+ random.random(1, World ^ cols-2, X, !RS),
+ random.random(1, World ^ rows-2, Y, !RS),
+ ( if touches_snake(X, Y, World) then
+ new_apple(World, !RS, Apple)
+ else
+ Apple = apple(X, Y, apple_char(World ^ next_apple_num))
+ ).
:- pred touches_snake(int::in, int::in, world::in) is semidet.
@@ -266,7 +268,7 @@ touches_snake(X, Y, World) :- {X, Y} `member` World ^ snake ^ tail.
:- func inc_apple_num(int) = int.
-inc_apple_num(N) = (if N < 9 then N+1 else 1).
+inc_apple_num(N) = (if N < 9 then N + 1 else 1).
:- func apple_char(int) = int.
@@ -274,77 +276,88 @@ apple_char(N) = char.to_int('0') + N.
%-----------------------------------------------------------------------------%
-:- pred draw_world(world::in, io::di, io::uo) is det.
-:- pred draw_walls(world::in, io::di, io::uo) is det.
-:- pred draw_score(int::in, io::di, io::uo) is det.
-:- pred draw_snake(snake::in, io::di, io::uo) is det.
-:- pred draw_snake_segment(segment::in, io::di, io::uo) is det.
-:- pred draw_apple(apple::in, io::di, io::uo) is det.
-:- pred rect(int::in, int::in, int::in, int::in, char::in, io::di, io::uo)
- is det.
-
:- func wall_char = int.
-:- func head_char = int.
-:- func tail_char = int.
wall_char = char.to_int('+').
+
+:- func head_char = int.
+
head_char = char.to_int('0').
+
+:- func tail_char = int.
+
tail_char = char.to_int('O').
+:- pred draw_world(world::in, io::di, io::uo) is det.
+
draw_world(World, !IO) :-
- curs.clear(!IO),
- draw_walls(World, !IO),
- draw_score(World ^ score, !IO),
- draw_snake(World ^ snake, !IO),
- draw_apple(World ^ apple, !IO).
+ curs.clear(!IO),
+ draw_walls(World, !IO),
+ draw_score(World ^ score, !IO),
+ draw_snake(World ^ snake, !IO),
+ draw_apple(World ^ apple, !IO).
+
+:- pred draw_walls(world::in, io::di, io::uo) is det.
draw_walls(World, !IO) :-
- Cols = World ^ cols,
- Rows = World ^ rows,
- rect(0, 0, Cols-1, Rows-1, '+', !IO).
+ Cols = World ^ cols,
+ Rows = World ^ rows,
+ rect(0, 0, Cols - 1, Rows - 1, '+', !IO).
+
+:- pred draw_score(int::in, io::di, io::uo) is det.
draw_score(Score, !IO) :-
- curs.move(0, 5, !IO),
- curs.addstr(curs.normal, String, !IO),
- String = string.format(" Score: %d ", [i(Score)]).
+ curs.move(0, 5, !IO),
+ curs.addstr(curs.normal, String, !IO),
+ String = string.format(" Score: %d ", [i(Score)]).
+
+:- pred draw_snake(snake::in, io::di, io::uo) is det.
draw_snake(Snake, !IO) :-
- list.foldl(draw_snake_segment, Snake ^ tail, !IO),
- Snake ^ head = {HeadX, HeadY},
- curs.move(HeadY, HeadX, !IO),
- curs.addch(curs.bold, head_char, !IO).
+ list.foldl(draw_snake_segment, Snake ^ tail, !IO),
+ Snake ^ head = {HeadX, HeadY},
+ curs.move(HeadY, HeadX, !IO),
+ curs.addch(curs.bold, head_char, !IO).
+
+:- pred draw_snake_segment(segment::in, io::di, io::uo) is det.
draw_snake_segment({X,Y}, !IO) :-
- curs.move(Y, X, !IO),
- curs.addch(curs.normal, tail_char, !IO).
+ curs.move(Y, X, !IO),
+ curs.addch(curs.normal, tail_char, !IO).
+
+:- pred draw_apple(apple::in, io::di, io::uo) is det.
draw_apple(no_apple, !IO).
draw_apple(apple(X, Y, Char), !IO) :-
- curs.move(Y, X, !IO),
- curs.addch(curs.standout, Char, !IO).
+ curs.move(Y, X, !IO),
+ curs.addch(curs.standout, Char, !IO).
+
+:- pred rect(int::in, int::in, int::in, int::in, char::in, io::di, io::uo)
+ is det.
rect(X1,Y1, X2,Y2, Char, !IO) :-
- char.to_int(Char, C),
- curs.move(Y1, X1, !IO), curs.hline(C, X2-X1, !IO),
- curs.move(Y2, X1, !IO), curs.hline(C, X2-X1, !IO),
- curs.move(Y1, X1, !IO), curs.vline(C, Y2-Y1, !IO),
- curs.move(Y1, X2, !IO), curs.vline(C, Y2-Y1, !IO).
+ char.to_int(Char, C),
+ curs.move(Y1, X1, !IO), curs.hline(C, X2-X1, !IO),
+ curs.move(Y2, X1, !IO), curs.hline(C, X2-X1, !IO),
+ curs.move(Y1, X1, !IO), curs.vline(C, Y2-Y1, !IO),
+ curs.move(Y1, X2, !IO), curs.vline(C, Y2-Y1, !IO).
%-----------------------------------------------------------------------------%
:- pred show_game_over(io::di, io::uo) is det.
show_game_over(!IO) :-
- Message = " You died, press a key... ",
- curs.rows_cols(Rows, Cols, !IO),
- curs.move(Rows/2, (Cols/2) - string.length(Message)/2, !IO),
- curs.addstr(curs.normal, Message, !IO),
- curs.refresh(!IO),
- sleep.usleep(500000, !IO),
- curs.nodelay(no, !IO),
- curs.flushinp(!IO),
- curs.getch(_, !IO),
- curs.nodelay(yes, !IO).
+ Message = " You died, press a key... ",
+ curs.rows_cols(Rows, Cols, !IO),
+ curs.move(Rows/2, (Cols/2) - string.length(Message) / 2, !IO),
+ curs.addstr(curs.normal, Message, !IO),
+ curs.refresh(!IO),
+ sleep.usleep(500000, !IO),
+ curs.nodelay(no, !IO),
+ curs.flushinp(!IO),
+ curs.getch(_, !IO),
+ curs.nodelay(yes, !IO).
%-----------------------------------------------------------------------------%
+:- end_module nibbles.
%-----------------------------------------------------------------------------%
diff --git a/extras/curs/samples/sleep.m b/extras/curs/samples/sleep.m
index 7a1be796b..b2a693a85 100644
--- a/extras/curs/samples/sleep.m
+++ b/extras/curs/samples/sleep.m
@@ -1,15 +1,17 @@
%-----------------------------------------------------------------------------%
+% vim: ts=4 sw=4 et tw=0 wm=0 ff=unix ft=mercury
+%-----------------------------------------------------------------------------%
:- module sleep.
:- interface.
:- import_module io.
- % usleep(MSec, !IO)
- %
- % Sleep for MSec microseconds.
- % Only implemented for Unix-like systems so far.
- %
+ % usleep(MSec, !IO)
+ %
+ % Sleep for MSec microseconds.
+ % Only implemented for Unix-like systems so far.
+ %
:- pred usleep(int::in, io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
@@ -19,19 +21,19 @@
:- pragma foreign_decl("C",
"
- #include <sys/time.h>
- #include <sys/types.h>
- #include <unistd.h>
+ #include <sys/time.h>
+ #include <sys/types.h>
+ #include <unistd.h>
").
:- pragma foreign_proc("C",
- usleep(N::in, IO0::di, IO::uo),
- [will_not_call_mercury, promise_pure],
+ usleep(N::in, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
- struct timeval tv = {0, N};
- select(0, NULL, NULL, NULL, &tv);
- IO = IO0;
+ struct timeval tv = {0, N};
+ select(0, NULL, NULL, NULL, &tv);
").
%-----------------------------------------------------------------------------%
+:- end_module sleep.
%-----------------------------------------------------------------------------%
More information about the reviews
mailing list