Path: uunet!zephyr.ens.tek.com!tekred!saab!billr
From: billr@saab.CNA.TEK.COM (Bill Randle)
Newsgroups: comp.sources.games
Subject: v09i094: adven - original adventure game in FORTRAN, Part06/08
Message-ID: <5633@tekred.CNA.TEK.COM>
Date: 18 May 90 18:21:40 GMT
Sender: news@tekred.CNA.TEK.COM
Lines: 1795
Approved: billr@saab.CNA.TEK.COM
Submitted-by: Chris Rende <cfctech!rphroy!trux!car@uunet.uu.net>
Posting-number: Volume 9, Issue 94
Archive-name: adven/Part06
#! /bin/sh
# This is a shell archive. Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file". To overwrite existing
# files, type "sh file -c". You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g.. If this archive is complete, you
# will see the following message at the end:
# "End of archive 6 (of 8)."
# Contents: ciao.f getwds.f gripe.f main.f.3 maint.f
# Wrapped by billr@saab on Thu May 17 14:47:29 1990
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'ciao.f' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'ciao.f'\"
else
echo shar: Extracting \"'ciao.f'\" \(510 characters\)
sed "s/^X//" >'ciao.f' <<'END_OF_FILE'
X SUBROUTINE CIAO
XC EXITS, AFTER ISSUING REMINDER TO SAVE NEW CORE IMAGE. USED WHEN SUSPENDING
XC AND WHEN CREATING NEW VERSION VIA MAGIC MODE. ON SOME SYSTEMS, THE CORE
XC IMAGE IS LOST ONCE THE PROGRAM EXITS. IF SO, SET K=31 INSTEAD OF 32.
X IMPLICIT INTEGER(A-Z)
X DIMENSION VEC(9)
X DATA K/32/,VEC/:74,:70000,:1000,6*0/
X CALL MSPEAK(K)
X CALL SAVE$$(VEC,'ADVE',4,CODE)
X IF(K.EQ.31)CALL GETIN(A,B,C,D)
X CALL BREAK$(.FALSE.)
X CALL EXIT
X END
END_OF_FILE
if test 510 -ne `wc -c <'ciao.f'`; then
echo shar: \"'ciao.f'\" unpacked with wrong size!
fi
# end of 'ciao.f'
fi
if test -f 'getwds.f' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'getwds.f'\"
else
echo shar: Extracting \"'getwds.f'\" \(16082 characters\)
sed "s/^X//" >'getwds.f' <<'END_OF_FILE'
XC*** GETWDS
X SUBROUTINE GETWDS
X
XC WHEN CALLED, CHECKS IF PREVIOUS WORDS VECTOR HAS BEEN EXHAUSTED.
XC IF NOT, BRANCH AROUND THE CODE WHICH READS IN A NEW LINE. IF VECTOR IS EMPTY
XC SUCK UP A LINE FROM THE TTY, THEN CHECK EACH WORD FOR INTELLIGIBILITY.
XC IF THE WORD IS VALID, ITS NUMBER GETS STUCK INTO THE WORDS VECTOR.
XC THEN EACH WORD IS PARSED BY THE APPROPRIATE CODE. THE LABELS BELOW ARE
XC 100 TIMES THE WORD CLASS.
XC
XC THE FOLLOWING VECTORS ARE USED:
XC TXT(WDX,2) HOLD THE RAW TEXT FROM GETLIN
XC WORDS(WDX) LIST OF WORD NUMBERS, CONVERTED FROM TXT(WDX,1).
XC VTXT(VRBX,2) HOLD THE TEXT FOR VERB VRBX.
XC VERBS(VRBX) IS THE LIST OF VALIDATED VERB NUMBERS.
XC OTXT(OBJX,2) HOLDS THE TEXT OF THE OBJECT OBJX.
XC OBJX(OBJX) IS THE LIST OF VALIDATED OBJECT NUMBERS.
XC IOTXT(IOBX,2) HOLDS THE TEXT FOR PREP'S IOBJ.
X
X IMPLICIT INTEGER(A-Z)
X LOGICAL BLIND,LIVING,PCT,PFLAG,HINGED,AT,ATHAND,TOTING,K1,ISWIZ
X REAL*8 WORD1,WORD2,DKK,DK
X LOGICAL WIZARD
X
X COMMON/IZWIZ/ISWIZ
X COMMON /ADJCOM/ ADJKEY(50),ADJTAB(150),ADJSIZ
X DOUBLE PRECISION NTXT
X COMMON /ALLCOM/ NTXT(150,2)
X COMMON /DIECOM/ NUMDIE,MAXDIE,TURNS
X COMMON /DWFCOM/ DWARF,KNIFE,KNFLOC,DFLAG,DSEEN(6),DLOC(6),
X 1 ODLOC(6),DWFMAX
X COMMON /LIQCOM/ BOTTLE,CASK,WATER,OIL,WINE,LIQTYP(5)
X COMMON /LOCCOM/ LOC,OLDLOC,OLDLC2,NEWLOC,MAXLOC
X COMMON /MNECOM/ BACK,CAVE,DPRSSN,ENTRNC,EXIT,GO,LOOK,NULL,
X 1 AXE,BEAR,BOAT,BOOK,BOOK2,BOOTH,CARVNG,CHASM,CHASM2,DOOR,GNOME,
X 2 GRATE,LAMP,PDOOR,PLANT,PLANT2,ROCKS,ROD,ROD2,SAFE,
X 3 TDOOR,TDOOR2,TROLL,TROLL2,EMRALD,SPICES,
X 4 FIND,YELL,INVENT,LEAVE,POUR,SAY,TAKE,THROW,
X 5 KILLED,IWEST,PHUCE(2,4),TK(20)
X COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150),
X 1 FIXED(150),MAXOBJ
X INTEGER*4 PTAB
X COMMON /PRPCOM/ VKEY(60),PTAB(300),VKYSIZ,PTBSIZ
X REAL*8 TXT
X COMMON /UTXCOM/ TXT(35,2),WDX
X REAL*8 VTXT,OTXT,IOTXT
X COMMON /WRDCOM/ VERBS(45),VTXT(45,2),VRBX,OBJS(45),OTXT(45,2),
X 1 OBJX,IOBJS(15),IOTXT(15,2),IOBX,PREP,WORDS(45)
X DIMENSION TAKDIR(20)
X
XC MOTION NOUN ACTION MISC PREP ADJ CONJ
X DATA CLASSD,CLASSN,CLASSA,CLASSM,CLASSP,CLASSJ,CLASSC
X 1 /1,2,3,4,5,6,7/
XC
XC A FEW MORE ACTION VERBS NOT IN COMMON.
X DATA DROP,FEED,NOTHNG,LIGHT,DRINK,SCORE /02,21,05,07,15,24/
X DATA POUR,PICK,PUT,GET /13,41,42,44/
XC
XC AND A MOTION VERB:
X DATA ENTER /3/
XC
XC AND TO GET/DROP EVERYTHING IN SIGHT:
X DATA ALL /109/
XC
XC TAKDIR IS A LIST OF MOTION VERBS WHICH ARE ACCEPTABLE AFTER 'TAKE'.
X DATA TAKDIR/2,6,9,10,11,13,14,17,23,25,33,34,
X 1 36,37,39,78,79,80,89,-1/
XC
XC IF WORDS(WDX+1) HAS SOMETHING IN IT, WE ARE STILL PROCESSING OLD INPUT LINE.
XC IF WORDS(1) = -2, SOMEONE ELSE HAS CALLED GETLIN (E.G., KILL DRAGON).
X
X IF(WORDS(WDX+1).GT.0)GOTO 30
X
XC IF WORDS(1) HAS BEEN SET TO -2, SOMEONE ELSE HAS ALREADY READ IN
XC THE NEW LINE, PRESUMABLY TO CHECK FOR SOME NON-STANDARD WORD.
XC (THIS HAPPENS WHEN KILLING DRAGON WITH BARE HANDS.)
X20 IF(WORDS(1).NE.-2)CALL GETLIN
X WDX=0
X DO 25 I=1,35
X WORDS(I)=0
X IF(TXT(I,1).NE.' ')WORDS(I)=VOCABX(TXT(I,1),-1)
X25 CONTINUE
X
XC THE FIRST WORD OF EACH CLAUSE GETS SPECIAL CHECKING, MOSTLY LOOKING
XC FOR IDIOMS.
X
XC SPECIAL HANDLING FOR 'SAY' AND 'CALL'. WIN IF SAYING/CALLING
XC MAGIC WORDS. NARKY IF UTTERING ANYTHING ELSE. IF NO OBJ, PASS
XC ON FOR HIGHER LEVEL PARSING.
X30 PFLAG=.FALSE.
X WDX=WDX+1
X WORD=WORDS(WDX)
X IF(WORD)830,800,32
X
X32 KK=CLASS(WORD)
X IF(KK.EQ.-1)GOTO 91
X IF(KK.EQ.CLASSA.OR.KK.EQ.CLASSD.OR.KK.EQ.CLASSM)CALL CLRLIN
X K=VAL(WORD)
X IF(KK.NE.CLASSA.OR.(K.NE.SAY.AND.K.NE.YELL))GOTO 40
X
XC 'SAY' OR 'CALL'. IF NO NEXT WORD, PASS ON TO HIGHER POWERS.
XC IF OBJECT IS MAGIC WORD ('SAY XYZZY'), FLUSH 'SAY' & TAKE NEXT WORD.
X IF(WORDS(WDX+1).EQ.0.OR.CLASS(WORDS(WDX+1)).EQ.CLASSC)GOTO 99
X WDX=WDX+1
X IF(K.EQ.SAY)CALL A5TOA1(TXT(WDX,1),TXT(WDX,2),'".',TK,K)
X IF(K.EQ.YELL)CALL A5TOA1(TXT(WDX,1),TXT(WDX,2),'"!!!!!',TK,K)
X WORD=WORDS(WDX)
X IF(WORD.EQ.62.OR.WORD.EQ.65.OR.WORD.EQ.71.OR.WORD.EQ.82
X 1 .OR.WORD.EQ.2025)GOTO 99
X PRINT 37,(TK(I),I=1,K)
X37 FORMAT(/' Okay, "',20A1)
X GOTO 860
X
XC SPECIAL STUFF FOR 'ENTER'. CAN'T GO INTO WATER.
XC 'ENTER BOAT' MEANS 'TAKE BOAT'.
X40 WORD1=TXT(WDX,1)
X WORD2=TXT(WDX+1,1)
X IF(WORD1.NE.'ENTER ')GOTO 50
X IF(WORD2.EQ.' ')GOTO 91
X SPK=43
X IF(LIQLOC(LOC).EQ.WATER)SPK=70
X IF(WORD2.EQ.'STREAM '.OR.WORD2.EQ.'WATER '.OR.WORD2.EQ.
X 1 'RESERV '.OR.WORD2.EQ.'OCEAN '.OR.WORD2.EQ.'SEA '
X 2 .OR.WORD2.EQ.'POOL ')GOTO 810
X IF(WORD2.NE.'BOAT '.AND.WORD2.NE.'ROWBOA ')GOTO 99
X WORD=TAKE+2000
X GOTO 99
X
XC 'LEAVE' IS A MOTION VERB, UNLESS LEAVING AN OBJECT,
XC E.G., 'LEAVE BOAT' OR 'LEAVE BOTTLE'. BUT MAKE SURE TO LEAVE ('DROP')
XC ONLY TOTABLE OBJECTS.
X50 KK=WORDS(WDX+1)
X IF(WORD1.NE.'LEAVE '.OR.CLASS(KK).NE.CLASSN)
X 1 GOTO 55
X IF(HINGED(VAL(KK)).OR.FIXED(VAL(KK)).NE.0)GOTO 99
X WORD=LEAVE+2000
X GOTO 99
X
XC IF 'LIGHT LAMP', LIGHT MUST BE TAKEN AS AN ACTION VERB, NOT A NOUN.
X55 IF(WORD1.NE.'LIGHT'.OR.WORDS(WDX+1).NE.(LAMP+1000))GOTO 60
X WORD=LIGHT+2000
X GOTO 99
X
XC 'WATER PLANT' BECOMES 'POUR WATER', IF WE ARE AT PLANT.
XC 'OIL DOOR' BECOMES 'POUR OIL', ETC., ETC.
X60 IF((WORD1.NE.'WATER '.AND.WORD1.NE.'OIL ')
X 1 .OR.(WORD2.NE.'PLANT '.AND.WORD2.NE.'DOOR '
X 2 .AND.WORD2.NE.'SWORD '.AND.WORD2.NE.'ANVIL '))GOTO 65
X IF(.NOT.AT(VOCABX(WORD2,CLASSN)))GOTO 61
X WORDS(WDX+1)=WORDS(WDX)
X TXT(WDX+1,1)=WORD1
X TXT(WDX+1,2)=TXT(WDX,2)
X61 WORD=POUR+2000
X GOTO 99
X
XC CHECK FILLING OR EMPTYING A CONTAINER.
X65 IF((WORD1.NE.'EMPTY ').OR.
X 1 (CLASS(WORDS(WDX+1)).NE.CLASSN))GOTO 91
X KK=VAL(WORDS(WDX+1))
X IF(KK.NE.SACK.AND.KK.NE.SAFE.AND.KK.NE.BOAT.AND.KK.NE.CHEST)
X 1 GOTO 91
X GOTO 91
XC *** UNFINISHED CODE HERE ***
X
X
XC THIS IS THE 'INNER' LOOP. DISPATCHING OF ALL WORDS IN A CLAUSE AFTER
XC THE FIRST COMES THRU HERE.
X
X90 WDX=WDX+1
X WORD=WORDS(WDX)
X91 IF(WORD)830,900,92
X
X96 WCLASS=WCLASS+1
X WORD=VOCABX(TXT(WDX,1),-(WCLASS+1))
X IF(WORD.EQ.-1)GOTO 800
X WORDS(WDX)=WORD
X92 IF(CLASS(WORD).NE.CLASSN)GOTO 99
X
XC IT'S NOT THE FIRST: MAKE SURE HE INCLUDED A COMMA OR 'AND'.
XC DIFFERENTIATE BETWEEN DIR & INDIR OBJECTS.
XC CHECK FOR SPECIAL CASE OF MULTIPLE OBJECTS: 'FEED BEAR HONEY' OR
XC 'THROW TROLL NUGGET'.
X K=OBJX
X IF(PFLAG)K=IOBX
X IF(K.EQ.0.OR.CLASS(WORDS(WDX-1)).EQ.CLASSC)GOTO 99
X KK=VAL(VERBS(VRBX))
X IF(.NOT.LIVING(OBJS(OBJX)).OR.(KK.NE.THROW.AND.KK.NE.FEED))
X 1 GOTO 800
X IOBX=IOBX+1
X IOBJS(IOBX)=OBJS(OBJX)
X OBJS(OBJX)=0
X OBJX=OBJX-1
X
X99 WCLASS=CLASS(WORD)
X GOTO(100,200,300,400,500,600,700),WCLASS
XC MWD OBJ AVB MVB PRP ADJ CNJ
X CALL BUG(33)
XC MOTION VERB.
XC A MOTION VERB IS EITHER A DIRECTION ('WEST') OR A MOTION ('JUMP').
XC MULTIPLE MOTIONS MUST BE SEPARATED BY COMMAS OR AND'S. THERE ARE
XC SOME IDIOMATIC USES WHICH MUST BE SCANNED FOR, SUCH AS 'TAKE BRIDGE',
XC WHICH BECOMES 'BRIDGE' AND 'GO WEST', WHICH BECOMES 'WEST', AND 'LEAVE THING'
XC IS DIFFERENT FROM JUST 'LEAVE'.
XC
XC IF ORIGINAL VERB WAS 'GO', FLUSH IT & REPLACE WITH THIS ONE.
XC I.E., 'GO WEST' BECOMES 'WEST'.
XC
XC CHECK TAKDIR(20) LIST FOR VALID OBJECT MOTION VERBS FOR 'TAKE'.
XC IF FOUND, THROW AWAY 'TAKE' AND USE THE MOTION VERB.
XC
XC SINCE THE ORIGINAL VERB IS AN ACTION VERB, CHECK THIS WORD IN THE
XC NOUN TABLE. MAYBE IT IS AN OBJECT SYNONYMOUS WITH A VERB ('ROCKS').
XC
XC IF IT ISN'T A VALID MOTION-OBJECT OF 'TAKE' OR 'GO', NOR AN OBJECT,
XC CHECK THE PREP TABLE. IF FOUND, HAND IT TO THE PREPOSITION ANALYZER.
X
X100 IF(VRBX.EQ.0)GOTO 180
X K=VERBS(VRBX)
X IF(CLASS(K).GT.CLASSA)GOTO 800
X IF(CLASS(K).NE.CLASSA)GOTO 140
X IF(VAL(K).EQ.GO)GOTO 180
X
X IF(VAL(K).NE.TAKE)GOTO 96
X KK=VAL(WORD)
X DO 110 I=1,20
X IF(TAKDIR(I).EQ.KK)GOTO 180
X110 CONTINUE
X GOTO 96
X
XC IF ORIGINAL MOTION VERB WAS CRAWL, JUMP OR CLIMB, IGNORE CURRENT WORD.
XC I.E., 'CLIMB UP' OR 'JUMP OVER' BECOME 'CLIMB' & 'JUMP' ONLY.
X140 IF(K.EQ.17.OR.K.EQ.39.OR.K.EQ.56)GOTO 90
XC 'CRAWL' 'JUMP' 'CLIMB'
X
X180 VERBS(1)=WORD
X VRBX=1
X IF(TXT(WDX,1).NE.'WEST ')GOTO 90
X IWEST=IWEST+1
X IF(IWEST.EQ.10)CALL RSPEAK(17)
X K=VAL(WORD)
X IF(K.EQ.EXIT.OR.K.EQ.ENTER)GOTO 860
X GOTO 90
XC ANALYZE OBJECT.
XC IF PFLAG IS TRUE, THEN WE ARE PROCESSING A SET OF INDIRECT (PREP)
XC OBJECTS, NOT DIRECT OBJS.
X
X200 IF(PFLAG)GOTO 503
X IF(VRBX.NE.0)GOTO 220
X K=VOCABX(TXT(WDX,1),-(CLASSA+1))
X IF(K.EQ.-1)GOTO 220
X WORD=K
X GOTO 300
X
X220 WORD=VAL(WORD)
X IF(WORD.EQ.ALL)GOTO 280
X222 CALL GETOBJ(WORD)
X IF(WORD)230,860,240
X
XC IT WASN'T REALLY AN OBJECT. GO SEE WHAT IT WAS.
X230 WORD=-WORD
X GOTO 99
X
XC IT WAS REALLY AN OBJECT & IT IS HERE.
X240 OBJX=OBJX+1
X OBJS(OBJX)=WORD
X OTXT(OBJX,1)=TXT(WDX,1)
X OTXT(OBJX,2)=TXT(WDX,2)
X GOTO 90
X
XC TAKE EVERYTHING NOT BATTENED DOWN.
X
X280 KK=VAL(VERBS(VRBX))
X K1=.FALSE.
X IF(KK.EQ.DROP.OR.KK.EQ.PUT.OR.KK.EQ.LEAVE)GOTO 281
X K1=.TRUE.
X IF(KK.NE.TAKE.AND.KK.NE.PICK.AND.KK.NE.GET)GOTO 800
X SPK=357
X IF(BLIND(0))GOTO 810
X281 DO 289 I=1,MAXOBJ
X IF(.NOT.ATHAND(I).OR.FIXED(I).NE.0)GOTO 289
X IF(I.GE.WATER.AND.I.LE.WINE+1)GOTO 289
X IF((K1.AND.TOTING(I)) .OR. (.NOT.K1.AND..NOT.TOTING(I)) )GOTO 289
X OBJX=OBJX+1
X OBJS(OBJX)=I
X OTXT(OBJX,1)=NTXT(I,1)
X OTXT(OBJX,2)=NTXT(I,2)
X IF(OBJX.EQ.44)GOTO 90
X289 CONTINUE
X GOTO 90
XC ACTION VERB.
X300 IF(VRBX.EQ.0)GOTO 370
X IF(VAL(VERBS(VRBX)).NE.TAKE)GOTO 320
X K=VAL(WORD)
X IF(K.EQ.DRINK.OR.K.EQ.INVENT.OR.K.EQ.SCORE.OR.K.EQ.NOTHNG
X 1 .OR.K.EQ.LOOK)GOTO 371
X IF(K.NE.GO)GOTO 800
X DK=TXT(WDX,1)
X IF(DK.EQ.'WALK '.OR.DK.EQ.'RUN '.OR.DK.EQ.'HIKE ')
X 1 GOTO 371
X GOTO 800
X
X320 IF(OBJX.NE.0.OR.CLASS(WORDS(WDX-1)).NE.CLASSC)GOTO 800
X370 VRBX=VRBX+1
X371 VERBS(VRBX)=WORD
X VTXT(VRBX,1)=TXT(WDX,1)
X VTXT(VRBX,2)=TXT(WDX,2)
X GOTO 90
X
X
XC MISCELLANEOUS WORDS/VERBS.
X400 IF(VRBX.NE.0)GOTO 800
X VERBS(1)=WORD
X VRBX=1
X GOTO 90
XC ANALYZE A PREPOSITION AND ITS OBJECT. CHECK THAT PREP
XC IS VALID FOR THIS VERB, AND THEN CHECK THAT THE OBJECT IS VALID
XC FOR THIS PREPOSITION. IF FIRST CHECK FAILS, SYNTAX IS MESSED
XC UP; IF SECOND PART FAILS, IT MAY MERELY BE AN IMPOSSIBLE ACT.
X
X500 IF(CLASS(VERBS(VRBX)).NE.CLASSA.OR.IOBX.NE.0)GOTO 800
X IF(PFLAG)GOTO 503
X VRBKEY=VKEY(VAL(VERBS(VRBX)))
X IF(VRBKEY.EQ.0)GOTO 800
X PREP=VAL(WORD)
X PFLAG=.TRUE.
X WDX=WDX+1
X WORD=WORDS(WDX)
X IF(WORD.EQ.0)GOTO 510
X GOTO(800,503,800,800,800,600,510),CLASS(WORD)
X GOTO 840
X
X503 WORD=VAL(WORD)
X IF(WORD.EQ.ALL)GOTO 510
X504 CALL GETOBJ(WORD)
X IF(WORD)570,860,505
X
X505 IOBX=IOBX+1
X IOBJS(IOBX)=WORD
X IOTXT(IOBX,1)=TXT(WDX,1)
X IOTXT(IOBX,2)=TXT(WDX,2)
X510 KK=IABS(PTAB(VRBKEY)/1000)
X IF(KK.NE.PREP)GOTO 525
X
XC PREP IS VALID WITH THIS VERB. NOW CHECK OBJECT OF PREP.
X IF(WORD.EQ.0.OR.CLASS(WORD).EQ.CLASSC)GOTO 530
X
XC AN OBJ FOLLOWS THE PREP. SEE IF IT'S PLAUSIBLE.
X520 KK=IABS(INTS(MOD(PTAB(VRBKEY),0001000)))
X IF(KK.EQ.WORD.AND.KK.EQ.ALL)GOTO 280
X IF(KK.EQ.WORD.OR.KK.EQ.999)GOTO 90
X525 VRBKEY=VRBKEY+1
X IF(PTAB(VRBKEY-1).GE.0)GOTO 510
X GOTO 570
X
XC NO OBJ FOLLOWS PREP. CHECK SPECIAL CASES.
X530 PFLAG=.FALSE.
X WDX=WDX-1
X DK=TXT(WDX,1)
X DKK=VTXT(VRBX,1)
X IF((DK.NE.'ON '.AND.DK.NE.'OFF ').AND.
X 1 (DKK.NE.'TURN '.OR.OBJS(OBJX).NE.LAMP) .AND.
X 2 (DKK.NE.'TAKE '.AND.DKK.NE.'PUT ') )GOTO 570
X IF((DK.EQ.'UP '.AND.DKK.NE.'PICK ').OR.
X 1 (DK.EQ.'DOWN '.AND.(DKK.NE.'PUT '.AND.VERBS(VRBX).NE.THROW
X 2 )))GOTO 570
X WDX=WDX+1
X WORD=WORDS(WDX)
X IF(WORD.EQ.0)GOTO 900
X IF(CLASS(WORD).NE.CLASSC)GOTO 800
X GOTO 91
X
XC YOU CAN'T DO THAT!!
X570 SPK=NOWAY(0)
X GOTO 810
XC ADJECTIVE HANDLER.
XC SCARF THE NEXT WORD, MAKE SURE IT IS A VALID OBJECT FOR THIS ADJ.
XC THEN CALL GETOBJ TO SEE IF IT IS REALLY THERE, THEN LINK INTO OBJ
XC CODE.
X
X600 ADJ=VAL(WORD)
X WDX=WDX+1
X WORD=WORDS(WDX)
X IF(WORD)840,640,605
X
X605 IF(CLASS(WORD).EQ.CLASSC) GOTO 640
X IF(CLASS(WORD).NE.CLASSN) WORD=VOCABX(TXT(WDX,1),-(CLASSN+1))
X IF(WORD.EQ.-1.OR.CLASS(WORD).NE.CLASSN.OR.VAL(WORD).EQ.ALL)
X 1 GOTO 800
X WORDS(WDX)=WORD
X KK=VAL(WORD)
X K=ADJKEY(ADJ)
X610 IF(KK.EQ.IABS(ADJTAB(K)))GOTO 92
X IF(ADJTAB(K).LT.0)GOTO 800
X K=K+1
X GOTO 610
X
X640 CALL A5TOA1(TXT(WDX-1,1),TXT(WDX-1,2),'WHAT?',TK,K)
X PRINT 642,(TK(I),I=1,K)
X642 FORMAT(/1H , 20A1)
X GOTO 20
X
X
XC ANALYZE A CONJUNCTION. MAY BE A COMMA OR AN EXPLICIT "AND".
XC LOOK AHEAD AT NEXT WORD. IF IT IS AN ACTION VERB AND NO OBJECT
XC HAS YET BEEN SPECIFIED, PUT IT INTO THE VERB STACK. IF IT IS
XC AN OBJECT, ADD IT TO THE PILE.
XC ELSE, BUMP BACK THE WORD POINTER, ASSUME END OF CLAUSE, AND
XC RETURN.
X700 WDX=WDX+1
X WORD=WORDS(WDX)
X IF(WORD)840,800,710
X
X710 GOTO(790,92,720,790,800,92,800),CLASS(WORD)
X
XC A NEW ACTION VERB FOLLOWS. IF NO PREVIOUS VERB HAS BEEN TYPED,
XC HE LOSES. IF PREVIOUS VERB IS NOT AN ACTION VERB, HE LOSES.
XC IF AN OBJ/IOBJ WAS SPECIFIED FOR PREV ACT VERB, HE LOSES. ONLY
XC VALID SYNTAX IS: 'GET AND OPEN CAGE'.
X720 IF(VRBX.NE.0.AND.CLASS(VERBS(VRBX)).EQ.CLASSA
X 1 .AND.OBJX.EQ.0.AND.IOBX.EQ.0)GOTO 92
X790 WDX=WDX-1
X GOTO 900
XC GEE, I DON'T UNDERSTAND. FLUSH REST OF CURRENT CLAUSE, UP TO
XC EOL OR CONJUNCTION & CONTINUE.
X800 SPK=CONFUZ(0)
X810 CALL RSPEAK(SPK)
X820 CALL CLRLIN
X GOTO 20
X
XC AN IRREGULAR WORD WAS TYPED IN BY USER. CHECK FOR WIZARDRY.
X830 IF(TURNS.NE.0.OR.TXT(1,1).NE.'MAGIC'.OR.TXT(2,1).NE.'MODE')
X 1 GOTO 840
X TXT(1,1)=' '
X TXT(2,1)=' '
X CALL MAINT
XC (NO RETURN FROM MAINT)
X
X840 IF(TXT(1,1).NE.'WIZARD'.OR.TXT(2,1).NE.'MODE ')GOTO 841
X IF(.NOT.WIZARD(.FALSE.))GOTO 843
X ISWIZ=.TRUE.
X CALL BREAK$(.FALSE.)
X843 CALL CLRLIN
X GOTO 20
X841 IF(PCT(25))GOTO 850
X CALL A5TOA1(TXT(WDX,1),TXT(WDX,2),'.',TK,K)
X PRINT 842,(TK(I),I=1,K)
X842 FORMAT(/' I don''t understand the word ',20A1)
X CALL CLRLIN
X GOTO 20
X
X850 CALL A5TOA1(TXT(WDX,1),TXT(WDX,2),'?',TK,K)
X PRINT 852,(TK(I),I=1,K)
X852 FORMAT(/' Mumble? ',20A1)
X CALL CLRLIN
X GOTO 20
X
X
XC SCAN TO CONJ OR END OF LINE.
X860 CALL CLRLIN
X PFLAG=.FALSE.
X862 WDX=WDX+1
X IF(WORDS(WDX).EQ.0)GOTO 20
X IF(CLASS(WORDS(WDX)).EQ.CLASSC)GOTO 90
X GOTO 862
X
XC END OF CLAUSE. WE APPEAR TO HAVE REACHED THE END OF A SENTENCE.
XC IT WAS TERMINATED EITHER BY CRLF OR A CONJUNCTION. IF A CONJ,
XC THE CONJ ANALYZER CLAIMS THAT THE NEXT WORDS ARE NOT PART OF
XC THIS CLAUSE. DECIDE WHETHER OR NOT WE HAVE ENOUGH TO WORK WITH.
X900 PFLAG=.FALSE.
X IF(VERBS(1).NE.0)GOTO 930
X IF(OBJS(1).EQ.0)GOTO 800
X IF(OBJS(2).NE.0)GOTO 920
X CALL A5TOA1(OTXT(1,1),OTXT(1,2),'?',TK,K)
X PRINT 915,(TK(I),I=1,K)
X915 FORMAT(/' What do you want to do with the ',20A1)
X GOTO 20
X
X920 CALL A5TOA1('them',' ','?',TK,K)
X PRINT 926,(TK(I),I=1,K)
X926 FORMAT(/' What do you want to do with ',20A1)
X GOTO 20
X
X930 IF(OBJX.GT.1.AND.IOBX.GT.1)GOTO 800
X RETURN
X
X END
END_OF_FILE
if test 16082 -ne `wc -c <'getwds.f'`; then
echo shar: \"'getwds.f'\" unpacked with wrong size!
fi
# end of 'getwds.f'
fi
if test -f 'gripe.f' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'gripe.f'\"
else
echo shar: Extracting \"'gripe.f'\" \(1877 characters\)
sed "s/^X//" >'gripe.f' <<'END_OF_FILE'
XC*** GRIPE
X
X SUBROUTINE GRIPE(LOC,SCORE,CLOSNG,CLOSED)
X
XC ALLOW PLAYER TO WRITE ANY LENGTH MESSAGE TO A GRIPE FILE. ALSO INCLUDE
XC ENVIRONMENTAL INFO, IN CASE THIS IS A BUG REPORT.
X
X IMPLICIT INTEGER(A-Z)
X$INSERT SYSCOM>A$KEYS
X LOGICAL CLOSNG,CLOSED
X COMMON /DIECOM/ NUMDIE,MAXDIE,TURNS
X DIMENSION DDD(8),MSG(36),TTT(4),VEC(15),FILE(11),PART1(3),PART2(3)
X DOUBLEPRECISION CAVE,USER
X DATA FILE/'GRIPE GRIPE.ADV '/
X DATA PART1/:157763,:163763,:173777/,PART2/:166755,:177755,
X 1 :165676/
X
X ERCNT=0
X CALL DATE$A(DDD)
X CALL TIME$A(TTT)
X CALL TIMDAT(VEC,15)
X
X10 CALL CLOS$A(10)
X FILE(4)=AND(PART1(1),PART2(1))
X FILE(5)=AND(PART1(2),PART2(2))
X FILE(6)=AND(PART1(3),PART2(3))
X IF(.NOT.OPEN$A(A$WRIT,'ADVENTURE>GRIPE.ADV',19,10))GOTO 200
X CALL GEND$A(10)
X
X CAVE='open.'
X IF(CLOSNG)CAVE='closing.'
X IF(CLOSED)CAVE='closed.'
X
X WRITE (14,20)(VEC(I),I=13,15),DDD,TTT,TURNS,SCORE,NUMDIE,CAVE
X20 FORMAT(//' Player: ',3A2,4X,8A2,2X,4A2,
X 1/I4,' Turns;',I5,' Points;',I3,' Resurrections;',
X 2' Cave is ',A6)
X CALL GSPEAK(LOC)
X WRITE (14,32)
X32 FORMAT(' Text:')
X CALL MSPEAK(23)
X
X55 READ(1,56)(MSG(I),I=1,35),K
X56 FORMAT(36A2)
X IF(K.EQ.' ')GOTO 60
X CALL MSPEAK(24)
X GOTO 55
X
X60 DO 62 I=1,35
X K=36-I
X IF(MSG(K).NE.' ')GOTO 65
X62 CONTINUE
X GOTO 90
X
X65 WRITE (14,67)(MSG(I),I=1,K)
X67 FORMAT(36A2)
X GOTO 55
X
X90 CALL CLOS$A(10)
X DO 1001 I=4,6
X1001 FILE(I)=' '
X RETURN
X
X200 ERCNT=ERCNT+1
X IF(ERCNT.GT.3)GOTO 90
X PRINT 202,ERCNT
X202 FORMAT(/' CAN''T OPEN GRIPE FILE. WAIT...(',I1,')')
X CALL SLEEP$(00005000)
X GOTO 10
X
X300 PRINT 302
X302 FORMAT(/' BUG: CAN''T OPEN GRIPE FILE.')
X RETURN
X
X END
END_OF_FILE
if test 1877 -ne `wc -c <'gripe.f'`; then
echo shar: \"'gripe.f'\" unpacked with wrong size!
fi
# end of 'gripe.f'
fi
if test -f 'main.f.3' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'main.f.3'\"
else
echo shar: Extracting \"'main.f.3'\" \(31534 characters\)
sed "s/^X//" >'main.f.3' <<'END_OF_FILE'
X
XC FEED BEAR?
X22140 SPK=102
X IF(IOBJ.NE.BEAR)GOTO 22150
X IF(PROP(BEAR).EQ.3)SPK=NOWAY(0)
X IF(PROP(BEAR).EQ.1.OR.PROP(BEAR).EQ.2)SPK=264
X IF(OBJ.EQ.FOOD)SPK=278
X IF(OBJ.NE.HONEY)GOTO 2011
X PROP(BEAR)=1
X FIXED(AXE)=0
X PROP(AXE)=0
X SPK=168
X CALL DSTROY(HONEY)
X GOTO 2011
X
XC FEED DOG?
X22150 IF(IOBJ.NE.DOG)GOTO 22160
X IF(PROP(DOG).EQ.1)SPK=291
X IF(OBJ.NE.FOOD.OR.PROP(DOG).EQ.1)GOTO 2011
X SPK=249
X CALL DSTROY(FOOD)
X GOTO 2011
X
XC FEED WUMPUS?
X22160 IF(IOBJ.NE.WUMPUS)GOTO 22170
X IF(PROP(WUMPUS).EQ.6)SPK=326
X IF(PROP(WUMPUS).EQ.0)SPK=327
X IF(OBJ.EQ.FOOD)SPK=240
X GOTO 2011
X
XC FEED BEES?
X22170 IF(IOBJ.NE.BEES.OR.OBJ.NE.FLOWER)GOTO 2070
X IF(ENCLSD(FLOWER))CALL REMOVE(FLOWER)
X CALL DROP(FLOWER,LOC)
X FIXED(FLOWER)=-1
X PROP(FLOWER)=1
X CALL DROP(HONEY,LOC)
X CALL JUGGLE(HONEY)
X SPK=267
X PROP(HIVE)=1
X GOTO 2011
XC FILL. BOTTLE/CASK MUST BE EMPTY, AND SOME LIQUID AVAILABLE.
XC (VASE IS NASTY & GRAIL IS CRACKED.)
X12200 IF( (.NOT.HERE(BOTTLE).AND..NOT.HERE(CASK)) .OR.
X 1 (HERE(BOTTLE).AND.HERE(CASK)) )GOTO 10000
X IF(PROP(CASK).EQ.1.AND.HERE(CASK))OBJ=CASK
X IF(PROP(BOTTLE).EQ.1.AND.HERE(BOTTLE))OBJ=BOTTLE
X IF(OBJ.EQ.0)GOTO 10000
X
XC FILL OBJ WITH IOBJ
X22200 SPK=313
X IF(.NOT.VESSEL(OBJ))GOTO 2011
X IF(IOBJ.EQ.0)IOBJ=LIQLOC(LOC)
X IF(OBJ.NE.BOTTLE.AND.OBJ.NE.CASK)GOTO 22220
X K=0
X IF(OBJ.EQ.CASK)K=1
X SPK=0
X IF(IOBJ.EQ.0)SPK=304+K
X IF(LIQ(OBJ).NE.0)SPK=302+K
X IF(SPK.NE.0)GOTO 2011
X SPK=306+K
X IF(IOBJ.EQ.OIL)SPK=308+K
X IF(IOBJ.EQ.WINE)SPK=310+K
X PROP(OBJ)=MOD(LOCCON(LOC),8)/2*2
X PLACE(IOBJ+K)=-1
X CALL INSERT(IOBJ+K,OBJ)
X GOTO 2011
X
XC VASE. (NASTY).
X22220 IF(OBJ.NE.VASE)GOTO 22230
X SPK=144
X IF(IOBJ.EQ.0.OR..NOT.HOLDNG(VASE))GOTO 2011
X CALL RSPEAK(145)
X PROP(VASE)=2
X FIXED(VASE)=-1
X GOTO 20290
X
XC GRAIL OR OTHER.
X22230 SPK=339
X IF(OBJ.EQ.GRAIL)SPK=298
X GOTO 2011
X
XC BLAST. NO EFFECT UNLESS YOU'VE GOT DYNAMITE, WHICH IS A NEAT TRICK!
X
X12300 IF(PROP(ROD2).GT.0.AND.CLOSED)GOTO 12310
X IF(.NOT.ISWIZ)GOTO 2011
X DO 12305 I=1,5
X IF(LOC.NE.DLOC(I))GOTO 12305
X DLOC(I)=0
X DSEEN(I)=.FALSE.
X12305 CONTINUE
X GOTO 2011
X12310 BONUS=133
X IF(LOC.EQ.115)BONUS=134
X IF(HERE(ROD2))BONUS=135
X CALL RSPEAK(BONUS)
X GOTO 95000
XC SCORE.
X
X12400 SCORNG=.TRUE.
X CALL RATING(SCORE,MXSCOR,BONUS,GAVEUP,SCORNG,CLOSNG,CLOSED)
X SCORNG=.FALSE.
X PRINT 12412,SCORE,MXSCOR,TURNS
X12412 FORMAT(/' If you were to quit now, you would score',I4
X 1 ,' out of',I4,' using',I4,' turns.')
XC GAVEUP=YES(143,54,54)
XC GOTO 11850
X GOTO 2100
X
XC FEE FIE FOE FOO (AND FUM). ADVANCE TO NEXT STATE IF GIVEN IN PROPER ORDER.
XC LOOK UP WD1 IN SECTION 3 OF VOCAB TO DETERMINE WHICH WORD WE'VE GOT. LAST
XC WORD ZIPS THE EGGS BACK TO THE GIANT ROOM (UNLESS ALREADY THERE).
X
X12500 K=VOCABX(VTXT(VRBX,1),4)
X SPK=42
X IF(FOOBAR.EQ.1-K)GOTO 12520
X IF(FOOBAR.NE.0)SPK=151
X GOTO 2011
X
X12520 FOOBAR=K
X IF(K.NE.4)GOTO 2009
X FOOBAR=0
X IF(PLACE(EGGS).EQ.PLAC(EGGS)
X 1 .OR.(TOTING(EGGS).AND.LOC.EQ.PLAC(EGGS)))GOTO 2011
XC BRING BACK TROLL IF WE STEAL THE EGGS BACK FROM HIM BEFORE CROSSING.
X IF(PLACE(EGGS).EQ.0.AND.PLACE(TROLL).EQ.0.AND.PROP(TROLL).EQ.0)
X 1 PROP(TROLL)=1
X K=2
X IF(HERE(EGGS))K=1
X IF(LOC.EQ.PLAC(EGGS))K=0
X CALL MOVE(EGGS,PLAC(EGGS))
X CALL PSPEAK(EGGS,K)
X GOTO 2100
X
XC BRIEF/UNBRIEF. INTRANSITIVE ONLY.
XC SUPPRESS LONG DESCRIPTIONS AFTER FIRST TIME.
X
X12600 DETAIL=3
X TERSE=.FALSE.
X IF(ABBNUM.EQ.10000)GOTO 12610
X SPK=156
X ABBNUM=10000
X GOTO 2011
X
X12610 ABBNUM=5
X SPK=374
X GOTO 2011
X
X22600 IF(OBJ.NE.0.AND.LIVING(OBJ).AND.IOBJ.NE.0)GOTO 2011
X GOTO 2060
X
XC READ. MAGAZINES IN DWARVISH, MESSAGE WE'VE SEEN, AND . . . OYSTER?
X
X22700 IF(BLIND(0))GOTO 2011
X IF(OBJ.NE.0.AND.IOBJ.NE.0)GOTO 2060
X SPK=CONFUZ(0)
X IF(OBJ.EQ.0)OBJ=IOBJ
X IF(OBJ.EQ.BOOK.OR.OBJ.EQ.BOOK2)SPK=142
X IF(OBJ.EQ.BILLBD)SPK=361
X IF(OBJ.EQ.CARVNG)SPK=372
X IF(OBJ.EQ.MAGZIN)SPK=190
X IF(OBJ.EQ.MESSAG)SPK=191
X IF(OBJ.EQ.OYSTER.AND.HINTED(2).AND.HOLDNG(OYSTER))SPK=194
X IF(OBJ.EQ.POSTER)SPK=370
X IF(OBJ.EQ.TABLET)SPK=196
X IF(OBJ.NE.OYSTER.OR.HINTED(2).OR..NOT.HOLDNG(OYSTER)
X 1 .OR..NOT.CLOSED)GOTO 2011
X HINTED(2)=YES(192,193,54)
X GOTO 2100
XC BREAK. WORKS FOR MIRROR IN REPOSITORY AND, OF COURSE, THE
XC VASE AND BOTTLE. ALSO, THE SWORD IS MORE BRITTLE THAN IT APPEARS.
X
X22800 IF(OBJ.EQ.MIRROR)SPK=148
X IF(OBJ.EQ.VASE.AND.PROP(VASE).EQ.0)GOTO 22820
X IF(OBJ.EQ.BOTTLE.AND.PROP(BOTTLE).NE.3)GOTO 22840
X IF(OBJ.EQ.SWORD)GOTO 22860
X IF(OBJ.NE.MIRROR.OR..NOT.CLOSED)GOTO 2011
X CALL RSPEAK(197)
X GOTO 93000
X
X22820 SPK=198
X PROP(VASE)=2
X22830 IF(ENCLSD(OBJ))CALL REMOVE(OBJ)
X IF(HOLDNG(OBJ))CALL DROP(OBJ,LOC)
X FIXED(OBJ)=-1
X GOTO 2011
X
X22840 SPK=231
X K=LIQ(BOTTLE)
X PROP(BOTTLE)=3
X IF(K.EQ.0)GOTO 22830
X CALL REMOVE(K)
X PLACE(K)=0
X GOTO 22830
X
XC HE'D BETTER NOT SLING THE SWORD AROUND!
X22860 SPK=29
X IF(.NOT.HOLDNG(SWORD))GOTO 2011
X SPK=279
X PROP(SWORD)=4
X GOTO 22830
X
XC ERWACHE. ONLY USE IS TO DISTURB THE DWARVES OR THE WUMPUS.
XC OTHER WUMPUS-WAKERS LINK HERE.
X
X22900 IF(.NOT.AT(WUMPUS))GOTO 22940
X CHASE=1
X PROP(WUMPUS)=1
X SPK=276
X GOTO 2011
X
X22940 IF(AT(DOG).AND.PROP(DOG).EQ.1)SPK=291
X IF(OBJ.NE.DWARF.OR..NOT.CLOSED)GOTO 2011
X CALL RSPEAK(199)
X GOTO 93000
XC SUSPEND. OFFER TO EXIT LEAVING THINGS RESTARTABLE, BUT REQUIRING A DELAY
XC BEFORE RESTARTING (SO CAN'T SAVE THE WORLD BEFORE TRYING SOMETHING RISKY).
XC UPON RESTARTING, SETUP=-1 CAUSES RETURN TO 13050 TO PICK UP AGAIN.
X
X13000 SPK=201
X IF(DEMO)GOTO 2011
X PRINT 13010,LATNCY
X13010 FORMAT(/' I can suspend your adventure for you so that you can',
X 1 ' resume later, but'/' you will have to wait at least',
X 2 I3,' minutes before continuing.')
X IF(.NOT.YES(200,54,54))GOTO 2100
X CALL DATIME(SAVED,SAVET)
X SETUP=-1
X CALL CIAO
X
X13050 YEA=START(0)
X SETUP=3
X VERBS(1)=NULL
X VRBX=1
X VERBS(2)=0
X OBJS(1)=0
X OBJX=0
X GOTO 2750
X
XC HOURS. REPORT CURRENT NON-PRIME-TIME HOURS.
X
X13100 CALL MSPEAK(6)
X CALL HOURS
X GOTO 2100
X
X
XC YANK. A VARIANT OF 'CARRY'. IN GENERAL, NOT A GOOD IDEA.
XC AT MOST, IT GETS THE CLOAK OR A COUPLE SNIDE COMMENTS.
X
X23200 IF(TOTING(OBJ))GOTO 20200
X IF(OBJ.EQ.PLANT.OR.OBJ.EQ.SWORD.OR.OBJ.EQ.CHAIN)GOTO 20100
X SPK=205
X IF(OBJ.EQ.BEAR.AND.PROP(CHAIN).EQ.1)GOTO 2011
X IF(OBJ.EQ.CLOAK.AND.PROP(CLOAK).EQ.2)GOTO 20120
X GOTO 20100
X
XC WEAR: ONLY GOOD FOR JEWELS, RUBY SLIPPERS, CLOAK & CROWN.
XC BUT HE MIGHT TRY THE SWORD. ANYTHING ELSE IS RIDICULOUS.
XC ANOTHER VARIANT OF 'CARRY'.
X
X23300 SPK=209
X IF(OBJ.EQ.SWORD.AND.PROP(SWORD).NE.3)GOTO 2011
X IF(WORN(OBJ))GOTO 23320
X23310 CALL A5TOA1(OTXT(OBJX,1),OTXT(OBJX,2),'?',TK,K)
X PRINT 23312,(TK(I),I=1,K)
X23312 FORMAT(/' Just exactly how does one wear a ',20A1)
X GOTO 2100
X
X23320 SPK=242
X IF(OBJ.EQ.CLOAK.AND.PROP(CLOAK).EQ.2)GOTO 2011
X SPK=210
X IF(OBJ.EQ.SHOES)SPK=227
X IF(WEARNG(OBJ))GOTO 2011
X PROP(OBJ)=1
X CALL BITON(OBJ,WEARBT)
X IF(ENCLSD(OBJ))CALL REMOVE(OBJ)
X IF(HOLDNG(OBJ))GOTO 2009
X GOTO 20120
XC HIT. IF NOT PUNCHING OUT TELEPHONE, ASSUME ATTACK.
X
X23400 IF(AT(WUMPUS).AND.PROP(WUMPUS).EQ.0)GOTO 22900
X IF(OBJ.NE.PHONE)GOTO 21200
X IF(CLOSED)GOTO 93100
X SPK=256
X IF(PROP(PHONE).EQ.2)GOTO 2011
X CALL DROP(SLUGS,LOC)
X SPK=257
X PROP(PHONE)=2
X PROP(BOOTH)=2
X GOTO 2011
X
XC ANSWER (TELEPHONE). SMARTASS FOR ANYTHING ELSE.
X13500 IF(LOC.NE.189.OR.PROP(PHONE).NE.0)GOTO 10000
X OBJ=PHONE
X23500 IF(OBJ.NE.PHONE)GOTO 23520
X SPK=269
X IF(PROP(PHONE).NE.0)GOTO 2011
X IF(CLOSED)GOTO 93200
X SPK=261
X PROP(PHONE)=1
X PROP(BOOTH)=2
X GOTO 2011
X
X23520 IF(OBJ.EQ.DWARF.OR.OBJ.EQ.WUMPUS.OR.OBJ.EQ.SNAKE.OR.OBJ.EQ.BEAR
X 1 .OR.OBJ.EQ.DRAGON)SPK=259
X IF(OBJ.EQ.TROLL)SPK=258
X IF(OBJ.EQ.BIRD)SPK=260
X GOTO 2011
XC BLOW. JOSHUA FIT DE BATTLE OF JERICHO, AND DE WALLS....
X
X23600 IF(OBJ.NE.0.AND.IOBJ.NE.0)GOTO 2060
X IF(OBJ.EQ.0)OBJ=IOBJ
X IOBJ=0
X IF(OBJ.EQ.0)SPK=268
X IF(OBJ.NE.HORN)GOTO 2011
X SPK=266
X IF(OUTSID(LOC))SPK=277
X IF(.NOT.AT(WUMPUS))GOTO 23610
X IF(PROP(WUMPUS).NE.0)GOTO 2011
X CALL RSPEAK(SPK)
X GOTO 22900
X
X23610 IF(PROP(WALL).EQ.1.OR.(LOC.NE.102.AND.LOC.NE.194))GOTO 2011
X K=196
X IF(LOC.EQ.194)K=195
X CALL RSPEAK(265)
X PROP(WALL)=1
X DO 23620 OBJ=1,MAXOBJ
X IF(PLACE(OBJ).EQ.LOC.OR.FIXED(OBJ).EQ.LOC)CALL MOVE(OBJ,K)
X23620 CONTINUE
X NEWLOC=K
X GOTO 2
X
X
XC CALL. IF NO PHONE IS HANDY, YELL.
X
X13800 IF(.NOT.HERE(PHONE))GOTO 10000
X GOTO 23910
X
XC DIAL. NO EFFECT UNLESS AT PHONE.
X
X23900 IF(OBJ.NE.PHONE)GOTO 2011
X23910 IF(CLOSED)GOTO 93200
X SPK=271
X GOTO 2011
X
X
XC PLAY. ONLY FOR HORN OR LYRE.
X24000 IF(OBJ.NE.0.AND.IOBJ.NE.0)GOTO 2060
X IF(OBJ.EQ.0)OBJ=IOBJ
X IOBJ=0
X IF(OBJ.EQ.HORN)GOTO 23600
X IF(OBJ.NE.LYRE)GOTO 2011
X SPK=287
X IF(.NOT.HERE(DOG).OR.DEAD(DOG))GOTO 2011
X PROP(DOG)=1
X CALL BITON(DOG,DEADBT)
X FIXED(AXE)=0
X PROP(AXE)=0
X SPK=288
X GOTO 2011
X
X
XC PICK/PICK UP. CAN PICK FLOWERS & MUSHROOMS, BUT MUST 'PICK UP' EVERYTHING EL
X
X24100 IF(OBJ.EQ.0)OBJ=IOBJ
X IOBJ=0
X IF(OBJ.EQ.FLOWER.OR.OBJ.EQ.MUSHRM)GOTO 20100
X IF(PREP.NE.0)GOTO 20100
X GOTO 2060
XC PUT DOWN: EQUIVALENT TO DROP.
XC PUT IN: IF LIQUID, MEANS 'FILL'.
XC PUT ON: WEAR OR DROP.
X
X24200 IF(PREP.NE.0)GOTO 24210
X CALL A5TOA1(OTXT(OBJX,1),OTXT(OBJX,2),'?',TK,K)
X PRINT 24204,(TK(I),I=1,K)
X24204 FORMAT(/' Where do you want to put the ',20A1)
X GOTO 2600
X
X24210 IF(PREP.EQ.PREPIN)GOTO 24500
X
XC PUT ON: "WEAR" OR "PUT OBJ ON IOBJ".
X24240 IF(PREP.NE.PREPON)GOTO 24250
X IF(OBJ.NE.0)GOTO 24242
X OBJ=IOBJ
X OTXT(OBJX,1)=IOTXT(IOBX,1)
X OTXT(OBJX,2)=IOTXT(IOBX,2)
X IOBJ=0
X24242 IF(WORN(OBJ))GOTO 23300
X IF(IOBJ.EQ.0)GOTO 23310
X GOTO 20200
X
XC PUT DOWN: "DROP"
X24250 IF(OBJ.EQ.0.OR.IOBJ.EQ.0)GOTO 24252
X GOTO 2070
X
X24252 IF(OBJ.EQ.0)OBJ=IOBJ
X IOBJ=0
X GOTO 20200
X
X
XC TURN ON/OFF.
X
X24300 IF(PREP.EQ.0)GOTO 2060
X IF(OBJ.EQ.0.AND.IOBJ.EQ.LAMP)OBJ=LAMP
X IF(OBJ.NE.LAMP)GOTO 2070
X IF(PREP.EQ.PREPON)GOTO 20700
X GOTO 20800
X
X
XC GET (NO PREP): "TAKE"
XC GET IN: "ENTER"
XC GET OUT: "LEAVE"
XC****** NEEDS WORK
X
X24400 IF(PREP.EQ.0.OR.PREP.EQ.PREPFR)GOTO 20100
X IF(OBJ.NE.0)GOTO 2060
X OBJ=IOBJ
X IOBJ=0
X PREP=0
X GOTO 20100
XC INSERT/PUT IN.
X
X24500 IF(IOBJ.EQ.0)GOTO 10010
X SPK=NOWAY(0)
X IF(OBJ.EQ.SWORD.AND.IOBJ.EQ.ANVIL.AND.PROP(SWORD).EQ.0)SPK=350
X IF(.NOT.VESSEL(IOBJ))GOTO 2011
X ASSIGN 24510 TO RETN
X GOTO 20190
X
X24510 IF(IOBJ.NE.BOTTLE.AND.IOBJ.NE.CASK.AND.IOBJ.NE.VASE
X 1 .AND.IOBJ.NE.GRAIL.AND.(OBJ.LT.WATER.OR.OBJ.GT.WINE+1))
X 2 GOTO 24515
X OBJ=IOBJ
X IOBJ=OBJS(OBJX)
X GOTO 22200
X
X24515 SPK=252
X IF(OBJ.EQ.IOBJ)GOTO 2011
X SPK=358
X IF(.NOT.AJAR(IOBJ))GOTO 2011
X IF(IOBJ.NE.BOAT.AND.IOBJ.NE.CHEST)GOTO 24520
X IF(IOBJ.EQ.CHEST.AND.OBJ.EQ.BOAT)GOTO 2070
X GOTO 24590
X
XC BIRD GOES INTO CAGE AND ONLY CAGE. CAGE HOLDS NOTHING ELSE.
XC BAR VASE & PILLOW FROM SAFE, TO FORCE PUTTING DOWN ON FLOOR.
X24520 SPK=351
X IF(OBJ.EQ.BIRD.AND.IOBJ.NE.CAGE)GOTO 2011
X SPK=329
X IF(IOBJ.EQ.CAGE.AND.OBJ.NE.BIRD)GOTO 2011
X IF(OBJ.EQ.BIRD)GOTO 20120
X IF(IOBJ.EQ.SAFE.AND.(OBJ.EQ.VASE.OR.OBJ.EQ.PILLOW))GOTO 2011
X IF(IOBJ.EQ.SHIELD.AND.OBJ.NE.RADIUM)GOTO 2011
X IF(IOBJ.NE.PHONE)GOTO 24530
X IF(OBJ.NE.COINS.AND.OBJ.NE.SLUGS)GOTO 2070
X CALL DSTROY(OBJ)
X SPK=330
X GOTO 2011
X
X24530 IF(IOBJ.NE.VEND)GOTO 24540
X IF(OBJ.NE.COINS.AND.OBJ.NE.SLUGS)GOTO 2070
X CALL DSTROY(OBJ)
X CALL MOVE(BATTER,LOC)
X IF(PROP(BATTER).NE.1)GOTO 24535
X CALL RSPEAK(317)
X PROP(VEND)=1
X24535 PROP(BATTER)=0
X CALL PSPEAK(BATTER,0)
X GOTO 2100
X
XC PUT BATTERIES IN LAMP.
XC THERE IS A GLITCH HERE, IN THAT IF HE TRIES TO GET A THIRD SET OF
XC BATTERIES BEFORE THE SECOND SET HAS BEEN INSERTED, THE SECOND SET
XC DISAPPEARS! ***FIX THIS SOMETIME***
X24540 IF(IOBJ.NE.LAMP)GOTO 24550
X IF(OBJ.NE.BATTER.OR.PROP(BATTER).NE.0)GOTO 2070
X PROP(BATTER)=1
X IF(ENCLSD(BATTER))CALL REMOVE(BATTER)
X IF(HOLDNG(BATTER))CALL DROP(BATTER,LOC)
X LIMIT=400
X PROP(LAMP)=1
X LMWARN=.FALSE.
X SPK=188
X GOTO 2011
X
X24550 IF(.NOT.SMALL(OBJ))GOTO 2011
X24590 IF(WEARNG(OBJ))CALL BITOFF(OBJ,WEARBT)
X IF(ENCLSD(OBJ))CALL REMOVE(OBJ)
X CALL INSERT(OBJ,IOBJ)
X GOTO 2009
XC REMOVE/TAKE FROM.
X
X24600 IF(OBJ.NE.RING.OR.PROP(RING).NE.2)GOTO 24610
X PREP=0
X IOBJ=0
X GOTO 20100
X
X24610 SPK=343
X IF(IOBJ.NE.0)GOTO 24620
X IF(.NOT.ENCLSD(OBJ))SPK=340
X IOBJ=-PLACE(OBJ)
X24620 IF(PLACE(OBJ).NE.-IOBJ)SPK=341
X IF(.NOT.AJAR(IOBJ))SPK=335
X IF(OBJ.EQ.WATER.OR.OBJ.EQ.OIL.OR.OBJ.EQ.WINE)SPK=342
X IF(.NOT.TOTING(OBJ).AND.BURDEN(0)+BURDEN(OBJ).GT.15)SPK=92
X IF(SPK.NE.343)GOTO 2011
X CALL REMOVE(OBJ)
X IF(OBJ.EQ.BIRD)GOTO 20200
X GOTO 2009
X
X
XC BURN
X
X24700 GOTO 2011
X
X
XC GRIPE/COMPLAIN/SUGGEST.
X
X14800 SCORNG=.TRUE.
X CALL RATING(SCORE,MXSCOR,BONUS,GAVEUP,SCORNG,CLOSNG,CLOSED)
X SCORNG=.FALSE.
X CALL GRIPE(LOC,SCORE,CLOSNG,CLOSED)
X GOTO 2011
XC LOCK. CHAIN, GRATE, CHEST, ELFIN DOOR
XC HERE ARE THE CURRENT LOCK/UNLOCK MESSAGES & NUMBERS:
XC 31 YOU HAVE NO KEYS.
XC 32 IT HAS NO LOCK.
XC 34 IT'S ALREADY LOCKED.
XC 35 THE GRATE IS NOW LOCKED.
XC 36 THE GRATE IS NOW UNLOCKED.
XC 37 IT WAS ALREADY UNLOCKED.
XC 55 YOU CAN'T UNLOCK THE KEYS.
XC 171 The chain is now unlocked.
XC 172 The chain is now locked.
XC 173 There is nothing here to which the chain can be locked.
XC 224 YOUR KEYS ARE ALL TOO LARGE.
XC 234 The wrought-iron door is now locked.
XC 235 The tiny door is now locked.
XC 236 The wrought-iron door is now unlocked.
XC 237 The tiny door is now unlocked.
XC 375 YOU DON'T HAVE THE RIGHT KEY.
XC 333 THE CHEST IS NOW LOCKED.
XC 334 THE CHEST IS NOW UNLOCKED.
XC 367 THE SAFE'S DOOR SWINGS SHUT.
X
X24900 IF(HINGED(OBJ))GOTO 24905
X CALL A5TOA1(OTXT(OBJX,1),OTXT(OBJX,2),'.',TK,K)
X PRINT 24903,(TK(I),I=1,K)
X24903 FORMAT(/' I don''t know how to lock or unlock the ',20A1)
X GOTO 2100
X
X24905 SPK=375
X IF(.NOT.LOCKS(OBJ))SPK=32
X IF(LOCKED(OBJ))SPK=34
X IF(.NOT.(ATHAND(KEYS).OR.ATHAND(SKEY).OR.OBJ.EQ.SAFE))SPK=31
X IF(SPK.NE.375)GOTO 2011
X
XC CHAIN.
X IF(OBJ.NE.CHAIN)GOTO 24910
X IF(.NOT.ATHAND(KEYS))GOTO 2011
X SPK=173
X IF(LOC.NE.PLAC(CHAIN))GOTO 2011
X SPK=172
X PROP(CHAIN)=2
X IF(ENCLSD(CHAIN))CALL REMOVE(CHAIN)
X IF(HOLDNG(CHAIN))CALL DROP(CHAIN,LOC)
X FIXED(CHAIN)=-1
X GOTO 24990
X
XC CHEST.
X24910 IF(OBJ.NE.CHEST)GOTO 24920
X IF(.NOT.ATHAND(KEYS))GOTO 2011
X SPK=334
X GOTO 24990
X
XC ELFIN DOOR.
X24920 IF(OBJ.NE.TDOOR.AND.OBJ.NE.TDOOR2)GOTO 24930
X SPK=224
X IF(.NOT.TOTING(SKEY))GOTO 2011
X PROP(TDOOR)=0
X PROP(TDOOR2)=0
X SPK=234+2*PROP(TDOOR)+(TDOOR2-OBJ)
X K=TDOOR+(TDOOR2-OBJ)
X CALL BITON(K,LOCKBT)
X CALL BITOFF(K,OPENBT)
X GOTO 24990
X
XC GRATE.
X24930 IF(OBJ.NE.GRATE)GOTO 24940
X IF(.NOT.ATHAND(KEYS))GOTO 2011
X PROP(GRATE)=0
X SPK=35
X GOTO 24990
X
XC SAFE.
X24940 PROP(SAFE)=0
X SPK=367
XC GOTO 24990
X
X24990 CALL BITON(OBJ,LOCKBT)
X CALL BITOFF(OBJ,OPENBT)
X GOTO 2011
XC UNLOCK. CHAIN, GRATE, CHEST, ELFIN DOOR.
X
X25000 SPK=55
X IF(OBJ.EQ.KEYS.OR.OBJ.EQ.SKEY)GOTO 2011
X IF(.NOT.HINGED(OBJ))GOTO 24900
X SPK=375
X IF(.NOT.LOCKED(OBJ))SPK=37
X IF(.NOT.LOCKS(OBJ))SPK=32
X IF(OBJ.EQ.SAFE)SPK=342
X IF(OBJ.EQ.SAFE.AND.(IOBJ.EQ.KEYS.OR.IOBJ.EQ.SKEY))SPK=368
X IF(.NOT.(ATHAND(KEYS).OR.ATHAND(SKEY).OR.OBJ.EQ.SAFE))SPK=31
X IF(SPK.NE.375)GOTO 2011
X
XC CHAIN.
X IF(OBJ.NE.CHAIN)GOTO 25020
X IF(.NOT.ATHAND(KEYS))GOTO 2011
X SPK=171
X IF(PROP(BEAR).EQ.0)SPK=41
X IF(SPK.NE.171)GOTO 2011
X PROP(CHAIN)=0
X FIXED(CHAIN)=0
X IF(PROP(BEAR).NE.3)PROP(BEAR)=2
X FIXED(BEAR)=2-PROP(BEAR)
X GOTO 25090
X
XC CHEST.
X25020 IF(OBJ.NE.CHEST)GOTO 25030
X IF(.NOT.ATHAND(KEYS))GOTO 2011
X SPK=333
X GOTO 25090
X
XC ELFIN DOOR.
XC STUFF TO LOCK/UNLOCK TINY DOOR W/SPECIAL KEY.
XC THE DAMN THING IS REALLY AT FOUR PLACES, AND WE WANT THE RIGHT
XC MESSAGES IF HE ONLY HAS 'BIG' KEYS (OR NO KEYS). ALSO, HE
XC CAN UNLOCK IT EITHER WHILE HE IS BIG OR SMALL.
X25030 IF(OBJ.NE.TDOOR.AND.OBJ.NE.TDOOR2)GOTO 25040
X SPK=224
X IF(.NOT.ATHAND(SKEY))GOTO 2011
X IF(CLOSNG)GOTO 25060
X PROP(TDOOR)=1
X PROP(TDOOR2)=1
X SPK=234+2*PROP(TDOOR)+(TDOOR2-OBJ)
X K=TDOOR+(TDOOR2-OBJ)
X CALL BITOFF(K,LOCKBT)
X CALL BITON(K,OPENBT)
X GOTO 25090
X
XC GRATE.
X25040 IF(.NOT.ATHAND(KEYS))GOTO 2011
X IF(CLOSNG)GOTO 25060
X PROP(GRATE)=1
X SPK=36
X
X25090 CALL BITOFF(OBJ,LOCKBT)
X CALL BITON(OBJ,OPENBT)
X GOTO 2011
X
XC CLOSING. NO EXIT THIS WAY.
X25060 SPK=130
X IF(.NOT.PANIC)CLOCK2=15
X PANIC=.TRUE.
X GOTO 2011
X
X
XC HEALTH. GIVE HIM A DIAGNOSIS.
X
X25100 IF(HEALTH.LT.100)PRINT 25102,HEALTH
X25102 FORMAT(/' You''re health rating is ',I2,
X 1 ' out of a possible 100.')
X IF(PCT(50))SPK=349
X IF(HEALTH.GE.95)GOTO 2011
X SPK=381 + (100-HEALTH)/20
X GOTO 2011
X
X
XC LOOK. CAN'T GIVE MORE DETAIL. PRETEND IT WASN'T DARK (THOUGH IT MAY "NOW"
XC BE DARK) SO HE WON'T FALL INTO A PIT WHILE STARING INTO THE GLOOM.
X
X25200 IF(OBJ.NE.0)GOTO 2060
X IF(IOBJ.NE.0)GOTO 25210
X25201 IF(DETAIL.LT.3)CALL RSPEAK(15)
X DETAIL=DETAIL+1
X WZDARK=.FALSE.
X ABB(LOC)=0
X NEWLOC=LOC
X GOTO 2
X
XC LOOK INTO SOMETHING (A CONTAINER).
X25210 IF(.NOT.VESSEL(IOBJ))GOTO 25220
X IF(.NOT.AJAR(IOBJ).AND.OPAQUE(IOBJ))GOTO 2011
X SPK=359
X IF(HOLDER(IOBJ).EQ.0)GOTO 2011
X PRINT 25212
X25212 FORMAT(1H )
X CALL LOOKIN(IOBJ)
X GOTO 2100
X
XC LOOK AT SOMETHING. IF WRITTEN, READ IT.
X25220 IF(.NOT.PRINTD(IOBJ))GOTO 25201
X OBJ=IOBJ
X IOBJ=0
X GOTO 22700
X
X
XC COMBO: TRYING TO OPEN SAFE. SEE COMMENTS FOR FEE FIE FOE FOO.
X
X25300 IF(.NOT.AT(SAFE))GOTO 2060
X K=VOCABX(VTXT(VRBX,1),4)-10
X SPK=42
X IF(COMBO.EQ.1-K)GOTO 25320
X IF(COMBO.NE.0)SPK=366
X GOTO 2011
X
X25320 COMBO=K
X SPK=371
X IF(K.NE.3)GOTO 2011
X COMBO=0
X CALL BITOFF(SAFE,LOCKBT)
X CALL BITON(SAFE,OPENBT)
X PROP(SAFE)=1
X SPK=365
X IF(PROP(BOOK).GE.0)GOTO 2011
X TALLY=TALLY-1
XC IF REMAINING TREASURES TOO ELUSIVE, ZAP HIS LAMP.
XC THIS COPIES SOME CODE LOCATED AROUND LABEL 2000. MUST BE DONE
XC HERE SINCE BOOK IS CONTAINED IN SAFE & TALLY STUFF ONLY WORKS FOR THINGS
XC DEPOSITED AT A LOC.
X IF(TALLY.EQ.TALLY2.AND.TALLY.NE.0)LIMIT=MIN0(35,LIMIT)
X GOTO 2011
XC DUST/SWEEP.
X25400 IF(.NOT.ATHAND(BRUSH))SPK=342
X IF(.NOT.AT(CARVNG).OR..NOT.ATHAND(BRUSH).OR.PROP(CARVNG).EQ.1)
X 1 GOTO 2011
X PROP(CARVNG)=1
X CALL RSPEAK(363)
X SPK=372
X GOTO 2011
X
X
XC TERSE/UNTERSE. SUPRESS ALL LONG-FORM DESCRIPTIONS.
X
X25500 TERSE=.NOT.TERSE
X DETAIL=3
X GOTO 2009
XC WIZ STUFF
X
X25600 IF(ISWIZ)CALL MONITR
X GOTO 2009
X25700 IF(ISWIZ) CALL XMAP
X GOTO 2009
X25800 IF(.NOT.ISWIZ) GOTO 2009
X WRITE(1,25801)
X25801 FORMAT (1X,'LOCATION ?')
X READ (1,25802) GATLOC
X25802 FORMAT (I4)
X IF ((GATLOC.GT.0).AND.(GATLOC.LE.MAXLOC))
X + LOC=GATLOC
X GOTO 2009
X25900 IF(ISWIZ) WRITE(1,25901) DLOC(DWFMAX)
X25901 FORMAT(1X,'THE PIRATE IS AT LOCATION ',I4)
X GOTO 2009
X
XC HINTS
X
XC COME HERE IF HE'S BEEN LONG ENOUGH AT REQUIRED LOC(S) FOR SOME UNUSED HINT.
XC HINT NUMBER IS IN VARIABLE "HINT". BRANCH TO QUICK TEST FOR ADDITIONAL
XC CONDITIONS, THEN COME BACK TO DO NEAT STUFF. GOTO 40010 IF CONDITIONS ARE
XC MET AND WE WANT TO OFFER THE HINT. GOTO 40020 TO CLEAR HINTLC BACK TO ZERO,
XC 40030 TO TAKE NO ACTION YET.
X
X40000 GOTO (40700,40800,40900,41000,41100,41200,41300,41400,41500,
X 1 41600,41700),(HINT+1-HNTMIN)
XC MAZE DARK WITT SWORD SLIDE CAVE1 BIRD CAVE2 RNBOW
XC SNAKE STYX
X
X PRINT 40002,HINT
X40002 FORMAT (' TRYING TO PRINT HINT # ',I1,/)
X CALL BUG(27)
X
X40010 HINTLC(HINT)=0
X IF(.NOT.YES(HINTS(HINT,3),0,54))GOTO 2603
X PRINT 40012,HINTS(HINT,2)
X40012 FORMAT(/' I am prepared to give you a hint, but it will cost
X 1 you', I2,' points.')
X HINTED(HINT)=YES(175,HINTS(HINT,4),54)
X IF(HINTED(HINT).AND.LIMIT.GT.30)LIMIT=LIMIT+30*HINTS(HINT,2)
X40020 HINTLC(HINT)=0
X40030 GOTO 2603
X
XC NOW FOR THE QUICK TESTS. SEE DATABASE DESCRIPTION FOR ONE-LINE NOTES.
X
X40700 IF(ATLOC(LOC).EQ.0.AND.ATLOC(OLDLOC).EQ.0.AND.
X 1 ATLOC(OLDLC2).EQ.0.AND.BURDEN(0).GT.1)GOTO 40010
X GOTO 40020
X
X40800 IF(PROP(EMRALD).NE.-1.AND.PROP(PYRAM).EQ.-1)GOTO 40010
X GOTO 40020
X
X40900 GOTO 40010
X
X41000 IF( (PROP(SWORD).EQ.1.OR.PROP(SWORD).EQ.5)
X 1 .AND..NOT.TOTING(CROWN))GOTO 40010
X GOTO 40020
X
X41100 GOTO 40010
X
X41200 IF(PROP(GRATE).EQ.0.AND..NOT.ATHAND(KEYS))GOTO 40010
X GOTO 40020
X
X41300 IF(HERE(BIRD).AND.ATHAND(ROD).AND.OBJ.EQ.BIRD)GOTO 40010
X GOTO 40030
X
X41400 IF(ABB(159).EQ.0)GOTO 40010
X GOTO 40020
X
X41500 IF(.NOT.TOTING(SHOES).OR.ABB(205).EQ.0)GOTO 40010
X GOTO 40020
X
X41600 IF(.NOT.ATHAND(LYRE).AND.PROP(DOG).NE.1)GOTO 40010
X GOTO 40020
X
X41700 IF(HERE(SNAKE).AND..NOT.HERE(BIRD))GOTO 40010
X GOTO 40020
XC CAVE CLOSING AND SCORING
X
X
XC THESE SECTIONS HANDLE THE CLOSING OF THE CAVE. THE CAVE CLOSES "CLOCK1"
XC TURNS AFTER THE LAST TREASURE HAS BEEN LOCATED (INCLUDING THE PIRATE'S
XC CHEST, WHICH MAY OF COURSE NEVER SHOW UP). NOTE THAT THE TREASURES NEED NOT
XC HAVE BEEN TAKEN YET, JUST LOCATED. HENCE CLOCK1 MUST BE LARGE ENOUGH TO GET
XC OUT OF THE CAVE (IT ONLY TICKS WHILE INSIDE THE CAVE). WHEN IT HITS ZERO,
XC WE BRANCH TO 90000 TO START CLOSING THE CAVE, AND THEN SIT BACK AND WAIT FOR
XC HIM TO TRY TO GET OUT. IF HE DOESN'T WITHIN CLOCK2 TURNS, WE CLOSE THE
XC CAVE; IF HE DOES TRY, WE ASSUME HE PANICS, AND GIVE HIM A FEW ADDITIONAL
XC TURNS TO GET FRANTIC BEFORE WE CLOSE. WHEN CLOCK2 HITS ZERO, WE BRANCH TO
XC 90000 TO TRANSPORT HIM INTO THE FINAL PUZZLE. NOTE THAT THE PUZZLE DEPENDS
XC UPON ALL SORTS OF RANDOM THINGS. FOR INSTANCE, THERE MUST BE NO WATER OR
XC OIL, SINCE THERE ARE BEANSTALKS WHICH WE DON'T WANT TO BE ABLE TO WATER,
XC SINCE THE CODE CAN'T HANDLE IT. ALSO, WE CAN HAVE NO KEYS, SINCE THERE IS A
XC GRATE (HAVING MOVED THE FIXED OBJECT!) THERE SEPARATING HIM FROM ALL THE
XC TREASURES. MOST OF THESE PROBLEMS ARISE FROM THE USE OF NEGATIVE PROP
XC NUMBERS TO SUPPRESS THE OBJECT DESCRIPTIONS UNTIL HE'S ACTUALLY MOVED THE
XC OBJECTS.
X
XC WHEN THE FIRST WARNING COMES, WE LOCK THE GRATE, DESTROY THE BRIDGE, KILL
XC ALL THE DWARVES (AND THE PIRATE), REMOVE THE TROLL AND BEAR (UNLESS DEAD),
XC AND SET "CLOSNG" TO TRUE. LEAVE THE DRAGON; TOO MUCH TROUBLE TO MOVE IT.
XC FROM NOW UNTIL CLOCK2 RUNS OUT, HE CANNOT UNLOCK THE GRATE, MOVE TO ANY
XC LOCATION OUTSIDE THE CAVE (LOC=BITSET(LOCCON,6)), OR CREATE THE BRIDGE. NOR
XC RESURRECTED IF HE DIES. NOTE THAT THE SNAKE IS ALREADY GONE, SINCE HE GOT
XC TO THE TREASURE ACCESSIBLE ONLY VIA THE HALL OF THE MT. KING. ALSO, HE'S
XC BEEN IN GIANT ROOM (TO GET EGGS), SO WE CAN REFER TO IT. ALSO ALSO, HE'S
XC GOTTEN THE PEARL, SO WE KNOW THE BIVALVE IS AN OYSTER. *AND*, THE DWARVES
XC MUST HAVE BEEN ACTIVATED, SINCE WE'VE FOUND CHEST.
X
X90000 PROP(GRATE)=0
X PROP(FISSUR)=0
X PROP(TDOOR)=0
X PROP(TDOOR2)=0
X DO 90010 I=1,6
X DSEEN(I)=.FALSE.
X90010 DLOC(I)=0
X CALL MOVE(TROLL,0)
X CALL MOVE(TROLL+MAXOBJ,0)
X CALL MOVE(TROLL2,PLAC(TROLL))
X CALL MOVE(TROLL2+MAXOBJ,FIXD(TROLL))
X CALL JUGGLE(CHASM)
X IF(PROP(BEAR).NE.3)CALL DSTROY(BEAR)
X PROP(CHAIN)=0
X FIXED(CHAIN)=0
X PROP(AXE)=0
X FIXED(AXE)=0
X CALL RSPEAK(129)
X CLOCK1=-1
X CLOSNG=.TRUE.
X GOTO 19999
X
XC ONCE HE'S PANICKED, AND CLOCK2 HAS RUN OUT, WE COME HERE TO SET UP THE
XC STORAGE ROOM. THE ROOM HAS TWO LOCS, HARDWIRED AS 115 (NE) AND 116 (SW).
XC AT THE NE END, WE PLACE EMPTY BOTTLES, A NURSERY OF PLANTS, A BED OF
XC OYSTERS, A PILE OF LAMPS, RODS WITH STARS, SLEEPING DWARVES, PHONE BOOTH AND
XC AT THE SW END WE PLACE GRATE OVER TREASURES, SNAKE PIT, COVEY OF CAGED BIRDS,
XC MORE RODS, AND PILLOWS. A MIRROR STRETCHES ACROSS ONE WALL. MANY OF THE
XC OBJECTS COME FROM KNOWN LOCATIONS AND/OR STATES (E.G. THE SNAKE IS KNOWN TO
XC HAVE BEEN DESTROYED AND NEEDN'T BE CARRIED AWAY FROM ITS OLD "PLACE"),
XC MAKING THE VARIOUS OBJECTS BE HANDLED DIFFERENTLY. WE ALSO DROP ALL OTHER
XC OBJECTS HE MIGHT BE CARRYING (LEST HE HAVE SOME WHICH COULD CAUSE TROUBLE,
XC SUCH AS THE KEYS). WE DESCRIBE THE FLASH OF LIGHT AND TRUNDLE BACK.
XC THE PHONE MAKES IT IMPOSSIBLE FOR THE WALDO TO FART AROUND IN THE
XC REPOSITORY TOO LONG. WHEN CLOCK3 TICKS TO ZERO, THE PHONE STARTS
XC RINGING. WHEN IT HITS -7, THE DWARVES WAKE UP. IF HE FIDDLES WITH
XC THE PHONE, HE GETS ZONKED IN OTHER WAYS.
X
X91000 PROP(BOTTLE)=PUT(BOTTLE,115,1)
X PROP(PLANT)=PUT(PLANT,115,0)
X PROP(OYSTER)=PUT(OYSTER,115,0)
X PROP(LAMP)=PUT(LAMP,115,0)
X PROP(ROD)=PUT(ROD,115,0)
X PROP(DWARF)=PUT(DWARF,115,0)
X LOC=115
X OLDLOC=115
X NEWLOC=115
X
XC LEAVE THE GRATE WITH NORMAL (NON-NEGATIVE PROPERTY).
X
X FOO=PUT(GRATE,116,0)
X PROP(SNAKE)=PUT(SNAKE,116,1)
X PROP(BIRD)=PUT(BIRD,116,1)
X PROP(CAGE)=PUT(CAGE,116,0)
X PROP(ROD2)=PUT(ROD2,116,0)
X PROP(PILLOW)=PUT(PILLOW,116,0)
X
X PROP(BOOTH)=PUT(BOOTH,116,-4)
X FIXED(BOOTH)=115
X PROP(PHONE)=PUT(PHONE,212,-4)
X
X PROP(MIRROR)=PUT(MIRROR,115,0)
X PROP(BOOK2)=PUT(BOOK2,115,0)
X FIXED(MIRROR)=116
X
X DO 91010 I=1,MAXOBJ
X IF(TOTING(I).AND.ENCLSD(I))CALL REMOVE(I)
X91010 IF(TOTING(I))CALL DSTROY(I)
X
X CALL RSPEAK(132)
X CLOSED=.TRUE.
X GOTO 2
XC ANOTHER WAY WE CAN FORCE AN END TO THINGS IS BY HAVING THE LAMP GIVE OUT.
XC WHEN IT GETS CLOSE, WE COME HERE TO WARN HIM.
XC 92000 IS FOR CASES OF LAMP DYING. 92400 IS WHEN IT GOES OUT,
XC AND 92600 IS IF HE'S WANDERED OUTSIDE AND THE LAMP IS USED UP, IN WHICH
XC CASE WE FORCE HIM TO GIVE UP.
X
X92000 IF(LMWARN.OR..NOT.HERE(LAMP))GOTO 19999
X LMWARN=.TRUE.
X SPK=187
X IF(PROP(BATTER).EQ.1)SPK=323
X IF(PLACE(BATTER).EQ.0)SPK=183
X IF(PROP(VEND).EQ.1)SPK=189
X CALL RSPEAK(SPK)
X GOTO 19999
X
X92400 LIMIT=-1
X PROP(LAMP)=0
X IF(HERE(LAMP))CALL RSPEAK(184)
X GOTO 19999
X
X92600 CALL RSPEAK(185)
X GAVEUP=.TRUE.
X GOTO 95000
X
XC AND, OF COURSE, DEMO GAMES ARE ENDED BY THE WIZARD.
X
X92800 CALL MSPEAK(1)
X GAVEUP=.TRUE.
X GOTO 95000
X
XC OH DEAR, HE'S DISTURBED THE DWARVES.
X
X93000 CALL RSPEAK(136)
X GOTO 95000
X
XC HIT THE PHONE. JINGLE, JANGLE, CRASH!
X93100 CALL RSPEAK(282)
X GOTO 93000
X
XC WHOOPS. DOWN THE CHUTE.
X93200 CALL RSPEAK(283)
X GOTO 95000
X
XC DWARVES CAN'T SLEEP THRU ALL THIS RINGING!
X93300 CALL RSPEAK(254)
X GOTO 95000
XC "YOU'RE DEAD, FRED." "YOU DIED, CLYDE?"
XC
XC IF THE CURRENT LOC IS ZERO, IT MEANS THE CLOWN GOT HIMSELF KILLED. WE'LL
XC ALLOW THIS MAXDIE TIMES. MAXDIE IS AUTOMATICALLY SET BASED ON THE NUMBER OF
XC SNIDE MESSAGES AVAILABLE. EACH DEATH RESULTS IN A MESSAGE (81, 83, ETC.)
XC WHICH OFFERS REINCARNATION; IF ACCEPTED, THIS RESULTS IN MESSAGE 82, 84,
XC ETC. THE LAST TIME, IF HE WANTS ANOTHER CHANCE, HE GETS A SNIDE REMARK AS
XC WE EXIT. WHEN REINCARNATED, ALL OBJECTS BEING CARRIED GET DROPPED AT OLDLC2
XC (PRESUMABLY THE LAST PLACE PRIOR TO BEING KILLED) WITHOUT CHANGE OF PROPS.
XC THE LOOP RUNS BACKWARDS TO ASSURE THAT THE BIRD IS DROPPED BEFORE THE CAGE.
XC (THIS KLUGE COULD BE CHANGED ONCE WE'RE SURE ALL REFERENCES TO BIRD AND CAGE
XC ARE DONE BY KEYWORDS.) THE LAMP IS A SPECIAL CASE (IT WOULDN'T DO TO LEAVE
XC IT IN THE CAVE). IT IS TURNED OFF AND LEFT OUTSIDE THE BUILDING (ONLY IF HE
XC WAS CARRYING IT, OF COURSE). HE HIMSELF IS LEFT INSIDE THE BUILDING (AND
XC HEAVEN HELP HIM IF HE TRIES TO XYZZY BACK INTO THE CAVE WITHOUT THE LAMP!).
XC OLDLOC IS ZAPPED SO HE CAN'T JUST "RETREAT".
X
XC THE EASIEST WAY TO GET KILLED IS TO FALL INTO A PIT IN PITCH DARKNESS.
X
X94000 CALL RSPEAK(23)
X OLDLC2=LOC
X
XC OKAY, HE'S DEAD. LET'S GET ON WITH IT.
X
X94100 IF(CLOSNG)GOTO 94500
X YEA=YES(81+NUMDIE*2,82+NUMDIE*2,54)
X NUMDIE=NUMDIE+1
X IF(NUMDIE.EQ.MAXDIE.OR..NOT.YEA)GOTO 95000
X IF(CHASE.EQ.0)GOTO 94160
X
XC CHAMP WAS BEING CHASED BY WUMPUS, & DIED ANOTHER WAY.
XC PUT WUMPUS BACK TO SLEEP, IN CASE OUR HERO STILL HASN'T GOT THE CLOAK.
X CHASE=0
X PROP(WUMPUS)=0
X CALL MOVE(WUMPUS,174)
X94160 IF(TOTING(LAMP))PROP(LAMP)=0
X DO 94200 J=1,MAXOBJ
X IF(.NOT.HOLDNG(J))GOTO 94200
X LOC=OLDLC2
X IF(J.EQ.LAMP)LOC=1
X CALL DROP(J,LOC)
X IF(.NOT.WEARNG(J))GOTO 94200
X PROP(J)=0
X CALL BITOFF(J,WEARBT)
X94200 CONTINUE
X LOC=3
X OLDLOC=LOC
X WDX=0
X WORDS(1)=0
X CALL CLRLIN
X HEALTH=100
X GOTO 2000
X
XC HE DIED DURING CLOSING TIME. NO RESURRECTION. TALLY UP A DEATH AND EXIT.
X
X94500 CALL RSPEAK(131)
X NUMDIE=NUMDIE+1
X GOTO 95000
XC IT'S OVER. TALLY SCORE.
X
X95000 CALL RATING(SCORE,MXSCOR,BONUS,GAVEUP,SCORNG,CLOSNG,CLOSED)
X
XC THAT SHOULD BE GOOD ENOUGH. LET'S TELL HIM ALL ABOUT IT.
X
X CALL LOG(SCORE,TURNS,NUMDIE)
X
X PRINT 95100,SCORE,MXSCOR,TURNS
X95100 FORMAT(///' You scored',I4,' out of a possible',I4,
X 1 ', using',I5,' turns.')
X
X DO 95200 I=1,CLSSES
X IF(CVAL(I).GE.SCORE)GOTO 95210
X95200 CONTINUE
X PRINT 95202
X95202 FORMAT(/' You just went off my scale!!'/)
X GOTO 98000
X
X95210 CALL SPEAK(CTEXT(I))
X IF(I.EQ.CLSSES-1)GOTO 95220
X K=CVAL(I)+1-SCORE
X KK='s.'
X IF(K.EQ.1)KK='. '
X PRINT 95212,K,KK
X95212 FORMAT(/' To achieve the next higher rating, you need',I3,
X 1 ' more point',A2/)
X GOTO 98000
X
X95220 PRINT 95222
X95222 FORMAT(/' To achieve the next higher rating ',
X 1 'would be a neat trick!'//' CONGRATULATIONS!!'/)
X
XC98000 STOP
X98000 STOP
X
X END
END_OF_FILE
if test 31534 -ne `wc -c <'main.f.3'`; then
echo shar: \"'main.f.3'\" unpacked with wrong size!
fi
# end of 'main.f.3'
fi
if test -f 'maint.f' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'maint.f'\"
else
echo shar: Extracting \"'maint.f'\" \(1756 characters\)
sed "s/^X//" >'maint.f' <<'END_OF_FILE'
XC*** MAINT
X
X SUBROUTINE MAINT
X
XC SOMEONE SAID THE MAGIC WORD TO INVOKE MAINTENANCE MODE. MAKE SURE HE'S A
XC WIZARD. IF SO, LET HIM TWEAK ALL SORTS OF RANDOM THINGS, THEN EXIT SO CAN
XC SAVE TWEAKED VERSION. SINCE MAGIC WORD MUST BE FIRST COMMAND GIVEN, ONLY
XC THING WHICH NEEDS TO BE FIXED UP IS ABB(1).
X
X IMPLICIT INTEGER(A-Z)
X LOGICAL YESM,BLKLIN,WIZARD
X DIMENSION HNAME(10)
X COMMON /BLKCOM/ BLKLIN
X INTEGER*4 LTEXT,STEXT
X COMMON /LTXCOM/ LTEXT(250),STEXT(250),KEY(250),ABB(250),LOCSIZ
X INTEGER*4 WKDAY,WKEND,HOLID
X DOUBLE PRECISION MAGIC,Y,WD
X COMMON /WIZCOM/ WKDAY,WKEND,HOLID,HBEGIN,HEND,HNAME,
X 1 SHORT,MAGIC,MAGNM,LATNCY,SAVED,SAVET,SETUP
X
X IF(.NOT.WIZARD(.TRUE.))RETURN
X BLKLIN=.FALSE.
X IF(YESM(10,0,0))CALL HOURS
X IF(YESM(11,0,0))CALL NEWHRS
X IF(.NOT.YESM(26,0,0))GOTO 10
X CALL MSPEAK(27)
X READ(1,1)HBEGIN
X1 FORMAT(I4)
X CALL MSPEAK(28)
X READ(1,1)HEND
X CALL DATIME(D,T)
X HBEGIN=HBEGIN+D
X HEND=HBEGIN+HEND-1
X CALL MSPEAK(29)
X READ(1,2)HNAME
X2 FORMAT(10A2)
X10 PRINT 12,SHORT
X12 FORMAT(' LENGTH OF SHORT GAME (NULL TO LEAVE AT',I3,'):')
X READ(1,1)X
X IF(X.GT.0)SHORT=X
X CALL MSPEAK(12)
X CALL GETIN(WD,Y,Y,Y)
X IF(WD.NE.' ')MAGIC=WD
X CALL MSPEAK(13)
X READ(1,1)X
X IF(X.GT.0)MAGNM=X
X PRINT 16,LATNCY
X16 FORMAT(' LATENCY FOR RESTART (NULL TO LEAVE AT',I3,'):')
X READ(1,1)X
X IF(X.GT.0.AND.X.LT.45)CALL MSPEAK(30)
X IF(X.GT.0)LATNCY=MAX0(45,X)
X IF(YESM(14,0,0))CALL MOTD(.TRUE.)
X SAVED=0
X SETUP=2
X ABB(1)=0
X CALL MSPEAK(15)
X BLKLIN=.TRUE.
X CALL CIAO
X END
END_OF_FILE
if test 1756 -ne `wc -c <'maint.f'`; then
echo shar: \"'maint.f'\" unpacked with wrong size!
fi
# end of 'maint.f'
fi
echo shar: End of archive 6 \(of 8\).
cp /dev/null ark6isdone
MISSING=""
for I in 1 2 3 4 5 6 7 8 ; do
if test ! -f ark${I}isdone ; then
MISSING="${MISSING} ${I}"
fi
done
if test "${MISSING}" = "" ; then
echo You have unpacked all 8 archives.
rm -f ark[1-9]isdone
else
echo You still need to unpack the following archives:
echo " " ${MISSING}
fi
## End of shell archive.
exit 0