home *** CD-ROM | disk | FTP | other *** search
/ Fatal Distractions! / fataldistractions.bin / chap01 / adventur / dwarfs.for < prev    next >
Text File  |  1990-11-13  |  6KB  |  186 lines

  1.       SUBROUTINE DWARFS(IRET)
  2. C
  3.       INCLUDE 'ADVCOM.COM'
  4.       INCLUDE 'NEWCOM.COM'
  5.       INCLUDE 'FUNCT.H'
  6. C
  7. C
  8. C
  9. C
  10. C
  11.       IF(NEWLOC.GE.9.OR.NEWLOC.EQ.0.OR..NOT.CLOSNG) GOTO 71
  12.       CALL RSPEAK(130)
  13.       NEWLOC=LOC
  14.       IF(.NOT.PANIC) CLOCK2=15
  15.       PANIC=.TRUE.
  16.       
  17. C
  18. C  SEE IF A DWARF HAS SEEN HIM AND HAS COME FROM WHERE HE WANTS TO GO.  IF SO,
  19. C  THE DWARF'S BLOCKING HIS WAY.  IF COMING FROM PLACE FOBIDDEN TO PIRATE
  20. C  (DWARVES ROOTED IN PLACE) LET HIM GET OUT (AND ATTACKED).
  21.  
  22.    71 IF(NEWLOC.EQ.LOC.OR.FORCED(LOC).OR.BITSET(LOC,3)) GOTO 74
  23.       DO 73 I=1,5
  24.       IF(ODLOC(I).NE.NEWLOC.OR..NOT.DSEEN(I)) GOTO 73
  25.       NEWLOC=LOC
  26.       CALL RSPEAK(2)
  27.       GOTO 74
  28.    73 CONTINUE
  29.    74 LOC=NEWLOC
  30.    
  31. C  DWARF STUFF.  SEE EARLIER COMMENTS FOR DESCRIPTIONS OF VARIABLES.  REMEMBER
  32. C  SIXTH DWARF IS PIRATE AND IS THUS VERY DIFFERENT EXCEPT FOR MOTION RULES.
  33.  
  34. C  FIRST OFF, DON'T LET THE DWARVES FOLLOW HIM INTO A PIT OR A WALL.  ACTIVATE
  35. C  THE WHOLE MESS THE FIRST TIME HE GETS AS FAR AS THE HALL OF MISTS (LOC 15).
  36. C  IF NEWLOC IS FORBIDDEN TO PIRATE (IN PARTICULAR, IF IT'S BEYOND THE TROLL
  37. C  BRIDGE), BYPASS DWARF STUFF.  THAT WAY PIRATE CAN'T STEAL RETURN TOLL, AND
  38. C  DWARVES CAN'T MEET THE BEAR.  ALSO MEANS DWARVES WON'T FOLLOW HIM INTO DEAD
  39. C  END IN MAZE, BUT C'EST LA VIE. THEY'LL WAIT FOR HIM OUTSIDE THE DEAD END.
  40.  
  41.       IF(LOC.EQ.0.OR.FORCED(LOC).OR.BITSET(NEWLOC,3)) GOTO 2000
  42.       IF(DFLAG.NE.0) GOTO 6000
  43.       IF(LOC.GE.15) DFLAG=1
  44.       GOTO 2000
  45.       
  46. C  WHEN WE ENCOUNTER THE FIRST DWARF, WE KILL 0, 1, OR 2 OF THE 5 DWARVES.  IF
  47. C  ANY OF THE SURVIVORS IS AT LOC, REPLACE HIM AT THE ALTERNATIVE LOCATION.
  48.  
  49.  6000 IF(DFLAG.NE.1) GOTO 6010
  50.       IF(LOC.LT.15.OR.PCT(95)) GOTO 2000
  51.       DFLAG=2
  52.       DO 6001 I=1,2
  53.       J=1+RAN(5)
  54. C  IF SAVED NOT = -1, HE BYPASSED THE "START" CALL.
  55.  6001 IF(PCT(50).AND.SAVED.EQ.-1) DLOC(J)=0
  56.       DO 6002 I=1,5
  57.       IF(DLOC(I).EQ.LOC) DLOC(I)=DALTLC
  58.  6002 ODLOC(I)=DLOC(I)
  59.       CALL RSPEAK(3)
  60.       CALL DROP(AXE,LOC)
  61.       GOTO 2000
  62.       
  63. C  THINGS ARE IN FULL SWING.  MOVE EACH DWARF AT RANDOM, EXCEPT IF HE'S SEEN US
  64. C  HE STICKS WITH US.  DWARVES NEVER GO TO LOCS <15.  IF WANDERING AT RANDOM,
  65. C  THEY DON'T BACK UP UNLESS THERE'S NO ALTERNATIVE.  IF THEY DON'T HAVE TO
  66. C  MOVE, THEY ATTACK.  AND, OF COURSE, DEAD DWARVES DON'T DO MUCH OF ANYTHING.
  67.  
  68.  6010 DTOTAL=0
  69.       ATTACK=0
  70.       STICK=0
  71.       DO 6030 I=1,6
  72.       IF(DLOC(I).EQ.0) GOTO 6030
  73.       J=1
  74.       KK=DLOC(I)
  75.       KK=KEY(KK)
  76.       IF(KK.EQ.0) GOTO 6016
  77.  6012 NEWLOC=MOD(IABS(TRAVEL(KK))/1000,1000)
  78.       IF(NEWLOC.GT.300.OR.NEWLOC.LT.15.OR.NEWLOC.EQ.ODLOC(I)
  79.      1   .OR.(J.GT.1.AND.NEWLOC.EQ.TK(J-1)).OR.J.GE.20
  80.      2   .OR.NEWLOC.EQ.DLOC(I).OR.FORCED(NEWLOC)
  81.      3   .OR.(I.EQ.6.AND.BITSET(NEWLOC,3))
  82.      4   .OR.IABS(TRAVEL(KK))/1000000.EQ.100) GOTO 6014
  83.       TK(J)=NEWLOC
  84.       J=J+1
  85.  6014 KK=KK+1
  86.       IF(TRAVEL(KK-1).GE.0) GOTO 6012
  87.  6016 TK(J)=ODLOC(I)
  88.       IF(J.GE.2) J=J-1
  89.       J=1+RAN(J)
  90.       ODLOC(I)=DLOC(I)
  91.       DLOC(I)=TK(J)
  92.       DSEEN(I)=(DSEEN(I).AND.LOC.GE.15)
  93.      1         .OR.(DLOC(I).EQ.LOC.OR.ODLOC(I).EQ.LOC)
  94.       IF(.NOT.DSEEN(I)) GOTO 6030
  95.       DLOC(I)=LOC
  96.       IF(I.NE.6) GOTO 6027
  97.       
  98. C  THE PIRATE'S SPOTTED HIM.  HE LEAVES HIM ALONE ONCE WE'VE FOUND CHEST.
  99. C  K COUNTS IF A TREASURE IS HERE.  IF NOT, AND TALLY=TALLY2 PLUS ONE FOR
  100. C  AN UNSEEN CHEST, LET THE PIRATE BE SPOTTED.
  101.  
  102.       IF(LOC.EQ.CHLOC.OR.PROP(CHEST).GE.0) GOTO 6030
  103.       K=0
  104.       DO 6020 J=50,MAXTRS
  105. C  PIRATE WON'T TAKE PYRAMID FROM PLOVER ROOM OR DARK ROOM (TOO EASY!).
  106.       IF(J.EQ.PYRAM.AND.(LOC.EQ.PLAC(PYRAM)
  107.      1   .OR.LOC.EQ.PLAC(EMRALD))) GOTO 6020
  108.       IF(TOTING(J)) GOTO 6022
  109.  6020 IF(HERE(J)) K=1
  110.       IF(TALLY.EQ.TALLY2+1.AND.K.EQ.0.AND.PLACE(CHEST).EQ.0
  111.      1   .AND.HERE(LAMP).AND.PROP(LAMP).EQ.1) GOTO 6025
  112.       IF(ODLOC(6).NE.DLOC(6).AND.PCT(20)) CALL RSPEAK(127)
  113.       GOTO 6030
  114.       
  115.  6022 CALL RSPEAK(128)
  116.  
  117. C  DON'T STEAL CHEST BACK FROM TROLL!
  118.       IF(PLACE(MESSAG).EQ.0) CALL MOVE(CHEST,CHLOC)
  119.       CALL MOVE(MESSAG,CHLOC2)
  120.       DO 6023 J=50,MAXTRS
  121.       IF(J.EQ.PYRAM.AND.(LOC.EQ.PLAC(PYRAM)
  122.      1   .OR.LOC.EQ.PLAC(EMRALD))) GOTO 6023
  123.       IF(AT(J).AND.FIXED(J).EQ.0) CALL CARRY(J,LOC)
  124.       IF(TOTING(J)) CALL DROP(J,CHLOC)
  125.  6023 CONTINUE
  126.  6024 DLOC(6)=CHLOC
  127.       ODLOC(6)=CHLOC
  128.       DSEEN(6)=.FALSE.
  129.       GOTO 6030
  130.       
  131.  6025 CALL RSPEAK(186)
  132.       CALL MOVE(CHEST,CHLOC)
  133.       CALL MOVE(MESSAG,CHLOC2)
  134.       GOTO 6024
  135.       
  136. C  THIS THREATENING LITTLE DWARF IS IN THE ROOM WITH HIM!
  137.  
  138.  6027 DTOTAL=DTOTAL+1
  139.       IF(ODLOC(I).NE.DLOC(I)) GOTO 6030
  140.       ATTACK=ATTACK+1
  141.       IF(KNFLOC.GE.0) KNFLOC=LOC
  142.       IF(RAN(1000).LT.95*(DFLAG-2)) STICK=STICK+1
  143.  6030 CONTINUE
  144.  
  145. C  NOW WE KNOW WHAT'S HAPPENING.  LET'S TELL THE POOR SUCKER ABOUT IT.
  146.  
  147.       IF(DTOTAL.EQ.0) GOTO 2000
  148.       IF(DTOTAL.EQ.1) GOTO 75
  149.       WRITE(*,67) DTOTAL
  150.    67 FORMAT(/' THERE ARE 'I1,' THREATENING LITTLE DWARVES IN THE',
  151.      1        ' ROOM WITH YOU.')
  152.       GOTO 77
  153.    75 CALL RSPEAK(4)
  154.    77 IF(ATTACK.EQ.0) GOTO 2000
  155.       IF(DFLAG.EQ.2) DFLAG=3
  156. C  IF SAVED NOT =-1, HE BYPASSED THE "START" CALL.  DWARVES GET *VERY* MAD!
  157.       IF(SAVED.NE.-1) DFLAG=20
  158.       IF(ATTACK.EQ.1) GOTO 79
  159.       WRITE(*,78) ATTACK
  160.    78 FORMAT(/' ',I1,' OF THEM THROW KNIVES AT YOU!')
  161.       K=6
  162.    82 IF(STICK.GT.1) GOTO 83
  163.       CALL RSPEAK(K+STICK)
  164.       IF(STICK.EQ.0) GOTO 2000
  165.       GOTO 84
  166.    83 WRITE(*,68) STICK
  167.    68 FORMAT(/' ',I1,' OF THEM GET YOU!')
  168.    84 OLDLC2=LOC
  169.       GOTO 99
  170.       
  171.    79 CALL RSPEAK(5)
  172.       K=52
  173.       GOTO 82
  174.       
  175. C
  176. C  SET UP RETURN PARAMETER.
  177.    99 CONTINUE
  178.       IRET=2
  179.       RETURN
  180. C
  181.  2000 CONTINUE
  182.       IRET=1
  183.       RETURN
  184. C
  185.       END
  186.