C THIS IS THE FIRST LINE OF ADVENTURE, MAIN MODULE.
SUBROUTINE AMAIN
C CURRENT LIMITS:
C 20000 WORDS OF MESSAGE TEXT (LINES, LINSIZ).
C 1600 TRAVEL OPTIONS (TRAVEL, TRVSIZ).
C 600 VOCABULARY WORDS (KTAB, ATAB, TABSIZ).
C 250 LOCATIONS (LTEXT, STEXT, KEY, LOCCON, ABB, ATLOC,
C LOCSIZ, MAXLOC).
C 150 OBJECTS (PLAC, PLACE, FIXD, FIXED, LINK (TWICE), PTEXT, POINTS,
C HOLDER, HLINK, OBJCND, OBJCON, PROP, WEIGHT, MAXOBJ).
C 60 "ACTION" VERBS (ACTSPK, VRBSIZ, VKEY).
C 300 VERB/PREP/OBJ COMBINATIONS (PTAB, PTBSIZ).
C 50 ADJECTIVES (ADJKEY, ADJSIZ)
C 150 MODIFIED NOUNS (ADJTAB, MAXOBJ)
C 400 RANDOM MESSAGES (RTEXT, RTXSIZ).
C 12 DIFFERENT PLAYER CLASSIFICATIONS (CTEXT, CVAL, CLSMAX).
C 20 HINTS, LESS 3 (HINTLC, HINTED, HINTS, HNTSIZ, HNTMIN).
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 OF ANY CLASS.) THESE UPPER
C LIMITS ARE:
C 1000 NON-SYNONYMOUS VOCABULARY WORDS OF EACH CLASS. CURRENTLY DEFINED
C CLASSES ARE:
C 1. MOTION/DIRECTION WORDS (EAST, WEST, UP, JUMP, ETC.)
C 2. NOUNS/OBJECTS (LAMP, KEYS, TROLL, ETC.)
C 3. ACTION VERBS, TRANSITIVE & INTRANSITIVE (TAKE, DROP, KILL, IN
C 4. MISCELLANEOUS WORDS; MOSTLY THINGS OR ACTIONS WHICH GENERATE
C FIXED REPLIES (FEE-FIE-FOE-FOO, TREE, CAVE, CURSES)
C 5. PREPOSITIONS, DUPLICATES MANY WORDS IN SECTION 1.
C 6. ADJECTIVES
C 7. CONJUNCTIONS
C 450 LOCATIONS
C 100 OBJECTS WHICH CAN BE USED IN TRAVEL TABLE (PLUS 900 MORE, WHICH CAN'
C DESCRIPTION OF THE DATABASE FORMAT
C
C
C THE DATA FILE CONTAINS SEVERAL SECTIONS. EACH BEGINS WITH A LINE CONTAINING
C A NUMBER IDENTIFYING THE SECTION, AND ENDS WITH A LINE CONTAINING "-1".
C
C SECTION 1: LONG FORM DESCRIPTIONS. EACH LINE CONTAINS A LOCATION NUMBER,
C A TAB, AND A LINE OF TEXT. THE SET OF (NECESSARILY ADJACENT) LINES
C WHOSE NUMBERS ARE X FORM THE LONG DESCRIPTION OF LOCATION X.
C
C SECTION 2: SHORT FORM DESCRIPTIONS. SAME FORMAT AS LONG FORM. NOT ALL
C PLACES HAVE SHORT DESCRIPTIONS.
C
C SECTION 3: VOCABULARY. EACH LINE CONTAINS A NUMBER (N), A TAB, AND A
C FIVE-LETTER WORD. CALL M=N/1000. IF M=0, THEN THE WORD IS A MOTION
C VERB FOR USE IN TRAVELLING (SEE SECTION 4). ELSE, IF M=1, THE WORD IS
C AN OBJECT. ELSE, IF M=2, THE WORD IS AN ACTION VERB (SUCH AS "CARRY"
C OR "ATTACK"). ELSE, IF M=3, THE WORD IS A SPECIAL CASE VERB (SUCH AS
C "DIG") AND N MOD 1000 IS AN INDEX INTO SECTION 6. OBJECTS FROM 50 TO
C (CURRENTLY, ANYWAY) 79 ARE CONSIDERED TREASURES (FOR PIRATE, CLOSEOUT).
C
C SECTION 4: TRAVEL TABLE. EACH LINE CONTAINS A LOCATION NUMBER (X), A SECOND
C LOCATION NUMBER (Y), AND A LIST OF MOTION VERBS (SEE SECTION 3).
C EACH MOTION REPRESENTS A VERB WHICH WILL GO TO Y IF CURRENTLY AT X.
C Y, IN TURN, IS INTERPRETED AS FOLLOWS. LET M=Y/1000, N=Y MOD 1000.
C IF N<=MAXLOC IT IS THE LOCATION TO GO TO.
C IF MAXLOC<N<=500 N-MAXLOC IS USED IN A COMPUTED GOTO
C TO A SECTION OF SPECIAL CODE.
C IF N>500 MESSAGE N-500 FROM SECTION 6 IS PRINTED,
C AND HE STAYS WHEREVER HE IS.
C MEANWHILE, M SPECIFIES THE CONDITIONS ON THE MOTION.
C IF M=0 IT'S UNCONDITIONAL.
C IF 0<M<100 IT IS DONE WITH M% PROBABILITY.
C IF M=100 UNCONDITIONAL, BUT FORBIDDEN TO DWARVES.
C IF 100<M<=200 HE MUST BE CARRYING OBJECT M-100.
C IF 200<M<=300 MUST BE CARRYING OR IN SAME ROOM AS M-200.
C IF 300<M<=400 PROP(M MOD 100) MUST *NOT* BE 0.
C IF 400<M<=500 PROP(M MOD 100) MUST *NOT* BE 1.
C IF 500<M<=600 PROP(M MOD 100) MUST *NOT* BE 2, ETC.
C IF THE CONDITION (IF ANY) IS NOT MET, THEN THE NEXT *DIFFERENT*
C "DESTINATION" VALUE IS USED (UNLESS IT FAILS TO MEET *ITS* CONDITIONS,
C IN WHICH CASE THE NEXT IS FOUND, ETC.). TYPICALLY, THE NEXT DEST WILL
C BE FOR ONE OF THE SAME VERBS, SO THAT ITS ONLY USE IS AS THE ALTERNATE
C DESTINATION FOR THOSE VERBS. FOR INSTANCE:
C 15 110022 29 31 34 35 23 43
C 15 14 29
C THIS SAYS THAT, FROM LOC 15, ANY OF THE VERBS 29, 31, ETC., WILL TAKE
C HIM TO 22 IF HE'S CARRYING OBJECT 10, AND OTHERWISE WILL GO TO 14.
C 11 303008 49
C 11 9 50
C THIS SAYS THAT, FROM 11, 49 TAKES HIM TO 8 UNLESS PROP(3)=0, IN WHICH
C CASE HE GOES TO 9. VERB 50 TAKES HIM TO 9 REGARDLESS OF PROP(3).
C (SEE DESCRIPTION FOR SECTION 14 FOR A SCHEMATIC OF TABLES.)
C
C SECTION 5: OBJECT DESCRIPTIONS. EACH LINE CONTAINS A NUMBER (N), A TAB,
C AND A MESSAGE. IF N IS FROM 1 TO MAXOBJ, THE MESSAGE IS THE "INVENTORY"
C MESSAGE FOR OBJECT N. OTHERWISE, N SHOULD BE 0000, 1000, 2000, ETC., AN
C THE MESSAGE SHOULD BE THE DESCRIPTION OF THE PRECEDING OBJECT WHEN ITS
C PROP VALUE IS N/1000. THE N/1000 IS USED ONLY TO DISTINGUISH MULTIPLE
C MESSAGES FROM MULTI-LINE MESSAGES; THE PROP INFO ACTUALLY REQUIRES ALL
C MESSAGES FOR AN OBJECT TO BE PRESENT AND CONSECUTIVE. PROPERTIES WHICH
C PRODUCE NO MESSAGE SHOULD BE GIVEN THE MESSAGE ">$<". NOTE THAT
C OBJECTS WITH N>100 CANNOT BE USED FOR CONDITIONAL MOTIONS IN
C TRAVEL TABLE.
C
C SECTION 6: ARBITRARY MESSAGES. SAME FORMAT AS SECTIONS 1, 2, AND 5, EXCEPT
C THE NUMBERS BEAR NO RELATION TO ANYTHING (EXCEPT FOR SPECIAL VERBS
C IN SECTION 3).
C
C SECTION 7: CONTAINS LOTS OF OBJECT INFO:
C (1) OBJECT LOCATIONS & WEIGHTS. EACH LINE CONTAINS AN OBJECT NUMBER
C AND ITS INITIAL LOCATION (ZERO (OR OMITTED) IF NONE). IF THE OBJECT IS
C IMMOVABLE, THE LOCATION IS FOLLOWED BY A "-1". IF IT HAS TWO LOCATIONS
C (E.G. THE GRATE) THE FIRST LOCATION IS FOLLOWED WITH THE SECOND, AND
C THE OBJECT IS ASSUMED TO BE IMMOVABLE. IF THE OBJECT IS MOVABLE, IT
C HAS A THIRD NUMBER WHICH IS ITS RELATIVE WEIGHT.
C (2) DEFAULT OBJECT NAMES. TEN CHARACTER MAXIMUM, TO PERMIT PRINTING
C OBJECT NAMES WHEN HERO SAYS 'TAKE ALL' OR SUCH.
C (3) POINTS. OBJECT NUMBER, A SCORE
C VALUE, A PROP VALUE, AND A LOCATION NUMBER. THE SCORE IS
C FOR LEAVING IT AT THE NAMED LOCATION WITH THE RIGHT PROP VALUE.
C SCORES ARE ASSIGNED ON A DIFFICULTY SCALE OF 1-5 (1 IS
C FOR EASY TREASURES; 5 IS FOR REAL HARD ONES), AND ARE MULTIPLIED
C BY SOME APPROPRIATE FACTOR AT SCORING TIME.
C
C SECTION 8: ACTION DEFAULTS. EACH LINE CONTAINS AN "ACTION-VERB" NUMBER AND
C THE INDEX (IN SECTION 6) OF THE DEFAULT MESSAGE FOR THE VERB.
C
C SECTION 9: LIQUID ASSETS, ETC. EACH LINE CONTAINS A NUMBER (N) AND UP TO 20
C LOCATION NUMBERS. BIT N (WHERE 0 IS THE UNITS BIT) IS SET IN LOCCON(LOC
C FOR EACH LOC GIVEN. THE COND BITS CURRENTLY ASSIGNED ARE:
C 0 LIGHT
C 1 IF BIT 3 IS ON: ON FOR OIL, OFF FOR WATER
C 2 IF BIT 3 IS ON: ON FOR WINE, OFF FOR WATER & OIL
C 3 LIQUID ASSET, SEE BITS 1 & 2
C 4 PIRATE DOESN'T GO HERE UNLESS FOLLOWING PLAYER
C 5 ALL LOCATIONS IN EITHER 'PORTAL'; I.E., NOT OUTSIDE
C CAVE, BUT NOT FAR IN
C 6 ALL LOCATIONS OUTSIDE THE CAVE
C OTHER BITS ARE USED TO INDICATE AREAS OF INTEREST TO "HINT" ROUTINES:
C 7 LOST IN MAZE
C 8 PONDERING DARK ROOM
C 9 AT WITT'S END
C 10 TRYING TO EXTRACT SWORD
C 11 TRYING TO GO UP SLIDE
C 12 TRYING TO GET INTO CAVE VIA SEA ENTRANCE
C 13 TRYING TO FIND CAVE (ANY ENTRANCE)
C 14 TRYING TO CATCH BIRD
C 15 TRYING TO GET OVER THE RAINBOW
C 16 STYMIED BY DOG
C 17 TRYING TO DEAL WITH SNAKE
C LOCCON(LOC) IS SET TO 2, OVERRIDING ALL OTHER BITS, IF LOC HAS FORCED
C MOTION.
C
C SECTION 10: CLASS MESSAGES. EACH LINE CONTAINS A NUMBER (N), A TAB, AND A
C MESSAGE DESCRIBING A CLASSIFICATION OF PLAYER. THE SCORING SECTION
C SELECTS THE APPROPRIATE MESSAGE, WHERE EACH MESSAGE IS CONSIDERED TO
C APPLY TO PLAYERS WHOSE SCORES ARE HIGHER THAN THE PREVIOUS N BUT NOT
C HIGHER THAN THIS N. NOTE THAT THESE SCORES PROBABLY CHANGE WITH EVERY
C MODIFICATION (AND PARTICULARLY EXPANSION) OF THE PROGRAM.
C
C SECTION 11: HINTS. EACH LINE CONTAINS A HINT NUMBER (CORRESPONDING TO A
C COND BIT, SEE SECTION 9), THE NUMBER OF TURNS HE MUST BE AT THE RIGHT
C LOC(S) BEFORE TRIGGERING THE HINT, THE POINTS DEDUCTED FOR TAKING THE
C HINT, THE MESSAGE NUMBER (SECTION 6) OF THE QUESTION, AND THE MESSAGE
C NUMBER OF THE HINT. THESE VALUES ARE STASHED IN THE "HINTS" ARRAY.
C HNTMAX IS SET TO THE MAX HINT NUMBER (<= HNTSIZ). NUMBERS 1-6 ARE
C UNUSABLE SINCE COND BITS ARE OTHERWISE ASSIGNED, SO 2 IS USED TO
C REMEMBER IF HE'S READ THE CLUE IN THE REPOSITORY, AND 3 IS USED TO
C REMEMBER WHETHER HE ASKED FOR INSTRUCTIONS (GETS MORE TURNS, BUT LOSES
C POINTS). HNTMIN IS SET TO THE NUMBER OF THE FIRST USABLE HINT.
C
C SECTION 12: MAGIC MESSAGES. IDENTICAL TO SECTION 6 EXCEPT PUT IN A SEPARATE
C SECTION FOR EASIER REFERENCE. MAGIC MESSAGES ARE USED BY THE STARTUP,
C MAINTENANCE MODE, AND RELATED ROUTINES.
C
C SECTION 14: PREPOSITION TABLE. EACH LINE CONTAINS A VERB, A PREPOSITION
C AND VALID OBJECTS FOR THAT VERB/PREP COMBINATION. THEY ARE CONVERTED
C INTO TWO TABLES SIMILAR IN FORMAT TO THE TRAVEL TABLE. THE FIRST
C TABLE, VKEY, HAS ONE ENTRY PER VERB. A ZERO ENTRY INDICATES NO
C PREPOSITION IS VALID WITH THAT VERB. A NON-ZERO ENTRY POINTS TO THE
C BEGINNING OF THE PREP/OBJ LIST FOR THAT VERB. THE POSITION OF THE
C ENTRY IN VKEY CORRESPONDS TO THE VERB NUMBER. THE PREP/OBJ LIST,
C PTAB, FOR A GIVEN VERB CONSISTS OF A SERIES OF ONE-WORD ENTRIES
C DELIMITED BY A NEGATIVE ENTRY. EACH WORD CONTAINS THE PREPOSITION
C NUMBER TIMES 1000 PLUS THE NUMBER OF A VALID OBJECT. A SCHEMATIC
C FOLLOWS. ENTRIES IN VKEY ARE REPRESENTED BY V1, V2, ... VN.
C ENTRIES IN PTAB ARE REPRESENTED BY P1, P2, ..., PN (PREPOSITIONS),
C AND OB1, OB2,..., OBN (OBJECTS).
C
C I VKEY(I) PTAB(J) J
C - ------- ------- -
C 1. V1==========>> P1,OB1 1.
C P1,OB2 2.
C P1,OB3 3.
C P1,OB4 4.
C P1,OB5 5.
C P2,OB1 6.
C P2,OB2 7.
C P3,OB1 8.
C P3,OB2 9.
C P3,OB3 10.
C -P3,OB4 11.
C 2. V2==========>> P1,OB1 12.
C P1,OB2 13.
C P2,OB1 14.
C -P3,OB1 15.
C 3. 0 (THE VERB CORRESPONDING TO THIS POSITION TAKES NO PREPOSITION
C 4. V3==========>> P1,OB1 16.
C -P2,OB1 17.
C
C SECTION 15: OBJECT ATTRIBUTES. EACH LINE CONTAINS A BIT NUMBER AND
C UP TO 20 OBJECT NUMBERS. BIT N (WHERE ZERO IS THE UNITS BIT) IS SET
C IN OBJCON(OBJ) FOR EACH OBJECT GIVEN. THE BITS CURRENTLY ASSIGNED
C ARE:
C 1 THE OBJ CAN BE OPENED/CLOSED. (DOORS, GRATE, CLAM, ETC.)
C 2 THE OBJ IS CURRENTLY OPEN.
C 3 IT HAS A LOCK. (GRATE, CHAIN, ELFIN DOOR, ETC.)
C 4 IT IS CURRENTLY LOCKED.
C 5 FLAMMABLE. (IT WILL BURN IF IGNITED.)
C 6 IT IS CURRENTLY BURNING.
C 7 EDIBLE. FOOD, MUSHROOMS, ETC.
C 8 PRINTED MATERIAL, ANYTHING READABLE
C 9 A LIVING BEASTIE, E.G., DWARF, DOG, WUMPUS, ETC.
C 10 DEAD (KILLED) BEASTIE: WUMPUS, DRAGON, SLEEPING DOG
C 11 CAN BE WORN: CROWN, SHOES, CLOAK, JEWELS
C 12 IS CURRENTLY BEING WORN
C 13 REQUIRES PLURAL RESPONSES (SHOES, COINS, ETC.)
C 14 TREASURE.
C 15 CONTAINER.
C 16 OBJECT IS "SMALL". (CAN FIT INTO SACK OR CHEST)
C 17 CONTAINER IS OPAQUE -- CONTENTS ARE NOT VISIBLE UNLESS
C CONTAINER IS OPEN.
C
C SECTION 16: ADJECTIVE/NOUN LIST. EACH VALID ADJECTIVE IS FOLLOWED BY
C ALL NOUNS WHICH IT MAY MODIFY.
C
C SECTION 0: END OF DATABASE.
IMPLICIT INTEGER(A-Z)
INCLUDE 'config.f'
LOGICAL DSEEN,BLKLIN,HINTED,YES,START,TERSE,ISWIZ,LOGOUT
LOGICAL WZDARK,KILLED,RDFLAG,LIVING
! Whether there is a prompt or not:
LOGICAL PROMPT
INTEGER*4 BITS,TRAVEL,POINTS,OBJCND,LOCCON,STEXT,RTEXT,MTEXT
C INTEGER*4 LINUSE,KK,LINSIZ,K1,PTAB,WKDAY,WKEND,HOLID,LTEXT
INTEGER*4 LINUSE,LINSIZ,K1,PTAB,WKDAY,WKEND,HOLID,LTEXT
CHARACTER*4 KK2
INTEGER*4 KK
C INTEGER*4 PTEXT,OBJCON,J12,JL1,JL2,JKK,JK1,LINES,JNEW,RETN,CTEXT
INTEGER*4 PTEXT,OBJCON,J12,JL1,JL2,JK1,JNEW,RETN,CTEXT
C CHARACTER*4 JKK
CHARACTER*4 LINES
INTEGER*4 JKK, ILINES
COMMON /COMTXT/ ILINES(25000) !THIS IS BECOUSE LINES IS NOW CHARACTER STUFF
C I WILL HAVE TO CHECK OTHER STUFF THAT USE IT (/TXTCOM/) SUCH AS MSPEAK
C DOUBLE PRECISION DTK(9),ATAB,NTXT,DJJ,DK,DKK,DL,DLL
CHARACTER*8 DTK(9), ATAB, NTXT, DJJ, DK, DKK, DL, DLL
C DOUBLE PRECISION VTXT,OTXT,IOTXT,MAGIC,TXT
CHARACTER*8 VTXT, OTXT, IOTXT, MAGIC, TXT
COMMON/IZWIZ/ISWIZ
INTEGER*4 MESSGS
COMMON/LNKCOM/ACTIVE(32),USER(15,32),MESSGS(32),MONITO(32),
1 TEXT(70,32)
LOGICAL ACTIVE
COMMON /MYRCOM/ PROMPT
COMMON /ADJCOM/ ADJKEY(50),ADJTAB(150),ADJSIZ
COMMON /ALLCOM/ NTXT(150,2)
COMMON /BITCOM/ OPENBT,LOCKBT,BURNBT,WEARBT
COMMON /BLKCOM/ BLKLIN
COMMON /CONCOM/ LOCCON(250),OBJCON(150)
COMMON /DIECOM/ NUMDIE,MAXDIE,TURNS
COMMON /DWFCOM/ DWARF,KNIFE,KNFLOC,DFLAG,DSEEN(6),DLOC(6),
1 ODLOC(6),DWFMAX
COMMON /HLDCOM/ HOLDER(150),HLINK(150)
COMMON /HNTCOM/ HINTLC(20),HINTED(20),HINTS(20,4),HNTSIZ,HNTMIN,
$ HTNMAX
COMMON /LIQCOM/ BOTTLE,CASK,WATER,OIL,WINE,LIQTYP(5)
COMMON /LOCCOM/ LOC,OLDLOC,OLDLC2,NEWLOC,MAXLOC
COMMON /MNECOM/ BACK,CAVE,DPRSSN,ENTRNC,XIT,GO,LOOK,NULL,
1 AXE,BEAR,BOAT,BOOK,BOOK2,BOOTH,CARVNG,CHASM,CHASM2,DOOR,GNOME,
2 GRATE,LAMP,PDOOR,PLANT,PLANT2,ROCKS,ROD,ROD2,SAFE,
3 TDOOR,TDOOR2,TROLL,TROLL2,EMRALD,SPICES,
4 FIND,YELL,INVENT,LEAVE,POUR,SAY,TAKE,THROW,
5 KILLED,IWEST,PHUCE(2,4),TK(20)
C COMMON /COMMNE/ BACK,CAVE,DPRSSN,ENTRNC,XIT,GO,LOOK,NULL,
C 1 AXE,BEAR,BOAT,BOOK,BOOK2,BOOTH,CARVNG,CHASM,CHASM2,DOOR,GNOME,
C 2 GRATE,LAMP,PDOOR,PLANT,PLANT2,ROCKS,ROD,ROD2,SAFE,
C 3 TDOOR,TDOOR2,TROLL,TROLL2,EMRALD,SPICES,
C 4 FIND,YELL,INVENT,LEAVE,POUR,SAY,TAKE,THROW,
C 5 KILLED,IWEST,PHUCE(2,4),TK(20)
COMMON /LTXCOM/ LTEXT(250),STEXT(250),KEY(250),ABB(250),LOCSIZ
COMMON /OBJCOM/ PLAC(150),FIXD(150),WEIGHT(150),PROP(150),
1 POINTS(150)
COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150),
1 FIXED(150),MAXOBJ
COMMON /PRPCOM/ VKEY(60),PTAB(300),VKYSIZ,PTBSIZ
COMMON /TRVCOM/ TRAVEL(1600)
COMMON /TXTCOM/ LINES(25000),RTEXT(400),PTEXT(150),MTEXT(45)
COMMON /UTXCOM/ TXT(35,2),WDX
COMMON /VOCCOM/ KTAB(600),ATAB(600),TABSIZ
COMMON /WIZCOM/ WKDAY,WKEND,HOLID,HBEGIN,HEND,HNAME,
1 SHORT,MAGIC,MAGNM,LATNCY,SAVED,SAVET,SETUP
COMMON /WRDCOM/ VERBS(45),VTXT(45,2),VRBX,OBJS(45),OTXT(45,2),
1 OBJX,IOBJS(15),IOTXT(15,2),IOBX,PREP,WORDS(45)
DIMENSION OBJCND(150),ACTSPK(60),CTEXT(12),CVAL(12)
DIMENSION HNAME(10)
LOGICAL AJAR,AT,ATHAND,BITSET,BLIND,CLOSED,CLOSNG,
1 DARK,DEAD,DEMO,EDIBLE,ENCLSD,FORCED,
2 GAVEUP,HERE,HINGED,HOLDNG,INSIDE,LMWARN,LOCKS,OUTSID,OPAQUE,
3 PANIC,PCT,PLURAL,PORTAL,PRINTD,SCORNG,SMALL,
4 TOTING,TREASR,LOCKED,VESSEL,WEARNG,WORN,YEA,
5 YESM
DATA LINSIZ/25000/,TRVSIZ/1600/,TABSIZ/600/,LOCSIZ/250/,
1 VRBSIZ/60/,RTXSIZ/400/,CLSMAX/12/,HNTSIZ/20/,MAGSIZ/45/,
2 MAXOBJ/150/,MAXLOC/300/,HNTMIN/7/,PTBSIZ/300/,ADJSIZ/50/,
3 VKYSIZ/60/,SETUP/0/,BLKLIN/.TRUE./,DWFMAX/6/,ISWIZ/.FALSE./
! DATA PROMPT/.FALSE./
DATA OBJCND/150*0/,LINUSE/0/
C PHUCE CONSISTS OF FOUR PAIRS OF ORIGIN/DESTINATION LOCATIONS FROM/TO
C WHICH ONE IS TRANSPORTED ON UTTERING THE ELFIN CURSE AT THE TINY
C DOOR. HE CAN GO FROM BIG TO SMALL OR SMALL TO BIG, ON EITHER SIDE OF
C THE DOOR.
DATA PHUCE/158,160,160,158,167,166,166,167/
DATA POUR /13/ !PUTTING THIS HERE, FROM GETWDS.F--MV
C DATA PHROG/'PH','RO','GS'/
C BITS(N) IS A ONE-BIT IN POSITION N, WHERE THE RIGHTMOST BIT IS BIT ZERO.
C DATA BITS/
C 1 1,2,4,8,16,32,64,128,256,512,1024,2048,
C 2 :10000,:20000,:40000,
C 3 :100000,:200000,:400000,
C 4 :1000000,:2000000,:4000000,
C 5 :10000000,:20000000,:40000000,
C 6 :100000000,:200000000,:400000000,
C 7 :1000000000,:2000000000,:4000000000,
C 8 :10000000000,:20000000000,:40000000000,
C 9 :100000000000,:200000000000,:400000000000/
DATA DEADBT,OPENBT,LOCKBT,BURNBT,WEARBT /10,2,4,6,12/
C STATEMENT FUNCTIONS
C
C
C AJAR(OBJ = TRUE IF THE OBJECT IS OPEN
C AT(OBJ) = TRUE IF ON EITHER SIDE OF TWO-PLACED OBJECT
C ATHAND(OBJ) = TRUE IF OBJECT IS HERE AND NOT IN CLOSED CONTAINER.
C BITSET(COND,L,N) = TRUE IF COND(L) HAS BIT N SET (BIT 0 IS UNITS BIT)
C BLIND(DUMMY) = TRUE IF HERO CAN'T SEE (TOO DARK OR GLAREY)
C DARK(DUMMY) = TRUE IF LOCATION "LOC" IS DARK
C DEAD(OBJ) = TRUE IF CRITTER IS KILLED (OR IN ENCHANTED SLEEP)
C FORCED(LOC) = TRUE IF LOC MOVES WITHOUT ASKING FOR INPUT (COND=2)
C HERE(OBJ) = TRUE IF THE OBJ IS AT "LOC" (OR IS BEING CARRIED)
C HINGED(OBJ) = TRUE IF OBJECT CAN BE OPENED/SHUT.
C INSIDE(LOC) = TRUE IF LOCATION IS WELL WITHIN THE CAVE
C LIQ(DUMMY) = OBJECT NUMBER OF LIQUID IN BOTTLE
C LIQLOC(LOC) = OBJECT NUMBER OF LIQUID (IF ANY) AT LOC
C LIVING(OBJ) = TRUE IF OBJ IS SOME SORT OF CRITTER
C LOCKED(OBJ) = TRUE IF OBJECT IS LOCKED. (NEED NOT HAVE A LOCK,
C E.G., RUSTY DOOR)
C LOCKS(OBJ) = TRUE IF OBJECT HAS A LOCK.
C OPAQUE(OBJ) = TRUE IF CONTAINER IS NOT TRANSPARENT (SACK, CHEST)
C TRANSPARENT OBJS: BOTTLE(GLASS), CAGE(WICKER)
C OUTSID(LOC) = TRUE IF LOCATION IS OUTSIDE THE CAVE
C PCT(N) = TRUE N% OF THE TIME (N INTEGER FROM 0 TO 100)
C PLURAL(OBJ) = TRUE IF IT IS A PLURAL OBJ (SHOES, KEYS, ETC.)
C PORTAL(LOC) = TRUE IS LOCATION IS IN CAVE "ENTRANCE"
C PRINTD(OBJ) = TRUE IF OBJECT CAN BE READ.
C SMALL(OBJ) = TRUE IF OBJ FITS INTO SACK
C TOTING(OBJ) = TRUE IF THE OBJ IS BEING CARRIED
C TREASR(OBJ) = TRUE IF OBJECT IS A TREASURE
C VESSEL(OBJ) = TRUE IF OBJECT IS A CONTAINER
C WEARNG(OBJ) = TRUE IF OBJECT IS BEING WORN
C WORN(OBJ) = TRUE IF THE OBJECT CAN BE WORN
C
C CLOSED SAYS WHETHER WE'RE ALL THE WAY CLOSED
C CLOSNG SAYS WHETHER ITS CLOSING TIME YET
C DEMO IS TRUE IF THIS IS A PRIME-TIME DEMONSTRATION GAME
C GAVEUP SAYS WHETHER HE EXITED VIA "QUIT"
C LMWARN SAYS WHETHER HE'S BEEN WARNED ABOUT LAMP GOING DIM
C PANIC SAYS WHETHER HE'S FOUND OUT HE'S TRAPPED IN THE CAVE
C SCORNG INDICATES TO THE RATING ROUTINE WHETHER WE'RE DOING A "SCORE" COMMAND
C WZDARK SAYS WHETHER THE LOC HE'S LEAVING WAS DARK
C YEA IS RANDOM YES/NO REPLY
IF(SETUP.NE.0)GOTO 1200
PRINT 1000
1000 FORMAT(' INITIALISING...')
DO 10 I=1,32
10 ACTIVE(I)=.FALSE.
C CLEAR OUT THE VARIOUS TEXT-POINTER ARRAYS. ALL TEXT IS STORED IN ARRAY
C LINES; EACH LINE IS PRECEDED BY A WORD POINTING TO THE NEXT POINTER (I.E.
C THE WORD FOLLOWING THE END OF THE LINE). THE POINTER IS NEGATIVE IF THIS IS
C FIRST LINE OF A MESSAGE. THE TEXT-POINTER ARRAYS CONTAIN INDICES OF
C POINTER-WORDS IN LINES. STEXT(N) IS SHORT DESCRIPTION OF LOCATION N.
C LTEXT(N) IS LONG DESCRIPTION. PTEXT(N) POINTS TO MESSAGE FOR PROP( PROPN)=0
C SUCCESSIVE PROP MESSAGES ARE FOUND BY CHASING POINTERS. RTEXT CONTAINS
C SECTION 6'S STUFF. CTEXT(N) POINTS TO A PLAYER-CLASS MESSAGE. MTEXT IS FOR
C SECTION 12. WE ALSO CLEAR COND. SEE DESCRIPTION OF SECTION 9 FOR DETAILS.
DO 1001 I=1,MAXLOC
IF(I.LE.MAXOBJ)PTEXT(I)=0
IF(I.LE.RTXSIZ)RTEXT(I)=0
IF(I.LE.CLSMAX)CTEXT(I)=0
IF(I.LE.MAGSIZ)MTEXT(I)=0
IF(I.GT.LOCSIZ)GOTO 1001
STEXT(I)=0
LTEXT(I)=0
LOCCON(I)=0
1001 CONTINUE
C CALL SRCH$$(1,'ADVE.BASE',9,1,TYPE,CODE)
C I'M NOT SURE WHAT THE ABOVE LINE IS SUPPOSED TO DO? OPEN FILE?
! I added some file checks (myrkraverk):
IF(ACCESS(ADVTXT,'r').EQ.0)THEN
OPEN( UNIT=1, FILE=ADVTXT )
ELSE IF (ACCESS('adventure.text','r').EQ.0.) THEN
OPEN( UNIT=1, FILE='adventure.text' )
ELSE
PRINT *, 'I don''t know where ''adventure.text'' is'
STOP
END IF
SETUP=1
LINUSE=1
TRVS=1
PTBS=1
ATBS=1
CLSSES=1
C START NEW DATA SECTION. SECT IS THE SECTION NUMBER.
C1002 READ(5,1003)SECT
1002 READ(1,1003)SECT
1003 FORMAT(I8)
PRINT 1015,SECT
1015 FORMAT (' READING TABLE ',I2,'...')
OLDLOC=-1
GOTO(1190,1004,1004,1040,1030,1004,1004,1050,1060,1070,1004,
1 1080,1004,0999,1100,1120,1140),(SECT+1)
C (0) (1) (2) (3) (4) (5) (6) (7) (8) (9) (10)
C (11) (12) (13) (14) (15) (16)
999 CALL BUG(9)
C SECTIONS 1, 2, 5, 6, 10, 12. READ MESSAGES AND SET UP POINTERS.
1004 JL1=LINUSE+1
JL2=LINUSE+18
C READ(5,1005)LOC,(LINES(J12),J12=JL1,JL2),KK2
READ(1,1005)LOC,(LINES(J12),J12=JL1,JL2),KK2
C CHANGED KK TO KK2 ABOVE! MIGHT COUSE UNWANTED SIDE-FX M.V.
1005 FORMAT(I8,19A4)
IF(KK2.EQ.' ')GOTO 1017 !KK->KK2 BECOUSE OF ABOVE
PRINT 1016,LOC
1016 FORMAT (1X,'LINE FOR LOCN ',I4,' TOO LONG.')
CALL BUG(0)
1017 IF(LOC.EQ.-1)GOTO 1002
DO 1006 K=1,18
JKK=LINUSE+19-K
IF(LINES(JKK).NE.' ')GOTO 1007
1006 CONTINUE
IF(LOC.EQ.0)GOTO 1004
C ABOVE KLUGE IS TO AVOID F40 BUG IF CRLF BROKEN ACROSS RECORD BOUNDARY
CALL BUG(1)
1007 JL1=LINUSE+1
DO 1008 JK1=JL1,JKK
C1008 LINES(JK1)=XOR(LINES(JK1),'CLYD')
1008 LINES(JK1)=LINES(JK1)!????
C LINES(LINUSE)=JKK+1
ILINES(LINUSE)=JKK+1!DANGEROUS STUFF BUT WHAT CAN I DO? M.V.
IF(LOC.EQ.OLDLOC)GOTO 1020
IF(LOC.GT.OLDLOC.OR.SECT.EQ.5)GOTO 1019
PRINT 1018,LOC,SECT
1018 FORMAT (/' LINE ',I3,' OUT OF ORDER IN SECTION ',I2)
CALL BUG(10)
C1019 LINES(LINUSE)=-LINES(LINUSE)
1019 ILINES(LINUSE)=-ILINES(LINUSE)!THIS MOST DEFFINETLY HAS SERIOUS
IF(SECT.EQ.12)GOTO 1013 !SIDE-FX. HAVE TO DEBUG CAREFULLY!!!
IF(SECT.EQ.10)GOTO 1012 !--I THINK IT IS MOST UNIVERSALLY
IF(SECT.EQ.6)GOTO 1011 !FIXED NOW, MYRKRAVERK
IF(SECT.EQ.5)GOTO 1010
IF(SECT.EQ.1)GOTO 1009
STEXT(LOC)=LINUSE
GOTO 1020
1009 LTEXT(LOC)=LINUSE
GOTO 1020
1010 IF(LOC.GT.0.AND.LOC.LE.MAXOBJ)PTEXT(LOC)=LINUSE
GOTO 1020
1011 IF(LOC.GT.RTXSIZ)CALL BUG(6)
RTEXT(LOC)=LINUSE
GOTO 1020
1012 CTEXT(CLSSES)=LINUSE
CVAL(CLSSES)=LOC
CLSSES=CLSSES+1
GOTO 1020
1013 IF(LOC.GT.MAGSIZ)CALL BUG(6)
MTEXT(LOC)=LINUSE
1020 LINUSE=JKK+1
C LINES(LINUSE)=-1
ILINES(LINUSE)=-1
C THIS MOST DEFFINETLY CRIPPLES /TXTCOM/ ALOT AND RENDERS ALL STUFF THAT
C USES IT INCORRECT!!!!!!!!!!!!!
C MOST LIKELY UNIVERSALLY FIXED NOW, MYRKRAVERK
OLDLOC=LOC
IF(LINUSE+18.GT.LINSIZ)CALL BUG(2)
GOTO 1004
C THE STUFF FOR SECTION 4 IS ENCODED HERE. EACH "FROM-LOCATION" GETS A
C CONTIGUOUS SECTION OF THE "TRAVEL" ARRAY. EACH ENTRY IN TRAVEL IS
C NEWLOC*1000 + KEYWORD (FROM SECTION 3, MOTION VERBS), AND IS NEGATED IF
C THIS IS THE LAST ENTRY FOR THIS LOCATION. KEY(N) IS THE INDEX IN TRAVEL
C OF THE FIRST OPTION AT LOCATION N.
C1030 READ(5,1031)LOC,JNEW,(DTK(I),I=1,8)
1030 READ(1,1031)LOC,JNEW,(DTK(I),I=1,8)
1031 FORMAT(2I8,8(A6,2X))
IF(LOC.EQ.0)GOTO 1030
C ABOVE KLUGE IS TO AVOID AFOREMENTIONED F40 BUG
IF(LOC.EQ.-1)GOTO 1002
IF(LOC.GE.OLDLOC)GOTO 1032
PRINT 1018,LOC,SECT
CALL BUG(10)
1032 IF(KEY(LOC).NE.0)GOTO 1033
KEY(LOC)=TRVS
GOTO 1035
1033 TRAVEL(TRVS-1)=-TRAVEL(TRVS-1)
1035 DO 1037 L=1,8
IF(DTK(L).EQ.' ')GOTO 1039
K=VOCABX(DTK(L),-1)
TRAVEL(TRVS)=JNEW*1000+K
TRVS=TRVS+1
IF(TRVS.EQ.TRVSIZ)CALL BUG(3)
1037 CONTINUE
1039 TRAVEL(TRVS-1)=-TRAVEL(TRVS-1)
GOTO 1030
C HERE WE READ IN THE VOCABULARY. KTAB(N) IS THE WORD NUMBER, ATAB(N) IS
C THE CORRESPONDING WORD. THE -1 AT THE END OF SECTION 3 IS LEFT IN KTAB
C AS AN END-MARKER. THE WORDS ARE GIVEN A MINIMAL HASH TO MAKE READING THE
C CORE-IMAGE HARDER. NOTE THAT '/7-08' HAD BETTER NOT BE IN THE LIST, SINCE
C IT COULD HASH TO -1.
1040 DO 1042 TABNDX=1,TABSIZ
C1043 READ(5,1041)KTAB(TABNDX),ATAB(TABNDX)
1043 READ(1,1041)KTAB(TABNDX),ATAB(TABNDX)
1041 FORMAT(I8,A6)
IF(KTAB(TABNDX).EQ.0)GOTO 1043
C ABOVE KLUGE IS TO AVOID AFOREMENTIONED F40 BUG
IF(KTAB(TABNDX).EQ.-1)GOTO 1002
1042 CONTINUE
CALL BUG(4)
C READ IN THE INITIAL LOCATIONS FOR EACH OBJECT. ALSO THE IMMOVABILITY INFO.
C PLAC CONTAINS INITIAL LOCATIONS OF OBJECTS. FIXD IS -1 FOR IMMOVABLE
C OBJECTS (INCLUDING THE SNAKE), OR = SECOND LOC FOR TWO-PLACED OBJECTS.
C WEIGHT CONTAINS THE HEAVINESS OF EACH OBJ, ON A SCALE OF 1-10.
C1050 READ(5,1052) OBJ,J,K,KK,DL,DLL,(TK(I),I=1,3)
1050 READ(1,1052) OBJ,J,K,KK,DL,DLL,(TK(I),I=1,3)
1052 FORMAT(4I8,2(A6,2X),3I8)
IF(OBJ.EQ.-1)GOTO 1002
IF(OBJ.LE.0.OR.OBJ.GT.MAXOBJ)CALL BUG(17)
PLAC(OBJ)=J
FIXD(OBJ)=K
WEIGHT(OBJ)=KK
C READ DEFAULT OBJECT NAMES. FOR USE IN 'TAKE ALL' COMMANDS.
NTXT(OBJ,1)=DL
NTXT(OBJ,2)=DLL
C READ POINT VALUES FOR TREASURES.
K=1
IF(TK(3).LT.0)K=-1
POINTS(OBJ)= (TK(1)*1000000*K) + (TK(2)*1000*K) + TK(3)
GOTO 1050
C READ DEFAULT MESSAGE NUMBERS FOR ACTION VERBS, STORE IN ACTSPK.
C1060 READ(5,1061)VERB,J
1060 READ(1,1061)VERB,J
1061 FORMAT(10I8)
IF(VERB.EQ.-1)GOTO 1002
ACTSPK(VERB)=J
GOTO 1060
C READ INFO ABOUT AVAILABLE LIQUIDS AND OTHER CONDITIONS, STORE IN COND.
C1070 READ(5,1061)K,(TK(I),I=1,9)
1070 READ(1,1061)K,(TK(I),I=1,9)
IF(K.EQ.-1)GOTO 1002
DO 1071 I=1,20
LOC=TK(I)
IF(LOC.EQ.0)GOTO 1070
IF(BITSET(LOCCON(LOC),K))CALL BUG(8)
1071 LOCCON(LOC)=LOCCON(LOC)+BITS(K)
GOTO 1070
C READ DATA FOR HINTS.
1080 HNTMAX=0
C1081 READ(5,1061)K,(TK(I),I=1,9)
1081 READ(1,1061)K,(TK(I),I=1,9)
IF(K.EQ.-1)GOTO 1002
IF(K.EQ.0)GOTO 1081
IF(K.LT.0.OR.K.GT.HNTSIZ)CALL BUG(7)
DO 1083 I=1,4
1083 HINTS(K,I)=TK(I)
HNTMAX=MAX0(HNTMAX,K)
GOTO 1081
C SECTION 14 IS THE PREPOSITION TABLE.
C1100 READ(5,1101)DK,DKK,(DTK(I),I=1,8)
1100 READ(1,1101)DK,DKK,(DTK(I),I=1,8)
1101 FORMAT(10(A6,2X))
C IF(DK.EQ.0)GOTO 1100
IF(ICHAR(DK).EQ.0)GOTO 1100
C ABOVE KLUGE IS TO AVOID AFOREMENTIONED F40 BUG
IF(DK.EQ.'-1 ')GOTO 1002
VERB=VAL(VOCABX(DK,-4))
DJJ=DK
IF(VERB.EQ.-1)GOTO 1106
PREP=VAL(VOCABX(DKK,-6))
DJJ=DKK
IF(PREP.EQ.-1)GOTO 1106
IF(VKEY(VERB).NE.0)GOTO 1104
VKEY(VERB)=PTBS
GOTO 1105
1104 PTAB(PTBS-1)=-PTAB(PTBS-1)
1105 DO 1110 L=1,8
IF(DTK(L).EQ.' ')GOTO 1111
K=VAL(VOCABX(DTK(L),-3))
IF(K.NE.-1)GOTO 1108
K=999
IF(L.EQ.1.AND.DTK(1).EQ.'ANY ')GOTO 1108
DJJ=DTK(L)
GO TO 1106
1108 PTAB(PTBS)=PREP*1000+K
PTBS=PTBS+1
IF(PTBS.EQ.PTBSIZ)CALL BUG(15)
1110 CONTINUE
1111 PTAB(PTBS-1)=-PTAB(PTBS-1)
GOTO 1100
C only come here via "GO TO 1106", never should drop in.
1106 PRINT 1107,DJJ
1107 FORMAT(/' UNRECOGNIZED WORD "',A6,'" IN PREP/OBJ TABLE.')
CALL BUG(14)
C READ CONDITION BITS FOR OBJECTS. KK IS THE BIT; TK(I), THE OBJ LIST.
C1120 READ(5,1061)IKK,(TK(I),I=1,9)
1120 READ(1,1061)IKK,(TK(I),I=1,9)
IF(IKK.EQ.-1)GOTO 1002
DO 1125 I=1,9
OBJ=TK(I)
IF(OBJ.EQ.0)GOTO 1120
IF(OBJ.LE.0.OR.OBJ.GT.MAXOBJ)CALL BUG(17)
IF(.NOT.BITSET(OBJCND(OBJ),IKK))GOTO 1125
WRITE(1,101)OBJ,IKK
101 FORMAT('BIT SET TWICE OBJ=',I5,' BIT= ',I5)
CALL BUG(16)
1125 OBJCND(OBJ)=OBJCND(OBJ)+BITS(IKK)
GOTO 1120
C SECTION 17 IS THE ADJECTIVE TABLE.
C1140 READ(5,1141)DK,(DTK(I),I=1,9)
1140 READ(1,1141)DK,(DTK(I),I=1,9)
1141 FORMAT(10(A6,2X))
C IF(DK.EQ.0)GOTO 1140
C ABOVE KLUGE IS TO AVOID AFOREMENTIONED F40 BUG
C COMPILER DOESN'T AGREE WITH 'ABOVE KLUDGE' SO REMOVED IT. I DON'T THINK
C ANY F40 BUGS ARE GOING TO COUSE TROUBLE. MYRKRAVERK
IF(DK.EQ.'-1 ')GOTO 1002
ADJ=VOCABX(DK,-7)
DJJ=DK
IF(ADJ.EQ.-1.OR.CLASS(ADJ).NE.6)GOTO 1148
ADJ=VAL(ADJ)
IF(ADJKEY(ADJ).NE.0)GOTO 1142
ADJKEY(ADJ)=ATBS
GOTO 1143
1142 ADJTAB(ATBS-1)=-ADJTAB(ATBS-1)
1143 DO 1145 L=1,9
IF(DTK(L).EQ.' ')GOTO 1146
DJJ=DTK(L)
K=VOCABX(DTK(L),-3)
IF(K.EQ.-1.OR.CLASS(K).NE.2)GOTO 1148
ADJTAB(ATBS)=VAL(K)
ATBS=ATBS+1
IF(ATBS.EQ.MAXOBJ)CALL BUG(18)
1145 CONTINUE
1146 ADJTAB(ATBS-1)=-ADJTAB(ATBS-1)
GOTO 1140
1148 PRINT 1149,DJJ
1149 FORMAT(/' UNRECOGNIZED WORD "',A6,'" IN ADJECTIVE TABLE.')
CALL BUG(13)
C EVERYTHING IS READ! NOW FINISH CONSTRUCTING INTERNAL DATA FORMAT.
C DEFINE SOME HANDY MNEMONICS. THESE CORRESPOND TO OBJECT NUMBERS.
C (INCLUDES TREASURES.)
C1190 CALL CLOS$A(1)
1190 CLOSE(1)
ANVIL=VOCABX('ANVIL ',2)
AXE=VOCABX('AXE ',2)
BATTER=VOCABX('BATTER ',2)
BEAR=VOCABX('BEAR ',2)
BEES=VOCABX('BEES ',2)
BILLBD=VOCABX('BILLBO ',2)
BIRD=VOCABX('BIRD ',2)
BOAT=VOCABX('BOAT ',2)
BOOK=VOCABX('BOOK ',2)
BOOK2=BOOK+1
BOOTH=VOCABX('BOOTH ',2)
BOTTLE=VOCABX('BOTTLE ',2)
BRUSH=VOCABX('BRUSH ',2)
CAGE=VOCABX('CAGE ',2)
CAKES=VOCABX('CAKES ',2)
CARVNG=VOCABX('CARVIN ',2)
CASK=VOCABX('CASK ',2)
CHAIN=VOCABX('CHAIN ',2)
CHASM=VOCABX('CHASM ',2)
CHASM2=CHASM+1
CHEST=VOCABX('CHEST ',2)
CLAM=VOCABX('CLAM ',2)
CLOAK=VOCABX('CLOAK ',2)
COINS=VOCABX('COINS ',2)
CROWN=VOCABX('CROWN ',2)
DOG=VOCABX('DOG ',2)
DOOR=VOCABX('DOOR ',2)
DRAGON=VOCABX('DRAGON ',2)
DWARF=VOCABX('DWARF ',2)
EGGS=VOCABX('EGGS ',2)
EMRALD=VOCABX('EMERAL ',2)
FISSUR=VOCABX('FISSUR ',2)
FLOWER=VOCABX('FLOWER ',2)
FLY=VOCABX('FLY ',2)
FOOD=VOCABX('FOOD ',2)
GNOME=VOCABX('GNOME ',2)
GRAIL=VOCABX('GRAIL ',2)
GRATE=VOCABX('GRATE ',2)
HIVE=VOCABX('HIVE ',2)
HONEY=VOCABX('HONEY ',2)
HORN=VOCABX('HORN ',2)
JEWELS=VOCABX('JEWELS ',2)
KEYS=VOCABX('KEYS ',2)
KNIFE=VOCABX('KNIFE ',2)
LAMP=VOCABX('LAMP ',2)
LYRE=VOCABX('LYRE ',2)
MAGZIN=VOCABX('MAGAZI ',2)
MESSAG=VOCABX('MESSAG ',2)
MIRROR=VOCABX('MIRROR ',2)
MUSHRM=VOCABX('MUSHRO ',2)
NUGGET=VOCABX('NUGGET ',2)
OIL=VOCABX('OIL ',2)
C OIL2=OIL+1
OYSTER=VOCABX('OYSTER ',2)
PLAQUE=VOCABX('PLAQUE ',2)
PEARL=VOCABX('PEARL ',2)
PHONE=VOCABX('PHONE ',2)
PILLOW=VOCABX('PILLOW ',2)
PLANT=VOCABX('PLANT ',2)
PLANT2=PLANT+1
POLE=VOCABX('POLE ',2)
POSTER=VOCABX('POSTER ',2)
PYRAM=VOCABX('PYRAMI ',2)
RADIUM=VOCABX('RADIUM ',2)
RING=VOCABX('RING ',2)
ROCKS=VOCABX('ROCKS ',2)
ROD=VOCABX('ROD ',2)
ROD2=ROD+1
RUG=VOCABX('RUG ',2)
SAFE=VOCABX('SAFE ',2)
SHIELD=VOCABX('TUBE ',2)
SHOES=VOCABX('SHOES ',2)
SKEY=VOCABX('KEY ',2)
SLUGS=VOCABX('SLUGS ',2)
SNAKE=VOCABX('SNAKE ',2)
SPICES=VOCABX('SPICES ',2)
SPIDER=VOCABX('SPIDER ',2)
STEPS=VOCABX('STEPS ',2)
STICKS=VOCABX('STICKS ',2)
SWORD=VOCABX('SWORD ',2)
TABLET=VOCABX('TABLET ',2)
TDOOR=DOOR+1
TDOOR2=TDOOR+1
PDOOR=TDOOR2+1
TRIDNT=VOCABX('TRIDEN ',2)
TROLL=VOCABX('TROLL ',2)
TROLL2=TROLL+1
VASE=VOCABX('VASE ',2)
VEND=VOCABX('MACHIN ',2)
WALL=VOCABX('WALL ',2)
WALL2=WALL+1
WATER=VOCABX('WATER ',2)
C WATER2=WATER+1
WINE=VOCABX('WINE ',2)
C WINE2=WINE+1
WUMPUS=VOCABX('WUMPUS ',2)
C THESE ARE MOTION-VERB NUMBERS.
BACK=VOCABX('BACK ',1)
CAVE=VOCABX('CAVE ',1)
DPRSSN=VOCABX('DEPRES ',1)
ENTRNC=VOCABX('ENTRAN ',1)
XIT=VOCABX('EXIT ',1)
NULL=VOCABX('NULL ',1)
C AND SOME ACTION VERBS.
FIND=VOCABX('FIND ',3)
GO=VOCABX('GO ',3)
HIT=VOCABX('HIT ',3)
LOOK=VOCABX('LOOK ',3)
YELL=VOCABX('CALL ',3)
INVENT=VOCABX('INVENT ',3)
LEAVE=VOCABX('LEAVE ',3)
LOCK=VOCABX('LOCK ',3)
SAY=VOCABX('SAY ',3)
SHUT=VOCABX('CLOSE ',3)
TAKE=VOCABX('TAKE ',3)
THROW=VOCABX('THROW ',3)
UNLOCK=VOCABX('UNLOCK ',3)
WEAR=VOCABX('WEAR ',3)
YANK=VOCABX('YANK ',3)
C AND A FEW PREPOSITIONS. PREFIX 'PREP' TO DISTINGUISH THEM FROM FUNCTIONS & R
PREPAT=VOCABX('AT ',5)
PREPDN=VOCABX('DOWN ',5)
PREPFR=VOCABX('FROM ',5)
PREPIN=VOCABX('IN ',5)
PREPOF=VOCABX('OFF ',5)
PREPON=VOCABX('ON ',5)
C A POPULAR LOCATION IS:
Y2=33
C IF SETUP=2 WE DON'T NEED TO DO THIS. IT'S ONLY NECESSARY IF WE HAVEN'T DONE
C IT AT ALL OR IF THE PROGRAM HAS BEEN RUN SINCE THEN.
1200 IF(SETUP.EQ.2)GOTO 1
IF(SETUP.EQ.-1)GOTO 13050
C HAVING READ IN THE DATABASE, CERTAIN THINGS ARE NOW CONSTRUCTED. PROPS ARE
C SET TO ZERO. WE FINISH SETTING UP COND BY CHECKING FOR FORCED-MOTION TRAVEL
C ENTRIES. THE PLAC AND FIXD ARRAYS ARE USED TO SET UP ATLOC(N) AS THE FIRST
C OBJECT AT LOCATION N, AND LINK(OBJ) AS THE NEXT OBJECT AT THE SAME LOCATION
C AS OBJ. (OBJ>MAXOBJ INDICATES THAT FIXED(OBJ-MAXOBJ)=LOC; LINK(OBJ) IS STILL
C THE CORRECT LINK TO USE.) ABB IS ZEROED; IT CONTROLS WHETHER THE ABBREVIATED
C DESCRIPTION IS PRINTED. COUNTS MOD 5 UNLESS "LOOK" IS USED.
DO 1201 I=1,MAXOBJ
PLACE(I)=0
PROP(I)=0
HOLDER(I)=0
HLINK(I)=0
LINK(I)=0
1201 LINK(I+MAXOBJ)=0
DO 1202 I=1,LOCSIZ
ABB(I)=0
IF(LTEXT(I).EQ.0.OR.KEY(I).EQ.0)GOTO 1202
K=KEY(I)
IF(MOD(IABS(TRAVEL(K)),0001000).EQ.1)LOCCON(I)=2
1202 ATLOC(I)=0
C SET UP THE ATLOC AND LINK ARRAYS AS DESCRIBED ABOVE. WE'LL USE THE DROP
C SUBROUTINE, WHICH PREFACES NEW OBJECTS ON THE LISTS. SINCE WE WANT THINGS
C IN THE OTHER ORDER, WE'LL RUN THE LOOP BACKWARDS. IF THE OBJECT IS IN TWO
C LOCS, WE DROP IT TWICE. THIS ALSO SETS UP "PLACE" AND "FIXED" AS COPIES OF
C "PLAC" AND "FIXD". ALSO, SINCE TWO-PLACED OBJECTS ARE TYPICALLY BEST
C DESCRIBED LAST, WE'LL DROP THEM FIRST.
DO 1206 I=1,MAXOBJ
K=MAXOBJ+1-I
IF(FIXD(K).LE.0)GOTO 1206
CALL DROP(K+MAXOBJ,FIXD(K))
CALL DROP(K,PLAC(K))
1206 CONTINUE
DO 1207 I=1,MAXOBJ
K=MAXOBJ+1-I
FIXED(K)=FIXD(K)
1207 IF(PLAC(K).NE.0.AND.FIXD(K).LE.0)CALL DROP(K,PLAC(K))
C MAKE SURE ALL THE RIGHT THINGS GET CLOSED AND LOCKED, ETC., BEFORE
C WE GET STARTED.
DO 1220 I=1,MAXOBJ
1220 OBJCON(I)=OBJCND(I)
C TREASURES, AS NOTED EARLIER, ARE OBJECTS WITH BITSET(14) IN OBJCON.
C THEIR PROPS ARE INITIALLY -1, AND ARE SET TO 0 THE FIRST TIME THEY ARE
C DESCRIBED. TALLY KEEPS TRACK OF HOW MANY ARE NOT YET FOUND, SO WE KNOW
C WHEN TO CLOSE THE CAVE. TALLY2 COUNTS HOW MANY CAN NEVER BE FOUND (E.G. IF
C LOST BIRD OR BRIDGE).
TALLY=0
TALLY2=0
DO 1240 I=1,MAXOBJ
IF(.NOT.TREASR(I))GOTO 1240
IF(PTEXT(I).NE.0)PROP(I)=-1
1240 TALLY=TALLY-PROP(I)
C CLEAR THE HINT STUFF. HINTLC(I) IS HOW LONG HE'S BEEN AT LOC WITH COND BIT
C I. HINTED(I) IS TRUE IFF HINT I HAS BEEN USED.
DO 1300 I=1,HNTMAX
HINTED(I)=.FALSE.
1300 HINTLC(I)=0
C INITIALISE THE DWARVES. DLOC IS LOC OF DWARVES, HARD-WIRED IN. ODLOC IS
C PRIOR LOC OF EACH DWARF, INITIALLY GARBAGE. DALTLC IS ALTERNATE INITIAL LOC
C FOR DWARF, IN CASE ONE OF THEM STARTS OUT ON TOP OF THE ADVENTURER. (NO 2
C OF THE 5 INITIAL LOCS ARE ADJACENT.) DSEEN IS TRUE IF DWARF HAS SEEN HIM.
C DFLAG CONTROLS THE LEVEL OF ACTIVATION OF ALL THIS:
C 0 NO DWARF STUFF YET (WAIT UNTIL REACHES HALL OF MISTS)
C 1 REACHED HALL OF MISTS, BUT HASN'T MET FIRST DWARF
C 2 MET FIRST DWARF, OTHERS START MOVING, NO KNIVES THROWN YET
C 3 A KNIFE HAS BEEN THROWN (FIRST SET ALWAYS MISSES)
C 3+ DWARVES ARE MAD (INCREASES THEIR ACCURACY)
C SIXTH DWARF IS SPECIAL (THE PIRATE). HE ALWAYS STARTS AT HIS CHEST'S
C EVENTUAL LOCATION INSIDE THE MAZE. THIS LOC IS SAVED IN CHLOC FOR REF.
C THE DEAD END IN THE OTHER MAZE HAS ITS LOC STORED IN CHLOC2.
CHLOC=114
CHLOC2=140
DO 1700 I=1,DWFMAX
1700 DSEEN(I)=.FALSE.
DFLAG=0
DLOC(1)=PLAC(SNAKE)
DLOC(2)=PLAC(BOOTH)
DLOC(3)=Y2
DLOC(4)=44
DLOC(5)=PLAC(CLAM)
C DLOC(6)=PLAC(VEND)
DLOC(DWFMAX)=CHLOC
DALTLC=PLAC(NUGGET)
C OTHER RANDOM FLAGS AND COUNTERS, AS FOLLOWS:
C ABBNUM HOW OFTEN WE SHOULD PRINT NON-ABBREVIATED DESCRIPTIONS
C BCROSS NUMBER OF TIMES COLLAPSING BRIDGE HAS BEEN TRAVERSED.
C BONUS USED TO DETERMINE AMOUNT OF BONUS IF HE REACHES CLOSING
C CHASE TELLS HOW CLOSE THE WUMPUS IS TO GOBBLING HIM UP
C CLOCK1 NUMBER OF TURNS FROM FINDING LAST TREASURE TILL CLOSING
C CLOCK2 NUMBER OF TURNS FROM FIRST WARNING TILL BLINDING FLASH
C CLOCK3 NUMBER OF TURNS IN REPOSITORY TILL PHONE RINGS.
C AFTER TICKING TO 0, TICKS 7 TIMES TO WAKE DWARVES.
C COMBO CURRENT PROGRESS IN GIVING SAFE'S COMBINATION
C DETAIL HOW OFTEN WE'VE SAID "NOT ALLOWED TO GIVE MORE DETAIL"
C DKILL NUMBER OF DWARVES KILLED (UNUSED IN SCORING, NEEDED FOR MSG)
C FOOBAR CURRENT PROGRESS IN SAYING "FEE FIE FOE FOO".
C HEALTH PERCENTAGE OF MAXIMUM (100) FITNESS
C IWEST HOW MANY TIMES HE'S SAID "WEST" INSTEAD OF "W"
C KNFLOC 0 IF NO KNIFE HERE, LOC IF KNIFE HERE, -1 AFTER CAVEAT
C LIMIT LIFETIME OF LAMP (NOT SET HERE)
C MAXDIE NUMBER OF REINCARNATION MESSAGES AVAILABLE (UP TO 5)
C NUMDIE NUMBER OF TIMES KILLED SO FAR
C TERSE IF TRUE, NEVER PRINT LONG LOCATION DESCRIPTIONS
C TURNS TALLIES HOW MANY COMMANDS HE'S GIVEN (IGNORES YES/NO)
C WASTE TELLS HOW LONG HE HAS USED LAMP IN LIGHTED AREA.
C LOGICALS WERE EXPLAINED EARLIER
ABBNUM=5
BCROSS=0
BONUS=0
CLOCK1=30
CLOCK2=50
CLOCK3=20+RAN(20)
CHASE=0
CLOSED=.FALSE.
CLOSNG=.FALSE.
COMBO=0
DETAIL=0
DKILL=0
FOOBAR=0
GAVEUP=.FALSE.
HEALTH=100
IWEST=0
KNFLOC=0
LMWARN=.FALSE.
DO 1800 I=0,4
1800 IF(RTEXT(2*I+81).NE.0)MAXDIE=I+1
NUMDIE=0
PANIC=.FALSE.
SAVED=0
SCORNG=.FALSE.
TERSE=.FALSE.
TURNS=0
WASTE=0
C SETUP THE LIQUIDS ACCORDING TO CONTAINER PROP VALUES
LIQTYP(1)=WATER
LIQTYP(2)=0
LIQTYP(3)=OIL
LIQTYP(4)=0
LIQTYP(5)=WINE
PROP(POLE)=1
PROP(SKEY)=1
PLACE(WATER)=-1
CALL INSERT(WATER,BOTTLE)
PLACE(BOOK)=-1
CALL INSERT(BOOK,SAFE)
C AND CLEAR OUT ANY LEFTOVER WORD VECTORS...
CALL CLRLIN
DO 1810 WDX=1,35
1810 WORDS(WDX)=0
WDX=0
C IF SETUP=1, REPORT ON AMOUNT OF ARRAYS ACTUALLY USED, TO PERMIT REDUCTIONS.
IF(SETUP.NE.1)GOTO 1
SETUP=2
JJ=0
DO 1989 K=1,VKYSIZ
1989 IF(VKEY(K).NE.0)JJ=JJ+1
DO 1998 K=1,LOCSIZ
KK=LOCSIZ+1-K
IF(LTEXT(KK).NE.0)GOTO 1997
1998 CONTINUE
1997 LL=0
OBJ=0
DO 1996 K=1,MAXOBJ
IF(TREASR(K))LL=LL+1
1996 IF(PTEXT(K).NE.0)OBJ=OBJ+1
DO 1995 K=1,TABNDX
1995 IF(KTAB(K)/1000.EQ.2)VERB=KTAB(K)-2000
DO 1994 K=1,RTXSIZ
J=RTXSIZ+1-K
IF(RTEXT(J).NE.0)GOTO 1993
1994 CONTINUE
1993 DO 1992 K=1,MAGSIZ
I=MAGSIZ+1-K
IF(MTEXT(I).NE.0)GOTO 1991
1992 CONTINUE
1991 CALL RATING(SCORE,MXSCOR,0,0,0,0,0)
K=MAXOBJ
PRINT 1999,LINUSE,LINSIZ,TRVS,TRVSIZ,TABNDX,TABSIZ,KK,
1 LOCSIZ,OBJ,K,LL,VERB,VRBSIZ,J,RTXSIZ,CLSSES,CLSMAX,
2 HNTMAX,HNTSIZ,I,MAGSIZ,PTBS,PTBSIZ,JJ,VERB,
3 MXSCOR
1999 FORMAT (' TABLE SPACE USED:'/
1 ' ',I6,' OF ',I6,' WORDS OF MESSAGES'/
2 ' ',I6,' OF ',I6,' TRAVEL OPTIONS'/
3 ' ',I6,' OF ',I6,' VOCABULARY WORDS'/
4 ' ',I6,' OF ',I6,' LOCATIONS'/
5 ' ',I6,' OF ',I6,' OBJECTS OF WHICH ',I2,' ARE TREASURES.'/
6 ' ',I6,' OF ',I6,' ACTION VERBS'/
7 ' ',I6,' OF ',I6,' RTEXT MESSAGES'/
8 ' ',I6,' OF ',I6,' CLASS MESSAGES'/
9 ' ',I6,' OF ',I6,' HINTS'/
1 ' ',I6,' OF ',I6,' MAGIC MESSAGES'/
2 ' ',I6,' OF ',I6,' VERB/PREP/OBJ OPTIONS'/
3 ' ',I6,' OF ',I6,' VERBS TAKE PREPOSITIONS'/
4 /' MAXIMUM SCORE FOR THIS VERSION IS ',I4,' POINTS.'/
5 )
C FINALLY, SINCE WE'RE CLEARLY SETTING THINGS UP FOR THE FIRST TIME...
IF(YESM(33,0,0))CALL XMAP
CALL POOF
! PAUSE 5
C START-UP, DWARF STUFF
1 DEMO=START(0)
CALL MOTD(.FALSE.)
I=RAN(1)
CALL RSPEAK(325)
HINTED(3)=YES(65,1,0)
NEWLOC=1
SETUP=3
LIMIT=280
IF(HINTED(3))LIMIT=550
C CAN'T LEAVE CAVE ONCE IT'S CLOSING (EXCEPT BY MAIN OFFICE).
2 IF(.NOT.OUTSID(NEWLOC).OR.NEWLOC.EQ.0.OR..NOT.CLOSNG)GOTO 71
CALL RSPEAK(130)
NEWLOC=LOC
IF(.NOT.PANIC)CLOCK2=15
PANIC=.TRUE.
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).
71 IF(NEWLOC.EQ.LOC)GOTO 74
ILOC=LOC
171 IF(FORCED(ILOC))GOTO 74
172 IF(AND(LOCCON(ILOC),000016).NE.0)GOTO 74
L1=DWFMAX-1
DO 73 I=1,L1
IF(ODLOC(I).NE.NEWLOC.OR..NOT.DSEEN(I))GOTO 73
NEWLOC=LOC
CALL RSPEAK(2)
GOTO 74
73 CONTINUE
74 LOC=NEWLOC
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 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.
IF(LOC.EQ.0.OR.FORCED(LOC).OR.AND(LOCCON(NEWLOC),000016).NE.0)
1 GOTO 2000
IF(DFLAG.NE.0)GOTO 6000
IF(INSIDE(LOC))DFLAG=1
GOTO 2000
C WHEN WE ENCOUNTER THE FIRST DWARF, WE KILL 0, 1, OR 2 OF THE DWFMAX DWARVES.
C IF ANY OF THE SURVIVORS IS AT LOC, REPLACE HIM WITH THE ALTERNATE.
6000 IF(DFLAG.NE.1)GOTO 6010
IF(.NOT.INSIDE(LOC).OR.PCT(95))GOTO 2000
DFLAG=2
DO 6001 I=1,2
J=1+RAN(DWFMAX-1)
C IF SAVED NOT = -1, HE BYPASSED THE "START" CALL.
6001 IF(PCT(50).AND.SAVED.EQ.-1)DLOC(J)=0
L1=DWFMAX-1
DO 6002 I=1,L1
IF(DLOC(I).EQ.LOC)DLOC(I)=DALTLC
6002 ODLOC(I)=DLOC(I)
CALL RSPEAK(3)
CALL DROP(AXE,LOC)
GOTO 2000
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 WHICH ARE OUTSIDE OR IN
C EITHER OF THE TWO PORTAL AREAS. IF WANDERING AT RANDOM, THEY
C 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.
6010 DTOTAL=0
ATTACK=0
STICK=0
DO 6030 I=1,DWFMAX
IF(DLOC(I).EQ.0)GOTO 6030
J=1
KK=KEY(DLOC(I))
IF(KK.EQ.0)GOTO 6016
6012 NEWLOC=MOD(IABS(TRAVEL(KK))/1000,1000)
IF(NEWLOC.GT.MAXLOC.OR.NEWLOC.EQ.ODLOC(I)
1 .OR..NOT.INSIDE(NEWLOC)
2 .OR.(J.GT.1.AND.NEWLOC.EQ.TK(J-1)).OR.J.GE.20
3 .OR.NEWLOC.EQ.DLOC(I).OR.FORCED(NEWLOC)
4 .OR.(I.EQ.DWFMAX.AND.AND(LOCCON(NEWLOC),000016).NE.0)
5 .OR.IABS(TRAVEL(KK))/1000.EQ.100)GOTO 6014
TK(J)=NEWLOC
J=J+1
6014 KK=KK+1
IF(TRAVEL(KK-1).GE.0)GOTO 6012
6016 TK(J)=ODLOC(I)
IF(J.GE.2)J=J-1
J=1+RAN(J)
ODLOC(I)=DLOC(I)
DLOC(I)=TK(J)
DSEEN(I)=(DSEEN(I).AND.INSIDE(LOC))
1 .OR.(DLOC(I).EQ.LOC.OR.ODLOC(I).EQ.LOC)
IF(.NOT.DSEEN(I))GOTO 6030
DLOC(I)=LOC
IF(I.NE.DWFMAX)GOTO 6027
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.
IF(LOC.EQ.CHLOC.OR.PROP(CHEST).GE.0)GOTO 6030
K=0
DO 6020 J=1,MAXOBJ
C PIRATE WON'T TAKE PYRAMID FROM PLOVER ROOM OR DARK ROOM (TOO EASY!).
IF(.NOT.TREASR(J).OR.(J.EQ.CASK.AND.LIQ(CASK).NE.WINE))GOTO 6020
IF(J.EQ.PYRAM.AND.(LOC.EQ.PLAC(PYRAM)
1 .OR.LOC.EQ.PLAC(EMRALD)))GOTO 6020
IF(TOTING(J).AND.ATHAND(J))GOTO 6022
6020 IF(HERE(J).AND.TREASR(J))K=1
IF(TALLY.EQ.TALLY2+1.AND.K.EQ.0.AND.PLACE(CHEST).EQ.0
1 .AND.ATHAND(LAMP).AND.PROP(LAMP).EQ.1)GOTO 6025
IF(ODLOC(DWFMAX).NE.DLOC(DWFMAX).AND.PCT(30))CALL RSPEAK(127)
GOTO 6030
6022 CALL RSPEAK(128)
C DON'T STEAL CHEST BACK FROM TROLL!
IF(PLACE(MESSAG).EQ.0)CALL MOVE(CHEST,CHLOC)
CALL MOVE(MESSAG,CHLOC2)
DO 6023 J=1,MAXOBJ
IF(.NOT.TREASR(J).OR.(J.EQ.PYRAM.AND.
1 (LOC.EQ.PLAC(PYRAM).OR.LOC.EQ.PLAC(EMRALD))).OR.
2 (J.EQ.CASK.AND.LIQ(CASK).NE.WINE).OR.
3 (ENCLSD(J).AND..NOT.ATHAND(J)))GOTO 6023
IF(AT(J).AND.FIXED(J).EQ.0)CALL CARRY(J,LOC)
IF(ENCLSD(J))CALL REMOVE(J)
IF(.NOT.HOLDNG(J))GOTO 6023
CALL INSERT(J,CHEST)
IF(.NOT.WEARNG(J))GOTO 6023
PROP(J)=0
CALL BITOFF(J,WEARBT)
6023 CONTINUE
6024 DLOC(DWFMAX)=CHLOC
ODLOC(DWFMAX)=CHLOC
DSEEN(DWFMAX)=.FALSE.
GOTO 6030
6025 CALL RSPEAK(186)
CALL MOVE(CHEST,CHLOC)
CALL MOVE(MESSAG,CHLOC2)
GOTO 6024
C THIS THREATENING LITTLE DWARF IS IN THE ROOM WITH HIM!
6027 DTOTAL=DTOTAL+1
IF(ODLOC(I).NE.DLOC(I))GOTO 6030
ATTACK=ATTACK+1
IF(KNFLOC.GE.0)KNFLOC=LOC
IF(RAN(1000).LT.95*(DFLAG-2))STICK=STICK+1
6030 CONTINUE
C NOW WE KNOW WHAT'S HAPPENING. LET'S TELL THE POOR SUCKER ABOUT IT.
IF(DTOTAL.EQ.0)GOTO 2000
IF(DTOTAL.EQ.1)GOTO 75
PRINT 67,DTOTAL
67 FORMAT(/' There are ',I1,' threatening little dwarves in the'
1 ,' room with you!')
GOTO 77
75 CALL RSPEAK(4)
77 IF(ATTACK.EQ.0)GOTO 2000
IF(DFLAG.EQ.2)DFLAG=3
C IF SAVED NOT = -1, HE BYPASSED THE "START" CALL. DWARVES GET *VERY* MAD!
IF(SAVED.NE.-1)DFLAG=20
IF(ATTACK.EQ.1)GOTO 79
PRINT 78,ATTACK
78 FORMAT(/' ',I1,' of them throw knives at you!')
K=6
82 IF(STICK.GT.1)GOTO 83
CALL RSPEAK(K+STICK)
IF(STICK.EQ.0)GOTO 2000
GOTO 84
83 PRINT 68,STICK
68 FORMAT(/' ',I1,' of them get you!')
84 OLDLC2=LOC
GOTO 94100
79 CALL RSPEAK(5)
K=52
GOTO 82
C DESCRIBE THE CURRENT LOCATION AND (MAYBE) GET NEXT COMMAND.
C PRINT TEXT FOR CURRENT LOC.
2000 IF(LOC.EQ.0)GOTO 94100
JKK=STEXT(LOC)
IF(VERB.EQ.LOOK.OR.JKK.EQ.0.OR.
1 (.NOT.TERSE.AND.MOD(ABB(LOC),ABBNUM).EQ.0) )JKK=LTEXT(LOC)
IF((FORCED(LOC).OR..NOT.DARK(0)).AND.LOC.NE.200)GOTO 2001
IF(LOC.NE.200.AND. (DARK(0).OR.PROP(LAMP).EQ.0
1 .OR..NOT.ATHAND(LAMP)) )GOTO 2003
IF(PROP(LAMP).EQ.0.OR..NOT.ATHAND(LAMP))GOTO 2020
IF(PCT(35))GOTO 94000
JKK=RTEXT(294)
GOTO 2020
2003 IF(WZDARK.AND.PCT(35))GOTO 94000
JKK=RTEXT(16)
2001 IF(HOLDNG(BEAR).AND..NOT.DARK(0))CALL RSPEAK(141)
2020 CALL SPEAK(JKK)
K=1
ABB(LOC)=ABB(LOC)+1
IF(.NOT.FORCED(LOC))GOTO 2022
CALL TRAVL(K)
IF(KILLED)GOTO 94100
GOTO 2
2022 ABB(LOC)=ABB(LOC)-1
IF(LOC.EQ.Y2.AND.PCT(25).AND..NOT.CLOSNG)CALL RSPEAK(8)
IF(LOC.EQ.147.AND.ABB(LOC).EQ.1)CALL RSPEAK(216)
C SEE IF HE IS WASTING HIS BATTERIES OUT IN THE OPEN.
K=0
IF(.NOT.OUTSID(LOC).OR.PROP(LAMP).EQ.0)GOTO 2030
K=WASTE+1
IF(K.LE.12)GOTO 2030
CALL RSPEAK(324)
K=0
2030 WASTE=K
C IF WUMPUS IS CHASING STOOGE, SEE IF WUMPUS GETS HIM.
IF(CHASE.EQ.0)GOTO 2040
CHASE=CHASE+1
KK=CHASE/2
PROP(WUMPUS)=KK
CALL MOVE(WUMPUS,LOC)
IF(KK.LT.5)GOTO 2040
IF(DARK(0))CALL RSPEAK(270)
CALL PSPEAK(WUMPUS,5)
GOTO 94100
C CHECK FOR RADIATION POISONING.
2040 K=1
IF(OUTSID(LOC))K=3
HEALTH=MIN0(HEALTH+1,100)
IF(.NOT.HERE(RADIUM).OR.
1 (PLACE(RADIUM).EQ.-SHIELD.AND..NOT.AJAR(SHIELD)) )GOTO 2045
HEALTH=HEALTH-K-7
IF(HEALTH.GE.60)GOTO 2045
CALL RSPEAK(391+(60-HEALTH)/10)
IF(HEALTH.LE.0)GOTO 94100
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).
C LIKEWISE, FOR SWORD (MUST PROVE ELFIN ROYALTY).
2045 IF(OLDLOC.NE.188.OR.LOC.EQ.189.OR.LOC.EQ.188
1 .OR.PROP(BOOTH).NE.1)GOTO 2021
CALL MOVE(GNOME,0)
PROP(BOOTH)=0
2021 IF(BLIND(0))GOTO 2100
ABB(LOC)=ABB(LOC)+1
I=ATLOC(LOC)
2004 IF(I.EQ.0)GOTO 2100
OBJ=I
IF(OBJ.GT.MAXOBJ)OBJ=OBJ-MAXOBJ
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.OR.OBJ.EQ.SWORD
1 .OR.OBJ.EQ.CASK)PROP(OBJ)=1
IF(OBJ.EQ.CLOAK.OR.OBJ.EQ.RING)PROP(OBJ)=2
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
C CALL PSPEAK(OBJ,INTS(KK))
CALL PSPEAK(OBJ,(KK))!REMOVED INTS, M.V.
CALL LOOKIN(OBJ)
2008 I=LINK(I)
GOTO 2004
C "I DON'T UNDERSTAND THAT!"
2060 SPK=CONFUZ(0)
GOTO 2011
C "YOU CAN'T DO THAT!" (AN IMPOSSIBLE ACT, E.G., "OPEN SWORD", "FEED BOAT", ET
2070 SPK=NOWAY(0)
GOTO 2011
2009 SPK=54
2011 IF(OBJ.EQ.0.OR.(OBJS(2).EQ.0.AND.IOBJS(2).EQ.0))GOTO 2015
CALL PSPEAK(OBJ,-1)
C CALL TNOUA(' ',5)
C HOPE REMOVING THIS IS OK, M.V.
BLKLIN=.FALSE.
2015 CALL RSPEAK(SPK)
BLKLIN=.TRUE.
2100 RDFLAG=.FALSE.
IF(OBJX.EQ.0)GOTO 2110
OBJX=OBJX+1
IF(OBJS(OBJX).EQ.0)OBJX=0
2110 IF(OBJX.GT.0.AND.OBJS(OBJX).NE.0)GOTO 2120
IF(IOBX.EQ.0)GOTO 2120
IOBX=IOBX+1
IF(IOBJS(IOBX).EQ.0)IOBX=0
IF(IOBX.NE.0.AND.OBJS(1).NE.0)OBJX=1
2120 IF(OBJX.GT.0.OR.IOBX.GT.0)GOTO 2600
IF(OBJS(1).NE.0)OBJX=1
IF(IOBJS(1).NE.0)IOBX=1
VRBX=VRBX+1
IF(VERBS(VRBX).NE.0)GOTO 2600
CALL CLRLIN
RDFLAG=.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" < HNTMIN (SPECIAL STUFF, SEE DATABASE
C NOTES).
2600 DO 2602 HINT=HNTMIN,HNTMAX
IF(HINTED(HINT))GOTO 2602
IF(AND(LOCCON(LOC),BITS(HINT)).EQ.0)HINTLC(HINT)=-1
HINTLC(HINT)=HINTLC(HINT)+1
IF(HINTLC(HINT).GE.HINTS(HINT,1))GOTO 40000
2602 CONTINUE
C gotta add 2603 as we want to "GO TO" here, but compiler
C doesn't like it when we try to goto 2602 as it is part of a loop.
2603 CONTINUE
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,MAXOBJ
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)
IF(.NOT.RDFLAG)GOTO 2608
C GET A NEW INPUT CLAUSE, OR FINISH GETTING CURRENT ONE.
CALL GETWDS
VRBX=1
OBJX=0
IF(OBJS(1).NE.0)OBJX=1
IOBX=0
IF(IOBJS(1).NE.0)IOBX=1
RDFLAG=.TRUE.
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)
COMBO=MIN0(0,-COMBO)
TURNS=TURNS+1
IF(DEMO.AND.TURNS.GE.SHORT)GOTO 92800
IF(LOGOUT(0))GOTO 92800
C IF(TURNS.EQ.3)CALL DATIME(XXD,XXT)
C IF(TURNS.NE.45)GOTO 2609
C SEE IF TIMER UUO HAS BEEN ZAPPED; IF SO, HE'S CHEATING.
C FLUSHING THIS FOR NOW. EATS CPU IN PA1050. [D. LONG]
C CALL DATIME(YYD,YYT)
C IF(XXD.EQ.YYD.AND.XXT.EQ.YYT)SAVED=0
2609 IF(TURNS.EQ.310.AND.ABBNUM.NE.10000.AND..NOT.TERSE)
1 CALL RSPEAK(273)
C BUMP ALL THE RIGHT CLOCKS FOR RECONNING BATTERY LIFE AND CLOSING.
IF(CLOSED)CLOCK3=CLOCK3-1
IF(CLOCK3.EQ.-7)GOTO 93300
IF(CLOCK3.NE.0)GOTO 2621
PROP(PHONE)=0
PROP(BOOTH)=0
CALL RSPEAK(284)
2621 IF(TALLY.EQ.0.AND.INSIDE(LOC).AND.LOC.NE.Y2)CLOCK1=CLOCK1-1
IF(CLOCK1.EQ.0)GOTO 90000
IF(CLOCK1.LT.0)CLOCK2=CLOCK2-1
IF(CLOCK2.EQ.0)GOTO 91000
C IF(PROP(LAMP).EQ.1)LIMIT=LIMIT-1
IF(LIMIT.EQ.0)GOTO 92400
IF(LIMIT.LT.0.AND.OUTSID(LOC))GOTO 92600
IF(LIMIT.LE.40)GOTO 92000
19999 VERB=VAL(VERBS(VRBX))
OBJ=0
IF(OBJX.NE.0)OBJ=OBJS(OBJX)
IOBJ=0
IF(IOBX.NE.0)IOBJ=IOBJS(IOBX)
IF(KNFLOC.NE.LOC.OR.(OBJ.NE.KNIFE.AND.IOBJ.NE.KNIFE))GOTO 19998
KNFLOC=-1
SPK=116
GOTO 2011
19998 GOTO (2750,2700,4000,2710), CLASS(VERBS(VRBX))
2700 CALL BUG(22)
2710 SPK=VERB
GOTO 2011
C IT IS A MOTION VERB. ANALYZE IT & LOOP TO 2, IF NOT DEAD.
2750 CALL TRAVL(VERB)
IF(KILLED)GOTO 94100
GOTO 2
C ACTION VERB 'LEAVE' (DROP) HAS NO OBJECT.
3100 CALL BUG(29)
C VERB 'SAY' OR 'YELL' SLIPPED THROUGH WITH AN OBJECT.
3200 CALL BUG(34)
C ANALYSE A VERB.
4000 SPK=ACTSPK(VERB)
IF(OBJ.NE.0.OR.IOBJ.NE.0)GOTO 4090
C ANALYSE AN INTRANSITIVE VERB (IE, NO OBJECT GIVEN YET).
GOTO(
9 10100,10000,10000,10400, 2009,10400,20700,20800,10000,10000,
9 2011,21200,11300,11400,11500,10000,10000,11800,10000,12000,
9 10000,12200,12300,12400,12500,12600,10000,10000,10000,13000,
9 13100,10100,10000,10000,13500,23600, 3100,13800,10000,10000,
9 10000,10000,10000,10100,10100,10100,10100,14800,10400,10400,
9 25100,25200,25300,25400,25500,25600,25700,25800,25900),VERB
C 01-10 TAKE DROP SAY OPEN NOTH CLOSE ON OFF WAVE CALM
C 11-20 WALK KILL POUR EAT DRINK RUB THROW QUIT FIND INVEN
C 21-30 FEED FILL BLAST SCORE FOO BRIEF READ BREAK WAKE SUSPD
C 31-40 HOUR YANK WEAR HIT ANSWR BLOW LEAVE YELL DIAL PLAY
C 41-50 PICK PUT TURN GET INSRT REMOV BURN GRIPE LOCK UNLOK
C 51-60 HEALTH LOOK COMBO SWEEP TERSE WIZ MAP GATE PIRLOC
CALL BUG(23)
C ANALYSE A TRANSITIVE VERB.
4090 GOTO(
9 20100,20200, 3200,20400, 2009,20600,20700,20800,20900, 2011,
9 2011,21200,21300,21400,21500,21600,21700, 2011,21900,21900,
9 22100,22200,12300, 2011, 2011,22600,22700,22800,22900, 2011,
9 2011,23200,23300,23400,23500,23600,20200, 3200,23900,24000,
9 24100,24200,24300,24400,24500,24600,24700, 2060,24900,25000,
9 2060,25200, 2070,25400, 2060, 2060, 2060, 2060, 2060),VERB
C 01-10 TAKE DROP SAY OPEN NOTH CLOSE ON OFF WAVE CALM
C 11-20 WALK KILL POUR EAT DRINK RUB THROW QUIT FIND INVEN
C 21-30 FEED FILL BLAST SCORE FOO BRIEF READ BREAK WAKE SUSPD
C 31-40 HOUR YANK WEAR HIT ANSWR BLOW LEAVE YELL DIAL PLAY
C 41-50 PICK PUT TURN GET INSRT REMOV BURN GRIPE LOCK UNLOK
C 51-60 HEALTH LOOK COMBO SWEEP TERSE WIZ MAP GATE PIRLOC
CALL BUG(24)
C ROUTINES FOR PERFORMING THE VARIOUS ACTION VERBS
C STATEMENT NUMBERS IN THIS SECTION ARE 10000 FOR INTRANSITIVE VERBS, 20000 FOR
C TRANSITIVE, PLUS 100 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").
10000 CALL A5TOA1(VTXT(VRBX,1),VTXT(VRBX,2),'WHAT?',TK,K)
PRINT 10002,(TK(I),I=1,K)
10002 FORMAT(/' ',20A1)
OBJS(1)=0
OBJX=0
GOTO 2600
10010 CALL A5TOA1(VTXT(VRBX,1),VTXT(VRBX,2),'it?',TK,K)
PRINT 10012,(TK(I),I=1,K)
10012 FORMAT(/' Where do you want to ',20A1)
GOTO 2600
C CONSTRUCT MSG: "I DON'T KNOW HOW TO [VERB] THE [OBJ]", AND VARIANTS.
C CARRY, NO OBJECT GIVEN YET. OK IF ONLY ONE OBJECT PRESENT.
10100 IF(ATLOC(LOC).EQ.0.OR.LINK(ATLOC(LOC)).NE.0.OR.BLIND(0))
1 GOTO 10000
L1=DWFMAX-1
DO 10110 I=1,L1
IF(DLOC(I).EQ.LOC.AND.DFLAG.GE.2)GOTO 10000
10110 CONTINUE
OBJ=ATLOC(LOC)
IF(VERB.EQ.YANK)GOTO 23200
IF(VERB.EQ.WEAR)GOTO 23300
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 "YANK" AND "WEAR" ALSO WEAVE INTO THIS CODE, SINCE THEY ARE MOSTLY
C JUST RESTRICTED CARRY'S.
20100 IF(OBJ.EQ.BOAT)SPK=281
IF(PLURAL(OBJ))SPK=297
IF(PREP.NE.PREPOF)GOTO 20104
IF(OBJ.NE.0.AND.IOBJ.NE.0)GOTO 2060
IF(OBJ.EQ.0)OBJ=IOBJ
IOBJ=0
GOTO 20200
20104 IF(HOLDNG(OBJ))GOTO 2011
ASSIGN 20106 TO RETN
GOTO 20190
20106 IF(PREP.EQ.PREPIN)GOTO 24500
IF(PREP.EQ.PREPFR.OR.ENCLSD(OBJ))GOTO 24600
C THE NEXT LINES ARE FOR 'TAKING' LIQUIDS (WATER, OIL & WINE).
C IF WE ARE HOLDING A CONTAINER (BOTTLE OR CASK), WE CAN TAKE THE
C THE LIQUID BY FILLING THE CONTAINER. IF THERE IS A CONTAINER NEARBY
C HOLDING THE REQUESTED LIQUID, WE WILL PICK UP THE CONTAINER.
IF(IOBJ.EQ.0)GOTO 20110
SPK=313
IF(OBJ.NE.CASK.AND.OBJ.NE.BOTTLE)GOTO 2011
K=0
IF(OBJ.EQ.CASK)K=1
IOBJ=IOBJ+K
IF(LIQ(OBJ).EQ.IOBJ)GOTO 20116
SPK=302+K
IF(PROP(OBJ).NE.1)GOTO 2011
GOTO 20118
20110 IF(OBJ.NE.WATER.AND.OBJ.NE.OIL.AND.OBJ.NE.WINE)GOTO 20120
IOBJ=OBJ
K=0
OBJ=BOTTLE
IF(.NOT.HERE(BOTTLE))GOTO 20114
IF(PROP(BOTTLE).NE.1)GOTO 20112
IF(.NOT.HERE(CASK).OR.(HERE(CASK).AND.PROP(CASK).EQ.1))
1 GOTO 20118
OBJ=0
CALL RSPEAK(304)
GOTO 2600
20112 IF(LIQ(BOTTLE).EQ.IOBJ)GOTO 20116
20114 SPK=312
IF(.NOT.HERE(CASK))GOTO 2011
OBJ=CASK
K=1
IF(PROP(CASK).EQ.1)GOTO 20118
IF(LIQ(CASK).EQ.IOBJ)GOTO 20116
SPK=315
IF(.NOT.ATHAND(BOTTLE))SPK=303
GOTO 2011
20116 IF(.NOT.HOLDNG(OBJ))GOTO 20120
SPK=302+K
GOTO 2011
20118 IF(HOLDNG(OBJ))GOTO 22200
GOTO 20120
C *** END OF LIQUID STUFF
C 'WEAR' AND 'YANK' WEAVE IN HERE.
20120 SPK=343
IF(OBJ.EQ.BEAR .OR. BURDEN(0)+BURDEN(OBJ).LE.15 )GOTO 20125
SPK=92
IF(.NOT.WEARNG(OBJ))GOTO 2011
PROP(OBJ)=0
CALL BITOFF(OBJ,WEARBT)
GOTO 2011
C CLOAK. BIG TROUBLE AHEAD. CAN ONLY GET HERE VIA 'YANK'.
20125 IF(OBJ.NE.CLOAK.OR.PROP(CLOAK).NE.2)GOTO 20130
PROP(ROCKS)=1
PROP(CLOAK)=0
FIXED(CLOAK)=0
CALL CARRY(CLOAK,LOC)
CALL RSPEAK(241)
IF(AT(WUMPUS).AND.PROP(WUMPUS).EQ.0)GOTO 22900
GOTO 2100
C POSTER: HIDES WALL SAFE.
20130 IF(OBJ.NE.POSTER.OR.PLACE(SAFE).NE.0)GOTO 20160
PROP(POSTER)=1
SPK=362
C MOVE SAFE AND WALL CONTAINING SAFE INTO VIEW.
CALL DROP(SAFE,LOC)
CALL DROP(WALL2,LOC)
GOTO 20180
C BOAT: NEED THE POLE TO PUSH IT
20160 IF(OBJ.NE.BOAT)GOTO 20165
SPK=218
IF(.NOT.TOTING(POLE).AND.PLACE(POLE).NE.-BOAT)GOTO 2011
PROP(BOAT)=1
SPK=221
GOTO 20180
C BIRD: GOT TO HAVE CAGE, BUT ROD CAN'T BE AROUND TO TAKE BIRD
20165 IF(OBJ.NE.BIRD.OR.PROP(BIRD).NE.0)GOTO 20170
SPK=26
IF(ATHAND(ROD))GOTO 2011
SPK=27
IF(.NOT.HOLDNG(CAGE))GOTO 2011
CALL INSERT(BIRD,CAGE)
CALL BITOFF(CAGE,OPENBT)
GOTO 2009
C SWORD: IF IN ANVIL, NEEDS CROWN & MUST YANK.
20170 IF(OBJ.NE.SWORD.OR.PROP(SWORD).EQ.0)GOTO 20180
IF(IOBJ.NE.0.AND.IOBJ.NE.ANVIL)GOTO 2070
IF(VERB.EQ.YANK)GOTO 20175
C HE WANTS THE SWORD, BUT HASN'T ESTABLISHED HIS ROYAL BLOOD, OR HE
C HASN'T PULLED HARD ENOUGH. OR NEITHER.
IF(.NOT.YES(215,0,0))GOTO 2009
20175 IF(WEARNG(CROWN))GOTO 20180
CALL PSPEAK(SWORD,2)
IF(CLOSED)GOTO 93000
FIXED(SWORD)=-1
PROP(SWORD)=3
GOTO 2100
20180 CALL CARRY(OBJ,LOC)
IF(OBJ.EQ.POLE.OR.OBJ.EQ.SKEY.OR.OBJ.EQ.SWORD
1 .OR.((OBJ.EQ.CLOAK.OR.OBJ.EQ.RING)
2 .AND..NOT.WEARNG(OBJ)) )PROP(OBJ)=0
IF(VERB.NE.YANK.OR.OBJ.EQ.SWORD)GOTO 2011
SPK=204
GOTO 2011
C THIS IS A QUASI-SUBROUTINE, CALLED FROM 'TAKE' AND FROM 'INSERT', WHEN
C THE ITEM IS NOT CURRENTLY BEING TOTED. 'RETN' IS A VARIABLE DEFINED
C TO BE THE RETURN ADDRESS.
20190 SPK=NOWAY(0)
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(OBJ.EQ.SWORD.AND.PROP(SWORD).EQ.5)SPK=208
IF(OBJ.EQ.CLOAK.AND.PROP(CLOAK).EQ.2)SPK=242
IF(OBJ.EQ.AXE.AND.PROP(AXE).EQ.2)SPK=246
IF(OBJ.EQ.PHONE)SPK=251
IF(OBJ.EQ.BEES.OR.OBJ.EQ.HIVE)SPK=295
IF(OBJ.EQ.STICKS)SPK=296
IF(FIXED(OBJ).NE.0)GOTO 2011
GOTO RETN
C DROP/DISCARD OBJECT. "THROW" ALSO COMES HERE FOR MOST OBJECTS.
C SPECIAL CASES FOR BIRD (MIGHT ATTACK SNAKE OR DRAGON) AND CAGE (MIGHT
C CONTAIN BIRD) AND VASE.
C DROP COINS IN VENDING MACHINE FOR EXTRA BATTERIES.
20200 IF(HOLDNG(ROD2).AND.OBJ.EQ.ROD.AND..NOT.HOLDNG(ROD))OBJ=ROD2
IF(PLURAL(OBJ))SPK=105
K=LIQ(BOTTLE)
IF(K.EQ.OBJ)OBJ=BOTTLE
IF(OBJ.NE.BOTTLE)K=LIQ(CASK)
IF(OBJ.NE.BOTTLE.AND.K.EQ.OBJ)OBJ=CASK
IF(.NOT.TOTING(OBJ))GOTO 2011
IF(PREP.EQ.PREPIN)GOTO 24500
IF(OBJ.NE.BIRD.OR..NOT.HERE(SNAKE))GOTO 20220
CALL RSPEAK(30)
IF(CLOSED)GOTO 93000
CALL REMOVE(BIRD)
CALL DSTROY(SNAKE)
C SET SNAKE PROP FOR USE BY TRAVEL OPTIONS
PROP(SNAKE)=1
CALL DROP(BIRD,LOC)
GOTO 2100
20220 SPK=344
IF(VERB.EQ.LEAVE)SPK=353
IF(VERB.EQ.THROW)SPK=352
IF(VERB.EQ.TAKE)SPK=54
IF(OBJ.NE.POLE.OR..NOT.HOLDNG(BOAT))GOTO 20240
SPK=280
GOTO 2011
20240 IF(OBJ.NE.BIRD.OR..NOT.AT(DRAGON).OR.PROP(DRAGON).NE.0)
1 GOTO 20260
CALL RSPEAK(154)
CALL REMOVE(BIRD)
CALL DSTROY(BIRD)
IF(PLACE(SNAKE).EQ.PLAC(SNAKE))TALLY2=TALLY2+1
GOTO 2100
20260 IF(OBJ.NE.BEAR.OR..NOT.AT(TROLL))GOTO 20270
SPK=163
CALL DSTROY(TROLL)
CALL DSTROY(TROLL+MAXOBJ)
CALL MOVE(TROLL2,PLAC(TROLL))
CALL MOVE(TROLL2+MAXOBJ,FIXD(TROLL))
CALL JUGGLE(CHASM)
PROP(TROLL)=2
GOTO 20290
20270 IF(OBJ.NE.VASE.OR.LOC.EQ.PLAC(PILLOW))GOTO 20275
PROP(VASE)=2
IF(AT(PILLOW))PROP(VASE)=0
CALL PSPEAK(VASE,PROP(VASE)+1)
IF(PROP(VASE).NE.0)FIXED(VASE)=-1
GOTO 20290
20275 IF(OBJ.NE.FLY.OR..NOT.AT(SPIDER)) GOTO 20280
PROP(FLY)=1
PROP(SPIDER)=1
SPK=379
CALL DSTROY(FLY)
GOTO 2011
20280 IF(WORN(OBJ).OR.OBJ.EQ.POLE.OR.OBJ.EQ.BOAT)PROP(OBJ)=0
IF(WORN(OBJ))CALL BITOFF(OBJ,WEARBT)
IF(OBJ.EQ.POLE)PROP(BOAT)=0
20290 IF(ENCLSD(OBJ))CALL REMOVE(OBJ)
CALL DROP(OBJ,LOC)
GOTO 2011
C OPEN/CLOSE/LOCK/UNLOCK: NO OBJECT GIVEN.
C ASSUME VARIOUS THINGS IF PRESENT.
10400 SPK=28
K=0
DO 10410 I=1,MAXOBJ
IF(.NOT.(HERE(I).AND.HINGED(I)))GOTO 10410
OBJ=I
K=K+1
10410 CONTINUE
IF(K.GT.1)GOTO 10000
IF(OBJ.NE.0)GOTO 10420
IF(VERB.EQ.LOCK.OR.VERB.EQ.UNLOCK)GOTO 2011
GOTO 10000
10420 IF(VERB.EQ.LOCK)GOTO 24900
IF(VERB.EQ.UNLOCK)GOTO 25000
IF(VERB.EQ.SHUT)GOTO 20600
C OPEN. SPECIAL STUFF FOR OPENING CLAM/OYSTER.
C THE FOLLOWING CAN BE OPENED WITHOUT A KEY:
C CLAM/OYSTER, DOOR, PDOOR, BOTTLE, CASK, CAGE
20400 IF(.NOT.HINGED(OBJ))GOTO 2070
SPK=253
IF(OBJ.EQ.PDOOR.AND.PROP(PDOOR).EQ.1)GOTO 2011
SPK=336
IF(AJAR(OBJ))GOTO 2011
IF(LOCKS(OBJ).OR.IOBJ.EQ.KEYS.OR.IOBJ.EQ.SKEY)GOTO 25000
SPK=337
IF(OBJ.EQ.DOOR)SPK=111
IF(LOCKED(OBJ))GOTO 2011
IF(OBJ.EQ.CLAM.OR.OBJ.EQ.OYSTER)GOTO 20410
CALL BITON(OBJ,OPENBT)
GOTO 2009
C CLAM/OYSTER.
20410 K=0
IF(OBJ.EQ.OYSTER)K=1
SPK=124+K
IF(HOLDNG(OBJ))SPK=120+K
IF(.NOT.ATHAND(TRIDNT))SPK=122+K
IF(IOBJ.NE.0.AND.IOBJ.NE.TRIDNT)SPK=376+K
IF(SPK.NE.124)GOTO 2011
CALL DSTROY(CLAM)
CALL DROP(OYSTER,LOC)
CALL DROP(PEARL,105)
GOTO 2011
C CLOSE. SHUT.
C THE FOLLOWING CAN BE CLOSED WITHOUT KEYS:
C DOOR, PDOOR, BOTTLE, CASK, CAGE
20600 IF(.NOT.HINGED(OBJ))GOTO 2070
SPK=338
IF(.NOT.AJAR(OBJ))GOTO 2011
IF(LOCKS(OBJ))GOTO 24900
CALL BITOFF(OBJ,OPENBT)
GOTO 2009
C LIGHT LAMP
20700 IF(.NOT.ATHAND(LAMP))GOTO 2011
SPK=184
IF(LIMIT.LT.0)GOTO 2011
SPK=321
IF(PROP(LAMP).EQ.1)GOTO 2011
PROP(LAMP)=1
K=39
IF(LOC.EQ.200)K=108
CALL RSPEAK(K)
IF(WZDARK)GOTO 2000
GOTO 2100
C LAMP OFF
20800 IF(.NOT.ATHAND(LAMP))GOTO 2011
SPK=322
IF(PROP(LAMP).EQ.0)GOTO 2011
PROP(LAMP)=0
CALL RSPEAK(40)
IF(DARK(0))CALL RSPEAK(16)
GOTO 2100
C WAVE. NO EFFECT UNLESS WAVING ROD AT FISSURE.
20900 IF((.NOT.HOLDNG(OBJ)).AND.(OBJ.NE.ROD.OR..NOT.HOLDNG(ROD2)))
1 SPK=29
IF(OBJ.NE.ROD.OR..NOT.AT(FISSUR).OR..NOT.HOLDNG(OBJ)
1 .OR.CLOSNG)GOTO 2011
IF(IOBJ.NE.0.AND.IOBJ.NE.FISSUR)GOTO 2011
PROP(FISSUR)=1-PROP(FISSUR)
CALL PSPEAK(FISSUR,2-PROP(FISSUR))
IF(CHASE.EQ.0.OR.PROP(FISSUR).NE.0)GOTO 2100
C DEMISE OF THE WUMPUS. CHAMP MUST HAVE JUST CROSSED BRIDGE.
IF((LOC.EQ.17.AND.OLDLOC.NE.27)
1 .OR.(LOC.EQ.27.AND.OLDLOC.NE.17))GOTO 2100
CALL RSPEAK(244)
CHASE=0
CALL DROP(RING,209)
CALL MOVE(WUMPUS,209)
PROP(WUMPUS)=6
CALL BITON(WUMPUS,DEADBT)
IF(PLACE(AXE).NE.PLAC(WUMPUS))GOTO 2100
FIXED(AXE)=0
PROP(AXE)=0
GOTO 2100
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 KILL OBJ WITH IOBJ.
21200 L1=DWFMAX-1
DO 21210 DWARFN=1,L1
IF(DLOC(DWARFN).EQ.LOC.AND.DFLAG.GE.2)GOTO 21220
21210 CONTINUE
DWARFN=0
21220 IF(OBJ.NE.0)GOTO 21240
IF(DWARFN.NE.0)OBJ=DWARF
IF(HERE(SNAKE))OBJ=OBJ*MAXOBJ+SNAKE
IF(AT(DRAGON).AND.PROP(DRAGON).EQ.0)OBJ=OBJ*MAXOBJ+DRAGON
IF(AT(TROLL))OBJ=OBJ*MAXOBJ+TROLL
IF(HERE(GNOME))OBJ=OBJ*MAXOBJ+GNOME
IF(HERE(BEAR).AND.PROP(BEAR).EQ.0)OBJ=OBJ*MAXOBJ+BEAR
IF(HERE(WUMPUS).AND.PROP(WUMPUS).EQ.0)OBJ=OBJ*MAXOBJ+WUMPUS
IF(OBJ.GT.MAXOBJ)GOTO 10000
IF(OBJ.NE.0)GOTO 21240
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=MAXOBJ*OBJ+CLAM
IF(OBJ.GT.MAXOBJ)GOTO 10000
21240 IF(OBJ.NE.BIRD)GOTO 21245
SPK=137
IF(CLOSED)GOTO 2011
CALL DSTROY(BIRD)
PROP(BIRD)=0
IF(PLACE(SNAKE).EQ.PLAC(SNAKE))TALLY2=TALLY2+1
SPK=45
21245 IF(OBJ.NE.FLY)GOTO 21250
PROP(FLY)=2
SPK=398
CALL DSTROY(FLY)
GOTO 2011
21250 IF(OBJ.EQ.DWARF)GOTO 21270
IF(OBJ.EQ.0)SPK=44
IF(OBJ.EQ.CLAM.OR.OBJ.EQ.OYSTER)SPK=150
IF(AT(DOG).AND.PROP(DOG).EQ.1)SPK=291
IF(OBJ.EQ.SNAKE)SPK=46
IF(OBJ.EQ.DRAGON.OR.(OBJ.EQ.WUMPUS.AND.PROP(WUMPUS).EQ.6))SPK=167
IF(OBJ.EQ.TROLL)SPK=157
IF(OBJ.EQ.BEAR)SPK=165+(PROP(BEAR)+1)/2
IF(OBJ.EQ.GNOME)SPK=320
IF(IOBJ.NE.AXE.OR.VERB.EQ.THROW.OR.
1 (OBJ.NE.DOG.AND.OBJ.NE.WUMPUS.AND.OBJ.NE.DRAGON
2 .AND.OBJ.NE.TROLL))GOTO 21253
IOBJ=OBJ
OBJ=IOBJS(IOBX)
SPK=110
GOTO 21700
21253 IF(IOBJ.NE.0.AND.IOBJ.NE.AXE)GOTO 2070
IF(OBJ.NE.DRAGON.OR.PROP(DRAGON).NE.0)GOTO 2011
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 THERE IS SOME AMOUNT OF PAIN HERE, TO FORCE GETWDS TO DO THE RIGHT THING.
CALL RSPEAK(49)
CALL GETLIN
WDX=0
CALL CLRLIN
IF(TXT(1,1).EQ.'Y'.OR.TXT(1,1).EQ.'YES')GOTO 21255
WORDS(1)=-2
RDFLAG=.TRUE.
GOTO 2600
21255 CALL PSPEAK(DRAGON,1)
CALL BITON(DRAGON,DEADBT)
PROP(DRAGON)=2
PROP(RUG)=0
K=(PLAC(DRAGON)+FIXD(DRAGON))/2
CALL MOVE(DRAGON+MAXOBJ,-1)
CALL MOVE(RUG+MAXOBJ,0)
CALL MOVE(DRAGON,K)
CALL MOVE(RUG,K)
DO 21260 OBJ=1,MAXOBJ
IF(PLACE(OBJ).EQ.PLAC(DRAGON).OR.PLACE(OBJ).EQ.FIXD(DRAGON))
1 CALL MOVE(OBJ,K)
21260 CONTINUE
WORDS(1)=0
LOC=K
NEWLOC=K
GOTO 2
C HE IS ATTACKING A DWARF. IF USING SOMETHING OTHER THAN AXE OR SWORD,
C GOODBYE CHARLIE. IF USING NOTHING, DON'T LET HIM. IF USING AXE OR
C SWORD, THE FOLLOWING ODDS PREVAIL (IF I CALCULATED THIS MESS RIGHT!)
C (THE END OF LINE FIGURE IS THE CULULATIVE PROBABILITY OF THE EVENT):
C .25 - HERO KILLS DWARF (.25)
C .75 - HERO MISSES
C .25 - HERO GETS KNIFE IN (HIS) RIBS. DIES. (.1875)
C .75 - HERO CAN'T MAKE A CLEAN THRUST
C .36 - STANDOFF (.2)
C .64 - DWARF SLASHES
C .61 - DWARF MISSES! (.22)
C .39 - DWARF KILLS HERO (.14)
C ADVENTURER HAS 1/3 CHANCE OF GETTING NAILED, 1/4 CHANCE OF NAILING
C DWARF. ALL BY WAY OF ENCOURAGING HIM TO THROW THE AXE.
21270 IF(OBJ.EQ.DWARF.AND.CLOSED)GOTO 93000
SPK=49
IF(IOBJ.EQ.0)GOTO 2011
SPK=355
IF(IOBJ.NE.AXE.AND.IOBJ.NE.SWORD)GOTO 21275
IF(PCT(25))GOTO 21753
IF(PCT(25))GOTO 21275
CALL RSPEAK(354)
IF(PCT(36))GOTO 2100
CALL RSPEAK(356)
SPK=52
IF(PCT(61))GOTO 2011
SPK=53
C HERO IS GONZO.
21275 CALL RSPEAK(SPK)
OLDLC2=LOC
GOTO 94100
C POUR. IF NO OBJECT, ASSUME LIQ IN CONTAINER, IF HOLDING ONLY ONE.
C SPECIAL TESTS FOR POURING WATER OR OIL ON PLANT OR RUSTY DOOR.
11300 IF(.NOT.HOLDNG(BOTTLE).AND..NOT.HOLDNG(CASK))GOTO 10000
K=LIQ(BOTTLE)
KK=LIQ(CASK)
IF(HOLDNG(BOTTLE).AND.K.NE.0.AND.HOLDNG(CASK)
1 .AND.KK.NE.0)GOTO 10000
IF(KK.NE.0.AND.HOLDNG(CASK))OBJ=CASK
IF(K.NE.0.AND.HOLDNG(BOTTLE))OBJ=BOTTLE
IF(OBJ.EQ.0)GOTO 10000
C POUR OBJ FROM IOBJ.
21300 SPK=78
IF(OBJ.NE.BOTTLE.AND.OBJ.NE.CASK)GOTO 21310
IOBJ=OBJ
OBJ=LIQ(IOBJ)
SPK=316
IF(OBJ.EQ.0)GOTO 2011
GOTO 21320
21310 IF(OBJ.LT.WATER.OR.OBJ.GT.WINE+1)GOTO 2011
SPK=29
IF(.NOT.HOLDNG(BOTTLE).AND..NOT.HOLDNG(CASK))GOTO 2011
IF(HOLDNG(BOTTLE).AND.LIQ(BOTTLE).EQ.OBJ)IOBJ=BOTTLE
IF(HOLDNG(CASK).AND.LIQ(CASK).EQ.OBJ)IOBJ=CASK
IF(IOBJ.EQ.0)GOTO 2011
21320 SPK=335
IF(.NOT.AJAR(IOBJ))GOTO 2011
IF(IOBJ.EQ.CASK)OBJ=OBJ+1
PROP(IOBJ)=1
CALL REMOVE(OBJ)
PLACE(OBJ)=0
SPK=77
IF(IOBJ.NE.CASK)GOTO 21330
OBJ=OBJ-1
SPK=104
21330 IF(.NOT.(AT(PLANT).OR.AT(DOOR).OR.AT(SWORD)).OR.
1 AT(SWORD).AND.PROP(SWORD).EQ.0)GOTO 2011
IF(AT(DOOR))GOTO 21340
IF(AT(SWORD))GOTO 21350
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
NEWLOC=LOC
GOTO 2
21340 PROP(DOOR)=0
IF(OBJ.NE.OIL)GOTO 21341
PROP(DOOR)=1
CALL BITOFF(DOOR,LOCKBT)
CALL BITON(DOOR,OPENBT)
21341 SPK=113+PROP(DOOR)
GOTO 2011
C IF SWORD IS ALREADY OILY, DON'T LET HIM CLEAN IT. NO SOAP.
21350 IF(PROP(SWORD).EQ.5)GOTO 21360
PROP(SWORD)=4
IF(OBJ.NE.OIL)GOTO 21360
PROP(SWORD)=5
FIXED(SWORD)=-1
21360 SPK=206+PROP(SWORD)-4
GOTO 2011
C EAT. INTRANSITIVE: ASSUME EDIBLE IF PRESENT, ELSE ASK WHAT. TRANSITIVE:
C FOOD/MUSHROOMS/CAKES OK, SOME THINGS LOSE APPETITE, REST ARE RIDICULOUS.
C IF HE HAS MORE THAN ONE EDIBLE, OR NONE, 'EAT' IS AMBIGUOUS WITHOUT
C AN EXPLICIT OBJECT.
11400 K=0
DO 11410 I=1,MAXOBJ
IF(.NOT.(HERE(I).AND.EDIBLE(I))) GOTO 11410
K=K+1
KK=I
11410 CONTINUE
IF(K.NE.1)GOTO 10000
OBJ=KK
IF(OBJ.NE.FOOD.AND.OBJ.NE.HONEY)GOTO 21400
11420 IF(OBJ.EQ.HONEY)TALLY2=TALLY2+1
CALL DSTROY(OBJ)
SPK=72
GOTO 2011
C IF HE ATE THE RIGHT THING AND IS IN THE RIGHT PLACE, MOVE HIM TO
C THE OTHER PLACE WITH ALL HIS JUNK. OTHERWISE, NARKY MESSAGE.
21400 IF(OBJ.EQ.FOOD.OR.OBJ.EQ.HONEY)GOTO 11420
IF(OBJ.EQ.BIRD.OR.OBJ.EQ.SNAKE.OR.OBJ.EQ.CLAM.OR.OBJ.EQ.OYSTER
1 .OR.OBJ.EQ.FLOWER.OR.OBJ.EQ.FLY)SPK=301
IF(OBJ.EQ.DWARF.OR.OBJ.EQ.DRAGON.OR.OBJ.EQ.TROLL
1 .OR.OBJ.EQ.DOG.OR.OBJ.EQ.WUMPUS.OR.OBJ.EQ.BEAR
2 .OR.OBJ.EQ.GNOME)SPK=250
IF(OBJ.NE.MUSHRM.AND.OBJ.NE.CAKES)GOTO 2011
K=OBJ-MUSHRM
LL=229+K
K=159-K
KK=SKEY
IF(OBJ.EQ.MUSHRM)KK=TDOOR
IF(OBJ.EQ.MUSHRM.AND.LOC.NE.158)TALLY2=TALLY2+1
CALL DSTROY(OBJ)
SPK=228
C IF(.NOT. (HERE(INTS(KK)).OR.FIXED(KK).EQ.LOC) )GOTO 2011
IF(.NOT. (HERE((KK)).OR.FIXED(KK).EQ.LOC) )GOTO 2011!REMOVED INTS, M.V.
CALL RSPEAK(LL)
C IF HE HASN'T TAKEN TINY KEY OFF SHELF, DON'T LET HIM GET IT FOR FREE!
DO 21440 OBJ=1,MAXOBJ
IF(OBJ.EQ.SKEY.AND.PROP(SKEY).EQ.1)GOTO 21440
IF(PLACE(OBJ).EQ.PLAC(KK).AND.FIXED(OBJ).EQ.0)CALL MOVE(OBJ,K)
21440 CONTINUE
IF(LOC.EQ.PLAC(SKEY).AND.PLACE(SKEY).EQ.PLAC(SKEY))
1 TALLY2=TALLY2+1
LOC=K
NEWLOC=K
GOTO 2
C DRINK. IF NO OBJECT, ASSUME WATER OR WINE AND LOOK FOR THEM HERE.
C IF POTABLE IS IN BOTTLE OR CASK, DRINK THAT. IF NOT, SEE IF THERE
C IS SOMETHING DRINKABLE NEARBY (STREAM, LAKE, WINE FOUNTAIN, ETC.),
C AND DRINK THAT. IF HE HAS STUFF IN BOTH CONTAINERS, ASK WHICH.
C DRINK OBJ FROM IOBJ
11500 LL=LIQLOC(LOC)
IF(.NOT.ATHAND(BOTTLE).AND..NOT.ATHAND(CASK)
1 .AND.LL.NE.WINE.AND.LL.NE.WATER)GOTO 10000
K=LIQ(BOTTLE)
KK=LIQ(CASK)
IF(.NOT.ATHAND(BOTTLE).OR.K.EQ.0)GOTO 11520
IF(ATHAND(CASK).AND.KK.NE.0.AND.KK.NE.K)GOTO 10000
OBJ=K
IOBJ=BOTTLE
GOTO 21560
11520 IF(.NOT.ATHAND(CASK).OR.KK.EQ.0)GOTO 11540
OBJ=KK
IOBJ=CASK
GOTO 21560
11540 IF(LL.EQ.0)GOTO 10000
OBJ=LL
IOBJ=-1
GOTO 21560
21500 IF(OBJ.EQ.0.AND.(IOBJ.EQ.BOTTLE.OR.IOBJ.EQ.CASK))OBJ=LIQ(IOBJ)
SPK=110
IF(OBJ.EQ.OIL)SPK=301
IF(OBJ.NE.WATER.AND.OBJ.NE.WINE)GOTO 2011
IF(IOBJ.NE.0)GOTO 21560
IF(OBJ.EQ.LIQLOC(LOC))IOBJ=-1
IF(ATHAND(CASK).AND.OBJ.EQ.LIQ(CASK))IOBJ=CASK
IF(ATHAND(BOTTLE).AND.OBJ.EQ.LIQ(BOTTLE))IOBJ=BOTTLE
21560 SPK=73
IF(IOBJ.EQ.-1)GOTO 21570
IF(IOBJ.EQ.CASK)OBJ=OBJ+1
CALL REMOVE(OBJ)
PLACE(OBJ)=0
PROP(IOBJ)=1
SPK=74
IF(IOBJ.EQ.CASK)SPK=299
21570 IF(OBJ.EQ.WATER.OR.OBJ.EQ.WATER+1)GOTO 2011
C UH-OH. HE'S A WINO. LET HIM REAP THE REWARDS OF INCONTINENCE.
C HE'LL WANDER AROUND FOR AWHILE, THEN WAKE UP SOMEWHERE OR OTHER,
C HAVING DROPPED MOST OF HIS STUFF.
CALL RSPEAK(300)
IF(PROP(LAMP).EQ.1)LIMIT=LIMIT-RAN(LIMIT)/2
IF(LIMIT.LT.10)LIMIT=25
K=0
IF(PCT(15))K=49
IF(K.EQ.0.AND.PCT(15))K=53
IF(K.EQ.0.AND.PCT(25))K=132
IF(K.EQ.0)K=175
IF(OUTSID(LOC))K=5
IF(K.EQ.LOC)GOTO 2100
IF(HOLDNG(AXE))CALL MOVE(AXE,K)
IF(HOLDNG(LAMP))CALL MOVE(LAMP,K)
DO 21580 J=1,MAXOBJ
IF(WEARNG(J))CALL BITOFF(J,WEARBT)
21580 IF(HOLDNG(J))CALL DROP(J,LOC)
LOC=K
NEWLOC=K
GOTO 2
C RUB. YIELDS VARIOUS SNIDE REMARKS.
21600 IF(OBJ.NE.LAMP)SPK=76
GOTO 2011
C THROW OBJ AT IOBJ.
C SAME AS DISCARD UNLESS AXE. THEN SAME AS ATTACK EXCEPT IGNORE BIRD,
C AND IF DWARF IS PRESENT THEN ONE MIGHT BE KILLED.
C AXE ALSO SPECIAL FOR DRAGON, BEAR, DOG, WUMPUS AND TROLL.
C TREASURES SPECIAL FOR TROLL.
C IF THROWING FOOD AT SOMEONE WHO MIGHT BE HUNGRY, GO FEED HIM.
21700 IF(PREP.EQ.PREPDN)GOTO 24200
IF(HOLDNG(ROD2).AND.OBJ.EQ.ROD.AND..NOT.HOLDNG(ROD))OBJ=ROD2
IF(.NOT.HOLDNG(OBJ))GOTO 2011
IF(OBJ.EQ.BOAT.OR.OBJ.EQ.BEAR)GOTO 2070
DWARFN=0
IF(IOBJ.NE.0)GOTO 21750
C NO INDIRECT OBJ WAS SPECIFIED. IF A DWARF IS PRESENT, ASSUME IT
C IS THE IOBJ. IF NOT, LOOK FOR ANY OTHER LIVING THING. IF NO LIVING
C THINGS PRESENT, TREAT 'THROW' AS 'DROP'.
L1=DWFMAX-1
DO 21710 DWARFN=1,L1
IF(DLOC(DWARFN).EQ.LOC.AND.DFLAG.GE.2)GOTO 21718
21710 CONTINUE
DWARFN=0
C NO DWARVES PRESENT; FIGURE OUT PLAUSIBLE OBJECT.
K=0
DO 21715 I=1,MAXOBJ
IF(.NOT. (AT(I).AND.LIVING(I)) )GOTO 21715
IOBJ=I
K=K+1
21715 CONTINUE
IF(K.EQ.0)GOTO 20200
C IT IS A BEASTIE OF SOME SORT. IS THERE MORE THAN ONE?
C DON'T KILL THE BIRD BY DEFAULT.
21717 IF(K.EQ.1)GOTO 21718
CALL RSPEAK(43)
GOTO 2600
21718 IF(IOBJ.EQ.BIRD)GOTO 20200
IF(TREASR(OBJ).AND.AT(TROLL))IOBJ=TROLL
21750 IF(TREASR(OBJ).AND.IOBJ.EQ.TROLL)GOTO 21790
IF(OBJ.EQ.SWORD.OR.OBJ.EQ.BOTTLE)GOTO 22800
IF(DWARFN.NE.0)IOBJ=DWARF
IF(EDIBLE(OBJ).AND.LIVING(IOBJ))GOTO 22100
IF(OBJ.NE.AXE)GOTO 20200
SPK=152
IF(IOBJ.EQ.DRAGON.AND.PROP(DRAGON).EQ.0)GOTO 21755
SPK=158
IF(IOBJ.EQ.TROLL)GOTO 21755
IF(IOBJ.NE.DWARF)GOTO 21760
SPK=48
C IF SAVED NOT = -1, HE BYPASSED THE "START" CALL.
IF(RAN(3).EQ.0.OR.SAVED.NE.-1)GOTO 21755
IF(DWARFN.NE.0)GOTO 21753
L1=DWFMAX-1
DO 21752 DWARFN=1,L1
IF(DLOC(DWARFN).EQ.LOC.AND.DFLAG.GE.2)GOTO 21753
21752 CONTINUE
C 'ATTACK' WITH AXE OR SWORD LINKS IN HERE.
21753 DSEEN(DWARFN)=.FALSE.
DLOC(DWARFN)=0
SPK=47
DKILL=DKILL+1
IF(DKILL.EQ.1)SPK=149
21755 CALL RSPEAK(SPK)
CALL DROP(AXE,LOC)
NEWLOC=LOC
GOTO 2
C THIS'LL TEACH HIM TO THROW THE AXE AT THE BEAR!
21760 IF(IOBJ.NE.BEAR.OR.PROP(BEAR).NE.0)GOTO 21765
SPK=164
CALL DROP(AXE,LOC)
FIXED(AXE)=-1
PROP(AXE)=1
CALL JUGGLE(BEAR)
GOTO 2011
C OR THE WUMPUS!
21765 IF(IOBJ.NE.WUMPUS.OR.PROP(WUMPUS).EQ.6)GOTO 21770
IF(PROP(WUMPUS).EQ.6)GOTO 20200
SPK=245
PROP(AXE)=2
IF(PROP(WUMPUS).EQ.0)GOTO 21780
SPK=243
CALL DSTROY(AXE)
GOTO 2011
C OR THE NICE DOGGIE!
21770 IF(IOBJ.NE.DOG.OR.PROP(DOG).EQ.1)GOTO 21790
SPK=248
PROP(AXE)=3
21780 CALL DROP(AXE,LOC)
FIXED(AXE)=-1
CALL JUGGLE(IOBJ)
GOTO 2011
C SNARF A TREASURE FOR THE TROLL.
21790 IF(IOBJ.NE.TROLL)GOTO 21795
PREP=0
IF(OBJ.EQ.CASK.AND.LIQ(CASK).NE.WINE)GOTO 20200
SPK=159
CALL DROP(OBJ,0)
IF(OBJ.EQ.CASK)PLACE(WINE+1)=0
CALL MOVE(TROLL,0)
CALL MOVE(TROLL+MAXOBJ,0)
CALL DROP(TROLL2,PLAC(TROLL))
CALL DROP(TROLL2+MAXOBJ,FIXD(TROLL))
CALL JUGGLE(CHASM)
GOTO 2011
C THROWING AXE AT NONE OF THE ABOVE. ASSUME 'ATTACK'.
21795 OBJ=IOBJ
IOBJ=OBJS(OBJX)
GOTO 21200
C QUIT. INTRANSITIVE ONLY. VERIFY INTENT AND EXIT IF THAT'S WHAT HE WANTS.
11800 GAVEUP=YES(22,54,54)
11850 IF(GAVEUP)GOTO 95000
GOTO 2100
C FIND. MIGHT BE CARRYING IT, OR IT MIGHT BE HERE. ELSE GIVE CAVEAT.
21900 IF(AT(OBJ).OR.(LIQ(BOTTLE).EQ.OBJ.AND.AT(BOTTLE))
1 .OR.K.EQ.LIQLOC(LOC))SPK=94
L1=DWFMAX-1
DO 21920 I=1,L1
21920 IF(DLOC(I).EQ.LOC.AND.DFLAG.GE.2.AND.OBJ.EQ.DWARF)SPK=94
IF(CLOSED)SPK=138
IF(ATHAND(OBJ))SPK=24
GOTO 2011
C INVENTORY. IF OBJECT, TREAT SAME AS FIND. ELSE REPORT ON CURRENT BURDEN.
C THERE ARE SOME FUNNY CASES, LIKE THE WEARABLE THINGS. ALSO, BOAT
C AND BEAR, WHICH AREN'T REALLY CARRIED. LIST OUTER-LEVEL CONTAINERS
C AND CONTENTS, IF CONTAINER IS OPEN OR TRANSPARENT.
12000 SPK=98
DO 12050 I=1,MAXOBJ
IF(I.EQ.BEAR.OR.I.EQ.BOAT.OR..NOT.HOLDNG(I))GOTO 12050
IF(WEARNG(I))GOTO 12050
IF(SPK.EQ.98)CALL RSPEAK(99)
BLKLIN=.FALSE.
CALL PSPEAK(I,-1)
SPK=0
IF(I.NE.BOAT)CALL LOOKIN(I)
12050 CONTINUE
C TELL HIM WHAT HE IS WEARING.
K=0
DO 12060 I=1,MAXOBJ
IF(.NOT.WEARNG(I))GOTO 12060
IF(K.EQ.0)PRINT 12052
12052 FORMAT(1H ,'You are wearing:')
C CALL TNOUA(' ',5)
C HOPE REMOVING THIS IS OK, M.V.
CALL PSPEAK(I,-1)
K=-1
12060 CONTINUE
IF(.NOT.HOLDNG(BOAT))GOTO 12090
CALL RSPEAK(221)
CALL LOOKIN(BOAT)
12090 IF(HOLDNG(BEAR))SPK=141
GOTO 2011
C FEED. IF BIRD, NO SEED. SNAKE, DRAGON, TROLL: QUIP. IF DWARF, MAKE HIM
C MAD. BEAR, SPECIAL.
C CASE 1: FEED CRITTER. *OR*
C CASE 2: FEED CRITTER EDIBLE.
C [** THIS CASE TRANSFORMED BY PARSER INTO CASE 3 **]
C CASE 3: FEED EDIBLE TO CRITTER.
22100 IF(IOBJ.NE.0.AND.LIVING(IOBJ))GOTO 22120
SPK=100
IF(OBJ.EQ.BIRD)GOTO 2011
IF(.NOT.LIVING(OBJ))GOTO 2070
C SEE IF THERE IS ANYTHING EDIBLE AROUND HERE.
KK=0
K=0
DO 22110 I=1,MAXOBJ
IF(.NOT.HERE(I).OR..NOT.EDIBLE(I))GOTO 22110
K=K+1
KK=I
22110 CONTINUE
IOBJ=OBJ
OBJ=KK
IF(K.EQ.1.OR.DEAD(IOBJ))GOTO 22120
CALL A5TOA1(OTXT(OBJX,1),OTXT(OBJX,2),'?',TK,K)
PRINT 22112,(TK(I),I=1,K)
22112 FORMAT (/' What do you want to feed the ',20A1)
OBJS(1)=0
OBJX=0
GOTO 2600
C FEED OBJ TO IOBJ.
22120 IF(IOBJ.NE.SNAKE.AND.IOBJ.NE.DRAGON.AND.IOBJ.NE.TROLL)GOTO 22130
SPK=102
IF(IOBJ.EQ.DRAGON.AND.PROP(DRAGON).NE.0)SPK=NOWAY(0)
IF(IOBJ.EQ.TROLL)SPK=182
IF(IOBJ.NE.SNAKE.OR.CLOSED.OR.OBJ.NE.BIRD)GOTO 2011
SPK=101
CALL DSTROY(BIRD)
PROP(BIRD)=0
TALLY2=TALLY2+1
GOTO 2011
C FEED DWARF?
22130 IF(IOBJ.NE.DWARF)GOTO 22140
SPK=103
DFLAG=DFLAG+1
GOTO 2011
C FEED BEAR?
22140 SPK=102
IF(IOBJ.NE.BEAR)GOTO 22150
IF(PROP(BEAR).EQ.3)SPK=NOWAY(0)
IF(PROP(BEAR).EQ.1.OR.PROP(BEAR).EQ.2)SPK=264
IF(OBJ.EQ.FOOD)SPK=278
IF(OBJ.NE.HONEY)GOTO 2011
PROP(BEAR)=1
FIXED(AXE)=0
PROP(AXE)=0
SPK=168
CALL DSTROY(HONEY)
GOTO 2011
C FEED DOG?
22150 IF(IOBJ.NE.DOG)GOTO 22160
IF(PROP(DOG).EQ.1)SPK=291
IF(OBJ.NE.FOOD.OR.PROP(DOG).EQ.1)GOTO 2011
SPK=249
CALL DSTROY(FOOD)
GOTO 2011
C FEED WUMPUS?
22160 IF(IOBJ.NE.WUMPUS)GOTO 22170
IF(PROP(WUMPUS).EQ.6)SPK=326
IF(PROP(WUMPUS).EQ.0)SPK=327
IF(OBJ.EQ.FOOD)SPK=240
GOTO 2011
C FEED BEES?
22170 IF(IOBJ.NE.BEES.OR.OBJ.NE.FLOWER)GOTO 2070
IF(ENCLSD(FLOWER))CALL REMOVE(FLOWER)
CALL DROP(FLOWER,LOC)
FIXED(FLOWER)=-1
PROP(FLOWER)=1
CALL DROP(HONEY,LOC)
CALL JUGGLE(HONEY)
SPK=267
PROP(HIVE)=1
GOTO 2011
C FILL. BOTTLE/CASK MUST BE EMPTY, AND SOME LIQUID AVAILABLE.
C (VASE IS NASTY & GRAIL IS CRACKED.)
12200 IF( (.NOT.HERE(BOTTLE).AND..NOT.HERE(CASK)) .OR.
1 (HERE(BOTTLE).AND.HERE(CASK)) )GOTO 10000
IF(PROP(CASK).EQ.1.AND.HERE(CASK))OBJ=CASK
IF(PROP(BOTTLE).EQ.1.AND.HERE(BOTTLE))OBJ=BOTTLE
IF(OBJ.EQ.0)GOTO 10000
C FILL OBJ WITH IOBJ
22200 SPK=313
IF(.NOT.VESSEL(OBJ))GOTO 2011
IF(IOBJ.EQ.0)IOBJ=LIQLOC(LOC)
IF(OBJ.NE.BOTTLE.AND.OBJ.NE.CASK)GOTO 22220
K=0
IF(OBJ.EQ.CASK)K=1
SPK=0
IF(IOBJ.EQ.0)SPK=304+K
IF(LIQ(OBJ).NE.0)SPK=302+K
IF(SPK.NE.0)GOTO 2011
SPK=306+K
IF(IOBJ.EQ.OIL)SPK=308+K
IF(IOBJ.EQ.WINE)SPK=310+K
PROP(OBJ)=MOD(LOCCON(LOC),8)/2*2
PLACE(IOBJ+K)=-1
CALL INSERT(IOBJ+K,OBJ)
GOTO 2011
C VASE. (NASTY).
22220 IF(OBJ.NE.VASE)GOTO 22230
SPK=144
IF(IOBJ.EQ.0.OR..NOT.HOLDNG(VASE))GOTO 2011
CALL RSPEAK(145)
PROP(VASE)=2
FIXED(VASE)=-1
GOTO 20290
C GRAIL OR OTHER.
22230 SPK=339
IF(OBJ.EQ.GRAIL)SPK=298
GOTO 2011
C BLAST. NO EFFECT UNLESS YOU'VE GOT DYNAMITE, WHICH IS A NEAT TRICK!
12300 IF(PROP(ROD2).GT.0.AND.CLOSED)GOTO 12310
IF(.NOT.ISWIZ)GOTO 2011
DO 12305 I=1,5
IF(LOC.NE.DLOC(I))GOTO 12305
DLOC(I)=0
DSEEN(I)=.FALSE.
12305 CONTINUE
GOTO 2011
12310 BONUS=133
IF(LOC.EQ.115)BONUS=134
IF(HERE(ROD2))BONUS=135
CALL RSPEAK(BONUS)
GOTO 95000
C SCORE.
12400 SCORNG=.TRUE.
CALL RATING(SCORE,MXSCOR,BONUS,GAVEUP,SCORNG,CLOSNG,CLOSED)
SCORNG=.FALSE.
PRINT 12412,SCORE,MXSCOR,TURNS
12412 FORMAT(/' If you were to quit now, you would score',I4
1 ,' out of',I4,' using',I4,' turns.')
C GAVEUP=YES(143,54,54)
C GOTO 11850
GOTO 2100
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).
12500 K=VOCABX(VTXT(VRBX,1),4)
SPK=42
IF(FOOBAR.EQ.1-K)GOTO 12520
IF(FOOBAR.NE.0)SPK=151
GOTO 2011
12520 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 2100
C BRIEF/UNBRIEF. INTRANSITIVE ONLY.
C SUPPRESS LONG DESCRIPTIONS AFTER FIRST TIME.
12600 DETAIL=3
TERSE=.FALSE.
IF(ABBNUM.EQ.10000)GOTO 12610
SPK=156
ABBNUM=10000
GOTO 2011
12610 ABBNUM=5
SPK=374
GOTO 2011
22600 IF(OBJ.NE.0.AND.LIVING(OBJ).AND.IOBJ.NE.0)GOTO 2011
GOTO 2060
C READ. MAGAZINES IN DWARVISH, MESSAGE WE'VE SEEN, AND . . . OYSTER?
22700 IF(BLIND(0))GOTO 2011
IF(OBJ.NE.0.AND.IOBJ.NE.0)GOTO 2060
SPK=CONFUZ(0)
IF(OBJ.EQ.0)OBJ=IOBJ
IF(OBJ.EQ.BOOK.OR.OBJ.EQ.BOOK2)SPK=142
IF(OBJ.EQ.BILLBD)SPK=361
IF(OBJ.EQ.CARVNG)SPK=372
IF(OBJ.EQ.MAGZIN)SPK=190
IF(OBJ.EQ.MESSAG)SPK=191
IF(OBJ.EQ.OYSTER.AND.HINTED(2).AND.HOLDNG(OYSTER))SPK=194
IF(OBJ.EQ.POSTER)SPK=370
IF(OBJ.EQ.TABLET)SPK=196
IF(OBJ.NE.OYSTER.OR.HINTED(2).OR..NOT.HOLDNG(OYSTER)
1 .OR..NOT.CLOSED)GOTO 2011
HINTED(2)=YES(192,193,54)
GOTO 2100
C BREAK. WORKS FOR MIRROR IN REPOSITORY AND, OF COURSE, THE
C VASE AND BOTTLE. ALSO, THE SWORD IS MORE BRITTLE THAN IT APPEARS.
22800 IF(OBJ.EQ.MIRROR)SPK=148
IF(OBJ.EQ.VASE.AND.PROP(VASE).EQ.0)GOTO 22820
IF(OBJ.EQ.BOTTLE.AND.PROP(BOTTLE).NE.3)GOTO 22840
IF(OBJ.EQ.SWORD)GOTO 22860
IF(OBJ.NE.MIRROR.OR..NOT.CLOSED)GOTO 2011
CALL RSPEAK(197)
GOTO 93000
22820 SPK=198
PROP(VASE)=2
22830 IF(ENCLSD(OBJ))CALL REMOVE(OBJ)
IF(HOLDNG(OBJ))CALL DROP(OBJ,LOC)
FIXED(OBJ)=-1
GOTO 2011
22840 SPK=231
K=LIQ(BOTTLE)
PROP(BOTTLE)=3
IF(K.EQ.0)GOTO 22830
CALL REMOVE(K)
PLACE(K)=0
GOTO 22830
C HE'D BETTER NOT SLING THE SWORD AROUND!
22860 SPK=29
IF(.NOT.HOLDNG(SWORD))GOTO 2011
SPK=279
PROP(SWORD)=4
GOTO 22830
C ERWACHE. ONLY USE IS TO DISTURB THE DWARVES OR THE WUMPUS.
C OTHER WUMPUS-WAKERS LINK HERE.
22900 IF(.NOT.AT(WUMPUS))GOTO 22940
CHASE=1
PROP(WUMPUS)=1
SPK=276
GOTO 2011
22940 IF(AT(DOG).AND.PROP(DOG).EQ.1)SPK=291
IF(OBJ.NE.DWARF.OR..NOT.CLOSED)GOTO 2011
CALL RSPEAK(199)
GOTO 93000
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 13050 TO PICK UP AGAIN.
13000 SPK=201
IF(DEMO)GOTO 2011
PRINT 13010,LATNCY
13010 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 2100
CALL DATIME(SAVED,SAVET)
SETUP=-1
CALL CIAO
13050 YEA=START(0)
SETUP=3
VERBS(1)=NULL
VRBX=1
VERBS(2)=0
OBJS(1)=0
OBJX=0
GOTO 2750
C HOURS. REPORT CURRENT NON-PRIME-TIME HOURS.
13100 CALL MSPEAK(6)
CALL HOURS
GOTO 2100
C YANK. A VARIANT OF 'CARRY'. IN GENERAL, NOT A GOOD IDEA.
C AT MOST, IT GETS THE CLOAK OR A COUPLE SNIDE COMMENTS.
23200 IF(TOTING(OBJ))GOTO 20200
IF(OBJ.EQ.PLANT.OR.OBJ.EQ.SWORD.OR.OBJ.EQ.CHAIN)GOTO 20100
SPK=205
IF(OBJ.EQ.BEAR.AND.PROP(CHAIN).EQ.1)GOTO 2011
IF(OBJ.EQ.CLOAK.AND.PROP(CLOAK).EQ.2)GOTO 20120
GOTO 20100
C WEAR: ONLY GOOD FOR JEWELS, RUBY SLIPPERS, CLOAK & CROWN.
C BUT HE MIGHT TRY THE SWORD. ANYTHING ELSE IS RIDICULOUS.
C ANOTHER VARIANT OF 'CARRY'.
23300 SPK=209
IF(OBJ.EQ.SWORD.AND.PROP(SWORD).NE.3)GOTO 2011
IF(WORN(OBJ))GOTO 23320
23310 CALL A5TOA1(OTXT(OBJX,1),OTXT(OBJX,2),'?',TK,K)
PRINT 23312,(TK(I),I=1,K)
23312 FORMAT(/' Just exactly how does one wear a ',20A1)
GOTO 2100
23320 SPK=242
IF(OBJ.EQ.CLOAK.AND.PROP(CLOAK).EQ.2)GOTO 2011
SPK=210
IF(OBJ.EQ.SHOES)SPK=227
IF(WEARNG(OBJ))GOTO 2011
PROP(OBJ)=1
CALL BITON(OBJ,WEARBT)
IF(ENCLSD(OBJ))CALL REMOVE(OBJ)
IF(HOLDNG(OBJ))GOTO 2009
GOTO 20120
C HIT. IF NOT PUNCHING OUT TELEPHONE, ASSUME ATTACK.
23400 IF(AT(WUMPUS).AND.PROP(WUMPUS).EQ.0)GOTO 22900
IF(OBJ.NE.PHONE)GOTO 21200
IF(CLOSED)GOTO 93100
SPK=256
IF(PROP(PHONE).EQ.2)GOTO 2011
CALL DROP(SLUGS,LOC)
SPK=257
PROP(PHONE)=2
PROP(BOOTH)=2
GOTO 2011
C ANSWER (TELEPHONE). SMARTASS FOR ANYTHING ELSE.
13500 IF(LOC.NE.189.OR.PROP(PHONE).NE.0)GOTO 10000
OBJ=PHONE
23500 IF(OBJ.NE.PHONE)GOTO 23520
SPK=269
IF(PROP(PHONE).NE.0)GOTO 2011
IF(CLOSED)GOTO 93200
SPK=261
PROP(PHONE)=1
PROP(BOOTH)=2
GOTO 2011
23520 IF(OBJ.EQ.DWARF.OR.OBJ.EQ.WUMPUS.OR.OBJ.EQ.SNAKE.OR.OBJ.EQ.BEAR
1 .OR.OBJ.EQ.DRAGON)SPK=259
IF(OBJ.EQ.TROLL)SPK=258
IF(OBJ.EQ.BIRD)SPK=260
GOTO 2011
C BLOW. JOSHUA FIT DE BATTLE OF JERICHO, AND DE WALLS....
23600 IF(OBJ.NE.0.AND.IOBJ.NE.0)GOTO 2060
IF(OBJ.EQ.0)OBJ=IOBJ
IOBJ=0
IF(OBJ.EQ.0)SPK=268
IF(OBJ.NE.HORN)GOTO 2011
SPK=266
IF(OUTSID(LOC))SPK=277
IF(.NOT.AT(WUMPUS))GOTO 23610
IF(PROP(WUMPUS).NE.0)GOTO 2011
CALL RSPEAK(SPK)
GOTO 22900
23610 IF(PROP(WALL).EQ.1.OR.(LOC.NE.102.AND.LOC.NE.194))GOTO 2011
K=196
IF(LOC.EQ.194)K=195
CALL RSPEAK(265)
PROP(WALL)=1
DO 23620 OBJ=1,MAXOBJ
IF(PLACE(OBJ).EQ.LOC.OR.FIXED(OBJ).EQ.LOC)CALL MOVE(OBJ,K)
23620 CONTINUE
NEWLOC=K
GOTO 2
C CALL. IF NO PHONE IS HANDY, YELL.
13800 IF(.NOT.HERE(PHONE))GOTO 10000
GOTO 23910
C DIAL. NO EFFECT UNLESS AT PHONE.
23900 IF(OBJ.NE.PHONE)GOTO 2011
23910 IF(CLOSED)GOTO 93200
SPK=271
GOTO 2011
C PLAY. ONLY FOR HORN OR LYRE.
24000 IF(OBJ.NE.0.AND.IOBJ.NE.0)GOTO 2060
IF(OBJ.EQ.0)OBJ=IOBJ
IOBJ=0
IF(OBJ.EQ.HORN)GOTO 23600
IF(OBJ.NE.LYRE)GOTO 2011
SPK=287
IF(.NOT.HERE(DOG).OR.DEAD(DOG))GOTO 2011
PROP(DOG)=1
CALL BITON(DOG,DEADBT)
FIXED(AXE)=0
PROP(AXE)=0
SPK=288
GOTO 2011
C PICK/PICK UP. CAN PICK FLOWERS & MUSHROOMS, BUT MUST 'PICK UP' EVERYTHING EL
24100 IF(OBJ.EQ.0)OBJ=IOBJ
IOBJ=0
IF(OBJ.EQ.FLOWER.OR.OBJ.EQ.MUSHRM)GOTO 20100
IF(PREP.NE.0)GOTO 20100
GOTO 2060
C PUT DOWN: EQUIVALENT TO DROP.
C PUT IN: IF LIQUID, MEANS 'FILL'.
C PUT ON: WEAR OR DROP.
24200 IF(PREP.NE.0)GOTO 24210
CALL A5TOA1(OTXT(OBJX,1),OTXT(OBJX,2),'?',TK,K)
PRINT 24204,(TK(I),I=1,K)
24204 FORMAT(/' Where do you want to put the ',20A1)
GOTO 2600
24210 IF(PREP.EQ.PREPIN)GOTO 24500
C PUT ON: "WEAR" OR "PUT OBJ ON IOBJ".
24240 IF(PREP.NE.PREPON)GOTO 24250
IF(OBJ.NE.0)GOTO 24242
OBJ=IOBJ
OTXT(OBJX,1)=IOTXT(IOBX,1)
OTXT(OBJX,2)=IOTXT(IOBX,2)
IOBJ=0
24242 IF(WORN(OBJ))GOTO 23300
IF(IOBJ.EQ.0)GOTO 23310
GOTO 20200
C PUT DOWN: "DROP"
24250 IF(OBJ.EQ.0.OR.IOBJ.EQ.0)GOTO 24252
GOTO 2070
24252 IF(OBJ.EQ.0)OBJ=IOBJ
IOBJ=0
GOTO 20200
C TURN ON/OFF.
24300 IF(PREP.EQ.0)GOTO 2060
IF(OBJ.EQ.0.AND.IOBJ.EQ.LAMP)OBJ=LAMP
IF(OBJ.NE.LAMP)GOTO 2070
IF(PREP.EQ.PREPON)GOTO 20700
GOTO 20800
C GET (NO PREP): "TAKE"
C GET IN: "ENTER"
C GET OUT: "LEAVE"
C****** NEEDS WORK
24400 IF(PREP.EQ.0.OR.PREP.EQ.PREPFR)GOTO 20100
IF(OBJ.NE.0)GOTO 2060
OBJ=IOBJ
IOBJ=0
PREP=0
GOTO 20100
C INSERT/PUT IN.
24500 IF(IOBJ.EQ.0)GOTO 10010
SPK=NOWAY(0)
IF(OBJ.EQ.SWORD.AND.IOBJ.EQ.ANVIL.AND.PROP(SWORD).EQ.0)SPK=350
IF(.NOT.VESSEL(IOBJ))GOTO 2011
ASSIGN 24510 TO RETN
GOTO 20190
24510 IF(IOBJ.NE.BOTTLE.AND.IOBJ.NE.CASK.AND.IOBJ.NE.VASE
1 .AND.IOBJ.NE.GRAIL.AND.(OBJ.LT.WATER.OR.OBJ.GT.WINE+1))
2 GOTO 24515
OBJ=IOBJ
IOBJ=OBJS(OBJX)
GOTO 22200
24515 SPK=252
IF(OBJ.EQ.IOBJ)GOTO 2011
SPK=358
IF(.NOT.AJAR(IOBJ))GOTO 2011
IF(IOBJ.NE.BOAT.AND.IOBJ.NE.CHEST)GOTO 24520
IF(IOBJ.EQ.CHEST.AND.OBJ.EQ.BOAT)GOTO 2070
GOTO 24590
C BIRD GOES INTO CAGE AND ONLY CAGE. CAGE HOLDS NOTHING ELSE.
C BAR VASE & PILLOW FROM SAFE, TO FORCE PUTTING DOWN ON FLOOR.
24520 SPK=351
IF(OBJ.EQ.BIRD.AND.IOBJ.NE.CAGE)GOTO 2011
SPK=329
IF(IOBJ.EQ.CAGE.AND.OBJ.NE.BIRD)GOTO 2011
IF(OBJ.EQ.BIRD)GOTO 20120
IF(IOBJ.EQ.SAFE.AND.(OBJ.EQ.VASE.OR.OBJ.EQ.PILLOW))GOTO 2011
IF(IOBJ.EQ.SHIELD.AND.OBJ.NE.RADIUM)GOTO 2011
IF(IOBJ.NE.PHONE)GOTO 24530
IF(OBJ.NE.COINS.AND.OBJ.NE.SLUGS)GOTO 2070
CALL DSTROY(OBJ)
SPK=330
GOTO 2011
24530 IF(IOBJ.NE.VEND)GOTO 24540
IF(OBJ.NE.COINS.AND.OBJ.NE.SLUGS)GOTO 2070
CALL DSTROY(OBJ)
CALL MOVE(BATTER,LOC)
IF(PROP(BATTER).NE.1)GOTO 24535
CALL RSPEAK(317)
PROP(VEND)=1
24535 PROP(BATTER)=0
CALL PSPEAK(BATTER,0)
GOTO 2100
C PUT BATTERIES IN LAMP.
C THERE IS A GLITCH HERE, IN THAT IF HE TRIES TO GET A THIRD SET OF
C BATTERIES BEFORE THE SECOND SET HAS BEEN INSERTED, THE SECOND SET
C DISAPPEARS! ***FIX THIS SOMETIME***
24540 IF(IOBJ.NE.LAMP)GOTO 24550
IF(OBJ.NE.BATTER.OR.PROP(BATTER).NE.0)GOTO 2070
PROP(BATTER)=1
IF(ENCLSD(BATTER))CALL REMOVE(BATTER)
IF(HOLDNG(BATTER))CALL DROP(BATTER,LOC)
LIMIT=400
PROP(LAMP)=1
LMWARN=.FALSE.
SPK=188
GOTO 2011
24550 IF(.NOT.SMALL(OBJ))GOTO 2011
24590 IF(WEARNG(OBJ))CALL BITOFF(OBJ,WEARBT)
IF(ENCLSD(OBJ))CALL REMOVE(OBJ)
CALL INSERT(OBJ,IOBJ)
GOTO 2009
C REMOVE/TAKE FROM.
24600 IF(OBJ.NE.RING.OR.PROP(RING).NE.2)GOTO 24610
PREP=0
IOBJ=0
GOTO 20100
24610 SPK=343
IF(IOBJ.NE.0)GOTO 24620
IF(.NOT.ENCLSD(OBJ))SPK=340
IOBJ=-PLACE(OBJ)
24620 IF(PLACE(OBJ).NE.-IOBJ)SPK=341
IF(.NOT.AJAR(IOBJ))SPK=335
IF(OBJ.EQ.WATER.OR.OBJ.EQ.OIL.OR.OBJ.EQ.WINE)SPK=342
IF(.NOT.TOTING(OBJ).AND.BURDEN(0)+BURDEN(OBJ).GT.15)SPK=92
IF(SPK.NE.343)GOTO 2011
CALL REMOVE(OBJ)
IF(OBJ.EQ.BIRD)GOTO 20200
GOTO 2009
C BURN
24700 GOTO 2011
C GRIPE/COMPLAIN/SUGGEST.
14800 SCORNG=.TRUE.
CALL RATING(SCORE,MXSCOR,BONUS,GAVEUP,SCORNG,CLOSNG,CLOSED)
SCORNG=.FALSE.
CALL GRIPE(LOC,SCORE,CLOSNG,CLOSED)
GOTO 2011
C LOCK. CHAIN, GRATE, CHEST, ELFIN DOOR
C HERE ARE THE CURRENT LOCK/UNLOCK MESSAGES & NUMBERS:
C 31 YOU HAVE NO KEYS.
C 32 IT HAS NO LOCK.
C 34 IT'S ALREADY LOCKED.
C 35 THE GRATE IS NOW LOCKED.
C 36 THE GRATE IS NOW UNLOCKED.
C 37 IT WAS ALREADY UNLOCKED.
C 55 YOU CAN'T UNLOCK THE KEYS.
C 171 The chain is now unlocked.
C 172 The chain is now locked.
C 173 There is nothing here to which the chain can be locked.
C 224 YOUR KEYS ARE ALL TOO LARGE.
C 234 The wrought-iron door is now locked.
C 235 The tiny door is now locked.
C 236 The wrought-iron door is now unlocked.
C 237 The tiny door is now unlocked.
C 375 YOU DON'T HAVE THE RIGHT KEY.
C 333 THE CHEST IS NOW LOCKED.
C 334 THE CHEST IS NOW UNLOCKED.
C 367 THE SAFE'S DOOR SWINGS SHUT.
24900 IF(HINGED(OBJ))GOTO 24905
CALL A5TOA1(OTXT(OBJX,1),OTXT(OBJX,2),'.',TK,K)
PRINT 24903,(TK(I),I=1,K)
24903 FORMAT(/' I don''t know how to lock or unlock the ',20A1)
GOTO 2100
24905 SPK=375
IF(.NOT.LOCKS(OBJ))SPK=32
IF(LOCKED(OBJ))SPK=34
IF(.NOT.(ATHAND(KEYS).OR.ATHAND(SKEY).OR.OBJ.EQ.SAFE))SPK=31
IF(SPK.NE.375)GOTO 2011
C CHAIN.
IF(OBJ.NE.CHAIN)GOTO 24910
IF(.NOT.ATHAND(KEYS))GOTO 2011
SPK=173
IF(LOC.NE.PLAC(CHAIN))GOTO 2011
SPK=172
PROP(CHAIN)=2
IF(ENCLSD(CHAIN))CALL REMOVE(CHAIN)
IF(HOLDNG(CHAIN))CALL DROP(CHAIN,LOC)
FIXED(CHAIN)=-1
GOTO 24990
C CHEST.
24910 IF(OBJ.NE.CHEST)GOTO 24920
IF(.NOT.ATHAND(KEYS))GOTO 2011
SPK=334
GOTO 24990
C ELFIN DOOR.
24920 IF(OBJ.NE.TDOOR.AND.OBJ.NE.TDOOR2)GOTO 24930
SPK=224
IF(.NOT.TOTING(SKEY))GOTO 2011
PROP(TDOOR)=0
PROP(TDOOR2)=0
SPK=234+2*PROP(TDOOR)+(TDOOR2-OBJ)
K=TDOOR+(TDOOR2-OBJ)
CALL BITON(K,LOCKBT)
CALL BITOFF(K,OPENBT)
GOTO 24990
C GRATE.
24930 IF(OBJ.NE.GRATE)GOTO 24940
IF(.NOT.ATHAND(KEYS))GOTO 2011
PROP(GRATE)=0
SPK=35
GOTO 24990
C SAFE.
24940 PROP(SAFE)=0
SPK=367
C GOTO 24990
24990 CALL BITON(OBJ,LOCKBT)
CALL BITOFF(OBJ,OPENBT)
GOTO 2011
C UNLOCK. CHAIN, GRATE, CHEST, ELFIN DOOR.
25000 SPK=55
IF(OBJ.EQ.KEYS.OR.OBJ.EQ.SKEY)GOTO 2011
IF(.NOT.HINGED(OBJ))GOTO 24900
SPK=375
IF(.NOT.LOCKED(OBJ))SPK=37
IF(.NOT.LOCKS(OBJ))SPK=32
IF(OBJ.EQ.SAFE)SPK=342
IF(OBJ.EQ.SAFE.AND.(IOBJ.EQ.KEYS.OR.IOBJ.EQ.SKEY))SPK=368
IF(.NOT.(ATHAND(KEYS).OR.ATHAND(SKEY).OR.OBJ.EQ.SAFE))SPK=31
IF(SPK.NE.375)GOTO 2011
C CHAIN.
IF(OBJ.NE.CHAIN)GOTO 25020
IF(.NOT.ATHAND(KEYS))GOTO 2011
SPK=171
IF(PROP(BEAR).EQ.0)SPK=41
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 25090
C CHEST.
25020 IF(OBJ.NE.CHEST)GOTO 25030
IF(.NOT.ATHAND(KEYS))GOTO 2011
SPK=333
GOTO 25090
C ELFIN DOOR.
C STUFF TO LOCK/UNLOCK TINY DOOR W/SPECIAL KEY.
C THE DAMN THING IS REALLY AT FOUR PLACES, AND WE WANT THE RIGHT
C MESSAGES IF HE ONLY HAS 'BIG' KEYS (OR NO KEYS). ALSO, HE
C CAN UNLOCK IT EITHER WHILE HE IS BIG OR SMALL.
25030 IF(OBJ.NE.TDOOR.AND.OBJ.NE.TDOOR2)GOTO 25040
SPK=224
IF(.NOT.ATHAND(SKEY))GOTO 2011
IF(CLOSNG)GOTO 25060
PROP(TDOOR)=1
PROP(TDOOR2)=1
SPK=234+2*PROP(TDOOR)+(TDOOR2-OBJ)
K=TDOOR+(TDOOR2-OBJ)
CALL BITOFF(K,LOCKBT)
CALL BITON(K,OPENBT)
GOTO 25090
C GRATE.
25040 IF(.NOT.ATHAND(KEYS))GOTO 2011
IF(CLOSNG)GOTO 25060
PROP(GRATE)=1
SPK=36
25090 CALL BITOFF(OBJ,LOCKBT)
CALL BITON(OBJ,OPENBT)
GOTO 2011
C CLOSING. NO EXIT THIS WAY.
25060 SPK=130
IF(.NOT.PANIC)CLOCK2=15
PANIC=.TRUE.
GOTO 2011
C HEALTH. GIVE HIM A DIAGNOSIS.
25100 IF(HEALTH.LT.100)PRINT 25102,HEALTH
25102 FORMAT(/' You''re health rating is ',I2,
1 ' out of a possible 100.')
IF(PCT(50))SPK=349
IF(HEALTH.GE.95)GOTO 2011
SPK=381 + (100-HEALTH)/20
GOTO 2011
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.
25200 IF(OBJ.NE.0)GOTO 2060
IF(IOBJ.NE.0)GOTO 25210
25201 IF(DETAIL.LT.3)CALL RSPEAK(15)
DETAIL=DETAIL+1
WZDARK=.FALSE.
ABB(LOC)=0
NEWLOC=LOC
GOTO 2
C LOOK INTO SOMETHING (A CONTAINER).
25210 IF(.NOT.VESSEL(IOBJ))GOTO 25220
IF(.NOT.AJAR(IOBJ).AND.OPAQUE(IOBJ))GOTO 2011
SPK=359
IF(HOLDER(IOBJ).EQ.0)GOTO 2011
PRINT 25212
25212 FORMAT(1H )
CALL LOOKIN(IOBJ)
GOTO 2100
C LOOK AT SOMETHING. IF WRITTEN, READ IT.
25220 IF(.NOT.PRINTD(IOBJ))GOTO 25201
OBJ=IOBJ
IOBJ=0
GOTO 22700
C COMBO: TRYING TO OPEN SAFE. SEE COMMENTS FOR FEE FIE FOE FOO.
25300 IF(.NOT.AT(SAFE))GOTO 2060
K=VOCABX(VTXT(VRBX,1),4)-10
SPK=42
IF(COMBO.EQ.1-K)GOTO 25320
IF(COMBO.NE.0)SPK=366
GOTO 2011
25320 COMBO=K
SPK=371
IF(K.NE.3)GOTO 2011
COMBO=0
CALL BITOFF(SAFE,LOCKBT)
CALL BITON(SAFE,OPENBT)
PROP(SAFE)=1
SPK=365
IF(PROP(BOOK).GE.0)GOTO 2011
TALLY=TALLY-1
C IF REMAINING TREASURES TOO ELUSIVE, ZAP HIS LAMP.
C THIS COPIES SOME CODE LOCATED AROUND LABEL 2000. MUST BE DONE
C HERE SINCE BOOK IS CONTAINED IN SAFE & TALLY STUFF ONLY WORKS FOR THINGS
C DEPOSITED AT A LOC.
IF(TALLY.EQ.TALLY2.AND.TALLY.NE.0)LIMIT=MIN0(35,LIMIT)
GOTO 2011
C DUST/SWEEP.
25400 IF(.NOT.ATHAND(BRUSH))SPK=342
IF(.NOT.AT(CARVNG).OR..NOT.ATHAND(BRUSH).OR.PROP(CARVNG).EQ.1)
1 GOTO 2011
PROP(CARVNG)=1
CALL RSPEAK(363)
SPK=372
GOTO 2011
C TERSE/UNTERSE. SUPRESS ALL LONG-FORM DESCRIPTIONS.
25500 TERSE=.NOT.TERSE
DETAIL=3
GOTO 2009
C WIZ STUFF
25600 IF(ISWIZ)CALL MONITR
GOTO 2009
25700 IF(ISWIZ) CALL XMAP
GOTO 2009
25800 IF(.NOT.ISWIZ) GOTO 2009
WRITE(1,25801)
25801 FORMAT (1X,'LOCATION ?')
READ (1,25802) GATLOC
25802 FORMAT (I4)
IF ((GATLOC.GT.0).AND.(GATLOC.LE.MAXLOC))
+ LOC=GATLOC
GOTO 2009
25900 IF(ISWIZ) WRITE(1,25901) DLOC(DWFMAX)
25901 FORMAT(1X,'THE PIRATE IS AT LOCATION ',I4)
GOTO 2009
C HINTS
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.
40000 GOTO (40700,40800,40900,41000,41100,41200,41300,41400,41500,
1 41600,41700),(HINT+1-HNTMIN)
C MAZE DARK WITT SWORD SLIDE CAVE1 BIRD CAVE2 RNBOW
C SNAKE STYX
PRINT 40002,HINT
40002 FORMAT (' TRYING TO PRINT HINT # ',I1,/)
CALL BUG(27)
40010 HINTLC(HINT)=0
IF(.NOT.YES(HINTS(HINT,3),0,54))GOTO 2603
PRINT 40012,HINTS(HINT,2)
40012 FORMAT(/' I am prepared to give you a hint, but it will cost
1 you', I2,' points.')
HINTED(HINT)=YES(175,HINTS(HINT,4),54)
IF(HINTED(HINT).AND.LIMIT.GT.30)LIMIT=LIMIT+30*HINTS(HINT,2)
40020 HINTLC(HINT)=0
40030 GOTO 2603
C NOW FOR THE QUICK TESTS. SEE DATABASE DESCRIPTION FOR ONE-LINE NOTES.
40700 IF(ATLOC(LOC).EQ.0.AND.ATLOC(OLDLOC).EQ.0.AND.
1 ATLOC(OLDLC2).EQ.0.AND.BURDEN(0).GT.1)GOTO 40010
GOTO 40020
40800 IF(PROP(EMRALD).NE.-1.AND.PROP(PYRAM).EQ.-1)GOTO 40010
GOTO 40020
40900 GOTO 40010
41000 IF( (PROP(SWORD).EQ.1.OR.PROP(SWORD).EQ.5)
1 .AND..NOT.TOTING(CROWN))GOTO 40010
GOTO 40020
41100 GOTO 40010
41200 IF(PROP(GRATE).EQ.0.AND..NOT.ATHAND(KEYS))GOTO 40010
GOTO 40020
41300 IF(HERE(BIRD).AND.ATHAND(ROD).AND.OBJ.EQ.BIRD)GOTO 40010
GOTO 40030
41400 IF(ABB(159).EQ.0)GOTO 40010
GOTO 40020
41500 IF(.NOT.TOTING(SHOES).OR.ABB(205).EQ.0)GOTO 40010
GOTO 40020
41600 IF(.NOT.ATHAND(LYRE).AND.PROP(DOG).NE.1)GOTO 40010
GOTO 40020
41700 IF(HERE(SNAKE).AND..NOT.HERE(BIRD))GOTO 40010
GOTO 40020
C CAVE CLOSING AND SCORING
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 90000 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 90000 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 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=BITSET(LOCCON,6)), OR CREATE THE BRIDGE. NOR
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.
90000 PROP(GRATE)=0
PROP(FISSUR)=0
PROP(TDOOR)=0
PROP(TDOOR2)=0
DO 90010 I=1,6
DSEEN(I)=.FALSE.
90010 DLOC(I)=0
CALL MOVE(TROLL,0)
CALL MOVE(TROLL+MAXOBJ,0)
CALL MOVE(TROLL2,PLAC(TROLL))
CALL MOVE(TROLL2+MAXOBJ,FIXD(TROLL))
CALL JUGGLE(CHASM)
IF(PROP(BEAR).NE.3)CALL DSTROY(BEAR)
PROP(CHAIN)=0
FIXED(CHAIN)=0
PROP(AXE)=0
FIXED(AXE)=0
CALL RSPEAK(129)
CLOCK1=-1
CLOSNG=.TRUE.
GOTO 19999
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, PHONE BOOTH AND
C AT 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 THE PHONE MAKES IT IMPOSSIBLE FOR THE WALDO TO FART AROUND IN THE
C REPOSITORY TOO LONG. WHEN CLOCK3 TICKS TO ZERO, THE PHONE STARTS
C RINGING. WHEN IT HITS -7, THE DWARVES WAKE UP. IF HE FIDDLES WITH
C THE PHONE, HE GETS ZONKED IN OTHER WAYS.
91000 PROP(BOTTLE)=PUT(BOTTLE,115,1)
PROP(PLANT)=PUT(PLANT,115,0)
PROP(OYSTER)=PUT(OYSTER,115,0)
PROP(LAMP)=PUT(LAMP,115,0)
PROP(ROD)=PUT(ROD,115,0)
PROP(DWARF)=PUT(DWARF,115,0)
LOC=115
OLDLOC=115
NEWLOC=115
C LEAVE THE GRATE WITH NORMAL (NON-NEGATIVE PROPERTY).
FOO=PUT(GRATE,116,0)
PROP(SNAKE)=PUT(SNAKE,116,1)
PROP(BIRD)=PUT(BIRD,116,1)
PROP(CAGE)=PUT(CAGE,116,0)
PROP(ROD2)=PUT(ROD2,116,0)
PROP(PILLOW)=PUT(PILLOW,116,0)
PROP(BOOTH)=PUT(BOOTH,116,-4)
FIXED(BOOTH)=115
PROP(PHONE)=PUT(PHONE,212,-4)
PROP(MIRROR)=PUT(MIRROR,115,0)
PROP(BOOK2)=PUT(BOOK2,115,0)
FIXED(MIRROR)=116
DO 91010 I=1,MAXOBJ
IF(TOTING(I).AND.ENCLSD(I))CALL REMOVE(I)
91010 IF(TOTING(I))CALL DSTROY(I)
CALL RSPEAK(132)
CLOSED=.TRUE.
GOTO 2
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.
C 92000 IS FOR CASES OF LAMP DYING. 92400 IS WHEN IT GOES OUT,
C AND 92600 IS IF HE'S WANDERED OUTSIDE AND THE LAMP IS USED UP, IN WHICH
C CASE WE FORCE HIM TO GIVE UP.
92000 IF(LMWARN.OR..NOT.HERE(LAMP))GOTO 19999
LMWARN=.TRUE.
SPK=187
IF(PROP(BATTER).EQ.1)SPK=323
IF(PLACE(BATTER).EQ.0)SPK=183
IF(PROP(VEND).EQ.1)SPK=189
CALL RSPEAK(SPK)
GOTO 19999
92400 LIMIT=-1
PROP(LAMP)=0
IF(HERE(LAMP))CALL RSPEAK(184)
GOTO 19999
92600 CALL RSPEAK(185)
GAVEUP=.TRUE.
GOTO 95000
C AND, OF COURSE, DEMO GAMES ARE ENDED BY THE WIZARD.
92800 CALL MSPEAK(1)
GAVEUP=.TRUE.
GOTO 95000
C OH DEAR, HE'S DISTURBED THE DWARVES.
93000 CALL RSPEAK(136)
GOTO 95000
C HIT THE PHONE. JINGLE, JANGLE, CRASH!
93100 CALL RSPEAK(282)
GOTO 93000
C WHOOPS. DOWN THE CHUTE.
93200 CALL RSPEAK(283)
GOTO 95000
C DWARVES CAN'T SLEEP THRU ALL THIS RINGING!
93300 CALL RSPEAK(254)
GOTO 95000
C "YOU'RE DEAD, FRED." "YOU DIED, CLYDE?"
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 THE EASIEST WAY TO GET KILLED IS TO FALL INTO A PIT IN PITCH DARKNESS.
94000 CALL RSPEAK(23)
OLDLC2=LOC
C OKAY, HE'S DEAD. LET'S GET ON WITH IT.
94100 IF(CLOSNG)GOTO 94500
YEA=YES(81+NUMDIE*2,82+NUMDIE*2,54)
NUMDIE=NUMDIE+1
IF(NUMDIE.EQ.MAXDIE.OR..NOT.YEA)GOTO 95000
IF(CHASE.EQ.0)GOTO 94160
C CHAMP WAS BEING CHASED BY WUMPUS, & DIED ANOTHER WAY.
C PUT WUMPUS BACK TO SLEEP, IN CASE OUR HERO STILL HASN'T GOT THE CLOAK.
CHASE=0
PROP(WUMPUS)=0
CALL MOVE(WUMPUS,174)
94160 IF(TOTING(LAMP))PROP(LAMP)=0
DO 94200 J=1,MAXOBJ
IF(.NOT.HOLDNG(J))GOTO 94200
LOC=OLDLC2
IF(J.EQ.LAMP)LOC=1
CALL DROP(J,LOC)
IF(.NOT.WEARNG(J))GOTO 94200
PROP(J)=0
CALL BITOFF(J,WEARBT)
94200 CONTINUE
LOC=3
OLDLOC=LOC
WDX=0
WORDS(1)=0
CALL CLRLIN
HEALTH=100
GOTO 2000
C HE DIED DURING CLOSING TIME. NO RESURRECTION. TALLY UP A DEATH AND EXIT.
94500 CALL RSPEAK(131)
NUMDIE=NUMDIE+1
GOTO 95000
C IT'S OVER. TALLY SCORE.
95000 CALL RATING(SCORE,MXSCOR,BONUS,GAVEUP,SCORNG,CLOSNG,CLOSED)
C THAT SHOULD BE GOOD ENOUGH. LET'S TELL HIM ALL ABOUT IT.
CALL MLOG(SCORE,TURNS,NUMDIE)
PRINT 95100,SCORE,MXSCOR,TURNS
95100 FORMAT(///' You scored',I4,' out of a possible',I4,
1 ', using',I5,' turns.')
DO 95200 I=1,CLSSES
IF(CVAL(I).GE.SCORE)GOTO 95210
95200 CONTINUE
PRINT 95202
95202 FORMAT(/' You just went off my scale!!'/)
GOTO 98000
95210 CALL SPEAK(CTEXT(I))
IF(I.EQ.CLSSES-1)GOTO 95220
K=CVAL(I)+1-SCORE
KK2='s.'
IF(K.EQ.1)KK2='. '
PRINT 95212,K,KK2
95212 FORMAT(/' To achieve the next higher rating, you need',I3,
1 ' more point',A2/)
GOTO 98000
95220 PRINT 95222
95222 FORMAT(/' To achieve the next higher rating ',
1 'would be a neat trick!'//' CONGRATULATIONS!!'/)
C98000 STOP
98000 IF(.NOT.PROMPT)WRITE(*,98001)
98001 FORMAT('END:')
STOP
!98000 STOP
END