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