ADL Scenario Source Code

    MESSAGE "\n	standard.adl - version 3.3 - April 29, 1992\n"	;
    MESSAGE "	Copyright 1986-1992 by Ross Cunniff and Tim Brengle\n";
    MESSAGE "	Consult \"The ADL Programmer's Reference Manual\" for\n";
    MESSAGE "	information on using standard.adl\n\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 ***

    BITPROP
    	SEEN,		// I've been here / seen this
    	OPENS,		// This can be opened
    	LOCKS,		// This can be locked
    	OPENED,		// This is opened
    	LOCKED,		// This is locked
    	TRANS,		// This is transparent
    	LIGHT,		// This gives off light
    	FLAME,		// This is on fire
    	NOTAKE;		// Ignore this object for "take"

    // The other boolean properties are available to the user.

    //  *** Integer Object Properties ***

    // PROPERTY LDESC, SDESC, ACTION;
    PROPERTY
    	AllLink,	// Link for objects used with "take" and "drop"
    	SAVESENT;	// First VAR in a sentence save area

    // The other integer properties are available to the user

    /* *** Useful Constants *** */

    TRUE  = 1;
    FALSE = 0;
    NULL  = 0;

    /* *** Strings used more than once *** */
    _YouSeeNo = "You see no ";
    _Huh = "Huh?\n";
    _CR	= "\n";
    _EOL	= ".\n";
    _MeanMsg = "What do you mean by \"";
    _ItConfused = "I can't seem to figure out what you mean by 'it'.\n";
    _Dropped = "dropped";

    /* *** 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;

    ACT_TTY	= 11;		/* Set an actor's tty */
    CURR_TTY= 12;		/* Change the tty to the given actor's tty */
    VECSIZE	= 13;		/* Change the size of the transition vector */

    /* *** 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 with 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 */

    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 ($and ($eq @Dobj 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) _EOL)
    	    ($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) _EOL)
    	    ($exit 1)
    	)
         ELSE
    	(IF ($not ($and $1 MULT_OBJ)) THEN
    	    ($say "You may not use multiple direct objects with "
    			($vname @Verb) _EOL)
    	    ($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) _EOL)
    	($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) _EOL)
    	($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 a string with " ($vname @Verb) _EOL)
    	($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 =
        LOCAL o;

        ($setg o $1)
        (WHILE @o DO
    	(IF ($prop @o $2) THEN				/* This one is it! */
    	    ($return TRUE)
    	 ELSEIF ($or ($prop @o OPENED) ($prop @o TRANS)) THEN	/* Look inside */
    	    (IF (Visible ($cont $1) $2) THEN
    	 	($return TRUE)
    	    )
    	)
    	($setg o ($link @o))	/* See if siblings satisfy Visible */
        )
        ($return FALSE)
    ;

    /* (Reach Obj Loc) - returns 1 IFF Obj == Loc, or can (recursively) be
      reached via the Loc */

    Reach =
        LOCAL o;

        ($setg o $2)
        (WHILE @o DO
    	(IF ($eq $1 @o) THEN			/* This is the one! */
    	    ($return TRUE)
    	 ELSEIF ($prop @o OPENED) THEN		/* Still explore inside */
    	    (IF (Reach $1 ($cont @o)) THEN
    		($return TRUE)
    	    )
    	)
    	($setg o ($link @o))			/* See if siblings can reach */
        )
        ($return FALSE)
    ;

    /* (See Obj Loc) - returns 1 IFF the Obj == Loc, or can be reached
      via the Loc (similar to Reach, above) */

    See =
        LOCAL o;

        (IF @Dark THEN			/* Can't see in a dark room! */
    	($return FALSE)
        )
        ($setg o $2)
        (WHILE @o DO
    	(IF ($eq $1 @o) THEN		/* This is the one! */
    	    ($return TRUE)
    	 ELSEIF ($or  ($prop @o TRANS) ($prop @o OPENED)) THEN
    	    /* Still explore inside */
    	    (IF (See $1 ($cont @o)) THEN
    		($return TRUE)
    	    )
    	)
    	($setg o ($link @o))		/* See whether siblings can see */
        )
        ($return FALSE)
    ;

    /* (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 _CR)
    		)
    	     ELSEIF ($eq $3 $sdesc) THEN
    		($say _CR)
    	    )
    	)
    	(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 _YouSeeNo ($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) _EOL)
    	($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 _CR)
    	)
    	($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) _EOL)
    	 ELSE
    	    ($say _YouSeeNo ($name $1) " here.\n")
    	)
    	($exit 1)
         ELSEIF ($not (Reach $1 $2)) THEN
    	($say "You can't reach the " ($name $1) _EOL)
    	($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.  Proceeding with Normal 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)
        ($exit 1)
    ;

    Silly =
        ($say "That's silly!\n")
        ($exit 1)
    ;

    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 ($not @Prep) THEN
    	    /* The sentence was "take X Y" */
    	    ($say _Huh)
    	    ($exit 1)
    	)
    	(IF ($prop @Iobj OPENED) THEN
    	    (TorDPRE ($cont @Iobj) "take")
    	 ELSE
    	    ($say "You can't reach into the " ($name @Iobj) _CR)
    	    ($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
    	(IF ($not @Prep) THEN
    	    /* The sentence was "drop X Y" */
    	    ($say _Huh)
    	    ($exit 1)
    	)
    	(IF ($not ($prop @Iobj OPENED)) THEN
    	    ($say "You can't put that into the " ($name @Iobj) _EOL)
    	    ($exit 1 )
    	)
    	($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)) _EOL)
    ;

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

    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 with Normal Verbs.  Proceeding with 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)))))
        )
    ;

    Die =
    LOCAL Str;
        ($say "Do you want to RESTART, RESTORE, or QUIT? ")
        (WHILE TRUE DO
    	($setg Str ($read))
    	(IF ($or ($eqst @Str "restart") ($eqst @Str "RESTART")) THEN
    	    ($spec RESTART)
    	 ELSEIF ($or ($eqst @Str "restore") ($eqst @Str "RESTORE")) THEN
    	    /* Execute restore.ACTION */
    	    (($vprop restore ACTION))
    	 ELSEIF ($or ($eqst @Str "quit") ($eqst @Str "QUIT")) THEN
    	    ($spec QUIT)
    	 ELSE
    	    ($say "Do you want to RESTART, RESTORE, or QUIT? ")
    	)
        )
    ;

    MESSAGE "Done with Dwimmer.  Done with standard.adl\n";

    /**** EOF standard.adl ****/