stdlib.dg

(library version) Library version 1.2.3.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Global variables

%% The following variables may be queried directly from the story, but the
%% library gets confused if you modify them directly with (now). Instead, use
%% the predicates mentioned in the comments:

%% Update with (select player $):
(global variable (current player $))

%% Update with (enter $) or (move player to $ $):
(global variable (current room $))

%% Update with (increase score by $) or (decrease score by $):
(global variable (current score $))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Style class declarations

%% These declarations are merely hints to the backend and/or interpreter.

%% Attributes can be ignored based on context. On the Z-machine backend, for
%% instance, 'height' only has an effect on (status bar $) boxes, whereas
%% 'width' and 'float' only affect (div $) boxes that are nested inside a
%% (status bar $) box. The height and width may be specified in em/ch or %.

(style class @status)
	height: 1em;

(style class @score)
	float: right;
	width: 17ch;

(style class @initial-spacer)
	margin-bottom: 2em;

(style class @title)
	font-family: Geneva, sans-serif;
	font-weight: bold;
	font-size: 1.4em;
	margin-top: 1em;

(style class @roomheader)
	margin-top: .3em;
	font-family: Geneva, sans-serif;

(style class @gameover)
	font-weight: bold;
	margin-top: 1em;
	margin-bottom: 1em;

(style class @bold)
	font-weight: bold;

(style class @italic)
	font-style: italic;

%% For messages that come from the program, rather than from the game world
(style class @meta)
	font-face: sans-serif;
	font-style: italic;

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Interface declarations for predicates typically defined in story code

(interface (name $<Obj))
(interface (tagged name $<Obj))
(interface (descr $<Obj))
(interface (initial appearance $<Obj))
(interface (appearance $<Obj))
(interface (appearance $<Obj $<Rel $<Loc))
(interface (feel $<Obj))
(interface (room header $<Obj))
(interface (look $<Obj))

(interface (dict $<Obj))
(interface (plural dict $<Obj))
(interface (heads $<Obj))

(interface (from $<Room go $>Dir to $>Obj))
(interface (from $<Room through $>Door to $>Obj))

(interface ($<Room attracts $>Obj))

(interface (maximum score $>Number))

(interface (clarify location of $<Obj))
(interface ($>Obj provides light))
(interface ($<Key unlocks $<Door))

(interface ($<Door blocks passage))
(interface ($<Door blocks light))

(interface (fungible $<Obj1 $<Obj2))

(interface (on every tick in $<Room))

(interface (understand $<Words as $>Action))
(interface (understand $<Words))

(interface (describe action $<Action))
(interface (unlikely $<Action))
(interface (very unlikely $<Action))

(interface (before $<Action))
(interface (refuse $<Action))
(interface (instead of $<Action))
(interface (prevent $<Action))
(interface (perform $<Action))
(interface (after $<Action))

(interface (action $<Action requires $>Obj to be present))
(interface (action $<Action requires $>Obj to be touched))

(interface (group-before $<GroupAction))
(interface (group-refuse $<GroupAction))
(interface (group-instead of $<GroupAction))
(interface (group-prevent $<GroupAction))
(interface (group-perform $<GroupAction))
(interface (group-after $<GroupAction))

(interface (narrate taking $<Obj))
(interface (narrate removing $<Obj))
(interface (narrate wearing $<Obj))
(interface (narrate putting $<Obj $<Rel $<Dest))
(interface (narrate dropping $<Obj))
(interface (narrate opening $<Obj))
(interface (narrate closing $<Obj))
(interface (narrate unlocking $<Obj with $<Key))
(interface (narrate locking $<Obj with $<Key))
(interface (narrate switching on $<Obj))
(interface (narrate switching off $<Obj))
(interface (narrate eating $<Obj))
(interface (narrate climbing $<Obj))
(interface (narrate entering $<Obj))
(interface (narrate leaving $<Obj))
(interface (narrate leaving $<Room $<Dir))
(interface (narrate leaving $<Room $<Dir with $<Obj))
(interface (narrate leaving $<Room $<Dir by $<Vehicle))
(interface (narrate failing to look $<Dir))

(interface (describe topic $<Topic))

(interface (default action $<Obj $>Action))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Relations

%% Avoid compiler warnings with --warn-not-topic
#in
#on
#partof
#heldby
#wornby
#under
#behind

