




C***   A5TOA1

       SUBROUTINE A5TOA1(A,B,C,QQ,LENG)

C  A AND B CONTAIN A 1- TO 12-CHARACTER WORD IN A6 FORMAT, C CONTAINS ANOTHER
C  WORD AND/OR PUNCTUATION.  THEY ARE UNPACKED TO ONE CHARACTER PER WORD IN THE
C  ARRAY "CHARS".
C  THE INDEX OF THE LAST NON-BLANK CHAR IN CHARS IS RETURNED IN LENG.

       IMPLICIT INTEGER(A-Z)
       CHARACTER*6 A,B,C
       CHARACTER QQ(20)
	DO 300 JJ=1,6
	QQ(JJ)=A(JJ:JJ)
300	QQ(JJ+6)=B(JJ:JJ)
      DO 5 I=1,12
      IF(QQ(I).EQ.' ')GOTO 10
5     CONTINUE
      LENG=12
      GOTO 15
10    CONTINUE
      LENG=I-1
15    DO 20 I=1,6
      IF(C(I:I).NE.' ')THEN
          LENG=LENG+1
          QQ(LENG) = C(I:I)
      ENDIF
20    CONTINUE
      DO 21 I= LENG+1,20
21    QQ(I) = ' '    
      DO 22 I= 1,20
22    IF(QQ(I).EQ.'_')QQ(I) = ' '
      
      RETURN
      END



C***  AJAR   .TRUE. IF OBJ IS CONTAINER AND IS OPEN
C  THE NEXT LOGICAL FUNCTIONS DESCRIBE ATTRIBUTES OF OBJECTS.
C  (AJAR, HINGED, OPAQUE, PRINTD, TREASR, VESSEL, WEARNG)

       LOGICAL FUNCTION AJAR(OBJ)

C  AJAR(OBJ)    = TRUE IF OBJECT IS AN OPEN OR UNHINGED CONTAINER.

       IMPLICIT INTEGER(A-Z)
       LOGICAL BITSET,HINGED,VESSEL
       COMMON /BITCOM/ OPENBT,UNLKBT,BURNBT,WEARBT
       COMMON /CONCOM/ LOCCON(250),OBJCON(150)

      AJAR=BITSET(OBJCON(OBJ),OPENBT).OR.
     1  (VESSEL(OBJ).AND..NOT.HINGED(OBJ))
       RETURN
       END


C***  AT     .TRUE. IF AT OBJ
       LOGICAL FUNCTION AT(OBJ)

C  AT(OBJ)      = TRUE IF ON EITHER SIDE OF TWO-PLACED OBJECT

       IMPLICIT INTEGER(A-Z)
       COMMON /LOCCOM/ LOC,OLDLOC,OLDLC2,NEWLOC,MAXLOC
       COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150),
     1          FIXED(150),MAXOBJ
       AT = .FALSE.
       IF(OBJ.LT.1.OR.OBJ.GT.MAXOBJ)RETURN
       AT=PLACE(OBJ).EQ.LOC.OR.FIXED(OBJ).EQ.LOC
       RETURN
       END



C***  ATHAND .TRUE. IF OBJ READILY AVAILABLE


       LOGICAL FUNCTION ATHAND(OBJ)

C  ATHAND(OBJ)  = TRUE IF OBJ IS READILY REACHABLE.
C                 IT CAN BE LYING HERE, IN HAND OR IN OPEN CONTAINER.

       IMPLICIT INTEGER(A-Z)
       COMMON /LOCCOM/ LOC,OLDLOC,OLDLC2,NEWLOC,MAXLOC
       COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150),
     1          FIXED(150),MAXOBJ
       LOGICAL TOTING,AJAR,ENCLSD,HOLDNG,AAA

       ATHAND = .FALSE.
       IF(PLACE(OBJ).EQ.LOC.OR.HOLDNG(OBJ))THEN
             ATHAND = .TRUE.
             RETURN
       ENDIF
       IF(.NOT.ENCLSD(OBJ))RETURN
       CONTNR=-PLACE(OBJ)
       

       ATHAND=
     1      (AJAR(CONTNR).AND.
     2          (PLACE(CONTNR).EQ.LOC.OR.
     3          (TOTING(OBJ).AND.HOLDNG(CONTNR))))

       RETURN
       END




C***   BITOFF


       SUBROUTINE BITOFF(OBJ,BIT)

C  TURNS OFF (SETS=0) A BIT IN OBJCON.

       IMPLICIT INTEGER(A-Z)
       COMMON /CONCOM/ LOCCON(250),OBJCON(150)

C      OBJCON(OBJ)=IAND(OBJCON(OBJ),INOT(BITS(BIT)))
C THE FOLLOWING SHOULD BE EQUIVALENT TO THE ABOVE
       OBJCON(OBJ)=IOR(OBJCON(OBJ),(BITS(BIT)))-BITS(BIT)
       RETURN
       END




C***   BITON


       SUBROUTINE BITON(OBJ,BIT)

C  TURNS ON (SETS=1) A BIT IN OBJCON.

       IMPLICIT INTEGER(A-Z)
       COMMON /CONCOM/ LOCCON(250),OBJCON(150)

      OBJCON(OBJ)=IOR(OBJCON(OBJ),BITS(BIT))
       RETURN
       END






C***   BITS
      INTEGER FUNCTION BITS(SHIFT)
      IMPLICIT INTEGER (A-Z)
      BITS=(2**SHIFT)
      RETURN
      END




C***   BITSET
C  MISCELLANEOUS LOGICAL FUNCTIONS (BITSET, PCT)
C  ALSO, SUBROUTINES FOR TURNING BITS ON AND OFF (BITON, BITOFF).

       LOGICAL FUNCTION BITSET(WORD,N)

C  BITSET(COND,L,N) = TRUE IF COND(L) HAS BIT N SET

       IMPLICIT INTEGER(A-Z)
      BITSET=IAND(WORD,2**N).NE.0
5      RETURN
       END






C***  BLIND  .TRUE. IF YOU CAN'T SEE AT THIS LOC
C  LOCATION ATTRIBUTES.  (BLIND, DARK, FORCED, INSIDE, OUTSID, PORTAL)


       LOGICAL FUNCTION BLIND(DUMMY)

C  TRUE IF ADVENTURER IS "BLIND" AT THIS LOC, (DARKNESS OR GLARE)

       IMPLICIT INTEGER(A-Z)
       COMMON /CONCOM/ LOCCON(250),OBJCON(150)
       COMMON /LOCCOM/ LOC,OLDLOC,OLDLC2,NEWLOC,MAXLOC
       COMMON /OBJCOM/ PLAC(150),FIXD(150),WEIGHT(150),PROP(150),
     1          POINTS(150)
      LOGICAL DARK,ATHAND
       DATA LAMP /2/

       BLIND=DARK(0).OR.(LOC.EQ.200.AND.ATHAND(LAMP).AND.PROP(LAMP)
     1      .EQ.1)

       RETURN
       END





C***   BUG

       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       10      OUT OF ORDER LOCS OR RSPEAK ENTRIES.
C       11      ILLEGAL MOTION WORD IN TRAVEL TABLE
C       12      ** UNUSED **.
C       13      UNKNOWN OR ILLEGAL WORD IN ADJECTIVE TABLE.
C       14      ILLEGAL WORD IN PREP/OBJ TABLE
C       15      TOO MANY ENTRIES IN PREP/OBJ TABLE
C       16      OBJECT HAS CONDITION BIT SET TWICE
C       17      OBJECT NUMBER TOO LARGE
C       18      TOO MANY ENTRIES IN ADJECTIVE/NOUN TABLE.
C       20      SPECIAL TRAVEL (500>L>300) EXCEEDS GOTO LIST
C       21      RAN OFF END OF VOCABULARY TABLE
C       22      VERB CLASS (N/1000) NOT BETWEEN 1 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
C       29      ACTION VERB 'LEAVE' HAS NO OBJECT.
C       30      PREPOSITION FOUND IN UNEXPECTED TABLE
C       31      RECEIVED AN UNEXPECTED WORD TERMINATOR FROM A1TOA5
C       32      TRYING TO PUT A CONTAINER INTO ITSELF (TRICKY!)
C       33      UNKNOWN WORD CLASS IN GETWDS
C       35      TRYING TO CARRY A NON-EXISTENT OBJECT

       WRITE(*,1) NUM
1       FORMAT (' FATAL ERROR, SEE SOURCE CODE FOR INTERPRETATION.'/
     1  ' PROBABLE CAUSE: ERRONEOUS INFO IN DATABASE OR BAD ASAVE.DAT'/
     2  ' ERROR CODE =',I2/)
       STOP
       END


C***  BURDEN .. RETURNS WEIGHT OF ITEMS BEING CARRIED

       INTEGER FUNCTION BURDEN(OBJ)

C  IF OBJ=0, BURDEN CALCULATES THE TOTAL WEIGHT OF THE ADVENTURER'S BURDEN,
C       INCLUDING EVERYTHING IN ALL CONTAINERS (EXCEPT THE BOAT) THAT HE IS
C       CARRYING.
C  IF OBJ#0 AND OBJ IS A CONTAINER, CALCULATE THE WEIGHT OF EVERYTHING INSIDE
C       THE CONTAINER (INCLUDING THE CONTAINER ITSELF).  SINCE DONKEY FORTRAN
C       ISN'T RECURSIVE, WE WILL ONLY CALCULATE WEIGHTS OF CONTAINED CONTAINERS
C       ONE LEVEL DOWN.  THE ONLY SERIOUS CONTAINED CONTAINER WOULD BE THE SACK
C       THE ONLY THINGS WE'LL MISS WILL BE FILLED VS EMPTY BOTTLE OR CAGE.
C  IF OBJ#0 AND ISN'T A CONTAINER, RETURN ITS WEIGHT.

       IMPLICIT INTEGER(A-Z)
       COMMON /OBJCOM/ PLAC(150),FIXD(150),WEIGHT(150),PROP(150),
     1          POINTS(150)
       COMMON /HLDCOM/ HOLDER(150),HLINK(150)
       COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150),
     1          FIXED(150),MAXOBJ
       LOGICAL TOTING,WEARNG
       DATA BOAT /48/

       BURDEN=0
       IF(OBJ.NE.0)GOTO 200
       DO 100 I=1,MAXOBJ
       IF(.NOT.TOTING(I).OR.PLACE(I).EQ.-BOAT)GOTO 100
       BURDEN=BURDEN+WEIGHT(I)
100     CONTINUE
       RETURN

200     BURDEN=WEIGHT(OBJ)
       IF(OBJ.EQ.BOAT)RETURN
       TEMP=HOLDER(OBJ)
210     IF(TEMP.EQ.0)RETURN
       BURDEN=BURDEN+WEIGHT(TEMP)
       TEMP=HLINK(TEMP)
       GOTO 210

       END






C***   CARRY

       SUBROUTINE CARRY(OBJECT,WHERE)

C  START TOTING AN OBJECT, REMOVING IT FROM THE LIST OF THINGS AT ITS FORMER
C  LOCATION.  IF OBJECT>MAXOBJ (MOVING "FIXED" SECOND LOC),
C  DON'T CHANGE PLACE.

       IMPLICIT INTEGER(A-Z)
       COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150),
     1          FIXED(150),MAXOBJ

       IF(OBJECT.GT.MAXOBJ)GOTO 5
       IF(PLACE(OBJECT).EQ.-1)RETURN
       PLACE(OBJECT)=-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)
       IF(TEMP.NE.0)GOTO 7
       CALL BUG(35)

8       LINK(TEMP)=LINK(OBJECT)
       RETURN
       END


