[m-rev.] for review: curses games

[Peter Wang]

Estimated hours taken: 10
Branches: main

extras/curs/samples/frogger.m:
extras/curs/samples/nibbles.m:
extras/curs/samples/sleep.m:
	Add two curses games I wrote in December 2004.

Index: extras/curs/samples/frogger.m
===================================================================
RCS file: extras/curs/samples/frogger.m
diff -N extras/curs/samples/frogger.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ extras/curs/samples/frogger.m	10 Feb 2006 04:35:55 -0000
@@ -0,0 +1,354 @@
+%-----------------------------------------------------------------------------%
+%
+% A frogger clone, by Peter Wang.
+% This source file is hereby placed in the public domain.
+%
+% Missing features: colour, fly, turtles don't submerge, timeout.
+%
+%-----------------------------------------------------------------------------%
+
+:- module frogger.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module bool, char, int, list, string.
+
+:- use_module curs, sleep.
+
+:- type world
+	--->	world(
+			lives		:: int,
+			remaining_goals	:: int,
+			frog		:: frog,
+			level		:: level
+		).
+
+:- type frog
+	--->	frog(
+			frog_x	:: int,
+			frog_y	:: int
+		).
+
+:- type level	== list(row).
+
+:- type row
+        --->    row(
+			scroll	:: scroll,
+			str   	:: string
+		).
+
+:- type scroll
+	--->	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
+).
+
+:- func width = int.
+:- func height = int.
+
+width = string.length(list.det_head(initial_level) ^ str).
+height = list.length(initial_level).
+
+:- func initial_frog = frog.
+
+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,			"============================")
+].
+
+:- pred goal_char(char::in) is semidet.
+
+goal_char('g').
+
+	% Frog cannot touch even a single one of these chars.
+	%
+:- pred frog_cant_touch_1(char::in) is semidet.
+
+frog_cant_touch_1('<').
+frog_cant_touch_1('>').
+frog_cant_touch_1('.').
+frog_cant_touch_1(':').
+frog_cant_touch_1('C').
+frog_cant_touch_1('c').
+
+	% Frog can touch at most one of these chars.
+	%
+:- pred frog_cant_touch_2(char::in) is semidet.
+
+frog_cant_touch_2('~').
+
+:- func game_loop_rate = int.
+
+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).
+
+:- 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
+		)
+	).
+
+%-----------------------------------------------------------------------------%
+
+:- 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).
+
+draw_level(Level, !IO) :-
+	draw_level_2(0, Level, !IO).
+
+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).
+
+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
+	).
+
+draw_frog(frog(X, Y), !IO) :-
+	curs.move(Y, X, !IO),
+	curs.addstr(curs.standout, "<>", !IO).
+
+draw_status(Lives, !IO) :-
+	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.
+        %
+:- func visualise(char) = char.
+
+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).
+
+%-----------------------------------------------------------------------------%
+
+:- 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
+		)
+	).
+
+:- pred is_quit(int::in) is semidet.
+
+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).
+
+move_frog_right(World0, World) :-
+	World0 ^ frog = frog(X, Y),
+	World = World0 ^ frog := frog(min(width-2, X+1), Y).
+
+move_frog_up(World0, World) :-
+	World0 ^ frog = frog(X, Y),
+	World = World0 ^ frog := frog(X, max(0, Y-1)).
+
+move_frog_down(World0, World) :-
+	World0 ^ frog = frog(X, Y),
+	World = World0 ^ frog := frog(X, min(height-1, Y+1)).
+
+%-----------------------------------------------------------------------------%
+
+:- 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).
+
+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).
+
+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
+	).
+
+%-----------------------------------------------------------------------------%
+
+:- 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
+	; check_frog_went_splat(!World) -> true
+	; true
+	).
+
+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).
+
+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(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).
+
+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)),
+	NewRow = Row ^ str := NewStr,
+	NewLevel = list.replace_nth_det(Level, Y+1, NewRow),
+	World = World0 ^ level := NewLevel.
+
+%-----------------------------------------------------------------------------%
Index: extras/curs/samples/nibbles.m
===================================================================
RCS file: extras/curs/samples/nibbles.m
diff -N extras/curs/samples/nibbles.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ extras/curs/samples/nibbles.m	7 Feb 2006 12:40:23 -0000
@@ -0,0 +1,333 @@
+%-----------------------------------------------------------------------------%
+%
+% A nibbles clone by Peter Wang.
+% This source file is hereby placed in the public domain.
+%
+%-----------------------------------------------------------------------------%
+
+:- module nibbles.
+
+:- interface.
+
+:- import_module io.
+
+:- 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.
+
+:- type rs == random.supply.
+
+:- type world
+	--->	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
+		).
+
+:- type direction
+	--->	up
+	;	down
+	;	left
+	;	right.
+
+:- type segment == {int, int}.	
+
+:- type apple
+	--->	no_apple
+	;	apple(
+			x	:: int,
+			y	:: int,
+			repr	:: int
+		).
+
+%-----------------------------------------------------------------------------%
+
+main(!IO) :-
+	time.time(Now, !IO),
+	time.localtime(Now) = LocalNow,
+	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).
+
+:- 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
+	).
+
+%-----------------------------------------------------------------------------%
+
+:- 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
+		)
+	).
+
+:- pred quit_key(int::in) is semidet.
+
+quit_key(char.to_int('q')).
+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))).
+
+direction_key_2(curs.key_up, up).
+direction_key_2(curs.key_down, down).
+direction_key_2(curs.key_left, left).
+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
+	).
+
+:- pred valid_direction_change(direction::in, direction::in) is semidet.
+
+valid_direction_change(up, left).
+valid_direction_change(up, right).
+valid_direction_change(down, left).
+valid_direction_change(down, right).
+valid_direction_change(left, up).
+valid_direction_change(left, down).
+valid_direction_change(right, up).
+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")
+	).
+
+%-----------------------------------------------------------------------------%
+
+:- 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
+		)
+	).
+
+:- 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).
+
+%-----------------------------------------------------------------------------%
+
+:- 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
+	).
+
+%-----------------------------------------------------------------------------%
+
+:- 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
+	).
+
+:- 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))
+	).
+
+:- pred touches_snake(int::in, int::in, world::in) is semidet.
+
+touches_snake(X, Y, World) :- {X, Y} = World ^ snake ^ head.
+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).
+
+:- func apple_char(int) = int.
+
+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('+').
+head_char = char.to_int('0').
+tail_char = char.to_int('O').
+
+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).
+
+draw_walls(World, !IO) :-
+	Cols = World ^ cols,
+	Rows = World ^ rows,
+	rect(0, 0, Cols-1, Rows-1, '+', !IO).
+
+draw_score(Score, !IO) :-
+	curs.move(0, 5, !IO),
+	curs.addstr(curs.normal, String, !IO),
+	String = string.format(" Score: %d ", [i(Score)]).
+
+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).
+
+draw_snake_segment({X,Y}, !IO) :-
+	curs.move(Y, X, !IO),
+	curs.addch(curs.normal, tail_char, !IO).
+
+draw_apple(no_apple, !IO).
+draw_apple(apple(X, Y, Char), !IO) :-
+	curs.move(Y, X, !IO),
+	curs.addch(curs.standout, Char, !IO).
+
+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).
+
+%-----------------------------------------------------------------------------%
+
+:- 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).
+
+%-----------------------------------------------------------------------------%
Index: extras/curs/samples/sleep.m
===================================================================
RCS file: extras/curs/samples/sleep.m
diff -N extras/curs/samples/sleep.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ extras/curs/samples/sleep.m	7 Feb 2006 12:40:30 -0000
@@ -0,0 +1,36 @@
+%-----------------------------------------------------------------------------%
+
+:- module sleep.
+
+:- interface.
+
+:- import_module io.
+
+	% 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.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- pragma foreign_decl("C",
+"
+	#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],
+"{
+	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
--------------------------------------------------------------------------