sw/adventure/src/AMAIN.RA

   1         EXTERN  SAVEGM
   2         EXTERN  RSTRGM
   3         EXTERN  A5TOA1
   4         SECT    AMAIN
   5         EXTERN  BITSET
   6         EXTERN  BUG
   7         EXTERN  CARRY
   8         EXTERN  DROP
   9         EXTERN  DSTROY
  10         EXTERN  GETIN
  11         EXTERN  IABS
  12         EXTERN  JUGGLE
  13         EXTERN  MAX0
  14         EXTERN  MIN0
  15         EXTERN  MOD
  16         EXTERN  MOVE
  17         EXTERN  SPEAK
  18         EXTERN  PSPEAK
  19         EXTERN  PUT
  20         EXTERN  RND
  21         EXTERN  RSPEAK
  22         EXTERN  SPEAK
  23         EXTERN  VOCAB
  24         EXTERN  YES
  25         EXTERN  #FIX
  26         EXTERN  #WRITO
  27         EXTERN  #RENDO
  28         EXTERN  #RSVO
  29         EXTERN  #UE
  30         EXTERN  #EQ
  31         EXTERN  #NE
  32         EXTERN  PCT
  33         EXTERN  GETWRD
  34         EXTERN  PUTWRD
  35         EXTERN  SIXOUT
  36         JA      #ST
  37 #XR,    ORG     .+10
  38         TEXT    +AMAIN +
  39 #RET,   SETX    #XR
  40         SETB    #BASE
  41         JA      .+3
  42 #BASE,  ORG     .+6
  43         ORG     #BASE+30
  44         FNOP
  45         JA      #RET
  46         FNOP
  47 #GOBAK, 0;0
  48 HINT,   ORG     .+3
  49 KENT,   ORG     .+3
  50 KQ,     ORG     .+3
  51 K2,     ORG     .+3
  52 LL,     ORG     .+3
  53 N,      ORG     .+3
  54 PBOTL,  ORG     .+3
  55 SPK,    ORG     .+3
  56 WD1,    ORG     .+3
  57 WD1X,   ORG     .+3
  58 WD2,    ORG     .+3
  59 WD2X,   ORG     .+3
  60 YEA,    ORG     .+3
  61 #TMP,   ORG     .+30
  62
  63 ZERO,   F 0
  64 ONE,    F 1
  65 TWO,    F 2
  66 THREE,  F 3
  67 #LIT,   F 4             / Literals. Too many cause ST overflow
  68         F 5     /3
  69         F 6     /6
  70         F 8     /11
  71         F 9     /14
  72         F 10    /17
  73         F 12    /22
  74         F 15    /25
  75         F 16    /30
  76         F 17    /33
  77         F 20    /36
  78         F 22    /41
  79         F 23    /44
  80         F 24    /47
  81         F 25    /52
  82         F 26    /55
  83         F 27    /60
  84         F 30    /63
  85         F 35    /66
  86         F 37    /71
  87         F 39    /74
  88         F 40    /77
  89         F 45    /102
  90         F 49    /105
  91         F 50    /110
  92         F 54    /113
  93         F 57    /116
  94         F 58    /121
  95         F 62    /124
  96         F 65    /127
  97         F 81    /132
  98         F 202   /135
  99         F 91    /140
 100         F 92    /143
 101         F 95    /146
 102         F 99    /151
 103         F 100   /154
 104         F 105   /157
 105         F 110   /162
 106         F 115   /165
 107         F 116   /170
 108         F 117   /173
 109         F 127   /176
 110         F 128   /201
 111         F 129   /204
 112         F 130   /207
 113         F 131   /212
 114         F 132   /215
 115         F 136   /220
 116         F 140   /223
 117         F 141   /226
 118         F 143   /231
 119         F 145   /234
 120         F 162   /237
 121         F 163   /242
 122         F 165   /245
 123         F 175   /250
 124         F 184   /253
 125         F 185   /256
 126         F 186   /261
 127         F 188   /264
 128         F 192   /267
 129         F 193   /272
 130         F 197   /275
 131         F 199   /300
 132         F 201   /303
 133         F 300   /306
 134         F 500   /311
 135         F 1000  /314
 136         F 2500  /317
 137         F 10000 /322
 138 PCOND,  0                       /325
 139         JA      COND-3
 140 PFIXD,  0                       /330
 141         JA      FIXD-3
 142 PHINTS, 0                       /333
 143         JA      HINTS-77
 144 PABB,   0                       /336
 145         JA      ABB-3
 146 PPLAC,  0                       /341
 147         JA      PLAC-3
 148 TENTE,  TEXT +ENTE  +           /344
 149 TPOUR,  TEXT +POUR  +           /347
 150 TWEST,  TEXT +WEST  +           /352
 151 TQUES,  TEXT +?@    +           /355
 152 TQDOT,  TEXT +".@   +           /360
 153 TYES,   TEXT +YES   +           /363
 154 TYE,    TEXT +YE    +           /366
 155 TY,     TEXT +Y     +           /371
 156         F 154                   /374
 157         F 60                    /377
 158         F 29                    /402
 159 MINUS1, F -1.0
 160         #LBL=.
 161         COMMON  ABBCOM
 162 ABB,    ORG     .+702
 163         COMMON  MISCOM
 164 LINUSE, ORG     .+3
 165 TRVS,   ORG     .+3
 166 CLSSES, ORG     .+3
 167 OLDLOC, ORG     .+3
 168 LOC,    ORG     .+3
 169 CVAL,   ORG     .+44
 170 TK,     ORG     .+74
 171 NEWLOC, ORG     .+3
 172 KEY,    ORG     .+702
 173 PLAC,   ORG     .+454
 174 FIXD,   ORG     .+454
 175 ACTSPK, ORG     .+151
 176 COND,   ORG     .+702
 177 HINTS,  ORG     .+360
 178 HNTMAX, ORG     .+3
 179 PROP,   ORG     .+454
 180 TALLY,  ORG     .+3
 181 TALLY2, ORG     .+3
 182 HINTLC, ORG     .+74
 183 CHLOC,  ORG     .+3
 184 CHLOC2, ORG     .+3
 185 DSEEN,  ORG     .+22
 186 DFLAG,  ORG     .+3
 187 DLOC,   ORG     .+22
 188 DALTLC, ORG     .+3
 189 KEYS,   ORG     .+3
 190 LAMP,   ORG     .+3
 191 GRATE,  ORG     .+3
 192 CAGE,   ORG     .+3
 193 ROD,    ORG     .+3
 194 ROD2,   ORG     .+3
 195 STEPS,  ORG     .+3
 196 BIRD,   ORG     .+3
 197 DOOR,   ORG     .+3
 198 PILLOW, ORG     .+3
 199 SNAKE,  ORG     .+3
 200 FISSUR, ORG     .+3
 201 TABLET, ORG     .+3
 202 CLAM,   ORG     .+3
 203 OYSTER, ORG     .+3
 204 MAGZIN, ORG     .+3
 205 DWARF,  ORG     .+3
 206 KNIFE,  ORG     .+3
 207 FOOD,   ORG     .+3
 208 BOTTLE, ORG     .+3
 209 WATER,  ORG     .+3
 210 OIL,    ORG     .+3
 211 PLANT,  ORG     .+3
 212 PLANT2, ORG     .+3
 213 AXE,    ORG     .+3
 214 MIRROR, ORG     .+3
 215 DRAGON, ORG     .+3
 216 CHASM,  ORG     .+3
 217 TROLL,  ORG     .+3
 218 TROLL2, ORG     .+3
 219 BEAR,   ORG     .+3
 220 MESSAG, ORG     .+3
 221 VEND,   ORG     .+3
 222 BATTER, ORG     .+3
 223 NUGGET, ORG     .+3
 224 COINS,  ORG     .+3
 225 CHEST,  ORG     .+3
 226 EGGS,   ORG     .+3
 227 TRIDNT, ORG     .+3
 228 VASE,   ORG     .+3
 229 EMRALD, ORG     .+3
 230 PYRAM,  ORG     .+3
 231 PEARL,  ORG     .+3
 232 RUG,    ORG     .+3
 233 CHAIN,  ORG     .+3
 234 BACK,   ORG     .+3
 235 LOOK,   ORG     .+3
 236 CAVE,   ORG     .+3
 237 NULL,   ORG     .+3
 238 ENTRNC, ORG     .+3
 239 DPRSSN, ORG     .+3
 240 SAY,    ORG     .+3
 241 LOCK,   ORG     .+3
 242 THROW,  ORG     .+3
 243 FIND,   ORG     .+3
 244 INVENT, ORG     .+3
 245 TURNS,  ORG     .+3
 246 LMWARN, ORG     .+3
 247 KNFLOC, ORG     .+3
 248 DETAIL, ORG     .+3
 249 ABBNUM, ORG     .+3
 250 NUMDIE, ORG     .+3
 251 MAXDIE, ORG     .+3
 252 DKILL,  ORG     .+3
 253 FOOBAR, ORG     .+3
 254 BONUS,  ORG     .+3
 255 CLOCK1, ORG     .+3
 256 CLOCK2, ORG     .+3
 257 CLOSNG, ORG     .+3
 258 PANIC,  ORG     .+3
 259 CLOSED, ORG     .+3
 260 GAVEUP, ORG     .+3
 261 SCORNG, ORG     .+3
 262 ODLOC,  ORG     .+22
 263 STREAM, ORG     .+3
 264 SPICES, ORG     .+3
 265
 266         COMMON  MISC2
 267 I,      ORG     .+3
 268         ORG     .+3     /RTXSIZ
 269         ORG     .+3     /CLSMAX
 270         ORG     .+3     /LOCSIZ
 271 CTEXT,  ORG     .+44
 272 STEXT,  ORG     .+702
 273 LTEXT,  ORG     .+702
 274         ORG     .+3     /SECT
 275 TRAVEL, ORG     .+1356
 276 TRVCON, ORG     .+1356
 277 TRVLOC, ORG     .+1356
 278 TRVSIZ, ORG     .+3
 279         ORG     .+3     /TABNDX
 280 OBJ,    ORG     .+3
 281 J,      ORG     .+3
 282 K,      ORG     .+3
 283 VERB,   ORG     .+3
 284 HNTSIZ, ORG     .+3
 285 MAXTRS, ORG     .+3
 286 HINTED, ORG     .+74
 287         ORG     .+3     /HNTLOC
 288 KK,     ORG     .+3
 289         COMMON  PLACOM
 290 ATLOC,  ORG     .+702
 291 LINK,   ORG     .+1130
 292 PLACE,  ORG     .+454
 293 FIXED,  ORG     .+454
 294 HOLDNG, ORG     .+3
 295         COMMON  PTXCOM
 296 PTEXT,  ORG     .+454
 297         COMMON  TXTCOM
 298 RTEXT,  ORG     .+1147
 299         ORG     .+44    /LINES
 300         ORG     .+3     /ASCVAR
 301         ORG     .+3     /TXTLOC
 302         ORG     .+234   /DATA
 303         COMMON  MISC3
 304 ATTACK, ORG     .+3
 305 DTOTAL, ORG     .+3
 306 OLDLC2, ORG     .+3
 307 LIMIT,  ORG     .+3
 308 MXSCOR, ORG     .+3
 309 SCORE,  ORG     .+3
 310 STICK,  ORG     .+3
 311 WZDARK, ORG     .+3
 312 \f       ORG     #LBL
 313 #25000,
 314 #RTN,   BASE    #BASE
 315         JA      #GOBAK
 316 #ST,    STARTD
 317         0210
 318         FSTA    #GOBAK,0
 319         0200
 320         SETX    #XR
 321         SETB    #BASE
 322         STARTF
 323         JA      #STRT    /#G0001
 324 /
 325 / Statement functions - called with JSA to save space
 326 /
 327 /       TOTING(OBJ)=PLACE(OBJ).EQ.-1
 328 TOTING, 0;0
 329         ATX     3
 330         FLDA    PLACE-3,3
 331         FADD    ONE
 332         JSA     #EQ
 333         JA      TOTING
 334
 335 /       AT(OBJ)=PLACE(OBJ).EQ.LOC.OR.FIXED(OBJ).EQ.LOC
 336 AT,     0;0
 337         ATX     3
 338         FLDA    PLACE-3,3
 339         FSUB    LOC
 340         JEQ     ISAT
 341         FLDA    FIXED-3,3
 342         FSUB    LOC
 343 ISAT,   JSA     #EQ
 344         JA      AT
 345
 346 /       FORCED(LOC)=COND(LOC).EQ.2
 347 FORCED, 0;0
 348         ATX     3
 349         FLDA    COND-3,3
 350         FSUB    TWO
 351         JSA     #EQ
 352         JA      FORCED
 353
 354 /       HERE(OBJ) = PLACE(OBJ).EQ.LOC .OR. TOTING(OBJ)
 355 HERE,   0;0
 356         JSA     TOTING
 357         JNE     ISHERE
 358         FLDA    LOC
 359         FSUB    PLACE-3,3
 360         JEQ     ISHERE
 361         FCLA
 362         JA      HERE
 363 ISHERE, FLDA    ONE
 364         JA      HERE
 365
 366 / DARK(DUMMY)=MOD(COND(LOC),2).EQ.0.AND.(PROP(LAMP).EQ.0.OR.
 367 / 1     .NOT.HERE(LAMP))
 368
 369 DARK,   0;0
 370 / .OR. .NOT. HERE(LAMP)
 371         FLDA    LAMP
 372         JSA     HERE
 373         JEQ     NOTHR
 374 / .OR. PROP(LAMP) EQ 0
 375         FLDA    LAMP
 376         ATX     4
 377         FLDA    PROP-3,4
 378         JNE     NOTDRK
 379 / MOD(COND(LOC),2) .EQ. 0
 380 NOTHR,  FLDA    LOC             / Either prop or not here
 381         ATX     4
 382         FLDA    COND-3,4        / COND(LOC)
 383         FDIV    TWO             / Divided by two
 384         JSA     #FIX
 385         FMUL    TWO
 386         FSTA    #TMP+14
 387         FLDA    COND-3,4        / Get back COND(LOC)
 388         FSUB    #TMP+14         / Now have mod
 389         JNE     NOTDRK          / If not zero, not dark
 390         FLDA    ONE
 391         JA      DARK
 392 NOTDRK, FCLA
 393         JA      DARK
 394
 395 /       LIQ2(PBOTL)=(1-PBOTL)*WATER+(PBOTL/2)*(WATER+OIL)
 396 LIQ2,   0;0
 397         FLDA    ONE
 398         FSUB    PBOTL           / 1 - PBOTL
 399         FMUL    WATER           / (1-PBOTL)*WATER
 400         FSTA    #TMP+14         / Store first term
 401         FLDA    PBOTL
 402         FDIV    TWO             / PBOTL/2
 403         JSA     #FIX
 404         FSTA    #TMP+6
 405         FLDA    WATER
 406         FADD    OIL             / WATER+OIL
 407         FMUL    #TMP+6          / (PBOTL/2)*(WATER+OIL)
 408         FADD    #TMP+14
 409         JA      LIQ2            / Done
 410
 411 /       LIQ(DUMMY)=LIQ2(MAX0(PROP(BOTTLE),-1-PROP(BOTTLE)))
 412 LIQ,    0;0
 413 /PROP(BOTTLE)
 414         FLDA    BOTTLE
 415         ATX     5
 416         FLDA    PROP-3,5        / PROP(BOTTLE)
 417         FSTA    PBOTL
 418         FLDA    MINUS1
 419         FSUB    PBOTL           /-1-PROP(BOTTLE)
 420         FSTA    #TMP+11
 421         FLDA    PBOTL           / Find larger
 422         FSUB    #TMP+11
 423         JGT     .+4             / already larger, now PBOTL
 424         FLDA    #TMP+11
 425         FSTA    PBOTL           / This is PBOTL
 426         JSA     LIQ2            / Call LIQ2 with this
 427         JA      LIQ             / And return
 428
 429 /       LIQLOC(LOC)=LIQ2((MOD(COND(LOC)/2*2,8)-5)*MOD(COND(LOC)/4,2)+1)
 430 LIQLOC, 0;0
 431         FLDA    LOC             / Always called with LOC as arg
 432         ATX     2
 433         FLDA    COND-3,2        / COND(LOC)
 434         FSTA    #TMP+11         / Save that
 435         FDIV    TWO
 436         JSA     #FIX            / COND(LOC)/2
 437         FMUL    TWO             / COND(LOC)/2*2
 438         FSTA    #TMP+17
 439         FDIV    #LIT+11         / Modulo 8
 440         JSA     #FIX
 441         FMUL    #LIT+11
 442         FSTA    #TMP+22
 443         FLDA    #TMP+17
 444         FSUB    #TMP+22         / MOD(...)
 445         FSUB    #LIT+3          / -5.
 446         FSTA    #TMP+25         / First Term
 447         FLDA    #TMP+11         / COND(LOC)
 448         FDIV    #LIT            / COND(LOC)/4
 449         JSA     #FIX
 450         FSTA    #TMP+17
 451         FDIV    TWO             / Mod 2
 452         JSA     #FIX
 453         FMUL    TWO
 454         FSTA    #TMP+22
 455         FLDA    #TMP+17
 456         FSUB    #TMP+22
 457         FMUL    #TMP+25         / Multiply
 458         FADD    ONE             / +1
 459         FSTA    PBOTL           / Finally got the term
 460         JSA     LIQ2            / Send to LIQ2
 461         JA      LIQLOC
 462 \f/
 463 / Main routine entry point
 464 /
 465 #STRT,
 466 /1       I=RND(1)
 467 #1,     JSR     RND
 468         JA      .+4
 469         JA      ONE
 470         FSTA    I
 471 /       HINTED(3)=YES(65,1,0)
 472         LDX     3,7
 473         JSR     YES
 474         JA      .+10
 475         JA      #LIT+127
 476         JA      ONE
 477         JA      ZERO
 478         FSTA    HINTED-3,7
 479 /       NEWLOC=1
 480         FLDA    ONE
 481         FSTA    NEWLOC
 482 /       LOC = NEWLOC
 483         FSTA    LOC
 484 /       LIMIT=330
 485         LDX     512,0   /330
 486         XTA     0
 487         FSTA    LIMIT
 488 /       IF(HINTED(3))LIMIT=1000
 489         FLDA    HINTED-3,7
 490         JEQ     #2
 491         FLDA    #LIT+314
 492         FSTA    LIMIT
 493 /2       IF(NEWLOC.GE.9.OR.NEWLOC.EQ.0.OR..NOT.CLOSNG)GOTO 71
 494 #2,     FLDA    NEWLOC
 495         FSUB    #LIT+14
 496         JGE     #71
 497         FLDA    NEWLOC
 498         JEQ     #71
 499         FLDA    CLOSNG
 500         JEQ     #71
 501 /       CALL RSPEAK(130)
 502         JSR     RSPEAK
 503         JA      .+4
 504         JA      #LIT+207
 505 /       NEWLOC=LOC
 506         FLDA    LOC
 507         FSTA    NEWLOC
 508 /       IF(.NOT.PANIC)CLOCK2=15
 509         FLDA    PANIC
 510         JNE     .+5
 511         FLDA    #LIT+25
 512         FSTA    CLOCK2
 513 /       PANIC=.TRUE.
 514         FLDA    ONE
 515         FSTA    PANIC
 516 /C
 517 /C SEE IF A DWARF HAS SEEN HIM AND HAS COME FROM WHERE HE WANTS TO GO. IF SO,
 518 /C THE DWARF'S BLOCKING HIS WAY. IF COMING FROM PLACE FORBIDDEN TO PIRATE
 519 /C (DWARVES ROOTED IN PLACE) LET HIM GET OUT (AND ATTACKED).
 520 /C
 521 /71      IF(NEWLOC.EQ.LOC.OR.FORCED(LOC).OR.BITSET(LOC,3))GOTO 74
 522 #71,    FLDA    NEWLOC
 523         FSUB    LOC
 524         JEQ     #74
 525         FLDA    LOC
 526         JSA     FORCED
 527         JNE     #74
 528         JSR     BITSET
 529         JA      .+6
 530         JA      LOC
 531         JA      THREE
 532         JNE     #74
 533 /       DO 73 I=1,5
 534         FLDA    ONE
 535         FSTA    I
 536
 537 /       IF(ODLOC(I).NE.NEWLOC.OR..NOT.DSEEN(I))GOTO 73
 538 #G0047, FLDA    I
 539         ATX     7
 540         FLDA    ODLOC-3,7
 541         FSUB    NEWLOC
 542         JNE     #73
 543         FLDA    DSEEN-3,7
 544         JEQ     #73
 545 /       NEWLOC=LOC
 546         FLDA    LOC
 547         FSTA    NEWLOC
 548 /       CALL RSPEAK(2)
 549         JSR     RSPEAK
 550         JA      .+4
 551         JA      TWO
 552 /       GOTO 74
 553         JA      #74
 554 /73      CONTINUE
 555 #73,    FLDA    I
 556         FADD    ONE
 557         FSTA    I
 558         FSUB    #LIT+3
 559         JLE     #G0047
 560
 561 #74,    FLDA    NEWLOC
 562         FSTA    LOC
 563 /C
 564 /C DWARF STUFF. SEE EARLIER COMMENTS FOR DESCRIPTION OF VARIABLES. REMEMBER
 565 /C SIXTH DWARF IS PIRATE AND IS THUS VERY DIFFERENT EXCEPT FOR MOTION RULES.
 566 /C
 567 /C FIRST OFF, DON'T LET THE DWARVES FOLLOW HIM INTO A PIT OR A WALL. ACTIVATE
 568 /C THE WHOLE MESS THE FIRST TIME HE GETS AS FAR AS THE HALL OF MISTS (LOC 15).
 569 /C IF NEWLOC IS FORBIDDEN TO PIRATE (IN PARTICULAR, IF IT'S BEYOND THE TROLL
 570 /C BRIDGE), BYPASS DWARF STUFF. THAT WAY PIRATE CAN'T STEAL RETURN TOLL, AND
 571 /C DWARVES CAN'T MEET THE BEAR. ALSO MEANS DWARVES WON'T FOLLOW HIM INTO DEAD
 572 /C END IN MAZE, BUT C'EST LA VIE. THEY'LL WAIT FOR HIM OUTSIDE THE DEAD END.
 573 /C
 574 /       IF(LOC.EQ.0.OR.FORCED(LOC).OR.BITSET(NEWLOC,3))GOTO 2000
 575         JEQ     #2000
 576         FLDA    LOC
 577         JSA     FORCED
 578         JNE     #2000
 579         JSR     BITSET
 580         JA      .+6
 581         JA      NEWLOC
 582         JA      THREE
 583         JNE     #2000
 584 /       IF(DFLAG.NE.0)GOTO 6000
 585         FLDA    DFLAG
 586         JNE     #6000
 587 /       IF(LOC.GE.15)DFLAG=1
 588         FLDA    LOC
 589         FSUB    #LIT+25
 590         JLT     #2000
 591         FLDA    ONE
 592         FSTA    DFLAG
 593 /       GOTO 2000
 594         JA      #2000
 595
 596 /C
 597 /C WHEN WE ENCOUNTER THE FIRST DWARF, WE KILL 0, 1, OR 2 OF THE 5 DWARVES. IF
 598 /C ANY OF THE SURVIVORS IS AT LOC, REPLACE HIM WITH THE ALTERNATE.
 599 /C
 600 /6000    IF(DFLAG.NE.1)GOTO 6010
 601 #6000,  FLDA    DFLAG
 602         FSUB    ONE
 603         JNE     #6010
 604 /       IF(LOC.LT.15.OR.PCT(95))GOTO 2000
 605         FLDA    LOC
 606         FSUB    #LIT+25
 607         JLT     #2000
 608         JSR     PCT
 609         JA      .+4
 610         JA      #LIT+146
 611         JNE     #2000
 612 /       DFLAG=2
 613         FLDA    TWO
 614         FSTA    DFLAG
 615 /       DO 6001 I=1,2
 616         FLDA    ONE
 617         FSTA    I
 618
 619 /       J=1+RND(5)
 620 #G0051, JSR     RND
 621         JA      .+4
 622         JA      #LIT+3
 623         FADD    ONE
 624         FSTA    J
 625
 626 /6001    IF(PCT(50))DLOC(J)=0
 627 #6001,  JSR     PCT
 628         JA      .+4
 629         JA      #LIT+110
 630         JEQ     .+10
 631         FLDA    J
 632         ATX     7
 633         FCLA
 634         FSTA    DLOC-3,7
 635         FLDA    I
 636         FADD    ONE
 637         FSTA    I
 638         FSUB    TWO
 639         JLE     #G0051
 640 /       DO 6002 I=1,5
 641         FLDA    ONE
 642         FSTA    I
 643
 644 /       IF(DLOC(I).EQ.LOC)DLOC(I)=DALTLC
 645 #G0053, FLDA    I
 646         ATX     7
 647         FLDA    DLOC-3,7
 648         FSUB    LOC
 649         JNE     #6002
 650         FLDA    DALTLC
 651         FSTA    DLOC-3,7
 652 /6002    ODLOC(I)=DLOC(I)
 653 #6002,  FLDA    I
 654         ATX     7
 655         FLDA    DLOC-3,7
 656         FSTA    ODLOC-3,7
 657         FLDA    I
 658         FADD    ONE
 659         FSTA    I
 660         FSUB    #LIT+3
 661         JLE     #G0053
 662 /       CALL RSPEAK(3)
 663         JSR     RSPEAK
 664         JA      .+4
 665         JA      THREE
 666 /       CALL DROP(AXE,LOC)
 667         JSR     DROP
 668 /       GOTO 2000
 669         JA      #2000
 670         JA      AXE
 671         JA      LOC
 672
 673 /C
 674 /C THINGS ARE IN FULL SWING. MOVE EACH DWARF AT RANDOM, EXCEPT IF HE'S SEEN US
 675 /C HE STICKS WITH US. DWARVES NEVER GO TO LOCS <15. IF WANDERING AT RANDOM,
 676 /C THEY DON'T BACK UP UNLESS THERE'S NO ALTERNATIVE. IF THEY DON'T HAVE TO
 677 /C MOVE, THEY ATTACK. AND, OF COURSE, DEAD DWARVES DON'T DO MUCH OF ANYTHING.
 678 /C
 679 /6010    DTOTAL=0
 680 #6010,  FCLA
 681         FSTA    DTOTAL
 682 /       ATTACK=0
 683         FSTA    ATTACK
 684 /       STICK=0
 685         FSTA    STICK
 686 /       DO 6030 I=1,6
 687         FLDA    ONE
 688         FSTA    I
 689 /        IF (DLOC(I).EQ.0)GOTO 6030
 690 #G0055, FLDA    I
 691         ATX     7
 692         FLDA    DLOC-3,7
 693         JEQ     #6030
 694 /       J=1
 695         FLDA    ONE
 696         FSTA    J
 697 /       KK=DLOC(I)
 698         FLDA    DLOC-3,7
 699         FSTA    KK
 700 /       KK=KEY(KK)
 701         ATX     7
 702         FLDA    KEY-3,7
 703         FSTA    KK
 704 /       IF(KK.EQ.0)GOTO 6016
 705         JEQ     #6016
 706
 707 /6012    NEWLOC=TRVLOC(KK)
 708 #6012,  JSR     GETWRD
 709         JA      .+10
 710         JA      TRVLOC
 711         JA      KK
 712         JA      ZERO
 713         FSTA    NEWLOC
 714 /       IF(NEWLOC.GT.300.OR.NEWLOC.LT.15.OR.NEWLOC.EQ.ODLOC(I)
 715 /       1       .OR.(J.GT.1.AND.NEWLOC.EQ.TK(J-1)).OR.J.GE.20
 716 /       2       .OR.NEWLOC.EQ.DLOC(I).OR.FORCED(NEWLOC)
 717 /       3       .OR.(I.EQ.6.AND.BITSET(NEWLOC,3))
 718 /       4       .OR.TRVCON(KK).EQ.100)GOTO 6014
 719         FSUB    #LIT+306
 720         JGT     #6014
 721         FLDA    NEWLOC
 722         FSUB    #LIT+25
 723         JLT     #6014
 724         FLDA    I
 725         ATX     7
 726         FLDA    NEWLOC
 727         FSUB    ODLOC-3,7
 728         JEQ     #6014
 729         FLDA    J
 730         FSUB    ONE
 731         JLE     .+11
 732         ATX     6
 733         FLDA    NEWLOC
 734         FSUB    TK-3,6
 735         JEQ     #6014
 736         FLDA    J
 737         FSUB    #LIT+36
 738         JGE     #6014
 739         FLDA    I
 740         ATX     7
 741         FLDA    NEWLOC
 742         FSUB    DLOC-3,7
 743         JEQ     #6014
 744         FLDA    NEWLOC
 745         JSA     FORCED
 746         JNE     #6014
 747         FLDA    I
 748         FSUB    #LIT+6
 749         JNE     .+14
 750         JSR     BITSET
 751         JA      .+6
 752         JA      NEWLOC
 753         JA      THREE
 754         JNE     #6014
 755         JSR     GETWRD
 756         JA      .+10
 757         JA      TRVCON
 758         JA      KK
 759         JA      ZERO
 760         FSUB    #LIT+154
 761         JEQ     #6014
 762 /       TK(J)=NEWLOC
 763         FLDA    J
 764         ATX     7
 765         FLDA    NEWLOC
 766         FSTA    TK-3,7
 767 /       J=J+1
 768         FLDA    ONE
 769         FADDM   J
 770
 771 /6014    KK=KK+1
 772 #6014,  FLDA    KK
 773         FADD    ONE
 774         FSTA    KK
 775 /       IF(TRAVEL(KK-1).GE.0)GOTO 6012
 776         FSUB    ONE
 777         FSTA    #TMP
 778         JSR     GETWRD
 779         JA      .+10
 780         JA      TRAVEL
 781         JA      #TMP
 782         JA      ZERO
 783         JGE     #6012
 784 /6016    TK(J)=ODLOC(I)
 785 #6016,  FLDA    J
 786         ATX     6
 787         FLDA    I
 788         ATX     7
 789         FLDA    ODLOC-3,7
 790         FSTA    TK-3,6
 791 /       IF(J.GE.2)J=J-1
 792         FLDA    J
 793         FSUB    TWO
 794         JLT     .+5
 795         FLDA    MINUS1
 796         FADDM   J
 797 /       J=1+RND(J)
 798         JSR     RND
 799         JA      .+4
 800         JA      J
 801         FADD    ONE
 802         FSTA    J
 803 /       ODLOC(I)=DLOC(I)
 804         FLDA    DLOC-3,7
 805         FSTA    ODLOC-3,7
 806 /       DLOC(I)=TK(J)
 807         FLDA    J
 808         ATX     6
 809         FLDA    TK-3,6
 810         FSTA    DLOC-3,7
 811 /       DSEEN(I)=(DSEEN(I).AND.LOC.GE.15)
 812 /       1       .OR.(DLOC(I).EQ.LOC.OR.ODLOC(I).EQ.LOC)
 813         FLDA    LOC
 814         FSUB    #LIT+25
 815         JLT     .+6
 816         FLDA    DSEEN-3,7
 817         JNE     .+21
 818         FLDA    DLOC-3,7
 819         FSUB    LOC
 820         JEQ     .+13
 821         FLDA    ODLOC-3,7
 822         FSUB    LOC
 823         JEQ     .+5
 824         FCLA
 825         JA      .+3
 826         FLDA    ONE
 827         FSTA    DSEEN-3,7
 828 /       IF(.NOT.DSEEN(I))GOTO 6030
 829         JEQ     #6030
 830 /       DLOC(I)=LOC
 831         FLDA    LOC
 832         FSTA    DLOC-3,7
 833 /       IF(I.NE.6)GOTO 6027
 834         FLDA    I
 835         FSUB    #LIT+6
 836         JNE     #6027
 837 /C
 838 /C THE PIRATE'S SPOTTED HIM. HE LEAVES HIM ALONE ONCE WE'VE FOUND CHEST.
 839 /C K COUNTS IF A TREASURE IS HERE. IF NOT, AND TALLY=TALLY2 PLUS ONE FOR
 840 /C AN UNSEEN CHEST, LET THE PIRATE BE SPOTTED.
 841 /C
 842 /       IF(LOC.EQ.CHLOC.OR.PROP(CHEST).GE.0)GOTO 6030
 843
 844         FLDA    LOC
 845         FSUB    CHLOC
 846         JEQ     #6030
 847         FLDA    CHEST
 848         ATX     7
 849         FLDA    PROP-3,7
 850         JGE     #6030
 851 /       K=0
 852         FCLA
 853         FSTA    K
 854 /       DO 6020 J=50,MAXTRS
 855         FLDA    #LIT+110
 856         FSTA    J
 857 /C
 858 /C PIRATE WON'T TAKE PYRAMID FROM PLOVER ROOM OR DARK ROOM (TOO EASY!).
 859 /C
 860 /       IF(J.EQ.PYRAM.AND.(LOC.EQ.PLAC(PYRAM)
 861 /       1       .OR.LOC.EQ.PLAC(EMRALD)))GOTO 6020
 862 #G0057, FLDA    J
 863         FSUB    PYRAM
 864         JNE     .+13
 865         FLDA    PYRAM
 866         ATX     7
 867         FLDA    LOC
 868         FSUB    PLAC-3,7
 869         JEQ     #6020
 870         FLDA    EMRALD
 871         ATX     6
 872         FLDA    LOC
 873         FSUB    PLAC-3,6
 874         JEQ     #6020
 875 /       IF(TOTING(J))GOTO 6022
 876         FLDA    J
 877         JSA     TOTING
 878         JNE     #6022
 879
 880 /6020    IF(HERE(J))K=1
 881 #6020,  FLDA    J
 882         JSA     HERE
 883         JEQ     .+5
 884         FLDA    ONE
 885         FSTA    K
 886         FLDA    J
 887         FADD    ONE
 888         FSTA    J
 889         FSUB    MAXTRS
 890         JLE     #G0057
 891 /       IF(TALLY.EQ.TALLY2+1.AND.K.EQ.0.AND.PLACE(CHEST).EQ.0
 892 /       1       .AND.HERE(LAMP).AND.PROP(LAMP).EQ.1)GOTO 6025
 893         FLDA    TALLY2
 894         FADD    ONE
 895         FSUB    TALLY
 896         JNE     #M4
 897         FLDA    K
 898         JNE     #M4
 899         FLDA    CHEST
 900         ATX     7
 901         FLDA    PLACE-3,7
 902         JNE     #M4
 903         FLDA    LAMP
 904         JSA     HERE
 905         JEQ     #M4
 906         FLDA    LAMP
 907         ATX     6
 908         FLDA    PROP-3,6
 909         FSUB    ONE
 910         JEQ     #6025
 911 /       IF(ODLOC(6).NE.DLOC(6).AND.PCT(20))CALL RSPEAK(127)
 912 #M4,    FLDA    #LIT+6
 913         ATX     7
 914         FLDA    ODLOC-3,7
 915         FSUB    DLOC-3,7
 916         JEQ     #6030
 917         JSR     PCT
 918         JA      .+4
 919         JA      #LIT+36
 920         JEQ     #6030
 921         JSR     RSPEAK
 922 /       GOTO 6030
 923         JA      #6030
 924         JA      #LIT+176
 925 /C
 926 /6022    CALL RSPEAK(128)
 927 #6022,  JSR     RSPEAK
 928         JA      .+4
 929         JA      #LIT+201
 930 /C
 931 /C DON'T STEAL CHEST BACK FROM TROLL!
 932 /C
 933 /       IF(PLACE(MESSAG).EQ.0)CALL MOVE(CHEST,CHLOC)
 934         FLDA    MESSAG
 935         ATX     7
 936         FLDA    PLACE-3,7
 937         JNE     .+12
 938         JSR     MOVE
 939         JA      .+6
 940         JA      CHEST
 941         JA      CHLOC
 942 /       CALL MOVE(MESSAG,CHLOC2)
 943         JSR     MOVE
 944         JA      .+6
 945         JA      MESSAG
 946         JA      CHLOC2
 947 /       DO 6023 J=50,MAXTRS
 948         FLDA    #LIT+110
 949         FSTA    J
 950
 951 /       IF(J.EQ.PYRAM.AND.(LOC.EQ.PLAC(PYRAM)
 952 /       1       .OR.LOC.EQ.PLAC(EMRALD)))GOTO 6023
 953 #G0063, FLDA    J
 954         FSUB    PYRAM
 955         JNE     .+13
 956         FLDA    PYRAM
 957         ATX     7
 958         FLDA    LOC
 959         FSUB    PLAC-3,7
 960         JEQ     #6023
 961         FLDA    EMRALD
 962         ATX     6
 963         FLDA    LOC
 964         FSUB    PLAC-3,6
 965         JEQ     #6023
 966 /       IF(AT(J).AND.FIXED(J).EQ.0)CALL CARRY(J,LOC)
 967         FLDA    J
 968         JSA     AT
 969         JEQ     .+21
 970         FLDA    J
 971         ATX     7
 972         FLDA    FIXED-3,7
 973         JNE     .+12
 974         JSR     CARRY
 975         JA      .+6
 976         JA      J
 977         JA      LOC
 978 /       IF(TOTING(J))CALL DROP(J,CHLOC)
 979         FLDA    J
 980         JSA     TOTING
 981         JEQ     #6023
 982         JSR     DROP
 983         JA      .+6
 984         JA      J
 985         JA      CHLOC
 986 /6023    CONTINUE
 987 #6023,  FLDA    J
 988         FADD    ONE
 989         FSTA    J
 990         FSUB    MAXTRS
 991         JLE     #G0063
 992
 993 /6024    DLOC(6)=CHLOC
 994 #6024,  FLDA    #LIT+6
 995         ATX     7
 996         FLDA    CHLOC
 997         FSTA    DLOC-3,7
 998 /       ODLOC(6)=CHLOC
 999         FSTA    ODLOC-3,7