C***   CLASS


       INTEGER FUNCTION CLASS(WORD)

C  RETURNS WORD CLASS NUMBER (1=MOTION VERB; 2=NOUN; 3=ACTION VERB;
C  4=MISCELLANEOUS WORD; 5=PREPOSITION; 6=ADJECTIVE; 7=CONJUNCTION).


       IMPLICIT INTEGER(A-Z)

       CLASS=WORD/1000 +1
       IF(WORD.LT.0)CLASS=-1
       RETURN
       END



C***   CLRLIN

       SUBROUTINE CLRLIN

C  CLEARS OUT ALL CURRENT SYNTAX ARGS IN PREPARATION FOR A NEW INPUT LINE

       IMPLICIT INTEGER(A-Z)
       CHARACTER*6 VTXT,OTXT,IOTXT,DTK,ATAB,TXT,ALLZERO
       COMMON /WRDCOM/ VERBS(45),VRBX,OBJS(45),
     1  OBJX,IOBJS(15),IOBX,PREP,WORDS(45)
       COMMON /SV3COM/DTK(9),ATAB(600),VTXT(45,2),OTXT(45,2),IOTXT(15,2)
     1      ,TXT(35,2)

       DO 3333 I=1,6
3333   ALLZERO(I:I) = CHAR(0)
       DO 1 I=1,45
       OBJS(I)=0
       VERBS(I)=0
       DO 1 J=1,2
1       VTXT(I,J)=ALLZERO

       DO 3 I=1,15
       IOBJS(I)=0
       DO 3 J=1,2
       IOTXT(I,J)=ALLZERO
3       OTXT(I,J)=ALLZERO

       VRBX=0
       OBJX=0
       IOBX=0
       PREP=0
       RETURN

       END



C***   CONFUZ


       INTEGER FUNCTION CONFUZ(DUMMY)

C  GENERATES SOME VARIANT OF "DON'T UNDERSTAND THAT" MESSAGE.

       IMPLICIT INTEGER(A-Z)
      LOGICAL PCT
       CONFUZ=60
       IF(PCT(50))CONFUZ=61
       IF(PCT(33))CONFUZ=13
       IF(PCT(25))CONFUZ=347
       IF(PCT(20))CONFUZ=195
       RETURN
       END




C***  DARK   .TRUE. IF THERE IS NO LIGHT HERE


       LOGICAL FUNCTION DARK(DUMMY)

C  TRUE IF LOCATION "LOC" IS DARK

       IMPLICIT INTEGER(A-Z)
       COMMON /CONCOM/ LOCCON(250),OBJCON(150)
       COMMON /LOCCOM/ LOC,OLDLOC,OLDLC2,NEWLOC,MAXLOC
       COMMON /OBJCOM/ PLAC(150),FIXD(150),WEIGHT(150),PROP(150),
     1          POINTS(150)
      LOGICAL ATHAND
       DATA LAMP /2/

       DARK=MOD(LOCCON(LOC),2).EQ.0.AND.(PROP(LAMP).EQ.0.OR.
     1  .NOT.ATHAND(LAMP))
       RETURN
       END







C***   DEAD  .TRUE. IF OBJ IS NOW DEAD
      LOGICAL FUNCTION DEAD(OBJ)
      IMPLICIT INTEGER(A-Z)
      LOGICAL BITSET
      COMMON/CONCOM/LOCCON(250),OBJCON(150)
      DEAD=BITSET(OBJCON(OBJ),10)
      RETURN
      END

C***   DROP



       SUBROUTINE DROP(OBJECT,WHERE)

C  PLACE AN OBJECT AT A GIVEN LOC, PREFIXING IT ONTO THE ATLOC LIST.

       IMPLICIT INTEGER(A-Z)
       COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150),
     1          FIXED(150),MAXOBJ

       IF(OBJECT.GT.MAXOBJ)GOTO 1
       PLACE(OBJECT)=WHERE
       GOTO 2

1       FIXED(OBJECT-MAXOBJ)=WHERE
2       IF(WHERE.LE.0)RETURN
       LINK(OBJECT)=ATLOC(WHERE)
       ATLOC(WHERE)=OBJECT
       RETURN
       END




C***   DSTROY


       SUBROUTINE DSTROY(OBJECT)

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

       IMPLICIT INTEGER(A-Z)

       CALL MOVE(OBJECT,0)
       RETURN
       END




C***   EDIBLE  .TRUE. IF OBJ CAN BE EATEN

      LOGICAL FUNCTION EDIBLE(OBJ)
      IMPLICIT INTEGER(A-Z)
      LOGICAL BITSET
      COMMON/CONCOM/LOCCON(250),OBJCON(150)
      EDIBLE=BITSET(OBJCON(OBJ),7)
      RETURN
      END


C***  ENCLSD .TURE. IF OBJ INSIDE SOMETHING


       LOGICAL FUNCTION ENCLSD(OBJECT)

C  ENCLSD(OBJ) = TRUE IF THE OBJ IS IN A CONTAINER

       IMPLICIT INTEGER(A-Z)
       COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150),
     1          FIXED(150),MAXOBJ
       ENCLSD=.FALSE.
       IF(OBJECT.LT.1.OR.OBJECT.GT.MAXOBJ)RETURN
       ENCLSD=PLACE(OBJECT).LT.-1
       RETURN
       END





C***   FORCED


       LOGICAL FUNCTION FORCED(LOC)

C  A FORCED LOCATION IS ONE FROM WHICH HE IS IMMEDIATELY BOUNCED TO ANOTHER.
C  NORMAL USE IS FOR DEATH (FORCE TO LOC ZERO) AND FOR DESCRIPTIONS OF
C  JOURNEY FROM ONE PLACE TO ANOTHER.

       IMPLICIT INTEGER(A-Z)
       COMMON /CONCOM/ LOCCON(250),OBJCON(150)

       FORCED=LOCCON(LOC).EQ.2

       RETURN
       END



C***   GETLIN

       SUBROUTINE GETLIN


       IMPLICIT INTEGER(A-Z)
       LOGICAL BLKLIN
       COMMON /BLKCOM/ BLKLIN
      CHARACTER*6 TXT,WDS(2),KK,DTK,ATAB,VTXT,OTXT,IOTXT,TXT2(35,2)
      LOGICAL ACTIVE
       COMMON /UTXCOM/ WDX
       CHARACTER CHRS(150), CHR2(150),CHRX(70)
       COMMON /SV3COM/DTK(9),ATAB(600),VTXT(45,2),OTXT(45,2),IOTXT(15,2)
     1      ,TXT(35,2)

10      DO 15 I=1,35
       DO 15 J=1,2
        TXT2(I,J) = '      '
15      TXT(I,J)  = '      '

20      IF(BLKLIN)WRITE(*,*)'  '
	WRITE(*,1266)
C1266	FORMAT(' >')
C??????????????????????????????? THE FOLLOWING WORKS ON MANY COMPUTERS:
1266	FORMAT(' >',$)
30      READ (*,50)CHRX
50      FORMAT(70A1)
        DO 1 I=1,70
        CHRX(I) = CHAR(IAND(ICHAR(CHRX(I)), 127))
        IF(CHRX(I).LT.' ')CHRX(I) = ' '
        IF(CHRX(I).GE.'`')CHRX(I) = CHAR(ICHAR(CHRX(I)) - 32)
1       CONTINUE
      
        DO 4 I=1,70
        IF(CHRX(I).NE.' ') GOTO 6
4       CONTINUE
        GOTO 20
6       CONTINUE

        INDX = 1
        DO 2 I=1,70
        IF(CHRX(I).EQ.'.'.OR.CHRX(I).EQ.';'.OR.CHRX(I).EQ.',')THEN
          CHR2(INDX) = ' '
          INDX = INDX + 1
          CHR2(INDX) = 'A'
          INDX = INDX + 1
          CHR2(INDX) = 'N'
          INDX = INDX + 1
          CHR2(INDX) = 'D'
          INDX = INDX + 1
          CHR2(INDX) = ' '
          INDX = INDX + 1
        ELSE
          CHR2(INDX) = CHRX(I)
          INDX = INDX + 1
        ENDIF
2       CONTINUE
        CHR2(INDX) = '.'


        DO 70 INDX2= 1,INDX
70      IF(CHR2(INDX2).NE.' ') GOTO 73
73      CONTINUE
        J = 1
        DO 71 I = INDX2,INDX
        IF(I.NE.INDX2.AND.CHRS(J-1).EQ.' '.AND.CHR2(I).EQ.' ')GOTO71
        CHRS(J) = CHR2(I)
        J = J+1
71      CONTINUE
        IF(CHRS(1).EQ.'.') GOTO 20

        WDX = 1
        J = 1
        DO 100 I=1,100        
              IF(CHRS(I).EQ.'.') GO TO 200
              IF(CHRS(I).EQ.' ') GO TO 120
              IF(J.LE.6)TXT2(WDX,1)(J:J) = CHRS(I)
              IF(J.GT.6.AND.J.LE.12)TXT2(WDX,2)(J-6:J-6) = CHRS(I)
              J = J+1
              GOTO 100
120        CONTINUE
           J = 1
           WDX = WDX + 1
100     CONTINUE
200     CONTINUE
        TXT(1,1) = TXT2(1,1)
        TXT(1,2) = TXT2(1,2)
        J = 1
        DO 210 I=2,35
          IF(TXT(J,1).NE.'AND   '.OR.TXT2(I,1).NE.'AND   ')THEN
               J = J+1
               TXT(J,1) = TXT2(I,1)
               TXT(J,2) = TXT2(I,2)
          ELSE
               WDX = WDX - 1
          ENDIF
210     CONTINUE

C          WRITE(*,12345)(TXT(IQQ,1),IQQ = 1,35)
C12345  FORMAT(' ',5A6)


       END



C***   GETOBJ

       SUBROUTINE GETOBJ(OBJ)

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, OIL AND WINE ARE ALSO
C  FUNNY, SINCE THEY ARE NEVER ACTUALLY DROPPED AT ANY LOCATION, BUT MIGHT
C  BE HERE INSIDE THE BOTTLE OR AS A FEATURE OF THE LOCATION.
C
C  HAS THREE POSSIBLE RETURN VALUES FOR 'OBJ':
C       VAL > 0 :: A POSITIVE OBJECT NUMBER
C       VAL = 0 :: OBJECT NOT FOUND HERE.  ERROR MESSAGE PRINTED.
C       VAL < 0 :: OBJECT WORD REALLY SOMETHING ELSE.  RETURN NEGATIVE
C                       VALUE OF SUBSTITUTED WORD.

       IMPLICIT INTEGER(A-Z)
      LOGICAL AT
       CHARACTER ZAPP(20)
       COMMON /DWFCOM/ DWARF,KNIFE,KNFLOC,DFLAG,DSEEN(6),DLOC(6),
     1  ODLOC(6),DWFMAX
       COMMON /LIQCOM/ BOTTLE,CASK,WATER,OIL,WINE,LIQTYP(5)
       COMMON /LOCCOM/ LOC,OLDLOC,OLDLC2,NEWLOC,MAXLOC
       COMMON /MNECOM/ BACK,CAVE,DPRSSN,ENTRNC,EXIT,GO,LOOK,NULL,
     1 AXE,BEAR,BOAT,BOOK,BOOK2,BOOTH,CARVNG,CHASM,CHASM2,DOOR,GNOME,
     2 GRATE,LAMP,PDOOR,PLANT,PLANT2,ROCKS,ROD,ROD2,SAFE,
     3 TDOOR,TDOOR2,TROLL,TROLL2,EMRALD,SPICES,
     4 FIND,YELL,INVENT,LEAVE,POUR,SAY,TAKE,THROW,
     5 IWEST,PHUCE(2,4),TK(20)
       COMMON /OBJCOM/ PLAC(150),FIXD(150),WEIGHT(150),PROP(150),
     1          POINTS(150)
       COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150),
     1          FIXED(150),MAXOBJ
      CHARACTER*6 TXT
       COMMON /UTXCOM/ WDX
      CHARACTER*6 VTXT,OTXT,IOTXT,DTK,ATAB
       COMMON /WRDCOM/ VERBS(45),VRBX,OBJS(45),
     1  OBJX,IOBJS(15),IOBX,PREP,WORDS(45)
       LOGICAL ATHAND,BLIND,HERE,HOLDNG,PLURAL
       COMMON /SV3COM/DTK(9),ATAB(600),VTXT(45,2),OTXT(45,2),IOTXT(15,2)
     1      ,TXT(35,2)


       IF(HOLDNG(OBJ))RETURN
       IF(BLIND(0))GOTO 280
       IF(FIXED(OBJ).EQ.LOC.OR.ATHAND(OBJ))GOTO 290
       IF(.NOT.HERE(OBJ))GOTO 205
       K=335
       IF(PLURAL(OBJ))K=373
       OBJ=0
       CALL RSPEAK(K)
       RETURN

