Source Code 1992 March/Source_Code_CD-ROM_Walnut_Creek_March_1992.iso/usenet/compsrcs/games/new/911231.1

Internet Message Format | 1991-12-30 | 78.0 KB

Path: uunet!wupost!waikato.ac.nz!ccc_simon
From: [e-mail] (Simon Travaglia)
Newsgroups: vmsnet.sources.games
Subject: Adventure Source (The right posting)
Message-ID: <[e-mail]>
Date: 31 Dec 91 09:18:25 +1300
Organization: University of Waikato Computer Centre
Lines: 2797

This is the slightly modified source to adventure as we got it.  The data
file is easier to obtain, so I haven't posted it.  Please be aware that there
is more than one version of Adventure (and adventure data file) around, due
probably to quick ports to various machines...

All credit to Crowther and Woods!

-----------------------------------Axe Here-----------------------------------
C  ADVENTURES

C  CURRENT LIMITS:
C      9650 WORDS OF MESSAGE TEXT (LINES, LINSIZ).
C    750 TRAVEL OPTIONS (TRAVEL, TRVSIZ).
C    300 VOCABULARY WORDS (KTAB, ATAB, TABSIZ).
C    150 LOCATIONS (LTEXT, STEXT, KEY, COND, ABB, ATLOC, LOCSIZ).
C    100 OBJECTS (PLAC, PLACE, FIXD, FIXED, LINK (TWICE), PTEXT, PROP).
C     35 "ACTION" VERBS (ACTSPK, VRBSIZ).
C    205 RANDOM MESSAGES (RTEXT, 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 OF
C  THE DATABASE.  (E.G., THE VOCABULARY USES N/1000 TO DETERMINE WORD TYPE,
C  SO THERE CAN'T BE MORE THAN 1000 WORDS.)  THESE UPPER LIMITS ARE:
C    1000 NON-SYNONYMOUS VOCABULARY WORDS
C    300 LOCATIONS
C    100 OBJECTS
C
C    *****************************************************************
C    * Any comments like this pertain to the modifications made to   *
C    * the source By S Travaglia, Waikato Univerity, 1985-7. Old src    *
C    * won't be deleted in case someone may want to look it up.      *
C    *       [e-mail]                    *
C    *****************************************************************
C
C    *****************************************************************
C    * The call to IMAGE_DIR does a $GETJPI to find the image name.  *
C    * The directory spec is extracted from this and is used in data *
C    * file opens etc.  This way you don't have to have a hardwired  *
C    * directory spec in the program, wherever the .EXE is, put the  *
C    * data file as well.  IMAGE_DIR: is a local logical that xlates *
C    * to the directory the image is being run from            *
C    * Either write this routine, OR, simply take the IMAGE_DIR out  *
C    * of the data file spec                        *
C    *****************************************************************

    IMPLICIT INTEGER(A-Z)
    LOGICAL DSEEN,BLKLIN,HINTED,YES,START
    CHARACTER WD1*10,WD2*10,TEMPC*25
    CHARACTER CLINES*100
    CHARACTER ATAB(300)*5

    COMMON /TXTCOM/ RTEXT,LINES
    COMMON /BLKCOM/ BLKLIN
    COMMON/VOCCOM1/ ATAB
    COMMON/VOCCOM2/KTAB, 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,MAGNM,LATNCY,SAVED,SAVET,SETUP

    DIMENSION LINES(12000)
    DIMENSION TRAVEL(750)
    DIMENSION KTAB(300)
    DIMENSION LTEXT(150),STEXT(150),KEY(150),COND(150),ABB(150),
    1    ATLOC(150)
    DIMENSION PLAC(100),PLACE(100),FIXD(100),FIXED(100),LINK(200),
    1    PTEXT(100),PROP(100)
    DIMENSION ACTSPK(35)
    DIMENSION RTEXT(205)
    DIMENSION CTEXT(12),CVAL(12)
    DIMENSION HINTLC(20),HINTED(20),HINTS(20,4)
    DIMENSION MTEXT(35)
    DIMENSION TK(20),DSEEN(6),DLOC(6),ODLOC(6),HNAME(4)

C
C AVOID MAKING THE COMPILER WORRY ABOUT MODIFYING THE DO INDEX
C
    INTEGER IDONDX
C  STATEMENT FUNCTIONS
C
C
C  TOTING(OBJ)    = TRUE IF THE OBJ IS BEING CARRIED
C  HERE(OBJ)    = TRUE IF THE OBJ IS AT "LOC" (OR IS BEING CARRIED)
C  AT(OBJ)    = TRUE IF ON 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 LOC HE'S LEAVING WAS DARK
C  LMWARN SAYS WHETHER HE'S BEEN WARNED ABOUT 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" COMMAND
C  DEMO IS TRUE IF THIS IS A PRIME-TIME DEMONSTRATION GAME
C  YEA IS RANDOM YES/NO REPLY

    LOGICAL TOTING,HERE,AT,BITSET,DARK,WZDARK,LMWARN,CLOSNG,PANIC,
    1    CLOSED,GAVEUP,SCORNG,DEMO,YEA
    EXTERNAL RAN

    TOTING(OBJ)=PLACE(OBJ).EQ.-1
    HERE(OBJ)=PLACE(OBJ).EQ.LOC.OR.TOTING(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)))
    LIQLOC(LOC)=LIQ2((MOD(COND(LOC)/2*2,8)-5)*MOD(COND(LOC)/4,2)+1)
    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.OR.
    1    .NOT.HERE(LAMP))
    PCT(N)=RAN(100).LT.N
C
    DATA LINSIZ/12000/,TRVSIZ/750/,TABSIZ/300/,LOCSIZ/150/,
    1  VRBSIZ/35/,RTXSIZ/205/,CLSMAX/12/,HNTSIZ/20/,MAGSIZ/35/
    DATA SETUP/0/,BLKLIN/.TRUE./

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  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 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  SECTION 4: 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 3).  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  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 CURRENTLY 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    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 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-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  * Comment out the call to image_dir if not using it *
    CALL Image_Dir

    IF(SETUP.NE.0)GOTO 1100
    TYPE 1000
1000    FORMAT(' Please wait while we obtain entry to the cave...')


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.

    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
    STEXT(I)=0
    LTEXT(I)=0
    COND(I)=0
1001    CONTINUE

c    * Remember to take out image_dir if you're not using it *

    OPEN(UNIT=1,NAME='Image_Dir:Adventure.Dat',READONLY,TYPE='OLD')
    SETUP=1
    LINUSE=1
    TRVS=1
    CLSSES=1

C  START NEW DATA SECTION.  SECT IS THE SECTION NUMBER.

1002    READ(1,*) SECT
    OLDLOC=-1
    GOTO(1100,1004,1004,1030,1040,1004,1004,1050,1060,1070,1004,
    1    1080,1004) (SECT+1)
C          (0)  (1)  (2)  (3)  (4)  (5)  (6)  (7)  (8)  (9)  (10)
C         (11) (12)
    CALL BUG(9)

C  SECTIONS 1, 2, 5, 6, 10, 12.  READ MESSAGES AND SET UP POINTERS.

1004    READ(1,1005) CLINES(1:80)
1005    FORMAT(80A)
    CLINES(80:80)=' '
    LOC=INTG(CLINES(1:6))
    IT=LINUSE+1
D    PRINT *,CLINES
    CALL XFR(CLINES(9:80),LINES,IT)
    IF(LOC.EQ.-1)GOTO 1002
    DO 1006 K=1,18
    KK=LINUSE+19-K
    IF(LINES(KK).NE.' ')GOTO 1007
1006    CONTINUE
1007    LINES(LINUSE)=KK+1
    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

    STEXT(LOC)=LINUSE
    GOTO 1020

1008    LTEXT(LOC)=LINUSE
    GOTO 1020

1010    IF(LOC.GT.0.AND.LOC.LE.100)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=KK+1
    LINES(LINUSE)=-1
    OLDLOC=LOC
    IF(LINUSE+17.GT.LINSIZ)CALL BUG(2)
    GOTO 1004


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.

1030    DO 1031 I=1,20
1031    TK(I)=0
    NEWLOC=0
    LOC=0
    READ(1,*)LOC,NEWLOC,TK
    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(TK(L).EQ.0)GOTO 1039
    TRAVEL(TRVS)=NEWLOC*1000+TK(L)
    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 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.

1040    DO 1042 TABNDX=1,TABSIZ
1043    READ(1,1041) TEMPC(1:8),ATAB(TABNDX)
1041    FORMAT(8A,5A)
    KTAB(TABNDX)=INTG(TEMPC(1:8))
    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.

1050    OBJ=0
    J=0
    K=0
    READ(1,*)OBJ,J,K
    IF(OBJ.EQ.-1)GOTO 1002
    PLAC(OBJ)=J
    FIXD(OBJ)=K
    GOTO 1050

C  READ DEFAULT MESSAGE NUMBERS FOR ACTION VERBS, STORE IN ACTSPK.

1060    READ(1,*)VERB,J
    IF(VERB.EQ.-1)GOTO 1002
    ACTSPK(VERB)=J
    GOTO 1060

C  READ INFO ABOUT AVAILABLE LIQUIDS AND OTHER CONDITIONS, STORE IN COND.

1070    DO 1072 I=1,20
1072    TK(I)=0
    K=0
    READ(1,*)K,TK
    IF(K.EQ.-1)GOTO 1002
    DO 1071 I=1,20
    LOC=TK(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  READ DATA FOR HINTS.

1080    HNTMAX=0
1081    DO 1084 I=1,20
1084    TK(I)=0
    K=0
    READ(1,*)K,TK
    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  FINISH CONSTRUCTING INTERNAL DATA FORMAT

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.

1100    IF(SETUP.EQ.2)GOTO 1
    IF(SETUP.EQ.-1)GOTO 8305


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 PRINTED.  COUNTS MOD 5 UNLESS "LOOK" IS USED.

    DO 1101 I=1,100
    PLACE(I)=0
    PROP(I)=0
    LINK(I)=0
1101    LINK(I+100)=0

    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  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 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

    DO 1107 I=1,100
    K=101-I
    FIXED(K)=FIXD(K)
1107    IF(PLAC(K).NE.0.AND.FIXD(K).LE.0)CALL DROP(K,PLAC(K))


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).

    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  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  DEFINE SOME HANDY MNEMONICS.  THESE CORRESPOND TO OBJECT NUMBERS.

    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('PILLO',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)

C  OBJECTS FROM 50 THROUGH WHATEVER ARE TREASURES.  HERE ARE A FEW.

    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)

C  THESE ARE MOTION-VERB NUMBERS.

    BACK=VOCAB('BACK',0)
    LOOK=VOCAB('LOOK',0)
    CAVE=VOCAB('CAVE',0)
    NULL=VOCAB('NULL',0)
    ENTRNC=VOCAB('ENTRA',0)
    DPRSSN=VOCAB('DEPRE',0)

C  AND SOME ACTION VERBS.

    SAY=VOCAB('SAY',2)
    LOCK=VOCAB('LOCK',2)
    THROW=VOCAB('THROW',2)
    FIND=VOCAB('FIND',2)
    INVENT=VOCAB('INVEN',2)

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,6
1700    DSEEN(I)=.FALSE.
    DFLAG=0
    DLOC(1)=19
    DLOC(2)=27
    DLOC(3)=33
    DLOC(4)=44
    DLOC(5)=64
    DLOC(6)=CHLOC
    DALTLC=18

