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 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 } { *** $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? } 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 } { *** Verbs *** } 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 } 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))) (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 @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) ) ; { 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) ($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 } 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. } Prompter = ($say "\n> ") ; { (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. (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" } TorDACT = (IF ($le @Numd @NumSeen) THEN (Mover %1 %2) ELSE ($setg NumSeen ($plus @NumSeen 1)) ) ; MESSAGE "---> 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) ; { 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") ) ; ClS = ($say "\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\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) ) ; wait(PREACT) = (Expect NO_OBJ NO_OBJ); wait(ACTION) = ($say "Time passes...\n"); 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 ($eq ($loc @Dobj) .ME) THEN ($say "You already have the " ($name @Dobj) ".\n") ($exit 1) ) (IF @Iobj THEN (IF ($or ($prop @Iobj OPENED) ($prop @Iobj INCAP) ($prop @Iobj ONCAP) ) 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 (CheckAvail) ($setg IobjSave @Iobj) ($setg Iobj 0) ) (TorDPRE ($cont .ME) "drop") ; drop(ACTION) = (IF @IobjSave THEN (IF ($eq @Prep in) THEN (IF ($or ($prop @IobjSave OPENED) ($prop @IobjSave INCAP)) THEN (TorDACT @IobjSave "OK") ELSE ($say "I can't reach into it.\n") ) ELSEIF ($eq @Prep on) THEN (IF ($prop @IobjSave ONCAP) THEN (TorDACT @IobjSave "OK") ELSE ($say "There is no good surface on it.\n") ) ELSE ($say "You can only put things IN or ON something.\n") ) ELSE (TorDACT ($loc .ME) "dropped") ) ; put(PREACT) = ($setg Verb drop) (($vprop drop PREACT)) { You need double brackets } ; { I can't figure out why } 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 ($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") ($setg Conts TRUE) (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") ) ; lock(PREACT) = Preact; lock(ACTION) = ($say "You can't lock this.\n"); unlock(PREACT) = Preact; unlock(ACTION) = ($say "You can't unlock this.\n"); move(PREACT) = Preact; move(ACTION) = ($say "Nothing seems to happen.\n"); break(PREACT) = Preact; break(ACTION) = ($say "There seems to be no way to do so.\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) = (IF @Iobj THEN ($say "It bounces off the " ($name @Iobj) ", then falls to the ground.\n" ) ELSE ($say "Thrown.\n") ) ($move ($dobj) ($loc .ME)) ; turn(PREACT) = Preact; turn(ACTION) = Silly; light(PREACT) = Preact; light(ACTION) = Silly; douse(PREACT) = Preact; douse(ACTION) = Silly; read(PREACT) = Preact; 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) ". ") (ObjCont) ; look(PREACT) = (Expect NO_OBJ ($or NO_OBJ ONE_OBJ PLAIN_OBJ)) (CheckAvail) ; look(ACTION) = ($sdesc ($loc .ME)) (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 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) ) ) ; enter(PREACT) = (Expect ($or ONE_OBJ PLAIN_OBJ) NO_OBJ) (CheckAvail) ; enter(ACTION) = Silly; 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))))) ) ; { eof "calyx2.adl" }