205     IF(OBJ.NE.GRATE)GOTO 210
       IF(LOC.EQ.1.OR.LOC.EQ.4.OR.LOC.EQ.7)OBJ=-DPRSSN
       IF(LOC.GT.9.AND.LOC.LT.15)OBJ=-ENTRNC
       IF(OBJ.EQ.GRATE)GOTO 280
       RETURN

210     IF(OBJ.NE.DWARF)GOTO 220
      L1=DWFMAX-1
       DO 212 I=1,L1
       IF(DLOC(I).EQ.LOC.AND.DFLAG.GE.2)GOTO 290
212     CONTINUE
       GOTO 280

220     IF(OBJ.EQ.LIQLOC(LOC).OR.
     1  (ATHAND(BOTTLE).AND.LIQ(BOTTLE).EQ.OBJ).OR.
     2  (ATHAND(CASK).AND.LIQ(CASK).EQ.OBJ))GOTO 290
       IF(OBJ.NE.PLANT.OR..NOT.AT(PLANT2).OR.PROP(PLANT2).EQ.0)GOTO 230
       OBJ=PLANT2
       GOTO 290

230     IF(OBJ.NE.ROCKS.OR..NOT.AT(CARVNG))GOTO 240
       OBJ=CARVNG
       GOTO 290

240     IF(OBJ.NE.ROD.OR..NOT.ATHAND(ROD2))GOTO 250
       OBJ=ROD2
       GOTO 290

250     IF(OBJ.NE.DOOR.OR..NOT.
     1  (AT(SAFE).OR.AT(TDOOR).OR.AT(TDOOR2).OR.AT(PDOOR)))
     2  GOTO 260
       OBJ=TDOOR
       IF(AT(TDOOR2))OBJ=TDOOR2
       IF(AT(PDOOR))OBJ=PDOOR
       IF(AT(SAFE))OBJ=SAFE
       GOTO 290

260     IF(OBJ.NE.BOOK.OR..NOT.ATHAND(BOOK2))GOTO 270
       OBJ=BOOK2
       GOTO 290

270     IF(VERBS(VRBX).EQ.FIND.OR.VERBS(VRBX).EQ.INVENT)GOTO 290

C  IT ISN'T HERE.  TELL HIM & RETURN.
280     OBJ=0
       CALL A5TOA1(TXT(WDX,1),TXT(WDX,2),'_here.',ZAPP,K)
       WRITE(*,282)(ZAPP(I),I=1,K)
282     FORMAT(/' I see no ',20A1)

290     RETURN

       END





C***   GETWDS
       SUBROUTINE GETWDS

C  WHEN CALLED, CHECKS IF PREVIOUS WORDS VECTOR HAS BEEN EXHAUSTED.
C  IF NOT, BRANCH AROUND THE CODE WHICH READS IN A NEW LINE.  IF VECTOR IS EMPTY
C  SUCK UP A LINE FROM THE TTY, THEN CHECK EACH WORD FOR INTELLIGIBILITY.
C  IF THE WORD IS VALID, ITS NUMBER GETS STUCK INTO THE WORDS VECTOR.
C  THEN EACH WORD IS PARSED BY THE APPROPRIATE CODE.  THE LABELS BELOW ARE
C  100 TIMES THE WORD CLASS.
C
C  THE FOLLOWING VECTORS ARE USED:
C       TXT(WDX,2)              HOLD THE RAW TEXT FROM GETLIN
C       WORDS(WDX)              LIST OF WORD NUMBERS, CONVERTED FROM TXT(WDX,1).
C       VTXT(VRBX,2)            HOLD THE TEXT FOR VERB VRBX.
C       VERBS(VRBX)             IS THE LIST OF VALIDATED VERB NUMBERS.
C       OTXT(OBJX,2)            HOLDS THE TEXT OF THE OBJECT OBJX.
C       OBJX(OBJX)              IS THE LIST OF VALIDATED OBJECT NUMBERS.
C       IOTXT(IOBX,2)           HOLDS THE TEXT FOR PREP'S IOBJ.

       IMPLICIT INTEGER(A-Z)
       LOGICAL BLIND,LIVING,PCT,PFLAG,HINGED,AT,ATHAND,TOTING,K1,ISWIZ
       LOGICAL KILLED
      CHARACTER*6 WORD1,WORD2,DKK,DK
      CHARACTER ZAPP(20)

      COMMON/IZWIZ/ISWIZ
       COMMON /ADJCOM/ ADJKEY(50),ADJTAB(150),ADJSIZ
       COMMON /DIECOM/ NUMDIE,MAXDIE,TURNS,KILLED
       COMMON /DWFCOM/ DWARF,KNIFE,KNFLOC,DFLAG,DSEEN(6),DLOC(6),
     1  ODLOC(6),DWFMAX
       COMMON /LIQCOM/ BOTTLE,CASK,WATER,OIL,WINE,LIQTYP(5)
       COMMON /LOCCOM/ LOC,OLDLOC,OLDLC2,NEWLOC,MAXLOC
       COMMON /MNECOM/ BACK,CAVE,DPRSSN,ENTRNC,EXIT,GO,LOOK,NULL,
     1 AXE,BEAR,BOAT,BOOK,BOOK2,BOOTH,CARVNG,CHASM,CHASM2,DOOR,GNOME,
     2 GRATE,LAMP,PDOOR,PLANT,PLANT2,ROCKS,ROD,ROD2,SAFE,
     3 TDOOR,TDOOR2,TROLL,TROLL2,EMRALD,SPICES,
     4 FIND,YELL,INVENT,LEAVE,POUR,SAY,TAKE,THROW,
     5 IWEST,PHUCE(2,4),TK(20)
       COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150),
     1          FIXED(150),MAXOBJ
       COMMON /PRPCOM/ VKEY(60),PTAB(300),VKYSIZ,PTBSIZ
      CHARACTER*6 TXT,DTK(9),ATAB
       COMMON /UTXCOM/ WDX
      CHARACTER*6 VTXT,OTXT,IOTXT
       COMMON /WRDCOM/ VERBS(45),VRBX,OBJS(45),
     1  OBJX,IOBJS(15),IOBX,PREP,WORDS(45)
       DIMENSION TAKDIR(20)
       COMMON /SV3COM/DTK,ATAB(600),VTXT(45,2),OTXT(45,2),IOTXT(15,2)
     1      ,TXT(35,2)

C            MOTION  NOUN  ACTION  MISC   PREP   ADJ    CONJ
       DATA CLASSD,CLASSN,CLASSA,CLASSM,CLASSP,CLASSJ,CLASSC
     1 /1,2,3,4,5,6,7/
C
C  A FEW MORE ACTION VERBS NOT IN COMMON.
       DATA DROP,FEED,NOTHNG,LIGHT,DRINK,SCORE /02,21,05,07,15,24/
       DATA PICK,PUT,GET /41,42,44/
C
C  AND A MOTION VERB:
       DATA ENTER /3/
C
C  AND TO GET/DROP EVERYTHING IN SIGHT:
       DATA ALL /109/
C
C  TAKDIR IS A LIST OF MOTION VERBS WHICH ARE ACCEPTABLE AFTER 'TAKE'.
       DATA TAKDIR/2,6,9,10,11,13,14,17,23,25,33,34,
     1                  36,37,39,78,79,80,89,-1/
C
C  IF WORDS(WDX+1) HAS SOMETHING IN IT, WE ARE STILL PROCESSING OLD INPUT LINE.
C  IF WORDS(1) = -2, SOMEONE ELSE HAS CALLED GETLIN (E.G., KILL DRAGON).

       POUR = 13
       IF(WORDS(WDX+1).GT.0)GOTO 30

C  IF WORDS(1) HAS BEEN SET TO -2, SOMEONE ELSE HAS ALREADY READ IN
C  THE NEW LINE, PRESUMABLY TO CHECK FOR SOME NON-STANDARD WORD.
C  (THIS HAPPENS WHEN KILLING DRAGON WITH BARE HANDS.)
20      IF(WORDS(1).NE.-2)CALL GETLIN
       WDX=0
       DO 25 I=1,35
       WORDS(I)=0
       IF(TXT(I,1).NE.'      ')WORDS(I)=VOCABX(TXT(I,1),-1)
25      CONTINUE

C  THE FIRST WORD OF EACH CLAUSE GETS SPECIAL CHECKING, MOSTLY LOOKING
C  FOR IDIOMS.

C  SPECIAL HANDLING FOR 'SAY' AND 'CALL'.  WIN IF SAYING/CALLING
C  MAGIC WORDS.  NARKY IF UTTERING ANYTHING ELSE.  IF NO OBJ, PASS
C  ON FOR HIGHER LEVEL PARSING.
30      PFLAG=.FALSE.
       WDX=WDX+1
       WORD=WORDS(WDX)
       IF(WORD)830,800,32

32      KK=CLASS(WORD)
       IF(KK.EQ.-1)GOTO 91
       IF(KK.EQ.CLASSA.OR.KK.EQ.CLASSD.OR.KK.EQ.CLASSM)CALL CLRLIN
       K=VAL(WORD)
       IF(KK.NE.CLASSA.OR.(K.NE.SAY.AND.K.NE.YELL))GOTO 40

C  'SAY' OR 'CALL'.  IF NO NEXT WORD, PASS ON TO HIGHER POWERS.
C  IF OBJECT IS MAGIC WORD ('SAY XYZZY'), FLUSH 'SAY' & TAKE NEXT WORD.
       IF(WORDS(WDX+1).EQ.0.OR.CLASS(WORDS(WDX+1)).EQ.CLASSC)GOTO 99
       WDX=WDX+1
       IF(K.EQ.SAY)CALL A5TOA1(TXT(WDX,1),TXT(WDX,2),'".    ',ZAPP,K)
       IF(K.EQ.YELL)CALL A5TOA1(TXT(WDX,1),TXT(WDX,2),'"!!!!!',ZAPP,K)
       WORD=WORDS(WDX)
       IF(WORD.EQ.62.OR.WORD.EQ.65.OR.WORD.EQ.71.OR.WORD.EQ.82
     1  .OR.WORD.EQ.2025)GOTO 99
       WRITE(*,37)(ZAPP(I),I=1,K)
37      FORMAT(/' Okay, "',20A1)
       GOTO 860

