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)
       IMPLICIT INTEGER(A-Z)

       LOGICAL KILLED,PCT,HOLDNG,ENCLSD
      INTEGER*4 LL
       LOGICAL INSIDE,OUTSID,PORTAL,TOTING,HERE,AT,FORCED

      INTEGER*4 TRAVEL
       COMMON /TRVCOM/ TRAVEL(1600)
      INTEGER*4 LTEXT,STEXT
       COMMON /LTXCOM/ LTEXT(250),STEXT(250),KEY(250),ABB(250),LOCSIZ
       COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150),
     1          FIXED(150),MAXOBJ
      INTEGER*4 POINTS,NEW1
       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 KILLED,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(INTS(MOD(LL,0001000)).EQ.1.OR.INTS(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=INTS(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)RETURN
       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)
       RETURN

21      LL=MOD((IABS(TRAVEL(KK))/1000),1000)
       IF(LL.EQ.INTL(K))GOTO 25
       IF(LL.GT.INTL(MAXLOC))GOTO 22
       J=KEY(LL)
       IF(FORCED(LL).AND.MOD((IABS(TRAVEL(J))/1000),1000).EQ.INTL(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)
       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(VERB.EQ.FIND.OR.VERB.EQ.INVENT)SPK=59
       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),NEWLOC
C             ALCOV PLOVR TROLL PHUCE BOOTH BRDGE
      WRITE(1,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(65).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  END OF SPECIALS.

       END