(relation #in)		%% Note: #in is also a direction
(relation #on)
(relation #partof)
(relation #heldby)
(relation #wornby)
(relation #under)
(relation #behind)

(name #in)		in
(name #on)		on
(name #partof)		part of
(name #heldby)		held by
(name #wornby)		worn by
(name #under)		under
(name #behind)		behind

(Name #partof)		As part of

(interface (present-name $<Rel))

(present-name #in)	inside
(present-name #on)	on top of
(present-name $Rel)	(name $Rel)

(interface (towards-name $<Rel))

(towards-name #in)	into
(towards-name #on)	onto
(towards-name $Rel)	(name $Rel)

(interface (reverse-name $<Rel))

(reverse-name #in)	out of
(reverse-name #on)	off
(reverse-name #partof)	away from
(reverse-name #heldby)	away from
(reverse-name #wornby)	off
(reverse-name #under)	out from under
(reverse-name #behind)	out from behind

(the (relation $Rel))	(name $Rel)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Directions

(interface (opposite of $<Dir1 is $>Dir2))

(interface (present-adverb $<Dir))
(interface (from-adverb $<Dir))

#north
(direction *)
(name *)		north
(dict *)		n northern
(opposite of * is #south)

#south
(direction *)
(name *)		south
(dict *)		s southern
(opposite of * is #north)

#east
(direction *)
(name *)		east
(dict *)		e eastern
(opposite of * is #west)

#west
(direction *)
(name *)		west
(dict *)		w western
(opposite of * is #east)

#northeast
(direction *)
(name *)		northeast
(dict *)		ne north-east
(opposite of * is #southwest)

#northwest
(direction *)
(name *)		northwest
(dict *)		nw north-west
(opposite of * is #southeast)

#southwest
(direction *)
(name *)		southwest
(dict *)		sw south-west
(opposite of * is #northeast)

#southeast
(direction *)
(name *)		southeast
(dict *)		se south-east
(opposite of * is #northwest)

#up
(direction *)
(name *)		up
(dict *)		u ceiling sky above
(present-adverb *)	above
(from-adverb *)		above
(opposite of * is #down)

#down
(direction *)
(name *)		down
(dict *)		d below
(present-adverb *)	below
(from-adverb *)		below
(opposite of * is #up)

#in			%% Note: #in is also a relation
(direction *)
(present-adverb *)	inside
(from-adverb *)		inside
(opposite of * is #out)

#out
(direction *)
(name *)		out
(dict *)		outside outwards
(present-adverb *)	outside
(opposite of * is #in)

(present-adverb $Dir)	to the (name $Dir)
(from-adverb $Dir)	the (name $Dir)

(proper (direction $))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Common traits and per-object flags

%% Negations

@($Obj is open)			~($Obj is closed)
@($Obj is unlocked)		~($Obj is locked)
@($Obj is on)			~($Obj is off)
@($Obj is revealed)		~($Obj is hidden)
@($Obj is pristine)		~($Obj is handled)
@($Obj is unvisited)		~($Obj is visited)
@($Obj is in order)		~($Obj is broken)

%% Inheritance relations

(actor container $Obj)		*(room $Obj)
(animate $Obj)			*(female $Obj)
(animate $Obj)			*(male $Obj)
(animate $Obj)			*(gender-neutral $Obj)
(container $Obj)		*(actor container $Obj)
(item $Obj)			*(wearable $Obj)
(supporter $Obj)		*(actor supporter $Obj)
(excluded from all $Obj)	*(not here $Obj)
(excluded from all $Obj)	*(room $Obj)
(actor container $Obj)		*(in-seat $Obj)
(actor supporter $Obj)		*(on-seat $Obj)
(seat $Obj)			*(in-seat $Obj)
(seat $Obj)			*(on-seat $Obj)
(opaque $Obj)			*(openable $Obj)
(openable $Obj)			*(lockable $Obj)
(plural $Obj)			*(pair $Obj)

%% "Edison's Lament: No switch is ever in the right position."
%% (From "The Grand List Of Console Role Playing Game Clichés")
%% Of course, you can override these defaults on an object-by-object basis:

((openable $) is closed)
((lockable $) is locked)
((switchable $) is off)

%% Convenience predicate:

(interface (reveal $<Obj))

(reveal $Obj)
	(now) ($Obj is revealed)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Rules to prevent compiler warnings

%% The following rule definitions have no effect on the behaviour of the
%% program, but they prevent warnings about undefined predicates. They have
%% zero impact on performance.

%% These are typically static traits:

(ambiguously plural $)	(fail)
(an $)			(fail)
(door $)		(fail)
(edible $)		(fail)
(female $)		(fail)
(gender-neutral $)	(fail)
(fine where it is $)	(fail)
(inherently dark $)	(fail)
(item $)		(fail)
(lockable $)		(fail)
(male $)		(fail)
(not here $)		(fail)
(openable $)		(fail)
(out of reach $)	(fail)
(pair $)		(fail)
(potable $)		(fail)
(pushable $)		(fail)
(sharp $)		(fail)
(singleton $)		(fail)
(switchable $)		(fail)
(uncountable $)		(fail)
(wearable $)		(fail)
(vehicle $)		(fail)
(your $)		(fail)
(on-seat $)		(fail)
(in-seat $)		(fail)
(consultable $)		(fail)

%% These typically involve rule bodies with further conditions:

($ provides light)	(fail)

%% These are typically dynamic (i.e. per-object flags):

($ is broken)		(fail)
($ is hidden)		(fail)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Rooms and doors

(name (room $))		location
(room header $Room)	(Tagged name $Room)
(look (room $R))	You are here.

(interface (from $<Room go $>Dir to room $>Obj))

%% Given a room and a direction, what room (if any) is reachable that way?
%% Given a room and a target room, what direction (if any) leads there?

(from $Here go $Dir to room $Room)
	(if) (bound $Room) (then)
		(from $Here go $Dir to $Room)
	(or)
		(from $Here through $Door to $Room)
		(from $Here go $Dir to $Door)
	(else)
		*(from $Here go $Dir to $Target)
		(if) (room $Target) (then)
			($Target = $Room)
		(elseif) (direction $Target) (then)
			(from $Here go $Target to room $Room)
		(else)
			(door $Target)
			~($Target blocks passage)
			(from $Here through $Target to $Room)
		(endif)
	(endif)

(interface (from $<Room go $<Dir to object $>Obj))

%% Given a room and a direction, what object, door and/or room is visible
%% that way? (Usually multi-queried)

(from $Room go $Dir to object $Obj)
	(from $Room go $Dir to $Point)
	(if) (direction $Point) (then)
		*(from $Room go $Point to object $Obj)
	(elseif) (door $Point) (then)
		{
			~($Point blocks light)
			(from $Room through $Point to $Obj)
		(or)
			($Obj = $Point)
		}
	(else)
		($Obj = $Point)
	(endif)

(the (current room $))	this location

(name (door $))		door

($Door blocks passage)
	($Door is closed)

((opaque $Door) blocks light)
	($Door is closed)

@(from $Room go $Dir through $Door to $Target)
	*(from $Room go $Dir to $Door)
	*(from $Room through $Door to $Target)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Access rules

(interface (visibility ceiling of $<Obj is $>Ceil))

(visibility ceiling of $Obj is $Ceil)
	(if) ($Obj has parent $Parent) (then)
		(if)
			(opaque $Parent)
			($Obj has relation $Rel)
			(if) ($Rel = #in) (then)
				($Parent is closed)
			(else)
				($Rel = #under)
			(endif)
		(then)
			($Ceil = $Parent)
		(else)
			(visibility ceiling of $Parent is $Ceil)
		(endif)
	(else)
		($Ceil = $Obj)
	(endif)

(interface (light reaches ceiling $<Ceil))

(light reaches ceiling (room $Ceil))
	~(inherently dark $Ceil)

(light reaches ceiling $Ceil)
	*($Obj provides light)
	(visibility ceiling of $Obj is $Ceil)

(global variable (current scope ceiling $))

(recompute visibility)
	(current player $Player)
	(visibility ceiling of $Player is $Ceil)
	(if) (light reaches ceiling $Ceil) (then)
		(now) (current scope ceiling $Ceil)
		(now) (player can see)
	(else)
		(reachability ceiling of $Player is $RCeil)
		(now) (current scope ceiling $RCeil)
		(now) ~(player can see)
	(endif)

(recompute visibility)
	%% Fallback e.g. if there is no current player.

(interface (player can see $<Obj))

(player can see $Obj)
	(player can see)
	(current scope ceiling $Ceil)
	(if) (room $Obj) ~($Obj = $Ceil) (then)
		(room $Ceil)
		{
			(from $Ceil go $ to $Obj)
		(or)
			(from $Ceil through $Door to $Obj)
			~($Door blocks light)
		}
	(else)
		(visibility ceiling of $Obj is $Ceil)
	(endif)

(interface (reachability ceiling of $<Obj is $>Ceil))

(reachability ceiling of $Obj is $Ceil)
	(if) ($Obj is $Rel $Parent) (then)
		(if)
			($Rel = #in)
			($Parent is closed)
		(or)
			($Rel = #under)
			($Parent is #wornby $Actor)
			~(current player $Actor)
		(then)
			($Ceil = $Parent)
		(else)
			(reachability ceiling of $Parent is $Ceil)
		(endif)
	(else)
		($Ceil = $Obj)
	(endif)

(interface (player can reach $<Obj))

(player can reach $Obj)
	~(out of reach $Obj)
	(current player $Player)
	(reachability ceiling of $Player is $Ceil)
	{
		($Obj = $Ceil)
	(or)
		(reachability ceiling of $Obj is $Ceil)
	}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Scope

%% The following predicate can be extended by the game, typically using rules
%% that check certain conditions, e.g. what the current room is:

(interface (add $>Obj to scope))

(add #darkness to scope)
	~(player can see)

%% The default scope is everything that the player can see or reach, plus
%% objects that are marked out of reach but would be reachable otherwise.
%% Instead of querying the predicates defined above, we compute all of this in
%% a single traversal of the object tree, for better performance.

(interface ($>Obj is in scope))

($Obj is in scope)
	*(add $Obj to scope)

($Obj is in scope)
	(current scope ceiling $Ceil)
	(if) (fully bound $Obj) (then)
		(if) (player can see) (then)
			(traverse scope bottom-up $Obj to $Ceil wearer $)
		(else)
			{
				($Obj = $Ceil)
			(or)
				(reachability ceiling of $Obj is $Ceil)
			}
		(endif)
	(else)
		{
			($Obj = $Ceil)
		(or)
			*($InCeil is #in $Ceil)
			*(traverse scope top-down $Obj from $InCeil wearer $)
		}
	(endif)

($Obj is in scope)
	(if) (bound $Obj) (then)
		(room $Obj)
	(endif)
	(player can see)
	(current scope ceiling $Ceil)
	(room $Ceil)
	{
		*(from $Ceil go $ to $Obj)
		(room $Obj)
	(or)
		*(from $Ceil through $Door to $Obj)
		~($Door blocks light)
	}

(interface (traverse scope bottom-up $<Obj to $<Ceil wearer $Wearer))

(traverse scope bottom-up $Ceil to $Ceil wearer $)
(traverse scope bottom-up $Obj to $Ceil wearer $Wearer)
	($Obj is $Rel $Parent)
	(if) ($Rel = #wornby) (then)
		($Parent = $Wearer)
	(endif)
	(if) ($Parent = $Ceil) (then)
		($Rel = #in)
	(elseif) (opaque $Parent) (then)
		(if) ($Rel = #in) (then)
			($Parent is open)
		(elseif) ($Rel = #under) (then)
			(current player $Wearer)
		(endif)
	(endif)
	(traverse scope bottom-up $Parent to $Ceil wearer $Wearer)

(interface (traverse scope top-down $>Obj from $<Ceil wearer $Wearer))

(traverse scope top-down $Obj from $Obj wearer $)
(traverse scope top-down $Output from $Obj wearer $Wearer)
	(if) (opaque $Obj) (then)
		*($Child is $Rel $Obj)
		(if) ($Rel = #in) (then)
			($Obj is open)
		(elseif) ($Rel = #under) (then)
			(current player $Wearer)
		(endif)
	(else)
		*($Child is $Rel $Obj)
	(endif)
	(if) ($Rel = #wornby) (then)
		($Wearer = $Obj)
	(endif)
	*(traverse scope top-down $Output from $Child wearer $Wearer)

#darkness
(name *)	darkness
(dict *)	dark
(singleton *)
(intangible *)
(descr *)	(narrate darkness)

(rebuild scope)
	(update environment around player)
	(forget pronouns out of scope)

%% Debugging predicate:

(interface (scope))

(scope)
	(rebuild scope)
	The current scope is: (line)
	(exhaust) {
		*($Obj is in scope)
		$Obj:
		%% Prevent (the $) from revealing hidden objects
		(if) ($Obj is hidden) (then)
			(the $Obj)
			(now) ($Obj is hidden)
		(else)
			(the $Obj)
		(endif)
		(line)
	}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Select player, enter a room or other location, move floating objects

(interface (select player $<Player))

(select player $Player)
	(clear all pronouns)
	(now) (current player $Player)
	(update environment around player)

(interface (move player to $<Rel $<Loc))

(move player to $Rel $Loc)
	(current player $Player)
	(now) ($Player is $Rel $Loc)
	(update environment around player)

(interface (enter $<Room))

(enter $Room)
	(now) (don't mark the room as visited yet) %% We keep ($ is visited) unset until after (narrate entering $) has had its chance to describe things
	(move player to #in $Room)
	(narrate entering $Room)
	(mark the location as visited)

(interface (enter $<Room by $<Vehicle))

(enter $Room by $Vehicle)
	(now) ($Vehicle is #in $Room)
	(now) ($Vehicle is handled)
	(now) (don't mark the room as visited yet)
	(update environment around player)
	(narrate entering $Room)
	(mark the location as visited)

(update environment around player)
	(if) (current player $Player) ($Player is in room $Room) (then)
		(now) (current room $Room)
		(exhaust) {
			*($Room attracts $Object)
			(now) ($Object is #in $Room)
		}
		(recompute visibility)
		(mark the location as visited)
	(endif)

(mark the location as visited)
	(don't mark the room as visited yet) %% This flag prevents it only once
	(now) ~(don't mark the room as visited yet)
(mark the location as visited)
	(if) (current room $Room) ($Room is unvisited) (player can see) (then)
		(now) ($Room is visited)
	(endif)

(narrate entering (room $Room))
	(now) (looking after moving)
	(par)
	(try [look])

(narrate entering $Obj)
	You get into (the $Obj).

(interface (prevent entering $<Obj))

(prevent entering $Obj)
	(when $Obj won't accept actor #in)

(interface (narrate failing to leave $<Obj $<Dir))

(narrate failing to leave $ $)
	There doesn't appear to be an exit in that direction.

%% Extend the following predicate to simulate objects occupying multiple rooms:

($Room attracts $Obj)
	*(from $Room go $ to $Obj)
	~(direction $Obj)
	~(room $Obj)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Standard actions

%% LOOK <dir>

(grammar [examine/x/look/l [direction]] for [look $])

(unlikely [look $])

(prevent [look $])
	~(player can see)
	You can't see in the darkness.

(perform [look $Dir])
	(if)
		(current scope ceiling $Room)
		(room $Room)
		(from $Room go $Dir to $Target)
	(then)
		(if) (direction $Target) (then)
			(try [look $Target])
		(elseif) (door $Target) ~($Target blocks light) (then)
			(from $Room through $Target to $OtherRoom)
			(if) ($OtherRoom is visited) (then)
				Through (the $Target) you see (a $OtherRoom).
				(notice $OtherRoom)
			(else)
				You can't quite make out what's on the other
				side of (the $Target).
				(notice $Target)
			(endif)
		(elseif) (room $Target) ($Target is unvisited) (then)
			You can't get a good view of what's in that direction.
		(else)
			(Name $Dir) from here (is $Target) (a $Target).
			(notice $Target)
		(endif)
	(else)
		(narrate failing to look $Dir)
	(endif)

(narrate failing to look #up)
	You see nothing unexpected above.

(narrate failing to look #down)
	You see nothing unexpected below.

(narrate failing to look #in)
	Your introspection reveals nothing.

(narrate failing to look #out)
	There's no obvious way out of here.

(narrate failing to look $)
	You see nothing unexpected in that direction.

%% LOOK <rel> <obj>

(grammar [look/l [in inside into through] [single]] for [look #in $])
(grammar [look/l [on upon] [single]] for [look #on $])
(grammar [look/l behind [single]] for [look #behind $])
(grammar [look/l under [single]] for [look #under $])

(unlikely [look #in $Obj])
	~(container $Obj)

(unlikely [look #on $Obj])
	~(supporter $Obj)

%% Reachability not required, but visibility:

~(action [look $ $] requires $ to be touched)
(refuse [look $ $Obj]) (when $Obj is out of sight)
%% This is the only action in the standard library that refuses based on visibility, so it's implemented as a specific rule here instead of a more general (action $ requires $ to be seen). If more actions require it in the future, though, that could easily change.

(before [look #in (opaque $Obj)])
	($Obj is closed)
	(first try [open $Obj])

(instead of [look #in (current room $)])
	(try [look])

(instead of [look #in $Obj])
	{ (room $Obj) (or) (door $Obj) }
	(current room $Here)
	{
		(from $Here go $Dir to $Obj)
	(or)
		(from $Here through $Door to $Obj)
		(from $Here go $Dir to $Door)
	}
	(direction $Dir)
	(try [look $Dir])

(prevent [look #in $Obj])
	~(container $Obj)
	(The $Obj) can't contain things.

(prevent [look #in (opaque $Obj)])
	($Obj is closed)
	~(current scope ceiling $Obj)
	(if) (openable $Obj) (then)
		(The $Obj is) closed.
	(else)
		You can't look inside (the $Obj).
	(endif)

(prevent [look #behind (room $Obj)])
	Looking behind (the $Obj) doesn't make sense.

(prevent [look #under $Obj])
	($Obj is #wornby $Actor)
	~(current player $Actor)
	(animate $Actor)
	(The $Actor) might not like that.

(perform [look $Rel $Obj])
	(collect $C)
		*($C is $Rel $Obj)
		(now) ($C is revealed)
	(into $List)
	(if) (empty $List) (then)
		(if) (#in = $Rel) (then)
			(The $Obj is) empty.
		(else)
			(if) ($Rel is one of [#under #behind]) (then)
				You find
			(else)
				There's
			(endif)
			nothing (present-name $Rel) (the $Obj).
		(endif)
	(else)
		(Name $Rel) (the $Obj) you see (a $List). (notice $List)
	(endif)

%% FIND <obj>

%% FIND takes the player to the room that currently contains the object.
%% For objects that move around autonomously, it may be a good idea to override
%% this rule, to say e.g. "you don't know where the cat might be right now".
%% Note that floating objects, including doors, will remain in the room where
%% they were last encountered. This will usually put the player on the expected
%% side of doors.

(grammar [find [any]] for [find $])
(grammar [look/l for [any]] for [find $])

(unlikely [find $Obj])
	($Obj is nowhere)

~(action [find $] requires $ to be present)

(prevent [find (not here $Obj)])
	You don't know where to find (the $Obj).

(prevent [find $Obj])
	(when $Obj is already held)

(prevent [find $Obj])
	($Obj is in room $Room)
	(current room $Room)
	(The $Obj) (is $Obj)
	(if) ($Obj is $Rel $Loc) ~(room $Loc) (then)
		(name $Rel) (the $Loc)
	(else)
		here
	(endif)
	.

(prevent [find $Obj])
	($Obj is in room $Room)
	(current room $Here)
	~(shortest path from $Here to $Room is $)
	You don't know how to get to (the $Obj) from here.

(perform [find $Obj])
	(if) ($Obj is in room $Room) (then)
		(line) \( attempting to go to (the $Room) \) (line)
		(try [go to $Room])
	(else)
		You don't know where to find (the $Obj).
	(endif)

%% EXAMINE <obj>

(grammar [examine/x/watch/describe/check/look/l [object]] for [examine $])
(grammar [look/l at [object]] for [examine $])

(understand [who am i] as [examine $Player])
	(current player $Player)

~(action [examine $] requires $ to be touched)

(instead of [examine (room $Obj)])
	(current room $Here)
	~($Here = $Obj)
	(if)
		(from $Here go $Dir to $Obj)
	(then)
		(try [look $Dir])
	(elseif)
		(from $Here through $Door to $Obj)
		~($Door blocks light)
		(from $Here go $Dir to $Door)
	(then)
		(try [look $Dir])
	(else)
		You can't get a good view of (the $Obj) from here.
	(endif)

(perform [examine $Obj])
	(current player $Player)
	($Player is nested #in $Obj)
	(look $Obj)

(perform [examine $Obj])
	(descr $Obj)
	(if) (supporter $Obj) (then)
		(if) (fungibility enabled) (then)
			(collect $Child)
				*($Child is #on $Obj)
			(into $OnList)
			(fungibility-enabled appearance $OnList #on $Obj)
		(else)
			(exhaust) {
				*($Child is #on $Obj)
				(par)
				(appearance $Child #on $Obj)
				(notice $Child)
			}
		(endif)
	(endif)
	(if) (container $Obj) ~{ (opaque $Obj) ($Obj is closed) } (then)
		(if) (fungibility enabled) (then)
			(collect $Child)
				*($Child is #in $Obj)
			(into $InList)
			(fungibility-enabled appearance $InList #in $Obj)
		(else)
			(exhaust) {
				*($Child is #in $Obj)
				(par)
				(appearance $Child #in $Obj)
				(notice $Child)
			}
		(endif)
	(endif)
	(par)

%% LOOK

(grammar [look/l] for [look])
(grammar [look/l around] for [look])
(grammar [where am i] for [look])

(describe action [look])
	look around

%% We want to reset (moving long distances) just before the final [look]
(before [look])
	(last step of movement)
	(now) ~(moving long distances)
	(now) ~(last step of movement)

%% And (looking after moving) just after
(on every tick)
	(now) ~(looking after moving)

(perform [look])
	(current player $Player)
	($Player is $Rel $Loc)
	{ (verbosity level $Verbosity) (or) ($Verbosity = 2) } %% Just in case
	(div @roomheader) (location headline)
	(if)
		(looking after moving)
		{
			($Verbosity = 0) (or) %% Verbosity 0: when moving at all
			(current room $Room) ($Room is visited) ($Verbosity < 2) (or) %% Verbosity 1: when visited
			(moving long distances) ($Verbosity < 3) %% Verbosity 2: when moving long distances
		}
	(then)
		%% No room description, keep it brief
		(par)
	(elseif) (player can see) (then)
		(current scope ceiling $Ceil)
		(look $Ceil)
		(make appearances $Rel $Loc)
		(par)
	(else)
		(narrate darkness)
	(endif)

%% SEARCH <obj>

(grammar [search [object]] for [search $])

(instead of [search (current room $R)])
	(try [look])

(prevent [search (animate $Obj)])
	~(current player $Obj)
	(The $Obj) might not like that.

(perform [search $O])
	(if) (opaque $O) ($O is closed) (then)
		($InList = [])
	(else)
		(collect $C) *($C is #in $O) (reveal $C) (into $InList)
	(endif)
	(collect $C) *($C is #on $O) (reveal $C) (into $OnList)
	(collect $C) *($C is #behind $O) (reveal $C) (into $BehindList)
	(if) ($O has relation #wornby) (then)
		($UnderList = [])
	(else)
		(collect $C) *($C is #under $O) (reveal $C) (into $UnderList)
	(endif)
	(if) (nonempty $InList) (then)
		(if) ($InList = [$InObj]) (then)
			(A $InObj) (is $InObj) in (the $O).
		(else)
			In (the $O) you find (a $InList).
		(endif)
		(notice $InList)
	(endif)
	(if) (nonempty $OnList) (then)
		(if) ($OnList = [$OnObj]) (then)
			(A $OnObj) (is $OnObj) on (the $O).
		(else)
			On (the $O) you find (a $OnList).
		(endif)
		(notice $OnList)
	(endif)
	(if) (nonempty $BehindList) (then)
		You find (a $BehindList) behind (the $O).
		(notice $BehindList)
	(endif)
	(if) (nonempty $UnderList) (then)
		You find (a $UnderList) under (the $O).
		(notice $UnderList)
	(endif)
	(if)
		(empty $InList)
		(empty $OnList)
		(empty $BehindList)
		(empty $UnderList)
	(then)
		You find nothing of interest.
	(endif)

%% FEEL <obj>

(grammar [feel/touch/finger/rub/prod [object]] for [feel $])

(perform [feel $Obj])
	(feel $Obj)

%% LISTEN TO <obj>
%% LISTEN

(grammar [listen/hear [single]] for [listen to $])
(grammar [listen to [single]] for [listen to $])

%% Don't require reachability:
~(action [listen to $] requires $ to be touched)

(perform [listen to $Obj])
	(if) (current player $Obj) (then)
		You can hear the familiar rumble of your blood stream
		and the faint whine of your nervous system.
	(elseif) (animate $Obj) (then)
		(The $Obj) (is $Obj) silent.
	(elseif) (room $Obj) (then)
		You hear nothing in particular.
	(else)
		You hear no particular sound coming from (the $Obj).
	(endif)

(grammar [listen/hear] for [listen])

(instead of [listen])
	(current room $Room)
	(try [listen to $Room])

%% KISS <obj>

(grammar [kiss/love [animate]] for [kiss $])

(prevent [kiss $Obj])
	(current player $Player)
	{
		($Obj = $Player)
	(or)
		($Obj is part of $Player)
	}
	Your feelings for yourself are primarily of a platonic nature.

(perform [kiss (animate $Obj)])
	(The $Obj) (doesn't $Obj) seem receptive to that sort of thing.
	(tick) (stop)

(perform [kiss $Obj])
	(The $Obj is) unmoved by your display of affection.

%% HUG <obj>

(grammar [hug/embrace [animate]] for [hug $])

(perform [hug $Obj])
	(try [kiss $Obj])

%% JUMP

(grammar [jump/skip/hop/bounce/exercise] for [jump])

(perform [jump])
	You enjoy a bit of jumping on the spot.

%% DANCE

(grammar [dance/jive/shake/twirl/spin] for [dance])

(perform [dance])
	You practise your moves.

%% WAVE <obj>
%% WAVE

(grammar [wave [held]] for [wave $])
(grammar [wave] for itself)

(unlikely [wave $Obj])
	(current player $Player)
	~($Obj is #heldby $Player)
	~($Obj is part of $Player)

(before [wave $Obj])
	(ensure $Obj is held)

(prevent [wave $Obj])
	(current player $Player)
	~($Obj is part of $Player)
	(when $Obj isn't directly held)

(perform [wave $Obj])
	You wave (the $Obj) in the air, with no apparent consequences.

(perform [wave])
	You wave your hands in the air.

%% SING

(grammar [sing/hum] for [sing])

(perform [sing])
	You hum a few notes.

%% THROW <obj> AT <obj>
%% THROW <obj>
%% THROW <obj> <dir>

(grammar [throw/toss [held] [at on to in into onto] [single]] for [throw $ at $])
(grammar [throw/toss [held]] for [throw $])
(grammar [throw/toss away [held]] for [throw $])

(understand [throw/toss | $Words] as [throw $Obj $Dir])
	(last $Words $Last)
	(parse direction [$Last] $Dir)
	(reverse $Words [$ | $RevWords])
	(reverse $RevWords $Left)
	*(understand $Left as object $Obj preferably held)

(unlikely [throw $Obj | $])
	(current player $Actor)
	~($Obj has ancestor $Actor)

(perform [throw $Obj])
	At what?
	(asking for object in [throw $Obj at []])

(instead of [throw $Obj $Dir])
	(current room $Here)
	(if) (from $Here go $Dir to object $Target) (then)
		(try [throw $Obj at $Target])
	(else)
		(try [throw $Obj])
	(endif)

%% The target doesn't have to be reachable:
(action [throw $Obj at $] requires $Obj to be touched) (just)

(before [throw $Obj at $])
	(current player $Actor)
	($Obj has ancestor $Actor)
	(ensure $Obj is held)

(prevent [throw $Obj at $])
	~(current player $Obj)
	(when $Obj isn't directly held)

(perform [throw $Obj at $Target])
	Throwing (the $Obj) at (the $Target) would achieve little.
	(tick) (stop)

%% THINK

(grammar [think] for itself)

(perform [think])
	That would be a good first step.
	(line) \( Try HINT if you are desperate. \) (line)

%% SLEEP

(grammar [sleep/nap/dream] for [sleep])
(grammar [take nap] for [sleep])
(grammar [take a nap] for [sleep])
(grammar [fall asleep] for [sleep])

(perform [sleep])
	You're not all that sleepy.

%% TAKE <obj>
%% TAKE <obj> FROM <obj>

(grammar [take/grab/snatch/steal/acquire/hold/gather/get/pick/remove [takable child] from [single]] for [take $ from $])

(grammar [take/grab/snatch/steal/acquire/hold/gather/get/pick [takable]] for [take $])
(grammar [pick up [takable]] for [take $])

(unlikely [take ~(item $)])

(unlikely [take $Obj])
	($Obj has relation $Rel)
	($Rel is one of [#partof #heldby #wornby])

(unlikely [take $Obj from $Parent])
	~($Obj has ancestor $Parent)

(prevent [take $Obj from $Parent])
	~($Obj has ancestor $Parent)
	(if) (animate $Parent) (then)
		(The $Parent) (does $Parent) not have (the $Obj).
	(elseif) (container $Parent) (then)
		(The $Obj) (isn't $Obj) in (the $Parent).
	(elseif) (supporter $Parent) (then)
		(The $Obj) (isn't $Obj) on (the $Parent).
	(else)
		That's not where (the $Obj) (is $Obj).
	(endif)

(perform [take $Obj from $])
	(try [take $Obj])

(before [take (item $Obj)])
	(current player $Player)
	($Player has ancestor $Obj)
	(first try [leave $Obj])

(prevent [take $Obj])
	(when $Obj is already held)
	(or) (when $Obj is already worn)
	(or) (when $Obj is fine where it is)
	(or) (when $Obj is part of something)
	(or) (when $Obj is held by someone)
	(or) (when $Obj is worn by someone)
	(or) (when $Obj can't be taken)

(narrate taking $Obj)
	(current player $Actor)
	You take (the $Obj)
	(if) ($Obj is $Rel $Parent) ~($Actor has ancestor $Parent) (then)
		(reverse-name $Rel) (the $Parent)
	(endif)
	.

(perform [take $Obj])
	(narrate taking $Obj)
	(current player $Actor)
	(now) ($Obj is #heldby $Actor)
	(now) ($Obj is handled)

%% REMOVE <obj>

(grammar [remove/doff/shed/loosen/disrobe/undress [worn]] for [remove $])
(grammar [take off [worn]] for [remove $])
(grammar [take [worn] off] for [remove $])

(unlikely [remove $Obj])
	(current player $Player)
	~($Obj is #wornby $Player)

(before [remove $Obj])
	($Obj is #under $Cover)
	(current player $Player)
	($Cover is worn by $Player)
	(first try [remove $Cover])

(instead of [remove $Obj])
	~(wearable $Obj)
	~($Obj has relation #partof)
	(item $Obj)
	(try [take $Obj])

(prevent [remove $Obj])
	(when $Obj is part of something)

(prevent [remove $Obj])
	($Obj is #under $Cover)
	(current player $Player)
	($Cover is worn by $Player)
	You'd have to remove (the $Cover) first.

(prevent [remove $Obj])
	(current player $Player)
	~($Obj is #wornby $Player)
	But you aren't wearing (the $Obj).

(narrate removing $Obj)
	You take off (the $Obj).

(perform [remove $Obj])
	(narrate removing $Obj)
	(current player $Player)
	(exhaust) {
		*($Sub is #under $Obj)
		(now) ($Sub is #wornby $Player)
		(now) ($Sub is handled)
	}
	(now) ($Obj is #heldby $Player)
	(now) ($Obj is handled)

%% WEAR <obj>

(grammar [wear/don [held]] for [wear $])
(grammar [put on [held]] for [wear $])
(grammar [put [held] on] for [wear $])

(unlikely [wear $Obj])
	~(wearable $Obj)

(unlikely [wear $Obj])
	(current player $Player)
	($Obj is worn by $Player)

(before [wear $Obj])
	(current player $Player)
	~($Obj is worn by $Player)
	(if)
		*($Worn is worn by $Player bottom-up)
		(wearing $Obj removes $Worn)
	(then)
		(first try [remove $Worn])
	(endif)

(before [wear $Obj])
	(wearable $Obj)
	(current player $Player)
	~($Obj is worn by $Player)
	(ensure $Obj is held)

(prevent [wear $Obj])
	(when $Obj is already worn)

(prevent [wear $Obj])
	~(wearable $Obj)
	(The $Obj) can't be worn.

(prevent [wear $Obj])
	(current player $Player)
	*($Worn is worn by $Player bottom-up)
	(wearing $Obj removes $Worn)
	You can't do that while wearing (the $Worn).

(prevent [wear $Obj])
	(when $Obj isn't directly held)

(narrate wearing $Obj)
	You put on (the $Obj).

(perform [wear $Obj])
	(narrate wearing $Obj)
	(current player $Player)
	(exhaust) {
		*($Worn is #wornby $Player)
		(wearing $Obj covers $Worn)
		(now) ($Worn is #under $Obj)
		(now) ($Worn is handled)
	}
	(now) ($Obj is #wornby $Player)
	(now) ($Obj is handled)

%% PUT <obj> <rel> <obj>

(grammar [put/lay/drop/hide/stash/stuff/insert [held] [in inside into through] [single]] for [put $ #in $])
(grammar [put/lay/drop [held] [on onto atop upon] [single]] for [put $ #on $])
(grammar [put/lay/drop/hide/stash/stuff [held] behind [single]] for [put $ #behind $])
(grammar [put/lay/drop/hide/stash/stuff [held] under [single]] for [put $ #under $])

(unlikely [put $Obj $ $])
	(current player $Actor)
	~($Obj has ancestor $Actor)

(unlikely [put $ #on $Dest])
	~(supporter $Dest)

(unlikely [put $ #in $Dest])
	~(container $Dest)

(unlikely [put $Obj $ $Obj])

(unlikely [put $Obj $ $Dest])
	($Dest has ancestor $Obj)

(unlikely [put $Obj $Rel $Dest])
	($Obj is $Rel $Dest)

(before [put $Obj $Rel $Dest])
	~($Obj is $Rel $Dest)
	(ensure $Obj is held)

(before [put $ #in $Dest])
	($Dest is closed)
	(first try [open $Dest])

(instead of [put (current player $) #in $Dest])
	(try [enter $Dest])

(instead of [put (current player $) #on $Dest])
	(try [climb $Dest])

(instead of [put $Obj $Rel $Dest])
	(current player $Player)
	($Player is $Rel $Dest)
	(try [drop $Obj])

(prevent [put $Obj $Rel $Dest])
	(when $Obj is already $Rel $Dest)
	(or) (when $Obj isn't directly held)

(prevent [put $Obj $Rel $Dest])
	($Dest is nested $OldRel $Obj)
	(The $Obj) can't be placed
	(if) ~($OldRel is one of [#in #on]) (then)
		(towards-name $Rel) something that's
	(endif)
	(present-name $OldRel) (itself $Obj).

(prevent [put $Obj $Rel $Obj])
	You can't put (the $Obj) (towards-name $Rel) (itself $Obj).

(prevent [put $ $Rel $Dest])
	(when $Dest won't accept $Rel)

(prevent [put $ #in $Dest])
	(when $Dest is closed)

(narrate putting $Obj $Rel $Dest)
	You put (the $Obj) (name $Rel) (the $Dest).

(perform [put $Obj $Rel $Dest])
	(narrate putting $Obj $Rel $Dest)
	(now) ($Obj is $Rel $Dest)
	(now) ($Obj is handled)

%% DROP <obj>

(grammar [put/lay/drop [held]] for [drop $])
(grammar [put/lay/drop/set down [held]] for [drop $])
(grammar [put/lay/drop/set [held] down] for [drop $])
(grammar [let go of [held]] for [drop $])

(unlikely [drop $Obj])
	(current player $Actor)
	~($Obj has ancestor $Actor)

(before [drop $Obj])
	(current player $Actor)
	($Obj has ancestor $Actor)
	~($Obj has relation #partof)
	(ensure $Obj is held)

(prevent [drop $Obj])
	(when $Obj is part of something)
	(or) (when $Obj isn't directly held)

(narrate dropping $Obj)
	(current player $Actor)
	($Actor is $Rel $Loc)
	(The $Obj) fall(s $Obj)
	(if) ($Rel = #on) (then)
		onto (the $Loc).
	(else)
		to the ground.
	(endif)

(perform [drop $Obj])
	(narrate dropping $Obj)
	(current player $Actor)
	($Actor is $Rel $Loc)
	(now) ($Obj is $Rel $Loc)
	(now) ($Obj is handled)

%% INVENTORY

(grammar [inventory/i/inv] for [inventory])
(grammar [take/get inventory] for [inventory])

(describe action [inventory])
	take inventory

(perform [inventory])
	(current player $Player)
	(collect $C) *($C is #heldby $Player) (into $HeldList)
	(collect $C) *($C is worn by $Player top-down) (into $WornList)
	(if) (empty $HeldList) (then)
		(narrate holding nothing)
	(else)
		You have (a $HeldList).
	(endif)
	(if) (empty $WornList) (then)
		(narrate wearing nothing)
	(else)
		You're wearing (a $WornList).
	(endif)
	(line)

(narrate holding nothing)
	You have no possessions.

(narrate wearing nothing)

%% EXITS

(grammar [exits/map] for [exits])
(grammar [list exits] for [exits])
(grammar [list the exits] for [exits])

(describe action [exits])
	list the exits

(prevent [exits])
	~(player can see)
	You can't be sure of where the exits are in the darkness.

(perform [exits])
	(current room $Room)
	(if)
		~{
			*(from $Room go $Dir to $Target)
			(direction $Dir)
			{ (room $Target) (or) (door $Target) }
		}
	(then)
		There are no obvious exits here.
	(else)
		Obvious exits are: (line)
		(exhaust) {
			*(from $Room go $Dir to $Target)
			(direction $Dir)
			(if) (door $Target) (or) (room $Target) (then)
				(if) (library links enabled) (then)
					(link) (Name $Dir)
				(else)
					(Name $Dir)
				(endif)
				(if) (door $Target) (then)
					through (the $Target)
					(if) ($Target is closed) (then)
						\(currently closed\)
					(elseif)
						(from $Room through $Target to $R)
					(then)
						(describe remote room $R)
					(endif)
				(else)
					(describe remote room $Target)
				(endif)
				. (line)
			(endif)
		}
	(endif)

(describe remote room $Room)
	(if) ($Room is visited) (then)
		to
		(if) (light reaches ceiling $Room) (then)
			(the $Room)
		(else)
			darkness
		(endif)
	(endif)

%% EXIST (misspelled EXITS, just for the giggles)

(grammar [exist] for itself)

(perform [exist])
	So you do.

%% WAIT

(grammar [wait/z] for [wait])

(perform [wait])
	A moment slips away.

%% GIVE <obj> TO <obj>
%% GIVE <obj>

(grammar [give/offer/proffer [held] to [animate]] for [give $ to $])
(grammar [give/offer/proffer [animate] [held]] for [give $ to $] reversed)

(grammar [give/offer/proffer [held]] for [give $])

(unlikely [give $Obj to $Obj])

(unlikely [give $Obj to $])
	(current player $Player)
	~($Obj has ancestor $Player)

(unlikely [give $ to $Dest])
	~(animate $Dest)

(unlikely [give $])

(perform [give $Obj])
	To whom?
	(asking for object in [give $Obj to []])

(before [give $Obj to $])
	(ensure $Obj is held)

(prevent [give $Obj to $])
	(when $Obj isn't directly held)

(perform [give $ to $Dest])
	(if) (animate $Dest) (then)
		(The $Dest) (doesn't $Dest) appear to be interested.
	(else)
		Giving things to (the $Dest) doesn't appear to work.
	(endif)
	(tick) (stop)

%% SHOW <obj> TO <obj>
%% SHOW <obj>

(grammar [show [held] to [animate]] for [show $ to $])
(grammar [show [animate] [held]] for [show $ to $] reversed)

(grammar [show [held]] for [show $])

(unlikely [show $Obj to $Obj])

(unlikely [show $Obj to $])
	(item $Obj)
	(current player $Actor)
	~($Obj is nested #heldby $Actor)

(unlikely [show $ to $Dest])
	~(animate $Dest)

(unlikely [show $])

(action [show $Obj to $] requires $Obj to be touched) (just)

(perform [show $Obj])
	To whom?
	(asking for object in [show $Obj to []])

(before [show $Obj to $])
	(item $Obj)
	(ensure $Obj is held)

(prevent [show $Obj to $])
	(item $Obj)
	(when $Obj isn't directly held)

(perform [show $ to $Dest])
	(if) (animate $Dest) (then)
		(The $Dest) (doesn't $Dest) appear to be interested.
	(else)
		Showing things to (the $Dest) has no effect.
	(endif)
	(tick) (stop)

%% OPEN <obj>

(grammar [open/unwrap/uncover [object]] for [open $])

(unlikely [open $Obj])
	~(openable $Obj) (or) ($Obj is open)

(before [open $Obj])
	($Obj is closed)
	($Obj is locked)
	(current player $Player)
	*($Key is nested #heldby $Player)
	($Key unlocks $Obj)
	~($Key is hidden)
	(first try [unlock $Obj with $Key])

(prevent [open $Obj])
	~(openable $Obj)
	(The $Obj) (doesn't $Obj) open.

(prevent [open (openable $Obj)])
	($Obj is open)
	(The $Obj is) already open.

(prevent [open $Obj])
	($Obj is locked)
	(The $Obj is) locked.

(narrate opening $Obj)
	You open (the $Obj)
	(current player $Player)
	(if) ~($Player is nested #in $Obj) (then)
		(collect $Child)
			*($Child is #in $Obj)
			(reveal $Child)
		(into $List)
		(if) (nonempty $List) (then)
			, revealing (a $List)
			(notice $List)
		(endif)
	(endif)
	.

(perform [open $Obj])
	(narrate opening $Obj)
	(now) ($Obj is open)

%% CLOSE <obj>

(grammar [close/shut/cover [object]] for [close $])

(unlikely [close $Obj])
	~(openable $Obj) (or) ($Obj is closed)

(prevent [close $Obj])
	~(openable $Obj)
	(The $Obj) can't be closed.

(prevent [close $Obj])
	($Obj is closed)
	(The $Obj is) already closed.

(narrate closing $Obj)
	You close (the $Obj).

(perform [close $Obj])
	(narrate closing $Obj)
	(now) ($Obj is closed)

%% UNLOCK <obj> WITH <obj>
%% UNLOCK <obj>

(grammar [unlock [object] with [single held]] for [unlock $ with $])
(grammar [unlock [object]] for [unlock $])

(unlikely [unlock $Obj | $])
	~(lockable $Obj) (or) ($Obj is unlocked)

(before [unlock $ with $Key])
	(ensure $Key is held)

(instead of [unlock $Obj])
	(current player $Player)
	*($Key is nested #heldby $Player)
	($Key unlocks $Obj)
	~($Key is hidden)
	(line) \(with (the $Key)\) (line)
	(try [unlock $Obj with $Key])

(prevent [unlock $Obj | $])
	~(lockable $Obj)
	(The $Obj) can't be unlocked.

(prevent [unlock (lockable $Obj) | $])
	($Obj is unlocked)
	(The $Obj is) already unlocked.

(perform [unlock $Obj])
	With what?
	(asking for object in [unlock $Obj with []])

(prevent [unlock $Obj with $Key])
	~($Key unlocks $Obj)
	You fail to unlock (the $Obj) with (the $Key).

(narrate unlocking $Obj with $Key)
	You unlock (the $Obj) with (the $Key).

(perform [unlock $Obj with $Key])
	(narrate unlocking $Obj with $Key)
	(now) ($Obj is unlocked)

%% LOCK <obj> WITH <obj>
%% LOCK <obj>

(grammar [lock [object] with [single held]] for [lock $ with $])
(grammar [lock [object]] for [lock $])

(unlikely [lock $Obj | $])
	~(lockable $Obj)
	(or) ($Obj is locked)

(before [lock $ with $Key])
	(ensure $Key is held)

(before [lock (lockable $Obj) with $])
	(openable $Obj)
	($Obj is open)
	(first try [close $Obj])

(instead of [lock $Obj])
	(current player $Player)
	*($Key is nested #heldby $Player)
	($Key unlocks $Obj)
	~($Key is hidden)
	(line) \(with (the $Key)\) (line)
	(try [lock $Obj with $Key])

(prevent [lock $Obj | $])
	~(lockable $Obj)
	(The $Obj) can't be locked.

(prevent [lock (lockable $Obj) | $])
	($Obj is locked)
	(The $Obj is) already locked.

(perform [lock $Obj])
	With what?
	(asking for object in [lock $Obj with []])

(prevent [lock $Obj with $Key])
	~($Key unlocks $Obj)
	You fail to lock (the $Obj) with (the $Key).

(narrate locking $Obj with $Key)
	You lock (the $Obj) with (the $Key).

(perform [lock $Obj with $Key])
	(narrate locking $Obj with $Key)
	(now) ($Obj is locked)

%% SWITCH ON <obj>

(grammar [turn/switch on [object]] for [switch on $])
(grammar [turn/switch [object] on] for [switch on $])

(unlikely [switch on $Obj])
	~(switchable $Obj) (or) ($Obj is on)

(describe action [switch on $Obj])
	switch (the full $Obj) on

(prevent [switch on $Obj])
	~(switchable $Obj)
	(The $Obj) can't be switched on.

(prevent [switch on $Obj])
	($Obj is on)
	(The $Obj is) already on.

(narrate switching on $Obj)
	You switch (the $Obj) on.

(perform [switch on $Obj])
	(narrate switching on $Obj)
	(now) ($Obj is on)

%% SWITCH OFF <obj>

(grammar [turn/switch off [object]] for [switch off $])
(grammar [turn/switch [object] off] for [switch off $])

(unlikely [switch off $Obj])
	~(switchable $Obj) (or) ($Obj is off)

(describe action [switch off $Obj])
	switch (the full $Obj) off

(prevent [switch off $Obj])
	($Obj is off)
	(The $Obj is) already off.

(prevent [switch off $Obj])
	~(switchable $Obj)
	(The $Obj) can't be turned off.

(narrate switching off $Obj)
	You switch (the $Obj) off.

(perform [switch off $Obj])
	(narrate switching off $Obj)
	(now) ($Obj is off)

%% SWITCH <obj>

(grammar [switch [object]] for [switch $])

(unlikely [switch ~(switchable $)])

(instead of [switch (switchable $Obj)])
	(if) ($Obj is on) (then)
		(try [switch off $Obj])
	(else)
		(try [switch on $Obj])
	(endif)

(perform [switch $Obj])
	(The $Obj) can't be switched on or off.
	(tick) (stop)

%% SQUEEZE <obj>

(grammar [squeeze/squash [object]] for [squeeze $])

(perform [squeeze $Obj])
	You give (the $Obj) a bit of a squeeze.

%% FIX <obj>

(grammar [fix/repair/mend [object]] for [fix $])

(unlikely [fix $Obj])
	($Obj is in order)

(prevent [fix $Obj])
	($Obj is in order)
	You can't find anything wrong with (the $Obj).

(perform [fix $Obj])
	You don't know how to repair (the $Obj).
	(tick) (stop)

%% TASTE <obj>

(grammar [taste/lick/relish/savour [object]] for [taste $])

(unlikely [taste $Obj])
	~(edible $Obj)
	~(potable $Obj)

(prevent [taste $Obj])
	~(edible $Obj)
	~(potable $Obj)
	Don't be gross.

(perform [taste $Obj])
	You savour the taste of (the $Obj).

%% FLY

(grammar [fly] for itself)

(perform [fly])
	You lack the ability.

%% BITE <obj>

(grammar [bite/chew/gnaw [single]] for [bite $])
(grammar [gnaw at [single]] for [bite $])

(perform [bite (animate $Obj)])
	(try [attack $Obj])

(perform [bite $Obj])
	(try [eat $Obj])

%% EAT <obj>

(grammar [eat/devour/ingest/munch/swallow [object]] for [eat $])

(unlikely [eat $Obj])
	~(edible $Obj)
	~(potable $Obj)

(before [eat $Obj])
	{ (edible $Obj) (or) (potable $Obj) }
	(item $Obj)
	(ensure $Obj is held)

(instead of [eat $Obj])
	~(edible $Obj)
	(potable $Obj)
	(try [drink $Obj])

(prevent [eat $Obj])
	(current player $Player)
	{
		($Obj = $Player)
	(or)
		($Obj is part of $Player)
	}
	Cannibalism isn't the answer to this one.

(prevent [eat $Obj])
	~(edible $Obj)
	(The $Obj) (isn't $Obj) edible.

(prevent [eat $Obj])
	(item $Obj)
	(when $Obj isn't directly held)

(narrate eating $Obj)
	You eat (the $Obj).

(perform [eat $Obj])
	(narrate eating $Obj)
	(now) ($Obj is nowhere)
	(now) ($Obj is handled)

%% DRINK <obj>

(grammar [drink/sip/quaff [object]] for [drink $])
(grammar [drink/sip from [object]] for [drink $])

(unlikely [drink $Obj])
	~(potable $Obj)

(before [drink $Obj])
	{ (edible $Obj) (or) (potable $Obj) }
	(item $Obj)
	(ensure $Obj is held)

(prevent [drink $Obj])
	~(potable $Obj)
	You can't drink (the $Obj).

(prevent [drink $Obj])
	(item $Obj)
	(when $Obj isn't directly held)

(perform [drink $Obj])
	You take a sip from (the $Obj).

%% CUT <obj> WITH <obj>
%% CUT <obj>

(grammar [cut/sever/slice/prune/chop [object] with [single]] for [cut $ with $])
(grammar [cut/sever/slice/prune/chop [object]] for [cut $])
(grammar [cut/slice/chop off [object]] for [cut $])
(grammar [cut/slice/chop [object] off] for [cut $])

(unlikely [cut $ with $Obj])
	~(sharp $Obj)

(perform [cut $Obj])
	With what?
	(asking for object in [cut $Obj with []])

(prevent [cut $ with $Obj])
	~(sharp $Obj)
	(The $Obj is) too blunt for that. %% Funny when Obj is the player.

(perform [cut $Obj with $])
	You consider cutting
	(if) (current player $Player) ($Obj is part of $Player) (then)
		off
	(endif)
	(the $Obj), but reject the idea.

%% USE <obj>

(understand [use | $Words] as $Action)
	*(understand $Words as single object $Obj)
	(if)
		(implicit action is $Implicit)
		~(implicit action wants direction)
	(then)
		(recover implicit action $Implicit $Obj into $Action)
	(else)
		($Action = [use $Obj])
	(endif)

(instead of [use (door $Door)])
	(try [enter $Door])

(perform [use $])
	How? Please be more specific.
	(stop)

%% CONSULT <obj> ABOUT <topic>

(grammar [consult [object] about [topic]] for [consult $ about $])
(grammar [look up [topic] in [object]] for [consult $ about $] reversed)

(describe action [consult $Obj about $Topic])
	consult (the full $Obj) about (describe topic $Topic)

(unlikely [consult $Obj about $])
	~(consultable $Obj)

(action [consult $Obj about $] requires $Obj to be present) (just)
(action [consult $Obj about $] requires $Obj to be touched) (just)

(prevent [consult $Obj about $])
	~(consultable $Obj)
	You can't look things up in (the $Obj).

(perform [consult $Obj about $Topic])
	You find no information about (describe topic $Topic) in (the $Obj).

%% ASK/TELL <obj> ABOUT <topic> (redirected to TALK TO <obj> ABOUT <topic> by default)

(grammar [ask [animate] about [topic]] for [ask $ about $])
(grammar [tell [animate] about [topic]] for [tell $ about $])

(describe action [ask $Person about $Topic])
	ask (the full $Person) about (describe topic $Topic)

(describe action [tell $Person about $Topic])
	tell (the full $Person) about (describe topic $Topic)

(grammar [ask [animate]] for [ask $])
(grammar [tell [animate]] for [tell $])

(describe action [ask $Person])
	ask (the full $Person) something

(describe action [tell $Person])
	tell (the full $Person) something

(unlikely [ask/tell $Obj about $])
	~(animate $Obj)

%% Don't require reachability (or the presence of the topic):

(action [ask $Obj | $] requires $Obj to be present) (just)
~(action [ask $ | $] requires $ to be touched)

(action [tell $Obj | $] requires $Obj to be present) (just)
~(action [tell $ | $] requires $ to be touched)

(perform [ask/tell $Person about $Topic])
	(try [talk to $Person about $Topic])

(perform [ask/tell $Obj])
	(try [talk to $Obj])

%% TALK TO <obj> ABOUT <topic>
%% TALK TO <obj>
%% TALK

(grammar [talk/speak to [animate] about [topic]] for [talk to $ about $])
(grammar [talk/speak to [animate]] for [talk to $])
(grammar [talk/speak [animate]] for [talk to $])
(grammar [talk] for itself)

(describe action [talk to $Person about $Topic])
	talk to (the full $Person) about (describe topic $Topic)

(unlikely [talk to $Obj | $])
	~(animate $Obj)

(perform [talk])
	To whom?
	(asking for object in [talk to []])

%% Don't require reachability:

(action [talk to $Obj | $] requires $Obj to be present) (just)
~(action [talk to $ | $] requires $ to be touched)

(perform [talk to $Obj about $])
	(try [talk to $Obj])

(perform [talk to (current player $)])
	You mumble a few well-chosen words to yourself.

(perform [talk to $])
	There is no reply.

%% CURSE

(grammar [curse/swear] for [curse])

(perform [curse])
	You mumble a few well-chosen words to yourself.

%% PRAY

(grammar [pray] for itself)

(perform [pray])
	There is no answer.

%% SHRUG

(grammar [shrug] for itself)

(perform [shrug])
	You shrug indifferently.

%% CALL <obj> (redirected to TALK TO by default)
%% CALL (redirected to CALL TO by default)
%% Stories containing a phone would override these.

(grammar [call [animate]] for [call $])
(grammar [call/shout to [animate]] for [call $])
(grammar [call] for itself)

(unlikely [call $Obj])
	~(animate $Obj)

~(action [call $] requires $ to be touched)

(perform [call (current player $)])
	Why call when you're already right here?
	(tick) (stop)

(perform [call $Obj])
	(try [talk to $Obj])

(perform [call])
	Call whom?
	(asking for object in [call []])

%% GREET <obj> (redirected to TALK TO by default)
%% GREET

(grammar [greet/hello/hi/hey [animate]] for [greet $])
(grammar [greet/hello/hi/hey] for [greet])

(unlikely [greet $Obj])
	~(animate $Obj)

~(action [greet $] requires $ to be touched)

(perform [greet $Obj])
	(try [talk to $Obj])

(perform [greet])
	You say hello to nobody in particular.

%% TELL <obj> TO | <action>

(understand [tell/ask | $Words] as [tell $Actor to | $Action])
	*(split $Words by [, to] into $Left and $Right)
	*(understand $Left as single object $Actor preferably animate)
	(current actor $OldActor)
	(now) (current actor $Actor)
	(rewrite $Right into $Simplified)
	(collect $A)
		*(understand $Simplified as $A)
	(into $List)
	(now) (current actor $OldActor)
	*($Action is one of $List)

(understand [ask | $Words] as [tell $Actor to give $Obj to $Player])
	*(split $Words by [for] into $Left and $Right)
	*(understand $Left as single object $Actor preferably animate)
	*(understand $Right as object $Obj preferably child of $Actor)
	(current player $Player)

%% The rule for "name comma action" is further down in the file.

(unlikely [tell $Addressee to | $])
	~(animate $Addressee)

(describe action [tell $Actor to give $Obj to (current player $)])
	ask (the full $Actor) for (the full $Obj)

(describe action [tell $Actor to tell (current player $) about $Topic])
	ask (the full $Actor) about (describe topic $Topic)

(describe action [tell $Actor to | $Action])
	tell (the full $Actor) to (describe action $Action)

(unlikely [tell $Obj to | $])
	~(animate $Obj)

(action [tell $NPC to | $] requires $NPC to be present) (just)
~(action [tell $ to | $] requires $ to be touched)

(instead of [tell $NPC to greet])
	(try [greet $NPC])

(instead of [tell $NPC to tell (current player $) about $Topic])
	(try [ask $NPC about $Topic])

(perform [tell $Actor to | $])
	(if) (animate $Actor) (then)
		(The $Actor) refuse(s $Actor).
	(else)
		(The $Actor) (doesn't $Actor) take orders.
	(endif)

%% SMELL <obj>
%% SMELL

(grammar [smell/sniff/inhale [object]] for [smell $])
(grammar [smell/sniff/inhale] for [smell])

~(action [smell $] requires $ to be touched)

(perform [smell $Obj])
	(The $Obj) smell(s $Obj) as expected.

(perform [smell])
	You sniff at the air, perceiving nothing out of the ordinary.

%% WAKE UP

(grammar [wake up] for itself)
(grammar [wake/awake/awaken] for [wake up])

(understand [pinch | $Words] as [wake up])
	*(understand $Words as single object $Obj)
	(current player $Player)
	{
		($Obj = $Player)
	(or)
		($Obj is part of $Player)
	}

(perform [wake up])
	You try to will yourself to wake up, but nothing obvious happens.

%% CLIMB <obj>

(grammar [climb/mount/scale [single]] for [climb $])
(grammar [go/get/step/climb up [on onto] [single]] for [climb $])
(grammar [go/get/step/climb/stand/lie [on onto] [single]] for [climb $])
(grammar [go/get/step/climb/stand/lie on top of [single]] for [climb $])
(grammar [sit/stand/lie on [single]] for [climb $])
(grammar [sit/stand/lie down on [single]] for [climb $])
(grammar [jump to/onto [single]] for [climb $])

(unlikely [climb $Obj])
	~(actor supporter $Obj)

(unlikely [climb $Obj])
	(current player $Actor)
	($Obj has ancestor $Actor)

(unlikely [climb $Obj])
	(current player $Actor)
	($Actor is nested #on $Obj)

(describe action [climb $Obj])
	get onto (the full $Obj)

(instead of [climb (room $Room)])
	~(actor supporter $Room)
	(try [go #up])

(instead of [climb (actor container $Obj)])
	~(actor supporter $Obj)
	(seat $Obj)
	(try [enter $Obj])

(prevent [climb $Obj])
	(current player $Actor)
	{
		(when $Actor is already #on $Obj)
		(or) (when $Obj won't accept actor #on)
	}

(prevent [climb $Dest])
	(current player $Actor)
	($Dest is nested $OldRel $Actor)
	You can't get onto something that's (present-name $OldRel) yourself.

(narrate climbing $Obj)
	You get onto (the $Obj).

(perform [climb $Obj])
	(narrate climbing $Obj)
	(move player to #on $Obj)

%% ENTER <obj>

(grammar [enter/cross [single]] for [enter $])
(grammar [go/get/enter/climb/jump/sit/lie [in into inside] [single]] for [enter $])

(understand [go | $Words] as [enter $Obj])
	*(understand $Words as single object $Obj)
	{ (door $Obj) (or) ~(room $Obj) (actor container $Obj) }

(unlikely [enter $Obj])
	~(actor container $Obj)
	~(door $Obj)

(unlikely [enter $Obj])
	(current player $Actor)
	($Obj has ancestor $Actor)

(unlikely [enter $Obj])
	(current player $Actor)
	($Actor is nested #in $Obj)

~(very unlikely [enter $])

(describe action [enter $Obj])
	get into (the full $Obj)

%% Rooms are generally not present
~(action [enter (room $)] requires $ to be present)

(before [enter (actor container $Obj)])
	($Obj is closed)
	(first try [open $Obj])

(instead of [enter (room $Room)])
	(current room $Here)
	~($Here = $Room)
	(if)
		(from $Here go $Dir to $Room)
	(or)
		(from $Here through $Door to $Room)
		(from $Here go $Dir to $Door)
	(then)
		(direction $Dir) %% Assure the compiler that $Dir is bound.
		(try [go $Dir])
	(else)
		(The $Room) (isn't $Room) here.
		(tick) (stop)
	(endif)

(instead of [enter (door $Obj)])
	(current room $Room)
	(from $Room go $Dir to $Obj)
	(direction $Dir) %% Assure the compiler that $Dir is bound.
	(try [go $Dir])

(instead of [enter (wearable $Obj)])
	(try [wear $Obj])

(instead of [enter (actor supporter $Obj)])
	~(actor container $Obj)
	(seat $Obj)
	(try [climb $Obj])

(prevent [enter $Obj])
	(current player $Actor)
	{
		(when $Actor is already #in $Obj)
		(or) (prevent entering $Obj)
	}

(prevent [enter $Dest])
	(current player $Actor)
	($Dest is nested $OldRel $Actor)
	You can't get into something that's (present-name $OldRel) yourself.

(perform [enter $Obj])
	(narrate entering $Obj)
	(move player to #in $Obj)

%% SIT

(grammar [sit] for itself)

(unlikely [sit])

(perform [sit])
	On what?
	(asking for object in [climb []])

%% STAND

(grammar [stand] for itself)
(grammar [stand up] for [stand])

(describe action [stand])
	stand up

(instead of [stand])
	(current player $Player)
	($Player has parent $Obj)
	~(room $Obj)
	(try [leave $Obj])

(perform [stand])
	You're already standing up.
	(tick) (stop)

%% LEAVE <obj>
%% LEAVE

(grammar [leave/exit [single]] for [leave $])
(grammar [get/jump/go [out off] of [single]] for [leave $])
(grammar [get/jump/go off [single]] for [leave $])

(understand [u/up] as [leave])
	(current player $Player)
	($Player has parent $Obj)
	(seat $Obj)

(understand [go/get u/up] as [leave])
	(current player $Player)
	($Player has parent $Obj)
	(seat $Obj)

(understand [d/down] as [leave])
	(current player $Player)
	($Player is #on $Obj)
	~(seat $Obj)

(understand [go/get/climb d/down] as [leave])
	(current player $Player)
	($Player is #on $Obj)
	~(seat $Obj)

(understand [out] as [leave])
	(current player $Player)
	($Player is #in $Obj)
	~(room $Obj)

(understand [go/get out] as [leave])
	(current player $Player)
	($Player is #in $Obj)
	~(room $Obj)

(grammar [leave/exit] for [leave])
(grammar [get/jump [out off]] for [leave])

(describe action [leave $Obj])
	(current player $Player)
	($Player is $Rel $Obj)
	get (reverse-name $Rel) (the $Obj)

(describe action [leave])
	(current player $Player)
	($Player is $Rel $Obj)
	~(room $Obj)
	get (reverse-name $Rel) (the $Obj)

(unlikely [leave $Obj])
	(current player $Actor)
	~{
		($Actor has ancestor $Obj)
	(or)
		($Obj is worn by $Actor)
	}

~(very unlikely [leave (current room $)])

(refuse [leave (room $Room)])
	~(current room $Room)
	But you aren't in (the $Room).

(perform [leave])
	(current player $Player)
	($Player has parent $Obj)
	(if) (room $Obj) (then)
		(try [go #out])
	(else)
		(try [leave $Obj])
	(endif)

(before [leave $Obj])
	(current player $Actor)
	($Actor has ancestor $Obj)
	(recursively leave descendants of $Obj)

(before [leave $Obj])
	($Obj is closed)
	(current player $Player)
	($Player is #in $Obj)
	(first try [open $Obj])

(instead of [leave $Obj])
	(current player $Actor)
	($Obj is worn by $Actor)
	(try [remove $Obj])

(instead of [leave (current room $)])
	(try [go #out])

(prevent [leave $Obj])
	(current player $Player)
	~($Player has parent $Obj)
	You're not
	(if) (supporter $Obj) (then)
		(if) (container $Obj) (then)
			in or
		(endif)
		on top of
	(else)
		inside
	(endif)
	(the $Obj).

(narrate leaving $Obj)
	You
	(current player $Player)
	(if) ($Player is $Rel $Obj) (then)
		get (reverse-name $Rel)
	(else)
		leave
	(endif)
	(the $Obj).

(perform [leave $Obj])
	(narrate leaving $Obj)
	($Obj is $NewRel $NewObj)
	(move player to $NewRel $NewObj)

%% GO TO <room>

%% It is only possible to go to visited rooms and non-hidden objects in this
%% way.

(understand [go to | $Words] as [go to $Room])
	*(understand $Words as room name $Room)

(understand [go/approach | $Words] as [go to $Room])
	*(understand $Words as room name $Room)

(understand $Words as room name $Room)
	(filter $Words into $Filtered)
	(nonempty $Filtered)
	(determine object $Room)
		*(room $Room)
		($Room is visited)
	(from words)
		*(dict $Room)
	(matching all of $Filtered)

(unlikely [go to $]) %% Prefer default actions on objects to default actions on rooms, if both are enabled
	(default actions enabled)
	(default actions apply to rooms)
(very unlikely [go to $Room]) %% Don't call it very unlikely just because it involves a room
	(just) (current room $Room) %% But going to the current room should still be very unlikely

%% Rooms generally aren't present
~(action [go to $] requires $ to be present)

%% Utility like (last $) that also returns the everything-but-last of the list
%% In other words, it's the opposite of ($List = [$Head | $Rest])
(interface (split last element from $<List into $>Rest and $>Last))
(split last element from [$Last] into [] and $Last)
(split last element from [$Head | $OldRest] into [$Head | $NewRest] and $Last)
	(split last element from $OldRest into $NewRest and $Last)

(perform [go to $Room])
	(current room $Here)
	(if) ($Here = $Room) (then)
		You are already in (the $Room).
		(tick) (stop)
	(elseif)
		(shortest path from $Here to $Room is $FullPath)
		(split last element from $FullPath into $Path and $Final)
	(then)
		(exhaust) {
			*($Dir is one of $Path)
			(now) (moving long distances) %% Switch to a more minimal reporting style
			(try [go $Dir])
			(tick)
			(par)
		}
		(now) (last step of movement) %% And switch back for the last step
		(try [go $Final])
	(else)
		You don't know how to get to (the $Room) from here.
		(tick) (stop)
	(endif)

%% Navigation by direction:

%% What the player types is eventually translated into one of:

%% [leave $Room $Dir]
%% [leave $Room $Dir by $Vehicle]
%% [leave $Room $Dir with $Obj]

%% These are generally the ones to override/extend.

%% The default rules for the aforementioned actions invoke '(prevent entering
%% $Room)' and '(narrate entering $Room)'. These predicates can of course also
%% be overridden. Thus, entering a room is not an action of its own, but is
%% an inherent part of leaving a room.

%% GO <direction>

%% The rule for just typing a list of directions (without a verb) is further
%% down in the file.

(grammar [go/walk/crawl/leave/get/climb [direction]] for [go $])
(grammar [go/walk/crawl [to further] [direction]] for [go $])
(grammar [go/walk/crawl] for [go #out])
(grammar [enter] for [go #in])

(understand [climb] as [go $Dir])
	(current room $Room)
	*($Dir is one of [#up #down])
	(from $Room go $Dir to $)

(unlikely-complex [go $DirList] 0)
	(just)
	(if) (direction $DirList) (then)
		($Dir = $DirList)
	(else)
		%% Only consider the first direction in the list.
		([+ $Dir | $] = $DirList)
	(endif)
	(unlikely [go $Dir])

(unlikely [go $Dir])
	(current room $Room)
	~{
		(from $Room go $Dir to $Target)
		{ (room $Target) (or) (door $Target) (or) (direction $Target) }
	}

(before [go $])
	(recursively leave non-vehicles)

(before [go $Dir])
	(current room $Room)
	(from $Room go $Dir to $Target)
	(door $Target)
	($Target is closed)
	(first try [open $Target])

(prevent [go $])
	(current player $Actor)
	($Actor is $Rel $Obj)
	~(room $Obj)
	~(vehicle $Obj)
	(when $Actor is $Rel $Obj)

(perform [go $Dir])
	(current player $Actor)
	(current room $Room)
	(if) ($Actor has parent $Room) (then)
		(try [leave $Room $Dir])
	(else)
		($Actor has parent $Vehicle)
		(try [leave $Room $Dir by $Vehicle])
	(endif)

%% PUSH <obj> <dir>

(grammar [push/move/shove/shift/press/roll [single] [direction]] for [push $ $])

(unlikely [push $Obj $])
	~(pushable $Obj)

(before [push $ $])
	(recursively leave non-vehicles)

(before [push $ $Dir])
	(current room $Room)
	(from $Room go $Dir to $Target)
	(door $Target)
	($Target is closed)
	(first try [open $Target])

(prevent [push $Obj $])
	~(pushable $Obj)
	(The $Obj) can't be pushed from place to place.

(prevent [push $ $])
	(current player $Actor)
	($Actor is $Rel $Obj)
	~{ ($Rel = #in) (room $Obj) }
	(when $Actor is $Rel $Obj)

(perform [push $Obj $Dir])
	(current room $Room)
	(try [leave $Room $Dir with $Obj])

%% PUSH <obj>

(grammar [push/move/shove/shift/press [object]] for [push $])

(perform [push (pushable $Obj)])
	In what direction?
	(asking for direction in [push $Obj []])

(perform [push (room $)])
	Pushing on your surroundings has no effect.

(perform [push (item $Obj)])
	You give (the $Obj) a bit of a push.

(perform [push $Obj])
	You apply a bit of force to (the $Obj), but (it $Obj doesn't) budge.

%% PULL <obj>

(grammar [pull/yank/drag/tug/tow [object]] for [pull $])
(grammar [pull/yank/drag/tug/tow on [object]] for [pull $])

(perform [pull $Obj])
	You yank at (the $Obj), but
	(if) (item $Obj) (then)
		nothing noteworthy happens.
	(else)
		(it $Obj) won't budge.
	(endif)

%% TURN <obj>

(grammar [turn/rotate/twist/screw/unscrew [object]] for [turn $])

(prevent [turn (room $Obj)])
	You can't turn (the $Obj).

(perform [turn $Obj])
	Turning (the $Obj) has no apparent effect.

%% READ <obj>

(grammar [read [object]] for [read $])

(prevent [read $])
	~(player can see)
	It is too dark to read.

(perform [read $Obj])
	There's nothing written on (the $Obj).

%% FLUSH <obj>
%% FLUSH

(grammar [flush [object]] for [flush $])
(grammar [flush] for itself)

(perform [flush $Obj])
	You don't know how to flush (the $Obj).
	(tick) (stop)

(perform [flush])
	Flush what?
	(asking for object in [flush []])

%% SWIM IN <obj>
%% SWIM

(grammar [swim/bathe in [single]] for [swim in $])
(grammar [swim/bathe] for [swim])

(perform [swim])
	In what?
	(asking for object in [swim in []])

%% CLEAN <obj>

(grammar [clean/brush/shine/polish/sweep/dust/wipe/scrub [object]] for [clean $])

(perform [clean $Obj])
	You make a half-hearted attempt at cleaning (the $Obj).

%% TIE <obj> TO <obj>
%% TIE <obj>

(understand [tie/bind/attach/fasten | $Words] as [tie $A to $B])
	*(split $Words by [to on onto around] into $Left and $Right)
	*(understand $Left as single object $A)
	(if) ($Right = [itself]) (then)
		($B = $A)
	(else)
		*(understand $Right as single object $B)
	(endif)

(understand [tie/bind/attach/fasten | $Words] as [tie $Obj])
	*(understand $Words as single object $Obj)

(unlikely [tie $])

(perform [tie $Obj])
	To what?
	(asking for object in [tie $Obj to []])

(perform [tie $A to $B])
	There's no obvious way to tie (the $A) to (the $B).
	(tick) (stop)

%% UNTIE <obj> FROM <obj>
%% UNTIE <obj>

(understand [untie | $Words] as [untie $A from $B])
	*(split $Words by [from] into $Left and $Right)
	*(understand $Left as single object $A)
	(if) ($Right = [itself]) (then)
		($B = $A)
	(else)
		*(understand $Right as single object $B)
	(endif)

(unlikely [untie $Obj from $])
	(unlikely [untie $Obj])

(understand [untie | $Words] as [untie $Obj])
	*(understand $Words as non-all object $Obj)

(perform [untie $Obj])
	(The $Obj) (isn't $Obj) tied to anything.
	(tick) (stop)

(perform [untie $Obj from $OtherObj])
	(The $Obj) (isn't $Obj) tied to (the $OtherObj).
	(tick) (stop)

%% ATTACK <obj> WITH <obj>
%% ATTACK <obj>

(grammar [attack/break/smash/hit/slap/kick/fight/torture/wreck/crack/destroy/murder/kill/punch/thump [single] with [single held]] for [attack $ with $])
(grammar [attack/break/smash/hit/slap/kick/fight/torture/wreck/crack/destroy/murder/kill/punch/thump [single]] for [attack $])

(unlikely [attack $ with $Obj])
	~(item $Obj)

(unlikely [attack $ with $Obj])
	(current player $Actor)
	~($Obj has ancestor $Actor)

(before [attack $ with $Obj])
	(ensure $Obj is held)

(prevent [attack $ with $Obj])
	(when $Obj isn't directly held)

(perform [attack $Obj with $])
	(try [attack $Obj])

(perform [attack $Obj])
	You consider attacking (the $Obj), but reject the idea.

%% LEAVE <room> <dir>
%% LEAVE <room> <dir> BY <vehicle>
%% LEAVE <room> <dir> WITH <object>

(instead of [leave $Room $Dir])
	(from $Room go $Dir to $Target)
	(direction $Target)
	(try [leave $Room $Target])

(prevent [leave $Room $Dir])
	(if) (from $Room go $Dir to $Target) (then)
		(if) (door $Target) (then)
			{
				(when $Target blocks passage)
			(or)
				(from $Room through $Target to $OtherRoom)
				(prevent entering $OtherRoom)
			}
		(elseif) (room $Target) (then)
			(prevent entering $Target)
		(else)
			(narrate failing to leave $Room $Dir)
		(endif)
	(else)
		(if) ($Dir is one of [#out #in]) (then)
			In what direction?
			(asking for direction in [go []])
		(else)
			(narrate failing to leave $Room $Dir)
		(endif)
	(endif)

%% If this is a step in a long-distance movement, keep the reporting short and sweet
(narrate leaving $ $Dir)
	(moving long distances)
	\( (name $Dir) \) (line)

(narrate leaving $Room $Dir)
	You
	(if) ($Dir is one of [#up #down]) (then)
		climb
	(elseif) (player can see) (then)
		walk
	(else)
		feel your way
	(endif)
	(name $Dir)
	(if) (from $Room go $Dir to $Target) (door $Target) (then)
		through (the $Target)
	(endif)
	.

(perform [leave $Room $Dir])
	(narrate leaving $Room $Dir)
	(from $Room go $Dir to room $Target)
	(enter $Target)

(instead of [leave $Room $Dir with $Obj])
	(from $Room go $Dir to $Target)
	(direction $Target)
	(try [leave $Room $Target with $Obj])

(prevent [leave $Room $Dir with $])
	(prevent [leave $Room $Dir])

(narrate leaving $ $Dir with $Obj)
	You push (the $Obj) (name $Dir).
	(par)

(perform [leave $Room $Dir with $PushObj])
	(narrate leaving $Room $Dir with $PushObj)
	(from $Room go $Dir to room $NewRoom)
	(now) ($PushObj is #in $NewRoom)
	(now) ($PushObj is handled)
	(enter $NewRoom)

(instead of [leave $Room $Dir by $Obj])
	(from $Room go $Dir to $Target)
	(direction $Target)
	(try [leave $Room $Target by $Obj])

(prevent [leave $Room $Dir by $])
	(prevent [leave $Room $Dir])

%% As above
(narrate leaving $ $Dir by $)
	(moving long distances)
	\( (name $Dir) \) (line)

(narrate leaving $ $Dir by $Obj)
	You drive (the $Obj) (name $Dir).
	(par)

(perform [leave $Room $Dir by $Vehicle])
	(narrate leaving $Room $Dir by $Vehicle)
	(from $Room go $Dir to room $NewRoom)
	(enter $NewRoom by $Vehicle)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Commands

(interface (command $<Action))

@(understand command $Action)
	(understand $Action)
	(command $Action)

(describe action (command $Action))
	issue the (exhaust) { *($Word is one of $Action) $Word } command

%% QUIT

(command [quit])
(understand [quit/q] as [quit])
(prevent [quit])
	~(interpreter supports quit)
	(div @meta) { In this interpreter, close the window to quit the game. }
(perform [quit])
	(div @meta) { Really quit? \(y (no space) / (no space) n\) }
	(if) (yesno) (then)
		(div @meta) (display quit message)
		(quit)
	(endif)
	(stop)

(display quit message)
	Thanks for playing!

%% RESTART

(understand command [restart])
(perform [restart])
	(div @meta) {
		Restart the game from the beginning? \(
		(if) (library links enabled) (then) (link) y (else) y (endif)
		(no space) / (no space)
		(if) (library links enabled) (then) (link) n (else) n (endif)
		\)
	}
	(if) (yesno) (then)
		(restart)
		(div @meta) { Failed to restart. }
	(endif)
	(stop)

%% SAVE

(understand command [save])
(perform [save])
	(if) (save $ComingBack) (then)
		(if) ($ComingBack = 1) (then)
			(roman)
			(div @meta) { Game state restored successfully. }
			(div @roomheader) (location headline)
		(else)
			(div @meta) { Game state saved successfully. }
		(endif)
	(else)
		(div @meta) { Failed to save the game state. }
	(endif)
	(stop)

%% RESTORE

(understand command [restore])
(perform [restore])
	(restore)
	(div @meta) { Failed to restore the game state. }
	(stop)

%% UNDO

(command [undo])
(perform [undo])
	(if) ~(interpreter supports undo) (then)
		(div @meta) { This interpreter doesn't support undo. }
	(elseif) (undo) (then)
		(div @meta) { Failed to undo last turn. }
	(else)
		(div @meta) { There are no more turns to undo! }
	(endif)
	(stop)

(narrate undoing $Words)
	(div @meta) { Undoing the last turn \( (print words $Words) \). }
	(line)
	(location headline)

%% TRANSCRIPT

(command [transcript on])
(understand [transcript/script on] as [transcript on])
(understand [transcript/script] as [transcript on])

(perform [transcript on])
	(div @meta) {
		(if) (transcript on) (then)
			Transcript enabled.
		(elseif) (transcript active) (then)
			%% Do nothing, transcripting is already active
		(else)
			Failed to enable transcript.
			(stop)
		(endif)
	}

(command [transcript off])
(understand [transcript/script off] as [transcript off])

(perform [transcript off])
	(transcript off)
	(div @meta) { Transcript disabled. }

%% SCORE

(understand command [score])
	(scoring enabled)

(perform [score])
	(scoring enabled)
	(current score $Score)
	(div @meta) {
		You currently have $Score
		(if) ($Score = 1) (then) point (else) points (endif)
		(if) (maximum score $Max) (then)
			out of a maximum of $Max
		(endif)
		.
	}

%% NOTIFY

(understand command [notify on])
	(scoring enabled)

(perform [notify on])
	(scoring enabled)
	(now) (score notifications are on)
	(div @meta) { Enabling score notifications. }

(understand command [notify off])
	(scoring enabled)

(perform [notify off])
	(scoring enabled)
	(now) ~(score notifications are on)
	(div @meta) { Score notifications have been turned off. }

%% PRONOUNS

(understand command [pronouns])
(perform [pronouns])
	(div @meta) {
		"Me" refers to yourself. (line)
		(collect $Obj)
			(player's it refers to $Obj)
		(or)
			(narrator's it refers to $Obj)
		(into $ItList)
		(if) (nonempty $ItList) (then) "It" refers to (or-listing $ItList). (line) (endif)
		(if) (her refers to $Her) (then) "Her" refers to (the $Her). (line) (endif)
		(if) (him refers to $Him) (then) "Him" refers to (the $Him). (line) (endif)
		(if) (them refers to $Them) (then) "Them" refers to (the $Them). (line) (endif)
	}

%% VERBOSE / BRIEF / SUPERBRIEF / SUPERVERBOSE

(global variable (verbosity level $))
%% 0 = superbrief (never show room details)
%% 1 = brief (show room details only when unvisited)
%% 2 = verbose (show room details except when moving long distances)
%% 3 = superverbose (always show room details)

%% If the author doesn't specify, we start with "verbose"
(startup)
	~(verbosity level $)
	(now) (verbosity level 2)

(understand command [superbrief])
(perform [superbrief])
	(now) (verbosity level 0)
	(div @meta) { (story title or default) is now in SUPERBRIEF mode. Location details will never be shown while moving, even on a first visit. }

(understand command [brief])
(perform [brief])
	(now) (verbosity level 1)
	(div @meta) { (story title or default) is now in BRIEF mode. Location details will not be shown when moving to a previously-visited area. }

(understand command [verbose])
(perform [verbose])
	(now) (verbosity level 2)
	(div @meta) { (story title or default) is now in VERBOSE mode. Location details will not be shown when travelling long distances, but will be shown after normal movement. }

(understand command [superverbose])
(perform [superverbose])
	(now) (verbosity level 3)
	(div @meta) { (story title or default) is now in SUPERVERBOSE mode. Location details will always be shown when moving. }

%% VERSION

(understand command [version])
(understand [banner] as [version])
(perform [version])
	(banner)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Simplified grammar definitions

%% A definition like the following:
%%	(grammar [give [held] to [animate]] for [give $ to $])
%% is transformed at compile-time into a compact internal representation:
%%	(grammar entry @give [22 to 11] [give $ to $])

%% The transformation is carried out by the following access predicates:

@(grammar $Words for itself)
	(understand $Words)
@(grammar [$Verb | $More] for $Action)
	(grammar transformer $More [] $Verb $Action 0)
@(grammar [$Verb | $More] for $Action reversed)
	(grammar transformer $More [] $Verb $Action 1)

@(grammar transformer [[single] | $Tail] $SoFar $Verb $Action $Rev)
	(grammar transformer $Tail [10 | $SoFar] $Verb $Action $Rev)
@(grammar transformer [[single object] | $Tail] $SoFar $Verb $Action $Rev)
	(grammar transformer $Tail [10 | $SoFar] $Verb $Action $Rev)
@(grammar transformer [[animate] | $Tail] $SoFar $Verb $Action $Rev)
	(grammar transformer $Tail [11 | $SoFar] $Verb $Action $Rev)
@(grammar transformer [[single held] | $Tail] $SoFar $Verb $Action $Rev)
	(grammar transformer $Tail [12 | $SoFar] $Verb $Action $Rev)
@(grammar transformer [[object] | $Tail] $SoFar $Verb $Action $Rev)
	(grammar transformer $Tail [20 | $SoFar] $Verb $Action $Rev)
@(grammar transformer [[held] | $Tail] $SoFar $Verb $Action $Rev)
	(grammar transformer $Tail [22 | $SoFar] $Verb $Action $Rev)
@(grammar transformer [[takable] | $Tail] $SoFar $Verb $Action $Rev)
	(grammar transformer $Tail [23 | $SoFar] $Verb $Action $Rev)
@(grammar transformer [[worn] | $Tail] $SoFar $Verb $Action $Rev)
	(grammar transformer $Tail [24 | $SoFar] $Verb $Action $Rev)
@(grammar transformer [[child] | $Tail] $SoFar $Verb $Action $Rev)
	(grammar transformer $Tail [25 | $SoFar] $Verb $Action $Rev)
@(grammar transformer [[takable child] | $Tail] $SoFar $Verb $Action $Rev)
	(grammar transformer $Tail [26 | $SoFar] $Verb $Action $Rev)
@(grammar transformer [[any] | $Tail] $SoFar $Verb $Action $Rev)
	(grammar transformer $Tail [30 | $SoFar] $Verb $Action $Rev)
@(grammar transformer [[any animate] | $Tail] $SoFar $Verb $Action $Rev)
	(grammar transformer $Tail [31 | $SoFar] $Verb $Action $Rev)
@(grammar transformer [[topic] | $Tail] $SoFar $Verb $Action $Rev)
	(grammar transformer $Tail [40 | $SoFar] $Verb $Action $Rev)
@(grammar transformer [[direction] | $Tail] $SoFar $Verb $Action $Rev)
	(grammar transformer $Tail [50 | $SoFar] $Verb $Action $Rev)
@(grammar transformer [[number] | $Tail] $SoFar $Verb $Action $Rev)
	(grammar transformer $Tail [60 | $SoFar] $Verb $Action $Rev)
@(grammar transformer [$Head | $Tail] $SoFar $Verb $Action $Rev)
	(grammar transformer $Tail [$Head | $SoFar] $Verb $Action $Rev)
@(grammar transformer [] $SoFar $Verb $Action $Rev)
	(grammar inverter $SoFar [] $Verb $Action $Rev)

@(grammar inverter [$Head | $Tail] $SoFar $Verb $Action $Rev)
	(grammar inverter $Tail [$Head | $SoFar] $Verb $Action $Rev)
@(grammar inverter [] $SoFar $Verb $Action 0)
	(grammar entry $Verb $SoFar $Action)
@(grammar inverter [] $SoFar $Verb $Action 1)
	(grammar entry $Verb $SoFar $Action reversed)

(interface (grammar entry $<Verb $>Grammar $Action))
(interface (grammar entry $<Verb $>Grammar $Action reversed))

%% The resulting grammar tables can be inspected in the debugger, by typing
%% *(grammar entry $ $ $)
%% *(grammar entry $ $ $ reversed)

%% We need a couple of understand-rules that query the grammar table:

(understand [$Verb | $Words] as $Action)
	*(grammar entry $Verb $Grammar $Action)
	*(match grammar $Grammar against $Words into $ObjList)
	(populate template $Action with $ObjList)

(understand [$Verb | $Words] as $Action)
	*(grammar entry $Verb $Grammar $Action reversed)
	*(match grammar $Grammar against $Words into $ObjList)
	(reverse $ObjList $RevObjList)
	(populate template $Action with $RevObjList)

(match grammar [] against [] into [])
(match grammar [$G | $MoreG] against $Words into $ObjList)
	(if) (number $G) (then)
		(if) (empty $MoreG) (then)
			*(match grammar token $G against $Words [] into $Obj)
			($ObjList = [$Obj])
		(else)
			(if) ($MoreG = [$Prep | $YetMoreG]) ~(number $Prep) (then)
				*(split $Words by $Prep into $Left and $Right)
			(else)
				($YetMoreG = $MoreG)
				*(split $Words anywhere into $Left and $Right)
			(endif)
			*(match grammar $YetMoreG against $Right into $MoreObj)
			*(match grammar token $G against $Left $MoreObj into $Obj)
			($ObjList = [$Obj | $MoreObj])
		(endif)
	(else)
		($Words = [$W | $MoreWords])
		(if) (nonempty $G) (then)
			($W is one of $G)
		(else)
			($W = $G)
		(endif)
		*(match grammar $MoreG against $MoreWords into $ObjList)
	(endif)

(match grammar token 10 against $Words $ into $Obj)
	*(understand $Words as single object $Obj)
(match grammar token 11 against $Words $ into $Obj)
	*(understand $Words as single object $Obj preferably animate)
(match grammar token 12 against $Words $ into $Obj)
	*(understand $Words as single object $Obj preferably held)
(match grammar token 20 against $Words $ into $Obj)
	*(understand $Words as non-all object $Obj)
(match grammar token 22 against $Words [$ExclObj | $] into $Obj)
	*(understand $Words as object $Obj preferably held excluding $ExclObj)
(match grammar token 22 against $Words $ into $Obj)
	*(understand $Words as object $Obj preferably held)
(match grammar token 23 against $Words $ into $Obj)
	*(understand $Words as object $Obj preferably takable)
(match grammar token 24 against $Words $ into $Obj)
	*(understand $Words as object $Obj preferably worn)
(match grammar token 25 against $Words [$Parent | $] into $Obj)
	*(understand $Words as object $Obj preferably child of $Parent)
(match grammar token 26 against $Words [$Parent | $] into $Obj)
	*(understand $Words as object $Obj preferably { ($_ has parent $Parent) (takable $_) })
(match grammar token 30 against $Words $ into $Obj)
	*(understand $Words as any object $Obj)
(match grammar token 31 against $Words $ into $Obj)
	*(understand $Words as any object $Obj preferably animate)
(match grammar token 40 against $Words $ into $Obj)
	*(understand $Words as topic $Obj)
(match grammar token 50 against $Words $ into $Obj)
	*(understand $Words as direction $Obj)
(match grammar token 60 against $Words $ into $N)
	*(understand $Words as number $N)

(interface (populate template $Template with $<ObjList))

(populate template [] with [])
(populate template [(fully bound $) | $More] with $ObjList)
	(populate template $More with $ObjList)
(populate template [$Head | $MoreA] with [$Head | $MoreObj])
	(populate template $MoreA with $MoreObj)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Understanding actions with special syntax

%% Rules for understanding actions that do not begin with a verb should go
%% here. This allows the other rules (that do begin with a verb) to be lumped
%% together into a single, efficient lookup operation.

(understand $Words as [go $Dir])
	~(implicit action wants direction)
	*(understand $Words as direction $Dir)

(understand $Words as [tell $Actor to | $Action])
	*(split $Words by [,] into $Left and $Right)
	*(understand $Left as single object $Actor preferably animate)
	(object $Actor) %% Significant when allowing parse errors.
	(current actor $OldActor)
	(now) (current actor $Actor)
	(rewrite $Right into $Simplified)
	(collect $A)
		*(understand $Simplified as $A)
	(into $List)
	(now) (current actor $OldActor)
	*($Action is one of $List)

(understand $Words as $Action)
	(implicit action is $Implicit)
	(if) (implicit action wants direction) (then)
		*(understand $Words as direction $O)
	(else)
		%% We don't know the correct policy, so fall back on 'non-all'.
		*(understand $Words as non-all object $O)
	(endif)
	(recover implicit action $Implicit $O into $Action)

(understand $Words as $Action)
	(default actions enabled)
	~{ (implicit action is $) ~(implicit action wants direction) }
	{
		*(understand $Words as non-all object $Obj)
	(or)
		(default actions apply to rooms)
		*(understand $Words as room name $Obj)
	}
	~(empty $Obj)
	~($Obj = [1])
	(if) ($Obj = [a $RealObj]) (then)
		(default action $RealObj $Action)
	(else)
		(default action $Obj $Action)
	(endif)

(default action (current room $) [look])
(default action (room $Obj) [go to $Obj])
(default action $Obj [examine $Obj])

(understand $Words as $Words)
	(understand $Words)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Dealing with actions

%% If the player enters multiple actions on one line ("get lamp. n"), they
%% are parsed and carried out one at a time.

%% A complex action ("get all") is broken down, and the simple actions are
%% carried out in turn.

%% A (simple) action may invoke preliminary actions (e.g. open the door
%% before walking through it). These are carried out in turn.

%% After the preliminary actions (before) have been carried out, the action
%% is potentially refused. Normally, actions that involve unreachable objects
%% are refused; this is overridden by actions, such as look at, that don't
%% require reachability.

%% If the action wasn't refused, it will be handled by the (instead of $)
%% predicate. This predicate can be overridden for special cases in the story.
%% The default behaviour is to further break down handling into two stages:
%% Prevent and perform.
%% They are separate because it's convenient to be able to override
%% e.g. what happens when you put the twig in the fire without also overriding
%% the default checks, such as whether you are holding the twig.

%% (prevent $) should print something and succeed if the player character
%% tries, but there's a problem with completing the action. When prevent
%% succeeds, time is advanced (tick), and further actions are stopped.

%% If prevent fails, (perform $) is invoked to carry out the action. For the
%% eighteen core actions in this standard library, the perform rules call out
%% to a separate (narrate ...) rule, for stories that wish to override the
%% narration without affecting the default operations on the object tree.

%% Note that the world model is updated after narrating. This allows the
%% narrate rule to query the world as it used to be, before carrying out the
%% operation, in order to say for instance 'you take the worm out of the can'.

%% If something dramatic happens, an overriding rule should advance time if
%% necessary and (stop). So if the player types "n. n", and the first action
%% implies opening a door, which implies unlocking the door, and the unlocking
%% triggers a cutscene, then opening the door is cancelled, and the second "n"
%% is also ignored.

%% After a non-command action, time is advanced using (tick). This can be
%% inhibited by querying (inhibit next tick).

%% Throughout this procedure, as soon as a refuse or prevent rule succeeds (or
%% (stop) is invoked), the entire procedure stops, and further actions are
%% ignored.

(describe action $Action)
	(describe self-describing action $Action)

(describe self-describing action [])

(describe self-describing action [(word $W) | $More])
	(just)
	$W
	(describe self-describing action $More)

(describe self-describing action [$Obj | $More])
	(the full $Obj)
	(describe self-describing action $More)

%% Debugging predicates:

(interface (actions on))
(interface (actions off))

(actions on)
	(now) (tracing actions)

(actions off)
	(now) ~(tracing actions)

(interface (try $<Action))

(try $Action)
	(if) (tracing actions) (then)
		(line) ACTION: $Action \( (describe action $Action) \) (line)
	(endif)
	~{ (refuse $Action) (stop) }
	(exhaust) *(before $Action)
	~{ (refuse $Action) (stop) }
	(instead of $Action)

(try $)
	%% Try always succeeds; this prevents accidental double-triggers.

(interface (first try $<Action))

(first try $Action)
	(line) \( first attempting to (describe action $Action) \) (line)
	(try $Action)
	(tick)
	(par)

%% In library 1.1.0, (refuse $) was overhauled to call out to two more specific predicates that authors can more easily override for their own actions. Plus, these predicates can now be checked in (prevent $) rules as well!

(refuse $Action)
	*(action $Action requires $Obj to be present)
	(when $Obj is not here)

(refuse $Action)
	*(action $Action requires $Obj to be touched)
	(when $Obj is out of reach)

(action $Action requires $Obj to be present) %% Assume all physical objects need presence
	*($Obj is one of $Action)
	(object $Obj)
	~(direction $Obj)
	~(relation $Obj)

(action $Action requires $Obj to be touched)
	*(action $Action requires $Obj to be present) %% Assume all presence-required objects need touch too

(before $)	(fail)

(instead of $Action)
	~{ (prevent $Action) (tick) (stop) }
	(perform $Action)
	(exhaust) *(after $Action)

(prevent $)	(fail)

(perform $Action)
	You can't (describe action $Action).
	(tick) (stop)

(after $)	(fail)

(interface (try-complex $<Action))

(try-complex $ComplexAction)
	(if) ~(action $ComplexAction preserves the question) (then)
		(now) ~(implicit action is $)
		(now) ~(implicit action wants direction)
	(endif)
	(if) ~(allowed action $ComplexAction) (then)
		(report disallowed action $ComplexAction)
		(stop)
	(elseif) ([] is one of $ComplexAction) (then)
		You're not aware of any such thing!
		(stop)
	(else)
		(strip decorations from $ComplexAction into $MultiAction)
		%% Now we have something like:
		%% [put [#marble1 #marble2 #marblefloor] #in #bowl]
		(if)
			*($Obj is one of $MultiAction)
			{
				(nonempty $Obj)
			(or)
				(object $Obj)
				~(direction $Obj)
				~(relation $Obj)
				~(room $Obj)
			}
		(then)
			(notice player's $Obj)
		(endif)
		(if) *($List is one of $MultiAction) (nonempty $List) (then)
			(exhaust) {
				*(regroup stripped action $MultiAction of
					$MultiAction into $Regrouped $Multi)
				%% Assuming the marbles are fungible, now we
				%% are backtracking over:
				%% [put [#marble1 #marble2] #in #bowl]
				%% [put #marblefloor #in #bowl]
				(if)
					~(empty $Multi)
				(then)
					%% If at least two multi-actions are
					%% implied, describe each step.
					(line)
					(if) (library links enabled) (then)
						(link) (The full $Multi)
					(else)
						(The full $Multi)
					(endif)
					:
				(endif)
				(try regrouped $Regrouped)
			}
		(else)
			%% Optimize the common case.
			(try regrouped $MultiAction)
		(endif)
	(endif)

(try regrouped $Regrouped)
	(exhaust) {
		*($Regrouped recursively contains $O)
		(object $O)
		(now) ~($O is hidden)
	}
	(if)
		*($Elem is one of $Regrouped)
		(nonempty $Elem)
	(then)
		(group-try $Regrouped)
	(else)
		(try $Regrouped)
	(endif)
	(if) ~(command $Regrouped) (then)
		(tick)
	(endif)
	(par)

%% Add rules to the following six predicates, and to
%% '(action $ may group $ with $)', to deal with groups of objects.

(group-refuse $MultiAction)
	*(expand group-action $MultiAction into $Simple)
	(refuse $Simple)

(group-before $MultiAction)
	*(expand group-action $MultiAction into $Simple)
	*(before $Simple)

(group-instead of $MultiAction)
	~{ (group-prevent $MultiAction) (tick) (stop) }
	(group-perform $MultiAction)
	(exhaust) *(group-after $MultiAction)

(group-prevent $MultiAction)
	*(expand group-action $MultiAction into $Simple)
	(prevent $Simple)

(group-perform $MultiAction)
	(exhaust) {
		*(expand group-action $MultiAction into $Simple)
		(perform $Simple)
	}

(group-after $MultiAction)
	*(expand group-action $MultiAction into $Simple)
	*(after $Simple)

(interface (group-try $<MultiAction))

(group-try $MultiAction)
	(if) (tracing actions) (then)
		(line)
		GROUP ACTION: $MultiAction \( (describe action $MultiAction) \)
		(line)
	(endif)
	~{ (group-refuse $MultiAction) (stop) }
	(exhaust) *(group-before $MultiAction)
	~{ (group-refuse $MultiAction) (stop) }
	(group-instead of $MultiAction)

(interface (first group-try $<MultiAction))

(first group-try $MultiAction)
	(line) \( first attempting to (describe action $MultiAction) \) (line)
	(group-try $MultiAction)
	(tick)
	(par)

(strip decorations from [] into [])

(strip decorations from [[a $Obj] | $MoreIn] into [$Obj | $MoreOut])
	(strip decorations from $MoreIn into $MoreOut)

(strip decorations from [[+ | $MultiIn] | $MoreIn] into [$MultiOut | $MoreOut])
	(strip decorations from $MultiIn into $MultiOut)
	(strip decorations from $MoreIn into $MoreOut)

(strip decorations from [$Obj | $MoreIn] into [$Obj | $MoreOut])
	(strip decorations from $MoreIn into $MoreOut)

(expand group-action [] into [])

(expand group-action [$HeadIn | $TailIn] into [$HeadOut | $TailOut])
	(if) (nonempty $HeadIn) (then)
		*($HeadOut is one of $HeadIn)
	(else)
		($HeadOut = $HeadIn)
	(endif)
	*(expand group-action $TailIn into $TailOut)

%% If the input is [frob [#a #b] #c [#d #e #f] [#e #d]]
%% and #d and #e can form a group, then we return four times:
%% Action:                             Multi:
%% [frob #a #c [#d #e] [#e #d]]        [#a [#d #e]]
%% [frob #a #c #f [#e #d]]             [#a #f]
%% [frob #b #c [#d #e] [#e #d]]        [#b [#d #e]]
%% [frob #b #c #f [#e #d]]             [#b #f]

(regroup stripped action [] of $ into [] [])

(regroup stripped action [$HeadIn | $TailIn] of $Action into [$HeadOut | $TailOut] $Multi)
	(if) (nonempty $HeadIn) (then)
		(regroup objects $HeadIn of $Action into $GroupList)
		(if) ($GroupList = [$Single]) (then)
			%% All of the objects in this slot ended up in the
			%% same group, like [#e #d] in the example.
			($HeadOut = $Single)
			*(regroup stripped action $TailIn of $Action into $TailOut $Multi)
		(else)
			%% Backtrack over the groups.
			*($HeadOut is one of $GroupList)
			*(regroup stripped action $TailIn of $Action into $TailOut $MultiTail)
			($Multi = [$HeadOut | $MultiTail])
		(endif)
	(else)
		%% This was a regular object or word, like @frob or #c.
		($HeadOut = $HeadIn)
		*(regroup stripped action $TailIn of $Action into $TailOut $Multi)
	(endif)

%% Transform e.g.:
%% [#marble1 #marblefloor #marble2] into [[#marble1 #marble2] #marblefloor]
%% [#foo #bar #bar #baz] into [#foo #bar #baz]

(regroup objects [] of $ into [])

(regroup objects [$HeadIn | $TailIn] of $Action into [$HeadOut | $TailOut])
	(collect group members $TailIn $HeadIn $Action $Included $Excluded)
	(if) (nonempty $Included) (then)
		($HeadOut = [$HeadIn | $Included])
	(else)
		($HeadOut = $HeadIn)
	(endif)
	(regroup objects $Excluded of $Action into $TailOut)

(collect group members $InputList $Key $Action $Included $Excluded)
	(collect $Obj1)
		*($Obj1 is one of $InputList)
		(action $Action may group $Key with $Obj1)
	(into $Included)
	(collect $Obj2)
		*($Obj2 is one of $InputList)
		~(action $Action may group $Key with $Obj2)
	(into $Excluded)

(interface (action $<Action may group $<Obj1 with $<Obj2))

(action $ may group $ with $)
	(fail)

(unlikely-complex $ComplexAction $VeryLevel)
	(strip decorations from $ComplexAction into $Stripped)
	*(expand group-action $Stripped into $Simple)
	(level $VeryLevel unlikely $Simple)

(level 0 unlikely $Action)
	(unlikely $Action) (or)
	(very unlikely $Action) (or)
	(very very unlikely $Action)

(level 1 unlikely $Action)
	(very unlikely $Action) (or)
	(very very unlikely $Action)

(level 2 unlikely $Action)
	(very very unlikely $Action)

%% Current and nearby rooms are in scope, but they're rarely what the player
%% means. The following rules ensure that most actions that mention rooms
%% directly are considered unlikely.

(very unlikely [(room $) | $])
(very unlikely [$ | $More])
	(very unlikely $More)

%% Only report the unrecognized topic (@?) as a last resort.

(interface (very very unlikely $<Action))

(very very unlikely [? | $])
(very very unlikely [$ | $More])
	(very very unlikely $More)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Daemons

(interface (inhibit next tick))
(inhibit next tick)
	(now) (inhibiting next tick)

%% When something dramatic happens in an action rule, we (stop) to cut off any further actions in the sequence. When something dramatic happens in an (on every tick) rule, we DON'T do that, because it would be weird to have only half a tick happen. Instead, we call this, which (stop)s once the tick is done.
(interface (stop after this tick))
(stop after this tick)
	(now) (stopping after this tick)

(tick)
	(if) (inhibiting next tick) (then)
		(now) ~(inhibiting next tick)
	(else)
		(update environment around player)
		(exhaust) *(early on every tick)
		(exhaust) *(on every tick)
		(exhaust) *(late on every tick)
		(if) (stopping after this tick) (then)
			(now) ~(stopping after this tick)
			(stop)
		(endif)
	(endif)

%% Stories may add rules to the following predicates:

(on every tick)
	(current room $Room)
	*(on every tick in $Room)

(on every tick)
	(if) (narrator's it is protected) (then)
		(now) ~(narrator's it is protected)
	(elseif) (player's it refers to $) (then)
		%% The narrator's it is short-lived, except when
		%% 'it' unambiguously refers to it.
		(now) ~(narrator's it refers to $)
	(endif)

(on every tick in $)		(fail)

(early on every tick)		(fail)
(late on every tick)		(fail)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Non-player characters

%% (let $NPC take $Obj)		(narrate $NPC taking $Obj)
%% (let $NPC drop $Obj)		(narrate $NPC dropping $Obj)
%% (let $NPC wear $Obj)		(narrate $NPC wearing $Obj)
%% (let $NPC remove $Obj)	(narrate $NPC removing $Obj)
%% (let $NPC put $A $Rel $B)	(narrate $NPC putting $A $Rel $B)
%% (let $NPC open $Obj)		(narrate $NPC opening $Obj)
%% (let $NPC close $Obj)	(narrate $NPC closing $Obj)

%% (let $NPC climb $Obj)	(narrate $NPC climbing $Obj)
%% (let $NPC enter $Obj)	(narrate $NPC entering $Obj)
%% (let $NPC leave $Obj)	(narrate $NPC leaving $Obj)
%% (let $NPC go $Dir)		(narrate $NPC leaving $Room $Dir to $NewRoom)
%%				(narrate $NPC entering $Room from $OldRoom)

%% No checks are carried out -- only attempt an NPC action if it makes sense!

(interface (let $<NPC climb $<Obj))
(interface (narrate $<NPC climbing $<Obj))

(let $NPC climb $Obj)
	(if) (player can see $Obj) (then)
		(narrate $NPC climbing $Obj)
	(endif)
	(now) ($NPC is #on $Obj)

(narrate $NPC climbing $Obj)
	(The $NPC) get(s $NPC) onto (the $Obj).
	(notice $NPC)

(interface (let $<NPC close $<Obj))
(interface (narrate $<NPC closing $<Obj))

(let $NPC close $Obj)
	(if) (player can see $Obj) (then)
		(narrate $NPC closing $Obj)
	(endif)
	(now) ($Obj is closed)

(narrate $NPC closing $Obj)
	(The $NPC) close(s $NPC) (the $Obj).
	(notice $NPC)

(interface (let $<NPC drop $<Obj))
(interface (narrate $<NPC dropping $<Obj))

(let $NPC drop $Obj)
	(if) (player can see $NPC) (then)
		(narrate $NPC dropping $Obj)
	(endif)
	($NPC is $Rel $Loc)
	(now) ($Obj is $Rel $Loc)

(narrate $NPC dropping $Obj)
	(The $NPC) drop(s $NPC) (the $Obj).
	(notice $NPC)

(interface (let $<NPC enter $<Obj))
(interface (narrate $<NPC entering $<Obj))

(let $NPC enter $Obj)
	(if) (player can see $Obj) (then)
		(narrate $NPC entering $Obj)
	(endif)
	(now) ($NPC is #in $Obj)

(narrate $NPC entering $Obj)
	(The $NPC) get(s $NPC) into (the $Obj).
	(notice $NPC)

(interface (let $<NPC go $<Dir))
(interface (narrate $<NPC leaving $<OldRoom $<Dir to $<NewRoom))
(interface (narrate $<NPC entering $<NewRoom from $<OldRoom))

(let $NPC go $Dir)
	($NPC is in room $OldRoom)
	(from $OldRoom go $Dir to room $NewRoom)
	(if) (player can see $NPC) (then)
		(narrate $NPC leaving $OldRoom $Dir to $NewRoom)
	(endif)
	(now) ($NPC is #in $NewRoom)
	(if) (player can see $NPC) (then)
		(narrate $NPC entering $NewRoom from $OldRoom)
	(endif)

(narrate $Obj leaving $ $Dir to $NewRoom)
	(The $Obj) disappear(s $Obj) (name $Dir)
	(if) ($NewRoom is visited) (then) to (the $NewRoom) (endif).

(narrate $Obj entering $NewRoom from $OldRoom)
	(if) (from $NewRoom go $InDir to room $OldRoom) (then)
		(if) ($InDir = #in) (then)
			(The $Obj) leaves (the $OldRoom).
		(else)
			(The $Obj) enter(s $Obj) from (from-adverb $InDir).
			(notice $Obj)
		(endif)
	(else)
		(The $Obj) enter(s $Obj) from (the $OldRoom).
		(notice $Obj)
	(endif)

(interface (let $<NPC leave $<Obj))
(interface (narrate $<NPC leaving $<Obj))

(let $NPC leave $Obj)
	(if) (player can see $Obj) (then)
		(narrate $NPC leaving $Obj)
	(endif)
	($Obj is $Rel $Loc)
	(now) ($NPC is $Rel $Loc)

(narrate $NPC leaving $Obj)
	(The $NPC) leave(s $NPC) (the $Obj).
	(notice $NPC)

(interface (let $<NPC open $<Obj))
(interface (narrate $<NPC opening $<Obj))

(let $NPC open $Obj)
	(if) (player can see $Obj) (then)
		(narrate $NPC opening $Obj)
	(endif)
	(now) ($Obj is open)

(narrate $NPC opening $Obj)
	(The $NPC) open(s $NPC) (the $Obj).
	(notice $NPC)

(interface (let $<NPC put $<Obj $<Rel $<Dest))
(interface (narrate $<NPC putting $<Obj $<Rel $<Dest))

(let $NPC put $Obj $Rel $Dest)
	(if) (player can see $NPC) (then)
		(narrate $NPC putting $Obj $Rel $Dest)
	(endif)
	(now) ($Obj is $Rel $Dest)

(narrate $NPC putting $Obj $Rel $Dest)
	(The $NPC) put(s $NPC) (the $Obj) (name $Rel) (the $Dest).
	(notice $NPC)

(interface (let $<NPC remove $<Obj))
(interface (narrate $<NPC removing $<Obj))

(let $NPC remove $Obj)
	($Obj is #wornby $NPC)
	(if) (player can see $NPC) (then)
		(narrate $NPC removing $Obj)
	(endif)
	(exhaust) {
		*($Sub is #under $Obj)
		(now) ($Sub is #wornby $NPC)
	}
	(now) ($Obj is #heldby $NPC)

(narrate $NPC removing $Obj)
	(The $NPC) take(s $NPC) off (the $Obj).
	(notice $NPC)

(interface (let $<NPC take $<Obj))
(interface (narrate $<NPC taking $<Obj))

(let $NPC take $Obj)
	(if) (player can see $NPC) (then)
		(narrate $NPC taking $Obj)
	(endif)
	(now) ($Obj is #heldby $NPC)

(narrate $NPC taking $Obj)
	(The $NPC) take(s $NPC) (the $Obj).
	(notice $NPC)

(interface (let $<NPC wear $<Obj))
(interface (narrate $<NPC wearing $<Obj))

(let $NPC wear $Obj)
	(if) (player can see $NPC) (then)
		(narrate $NPC wearing $Obj)
	(endif)
	(now) ($Obj is #wornby $NPC)

(narrate $NPC wearing $Obj)
	(The $NPC) put(s $NPC) on (the $Obj).
	(notice $NPC)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Numbers

(interface (parse numeral $<Word into $>Number))

(parse numeral @zero into 0)
(parse numeral @one into 1)
(parse numeral @two into 2)
(parse numeral @three into 3)
(parse numeral @four into 4)
(parse numeral @five into 5)
(parse numeral @six into 6)
(parse numeral @seven into 7)
(parse numeral @eight into 8)
(parse numeral @nine into 9)
(parse numeral @ten into 10)
(parse numeral @eleven into 11)
(parse numeral @twelve into 12)
(parse numeral @thirteen into 13)
(parse numeral @fourteen into 14)
(parse numeral @fifteen into 15)
(parse numeral @sixteen into 16)
(parse numeral @seventeen into 17)
(parse numeral @eighteen into 18)
(parse numeral @nineteen into 19)
(parse numeral $N into $N) (number $N)

(interface (understand $<Words as number $>Number))

(understand [$Word] as number $N)
	(parse numeral $Word into $N)

(interface (spell out $<Number))

(spell out 0)		zero
(spell out 1)		one
(spell out 2)		two
(spell out 3)		three
(spell out 4)		four
(spell out 5)		five
(spell out 6)		six
(spell out 7)		seven
(spell out 8)		eight
(spell out 9)		nine
(spell out 10)		ten
(spell out 11)		eleven
(spell out 12)		twelve
(spell out 13)		thirteen
(spell out 14)		fourteen
(spell out 15)		fifteen
(spell out 16)		sixteen
(spell out 17)		seventeen
(spell out 18)		eighteen
(spell out 19)		nineteen
(spell out $N)		$N

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Printing the names of objects and object lists

(interface (a $<Obj))
(interface (the $<Obj))
(interface (the full $<Obj))
(interface (A $<Obj))
(interface (A full $<Obj))
(interface (Name $<Obj))
(interface (Tagged name $<Obj))
(interface (The $<Obj))
(interface (The full $<Obj))

(a [])			nothing
(a (list $List))	(a-listing $List)

(the [])		something	%% May appear in incomplete actions.
(the full [])		something	%% May appear in incomplete actions.
(the [1])		someone		%% May appear in incomplete actions.
(the full [1])		someone		%% May appear in incomplete actions.

(the [a $Obj])			(a $Obj)
(the [+ | $List])		(the-listing $List)
(the (list $List))		(the-listing $List)

(the full [a $Obj])		(a full $Obj)
(the full [+ | $List])		(the-full-listing $List)
(the full [, | $List])		(the-full-or-listing $List)
(the full (list $List))		(the-full-listing $List)

(it [$Single])			(it $Single)
(its [$Single])			(its $Single)
(itself [$Single])		(itself $Single)
(is [$Single])			(is $Single)
(isn't [$Single])		(isn't $Single)
(has [$Single])			(has $Single)
(does [$Single])		(does $Single)
(s [$Single])			(s $Single)
(es [$Single])			(es $Single)
(the [$Single] is)		(the $Single is)
(it [$Single] is)		(it $Single is)
(it [$Single] has)		(it $Single has)
(it [$Single] does)		(it $Single does)
(it [$Single] s)		(it $Single s)
(it [$Single] es)		(it $Single es)
(them [$Single])		(them $Single)

(it (nonempty $List))		they
(its (nonempty $List))		their
(itself (nonempty $List))	themselves
(is (nonempty $List))		are
(isn't (nonempty $List))	aren't
(has (nonempty $List))		have
(does (nonempty $List))		do
(s (nonempty $List))
(es (nonempty $List))
(the (nonempty $List) is)	(the $List) are
(it (nonempty $List) is)	they're
(them (nonempty $List))		them

(the full $Obj)
	(the $Obj)
	(add location information for $Obj)

(a full $Obj)
	(a $Obj)
	(add location information for $Obj)

(interface (add location information for $<Obj))

(add location information for $Obj)
	(if) (clarify location of $Obj) ~(direction $Obj) ~(relation $Obj) (then)
		(if)
			(current room $Room)
			(from $Room go $Dir to $Obj)
			(direction $Dir)
		(then)
			(present-adverb $Dir)
		(elseif)
			($Obj is $Rel $Loc)
			~(room $Loc)
		(then)
			(if) (plural $Obj) (then)
				that are
			(else)
				that's
			(endif)
			(name $Rel) (the full $Loc)
		(endif)
	(endif)

(clarify location of (door $Obj))
	~(singleton $Obj)

(a ($Obj is hidden))	(reveal $Obj) (fail) %% Proceed with normal handling.
(the ($Obj is hidden))	(reveal $Obj) (fail) %% Proceed with normal handling.

(a (current player $Obj))
	(if) (library links enabled) (then)
		(link [myself]) yourself
	(else)
		yourself
	(endif)

(A (current player $Obj))
	(if) (library links enabled) (then)
		(link [me]) You
	(else)
		You
	(endif)

(the $Obj)		(current player $Obj) yourself
(The $Obj)		(current player $Obj) You
(it $Obj)		(current player $Obj) you
(them $Obj)		(current player $Obj) you
(its $Obj)		(current player $Obj) your
(itself $Obj)		(current player $Obj) yourself
(is $Obj)		(current player $Obj) are
(isn't $Obj)		(current player $Obj) aren't
(has $Obj)		(current player $Obj) have
(does $Obj)		(current player $Obj) do
(that $Obj)		(current player $Obj) yourself
(s $Obj)		(current player $Obj)
(es $Obj)		(current player $Obj)
(the $Obj is)		(current player $Obj) you're
(it $Obj is)		(current player $Obj) you're
(That $Obj)		(current player $Obj) You
(That's $Obj)		(current player $Obj) You're

(a (proper $Obj))	(maybe link $Obj)
(the (proper $Obj))	(tagged name $Obj)

(a (your $Obj))		your (maybe link $Obj)
(the (your $Obj))	your (tagged name $Obj)

(a (singleton $Obj))	(maybe link $Obj {(the $_)})

(a (pair $Obj))		a pair of (maybe link $Obj)

(a (uncountable $Obj))	some (maybe link $Obj)

(a (plural $Obj))	some (maybe link $Obj)
(it (plural $))		they
(them (plural $))	them
(itself (plural $))	themselves
(its (plural $))	their
(it (plural $) is)	they're
(s (plural $))
(es (plural $))
(is (plural $))		are
(isn't (plural $))	aren't
(has (plural $))	have
(does (plural $))	do
(that (plural $))	those
(That's (plural $))	Those are

(a (an $Obj))		an (maybe link $Obj)

(it (female $))		she
(them (female $))	her
(itself (female $))	herself
(its (female $))	her
(it (female $) is)	she's

(it (male $))		he
(them (male $))		him
(itself (male $))	himself
(its (male $))		his
(it (male $) is)	he's

(it (gender-neutral $))		they
(them (gender-neutral $))	them
(itself (gender-neutral $))	themself
(its (gender-neutral $))	their
(it (gender-neutral $) is)	they're
(it (gender-neutral $) has)	they have
(it (gender-neutral $) does)	they do
(it (gender-neutral $) s)
(it (gender-neutral $) es)

(a $Obj)		a (maybe link $Obj)
(the $Obj)		the (tagged name $Obj)
(it $)			it
(them $)		it
(itself $)		itself
(its $)			its
(s $)			(no space) s
(es $)			(no space) es
(is $)			is
(isn't $)		isn't
(has $)			has
(does $)		does
(the $O is)		(the $O) (is $O)
(it $O is)		(it $O) (is $O)
(it $O has)		(it $O) (has $O)
(it $O does)	(it $O) (does $O)
(it $O s)		(s $O)  %% To be used when subject is a pronoun
(it $O es)		(es $O) %% (behaves differently for they/them)
(that $)		that
(That's $)		That's

(doesn't $Obj)		(does $Obj) (no space) n't
(it $Obj doesn't)	(it $Obj does) (no space) n't

(tagged name $Obj) (name $Obj)
(name $)

%% Avoid a compiler warning, since the library doesn't use this:
(interface (Its $<Obj))

(Name $Obj)		(uppercase) (name $Obj)
(Tagged name $Obj)	(uppercase) (tagged name $Obj)
(A $Obj)		(uppercase) (a $Obj)
(The $Obj)		(uppercase) (the $Obj)
(A full $Obj)		(uppercase) (a full $Obj)
(The full $Obj)		(uppercase) (the full $Obj)
(It $Obj)		(uppercase) (it $Obj)
(Its $Obj)		(uppercase) (its $Obj)
(The $Obj is)		(uppercase) (the $Obj is)
(That $Obj)		(uppercase) (that $Obj)

(interface ($<Obj))

($Obj)
	(link) (tagged name $Obj)

(interface ($<Obj $<Text))

($Obj $Text)
	(if) (interpreter supports links) (then)
		(collect words)
			(tagged name $Obj)
		(into $Words)
		(link $Words) (query $Text)
	(else)
		(query $Text)
	(endif)

(maybe link $Obj)
	(if) (library links enabled) (then)
		(link) (tagged name $Obj)
	(else)
		(tagged name $Obj)
	(endif)

(maybe link $Obj $Closure)
	(if) (library links enabled) (then)
		(if) (current player $Obj) (then)
			(link [myself]) (query $Closure $Obj)
		(else)
			(link) (query $Closure $Obj)
		(endif)
	(else)
		(query $Closure $Obj)
	(endif)

(interface (open or closed $<Obj))

(open or closed $Obj)
	(if) ($Obj is open) (then)
		open
	(else)
		closed
	(endif)

(a-listing $List)
	(listing $List {(a $_)} @and [] 0)
(the-listing $List)
	(listing $List {(the $_)} @and @the 0)
(the-full-listing $List)
	(listing $List {(the full $_)} @and @the 0)
(the-full-or-listing $List)
	(listing $List {(maybe link $_ {(the full $_)})} @or @the 0)
(or-listing $List)
	(listing $List {(the $_)} @or @the 0)

(listing [] $ $ $ 0)
	nothing
(listing [$Head | $Tail] $PrintClosure $Conjunction $The $NPrinted)
	(if) (fungibility enabled) (then)
		(combine-fungible $Tail $Head $NInc $Rest)
	(else)
		($Rest = $Tail)
	(endif)
	(if) (empty $Rest) (then)
		(if) ($Conjunction = @,) (then) %% Passing @, as the conjunction means use commas for everything
			(if) ($NPrinted > 0) (then) , (endif)
		(else)
			(if) ($NPrinted > 1) (then) , (endif)
			(if) ($NPrinted > 0) (then) $Conjunction (endif)
		(endif)
	(else)
		(if) ($NPrinted > 0) (then) , (endif)
	(endif)
	(if) (fungibility enabled) ($NInc > 1) (then)
		(if) ($The = @the) (then)
			the
			(spell out $NInc)
			(plural name $Head)
		(else)
			(spell out $NInc)
			(if) (library links enabled) (then)
				(link) (plural name $Head)
			(else)
				(plural name $Head)
			(endif)
		(endif)
	(else)
		(query $PrintClosure $Head)
	(endif)
	($NPrinted plus 1 into $NPp1)
	(if) (nonempty $Rest) (then)
		(listing $Rest $PrintClosure $Conjunction $The $NPp1)
	(endif)

(interface (list of objects $<Rel $<Loc))

(list of objects $Rel $Loc)
	(collect $Obj)
		*($Obj is $Rel $Loc)
	(into $List)
	(a $List)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Generating dictionary words for objects

(dict (your $))
	my mine
	your %% In case players are excessively literal (or copy-pasting)

(dict (pair $))
	pair

(plural dict (pair $))
	pairs

(dict (openable $Obj))
	(if) ($Obj is open) (then)
		%% With default actions, "open box" would look like a request
		%% to examine an already-open box, which is probably not
		%% what the player intended.
		(if) ~(default actions enabled) (then) open (endif)
		opened
	(else)
		closed
	(endif)

(dict (lockable $Obj))
	(if) ($Obj is locked) (then)
		locked
	(else)
		unlocked
	(endif)

%% By default, any word mentioned in the name rule is included:

(dict $Obj)
	(tagged name $Obj)

%% The plural dict should only mention nouns, so the default rule can't
%% invoke (plural name $).

(plural dict $)
	(fail)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Setting the pronouns from an object

(interface (notice $<Obj))

(notice $Obj)
	(if) (object $Obj) (then)
		(reveal $Obj)

		%% Should we set plural pronouns?
		(if)
			(ambiguously plural $Obj) (or)
			(plural $Obj) (or)
			(pair $Obj) (or)
			(gender-neutral $Obj)
		(then)
			(now) (them refers to [$Obj])
		(endif)

		%% Should we set singular pronouns?
		(if)
			(ambiguously plural $Obj) (or)
			~{
				(plural $Obj) (or)
				(pair $Obj) (or)
				(gender-neutral $Obj)
			}
		(then)
			(if) (female $Obj) (then)
				(now) (her refers to $Obj)
			(elseif) (male $Obj) (then)
				(now) (him refers to $Obj)
			(else)
				(now) (narrator's it refers to $Obj)
				(now) (narrator's it is protected)
				(if) (player's it refers to $Obj) (then)
					(now) ~(player's it refers to $)
				(endif)
			(endif)
		(endif)

	(elseif) (list $Obj) (then)
		(if) ($Obj = [$Single]) (then)
			(notice $Single)
		(else)
			(now) (them refers to $Obj)
		(endif)
	(endif)

(notice player's $Obj)
	(if) ~(current player $Obj) (then)

		(if) (list $Obj) (then)
			(if) ($Obj = [$Single]) (then)
				(notice player's $Single)
			(else)
				(now) (them refers to $Obj)
			(endif)
		(else)

			%% Should we set plural pronouns?
			(if)
				(ambiguously plural $Obj) (or)
				(plural $Obj) (or)
				(pair $Obj) (or)
				(gender-neutral $Obj)
			(then)
				(now) (them refers to [$Obj])
			(endif)

			%% Should we set singular pronouns?
			(if)
				(ambiguously plural $Obj) (or)
				~{
					(plural $Obj) (or)
					(pair $Obj) (or)
					(gender-neutral $Obj)
				}
			(then)
				(if) (female $Obj) (then)
					(now) (her refers to $Obj)
				(elseif) (male $Obj) (then)
					(now) (him refers to $Obj)
				(else)
					(now) (player's it refers to $Obj)
					(if) (narrator's it refers to $Obj) (then)
						(now) ~(narrator's it refers to $)
					(endif)
				(endif)
			(endif)

		(endif)
	(endif)

(clear all pronouns)
	(now) ~(player's it refers to $)
	(now) ~(narrator's it refers to $)
	(now) ~(her refers to $)
	(now) ~(him refers to $)
	(now) ~(them refers to $)

(forget pronouns out of scope)
	(if) (player's it refers to $Obj) ~($Obj is in scope) (then)
		(now) ~(player's it refers to $)
	(endif)
	(if) (narrator's it refers to $Obj) ~($Obj is in scope) (then)
		(now) ~(narrator's it refers to $)
	(endif)
	(if) (him refers to $Obj) ~($Obj is in scope) (then)
		(now) ~(him refers to $)
	(endif)
	(if) (her refers to $Obj) ~($Obj is in scope) (then)
		(now) ~(her refers to $)
	(endif)
	(if)
		(them refers to $ObjList)
		*($Obj is one of $ObjList)
		~($Obj is in scope)
	(then)
		(now) ~(them refers to $)
	(endif)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Default descriptions etc.

(descr (current player $))
	Well, there you are.

(descr (door $Door))
	~($Door blocks light)
	(current room $Room)
	(from $Room through $Door to $R)
	Through (the $Door) you see (the $R).

(descr (door $Door))
	(openable $Door)
	(The $Door is) currently (open or closed $Door).

(descr $O)
	(current room $Room)
	*(from $Room go $Dir to $O)
	(direction $Dir)
	(The $O is) (name $Dir) from here.

(descr $Obj)
	(It $Obj) seem(it $Obj s) to be harmless.

(look $Obj)
	(descr $Obj)

(feel (room $))
	You poke around at your surroundings. They feel as expected.

(feel $Obj)
	(The $Obj) feel(s $Obj) as expected.

(appearance $Obj $ $)
	(appearance $Obj)

(appearance ($Obj is pristine))
	(initial appearance $Obj)

(appearance (item $Obj))
	($Obj is handled)
	($Obj is $Rel $Loc)
	(if) ($Rel = #in) (room $Loc) (then)
		You see (a $Obj) here.
	(else)
		(A $Obj) (is $Obj) (name $Rel) (the $Loc).
	(endif)

(appearance (nonempty $List))
	(fungibility enabled)
	($List = [$Head | $])
	($Head is $Rel $Loc)
	(if) ($Rel = #in) (room $Loc) (then)
		You see (a $List) here.
	(else)
		(A $List) are (name $Rel) (the $Loc).
	(endif)

(make appearances $Rel $Loc)
	(if)
		~{ (opaque $Loc) ($Loc is closed) ($Rel = #in) }
		($Loc is $ParentRel $ParentLoc)
	(then)
		(make appearances $ParentRel $ParentLoc)
	(endif)
	(if) (fungibility enabled) (then)
		(collect $Obj)
			*($Obj is $Rel $Loc)
			~($Obj is hidden)
		(into $ObjList)
		(fungibility-enabled appearance $ObjList $Rel $Loc)
	(else)
		(exhaust) {
			*($Object is $Rel $Loc)
			~($Object is hidden)
			(par)
			(appearance $Object $Rel $Loc)
			(notice $Object)
		}
	(endif)

(interface (list objects $<Rel $<Loc))

(list objects $Rel $Loc)
	(collect $Obj)
		*($Obj is $Rel $Loc)
		~(current player $Obj)
	(into $List)
	(if) (nonempty $List) (then)
		(Name $Rel) (the $Loc) (is $List) (a $List).
		(notice $List)
	(endif)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Fungibility

(fungibility enabled)	(fail)	%% Override this from the story.

(fungible $A $A)

(truly fungible $A $B)
	(fungible $A $B)
	($A is $Rel $Parent)
	($B is $Rel $Parent)

(combine-fungible [] $ 1 [])
(combine-fungible $InputList $Key $N $Excluded)
	(accumulate 1)
		*($Obj1 is one of $InputList)
		(truly fungible $Key $Obj1)
	(into $Sum)
	(if) ($Sum = 0) (then)
		($N = 1)
		($Excluded = $InputList)
	(else)
		($Sum plus 1 into $N)
		(collect $Obj2)
			*($Obj2 is one of $InputList)
			~(truly fungible $Key $Obj2)
		(into $Excluded)
	(endif)

(strip-fungible [] [])
(strip-fungible [$HeadIn | $MoreIn] [$HeadOut | $MoreOut])
	(combine-fungible $MoreIn $HeadIn $N $Rest)
	(if) (1 < $N) (then)
		($HeadOut = [a $HeadIn]) %% Decorated.
	(else)
		($HeadOut = $HeadIn)
	(endif)
	(strip-fungible $Rest $MoreOut)

(fungibility-enabled appearance [] $ $)

(fungibility-enabled appearance [$Head | $Tail] $Rel $Loc)
	(combine-fungible $Tail $Head $NInc $Rest)
	(par)
	(exhaust) {
		(if) ($NInc = 1) (then)
			(appearance $Head $Rel $Loc)
			(notice $Head)
		(else)
			(remove from $Tail matching $Rest into $Similar)
			($ObjSet = [$Head | $Similar])
			(appearance $ObjSet $Rel $Loc)
			(notice $ObjSet)
		(endif)
	}
	(fungibility-enabled appearance $Rest $Rel $Loc)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Common complaints and prevent-checks

(when $ is out of sight)
	~(player can see)
	You can't see well enough to do that in the darkness.

(when $Obj is out of sight)
	~(player can see $Obj)
	You can't see any such thing.

(when $Obj is already held)
	(current player $Player)
	($Obj is #heldby $Player)
	You're already holding (the $Obj).

(when $Obj is already worn)
	(current player $Player)
	($Obj is worn by $Player)
	You're already wearing (the $Obj).

(when $O isn't directly held)
	(current player $Actor)
	~($O is #heldby $Actor)
	You're not holding (the $O).

(when $Obj is not here)
	(not here $Obj)
	(The $Obj) (isn't $Obj) here.

(when (intangible $Obj) is out of reach)
	(The $Obj is) intangible.

(when $Obj is out of reach)
	~(player can reach $Obj)
	(if) (player can see $Obj) (then)
		You can't reach (the $Obj).
	(else)
		(The $Obj) (isn't $Obj) here.
	(endif)

(when $O is part of something)
	($O is #partof $Parent)
	(That's $O) part of (the $Parent).

(when $O is held by someone)
	($O is #heldby $Parent)
	(That $O) belong(s $O) to (the $Parent).

(when $O is worn by someone)
	($O is #wornby $Parent)
	(The $Parent is) wearing (that $O).

(when $Obj is fine where it is)
	(fine where it is $Obj)
	(if) (animate $Obj) (then)
		(uppercase) (it $Obj is)
	(else)
		(That's $Obj)
	(endif)
	(if) (gender-neutral $Obj) (then)
		%% Slightly awkward special case for singular they/them
		fine where (it $Obj is) currently located.
	(else)
		fine where (it $Obj) (is $Obj).
	(endif)

(when ~(item $O) can't be taken)
	You can't take (the $O).

~(when (supporter $O) won't accept #on)

~(when (container $O) won't accept #in)

(when $O won't accept $Rel)
	(if) ($Rel is one of [#under #behind]) (then)
		Putting things (name $Rel) (the $O) would achieve little.
	(else)
		You can't put things (name $Rel) (the $O).
	(endif)

~(when (actor supporter $O) won't accept actor #on)

~(when (actor container $O) won't accept actor #in)

(when $O won't accept actor $Rel)
	(if) ($Rel is one of [#under #behind]) (then)
		Going (name $Rel) (the $O) would achieve little.
	(else)
		It's not possible to get (towards-name $Rel) (the $O).
	(endif)

(when $O is already $Rel $Dest)
	($O is $Rel $Dest)
	(The $O is) already (name $Rel) (the $Dest).

(when $O is $Rel $Parent)
	($O is $Rel $Parent)
	(The $O) will have to get (reverse-name $Rel) (the $Parent) first.

(when $Obj is closed)
	($Obj is closed)
	(The $Obj is) closed.

(when $Obj blocks passage)
	($Obj blocks passage)
	(if) ($Obj is closed) (then)
		(The $Obj is) closed.
	(else)
		(The $Obj) (doesn't $Obj) allow you to pass.
	(endif)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Program entry, main loop, status bar, score

(interface (startup))

(program entry point)
	(exhaust) *(startup) %% Put hooks here for anything that needs to be handled before play begins
	(div @initial-spacer) {}
	(update environment around player)
	(stoppable) (intro)
	*(repeat forever) (read-parse-act) (fail)

(intro)
	(banner)
	(try [look])

%% When the game asks a disambiguating question ("Did you ..."), and the player
%% types an unrecognized response, this needs to be parsed as a regular action
%% instead. If this happens several times in a row, the heap would fill up with
%% half-finished parsing attempts, and eventually overflow. To prevent this, we
%% store the unrecognized response in a global variable and backtrack (actually
%% stop) to recover heap space.

(global variable (deferred commandline $))

(read-parse-act)
	(rebuild scope)
	(if) (deferred commandline $Words) (then)
		(now) ~(deferred commandline $)
		(stoppable) {
			(parse commandline $Words with choices [])
		}
	(elseif) (game has ended) (then)
		(game over)
	(else)
		(par)
		(stoppable) {
			%% If this flag is still set, then a long-distance movement was interrupted by a (stop) before it reached its last step. We should explain this to the player.
			(if) (moving long distances) (then)
				(div @meta) {
					Because something dramatic happened, your movement was cut short.
				}
				(now) ~(moving long distances)
				(now) ~(last step of movement)
			(endif)

			(if)
				(scoring enabled)
				(score notifications are on)
			(then)
				(report score change)
			(endif)

			(if) (current node $DispObj) (then)
				(collect $Choice)
					*($DispObj offers $Choice)
					(available $Choice)
				(into $ChoiceListWithDup)
				(remove duplicates $ChoiceListWithDup $ChoiceList)
				(if) (empty $ChoiceList) (then)
					(now) ~(current node $)
					(now) ($DispObj is choice-exhausted)
					(if) ($DispObj flows to $Fallback) (then)
						(activate node $Fallback)
					(else)
						(activate parser)
					(endif)
				(endif)
				(redraw status bar)
				(get choice of $ChoiceList into $Words)
			(else)
				(redraw status bar)
				($ChoiceList = [])
				(prompt and input $Words)
			(endif)

			(parse commandline $Words with choices $ChoiceList)
		}
	(endif)

(interface (prompt and input $>Words))

(prompt and input $Words)
	*(repeat forever)
	> (get input $Words)

	%% '*' is by convention used by testers to put comments in a
	%% transcript. Ignore it and try again.
	(if) ($Words = [\* | $]) (then)
		(if) ~(transcript active) (then)
			(div @meta) { A transcript is not currently being recorded. Use SCRIPT ON to start one. }
		(endif)
		(fail)
	(endif)

(interface (get choice of $<ChoiceList into $>Words))

(get choice of $ChoiceList into $Words)
	(enumerate choices $ChoiceList 1)
	(prompt and input $Words)

(interface (enumerate choices $<ObjList $<FirstIndex))

(enumerate choices [] $)
(enumerate choices [$Target | $More] $Index)
	$Index .
	(if) (library links enabled) (then)
		(link [$Index]) (print label of $Target)
	(else)
		(print label of $Target)
	(endif)
	(line)
	($Index plus 1 into $Ip1)
	(enumerate choices $More $Ip1)

(report score change)
	(reported score is $Reported)
	(current score $Score)
	(if) ($Score < $Reported) (then)
		($Reported minus $Score into $Diff)
		(div @meta) {
			\( Your score has gone down by (spell out $Diff)
			point (if) ~(1 = $Diff) (then) (no space) s (endif)
			. \)
		}
		(par)
		(now) (reported score is $Score)
	(elseif) ($Score > $Reported) (then)
		($Score minus $Reported into $Diff)
		(div @meta) {
			\( Your score has gone up by (spell out $Diff)
			point (if) ~(1 = $Diff) (then) (no space) s (endif)
			. \)
		}
		(par)
		(now) (reported score is $Score)
	(endif)

(redraw status bar)
	(status bar @status) {
		(score headline)
		(status headline)
	}

(redraw status bar)
	%% This predicate shouldn't fail.

(status headline)
	(location headline)

(location headline)
	(if) (current player $) (then)
		(if) (player can see) (then)
			(current room $Room)
			(span @bold) (room header $Room)
			(location headline tag)
		(else)
			(span @bold) (darkness headline)
		(endif)
	(endif)

(location headline tag)
	(current player $Player)
	($Player is $Rel $Loc)
	(if) ~(room $Loc) (then)
		\( (name $Rel) (the $Loc) \)
	(endif)

(darkness headline)
	In the dark

(narrate darkness)
	You are surrounded by darkness.
	(notice #darkness)

(current score 0)
(reported score is 0)

(score notifications are on)
	(scoring enabled)

(interface (increase score by $<Delta))

(increase score by $Delta)
	(current score $Old)
	($Old plus $Delta into $New)
	(now) (current score $New)

(interface (decrease score by $<Delta))

(decrease score by $Delta)
	(current score $Old)
	($Old minus $Delta into $New)
	(now) (current score $New)

(score headline)
	(if) (scoring enabled) (then)
		(current score $Score)
		(div @score) {
			Score: $Score
			(if) (maximum score $Max) (then)
				of $Max
			(endif)
		}
	(endif)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Banner and default metadata

%% There is no formal requirement to print the banner, but it's appreciated
%% and useful to the community and yourself.

(banner)
	(par)
	(div @title) (story title or default)
	(story noun) by (story author or default).
	(line)
	(additional banner text)
	(line)
	(story release $RelNum)
	Release $RelNum.
	Serial number (serial number).
	(line)
	(compiler version).
	(library version)
	(exhaust) { *(extension version) }
	(par)

%% Override to insert co-credits, dedications, etc. into the banner:

(additional banner text)

%% Library extensions can add their name and version number to the banner:

(extension version)		(fail)

%% The following predicates help to conserve space when a title or author is
%% provided. The compiler is smart enough to eliminate the second rule if the
%% first is known to succeed:

(story title or default)	(story title)
(story title or default)	An Interactive Fiction

(story author or default)	(story author)
(story author or default)	Anonymous

%% Don't warn about querying these; however, this does not disable the warning
%% about them not being defined (for a sufficiently large story):

(story title)		(fail)
(story author)		(fail)

%% We can safely supply defaults for the following:

(story release 1)

(story noun)
	An interactive fiction

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Game over

(game over) %% The (game over $) predicate first backtracks to free memory, then calls this
	(par)
	(game over status bar)
	(if) (scoring enabled) (then)
		(current score $Score)
		Game over. You scored $Score
		(if) ($Score = 1) (then) point (else) points (endif)
		(if) (maximum score $Max) (then)
			out of $Max
		(endif)
		.
		(par)
	(endif)
	*(repeat forever) (game over menu) (fail)

(interface (game over $<Closure))

(game over $Message)
	(div @gameover) {
		(space 5)
		\*\*\* (query $Message) \*\*\*
		(if) (interpreter supports text alignment) (then)
			(space 5)
			%% Why the second (space 5)? So that if someone sets text-align: center for the Å-machine web interpreter, the initial (space 5) won't put it off-center again.
		(endif)
	}
	(now) (game has ended)
	(stop) %% This breaks out of the main game loop to free memory; the fact that (game has ended) then makes the main loop call (game over) to end things properly

(game over status bar)
	(status bar @status) {
		(score headline)
		Game Over
	}

(game over menu)
	(div @meta) {
		Would you like to:
		(if) (interpreter supports undo) (then)
			(line) (space 5)
			(if) (library links enabled) (then)
				(link) UNDO
			(else)
				UNDO
			(endif)
			the last move,
		(endif)
		(line) (space 5)
		(if) (library links enabled) (then)
			(link) RESTORE a saved position,
		(else)
			RESTORE a saved position,
		(endif)
		(line) (space 5)
		(exhaust) {
			*(game over option)
			(line) (space 5)
		}
		(if) (interpreter supports quit) (then)
			(if) (library links enabled) (then)
				(link) QUIT
			(else)
				QUIT
			(endif)
			the program,
			(line) (space 5)
		(endif)
		or
		(if) (library links enabled) (then)
			(link) RESTART
		(else)
			RESTART
		(endif)
		from the beginning?
	}
	(line)
	(prompt and input $Words)
	(stoppable) (parse game over $Words)

(game over option)
	(amusing enabled)
	see a list of
	(if) (library links enabled) (then)
		(link) AMUSING
	(else)
		AMUSING
	(endif)
	things to do,

(interface (parse game over $<Words))

(parse game over [restart])
	(restart)

(parse game over [restore])
	(try [restore])

(parse game over [undo])
	(if) (undo) (or) (then)
		(div @meta) { Failed to undo last turn. }
	(endif)

(parse game over [amusing])
	(amusing enabled)
	(amusing)

(parse game over [quit/q])
	(display quit message)
	(line)
	(quit)

(parse game over $)
	(div @meta) { Please type one of the given words. }

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Parser: Global variables

(global variable (reported score is $))
(global variable (last command was $))
(global variable (implicit action is $))

(global variable (player's it refers to $))
(global variable (narrator's it refers to $))
(global variable (her refers to $))
(global variable (him refers to $))
(global variable (them refers to $))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Parser: Rewrite

(interface (rewrite $<WordsIn into $>WordsOut))

%% Fallback rewrite rule does nothing.

(rewrite $A into $A)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Parser: Directions

%% Directions are treated separately from other objects for performance
%% reasons. They are not in scope.

(interface (understand $<Words as direction $>DirList))

(understand $Words as direction $Output)
	(parse direction list $Words $ObjList)
	(mark multi-object $ObjList into $Output)

%% Deal with serial commas
(parse direction list [and | $Rest] $Out)
	*(parse direction list $Rest $Out)

(parse direction list $Words [$Head | $Tail])
	*(split $Words by [, and] into $Left and $Right)
	(just)
	*(parse direction $Left $Head)
	*(parse direction list $Right $Tail)

(parse direction list $Words [$Dir])
	*(parse direction $Words $Dir)

(parse direction [to | $Words] $Dir)
	(just)
	*(parse direction $Words $Dir)

(parse direction [the | $Words] $Dir)
	(just)
	*(parse direction $Words $Dir)

(parse direction $Input $Dir)
	(nonempty $Input)
	(determine object $Dir)
		*(direction $Dir)
	(from words)
		*(dict $Dir)
	(matching all of $Input)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Parser: Objects

%% Nouns in complex actions are represented as:
%%	an object $Obj,
%%	a decorated object [a $Obj],
%%	a list of objects (possibly decorated) [+ $Obj1 $Obj2 ...], or
%%	an error code [], [,], [all]
%% No output or other side effects are produced by the following rules.
%% Policy/ExcludeList are ignored when there's just one matching object.
%% Ambiguous expressions result in backtracking.

(interface (understand $<Words as non-all object $>ObjList))
(interface (understand $<Words as single object $>Obj))
(interface (understand $<Words as object $>ObjList preferably $<Closure))
(interface (understand $<Words as single object $>Obj preferably $<Closure))
(interface (understand $<Words as object $>ObjList preferably child of $<Parent))
(interface (understand $<Words as object $>ObjList preferably takable))
(interface (understand $<Words as object $>ObjList preferably held))
(interface (understand $<Words as single object $>Obj preferably held))
(interface (understand $<Words as object $>ObjList preferably held excluding $<ExcludeObj))
(interface (understand $<Words as single object $>Obj preferably animate))
(interface (understand $<Words as object $>ObjList preferably worn))
(interface (understand $<Words as single object $>Obj preferably supporter))
(interface (understand $<Words as single object $>Obj preferably container))
(interface (understand $<Words as any object $>Obj))
(interface (understand $<Words as any object $>Obj preferably animate))
(interface (understand $<Words as any object $>Obj preferably $<Closure))

(understand $Words as non-all object $Output)
	*(parse $Words as object $Output {} [] 0)

(understand $Words as single object $Object)
	*(parse $Words as single object $Object {} [])

(understand $Words as object $Output preferably $Closure)
	*(parse $Words as object $Output $Closure [] 1)

(understand $Words as single object $Output preferably $Closure)
	*(parse $Words as single object $Output $Closure [])

(understand $Words as object $Output preferably child of $Parent)
	*(parse $Words as object $Output {($_ has parent $Parent)} [] 1)

(understand $Words as object $Output preferably takable)
	*(parse $Words as object $Output {(takable $_)} [] 1)

(understand $Words as object $Output preferably held)
	(current actor $Actor)
	*(parse $Words as object $Output {($_ is #heldby $Actor)} [] 1)

(understand $Words as single object $Output preferably held)
	(current actor $Actor)
	*(parse $Words as single object $Output {($_ is #heldby $Actor)} [])

(understand $Words as object $Output preferably held excluding $ExcludeObj)
	(current actor $Actor)
	*(parse $Words as object $Output {
		($_ is #heldby $Actor)
		~($_ = $ExcludeObj)
	} [] 1)

(understand $Words as single object $Output preferably animate)
	*(parse $Words as single object $Output {(animate $_)} [1])
	%% [1] produces 'someone' instead of 'something' in error responses.

(understand $Words as object $Output preferably worn)
	(current actor $Actor)
	*(parse $Words as object $Output {($_ is worn by $Actor)} [] 1)

(understand $Words as single object $Output preferably supporter)
	*(parse $Words as single object $Output {(supporter $_)} [])

(understand $Words as single object $Output preferably container)
	*(parse $Words as single object $Output {(container $_)} [])

(understand $Words as any object $Output)
	*(parse $Words as any object $Output {} [])

(understand $Words as any object $Output preferably animate)
	*(parse $Words as any object $Output {(animate $_)} [1])

(understand $Words as any object $Output preferably $Closure)
	*(parse $Words as any object $Output $Closure [])

(interface (takable $<Obj))

(takable (item $Obj))
	($Obj has relation $Rel)
	~($Rel is one of [#partof #heldby #wornby])
	(current player $Player)
	~($Obj has ancestor $Player)
	~($Obj is nested #wornby $)
	~($Obj is nested #heldby $)

%% This predicate used to do something different if $Policy was an object
%% Now it doesn't, because object policies caused obscure bugs for not much gain
%% Instead, it just tests that the policy is bound to a list, because $ is used for the null policy
%% (bound $) isn't enough to satisfy the compiler's checks, and (fully bound $) is too much, closures can have non-fully-bound inputs
(interface (verify object policy $Policy $<Obj))
(verify object policy (nonempty $Policy) $Obj)
	(query $Policy $Obj)

(interface (parse $<Words as object $>ObjList $Policy $<FailObj $<AllAllowed))

(parse $Words as object $Output $Policy $ $AllAllowed)
	*(split $Words by [but except] into $Left and $Right)
	*(parse noun list $Left as $BaseList $Policy $AllAllowed)
	*(parse negative noun $Right from $BaseList into $ObjList)
	(mark multi-object $ObjList into $Output)

(parse $Words as object $Output $Policy $ $AllAllowed)
	*(parse noun list $Words as $ObjList $Policy $AllAllowed)
	(mark multi-object $ObjList into $Output)

(parse $ as object $Someone $ $Someone $)
	(allowing parse errors)

(interface (parse $<Words as single object $>Obj $Policy $<FailObj))

(parse $Words as single object $Output $Policy $Someone)
	*(parse $Words as object $ObjList $Policy $Someone 0)
	(if) ($ObjList = [+ | $]) (then)
		(allowing parse errors)
		($Output = [,])
	(else)
		($Output = $ObjList)
	(endif)

(interface (parse $<Words as any object $>Obj $Policy $<FailObj))

(parse $Words as any object $Output $Policy $)
	(filter $Words into $Filtered)
	(nonempty $Filtered)
	(collect $Obj)
		(determine object $Obj)
			*(object $Obj)
			~(direction $Obj)
			~(relation $Obj)
			~($Obj is in scope) %% Prevent double matches due to next branch.
			~($Obj is hidden)
			($Obj is in room $Room)
			($Room is visited)
			(words $Filtered sufficiently specify $Obj)
		(from words)
			*(dict $Obj)
		(matching all of $Filtered)
	(into $Candidates)
	(apply policy to $Candidates $Policy $ObjList)
	*($Output is one of $ObjList)

(parse $Words as any object $Output $Policy $Someone)
	%% The purpose of this branch is to support pronouns, as well
	%% as not-here objects that are in scope.
	*(parse $Words as single object $Output $Policy $Someone)
	~(room $Output)

(interface (mark multi-object $<ObjList into $>ComplexObj))

(mark multi-object [$Single] into $Single)
	~(word $Single)
(mark multi-object [$Head | $Tail] into [+ $Head | $Tail])
	(object $Head)
(mark multi-object $Other into $Other)

%% Avoid error when using serial comma (TAKE X, Y, AND Z)
(parse noun list [and | $Rest] as $ObjList $Policy $AllAllowed)
	(parse noun list $Rest as $ObjList $Policy $AllAllowed)

(parse noun list $Words as $ObjList $Policy $AllAllowed)
	(split $Words by [, and] into $Left and $Right)
	*(parse basic noun $Left as $LeftObj $Policy $AllAllowed)
	*(parse noun list $Right as $RightObj $Policy $AllAllowed)
	(if) ($RightObj = [$Head | $Tail]) (last $LeftObj $Head) (then)
		%% ensure e.g. "black and white photo" is parsed as one thing
		(append $LeftObj $Tail $ObjList)
	(else)
		(append $LeftObj $RightObj $ObjList)
	(endif)

(parse noun list $Words as $ObjList $Policy $AllAllowed)
	*(parse basic noun $Words as $ObjList $Policy $AllAllowed)

(parse negative noun [$Number | $Words] from $BaseList into $Result)
	{
		($Number is one of [a an])
		($N = 1)
	(or)
		(parse numeral $Number into $N)
	}
	(just)
	(if) (empty $Words) (then)
		(take $N from $BaseList into $NegList)
	(else)
		*(parse indefinite $Words as $NegList $N {($_ is one of $BaseList)})
	(endif)
	(remove from $BaseList matching $NegList into $Result)

(parse negative noun $Words from $BaseList into $Result)
	*(parse object name $Words as $NegList 0 { ($_ is one of $BaseList) })
	(remove from $BaseList matching $NegList into $Result)

(interface (parse basic noun $<Words as $>ObjList $Policy $<AllAllowed))

(parse basic noun [the | $Words] as $ObjList $Policy $AllAllowed)
	(just)
	*(parse basic noun $Words as $ObjList $Policy $AllAllowed)

(parse basic noun [me/myself/self/yourself/you] as [$Obj] $ $)
	(current player $Obj)

(parse basic noun [here/room/location/area/surroundings/wall/walls] as [$Room] $ $)
	(current room $Room)

(parse basic noun [this room/location/area] as [$Room] $ $)
	(current room $Room)

(parse basic noun [it/that] as [$Obj] $ $)
	{
		(player's it refers to $Obj)
	(or)
		(narrator's it refers to $Obj)
	}

(parse basic noun [some] as [$Obj] $Policy $AllAllowed)
	(parse basic noun [it] as [$Obj] $Policy $AllAllowed)
	(uncountable $Obj)

(parse basic noun [her] as [$Obj] $ $)
	(her refers to $Obj)

(parse basic noun [him] as [$Obj] $ $)
	(him refers to $Obj)

(parse basic noun [them] as $ObjList $ $)
	(them refers to $ObjList)

(parse basic noun [all/everything] as [all] $ 0)
	(allowing parse errors)
	(just)

(parse basic noun [all/everything] as $Result (object $Policy) 1)
	(just)
	(collect $Obj)
		*($Obj has parent $Policy)
		($Obj is in scope)
		~($Obj is hidden)
		~(excluded from all $Obj)
	(into $Result)

(parse basic noun [all/everything] as $Result (nonempty $Policy) 1)
	(just)
	(collect $Obj)
		*($Obj is in scope)
		~(excluded from all $Obj)
		~($Obj is hidden)
		(verify object policy $Policy $Obj)
	(into $Result)

(parse basic noun [all/every/each | $Words] as $ObjList $Policy $)
	*(parse object name $Words as $ObjList 1 $Policy)

(parse basic noun [a/an/any/some | $Words] as $ObjList $Policy $)
	*(parse indefinite $Words as $ObjList 1 $Policy)

(parse basic noun [$Number | $Words] as $ObjList $Policy $)
	(nonempty $Words)
	(parse numeral $Number into $N)
	*(parse indefinite $Words as $ObjList $N $Policy)

(parse basic noun $Words as $ObjList $Policy $)
	%% This is the common case.
	*(parse object name $Words as $ObjList 0 $Policy)

(parse indefinite $Words as $Result $Limit $Policy)
	*(parse object name $Words as $ObjList 1 $Policy)
	(if) ($Limit = 1) ($ObjList = [$First $ | $]) (then)
		($Result = [[a $First]]) %% Decorate the result.
	(else)
		(take $Limit from $ObjList into $Result)
		(nonempty $Result)
	(endif)

(interface (parse object name $<Words as $>ObjList $<AllFlag $Policy))

(parse object name $Words as $Result $All $Policy)
	(filter $Words into $Filtered)
	(nonempty $Filtered)
	(collect $Obj)
		%% catch expressions like 'open the eastern window'
		($Filtered = [$Head | $Tail])
		(nonempty $Tail)
		(parse direction [$Head] $Dir)
		(current room $Room)
		(determine object $Obj)
			*(from $Room go $Dir to object $Obj)
			~(direction $Obj)
			~(relation $Obj)
			(words $Tail sufficiently specify $Obj)
		(from words)
			*(dict $Obj)
		(matching all of $Tail)
	(or)
		%% this is the normal case
		(determine object $Obj)
			*($Obj is in scope)
			~(direction $Obj)
			~(relation $Obj)
			(words $Filtered sufficiently specify $Obj)
		(from words)
			*(dict $Obj)
		(or)
			*(plural dict $Obj)
		(matching all of $Filtered)
	(into $Candidates)
	(nonempty $Candidates)
	(apply policy to $Candidates $Policy $CleanList)
	(if)
		%% Optimize for the common case.
		($CleanList = [$])
	(or)
		%% E.g. get all wooden.
		($All = 1)
	(or)
		%% A plural word causes all matching objects to be returned.
		*($PluralWord is one of $Filtered)
		(determine object $PObj)
			*($PObj is one of $CleanList)
		(from words)
			*(plural dict $PObj)
		(matching all of [$PluralWord])
	(then)
		($Result = $CleanList)
	(else)
		%% Backtrack over each matching object, for disambiguation.
		(if) (fungibility enabled) (then)
			(strip-fungible $CleanList $UniqueList)
			*($Obj is one of $UniqueList)
			($Result = [$Obj])
		(else)
			*($Obj is one of $CleanList)
			($Result = [$Obj])
		(endif)
	(endif)

(interface (words $<Words sufficiently specify $<Obj))

(words $ sufficiently specify $)
	~(head noun is required)

(words $Words sufficiently specify $Obj)
	(collect words)
		(heads $Obj)
	(into $Heads)
	(if) (nonempty $Heads) (then)
		*($H is one of $Heads)
		($H is one of $Words)
	(endif)

(interface (filter $<WordsIn into $>WordsOut))

(filter [] into [])
	(just)

(filter [of/the/this/that | $MoreIn] into $MoreOut)
	(just)
	(filter $MoreIn into $MoreOut)

(filter [$Other | $MoreIn] into [$Other | $MoreOut])
	(filter $MoreIn into $MoreOut)

(interface (apply policy to $<ObjsIn $Policy $>ObjsOut))

(apply policy to $Input $Policy $Output)
	(collect $Obj)
		*($Obj is one of $Input)
		(verify object policy $Policy $Obj)
	(into $Output)
	(nonempty $Output)

(apply policy to $Input $ $Input)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Topics

(describe topic @?)
	that

(describe topic $Topic)
	($Topic = [, | $])
	(the full $Topic)

(describe topic (object $Obj))
	(the full $Obj)

(describe topic $)
	something

(proper *(proper topic $))
(topic *(proper topic $))

(proper topic $)
	(fail)

(interface (understand $<Words as topic $>Topic))

(understand $Words as topic $Obj)
	(filter $Words into $Filtered)
	(determine object $Obj)
		*(topic $Obj)
		(words $Filtered sufficiently specify $Obj)
	(from words)
		*(dict $Obj)
	(matching all of $Filtered)

(understand $Words as topic $Obj)
	*(understand $Words as single object $Obj)

(understand $WordList as topic $Topic)
	*($Word is one of $WordList)
	(topic keyword $Word implies $Topic)

(understand $ as topic @?)

(interface (topic keyword $<Word implies $>Topic))

(topic keyword $Keyword implies $Keyword)
	(topic keyword $Keyword)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Choice mode

(global variable (current node $))
(global variable (previous node $))

(interface (choose $<Obj))

(choose $Obj)
	(print label of $Obj)
	(par)
	(activate node $Obj)

(interface (print label of $<Obj))

(print label of $Obj)
	(if) ($Obj is exposed) (then)
		(label $Obj)
	(else)
		(initial label $Obj)
	(endif)

(interface (display $<Obj))

(display $Obj)
	(exhaust) { *(before disp $Obj) }
	(disp $Obj)
	(exhaust) { *(after disp $Obj) }

(interface (activate node $<Obj))

(activate node $Obj)
	(if) (current node $Previous) (then)
		(now) (previous node $Previous)
	(else)
		(now) ~(previous node $)
	(endif)
	(now) (current node $Obj)
	(display $Obj)
	(if) (object $Obj) (then) (now) ($Obj is exposed) (endif)
	(stop)

(activate parser)
	(now) ~(current node $)
	(now) ~(previous node $)
	(stop)

(interface (available $<Obj))

(available (sticky $))

(available $Node)		~($Node is choice-exhausted)

(sticky *(terminating $))

(interface ($<Object flows to $>Target))

($Obj flows to $Previous)
	~(terminating $Obj)
	(previous node $Previous)

(interface (initial label $<Obj))

(initial label $Obj)		(label $Obj)

(interface (allowed action $<Action))

(allowed action $)		~(current node $)
(allowed action (command $))

(report disallowed action $)
	\( That action is currently disabled. \)

(interface (label $<Obj))

(terminating $)			(fail)
(label $)			(fail)
($ offers $)			(fail)

(before disp $)			(fail)
(disp $)
(after disp $)			(fail)

@($Node is unexposed)		~($Node is exposed)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Parser: Toplevel

%% Parse and attempt each action in turn, and abort if one fails.
%% That's because an action may modify the scope, which affects the parsing of
%% subsequent actions.

(global variable (current actor $))

(interface (parse commandline $<Words with choices $<ChoiceList))

(parse commandline [] with choices $)
	(div @meta) { Come again? }

(parse commandline [undo] with choices $)
	(try [undo])

(parse commandline $Words with choices $ChoiceList)
	%% Before proceeding, save the current undo state:
	(if) (save undo 1) (then)
		(roman)
		(narrate undoing $Words)
		(stop)
	(endif)
	(if)
		(nonempty $ChoiceList)
		($Words = [$Index])
		(number $Index)
		(nth $ChoiceList $Index $Target)
	(then)
		(choose $Target)
	(else)
		(now) ~(allowing parse errors)
		(parse action sequence $Words)
	(endif)

(interface (parse action sequence $<Words))

(parse action sequence $Words)
	(if) (split $Words by [. ; then] into $Left and $Right) (then)
		(parse action $Left)
		(rebuild scope)
		(parse action sequence $Right)
	(else)
		(parse action $Words)
	(endif)

(interface (parse action $<Words))

(parse action [])

(parse action $Words)
	%% Usually, the player is the actor.
	(if) (current player $Player) (then)
		(now) (current actor $Player)
	(endif)

	%% Handle AGAIN, OOPS, and rewriting:

	(if)
		($Words = [$W])
		($W is one of [again g])
		(last command was $LastCmd)
	(then)
		(rewrite $LastCmd into $ActualWords)
	(elseif) ($Words = [oops $GoodWord]) (then)
		(if)
			(last command was $LastCmd)
			(correct $LastCmd with $GoodWord into $GoodCmd)
		(then)
			(now) (last command was $GoodCmd)
			(rewrite $GoodCmd into $ActualWords)
		(else)
			(div @meta) { \( Sorry, I don't know what to fix. \) }
			(stop)
		(endif)
	(else)
		(now) (last command was $Words)
		(rewrite $Words into $ActualWords)
	(endif)

	%% Parse the action:

	(now) ~(head noun is required)
	(collect $A)
		*(understand $ActualWords as $A)
	(into $AllCandidatesWithDup)

	%% Since we may have multiple matches, do some sieving:

	(remove duplicates $AllCandidatesWithDup $AllCandidates)
	(if) ($AllCandidates = [$Single]) (then)
		%% Optimize the common case.
		(try-complex $Single)
	(elseif) (empty $AllCandidates) (then)
		%% We were unable to parse the action.

		%% Occasionally people like to separate actions by
		%% commas or 'AND', but this is problematic. We can
		%% only deal with it as a last resort, because in order
		%% to parse the part after the separator, we need to
		%% have the right scope, and therefore we first have to
		%% execute what's to the left of the separator.

		(if)
			*(split $ActualWords by [, and]
				into $Left and $Right)
			*(understand $Left as $)
		(then)
			(parse action $Left)
			(rebuild scope)
			(parse action $Right)
		(else)
			%% Everything has failed. Can we understand a
			%% partial action, in order to print an
			%% informative error message?

			(parse partial action $ActualWords)
		(endif)
	(else)
		(sieve action candidates $AllCandidates $ActualWords 0)
	(endif)

(correct [$BadWord | $More] with $GoodWord into [$GoodWord | $More])
	(unknown word $BadWord)
(correct [$Head | $TailIn] with $GoodWord into [$Head | $TailOut])
	(correct $TailIn with $GoodWord into $TailOut)

(parse partial action $Words)
	%% The multi-query inside the if-condition is unnecessary
	%% (if-conditions are only evaluated once), but the compiler is able to
	%% opmitize predicates better if they're consistently queried in the
	%% same mode.

	(now) (allowing parse errors)
	(if) *(understand $Words as $BadAction) (then)
		(if) ([all] is one of $BadAction) (then)
			(div @meta) {
				\( The word "all" is not allowed in that context. Please be more specific. \)
			}
		(elseif) ([,] is one of $BadAction) (then)
			(div @meta) {
				\( You're not allowed to use multiple objects in that
				context. Please do it step by step. \)
			}
		(else)
			(div @meta) {
				\( I only understood you as far as wanting to
				(describe action $BadAction)
				. \)
			}
		(endif)
	(else)
		(div @meta) { \( I'm sorry, I didn't understand what you wanted to do. \) }
	(endif)
	(stop)

(sieve action candidates $AllCandidates $Words $VeryLevel)
	(if) ($VeryLevel = 3) (then)
		($LikelyCandidates = $AllCandidates)
	(else)
		(collect $A)
			*($A is one of $AllCandidates)
			~(unlikely-complex $A $VeryLevel)
		(into $LikelyCandidates)
	(endif)
	(if) (nonempty $LikelyCandidates) (then)
		%% Consider only the likely candidates.
		(consider action candidates $LikelyCandidates $Words)
	(else)
		%% All candidates were deemed unlikely, but some candidates
		%% could be more unlikely than the others.
		($VeryLevel plus 1 into $NextLevel)
		(sieve action candidates $AllCandidates $Words $NextLevel)
	(endif)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Disambiguation

(consider action candidates $List $Words)
	(if) ($List = [$Single]) (then)
		%% Optimize the common case.
		(try-complex $Single)
	(else)
		%% Eliminate options where the head noun is missing.
		(now) (head noun is required)
		(collect $A)
			*(understand $Words as $A)
			($A is one of $List)
		(into $ShortListWithDup)
		(remove duplicates $ShortListWithDup $ShortList)
		(if) ($ShortList = [$Single]) (then)
			(try-complex $Single)
		(else)
			(if) (empty $ShortList) (then)
				(disambiguate action $List $ComplexAction)
			(else)
				(disambiguate action $ShortList $ComplexAction)
			(endif)
			(try-complex $ComplexAction)
		(endif)
	(endif)

(disambiguate action $List $Result)
	(collect $Action)
		*($Action is one of $List)
		~{
			*($Action recursively contains $Obj)
			($Obj is hidden)
		}
	(into $NonSpoilery)
	(if) (empty $NonSpoilery) (then)
		($AskList = $List)
	(else)
		($AskList = $NonSpoilery)
	(endif)
	(if) ($AskList = [$Single]) (then)
		($Result = $Single)
	(elseif)
		(rephrase as object disambiguation
			$AskList
			$ComplexAction
			$Template
			$ObjList)
	(then)
		(div @meta) {
			Did you want to (describe action $ComplexAction)?
		}
		(par)
		(prompt and input $Words)
		{
			(now) (head noun is required)
			(disambiguate by object name $Words $Template $ObjList $Result)
		(or)
			(now) ~(head noun is required)
			(disambiguate by object name $Words $Template $ObjList $Result)
		(or)
			(now) (deferred commandline $Words)
			(stop)
		}
	(else)
		(div @meta) {
			Did you want to: (line)
			(enumerate actions $AskList 1 $)
			(if) ~{ (library links enabled) (interpreter supports links) } (then)
				\( Type the corresponding number \)
			(endif)
		}
		(par)
		(prompt and input $Words)
		{
			(understand $Words as number $N)
			($N > 0)
			(nth $AskList $N $Result)
		(or)
			(now) (deferred commandline $Words)
			(stop)
		}
	(endif)

(disambiguate by object name [me/myself] $Template $ObjList $Result)
	(current player $Player)
	($Player is one of $ObjList)
	(recover implicit action $Template $Player into $Result)

(disambiguate by object name $Words $Template $ObjList $Result)
	%% Since the player was given an explicit list of '(the full $)'
	%% descriptions, we have to match against those, in addition to the
	%% normal dict rules.

	(collect $A)
		(determine object $Obj)
			*($Obj is one of $ObjList)
			~(direction $Obj)
			~(relation $Obj)
			(words $Words sufficiently specify $Obj)
		(from words)
			(the full $Obj)
		(matching all of $Words)
		(recover implicit action $Template $Obj into $A)
	(into $Candidates)
	(nonempty $Candidates) %% otherwise fail into the next rule
	{
		($Candidates = [$Result])
	(or)
		(disambiguate action $Candidates $Result)
	}

(disambiguate by object name $Words $Template $ObjList $Result)
	(collect $A)
		(determine object $Obj)
			*($Obj is one of $ObjList)
			~(direction $Obj)
			~(relation $Obj)
			(words $Words sufficiently specify $Obj)
		(from words)
			*(dict $Obj)
		(matching all of $Words)
		(recover implicit action $Template $Obj into $A)
	(into $Candidates)
	(nonempty $Candidates)
	{
		($Candidates = [$Result])
	(or)
		(disambiguate action $Candidates $Result)
	}

(rephrase as object disambiguation [$Head | $Tail] $Complex $Template $ObjList)
	(all identical except object $Head $Tail $Pos [] $ObjList)
	(replace nth $Head $Pos [, | $ObjList] $Complex)
	(replace nth $Head $Pos [] $Template)

(replace nth [$ | $Tail] 1 $Element [$Element | $Tail])

(replace nth [$Head | $Tail] $N $Element [$Head | $SubOutput])
	($N minus 1 into $Nm1)
	(replace nth $Tail $Nm1 $Element $SubOutput)

(all identical except object $First [] $ObjPos $ObjIn [$LastObj | $ObjIn])
	(number $ObjPos)
	(nth $First $ObjPos $LastObj)

(all identical except object $First [$Second | $More] $ObjPos $ObjIn $ObjOut)
	(identical except object $First $Second 1 $ObjPos $FirstObj)
	(all identical except object
		$First
		$More
		$ObjPos
		[$FirstObj | $ObjIn]
		$ObjOut)

(identical except object [$H1 | $T1] [$H2 | $T2] $CurrPos $TargetPos $O1)
	(if) (object $H1) (object $H2) ~($H1 = $H2) (then)
		($CurrPos = $TargetPos)
		($O1 = $H2)
		($T1 = $T2)
	(else)
		($H1 = $H2)
		($CurrPos plus 1 into $NextPos)
		(identical except object $T1 $T2 $NextPos $TargetPos $O1)
	(endif)

(enumerate action $N $Action)
	(library links enabled)
	$N . (link [$N]) (describe action $Action)

(enumerate action $N $Action)
	$N . (describe action $Action)

(enumerate actions [$Item1 $Item2] $N $Np1)
	(just)
	(enumerate action $N $Item1) , or (line)
	($N plus 1 into $Np1)
	(enumerate action $Np1 $Item2) ? (line)
(enumerate actions [$Item1 $Item2 | $] 9 10)
	(just)
	(enumerate actions [$Item1 $Item2] 9 10)
	\(List truncated.\) (line)
(enumerate actions [$Head | $Tail] $N $Last)
	(enumerate action $N $Head) , (line)
	($N plus 1 into $Np1)
	(enumerate actions $Tail $Np1 $Last)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Asking for clarification

(interface (asking for object in $<Action))

(asking for object in $Action)
	(now) (implicit action is $Action)
	(now) ~(implicit action wants direction)
	(stop)

(interface (asking for direction in $<Action))

(asking for direction in $Action)
	(now) (implicit action is $Action)
	(now) (implicit action wants direction)
	(stop)

(recover implicit action [] $ into [])

(recover implicit action [[] | $More] $Obj into [$Obj | $More])

(recover implicit action [$Other | $MoreIn] $Obj into [$Other | $MoreOut])
	(recover implicit action $MoreIn $Obj into $MoreOut)

(action [inventory] preserves the question)
(action (command $) preserves the question)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Miscellaneous input routines

%% Asking a yes/no question:

(yesno)
	(if) (library links enabled) (then)
		(link) yes (space) / (space) (link) no
	(endif)
	(space) (prompt and input $Words)
	(if) ($Words = [yes]) (or) ($Words = [y]) (then)
	(elseif) ($Words = [no]) (or) ($Words = [n]) (then)
		(fail)
	(else)
		(div @meta) { Please answer yes or no. }
		(yesno)
	(endif)

%% Asking for a number:

(interface (get number from $<First to $<Last $>Number))

(get number from $First to $Last $N)
	$First - $Last (prompt and input $Input)
	(understand $Input as number $N)
	~($N < $First)
	~($N > $Last)

%% Waiting for a keypress:

(interface (any key))

(any key)
	(get key $)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Finding the shortest path from one room to another, using obvious exits.

(interface (shortest path from $<Room1 to $<Room2 is $>DirList))

(shortest path from $A to $B is $Path)
	($B is visited)
	(find paths starting at $A)
	(build path from $A to $B [] $Path)

(interface (first step from $<Room1 to $<Room2 is $>Dir))

(first step from $A to $B is $Dir)
	($B is visited)
	(find paths starting at $A)
	(reconstruct first hop $Dir from $A to $B)

(find paths starting at $Start)
	(exhaust) {
		*(room $R)
		(now) ~(last hop before $R is $)
	}
	(now) (last hop before $Start is [])
	(exhaust) {
		%% Explore the room graph starting from $A, set the last-hop
		%% variables, and fail when there are no rooms left.
		(elaborate paths from [$Start])
	}

(elaborate paths from $RoomList)
	(nonempty $RoomList)
	(collect $R)
		*($Here is one of $RoomList)
		{
			*(from $Here go $ to $R)
			(room $R)
		(or)
			*(from $Here through $Door to $R)
			~($Door blocks passage)
		}
		($R is visited)
		~(last hop before $R is $)
		(now) (last hop before $R is $Here)
	(into $NextGen)
	(elaborate paths from $NextGen)

%% Rooms have no locations, so '($ has relation $)' is unused for rooms.
%% We can repurpose it for path finding, to save RAM:

@(last hop before $A is $B) ($A has relation $B)

%% Reconstruct the full path from the 'last hop' links:

(build path from $Start to $End $SoFar $Path)
	(last hop before $End is $Last)
	(if) (empty $Last) (then)
		($Path = $SoFar)
	(else)
		(from $Last go $Dir to room $End)
		(build path from $Start to $Last [$Dir | $SoFar] $Path)
	(endif)

%% Reconstruct just the first hop:

(reconstruct first hop $Dir from $Start to $End)
	(last hop before $End is $Last)
	(if) ($Last = $Start) (then)
		(from $Start go $Dir to room $End)
	(else)
		(reconstruct first hop $Dir from $Start to $Last)
	(endif)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Updating and traversing the object tree

@($Obj is $Rel $Parent)
	%% The order of the following queries is critical when $Obj is unbound.
	*($Obj has parent $Parent)
	*($Obj has relation $Rel)

@($Obj is nowhere)
	~($Obj has parent $)

%% Determine what room ultimately surrounds a particular object:

(interface ($<Obj is in room $>Room))

((room $Room) is in room $Room)

($Obj is in room $Room)
	($Obj has parent $Loc)
	($Loc is in room $Room)

%% The following three predicates may be called with either parameter unbound.
%% They will traverse the object tree in the most efficient way for each case.

(interface ($>Obj has ancestor $>Ancestor))

($Obj has ancestor $Ancestor)
	(if) (fully bound $Obj) (then)
		($Obj has parent $Parent)
		{
			($Parent = $Ancestor)
		(or)
			*($Parent has ancestor $Ancestor)
		}
	(else)
		*($Sub has parent $Ancestor)
		{
			($Obj = $Sub)
		(or)
			*($Obj has ancestor $Sub)
		}
	(endif)

(interface ($>Obj is nested $>Rel $>Loc))

($Obj is nested $Rel $Loc)
	(if) (fully bound $Obj) (then)
		($Obj has parent $Parent)
		{
			($Obj has relation $Rel)
			($Parent = $Loc)
		(or)
			*($Parent is nested $Rel $Loc)
		}
	(else)
		*($Sub is $Rel $Loc)
		{
			($Obj = $Sub) (or)
			*($Obj has ancestor $Sub)
		}
	(endif)

(interface ($>Obj is part of $>Ancestor))

($Obj is part of $Ancestor)
	*($Obj is recursively #partof $Ancestor)

(interface ($>Obj is recursively $<Rel $>Ancestor))

($Obj is recursively $Rel $Ancestor)
	(if) (bound $Obj) (then)
		($Obj is $Rel $Parent)
		{
			($Parent = $Ancestor)
		(or)
			*($Parent is recursively $Rel $Ancestor)
		}
	(else)
		*($Obj is recursively $Rel $Ancestor top-down)
	(endif)

(interface ($>Obj is recursively $<Rel $<Ancestor top-down))

($Obj is recursively $Rel $Ancestor top-down)
	*($Sub is $Rel $Ancestor)
	{
		($Obj = $Sub)
	(or)
		*($Obj is recursively $Rel $Sub top-down)
	}

(interface ($>Obj is recursively $<Rel $<Ancestor bottom-up))

($Obj is recursively $Rel $Ancestor bottom-up)
	*($Sub is $Rel $Ancestor)
	{
		*($Obj is recursively $Rel $Sub bottom-up)
	(or)
		($Obj = $Sub)
	}

(interface ($>Obj is worn by $>Actor))

($Obj is worn by $Actor)
	(if) (bound $Obj) (then)
		($Obj is $Rel $Parent)
		(if) ($Rel = #wornby) (then)
			($Parent = $Actor)
		(else)
			($Rel = #under)
			($Parent is worn by $Actor)
		(endif)
	(else)
		*($Obj is worn by $Actor top-down)
	(endif)

(interface ($>Obj is worn by $<Actor top-down))

($Obj is worn by $Actor top-down)
	*($Cover is #wornby $Actor)
	{
		($Obj = $Cover)
	(or)
		*($Obj is recursively #under $Cover top-down)
	}

(interface ($>Obj is worn by $<Actor bottom-up))

($Obj is worn by $Actor bottom-up)
	*($Cover is #wornby $Actor)
	{
		*($Obj is recursively #under $Cover bottom-up)
	(or)
		($Obj = $Cover)
	}

(interface (wearing $<New covers $<Old))

(wearing $New covers $Old)
	($Old recursively goes underneath $New)

(interface (wearing $<New removes $<Old))

(wearing $New removes $Old)
	($New recursively goes underneath $Old)

(interface ($<Obj recursively goes underneath $>Cover))

($Obj recursively goes underneath $Cover)
	($Obj goes underneath $Next)
	{
		($Next = $Cover)
	(or)
		*($Next recursively goes underneath $Cover)
	}

(interface ($<Obj goes underneath $>Cover))

($ goes underneath $)
	(fail)

%% The following predicates are useful when writing before-rules:

(interface (ensure $<Obj is held))

(ensure $Obj is held)
	(current player $Player)
	(if) (wearable $Obj) ($Obj is worn by $Player) (then)
		(first try [remove $Obj])
	(elseif) (item $Obj) ~($Obj is #heldby $Player) (then)
		(first try [take $Obj])
	(endif)

(recursively leave non-vehicles)
	(current player $Actor)
	($Actor has parent $Obj)
	~(room $Obj)
	~(vehicle $Obj)
	(first try [leave $Obj])
	(recursively leave non-vehicles)

(recursively leave descendants of $Obj)
	(current player $Actor)
	($Actor has parent $FirstObj)
	~($FirstObj = $Obj)
	(first try [leave $FirstObj])
	(recursively leave descendants of $Obj)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% List manipulation

(remove from [] matching $ into [])
	(just)
(remove from [$In | $MoreIn] matching $Keys into $MoreOut)
	($In is one of $Keys)
	(just)
	(remove from $MoreIn matching $Keys into $MoreOut)
(remove from [$In | $MoreIn] matching $Keys into [$In | $MoreOut])
	(remove from $MoreIn matching $Keys into $MoreOut)

(interface (remove duplicates $<Input $>Output))

(remove duplicates [] [])
	(just)
(remove duplicates [$Head | $MoreIn] $MoreOut)
	($Head is one of $MoreIn)
	(just)
	(remove duplicates $MoreIn $MoreOut)
(remove duplicates [$Head | $MoreIn] [$Head | $MoreOut])
	(remove duplicates $MoreIn $MoreOut)

(interface (length of $List into $>Number))

(length of [] into 0)
(length of [$ | $More] into $Np1)
	(length of $More into $N)
	($N plus 1 into $Np1)

(interface (nth $List $<Index $Element))

(nth [$Head | $] 1 $Head)
(nth [$ | $Tail] $N $Result)
	($N minus 1 into $Nm1)
	(nth $Tail $Nm1 $Result)

(last [$Last] $Last)
(last [$ | $Tail] $Last)
	(last $Tail $Last)

(take 0 from $ into [])
(take $N from [$Head | $MoreIn] into [$Head | $MoreOut])
	($N minus 1 into $Nm1)
	(take $Nm1 from $MoreIn into $MoreOut)

(interface ($<List1 contains one of $<List2))

($X contains one of $Y)
	(split $X by $Y into $ and $)

(interface ($<List1 contains sublist $<List2))

($ contains sublist [])
($List contains sublist [$Head | $Tail])
	(split $List by [$Head] into $ and $Rest)
	(append $Tail $ $Rest)

($List recursively contains $Element)
	*($Obj is one of $List)
	{
		($Obj = $Element)
	(or)
		(nonempty $Obj)
		($Obj recursively contains $Element)
	}

(reverse $Input $Output)
	(reverse-sub $Input $Output [])

(reverse-sub [] $Output $Output)
(reverse-sub [$Head | $Tail] $Output $SoFar)
	(reverse-sub $Tail $Output [$Head | $SoFar])

(split [$First $Second | $Tail] anywhere into [$First] and [$Second | $Tail])
(split [$First | $More] anywhere into [$First | $Left] and $Right)
	*(split $More anywhere into $Left and $Right)

(interface (print words $<Words))

(print words $List)
	(exhaust) {
		*($Word is one of $List)
		$Word
	}

(interface (Print Words $<Words))

(Print Words $List)
	(exhaust) {
		*($Word is one of $List)
		(uppercase) $Word
	}

(interface (randomly select $>Element from $<List))

(randomly select $Element from $List)
	(length of $List into $N)
	(random from 1 to $N into $Index)
	(nth $List $Index $Element)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Get rid of some compiler warnings

(plural name $)			(fail)
(from $ go $ to $)		(fail)
($ unlocks $)			(fail)
(from $ through $ to $)		(fail)
(topic keyword $)		(fail)
(scoring enabled)		(fail)
(maximum score $)		(fail)
(amusing enabled)		(fail)
(amusing)			(fail)
(library links enabled)		(fail)
(default actions apply to rooms)	(fail)
(heads $)			(fail)
(room $)			(fail)

%% Effectively the same
(default actions enabled)	(default actions apply to rooms)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Fatal runtime errors

(error $Code entry point)
	(roman)
	(div @meta) {
		Technical trouble \( code $Code \):
		(report fatal error $Code)
		(display memory statistics)
		Attempting to recover with UNDO.
	}
	(if) (undo) (or) (then)
		(div @meta) { Undo failed! This problem is unrecoverable. }
	(endif)

(report fatal error 1)	Heap space exhausted.
(report fatal error 2)	Auxiliary heap space exhausted.
(report fatal error 3)	Type error: Expected object.
(report fatal error 4)	Type error: Expected bound value.
(report fatal error 5)	Invalid dynamic operation.
(report fatal error 6)	Long-term heap space exhausted.
(report fatal error 7)	Invalid output state.
(report fatal error $)	Invalid error code!

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% License and copyright notice
%% Copyright 2018-2026 Linus Åkesson and the Dialog Project contributors
%%
%% Redistribution and use in source and binary forms, with or without
%% modification, are permitted provided that the following conditions are met:
%%
%%  1. Redistributions of source code must retain the above copyright
%%      notice, this list of conditions and the following disclaimer.
%%
%%  2. Redistributions in binary form must reproduce the above copyright
%%     notice, this list of conditions and the following disclaimer in the
%%     documentation and/or other materials provided with the distribution.
%%
%%     THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
%%     IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
%%     TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
%%     PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
%%     HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
%%     SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
%%     LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
%%     DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
%%     THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
%%     (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
%%     OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
%%
%% This license is intended to apply to the Dialog compiler and debugger and
%% the source code of the standard libraries. Any time those components are
%% distributed, this copyright notice should be attached. But it is not meant
%% to limit what the compiler's output can be used for, even for projects that
%% include the standard libraries. To make this explicit, the project is ALSO
%% released under a modified two-clause BSD license, which is exactly the same
%% as the above but adds this exception:
%%
%%     As an exception, if, as a result of you compiling your source code,
%%     portions of this software are embedded into compiler output in binary
%%     form, you may redistribute such embedded portions without complying
%%     with condition 2 of the license.
%%
%% In other words, you can distribute the Z-machine and Å-machine bytecode that
%% the compiler produces in any way you like, without needing to include this
%% license file or comply with the attribution requirements (for the library
%% or for the Z-machine runtime routines).