C  SPECIAL STUFF FOR 'ENTER'.  CAN'T GO INTO WATER.
C  'ENTER BOAT' MEANS 'TAKE BOAT'.
40      WORD1=TXT(WDX,1)
       WORD2=TXT(WDX+1,1)
       IF(WORD1.NE.'ENTER ')GOTO 50
       IF(WORD2.EQ.'      ')GOTO 91
       SPK=43
       IF(LIQLOC(LOC).EQ.WATER)SPK=70
       IF(WORD2.EQ.'STREAM'.OR.WORD2.EQ.'WATER '.OR.WORD2.EQ.
     1  'RESERV'.OR.WORD2.EQ.'OCEAN '.OR.WORD2.EQ.'SEA   '
     2  .OR.WORD2.EQ.'POOL  ')GOTO 810
       IF(WORD2.NE.'BOAT  '.AND.WORD2.NE.'ROWBOA')GOTO 99
       WORD=TAKE+2000
       GOTO 99

C  'LEAVE' IS A MOTION VERB, UNLESS LEAVING AN OBJECT,
C  E.G., 'LEAVE BOAT' OR 'LEAVE BOTTLE'.  BUT MAKE SURE TO LEAVE ('DROP')
C  ONLY TOTABLE OBJECTS.
50      KK=WORDS(WDX+1)
       IF(WORD1.NE.'LEAVE '.OR.CLASS(KK).NE.CLASSN)
     1  GOTO 55
       IF(HINGED(VAL(KK)).OR.FIXED(VAL(KK)).NE.0)GOTO 99
       WORD=LEAVE+2000
       GOTO 99

C  IF 'LIGHT LAMP', LIGHT MUST BE TAKEN AS AN ACTION VERB, NOT A NOUN.
55      IF(WORD1.NE.'LIGHT'.OR.WORDS(WDX+1).NE.(LAMP+1000))GOTO 60
       WORD=LIGHT+2000
       GOTO 99

C  'WATER PLANT' BECOMES 'POUR WATER', IF WE ARE AT PLANT.
C  'OIL DOOR' BECOMES 'POUR OIL', ETC., ETC.
60      IF((WORD1.NE.'WATER '.AND.WORD1.NE.'OIL   ')
     1  .OR.(WORD2.NE.'PLANT '.AND.WORD2.NE.'DOOR  '
     2     .AND.WORD2.NE.'SWORD '.AND.WORD2.NE.'ANVIL '))GOTO 65
       IF(.NOT.AT(VOCABX(WORD2,CLASSN)))GOTO 61
       WORDS(WDX+1)=WORDS(WDX)
       TXT(WDX+1,1)=WORD1
       TXT(WDX+1,2)=TXT(WDX,2)
61      WORD=POUR+2000
       GOTO 99

C  CHECK FILLING OR EMPTYING A CONTAINER.
65      IF((WORD1.NE.'EMPTY ').OR.
     1  (CLASS(WORDS(WDX+1)).NE.CLASSN))GOTO 91
       KK=VAL(WORDS(WDX+1))
C      IF(KK.NE.SACK.AND.KK.NE.SAFE.AND.KK.NE.BOAT.AND.KK.NE.CHEST)
C    1  GOTO 91
C  *** UNFINISHED CODE HERE ***
C    ALL THAT ACTUALLY HAPPENS IS OFF ERROR MESSAGES. THE STOOGE
C    SIMPLY CAN'T SAY 'EMPTY SACK OR 'TAKE ALL FROM SACK' ETC
            GOTO 91


C  THIS IS THE 'INNER' LOOP.  DISPATCHING OF ALL WORDS IN A CLAUSE AFTER
C  THE FIRST COMES THRU HERE.

90      WDX=WDX+1
       WORD=WORDS(WDX)
91      IF(WORD)830,900,92

96      WCLASS=WCLASS+1
       WORD=VOCABX(TXT(WDX,1),-(WCLASS+1))
       IF(WORD.EQ.-1)GOTO 800
       WORDS(WDX)=WORD
92      IF(CLASS(WORD).NE.CLASSN)GOTO 99

C  IT'S NOT THE FIRST: MAKE SURE HE INCLUDED A COMMA OR 'AND'.
C  DIFFERENTIATE BETWEEN DIR & INDIR OBJECTS.
C  CHECK FOR SPECIAL CASE OF MULTIPLE OBJECTS: 'FEED BEAR HONEY' OR
C  'THROW TROLL NUGGET'.
       K=OBJX
       IF(PFLAG)K=IOBX
       IF(K.EQ.0.OR.CLASS(WORDS(WDX-1)).EQ.CLASSC)GOTO 99
       KK=VAL(VERBS(VRBX))
       IF(.NOT.LIVING(OBJS(OBJX)).OR.(KK.NE.THROW.AND.KK.NE.FEED))
     1  GOTO 800
       IOBX=IOBX+1
       IOBJS(IOBX)=OBJS(OBJX)
       OBJS(OBJX)=0
       OBJX=OBJX-1

99      WCLASS=CLASS(WORD)
       GOTO(100,200,300,400,500,600,700),WCLASS
C            MWD OBJ AVB MVB PRP ADJ CNJ
       CALL BUG(33)
C  MOTION VERB.
C  A MOTION VERB IS EITHER A DIRECTION ('WEST') OR A MOTION ('JUMP').
C  MULTIPLE MOTIONS MUST BE SEPARATED BY COMMAS OR AND'S.  THERE ARE
C  SOME IDIOMATIC USES WHICH MUST BE SCANNED FOR, SUCH AS 'TAKE BRIDGE',
C  WHICH BECOMES 'BRIDGE' AND 'GO WEST', WHICH BECOMES 'WEST', AND 'LEAVE THING'
C  IS DIFFERENT FROM JUST 'LEAVE'.
C
C  IF ORIGINAL VERB WAS 'GO', FLUSH IT & REPLACE WITH THIS ONE.
C  I.E., 'GO WEST' BECOMES 'WEST'.
C
C  CHECK TAKDIR(20) LIST FOR VALID OBJECT MOTION VERBS FOR 'TAKE'.
C  IF FOUND, THROW AWAY 'TAKE' AND USE THE MOTION VERB.
C
C  SINCE THE ORIGINAL VERB IS AN ACTION VERB, CHECK THIS WORD IN THE
C  NOUN TABLE.  MAYBE IT IS AN OBJECT SYNONYMOUS WITH A VERB ('ROCKS').
C
C  IF IT ISN'T A VALID MOTION-OBJECT OF 'TAKE' OR 'GO', NOR AN OBJECT,
C  CHECK THE PREP TABLE.  IF FOUND, HAND IT TO THE PREPOSITION ANALYZER.

100     IF(VRBX.EQ.0)GOTO 180
       K=VERBS(VRBX)
       IF(CLASS(K).GT.CLASSA)GOTO 800
       IF(CLASS(K).NE.CLASSA)GOTO 140
       IF(VAL(K).EQ.GO)GOTO 180

       IF(VAL(K).NE.TAKE)GOTO 96
       KK=VAL(WORD)
       DO 110 I=1,20
       IF(TAKDIR(I).EQ.KK)GOTO 180
110     CONTINUE
       GOTO 96

C  IF ORIGINAL MOTION VERB WAS CRAWL, JUMP OR CLIMB, IGNORE CURRENT WORD.
C  I.E., 'CLIMB UP' OR 'JUMP OVER' BECOME 'CLIMB' & 'JUMP' ONLY.
140     IF(K.EQ.17.OR.K.EQ.39.OR.K.EQ.56)GOTO 90
C            'CRAWL'     'JUMP'    'CLIMB'

180     VERBS(1)=WORD
       VRBX=1
       IF(TXT(WDX,1).NE.'WEST  ')GOTO 90
       IWEST=IWEST+1
       IF(IWEST.EQ.10)CALL RSPEAK(17)
       K=VAL(WORD)
       IF(K.EQ.EXIT.OR.K.EQ.ENTER)GOTO 860
       GOTO 90
C  ANALYZE OBJECT.
C  IF PFLAG IS TRUE, THEN WE ARE PROCESSING A SET OF INDIRECT (PREP)
C  OBJECTS, NOT DIRECT OBJS.

200     IF(PFLAG)GOTO 503
       IF(VRBX.NE.0)GOTO 220
       K=VOCABX(TXT(WDX,1),-(CLASSA+1))
       IF(K.EQ.-1)GOTO 220
       WORD=K
       GOTO 300

220     WORD=VAL(WORD)
       IF(WORD.EQ.ALL)GOTO 280
222     CALL GETOBJ(WORD)
       IF(WORD)230,860,240

C  IT WASN'T REALLY AN OBJECT.  GO SEE WHAT IT WAS.
230     WORD=-WORD
       GOTO 99

C  IT WAS REALLY AN OBJECT & IT IS HERE.
240     OBJX=OBJX+1
       OBJS(OBJX)=WORD
       OTXT(OBJX,1)=TXT(WDX,1)
       OTXT(OBJX,2)=TXT(WDX,2)
       GOTO 90

C  TAKE EVERYTHING NOT BATTENED DOWN.

280     KK=VAL(VERBS(VRBX))
       K1=.FALSE.
       IF(KK.EQ.DROP.OR.KK.EQ.PUT.OR.KK.EQ.LEAVE)GOTO 281
       K1=.TRUE.
       IF(KK.NE.TAKE.AND.KK.NE.PICK.AND.KK.NE.GET)GOTO 800
       SPK=357
       IF(BLIND(0))GOTO 810
281     DO 289 I=1,MAXOBJ
       IF(.NOT.ATHAND(I).OR.FIXED(I).NE.0)GOTO 289
       IF(I.GE.WATER.AND.I.LE.WINE+1)GOTO 289
       IF((K1.AND.TOTING(I)) .OR. (.NOT.K1.AND..NOT.TOTING(I)) )GOTO 289
       OBJX=OBJX+1
       OBJS(OBJX)=I
C       OTXT(OBJX,1)=NTXT(I,1)
C       OTXT(OBJX,2)=NTXT(I,2)
	OTXT(OBJX,1)='BUG???'
	OTXT(OBJX,2)='      '
       IF(OBJX.EQ.44)GOTO 90
289     CONTINUE
       GOTO 90
C  ACTION VERB.
300     IF(VRBX.EQ.0)GOTO 370
       IF(VAL(VERBS(VRBX)).NE.TAKE)GOTO 320
       K=VAL(WORD)
       IF(K.EQ.DRINK.OR.K.EQ.INVENT.OR.K.EQ.SCORE.OR.K.EQ.NOTHNG
     1  .OR.K.EQ.LOOK)GOTO 371
       IF(K.NE.GO)GOTO 800
       DK=TXT(WDX,1)
       IF(DK.EQ.'WALK  '.OR.DK.EQ.'RUN   '.OR.DK.EQ.'HIKE  ')
     1  GOTO 371
       GOTO 800

320     IF(OBJX.NE.0.OR.CLASS(WORDS(WDX-1)).NE.CLASSC)GOTO 800
370     VRBX=VRBX+1
371     VERBS(VRBX)=WORD
       VTXT(VRBX,1)=TXT(WDX,1)
       VTXT(VRBX,2)=TXT(WDX,2)
       GOTO 90


C  MISCELLANEOUS WORDS/VERBS.
400     IF(VRBX.NE.0)GOTO 800
       VERBS(1)=WORD
       VRBX=1
       GOTO 90
C  ANALYZE A PREPOSITION AND ITS OBJECT.  CHECK THAT PREP
C  IS VALID FOR THIS VERB, AND THEN CHECK THAT THE OBJECT IS VALID
C  FOR THIS PREPOSITION.  IF FIRST CHECK FAILS, SYNTAX IS MESSED
C  UP; IF SECOND PART FAILS, IT MAY MERELY BE AN IMPOSSIBLE ACT.

