MESSAGE "\n	standard.adl - version 3.1 - June 20, 1987\n"		;
MESSAGE "	Copyright (c) 1986, 1987 by Ross Cunniff\n"		;
{
	standard.adl - a set of ADL definitions intended to make
	ADL programs conform to the standard set in the document
	"ADL Player's Handbook" by Brengle and Cunniff.  standard.adl
	should be portable to all ADL implementations, and should
	work elegantly and efficiently, encouraging its use by programmers.
	The following is the "interface" to standard.adl.  It tells
	what is defined in this file.
}


{  *** Boolean Object Properties *** }

SEEN    = 16;		{ I've been here / seen this }
OPENS   = 15;		{ This can be opened }
LOCKS   = 14;		{ This can be locked }
OPENED  = 13;		{ This is opened }
LOCKED  = 12;		{ This is locked }
TRANS   = 11;		{ This is transparent }
LIGHT   = 10;		{ This gives off light }
FLAME   = 9;		{ This is on fire }
NOTAKE  = 8;		{ Ignore this object for "take" }

{ The other 6 boolean properties are available to the user. }


{  *** Integer Object Properties *** }

AllLink = 29;		{ Link for objects used with "take" and "drop" }
SAVESENT = 28;		{ First VAR in a sentence save area }

{ The other 11 integer properties are available to the user }



{ *** Useful Constants *** }

TRUE  = 1;
FALSE = 0;
NULL  = 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 }



{ *** $spec commands *** }

DEBUG	= 1;
RESTART	= 2;
QUIT	= 3;
SAVE	= 4;
RESTORE	= 5;
EXEC	= 6;
PRESERVE= 7;
SCRIPT	= 8;
HEADER	= 9;
MARGIN	= 10;



{ *** Global Variables *** }

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? }

    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? }



{ *** Objects *** }

NOUN
    all,		{ Used only in sentences with take and drop }
    it;			{ Refers to the last Dobj or Iobj typed }


{ *** Verbs - NOTE: do not change the PREACT or ACTION of any of these
  without carefully considering the consequences *** }

VERB
    n,  s,  e,  w,
    ne, se, nw, sw,
    up, down,
    enter, exit,
    get, put, take, drop,
    wear, remove,
    verbose, terse,
    open, close,
    lock, unlock,
    move, break, rub, touch,
    throw, read, burn,
    examine, look, inventory,
    quit, restart,
    save, restore, script,
    turn, douse, light,
    wait, again, go;


{ Verb equivalences }

g	  = again;
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;


MESSAGE "Done with Standard Interface - proceeding to Utility 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 seem to figure out what you mean by 'it'.\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)))

    (IF ($or ($lt @LastDobj 0) ($lt @LastIobj 0) ($gt @LastNumd 1)) THEN
	($say ItConfused)
	($exit 1)
    )
    (IF ($and ($ne @LastDobj 0) ($eq @LastIobj 0)) THEN
	($setg %1 @LastDobj)
     ELSEIF ($and ($ne @LastIobj 0) ($eq @LastDobj 0)) THEN
	($setg %1 @LastIobj)
     ELSE
	($say ItConfused)
	($exit 1)
    )
;



{  ActAction - the default Actor Action }

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 @Iobj 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)
    )
;



{ Preact - the default verb Preact }
Preact =
    (Expect ($or ONE_OBJ PLAIN_OBJ) ($or NO_OBJ ONE_OBJ PLAIN_OBJ))
    (CheckAvail)
;



{ (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)) THEN	{ Look inside }
	(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 ($prop %2 OPENED) THEN		{ Still explore inside }
	(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)                 { Still explore inside }
		  ($prop %2 OPENED))
     THEN
	(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 item 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 }

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)) 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 ($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 }

SaveSentence =
LOCAL SavePlace;
    ($setg SavePlace ($prop .ME SAVESENT))
    (IF ($not @SavePlace) THEN
	($return 0)
    )
    ($setg @SavePlace @Verb)
    ($setg ($plus @SavePlace 1) @Numd)
    ($setg ($plus @SavePlace 2) @Conj)
    ($setg ($plus @SavePlace 3) @Dobj)
    ($setg ($plus @SavePlace 4) @Prep)
    ($setg ($plus @SavePlace 5) @Iobj)
;



{ (Prompter) - print out a user prompt.  Usually only mentioned
  in ($prompt Prompter) in START }

Prompter =
    ($say "> ")
;



{ (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 }

InitList =
LOCAL Curr;
    ($setg MultList NULL)
    ($setg AllSeen TRUE)
    ($setg Curr %1)
    (WHILE @Curr DO
	(IF ($not ($prop @Curr NOTAKE)) THEN
	    ($setp @Curr AllLink @MultList)
	    ($setg MultList @Curr)
	)
	(Next Curr)
    )
;



{ (Mover Where String) - Moves each object on MultList to Where, printing
  String as it does so. }

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 }
	    ($say "  " ($name @Dobj) " - " %2 "\n")
	)
	($setg MultList ($prop @MultList AllLink))
    )
;



