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))
C IF(INTS(MOD(LL,0001000)).EQ.1.OR.INTS(MOD(LL,0001000)).EQ.K)
IF((MOD(LL,0001000)).EQ.1.OR.(MOD(LL,0001000)).EQ.K)
C REMOVED INTS ABOVE. THE USUAL CAVETAH. M.V.
1 GOTO 10
IF(TRAVEL(KK).LT.0000000)GOTO 50
KK=KK+1
GOTO 9
10 LL=LL/0001000
C11 NEWLOC=INTS(LL/0001000)
11 NEWLOC=(LL/0001000)!THE USUAL, REMOVED INTS. M.V.
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)
C IF(LL.EQ.INTL(K))GOTO 25
IF(LL.EQ.(K))GOTO 25 !REMOVED INTL, M.V.
C IF(LL.GT.INTL(MAXLOC))GOTO 22
IF(LL.GT.(MAXLOC))GOTO 22!REMOVED INTL, M.V.
J=KEY(LL)
C IF(FORCED(LL).AND.MOD((IABS(TRAVEL(J))/1000),1000).EQ.INTL(K))
IF(FORCED(LL).AND.MOD((IABS(TRAVEL(J))/1000),1000).EQ.(K))!REMOVED INTL, M.V.
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