500     IF(CLASS(VERBS(VRBX)).NE.CLASSA.OR.IOBX.NE.0)GOTO 800
       IF(PFLAG)GOTO 503
       VRBKEY=VKEY(VAL(VERBS(VRBX)))
       IF(VRBKEY.EQ.0)GOTO 800
       PREP=VAL(WORD)
       PFLAG=.TRUE.
       WDX=WDX+1
       WORD=WORDS(WDX)
       IF(WORD.EQ.0)GOTO 510
       GOTO(800,503,800,800,800,600,510),CLASS(WORD)
       GOTO 840

503     WORD=VAL(WORD)
       IF(WORD.EQ.ALL)GOTO 510
504     CALL GETOBJ(WORD)
       IF(WORD)570,860,505

505     IOBX=IOBX+1
       IOBJS(IOBX)=WORD
       IOTXT(IOBX,1)=TXT(WDX,1)
       IOTXT(IOBX,2)=TXT(WDX,2)
510     KK=IABS(PTAB(VRBKEY)/1000)
       IF(KK.NE.PREP)GOTO 525

C  PREP IS VALID WITH THIS VERB.  NOW CHECK OBJECT OF PREP.
       IF(WORD.EQ.0.OR.CLASS(WORD).EQ.CLASSC)GOTO 530

C  AN OBJ FOLLOWS THE PREP.  SEE IF IT'S PLAUSIBLE.
520     KK=IABS((MOD(PTAB(VRBKEY),0001000)))
       IF(KK.EQ.WORD.AND.KK.EQ.ALL)GOTO 280
       IF(KK.EQ.WORD.OR.KK.EQ.999)GOTO 90
525     VRBKEY=VRBKEY+1
       IF(PTAB(VRBKEY-1).GE.0)GOTO 510
       GOTO 570

C  NO OBJ FOLLOWS PREP.  CHECK SPECIAL CASES.
530     PFLAG=.FALSE.
       WDX=WDX-1
       DK=TXT(WDX,1)
       DKK=VTXT(VRBX,1)
       IF((DK.NE.'ON    '.AND.DK.NE.'OFF   ').AND.
     1 (DKK.NE.'TURN  '.OR.OBJS(OBJX).NE.LAMP) .AND.
     2 (DKK.NE.'TAKE  '.AND.DKK.NE.'PUT   ') )GOTO 570
       IF((DK.EQ.'UP    '.AND.DKK.NE.'PICK  ').OR.
     1 (DK.EQ.'DOWN  '.AND.(DKK.NE.'PUT   '.AND.VERBS(VRBX).NE.THROW
     2 )))GOTO 570
       WDX=WDX+1
       WORD=WORDS(WDX)
       IF(WORD.EQ.0)GOTO 900
       IF(CLASS(WORD).NE.CLASSC)GOTO 800
       GOTO 91

C  YOU CAN'T DO THAT!!
570     SPK=NOWAY(0)
       GOTO 810
C  ADJECTIVE HANDLER.
C  SCARF THE NEXT WORD, MAKE SURE IT IS A VALID OBJECT FOR THIS ADJ.
C  THEN CALL GETOBJ TO SEE IF IT IS REALLY THERE, THEN LINK INTO OBJ
C  CODE.

600     ADJ=VAL(WORD)
       WDX=WDX+1
       WORD=WORDS(WDX)
       IF(WORD)840,640,605

605     IF(CLASS(WORD).EQ.CLASSC) GOTO 640
       IF(CLASS(WORD).NE.CLASSN) WORD=VOCABX(TXT(WDX,1),-(CLASSN+1))
       IF(WORD.EQ.-1.OR.CLASS(WORD).NE.CLASSN.OR.VAL(WORD).EQ.ALL)
     1  GOTO 800
       WORDS(WDX)=WORD
       KK=VAL(WORD)
       K=ADJKEY(ADJ)
610     IF(KK.EQ.IABS(ADJTAB(K)))GOTO 92
       IF(ADJTAB(K).LT.0)GOTO 800
       K=K+1
       GOTO 610

640     CALL A5TOA1(TXT(WDX-1,1),TXT(WDX-1,2),'_WHAT?',ZAPP,K)
       WRITE(*,642)(ZAPP(I),I=1,K)
642     FORMAT(1X, 20A1)
       GOTO 20


C  ANALYZE A CONJUNCTION.  MAY BE A COMMA OR AN EXPLICIT "AND".
C  LOOK AHEAD AT NEXT WORD.  IF IT IS AN ACTION VERB AND NO OBJECT
C  HAS YET BEEN SPECIFIED, PUT IT INTO THE VERB STACK.  IF IT IS
C  AN OBJECT, ADD IT TO THE PILE.
C  ELSE, BUMP BACK THE WORD POINTER, ASSUME END OF CLAUSE, AND
C  RETURN.
700     WDX=WDX+1
       WORD=WORDS(WDX)
       IF(WORD)840,800,710

710     GOTO(790,92,720,790,800,92,800),CLASS(WORD)

C  A NEW ACTION VERB FOLLOWS.  IF NO PREVIOUS VERB HAS BEEN TYPED,
C  HE LOSES.  IF PREVIOUS VERB IS NOT AN ACTION VERB, HE LOSES.
C  IF AN OBJ/IOBJ WAS SPECIFIED FOR PREV ACT VERB, HE LOSES.  ONLY
C  VALID SYNTAX IS: 'GET AND OPEN CAGE'.
720     IF(VRBX.NE.0.AND.CLASS(VERBS(VRBX)).EQ.CLASSA
     1  .AND.OBJX.EQ.0.AND.IOBX.EQ.0)GOTO 92
790     WDX=WDX-1
       GOTO 900
C  GEE, I DON'T UNDERSTAND.  FLUSH REST OF CURRENT CLAUSE, UP TO
C  EOL OR CONJUNCTION & CONTINUE.
800     SPK=CONFUZ(0)
810     CALL RSPEAK(SPK)
820     CALL CLRLIN
       GOTO 20

C  AN IRREGULAR WORD WAS TYPED IN BY USER.  CHECK FOR WIZARDRY.
830     CONTINUE

840     CONTINUE
841     IF(PCT(25))GOTO 850
       CALL A5TOA1(TXT(WDX,1),TXT(WDX,2),'.     ',ZAPP,K)
       WRITE(*,842)(ZAPP(I),I=1,K)
842     FORMAT(/' I don''t understand the word ',20A1)
       CALL CLRLIN
       GOTO 20

850     CALL A5TOA1(TXT(WDX,1),TXT(WDX,2),'?     ',ZAPP,K)
       WRITE(*,852)(ZAPP(I),I=1,K)
852     FORMAT(/' Mumble?  ',20A1)
       CALL CLRLIN
       GOTO 20


C  SCAN TO CONJ OR END OF LINE.
860     CALL CLRLIN
       PFLAG=.FALSE.
862     WDX=WDX+1
       IF(WORDS(WDX).EQ.0)GOTO 20
       IF(CLASS(WORDS(WDX)).EQ.CLASSC)GOTO 90
       GOTO 862

C  END OF CLAUSE.  WE APPEAR TO HAVE REACHED THE END OF A SENTENCE.
C  IT WAS TERMINATED EITHER BY CRLF OR A CONJUNCTION.  IF A CONJ,
C  THE CONJ ANALYZER CLAIMS  THAT THE NEXT WORDS ARE NOT PART OF
C  THIS CLAUSE.  DECIDE WHETHER OR NOT WE HAVE ENOUGH TO WORK WITH.
900     PFLAG=.FALSE.
       IF(VERBS(1).NE.0)GOTO 930
       IF(OBJS(1).EQ.0)GOTO 800
       IF(OBJS(2).NE.0)GOTO 920
       CALL A5TOA1(OTXT(1,1),OTXT(1,2),'?     ',ZAPP,K)
       WRITE(*,915)(ZAPP(I),I=1,K)
915     FORMAT(/' What do you want to do with the ',20A1)
       GOTO 20

920    WRITE(*,*)' What do you want to do with them'
       GOTO 20

930     IF(OBJX.GT.1.AND.IOBX.GT.1)GOTO 800
       RETURN

       END





C***  HERE   .TRUE. IF OBJ AT THIS LOCATION


       LOGICAL FUNCTION HERE(OBJ)

C  HERE(OBJ)    = TRUE IF THE OBJ IS AT "LOC" (OR IS BEING CARRIED)

       IMPLICIT INTEGER(A-Z)
       COMMON /LOCCOM/ LOC,OLDLOC,OLDLC2,NEWLOC,MAXLOC
       COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150),
     1          FIXED(150),MAXOBJ
       LOGICAL TOTING
       HERE = .FALSE.
       IF(OBJ.LT.1.OR.OBJ.GT.MAXOBJ)RETURN
       HERE=PLACE(OBJ).EQ.LOC.OR.TOTING(OBJ)
       RETURN
       END





C***  HINGED .TRUE. IF OBJ CAN BE OPENED


       LOGICAL FUNCTION HINGED(OBJ)

C  HINGED(OBJ)  = TRUE IF OBJECT CAN BE OPENED/SHUT.

       IMPLICIT INTEGER(A-Z)
       LOGICAL BITSET
       COMMON /CONCOM/ LOCCON(250),OBJCON(150)

      HINGED=BITSET(OBJCON(OBJ),1)

       RETURN
       END




C***  HOLDNG .TRUE. IF HOLDING OBJ


       LOGICAL FUNCTION HOLDNG(OBJ)

C  HOLDNG(OBJ)  = TRUE IF THE OBJ IS BEING CARRIED IN HAND.

       IMPLICIT INTEGER(A-Z)
       COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150),
     1          FIXED(150),MAXOBJ
       HOLDNG = .FALSE.
       IF(OBJ.LT.1.OR.OBJ.GT.MAXOBJ)RETURN
       HOLDNG=PLACE(OBJ).EQ.-1
       RETURN
       END







C***   INSERT

       SUBROUTINE INSERT(OBJECT,CONTNR)

       IMPLICIT INTEGER(A-Z)
       COMMON /HLDCOM/ HOLDER(150),HLINK(150)
       COMMON /LOCCOM/ LOC,OLDLOC,OLDLC2,NEWLOC,MAXLOC
       COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150),
     1          FIXED(150),MAXOBJ

       IF(CONTNR.EQ.OBJECT)CALL BUG(32)
       CALL CARRY(OBJECT,LOC)

       TEMP=HOLDER(CONTNR)
       HOLDER(CONTNR)=OBJECT
       HLINK(OBJECT)=TEMP
       PLACE(OBJECT)=-CONTNR
       RETURN

       END
C***   INSIDE .TRUE. IF LOCATION IS WELL WITHIN THE CAVE


       LOGICAL FUNCTION INSIDE(LOC)

C  INSIDE(LOC)  = TRUE IF LOCATION IS WELL WITHIN THE CAVE

       IMPLICIT INTEGER(A-Z)
       LOGICAL OUTSID,PORTAL
       INSIDE=.NOT.OUTSID(LOC).AND..NOT.PORTAL(LOC)
       RETURN
       END








C***   JUGGLE

       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(250),LINK(300),PLACE(150),
     1          FIXED(150),MAXOBJ

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



C***   LIQ


       INTEGER FUNCTION LIQ(OBJ)
       IMPLICIT INTEGER(A-Z)
       COMMON /LIQCOM/ BOTTLE,CASK,WATER,OIL,WINE,LIQTYP(5)
       COMMON /OBJCOM/ PLAC(150),FIXD(150),WEIGHT(150),PROP(150),
     1          POINTS(150)

