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

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

Path: uunet!comp.vuw.ac.nz!waikato.ac.nz!ccc_simon
From: [e-mail] (Simon Travaglia)
Newsgroups: vmsnet.sources.games
Subject: Adventure Fortran Source
Message-ID: <[e-mail]>
Date: 31 Dec 91 09:08:51 +1300
Organization: University of Waikato Computer Centre
Lines: 2785

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         *
C    * won't be deleted in case someone may want to look them up.    *
C    *       ----====++++**** Ralph Wuz Here ****++++====----        *
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    *****************************************************************

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

    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.