home *** CD-ROM | disk | FTP | other *** search
/ rtsi.com / 2014.01.www.rtsi.com.tar / www.rtsi.com / OS9 / OSK / EFFO / forum3.lzh / SAMPLES / standard.adl
Text File  |  1988-01-22  |  27KB  |  1,159 lines
  1. MESSAGE "\n    standard.adl - version 3.1 - June 20, 1987\n"        ;
  2. MESSAGE "    Copyright (c) 1986, 1987 by Ross Cunniff\n"        ;
  3. MESSAGE "    Consult \"The ADL Programmer's Reference Manual\" for\n";
  4. MESSAGE "    information on using standard.adl\n\n"            ;
  5. {
  6.     standard.adl - a set of ADL definitions intended to make
  7.     ADL programs conform to the standard set in the document
  8.     "ADL Player's Handbook" by Brengle and Cunniff.  standard.adl
  9.     should be portable to all ADL implementations, and should
  10.     work elegantly and efficiently, encouraging its use by programmers.
  11.     The following is the "interface" to standard.adl.  It tells
  12.     what is defined in this file.
  13. }
  14.  
  15.  
  16. {  *** Boolean Object Properties *** }
  17.  
  18. SEEN    = 16;        { I've been here / seen this }
  19. OPENS   = 15;        { This can be opened }
  20. LOCKS   = 14;        { This can be locked }
  21. OPENED  = 13;        { This is opened }
  22. LOCKED  = 12;        { This is locked }
  23. TRANS   = 11;        { This is transparent }
  24. LIGHT   = 10;        { This gives off light }
  25. FLAME   = 9;        { This is on fire }
  26. NOTAKE  = 8;        { Ignore this object for "take" }
  27.  
  28. { The other 6 boolean properties are available to the user. }
  29.  
  30.  
  31. {  *** Integer Object Properties *** }
  32.  
  33. AllLink = 29;        { Link for objects used with "take" and "drop" }
  34. SAVESENT = 28;        { First VAR in a sentence save area }
  35.  
  36. { The other 11 integer properties are available to the user }
  37.  
  38.  
  39.  
  40. { *** Useful Constants *** }
  41.  
  42. TRUE  = 1;
  43. FALSE = 0;
  44. NULL  = 0;
  45.  
  46.  
  47.  
  48. { *** Flags for Expect *** }
  49.  
  50. NO_OBJ        = 1;        { It is valid to have no objects }
  51. ONE_OBJ        = 2;        { It is valid to have one object }
  52. MULT_OBJ    = 4;        { It is valid to have multiple objects }
  53. STR_OBJ        = 8;        { It is valid to have string objects }
  54. PLAIN_OBJ    = 16;        { It is valid to have normal objects }
  55.  
  56.  
  57.  
  58. { *** $spec commands *** }
  59.  
  60. DEBUG    = 1;
  61. RESTART    = 2;
  62. QUIT    = 3;
  63. SAVE    = 4;
  64. RESTORE    = 5;
  65. EXEC    = 6;
  66. PRESERVE= 7;
  67. SCRIPT    = 8;
  68. HEADER    = 9;
  69. MARGIN    = 10;
  70.  
  71.  
  72.  
  73. { *** Global Variables *** }
  74.  
  75. VAR
  76.     First,        { Is the current Dobj the first in the Dobj list? }
  77.     AllSeen,        { Did the player type "all" in this sentence? }
  78.     MultList,        { Head ptr of the multiple object list }
  79.     MyConj,        { Records where "but" has been seen }
  80.     NumSeen,        { Number of Dobj's seen by "take" or "drop" so far }
  81.     IobjSave,        { Save for the Iobj (for TAKE and DROP) }
  82.     Skip,        { Should TorDACT skip this object? }
  83.     Scripting,        { Are we writing a script file? }
  84.  
  85.     Conts,        { Have we already printed out "You can see:"? }
  86.     Indent,        { Indent outer object descriptions? }
  87.  
  88.     LastVerb,        { The Verb from the previous sentence }
  89.     LastNumd,        { The Numd from the previous sentence }
  90.     LastConj,        { The Conj from the previous sentence }
  91.     LastDobj,        { The Dobj from the previous sentence }
  92.     LastPrep,        { The Prep from the previous sentence }
  93.     LastIobj,        { The Iobj from the previous sentence }
  94.  
  95.     Dark,        { Is it dark? }
  96.     MyLoc,        { My last location }
  97.     Verbose;        { Does the player want verbose output? }
  98.  
  99.  
  100. (First)   = TRUE;
  101. (MyLoc)      = -1;        { Look on the first turn }
  102.  
  103.  
  104.  
  105. { *** Prepositions *** }
  106.  
  107. PREP
  108.     with, to, into, at, under, from, off, on;
  109.  
  110. in = into;
  111.  
  112.  
  113.  
  114. { *** Articles *** }
  115.  
  116. ARTICLE
  117.     the, a, an;
  118.  
  119.  
  120.  
  121. { *** Useful routines *** }
  122.  
  123. ROUTINE
  124.     StdInit,        { (StdInit actor) Standard game with actor playing }
  125.     Reach,        { (Reach Obj Where) True IFF I can reach Obj in Where }
  126.     See,        { (See Obj Where) True IFF I can see Obj in Where }
  127.     Lit,        { (LitP) True IFF something is lit or burning }
  128.     Describe,        { (Describe depth obj rout) Describe obj }
  129.     Avail,        { (Avail Obj) Is Obj available? }
  130.     CheckAvail,        { (CheckAvail) check availability of Dobj and Iobj }
  131.     Expect,        { (Expect DobjFlags IobjFlags) Check the form }
  132.     Preact,        { Standard verb preact }
  133.     Looker,        { Looking daemon }
  134.     Prompter,        { User prompt }
  135.     ActAction,        { Standard actor ACTION }
  136.     SaveSentence,    { (SaveSentence) - save the value of the curr. sent. }
  137.     TakeAct,        { User defined take action }
  138.     DropAct,        { User defined drop action }
  139.     Dwimmer;        { (Dwimmer Obj) - is Obj the one I want? }
  140.  
  141.  
  142.  
  143. { *** Objects *** }
  144.  
  145. NOUN
  146.     all,        { Used only in sentences with take and drop }
  147.     it;            { Refers to the last Dobj or Iobj typed }
  148.  
  149.  
  150. { *** Verbs - NOTE: do not change the PREACT or ACTION of any of these
  151.   without carefully considering the consequences *** }
  152.  
  153. VERB
  154.     n,  s,  e,  w,
  155.     ne, se, nw, sw,
  156.     up, down,
  157.     enter, exit,
  158.     get, put, take, drop,
  159.     wear, remove,
  160.     verbose, terse,
  161.     open, close,
  162.     lock, unlock,
  163.     move, break, rub, touch,
  164.     throw, read, burn,
  165.     examine, look, inventory,
  166.     quit, restart,
  167.     save, restore, script,
  168.     turn, douse, light,
  169.     wait, again, go;
  170.  
  171.  
  172. { Verb equivalences }
  173.  
  174. g      = again;
  175. z      = wait;
  176. l      = look;
  177. u      = up;
  178. d      = down;
  179. north      = n;
  180. south      = s;
  181. east      = e;
  182. west      = w;
  183. northeast = ne;
  184. northwest = nw;
  185. southeast = se;
  186. southwest = sw;
  187. put on      = wear;
  188. take off  = remove;
  189. turn on      = light;
  190. turn off  = douse;
  191. look at   = examine;
  192.  
  193.  
  194. MESSAGE "Done with Standard Interface - proceeding to Utility Routines\n";
  195.  
  196.  
  197.  
  198. { (StdInit actor) - initializes the ACTION routine of actor, sets
  199.   up the prompter, and sets up the looking daemon. }
  200.  
  201. StdInit =
  202.     ($setp %1 ACTION ActAction)
  203.     ($setp %1 NOTAKE TRUE)
  204.     ($setp %1 SAVESENT LastVerb)
  205.     ($actor %1 NULL TRUE)
  206.     ($prompt Prompter)
  207.     ($sdem Looker)
  208.     ($setv n s e w ne se nw sw u d)
  209. ;
  210.  
  211.  
  212.  
  213. { (FindIt obj) - figure out what an 'it' in a player's sentence refers
  214.   to }
  215.  
  216. ItConfused = "I can't seem to figure out what you mean by 'it'.\n";
  217. FindIt =
  218. LOCAL
  219.     SavePlace,        { The value of .ME(SAVESENT) }
  220.     LastDobj,        { The last DIRECT OBJECT typed }
  221.     LastIobj,        { The last INDIRECT OBJECT typed }
  222.     LastNumd;        { The previous NUMBER OF DIRECT OBJECTS typed }
  223.  
  224.     { Retrieve the pertinent info from SAVESENT }
  225.     ($setg SavePlace ($prop .ME SAVESENT))
  226.     (IF ($not @SavePlace) THEN
  227.     ($say ItConfused)
  228.     ($exit 1)
  229.     )
  230.     ($setg LastNumd ($global ($plus @SavePlace 1)))
  231.     ($setg LastDobj ($global ($plus @SavePlace 3)))
  232.     ($setg LastIobj ($global ($plus @SavePlace 5)))
  233.  
  234.     (IF ($or ($lt @LastDobj 0) ($lt @LastIobj 0) ($gt @LastNumd 1)) THEN
  235.     ($say ItConfused)
  236.     ($exit 1)
  237.     )
  238.     (IF ($and ($ne @LastDobj 0) ($eq @LastIobj 0)) THEN
  239.     ($setg %1 @LastDobj)
  240.      ELSEIF ($and ($ne @LastIobj 0) ($eq @LastDobj 0)) THEN
  241.     ($setg %1 @LastIobj)
  242.      ELSE
  243.     ($say ItConfused)
  244.     ($exit 1)
  245.     )
  246. ;
  247.  
  248.  
  249.  
  250. {  ActAction - the default Actor Action }
  251.  
  252. ActAction =
  253. LOCAL SavePlace;
  254.     (IF ($eq @Verb again) THEN
  255.     ($setg SavePlace ($prop .ME SAVESENT))
  256.     (IF ($not @SavePlace) THEN
  257.         ($say "I can't do that.\n")
  258.         ($exit 1)
  259.     )
  260.     (IF ($or @Dobj @Iobj) THEN
  261.         ($say "You may not use objects with 'again'.\n")
  262.         ($exit 1)
  263.     )
  264.     (IF ($gt ($global ($plus @SavePlace 1)) 1) THEN
  265.         ($say "You can't use 'again' with multiple direct objects.\n")
  266.         ($exit 1)
  267.     )
  268.     ($setg Verb ($global @SavePlace))
  269.     ($setg Numd ($global ($plus @SavePlace 1)))
  270.     ($setg Conj ($global ($plus @SavePlace 2)))
  271.     ($setg Dobj ($global ($plus @SavePlace 3)))
  272.     ($setg Prep ($global ($plus @SavePlace 4)))
  273.     ($setg Iobj ($global ($plus @SavePlace 5)))
  274.     ($exit 0)
  275.     )
  276.     (IF ($and ($eq @Dobj it) ($ne @Iobj it)) THEN
  277.     (FindIt Dobj)
  278.      ELSEIF ($and ($eq @Iobj it) ($ne @Dobj it)) THEN
  279.     (FindIt Iobj)
  280.      ELSEIF ($or ($eq @Iobj it) ($eq @Iobj it)) THEN
  281.     ($say "You may only use the word 'it' once in a sentence.\n")
  282.     ($exit 1)
  283.     )
  284.     (SaveSentence)
  285. ;
  286.  
  287.  
  288.  
  289.  
  290. { (CheckAvail) - checks to see whether the objects named by the
  291.   player are indeed available }
  292.  
  293. CheckAvail =
  294.     (IF ($gt ($dobj) 0) THEN
  295.     (Avail ($dobj))
  296.     )
  297.     (IF ($gt ($iobj) 0) THEN
  298.     (Avail ($iobj))
  299.     )
  300. ;
  301.  
  302.  
  303.  
  304. { (Expect DobjFlags IobjFlags) - Checks for a valid sentence }
  305.  
  306. Expect =
  307.     { Check the number of direct objects }
  308.     (IF ($eq @Numd 0) THEN
  309.     (IF ($not ($and %1 NO_OBJ)) THEN
  310.         ($say "You must tell me what to " ($vname @Verb) ".\n")
  311.         ($exit 3)
  312.     )
  313.      ELSEIF ($and ($eq @Numd 1) ($ne @Dobj all)) THEN
  314.     (IF ($and    ($not ($and %1 MULT_OBJ))
  315.             ($not ($and %1 ONE_OBJ))  )
  316.      THEN
  317.         ($say "You may not use a direct object with "
  318.             ($vname @Verb) ".\n")
  319.         ($exit 1)
  320.     )
  321.      ELSE
  322.     (IF ($not ($and %1 MULT_OBJ)) THEN
  323.         ($say "You may not use multiple direct objects with "
  324.             ($vname @Verb) ".\n")
  325.         ($exit 1)
  326.     )
  327.     )
  328.  
  329.     { Check the number of Indirect objects }
  330.     (IF ($and ($eq @Iobj 0) ($not ($and %2 NO_OBJ))) THEN
  331.     ($say "How would you like to do that?\n")
  332.     ($exit 3)
  333.      ELSEIF ($and ($ne @Iobj 0) ($not ($and %2 ONE_OBJ))) THEN
  334.     ($say "You may not use an indirect object with "
  335.         ($vname @Verb) ".\n")
  336.     ($exit 1)
  337.     )
  338.  
  339.     { Check the type of the objects }
  340.     (IF ($or    ($and ($lt @Dobj 0) ($not ($and %1 STR_OBJ)))
  341.         ($and ($lt @Iobj 0) ($not ($and %2 STR_OBJ))) )
  342.      THEN
  343.     ($say "You may not use strings with " ($vname @Verb) ".\n")
  344.     ($exit 1)
  345.     )
  346.     (IF ($or    ($and ($gt @Dobj 0) ($not ($and %1 PLAIN_OBJ)))
  347.         ($and ($gt @Iobj 0) ($not ($and %2 PLAIN_OBJ))) )
  348.      THEN
  349.     ($say "You must use strings with " ($vname @Verb) ".\n")
  350.     ($exit 1)
  351.     )
  352. ;
  353.  
  354.  
  355.  
  356. { Preact - the default verb Preact }
  357. Preact =
  358.     (Expect ($or ONE_OBJ PLAIN_OBJ) ($or NO_OBJ ONE_OBJ PLAIN_OBJ))
  359.     (CheckAvail)
  360. ;
  361.  
  362.  
  363.  
  364. { (Visible List Propno) - returns 1 IFF an object is visible on List that
  365.   has a nonzero prop Propno }
  366.  
  367. Visible =
  368.     (IF ($not %1) THEN                    { Null list }
  369.     ($return FALSE)
  370.      ELSEIF ($prop %1 %2) THEN                { This one is it! }
  371.     ($return TRUE)
  372.      ELSEIF ($or ($prop %1 OPENED) ($prop %1 TRANS)) THEN    { Look inside }
  373.     (IF (Visible ($cont %1) %2) THEN
  374.         ($return TRUE)
  375.     )
  376.     )
  377.     ($return (Visible ($link %1) %2))    { See if siblings satisfy Visible }
  378. ;
  379.  
  380.  
  381.  
  382. { (Reach Obj Loc) - returns 1 IFF Obj == Loc, or can (recursively) be
  383.   reached via the Loc }
  384.  
  385. Reach =
  386.     (IF ($not %2) THEN                { Null list }
  387.     ($return FALSE)
  388.      ELSEIF ($eq %1 %2) THEN            { This is the one! }
  389.     ($return TRUE)
  390.      ELSEIF ($prop %2 OPENED) THEN        { Still explore inside }
  391.     (IF (Reach %1 ($cont %2)) THEN
  392.         ($return TRUE)
  393.     )
  394.     )
  395.     ($return  (Reach %1 ($link %2)))        { See if siblings can reach }
  396. ;
  397.  
  398.  
  399.  
  400. { (See Obj Loc) - returns 1 IFF the Obj == Loc, or can be reached
  401.   via the Loc (similar to Reach, above) }
  402.  
  403. See =
  404.     (IF @Dark THEN            { Can't see in a dark room! }
  405.     ($return FALSE)
  406.      ELSEIF ($not %2) THEN        { Null list }
  407.     ($return FALSE)
  408.      ELSEIF ($eq %1 %2) THEN        { This is the one! }
  409.     ($return TRUE)
  410.      ELSEIF ($or  ($prop %2 TRANS)                 { Still explore inside }
  411.           ($prop %2 OPENED))
  412.      THEN
  413.     (IF (See %1 ($cont %2)) THEN
  414.         ($return TRUE)
  415.     )
  416.     )
  417.     ($return  (See   %1 ($link %2)))    { See whether siblings can see }
  418. ;
  419.  
  420.  
  421.  
  422. { (Avail Obj) - returns 1 IFF I can see Obj or I can reach Obj,
  423.   performs a ($exit 1) otherwise }
  424.  
  425. Avail =
  426.     (IF ($not %1) THEN            { Null object }
  427.     ($say "The what?\n")
  428.     ($exit 1)
  429.      ELSEIF ($not ($or (See %1 ($cont ($loc .ME))) (See %1 ($cont .ME)))) THEN
  430.     ($say "I can't see that item here.\n")
  431.     ($exit 1)
  432.      ELSEIF ($not ($or (Reach %1 ($cont ($loc .ME))) (Reach %1 ($cont .ME))))
  433.      THEN
  434.     ($say "I can't get at that item.\n")
  435.     ($exit 1)
  436.     )
  437.     ($return TRUE)
  438. ;
  439.  
  440.  
  441.  
  442. { (Lit Room) - returns TRUE IFF Room is lit }
  443.  
  444. Lit =
  445.     (IF ($prop %1 LIGHT) THEN        { Intrinsically lit }
  446.     ($return TRUE)
  447.      ELSEIF ($or (Visible ($cont %1) LIGHT) (Visible ($cont %1) FLAME)) THEN
  448.     ($return TRUE)            { I can see a light }
  449.      ELSEIF ($or (Visible ($cont .ME) LIGHT) (Visible ($cont .ME) FLAME)) THEN
  450.     ($return TRUE)            { I have a light }
  451.      ELSE
  452.     ($return FALSE)
  453.     )
  454. ;
  455.  
  456.  
  457.  
  458. { (Next global) - sets global to point to the sibling of the object
  459.    pointed to by global }
  460.  
  461. Next =
  462.     ($setg %1 ($link ($global %1)))
  463. ;
  464.  
  465.  
  466.  
  467. { (Blank n) - Type 2*n blanks }
  468.  
  469. Blank =
  470. LOCAL i;
  471.     (IF ($not @Indent) THEN    ($return 0))
  472.     ($setg i %1)
  473.     (WHILE @i DO
  474.     ($say "  ")
  475.     ($setg i ($minus @i 1))
  476.     )
  477. ;
  478.  
  479.  
  480.  
  481. { (Describe Level Obj Rout) - Describes Obj using Rout (which is a ROUTINE that
  482.   returns a ROUTINE that describes Obj, typically $sdesc or $ldesc),
  483.   and also describes the contents of Obj }
  484.  
  485. Describe =
  486.     (IF ($not %2) THEN        { Null list }
  487.     ($return 0)
  488.      ELSEIF ($not %1) THEN    { Level 0 == This is a room.  Check lighting }
  489.     ($setg Conts FALSE)
  490.     (IF (Lit %2) THEN
  491.         ($setg Dark FALSE) { Can't be dark in a lit room! }
  492.         ((%3 %2))        { Talk about the room }
  493.         (IF ($not @Dark) THEN
  494.         (Describe 1 ($cont %2) %3)    { Talk about its contents }
  495.         )
  496.      ELSE
  497.         ($say "It's mighty dark in here!\n")
  498.         ($setg Dark TRUE)
  499.     )
  500.      ELSE                { Level > 0 == This is a list of objs }
  501.     (IF (%3 %2) THEN        { Talk (only) about the visible }
  502.         (IF ($and ($eq %3 $sdesc) ($not @Conts)) THEN
  503.         (Blank ($minus %1 1))
  504.         ($say "You can see:\n")
  505.         )
  506.         ($setg Conts TRUE)
  507.         (Blank %1)            { Indent }
  508.         ((%3 %2))            { Blurb the object }
  509.         (IF ($cont %2) THEN        { something inside it...}
  510.         (IF ($or ($prop %2 OPENED) ($prop %2 TRANS)) THEN
  511.             (IF ($eq %3 $ldesc) THEN
  512.             (Blank %1)
  513.             ($say "It contains:\n")
  514.              ELSE
  515.             ($say ", containing\n")
  516.             )
  517.             ($setp %2 SEEN TRUE)
  518.             (Describe ($plus %1 1) ($cont %2) $sdesc)
  519.                 {Short descs for conts}
  520.          ELSEIF ($eq %3 $sdesc) THEN
  521.             ($say "\n")
  522.         )
  523.          ELSEIF ($eq %3 $sdesc) THEN
  524.         ($say "\n")
  525.         )
  526.     )
  527.     (Describe %1 ($link %2) %3)
  528.     )
  529. ;
  530.  
  531.  
  532.  
  533. { (SaveSentence) - save the value of the current sentence }
  534.  
  535. SaveSentence =
  536. LOCAL SavePlace;
  537.     ($setg SavePlace ($prop .ME SAVESENT))
  538.     (IF ($not @SavePlace) THEN
  539.     ($return 0)
  540.     )
  541.     ($setg @SavePlace @Verb)
  542.     ($setg ($plus @SavePlace 1) @Numd)
  543.     ($setg ($plus @SavePlace 2) @Conj)
  544.     ($setg ($plus @SavePlace 3) @Dobj)
  545.     ($setg ($plus @SavePlace 4) @Prep)
  546.     ($setg ($plus @SavePlace 5) @Iobj)
  547. ;
  548.  
  549.  
  550.  
  551. { (Prompter) - print out a user prompt.  Usually only mentioned
  552.   in ($prompt Prompter) in START }
  553.  
  554. Prompter =
  555.     ($say "> ")
  556. ;
  557.  
  558.  
  559.  
  560. { (Looker) - The standard Looking daemon.  Usually only mentioned
  561.   in START. }
  562.  
  563. Looker =
  564.     ($setp .ME TRANS FALSE)
  565.     ($setg MyConj FALSE)
  566.     ($setg First TRUE)
  567.     ($setg IobjSave NULL)
  568.     ($setg AllSeen FALSE)
  569.     (IF ($ne @MyLoc ($loc .ME)) THEN
  570.     (IF ($and ($not @Verbose) ($prop ($loc .ME) SEEN)) THEN
  571.         (Describe 0 ($loc .ME) $sdesc)
  572.      ELSE
  573.         (($sdesc ($loc .ME)))
  574.         (Describe 0 ($loc .ME) $ldesc)
  575.         ($setp ($loc .ME) SEEN TRUE)
  576.     )
  577.     (IF @Dark THEN
  578.         ($setp ($loc .ME) SEEN FALSE)
  579.     )
  580.     ($setg MyLoc ($loc .ME))
  581.     )
  582.     ($setp .ME TRANS TRUE)
  583.     ($setp .ME OPENED TRUE)
  584. ;
  585.  
  586.  
  587.  
  588. {
  589.   The following are routines relating to sentence constructions such
  590.   as "take all but rock and cow.  drop all but sword."
  591. }
  592.  
  593.  
  594. { (DelList Obj) -- Deletes Obj from the list of multiple direct objects }
  595.  
  596. DelList =
  597. LOCAL Curr;
  598.     (IF ($eq %1 all) THEN
  599.     { The player typed something like "take all but all" }
  600.     ($say "I don't understand that.\n")
  601.     ($exit 1)
  602.     )
  603.     ($setg Curr @MultList)
  604.     (IF ($eq @Curr %1) THEN
  605.     { Delete the head of the list }
  606.     ($setg MultList ($prop @Curr AllLink))
  607.      ELSE
  608.     { It's somewhere in the middle of the list }
  609.     (WHILE @Curr DO
  610.         (IF ($eq ($prop @Curr AllLink) %1) THEN
  611.         ($setp @Curr AllLink ($prop ($prop @Curr AllLink) AllLink))
  612.         ($return 0)
  613.         )
  614.         ($setg Curr ($prop @Curr AllLink))
  615.     )
  616.     { If we make it here, %1 wasn't on the list to begin with. }
  617.     ($say "You see no " ($name %1) " here.\n")
  618.     ($exit 1)
  619.     )
  620. ;
  621.  
  622.  
  623.  
  624. { (AddList Obj) -- Adds Obj to the list of multiple direct objects }
  625.  
  626. AddList =
  627.     (IF ($eq %1 all) THEN
  628.     { The player typed something like "Take rock and all" }
  629.     ($say "I don't understand that.\n")
  630.     ($exit 1)
  631.     )
  632.     ($setp %1 AllLink @MultList)
  633.     ($setg MultList %1)
  634. ;
  635.  
  636.  
  637.  
  638. { (InitList Where) --  Adds each object contained in Where to MultList }
  639.  
  640. InitList =
  641. LOCAL Curr;
  642.     ($setg MultList NULL)
  643.     ($setg AllSeen TRUE)
  644.     ($setg Curr %1)
  645.     (WHILE @Curr DO
  646.     (IF ($not ($prop @Curr NOTAKE)) THEN
  647.         ($setp @Curr AllLink @MultList)
  648.         ($setg MultList @Curr)
  649.     )
  650.     (Next Curr)
  651.     )
  652. ;
  653.  
  654.  
  655.  
  656. { (Mover Where String) - Moves each object on MultList to Where, printing
  657.   String as it does so. }
  658.  
  659. Mover =
  660.     (IF ($not @MultList) THEN
  661.     ($say "There is nothing to " ($vname @Verb) ".\n")
  662.     ($exit 1)
  663.     )
  664.     (WHILE @MultList DO
  665.     ($setg Dobj @MultList)
  666.     ($setg Iobj @IobjSave)
  667.     ($setg Skip FALSE)
  668.     (($action @Dobj))        { Call the ACTION routines }
  669.     (IF ($not @Skip) THEN
  670.         (($action @Iobj))        {   for the Dobj and Iobj }
  671.     )
  672.     (IF ($not @Skip) THEN    { Call the ACTIONs for the verb }
  673.         (IF ($eq @Verb take) THEN
  674.         (TakeAct)
  675.          ELSE {Verb == drop}
  676.         (DropAct)
  677.         )
  678.     )
  679.     (IF ($not @Skip) THEN
  680.         ($move @Dobj %1)        { Do the moving }
  681.         ($say "  " ($name @Dobj) " - " %2 "\n")
  682.     )
  683.     ($setg MultList ($prop @MultList AllLink))
  684.     )
  685. ;
  686.  
  687.  
  688.  
  689. { (CheckLoc Obj Where) -  Checks whethere Obj can be seen on Where
  690.   and can be reached on Where }
  691.  
  692. CheckLoc =
  693.     (IF ($not (See %1 %2)) THEN
  694.     (IF ($eq %2 ($cont .ME)) THEN
  695.         ($say "You have no " ($name %1) ".\n")
  696.      ELSE
  697.         ($say "You see no " ($name %1) " here.\n")
  698.     )
  699.     ($exit 1)
  700.      ELSEIF ($not (Reach %1 %2)) THEN
  701.     ($say "You can't reach the " ($name %1) ".\n")
  702.     ($exit 1)
  703.     )
  704. ;
  705.  
  706.  
  707.  
  708. { (TorDPRE Where) -- Uses Where as the context for a multiple
  709.   direct object (with "all" as a possible object) list. }
  710.  
  711. TorDPRE =
  712.     (IF ($not @First) THEN
  713.     { The MultList is initialized }
  714.     (IF @Conj THEN
  715.         (IF ($not @AllSeen) THEN
  716.         { The player typed something like "take a, b but c" }
  717.         ($say "I don't understand that.\n")
  718.         ($exit 1)
  719.         )
  720.         ($setg MyConj TRUE)
  721.     )
  722.     (IF @MyConj THEN    { We have seen "but" in the sentence }
  723.         (DelList @Dobj)    {   so delete this object from the list }
  724.      ELSE            { We have NOT seen "but" }
  725.         (CheckLoc @Dobj %1) { See if the object is in the right place }
  726.         (AddList @Dobj)    { If so, add the object to the mult list }
  727.     )
  728.      ELSE            { The MultList is NOT initialized, but
  729.                   there are objects in the sentence }
  730.     (IF ($eq @Dobj all) THEN
  731.         (InitList %1)    { The direct obj. is all, so set the MultList
  732.                     to the cont of the loc of .ME }
  733.      ELSE            { The dir obj. is NOT all, so set MultList to }
  734.         (CheckLoc @Dobj %1) {   be the direct object. }
  735.         ($setg MultList @Dobj)
  736.         ($setp @Dobj AllLink NULL)
  737.     )
  738.     ($setg First FALSE)
  739.     ($setg MyConj FALSE)
  740.     ($setg NumSeen 1)
  741.     )
  742.     ($setg Dobj 0)        { We will call the ACTION routines later... }
  743. ;
  744.  
  745.  
  746.  
  747. { (TorDACT Where String) -- Moves all objects on the multlist to Where
  748.   (using Mover) if all of the objects have been seen;  otherwise it waits.
  749.   String is the past participle of $verb. (e.g. "taken", "dropped" }
  750.  
  751. TorDACT =
  752.     (IF ($le @Numd @NumSeen) THEN
  753.     (Mover %1 %2)
  754.      ELSE
  755.     ($setg NumSeen ($plus @NumSeen 1))
  756.     )
  757. ;
  758.  
  759.  
  760.  
  761. MESSAGE "Done with Utility Routines.  Begin predefined verbs.\n";
  762.  
  763.  
  764.  
  765. { The following objects are for things like "go north" }
  766. NOUN
  767.     n DIR,  s DIR,  e DIR,  w DIR,
  768.     ne DIR, se DIR, nw DIR, sw DIR,
  769.     u DIR,  d DIR;
  770.  
  771. { We keep them in this array for PORTABLE referencing }
  772. VAR
  773.     _DirArray[ 10 ];
  774.  
  775. (_DirArray+0) = n DIR;
  776. (_DirArray+1) = s DIR;
  777. (_DirArray+2) = e DIR;
  778. (_DirArray+3) = w DIR;
  779. (_DirArray+4) = ne DIR;
  780. (_DirArray+5) = se DIR;
  781. (_DirArray+6) = nw DIR;
  782. (_DirArray+7) = sw DIR;
  783. (_DirArray+8) = u DIR;
  784. (_DirArray+9) = d DIR;
  785.  
  786. go( PREACT ) =
  787. LOCAL i;
  788.     (Expect ($or ONE_OBJ PLAIN_OBJ) NO_OBJ)
  789.     { Try to find the Dobj in the list of Directions }
  790.     ($setg i 0)
  791.     (WHILE ($lt @i 10) DO
  792.     (IF ($eq ($global ($plus _DirArray @i)) ($dobj)) THEN
  793.         { We found it.  Set the Verb and Dobj appropriately }
  794.         ($setg Verb ($minus 0 ($modif ($dobj))))
  795.         ($setg Dobj 0)
  796.         (($vprop ($verb) PREACT))
  797.         ($return 0)
  798.     )
  799.     ($setg i ($plus @i 1))
  800.     )
  801.  
  802.     { If we get here, we didn't find the Dobj }
  803.     ($say "Huh?\n")
  804.     ($exit 1)
  805. ;
  806.  
  807.  
  808. Silly =
  809.     ($say "That's silly!\n")
  810.     ($exit 1)
  811. ;
  812.  
  813.  
  814. _MeanMsg = "What do you mean by \"";
  815. NOVERB( PREACT ) =
  816.     (IF ($gt @Dobj 0) THEN
  817.     ($say "What do you want to do with the " ($name @Dobj) "?\n")
  818.     ($exit 3)
  819.      ELSEIF ($lt @Dobj 0) THEN
  820.     ($say _MeanMsg @Dobj "\"?\n")
  821.     ($exit 3)
  822.      ELSEIF ($lt @Dobj 0) THEN
  823.     ($say _MeanMsg @Dobj "\"?\n")
  824.     ($exit 3)
  825.      ELSEIF ($gt @Iobj 0) THEN
  826.     ($say "What to you want to do " ($pname @Prep) " the "
  827.         ($name @Iobj) "?\n")
  828.     ($exit 3)
  829.      ELSEIF ($lt @Iobj 0) THEN
  830.     ($say _MeanMsg @Iobj "\"?\n")
  831.     ($exit 3)
  832.      ELSE
  833.     ($say "I beg your pardon?\n")
  834.     ($exit 1)
  835.     )
  836. ;
  837.  
  838. wait( PREACT ) =
  839.     (Expect NO_OBJ NO_OBJ)
  840.     ($say "Time passes...\n")
  841.     ($exit 1)
  842. ;
  843.    
  844. wear( PREACT ) = Preact;
  845. wear( ACTION ) = Silly;
  846.  
  847. remove( PREACT ) = Preact;
  848. remove( ACTION ) = Silly;
  849.  
  850. verbose( PREACT ) = (Expect NO_OBJ NO_OBJ);
  851. verbose( ACTION ) =
  852.     ($say "Maximum verbosity.\n")
  853.     ($setg Verbose TRUE)
  854. ;
  855.  
  856. terse( PREACT ) = (Expect NO_OBJ NO_OBJ);
  857. terse( ACTION ) =
  858.     ($say "Minimum verbosity.\n")
  859.     ($setg Verbose FALSE)
  860. ;
  861.  
  862.  
  863. take( PREACT ) =
  864.     (Expect ($or ONE_OBJ MULT_OBJ PLAIN_OBJ) ($or NO_OBJ ONE_OBJ PLAIN_OBJ))
  865.     ($setp .ME OPENED TRUE)
  866.     ($setp .ME TRANS TRUE)
  867.     (IF @Iobj THEN
  868.     (IF ($prop @Iobj OPENED) THEN
  869.         (TorDPRE ($cont @Iobj) "take")
  870.      ELSE
  871.         ($say "You can't reach into the " ($name @Iobj) "\n")
  872.         ($exit 1)
  873.     )
  874.      ELSE
  875.     (TorDPRE ($cont ($loc .ME)) "take")
  876.     )
  877. ;
  878. take( ACTION ) =
  879.     (TorDACT .ME "taken")
  880. ;
  881.  
  882. drop( PREACT ) = 
  883.     (Expect ($or ONE_OBJ MULT_OBJ PLAIN_OBJ) ($or NO_OBJ ONE_OBJ PLAIN_OBJ))
  884.     (IF @Iobj THEN
  885.     ($setg IobjSave @Iobj)
  886.     ($setg Iobj 0)
  887.     )
  888.     (TorDPRE ($cont .ME) "drop")
  889. ;
  890. drop( ACTION ) =
  891.     (IF @IobjSave THEN
  892.     (TorDACT @IobjSave "dropped")
  893.      ELSE
  894.     (TorDACT ($loc .ME) "dropped")
  895.     )
  896. ;
  897.  
  898.  
  899. put( PREACT ) =
  900.     ($setg Verb drop)
  901.     (($vprop drop PREACT))
  902. ;
  903. get( PREACT ) =
  904.     ($setg Verb take)
  905.     (($vprop take PREACT))
  906. ;
  907.  
  908.  
  909. open( PREACT ) = Preact;
  910. open( ACTION ) =
  911.     (IF ($not ($prop ($dobj) OPENS)) THEN
  912.     ($say "I don't know how to open that!\n")
  913.     ($exit 1)
  914.      ELSEIF ($and ($prop ($dobj) LOCKS) ($prop ($dobj) LOCKED)) THEN
  915.     ($say "I can't open it, it's locked!\n")
  916.     ($exit 1)
  917.      ELSEIF ($prop ($dobj) OPENED) THEN
  918.     ($say "It's already open!\n")
  919.     ($exit 1)
  920.      ELSE
  921.     ($setp ($dobj) OPENED TRUE)
  922.     (IF ($and  ($ne ($cont ($dobj)) 0) ($not ($prop ($dobj) TRANS))) THEN
  923.         ($say "Opening the " ($name @Dobj) " reveals:\n")
  924.         (Describe 1 ($cont ($dobj)) $sdesc)
  925.      ELSE
  926.         ($say "Opened.\n")
  927.     )
  928.     )
  929. ;
  930.  
  931.  
  932. close( PREACT ) = Preact;
  933. close( ACTION ) =
  934.     (IF ($not ($prop ($dobj) OPENS)) THEN
  935.     ($say "I don't know how to close that!\n")
  936.     ($exit 1)
  937.      ELSEIF ($not ($prop ($dobj) OPENED)) THEN
  938.     ($say "It's already closed!\n")
  939.     ($exit 1)
  940.      ELSE
  941.     ($setp ($dobj) OPENED FALSE)
  942.     ($say "Closed.\n")
  943.     )
  944. ;
  945.  
  946.  
  947. Lockact =
  948.     (IF ($prop ($dobj) LOCKS) THEN
  949.     ($say "Hm, you don't seem to have the right key.\n")
  950.      ELSE
  951.     ($say "I don't know how to lock or unlock such a thing.\n")
  952.     )
  953. ;
  954.  
  955. lock( PREACT ) = Preact;
  956. lock( ACTION ) = Lockact;
  957.  
  958. unlock( PREACT) = Preact;
  959. unlock( ACTION ) = Lockact;
  960.  
  961.  
  962. move( PREACT ) = Preact;
  963. move( ACTION ) = ($say "Nothing seems to happen.\n");
  964.  
  965.  
  966. break( PREACT ) = Preact;
  967. break( ACTION ) = ($say "It seems to be unbreakable.\n");
  968.  
  969.  
  970. touch( PREACT ) = Preact;
  971. touch( ACTION ) =
  972.     ($say "Touching the " ($name ($dobj)) " doesn't seem too useful.\n")
  973. ;
  974.  
  975. rub( PREACT ) = Preact;
  976. rub( ACTION ) =
  977.     ($say "Nothing happens when you rub the " ($name ($dobj)) ".\n")
  978. ;
  979.  
  980.  
  981. throw( PREACT ) = Preact;
  982. throw( ACTION ) =
  983.     ($move ($dobj) ($loc .ME))
  984.     ($say "Thrown.\n")
  985. ;
  986.  
  987.  
  988. turn( PREACT ) = Preact;
  989. turn( ACTION ) = Silly;
  990.  
  991. light( PREACT ) = Preact;
  992. light( ACTION ) = Silly;
  993.  
  994. douse( PREACT ) = Preact;
  995. douse( ACTION ) = Silly;
  996.  
  997. read( PREACT ) =
  998.     (Expect ($or ONE_OBJ PLAIN_OBJ) ($or NO_OBJ ONE_OBJ PLAIN_OBJ))
  999.     (IF ($not ($or (See ($dobj) ($cont .ME)) (See ($dobj) ($cont ($loc .ME)))))
  1000.      THEN
  1001.     ($say "You don't see that here.\n")
  1002.     ($exit 1)
  1003.     )
  1004. ;
  1005. read( ACTION ) = ($say "It doesn't have anything on it to read.\n");
  1006.  
  1007.  
  1008. burn( PREACT ) = Preact;
  1009. burn( ACTION ) =
  1010.     ($say "That doesn't seem to work.\n")
  1011. ;
  1012.  
  1013.  
  1014. examine( PREACT ) = Preact;
  1015. examine( ACTION ) =
  1016.     ($say "You see nothing special about the " ($name @Dobj) ".\n")
  1017. ;
  1018.  
  1019.  
  1020. look( PREACT ) =
  1021.     (Expect NO_OBJ ($or NO_OBJ ONE_OBJ PLAIN_OBJ))
  1022.     (CheckAvail)
  1023. ;
  1024. look( ACTION ) =
  1025.     (Describe 0 ($loc .ME) $ldesc)
  1026. ;
  1027.  
  1028.  
  1029. inventory( PREACT ) = (Expect NO_OBJ NO_OBJ);
  1030. inventory( ACTION ) =
  1031.     (IF ($not ($cont .ME)) THEN
  1032.     ($say "You are empty-handed.\n")
  1033.     ($exit 1)
  1034.     )
  1035.     ($setp .ME SEEN TRUE)
  1036.     ($say "You are carrying:\n")
  1037.     ($setg Conts TRUE)
  1038.     (Describe 1 ($cont .ME) $sdesc)
  1039. ;
  1040.  
  1041.  
  1042. quit( PREACT ) = (Expect NO_OBJ NO_OBJ);
  1043. quit( ACTION ) =
  1044.     ($say "Are you sure that you want to quit? ")
  1045.     (IF ($yorn) THEN
  1046.     ($spec QUIT)
  1047.     )
  1048. ;
  1049.  
  1050.  
  1051. save( PREACT ) = (Expect NO_OBJ NO_OBJ);
  1052. save( ACTION ) =
  1053. LOCAL s;
  1054.     ($setg MyLoc -1)
  1055.     ($setp ($loc .ME) SEEN FALSE)
  1056.     ($say "Save to which file? ")
  1057.     ($setg s ($read))
  1058.     (IF ($leng @s) THEN
  1059.     (IF ($spec SAVE @s) THEN
  1060.         ($say "Save succeeded.\n")
  1061.      ELSE
  1062.         ($say "Save failed.\n")
  1063.     )
  1064.     )
  1065.     ($setp ($loc .ME) SEEN TRUE)
  1066.     ($setg MyLoc ($loc .ME))
  1067. ;
  1068.  
  1069.  
  1070. restore( PREACT ) = (Expect NO_OBJ NO_OBJ);
  1071. restore( ACTION ) =
  1072. LOCAL s;
  1073.     ($say "Restore from which file? ")
  1074.     ($setg s ($read))
  1075.     (IF ($leng @s) THEN
  1076.     ($spec RESTORE @s)
  1077.     { If we make it to this point, the restore didn't happen }
  1078.     ($say "Restore failed.\n")
  1079.     )
  1080. ;
  1081.  
  1082.  
  1083. restart( PREACT ) = (Expect NO_OBJ NO_OBJ);
  1084. restart( ACTION ) =
  1085.     ($say "Are you sure that you want to restart? ")
  1086.     (IF ($yorn) THEN
  1087.     ($spec RESTART)
  1088.     )
  1089. ;
  1090.  
  1091.  
  1092. script( PREACT ) = (Expect NO_OBJ NO_OBJ);
  1093. script( ACTION ) =
  1094. LOCAL s;
  1095.     (IF @Scripting THEN
  1096.     ($spec SCRIPT 0)
  1097.     ($say "Scripting turned off.\n")
  1098.     ($setg Scripting FALSE)
  1099.      ELSE
  1100.     ($say "Script to which file? ")
  1101.     ($setg s ($read))
  1102.     (IF ($leng @s) THEN
  1103.         ($say "Scripting turned on.\n")
  1104.         ($spec SCRIPT @s)
  1105.         ($setg Scripting TRUE)
  1106.     )
  1107.     )
  1108. ;
  1109.  
  1110.  
  1111. MESSAGE "Done initializing verb routines.  Starting Dwimmer.\n" ;
  1112.  
  1113.  
  1114. { (Dwimmer Obj) - returns 1 if the object is "possibly the one the
  1115.   user meant."  Returns 0 otherwise. }
  1116.  
  1117. Dwimmer =
  1118. LOCAL
  1119.     Trans,
  1120.     Opened,
  1121.     CanSee,
  1122.     i;
  1123.  
  1124.     (IF ($eq ($verb) go) THEN
  1125.     { Try to find %1 in the list of Directions }
  1126.     ($setg i 0)
  1127.     (WHILE ($lt @i 10) DO
  1128.         (IF ($eq ($global ($plus _DirArray @i)) %1) THEN
  1129.         { We found it! }
  1130.         ($return TRUE)
  1131.         )
  1132.         ($setg i ($plus @i 1))
  1133.     )
  1134.     { If we get here, we didn't find it. }
  1135.     ($return 0)
  1136.      ELSEIF ($eq ($verb) take) THEN
  1137.     { We don't want to look at stuff .ME is already carrying }
  1138.     ($setg Trans ($prop .ME TRANS))
  1139.     ($setg Opened ($prop .ME OPENED))
  1140.     ($setp .ME TRANS FALSE)
  1141.     ($setp .ME OPENED FALSE)
  1142.     ($setg CanSee (See %1 ($cont ($loc .ME))))
  1143.     ($setp .ME TRANS @Trans)
  1144.     ($setp .ME OPENED @Opened)
  1145.     ($return @CanSee)
  1146.      ELSEIF ($eq ($verb) drop) THEN
  1147.     { We need to be transparent }
  1148.     ($setg Trans ($prop .ME TRANS))
  1149.     ($setg CanSee (See %1 ($cont .ME)))
  1150.     ($setp .ME TRANS @Trans)
  1151.     ($return @CanSee)
  1152.      ELSE
  1153.     { This is the default case - it works pretty well }
  1154.     ($return ($or (See %1 ($cont .ME)) (See %1 ($cont ($loc .ME)))))
  1155.     )
  1156. ;
  1157.  
  1158. {*** EOF standard.adl ***}
  1159.