C       LIQ=LIQ2(MAX0(PROP(OBJ),-1-PROP(OBJ)))
       LIQ = 0
       IF(OBJ.NE.BOTTLE.AND.OBJ.NE.CASK)RETURN
          IQ = MAX0(PROP(OBJ)+1,-1-(PROP(OBJ)+1))
          IF(IQ.LE.0)RETURN
          LIQ=LIQTYP(IQ)
       RETURN   
       END





C***   LIQ2
C  NON-LOGICAL (ILLOGICAL?) FUNCTIONS (CLASS,LIQ,LIQ2,LIQLOC,VAL)

       INTEGER FUNCTION LIQ2(PBOTL)
       IMPLICIT INTEGER(A-Z)
       COMMON /LIQCOM/ BOTTLE,CASK,WATER,OIL,WINE,LIQTYP(5)

       LIQ2=(1-PBOTL)*WATER+(PBOTL/2)*(WATER+OIL)+(PBOTL/4)
     1  *(WATER+WINE-2*OIL)
       RETURN
       END









C***   LIQLOC

       INTEGER FUNCTION LIQLOC(LOC)
       IMPLICIT INTEGER(A-Z)
       COMMON /LIQCOM/ BOTTLE,CASK,WATER,OIL,WINE,LIQTYP(5)
      INTEGER WRD(2)
       COMMON /CONCOM/ LOCCON(250),OBJCON(150)
      EQUIVALENCE (LOCCON,WRD)
C      CALL TOOCT(LOCCON(LOC))
C      CALL TOOCT(WRD(LOC*2))

       LIQLOC=LIQ2((MOD(LOCCON(LOC)/8,2)*(MOD(LOCCON(LOC)/2*2,16)-9)
     1  +1))

       RETURN
       END



C***  LIVING .TRUE. IF OBJ IS LIVING, BEAR FOR EXAMPLE


       LOGICAL FUNCTION LIVING(OBJ)

C  LIVING(OBJ)  = TRUE IF OBJ IS SOME SORT OF CRITTER

       IMPLICIT INTEGER(A-Z)
       LOGICAL BITSET
       COMMON /CONCOM/ LOCCON(250),OBJCON(150)

      LIVING=BITSET(OBJCON(OBJ),9)

       RETURN
       END




C***   LOCKED  .TRUE. IF LOCKABLE OBJ IS LOCKED

      LOGICAL FUNCTION LOCKED(OBJ)
      IMPLICIT INTEGER(A-Z)
      LOGICAL BITSET
      COMMON/CONCOM/LOCCON(250),OBJCON(150)
      LOCKED=BITSET(OBJCON(OBJ),4)
      RETURN
      END

C***   LOCKS  .TRUE. IF YOU CAN LOCK THIS OBJ

      LOGICAL FUNCTION LOCKS(OBJ)
      IMPLICIT INTEGER(A-Z)
      LOGICAL BITSET
      COMMON/CONCOM/LOCCON(250),OBJCON(150)
      LOCKS=BITSET(OBJCON(OBJ),3)
      RETURN
      END






C***   LOOKIN

       SUBROUTINE LOOKIN(CONTNR)

C  LIST CONTENTS IF OBJ IS A CONTAINER AND IS OPEN OR TRANSPARENT.
C  SAVE INITIAL VALUE OF BLKLIN THRU SUBROUTINE.

       IMPLICIT INTEGER(A-Z)
       COMMON /BLKCOM/ BLKLIN
       COMMON /HLDCOM/ HOLDER(150),HLINK(150)
       LOGICAL VESSEL,AJAR,OPAQUE,BLKLIN,BSAVE
       DIMENSION TK(20)

       IF(.NOT.VESSEL(CONTNR).OR.
     1  (.NOT.AJAR(CONTNR).AND.OPAQUE(CONTNR)) )RETURN
       TEMP=HOLDER(CONTNR)
       LOOP=0
       BSAVE=BLKLIN
20      IF(TEMP.EQ.0)RETURN
       BLKLIN=.FALSE.
       IF(LOOP.EQ.0)CALL RSPEAK(360)
       CALL TNOUA
       CALL PSPEAK(TEMP,-1)
       BLKLIN=BSAVE
       TEMP=HLINK(TEMP)
       LOOP=-1
       GOTO 20

       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(250),LINK(300),PLACE(150),
     1          FIXED(150),MAXOBJ
      LOGICAL ENCLSD

       IF(OBJECT.GT.MAXOBJ)THEN
              FROM=FIXED(OBJECT-MAXOBJ)
       ELSE
              IF(ENCLSD(OBJECT))CALL REMOVE(OBJECT)
              FROM=PLACE(OBJECT)
       ENDIF
       IF(FROM.GT.0.AND.FROM.LE.MAXOBJ*2)CALL CARRY(OBJECT,FROM)
       CALL DROP(OBJECT,WHERE)
       RETURN
       END






C***   NOWAY


       INTEGER FUNCTION NOWAY(DUMMY)

C  GENERATE'S SOME VARIANT OF "CAN'T DO THAT" MESSAGE.

       IMPLICIT INTEGER(A-Z)
      LOGICAL PCT

       NOWAY=14
       IF(PCT(50))NOWAY=110
       IF(PCT(33))NOWAY=147
       IF(PCT(25))NOWAY=250
       IF(PCT(20))NOWAY=262
       IF(PCT(17))NOWAY=25
       IF(PCT(14))NOWAY=345
       IF(PCT(12))NOWAY=346
       RETURN
       END






C***  OPAQUE .TRUE. IF OBJ IS NON-TRANSPARENT CONTAINER


       LOGICAL FUNCTION OPAQUE(OBJ)

C  OPAQUE(OBJ)  = TRUE IF OBJECT IS NOT TRANSPARENT.  E.G., BAG & CHEST ARE OPAQ
C                 WICKER CAGE & GLASS BOTTLE ARE TRANSPARENT.

       IMPLICIT INTEGER(A-Z)
       LOGICAL BITSET
       COMMON /CONCOM/ LOCCON(250),OBJCON(150)

      OPAQUE=BITSET(OBJCON(OBJ),6)

       RETURN
       END

C***   OUTSID .TRUE. IF LOCATION IS OUTSIDE THE CAVE


       LOGICAL FUNCTION OUTSID(LOC)

C  OUTSID(LOC)  = TRUE IF LOCATION IS OUTSIDE THE CAVE

       IMPLICIT INTEGER(A-Z)
       LOGICAL BITSET
       COMMON /CONCOM/ LOCCON(250),OBJCON(150)

       OUTSID=BITSET(LOCCON(LOC),6)

       RETURN
       END




C***   PCT


      LOGICAL FUNCTION PCT(N)

C  PCT(N)       = TRUE N% OF THE TIME (N INTEGER FROM 0 TO 100)

       IMPLICIT INTEGER(A-Z)
       PCT=RANZ(100).LT.N
       RETURN
       END






C***  PLURAL .TRUE. IF OBJ IS MULTIPLE OBJS


       LOGICAL FUNCTION PLURAL(OBJ)

C  PLURAL(OBJ)  = TRUE IF OBJECT IS A "BUNCH" OF THINGS (COINS, SHOES).

       IMPLICIT INTEGER(A-Z)
       LOGICAL BITSET
       COMMON /CONCOM/ LOCCON(250),OBJCON(150)

      PLURAL=BITSET(OBJCON(OBJ),13)

       RETURN
       END






C***   PORTAL .TRUE. IF LOCATION IS IN CAVE ENTRANCE


       LOGICAL FUNCTION PORTAL(LOC)

C  PORTAL(LOC)  = TRUE IS LOCATION IS IN CAVE "ENTRANCE"

       IMPLICIT INTEGER(A-Z)
       LOGICAL BITSET
       COMMON /CONCOM/ LOCCON(250),OBJCON(150)

       PORTAL=BITSET(LOCCON(LOC),5)

       RETURN
       END




C***  PRINTD .TRUE. IF OBJ CAN BE READ


       LOGICAL FUNCTION PRINTD(OBJ)

C  PRINTD(OBJ)  = TRUE IF OBJECT CAN BE READ.

       IMPLICIT INTEGER(A-Z)
       LOGICAL BITSET
       COMMON /CONCOM/ LOCCON(250),OBJCON(150)

      PRINTD=BITSET(OBJCON(OBJ),8)

       RETURN
       END




C***   PSPEAK



       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/ LINES(25000),RTEXT(450),PTEXT(150)

       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







C***   PUT



       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




C***   RANZ
C  UTILITY ROUTINES (SHIFT, RAN, DATIME, CIAO, BUG, LOG)

        INTEGER FUNCTION RANZ(RANGE)
        IMPLICIT INTEGER (A-Z)
        SAVE
        DATA SEED/12345/
        SEED = SEED*69069+1
        I = 16384/RANGE
        J = IABS(SEED)/I
        RANZ = MOD(J,RANGE)
        RETURN
        END



C***   RATING

       SUBROUTINE RATING(SCORE,BONUS,GAVEUP,SCORNG,CLOSNG,CLOSED
     1    ,HNTMAX)

C  CALCULATE WHAT THE PLAYER'S SCORE WOULD BE IF HE QUIT NOW.
C  THIS MAY BE THE END OF THE GAME, OR HE MAY JUST BE WONDERING
C  HOW HE IS DOING.  

       IMPLICIT INTEGER(A-Z)
       LOGICAL TREASR,GAVEUP,CLOSNG,CLOSED,SCORNG,HINTED,KILLED
       COMMON /MNECOM/ BACK,CAVE,DPRSSN,ENTRNC,EXIT,GO,LOOK,NULL,
     1 AXE,BEAR,BOAT,BOOK,BOOK2,BOOTH,CARVNG,CHASM,CHASM2,DOOR,GNOME,
     2 GRATE,LAMP,PDOOR,PLANT,PLANT2,ROCKS,ROD,ROD2,SAFE,
     3 TDOOR,TDOOR2,TROLL,TROLL2,EMRALD,SPICES,
     4 FIND,YELL,INVENT,LEAVE,POUR,SAY,TAKE,THROW,
     5 IWEST,PHUCE(2,4),TK(20)
       COMMON /DIECOM/ NUMDIE,MAXDIE,TURNS,KILLED
       COMMON /DWFCOM/ DWARF,KNIFE,KNFLOC,DFLAG,DSEEN(6),DLOC(6),
     1  ODLOC(6),DWFMAX
       COMMON /HNTCOM/ HINTLC(20),HINTED(20),HINTS(20,4),HNTSIZ,HNTMIN
       COMMON /OBJCOM/ PLAC(150),FIXD(150),WEIGHT(150),PROP(150),
     1          POINTS(150)
       COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150),
     1          FIXED(150),MAXOBJ
       COMMON /SV2COM/ANVIL,BATTER,BEES,BILLBD,BIRD,BRUSH,CAGE,
     1   CAKES,CHAIN,CHEST,CHLOC,CHLOC2,CLAM,CLOAK,CLSSES,COINS,CROWN,
     2   DALTLC,DOG,DRAGON,EGGS,FISSUR,FLOWER,GATLOC,GRAIL,HIVE,
     3   HONEY,HORN,JEWELS,KEYS,LYRE,
     4   MAGZIN,MIRROR,MUSHRM,MXSCOR,NUGGET,OYSTER,PEARL,PHONE,
     5   PILLOW,POLE,POSTER,PREPAT,PREPDN,PREPFR,PREPIN,PREPOF,
     6   PREPON,PYRAM,RADIUM,RING,RUG,SAPPHI,SHIELD,SHOES,
     7   SHUT,SLUGS,SNAKE,SPHERE,STEPS,STICKS,SWORD,TABLET,TRIDNT,
     8   UNLOCK,VASE,WALL,WALL2,WEAR,WUMPUS,Y2,YANK

       DIMENSION QK(20)