{ (CheckLoc Obj Where) -  Checks whethere 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 ($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" }

TorDACT =
    (IF ($le @Numd @NumSeen) THEN
	(Mover %1 %2)
     ELSE
	($setg NumSeen ($plus @NumSeen 1))
    )
;



MESSAGE "Done with Utility Routines.  Begin predefined verbs.\n";



{ 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)
;


Silly =
    ($say "That's silly!\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)
    )
;

wait( PREACT ) =
    (Expect NO_OBJ NO_OBJ)
    ($say "Time passes...\n")
    ($exit 1)
;
   
wear( PREACT ) = Preact;
wear( ACTION ) = Silly;

remove( PREACT ) = Preact;
remove( ACTION ) = Silly;

verbose( PREACT ) = (Expect NO_OBJ NO_OBJ);
verbose( ACTION ) =
    ($say "Maximum verbosity.\n")
    ($setg Verbose TRUE)
;

terse( PREACT ) = (Expect NO_OBJ NO_OBJ);
terse( ACTION ) =
    ($say "Minimum verbosity.\n")
    ($setg Verbose FALSE)
;


take( PREACT ) =
    (Expect ($or ONE_OBJ MULT_OBJ PLAIN_OBJ) ($or NO_OBJ ONE_OBJ PLAIN_OBJ))
    ($setp .ME OPENED TRUE)
    ($setp .ME TRANS TRUE)
    (IF @Iobj THEN
	(IF ($prop @Iobj OPENED) THEN
	    (TorDPRE ($cont @Iobj) "take")
	 ELSE
	    ($say "You can't reach into the " ($name @Iobj) "\n")
	    ($exit 1)
	)
     ELSE
	(TorDPRE ($cont ($loc .ME)) "take")
    )
;
take( ACTION ) =
    (TorDACT .ME "taken")
;

drop( PREACT ) = 
    (Expect ($or ONE_OBJ MULT_OBJ PLAIN_OBJ) ($or NO_OBJ ONE_OBJ PLAIN_OBJ))
    (IF @Iobj THEN
	($setg IobjSave @Iobj)
	($setg Iobj 0)
    )
    (TorDPRE ($cont .ME) "drop")
;
drop( ACTION ) =
    (IF @IobjSave THEN
	(TorDACT @IobjSave "dropped")
     ELSE
	(TorDACT ($loc .ME) "dropped")
    )
;


put( PREACT ) =
    ($setg Verb drop)
    (($vprop drop PREACT))
;
get( PREACT ) =
    ($setg Verb take)
    (($vprop take PREACT))
;


open( PREACT ) = Preact;
open( ACTION ) =
    (IF ($not ($prop ($dobj) OPENS)) THEN
	($say "I don't know how to open that!\n")
	($exit 1)
     ELSEIF ($and ($prop ($dobj) LOCKS) ($prop ($dobj) LOCKED)) THEN
	($say "I can't open it, it's locked!\n")
	($exit 1)
     ELSEIF ($prop ($dobj) OPENED) THEN
	($say "It's already open!\n")
	($exit 1)
     ELSE
	($setp ($dobj) OPENED TRUE)
	(IF ($and  ($ne ($cont ($dobj)) 0) ($not ($prop ($dobj) TRANS))) THEN
	    ($say "Opening the " ($name @Dobj) " reveals:\n")
	    (Describe 1 ($cont ($dobj)) $sdesc)
	 ELSE
	    ($say "Opened.\n")
	)
    )
;


close( PREACT ) = Preact;
close( ACTION ) =
    (IF ($not ($prop ($dobj) OPENS)) THEN
	($say "I don't know how to close that!\n")
	($exit 1)
     ELSEIF ($not ($prop ($dobj) OPENED)) THEN
	($say "It's already closed!\n")
	($exit 1)
     ELSE
	($setp ($dobj) OPENED FALSE)
	($say "Closed.\n")
    )
;


Lockact =
    (IF ($prop ($dobj) LOCKS) THEN
	($say "Hm, you don't seem to have the right key.\n")
     ELSE
	($say "I don't know how to lock or unlock such a thing.\n")
    )
;

lock( PREACT ) = Preact;
lock( ACTION ) = Lockact;

unlock( PREACT) = Preact;
unlock( ACTION ) = Lockact;


move( PREACT ) = Preact;
move( ACTION ) = ($say "Nothing seems to happen.\n");


break( PREACT ) = Preact;
break( ACTION ) = ($say "It seems to be unbreakable.\n");


touch( PREACT ) = Preact;
touch( ACTION ) =
    ($say "Touching the " ($name ($dobj)) " doesn't seem too useful.\n")
;

rub( PREACT ) = Preact;
rub( ACTION ) =
    ($say "Nothing happens when you rub the " ($name ($dobj)) ".\n")
;


throw( PREACT ) = Preact;
throw( ACTION ) =
    ($move ($dobj) ($loc .ME))
    ($say "Thrown.\n")
;


turn( PREACT ) = Preact;
turn( ACTION ) = Silly;

light( PREACT ) = Preact;
light( ACTION ) = Silly;

douse( PREACT ) = Preact;
douse( ACTION ) = Silly;

read( PREACT ) =
    (Expect ($or ONE_OBJ PLAIN_OBJ) ($or NO_OBJ ONE_OBJ PLAIN_OBJ))
    (IF ($not ($or (See ($dobj) ($cont .ME)) (See ($dobj) ($cont ($loc .ME)))))
     THEN
	($say "You don't see that here.\n")
	($exit 1)
    )
;
read( ACTION ) = ($say "It doesn't have anything on it to read.\n");


burn( PREACT ) = Preact;
burn( ACTION ) =
    ($say "That doesn't seem to work.\n")
;


examine( PREACT ) = Preact;
examine( ACTION ) =
    ($say "You see nothing special about the " ($name @Dobj) ".\n")
;


look( PREACT ) =
    (Expect NO_OBJ ($or NO_OBJ ONE_OBJ PLAIN_OBJ))
    (CheckAvail)
;
look( ACTION ) =
    (Describe 0 ($loc .ME) $ldesc)
;


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 that you want to quit? ")
    (IF ($yorn) THEN
	($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
	($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 that you want to restart? ")
    (IF ($yorn) THEN
	($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)
	)
    )
;


MESSAGE "Done initializing verb routines.  Starting 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)))))
    )
;

{*** EOF standard.adl ***}