MESSAGE "\n stdproc.adl - version 5.0 - January 5, 2011\n" ;
MESSAGE " Copyright 1986-2011 by Ross Cunniff and Tim Brengle\n";
MESSAGE " Consult \"The ADL Programmer's Reference Manual\" for\n";
MESSAGE " information on using stdproc.adl\n\n" ;
/*
stdproc.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. stdproc.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 stdproc.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 = Proc(actor)
{
actor.ACTION = ActAction;
actor.NOTAKE = TRUE;
actor.SAVESENT = &LastVerb;
$actor(actor, 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 = Proc(obj)
{
Var
SavePlace, /* The value of $ME(SAVESENT) */
tLastDobj, /* The last DIRECT OBJECT typed */
tLastIobj, /* The last INDIRECT OBJECT typed */
tLastNumd; /* The previous NUMBER OF DIRECT OBJECTS typed */
/* Retrieve the pertinent info from SAVESENT */
SavePlace = $ME.SAVESENT;
If (!SavePlace) {
$say(_ItConfused);
$exit(1);
}
tLastNumd = (*SavePlace)[1];
tLastDobj = (*SavePlace)[3];
tLastIobj = (*SavePlace)[5];
If ((tLastDobj < 0) | (tLastIobj < 0) | (tLastNumd > 1)) {
/* No previous direct obj, or no previous indirect obj,
* or more than one direct obj */
$say(_ItConfused);
$exit(1);
}
If ((tLastDobj != 0) & (tLastIobj == 0)) {
*obj = tLastDobj;
}
Else If ((tLastIobj != 0) & (tLastDobj == 0)) {
*obj = tLastIobj;
}
Else {
$say(_ItConfused);
$exit(1);
}
}
/* ActAction() - the default Actor Action */
ActAction = Proc()
{
Var
SavePlace;
If (Verb == again) {
SavePlace = $ME.SAVESENT;
If (!SavePlace) {
"I can't do that.\n";
$exit(1);
}
If (Dobj | Iobj) {
"You may not use objects with 'again'.\n";
$exit(1);
}
If ((*SavePlace)[1] > 1) {
"You can't use 'again' with multiple direct objects.\n";
$exit(1);
}
Verb = (*SavePlace)[0];
Numd = (*SavePlace)[1];
Conj = (*SavePlace)[2];
Dobj = (*SavePlace)[3];
Prep = (*SavePlace)[4];
Iobj = (*SavePlace)[5];
exit(0);
}
If ((Dobj == it) & (Iobj != it)) {
FindIt(&Dobj);
}
Else If ((Iobj == it) & (Dobj != it)) {
FindIt(&Iobj);
}
Else If((Dobj == it) & (Iobj == it)) {
"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 = Proc()
{
If (Dobj > 0) {
Avail(Dobj);
}
If (Iobj > 0) {
Avail(Iobj);
}
}
/* Expect(DobjFlags, IobjFlags) - Checks for a valid sentence */
Expect = Proc(DobjFlags, IobjFlags)
{
/* Check the number of direct objects */
If (Numd == 0) {
If (!(DobjFlags & NO_OBJ)) {
"You must tell me what to ", $vname(Verb), _EOL;
$exit(3);
}
}
Else If ((Numd == 1) & (Dobj != all)) {
If (!(DobjFlags & (MULT_OBJ | ONE_OBJ))) {
"You may not use a direct object with ", $vname(Verb), _EOL;
$exit(1);
}
}
Else {
If (!(DobjFlags & MULT_OBJ)) {
"You may not use multiple direct objects with ",
$vname(Verb), _EOL;
$exit(1);
}
}
/* Check the number of Indirect objects */
If ((Iobj == 0) & !(IobjFlags & NO_OBJ)) {
"How would you like to do that?\n";
$exit(3);
}
Else If ((Iobj != 0) & !(IobjFlags & ONE_OBJ)) {
"You may not use an indirect object with ", $vname(Verb), _EOL;
$exit(1);
}
/* Check the type of the objects */
If ( ((Dobj < 0) & !(DobjFlags & STR_OBJ)) |
((Iobj < 0) & !(IobjFlags & STR_OBJ)))
{
"You may not use strings with ", $vname(Verb), _EOL;
$exit(1);
}
If ( ((Dobj > 0) & !(DobjFlags & PLAIN_OBJ)) |
((Iobj > 0) & !(IobjFlags & PLAIN_OBJ)) )
{
"You must use a string with ", $vname(Verb), _EOL;
$exit(1);
}
}
/* Preact - the default verb Preact */
Preact = Proc()
{
Expect(ONE_OBJ|PLAIN_OBJ, 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 = Proc(List, Propno)
{
Var
o;
o = List;
While (o) {
If (o.Propno) {
/* This is it! */
Return TRUE;
}
Else If (o.OPENED | o.TRANS) {
/* Look inside */
If (Visible($cont(o), Propno)) {
Return TRUE;
}
}
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 = Proc(Obj, Loc)
{
Var
o;
o = Loc;
While (o) {
If (Obj == o) {
/* This is the one! */
Return TRUE;
}
Else If (o.OPENED) {
/* Still explore inside */
If (Reach(Obj, $cont(o))) {
Return TRUE;
}
}
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 = Proc(Obj, Loc)
{
Var
o;
If (Dark) {
/* Can't see in a dark room! */
Return FALSE;
}
o = Loc;
While (o) {
If (Obj == o) {
/* This is the one! */
Return TRUE;
}
Else If (o.TRANS | o.OPENED) {
/* Still explore inside */
If (See(Obj, $cont(o))) {
Return TRUE;
}
}
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 = Proc(Obj)
{
If (!Obj) {
"The what?\n";
$exit(1);
}
Else If (!(See(Obj, $cont($loc($ME))) | See(Obj,$cont($ME)))) {
"I can't see that item here.\n";
$exit(1);
}
Else If (!(Reach(Obj, $cont($loc($ME))) | Reach(Obj,$cont($ME)))) {
"I can't get at that item.\n";
$exit(1);
}
Return TRUE;
}
/* Lit(Room) - Returns TRUE IFF Room is lit */
Lit = Proc(Room)
{
If (Room.LIGHT) {
/* Intrinsically lit */
Return TRUE;
}
Else If (Visible($cont(Room), LIGHT) | Visible($cont(Room), FLAME)) {
Return TRUE; /* I can see a light */
}
Else If (Visible($cont($ME), LIGHT) | Visible($cont($ME), FLAME)) {
Return TRUE; /* I have a light */
}
Else {
Return FALSE;
}
}
/* Blank(num) - Type 2*n blanks */
Blank = Proc(num)
{
Var
idx;
If (!Indent) Return;
idx = num;
While (idx > 0) {
" ";
idx = idx - 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 = Proc(Level, Obj, Rout)
{
If (!Obj) {
/* Null list */
Return 0;
}
Else If (!Level) {
/* Level 0 == This is a room. Check lighting */
Conts = FALSE;
If (Lit(Obj)) {
Dark = FALSE; /* Can't be dark in a lit room! */
(Rout(Obj))(); /* Talk about the room */
If (!Dark) {
Describe(1, $cont(Obj), Rout); /* Talk about its contents */
}
}
Else {
"It's mighty dark in here!\n";
Dark = TRUE;
}
}
Else {
/* Level > 0 == This is a list of objs */
If (Rout(Obj)) {
/* Talk (only) about the visible */
If ((Rout == $sdesc) & !Conts) {
Blank(Level - 1);
"You can see:\n";
}
Conts = TRUE;
Blank(Level); /* Indent */
(Rout(Obj))(); /* Blurb the object */
If ($cont(Obj)) {
/* something inside it...*/
If (Obj.OPENED | Obj.TRANS) {
If (Rout == $ldesc) {
Blank(Level);
"It contains:\n";
}
Else {
", containing\n";
}
Obj.SEEN = TRUE;
/*Short descs for conts*/
Describe(Level+1, $cont(Obj), $sdesc);
}
Else If (Rout == $sdesc) {
$say(_CR);
}
}
Else If (Rout == $sdesc) {
$say(_CR);
}
}
Describe(Level, $link(Obj), Rout);
}
}
/* SaveSentence() - save the value of the current sentence */
SaveSentence = Proc()
{
Var SavePlace;
SavePlace = $ME.SAVESENT;
If (!SavePlace) {
Return 0;
}
(*SavePlace)[0] = Verb;
(*SavePlace)[1] = Numd;
(*SavePlace)[2] = Conj;
(*SavePlace)[3] = Dobj;
(*SavePlace)[4] = Prep;
(*SavePlace)[5] = Iobj;
}
/* Prompter() - print out a user prompt. Usually only mentioned
in ($prompt Prompter) in START */
Prompter = Proc()
{
"> ";
}
/* Looker() - The standard Looking daemon. Usually only mentioned
in START. */
Looker = Proc()
{
$ME.TRANS = FALSE;
MyConj = FALSE;
First = TRUE;
IobjSave = NULL;
AllSeen = FALSE;
If (MyLoc != $loc($ME)) {
If ($loc($ME).SEEN & !Verbose) {
Describe(0, $loc($ME), $sdesc);
}
Else {
$sdesc($loc($ME))();
Describe(0, $loc($ME), $ldesc);
$loc($ME).SEEN = TRUE;
}
If (Dark) {
$loc($ME).SEEN = FALSE;
}
MyLoc = $loc($ME);
}
$ME.TRANS = TRUE;
$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 = Proc(Obj)
{
Var
Curr;
If (Obj == all) {
/* The player typed something like "take all but all" */
"I don't understand that.\n";
$exit(1);
}
Curr = MultList;
If (Curr == Obj) {
/* Delete the head of the list */
MultList = Curr.AllLink;
}
Else {
/* It's somewhere in the middle of the list */
While (Curr) {
If (Curr.AllLink == Obj) {
Curr.AllLink = Curr.AllLink.AllLink;
Return 0;
}
Curr = Curr.AllLink;
}
/* If we make it here, $1 wasn't on the list to begin with. */
"", _YouSeeNo, $name($1), " here.\n";
$exit(1);
}
}
/* AddList(Obj) -- Adds Obj to the list of multiple direct objects */
AddList = Proc(Obj)
{
If (Obj == all) {
/* The player typed something like "Take rock and all" */
"I don't understand that.\n";
$exit(1);
}
Obj.AllLink = MultList;
MultList = Obj;
}
/* InitList(Where) -- Adds each object contained in Where to MultList */
InitList = Proc(Where)
{
Var
Curr;
MultList = NULL;
AllSeen = TRUE;
Curr = Where;
While (Curr) {
If (!Curr.NOTAKE) {
Curr.AllLink = MultList;
MultList = Curr;
}
Curr = $link(Curr);
}
}
/* Mover(Where,String) - Moves each object on MultList to Where, printing
String as it does so. */
Mover = Proc(Where, String)
{
If (!MultList) {
"There is nothing to ", $vname(Verb), _EOL;
$exit(1);
}
While (MultList) {
Dobj = MultList;
Iobj = IobjSave;
Skip = FALSE;
$action(Dobj)(); /* Call the ACTION routines */
If (!Skip) {
$action(Iobj)(); /* for the Dobj and Iobj */
}
If (!Skip) { /* Call the ACTIONs for the verb */
If (Verb == take) {
TakeAct();
}
Else {
/* Verb == drop */
DropAct();
}
}
If (!Skip) {
$move(Dobj, Where); /* Do the moving */
" ", $name(Dobj), " - ", String, _CR;
}
MultList = MultList.AllLink;
}
}
/* CheckLoc(Obj,Where) - Checks whethere Obj can be seen on Where
and can be reached on Where */
CheckLoc = Proc(Obj, Where)
{
If (!See(Obj, Where)) {
If (Where == $cont($ME)) {
"You have no ", $name(Obj), _EOL;
}
Else {
"", _YouSeeNo, $name(Obj), " here.\n";
}
$exit(1);
}
Else If (!Reach(Obj, Where)) {
"You can't reach the ", $name(Obj), _EOL;
$exit(1);
}
}
/* TorDPRE(Where) -- Uses Where as the context for a multiple
direct object (with "all" as a possible object) list. */
TorDPRE = Proc(Where)
{
If (!First) {
/* The MultList is initialized */
If (Conj) {
If (!AllSeen) {
/* The player typed something like "take a, b but c" */
"I don't understand that.\n";
$exit(1);
}
MyConj = TRUE;
}
If (MyConj) { /* We have seen "but" in the sentence */
DelList(Dobj); /* so delete this object from the list */
}
Else { /* We have NOT seen "but" */
CheckLoc(Dobj, Where); /* 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 (Dobj == all) {
InitList(Where); /* 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, Where); /* be the direct object. */
MultList = Dobj;
Dobj.AllLink = NULL;
}
First = FALSE;
MyConj = FALSE;
NumSeen = 1;
}
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 = Proc(Where, String)
{
If (Numd <= NumSeen) {
Mover(Where, String);
}
Else {
NumSeen = 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 ) = Proc()
{
Var
i;
Expect(ONE_OBJ|PLAIN_OBJ, NO_OBJ);
/* Try to find the Dobj in the list of Directions */
i = 0;
While (i < 10) {
If (_DirArray[i] == $dobj()) {
/* We found it. Set the Verb and Dobj appropriately */
Verb = -$modif($dobj());
Dobj = 0;
$vprop($verb(), PREACT)();
Return 0;
}
i = i + 1;
}
/* If we get here, we didn't find the Dobj */
"", _Huh;
$exit(1);
}
Silly = Proc()
{
"That's silly!\n";
$exit(1);
}
NOVERB( PREACT ) = Proc()
{
If (Dobj > 0) {
"What do you want to do with the ", $name(Dobj), "?\n";
$exit(3);
}
Else If (Dobj < 0) {
"", _MeanMsg, Dobj, "\"?\n";
$exit(3);
}
Else If (Iobj > 0) {
"What to you want to do ", $pname(Prep), " the ", $name(Iobj), "?\n";
$exit(3);
}
Else If (Iobj < 0) {
"", _MeanMsg, Iobj, "\"?\n";
$exit(3);
}
Else {
"I beg your pardon?\n";
$exit(1);
}
}
wait( PREACT ) = Proc()
{
Expect(NO_OBJ, NO_OBJ);
"Time passes...\n";
$exit(1);
}
wear( PREACT ) = Preact;
wear( ACTION ) = Silly;
remove( PREACT ) = Preact;
remove( ACTION ) = Silly;
verbose( PREACT ) = Proc() { Expect(NO_OBJ, NO_OBJ); }
verbose( ACTION ) = Proc()
{
"Maximum verbosity.\n";
Verbose = TRUE;
}
terse( PREACT ) = Proc() { Expect(NO_OBJ, NO_OBJ); }
terse( ACTION ) = Proc()
{
"Minimum verbosity.\n";
Verbose = FALSE;
}
take( PREACT ) = Proc()
{
Expect(ONE_OBJ|MULT_OBJ|PLAIN_OBJ, NO_OBJ|ONE_OBJ|PLAIN_OBJ);
If (Iobj) {
If (!Prep) {
/* The sentence was "take X Y" */
$say(_Huh);
$exit(1);
}
If (Iobj.OPENED) {
TorDPRE($cont(Iobj), "take");
}
Else {
"You can't reach into the ", $name(Iobj), _CR;
$exit(1);
}
}
Else {
$ME.OPENED = FALSE; $ME.TRANS = FALSE;
TorDPRE($cont($loc($ME)), "take");
$ME.OPENED = TRUE; $ME.TRANS = TRUE;
}
}
take( ACTION ) = Proc() { TorDACT($ME, "taken"); }
drop( PREACT ) = Proc()
{
Expect(ONE_OBJ|MULT_OBJ|PLAIN_OBJ, NO_OBJ|ONE_OBJ|PLAIN_OBJ);
If (Iobj) {
If (!Prep) {
/* The sentence was "drop X Y" */
$say(_Huh);
$exit(1);
}
If (!Iobj.OPENED) {
"You can't put that into the ", $name(Iobj), _EOL;
$exit(1);
}
IobjSave = Iobj;
Iobj = 0;
}
TorDPRE($cont($ME), "drop");
}
drop( ACTION ) = Proc()
{
If (IobjSave) {
TorDACT(IobjSave, _Dropped);
}
Else {
TorDACT($loc($ME), _Dropped);
}
}
put( PREACT ) = Proc() { Verb = drop; $vprop(drop, PREACT)(); }
get( PREACT ) = Proc() { Verb = take; $vprop(take, PREACT)(); }
open( PREACT ) = Preact;
open( ACTION ) = Proc()
{
If (!$dobj().OPENS) {
"I don't know how to open that!\n";
$exit(1);
}
Else If ($dobj().LOCKS & $dobj().LOCKED) {
"I can't open it, it's locked!\n";
$exit(1);
}
Else If ($dobj().OPENED) {
"It's already open!\n";
$exit(1);
}
Else {
$dobj().OPENED = TRUE;
If (($cont($dobj()) != 0) & !$dobj().TRANS) {
"Opening the ", $name(Dobj), " reveals:\n";
Describe(1, $cont($dobj()), $sdesc);
}
Else {
"Opened.\n";
}
}
}
close( PREACT ) = Preact;
close( ACTION ) = Proc()
{
If (!$dobj().OPENS) {
"I don't know how to close that!\n";
$exit(1);
}
Else If (!$dobj().OPENED) {
"It's already closed!\n";
$exit(1);
}
Else {
$dobj().OPENED = FALSE;
"Closed.\n";
}
}
Lockact = Proc()
{
If ($dobj().LOCKS) {
"Hmm, you don't seem to have the right key.\n";
}
Else {
"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 ) = Proc() {"Nothing seems to happen.\n";}
break( PREACT ) = Preact;
break( ACTION ) = Proc() {"It seems to be unbreakable.\n";}
touch( PREACT ) = Preact;
touch( ACTION ) = Proc()
{
"Touching the ", $name($dobj()), " doesn't seem too useful.\n";
}
rub( PREACT ) = Preact;
rub( ACTION ) = Proc()
{
"Nothing happens when you rub the ", $name($dobj()), _EOL;
}
throw( PREACT ) = Preact;
throw( ACTION ) = Proc() { $move($dobj(), $loc($ME)); "Thrown.\n"; }
turn( PREACT ) = Preact;
turn( ACTION ) = Silly;
light( PREACT ) = Preact;
light( ACTION ) = Silly;
douse( PREACT ) = Preact;
douse( ACTION ) = Silly;
read( PREACT ) = Proc()
{
Expect(ONE_OBJ|PLAIN_OBJ, NO_OBJ|ONE_OBJ|PLAIN_OBJ);
If (!(See($dobj(), $cont($ME)) | See($dobj(), $cont($loc($ME))))) {
"You don't see that here.\n";
$exit(1);
}
}
read( ACTION ) = Proc() { "It doesn't have anything on it to read.\n"; }
burn( PREACT ) = Preact;
burn( ACTION ) = Proc() { "That doesn't seem to work.\n"; }
examine( PREACT ) = Preact;
examine( ACTION ) = Proc()
{
"You see nothing special about the ", $name(Dobj), _EOL;
}
look( PREACT ) = Proc()
{
Expect(NO_OBJ, NO_OBJ|ONE_OBJ|PLAIN_OBJ);
CheckAvail();
}
look( ACTION ) = Proc() { Describe(0, $loc($ME), $ldesc); }
inventory( PREACT ) = Proc() { Expect(NO_OBJ, NO_OBJ); }
inventory( ACTION ) = Proc()
{
If (!$cont($ME)) {
"You are empty-handed.\n";
$exit(1);
}
$ME.SEEN = TRUE;
"You are carrying:\n";
Conts = TRUE;
Describe(1, $cont($ME), $sdesc);
}
quit( PREACT ) = Proc() { Expect(NO_OBJ, NO_OBJ); }
quit( ACTION ) = Proc()
{
"Are you sure that you want to quit? ";
If ($yorn()) {
$spec(QUIT);
}
}
save( PREACT ) = Proc() { Expect(NO_OBJ, NO_OBJ); }
save( ACTION ) = Proc()
{
Var
str;
MyLoc = -1;
$loc($ME).SEEN = FALSE;
"Save to which file? ";
str = $read();
If ($leng(str)) {
If ($spec(SAVE, str)) {
"Save succeeded.\n";
}
Else {
"Save failed.\n";
}
}
$loc($ME).SEEN = TRUE;
MyLoc = $loc($ME);
}
restore( PREACT ) = Proc() { Expect(NO_OBJ, NO_OBJ); }
restore( ACTION ) = Proc()
{
Var
str;
"Restore from which file? ";
str = $read();
If ($leng(str)) {
$spec(RESTORE, str);
/* If we make it to this point, the restore didn't happen */
"Restore failed.\n";
}
}
restart( PREACT ) = Proc() { Expect(NO_OBJ, NO_OBJ); }
restart( ACTION ) = Proc()
{
"Are you sure that you want to restart? ";
If ($yorn()) {
$spec(RESTART);
}
}
script( PREACT ) = Proc() { Expect(NO_OBJ, NO_OBJ); }
script( ACTION ) = Proc()
{
Var
str;
If (Scripting) {
$spec(SCRIPT, 0);
"Scripting turned off.\n";
Scripting = FALSE;
}
Else {
"Script to which file? ";
str = $read();
If ($leng(str)) {
"Scripting turned on.\n";
$spec(SCRIPT, str);
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 = Proc(Obj)
{
Var
Trans,
Opened,
CanSee,
i;
If ($verb() == go) {
/* Try to find Obj in the list of Directions */
i = 0;
While (i < 10) {
If (_DirArray[i] == Obj) {
/* We found it! */
Return TRUE;
}
i = i + 1;
}
/* If we get here, we didn't find it. */
Return 0;
}
Else If ($verb() == take) {
/* We don't want to look at stuff $ME is already carrying */
Trans = $ME.TRANS; Opened = $ME.OPENED;
$ME.TRANS = FALSE; $ME.OPENED = FALSE;
CanSee = See(Obj, $cont($loc($ME)));
$ME.TRANS = Trans; $ME.OPENED = Opened;
Return CanSee;
}
Else If ($verb() == drop) {
/* We need to be transparent */
Trans = $ME.TRANS;
CanSee = See(Obj, $cont($ME));
$ME.TRANS = Trans;
Return CanSee;
}
Else {
/* This is the default case - it works pretty well */
Return See(Obj, $cont($ME)) | See(Obj, $cont($loc($ME)));
}
}
Die = Proc()
{
Var
Str;
"Do you want to RESTART, RESTORE, or QUIT? ";
While (TRUE) {
Str = $read();
IF ((Str ?= "restart") | (Str ?= "RESTART")) {
$spec(RESTART);
}
Else If ((Str ?= "restore") | (Str ?= "RESTORE")) {
/* Execute restore.ACTION */
$vprop(restore, ACTION)();
}
Else If ((Str ?= "quit") | (Str ?= "QUIT")) {
$spec(QUIT);
}
Else {
"Do you want to RESTART, RESTORE, or QUIT? ";
}
}
}
MESSAGE "Done with Dwimmer. Done with stdproc.adl\n";
/**** EOF stdProc.adl ****/