github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-04-28 21:08:01 +00:00
Code Issues Releases Wiki Activity
Files
97559f4b9b75f52acd96fe4b80787dc2ecacb4a0
PDP-10.its/src/games/adv4ma.3

2577 lines
84 KiB
Groff
Raw Blame History

C ADVENTURES
C
C CURRENT LIMITS:
C 15000 WORDS OF MESSAGE TEXT (LINES, LINSIZ).
C 900 TRAVEL OPTIONS (TRAVEL, TRVSIZ).
C 400 VOCABULARY WORDS (KTAB, ATAB, TABSIZ).
C 200 LOCATIONS (LTEXT, STEXT, KEY, COND, ABB, ATLOC, LOCSIZ).
C 100 OBJECTS (PLAC, PLACE, FIXD, FIXED, LINK (TWICE), PTEXT, PROP).
C 50 "ACTION" VERBS (ACTSPK, VRBSIZ).
C 250 RANDOM MESSAGES (RTEXT, RTXSIZ).
C 12 DIFFERENT PLAYER CLASSIFICATIONS (CTEXT, CVAL, CLSMAX).
C 20 HINTS, LESS 3 (HINTLC, HINTED, HINTS, HNTSIZ).
C 35 MAGIC MESSAGES (MTEXT, MAGSIZ).
C THERE ARE ALSO LIMITS WHICH CANNOT BE EXCEEDED DUE TO THE STRUCTURE
C OF THE DATABASE. (E.G., THE VOCABULARY USES N/1000 TO DETERMINE WORD
C TYPE, SO THERE CAN'T BE MORE THAN 1000 WORDS.) THESE UPPER LIMITS
C ARE:
C 1000 NON-SYNONYMOUS VOCABULARY WORDS
C 300 LOCATIONS
C 100 OBJECTS
C
C Modified for the Brown University system, April 1978
C Dave Wallace '78
C Dave Nebiker '79
C Eric Albert '80
C LES WU '82 (ALSO MADE CONVERSIONS FOR A NBS-10)
C Modified for the ITS system, July 1979 by EJS@MC
C
IMPLICIT INTEGER(A-Z)
LOGICAL DSEEN,BLKLIN,HINTED,YES,START
LOGICAL TOTING,HERE,AT,BITSET,DARK,WZDARK,LMWARN,CLOSNG,PANIC,
1 CLOSED,GAVEUP,SCORNG,SCORE2,DEMO,YEA,PCT,FORCED,STAT4,
2 WEARNG
C
COMMON /TXTCOM/ RTEXT,LINES
COMMON /BLKCOM/ BLKLIN
COMMON /VOCCOM/ KTAB,ATAB,TABSIZ
COMMON /PLACOM/ ATLOC,LINK,PLACE,FIXED,HOLDNG
COMMON /MTXCOM/ MTEXT
COMMON /PTXCOM/ PTEXT
COMMON /ABBCOM/ ABB
COMMON /WIZCOM/ WKDAY,WKEND,HOLID, HBEGIN,HEND,HNAME,
1 SHORT,MAGIC,MAGNM,LATNCY,SAVED,SAVET,SETUP
COMMON /SAVCOM/ SEGOFF,ABBNUM,ATTACK,CLOCK1,CLOCK2,CLOSED,CLOSNG,
1 DETAIL,DFLAG,DKILL,DLOC,DSEEN,DTOTAL,GAVEUP,HINT,HINTED,
2 IWEST,KNFLOC,LIMIT,LMWARN,LOC,NUMDIE,PANIC,PROP,STICK,
3 TALLY,TALLY2,TURNS,WZDARK,XXD,XXT,ACCT,HINTLC,HINTS,
4 MAGIC1,MAGIC2,FILLER,TURNS3
C
DIMENSION LINES(15000)
DIMENSION TRAVEL(900)
DIMENSION KTAB(400),ATAB(400)
DIMENSION LTEXT(200),STEXT(200),KEY(200),COND(200),ABB(200),
1 ATLOC(200)
DIMENSION PLAC(100),PLACE(100),FIXD(100),FIXED(100),LINK(200),
1 PTEXT(100),PROP(100)
DIMENSION ACTSPK(50)
DIMENSION RTEXT(250)
DIMENSION CTEXT(12),CVAL(12)
DIMENSION HINTLC(20),HINTED(20),HINTS(20,4)
DIMENSION MTEXT(35)
DIMENSION TK(20),DSEEN(12),DLOC(12),ODLOC(12),HNAME(4),TK1(9)
DIMENSION FILLER(20)
C
DATA LINSIZ/15000/,TRVSIZ/900/,LOCSIZ/200/,
1 VRBSIZ/50/,RTXSIZ/250/,CLSMAX/12/,HNTSIZ/20/,MAGSIZ/35/
DATA TABSIZ/400/,SETUP/0/,BLKLIN/.TRUE./
C STATEMENT FUNCTIONS
C
C
C WEARNG(OBJ) = TRUE IF THE OBJ IS BEING WORN
C TOTING(OBJ) = TRUE IF THE OBJ IS BEING CARRIED
C HERE(OBJ) = TRUE IF THE OBJ IS AT "LOC" (OR IS BEING CARRIED OR WORN)
C AT(OBJ) = TRUE IF IN EITHER SIDE OF TWO-PLACED OBJECT
C LIQ(DUMMY) = OBJECT NUMBER OF LIQUID IN BOTTLE
C LIQLOC(LOC) = OBJECT NUMBER OF LIQUID (IF ANY) AT LOC
C BITSET(L,N) = TRUE IF COND(L) HAS BIT N SET (BIT 0 IS UNITS BIT)
C FORCED(LOC) = TRUE IF LOC MOVES WITHOUT ASKING FOR INPUT (COND=2)
C DARK(DUMMY) = TRUE IF LOCATION "LOC" IS DARK
C PCT(N) = TRUE N% OF THE TIME ( N INTEGER FROM 0 TO 100 )
C
C WZDARK says whether the location he's leaving was dark
C LMWARN says whether he's been warned about the lamp going dim
C CLOSNG says whether its closing time yet
C PANIC says whether he's found out he's trapped in the cave
C CLOSED says whether we're all the way closed
C GAVEUP says whether he exited via "QUIT"
C SCORNG indicates to the score routine whether we're doing a "SCORE" cmnd
C SCORE2 does the same as SCORING but used when pausing
C DEMO is true if this is a prime-time demonstration
C YEA is a random YES/NO reply
C
C
WEARNG(OBJ) = PLACE(OBJ) .EQ. -2
TOTING(OBJ) = PLACE(OBJ) .EQ. -1
HERE(OBJ) = PLACE(OBJ) .EQ. LOC .OR. TOTING(OBJ) .OR. WEARNG(OBJ)
AT(OBJ) = PLACE(OBJ) .EQ. LOC .OR. FIXED(OBJ) .EQ. LOC
LIQ2(PBOTL) = (1-PBOTL) * WATER + (PBOTL / 2) * (WATER + OIL)
LIQ(DUMMY) = LIQ2(MAX0(PROP(BOTTLE), -1 - PROP(BOTTLE)))
1 + (DUMMY-DUMMY)
LIQLOC(LOC)=LIQ2((MOD(COND(LOC)/2 *2,8)-5)*MOD(COND(LOC)/4,2)+1)
C BITSET(L, N) = AND(COND(L), SHIFT(1,N)) .NE. 0
BITSET(L,N)=(COND(L).AND.SHIFT(1,N)).NE.0
FORCED(LOC) = COND(LOC) .EQ. 2
DARK(DUMMY) = MOD(COND(LOC), 2) .EQ. 0 .AND. (PROP(LAMP) .EQ. 0
1 .OR. .NOT. HERE(LAMP))
2 .AND.(DUMMY.EQ.DUMMY)
PCT(N) = RAN(100) .LT. N
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 (necessatily adjacent) lines
C whose numbers are X form the long description of location X.
C Section 2 : Short form descriptions. Same format as long form. Not all
C places have short descriptions .
C Section 3 : Travel table. Each line contains a location number (X), a second
C location number (Y), and a list of motion numbers (see section 4).
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 <= 300 It is the location to go to.
C If 300 < N <= 500 N - 300 is used in a computed goto to
C a section of special code.
C If N > 500 Message N-500 from section 6 is typed
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, bit 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 SPECIAL KLUDGE FOR WEARING OBJECTS (6/28/78)
C IF 900 < M <= 1000 HE MUST BE WEARING OBJ M-900
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 Section 4 : Vocabulary. Each line contains a number (N), a tab, and a
C file-letter word. Call M = N / 1000. If M = 0, then the word is a
C motion verb for use in travelling (see section 3). Else, if M = 1,
C the word is an object. Else, if M = 2, the word is an action vert
C (such as "carry" or "attack"). Else, if M =3, the word is a special
C case verb (such as "dig") and N MOD 1000 is an index into section 6.
C Objects from 50 to (currently, anyway) 79 are considered treasures
C (for Pirate, closeout).
C
C Section 5: Object descriptions. Each line contains a number (N), a tab,
C and a message. If N is from 1 to 100, the message is the "INVENTORY"
C message for object N. Otherwise, N should be 000, 100, 200, etc., and
C the message should be the description of the preceding object when its
C prop value is N/100. The N/100 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 ">$<".
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 4).
C Section 7: Object locations. Each line contains an object number and its
C 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.
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 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 cond(loc)
C for each loc given. The cond bits currentlly assigned are:
C 0 light
C 1 if bit 2 is on: on for oil, off for water
C 2 liquid asset, see bit 1
C 3 Pirate doesn't go here unless following player
C Other bits are used to indicate areas of interest to "Hint" routines:
C 4 Trying to get into cave
C 5 Trying to catch bird
C 6 Trying to deal with snake
C 7 Lost in maze
C 8 Pondering dark room
C 9 At Witt's end
C 10 Trying to get through Throne Room Passage
C 11 Trying to get sword out of stone
C Cond(loc) is set to 2, overriding all other bits, if loc has forced
C motion.
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 Section 11: Hints. Each line contains a hint numbr (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 hntmax is set to the max hint number (<= hntsiz). Numbers 1-3 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).
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 SECTION 0: END OF DATABASE.
C READ THE DATABASE IF WE HAVE NOT YET DONE SO
C
IF(SETUP.NE.0)GOTO 1100
WRITE (5,1000)
1000 FORMAT(' INITIALISING...')
OPEN (UNIT=1,FILE='FT01.DAT',ACCESS='SEQIN')
C
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(N)=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.
C
DO 1001 I=1,300
IF(I.LE.100)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
KEY(I) = 0
STEXT(I)=0
LTEXT(I)=0
COND(I)=0
1001 CONTINUE
C
ACCT = 015501888
SETUP=1
LINUSE=1
TRVS=1
CLSSES=1
C
C START NEW DATA SECTION. SECT IS THE SECTION NUMBER.
C
1002 READ(1,1003)SECT
WRITE (5,9898) SECT
9898 FORMAT (' NOW READING SECTION',I5)
IF (SECT.EQ.0) CLOSE (UNIT=1,FILE='FT01.DAT')
1003 FORMAT(I7)
OLDLOC=-1
ERA1=SECT+1
GOTO(1100,1004,1004,1030,1040,1004,1004,1050,1060,1070,1004,
1 1080,1004), ERA1
C (0) (1) (2) (3) (4) (5) (6) (7) (8) (9) (10)
C (11) (12)
CALL BUG(9)
C
C SECTIONS 1, 2, 3, 5, 6, 10, 12. READ MESSAGES AND SET UP POINTERS
C
1004 ERA2=LINUSE+1
ERA3=LINUSE+18
READ(1,1005)LOC,(LINES(J),J=ERA2,ERA3)
1005 FORMAT(1I8,18A4)
IF(LOC.EQ.-1)GOTO 1002
DO 1006 K=1,18
KK=LINUSE+19-K
IF((LINES(KK).XOR.' ').NE.0)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 LINES(LINUSE)=KK+1
C HASH UP MESSAGES TO MAKE CORE HARDER TO READ. NOTE THAT ERA2 AND ERA3
C MUST NOT HAVE CHANGED SINCE WE READ LINE IN (I.E. DON'T BRANCH INTO
C AREA BETWEEN 1004 AND HERE).
DO 1009 J=ERA2,ERA3
1009 LINES(J)=LINES(J).XOR.'?L.0'
IF(LOC.EQ.OLDLOC)GOTO 1020
LINES(LINUSE)=-LINES(LINUSE)
IF(SECT.EQ.12)GOTO 1013
IF(SECT.EQ.10)GOTO 1012
IF(SECT.EQ.6)GOTO 1011
IF(SECT.EQ.5)GOTO 1010
IF(SECT.EQ.1)GOTO 1008
C
STEXT(LOC)=LINUSE
GOTO 1020
C
1008 LTEXT(LOC)=LINUSE
GOTO 1020
C
1010 IF(LOC.GT.0.AND.LOC.LE.100)PTEXT(LOC)=LINUSE
GOTO 1020
C
1011 IF(LOC.GT.RTXSIZ)CALL BUG(6)
RTEXT(LOC)=LINUSE
GOTO 1020
C
1012 CTEXT(CLSSES)=LINUSE
CVAL(CLSSES)=LOC
CLSSES=CLSSES+1
GOTO 1020
C
1013 IF(LOC.GT.MAGSIZ)CALL BUG(6)
MTEXT(LOC)=LINUSE
C
1020 LINUSE=KK+1
LINES(LINUSE)=-1
OLDLOC=LOC
IF(LINUSE+18.GT.LINSIZ)CALL BUG(2)
GOTO 1004
C
C THE STUFF FOR SECTION 3 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 4, 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.
C
1030 READ(1,1031)LOC,NEWLOC,TK1
1031 FORMAT(11I7)
IF(LOC.EQ.0)GOTO 1030
C ABOVE KLUGE IS TO AVOID AFOREMENTIONED F40 BUG
IF(LOC.EQ.-1)GOTO 1002
IF(KEY(LOC).NE.0)GOTO 1033
KEY(LOC)=TRVS
GOTO 1035
1033 TRAVEL(TRVS-1)=-TRAVEL(TRVS-1)
1035 DO 1037 L=1,20
IF(TK1(L).EQ.0)GOTO 1039
TRAVEL(TRVS)=NEWLOC*1000+TK1(L)
TRVS=TRVS+1
IF(TRVS.EQ.TRVSIZ)CALL BUG(3)
1037 CONTINUE
1039 TRAVEL(TRVS-1)=-TRAVEL(TRVS-1)
GOTO 1030
C
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 4 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.
C
1040 DO 1042 TABNDX=1,TABSIZ
C1043 READ(1,1041)KTAB(TABNDX),DEW1,DEW2
1043 READ(1,1041)KTAB(TABNDX),ATAB(TABNDX)
C ATAB(TABNDX)=CODE(DEW1,DEW2)
C1041 FORMAT(I7,A4,A1)
1041 FORMAT (I7,A5)
IF(KTAB(TABNDX).EQ.0)GOTO 1043
C ABOVE KLUGE IS TO AVOID AFOREMENTIONED F40 BUG
IF(KTAB(TABNDX).EQ.-1)GOTO 1002
1042 ATAB(TABNDX)=ATAB(TABNDX).XOR.'PHRO'
CALL BUG(4)
C
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
1050 READ(1,1031)OBJ,J,K
IF(OBJ.EQ.-1)GOTO 1002
PLAC(OBJ)=J
FIXD(OBJ)=K
GOTO 1050
C
C READ DEFAULT MESSAGE NUMBERS FOR ACTION VERBS, STORE IN ACTSPK.
C
1060 READ(1,1031)VERB,J
IF(VERB.EQ.-1)GOTO 1002
ACTSPK(VERB)=J
GOTO 1060
C
C READ INFO ABOUT AVAILABLE LIQUIDS AND OTHER CONDITIONS, STORE IN COND.
C
1070 READ(1,1031)K,TK1
IF(K.EQ.-1)GOTO 1002
DO 1071 I=1,9
LOC=TK1(I)
IF(LOC.EQ.0)GOTO 1070
IF(BITSET(LOC,K)) CALL BUG(8)
1071 COND(LOC)=COND(LOC)+SHIFT(1,K)
GOTO 1070
C
C READ DATA FOR HINTS.
C
1080 HNTMAX=0
1081 READ(1,1031)K,TK1
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)=TK1(I)
HNTMAX=MAX0(HNTMAX,K)
GOTO 1081
C
C FINISH CONSTRUCTING INTERNAL DATA FORMAT
C
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.
C
1100 IF(SETUP.EQ.2)GOTO 1
IF(SETUP.EQ.-1)GOTO 8305
C
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>100 INDICATES THAT FIXED(OBJ-100)=LOC; LINK(OBJ) IS STILL THE
C CORRECT LINK TO USE.) ABB IS ZEROED; IT CONTROLS WHETHER THE ABBREVIATED
C DESCRIPTION IS TYPEED. COUNTS MOD 5 UNLESS "LOOK" IS USED.
C
DO 1101 I=1,100
PLACE(I)=0
PROP(I)=0
LINK(I)=0
1101 LINK(I+100)=0
C
DO 1102 I=1,LOCSIZ
ABB(I)=0
IF(LTEXT(I).EQ.0.OR.KEY(I).EQ.0)GOTO 1102
K=KEY(I)
IF(MOD(IABS(TRAVEL(K)),1000).EQ.1)COND(I)=2
1102 ATLOC(I)=0
C
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.
C
DO 1106 I=1,100
K=101-I
IF(FIXD(K).LE.0)GOTO 1106
CALL DROP(K+100,FIXD(K))
CALL DROP(K,PLAC(K))
1106 CONTINUE
C
DO 1107 I=1,100
K=101-I
FIXED(K)=FIXD(K)
1107 IF(PLAC(K).NE.0.AND.FIXED(K).LE.0)CALL DROP(K,PLAC(K))
C
C TREASURES, AS NOTED EARLIER, ARE OBJECTS 50 THROUGH MAXTRS (CURRENTLY 79),
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).
C
MAXTRS=79
TALLY=0
TALLY2=0
DO 1200 I=50,MAXTRS
IF(PTEXT(I).NE.0)PROP(I)=-1
1200 TALLY=TALLY-PROP(I)
C
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.
C
DO 1300 I=1,HNTMAX
HINTED(I)=.FALSE.
1300 HINTLC(I)=0
C
C DEFINE SOME HANDY MNEMONICS. THESE CORRESPOND TO OBJECT NUMBERS.
C
C KEYS=VOCAB(CODE('KEYS'),1)
C LAMP=VOCAB(CODE('LAMP'),1)
C GRATE=VOCAB(CODE('GRAT','E'),1)
C CAGE=VOCAB(CODE('CAGE'),1)
C ROD=VOCAB(CODE('ROD'),1)
C ROD2=ROD+1
C STEPS=VOCAB(CODE('STEP','S'),1)
C BIRD=VOCAB(CODE('BIRD'),1)
C DOOR=VOCAB(CODE('DOOR'),1)
C PILLOW=VOCAB(CODE('PILL','O'),1)
C SNAKE=VOCAB(CODE('SNAK','E'),1)
C FISSUR=VOCAB(CODE('FISS','U'),1)
C TABLET=VOCAB(CODE('TABL','E'),1)
C CLAM=VOCAB(CODE('CLAM'),1)
C OYSTER=VOCAB(CODE('OYST','E'),1)
C MAGZIN=VOCAB(CODE('MAGA','Z'),1)
C DWARF=VOCAB(CODE('DWAR','F'),1)
C KNIFE=VOCAB(CODE('KNIF','E'),1)
C FOOD=VOCAB(CODE('FOOD'),1)
C BOTTLE=VOCAB(CODE('BOTT','L'),1)
C WATER=VOCAB(CODE('WATE','R'),1)
C OIL=VOCAB(CODE('OIL'),1)
C PLANT=VOCAB(CODE('PLAN','T'),1)
C PLANT2=PLANT+1
C AXE=VOCAB(CODE('AXE'),1)
C MIRROR=VOCAB(CODE('MIRR','O'),1)
C DRAGON=VOCAB(CODE('DRAG','O'),1)
C CHASM=VOCAB(CODE('CHAS','M'),1)
C TROLL=VOCAB(CODE('TROL','L'),1)
C TROLL2=TROLL+1
C BEAR=VOCAB(CODE('BEAR'),1)
C MESSAG=VOCAB(CODE('MESS','A'),1)
C VEND=VOCAB(CODE('VEND','I'),1)
C BATTER=VOCAB(CODE('BATT','E'),1)
C STONE=VOCAB(CODE('STON','E'),1)
C PLAQUE= VOCAB(CODE('PLAQ','U'),1)
C TPASS = VOCAB(CODE('TPAS','S'),1)
C BROOM = VOCAB(CODE('BROO','M'),1)
C MAP = VOCAB(CODE('MAP'),1)
C DAGGER= VOCAB(CODE('DAGG','E'),1)
C ELVNDR= VOCAB(CODE('ELVE','N'),1)
C TRAP = VOCAB(CODE('TRAP'),1)
C MAGICN= VOCAB(CODE('MAGI','C'),1)
C SIGN = VOCAB(CODE('SIGN'),1)
C BOOK = VOCAB(CODE('BOOK'),1)
C STAFF = VOCAB(CODE('STAF','F'),1)
CC
CC OBJECTS FROM 50 THROUGH WHATEVER ARE TREASURES. HERE ARE A FEW.
CC
C NUGGET=VOCAB(CODE('GOLD'),1)
C COINS=VOCAB(CODE('COIN','S'),1)
C CHEST=VOCAB(CODE('CHES','T'),1)
C EGGS=VOCAB(CODE('EGGS'),1)
C TRIDNT=VOCAB(CODE('TRID','E'),1)
C VASE=VOCAB(CODE('VASE'),1)
C EMRALD=VOCAB(CODE('EMER','A'),1)
C PYRAM=VOCAB(CODE('PYRA','M'),1)
C PEARL=VOCAB(CODE('PEAR','L'),1)
C RUG=VOCAB(CODE('RUG'),1)
C CHAIN=VOCAB(CODE('CHAI','N'),1)
C SPICES=VOCAB(CODE('SPIC','E'),1)
C CROWN=VOCAB(CODE('CROW','N'),1)
C RING=VOCAB(CODE('RING'),1)
C SWORD=VOCAB(CODE('SWOR','D'),1)
C MITHRL= VOCAB(CODE('MITH','R'),1)
C SCHOL = VOCAB(CODE('SCHO','L'),1)
CC
CC THESE ARE MOTION-VERB NUMBERS.
CC
C BACK=VOCAB(CODE('BACK'),0)
C LOOK=VOCAB(CODE('LOOK'),0)
C CAVE=VOCAB(CODE('CAVE'),0)
C NULL=VOCAB(CODE('NULL'),0)
C ENTRNC=VOCAB(CODE('ENTR','A'),0)
C DPRSSN=VOCAB(CODE('DEPR','E'),0)
CC
CC AND SOME ACTION VERBS.
CC
C SAY=VOCAB(CODE('SAY'),2)
C LOCK=VOCAB(CODE('LOCK'),2)
C THROW=VOCAB(CODE('THRO','W'),2)
C FIND=VOCAB(CODE('FIND'),2)
C INVENT=VOCAB(CODE('INVE','N'),2)
C WEAR = VOCAB(CODE('WEAR'),2)
C REMOVE= VOCAB(CODE('REMO','V'),2)
C
C THESE ARE THE ORIGINAL DEC-10 DEFINITIONS TO BE USED WHEN
C CODE IS NOT AVAILABLE
KEYS=VOCAB('KEYS',1)
LAMP=VOCAB('LAMP',1)
GRATE=VOCAB('GRATE',1)
CAGE=VOCAB('CAGE',1)
ROD=VOCAB('ROD',1)
ROD2=ROD+1
STEPS=VOCAB('STEPS',1)
BIRD=VOCAB('BIRD',1)
DOOR=VOCAB('DOOR',1)
PILLOW=VOCAB('PILLOW',1)
SNAKE=VOCAB('SNAKE',1)
FISSUR=VOCAB('FISSU',1)
TABLET=VOCAB('TABLE',1)
CLAM=VOCAB('CLAM',1)
OYSTER=VOCAB('OYSTE',1)
MAGZIN=VOCAB('MAGAZ',1)
DWARF=VOCAB('DWARF',1)
KNIFE=VOCAB('KNIFE',1)
FOOD=VOCAB('FOOD',1)
BOTTLE=VOCAB('BOTTL',1)
WATER=VOCAB('WATER',1)
OIL=VOCAB('OIL',1)
PLANT=VOCAB('PLANT',1)
PLANT2=PLANT+1
AXE=VOCAB('AXE',1)
MIRROR=VOCAB('MIRRO',1)
DRAGON=VOCAB('DRAGO',1)
CHASM=VOCAB('CHASM',1)
TROLL=VOCAB('TROLL',1)
TROLL2=TROLL+1
BEAR=VOCAB('BEAR',1)
MESSAG=VOCAB('MESSA',1)
VEND=VOCAB('VENDI',1)
BATTER=VOCAB('BATTE',1)
STONE=VOCAB('STONE',1)
PLAQUE=VOCAB('PLAQU',1)
TPASS=VOCAB('TPASS',1)
BROOM=VOCAB('BROOM',1)
MAP=VOCAB('MAP',1)
DAGGER=VOCAB('DAGGER',1)
ELVNDR=VOCAB('ELVEN',1)
TRAP=VOCAB('TRAP',1)
MAGICN=VOCAB('MAGIC',1)
SIGN=VOCAB('SIGN',1)
BOOK=VOCAB('BOOK',1)
STAFF=VOCAB('STAFF',1)
NUGGET=VOCAB('GOLD',1)
COINS=VOCAB('COINS',1)
CHEST=VOCAB('CHEST',1)
EGGS=VOCAB('EGGS',1)
TRIDNT=VOCAB('TRIDE',1)
VASE=VOCAB('VASE',1)
EMRALD=VOCAB('EMERA',1)
PYRAM=VOCAB('PYRAM',1)
PEARL=VOCAB('PEARL',1)
RUG=VOCAB('RUG',1)
CHAIN=VOCAB('CHAIN',1)
SPICES=VOCAB('SPICE',1)
CROWN=VOCAB('CROWN',1)
RING=VOCAB('RING',1)
SWORD=VOCAB('SWORD',1)
MITHRL=VOCAB('MITHR',1)
SCHOL=VOCAB('SCHOL',1)
BACK=VOCAB('BACK',0)
LOOK=VOCAB('LOOK',0)
CAVE=VOCAB('CAVE',0)
NULL=VOCAB('NULL',0)
ENTRNC=VOCAB('ENTRA',0)
DPRSSN=VOCAB('DEPRE',0)
SAY=VOCAB('SAY',2)
LOCK=VOCAB('LOCK',2)
THROW=VOCAB('THROW',2)
FIND=VOCAB('FIND',2)
INVENT=VOCAB('INVEN',2)
WEAR=VOCAB('WEAR',2)
REMOVE=VOCAB('REMOV',2)
C INITIALIZE 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.
C
CHLOC=114
CHLOC2=140
DO 1700 I=1,12
1700 DSEEN(I)=.FALSE.
DFLAG=0
DLOC(1)=19
DLOC(2)=27
DLOC(3)=33
DLOC(4)=44
DLOC(5)=64
DO 1701 I = 6, 10
DLOC(I)=0
1701 CONTINUE
DLOC(11)=CHLOC
DLOC(12)=0
DALTLC=18
C
C OTHER RANDOM FLAGS AND COUNTERS, AS FOLLOWS:
C TURNS TALLIES HOW MANY COMMANDS HE'S GIVEN (IGNORES YES/NO)
C TURNS2 USED TO VERIFY TURNS ARE BEING COUNTED
C TURNS3 ANOTHER BACKUP TURNS COUNTER
C LIMIT LIFETIME OF LAMP (NOT SET HERE)
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 DETAIL HOW OFTEN WE'VE SAID "NOT ALLOWED TO GIVE MORE DETAIL"
C ABBNUM HOW OFTEN WE SHOULD TYPE NON-ABBREVIATED DESCRIPTIONS
C MAXDIE NUMBER OF REINCARNATION MESSAGES AVAILABLE (UP TO 5)
C NUMDIE NUMBER OF TIMES KILLED SO FAR
C HOLDNG NUMBER OF OBJECTS BEING CARRIED
C DKILL NUMBER OF DWARVES KILLED (UNUSED IN SCORING, NEEDED FOR MSG)
C FOOBAR CURRENT PROGRESS IN SAYING "FEE FIE FOE FOO".
C BONUS USED TO DETERMINE AMOUNT OF BONUS IF HE REACHES CLOSING
C CLOCK1 NUMBER OF TURNS FROM FINDING LAST TREASURE TILL CLOSING
C CLOCK2 NUMBER OF TURNS FROM FIRST WARNING TILL BLINDING FLASH
C MAGIC1 CURRENT PROGRESS IN ENCOUNTERING MAGICIAN
C MAGIC2 HOW ANNOYED THE MAGICIAN IS
C LOGICALS WERE EXPLAINED EARLIER
C
TURNS=0
LMWARN=.FALSE.
IWEST=0
KNFLOC=0
DETAIL=0
ABBNUM=5
DO 1800 I=1,5
1800 IF(RTEXT(2*I+79).NE.0)MAXDIE=I
NUMDIE=0
HOLDNG=0
DKILL=0
FOOBAR=0
BONUS=0
CLOCK1=30
CLOCK2=50
SAVED=0
TURNS2 = 0
TURNS3 = 0
CLOSNG=.FALSE.
PANIC=.FALSE.
CLOSED=.FALSE.
GAVEUP=.FALSE.
SCORNG=.FALSE.
SCORE2 = .FALSE.
MAGIC1 = 0
MAGIC2 = 0
C
C IF SETUP=1, REPORT ON AMOUNT OF ARRAYS ACTUALLY USED, TO PERMIT REDUCTIONS.
C
IF(SETUP.NE.1)GOTO 1
SETUP=2
C
DO 1998 K=1,LOCSIZ
KK=LOCSIZ+1-K
IF(LTEXT(KK).NE.0)GOTO 1997
1998 CONTINUE
C
OBJ=0
1997 DO 1996 K=1,100
1996 IF(PTEXT(K).NE.0)OBJ=OBJ+1
C
DO 1995 K=1,TABNDX
1995 IF(KTAB(K)/1000.EQ.2)VERB=KTAB(K)-2000
C
DO 1994 K=1,RTXSIZ
J=RTXSIZ+1-K
IF(RTEXT(J).NE.0)GOTO 1993
1994 CONTINUE
C
1993 DO 1992 K=1,MAGSIZ
I=MAGSIZ+1-K
IF(MTEXT(I).NE.0)GOTO 1991
1992 CONTINUE
C
1991 K=100
WRITE (5,1999)LINUSE,LINSIZ,TRVS,TRVSIZ,TABNDX,TABSIZ,KK
1 ,LOCSIZ,OBJ,K,VERB,VRBSIZ,J,RTXSIZ,CLSSES,CLSMAX
2 ,HNTMAX,HNTSIZ,I,MAGSIZ
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'/
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 )
C
C FINALLY, SINCE WE'RE CLEARLY SETTING THINGS UP FOR THE FIRST TIME...
C
CALL POOF
CALL MAINT
C START-UP, DWARF STUFF
C
C Modified to ask about restarted games 10/24/78
1 DEMO=START(0)
CALL MOTD(.FALSE.)
I=RAN(1)
NEWLOC=1
SETUP=3
LIMIT=430
IF (DEMO) GOTO 5
IF (.NOT.YES(223,0,0)) GOTO 5
CALL LOAD('REST')
TURNS2 = TURNS
TURNS3 = TURNS/10
IF (MOD(TURNS,10).GE.2) TURNS3 = TURNS3 + 1
DEMO=START(0)
K = NULL
IF (SEGOFF.EQ.0) GOTO 4
C IF (.NOT.STAT4(SEGOFF,ACCT)) GOTO 4
SAVED = 1
LIMIT = MIN0(35,LIMIT)
4 CONTINUE
GOTO 8
5 CONTINUE
HINTED(3)=YES(65,1,0)
IF(HINTED(3))LIMIT=1200
C
C CAN'T LEAVE CAVE ONCE IT'S CLOSING (EXCEPT BY MAIN OFFICE).
C
2 IF(NEWLOC.GE.9.OR.NEWLOC.EQ.0.OR..NOT.CLOSNG)GOTO 71
CALL RSPEAK(130)
NEWLOC=LOC
IF(.NOT.PANIC)CLOCK2=15
PANIC=.TRUE.
C
C SEE IF A DWARF HAS SEEN HIM AND HAS COME FROM WHERE HE WANTS TO GO. IF SO,
C THE DWARF'S BLOCKING HIS WAY. IF COMING FROM PLACE FORBIDDEN TO PIRATE
C (DWARVES ROOTED IN PLACE) LET HIM GET OUT (AND ATTACKED).
C
71 IF(NEWLOC.EQ.LOC.OR.FORCED(LOC).OR.BITSET(LOC,3))GOTO 74
DO 73 I=1,10
IF(ODLOC(I).NE.NEWLOC.OR..NOT.DSEEN(I))GOTO 73
NEWLOC=LOC
CALL RSPEAK(2)
GOTO 74
73 CONTINUE
74 LOC=NEWLOC
C
C DWARF STUFF. SEE EARILIER COMMENTS FOR DESCRIPTION OF VARIABLES. REMEMBER
C ELEVENTH DWARF IS PIRATE AND IS THUS VERY DIFFERENT EXCEPT FOR MOTION RULES.
C
C FIRST OFF, DON'T LET THE DWARVES FOLLOW HIM INTO A PIT OR A WALL. ACTIVATE
C THE WHOLE MESS THE FIRST TIME HE GETS AS FAR AS THE HALL OF MISTS (LOC 15).
C IF NEWLOC IS FORBIDDEN TO PIRATE (IN PARTICULAR, IF IT'S BEYOND THE TROLL
C BRIDGE), BYPASS DWARF STUFF. THAT WAY PIRATE CAN'T STEAL RETURN TOLL, AND
C DWARVES CAN'T MEET THE BEAR. ALSO MEANS DWARVES WON'T FOLLOW HIM INTO DEAD
C END IN MAZE, BUT C'EST LA VIE. THEY'LL WAIT FOR HIM OUTSIDE THE DEAD END.
C
IF(LOC.EQ.0.OR.FORCED(LOC).OR.BITSET(NEWLOC,3))GOTO 2000
IF(DFLAG.NE.0)GOTO 6000
IF(LOC.GE.15)DFLAG=1
GOTO 2000
C
C WHEN WE ENCOUNTER THE FIRST DWARF, WE KILL 0, 1, OR 2 OF THE 5 DWARVES. IF
C ANY OF THE SURVIVORS IS AT LOC, REPLACE HIM WITH THE ALTERNATE.
C
6000 IF(DFLAG.NE.1)GOTO 6010
IF(LOC.LT.15.OR.PCT(95))GOTO 2000
DFLAG=2
DO 6001 I=1,2
J=1+RAN(5)
C IF SAVED NOT = -1, HE BYPASSED THE "START" CALL.
6001 IF(PCT(50).AND.SAVED.EQ.-1)DLOC(J)=0
DO 6002 I=1,10
IF(DLOC(I).EQ.LOC)DLOC(I)=DALTLC
6002 ODLOC(I)=DLOC(I)
CALL RSPEAK(3)
CALL DROP(AXE,LOC)
GOTO 2000
C
C THINGS ARE IN FULL SWING. MOVE EACH DWARF AT RANDOM, EXCEPT IF HE'S SEEN US
C HE STICKS WITH US. DWARVES NEVER GO TO LOCS <15. IF WANDERING AT RANDOM,
C THEY DON'T BACK UP UNLESS THERE'S NO ALTERNATIVE. IF THEY DON'T HAVE TO
C MOVE, THEY ATTACK. AND, OF COURSE, DEAD DWARVES DON'T DO MUCH OF ANYTHING,
C UNLESS HE'S CHEATING, IN WHICH CASE THEY ARE RESSURECTED.
C
6010 DTOTAL=0
ATTACK=0
STICK=0
DO 6030 I=1,12
IF(DLOC(I).EQ.0)GOTO 6029
J=1
KK=DLOC(I)
KK=KEY(KK)
IF(KK.EQ.0)GOTO 6016
6012 NEWLOC=MOD(IABS(TRAVEL(KK))/1000,1000)
IF(NEWLOC.GT.300.OR.NEWLOC.LT.15.OR.NEWLOC.EQ.ODLOC(I)
1 .OR.(J.GT.1.AND.NEWLOC.EQ.TK(J-1)).OR.J.GE.20
2 .OR.NEWLOC.EQ.DLOC(I).OR.FORCED(NEWLOC)
3 .OR.(I.EQ.6.AND.BITSET(NEWLOC,3))
4 .OR.IABS(TRAVEL(KK))/1000000.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.LOC.GE.15)
1 .OR.(DLOC(I).EQ.LOC.OR.ODLOC(I).EQ.LOC)
IF(.NOT.DSEEN(I))GOTO 6030
DLOC(I)=LOC
IF(I.NE.11)GOTO 6027
C
C THE PIRATE'S SPOTTED HIM. HE LEAVES HIM ALONE ONCE WE'VE FOUND CHEST.
C K COUNTS IF A TREASURE IS HERE. IF NOT, AND TALLY=TALLY2 PLUS ONE FOR
C AN UNSEEN CHEST, LET THE PIRATE BE SPOTTED.
C
IF(LOC.EQ.CHLOC.OR.PROP(CHEST).GE.0)GOTO 6030
K=0
DO 6020 J=50,MAXTRS
C PIRATE WON'T TAKE PYRAMID FROM PLOVER ROOM OR DARK ROOM (TOO EASY!).
IF(J.EQ.PYRAM.AND.(LOC.EQ.PLAC(PYRAM)
1 .OR.LOC.EQ.PLAC(EMRALD)))GOTO 6020
IF(TOTING(J))GOTO 6022
6020 IF(HERE(J))K=1
IF(TALLY.EQ.TALLY2+1.AND.K.EQ.0.AND.PLACE(CHEST).EQ.0
1 .AND.HERE(LAMP).AND.PROP(LAMP).EQ.1)GOTO 6025
IF(ODLOC(6).NE.DLOC(6).AND.PCT(20))CALL RSPEAK(127)
GOTO 6030
C
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=50,MAXTRS
IF(J.EQ.PYRAM.AND.(LOC.EQ.PLAC(PYRAM)
1 .OR.LOC.EQ.PLAC(EMRALD)))GOTO 6023
IF(AT(J).AND.FIXED(J).EQ.0)CALL CARRY(J,LOC)
IF(TOTING(J))CALL DROP(J,CHLOC)
6023 CONTINUE
6024 DLOC(11)=CHLOC
ODLOC(11)=CHLOC
DSEEN(11)=.FALSE.
GOTO 6030
C
6025 CALL RSPEAK(186)
CALL MOVE(CHEST,CHLOC)
CALL MOVE(MESSAG,CHLOC2)
GOTO 6024
C
C THIS THREATENING LITTLE DWARF IS IN THE ROOM WITH HIM!
C
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
GOTO 6030
6029 CONTINUE
C IF HE'S CHEATING AND THE DWARF IS DEAD, BRING IT BACK TO LIFE
C IT COMES BACK AT Y2 UNLESS HE'S THERE IN WHICH CASE IT CONES
C BACK IN THE HALL OF MISTS.
IF (.NOT.(SAVED.NE.-1.AND.DLOC(I).EQ.0)) GOTO 6030
DLO C(I) = 33
IF (LOC.EQ.33) DLOC(I) = 15
6030 CONTINUE
C IF TURNS2 IS NOT EQUAL TO TURNS THEN SOMEONE IS CHEATING
IF (LOC.LT.15.OR. (TURNS.EQ.TURNS2.AND.TURNS .GE.0)) GOTO 6035
DTOTAL = DTOTAL + 1
ATTACK = ATTACK + 1
STICK = STICK + 1
6035 CONTINUE
C
C NOW WE KNOW WHAT'S HAPPENING. LET'S TELL THE POOR SUCKER ABOUT IT.
C
IF(DTOTAL.EQ.0)GOTO 2000
IF(DTOTAL.EQ.1)GOTO 75
TYPE 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
TYPE 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 TYPE 68,STICK
68 FORMAT(/' ',I1,' OF THEM GET YOU!')
84 OLDLC2=LOC
GOTO 99
C
79 CALL RSPEAK(5)
K=52
GOTO 82
C
C DESCRIBE THE CURRENT LOCATION AND (MAYBE) GET NEXT COMMAND.
C
C TYPE TEXT FOR CURRENT LOC.
C
2000 IF(LOC.EQ.0)GOTO 99
KK=STEXT(LOC)
IF(MOD(ABB(LOC),ABBNUM).EQ.0.OR.KK.EQ.0)KK=LTEXT(LOC)
IF(FORCED(LOC).OR..NOT.DARK(0))GOTO 2001
IF(WZDARK.AND.PCT(35))GOTO 90
KK=RTEXT(16)
2001 IF(TOTING(BEAR))CALL RSPEAK(141)
CALL SPEAK(KK)
K=1
IF(FORCED(LOC))GOTO 8
IF(LOC.EQ.33.AND.PCT(25).AND..NOT.CLOSNG)CALL RSPEAK(8)
C
C TYPE OUT DESCRIPTIONS OF OBJECTS AT THIS LOCATION. IF NOT CLOSING AND
C PROPERTY VALUE IS NEGATIVE, TALLY OFF ANOTHER TREASURE. RUG IS SPECIAL
C CASE; ONCE SEEN, ITS PROP IS 1 (DRAGON ON IT) TILL DRAGON IS KILLED.
C SIMILARLY FOR CHAIN; PROP IS INITIALLY 1 (LOCKED TO BEAR). THESE HACKS
C ARE BECAUSE PROP=0 IS NEEDED TO GET FULL SCORE.
C
IF(DARK(0))GOTO 2012
ABB(LOC)=ABB(LOC)+1
I=ATLOC(LOC)
2004 IF(I.EQ.0)GOTO 2012
OBJ=I
IF(OBJ.GT.100)OBJ=OBJ-100
IF(OBJ.EQ.STEPS.AND.TOTING(NUGGET))GOTO 2008
IF(PROP(OBJ).GE.0)GOTO 2006
IF(CLOSED)GOTO 2008
PROP(OBJ)=0
IF(OBJ.EQ.RUG.OR.OBJ.EQ.CHAIN.OR.OBJ.EQ.CROWN.OR.OBJ.EQ.RING
1 .OR.OBJ.EQ.SWORD.OR.OBJ.EQ.SCHOL) PROP(OBJ)=1
TALLY=TALLY-1
C IF REMAINING TREASURES TOO ELUSIVE, ZAP HIS LAMP.
IF(TALLY.EQ.TALLY2.AND.TALLY.NE.0)LIMIT=MIN0(35,LIMIT)
2006 KK=PROP(OBJ)
IF(OBJ.EQ.STEPS.AND.LOC.EQ.FIXED(STEPS))KK=1
CALL PSPEAK(OBJ,KK)
2008 I=LINK(I)
GOTO 2004
C
2009 K=54
2010 SPK=K
2011 CALL RSPEAK(SPK)
C
2012 VERB=0
OBJ=0
C
C CHECK IF THIS LOC IS ELIGIBLE FOR ANY HINTS. IF BEEN HERE LONG ENOUGH,
C BRANCH TO HELP SECTION (ON LATER PAGE). HINTS ALL COME BACK HERE EVENTUALLY
C TO FINISH THE LOOP. IGNORE "HINTS" < 4 (SPECIAL STUFF, SEE DATABASE NOTES).
C
2600 DO 2602 HINT=4,HNTMAX
IF(HINTED(HINT))GOTO 2602
IF(.NOT.BITSET(LOC,HINT))HINTLC(HINT)=-1
HINTLC(HINT)=HINTLC(HINT)+1
IF(HINTLC(HINT).GE.HINTS(HINT,1))GOTO 40000
2602 CONTINUE
C
C KICK THE RANDOM NUMBER GENERATOR JUST TO ADD VARIETY TO THE CHASE. ALSO,
C IF CLOSING TIME, CHECK FOR ANY OBJECTS BEING TOTED WITH PROP < O AND SET
C THE PROP TO -1-PROP. THIS WAY OBJECTS WON'T BE DESCRIBED UNTIL THEY'VE
C BEEN PICKED UP AND PUT DOWN SEPARATE FROM THEIR RESPECTIVE PILES. DON'T
C TICK CLOCK1 UNLESS WELL INTO CAVE (AND NOT AT Y2).
C
IF(.NOT.CLOSED)GOTO 2605
IF(PROP(OYSTER).LT.0.AND.TOTING(OYSTER))
1 CALL PSPEAK(OYSTER,1)
DO 2604 I=1,100
2604 IF(TOTING(I).AND.PROP(I).LT.0)PROP(I)=-1-PROP(I)
2605 WZDARK=DARK(0)
IF(KNFLOC.GT.0.AND.KNFLOC.NE.LOC)KNFLOC=0
I=RAN(1)
CALL GETIN(WD1,WD1X,WD2,WD2X)
C
C EVERY INPUT, CHECK "FOOBAR" FLAG. IF ZERO, NOTHING'S GOING ON. IF POS,
C MAKE NEG. IF NEG, HE SKIPPED A WORD, SO MAKE IT ZERO.
C
2608 FOOBAR=MIN0(0,-FOOBAR)
C
C IF THIS IS TURN 0 THEN WE MIGHT WANT TO RECOGNIZE SPECIAL COMMANDS.
C IF COMMAND IS "MAGIC MODE" THEN HE WANTS TO UPDATE SOMETHING AND WE
C PROCEED TO MAINT. IF THE COMMAND IS "RESTORE" AND THIS IS NOT A
C DEMONSTRATION GAME (NOT PRIME TIME) THEN THE LOAD ROUTINE IS CALLED AND WE
C CONTINUE WITH A NULL COMMAND. (IF THIS IS PRIME TIME WE PASS THE COMMAND
C ON TO HAVE IT IGNORED). IF FINISHED IS TRUE THEN THE GAME HAS ALREADY
C BEEN FINISHED SO SET THE DWARVES ON HIM.
C IF THIS IS NOT A RESTORE OR MAINTENANCE THEN
C STAT1 IS CALLED TO KEEP STATISTICS ON A NEW GAME.
C
IF (TURNS.NE.0) GOTO 2609
C IF (WD1.EQ.CODE('MAGI','C').AND.WD2.EQ.CODE('MODE')) CALL MAINT
C IF (DEMO.OR.WD1.NE.CODE('REST','O').OR.WD1X.NE.CODE('RE'))
IF (WD1.EQ.'MAGIC'.AND.WD2.EQ.'MODE') CALL MAINT
IF (DEMO.OR.WD1.NE.'RESTO'.OR.WD1X.NE.'RE')
1 GOTO 2615
CALL LOAD ('REST')
TURNS2 = TURNS
TURNS3 = TURNS/10
IF (MOD(TURNS,10).GE.2) TURNS3 = TURNS3 + 1
DEMO = START(0)
C WD1 = CODE('NULL')
WD1 = 'NULL'
IF (SEGOFF.EQ.0) GOTO 2609
C IF (.NOT.STAT4(SEGOFF,ACCT)) GOTO 2621
SAVED = 1
LIMIT = MIN0(35,LIMIT)
2621 CONTINUE
GOTO 2609
C ELSE
C2615 SEGOFF = STAT1(DEMO,ACCT)
C ENDIF
C ENDIF
2615 CONTINUE
2609 CONTINUE
TURNS=TURNS+1
IF(DEMO.AND.TURNS.GE.SHORT)GOTO 13000
IF (MOD(TURNS,10).EQ.2) TURNS3 = TURNS3 + 1
IF (TURNS3.NE.(TURNS+8)/10) SAVED = 1
IF(TURNS.EQ.3)CALL DATIME(XXD,XXT)
IF(TURNS.NE.45)GOTO 2617
C SEE IF TIMER HAS BEEN ZAPPED; IF SO, HE'S CHEATING
CALL DATIME(YYD,YYT)
IF(XXD.EQ.YYD.AND.XXT.EQ.YYT)SAVED=0
2617 IF(VERB.EQ.SAY.AND.WD2.NE.0)VERB=0
TURNS2 = TURNS2 + 1
IF (TURNS.LT.0.OR.TURNS.NE.TURNS2) SAVED = 1
IF(VERB.EQ.SAY)GOTO 4090
IF(TALLY.EQ.0.AND.LOC.GE.15.AND.LOC.NE.33)CLOCK1=CLOCK1-1
IF(CLOCK1.EQ.0)GOTO 10000
IF(CLOCK1.LT.0)CLOCK2=CLOCK2-1
IF(CLOCK2.EQ.0)GOTO 11000
IF(PROP(LAMP).EQ.1)LIMIT=LIMIT-1
IF(LIMIT.LE.30.AND.HERE(BATTER).AND.PROP(BATTER).EQ.0
1 .AND.HERE(LAMP))GOTO 12000
IF(LIMIT.EQ.0)GOTO 12400
IF(LIMIT.LT.0.AND.LOC.LE.8)GOTO 12600
IF(LIMIT.LE.30)GOTO 12200
C
C SEE IF MAGICIAN IS IS ROOM WITH HIM. IF HE IS AND WE HAVE BEEN HERE
C FOR A SUFFICIENTLY LONG TIME, ZAP HIM. IF THE MAGICIAN IS NOT HERE,
C RESET HOW LONG WE HAVE BEEN VISITING HIM. (MAGIC1)
19999 IF (.NOT.HERE(MAGICN)) MAGIC1 = 0
IF (MAGIC1.EQ.0) GOTO 2611
IF (MAGIC1.EQ.1.AND..NOT.WEARNG(CROWN).AND..NOT.WEARNG(RING))
1 GOTO 2611
MAGIC2 = MAGIC2 + 1
IF (WEARNG(CROWN).OR.WEARNG(RING).OR.MAGIC2.GE.4) GOTO 7050
IF (CLOSNG) GOTO 7050
C BUMP HIM BACK TO BUILDING
CALL RSPEAK(234)
LOC = 3
OLDLOC = 3
GOTO 2611
C HE'S REALLY BOTHERING MAGICIAN
C SO KILL HIM
7050 CALL RSPEAK(235)
DO 7055 I = 1, 99
J = 101 - I
IF (.NOT.TOTING(J).AND..NOT.WEARNG(J)) GOTO 7055
IF (PLAC(J).EQ.0) GOTO 7053
CALL DROP (J,LOC)
GOTO 7055
7053 CALL DROP (J,PLAC(J))
7055 CONTINUE
GOTO 99
C
2611 K=43
IF(LIQLOC(LOC).EQ.WATER)K=70
C IF(WD1.EQ.CODE('ENTE','R').AND.(WD2.EQ.
C 1 CODE('STRE','A').OR.WD2.EQ.CODE('WATE','R')))
C 2 GOTO 2010
C IF(WD1.EQ.CODE('ENTE','R').AND.WD2.NE.0)GOTO 2800
C IF((WD1.NE.CODE('WATE','R').AND.WD1.NE.CODE('OIL'))
C 1 .OR.(WD2.NE.CODE('PLAN','T').AND.WD2.NE.CODE('DOOR')))
C 2 GOTO 2610
C IF(AT(VOCAB(WD2,1)))WD2=CODE('POUR')
C2610 IF(WD1.NE.CODE('WEST'))GOTO 2630
IF(WD1.EQ.'ENTER'.AND.(WD2.EQ.'STREA'.OR.WD2.EQ.'WATER'))
1 GOTO 2010
IF(WD1.EQ.'ENTER'.AND.WD2.NE.0)GOTO 2800
IF((WD1.NE.'WATER'.AND.WD1.NE.'OIL') .OR.
1 (WD2.NE.'PLANT'.AND.WD2.NE.'DOOR')) GOTO 2610
IF(AT(VOCAB(WD2,1))) WD2='POUR'
2610 IF(WD1.NE.'WEST') GOTO 2630
IWEST=IWEST+1
IF(IWEST.EQ.10)CALL RSPEAK(17)
2630 I=VOCAB(WD1,-1)
IF(I.EQ.-1)GOTO 3000
K=MOD(I,1000)
KQ=I/1000+1
GOTO (8,5000,4000,2010),KQ
CALL BUG(22)
C
C GET SECOND WORD FOR ANALYSIS.
C
2800 WD1=WD2
WD1X=WD2X
WD2=0
GOTO 2610
C
C GEE, I DON'T UNDERSTAND.
C
3000 SPK=60
IF(PCT(20))SPK=61
IF(PCT(20))SPK=13
CALL RSPEAK(SPK)
GOTO 2600
C ANALYSE A VERB. REMEMBER WHAT IT WAS, GO BACK FOR OBJECT IF SECOND WORD
C UNLESS VERB IS 'SAY', WHICH SNARFS ARBITRARY SECOND WORD.
C
4000 VERB=K
SPK=ACTSPK(VERB)
IF(WD2.NE.0.AND.VERB.NE.SAY)GOTO 2800
IF(VERB.EQ.SAY)OBJ=WD2
IF(OBJ.NE.0)GOTO 4090
C
C ANALYSE AN INTRANSITIVE VERB (IE, NO OBJECT GIVEN YET).
C
4080 GOTO(8010,8000,8000,8040,2009,8040,9070,9080,8000,8000,
1 2011,9120,9130,8140,9150,8000,8000,8180,8000,8200,
2 8000,9220,9230,8240,8250,8260,8270,8000,8000,8300,
3 8310,8320,8330,8340,9070,9080,8370),VERB
C TAKE DROP SAY OPEN NOTH LOCK LGHT EXTI WAVE CALM
C WALK KILL POUR EAT DRNK RUB TOSS QUIT FIND INVN
C FEED FILL BLST SCOR FOO BRF READ BREK WAKE SUSP
C HOUR WEAR PULL REMV ON OFF SWEP
CALL BUG(23)
C
C ANALYSE A TRANSITIVE VERB.
C
4090 GOTO(9010,9020,9030,9040,2009,9040,9070,9080,9090,2011,
1 2011,9120,9130,9140,9150,9160,9170,2011,9190,9190,
2 9210,9220,9230,2011,2011,2011,9270,9280,9290,2011,
3 2011,9320,9330,9340,9350,9360,2011),VERB
C TAKE DROP SAY OPEN NOTH LOCK LGHT EXTI WAVE CALM
C WALK KILL POUR EAT DRNK RUB TOSS QUIT FIND INVN
C FEED FILL BLST SCOR FOO BRF READ BREK WAKE SUSP
C HOUR WEAR PULL REMV ON OFF SWEP
CALL BUG(24)
C
C ANALYSE AN OBJECT WORD. SEE IF THE THING IS HERE, WHETHER WE'VE GOT A VERB
C YET, AND SO ON. OBJECT MUST BE HERE UNLESS VERB IS 'FIND' OR 'INVENT(ORY)'
C (AND NO NEW VERB YET TO BE ANALYSED). WATER AND OIL ARE ALSO FUNNY, SINCE
C THEY ARE NEVER ACTUALLY DROPPED AT ANY LOCATION, BUT MIGHT BE HERE INSIDE
C THE BOTTLE OR AS A FEATURE OF THE LOCATION.
C
5000 OBJ=K
IF(FIXED(K).NE.LOC.AND..NOT.HERE(K))GOTO 5100
5010 IF(WD2.NE.0)GOTO 2800
IF(VERB.NE.0)GOTO 4090
CALL A5TOA1(WD1,WD1X,'?',TK,K)
TYPE 5015,(TK(I),I=1,K)
5015 FORMAT(/' WHAT DO YOU WANT TO DO WITH THE ',20A1)
GOTO 2600
C
5100 IF(K.NE.GRATE)GOTO 5110
IF(LOC.EQ.1.OR.LOC.EQ.4.OR.LOC.EQ.7)K=DPRSSN
IF(LOC.GT.9.AND.LOC.LT.15)K=ENTRNC
IF(K.NE.GRATE)GOTO 8
5110 IF(K.NE.DWARF)GOTO 5120
DO 5112 I=1,10
IF(DLOC(I).EQ.LOC.AND.DFLAG.GE.2)GOTO 5010
5112 CONTINUE
5120 IF((LIQ(0).EQ.K.AND.HERE(BOTTLE)).OR.K.EQ.LIQLOC(LOC))GOTO 5010
IF(OBJ.NE.PLANT.OR..NOT.AT(PLANT2).OR.PROP(PLANT2).EQ.0)GOTO 5130
OBJ=PLANT2
GOTO 5010
5130 IF(OBJ.NE.KNIFE.OR.KNFLOC.NE.LOC)GOTO 5140
KNFLOC=-1
SPK=116
GOTO 2011
5140 IF(OBJ.NE.ROD.OR..NOT.HERE(ROD2))GOTO 5190
OBJ=ROD2
GOTO 5010
5190 IF((VERB.EQ.FIND.OR.VERB.EQ.INVENT).AND.WD2.EQ.0)GOTO 5010
CALL A5TOA1(WD1,WD1X,'HERE.',TK,K)
TYPE 5199,(TK(I),I=1,K)
5199 FORMAT(/' I SEE NO ',20A1)
GOTO 2012
C FIGURE OUT THE NEW LOCATION
C
C GIVEN THE CURRENT LOCATION IN "LOC", AND A MOTION VERB NUMBER IN "K", PUT
C THE NEW LOCATION IN "NEWLOC". THE CURRENT LOC IS SAVED IN "OLDLOC" IN CASE
C HE WANTS TO RETREAT. THE CURRENT OLDLOC IS SAVED IN OLDLC2, IN CASE HE
C DIES. (IF HE DOES, NEWLOC WILL BE LIMBO, AND OLDLOC WILL BE WHAT KILLED
C HIM, SO WE NEED OLDLC2, WHICH IS THE LAST PLACE HE WAS SAFE.)
C
8 KK=KEY(LOC)
NEWLOC=LOC
IF(KK.EQ.0)CALL BUG(26)
IF(K.EQ.NULL)GOTO 2
IF(K.EQ.BACK)GOTO 20
IF (K.EQ.LOOK)GOTO 30
IF(K.EQ.CAVE)GOTO 40
OLDLC2=OLDLOC
OLDLOC=LOC
C
9 LL=IABS(TRAVEL(KK))
IF(MOD(LL,1000).EQ.1.OR.MOD(LL,1000).EQ.K)GOTO 10
IF(TRAVEL(KK).LT.0)GOTO 50
KK=KK+1
GOTO 9
C
10 LL=LL/1000
11 NEWLOC=LL/1000
K=MOD(NEWLOC,100)
IF(NEWLOC.LE.300)GOTO 13
IF(PROP(K).NE.NEWLOC/100-3.AND.NEWLOC/100.NE.9)GOTO 16
IF (WEARNG(K) .AND. NEWLOC/100.EQ.9) GOTO 16
12 IF(TRAVEL(KK).LT.0)CALL BUG(25)
KK=KK+1
NEWLOC=IABS(TRAVEL(KK))/1000
IF(NEWLOC.EQ.LL)GOTO 12
LL=NEWLOC
GOTO 11
C
13 IF(NEWLOC.LE.100)GOTO 14
IF(TOTING(K).OR.(NEWLOC.GT.200.AND.AT(K)))GOTO 16
GOTO 12
C
14 IF(NEWLOC.NE.0.AND..NOT.PCT(NEWLOC))GOTO 12
16 NEWLOC=MOD(LL,1000)
IF(NEWLOC.LE.300)GOTO 2
IF(NEWLOC.LE.500)GOTO 30000
CALL RSPEAK(NEWLOC-500)
NEWLOC=LOC
GOTO 2
C
C SPECIAL MOTIONS COME HERE. LABELLING CONVENTION: STATEMENT NUMBERS NNNXX
C (XX=00-99) ARE USED FOR SPECIAL CASE NUMBER NNN (NNN=301-500)
C
30000 NEWLOC=NEWLOC-300
GOTO (30100,30200,30300,30400,30500),NEWLOC
CALL BUG(20)
C
C TRAVEL 301. PLOVER-ALCOVE PASSAGE. CAN CARRY ONLY EMERALD. NOTE: TRAVEL
C TABLE MUST INCLUDE "USELESS" ENTRIES GOING THROUGH PASSAGE, WHICH CAN NEVER
C BE USED FOR ACTUAL MOTION, BUT CAN BE SPOTTED BY "GO BACK".
C
30100 NEWLOC=99+100-LOC
IF(HOLDNG.EQ.0.OR.(HOLDNG.EQ.1.AND.TOTING(EMRALD)))GOTO 2
NEWLOC=LOC
CALL RSPEAK(117)
GOTO 2
C
C TRAVEL 302. PLOVER TRANSPORT. DROP THE EMERALD (ONLY USE SPECIAL TRAVEL IF
C TOTING IT), SO HE'S FORCED TO USE THE PLOVER-PASSAGE TO GET IT OUT. HAVING
C DROPPED IT, GO BACK AND PRETEND HE WASN'T CARRYING IT AFTER ALL.
C
30200 CALL DROP(EMRALD,LOC)
GOTO 12
C
C TRAVEL 303. TROLL BRIDGE. MUST BE DONE ONLY AS SPECIAL MOTION SO THAT
C DWARVES WON'T WANDER ACROSS AND ENCOUNTER THE BEAR. (THEY WON'T FOLLOW THE
C PLAYER THERE BECAUSE THAT REGION IS FORBIDDEN TO THE PIRATE.) IF
C PROP(TROLL)=1, HE'S CROSSED SINCE PAYING, SO STEP OUT AND BLOCK HIM.
C (STANDARD TRAVEL ENTRIES CHECK FOR PROP(TROLL)=0.) SPECIAL STUFF FOR BEAR.
C
30300 IF(PROP(TROLL).NE.1)GOTO 30310
CALL PSPEAK(TROLL,1)
PROP(TROLL)=0
CALL MOVE(TROLL2,0)
CALL MOVE(TROLL2+100,0)
CALL MOVE(TROLL,PLAC(TROLL))
CALL MOVE(TROLL+100,FIXD(TROLL))
CALL JUGGLE(CHASM)
NEWLOC=LOC
GOTO 2
C
30310 NEWLOC=PLAC(TROLL)+FIXD(TROLL)-LOC
IF(PROP(TROLL).EQ.0)PROP(TROLL)=1
IF(.NOT.TOTING(BEAR))GOTO 2
CALL RSPEAK(162)
PROP(CHASM)=1
PROP(TROLL)=2
CALL DROP(BEAR,NEWLOC)
FIXED(BEAR)=-1
PROP(BEAR)=3
IF(PROP(SPICES).LT.0)TALLY2=TALLY2+1
OLDLC2=NEWLOC
GOTO 99
C
C TRAVEL 304
C SPECIAL MOTION TO WIZARDS CHAMBER FROM STAIRS
C IF STAFF HAS BEEN DROPPED AFTER BEING PICKED UP, MAKE
C SURE THAT MAGICIAN IS PUT BACK.
C
30400 CALL MOVE(MAGICN,PLAC(MAGICN))
CALL MOVE (STAFF, PLAC(STAFF))
PROP(MAGICN) = 0
PROP(STAFF) = 0
FIXED(STAFF) = -1
PROP(ELVNDR) = 0
GOTO 12
C
C TRAVEL 305
C DWARVE'S MINE FROM STAIRS. IF THE NEW DWARVES HAVE BEEN RELEASED
C AND ARE NOT ALL DEAD, HE GETS THROUGH. OTHERWISE HE DIES.
C
30500 IF (CLOSNG) GOTO 30530
DO 30510 I = 6, 10
IF (DLOC(I) .NE. 0) GOTO 30530
30510 CONTINUE
CALL RSPEAK(240)
DO 30520 I = 6, 10
DLOC(I) = 16
30520 CONTINUE
GOTO 99
30530 NEWLOC = PLACE(SIGN)
GOTO 2
C
C END OF SPECIALS.
C
C HANDLE "GO BACK". LOOK FOR VERB WHICH GOES FROM LOC TO OLDLOC, OR TO OLDLC2
C IF OLDLOC HAS FORCED-MOTION. K2 SAVES ENTRY -> FORCED LOC -> PREVIOUS LOC.
C
20 K=OLDLOC
IF(FORCED(K))K=OLDLC2
OLDLC2=OLDLOC
OLDLOC=LOC
K2=0
IF(K.NE.LOC)GOTO 21
CALL RSPEAK(91)
GOTO 2
C
21 LL=MOD((IABS(TRAVEL(KK))/1000),1000)
IF(LL.EQ.K)GOTO 25
IF(LL.GT.300)GOTO 22
J=KEY(LL)
IF(FORCED(LL).AND.MOD((IABS(TRAVEL(J))/1000),1000).EQ.K)K2=KK
22 IF(TRAVEL(KK).LT.0)GOTO 23
KK=KK+1
GOTO 21
C
23 KK=K2
IF(KK.NE.0)GOTO 25
CALL RSPEAK(140)
GOTO 2
C
25 K=MOD(IABS(TRAVEL(KK)),1000)
KK=KEY(LOC)
GOTO 9
C
C LOOK. CAN'T GIVE MORE DETAIL. PRETEND IT WASN'T DARK (THOUGH IT MAY "NOW"
C BE DARK) SO HE WON'T FALL INTO A PIT WHILE STARING INTO THE GLOOM.
C
30 IF(DETAIL.LT.3)CALL RSPEAK(15)
DETAIL=DETAIL+1
WZDARK=.FALSE.
ABB(LOC)=0
GOTO 2
C
C CAVE. DIFFERENT MESSAGES DEPENDING ON WHETHER ABOVE GROUND.
C
40 IF(LOC.LT.8)CALL RSPEAK(57)
IF(LOC.GE.8)CALL RSPEAK(58)
GOTO 2
C
C NON-APPLICABLE MOTION. VARIOUS MESSAGES DEPENDING ON WORD GIVEN.
C
50 SPK=12
IF(K.GE.43.AND.K.LE.50)SPK=9
IF(K.EQ.29.OR.K.EQ.30)SPK=9
IF(K.EQ.7.OR.K.EQ.36.OR.K.EQ.37)SPK=10
IF(K.EQ.11.OR.K.EQ.19)SPK=11
IF(VERB.EQ.FIND.OR.VERB.EQ.INVENT)SPK=59
IF(K.EQ.62.OR.K.EQ.65)SPK=42
IF(K.EQ.17)SPK=80
CALL RSPEAK(SPK)
GOTO 2
C "YOU'RE DEAD, JIM."
C
C IF THE CURRENT LOC IS ZERO, IT MEANS THE CLOWN GOT HIMSELF KILLED. WE'LL
C ALLOW THIS MAXDIE TIMES. MAXDIE IS AUTOMATICALLY SET BASED ON THE NUMBER OF
C SNIDE MESSAGES AVAILABLE. EACH DEATH RESULTS IN A MESSAGE (81, 83, ETC.)
C WHICH OFFERS REINCARNATION; IF ACCEPTED, THIS RESULTS IN MESSAGE 82, 84,
C ETC. THE LAST TIME, IF HE WANTS ANOTHER CHANCE, HE GETS A SNIDE REMARK AS
C WE EXIT. WHEN REINCARNATED, ALL OBJECTS BEING CARRIED GET DROPPED AT OLDLC2
C (PRESUMABLY THE LAST PLACE PRIOR TO BEING KILLED) WITHOUT CHANGE OF PROPS.
C THE LOOP RUNS BACKWARDS TO ASSURE THAT THE BIRD IS DROPPED BEFORE THE CAGE.
C (THIS KLUGE COULD BE CHANGED ONCE WE'RE SURE ALL REFERENCES TO BIRD AND CAGE
C ARE DONE BY KEYWORDS.) THE LAMP IS A SPECIAL CASE (IT WOULDN'T DO TO LEAVE
C IT IN THE CAVE). IT IS TURNED OFF AND LEFT OUTSIDE THE BUILDING (ONLY IF HE
C WAS CARRYING IT, OF COURSE). HE HIMSELF IS LEFT INSIDE THE BUILDING (AND
C HEAVEN HELP HIM IF HE TRIES TO XYZZY BACK INTO THE CAVE WITHOUT THE LAMP!).
C OLDLOC IS ZAPPED SO HE CAN'T JUST "RETREAT".
C
C THE EASIEST WAY TO GET KILLED IS TO FALL INTO A PIT IN PITCH DARKNESS.
C
90 CALL RSPEAK(23)
OLDLC2=LOC
C
C OKAY, HE'S DEAD. LET'S GET ON WITH IT.
C
99 IF(CLOSNG)GOTO 95
YEA=YES(81+NUMDIE*2,82+NUMDIE*2,54)
NUMDIE=NUMDIE+1
IF(NUMDIE.EQ.MAXDIE.OR..NOT.YEA)GOTO 20000
PLACE(WATER)=0
PLACE(OIL)=0
IF(TOTING(LAMP))PROP(LAMP)=0
DO 98 J=1,100
I=101-J
IF(.NOT.TOTING(I))GOTO 98
K=OLDLC2
IF(I.EQ.LAMP)K=1
CALL DROP(I,K)
98 CONTINUE
IF (PLACE(STAFF).NE.PLAC(STAFF)) CALL MOVE (STAFF, PLAC(STAFF))
LOC=3
OLDLOC=LOC
GOTO 2000
C
C HE DIED DURING CLOSING TIME. NO RESURRECTION. TALLY UP A DEATH AND EXIT
C
95 CALL RSPEAK(131)
NUMDIE=NUMDIE+1
GOTO 20000
C ROUTINES FOR PERFORMING THE VARIOUS ACTION VERBS
C
C STATEMENT NUMBERS IN THIS SECTION ARE 8000 FOR INTRANSITIVE VERBS, 9000 FOR
C TRANSITIVE, PLUS TEN TIMES THE VERB NUMBER. MANY INTRANSITIVE VERBS USE THE
C TRANSITIVE CODE, AND SOME VERBS USE CODE FOR OTHER VERBS, AS NOTED BELOW.
C IF THE NUMBER OF STATEMENT NUMBERS REQUIRED FOR ANY ONE VERB EXCEEDS THE
C TEN PROVIDED, EXTRA STATEMENT NUMBERS ARE TAKEN FROM THE GROUP 9XXYY,
C WHERE XX IS THE NUMBER OF THE PARTICULAR VERB IN QUESTION.
C
C RANDOM INTRANSITIVE VERBS COME HERE. CLEAR OBJ JUST IN CASE (SEE "ATTACK").
C
8000 CALL A5TOA1(WD1,WD1X,'WHAT?',TK,K)
TYPE 8002,(TK(I),I=1,K)
8002 FORMAT(/' ',20A1)
OBJ=0
GOTO 2600
C
C CARRY, NO OBJECT GIVEN YET. OK IF ONLY ONE OBJECT PRESENT.
C
8010 IF(ATLOC(LOC).EQ.0.OR.LINK(ATLOC(LOC)).NE.0)GOTO 8000
DO 8012 I=1,5
IF(DLOC(I).EQ.LOC.AND.DFLAG.GE.2)GOTO 8000
8012 CONTINUE
OBJ=ATLOC(LOC)
C
C CARRY AN OBJECT. SPECIAL CASES FOR BIRD AND CAGE (IF BIRD IN CAGE, CAN'T
C TAKE ONE WITHOUT THE OTHER. LIQUIDS ALSO SPECIAL, SINCE THEY DEPEND ON
C STATUS OF BOTTLE. ALSO VARIOUS SIDE EFFECTS, ETC.
C
9010 IF(TOTING(OBJ))GOTO 2011
SPK=25
IF(OBJ.EQ.PLANT.AND.PROP(PLANT).LE.0)SPK=115
IF(OBJ.EQ.BEAR.AND.PROP(BEAR).EQ.1)SPK=169
IF(OBJ.EQ.CHAIN.AND.PROP(BEAR).NE.0)SPK=170
IF(FIXED(OBJ).NE.0)GOTO 2011
IF(OBJ.NE.WATER.AND.OBJ.NE.OIL)GOTO 9017
IF(HERE(BOTTLE).AND.LIQ(0).EQ.OBJ)GOTO 9018
OBJ=BOTTLE
IF(TOTING(BOTTLE).AND.PROP(BOTTLE).EQ.1)GOTO 9220
IF(PROP(BOTTLE).NE.1)SPK=105
IF(.NOT.TOTING(BOTTLE))SPK=104
GOTO 2011
9018 OBJ=BOTTLE
9017 IF(HOLDNG.LT.7)GOTO 9016
CALL RSPEAK(92)
GOTO 2012
9016 IF(OBJ.NE.BIRD)GOTO 9014
IF(PROP(BIRD).NE.0)GOTO 9014
IF(.NOT.TOTING(ROD))GOTO 9013
CALL RSPEAK(26)
GOTO 2012
9013 IF(TOTING(CAGE))GOTO 9015
CALL RSPEAK(27)
GOTO 2012
9015 PROP(BIRD)=1
9014 IF((OBJ.EQ.BIRD.OR.OBJ.EQ.CAGE).AND.PROP(BIRD).NE.0)
1 CALL CARRY(BIRD+CAGE-OBJ,LOC)
CALL CARRY(OBJ,LOC)
K=LIQ(0)
IF(OBJ.EQ.BOTTLE.AND.K.NE.0)PLACE(K)=-1
IF ((OBJ.EQ.CROWN.OR.OBJ.EQ.RING).AND.PROP(OBJ).EQ.1)
1 PROP(OBJ) = 0
GOTO 2009
C
C DISCARD OBJECT. "THROW" ALSO COMES HERE FOR MOST OBJECTS. SPECIAL CASES FOR
C BIRD (MIGHT ATTACK SNAKE OR DRAGON) AND CAGE (MIGHT CONTAIN BIRD) AND VASE.
C DROP COINS AT VENDING MACHINE FOR EXTRA BATTERIES.
C
9020 IF(TOTING(ROD2).AND.OBJ.EQ.ROD.AND..NOT.TOTING(ROD))OBJ=ROD2
IF(.NOT.TOTING(OBJ) .AND. .NOT.WEARNG(OBJ))GOTO 2011
IF (OBJ.EQ.RING) PROP(TPASS) = 0
IF (OBJ.EQ.STAFF) GOTO 9029
IF(OBJ.NE.BIRD.OR..NOT.HERE(SNAKE))GOTO 9024
CALL RSPEAK(30)
IF(CLOSED)GOTO 19000
CALL DSTROY(SNAKE)
C SET PROP FOR USE BY TRAVEL OPTIONS
PROP(SNAKE)=1
9021 K=LIQ(0)
IF(K.EQ.OBJ)OBJ=BOTTLE
IF(OBJ.EQ.BOTTLE.AND.K.NE.0)PLACE(K)=0
IF(OBJ.EQ.CAGE.AND.PROP(BIRD).NE.0)CALL DROP(BIRD,LOC)
IF(OBJ.EQ.BIRD)PROP(BIRD)=0
CALL DROP(OBJ,LOC)
GOTO 2012
C
9024 IF(OBJ.NE.COINS.OR..NOT.HERE(VEND))GOTO 9025
CALL DSTROY(COINS)
CALL DROP(BATTER,LOC)
CALL PSPEAK(BATTER,0)
GOTO 2012
C
9025 IF(OBJ.NE.BIRD.OR..NOT.AT(DRAGON).OR.PROP(DRAGON).NE.0)GOTO 9026
CALL RSPEAK(154)
CALL DSTROY(BIRD)
PROP(BIRD)=0
IF(PLACE(SNAKE).EQ.PLAC(SNAKE))TALLY2=TALLY2+1
GOTO 2012
C
9026 IF(OBJ.NE.BEAR.OR..NOT.AT(TROLL))GOTO 9027
CALL RSPEAK(163)
CALL MOVE(TROLL,0)
CALL MOVE (TROLL+100,0)
CALL MOVE(TROLL2,PLAC(TROLL))
CALL MOVE(TROLL2+100,FIXD(TROLL))
CALL JUGGLE(CHASM)
PROP(TROLL)=2
GOTO 9021
C
9027 IF(OBJ.EQ.VASE.AND.LOC.NE.PLAC(PILLOW))GOTO 9028
CALL RSPEAK(54)
GOTO 9021
C
9028 PROP(VASE)=2
IF(AT(PILLOW))PROP(VASE)=0
CALL PSPEAK(VASE,PROP(VASE)+1)
IF(PROP(VASE).NE.0)FIXED(VASE)=-1
GOTO 9021
C
9029 CALL DROP (STAFF, 0)
CALL RSPEAK (227)
PROP (STAFF) = 1
GOTO 2012
C
C SAY. ECHO WD2 (OR WD1 IF NO WD2 (SAY WHAT?, ETC.).) MAGIC WORDS OVERRIDE.
C
9030 CALL A5TOA1(WD2,WD2X,'".',TK,K)
IF(WD2.EQ.0)CALL A5TOA1(WD1,WD1X,'".',TK,K)
IF(WD2.NE.0)WD1=WD2
I=VOCAB(WD1,-1)
IF(I.EQ.62.OR.I.EQ.65.OR.I.EQ.71.OR.I.EQ.2025.OR.I.EQ.80)
1 GOTO 9035
TYPE 9032,(TK(I),I=1,K)
9032 FORMAT(/' OKAY, "',20A1)
GOTO 2012
C
9035 WD2=0
OBJ=0
GOTO 2630
C
C LOCK, UNLOCK, NO OBJECT GIVEN. ASSUME VARIOUS THINGS IF PRESENT.
C
8040 SPK=28
IF(HERE(CLAM))OBJ=CLAM
IF(HERE(OYSTER))OBJ=OYSTER
IF(AT(DOOR))OBJ=DOOR
IF(AT(GRATE))OBJ=GRATE
IF(OBJ.NE.0.AND.HERE(CHAIN))GOTO 8000
IF(HERE(CHAIN))OBJ=CHAIN
IF(OBJ.EQ.0)GOTO 2011
C
C LOCK, UNLOCK OBJECT. SPECIAL STUFF FOR OPENING CLAM/OYSTER AND FOR CHAIN.
C
9040 IF(OBJ.EQ.CLAM.OR.OBJ.EQ.OYSTER)GOTO 9046
IF(OBJ.EQ.DOOR)SPK=111
IF(OBJ.EQ.DOOR.AND.PROP(DOOR).EQ.1)SPK=54
IF(OBJ.EQ.CAGE)SPK=32
IF(OBJ.EQ.KEYS)SPK=55
IF(OBJ.EQ.GRATE.OR.OBJ.EQ.CHAIN)SPK=31
IF(SPK.NE.31.OR..NOT.HERE(KEYS))GOTO 2011
IF(OBJ.EQ.CHAIN)GOTO 9048
IF(.NOT.CLOSNG)GOTO 9043
K=130
IF(.NOT.PANIC)CLOCK2=15
PANIC=.TRUE.
GOTO 2010
C
9043 K=34+PROP(GRATE)
PROP(GRATE)=1
IF(VERB.EQ.LOCK)PROP(GRATE)=0
K=K+2*PROP(GRATE)
GOTO 2010
C
C CLAM/OYSTER
9046 K=0
IF(OBJ.EQ.OYSTER)K=1
SPK=124+K
IF(TOTING(OBJ))SPK=120+K
IF(.NOT.TOTING(TRIDNT))SPK=122+K
IF(VERB.EQ.LOCK)SPK=61
IF(SPK.NE.124)GOTO 2011
CALL DSTROY(CLAM)
CALL DROP(OYSTER,LOC)
CALL DROP(PEARL,105)
GOTO 2011
C
C CHAIN.
9048 IF(VERB.EQ.LOCK)GOTO 9049
SPK=171
IF(PROP(BEAR).EQ.0)SPK=41
IF(PROP(CHAIN).EQ.0)SPK=37
IF(SPK.NE.171)GOTO 2011
PROP(CHAIN)=0
FIXED(CHAIN)=0
IF(PROP(BEAR).NE.3)PROP(BEAR)=2
FIXED(BEAR)=2-PROP(BEAR)
GOTO 2011
C
9049 SPK=172
IF(PROP(CHAIN).NE.0)SPK=34
IF(LOC.NE.PLAC(CHAIN))SPK=173
IF(SPK.NE.172)GOTO 2011
PROP(CHAIN)=2
IF(TOTING(CHAIN))CALL DROP(CHAIN,LOC)
FIXED(CHAIN)=-1
GOTO 2011
C
C LIGHT LAMP
C
9070 IF(.NOT.HERE(LAMP))GOTO 2011
SPK=184
IF(LIMIT.LT.0)GOTO 2011
PROP(LAMP)=1
CALL RSPEAK(39)
IF(WZDARK)GOTO 2000
GOTO 2012
C
C EXTINGUISH LAMP
C
9080 IF(.NOT.HERE(LAMP))GOTO 2011
PROP(LAMP)=0
CALL RSPEAK(40)
IF(DARK(0))CALL RSPEAK(16)
GOTO 2012
C
C WAVE. NO EFFECT UNLESS WAVING ROD AT FISSURE.
C OR WAVING STAFF
C
9090 IF (OBJ.EQ.STAFF.AND.TOTING(STAFF)) GOTO 9091
IF((.NOT.TOTING(OBJ)).AND.(OBJ.NE.ROD.OR..NOT.TOTING(ROD2)))
1 SPK=29
IF(OBJ.NE.ROD.OR..NOT.AT(FISSUR).OR..NOT.TOTING(OBJ)
1 .OR.TOTING(STAFF).OR.CLOSNG)GOTO 2011
PROP(FISSUR)=1-PROP(FISSUR)
CALL PSPEAK(FISSUR,2-PROP(FISSUR))
GOTO 2012
9091 CALL RSPEAK (226)
IF (TOTING(LAMP)) PROP(LAMP) = 0
IF (TOTING(LAMP)) CALL DROP(LAMP, 1)
PROP(STAFF) = 1
CALL DROP(STAFF,0)
DO 9093 I = 1, 100
J = 101 - I
IF (.NOT.TOTING(J) .AND. .NOT.WEARNG(J)) GOTO 9094
IF (PLAC(J).NE.0) GOTO 9095
CALL DROP (J,LOC)
GOTO 9094
9095 CALL DROP (J,PLAC(J))
9094 CONTINUE
9093 CONTINUE
GOTO 99
C
C ATTACK. ASSUME TARGET IF UNAMBIGUOUS. "THROW" ALSO LINKS HERE. ATTACKABLE
C OBJECTS FALL INTO TWO CATAGORIES: ENEMIES (SNAKE, DWARF, ETC.) AND OTHERS
C (BIRD, CLAM). AMBIGUOUS IF TWO ENEMIES, OR IF NO ENEMIES BUT TWO OTHERS.
C IF ATTACKING DWARVES WITH A SWORD, SMALL CHANCE TO KILL DWARF, GREATER
C CHANCE TO BREAK SWORD.
C
9120 DO 9121 I=1,10
IF(DLOC(I).EQ.LOC.AND.DFLAG.GE.2)GOTO 9122
9121 CONTINUE
I=0
9122 IF(OBJ.NE.0)GOTO 9124
IF(I.NE.0)OBJ=DWARF
IF(HERE(SNAKE))OBJ=OBJ*100+SNAKE
IF(AT(DRAGON).AND.PROP(DRAGON).EQ.0)OBJ=OBJ*100+DRAGON
IF(AT(TROLL))OBJ=OBJ*100+TROLL
IF(HERE(BEAR).AND.PROP(BEAR).EQ.0)OBJ=OBJ*100+BEAR
IF(OBJ.GT.100)GOTO 8000
IF(OBJ.NE.0)GOTO 9124
C CAN'T ATTACK BIRD BY THROWING AXE.
IF(HERE(BIRD).AND.VERB.NE.THROW)OBJ=BIRD
C CLAM AND OYSTER BOTH TREATED AS OYSTER FOR INTRANSITIVE CASE; NO HARM DONE.
IF(HERE(CLAM).OR.HERE(OYSTER))OBJ=100*OBJ+CLAM
IF(OBJ.GT.100)GOTO 8000
9124 IF(OBJ.NE.BIRD)GOTO 9125
SPK=137
IF(CLOSED)GOTO 2011
CALL DSTROY(BIRD)
PROP(BIRD)=0
IF(PLACE(SNAKE).EQ.PLAC(SNAKE))TALLY2=TALLY2+1
SPK=45
9125 IF(OBJ.EQ.0)SPK=44
IF(OBJ.EQ.CLAM.OR.OBJ.EQ.OYSTER)SPK=150
IF(OBJ.EQ.SNAKE)SPK=46
IF(OBJ.EQ.DWARF)SPK=49
IF(OBJ.EQ.DWARF.AND.CLOSED)GOTO 19000
IF(OBJ.EQ.DRAGON)SPK=167
IF(OBJ.EQ.TROLL)SPK=157
IF(OBJ.EQ.BEAR)SPK=165+(PROP(BEAR)+1)/2
C
C KILL DWARVES IF WE'RE LUCKY, OR POSSIBLY LOSE DAGGER.
C MAYBE BREAK SWORD IF USING THAT AGAINST DWARVES.
IF (OBJ.NE.DWARF.OR..NOT.TOTING(SWORD)) GOTO 9128
SPK = 48
IF (RAN(5).NE.0.OR.SAVED.NE.-1) GOTO 9126
DSEEN(I) = .FALSE.
DLOC(I) = 0
DKILL = DKILL + 1
SPK = 47
IF (DKILL.EQ.1) SPK = 149
9126 CONTINUE
CALL RSPEAK (SPK)
IF (RAN(4).NE.0) GOTO 9127
CALL DROP (SWORD,LOC)
FIXED(SWORD) = -1
PROP(SWORD) = 2
CALL RSPEAK(224)
9127 CONTINUE
K = NULL
GOTO 8
9128 IF(OBJ.NE.DRAGON.OR.PROP(DRAGON).NE.0)GOTO 2011
C FUN STUFF FOR DRAGON. IF HE INSISTS ON ATTACKING IT, HE WINS! SET PROP TO
C DEAD! MOVE DRAGON TO CENTRAL LOC (STILL FIXED), MOVE RUG THERE (NOT FIXED),
C AND MOVE HIM THERE, TOO. THEN DO A NULL MOTION TO GET NEW DESCRIPTION.
CALL RSPEAK(49)
VERB=0
OBJ=0
CALL GETIN(WD1,WD1X,WD2,WD2X)
C IF(WD1.NE.CODE('Y').AND.WD1.NE.CODE('YES'))GOTO 2608
IF(WD1.NE.'Y'.AND.WD1.NE.'YES') GOTO 2608
CALL PSPEAK(DRAGON,1)
PROP(DRAGON)=2
PROP(RUG)=0
K=(PLAC(DRAGON)+FIXD(DRAGON))/2
CALL MOVE(DRAGON+100,-1)
CALL MOVE(RUG+100,0)
CALL MOVE(DRAGON,K)
CALL MOVE(RUG,K)
DO 9129 OBJ=1,100
IF(PLACE(OBJ).EQ.PLAC(DRAGON).OR.PLACE(OBJ).EQ.FIXD(DRAGON))
1 CALL MOVE(OBJ,K)
9129 CONTINUE
LOC=K
K=NULL
GOTO 8
C
C POUR. IF NO OBJECT, OR OBJECT IS BOTTLE, ASSUME CONTENTS OF BOTTLE.
C SPECIAL TESTS FOR POURING WATER OR OIL ON PLANT OR RUSTY DOOR.
C
9130 IF(OBJ.EQ.BOTTLE.OR.OBJ.EQ.0)OBJ=LIQ(0)
IF(OBJ.EQ.0)GOTO 8000
IF(.NOT.TOTING(OBJ))GOTO 2011
SPK=78
IF(OBJ.NE.OIL.AND.OBJ.NE.WATER)GOTO 2011
PROP(BOTTLE)=1
PLACE(OBJ)=0
SPK=77
IF(.NOT.(AT(PLANT).OR.AT(DOOR)))GOTO 2011
C
IF(AT(DOOR))GOTO 9132
SPK=112
IF(OBJ.NE.WATER)GOTO 2011
CALL PSPEAK(PLANT,PROP(PLANT)+1)
PROP(PLANT)=MOD(PROP(PLANT)+2,6)
PROP(PLANT2)=PROP(PLANT)/2
K=NULL
GOTO 8
C
9132 PROP(DOOR)=0
IF(OBJ.EQ.OIL)PROP(DOOR)=1
SPK=113+PROP(DOOR)
GOTO 2011
C
C EAT. INTRANSITIVE: ASSUME FOOD IF PRESENT, ELSE ASK WHAT. TRANSITIVE: FOOD
C OK, SOME THINGS LOSE APPETITE, REST ARE RIDICULOUS.
8140 IF(.NOT.HERE(FOOD))GOTO 8000
8142 CALL DSTROY(FOOD)
SPK=72
GOTO 2011
C
9140 IF(OBJ.EQ.FOOD)GOTO 8142
IF(OBJ.EQ.BIRD.OR.OBJ.EQ.SNAKE.OR.OBJ.EQ.CLAM.OR.OBJ.EQ.OYSTER
1 .OR.OBJ.EQ.DWARF.OR.OBJ.EQ.DRAGON.OR.OBJ.EQ.TROLL
2 .OR.OBJ.EQ.BEAR)SPK=71
GOTO 2011
C
C DRINK. IF NO OBJECT, ASSUME WATER AND LOOK FOR IT HERE. IF WATER IS IN
C THE BOTTLE, DRINK THAT, ELSE MUST BE AT A WATER LOC, SO DRINK STREAM.
C
9150 IF(OBJ.EQ.0.AND.LIQLOC(LOC).NE.WATER.AND.(LIQ(0).NE.WATER
1 .OR..NOT.HERE(BOTTLE)))GOTO 8000
IF(OBJ.NE.0.AND.OBJ.NE.WATER)SPK=110
IF(SPK.EQ.110.OR.LIQ(0).NE.WATER.OR..NOT.HERE(BOTTLE))GOTO 2011
PROP(BOTTLE)=1
PLACE(WATER)=0
SPK=74
GOTO 2011
C
C RUB. YIELDS VARIOUS SNIDE REMARKS.
C
9160 IF (OBJ.EQ.LAMP) SPK = 75
IF (OBJ.EQ.TROLL) SPK = 202
IF (OBJ.EQ.DWARF) SPK = 203
IF (OBJ.EQ.DWARF) DFLAG = DFLAG + 1
IF (OBJ.NE.STAFF) GOTO 9162
IF (TOTING(LAMP)) PROP(LAMP) = 0
IF (TOTING(LAMP)) CALL DROP(LAMP, 1)
CALL RSPEAK (225)
PROP(STAFF) = 1
CALL DROP (STAFF,0)
DO 9164 I = 1, 100
J = 101 - I
IF (.NOT.TOTING(J).AND..NOT.WEARNG(J)) GOTO 9165
IF (PLAC(J).NE.0) GOTO 9166
CALL DROP (J, LOC)
GOTO 9165
9166 CALL DROP (J, PLAC(J))
9165 CONTINUE
9164 CONTINUE
GOTO 99
9162 IF (OBJ.NE.DRAGON) GOTO 2011
C RUBBING THE DRAGON BURNS HIS PINKIES, SO DROP EVERYTHING
SPK = 204
DO 9161 J= 1,100
I = 101 - J
IF (.NOT.TOTING(I)) GOTO 9161
CALL DROP(I,LOC)
9161 CONTINUE
GOTO 2011
C
C THROW. SAME AS DISCARD UNLESS AXE, FOOD, STAFF, DAGGER, OR BEAR.
C THEN SAME AS ATTACK FOR AXE AND DAGGER EXCEPT IGNORE BIRD,
C AND IF DWARF IS PRESENT THEN ONE MIGHT BE KILLED. (ONLY WAY TO DO SO!)
C AXE AND DAGGER ALSO SPECIAL FOR DRAGON, BEAR, AND TROLL.
C TREASURES SPECIAL FOR TROLL.
C BEAR IS JUST A WEE BIT TOO BIG TO THROW
C
9170 IF(TOTING(ROD2).AND.OBJ.EQ.ROD.AND..NOT.TOTING(ROD))OBJ=ROD2
IF(.NOT.TOTING(OBJ))GOTO 2011
IF(OBJ.GE.50.AND.OBJ.LE.MAXTRS.AND.AT(TROLL))GOTO 9178
IF(OBJ.EQ.FOOD.AND.HERE(BEAR))GOTO 9177
IF (OBJ.EQ.BEAR) GOTO 9179
IF ((OBJ.EQ.AXE.OR.OBJ.EQ.DAGGER).AND.HERE(MAGICN)) GOTO 9174
IF(OBJ.NE.AXE.AND.OBJ.NE.DAGGER.AND.DFLAG.GE.2)GOTO 9020
DO 9171 I=1,10
IF(DLOC(I).EQ.LOC)GOTO 9172
9171 CONTINUE
SPK=152
IF (OBJ.EQ.DAGGER) SPK = 228
IF(AT(DRAGON).AND.PROP(DRAGON).EQ.0)GOTO 9175
SPK=158
IF (OBJ.EQ.DAGGER) SPK = 229
IF(AT(TROLL))GOTO 9175
IF(HERE(BEAR).AND.PROP(BEAR).EQ.0)GOTO 9176
OBJ=0
GOTO 9120
C
9172 SPK=48
CALL DROP (OBJ,LOC)
IF (RAN(4).NE.0.OR.OBJ.NE.DAGGER) GOTO 9173
SPK = 231
CALL DSTROY(DAGGER)
GOTO 9175
9173 CONTINUE
C IF SAVED NOT = -1, HE BYPASSED THE "START" CALL.
IF(RAN(3).EQ.0.OR.SAVED.NE.-1)GOTO 9175
DSEEN(I)=.FALSE.
DLOC(I)=0
SPK=47
DKILL=DKILL+1
IF(DKILL.EQ.1)SPK=149
9175 CALL RSPEAK(SPK)
K=NULL
GOTO 8
C
C THIS'LL TEACH HIM TO THROW THE AXE AT THE BEAR!
9176 SPK=164
IF (OBJ.EQ.DAGGER) SPK = 230
CALL DROP(OBJ,LOC)
FIXED(OBJ)=-1
PROP(OBJ)=1
CALL JUGGLE(BEAR)
GOTO 2011
C
C BUT THROWING FOOD IS ANOTHER STORY.
9177 OBJ=BEAR
GOTO 9210
C
9178 SPK=159
C SNARF A TREASURE FOR THE TROLL.
CALL DROP(OBJ,0)
CALL MOVE(TROLL,0)
CALL MOVE(TROLL+100,0)
CALL DROP(TROLL2,PLAC(TROLL))
CALL DROP(TROLL2+100,FIXD(TROLL))
CALL JUGGLE(CHASM)
GOTO 2011
C TRYING TO THROW THE BEAR IS HE?? WE'LL JUST SEE ABOUT THAT!
9179 IF (OBJ.EQ.BEAR) SPK = 205
GOTO 2011
C TRYING TO ELIMINATE MAGIC USER.
9174 SPK = 232
CALL DROP (OBJ, LOC)
IF (OBJ.EQ.AXE) GOTO 91701
SPK = 233
MAGIC1 = 0
PROP(MAGICN) = 1
CALL MOVE (MAGICN,0)
FIXED(STAFF) = 0
PROP(ELVNDR) = 1
91701 MAGIC2 = 5 + MAGIC2
MAGIC1 = 2 + MAGIC1
CALL RSPEAK(SPK)
K = NULL
GOTO 8
C
C QUIT. INTRANSITIVE ONLY. VERIFY INTENT AND EXIT IF THAT'S WHAT HE WANTS.
C
8180 GAVEUP=YES(22,54,54)
8185 IF(GAVEUP)GOTO 20000
GOTO 2012
C
C FIND. MIGHT BE CARRYING IT, OR IT MIGHT BE HERE. ELSE GIVE CAVEAT.
C
9190 IF(AT(OBJ).OR.(LIQ(0).EQ.OBJ.AND.AT(BOTTLE))
1 .OR.K.EQ.LIQLOC(LOC))SPK=94
DO 9192 I=1,5
9192 IF(DLOC(I).EQ.LOC.AND.DFLAG.GE.2.AND.OBJ.EQ.DWARF)SPK=94
IF(CLOSED)SPK=138
IF(TOTING(OBJ))SPK=24
GOTO 2011
C
C INVENTORY. IF OBJECT, TREAT SAME AS FIND. ELSE REPORT ON CURRENT BURDEN.
C
8200 SPK=98
DO 8201 I=1,100
IF(I.EQ.BEAR.OR..NOT.TOTING(I))GOTO 8201
IF(SPK.EQ.98)CALL RSPEAK(99)
BLKLIN=.FALSE.
CALL PSPEAK(I,-1)
BLKLIN=.TRUE.
SPK=0
8201 CONTINUE
SPK = 206
DO 8203 I=1,100
IF (.NOT.WEARNG(I)) GOTO 8203
IF (SPK.EQ.206) CALL RSPEAK(206)
BLKLIN = .FALSE.
CALL PSPEAK(I,-1)
SPK = 0
8203 CONTINUE
BLKLIN = .TRUE.
SPK = 0
IF(TOTING(BEAR))SPK=141
GOTO 2011
C
C FEED. IF BIRD, NO SEED. SNAKE, DRAGON, TROLL: QUIP. IF DWARF, MAKE HIM
C MAD. BEAR, SPECIAL.
C
9210 IF(OBJ.NE.BIRD)GOTO 9212
SPK=100
GOTO 2011
C
9212 IF(OBJ.NE.SNAKE.AND.OBJ.NE.DRAGON.AND.OBJ.NE.TROLL)GOTO 9213
SPK=102
IF(OBJ.EQ.DRAGON.AND.PROP(DRAGON).NE.0)SPK=110
IF(OBJ.EQ.TROLL)SPK=182
IF(OBJ.NE.SNAKE.OR.CLOSED.OR..NOT.HERE(BIRD))GOTO 2011
SPK=101
CALL DSTROY(BIRD)
PROP(BIRD)=0
TALLY2=TALLY2+1
GOTO 2011
C
9213 IF(OBJ.NE.DWARF)GOTO 9214
IF(.NOT.HERE(FOOD))GOTO 2011
SPK=103
DFLAG=DFLAG+1
GOTO 2011
C
9214 IF(OBJ.NE.BEAR)GOTO 9215
IF(PROP(BEAR).EQ.0)SPK=102
IF(PROP(BEAR).EQ.3)SPK=110
IF(.NOT.HERE(FOOD))GOTO 2011
CALL DSTROY(FOOD)
PROP(BEAR)=1
FIXED(AXE)=0
PROP(AXE)=0
FIXED(DAGGER) = 0
PROP(DAGGER) = 0
SPK=168
GOTO 2011
C
9215 SPK=14
GOTO 2011
C
C FILL. BOTTLE MUST BE EMPTY, AND SOME LIQUID AVAILABLE. (VASE IS NASTY.)
C
9220 IF(OBJ.EQ.VASE)GOTO 9222
IF(OBJ.NE.0.AND.OBJ.NE.BOTTLE)GOTO 2011
IF(OBJ.EQ.0.AND..NOT.HERE(BOTTLE))GOTO 8000
SPK=107
IF(LIQLOC(LOC).EQ.0)SPK=106
IF(LIQ(0).NE.0)SPK=105
IF(SPK.NE.107)GOTO 2011
PROP(BOTTLE)=MOD(COND(LOC),4)/2*2
K=LIQ(0)
IF(TOTING(BOTTLE))PLACE(K)=-1
IF(K.EQ.OIL)SPK=108
GOTO 2011
C
9222 SPK=29
IF(LIQLOC(LOC).EQ.0)SPK=144
IF(LIQLOC(LOC).EQ.0.OR..NOT.TOTING(VASE))GOTO 2011
CALL RSPEAK(145)
PROP(VASE)=2
FIXED(VASE)=-1
GOTO 9024
C
C BLAST. NO EFFECT UNLESS YOU'VE GOT DYNAMITE, WHICH IS A NEAT TRICK!
C
9230 IF(PROP(ROD2).LT.0.OR..NOT.CLOSED)GOTO 2011
BONUS=133
IF(LOC.EQ.115)BONUS=134
IF(HERE(ROD2))BONUS=135
CALL RSPEAK(BONUS)
GOTO 20000
C
C SCORE. GO TO SCORING SECTION, WHICH WILL RETURN TO 8241 IF SCORNG IS TRUE
C
8240 SCORNG=.TRUE.
SCORE = SCORES(MXSCOR,CHEST,MAXDIE,SCORNG,BONUS,HNTMAX,MAXTRS)
C
8241 SCORNG=.FALSE.
TYPE 8243,SCORE,MXSCOR
8243 FORMAT(/' IF YOU WERE TO QUIT NOW, YOU WOULD SCORE',I4
1 ,' OUT OF A POSSIBLE',I4,'.')
GAVEUP=YES(143,54,54)
GOTO 8185
C
C FEE FIE FOE FOO (AND FUM). ADVANCE TO NEXT STATE IF GIVEN IN PROPER ORDER.
C LOOK UP WD1 IN SECTION 3 OF VOCAB TO DETERMINE WHICH WORD WE'VE GOT. LAST
C WORD ZIPS THE EGGS BACK TO THE GIANT ROOM (UNLESS ALREADY THERE).
C
8250 K=VOCAB(WD1,3)
SPK=42
IF(FOOBAR.EQ.1-K)GOTO 8252
IF(FOOBAR.NE.0)SPK=151
GOTO 2011
C
8252 FOOBAR=K
IF(K.NE.4)GOTO 2009
8254 FOOBAR=0
IF(PLACE(EGGS).EQ.PLAC(EGGS).OR.TOTING(STAFF)
1 .OR.(TOTING(EGGS).AND.LOC.EQ.PLAC(EGGS)))GOTO 2011
C BRING BACK TROLL IF WE STEAL THE EGGS BACK FROM HIM BEFORE CROSSING.
IF(PLACE(EGGS).EQ.0.AND.PLACE(TROLL).EQ.0.AND.PROP(TROLL).EQ.0)
1 PROP(TROLL)=1
K=2
IF(HERE(EGGS))K=1
IF(LOC.EQ.PLAC(EGGS))K=0
CALL MOVE(EGGS,PLAC(EGGS))
CALL PSPEAK(EGGS,K)
GOTO 2012
C
C BRIEF. INTRANSITIVE ONLY. SUPPRESS LONG DESCRIPTIONS AFTER FIRST TIME.
C
8260 SPK=156
ABBNUM=10000
DETAIL=3
GOTO 2011
C
C READ. MAGAZINES IN DWARVISH, MESSAGE WE'VE SEEN, AND . . . OYSTER?
C
8270 IF(HERE(MAGZIN))OBJ=MAGZIN
IF(HERE(TABLET))OBJ=OBJ*100+TABLET
IF(HERE(MESSAG))OBJ=OBJ*100+MESSAG
IF (HERE(PLAQUE)) OBJ = OBJ*100 + PLAQUE
IF (HERE(MAP)) OBJ = OBJ*100 + MAP
IF (HERE(SIGN)) OBJ = OBJ*100 + SIGN
IF (HERE(ELVNDR).AND.PROP(ELVNDR).EQ.2) OBJ = OBJ*100 + ELVNDR
IF (HERE(BOOK)) OBJ = OBJ*100 + BOOK
IF (HERE(SCHOL).AND.PROP(SCHOL).NE.1) OBJ = OBJ*100 + SCHOL
IF(CLOSED.AND.TOTING(OYSTER))OBJ=OYSTER
IF(OBJ.GT.100.OR.OBJ.EQ.0.OR.DARK(0))GOTO 8000
C
9270 IF(DARK(0))GOTO 5190
IF(OBJ.EQ.MAGZIN)SPK=190
IF(OBJ.EQ.TABLET)SPK=196
IF(OBJ.EQ.MESSAG)SPK=191
IF (OBJ.EQ.PLAQUE) SPK=215
IF (OBJ.EQ.MAP) SPK=222
IF (OBJ.EQ.SIGN) SPK = 245
IF (OBJ.EQ.ELVNDR.AND.PROP(ELVNDR).EQ.2) SPK = 242
IF (OBJ.EQ.SCHOL.AND.PROP(SCHOL).NE.1) SPK = 248
IF (OBJ.EQ.BOOK) GOTO 9271
IF(OBJ.EQ.OYSTER.AND.HINTED(2).AND.TOTING(OYSTER))SPK=194
IF(OBJ.NE.OYSTER.OR.HINTED(2).OR..NOT.TOTING(OYSTER)
1 .OR..NOT.CLOSED)GOTO 2011
HINTED(2)=YES(192,193,54)
GOTO 2012
C
9271 SPK = 241
IF (LOC.EQ.PLAC(EGGS)) GOTO 8254
IF (.NOT.CLOSNG.AND.HERE(ELVNDR).AND..NOT.HERE(MAGICN)) GOTO 9272
IF (AT(DRAGON).AND.PROP(DRAGON).EQ.0) GOTO 9273
IF (HERE(STONE)) SPK = 243
GOTO 2011
9272 PROP(ELVNDR) = 2
SPK = 54
GOTO 2011
9273 PROP(DRAGON) = 2
K = (PLAC(DRAGON) + FIXD(DRAGON)) /2
CALL MOVE (DRAGON+100, -1)
CALL MOVE(RUG+100, 0)
CALL MOVE (DRAGON, 0)
CALL MOVE (RUG, 0)
DO 9274 OBJ = 1, 100
IF (PLACE(OBJ).EQ.PLAC(DRAGON).OR.PLACE(OBJ).EQ.FIXD(DRAGON))
1 CALL MOVE (OBJ, K)
9274 CONTINUE
CALL RSPEAK(244)
LOC = K
K = NULL
GOTO 8
C
C BREAK. ONLY WORKS FOR MIRROR IN REPOSITORY AND, OF COURSE, THE VASE.
C
9280 IF(OBJ.EQ.MIRROR)SPK=148
IF(OBJ.EQ.VASE.AND.PROP(VASE).EQ.0)GOTO 9282
IF(OBJ.NE.MIRROR.OR..NOT.CLOSED)GOTO 2011
CALL RSPEAK(197)
GOTO 19000
C
9282 SPK=198
IF(TOTING(VASE))CALL DROP(VASE,LOC)
PROP(VASE)=2
FIXED(VASE)=-1
GOTO 2011
C WAKE. ONLY USE IS TO DISTURB THE DWARVES.
C
9290 IF(OBJ.NE.DWARF.OR..NOT.CLOSED)GOTO 2011
CALL RSPEAK(199)
GOTO 19000
C
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 CALL STAT3 (IF SEGMENT AROUND) SO WE KNOW THAT THE GAME WAS SUSPENDED
C CALL FILE TO SAVE THE IMPORTANT INFORMATION IN A FILE (AND REDUCE THE
C SIZE FILE A SUSPENDED GAME CREATES).
C UPON RESTARTING, SETUP=-1 CAUSES RETURN TO 8305 TO PICK UP AGAIN.
C
8300 SPK=201
IF(DEMO)GOTO 2011
TYPE 8302,LATNCY
8302 FORMAT(/' I CAN SUSPEND YOUR ADVENTURE FOR YOU SO THAT YOU CAN',
1 ' RESUME LATER, BUT'/' YOU WILL HAVE TO WAIT AT LEAST',
2 I3,' MINUTES BEFORE CONTINUING.')
IF(.NOT.YES(200,54,54))GOTO 2012
CALL DATIME(SAVED,SAVET)
SETUP=-1
IF (SEGOFF.EQ.0) GOTO 8304
SCORNG = .TRUE.
SCORE = SCORES(MXSCOR,CHEST,MAXDIE,SCORNG,BONUS,HNTMAX,MAXTRS)
8303 SCORNG = .FALSE.
C CALL STAT2(SEGOFF,SCORE,TURNS,MXSCOR,NUMDIE,GAVEUP,
C 1 CLOSNG,CLOSED,.FALSE.,ACCT)
C CALL STAT3(SEGOFF,ACCT)
8304 CONTINUE
CALL LOAD('FILE')
CALL CIAO(.TRUE.)
C
8305 YEA=START(0)
SETUP=3
K=NULL
GOTO 8
C
C HOURS. REPORT CURRENT NON-PRIME-TIME HOURS.
C
8310 CALL MSPEAK(6)
CALL HOURS
GOTO 2012
C
C WEARING ROUTINES
C
8320 IF (TOTING(RING)) OBJ = RING
IF (TOTING(CROWN)) OBJ = OBJ*100 + CROWN
IF (OBJ.GT.100.OR.OBJ.EQ.0) GOTO 8000
C
9320 IF (OBJ.NE.RING.AND.OBJ.NE.CROWN) SPK = 208
IF (OBJ.EQ.MITHRL) SPK = 237
IF (WEARNG(OBJ)) SPK = 209
IF (.NOT.TOTING(OBJ).OR.SPK.EQ.208.OR.SPK.EQ.237) GOTO 2011
PLACE(OBJ) = -2
SPK = 54
HOLDNG = HOLDNG - 1
IF (OBJ.EQ.RING) PROP(TPASS) = 1
GOTO 2011
C
C PULL. PULL SWORD OUT OF STONE (IF WEARNG CROWN) OR IF HE PERSISTS
C IN TRYING TO PULL IT OUT WITHOUT THE CROWN SMASH IT.
C
8330 IF (PLACE(SWORD).NE.LOC.OR.PROP(SWORD).NE.1) GOTO 8000
OBJ = SWORD
C
9330 IF (OBJ.NE.SWORD) GOTO 2011
SPK = 211
IF (PROP(SWORD).NE.1) GOTO 2011
IF (WEARNG(CROWN)) GOTO 9335
IF (.NOT.YES(212,213,54)) GOTO 2012
PROP(SWORD) = 2
GOTO 2012
9335 SPK = 92
IF (HOLDNG.GE.7) GOTO 2011
FIXED(SWORD) = 0
CALL CARRY(SWORD,LOC)
PROP(SWORD) = 0
SPK = 214
PROP(STONE) = 1
GOTO 2011
C
C REMOVE. IF NO OBJECT GIVEN AND ONLY WEARING 1 OBJECT THEN ASSUME THAT.
C OTHERWISE ASK WHAT.
C
8340 IF (WEARNG(RING)) OBJ = RING
IF (WEARNG(CROWN)) OBJ = OBJ*100 + CROWN
IF (OBJ.GT.100.OR.OBJ.EQ.0) GOTO 8000
C IF WEARING OBJECT AND HAVE ROOM IN HANDS TO HOLD IT, THEN TAKE IT OFF
9340 IF (.NOT.WEARNG(OBJ)) GOTO 2011
IF (HOLDNG.LT.7) GOTO 9345
SPK=92
GOTO 2011
9345 SPK=54
HOLDNG=HOLDNG+1
PLACE(OBJ) = -1
IF (OBJ.EQ.RING) PROP(TPASS) = 0
GOTO 2011
C
C ON
C
9350 IF (OBJ.EQ.LAMP) GOTO 9070
SPK=ACTSPK(MOD(WEAR,1000))
GOTO 9320
C
C OFF
C
9360 IF (OBJ.EQ.LAMP) GOTO 9080
SPK=ACTSPK(MOD(REMOVE,1000))
GOTO 9340
C
C SWEEP. MUST BE EITHER IN ROOM WITH TRAP DOOR OR WITH SCHOLORSHIP
C WITH PROP SET TO 1
C
8370 SPK = 49
IF (.NOT.TOTING(BROOM)) GOTO 2011
SPK = 246
IF (.NOT.HERE(SCHOL).OR.PROP(SCHOL).NE.1) GOTO 8371
SPK = 238
PROP(SCHOL) = 0
FIXED(SCHOL) = 0
8371 IF (.NOT.HERE(TRAP).OR.PROP(TRAP).NE.0) GOTO 8372
SPK = 239
PROP(TRAP) = 1
8372 GOTO 2011
C
C HINTS
C
C COME HERE IF HE'S BEEN LONG ENOUGH AT REQUIRED LOC(S) FOR SOME UNUSED HINT.
C HINT NUMBER IS IN VARIABLE "HINT". BRANCH TO QUICK TEST FOR ADDITIONAL
C CONDITIONS, THEN COME BACK TO DO NEAT STUFF. GOTO 40010 IF CONDITIONS ARE
C MET AND WE WANT TO OFFER THE HINT. GOTO 40020 TO CLEAR HINTLC BACK TO ZERO,
C 40030 TO TAKE NO ACTION YET.
C
40000 ERA4=HINT-3
GOTO (40400,40500,40600,40700,40800,40900,41000,41100),ERA4
C CAVE BIRD SNAKE MAZE DARK WITT SWORD TPASS
CALL BUG(27)
C
40010 HINTLC(HINT)=0
IF(.NOT.YES(HINTS(HINT,3),0,54))GOTO 2602
TYPE 40012,HINTS(HINT,2)
40012 FORMAT(/' I AM PREPARED TO GIVE YOU A HINT, BUT IT WILL COST YOU',
1 I2,' POINTS.')
HINTED(HINT)=YES(175,HINTS(HINT,4),54)
IF(HINTED(HINT).AND.LIMIT.GT.30)LIMIT=LIMIT+30*HINTS(HINT,2)
40020 HINTLC(HINT)=0
40030 GOTO 2602
C
C NOW FOR THE QUICK TESTS. SEE DATABASE DESCRIPTION FOR ONE-LINE NOTES.
C
40400 IF(PROP(GRATE).EQ.0.AND..NOT.HERE(KEYS))GOTO 40010
GOTO 40020
C
40500 IF(HERE(BIRD).AND.TOTING(ROD).AND.OBJ.EQ.BIRD)GOTO 40010
GOTO 40030
C
40600 IF(HERE(SNAKE).AND..NOT.HERE(BIRD))GOTO 40010
GOTO 40020
C
40700 IF(ATLOC(LOC).EQ.0.AND.ATLOC(OLDLOC).EQ.0
1 .AND.ATLOC(OLDLC2).EQ.0.AND.HOLDNG.GT.1)GOTO 40010
GOTO 40020
C
40800 IF(PROP(EMRALD).NE.-1.AND.PROP(PYRAM).EQ.-1)GOTO 40010
GOTO 40020
C
40900 GOTO 40010
C
41000 IF (.NOT.WEARNG(RING)) GOTO 40010
GOTO 40020
C
41100 IF (PROP(SWORD).EQ.1) GOTO 40010
GOTO 40020
C
C CAVE CLOSING AND SCORING
C
C
C THESE SECTIONS HANDLE THE CLOSING OF THE CAVE. THE CAVE CLOSES "CLOCK1"
C TURNS AFTER THE LAST TREASURE HAS BEEN LOCATED (INCLUDING THE PIRATE'S
C CHEST, WHICH MAY OF COURSE NEVER SHOW UP). NOTE THAT THE TREASURES NEED NOT
C HAVE BEEN TAKEN YET, JUST LOCATED. HENCE CLOCK1 MUST BE LARGE ENOUGH TO GET
C OUT OF THE CAVE (IT ONLY TICKS WHILE INSIDE THE CAVE). WHEN IT HITS ZERO,
C WE BRANCH TO 10000 TO START CLOSING THE CAVE, AND THEN SIT BACK AND WAIT FOR
C HIM TO TRY TO GET OUT. IF HE DOESN'T WITHIN CLOCK2 TURNS, WE CLOSE THE
C CAVE; IF HE DOES TRY, WE ASSUME HE PANICS, AND GIVE HIM A FEW ADDITIONAL
C TURNS TO GET FRANTIC BEFORE WE CLOSE. WHEN CLOCK2 HITS ZERO, WE BRANCH TO
C 11000 TO TRANSPORT HIM INTO THE FINAL PUZZLE. NOTE THAT THE PUZZLE DEPENDS
C UPON ALL SORTS OF RANDOM THINGS. FOR INSTANCE, THERE MUST BE NO WATER OR
C OIL, SINCE THERE ARE BEANSTALKS WHICH WE DON'T WANT TO BE ABLE TO WATER,
C SINCE THE CODE CAN'T HANDLE IT. ALSO, WE CAN HAVE NO KEYS, SINCE THERE IS A
C GRATE (HAVING MOVED THE FIXED OBJECT!) THERE SEPARATING HIM FROM ALL THE
C TREASURES. MOST OF THESE PROBLEMS ARISE FROM THE USE OF NEGATIVE PROP
C NUMBERS TO SUPPRESS THE OBJECT DESCRIPTIONS UNTIL HE'S ACTUALLY MOVED THE
C OBJECTS.
C
C WHEN THE FIRST WARNING COMES, WE LOCK THE GRATE, DESTROY THE BRIDGE, KILL
C ALL THE DWARVES (AND THE PIRATE), REMOVE THE TROLL AND BEAR (UNLESS DEAD),
C AND SET "CLOSNG" TO TRUE. LEAVE THE DRAGON; TOO MUCH TROUBLE TO MOVE IT.
C FROM NOW UNTIL CLOCK2 RUNS OUT, HE CANNOT UNLOCK THE GRATE, MOVE TO ANY
C LOCATION OUTSIDE THE CAVE (LOC<9), OR CREATE THE BRIDGE. NOR CAN HE BE
C RESURRECTED IF HE DIES. NOTE THAT THE SNAKE IS ALREADY GONE, SINCE HE GOT
C TO THE TREASURE ACCESSIBLE ONLY VIA THE HALL OF THE MT. KING. ALSO, HE'S
C BEEN IN THE GIANT ROOM (TO GET EGGS), SO WE CAN REFER TO IT. ALSO ALSO, HE'S
C GOTTEN THE PEARL, SO WE KNOW THE BIVALVE IS AN OYSTER. *AND*, THE DWARVES
C MUST HAVE BEEN ACTIVATED, SINCE WE'VE FOUND CHEST.
C
10000 PROP(GRATE)=0
PROP(FISSUR)=0
DO 10010 I=1,12
DSEEN(I)=.FALSE.
10010 DLOC(I)=0
CALL MOVE(TROLL,0)
CALL MOVE(TROLL+100,0)
CALL MOVE(TROLL2,PLAC(TROLL))
CALL MOVE(TROLL2+100,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)
IF (.NOT.TOTING(STAFF)) GOTO 10020
CALL RSPEAK(236)
CALL DROP(STAFF,0)
GOTO 10030
10020 CALL MOVE(STAFF,0)
10030 CALL MOVE(MAGICN,0)
PROP(STAFF) = 0
PROP(ELVNDR) = 1
CLOCK1=-1
CLOSNG=.TRUE.
GOTO 19999
C
C ONCE HE'S PANICKED, AND CLOCK2 HAS RUN OUT, WE COME HERE TO SET UP THE
C STORAGE ROOM. THE ROOM HAS TWO LOCS, HARDWIRED AS 115 (NE) AND 116 (SW).
C AT THE NE END, WE PLACE EMPTY BOTTLES, A NURSERY OF PLANTS, A BED OF
C OYSTERS, A PILE OF LAMPS, RODS WITH STARS, SLEEPING DWARVES, AND HIM. AND
C THE SW END WE PLACE GRATE OVER TREASURES, SNAKE PIT, COVEY OF CAGED BIRDS,
C MORE RODS, AND PILLOWS. A MIRROR STRETCHES ACROSS ONE WALL. MANY OF THE
C OBJECTS COME FROM KNOWN LOCATIONS AND/OR STATES (E.G. THE SNAKE IS KNOWN TO
C HAVE BEEN DESTROYED AND NEEDN'T BE CARRIED AWAY FROM ITS OLD 'PLACE'),
C MAKING THE VARIOUS OBJECTS BE HANDLED DIFFERENTLY. WE ALSO DROP ALL OTHER
C OBJECTS HE MIGHT BE CARRYING (LEST HE HAVE SOME WHICH COULD CAUSE TROUBLE,
C SUCH AS KEYS). WE DESCRIBE THE FLASH OF LIGHT AND TRUNDLE BACK.
C
11000 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
C LEAVE THE GRATE WITH NORMAL (NON-NEGATIVE PROPERTY).
C
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)
C
PROP(MIRROR)=PUT(MIRROR,115,0)
FIXED(MIRROR)=116
C
DO 11010 I=1,100
11010 IF(TOTING(I))CALL DSTROY(I)
C
CALL RSPEAK(132)
CLOSED=.TRUE.
GOTO 2
C
C ANOTHER WAY WE CAN FORCE AN END TO THINGS IS BY HAVING THE LAMP GIVE OUT.
C WHEN IT GETS CLOSE, WE COME HERE TO WARN HIM. WE GO TO 12000 IF THE LAMP
C AND FRESH BATTERIES ARE HERE, IN WHICH CASE WE REPLACE THE BATTERIES AND
C CONTINUE. 12200 IS FOR OTHER CASES OF LAMP DYING. 12400 IS WHEN IT GOES
C OUT, AND 12600 IS IF HE'S WANDERED OUTSIDE AND THE LAMP IS USED UP, IN WHICH
C CASE WE FORCE HIM TO GIVE UP.
C
12000 CALL RSPEAK(188)
PROP(BATTER)=1
IF(TOTING(BATTER))CALL DROP(BATTER,LOC)
LIMIT=LIMIT+2500
LMWARN=.FALSE.
GOTO 19999
C
12200 IF(LMWARN.OR..NOT.HERE(LAMP))GOTO 19999
LMWARN=.TRUE.
SPK=187
IF(PLACE(BATTER).EQ.0)SPK=183
IF(PROP(BATTER).EQ.1)SPK=189
CALL RSPEAK(SPK)
GOTO 19999
C
12400 LIMIT=-1
PROP(LAMP)=0
IF (HERE(LAMP))CALL RSPEAK(184)
GOTO 19999
C
12600 CALL RSPEAK(185)
GAVEUP=.TRUE.
GOTO 20000
C
C AND, OF COURSE, DEMO GAMES ARE ENDED BY THE WIZARD.
C
13000 CALL MSPEAK(1)
GAVEUP=.TRUE.
GOTO 20000
C
C OH DEAR, HE'S DISTURBED THE DWARVES.
C
19000 CALL RSPEAK(136)
20000 SCORE = SCORES(MXSCOR,CHEST,MAXDIE
1,GAVEUP,BONUS,HNTMAX,MAXTRS)
C THAT SHOULD BE GOOD ENOUGH. LET'S TELL HIM ALL ABOUT IT
C AFTER RECORDING FOR OUR RECORDS
C
C CALL STAT2(SEGOFF,SCORE,TURNS,MXSCOR,NUMDIE,GAVEUP,
C 1 CLOSNG,CLOSED,.TRUE.,ACCT)
TYPE 20100,SCORE,MXSCOR,TURNS
20100 FORMAT(///' YOU SCORED',I4,' OUT OF A POSSIBLE',I4,
1 ', USING',I5,' TURNS.')
C
DO 20200 I=1,CLSSES
IF(CVAL(I).GE.SCORE)GOTO 20210
20200 CONTINUE
TYPE 20202
20202 FORMAT(/' YOU JUST WENT OFF MY SCALE!!'/)
GOTO 25000
C
20210 CALL SPEAK(CTEXT(I))
IF(I.EQ.CLSSES-1)GOTO 20220
K=CVAL(I)+1-SCORE
IF(K.EQ.1)GOTO 20214
TYPE 20212,K
GOTO 20218
20214 TYPE 20216,K
20212 FORMAT(/' TO ACHIEVE THE NEXT HIGHER RATING, YOU NEED',I3,
1 ' MORE POINTS.'/)
20216 FORMAT(/' TO ACHIEVE THE NEXT HIGHER RATING, YOU NEED',I3,
1 ' MORE POINT.'/)
20218 GOTO 25000
C
20220 TYPE 20222
20222 FORMAT(/' TO ACHIEVE THE NEXT HIGHER RATING ',
1 'WOULD BE A NEAT TRICK!'//' CONGRATULATIONS!!'/)
C
25000 STOP
C
C
END
Reference in New Issue View Git Blame Copy Permalink