1000 /       DSEEN(6)=.FALSE.
1001         FCLA
1002         FSTA    DSEEN-3,7
1003 /       GOTO 6030
1004         JA      #6030
1005
1006 /C
1007 /6025    CALL RSPEAK(186)
1008
1009 #6025,  JSR     RSPEAK
1010         JA      .+4
1011         JA      #LIT+261
1012 /       CALL MOVE(CHEST,CHLOC)
1013         JSR     MOVE
1014         JA      .+6
1015         JA      CHEST
1016         JA      CHLOC
1017 /       CALL MOVE(MESSAG,CHLOC2)
1018         JSR     MOVE
1019 /       GOTO 6024
1020         JA      #6024
1021         JA      MESSAG
1022         JA      CHLOC2
1023
1024 /C
1025 /C THIS THREATENING LITTLE DWARF IS IN THE ROOM WITH HIM!
1026 /C
1027 /6027    DTOTAL=DTOTAL+1
1028 #6027,  FLDA    ONE
1029         FADDM   DTOTAL
1030 /       IF(ODLOC(I).NE.DLOC(I))GOTO 6030
1031         FLDA    I
1032         ATX     7
1033         FLDA    ODLOC-3,7
1034         FSUB    DLOC-3,7
1035         JNE     #6030
1036 /       ATTACK=ATTACK+1
1037         FLDA    ONE
1038         FADDM   ATTACK
1039 /       IF(KNFLOC.GE.0)KNFLOC=LOC
1040         FLDA    KNFLOC
1041         JLT     .+6
1042         FLDA    LOC
1043         FSTA    KNFLOC
1044 /       IF(RND(1000).LT.95*(DFLAG-2))STICK=STICK+1
1045         JSR     RND
1046         JA      .+4
1047         JA      #LIT+314
1048         FSTA    #TMP
1049         FLDA    DFLAG
1050         FSUB    TWO
1051         FMUL    #LIT+146
1052         FSUB    #TMP
1053         JLT     #6030
1054         FLDA    ONE
1055         FADDM   STICK
1056 /6030    CONTINUE
1057 #6030,  FLDA    I
1058         FADD    ONE
1059         FSTA    I
1060         FSUB    #LIT+6
1061         JLE     #G0055
1062 /C
1063 /C NOW WE KNOW WHAT'S HAPPENING. LET'S TELL THE POOR SUCKER ABOUT IT.
1064 /C
1065 /       IF(DTOTAL.EQ.0)GOTO 2000
1066         FLDA    DTOTAL
1067         JEQ     #2000
1068 /       IF(DTOTAL.EQ.1)GOTO 75
1069         FSUB    ONE
1070         JEQ     #75
1071 /       TYPE 67,DTOTAL
1072 /67      FORMAT(' There are ',I1,' threatening little dwarves in the'
1073 /       1       ,' room with you.')
1074
1075         JSR     SIXOUT
1076         JA      .+10
1077         JA      #67A
1078         JA      ZERO
1079         JA      TWO
1080
1081         TRAP3   #WRITO
1082         JA      #LIT
1083         JA      #67
1084         FLDA    DTOTAL
1085         TRAP3   #RSVO
1086         TRAP3   #RENDO
1087
1088         JSR     SIXOUT
1089 /        GOTO 77
1090         JA      #77
1091 
       JA      #67B
