1  /* ADVENTURES
   2 
   3    CURRENT LIMITS:
   4        9650 WORDS OF MESSAGE TEXT (LINES, LINSIZ).
   5         750 TRAVEL OPTIONS (TRAVEL, TRVSIZ).
   6         300 VOCABULARY WORDS (KTAB, ATAB, TABSIZ).
   7         150 LOCATIONS (LTEXT, STEXT, KEY, COND, ABB, ATLOC, LOCSIZ).
   8         100 OBJECTS (PLAC, PLACE, FIXD, FIXED, LINK (TWICE), PTEXT,
   9                     PROP).
  10          35 "ACTION" VERBS (ACTSPK, VRBSIZ).
  11         205 RANDOM MESSAGES (RTEXT, RTXSIZ).
  12          12 DIFFERENT PLAYER CLASSIFICATIONS (CTEXT, CVAL, CLSMAX).
  13          20 HINTS, LESS 3 (HINTLC, HINTED, HINTS, HNTSIZ).
  14          35 MAGIC MESSAGES (MTEXT, MAGSIZ).
  15 
  16    THERE ARE ALSO LIMITS WHICH CANNOT BE EXCEEDED DUE TO THE
  17    STRUCTURE OF THE DATABASE.  (E.G., THE VOCABULARY USES
  18    N/1000 TO DETERMINE WORD TYPE, SO THERE CAN'T BE MORE
  19    THAN 1000 WORDS.) THESE UPPER LIMITS ARE:
  20 
  21         1000 NON-SYNONYMOUS VOCABULARY WORDS
  22         300 LOCATIONS
  23         100 OBJECTS
  24  */
  25 
  26 
  27 /* (SUBSCRIPTRANGE,STRINGRANGE):  */
  28 /* CAC ADVENT: proc options (main); */
  29 adventure: proc options (main);
  30 
  31       dcl  CAVES        file input;
  32       dcl  sysprint stream;
  33       dcl sysin file input stream;
  34       dcl error condition;
  35       dcl code fixed bin (35);
  36       dcl dir_name char (168);
  37       dcl ldn fixed bin;
  38       dcl entryname char (168);
  39       dcl data_file_pathname char (168);
  40       dcl atd char (255);
  41       dcl atd_len fixed bin (21);
  42 
  43 /* CAC
  44       dcl TREAD entry (char(133),fixed bin(31),char(133),
  45               fixed bin(31),fixed bin(31)) options (asm inter);
  46 
  47       dcl TWRITE entry (char(133),fixed bin(31),fixed bin(31))
  48               options (asm inter);
  49 
  50       dcl RANDU entry (fixed bin(31),fixed bin(31),float bin(31))
  51               options (asm inter);
  52 
  53       dcl ITIME entry (fixed bin(31)) options (asm inter);
  54 */
  55 
  56       declare clock_ entry returns (fixed bin(71));
  57       declare random_$uniform entry (float bin(27));
  58       declare hcs_$fs_get_path_name entry (ptr, char(*), fixed bin, char(*), fixed bin(35));
  59       declare pathname_ entry (char (*), char (*)) returns (char (168));
  60       declare com_err_ entry() options(variable);
  61       declare ioa_$rsnnl entry() options(variable);
  62 
  63         dcl 1 TXTCOM static,
  64               2 RTEXT(205) fixed bin(31),
  65               2 LINES(9650) char(5);
  66 
  67         dcl 1 BLKCOM static,
  68               2 BLKLIN bit(1) init ("1"b);
  69 
  70         dcl 1 PTXCOM static,
  71               2 PTEXT(100) fixed bin(31);
  72 
  73         dcl 1 VOCCOM static,
  74               2 KTAB(300) fixed bin(31),
  75               2 ATAB(300) char(5),
  76               2 TABSIZ fixed bin(31) init(300);
  77 
  78         dcl 1 PLACOM static,
  79               2 ATLOC(150) fixed bin(31),
  80               2 LINK(200) fixed bin(31),
  81               2 PLACE(100) fixed bin(31),
  82               2 FIXED(100) fixed bin(31),
  83               2 HOLDNG fixed bin(31);
  84 
  85         dcl 1 ABBCOM static,
  86               2 ABB(150) fixed bin(31);
  87 
  88 
  89          dcl PICWORD picture "s9999" static;
  90 
  91   dcl 1  ADVARS static,
  92       2  ABBNUM       fixed bin(31)  init(0),
  93       2  IX           fixed bin(31)  init (65549),
  94       2  IY           fixed bin(31)  init(0),
  95       2  Y            float bin(31) ,
  96       2  AXE          fixed bin(31)  init(0),
  97       2  BACK         fixed bin(31)  init(0),
  98       2  BATTER       fixed bin(31)  init(0),
  99       2  BEAR         fixed bin(31)  init(0),
 100       2  BIRD         fixed bin(31)  init(0),
 101       2  BONUS        fixed bin(31)  init(0),
 102       2  BOTTLE       fixed bin(31)  init(0),
 103       2  CAGE         fixed bin(31)  init(0),
 104       2  CAVE         fixed bin(31)  init(0),
 105       2  CCODE        fixed bin(31)  init(0),
 106       2  CH           fixed bin(31)  init(0),
 107       2  CHAIN        fixed bin(31)  init(0),
 108       2  CHASM        fixed bin(31)  init(0),
 109       2  CHEST        fixed bin(31)  init(0),
 110       2  CHLOC        fixed bin(31)  init(0),
 111       2  CHLOC2       fixed bin(31)  init(0),
 112       2  CLAM         fixed bin(31)  init(0),
 113       2  CLOCK1       fixed bin(31)  init(0),
 114       2  CLOCK2       fixed bin(31)  init(0),
 115       2  CLSSES       fixed bin(31)  init(0),
 116       2  CLSSIZ       fixed bin(31)  init(12),
 117       2  COINS        fixed bin(31)  init(0),
 118       2  DALTLC       fixed bin(31)  init(0),
 119       2  DETAIL       fixed bin(31)  init(0),
 120       2  DFLAG        fixed bin(31)  init(0),
 121       2  DKILL        fixed bin(31)  init(0),
 122       2  DOOR         fixed bin(31)  init(0),
 123       2  DPRSSN       fixed bin(31)  init(0),
 124       2  DRAGON       fixed bin(31)  init(0),
 125       2  DTOTAL       fixed bin(31)  init(0),
 126       2  DWARF        fixed bin(31)  init(0),
 127       2  EGGS         fixed bin(31)  init(0),
 128       2  EMRALD       fixed bin(31)  init(0),
 129       2  ENTRNC       fixed bin(31)  init(0),
 130       2  FIND         fixed bin(31)  init(0),
 131       2  FISSUR       fixed bin(31)  init(0),
 132       2  FOO          fixed bin(31)  init(0),
 133       2  FOOBAR       fixed bin(31)  init(0),
 134       2  FOOD         fixed bin(31)  init(0),
 135       2  FROM         fixed bin(31)  init(0),
 136       2  GRATE        fixed bin(31)  init(0),
 137       2  HINT         fixed bin(31)  init(0),
 138       2  HINTLC(20)   fixed bin(31)  init((20)0),
 139       2  HNTMAX       fixed bin(31)  init(0),
 140       2  I            fixed bin(31)  init(0),
 141       2  INLEN        fixed bin(31)  init(0),
 142       2  INSTR        char(133) ,
 143       2  INVENT       fixed bin(31)  init(0),
 144       2  IWEST        fixed bin(31)  init(0),
 145       2  J            fixed bin(31)  init(0),
 146       2  JUNK1        char(5) ,
 147       2  JUNK2        char(5) ,
 148       2  JUNK3        char(5) ,
 149       2  K            fixed bin(31)  init(0),
 150       2  KEYS         fixed bin(31)  init(0),
 151       2  KK           fixed bin(31)  init(0),
 152       2  KKWORD       char(2) ,
 153       2  KNFLOC       fixed bin(31)  init(0),
 154       2  KNIFE        fixed bin(31)  init(0),
 155       2  KQ           fixed bin(31)  init(0),
 156       2  K2           fixed bin(31)  init(0),
 157       2  L            fixed bin(31)  init(0),
 158       2  LAMP         fixed bin(31)  init(0),
 159       2  LIMIT        fixed bin(31)  init(0),
 160       2  LINUSE       fixed bin(31)  init(0),
 161       2  LL           fixed bin(31)  init(0),
 162       2  LOC          fixed bin(31)  init(0),
 163       2  LOCK         fixed bin(31)  init(0),
 164       2  LOOK         fixed bin(31)  init(0),
 165       2  M            fixed bin(31)  init(0),
 166       2  MAGZIN       fixed bin(31)  init(0),
 167       2  MAXDIE       fixed bin(31)  init(0),
 168       2  MAXTRS       fixed bin(31)  init(0),
 169       2  MESSAG       fixed bin(31)  init(0),
 170       2  MIRROR       fixed bin(31)  init(0),
 171       2  MXSCOR       fixed bin(31)  init(0),
 172       2  NEWLOC       fixed bin(31)  init(0),
 173       2  NUGGET       fixed bin(31)  init(0),
 174       2  NULLX        fixed bin(31)  init(0),
 175       2  NUMDIE       fixed bin(31)  init(0),
 176       2  OBJ          fixed bin(31)  init(0),
 177       2  OIL          fixed bin(31)  init(0),
 178       2  OLDLC2       fixed bin(31)  init(0),
 179       2  OLDLOC       fixed bin(31)  init(0),
 180       2  OUTSTR       char(133) var ,
 181       2  OYSTER       fixed bin(31)  init(0),
 182       2  PEARL        fixed bin(31)  init(0),
 183       2  PILLOW       fixed bin(31)  init(0),
 184       2  PLANT        fixed bin(31)  init(0),
 185       2  PLANT2       fixed bin(31)  init(0),
 186       2  POSN         fixed bin(31)  init(0),
 187       2  PYRAM        fixed bin(31)  init(0),
 188       2  REPLY        char(5) ,
 189       2  ROD          fixed bin(31)  init(0),
 190       2  ROD2         fixed bin(31)  init(0),
 191       2  RUG          fixed bin(31)  init(0),
 192       2  SAY          fixed bin(31)  init(0),
 193       2  SCORE        fixed bin(31)  init(0),
 194       2  SECT         fixed bin(31)  init(0),
 195       2  SNAKE        fixed bin(31)  init(0),
 196       2  SPICES       fixed bin(31)  init(0),
 197       2  SPK          fixed bin(31)  init(0),
 198       2  STEPS        fixed bin(31)  init(0),
 199       2  STICK        fixed bin(31)  init(0),
 200       2  TABLET       fixed bin(31)  init(0),
 201       2  TABNDX       fixed bin(31)  init(0),
 202       2  TALLY        fixed bin(31)  init(0),
 203       2  TALLY2       fixed bin(31)  init(0),
 204       2  TEMP         fixed bin(31)  init(0),
 205       2  THROW        fixed bin(31)  init(0),
 206       2  TRAVEL(750)  fixed bin(31)  init((750)0),
 207       2  ATTACK       fixed bin(31)  init(0),
 208       2  TRIDNT       fixed bin(31)  init(0),
 209       2  TROLL        fixed bin(31)  init(0),
 210       2  TROLL2       fixed bin(31)  init(0),
 211       2  TRVS         fixed bin(31)  init(0),
 212       2  TURNS        fixed bin(31)  init(0),
 213       2  VASE         fixed bin(31)  init(0),
 214       2  VEND         fixed bin(31)  init(0),
 215       2  VERB         fixed bin(31)  init(0),
 216       2  WATER        fixed bin(31)  init(0),
 217       2  WD1          char(5) ,
 218       2  WD1X         char(5) ,
 219       2  WD2          char(5) ,
 220       2  WD2X         char(5) ,
 221       2  WORD         fixed bin(31)  init(0),
 222       2  WORDEND      fixed bin(31)  init(0),
 223       2  WORDSIZE     fixed bin(31)  init(0),
 224       2  WORDSTRT     fixed bin(31)  init(0),
 225       2  LTEXT(150)   fixed bin(31)  init((150)0),
 226       2  STEXT(150)   fixed bin(31)  init((150)0),
 227       2  KEY(150)     fixed bin(31)  init((150)0),
 228       2  COND(150)    fixed bin(31)  init((150)0),
 229       2  PLAC(100)    fixed bin(31)  init((100)0),
 230       2  FIXD(100)    fixed bin(31)  init((100)0),
 231       2  PROP(100)    fixed bin(31)  init((100)0),
 232       2  ACTSPK(35)   fixed bin(31)  init((35)0),
 233       2  CTEXT(12)    fixed bin(31)  init((12)0),
 234       2  CVAL(12)     fixed bin(31)  init((12)0),
 235       2  HINTS(20,4)  fixed bin(31)  init((80)0),
 236       2  HINTED(20)   bit(1) ,
 237       2  TK(20)       fixed bin(31) ,
 238       2  TKWORD(10)   char(1) ,
 239       2  DLOC(6)      fixed bin(31) ,
 240       2  ODLOC(6)     fixed bin(31) ,
 241       2  DSEEN(6)     bit(1) ,
 242       2  LINSIZ       fixed bin(31) init (9650) ,
 243       2  TRVSIZ       fixed bin(31) init (750) ,
 244       2  LOCSIZ       fixed bin(31) init (150) ,
 245       2  VRBSIZ       fixed bin(31) init (35) ,
 246       2  RTXSIZ       fixed bin(31) init (205) ,
 247       2  CLSMAX       fixed bin(31) init (12) ,
 248       2  HNTSIZ       fixed bin(31) init (20) ,
 249       2  WZDARK       bit(1) ,
 250       2  LMWARN       bit(1) ,
 251       2  CLOSNG       bit(1) ,
 252       2  PANIC        bit(1) ,
 253       2  CLOSED       bit(1) ,
 254       2  GAVEUP       bit(1) ,
 255       2  SCORNG       bit(1) ,
 256       2  LOGON        bit(1) init ("0"b),
 257       2  YEA          bit(1) ;
 258 
 259 /*
 260 
 261    WZDARK SAYS WHETHER THE LOC HE'S LEAVING WAS DARK
 262    LMWARN SAYS WHETHER HE'S BEEN WARNED ABOUT LAMP GOING DIM
 263    CLOSNG SAYS WHETHER ITS CLOSING TIME YET
 264    PANIC SAYS WHETHER HE'S FOUND OUT HE'S TRAPPED IN THE
 265    CAVE
 266    CLOSED SAYS WHETHER WE'RE ALL THE WAY CLOSED
 267    GAVEUP SAYS WHETHER HE EXITED VIA "QUIT"
 268    SCORNG INDICATES TO THE SCORE ROUTINE WHETHER WE'RE DOING
 269    A "SCORE" COMMAND
 270    YEA IS RANDOM YES/NO REPLY
 271 
 272  */
 273 
 274 /*  DESCRIPTION OF THE DATABASE FORMAT
 275 
 276 
 277    THE DATA FILE CONTAINS SEVERAL SECTIONS.  EACH BEGINS
 278    WITH A LINE CONTAINING A NUMBER IDENTIFYING THE SECTION,
 279    AND ENDS WITH A LINE CONTAINING "-1".
 280 
 281    SECTION 1:  LONG FORM DESCRIPTIONS.  EACH LINE CONTAINS A
 282        LOCATION NUMBER, A TAB, AND A LINE OF TEXT.  THE SET
 283        OF (NECESSARILY ADJACENT) LINES WHOSE NUMBERS ARE X
 284        FORM THE LONG DESCRIPTION OF LOCATION X.
 285    SECTION 2:  SHORT FORM DESCRIPTIONS.  SAME FORMAT AS LONG
 286        FORM.  NOT ALL PLACES HAVE SHORT DESCRIPTIONS.
 287    SECTION 3:  TRAVEL TABLE.  EACH LINE CONTAINS A LOCATION
 288        NUMBER (X), A SECOND LOCATION NUMBER (Y), AND A LIST
 289        OF MOTION NUMBERS (SEE SECTION 4).  EACH MOTION
 290        REPRESENTS A VERB WHICH WILL GO TO Y IF CURRENTLY AT
 291        X.  Y, IN TURN, IS INTERPRETED AS FOLLOWS.  LET
 292        M=Y/1000, N=Y MOD 1000.
 293                IF N<=300       IT IS THE LOCATION TO GO TO.
 294                IF 300<N<=500   N-300 IS USED IN A COMPUTED
 295                                GOTO TO A SECTION OF SPECIAL
 296                                CODE.
 297                IF N>500        MESSAGE N-500 FROM SECTION 6
 298                                IS PRINTED, AND HE STAYS
 299                                WHEREVER HE IS.
 300        MEANWHILE, M SPECIFIES THE CONDITIONS ON THE MOTION.
 301                IF M=0          IT'S UNCONDITIONAL.
 302                IF 0<M<100      IT IS DONE WITH M%
 303                                PROBABILITY.
 304                IF M=100        UNCONDITIONAL, BUT FORBIDDEN
 305                                TO DWARVES.
 306                IF 100<M<=200   HE MUST BE CARRYING OBJECT
 307                                M-100.
 308                IF 200<M<=300   MUST BE CARRYING OR IN SAME
 309                                ROOM
 310                                        AS M-200.
 311                IF 300<M<=400   PROP(M MOD 100) MUST *NOT* BE
 312                                0.
 313                IF 400<M<=500   PROP(M MOD 100) MUST *NOT* BE
 314                                1.
 315                IF 500<M<=600   PROP(M MOD 100) MUST *NOT* BE
 316                                2, ETC.
 317        IF THE CONDITION (IF ANY) IS NOT MET, THEN THE NEXT
 318        *DIFFERENT* "DESTINATION" VALUE IS USED (UNLESS IT
 319        FAILS TO MEET *ITS* CONDITIONS, IN WHICH CASE THE
 320        NEXT IS FOUND, ETC.).  TYPICALLY, THE NEXT DEST WILL
 321        BE FOR ONE OF THE SAME VERBS, SO THAT ITS ONLY USE IS
 322        AS THE ALTERNATE DESTINATION FOR THOSE VERBS.  FOR
 323        INSTANCE:
 324            15      110022  29      31      34      35      23      43
 325            15      14      29
 326        THIS SAYS THAT, FROM LOC 15, ANY OF THE VERBS 29, 31,
 327        ETC., WILL TAKE HIM TO 22 IF HE'S CARRYING OBJECT 10,
 328        AND OTHERWISE WILL GO TO 14.
 329                11      303008  49
 330                11      9       50
 331        THIS SAYS THAT, FROM 11, 49 TAKES HIM TO 8 UNLESS
 332        PROP(3)=0, IN WHICH CASE HE GOES TO 9.  VERB 50 TAKES
 333        HIM TO 9 REGARDLESS OF PROP(3).
 334    SECTION 4:  VOCABULARY.  EACH LINE CONTAINS A NUMBER (N),
 335        A TAB, AND A FIVE-LETTER WORD.  CALL M=N/1000.  IF
 336        M=0, THEN THE WORD IS A MOTION VERB FOR USE IN
 337        TRAVELLING (SEE SECTION 3).  ELSE, IF M=1, THE WORD
 338        IS AN OBJECT.  ELSE, IF M=2, THE WORD IS AN ACTION
 339        VERB (SUCH AS "CARRY" OR "ATTACK").  ELSE, IF M=3,
 340        THE WORD IS A SPECIAL CASE VERB (SUCH AS "DIG") AND N
 341        MOD 1000 IS AN INDEX INTO SECTION 6.  OBJECTS FROM 50
 342        TO (CURRENTLY, ANYWAY) 79 ARE CONSIDERED TREASURES
 343        (FOR PIRATE, CLOSEOUT).
 344    SECTION 5:  OBJECT DESCRIPTIONS.  EACH LINE CONTAINS A
 345        NUMBER (N), A TAB, AND A MESSAGE.  IF N IS FROM 1 TO
 346        100, THE MESSAGE IS THE "INVENTORY" MESSAGE FOR
 347        OBJECT N.  OTHERWISE, N SHOULD BE 000, 100, 200,
 348        ETC., AND THE MESSAGE SHOULD BE THE DESCRIPTION OF
 349        THE PRECEDING OBJECT WHEN ITS PROP VALUE IS N/100.
 350        THE N/100 IS USED ONLY TO DISTINGUISH MULTIPLE
 351        MESSAGES FROM MULTI-LINE MESSAGES; THE PROP INFO
 352        ACTUALLY REQUIRES ALL MESSAGES FOR AN OBJECT TO BE
 353        PRESENT AND CONSECUTIVE.  PROPERTIES WHICH PRODUCE NO
 354        MESSAGE SHOULD BE GIVEN THE MESSAGE ">$<".
 355    SECTION 6:  ARBITRARY MESSAGES.  SAME FORMAT AS SECTIONS
 356        1, 2, AND 5, EXCEPT THE NUMBERS BEAR NO RELATION TO
 357        ANYTHING (EXCEPT FOR SPECIAL VERBS IN SECTION 4).
 358    SECTION 7:  OBJECT LOCATIONS.  EACH LINE CONTAINS AN
 359        OBJECT NUMBER AND ITS INITIAL LOCATION (ZERO (OR
 360        OMITTED) IF NONE).  IF THE OBJECT IS IMMOVABLE, THE
 361        LOCATION IS FOLLOWED BY A "-1".  IF IT HAS TWO
 362        LOCATIONS (E.G.  THE GRATE) THE FIRST LOCATION IS
 363        FOLLOWED WITH THE SECOND, AND THE OBJECT IS ASSUMED
 364        TO BE IMMOVABLE.
 365    SECTION 8:  ACTION DEFAULTS.  EACH LINE CONTAINS AN
 366        "ACTION-VERB" NUMBER AND THE INDEX (IN SECTION 6) OF
 367        THE DEFAULT MESSAGE FOR THE VERB.
 368    SECTION 9:  LIQUID ASSETS, ETC.  EACH LINE CONTAINS A
 369        NUMBER (N) AND UP TO 20 LOCATION NUMBERS.  BIT N
 370        (WHERE 0 IS THE UNITS BIT) IS SET IN COND(LOC) FOR
 371        EACH LOC GIVEN.  THE COND BITS CURRENTLY ASSIGNED
 372        ARE:
 373                0       LIGHT
 374                1       IF BIT 2 IS ON:  ON FOR OIL, OFF FOR
 375                        WATER
 376                2       LIQUID ASSET, SEE BIT 1
 377                3       PIRATE DOESN'T GO HERE UNLESS
 378                        FOLLOWING PLAYER
 379        OTHER BITS ARE USED TO INDICATE AREAS OF INTEREST TO
 380        "HINT" ROUTINES:
 381                4       TRYING TO GET INTO CAVE
 382                5       TRYING TO CATCH BIRD
 383                6       TRYING TO DEAL WITH SNAKE
 384                7       LOST IN MAZE
 385                8       PONDERING DARK ROOM
 386                9       AT WITT'S END
 387        COND(LOC) IS SET TO 2, OVERRIDING ALL OTHER BITS, IF
 388        LOC HAS FORCED MOTION.
 389    SECTION 10:  CLASS MESSAGES.  EACH LINE CONTAINS A NUMBER
 390        (N), A TAB, AND A MESSAGE DESCRIBING A CLASSIFICATION
 391        OF PLAYER.  THE SCORING SECTION SELECTS THE
 392        APPROPRIATE MESSAGE, WHERE EACH MESSAGE IS CONSIDERED
 393        TO APPLY TO PLAYERS WHOSE SCORES ARE HIGHER THAN THE
 394        PREVIOUS N BUT NOT HIGHER THAN THIS N.  NOTE THAT
 395        THESE SCORES PROBABLY CHANGE WITH EVERY MODIFICATION
 396        (AND PARTICULARLY EXPANSION) OF THE PROGRAM.
 397    SECTION 11:  HINTS.  EACH LINE CONTAINS A HINT NUMBER
 398        (CORRESPONDING TO A COND BIT, SEE SECTION 9), THE
 399        NUMBER OF TURNS HE MUST BE AT THE RIGHT LOC(S) BEFORE
 400        TRIGGERING THE HINT, THE POINTS DEDUCTED FOR TAKING
 401        THE HINT, THE MESSAGE NUMBER (SECTION 6) OF THE
 402        QUESTION, AND THE MESSAGE NUMBER OF THE HINT.  THESE
 403        VALUES ARE STASHED IN THE "HINTS" ARRAY.  HNTMAX IS
 404        SET TO THE MAX HINT NUMBER (<= HNTSIZ).  NUMBERS 1-3
 405        ARE UNUSABLE SINCE COND BITS ARE OTHERWISE ASSIGNED,
 406        SO 2 IS USED TO REMEMBER IF HE'S READ THE CLUE IN THE
 407        REPOSITORY, AND 3 IS USED TO REMEMBER WHETHER HE
 408        ASKED FOR INSTRUCTIONS (GETS MORE TURNS, BUT LOSES
 409        POINTS).
 410    SECTION 12:  MAGIC MESSAGES.  IDENTICAL TO SECTION 6
 411        EXCEPT PUT IN A SEPARATE SECTION FOR EASIER
 412        REFERENCE.  MAGIC MESSAGES ARE USED BY THE STARTUP,
 413        MAINTENANCE MODE, AND RELATED ROUTINES.
 414    SECTION 0:  END OF DATABASE.
 415 
 416  */
 417 on error begin;
 418    put skip data (ADVARS);
 419    end;
 420 
 421 
 422 /*  READ THE DATABASE IF WE HAVE NOT YET DONE SO       */
 423 
 424         put string (OUTSTR) edit ("Loading...") (a);
 425         call LINEOUT;
 426 
 427 /*
 428    CLEAR OUT THE VARIOUS TEXT-POINTER ARRAYS.  ALL TEXT IS
 429    STORED IN ARRAY LINES; EACH LINE IS PRECEDED BY A WORD
 430    POINTING TO THE NEXT POINTER (I.E.  THE WORD FOLLOWING
 431    THE END OF THE LINE).  THE POINTER IS NEGATIVE IF THIS IS
 432    FIRST LINE OF A MESSAGE.  THE TEXT-POINTER ARRAYS CONTAIN
 433    INDICES OF POINTER-WORDS IN LINES.  STEXT(N) IS SHORT
 434    DESCRIPTION OF LOCATION N.  LTEXT(N) IS LONG DESCRIPTION.
 435    PTEXT(N) POINTS TO MESSAGE FOR PROP(N)=0.  SUCCESSIVE
 436    PROP MESSAGES ARE FOUND BY CHASING POINTERS.  RTEXT
 437    CONTAINS SECTION 6'S STUFF.  CTEXT(N) POINTS TO A
 438    PLAYER-CLASS MESSAGE.  MTEXT IS FOR SECTION 12.  WE ALSO
 439    CLEAR COND.  SEE DESCRIPTION OF SECTION 9 FOR DETAILS.
 440  */
 441 
 442         do I=1 to 300;
 443             if I <= 100 then PTEXT(I)=0;
 444             if I <= RTXSIZ then RTEXT(I)=0;
 445             if I <= CLSMAX then CTEXT(I)=0;
 446             if I <= LOCSIZ then do;
 447                 STEXT(I)=0;
 448                 LTEXT(I)=0;
 449                 COND(I)=0;
 450                 end;
 451             end;
 452 
 453         KEY=0;
 454         LINUSE=1;
 455         TRVS=1;
 456         CLSSES=1;
 457 
 458 /* START NEW DATA SECTION.  SECT IS THE SECTION NUMBER. */
 459 
 460         call hcs_$fs_get_path_name (codeptr(adventure), dir_name, ldn, entryname, code);
 461         if code ^= 0 then do;
 462              call com_err_ (code, "adventure", "Getting path to adventure");
 463              return;
 464         end;
 465 
 466         data_file_pathname = pathname_ (dir_name, "ADVNTCAV.DAT");
 467 
 468         call ioa_$rsnnl ("vfile_ ^a", atd, atd_len, data_file_pathname);
 469 
 470         open file (CAVES) title (atd) input;
 471 
 472 L1002:  get file (CAVES) edit (SECT) (col(1),f(8));
 473         OLDLOC=-1;
 474 /* CAC
 475         select (SECT);
 476            when (00)  goto L1100;        / * (0) * /
 477            when (01)  goto L1004;        / * (1) * /
 478            when (02)  goto L1004;        / * (2) * /
 479            when (03)  goto L1030;        / * (3) * /
 480            when (04)  goto L1040;        / * (4) * /
 481            when (05)  goto L1004;        / * (5) * /
 482            when (06)  goto L1004;        / * (6) * /
 483            when (07)  goto L1050;        / * (7) * /
 484            when (08)  goto L1060;        / * (8) * /
 485            when (09)  goto L1070;        / * (9) * /
 486            when (10)  goto L1004;       / * (10) * /
 487            when (11)  goto L1080;       / * (11) * /
 488            end;
 489 */
 490         if SECT = 00 then goto L1100;
 491         if SECT = 01 then goto L1004;
 492         if SECT = 02 then goto L1004;
 493         if SECT = 03 then goto L1030;
 494         if SECT = 04 then goto L1040;
 495         if SECT = 05 then goto L1004;
 496         if SECT = 06 then goto L1004;
 497         if SECT = 07 then goto L1050;
 498         if SECT = 08 then goto L1060;
 499         if SECT = 09 then goto L1070;
 500         if SECT = 10 then goto L1004;
 501         if SECT = 11 then goto L1080;
 502 
 503         call BUG(9);
 504 
 505 /* SECTIONS 1, 2, 5, 6, 10.  READ MESSAGES AND SET UP POINTERS. */
 506 
 507 L1004:  get file (CAVES) edit
 508             (LOC,(LINES(J) do J=LINUSE+1 to LINUSE+14),KKWORD)
 509             (col(1),f(8),14 a(5),a(2));
 510         if KKWORD ^= " " then call BUG(0);
 511         if LOC = -1 then goto L1002;
 512         do K=1 to 14;
 513             KK=LINUSE+15-K;
 514             if LINES(KK) ^= " " then goto L1007;
 515             end;
 516         call BUG(1);
 517 L1007:  PICWORD=KK+1;
 518         LINES(LINUSE)=PICWORD;
 519         if LOC = OLDLOC then goto L1020;
 520 /* CAC fix conversion warning        PICWORD=-LINES(LINUSE); */
 521         PICWORD = convert (PICWORD, -LINES(LINUSE));
 522         LINES(LINUSE)=PICWORD;
 523         if SECT = 10 then goto L1012;
 524         if SECT = 6 then goto L1011;
 525         if SECT = 5 then goto L1010;
 526         if SECT = 1 then goto L1008;
 527 
 528         STEXT(LOC)=LINUSE;
 529         goto L1020;
 530 
 531 L1008:  LTEXT(LOC)=LINUSE;
 532         goto L1020;
 533 
 534 L1010:  if LOC > 0 & LOC <= 100 then PTEXT(LOC)=LINUSE;
 535         goto L1020;
 536 
 537 L1011:  if LOC > RTXSIZ then call BUG(6);
 538         RTEXT(LOC)=LINUSE;
 539         goto L1020;
 540 
 541 L1012:  CTEXT(CLSSES)=LINUSE;
 542         CVAL(CLSSES)=LOC;
 543         CLSSES=CLSSES+1;
 544 
 545 L1020:  LINUSE=KK+1;
 546         LINES(LINUSE)="-1   ";
 547         OLDLOC=LOC;
 548         if LINUSE+14 > LINSIZ then call BUG(2);
 549         goto L1004;
 550 
 551 /*
 552    THE STUFF FOR SECTION 3 IS ENCODED HERE.  EACH
 553    "FROM-LOCATION" GETS A CONTIGUOUS SECTION OF THE "TRAVEL"
 554    ARRAY.  EACH ENTRY IN TRAVEL IS NEWLOC*1000 + KEYWORD
 555    (FROM SECTION 4, MOTION VERBS), AND IS NEGATED IF THIS IS
 556    THE LAST ENTRY FOR THIS LOCATION.  KEY(N) IS THE INDEX IN
 557    TRAVEL OF THE FIRST OPTION AT LOCATION N.
 558 */
 559 
 560 L1030:  get file (CAVES) edit
 561              (LOC,NEWLOC,(TK(I) do I=1 to 8)) (col(1),10 f(8));
 562         if LOC = -1 then goto L1002;
 563         if KEY(LOC) ^= 0 then goto L1033;
 564         KEY(LOC)=TRVS;
 565         goto L1035;
 566 L1033:  TRAVEL(TRVS-1)=-TRAVEL(TRVS-1);
 567 L1035:  do L=1 to 8;
 568             if TK(L) = 0 then goto L1039;
 569             TRAVEL(TRVS)=NEWLOC*1000+TK(L);
 570             TRVS=TRVS+1;
 571             if TRVS = TRVSIZ then call BUG(3);
 572             end;
 573 
 574 L1039:  TRAVEL(TRVS-1)=-TRAVEL(TRVS-1);
 575         goto L1030;
 576 
 577 /*
 578    HERE WE READ IN THE VOCABULARY.  KTAB(N) IS THE WORD
 579    NUMBER, ATAB(N) IS THE CORRESPONDING WORD.  THE -1 AT THE
 580    END OF SECTION 4 IS LEFT IN KTAB AS AN END-MARKER.  THE
 581    WORDS ARE GIVEN A MINIMAL HASH TO MAKE READING THE
 582    CORE-IMAGE HARDER.  NOTE THAT '/7-08' HAD BETTER NOT BE
 583    IN THE LIST, SINCE IT COULD HASH TO -1.  (HASHING REMOVED
 584    IN PL/1 VERSION..BRD)
 585 */
 586 
 587 L1040:  do TABNDX=1 to TABSIZ;
 588 L1043:  get file (CAVES) edit
 589               (KTAB(TABNDX),ATAB(TABNDX)) (col(1),f(8),a (5));
 590         if KTAB(TABNDX) = -1 then goto L1002;
 591         end;
 592         call BUG(4);
 593 
 594 /*
 595    READ IN THE INITIAL LOCATIONS FOR EACH OBJECT.  ALSO THE
 596    IMMOVABILITY INFO.  PLAC CONTAINS INITIAL LOCATIONS OF
 597    OBJECTS.  FIXD IS -1 FOR IMMOVABLE OBJECTS (INCLUDING THE
 598    SNAKE), OR = SECOND LOC FOR TWO-PLACED OBJECTS.
 599 */
 600 
 601 L1050:  get file (CAVES) edit (OBJ,J,K) (col(1),3 f(8));
 602         if OBJ = -1 then goto L1002;
 603         PLAC(OBJ)=J;
 604         FIXD(OBJ)=K;
 605         goto L1050;
 606 
 607 /* READ DEFAULT MESSAGE NUMBERS FOR ACTION VERBS, STORE IN
 608    ACTSPK.  */
 609 
 610 L1060:  get file (CAVES) edit (VERB,J) (col(1),2 f(8));
 611         if VERB = -1 then goto L1002;
 612         ACTSPK(VERB)=J;
 613         goto L1060;
 614 
 615 /* READ INFO ABOUT AVAILABLE LIQUIDS AND OTHER CONDITIONS,
 616    STORE IN COND.  */
 617 
 618 L1070:  get file (CAVES) edit (K,(TK(I) do I=1 to 9))
 619              (col(1),10 f(8));
 620         if K = -1 then goto L1002;
 621         do I=1 to 9;
 622             LOC=TK(I);
 623             if LOC = 0 then goto L1070;
 624             if BITSET(LOC,K) then call BUG(8);
 625             COND(LOC)=COND(LOC)+2**K;
 626             end;
 627         goto L1070;
 628 
 629 /* READ DATA FOR HINTS. */
 630 
 631 L1080:  HNTMAX=0;
 632 L1081:  get file (CAVES) edit (K,(TK(I) do I=1 to 4))
 633              (col(1),5 f(8));
 634         if K = -1 then goto L1002;
 635         if K = 0 then goto L1081;
 636         if K < 0 | K > HNTSIZ then call BUG(7);
 637         do I=1 to 4;
 638             HINTS(K,I)=TK(I);
 639             end;
 640         HNTMAX=max(HNTMAX,K);
 641         goto L1081;
 642 /*
 643    FINISH CONSTRUCTING INTERNAL DATA FORMAT
 644 
 645    HAVING READ IN THE DATABASE, CERTAIN THINGS ARE NOW
 646    CONSTRUCTED.  PROPS ARE SET TO ZERO.  WE FINISH SETTING
 647    UP COND BY CHECKING FOR FORCED-MOTION TRAVEL ENTRIES.
 648    THE PLAC AND FIXD ARRAYS ARE USED TO SET UP ATLOC(N) AS
 649    THE FIRST OBJECT AT LOCATION N, AND LINK(OBJ) AS THE NEXT
 650    OBJECT AT THE SAME LOCATION AS OBJ.  (OBJ>100 INDICATES
 651    THAT FIXED(OBJ-100)=LOC; LINK(OBJ) IS STILL THE CORRECT
 652    LINK TO USE.) ABB IS ZEROED; IT CONTROLS WHETHER THE
 653    ABBREVIATED DESCRIPTION IS PRINTED.  COUNTS MOD 5 UNLESS
 654    "LOOK" IS USED.
 655 */
 656 
 657 L1100:
 658   close file (CAVES);
 659 
 660   do I=1 to 100;
 661             PLACE(I)=0;
 662             PROP(I)=0;
 663             LINK(I)=0;
 664             LINK(I+100)=0;
 665             end;
 666 
 667         do I=1 to LOCSIZ;
 668         ABB(I)=0;
 669         if LTEXT(I) = 0 | KEY(I) = 0 then goto L1102;
 670         K=KEY(I);
 671         if mod(abs(TRAVEL(K)),1000) = 1 then COND(I)=2;
 672 L1102:  ATLOC(I)=0;
 673         end;
 674 
 675 /*
 676    SET UP THE ATLOC AND LINK ARRAYS AS DESCRIBED ABOVE.
 677    WE'LL USE THE DROP SUBROUTINE, WHICH PREFACES NEW OBJECTS
 678    ON THE LISTS.  SINCE WE WANT THINGS IN THE OTHER ORDER,
 679    WE'LL RUN THE LOOP BACKWARDS.  IF THE OBJECT IS IN TWO
 680    LOCS, WE DROP IT TWICE.  THIS ALSO SETS UP "PLACE" AND
 681    "FIXED" AS COPIES OF "PLAC" AND "FIXD".  ALSO, SINCE
 682    TWO-PLACED OBJECTS ARE TYPICALLY BEST DESCRIBED LAST,
 683    WE'LL DROP THEM FIRST.
 684 */
 685 
 686         do I=1 to 100;
 687             K=101-I;
 688             if FIXD(K) > 0 then do;
 689                 call DROP(K+100,FIXD(K));
 690                 call DROP(K,PLAC(K));
 691                 end;
 692             end;
 693 
 694         do I=1 to 100;
 695             K=101-I;
 696             FIXED(K)=FIXD(K);
 697             if PLAC(K) ^= 0 & FIXD(K) <= 0 then call DROP(K,PLAC(K));
 698             end;
 699 
 700 /*
 701    TREASURES, AS NOTED EARLIER, ARE OBJECTS 50 THROUGH
 702    MAXTRS (CURRENTLY 79).  THEIR PROPS ARE INITIALLY -1, AND
 703    ARE SET TO 0 THE FIRST TIME THEY ARE DESCRIBED.  TALLY
 704    KEEPS TRACK OF HOW MANY ARE NOT YET FOUND, SO WE KNOW
 705    WHEN TO CLOSE THE CAVE.  TALLY2 COUNTS HOW MANY CAN NEVER
 706    BE FOUND (E.G.  IF LOST BIRD OR BRIDGE).
 707 */
 708 
 709         MAXTRS=79;
 710         TALLY=0;
 711         TALLY2=0;
 712         do I=50 to MAXTRS;
 713             if PTEXT(I) ^= 0 then PROP(I)=-1;
 714             TALLY=TALLY-PROP(I);
 715             end;
 716 /*
 717    CLEAR THE HINT STUFF.  HINTLC(I) IS HOW LONG HE'S BEEN AT
 718    LOC WITH COND BIT I.  HINTED(I) IS TRUE IFF HINT I HAS
 719    BEEN USED.
 720 */
 721 
 722         do  I=1 to HNTMAX;
 723             HINTED(I)="0"b;
 724             HINTLC(I)=0;
 725             end;
 726 
 727 /* DEFINE SOME HANDY MNEMONICS.  THESE CORRESPOND TO OBJECT
 728    NUMBERS.  */
 729 
 730         KEYS=VOCAB("KEYS",1);
 731         LAMP=VOCAB("LAMP",1);
 732         GRATE=VOCAB("GRATE",1);
 733         CAGE=VOCAB("CAGE",1);
 734         ROD=VOCAB("ROD",1);
 735         ROD2=ROD+1;
 736         STEPS=VOCAB("STEPS",1);
 737         BIRD=VOCAB("BIRD",1);
 738         DOOR=VOCAB("DOOR",1);
 739         PILLOW=VOCAB("PILLO",1);
 740         SNAKE=VOCAB("SNAKE",1);
 741         FISSUR=VOCAB("FISSU",1);
 742         TABLET=VOCAB("TABLE",1);
 743         CLAM=VOCAB("CLAM",1);
 744         OYSTER=VOCAB("OYSTE",1);
 745         MAGZIN=VOCAB("MAGAZ",1);
 746         DWARF=VOCAB("DWARF",1);
 747         KNIFE=VOCAB("KNIFE",1);
 748         FOOD=VOCAB("FOOD",1);
 749         BOTTLE=VOCAB("BOTTL",1);
 750         WATER=VOCAB("WATER",1);
 751         OIL=VOCAB("OIL",1);
 752         PLANT=VOCAB("PLANT",1);
 753         PLANT2=PLANT+1;
 754         AXE=VOCAB("AXE",1);
 755         MIRROR=VOCAB("MIRRO",1);
 756         DRAGON=VOCAB("DRAGO",1);
 757         CHASM=VOCAB("CHASM",1);
 758         TROLL=VOCAB("TROLL",1);
 759         TROLL2=TROLL+1;
 760         BEAR=VOCAB("BEAR",1);
 761         MESSAG=VOCAB("MESSA",1);
 762         VEND=VOCAB("VENDI",1);
 763         BATTER=VOCAB("BATTE",1);
 764 
 765 /* OBJECTS FROM 50 THROUGH WHATEVER ARE TREASURES.  HERE ARE
 766    A FEW.  */
 767 
 768         NUGGET=VOCAB("GOLD",1);
 769         COINS=VOCAB("COINS",1);
 770         CHEST=VOCAB("CHEST",1);
 771         EGGS=VOCAB("EGGS",1);
 772         TRIDNT=VOCAB("TRIDE",1);
 773         VASE=VOCAB("VASE",1);
 774         EMRALD=VOCAB("EMERA",1);
 775         PYRAM=VOCAB("PYRAM",1);
 776         PEARL=VOCAB("PEARL",1);
 777         RUG=VOCAB("RUG",1);
 778         CHAIN=VOCAB("CHAIN",1);
 779 
 780 /* THESE ARE MOTION-VERB NUMBERS. */
 781 
 782         BACK=VOCAB("BACK",0);
 783         LOOK=VOCAB("LOOK",0);
 784         CAVE=VOCAB("CAVE",0);
 785         NULLX=VOCAB("NULL",0);
 786         ENTRNC=VOCAB("ENTRA",0);
 787         DPRSSN=VOCAB("DEPRE",0);
 788 
 789 /* AND SOME ACTION VERBS. */
 790 
 791         SAY=VOCAB("SAY",2);
 792         LOCK=VOCAB("LOCK",2);
 793         THROW=VOCAB("THROW",2);
 794         FIND=VOCAB("FIND",2);
 795         INVENT=VOCAB("INVEN",2);
 796 
 797 /*
 798    INITIALIZE THE DWARVES.  DLOC IS LOC OF DWARVES,
 799    HARD-WIRED IN.  ODLOC IS PRIOR LOC OF EACH DWARF,
 800    INITIALLY GARBAGE.  DALTLC IS ALTERNATE INITIAL LOC FOR
 801    DWARF, IN CASE ONE OF THEM STARTS OUT ON TOP OF THE
 802    ADVENTURER.  (NO 2 OF THE 5 INITIAL LOCS ARE ADJACENT.)
 803    DSEEN IS TRUE IF DWARF HAS SEEN HIM.  DFLAG CONTROLS THE
 804    LEVEL OF ACTIVATION OF ALL THIS:
 805         0       NO DWARF STUFF YET (WAIT UNTIL REACHES HALL
 806                 OF MISTS)
 807         1       REACHED HALL OF MISTS, BUT HASN'T MET FIRST DWARF
 808         2       MET FIRST DWARF, OTHERS START MOVING, NO
 809                 KNIVES THROWN YET
 810         3       A KNIFE HAS BEEN THROWN (FIRST SET ALWAYS
 811                 MISSES)
 812         3+      DWARVES ARE MAD (INCREASES THEIR ACCURACY)
 813    SIXTH DWARF IS SPECIAL (THE PIRATE).  HE ALWAYS STARTS AT
 814    HIS CHEST'S EVENTUAL LOCATION INSIDE THE MAZE.  THIS LOC
 815    IS SAVED IN CHLOC FOR REF.  THE DEAD END IN THE OTHER
 816    MAZE HAS ITS LOC STORED IN CHLOC2.
 817 */
 818 
 819         CHLOC=114;
 820         CHLOC2=140;
 821         do I=1 to 6;
 822             DSEEN(I)="0"b;
 823             end;
 824         DFLAG=0;
 825         DLOC(1)=19;
 826         DLOC(2)=27;
 827         DLOC(3)=33;
 828         DLOC(4)=44;
 829         DLOC(5)=64;
 830         DLOC(6)=CHLOC;
 831         DALTLC=18;
 832 
 833 /*
 834    OTHER RANDOM FLAGS AND COUNTERS, AS FOLLOWS:
 835         TURNS   TALLIES HOW MANY COMMANDS HE'S GIVEN
 836                 (IGNORES YES/NO)
 837         LIMIT   LIFETIME OF LAMP (NOT SET HERE)
 838         IWEST   HOW MANY TIMES HE'S SAID "WEST" INSTEAD OF
 839                 "W"
 840         KNFLOC  0 IF NO KNIFE HERE, LOC IF KNIFE HERE, -1
 841                 AFTER CAVEAT
 842         DETAIL  HOW OFTEN WE'VE SAID "NOT ALLOWED TO GIVE
 843                 MORE DETAIL"
 844         ABBNUM  HOW OFTEN WE SHOULD PRINT NON-ABBREVIATED
 845                 DESCRIPTIONS
 846         MAXDIE  NUMBER OF REINCARNATION MESSAGES AVAILABLE
 847                 (UP TO 5)
 848         NUMDIE  NUMBER OF TIMES KILLED SO FAR
 849         HOLDNG  NUMBER OF OBJECTS BEING CARRIED
 850         DKILL   NUMBER OF DWARVES KILLED (UNUSED IN SCORING,
 851                 NEEDED FOR MSG)
 852         FOOBAR  CURRENT PROGRESS IN SAYING "FEE FIE FOE
 853                 FOO".
 854         BONUS   USED TO DETERMINE AMOUNT OF BONUS IF HE
 855                 REACHES CLOSING
 856         CLOCK1  NUMBER OF TURNS FROM FINDING LAST TREASURE
 857                 TILL CLOSING
 858         CLOCK2  NUMBER OF TURNS FROM FIRST WARNING TILL
 859                 BLINDING FLASH
 860         LOGICALS WERE EXPLAINED EARLIER
 861 */
 862 
 863         TURNS=0;
 864         LMWARN="0"b;
 865         IWEST=0;
 866         KNFLOC=0;
 867         DETAIL=0;
 868         ABBNUM=5;
 869         do I=0 to 4;
 870             if RTEXT(2*I+81) ^= 0 then MAXDIE=I+1;
 871             end;
 872         NUMDIE=0;
 873         HOLDNG=0;
 874         DKILL=0;
 875         FOOBAR=0;
 876         BONUS=0;
 877         CLOCK1=30;
 878         CLOCK2=50;
 879         CLOSNG="0"b;
 880         PANIC="0"b;
 881         CLOSED="0"b;
 882         GAVEUP="0"b;
 883         SCORNG="0"b;
 884 
 885 /* REPORT ON AMOUNT OF ARRAYS ACTUALLY USED, TO PERMIT
 886    REDUCTIONS. */
 887 
 888 
 889         do K=1 to LOCSIZ;
 890             KK=LOCSIZ+1-K;
 891             if LTEXT(KK) ^= 0 then goto L1997;
 892             end;
 893 
 894         OBJ=0;
 895 L1997:  do K=1 to 100;
 896             if PTEXT(K) ^= 0 then OBJ=OBJ+1;
 897             end;
 898 
 899         do K=1 to TABNDX;
 900             if KTAB(K)/1000 = 2 then VERB=KTAB(K)-2000;
 901             end;
 902 
 903         do K=1 to RTXSIZ;
 904             J=RTXSIZ+1-K;
 905             if RTEXT(J) ^= 0 then goto L1991;
 906             end;
 907 
 908 L1991:  K=100;
 909 
 910 /*  FINALLY, SINCE WE"RE CLEARLY SETTING THINGS UP FOR THE
 911    FIRST TIME...  */
 912 
 913         put string (OUTSTR) edit ("Done!") (a);
 914         call LINEOUT;
 915 
 916 /*  START-UP, DWARF STUFF */
 917 
 918 /* CAC L1:     call ITIME(I); */
 919 L1:     I = mod (clock_ (), 512);
 920         do J=1 to I;
 921 /* CAC     call RAN(1); */
 922            K=RAN(1);
 923            end;
 924         I=RAN(1);
 925         HINTED(3)=YES(65,1,0);
 926         LOC,NEWLOC=1;
 927         LIMIT=330;
 928         if HINTED(3) then LIMIT=1000;
 929 
 930 /*  CAN'T LEAVE CAVE ONCE IT'S CLOSING (EXCEPT BY MAIN OFFICE). */
 931 
 932 L2:     if NEWLOC >= 9 | NEWLOC = 0 |  ^ CLOSNG then goto L71;
 933         call RSPEAK(130);
 934         NEWLOC=LOC;
 935         if  ^ PANIC then CLOCK2=15;
 936         PANIC="1"b;
 937 
 938 /*
 939    SEE IF A DWARF HAS SEEN HIM AND HAS COME FROM WHERE HE
 940    WANTS TO GO.  IF SO, THE DWARF'S BLOCKING HIS WAY.  IF
 941    COMING FROM PLACE FORBIDDEN TO PIRATE (DWARVES ROOTED IN
 942    PLACE) LET HIM GET OUT (AND ATTACKED).
 943 */
 944 
 945 L71:    if NEWLOC = LOC | FORCED(LOC) | BITSET(LOC,3) then goto L74;
 946         do I=1 to 5;
 947             if ^ (ODLOC(I) ^= NEWLOC |  ^ DSEEN(I)) then do;
 948                 NEWLOC=LOC;
 949                 call RSPEAK(2);
 950                 goto L74;
 951                 end;
 952             end;
 953 L74:    LOC=NEWLOC;
 954 
 955 /*
 956    DWARF STUFF.  SEE EARLIER COMMENTS FOR DESCRIPTION OF
 957    VARIABLES.  REMEMBER SIXTH DWARF IS PIRATE AND IS THUS
 958    VERY DIFFERENT EXCEPT FOR MOTION RULES.
 959 
 960    FIRST OFF, DON'T LET THE DWARVES FOLLOW HIM INTO A PIT OR
 961    A WALL.  ACTIVATE THE WHOLE MESS THE FIRST TIME HE GETS
 962    AS FAR AS THE HALL OF MISTS (LOC 15).  IF NEWLOC IS
 963    FORBIDDEN TO PIRATE (IN PARTICULAR, IF IT'S BEYOND THE
 964    TROLL BRIDGE), BYPASS DWARF STUFF.  THAT WAY PIRATE CAN'T
 965    STEAL RETURN TOLL, AND DWARVES CAN'T MEET THE BEAR.  ALSO
 966    MEANS DWARVES WON'T FOLLOW HIM INTO DEAD END IN MAZE, BUT
 967    C'EST LA VIE.  THEY'LL WAIT FOR HIM OUTSIDE THE DEAD END.
 968 */
 969 
 970         if LOC = 0 | FORCED(LOC) | BITSET(NEWLOC,3) then goto L2000;
 971         if DFLAG ^= 0 then goto L6000;
 972         if LOC >= 15 then DFLAG=1;
 973         goto L2000;
 974 
 975 /*
 976    WHEN WE ENCOUNTER THE FIRST DWARF, WE KILL 0, 1, OR 2 OF
 977    THE 5 DWARVES.  IF ANY OF THE SURVIVORS IS AT LOC,
 978    REPLACE HIM WITH THE ALTERNATE.
 979 */
 980 
 981 L6000:  if DFLAG ^= 1 then goto L6010;
 982         if LOC < 15 | PCT(95) then goto L2000;
 983         DFLAG=2;
 984         do I=1 to 2;
 985             J=1+RAN(5);
 986             if PCT(50) then DLOC(J)=0;
 987             end;
 988         do I=1 to 5;
 989             if DLOC(I) = LOC then DLOC(I)=DALTLC;
 990             ODLOC(I)=DLOC(I);
 991             end;
 992         call RSPEAK(3);
 993         call DROP(AXE,LOC);
 994         goto L2000;
 995 
 996 /*
 997    THINGS ARE IN FULL SWING.  MOVE EACH DWARF AT RANDOM,
 998    EXCEPT IF HE'S SEEN US HE STICKS WITH US.  DWARVES NEVER
 999    GO TO LOCS <15.  IF WANDERING AT RANDOM, THEY DON'T BACK
1000    UP UNLESS THERE'S NO ALTERNATIVE.  IF THEY DON'T HAVE TO
1001    MOVE, THEY ATTACK.  AND, OF COURSE, DEAD DWARVES DON'T DO
1002    MUCH OF ANYTHING.
1003 */
1004 
1005 L6010:  DTOTAL=0;
1006         ATTACK=0;
1007         STICK=0;
1008         do I=1 to 6;
1009             if DLOC(I) = 0 then goto L6030;
1010             J=1;
1011             KK=DLOC(I);
1012             KK=KEY(KK);
1013             if KK = 0 then goto L6016;
1014 L6012:      NEWLOC=mod(abs(TRAVEL(KK))/1000,1000);
1015             if NEWLOC > 300 | NEWLOC < 15 | NEWLOC = ODLOC(I)
1016               | (J > 1 & NEWLOC = TK(J-1)) | J >= 20
1017               | NEWLOC = DLOC(I) | FORCED(NEWLOC)
1018               | (I = 6 & BITSET(NEWLOC,3))
1019               | abs(TRAVEL(KK))/1000000 = 100 then goto L6014;
1020             TK(J)=NEWLOC;
1021             J=J+1;
1022 L6014:      KK=KK+1;
1023             if TRAVEL(KK-1) >= 0 then goto L6012;
1024 L6016:      TK(J)=ODLOC(I);
1025             if J >= 2 then J=J-1;
1026             J=1+RAN(J);
1027             ODLOC(I)=DLOC(I);
1028             DLOC(I)=TK(J);
1029             DSEEN(I)=(DSEEN(I) & LOC >= 15)
1030              | (DLOC(I) = LOC | ODLOC(I) = LOC);
1031             if ^DSEEN(I) then goto L6030;
1032             DLOC(I)=LOC;
1033             if I ^= 6 then goto L6027;
1034 
1035 /*
1036    THE PIRATE'S SPOTTED HIM.  HE LEAVES HIM ALONE ONCE WE'VE
1037    FOUND CHEST.  K COUNTS IF A TREASURE IS HERE.  IF NOT,
1038    AND TALLY=TALLY2 PLUS ONE FOR AN UNSEEN CHEST, LET THE
1039    PIRATE BE SPOTTED.
1040 */
1041 
1042             if LOC = CHLOC | PROP(CHEST) >= 0 then goto L6030;
1043             K=0;
1044             do J=50 to MAXTRS;
1045 
1046 /* PIRATE WON'T TAKE PYRAMID FROM PLOVER ROOM OR DARK ROOM
1047    (TOO EASY!).  */
1048 
1049                 if J = PYRAM & (LOC = PLAC(PYRAM)
1050                  | LOC = PLAC(EMRALD)) then goto L6020;
1051                 if TOTING(J) then goto L6022;
1052 L6020:          if HERE(J) then K=1;
1053                 end;
1054             if TALLY = TALLY2+1 & K = 0 & PLACE(CHEST) = 0
1055              & HERE(LAMP) & PROP(LAMP) = 1 then goto L6025;
1056             if ODLOC(6) ^= DLOC(6) & PCT(20) then call RSPEAK(127);
1057             goto L6030;
1058 
1059 L6022:      call RSPEAK(128);
1060 
1061 /* DON'TSTEAL CHEST BACK FROM TROLL! */
1062 
1063             if PLACE(MESSAG) = 0 then call MOVE(CHEST,CHLOC);
1064             call MOVE(MESSAG,CHLOC2);
1065             do J=50 to MAXTRS;
1066                 if J = PYRAM & (LOC = PLAC(PYRAM)
1067                  | LOC = PLAC(EMRALD)) then goto L6023;
1068                 if AT(J) & FIXED(J) = 0 then call CARRY(J,LOC);
1069                 if TOTING(J) then call DROP(J,CHLOC);
1070 L6023:          end;
1071 L6024:      DLOC(6)=CHLOC;
1072             ODLOC(6)=CHLOC;
1073             DSEEN(6)="0"b;
1074             goto L6030;
1075 
1076 L6025:      call RSPEAK(186);
1077             call MOVE(CHEST,CHLOC);
1078             call MOVE(MESSAG,CHLOC2);
1079             goto L6024;
1080 
1081 /* THIS THREATENING LITTLE DWARF IS IN THE ROOM WITH HIM! */
1082 
1083 L6027:      DTOTAL=DTOTAL+1;
1084             if ODLOC(I) ^= DLOC(I) then goto L6030;
1085             ATTACK=ATTACK+1;
1086             if KNFLOC >= 0 then KNFLOC=LOC;
1087             if RAN(1000) < 95*(DFLAG-2) then STICK=STICK+1;
1088 L6030:      end;
1089 
1090 /* NOW WE KNOW WHAT'S HAPPENING.  LET'S TELL THE POOR SUCKER
1091    ABOUT IT.  */
1092 
1093         if DTOTAL = 0 then goto L2000;
1094         if DTOTAL = 1 then goto L75;
1095         call LINESKP;
1096         put string (OUTSTR) edit ("There are ",DTOTAL,
1097             " threatening little dwarves in the room with you.")
1098             (a,f(1),a);
1099         call LINEOUT;
1100         goto L77;
1101 L75:    call RSPEAK(4);
1102 L77:    if ATTACK = 0 then goto L2000;
1103         if DFLAG = 2 then DFLAG=3;
1104 
1105 /*
1106    DWARVES GET *VERY* MAD!
1107 */
1108 
1109         if ATTACK = 1 then goto L79;
1110         put string (OUTSTR) edit (ATTACK,
1111            " of them throw knives at you!")
1112             (f(1),a);
1113         call LINEOUT;
1114         K=6;
1115 L82:    if STICK > 1 then goto L83;
1116         call RSPEAK(K+STICK);
1117         if STICK = 0 then goto L2000;
1118         goto L84;
1119 L83:    put string (OUTSTR) edit (STICK," of them get you!") (f(1),a);
1120         call LINEOUT;
1121 L84:    OLDLC2=LOC;
1122         goto L99;
1123 
1124 L79:    call RSPEAK(5);
1125         K=52;
1126         goto L82;
1127 
1128 /* DESCRIBE THE CURRENT LOCATION AND (MAYBE) GET NEXT COMMAND. */
1129 
1130 /* PRINT TEXT FOR CURRENT LOC. */
1131 
1132 L2000:  if LOC = 0 then goto L99;
1133         KK=STEXT(LOC);
1134         if mod(ABB(LOC),ABBNUM) = 0 | KK = 0 then KK=LTEXT(LOC);
1135         if FORCED(LOC) |  ^ DARK(0) then goto L2001;
1136         if WZDARK & PCT(35) then goto L90;
1137         KK=RTEXT(16);
1138 L2001:  if TOTING(BEAR) then call RSPEAK(141);
1139         call SPEAK(KK);
1140         K=1;
1141         if FORCED(LOC) then goto L8;
1142         if LOC = 33 & PCT(25) &  ^ CLOSNG then call RSPEAK(8);
1143 
1144 /*
1145    PRINT OUT DESCRIPTIONS OF OBJECTS AT THIS LOCATION.  IF
1146    NOT CLOSING AND PROPERTY VALUE IS NEGATIVE, TALLY OFF
1147    ANOTHER TREASURE.  RUG IS SPECIAL CASE; ONCE SEEN, ITS
1148    PROP IS 1 (DRAGON ON IT) TILL DRAGON IS KILLED.
1149    SIMILARLY FOR CHAIN; PROP IS INITIALLY 1 (LOCKED TO
1150    BEAR).  THESE HACKS ARE BECAUSE PROP=0 IS NEEDED TO GET
1151    FULL SCORE.
1152 */
1153 
1154         if DARK(0) then goto L2012;
1155         ABB(LOC)=ABB(LOC)+1;
1156         I=ATLOC(LOC);
1157 L2004:   if I = 0 then goto L2012;
1158         OBJ=I;
1159         if OBJ > 100 then OBJ=OBJ-100;
1160         if OBJ = STEPS & TOTING(NUGGET) then goto L2008;
1161         if PROP(OBJ) >= 0 then goto L2006;
1162         if CLOSED then goto L2008;
1163         PROP(OBJ)=0;
1164         if OBJ = RUG | OBJ = CHAIN then PROP(OBJ)=1;
1165         TALLY=TALLY-1;
1166 
1167 /* IF REMAINING TREASURES TOO ELUSIVE, ZAP HIS LAMP. */
1168 
1169         if TALLY = TALLY2 & TALLY ^= 0 then LIMIT=min(35,LIMIT);
1170 L2006:  KK=PROP(OBJ);
1171         if OBJ = STEPS & LOC = FIXED(STEPS) then KK=1;
1172         call PSPEAK(OBJ,KK);
1173 L2008:  I=LINK(I);
1174         goto L2004;
1175 
1176 L2009:  K=54;
1177 L2010:  SPK=K;
1178 L2011:  call RSPEAK(SPK);
1179 
1180 L2012:  VERB=0;
1181         OBJ=0;
1182 
1183 /*
1184    CHECK IF THIS LOC IS ELIGIBLE FOR ANY HINTS.  IF BEEN
1185    HERE LONG ENOUGH, BRANCH TO HELP SECTION (ON LATER PAGE).
1186    HINTS ALL COME BACK HERE EVENTUALLY TO FINISH THE LOOP.
1187    IGNORE "HINTS" < 4 (SPECIAL STUFF, SEE DATABASE NOTES).
1188 */
1189 
1190 L2600:  do HINT=4 to HNTMAX;
1191             if ^ (HINTED(HINT)) then do;
1192                 if ^BITSET(LOC,HINT) then HINTLC(HINT)=-1;
1193                 HINTLC(HINT)=HINTLC(HINT)+1;
1194                 if HINTLC(HINT) >= HINTS(HINT,1) then goto L40000;
1195                 end;
1196             end;
1197 
1198 /*
1199    KICK THE RANDOM NUMBER GENERATOR JUST TO ADD VARIETY TO
1200    THE CHASE.  ALSO, IF CLOSING TIME, CHECK FOR ANY OBJECTS
1201    BEING TOTED WITH PROP < 0 AND SET THE PROP TO -1-PROP.
1202    THIS WAY OBJECTS WON'T BE DESCRIBED UNTIL THEY'VE BEEN
1203    PICKED UP AND PUT DOWN SEPARATE FROM THEIR RESPECTIVE
1204    PILES.  DON'T TICK CLOCK1 UNLESS WELL INTO CAVE (AND NOT
1205    AT Y2).
1206 */
1207 
1208 L2602:  if ^CLOSED then goto L2605;
1209         if PROP(OYSTER) < 0 & TOTING(OYSTER)
1210                then call PSPEAK(OYSTER,1);
1211         do I=1 to 100;
1212             if TOTING(I) & PROP(I) < 0 then PROP(I)=-1-PROP(I);
1213             end;
1214 L2605:  WZDARK=DARK(0);
1215         if KNFLOC > 0 & KNFLOC ^= LOC then KNFLOC=0;
1216         I=RAN(1);
1217         call GETIN(WD1,WD1X,WD2,WD2X);
1218 
1219 /*
1220    EVERY INPUT, CHECK "FOOBAR" FLAG.  IF ZERO, NOTHING'S
1221    GOING ON.  IF POS, MAKE NEG.  IF NEG, HE SKIPPED A WORD,
1222    SO MAKE IT ZERO.
1223 */
1224 
1225 L2608:  FOOBAR=min(0,-FOOBAR);
1226         TURNS=TURNS+1;
1227         if VERB = SAY & WD2 ^= "     " then VERB=0;
1228         if VERB = SAY then goto L4090;
1229         if TALLY = 0 & LOC >= 15 & LOC ^= 33 then CLOCK1=CLOCK1-1;
1230         if CLOCK1 = 0 then goto L10000;
1231         if CLOCK1 < 0 then CLOCK2=CLOCK2-1;
1232         if CLOCK2 = 0 then goto L11000;
1233         if PROP(LAMP) = 1 then LIMIT=LIMIT-1;
1234         if LIMIT <= 30 & HERE(BATTER) & PROP(BATTER) = 0
1235          & HERE(LAMP) then goto L12000;
1236         if LIMIT = 0 then goto L12400;
1237         if LIMIT < 0 & LOC <= 8 then goto L12600;
1238         if LIMIT <= 30 then goto L12200;
1239 L19999: K=43;
1240         if LIQLOC(LOC) = WATER then K=70;
1241         if WD1 = "ENTER" & (WD2 = "STREA" | WD2 = "WATER")
1242          then goto L2010;
1243         if WD1 = "ENTER" & WD2 ^= "    " then goto L2800;
1244         if (WD1 ^= "WATER" & WD1 ^= "OIL")
1245          | (WD2 ^= "PLANT" & WD2 ^= "DOOR") then goto L2610;
1246         if AT(VOCAB(WD2,1)) then WD2="POUR";
1247 L2610:  if WD1 ^= "WEST" then goto L2630;
1248         IWEST=IWEST+1;
1249         if IWEST = 10 then call RSPEAK(17);
1250 L2630:  I=VOCAB(WD1,-1);
1251         if I = -1 then goto L3000;
1252         K=mod(I,1000);
1253         KQ=I/1000+1;
1254 /* CAC
1255         select (KQ-1);
1256            when (0) goto L8;
1257            when (1) goto L5000;
1258            when (2) goto L4000;
1259            when (3) goto L2010;
1260            end;
1261 */
1262         if KQ - 1 = 0 then goto L8;
1263         if KQ - 1 = 1 then goto L5000;
1264         if KQ - 1 = 2 then goto L4000;
1265         if KQ - 1 = 3 then goto L2010;
1266         call BUG(22);
1267 
1268 /* GET SECOND WORD FOR ANALYSIS. */
1269 
1270 L2800:  WD1=WD2;
1271         WD1X=WD2X;
1272         WD2="     ";
1273         goto L2610;
1274 
1275 /* GEE, I DON'T UNDERSTAND. */
1276 
1277 L3000:  SPK=60;
1278         if PCT(20) then SPK=61;
1279         if PCT(20) then SPK=13;
1280         call RSPEAK(SPK);
1281         goto L2600;
1282 
1283 /*
1284    ANALYSE A VERB.  REMEMBER WHAT IT WAS, GO BACK FOR OBJECT
1285    IF SECOND WORD UNLESS VERB IS "SAY", WHICH SNARFS
1286    ARBITRARY SECOND WORD.
1287 */
1288 
1289 L4000:  VERB=K;
1290         SPK=ACTSPK(VERB);
1291         if WD2 ^= "     " & VERB ^= SAY then goto L2800;
1292         if VERB = SAY then
1293             if WD2 = "     " then goto L4080;
1294                              else goto L4090;
1295         if OBJ ^= 0 then goto L4090;
1296 
1297 /* ANALYSE AN INTRANSITIVE VERB (IE, NO OBJECT GIVEN YET). */
1298 
1299 /* CAC recoded 'select' */
1300 L4080:  if VERB = 01 then goto L8010;       /* TAKE */
1301         if VERB = 02 then goto L8000;       /* DROP */
1302         if VERB = 03 then goto L8000;       /* SAY */
1303         if VERB = 04 then goto L8040;       /* OPEN */
1304         if VERB = 05 then goto L2009;       /* NOTH */
1305         if VERB = 06 then goto L8040;       /* LOCK */
1306         if VERB = 07 then goto L9070;       /* ON */
1307         if VERB = 08 then goto L9080;       /* OFF */
1308         if VERB = 09 then goto L8000;       /* WAVE */
1309         if VERB = 10 then goto L8000;       /* CALM */
1310         if VERB = 11 then goto L2011;       /* WALK */
1311         if VERB = 12 then goto L9120;       /* KILL */
1312         if VERB = 13 then goto L9130;       /* POUR */
1313         if VERB = 14 then goto L8140;       /* EAT */
1314         if VERB = 15 then goto L9150;       /* DRNK */
1315         if VERB = 16 then goto L8000;       /* RUB */
1316         if VERB = 17 then goto L8000;       /* TOSS */
1317         if VERB = 18 then goto L8180;       /* QUIT */
1318         if VERB = 19 then goto L8000;       /* FIND */
1319         if VERB = 20 then goto L8200;       /* INVN */
1320         if VERB = 21 then goto L8000;       /* FEED */
1321         if VERB = 22 then goto L9220;       /* FILL */
1322         if VERB = 23 then goto L9230;       /* BLST */
1323         if VERB = 24 then goto L8240;       /* SCOR */
1324         if VERB = 25 then goto L8250;       /* FOO */
1325         if VERB = 26 then goto L8260;       /* BRF */
1326         if VERB = 27 then goto L8270;       /* READ */
1327         if VERB = 28 then goto L8000;       /* BREK */
1328         if VERB = 29 then goto L8000;       /* WAKE */
1329         if VERB = 30 then goto L8300;       /* SUSP */
1330         if VERB = 31 then goto L8310;       /* HOUR */
1331         if VERB = 32 then goto SETLOG;      /* LOG  */
1332 
1333         call BUG(23);
1334 
1335 /* ANALYSE A TRANSITIVE VERB. */
1336 
1337 /* CAC recoded 'select' */
1338 L4090:  if VERB = 01 then goto L9010;       /* TAKE */
1339         if VERB = 02 then goto L9020;       /* DROP */
1340         if VERB = 03 then goto L9030;       /* SAY */
1341         if VERB = 04 then goto L9040;       /* OPEN */
1342         if VERB = 05 then goto L2009;       /* NOTH */
1343         if VERB = 06 then goto L9040;       /* LOCK */
1344         if VERB = 07 then goto L9070;       /* ON */
1345         if VERB = 08 then goto L9080;       /* OFF */
1346         if VERB = 09 then goto L9090;       /* WAVE */
1347         if VERB = 10 then goto L2011;       /* CALM */
1348         if VERB = 11 then goto L2011;       /* WALK */
1349         if VERB = 12 then goto L9120;       /* KILL */
1350         if VERB = 13 then goto L9130;       /* POUR */
1351         if VERB = 14 then goto L9140;       /* EAT */
1352         if VERB = 15 then goto L9150;       /* DRNK */
1353         if VERB = 16 then goto L9160;       /* RUB */
1354         if VERB = 17 then goto L9170;       /* TOSS */
1355         if VERB = 18 then goto L2011;       /* QUIT */
1356         if VERB = 19 then goto L9190;       /* FIND */
1357         if VERB = 20 then goto L9190;       /* INVN */
1358         if VERB = 21 then goto L9210;       /* FEED */
1359         if VERB = 22 then goto L9220;       /* FILL */
1360         if VERB = 23 then goto L9230;       /* BLST */
1361         if VERB = 24 then goto L2011;       /* SCOR */
1362         if VERB = 25 then goto L2011;       /* FOO */
1363         if VERB = 26 then goto L2011;       /* BRF */
1364         if VERB = 27 then goto L9270;       /* READ */
1365         if VERB = 28 then goto L9280;       /* BREK */
1366         if VERB = 29 then goto L9290;       /* WAKE */
1367         if VERB = 30 then goto L2011;       /* SUSP */
1368         if VERB = 31 then goto L2011;       /* HOUR */
1369         if VERB = 32 then goto L2011;       /* LOG  */
1370         call BUG(24);
1371 
1372 /*
1373    ANALYSE AN OBJECT WORD.  SEE IF THE THING IS HERE,
1374    WHETHER WE'VE GOT A VERB YET, AND SO ON.  OBJECT MUST BE
1375    HERE UNLESS VERB IS "FIND" OR "INVENT(ORY)" (AND NO NEW
1376    VERB YET TO BE ANALYSED).  WATER AND OIL ARE ALSO FUNNY,
1377    SINCE THEY ARE NEVER ACTUALLY DROPPED AT ANY LOCATION,
1378    BUT MIGHT BE HERE INSIDE THE BOTTLE OR AS A FEATURE OF
1379    THE LOCATION.
1380 */
1381 
1382 L5000:  OBJ=K;
1383         if FIXED(K) ^= LOC &  ^ HERE(K) then goto L5100;
1384 L5010:  if WD2 ^= "     " then goto L2800;
1385         if VERB ^= 0 then goto L4090;
1386         call A5TOA1(WD1,WD1X,TKWORD,K);
1387         call LINESKP;
1388         put string (OUTSTR) edit ("What do you want to do with the ",
1389             (TKWORD(I) do I=1 to K)) (a,20 a);
1390         call LINEOUT;
1391         goto L2600;
1392 
1393 L5100:  if K ^= GRATE then goto L5110;
1394         if LOC = 1 | LOC = 4 | LOC = 7 then K=DPRSSN;
1395         if LOC > 9 & LOC < 15 then K=ENTRNC;
1396         if K ^= GRATE then goto L8;
1397 L5110:  if K ^= DWARF then goto L5120;
1398         do I=1 to 5;
1399             if DLOC(I) = LOC & DFLAG >= 2 then goto L5010;
1400             end;
1401 L5120:  if (LIQ(0) = K & HERE(BOTTLE))
1402                | K = LIQLOC(LOC) then goto L5010;
1403         if OBJ ^= PLANT |  ^ AT(PLANT2) | PROP(PLANT2) = 0
1404               then goto L5130;
1405         OBJ=PLANT2;
1406         goto L5010;
1407 L5130:  if OBJ ^= KNIFE | KNFLOC ^= LOC then goto L5140;
1408         KNFLOC=-1;
1409         SPK=116;
1410         goto L2011;
1411 L5140:  if OBJ ^= ROD |  ^HERE(ROD2) then goto L5190;
1412         OBJ=ROD2;
1413         goto L5010;
1414 L5190:  if (VERB = FIND | VERB = INVENT) & WD2 = "     "
1415              then goto L5010;
1416         call A5TOA1(WD1,WD1X,TKWORD,K);
1417         call LINESKP;
1418         put string (OUTSTR) edit
1419              ("I see no ",(TKWORD(I) do I=1 to K)," here!")
1420             (a,20 a);
1421         call LINEOUT;
1422         goto L2012;
1423 /*
1424    FIGURE OUT THE NEW LOCATION
1425 
1426    GIVEN THE CURRENT LOCATION IN "LOC", AND A MOTION VERB
1427    NUMBER IN "K", PUT THE NEW LOCATION IN "NEWLOC".  THE
1428    CURRENT LOC IS SAVED IN "OLDLOC" IN CASE HE WANTS TO
1429    RETREAT.  THE CURRENT OLDLOC IS SAVED IN OLDLC2, IN CASE
1430    HE DIES.  (IF HE DOES, NEWLOC WILL BE LIMBO, AND OLDLOC
1431    WILL BE WHAT KILLED HIM, SO WE NEED OLDLC2, WHICH IS THE
1432    LAST PLACE HE WAS SAFE.)
1433 */
1434 
1435 L8:     KK=KEY(LOC);
1436         NEWLOC=LOC;
1437         if KK = 0 then call BUG(26);
1438         if K = NULLX then goto L2;
1439         if K = BACK then goto L20;
1440         if K = LOOK then goto L30;
1441         if K = CAVE then goto L40;
1442         OLDLC2=OLDLOC;
1443         OLDLOC=LOC;
1444 
1445 L9:     LL=abs(TRAVEL(KK));
1446         if mod(LL,1000) = 1 | mod(LL,1000) = K then goto L10;
1447         if TRAVEL(KK) < 0 then goto L50;
1448         KK=KK+1;
1449         goto L9;
1450 
1451 L10:    LL=LL/1000;
1452 L11:    NEWLOC=LL/1000;
1453         K=mod(NEWLOC,100);
1454         if NEWLOC <= 300 then goto L13;
1455         if PROP(K) ^= NEWLOC/100-3 then goto L16;
1456 L12:    if TRAVEL(KK) < 0 then call BUG(25);
1457         KK=KK+1;
1458         NEWLOC=abs(TRAVEL(KK))/1000;
1459         if NEWLOC = LL then goto L12;
1460         LL=NEWLOC;
1461         goto L11;
1462 
1463 L13:    if NEWLOC <= 100 then goto L14;
1464         if TOTING(K) | (NEWLOC > 200 & AT(K)) then goto L16;
1465         goto L12;
1466 
1467 L14:    if NEWLOC ^= 0 &  ^PCT(NEWLOC) then goto L12;
1468 L16:    NEWLOC=mod(LL,1000);
1469         if NEWLOC <= 300 then goto L2;
1470         if NEWLOC <= 500 then goto L30000;
1471         call RSPEAK(NEWLOC-500);
1472         NEWLOC=LOC;
1473         goto L2;
1474 
1475 /*
1476    SPECIAL MOTIONS COME HERE.  LABELLING CONVENTION:
1477    STATEMENT NUMBERS NNNXX (XX=00-99) ARE USED FOR SPECIAL
1478    CASE NUMBER NNN (NNN=301-500).
1479 */
1480 
1481 L30000: NEWLOC=NEWLOC-300;
1482 /* CAC recoded 'select' */
1483         if NEWLOC-1 = 00 then goto L30100;
1484         if NEWLOC-1 = 01 then goto L30200;
1485         if NEWLOC-1 = 02 then goto L30300;
1486         call BUG(20);
1487 
1488 /*
1489    TRAVEL 301.  PLOVER-ALCOVE PASSAGE.  CAN CARRY ONLY
1490    EMERALD.  NOTE:  TRAVEL TABLE MUST INCLUDE "USELESS"
1491    ENTRIES GOING THROUGH PASSAGE, WHICH CAN NEVER BE USED
1492    FOR ACTUAL MOTION, BUT CAN BE SPOTTED BY "GO BACK".
1493 */
1494 
1495 L30100: NEWLOC=99+100-LOC;
1496         if HOLDNG = 0 | (HOLDNG = 1 & TOTING(EMRALD)) then goto L2;
1497         NEWLOC=LOC;
1498         call RSPEAK(117);
1499         goto L2;
1500 
1501 /*
1502    TRAVEL 302.  PLOVER TRANSPORT.  DROP THE EMERALD (ONLY
1503    USE SPECIAL TRAVEL IF TOTING IT), SO HE'S FORCED TO USE
1504    THE PLOVER-PASSAGE TO GET IT OUT.  HAVING DROPPED IT, GO
1505    BACK AND PRETEND HE WASN'T CARRYING IT AFTER ALL.
1506 */
1507 
1508 L30200: call DROP(EMRALD,LOC);
1509         goto L12;
1510 
1511 /*
1512    TRAVEL 303.  TROLL BRIDGE.  MUST BE DONE ONLY AS SPECIAL
1513    MOTION SO THAT DWARVES WON'T WANDER ACROSS AND ENCOUNTER
1514    THE BEAR.  (THEY WON'T FOLLOW THE PLAYER THERE BECAUSE
1515    THAT REGION IS FORBIDDEN TO THE PIRATE.) IF
1516    PROP(TROLL)=1, HE'S CROSSED SINCE PAYING, SO STEP OUT AND
1517    BLOCK HIM.  (STANDARD TRAVEL ENTRIES CHECK FOR
1518    PROP(TROLL)=0.) SPECIAL STUFF FOR BEAR.
1519 */
1520 
1521 L30300: if PROP(TROLL) ^= 1 then goto L30310;
1522         call PSPEAK(TROLL,1);
1523         PROP(TROLL)=0;
1524         call MOVE(TROLL2,0);
1525         call MOVE(TROLL2+100,0);
1526         call MOVE(TROLL,PLAC(TROLL));
1527         call MOVE(TROLL+100,FIXD(TROLL));
1528         call JUGGLE(CHASM);
1529         NEWLOC=LOC;
1530         goto L2;
1531 
1532 L30310: NEWLOC=PLAC(TROLL)+FIXD(TROLL)-LOC;
1533         if PROP(TROLL) = 0 then PROP(TROLL)=1;
1534         if ^TOTING(BEAR) then goto L2;
1535         call RSPEAK(162);
1536         PROP(CHASM)=1;
1537         PROP(TROLL)=2;
1538         call DROP(BEAR,NEWLOC);
1539         FIXED(BEAR)=-1;
1540         PROP(BEAR)=3;
1541         if PROP(SPICES) < 0 then TALLY2=TALLY2+1;
1542         OLDLC2=NEWLOC;
1543         goto L99;
1544 
1545 /* END OF SPECIALS. */
1546 
1547 /*
1548    HANDLE "GO BACK".  LOOK FOR VERB WHICH GOES FROM LOC TO
1549    OLDLOC, OR TO OLDLC2 IF OLDLOC HAS FORCED-MOTION.  K2
1550    SAVES ENTRY -> FORCED LOC -> PREVIOUS LOC.
1551 */
1552 
1553 L20:    K=OLDLOC;
1554         if FORCED(K) then K=OLDLC2;
1555         OLDLC2=OLDLOC;
1556         OLDLOC=LOC;
1557         K2=0;
1558         if K ^= LOC then goto L21;
1559         call RSPEAK(91);
1560         goto L2;
1561 
1562 L21:    LL=mod((abs(TRAVEL(KK))/1000),1000);
1563         if LL = K then goto L25;
1564         if LL > 300 then goto L22;
1565         J=KEY(LL);
1566         if FORCED(LL) & mod((abs(TRAVEL(J))/1000),1000) = K
1567              then K2=KK;
1568 L22:    if TRAVEL(KK) < 0 then goto L23;
1569         KK=KK+1;
1570         goto L21;
1571 
1572 L23:    KK=K2;
1573         if KK ^= 0 then goto L25;
1574         call RSPEAK(140);
1575         goto L2;
1576 
1577 L25:    K=mod(abs(TRAVEL(KK)),1000);
1578         KK=KEY(LOC);
1579         goto L9;
1580 
1581 /*
1582    LOOK.  CAN'T GIVE MORE DETAIL.  PRETEND IT WASN'T DARK
1583    (THOUGH IT MAY "NOW" BE DARK) SO HE WON'T FALL INTO A PIT
1584    WHILE STARING INTO THE GLOOM.
1585 */
1586 
1587 L30:    if DETAIL < 3 then call RSPEAK(15);
1588         DETAIL=DETAIL+1;
1589         WZDARK="0"b;
1590         ABB(LOC)=0;
1591         goto L2;
1592 
1593 /* CAVE.  DIFFERENT MESSAGES DEPENDING ON WHETHER ABOVE GROUND. */
1594 
1595 L40:    if LOC < 8 then call RSPEAK(57);
1596         if LOC >= 8 then call RSPEAK(58);
1597         goto L2;
1598 
1599 /* NON-APPLICABLE MOTION.  VARIOUS MESSAGES DEPENDING ON
1600    WORD GIVEN.  */
1601 
1602 L50:    SPK=12;
1603         if K >= 43 & K <= 50 then SPK=9;
1604         if K = 29 | K = 30 then SPK=9;
1605         if K = 7 | K = 36 | K = 37 then SPK=10;
1606         if K = 11 | K = 19 then SPK=11;
1607         if VERB = FIND | VERB = INVENT then SPK=59;
1608         if K = 62 | K = 65 then SPK=42;
1609         if K = 17 then SPK=80;
1610         call RSPEAK(SPK);
1611         goto L2;
1612 
1613 /*
1614    "YOU'RE DEAD, JIM."
1615 
1616    IF THE CURRENT LOC IS ZERO, IT MEANS THE CLOWN GOT
1617    HIMSELF KILLED.  WE'LL ALLOW THIS MAXDIE TIMES.  MAXDIE
1618    IS AUTOMATICALLY SET BASED ON THE NUMBER OF SNIDE
1619    MESSAGES AVAILABLE.  EACH DEATH RESULTS IN A MESSAGE (81,
1620    83, ETC.) WHICH OFFERS REINCARNATION; IF ACCEPTED, THIS
1621    RESULTS IN MESSAGE 82, 84, ETC.  THE LAST TIME, IF HE
1622    WANTS ANOTHER CHANCE, HE GETS A SNIDE REMARK AS WE EXIT.
1623    WHEN REINCARNATED, ALL OBJECTS BEING CARRIED GET DROPPED
1624    AT OLDLC2 (PRESUMABLY THE LAST PLACE PRIOR TO BEING
1625    KILLED) WITHOUT CHANGE OF PROPS.  THE LOOP RUNS BACKWARDS
1626    TO ASSURE THAT THE BIRD IS DROPPED BEFORE THE CAGE.
1627    (THIS KLUGE COULD BE CHANGED ONCE WE'RE SURE ALL
1628    REFERENCES TO BIRD AND CAGE ARE DONE BY KEYWORDS.) THE
1629    LAMP IS A SPECIAL CASE (IT WOULDN'T DO TO LEAVE IT IN THE
1630    CAVE).  IT IS TURNED OFF AND LEFT OUTSIDE THE BUILDING
1631    (ONLY IF HE WAS CARRYING IT, OF COURSE).  HE HIMSELF IS
1632    LEFT INSIDE THE BUILDING (AND HEAVEN HELP HIM IF HE TRIES
1633    TO XYZZY BACK INTO THE CAVE WITHOUT THE LAMP!).  OLDLOC
1634    IS ZAPPED SO HE CAN'T JUST "RETREAT".
1635 
1636    THE EASIEST WAY TO GET KILLED IS TO FALL INTO A PIT IN
1637    PITCH DARKNESS.
1638 */
1639 
1640 L90:    call RSPEAK(23);
1641         OLDLC2=LOC;
1642 
1643 /* OKAY, HE'S DEAD.  LET'S GET ON WITH IT. */
1644 
1645 L99:    if CLOSNG then goto L95;
1646         YEA=YES(81+NUMDIE*2,82+NUMDIE*2,54);
1647         NUMDIE=NUMDIE+1;
1648         if NUMDIE = MAXDIE |  ^YEA then goto L20000;
1649         PLACE(WATER)=0;
1650         PLACE(OIL)=0;
1651         if TOTING(LAMP) then PROP(LAMP)=0;
1652         do J=1 to 100;
1653             I=101-J;
1654             if ^TOTING(I) then goto L98;
1655             K=OLDLC2;
1656             if I = LAMP then K=1;
1657             call DROP(I,K);
1658 L98:        end;
1659         LOC=3;
1660         OLDLOC=LOC;
1661         goto L2000;
1662 
1663 /* HE DIED DURING CLOSING TIME.  NO RESURRECTION.  TALLY UP
1664    A DEATH AND EXIT.  */
1665 
1666 L95:    call RSPEAK(131);
1667         NUMDIE=NUMDIE+1;
1668         goto L20000;
1669 
1670 /*
1671    ROUTINES FOR PERFORMING THE VARIOUS ACTION VERBS
1672 
1673    STATEMENT NUMBERS IN THIS SECTION ARE 8000 FOR
1674    INTRANSITIVE VERBS, 9000 FOR TRANSITIVE, PLUS TEN TIMES
1675    THE VERB NUMBER.  MANY INTRANSITIVE VERBS USE THE
1676    TRANSITIVE CODE, AND SOME VERBS USE CODE FOR OTHER VERBS,
1677    AS NOTED BELOW.
1678 
1679    RANDOM INTRANSITIVE VERBS COME HERE.  CLEAR OBJ JUST IN
1680    CASE (SEE "ATTACK").
1681 */
1682 
1683 L8000:  call A5TOA1(WD1,WD1X,TKWORD,K);
1684         call LINESKP;
1685         put string (OUTSTR) edit
1686              ((TKWORD(I) do I=1 to K)," what?") (a,20 a);
1687         call LINEOUT;
1688         OBJ=0;
1689         goto L2600;
1690 
1691 /* CARRY, NO OBJECT GIVEN YET.  OK IF ONLY ONE OBJECT PRESENT. */
1692 
1693 L8010:  if ATLOC(LOC) = 0 | LINK(ATLOC(LOC)) ^= 0 then goto L8000;
1694         do I=1 to 5;
1695             if DLOC(I) = LOC & DFLAG >= 2 then goto L8000;
1696             end;
1697         OBJ=ATLOC(LOC);
1698 
1699 /*
1700    CARRY AN OBJECT.  SPECIAL CASES FOR BIRD AND CAGE (IF
1701    BIRD IN CAGE, CAN'T TAKE ONE WITHOUT THE OTHER.  LIQUIDS
1702    ALSO SPECIAL, SINCE THEY DEPEND ON STATUS OF BOTTLE.
1703    ALSO VARIOUS SIDE EFFECTS, ETC.
1704 */
1705 
1706 L9010:  if TOTING(OBJ) then goto L2011;
1707         SPK=25;
1708         if OBJ = PLANT & PROP(PLANT) <= 0 then SPK=115;
1709         if OBJ = BEAR & PROP(BEAR) = 1 then SPK=169;
1710         if OBJ = CHAIN & PROP(BEAR) ^= 0 then SPK=170;
1711         if FIXED(OBJ) ^= 0 then goto L2011;
1712         if OBJ ^= WATER & OBJ ^= OIL then goto L9017;
1713         if HERE(BOTTLE) & LIQ(0) = OBJ then goto L9018;
1714         OBJ=BOTTLE;
1715         if TOTING(BOTTLE) & PROP(BOTTLE) = 1 then goto L9220;
1716         if PROP(BOTTLE) ^= 1 then SPK=105;
1717         if ^TOTING(BOTTLE) then SPK=104;
1718         goto L2011;
1719 L9018:  OBJ=BOTTLE;
1720 L9017:  if HOLDNG < 7 then goto L9016;
1721         call RSPEAK(92);
1722         goto L2012;
1723 L9016:  if OBJ ^= BIRD then goto L9014;
1724         if PROP(BIRD) ^= 0 then goto L9014;
1725         if ^TOTING(ROD) then goto L9013;
1726         call RSPEAK(26);
1727         goto L2012;
1728 L9013:  if TOTING(CAGE) then goto L9015;
1729         call RSPEAK(27);
1730         goto L2012;
1731 L9015:  PROP(BIRD)=1;
1732 L9014:  if (OBJ = BIRD | OBJ = CAGE) & PROP(BIRD) ^= 0
1733             then call CARRY(BIRD+CAGE-OBJ,LOC);
1734         call CARRY(OBJ,LOC);
1735         K=LIQ(0);
1736         if OBJ = BOTTLE & K ^= 0 then PLACE(K)=-1;
1737         goto L2009;
1738 
1739 /*
1740    DISCARD OBJECT.  "THROW" ALSO COMES HERE FOR MOST
1741    OBJECTS.  SPECIAL CASES FOR BIRD (MIGHT ATTACK SNAKE OR
1742    DRAGON) AND CAGE (MIGHT CONTAIN BIRD) AND VASE.  DROP
1743    COINS AT VENDING MACHINE FOR EXTRA BATTERIES.
1744 */
1745 
1746 L9020:  if TOTING(ROD2) & OBJ = ROD &  ^ TOTING(ROD) then OBJ=ROD2;
1747         if ^TOTING(OBJ) then goto L2011;
1748         if OBJ ^= BIRD |  ^ HERE(SNAKE) then goto L9024;
1749         call RSPEAK(30);
1750         if CLOSED then goto L19000;
1751         call DSTROY(SNAKE);
1752 
1753 /* SET PROP FOR USE BY TRAVEL OPTIONS */
1754 
1755         PROP(SNAKE)=1;
1756 L9021:  K=LIQ(0);
1757         if K = OBJ then OBJ=BOTTLE;
1758         if OBJ = BOTTLE & K ^= 0 then PLACE(K)=0;
1759         if OBJ = CAGE & PROP(BIRD) ^= 0 then call DROP(BIRD,LOC);
1760         if OBJ = BIRD then PROP(BIRD)=0;
1761         call DROP(OBJ,LOC);
1762         goto L2012;
1763 
1764 L9024:  if OBJ ^= COINS |  ^ HERE(VEND) then goto L9025;
1765         call DSTROY(COINS);
1766         call DROP(BATTER,LOC);
1767         call PSPEAK(BATTER,0);
1768         goto L2012;
1769 
1770 L9025:  if OBJ ^= BIRD |  ^ AT(DRAGON) | PROP(DRAGON) ^= 0
1771                then goto L9026;
1772         call RSPEAK(154);
1773         call DSTROY(BIRD);
1774         PROP(BIRD)=0;
1775         if PLACE(SNAKE) = PLAC(SNAKE) then TALLY2=TALLY2+1;
1776         goto L2012;
1777 
1778 L9026:  if OBJ ^= BEAR |  ^AT(TROLL) then goto L9027;
1779         call RSPEAK(163);
1780         call MOVE(TROLL,0);
1781         call MOVE(TROLL+100,0);
1782         call MOVE(TROLL2,PLAC(TROLL));
1783         call MOVE(TROLL2+100,FIXD(TROLL));
1784         call JUGGLE(CHASM);
1785         PROP(TROLL)=2;
1786         goto L9021;
1787 
1788 L9027:  if OBJ = VASE & LOC ^= PLAC(PILLOW) then goto L9028;
1789         call RSPEAK(54);
1790         goto L9021;
1791 
1792 L9028:  PROP(VASE)=2;
1793         if AT(PILLOW) then PROP(VASE)=0;
1794         call PSPEAK(VASE,PROP(VASE)+1);
1795         if PROP(VASE) ^= 0 then FIXED(VASE)=-1;
1796         goto L9021;
1797 
1798 /* SAY.  ECHO WD2 (OR WD1 IF NO WD2 (SAY WHAT?, ETC.).)
1799    MAGIC WORDS OVERRIDE.  */
1800 
1801 L9030:  call A5TOA1(WD2,WD2X,TKWORD,K);
1802         if WD2 = "     " then call A5TOA1(WD1,WD1X,TKWORD,K);
1803         if WD2 ^= "     " then WD1=WD2;
1804         I=VOCAB(WD1,-1);
1805         if I = 62 | I = 65 | I = 71 | I = 2025 then goto L9035;
1806         call LINESKP;
1807         put string (OUTSTR) edit
1808                ("Okay, '",(TKWORD(I) do I=1 to K),"'.") (a,20 a);
1809         call LINEOUT;
1810         goto L2012;
1811 
1812 L9035:  WD2="     ";
1813         OBJ=0;
1814         goto L2630;
1815 
1816 /* LOCK, UNLOCK, NO OBJECT GIVEN.  ASSUME VARIOUS THINGS IF
1817    PRESENT.  */
1818 
1819 L8040:  SPK=28;
1820         if HERE(CLAM) then OBJ=CLAM;
1821         if HERE(OYSTER) then OBJ=OYSTER;
1822         if AT(DOOR) then OBJ=DOOR;
1823         if AT(GRATE) then OBJ=GRATE;
1824         if OBJ ^= 0 & HERE(CHAIN) then goto L8000;
1825         if HERE(CHAIN) then OBJ=CHAIN;
1826         if OBJ = 0 then goto L2011;
1827 
1828 /* LOCK, UNLOCK OBJECT.  SPECIAL STUFF FOR OPENING
1829    CLAM/OYSTER AND FOR CHAIN.  */
1830 
1831 L9040:  if OBJ = CLAM | OBJ = OYSTER then goto L9046;
1832         if OBJ = DOOR then SPK=111;
1833         if OBJ = DOOR & PROP(DOOR) = 1 then SPK=54;
1834         if OBJ = CAGE then SPK=32;
1835         if OBJ = KEYS then SPK=55;
1836         if OBJ = GRATE | OBJ = CHAIN then SPK=31;
1837         if SPK ^= 31 |  ^ HERE(KEYS) then goto L2011;
1838         if OBJ = CHAIN then goto L9048;
1839         if ^CLOSNG then goto L9043;
1840         K=130;
1841         if ^PANIC then CLOCK2=15;
1842         PANIC="1"b;
1843         goto L2010;
1844 
1845 L9043:  K=34+PROP(GRATE);
1846         PROP(GRATE)=1;
1847         if VERB = LOCK then PROP(GRATE)=0;
1848         K=K+2*PROP(GRATE);
1849         goto L2010;
1850 
1851 /* CLAM/OYSTER. */
1852 
1853 L9046:  K=0;
1854         if OBJ = OYSTER then K=1;
1855         SPK=124+K;
1856         if TOTING(OBJ) then SPK=120+K;
1857         if ^TOTING(TRIDNT) then SPK=122+K;
1858         if VERB = LOCK then SPK=61;
1859         if SPK ^= 124 then goto L2011;
1860         call DSTROY(CLAM);
1861         call DROP(OYSTER,LOC);
1862         call DROP(PEARL,105);
1863         goto L2011;
1864 
1865 /* CHAIN. */
1866 
1867 L9048:  if VERB = LOCK then goto L9049;
1868         SPK=171;
1869         if PROP(BEAR) = 0 then SPK=41;
1870         if PROP(CHAIN) = 0 then SPK=37;
1871         if SPK ^= 171 then goto L2011;
1872         PROP(CHAIN)=0;
1873         FIXED(CHAIN)=0;
1874         if PROP(BEAR) ^= 3 then PROP(BEAR)=2;
1875         FIXED(BEAR)=2-PROP(BEAR);
1876         goto L2011;
1877 
1878 L9049:  SPK=172;
1879         if PROP(CHAIN) ^= 0 then SPK=34;
1880         if LOC ^= PLAC(CHAIN) then SPK=173;
1881         if SPK ^= 172 then goto L2011;
1882         PROP(CHAIN)=2;
1883         if TOTING(CHAIN) then call DROP(CHAIN,LOC);
1884         FIXED(CHAIN)=-1;
1885         goto L2011;
1886 
1887 /* LIGHT LAMP */
1888 
1889 L9070:  if ^HERE(LAMP) then goto L2011;
1890         SPK=184;
1891         if LIMIT < 0 then goto L2011;
1892         PROP(LAMP)=1;
1893         call RSPEAK(39);
1894         if WZDARK then goto L2000;
1895         goto L2012;
1896 
1897 /* LAMP OFF */
1898 
1899 L9080:  if ^HERE(LAMP) then goto L2011;
1900         PROP(LAMP)=0;
1901         call RSPEAK(40);
1902         if DARK(0) then call RSPEAK(16);
1903         goto L2012;
1904 
1905 /* WAVE.  NO EFFECT UNLESS WAVING ROD AT FISSURE. */
1906 
1907 L9090:  if (^TOTING(OBJ)) & (OBJ ^= ROD |  ^ TOTING(ROD2))
1908          then SPK=29;
1909         if OBJ ^= ROD |  ^ AT(FISSUR) |  ^ TOTING(OBJ)
1910          | CLOSNG then goto L2011;
1911         PROP(FISSUR)=1-PROP(FISSUR);
1912         call PSPEAK(FISSUR,2-PROP(FISSUR));
1913         goto L2012;
1914 
1915 /*
1916    ATTACK.  ASSUME TARGET IF UNAMBIGUOUS.  "THROW" ALSO
1917    LINKS HERE.  ATTACKABLE OBJECTS FALL INTO TWO CATEGORIES:
1918    ENEMIES (SNAKE, DWARF, ETC.) AND OTHERS (BIRD, CLAM).
1919    AMBIGUOUS IF TWO ENEMIES, OR IF NO ENEMIES BUT TWO
1920    OTHERS.
1921 */
1922 
1923 L9120:  do I=1 to 5;
1924             if DLOC(I) = LOC & DFLAG >= 2 then goto L9122;
1925             end;
1926         I=0;
1927 L9122:  if OBJ ^= 0 then goto L9124;
1928         if I ^= 0 then OBJ=DWARF;
1929         if HERE(SNAKE) then OBJ=OBJ*100+SNAKE;
1930         if AT(DRAGON) & PROP(DRAGON) = 0 then OBJ=OBJ*100+DRAGON;
1931         if AT(TROLL) then OBJ=OBJ*100+TROLL;
1932         if HERE(BEAR) & PROP(BEAR) = 0 then OBJ=OBJ*100+BEAR;
1933         if OBJ > 100 then goto L8000;
1934         if OBJ ^= 0 then goto L9124;
1935 
1936 /* CAN'T ATTACK BIRD BY THROWING AXE. */
1937 
1938         if HERE(BIRD) & VERB ^= THROW then OBJ=BIRD;
1939 
1940 /* CLAM AND OYSTER BOTH TREATED AS CLAM FOR INTRANSITIVE
1941    CASE; NO HARM DONE.  */
1942 
1943         if HERE(CLAM) | HERE(OYSTER) then OBJ=100*OBJ+CLAM;
1944         if OBJ > 100 then goto L8000;
1945 L9124:  if OBJ ^= BIRD then goto L9125;
1946         SPK=137;
1947         if CLOSED then goto L2011;
1948         call DSTROY(BIRD);
1949         PROP(BIRD)=0;
1950         if PLACE(SNAKE) = PLAC(SNAKE) then TALLY2=TALLY2+1;
1951         SPK=45;
1952 L9125:  if OBJ = 0 then SPK=44;
1953         if OBJ = CLAM | OBJ = OYSTER then SPK=150;
1954         if OBJ = SNAKE then SPK=46;
1955         if OBJ = DWARF then SPK=49;
1956         if OBJ = DWARF & CLOSED then goto L19000;
1957         if OBJ = DRAGON then SPK=167;
1958         if OBJ = TROLL then SPK=157;
1959         if OBJ = BEAR then SPK=165+(PROP(BEAR)+1)/2;
1960         if OBJ ^= DRAGON | PROP(DRAGON) ^= 0 then goto L2011;
1961 /*
1962    FUN STUFF FOR DRAGON.  IF HE INSISTS ON ATTACKING IT,
1963    WIN!  SET PROP TO DEAD, MOVE DRAGON TO CENTRAL LOC (STILL
1964    FIXED), MOVE RUG THERE (NOT FIXED), AND MOVE HIM THERE,
1965    TOO.  THEN DO A NULL MOTION TO GET NEW DESCRIPTION.
1966 */
1967         call RSPEAK(49);
1968         VERB=0;
1969         OBJ=0;
1970         call GETIN(WD1,WD1X,WD2,WD2X);
1971         if WD1 ^= "Y" & WD1 ^= "YES" then goto L2608;
1972         call PSPEAK(DRAGON,1);
1973         PROP(DRAGON)=2;
1974         PROP(RUG)=0;
1975         K=(PLAC(DRAGON)+FIXD(DRAGON))/2;
1976         call MOVE(DRAGON+100,-1);
1977         call MOVE(RUG+100,0);
1978         call MOVE(DRAGON,K);
1979         call MOVE(RUG,K);
1980         do OBJ=1 to 100;
1981         if PLACE(OBJ) = PLAC(DRAGON) | PLACE(OBJ) = FIXD(DRAGON)
1982              then call MOVE(OBJ,K);
1983             end;
1984         LOC=K;
1985         K=NULLX;
1986         goto L8;
1987 
1988 /*
1989    POUR.  IF NO OBJECT, OR OBJECT IS BOTTLE, ASSUME CONTENTS
1990    OF BOTTLE.  SPECIAL TESTS FOR POURING WATER OR OIL ON
1991    PLANT OR RUSTY DOOR.
1992 */
1993 
1994 L9130:  if OBJ = BOTTLE | OBJ = 0 then OBJ=LIQ(0);
1995         if OBJ = 0 then goto L8000;
1996         if ^TOTING(OBJ) then goto L2011;
1997         SPK=78;
1998         if OBJ ^= OIL & OBJ ^= WATER then goto L2011;
1999         PROP(BOTTLE)=1;
2000         PLACE(OBJ)=0;
2001         SPK=77;
2002         if ^(AT(PLANT) | AT(DOOR)) then goto L2011;
2003 
2004         if AT(DOOR) then goto L9132;
2005         SPK=112;
2006         if OBJ ^= WATER then goto L2011;
2007         call PSPEAK(PLANT,PROP(PLANT)+1);
2008         PROP(PLANT)=mod(PROP(PLANT)+2,6);
2009         PROP(PLANT2)=PROP(PLANT)/2;
2010         K=NULLX;
2011         goto L8;
2012 
2013 L9132:  PROP(DOOR)=0;
2014         if OBJ = OIL then PROP(DOOR)=1;
2015         SPK=113+PROP(DOOR);
2016         goto L2011;
2017 
2018 /*
2019    EAT.  INTRANSITIVE:  ASSUME FOOD IF PRESENT, ELSE ASK
2020    WHAT.  TRANSITIVE:  FOOD OK, SOME THINGS LOSE APPETITE,
2021    REST ARE RIDICULOUS.
2022 */
2023 
2024 L8140:  if ^HERE(FOOD) then goto L8000;
2025 L8142:  call DSTROY(FOOD);
2026         SPK=72;
2027         goto L2011;
2028 
2029 L9140:  if OBJ = FOOD then goto L8142;
2030         if OBJ = BIRD | OBJ = SNAKE | OBJ = CLAM | OBJ = OYSTER
2031          | OBJ = DWARF | OBJ = DRAGON | OBJ = TROLL
2032          | OBJ = BEAR then SPK=71;
2033         goto L2011;
2034 
2035 /*
2036    DRINK.  IF NO OBJECT, ASSUME WATER AND LOOK FOR IT HERE.
2037    IF WATER IS IN THE BOTTLE, DRINK THAT, ELSE MUST BE AT A
2038    WATER LOC, SO DRINK STREAM.
2039 */
2040 
2041 L9150:  if OBJ = 0 & LIQLOC(LOC) ^= WATER & (LIQ(0) ^= WATER
2042          |  ^ HERE(BOTTLE)) then goto L8000;
2043         if OBJ ^= 0 & OBJ ^= WATER then SPK=110;
2044         if SPK = 110 | LIQ(0) ^= WATER |  ^ HERE(BOTTLE)
2045              then goto L2011;
2046         PROP(BOTTLE)=1;
2047         PLACE(WATER)=0;
2048         SPK=74;
2049         goto L2011;
2050 
2051 /* RUB.  YIELDS VARIOUS SNIDE REMARKS. */
2052 
2053 L9160:  if OBJ ^= LAMP then SPK=76;
2054         goto L2011;
2055 
2056 /*
2057    THROW.  SAME AS DISCARD UNLESS AXE.  THEN SAME AS ATTACK
2058    EXCEPT IGNORE BIRD, AND IF DWARF IS PRESENT THEN ONE
2059    MIGHT BE KILLED.  (ONLY WAY TO DO SO!) AXE ALSO SPECIAL
2060    FOR DRAGON, BEAR, AND TROLL.  TREASURES SPECIAL FOR
2061    TROLL.
2062 */
2063 
2064 L9170:  if TOTING(ROD2) & OBJ = ROD &  ^ TOTING(ROD) then OBJ=ROD2;
2065         if ^TOTING(OBJ) then goto L2011;
2066         if OBJ >= 50 & OBJ <= MAXTRS & AT(TROLL) then goto L9178;
2067         if OBJ = FOOD & HERE(BEAR) then goto L9177;
2068         if OBJ ^= AXE then goto L9020;
2069         do I=1 to 5;
2070 
2071 /* NEEDN'T CHECK DFLAG IF AXE IS HERE. */
2072 
2073             if DLOC(I) = LOC then goto L9172;
2074             end;
2075         SPK=152;
2076         if AT(DRAGON) & PROP(DRAGON) = 0 then goto L9175;
2077         SPK=158;
2078         if AT(TROLL) then goto L9175;
2079         if HERE(BEAR) & PROP(BEAR) = 0 then goto L9176;
2080         OBJ=0;
2081         goto L9120;
2082 
2083 L9172:  SPK=48;
2084 
2085 
2086         if RAN(3) = 0 then goto L9175;
2087         DSEEN(I)="0"b;
2088         DLOC(I)=0;
2089         SPK=47;
2090         DKILL=DKILL+1;
2091         if DKILL = 1 then SPK=149;
2092 L9175:  call RSPEAK(SPK);
2093         call DROP(AXE,LOC);
2094         K=NULLX;
2095         goto L8;
2096 
2097 /* THIS'LL TEACH HIM TO THROW THE AXE AT THE BEAR! */
2098 
2099 L9176:  SPK=164;
2100         call DROP(AXE,LOC);
2101         FIXED(AXE)=-1;
2102         PROP(AXE)=1;
2103         call JUGGLE(BEAR);
2104         goto L2011;
2105 
2106 /* BUT THROWING FOOD IS ANOTHER STORY. */
2107 
2108 L9177:  OBJ=BEAR;
2109         goto L9210;
2110 
2111 L9178:  SPK=159;
2112 
2113 /* SNARF A TREASURE FOR THE TROLL. */
2114 
2115         call DROP(OBJ,0);
2116         call MOVE(TROLL,0);
2117         call MOVE(TROLL+100,0);
2118         call DROP(TROLL2,PLAC(TROLL));
2119         call DROP(TROLL2+100,FIXD(TROLL));
2120         call JUGGLE(CHASM);
2121         goto L2011;
2122 
2123 /* QUIT.  INTRANSITIVE ONLY.  VERIFY INTENT AND EXIT IF
2124    THAT'S WHAT HE WANTS.  */
2125 
2126 L8180:  GAVEUP=YES(22,54,54);
2127 L8185:  if GAVEUP then goto L20000;
2128         goto L2012;
2129 
2130 /* FIND.  MIGHT BE CARRYING IT, OR IT MIGHT BE HERE.  ELSE
2131    GIVE CAVEAT.  */
2132 
2133 L9190:  if AT(OBJ) | (LIQ(0) = OBJ & AT(BOTTLE))
2134          | K = LIQLOC(LOC) then SPK=94;
2135         do I=1 to 5;
2136             if DLOC(I) = LOC & DFLAG >= 2 & OBJ = DWARF then SPK=94;
2137             end;
2138         if CLOSED then SPK=138;
2139         if TOTING(OBJ) then SPK=24;
2140         goto L2011;
2141 
2142 /* INVENTORY.  IF OBJECT, TREAT SAME AS FIND.  ELSE REPORT
2143    ON CURRENT BURDEN.  */
2144 
2145 L8200:  SPK=98;
2146         do I=1 to 100;
2147            if I = BEAR |  ^ TOTING(I) then goto L8201;
2148            if SPK = 98 then call RSPEAK(99);
2149            BLKLIN="0"b;
2150            call PSPEAK(I,-1);
2151            BLKLIN="1"b;
2152            SPK=0;
2153 L8201:     end;
2154         if TOTING(BEAR) then SPK=141;
2155         goto L2011;
2156 
2157 /*
2158 FEED.  IF BIRD, NO SEED.  SNAKE, DRAGON, TROLL:  QUIP.  IF
2159    DWARF, MAKE HIM MAD.  BEAR, SPECIAL.
2160 */
2161 
2162 L9210:  if OBJ ^= BIRD then goto L9212;
2163         SPK=100;
2164         goto L2011;
2165 
2166 L9212:  if OBJ ^= SNAKE & OBJ ^= DRAGON & OBJ ^= TROLL then goto L9213;
2167         SPK=102;
2168         if OBJ = DRAGON & PROP(DRAGON) ^= 0 then SPK=110;
2169         if OBJ = TROLL then SPK=182;
2170         if OBJ ^= SNAKE | CLOSED |  ^ HERE(BIRD) then goto L2011;
2171         SPK=101;
2172         call DSTROY(BIRD);
2173         PROP(BIRD)=0;
2174         TALLY2=TALLY2+1;
2175         goto L2011;
2176 
2177 L9213:  if OBJ ^= DWARF then goto L9214;
2178         if ^HERE(FOOD) then goto L2011;
2179         SPK=103;
2180         DFLAG=DFLAG+1;
2181         goto L2011;
2182 
2183 L9214:  if OBJ ^= BEAR then goto L9215;
2184         if PROP(BEAR) = 0 then SPK=102;
2185         if PROP(BEAR) = 3 then SPK=110;
2186         if ^HERE(FOOD) then goto L2011;
2187         call DSTROY(FOOD);
2188         PROP(BEAR)=1;
2189         FIXED(AXE)=0;
2190         PROP(AXE)=0;
2191         SPK=168;
2192         goto L2011;
2193 
2194 L9215:  SPK=14;
2195         goto L2011;
2196 
2197 /* FILL.  BOTTLE MUST BE EMPTY, AND SOME LIQUID AVAILABLE.
2198    (VASE IS NASTY.) */
2199 
2200 L9220:  if OBJ = VASE then goto L9222;
2201         if OBJ ^= 0 & OBJ ^= BOTTLE then goto L2011;
2202         if OBJ = 0 &  ^ HERE(BOTTLE) then goto L8000;
2203         SPK=107;
2204         if LIQLOC(LOC) = 0 then SPK=106;
2205         if LIQ(0) ^= 0 then SPK=105;
2206         if SPK ^= 107 then goto L2011;
2207         PROP(BOTTLE)=mod(COND(LOC),4)/2;
2208         PROP(BOTTLE)=PROP(BOTTLE)*2;
2209         K=LIQ(0);
2210         if TOTING(BOTTLE) then PLACE(K)=-1;
2211         if K = OIL then SPK=108;
2212         goto L2011;
2213 
2214 L9222:  SPK=29;
2215         if LIQLOC(LOC) = 0 then SPK=144;
2216         if LIQLOC(LOC) = 0 |  ^TOTING(VASE) then goto L2011;
2217         call RSPEAK(145);
2218         PROP(VASE)=2;
2219         FIXED(VASE)=-1;
2220         goto L9024;
2221 
2222 /* BLAST.  NO EFFECT UNLESS YOU'VE GOT DYNAMITE, WHICH IS A
2223    NEAT TRICK!  */
2224 
2225 L9230:  if PROP(ROD2) < 0 |  ^ CLOSED then goto L2011;
2226         BONUS=133;
2227         if LOC = 115 then BONUS=134;
2228         if HERE(ROD2) then BONUS=135;
2229         call RSPEAK(BONUS);
2230         goto L20000;
2231 
2232 /* SCORE.  GO TO SCORING SECTION, WHICH WILL RETURN TO 8241
2233    IF SCORNG IS TRUE.  */
2234 
2235 L8240:  SCORNG="1"b;
2236         goto L20000;
2237 
2238 L8241:  SCORNG="0"b;
2239         call LINESKP;
2240         put string (OUTSTR) edit
2241              ("If you were to quit now, you would score ",
2242             SCORE," out of a possible",MXSCOR,".") (a,f(4),a,f(4),a);
2243         call LINEOUT;
2244         GAVEUP=YES(143,54,54);
2245         goto L8185;
2246 
2247 /*
2248    FEE FIE FOE FOO (AND FUM).  ADVANCE TO NEXT STATE IF GIVEN
2249    IN PROPER ORDER.  LOOK UP WD1 IN SECTION 3 OF VOCAB TO
2250    DETERMINE WHICH WORD WE'VE GOT.  LAST WORD ZIPS THE EGGS
2251    BACK TO THE GIANT ROOM (UNLESS ALREADY THERE).
2252 */
2253 
2254 L8250:  K=VOCAB(WD1,3);
2255         SPK=42;
2256         if FOOBAR = 1-K then goto L8252;
2257         if FOOBAR ^= 0 then SPK=151;
2258         goto L2011;
2259 
2260 L8252:  FOOBAR=K;
2261         if K ^= 4 then goto L2009;
2262         FOOBAR=0;
2263         if PLACE(EGGS) = PLAC(EGGS)
2264          | (TOTING(EGGS) & LOC = PLAC(EGGS)) then goto L2011;
2265 
2266 /* BRING BACK TROLL IF WE STEAL THE EGGS BACK FROM HIM
2267    BEFORE CROSSING.  */
2268 
2269         if PLACE(EGGS) = 0 & PLACE(TROLL) = 0 & PROP(TROLL) = 0
2270          then PROP(TROLL)=1;
2271         K=2;
2272         if HERE(EGGS) then K=1;
2273         if LOC = PLAC(EGGS) then K=0;
2274         call MOVE(EGGS,PLAC(EGGS));
2275         call PSPEAK(EGGS,K);
2276         goto L2012;
2277 
2278 /* BRIEF.  INTRANSITIVE ONLY.  SUPPRESS LONG DESCRIPTIONS
2279    AFTER FIRST TIME.  */
2280 
2281 L8260:  SPK=156;
2282         ABBNUM=10000;
2283         DETAIL=3;
2284         goto L2011;
2285 
2286 /* READ.  MAGAZINES IN DWARVISH, MESSAGE WE'VE SEEN, AND .
2287    .  .  OYSTER?  */
2288 
2289 L8270:  if HERE(MAGZIN) then OBJ=MAGZIN;
2290         if HERE(TABLET) then OBJ=OBJ*100+TABLET;
2291         if HERE(MESSAG) then OBJ=OBJ*100+MESSAG;
2292         if CLOSED & TOTING(OYSTER) then OBJ=OYSTER;
2293         if OBJ > 100 | OBJ = 0 | DARK(0) then goto L8000;
2294 
2295 L9270:  if DARK(0) then goto L5190;
2296         if OBJ = MAGZIN then SPK=190;
2297         if OBJ = TABLET then SPK=196;
2298         if OBJ = MESSAG then SPK=191;
2299         if OBJ = OYSTER & HINTED(2) & TOTING(OYSTER) then SPK=194;
2300         if OBJ ^= OYSTER | HINTED(2) |  ^TOTING(OYSTER)
2301          |  ^CLOSED then goto L2011;
2302         HINTED(2)=YES(192,193,54);
2303         goto L2012;
2304 
2305 /* BREAK.  ONLY WORKS FOR MIRROR IN REPOSITORY AND, OF
2306    COURSE, THE VASE.  */
2307 
2308 L9280:  if OBJ = MIRROR then SPK=148;
2309         if OBJ = VASE & PROP(VASE) = 0 then goto L9282;
2310         if OBJ ^= MIRROR |  ^CLOSED then goto L2011;
2311         call RSPEAK(197);
2312         goto L19000;
2313 
2314 L9282:  SPK=198;
2315         if TOTING(VASE) then call DROP(VASE,LOC);
2316         PROP(VASE)=2;
2317         FIXED(VASE)=-1;
2318         goto L2011;
2319 
2320 /* WAKE.  ONLY USE IS TO DISTURB THE DWARVES. */
2321 
2322 L9290:  if OBJ ^= DWARF |  ^CLOSED then goto L2011;
2323         call RSPEAK(199);
2324         goto L19000;
2325 
2326 /*
2327    SUSPEND.  OFFER TO EXIT LEAVING THINGS RESTARTABLE, BUT
2328    REQUIRING A DELAY BEFORE RESTARTING (SO CAN'T SAVE THE
2329    WORLD BEFORE TRYING SOMETHING RISKY).  UPON RESTARTING,
2330    SETUP=-1 CAUSES RETURN TO 8305 TO PICK UP AGAIN.
2331 */
2332 
2333 L8300:  put string (OUTSTR) edit
2334               ("Can't suspend on this machine") (a);
2335         call LINEOUT;
2336         goto L2012;
2337 
2338 /* HOURS.  REPORT CURRENT NON-PRIME-TIME HOURS. */
2339 
2340 L8310:  put string (OUTSTR) edit ("Open all day!") (a);
2341         call LINEOUT;
2342         goto L2012;
2343 
2344 /* LOG.  TOGGLE LOGGIN EITHER ON OR OFF */
2345 
2346 SETLOG: LOGON = ^ LOGON;
2347         if LOGON then put string (OUTSTR) edit ("Log on.") (a);
2348                  else put string (OUTSTR) edit ("Log off.") (a);
2349         call LINEOUT;
2350         call LINESKP;
2351         goto L2012;
2352 
2353 /*
2354    HINTS
2355 
2356    COME HERE IF HE'S BEEN LONG ENOUGH AT REQUIRED LOC(S) FOR
2357    SOME UNUSED HINT.  HINT NUMBER IS IN VARIABLE "HINT".
2358    BRANCH TO QUICK TEST FOR ADDITIONAL CONDITIONS, THEN COME
2359    BACK TO DO NEAT STUFF.  GOTO 40010 IF CONDITIONS ARE MET
2360    AND WE WANT TO OFFER THE HINT.  GOTO 40020 TO CLEAR
2361    HINTLC BACK TO ZERO, 40030 TO TAKE NO ACTION YET.
2362 */
2363 
2364 /* CAC recoded 'select' */
2365 L40000: if HINT-4 = 00 then goto L40400;        /* CAVE */
2366         if HINT-4 = 01 then goto L40500;        /* BIRD */
2367         if HINT-4 = 02 then goto L40600;        /* SNAKE */
2368         if HINT-4 = 03 then goto L40700;        /* MAZE */
2369         if HINT-4 = 04 then goto L40800;        /* DARK */
2370         if HINT-4 = 05 then goto L40900;        /* WITT */
2371         call BUG(27);
2372 
2373 L40010: HINTLC(HINT)=0;
2374         if ^YES(HINTS(HINT,3),0,54) then goto L2602;
2375         call LINESKP;
2376         put string (OUTSTR) edit
2377           ("I am prepared to give you a hint, but it will cost you",
2378              HINTS(HINT,2)," points.") (a,f(2),a);
2379         call LINEOUT;
2380         HINTED(HINT)=YES(175,HINTS(HINT,4),54);
2381         if HINTED(HINT) & LIMIT > 30
2382                then LIMIT=LIMIT+30*HINTS(HINT,2);
2383 L40020: HINTLC(HINT)=0;
2384 L40030: goto L2602;
2385 
2386 /* NOW FOR THE QUICK TESTS.  SEE DATABASE DESCRIPTION FOR
2387    ONE-LINE NOTES.  */
2388 
2389 L40400: if PROP(GRATE) = 0 &  ^ HERE(KEYS) then goto L40010;
2390         goto L40020;
2391 
2392 L40500: if HERE(BIRD) & TOTING(ROD) & OBJ = BIRD then goto L40010;
2393         goto L40030;
2394 
2395 L40600: if HERE(SNAKE) &  ^ HERE(BIRD) then goto L40010;
2396         goto L40020;
2397 
2398 L40700: if ATLOC(LOC) = 0 & ATLOC(OLDLOC) = 0
2399          & ATLOC(OLDLC2) = 0 & HOLDNG > 1 then goto L40010;
2400         goto L40020;
2401 
2402 L40800: if PROP(EMRALD) ^= -1 & PROP(PYRAM) = -1 then goto L40010;
2403         goto L40020;
2404 
2405 L40900: goto L40010;
2406 
2407 /*
2408    CAVE CLOSING AND SCORING
2409 
2410 
2411    THESE SECTIONS HANDLE THE CLOSING OF THE CAVE.  THE CAVE
2412    CLOSES "CLOCK1" TURNS AFTER THE LAST TREASURE HAS BEEN
2413    LOCATED (INCLUDING THE PIRATE'S CHEST, WHICH MAY OF
2414    COURSE NEVER SHOW UP).  NOTE THAT THE TREASURES NEED NOT
2415    HAVE BEEN TAKEN YET, JUST LOCATED.  HENCE CLOCK1 MUST BE
2416    LARGE ENOUGH TO GET OUT OF THE CAVE (IT ONLY TICKS WHILE
2417    INSIDE THE CAVE).  WHEN IT HITS ZERO, WE BRANCH TO 10000
2418    TO START CLOSING THE CAVE, AND THEN SIT BACK AND WAIT FOR
2419    HIM TO TRY TO GET OUT.  IF HE DOESN'T WITHIN CLOCK2
2420    TURNS, WE CLOSE THE CAVE; IF HE DOES TRY, WE ASSUME HE
2421    PANICS, AND GIVE HIM A FEW ADDITIONAL TURNS TO GET
2422    FRANTIC BEFORE WE CLOSE.  WHEN CLOCK2 HITS ZERO, WE
2423    BRANCH TO 11000 TO TRANSPORT HIM INTO THE FINAL PUZZLE.
2424    NOTE THAT THE PUZZLE DEPENDS UPON ALL SORTS OF RANDOM
2425    THINGS.  FOR INSTANCE, THERE MUST BE NO WATER OR OIL,
2426    SINCE THERE ARE BEANSTALKS WHICH WE DON'T WANT TO BE ABLE
2427    TO WATER, SINCE THE CODE CAN'T HANDLE IT.  ALSO, WE CAN
2428    HAVE NO KEYS, SINCE THERE IS A GRATE (HAVING MOVED THE
2429    FIXED OBJECT!) THERE SEPARATING HIM FROM ALL THE
2430    TREASURES.  MOST OF THESE PROBLEMS ARISE FROM THE USE OF
2431    NEGATIVE PROP NUMBERS TO SUPPRESS THE OBJECT DESCRIPTIONS
2432    UNTIL HE'S ACTUALLY MOVED THE OBJECTS.
2433 
2434    WHEN THE FIRST WARNING COMES, WE LOCK THE GRATE, DESTROY
2435    THE BRIDGE, KILL ALL THE DWARVES (AND THE PIRATE), REMOVE
2436    THE TROLL AND BEAR (UNLESS DEAD), AND SET "CLOSNG" TO
2437    TRUE.  LEAVE THE DRAGON; TOO MUCH TROUBLE TO MOVE IT.
2438    FROM NOW UNTIL CLOCK2 RUNS OUT, HE CANNOT UNLOCK THE
2439    GRATE, MOVE TO ANY LOCATION OUTSIDE THE CAVE (LOC<9), OR
2440    CREATE THE BRIDGE.  NOR CAN HE BE RESURRECTED IF HE DIES.
2441    NOTE THAT THE SNAKE IS ALREADY GONE, SINCE HE GOT TO THE
2442    TREASURE ACCESSIBLE ONLY VIA THE HALL OF THE MT.  KING.
2443    ALSO, HE'S BEEN IN GIANT ROOM (TO GET EGGS), SO WE CAN
2444    REFER TO IT.  ALSO ALSO, HE'S GOTTEN THE PEARL, SO WE
2445    KNOW THE BIVALVE IS AN OYSTER.  *AND*, THE DWARVES MUST
2446    HAVE BEEN ACTIVATED, SINCE WE'VE FOUND CHEST.
2447 */
2448 
2449 L10000: PROP(GRATE)=0;
2450         PROP(FISSUR)=0;
2451         do I=1 to 6;
2452             DSEEN(I)="0"b;
2453             end;
2454         call MOVE(TROLL,0);
2455         call MOVE(TROLL+100,0);
2456         call MOVE(TROLL2,PLAC(TROLL));
2457         call MOVE(TROLL2+100,FIXD(TROLL));
2458         call JUGGLE(CHASM);
2459         if PROP(BEAR) ^= 3 then call DSTROY(BEAR);
2460         PROP(CHAIN)=0;
2461         FIXED(CHAIN)=0;
2462         PROP(AXE)=0;
2463         FIXED(AXE)=0;
2464         call RSPEAK(129);
2465         CLOCK1=-1;
2466         CLOSNG="1"b;
2467         goto L19999;
2468 
2469 /*
2470    ONCE HE'S PANICKED, AND CLOCK2 HAS RUN OUT, WE COME HERE
2471    TO SET UP THE STORAGE ROOM.  THE ROOM HAS TWO LOCS,
2472    HARDWIRED AS 115 (NE) AND 116 (SW).  AT THE NE END, WE
2473    PLACE EMPTY BOTTLES, A NURSERY OF PLANTS, A BED OF
2474    OYSTERS, A PILE OF LAMPS, RODS WITH STARS, SLEEPING
2475    DWARVES, AND HIM.  AND THE SW END WE PLACE GRATE OVER
2476    TREASURES, SNAKE PIT, COVEY OF CAGED BIRDS, MORE RODS,
2477    AND PILLOWS.  A MIRROR STRETCHES ACROSS ONE WALL.  MANY
2478    OF THE OBJECTS COME FROM KNOWN LOCATIONS AND/OR STATES
2479    (E.G.  THE SNAKE IS KNOWN TO HAVE BEEN DESTROYED AND
2480    NEEDN'T BE CARRIED AWAY FROM ITS OLD "PLACE"), MAKING THE
2481    VARIOUS OBJECTS BE HANDLED DIFFERENTLY.  WE ALSO DROP ALL
2482    OTHER OBJECTS HE MIGHT BE CARRYING (LEST HE HAVE SOME
2483    WHICH COULD CAUSE TROUBLE, SUCH AS THE KEYS).  WE
2484    DESCRIBE THE FLASH OF LIGHT AND TRUNDLE BACK.
2485 */
2486 
2487 L11000: PROP(BOTTLE)=PUT(BOTTLE,115,1);
2488         PROP(PLANT)=PUT(PLANT,115,0);
2489         PROP(OYSTER)=PUT(OYSTER,115,0);
2490         PROP(LAMP)=PUT(LAMP,115,0);
2491         PROP(ROD)=PUT(ROD,115,0);
2492         PROP(DWARF)=PUT(DWARF,115,0);
2493         LOC=115;
2494         OLDLOC=115;
2495         NEWLOC=115;
2496 
2497 /* LEAVE THE GRATE WITH NORMAL (NON-NEGATIVE PROPERTY). */
2498 
2499         FOO=PUT(GRATE,116,0);
2500         PROP(SNAKE)=PUT(SNAKE,116,1);
2501         PROP(BIRD)=PUT(BIRD,116,1);
2502         PROP(CAGE)=PUT(CAGE,116,0);
2503         PROP(ROD2)=PUT(ROD2,116,0);
2504         PROP(PILLOW)=PUT(PILLOW,116,0);
2505 
2506         PROP(MIRROR)=PUT(MIRROR,115,0);
2507         FIXED(MIRROR)=116;
2508 
2509         do I=1 to 100;
2510             if TOTING(I) then call DSTROY(I);
2511             end;
2512 
2513         call RSPEAK(132);
2514         CLOSED="1"b;
2515         goto L2;
2516 
2517 /*
2518    ANOTHER WAY WE CAN FORCE AN END TO THINGS IS BY HAVING
2519    THE LAMP GIVE OUT.  WHEN IT GETS CLOSE, WE COME HERE TO
2520    WARN HIM.  WE GO TO 12000 IF THE LAMP AND FRESH BATTERIES
2521    ARE HERE, IN WHICH CASE WE REPLACE THE BATTERIES AND
2522    CONTINUE.  12200 IS FOR OTHER CASES OF LAMP DYING.  12400
2523    IS WHEN IT GOES OUT, AND 12600 IS IF HE'S WANDERED
2524    OUTSIDE AND THE LAMP IS USED UP, IN WHICH CASE WE FORCE
2525    HIM TO GIVE UP.
2526 */
2527 
2528 L12000: call RSPEAK(188);
2529         PROP(BATTER)=1;
2530         if TOTING(BATTER) then call DROP(BATTER,LOC);
2531         LIMIT=LIMIT+2500;
2532         LMWARN="0"b;
2533         goto L19999;
2534 
2535 L12200: if LMWARN |  ^HERE(LAMP) then goto L19999;
2536         LMWARN="1"b;
2537         SPK=187;
2538         if PLACE(BATTER) = 0 then SPK=183;
2539         if PROP(BATTER) = 1 then SPK=189;
2540         call RSPEAK(SPK);
2541         goto L19999;
2542 
2543 L12400: LIMIT=-1;
2544         PROP(LAMP)=0;
2545         if HERE(LAMP) then call RSPEAK(184);
2546         goto L19999;
2547 
2548 L12600: call RSPEAK(185);
2549         GAVEUP="1"b;
2550         goto L20000;
2551 
2552 /* OH DEAR, HE'S DISTURBED THE DWARVES. */
2553 
2554 L19000: call RSPEAK(136);
2555 
2556 /*
2557    EXIT CODE.  WILL EVENTUALLY INCLUDE SCORING.  FOR NOW, HOWEVER, ...
2558 
2559    THE PRESENT SCORING ALGORITHM IS AS FOLLOWS:
2560       OBJECTIVE:          POINTS:        PRESENT TOTAL POSSIBLE:
2561    GETTING WELL INTO CAVE   25                    25
2562    EACH TREASURE < CHEST    12                    60
2563    TREASURE CHEST ITSELF    14                    14
2564    EACH TREASURE > CHEST    16                   144
2565    SURVIVING             (MAX-NUM)*10             30
2566    NOT QUITTING              4                     4
2567    REACHING "CLOSNG"        25                    25
2568    "CLOSED": QUIT/KILLED    10
2569              KLUTZED        25
2570              WRONG WAY      30
2571              SUCCESS        45                    45
2572    CAME TO WITT'S END        1                     1
2573    ROUND OUT THE TOTAL       2                     2
2574                                         TOTAL:   350
2575    (POINTS CAN ALSO BE DEDUCTED FOR USING HINTS.)
2576 */
2577 
2578 L20000: SCORE=0;
2579         MXSCOR=0;
2580 
2581 /*
2582    FIRST TALLY UP THE TREASURES.  MUST BE IN BUILDING AND
2583    NOT BROKEN.  GIVE THE POOR GUY 2 POINTS JUST FOR FINDING
2584    EACH TREASURE.
2585 */
2586 
2587         do I=50 to MAXTRS;
2588             if PTEXT(I) ^= 0 then do;
2589                 K=12;
2590                 if I = CHEST then K=14;
2591                 if I > CHEST then K=16;
2592                 if PROP(I) >= 0 then SCORE=SCORE+2;
2593                 if PLACE(I) = 3 & PROP(I) = 0 then SCORE=SCORE+K-2;
2594                 MXSCOR=MXSCOR+K;
2595                 end;
2596             end;
2597 
2598 /*
2599    NOW LOOK AT HOW HE FINISHED AND HOW FAR HE GOT.  MAXDIE
2600    AND NUMDIE TELL US HOW WELL HE SURVIVED.  GAVEUP SAYS
2601    WHETHER HE EXITED VIA QUIT.  DFLAG WILL TELL US IF HE
2602    EVER GOT SUITABLY DEEP INTO THE CAVE.  CLOSNG STILL
2603    INDICATES WHETHER HE REACHED THE ENDGAME.  AND IF HE GOT
2604    AS FAR AS "CAVE CLOSED" (INDICATED BY "CLOSED"), then
2605    BONUS IS ZERO FOR MUNDANE EXITS OR 133, 134, 135 IF HE
2606    BLEW IT (SO TO SPEAK).
2607 */
2608 
2609         SCORE=SCORE+(MAXDIE-NUMDIE)*10;
2610         MXSCOR=MXSCOR+MAXDIE*10;
2611         if ^(SCORNG | GAVEUP) then SCORE=SCORE+4;
2612         MXSCOR=MXSCOR+4;
2613         if DFLAG ^= 0 then SCORE=SCORE+25;
2614         MXSCOR=MXSCOR+25;
2615         if CLOSNG then SCORE=SCORE+25;
2616         MXSCOR=MXSCOR+25;
2617         if ^CLOSED then goto L20020;
2618         if BONUS = 0 then SCORE=SCORE+10;
2619         if BONUS = 135 then SCORE=SCORE+25;
2620         if BONUS = 134 then SCORE=SCORE+30;
2621         if BONUS = 133 then SCORE=SCORE+45;
2622 L20020: MXSCOR=MXSCOR+45;
2623 
2624 /* DID HE COME TO WITT'S END AS HE SHOULD? */
2625 
2626         if PLACE(MAGZIN) = 108 then SCORE=SCORE+1;
2627         MXSCOR=MXSCOR+1;
2628 
2629 /* ROUND IT OFF. */
2630 
2631         SCORE=SCORE+2;
2632         MXSCOR=MXSCOR+2;
2633 
2634 /* DEDUCT POINTS FOR HINTS.  HINTS < 4 ARE SPECIAL; SEE
2635    DATABASE DESCRIPTION.  */
2636 
2637         do I=1 to HNTMAX;
2638             if HINTED(I) then SCORE=SCORE-HINTS(I,2);
2639             end;
2640 
2641 /* RETURN TO SCORE COMMAND IF THAT'S WHERE WE CAME FROM. */
2642 
2643         if SCORNG then goto L8241;
2644 
2645 /* THAT SHOULD BE GOOD ENOUGH.  LET'S TELL HIM ALL ABOUT IT. */
2646 
2647         call LINESKP;
2648         call LINESKP;
2649         call LINESKP;
2650         put string (OUTSTR) edit
2651             ("You scored",SCORE," out of a possible",
2652             MXSCOR," using",TURNS," turns.")
2653            (a,f(4),a,f(4),a,f(4),a);
2654         call LINEOUT;
2655 
2656         do I=1 to CLSSES;
2657             if CVAL(I) >= SCORE then goto L20210;
2658             end;
2659         call LINESKP;
2660         put string (OUTSTR) edit ("You just went of my scale!!") (a);
2661         call LINEOUT;
2662         goto L25000;
2663 
2664 L20210: call SPEAK(CTEXT(I));
2665         if I = CLSSES-1 then goto L20220;
2666         K=CVAL(I)+1-SCORE;
2667         KKWORD="s.";
2668         if K = 1 then KKWORD=". ";
2669         call LINESKP;
2670         put string (OUTSTR) edit
2671             ("To achieve the next higher rating, you need",
2672                K," more point",KKWORD) (a,f(3),a,a(2));
2673         call LINEOUT;
2674         goto L25000;
2675 
2676 L20220: call LINESKP;
2677         put string (OUTSTR) edit
2678          ("To achieve the next higher rating would be a neat trick!")
2679                (a);
2680         call LINEOUT;
2681         call LINESKP;
2682         put string (OUTSTR) edit ("Congratulations!!") (a);
2683         call LINEOUT;
2684 
2685 L25000: call LINESKP;
2686         stop;
2687 /*  SUBROUTINES/FUNCTIONS
2688 
2689 
2690    TOTING(OBJ)  = TRUE IF THE OBJ IS BEING CARRIED
2691    HERE(OBJ)    = TRUE IF THE OBJ IS AT "LOC" (OR IS BEING CARRIED)
2692    AT(OBJ)      = TRUE IF ON EITHER SIDE OF TWO-PLACED OBJECT
2693    LIQ(DUMMY)   = OBJECT NUMBER OF LIQUID IN BOTTLE
2694    LIQLOC(LOC)  = OBJECT NUMBER OF LIQUID (IF ANY) AT LOC
2695    BITSET(L,N)  = TRUE IF COND(L) HAS BIT N SET (BIT 0 IS UNITS BIT)
2696    FORCED(LOC)  = TRUE IF LOC MOVES WITHOUT ASKING FOR INPUT (COND=2)
2697    DARK(DUMMY)  = TRUE IF LOCATION "LOC" IS DARK
2698    PCT(N)       = TRUE N% OF THE TIME (N INTEGER FROM 0 TO 100)
2699 
2700 */
2701 
2702 TOTING: proc (OBJ) returns (bit(1));
2703 
2704         dcl OBJ fixed bin(31);
2705 
2706         return(PLACE(OBJ) = -1);
2707         end;
2708 
2709 HERE: proc (OBJ) returns (bit(1));
2710 
2711         dcl OBJ fixed bin(31);
2712 
2713         return(PLACE(OBJ) = LOC | TOTING(OBJ));
2714         end;
2715 
2716 AT: proc (OBJ) returns (bit(1));
2717 
2718         dcl OBJ fixed bin (31);
2719 
2720         return(PLACE(OBJ) = LOC | FIXED (OBJ) = LOC);
2721         end;
2722 
2723 LIQ2: proc (PBOTL) returns (fixed bin(31));
2724 
2725         dcl PBOTL fixed bin(31);
2726         dcl LIQ2TEMP fixed bin(31);
2727 
2728         LIQ2TEMP=PBOTL/2;
2729         return((1-PBOTL)*WATER+(LIQ2TEMP)*(WATER+OIL));
2730         end;
2731 
2732 LIQ: proc (DUMMY) returns (fixed bin(31));
2733 
2734         dcl DUMMY fixed bin(31);
2735 
2736         return(LIQ2(max(PROP(BOTTLE),-1-PROP(BOTTLE))));
2737         end;
2738 
2739 LIQLOC: proc (LOC) returns (fixed bin(31));
2740 
2741         dcl LOC fixed bin(31);
2742         dcl (LIQTEMP1,LIQTEMP2) fixed bin(31);
2743 
2744         LIQTEMP1=COND(LOC)/2;
2745         LIQTEMP1=LIQTEMP1*2;
2746         LIQTEMP2=COND(LOC)/4;
2747         return(LIQ2((mod(LIQTEMP1,8)-5)*mod(LIQTEMP2,2)+1));
2748         end;
2749 
2750 BITSET: proc (L,N) returns (bit(1));
2751 
2752         dcl (L,N) fixed bin(31);
2753         dcl BITTEMP fixed bin(31) static;
2754 
2755         BITTEMP=COND(L)/2**N;
2756         return(mod(BITTEMP,2) ^= 0);
2757         end;
2758 
2759 FORCED: proc (LOC) returns (bit(1));
2760 
2761         dcl LOC fixed bin(31);
2762 
2763         return(COND(LOC) = 2);
2764         end;
2765 
2766 DARK: proc (DUMMY) returns (bit(1));
2767 
2768         dcl DUMMY fixed bin(31);
2769 
2770         return(mod(COND(LOC),2) = 0 &
2771              (PROP(LAMP) = 0 | ^ HERE(LAMP)));
2772         end;
2773 
2774 PCT: proc (N) returns (bit(1));
2775 
2776         dcl N fixed bin(31);
2777 
2778         return(RAN(100) < N);
2779         end;
2780 /* I/O ROUTINES (SPEAK, PSPEAK, RSPEAK, GETIN, YES, A5TOA1) */
2781 
2782 
2783 SPEAK: proc (N);
2784 
2785         dcl N fixed bin(31);
2786         dcl (I,K,L) fixed bin (31);
2787 
2788 /*
2789    PRINT THE MESSAGE WHICH STARTS AT LINES(N).  PRECEDE IT
2790    WITH A BLANK LINE UNLESS BLKLIN IS FALSE.
2791 */
2792 
2793         if N = 0 then return;
2794         if LINES(N+1) = ">$<" then return;
2795         if (BLKLIN) then call LINESKP;
2796         K=N;
2797 /* CAC Fix conversion warning L1:     L=abs(LINES(K))-1; */
2798 L1:     L=abs(convert (L, LINES(K)))-1;
2799         K=K+1;
2800         put string (OUTSTR) edit ((LINES(I) do I=K to L)) (14 a(5));
2801         call LINEOUT;
2802         K=L+1;
2803 /* CAC Fix conversion warning        if LINES(K) >= 0 then goto L1; */
2804         if convert (L, LINES(K)) >= 0 then goto L1;
2805         return;
2806         end;
2807 
2808 
2809 
2810 PSPEAK:proc (MSG,SKIP);
2811 
2812         dcl (MSG,SKIP) fixed bin(31);
2813         dcl (I,M) fixed bin (31);
2814 
2815 /*
2816    FIND THE SKIP+1ST MESSAGE FROM MSG AND PRINT IT.  MSG
2817    SHOULD BE THE INDEX OF THE INVENTORY MESSAGE FOR OBJECT.
2818    (INVEN+N+1 MESSAGE IS PROP=N MESSAGE).
2819 */
2820 
2821         M=PTEXT(MSG);
2822         if SKIP < 0 then goto L9;
2823         do I=0 to SKIP;
2824 /* CAC Fix conversion warning L1:         M=abs(LINES(M)); */
2825 L1:         M=abs(convert (M, LINES(M)));
2826 /* CAC Fix conversion warning             if LINES(M) >= 0 then goto L1; */
2827             if convert (M, LINES(M)) >= 0 then goto L1;
2828             end;
2829 L9:     call SPEAK(M);
2830         return;
2831         end;
2832 
2833 
2834 
2835 RSPEAK: proc (I);
2836 
2837         dcl I fixed bin(31);
2838 
2839 /* PRINT THE I-TH "RANDOM" MESSAGE (SECTION 6 OF DATABASE). */
2840 
2841         if I ^= 0 then call SPEAK(RTEXT(I));
2842         return;
2843         end;
2844 
2845 GETIN: proc (WORD1,WORD1X,WORD2,WORD2X);
2846 
2847 /*
2848    GET A COMMAND FROM THE ADVENTURER.  SNARF OUT THE FIRST
2849    WORD, PAD IT WITH BLANKS, AND RETURN IT IN WORD1.  CHARS
2850    6 THRU 10 ARE RETURNED IN WORD1X, IN CASE WE NEED TO
2851    PRINT OUT THE WHOLE WORD IN AN ERROR MESSAGE.  ANY NUMBER
2852    OF BLANKS MAY FOLLOW THE WORD.  IF A SECOND WORD APPEARS,
2853    IT IS RETURNED IN WORD2 (CHARS 6 THRU 10 IN WORD2X), ELSE
2854    WORD2 IS SET TO ZERO.
2855 */
2856 
2857         dcl (WORD1,WORD1X,WORD2,WORD2X) char(5);
2858 
2859         WORD1,WORD1X,WORD2,WORD2X="     ";
2860         if LOGON then put skip;
2861         WORDSTRT=0;
2862         do while (WORDSTRT = 0);
2863             if BLKLIN then call LINESKP;
2864 /* CAC      call TREAD(INSTR,0,INSTR,INLEN,CCODE);
2865             if CCODE = 1 then do;
2866                 OUTSTR=substr(INSTR,1,INLEN);
2867                 WORDSTRT=verify(OUTSTR," ");
2868                 end;
2869             else do;
2870                 if BLKLIN then call LINESKP;
2871                 put string (OUTSTR) edit
2872                    ("Terminal error..reenter.") (a);
2873                 call LINEOUT;
2874                 end;
2875 */
2876             /* get list (OUTSTR);*/
2877             dcl line char (256) aligned,
2878                 nelemt fixed bin (21),
2879                 code fixed bin (35);
2880             dcl  iox_$get_line entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35));
2881             declare  iox_$user_input pointer external static;
2882 
2883             call iox_$get_line (iox_$user_input, addr (line), length (line),
2884                  nelemt, code);
2885             OUTSTR = substr (line, 1, nelemt-1); /* -1 to lose CR */
2886             OUTSTR = translate (OUTSTR, "ABCDEFGHIJKLMNOPQRSTUVWXYZ",
2887                                         "abcdefghijklmnopqrstuvwxyz");
2888             WORDSTRT=verify(OUTSTR," ");
2889             end;
2890 
2891         if LOGON then put skip edit (OUTSTR) (a);
2892         OUTSTR=substr(OUTSTR,WORDSTRT);
2893         WORDEND=index(OUTSTR," ")-1;
2894         if WORDEND=-1 then WORDEND=length(OUTSTR);
2895         WORDSIZE=min(WORDEND,5);
2896         WORD1=substr(OUTSTR,1,WORDSIZE);
2897         if WORDEND > 5 then do;
2898             WORDSIZE=min(WORDEND-5,5);
2899             WORD1X=substr(OUTSTR,6,WORDSIZE);
2900             end;
2901         if WORDEND=length(OUTSTR) then return;
2902         OUTSTR=substr(OUTSTR,WORDEND+1);
2903         WORDSTRT=verify(OUTSTR," ");
2904         if WORDSTRT = 0 then return;
2905         OUTSTR=substr(OUTSTR,WORDSTRT);
2906         WORDEND=index(OUTSTR," ")-1;
2907         if WORDEND = -1 then WORDEND=length(OUTSTR);
2908         WORDSIZE=min(WORDEND,5);
2909         WORD2=substr(OUTSTR,1,WORDSIZE);
2910         if WORDEND > 5 then do;
2911             WORDSIZE=min(WORDEND-5,5);
2912             WORD2X=substr(OUTSTR,6,WORDSIZE);
2913             end;
2914         return;
2915         end;
2916 
2917 
2918 
2919 YES: proc (X,Y,Z) returns (bit(1));
2920 
2921         dcl (X,Y,Z) fixed bin(31);
2922 
2923 /*
2924    PRINT MESSAGE X, WAIT FOR YES/NO ANSWER.  IF YES, PRINT Y
2925    AND LEAVE YEA TRUE; IF NO, PRINT Z AND LEAVE YEA FALSE.
2926 */
2927 
2928 
2929 L1:     if X ^= 0 then call RSPEAK(X);
2930         call GETIN(REPLY,JUNK1,JUNK2,JUNK3);
2931         if REPLY = "YES" | REPLY = "Y" then goto L10;
2932         if REPLY = "NO" | REPLY = "N" then goto L20;
2933         call LINESKP;
2934         put string (OUTSTR) edit ("Please answer the question!") (a);
2935         call LINEOUT;
2936         goto L1;
2937 L10:    if Y ^= 0 then call RSPEAK(Y);
2938         return("1"b);
2939 L20:    if Z ^=0 then call RSPEAK(Z);
2940         return("0"b);
2941         end;
2942 
2943 
2944 
2945 A5TOA1: proc (A,B,CHARS,LENG);
2946 
2947 /*
2948   A AND B CONTAN A 1-10 CHARACTER WORD IN A5 FORMAT.
2949   THEY ARE CONCATENATED AND MOVED INTO A CHAR(1)
2950   ARRAY UNTIL A BLANK IS ENCOUNTERED.  THE TOTAL
2951   LENGTH IS RETURNED IN LENG.
2952 
2953 */
2954 
2955         dcl (A,B) char(5);
2956         dcl LENG fixed bin(31);
2957         dcl CHARS(10) char(1);
2958 
2959         dcl WORDS(2) char(5);
2960         dcl XLATETO char(26) init ("abcdefghijklmnopqrstuvwxyz");
2961         dcl XLATEFR char(26) init ("ABCDEFGHIJKLMNOPQRSTUVWXYZ");
2962 
2963         WORDS(1)=translate(A,XLATETO,XLATEFR);
2964         WORDS(2)=translate(B,XLATETO,XLATEFR);
2965         LENG=0;
2966         do WORD=1 to 2;
2967             do CH=1 to 5;
2968                 CHARS(LENG+1)=substr(WORDS(WORD),CH,1);
2969                 if CHARS(LENG+1) = " " then return;
2970                 LENG=LENG+1;
2971                 end;
2972             end;
2973         return;
2974         end;
2975 /*
2976    DATA STRUCTURE ROUTINES (VOCAB, DSTROY, JUGGLE, MOVE,
2977    PUT, CARRY, DROP)
2978 */
2979 
2980 VOCAB: proc (ID,INIT) returns(fixed bin(31));
2981 
2982         dcl ID char(5);
2983         dcl INIT fixed bin(31);
2984         dcl I    fixed bin(31);
2985 
2986 /*
2987    LOOK UP ID IN THE VOCABULARY (ATAB) AND RETURN ITS
2988    "DEFINITION" (KTAB), OR -1 IF NOT FOUND.  IF INIT IS
2989    POSITIVE, THIS IS AN INITIALISATION CALL SETTING UP A
2990    KEYWORD VARIABLE, AND NOT FINDING IT CONSTITUTES A BUG.
2991    IT ALSO MEANS THAT ONLY KTAB VALUES WHICH TAKEN OVER 1000
2992    EQUAL INIT MAY BE CONSIDERED.  (THUS "STEPS", WHICH IS A
2993    MOTION VERB AS WELL AS AN OBJECT, MAY BE LOCATED AS AN
2994    OBJECT.)  AND IT ALSO MEANS THE KTAB VALUE IS TAKEN MOD
2995    1000.
2996 */
2997 
2998        dcl VOCRTN fixed bin(31);
2999 
3000 /*put skip list ("at vocab 1 ID", ID, "INIT", INIT);*/
3001         do I=1 to TABSIZ;
3002 /*put skip list ("I", I, "ktab", KTAB(I), "atab", ATAB(I), "/1000", trunc(KTAB(I)/1000));*/
3003             if KTAB(I) = -1 then goto L2;
3004             if INIT >= 0 & trunc(KTAB(I)/1000) ^= INIT then goto L1;
3005             if ATAB(I) = ID then goto L3;
3006 L1:         end;
3007         call BUG(21);
3008 
3009 L2:     if INIT < 0 then return(-1);
3010         call BUG(5);
3011 
3012 L3:     VOCRTN=KTAB(I);
3013         if INIT >= 0 then VOCRTN=mod(VOCRTN,1000);
3014         return(VOCRTN);
3015         end;
3016 
3017 
3018 
3019 DSTROY: proc (OBJECT);
3020 
3021         dcl OBJECT fixed bin(31);
3022 
3023 /*
3024    PERMANENTLY ELIMINATE "OBJECT" BY MOVING TO A
3025    NON-EXISTANT LOCATION.
3026 */
3027 
3028 
3029         call MOVE(OBJECT,0);
3030         return;
3031         end;
3032 
3033 
3034 
3035 JUGGLE: proc (OBJECT);
3036 
3037         dcl OBJECT fixed bin(31);
3038         dcl (I,J)  fixed bin(31);
3039 
3040 /*
3041    JUGGLE AN OBJECT BY PICKING IT UP AND PUTTING IT DOWN
3042    AGAIN, THE PURPOSE BEING TO GET THE OBJECT TO THE FRONT
3043    OF THE CHAIN OF THINGS AT ITS LOC.
3044 */
3045 
3046         I=PLACE(OBJECT);
3047         J=FIXED(OBJECT);
3048         call MOVE(OBJECT,I);
3049         call MOVE(OBJECT+100,J);
3050         return;
3051         end;
3052 
3053 
3054 
3055 MOVE: proc (OBJECT,WHERE);
3056 
3057         dcl (OBJECT,WHERE) fixed bin(31);
3058 
3059 /*
3060    PLACE ANY OBJECT ANYWHERE BY PICKING IT UP AND DROPPING
3061    IT.  MAY ALREADY BE TOTING, IN WHICH CASE THE CARRY IS A
3062    NO-OP.  MUSTN'T PICK UP OBJECTS WHICH ARE NOT AT ANY LOC,
3063    SINCE CARRY WANTS TO REMOVE OBJECTS FROM ATLOC CHAINS.
3064 */
3065 
3066         if OBJECT > 100 then goto L1;
3067         FROM=PLACE(OBJECT);
3068         goto L2;
3069 L1:     FROM=FIXED(OBJECT-100);
3070 L2:     if FROM > 0 & FROM <= 300 then call CARRY(OBJECT,FROM);
3071         call DROP(OBJECT,WHERE);
3072         return;
3073         end;
3074 
3075 
3076 
3077 PUT: proc (OBJECT,WHERE,PVAL) returns(fixed bin(31));
3078 
3079         dcl (OBJECT,WHERE,PVAL) fixed bin(31);
3080 
3081 /*
3082    PUT IS THE SAME AS MOVE, EXCEPT IT RETURNS A VALUE USED
3083    TO SET UP THE NEGATED PROP VALUES FOR THE REPOSITORY
3084    OBJECTS.
3085 */
3086 
3087         call MOVE(OBJECT,WHERE);
3088         return((-1)-PVAL);
3089         end;
3090 
3091 
3092 
3093 CARRY: proc (OBJECT,WHERE);
3094 
3095         dcl (OBJECT,WHERE) fixed bin(31);
3096 
3097 /*
3098    START TOTING AN OBJECT, REMOVING IT FROM THE LIST OF
3099    THINGS AT ITS FORMER LOCATION.  INCR HOLDNG UNLESS IT WAS
3100    ALREADY BEING TOTED.  IF OBJECT>100 (MOVING "FIXED"
3101    SECOND LOC), DON'T CHANGE PLACE OR HOLDNG.
3102 */
3103 
3104 
3105 
3106         if OBJECT > 100 then goto L5;
3107         if PLACE(OBJECT) = -1 then return;
3108         PLACE(OBJECT)=-1;
3109         HOLDNG=HOLDNG+1;
3110 L5:     if ATLOC(WHERE) ^= OBJECT then goto L6;
3111         ATLOC(WHERE)=LINK(OBJECT);
3112         return;
3113 L6:     TEMP=ATLOC(WHERE);
3114 L7:     if LINK(TEMP) = OBJECT then goto L8;
3115         TEMP=LINK(TEMP);
3116         goto L7;
3117 L8:     LINK(TEMP)=LINK(OBJECT);
3118         return;
3119         end;
3120 
3121 
3122 
3123 DROP: proc (OBJECT,WHERE);
3124 
3125         dcl (OBJECT,WHERE) fixed bin(31);
3126 
3127 /*
3128    PLACE AN OBJECT AT A GIVEN LOC, PREFIXING IT ONTO THE
3129    ATLOC LIST.  DECR HOLDNG IF THE OBJECT WAS BEING TOTED.
3130 */
3131 
3132         if OBJECT > 100 then goto L1;
3133         if PLACE(OBJECT) = -1 then HOLDNG=HOLDNG-1;
3134         PLACE(OBJECT)=WHERE;
3135         goto L2;
3136 L1:     FIXED(OBJECT-100)=WHERE;
3137 L2:     if WHERE <= 0 then return;
3138         LINK(OBJECT)=ATLOC(WHERE);
3139         ATLOC(WHERE)=OBJECT;
3140         return;
3141         end;
3142 
3143 /*  UTILITY ROUTINES (RAN, CIAO, BUG) */
3144 
3145 /* CIAO: proc; */
3146 
3147 /*
3148    EXITS...NO MESSAGE OUTPUT SINCE CAN'T SAVE CORE IMAGE
3149 */
3150 
3151 /*
3152         stop;
3153         end;
3154 */
3155 
3156 
3157 
3158 BUG: proc (NUM);
3159 
3160         dcl NUM fixed bin(31);
3161 
3162 /*
3163    THE FOLLOWING CONDITIONS ARE CURRENTLY CONSIDERED FATAL
3164    BUGS.  NUMBERS < 20 ARE DETECTED WHILE READING THE
3165    DATABASE; THE OTHERS OCCUR AT "RUN TIME".
3166         0       MESSAGE LINE > 70 CHARACTERS
3167         1       NULL LINE IN MESSAGE
3168         2       TOO MANY WORDS OF MESSAGES
3169         3       TOO MANY TRAVEL OPTIONS
3170         4       TOO MANY VOCABULARY WORDS
3171         5       REQUIRED VOCABULARY WORD NOT FOUND
3172         6       TOO MANY RTEXT OR MTEXT MESSAGES
3173         7       TOO MANY HINTS
3174         8       LOCATION HAS COND BIT BEING SET TWICE
3175         9       INVALID SECTION NUMBER IN DATABASE
3176         20      SPECIAL TRAVEL (500>L>300) EXCEEDS GOTO LIST
3177         21      RAN OFF END OF VOCABULARY TABLE
3178         22      VOCABULARY TYPE (N/1000) NOT BETWEEN 0 AND 3
3179         23      INTRANSITIVE ACTION VERB EXCEEDS GOTO LIST
3180         24      TRANSITIVE ACTION VERB EXCEEDS GOTO LIST
3181         25      CONDITIONAL TRAVEL ENTRY WITH NO ALTERNATIVE
3182         26      LOCATION HAS NO TRAVEL ENTRIES
3183         27      HINT NUMBER EXCEEDS GOTO LIST
3184         28      INVALID MONTH RETURNED BY DATE FUNCTION
3185 */
3186 
3187 
3188         put string (OUTSTR) edit ("Fatal error # ",NUM) (a,f(2));
3189         call LINEOUT;
3190         stop;
3191         end;
3192 
3193 LINESKP: proc;
3194 
3195 /* OUTPUTS A BLANK LINE */
3196 
3197         OUTSTR=" ";
3198         call LINEOUT;
3199         return;
3200         end;
3201 
3202 LINEOUT: proc;
3203 
3204 /* OUTPUT A LINE TO MILTEN */
3205 
3206         INSTR=OUTSTR;
3207         if LOGON & OUTSTR ^= " " then
3208              put skip edit (OUTSTR) (a);
3209 /*      CCODE=0;
3210         do while (CCODE = 0);
3211             call TWRITE(INSTR,length(OUTSTR),CCODE);
3212             end; */
3213         put skip edit (OUTSTR) (a);
3214         return;
3215         end;
3216 
3217 RAN: proc (N) returns (fixed bin(31));
3218 
3219 /* RETURNS RANDOM NUMBER BETWEEN 0 AND N-1 */
3220 
3221         dcl N fixed bin(31);
3222         dcl RANRTN fixed bin(31);
3223 
3224 /*
3225         RANRTN=N;
3226         do while (RANRTN = N);
3227             call RANDU(IX,IY,Y);
3228             IX=IY;
3229             RANRTN=Y*N;
3230             end;
3231         return(RANRTN);
3232 */
3233         dcl r float bin(27);
3234         call random_$uniform (r);
3235         RANRTN = (trunc (r * N));
3236         return(RANRTN);
3237         end;
3238 
3239 
3240 /* CAC  end ADVENT; */
3241   end adventure;