C  THE PRESENT SCORING ALGORITHM IS AS FOLLOWS:
C  (TREASURE POINTS ARE EXPLAINED IN A FOLLOWING COMMENT)
C     OBJECTIVE:          POINTS:        PRESENT TOTAL POSSIBLE:
C  GETTING WELL INTO CAVE   25                    25
C  TOTAL POSSIBLE FOR TREASURES (+MAG)           426
C  SURVIVING             (MAX-NUM)*10             30
C  NOT QUITTING              4                     4
C  REACHING "CLOSNG"        20                    20
C  "CLOSED": QUIT/KILLED    10
C            KLUTZED        20
C            WRONG WAY      25
C            SUCCESS        30                    30
C  ROUND OUT THE TOTAL      16                    16
C                                       TOTAL:   551
C  (POINTS CAN ALSO BE DEDUCTED FOR USING HINTS.)

       SCORE=0
       MXSCOR=0

C  FIRST TALLY UP THE TREASURES.  MUST BE IN BUILDING AND NOT BROKEN.
C  GIVE THE POOR GUY PARTIAL SCORE JUST FOR FINDING EACH TREASURE.
C  GETS FULL SCORE, QK(3), FOR OBJ IF:
C       OBJ IS AT LOC QK(1), AND
C       OBJ HAS PROP VALUE OF QK(2)
C
C               WEIGHT          TOTAL POSSIBLE
C  MAGAZINE     1 (ABSOLUTE)            1
C
C  ALL THE FOLLOWING ARE MULTIPLIED BY 5 (RANGE 5-25):
C  BOOK         2
C  CASK         3 (WITH WINE ONLY)
C  CHAIN        4 (MUST ENTER VIA STYX)
C  CHEST        5
C  CLOAK        3
C  CLOVER       1
C  COINS        5
C  CROWN        2
C  CRYSTAL-BALL 2
C  DIAMONDS     2
C  EGGS         3
C  EMERALD      3
C  GRAIL        2
C  HORN         2
C  JEWELS       1
C  LYRE         1
C  NUGGET       2
C  PEARL        4
C  PYRAMID      4
C  RADIUM       4
C  RING         4
C  RUG          3
C  SAPPHIRE     1
C  SHOES        3
C  SPICES       1
C  SWORD        4
C  TRIDENT      2
C  VASE         2
C  DROPLET      5
C  TREE         5
C       TOTAL: 85 * 5 = 425 + 1 ==> 426

       DO 1010 OBJ=1,MAXOBJ
       IF(POINTS(OBJ).EQ.0)GOTO 1010
	QK(3)=IABS(POINTS(OBJ))/1000000
	QK(2)=(IABS(POINTS(OBJ))-QK(3)*1000000)/1000
	QK(1)=IABS(POINTS(OBJ))-QK(3)*1000000-QK(2)*1000
       IF(POINTS(OBJ).LT.0) QK(1)=-QK(1)
       K=0
       IF(.NOT.TREASR(OBJ))GOTO 1007
       K=QK(3)*2
       IF(PROP(OBJ).GE.0)SCORE=SCORE+K
       QK(3)=QK(3)*5
1007    IF(PLACE(OBJ).EQ.QK(1).AND.PROP(OBJ).EQ.QK(2).AND.
     1  (PLACE(OBJ).NE.-CHEST.OR.PLACE(CHEST).EQ.3).AND.
     2  (PLACE(OBJ).NE.-SHIELD.OR.PLACE(SHIELD).EQ.-SAFE))
     3  SCORE=SCORE+QK(3)-K
       MXSCOR=MXSCOR+QK(3)
1010    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).

       ASCORE=(MAXDIE-NUMDIE)*10
       MXSCOR=MXSCOR+MAXDIE*10
       IF(.NOT.(SCORNG.OR.GAVEUP))ASCORE=ASCORE+4
       MXSCOR=MXSCOR+4
       IF(DFLAG.NE.0)ASCORE=ASCORE+25
       MXSCOR=MXSCOR+25
       IF(CLOSNG)ASCORE=ASCORE+20
       MXSCOR=MXSCOR+20
       IF(.NOT.CLOSED)GOTO 1020
       IF(BONUS.EQ.0)ASCORE=ASCORE+10
       IF(BONUS.EQ.135)ASCORE=ASCORE+20
       IF(BONUS.EQ.134)ASCORE=ASCORE+25
       IF(BONUS.EQ.133)ASCORE=ASCORE+30
1020    MXSCOR=MXSCOR+30
C  ROUND IT OFF.

       ASCORE=ASCORE+16
       MXSCOR=MXSCOR+16

C  DEDUCT POINTS FOR HINTS.  HINTS < HNTMIN ARE SPECIAL; SEE DATABASE DESCRIPTIO

       DO 1030 I=1,HNTMAX
1030    IF(HINTED(I))SCORE=SCORE-HINTS(I,2)
       JTURNS=TURNS/100
	IF(JTURNS.EQ.0)ASCORE=0
        IF(JTURNS.EQ.1)ASCORE=ASCORE/3
        IF(JTURNS.EQ.2)ASCORE=(ASCORE*2)/3
        SCORE=SCORE+ASCORE
        IF(SCORE.LT.0) SCORE=0
	RETURN
       END




C***   REMOVE


       SUBROUTINE REMOVE(OBJECT)

       IMPLICIT INTEGER(A-Z)
       COMMON /HLDCOM/ HOLDER(150),HLINK(150)
       COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150),
     1          FIXED(150),MAXOBJ

       CONTNR=-PLACE(OBJECT)
       PLACE(OBJECT)=-1

       IF(HOLDER(CONTNR).NE.OBJECT)GOTO 1
       HOLDER(CONTNR)=HLINK(OBJECT)
       RETURN

1       TEMP=HOLDER(CONTNR)
2       IF(HLINK(TEMP).EQ.OBJECT)GOTO 3
       TEMP=HLINK(TEMP)
       GOTO 2

3       HLINK(TEMP)=HLINK(OBJECT)
       RETURN
       END





C***   RSPEAK

       SUBROUTINE RSPEAK(I)

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

       IMPLICIT INTEGER(A-Z)
       COMMON /TXTCOM/ LINES(25000),RTEXT(450),PTEXT(150)

       IF(I.LE.0)RETURN
       M=RTEXT(I)
       CALL SPEAK(M)
       RETURN
       END





C***   SMALL  .TRUE. IF IT FITS IN SACK OR SMALL CONTAINER

      LOGICAL FUNCTION SMALL(OBJ)
      IMPLICIT INTEGER(A-Z)
      LOGICAL BITSET
      COMMON/CONCOM/LOCCON(250),OBJCON(150)
      SMALL=BITSET(OBJCON(OBJ),5)
      RETURN
      END



C***   SPEAK

       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 /TNOUX/INDENT
       COMMON /TXTCOM/ LINES(25000),RTEXT(450),PTEXT(150)
       COMMON /BLKCOM/ BLKLIN
       DIMENSION OLINE(30)
C	DATA ZCLYD/'CLYD'/,ZLS/'<$$<'/
C        ZCLYD = 0
C       ZCLYD = 37+256*(9+256*(20+256*15))
       ZCLYD =    ICHAR('c')+256*(ICHAR('L')+ 256*(ICHAR('y')
     1     +256*ICHAR('D')))
       ZLS = 60+256*(36+256*(36+256*60))
	XCLYD=IEOR(ZCLYD,ZLS)
100    IF(N.EQ.0)GOTO 145
      IF(LINES(N+1).EQ.XCLYD)GOTO 4
       K=N
1      CONTINUE
        L=IABS(LINES(K))-K-1
       DO 2 I=1,L
2     OLINE(I)=IEOR(LINES(K+I),ZCLYD)
       IF(INDENT.EQ.0)WRITE(*,3) (OLINE(I),I=1,L)
	IF(INDENT.EQ.1)WRITE(*,133)(OLINE(I),I=1,L)
133	FORMAT(6X,19A4)
3       FORMAT(' ',19A4)
       K=K+L+1
       IF(LINES(K).GE.0)GOTO 1
4      CONTINUE
145	INDENT=0
      RETURN
       END


C       A HORRIBLE KLUDGE
	SUBROUTINE TNOUA
	INTEGER INDENT
	COMMON /TNOUX/INDENT
	INDENT=1
	RETURN
	END



C***  TOTING .TRUE. IF OBJ SOMEWHERE ON PERSON


       LOGICAL FUNCTION TOTING(OBJ)

C  TOTING(OBJ)  = TRUE IF THE OBJ IS BEING CARRIED (IN HAND OR
C                 CONTAINER).  OBJ MAY NOT BE REACHABLE.  SEE
C                 ALSO: ENCLSD, ATHAND, HOLDNG.

       IMPLICIT INTEGER(A-Z)
       COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150),
     1          FIXED(150),MAXOBJ
       LOGICAL HOLDNG,ENCLSD,AAA,BBB,CCC


  
       TOTING = .FALSE.
       IF(HOLDNG(OBJ))THEN
          TOTING = .TRUE.
          RETURN
       ENDIF
       CONTNR=-PLACE(OBJ)
       IF(CONTNR.LE.0)RETURN
       IF(HOLDNG(CONTNR))THEN
          TOTING = .TRUE.
          RETURN
       ENDIF
       OUTER=-PLACE(CONTNR)
       IF(OUTER.LE.0)RETURN
       IF(HOLDNG(OUTER))THEN
          TOTING = .TRUE.
          RETURN
       ENDIF
       OUTER2=-PLACE(OUTER)
       IF(OUTER2.LE.0)RETURN
       IF(HOLDNG(OUTER2))THEN
          TOTING = .TRUE.
          RETURN
       ENDIF
       RETURN

       END





C***   TRAVL
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.)

       SUBROUTINE TRAVL(K,BCROSS,TALLY2)
       IMPLICIT INTEGER(A-Z)

       LOGICAL KILLED,PCT,HOLDNG,ENCLSD
       LOGICAL INSIDE,OUTSID,PORTAL,TOTING,HERE,AT,FORCED

       COMMON /DIECOM/ NUMDIE,MAXDIE,TURNS,KILLED
       COMMON /TRVCOM/ TRAVEL(1600)
       COMMON /LTXCOM/ LTEXT(250),STEXT(250),KEY(250),ABB(250),LOCSIZ
       COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150),
     1          FIXED(150),MAXOBJ
       COMMON /OBJCOM/ PLAC(150),FIXD(150),WEIGHT(150),PROP(150),
     1          POINTS(150)
       COMMON /LOCCOM/ LOC,OLDLOC,OLDLC2,NEWLOC,MAXLOC
       COMMON /MNECOM/ BACK,CAVE,DPRSSN,ENTRNC,EXIT,GO,LOOK,NULL,
     1 AXE,BEAR,BOAT,BOOK,BOOK2,BOOTH,CARVNG,CHASM,CHASM2,DOOR,GNOME,
     2 GRATE,LAMP,PDOOR,PLANT,PLANT2,ROCKS,ROD,ROD2,SAFE,
     3 TDOOR,TDOOR2,TROLL,TROLL2,EMRALD,SPICES,
     4 FIND,YELL,INVENT,LEAVE,POUR,SAY,TAKE,THROW,
     5 IWEST,PHUCE(2,4),TK(20)

       KILLED=.FALSE.
       KK=KEY(LOC)
       NEWLOC=LOC
       IF(KK.EQ.0)CALL BUG(26)
       IF(K.EQ.NULL)RETURN
       IF(K.EQ.BACK)GOTO 20
       IF(K.EQ.CAVE)GOTO 40
       OLDLC2=OLDLOC
       OLDLOC=LOC

