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