(library version) Library version 0.25. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% 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; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Relations (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 (dict #in) inside into through inwards (dict #on) onto atop upon (dict #partof) (just) (fail) (dict #heldby) (just) (fail) (dict #wornby) (just) (fail) (present-name #in) inside (present-name #on) on top of (present-name $Rel) (name $Rel) (towards-name #in) into (towards-name #on) onto (towards-name $Rel) (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 #north (direction *) (name *) north (dict *) n northern #south (direction *) (name *) south (dict *) s southern #east (direction *) (name *) east (dict *) e eastern #west (direction *) (name *) west (dict *) w western #northeast (direction *) (name *) northeast (dict *) ne north-east #northwest (direction *) (name *) northwest (dict *) nw north-west #southwest (direction *) (name *) southwest (dict *) sw south-west #southeast (direction *) (name *) southeast (dict *) se south-east #up (direction *) (name *) up (dict *) u ceiling sky above #down (direction *) (name *) down (dict *) d below #in %% Note: #in is also a relation (direction *) #out (direction *) (name *) out (dict *) outside outwards (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 transparent) ~($Obj is opaque) @($Obj is in order) ~($Obj is broken) %% Inheritance relations (actor container $Obj) *(room $Obj) (animate $Obj) *(female $Obj) (animate $Obj) *(male $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) (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) ((openable $) is opaque) %% Convenience predicate: (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: (an $) (fail) (door $) (fail) (edible $) (fail) (female $) (fail) (fine where it is $) (fail) (inherently dark $) (fail) (intangible $) (fail) (item $) (fail) (lockable $) (fail) (male $) (fail) (not here $) (fail) (openable $) (fail) (out of reach $) (fail) (pair $) (fail) (potable $) (fail) (proper $) (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) (Name $Room) (look (room $R)) You are here. %% Given a room and a direction, what room (if any) is reachable that way? (from $Here go $Dir to room $Room) *(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) %% Given a room and a direction, what object, door and/or room is visible %% that way? (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) ($Door blocks light) ($Door is opaque) ($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 (global variable (current visibility ceiling $)) (recompute visibility) (current player $Player) (visibility ceiling of $Player is $Ceil) (now) (current visibility ceiling $Ceil) (if) (light reaches ceiling $Ceil) (then) (now) (player can see) (else) (now) ~(player can see) (endif) (recompute visibility) %% E.g. if there is no current player. (light reaches ceiling (room $Ceil)) ~(inherently dark $Ceil) (light reaches ceiling $Ceil) *($Obj provides light) (visibility ceiling of $Obj is $Ceil) (visibility ceiling of (room $R) is $R) (visibility ceiling of $Obj is $Parent) ($Obj is #in $Parent) ($Parent is opaque) ($Parent is closed) (visibility ceiling of $Obj is $Ceil) ($Obj has parent $Parent) (visibility ceiling of $Parent is $Ceil) ($Obj is visible to player) (current visibility ceiling $Ceil) (if) (visibility ceiling of $Obj is $Ceil) (then) { (player can see) (or) (current player $Player) ($Obj has ancestor $Player) } (else) (room $Obj) (room $Ceil) (player can see) { (from $Ceil go $ to $Obj) (or) (from $Ceil through $Door to $Obj) ~($Door blocks light) } (endif) (reachability ceiling of $O is $Ceil) (if) ($O is $Rel $Parent) (then) (if) ($Rel = #in) ($Parent is closed) (then) ($Parent = $Ceil) (else) (reachability ceiling of $Parent is $Ceil) (endif) (else) ($O = $Ceil) (endif) (trace reachability $Obj to $Obj or $) (trace reachability $Obj to $ or $Obj) (trace reachability $Obj to $Ceil1 or $Ceil2) ($Obj is $Rel $Parent) ~{ ($Rel = #in) ($Parent is closed) } (trace reachability $Parent to $Ceil1 or $Ceil2) ($Obj is reachable by $Actor) ~(out of reach $Obj) (reachability ceiling of $Actor is $Ceil) (reachability ceiling of $Obj is $Ceil) ($Obj is reachable by player) ~(out of reach $Obj) (current player $Player) (reachability ceiling of $Player is $Ceil) (trace reachability $Obj to $Player or $Ceil) %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Scope %% This predicate can be extended by the game, typically using rules that check %% certain conditions, e.g. what the current room is: (add $ to scope) (fail) %% These rules should generally be left as they are: (rebuild scope) (recompute visibility) (forget pronouns out of scope) ($Obj is in scope) *(add $Obj to scope) ($Obj is in scope) (if) (player can see) (then) (current visibility ceiling $Ceil) { *($Obj is visible up to $Ceil) (or) (room $Ceil) { *(from $Ceil go $ to $Obj) (room $Obj) (or) *(from $Ceil through $Door to $Obj) ~($Door blocks light) } } (else) { (current visibility ceiling $Obj) (or) (current player $Player) *($Obj is visible up to $Player) } (endif) ($Obj is visible up to $Obj) ($Obj is visible up to $Ceiling) (if) (bound $Obj) (then) ($Obj has parent $Parent) ~{ ($Obj has relation #in) ($Parent is closed) ($Parent is opaque) } ($Parent is visible up to $Ceiling) (else) (if) ($Ceiling is closed) ($Ceiling is opaque) (then) *($Sub has parent $Ceiling) ~($Sub has relation #in) (else) *($Sub has parent $Ceiling) (endif) *($Obj is visible up to $Sub) (endif) (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 (select player $Player) (clear all pronouns) (now) (current player $Player) (update environment around player) (move player to $Rel $Loc) (current player $Player) (now) ($Player is $Rel $Loc) (update environment around player) (enter $Room) (move player to #in $Room) (narrate entering $Room) (enter $Room by $Vehicle) (now) ($Vehicle is #in $Room) (now) ($Vehicle is handled) (update environment around player) (narrate entering $Room) (update environment around player) (recompute visibility) (if) (current player $Player) ($Player is in room $Room) (then) (now) (current room $Room) (if) ($Room is unvisited) (player can see) (then) (now) ($Room is visited) (endif) (exhaust) { *($Room attracts $Object) (now) ($Object is #in $Room) } (endif) (narrate entering (room $)) (par) (try [look]) (narrate entering $Obj) You get into (the $Obj). (prevent entering $Obj) (when $Obj won't accept actor #in) (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 (understand [examine/look | $Words] as [look $Dir]) *(understand $Words as direction $Dir) (unlikely [look $]) (prevent [look $]) ~(player can see) You can't see in the darkness. (perform [look $Dir]) (if) (current visibility 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 (understand [look | $Words] as [look $Rel $Obj]) *(split $Words by relation $Rel into [] and $MoreWords) *(understand $MoreWords as single object $Obj) (unlikely [look #in $Obj]) ~(container $Obj) (unlikely [look #on $Obj]) ~(supporter $Obj) %% Reachability not required, but visibility: (refuse [look $ $Obj]) (just) { (when $Obj is not here) (or) (when $Obj is out of sight) } (before [look #in $Obj]) ($Obj is opaque) ($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 $Obj]) ($Obj is opaque) ($Obj is closed) ~(current visibility 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. (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) %% EXAMINE (rewrite [look/l at | $Words] into [examine | $Words]) (understand [examine/watch/describe/check/look | $Words] as [examine $Obj]) *(understand $Words as non-all object $Obj) (understand [who am i] as [examine $Player]) (current player $Player) ~(refuse [examine $]) %% No need for reachability. (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 (current visibility ceiling $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) } (endif) (endif) (if) (container $Obj) ~{ ($Obj is opaque) ($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) } (endif) (endif) (par) %% LOOK (understand [look]) (understand [look around] as [look]) (understand [where am i] as [look]) (describe action [look]) look around (perform [look]) (current player $Player) (current visibility ceiling $Ceil) (location headline) (line) (if) (player can see) (then) (look $Ceil) ($Player is $Rel $Loc) (make appearances $Rel $Loc) (par) (else) (narrate darkness) (endif) %% SEARCH (understand [search | $Words] as [search $Obj]) *(understand $Words as non-all object $Obj) (instead of [search (current room $R)]) (try [look]) (perform [search $O]) (if) ($O is closed) ($O is opaque) (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) (collect $C) *($C is #under $O) (reveal $C) (into $UnderList) (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 (understand [feel/touch/finger/rub/prod | $Words] as [feel $Obj]) *(understand $Words as non-all object $Obj) (perform [feel $Obj]) (feel $Obj) %% LISTEN TO %% LISTEN (rewrite [listen to | $Words] into [listen | $Words]) (understand [listen/hear | $Words] as [listen to $Obj]) *(understand $Words as single object $Obj) %% Don't require reachability: (refuse [listen to $Obj]) (just) (when $Obj is not here) (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) (understand [listen/hear] as [listen]) (instead of [listen]) (current room $Room) (try [listen to $Room]) %% KISS (understand [kiss/hug/embrace/love | $Words] as [kiss $Obj]) *(understand $Words as single object $Obj preferably animate) (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 $Obj]) (The $Obj is) unmoved by your display of affection. %% JUMP (understand [jump/skip/hop/bounce/exercise] as [jump]) (perform [jump]) You enjoy a bit of jumping on the spot. %% DANCE (understand [dance/jive/shake/twirl/spin] as [dance]) (perform [dance]) You practise your moves. %% WAVE %% WAVE (understand [wave | $Words] as [wave $Obj]) *(understand $Words as object $Obj preferably held) (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. (understand [wave]) (perform [wave]) You wave your hands in the air. %% SING (understand [sing/hum] as [sing]) (perform [sing]) You hum a few notes. %% THROW AT %% THROW %% THROW (rewrite [throw away | $Words] into [throw | $Words]) (understand [throw/toss | $Words] as [throw $A at $B]) *(split $Words by [at on to in into onto] into $Left and $Right) *(understand $Left as object $A preferably held) *(understand $Right as single object $B) (understand [throw/toss | $Words] as [throw $Obj]) *(understand $Words as object $Obj preferably held) (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: (refuse [throw $Obj at $Target]) (just) { (when $Obj is not here) (or) (when $Target is not here) (or) (when $Obj is out of reach) } (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 (understand [think]) (perform [think]) That would be a good first step. (line) \( Try HINT if you are desperate. \) (line) %% SLEEP (understand [sleep]) (understand [nap] as [sleep]) (understand [take nap] as [sleep]) (understand [take a nap] as [sleep]) (understand [fall asleep] as [sleep]) (understand [dream] as [sleep]) (perform [sleep]) You're not all that sleepy. %% TAKE %% TAKE FROM (rewrite [pick up | $Words] into [take | $Words]) (understand [take/grab/snatch/steal/acquire/hold/gather/get/remove | $Words] as [take $Obj from $Parent]) *(split $Words by [from] into $Left and $Right) *(understand $Right as single object $Parent) *(understand $Left as object $Obj preferably child of $Parent) (understand [take/grab/snatch/steal/acquire/hold/gather/get | $Words] as [take $Obj]) *(understand $Words as object $Obj preferably takable) (unlikely [take $Obj]) { (current player $Actor) ($Obj is $Rel $Actor) ($Rel is one of [#heldby #wornby]) } (or) ~(item $Obj) (or) ($Obj has relation #partof) (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 $Parent]) (current player $Player) ($Obj is recursively worn by $Player) { ($Parent = $Player) (or) ($Parent has ancestor $Player) } (try [remove $Obj]) (perform [take $Obj from $]) (try [take $Obj]) (prevent [take $Obj]) (when $Obj is already held) (or) (when $Obj is fine where it is) (or) (when $Obj is part of something) (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 (understand [take | $Words] as [remove $Obj]) *(split $Words by [off] into $Left and $Right) { ($Left = []) *(understand $Right as object $Obj preferably worn) (or) ($Right = []) *(understand $Left as object $Obj preferably worn) } (understand [remove/doff/shed/loosen/disrobe/undress | $Words] as [remove $Obj]) *(understand $Words as object $Obj preferably worn) (unlikely [remove $Obj]) (current player $Actor) ~($Obj is #wornby $Actor) (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]) (current player $Actor) ~($Obj is recursively worn by $Actor) But you aren't wearing (the $Obj). (narrate removing $Obj) You take off (the $Obj). (perform [remove $Obj]) (narrate removing $Obj) (current player $Actor) (now) ($Obj is #heldby $Actor) (now) ($Obj is handled) %% WEAR (rewrite [put on | $Words] into [wear | $Words]) (understand [wear/don | $Words] as [wear $Obj]) *(understand $Words as object $Obj preferably held) (understand [put | $Words] as [wear $Obj]) *(split $Words by [on] into $Left and []) *(understand $Left as object $Obj preferably held) (unlikely [wear $Obj]) ~(wearable $Obj) (unlikely [wear $Obj]) (current player $Actor) ($Obj is #wornby $Actor) (before [wear $Obj]) (wearable $Obj) (current player $Actor) ~($Obj is nested #wornby $Actor) (ensure $Obj is held) (prevent [wear $Obj]) (current player $Actor) ($Obj is recursively worn by $Actor) You are already wearing (the $Obj). (prevent [wear $Obj]) ~(wearable $Obj) (The $Obj) can't be 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 $Actor) (now) ($Obj is #wornby $Actor) (now) ($Obj is handled) %% PUT (rewrite [set/lay/drop down | $Words] into [put | $Words]) (rewrite [put away/down | $Words] into [put | $Words]) (rewrite [let go of | $Words] into [drop | $Words]) (understand [put/lay/drop | $Words] as [put $Obj $Rel $Dest]) *(split $Words by relation $Rel into $Left and $Right) *(understand $Right as single object $Dest) *(understand $Left as object $Obj preferably held excluding $Dest) (understand [hide/stash/stuff | $Words] as [put $Obj $Rel $Dest]) *(split $Words by relation $Rel into $Left and $Right) ~($Rel = #on) *(understand $Right as single object $Dest) *(understand $Left as object $Obj preferably held excluding $Dest) (understand [insert | $Words] as [put $Obj #in $Dest]) *(split $Words by [in inside into through] into $Left and $Right) *(understand $Right as single object $Dest) *(understand $Left as object $Obj preferably held excluding $Dest) (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) (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 (understand [put/lay/drop | $Words] as [drop $Obj]) *(split $Words by [down] into $Left and []) *(understand $Left as object $Obj preferably held) (understand [put/lay/drop | $Words] as [drop $Obj]) *(understand $Words as object $Obj preferably held) (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 (understand [inventory/i/inv] as [inventory]) (understand [take/get inventory] as [inventory]) (describe action [inventory]) take inventory (perform [inventory]) (current player $Actor) (collect $C) *($C is #heldby $Actor) (into $HeldList) (collect $C) *($C is #wornby $Actor) (into $WornList) You have (if) (empty $HeldList) (then) no possessions (else) (a $HeldList) (endif) . You're (if) (empty $WornList) (then) not wearing anything (else) wearing (a $WornList) (endif) . (line) %% EXITS (understand [exits]) (understand [list exits] as [exits]) (understand [list the exits] as [exits]) (understand [map] as [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) (then) (Name $Dir) through (a $Target) (if) ($Target is closed) (then) \(currently closed\) (elseif) (from $Room through $Target to $R) ($R is visited) (then) to (if) (inherently dark $R) (then) darkness (else) (the $R) (endif) (endif) . (line) (elseif) (room $Target) (then) (Name $Dir) (if) ($Target is visited) (then) to (if) (inherently dark $Target) (then) darkness (else) (the $Target) (endif) (endif) . (line) (endif) } (endif) %% EXIST (misspelled EXITS, just for the giggles) (understand [exist]) (perform [exist]) So you do. %% WAIT (understand [wait/z] as [wait]) (perform [wait]) A moment slips away. %% GIVE TO %% GIVE (understand [give/offer | $Words] as [give $Obj to $Dest]) *(split $Words by [to] into $Left and $Right) *(understand $Right as single object $Dest preferably animate) *(understand $Left as object $Obj preferably held excluding $Dest) (understand [give/offer | $Words] as [give $Obj to $Dest]) *(split $Words anywhere into $Left and $Right) *(understand $Left as single object $Dest preferably animate) *(understand $Right as object $Obj preferably held excluding $Dest) (understand [give/offer | $Words] as [give $Obj]) *(understand $Words as object $Obj preferably held) (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 TO %% SHOW (understand [show | $Words] as [show $Obj to $Dest]) *(split $Words by [to] into $Left and $Right) *(understand $Right as single object $Dest preferably animate) *(understand $Left as object $Obj preferably held excluding $Dest) (understand [show | $Words] as [show $Obj to $Dest]) *(split $Words anywhere into $Left and $Right) *(understand $Left as single object $Dest preferably animate) *(understand $Right as object $Obj preferably held excluding $Dest) (understand [show | $Words] as [show $Obj]) *(understand $Words as object $Obj preferably held) (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 $]) (refuse [show $Obj to $Person]) (just) { (when $Obj is not here) (or) (when $Person is not here) (or) (when $Obj is out of reach) } (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 (understand [open/unwrap/uncover | $Words] as [open $Obj]) *(understand $Words as non-all object $Obj) (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) (collect $Child) *($Child is #in $Obj) (reveal $Child) (into $List) (if) (nonempty $List) (then) , revealing (a $List) (notice $List) (endif) . (perform [open $Obj]) (narrate opening $Obj) (now) ($Obj is open) %% CLOSE (understand [close/shut/cover | $Words] as [close $Obj]) *(understand $Words as non-all object $Obj) (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 WITH %% UNLOCK (understand [unlock | $Words] as [unlock $Obj with $Key]) *(split $Words by [with] into $Left and $Right) *(understand $Left as non-all object $Obj) *(understand $Right as single object $Key preferably held) (understand [unlock | $Words] as [unlock $Obj]) *(understand $Words as non-all object $Obj) (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 WITH %% LOCK (understand [lock | $Words] as [lock $Obj with $Key]) *(split $Words by [with] into $Left and $Right) *(understand $Left as non-all object $Obj) *(understand $Right as single object $Key preferably held) (understand [lock | $Words] as [lock $Obj]) *(understand $Words as non-all object $Obj) (unlikely [lock $Obj | $]) ~(lockable $Obj) (or) ($Obj is locked) (before [lock $ with $Key]) (ensure $Key is held) (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 (understand [turn/switch | $Words] as [switch on $Obj]) *(split $Words by [on] into $Left and $Right) { ($Left = []) *(understand $Right as non-all object $Obj) (or) ($Right = []) *(understand $Left as non-all object $Obj) } (understand [switch | $Words] as [switch on $Obj]) *(understand $Words as single object $Obj) (switchable $Obj) ($Obj is off) (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 (understand [turn/switch | $Words] as [switch off $Obj]) *(split $Words by [off] into $Left and $Right) { ($Left = []) *(understand $Right as non-all object $Obj) (or) ($Right = []) *(understand $Left as non-all object $Obj) } (understand [switch | $Words] as [switch off $Obj]) *(understand $Words as single object $Obj) (switchable $Obj) ($Obj is on) (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) %% SQUEEZE (understand [squeeze/squash | $Words] as [squeeze $Obj]) *(understand $Words as non-all object $Obj) (perform [squeeze $Obj]) You give (the $Obj) a bit of a squeeze. %% FIX (understand [fix/repair/mend | $Words] as [fix $Obj]) *(understand $Words as non-all object $Obj) (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 (understand [taste/lick/relish/savour | $Words] as [taste $Obj]) *(understand $Words as non-all object $Obj) (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 (understand [fly]) (perform [fly]) You lack the ability. %% BITE (rewrite [gnaw at | $Words] into [bite | $Words]) (understand [bite/chew/gnaw | $Words] as [bite $Obj]) *(understand $Words as single object $Obj) (perform [bite (animate $Obj)]) (try [attack $Obj]) (perform [bite $Obj]) (try [eat $Obj]) %% EAT (understand [eat/devour/ingest/munch/swallow | $Words] as [eat $Obj]) *(understand $Words as non-all object $Obj) (unlikely [eat $Obj]) ~(edible $Obj) ~(potable $Obj) (before [eat $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 (understand [drink/sip/quaff | $Words] as [drink $Obj]) *(understand $Words as non-all object $Obj) (unlikely [drink $Obj]) ~(potable $Obj) (before [drink $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 WITH %% CUT (rewrite [cut off | $Words] into [cut | $Words]) (rewrite [chop off | $Words] into [cut | $Words]) (understand [cut/sever/slice/prune/chop | $Words] as [cut $A with $B]) *(split $Words by [with] into $Left and $Right) *(understand $Left as non-all object $A) *(understand $Right as single object $B) (understand [cut/sever/slice/prune/chop | $Words] as [cut $Obj]) *(understand $Words as non-all object $Obj) (understand [cut/chop/slice | $Words] as [cut $Obj]) *(split $Words by [off] into $Left and []) *(understand $Left as non-all object $Obj) (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) ($Obj is part of $Player) (current player $Player) (then) off (endif) (the $Obj), but reject the idea. %% USE (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 ABOUT (understand [consult | $Words] as [consult $Obj about $Topic]) *(split $Words by [about] into $Left and $Right) *(understand $Left as single object $Obj) *(understand $Right as topic $Topic) (understand [look up | $Words] as [consult $Obj about $Topic]) *(split $Words by [in] into $Left and $Right) *(understand $Right as single object $Obj) *(understand $Left as topic $Topic) (describe action [consult $Obj about $Topic]) consult (the full $Obj) about (describe topic $Topic) (refuse [consult $Obj about $]) (just) { (when $Obj is not here) (or) (when $Obj is out of reach) } (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 ABOUT (redirected to TALK TO by default) (understand [ask | $Words] as [ask $Person about $Topic]) *(split $Words by [about] into $Left and $Right) *(understand $Left as single object $Person preferably animate) *(understand $Right as topic $Topic) (understand [tell | $Words] as [tell $Person about $Topic]) *(split $Words by [about] into $Left and $Right) *(understand $Left as single object $Person preferably animate) *(understand $Right as topic $Topic) (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) (understand [ask | $Words] as [ask $Obj]) *(understand $Words as single object $Obj preferably animate) (understand [tell | $Words] as [tell $Obj]) *(understand $Words as single object $Obj preferably animate) (describe action [ask $Person]) ask (the full $Person) something (describe action [tell $Person]) tell (the full $Person) something %% Don't require reachability: (refuse [ask $Obj | $]) (just) (when $Obj is not here) (refuse [tell $Obj about $]) (just) (when $Obj is not here) (refuse [tell $Obj]) (just) (when $Obj is not here) (perform [ask $Person about $]) (try [talk to $Person]) (perform [tell $Person about $]) (try [talk to $Person]) (perform [ask $Obj]) (try [talk to $Obj]) (perform [tell $Obj]) (try [talk to $Obj]) %% TALK TO %% TALK (rewrite [talk to | $Words] into [talk | $Words]) (rewrite [speak to | $Words] into [talk | $Words]) (understand [talk/speak | $Words] as [talk to $Obj]) *(understand $Words as single object $Obj preferably animate) (understand [talk]) (unlikely [talk to $Obj]) ~(animate $Obj) (perform [talk]) To whom? (asking for object in [talk to []]) %% Don't require reachability: (refuse [talk to $Obj]) (just) (when $Obj is not here) (perform [talk to (current player $)]) You mumble a few well-chosen words to yourself. (perform [talk to $]) There is no reply. %% CURSE (understand [curse/swear] as [curse]) (perform [curse]) You mumble a few well-chosen words to yourself. %% SHOUT TO (redirected to TALK TO by default) %% SHOUT (redirected to TALK by default) (understand [shout/yell/scream to | $Words] as [shout to $Obj]) *(understand $Words as single object $Obj preferably animate) (unlikely [shout to $Obj]) ~(animate $Obj) (refuse [shout to $Obj]) (just) (when $Obj is not here) (perform [shout to $Obj]) (try [talk to $Obj]) (understand [shout/yell/scream] as [shout]) (perform [shout]) To whom? (asking for object in [shout to []]) %% PRAY (understand [pray]) (perform [pray]) There is no answer. %% SHRUG (understand [shrug]) (perform [shrug]) You shrug indifferently. %% CALL (redirected to SHOUT TO by default) %% CALL (redirected to SHOUT by default) %% Stories containing a phone would override these. (rewrite [call to | $Words] into [call | $Words]) (understand [call | $Words] as [call $Obj]) *(understand $Words as single object $Obj preferably animate) (unlikely [call $Obj]) ~(animate $Obj) (refuse [call $Obj]) (just) (when $Obj is not here) (perform [call $Obj]) (try [shout to $Obj]) (understand [call]) (perform [call]) (try [shout]) %% GREET (redirected to TALK TO by default) %% GREET (understand [greet/hello/hi | $Words] as [greet $Obj]) *(understand $Words as single object $Obj preferably animate) (unlikely [greet $Obj]) ~(animate $Obj) (refuse [greet $Obj]) (just) (when $Obj is not here) (perform [greet $Obj]) (try [talk to $Obj]) (understand [greet/hello/hi] as [greet]) (perform [greet]) You say hello to nobody in particular. %% TELL TO | (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 | $Action]) tell (the full $Actor) to (describe action $Action) (refuse [tell $NPC to | $]) (just) (when $NPC is not here) (instead of [tell $NPC to greet]) (try [greet $NPC]) (perform [tell $Actor to | $]) (if) (animate $Actor) (then) (The $Actor) refuse(s $Actor). (else) (The $Actor) (doesn't $Actor) take orders. (endif) %% SMELL (understand [smell/sniff/inhale | $Words] as [smell $Obj]) *(understand $Words as non-all object $Obj) (refuse [smell $Obj]) (just) (when $Obj is not here) (perform [smell $Obj]) (The $Obj) smell(s $Obj) as expected. (understand [smell/sniff/inhale] as [smell]) (perform [smell]) You sniff at the air, perceiving nothing out of the ordinary. %% WAKE UP (understand [wake up]) (understand [wake/awake/awaken] as [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 (rewrite [go/get/step/climb up on/onto | $Words] into [climb | $Words]) (rewrite [go/get/step/climb on/onto | $Words] into [climb | $Words]) (rewrite [sit on top of | $Words] into [climb | $Words]) (rewrite [sit/stand/lie on | $Words] into [climb | $Words]) (rewrite [sit/lie down on | $Words] into [climb | $Words]) (rewrite [jump to/onto | $Words] into [climb | $Words]) (understand [climb/mount/scale | $Words] as [climb $Obj]) *(understand $Words as single object $Obj preferably supporter) (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) (current player $Actor) (now) ($Actor is #on $Obj) %% ENTER (rewrite [go/get/enter/climb/jump in/into/inside | $Words] into [enter | $Words]) (rewrite [sit/lie in/inside | $Words] into [enter | $Words]) (understand [enter/cross | $Words] as [enter $Obj]) *(understand $Words as single object $Obj preferably container) (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) (describe action [enter $Obj]) get into (the full $Obj) ~(refuse [enter (room $)]) (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 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) (current player $Actor) (now) ($Actor is #in $Obj) %% SIT (understand [sit]) (unlikely [sit]) (perform [sit]) On what? (asking for object in [climb []]) %% STAND (rewrite [stand up] into [stand]) (understand [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 %% LEAVE (understand [leave/exit | $Words] as [leave $Obj]) *(understand $Words as single object $Obj) (understand [get/jump/go out/off of | $Words] as [leave $Obj]) *(understand $Words as single object $Obj preferably container) (understand [get/jump/go off | $Words] as [leave $Obj]) *(understand $Words as single object $Obj preferably supporter) (understand [leave/exit] as [leave]) (understand [get/jump out] as [leave]) (understand [get off] as [leave]) (understand [jump off] as [leave]) (current player $Player) ($Player has relation #on) (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 nested #wornby $Actor) } (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) (instead of [leave $Obj]) (current player $Actor) ($Obj is nested #wornby $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) (current player $Player) ($Obj is $NewRel $NewObj) (now) ($Player is $NewRel $NewObj) %% GO TO %% It is only possible to go to visited rooms and non-hidden objects in this %% way. (understand [go/approach | $Words] as [go to $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 (current room $)]) ~(refuse [go to $]) (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 $Path) (then) (exhaust) { *($Dir is one of $Path) (line) \( attempting to go (name $Dir) \) (line) (try [go $Dir]) (tick) (par) } (inhibit next tick) (else) You don't know how to get to (the $Room) from here. (tick) (stop) (endif) %% FIND %% 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. (rewrite [look for | $Words] into [find | $Words]) (understand [find | $Words] as [find $Obj]) { (filter $Words into $Filtered) (nonempty $Filtered) (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) (from words) *(dict $Obj) (matching all of $Filtered) (or) %% The purpose of this branch is to support pronouns, as well %% as not-here objects that are in scope. *(understand $Words as single object $Obj) ~(room $Obj) } (unlikely [find $Obj]) ($Obj is nowhere) ~(refuse [find $]) (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) %% 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 %% The rule for just typing a list of directions (without a verb) is further %% down in the file. (rewrite [go/walk/crawl to | $Words] into [go | $Words]) (rewrite [go/walk/crawl further | $Words] into [go | $Words]) (understand [go/walk/crawl/leave/get/climb | $Words] as [go $Dir]) *(understand $Words as direction $Dir) (understand [go/walk/crawl] as [go #out]) (understand [enter] as [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]) (just) (if) (direction $DirList) (then) ($Dir = $DirList) (else) %% Only consider the first direction in the list. ([+ $Dir | $] = $DirList) (endif) (current room $Room) ~{ (from $Room go $Dir to $Target) { (room $Target) (or) (door $Target) (or) (direction $Target) } } (before [go $Dir]) (current player $Actor) ~{ ($Dir = #down) ($Actor has relation #on) } ~{ ($Dir = #out) ($Actor has relation #in) } ~{ ($Dir = #up) ($Actor has parent $Parent) (seat $Parent) } (recursively leave non-vehicles) (before [go $Dir]) (current player $Actor) ~{ ($Dir = #down) ($Actor has relation #on) } ~{ ($Dir = #out) ($Actor has relation #in) } (current room $Room) (from $Room go $Dir to $Target) (door $Target) ($Target is closed) (first try [open $Target]) (instead of [go #up]) (current player $Player) ($Player has parent $Obj) (seat $Obj) (try [leave $Obj]) (instead of [go #down]) (current player $Actor) ($Actor is #on $Obj) (try [leave $Obj]) (instead of [go #out]) (current player $Actor) ($Actor is #in $Obj) ~(room $Obj) (try [leave $Obj]) (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 (understand [push/move/shove/shift/press/roll | $Words] as [push $Obj $Dir]) *(split $Words anywhere into $Left and $Right) *(understand $Right as direction $Dir) *(understand $Left as single object $Obj) (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 (understand [push/move/shove/shift/press | $Words] as [push $Obj]) *(understand $Words as non-all object $Obj) (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 $Obj) budge. %% PULL (rewrite [pull/yank/drag/tug/tow on | $Words] into [pull | $Words]) (understand [pull/yank/drag/tug/tow | $Words] as [pull $Obj]) *(understand $Words as non-all object $Obj) (perform [pull $Obj]) You yank at (the $Obj), but (if) (item $Obj) (then) nothing noteworthy happens. (else) (it $Obj) won't budge. (endif) %% TURN (understand [turn/rotate/twist/screw/unscrew | $Words] as [turn $Obj]) *(understand $Words as non-all object $Obj) (prevent [turn (room $Obj)]) You can't turn (the $Obj). (perform [turn $Obj]) Turning (the $Obj) has no apparent effect. %% READ (understand [read | $Words] as [read $Obj]) *(understand $Words as non-all object $Obj) (prevent [read $]) ~(player can see) It is too dark to read. (perform [read $Obj]) There's nothing written on (the $Obj). %% FLUSH %% FLUSH (understand [flush | $Words] as [flush $Obj]) *(understand $Words as non-all object $Obj) (perform [flush $Obj]) You don't know how to flush (the $Obj). (tick) (stop) (understand [flush]) (perform [flush]) Flush what? (asking for object in [flush []]) %% SWIM IN %% SWIM (understand [swim/bathe in | $Words] as [swim in $Obj]) *(understand $Words as single object $Obj) (perform [swim in $Obj]) You can't swim in (the $Obj). (tick) (stop) (understand [swim/bathe] as [swim]) (perform [swim]) In what? (asking for object in [swim in []]) %% CLEAN (understand [clean/brush/shine/polish/sweep/dust/wipe/scrub | $Words] as [clean $Obj]) *(understand $Words as non-all object $Obj) (perform [clean $Obj]) You make a half-hearted attempt at cleaning (the $Obj). %% TIE TO %% TIE (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 FROM %% UNTIE (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 tied to anything. (tick) (stop) (perform [untie $Obj from $OtherObj]) (The $Obj) isn't tied to (the $OtherObj). (tick) (stop) %% ATTACK WITH %% ATTACK (understand [attack/break/smash/hit/slap/kick/fight/torture/wreck/crack/destroy/murder/kill/punch/thump | $Words] as [attack $A with $B]) *(split $Words by [with] into $Left and $Right) *(understand $Left as non-all object $A) *(understand $Right as object $B preferably held) (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]) (understand [attack/break/smash/hit/slap/kick/fight/torture/wreck/crack/destroy/murder/kill/punch/thump | $Words] as [attack $Obj]) *(understand $Words as single object $Obj) (perform [attack $Obj]) You consider attacking (the $Obj), but reject the idea. %% LEAVE %% LEAVE BY %% LEAVE WITH (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) (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]) (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 @(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]) (perform [quit]) Really quit? \(y (no space) / (no space) n\) (if) (yesno) (then) (display quit message) (line) (quit) (endif) (stop) (display quit message) (par) Thanks for playing! %% RESTART (understand command [restart]) (perform [restart]) Restart the game from the beginning? \(y (no space) / (no space) n\) (if) (yesno) (then) (restart) Failed to restart. (endif) (stop) %% SAVE (understand command [save]) (perform [save]) (if) (save $ComingBack) (then) (if) ($ComingBack = 1) (then) (roman) Game state restored successfully. (line) (location headline) (else) Game state saved successfully. (endif) (else) Failed to save the game state. (endif) (stop) %% RESTORE (understand command [restore]) (perform [restore]) (restore) Failed to restore the game state. (stop) %% TRANSCRIPT (command [transcript on]) (understand [transcript/script on] as [transcript on]) (understand [transcript/script] as [transcript on]) (perform [transcript on]) (if) (transcript on) (then) Transcript enabled. (else) Failed to enable transcript. (stop) (endif) (command [transcript off]) (understand [transcript/script off] as [transcript off]) (perform [transcript off]) (transcript off) Transcript disabled. %% SCORE (understand command [score]) (scoring enabled) (perform [score]) (scoring enabled) (current score $Score) 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) Enabling score notifications. (understand command [notify off]) (scoring enabled) (perform [notify off]) (scoring enabled) (now) ~(score notifications are on) Score notifications have been turned off. %% PRONOUNS (understand command [pronouns]) (perform [pronouns]) "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 (understand command [verbose]) (understand [brief/superbrief] as [verbose]) (perform [verbose]) The verbosity level of this story is not adjustable. (stop) %% VERSION (understand command [version]) (understand [banner] as [version]) (perform [version]) (banner) %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% 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 $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) (actions on) (now) (tracing actions) (actions off) (now) ~(tracing actions) (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. (first try $Action) (line) \( first attempting to (describe action $Action) \) (line) (try $Action) (tick) (par) (refuse $Action) *($Obj is one of $Action) (object $Obj) ~(direction $Obj) ~(relation $Obj) { (when $Obj is not here) (or) (when $Obj is out of reach) } (before $) (fail) (instead of $Action) ~{ (prevent $Action) (tick) (stop) } (perform $Action) (prevent $) (fail) (perform $) (try-complex [$Verb | $ComplexObjects]) (if) ([] is one of $ComplexObjects) (then) You're not aware of any such thing! (line) (fail) (elseif) ([+ | $FirstMulti] is one of $ComplexObjects) (then) %% If at least two actions are implied, %% describe each one in turn. (if) ~{ *($Obj is one of $FirstMulti) (direction $Obj) } (then) (strip decorations from $FirstMulti into $Stripped) (notice player's $Stripped) %% Set 'them'. (endif) (exhaust) { *(expand complex objlist $ComplexObjects $ObjList) (line) Trying to (describe action [$Verb | $ObjList]): (try-decorated $Verb $ObjList) } (else) *(expand complex objlist $ComplexObjects $ObjList) (try-decorated $Verb $ObjList) (endif) (try-decorated $Verb $ObjList) (strip decorations from $ObjList into $CleanList) (if) *($Obj is one of $CleanList) (object $Obj) ~(direction $Obj) ~(relation $Obj) ~(room $Obj) (then) (notice player's $Obj) (endif) (exhaust) { *($Obj is one of $CleanList) (object $Obj) (now) ~($Obj is hidden) } ($Action = [$Verb | $CleanList]) (try $Action) (if) (command $Action) (then) (now) (narrator's it is protected) (else) (tick) (endif) (par) (strip decorations from [] into []) (strip decorations from [[a $Obj] | $MoreIn] into [$Obj | $MoreOut]) (strip decorations from $MoreIn into $MoreOut) (strip decorations from [$Obj | $MoreIn] into [$Obj | $MoreOut]) (strip decorations from $MoreIn into $MoreOut) (expand complex objlist [] []) (just) (expand complex objlist [[+ | $ObjList] | $MoreIn] [$Obj | $MoreOut]) (just) *($Obj is one of $ObjList) *(expand complex objlist $MoreIn $MoreOut) (expand complex objlist [$Other | $MoreIn] [$Other | $MoreOut]) *(expand complex objlist $MoreIn $MoreOut) (unlikely-complex [$Verb | $ComplexObjList]) *(expand complex objlist $ComplexObjList $SimpleObjList) (strip decorations from $SimpleObjList into $Stripped) (unlikely [$Verb | $Stripped]) %% 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. (unlikely $Action) (unlikely due to room $Action) (unlikely due to room $Action) ~($Action = [leave $]) ~($Action = [go to $]) ~($Action = [enter $]) *($Obj is one of $Action) (room $Obj) %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Daemons (inhibit next tick) (now) (inhibiting next tick) (tick) (if) (inhibiting next tick) (then) (now) ~(inhibiting next tick) (else) (recompute visibility) (exhaust) *(on every tick) (endif) %% Stories may add rules to this predicate, or to (on every tick in $): (on every tick) (current room $Room) *(on every tick in $Room) %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Numbers (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) (understand [$Word] as number $N) (parse numeral $Word into $N) (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 (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 (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 (the full $Obj) (the $Obj) (add location information for $Obj) (a full $Obj) (a $Obj) (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) (if) ($Dir = #down) (then) below (elseif) ($Dir = #up) (then) above (else) to the (name $Dir) (endif) (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 $Obj) (current player $Obj) yourself (A $Obj) (current player $Obj) You (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's $Obj) (current player $Obj) You're (a (proper $Obj)) (name $Obj) (the (proper $Obj)) (name $Obj) (a (your $Obj)) your (name $Obj) (the (your $Obj)) your (name $Obj) (a (singleton $Obj)) (the $Obj) (a (pair $Obj)) a pair of (name $Obj) (a (uncountable $Obj)) some (name $Obj) (a (plural $Obj)) some (name $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 (name $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 (a $Obj) a (name $Obj) (the $Obj) the (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) (that $) that (That's $) That's (doesn't $Obj) (does $Obj) (no space) n't (name $) (Name $Obj) (uppercase) (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) (The $Obj is) (uppercase) (the $Obj is) (That $Obj) (uppercase) (that $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 0) (the-full-listing $List) (listing $List {(the full $_)} @and 0) (the-full-or-listing $List) (listing $List {(the full $_)} @or 0) (or-listing $List) (listing $List {(the $_)} @or 0) (listing [] $ $ 0) nothing (listing [$Head | $Tail] $PrintClosure $Conjunction $NPrinted) (if) (fungibility enabled) (then) (combine-fungible $Tail $Head $NInc $Rest) (else) ($Rest = $Tail) (endif) (if) (empty $Rest) (then) (if) ($NPrinted > 1) (then) , (endif) (if) ($NPrinted > 0) (then) $Conjunction (endif) (else) (if) ($NPrinted > 0) (then) , (endif) (endif) (if) (fungibility enabled) ($NInc > 1) (then) (spell out $NInc) (plural name $Head) (else) (query $PrintClosure $Head) (endif) ($NPrinted plus 1 into $NPp1) (if) (nonempty $Rest) (then) (listing $Rest $PrintClosure $Conjunction $NPp1) (endif) (list of objects $Rel $Loc) (collect $Obj) *($Obj is $Rel $Loc) (into $List) (a $List) %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Generating dictionary words for objects (dict (your $)) my mine (dict (pair $)) pair (plural dict (pair $)) pairs (dict (openable $Obj)) (if) ($Obj is open) (then) open opened (else) closed (endif) (dict (lockable $Obj)) (if) ($Obj is locked) (then) locked (else) unlocked (endif) (dict (room $Room)) (inherently dark $Room) ~(light reaches ceiling $Room) dark darkness %% By default, any word mentioned in the name rule is included: (dict $Obj) (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 (notice $Obj) (if) (object $Obj) (then) (reveal $Obj) (if) (plural $Obj) (or) (pair $Obj) (then) (now) (them refers to [$Obj]) (elseif) (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) (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) (plural $Obj) (or) (pair $Obj) (then) (now) (them refers to [$Obj]) (elseif) (list $Obj) (then) (if) ($Obj = [$Single]) (then) (notice player's $Single) (else) (now) (them refers to $Obj) (endif) (elseif) (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) (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(s $Obj) to be harmless. (look $Obj) ($Obj has parent $Parent) (look $Parent) (feel (room $)) You poke around at your surroundings. They feel as expected. (feel $Obj) (The $Obj) feel(s $Obj) as expected. (appearance (item $Obj) #in (room $Room)) ($Obj is handled) You see (a $Obj) here. (notice $Obj) (appearance (item $Obj) $Rel $Loc) ($Obj is handled) (A $Obj) (is $Obj) (name $Rel) (the $Loc). (notice $Obj) (appearance (list $List) $Rel $Loc) (fungibility enabled) (if) ($Rel = #in) (room $Loc) (then) You see (a $List) here. (else) (A $List) are (name $Rel) (the $Loc). (endif) (notice $List) (make appearances $Rel $Loc) (if) ~{ ($Loc is opaque) ($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) } (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 [$Head | $Tail] $Key $N $Excluded) (if) (truly fungible $Head $Key) (then) (combine-fungible $Tail $Key $NMore $Excluded) ($NMore plus 1 into $N) (else) (combine-fungible $Tail $Key $N $MoreExcl) ($Excluded = [$Head | $MoreExcl]) (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) (if) ($NInc = 1) (then) (appearance $Head $Rel $Loc) (or) (else) (remove from $Tail matching $Rest into $Similar) (appearance [$Head | $Similar] $Rel $Loc) (endif) (fungibility-enabled appearance $Rest $Rel $Loc) %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Common complaints and prevent-checks (when $O is out of sight) ~($O is visible to player) (if) (player can see) (then) You can't see any such thing. (else) You can't see well enough to do that in the darkness. (endif) (when $O is already held) (current player $Actor) { ($O is #heldby $Actor) You're already holding (the $O). (or) ($O is recursively worn by $Actor) You're already wearing (the $O). } (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 $O is out of reach) ~($O is reachable by player) (if) ($O is visible to player) (then) You can't reach (the $O). (else) (The $O) (isn't $O) here. (endif) (when (intangible $O) is out of reach) (The $O is) intangible. (when $O is part of something) ($O is #partof $Parent) (That's $O) part of (the $Parent). (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) fine where (it $Obj) (is $Obj). (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 (program entry point) (div @initial-spacer) {} (update environment around player) (stoppable) (intro) (par) *(repeat forever) (read-parse-act) (fail) (intro) (banner) (try [look]) (read-parse-act) (stoppable) { (if) (scoring enabled) (score notifications are on) (then) (reported score is $Reported) (current score $Score) (if) ($Score < $Reported) (then) ($Reported minus $Score into $Diff) \( 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) \( 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) (endif) (redraw status bar) > (get input $Words) (parse commandline $Words) } (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) (par) (redraw status bar) (status bar @status) { (score headline) (status headline) } (redraw status bar) %% This predicate shouldn't fail. (status headline) (location headline) (location headline) (current player $Player) (if) (player can see) (then) (current room $Room) (bold) (room header $Room) (unstyle) ($Player is $Rel $Loc) (if) ~{ ($Rel = #in) ($Loc = $Room) } (then) \( (name $Rel) (the $Loc) \) (endif) (else) (bold) (darkness headline) (unstyle) (endif) (darkness headline) In the dark (narrate darkness) You are surrounded by darkness. (current visibility ceiling $Ceil) (notice $Ceil) (current score 0) (reported score is 0) (score notifications are on) (scoring enabled) (increase score by $Delta) (current score $Old) ($Old plus $Delta into $New) (now) (current score $New) (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) (bold) (story title or default) (unstyle) (line) (story noun) by (story author or default). (line) (story release $RelNum) Release $RelNum. Serial number (serial number). (line) (compiler version). (library version) (exhaust) { *(extension version) } (par) %% 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) (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) (game over $Message) (par) (space 5) (bold) \*\*\* (query $Message) \*\*\* (unstyle) (game over) (game over status bar) (status bar @status) { (score headline) Game Over } (game over menu) (line) Would you like to: RESTART, RESTORE a saved game, (if) (interpreter supports undo) (then) UNDO the last move, (endif) (if) (amusing enabled) (then) see a list of AMUSING things to do, (endif) or QUIT? > (get input $Words) (stoppable) (parse game over $Words) (parse game over [restart]) (restart) (parse game over [restore]) (try [restore]) (parse game over [undo]) (if) (undo) (or) (then) Failed to undo last turn. (endif) (parse game over [amusing]) (amusing enabled) (amusing) (parse game over [quit]) (display quit message) (line) (quit) (parse game over [q]) (parse game over [quit]) (parse game over $) 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 (rewrite [x | $Words] into [examine | $Words]) (rewrite [l | $Words] into [look | $Words]) %% 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. (understand $Words as direction $Output) (parse direction list $Words $ObjList) (mark multi-object $ObjList into $Output) (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. (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 $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 #wornby $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 $_)} []) (takable (item $Obj)) ~($Obj has relation #partof) ~{ ($Obj is $Rel $Parent) ($Rel is one of [#heldby #wornby]) (current actor $Parent) } (verify object policy (object $Policy) $Obj) ($Obj has parent $Policy) (verify object policy (nonempty $Policy) $Obj) (query $Policy $Obj) (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 $Policy $Someone $) (allowing parse errors) (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) (mark multi-object [$Single] into $Single) ~(word $Single) (mark multi-object [$Head | $Tail] into [+ $Head | $Tail]) (object $Head) (mark multi-object $Other into $Other) (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) (append $LeftObj $RightObj $ObjList) (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 $BaseList []) (remove from $BaseList matching $NegList into $Result) (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) (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) (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) (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) (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) (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 (object $Obj)) (the full $Obj) (describe topic $) something (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) (topic keyword $Keyword implies $Keyword) (topic keyword $Keyword) %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% 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 $)) (parse commandline []) Come again? (parse commandline [\* | $]) %% By convention used by testers to put comments in a transcript. (parse commandline $Words) (now) ~(allowing parse errors) (rebuild scope) (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) (parse action []) (parse action $Words) %% First, check for UNDO. (if) ($Words = [undo]) (then) (if) ~(interpreter supports undo) (then) This interpreter doesn't support undo. (elseif) (undo) (then) Failed to undo last turn. (else) There are no more turns to undo! (endif) (stop) (else) %% The command wasn't UNDO. %% Before proceeding, save the current undo state: (if) (save undo 1) (then) (roman) Undoing the last turn. (line) (location headline) (stop) (endif) %% Usually, the player is the actor. (current player $Player) (now) (current actor $Player) %% Handle AGAIN and rewriting: (if) ($Words = [$W]) ($W is one of [again g]) (last command was $LastCmd) (then) (rewrite $LastCmd into $ActualWords) (else) (now) (last command was $Words) (rewrite $Words into $ActualWords) (endif) %% Parse the action. Special treatment if we've asked for %% clarification, and a noun was entered on its own: (collect $A) (implicit action is $Implicit) (if) (implicit action wants direction) (then) *(understand $ActualWords as direction $O) (else) %% We don't know the correct policy, so %% fall back on 'non-all'. *(understand $ActualWords as non-all object $O) (endif) (recover implicit action $Implicit $O into $A) (or) *(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. (now) ~(implicit action is $) (now) ~(implicit action wants direction) (try-complex $Single) (else) (sieve action candidates $AllCandidates $ActualWords) (endif) (endif) (sieve action candidates $AllCandidates $ActualWords) (if) (nonempty $AllCandidates) (then) (now) ~(implicit action is $) (now) ~(implicit action wants direction) (collect $A) *($A is one of $AllCandidates) ~(unlikely-complex $A) (into $LikelyCandidates) (if) (nonempty $LikelyCandidates) (then) %% Consider only the likely candidates. (consider action candidates $LikelyCandidates) (else) %% All candidates were deemed unlikely, but some %% candidates are more unlikely than others. Here, we %% decide that most actions that involve rooms are %% very unlikely. (collect $A) *($A is one of $AllCandidates) ~(unlikely due to room $A) (into $SomewhatLikely) (if) (nonempty $SomewhatLikely) (then) (consider action candidates $SomewhatLikely) (else) (consider action candidates $AllCandidates) (endif) (endif) (elseif) %% 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. *(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? %% 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 $ActualWords as $BadAction) (then) (if) ([all] is one of $BadAction) (then) \( The word "all" is not allowed in that context. Please be more specific. \) (elseif) ([,] is one of $BadAction) (then) \( You're not allowed to use multiple objects in that context. Please do it step by step. \) (else) \( I only understood you as far as wanting to (describe action $BadAction) . \) (endif) (else) \( I'm sorry, I didn't understand what you wanted to do. \) (endif) (stop) (endif) %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Disambiguation (consider action candidates $List) (if) ($List = [$Single]) (then) %% Optimize the common case. (try-complex $Single) (else) (disambiguate action $List $ComplexAction) (try-complex $ComplexAction) (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) Did you want to (describe action $ComplexAction)? (par) > (get input $Words) { %% Since the player was given an explicit list of %% '(the full $)' descriptions, we have to match %% against those, instead of the normal dict rules. %% However, we make a special case out of me/myself %% (which is usually printed as 'yourself'). (current player $Player) (if) ($Words = [$W]) ($W is one of [me myself]) ($Player is one of $ObjList) (then) (recover implicit action $Template $Player into $Result) (else) (collect $A) (determine object $Obj) *($Obj is one of $ObjList) ~(direction $Obj) ~(relation $Obj) (from words) (the full $Obj) (matching all of $Words) (recover implicit action $Template $Obj into $A) (into $Candidates) (nonempty $Candidates) { ($Candidates = [$Result]) (or) (just) (consider action candidates $Candidates) (stop) } (endif) (or) (parse commandline $Words) (stop) } (else) Did you want to: (line) (enumerate actions $AskList 1 $) \( Type the corresponding number \) (par) > (get input $Words) { (understand $Words as number $N) ($N > 0) (nth $AskList $N $Result) (or) (parse commandline $Words) (stop) } (endif) (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 actions [$Item1 $Item2] $N $Np1) (just) $N . (describe action $Item1) , or (line) ($N plus 1 into $Np1) $Np1 . (describe action $Item2) ? (line) (enumerate actions [$Item1 $Item2 | $] 9 10) (just) (enumerate actions [$Item1 $Item2] 9 10) \(List truncated.\) (line) (enumerate actions [$Head | $Tail] $N $Last) $N . (describe action $Head) , (line) ($N plus 1 into $Np1) (enumerate actions $Tail $Np1 $Last) %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Asking for clarification (asking for object in $Action) (now) (implicit action is $Action) (now) ~(implicit action wants direction) (stop) (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) %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Miscellaneous input routines %% Asking a yes/no question: (yesno) (space) > (get input $Words) (if) ($Words = [yes]) (or) ($Words = [y]) (then) (elseif) ($Words = [no]) (or) ($Words = [n]) (then) (fail) (else) Please answer yes or no (yesno) (endif) %% Asking for a number: (get number from $First to $Last $N) $First - $Last > (get input $Input) (understand $Input as number $N) ~($N < $First) ~($N > $Last) %% Waiting for a keypress: (any key) (get key $) %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Finding the shortest path from one room to another, using obvious exits. (shortest path from $A to $B is $Path) (find paths from $A) ($B has distance $ from start) (build path from $A to $B [] $Path) (find paths from $Start) (now) ~($ has distance $ from start) (now) ~($ is to be considered) (now) ($Start has distance 0 from start) (now) ($Start is to be considered) (stoppable) { *(repeat forever) (find paths subroutine) (fail) } (find paths subroutine) (if) ($First is to be considered) (then) %% There's at least one room left to consider. %% Of all the rooms left to consider, pick the one with the %% shortest known distance from the starting room: ($First has distance $FirstDist from start) (collect $Node) *($Node is to be considered) (into [$ | $Considered]) (find nearest $Considered $FirstDist $First into $Nearest) %% Remove it from the set of rooms left to consider (because %% we're considering it now): (now) ~($Nearest is to be considered) %% Obtain its shortest known distance from the starting room, %% and add 1. This will be the distance to each of its %% neighbours, if we go there via the room under consideration. ($Nearest has distance $D from start) ($D plus 1 into $Dp1) %% Consider each neighbouring room (that the player has seen): (exhaust) { *(from $Nearest go $ to room $Dest) ($Dest is visited) %% Only proceed if there is no known path to the %% neighbouring room, or if the new path is shorter: (if) ($Dest has distance $OldDist from start) (then) ($Dp1 < $OldDist) (endif) %% Store the new path and distance: (now) ($Dest has distance $Dp1 from start) (now) (last hop before $Dest is $Nearest) %% We must consider the neighbours of this neighbour: (now) ($Dest is to be considered) } (else) (stop) (endif) %% Run through the list of rooms, and return the one with the shortest distance %% from the starting room: (find nearest [] $ $ArgMin into $ArgMin) (find nearest [$Head | $Tail] $Min $ArgMin into $Output) (if) ($Head has distance $D from start) ($D < $Min) (then) (find nearest $Tail $D $Head into $Output) (else) (find nearest $Tail $Min $ArgMin into $Output) (endif) %% Reconstruct the full path from the 'last hop' links: (build path from $Start to $Start $SoFar $SoFar) (build path from $Start to $End $SoFar $Path) (last hop before $End is $Last) (from $Last go $Dir to room $End) (build path from $Start to $Last [$Dir | $SoFar] $Path) %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% 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: ((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. ($Obj has ancestor $Ancestor) (if) (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) ($Obj is nested $Rel $Loc) (if) (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) ($Obj is part of $Ancestor) (if) (bound $Obj) (then) ($Obj is #partof $Parent) { ($Parent = $Ancestor) (or) *($Parent is part of $Ancestor) } (else) *($Sub is #partof $Ancestor) { ($Obj = $Sub) (or) *($Obj is part of $Sub) } (endif) ($Obj is recursively worn by $Actor) ($Obj is #wornby $Actor) ($Obj is recursively worn by $Actor) ($Obj is #partof $OtherObj) ($OtherObj is recursively worn by $Actor) %% The following predicates are useful when writing before-rules: (ensure $Obj is held) (current player $Actor) (if) ($Obj is recursively worn by $Actor) (then) (first try [remove $Obj]) (elseif) (item $Obj) ~($Obj is #heldby $Actor) (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 (append [] $A $A) (append [$A | $MoreA] $B [$A | $C]) (append $MoreA $B $C) (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) (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) (length of [] into 0) (length of [$ | $More] into $Np1) (length of $More into $N) ($N plus 1 into $Np1) (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) ($X contains one of $Y) (split $X by $Y into $ and $) ($ 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) (split $Input by relation $Rel into $Left and $Right) (nonempty $Input) *(relation $Rel) (collect words) *(dict $Rel) (into $WordSet) (nonempty $WordSet) *(split $Input by $WordSet into $Left and $Right) (print words $List) (exhaust) { *($Word is one of $List) $Word } (Print Words $List) (exhaust) { *($Word is one of $List) (uppercase) $Word } %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Get rid of some compiler warnings (plural name $) (fail) (from $ go $ to $) (fail) ($ unlocks $) (fail) (from $ through $ to $) (fail) (topic keyword $) (fail) (on every tick in $) (fail) (scoring enabled) (fail) (maximum score $) (fail) (amusing enabled) (fail) (amusing) (fail) %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Fatal runtime errors (error $Code entry point) (roman) \( Technical trouble: (report fatal error $Code) Attempting to recover with UNDO. \) (line) (if) (undo) (or) (then) Undo failed! (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 $) Invalid error code!