SUBROUTINE TRAVL(K,B_CROSS,TALLY_2) USE ALLCOM ! FIGURE OUT THE NEW LOCATION ! GIVEN THE CURRENT LOCATION IN "LOC", AND A MOTION VERB NUMBER IN "K", PUT NEW LOCATION IN "NEWLOC". CURRENT LOC IS SAVED IN ! "OLDLOC" IN CASE ADVENTURER WANTS TO RETREAT AND IN OLDLC2 IN CASE ADVENTURER DIES. IF ADVENTURER DIES, NEWLOC WILL BE ! LIMBO AND OLDLOC WILL BE WHAT KILLED ADVENTURER, SO WE NEED OLDLC2, WHICH IS THE LAST PLACE ADVENTURER WAS SAFE. INTEGER KK,LL,NEW1,K2,J,K,KALFLG,BURDEN,TALLY_2,OBJECT,B_CROSS,RANZ LOGICAL PCT,HOLDNG,ENCLSD,OUTSID,TOTING,AT,FORCED,DEAD DATA KALFLG/0/ CALL COLOR(LOC) KILLED=.FALSE. KK=KEY(LOC) NEWLOC=LOC IF (KK.EQ.0) CALL BUG('LOCATION HAS NO TRAVEL ENTRIES') IF (K.EQ.NULL) GO TO 99999 IF (K.EQ.BACK) GO TO 20 IF (K.EQ.CAVE) GO TO 40 OLDLC2=OLDLOC OLDLOC=LOC 9 LL=IABS(TRAVEL(KK)) IF (MOD(LL,1000).NE.1.AND.MOD(LL,1000).NE.K) THEN IF (TRAVEL(KK).LT.0000000) GO TO 50 KK=KK+1 GO TO 9 ENDIF LL=LL/1000 11 NEWLOC=LL/1000 K=MOD(NEWLOC,100) IF (NEWLOC.LE.MAXLOC) GO TO 13 IF (PROP(K).NE.NEWLOC/100-3) GO TO 16 12 IF (TRAVEL(KK).LT.0) CALL BUG('CONDITIONAL TRAVEL ENTRY WITH NO ALTERNATIVE') KK=KK+1 NEW1=IABS(TRAVEL(KK))/1000 IF (NEW1.EQ.LL) GO TO 12 LL=NEW1 GO TO 11 13 IF (NEWLOC.GT.100) THEN IF (TOTING(K).OR.(NEWLOC.GT.200.AND.AT(K))) GO TO 16 GO TO 12 ENDIF IF (NEWLOC.NE.0.AND..NOT.PCT(NEWLOC)) GO TO 12 16 NEWLOC=MOD(LL,1000) IF (NEWLOC.LE.MAXLOC)GO TO 2000 IF (NEWLOC.LE.500) GO TO 30000 CALL SPEAK(RTEXT(NEWLOC-500)) NEWLOC=LOC GO TO 99999 ! "GO BACK". LOOK FOR VERB WHICH GOES FROM LOC TO OLDLOC, OR TO OLDLC2 ! 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.EQ.LOC) THEN CALL SPEAK(RTEXT(91)) GO TO 2000 ENDIF 21 LL=MOD((IABS(TRAVEL(KK))/1000),1000) IF (LL.EQ.K) GO TO 25 IF (LL.LE.MAXLOC) THEN J=KEY(LL) IF (FORCED(LL).AND.MOD((IABS(TRAVEL(J))/1000),1000).EQ.K) K2=KK ENDIF IF (TRAVEL(KK).GE.0) THEN KK=KK+1 GO TO 21 ENDIF KK=K2 IF (KK.NE.0) GO TO 25 CALL SPEAK(RTEXT(140)) 2000 IF (NEWLOC.GE.242.AND.NEWLOC.LE.247) THEN IF (NEWLOC.EQ.242) THEN KALFLG=0 ELSEIF (NEWLOC.EQ.OLDLOC+1) THEN KALFLG=KALFLG+1 ELSE KALFLG=-10 ENDIF ENDIF GO TO 99999 25 K=MOD(IABS(TRAVEL(KK)),1000) KK=KEY(LOC) GO TO 9 ! DIFFERENT MESSAGES DEPENDING ON WHETHER ABOVE GROUND. 40 IF (OUTSID(LOC)) CALL SPEAK(RTEXT(57)) IF (.NOT.OUTSID(LOC)) CALL SPEAK(RTEXT(58)) GO TO 99999 ! NON-APPLICABLE MOTION. VARIOUS MESSAGES DEPENDING ON WORD GIVEN. 50 SPK=12 SELECT CASE (K) CASE (43:50,29,30); SPK=9 CASE (7,36,37); SPK=10 CASE (11,19); SPK=11 CASE (62,65,82); SPK=42 CASE(17); SPK=80 END SELECT CALL SPEAK(RTEXT(SPK)) GO TO 99999 ! SPECIAL MOTIONS. STATEMENT NUMBERS NNNXX (XX=00-99) ARE USED FOR SPECIAL CASE NUMBER NNN (NNN=301-500). 30000 NEWLOC=NEWLOC-MAXLOC SELECT CASE (NEWLOC) CASE (1); GO TO 30100 !ALCOVE CASE (2); GO TO 30200 !PLOVER CASE (3); GO TO 30300 !TROLL CASE (4); GO TO 30400 !PHUCE CASE (5); GO TO 30500 !PHONE BOOTH CASE (6); GO TO 30600 !BRIDGE CASE (7); GO TO 30700 !KALEIDOSCOPE END SELECT CALL BUG('SPECIAL TRAVEL (500>L>300) EXCEEDS CASE LIST') ! PLOVER-ALCOVE PASSAGE. CAN CARRY ONLY EMERALD. TRAVEL TABLE MUST INCLUDE "USELESS" ENTRIES GOING ! THROUGH PASSAGE WHICH CAN NEVER 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))) GO TO 99999 NEWLOC=LOC CALL SPEAK(RTEXT(117)) GO TO 99999 ! PLOVER TRANSPORT. DROP THE EMERALD (ONLY USE SPECIAL TRAVEL IF TOTING IT) SO FORCED TO USE THE ! PLOVER-PASSAGE TO GET IT OUT. HAVING DROPPED IT, GO BACK AND PRETEND WASN'T CARRYING IT AFTER ALL. 30200 IF (ENCLSD(EMRALD)) CALL REMOVE(EMRALD) CALL DROP(EMRALD,LOC) GO TO 12 ! TROLL BRIDGE. MUST BE DONE ONLY AS SPECIAL MOTION SO DWARVES WON'T WANDER ACROSS AND ENCOUNTER THE BEAR. ! THEY WON'T FOLLOW THE ADVENTURER THERE BECAUSE THAT REGION IS FORBIDDEN TO THE PIRATE. IF PROP(TROLL)=1, ADVENTURER'S ! CROSSED SINCE PAYING, SO STEP OUT AND BLOCK. (STANDARD TRAVEL ENTRIES CHECK FOR PROP(TROLL)=0.) SPECIAL STUFF FOR BEAR. 30300 IF (PROP(TROLL).EQ.1) THEN 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 ELSE NEWLOC=PLAC(TROLL)+FIXD(TROLL)-LOC IF (PROP(TROLL).EQ.0) PROP(TROLL)=1 IF (HOLDNG(BEAR)) THEN CALL SPEAK(RTEXT(162)) PROP(CHASM)=1 PROP(TROLL)=2 CALL DROP(BEAR,NEWLOC) FIXED(BEAR)=-1 PROP(BEAR)=3 IF (PROP(SPICES).LT.0)TALLY_2=TALLY_2+1 OLDLC2=NEWLOC KILLED=.TRUE. ENDIF ENDIF GO TO 99999 ! GROWING OR SHRINKING IN AREA OF TINY DOOR. EACH TIME EVERYTHING IS IS MOVED TO THE NEW LOC. PRESUMABLY, ALL POSSESIONS ARE ! SHRUNK OR STRETCHED AS WELL. PHUCE(2,4) IS AN ARRAY CONTAINING FOUR PAIRS OF "HERE" (K) AND "THERE" (KK) LOCATIONS. 30400 K=PHUCE(1,LOC-161+1) NEWLOC=PHUCE(2,LOC-161+1) DO OBJECT=1,MAXOBJ IF (OBJECT.EQ.BOAT) CYCLE IF (PLACE(OBJECT).EQ.K.AND.(FIXED(OBJECT).EQ.0.OR.FIXED(OBJECT).EQ.-1)) CALL MOVE(OBJECT,NEWLOC) END DO GO TO 99999 ! PHONE BOOTH IN ROTUNDA. TRYING TO SHOVE PAST GNOME TO GET INTO PHONE BOOTH. 30500 IF ((PROP(BOOTH).EQ.0.AND.PCT(55)).OR.ABB(LOC).EQ.1) THEN CALL SPEAK(RTEXT(263)) PROP(BOOTH)=1 CALL MOVE(GNOME,188) NEWLOC=LOC ELSE NEWLOC=189 IF ( PROP(BOOTH).EQ.1) THEN CALL SPEAK(RTEXT(253)) NEWLOC=LOC ENDIF ENDIF GO TO 99999 ! COLLAPSING CLAY BRIDGE; CAN CROSS WITH UP TO THREE THINGS. IF MORE OR CARRYING OBVIOUSLY HEAVY THINGS MAY END UP IN THE DRINK. 30600 NEWLOC=235 IF (LOC.EQ.235) NEWLOC=190 B_CROSS=B_CROSS+1 KK=BURDEN(0) IF (KK.GT.4) THEN K=MAX( ((KK+B_CROSS)**2)/10, 10) IF (PCT(K)) THEN CALL SPEAK(RTEXT(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 OBJECT=1,MAXOBJ IF (TOTING(OBJECT)) CALL DESTROY(OBJECT) END DO PROP(CHASM2)=1 ELSE CALL SPEAK(RTEXT(318)) ENDIF ENDIF GO TO 99999 ! THE KALEIDOSCOPE CODE IS HERE 30700 IF (KALFLG.EQ.5) THEN NEWLOC=248 OLDLOC=247 ELSE NEWLOC=242+RANZ(5) OLDLOC=NEWLOC-1 CALL SPEAK(RTEXT(406)) KALFLG=-10 IF (NEWLOC.EQ.242) KALFLG=0 ENDIF 99999 CALL COLOR(NEWLOC) IF (OLDLOC.EQ.206.AND..NOT.DEAD(BASILISK).AND.PROP(BASILISK).LT.2) PROP(BASILISK)=PROP(BASILISK)+1 END