home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Fatal Distractions!
/
fataldistractions.bin
/
chap01
/
adventur
/
search.for
< prev
next >
Wrap
Text File
|
1990-11-18
|
31KB
|
985 lines
SUBROUTINE SEARCH(IRET)
C
C MODIFIED BY KENT BLACKETT
C ENGINEERING SYSTEMS GROUP
C DIGITAL EQUIPMENT CORP.
C 15-JUL-77
C ORIGINAL VERSION WAS FOR DECSYSTEM-10
C THIS VERSION IS FOR FORTRAN IV-PLUS UNDER
C THE IAS OPERATING SYSTEM ON THE PDP-11/70
C NOTE THAT IT MUST BE COMPILED WITH THE
C /WF:3/I4 SWITCHES...
C
C
C CURRENT LIMITS
C 750 TRAVEL OPTIONS (TRAVEL, TRVSIZ).
C 300 VOCABULARY WORDS (KTAB, ATAB, TABSIZ).
C 150 LOCATIONS (LTEXT, STEXT, KEY, COND, ABB, ATLOC, LOCSIZ)
C 100 OBJECTS (PLAC, PLACE, FIXD, FIXED, LINK (TWICE), PTEXT, PROP).
C 35 "ACTION" VERBS (ACTSPK, VRBSIZ).
C 205 RANDOM MESSAGES (RTEXT, TRXSIZ).
C 12 DIFFERENT PLAYER CLASSIFICATIONS (CTEXT, CVAL, CLSMAX).
C 20 HINTS, LESS 3 (HINTLC, HINTED, HINTS, HNTSIZ).
C 35 MAGIC MESSAGES (MTEXT, MAGSIZ).
C THERE ARE ALSO LIMITS WHICH CANNOT BE EXCEEDED DUE TO THE STRUCTURE OF
C THE DATABASE. (E.G., THE VOCABULARY USES N/1000 TO DETERMINE WORD TYPE,
C SO THERE CAN'T BE MORE THAN 1000 WORDS.) THESE UPPER LIMITS ARE:
C 1000 NON-SYNONYMOUS VOCABULARY WORDS
C 300 LOCATIONS
C 100 OBJECTS
C
C INCLUDE DEFINED COMMONS
INCLUDE 'ADVCOM.COM'
INCLUDE 'NEWCOM.COM'
C
CHARACTER*1 TEXT(20)
LOGICAL PTIME
INCLUDE 'FUNCT.H'
C
C
INCLUDE 'DATAB.H'
C
C DETERMINE PROCESSING TO BE PERFORMED.
C
GOTO(2000,99)IRET
C
C DESCRIBE THE CURRENT LOCATION AND (MAYBE) GET NEXT COMMAND.
C PRINT TEXT FOR CURRENT LOC.
2000 IF(LOC.EQ.0) GOTO 99
KK=STEXT(LOC)
IF(ABBNUM.EQ.0) KENT=0
IF(ABBNUM.NE.0) KENT=MOD(ABB(LOC),ABBNUM)
IF(KENT.EQ.0.OR.KK.EQ.0) KK=LTEXT(LOC)
IF(FORCED(LOC).OR..NOT.DARK(0)) GOTO 2001
IF(WZDARK.AND.PCT(35)) GOTO 90
KK=RTEXT(16)
2001 IF(TOTING(BEAR)) CALL RSPEAK(141)
CALL SPEAK(KK)
K=1
IF(FORCED(LOC)) GOTO 8
IF(LOC.EQ.33.AND.PCT(25).AND..NOT.CLOSNG) CALL RSPEAK(8)
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 INTIALLY 1 (LOCKED TO BEAR). THESE HACKS
C ARE BECAUSE PROP=0 IS NEEDED TO GET FULL SCORE.
IF(DARK(0)) GOTO 2012
ABB(LOC)=ABB(LOC)+1
I=ATLOC(LOC)
2004 IF(I.EQ.0) GOTO 2012
BLKLIN=.FALSE.
OBJ=I
IF(OBJ.GT.100) OBJ=OBJ-100
IF(OBJ.EQ.STEPS.AND.TOTING(NUGGET)) GOTO 2008
IF(PROP(OBJ).GE.0) GOTO 2006
IF(CLOSED) GOTO 2008
PROP(OBJ)=0
IF(OBJ.EQ.RUG.OR.OBJ.EQ.CHAIN) PROP(OBJ)=1
TALLY=TALLY-1
C IF REMAINING TREASURES TOO ELUSIVE, ZAP HIS LAMP.
IF(TALLY.EQ.TALLY2.AND.TALLY.NE.0) LIMIT=MIN0(35,LIMIT)
2006 KK=PROP(OBJ)
IF(OBJ.EQ.STEPS.AND.LOC.EQ.FIXED(STEPS)) KK=1
CALL PSPEAK(OBJ,KK)
2008 I=LINK(I)
GOTO 2004
2009 K=54
2010 SPK=K
2011 CALL RSPEAK(SPK)
2012 VERB=0
OBJ=0
BLKLIN=.TRUE.
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).
2600 CONTINUE
CALL HELPME
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).
IF(.NOT.CLOSED) GOTO 2605
IF(PROP(OYSTER).LT.0.AND.TOTING(OYSTER))
1 CALL PSPEAK(OYSTER,1)
DO 2604 I=1,100
2604 IF(TOTING(I).AND.PROP(I).LT.0) PROP(I)=-1-PROP(I)
2605 WZDARK=DARK(0)
IF(KNFLOC.GT.0.AND.KNFLOC.NE.LOC) KNFLOC=0
I=RAN(1)
CALL GETIN(WD1,WD1X,WD2,WD2X)
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.
2608 FOOBAR=MIN0(0,-FOOBAR)
IF(TURNS.EQ.0.AND.WD1.EQ.'MAGI'.AND.WD2.EQ.'MODE') GOTO 26000
TURNS=TURNS+1
CALL DATIME(D,T)
PRIMTM=WKDAY
IF(MOD(D,7).LE.1) PRIMTM=WKEND
IF(D.GE.HBEGIN.AND.D.LE.HEND) PRIMTM=HOLID
PTIME=(PRIMTM.AND.SHIFT(1,T/60)).NE.0
IF((.NOT.(DEMO.OR.WIZ)).AND.PTIME) GOTO 13000
IF(DEMO.AND.TURNS.GE.SHORT) GOTO 13000
IF(VERB.EQ.SAY.AND.WD2.NE.0) VERB=0
IF(VERB.EQ.SAY) GOTO 4090
IF(TALLY.EQ.0.AND.LOC.GE.15.AND.LOC.NE.33) CLOCK1=CLOCK1-1
IF(CLOCK1.EQ.0) GOTO 10000
IF(CLOCK1.LT.0) CLOCK2=CLOCK2-1
IF(CLOCK2.EQ.0) GOTO 11000
IF(PROP(LAMP).EQ.1) LIMIT=LIMIT-1
IF(LIMIT.LE.30.AND.HERE(BATTER).AND.PROP(BATTER).EQ.0
1 .AND.HERE(LAMP)) GOTO 12000
IF(LIMIT.EQ.0) GOTO 12400
IF(LIMIT.LT.0.AND.LOC.LE.8) GOTO 12600
IF(LIMIT.LE.30) GOTO 12200
19999 K=43
IF(LIQLOC(LOC).EQ.WATER) K=70
IF(WD1.EQ.'ENTE'.AND.(WD2.EQ.'STRE'.OR.WD2.EQ.'WATE')) GOTO 2010
IF(WD1.EQ.'ENTE'.AND.WD2.NE.0) GOTO 2800
IF((WD1.NE.'WATE'.AND.WD1.NE.'OIL')
1 .OR.(WD2.NE.'PLAN'.AND.WD2.NE.'DOOR')) GOTO 2610
IF(AT(VOCAB(WD2,1)))WD2='POUR'
2610 IF(WD1.NE.'WEST') GOTO 2630
IWEST=IWEST+1
IF(IWEST.EQ.10) CALL RSPEAK(17)
2630 I=VOCAB(WD1,-1)
IF(I.EQ.-1) GOTO 3000
K=MOD(I,1000)
KQ=I/1000+1
GOTO (8,5000,4000,2010) KQ
CALL BUG(22)
C GET SECOND WORD FOR ANALYSIS.
2800 WD1=WD2
WD1X=WD2X
WD2=0
GOTO 2610
C GEE, I DON'T UNDERSTAND.
3000 SPK=60
IF(PCT(20)) SPK=61
IF(PCT(20)) SPK=13
CALL RSPEAK(SPK)
GOTO 2600
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.
4000 VERB=K
SPK=ACTSPK(VERB)
IF(WD2.NE.0.AND.VERB.NE.SAY) GOTO 2800
IF(VERB.EQ.SAY) OBJ=WD2
IF(OBJ.NE.0) GOTO 4090
C ANALYSE AN INTRANSITIVE VERB (I.E., NO OBJECT GIVEN YET).
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) 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
CALL BUG(23)
C ANALYSE A TRANSITIVE VERB.
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) 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
CALL BUG(24)
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.
5000 OBJ=K
IF(FIXED(K).NE.LOC.AND..NOT.HERE(K)) GOTO 5100
5010 IF(WD2.NE.0) GOTO 2800
IF(VERB.NE.0) GOTO 4090
CALL A5TOA1(WD1,WD1X,'? ',TEXT,K)
WRITE(*,5015) (TEXT(I),I=1,K)
5015 FORMAT(/' WHAT DO YOU WANT TO DO WITH THE ',20A1)
GOTO 2600
5100 IF(K.NE.GRATE) GOTO 5110
IF(LOC.EQ.1.OR.LOC.EQ.4.OR.LOC.EQ.7) K=DPRSSN
IF(LOC.GT.9.AND.LOC.LT.15) K=ENTRNC
IF(K.NE.GRATE) GOTO 8
5110 IF(K.NE.DWARF) GOTO 5120
DO 5112 I=1,5
IF(DLOC(I).EQ.LOC.AND.DFLAG.GE.2) GOTO 5010
5112 CONTINUE
5120 IF((LIQ(0).EQ.K.AND.HERE(BOTTLE)).OR.K.EQ.LIQLOC(LOC)) GOTO 5010
IF(OBJ.NE.PLANT.OR..NOT.AT(PLANT2).OR.PROP(PLANT2).EQ.0) GOTO 5130
OBJ=PLANT2
GOTO 5010
5130 IF(OBJ.NE.KNIFE.OR.KNFLOC.NE.LOC) GOTO 5140
KNFLOC=-1
SPK=116
GOTO 2011
5140 IF(OBJ.NE.ROD.OR..NOT.HERE(ROD2)) GOTO 5190
OBJ=ROD2
GOTO 5010
5190 IF((VERB.EQ.FIND.OR.VERB.EQ.INVENT).AND.WD2.EQ.0) GOTO 5010
CALL A5TOA1(WD1,WD1X,'HERE',TEXT,K)
WRITE(*,5199) (TEXT(I),I=1,K)
5199 FORMAT(/' I SEE NO '20A1)
GOTO 2012
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 CONTINUE
CALL NEW1(IRET)
GOTO (2,99),IRET
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 REINCRNATED, 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 THE EASIEST WAY TO GET KILLED IS TO FALL INTO A PIT IN PITCH DARKNESS.
90 CALL RSPEAK(23)
OLDLC2=LOC
C OKAY, HE'S DEAD. LET'S GET ON WITH IT.
99 IF(CLOSNG) GOTO 95
YEA=YES(81+NUMDIE*2,82+NUMDIE*2,54)
NUMDIE=NUMDIE+1
IF(NUMDIE.EQ.MAXDIE.OR..NOT.YEA) GOTO 20000
PLACE(WATER)=0
PLACE(OIL)=0
IF(TOTING(LAMP)) PROP(LAMP)=0
DO 98 J=1,100
I=101-J
IF(.NOT.TOTING(I)) GOTO 98
K=OLDLC2
IF(I.EQ.LAMP) K=1
CALL DROP(I,K)
98 CONTINUE
LOC=3
OLDLOC=LOC
GOTO 2000
C HE DIED DURING CLOSING TIME. NO RESURRECTION. TALLY UP A DEATH AND EXIT.
95 CALL RSPEAK(131)
NUMDIE=NUMDIE+1
GOTO 20000
C ROUTINES FOR PERFORMING THE VARIOUS ACTION VERBS
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 RANDOM INTRANSITIVE VERBS COME HERE. CLEAR OBJ JUST IN CASE (SEE "ATTACK").
8000 CALL A5TOA1(WD1,WD1X,'HUH?',TEXT,K)
WRITE(*,8002) (TEXT(I),I=1,K)
8002 FORMAT(/' ',20A1)
OBJ=0
GOTO 2600
C CARRY, NO OBJECT GIVEN YET. OK IF ONLY ONE OBJECT PRESENT.
8010 IF(ATLOC(LOC).EQ.0.OR.LINK(ATLOC(LOC)).NE.0) GOTO 8000
DO 8012 I=1,5
IF(DLOC(I).EQ.LOC.AND.DFLAG.GE.2) GOTO 8000
8012 CONTINUE
OBJ=ATLOC(LOC)
C CARRY AN OBJECT. SPECIAL CASES FOR BIRD AND CAGE (F BIRD IN CAGE, CAN'T
C TAKE ONE WITHOUT THE OTHER. LIQUIDS ALSO SPECIAL, SINCE THEY DEPEND ON
C STATUS OF BOTTLE. ALSO VARIOUIS SIDE EFFECTS, ETC.
9010 IF(TOTING(OBJ)) GOTO 2011
SPK=25
IF(OBJ.EQ.PLANT.AND.PROP(PLANT).LE.0) SPK=115
IF(OBJ.EQ.BEAR.AND.PROP(BEAR).EQ.1) SPK=169
IF(OBJ.EQ.CHAIN.AND.PROP(BEAR).NE.0) SPK=170
IF(FIXED(OBJ).NE.0) GOTO 2011
IF(OBJ.NE.WATER.AND.OBJ.NE.OIL) GOTO 9017
IF(HERE(BOTTLE).AND.LIQ(0).EQ.OBJ) GOTO 9018
OBJ=BOTTLE
IF(TOTING(BOTTLE).AND.PROP(BOTTLE).EQ.1) GOTO 9220
IF(PROP(BOTTLE).NE.1) SPK=105
IF(.NOT.TOTING(BOTTLE)) SPK=104
GOTO 2011
9018 OBJ=BOTTLE
9017 IF(HOLDNG.LT.7) GOTO 9016
CALL RSPEAK(92)
GOTO 2012
9016 IF(OBJ.NE.BIRD) GOTO 9014
IF(PROP(BIRD).NE.0) GOTO 9014
IF(.NOT.TOTING(ROD)) GOTO 9013
CALL RSPEAK(26)
GOTO 2012
9013 IF(TOTING(CAGE)) GOTO 9015
CALL RSPEAK(27)
GOTO 2012
9015 PROP(BIRD)=1
9014 IF((OBJ.EQ.BIRD.OR.OBJ.EQ.CAGE).AND.PROP(BIRD).NE.0)
1 CALL CARRY(BIRD+CAGE-OBJ,LOC)
CALL CARRY(OBJ,LOC)
K=LIQ(0)
IF(OBJ.EQ.BOTTLE.AND.K.NE.0) PLACE(K)=-1
GOTO 2009
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.
9020 IF(TOTING(ROD2).AND.OBJ.EQ.ROD.AND..NOT.TOTING(ROD)) OBJ=ROD2
IF(.NOT.TOTING(OBJ)) GOTO 2011
IF(OBJ.NE.BIRD.OR..NOT.HERE(SNAKE)) GOTO 9024
CALL RSPEAK(30)
IF(CLOSED) GOTO 19000
CALL DSTROY(SNAKE)
C SET PROP FOR USE BY TRAVEL OPTIONS
PROP(SNAKE)=1
9021 K=LIQ(0)
IF(K.EQ.OBJ) OBJ=BOTTLE
IF(OBJ.EQ.BOTTLE.AND.K.NE.0) PLACE(K)=0
IF(OBJ.EQ.CAGE.AND.PROP(BIRD).NE.0) CALL DROP(BIRD,LOC)
IF(OBJ.EQ.BIRD)PROP(BIRD)=0
CALL DROP(OBJ,LOC)
GOTO 2012
9024 IF(OBJ.NE.COINS.OR..NOT.HERE(VEND)) GOTO 9025
CALL DSTROY(COINS)
CALL DROP(BATTER,LOC)
CALL PSPEAK(BATTER,0)
GOTO 2012
9025 IF(OBJ.NE.BIRD.OR..NOT.AT(DRAGON).OR.PROP(DRAGON).NE.0) GOTO 9026
CALL RSPEAK(154)
CALL DSTROY(BIRD)
PROP(BIRD)=0
IF(PLACE(SNAKE).EQ.PLAC(SNAKE)) TALLY2=TALLY2+1
GOTO 2012
9026 IF(OBJ.NE.BEAR.OR..NOT.AT(TROLL)) GOTO 9027
CALL RSPEAK(163)
CALL MOVE(TROLL,0)
CALL MOVE(TROLL+100,0)
CALL MOVE(TROLL2,PLAC(TROLL))
CALL MOVE(TROLL2+100,FIXD(TROLL))
CALL JUGGLE(CHASM)
PROP(TROLL)=2
GOTO 9021
9027 IF(OBJ.EQ.VASE.AND.LOC.NE.PLAC(PILLOW)) GOTO 9028
CALL RSPEAK(54)
GOTO 9021
9028 PROP(VASE)=2
IF(AT(PILLOW)) PROP(VASE)=0
CALL PSPEAK(VASE,PROP(VASE)+1)
IF(PROP(VASE).NE.0) FIXED(VASE)=-1
GOTO 9021
C SAY. ECHO WD2 (OR WD1 IF NO WD2 (SAY WHAT?, ETC.).) MAGIC WORDS OVERRIDE.
9030 CALL A5TOA1(WD2,WD2X,'". ',TEXT,K)
IF(WD2.EQ.0) CALL A5TOA1(WD1,WD1X,'". ',TEXT,K)
IF(WD2.NE.0) WD1=WD2
I=VOCAB(WD1,-1)
IF(I.EQ.62.OR.I.EQ.65.OR.I.EQ.71.OR.I.EQ.2025) GOTO 9035
WRITE(*,9032) (TEXT(I),I=1,K)
9032 FORMAT(/' OKAY, "',20A1)
GOTO 2012
9035 WD2=0
OBJ=0
GOTO 2630
C LOCK, UNLOCK, NO OBJECT GIVEN. ASSUME VARIOUS THINGS IF PRESENT.
8040 SPK=28
IF(HERE(CLAM)) OBJ=CLAM
IF(HERE(OYSTER)) OBJ=OYSTER
IF(AT(DOOR)) OBJ=DOOR
IF(AT(GRATE)) OBJ=GRATE
IF(OBJ.NE.0.AND.HERE(CHAIN)) GOTO 8000
IF(HERE(CHAIN)) OBJ=CHAIN
IF(OBJ.EQ.0) GOTO 2011
C LOCK, UNLOCK OBJECT. SPECIAL STUFF FOR OPENING CLAM/OYSTER AND FOR CHAIN.
9040 IF(OBJ.EQ.CLAM.OR.OBJ.EQ.OYSTER) GOTO 9046
IF(OBJ.EQ.DOOR) SPK=111
IF(OBJ.EQ.DOOR.AND.PROP(DOOR).EQ.1) SPK=54
IF(OBJ.EQ.CAGE) SPK=32
IF(OBJ.EQ.KEYS) SPK=55
IF(OBJ.EQ.GRATE.OR.OBJ.EQ.CHAIN) SPK=31
IF(SPK.NE.31.OR..NOT.HERE(KEYS)) GOTO 2011
IF(OBJ.EQ.CHAIN) GOTO 9048
IF(.NOT.CLOSNG) GOTO 9043
K=130
IF(.NOT.PANIC) CLOCK2=15
PANIC=.TRUE.
GOTO 2010
9043 K=34+PROP(GRATE)
PROP(GRATE)=1
IF(VERB.EQ.LOCK) PROP(GRATE)=0
K=K+2*PROP(GRATE)
GOTO 2010
C CLAM/OYSTER.
9046 K=0
IF(OBJ.EQ.OYSTER) K=1
SPK=124+K
IF(TOTING(OBJ)) SPK=120+K
IF(.NOT.TOTING(TRIDNT)) SPK=122+K
IF(VERB.EQ.LOCK) SPK=61
IF(SPK.NE.124) GOTO 2011
CALL DSTROY(CLAM)
CALL DROP(OYSTER,LOC)
CALL DROP(PEARL,105)
GOTO 2011
C CHAIN.
9048 IF(VERB.EQ.LOCK) GOTO 9049
SPK=171
IF(PROP(BEAR).EQ.0) SPK=41
IF(PROP(CHAIN).EQ.0) SPK=37
IF(SPK.NE.171) GOTO 2011
PROP(CHAIN)=0
FIXED(CHAIN)=0
IF(PROP(BEAR).NE.3) PROP(BEAR)=2
FIXED(BEAR)=2-PROP(BEAR)
GOTO 2011
9049 SPK=172
IF(PROP(CHAIN).NE.0) SPK=34
IF(LOC.NE.PLAC(CHAIN)) SPK=173
IF(SPK.NE.172) GOTO 2011
PROP(CHAIN)=2
IF(TOTING(CHAIN)) CALL DROP(CHAIN,LOC)
FIXED(CHAIN) =-1
GOTO 2011
C LIGHT LAMP
9070 IF(.NOT.HERE(LAMP)) GOTO 2011
SPK=184
IF(LIMIT.LT.0) GOTO 2011
PROP(LAMP)=1
CALL RSPEAK(39)
IF(WZDARK) GOTO 2000
GOTO 2012
C LAMP OFF
9080 IF(.NOT.HERE(LAMP)) GOTO 2011
PROP(LAMP)=0
CALL RSPEAK(40)
IF(DARK(0)) CALL RSPEAK(16)
GOTO 2012
C WAVE. NO EFFECT UNLESS WAVING ROD AT FISSURE.
9090 IF((.NOT.TOTING(OBJ)).AND.(OBJ.NE.ROD.OR..NOT.TOTING(ROD2)))
1 SPK=29
IF(OBJ.NE.ROD.OR..NOT.AT(FISSUR).OR..NOT.TOTING(OBJ)
1 .OR.CLOSNG) GOTO 2011
PROP(FISSUR)=1-PROP(FISSUR)
CALL PSPEAK(FISSUR,2-PROP(FISSUR))
GOTO 2012
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.
9120 DO 9121 I=1,5
IF(DLOC(I).EQ.LOC.AND.DFLAG.GE.2) GOTO 9122
9121 CONTINUE
I=0
9122 IF(OBJ.NE.0) GOTO 9124
IF(I.NE.0) OBJ=DWARF
IF(HERE(SNAKE)) OBJ=OBJ*100+SNAKE
IF(AT(DRAGON).AND.PROP(DRAGON).EQ.0) OBJ=OBJ*100+DRAGON
IF(AT(TROLL)) OBJ=OBJ*100+TROLL
IF(HERE(BEAR).AND.PROP(BEAR).EQ.0) OBJ=OBJ*100+BEAR
IF(OBJ.GT.100) GOTO 8000
IF(OBJ.NE.0) GOTO 9124
C CAN'T ATTACK BIRD BY THROWING AXE.
IF(HERE(BIRD).AND.VERB.NE.THROW) OBJ=BIRD
C CLAM AND OYSTER BOTH TREATED AS CLAM FOR INTRANSITIVE CASE; NO HARM DONE.
IF(HERE(CLAM).OR.HERE(OYSTER)) OBJ=100*OBJ+CLAM
IF(OBJ.GT.100) GOTO 8000
9124 IF(OBJ.NE.BIRD) GOTO 9125
SPK=137
IF(CLOSED) GOTO 2011
CALL DSTROY(BIRD)
PROP(BIRD)=0
IF(PLACE(SNAKE).EQ.PLAC(SNAKE)) TALLY2=TALLY2+1
SPK=45
9125 IF(OBJ.EQ.0) SPK=44
IF(OBJ.EQ.CLAM.OR.OBJ.EQ.OYSTER) SPK=150
IF(OBJ.EQ.SNAKE) SPK=46
IF(OBJ.EQ.DWARF) SPK=49
IF(OBJ.EQ.DWARF.AND.CLOSED) GOTO 19000
IF(OBJ.EQ.DRAGON) SPK=167
IF(OBJ.EQ.TROLL) SPK=157
IF(OBJ.EQ.BEAR) SPK=165+(PROP(BEAR)+1)/2
IF(OBJ.NE.DRAGON.OR.PROP(DRAGON).NE.0) GOTO 2011
C FUN STUFF FOR DRAGON. IF HE INSISTS IN 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.
CALL RSPEAK(49)
VERB=0
OBJ=0
CALL GETIN(WD1,WD1X,WD2,WD2X)
IF(WD1.NE.'Y'.AND.WD1.NE.'YES') GOTO 2608
CALL PSPEAK(DRAGON,1)
PROP(DRAGON)=2
PROP(RUG)=0
K=(PLAC(DRAGON)+FIXD(DRAGON))/2
CALL MOVE(DRAGON+100,-1)
CALL MOVE(RUG+100,0)
CALL MOVE(DRAGON,K)
CALL MOVE(RUG,K)
DO 9126 OBJ=1,100
IF(PLACE(OBJ).EQ.PLAC(DRAGON).OR.PLACE(OBJ).EQ.FIXD(DRAGON))
1 CALL MOVE(OBJ,K)
9126 CONTINUE
LOC=K
K=NULL
GOTO 8
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.
9130 IF(OBJ.EQ.BOTTLE.OR.OBJ.EQ.0) OBJ=LIQ(0)
IF(OBJ.EQ.0) GOTO 8000
IF(.NOT.TOTING(OBJ)) GOTO 2011
SPK=78
IF(OBJ.NE.OIL.AND.OBJ.NE.WATER) GOTO 2011
PROP(BOTTLE)=1
PLACE(OBJ)=0
SPK=77
IF(.NOT.(AT(PLANT).OR.AT(DOOR))) GOTO 2011
IF(AT(DOOR)) GOTO 9132
SPK=112
IF(OBJ.NE.WATER) GOTO 2011
CALL PSPEAK(PLANT,PROP(PLANT)+1)
PROP(PLANT)=MOD(PROP(PLANT)+2,6)
PROP(PLANT2)=PROP(PLANT)/2
K=NULL
GOTO 8
9132 PROP(DOOR)=0
IF(OBJ.EQ.OIL) PROP(DOOR)=1
SPK=113+PROP(DOOR)
GOTO 2011
C EAT. INTRANSITIVE: ASSUME FOOD IF PRESENT, ELSE ASK WHAT. TRANSITIVE: FOOD
C OK, SOME THINGS LOSE APPETITE, REST ARE RIDICULOUS.
8140 IF(.NOT.HERE(FOOD)) GOTO 8000
8142 CALL DSTROY(FOOD)
SPK=72
GOTO 2011
9140 IF(OBJ.EQ.FOOD) GOTO 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
GOTO 2011
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 WATER LOC, SO DRINK STREAM.
9150 IF(OBJ.EQ.0.AND.LIQLOC(LOC).NE.WATER.AND.(LIQ(0).NE.WATER
1 .OR..NOT.HERE(BOTTLE))) GOTO 8000
IF(OBJ.NE.0.AND.OBJ.NE.WATER) SPK=110
IF(SPK.EQ.110.OR.LIQ(0).NE.WATER.OR..NOT.HERE(BOTTLE)) GOTO 2011
PROP(BOTTLE)=1
PLACE(WATER)=0
SPK=74
GOTO 2011
C RUB. YIELDS VARIOUS SNIDE REMARKS.
9160 IF(OBJ.NE.LAMP) SPK=76
GOTO 2011
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.
9170 IF(TOTING(ROD2).AND.OBJ.EQ.ROD.AND..NOT.TOTING(ROD)) OBJ=ROD2
IF(.NOT.TOTING(OBJ)) GOTO 2011
IF(OBJ.GE.50.AND.OBJ.LE.MAXTRS.AND.AT(TROLL)) GOTO 9178
IF(OBJ.EQ.FOOD.AND.HERE(BEAR)) GOTO 9177
IF(OBJ.NE.AXE) GOTO 9020
DO 9171 I=1,5
C NEEDN'T CHECK DFLAG IF AXE IS HERE.
IF(DLOC(I).EQ.LOC) GOTO 9172
9171 CONTINUE
SPK=152
IF(AT(DRAGON).AND.PROP(DRAGON).EQ.0) GOTO 9175
SPK=158
IF(AT(TROLL)) GOTO 9175
IF(HERE(BEAR).AND.PROP(BEAR).EQ.0) GOTO 9176
OBJ=0
GOTO 9120
9172 SPK=48
C IF SAVED NOT = -1, HE BYPASSED THE "START" CALL.
IF(RAN(3).EQ.0.OR.SAVED.NE.-1) GOTO 9175
DSEEN(I)=.FALSE.
DLOC(I)=0
SPK=47
DKILL=DKILL+1
IF(DKILL.EQ.1) SPK=149
9175 CALL RSPEAK(SPK)
CALL DROP(AXE,LOC)
K=NULL
GOTO 8
C THIS'LL TEACH HIM TO THROW THE AXE AT THE BEAR!
9176 SPK=164
CALL DROP(AXE,LOC)
FIXED(AXE)=-1
PROP(AXE)=1
CALL JUGGLE(BEAR)
GOTO 2011
C BUT THROWING FOOD IS ANOTHER STORY.
9177 OBJ=BEAR
GOTO 9210
9178 SPK=159
C SNARF A TREASURE FOR THE TROLL.
CALL DROP(OBJ,0)
CALL MOVE(TROLL,0)
CALL MOVE(TROLL+100,0)
CALL DROP(TROLL2,PLAC(TROLL))
CALL DROP(TROLL2+100,FIXD(TROLL))
CALL JUGGLE(CHASM)
GOTO 2011
C QUIT. INTRANSITIVE ONLY. VERIFY INTENT AND EXIT IF THAT'S WHAT HE WANTS.
8180 GAVEUP=YES(22,54,54)
8185 IF(GAVEUP) GOTO 20000
GOTO 2012
C FIND. MIGHT BE CARRYING IT, OR IT MIGHT BE HERE. ELSE GIVE CAVEAT.
9190 IF(AT(OBJ).OR.(LIQ(0).EQ.OBJ.AND.AT(BOTTLE))
1 .OR.K.EQ.LIQLOC(LOC)) SPK=94
DO 9192 I=1,5
9192 IF(DLOC(I).EQ.LOC.AND.DFLAG.GE.2.AND.OBJ.EQ.DWARF) SPK=94
IF(CLOSED) SPK=138
IF(TOTING(BIRD)) SPK=24
GOTO 2011
C INVENTORY. IF OBJECT, TREAT SAME AS FIND. ELSE REPORT ON CURRENT BURDEN.
8200 SPK=98
DO 8201 I=1,100
IF(I.EQ.BEAR.OR..NOT.TOTING(I)) GOTO 8201
IF(SPK.EQ.98) CALL RSPEAK(99)
BLKLIN=.FALSE.
CALL PSPEAK(I,-1)
BLKLIN=.TRUE.
SPK=0
8201 CONTINUE
IF(TOTING(BEAR)) SPK=141
GOTO 2011
C FEED. IF BIRD, NO SEED. SNAKE, DRAGON, TROLL: QUIP. IF DWARF, MAKE HIM
C MAD. BEAR, SPECIAL.
9210 IF(OBJ.NE.BIRD) GOTO 9212
SPK=100
GOTO 2011
9212 IF(OBJ.NE.SNAKE.AND.OBJ.NE.DRAGON.AND.OBJ.NE.TROLL) GOTO 9213
SPK=102
IF(OBJ.EQ.DRAGON.AND.PROP(DRAGON).NE.0) SPK=110
IF(OBJ.EQ.TROLL) SPK=182
IF(OBJ.NE.SNAKE.OR.CLOSED.OR..NOT.HERE(BIRD)) GOTO 2011
SPK=101
CALL DSTROY(BIRD)
PROP(BIRD)=0
TALLY2=TALLY2+1
GOTO 2011
9213 IF(OBJ.NE.DWARF) GOTO 9214
IF(.NOT.HERE(FOOD)) GOTO 2011
SPK=103
DFLAG=DFLAG+1
GOTO 2011
9214 IF(OBJ.NE.BEAR) GOTO 9215
IF(PROP(BEAR).EQ.0) SPK=102
IF(PROP(BEAR).EQ.3) SPK=110
IF(.NOT.HERE(FOOD)) GOTO 2011
CALL DSTROY(FOOD)
PROP(BEAR)=1
FIXED(AXE)=0
PROP(AXE)=0
SPK=168
GOTO 2011
9215 SPK=14
GOTO 2011
C FILL. BOTTLE MUST BE EMPTY, AND SOME LIQUID AVAILABLE. (VASE IS NASTY.)
9220 IF(OBJ.EQ.VASE) GOTO 9222
IF(OBJ.NE.0.AND.OBJ.NE.BOTTLE) GOTO 2011
IF(OBJ.EQ.0.AND..NOT.HERE(BOTTLE)) GOTO 8000
SPK=107
IF(LIQLOC(LOC).EQ.0) SPK=106
IF(LIQ(0).NE.0) SPK=105
IF(SPK.NE.107) GOTO 2011
PROP(BOTTLE)=MOD(COND(LOC),4)/2*2
K=LIQ(0)
IF(TOTING(BOTTLE)) PLACE(K)=-1
IF(K.EQ.OIL) SPK=108
GOTO 2011
9222 SPK=29
IF(LIQLOC(LOC).EQ.0) SPK=144
IF(LIQLOC(LOC).EQ.0.OR..NOT.TOTING(VASE)) GOTO 2011
CALL RSPEAK(145)
PROP(VASE)=2
FIXED(VASE)=-1
GOTO 9024
C BLAST. NO EFFECT UNLESS YOU'VE GOT DYNAMITE, WHICH IS A NEAT TRICK!
9230 IF(PROP(ROD2).LT.0.OR..NOT.CLOSED) GOTO 2011
BONUS=133
IF(LOC.EQ.115) BONUS=134
IF(HERE(ROD2)) BONUS=135
CALL RSPEAK(BONUS)
GOTO 20000
C SCORE. GO TO SCORING SECTION, WHICH WILL RETURN TO 8241 IF SCORNG IS TRUE.
8240 SCORNG=.TRUE.
GOTO 20000
8241 SCORNG=.FALSE.
WRITE(*,8243) SCORE, MXSCOR
8243 FORMAT(/' IF YOU WERE TO QUIT NOW, YOU WOULD SCORE',I4,
1 ' OUT OF A POSSIBLE',I4,'.')
GAVEUP=YES(143,54,54)
GOTO 8185
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).
8250 K=VOCAB(WD1,3)
SPK=42
IF(FOOBAR.EQ.1-K) GOTO 8252
IF(FOOBAR.NE.0) SPK=151
GOTO 2011
8252 FOOBAR=K
IF(K.NE.4) GOTO 2009
FOOBAR=0
IF(PLACE(EGGS).EQ.PLAC(EGGS)
1 .OR.(TOTING(EGGS).AND.LOC.EQ.PLAC(EGGS))) GOTO 2011
C BRING BACK TROLL IF WE STEAL THE EGGS BACK FROM HIM BEFORE CROSSING.
IF(PLACE(EGGS).EQ.0.AND.PLACE(TROLL).EQ.0.AND.PROP(TROLL).EQ.0)
1 PROP(TROLL)=1
K=2
IF(HERE(EGGS)) K=1
IF(LOC.EQ.PLAC(EGGS)) K=0
CALL MOVE(EGGS,PLAC(EGGS))
CALL PSPEAK(EGGS,K)
GOTO 2012
C BRIEF. INTRANSITIVE ONLY. SUPPRESS LONG DESCRIPTIONS AFTER FIRST TIME.
8260 SPK=156
ABBNUM=10000
DETAIL=3
GOTO 2011
C READ. MAGAZINES IN DWARVISH, MESSAGE WE'VE SEEN, AND ... OYSTER?
8270 IF(HERE(MAGZIN)) OBJ=MAGZIN
IF(HERE(TABLET)) OBJ=OBJ*100+TABLET
IF(HERE(MESSAG)) OBJ=OBJ*100+MESSAG
IF(CLOSED.AND.TOTING(OYSTER)) OBJ=OYSTER
IF(OBJ.GT.100.OR.OBJ.EQ.0.OR.DARK(0)) GOTO 8000
9270 IF(DARK(0)) GOTO 5190
IF(OBJ.EQ.MAGZIN) SPK=190
IF(OBJ.EQ.TABLET) SPK=196
IF(OBJ.EQ.MESSAG) SPK=191
IF(OBJ.EQ.OYSTER.AND.HINTED(2).AND.TOTING(OYSTER)) SPK=194
IF(OBJ.NE.OYSTER.OR.HINTED(2).OR..NOT.TOTING(OYSTER)
1 .OR..NOT.CLOSED) GOTO 2011
HINTED(2)=YES(192,193,54)
GOTO 2012
C BREAK. ONLY WORKS FOR MIRROR IN REPOSITORY AND, OF COURSE, THE VASE.
9280 IF(OBJ.EQ.MIRROR) SPK=148
IF(OBJ.EQ.VASE.AND.PROP(VASE).EQ.0) GOTO 9282
IF(OBJ.NE.MIRROR.OR..NOT.CLOSED) GOTO 2011
CALL RSPEAK(197)
GOTO 19000
9282 SPK=198
IF(TOTING(VASE)) CALL DROP(VASE,LOC)
PROP(VASE)=2
FIXED(VASE)=-1
GOTO 2011
C WAKE. ONLY USE IS TO DISTURB THE DWARVES.
9290 IF(OBJ.NE.DWARF.OR..NOT.CLOSED) GOTO 2011
CALL RSPEAK(199)
GOTO 19000
C SUSPEND. OFFER TO EXIT LEAVING THINGS RESTARTABLE BUT REQUIRING A DELAY
C BEFORE RESTARTING (SO CAN'T SAVE THE WORLD BEFORE TRYING SOMETHING RISKY).
C UPON RESTARTING, SETUP=-1 CAUSES RETURN TO 8305 TO PICK UP AGAIN.
8300 SPK=201
IF(DEMO) GOTO 2011
WRITE(*,8302) LATNCY
8302 FORMAT(/' I CAN SUSPEND YOUR ADVENTURE FOR YOU SO THAT YOU CAN',
1 ' RESUME LATER, BUT'/' YOU WILL HAVE TO WAIT AT LEAST',
2 I3,' MINUTES BEFORE CONTINUING')
IF(.NOT.YES(200,54,54)) GOTO 2012
K=NULL
GOTO 8
C CALL DATIME(SAVED,SAVET)
C SETUP=-1
C CALL CIAO
C8305 YEA=START(0)
C SETUP=3
C K=NULL
C GOTO 8
C HOURS. REPORT CURRENT NON-PRIME-TIME HOURS.
8310 CALL MSPEAK(6)
CALL HOURS
GOTO 2012
C CAVE CLOSING AND SCORING
C SET PROCESSING PARAMETER TO APPROPRIATE VALUE AND CALL CLOSEX.
10000 CONTINUE
IRET=1
GOTO 24000
C
11000 CONTINUE
IRET=2
GOTO 24000
C
12000 CONTINUE
IRET=3
GOTO 24000
C
12200 CONTINUE
IRET=4
GOTO 24000
C
12400 CONTINUE
IRET=5
GOTO 24000
C
12600 CONTINUE
IRET=6
GOTO 24000
C
13000 CONTINUE
IRET=7
GOTO 24000
C
19000 CONTINUE
IRET=8
GOTO 24000
C
20000 CONTINUE
IRET=9
C
C CALL THE CLOSE ROUTINE (CLOSEX)
24000 CONTINUE
CALL CLOSEX(IRET)
C
C PERFORM REQUIRED PROCESSING ACCORDING TO RETURNED VALUE OF IRET.
GO TO(19999,2,8241,25000),IRET
C
2 CONTINUE
IRET=1
RETURN
C
C THE ADVENTURE HAS BEEN COMPLETED - RETURN TO THE CALLING ROUTINE.
25000 CONTINUE
IRET=2
RETURN
C
C MAINTENANCE MODE. SET RETURN FLAG AND GET OUT
26000 CONTINUE
IRET=3
RETURN
END