EXTERN SAVEGM EXTERN RSTRGM EXTERN A5TOA1 SECT AMAIN EXTERN BITSET EXTERN BUG EXTERN CARRY EXTERN DROP EXTERN DSTROY EXTERN GETIN EXTERN IABS EXTERN JUGGLE EXTERN MAX0 EXTERN MIN0 EXTERN MOD EXTERN MOVE EXTERN SPEAK EXTERN PSPEAK EXTERN PUT EXTERN RND EXTERN RSPEAK EXTERN SPEAK EXTERN VOCAB EXTERN YES EXTERN #FIX EXTERN #WRITO EXTERN #RENDO EXTERN #RSVO EXTERN #UE EXTERN #EQ EXTERN #NE EXTERN PCT EXTERN GETWRD EXTERN PUTWRD EXTERN SIXOUT JA #ST #XR, ORG .+10 TEXT +AMAIN + #RET, SETX #XR SETB #BASE JA .+3 #BASE, ORG .+6 ZERO, F 0 ONE, F 1 TWO, F 2 THREE, F 3 MINUS1, F -1 IND, 0;0;0 ORG #BASE+30 FNOP JA #RET FNOP #GOBAK, 0;0 HINT, ORG .+3 KENT, ORG .+3 KQ, ORG .+3 K2, ORG .+3 LL, ORG .+3 N, ORG .+3 PBOTL, ORG .+3 SPK, ORG .+3 WD1, ORG .+3 WD1X, ORG .+3 WD2, ORG .+3 WD2X, ORG .+3 YEA, ORG .+3 #TMP, ORG .+30 #LIT, F 4 / Literals. Too many cause ST overflow F 5 /3 F 6 /6 F 8 /11 F 9 /14 F 10 /17 F 12 /22 F 15 /25 F 16 /30 F 17 /33 F 20 /36 F 22 /41 F 23 /44 F 24 /47 F 25 /52 F 26 /55 F 27 /60 F 30 /63 F 35 /66 F 37 /71 F 39 /74 F 40 /77 F 45 /102 F 49 /105 F 50 /110 F 54 /113 F 57 /116 F 58 /121 F 62 /124 F 65 /127 F 81 /132 F 29 /135 F 91 /140 F 92 /143 F 95 /146 F 99 /151 F 100 /154 F 105 /157 F 110 /162 F 115 /165 F 116 /170 F 117 /173 F 127 /176 F 128 /201 F 129 /204 F 130 /207 F 131 /212 F 132 /215 F 136 /220 F 140 /223 F 141 /226 F 143 /231 F 145 /234 F 162 /237 F 163 /242 F 165 /245 F 175 /250 F 184 /253 F 185 /256 F 186 /261 F 188 /264 F 192 /267 F 193 /272 F 197 /275 F 199 /300 F 201 /303 F 300 /306 F 500 /311 F 1000 /314 F 2500 /317 F 10000 /322 F 80 /325 F 60 /330 F 154 /333 TENTE, TEXT +ENTE + TPOUR, TEXT +POUR + TWEST, TEXT +WEST + TQUES, TEXT +?@ + TQDOT, TEXT +".@ + TYES, TEXT +YES + TYE, TEXT +YE + TY, TEXT +Y + #LBL=. COMMON ABBCOM ABB, ORG .+702 COMMON MISCOM LINUSE, ORG .+3 TRVS, ORG .+3 CLSSES, ORG .+3 OLDLOC, ORG .+3 LOC, ORG .+3 CVAL, ORG .+44 TK, ORG .+74 NEWLOC, ORG .+3 KEY, ORG .+702 PLAC, ORG .+454 FIXD, ORG .+454 ACTSPK, ORG .+151 COND, ORG .+702 HINTS, ORG .+360 HNTMAX, ORG .+3 PROP, ORG .+454 TALLY, ORG .+3 TALLY2, ORG .+3 HINTLC, ORG .+74 CHLOC, ORG .+3 CHLOC2, ORG .+3 DSEEN, ORG .+22 DFLAG, ORG .+3 DLOC, ORG .+22 DALTLC, ORG .+3 KEYS, ORG .+3 LAMP, ORG .+3 GRATE, ORG .+3 CAGE, ORG .+3 ROD, ORG .+3 ROD2, ORG .+3 STEPS, ORG .+3 BIRD, ORG .+3 DOOR, ORG .+3 PILLOW, ORG .+3 SNAKE, ORG .+3 FISSUR, ORG .+3 TABLET, ORG .+3 CLAM, ORG .+3 OYSTER, ORG .+3 MAGZIN, ORG .+3 DWARF, ORG .+3 KNIFE, ORG .+3 FOOD, ORG .+3 BOTTLE, ORG .+3 WATER, ORG .+3 OIL, ORG .+3 PLANT, ORG .+3 PLANT2, ORG .+3 AXE, ORG .+3 MIRROR, ORG .+3 DRAGON, ORG .+3 CHASM, ORG .+3 TROLL, ORG .+3 TROLL2, ORG .+3 BEAR, ORG .+3 MESSAG, ORG .+3 VEND, ORG .+3 BATTER, ORG .+3 NUGGET, ORG .+3 COINS, ORG .+3 CHEST, ORG .+3 EGGS, ORG .+3 TRIDNT, ORG .+3 VASE, ORG .+3 EMRALD, ORG .+3 PYRAM, ORG .+3 PEARL, ORG .+3 RUG, ORG .+3 CHAIN, ORG .+3 BACK, ORG .+3 LOOK, ORG .+3 CAVE, ORG .+3 NULL, ORG .+3 ENTRNC, ORG .+3 DPRSSN, ORG .+3 SAY, ORG .+3 LOCK, ORG .+3 THROW, ORG .+3 FIND, ORG .+3 INVENT, ORG .+3 TURNS, ORG .+3 LMWARN, ORG .+3 KNFLOC, ORG .+3 DETAIL, ORG .+3 ABBNUM, ORG .+3 NUMDIE, ORG .+3 MAXDIE, ORG .+3 DKILL, ORG .+3 FOOBAR, ORG .+3 BONUS, ORG .+3 CLOCK1, ORG .+3 CLOCK2, ORG .+3 CLOSNG, ORG .+3 PANIC, ORG .+3 CLOSED, ORG .+3 GAVEUP, ORG .+3 SCORNG, ORG .+3 ODLOC, ORG .+22 STREAM, ORG .+3 SPICES, ORG .+3 COMMON MISC2 I, ORG .+3 ORG .+3 /RTXSIZ ORG .+3 /CLSMAX ORG .+3 /LOCSIZ CTEXT, ORG .+44 STEXT, ORG .+702 LTEXT, ORG .+702 ORG .+3 /SECT TRAVEL, ORG .+1356 TRVCON, ORG .+1356 TRVLOC, ORG .+1356 TRVSIZ, ORG .+3 ORG .+3 /TABNDX OBJ, ORG .+3 J, ORG .+3 K, ORG .+3 VERB, ORG .+3 HNTSIZ, ORG .+3 MAXTRS, ORG .+3 HINTED, ORG .+74 ORG .+3 /HNTLOC KK, ORG .+3 COMMON PLACOM ATLOC, ORG .+702 LINK, ORG .+1130 PLACE, ORG .+454 FIXED, ORG .+454 HOLDNG, ORG .+3 COMMON PTXCOM PTEXT, ORG .+454 COMMON TXTCOM RTEXT, ORG .+1147 ORG .+44 /LINES ORG .+3 /ASCVAR ORG .+3 /TXTLOC ORG .+234 /DATA COMMON MISC3 ATTACK, ORG .+3 DTOTAL, ORG .+3 OLDLC2, ORG .+3 LIMIT, ORG .+3 MXSCOR, ORG .+3 SCORE, ORG .+3 STICK, ORG .+3 WZDARK, ORG .+3 ORG #LBL #25000, #RTN, BASE #BASE JA #GOBAK #ST, STARTD 0210 FSTA #GOBAK,0 0200 SETX #XR SETB #BASE STARTF JA #STRT /#G0001 / / Statement functions - called with JSA to save space / / TOTING(OBJ)=PLACE(OBJ).EQ.-1 TOTING, 0;0 ATX 3 FLDA PLACE-3,3 FADD ONE JSA #EQ JA TOTING / AT(OBJ)=PLACE(OBJ).EQ.LOC.OR.FIXED(OBJ).EQ.LOC AT, 0;0 ATX 3 FLDA PLACE-3,3 FSUB LOC JEQ ISAT FLDA FIXED-3,3 FSUB LOC ISAT, JSA #EQ JA AT / FORCED(LOC)=COND(LOC).EQ.2 FORCED, 0;0 ATX 3 FLDA COND-3,3 FSUB TWO JSA #EQ JA FORCED / HERE(OBJ) = PLACE(OBJ).EQ.LOC .OR. TOTING(OBJ) HERE, 0;0 JSA TOTING JNE ISHERE FLDA LOC FSUB PLACE-3,3 JEQ ISHERE FCLA JA HERE ISHERE, FLDA ONE JA HERE / DARK(DUMMY)=MOD(COND(LOC),2).EQ.0.AND.(PROP(LAMP).EQ.0.OR. / 1 .NOT.HERE(LAMP)) DARK, 0;0 / .OR. .NOT. HERE(LAMP) FLDA LAMP JSA HERE JEQ NOTHR / .OR. PROP(LAMP) EQ 0 FLDA PROP-3,3 JNE NOTDRK / MOD(COND(LOC),2) .EQ. 0 NOTHR, FLDA LOC / Either prop or not here ATX 4 FLDA COND-3,4 / COND(LOC) FDIV TWO / Divided by two JSA #FIX FMUL TWO FSTA #TMP+14 FLDA COND-3,4 / Get back COND(LOC) FSUB #TMP+14 / Now have mod JNE NOTDRK / If not zero, not dark FLDA ONE JA DARK NOTDRK, FCLA JA DARK / LIQ2(PBOTL)=(1-PBOTL)*WATER+(PBOTL/2)*(WATER+OIL) LIQ2, 0;0 FLDA ONE FSUB PBOTL / 1 - PBOTL FMUL WATER / (1-PBOTL)*WATER FSTA #TMP+14 / Store first term FLDA PBOTL FDIV TWO / PBOTL/2 JSA #FIX FSTA #TMP+6 FLDA WATER FADD OIL / WATER+OIL FMUL #TMP+6 / (PBOTL/2)*(WATER+OIL) FADD #TMP+14 JA LIQ2 / Done / LIQ(DUMMY)=LIQ2(MAX0(PROP(BOTTLE),-1-PROP(BOTTLE))) LIQ, 0;0 /PROP(BOTTLE) FLDA BOTTLE ATX 5 FLDA PROP-3,5 / PROP(BOTTLE) FSTA PBOTL FLDA MINUS1 FSUB PBOTL /-1-PROP(BOTTLE) FSTA #TMP+11 FLDA PBOTL / Find larger FSUB #TMP+11 JGT .+4 / already larger, now PBOTL FLDA #TMP+11 FSTA PBOTL / This is PBOTL JSA LIQ2 / Call LIQ2 with this JA LIQ / And return / LIQLOC(LOC)=LIQ2((MOD(COND(LOC)/2*2,8)-5)*MOD(COND(LOC)/4,2)+1) LIQLOC, 0;0 FLDA LOC / Always called with LOC as arg ATX 2 FLDA COND-3,2 / COND(LOC) FSTA #TMP+11 / Save that FDIV TWO JSA #FIX / COND(LOC)/2 FMUL TWO / COND(LOC)/2*2 FSTA #TMP+17 FDIV #LIT+11 / Modulo 8 JSA #FIX FMUL #LIT+11 FSTA #TMP+22 FLDA #TMP+17 FSUB #TMP+22 / MOD(...) FSUB #LIT+3 / -5. FSTA #TMP+25 / First Term FLDA #TMP+11 / COND(LOC) FDIV #LIT / COND(LOC)/4 JSA #FIX FSTA #TMP+17 FDIV TWO / Mod 2 JSA #FIX FMUL TWO FSTA #TMP+22 FLDA #TMP+17 FSUB #TMP+22 FMUL #TMP+25 / Multiply FADD ONE / +1 FSTA PBOTL / Finally got the term JSA LIQ2 / Send to LIQ2 JA LIQLOC / / Read the property field - object passed in FAC / RDPROP, 0;0 ATX 7 FLDA PROP-3,7 JA RDPROP / / Print a string / SPRINT, 0;0 LDX 0,1 STARTD FLDA SPRINT FSTA IND /Indirect pointer FLDA% IND,1 FSTA PTR FLDA% IND,1+ FSTA CNT FLDA D4 /Add four to skip arguments FADDM SPRINT STARTD JSR SIXOUT JA SPRINT PTR, 0;0 JA ZERO CNT, 0;0 D4, 0;4 / / Main routine entry point / #STRT, /1 I=RND(1) #1, JSR RND JA .+4 JA ONE FSTA I / HINTED(3)=YES(65,1,0) JSR YES JA .+10 JA #LIT+127 JA ONE JA ZERO FSTA HINTED+6 /HINTED(3) / NEWLOC=1 FLDA ONE FSTA NEWLOC / LOC = NEWLOC FSTA LOC / LIMIT=330 DECIMAL LDX 330,0 OCTAL XTA 0 FSTA LIMIT / IF(HINTED(3))LIMIT=1000 FLDA HINTED+6 /HINTED(3) JEQ #2 FLDA #LIT+314 FSTA LIMIT /2 IF(NEWLOC.GE.9.OR.NEWLOC.EQ.0.OR..NOT.CLOSNG)GOTO 71 #2, FLDA NEWLOC FSUB #LIT+14 JGE #71 FLDA NEWLOC JEQ #71 FLDA CLOSNG JEQ #71 / CALL RSPEAK(130) JSR RSPEAK JA .+4 JA #LIT+207 / NEWLOC=LOC FLDA LOC FSTA NEWLOC / IF(.NOT.PANIC)CLOCK2=15 FLDA PANIC JNE .+5 FLDA #LIT+25 FSTA CLOCK2 / PANIC=.TRUE. FLDA ONE FSTA PANIC /C /C SEE IF A DWARF HAS SEEN HIM AND HAS COME FROM WHERE HE WANTS TO GO. IF SO, /C THE DWARF'S BLOCKING HIS WAY. IF COMING FROM PLACE FORBIDDEN TO PIRATE /C (DWARVES ROOTED IN PLACE) LET HIM GET OUT (AND ATTACKED). /C /71 IF(NEWLOC.EQ.LOC.OR.FORCED(LOC).OR.BITSET(LOC,3))GOTO 74 #71, FLDA NEWLOC FSUB LOC JEQ #74 FLDA LOC JSA FORCED JNE #74 JSR BITSET JA .+6 JA LOC JA THREE JNE #74 / DO 73 I=1,5 FLDA ONE FSTA I / IF(ODLOC(I).NE.NEWLOC.OR..NOT.DSEEN(I))GOTO 73 #G0047, FLDA I ATX 7 FLDA ODLOC-3,7 FSUB NEWLOC JNE #73 FLDA DSEEN-3,7 JEQ #73 / NEWLOC=LOC FLDA LOC FSTA NEWLOC / CALL RSPEAK(2) JSR RSPEAK JA .+4 JA TWO / GOTO 74 JA #74 /73 CONTINUE #73, FLDA I FADD ONE FSTA I FSUB #LIT+3 JLE #G0047 #74, FLDA NEWLOC FSTA LOC /C /C DWARF STUFF. SEE EARLIER COMMENTS FOR DESCRIPTION OF VARIABLES. REMEMBER /C SIXTH DWARF IS PIRATE AND IS THUS VERY DIFFERENT EXCEPT FOR MOTION RULES. /C /C FIRST OFF, DON'T LET THE DWARVES FOLLOW HIM INTO A PIT OR A WALL. ACTIVATE /C THE WHOLE MESS THE FIRST TIME HE GETS AS FAR AS THE HALL OF MISTS (LOC 15). /C IF NEWLOC IS FORBIDDEN TO PIRATE (IN PARTICULAR, IF IT'S BEYOND THE TROLL /C BRIDGE), BYPASS DWARF STUFF. THAT WAY PIRATE CAN'T STEAL RETURN TOLL, AND /C DWARVES CAN'T MEET THE BEAR. ALSO MEANS DWARVES WON'T FOLLOW HIM INTO DEAD /C END IN MAZE, BUT C'EST LA VIE. THEY'LL WAIT FOR HIM OUTSIDE THE DEAD END. /C / IF(LOC.EQ.0.OR.FORCED(LOC).OR.BITSET(NEWLOC,3))GOTO 2000 / FLDA LOC JEQ #2000 / FLDA LOC JSA FORCED JNE #2000 JSR BITSET JA .+6 JA NEWLOC JA THREE JNE #2000 / IF(DFLAG.NE.0)GOTO 6000 FLDA DFLAG JNE #6000 / IF(LOC.GE.15)DFLAG=1 FLDA LOC FSUB #LIT+25 JLT #2000 FLDA ONE FSTA DFLAG / GOTO 2000 JA #2000 /C /C WHEN WE ENCOUNTER THE FIRST DWARF, WE KILL 0, 1, OR 2 OF THE 5 DWARVES. IF /C ANY OF THE SURVIVORS IS AT LOC, REPLACE HIM WITH THE ALTERNATE. /C /6000 IF(DFLAG.NE.1)GOTO 6010 #6000, FLDA DFLAG FSUB ONE JNE #6010 / IF(LOC.LT.15.OR.PCT(95))GOTO 2000 FLDA LOC FSUB #LIT+25 JLT #2000 JSR PCT JA .+4 JA #LIT+146 JNE #2000 / DFLAG=2 FLDA TWO FSTA DFLAG / DO 6001 I=1,2 FLDA ONE FSTA I / J=1+RND(5) #G0051, JSR RND JA .+4 JA #LIT+3 FADD ONE FSTA J /6001 IF(PCT(50))DLOC(J)=0 #6001, JSR PCT JA .+4 JA #LIT+110 JEQ .+10 FLDA J ATX 7 FCLA FSTA DLOC-3,7 FLDA I FADD ONE FSTA I FSUB TWO JLE #G0051 / DO 6002 I=1,5 FLDA ONE FSTA I / IF(DLOC(I).EQ.LOC)DLOC(I)=DALTLC #G0053, FLDA I ATX 7 FLDA DLOC-3,7 FSUB LOC JNE #6002 FLDA DALTLC FSTA DLOC-3,7 /6002 ODLOC(I)=DLOC(I) #6002, FLDA I ATX 7 FLDA DLOC-3,7 FSTA ODLOC-3,7 FLDA I FADD ONE FSTA I FSUB #LIT+3 JLE #G0053 / CALL RSPEAK(3) JSR RSPEAK JA .+4 JA THREE / CALL DROP(AXE,LOC) JSR DROP / GOTO 2000 JA #2000 JA AXE JA LOC /C /C THINGS ARE IN FULL SWING. MOVE EACH DWARF AT RANDOM, EXCEPT IF HE'S SEEN US /C HE STICKS WITH US. DWARVES NEVER GO TO LOCS <15. IF WANDERING AT RANDOM, /C THEY DON'T BACK UP UNLESS THERE'S NO ALTERNATIVE. IF THEY DON'T HAVE TO /C MOVE, THEY ATTACK. AND, OF COURSE, DEAD DWARVES DON'T DO MUCH OF ANYTHING. /C /6010 DTOTAL=0 #6010, FCLA FSTA DTOTAL / ATTACK=0 FSTA ATTACK / STICK=0 FSTA STICK / DO 6030 I=1,6 FLDA ONE FSTA I / IF (DLOC(I).EQ.0)GOTO 6030 #G0055, FLDA I ATX 7 FLDA DLOC-3,7 JEQ #6030 / J=1 FLDA ONE FSTA J / KK=DLOC(I) FLDA DLOC-3,7 FSTA KK / KK=KEY(KK) ATX 7 FLDA KEY-3,7 FSTA KK / IF(KK.EQ.0)GOTO 6016 JEQ #6016 /6012 NEWLOC=TRVLOC(KK) #6012, JSR GETWRD JA .+10 JA TRVLOC JA KK JA ZERO FSTA NEWLOC / IF(NEWLOC.GT.300.OR.NEWLOC.LT.15.OR.NEWLOC.EQ.ODLOC(I) / 1 .OR.(J.GT.1.AND.NEWLOC.EQ.TK(J-1)).OR.J.GE.20 / 2 .OR.NEWLOC.EQ.DLOC(I).OR.FORCED(NEWLOC) / 3 .OR.(I.EQ.6.AND.BITSET(NEWLOC,3)) / 4 .OR.TRVCON(KK).EQ.100)GOTO 6014 FSUB #LIT+306 JGT #6014 FLDA NEWLOC FSUB #LIT+25 JLT #6014 FLDA I ATX 7 FLDA NEWLOC FSUB ODLOC-3,7 JEQ #6014 FLDA J FSUB ONE JLE .+11 ATX 6 FLDA NEWLOC FSUB TK-3,6 JEQ #6014 FLDA J FSUB #LIT+36 JGE #6014 FLDA I ATX 7 FLDA NEWLOC FSUB DLOC-3,7 JEQ #6014 FLDA NEWLOC JSA FORCED JNE #6014 FLDA I FSUB #LIT+6 JNE .+14 JSR BITSET JA .+6 JA NEWLOC JA THREE JNE #6014 JSR GETWRD JA .+10 JA TRVCON JA KK JA ZERO FSUB #LIT+154 JEQ #6014 / TK(J)=NEWLOC FLDA J ATX 7 FLDA NEWLOC FSTA TK-3,7 / J=J+1 FLDA ONE FADDM J /6014 KK=KK+1 #6014, FLDA KK FADD ONE FSTA KK / IF(TRAVEL(KK-1).GE.0)GOTO 6012 FSUB ONE FSTA #TMP JSR GETWRD JA .+10 JA TRAVEL JA #TMP JA ZERO JGE #6012 /6016 TK(J)=ODLOC(I) #6016, FLDA J ATX 6 FLDA I ATX 7 FLDA ODLOC-3,7 FSTA TK-3,6 / IF(J.GE.2)J=J-1 FLDA J FSUB TWO JLT .+5 FLDA MINUS1 FADDM J / J=1+RND(J) JSR RND JA .+4 JA J FADD ONE FSTA J / ODLOC(I)=DLOC(I) FLDA DLOC-3,7 FSTA ODLOC-3,7 / DLOC(I)=TK(J) FLDA J ATX 6 FLDA TK-3,6 FSTA DLOC-3,7 / DSEEN(I)=(DSEEN(I).AND.LOC.GE.15) / 1 .OR.(DLOC(I).EQ.LOC.OR.ODLOC(I).EQ.LOC) FLDA LOC FSUB #LIT+25 JLT .+6 FLDA DSEEN-3,7 JNE .+21 FLDA DLOC-3,7 FSUB LOC JEQ .+13 FLDA ODLOC-3,7 FSUB LOC JEQ .+5 FCLA JA .+3 FLDA ONE FSTA DSEEN-3,7 / IF(.NOT.DSEEN(I))GOTO 6030 JEQ #6030 / DLOC(I)=LOC FLDA LOC FSTA DLOC-3,7 / IF(I.NE.6)GOTO 6027 FLDA I FSUB #LIT+6 JNE #6027 /C /C THE PIRATE'S SPOTTED HIM. HE LEAVES HIM ALONE ONCE WE'VE FOUND CHEST. /C K COUNTS IF A TREASURE IS HERE. IF NOT, AND TALLY=TALLY2 PLUS ONE FOR /C AN UNSEEN CHEST, LET THE PIRATE BE SPOTTED. /C / IF(LOC.EQ.CHLOC.OR.PROP(CHEST).GE.0)GOTO 6030 FLDA LOC FSUB CHLOC JEQ #6030 FLDA CHEST JSA RDPROP JGE #6030 / K=0 FCLA FSTA K / DO 6020 J=50,MAXTRS FLDA #LIT+110 FSTA J /C /C PIRATE WON'T TAKE PYRAMID FROM PLOVER ROOM OR DARK ROOM (TOO EASY!). /C / IF(J.EQ.PYRAM.AND.(LOC.EQ.PLAC(PYRAM) / 1 .OR.LOC.EQ.PLAC(EMRALD)))GOTO 6020 #G0057, FLDA J FSUB PYRAM JNE .+24 FLDA PYRAM ATX 7 FLDA LOC FSUB PLAC-3,7 JEQ #6020 FLDA EMRALD ATX 6 FLDA LOC FSUB PLAC-3,6 JEQ #6020 / IF(TOTING(J))GOTO 6022 FLDA J JSA TOTING JNE #6022 /6020 IF(HERE(J))K=1 #6020, FLDA J JSA HERE JEQ .+5 FLDA ONE FSTA K FLDA J FADD ONE FSTA J FSUB MAXTRS JLE #G0057 / IF(TALLY.EQ.TALLY2+1.AND.K.EQ.0.AND.PLACE(CHEST).EQ.0 / 1 .AND.HERE(LAMP).AND.PROP(LAMP).EQ.1)GOTO 6025 FLDA TALLY2 FADD ONE FSUB TALLY JNE #M4 FLDA K JNE #M4 FLDA CHEST ATX 7 FLDA PLACE-3,7 JNE #M4 FLDA LAMP JSA HERE JEQ #M4 FLDA PROP-3,3 FSUB ONE JEQ #6025 / IF(ODLOC(6).NE.DLOC(6).AND.PCT(20))CALL RSPEAK(127) #M4, FLDA ODLOC+17 /ODLOC(6) FSUB DLOC+17 /DLOC(6) JEQ #6030 JSR PCT JA .+4 JA #LIT+36 JEQ #6030 JSR RSPEAK / GOTO 6030 JA #6030 JA #LIT+176 /C /6022 CALL RSPEAK(128) #6022, JSR RSPEAK JA .+4 JA #LIT+201 /C /C DON'T STEAL CHEST BACK FROM TROLL! /C / IF(PLACE(MESSAG).EQ.0)CALL MOVE(CHEST,CHLOC) FLDA MESSAG ATX 7 FLDA PLACE-3,7 JNE .+12 JSR MOVE JA .+6 JA CHEST JA CHLOC / CALL MOVE(MESSAG,CHLOC2) JSR MOVE JA .+6 JA MESSAG JA CHLOC2 / DO 6023 J=50,MAXTRS FLDA #LIT+110 FSTA J / IF(J.EQ.PYRAM.AND.(LOC.EQ.PLAC(PYRAM) / 1 .OR.LOC.EQ.PLAC(EMRALD)))GOTO 6023 #G0063, FLDA J FSUB PYRAM JNE .+24 FLDA PYRAM ATX 7 FLDA LOC FSUB PLAC-3,7 JEQ #6023 FLDA EMRALD ATX 6 FLDA LOC FSUB PLAC-3,6 JEQ #6023 / IF(AT(J).AND.FIXED(J).EQ.0)CALL CARRY(J,LOC) FLDA J JSA AT JEQ .+16 / FLDA J / ATX 3 FLDA FIXED-3,3 JNE .+12 JSR CARRY JA .+6 JA J JA LOC / IF(TOTING(J))CALL DROP(J,CHLOC) FLDA J JSA TOTING JEQ #6023 JSR DROP JA .+6 JA J JA CHLOC /6023 CONTINUE #6023, FLDA J FADD ONE FSTA J FSUB MAXTRS JLE #G0063 /6024 DLOC(6)=CHLOC #6024, FLDA #LIT+6 ATX 7 FLDA CHLOC FSTA DLOC-3,7 / ODLOC(6)=CHLOC FSTA ODLOC-3,7 / DSEEN(6)=.FALSE. FCLA FSTA DSEEN-3,7 / GOTO 6030 JA #6030 /C /6025 CALL RSPEAK(186) #6025, JSR RSPEAK JA .+4 JA #LIT+261 / CALL MOVE(CHEST,CHLOC) JSR MOVE JA .+6 JA CHEST JA CHLOC / CALL MOVE(MESSAG,CHLOC2) JSR MOVE / GOTO 6024 JA #6024 JA MESSAG JA CHLOC2 /C /C THIS THREATENING LITTLE DWARF IS IN THE ROOM WITH HIM! /C /6027 DTOTAL=DTOTAL+1 #6027, FLDA ONE FADDM DTOTAL / IF(ODLOC(I).NE.DLOC(I))GOTO 6030 FLDA I ATX 7 FLDA ODLOC-3,7 FSUB DLOC-3,7 JNE #6030 / ATTACK=ATTACK+1 FLDA ONE FADDM ATTACK / IF(KNFLOC.GE.0)KNFLOC=LOC FLDA KNFLOC JLT .+6 FLDA LOC FSTA KNFLOC / IF(RND(1000).LT.95*(DFLAG-2))STICK=STICK+1 JSR RND JA .+4 JA #LIT+314 FSTA #TMP FLDA DFLAG FSUB TWO FMUL #LIT+146 FSUB #TMP JLT #6030 FLDA ONE FADDM STICK /6030 CONTINUE #6030, FLDA I FADD ONE FSTA I FSUB #LIT+6 JLE #G0055 /C /C NOW WE KNOW WHAT'S HAPPENING. LET'S TELL THE POOR SUCKER ABOUT IT. /C / IF(DTOTAL.EQ.0)GOTO 2000 FLDA DTOTAL JEQ #2000 / IF(DTOTAL.EQ.1)GOTO 75 FSUB ONE JEQ #75 / TYPE 67,DTOTAL /67 FORMAT(' There are ',I1,' threatening little dwarves in the' / 1 ,' room with you.') JSR SPRINT JA #67A JA TWO TRAP3 #WRITO JA #LIT JA #67 FLDA DTOTAL TRAP3 #RSVO TRAP3 #RENDO JSA SPRINT JA #67B JA ONE / GOTO 77 JA #77 /75 CALL RSPEAK(4) #75, JSR RSPEAK JA .+4 JA #LIT /77 IF(ATTACK.EQ.0)GOTO 2000 #77, FLDA ATTACK JEQ #2000 / IF(DFLAG.EQ.2)DFLAG=3 FLDA DFLAG FSUB TWO JNE .+5 FLDA THREE FSTA DFLAG / IF(ATTACK.EQ.1)GOTO 79 FLDA ATTACK FSUB ONE JEQ #79 / TYPE 78,ATTACK /78 FORMAT(' ',I1,' of them throw knives at you!') TRAP3 #WRITO JA #LIT JA #78 FLDA ATTACK TRAP3 #RSVO TRAP3 #RENDO JSA SPRINT JA #78B JA ONE / K=6 FLDA #LIT+6 FSTA K /82 IF(STICK.GT.1)GOTO 83 #82, FLDA STICK FSUB ONE JGT #83 / CALL RSPEAK(K+STICK) FLDA K FADD STICK FSTA #TMP JSR RSPEAK JA .+4 JA #TMP / IF(STICK.EQ.0)GOTO 2000 FLDA STICK JEQ #2000 / GOTO 84 JA #84 /83 TYPE 68,STICK #83, TRAP3 #WRITO JA #LIT JA #68 FLDA STICK TRAP3 #RSVO TRAP3 #RENDO /68 FORMAT(' ',I1,' of them get you!') JSA SPRINT JA #68B JA ONE /84 OLDLC2=LOC #84, FLDA LOC FSTA OLDLC2 / GOTO 99 JA #99 /C /79 CALL RSPEAK(5) #79, JSR RSPEAK JA .+4 JA #LIT+3 / K=52 DECIMAL LDX 52,0 OCTAL XTA 0 FSTA K / GOTO 82 JA #82 /C DESCRIBE THE CURRENT LOCATION AND (MAYBE) GET NEXT COMMAND. /C /C PRINT TEXT FOR CURRENT LOC. /C /2000 IF(LOC.EQ.0)GOTO 99 #2000, FLDA LOC JEQ #99 / KK=STEXT(LOC) FLDA LOC ATX 7 FLDA STEXT-3,7 FSTA KK / KENT=0 FCLA FSTA KENT / IF (ABBNUM.NE.0) KENT=MOD(ABB(LOC),ABBNUM) FLDA ABBNUM JEQ NOMOD / FLDA LOC / ATX 7 FLDA ABB-3,7 FSTA #TMP JSR MOD JA .+6 JA #TMP JA ABBNUM FSTA KENT / IF (KENT.EQ.0.OR.KK.EQ.0) KK=LTEXT(LOC) NOMOD, FLDA KENT JEQ .+6 FLDA KK JNE .+11 FLDA LOC ATX 7 FLDA LTEXT-3,7 FSTA KK / IF(FORCED(LOC).OR..NOT.DARK(0))GOTO 2001 FLDA LOC JSA FORCED JNE #2001 JSA DARK JEQ #2001 / IF(WZDARK.AND.PCT(35))GOTO 90 FLDA WZDARK JEQ .+12 JSR PCT JA .+4 JA #LIT+66 JNE #90 / KK=RTEXT(16) FLDA RTEXT+55 FSTA KK /2001 IF(TOTING(BEAR))CALL RSPEAK(141) #2001, FLDA BEAR JSA TOTING JEQ .+10 JSR RSPEAK JA .+4 JA #LIT+226 / CALL SPEAK(KK) JSR SPEAK JA .+4 JA KK / K=1 FLDA ONE FSTA K / IF(FORCED(LOC))GOTO 8 FLDA LOC JSA FORCED JNE #8 / IF(LOC.EQ.33.AND.PCT(25).AND..NOT.CLOSNG)CALL RSPEAK(8) DECIMAL LDX 33,0 OCTAL XTA 0 FSUB LOC JNE .+24 JSR PCT JA .+4 JA #LIT+52 JEQ .+14 FLDA CLOSNG JNE .+10 JSR RSPEAK JA .+4 JA #LIT+11 /C /C PRINT OUT DESCRIPTIONS OF OBJECTS AT THIS LOCATION. IF NOT CLOSING AND /C PROPERTY VALUE IS NEGATIVE, TALLY OFF ANOTHER TREASURE. RUG IS SPECIAL /C CASE; ONCE SEEN, ITS PROP IS 1 (DRAGON ON IT) TILL DRAGON IS KILLED. /C SIMILARLY FOR CHAIN; PROP IS INITIALLY 1 (LOCKED TO BEAR). THESE HACKS /C ARE BECAUSE PROP=0 IS NEEDED TO GET FULL SCORE. /C / IF(DARK(0))GOTO 2012 JSA DARK JNE #2012 / ABB(LOC)=ABB(LOC)+1 FLDA LOC ATX 4 FLDA ONE FADDM ABB-3,7 / I=ATLOC(LOC) FLDA ATLOC-3,7 FSTA I /2004 IF(I.EQ.0)GOTO 2012 #2004, FLDA I JEQ #2012 / OBJ=I FSTA OBJ / IF(OBJ.GT.100)OBJ=OBJ-100 FSUB #LIT+154 JLE .+4 / FLDA OBJ / FSUB #LIT+154 FSTA OBJ / IF(OBJ.EQ.STEPS.AND.TOTING(NUGGET))GOTO 2008 FLDA OBJ FSUB STEPS JNE .+10 FLDA NUGGET JSA TOTING JNE #2008 / IF(PROP(OBJ).GE.0)GOTO 2006 FLDA OBJ JSA RDPROP JGE #2006 / IF(CLOSED)GOTO 2008 FLDA CLOSED JNE #2008 / PROP(OBJ)=0 FCLA FSTA PROP-3,7 / IF(OBJ.EQ.RUG.OR.OBJ.EQ.CHAIN)PROP(OBJ)=1 FLDA OBJ FSUB RUG JEQ .+10 FLDA OBJ FSUB CHAIN JNE .+5 FLDA ONE FSTA PROP-3,7 / TALLY=TALLY-1 FLDA TALLY FADD MINUS1 FSTA TALLY /C IF REMAINING TREASURES TOO ELUSIVE, ZAP HIS LAMP. / IF(TALLY.EQ.TALLY2.AND.TALLY.NE.0)LIMIT=MIN0(35,LIMIT) JEQ #2006 FSUB TALLY2 JNE #2006 JSR MIN0 JA .+6 JA #LIT+66 JA LIMIT FSTA LIMIT /2006 KK=PROP(OBJ) #2006, FLDA OBJ JSA RDPROP FSTA KK / IF(OBJ.EQ.STEPS.AND.LOC.EQ.FIXED(STEPS))KK=1 FLDA OBJ FSUB STEPS JNE .+16 FLDA STEPS ATX 7 FLDA LOC FSUB FIXED-3,7 JNE .+5 FLDA ONE FSTA KK / CALL PSPEAK(OBJ,KK) JSR PSPEAK JA .+6 JA OBJ JA KK /2008 I=LINK(I) #2008, FLDA I ATX 7 FLDA LINK-3,7 FSTA I / GOTO 2004 JA #2004 /2009 K=54 #2009, FLDA #LIT+113 FSTA K /2010 SPK=K #2010, FLDA K FSTA SPK /2011 CALL RSPEAK(SPK) #2011, JSR RSPEAK JA .+4 JA SPK /2012 VERB=0 #2012, FCLA FSTA VERB / OBJ=0 FSTA OBJ /C /C CHECK IF THIS LOC IS ELIGIBLE FOR ANY HINTS. IF BEEN HERE LONG ENOUGH, /C BRANCH TO HELP SECTION (ON LATER PAGE). HINTS ALL COME BACK HERE EVENTUALLY /C TO FINISH THE LOOP. IGNORE "HINTS" < 4 (SPECIAL STUFF, SEE DATABASE NOTES). /C /2600 DO 2602 HINT=4,HNTMAX #2600, FLDA #LIT FSTA HINT / IF(HINTED(HINT))GOTO 2602 #G0102, FLDA HINT ATX 7 FLDA HINTED-3,7 JNE #2602 / IF(.NOT.BITSET(LOC,HINT))HINTLC(HINT)=-1 JSR BITSET JA .+6 JA LOC JA HINT JNE .+5 FLDA MINUS1 FSTA HINTLC-3,7 / HINTLC(HINT)=HINTLC(HINT)+1 FLDA ONE FADDM HINTLC-3,7 / IF(HINTLC(HINT).GE.HINTS(HINT,1))GOTO 40000 FLDA #LIT+36 / 20 FADD HINT / HINT,1 ATX 6 FLDA HINTLC-3,7 FSUB HINTS-77,6 JGE #40000 /2602 CONTINUE #2602, FLDA HINT FADD ONE FSTA HINT FSUB HNTMAX JLE #G0102 /C /C KICK THE RANDOM NUMBER GENERATOR JUST TO ADD VARIETY TO THE CHASE. ALSO, /C IF CLOSING TIME, CHECK FOR ANY OBJECTS BEING TOTED WITH PROP < 0 AND SET /C THE PROP TO -1-PROP. THIS WAY OBJECTS WON'T BE DESCRIBED UNTIL THEY'VE /C BEEN PICKED UP AND PUT DOWN SEPARATE FROM THEIR RESPECTIVE PILES. DON'T /C TICK CLOCK1 UNLESS WELL INTO CAVE (AND NOT AT Y2). /C / IF(.NOT.CLOSED)GOTO 2605 FLDA CLOSED JEQ #2605 / IF(PROP(OYSTER).LT.0.AND.TOTING(OYSTER)) / 1 CALL PSPEAK(OYSTER,1) FLDA OYSTER JSA TOTING JEQ .+16 FLDA PROP-3,3 JGE .+12 JSR PSPEAK JA .+6 JA OYSTER JA ONE / DO 2604 I=1,100 FLDA ONE FSTA I /2604 IF(TOTING(I).AND.PROP(I).LT.0)PROP(I)=-1-PROP(I) #2604, FLDA I JSA TOTING JEQ .+13 FLDA PROP-3,3 JGE .+7 FLDA MINUS1 FSUB PROP-3,3 FSTA PROP-3,3 FLDA I FADD ONE FSTA I FSUB #LIT+154 JLE #2604 /2605 WZDARK=DARK(0) #2605, JSA DARK FSTA WZDARK / IF(KNFLOC.GT.0.AND.KNFLOC.NE.LOC)KNFLOC=0 FLDA KNFLOC JLE .+11 FSUB LOC JEQ .+5 FCLA FSTA KNFLOC / I=RND(1) JSR RND JA .+4 JA ONE / CALL GETIN(WD1,WD1X,WD2,WD2X) JSR GETIN JA .+12 JA WD1 JA WD1X JA WD2 JA WD2X /C /C EVERY INPUT, CHECK "FOOBAR" FLAG. IF ZERO, NOTHING'S GOING ON. IF POS, /C MAKE NEG. IF NEG, HE SKIPPED A WORD, SO MAKE IT ZERO. /C /2608 FOOBAR=MIN0(0,-FOOBAR) #2608, FLDA FOOBAR FNEG FSTA #TMP JSR MIN0 JA .+6 JA ZERO JA #TMP FSTA FOOBAR / TURNS=TURNS+1 FLDA ONE FADDM TURNS /C IF(VERB.EQ.SAY.AND.WD2.NE.0)VERB=0 /C IF(VERB.EQ.SAY)GOTO 4090 / IF(TALLY.EQ.0.AND.LOC.GE.15.AND.LOC.NE.33)CLOCK1=CLOCK1-1 FLDA TALLY JNE .+23 FLDA LOC FSUB #LIT+25 JLT .+16 DECIMAL LDX 33,0 OCTAL XTA 0 FSUB LOC JEQ .+7 FLDA CLOCK1 FSUB ONE FSTA CLOCK1 / IF(CLOCK1.EQ.0)GOTO 10000 FLDA CLOCK1 JEQ #10000 / IF(CLOCK1.LT.0)CLOCK2=CLOCK2-1 JGE .+7 FLDA CLOCK2 FSUB ONE FSTA CLOCK2 / IF(CLOCK2.EQ.0)GOTO 11000 FLDA CLOCK2 JEQ #11000 / IF(PROP(LAMP).EQ.1)LIMIT=LIMIT-1 FLDA LAMP JSA RDPROP FSUB ONE JNE .+5 FLDA MINUS1 FADDM LIMIT / IF(LIMIT.LE.30.AND.HERE(BATTER).AND.PROP(BATTER).EQ.0 / 1 .AND.HERE(LAMP))GOTO 12000 FLDA LIMIT FSUB #LIT+63 JGT .+22 FLDA BATTER JSA HERE JEQ .+14 FLDA PROP-3,3 JNE .+10 FLDA LAMP JSA HERE JNE #12000 / IF(LIMIT.EQ.0)GOTO 12400 FLDA LIMIT JEQ #12400 / IF(LIMIT.LT.0.AND.LOC.LE.8)GOTO 12600 / FLDA LIMIT JGE .+7 FLDA LOC FSUB #LIT+11 JLE #12600 / IF(LIMIT.LE.30)GOTO 12200 FLDA LIMIT FSUB #LIT+63 JLE #12200 /19999 K=43 DECIMAL #19999, LDX 43,0 OCTAL XTA 0 FSTA K / IF(LIQLOC(LOC).EQ.WATER)K=70 JSA LIQLOC FSUB WATER JNE .+7 DECIMAL LDX 70,0 OCTAL XTA 0 FSTA K /C /C DO PRELIMINARY ANALYSIS OF SENTENCE TO FIND CERTAIN SPECIAL /C CASES, VIZ, /C /C ENTER /C ENTER /C /C / CALL VOCAB(WD1,WD1A,-1,I) JSR VOCAB JA .+6 JA WD1 JA MINUS1 FSTA I / CALL VOCAB(WD2,WD2A,-1,J) JSR VOCAB JA .+6 JA WD2 JA MINUS1 FSTA J / IF(WD1.NE.'ENTE') GO TO 2609 FLDA WD1 FSUB TENTE JNE #2609 / IF(J .EQ. (WATER+1000) / 1 .OR. J .EQ. STREAM) GO TO 2010 FLDA WATER FADD #LIT+314 FSUB J JEQ #2010 FLDA J FSUB STREAM JEQ #2010 / IF(WD2 .NE. 0) GO TO 2800 FLDA WD2 JNE #2800 /2609 IF((I .NE. (WATER+1000) .AND. I .NE. (OIL+1000)) / 1 .OR. (J .NE. (PLANT+1000) .AND. J .NE. (DOOR+1000))) / 2 GO TO 2610 #2609, FLDA WATER FADD #LIT+314 FSUB I JEQ .+11 FLDA OIL FADD #LIT+314 FSUB I JNE #2610 FLDA PLANT FADD #LIT+314 FSUB J JEQ .+11 FLDA DOOR FADD #LIT+314 FSUB J JNE #2610 / WD2="POUR" FLDA TPOUR FSTA WD2 /2610 IF(WD1 .EQ. 'WEST' .AND. PCT(10)) / 1 CALL RSPEAK(17) #2610, FLDA WD1 FSUB TWEST JNE #2630 JSR PCT JA .+4 JA #LIT+17 JEQ #2630 JSR RSPEAK JA .+4 JA #LIT+33 /2630 CALL VOCAB(WD1,-1,I) #2630, JSR VOCAB JA .+6 JA WD1 JA MINUS1 FSTA I / IF(I.EQ.-1)GOTO 3000 FADD ONE JEQ #3000 / K=MOD(I,1000) JSR MOD JA .+6 JA I JA #LIT+314 FSTA K / KQ=I/1000+1 FLDA I FDIV #LIT+314 JSA #FIX FADD ONE FSTA KQ / GOTO (8,5000,4000,2010)KQ FLDA KQ ATX 1 STARTD FLDA .+2,1 STARTF JAC JA #8 JA #5000 JA #4000 JA #2010 / CALL BUG(22) JSR BUG JA .+4 JA #LIT+41 /C /C GET SECOND WORD FOR ANALYSIS. /C /2800 WD1=WD2 / WD1A=WD2A #2800, FLDA WD2 FSTA WD1 / WD1X=WD2X FLDA WD2X FSTA WD1X / WD2=0 FCLA FSTA WD2 / GOTO 2610 JA #2610 /C /C GEE, I DON'T UNDERSTAND. /C /3000 SPK=60 #3000, FLDA #LIT+330 FSTA SPK / IF(PCT(20))SPK=61 JSR PCT JA .+4 JA #LIT+36 JEQ .+6 DECIMAL LDX 61,0 OCTAL XTA 0 FSTA SPK / IF(PCT(20))SPK=13 JSR PCT JA .+4 JA #LIT+36 JEQ .+6 DECIMAL LDX 13,0 OCTAL XTA 0 FSTA SPK / CALL RSPEAK(SPK) JSR RSPEAK JA .+4 JA SPK / GOTO 2600 JA #2600 /C /C ANALYSE A VERB. REMEMBER WHAT IT WAS, GO BACK FOR OBJECT IF SECOND WORD /C UNLESS VERB IS "SAY", WHICH SNARFS ARBITRARY SECOND WORD. /C /4000 VERB=K #4000, FLDA K FSTA VERB / SPK=ACTSPK(VERB) ATX 7 FLDA ACTSPK-3,7 FSTA SPK / IF(WD2.NE.0.AND.VERB.NE.SAY)GOTO 2800 FLDA WD2 JEQ .+10 FLDA VERB FSUB SAY JNE #2800 / IF(VERB.EQ.SAY)OBJ=WD2 FLDA VERB FSUB SAY JNE .+5 FLDA WD2 FSTA OBJ / IF(OBJ.NE.0)GOTO 4090 FLDA OBJ FSUB ZERO JNE #4090 /C /C ANALYSE AN INTRANSITIVE VERB (IE, NO OBJECT GIVEN YET). /C /4080 GOTO(8010,8000,8000,8040,2009,8040,9070,9080,8000,8000, / 1 2011,9120,9130,8140,9150,8000,8000,8180,8000,8200, / 2 8000,9220,9230,8240,8250,8260,8270,8000,8000,8300, / 3 8310,8320)VERB /C TAKE DROP SAY OPEN NOTH LOCK ON OFF WAVE CALM /C WALK KILL POUR EAT DRNK RUB TOSS QUIT FIND INVN /C FEED FILL BLST SCOR FOO BRF READ BREK WAKE SUSP /C HOUR RESU #4080, FLDA VERB ATX 1 STARTD FLDA .+2,1 STARTF JAC JA #8010 JA #8000 JA #8000 JA #8040 JA #2009 JA #8040 JA #9070 JA #9080 JA #8000 JA #8000 JA #2011 JA #9120 JA #9130 JA #8140 JA #9150 JA #8000 JA #8000 JA #8180 JA #8000 JA #8200 JA #8000 JA #9220 JA #9230 JA #8240 JA #8250 JA #8260 JA #8270 JA #8000 JA #8000 JA #8300 JA #8310 JA #8320 / CALL BUG(23) JSR BUG JA .+4 JA #LIT+44 /C /C ANALYSE A TRANSITIVE VERB. /C /4090 GOTO(9010,9020,9030,9040,2009,9040,9070,9080,9090,2011, / 1 2011,9120,9130,9140,9150,9160,9170,2011,9190,9190, / 2 9210,9220,9230,2011,2011,2011,9270,9280,9290,2011, / 3 2011,2011)VERB /C TAKE DROP SAY OPEN NOTH LOCK ON OFF WAVE CALM /C WALK KILL POUR EAT DRNK RUB TOSS QUIT FIND INVN /C FEED FILL BLST SCOR FOO BRF READ BREK WAKE SUSP /C HOUR RESU #4090, FLDA VERB ATX 1 STARTD FLDA .+2,1 STARTF JAC JA #9010 JA #9020 JA #9030 JA #9040 JA #2009 JA #9040 JA #9070 JA #9080 JA #9090 JA #2011 JA #2011 JA #9120 JA #9130 JA #9140 JA #9150 JA #9160 JA #9170 JA #2011 JA #9190 JA #9190 JA #9210 JA #9220 JA #9230 JA #2011 JA #2011 JA #2011 JA #9270 JA #9280 JA #9290 JA #2011 JA #2011 JA #2011 JA #2011 / CALL BUG(24) JSR BUG JA .+4 JA #LIT+47 /C /C ANALYSE AN OBJECT WORD. SEE IF THE THING IS HERE, WHETHER WE'VE GOT A VERB /C YET, AND SO ON. OBJECT MUST BE HERE UNLESS VERB IS "FIND" OR "INVENT(ORY)" /C (AND NO NEW VERB YET TO BE ANALYSED). WATER AND OIL ARE ALSO FUNNY, SINCE /C THEY ARE NEVER ACTUALLY DROPPED AT ANY LOCATION, BUT MIGHT BE HERE INSIDE /C THE BOTTLE OR AS A FEATURE OF THE LOCATION. /C /5000 OBJ=K #5000, FLDA K FSTA OBJ / IF(FIXED(K).NE.LOC.AND..NOT.HERE(K))GOTO 5100 FLDA K ATX 7 FLDA FIXED-3,7 FSUB LOC JEQ #5010 FLDA K JSA HERE JEQ #5100 /5010 IF(WD2.NE.0)GOTO 2800 #5010, FLDA WD2 JNE #2800 / IF(VERB.NE.0)GOTO 4090 FLDA VERB JNE #4090 / TYPE 5015 /5015 FORMAT(' What do you want to do with the ',$) JSA SPRINT JA #5015 JA TWO / CALL A5TOA1(WD1,WD1A,WD1X,'?') JSR A5TOA1 JA .+10 JA WD1 JA WD1X JA TQUES TRAP3 #WRITO JA #LIT JA #LINEF+2 TRAP3 #RENDO / GOTO 2600 #LINEF, JA #2600 TEXT +(' ')+ /C /5100 IF(K.NE.GRATE)GOTO 5110 #5100, FLDA K FSUB GRATE JNE #5110 / IF(LOC.EQ.1.OR.LOC.EQ.4.OR.LOC.EQ.7)K=DPRSSN FLDA LOC FSUB ONE JEQ .+10 FSUB THREE JEQ .+5 FSUB THREE JNE .+6 FLDA DPRSSN FSTA K / IF(LOC.GT.9.AND.LOC.LT.15)K=ENTRNC FLDA LOC FSUB #LIT+14 JLE .+13 FLDA LOC FSUB #LIT+25 JGE .+6 FLDA ENTRNC FSTA K / IF(K.NE.GRATE)GOTO 8 FLDA K FSUB GRATE JNE #8 /5110 IF(K.NE.DWARF)GOTO 5120 #5110, FLDA K FSUB DWARF JNE #5120 / DO 5112 I=1,5 FLDA ONE FSTA I / IF(DLOC(I).EQ.LOC.AND.DFLAG.GE.2)GOTO 5010 #G0122, FLDA I ATX 7 FLDA DLOC-3,7 FSUB LOC JNE #5112 FLDA DFLAG FSUB TWO JGE #5010 /5112 CONTINUE #5112, FLDA I FADD ONE FSTA I FSUB #LIT+3 JLE #G0122 /5120 IF((LIQ(0).EQ.K.AND.HERE(BOTTLE)).OR.K.EQ.LIQLOC(LOC))GOTO 5010 #5120, JSA LIQ FSUB K JNE .+10 FLDA BOTTLE JSA HERE JNE #5010 JSA LIQLOC FSUB K JEQ #5010 / IF(OBJ.NE.PLANT.OR..NOT.AT(PLANT2).OR.PROP(PLANT2).EQ.0)GOTO 5130 FLDA OBJ FSUB PLANT JNE #5130 FLDA PLANT2 JSA AT JEQ #5130 / FLDA PLANT2 / ATX 3 FLDA PROP-3,3 JEQ #5130 / OBJ=PLANT2 FLDA PLANT2 FSTA OBJ / GOTO 5010 JA #5010 /5130 IF(OBJ.NE.KNIFE.OR.KNFLOC.NE.LOC)GOTO 5140 #5130, FLDA OBJ FSUB KNIFE JNE #5140 FLDA KNFLOC FSUB LOC JNE #5140 / KNFLOC=-1 FLDA MINUS1 FSTA KNFLOC / SPK=116 FLDA #LIT+170 FSTA SPK / GOTO 2011 JA #2011 /5140 IF(OBJ.NE.ROD.OR..NOT.HERE(ROD2))GOTO 5190 #5140, FLDA OBJ FSUB ROD JNE #5190 FLDA ROD2 JSA HERE JEQ #5190 / OBJ=ROD2 FLDA ROD2 FSTA OBJ / GOTO 5010 JA #5010 /5190 IF((VERB.EQ.FIND.OR.VERB.EQ.INVENT).AND.WD2.EQ.0)GOTO 5010 #5190, FLDA VERB FSUB INVENT JEQ .+10 FLDA VERB FSUB FIND JNE .+5 FLDA WD2 JEQ #5010 / TYPE 5199 JSA SPRINT JA #5199 JA TWO /5199 FORMAT(' I don''t see any ',$) / CALL A5TOA1(WD1,WD1A,WD1X,'.') / GOTO 2012 JSR A5TOA1 JA #2012 JA WD1 JA WD1X JA TQDOT /C FIGURE OUT THE NEW LOCATION /C /C GIVEN THE CURRENT LOCATION IN "LOC", AND A MOTION VERB NUMBER IN "K", PUT /C THE NEW LOCATION IN "NEWLOC". THE CURRENT LOC IS SAVED IN "OLDLOC" IN CASE /C HE WANTS TO RETREAT. THE CURRENT OLDLOC IS SAVED IN OLDLC2, IN CASE HE /C DIES. (IF HE DOES, NEWLOC WILL BE LIMBO, AND OLDLOC WILL BE WHAT KILLED /C HIM, SO WE NEED OLDLC2, WHICH IS THE LAST PLACE HE WAS SAFE.) /C /8 KK=KEY(LOC) #8, FLDA LOC ATX 7 FLDA KEY-3,7 FSTA KK / NEWLOC=LOC FLDA LOC FSTA NEWLOC / IF(KK.EQ.0)CALL BUG(26) FLDA KK JNE .+10 JSR BUG JA .+4 JA #LIT+55 / IF(K.EQ.NULL)GOTO 2 FLDA K FSUB NULL JEQ #2 / IF(K.EQ.BACK)GOTO 20 FLDA K FSUB BACK JEQ #20 / IF(K.EQ.LOOK)GOTO 30 FLDA K FSUB LOOK JEQ #30 / IF(K.EQ.CAVE)GOTO 40 FLDA K FSUB CAVE JEQ #40 / OLDLC2=OLDLOC FLDA OLDLOC FSTA OLDLC2 / OLDLOC=LOC FLDA LOC FSTA OLDLOC /C /9 LL=IABS(TRAVEL(KK)) #9, JSR GETWRD JA .+10 JA TRAVEL JA KK JA ZERO FSTA #TMP JSR IABS JA .+4 JA #TMP FSTA LL / IF(LL.EQ.1 .OR. LL.EQ.K)GOTO 10 FSUB ONE JEQ #10 FLDA LL FSUB K JEQ #10 / IF(TRAVEL(KK).LT.0)GOTO 50 JSR GETWRD JA .+10 JA TRAVEL JA KK JA ZERO JLT #50 / KK=KK+1 FLDA ONE FADDM KK / GOTO 9 JA #9 /C /10 NEWLOC=TRVCON(KK) #10, JSR GETWRD JA .+10 JA TRVCON JA KK JA ZERO FSTA NEWLOC / K=MOD(NEWLOC,100) JSR MOD JA .+6 JA NEWLOC JA #LIT+154 FSTA K / IF(NEWLOC.LE.300)GOTO 13 FLDA NEWLOC FSUB #LIT+306 JLE #13 / IF(PROP(K).NE.NEWLOC/100-3)GOTO 16 FLDA K ATX 7 FLDA NEWLOC FDIV #LIT+154 JSA #FIX FSUB THREE FSUB PROP-3,7 JNE #16 /C /C TRY NEXT ENTRY IN TRAVEL TABLE /C /12 IF(TRAVEL(KK).LT.0)CALL BUG(25) #12, JSR GETWRD JA .+10 JA TRAVEL JA KK JA ZERO JGE .+10 JSR BUG JA .+4 JA #LIT+52 / KK=KK+1 FLDA KK FSTA #TMP FADD ONE FSTA KK /C MAKE SURE HE DOESN'T GO THROUGH SAME TEST AGAIN /C / IF(TRVCON(KK-1).EQ.TRVCON(KK) .AND. TRVLOC(KK-1).EQ.TRVLOC(KK)) / 1 GOTO 12 JSR GETWRD JA .+10 JA TRVCON JA #TMP JA ZERO FSTA #TMP+3 JSR GETWRD JA .+10 JA TRVCON JA KK JA ZERO FSUB #TMP+3 JNE #10 JSR GETWRD JA .+10 JA TRVLOC JA #TMP JA ZERO FSTA #TMP+3 JSR GETWRD JA .+10 JA TRVLOC JA #TMP FSUB #TMP+3 JEQ #12 / GO TO 10 JA #10 /C /13 IF(NEWLOC.LE.100)GOTO 14 #13, FLDA NEWLOC FSUB #LIT+154 JLE #14 / IF(TOTING(K).OR.(NEWLOC.GT.200.AND.AT(K)))GOTO 16 FLDA K JSA TOTING JNE #16 DECIMAL LDX 200,0 OCTAL XTA 0 FSUB NEWLOC JGT #12 FLDA K JSA AT JNE #16 / GOTO 12 JA #12 /C /14 IF(NEWLOC.NE.0.AND..NOT.PCT(NEWLOC))GOTO 12 #14, FLDA NEWLOC JEQ #16 JSR PCT JA .+4 JA NEWLOC JEQ #12 /16 NEWLOC=TRVLOC(KK) #16, JSR GETWRD JA .+10 JA TRVLOC JA KK JA ZERO FSTA NEWLOC / IF(NEWLOC.LE.300)GOTO 2 FSUB #LIT+306 JLE #2 / IF(NEWLOC.LE.500)GOTO 30000 FLDA NEWLOC FSUB #LIT+311 JLE #30000 / CALL RSPEAK(NEWLOC-500) / FLDA NEWLOC / FSUB #LIT+311 FSTA #TMP JSR RSPEAK JA .+4 JA #TMP / NEWLOC=LOC FLDA LOC FSTA NEWLOC / GOTO 2 JA #2 /C /C SPECIAL MOTIONS COME HERE. LABELLING CONVENTION: STATEMENT NUMBERS NNNXX /C (XX=00-99) ARE USED FOR SPECIAL CASE NUMBER NNN (NNN=301-500). /C /30000 NEWLOC=NEWLOC-300 #30000, FLDA NEWLOC FSUB #LIT+306 FSTA NEWLOC / GOTO (30100,30200,30300)NEWLOC / FLDA NEWLOC ATX 1 STARTD FLDA .+2,1 STARTF JAC JA #30100 JA #30200 JA #30300 / CALL BUG(20) JSR BUG JA .+4 JA #LIT+36 /C /C TRAVEL 301. PLOVER-ALCOVE PASSAGE. CAN CARRY ONLY EMERALD. NOTE: TRAVEL /C TABLE MUST INCLUDE "USELESS" ENTRIES GOING THROUGH PASSAGE, WHICH CAN NEVER /C BE USED FOR ACTUAL MOTION, BUT CAN BE SPOTTED BY "GO BACK". /C /30100 NEWLOC=99+100-LOC #30100, FLDA #LIT+300 /199 FSUB LOC FSTA NEWLOC / IF(HOLDNG.EQ.0.OR.(HOLDNG.EQ.1.AND.TOTING(EMRALD)))GOTO 2 FLDA HOLDNG JEQ #2 FSUB ONE JNE #M27 FLDA EMRALD JSA TOTING JNE #2 / NEWLOC=LOC #M27, FLDA LOC FSTA NEWLOC / CALL RSPEAK(117) / GOTO 2 JSR RSPEAK JA #2 JA #LIT+173 /C /C TRAVEL 302. PLOVER TRANSPORT. DROP THE EMERALD (ONLY USE SPECIAL TRAVEL IF /C TOTING IT), SO HE'S FORCED TO USE THE PLOVER-PASSAGE TO GET IT OUT. HAVING /C DROPPED IT, GO BACK AND PRETEND HE WASN'T CARRYING IT AFTER ALL. /C /30200 CALL DROP(EMRALD,LOC) /GOTO 12 #30200, JSR DROP JA #12 JA EMRALD JA LOC /C /C TRAVEL 303. TROLL BRIDGE. MUST BE DONE ONLY AS SPECIAL MOTION SO THAT /C DWARVES WON'T WANDER ACROSS AND ENCOUNTER THE BEAR. (THEY WON'T FOLLOW THE /C PLAYER THERE BECAUSE THAT REGION IS FORBIDDEN TO THE PIRATE.) IF /C PROP(TROLL)=1, HE'S CROSSED SINCE PAYING, SO STEP OUT AND BLOCK HIM. /C (STANDARD TRAVEL ENTRIES CHECK FOR PROP(TROLL)=0.) SPECIAL STUFF FOR BEAR. /C /30300 IF(PROP(TROLL).NE.1)GOTO 30310 #30300, FLDA TROLL JSA RDPROP FSUB ONE JNE #30310 / CALL PSPEAK(TROLL,1) JSR PSPEAK JA .+6 JA TROLL JA ONE / PROP(TROLL)=0 FCLA FSTA PROP-3,7 / CALL MOVE(TROLL2,0) JSR MOVE JA .+6 JA TROLL2 JA ZERO / CALL MOVE(TROLL2+100,0) FLDA TROLL2 FADD #LIT+154 FSTA #TMP JSR MOVE JA .+6 JA #TMP JA ZERO / CALL MOVE(TROLL,PLAC(TROLL)) FLDA TROLL ATX 7 FLDA PLAC-3,7 FSTA #TMP JSR MOVE JA .+6 JA TROLL JA #TMP / CALL MOVE(TROLL+100,FIXD(TROLL)) FLDA TROLL ATX 7 FADD #LIT+154 FSTA #TMP FLDA FIXD-3,7 FSTA #TMP+3 JSR MOVE JA .+6 JA #TMP JA #TMP+3 / CALL JUGGLE(CHASM) FLDA CHASM JSA JUGGLE / NEWLOC=LOC FLDA LOC FSTA NEWLOC / GOTO 2 JA #2 /C /30310 NEWLOC=PLAC(TROLL)+FIXD(TROLL)-LOC #30310, FLDA TROLL ATX 7 FLDA PLAC-3,7 FADD FIXD-3,7 FSUB LOC FSTA NEWLOC / IF(PROP(TROLL).EQ.0)PROP(TROLL)=1 FLDA PROP-3,7 JNE .+5 FLDA ONE FSTA PROP-3,7 / IF(.NOT.TOTING(BEAR))GOTO 2 FLDA BEAR JSA TOTING JEQ #2 / CALL RSPEAK(162) JSR RSPEAK JA .+4 JA #LIT+237 / PROP(CHASM)=1 FLDA CHASM ATX 7 FLDA ONE FSTA PROP-3,7 / PROP(TROLL)=2 FLDA TROLL ATX 7 FLDA TWO FSTA PROP-3,7 / CALL DROP(BEAR,NEWLOC) JSR DROP JA .+6 JA BEAR JA NEWLOC / FIXED(BEAR)=-1 FLDA BEAR ATX 7 FLDA MINUS1 FSTA FIXED-3,7 / PROP(BEAR)=3 FLDA THREE FSTA PROP-3,7 / IF(PROP(SPICES).LT.0)TALLY2=TALLY2+1 FLDA SPICES JSA RDPROP JGE .+7 FLDA TALLY2 FADD ONE FSTA TALLY2 / OLDLC2=NEWLOC FLDA NEWLOC FSTA OLDLC2 / GOTO 99 JA #99 /C /C END OF SPECIALS. /C /C HANDLE "GO BACK". LOOK FOR VERB WHICH GOES FROM LOC TO OLDLOC, OR TO OLDLC2 /C IF OLDLOC HAS FORCED-MOTION. K2 SAVES ENTRY -> FORCED LOC -> PREVIOUS LOC. /C /20 K=OLDLOC #20, FLDA OLDLOC FSTA K / IF(FORCED(K))K=OLDLC2 / FLDA K JSA FORCED JEQ .+6 FLDA OLDLC2 FSTA K / OLDLC2=OLDLOC FLDA OLDLOC FSTA OLDLC2 / OLDLOC=LOC FLDA LOC FSTA OLDLOC / K2=0 FCLA FSTA K2 / IF(K.NE.LOC)GOTO 21 FLDA K FSUB LOC JNE #21 / CALL RSPEAK(91) / GOTO 2 JSR RSPEAK JA #2 JA #LIT+140 /C /21 LL=TRVLOC(KK) #21, JSR GETWRD JA .+10 JA TRVLOC JA KK JA ZERO FSTA LL / IF(LL.EQ.K)GOTO 25 FSUB K JEQ #25 / IF(LL.GT.300)GOTO 22 FLDA LL FSUB #LIT+306 JGT #22 / J=KEY(LL) FLDA LL ATX 7 FLDA KEY-3,7 FSTA J / IF(FORCED(LL).AND.TRVLOC(KK).EQ.K)K2=KK FLDA LL JSA FORCED JEQ #22 JSR GETWRD JA .+10 JA TRVLOC JA KK JA ZERO FSUB K JNE #22 FLDA KK FSTA K2 /22 IF(TRAVEL(KK).LT.0)GOTO 23 #22, JSR GETWRD JA .+10 JA TRAVEL JA KK JA ZERO JLT #23 / KK=KK+1 FLDA ONE FADDM KK / GOTO 21 JA #21 /C /23 KK=K2 #23, FLDA K2 FSTA KK / IF(KK.NE.0)GOTO 25 JNE #25 / CALL RSPEAK(140) / GOTO 2 JSR RSPEAK JA #2 JA #LIT+223 /C /25 K=IABS(TRAVEL(KK)) #25, JSR GETWRD JA .+10 JA TRAVEL JA KK JA ZERO FSTA #TMP JSR IABS JA .+4 JA #TMP FSTA K / KK=KEY(LOC) FLDA LOC ATX 7 FLDA KEY-3,7 FSTA KK / GOTO 9 JA #9 /C /C LOOK. CAN'T GIVE MORE DETAIL. PRETEND IT WASN'T DARK (THOUGH IT MAY "NOW" /C BE DARK) SO HE WON'T FALL INTO A PIT WHILE STARING INTO THE GLOOM. /C /30 IF(DETAIL.LT.3)CALL RSPEAK(15) #30, FLDA DETAIL FSUB THREE JGE .+10 JSR RSPEAK JA .+4 JA #LIT+25 / DETAIL=DETAIL+1 FLDA ONE FADDM DETAIL / WZDARK=.FALSE. FCLA FSTA WZDARK / ABB(LOC)=0 FLDA LOC ATX 7 FCLA FSTA ABB-3,7 / GOTO 2 JA #2 /C /C CAVE. DIFFERENT MESSAGES DEPENDING ON WHETHER ABOVE GROUND. /C /40 IF(LOC.LT.8)CALL RSPEAK(57) #40, FLDA LOC FSUB #LIT+11 JGE .+10 JSR RSPEAK JA #2 JA #LIT+116 / IF(LOC.GE.8)CALL RSPEAK(58) / GOTO 2 JSR RSPEAK JA #2 JA #LIT+121 /C /C NON-APPLICABLE MOTION. VARIOUS MESSAGES DEPENDING ON WORD GIVEN. /C /50 SPK=12 #50, FLDA #LIT+22 FSTA SPK / IF(K.GE.43.AND.K.LE.50)SPK=9 DECIMAL LDX 43,0 OCTAL XTA 0 FSUB K JGT .+7 FLDA K FSUB #LIT+110 JLE #M31 / IF(K.EQ.29.OR.K.EQ.30)SPK=9 FLDA #LIT+135 FSUB K JEQ #M31 FADD ONE JNE .+6 #M31, FLDA #LIT+14 FSTA SPK JA #M32 / IF(K.EQ.7.OR.K.EQ.36.OR.K.EQ.37)SPK=10 LDX 7,0 XTA 0 FSUB K JEQ #M34 DECIMAL LDX 36,0 OCTAL XTA 0 FSUB K JEQ #M34 FADD ONE JNE #M35 #M34, FLDA #LIT+17 FSTA SPK JA #M32 / IF(K.EQ.11.OR.K.EQ.19)SPK=11 #M35, DECIMAL LDX 11,0 OCTAL XTA 0 FSUB K JEQ #M36 DECIMAL LDX 19,0 OCTAL XTA 0 FSUB K JNE #M32 #M36, DECIMAL LDX 11,0 OCTAL XTA 0 FSTA SPK / IF(VERB.EQ.FIND.OR.VERB.EQ.INVENT)SPK=59 #M32, FLDA VERB FSUB INVENT JEQ #M37 FLDA VERB FSUB FIND JNE #M38 #M37, DECIMAL LDX 59,0 OCTAL XTA 0 FSTA SPK / IF(K.EQ.62.OR.K.EQ.65)SPK=42 #M38, FLDA K FSUB #LIT+124 JEQ #M39 FSUB THREE JNE #M40 #M39, DECIMAL LDX 42,0 OCTAL XTA 0 FSTA SPK / IF(K.EQ.17)SPK=80 #M40, FLDA K FSUB #LIT+33 JNE #M33 FLDA #LIT+325 FSTA SPK / CALL RSPEAK(SPK) / GOTO 2 #M33, JSR RSPEAK JA #2 JA SPK /C "YOU'RE DEAD, JIM." /C /C IF THE CURRENT LOC IS ZERO, IT MEANS THE CLOWN GOT HIMSELF KILLED. WE'LL /C ALLOW THIS MAXDIE TIMES. MAXDIE IS AUTOMATICALLY SET BASED ON THE NUMBER OF /C SNIDE MESSAGES AVAILABLE. EACH DEATH RESULTS IN A MESSAGE (81, 83, ETC.) /C WHICH OFFERS REINCARNATION; IF ACCEPTED, THIS RESULTS IN MESSAGE 82, 84, /C ETC. THE LAST TIME, IF HE WANTS ANOTHER CHANCE, HE GETS A SNIDE REMARK AS /C WE EXIT. WHEN REINCARNATED, ALL OBJECTS BEING CARRIED GET DROPPED AT OLDLC2 /C (PRESUMABLY THE LAST PLACE PRIOR TO BEING KILLED) WITHOUT CHANGE OF PROPS. /C THE LOOP RUNS BACKWARDS TO ASSURE THAT THE BIRD IS DROPPED BEFORE THE CAGE. /C (THIS KLUGE COULD BE CHANGED ONCE WE'RE SURE ALL REFERENCES TO BIRD AND CAGE /C ARE DONE BY KEYWORDS.) THE LAMP IS A SPECIAL CASE (IT WOULDN'T DO TO LEAVE /C IT IN THE CAVE). IT IS TURNED OFF AND LEFT OUTSIDE THE BUILDING (ONLY IF HE /C WAS CARRYING IT, OF COURSE). HE HIMSELF IS LEFT INSIDE THE BUILDING (AND /C HEAVEN HELP HIM IF HE TRIES TO XYZZY BACK INTO THE CAVE WITHOUT THE LAMP!). /C OLDLOC IS ZAPPED SO HE CAN'T JUST "RETREAT". /C /C THE EASIEST WAY TO GET KILLED IS TO FALL INTO A PIT IN PITCH DARKNESS. /C /90 CALL RSPEAK(23) #90, JSR RSPEAK JA .+4 JA #LIT+44 / OLDLC2=LOC FLDA LOC FSTA OLDLC2 /C /C OKAY, HE'S DEAD. LET'S GET ON WITH IT. /C /99 IF(CLOSNG)GOTO 95 #99, FLDA CLOSNG JNE #95 / YEA=YES(81+NUMDIE*2,82+NUMDIE*2,54) FLDA NUMDIE FADD NUMDIE FADD #LIT+132 FSTA #TMP FADD ONE FSTA #TMP+3 JSR YES JA .+10 JA #TMP JA #TMP+3 JA #LIT+113 FSTA YEA / NUMDIE=NUMDIE+1 FLDA NUMDIE FADD ONE FSTA NUMDIE / IF(NUMDIE.EQ.MAXDIE.OR..NOT.YEA)GOTO 20000 FSUB MAXDIE JEQ #20000 FLDA YEA JEQ #20000 / PLACE(WATER)=0 FLDA WATER ATX 7 FCLA FSTA PLACE-3,7 / PLACE(OIL)=0 FLDA OIL ATX 7 FCLA FSTA PLACE-3,7 / IF(TOTING(LAMP))PROP(LAMP)=0 FLDA LAMP JSA TOTING JEQ .+5 FCLA FSTA PROP-3,3 / DO 98 J=1,100 FLDA ONE FSTA J / I=101-J #G0150, DECIMAL LDX 101,0 OCTAL XTA 0 FSUB J FSTA I / IF(.NOT.TOTING(I))GOTO 98 JSA TOTING JEQ #98 / K=OLDLC2 FLDA OLDLC2 FSTA K / IF(I.EQ.LAMP)K=1 FLDA I FSUB LAMP JNE .+5 FLDA ONE FSTA K / CALL DROP(I,K) JSR DROP JA .+6 JA I JA K /98 CONTINUE #98, FLDA J FADD ONE FSTA J FSUB #LIT+154 JLE #G0150 / LOC=3 FLDA THREE / OLDLOC=LOC FSTA LOC FSTA OLDLOC / GOTO 2000 JA #2000 /C /C HE DIED DURING CLOSING TIME. NO RESURRECTION. TALLY UP A DEATH AND EXIT. /C /95 CALL RSPEAK(131) #95, JSR RSPEAK JA .+4 JA #LIT+212 / NUMDIE=NUMDIE+1 FLDA ONE FADDM NUMDIE / GOTO 20000 JA #20000 /C ROUTINES FOR PERFORMING THE VARIOUS ACTION VERBS /C /C STATEMENT NUMBERS IN THIS SECTION ARE 8000 FOR INTRANSITIVE VERBS, 9000 FOR /C TRANSITIVE, PLUS TEN TIMES THE VERB NUMBER. MANY INTRANSITIVE VERBS USE THE /C TRANSITIVE CODE, AND SOME VERBS USE CODE FOR OTHER VERBS, AS NOTED BELOW. /C /C RANDOM INTRANSITIVE VERBS COME HERE. CLEAR OBJ JUST IN CASE (SEE "ATTACK"). /C /8000 TYPE 8002 #8000, JSA SPRINT JA #8002 JA TWO /8002 FORMAT(' I don''t understand "',$) / CALL A5TOA1(WD1,WD1A,WD1X,'".') JSR A5TOA1 JA .+10 JA WD1 JA WD1X JA TQDOT / OBJ=0 FCLA FSTA OBJ TRAP3 #WRITO JA #LIT JA #LINEF+2 TRAP3 #RENDO / GOTO 2600 JA #2600 /C /C CARRY, NO OBJECT GIVEN YET. OK IF ONLY ONE OBJECT PRESENT. /C /8010 IF(ATLOC(LOC).EQ.0.OR.LINK(ATLOC(LOC)).NE.0)GOTO 8000 #8010, FLDA LOC ATX 7 FLDA ATLOC-3,7 JEQ #8000 ATX 6 FLDA LINK-3,6 JNE #8000 / DO 8012 I=1,5 FLDA ONE FSTA I / IF(DLOC(I).EQ.LOC.AND.DFLAG.GE.2)GOTO 8000 #G0152, FLDA I ATX 7 FLDA DLOC-3,7 FSUB LOC JNE #8012 FLDA DFLAG FSUB TWO JGE #8000 /8012 CONTINUE #8012, FLDA I FADD ONE FSTA I FSUB #LIT+3 JLE #G0152 / OBJ=ATLOC(LOC) FLDA LOC ATX 7 FLDA ATLOC-3,7 FSTA OBJ /C /C CARRY AN OBJECT. SPECIAL CASES FOR BIRD AND CAGE (IF BIRD IN CAGE, CAN'T /C TAKE ONE WITHOUT THE OTHER. LIQUIDS ALSO SPECIAL, SINCE THEY DEPEND ON /C STATUS OF BOTTLE. ALSO VARIOUS SIDE EFFECTS, ETC. /C /9010 IF(TOTING(OBJ))GOTO 2011 #9010, FLDA OBJ JSA TOTING JNE #2011 / SPK=25 FLDA #LIT+52 FSTA SPK / IF(OBJ.EQ.PLANT.AND.PROP(PLANT).LE.0)SPK=115 FLDA OBJ FSUB PLANT JNE .+12 FLDA PLANT JSA RDPROP JGT .+4 FLDA #LIT+165 FSTA SPK / IF(OBJ.EQ.BEAR.AND.PROP(BEAR).EQ.1)SPK=169 FLDA OBJ FSUB BEAR JNE .+15 FLDA BEAR JSA RDPROP FSUB ONE JNE .+6 DECIMAL LDX 169,0 OCTAL XTA 0 FSTA SPK / IF(OBJ.EQ.CHAIN.AND.PROP(BEAR).NE.0)SPK=170 FLDA OBJ FSUB CHAIN JNE .+14 FLDA BEAR JSA RDPROP JEQ .+6 DECIMAL LDX 170,0 OCTAL XTA 0 FSTA SPK / IF(FIXED(OBJ).NE.0)GOTO 2011 FLDA OBJ ATX 7 FLDA FIXED-3,7 JNE #2011 / IF(OBJ.NE.WATER.AND.OBJ.NE.OIL)GOTO 9017 FLDA OBJ FSUB WATER JEQ .+10 FLDA OBJ FSUB OIL JNE #9017 / IF(HERE(BOTTLE).AND.LIQ(0).EQ.OBJ)GOTO 9018 FLDA BOTTLE JSA HERE JEQ .+10 JSA LIQ FSUB OBJ JEQ #9018 / OBJ=BOTTLE FLDA BOTTLE FSTA OBJ / IF(TOTING(BOTTLE).AND.PROP(BOTTLE).EQ.1)GOTO 9220 FLDA BOTTLE JSA TOTING JEQ .+7 FLDA PROP-3,3 FSUB ONE JEQ #9220 / IF(PROP(BOTTLE).NE.1)SPK=105 FLDA PROP-3,3 FSUB ONE JEQ .+4 FLDA #LIT+157 FSTA SPK / IF(.NOT.TOTING(BOTTLE))SPK=104 FLDA BOTTLE JSA TOTING JNE #2011 DECIMAL LDX 104,0 OCTAL XTA 0 FSTA SPK / GOTO 2011 JA #2011 /9018 OBJ=BOTTLE #9018, FLDA BOTTLE FSTA OBJ /9017 IF(HOLDNG.LT.7)GOTO 9016 #9017, LDX 7,0 XTA 0 FSUB HOLDNG JGE #9016 / CALL RSPEAK(92) JSR RSPEAK JA #2012 JA #LIT+143 / GOTO 2012 /9016 IF(OBJ.NE.BIRD)GOTO 9014 #9016, FLDA OBJ FSUB BIRD JNE #9014 / IF(PROP(BIRD).NE.0)GOTO 9014 FLDA BIRD JSA RDPROP JNE #9014 / IF(.NOT.TOTING(ROD))GOTO 9013 FLDA ROD JSA TOTING JEQ #9013 / CALL RSPEAK(26) JSR RSPEAK JA #2012 JA #LIT+55 / GOTO 2012 /9013 IF(TOTING(CAGE))GOTO 9015 #9013, FLDA CAGE JSA TOTING JNE #9015 / CALL RSPEAK(27) JSR RSPEAK JA #2012 JA #LIT+60 / GOTO 2012 /9015 PROP(BIRD)=1 #9015, FLDA BIRD ATX 7 FLDA ONE FSTA PROP-3,7 /9014 IF((OBJ.EQ.BIRD.OR.OBJ.EQ.CAGE).AND.PROP(BIRD).NE.0) / 1 CALL CARRY(BIRD+CAGE-OBJ,LOC) #9014, FLDA OBJ FSUB BIRD JEQ .+10 FLDA OBJ FSUB CAGE JNE .+27 FLDA BIRD JSA RDPROP JEQ .+21 FLDA BIRD FADD CAGE FSUB OBJ FSTA #TMP JSR CARRY JA .+6 JA #TMP JA LOC / CALL CARRY(OBJ,LOC) JSR CARRY JA .+6 JA OBJ JA LOC / K=LIQ(0) JSA LIQ FSTA K / IF(OBJ.EQ.BOTTLE.AND.K.NE.0)PLACE(K)=-1 FLDA OBJ FSUB BOTTLE JNE #2009A FLDA K JEQ #2009A ATX 7 FLDA MINUS1 FSTA PLACE-3,7 / GOTO 2009 #2009A, DECIMAL LDX 202,0 OCTAL XTA 0 FSTA K /RHM - "Taken" message JA #2010 /C /C DISCARD OBJECT. "THROW" ALSO COMES HERE FOR MOST OBJECTS. SPECIAL CASES FOR /C BIRD (MIGHT ATTACK SNAKE OR DRAGON) AND CAGE (MIGHT CONTAIN BIRD) AND VASE. /C DROP COINS AT VENDING MACHINE FOR EXTRA BATTERIES. /C /9020 IF(TOTING(ROD2).AND.OBJ.EQ.ROD.AND..NOT.TOTING(ROD))OBJ=ROD2 #9020, FLDA ROD2 JSA TOTING JEQ .+22 FLDA OBJ FSUB ROD JNE .+14 FLDA ROD JSA TOTING JNE .+6 FLDA ROD2 FSTA OBJ / IF(.NOT.TOTING(OBJ))GOTO 2011 FLDA OBJ JSA TOTING JEQ #2011 / IF(OBJ.NE.BIRD.OR..NOT.HERE(SNAKE))GOTO 9024 FLDA OBJ FSUB BIRD JNE #9024 FLDA SNAKE JSA HERE JEQ #9024 / CALL RSPEAK(30) JSR RSPEAK JA .+4 JA #LIT+63 / IF(CLOSED)GOTO 19000 FLDA CLOSED JNE #19000 / CALL DSTROY(SNAKE) FLDA SNAKE JSA DSTROY /C /C SET PROP FOR USE BY TRAVEL OPTIONS /C / PROP(SNAKE)=1 FLDA SNAKE ATX 7 FLDA ONE FSTA PROP-3,7 /9021 K=LIQ(0) #9021, JSA LIQ FSTA K / IF(K.EQ.OBJ)OBJ=BOTTLE FSUB OBJ JNE .+6 FLDA BOTTLE FSTA OBJ / IF(OBJ.EQ.BOTTLE.AND.K.NE.0)PLACE(K)=0 FLDA OBJ FSUB BOTTLE JNE .+12 FLDA K JEQ .+6 ATX 7 FCLA FSTA PLACE-3,7 / IF(OBJ.EQ.CAGE.AND.PROP(BIRD).NE.0)CALL DROP(BIRD,LOC) FLDA OBJ FSUB CAGE JNE .+20 FLDA BIRD JSA RDPROP JEQ .+12 JSR DROP JA .+6 JA BIRD JA LOC / IF(OBJ.EQ.BIRD)PROP(BIRD)=0 FLDA OBJ FSUB BIRD JNE .+10 FLDA BIRD ATX 7 FCLA FSTA PROP-3,7 / CALL DROP(OBJ,LOC) JSR DROP / GO TO 2012 JA #2012 / JA OBJ JA LOC /C /9024 IF(OBJ.NE.COINS.OR..NOT.HERE(VEND))GOTO 9025 #9024, FLDA OBJ FSUB COINS JNE #9025 FLDA VEND JSA HERE JEQ #9025 / CALL DSTROY(COINS) FLDA COINS JSA DSTROY / CALL DROP(BATTER,LOC) JSR DROP JA .+6 JA BATTER JA LOC / CALL PSPEAK(BATTER,0) JSR PSPEAK JA .+6 JA BATTER JA ZERO / GOTO 2012 JA #2012 /C /9025 IF(OBJ.NE.BIRD.OR..NOT.AT(DRAGON).OR.PROP(DRAGON).NE.0)GOTO 9026 #9025, FLDA OBJ FSUB BIRD JNE #9026 FLDA DRAGON JSA AT JEQ #9026 / FLDA DRAGON / ATX 3 FLDA PROP-3,3 JNE #9026 / CALL RSPEAK(154) JSR RSPEAK JA .+4 JA #LIT+333 / CALL DSTROY(BIRD) FLDA BIRD JSA DSTROY / PROP(BIRD)=0 FLDA BIRD ATX 7 FCLA FSTA PROP-3,7 / IF(PLACE(SNAKE).EQ.PLAC(SNAKE))TALLY2=TALLY2+1 FLDA SNAKE ATX 7 FLDA PLACE-3,7 FSUB PLAC-3,7 JNE #2012 FLDA TALLY2 FADD ONE FSTA TALLY2 / GOTO 2012 JA #2012 /C /9026 IF(OBJ.NE.BEAR.OR..NOT.AT(TROLL))GOTO 9027 #9026, FLDA OBJ FSUB BEAR JNE #9027 FLDA TROLL JSA AT JEQ #9027 / CALL RSPEAK(163) JSR RSPEAK JA .+4 JA #LIT+242 / CALL MOVE(TROLL,0) JSR MOVE JA .+6 JA TROLL JA ZERO / CALL MOVE(TROLL+100,0) FLDA TROLL FADD #LIT+154 FSTA #TMP JSR MOVE JA .+6 JA #TMP JA ZERO / CALL MOVE(TROLL2,PLAC(TROLL)) FLDA TROLL ATX 7 FLDA PLAC-3,7 FSTA #TMP JSR MOVE JA .+6 JA TROLL2 JA #TMP / CALL MOVE(TROLL2+100,FIXD(TROLL)) FLDA TROLL2 FADD #LIT+154 FSTA #TMP / FLDA TROLL / ATX 7 FLDA FIXD-3,7 FSTA #TMP+3 JSR MOVE JA .+6 JA #TMP JA #TMP+3 / CALL JUGGLE(CHASM) FLDA CHASM JSA JUGGLE / PROP(TROLL)=2 / FLDA TROLL / ATX 7 FLDA TWO FSTA PROP-3,7 / GOTO 9021 JA #9021 /C /9027 IF(OBJ.EQ.VASE.AND.LOC.NE.PLAC(PILLOW))GOTO 9028 #9027, FLDA OBJ FSUB VASE JNE .+13 FLDA PILLOW ATX 7 FLDA LOC FSUB PLAC-3,7 JNE #9028 / CALL RSPEAK(54) JSR RSPEAK JA #9021 JA #LIT+113 / GOTO 9021 /C /9028 PROP(VASE)=2 #9028, FLDA VASE ATX 7 FLDA TWO FSTA PROP-3,7 / IF(AT(PILLOW))PROP(VASE)=0 FLDA PILLOW JSA AT JEQ .+10 FLDA VASE ATX 7 FCLA FSTA PROP-3,7 / CALL PSPEAK(VASE,PROP(VASE)+1) FLDA VASE JSA RDPROP FADD ONE FSTA #TMP JSR PSPEAK JA .+6 JA VASE JA #TMP / IF(PROP(VASE).NE.0)FIXED(VASE)=-1 FLDA VASE ATX 7 FLDA PROP-3,7 JEQ #9021 FLDA MINUS1 FSTA FIXED-3,7 / GOTO 9021 JA #9021 /C /C SAY. ECHO WD2 (OR WD1 IF NO WD2 (SAY WHAT?, ETC.).) MAGIC WORDS OVERRIDE. /C /9030 IF(WD2.EQ.0)GOTO 9031 #9030, FLDA WD2 JEQ #9031 / WD1=WD2 WD1A=WD2A FLDA WD2 FSTA WD1 / WD1X=WD2X FLDA WD2X FSTA WD1X /9031 CALL VOCAB(WD1,WD1A,-1,I) #9031, JSR VOCAB JA .+6 JA WD1 JA MINUS1 FSTA I / IF(I.EQ.62.OR.I.EQ.65.OR.I.EQ.71.OR.I.EQ.2025)GOTO 9035 FSUB #LIT+124 JEQ #9035 FSUB THREE JEQ #9035 FSUB #LIT+3 JEQ #9035 DECIMAL LDX 2025,0 OCTAL XTA 0 FSUB I JEQ #9035 / TYPE 9032 JSA SPRINT JA #9032 JA TWO /9032 FORMAT(' Okay, "',$) / CALL A5TOA1(WD1,WD1A,WD1X,'".') JSR A5TOA1 JA #2012 JA WD1 JA WD1X JA TQDOT / GOTO 2012 /C /9035 WD2=0 #9035, FCLA FSTA WD2 / OBJ=0 FSTA OBJ / GOTO 2630 JA #2630 /C /C LOCK, UNLOCK, NO OBJECT GIVEN. ASSUME VARIOUS THINGS IF PRESENT. /C /8040 SPK=28 #8040, DECIMAL LDX 28,0 OCTAL XTA 0 FSTA SPK / IF(HERE(CLAM))OBJ=CLAM FLDA CLAM JSA HERE JEQ .+6 FLDA CLAM FSTA OBJ / IF(HERE(OYSTER))OBJ=OYSTER FLDA OYSTER JSA HERE JEQ .+6 FLDA OYSTER FSTA OBJ / IF(AT(DOOR))OBJ=DOOR FLDA DOOR JSA AT JEQ .+6 FLDA DOOR FSTA OBJ / IF(AT(GRATE))OBJ=GRATE FLDA GRATE JSA AT JEQ .+6 FLDA GRATE FSTA OBJ / IF(OBJ.NE.0.AND.HERE(CHAIN))GOTO 8000 FLDA OBJ JEQ .+10 FLDA CHAIN JSA HERE JNE #8000 / IF(HERE(CHAIN))OBJ=CHAIN FLDA CHAIN JSA HERE JEQ .+6 FLDA CHAIN FSTA OBJ / IF(OBJ.EQ.0)GOTO 2011 FLDA OBJ JEQ #2011 /C /C LOCK, UNLOCK OBJECT. SPECIAL STUFF FOR OPENING CLAM/OYSTER AND FOR CHAIN. /C /9040 IF(OBJ.EQ.CLAM.OR.OBJ.EQ.OYSTER)GOTO 9046 #9040, FLDA OBJ FSUB CLAM JEQ #9046 FLDA OBJ FSUB OYSTER JEQ #9046 / IF(OBJ.EQ.DOOR)SPK=111 FLDA OBJ FSUB DOOR JNE #9040A DECIMAL LDX 111,0 OCTAL XTA 0 FSTA SPK / IF(OBJ.EQ.DOOR.AND.PROP(DOOR).EQ.1)SPK=54 #9040A, FLDA OBJ FSUB DOOR JNE .+13 FLDA DOOR JSA RDPROP FSUB ONE JEQ .+4 FLDA #LIT+113 FSTA SPK / IF(OBJ.EQ.CAGE)SPK=32 FLDA OBJ FSUB CAGE JNE .+6 DECIMAL LDX 32,0 OCTAL XTA 0 FSTA SPK / IF(OBJ.EQ.KEYS)SPK=55 FLDA OBJ FSUB KEYS JNE .+6 DECIMAL LDX 55,0 OCTAL XTA 0 FSTA SPK / IF(OBJ.EQ.GRATE.OR.OBJ.EQ.CHAIN)SPK=31 FLDA OBJ FSUB GRATE JEQ .+10 FLDA OBJ FSUB CHAIN JNE .+6 DECIMAL LDX 31,0 OCTAL XTA 0 FSTA SPK / IF(SPK.NE.31.OR..NOT.HERE(KEYS))GOTO 2011 DECIMAL LDX 31,0 OCTAL XTA 0 FSUB SPK JNE #2011 FLDA KEYS JSA HERE JEQ #2011 / IF(OBJ.EQ.CHAIN)GOTO 9048 FLDA OBJ FSUB CHAIN JEQ #9048 / IF(.NOT.CLOSNG)GOTO 9043 FLDA CLOSNG JEQ #9043 / K=130 FLDA #LIT+207 FSTA K / IF(.NOT.PANIC)CLOCK2=15 FLDA PANIC JNE .+5 FLDA #LIT+25 FSTA CLOCK2 / PANIC=.TRUE. FLDA ONE FSTA PANIC / GOTO 2010 JA #2010 /C /9043 K=34+PROP(GRATE) #9043, FLDA GRATE ATX 7 DECIMAL LDX 34,0 OCTAL XTA 0 FADD PROP-3,7 FSTA K / IF(VERB.EQ.LOCK)PROP(GRATE)=0 FLDA ONE FSTA PROP-3,7 FLDA VERB FSUB LOCK JNE .+4 / FCLA / already zero FSTA PROP-3,7 / K=K+2*PROP(GRATE) FLDA TWO FMUL PROP-3,7 FADD K FSTA K / GOTO 2010 JA #2010 /C /C CLAM/OYSTER. /C /9046 K=0 #9046, FCLA FSTA K / IF(OBJ.EQ.OYSTER)K=1 FLDA OBJ FSUB OYSTER JNE .+5 FLDA ONE FSTA K / SPK=124+K DECIMAL LDX 124,0 OCTAL XTA 0 FADD K FSTA SPK / IF(TOTING(OBJ))SPK=120+K FLDA OBJ JSA TOTING JEQ #9046A DECIMAL LDX 120,0 OCTAL XTA 0 FADD K FSTA SPK / IF(.NOT.TOTING(TRIDNT))SPK=122+K #9046A, FLDA TRIDNT JSA TOTING JNE .+10 DECIMAL LDX 122,0 OCTAL XTA 0 FADD K FSTA SPK / IF(VERB.EQ.LOCK)SPK=61 FLDA VERB FSUB LOCK JNE .+6 DECIMAL LDX 61,0 OCTAL XTA 0 FSTA SPK / IF(SPK.NE.124)GOTO 2011 DECIMAL LDX 124,0 OCTAL XTA 0 FSUB SPK JNE #2011 / CALL DSTROY(CLAM) FLDA CLAM JSA DSTROY / CALL DROP(OYSTER,LOC) JSR DROP JA .+6 JA OYSTER JA LOC / CALL DROP(PEARL,105) JSR DROP JA #2011 JA PEARL JA #LIT+157 / GOTO 2011 /C /C CHAIN. /C /9048 IF(VERB.EQ.LOCK)GOTO 9049 #9048, FLDA VERB FSUB LOCK JEQ #9049 / SPK=171 DECIMAL LDX 171,0 OCTAL XTA 0 FSTA SPK / IF(PROP(BEAR).EQ.0)SPK=41 FLDA BEAR JSA RDPROP JNE .+6 DECIMAL LDX 41,0 OCTAL XTA 0 FSTA SPK / IF(PROP(CHAIN).EQ.0)SPK=37 FLDA CHAIN JSA RDPROP JNE .+4 FLDA #LIT+71 FSTA SPK / IF(SPK.NE.171)GOTO 2011 DECIMAL LDX 171,0 OCTAL XTA 0 FSUB SPK JNE #2011 / PROP(CHAIN)=0 FCLA FSTA PROP-3,7 / FIXED(CHAIN)=0 FSTA FIXED-3,7 / IF(PROP(BEAR).NE.3)PROP(BEAR)=2 FLDA BEAR JSA RDPROP FSUB THREE JEQ .+5 FLDA TWO FSTA PROP-3,7 / FIXED(BEAR)=2-PROP(BEAR) FLDA TWO FSUB PROP-3,7 FSTA FIXED-3,7 / GOTO 2011 JA #2011 /C /9049 SPK=172 #9049, DECIMAL LDX 172,0 OCTAL XTA 0 FSTA SPK / IF(PROP(CHAIN).NE.0)SPK=34 FLDA CHAIN JSA RDPROP JEQ .+6 DECIMAL LDX 34,0 OCTAL XTA 0 FSTA SPK / IF(LOC.NE.PLAC(CHAIN))SPK=173 FLDA LOC FSUB PLAC-3,7 JEQ .+6 DECIMAL LDX 173,0 OCTAL XTA 0 FSTA SPK / IF(SPK.NE.172)GOTO 2011 DECIMAL LDX 172,0 OCTAL XTA 0 FSUB SPK JNE #2011 / PROP(CHAIN)=2 FLDA TWO FSTA PROP-3,7 / IF(TOTING(CHAIN))CALL DROP(CHAIN,LOC) FLDA CHAIN JSA TOTING JEQ .+12 JSR DROP JA .+6 JA CHAIN JA LOC / FIXED(CHAIN)=-1 FLDA MINUS1 FSTA FIXED-3,7 / GOTO 2011 JA #2011 /C /C LIGHT LAMP /C /9070 IF(.NOT.HERE(LAMP))GOTO 2011 #9070, FLDA LAMP JSA HERE JEQ #2011 / SPK=184 FLDA #LIT+253 FSTA SPK / IF(LIMIT.LT.0)GOTO 2011 FLDA LIMIT JLT #2011 / PROP(LAMP)=1 FLDA LAMP ATX 7 FLDA ONE FSTA PROP-3,7 / CALL RSPEAK(39) JSR RSPEAK JA .+4 JA #LIT+74 / IF(WZDARK)GOTO 2000 FLDA WZDARK JNE #2000 / GOTO 2012 JA #2012 /C /C LAMP OFF /C /9080 IF(.NOT.HERE(LAMP))GOTO 2011 #9080, FLDA LAMP ATX 7 JSA HERE JEQ #2011 / PROP(LAMP)=0 FCLA FSTA PROP-3,7 / CALL RSPEAK(40) JSR RSPEAK JA .+4 JA #LIT+77 / IF(DARK(0))CALL RSPEAK(16) JSA DARK JEQ #2012 JSR RSPEAK JA #2012 JA #LIT+30 / GOTO 2012 /C /C WAVE. NO EFFECT UNLESS WAVING ROD AT FISSURE. /C /9090 IF((.NOT.TOTING(OBJ)).AND.(OBJ.NE.ROD.OR..NOT.TOTING(ROD2))) / 1 SPK=29 #9090, FLDA OBJ JSA TOTING JNE .+20 FLDA OBJ FSUB ROD JNE .+12 FLDA ROD2 JSA TOTING JNE .+4 FLDA #LIT+135 FSTA SPK / IF(OBJ.NE.ROD.OR..NOT.AT(FISSUR).OR..NOT.TOTING(OBJ) / 1 .OR.CLOSNG)GOTO 2011 FLDA OBJ FSUB ROD JNE #2011 FLDA FISSUR JSA AT JEQ #2011 FLDA OBJ JSA TOTING JEQ #2011 FLDA CLOSNG JNE #2011 / PROP(FISSUR)=1-PROP(FISSUR) FLDA FISSUR ATX 7 FLDA ONE FSUB PROP-3,7 FSTA PROP-3,7 / CALL PSPEAK(FISSUR,2-PROP(FISSUR)) FLDA FISSUR ATX 7 FLDA TWO FSUB PROP-3,7 FSTA #TMP JSR PSPEAK JA #2012 JA FISSUR JA #TMP / GOTO 2012 /C /C ATTACK. ASSUME TARGET IF UNAMBIGUOUS. "THROW" ALSO LINKS HERE. ATTACKABLE /C OBJECTS FALL INTO TWO CATEGORIES: ENEMIES (SNAKE, DWARF, ETC.) AND OTHERS /C (BIRD, CLAM). AMBIGUOUS IF TWO ENEMIES, OR IF NO ENEMIES BUT TWO OTHERS. /C /9120 DO 9121 I=1,5 #9120, FLDA ONE FSTA I #H0102, FLDA I ATX 7 / IF(DLOC(I).EQ.LOC.AND.DFLAG.GE.2)GOTO 9122 FLDA DLOC-3,7 FSUB LOC JNE #9121 FLDA DFLAG FSUB TWO JGE #9122 /9121 CONTINUE #9121, FLDA I FADD ONE FSTA I FSUB #LIT+3 JLE #H0102 / I=0 FCLA FSTA I /9122 IF(OBJ.NE.0)GOTO 9124 #9122, FLDA OBJ JNE #9124 / IF(I.NE.0)OBJ=DWARF FLDA I JEQ .+6 FLDA DWARF FSTA OBJ / IF(HERE(SNAKE))OBJ=OBJ*100+SNAKE FLDA SNAKE JSA HERE JEQ .+11 FLDA OBJ FMUL #LIT+154 FADD SNAKE FSTA OBJ / IF(AT(DRAGON).AND.PROP(DRAGON).EQ.0)OBJ=OBJ*100+DRAGON FLDA DRAGON JSA AT JEQ .+15 / FLDA DRAGON / ATX 3 FLDA PROP-3,3 JNE .+11 FLDA OBJ FMUL #LIT+154 FADD DRAGON FSTA OBJ / IF(AT(TROLL))OBJ=OBJ*100+TROLL FLDA TROLL JSA AT JEQ .+11 FLDA OBJ FMUL #LIT+154 FADD TROLL FSTA OBJ / IF(HERE(BEAR).AND.PROP(BEAR).EQ.0)OBJ=OBJ*100+BEAR FLDA BEAR JSA HERE JEQ .+15 FLDA PROP-3,3 JNE .+11 FLDA OBJ FMUL #LIT+154 FADD BEAR FSTA OBJ / IF(OBJ.GT.100)GOTO 8000 FLDA OBJ FSUB #LIT+154 JGT #8000 / IF(OBJ.NE.0)GOTO 9124 FLDA OBJ JNE #9124 /C /C CAN'T ATTACK BIRD BY THROWING AXE. /C / IF(HERE(BIRD).AND.VERB.NE.THROW)OBJ=BIRD FLDA BEAR JSA HERE JEQ .+14 FLDA VERB FSUB THROW JNE .+6 FLDA BIRD FSTA OBJ /C /C CLAM AND OYSTER BOTH TREATED AS CLAM FOR INTRANSITIVE CASE; NO HARM DONE. /C / IF(HERE(CLAM).OR.HERE(OYSTER))OBJ=100*OBJ+CLAM FLDA CLAM JSA HERE JNE .+10 FLDA OYSTER JSA HERE JEQ .+11 FLDA #LIT+154 FMUL OBJ FADD CLAM FSTA OBJ / IF(OBJ.GT.100)GOTO 8000 FLDA OBJ FSUB #LIT+154 JGT #8000 /9124 IF(OBJ.NE.BIRD)GOTO 9125 #9124, FLDA OBJ FSUB BIRD JNE #9125 / SPK=137 DECIMAL LDX 137,0 OCTAL XTA 0 FSTA SPK / IF(CLOSED)GOTO 2011 FLDA CLOSED JNE #2011 / CALL DSTROY(BIRD) FLDA BIRD JSA DSTROY / PROP(BIRD)=0 FLDA BIRD ATX 7 FCLA FSTA PROP-3,7 / IF(PLACE(SNAKE).EQ.PLAC(SNAKE))TALLY2=TALLY2+1 FLDA SNAKE ATX 7 FLDA PLACE-3,7 FSUB PLAC-3,7 JNE .+7 FLDA TALLY2 FADD ONE FSTA TALLY2 / SPK=45 FLDA #LIT+102 FSTA SPK /9125 IF(OBJ.EQ.0)SPK=44 #9125, FLDA OBJ JNE .+6 DECIMAL LDX 44,0 OCTAL XTA 0 FSTA SPK / IF(OBJ.EQ.CLAM.OR.OBJ.EQ.OYSTER)SPK=150 FLDA OBJ FSUB CLAM JEQ .+10 FLDA OBJ FSUB OYSTER JNE .+6 DECIMAL LDX 150,0 OCTAL XTA 0 FSTA SPK / IF(OBJ.EQ.SNAKE)SPK=46 FLDA OBJ FSUB SNAKE JNE .+6 DECIMAL LDX 46,0 OCTAL XTA 0 FSTA SPK / IF(OBJ.EQ.DWARF)SPK=49 FLDA OBJ FSUB DWARF JNE .+4 FLDA #LIT+105 FSTA SPK / IF(OBJ.EQ.DWARF.AND.CLOSED)GOTO 19000 FLDA OBJ FSUB DWARF JNE .+6 FLDA CLOSED JNE #19000 / IF(OBJ.EQ.DRAGON)SPK=167 FLDA OBJ FSUB DRAGON JNE .+6 DECIMAL LDX 167,0 OCTAL XTA 0 FSTA SPK / IF(OBJ.EQ.TROLL)SPK=157 FLDA OBJ FSUB TROLL JNE .+6 DECIMAL LDX 157,0 OCTAL XTA 0 FSTA SPK / IF(OBJ.EQ.BEAR)SPK=165+(PROP(BEAR)+1)/2 FLDA OBJ FSUB BEAR JNE .+14 FLDA BEAR JSA RDPROP FADD ONE FDIV TWO JSA #FIX FADD #LIT+245 FSTA SPK / IF(OBJ.NE.DRAGON.OR.PROP(DRAGON).NE.0)GOTO 2011 FLDA OBJ FSUB DRAGON JNE #2011 FLDA DRAGON JSA RDPROP JNE #2011 /C /C FUN STUFF FOR DRAGON. IF HE INSISTS ON ATTACKING IT, WIN! SET PROP TO DEAD, /C MOVE DRAGON TO CENTRAL LOC (STILL FIXED), MOVE RUG THERE (NOT FIXED), AND /C MOVE HIM THERE, TOO. THEN DO A NULL MOTION TO GET NEW DESCRIPTION. /C / CALL RSPEAK(49) JSR RSPEAK JA .+4 JA #LIT+105 / VERB=0 FCLA FSTA VERB / OBJ=0 FSTA OBJ / CALL GETIN(WD1,WD1A,WD1X,WD2,WD2A,WD2X) JSR GETIN JA .+12 JA WD1 JA WD1X JA WD2 JA WD2X / IF(WD1.NE.'YE'.AND.WD1.NE.'Y')GOTO 2608 FLDA WD1 FSUB TYES JEQ OKKILL FLDA WD1 FSUB TYE JEQ OKKILL FLDA WD1 FSUB TY JNE #2608 / CALL PSPEAK(DRAGON,1) OKKILL, JSR PSPEAK JA .+6 JA DRAGON JA ONE / PROP(DRAGON)=2 FLDA DRAGON ATX 7 FLDA TWO FSTA PROP-3,7 / PROP(RUG)=0 FLDA RUG ATX 7 FCLA FSTA PROP-3,7 / K=(PLAC(DRAGON)+FIXD(DRAGON))/2 FLDA DRAGON ATX 7 FLDA PLAC-3,7 FADD FIXD-3,7 FDIV TWO JSA #FIX FSTA K / CALL MOVE(DRAGON+100,-1) FLDA DRAGON FADD #LIT+154 FSTA #TMP JSR MOVE JA .+6 JA #TMP JA MINUS1 / CALL MOVE(RUG+100,0) FLDA RUG FADD #LIT+154 FSTA #TMP JSR MOVE JA .+6 JA #TMP JA ZERO / CALL MOVE(DRAGON,K) JSR MOVE JA .+6 JA DRAGON JA K / CALL MOVE(RUG,K) JSR MOVE JA .+6 JA RUG JA K / DO 9126 OBJ=1,100 FLDA ONE FSTA OBJ / IF(PLACE(OBJ).EQ.PLAC(DRAGON).OR.PLACE(OBJ).EQ.FIXD(DRAGON)) / 1 CALL MOVE(OBJ,K) #H0122, FLDA OBJ ATX 7 FLDA DRAGON ATX 6 FLDA PLACE-3,7 FSUB PLAC-3,6 JEQ .+10 FLDA PLACE-3,7 FSUB FIXD-3,6 JNE #9126 JSR MOVE JA .+6 JA OBJ JA K /9126 CONTINUE #9126, FLDA OBJ FADD ONE FSTA OBJ FSUB #LIT+154 JLE #H0122 / LOC=K FLDA K FSTA LOC / K=NULL FLDA NULL FSTA K / GOTO 8 JA #8 /C /C POUR. IF NO OBJECT, OR OBJECT IS BOTTLE, ASSUME CONTENTS OF BOTTLE. /C SPECIAL TESTS FOR POURING WATER OR OIL ON PLANT OR RUSTY DOOR. /C /9130 IF(OBJ.EQ.BOTTLE.OR.OBJ.EQ.0)OBJ=LIQ(0) #9130, FLDA OBJ FSUB BOTTLE JEQ .+6 FLDA OBJ JNE .+6 JSA LIQ FSTA OBJ / IF(OBJ.EQ.0)GOTO 8000 FLDA OBJ JEQ #8000 / IF(.NOT.TOTING(OBJ))GOTO 2011 FLDA OBJ JSA TOTING JEQ #2011 / SPK=78 DECIMAL LDX 78,0 OCTAL XTA 0 FSTA SPK / IF(OBJ.NE.OIL.AND.OBJ.NE.WATER)GOTO 2011 FLDA OBJ FSUB OIL JEQ .+10 FLDA OBJ FSUB WATER JNE #2011 / PROP(BOTTLE)=1 FLDA BOTTLE ATX 7 FLDA ONE FSTA PROP-3,7 / PLACE(OBJ)=0 FLDA OBJ ATX 7 FCLA FSTA PLACE-3,7 / SPK=77 DECIMAL LDX 77,0 OCTAL XTA 0 FSTA SPK / IF(.NOT.(AT(PLANT).OR.AT(DOOR)))GOTO 2011 FLDA PLANT JSA AT JNE .+10 FLDA DOOR JSA AT JEQ #2011 /C / IF(AT(DOOR))GOTO 9132 FLDA DOOR JSA AT JNE #9132 / SPK=112 DECIMAL LDX 112,0 OCTAL XTA 0 FSTA SPK / IF(OBJ.NE.WATER)GOTO 2011 FLDA OBJ FSUB WATER JNE #2011 / CALL PSPEAK(PLANT,PROP(PLANT)+1) FLDA PLANT JSA RDPROP FADD ONE FSTA #TMP JSR PSPEAK JA .+6 JA PLANT JA #TMP / PROP(PLANT)=MOD(PROP(PLANT)+2,6) FLDA PLANT JSA RDPROP FADD TWO FSTA #TMP JSR MOD JA .+6 JA #TMP JA #LIT+6 FSTA PROP-3,7 / PROP(PLANT2)=PROP(PLANT)/2 FLDA PLANT2 ATX 7 FLDA PLANT JSA RDPROP FDIV TWO JSA #FIX FSTA PROP-3,6 / K=NULL FLDA NULL FSTA K / GOTO 8 JA #8 /C /9132 PROP(DOOR)=0 #9132, FLDA DOOR ATX 7 FCLA FSTA PROP-3,7 / IF(OBJ.EQ.OIL)PROP(DOOR)=1 FLDA OBJ FSUB OIL JNE .+10 FLDA DOOR ATX 7 FLDA ONE FSTA PROP-3,7 / SPK=113+PROP(DOOR) FLDA DOOR ATX 7 DECIMAL LDX 113,0 OCTAL XTA 0 FADD PROP-3,7 FSTA SPK / GOTO 2011 JA #2011 /C /C EAT. INTRANSITIVE: ASSUME FOOD IF PRESENT, ELSE ASK WHAT. TRANSITIVE: FOOD /C OK, SOME THINGS LOSE APPETITE, REST ARE RIDICULOUS. /C /8140 IF(.NOT.HERE(FOOD))GOTO 8000 #8140, FLDA FOOD JSA HERE JEQ #8000 /8142 CALL DSTROY(FOOD) #8142, FLDA FOOD JSA DSTROY / SPK=72 DECIMAL LDX 72,0 OCTAL XTA 0 FSTA SPK / GOTO 2011 JA #2011 /C /9140 IF(OBJ.EQ.FOOD)GOTO 8142 #9140, FLDA OBJ FSUB FOOD JEQ #8142 / IF(OBJ.EQ.BIRD.OR.OBJ.EQ.SNAKE.OR.OBJ.EQ.CLAM.OR.OBJ.EQ.OYSTER / 1 .OR.OBJ.EQ.DWARF.OR.OBJ.EQ.DRAGON.OR.OBJ.EQ.TROLL / 2 .OR.OBJ.EQ.BEAR)SPK=71 FLDA OBJ FSUB BIRD JEQ #M78 FLDA OBJ FSUB SNAKE JEQ #M78 FLDA OBJ FSUB CLAM JEQ #M78 FLDA OBJ FSUB OYSTER JEQ #M78 FLDA OBJ FSUB DWARF JEQ #M78 FLDA OBJ FSUB DRAGON JEQ #M78 FLDA OBJ FSUB TROLL JEQ #M78 FLDA OBJ FSUB BEAR JNE #2011 #M78, DECIMAL LDX 71,0 OCTAL XTA 0 FSTA SPK / GOTO 2011 JA #2011 /C /C DRINK. IF NO OBJECT, ASSUME WATER AND LOOK FOR IT HERE. IF WATER IS IN /C THE BOTTLE, DRINK THAT, ELSE MUST BE AT A WATER LOC, SO DRINK STREAM. /C /9150 IF(OBJ.EQ.0.AND.LIQLOC(LOC).NE.WATER.AND.(LIQ(0).NE.WATER / 1 .OR..NOT.HERE(BOTTLE)))GOTO 8000 #9150, FLDA OBJ JNE #M79 JSA LIQLOC FSUB WATER JEQ #M79 JSA LIQ FSUB WATER JNE #8000 FLDA BOTTLE JSA HERE JEQ #8000 / IF(OBJ.NE.0.AND.OBJ.NE.WATER)SPK=110 #M79, FLDA OBJ JEQ .+10 / FLDA OBJ FSUB WATER JEQ .+4 FLDA #LIT+162 FSTA SPK / IF(SPK.EQ.110.OR.LIQ(0).NE.WATER.OR..NOT.HERE(BOTTLE))GOTO 2011 FLDA SPK FSUB #LIT+162 JEQ #2011 JSA LIQ FSUB WATER JNE #2011 FLDA BOTTLE JSA HERE JEQ #2011 / PROP(BOTTLE)=1 FLDA ONE FSTA PROP-3,3 / PLACE(WATER)=0 FLDA WATER ATX 7 FCLA FSTA PLACE-3,7 / SPK=74 DECIMAL LDX 74,0 OCTAL XTA 0 FSTA SPK / GOTO 2011 JA #2011 /C /C RUB. YIELDS VARIOUS SNIDE REMARKS. /C /9160 IF(OBJ.NE.LAMP)SPK=76 #9160, FLDA OBJ FSUB LAMP JEQ #2011 DECIMAL LDX 76,0 OCTAL XTA 0 FSTA SPK / GOTO 2011 JA #2011 /C /C THROW. SAME AS DISCARD UNLESS AXE. THEN SAME AS ATTACK EXCEPT IGNORE BIRD, /C AND IF DWARF IS PRESENT THEN ONE MIGHT BE KILLED. (ONLY WAY TO DO SO!) /C AXE ALSO SPECIAL FOR DRAGON, BEAR, AND TROLL. TREASURES SPECIAL FOR TROLL. /C /9170 IF(TOTING(ROD2).AND.OBJ.EQ.ROD.AND..NOT.TOTING(ROD))OBJ=ROD2 #9170, FLDA ROD2 JSA TOTING JEQ #M81 FLDA OBJ FSUB ROD JNE #M81 FLDA ROD JSA TOTING JNE #M81 FLDA ROD2 FSTA OBJ / IF(.NOT.TOTING(OBJ))GOTO 2011 #M81, FLDA OBJ JSA TOTING JEQ #2011 / IF(OBJ.GE.50.AND.OBJ.LE.MAXTRS.AND.AT(TROLL))GOTO 9178 FLDA OBJ FSUB #LIT+110 JLT #M82 FLDA OBJ FSUB MAXTRS JGT #M82 FLDA TROLL JSA AT JNE #9178 / IF(OBJ.EQ.FOOD.AND.HERE(BEAR))GOTO 9177 #M82, FLDA OBJ FSUB FOOD JNE #M83 FLDA BEAR JSA HERE JNE #9177 / IF(OBJ.NE.AXE)GOTO 9020 #M83, FLDA OBJ FSUB AXE JNE #9020 / DO 9171 I=1,5 FLDA ONE FSTA I /C /C NEEDN'T CHECK DFLAG IF AXE IS HERE. /C / IF(DLOC(I).EQ.LOC)GOTO 9172 #H0132, FLDA I ATX 7 FLDA DLOC-3,7 FSUB LOC JEQ #9172 /9171 CONTINUE #9171, FLDA I FADD ONE FSTA I FSUB #LIT+3 JLE #H0132 / SPK=152 DECIMAL LDX 152,0 OCTAL XTA 0 FSTA SPK / IF(AT(DRAGON).AND.PROP(DRAGON).EQ.0)GOTO 9175 FLDA DRAGON JSA AT JEQ #M84 / FLDA DRAGON / ATX 3 FLDA PROP-3,3 JEQ #9175 / SPK=158 #M84, DECIMAL LDX 158,0 OCTAL XTA 0 FSTA SPK / IF(AT(TROLL))GOTO 9175 FLDA TROLL JSA AT JNE #9175 / IF(HERE(BEAR).AND.PROP(BEAR).EQ.0)GOTO 9176 FLDA BEAR JSA HERE JEQ #M85 FLDA PROP-3,3 JEQ #9176 / OBJ=0 #M85, FCLA FSTA OBJ / GOTO 9120 JA #9120 /C /9172 SPK=48 #9172, DECIMAL LDX 48,0 OCTAL XTA 0 FSTA SPK / IF(RND(3).EQ.0)GOTO 9175 JSR RND JA .+4 JA THREE JEQ #9175 / DSEEN(I)=.FALSE. FLDA I ATX 7 FCLA FSTA DSEEN-3,7 / DLOC(I)=0 FSTA DLOC-3,7 / SPK=47 DECIMAL LDX 47,0 OCTAL XTA 0 FSTA SPK / DKILL=DKILL+1 FLDA ONE FADDM DKILL / IF(DKILL.EQ.1)SPK=149 FSUB ONE JNE #9175 DECIMAL LDX 149,0 OCTAL XTA 0 FSTA SPK /9175 CALL RSPEAK(SPK) #9175, JSR RSPEAK JA .+4 JA SPK / CALL DROP(AXE,LOC) JSR DROP JA .+6 JA AXE JA LOC / K=NULL FLDA NULL FSTA K / GOTO 8 JA #8 /C /C THIS'LL TEACH HIM TO THROW THE AXE AT THE BEAR! /C /9176 SPK=164 #9176, DECIMAL LDX 164,0 OCTAL XTA 0 FSTA SPK / CALL DROP(AXE,LOC) JSR DROP JA .+6 JA AXE JA LOC / FIXED(AXE)=-1 FLDA AXE ATX 7 FLDA MINUS1 FSTA FIXED-3,7 / PROP(AXE)=1 FLDA ONE FSTA PROP-3,7 / CALL JUGGLE(BEAR) FLDA BEAR JSA JUGGLE / GOTO 2011 JA #2011 /C /C BUT THROWING FOOD IS ANOTHER STORY. /C /9177 OBJ=BEAR #9177, FLDA BEAR FSTA OBJ / GOTO 9210 JA #9210 /C /C SNARF A TREASURE FOR THE TROLL. /C /9178 SPK=159 #9178, DECIMAL LDX 159,0 OCTAL XTA 0 FSTA SPK / CALL DROP(OBJ,0) JSR DROP JA .+6 JA OBJ JA ZERO / CALL MOVE(TROLL,0) JSR MOVE JA .+6 JA TROLL JA ZERO / CALL MOVE(TROLL+100,0) FLDA TROLL FADD #LIT+154 FSTA #TMP JSR MOVE JA .+6 JA #TMP JA ZERO / CALL DROP(TROLL2,PLAC(TROLL)) FLDA TROLL ATX 7 FLDA PLAC-3,7 FSTA #TMP JSR DROP JA .+6 JA TROLL2 JA #TMP / CALL DROP(TROLL2+100,FIXD(TROLL)) FLDA TROLL2 FADD #LIT+154 FSTA #TMP / FLDA TROLL / ATX 7 FLDA FIXD-3,7 FSTA #TMP+3 JSR DROP JA .+6 JA #TMP JA #TMP+3 / CALL JUGGLE(CHASM) FLDA CHASM JSA JUGGLE / GOTO 2011 JA #2011 /C /C QUIT. INTRANSITIVE ONLY. VERIFY INTENT AND EXIT IF THAT'S WHAT HE WANTS. /C /8180 GAVEUP=YES(22,54,54) #8180, JSR YES JA .+10 JA #LIT+41 JA #LIT+113 JA #LIT+113 FSTA GAVEUP /8185 IF(GAVEUP)GOTO 20000 #8185, FLDA GAVEUP JNE #20000 / GOTO 2012 JA #2012 /C /C FIND. MIGHT BE CARRYING IT, OR IT MIGHT BE HERE. ELSE GIVE CAVEAT. /C /9190 IF(AT(OBJ).OR.(LIQ(0).EQ.OBJ.AND.AT(BOTTLE)) / 1 .OR.K.EQ.LIQLOC(LOC))SPK=94 #9190, FLDA OBJ JSA AT JNE #M86 JSA LIQ FSUB OBJ JNE #M87 FLDA BOTTLE JSA AT JNE #M86 #M87, JSA LIQLOC FSUB K JNE .+6 #M86, DECIMAL LDX 94,0 OCTAL XTA 0 FSTA SPK / DO 9192 I=1,5 FLDA ONE FSTA I /9192 IF(DLOC(I).EQ.LOC.AND.DFLAG.GE.2.AND.OBJ.EQ.DWARF)SPK=94 #9192, FLDA I ATX 7 FLDA DLOC-3,7 FSUB LOC JNE #M88 FLDA DFLAG FSUB TWO JLT #M88 FLDA OBJ FSUB DWARF JNE #M88 DECIMAL LDX 94,0 OCTAL XTA 0 FSTA SPK #M88, FLDA I FADD ONE FSTA I FSUB #LIT+3 JLE #9192 / IF(CLOSED)SPK=138 FLDA CLOSED JEQ .+6 DECIMAL LDX 138,0 OCTAL XTA 0 FSTA SPK / IF(TOTING(OBJ))SPK=24 FLDA OBJ JSA TOTING JEQ #2011 FLDA #LIT+47 FSTA SPK / GOTO 2011 JA #2011 /C /C INVENTORY. IF OBJECT, TREAT SAME AS FIND. ELSE REPORT ON CURRENT BURDEN. /C /8200 SPK=98 #8200, DECIMAL LDX 98,0 OCTAL XTA 0 FSTA SPK / DO 8201 I=1,100 FLDA ONE FSTA I / IF(I.EQ.BEAR.OR..NOT.TOTING(I))GOTO 8201 #H0143, FLDA I FSUB BEAR JEQ #8201 FLDA I JSA TOTING JEQ #8201 / IF(SPK.EQ.98)CALL RSPEAK(99) DECIMAL LDX 98,0 OCTAL XTA 0 FSUB SPK JNE .+10 JSR RSPEAK JA .+4 JA #LIT+151 / CALL PSPEAK(I,-1) JSR PSPEAK JA .+6 JA I JA MINUS1 / SPK=0 FCLA FSTA SPK /8201 CONTINUE #8201, FLDA I FADD ONE FSTA I FSUB #LIT+154 JLE #H0143 / IF(TOTING(BEAR))SPK=141 FLDA BEAR JSA TOTING JEQ #2011 FLDA #LIT+226 FSTA SPK / GOTO 2011 JA #2011 /C /C FEED. IF BIRD, NO SEED. SNAKE, DRAGON, TROLL: QUIP. IF DWARF, MAKE HIM /C MAD. BEAR, SPECIAL. /C /9210 IF(OBJ.NE.BIRD)GOTO 9212 #9210, FLDA OBJ FSUB BIRD JNE #9212 / SPK=100 FLDA #LIT+154 FSTA SPK / GOTO 2011 JA #2011 /C /9212 IF(OBJ.NE.SNAKE.AND.OBJ.NE.DRAGON.AND.OBJ.NE.TROLL)GOTO 9213 #9212, FLDA OBJ FSUB SNAKE JEQ #M89 FLDA OBJ FSUB DRAGON JEQ #M89 FLDA OBJ FSUB TROLL JNE #9213 / SPK=102 #M89, DECIMAL LDX 102,0 OCTAL XTA 0 FSTA SPK / IF(OBJ.EQ.DRAGON.AND.PROP(DRAGON).NE.0)SPK=110 FLDA OBJ FSUB DRAGON JNE #M90 FLDA DRAGON JSA RDPROP JEQ .+4 FLDA #LIT+162 FSTA SPK / IF(OBJ.EQ.TROLL)SPK=182 #M90, FLDA OBJ FSUB TROLL JNE .+6 DECIMAL LDX 182,0 OCTAL XTA 0 FSTA SPK / IF(OBJ.NE.SNAKE.OR.CLOSED.OR..NOT.HERE(BIRD))GOTO 2011 FLDA OBJ FSUB SNAKE JNE #2011 FLDA CLOSED JNE #2011 FLDA BIRD JSA HERE JEQ #2011 / SPK=101 DECIMAL LDX 101,0 OCTAL XTA 0 FSTA SPK / CALL DSTROY(BIRD) FLDA BIRD JSA DSTROY / PROP(BIRD)=0 FLDA BIRD ATX 7 FCLA FSTA PROP-3,7 / TALLY2=TALLY2+1 FLDA TALLY2 FADD ONE FSTA TALLY2 / GOTO 2011 JA #2011 /C /9213 IF(OBJ.NE.DWARF)GOTO 9214 #9213, FLDA OBJ FSUB DWARF JNE #9214 / IF(.NOT.HERE(FOOD))GOTO 2011 FLDA FOOD JSA HERE JEQ #2011 / SPK=103 DECIMAL LDX 103,0 OCTAL XTA 0 FSTA SPK / DFLAG=DFLAG+1 FLDA ONE FADDM DFLAG / GOTO 2011 JA #2011 /C /9214 IF(OBJ.NE.BEAR)GOTO 9215 #9214, FLDA OBJ FSUB BEAR JNE #9215 / IF(PROP(BEAR).EQ.0)SPK=102 FLDA BEAR JSA RDPROP JNE .+6 DECIMAL LDX 102,0 OCTAL XTA 0 FSTA SPK / IF(PROP(BEAR).EQ.3)SPK=110 FLDA PROP-3,7 FSUB THREE JNE .+4 FLDA #LIT+162 FSTA SPK / IF(.NOT.HERE(FOOD))GOTO 2011 FLDA FOOD JSA HERE JEQ #2011 / CALL DSTROY(FOOD) FLDA FOOD JSA DSTROY / PROP(BEAR)=1 FLDA ONE FSTA PROP-3,7 / FIXED(AXE)=0 FLDA AXE ATX 7 FCLA FSTA FIXED-3,7 / PROP(AXE)=0 FSTA PROP-3,7 / SPK=168 DECIMAL LDX 168,0 OCTAL XTA 0 FSTA SPK / GOTO 2011 JA #2011 /C /9215 SPK=14 #9215, DECIMAL LDX 14,0 OCTAL XTA 0 FSTA SPK / GOTO 2011 JA #2011 /C /C FILL. BOTTLE MUST BE EMPTY, AND SOME LIQUID AVAILABLE. (VASE IS NASTY.) /C /9220 IF(OBJ.EQ.VASE)GOTO 9222 #9220, FLDA OBJ FSUB VASE JEQ #9222 / IF(OBJ.NE.0.AND.OBJ.NE.BOTTLE)GOTO 2011 FLDA OBJ JEQ #M91 FLDA OBJ FSUB BOTTLE JNE #2011 / IF(OBJ.EQ.0.AND..NOT.HERE(BOTTLE))GOTO 8000 #M91, FLDA OBJ JNE #M92 FLDA BOTTLE JSA HERE JEQ #8000 / SPK=107 #M92, DECIMAL LDX 107,0 OCTAL XTA 0 FSTA SPK / IF(LIQLOC(LOC).EQ.0)SPK=106 JSA LIQLOC JNE #M92A DECIMAL LDX 106,0 OCTAL XTA 0 FSTA SPK / IF(LIQ(0).NE.0)SPK=105 #M92A, JSA LIQ JEQ .+4 FLDA #LIT+157 FSTA SPK / IF(SPK.NE.107)GOTO 2011 DECIMAL LDX 107,0 OCTAL XTA 0 FSUB SPK JNE #2011 / PROP(BOTTLE)=MOD(COND(LOC),4)/2*2 FLDA BOTTLE ATX 7 FLDA LOC ATX 6 FLDA COND-3,6 FSTA #TMP JSR MOD JA .+6 JA #TMP JA #LIT FDIV TWO JSA #FIX FMUL TWO FSTA PROP-3,7 / K=LIQ(0) JSA LIQ FSTA K / IF(TOTING(BOTTLE))PLACE(K)=-1 FLDA BOTTLE JSA TOTING JEQ .+10 FLDA K ATX 7 FLDA MINUS1 FSTA PLACE-3,7 / IF(K.EQ.OIL)SPK=108 FLDA K FSUB OIL JNE #2011 DECIMAL LDX 108,0 OCTAL XTA 0 FSTA SPK / GOTO 2011 JA #2011 /C /9222 SPK=29 #9222, FLDA #LIT+135 FSTA SPK / IF(LIQLOC(LOC).EQ.0)SPK=144 JSA LIQLOC JNE .+6 DECIMAL LDX 144,0 OCTAL XTA 0 FSTA SPK / IF(LIQLOC(LOC).EQ.0.OR..NOT.TOTING(VASE))GOTO 2011 JSA LIQLOC JEQ #2011 FLDA VASE JSA TOTING JEQ #2011 / CALL RSPEAK(145) JSR RSPEAK JA .+4 JA #LIT+234 / PROP(VASE)=2 FLDA VASE ATX 7 FLDA TWO FSTA PROP-3,7 / FIXED(VASE)=-1 FLDA MINUS1 FSTA FIXED-3,7 / GOTO 9024 JA #9024 /C /C BLAST. NO EFFECT UNLESS YOU'VE GOT DYNAMITE, WHICH IS A NEAT TRICK! /C /9230 IF(PROP(ROD2).LT.0.OR..NOT.CLOSED)GOTO 2011 #9230, FLDA ROD2 JSA RDPROP JLT #2011 FLDA CLOSED JEQ #2011 / BONUS=133 DECIMAL LDX 133,0 OCTAL XTA 0 FSTA BONUS / IF(LOC.EQ.115)BONUS=134 FLDA LOC FSUB #LIT+165 JNE .+7 DECIMAL LDX 134,0 OCTAL XTA 0 FSTA BONUS / IF(HERE(ROD2))BONUS=135 FLDA ROD2 JSA HERE JEQ .+7 DECIMAL LDX 135,0 OCTAL XTA 0 FSTA BONUS / CALL RSPEAK(BONUS) JSR RSPEAK JA .+4 JA BONUS / GOTO 20000 JA #20000 /C /C SCORE. GO TO SCORING SECTION, WHICH WILL RETURN TO 8241 IF SCORNG IS TRUE. /C /8240 SCORNG=.TRUE. #8240, FLDA ONE FSTA SCORNG / GOTO 20000 JA #20000 /C /8241 SCORNG=.FALSE. #8241, FCLA FSTA SCORNG / TYPE 8243,SCORE,MXSCOR JSA SPRINT JA #8243 JA TWO TRAP3 #WRITO JA #LIT JA #8243A FLDA SCORE TRAP3 #RSVO TRAP3 #RENDO JSA SPRINT JA #8243B JA THREE TRAP3 #WRITO JA #LIT JA #8243A FLDA MXSCOR TRAP3 #RSVO TRAP3 #RENDO JSA SPRINT JA #8243C JA ONE /8243 FORMAT(' If you were to quit now, you would score',I4 / 1 ,' out of a possible',I4,'.') / GAVEUP=YES(143,54,54) JSR YES JA .+10 JA #LIT+231 JA #LIT+113 JA #LIT+113 FSTA GAVEUP / GOTO 8185 JA #8185 /C /C FEE FIE FOE FOO (AND FUM). ADVANCE TO NEXT STATE IF GIVEN IN PROPER ORDER. /C LOOK UP WD1 IN SECTION 3 OF VOCAB TO DETERMINE WHICH WORD WE'VE GOT. LAST /C WORD ZIPS THE EGGS BACK TO THE GIANT ROOM (UNLESS ALREADY THERE). /C /8250 CALL VOCAB(WD1,WD1A,3,K) #8250, JSR VOCAB JA .+6 JA WD1 JA THREE FSTA K / SPK=42 DECIMAL LDX 42,0 OCTAL XTA 0 FSTA SPK / IF(FOOBAR.EQ.1-K)GOTO 8252 FLDA ONE FSUB K FSUB FOOBAR JEQ #8252 / IF(FOOBAR.NE.0)SPK=151 FLDA FOOBAR JEQ #2011 DECIMAL LDX 151,0 OCTAL XTA 0 FSTA SPK / GOTO 2011 JA #2011 /C /8252 FOOBAR=K #8252, FLDA K FSTA FOOBAR / IF(K.NE.4)GOTO 2009 FSUB #LIT JNE #2009 / FOOBAR=0 FCLA FSTA FOOBAR / IF(PLACE(EGGS).EQ.PLAC(EGGS) / 1 .OR.(TOTING(EGGS).AND.LOC.EQ.PLAC(EGGS)))GOTO 2011 FLDA EGGS ATX 7 FLDA PLACE-3,7 FSUB PLAC-3,7 JEQ #2011 FLDA EGGS JSA TOTING JEQ #M93 FLDA LOC FSUB PLAC-3,7 JEQ #2011 /C /C BRING BACK TROLL IF WE STEAL THE EGGS BACK FROM HIM BEFORE CROSSING. /C / IF(PLACE(EGGS).EQ.0.AND.PLACE(TROLL).EQ.0.AND.PROP(TROLL).EQ.0) / 1 PROP(TROLL)=1 #M93, FLDA PLACE-3,7 JNE #M94 FLDA TROLL ATX 6 FLDA PLACE-3,6 JNE #M94 FLDA PROP-3,6 JNE #M94 FLDA ONE FSTA PROP-3,6 / K=2 #M94, FLDA TWO FSTA K / IF(HERE(EGGS))K=1 FLDA EGGS JSA HERE JEQ .+5 FLDA ONE FSTA K / IF(LOC.EQ.PLAC(EGGS))K=0 FLDA LOC FSUB PLAC-3,7 JNE .+5 FCLA FSTA K / CALL MOVE(EGGS,PLAC(EGGS)) FLDA PLAC-3,7 FSTA #TMP JSR MOVE JA .+6 JA EGGS JA #TMP / CALL PSPEAK(EGGS,K) JSR PSPEAK JA .+6 JA EGGS JA K / GOTO 2012 JA #2012 /C /C BRIEF. INTRANSITIVE ONLY. SUPPRESS LONG DESCRIPTIONS AFTER FIRST TIME. /C /8260 SPK=156 #8260, DECIMAL LDX 156,0 OCTAL XTA 0 FSTA SPK / ABBNUM=10000 FLDA #LIT+322 FSTA ABBNUM / DETAIL=3 FLDA THREE FSTA DETAIL / GOTO 2011 JA #2011 /C /C READ. MAGAZINES IN DWARVISH, MESSAGE WE'VE SEEN, AND . . . OYSTER? /C /8270 IF(HERE(MAGZIN))OBJ=MAGZIN #8270, FLDA MAGZIN JSA HERE JEQ .+6 FLDA MAGZIN FSTA OBJ / IF(HERE(TABLET))OBJ=OBJ*100+TABLET FLDA TABLET JSA HERE JEQ .+11 FLDA OBJ FMUL #LIT+154 FADD TABLET FSTA OBJ / IF(HERE(MESSAG))OBJ=OBJ*100+MESSAG FLDA MESSAGE JSA HERE JEQ .+11 FLDA OBJ FMUL #LIT+154 FADD MESSAG FSTA OBJ / IF(CLOSED.AND.TOTING(OYSTER))OBJ=OYSTER FLDA OYSTER JSA TOTING FMUL CLOSED JEQ .+6 FLDA OYSTER FSTA OBJ / IF(OBJ.GT.100.OR.OBJ.EQ.0.OR.DARK(0))GOTO 8000 FLDA OBJ FSUB #LIT+154 JGT #8000 FLDA OBJ JEQ #8000 JSA DARK JNE #8000 /C /9270 IF(DARK(0))GOTO 5190 #9270, JSA DARK JNE #5190 / IF(OBJ.EQ.MAGZIN)SPK=190 FLDA OBJ FSUB MAGZIN JNE .+6 DECIMAL LDX 190,0 OCTAL XTA 0 FSTA SPK / IF(OBJ.EQ.TABLET)SPK=196 FLDA OBJ FSUB TABLET JNE .+6 DECIMAL LDX 196,0 OCTAL XTA 0 FSTA SPK / IF(OBJ.EQ.MESSAG)SPK=191 FLDA OBJ FSUB MESSAG JNE .+6 DECIMAL LDX 191,0 OCTAL XTA 0 FSTA SPK / IF(OBJ.EQ.OYSTER.AND.HINTED(2).AND.TOTING(OYSTER))SPK=194 FLDA OBJ FSUB OYSTER JNE #M95 FLDA HINTED+3 / HINTED(2) JEQ #M95 FLDA OYSTER JSA TOTING JEQ .+6 DECIMAL LDX 194,0 OCTAL XTA 0 FSTA SPK / IF(OBJ.NE.OYSTER.OR.HINTED(2).OR..NOT.TOTING(OYSTER) / 1 .OR..NOT.CLOSED)GOTO 2011 #M95, FLDA OBJ FSUB OYSTER JNE #2011 FLDA HINTED+3 JNE #2011 FLDA OYSTER JSA TOTING JEQ #2011 FLDA CLOSED JEQ #2011 / HINTED(2)=YES(192,193,54) JSR YES JA #2012 JA #LIT+267 JA #LIT+272 JA #LIT+113 FSTA HINTED+3 /HINTED(2) / GOTO 2012 / JA #2012 /C /C BREAK. ONLY WORKS FOR MIRROR IN REPOSITORY AND, OF COURSE, THE VASE. /C /9280 IF(OBJ.EQ.MIRROR)SPK=148 #9280, FLDA OBJ FSUB MIRROR JNE .+6 DECIMAL LDX 148,0 OCTAL XTA 0 FSTA SPK / IF(OBJ.EQ.VASE.AND.PROP(VASE).EQ.0)GOTO 9282 FLDA OBJ FSUB VASE JNE #M96 FLDA VASE JSA RDPROP JEQ #9282 / IF(OBJ.NE.MIRROR.OR..NOT.CLOSED)GOTO 2011 #M96, FLDA OBJ FSUB MIRROR JNE #2011 FLDA CLOSED JEQ #2011 / CALL RSPEAK(197) JSR RSPEAK / GOTO 19000 JA #19000 JA #LIT+275 /C /9282 SPK=198 #9282, DECIMAL LDX 198,0 OCTAL XTA 0 FSTA SPK / IF(TOTING(VASE))CALL DROP(VASE,LOC) FLDA VASE JSA TOTING JEQ .+12 JSR DROP JA .+6 JA VASE JA LOC / PROP(VASE)=2 FLDA TWO FSTA PROP-3,3 / FIXED(VASE)=-1 FLDA MINUS1 FSTA FIXED-3,3 / GOTO 2011 JA #2011 /C /C WAKE. ONLY USE IS TO DISTURB THE DWARVES. /C /9290 IF(OBJ.NE.DWARF.OR..NOT.CLOSED)GOTO 2011 #9290, FLDA OBJ FSUB DWARF JNE #2011 FLDA CLOSED JEQ #2011 / CALL RSPEAK(199) JSR RSPEAK / GOTO 19000 JA #19000 JA #LIT+300 /C /C SUSPEND. SAVE THE WORLD. /C /8300 CALL SAVEGM(.TRUE.,I) / GOTO 2012 #8300, JSR SAVEGM JA #2012 JA ONE JA I /C /C HOURS. JUST A JOKE. /C /8310 CALL RSPEAK(201) #8310, JSR RSPEAK / GOTO 2012 JA #2012 JA #LIT+303 /C /C RESUME. RESTORE THE WORLD. /C /8320 CALL RSTRGM(.TRUE.,I) / GO TO 2012 #8320, JSR RSTRGM JA #2012 JA ONE JA I /C HINTS /C /C COME HERE IF HE'S BEEN LONG ENOUGH AT REQUIRED LOC(S) FOR SOME UNUSED HINT. /C HINT NUMBER IS IN VARIABLE "HINT". BRANCH TO QUICK TEST FOR ADDITIONAL /C CONDITIONS, THEN COME BACK TO DO NEAT STUFF. GOTO 40010 IF CONDITIONS ARE /C MET AND WE WANT TO OFFER THE HINT. GOTO 40020 TO CLEAR HINTLC BACK TO ZERO, /C 40030 TO TAKE NO ACTION YET. /C /40000 GOTO (40400,40500,40600,40700,40800,40900)(HINT-3) /C CAVE BIRD SNAKE MAZE DARK WITT #40000, FLDA HINT FSUB THREE ATX 1 STARTD FLDA .+2,1 STARTF JAC JA #40400 JA #40500 JA #40600 JA #40700 JA #40800 JA #40010 / CALL BUG(27) JSR BUG JA .+4 JA #LIT+60 /C /40010 HINTLC(HINT)=0 #40010, FLDA HINT ATX 7 FCLA FSTA HINTLC-3,7 / IF(.NOT.YES(HINTS(HINT,3),0,54))GOTO 2602 FLDA #LIT+330 / 60 (index 3) FADD HINT / hint,3 ATX 7 FLDA HINTS-77,7 FSTA #TMP JSR YES JA .+10 JA #TMP JA ZERO JA #LIT+113 JEQ #2602 / TYPE 40012,HINTS(HINT,2) JSA SPRINT JA #40012 JA TWO TRAP3 #WRITO JA #LIT JA #4001A FLDA #LIT+77 / 40 FADD HINT / HINT, 2 ATX 7 FLDA HINTS-77,7 TRAP3 #RSVO TRAP3 #RENDO JSA SPRINT JA #4001B JA ONE /40012 FORMAT(' I am prepared to give you a hint, but it will cost you', / 1 I2,' points.') / HINTED(HINT)=YES(175,HINTS(HINT,4),54) FLDA HINT ATX 6 FADD #LIT+325 / 80: HINT,4 ATX 7 FLDA HINTS-77,7 FSTA #TMP JSR YES JA .+10 JA #LIT+250 JA #TMP JA #LIT+113 FSTA HINTED-3,6 / IF(HINTED(HINT).AND.LIMIT.GT.30)LIMIT=LIMIT+30*HINTS(HINT,2) JEQ #40020 FLDA LIMIT FSUB #LIT+63 JLE #40020 FLDA #LIT+77 /80 FADD HINT /HINT,2 ATX 6 FLDA #LIT+63 FMUL HINTS-77,6 FADD LIMIT FSTA LIMIT /40020 HINTLC(HINT)=0 #40020, FLDA HINT ATX 7 FCLA FSTA HINTLC-3,7 /40030 GOTO 2602 #40030, JA #2602 /C /C NOW FOR THE QUICK TESTS. SEE DATABASE DESCRIPTION FOR ONE-LINE NOTES. /C /40400 IF(PROP(GRATE).EQ.0.AND..NOT.HERE(KEYS))GOTO 40010 #40400, FLDA GRATE JSA RDPROP JNE #40020 FLDA KEYS JSA HERE JEQ #40010 / GOTO 40020 JA #40020 /40500 IF(HERE(BIRD).AND.TOTING(ROD).AND.OBJ.EQ.BIRD)GOTO 40010 #40500, FLDA BIRD JSA HERE JEQ #2602 FLDA ROD JSA TOTING JEQ #2602 FLDA OBJ JEQ #40010 FSUB BIRD JEQ #40010 / GOTO 40030 JA #2602 /C /40600 IF(HERE(SNAKE).AND..NOT.HERE(BIRD))GOTO 40010 #40600, FLDA SNAKE JSA HERE JEQ #40020 FLDA BIRD JSA HERE JEQ #40010 / GOTO 40020 JA #40020 /C /40700 IF(ATLOC(LOC).EQ.0.AND.ATLOC(OLDLOC).EQ.0 / 1 .AND.ATLOC(OLDLC2).EQ.0.AND.HOLDNG.GT.1)GOTO 40010 #40700, FLDA LOC ATX 7 FLDA ATLOC-3,7 JNE #40020 FLDA OLDLOC ATX 6 FLDA ATLOC-3,6 JNE #40020 FLDA OLDLC2 ATX 5 FLDA ATLOC-3,5 JNE #40020 FLDA HOLDNG FSUB ONE JGT #40010 / GOTO 40020 JA #40020 /C /40800 IF(PROP(EMRALD).NE.-1.AND.PROP(PYRAM).EQ.-1)GOTO 40010 / GOTO 40020 #40800, FLDA EMRALD ATX 7 FLDA MINUS1 FSUB PROP-3,7 JEQ #40020 FLDA PYRAM ATX 6 FLDA MINUS1 FSUB PROP-3,6 JEQ #40010 / GOTO 40020 JA #40020 /C /40900 JA #40010 /#40900 JA 40010 /C CAVE CLOSING AND SCORING /C /C /C THESE SECTIONS HANDLE THE CLOSING OF THE CAVE. THE CAVE CLOSES "CLOCK1" /C TURNS AFTER THE LAST TREASURE HAS BEEN LOCATED (INCLUDING THE PIRATE'S /C CHEST, WHICH MAY OF COURSE NEVER SHOW UP). NOTE THAT THE TREASURES NEED NOT /C HAVE BEEN TAKEN YET, JUST LOCATED. HENCE CLOCK1 MUST BE LARGE ENOUGH TO GET /C OUT OF THE CAVE (IT ONLY TICKS WHILE INSIDE THE CAVE). WHEN IT HITS ZERO, /C WE BRANCH TO 10000 TO START CLOSING THE CAVE, AND THEN SIT BACK AND WAIT FOR /C HIM TO TRY TO GET OUT. IF HE DOESN'T WITHIN CLOCK2 TURNS, WE CLOSE THE /C CAVE; IF HE DOES TRY, WE ASSUME HE PANICS, AND GIVE HIM A FEW ADDITIONAL /C TURNS TO GET FRANTIC BEFORE WE CLOSE. WHEN CLOCK2 HITS ZERO, WE BRANCH TO /C 11000 TO TRANSPORT HIM INTO THE FINAL PUZZLE. NOTE THAT THE PUZZLE DEPENDS /C UPON ALL SORTS OF RANDOM THINGS. FOR INSTANCE, THERE MUST BE NO WATER OR /C OIL, SINCE THERE ARE BEANSTALKS WHICH WE DON'T WANT TO BE ABLE TO WATER, /C SINCE THE CODE CAN'T HANDLE IT. ALSO, WE CAN HAVE NO KEYS, SINCE THERE IS A /C GRATE (HAVING MOVED THE FIXED OBJECT!) THERE SEPARATING HIM FROM ALL THE /C TREASURES. MOST OF THESE PROBLEMS ARISE FROM THE USE OF NEGATIVE PROP /C NUMBERS TO SUPPRESS THE OBJECT DESCRIPTIONS UNTIL HE'S ACTUALLY MOVED THE /C OBJECTS. /C /C WHEN THE FIRST WARNING COMES, WE LOCK THE GRATE, DESTROY THE BRIDGE, KILL /C ALL THE DWARVES (AND THE PIRATE), REMOVE THE TROLL AND BEAR (UNLESS DEAD), /C AND SET "CLOSNG" TO TRUE. LEAVE THE DRAGON; TOO MUCH TROUBLE TO MOVE IT. /C FROM NOW UNTIL CLOCK2 RUNS OUT, HE CANNOT UNLOCK THE GRATE, MOVE TO ANY /C LOCATION OUTSIDE THE CAVE (LOC<9), OR CREATE THE BRIDGE. NOR CAN HE BE /C RESURRECTED IF HE DIES. NOTE THAT THE SNAKE IS ALREADY GONE, SINCE HE GOT /C TO THE TREASURE ACCESSIBLE ONLY VIA THE HALL OF THE MT. KING. ALSO, HE'S /C BEEN IN GIANT ROOM (TO GET EGGS), SO WE CAN REFER TO IT. ALSO ALSO, HE'S /C GOTTEN THE PEARL, SO WE KNOW THE BIVALVE IS AN OYSTER. *AND*, THE DWARVES /C MUST HAVE BEEN ACTIVATED, SINCE WE'VE FOUND CHEST. /C /10000 PROP(GRATE)=0 #10000, FLDA GRATE ATX 7 FCLA FSTA PROP-3,7 / PROP(FISSUR)=0 FLDA FISSUR ATX 7 FCLA FSTA PROP-3,7 / DO 10010 I=1,6 FLDA ONE FSTA I / DSEEN(I)=.FALSE. #H0204, FLDA I ATX 7 FCLA FSTA DSEEN-3,7 /10010 DLOC(I)=0 /#10010, FLDA I / ATX 7 / FCLA FSTA DLOC-3,7 FLDA I FADD ONE FSTA I FSUB #LIT+6 JLE #H0204 / CALL MOVE(TROLL,0) JSR MOVE JA .+6 JA TROLL JA ZERO / CALL MOVE(TROLL+100,0) FLDA TROLL ATX 7 FADD #LIT+154 FSTA #TMP JSR MOVE JA .+6 JA #TMP JA ZERO / CALL MOVE(TROLL2,PLAC(TROLL)) / FLDA TROLL / ATX 7 FLDA PLAC-3,7 FSTA #TMP JSR MOVE JA .+6 JA TROLL2 JA #TMP / CALL MOVE(TROLL2+100,FIXD(TROLL)) FLDA TROLL2 FADD #LIT+154 FSTA #TMP / FLDA TROLL / ATX 7 FLDA FIXD-3,7 FSTA #TMP+3 JSR MOVE JA .+6 JA #TMP JA #TMP+3 / CALL JUGGLE(CHASM) FLDA CHASM JSA JUGGLE / IF(PROP(BEAR).NE.3)CALL DSTROY(BEAR) FLDA BEAR JSA RDPROP FSUB THREE JEQ .+6 FLDA BEAR JSA DSTROY / PROP(CHAIN)=0 FLDA CHAIN ATX 7 FCLA FSTA PROP-3,7 / FIXED(CHAIN)=0 / PROP(AXE)=0 FLDA AXE ATX 7 FCLA FSTA PROP-3,7 / FIXED(AXE)=0 FSTA FIXED-3,7 / CALL RSPEAK(129) JSR RSPEAK JA .+4 JA #LIT+204 / CLOCK1=-1 FLDA MINUS1 FSTA CLOCK1 / CLOSNG=.TRUE. FLDA ONE FSTA CLOSNG / GOTO 19999 JA #19999 /C /C ONCE HE'S PANICKED, AND CLOCK2 HAS RUN OUT, WE COME HERE TO SET UP THE /C STORAGE ROOM. THE ROOM HAS TWO LOCS, HARDWIRED AS 115 (NE) AND 116 (SW). /C AT THE NE END, WE PLACE EMPTY BOTTLES, A NURSERY OF PLANTS, A BED OF /C OYSTERS, A PILE OF LAMPS, RODS WITH STARS, SLEEPING DWARVES, AND HIM. AND /C THE SW END WE PLACE GRATE OVER TREASURES, SNAKE PIT, COVEY OF CAGED BIRDS, /C MORE RODS, AND PILLOWS. A MIRROR STRETCHES ACROSS ONE WALL. MANY OF THE /C OBJECTS COME FROM KNOWN LOCATIONS AND/OR STATES (E.G. THE SNAKE IS KNOWN TO /C HAVE BEEN DESTROYED AND NEEDN'T BE CARRIED AWAY FROM ITS OLD "PLACE"), /C MAKING THE VARIOUS OBJECTS BE HANDLED DIFFERENTLY. WE ALSO DROP ALL OTHER /C OBJECTS HE MIGHT BE CARRYING (LEST HE HAVE SOME WHICH COULD CAUSE TROUBLE, /C SUCH AS THE KEYS). WE DESCRIBE THE FLASH OF LIGHT AND TRUNDLE BACK. /C /11000 PROP(BOTTLE)=PUT(BOTTLE,115,1) #11000, FLDA BOTTLE ATX 7 JSR PUT JA .+10 JA BOTTLE JA #LIT+165 JA ONE FSTA PROP-3,7 / PROP(PLANT)=PUT(PLANT,115,0) FLDA PLANT ATX 7 JSR PUT JA .+10 JA PLANT JA #LIT+165 JA ZERO FSTA PROP-3,7 / PROP(OYSTER)=PUT(OYSTER,115,0) FLDA OYSTER ATX 7 JSR PUT JA .+10 JA OYSTER JA #LIT+165 JA ZERO FSTA PROP-3,7 / PROP(LAMP)=PUT(LAMP,115,0) FLDA LAMP ATX 7 JSR PUT JA .+10 JA LAMP JA #LIT+165 JA ZERO FSTA PROP-3,7 / PROP(ROD)=PUT(ROD,115,0) FLDA ROD ATX 7 JSR PUT JA .+10 JA ROD JA #LIT+165 JA ZERO FSTA PROP-3,7 / PROP(DWARF)=PUT(DWARF,115,0) FLDA DWARF ATX 7 JSR PUT JA .+10 JA DWARF JA #LIT+165 JA ZERO FSTA PROP-3,7 / LOC=115 / OLDLOC=115 / NEWLOC=115 FLDA #LIT+165 FSTA LOC FSTA OLDLOC FSTA NEWLOC /C /C LEAVE THE GRATE WITH NORMAL (NON-NEGATIVE PROPERTY). /C / I=PUT(GRATE,116,0) JSR PUT JA .+10 JA GRATE JA #LIT+170 JA ZERO FSTA I / PROP(SNAKE)=PUT(SNAKE,116,1) FLDA SNAKE ATX 7 JSR PUT JA .+10 JA SNAKE JA #LIT+170 JA ONE FSTA PROP-3,7 / PROP(BIRD)=PUT(BIRD,116,1) FLDA BIRD ATX 7 JSR PUT JA .+10 JA BIRD JA #LIT+170 JA ONE FSTA PROP-3,7 / PROP(CAGE)=PUT(CAGE,116,0) FLDA CAGE ATX 7 JSR PUT JA .+10 JA CAGE JA #LIT+170 JA ZERO FSTA PROP-3,7 / PROP(ROD2)=PUT(ROD2,116,0) FLDA ROD2 ATX 7 JSR PUT JA .+10 JA ROD2 JA #LIT+170 JA ZERO FSTA PROP-3,7 / PROP(PILLOW)=PUT(PILLOW,116,0) FLDA PILLOW ATX 7 JSR PUT JA .+10 JA PILLOW JA #LIT+170 JA ZERO FSTA PROP-3,7 /C / PROP(MIRROR)=PUT(MIRROR,115,0) FLDA MIRROR ATX 7 JSR PUT JA .+10 JA MIRROR JA #LIT+165 JA ZERO FSTA PROP-3,7 / FIXED(MIRROR)=116 FLDA #LIT+170 FSTA FIXED-3,7 /C / DO 11010 I=1,100 FLDA ONE FSTA I /11010 IF(TOTING(I))CALL DSTROY(I) #11010, FLDA I JSA TOTING JEQ .+6 FLDA I JSA DSTROY FLDA I FADD ONE FSTA I FSUB #LIT+154 JLE #11010 /C / CALL RSPEAK(132) JSR RSPEAK JA .+4 JA #LIT+215 / CLOSED=.TRUE. FLDA ONE FSTA CLOSED / GOTO 2 JA #2 /C /C ANOTHER WAY WE CAN FORCE AN END TO THINGS IS BY HAVING THE LAMP GIVE OUT. /C WHEN IT GETS CLOSE, WE COME HERE TO WARN HIM. WE GO TO 12000 IF THE LAMP /C AND FRESH BATTERIES ARE HERE, IN WHICH CASE WE REPLACE THE BATTERIES AND /C CONTINUE. 12200 IS FOR OTHER CASES OF LAMP DYING.12400 IS WHEN IT GOES /C OUT, AND 12600 IS IF HE'S WANDERED OUTSIDE AND THE LAMP IS USED UP, IN WHICH /C CASE WE FORCE HIM TO GIVE UP. /C /12000 CALL RSPEAK(188) #12000, JSR RSPEAK JA .+4 JA #LIT+264 / PROP(BATTER)=1 FLDA BATTER ATX 7 FLDA ONE FSTA PROP-3,7 / IF(TOTING(BATTER))CALL DROP(BATTER,LOC) FLDA BATTER JSA TOTING JEQ .+12 JSR DROP JA .+6 JA BATTER JA LOC / LIMIT=LIMIT+2500 FLDA #LIT+317 FADDM LIMIT / LMWARN=.FALSE. FCLA FSTA LMWARN / GOTO 19999 JA #19999 /C /12200 IF(LMWARN.OR..NOT.HERE(LAMP))GOTO 19999 #12200, FLDA LAMP JSA HERE JEQ #19999 FLDA LMWARN JNE #19999 / LMWARN=.TRUE. FLDA ONE FSTA LMWARN / SPK=187 DECIMAL LDX 187,0 OCTAL XTA 0 FSTA SPK / IF(PLACE(BATTER).EQ.0)SPK=183 FLDA BATTER ATX 7 FLDA PLACE-3,7 JNE .+6 DECIMAL LDX 183,0 OCTAL XTA 0 FSTA SPK / IF(PROP(BATTER).EQ.1)SPK=189 FLDA PROP-3,7 FSUB ONE JNE .+6 DECIMAL LDX 189,0 OCTAL XTA 0 FSTA SPK / CALL RSPEAK(SPK) #H0214, JSR RSPEAK JA #19999 JA SPK / GOTO 19999 /C /12400 LIMIT=-1 #12400, FLDA MINUS1 FSTA LIMIT / PROP(LAMP)=0 FLDA LAMP ATX 7 FCLA FSTA PROP-3,7 / IF(HERE(LAMP))CALL RSPEAK(184) FLDA LAMP JSA HERE / GOTO 19999 JEQ #19999 JSR RSPEAK JA #19999 JA #LIT+253 /C /12600 CALL RSPEAK(185) #12600, JSR RSPEAK JA .+4 JA #LIT+256 / GAVEUP=.TRUE. FLDA ONE FSTA GAVEUP / GOTO 20000 JA #20000 /C /C /C OH DEAR, HE'S DISTURBED THE DWARVES. /C /19000 CALL RSPEAK(136) #19000, JSR RSPEAK JA .+4 JA #LIT+220 /C /C EXIT CODE. WILL EVENTUALLY INCLUDE SCORING. FOR NOW, HOWEVER, ... /C /C THE PRESENT SCORING ALGORITHM IS AS FOLLOWS: /C OBJECTIVE: POINTS: PRESENT TOTAL POSSIBLE: /C GETTING WELL INTO CAVE 25 25 /C EACH TREASURE < CHEST 12 60 /C TREASURE CHEST ITSELF 14 14 /C EACH TREASURE > CHEST 16 144 /C SURVIVING (MAX-NUM)*10 30 /C NOT QUITTING 4 4 /C REACHING "CLOSNG" 25 25 /C "CLOSED": QUIT/KILLED 10 /C KLUTZED 25 /C WRONG WAY 30 /C SUCCESS 45 45 /C CAME TO WITT'S END 1 1 /C ROUND OUT THE TOTAL 2 2 /C TOTAL: 350 /20000 SCORE=0 #20000, FCLA FSTA SCORE / MXSCOR=0 FSTA MXSCOR /C /C FIRST TALLY UP THE TREASURES. MUST BE IN BUILDING AND NOT BROKEN. /C GIVE THE POOR GUY 2 POINTS JUST FOR FINDING EACH TREASURE. /C / DO 20010 I=50,MAXTRS FLDA #LIT+110 FSTA I / IF(PTEXT(I).EQ.0)GOTO 20010 #H0216, FLDA I ATX 7 FLDA PTEXT-3,7 JEQ #20010 / K=12 FLDA #LIT+22 FSTA K / IF(I.EQ.CHEST)K=14 FLDA I FSUB CHEST JNE .+7 DECIMAL LDX 14,0 OCTAL XTA 0 FSTA K / IF(I.GT.CHEST)K=16 FLDA I FSUB CHEST JLE .+5 FLDA #LIT+30 FSTA K / IF(PROP(I).GE.0)SCORE=SCORE+2 FLDA PROP-3,7 JLT .+5 FLDA TWO FADDM SCORE / IF(PLACE(I).EQ.3.AND.PROP(I).EQ.0)SCORE=SCORE+K-2 FLDA PLACE-3,7 FSUB THREE JNE #M100 FLDA PROP-3,7 JNE #M100 FLDA SCORE FADD K FSUB TWO FSTA SCORE / MXSCOR=MXSCOR+K #M100, FLDA K FADDM MXSCOR /20010 CONTINUE #20010, FLDA I FADD ONE FSTA I FSUB MAXTRS JLE #H0216 /C /C NOW LOOK AT HOW HE FINISHED AND HOW FAR HE GOT. MAXDIE AND NUMDIE TELL US /C HOW WELL HE SURVIVED. GAVEUP SAYS WHETHER HE EXITED VIA QUIT. DFLAG WILL /C TELL US IF HE EVER GOT SUITABLY DEEP INTO THE CAVE. CLOSNG STILL INDICATES /C WHETHER HE REACHED THE ENDGAME. AND IF HE GOT AS FAR AS "CAVE CLOSED" /C (INDICATED BY "CLOSED"), THEN BONUS IS ZERO FOR MUNDANE EXITS OR 133, 134, /C 135 IF HE BLEW IT (SO TO SPEAK). /C / SCORE=SCORE+(MAXDIE-NUMDIE)*10 FLDA MAXDIE FSUB NUMDIE FMUL #LIT+17 FADDM SCORE / MXSCOR=MXSCOR+MAXDIE*10 FLDA MAXDIE FMUL #LIT+17 FADDM MXSCOR / IF(.NOT.(SCORNG.OR.GAVEUP))SCORE=SCORE+4 FLDA SCORNG FADD GAVEUP JNE .+5 FLDA #LIT FADDM SCORE / MXSCOR=MXSCOR+4 FLDA #LIT FADDM MXSCOR / IF(DFLAG.NE.0)SCORE=SCORE+25 FLDA DFLAG JEQ .+5 FLDA #LIT+52 FADDM SCORE / MXSCOR=MXSCOR+25 FLDA #LIT+52 FADDM MXSCOR / IF(CLOSNG)SCORE=SCORE+25 FLDA CLOSNG JEQ .+5 FLDA #LIT+52 FADDM SCORE / MXSCOR=MXSCOR+25 FLDA #LIT+52 FADDM MXSCOR / IF(.NOT.CLOSED)GOTO 20020 FLDA CLOSED JEQ #20020 / IF(BONUS.EQ.0)SCORE=SCORE+10 FLDA BONUS JNE .+5 FLDA #LIT+17 FADDM SCORE / IF(BONUS.EQ.135)SCORE=SCORE+25 DECIMAL LDX 135,0 OCTAL XTA 0 FSUB BONUS JNE .+5 FLDA #LIT+52 FADDM SCORE / IF(BONUS.EQ.134)SCORE=SCORE+30 DECIMAL LDX 134,0 OCTAL XTA 0 FSUB BONUS JNE .+5 FLDA #LIT+63 FADDM SCORE / IF(BONUS.EQ.133)SCORE=SCORE+45 DECIMAL LDX 133,0 OCTAL XTA 0 FSUB BONUS JNE #20020 FLDA #LIT+102 FADDM SCORE /20020 MXSCOR=MXSCOR+45 #20020, FLDA #LIT+102 FADDM MXSCOR /C /C DID HE COME TO WITT'S END AS HE SHOULD? /C / IF(PLACE(MAGZIN).EQ.108)SCORE=SCORE+1 FLDA MAGZIN ATX 7 DECIMAL LDX 108,0 OCTAL XTA 0 FSUB PLACE-3,7 JNE .+5 FLDA ONE FADDM SCORE / MXSCOR=MXSCOR+1 FLDA ONE FADDM MXSCOR /C /C ROUND IT OFF. /C / SCORE=SCORE+2 FLDA TWO FADDM SCORE / MXSCOR=MXSCOR+2 FADDM MXSCOR /C /C DEDUCT POINTS FOR HINTS. HINTS < 4 ARE SPECIAL; SEE DATABASE DESCRIPTION. /C / DO 20030 I=1,HNTMAX FLDA ONE FSTA I /20030 IF(HINTED(I))SCORE=SCORE-HINTS(I,2) #20030, FLDA I ATX 7 FLDA HINTED-3,7 JEQ .+14 FLDA #LIT+77 /20 FADD I /I, 2 ATX 6 FLDA SCORE FSUB HINTS-77,6 FSTA SCORE FLDA I FADD ONE FSTA I FSUB HNTMAX JLE #20030 /C /C RETURN TO SCORE COMMAND IF THAT'S WHERE WE CAME FROM. /C / IF(SCORNG)GOTO 8241 FLDA SCORNG JNE #8241 /C /C THAT SHOULD BE GOOD ENOUGH. LET'S TELL HIM ALL ABOUT IT. /C / TYPE 20100,SCORE,MXSCOR,TURNS JSA SPRINT JA #20100 JA TWO TRAP3 #WRITO JA #LIT JA #2010A FLDA SCORE TRAP3 #RSVO TRAP3 #RENDO JSA SPRINT JA #2010B JA THREE TRAP3 #WRITO JA #LIT JA #2010A FLDA MXSCOR TRAP3 #RSVO TRAP3 #RENDO JSA SPRINT JA #2010C JA THREE TRAP3 #WRITO JA #LIT JA #2010D FLDA TURNS TRAP3 #RSVO TRAP3 #RENDO JSA SPRINT JA #2010E JA ONE /20100 FORMAT(/' You scored',I4,' out of a possible',I4, / 1 ', using',I5,' turns.') /C / DO 20200 I=1,CLSSES FLDA ONE FSTA I / IF(CVAL(I).GE.SCORE)GOTO 20210 #I0064, FLDA I ATX 7 FLDA CVAL-3,7 FSUB SCORE JGE #20210 /20200 CONTINUE #20200, FLDA I FADD ONE FSTA I FSUB CLSSES JLE #I0064 / TYPE 20202 JSA SPRINT JA #20202 JA ZERO /20202 FORMAT(' You just went off my scale!!'/) / GOTO 25000 JA #25000 /C /20210 CALL SPEAK(CTEXT(I)) #20210, FLDA I ATX 7 FLDA CTEXT-3,7 /GET CLASS MESSAGE FSTA #TMP+3 JSR SPEAK JA .+4 JA #TMP+3 / IF(I.EQ.CLSSES-1)GOTO 20220 FLDA CLSSES FSUB ONE FSUB I JEQ #20220 / K=CVAL(I)+1-SCORE FLDA I ATX 7 FLDA CVAL-3,7 FADD ONE FSUB SCORE FSTA K / TYPE 20212,K JSA SPRINT JA #20212 JA TWO JSA SPRINT JA #2021A JA THREE TRAP3 #WRITO JA #LIT JA #2021B FLDA K TRAP3 #RSVO TRAP3 #RENDO JSA SPRINT JA #2021C JA THREE /20212 FORMAT(' To achieve the next higher rating, you need',I3, / 1 ' more point',$) / IF(K.EQ.1) TYPE 20213 FLDA K FSUB ONE JNE .+12 JSA SPRINT JA #20213 JA ONE JA #25000 / IF(K.NE.1) TYPE 20214 JSA SPRINT JA #20214 JA ONE /20213 FORMAT('+.'/) /20214 FORMAT('+s.'/) / GOTO 25000 JA #25000 /C /20220 TYPE 20222 #20220, JSA SPRINT JA #20212 JA TWO JSA SPRINT JA #20222 JA ONE JSA SPRINT JA #20223 JA ZERO /20222 FORMAT(' To achieve the next higher rating ', / 1 'would be a neat trick!'/' Congratulations!!'/) / RETURN JA #GOBAK / END / / Fortran Formats: / #67A, TEXT %T]HERE ARE @% #67, TEXT %('+',I1,$)% #67B, TEXT % T]HREATENING LITTLE DWARVES IN THE ROOM WITH YOU.@% #68, #78, TEXT %(1X,I1,$)% #78B, TEXT % ]OF THEM THROW KNIVES AT YOU!@% #68B, TEXT % ]OF THEM GET YOU!@% #5015, TEXT %W]HAT DO YOU WANT TO DO WITH THE @% #5199, TEXT %I] DON'T SEE ANY "@% #8002, TEXT %I ]DON'T UNDERSTAND "@% #9032, TEXT %O]KAY, "@% #8243, TEXT %I]F YOU WERE TO QUIT NOW, YOU WOULD SCORE @% #2010A, #2021B, #8243A, TEXT %('+',I3,$)% #2010B, #8243B, TEXT % ]OUT OF A POSSIBLE @% #20213, #8243C, TEXT %.@% #40012, TEXT %I] AM PREPARED TO GIVE YOU A HINT, BUT IT WILL COST YOU @% #4001A, TEXT %('+',I2,$)% #4001B, TEXT % ]POINTS.@% #20100, TEXT %Y]OU SCORED @% #2010C, TEXT % ]USING @% #2010D, TEXT %('+',I5,$)% #2010E, TEXT % ]TURNS.@% #20202, TEXT %Y]OU JUST WENT OFF MY SCALE!!@% #20212, TEXT %T]O ACHIEVE THE NEXT HIGHER RATING@% #2021A, TEXT %, ]YOU NEED @% #2021C, TEXT % ]MORE POINT@% #20214, TEXT %]S.@% #20222, TEXT %] WOULD BE A NEAT TRICK!@% #20223, TEXT %C]ONGRATULATIONS!!@% END