MESSAGE "\n calyx2.adl - version 1.41 - Feb 14, 1995\n";
MESSAGE " 1994, 1995 by Miron Schmidt/Calyx Corp.\n";
MESSAGE " Based on Ross Cunniff's \"standard.adl\"\n";
MESSAGE " (Copyright (c) 1986, 1987 by Ross Cunniff)\n";
{ History:
calyx_std.adl - This was my first own std.adl. Added ClS, several
equivalencies; removed some bugs, most notably "put x in x"
and "put x in y" when y is closed.
v1.0 - INCAP, ONCAP, ObjCont, several new equivalencies, enter, exit,
ACTIVE, removed LOCKS & LOCKED.
v1.2 (Apr 6, 1994) - Everything from v1.0 works properly. Several
problems with ObjCont due to a bug in ADL - see commentary
there. Added Cloak.
v1.3 (May 1, 1994) - Retyped the standard answer for "exit". Added
this history. Changed "wait". Noticed and removed "put" bug:
"put x into y" worked even if y was in another room. I
inserted a (CheckAvail) line in the "drop" PREACT, but don't
know if there is a double check now somewhere in TorDPRE.
v1.4 (May 10, 1994) - Changed "look", so that the SDESC of a room is
now printed at a "look" (doesn't work).
v1.41 (Feb 14, 1995) - Rewrote ObjCont again; now a <cr> is inserted
if object has INCAP or ONCAP, but nothing is printed out.
Known bugs:
"look" doesn't work as it should (s.a.). Shouldn't matter though.
}
{ *** Boolean Object Properties *** }
SEEN = 16; { I've been here / seen this }
OPENS = 15; { This can be opened }
OPENED = 14; { This is open }
TRANS = 13; { This is transparent }
INCAP = 12; { The object has an "in"-capacity but is NOT }
{ openable, e.g. a sink }
ONCAP = 11; { The object has an "on"-capacity }
LIGHT = 10; { This gives off light }
FLAME = 9; { This is on fire }
NOTAKE = 8; { Ignore this object for "take" }
ACTIVE = 7; { This object is active, e.g. locked, turned on }
{ an object may only have *either* INCAP *or* ONCAP }
{ *** Integer Object Properties *** }
AllLink = 29; { Link for objects used with "take" and "drop" }
SAVESENT = 28; { First VAR in a sentence save area }
{ *** Useful Constants *** }
TRUE = 1;
FALSE = 0;
NULL = 0;
ON = 1;
OFF = 0;
{ *** Flags for Expect *** }
NO_OBJ = 1; { It is valid to have no objects }
ONE_OBJ = 2; { It is valid to have one object }
MULT_OBJ = 4; { It is valid to have multiple objects }
STR_OBJ = 8; { It is valid to have string objects }
PLAIN_OBJ = 16; { It is valid to have normal objects }
VAR
First, { Is the current Dobj the first in the Dobj list? }
AllSeen, { Did the player type "all" in this sentence? }
MultList, { Head ptr of the multiple object list }
MyConj, { Records where "but" has been seen }
NumSeen, { Number of Dobj's seen by "take" or "drop" so far }
IobjSave, { Save for the Iobj (for TAKE and DROP) }
Skip, { Should TorDACT skip this object? }
Scripting, { Are we writing a script file? }
Cloak, { Used to skip some sentences in predef'd ACTIONs }
Conts, { Have we already printed out "You can see:"? }
Indent, { Indent outer object descriptions? }
LastVerb, { The Verb from the previous sentence }
LastNumd, { The Numd from the previous sentence }
LastConj, { The Conj from the previous sentence }
LastDobj, { The Dobj from the previous sentence }
LastPrep, { The Prep from the previous sentence }
LastIobj, { The Iobj from the previous sentence }
Dark, { Is it dark? }
MyLoc, { My last location }
Verbose; { Does the player want verbose output? }
(First) = TRUE;
(MyLoc) = -1; { Look on the first turn }
{ *** Prepositions *** }
PREP
with, to, into, at, under, from, off, on;
in = into;
{ *** Articles *** }
ARTICLE
the, a, an;
{ *** Useful routines *** }
ROUTINE
StdInit, { (StdInit actor) Standard game with actor playing }
Reach, { (Reach Obj Where) True IFF I can reach Obj in Where }
See, { (See Obj Where) True IFF I can see Obj in Where }
Lit, { (LitP) True IFF something is lit or burning }
Describe, { (Describe depth obj rout) Describe obj }
Avail, { (Avail Obj) Is Obj available? }
CheckAvail, { (CheckAvail) check availability of Dobj and Iobj }
Expect, { (Expect DobjFlags IobjFlags) Check the form }
Preact, { Standard verb preact }
Looker, { Looking daemon }
Prompter, { User prompt }
ActAction, { Standard actor ACTION }
SaveSentence, { (SaveSentence) - save the value of the curr. sent. }
TakeAct, { User defined take action }
DropAct, { User defined drop action }
Dwimmer, { (Dwimmer Obj) - is Obj the one I want? }
ObjCont, { Describes the contents of an object }
ClS; { Clear Screen (print 31 blank lines) }
{ *** Objects *** }
NOUN
all, { Used only in sentences with take and drop }
it; { Refers to the last Dobj or Iobj typed }
q = quit;
g = again;
i = inventory;
x = examine;
z = wait;
l = look;
u = up;
d = down;
north = n;
south = s;
east = e;
west = w;
northeast = ne;
northwest = nw;
southeast = se;
southwest = sw;
put on = wear;
take off = remove;
turn on = light;
turn off = douse;
look at = examine;
brief = terse;
MESSAGE "---> Standard Routines.\n";
{ (StdInit actor) - initializes the ACTION routine of actor, sets
up the prompter, and sets up the looking daemon. }
StdInit =
($setp %1 ACTION ActAction)
($setp %1 NOTAKE TRUE)
($setp %1 SAVESENT LastVerb)
($actor %1 NULL TRUE)
($prompt Prompter)
($sdem Looker)
($setv n s e w ne se nw sw u d)
;
{ (FindIt obj) - figure out what an 'it' in a player's sentence refers
to }
ItConfused = "I can't figure out what you mean by 'it'.\n\n";
FindIt =
LOCAL
SavePlace, { The value of .ME(SAVESENT) }
LastDobj, { The last DIRECT OBJECT typed }
LastIobj, { The last INDIRECT OBJECT typed }
LastNumd; { The previous NUMBER OF DIRECT OBJECTS typed }
{ Retrieve the pertinent info from SAVESENT }
($setg SavePlace ($prop .ME SAVESENT))
(IF ($not @SavePlace) THEN
($say ItConfused)
($exit 1)
)
($setg LastNumd ($global ($plus @SavePlace 1)))
($setg LastDobj ($global ($plus @SavePlace 3)))
($setg LastIobj ($global ($plus @SavePlace 5)))
ActAction =
LOCAL SavePlace;
(IF ($eq @Verb again) THEN
($setg SavePlace ($prop .ME SAVESENT))
(IF ($not @SavePlace) THEN
($say "I can't do that.\n")
($exit 1)
)
(IF ($or @Dobj @Iobj) THEN
($say "You may not use objects with 'again'.\n")
($exit 1)
)
(IF ($gt ($global ($plus @SavePlace 1)) 1) THEN
($say "You can't use 'again' with multiple direct objects.\n")
($exit 1)
)
($setg Verb ($global @SavePlace))
($setg Numd ($global ($plus @SavePlace 1)))
($setg Conj ($global ($plus @SavePlace 2)))
($setg Dobj ($global ($plus @SavePlace 3)))
($setg Prep ($global ($plus @SavePlace 4)))
($setg Iobj ($global ($plus @SavePlace 5)))
($exit 0)
)
(IF ($and ($eq @Dobj it) ($ne @Iobj it)) THEN
(FindIt Dobj)
ELSEIF ($and ($eq @Iobj it) ($ne @Dobj it)) THEN
(FindIt Iobj)
ELSEIF ($or ($eq @Iobj it) ($eq @Dobj it)) THEN
($say "You may only use the word 'it' once in a sentence.\n")
($exit 1)
)
(SaveSentence)
;
{ (CheckAvail) - checks to see whether the objects named by the
player are indeed available }
CheckAvail =
(IF ($gt ($dobj) 0) THEN
(Avail ($dobj))
)
(IF ($gt ($iobj) 0) THEN
(Avail ($iobj))
)
;
{ (Expect DobjFlags IobjFlags) - Checks for a valid sentence }
Expect =
{ Check the number of direct objects }
(IF ($eq @Numd 0) THEN
(IF ($not ($and %1 NO_OBJ)) THEN
($say "You must tell me what to " ($vname @Verb) ".\n")
($exit 3)
)
ELSEIF ($and ($eq @Numd 1) ($ne @Dobj all)) THEN
(IF ($and ($not ($and %1 MULT_OBJ))
($not ($and %1 ONE_OBJ)) )
THEN
($say "You may not use a direct object with "
($vname @Verb) ".\n")
($exit 1)
)
ELSE
(IF ($not ($and %1 MULT_OBJ)) THEN
($say "You may not use multiple direct objects with "
($vname @Verb) ".\n")
($exit 1)
)
)
{ Check the number of Indirect objects }
(IF ($and ($eq @Iobj 0) ($not ($and %2 NO_OBJ))) THEN
($say "How would you like to do that?\n")
($exit 3)
ELSEIF ($and ($ne @Iobj 0) ($not ($and %2 ONE_OBJ))) THEN
($say "You may not use an indirect object with "
($vname @Verb) ".\n")
($exit 1)
)
{ Check the type of the objects }
(IF ($or ($and ($lt @Dobj 0) ($not ($and %1 STR_OBJ)))
($and ($lt @Iobj 0) ($not ($and %2 STR_OBJ))) )
THEN
($say "You may not use strings with " ($vname @Verb) ".\n")
($exit 1)
)
(IF ($or ($and ($gt @Dobj 0) ($not ($and %1 PLAIN_OBJ)))
($and ($gt @Iobj 0) ($not ($and %2 PLAIN_OBJ))) )
THEN
($say "You must use strings with " ($vname @Verb) ".\n")
($exit 1)
)
;
{ (Visible List Propno) - returns 1 IFF an object is visible on List that
has a nonzero prop Propno }
Visible =
(IF ($not %1) THEN { Null list }
($return FALSE)
ELSEIF ($prop %1 %2) THEN { This one is it! }
($return TRUE)
ELSEIF ($or
($prop %1 OPENED)
($prop %1 TRANS)
($prop %1 INCAP)
($prop %1 ONCAP)
)
THEN
(IF (Visible ($cont %1) %2) THEN
($return TRUE)
)
)
($return (Visible ($link %1) %2)) { See if siblings satisfy Visible }
;
{ (Reach Obj Loc) - returns 1 IFF Obj == Loc, or can (recursively) be
reached via the Loc }
Reach =
(IF ($not %2) THEN { Null list }
($return FALSE)
ELSEIF ($eq %1 %2) THEN { This is the one! }
($return TRUE)
ELSEIF ($or ($prop %2 OPENED) ($prop %2 INCAP) ($prop %2 ONCAP)) THEN
{ Still explore contents }
(IF (Reach %1 ($cont %2)) THEN
($return TRUE)
)
)
($return (Reach %1 ($link %2))) { See if siblings can reach }
;
{ (See Obj Loc) - returns 1 IFF the Obj == Loc, or can be reached
via the Loc (similar to Reach, above) }
See =
(IF @Dark THEN { Can't see in a dark room! }
($return FALSE)
ELSEIF ($not %2) THEN { Null list }
($return FALSE)
ELSEIF ($eq %1 %2) THEN { This is the one! }
($return TRUE)
ELSEIF ($or
($prop %2 TRANS)
($prop %2 OPENED)
($prop %2 INCAP)
($prop %2 ONCAP)
)
THEN { Still explore contents }
(IF (See %1 ($cont %2)) THEN
($return TRUE)
)
)
($return (See %1 ($link %2))) { See whether siblings can see }
;
{ (Avail Obj) - returns 1 IFF I can see Obj or I can reach Obj,
performs a ($exit 1) otherwise }
Avail =
(IF ($not %1) THEN { Null object }
($say "The what?\n")
($exit 1)
ELSEIF ($not ($or (See %1 ($cont ($loc .ME))) (See %1 ($cont .ME)))) THEN
($say "I can't see that here.\n")
($exit 1)
ELSEIF ($not ($or (Reach %1 ($cont ($loc .ME))) (Reach %1 ($cont .ME))))
THEN
($say "I can't get at that item.\n")
($exit 1)
)
($return TRUE)
;
{ (Lit Room) - returns TRUE IFF Room is lit }
Lit =
(IF ($prop %1 LIGHT) THEN { Intrinsically lit }
($return TRUE)
ELSEIF ($or (Visible ($cont %1) LIGHT) (Visible ($cont %1) FLAME)) THEN
($return TRUE) { I can see a light }
ELSEIF ($or (Visible ($cont .ME) LIGHT) (Visible ($cont .ME) FLAME)) THEN
($return TRUE) { I have a light }
ELSE
($return FALSE)
)
;
{ (Next global) - sets global to point to the sibling of the object
pointed to by global }
Next =
($setg %1 ($link ($global %1)))
;
{ (Blank n) - Type 2*n blanks (only if Indent is TRUE) }
Blank =
LOCAL i;
(IF ($not @Indent) THEN ($return 0))
($setg i %1)
(WHILE @i DO
($say " ")
($setg i ($minus @i 1))
)
;
{ (Describe Level Obj Rout) - Describes Obj using Rout (which is a ROUTINE that
returns a ROUTINE that describes Obj, typically $sdesc or $ldesc),
and also describes the contents of Obj }
Describe =
(IF ($not %2) THEN { Null list }
($return 0)
ELSEIF ($not %1) THEN { Level 0 == This is a room. Check lighting }
($setg Conts FALSE)
(IF (Lit %2) THEN
($setg Dark FALSE) { Can't be dark in a lit room! }
((%3 %2)) { Talk about the room }
(IF ($not @Dark) THEN
(Describe 1 ($cont %2) %3) { Talk about its contents }
)
ELSE
($say "It's mighty dark in here!\n")
($setg Dark TRUE)
)
ELSE { Level > 0 == This is a list of objs }
(IF (%3 %2) THEN { Talk (only) about the visible }
(IF ($and ($eq %3 $sdesc) ($not @Conts)) THEN
(Blank ($minus %1 1))
($say "You can see:\n")
)
($setg Conts TRUE)
(Blank %1) { Indent }
((%3 %2)) { Blurb the object }
(IF ($cont %2) THEN { something inside it...}
(IF ($or
($prop %2 OPENED)
($prop %2 TRANS)
($prop %2 INCAP)
)
THEN
(IF ($eq %3 $ldesc) THEN
(Blank %1)
($say "It contains:\n")
ELSE
($say ", containing\n")
)
($setp %2 SEEN TRUE)
(Describe ($plus %1 1) ($cont %2) $sdesc)
{ Short descs for conts }
ELSEIF ($prop %2 ONCAP) THEN
(IF ($eq %3 $sdesc) THEN
($say ", on the surface of which you can see:\n")
ELSE
(Blank %1)
($say "On its surface, you can see:\n")
)
($setp %2 SEEN TRUE)
(Describe ($plus %1 1) ($cont %2) $sdesc)
{ Short descs for conts }
ELSEIF ($eq %3 $sdesc) THEN
($say "\n")
)
ELSEIF ($eq %3 $sdesc) THEN
($say "\n")
)
)
(Describe %1 ($link %2) %3)
)
;
{ (SaveSentence) - save the value of the current sentence }
{ (Looker) - The standard Looking daemon. Usually only mentioned
in START. }
Looker =
($setp .ME TRANS FALSE)
($setg MyConj FALSE)
($setg First TRUE)
($setg IobjSave NULL)
($setg AllSeen FALSE)
(IF ($ne @MyLoc ($loc .ME)) THEN
(IF ($and ($not @Verbose) ($prop ($loc .ME) SEEN)) THEN
(Describe 0 ($loc .ME) $sdesc)
ELSE
(($sdesc ($loc .ME)))
(Describe 0 ($loc .ME) $ldesc)
($setp ($loc .ME) SEEN TRUE)
)
(IF @Dark THEN
($setp ($loc .ME) SEEN FALSE)
)
($setg MyLoc ($loc .ME))
)
($setp .ME TRANS TRUE)
($setp .ME OPENED TRUE)
;
{ The following are routines relating to sentence constructions such
as "take all but rock and cow. drop all but sword." }
{ (DelList Obj) -- Deletes Obj from the list of multiple direct objects }
DelList =
LOCAL Curr;
(IF ($eq %1 all) THEN
{ The player typed something like "take all but all" }
($say "I don't understand that.\n")
($exit 1)
)
($setg Curr @MultList)
(IF ($eq @Curr %1) THEN
{ Delete the head of the list }
($setg MultList ($prop @Curr AllLink))
ELSE
{ It's somewhere in the middle of the list }
(WHILE @Curr DO
(IF ($eq ($prop @Curr AllLink) %1) THEN
($setp @Curr AllLink ($prop ($prop @Curr AllLink) AllLink))
($return 0)
)
($setg Curr ($prop @Curr AllLink))
)
{ If we make it here, %1 wasn't on the list to begin with. }
($say "You see no " ($name %1) " here.\n")
($exit 1)
)
;
{ (AddList Obj) -- Adds Obj to the list of multiple direct objects }
AddList =
(IF ($eq %1 all) THEN
{ The player typed something like "Take rock and all" }
($say "I don't understand that.\n")
($exit 1)
)
($setp %1 AllLink @MultList)
($setg MultList %1)
;
{ (InitList Where) -- Adds each object contained in Where to MultList }
{ (Mover Where String) - Moves each object on MultList to Where, printing
String as it does so. (String is unly printed if Cloak is FALSE.) }
Mover =
(IF ($not @MultList) THEN
($say "There is nothing to " ($vname @Verb) ".\n")
($exit 1)
)
(WHILE @MultList DO
($setg Dobj @MultList)
($setg Iobj @IobjSave)
($setg Skip FALSE)
(($action @Dobj)) { Call the ACTION routines }
(IF ($not @Skip) THEN
(($action @Iobj)) { for the Dobj and Iobj }
)
(IF ($not @Skip) THEN { Call the ACTIONs for the verb }
(IF ($eq @Verb take) THEN
(TakeAct)
ELSE {Verb == drop}
(DropAct)
)
)
(IF ($not @Skip) THEN
($move @Dobj %1) { Do the moving }
(IF ($not @Cloak) THEN ($say " " ($name @Dobj) ": " %2 "\n"))
($setg Cloak FALSE)
)
($setg MultList ($prop @MultList AllLink))
)
;
{ (CheckLoc Obj Where) - Checks whether Obj can be seen on Where
and can be reached on Where }
CheckLoc =
(IF ($not (See %1 %2)) THEN
(IF ($eq %2 ($cont .ME)) THEN
($say "You have no " ($name %1) ".\n")
ELSE
($say "You see no " ($name %1) " here.\n")
)
($exit 1)
ELSEIF ($not (Reach %1 %2)) THEN
($say "You can't reach the " ($name %1) ".\n")
($exit 1)
)
;
{ (TorDPRE Where) -- Uses Where as the context for a multiple
direct object (with "all" as a possible object) list. }
TorDPRE =
(IF ($eq @Dobj @IobjSave) THEN { "put bag in bag" }
($say "That's physically impossible.\n")
($exit 1)
)
(IF ($not @First) THEN
{ The MultList is initialized }
(IF @Conj THEN
(IF ($not @AllSeen) THEN
{ The player typed something like "take a, b but c" }
($say "I don't understand that.\n")
($exit 1)
)
($setg MyConj TRUE)
)
(IF @MyConj THEN { We have seen "but" in the sentence }
(DelList @Dobj) { so delete this object from the list }
ELSE { We have NOT seen "but" }
(CheckLoc @Dobj %1) { See if the object is in the right place }
(AddList @Dobj) { If so, add the object to the mult list }
)
ELSE { The MultList is NOT initialized, but
there are objects in the sentence }
(IF ($eq @Dobj all) THEN
(InitList %1) { The direct obj. is all, so set the MultList
to the cont of the loc of .ME }
ELSE { The dir obj. is NOT all, so set MultList to }
(CheckLoc @Dobj %1) { be the direct object. }
($setg MultList @Dobj)
($setp @Dobj AllLink NULL)
)
($setg First FALSE)
($setg MyConj FALSE)
($setg NumSeen 1)
)
($setg Dobj 0) { We will call the ACTION routines later... }
;
{ (TorDACT Where String) -- Moves all objects on the multlist to Where
(using Mover) if all of the objects have been seen; otherwise it waits.
String is the past participle of $verb. (e.g. "taken", "dropped" }
{ The following objects are for things like "go north" }
NOUN
n DIR, s DIR, e DIR, w DIR,
ne DIR, se DIR, nw DIR, sw DIR,
u DIR, d DIR;
{ We keep them in this array for PORTABLE referencing }
VAR
_DirArray[ 10 ];
(_DirArray+0) = n DIR;
(_DirArray+1) = s DIR;
(_DirArray+2) = e DIR;
(_DirArray+3) = w DIR;
(_DirArray+4) = ne DIR;
(_DirArray+5) = se DIR;
(_DirArray+6) = nw DIR;
(_DirArray+7) = sw DIR;
(_DirArray+8) = u DIR;
(_DirArray+9) = d DIR;
go( PREACT ) =
LOCAL i;
(Expect ($or ONE_OBJ PLAIN_OBJ) NO_OBJ)
{ Try to find the Dobj in the list of Directions }
($setg i 0)
(WHILE ($lt @i 10) DO
(IF ($eq ($global ($plus _DirArray @i)) ($dobj)) THEN
{ We found it. Set the Verb and Dobj appropriately }
($setg Verb ($minus 0 ($modif ($dobj))))
($setg Dobj 0)
(($vprop ($verb) PREACT))
($return 0)
)
($setg i ($plus @i 1))
)
{ If we get here, we didn't find the Dobj }
($say "Huh?\n")
($exit 1)
;
{ I can't seem to figure out why, but the ObjCont routine just won't work
if $cont is checked in an AND condition. So the current routine [(IF (bla
is set) THEN (IF ($cont))...)] works correctly, while it was bug-ridden
when I programmed it like (IF ($and (bla is set) ($cont)) THEN...)
The error (ObjCont wasn't executed for certain containers) occurred only
with sibling objects that didn't have a defined ACTION.
That's probably due to a general bug in ADL. }
ObjCont =
($setg Conts TRUE)
(IF ($and ($prop @Dobj OPENS) ($not ($prop @Dobj OPENED))) THEN
($say "It's closed")
(IF ($prop @Dobj TRANS) THEN
(IF ($cont @Dobj) THEN
($say ", and contains:\n")
(Describe 1 ($cont @Dobj) $sdesc)
)
ELSE
($say ".\n")
)
ELSEIF ($prop @Dobj OPENED) THEN
($say "It's open")
(IF ($cont @Dobj) THEN
($say ", and contains:\n")
(Describe 1 ($cont @Dobj) $sdesc)
ELSE
($say ".\n")
)
ELSEIF ($prop @Dobj INCAP) THEN
(IF ($cont @Dobj) THEN
($say "It contains:\n")
(Describe 1 ($cont @Dobj) $sdesc)
ELSE
($say "\n")
)
ELSEIF ($prop @Dobj ONCAP) THEN
(IF ($cont @Dobj) THEN
($say "On its surface, you can see:\n")
(Describe 1 ($cont @Dobj) $sdesc)
ELSE
($say "\n")
)
ELSE
($say "\n")
)
Silly =
(IF ($pct 20) THEN
($say "Don't be silly!\n")
ELSEIF ($pct 25) THEN
($say "You're joking!\n")
ELSEIF ($pct 33) THEN
($say "Not in thousand years!\n")
ELSEIF ($pct 50) THEN
($say "That's nonsense!\n")
ELSE
($say "Very funny!\n")
)
($exit 1)
;
_MeanMsg = "What do you mean by \"";
NOVERB(PREACT) =
(IF ($gt @Dobj 0) THEN
($say "What do you want to do with the " ($name @Dobj) "?\n")
($exit 3)
ELSEIF ($lt @Dobj 0) THEN
($say _MeanMsg @Dobj "\"?\n")
($exit 3)
ELSEIF ($lt @Dobj 0) THEN
($say _MeanMsg @Dobj "\"?\n")
($exit 3)
ELSEIF ($gt @Iobj 0) THEN
($say "What to you want to do " ($pname @Prep) " the "
($name @Iobj) "?\n")
($exit 3)
ELSEIF ($lt @Iobj 0) THEN
($say _MeanMsg @Iobj "\"?\n")
($exit 3)
ELSE
($say "I beg your pardon?\n")
($exit 1)
)
;
inventory(PREACT) = (Expect NO_OBJ NO_OBJ);
inventory(ACTION) =
(IF ($not ($cont .ME)) THEN
($say "You are empty-handed.\n")
($exit 1)
)
($setp .ME SEEN TRUE)
($say "You are carrying:\n")
($setg Conts TRUE)
(Describe 1 ($cont .ME) $sdesc)
;
quit(PREACT) = (Expect NO_OBJ NO_OBJ);
quit(ACTION) =
($say "Are you sure you want to quit? ")
(IF ($yorn) THEN
($say "\n\nHope to see you soon again.\n\n\n")
($spec QUIT)
)
;
save(PREACT) = (Expect NO_OBJ NO_OBJ);
save(ACTION) =
LOCAL s;
($setg MyLoc -1)
($setp ($loc .ME) SEEN FALSE)
($say "Save to which file? ")
($setg s ($read))
(IF ($leng @s) THEN
(IF ($spec SAVE @s) THEN
($say "Save succeeded.\n")
ELSE
($say "Save failed.\n")
)
)
($setp ($loc .ME) SEEN TRUE)
($setg MyLoc ($loc .ME))
;
restore(PREACT) = (Expect NO_OBJ NO_OBJ);
restore(ACTION) =
LOCAL s;
($say "Restore from which file? ")
($setg s ($read))
(IF ($leng @s) THEN
($say "\nRestoring ...\n")
($spec RESTORE @s)
{ If we make it to this point, the restore didn't happen }
($say "Restore failed.\n")
)
;
restart(PREACT) = (Expect NO_OBJ NO_OBJ);
restart(ACTION) =
($say "Are you sure you want to restart? ")
(IF ($yorn) THEN
($say "\n")
($spec RESTART)
)
;
script(PREACT) = (Expect NO_OBJ NO_OBJ);
script(ACTION) =
LOCAL s;
(IF @Scripting THEN
($spec SCRIPT 0)
($say "Scripting turned off.\n")
($setg Scripting FALSE)
ELSE
($say "Script to which file? ")
($setg s ($read))
(IF ($leng @s) THEN
($say "Scripting turned on.\n")
($spec SCRIPT @s)
($setg Scripting TRUE)
)
)
;
exit(PREACT) =
(Expect ($or ONE_OBJ PLAIN_OBJ) NO_OBJ)
(IF ($not ($eq @Dobj ($loc .ME))) THEN
(CheckAvail)
)
;
exit(ACTION) = ($say "But you're not in it.\n");
MESSAGE "---> Initializing dwimmer.\n" ;
{ (Dwimmer Obj) - returns 1 if the object is "possibly the one the
user meant." Returns 0 otherwise. }
Dwimmer =
LOCAL
Trans,
Opened,
CanSee,
i;
(IF ($eq ($verb) go) THEN
{ Try to find %1 in the list of Directions }
($setg i 0)
(WHILE ($lt @i 10) DO
(IF ($eq ($global ($plus _DirArray @i)) %1) THEN
{ We found it! }
($return TRUE)
)
($setg i ($plus @i 1))
)
{ If we get here, we didn't find it. }
($return 0)
ELSEIF ($eq ($verb) take) THEN
{ We don't want to look at stuff .ME is already carrying }
($setg Trans ($prop .ME TRANS))
($setg Opened ($prop .ME OPENED))
($setp .ME TRANS FALSE)
($setp .ME OPENED FALSE)
($setg CanSee (See %1 ($cont ($loc .ME))))
($setp .ME TRANS @Trans)
($setp .ME OPENED @Opened)
($return @CanSee)
ELSEIF ($eq ($verb) drop) THEN
{ We need to be transparent }
($setg Trans ($prop .ME TRANS))
($setg CanSee (See %1 ($cont .ME)))
($setp .ME TRANS @Trans)
($return @CanSee)
ELSE
{ This is the default case - it works pretty well }
($return ($or (See %1 ($cont .ME)) (See %1 ($cont ($loc .ME)))))
)
;