home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / ADV350.ZIP / new1.for < prev    next >
Text File  |  1990-11-13  |  5KB  |  176 lines
  1.       SUBROUTINE NEW1(IRET)
  2. C
  3.       INCLUDE 'ADVCOM.COM'
  4.       INCLUDE 'NEWCOM.COM'
  5.       INCLUDE 'FUNCT.H'
  6.       
  7. C
  8. C  FIGURE OUT THE NEW LOCATION
  9. C
  10. C  GIVEN THE CURRENT LOCATION IN "LOC", AND A MOTION VERB NUMBER IN "K", PUT
  11. C  THE NEW LOCATINON IN "NEWLOC".  THE CURRENT LOC IS SAVED IN "OLDLOC" IN CASE
  12. C  HE WANTS TO RETREAT.  THE CURRENT OLDLOC IS SAVED IN OLDLC2, IN CASE HE
  13. C  DIES.  (IF HE DOES, NEWLOC WILL BE LIMBO, AND OLDLOC WILL BE WHAT KILLED
  14. C  HIM, SO WE NEED OLDLC2, WHICH IS THE LAST PLACE HE WAS SAFE.)
  15.  
  16.     8 KK=KEY(LOC)
  17.       NEWLOC=LOC
  18.       IF(KK.EQ.0) CALL BUG(26)
  19.       IF(K.EQ.NULL) GOTO 2
  20.       IF(K.EQ.BACK) GOTO 20
  21.       IF(K.EQ.LOOK) GOTO 30
  22.       IF(K.EQ.CAVE) GOTO 40
  23.       OLDLC2=OLDLOC
  24.       OLDLOC=LOC
  25.       
  26.     9 LL=IABS(TRAVEL(KK))
  27.       IF(MOD(LL,1000).EQ.1.OR.MOD(LL,1000).EQ.K) GOTO 10
  28.       IF(TRAVEL(KK).LT.0) GOTO 50
  29.       KK=KK+1
  30.       GOTO 9
  31.       
  32.    10 LL=LL/1000
  33.    11 NEWLOC=LL/1000
  34.       K=MOD(NEWLOC,100)
  35.       IF(NEWLOC.LE.300) GOTO 13
  36.       IF(PROP(K).NE.NEWLOC/100-3) GOTO 16
  37.    12 IF(TRAVEL(KK).LT.0) CALL BUG(25)
  38.       KK=KK+1
  39.       NEWLOC=IABS(TRAVEL(KK))/1000
  40.       IF(NEWLOC.EQ.LL) GOTO 12
  41.       LL=NEWLOC
  42.       GOTO 11
  43.    13 IF(NEWLOC.LE.100) GOTO 14
  44.       IF(TOTING(K).OR.(NEWLOC.GT.200.AND.AT(K))) GOTO 16
  45.       GOTO 12
  46.       
  47.    14 IF(NEWLOC.NE.0.AND..NOT.PCT(NEWLOC)) GOTO 12
  48.    16 NEWLOC=MOD(LL,1000)
  49.       IF(NEWLOC.LE.300) GOTO 2
  50.       IF(NEWLOC.LE.500) GOTO 30000
  51.       CALL RSPEAK(NEWLOC-500)
  52.       NEWLOC=LOC
  53.       GOTO 2
  54.       
  55. C  SPECIAL MOTIONS COME HERE.  LABELLING CONVENTION: STATEMENT NUMBERS NNNXX
  56. C  (XX=00-99) ARE USED FOR SPECIAL CASE NUMBER NNN (NNN=301-500).
  57.  
  58. 30000 NEWLOC=NEWLOC-300
  59.       GOTO (30100,30200,30300) NEWLOC
  60.       CALL BUG(20)
  61.       
  62. C  TRAVEL 301.  PLOVER-ALCOVE PASSAGE.  CAN CARRY ONLY EMERALD.  NOTE: TRAVEL
  63. C  TABLE MUST INCLUDE "USELESS" ENTRIES GOING THROUGH PASSAGE, WHICH CAN NEVER
  64. C  BE USED FOR ACTUAL MOTION, BUT CAN BE SPOTTED BY "GO BACK".
  65.  
  66. 30100 NEWLOC=99+100-LOC
  67.       IF(HOLDNG.EQ.0.OR.(HOLDNG.EQ.1.AND.TOTING(EMRALD))) GOTO 2
  68.       NEWLOC=LOC
  69.       CALL RSPEAK(117)
  70.       GOTO 2
  71.       
  72. C  TRAVEL 302.  PLOVER TRANSPORT.  DROP THE EMERALD (ONLY USE SPECIAL TRAVEL IF
  73. C  TOTING IT), SO HE'S FORCED TO USE THE PLOVER-PASSAGE TO GET IT OUT.  HAVING
  74. C  DROPPED IT, GO BACK AND PRETEND HE WASN'T CARRYING IT AFTER ALL.
  75.  
  76. 30200 CALL DROP(EMRALD,LOC)
  77.       GOTO 12
  78.       
  79. C  TRAVEL 303.  TROLL BRIDGE.  MUST BE DONE ONLY AS SPECIAL MOTION SO THAT
  80. C  DWARVES WON'T WANDER ACROSS AND ENCOUNTER THE BEAR.  (THEY WON'T FOLLOW THE
  81. C  PLAYER THERE BECAUSE THAT REGION IS FORBIDDEN TO THE PIRATE.)  IF
  82. C  PROP(TROLL)=1, HE'S CROSSED SINCE PAYING, SO STEP OUT AND BLOCK HIM.
  83. C  (STANDARD TRAVEL ENTRIES CHECK FOR PROP(TROLL)=0.)  SPECIAL STUFF FOR BEAR.
  84.  
  85. 30300 IF(PROP(TROLL).NE.1) GOTO 30310
  86.       CALL PSPEAK(TROLL,1)
  87.       PROP(TROLL)=0
  88.       CALL MOVE(TROLL2,0)
  89.       CALL MOVE(TROLL2+100,0)
  90.       CALL MOVE(TROLL,PLAC(TROLL))
  91.       CALL MOVE(TROLL+100,FIXD(TROLL))
  92.       CALL JUGGLE(CHASM)
  93.       NEWLOC=LOC
  94.       GOTO 2
  95.       
  96. 30310 NEWLOC=PLAC(TROLL)+FIXD(TROLL)-LOC
  97.       IF(PROP(TROLL).EQ.0) PROP(TROLL)=1
  98.       IF(.NOT.TOTING(BEAR)) GOTO 2
  99.       CALL RSPEAK(162)
  100.       PROP(CHASM)=1
  101.       PROP(TROLL)=2
  102.       CALL DROP(BEAR,NEWLOC)
  103.       FIXED(BEAR)=-1
  104.       PROP(BEAR)=3
  105.       IF(PROP(SPICES).LT.0) TALLY2=TALLY2+1
  106.       OLDLC2=NEWLOC
  107.       GOTO 99
  108.       
  109. C  END OF SPECIALS
  110.  
  111. C  HANDLE "GO BACK".  LOOK FOR VERB WHICH GOES FROM LOC TO OLDLOC, OR TO OLDLC2
  112. C  IF OLDLOC HAS FORCED-MOTION.  K2 SAVES ENTRY -> FORCED LOC -> PREVIOUS LOC.
  113.  
  114.    20 K=OLDLOC
  115.       IF(FORCED(K)) K=OLDLC2
  116.       OLDLC2=OLDLOC
  117.       OLDLOC=LOC
  118.       K2=0
  119.       IF(K.NE.LOC) GOTO 21
  120.       CALL RSPEAK(91)
  121.       GOTO 2
  122.       
  123.    21 LL=MOD((IABS(TRAVEL(KK))/1000),1000)
  124.       IF(LL.EQ.K) GOTO 25
  125.       IF(LL.GT.300) GOTO 22
  126.       J=KEY(LL)
  127.       IF(FORCED(LL).AND.MOD((IABS(TRAVEL(J))/1000),1000).EQ.K) K2=KK
  128.    22 IF(TRAVEL(KK).LT.0) GOTO 23
  129.       KK=KK+1
  130.       GOTO 21
  131.       
  132.    23 KK=K2
  133.       IF(KK.NE.0) GOTO 25
  134.       CALL RSPEAK(140)
  135.       GOTO 2
  136.       
  137.    25 K=MOD(IABS(TRAVEL(KK)),1000)
  138.       KK=KEY(LOC)
  139.       GOTO 9
  140.       
  141. C  LOOK.  CAN'T GIVE MORE DETAIL.  PRETEND IT WASN'T DARK (THOUGH IT MAY "NOW"
  142. C  BE DARK) SO HE WON'T FALL INTO A PIT WHILE STARING INTO THE GLOOM.
  143.  
  144.    30 IF(DETAIL.LT.3) CALL RSPEAK(15)
  145.       DETAIL=DETAIL+1
  146.       WZDARK=.FALSE.
  147.       ABB(LOC)=0
  148.       GOTO 2
  149.       
  150. C  CAVE.  DIFFERENT MESSAGES DEPENDING ON WHETHER ABOVE GROUND.
  151.  
  152.    40 IF(LOC.LT.8) CALL RSPEAK(57)
  153.       IF(LOC.GE.8) CALL RSPEAK(58)
  154.       GOTO 2
  155.       
  156. C  NON-APPLICABLE MOTION.  VARIOUS MESSAGES DEPENDING ON WORD GIVEN.
  157.  
  158.    50 SPK=12
  159.       IF(K.GE.43.AND.K.LE.50) SPK=9
  160.       IF(K.EQ.29.OR.K.EQ.30) SPK=9
  161.       IF(K.EQ.7.OR.K.EQ.36.OR.K.EQ.37) SPK=10
  162.       IF(K.EQ.11.OR.K.EQ.19) SPK=11
  163.       IF(VERB.EQ.FIND.OR.VERB.EQ.INVENT) SPK=59
  164.       IF(K.EQ.62.OR.K.EQ.65) SPK=42
  165.       IF(K.EQ.17) SPK=80
  166.       CALL RSPEAK(SPK)
  167. C
  168.     2 CONTINUE
  169.       IRET=1
  170.       RETURN
  171. C
  172.    99 CONTINUE
  173.       IRET=2
  174.       RETURN
  175.       END
  176.