1092         JA      ZERO
1093         JA      ONE
1094
1095 /75      CALL RSPEAK(4)
1096 #75,    JSR     RSPEAK
1097         JA      .+4
1098         JA      #LIT
1099
1100 /77      IF(ATTACK.EQ.0)GOTO 2000
1101 #77,    FLDA    ATTACK
1102         JEQ     #2000
1103 /       IF(DFLAG.EQ.2)DFLAG=3
1104         FLDA    DFLAG
1105         FSUB    TWO
1106         JNE     .+5
1107         FLDA    THREE
1108         FSTA    DFLAG
1109 /       IF(ATTACK.EQ.1)GOTO 79
1110         FLDA    ATTACK
1111         FSUB    ONE
1112         JEQ     #79
1113 /       TYPE 78,ATTACK
1114 /78      FORMAT(' ',I1,' of them throw knives at you!')
1115         TRAP3   #WRITO
1116         JA      #LIT
1117         JA      #78
1118         FLDA    ATTACK
1119         TRAP3   #RSVO
1120         TRAP3   #RENDO
1121         JSR     SIXOUT
1122         JA      .+10
1123         JA      #78B
1124         JA      ZERO
1125         JA      ONE
1126 /       K=6
1127         FLDA    #LIT+6
1128         FSTA    K
1129
1130 /82      IF(STICK.GT.1)GOTO 83
1131 #82,    FLDA    STICK
1132         FSUB    ONE
1133         JGT     #83
1134 /       CALL RSPEAK(K+STICK)
1135         FLDA    K
1136         FADD    STICK
1137         FSTA    #TMP
1138         JSR     RSPEAK
1139         JA      .+4
1140         JA      #TMP
1141 /       IF(STICK.EQ.0)GOTO 2000
1142         FLDA    STICK
1143         JEQ     #2000
1144 /       GOTO 84
1145         JA      #84
1146
1147 /83      TYPE 68,STICK
1148 #83,    TRAP3   #WRITO
1149         JA      #LIT
1150         JA      #68
1151         FLDA    STICK
1152         TRAP3   #RSVO
1153         TRAP3   #RENDO
1154
1155 /68      FORMAT(' ',I1,' of them get you!')
1156         JSR     SIXOUT
1157         JA      .+10
1158         JA      #68B
1159         JA      ZERO
1160         JA      ONE
1161 /84      OLDLC2=LOC
1162 #84,    FLDA    LOC
1163         FSTA    OLDLC2
1164 /       GOTO 99
1165         JA      #99
1166
1167 /C
1168 /79      CALL RSPEAK(5)
1169 #79,    JSR     RSPEAK
1170         JA      .+4
1171         JA      #LIT+3
1172 /       K=52
1173         LDX     64,0    /52
1174         XTA     0
1175         FSTA    K
1176 /       GOTO 82
1177         JA      #82
1178
1179 /C DESCRIBE THE CURRENT LOCATION AND (MAYBE) GET NEXT COMMAND.
1180 /C
1181 /C PRINT TEXT FOR CURRENT LOC.
1182 /C
1183 /2000    IF(LOC.EQ.0)GOTO 99
1184 #2000,  FLDA    LOC
1185         JEQ     #99
1186 /       KK=STEXT(LOC)
1187         FLDA    LOC
1188         ATX     7
1189         FLDA    STEXT-3,7
1190         FSTA    KK
1191 /       KENT=0
1192         FCLA
1193         FSTA    KENT
1194 /       IF (ABBNUM.NE.0) KENT=MOD(ABB(LOC),ABBNUM)
1195         FLDA    ABBNUM
1196         JEQ     .+26
1197         FLDA    LOC
1198         ATX     7
1199         XTA     7
1200         FMUL    THREE
1201         ALN     0
1202         STARTD
1203         FADD    PABB
1204         FSTA    .+7
1205         STARTF
1206         JSR     MOD
1207         JA      .+6
1208         JA      .
1209         JA      ABBNUM
1210         FSTA    KENT
1211 /       IF (KENT.EQ.0.OR.KK.EQ.0) KK=LTEXT(LOC)
1212 NOMOD,  FLDA    KENT
1213         JEQ     .+6
1214         FLDA    KK
1215         JNE     .+11
1216         FLDA    LOC
1217         ATX     7
1218         FLDA    LTEXT-3,7
1219         FSTA    KK
1220 /       IF(FORCED(LOC).OR..NOT.DARK(0))GOTO 2001
1221         FLDA    LOC
1222         JSA     FORCED
1223         JNE     #2001
1224         JSA     DARK
1225         JEQ     #2001
1226 /       IF(WZDARK.AND.PCT(35))GOTO 90
1227         FLDA    WZDARK
1228         JEQ     .+12
1229         JSR     PCT
1230         JA      .+4
1231         JA      #LIT+66
1232         JNE     #90
1233 /       KK=RTEXT(16)
1234         FLDA    RTEXT+55
1235         FSTA    KK
1236
1237 /2001    IF(TOTING(BEAR))CALL RSPEAK(141)
1238 #2001,  FLDA    BEAR
1239         JSA     TOTING
1240         JEQ     .+10
1241         JSR     RSPEAK
1242         JA      .+4
1243         JA      #LIT+226
1244 /       CALL SPEAK(KK)
1245         JSR     SPEAK
1246         JA      .+4
1247         JA      KK
1248 /       K=1
1249         FLDA    ONE
1250         FSTA    K
1251 /       IF(FORCED(LOC))GOTO 8
1252         FLDA    LOC
1253         JSA     FORCED
1254         JNE     #8
1255 /       IF(LOC.EQ.33.AND.PCT(25).AND..NOT.CLOSNG)CALL RSPEAK(8)
1256         LDX     41,0    /33
1257         XTA     0
1258         FSUB    LOC
1259         JNE     .+24
1260         JSR     PCT
1261         JA      .+4
1262         JA      #LIT+52
1263         JEQ     .+14
1264         FLDA    CLOSNG
1265         JNE     .+10
1266         JSR     RSPEAK
1267         JA      .+4
1268         JA      #LIT+11
1269 /C
1270 /C PRINT OUT DESCRIPTIONS OF OBJECTS AT THIS LOCATION. IF NOT CLOSING AND
1271 /C PROPERTY VALUE IS NEGATIVE, TALLY OFF ANOTHER TREASURE. RUG IS SPECIAL
1272 /C CASE; ONCE SEEN, ITS PROP IS 1 (DRAGON ON IT) TILL DRAGON IS KILLED.
1273 /C SIMILARLY FOR CHAIN; PROP IS INITIALLY 1 (LOCKED TO BEAR). THESE HACKS
1274 /C ARE BECAUSE PROP=0 IS NEEDED TO GET FULL SCORE.
1275 /C
1276 /       IF(DARK(0))GOTO 2012
1277         JSA     DARK
1278         JNE     #2012
1279 /       ABB(LOC)=ABB(LOC)+1
1280         FLDA    LOC
1281         ATX     7
1282         FLDA    ABB-3,7
1283         FADD    ONE
1284         FSTA    ABB-3,7
1285 /       I=ATLOC(LOC)
1286         FLDA    ATLOC-3,7
1287         FSTA    I
1288
1289 /2004    IF(I.EQ.0)GOTO 2012
1290 #2004,  FLDA    I
1291         JEQ     #2012
1292 /       OBJ=I
1293         FSTA    OBJ
1294 /       IF(OBJ.GT.100)OBJ=OBJ-100
1295         FSUB    #LIT+154
1296         JLE     .+4
1297 /       FLDA    OBJ
1298 /       FSUB    #LIT+154
1299         FSTA    OBJ
1300 /       IF(OBJ.EQ.STEPS.AND.TOTING(NUGGET))GOTO 2008
1301         FLDA    OBJ
1302         FSUB    STEPS
1303         JNE     .+10
1304         FLDA    NUGGET
1305         JSA     TOTING
1306         JNE     #2008
1307 /       IF(PROP(OBJ).GE.0)GOTO 2006
1308         FLDA    OBJ
1309         ATX     7
1310         FLDA    PROP-3,7
1311         JGE     #2006
1312 /       IF(CLOSED)GOTO 2008
1313         FLDA    CLOSED
1314         JNE     #2008
1315 /       PROP(OBJ)=0
1316         FCLA
1317         FSTA    PROP-3,7
1318 /       IF(OBJ.EQ.RUG.OR.OBJ.EQ.CHAIN)PROP(OBJ)=1
1319         FLDA    OBJ
1320         FSUB    RUG
1321         JEQ     .+10
1322         FLDA    OBJ
1323         FSUB    CHAIN
1324         JNE     .+5
1325         FLDA    ONE
1326         FSTA    PROP-3,7
1327 /       TALLY=TALLY-1
1328         FLDA    TALLY
1329         FADD    MINUS1
1330         FSTA    TALLY
1331 /C IF REMAINING TREASURES TOO ELUSIVE, ZAP HIS LAMP.
1332 /       IF(TALLY.EQ.TALLY2.AND.TALLY.NE.0)LIMIT=MIN0(35,LIMIT)
1333         JEQ     #2006
1334         FSUB    TALLY2
1335         JNE     #2006
1336         JSR     MIN0
1337         JA      .+6
1338         JA      #LIT+66
1339         JA      LIMIT
1340         FSTA    LIMIT
1341 /2006    KK=PROP(OBJ)
1342 #2006,  FLDA    OBJ
1343         ATX     7
1344         FLDA    PROP-3,7
1345         FSTA    KK
1346 /       IF(OBJ.EQ.STEPS.AND.LOC.EQ.FIXED(STEPS))KK=1
1347         FLDA    OBJ
1348         FSUB    STEPS
1349         JNE     .+16
1350         FLDA    STEPS
1351         ATX     7
1352         FLDA    LOC
1353         FSUB    FIXED-3,7
1354         JNE     .+5
1355         FLDA    ONE
1356         FSTA    KK
1357 /       CALL PSPEAK(OBJ,KK)
1358         JSR     PSPEAK
1359         JA      .+6
1360         JA      OBJ
1361         JA      KK
1362
1363 /2008    I=LINK(I)
1364 #2008,  FLDA    I
1365         ATX     7
1366         FLDA    LINK-3,7
1367         FSTA    I
1368 /       GOTO 2004
1369         JA      #2004
1370
1371 /2009    K=54
1372 #2009,  FLDA    #LIT+113
1373         FSTA    K
1374 /2010    SPK=K
1375 #2010,  FLDA    K
1376         FSTA    SPK
1377
1378 /2011    CALL RSPEAK(SPK)
1379 #2011,  JSR     RSPEAK
1380         JA      .+4
1381         JA      SPK
1382
1383 /2012    VERB=0
1384 #2012,  FCLA
1385         FSTA    VERB
1386 /       OBJ=0
1387         FSTA    OBJ
1388
1389 /C
1390 /C CHECK IF THIS LOC IS ELIGIBLE FOR ANY HINTS. IF BEEN HERE LONG ENOUGH,
1391 /C BRANCH TO HELP SECTION (ON LATER PAGE). HINTS ALL COME BACK HERE EVENTUALLY
1392 /C TO FINISH THE LOOP. IGNORE "HINTS" < 4 (SPECIAL STUFF, SEE DATABASE NOTES).
1393 /C
1394 /2600    DO 2602 HINT=4,HNTMAX
1395 #2600,  FLDA    #LIT
1396         FSTA    HINT
1397
1398 /       IF(HINTED(HINT))GOTO 2602
1399 #G0102, FLDA    HINT
1400         ATX     7
1401         FLDA    HINTED-3,7
1402         JNE     #2602
1403 /       IF(.NOT.BITSET(LOC,HINT))HINTLC(HINT)=-1
1404         JSR     BITSET
1405         JA      .+6
1406         JA      LOC
1407         JA      HINT
1408         JNE     .+6
1409         FLDA    MINUS1
1410         FSTA    HINTLC-3,7
1411 /       HINTLC(HINT)=HINTLC(HINT)+1
1412         FLDA    ONE
1413         FADDM   HINTLC-3,7
1414 /       IF(HINTLC(HINT).GE.HINTS(HINT,1))GOTO 40000
1415         FLDA    #LIT+36
1416         FADD    HINT
1417         ATX     6
1418         FLDA    HINTLC-3,7
1419         FSUB    HINTS-0077,6
1420         JGE     #40000
1421
1422 /2602    CONTINUE
1423 #2602,  FLDA    HINT
1424         FADD    ONE
1425         FSTA    HINT
1426         FSUB    HNTMAX
1427         JLE     #G0102
1428 /C
1429 /C KICK THE RANDOM NUMBER GENERATOR JUST TO ADD VARIETY TO THE CHASE. ALSO,
1430 /C IF CLOSING TIME, CHECK FOR ANY OBJECTS BEING TOTED WITH PROP < 0 AND SET
1431 /C THE PROP TO -1-PROP. THIS WAY OBJECTS WON'T BE DESCRIBED UNTIL THEY'VE
1432 /C BEEN PICKED UP AND PUT DOWN SEPARATE FROM THEIR RESPECTIVE PILES. DON'T
1433 /C TICK CLOCK1 UNLESS WELL INTO CAVE (AND NOT AT Y2).
1434 /C
1435 /       IF(.NOT.CLOSED)GOTO 2605
1436         FLDA    CLOSED
1437         JEQ     #2605
1438 /       IF(PROP(OYSTER).LT.0.AND.TOTING(OYSTER))
1439 /       1       CALL PSPEAK(OYSTER,1)
1440
1441         FLDA    OYSTER
1442         ATX     7
1443         FLDA    PROP-3,7
1444         JGE     .+20
1445         FLDA    OYSTER
1446         JSA     TOTING
1447         JEQ     .+12
1448         JSR     PSPEAK
1449         JA      .+6
1450         JA      OYSTER
1451         JA      ONE
1452 /       DO 2604 I=1,100
1453         FLDA    ONE
1454         FSTA    I
1455
1456 /2604    IF(TOTING(I).AND.PROP(I).LT.0)PROP(I)=-1-PROP(I)
1457 #2604,  FLDA    I
1458         ATX     7
1459         JSA     TOTING
1460         JEQ     .+13
1461         FLDA    PROP-3,7
1462         JGE     .+7
1463         FLDA    MINUS1
1464         FSUB    PROP-3,7
1465         FSTA    PROP-3,7
1466         FLDA    I
1467         FADD    ONE
1468         FSTA    I
1469         FSUB    #LIT+154
1470         JLE     #2604
1471
1472 /2605    WZDARK=DARK(0)
1473 #2605,  JSA     DARK
1474         FSTA    WZDARK
1475 /       IF(KNFLOC.GT.0.AND.KNFLOC.NE.LOC)KNFLOC=0
1476         FLDA    KNFLOC
1477         JLE     .+11
1478         FSUB    LOC
1479         JEQ     .+5
1480         FCLA
1481         FSTA    KNFLOC
1482 /       I=RND(1)
1483         JSR     RND
1484         JA      .+4
1485         JA      ONE
1486 /       CALL GETIN(WD1,WD1X,WD2,WD2X)
1487         JSR     GETIN
1488         JA      .+12
1489         JA      WD1
1490         JA      WD1X
1491         JA      WD2
1492         JA      WD2X
1493
1494 /C
1495 /C EVERY INPUT, CHECK "FOOBAR" FLAG. IF ZERO, NOTHING'S GOING ON. IF POS,
1496 /C MAKE NEG. IF NEG, HE SKIPPED A WORD, SO MAKE IT ZERO.
1497 /C
1498 /2608    FOOBAR=MIN0(0,-FOOBAR)
1499 #2608,  FLDA    FOOBAR
1500         FNEG
1501         FSTA    #TMP
1502         JSR     MIN0
1503         JA      .+6
1504         JA      ZERO
1505         JA      #TMP
1506         FSTA    FOOBAR
1507 /       TURNS=TURNS+1
1508         FLDA    ONE
1509         FADDM   TURNS
1510 /C       IF(VERB.EQ.SAY.AND.WD2.NE.0)VERB=0
1511 /C       IF(VERB.EQ.SAY)GOTO 4090
1512 /       IF(TALLY.EQ.0.AND.LOC.GE.15.AND.LOC.NE.33)CLOCK1=CLOCK1-1
1513         FLDA    TALLY
1514         JNE     .+23
1515         FLDA    LOC
1516         FSUB    #LIT+25
1517         JLT     .+16
1518         LDX     41,0    /33
1519         XTA     0
1520         FSUB    LOC
1521         JEQ     .+7
1522         FLDA    CLOCK1
1523         FSUB    ONE
1524         FSTA    CLOCK1
1525 /       IF(CLOCK1.EQ.0)GOTO 10000
1526         FLDA    CLOCK1
1527         JEQ     #10000
1528 /       IF(CLOCK1.LT.0)CLOCK2=CLOCK2-1
1529         JGE     .+7
1530         FLDA    CLOCK2
1531         FSUB    ONE
1532         FSTA    CLOCK2
1533 /       IF(CLOCK2.EQ.0)GOTO 11000
1534         FLDA    CLOCK2
1535         JEQ     #11000
1536 /       IF(PROP(LAMP).EQ.1)LIMIT=LIMIT-1
1537         FLDA    LAMP
1538         ATX     7
1539         FLDA    PROP-3,7
1540         FSUB    ONE
1541         JNE     .+5
1542         FLDA    MINUS1
1543         FADDM   LIMIT
1544 /       IF(LIMIT.LE.30.AND.HERE(BATTER).AND.PROP(BATTER).EQ.0
1545 /       1       .AND.HERE(LAMP))GOTO 12000
1546         FLDA    LIMIT
1547         FSUB    #LIT+63
1548         JGT     .+25
1549         FLDA    BATTER
1550         JSA     HERE
1551         JEQ     .+17
1552         FLDA    BATTER
1553         ATX     7
1554         FLDA    PROP-3,7
1555         JNE     .+10
1556         FLDA    LAMP
1557         JSA     HERE
1558         JNE     #12000
1559 /       IF(LIMIT.EQ.0)GOTO 12400
1560         FLDA    LIMIT
1561         JEQ     #12400
1562 /       IF(LIMIT.LT.0.AND.LOC.LE.8)GOTO 12600
1563         FLDA    LIMIT
1564         JGE     .+7
1565         FLDA    LOC
1566         FSUB    #LIT+11
1567         JLE     #12600
1568 /       IF(LIMIT.LE.30)GOTO 12200
1569         FLDA    LIMIT
1570         FSUB    #LIT+63
1571         JLE     #12200
1572
1573 /19999   K=43
1574 #19999, LDX     53,0    /43
1575         XTA     0
1576         FSTA    K
1577 /       IF(LIQLOC(LOC).EQ.WATER)K=70
1578         JSA     LIQLOC
1579         FSUB    WATER
1580         JNE     .+7
1581         LDX     106,0   /70
1582         XTA     0
1583         FSTA    K
1584 /C
1585 /C DO PRELIMINARY ANALYSIS OF SENTENCE TO FIND CERTAIN SPECIAL
1586 /C CASES, VIZ,
1587 /C
1588 /C ENTER <WATER,STREAM>
1589 /C ENTER <LOCATION>
1590 /C <WATER,OIL> <PLANT,DOOR>
1591 /C
1592 /       CALL VOCAB(WD1,WD1A,-1,I)
1593         JSR     VOCAB
1594         JA      .+6
1595         JA      WD1
1596         JA      MINUS1
1597         FSTA    I
1598 /       CALL VOCAB(WD2,WD2A,-1,J)
1599         JSR     VOCAB
1600         JA      .+6
1601         JA      WD2
1602         JA      MINUS1
1603         FSTA    J
1604 /       IF(WD1.NE.'ENTE') GO TO 2609
1605         FLDA    WD1
1606         FSUB    TENTE
1607         JNE     #2609
1608 /       IF(J .EQ. (WATER+1000)
1609 /       1       .OR. J .EQ. STREAM) GO TO 2010
1610         FLDA    WATER
1611         FADD    #LIT+314
1612         FSUB    J
1613         JEQ     #2010
1614         FLDA    J
1615         FSUB    STREAM
1616         JEQ     #2010
1617 /       IF(WD2 .NE. 0) GO TO 2800
1618         FLDA    WD2
1619         JNE     #2800
1620
1621 /2609    IF((I .NE. (WATER+1000) .AND. I .NE. (OIL+1000))
1622 /       1       .OR. (J .NE. (PLANT+1000) .AND. J .NE. (DOOR+1000)))
1623 /       2       GO TO 2610
1624 #2609,  FLDA    WATER
1625         FADD    #LIT+314
1626         FSUB    I
1627         JEQ     .+11
1628         FLDA    OIL
1629         FADD    #LIT+314
1630         FSUB    I
1631         JNE     #2610
1632         FLDA    PLANT
1633         FADD    #LIT+314
1634         FSUB    J
1635         JEQ     .+11
1636         FLDA    DOOR
1637         FADD    #LIT+314
1638         FSUB    J
1639         JNE     #2610
1640 /       WD2="POUR"
1641         FLDA    TPOUR
1642         FSTA    WD2
1643
1644 /2610    IF(WD1 .EQ. 'WEST' .AND. PCT(10))
1645 /       1       CALL RSPEAK(17)
1646
1647 #2610,  FLDA    WD1
1648         FSUB    TWEST
1649         JNE     #2630
1650         JSR     PCT
1651         JA      .+4
1652         JA      #LIT+17
1653         JEQ     #2630
1654         JSR     RSPEAK
1655         JA      .+4
1656         JA      #LIT+33
1657 /2630    CALL VOCAB(WD1,-1,I)
1658 #2630,  JSR     VOCAB
1659         JA      .+6
1660         JA      WD1
1661         JA      MINUS1
1662         FSTA    I
1663 /       IF(I.EQ.-1)GOTO 3000
1664         FADD    ONE
1665         JEQ     #3000
1666 /       K=MOD(I,1000)
1667         JSR     MOD
1668         JA      .+6
1669         JA      I
1670         JA      #LIT+314
1671         FSTA    K
1672 /       KQ=I/1000+1
1673         FLDA    I
1674         FDIV    #LIT+314
1675         JSA     #FIX
1676         FADD    ONE
1677         FSTA    KQ
1678 /       GOTO (8,5000,4000,2010)KQ
1679         FLDA    KQ
1680         ATX     1
1681         STARTD
1682         FLDA    .+2,1
1683         STARTF
1684         JAC
1685         JA      #8
1686         JA      #5000
1687         JA      #4000
1688         JA      #2010
1689 /       CALL BUG(22)
1690         JSR     BUG
1691         JA      .+4
1692         JA      #LIT+41
1693
1694 /C
1695 /C GET SECOND WORD FOR ANALYSIS.
1696 /C
1697 /2800    WD1=WD2
1698 /       WD1A=WD2A
1699
1700 #2800,  FLDA    WD2
1701         FSTA    WD1
1702 /       WD1X=WD2X
1703         FLDA    WD2X
1704         FSTA    WD1X
1705 /       WD2=0
1706         FCLA
1707         FSTA    WD2
1708 /       GOTO 2610
1709         JA      #2610
1710
1711 /C
1712 /C GEE, I DON'T UNDERSTAND.
1713 /C
1714 /3000    SPK=60
1715 #3000,  LDX     74,0    /60
1716         XTA     0
1717         FSTA    SPK
1718 /       IF(PCT(20))SPK=61
1719         JSR     PCT
1720         JA      .+4
1721         JA      #LIT+36
1722         JEQ     .+6
1723         LDX     75,0    /61
1724         XTA     0
1725         FSTA    SPK
1726 /       IF(PCT(20))SPK=13
1727         JSR     PCT
1728         JA      .+4
1729         JA      #LIT+36
1730         JEQ     .+6
1731         LDX     15,0    /13
1732         XTA     0
1733         FSTA    SPK
1734 /       CALL RSPEAK(SPK)
1735         JSR     RSPEAK
1736         JA      .+4
1737         JA      SPK
1738 /       GOTO 2600
1739         JA      #2600
1740
1741 /C
1742 /C ANALYSE A VERB. REMEMBER WHAT IT WAS, GO BACK FOR OBJECT IF SECOND WORD
1743 /C UNLESS VERB IS "SAY", WHICH SNARFS ARBITRARY SECOND WORD.
1744 /C
1745 /4000    VERB=K
1746 #4000,  FLDA    K
1747         FSTA    VERB
1748 /       SPK=ACTSPK(VERB)
1749         ATX     7
1750         FLDA    ACTSPK-3,7
1751         FSTA    SPK
1752 /       IF(WD2.NE.0.AND.VERB.NE.SAY)GOTO 2800
1753         FLDA    WD2
1754         JEQ     .+10
1755         FLDA    VERB
1756         FSUB    SAY
1757         JNE     #2800
1758 /       IF(VERB.EQ.SAY)OBJ=WD2
1759         FLDA    VERB
1760         FSUB    SAY
1761         JNE     .+5
1762         FLDA    WD2
1763         FSTA    OBJ
1764 /       IF(OBJ.NE.0)GOTO 4090
1765         FLDA    OBJ
1766         FSUB    ZERO
1767         JNE     #4090
1768
1769 /C
1770 /C ANALYSE AN INTRANSITIVE VERB (IE, NO OBJECT GIVEN YET).
1771 /C
1772 /4080    GOTO(8010,8000,8000,8040,2009,8040,9070,9080,8000,8000,
1773 /       1    2011,9120,9130,8140,9150,8000,8000,8180,8000,8200,
1774 /       2    8000,9220,9230,8240,8250,8260,8270,8000,8000,8300,
1775 /       3    8310,8320)VERB
1776 /C            TAKE DROP  SAY OPEN NOTH LOCK   ON  OFF WAVE CALM
1777 /C            WALK KILL POUR  EAT DRNK  RUB TOSS QUIT FIND INVN
1778 /C            FEED FILL BLST SCOR  FOO  BRF READ BREK WAKE SUSP
1779 /C            HOUR RESU
1780 #4080,  FLDA    VERB
1781         ATX     1
1782         STARTD
1783         FLDA    .+2,1
1784         STARTF
1785         JAC
1786         JA      #8010
1787         JA      #8000
1788         JA      #8000
1789         JA      #8040
1790         JA      #2009
1791         JA      #8040
1792         JA      #9070
1793         JA      #9080
1794         JA      #8000
1795         JA      #8000
1796         JA      #2011
1797         JA      #9120
1798         JA      #9130
1799         JA      #8140
1800         JA      #9150
1801         JA      #8000
1802         JA      #8000
1803         JA      #8180
1804         JA      #8000
1805         JA      #8200
1806         JA      #8000
1807         JA      #9220
1808         JA      #9230
1809         JA      #8240
1810         JA      #8250
1811         JA      #8260
1812         JA      #8270
1813         JA      #8000
1814         JA      #8000
1815         JA      #8300
1816         JA      #8310
1817         JA      #8320
1818 /       CALL BUG(23)
1819         JSR     BUG
1820         JA      .+4
1821         JA      #LIT+44
1822
1823 /C
1824 /C ANALYSE A TRANSITIVE VERB.
1825 /C
1826 /4090    GOTO(9010,9020,9030,9040,2009,9040,9070,9080,9090,2011,
1827 /       1    2011,9120,9130,9140,9150,9160,9170,2011,9190,9190,
1828 /       2    9210,9220,9230,2011,2011,2011,9270,9280,9290,2011,
1829 /       3    2011,2011)VERB
1830 /C            TAKE DROP  SAY OPEN NOTH LOCK   ON  OFF WAVE CALM
1831 /C            WALK KILL POUR  EAT DRNK  RUB TOSS QUIT FIND INVN
1832 /C            FEED FILL BLST SCOR  FOO  BRF READ BREK WAKE SUSP
1833 /C            HOUR RESU
1834 #4090,  FLDA    VERB
1835         ATX     1
1836         STARTD
1837         FLDA    .+2,1
1838         STARTF
1839         JAC
1840         JA      #9010
1841         JA      #9020
1842         JA      #9030
1843         JA      #9040
1844         JA      #2009
1845         JA      #9040
1846         JA      #9070
1847         JA      #9080
1848         JA      #9090
1849         JA      #2011
1850         JA      #2011
1851         JA      #9120
1852         JA      #9130
1853         JA      #9140
1854         JA      #9150
1855         JA      #9160
1856         JA      #9170
1857         JA      #2011
1858         JA      #9190
1859         JA      #9190
1860         JA      #9210
1861         JA      #9220
1862         JA      #9230
1863         JA      #2011
1864         JA      #2011
1865         JA      #2011
1866         JA      #9270
1867         JA      #9280
1868         JA      #9290
1869         JA      #2011
1870         JA      #2011
1871         JA      #2011
1872         JA      #2011
1873 /       CALL BUG(24)
1874         JSR     BUG
1875         JA      .+4
1876         JA      #LIT+47
1877
1878 /C
1879 /C ANALYSE AN OBJECT WORD. SEE IF THE THING IS HERE, WHETHER WE'VE GOT A VERB
1880 /C YET, AND SO ON. OBJECT MUST BE HERE UNLESS VERB IS "FIND" OR "INVENT(ORY)"
1881 /C (AND NO NEW VERB YET TO BE ANALYSED). WATER AND OIL ARE ALSO FUNNY, SINCE
1882 /C THEY ARE NEVER ACTUALLY DROPPED AT ANY LOCATION, BUT MIGHT BE HERE INSIDE
1883 /C THE BOTTLE OR AS A FEATURE OF THE LOCATION.
1884 /C
1885 /5000    OBJ=K
1886 #5000,  FLDA    K
1887         FSTA    OBJ
1888 /       IF(FIXED(K).NE.LOC.AND..NOT.HERE(K))GOTO 5100
1889         FLDA    K
1890         ATX     7
1891         FLDA    FIXED-3,7
1892         FSUB    LOC
1893         JEQ     #5010
1894         FLDA    K
1895         JSA     HERE
1896         JEQ     #5100
1897
1898 /5010    IF(WD2.NE.0)GOTO 2800
1899 #5010,  FLDA    WD2
1900         JNE     #2800
1901 /       IF(VERB.NE.0)GOTO 4090
1902         FLDA    VERB
1903         JNE     #4090
1904 /       TYPE 5015
1905 /5015    FORMAT(' What do you want to do with the ',$)
1906         JSR     SIXOUT
1907         JA      .+10
1908         JA      #5015
1909         JA      ZERO
1910         JA      TWO
1911
1912 /       CALL A5TOA1(WD1,WD1A,WD1X,'?')
1913         JSR     A5TOA1
1914         JA      .+10
1915         JA      WD1
1916         JA      WD1X
1917         JA      TQUES
1918         TRAP3   #WRITO
1919         JA      #LIT
1920         JA      #LINEF+2
1921         TRAP3   #RENDO
1922 /       GOTO 2600
1923 #LINEF, JA      #2600
1924         TEXT    +(' ')+
1925
1926 /C
1927 /5100    IF(K.NE.GRATE)GOTO 5110
1928 #5100,  FLDA    K
1929         FSUB    GRATE
1930         JNE     #5110
1931 /       IF(LOC.EQ.1.OR.LOC.EQ.4.OR.LOC.EQ.7)K=DPRSSN
1932         FLDA    LOC
1933         FSUB    ONE
1934         JEQ     .+10
1935         FSUB    THREE
1936         JEQ     .+5
1937         FSUB    THREE
1938         JNE     .+6
1939         FLDA    DPRSSN
1940         FSTA    K
1941 /       IF(LOC.GT.9.AND.LOC.LT.15)K=ENTRNC
1942         FLDA    LOC
1943         FSUB    #LIT+14
1944         JLE     .+13
1945         FLDA    LOC
1946         FSUB    #LIT+25
1947         JGE     .+6
1948         FLDA    ENTRNC
1949         FSTA    K
1950 /       IF(K.NE.GRATE)GOTO 8
1951         FLDA    K
1952         FSUB    GRATE
1953         JNE     #8
1954
1955 /5110    IF(K.NE.DWARF)GOTO 5120
1956 #5110,  FLDA    K
1957         FSUB    DWARF
1958         JNE     #5120
1959 /       DO 5112 I=1,5
1960         FLDA    ONE
1961         FSTA    I
1962
1963 /       IF(DLOC(I).EQ.LOC.AND.DFLAG.GE.2)GOTO 5010
1964 #G0122, FLDA    I
1965         ATX     7
1966         FLDA    DLOC-3,7
1967         FSUB    LOC
1968         JNE     #5112
1969         FLDA    DFLAG
1970         FSUB    TWO
1971         JGE     #5010
1972 /5112    CONTINUE
1973 #5112,  FLDA    I
1974         FADD    ONE
1975         FSTA    I
1976         FSUB    #LIT+3
1977         JLE     #G0122
1978
1979 /5120    IF((LIQ(0).EQ.K.AND.HERE(BOTTLE)).OR.K.EQ.LIQLOC(LOC))GOTO 5010
1980 #5120,  JSA     LIQ
1981         FSUB    K
1982         JNE     .+10
1983         FLDA    BOTTLE
1984         JSA     HERE
1985         JNE     #5010
1986         JSA     LIQLOC
1987         FSUB    K
1988         JEQ     #5010
1989 /       IF(OBJ.NE.PLANT.OR..NOT.AT(PLANT2).OR.PROP(PLANT2).EQ.0)GOTO 5130
1990         FLDA    OBJ
1991         FSUB    PLANT
1992         JNE     #5130
1993         FLDA    PLANT2
1994         JSA     AT
1995         JEQ     #5130
1996         FLDA    PLANT2
1997         ATX     7
1998         FLDA    PROP-3,7
1999         JEQ     #5130
2000 /       OBJ=PLANT2
2001         FLDA    PLANT2
2002         FSTA    OBJ
2003 /       GOTO 5010
2004         JA      #5010
2005
2006 /5130    IF(OBJ.NE.KNIFE.OR.KNFLOC.NE.LOC)GOTO 5140
2007 #5130,  FLDA    OBJ
2008         FSUB    KNIFE
2009         JNE     #5140
2010         FLDA    KNFLOC
2011         FSUB    LOC
2012         JNE     #5140
2013 /       KNFLOC=-1
2014         FLDA    MINUS1
2015         FSTA    KNFLOC
2016 /       SPK=116
2017         FLDA    #LIT+170
2018         FSTA    SPK
2019 /       GOTO 2011
2020         JA      #2011
2021
2022 /5140    IF(OBJ.NE.ROD.OR..NOT.HERE(ROD2))GOTO 5190
2023 #5140,  FLDA    OBJ
2024         FSUB    ROD
2025         JNE     #5190
2026         FLDA    ROD2
2027         JSA     HERE
2028         JEQ     #5190
2029 /       OBJ=ROD2
2030         FLDA    ROD2
2031         FSTA    OBJ
2032 /       GOTO 5010
2033         JA      #5010
2034
2035 /5190    IF((VERB.EQ.FIND.OR.VERB.EQ.INVENT).AND.WD2.EQ.0)GOTO 5010
2036 #5190,  FLDA    VERB
2037         FSUB    INVENT
2038         JEQ     .+10
2039         FLDA    VERB
2040         FSUB    FIND
2041         JNE     .+5
2042         FLDA    WD2
2043         JEQ     #5010
2044 /       TYPE 5199
2045         JSR     SIXOUT
2046         JA      .+10
2047         JA      #5199
2048         JA      ZERO
2049         JA      TWO
2050
2051 /5199    FORMAT(' I don''t see any ',$)
2052
2053 /       CALL A5TOA1(WD1,WD1A,WD1X,'.')
2054 /       GOTO 2012
2055         JSR     A5TOA1
2056         JA      #2012
2057         JA      WD1
2058         JA      WD1X
2059         JA      TQDOT
2060
2061 /C FIGURE OUT THE NEW LOCATION
2062 /C
2063 /C GIVEN THE CURRENT LOCATION IN "LOC", AND A MOTION VERB NUMBER IN "K", PUT
2064 /C THE NEW LOCATION IN "NEWLOC". THE CURRENT LOC IS SAVED IN "OLDLOC" IN CASE
2065 /C HE WANTS TO RETREAT. THE CURRENT OLDLOC IS SAVED IN OLDLC2, IN CASE HE
2066 /C DIES. (IF HE DOES, NEWLOC WILL BE LIMBO, AND OLDLOC WILL BE WHAT KILLED
2067 /C HIM, SO WE NEED OLDLC2, WHICH IS THE LAST PLACE HE WAS SAFE.)
2068 /C
2069 /8       KK=KEY(LOC)
2070 #8,     FLDA    LOC
2071         ATX     7
2072         FLDA    KEY-3,7
2073         FSTA    KK
2074 /       NEWLOC=LOC
2075         FLDA    LOC
2076         FSTA    NEWLOC
2077 /       IF(KK.EQ.0)CALL BUG(26)
2078         FLDA    KK
2079         JNE     .+10
2080         JSR     BUG
2081         JA      .+4
2082         JA      #LIT+55
2083 /       IF(K.EQ.NULL)GOTO 2
2084         FLDA    K
2085         FSUB    NULL
2086         JEQ     #2
2087 /       IF(K.EQ.BACK)GOTO 20
2088         FLDA    K
2089         FSUB    BACK
2090         JEQ     #20
2091 /       IF(K.EQ.LOOK)GOTO 30
2092         FLDA    K
2093         FSUB    LOOK
2094         JEQ     #30
2095 /       IF(K.EQ.CAVE)GOTO 40
2096         FLDA    K
2097         FSUB    CAVE
2098         JEQ     #40
2099 /       OLDLC2=OLDLOC
2100         FLDA    OLDLOC
2101         FSTA    OLDLC2
2102 /       OLDLOC=LOC
2103         FLDA    LOC
2104         FSTA    OLDLOC
2105 /C
2106 /9       LL=IABS(TRAVEL(KK))
2107 #9,     JSR     GETWRD
2108         JA      .+10
2109         JA      TRAVEL
2110         JA      KK
2111         JA      ZERO
2112         FSTA    #TMP
2113         JSR     IABS
2114         JA      .+4
2115         JA      #TMP
2116         FSTA    LL
2117 /       IF(LL.EQ.1 .OR. LL.EQ.K)GOTO 10
2118         FSUB    ONE
2119         JEQ     #10
2120         FLDA    LL
2121         FSUB    K
2122         JEQ     #10
2123 /       IF(TRAVEL(KK).LT.0)GOTO 50
2124         JSR     GETWRD
2125         JA      .+10
2126         JA      TRAVEL
2127         JA      KK
2128         JA      ZERO
2129         JLT     #50
2130 /       KK=KK+1
2131         FLDA    ONE
2132         FADDM   KK
2133 /       GOTO 9
2134         JA      #9
2135
2136 /C
2137 /10      NEWLOC=TRVCON(KK)
2138 #10,    JSR     GETWRD
2139         JA      .+10
2140         JA      TRVCON
2141         JA      KK
2142         JA      ZERO
2143         FSTA    NEWLOC
2144 /       K=MOD(NEWLOC,100)
2145         JSR     MOD
2146         JA      .+6
2147         JA      NEWLOC
2148         JA      #LIT+154
2149         FSTA    K
2150 /       IF(NEWLOC.LE.300)GOTO 13
2151         FLDA    NEWLOC
2152         FSUB    #LIT+306
2153         JLE     #13
2154 /       IF(PROP(K).NE.NEWLOC/100-3)GOTO 16
2155         FLDA    K
2156         ATX     7
2157         FLDA    NEWLOC
2158         FDIV    #LIT+154
2159         JSA     #FIX
2160         FSUB    THREE
2161         FSUB    PROP-3,7
2162         JNE     #16
2163 /C
2164 /C TRY NEXT ENTRY IN TRAVEL TABLE
2165 /C
2166 /12      IF(TRAVEL(KK).LT.0)CALL BUG(25)
2167 #12,    JSR     GETWRD
2168         JA      .+10
2169         JA      TRAVEL
2170         JA      KK
2171         JA      ZERO
2172         JGE     .+10
2173         JSR     BUG
2174         JA      .+4
2175         JA      #LIT+52
2176 /       KK=KK+1
2177         FLDA    KK
2178         FSTA    #TMP
2179         FADD    ONE
2180         FSTA    KK
2181
2182 /C MAKE SURE HE DOESN'T GO THROUGH SAME TEST AGAIN
2183 /C
2184 /       IF(TRVCON(KK-1).EQ.TRVCON(KK) .AND. TRVLOC(KK-1).EQ.TRVLOC(KK))
2185 /       1       GOTO 12
2186         JSR     GETWRD
2187         JA      .+10
2188         JA      TRVCON
2189         JA      #TMP
2190         JA      ZERO
2191         FSTA    #TMP+3
2192         JSR     GETWRD
2193         JA      .+10
2194         JA      TRVCON
2195         JA      KK
2196         JA      ZERO
2197         FSUB    #TMP+3
2198         JNE     #10
2199
2200         JSR     GETWRD
2201         JA      .+10
2202         JA      TRVLOC
2203         JA      #TMP
2204         JA      ZERO
2205         FSTA    #TMP+3
2206
2207         JSR     GETWRD
2208         JA      .+10
2209         JA      TRVLOC
2210         JA      #TMP
2211         FSUB    #TMP+3
2212         JEQ     #12
2213 /       GO TO 10
2214         JA      #10
2215 /C
2216 /13      IF(NEWLOC.LE.100)GOTO 14
2217 #13,    FLDA    NEWLOC
2218         FSUB    #LIT+154
2219         JLE     #14
2220 /       IF(TOTING(K).OR.(NEWLOC.GT.200.AND.AT(K)))GOTO 16
2221         FLDA    K
2222         JSA     TOTING
2223         JNE     #16
2224         LDX     310,0   /200
2225         XTA     0
2226         FSUB    NEWLOC
2227         JGT     #12
2228         FLDA    K
2229         JSA     AT
2230         JNE     #16
2231 /       GOTO 12
2232         JA      #12
2233
2234 /C
2235 /14      IF(NEWLOC.NE.0.AND..NOT.PCT(NEWLOC))GOTO 12
2236 #14,    FLDA    NEWLOC
2237         JEQ     #16
2238         JSR     PCT
2239         JA      .+4
2240         JA      NEWLOC
2241         JEQ     #12
2242
2243 /16      NEWLOC=TRVLOC(KK)
2244 #16,    JSR     GETWRD
2245         JA      .+10
2246         JA      TRVLOC
2247         JA      KK
2248         JA      ZERO
2249         FSTA    NEWLOC
2250 /       IF(NEWLOC.LE.300)GOTO 2
2251         FSUB    #LIT+306
2252         JLE     #2
2253 /       IF(NEWLOC.LE.500)GOTO 30000
2254         FLDA    NEWLOC
2255         FSUB    #LIT+311
2256         JLE     #30000
2257 /       CALL RSPEAK(NEWLOC-500)
2258 /       FLDA    NEWLOC
2259 /       FSUB    #LIT+311
2260         FSTA    #TMP
2261         JSR     RSPEAK
2262         JA      .+4
2263         JA      #TMP
2264 /       NEWLOC=LOC
2265         FLDA    LOC
2266         FSTA    NEWLOC
2267 /       GOTO 2
2268         JA      #2
2269
2270 /C
2271 /C SPECIAL MOTIONS COME HERE. LABELLING CONVENTION: STATEMENT NUMBERS NNNXX
2272 /C (XX=00-99) ARE USED FOR SPECIAL CASE NUMBER NNN (NNN=301-500).
2273 /C
2274 /30000   NEWLOC=NEWLOC-300
2275 #30000, FLDA    NEWLOC
2276         FSUB    #LIT+306
2277         FSTA    NEWLOC
2278 /       GOTO (30100,30200,30300)NEWLOC
2279 /       FLDA    NEWLOC
2280         ATX     1
2281         STARTD
2282         FLDA    .+2,1
2283         STARTF
2284         JAC
2285         JA      #30100
2286         JA      #30200
2287         JA      #30300
2288 /       CALL BUG(20)
2289         JSR     BUG
2290         JA      .+4
2291         JA      #LIT+36
2292
2293 /C
2294 /C TRAVEL 301. PLOVER-ALCOVE PASSAGE. CAN CARRY ONLY EMERALD. NOTE: TRAVEL
2295 /C TABLE MUST INCLUDE "USELESS" ENTRIES GOING THROUGH PASSAGE, WHICH CAN NEVER
2296 /C BE USED FOR ACTUAL MOTION, BUT CAN BE SPOTTED BY "GO BACK".
2297 /C
2298 /30100   NEWLOC=99+100-LOC
2299 #30100, FLDA    #LIT+300        /199
2300         FSUB    LOC
2301         FSTA    NEWLOC
2302 /       IF(HOLDNG.EQ.0.OR.(HOLDNG.EQ.1.AND.TOTING(EMRALD)))GOTO 2
2303         FLDA    HOLDNG
2304         JEQ     #2
2305         FSUB    ONE
2306         JNE     #M27
2307         FLDA    EMRALD
2308         JSA     TOTING
2309         JNE     #2
2310 /       NEWLOC=LOC
2311 #M27,   FLDA    LOC
2312         FSTA    NEWLOC
2313 /       CALL RSPEAK(117)
2314 /       GOTO 2
2315         JSR     RSPEAK
2316         JA      #2
2317         JA      #LIT+173
2318
2319 /C
2320 /C TRAVEL 302. PLOVER TRANSPORT. DROP THE EMERALD (ONLY USE SPECIAL TRAVEL IF
2321 /C TOTING IT), SO HE'S FORCED TO USE THE PLOVER-PASSAGE TO GET IT OUT. HAVING
2322 /C DROPPED IT, GO BACK AND PRETEND HE WASN'T CARRYING IT AFTER ALL.
2323 /C
2324 /30200   CALL DROP(EMRALD,LOC)
2325 /GOTO 12
2326 #30200, JSR     DROP
2327         JA      #12
2328         JA      EMRALD
2329         JA      LOC
2330
2331 /C
2332 /C TRAVEL 303. TROLL BRIDGE. MUST BE DONE ONLY AS SPECIAL MOTION SO THAT
2333 /C DWARVES WON'T WANDER ACROSS AND ENCOUNTER THE BEAR. (THEY WON'T FOLLOW THE
2334 /C PLAYER THERE BECAUSE THAT REGION IS FORBIDDEN TO THE PIRATE.) IF
2335 /C PROP(TROLL)=1, HE'S CROSSED SINCE PAYING, SO STEP OUT AND BLOCK HIM.
2336 /C (STANDARD TRAVEL ENTRIES CHECK FOR PROP(TROLL)=0.) SPECIAL STUFF FOR BEAR.
2337 /C
2338 /30300   IF(PROP(TROLL).NE.1)GOTO 30310
2339 #30300, FLDA    TROLL
2340         ATX     7
2341         FLDA    PROP-3,7
2342         FSUB    ONE
2343         JNE     #30310
2344 /       CALL PSPEAK(TROLL,1)
2345         JSR     PSPEAK
2346         JA      .+6
2347         JA      TROLL
2348         JA      ONE
2349 /       PROP(TROLL)=0
2350         FCLA
2351         FSTA    PROP-3,7
2352 /       CALL MOVE(TROLL2,0)
2353         JSR     MOVE
2354         JA      .+6
2355         JA      TROLL2
2356         JA      ZERO
2357 /       CALL MOVE(TROLL2+100,0)
2358         FLDA    TROLL2
2359         FADD    #LIT+154
2360         FSTA    #TMP
2361         JSR     MOVE
2362         JA      .+6
2363         JA      #TMP
2364         JA      ZERO
2365 /       CALL MOVE(TROLL,PLAC(TROLL))
2366         FLDA    TROLL
2367         ATX     7
2368         XTA     7
2369         FMUL    THREE
2370         ALN     0
2371         STARTD
2372         FADD    PPLAC
2373         FSTA    .+11
2374         STARTF
2375         JSR     MOVE
2376         JA      .+6
2377         JA      TROLL
2378         JA      .
2379 /       CALL MOVE(TROLL+100,FIXD(TROLL))
2380         FLDA    TROLL
2381         FADD    #LIT+154
2382         FSTA    #TMP
2383         FLDA    TROLL
2384         ATX     7
2385         XTA     7
2386         FMUL    THREE
2387         ALN     0
2388         STARTD
2389         FADD    PFIXD
2390         FSTA    .+11
2391         STARTF
2392         JSR     MOVE
2393         JA      .+6
2394         JA      #TMP
2395         JA      .
2396 /       CALL JUGGLE(CHASM)
2397         JSR     JUGGLE
2398         JA      .+4
2399         JA      CHASM
2400 /       NEWLOC=LOC
2401         FLDA    LOC
2402         FSTA    NEWLOC
2403 /       GOTO 2
2404         JA      #2
2405
2406 /C
2407 /30310   NEWLOC=PLAC(TROLL)+FIXD(TROLL)-LOC
2408 #30310, FLDA    TROLL
2409         ATX     7
2410         FLDA    PLAC-3,7
2411         FADD    FIXD-3,7
2412         FSUB    LOC
2413         FSTA    NEWLOC
2414 /       IF(PROP(TROLL).EQ.0)PROP(TROLL)=1
2415         FLDA    PROP-3,7
2416         JNE     .+5
2417         FLDA    ONE
2418         FSTA    PROP-3,7
2419 /       IF(.NOT.TOTING(BEAR))GOTO 2
2420         FLDA    BEAR
2421         JSA     TOTING
2422         JEQ     #2
2423 /       CALL RSPEAK(162)
2424         JSR     RSPEAK
2425         JA      .+4
2426         JA      #LIT+237
2427 /       PROP(CHASM)=1
2428         FLDA    CHASM
2429         ATX     7
2430         FLDA    ONE
2431 /       PROP(TROLL)=2
2432         FSTA    PROP-3,7
2433         FLDA    TROLL
2434         ATX     7
2435         FLDA    TWO
2436         FSTA    PROP-3,7
2437 /       CALL DROP(BEAR,NEWLOC)
2438         JSR     DROP
2439         JA      .+6
2440         JA      BEAR
2441         JA      NEWLOC
2442 /       FIXED(BEAR)=-1
2443         FLDA    BEAR
2444         ATX     7
2445         FLDA    MINUS1
2446         FSTA    FIXED-3,7
2447 /       PROP(BEAR)=3
2448         FLDA    THREE
2449         FSTA    PROP-3,7
2450 /       IF(PROP(SPICES).LT.0)TALLY2=TALLY2+1
2451         FLDA    SPICES
2452         ATX     7
2453         FLDA    PROP-3,7
2454         JGE     .+7
2455         FLDA    TALLY2
2456         FADD    ONE
2457         FSTA    TALLY2
2458 /       OLDLC2=NEWLOC
2459         FLDA    NEWLOC
2460         FSTA    OLDLC2
2461 /       GOTO 99
2462         JA      #99
2463
2464 /C
2465 /C END OF SPECIALS.
2466 /C
2467 /C HANDLE "GO BACK". LOOK FOR VERB WHICH GOES FROM LOC TO OLDLOC, OR TO OLDLC2
2468 /C IF OLDLOC HAS FORCED-MOTION. K2 SAVES ENTRY -> FORCED LOC -> PREVIOUS LOC.
2469 /C
2470 /20      K=OLDLOC
2471 #20,    FLDA    OLDLOC
2472         FSTA    K
2473 /       IF(FORCED(K))K=OLDLC2
2474 /       FLDA    K
2475         JSA     FORCED
2476         JEQ     .+6
2477         FLDA    OLDLC2
2478         FSTA    K
2479 /       OLDLC2=OLDLOC
2480         FLDA    OLDLOC
2481         FSTA    OLDLC2
2482 /       OLDLOC=LOC
2483         FLDA    LOC
2484         FSTA    OLDLOC
2485 /       K2=0
2486         FCLA
2487         FSTA    K2
2488 /       IF(K.NE.LOC)GOTO 21
2489         FLDA    K
2490         FSUB    LOC
2491         JNE     #21
2492 /       CALL RSPEAK(91)
2493 /       GOTO 2
2494         JSR     RSPEAK
2495         JA      #2
2496         JA      #LIT+140
2497
2498 /C
2499 /21      LL=TRVLOC(KK)
2500 #21,    JSR     GETWRD
2501         JA      .+10
2502         JA      TRVLOC
2503         JA      KK
2504         JA      ZERO
2505         FSTA    LL
2506 /       IF(LL.EQ.K)GOTO 25
2507         FSUB    K
2508         JEQ     #25
2509 /       IF(LL.GT.300)GOTO 22
2510         FLDA    LL
2511         FSUB    #LIT+306
2512         JGT     #22
2513 /       J=KEY(LL)
2514         FLDA    LL
2515         ATX     7
2516         FLDA    KEY-3,7
2517         FSTA    J
2518 /       IF(FORCED(LL).AND.TRVLOC(KK).EQ.K)K2=KK
2519         FLDA    LL
2520         JSA     FORCED
2521         JEQ     #22
2522         JSR     GETWRD
2523         JA      .+10
2524         JA      TRVLOC
2525         JA      KK
2526         JA      ZERO
2527         FSUB    K
2528         JNE     #22
2529         FLDA    KK
2530         FSTA    K2
2531 /22      IF(TRAVEL(KK).LT.0)GOTO 23
2532 #22,    JSR     GETWRD
2533         JA      .+10
2534         JA      TRAVEL
2535         JA      KK
2536         JA      ZERO
2537         JLT     #23
2538 /       KK=KK+1
2539         FLDA    ONE
2540         FADDM   KK
2541 /       GOTO 21
2542         JA      #21
2543
2544 /C
2545 /23      KK=K2
2546 #23,    FLDA    K2
2547         FSTA    KK
2548 /       IF(KK.NE.0)GOTO 25
2549         JNE     #25
2550 /       CALL RSPEAK(140)
2551 /       GOTO 2
2552         JSR     RSPEAK
2553         JA      #2
2554         JA      #LIT+223
2555
2556 /C
2557 /25      K=IABS(TRAVEL(KK))
2558 #25,    JSR     GETWRD
2559         JA      .+10
2560         JA      TRAVEL
2561         JA      KK
2562         JA      ZERO
2563         FSTA    #TMP
2564         JSR     IABS
2565         JA      .+4
2566         JA      #TMP
2567         FSTA    K
2568 /       KK=KEY(LOC)
2569         FLDA    LOC
2570         ATX     7
2571         FLDA    KEY-3,7
2572         FSTA    KK
2573 /       GOTO 9
2574         JA      #9
2575
2576 /C
2577 /C LOOK. CAN'T GIVE MORE DETAIL. PRETEND IT WASN'T DARK (THOUGH IT MAY "NOW"
2578 /C BE DARK) SO HE WON'T FALL INTO A PIT WHILE STARING INTO THE GLOOM.
2579 /C
2580 /30      IF(DETAIL.LT.3)CALL RSPEAK(15)
2581 #30,    FLDA    DETAIL
2582         FSUB    THREE
2583         JGE     .+10
2584         JSR     RSPEAK
2585         JA      .+4
2586         JA      #LIT+25
2587 /       DETAIL=DETAIL+1
2588         FLDA    ONE
2589         FADDM   DETAIL
2590 /       WZDARK=.FALSE.
2591         FCLA
2592         FSTA    WZDARK
2593 /       ABB(LOC)=0
2594         FLDA    LOC
2595         ATX     7
2596         FCLA
2597         FSTA    ABB-3,7
2598 /       GOTO 2
2599         JA      #2
2600
2601 /C
2602 /C CAVE. DIFFERENT MESSAGES DEPENDING ON WHETHER ABOVE GROUND.
2603 /C
2604 /40      IF(LOC.LT.8)CALL RSPEAK(57)
2605 #40,    FLDA    LOC
2606         FSUB    #LIT+11
2607         JGE     .+10
2608         JSR     RSPEAK
2609         JA      #2
2610         JA      #LIT+116
2611 /       IF(LOC.GE.8)CALL RSPEAK(58)
2612 /       GOTO 2
2613         JSR     RSPEAK
2614         JA      #2
2615         JA      #LIT+121
2616
2617 /C
2618 /C NON-APPLICABLE MOTION. VARIOUS MESSAGES DEPENDING ON WORD GIVEN.
2619 /C
2620 /50      SPK=12
2621 #50,    FLDA    #LIT+22
2622         FSTA    SPK
2623 /       IF(K.GE.43.AND.K.LE.50)SPK=9
2624         LDX     53,0    /43
2625         XTA     0
2626         FSUB    K
2627         JGE     .+7
2628         FLDA    K
2629         FSUB    #LIT+110
2630         JLE     #M31
2631 /       IF(K.EQ.29.OR.K.EQ.30)SPK=9
2632         LDX     35,0    /29
2633         XTA     0
2634         FSUB    K
2635         JEQ     #M31
2636         FADD    ONE
2637         JEQ     #M31
2638         JA      #M33
2639 #M31,   FLDA    #LIT+14
2640         FSTA    SPK
2641         JA      #M32
2642 /       IF(K.EQ.7.OR.K.EQ.36.OR.K.EQ.37)SPK=10
2643         LDX     7,0
2644         XTA     0
2645         FSUB    K
2646         JEQ     #M34
2647         LDX     44,0
2648         XTA     0
2649         FSUB    K
2650         JEQ     #M34
2651         FADD    ONE
2652         JNE     #M35
2653 #M34,   FLDA    #LIT+17
2654         FSTA    SPK
2655         JA      #M32
2656 /       IF(K.EQ.11.OR.K.EQ.19)SPK=11
2657 #M35,   LDX     13,0    /11
2658         XTA     0
2659         FSUB    K
2660         JEQ     #M36
2661         LDX     23,0    /19
2662         XTA     0
2663         FSUB    K
2664         JNE     #M32
2665 #M36,   LDX     13,0
2666         XTA     0
2667         FSTA    SPK
2668 /       IF(VERB.EQ.FIND.OR.VERB.EQ.INVENT)SPK=59
2669 #M32,   FLDA    VERB
2670         FSUB    INVENT
2671         JEQ     #M37
2672         FLDA    VERB
2673         FSUB    FIND
2674         JNE     #M38
2675 #M37,   LDX     73,0    /59
2676         XTA     0
2677         FSTA    SPK
2678 /       IF(K.EQ.62.OR.K.EQ.65)SPK=42
2679 #M38,   FLDA    K
2680         FSUB    #LIT+124
2681         JEQ     #M39
2682         FSUB    THREE
2683         JNE     #M40
2684 #M39,   LDX     52,0    /42
2685         XTA     0
2686         FSTA    SPK
2687 /       IF(K.EQ.17)SPK=80
2688 #M40,   FLDA    K
2689         FSUB    #LIT+33
2690         JNE     #M33
2691         LDX     120,0   /80
2692         XTA     0
2693         FSTA    SPK
2694 /       CALL RSPEAK(SPK)
2695 /       GOTO 2
2696 #M33,   JSR     RSPEAK
2697         JA      #2
2698         JA      SPK
2699
2700 /C "YOU'RE DEAD, JIM."
2701 /C
2702 /C IF THE CURRENT LOC IS ZERO, IT MEANS THE CLOWN GOT HIMSELF KILLED. WE'LL
2703 /C ALLOW THIS MAXDIE TIMES. MAXDIE IS AUTOMATICALLY SET BASED ON THE NUMBER OF
2704 /C SNIDE MESSAGES AVAILABLE. EACH DEATH RESULTS IN A MESSAGE (81, 83, ETC.)
2705 /C WHICH OFFERS REINCARNATION; IF ACCEPTED, THIS RESULTS IN MESSAGE 82, 84,
2706 /C ETC. THE LAST TIME, IF HE WANTS ANOTHER CHANCE, HE GETS A SNIDE REMARK AS
2707 /C WE EXIT. WHEN REINCARNATED, ALL OBJECTS BEING CARRIED GET DROPPED AT OLDLC2
2708 /C (PRESUMABLY THE LAST PLACE PRIOR TO BEING KILLED) WITHOUT CHANGE OF PROPS.
2709 /C THE LOOP RUNS BACKWARDS TO ASSURE THAT THE BIRD IS DROPPED BEFORE THE CAGE.
2710 /C (THIS KLUGE COULD BE CHANGED ONCE WE'RE SURE ALL REFERENCES TO BIRD AND CAGE
2711 /C ARE DONE BY KEYWORDS.) THE LAMP IS A SPECIAL CASE (IT WOULDN'T DO TO LEAVE
2712 /C IT IN THE CAVE). IT IS TURNED OFF AND LEFT OUTSIDE THE BUILDING (ONLY IF HE
2713 /C WAS CARRYING IT, OF COURSE). HE HIMSELF IS LEFT INSIDE THE BUILDING (AND
2714 /C HEAVEN HELP HIM IF HE TRIES TO XYZZY BACK INTO THE CAVE WITHOUT THE LAMP!).
2715 /C OLDLOC IS ZAPPED SO HE CAN'T JUST "RETREAT".
2716 /C
2717 /C THE EASIEST WAY TO GET KILLED IS TO FALL INTO A PIT IN PITCH DARKNESS.
2718 /C
2719 /90      CALL RSPEAK(23)
2720 #90,    JSR     RSPEAK
2721         JA      .+4
2722         JA      #LIT+44
2723 /       OLDLC2=LOC
2724         FLDA    LOC
2725         FSTA    OLDLC2
2726 /C
2727 /C OKAY, HE'S DEAD. LET'S GET ON WITH IT.
2728 /C
2729 /99      IF(CLOSNG)GOTO 95
2730 #99,    FLDA    CLOSNG
2731         JNE     #95
2732 /       YEA=YES(81+NUMDIE*2,82+NUMDIE*2,54)
2733         FLDA    NUMDIE
2734         FADD    NUMDIE
2735         FADD    #LIT+132
2736         FSTA    #TMP
2737         FLDA    #TMP
2738         FADD    ONE
2739         FSTA    #TMP+3
2740         JSR     YES
2741         JA      .+10
2742         JA      #TMP
2743         JA      #TMP+3
2744         JA      #LIT+113
2745         FSTA    YEA
2746 /       NUMDIE=NUMDIE+1
2747         FLDA    NUMDIE
2748         FADD    ONE
2749         FSTA    NUMDIE
2750 /       IF(NUMDIE.EQ.MAXDIE.OR..NOT.YEA)GOTO 20000
2751         FSUB    MAXDIE
2752         JEQ     #20000
2753         FLDA    YEA
2754         JEQ     #20000
2755 /       PLACE(WATER)=0
2756         FLDA    WATER
2757         ATX     7
2758         FCLA
2759         FSTA    PLACE-3,7
2760 /       PLACE(OIL)=0
2761         FLDA    OIL
2762         ATX     7
2763         FCLA
2764         FSTA    PLACE-3,7
2765 /       IF(TOTING(LAMP))PROP(LAMP)=0
2766         FLDA    LAMP
2767         JSA     TOTING
2768         JEQ     .+10
2769         FLDA    LAMP
2770         ATX     7
2771         FCLA
2772         FSTA    PROP-3,7
2773 /       DO 98 J=1,100
2774         FLDA    ONE
2775         FSTA    J
2776
2777 /       I=101-J
2778 #G0150, LDX     145,0   /101
2779         XTA     0
2780         FSUB    J
2781         FSTA    I
2782 /       IF(.NOT.TOTING(I))GOTO 98
2783         JSA     TOTING
2784         JEQ     #98
2785 /       K=OLDLC2
2786         FLDA    OLDLC2
2787         FSTA    K
2788 /       IF(I.EQ.LAMP)K=1
2789         FLDA    I
2790         FSUB    LAMP
2791         JNE     .+5
2792         FLDA    ONE
2793         FSTA    K
2794 /       CALL DROP(I,K)
2795         JSR     DROP
2796         JA      .+6
2797         JA      I
2798         JA      K
2799
2800 /98      CONTINUE
2801 #98,    FLDA    J
2802         FADD    ONE
2803         FSTA    J
2804         FSUB    #LIT+154
2805         JLE     #G0150
2806 /       LOC=3
2807         FLDA    THREE
2808 /       OLDLOC=LOC
2809         FSTA    LOC
2810         FSTA    OLDLOC
2811 /       GOTO 2000
2812         JA      #2000
2813
2814 /C
2815 /C HE DIED DURING CLOSING TIME. NO RESURRECTION. TALLY UP A DEATH AND EXIT.
2816 /C
2817 /95      CALL RSPEAK(131)
2818 #95,    JSR     RSPEAK
2819         JA      .+4
2820         JA      #LIT+212
2821 /       NUMDIE=NUMDIE+1
2822         FLDA    ONE
2823         FADDM   NUMDIE
2824 /       GOTO 20000
2825         JA      #20000
2826
2827 /C ROUTINES FOR PERFORMING THE VARIOUS ACTION VERBS
2828 /C
2829 /C STATEMENT NUMBERS IN THIS SECTION ARE 8000 FOR INTRANSITIVE VERBS, 9000 FOR
2830 /C TRANSITIVE, PLUS TEN TIMES THE VERB NUMBER. MANY INTRANSITIVE VERBS USE THE
2831 /C TRANSITIVE CODE, AND SOME VERBS USE CODE FOR OTHER VERBS, AS NOTED BELOW.
2832 /C
2833 /C RANDOM INTRANSITIVE VERBS COME HERE. CLEAR OBJ JUST IN CASE (SEE "ATTACK").
2834 /C
2835 /8000    TYPE 8002
2836 #8000,  JSR     SIXOUT
2837         JA      .+10
2838         JA      #8002
2839         JA      ZERO
2840         JA      TWO
2841
2842 /8002    FORMAT(' I don''t understand "',$)
2843 /       CALL A5TOA1(WD1,WD1A,WD1X,'".')
2844         JSR     A5TOA1
2845         JA      .+10
2846         JA      WD1
2847         JA      WD1X
2848         JA      TQDOT
2849 /       OBJ=0
2850         FCLA
2851         FSTA    OBJ
2852         TRAP3   #WRITO
2853         JA      #LIT
2854         JA      #LINEF+2
2855         TRAP3   #RENDO
2856 /       GOTO 2600
2857         JA      #2600
2858
2859 /C
2860 /C CARRY, NO OBJECT GIVEN YET. OK IF ONLY ONE OBJECT PRESENT.
2861 /C
2862 /8010    IF(ATLOC(LOC).EQ.0.OR.LINK(ATLOC(LOC)).NE.0)GOTO 8000
2863 #8010,  FLDA    LOC
2864         ATX     7
2865         FLDA    ATLOC-3,7
2866         JEQ     #8000
2867         ATX     6
2868         FLDA    LINK-3,6
2869         JNE     #8000
2870 /       DO 8012 I=1,5
2871         FLDA    ONE
2872         FSTA    I
2873
2874 /       IF(DLOC(I).EQ.LOC.AND.DFLAG.GE.2)GOTO 8000
2875 #G0152, FLDA    I
2876         ATX     7
2877         FLDA    DLOC-3,7
2878         FSUB    LOC
2879         JNE     #8012
2880         FLDA    DFLAG
2881         FSUB    TWO
2882         JGE     #8000
2883
2884 /8012    CONTINUE
2885 #8012,  FLDA    I
2886         FADD    ONE
2887         FSTA    I
2888         FSUB    #LIT+3
2889         JLE     #G0152
2890 /       OBJ=ATLOC(LOC)
2891         FLDA    LOC
2892         ATX     7
2893         FLDA    ATLOC-3,7
2894         FSTA    OBJ
2895
2896 /C
2897 /C CARRY AN OBJECT. SPECIAL CASES FOR BIRD AND CAGE (IF BIRD IN CAGE, CAN'T
2898 /C TAKE ONE WITHOUT THE OTHER. LIQUIDS ALSO SPECIAL, SINCE THEY DEPEND ON
2899 /C STATUS OF BOTTLE. ALSO VARIOUS SIDE EFFECTS, ETC.
2900 /C
2901 /9010    IF(TOTING(OBJ))GOTO 2011
2902 #9010,  FLDA    OBJ
2903         JSA     TOTING
2904         JNE     #2011
2905 /       SPK=25
2906         FLDA    #LIT+52
2907         FSTA    SPK
2908 /       IF(OBJ.EQ.PLANT.AND.PROP(PLANT).LE.0)SPK=115
2909         FLDA    OBJ
2910         FSUB    PLANT
2911         JNE     .+13
2912         FLDA    PLANT
2913         ATX     7
2914         FLDA    PROP-3,7
2915         JGT     .+4
2916         FLDA    #LIT+165
2917         FSTA    SPK
2918 /       IF(OBJ.EQ.BEAR.AND.PROP(BEAR).EQ.1)SPK=169
2919         FLDA    OBJ
2920         FSUB    BEAR
2921         JNE     .+16
2922         FLDA    BEAR
2923         ATX     7
2924         FLDA    PROP-3,7
2925         FSUB    ONE
2926         JNE     .+6
2927         LDX     251,0   /169
2928         XTA     0
2929         FSTA    SPK
2930 /       IF(OBJ.EQ.CHAIN.AND.PROP(BEAR).NE.0)SPK=170
2931         FLDA    OBJ
2932         FSUB    CHAIN
2933         JNE     .+15
2934         FLDA    BEAR
2935         ATX     7
2936         FLDA    PROP-3,7
2937         JEQ     .+6
2938         LDX     252,0   /170
2939         XTA     0
2940         FSTA    SPK
2941 /       IF(FIXED(OBJ).NE.0)GOTO 2011
2942         FLDA    OBJ
2943         ATX     7
2944         FLDA    FIXED-3,7
2945         JNE     #2011
2946 /       IF(OBJ.NE.WATER.AND.OBJ.NE.OIL)GOTO 9017
2947         FLDA    OBJ
2948         FSUB    WATER
2949         JEQ     .+10
2950         FLDA    OBJ
2951         FSUB    OIL
2952         JNE     #9017
2953 /       IF(HERE(BOTTLE).AND.LIQ(0).EQ.OBJ)GOTO 9018
2954         FLDA    BOTTLE
2955         JSA     HERE
2956         JEQ     .+10
2957         JSA     LIQ
2958         FSUB    OBJ
2959         JEQ     #9018
2960 /       OBJ=BOTTLE
2961         FLDA    BOTTLE
2962         FSTA    OBJ
2963 /       IF(TOTING(BOTTLE).AND.PROP(BOTTLE).EQ.1)GOTO 9220
2964         FLDA    BOTTLE
2965         JSA     TOTING
2966         JEQ     #M222
2967         FLDA    BOTTLE
2968         ATX     7
2969         FLDA    PROP-3,7
2970         FSUB    ONE
2971         JEQ     #9220
2972
2973 /       IF(PROP(BOTTLE).NE.1)SPK=105
2974 #M222,  FLDA    BOTTLE
2975         ATX     7
2976         FLDA    PROP-3,7
2977         FSUB    ONE
2978         JEQ     .+4
2979         FLDA    #LIT+157
2980         FSTA    SPK
2981 /       IF(.NOT.TOTING(BOTTLE))SPK=104
2982         FLDA    BOTTLE
2983         JSA     TOTING
2984         JNE     #2011
2985         LDX     150,0   / 104
2986         XTA     0
2987         FSTA    SPK
2988 /       GOTO 2011
2989         JA      #2011
2990
2991 /9018    OBJ=BOTTLE
2992 #9018,  FLDA    BOTTLE
2993         FSTA    OBJ
2994
2995 /9017    IF(HOLDNG.LT.7)GOTO 9016
2996 #9017,  LDX     7,0
2997         XTA     0
2998         FSUB    HOLDNG
2999         JGE     #9016
3000 /       CALL RSPEAK(92)
3001         JSR     RSPEAK
3002         JA      #2012
3003         JA      #LIT+143
3004 /       GOTO 2012
3005
3006 /9016    IF(OBJ.NE.BIRD)GOTO 9014
3007 #9016,  FLDA    OBJ
3008         FSUB    BIRD
3009         JNE     #9014
3010 /       IF(PROP(BIRD).NE.0)GOTO 9014
3011         FLDA    BIRD
3012         ATX     7
3013         FLDA    PROP-3,7
3014         JNE     #9014
3015 /       IF(.NOT.TOTING(ROD))GOTO 9013
3016         FLDA    ROD
3017         JSA     TOTING
3018         JEQ     #9013
3019 /       CALL RSPEAK(26)
3020         JSR     RSPEAK
3021         JA      #2012
3022         JA      #LIT+55
3023 /       GOTO 2012
3024
3025 /9013    IF(TOTING(CAGE))GOTO 9015
3026 #9013,  FLDA    CAGE
3027         JSA     TOTING
3028         JNE     #9015
3029 /       CALL RSPEAK(27)
3030         JSR     RSPEAK
3031         JA      #2012
3032         JA      #LIT+60
3033 /       GOTO 2012
3034
3035 /9015    PROP(BIRD)=1
3036 #9015,  FLDA    BIRD
3037         ATX     7
3038         FLDA    ONE
3039         FSTA    PROP-3,7
3040
3041 /9014    IF((OBJ.EQ.BIRD.OR.OBJ.EQ.CAGE).AND.PROP(BIRD).NE.0)
3042 /       1       CALL CARRY(BIRD+CAGE-OBJ,LOC)
3043 #9014,  FLDA    OBJ
3044         FSUB    BIRD
3045         JEQ     .+10
3046         FLDA    OBJ
3047         FSUB    CAGE
3048         JNE     .+30
3049         FLDA    BIRD
3050         ATX     7
3051         FLDA    PROP-3,7
3052         JEQ     .+21
3053         FLDA    BIRD
3054         FADD    CAGE
3055         FSUB    OBJ
3056         FSTA    #TMP
3057         JSR     CARRY
3058         JA      .+6
3059         JA      #TMP
3060         JA      LOC
3061 /       CALL CARRY(OBJ,LOC)
3062         JSR     CARRY
3063         JA      .+6
3064         JA      OBJ
3065         JA      LOC
3066 /       K=LIQ(0)
3067         JSA     LIQ
3068         FSTA    K
3069 /       IF(OBJ.EQ.BOTTLE.AND.K.NE.0)PLACE(K)=-1
3070         FLDA    OBJ
3071         FSUB    BOTTLE
3072         JNE     #2009A
3073         FLDA    K
3074         JEQ     #2009A
3075         ATX     7
3076         FLDA    MINUS1
3077         FSTA    PLACE-3,7
3078 /       GOTO 2009
3079 #2009A, FLDA    #LIT+135        /RHM - "Taken" message
3080         FSTA    K
3081         JA      #2010
3082
3083 /C
3084 /C DISCARD OBJECT. "THROW" ALSO COMES HERE FOR MOST OBJECTS. SPECIAL CASES FOR
3085 /C BIRD (MIGHT ATTACK SNAKE OR DRAGON) AND CAGE (MIGHT CONTAIN BIRD) AND VASE.
3086 /C DROP COINS AT VENDING MACHINE FOR EXTRA BATTERIES.
3087 /C
3088 /9020    IF(TOTING(ROD2).AND.OBJ.EQ.ROD.AND..NOT.TOTING(ROD))OBJ=ROD2
3089 #9020,  FLDA    ROD2
3090         JSA     TOTING
3091         JEQ     .+22
3092         FLDA    OBJ
3093         FSUB    ROD
3094         JNE     .+14
3095         FLDA    ROD
3096         JSA     TOTING
3097         JNE     .+6
3098         FLDA    ROD2
3099         FSTA    OBJ
3100 /       IF(.NOT.TOTING(OBJ))GOTO 2011
3101         FLDA    OBJ
3102         JSA     TOTING
3103         JEQ     #2011
3104 /       IF(OBJ.NE.BIRD.OR..NOT.HERE(SNAKE))GOTO 9024
3105         FLDA    OBJ
3106         FSUB    BIRD
3107         JNE     #9024
3108         FLDA    SNAKE
3109         JSA     HERE
3110         JEQ     #9024
3111 /       CALL RSPEAK(30)
3112         JSR     RSPEAK
3113         JA      .+4
3114         JA      #LIT+63
3115 /       IF(CLOSED)GOTO 19000
3116         FLDA    CLOSED
3117         JNE     #19000
3118 /       CALL DSTROY(SNAKE)
3119         JSR     DSTROY
3120         JA      .+4
3121         JA      SNAKE
3122 /C
3123 /C SET PROP FOR USE BY TRAVEL OPTIONS
3124 /C
3125 /       PROP(SNAKE)=1
3126         FLDA    SNAKE
3127         ATX     7
3128         FLDA    ONE
3129         FSTA    PROP-3,7
3130
3131 /9021    K=LIQ(0)
3132 #9021,  JSA     LIQ
3133         FSTA    K
3134 /       IF(K.EQ.OBJ)OBJ=BOTTLE
3135         FSUB    OBJ
3136         JNE     .+6
3137         FLDA    BOTTLE
3138         FSTA    OBJ
3139 /       IF(OBJ.EQ.BOTTLE.AND.K.NE.0)PLACE(K)=0
3140         FLDA    OBJ
3141         FSUB    BOTTLE
3142         JNE     .+12
3143         FLDA    K
3144         JEQ     .+6
3145         ATX     7
3146         FCLA
3147         FSTA    PLACE-3,7
3148 /       IF(OBJ.EQ.CAGE.AND.PROP(BIRD).NE.0)CALL DROP(BIRD,LOC)
3149         FLDA    OBJ
3150         FSUB    CAGE
3151         JNE     .+21
3152         FLDA    BIRD
3153         ATX     7
3154         FLDA    PROP-3,7
3155         JEQ     .+12
3156         JSR     DROP
3157         JA      .+6
3158         JA      BIRD
3159         JA      LOC
3160 /       IF(OBJ.EQ.BIRD)PROP(BIRD)=0
3161         FLDA    OBJ
3162         FSUB    BIRD
3163         JNE     .+10
3164         FLDA    BIRD
3165         ATX     7
3166         FCLA
3167         FSTA    PROP-3,7
3168 /       CALL DROP(OBJ,LOC)
3169         JSR     DROP
3170 /       GO TO 2012
3171         JA      #2012
3172 /
3173         JA      OBJ
3174         JA      LOC
3175
3176 /C
3177 /9024    IF(OBJ.NE.COINS.OR..NOT.HERE(VEND))GOTO 9025
3178 #9024,  FLDA    OBJ
3179         FSUB    COINS
3180         JNE     #9025
3181         FLDA    VEND
3182         JSA     HERE
3183         JEQ     #9025
3184 /       CALL DSTROY(COINS)
3185         JSR     DSTROY
3186         JA      .+4
3187         JA      COINS
3188 /       CALL DROP(BATTER,LOC)
3189         JSR     DROP
3190         JA      .+6
3191         JA      BATTER
3192         JA      LOC
3193 /       CALL PSPEAK(BATTER,0)
3194         JSR     PSPEAK
3195         JA      .+6
3196         JA      BATTER
3197         JA      ZERO
3198 /       GOTO 2012
3199         JA      #2012
3200
3201 \f/C
3202 /9025    IF(OBJ.NE.BIRD.OR..NOT.AT(DRAGON).OR.PROP(DRAGON).NE.0)GOTO 9026
3203 #9025,  FLDA    OBJ
3204         FSUB    BIRD
3205         JNE     #9026
3206         FLDA    DRAGON
3207         JSA     AT
3208         JEQ     #9026
3209         FLDA    DRAGON
3210         ATX     7
3211         FLDA    PROP-3,7
3212         JNE     #9026
3213 /       CALL RSPEAK(154)
3214         JSR     RSPEAK
3215         JA      .+4
3216         JA      #LIT+374
3217 /       CALL DSTROY(BIRD)
3218         JSR     DSTROY
3219         JA      .+4
3220         JA      BIRD
3221 /       PROP(BIRD)=0
3222         FLDA    BIRD
3223         ATX     7
3224         FCLA
3225         FSTA    PROP-3,7
3226 /       IF(PLACE(SNAKE).EQ.PLAC(SNAKE))TALLY2=TALLY2+1
3227         FLDA    SNAKE
3228         ATX     7
3229         FLDA    PLACE-3,7
3230         FSUB    PLAC-3,7
3231         JNE     #2012
3232         FLDA    TALLY2
3233         FADD    ONE
3234         FSTA    TALLY2
3235 /       GOTO 2012
3236         JA      #2012
3237
3238 /C
3239 /9026    IF(OBJ.NE.BEAR.OR..NOT.AT(TROLL))GOTO 9027
3240 #9026,  FLDA    OBJ
3241         FSUB    BEAR
3242         JNE     #9027
3243         FLDA    TROLL
3244         JSA     AT
3245         JEQ     #9027
3246 /       CALL RSPEAK(163)
3247         JSR     RSPEAK
3248         JA      .+4
3249         JA      #LIT+242
3250 /       CALL MOVE(TROLL,0)
3251         JSR     MOVE
3252         JA      .+6
3253         JA      TROLL
3254         JA      ZERO
3255 /       CALL MOVE(TROLL+100,0)
3256         FLDA    TROLL
3257         FADD    #LIT+154
3258         FSTA    #TMP
3259         JSR     MOVE
3260         JA      .+6
3261         JA      #TMP
3262         JA      ZERO
3263 /       CALL MOVE(TROLL2,PLAC(TROLL))
3264         FLDA    TROLL
3265         ATX     7
3266         XTA     7
3267         FMUL    THREE
3268         ALN     0
3269         STARTD
3270         FADD    PPLAC
3271         FSTA    .+11
3272         STARTF
3273         JSR     MOVE
3274         JA      .+6
3275         JA      TROLL2
3276         JA      .
3277 /       CALL MOVE(TROLL2+100,FIXD(TROLL))
3278         FLDA    TROLL2
3279         FADD    #LIT+154
3280         FSTA    #TMP
3281         FLDA    TROLL
3282         ATX     7
3283         XTA     7
3284         FMUL    THREE
3285         ALN     0
3286         STARTD
3287         FADD    PFIXD
3288         FSTA    .+11
3289         STARTF
3290         JSR     MOVE
3291         JA      .+6
3292         JA      #TMP
3293         JA      .
3294 /       CALL JUGGLE(CHASM)
3295         JSR     JUGGLE
3296         JA      .+4
3297         JA      CHASM
3298         FLDA    TROLL
3299         ATX     7
3300 /       PROP(TROLL)=2
3301         FLDA    TWO
3302         FSTA    PROP-3,7
3303 /       GOTO 9021
3304         JA      #9021
3305
3306 /C
3307 /9027    IF(OBJ.EQ.VASE.AND.LOC.NE.PLAC(PILLOW))GOTO 9028
3308 #9027,  FLDA    OBJ
3309         FSUB    VASE
3310         JNE     .+13
3311         FLDA    PILLOW
3312         ATX     7
3313         FLDA    LOC
3314         FSUB    PLAC-3,7
3315         JNE     #9028
3316 /       CALL RSPEAK(54)
3317         JSR     RSPEAK
3318         JA      #9021
3319         JA      #LIT+113
3320 /       GOTO 9021
3321
3322 /C
3323 /9028    PROP(VASE)=2
3324 #9028,  FLDA    VASE
3325         ATX     7
3326         FLDA    TWO
3327         FSTA    PROP-3,7
3328 /       IF(AT(PILLOW))PROP(VASE)=0
3329         FLDA    PILLOW
3330         JSA     AT
3331         JEQ     .+10
3332         FLDA    VASE
3333         ATX     7
3334         FCLA
3335         FSTA    PROP-3,7
3336 /       CALL PSPEAK(VASE,PROP(VASE)+1)
3337         FLDA    VASE
3338         ATX     7
3339         FLDA    PROP-3,7
3340         FADD    ONE
3341         FSTA    #TMP
3342         JSR     PSPEAK
3343         JA      .+6
3344         JA      VASE
3345         JA      #TMP
3346 /       IF(PROP(VASE).NE.0)FIXED(VASE)=-1
3347         FLDA    VASE
3348         ATX     7
3349         FLDA    PROP-3,7
3350         JEQ     #9021
3351         FLDA    MINUS1
3352         FSTA    FIXED-3,7
3353 /       GOTO 9021
3354         JA      #9021
3355
3356 /C
3357 /C SAY. ECHO WD2 (OR WD1 IF NO WD2 (SAY WHAT?, ETC.).) MAGIC WORDS OVERRIDE.
3358 /C
3359 /9030    IF(WD2.EQ.0)GOTO 9031
3360 #9030,  FLDA    WD2
3361         JEQ     #9031
3362 /       WD1=WD2 WD1A=WD2A
3363         FLDA    WD2
3364         FSTA    WD1
3365 /       WD1X=WD2X
3366         FLDA    WD2X
3367         FSTA    WD1X
3368
3369 /9031    CALL VOCAB(WD1,WD1A,-1,I)
3370 #9031,  JSR     VOCAB
3371         JA      .+6
3372         JA      WD1
3373         JA      MINUS1
3374         FSTA    I
3375 /       IF(I.EQ.62.OR.I.EQ.65.OR.I.EQ.71.OR.I.EQ.2025)GOTO 9035
3376         FSUB    #LIT+124
3377         JEQ     #9035
3378         FSUB    THREE
3379         JEQ     #9035
3380         FSUB    #LIT+3
3381         JEQ     #9035
3382         LDX     3751,0  /2025
3383         XTA     0
3384         FSUB    I
3385         JEQ     #9035
3386 /       TYPE 9032
3387         JSR     SIXOUT
3388         JA      .+10
3389         JA      #9032
3390         JA      ZERO
3391         JA      TWO
3392 /9032    FORMAT(' Okay, "',$)
3393 /       CALL A5TOA1(WD1,WD1A,WD1X,'".')
3394         JSR     A5TOA1
3395         JA      #2012
3396         JA      WD1
3397         JA      WD1X
3398         JA      TQDOT
3399 /       GOTO 2012
3400
3401 /C
3402 /9035    WD2=0
3403 #9035,  FCLA
3404         FSTA    WD2
3405 /       OBJ=0
3406         FSTA    OBJ
3407 /       GOTO 2630
3408         JA      #2630
3409
3410 /C
3411 /C LOCK, UNLOCK, NO OBJECT GIVEN. ASSUME VARIOUS THINGS IF PRESENT.
3412 /C
3413 /8040    SPK=28
3414 #8040,  LDX     34,0    /28
3415         XTA     0
3416         FSTA    SPK
3417 /       IF(HERE(CLAM))OBJ=CLAM
3418         FLDA    CLAM
3419         JSA     HERE
3420         JEQ     .+6
3421         FLDA    CLAM
3422         FSTA    OBJ
3423 /       IF(HERE(OYSTER))OBJ=OYSTER
3424         FLDA    OYSTER
3425         JSA     HERE
3426         JEQ     .+6
3427         FLDA    OYSTER
3428         FSTA    OBJ
3429 /       IF(AT(DOOR))OBJ=DOOR
3430         FLDA    DOOR
3431         JSA     AT
3432         JEQ     .+6
3433         FLDA    DOOR
3434         FSTA    OBJ
3435 /       IF(AT(GRATE))OBJ=GRATE
3436         FLDA    GRATE
3437         JSA     AT
3438         JEQ     .+6
3439         FLDA    GRATE
3440         FSTA    OBJ
3441 /       IF(OBJ.NE.0.AND.HERE(CHAIN))GOTO 8000
3442         FLDA    OBJ
3443         JEQ     .+10
3444         FLDA    CHAIN
3445         JSA     HERE
3446         JNE     #8000
3447 /       IF(HERE(CHAIN))OBJ=CHAIN
3448         FLDA    CHAIN
3449         JSA     HERE
3450         JEQ     .+6
3451         FLDA    CHAIN
3452         FSTA    OBJ
3453 /       IF(OBJ.EQ.0)GOTO 2011
3454         FLDA    OBJ
3455         JEQ     #2011
3456
3457 /C
3458 /C LOCK, UNLOCK OBJECT. SPECIAL STUFF FOR OPENING CLAM/OYSTER AND FOR CHAIN.
3459 /C
3460 /9040    IF(OBJ.EQ.CLAM.OR.OBJ.EQ.OYSTER)GOTO 9046
3461 #9040,  FLDA    OBJ
3462         FSUB    CLAM
3463         JEQ     #9046
3464         FLDA    OBJ
3465         FSUB    OYSTER
3466         JEQ     #9046
3467 /       IF(OBJ.EQ.DOOR)SPK=111
3468         FLDA    OBJ
3469         FSUB    DOOR
3470         JNE     #9040A
3471         LDX     157,0   /111
3472         XTA     0
3473         FSTA    SPK
3474 /       IF(OBJ.EQ.DOOR.AND.PROP(DOOR).EQ.1)SPK=54
3475 #9040A, FLDA    OBJ
3476         FSUB    DOOR
3477         JNE     .+16
3478         FLDA    DOOR
3479         ATX     7
3480         FLDA    PROP-3,7
3481         FSUB    ONE
3482         JEQ     .+6
3483         LDX     74,0    /60
3484         XTA     0
3485         FSTA    SPK
3486 /       IF(OBJ.EQ.CAGE)SPK=32
3487         FLDA    OBJ
3488         FSUB    CAGE
3489         JNE     .+6
3490         LDX     40,0    /32
3491         XTA     0
3492         FSTA    SPK
3493 /       IF(OBJ.EQ.KEYS)SPK=55
3494         FLDA    OBJ
3495         FSUB    KEYS
3496         JNE     .+6
3497         LDX     67,0    /55
3498         XTA     0
3499         FSTA    SPK
3500 /       IF(OBJ.EQ.GRATE.OR.OBJ.EQ.CHAIN)SPK=31
3501         FLDA    OBJ
3502         FSUB    GRATE
3503         JEQ     .+10
3504         FLDA    OBJ
3505         FSUB    CHAIN
3506         JNE     .+6
3507         LDX     37,0    /31
3508         XTA     0
3509         FSTA    SPK
3510 /       IF(SPK.NE.31.OR..NOT.HERE(KEYS))GOTO 2011
3511         LDX     37,0    /31
3512         XTA     0
3513         FSUB    SPK
3514         JNE     #2011
3515         FLDA    KEYS
3516         JSA     HERE
3517         JEQ     #2011
3518 /       IF(OBJ.EQ.CHAIN)GOTO 9048
3519         FLDA    OBJ
3520         FSUB    CHAIN
3521         JEQ     #9048
3522 /       IF(.NOT.CLOSNG)GOTO 9043
3523         FLDA    CLOSNG
3524         JEQ     #9043
3525 /       K=130
3526         FLDA    #LIT+207
3527         FSTA    K
3528 /       IF(.NOT.PANIC)CLOCK2=15
3529         FLDA    PANIC
3530         JNE     .+5
3531         FLDA    #LIT+25
3532         FSTA    CLOCK2
3533 /       PANIC=.TRUE.
3534         FLDA    ONE
3535         FSTA    PANIC
3536 /       GOTO 2010
3537         JA      #2010
3538
3539 /C
3540 /9043    K=34+PROP(GRATE)
3541 #9043,  FLDA    GRATE
3542         ATX     7
3543         LDX     42,0    /34
3544         XTA     0
3545         FADD    PROP-3,7
3546         FSTA    K
3547 /       IF(VERB.EQ.LOCK)PROP(GRATE)=0
3548         FLDA    GRATE
3549         ATX     7
3550         FLDA    ONE
3551         FSTA    PROP-3,7
3552         FLDA    VERB
3553         FSUB    LOCK
3554         JNE     .+10
3555         FLDA    GRATE
3556         ATX     7
3557         FCLA
3558         FSTA    PROP-3,7
3559 /       K=K+2*PROP(GRATE)
3560         FLDA    GRATE
3561         ATX     7
3562         FLDA    TWO
3563         FMUL    PROP-3,7
3564         FADD    K
3565         FSTA    K
3566 /       GOTO 2010
3567         JA      #2010
3568
3569 /C
3570 /C CLAM/OYSTER.
3571 /C
3572 /9046    K=0
3573 #9046,  FCLA
3574         FSTA    K
3575 /       IF(OBJ.EQ.OYSTER)K=1
3576         FLDA    OBJ
3577         FSUB    OYSTER
3578         JNE     .+5
3579         FLDA    ONE
3580         FSTA    K
3581 /       SPK=124+K
3582         LDX     174,0
3583         XTA     0
3584         FADD    K
3585         FSTA    SPK
3586 /       IF(TOTING(OBJ))SPK=120+K
3587         FLDA    OBJ
3588         JSA     TOTING
3589         JEQ     #9046A
3590         LDX     170,0   /120
3591         XTA     0
3592         FADD    K
3593         FSTA    SPK
3594 /       IF(.NOT.TOTING(TRIDNT))SPK=122+K
3595 #9046A, FLDA    TRIDNT
3596         JSA     TOTING
3597         JNE     .+10
3598         LDX     172,0   /122
3599         XTA     0
3600         FADD    K
3601         FSTA    SPK
3602 /       IF(VERB.EQ.LOCK)SPK=61
3603         FLDA    VERB
3604         FSUB    LOCK
3605         JNE     .+6
3606         LDX     75,0    /61
3607         XTA     0
3608         FSTA    SPK
3609 /       IF(SPK.NE.124)GOTO 2011
3610         LDX     174,0 /124
3611         XTA     0
3612         FSUB    SPK
3613         JNE     #2011
3614 /       CALL DSTROY(CLAM)
3615         JSR     DSTROY
3616         JA      .+4
3617         JA      CLAM
3618 /       CALL DROP(OYSTER,LOC)
3619         JSR     DROP
3620         JA      .+6
3621         JA      OYSTER
3622         JA      LOC
3623 /       CALL DROP(PEARL,105)
3624         JSR     DROP
3625         JA      #2011
3626         JA      PEARL
3627         JA      #LIT+157
3628 /       GOTO 2011
3629
3630 /C
3631 /C CHAIN.
3632 /C
3633 /9048    IF(VERB.EQ.LOCK)GOTO 9049
3634 #9048,  FLDA    VERB
3635         FSUB    LOCK
3636         JEQ     #9049
3637 /       SPK=171
3638         LDX     253,0   /171
3639         XTA     0
3640         FSTA    SPK
3641 /       IF(PROP(BEAR).EQ.0)SPK=41
3642         FLDA    BEAR
3643         ATX     7
3644         FLDA    PROP-3,7
3645         JNE     .+6
3646         LDX     51,0    /41
3647         XTA     0
3648         FSTA    SPK
3649 /       IF(PROP(CHAIN).EQ.0)SPK=37
3650         FLDA    CHAIN
3651         ATX     7
3652         FLDA    PROP-3,7
3653         JNE     .+4
3654         FLDA    #LIT+71
3655         FSTA    SPK
3656 /       IF(SPK.NE.171)GOTO 2011
3657         LDX     253,0   /171
3658         XTA     0
3659         FSUB    SPK
3660         JNE     #2011
3661 /       PROP(CHAIN)=0
3662         FCLA
3663         FSTA    PROP-3,7
3664 /       FIXED(CHAIN)=0
3665         FSTA    FIXED-3,7
3666 /       IF(PROP(BEAR).NE.3)PROP(BEAR)=2
3667         FLDA    BEAR
3668         ATX     7
3669         FLDA    PROP-3,7
3670         FSUB    THREE
3671         JEQ     .+5
3672         FLDA    TWO
3673         FSTA    PROP-3,7
3674 /       FIXED(BEAR)=2-PROP(BEAR)
3675         FLDA    TWO
3676         FSUB    PROP-3,7
3677         FSTA    FIXED-3,7
3678 /       GOTO 2011
3679         JA      #2011
3680
3681 /C
3682 /9049    SPK=172
3683 #9049,  LDX     254,0   /172
3684         XTA     0
3685         FSTA    SPK
3686 /       IF(PROP(CHAIN).NE.0)SPK=34
3687         FLDA    CHAIN
3688         ATX     7
3689         FLDA    PROP-3,7
3690         JEQ     .+6
3691         LDX     42,0    /34
3692         XTA     0
3693         FSTA    SPK
3694 /       IF(LOC.NE.PLAC(CHAIN))SPK=173
3695         FLDA    LOC
3696         FSUB    PLAC-3,7
3697         JEQ     .+6
3698         LDX     255,0   /173
3699         XTA     0
3700         FSTA    SPK
3701 /       IF(SPK.NE.172)GOTO 2011
3702         LDX     254,0   /172
3703         XTA     0
3704         FSUB    SPK
3705         JNE     #2011
3706 /       PROP(CHAIN)=2
3707         FLDA    TWO
3708         FSTA    PROP-3,7
3709 /       IF(TOTING(CHAIN))CALL DROP(CHAIN,LOC)
3710         FLDA    CHAIN
3711         JSA     TOTING
3712         JEQ     .+12
3713         JSR     DROP
3714         JA      .+6
3715         JA      CHAIN
3716         JA      LOC
3717 /       FIXED(CHAIN)=-1
3718         FLDA    MINUS1
3719         FSTA    FIXED-3,7
3720 /       GOTO 2011
3721         JA      #2011
3722
3723 /C
3724 /C LIGHT LAMP
3725 /C
3726 /9070    IF(.NOT.HERE(LAMP))GOTO 2011
3727 #9070,  FLDA    LAMP
3728         JSA     HERE
3729         JEQ     #2011
3730 /       SPK=184
3731         FLDA    #LIT+253
3732         FSTA    SPK
3733 /       IF(LIMIT.LT.0)GOTO 2011
3734         FLDA    LIMIT
3735         JLT     #2011
3736 /       PROP(LAMP)=1
3737         FLDA    LAMP
3738         ATX     7
3739         FLDA    ONE
3740         FSTA    PROP-3,7
3741 /       CALL RSPEAK(39)
3742         JSR     RSPEAK
3743         JA      .+4
3744         JA      #LIT+74
3745 /       IF(WZDARK)GOTO 2000
3746         FLDA    WZDARK
3747         JNE     #2000
3748 /       GOTO 2012
3749         JA      #2012
3750
3751 /C
3752 /C LAMP OFF
3753 /C
3754 /9080    IF(.NOT.HERE(LAMP))GOTO 2011
3755 #9080,  FLDA    LAMP
3756         JSA     HERE
3757         JEQ     #2011
3758 /       PROP(LAMP)=0
3759         FLDA    LAMP
3760         ATX     7
3761         FCLA
3762         FSTA    PROP-3,7
3763 /       CALL RSPEAK(40)
3764         JSR     RSPEAK
3765         JA      .+4
3766         JA      #LIT+77
3767 /       IF(DARK(0))CALL RSPEAK(16)
3768         JSA     DARK
3769         JEQ     #2012
3770         JSR     RSPEAK
3771         JA      #2012
3772         JA      #LIT+30
3773 /       GOTO 2012
3774
3775 /C
3776 /C WAVE. NO EFFECT UNLESS WAVING ROD AT FISSURE.
3777 /C
3778 /9090    IF((.NOT.TOTING(OBJ)).AND.(OBJ.NE.ROD.OR..NOT.TOTING(ROD2)))
3779 /       1        SPK=29
3780 #9090,  FLDA    OBJ
3781         JSA     TOTING
3782         JNE     .+20
3783         FLDA    OBJ
3784         FSUB    ROD
3785         JNE     .+12
3786         FLDA    ROD2
3787         JSA     TOTING
3788         JNE     .+4
3789         FLDA    #LIT+402
3790         FSTA    SPK
3791 /       IF(OBJ.NE.ROD.OR..NOT.AT(FISSUR).OR..NOT.TOTING(OBJ)
3792 /       1       .OR.CLOSNG)GOTO 2011
3793         FLDA    OBJ
3794         FSUB    ROD
3795         JNE     #2011
3796         FLDA    FISSUR
3797         JSA     AT
3798         JEQ     #2011
3799         FLDA    OBJ
3800         JSA     TOTING
3801         JEQ     #2011
3802         FLDA    CLOSNG
3803         JNE     #2011
3804 /       PROP(FISSUR)=1-PROP(FISSUR)
3805         FLDA    FISSUR
3806         ATX     7
3807         FLDA    ONE
3808         FSUB    PROP-3,7
3809         FSTA    PROP-3,7
3810 /       CALL PSPEAK(FISSUR,2-PROP(FISSUR))
3811         FLDA    FISSUR
3812         ATX     7
3813         FLDA    TWO
3814         FSUB    PROP-3,7
3815         FSTA    #TMP
3816         JSR     PSPEAK
3817         JA      #2012
3818         JA      FISSUR
3819         JA      #TMP
3820 /       GOTO 2012
3821
3822 /C
3823 /C ATTACK. ASSUME TARGET IF UNAMBIGUOUS. "THROW" ALSO LINKS HERE. ATTACKABLE
3824 /C OBJECTS FALL INTO TWO CATEGORIES: ENEMIES (SNAKE, DWARF, ETC.) AND OTHERS
3825 /C (BIRD, CLAM). AMBIGUOUS IF TWO ENEMIES, OR IF NO ENEMIES BUT TWO OTHERS.
3826 /C
3827 /9120    DO 9121 I=1,5
3828 #9120,  FLDA    ONE
3829         FSTA    I
3830
3831 #H0102, FLDA    I
3832         ATX     7
3833 /       IF(DLOC(I).EQ.LOC.AND.DFLAG.GE.2)GOTO 9122
3834         FLDA    DLOC-3,7
3835         FSUB    LOC
3836         JNE     #9121
3837         FLDA    DFLAG
3838         FSUB    TWO
3839         JGE     #9122
3840
3841 /9121    CONTINUE
3842 #9121,  FLDA    I
3843         FADD    ONE
3844         FSTA    I
3845         FSUB    #LIT+3
3846         JLE     #H0102
3847 /       I=0
3848         FCLA
3849         FSTA    I
3850
3851 /9122    IF(OBJ.NE.0)GOTO 9124
3852 #9122,  FLDA    OBJ
3853         JNE     #9124
3854 /       IF(I.NE.0)OBJ=DWARF
3855         FLDA    I
3856         JEQ     .+6
3857         FLDA    DWARF
3858         FSTA    OBJ
3859 /       IF(HERE(SNAKE))OBJ=OBJ*100+SNAKE
3860         FLDA    SNAKE
3861         JSA     HERE
3862         JEQ     .+11
3863         FLDA    OBJ
3864         FMUL    #LIT+154
3865         FADD    SNAKE
3866         FSTA    OBJ
3867 /       IF(AT(DRAGON).AND.PROP(DRAGON).EQ.0)OBJ=OBJ*100+DRAGON
3868         FLDA    DRAGON
3869         JSA     AT
3870         JEQ     .+20
3871         FLDA    DRAGON
3872         ATX     7
3873         FLDA    PROP-3,7
3874         JNE     .+11
3875         FLDA    OBJ
3876         FMUL    #LIT+154
3877         FADD    DRAGON
3878         FSTA    OBJ
3879 /       IF(AT(TROLL))OBJ=OBJ*100+TROLL
3880         FLDA    TROLL
3881         JSA     AT
3882         JEQ     .+11
3883         FLDA    OBJ
3884         FMUL    #LIT+154
3885         FADD    TROLL
3886         FSTA    OBJ
3887 /       IF(HERE(BEAR).AND.PROP(BEAR).EQ.0)OBJ=OBJ*100+BEAR
3888         FLDA    BEAR
3889         JSA     HERE
3890         JEQ     .+20
3891         FLDA    BEAR
3892         ATX     7
3893         FLDA    PROP-3,7
3894         JNE     .+11
3895         FLDA    OBJ
3896         FMUL    #LIT+154
3897         FADD    BEAR
3898         FSTA    OBJ
3899 /       IF(OBJ.GT.100)GOTO 8000
3900         FLDA    OBJ
3901         FSUB    #LIT+154
3902         JGT     #8000
3903 /       IF(OBJ.NE.0)GOTO 9124
3904         FLDA    OBJ
3905         JNE     #9124
3906 /C
3907 /C CAN'T ATTACK BIRD BY THROWING AXE.
3908 /C
3909 /       IF(HERE(BIRD).AND.VERB.NE.THROW)OBJ=BIRD
3910         FLDA    BEAR
3911         JSA     HERE
3912         JEQ     .+14
3913         FLDA    VERB
3914         FSUB    THROW
3915         JNE     .+6
3916         FLDA    BIRD
3917         FSTA    OBJ
3918 /C
3919 /C CLAM AND OYSTER BOTH TREATED AS CLAM FOR INTRANSITIVE CASE; NO HARM DONE.
3920 /C
3921 /       IF(HERE(CLAM).OR.HERE(OYSTER))OBJ=100*OBJ+CLAM
3922         FLDA    CLAM
3923         JSA     HERE
3924         JNE     .+10
3925         FLDA    OYSTER
3926         JSA     HERE
3927         JEQ     .+11
3928         FLDA    #LIT+154
3929         FMUL    OBJ
3930         FADD    CLAM
3931         FSTA    OBJ
3932 /       IF(OBJ.GT.100)GOTO 8000
3933         FLDA    OBJ
3934         FSUB    #LIT+154
3935         JGT     #8000
3936
3937 /9124    IF(OBJ.NE.BIRD)GOTO 9125
3938 #9124,  FLDA    OBJ
3939         FSUB    BIRD
3940         JNE     #9125
3941 /       SPK=137
3942         LDX     211,0   /137
3943         XTA     0
3944         FSTA    SPK
3945 /       IF(CLOSED)GOTO 2011
3946         FLDA    CLOSED
3947         JNE     #2011
3948 /       CALL DSTROY(BIRD)
3949         JSR     DSTROY
3950         JA      .+4
3951         JA      BIRD
3952 /       PROP(BIRD)=0
3953         FLDA    BIRD
3954         ATX     7
3955         FCLA
3956         FSTA    PROP-3,7
3957 /       IF(PLACE(SNAKE).EQ.PLAC(SNAKE))TALLY2=TALLY2+1
3958         FLDA    SNAKE
3959         ATX     7
3960         FLDA    PLACE-3,7
3961         FSUB    PLAC-3,7
3962         JNE     .+7
3963         FLDA    TALLY2
3964         FADD    ONE
3965         FSTA    TALLY2
3966 /       SPK=45
3967         FLDA    #LIT+102
3968         FSTA    SPK
3969
3970 /9125    IF(OBJ.EQ.0)SPK=44
3971 #9125,  FLDA    OBJ
3972         JNE     .+6
3973         LDX     54,0    /44
3974         XTA     0
3975         FSTA    SPK
3976 /       IF(OBJ.EQ.CLAM.OR.OBJ.EQ.OYSTER)SPK=150
3977         FLDA    OBJ
3978         FSUB    CLAM
3979         JEQ     .+10
3980         FLDA    OBJ
3981         FSUB    OYSTER
3982         JNE     .+6
3983         LDX     226,0   /150
3984         XTA     0
3985         FSTA    SPK
3986 /       IF(OBJ.EQ.SNAKE)SPK=46
3987         FLDA    OBJ
3988         FSUB    SNAKE
3989         JNE     .+6
3990         LDX     56,0    /46
3991         XTA     0
3992         FSTA    SPK
3993 /       IF(OBJ.EQ.DWARF)SPK=49
3994         FLDA    OBJ
3995         FSUB    DWARF
3996         JNE     .+4
3997         FLDA    #LIT+105
3998         FSTA    SPK
3999 /       IF(OBJ.EQ.DWARF.AND.CLOSED)GOTO 19000
4000         FLDA    OBJ
4001         FSUB    DWARF
4002         JNE     .+6
4003         FLDA    CLOSED
4004         JNE     #19000
4005 /       IF(OBJ.EQ.DRAGON)SPK=167
4006         FLDA    OBJ
4007         FSUB    DRAGON
4008         JNE     .+6
4009         LDX     247,0   /167
4010         XTA     0
4011         FSTA    SPK
4012 /       IF(OBJ.EQ.TROLL)SPK=157
4013         FLDA    OBJ
4014         FSUB    TROLL
4015         JNE     .+6
4016         LDX     235,0   /157
4017         XTA     0
4018         FSTA    SPK
4019 /       IF(OBJ.EQ.BEAR)SPK=165+(PROP(BEAR)+1)/2
4020         FLDA    OBJ
4021         FSUB    BEAR
4022         JNE     .+15
4023         FLDA    BEAR
4024         ATX     7
4025         FLDA    PROP-3,7
4026         FADD    ONE
4027         FDIV    TWO
4028         JSA     #FIX
4029         FADD    #LIT+245
4030         FSTA    SPK
4031 /       IF(OBJ.NE.DRAGON.OR.PROP(DRAGON).NE.0)GOTO 2011
4032         FLDA    OBJ
4033         FSUB    DRAGON
4034         JNE     #2011
4035         FLDA    DRAGON
4036         ATX     7
4037         FLDA    PROP-3,7
4038         JNE     #2011
4039 /C
4040 /C FUN STUFF FOR DRAGON. IF HE INSISTS ON ATTACKING IT, WIN! SET PROP TO DEAD,
4041 /C MOVE DRAGON TO CENTRAL LOC (STILL FIXED), MOVE RUG THERE (NOT FIXED), AND
4042 /C MOVE HIM THERE, TOO. THEN DO A NULL MOTION TO GET NEW DESCRIPTION.
4043 /C
4044 /       CALL RSPEAK(49)
4045         JSR     RSPEAK
4046         JA      .+4
4047         JA      #LIT+105
4048 /       VERB=0
4049         FCLA
4050         FSTA    VERB
4051 /       OBJ=0
4052         FSTA    OBJ
4053 /       CALL GETIN(WD1,WD1A,WD1X,WD2,WD2A,WD2X)
4054         JSR     GETIN
4055         JA      .+12
4056         JA      WD1
4057         JA      WD1X
4058         JA      WD2
4059         JA      WD2X
4060 /       IF(WD1.NE.'YE'.AND.WD1.NE.'Y')GOTO 2608
4061         FLDA    WD1
4062         FSUB    TYES
4063         JEQ     OKKILL
4064         FLDA    WD1
4065         FSUB    TYE
4066         JEQ     OKKILL
4067         FLDA    WD1
4068         FSUB    TY
4069         JNE     #2608
4070 /       CALL PSPEAK(DRAGON,1)
4071 OKKILL, JSR     PSPEAK
4072         JA      .+6
4073         JA      DRAGON
4074         JA      ONE
4075 /       PROP(DRAGON)=2
4076         FLDA    DRAGON
4077         ATX     7
4078         FLDA    TWO
4079         FSTA    PROP-3,7
4080 /       PROP(RUG)=0
4081         FLDA    RUG
4082         ATX     7
4083         FCLA
4084         FSTA    PROP-3,7
4085 /       K=(PLAC(DRAGON)+FIXD(DRAGON))/2
4086         FLDA    DRAGON
4087         ATX     7
4088         FLDA    PLAC-3,7
4089         FADD    FIXD-3,7
4090         FDIV    TWO
4091         JSA     #FIX
4092         FSTA    K
4093 /       CALL MOVE(DRAGON+100,-1)
4094         FLDA    DRAGON
4095         FADD    #LIT+154
4096         FSTA    #TMP
4097         JSR     MOVE
4098         JA      .+6
4099         JA      #TMP
4100         JA      MINUS1
4101 /       CALL MOVE(RUG+100,0)
4102         FLDA    RUG
4103         FADD    #LIT+154
4104         FSTA    #TMP
4105         JSR     MOVE
4106         JA      .+6
4107         JA      #TMP
4108         JA      ZERO
4109 /       CALL MOVE(DRAGON,K)
4110         JSR     MOVE
4111         JA      .+6
4112         JA      DRAGON
4113         JA      K
4114 /       CALL MOVE(RUG,K)
4115         JSR     MOVE
4116         JA      .+6
4117         JA      RUG
4118         JA      K
4119 /       DO 9126 OBJ=1,100
4120         FLDA    ONE
4121         FSTA    OBJ
4122
4123 /       IF(PLACE(OBJ).EQ.PLAC(DRAGON).OR.PLACE(OBJ).EQ.FIXD(DRAGON))
4124 /       1       CALL MOVE(OBJ,K)
4125 #H0122, FLDA    OBJ
4126         ATX     7
4127         FLDA    DRAGON
4128         ATX     6
4129         FLDA    PLACE-3,7
4130         FSUB    PLAC-3,6
4131         JEQ     .+10
4132         FLDA    PLACE-3,7
4133         FSUB    FIXD-3,6
4134         JNE     #9126
4135         JSR     MOVE
4136         JA      .+6
4137         JA      OBJ
4138         JA      K
4139 /9126    CONTINUE
4140 #9126,  FLDA    OBJ
4141         FADD    ONE
4142         FSTA    OBJ
4143         FSUB    #LIT+154
4144         JLE     #H0122
4145 /       LOC=K
4146         FLDA    K
4147         FSTA    LOC
4148 /       K=NULL
4149         FLDA    NULL
4150         FSTA    K
4151 /       GOTO 8
4152         JA      #8
4153
4154 /C
4155 /C POUR. IF NO OBJECT, OR OBJECT IS BOTTLE, ASSUME CONTENTS OF BOTTLE.
4156 /C SPECIAL TESTS FOR POURING WATER OR OIL ON PLANT OR RUSTY DOOR.
4157 /C
4158 /9130    IF(OBJ.EQ.BOTTLE.OR.OBJ.EQ.0)OBJ=LIQ(0)
4159 #9130,  FLDA    OBJ
4160         FSUB    BOTTLE
4161         JEQ     .+6
4162         FLDA    OBJ
4163         JNE     .+6
4164         JSA     LIQ
4165         FSTA    OBJ
4166 /       IF(OBJ.EQ.0)GOTO 8000
4167         FLDA    OBJ
4168         JEQ     #8000
4169 /       IF(.NOT.TOTING(OBJ))GOTO 2011
4170         FLDA    OBJ
4171         JSA     TOTING
4172         JEQ     #2011
4173 /       SPK=78
4174         LDX     116,0   /78
4175         XTA     0
4176         FSTA    SPK
4177 /       IF(OBJ.NE.OIL.AND.OBJ.NE.WATER)GOTO 2011
4178         FLDA    OBJ
4179         FSUB    OIL
4180         JEQ     .+10
4181         FLDA    OBJ
4182         FSUB    WATER
4183         JNE     #2011
4184 /       PROP(BOTTLE)=1
4185         FLDA    BOTTLE
4186         ATX     7
4187         FLDA    ONE
4188         FSTA    PROP-3,7
4189 /       PLACE(OBJ)=0
4190         FLDA    OBJ
4191         ATX     7
4192         FCLA
4193         FSTA    PLACE-3,7
4194 /       SPK=77
4195         LDX     115,0   /77
4196         XTA     0
4197         FSTA    SPK
4198 /       IF(.NOT.(AT(PLANT).OR.AT(DOOR)))GOTO 2011
4199         FLDA    PLANT
4200         JSA     AT
4201         JNE     .+10
4202         FLDA    DOOR
4203         JSA     AT
4204         JEQ     #2011
4205 /C
4206 /       IF(AT(DOOR))GOTO 9132
4207         FLDA    DOOR
4208         JSA     AT
4209         JNE     #9132
4210 /       SPK=112
4211         LDX     160,0   /112
4212         XTA     0
4213         FSTA    SPK
4214 /       IF(OBJ.NE.WATER)GOTO 2011
4215         FLDA    OBJ
4216         FSUB    WATER
4217         JNE     #2011
4218 /       CALL PSPEAK(PLANT,PROP(PLANT)+1)
4219         FLDA    PLANT
4220         ATX     7
4221         FLDA    PROP-3,7
4222         FADD    ONE
4223         FSTA    #TMP
4224         JSR     PSPEAK
4225         JA      .+6
4226         JA      PLANT
4227         JA      #TMP
4228 /       PROP(PLANT)=MOD(PROP(PLANT)+2,6)
4229         FLDA    PLANT
4230         ATX     7
4231         FLDA    PROP-3,7
4232         FADD    TWO
4233         FSTA    #TMP
4234         JSR     MOD
4235         JA      .+6
4236         JA      #TMP
4237         JA      #LIT+6
4238         FSTA    PROP-3,7
4239 /       PROP(PLANT2)=PROP(PLANT)/2
4240         FLDA    PLANT2
4241         ATX     7
4242         FLDA    PLANT
4243         ATX     6
4244         FLDA    PROP-3,6
4245         FDIV    TWO
4246         JSA     #FIX
4247         FSTA    PROP-3,7
4248 /       K=NULL
4249         FLDA    NULL
4250         FSTA    K
4251 /       GOTO 8
4252         JA      #8
4253
4254 /C
4255 /9132    PROP(DOOR)=0
4256 #9132,  FLDA    DOOR
4257         ATX     7
4258         FCLA
4259         FSTA    PROP-3,7
4260 /       IF(OBJ.EQ.OIL)PROP(DOOR)=1
4261         FLDA    OBJ
4262         FSUB    OIL
4263         JNE     .+10
4264         FLDA    DOOR
4265         ATX     7
4266         FLDA    ONE
4267         FSTA    PROP-3,7
4268 /       SPK=113+PROP(DOOR)
4269         FLDA    DOOR
4270         ATX     7
4271         LDX     161,0   /113
4272         XTA     0
4273         FADD    PROP-3,7
4274         FSTA    SPK
4275 /       GOTO 2011
4276         JA      #2011
4277
4278 /C
4279 /C EAT. INTRANSITIVE: ASSUME FOOD IF PRESENT, ELSE ASK WHAT. TRANSITIVE: FOOD
4280 /C OK, SOME THINGS LOSE APPETITE, REST ARE RIDICULOUS.
4281 /C
4282 /8140    IF(.NOT.HERE(FOOD))GOTO 8000
4283 #8140,  FLDA    FOOD
4284         JSA     HERE
4285         JEQ     #8000
4286
4287 /8142    CALL DSTROY(FOOD)
4288 #8142,  JSR     DSTROY
4289         JA      .+4
4290         JA      FOOD
4291 /       SPK=72
4292         LDX     110,0   /72
4293         XTA     0
4294         FSTA    SPK
4295 /       GOTO 2011
4296         JA      #2011
4297 /C
4298 /9140    IF(OBJ.EQ.FOOD)GOTO 8142
4299 #9140,  FLDA    OBJ
4300         FSUB    FOOD
4301         JEQ     #8142
4302 /       IF(OBJ.EQ.BIRD.OR.OBJ.EQ.SNAKE.OR.OBJ.EQ.CLAM.OR.OBJ.EQ.OYSTER
4303 /       1       .OR.OBJ.EQ.DWARF.OR.OBJ.EQ.DRAGON.OR.OBJ.EQ.TROLL
4304 /       2       .OR.OBJ.EQ.BEAR)SPK=71
4305         FLDA    OBJ
4306         FSUB    BIRD
4307         JEQ     #M78
4308         FLDA    OBJ
4309         FSUB    SNAKE
4310         JEQ     #M78
4311         FLDA    OBJ
4312         FSUB    CLAM
4313         JEQ     #M78
4314         FLDA    OBJ
4315         FSUB    OYSTER
4316         JEQ     #M78
4317         FLDA    OBJ
4318         FSUB    DWARF
4319         JEQ     #M78
4320         FLDA    OBJ
4321         FSUB    DRAGON
4322         JEQ     #M78
4323         FLDA    OBJ
4324         FSUB    TROLL
4325         JEQ     #M78
4326         FLDA    OBJ
4327         FSUB    BEAR
4328         JNE     #2011
4329 #M78,   LDX     107,0   /71
4330         XTA     0
4331         FSTA    SPK
4332 /       GOTO 2011
4333         JA      #2011
4334
4335 /C
4336 /C DRINK. IF NO OBJECT, ASSUME WATER AND LOOK FOR IT HERE. IF WATER IS IN
4337 /C THE BOTTLE, DRINK THAT, ELSE MUST BE AT A WATER LOC, SO DRINK STREAM.
4338 /C
4339 /9150    IF(OBJ.EQ.0.AND.LIQLOC(LOC).NE.WATER.AND.(LIQ(0).NE.WATER
4340 /       1       .OR..NOT.HERE(BOTTLE)))GOTO 8000
4341 #9150,  FLDA    OBJ
4342         JNE     #M79
4343         JSA     LIQLOC
4344         FSUB    WATER
4345         JEQ     #M79
4346         JSA     LIQ
4347         FSUB    WATER
4348         JNE     #8000
4349         FLDA    BOTTLE
4350         JSA     HERE
4351         JEQ     #8000
4352 /       IF(OBJ.NE.0.AND.OBJ.NE.WATER)SPK=110
4353 #M79,   FLDA    OBJ
4354         JEQ     .+12
4355         FLDA    OBJ
4356         FSUB    WATER
4357         JEQ     .+4
4358         FLDA    #LIT+162
4359         FSTA    SPK
4360 /       IF(SPK.EQ.110.OR.LIQ(0).NE.WATER.OR..NOT.HERE(BOTTLE))GOTO 2011
4361         FLDA    SPK
4362         FSUB    #LIT+162
4363         JEQ     #2011
4364         JSA     LIQ
4365         FSUB    WATER
4366         JNE     #2011
4367         FLDA    BOTTLE
4368         JSA     HERE
4369         JEQ     #2011
4370 /       PROP(BOTTLE)=1
4371         FLDA    BOTTLE
4372         ATX     7
4373         FLDA    ONE
4374         FSTA    PROP-3,7
4375 /       PLACE(WATER)=0
4376         FLDA    WATER
4377         ATX     7
4378         FCLA
4379         FSTA    PLACE-3,7
4380 /       SPK=74
4381         LDX     112,0   /74
4382         XTA     0
4383         FSTA    SPK
4384 /       GOTO 2011
4385         JA      #2011
4386
4387 /C
4388 /C RUB. YIELDS VARIOUS SNIDE REMARKS.
4389 /C
4390 /9160    IF(OBJ.NE.LAMP)SPK=76
4391 #9160,  FLDA    OBJ
4392         FSUB    LAMP
4393         JEQ     #2011
4394         LDX     114,0   /76
4395         XTA     0
4396         FSTA    SPK
4397 /       GOTO 2011
4398         JA      #2011
4399
4400 /C
4401 /C THROW. SAME AS DISCARD UNLESS AXE. THEN SAME AS ATTACK EXCEPT IGNORE BIRD,
4402 /C AND IF DWARF IS PRESENT THEN ONE MIGHT BE KILLED. (ONLY WAY TO DO SO!)
4403 /C AXE ALSO SPECIAL FOR DRAGON, BEAR, AND TROLL. TREASURES SPECIAL FOR TROLL.
4404 /C
4405 /9170    IF(TOTING(ROD2).AND.OBJ.EQ.ROD.AND..NOT.TOTING(ROD))OBJ=ROD2
4406 #9170,  FLDA    ROD2
4407         JSA     TOTING
4408         JEQ     #M81
4409         FLDA    OBJ
4410         FSUB    ROD
4411         JNE     #M81
4412         FLDA    ROD
4413         JSA     TOTING
4414         JNE     #M81
4415         FLDA    ROD2
4416         FSTA    OBJ
4417 /       IF(.NOT.TOTING(OBJ))GOTO 2011
4418 #M81,   FLDA    OBJ
4419         JSA     TOTING
4420         JEQ     #2011
4421 /       IF(OBJ.GE.50.AND.OBJ.LE.MAXTRS.AND.AT(TROLL))GOTO 9178
4422         FLDA    OBJ
4423         FSUB    #LIT+110
4424         JLT     #M82
4425         FLDA    OBJ
4426         FSUB    MAXTRS
4427         JGT     #M82
4428         FLDA    TROLL
4429         JSA     AT
4430         JNE     #9178
4431 /       IF(OBJ.EQ.FOOD.AND.HERE(BEAR))GOTO 9177
4432 #M82,   FLDA    OBJ
4433         FSUB    FOOD
4434         JNE     #M83
4435         FLDA    BEAR
4436         JSA     HERE
4437         JNE     #9177
4438 /       IF(OBJ.NE.AXE)GOTO 9020
4439 #M83,   FLDA    OBJ
4440         FSUB    AXE
4441         JNE     #9020
4442 /       DO 9171 I=1,5
4443         FLDA    ONE
4444         FSTA    I
4445
4446 /C
4447 /C NEEDN'T CHECK DFLAG IF AXE IS HERE.
4448 /C
4449 /       IF(DLOC(I).EQ.LOC)GOTO 9172
4450 #H0132, FLDA    I
4451         ATX     7
4452         FLDA    DLOC-3,7
4453         FSUB    LOC
4454         JEQ     #9172
4455
4456 /9171    CONTINUE
4457 #9171,  FLDA    I
4458         FADD    ONE
4459         FSTA    I
4460         FSUB    #LIT+3
4461         JLE     #H0132
4462 /       SPK=152
4463         LDX     230,0   /152
4464         XTA     0
4465         FSTA    SPK
4466 /       IF(AT(DRAGON).AND.PROP(DRAGON).EQ.0)GOTO 9175
4467         FLDA    DRAGON
4468         JSA     AT
4469         JEQ     #M84
4470         FLDA    DRAGON
4471         ATX     7
4472         FLDA    PROP-3,7
4473         JEQ     #9175
4474 /       SPK=158
4475 #M84,   LDX     236,0   /158
4476         XTA     0
4477         FSTA    SPK
4478 /       IF(AT(TROLL))GOTO 9175
4479         FLDA    TROLL
4480         JSA     AT
4481         JNE     #9175
4482 /       IF(HERE(BEAR).AND.PROP(BEAR).EQ.0)GOTO 9176
4483         FLDA    BEAR
4484         JSA     HERE
4485         JEQ     #M85
4486         FLDA    BEAR
4487         ATX     7
4488         FLDA    PROP-3,7
4489         JEQ     #9176
4490 /       OBJ=0
4491 #M85,   FCLA
4492         FSTA    OBJ
4493 /       GOTO 9120
4494         JA      #9120
4495
4496 /C
4497 /9172    SPK=48
4498 #9172,  LDX     60,0    /48
4499         XTA     0
4500         FSTA    SPK
4501 /       IF(RND(3).EQ.0)GOTO 9175
4502         JSR     RND
4503         JA      .+4
4504         JA      THREE
4505         JEQ     #9175
4506 /       DSEEN(I)=.FALSE.
4507         FLDA    I
4508         ATX     7
4509         FCLA
4510         FSTA    DSEEN-3,7
4511 /       DLOC(I)=0
4512         FSTA    DLOC-3,7
4513 /       SPK=47
4514         LDX     57,0    /47
4515         XTA     0
4516         FSTA    SPK
4517 /       DKILL=DKILL+1
4518         FLDA    ONE
4519         FADDM   DKILL
4520 /       IF(DKILL.EQ.1)SPK=149
4521         FSUB    ONE
4522         JNE     #9175
4523         LDX     225,0 /149
4524         XTA     0
4525         FSTA    SPK
4526 /9175    CALL RSPEAK(SPK)
4527 #9175,  JSR     RSPEAK
4528         JA      .+4
4529         JA      SPK
4530 /       CALL DROP(AXE,LOC)
4531         JSR     DROP
4532         JA      .+6
4533         JA      AXE
4534         JA      LOC
4535 /       K=NULL
4536         FLDA    NULL
4537         FSTA    K
4538 /       GOTO 8
4539         JA      #8
4540
4541 /C
4542 /C THIS'LL TEACH HIM TO THROW THE AXE AT THE BEAR!
4543 /C
4544 /9176    SPK=164
4545 #9176,  LDX     244,0   /164
4546         XTA     0
4547         FSTA    SPK
4548 /       CALL DROP(AXE,LOC)
4549         JSR     DROP
4550         JA      .+6
4551         JA      AXE
4552         JA      LOC
4553 /       FIXED(AXE)=-1
4554         FLDA    AXE
4555         ATX     7
4556         FLDA    MINUS1
4557         FSTA    FIXED-3,7
4558 /       PROP(AXE)=1
4559         FLDA    ONE
4560         FSTA    PROP-3,7
4561 /       CALL JUGGLE(BEAR)
4562         JSR     JUGGLE
4563 /       GOTO 2011
4564         JA      #2011
4565         JA      BEAR
4566
4567 /C
4568 /C BUT THROWING FOOD IS ANOTHER STORY.
4569 /C
4570 /9177    OBJ=BEAR
4571 #9177,  FLDA    BEAR
4572         FSTA    OBJ
4573 /       GOTO 9210
4574         JA      #9210
4575
4576 /C
4577 /C SNARF A TREASURE FOR THE TROLL.
4578 /C
4579 /9178    SPK=159
4580 #9178,  LDX     237,0   /159
4581         XTA     0
4582         FSTA    SPK
4583 /       CALL DROP(OBJ,0)
4584         JSR     DROP
4585         JA      .+6
4586         JA      OBJ
4587         JA      ZERO
4588 /       CALL MOVE(TROLL,0)
4589         JSR     MOVE
4590         JA      .+6
4591         JA      TROLL
4592         JA      ZERO
4593 /       CALL MOVE(TROLL+100,0)
4594         FLDA    TROLL
4595         FADD    #LIT+154
4596         FSTA    #TMP
4597         JSR     MOVE
4598         JA      .+6
4599         JA      #TMP
4600         JA      ZERO
4601 /       CALL DROP(TROLL2,PLAC(TROLL))
4602         FLDA    TROLL
4603         ATX     7
4604         XTA     7
4605         FMUL    THREE
4606         ALN     0
4607         STARTD
4608         FADD    PPLAC
4609         FSTA    .+11
4610         STARTF
4611         JSR     DROP
4612         JA      .+6
4613         JA      TROLL2
4614         JA      .
4615 /       CALL DROP(TROLL2+100,FIXD(TROLL))
4616         FLDA    TROLL2
4617         FADD    #LIT+154
4618         FSTA    #TMP
4619         FLDA    TROLL
4620         ATX     7
4621         XTA     7
4622         FMUL    THREE
4623         ALN     0
4624         STARTD
4625         FADD    PFIXD
4626         FSTA    .+11
4627         STARTF
4628         JSR     DROP
4629         JA      .+6
4630         JA      #TMP
4631         JA      .
4632 /       CALL JUGGLE(CHASM)
4633         JSR     JUGGLE
4634         JA      .+4
4635         JA      CHASM
4636 /       GOTO 2011
4637         JA      #2011
4638
4639 /C
4640 /C QUIT. INTRANSITIVE ONLY. VERIFY INTENT AND EXIT IF THAT'S WHAT HE WANTS.
4641 /C
4642 /8180    GAVEUP=YES(22,54,54)
4643 #8180,  JSR     YES
4644         JA      .+10
4645         JA      #LIT+41
4646         JA      #LIT+113
4647         JA      #LIT+113
4648         FSTA    GAVEUP
4649
4650 /8185    IF(GAVEUP)GOTO 20000
4651 #8185,  FLDA    GAVEUP
4652         JNE     #20000
4653 /       GOTO 2012
4654         JA      #2012
4655 /C
4656 /C FIND. MIGHT BE CARRYING IT, OR IT MIGHT BE HERE. ELSE GIVE CAVEAT.
4657 /C
4658 /9190    IF(AT(OBJ).OR.(LIQ(0).EQ.OBJ.AND.AT(BOTTLE))
4659 /       1       .OR.K.EQ.LIQLOC(LOC))SPK=94
4660 #9190,  FLDA    OBJ
4661         JSA     AT
4662         JNE     #M86
4663         JSA     LIQ
4664         FSUB    OBJ
4665         JNE     #M87
4666         FLDA    BOTTLE
4667         JSA     AT
4668         JNE     #M86
4669 #M87,   JSA     LIQLOC
4670         FSUB    K
4671         JNE     .+6
4672 #M86,   LDX     136,0   /94
4673         XTA     0
4674         FSTA    SPK
4675 /       DO 9192 I=1,5
4676         FLDA    ONE
4677         FSTA    I
4678 /9192    IF(DLOC(I).EQ.LOC.AND.DFLAG.GE.2.AND.OBJ.EQ.DWARF)SPK=94
4679 #9192,  FLDA    I
4680         ATX     7
4681         FLDA    DLOC-3,7
4682         FSUB    LOC
4683         JNE     #M88
4684         FLDA    DFLAG
4685         FSUB    TWO
4686         JLT     #M88
4687         FLDA    OBJ
4688         FSUB    DWARF
4689         JNE     #M88
4690         LDX     136,0   /94
4691         XTA     0
4692         FSTA    SPK
4693 #M88,   FLDA    I
4694         FADD    ONE
4695         FSTA    I
4696         FSUB    #LIT+3
4697         JLE     #9192
4698 /       IF(CLOSED)SPK=138
4699         FLDA    CLOSED
4700         JEQ     .+6
4701         LDX     212,0   /138
4702         XTA     0
4703         FSTA    SPK
4704 /       IF(TOTING(OBJ))SPK=24
4705         FLDA    OBJ
4706         JSA     TOTING
4707         JEQ     #2011
4708         FLDA    #LIT+47
4709         FSTA    SPK
4710 /       GOTO 2011
4711         JA      #2011
4712
4713 /C
4714 /C INVENTORY. IF OBJECT, TREAT SAME AS FIND. ELSE REPORT ON CURRENT BURDEN.
4715 /C
4716 /8200    SPK=98
4717 #8200,  LDX     142,0   /98
4718         XTA     0
4719         FSTA    SPK
4720 /       DO 8201 I=1,100
4721         FLDA    ONE
4722         FSTA    I
4723
4724 /       IF(I.EQ.BEAR.OR..NOT.TOTING(I))GOTO 8201
4725 #H0143, FLDA    I
4726         FSUB    BEAR
4727         JEQ     #8201
4728         FLDA    I
4729         JSA     TOTING
4730         JEQ     #8201
4731 /       IF(SPK.EQ.98)CALL RSPEAK(99)
4732         LDX     142,0   /98
4733         XTA     0
4734         FSUB    SPK
4735         JNE     .+10
4736         JSR     RSPEAK
4737         JA      .+4
4738         JA      #LIT+151
4739 /       CALL PSPEAK(I,-1)
4740         JSR     PSPEAK
4741         JA      .+6
4742         JA      I
4743         JA      MINUS1
4744 /       SPK=0
4745         FCLA
4746         FSTA    SPK
4747
4748 /8201    CONTINUE
4749 #8201,  FLDA    I
4750         FADD    ONE
4751         FSTA    I
4752         FSUB    #LIT+154
4753         JLE     #H0143
4754 /       IF(TOTING(BEAR))SPK=141
4755         FLDA    BEAR
4756         JSA     TOTING
4757         JEQ     #2011
4758         FLDA    #LIT+226
4759         FSTA    SPK
4760 /       GOTO 2011
4761         JA      #2011
4762
4763 /C
4764 /C FEED. IF BIRD, NO SEED. SNAKE, DRAGON, TROLL: QUIP. IF DWARF, MAKE HIM
4765 /C MAD. BEAR, SPECIAL.
4766 /C
4767 /9210    IF(OBJ.NE.BIRD)GOTO 9212
4768 #9210,  FLDA    OBJ
4769         FSUB    BIRD
4770         JNE     #9212
4771 /       SPK=100
4772         FLDA    #LIT+154
4773         FSTA    SPK
4774 /       GOTO 2011
4775         JA      #2011
4776
4777 /C
4778 /9212    IF(OBJ.NE.SNAKE.AND.OBJ.NE.DRAGON.AND.OBJ.NE.TROLL)GOTO 9213
4779 #9212,  FLDA    OBJ
4780         FSUB    SNAKE
4781         JEQ     #M89
4782         FLDA    OBJ
4783         FSUB    DRAGON
4784         JEQ     #M89
4785         FLDA    OBJ
4786         FSUB    TROLL
4787         JNE     #9213
4788 /       SPK=102
4789 #M89,   LDX     146,0   /102
4790         XTA     0
4791         FSTA    SPK
4792 /       IF(OBJ.EQ.DRAGON.AND.PROP(DRAGON).NE.0)SPK=110
4793         FLDA    OBJ
4794         FSUB    DRAGON
4795         JNE     #M90
4796         FLDA    DRAGON
4797         ATX     7
4798         FLDA    PROP-3,7
4799         JEQ     .+4
4800         FLDA    #LIT+162
4801         FSTA    SPK
4802 /       IF(OBJ.EQ.TROLL)SPK=182
4803 #M90,   FLDA    OBJ
4804         FSUB    TROLL
4805         JNE     .+6
4806         LDX     266,0   /182
4807         XTA     0
4808         FSTA    SPK
4809 /       IF(OBJ.NE.SNAKE.OR.CLOSED.OR..NOT.HERE(BIRD))GOTO 2011
4810         FLDA    OBJ
4811         FSUB    SNAKE
4812         JNE     #2011
4813         FLDA    CLOSED
4814         JNE     #2011
4815         FLDA    BIRD
4816         JSA     HERE
4817         JEQ     #2011
4818 /       SPK=101
4819         LDX     145,0   /101
4820         XTA     0
4821         FSTA    SPK
4822 /       CALL DSTROY(BIRD)
4823         JSR     DSTROY
4824         JA      .+4
4825         JA      BIRD
4826 /       PROP(BIRD)=0
4827         FLDA    BIRD
4828         ATX     7
4829         FCLA
4830         FSTA    PROP-3,7
4831 /       TALLY2=TALLY2+1
4832         FLDA    TALLY2
4833         FADD    ONE
4834         FSTA    TALLY2
4835 /       GOTO 2011
4836         JA      #2011
4837
4838 /C
4839 /9213    IF(OBJ.NE.DWARF)GOTO 9214
4840 #9213,  FLDA    OBJ
4841         FSUB    DWARF
4842         JNE     #9214
4843 /       IF(.NOT.HERE(FOOD))GOTO 2011
4844         FLDA    FOOD
4845         JSA     HERE
4846         JEQ     #2011
4847 /       SPK=103
4848         LDX     147,0   / 103
4849         XTA     0
4850         FSTA    SPK
4851 /       DFLAG=DFLAG+1
4852         FLDA    ONE
4853         FADDM   DFLAG
4854 /       GOTO 2011
4855         JA      #2011
4856
4857 /C
4858 /9214    IF(OBJ.NE.BEAR)GOTO 9215
4859 #9214,  FLDA    OBJ
4860         FSUB    BEAR
4861         JNE     #9215
4862 /       IF(PROP(BEAR).EQ.0)SPK=102
4863         FLDA    BEAR
4864         ATX     7
4865         FLDA    PROP-3,7
4866         JNE     .+6
4867         LDX     146,0   /102
4868         XTA     0
4869         FSTA    SPK
4870 /       IF(PROP(BEAR).EQ.3)SPK=110
4871         FLDA    PROP-3,7
4872         FSUB    THREE
4873         JNE     .+4
4874         FLDA    #LIT+162
4875         FSTA    SPK
4876 /       IF(.NOT.HERE(FOOD))GOTO 2011
4877         FLDA    FOOD
4878         JSA     HERE
4879         JEQ     #2011
4880 /       CALL DSTROY(FOOD)
4881         JSR     DSTROY
4882         JA      .+4
4883         JA      FOOD
4884 /       PROP(BEAR)=1
4885         FLDA    ONE
4886         FSTA    PROP-3,7
4887 /       FIXED(AXE)=0
4888         FLDA    AXE
4889         ATX     7
4890         FCLA
4891         FSTA    FIXED-3,7
4892 /       PROP(AXE)=0
4893         FSTA    PROP-3,7
4894 /       SPK=168
4895         LDX     250,0   /168
4896         XTA     0
4897         FSTA    SPK
4898 /       GOTO 2011
4899         JA      #2011
4900
4901 /C
4902 /9215    SPK=14
4903 #9215,  LDX     16,0    /14
4904         XTA     0
4905         FSTA    SPK
4906 /       GOTO 2011
4907         JA      #2011
4908
4909 /C
4910 /C FILL. BOTTLE MUST BE EMPTY, AND SOME LIQUID AVAILABLE. (VASE IS NASTY.)
4911 /C
4912 /9220    IF(OBJ.EQ.VASE)GOTO 9222
4913 #9220,  FLDA    OBJ
4914         FSUB    VASE
4915         JEQ     #9222
4916 /       IF(OBJ.NE.0.AND.OBJ.NE.BOTTLE)GOTO 2011
4917         FLDA    OBJ
4918         JEQ     #M91
4919         FLDA    OBJ
4920         FSUB    BOTTLE
4921         JNE     #2011
4922 /       IF(OBJ.EQ.0.AND..NOT.HERE(BOTTLE))GOTO 8000
4923 #M91,   FLDA    OBJ
4924         JNE     #M92
4925         FLDA    BOTTLE
4926         JSA     HERE
4927         JEQ     #8000
4928 /       SPK=107
4929 #M92,   LDX     153,0   /107
4930         XTA     0
4931         FSTA    SPK
4932 /       IF(LIQLOC(LOC).EQ.0)SPK=106
4933         JSA     LIQLOC
4934         JNE     #M92A
4935         LDX     152,0   /106
4936         XTA     0
4937         FSTA    SPK
4938 /       IF(LIQ(0).NE.0)SPK=105
4939 #M92A,  JSA     LIQ
4940         JEQ     .+4
4941         FLDA    #LIT+157
4942         FSTA    SPK
4943 /       IF(SPK.NE.107)GOTO 2011
4944         LDX     153,0   /107
4945         XTA     0
4946         FSUB    SPK
4947         JNE     #2011
4948 /        PROP(BOTTLE)=MOD(COND(LOC),4)/2*2
4949         FLDA    BOTTLE
4950         ATX     7
4951         FLDA    LOC
4952         ATX     6
4953         XTA     6
4954         FMUL    THREE
4955         ALN     0
4956         STARTD
4957         FADD    PCOND
4958         FSTA    .+7
4959         STARTF
4960         JSR     MOD
4961         JA      .+6
4962         JA      .
4963         JA      #LIT
4964         FDIV    TWO
4965         JSA     #FIX
4966         FMUL    TWO
4967         FSTA    PROP-3,7
4968 /       K=LIQ(0)
4969         JSA     LIQ
4970         FSTA    K
4971 /       IF(TOTING(BOTTLE))PLACE(K)=-1
4972         FLDA    BOTTLE
4973         JSA     TOTING
4974         JEQ     .+11
4975         FLDA    K
4976         ATX     7
4977         FLDA    MINUS1
4978         FSTA    PLACE-3,7
4979 /       IF(K.EQ.OIL)SPK=108
4980         FLDA    K
4981         FSUB    OIL
4982         JNE     #2011
4983         LDX     154,0   /108
4984         XTA     0
4985         FSTA    SPK
4986 /       GOTO 2011
4987         JA      #2011
4988
4989 /C
4990 /9222    SPK=29
4991 #9222,  LDX     35,0    /29
4992         XTA     0
4993         FSTA    SPK
4994 /       IF(LIQLOC(LOC).EQ.0)SPK=144
4995         JSA     LIQLOC
4996         JNE     .+6
4997         LDX     220,0   /144
4998         XTA     0
4999         FSTA    SPK
5000 /       IF(LIQLOC(LOC).EQ.0.OR..NOT.TOTING(VASE))GOTO 2011
5001         JSA     LIQLOC
5002         JEQ     #2011
5003         FLDA    VASE
5004         JSA     TOTING
5005         JEQ     #2011
5006 /       CALL RSPEAK(145)
5007         JSR     RSPEAK
5008         JA      .+4
5009         JA      #LIT+234
5010 /       PROP(VASE)=2
5011         FLDA    VASE
5012         ATX     7
5013         FLDA    TWO
5014         FSTA    PROP-3,7
5015 /       FIXED(VASE)=-1
5016         FLDA    MINUS1
5017         FSTA    FIXED-3,7
5018 /       GOTO 9024
5019         JA      #9024
5020
5021 /C
5022 /C BLAST. NO EFFECT UNLESS YOU'VE GOT DYNAMITE, WHICH IS A NEAT TRICK!
5023 /C
5024 /9230    IF(PROP(ROD2).LT.0.OR..NOT.CLOSED)GOTO 2011
5025 #9230,  FLDA    ROD2
5026         ATX     7
5027         FLDA    PROP-3,7
5028         JLT     #2011
5029         FLDA    CLOSED
5030         JEQ     #2011
5031 /       BONUS=133
5032         LDX     205,0   /133
5033         XTA     0
5034         FSTA    BONUS
5035 /       IF(LOC.EQ.115)BONUS=134
5036         FLDA    LOC
5037         FSUB    #LIT+165
5038         JNE     .+7
5039         LDX     206,0   /134
5040         XTA     0
5041         FSTA    BONUS
5042 /       IF(HERE(ROD2))BONUS=135
5043         FLDA    ROD2
5044         JSA     HERE
5045         JEQ     .+7
5046         LDX     207,0   /135
5047         XTA     0
5048         FSTA    BONUS
5049 /       CALL RSPEAK(BONUS)
5050         JSR     RSPEAK
5051         JA      .+4
5052         JA      BONUS
5053 /       GOTO 20000
5054         JA      #20000
5055
5056 /C
5057 /C SCORE. GO TO SCORING SECTION, WHICH WILL RETURN TO 8241 IF SCORNG IS TRUE.
5058 /C
5059 /8240    SCORNG=.TRUE.
5060 #8240,  FLDA    ONE
5061         FSTA    SCORNG
5062 /       GOTO 20000
5063         JA      #20000
5064
5065 /C
5066 /8241    SCORNG=.FALSE.
5067 #8241,  FCLA
5068         FSTA    SCORNG
5069 /       TYPE 8243,SCORE,MXSCOR
5070         JSR     SIXOUT
5071         JA      .+10
5072         JA      #8243
5073         JA      ZERO
5074         JA      TWO
5075
5076         TRAP3   #WRITO
5077         JA      #LIT
5078         JA      #8243A
5079         FLDA    SCORE
5080         TRAP3   #RSVO
5081         TRAP3   #RENDO
5082
5083         JSR     SIXOUT
5084         JA      .+10
5085         JA      #8243B
5086         JA      ZERO
5087         JA      THREE
5088
5089         TRAP3   #WRITO
5090         JA      #LIT
5091         JA      #8243A
5092         FLDA    MXSCOR
5093         TRAP3   #RSVO
5094         TRAP3   #RENDO
5095
5096         JSR     SIXOUT
5097         JA      .+10
5098         JA      #8243C
5099         JA      ZERO
5100         JA      ONE
5101
5102 /8243    FORMAT(' If you were to quit now, you would score',I4
5103 /       1       ,' out of a possible',I4,'.')
5104 /       GAVEUP=YES(143,54,54)
5105         JSR     YES
5106         JA      .+10
5107         JA      #LIT+231
5108         JA      #LIT+113
5109         JA      #LIT+113
5110         FSTA    GAVEUP
5111 /       GOTO 8185
5112         JA      #8185
5113
5114 /C
5115 /C FEE FIE FOE FOO (AND FUM). ADVANCE TO NEXT STATE IF GIVEN IN PROPER ORDER.
5116 /C LOOK UP WD1 IN SECTION 3 OF VOCAB TO DETERMINE WHICH WORD WE'VE GOT. LAST
5117 /C WORD ZIPS THE EGGS BACK TO THE GIANT ROOM (UNLESS ALREADY THERE).
5118 /C
5119 /8250    CALL VOCAB(WD1,WD1A,3,K)
5120 #8250,  JSR     VOCAB
5121         JA      .+6
5122         JA      WD1
5123         JA      THREE
5124         FSTA    K
5125 /       SPK=42
5126         LDX     52,0    /42
5127         XTA     0
5128         FSTA    SPK
5129 /       IF(FOOBAR.EQ.1-K)GOTO 8252
5130         FLDA    ONE
5131         FSUB    K
5132         FSUB    FOOBAR
5133         JEQ     #8252
5134 /       IF(FOOBAR.NE.0)SPK=151
5135         FLDA    FOOBAR
5136         JEQ     #2011
5137         LDX     227,0   /151
5138         XTA     0
5139         FSTA    SPK
5140 /       GOTO 2011
5141         JA      #2011
5142
5143 /C
5144 /8252    FOOBAR=K
5145 #8252,  FLDA    K
5146         FSTA    FOOBAR
5147 /       IF(K.NE.4)GOTO 2009
5148         FSUB    #LIT
5149         JNE     #2009
5150 /       FOOBAR=0
5151         FCLA
5152         FSTA    FOOBAR
5153 /       IF(PLACE(EGGS).EQ.PLAC(EGGS)
5154 /       1       .OR.(TOTING(EGGS).AND.LOC.EQ.PLAC(EGGS)))GOTO 2011
5155         FLDA    EGGS
5156         ATX     7
5157         FLDA    PLACE-3,7
5158         FSUB    PLAC-3,7
5159         JEQ     #2011
5160         FLDA    EGGS
5161         JSA     TOTING
5162         JEQ     #M93
5163         FLDA    LOC
5164         FSUB    PLAC-3,7
5165         JEQ     #2011
5166 /C
5167 /C BRING BACK TROLL IF WE STEAL THE EGGS BACK FROM HIM BEFORE CROSSING.
5168 /C
5169 /       IF(PLACE(EGGS).EQ.0.AND.PLACE(TROLL).EQ.0.AND.PROP(TROLL).EQ.0)
5170 /       1       PROP(TROLL)=1
5171 #M93,   FLDA    PLACE-3,7
5172         JNE     #M94
5173         FLDA    TROLL
5174         ATX     6
5175         FLDA    PLACE-3,6
5176         JNE     #M94
5177         FLDA    PROP-3,6
5178         JNE     #M94
5179         FLDA    ONE
5180         FSTA    PROP-3,6
5181 /       K=2
5182 #M94,   FLDA    TWO
5183         FSTA    K
5184 /       IF(HERE(EGGS))K=1
5185         FLDA    EGGS
5186         JSA     HERE
5187         JEQ     .+5
5188         FLDA    ONE
5189         FSTA    K
5190 /       IF(LOC.EQ.PLAC(EGGS))K=0
5191         FLDA    LOC
5192         FSUB    PLAC-3,7
5193         JNE     .+5
5194         FCLA
5195         FSTA    K
5196 /       CALL MOVE(EGGS,PLAC(EGGS))
5197         XTA     7
5198         FMUL    THREE
5199         ALN     0
5200         STARTD
5201         FADD    PPLAC
5202         FSTA    .+11
5203         STARTF
5204         JSR     MOVE
5205         JA      .+6
5206         JA      EGGS
5207         JA      .
5208 /       CALL PSPEAK(EGGS,K)
5209         JSR     PSPEAK
5210         JA      .+6
5211         JA      EGGS
5212         JA      K
5213 /       GOTO 2012
5214         JA      #2012
5215
5216 /C
5217 /C BRIEF. INTRANSITIVE ONLY. SUPPRESS LONG DESCRIPTIONS AFTER FIRST TIME.
5218 /C
5219 /8260    SPK=156
5220 #8260,  LDX     234,0   /156
5221         XTA     0
5222         FSTA    SPK
5223 /       ABBNUM=10000
5224         FLDA    #LIT+322
5225         FSTA    ABBNUM
5226 /       DETAIL=3
5227         FLDA    THREE
5228         FSTA    DETAIL
5229 /       GOTO 2011
5230         JA      #2011
5231
5232 /C
5233 /C READ. MAGAZINES IN DWARVISH, MESSAGE WE'VE SEEN, AND . . . OYSTER?
5234 /C
5235 /8270    IF(HERE(MAGZIN))OBJ=MAGZIN
5236 #8270,  FLDA    MAGZIN
5237         JSA     HERE
5238         JEQ     .+6
5239         FLDA    MAGZIN
5240         FSTA    OBJ
5241 /       IF(HERE(TABLET))OBJ=OBJ*100+TABLET
5242         FLDA    TABLET
5243         JSA     HERE
5244         JEQ     .+11
5245         FLDA    OBJ
5246         FMUL    #LIT+154
5247         FADD    TABLET
5248         FSTA    OBJ
5249 /       IF(HERE(MESSAG))OBJ=OBJ*100+MESSAG
5250         FLDA    MESSAGE
5251         JSA     HERE
5252         JEQ     .+11
5253         FLDA    OBJ
5254         FMUL    #LIT+154
5255         FADD    MESSAG
5256         FSTA    OBJ
5257 /       IF(CLOSED.AND.TOTING(OYSTER))OBJ=OYSTER
5258         FLDA    OYSTER
5259         JSA     TOTING
5260         FMUL    CLOSED
5261         JEQ     .+6
5262         FLDA    OYSTER
5263         FSTA    OBJ
5264 /       IF(OBJ.GT.100.OR.OBJ.EQ.0.OR.DARK(0))GOTO 8000
5265         FLDA    OBJ
5266         FSUB    #LIT+154
5267         JGT     #8000
5268         FLDA    OBJ
5269         JEQ     #8000
5270         JSA     DARK
5271         JNE     #8000
5272
5273 /C
5274 /9270    IF(DARK(0))GOTO 5190
5275 #9270,  JSA     DARK
5276         JNE     #5190
5277 /       IF(OBJ.EQ.MAGZIN)SPK=190
5278         FLDA    OBJ
5279         FSUB    MAGZIN
5280         JNE     .+6
5281         LDX     276,0   /190
5282         XTA     0
5283         FSTA    SPK
5284 /       IF(OBJ.EQ.TABLET)SPK=196
5285         FLDA    OBJ
5286         FSUB    TABLET
5287         JNE     .+6
5288         LDX     304,0   /196
5289         XTA     0
5290         FSTA    SPK
5291 /       IF(OBJ.EQ.MESSAG)SPK=191
5292         FLDA    OBJ
5293         FSUB    MESSAG
5294         JNE     .+6
5295         LDX     277,0   /191
5296         XTA     0
5297         FSTA    SPK
5298 /       IF(OBJ.EQ.OYSTER.AND.HINTED(2).AND.TOTING(OYSTER))SPK=194
5299         FLDA    OBJ
5300         FSUB    OYSTER
5301         JNE     #M95
5302         FLDA    TWO
5303         ATX     7
5304         FLDA    HINTED-3,7
5305         JEQ     #M95
5306         FLDA    OYSTER
5307         JSA     TOTING
5308         JEQ     .+6
5309         LDX     302,0   /194
5310         XTA     0
5311         FSTA    SPK
5312 /       IF(OBJ.NE.OYSTER.OR.HINTED(2).OR..NOT.TOTING(OYSTER)
5313 /       1       .OR..NOT.CLOSED)GOTO 2011
5314 #M95,   FLDA    OBJ
5315         FSUB    OYSTER
5316         JNE     #2011
5317         FLDA    HINTED-3,7
5318         JNE     #2011
5319         FLDA    OYSTER
5320         JSA     TOTING
5321         JEQ     #2011
5322         FLDA    CLOSED
5323         JEQ     #2011
5324 /       HINTED(2)=YES(192,193,54)
5325         FLDA    TWO
5326         ATX     7
5327         JSR     YES
5328         JA      .+10
5329         JA      #LIT+267
5330         JA      #LIT+272
5331         JA      #LIT+113
5332         FSTA    HINTED-3,7
5333 /       GOTO 2012
5334         JA      #2012
5335
5336 /C
5337 /C BREAK. ONLY WORKS FOR MIRROR IN REPOSITORY AND, OF COURSE, THE VASE.
5338 /C
5339 /9280    IF(OBJ.EQ.MIRROR)SPK=148
5340 #9280,  FLDA    OBJ
5341         FSUB    MIRROR
5342         JNE     .+6
5343         LDX     224,0   /148
5344         XTA     0
5345         FSTA    SPK
5346 /       IF(OBJ.EQ.VASE.AND.PROP(VASE).EQ.0)GOTO 9282
5347         FLDA    OBJ
5348         FSUB    VASE
5349         JNE     #M96
5350         FLDA    VASE
5351         ATX     7
5352         FLDA    PROP-3,7
5353         JEQ     #9282
5354 /       IF(OBJ.NE.MIRROR.OR..NOT.CLOSED)GOTO 2011
5355 #M96,   FLDA    OBJ
5356         FSUB    MIRROR
5357         JNE     #2011
5358         FLDA    CLOSED
5359         JEQ     #2011
5360 /       CALL RSPEAK(197)
5361         JSR     RSPEAK
5362 /       GOTO 19000
5363         JA      #19000
5364         JA      #LIT+275
5365
5366 /C
5367 /9282    SPK=198
5368 #9282,  LDX     306,0   /198
5369         XTA     0
5370         FSTA    SPK
5371 /       IF(TOTING(VASE))CALL DROP(VASE,LOC)
5372         FLDA    VASE
5373         JSA     TOTING
5374         JEQ     .+12
5375         JSR     DROP
5376         JA      .+6
5377         JA      VASE
5378         JA      LOC
5379 /       PROP(VASE)=2
5380         FLDA    VASE
5381         ATX     7
5382         FLDA    TWO
5383         FSTA    PROP-3,7
5384 /       FIXED(VASE)=-1
5385         FLDA    MINUS1
5386         FSTA    FIXED-3,7
5387 /       GOTO 2011
5388         JA      #2011
5389
5390 /C
5391 /C WAKE. ONLY USE IS TO DISTURB THE DWARVES.
5392 /C
5393 /9290    IF(OBJ.NE.DWARF.OR..NOT.CLOSED)GOTO 2011
5394 #9290,  FLDA    OBJ
5395         FSUB    DWARF
5396         JNE     #2011
5397         FLDA    CLOSED
5398         JEQ     #2011
5399 /       CALL RSPEAK(199)
5400         JSR     RSPEAK
5401 /       GOTO 19000
5402         JA      #19000
5403         JA      #LIT+300
5404
5405 /C
5406 /C SUSPEND. SAVE THE WORLD.
5407 /C
5408 /8300    CALL SAVEGM(.TRUE.,I)
5409 /       GOTO 2012
5410 #8300,  JSR     SAVEGM
5411         JA      #2012
5412         JA      ONE
5413         JA      I
5414
5415 /C
5416 /C HOURS. JUST A JOKE.
5417 /C
5418 /8310    CALL RSPEAK(201)
5419 #8310,  JSR     RSPEAK
5420 /       GOTO 2012
5421         JA      #2012
5422         JA      #LIT+303
5423
5424 /C
5425 /C RESUME. RESTORE THE WORLD.
5426 /C
5427 /8320    CALL RSTRGM(.TRUE.,I)
5428 /       GO TO 2012
5429
5430 #8320,  JSR RSTRGM
5431         JA      #2012
5432         JA      ONE
5433         JA      I
5434
5435
5436 /C HINTS
5437 /C
5438 /C COME HERE IF HE'S BEEN LONG ENOUGH AT REQUIRED LOC(S) FOR SOME UNUSED HINT.
5439 /C HINT NUMBER IS IN VARIABLE "HINT". BRANCH TO QUICK TEST FOR ADDITIONAL
5440 /C CONDITIONS, THEN COME BACK TO DO NEAT STUFF. GOTO 40010 IF CONDITIONS ARE
5441 /C MET AND WE WANT TO OFFER THE HINT. GOTO 40020 TO CLEAR HINTLC BACK TO ZERO,
5442 /C 40030 TO TAKE NO ACTION YET.
5443 /C
5444 /40000   GOTO (40400,40500,40600,40700,40800,40900)(HINT-3)
5445 /C             CAVE  BIRD  SNAKE MAZE  DARK  WITT
5446 #40000, FLDA    HINT
5447         FSUB    THREE
5448         ATX     1
5449         STARTD
5450         FLDA    .+2,1
5451         STARTF
5452         JAC
5453         JA      #40400
5454         JA      #40500
5455         JA      #40600
5456         JA      #40700
5457         JA      #40800
5458         JA      #40010
5459 /       CALL BUG(27)
5460         JSR     BUG
5461         JA      .+4
5462         JA      #LIT+60
5463 /C
5464 /40010   HINTLC(HINT)=0
5465 #40010, FLDA    HINT
5466         ATX     7
5467         FCLA
5468         FSTA    HINTLC-3,7
5469 /       IF(.NOT.YES(HINTS(HINT,3),0,54))GOTO 2602
5470         FLDA    #LIT+377
5471         FADD    HINT
5472         ATX     7
5473         XTA     7
5474         FMUL    THREE
5475         ALN     0
5476         STARTD
5477         FADD    PHINTS
5478         FSTA    .+7
5479         STARTF
5480         JSR     YES
5481         JA      .+10
5482         JA      .
5483         JA      ZERO
5484         JA      #LIT+113
5485         JEQ     #2602
5486 /       TYPE 40012,HINTS(HINT,2)
5487         JSR     SIXOUT
5488         JA      .+10
5489         JA      #40012
5490         JA      ZERO
5491         JA      TWO
5492
5493         TRAP3   #WRITO
5494         JA      #LIT
5495         JA      #4001A
5496         FLDA    TWO
5497         FMUL    #LIT+36
5498         FADD    HINT
5499         ATX     7
5500         FLDA    HINTS-0077,7
5501         TRAP3   #RSVO
5502         TRAP3   #RENDO
5503
5504         JSR     SIXOUT
5505         JA      .+10
5506         JA      #4001B
5507         JA      ZERO
5508         JA      ONE
5509 /40012   FORMAT(' I am prepared to give you a hint, but it will cost you',
5510 /       1       I2,' points.')
5511
5512 /       HINTED(HINT)=YES(175,HINTS(HINT,4),54)
5513         FLDA    HINT
5514         ATX     7
5515         FLDA    #LIT
5516         FMUL    #LIT+36
5517         FADD    HINT
5518         ATX     6
5519         XTA     6
5520         FMUL    THREE
5521         ALN     0
5522         STARTD
5523         FADD    PHINTS
5524         FSTA    .+11
5525         STARTF
5526         JSR     YES
5527         JA      .+10
5528         JA      #LIT+250
5529         JA      .
5530         JA      #LIT+113
5531         FSTA    HINTED-3,7
5532 /       IF(HINTED(HINT).AND.LIMIT.GT.30)LIMIT=LIMIT+30*HINTS(HINT,2)
5533         JEQ     #40020
5534         FLDA    LIMIT
5535         FSUB    #LIT+63
5536         JLE     #40020
5537         FLDA    TWO
5538         FMUL    #LIT+36
5539         FADD    HINT
5540         ATX     6
5541         FLDA    #LIT+63
5542         FMUL    HINTS-0077,6
5543         FADD    LIMIT
5544         FSTA    LIMIT
5545 /40020   HINTLC(HINT)=0
5546 #40020, FLDA    HINT
5547         ATX     7
5548         FCLA
5549         FSTA    HINTLC-3,7
5550 /40030   GOTO 2602
5551 #40030, JA      #2602
5552
5553 /C
5554 /C NOW FOR THE QUICK TESTS. SEE DATABASE DESCRIPTION FOR ONE-LINE NOTES.
5555 /C
5556 /40400   IF(PROP(GRATE).EQ.0.AND..NOT.HERE(KEYS))GOTO 40010
5557 #40400, FLDA    GRATE
5558         ATX     7
5559         FLDA    PROP-3,7
5560         JNE     #40020
5561         FLDA    KEYS
5562         JSA     HERE
5563         JEQ     #40010
5564 /       GOTO 40020
5565         JA      #40020
5566
5567 /40500   IF(HERE(BIRD).AND.TOTING(ROD).AND.OBJ.EQ.BIRD)GOTO 40010
5568 #40500, FLDA    BIRD
5569         JSA     HERE
5570         JEQ     #2602
5571         FLDA    ROD
5572         JSA     TOTING
5573         JEQ     #2602
5574         FLDA    OBJ
5575         JEQ     #40010
5576         FSUB    BIRD
5577         JEQ     #40010
5578 /       GOTO 40030
5579         JA      #2602
5580
5581 /C
5582 /40600   IF(HERE(SNAKE).AND..NOT.HERE(BIRD))GOTO 40010
5583 #40600, FLDA    SNAKE
5584         JSA     HERE
5585         JEQ     #40020
5586         FLDA    BIRD
5587         JSA     HERE
5588         JEQ     #40010
5589 /       GOTO 40020
5590         JA      #40020
5591
5592 /C
5593 /40700   IF(ATLOC(LOC).EQ.0.AND.ATLOC(OLDLOC).EQ.0
5594 /       1       .AND.ATLOC(OLDLC2).EQ.0.AND.HOLDNG.GT.1)GOTO 40010
5595 #40700, FLDA    LOC
5596         ATX     7
5597         FLDA    ATLOC-3,7
5598         JNE     #40020
5599         FLDA    OLDLOC
5600         ATX     6
5601         FLDA    ATLOC-3,6
5602         JNE     #40020
5603         FLDA    OLDLC2
5604         ATX     5
5605         FLDA    ATLOC-3,5
5606         JNE     #40020
5607         FLDA    HOLDNG
5608         FSUB    ONE
5609         JGT     #40010
5610 /       GOTO 40020
5611         JA      #40020
5612
5613 /C
5614 /40800   IF(PROP(EMRALD).NE.-1.AND.PROP(PYRAM).EQ.-1)GOTO 40010
5615 /       GOTO 40020
5616 #40800, FLDA    EMRALD
5617         ATX     7
5618         FLDA    MINUS1
5619         FSUB    PROP-3,7
5620         JEQ     #40020
5621         FLDA    PYRAM
5622         ATX     6
5623         FLDA    MINUS1
5624         FSUB    PROP-3,6
5625         JEQ     #40010
5626 /       GOTO 40020
5627         JA      #40020
5628 /C
5629 /40900  JA      #40010
5630 /#40900 JA      40010
5631
5632 /C CAVE CLOSING AND SCORING
5633 /C
5634 /C
5635 /C THESE SECTIONS HANDLE THE CLOSING OF THE CAVE. THE CAVE CLOSES "CLOCK1"
5636 /C TURNS AFTER THE LAST TREASURE HAS BEEN LOCATED (INCLUDING THE PIRATE'S
5637 /C CHEST, WHICH MAY OF COURSE NEVER SHOW UP). NOTE THAT THE TREASURES NEED NOT
5638 /C HAVE BEEN TAKEN YET, JUST LOCATED. HENCE CLOCK1 MUST BE LARGE ENOUGH TO GET
5639 /C OUT OF THE CAVE (IT ONLY TICKS WHILE INSIDE THE CAVE). WHEN IT HITS ZERO,
5640 /C WE BRANCH TO 10000 TO START CLOSING THE CAVE, AND THEN SIT BACK AND WAIT FOR
5641 /C HIM TO TRY TO GET OUT. IF HE DOESN'T WITHIN CLOCK2 TURNS, WE CLOSE THE
5642 /C CAVE; IF HE DOES TRY, WE ASSUME HE PANICS, AND GIVE HIM A FEW ADDITIONAL
5643 /C TURNS TO GET FRANTIC BEFORE WE CLOSE. WHEN CLOCK2 HITS ZERO, WE BRANCH TO
5644 /C 11000 TO TRANSPORT HIM INTO THE FINAL PUZZLE. NOTE THAT THE PUZZLE DEPENDS
5645 /C UPON ALL SORTS OF RANDOM THINGS. FOR INSTANCE, THERE MUST BE NO WATER OR
5646 /C OIL, SINCE THERE ARE BEANSTALKS WHICH WE DON'T WANT TO BE ABLE TO WATER,
5647 /C SINCE THE CODE CAN'T HANDLE IT. ALSO, WE CAN HAVE NO KEYS, SINCE THERE IS A
5648 /C GRATE (HAVING MOVED THE FIXED OBJECT!) THERE SEPARATING HIM FROM ALL THE
5649 /C TREASURES. MOST OF THESE PROBLEMS ARISE FROM THE USE OF NEGATIVE PROP
5650 /C NUMBERS TO SUPPRESS THE OBJECT DESCRIPTIONS UNTIL HE'S ACTUALLY MOVED THE
5651 /C OBJECTS.
5652 /C
5653 /C WHEN THE FIRST WARNING COMES, WE LOCK THE GRATE, DESTROY THE BRIDGE, KILL
5654 /C ALL THE DWARVES (AND THE PIRATE), REMOVE THE TROLL AND BEAR (UNLESS DEAD),
5655 /C AND SET "CLOSNG" TO TRUE. LEAVE THE DRAGON; TOO MUCH TROUBLE TO MOVE IT.
5656 /C FROM NOW UNTIL CLOCK2 RUNS OUT, HE CANNOT UNLOCK THE GRATE, MOVE TO ANY
5657 /C LOCATION OUTSIDE THE CAVE (LOC<9), OR CREATE THE BRIDGE. NOR CAN HE BE
5658 /C RESURRECTED IF HE DIES. NOTE THAT THE SNAKE IS ALREADY GONE, SINCE HE GOT
5659 /C TO THE TREASURE ACCESSIBLE ONLY VIA THE HALL OF THE MT. KING. ALSO, HE'S
5660 /C BEEN IN GIANT ROOM (TO GET EGGS), SO WE CAN REFER TO IT. ALSO ALSO, HE'S
5661 /C GOTTEN THE PEARL, SO WE KNOW THE BIVALVE IS AN OYSTER. *AND*, THE DWARVES
5662 /C MUST HAVE BEEN ACTIVATED, SINCE WE'VE FOUND CHEST.
5663 /C
5664 /10000   PROP(GRATE)=0
5665 #10000, FLDA    GRATE
5666         ATX     7
5667         FCLA
5668         FSTA    PROP-3,7
5669 /       PROP(FISSUR)=0
5670         FLDA    FISSUR
5671         ATX     7
5672         FCLA
5673         FSTA    PROP-3,7
5674 /       DO 10010 I=1,6
5675         FLDA    ONE
5676         FSTA    I
5677
5678 /       DSEEN(I)=.FALSE.
5679 #H0204, FLDA    I
5680         ATX     7
5681         FCLA
5682         FSTA    DSEEN-3,7
5683 /10010   DLOC(I)=0
5684 /#10010,        FLDA    I
5685 /       ATX     7
5686 /       FCLA
5687         FSTA    DLOC-3,7
5688         FLDA    I
5689         FADD    ONE
5690         FSTA    I
5691         FSUB    #LIT+6
5692         JLE     #H0204
5693 /       CALL MOVE(TROLL,0)
5694         JSR     MOVE
5695         JA      .+6
5696         JA      TROLL
5697         JA      ZERO
5698 /       CALL MOVE(TROLL+100,0)
5699         FLDA    TROLL
5700         FADD    #LIT+154
5701         FSTA    #TMP
5702         JSR     MOVE
5703         JA      .+6
5704         JA      #TMP
5705         JA      ZERO
5706 /       CALL MOVE(TROLL2,PLAC(TROLL))
5707         FLDA    TROLL
5708         ATX     7
5709         XTA     7
5710         FMUL    THREE
5711         ALN     0
5712         STARTD
5713         FADD    PPLAC
5714         FSTA    .+11
5715         STARTF
5716         JSR     MOVE
5717         JA      .+6
5718         JA      TROLL2
5719         JA      .
5720 /       CALL MOVE(TROLL2+100,FIXD(TROLL))
5721         FLDA    TROLL2
5722         FADD    #LIT+154
5723         FSTA    #TMP
5724         FLDA    TROLL
5725         ATX     7
5726         XTA     7
5727         FMUL    THREE
5728         ALN     0
5729         STARTD
5730         FADD    PFIXD
5731         FSTA    .+11
5732         STARTF
5733         JSR     MOVE
5734         JA      .+6
5735         JA      #TMP
5736         JA      .
5737 /       CALL JUGGLE(CHASM)
5738         JSR     JUGGLE
5739         JA      .+4
5740         JA      CHASM
5741 /       IF(PROP(BEAR).NE.3)CALL DSTROY(BEAR)
5742         FLDA    BEAR
5743         ATX     7
5744         FLDA    PROP-3,7
5745         FSUB    THREE
5746         JEQ     .+10
5747         JSR     DSTROY
5748         JA      .+4
5749         JA      BEAR
5750 /       PROP(CHAIN)=0
5751         FLDA    CHAIN
5752         ATX     7
5753         FCLA
5754         FSTA    PROP-3,7
5755 /       FIXED(CHAIN)=0
5756 /       PROP(AXE)=0
5757         FLDA    AXE
5758         ATX     7
5759         FCLA
5760         FSTA    PROP-3,7
5761 /       FIXED(AXE)=0
5762         FSTA    FIXED-3,7
5763 /       CALL RSPEAK(129)
5764         JSR     RSPEAK
5765         JA      .+4
5766         JA      #LIT+204
5767 /       CLOCK1=-1
5768         FLDA    MINUS1
5769         FSTA    CLOCK1
5770 /       CLOSNG=.TRUE.
5771         FLDA    ONE
5772         FSTA    CLOSNG
5773 /       GOTO 19999
5774         JA      #19999
5775
5776 /C
5777 /C ONCE HE'S PANICKED, AND CLOCK2 HAS RUN OUT, WE COME HERE TO SET UP THE
5778 /C STORAGE ROOM. THE ROOM HAS TWO LOCS, HARDWIRED AS 115 (NE) AND 116 (SW).
5779 /C AT THE NE END, WE PLACE EMPTY BOTTLES, A NURSERY OF PLANTS, A BED OF
5780 /C OYSTERS, A PILE OF LAMPS, RODS WITH STARS, SLEEPING DWARVES, AND HIM. AND
5781 /C THE SW END WE PLACE GRATE OVER TREASURES, SNAKE PIT, COVEY OF CAGED BIRDS,
5782 /C MORE RODS, AND PILLOWS. A MIRROR STRETCHES ACROSS ONE WALL. MANY OF THE
5783 /C OBJECTS COME FROM KNOWN LOCATIONS AND/OR STATES (E.G. THE SNAKE IS KNOWN TO
5784 /C HAVE BEEN DESTROYED AND NEEDN'T BE CARRIED AWAY FROM ITS OLD "PLACE"),
5785 /C MAKING THE VARIOUS OBJECTS BE HANDLED DIFFERENTLY. WE ALSO DROP ALL OTHER
5786 /C OBJECTS HE MIGHT BE CARRYING (LEST HE HAVE SOME WHICH COULD CAUSE TROUBLE,
5787 /C SUCH AS THE KEYS). WE DESCRIBE THE FLASH OF LIGHT AND TRUNDLE BACK.
5788 /C
5789 /11000   PROP(BOTTLE)=PUT(BOTTLE,115,1)
5790 #11000, FLDA    BOTTLE
5791         ATX     7
5792         JSR     PUT
5793         JA      .+10
5794         JA      BOTTLE
5795         JA      #LIT+165
5796         JA      ONE
5797         FSTA    PROP-3,7
5798 /       PROP(PLANT)=PUT(PLANT,115,0)
5799         FLDA    PLANT
5800         ATX     7
5801         JSR     PUT
5802         JA      .+10
5803         JA      PLANT
5804         JA      #LIT+165
5805         JA      ZERO
5806         FSTA    PROP-3,7
5807 /       PROP(OYSTER)=PUT(OYSTER,115,0)
5808         FLDA    OYSTER
5809         ATX     7
5810         JSR     PUT
5811         JA      .+10
5812         JA      OYSTER
5813         JA      #LIT+165
5814         JA      ZERO
5815         FSTA    PROP-3,7
5816 /       PROP(LAMP)=PUT(LAMP,115,0)
5817         FLDA    LAMP
5818         ATX     7
5819         JSR     PUT
5820         JA      .+10
5821         JA      LAMP
5822         JA      #LIT+165
5823         JA      ZERO
5824         FSTA    PROP-3,7
5825 /       PROP(ROD)=PUT(ROD,115,0)
5826         FLDA    ROD
5827         ATX     7
5828         JSR     PUT
5829         JA      .+10
5830         JA      ROD
5831         JA      #LIT+165
5832         JA      ZERO
5833         FSTA    PROP-3,7
5834 /       PROP(DWARF)=PUT(DWARF,115,0)
5835         FLDA    DWARF
5836         ATX     7
5837         JSR     PUT
5838         JA      .+10
5839         JA      DWARF
5840         JA      #LIT+165
5841         JA      ZERO
5842         FSTA    PROP-3,7
5843 /       LOC=115
5844 /       OLDLOC=115
5845 /       NEWLOC=115
5846         FLDA    #LIT+165
5847         FSTA    LOC
5848         FSTA    OLDLOC
5849         FSTA    NEWLOC
5850 /C
5851 /C LEAVE THE GRATE WITH NORMAL (NON-NEGATIVE PROPERTY).
5852 /C
5853 /       I=PUT(GRATE,116,0)
5854         JSR     PUT
5855         JA      .+10
5856         JA      GRATE
5857         JA      #LIT+170
5858         JA      ZERO
5859         FSTA    I
5860 /       PROP(SNAKE)=PUT(SNAKE,116,1)
5861         FLDA    SNAKE
5862         ATX     7
5863         JSR     PUT
5864         JA      .+10
5865         JA      SNAKE
5866         JA      #LIT+170
5867         JA      ONE
5868         FSTA    PROP-3,7
5869 /       PROP(BIRD)=PUT(BIRD,116,1)
5870         FLDA    BIRD
5871         ATX     7
5872         JSR     PUT
5873         JA      .+10
5874         JA      BIRD
5875         JA      #LIT+170
5876         JA      ONE
5877         FSTA    PROP-3,7
5878 /       PROP(CAGE)=PUT(CAGE,116,0)
5879         FLDA    CAGE
5880         ATX     7
5881         JSR     PUT
5882         JA      .+10
5883         JA      CAGE
5884         JA      #LIT+170
5885         JA      ZERO
5886         FSTA    PROP-3,7
5887 /       PROP(ROD2)=PUT(ROD2,116,0)
5888         FLDA    ROD2
5889         ATX     7
5890         JSR     PUT
5891         JA      .+10
5892         JA      ROD2
5893         JA      #LIT+170
5894         JA      MINUS1
5895         FSTA    PROP-3,7
5896 /       PROP(PILLOW)=PUT(PILLOW,116,0)
5897         FLDA    PILLOW
5898         ATX     7
5899         JSR     PUT
5900         JA      .+10
5901         JA      PILLOW
5902         JA      #LIT+170
5903         JA      ZERO
5904         FSTA    PROP-3,7
5905 /C
5906 /       PROP(MIRROR)=PUT(MIRROR,115,0)
5907         FLDA    MIRROR
5908         ATX     7
5909         JSR     PUT
5910         JA      .+10
5911         JA      MIRROR
5912         JA      #LIT+165
5913         JA      ZERO
5914         FSTA    PROP-3,7
5915 /       FIXED(MIRROR)=116
5916         FLDA    #LIT+170
5917         FSTA    FIXED-3,7
5918 /C
5919 /       DO 11010 I=1,100
5920         FLDA    ONE
5921         FSTA    I
5922
5923 /11010   IF(TOTING(I))CALL DSTROY(I)
5924 #11010, FLDA    I
5925         JSA     TOTING
5926         JEQ     .+10
5927         JSR     DSTROY
5928         JA      .+4
5929         JA      I
5930         FLDA    I
5931         FADD    ONE
5932         FSTA    I
5933         FSUB    #LIT+154
5934         JLE     #11010
5935 /C
5936 /       CALL RSPEAK(132)
5937         JSR     RSPEAK
5938         JA      .+4
5939         JA      #LIT+215
5940 /       CLOSED=.TRUE.
5941         FLDA    ONE
5942         FSTA    CLOSED
5943 /       GOTO 2
5944         JA      #2
5945
5946 /C
5947 /C ANOTHER WAY WE CAN FORCE AN END TO THINGS IS BY HAVING THE LAMP GIVE OUT.
5948 /C WHEN IT GETS CLOSE, WE COME HERE TO WARN HIM. WE GO TO 12000 IF THE LAMP
5949 /C AND FRESH BATTERIES ARE HERE, IN WHICH CASE WE REPLACE THE BATTERIES AND
5950 /C CONTINUE. 12200 IS FOR OTHER CASES OF LAMP DYING.12400 IS WHEN IT GOES
5951 /C OUT, AND 12600 IS IF HE'S WANDERED OUTSIDE AND THE LAMP IS USED UP, IN WHICH
5952 /C CASE WE FORCE HIM TO GIVE UP.
5953 /C
5954 /12000   CALL RSPEAK(188)
5955 #12000, JSR     RSPEAK
5956         JA      .+4
5957         JA      #LIT+264
5958 /       PROP(BATTER)=1
5959         FLDA    BATTER
5960         ATX     7
5961         FLDA    ONE
5962         FSTA    PROP-3,7
5963 /       IF(TOTING(BATTER))CALL DROP(BATTER,LOC)
5964         FLDA    BATTER
5965         JSA     TOTING
5966         JEQ     .+12
5967         JSR     DROP
5968         JA      .+6
5969         JA      BATTER
5970         JA      LOC
5971 /       LIMIT=LIMIT+2500
5972         FLDA    #LIT+317
5973         FADDM   LIMIT
5974 /       LMWARN=.FALSE.
5975         FCLA
5976         FSTA    LMWARN
5977 /       GOTO 19999
5978         JA      #19999
5979
5980 /C
5981 /12200   IF(LMWARN.OR..NOT.HERE(LAMP))GOTO 19999
5982 #12200, FLDA    LAMP
5983         JSA     HERE
5984         JEQ     #19999
5985         FLDA    LMWARN
5986         JNE     #19999
5987 /       LMWARN=.TRUE.
5988         FLDA    ONE
5989         FSTA    LMWARN
5990 /       SPK=187
5991         LDX     273,0   /187
5992         XTA     0
5993         FSTA    SPK
5994 /       IF(PLACE(BATTER).EQ.0)SPK=183
5995         FLDA    BATTER
5996         ATX     7
5997         FLDA    PLACE-3,7
5998         JNE     .+6
5999         LDX     267,0   /183
6000         XTA     0
6001         FSTA    SPK
6002 /       IF(PROP(BATTER).EQ.1)SPK=189
6003         FLDA    PROP-3,7
6004         FSUB    ONE
6005         JNE     .+6
6006         LDX     275,0   /189
6007         XTA     0
6008         FSTA    SPK
6009 /       CALL RSPEAK(SPK)
6010 #H0214, JSR     RSPEAK
6011         JA      #19999
6012         JA      SPK
6013 /       GOTO 19999
6014
6015 /C
6016 /12400   LIMIT=-1
6017 #12400, FLDA    MINUS1
6018         FSTA    LIMIT
6019 /       PROP(LAMP)=0
6020         FLDA    LAMP
6021         ATX     7
6022         FCLA
6023         FSTA    PROP-3,7
6024 /       IF(HERE(LAMP))CALL RSPEAK(184)
6025         FLDA    LAMP
6026         JSA     HERE
6027 /       GOTO 19999
6028         JEQ     #19999
6029         JSR     RSPEAK
6030         JA      #19999
6031         JA      #LIT+253
6032
6033 /C
6034 /12600   CALL RSPEAK(185)
6035 #12600, JSR     RSPEAK
6036         JA      .+4
6037         JA      #LIT+256
6038 /       GAVEUP=.TRUE.
6039         FLDA    ONE
6040         FSTA    GAVEUP
6041 /       GOTO 20000
6042         JA      #20000
6043
6044 /C
6045 /C
6046 /C OH DEAR, HE'S DISTURBED THE DWARVES.
6047 /C
6048 /19000   CALL RSPEAK(136)
6049 #19000, JSR     RSPEAK
6050         JA      .+4
6051         JA      #LIT+220
6052
6053 /C
6054 /C EXIT CODE. WILL EVENTUALLY INCLUDE SCORING. FOR NOW, HOWEVER, ...
6055 /C
6056 /C THE PRESENT SCORING ALGORITHM IS AS FOLLOWS:
6057 /C     OBJECTIVE:          POINTS:        PRESENT TOTAL POSSIBLE:
6058 /C  GETTING WELL INTO CAVE   25                    25
6059 /C  EACH TREASURE < CHEST    12                    60
6060 /C  TREASURE CHEST ITSELF    14                    14
6061 /C  EACH TREASURE > CHEST    16                   144
6062 /C  SURVIVING             (MAX-NUM)*10             30
6063 /C  NOT QUITTING              4                     4
6064 /C  REACHING "CLOSNG"        25                    25
6065 /C  "CLOSED": QUIT/KILLED    10
6066 /C            KLUTZED        25
6067 /C            WRONG WAY      30
6068 /C            SUCCESS        45                    45
6069 /C  CAME TO WITT'S END        1                     1
6070 /C  ROUND OUT THE TOTAL       2                     2
6071 /C                                       TOTAL:   350
6072 /20000   SCORE=0
6073 #20000, FCLA
6074         FSTA    SCORE
6075 /       MXSCOR=0
6076         FSTA    MXSCOR
6077 /C
6078 /C FIRST TALLY UP THE TREASURES. MUST BE IN BUILDING AND NOT BROKEN.
6079 /C GIVE THE POOR GUY 2 POINTS JUST FOR FINDING EACH TREASURE.
6080 /C
6081 /       DO 20010 I=50,MAXTRS
6082         FLDA    #LIT+110
6083         FSTA    I
6084
6085 /       IF(PTEXT(I).EQ.0)GOTO 20010
6086 #H0216, FLDA    I
6087         ATX     7
6088         FLDA    PTEXT-3,7
6089         JEQ     #20010
6090 /       K=12
6091         FLDA    #LIT+22
6092         FSTA    K
6093 /       IF(I.EQ.CHEST)K=14
6094         FLDA    I
6095         FSUB    CHEST
6096         JNE     .+7
6097         LDX     16,0    /14
6098         XTA     0
6099         FSTA    K
6100 /       IF(I.GT.CHEST)K=16
6101         FLDA    I
6102         FSUB    CHEST
6103         JLE     .+5
6104         FLDA    #LIT+30
6105         FSTA    K
6106 /       IF(PROP(I).GE.0)SCORE=SCORE+2
6107         FLDA    PROP-3,7
6108         JLT     .+5
6109         FLDA    TWO
6110         FADDM   SCORE
6111 /       IF(PLACE(I).EQ.3.AND.PROP(I).EQ.0)SCORE=SCORE+K-2
6112         FLDA    PLACE-3,7
6113         FSUB    THREE
6114         JNE     #M100
6115         FLDA    PROP-3,7
6116         JNE     #M100
6117         FLDA    SCORE
6118         FADD    K
6119         FSUB    TWO
6120         FSTA    SCORE
6121 /       MXSCOR=MXSCOR+K
6122 #M100,  FLDA    K
6123         FADDM   MXSCOR
6124
6125 /20010   CONTINUE
6126 #20010, FLDA    I
6127         FADD    ONE
6128         FSTA    I
6129         FSUB    MAXTRS
6130         JLE     #H0216
6131 /C
6132 /C NOW LOOK AT HOW HE FINISHED AND HOW FAR HE GOT. MAXDIE AND NUMDIE TELL US
6133 /C HOW WELL HE SURVIVED. GAVEUP SAYS WHETHER HE EXITED VIA QUIT. DFLAG WILL
6134 /C TELL US IF HE EVER GOT SUITABLY DEEP INTO THE CAVE. CLOSNG STILL INDICATES
6135 /C WHETHER HE REACHED THE ENDGAME. AND IF HE GOT AS FAR AS "CAVE CLOSED"
6136 /C (INDICATED BY "CLOSED"), THEN BONUS IS ZERO FOR MUNDANE EXITS OR 133, 134,
6137 /C 135 IF HE BLEW IT (SO TO SPEAK).
6138 /C
6139 /       SCORE=SCORE+(MAXDIE-NUMDIE)*10
6140         FLDA    MAXDIE
6141         FSUB    NUMDIE
6142         FMUL    #LIT+17
6143         FADDM   SCORE
6144 /       MXSCOR=MXSCOR+MAXDIE*10
6145         FLDA    MAXDIE
6146         FMUL    #LIT+17
6147         FADDM   MXSCOR
6148 /       IF(.NOT.(SCORNG.OR.GAVEUP))SCORE=SCORE+4
6149         FLDA    SCORNG
6150         FADD    GAVEUP
6151         JNE     .+5
6152         FLDA    #LIT
6153         FADDM   SCORE
6154 /       MXSCOR=MXSCOR+4
6155         FLDA    #LIT
6156         FADDM   MXSCOR
6157 \f
6158 /       IF(DFLAG.NE.0)SCORE=SCORE+25
6159         FLDA    DFLAG
6160         JEQ     .+5
6161         FLDA    #LIT+52
6162         FADDM   SCORE
6163 /       MXSCOR=MXSCOR+25
6164         FLDA    #LIT+52
6165         FADDM   MXSCOR
6166 /       IF(CLOSNG)SCORE=SCORE+25
6167         FLDA    CLOSNG
6168         JEQ     .+5
6169         FLDA    #LIT+52
6170         FADDM   SCORE
6171 /       MXSCOR=MXSCOR+25
6172         FLDA    #LIT+52
6173         FADDM   MXSCOR
6174 /       IF(.NOT.CLOSED)GOTO 20020
6175         FLDA    CLOSED
6176         JEQ     #20020
6177 /       IF(BONUS.EQ.0)SCORE=SCORE+10
6178         FLDA    BONUS
6179         JNE     .+5
6180         FLDA    #LIT+17
6181         FADDM   SCORE
6182 /       IF(BONUS.EQ.135)SCORE=SCORE+25
6183         LDX     207,0   /135
6184         XTA     0
6185         FSUB    BONUS
6186         JNE     .+5
6187         FLDA    #LIT+52
6188         FADDM   SCORE
6189 /       IF(BONUS.EQ.134)SCORE=SCORE+30
6190         LDX     206,0   /134
6191         XTA     0
6192         FSUB    BONUS
6193         JNE     .+5
6194         FLDA    #LIT+63
6195         FADDM   SCORE
6196 /       IF(BONUS.EQ.133)SCORE=SCORE+45
6197         LDX     205,0   /133
6198         XTA     0
6199         FSUB    BONUS
6200         JNE     #20020
6201         FLDA    #LIT+102
6202         FADDM   SCORE
6203 /20020   MXSCOR=MXSCOR+45
6204 #20020, FLDA    #LIT+102
6205         FADDM   MXSCOR
6206 /C
6207 /C DID HE COME TO WITT'S END AS HE SHOULD?
6208 /C
6209 /       IF(PLACE(MAGZIN).EQ.108)SCORE=SCORE+1
6210         FLDA    MAGZIN
6211         ATX     7
6212         LDX     154,0   /108
6213         XTA     0
6214         FSUB    PLACE-3,7
6215         JNE     .+5
6216         FLDA    ONE
6217         FADDM   SCORE
6218 /       MXSCOR=MXSCOR+1
6219         FLDA    ONE
6220         FADDM   MXSCOR
6221 /C
6222 /C ROUND IT OFF.
6223 /C
6224 /       SCORE=SCORE+2
6225         FLDA    TWO
6226         FADDM   SCORE
6227 /       MXSCOR=MXSCOR+2
6228         FADDM   MXSCOR
6229 /C
6230 /C DEDUCT POINTS FOR HINTS. HINTS < 4 ARE SPECIAL; SEE DATABASE DESCRIPTION.
6231 /C
6232 /       DO 20030 I=1,HNTMAX
6233         FLDA    ONE
6234         FSTA    I
6235
6236 /20030   IF(HINTED(I))SCORE=SCORE-HINTS(I,2)
6237 #20030, FLDA    I
6238         ATX     7
6239         FLDA    HINTED-3,7
6240         JEQ     .+15
6241         FLDA    TWO
6242         FMUL    #LIT+36
6243         FADD    I
6244         ATX     6
6245         FLDA    SCORE
6246         FSUB    HINTS-0077,6
6247         FSTA    SCORE
6248
6249         FLDA    I
6250         FADD    ONE
6251         FSTA    I
6252         FSUB    HNTMAX
6253         JLE     #20030
6254 /C
6255 /C RETURN TO SCORE COMMAND IF THAT'S WHERE WE CAME FROM.
6256 /C
6257 /       IF(SCORNG)GOTO 8241
6258         FLDA    SCORNG
6259         JNE     #8241
6260 /C
6261 /C THAT SHOULD BE GOOD ENOUGH. LET'S TELL HIM ALL ABOUT IT.
6262 /C
6263 /       TYPE 20100,SCORE,MXSCOR,TURNS
6264         JSR     SIXOUT
6265         JA      .+10
6266         JA      #20100
6267         JA      ZERO
6268         JA      TWO
6269
6270         TRAP3   #WRITO
6271         JA      #LIT
6272         JA      #2010A
6273         FLDA    SCORE
6274         TRAP3   #RSVO
6275         TRAP3   #RENDO
6276
6277         JSR     SIXOUT
6278         JA      .+10
6279         JA      #2010B
6280         JA      ZERO
6281         JA      THREE
6282
6283         TRAP3   #WRITO
6284         JA      #LIT
6285         JA      #2010A
6286         FLDA    MXSCOR
6287         TRAP3   #RSVO
6288         TRAP3   #RENDO
6289
6290         JSR     SIXOUT
6291         JA      .+10
6292         JA      #2010C
6293         JA      ZERO
6294         JA      THREE
6295
6296         TRAP3   #WRITO
6297         JA      #LIT
6298         JA      #2010D
6299
6300         FLDA    TURNS
6301         TRAP3   #RSVO
6302         TRAP3   #RENDO
6303
6304         JSR     SIXOUT
6305         JA      .+10
6306         JA      #2010E
6307         JA      ZERO
6308         JA      ONE
6309
6310 /20100   FORMAT(/' You scored',I4,' out of a possible',I4,
6311 /       1       ', using',I5,' turns.')
6312 /C
6313 /       DO 20200 I=1,CLSSES
6314         FLDA    ONE
6315         FSTA    I
6316
6317 /       IF(CVAL(I).GE.SCORE)GOTO 20210
6318 #I0064, FLDA    I
6319         ATX     7
6320         FLDA    CVAL-3,7
6321         FSUB    SCORE
6322         JGE     #20210
6323
6324 /20200   CONTINUE
6325 #20200, FLDA    I
6326         FADD    ONE
6327         FSTA    I
6328         FSUB    CLSSES
6329         JLE     #I0064
6330 /       TYPE 20202
6331         JSR     SIXOUT
6332         JA      #25000
6333         JA      #20202
6334         JA      ZERO
6335         JA      ZERO
6336
6337 /20202   FORMAT(' You just went off my scale!!'/)
6338 /       GOTO 25000
6339
6340 /C
6341 /20210   CALL SPEAK(CTEXT(I))
6342 #20210, FLDA    I
6343         ATX     7
6344         FLDA    CTEXT-3,7       /GET CLASS MESSAGE
6345         FSTA    #TMP+3
6346         JSR     SPEAK
6347         JA      .+4
6348         JA      #TMP+3
6349 /       IF(I.EQ.CLSSES-1)GOTO 20220
6350         FLDA    CLSSES
6351         FSUB    ONE
6352         FSUB    I
6353         JEQ     #20220
6354 /       K=CVAL(I)+1-SCORE
6355         FLDA    I
6356         ATX     7
6357         FLDA    CVAL-3,7
6358         FADD    ONE
6359         FSUB    SCORE
6360         FSTA    K
6361 /       TYPE 20212,K
6362         JSR     SIXOUT
6363         JA      .+10
6364         JA      #20212
6365         JA      ZERO
6366         JA      TWO
6367
6368         TRAP3   #WRITO
6369         JA      #LIT
6370         JA      #2021A
6371         FLDA    K
6372         TRAP3   #RSVO
6373         TRAP3   #RENDO
6374
6375         JSR     SIXOUT
6376         JA      .+10
6377         JA      #2021B
6378         JA      ZERO
6379         JA      THREE
6380
6381 /20212   FORMAT(' To achieve the next higher rating, you need',I3,
6382 /       1       ' more point',$)
6383 /       IF(K.EQ.1) TYPE 20213
6384         FLDA    K
6385         FSUB    ONE
6386         JNE     .+14
6387         JSR     SIXOUT
6388         JA      #25000
6389         JA      #20213
6390         JA      ZERO
6391         JA      ONE
6392
6393 /       IF(K.NE.1) TYPE 20214
6394         JSR     SIXOUT
6395         JA      #25000
6396         JA      #20214
6397         JA      ZERO
6398         JA      ONE
6399 /20213   FORMAT('+.'/)
6400
6401 /20214   FORMAT('+s.'/)
6402 /       GOTO 25000
6403
6404 /C
6405 /20220   TYPE 20222
6406 #20220, JSR     SIXOUT
6407         JA      .+10
6408         JA      #20222
6409         JA      ZERO
6410         JA      ZERO
6411         JSR     SIXOUT
6412         JA      #GOBAK
6413         JA      #20223
6414         JA      ZERO
6415         JA      ZERO
6416
6417 /20222   FORMAT(' To achieve the next higher rating ',
6418 /       1       'would be a neat trick!'/' Congratulations!!'/)
6419 /       RETURN
6420 /       END
6421 /
6422 / Fortran Formats:
6423 /
6424 #67A,   TEXT    %T]HERE ARE @%
6425 #67,    TEXT    %('+',I1,$)%
6426 #67B,   TEXT    % T]HREATENING LITTLE DWARVES IN THE ROOM WITH YOU.@%
6427 #68,
6428 #78,    TEXT    %(1X,I1,$)%
6429 #78B,   TEXT    % ]OF THEM THROW KNIVES AT YOU!@%
6430 #68B,   TEXT    % ]OF THEM GET YOU!@%
6431 #5015,  TEXT    %W]HAT DO YOU WANT TO DO WITH THE @%
6432 #5199,  TEXT    %I] DON'T SEE ANY "@%
6433 #8002,  TEXT    %I ]DON'T UNDERSTAND "@%
6434 #9032,  TEXT    %O]KAY, "@%
6435 #8243,  TEXT    %I]F YOU WERE TO QUIT NOW, YOU WOULD SCORE @%
6436 #2010A,
6437 #8243A, TEXT    %('+',I4,$)%
6438 #8243B, TEXT    % ]OUT OF A POSSIBLE @%
6439 #20213,
6440 #8243C, TEXT    %.@%
6441 #40012, TEXT    %I] AM PREPARED TO GIVE YOU A HINT, BUT IT WILL COST YOU @%
6442 #4001A, TEXT    %('+',I2,$)%
6443 #4001B, TEXT    % ]POINTS.@%
6444 #20100, TEXT    %Y]OU SCORED @%
6445 #2010B, TEXT    % ]OUT OF A POSSIBLE @%
6446 #2010C, TEXT    % ]USING @%
6447 #2010D, TEXT    %('+',I5,$)%
6448 #2010E, TEXT    % ]TURNS.@%
6449 #20202, TEXT    %Y]OU JUST WENT OFF MY SCALE!!@%
6450 #20212, TEXT    %T]O ACHIEVE THE NEXT HIGHER RATING, YOU NEED @%
6451 #2021A, TEXT    %('+',I3,$)%
6452 #2021B, TEXT    % ]MORE POINT@%
6453 #20214, TEXT    %]S.@%
6454 #20222, TEXT    %T]O ACHIEVE THE NEXT HIGHER RATING WOULD BE A NEAT TRICK!@%
6455 #20223, TEXT    %C]ONGRATULATIONS!!@%
6456         END