File: AMAIN.RA of Disk: V50/Source/Source-Listing-FORTRAN-2
(Source file text)
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
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
ZERO, F 0
ONE, F 1
TWO, F 2
THREE, F 3
#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 202 /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
PCOND, 0 /325
JA COND-3
PFIXD, 0 /330
JA FIXD-3
PHINTS, 0 /333
JA HINTS-77
PABB, 0 /336
JA ABB-3
PPLAC, 0 /341
JA PLAC-3
TENTE, TEXT +ENTE + /344
TPOUR, TEXT +POUR + /347
TWEST, TEXT +WEST + /352
TQUES, TEXT +?@ + /355
TQDOT, TEXT +".@ + /360
TYES, TEXT +YES + /363
TYE, TEXT +YE + /366
TY, TEXT +Y + /371
F 154 /374
F 60 /377
F 29 /402
MINUS1, F -1.0
#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 LAMP
ATX 4
FLDA PROP-3,4
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
/
/ Main routine entry point
/
#STRT,
/1 I=RND(1)
#1, JSR RND
JA .+4
JA ONE
FSTA I
/ HINTED(3)=YES(65,1,0)
LDX 3,7
JSR YES
JA .+10
JA #LIT+127
JA ONE
JA ZERO
FSTA HINTED-3,7
/ NEWLOC=1
FLDA ONE
FSTA NEWLOC
/ LOC = NEWLOC
FSTA LOC
/ LIMIT=330
LDX 512,0 /330
XTA 0
FSTA LIMIT
/ IF(HINTED(3))LIMIT=1000
FLDA HINTED-3,7
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
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
ATX 7
FLDA PROP-3,7
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 .+13
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 LAMP
ATX 6
FLDA PROP-3,6
FSUB ONE
JEQ #6025
/ IF(ODLOC(6).NE.DLOC(6).AND.PCT(20))CALL RSPEAK(127)
#M4, FLDA #LIT+6
ATX 7
FLDA ODLOC-3,7
FSUB DLOC-3,7
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 .+13
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 .+21
FLDA J
ATX 7
FLDA FIXED-3,7
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 SIXOUT
JA .+10
JA #67A
JA ZERO
JA TWO
TRAP3 #WRITO
JA #LIT
JA #67
FLDA DTOTAL
TRAP3 #RSVO
TRAP3 #RENDO
JSR SIXOUT
/ GOTO 77
JA #77
JA #67B
JA ZERO
JA ONE
/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
JSR SIXOUT
JA .+10
JA #78B
JA ZERO
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!')
JSR SIXOUT
JA .+10
JA #68B
JA ZERO
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
LDX 64,0 /52
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 .+26
FLDA LOC
ATX 7
XTA 7
FMUL THREE
ALN 0
STARTD
FADD PABB
FSTA .+7
STARTF
JSR MOD
JA .+6
JA .
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)
LDX 41,0 /33
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 7
FLDA ABB-3,7
FADD ONE
FSTA 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
ATX 7
FLDA PROP-3,7
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
ATX 7
FLDA PROP-3,7
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 .+6
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
FADD HINT
ATX 6
FLDA HINTLC-3,7
FSUB HINTS-0077,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
ATX 7
FLDA PROP-3,7
JGE .+20
FLDA OYSTER
JSA TOTING
JEQ .+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
ATX 7
JSA TOTING
JEQ .+13
FLDA PROP-3,7
JGE .+7
FLDA MINUS1
FSUB PROP-3,7
FSTA PROP-3,7
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
LDX 41,0 /33
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
ATX 7
FLDA PROP-3,7
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 .+25
FLDA BATTER
JSA HERE
JEQ .+17
FLDA BATTER
ATX 7
FLDA PROP-3,7
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
#19999, LDX 53,0 /43
XTA 0
FSTA K
/ IF(LIQLOC(LOC).EQ.WATER)K=70
JSA LIQLOC
FSUB WATER
JNE .+7
LDX 106,0 /70
XTA 0
FSTA K
/C
/C DO PRELIMINARY ANALYSIS OF SENTENCE TO FIND CERTAIN SPECIAL
/C CASES, VIZ,
/C
/C ENTER <WATER,STREAM>
/C ENTER <LOCATION>
/C <WATER,OIL> <PLANT,DOOR>
/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, LDX 74,0 /60
XTA 0
FSTA SPK
/ IF(PCT(20))SPK=61
JSR PCT
JA .+4
JA #LIT+36
JEQ .+6
LDX 75,0 /61
XTA 0
FSTA SPK
/ IF(PCT(20))SPK=13
JSR PCT
JA .+4
JA #LIT+36
JEQ .+6
LDX 15,0 /13
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 ',$)
JSR SIXOUT
JA .+10
JA #5015
JA ZERO
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 7
FLDA PROP-3,7
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
JSR SIXOUT
JA .+10
JA #5199
JA ZERO
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
LDX 310,0 /200
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
ATX 7
FLDA PROP-3,7
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
XTA 7
FMUL THREE
ALN 0
STARTD
FADD PPLAC
FSTA .+11
STARTF
JSR MOVE
JA .+6
JA TROLL
JA .
/ CALL MOVE(TROLL+100,FIXD(TROLL))
FLDA TROLL
FADD #LIT+154
FSTA #TMP
FLDA TROLL
ATX 7
XTA 7
FMUL THREE
ALN 0
STARTD
FADD PFIXD
FSTA .+11
STARTF
JSR MOVE
JA .+6
JA #TMP
JA .
/ CALL JUGGLE(CHASM)
JSR JUGGLE
JA .+4
JA CHASM
/ 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
/ PROP(TROLL)=2
FSTA PROP-3,7
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
ATX 7
FLDA PROP-3,7
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
LDX 53,0 /43
XTA 0
FSUB K
JGE .+7
FLDA K
FSUB #LIT+110
JLE #M31
/ IF(K.EQ.29.OR.K.EQ.30)SPK=9
LDX 35,0 /29
XTA 0
FSUB K
JEQ #M31
FADD ONE
JEQ #M31
JA #M33
#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
LDX 44,0
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, LDX 13,0 /11
XTA 0
FSUB K
JEQ #M36
LDX 23,0 /19
XTA 0
FSUB K
JNE #M32
#M36, LDX 13,0
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, LDX 73,0 /59
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, LDX 52,0 /42
XTA 0
FSTA SPK
/ IF(K.EQ.17)SPK=80
#M40, FLDA K
FSUB #LIT+33
JNE #M33
LDX 120,0 /80
XTA 0
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
FLDA #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 .+10
FLDA LAMP
ATX 7
FCLA
FSTA PROP-3,7
/ DO 98 J=1,100
FLDA ONE
FSTA J
/ I=101-J
#G0150, LDX 145,0 /101
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, JSR SIXOUT
JA .+10
JA #8002
JA ZERO
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 .+13
FLDA PLANT
ATX 7
FLDA PROP-3,7
JGT .+4
FLDA #LIT+165
FSTA SPK
/ IF(OBJ.EQ.BEAR.AND.PROP(BEAR).EQ.1)SPK=169
FLDA OBJ
FSUB BEAR
JNE .+16
FLDA BEAR
ATX 7
FLDA PROP-3,7
FSUB ONE
JNE .+6
LDX 251,0 /169
XTA 0
FSTA SPK
/ IF(OBJ.EQ.CHAIN.AND.PROP(BEAR).NE.0)SPK=170
FLDA OBJ
FSUB CHAIN
JNE .+15
FLDA BEAR
ATX 7
FLDA PROP-3,7
JEQ .+6
LDX 252,0 /170
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 #M222
FLDA BOTTLE
ATX 7
FLDA PROP-3,7
FSUB ONE
JEQ #9220
/ IF(PROP(BOTTLE).NE.1)SPK=105
#M222, FLDA BOTTLE
ATX 7
FLDA PROP-3,7
FSUB ONE
JEQ .+4
FLDA #LIT+157
FSTA SPK
/ IF(.NOT.TOTING(BOTTLE))SPK=104
FLDA BOTTLE
JSA TOTING
JNE #2011
LDX 150,0 / 104
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
ATX 7
FLDA PROP-3,7
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 .+30
FLDA BIRD
ATX 7
FLDA PROP-3,7
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, FLDA #LIT+135 /RHM - "Taken" message
FSTA K
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)
JSR DSTROY
JA .+4
JA SNAKE
/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 .+21
FLDA BIRD
ATX 7
FLDA PROP-3,7
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)
JSR DSTROY
JA .+4
JA COINS
/ 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 7
FLDA PROP-3,7
JNE #9026
/ CALL RSPEAK(154)
JSR RSPEAK
JA .+4
JA #LIT+374
/ CALL DSTROY(BIRD)
JSR DSTROY
JA .+4
JA BIRD
/ 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
XTA 7
FMUL THREE
ALN 0
STARTD
FADD PPLAC
FSTA .+11
STARTF
JSR MOVE
JA .+6
JA TROLL2
JA .
/ CALL MOVE(TROLL2+100,FIXD(TROLL))
FLDA TROLL2
FADD #LIT+154
FSTA #TMP
FLDA TROLL
ATX 7
XTA 7
FMUL THREE
ALN 0
STARTD
FADD PFIXD
FSTA .+11
STARTF
JSR MOVE
JA .+6
JA #TMP
JA .
/ CALL JUGGLE(CHASM)
JSR JUGGLE
JA .+4
JA CHASM
FLDA TROLL
ATX 7
/ PROP(TROLL)=2
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
ATX 7
FLDA PROP-3,7
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
LDX 3751,0 /2025
XTA 0
FSUB I
JEQ #9035
/ TYPE 9032
JSR SIXOUT
JA .+10
JA #9032
JA ZERO
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, LDX 34,0 /28
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
LDX 157,0 /111
XTA 0
FSTA SPK
/ IF(OBJ.EQ.DOOR.AND.PROP(DOOR).EQ.1)SPK=54
#9040A, FLDA OBJ
FSUB DOOR
JNE .+16
FLDA DOOR
ATX 7
FLDA PROP-3,7
FSUB ONE
JEQ .+6
LDX 74,0 /60
XTA 0
FSTA SPK
/ IF(OBJ.EQ.CAGE)SPK=32
FLDA OBJ
FSUB CAGE
JNE .+6
LDX 40,0 /32
XTA 0
FSTA SPK
/ IF(OBJ.EQ.KEYS)SPK=55
FLDA OBJ
FSUB KEYS
JNE .+6
LDX 67,0 /55
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
LDX 37,0 /31
XTA 0
FSTA SPK
/ IF(SPK.NE.31.OR..NOT.HERE(KEYS))GOTO 2011
LDX 37,0 /31
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
LDX 42,0 /34
XTA 0
FADD PROP-3,7
FSTA K
/ IF(VERB.EQ.LOCK)PROP(GRATE)=0
FLDA GRATE
ATX 7
FLDA ONE
FSTA PROP-3,7
FLDA VERB
FSUB LOCK
JNE .+10
FLDA GRATE
ATX 7
FCLA
FSTA PROP-3,7
/ K=K+2*PROP(GRATE)
FLDA GRATE
ATX 7
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
LDX 174,0
XTA 0
FADD K
FSTA SPK
/ IF(TOTING(OBJ))SPK=120+K
FLDA OBJ
JSA TOTING
JEQ #9046A
LDX 170,0 /120
XTA 0
FADD K
FSTA SPK
/ IF(.NOT.TOTING(TRIDNT))SPK=122+K
#9046A, FLDA TRIDNT
JSA TOTING
JNE .+10
LDX 172,0 /122
XTA 0
FADD K
FSTA SPK
/ IF(VERB.EQ.LOCK)SPK=61
FLDA VERB
FSUB LOCK
JNE .+6
LDX 75,0 /61
XTA 0
FSTA SPK
/ IF(SPK.NE.124)GOTO 2011
LDX 174,0 /124
XTA 0
FSUB SPK
JNE #2011
/ CALL DSTROY(CLAM)
JSR DSTROY
JA .+4
JA CLAM
/ 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
LDX 253,0 /171
XTA 0
FSTA SPK
/ IF(PROP(BEAR).EQ.0)SPK=41
FLDA BEAR
ATX 7
FLDA PROP-3,7
JNE .+6
LDX 51,0 /41
XTA 0
FSTA SPK
/ IF(PROP(CHAIN).EQ.0)SPK=37
FLDA CHAIN
ATX 7
FLDA PROP-3,7
JNE .+4
FLDA #LIT+71
FSTA SPK
/ IF(SPK.NE.171)GOTO 2011
LDX 253,0 /171
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
ATX 7
FLDA PROP-3,7
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, LDX 254,0 /172
XTA 0
FSTA SPK
/ IF(PROP(CHAIN).NE.0)SPK=34
FLDA CHAIN
ATX 7
FLDA PROP-3,7
JEQ .+6
LDX 42,0 /34
XTA 0
FSTA SPK
/ IF(LOC.NE.PLAC(CHAIN))SPK=173
FLDA LOC
FSUB PLAC-3,7
JEQ .+6
LDX 255,0 /173
XTA 0
FSTA SPK
/ IF(SPK.NE.172)GOTO 2011
LDX 254,0 /172
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
JSA HERE
JEQ #2011
/ PROP(LAMP)=0
FLDA LAMP
ATX 7
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+402
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 .+20
FLDA DRAGON
ATX 7
FLDA PROP-3,7
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 .+20
FLDA BEAR
ATX 7
FLDA PROP-3,7
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
LDX 211,0 /137
XTA 0
FSTA SPK
/ IF(CLOSED)GOTO 2011
FLDA CLOSED
JNE #2011
/ CALL DSTROY(BIRD)
JSR DSTROY
JA .+4
JA BIRD
/ 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
LDX 54,0 /44
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
LDX 226,0 /150
XTA 0
FSTA SPK
/ IF(OBJ.EQ.SNAKE)SPK=46
FLDA OBJ
FSUB SNAKE
JNE .+6
LDX 56,0 /46
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
LDX 247,0 /167
XTA 0
FSTA SPK
/ IF(OBJ.EQ.TROLL)SPK=157
FLDA OBJ
FSUB TROLL
JNE .+6
LDX 235,0 /157
XTA 0
FSTA SPK
/ IF(OBJ.EQ.BEAR)SPK=165+(PROP(BEAR)+1)/2
FLDA OBJ
FSUB BEAR
JNE .+15
FLDA BEAR
ATX 7
FLDA PROP-3,7
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
ATX 7
FLDA PROP-3,7
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
LDX 116,0 /78
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
LDX 115,0 /77
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
LDX 160,0 /112
XTA 0
FSTA SPK
/ IF(OBJ.NE.WATER)GOTO 2011
FLDA OBJ
FSUB WATER
JNE #2011
/ CALL PSPEAK(PLANT,PROP(PLANT)+1)
FLDA PLANT
ATX 7
FLDA PROP-3,7
FADD ONE
FSTA #TMP
JSR PSPEAK
JA .+6
JA PLANT
JA #TMP
/ PROP(PLANT)=MOD(PROP(PLANT)+2,6)
FLDA PLANT
ATX 7
FLDA PROP-3,7
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
ATX 6
FLDA PROP-3,6
FDIV TWO
JSA #FIX
FSTA PROP-3,7
/ 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
LDX 161,0 /113
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, JSR DSTROY
JA .+4
JA FOOD
/ SPK=72
LDX 110,0 /72
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, LDX 107,0 /71
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 .+12
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 BOTTLE
ATX 7
FLDA ONE
FSTA PROP-3,7
/ PLACE(WATER)=0
FLDA WATER
ATX 7
FCLA
FSTA PLACE-3,7
/ SPK=74
LDX 112,0 /74
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
LDX 114,0 /76
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
LDX 230,0 /152
XTA 0
FSTA SPK
/ IF(AT(DRAGON).AND.PROP(DRAGON).EQ.0)GOTO 9175
FLDA DRAGON
JSA AT
JEQ #M84
FLDA DRAGON
ATX 7
FLDA PROP-3,7
JEQ #9175
/ SPK=158
#M84, LDX 236,0 /158
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 BEAR
ATX 7
FLDA PROP-3,7
JEQ #9176
/ OBJ=0
#M85, FCLA
FSTA OBJ
/ GOTO 9120
JA #9120
/C
/9172 SPK=48
#9172, LDX 60,0 /48
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
LDX 57,0 /47
XTA 0
FSTA SPK
/ DKILL=DKILL+1
FLDA ONE
FADDM DKILL
/ IF(DKILL.EQ.1)SPK=149
FSUB ONE
JNE #9175
LDX 225,0 /149
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, LDX 244,0 /164
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)
JSR JUGGLE
/ GOTO 2011
JA #2011
JA BEAR
/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, LDX 237,0 /159
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
XTA 7
FMUL THREE
ALN 0
STARTD
FADD PPLAC
FSTA .+11
STARTF
JSR DROP
JA .+6
JA TROLL2
JA .
/ CALL DROP(TROLL2+100,FIXD(TROLL))
FLDA TROLL2
FADD #LIT+154
FSTA #TMP
FLDA TROLL
ATX 7
XTA 7
FMUL THREE
ALN 0
STARTD
FADD PFIXD
FSTA .+11
STARTF
JSR DROP
JA .+6
JA #TMP
JA .
/ CALL JUGGLE(CHASM)
JSR JUGGLE
JA .+4
JA CHASM
/ 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, LDX 136,0 /94
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
LDX 136,0 /94
XTA 0
FSTA SPK
#M88, FLDA I
FADD ONE
FSTA I
FSUB #LIT+3
JLE #9192
/ IF(CLOSED)SPK=138
FLDA CLOSED
JEQ .+6
LDX 212,0 /138
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, LDX 142,0 /98
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)
LDX 142,0 /98
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, LDX 146,0 /102
XTA 0
FSTA SPK
/ IF(OBJ.EQ.DRAGON.AND.PROP(DRAGON).NE.0)SPK=110
FLDA OBJ
FSUB DRAGON
JNE #M90
FLDA DRAGON
ATX 7
FLDA PROP-3,7
JEQ .+4
FLDA #LIT+162
FSTA SPK
/ IF(OBJ.EQ.TROLL)SPK=182
#M90, FLDA OBJ
FSUB TROLL
JNE .+6
LDX 266,0 /182
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
LDX 145,0 /101
XTA 0
FSTA SPK
/ CALL DSTROY(BIRD)
JSR DSTROY
JA .+4
JA BIRD
/ 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
LDX 147,0 / 103
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
ATX 7
FLDA PROP-3,7
JNE .+6
LDX 146,0 /102
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)
JSR DSTROY
JA .+4
JA FOOD
/ 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
LDX 250,0 /168
XTA 0
FSTA SPK
/ GOTO 2011
JA #2011
/C
/9215 SPK=14
#9215, LDX 16,0 /14
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, LDX 153,0 /107
XTA 0
FSTA SPK
/ IF(LIQLOC(LOC).EQ.0)SPK=106
JSA LIQLOC
JNE #M92A
LDX 152,0 /106
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
LDX 153,0 /107
XTA 0
FSUB SPK
JNE #2011
/ PROP(BOTTLE)=MOD(COND(LOC),4)/2*2
FLDA BOTTLE
ATX 7
FLDA LOC
ATX 6
XTA 6
FMUL THREE
ALN 0
STARTD
FADD PCOND
FSTA .+7
STARTF
JSR MOD
JA .+6
JA .
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 .+11
FLDA K
ATX 7
FLDA MINUS1
FSTA PLACE-3,7
/ IF(K.EQ.OIL)SPK=108
FLDA K
FSUB OIL
JNE #2011
LDX 154,0 /108
XTA 0
FSTA SPK
/ GOTO 2011
JA #2011
/C
/9222 SPK=29
#9222, LDX 35,0 /29
XTA 0
FSTA SPK
/ IF(LIQLOC(LOC).EQ.0)SPK=144
JSA LIQLOC
JNE .+6
LDX 220,0 /144
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
ATX 7
FLDA PROP-3,7
JLT #2011
FLDA CLOSED
JEQ #2011
/ BONUS=133
LDX 205,0 /133
XTA 0
FSTA BONUS
/ IF(LOC.EQ.115)BONUS=134
FLDA LOC
FSUB #LIT+165
JNE .+7
LDX 206,0 /134
XTA 0
FSTA BONUS
/ IF(HERE(ROD2))BONUS=135
FLDA ROD2
JSA HERE
JEQ .+7
LDX 207,0 /135
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
JSR SIXOUT
JA .+10
JA #8243
JA ZERO
JA TWO
TRAP3 #WRITO
JA #LIT
JA #8243A
FLDA SCORE
TRAP3 #RSVO
TRAP3 #RENDO
JSR SIXOUT
JA .+10
JA #8243B
JA ZERO
JA THREE
TRAP3 #WRITO
JA #LIT
JA #8243A
FLDA MXSCOR
TRAP3 #RSVO
TRAP3 #RENDO
JSR SIXOUT
JA .+10
JA #8243C
JA ZERO
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
LDX 52,0 /42
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
LDX 227,0 /151
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))
XTA 7
FMUL THREE
ALN 0
STARTD
FADD PPLAC
FSTA .+11
STARTF
JSR MOVE
JA .+6
JA EGGS
JA .
/ 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, LDX 234,0 /156
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
LDX 276,0 /190
XTA 0
FSTA SPK
/ IF(OBJ.EQ.TABLET)SPK=196
FLDA OBJ
FSUB TABLET
JNE .+6
LDX 304,0 /196
XTA 0
FSTA SPK
/ IF(OBJ.EQ.MESSAG)SPK=191
FLDA OBJ
FSUB MESSAG
JNE .+6
LDX 277,0 /191
XTA 0
FSTA SPK
/ IF(OBJ.EQ.OYSTER.AND.HINTED(2).AND.TOTING(OYSTER))SPK=194
FLDA OBJ
FSUB OYSTER
JNE #M95
FLDA TWO
ATX 7
FLDA HINTED-3,7
JEQ #M95
FLDA OYSTER
JSA TOTING
JEQ .+6
LDX 302,0 /194
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,7
JNE #2011
FLDA OYSTER
JSA TOTING
JEQ #2011
FLDA CLOSED
JEQ #2011
/ HINTED(2)=YES(192,193,54)
FLDA TWO
ATX 7
JSR YES
JA .+10
JA #LIT+267
JA #LIT+272
JA #LIT+113
FSTA HINTED-3,7
/ 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
LDX 224,0 /148
XTA 0
FSTA SPK
/ IF(OBJ.EQ.VASE.AND.PROP(VASE).EQ.0)GOTO 9282
FLDA OBJ
FSUB VASE
JNE #M96
FLDA VASE
ATX 7
FLDA PROP-3,7
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, LDX 306,0 /198
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 VASE
ATX 7
FLDA TWO
FSTA PROP-3,7
/ FIXED(VASE)=-1
FLDA MINUS1
FSTA FIXED-3,7
/ 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+377
FADD HINT
ATX 7
XTA 7
FMUL THREE
ALN 0
STARTD
FADD PHINTS
FSTA .+7
STARTF
JSR YES
JA .+10
JA .
JA ZERO
JA #LIT+113
JEQ #2602
/ TYPE 40012,HINTS(HINT,2)
JSR SIXOUT
JA .+10
JA #40012
JA ZERO
JA TWO
TRAP3 #WRITO
JA #LIT
JA #4001A
FLDA TWO
FMUL #LIT+36
FADD HINT
ATX 7
FLDA HINTS-0077,7
TRAP3 #RSVO
TRAP3 #RENDO
JSR SIXOUT
JA .+10
JA #4001B
JA ZERO
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 7
FLDA #LIT
FMUL #LIT+36
FADD HINT
ATX 6
XTA 6
FMUL THREE
ALN 0
STARTD
FADD PHINTS
FSTA .+11
STARTF
JSR YES
JA .+10
JA #LIT+250
JA .
JA #LIT+113
FSTA HINTED-3,7
/ IF(HINTED(HINT).AND.LIMIT.GT.30)LIMIT=LIMIT+30*HINTS(HINT,2)
JEQ #40020
FLDA LIMIT
FSUB #LIT+63
JLE #40020
FLDA TWO
FMUL #LIT+36
FADD HINT
ATX 6
FLDA #LIT+63
FMUL HINTS-0077,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
ATX 7
FLDA PROP-3,7
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
FADD #LIT+154
FSTA #TMP
JSR MOVE
JA .+6
JA #TMP
JA ZERO
/ CALL MOVE(TROLL2,PLAC(TROLL))
FLDA TROLL
ATX 7
XTA 7
FMUL THREE
ALN 0
STARTD
FADD PPLAC
FSTA .+11
STARTF
JSR MOVE
JA .+6
JA TROLL2
JA .
/ CALL MOVE(TROLL2+100,FIXD(TROLL))
FLDA TROLL2
FADD #LIT+154
FSTA #TMP
FLDA TROLL
ATX 7
XTA 7
FMUL THREE
ALN 0
STARTD
FADD PFIXD
FSTA .+11
STARTF
JSR MOVE
JA .+6
JA #TMP
JA .
/ CALL JUGGLE(CHASM)
JSR JUGGLE
JA .+4
JA CHASM
/ IF(PROP(BEAR).NE.3)CALL DSTROY(BEAR)
FLDA BEAR
ATX 7
FLDA PROP-3,7
FSUB THREE
JEQ .+10
JSR DSTROY
JA .+4
JA BEAR
/ 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 MINUS1
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 .+10
JSR DSTROY
JA .+4
JA I
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
LDX 273,0 /187
XTA 0
FSTA SPK
/ IF(PLACE(BATTER).EQ.0)SPK=183
FLDA BATTER
ATX 7
FLDA PLACE-3,7
JNE .+6
LDX 267,0 /183
XTA 0
FSTA SPK
/ IF(PROP(BATTER).EQ.1)SPK=189
FLDA PROP-3,7
FSUB ONE
JNE .+6
LDX 275,0 /189
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
LDX 16,0 /14
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
LDX 207,0 /135
XTA 0
FSUB BONUS
JNE .+5
FLDA #LIT+52
FADDM SCORE
/ IF(BONUS.EQ.134)SCORE=SCORE+30
LDX 206,0 /134
XTA 0
FSUB BONUS
JNE .+5
FLDA #LIT+63
FADDM SCORE
/ IF(BONUS.EQ.133)SCORE=SCORE+45
LDX 205,0 /133
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
LDX 154,0 /108
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 .+15
FLDA TWO
FMUL #LIT+36
FADD I
ATX 6
FLDA SCORE
FSUB HINTS-0077,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
JSR SIXOUT
JA .+10
JA #20100
JA ZERO
JA TWO
TRAP3 #WRITO
JA #LIT
JA #2010A
FLDA SCORE
TRAP3 #RSVO
TRAP3 #RENDO
JSR SIXOUT
JA .+10
JA #2010B
JA ZERO
JA THREE
TRAP3 #WRITO
JA #LIT
JA #2010A
FLDA MXSCOR
TRAP3 #RSVO
TRAP3 #RENDO
JSR SIXOUT
JA .+10
JA #2010C
JA ZERO
JA THREE
TRAP3 #WRITO
JA #LIT
JA #2010D
FLDA TURNS
TRAP3 #RSVO
TRAP3 #RENDO
JSR SIXOUT
JA .+10
JA #2010E
JA ZERO
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
JSR SIXOUT
JA #25000
JA #20202
JA ZERO
JA ZERO
/20202 FORMAT(' You just went off my scale!!'/)
/ GOTO 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
JSR SIXOUT
JA .+10
JA #20212
JA ZERO
JA TWO
TRAP3 #WRITO
JA #LIT
JA #2021A
FLDA K
TRAP3 #RSVO
TRAP3 #RENDO
JSR SIXOUT
JA .+10
JA #2021B
JA ZERO
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 .+14
JSR SIXOUT
JA #25000
JA #20213
JA ZERO
JA ONE
/ IF(K.NE.1) TYPE 20214
JSR SIXOUT
JA #25000
JA #20214
JA ZERO
JA ONE
/20213 FORMAT('+.'/)
/20214 FORMAT('+s.'/)
/ GOTO 25000
/C
/20220 TYPE 20222
#20220, JSR SIXOUT
JA .+10
JA #20222
JA ZERO
JA ZERO
JSR SIXOUT
JA #GOBAK
JA #20223
JA ZERO
JA ZERO
/20222 FORMAT(' To achieve the next higher rating ',
/ 1 'would be a neat trick!'/' Congratulations!!'/)
/ RETURN
/ 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,
#8243A, TEXT %('+',I4,$)%
#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 @%
#2010B, TEXT % ]OUT OF A POSSIBLE @%
#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, YOU NEED @%
#2021A, TEXT %('+',I3,$)%
#2021B, TEXT % ]MORE POINT@%
#20214, TEXT %]S.@%
#20222, TEXT %T]O ACHIEVE THE NEXT HIGHER RATING WOULD BE A NEAT TRICK!@%
#20223, TEXT %C]ONGRATULATIONS!!@%
END