C  OTHER RANDOM FLAGS AND COUNTERS, AS FOLLOWS:
C    TURNS    TALLIES HOW MANY COMMANDS HE'S GIVEN (IGNORES YES/NO)
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 PRINT 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    LOGICALS WERE EXPLAINED EARLIER

    TURNS=0
    LMWARN=.FALSE.
    IWEST=0
    KNFLOC=0
    DETAIL=0
    ABBNUM=5
    DO 1800 I=0,4
1800    IF(RTEXT(2*I+81).NE.0)MAXDIE=I+1
    NUMDIE=0
    HOLDNG=0
    DKILL=0
    FOOBAR=0
    BONUS=0
    CLOCK1=30
    CLOCK2=50
    SAVED=-1
    CLOSNG=.FALSE.
    PANIC=.FALSE.
    CLOSED=.FALSE.
    GAVEUP=.FALSE.
    SCORNG=.FALSE.

C  IF SETUP=1, REPORT ON AMOUNT OF ARRAYS ACTUALLY USED, TO PERMIT REDUCTIONS.

    IF(SETUP.NE.1)GOTO 1
    SETUP=2

    DO 1998 K=1,LOCSIZ
    KK=LOCSIZ+1-K
    IF(LTEXT(KK).NE.0)GOTO 1997
1998    CONTINUE

    OBJ=0
1997    DO 1996 K=1,100
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    K=100
C    TYPE 1999,LINUSE,LINSIZ,TRVS,TRVSIZ,TABNDX,TABSIZ,KK
C    1    ,LOCSIZ,OBJ,K,VERB,VRBSIZ,J,RTXSIZ,CLSSES,CLSMAX
C    2    ,HNTMAX,HNTSIZ,I,MAGSIZ
C1999    FORMAT (' Table space used:'/
C    1    ' ',I6,' OF ',I6,' words of messages'/
C    2    ' ',I6,' OF ',I6,' travel options'/
C    3    ' ',I6,' OF ',I6,' vocabulary words'/
C    4    ' ',I6,' OF ',I6,' locations'/
C    5    ' ',I6,' OF ',I6,' objects'/
C    6    ' ',I6,' OF ',I6,' action verbs'/
C    7    ' ',I6,' OF ',I6,' RTEXT messages'/
C    8    ' ',I6,' OF ',I6,' CLASS messages'/
C    9    ' ',I6,' OF ',I6,' hints'/
C    1    ' ',I6,' OF ',I6,' MAGIC messages'/
C    2    )

C  FINALLY, SINCE WE'RE CLEARLY SETTING THINGS UP FOR THE FIRST TIME...

    CALL POOF
C    TYPE *,'INIT DONE'

C  START-UP, DWARF STUFF

1    I=RAN(1)
    HINTED(3)=YES(65,1,0)
    NEWLOC=1
    SETUP=3
    LIMIT=1000
    IF(HINTED(3))LIMIT=1000
CP    CALL MAXTIM(9999999)

C  CAN'T LEAVE CAVE ONCE IT'S CLOSING (EXCEPT BY MAIN OFFICE).

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  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.OR.FORCED(LOC).OR.BITSET(LOC,3))GOTO 74
    DO 73 I=1,5
    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.BITSET(NEWLOC,3))GOTO 2000
    IF(DFLAG.NE.0)GOTO 6000
    IF(LOC.GE.15)DFLAG=1
    GOTO 2000

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.

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,5
    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 <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.

6010    DTOTAL=0
    ATTACK=0
    STICK=0
    DO 6030 I=1,6
    IF(DLOC(I).EQ.0)GOTO 6030
    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.6)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=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
    IDONDX=J
    IF(TOTING(IDONDX))GOTO 6022
6020    IF(HERE(IDONDX))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

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
    IDONDX=J
    IF(AT(IDONDX).AND.FIXED(IDONDX).EQ.0)
    1 CALL CARRY(IDONDX,LOC)
    IF(TOTING(IDONDX))CALL DROP(IDONDX,CHLOC)
6023    CONTINUE
6024    DLOC(6)=CHLOC
    ODLOC(6)=CHLOC
    DSEEN(6)=.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
    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    *** 99 You are Dead...

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 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  PRINT OUT DESCRIPTIONS OF OBJECTS AT THIS LOCATION.  IF NOT CLOSING AND
C  PROPERTY VALUE IS NEGATIVE, TALLY OFF ANOTHER TREASURE.  RUG IS SPECIAL
C  CASE; ONCE SEEN, ITS PROP IS 1 (DRAGON ON IT) TILL DRAGON IS KILLED.
C  SIMILARLY FOR CHAIN; PROP IS INITIALLY 1 (LOCKED TO BEAR).  THESE HACKS
C  ARE BECAUSE PROP=0 IS NEEDED TO GET FULL SCORE.

    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)PROP(OBJ)=1
    TALLY=TALLY-1
C  IF REMAINING TREASURES TOO ELUSIVE, ZAP HIS LAMP.
    IF(TALLY.EQ.TALLY2.AND.TALLY.NE.0)LIMIT=MIN0(35,LIMIT)
2006    KK=PROP(OBJ)
    IF(OBJ.EQ.STEPS.AND.LOC.EQ.FIXED(STEPS))KK=1
    CALL PSPEAK(OBJ,KK)
2008    I=LINK(I)
    GOTO 2004

2009    K=54
2010    SPK=K
2011    CALL RSPEAK(SPK)

2012    VERB=0
    OBJ=0

C  CHECK IF THIS LOC IS ELIGIBLE FOR ANY HINTS.  IF BEEN HERE LONG ENOUGH,
C  BRANCH TO HELP SECTION (ON LATER PAGE).  HINTS ALL COME BACK HERE EVENTUALLY
C  TO FINISH THE LOOP.  IGNORE "HINTS" < 4 (SPECIAL STUFF, SEE DATABASE NOTES).

2600    DO 2602 HINT=4,HNTMAX
    IF(HINTED(HINT))GOTO 2602
    IDONDX=HINT
    IF(.NOT.BITSET(LOC,IDONDX))HINTLC(HINT)=-1
    HINTLC(HINT)=HINTLC(HINT)+1
    IF(HINTLC(HINT).GE.HINTS(HINT,1))GOTO 40000
2602    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,100
    IDONDX=I
2604    IF(TOTING(IDONDX).AND.PROP(IDONDX).LT.0)
    1 PROP(IDONDX)=-1-PROP(IDONDX)
2605    WZDARK=DARK(0)
    IF(KNFLOC.GT.0.AND.KNFLOC.NE.LOC)KNFLOC=0
    I=RAN(1)
2607    CALL GETIN(Wd1, Wd2 )
    IF(ichar(wd1(1:1)) .eq. 0) goto 2607

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)

    TURNS=TURNS+1
C    IF(DEMO.AND.TURNS.GE.SHORT)GOTO 13000
    IF(VERB.EQ.SAY.AND.WD2.NE.' ')VERB=0
    IF(VERB.EQ.SAY)GOTO 4090
    IF(TALLY.EQ.0.AND.LOC.GE.15.AND.LOC.NE.33)CLOCK1=CLOCK1-1
    IF(CLOCK1.EQ.0)GOTO 10000
    IF(CLOCK1.LT.0)CLOCK2=CLOCK2-1
    IF(CLOCK2.EQ.0)GOTO 11000
    IF(PROP(LAMP).EQ.1)LIMIT=LIMIT-1
    IF(LIMIT.LE.30.AND.HERE(BATTER).AND.PROP(BATTER).EQ.0
    1    .AND.HERE(LAMP))GOTO 12000
    IF(LIMIT.EQ.0)GOTO 12400
    IF(LIMIT.LT.0.AND.LOC.LE.8)GOTO 12600
    IF(LIMIT.LE.30)GOTO 12200