9       LL=IABS(TRAVEL(KK))
       IF(MOD(LL,0001000).EQ.1.OR.MOD(LL,0001000).EQ.K)
     1  GOTO 10
       IF(TRAVEL(KK).LT.0000000)GOTO 50
       KK=KK+1
       GOTO 9

10      LL=LL/0001000
11    NEWLOC=LL/0001000
       K=MOD(NEWLOC,100)
       IF(NEWLOC.LE.MAXLOC)GOTO 13
       IF(PROP(K).NE.NEWLOC/100-3)GOTO 16
12      IF(TRAVEL(KK).LT.0)CALL BUG(25)
       KK=KK+1
       NEW1=IABS(TRAVEL(KK))/1000
       IF(NEW1.EQ.LL)GOTO 12
       LL=NEW1
       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.MAXLOC)GO TO 2000
       IF(NEWLOC.LE.500)GOTO 30000
       CALL RSPEAK(NEWLOC-500)
       NEWLOC=LOC
       RETURN
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)
       GO TO 2000

21      LL=MOD((IABS(TRAVEL(KK))/1000),1000)
       IF(LL.EQ.K)GOTO 25
       IF(LL.GT.MAXLOC)GOTO 22
       J=KEY(LL)
       IF(FORCED(LL).AND.MOD((IABS(TRAVEL(J))/1000),1000).EQ.K)
     1  K2=KK
22      IF(TRAVEL(KK).LT.000000)GOTO 23
       KK=KK+1
       GOTO 21

23      KK=K2
       IF(KK.NE.0)GOTO 25
       CALL RSPEAK(140)
2000    IF(NEWLOC.LT.242.OR.NEWLOC.GT.247)RETURN
       IF(NEWLOC.NE.242)GOTO 2010
       KALFLG=0
       RETURN
2010   IF(NEWLOC.NE.OLDLOC+1)GOTO 2020
       KALFLG=KALFLG+1
       RETURN
2020   KALFLG=-10
       RETURN

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

C  CAVE.  DIFFERENT MESSAGES DEPENDING ON WHETHER ABOVE GROUND.

40      IF(OUTSID(LOC))CALL RSPEAK(57)
       IF(.NOT.OUTSID(LOC))CALL RSPEAK(58)
       RETURN

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(K.EQ.62.OR.K.EQ.65.OR.K.EQ.82)SPK=42
       IF(K.EQ.17)SPK=80
       CALL RSPEAK(SPK)
       RETURN
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-MAXLOC
       GOTO (30100,30200,30300,30400,30500,30600,30700),NEWLOC
C             ALCOV PLOVR TROLL PHUCE BOOTH BRDGE
      WRITE(*,1001)NEWLOC
1001  FORMAT('BUG IN TRAVEL TABLES.  NEWLOC= ',I5)
       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
       KK=BURDEN(0)
       IF(KK.EQ.0.OR.(KK.EQ.BURDEN(EMRALD).AND.HOLDNG(EMRALD)))RETURN
       NEWLOC=LOC
       CALL RSPEAK(117)
       RETURN

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   IF(ENCLSD(EMRALD))CALL REMOVE(EMRALD)
       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+MAXOBJ,0)
       CALL MOVE(TROLL,PLAC(TROLL))
       CALL MOVE(TROLL+MAXOBJ,FIXD(TROLL))
       CALL JUGGLE(CHASM)
       NEWLOC=LOC
       RETURN

30310   NEWLOC=PLAC(TROLL)+FIXD(TROLL)-LOC
       IF(PROP(TROLL).EQ.0)PROP(TROLL)=1
       IF(.NOT.HOLDNG(BEAR))RETURN
       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
       KILLED=.TRUE.
       RETURN
C  TRAVEL 304.  GROWING OR SHRINKING IN AREA OF TINY DOOR.  EACH TIME
C  HE DOES THIS, EVERYTHING MUST BE MOVED TO THE NEW LOC.  PRESUMABLY,
C  ALL HIS POSSESIONS ARE SHRUNK OR STRECHED ALONG WITH HIM.
C  PHUCE(2,4) IS AN ARRAY CONTAINING FOUR PAIRS OF "HERE" (K) AND
C  "THERE" (KK) LOCATIONS.

30400   K=PHUCE(1,LOC-161+1)
       NEWLOC=PHUCE(2,LOC-161+1)
       DO 30410 OBJ=1,MAXOBJ
       IF(OBJ.EQ.BOAT)GOTO 30410
       IF(PLACE(OBJ).EQ.K.AND.(FIXED(OBJ).EQ.0.OR.FIXED(OBJ).EQ.-1))
     1  CALL MOVE(OBJ,NEWLOC)
30410   CONTINUE
       RETURN

C  TRAVEL #5.  PHONE BOOTH IN ROTUNDA.
C  TRYING TO SHOVE PAST GNOME, TO GET INTO PHONE BOOTH.

30500   IF((PROP(BOOTH).EQ.0.AND.PCT(55)).OR.ABB(LOC).EQ.1)GOTO 30510
       NEWLOC=189
       IF(PROP(BOOTH).NE.1)RETURN
       CALL RSPEAK(253)
       GOTO 30512

30510   CALL RSPEAK(263)
       PROP(BOOTH)=1
       CALL MOVE(GNOME,188)
30512   NEWLOC=LOC
       RETURN

C  TRAVEL #6.  COLLAPSING CLAY BRIDGE.  HE CAN CROSS WITH THREE (OR FEWER)
C  THINGS.  IF MORE, OR IF CARRYING OBVIOUSLY HEAVY THINGS, HE MAY END UP
C  IN THE DRINK.

30600   NEWLOC=235
       IF(LOC.EQ.235)NEWLOC=190
       BCROSS=BCROSS+1
       KK=BURDEN(0)
       IF(KK.LE.4)RETURN
       K=MAX0( ((KK+BCROSS)**2)/10, 10)
30605   IF(PCT(K))GOTO 30610
       CALL RSPEAK(318)
       RETURN

30610   CALL RSPEAK(319)
       NEWLOC=236
       IF(HOLDNG(LAMP))CALL MOVE(LAMP,236)
       IF(TOTING(AXE).AND.ENCLSD(AXE))CALL REMOVE(AXE)
       IF(HOLDNG(AXE))CALL MOVE(AXE,208)
       DO 30620 OBJ=1,MAXOBJ
30620   IF(TOTING(OBJ))CALL DSTROY(OBJ)
       PROP(CHASM2)=1
       RETURN
C      THE KALEIDOSCOPE CODE IS HERE
30700       IF(KALFLG.NE.5)GOTO 30701
	NEWLOC=248
       OLDLOC=247
       RETURN
30701    NEWLOC=242+RANZ(5)
	OLDLOC=NEWLOC-1
	CALL RSPEAK(406)
	KALFLG=-10
        IF(NEWLOC.EQ.242)KALFLG=0
	RETURN

C  END OF SPECIALS.

       END


C***  TREASR .TRUE. IF OBJ IS VALUABLE FOR POINTS


       LOGICAL FUNCTION TREASR(OBJ)

C  TREASR(OBJ)  = TRUE IF OBJECT IS A TREASURE

       IMPLICIT INTEGER(A-Z)
       LOGICAL BITSET
       COMMON /CONCOM/ LOCCON(250),OBJCON(150)

       TREASR=BITSET(OBJCON(OBJ),14)

       RETURN
       END







C***   VAL


       INTEGER FUNCTION VAL(WORD)

C  RETURNS THE 'VALUE' OF A WORD, MODULO 1000.

       IMPLICIT INTEGER(A-Z)
       VAL=MOD(WORD,1000)
       RETURN
       END




C***  VESSEL .TRUE. IF OBJ CAN HOLD A LIQUID


       LOGICAL FUNCTION VESSEL(OBJ)

C  VESSEL(OBJ)  = TRUE IF OBJECT IS A CONTAINER

       IMPLICIT INTEGER(A-Z)
       LOGICAL BITSET
       COMMON /CONCOM/ LOCCON(250),OBJCON(150)

       VESSEL=BITSET(OBJCON(OBJ),15)

       RETURN
       END





C***   VOCABX


       INTEGER FUNCTION VOCABX(ID,INIT)

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

       IMPLICIT INTEGER(A-Z)
      CHARACTER*6 ATAB,DTK,ID,VTXT,OTXT,IOTXT,TXT
       COMMON /VOCCOM/ KTAB(600),TABSIZ
       COMMON /SV3COM/DTK(9),ATAB(600),VTXT(45,2),OTXT(45,2),IOTXT(15,2)
     1      ,TXT(35,2)

C       HASH=ID.XOR.'PHROG'             (DONE BY CALLER)
       WDCLAS=INIT
       IF(INIT.LT.0)WDCLAS=-INIT-1
       DO 1 I=1,TABSIZ
       IF(KTAB(I).EQ.-1)GOTO 2
       IF(ATAB(I).NE.ID)GOTO 1
       IF(CLASS(KTAB(I)).GE.WDCLAS)GOTO 3
1       CONTINUE
       CALL BUG(21)

2       VOCABX=-1
       IF(INIT.LT.0)RETURN
       WRITE(*,4)ID
4       FORMAT (' VOCAB ERROR: CAN''T FIND WORD ''',A5,''' IN TABLE.')
       CALL BUG(5)

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



C***  WEARNG .TRUE. IF WEARING OBJ


       LOGICAL FUNCTION WEARNG(OBJ)

C  WEARNG(OBJ)  = TRUE IF THE OBJ IS BEING WORN

       IMPLICIT INTEGER(A-Z)
       COMMON /BITCOM/ OPENBT,UNLKBT,BURNBT,WEARBT
       COMMON /CONCOM/ LOCCON(250),OBJCON(150)
      LOGICAL BITSET

       WEARNG=BITSET(OBJCON(OBJ),WEARBT)
       RETURN
       END





C***   WORN  .TRUE. IF OBJ IS BEING WORN

      LOGICAL FUNCTION WORN(OBJ)
      IMPLICIT INTEGER(A-Z)
      LOGICAL BITSET
      COMMON/CONCOM/LOCCON(250),OBJCON(150)
      WORN=BITSET(OBJCON(OBJ),11)
      RETURN
      END




C***   YES



       LOGICAL FUNCTION YES(X,Y,Z)

C  PRINT MESSAGE X, WAIT FOR YES/NO ANSWER.  

       IMPLICIT INTEGER(A-Z)
      CHARACTER*6 REPLY

1       IF(X.NE.0)CALL RSPEAK(X)
        WRITE(*,338)
C338    FORMAT(/,' >')
C??????????????? THE FOLLOWING WORKS BETTER ON VAXES, ETC:
338    FORMAT(/,' >',$)
       READ(*,30)REPLY
30     FORMAT(A6)
       DO 2 I=1,6
       IF(REPLY(I:I).GE.'a'.AND.REPLY(I:I).LE.'z')
     1  REPLY(I:I) = CHAR(ICHAR(REPLY(I:I)) -32) 
2      CONTINUE
       IF(REPLY.EQ.'YES   '.OR.REPLY.EQ.'Y     ')GOTO 10
       IF(REPLY.EQ.'NO    '.OR.REPLY.EQ.'N     ')GOTO 20
       
       WRITE(*,*)' Please answer the question.'
       GOTO 1
10      YES=.TRUE.
       IF(Y.NE.0)CALL RSPEAK(Y)
       RETURN
20      YES=.FALSE.
       IF(Z.NE.0)CALL RSPEAK(Z)
       RETURN
       END



