home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Hack-Phreak Scene Programs
/
cleanhpvac.zip
/
cleanhpvac
/
ADV350.ZIP
/
dwarfs.for
< prev
next >
Wrap
Text File
|
1990-11-13
|
6KB
|
186 lines
SUBROUTINE DWARFS(IRET)
C
INCLUDE 'ADVCOM.COM'
INCLUDE 'NEWCOM.COM'
INCLUDE 'FUNCT.H'
C
C
C
C
C
IF(NEWLOC.GE.9.OR.NEWLOC.EQ.0.OR..NOT.CLOSNG) GOTO 71
CALL RSPEAK(130)
NEWLOC=LOC
IF(.NOT.PANIC) CLOCK2=15
PANIC=.TRUE.
C
C SEE IF A DWARF HAS SEEN HIM AND HAS COME FROM WHERE HE WANTS TO GO. IF SO,
C THE DWARF'S BLOCKING HIS WAY. IF COMING FROM PLACE FOBIDDEN TO PIRATE
C (DWARVES ROOTED IN PLACE) LET HIM GET OUT (AND ATTACKED).
71 IF(NEWLOC.EQ.LOC.OR.FORCED(LOC).OR.BITSET(LOC,3)) GOTO 74
DO 73 I=1,5
IF(ODLOC(I).NE.NEWLOC.OR..NOT.DSEEN(I)) GOTO 73
NEWLOC=LOC
CALL RSPEAK(2)
GOTO 74
73 CONTINUE
74 LOC=NEWLOC
C DWARF STUFF. SEE EARLIER COMMENTS FOR DESCRIPTIONS OF VARIABLES. REMEMBER
C SIXTH DWARF IS PIRATE AND IS THUS VERY DIFFERENT EXCEPT FOR MOTION RULES.
C FIRST OFF, DON'T LET THE DWARVES FOLLOW HIM INTO A PIT OR A WALL. ACTIVATE
C THE WHOLE MESS THE FIRST TIME HE GETS AS FAR AS THE HALL OF MISTS (LOC 15).
C IF NEWLOC IS FORBIDDEN TO PIRATE (IN PARTICULAR, IF IT'S BEYOND THE TROLL
C BRIDGE), BYPASS DWARF STUFF. THAT WAY PIRATE CAN'T STEAL RETURN TOLL, AND
C DWARVES CAN'T MEET THE BEAR. ALSO MEANS DWARVES WON'T FOLLOW HIM INTO DEAD
C END IN MAZE, BUT C'EST LA VIE. THEY'LL WAIT FOR HIM OUTSIDE THE DEAD END.
IF(LOC.EQ.0.OR.FORCED(LOC).OR.BITSET(NEWLOC,3)) GOTO 2000
IF(DFLAG.NE.0) GOTO 6000
IF(LOC.GE.15) DFLAG=1
GOTO 2000
C WHEN WE ENCOUNTER THE FIRST DWARF, WE KILL 0, 1, OR 2 OF THE 5 DWARVES. IF
C ANY OF THE SURVIVORS IS AT LOC, REPLACE HIM AT THE ALTERNATIVE LOCATION.
6000 IF(DFLAG.NE.1) GOTO 6010
IF(LOC.LT.15.OR.PCT(95)) GOTO 2000
DFLAG=2
DO 6001 I=1,2
J=1+RAN(5)
C IF SAVED NOT = -1, HE BYPASSED THE "START" CALL.
6001 IF(PCT(50).AND.SAVED.EQ.-1) DLOC(J)=0
DO 6002 I=1,5
IF(DLOC(I).EQ.LOC) DLOC(I)=DALTLC
6002 ODLOC(I)=DLOC(I)
CALL RSPEAK(3)
CALL DROP(AXE,LOC)
GOTO 2000
C THINGS ARE IN FULL SWING. MOVE EACH DWARF AT RANDOM, EXCEPT IF HE'S SEEN US
C HE STICKS WITH US. DWARVES NEVER GO TO LOCS <15. IF WANDERING AT RANDOM,
C THEY DON'T BACK UP UNLESS THERE'S NO ALTERNATIVE. IF THEY DON'T HAVE TO
C MOVE, THEY ATTACK. AND, OF COURSE, DEAD DWARVES DON'T DO MUCH OF ANYTHING.
6010 DTOTAL=0
ATTACK=0
STICK=0
DO 6030 I=1,6
IF(DLOC(I).EQ.0) GOTO 6030
J=1
KK=DLOC(I)
KK=KEY(KK)
IF(KK.EQ.0) GOTO 6016
6012 NEWLOC=MOD(IABS(TRAVEL(KK))/1000,1000)
IF(NEWLOC.GT.300.OR.NEWLOC.LT.15.OR.NEWLOC.EQ.ODLOC(I)
1 .OR.(J.GT.1.AND.NEWLOC.EQ.TK(J-1)).OR.J.GE.20
2 .OR.NEWLOC.EQ.DLOC(I).OR.FORCED(NEWLOC)
3 .OR.(I.EQ.6.AND.BITSET(NEWLOC,3))
4 .OR.IABS(TRAVEL(KK))/1000000.EQ.100) GOTO 6014
TK(J)=NEWLOC
J=J+1
6014 KK=KK+1
IF(TRAVEL(KK-1).GE.0) GOTO 6012
6016 TK(J)=ODLOC(I)
IF(J.GE.2) J=J-1
J=1+RAN(J)
ODLOC(I)=DLOC(I)
DLOC(I)=TK(J)
DSEEN(I)=(DSEEN(I).AND.LOC.GE.15)
1 .OR.(DLOC(I).EQ.LOC.OR.ODLOC(I).EQ.LOC)
IF(.NOT.DSEEN(I)) GOTO 6030
DLOC(I)=LOC
IF(I.NE.6) GOTO 6027
C THE PIRATE'S SPOTTED HIM. HE LEAVES HIM ALONE ONCE WE'VE FOUND CHEST.
C K COUNTS IF A TREASURE IS HERE. IF NOT, AND TALLY=TALLY2 PLUS ONE FOR
C AN UNSEEN CHEST, LET THE PIRATE BE SPOTTED.
IF(LOC.EQ.CHLOC.OR.PROP(CHEST).GE.0) GOTO 6030
K=0
DO 6020 J=50,MAXTRS
C PIRATE WON'T TAKE PYRAMID FROM PLOVER ROOM OR DARK ROOM (TOO EASY!).
IF(J.EQ.PYRAM.AND.(LOC.EQ.PLAC(PYRAM)
1 .OR.LOC.EQ.PLAC(EMRALD))) GOTO 6020
IF(TOTING(J)) GOTO 6022
6020 IF(HERE(J)) K=1
IF(TALLY.EQ.TALLY2+1.AND.K.EQ.0.AND.PLACE(CHEST).EQ.0
1 .AND.HERE(LAMP).AND.PROP(LAMP).EQ.1) GOTO 6025
IF(ODLOC(6).NE.DLOC(6).AND.PCT(20)) CALL RSPEAK(127)
GOTO 6030
6022 CALL RSPEAK(128)
C DON'T STEAL CHEST BACK FROM TROLL!
IF(PLACE(MESSAG).EQ.0) CALL MOVE(CHEST,CHLOC)
CALL MOVE(MESSAG,CHLOC2)
DO 6023 J=50,MAXTRS
IF(J.EQ.PYRAM.AND.(LOC.EQ.PLAC(PYRAM)
1 .OR.LOC.EQ.PLAC(EMRALD))) GOTO 6023
IF(AT(J).AND.FIXED(J).EQ.0) CALL CARRY(J,LOC)
IF(TOTING(J)) CALL DROP(J,CHLOC)
6023 CONTINUE
6024 DLOC(6)=CHLOC
ODLOC(6)=CHLOC
DSEEN(6)=.FALSE.
GOTO 6030
6025 CALL RSPEAK(186)
CALL MOVE(CHEST,CHLOC)
CALL MOVE(MESSAG,CHLOC2)
GOTO 6024
C THIS THREATENING LITTLE DWARF IS IN THE ROOM WITH HIM!
6027 DTOTAL=DTOTAL+1
IF(ODLOC(I).NE.DLOC(I)) GOTO 6030
ATTACK=ATTACK+1
IF(KNFLOC.GE.0) KNFLOC=LOC
IF(RAN(1000).LT.95*(DFLAG-2)) STICK=STICK+1
6030 CONTINUE
C NOW WE KNOW WHAT'S HAPPENING. LET'S TELL THE POOR SUCKER ABOUT IT.
IF(DTOTAL.EQ.0) GOTO 2000
IF(DTOTAL.EQ.1) GOTO 75
WRITE(*,67) DTOTAL
67 FORMAT(/' THERE ARE 'I1,' THREATENING LITTLE DWARVES IN THE',
1 ' ROOM WITH YOU.')
GOTO 77
75 CALL RSPEAK(4)
77 IF(ATTACK.EQ.0) GOTO 2000
IF(DFLAG.EQ.2) DFLAG=3
C IF SAVED NOT =-1, HE BYPASSED THE "START" CALL. DWARVES GET *VERY* MAD!
IF(SAVED.NE.-1) DFLAG=20
IF(ATTACK.EQ.1) GOTO 79
WRITE(*,78) ATTACK
78 FORMAT(/' ',I1,' OF THEM THROW KNIVES AT YOU!')
K=6
82 IF(STICK.GT.1) GOTO 83
CALL RSPEAK(K+STICK)
IF(STICK.EQ.0) GOTO 2000
GOTO 84
83 WRITE(*,68) STICK
68 FORMAT(/' ',I1,' OF THEM GET YOU!')
84 OLDLC2=LOC
GOTO 99
79 CALL RSPEAK(5)
K=52
GOTO 82
C
C SET UP RETURN PARAMETER.
99 CONTINUE
IRET=2
RETURN
C
2000 CONTINUE
IRET=1
RETURN
C
END