19999    K=43
    IF(LIQLOC(LOC).EQ.WATER)K=70
    IF(WD1.EQ.'ENTER'.AND.(WD2.EQ.'STREA'.OR.WD2.EQ.'WATER'))
    1    GOTO 2010
    IF(WD1.EQ.'ENTER'.AND.WD2.NE.' ')GOTO 2800
    IF((WD1.NE.'WATER'.AND.WD1.NE.'OIL')
    1    .OR.(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  GET SECOND WORD FOR ANALYSIS.

2800    WD1=WD2
    WD2=' '
    GOTO 2610

C  GEE, I DON'T UNDERSTAND.

3000    SPK=60
    IF(PCT(20))SPK=61
    IF(PCT(20))SPK=13
    CALL RSPEAK(SPK)
    GOTO 2600

C  ANALYSE A VERB.  REMEMBER WHAT IT WAS, GO BACK FOR OBJECT IF SECOND WORD
C  UNLESS VERB IS "SAY", WHICH SNARFS ARBITRARY SECOND WORD.

4000    VERB=K
    SPK=ACTSPK(VERB)
    IF(WD2.NE.' '.AND.VERB.NE.SAY)GOTO 2800
    IF(VERB.EQ.SAY)OBJ=VOCAB(WD2,-1)
    IF(OBJ.NE.0)GOTO 4090

C  ANALYSE AN INTRANSITIVE VERB (IE, NO OBJECT GIVEN YET).

4080    GOTO(8010,8000,8000,8040,2009,8040,9070,9080,8000,8000,
    1    2011,9120,9130,8140,9150,8000,8000,8180,8000,8200,
    2    8000,9220,9230,8240,8250,8260,8270,8000,8000,8300,
    3    8310)VERB
C         TAKE DROP  SAY OPEN NOTH LOCK   ON  OFF WAVE CALM
C         WALK KILL POUR  EAT DRNK  RUB TOSS QUIT FIND INVN
C         FEED FILL BLST SCOR  FOO  BRF READ BREK WAKE SUSP
C         HOUR
    CALL BUG(23)

C  ANALYSE A TRANSITIVE VERB.

4090    GOTO(9010,9020,9030,9040,2009,9040,9070,9080,9090,2011,
    1    2011,9120,9130,9140,9150,9160,9170,2011,9190,9190,
    2    9210,9220,9230,2011,2011,2011,9270,9280,9290,2011,
    3    2011)VERB
C         TAKE DROP  SAY OPEN NOTH LOCK   ON  OFF WAVE CALM
C         WALK KILL POUR  EAT DRNK  RUB TOSS QUIT FIND INVN
C         FEED FILL BLST SCOR  FOO  BRF READ BREK WAKE SUSP
C         HOUR
    CALL BUG(24)

C  ANALYSE AN OBJECT WORD.  SEE IF THE THING IS HERE, WHETHER WE'VE GOT A VERB
C  YET, AND SO ON.  OBJECT MUST BE HERE UNLESS VERB IS "FIND" OR "INVENT(ORY)"
C  (AND NO NEW VERB YET TO BE ANALYSED).  WATER AND OIL ARE ALSO FUNNY, SINCE
C  THEY ARE NEVER ACTUALLY DROPPED AT ANY LOCATION, BUT MIGHT BE HERE INSIDE
C  THE BOTTLE OR AS A FEATURE OF THE LOCATION.

5000    OBJ=K
    IF(FIXED(K).NE.LOC.AND..NOT.HERE(K))GOTO 5100
5010    IF(WD2.NE.' ')GOTO 2800
    IF(VERB.NE.0)GOTO 4090
    CALL A5TOA1(WD1,'?',TK,K)
    TYPE 5015,(TK(I),I=1,K)
5015    FORMAT(/' What do you want to do with the ',20A1)
    GOTO 2600

5100    IF(K.NE.GRATE)GOTO 5110
    IF(LOC.EQ.1.OR.LOC.EQ.4.OR.LOC.EQ.7)K=DPRSSN
    IF(LOC.GT.9.AND.LOC.LT.15)K=ENTRNC
    IF(K.NE.GRATE)GOTO 8
5110    IF(K.NE.DWARF)GOTO 5120
    DO 5112 I=1,5
    IF(DLOC(I).EQ.LOC.AND.DFLAG.GE.2)GOTO 5010
5112    CONTINUE
5120    IF((LIQ(0).EQ.K.AND.HERE(BOTTLE)).OR.K.EQ.LIQLOC(LOC))GOTO 5010
    IF(OBJ.NE.PLANT.OR..NOT.AT(PLANT2).OR.PROP(PLANT2).EQ.0)GOTO 5130
    OBJ=PLANT2
    GOTO 5010
5130    IF(OBJ.NE.KNIFE.OR.KNFLOC.NE.LOC)GOTO 5140
    KNFLOC=-1
    SPK=116
    GOTO 2011
5140    IF(OBJ.NE.ROD.OR..NOT.HERE(ROD2))GOTO 5190
    OBJ=ROD2
    GOTO 5010
5190    IF((VERB.EQ.FIND.OR.VERB.EQ.INVENT).AND.WD2.EQ.' ')GOTO 5010
    CALL A5TOA1(WD1,'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.)

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

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

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)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

13    IF(NEWLOC.LE.100)GOTO 14
    IF(TOTING(K).OR.(NEWLOC.GT.200.AND.AT(K)))GOTO 16
    GOTO 12

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  SPECIAL MOTIONS COME HERE.  LABELLING CONVENTION: STATEMENT NUMBERS NNNXX
C  (XX=00-99) ARE USED FOR SPECIAL CASE NUMBER NNN (NNN=301-500).

30000    NEWLOC=NEWLOC-300
    GOTO (30100,30200,30300)NEWLOC
    CALL BUG(20)

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".

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  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.

30200    CALL DROP(EMRALD,LOC)
    GOTO 12

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.

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

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  END OF SPECIALS.

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.

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

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

23    KK=K2
    IF(KK.NE.0)GOTO 25
    CALL RSPEAK(140)
    GOTO 2

25    K=MOD(IABS(TRAVEL(KK)),1000)
    KK=KEY(LOC)
    GOTO 9

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.

30    IF(DETAIL.LT.3)CALL RSPEAK(15)
    DETAIL=DETAIL+1
    WZDARK=.FALSE.
    ABB(LOC)=0
    GOTO 2

C  CAVE.  DIFFERENT MESSAGES DEPENDING ON WHETHER ABOVE GROUND.

40    IF(LOC.LT.8)CALL RSPEAK(57)
    IF(LOC.GE.8)CALL RSPEAK(58)
    GOTO 2

C  NON-APPLICABLE MOTION.  VARIOUS MESSAGES DEPENDING ON WORD GIVEN.

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  THE EASIEST WAY TO GET KILLED IS TO FALL INTO A PIT IN PITCH DARKNESS.

90    CALL RSPEAK(23)
    OLDLC2=LOC

C  OKAY, HE'S DEAD.  LET'S GET ON WITH IT.

99    IF(CLOSNG)GOTO 95
    YEA=YES(81+NUMDIE*2,82+NUMDIE*2,54)
    NUMDIE=NUMDIE+1
    IF(NUMDIE.EQ.MAXDIE.OR..NOT.YEA)GOTO 20000
    PLACE(WATER)=0
    PLACE(OIL)=0
    IF(TOTING(LAMP))PROP(LAMP)=0
    DO 98 J=1,100
    I=101-J
    IF(.NOT.TOTING(I))GOTO 98
    K=OLDLC2
    IF(I.EQ.LAMP)K=1
    CALL DROP(I,K)
98    CONTINUE
    LOC=3
    OLDLOC=LOC
    GOTO 2000

C  HE DIED DURING CLOSING TIME.  NO RESURRECTION.  TALLY UP A DEATH AND EXIT.

95    CALL RSPEAK(131)
    NUMDIE=+1
    GOTO 20000

C  ROUTINES FOR PERFORMING THE VARIOUS ACTION VERBS

C  STATEMENT NUMBERS IN THIS SECTION ARE 8000 FOR INTRANSITIVE VERBS, 9000 FOR
C  TRANSITIVE, PLUS TEN TIMES THE VERB NUMBER.  MANY INTRANSITIVE VERBS USE THE
C  TRANSITIVE CODE, AND SOME VERBS USE CODE FOR OTHER VERBS, AS NOTED BELOW.

C  RANDOM INTRANSITIVE VERBS COME HERE.  CLEAR OBJ JUST IN CASE (SEE "ATTACK").

8000    CALL A5TOA1(WD1,'What?',TK,K)
    TYPE 8002,(TK(I),I=1,K)
8002    FORMAT(/' ',20A1)
    OBJ=0
    GOTO 2600

C  CARRY, NO OBJECT GIVEN YET.  OK IF ONLY ONE OBJECT PRESENT.

8010    IF(ATLOC(LOC).EQ.0.OR.LINK(ATLOC(LOC)).NE.0)GOTO 8000
    DO 8012 I=1,5
    IF(DLOC(I).EQ.LOC.AND.DFLAG.GE.2)GOTO 8000
8012    CONTINUE
    OBJ=ATLOC(LOC)

C  CARRY AN OBJECT.  SPECIAL CASES FOR BIRD AND CAGE (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.

9010    IF(TOTING(OBJ))GOTO 2011
    SPK=25
    IF(OBJ.EQ.PLANT.AND.PROP(PLANT).LE.0)SPK=115
    IF(OBJ.EQ.BEAR.AND.PROP(BEAR).EQ.1)SPK=169
    IF(OBJ.EQ.CHAIN.AND.PROP(BEAR).NE.0)SPK=170
    IF(FIXED(OBJ).NE.0)GOTO 2011
    IF(OBJ.NE.WATER.AND.OBJ.NE.OIL)GOTO 9017
    IF(HERE(BOTTLE).AND.LIQ(0).EQ.OBJ)GOTO 9018
    OBJ=BOTTLE
    IF(TOTING(BOTTLE).AND.PROP(BOTTLE).EQ.1)GOTO 9220
    IF(PROP(BOTTLE).NE.1)SPK=105
    IF(.NOT.TOTING(BOTTLE))SPK=104
    GOTO 2011
9018    OBJ=BOTTLE
9017    IF(HOLDNG.LT.7)GOTO 9016
    CALL RSPEAK(92)
    GOTO 2012
9016    IF(OBJ.NE.BIRD)GOTO 9014
    IF(PROP(BIRD).NE.0)GOTO 9014
    IF(.NOT.TOTING(ROD))GOTO 9013
    CALL RSPEAK(26)
    GOTO 2012
9013    IF(TOTING(CAGE))GOTO 9015
    CALL RSPEAK(27)
    GOTO 2012
9015    PROP(BIRD)=1
9014    IF((OBJ.EQ.BIRD.OR.OBJ.EQ.CAGE).AND.PROP(BIRD).NE.0)
    1    CALL CARRY(BIRD+CAGE-OBJ,LOC)
    CALL CARRY(OBJ,LOC)
    K=LIQ(0)
    IF(OBJ.EQ.BOTTLE.AND.K.NE.0)PLACE(K)=-1
    GOTO 2009

C  DISCARD OBJECT.  "THROW" ALSO COMES HERE FOR MOST OBJECTS.  SPECIAL CASES FOR
C  BIRD (MIGHT ATTACK SNAKE OR DRAGON) AND CAGE (MIGHT CONTAIN BIRD) AND VASE.
C  DROP COINS AT VENDING MACHINE FOR EXTRA BATTERIES.

9020    IF(TOTING(ROD2).AND.OBJ.EQ.ROD.AND..NOT.TOTING(ROD))OBJ=ROD2
    IF(.NOT.TOTING(OBJ))GOTO 2011
    IF(OBJ.NE.BIRD.OR..NOT.HERE(SNAKE))GOTO 9024
    CALL RSPEAK(30)
    IF(CLOSED)GOTO 19000
    CALL DSTROY(SNAKE)
C  SET PROP FOR USE BY TRAVEL OPTIONS
    PROP(SNAKE)=1
9021    K=LIQ(0)
    IF(K.EQ.OBJ)OBJ=BOTTLE
    IF(OBJ.EQ.BOTTLE.AND.K.NE.0)PLACE(K)=0
    IF(OBJ.EQ.CAGE.AND.PROP(BIRD).NE.0)CALL DROP(BIRD,LOC)
    IF(OBJ.EQ.BIRD)PROP(BIRD)=0
    CALL DROP(OBJ,LOC)
    GOTO 2012

9024    IF(OBJ.NE.COINS.OR..NOT.HERE(VEND))GOTO 9025
    CALL DSTROY(COINS)
    CALL DROP(BATTER,LOC)
    CALL PSPEAK(BATTER,0)
    GOTO 2012

9025    IF(OBJ.NE.BIRD.OR..NOT.AT(DRAGON).OR.PROP(DRAGON).NE.0)GOTO 9026
    CALL RSPEAK(154)
    CALL DSTROY(BIRD)
    PROP(BIRD)=0
    IF(PLACE(SNAKE).EQ.PLAC(SNAKE))TALLY2=TALLY2+1
    GOTO 2012

9026    IF(OBJ.NE.BEAR.OR..NOT.AT(TROLL))GOTO 9027
    CALL RSPEAK(163)
    CALL MOVE(TROLL,0)
    CALL MOVE(TROLL+100,0)
    CALL MOVE(TROLL2,PLAC(TROLL))
    CALL MOVE(TROLL2+100,FIXD(TROLL))
    CALL JUGGLE(CHASM)
    PROP(TROLL)=2
    GOTO 9021

9027    IF(OBJ.EQ.VASE.AND.LOC.NE.PLAC(PILLOW))GOTO 9028
    CALL RSPEAK(54)
    GOTO 9021

9028    PROP(VASE)=2
    IF(AT(PILLOW))PROP(VASE)=0
    CALL PSPEAK(VASE,PROP(VASE)+1)
    IF(PROP(VASE).NE.0)FIXED(VASE)=-1
    GOTO 9021

C  SAY.  ECHO WD2 (OR WD1 IF NO WD2 (SAY WHAT?, ETC.).)  MAGIC WORDS OVERRIDE.

9030    CALL A5TOA1(WD2,'".',TK,K)
    IF(WD2.EQ.' ')CALL A5TOA1(WD1,'".',TK,K)
    IF(WD2.NE.' ')WD1=WD2
    I=VOCAB(WD1,-1)
    IF(I.EQ.62.OR.I.EQ.65.OR.I.EQ.71.OR.I.EQ.2025)GOTO 9035
    TYPE 9032,(TK(I),I=1,K)
9032    FORMAT(/' Okay, "',20A1)
    GOTO 2012

9035    WD2=' '
    OBJ=0
    GOTO 2630

C  LOCK, UNLOCK, NO OBJECT GIVEN.  ASSUME VARIOUS THINGS IF PRESENT.

8040    SPK=28
    IF(HERE(CLAM))OBJ=CLAM
    IF(HERE(OYSTER))OBJ=OYSTER
    IF(AT(DOOR))OBJ=DOOR
    IF(AT(GRATE))OBJ=GRATE
    IF(OBJ.NE.0.AND.HERE(CHAIN))GOTO 8000
    IF(HERE(CHAIN))OBJ=CHAIN
    IF(OBJ.EQ.0)GOTO 2011

C  LOCK, UNLOCK OBJECT.  SPECIAL STUFF FOR OPENING CLAM/OYSTER AND FOR CHAIN.

9040    IF(OBJ.EQ.CLAM.OR.OBJ.EQ.OYSTER)GOTO 9046
    IF(OBJ.EQ.DOOR)SPK=111
    IF(OBJ.EQ.DOOR.AND.PROP(DOOR).EQ.1)SPK=54
    IF(OBJ.EQ.CAGE)SPK=32
    IF(OBJ.EQ.KEYS)SPK=55
    IF(OBJ.EQ.GRATE.OR.OBJ.EQ.CHAIN)SPK=31
    IF(SPK.NE.31.OR..NOT.HERE(KEYS))GOTO 2011
    IF(OBJ.EQ.CHAIN)GOTO 9048
    IF(.NOT.CLOSNG)GOTO 9043
    K=130
    IF(.NOT.PANIC)CLOCK2=15
    PANIC=.TRUE.
    GOTO 2010

9043    K=34+PROP(GRATE)
    PROP(GRATE)=1
    IF(VERB.EQ.LOCK)PROP(GRATE)=0
    K=K+2*PROP(GRATE)
    GOTO 2010

C  CLAM/OYSTER.
9046    K=0
    IF(OBJ.EQ.OYSTER)K=1
    SPK=124+K
    IF(TOTING(OBJ))SPK=120+K
    IF(.NOT.TOTING(TRIDNT))SPK=122+K
    IF(VERB.EQ.LOCK)SPK=61
    IF(SPK.NE.124)GOTO 2011
    CALL DSTROY(CLAM)
    CALL DROP(OYSTER,LOC)
    CALL DROP(PEARL,105)
    GOTO 2011

C  CHAIN.
9048    IF(VERB.EQ.LOCK)GOTO 9049
    SPK=171
    IF(PROP(BEAR).EQ.0)SPK=41
    IF(PROP(CHAIN).EQ.0)SPK=37
    IF(SPK.NE.171)GOTO 2011
    PROP(CHAIN)=0
    FIXED(CHAIN)=0
    IF(PROP(BEAR).NE.3)PROP(BEAR)=2
    FIXED(BEAR)=2-PROP(BEAR)
    GOTO 2011

9049    SPK=172
    IF(PROP(CHAIN).NE.0)SPK=34
    IF(LOC.NE.PLAC(CHAIN))SPK=173
    IF(SPK.NE.172)GOTO 2011
    PROP(CHAIN)=2
    IF(TOTING(CHAIN))CALL DROP(CHAIN,LOC)
    FIXED(CHAIN)=-1
    GOTO 2011

C  LIGHT LAMP

9070    IF(.NOT.HERE(LAMP))GOTO 2011
    SPK=184
    IF(LIMIT.LT.0)GOTO 2011
    PROP(LAMP)=1
    CALL RSPEAK(39)
    IF(WZDARK)GOTO 2000
    GOTO 2012

C  LAMP OFF

9080    IF(.NOT.HERE(LAMP))GOTO 2011
    PROP(LAMP)=0
    CALL RSPEAK(40)
    IF(DARK(0))CALL RSPEAK(16)
    GOTO 2012

C  WAVE.  NO EFFECT UNLESS WAVING ROD AT FISSURE.

9090    IF((.NOT.TOTING(OBJ)).AND.(OBJ.NE.ROD.OR..NOT.TOTING(ROD2)))
    1    SPK=29
    IF(OBJ.NE.ROD.OR..NOT.AT(FISSUR).OR..NOT.TOTING(OBJ)
    1    .OR.CLOSNG)GOTO 2011
    PROP(FISSUR)=1-PROP(FISSUR)
    CALL PSPEAK(FISSUR,2-PROP(FISSUR))
    GOTO 2012

C  ATTACK.  ASSUME TARGET IF UNAMBIGUOUS.  "THROW" ALSO LINKS HERE.  ATTACKABLE
C  OBJECTS FALL INTO TWO CATEGORIES: ENEMIES (SNAKE, DWARF, ETC.)  AND OTHERS
C  (BIRD, CLAM).  AMBIGUOUS IF TWO ENEMIES, OR IF NO ENEMIES BUT TWO OTHERS.

9120    DO 9121 I=1,5
    IF(DLOC(I).EQ.LOC.AND.DFLAG.GE.2)GOTO 9122
9121    CONTINUE
    I=0
9122    IF(OBJ.NE.0)GOTO 9124
    IF(I.NE.0)OBJ=DWARF
    IF(HERE(SNAKE))OBJ=OBJ*100+SNAKE
    IF(AT(DRAGON).AND.PROP(DRAGON).EQ.0)OBJ=OBJ*100+DRAGON
    IF(AT(TROLL))OBJ=OBJ*100+TROLL
    IF(HERE(BEAR).AND.PROP(BEAR).EQ.0)OBJ=OBJ*100+BEAR
    IF(OBJ.GT.100)GOTO 8000
    IF(OBJ.NE.0)GOTO 9124
C  CAN'T ATTACK BIRD BY THROWING AXE.
    IF(HERE(BIRD).AND.VERB.NE.THROW)OBJ=BIRD
C  CLAM AND OYSTER BOTH TREATED AS CLAM FOR INTRANSITIVE CASE; NO HARM DONE.
    IF(HERE(CLAM).OR.HERE(OYSTER))OBJ=100*OBJ+CLAM
    IF(OBJ.GT.100)GOTO 8000
9124    IF(OBJ.NE.BIRD)GOTO 9125
    SPK=137
    IF(CLOSED)GOTO 2011
    CALL DSTROY(BIRD)
    PROP(BIRD)=0
    IF(PLACE(SNAKE).EQ.PLAC(SNAKE))TALLY2=TALLY2+1
    SPK=45
9125    IF(OBJ.EQ.0)SPK=44
    IF(OBJ.EQ.CLAM.OR.OBJ.EQ.OYSTER)SPK=150
    IF(OBJ.EQ.SNAKE)SPK=46
    IF(OBJ.EQ.DWARF)SPK=49
    IF(OBJ.EQ.DWARF.AND.CLOSED)GOTO 19000
    IF(OBJ.EQ.DRAGON)SPK=167
    IF(OBJ.EQ.TROLL)SPK=157
    IF(OBJ.EQ.BEAR)SPK=165+(PROP(BEAR)+1)/2
    IF(OBJ.NE.DRAGON.OR.PROP(DRAGON).NE.0)GOTO 2011
C  FUN STUFF FOR DRAGON.  IF HE INSISTS 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.
    CALL RSPEAK(49)
    VERB=0
    OBJ=0
    CALL GETIN( WD1,WD2)
    IF(WD1.NE.'Y'.AND.WD1.NE.'YES')GOTO 2608
    CALL PSPEAK(DRAGON,1)
    PROP(DRAGON)=2
    PROP(RUG)=0
    K=(PLAC(DRAGON)+FIXD(DRAGON))/2
    CALL MOVE(DRAGON+100,-1)
    CALL MOVE(RUG+100,0)
    CALL MOVE(DRAGON,K)
    CALL MOVE(RUG,K)
    DO 9126 OBJ=1,100
    IDONDX=OBJ
    IF(PLACE(IDONDX).EQ.PLAC(DRAGON).OR.
    1 PLACE(IDONDX).EQ.FIXD(DRAGON))
    2 CALL MOVE(IDONDX,K)
9126    CONTINUE
    LOC=K
    K=NULL
    GOTO 8

C  POUR.  IF NO OBJECT, OR OBJECT IS BOTTLE, ASSUME CONTENTS OF BOTTLE.
C  SPECIAL TESTS FOR POURING WATER OR OIL ON PLANT OR RUSTY DOOR.

9130    IF(OBJ.EQ.BOTTLE.OR.OBJ.EQ.0)OBJ=LIQ(0)
    IF(OBJ.EQ.0)GOTO 8000
    IF(.NOT.TOTING(OBJ))GOTO 2011
    SPK=78
    IF(OBJ.NE.OIL.AND.OBJ.NE.WATER)GOTO 2011
    PROP(BOTTLE)=1
    PLACE(OBJ)=0
    SPK=77
    IF(.NOT.(AT(PLANT).OR.AT(DOOR)))GOTO 2011

    IF(AT(DOOR))GOTO 9132
    SPK=112
    IF(OBJ.NE.WATER)GOTO 2011
    CALL PSPEAK(PLANT,PROP(PLANT)+1)
    PROP(PLANT)=MOD(PROP(PLANT)+2,6)
    PROP(PLANT2)=PROP(PLANT)/2
    K=NULL
    GOTO 8

9132    PROP(DOOR)=0
    IF(OBJ.EQ.OIL)PROP(DOOR)=1
    SPK=113+PROP(DOOR)
    GOTO 2011

C  EAT.  INTRANSITIVE: ASSUME FOOD IF PRESENT, ELSE ASK WHAT.  TRANSITIVE: FOOD
C  OK, SOME THINGS LOSE APPETITE, REST ARE RIDICULOUS.

8140    IF(.NOT.HERE(FOOD))GOTO 8000
8142    CALL DSTROY(FOOD)
    SPK=72
    GOTO 2011

9140    IF(OBJ.EQ.FOOD)GOTO 8142
    IF(OBJ.EQ.BIRD.OR.OBJ.EQ.SNAKE.OR.OBJ.EQ.CLAM.OR.OBJ.EQ.OYSTER
    1    .OR.OBJ.EQ.DWARF.OR.OBJ.EQ.DRAGON.OR.OBJ.EQ.TROLL
    2    .OR.OBJ.EQ.BEAR)SPK=71
    GOTO 2011

C  DRINK.  IF NO OBJECT, ASSUME WATER AND LOOK FOR IT HERE.  IF WATER IS IN
C  THE BOTTLE, DRINK THAT, ELSE MUST BE AT A WATER LOC, SO DRINK STREAM.

9150    IF(OBJ.EQ.0.AND.LIQLOC(LOC).NE.WATER.AND.(LIQ(0).NE.WATER
    1    .OR..NOT.HERE(BOTTLE)))GOTO 8000
    IF(OBJ.NE.0.AND.OBJ.NE.WATER)SPK=110
    IF(SPK.EQ.110.OR.LIQ(0).NE.WATER.OR..NOT.HERE(BOTTLE))GOTO 2011
    PROP(BOTTLE)=1
    PLACE(WATER)=0
    SPK=74
    GOTO 2011

C  RUB.  YIELDS VARIOUS SNIDE REMARKS.

9160    IF(OBJ.NE.LAMP)SPK=76
    GOTO 2011

C  THROW.  SAME AS DISCARD UNLESS AXE.  THEN SAME AS ATTACK EXCEPT IGNORE BIRD,
C  AND IF DWARF IS PRESENT THEN ONE MIGHT BE KILLED.  (ONLY WAY TO DO SO!)
C  AXE ALSO SPECIAL FOR DRAGON, BEAR, AND TROLL.  TREASURES SPECIAL FOR TROLL.

9170    IF(TOTING(ROD2).AND.OBJ.EQ.ROD.AND..NOT.TOTING(ROD))OBJ=ROD2
    IF(.NOT.TOTING(OBJ))GOTO 2011
    IF(OBJ.GE.50.AND.OBJ.LE.MAXTRS.AND.AT(TROLL))GOTO 9178
    IF(OBJ.EQ.FOOD.AND.HERE(BEAR))GOTO 9177
    IF(OBJ.NE.AXE)GOTO 9020
    DO 9171 I=1,5
C  NEEDN'T CHECK DFLAG IF AXE IS HERE.
    IF(DLOC(I).EQ.LOC)GOTO 9172
9171    CONTINUE
    SPK=152
    IF(AT(DRAGON).AND.PROP(DRAGON).EQ.0)GOTO 9175
    SPK=158
    IF(AT(TROLL))GOTO 9175
    IF(HERE(BEAR).AND.PROP(BEAR).EQ.0)GOTO 9176
    OBJ=0
    GOTO 9120

9172    SPK=48
C  IF SAVED NOT = -1, HE BYPASSED THE "START" CALL.
    IF(RAN(3).EQ.0.OR.SAVED.NE.-1)GOTO 9175
    DSEEN(I)=.FALSE.
    DLOC(I)=0
    SPK=47
    DKILL=DKILL+1
    IF(DKILL.EQ.1)SPK=149
9175    CALL RSPEAK(SPK)
    CALL DROP(AXE,LOC)
    K=NULL
    GOTO 8

C  THIS'LL TEACH HIM TO THROW THE AXE AT THE BEAR!
9176    SPK=164
    CALL DROP(AXE,LOC)
    FIXED(AXE)=-1
    PROP(AXE)=1
    CALL JUGGLE(BEAR)
    GOTO 2011

C  BUT THROWING FOOD IS ANOTHER STORY.
9177    OBJ=BEAR
    GOTO 9210

9178    SPK=159
C  SNARF A TREASURE FOR THE TROLL.
    CALL DROP(OBJ,0)
    CALL MOVE(TROLL,0)
    CALL MOVE(TROLL+100,0)
    CALL DROP(TROLL2,PLAC(TROLL))
    CALL DROP(TROLL2+100,FIXD(TROLL))
    CALL JUGGLE(CHASM)
    GOTO 2011

C  QUIT.  INTRANSITIVE ONLY.  VERIFY INTENT AND EXIT IF THAT'S WHAT HE WANTS.

8180    GAVEUP=YES(22,54,54)
8185    IF(GAVEUP)GOTO 20000
    GOTO 2012

C  FIND.  MIGHT BE CARRYING IT, OR IT MIGHT BE HERE.  ELSE GIVE CAVEAT.

9190    IF(AT(OBJ).OR.(LIQ(0).EQ.OBJ.AND.AT(BOTTLE))
    1    .OR.K.EQ.LIQLOC(LOC))SPK=94
    DO 9192 I=1,5
9192    IF(DLOC(I).EQ.LOC.AND.DFLAG.GE.2.AND.OBJ.EQ.DWARF)SPK=94
    IF(CLOSED)SPK=138
    IF(TOTING(OBJ))SPK=24
    GOTO 2011

C  INVENTORY.  IF OBJECT, TREAT SAME AS FIND.  ELSE REPORT ON CURRENT BURDEN.

8200    SPK=98
    DO 8201 I=1,100
    IDONDX=I
    IF(IDONDX.EQ.BEAR.OR..NOT.TOTING(IDONDX))GOTO 8201
    IF(SPK.EQ.98)CALL RSPEAK(99)
    BLKLIN=.FALSE.
    CALL PSPEAK(IDONDX,-1)
    BLKLIN=.TRUE.
    SPK=0
8201    CONTINUE
    IF(TOTING(BEAR))SPK=141
    GOTO 2011

C  FEED.  IF BIRD, NO SEED.  SNAKE, DRAGON, TROLL: QUIP.  IF DWARF, MAKE HIM
C  MAD.  BEAR, SPECIAL.

9210    IF(OBJ.NE.BIRD)GOTO 9212
    SPK=100
    GOTO 2011

9212    IF(OBJ.NE.SNAKE.AND.OBJ.NE.DRAGON.AND.OBJ.NE.TROLL)GOTO 9213
    SPK=102
    IF(OBJ.EQ.DRAGON.AND.PROP(DRAGON).NE.0)SPK=110
    IF(OBJ.EQ.TROLL)SPK=182
    IF(OBJ.NE.SNAKE.OR.CLOSED.OR..NOT.HERE(BIRD))GOTO 2011
    SPK=101
    CALL DSTROY(BIRD)
    PROP(BIRD)=0
    TALLY2=TALLY2+1
    GOTO 2011

9213    IF(OBJ.NE.DWARF)GOTO 9214
    IF(.NOT.HERE(FOOD))GOTO 2011
    SPK=103
    DFLAG=DFLAG+1
    GOTO 2011

9214    IF(OBJ.NE.BEAR)GOTO 9215
    IF(PROP(BEAR).EQ.0)SPK=102
    IF(PROP(BEAR).EQ.3)SPK=110
    IF(.NOT.HERE(FOOD))GOTO 2011
    CALL DSTROY(FOOD)
    PROP(BEAR)=1
    FIXED(AXE)=0
    PROP(AXE)=0
    SPK=168
    GOTO 2011

9215    SPK=14
    GOTO 2011

C  FILL.  BOTTLE MUST BE EMPTY, AND SOME LIQUID AVAILABLE.  (VASE IS NASTY.)

9220    IF(OBJ.EQ.VASE)GOTO 9222
    IF(OBJ.NE.0.AND.OBJ.NE.BOTTLE)GOTO 2011
    IF(OBJ.EQ.0.AND..NOT.HERE(BOTTLE))GOTO 8000
    SPK=107
    IF(LIQLOC(LOC).EQ.0)SPK=106
    IF(LIQ(0).NE.0)SPK=105
    IF(SPK.NE.107)GOTO 2011
    PROP(BOTTLE)=MOD(COND(LOC),4)/2*2
    K=LIQ(0)
    IF(TOTING(BOTTLE))PLACE(K)=-1
    IF(K.EQ.OIL)SPK=108
    GOTO 2011

9222    SPK=29
    IF(LIQLOC(LOC).EQ.0)SPK=144
    IF(LIQLOC(LOC).EQ.0.OR..NOT.TOTING(VASE))GOTO 2011
    CALL RSPEAK(145)
    PROP(VASE)=2
    FIXED(VASE)=-1
    GOTO 9024

C  BLAST.  NO EFFECT UNLESS YOU'VE GOT DYNAMITE, WHICH IS A NEAT TRICK!

9230    IF(PROP(ROD2).LT.0.OR..NOT.CLOSED)GOTO 2011
    BONUS=133
    IF(LOC.EQ.115)BONUS=134
    IF(HERE(ROD2))BONUS=135
    CALL RSPEAK(BONUS)
    GOTO 20000

C  SCORE.  GO TO SCORING SECTION, WHICH WILL RETURN TO 8241 IF SCORNG IS TRUE.

8240    SCORNG=.TRUE.
    GOTO 20000

8241    SCORNG=.FALSE.
    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  FEE FIE FOE FOO (AND FUM).  ADVANCE TO NEXT STATE IF GIVEN IN PROPER ORDER.
C  LOOK UP WD1 IN SECTION 3 OF VOCAB TO DETERMINE WHICH WORD WE'VE GOT.  LAST
C  WORD ZIPS THE EGGS BACK TO THE GIANT ROOM (UNLESS ALREADY THERE).

8250    K=VOCAB(WD1,3)
    SPK=42
    IF(FOOBAR.EQ.1-K)GOTO 8252
    IF(FOOBAR.NE.0)SPK=151
    GOTO 2011

8252    FOOBAR=K
    IF(K.NE.4)GOTO 2009
    FOOBAR=0
    IF(PLACE(EGGS).EQ.PLAC(EGGS)
    1    .OR.(TOTING(EGGS).AND.LOC.EQ.PLAC(EGGS)))GOTO 2011
C  BRING BACK TROLL IF WE STEAL THE EGGS BACK FROM HIM BEFORE CROSSING.
    IF(PLACE(EGGS).EQ.0.AND.PLACE(TROLL).EQ.0.AND.PROP(TROLL).EQ.0)
    1    PROP(TROLL)=1
    K=2
    IF(HERE(EGGS))K=1
    IF(LOC.EQ.PLAC(EGGS))K=0
    CALL MOVE(EGGS,PLAC(EGGS))
    CALL PSPEAK(EGGS,K)
    GOTO 2012

C  BRIEF.  INTRANSITIVE ONLY.  SUPPRESS LONG DESCRIPTIONS AFTER FIRST TIME.

8260    SPK=156
    ABBNUM=10000
    DETAIL=3
    GOTO 2011

C  READ.  MAGAZINES IN DWARVISH, MESSAGE WE'VE SEEN, AND . . . OYSTER?

8270    IF(HERE(MAGZIN))OBJ=MAGZIN
    IF(HERE(TABLET))OBJ=OBJ*100+TABLET
    IF(HERE(MESSAG))OBJ=OBJ*100+MESSAG
    IF(CLOSED.AND.TOTING(OYSTER))OBJ=OYSTER
    IF(OBJ.GT.100.OR.OBJ.EQ.0.OR.DARK(0))GOTO 8000

9270    IF(DARK(0))GOTO 5190
    IF(OBJ.EQ.MAGZIN)SPK=190
    IF(OBJ.EQ.TABLET)SPK=196
    IF(OBJ.EQ.MESSAG)SPK=191
    IF(OBJ.EQ.OYSTER.AND.HINTED(2).AND.TOTING(OYSTER))SPK=194
    IF(OBJ.NE.OYSTER.OR.HINTED(2).OR..NOT.TOTING(OYSTER)
    1    .OR..NOT.CLOSED)GOTO 2011
    HINTED(2)=YES(192,193,54)
    GOTO 2012

C  BREAK.  ONLY WORKS FOR MIRROR IN REPOSITORY AND, OF COURSE, THE VASE.

9280    IF(OBJ.EQ.MIRROR)SPK=148
    IF(OBJ.EQ.VASE.AND.PROP(VASE).EQ.0)GOTO 9282
    IF(OBJ.NE.MIRROR.OR..NOT.CLOSED)GOTO 2011
    CALL RSPEAK(197)
    GOTO 19000

9282    SPK=198
    IF(TOTING(VASE))CALL DROP(VASE,LOC)
    PROP(VASE)=2
    FIXED(VASE)=-1
    GOTO 2011

C  WAKE.  ONLY USE IS TO DISTURB THE DWARVES.

9290    IF(OBJ.NE.DWARF.OR..NOT.CLOSED)GOTO 2011
    CALL RSPEAK(199)
    GOTO 19000

C  SUSPEND.  OFFER TO EXIT LEAVING THINGS RESTARTABLE, BUT REQUIRING A DELAY
C  BEFORE RESTARTING (SO CAN'T SAVE THE WORLD BEFORE TRYING SOMETHING RISKY).
C  UPON RESTARTING, SETUP=-1 CAUSES RETURN TO 8305 TO PICK UP AGAIN.

8300    SPK=201
    IF(DEMO)GOTO 2011
    TYPE 8302
8302    FORMAT(/'  The Wizard and his assistants would like to apologise',
    1    ' for any inconvience'/' caused by the absence of a save',
    2    ' routine.')
    GOTO 2012

C    ******************************************************************
C    FORMAT(/' I can suspend your adventure for you so that you can',
C    1    ' resume later, but'/' you will have to wait at least',
C    2    I3,' minutes before continuing.')
C    IF(.NOT.YES(200,54,54))GOTO 2012
C    CALL DATIME(SAVED,SAVET)
C    SETUP=-1
C    CALL CIAO
C    ******************************************************************

C    *******************************************************************
C     * CIAO was removed because it is not possible for the VAX to save *
C    * core images.                                                    *
C    *******************************************************************

8305    SETUP=3
    K=NULL
    GOTO 8

C  HOURS.  REPORT CURRENT NON-PRIME-TIME HOURS.

8310    CALL MSPEAK(6)
8311    FORMAT( 'The wizard has declared the game eternally open.')
    TYPE 8311
    GOTO 2012

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 (40400,40500,40600,40700,40800,40900)(HINT-3)
C          CAVE  BIRD  SNAKE MAZE  DARK  WITT
    CALL BUG(27)

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  NOW FOR THE QUICK TESTS.  SEE DATABASE DESCRIPTION FOR ONE-LINE NOTES.

40400    IF(PROP(GRATE).EQ.0.AND..NOT.HERE(KEYS))GOTO 40010
    GOTO 40020

40500    IF(HERE(BIRD).AND.TOTING(ROD).AND.OBJ.EQ.BIRD)GOTO 40010
    GOTO 40030

40600    IF(HERE(SNAKE).AND..NOT.HERE(BIRD))GOTO 40010
    GOTO 40020

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

40800    IF(PROP(EMRALD).NE.-1.AND.PROP(PYRAM).EQ.-1)GOTO 40010
    GOTO 40020

40900    GOTO 40010

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 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  WHEN THE FIRST WARNING COMES, WE LOCK THE GRATE, DESTROY THE BRIDGE, KILL
C  ALL THE DWARVES (AND THE PIRATE), REMOVE THE TROLL AND BEAR (UNLESS DEAD),
C  AND SET "CLOSNG" TO TRUE.  LEAVE THE DRAGON; TOO MUCH TROUBLE TO MOVE IT.
C  FROM NOW UNTIL CLOCK2 RUNS OUT, HE CANNOT UNLOCK THE GRATE, MOVE TO ANY
C  LOCATION OUTSIDE THE CAVE (LOC<9), OR CREATE THE BRIDGE.  NOR CAN HE BE
C  RESURRECTED IF HE DIES.  NOTE THAT THE SNAKE IS ALREADY GONE, SINCE HE GOT
C  TO THE TREASURE ACCESSIBLE ONLY VIA THE HALL OF THE MT. KING.  ALSO, HE'S
C  BEEN IN GIANT ROOM (TO GET EGGS), SO WE CAN REFER TO IT.  ALSO ALSO, HE'S
C  GOTTEN THE PEARL, SO WE KNOW THE BIVALVE IS AN OYSTER.  *AND*, THE DWARVES
C  MUST HAVE BEEN ACTIVATED, SINCE WE'VE FOUND CHEST.

10000    PROP(GRATE)=0
    PROP(FISSUR)=0
    DO 10010 I=1,6
    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)
    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, AND HIM.  AND
C  THE SW END WE PLACE GRATE OVER TREASURES, SNAKE PIT, COVEY OF CAGED BIRDS,
C  MORE RODS, AND PILLOWS.  A MIRROR STRETCHES ACROSS ONE WALL.  MANY OF THE
C  OBJECTS COME FROM KNOWN LOCATIONS AND/OR STATES (E.G. THE SNAKE IS KNOWN TO
C  HAVE BEEN DESTROYED AND NEEDN'T BE CARRIED AWAY FROM ITS OLD "PLACE"),
C  MAKING THE VARIOUS OBJECTS BE HANDLED DIFFERENTLY.  WE ALSO DROP ALL OTHER
C  OBJECTS HE MIGHT BE CARRYING (LEST HE HAVE SOME WHICH COULD CAUSE TROUBLE,
C  SUCH AS THE KEYS).  WE DESCRIBE THE FLASH OF LIGHT AND TRUNDLE BACK.

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  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(MIRROR)=PUT(MIRROR,115,0)
    FIXED(MIRROR)=116

    DO 11010 I=1,100
    IDONDX=I
11010    IF(TOTING(IDONDX))CALL DSTROY(IDONDX)

    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.  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.

12000    CALL RSPEAK(188)
    PROP(BATTER)=1
    IF(TOTING(BATTER))CALL DROP(BATTER,LOC)
    LIMIT=LIMIT+2500
    LMWARN=.FALSE.
    GOTO 19999

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

12400    LIMIT=-1
    PROP(LAMP)=0
    IF(HERE(LAMP))CALL RSPEAK(184)
    GOTO 19999

12600    CALL RSPEAK(185)
    GAVEUP=.TRUE.
    GOTO 20000

C  AND, OF COURSE, DEMO GAMES ARE ENDED BY THE WIZARD.

13000    CALL MSPEAK(1)
    GOTO 20000

C  OH DEAR, HE'S DISTURBED THE DWARVES.

19000    CALL RSPEAK(136)

C  EXIT CODE.  WILL EVENTUALLY INCLUDE SCORING.  FOR NOW, HOWEVER, ...

C  THE PRESENT SCORING ALGORITHM IS AS FOLLOWS:
C     OBJECTIVE:          POINTS:        PRESENT TOTAL POSSIBLE:
C  GETTING WELL INTO CAVE   25                    25
C  EACH TREASURE < CHEST    12                    60
C  TREASURE CHEST ITSELF    14                    14
C  EACH TREASURE > CHEST    16                   144
C  SURVIVING             (MAX-NUM)*10             30
C  NOT QUITTING              4                     4
C  REACHING "CLOSNG"        25                    25
C  "CLOSED": QUIT/KILLED    10
C            KLUTZED        25
C            WRONG WAY      30
C            SUCCESS        45                    45
C  CAME TO WITT'S END        1                     1
C  ROUND OUT THE TOTAL       2                     2
C                                       TOTAL:   350
C  (POINTS CAN ALSO BE DEDUCTED FOR USING HINTS.)

20000    SCORE=0
    MXSCOR=0

C  FIRST TALLY UP THE TREASURES.  MUST BE IN BUILDING AND NOT BROKEN.
C  GIVE THE POOR GUY 2 POINTS JUST FOR FINDING EACH TREASURE.

    DO 20010 I=50,MAXTRS
    IF(PTEXT(I).EQ.0)GOTO 20010
    K=12
    IF(I.EQ.CHEST)K=14
    IF(I.GT.CHEST)K=16
    IF(PROP(I).GE.0)SCORE=SCORE+2
    IF(PLACE(I).EQ.3.AND.PROP(I).EQ.0)SCORE=SCORE+K-2
    MXSCOR=MXSCOR+K
20010    CONTINUE

C  NOW LOOK AT HOW HE FINISHED AND HOW FAR HE GOT.  MAXDIE AND NUMDIE TELL US
C  HOW WELL HE SURVIVED.  GAVEUP SAYS WHETHER HE EXITED VIA QUIT.  DFLAG WILL
C  TELL US IF HE EVER GOT SUITABLY DEEP INTO THE CAVE.  CLOSNG STILL INDICATES
C  WHETHER HE REACHED THE ENDGAME.  AND IF HE GOT AS FAR AS "CAVE CLOSED"
C  (INDICATED BY "CLOSED"), THEN BONUS IS ZERO FOR MUNDANE EXITS OR 133, 134,
C  135 IF HE BLEW IT (SO TO SPEAK).

    SCORE=SCORE+(MAXDIE-NUMDIE)*10
    MXSCOR=MXSCOR+MAXDIE*10
    IF(.NOT.(SCORNG.OR.GAVEUP))SCORE=SCORE+4
    MXSCOR=MXSCOR+4
    IF(DFLAG.NE.0)SCORE=SCORE+25
    MXSCOR=MXSCOR+25
    IF(CLOSNG)SCORE=SCORE+25
    MXSCOR=MXSCOR+25
    IF(.NOT.CLOSED)GOTO 20020
    IF(BONUS.EQ.0)SCORE=SCORE+10
    IF(BONUS.EQ.135)SCORE=SCORE+25
    IF(BONUS.EQ.134)SCORE=SCORE+30
    IF(BONUS.EQ.133)SCORE=SCORE+45
20020    MXSCOR=MXSCOR+45

C  DID HE COME TO WITT'S END AS HE SHOULD?

    IF(PLACE(MAGZIN).EQ.108)SCORE=SCORE+1
    MXSCOR=MXSCOR+1

C  ROUND IT OFF.

    SCORE=SCORE+2
    MXSCOR=MXSCOR+2

C  DEDUCT POINTS FOR HINTS.  HINTS < 4 ARE SPECIAL; SEE DATABASE DESCRIPTION.

    DO 20030 I=1,HNTMAX
20030    IF(HINTED(I))SCORE=SCORE-HINTS(I,2)

C  RETURN TO SCORE COMMAND IF THAT'S WHERE WE CAME FROM.

    IF(SCORNG)GOTO 8241

C  THAT SHOULD BE GOOD ENOUGH.  LET'S TELL HIM ALL ABOUT IT.

    TYPE 20100,SCORE,MXSCOR,TURNS
20100    FORMAT(///' You scored',I4,' out of a possible',I4,
    1    ', using',I5,' turns.')

    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

20210    CALL SPEAK(CTEXT(I))
    IF(I.EQ.CLSSES-1)GOTO 20220
    K=CVAL(I)+1-SCORE
    KK='s.'
    IF(K.EQ.1)KK='. '
    TYPE 20212,K,KK
20212    FORMAT(/' To achieve the next higher rating, you need',I3,
    1    ' more point',A2/)
    GOTO 25000

20220    TYPE 20222
20222    FORMAT(/' To achieve the next higher rating ',
    1    'would be a neat trick!'//' Congratulations!!'/)

25000    STOP


    END
C  I/O ROUTINES (SPEAK, PSPEAK, RSPEAK, GETIN, YES, A5TOA1)


    SUBROUTINE SPEAK(N)

C  PRINT THE MESSAGE WHICH STARTS AT LINES(N).  PRECEDE IT WITH A BLANK LINE
C  UNLESS BLKLIN IS FALSE.

    IMPLICIT INTEGER(A-Z)
    LOGICAL BLKLIN
    COMMON /TXTCOM/ RTEXT,LINES
    COMMON /BLKCOM/ BLKLIN
    DIMENSION RTEXT(205),LINES(22000)

    IF(N.EQ.0)RETURN
    IF(LINES(N+1).EQ.'>$<')RETURN
    IF(BLKLIN)TYPE 2
    K=N
1    L=IABS(LINES(K))-1
    K=K+1
    TYPE 2,(LINES(I),I=K,L)
2    FORMAT(' ',19A4)
    K=L+1
    IF(LINES(K).GE.0)GOTO 1
    RETURN
    END



    SUBROUTINE PSPEAK(MSG,SKIP)

C  FIND THE SKIP+1ST MESSAGE FROM MSG AND PRINT IT.  MSG SHOULD BE THE INDEX OF
C  THE INVENTORY MESSAGE FOR OBJECT.  (INVEN+N+1 MESSAGE IS PROP=N MESSAGE).

    IMPLICIT INTEGER(A-Z)
    COMMON /TXTCOM/ RTEXT,LINES
    COMMON /PTXCOM/ PTEXT
    DIMENSION RTEXT(205),LINES(9650),PTEXT(100)

    M=PTEXT(MSG)
    IF(SKIP.LT.0)GOTO 9
    DO 3 I=0,SKIP
1    M=IABS(LINES(M))
    IF(LINES(M).GE.0)GOTO 1
3    CONTINUE
9    CALL SPEAK(M)
    RETURN
    END



    SUBROUTINE RSPEAK(I)

C  PRINT THE I-TH "RANDOM" MESSAGE (SECTION 6 OF DATABASE).

    IMPLICIT INTEGER(A-Z)
    COMMON /TXTCOM/ RTEXT
    DIMENSION RTEXT(205)

    IF(I.NE.0)CALL SPEAK(RTEXT(I))
    RETURN
    END



    SUBROUTINE MSPEAK(I)

C  PRINT THE I-TH "MAGIC" MESSAGE (SECTION 12 OF DATABASE).

    IMPLICIT INTEGER(A-Z)
    COMMON /MTXCOM/ MTEXT
    DIMENSION MTEXT(35)

    IF(I.NE.0)CALL SPEAK(MTEXT(I))
    RETURN
    END



    SUBROUTINE GETIN(WORD1 , WORD2)

C  GET A COMMAND FROM THE ADVENTURER.  SNARF OUT THE FIRST WORD, PAD IT WITH
C  BLANKS, AND RETURN IT IN WORD1.  CHARS 6 THRU 10 ARE RETURNED IN WORD1X, IN
C  CASE WE NEED TO PRINT OUT THE WHOLE WORD IN AN ERROR MESSAGE.  ANY NUMBER OF
C  BLANKS MAY FOLLOW THE WORD.  IF A SECOND WORD APPEARS, IT IS RETURNED IN
C  WORD2 (CHARS 6 THRU 10 IN WORD2X), ELSE WORD2 IS SET TO ZERO.

C    **********************************************************************
C    * CHARSLC is a possible lowercase line.  Str$Upcase is called to cnv *
C    * to Upper case to give a bit of friendliness.                 *
C       **********************************************************************

    CHARACTER CHARS*30,CHARSLC*30,WORD1*10,WORD2*10
        INTEGER DUMMY
    WORD1=' '
    WORD2=' '
501    FORMAT ( ' => ', $)
        TYPE 501
100    FORMAT( Q,30A )
    READ(*, 100, Err=432, END=432) LNGTH,CHARSLC
    Dummy = Str$Upcase(CHARS,CHARSLC)
    I=LIB$SKPC(' ',CHARS)
    J=LIB$LOCC(' ',CHARS(I:30))-1
    WORD1=CHARS(I:I+J-1)
    IF(I+J.GT.LNGTH) RETURN
    I=I+J
    I=I+LIB$SKPC(' ',CHARS(I:30))-1
    J=LIB$LOCC(' ',CHARS(I:30))-1
    WORD2=CHARS(I:I+J)
432    RETURN
    END



    LOGICAL FUNCTION YES(X,Y,Z)

C  CALL YESX (BELOW) WITH MESSAGES FROM SECTION 6.

    IMPLICIT INTEGER(A-Z)
    EXTERNAL RSPEAK
    LOGICAL YESX

    YES=YESX(X,Y,Z,RSPEAK)
    RETURN
    END



    LOGICAL FUNCTION YESM(X,Y,Z)

C  CALL YESX (BELOW) WITH MESSAGES FROM SECTION 12.

    IMPLICIT INTEGER(A-Z)
    EXTERNAL MSPEAK
    LOGICAL YESX

    YESM=YESX(X,Y,Z,MSPEAK)
    RETURN
    END



    LOGICAL FUNCTION YESX(X,Y,Z,SPK)

C  PRINT MESSAGE X, WAIT FOR YES/NO ANSWER.  IF YES, PRINT Y AND LEAVE YEA
C  TRUE; IF NO, PRINT Z AND LEAVE YEA FALSE.  SPK IS EITHER RSPEAK OR MSPEAK.

    IMPLICIT INTEGER(A-Z)

    CHARACTER*5 REPLY,JUNK1
1    IF(X.NE.0)CALL SPK(X)
    CALL GETIN(REPLY, JUNK1 )
    IF(REPLY.EQ.'YES'.OR.REPLY.EQ.'Y')GOTO 10
    IF(REPLY.EQ.'NO'.OR.REPLY.EQ.'N')GOTO 20
    TYPE 9
9    FORMAT(/' Please answer the question.')
    GOTO 1
10    YESX=.TRUE.
    IF(Y.NE.0)CALL SPK(Y)
    RETURN
20    YESX=.FALSE.
    IF(Z.NE.0)CALL SPK(Z)
    RETURN
    END



    SUBROUTINE A5TOA1(A,B,CHARS,LENG)

C  A AND B CONTAIN A 1- TO 9-CHARACTER WORD IN A5 FORMAT, C CONTAINS ANOTHER
C  WORD AND/OR PUNCTUATION.  THEY ARE UNPACKED TO ONE CHARACTER PER WORD IN THE
C  ARRAY "CHARS", WITH EXACTLY ONE BLANK BETWEEN B AND C (OR NONE, IF C >= 0).
C  THE INDEX OF THE LAST NON-BLANK CHAR IN CHARS IS RETURNED IN LENG.

    IMPLICIT INTEGER(A-Z)
    DIMENSION CHARS(20)
    CHARACTER *(*) A,B
    INTEGER CHARS
C
C
    J=1
    DO 100 I=1,LIB$LEN(A)
        CHARS(J)=LIB$ICHAR(A(I:I))
        IF(A(I:I) .EQ. ' ')  GO TO 200
        J=J+1
100    CONTINUE
    CHARS(J)=' '
200    J=J+1
    DO 250 I=1,LIB$LEN(B)
        CHARS(J)=LIB$ICHAR(B(I:I))
        IF(B(I:I) .EQ. ' ') GO TO 300
        J=J+1
250    CONTINUE
300    LENG=J-1
    RETURN
    END

C  DATA STRUCTURE ROUTINES (VOCAB, DSTROY, JUGGLE, MOVE, PUT, CARRY, DROP)


    INTEGER FUNCTION VOCAB(ID,INIT)

C  LOOK UP ID IN THE VOCABULARY (ATAB) AND RETURN ITS "DEFINITION" (KTAB), OR
C  -1 IF NOT FOUND.  IF INIT IS POSITIVE, THIS IS AN INITIALISATION CALL SETTING
C  UP A KEYWORD VARIABLE, AND NOT FINDING IT CONSTITUTES A BUG.  IT ALSO MEANS
C  THAT ONLY KTAB VALUES WHICH TAKEN OVER 1000 EQUAL INIT MAY BE CONSIDERED.
C  (THUS "STEPS", WHICH IS A MOTION VERB AS WELL AS AN OBJECT, MAY BE LOCATED
C  AS AN OBJECT.)  AND IT ALSO MEANS THE KTAB VALUE IS TAKEN MOD 1000.

    IMPLICIT INTEGER(A-Z)
    COMMON/VOCCOM1/ ATAB
    COMMON/VOCCOM2/ KTAB,TABSIZ
    CHARACTER ATAB(300)*5
    CHARACTER*(*) ID
    CHARACTER*(5) HASH
    DIMENSION KTAB(300)

    HASH=ID
    DO 1 I=1,TABSIZ
    IF(KTAB(I).EQ.-1)GOTO 2
    IF(INIT.GE.0.AND.KTAB(I)/1000.NE.INIT)GOTO 1
    IF(ATAB(I).EQ.HASH)GOTO 3
1    CONTINUE
    CALL BUG(21)

2    VOCAB=-1
    IF(INIT.LT.0)RETURN
    CALL BUG(5)

3    VOCAB=KTAB(I)
    IF(INIT.GE.0)VOCAB=MOD(VOCAB,1000)
    RETURN
    END



    SUBROUTINE DSTROY(OBJECT)

C  PERMANENTLY ELIMINATE "OBJECT" BY MOVING TO A NON-EXISTENT LOCATION.

    IMPLICIT INTEGER(A-Z)

    CALL MOVE(OBJECT,0)
    RETURN
    END



    SUBROUTINE JUGGLE(OBJECT)

C  JUGGLE AN OBJECT BY PICKING IT UP AND PUTTING IT DOWN AGAIN, THE PURPOSE
C  BEING TO GET THE OBJECT TO THE FRONT OF THE CHAIN OF THINGS AT ITS LOC.

    IMPLICIT INTEGER(A-Z)
    COMMON /PLACOM/ ATLOC,LINK,PLACE,FIXED,HOLDNG
    DIMENSION ATLOC(150),LINK(200),PLACE(100),FIXED(100)

    I=PLACE(OBJECT)
    J=FIXED(OBJECT)
    CALL MOVE(OBJECT,I)
    CALL MOVE(OBJECT+100,J)
    RETURN
    END



    SUBROUTINE MOVE(OBJECT,WHERE)

C  PLACE ANY OBJECT ANYWHERE BY PICKING IT UP AND DROPPING IT.  MAY ALREADY BE
C  TOTING, IN WHICH CASE THE CARRY IS A NO-OP.  MUSTN'T PICK UP OBJECTS WHICH
C  ARE NOT AT ANY LOC, SINCE CARRY WANTS TO REMOVE OBJECTS FROM ATLOC CHAINS.

    IMPLICIT INTEGER(A-Z)
    COMMON /PLACOM/ ATLOC,LINK,PLACE,FIXED,HOLDNG
    DIMENSION ATLOC(150),LINK(200),PLACE(100),FIXED(100)

    IF(OBJECT.GT.100)GOTO 1
    FROM=PLACE(OBJECT)
    GOTO 2
1    FROM=FIXED(OBJECT-100)
2    IF(FROM.GT.0.AND.FROM.LE.300)CALL CARRY(OBJECT,FROM)
    CALL DROP(OBJECT,WHERE)
    RETURN
    END



    INTEGER FUNCTION PUT(OBJECT,WHERE,PVAL)

C  PUT IS THE SAME AS MOVE, EXCEPT IT RETURNS A VALUE USED TO SET UP THE
C  NEGATED PROP VALUES FOR THE REPOSITORY OBJECTS.

    IMPLICIT INTEGER(A-Z)

    CALL MOVE(OBJECT,WHERE)
    PUT=(-1)-PVAL
    RETURN
    END



    SUBROUTINE CARRY(OBJECT,WHERE)

C  START TOTING AN OBJECT, REMOVING IT FROM THE LIST OF THINGS AT ITS FORMER
C  LOCATION.  INCR HOLDNG UNLESS IT WAS ALREADY BEING TOTED.  IF OBJECT>100
C  (MOVING "FIXED" SECOND LOC), DON'T CHANGE PLACE OR HOLDNG.

    IMPLICIT INTEGER(A-Z)
    COMMON /PLACOM/ ATLOC,LINK,PLACE,FIXED,HOLDNG
    DIMENSION ATLOC(150),LINK(200),PLACE(100),FIXED(100)

    IF(OBJECT.GT.100)GOTO 5
    IF(PLACE(OBJECT).EQ.-1)RETURN
    PLACE(OBJECT)=-1
    HOLDNG=HOLDNG+1
5    IF(ATLOC(WHERE).NE.OBJECT)GOTO 6
    ATLOC(WHERE)=LINK(OBJECT)
    RETURN
6    TEMP=ATLOC(WHERE)
7    IF(LINK(TEMP).EQ.OBJECT)GOTO 8
    TEMP=LINK(TEMP)
    GOTO 7
8    LINK(TEMP)=LINK(OBJECT)
    RETURN
    END



    SUBROUTINE DROP(OBJECT,WHERE)

C  PLACE AN OBJECT AT A GIVEN LOC, PREFIXING IT ONTO THE ATLOC LIST.  DECR
C  HOLDNG IF THE OBJECT WAS BEING TOTED.

    IMPLICIT INTEGER(A-Z)
    COMMON /PLACOM/ ATLOC,LINK,PLACE,FIXED,HOLDNG
    DIMENSION ATLOC(150),LINK(200),PLACE(100),FIXED(100)

    IF(OBJECT.GT.100)GOTO 1
    IF(PLACE(OBJECT).EQ.-1)HOLDNG=HOLDNG-1
    PLACE(OBJECT)=WHERE
    GOTO 2
1    FIXED(OBJECT-100)=WHERE
2    IF(WHERE.LE.0)RETURN
    LINK(OBJECT)=ATLOC(WHERE)
    ATLOC(WHERE)=OBJECT
    RETURN
    END

C  WIZARDRY ROUTINES (START, MAINT, WIZARD, NEWHRS(X),  POOF)


    LOGICAL FUNCTION START(DUMMY)

C  CHECK TO SEE IF THIS IS "PRIME TIME".  IF SO, ONLY WIZARDS MAY PLAY, THOUGH
C  OTHERS MAY BE ALLOWED A SHORT GAME FOR DEMONSTRATION PURPOSES.  IF SETUP<0,
C  WE'RE CONTINUING FROM A SAVED GAME, SO CHECK FOR SUITABLE LATENCY.  RETURN
C  TRUE IF THIS IS A DEMO GAME (VALUE IS IGNORED FOR RESTARTS).

    IMPLICIT INTEGER(A-Z)
    LOGICAL PTIME,SOON,YESM
    DIMENSION HNAME(4)
    COMMON /WIZCOM/ WKDAY,WKEND,HOLID,HBEGIN,HEND,HNAME,
    1    SHORT,MAGNM,LATNCY,SAVED,SAVET,SETUP

C  FIRST FIND OUT WHETHER IT IS PRIME TIME (SAVE IN PTIME) AND, IF RESTARTING,
C  WHETHER IT'S TOO SOON (SAVE IN SOON).  PRIME-TIME SPECS ARE IN WKDAY, WKEND,
C  AND HOLID; SEE MAINT ROUTINE FOR DETAILS.  LATNCY IS REQUIRED DELAY BEFORE
C  RESTARTING.  WIZARDS MAY CUT THIS TO A THIRD.

C    PRIMTM=WKDAY

    PRIMTM=HOLID
    RETURN
    END

    SUBROUTINE MAINT( NUMDIE )

C  SOMEONE SAID THE MAGIC WORD TO INVOKE MAINTENANCE MODE.  MAKE SURE HE'S A
C  WIZARD.  IF SO, LET HIM TWEAK ALL SORTS OF RANDOM THINGS, THEN EXIT SO CAN
C  SAVE TWEAKED VERSION.  SINCE MAGIC WORD was to BE FIRST COMMAND GIVEN, ONLY
C  THING WHICH NEEDS TO BE FIXED UP IS ABB(1).

    IMPLICIT INTEGER(A-Z)
    LOGICAL YESM,BLKLIN
    DIMENSION HNAME(4),ABB(150)
    CHARACTER X*10,XT*10,MAGIC*10
    COMMON /BLKCOM/ BLKLIN
    COMMON /ABBCOM/ ABB
    COMMON /WIZCOM/ WKDAY,WKEND,HOLID,HBEGIN,HEND,HNAME,
    1    SHORT,MAGNM,LATNCY,SAVED,SAVET,SETUP
    COMMON /WIZWRD/ MAGIC

    IF(.NOT.WIZARD(0))RETURN
    NUMDIE=1
    BLKLIN=.FALSE.
    RETURN
    END



    LOGICAL FUNCTION WIZARD(DUMMY)

C  ASK IF HE'S A WIZARD.  IF HE SAYS YES, MAKE HIM PROVE IT.  RETURN TRUE IF HE
C  REALLY IS A WIZARD.

    IMPLICIT INTEGER(A-Z)
    LOGICAL YESM
    CHARACTER WORD*10,TWORD*10,MAGIC*10
    DIMENSION HNAME(4),VAL(5)
    COMMON /WIZCOM/ WKDAY,WKEND,HOLID,HBEGIN,HEND,HNAME,
    1    SHORT,MAGNM,LATNCY,SAVED,SAVET,SETUP
    COMMON /WIZWRD/ MAGIC

    WIZARD=YESM(16,0,7)
    IF(.NOT.WIZARD)RETURN

C  HE SAYS HE IS.  FIRST STEP: DOES HE KNOW ANYTHING MAGICAL?

    CALL MSPEAK(17)
    CALL GETIN(WORD , TWORD)
    IF(WORD.NE.MAGIC)GOTO 99

C  BY GEORGE, HE REALLY *IS* A WIZARD!

    CALL MSPEAK(19)
    WIZARD=.TRUE.
    RETURN

C  AHA!  AN IMPOSTOR!

99    CALL MSPEAK(20)
    WIZARD=.FALSE.
    RETURN
    END


    SUBROUTINE POOF

C  AS PART OF DATABASE INITIALISATION, WE CALL POOF TO SET UP SOME DUMMY
C  PRIME-TIME SPECS, MAGIC WORDS, ETC.

    IMPLICIT INTEGER(A-Z)
    DIMENSION HNAME(4)
    CHARACTER MAGIC*10
    COMMON /WIZCOM/ WKDAY,WKEND,HOLID,HBEGIN,HEND,HNAME,
    1    SHORT,MAGNM,LATNCY,SAVED,SAVET,SETUP
    COMMON /WIZWRD/ MAGIC

    WKDAY='0003FF00'X
    WKEND=0
    HOLID=0
    HBEGIN=0
    HEND=-1
    SHORT=900

C        *******************************************************************
C        * Have changed the Short Game to 900 Moves (If it is ever called) *
C        * (More than enuff time to get killed.  Changed Magic Word        *
C        * Magic Number does nothing as far as i can see.  The facility is *
C        * there but does not seem to be used anywhere...                  *
C        *******************************************************************

    MAGIC='WITCH'
    MAGNM=11111
    LATNCY=60
    RETURN
    END


C  UTILITY ROUTINES (SHIFT, RAN, DATIME, BUG)
C
C
C
    SUBROUTINE XFR(A,I,K)
    CHARACTER*(*) A
    DIMENSION ITMP(20),I(22000)
    LOGICAL*1 LTMP(80)
    EQUIVALENCE(ITMP,LTMP)
    J=LEN(A)
    DO 100 II=1,J
        LTMP(II)=LIB$ICHAR(A(II:II))
100    CONTINUE
    J=J/4+1
    DO 200 II=1,J
        I(K+II-1)=ITMP(II)
200    CONTINUE
    RETURN
    END

    FUNCTION INTG(CH)
    CHARACTER*(*) CH
    L=LEN(CH)
    I=LIB$SKPC(' ',CH)
    IS=1
    IF(CH(I:I) .EQ. '-') THEN
        I=I+1
        IS=-1
    ENDIF
    J=LIB$LOCC(' ',CH(I:L-I+1))-1
    INTG=0
    DO 100 K=I,I+J-1
        INTG=INTG*10+(LIB$ICHAR(CH(K:K))-'30'X)
100    CONTINUE
    INTG=INTG*IS
    RETURN
    END


    INTEGER FUNCTION SHIFT(VAL,DIST)
    IMPLICIT INTEGER(A-Z)

C  RETURN VAL LEFT-SHIFTED (LOGICALLY) DIST BITS (RIGHT-SHIFT IF DIST<0).

    SHIFT=VAL
    IF(DIST)10,20,30
10    IDIST=-DIST
    DO 11 I=1,IDIST
    J=0
    IF(SHIFT.LT.0)J='40000000'X
11    SHIFT=((SHIFT.AND.'7FFFFFFF'X)/2)+J
20    RETURN
30    DO 31 I=1,DIST
    J=0
    IF((SHIFT.AND.'40000000'X).NE.0)J='80000000'X
31    SHIFT=(SHIFT.AND.'3FFFFFFF'X)*2+J
    RETURN
    END



    INTEGER FUNCTION RAN(RANGE)

C  SINCE THE RAN FUNCTION IN LIB40 SEEMS TO BE A REAL LOSE, WE'LL USE ONE OF
C  OUR OWN.  IT'S BEEN RUN THROUGH MANY OF THE TESTS IN KNUTH VOL. 2 AND
C  SEEMS TO BE QUITE RELIABLE.  RAN RETURNS A VALUE UNIFORMLY SELECTED
C  BETWEEN 0 AND RANGE-1.  NOTE RESEMBLANCE TO ALG USED IN WIZARD.

    IMPLICIT INTEGER(A-Z)
    DATA R/0/

    D=1
    IF(R.NE.0)GOTO 1
    CALL DATIME(D,T)
    R=18*T+5
    D=1000+MOD(D,1000)
1    DO 2 T=1,D
2    R=MOD(R*1021,1048576)
    RAN=(RANGE*R)/1048576
    RETURN
    END



    SUBROUTINE DATIME(D,T)

C  RETURN THE DATE AND TIME IN D AND T.  D IS NUMBER OF DAYS SINCE 01-JAN-77,
C  T IS MINUTES PAST MIDNIGHT.
    IMPLICIT INTEGER(A-Z)
    DIMENSION MONTH(12)
    DATA MONTH/0,31,59,90,120,151,181,212,243,273,304,334/
    REAL FOR$SECNDS
    CALL FOR$JDATE(MON,DAY,YEAR)
    Y=(YEAR-77)*365+(YEAR-77)/4
    IF(MOD(YEAR,4) .EQ. 3 .AND. MON .GT. 2) Y=Y+1
    D=Y+MONTH(MON)+DAY-1
    T=FOR$SECNDS(0.0)/60.
    RETURN
    END



C    Ex-SUBROUTINE CIAO

C  EXITS, AFTER ISSUING REMINDER TO SAVE NEW CORE IMAGE.  USED WHEN SUSPENDING
C  AND WHEN CREATING NEW VERSION VIA MAGIC MODE.  ON SOME SYSTEMS, THE CORE
C  IMAGE IS LOST ONCE THE PROGRAM EXITS.  IF SO, SET K=31 INSTEAD OF 32.


    SUBROUTINE BUG(NUM)
    IMPLICIT INTEGER(A-Z)

C  THE FOLLOWING CONDITIONS ARE CURRENTLY CONSIDERED FATAL BUGS.  NUMBERS < 20
C  ARE DETECTED WHILE READING THE DATABASE; THE OTHERS OCCUR AT "RUN TIME".
C    0    MESSAGE LINE > 70 CHARACTERS
C    1    NULL LINE IN MESSAGE
C    2    TOO MANY WORDS OF MESSAGES
C    3    TOO MANY TRAVEL OPTIONS
C    4    TOO MANY VOCABULARY WORDS
C    5    REQUIRED VOCABULARY WORD NOT FOUND
C    6    TOO MANY RTEXT OR MTEXT MESSAGES
C    7    TOO MANY HINTS
C    8    LOCATION HAS COND BIT BEING SET TWICE
C    9    INVALID SECTION NUMBER IN DATABASE
C    20    SPECIAL TRAVEL (500>L>300) EXCEEDS GOTO LIST
C    21    RAN OFF END OF VOCABULARY TABLE
C    22    VOCABULARY TYPE (N/1000) NOT BETWEEN 0 AND 3
C    23    INTRANSITIVE ACTION VERB EXCEEDS GOTO LIST
C    24    TRANSITIVE ACTION VERB EXCEEDS GOTO LIST
C    25    CONDITIONAL TRAVEL ENTRY WITH NO ALTERNATIVE
C    26    LOCATION HAS NO TRAVEL ENTRIES
C    27    HINT NUMBER EXCEEDS GOTO LIST
C    28    INVALID MONTH RETURNED BY DATE FUNCTION

    TYPE 1, NUM
1    FORMAT (' Fatal error, see source code for interpretation.'/
    1    ' Probable cause: erroneous info in database.'/
    2    ' Error code =',I2/)
    STOP 'Oh dear'
    END
--

 +--------+ --+--        +         --+--                 The slowest "X" term
 | +----+ |   |          |           |                   in the west (With a
 | |    | |   | |  | `/` +--   --    |   ,--, `/` +\ /+ twin - rinse   cycle
 | +----+ |   | |  | |   |  ) (  )   |   |--' |   | V | thrown in.
 | VT1000 |   + +--+ +   +--   --    +   `--' +   +   + Fax:  [phone]
 +--------+ Simon Paul Travaglia,  Computer Services,  University  of  Waikato
 [========] Private. Bag 3105,  Hamilton, New Zealand. [e-mail]

Fairy Tale: A horror story to prepare children for the newspapers.