1 C INFEST- Subroutine to test for infested room
  2 C
  3 C Declarations
  4 C
  5           LOGICAL FUNCTION INFEST(R)
  6           IMPLICIT INTEGER (A-Z)
  7           %include dparam
  8 C
  9           IF(.NOT.ENDGMF) INFEST=(OROOM(CYCLO).EQ.R).OR.
 10           &         (OROOM(TROLL).EQ.R).OR.
 11           &         ((OROOM(THIEF).EQ.R).AND.THFACT)
 12           IF(ENDGMF) INFEST=(R.EQ.MRG).OR.(R.EQ.MRGE).OR.
 13           &         (R.EQ.MRGW).OR.
 14           &         ((R.EQ.INMIR).AND.(MLOC.EQ.MRG))
 15           RETURN
 16           END
 17 C page
 18 C AAPPLI- Applicables for adventurers
 19 C
 20 C Declarations
 21 C
 22           LOGICAL FUNCTION AAPPLI(RI)
 23           IMPLICIT INTEGER (A-Z)
 24           %include dparam
 25           LOGICAL F,MOVETO,QHERE,FINDXT
 26 C
 27           IF(RI.EQ.0) GO TO 10                              ! if zero, no app.
 28           AAPPLI=.TRUE.                                     ! assume wins.
 29           GO TO (1000,2000,3000),RI               ! branch on adv.
 30           CALL BUG(11,RI)
 31 C
 32 C Common false return.
 33 C
 34 10        AAPPLI=.FALSE.
 35           RETURN
 36 C page
 37 C AAPPLI, PAGE 2
 38 C
 39 C A1--    Dead player.
 40 C
 41 1000      IF((PRSA.NE.ATTACW).AND.(PRSA.NE.MUNGW).AND.
 42           &  (PRSA.NE.KILLW).AND.(PRSA.NE.SWINGW).AND.
 43           &  (PRSA.NE.KICKW).AND.(PRSA.NE.BLASTW)) GO TO 1050
 44           CALL RSPEAK(949)                        ! dead can't attack.
 45           RETURN
 46 C
 47 1050      IF((PRSA.NE.OPENW).AND.(PRSA.NE.CLOSEW).AND.
 48           &  (PRSA.NE.EATW).AND.(PRSA.NE.DRINKW).AND.
 49           &  (PRSA.NE.INFLAW).AND.(PRSA.NE.DEFLAW).AND.
 50           &  (PRSA.NE.TURNW).AND.(PRSA.NE.TIEW).AND.
 51           &  (PRSA.NE.RUBW).AND.(PRSA.NE.COUNTW).AND.
 52           &  (PRSA.NE.BURNW).AND.(PRSA.NE.UNTIEW)) GO TO 1100
 53           CALL RSPEAK(950)                        ! dead can't do simple acts.
 54           RETURN
 55 C
 56 1100      IF(PRSA.NE.TRNONW) GO TO 1150
 57           CALL RSPEAK(951)                        ! dead don't need lights.
 58           RETURN
 59 C
 60 1150      IF(PRSA.NE.SCOREW) GO TO 1200
 61           CALL RSPEAK(952)                        ! dead can't score.
 62           RETURN
 63 C
 64 1200      IF(PRSA.NE.TELLW) GO TO 1250
 65           CALL RSPEAK(953)                        ! dead can't give orders.
 66           RETURN
 67 C
 68 1250      IF(PRSA.NE.TAKEW) GO TO 1300
 69           CALL RSPEAK(954)                        ! dead can't take.
 70           RETURN
 71 C
 72 1300      IF((PRSA.NE.DROPW).AND.(PRSA.NE.THROWW).AND.
 73           &  (PRSA.NE.INVENW)) GO TO 1350
 74           CALL RSPEAK(955)                        ! dead have no possesions
 75           RETURN
 76 C
 77 1350      IF(PRSA.NE.DIAGNW) GO TO 1400
 78           CALL RSPEAK(956)                        ! dead as a doornail
 79           RETURN
 80 C
 81 1400      IF(PRSA.NE.LOOKW) GO TO 1500
 82           I=957                                             ! assume nothing here
 83           DO 1450 J=1,OLNT                        ! loop through objects
 84             IF(QHERE(J,HERE)) I=958               ! found something
 85 1450      CONTINUE
 86           CALL RSPEAK(I)                                    ! describe objects
 87 C old     IF((RFLAG(HERE).AND.RLIGHT).EQ.0) CALL RSPEAK(959)
 88           IF((AND(RFLAG(HERE),RLIGHT)).EQ.0) CALL RSPEAK(959)
 89           GO TO 10                                ! don't handle
 90 C
 91 1500      IF(PRSA.NE.PRAYW) GO TO 1600
 92           IF(HERE.EQ.TEMP2) GO TO 1550            ! praying in temple?
 93           CALL RSPEAK(960)                        ! prayers are not answered
 94           RETURN
 95 C
 96 C old 1550          OFLAG1(LAMP)=OFLAG1(LAMP).OR.VISIBT     ! back to life, restore lamp
 97 1550      OFLAG1(LAMP)=OR(OFLAG1(LAMP),VISIBT)    ! back to life, restore lamp
 98           AACTIO(PLAYER)=0                        ! disable dead player
 99           DEADF=.FALSE.                                     ! clear dead flag
100           F=MOVETO(FORE1,WINNER)                            ! move to forest
101           CALL RSPEAK(9)                                    ! describe
102           RETURN
103 C
104 1600      IF(PRSA.NE.WALKW) GO TO 1700
105           IF(.NOT.FINDXT(PRSO,HERE)) GO TO 10     ! if no exits, don't handle
106           IF(XROOM1.NE.BSHAF) GO TO 10            ! if not bshaft, don't handle
107           CALL RSPEAK(962)                        ! can't go and score points
108           RETURN
109 C
110 1700      IF(PRSA.EQ.QUITW) GO TO 10              ! if quit, don't handle
111           CALL RSPEAK(963)                        ! can't do it
112           RETURN
113 C page
114 C
115 C A2--    Robot.  Process most commands given to robot.
116 C
117 2000      IF((PRSA.NE.RAISEW).OR.(PRSO.NE.RCAGE)) GO TO 2200
118           CFLAG(CEVSPH)=.FALSE.                             ! robot raised cage.
119           WINNER=PLAYER                                     ! reset for player.
120           F=MOVETO(CAGER,WINNER)                            ! move to new room.
121           CALL NEWSTA(CAGE,567,CAGER,0,0)                   ! install cage in room.
122           CALL NEWSTA(ROBOT,0,CAGER,0,0)                    ! install robot in room.
123           AROOM(AROBOT)=CAGER                     ! also move robot/adv.
124           CAGESF=.TRUE.                                     ! cage solved.
125 C old     OFLAG1(ROBOT)=OFLAG1(ROBOT).AND..NOT.NDSCBT
126           OFLAG1(ROBOT)=AND(OFLAG1(ROBOT),COMPL(NDSCBT))
127 C old     OFLAG1(SPHER)=OFLAG1(SPHER).OR.TAKEBT   ! reset flags.
128           OFLAG1(SPHER)=OR(OFLAG1(SPHER),TAKEBT)  ! reset flags.
129           PRSCON=0                                ! stop cmd stream.
130           RETURN
131 C
132 2200      IF((PRSA.NE.DRINKW).AND.(PRSA.NE.EATW)) GO TO 2300
133           CALL RSPEAK(568)                        ! eat or drink, joke.
134           RETURN
135 C
136 2300      IF(PRSA.NE.READW) GO TO 2400            ! read,
137           CALL RSPEAK(569)                        ! joke.
138           RETURN
139 C
140 2400      IF((PRSA.EQ.WALKW).OR.(PRSA.EQ.TAKEW).OR.(PRSA.EQ.DROPW)
141           & .OR.(PRSA.EQ.PUTW).OR.(PRSA.EQ.PUSHW).OR.(PRSA.EQ.LEAPW)
142           & .OR.(PRSA.EQ.TURNW)) GO TO 2500       ! test for robot verb.
143           CALL RSPEAK(570)                        ! joke.
144           RETURN
145 C
146 2500      CALL RSPEAK(930)                        ! buzz, whirr, click!
147           GO TO 10                                ! don't handle here.
148 C page
149 C AAPPLI, PAGE 3
150 C
151 C A3--    Master.  Process most commands given to master.
152 C
153 C old 3000          IF((OFLAG2(QDOOR).AND.OPENBT).NE.0) GO TO 3100
154 3000      IF((AND(OFLAG2(QDOOR),OPENBT)).NE.0) GO TO 3100
155           CALL RSPEAK(783)                        ! no master yet.
156           RETURN
157 C
158 3100      IF(PRSA.NE.WALKW) GO TO 3200            ! walk?
159           I=784                                             ! assume wont.
160           IF(((HERE.EQ.SCORR).AND.
161           &         ((PRSO.EQ.XNORTH).OR.(PRSO.EQ.XENTER))).OR.
162           &  ((HERE.EQ.NCORR).AND.
163           &         ((PRSO.EQ.XSOUTH).OR.(PRSO.EQ.XENTER))))
164           &         I=785                                   ! if prison, cant.
165           CALL RSPEAK(I)
166           RETURN
167 C
168 3200      IF((PRSA.EQ.STAYW).OR.(PRSA.EQ.FOLLOW).OR.(PRSA.EQ.KILLW).OR.
169           &  (PRSA.EQ.MUNGW).OR.(PRSA.EQ.ATTACW)) GO TO 10
170           IF((PRSA.EQ.TAKEW).OR.(PRSA.EQ.DROPW).OR.(PRSA.EQ.PUTW).OR.
171           &  (PRSA.EQ.THROWW).OR.(PRSA.EQ.PUSHW).OR.(PRSA.EQ.TURNW).OR.
172           &  (PRSA.EQ.SPINW).OR.(PRSA.EQ.TRNTOW).OR.(PRSA.EQ.OPENW).OR.
173           &  (PRSA.EQ.CLOSEW)) GO TO 3300                   ! master can, politely.
174           CALL RSPEAK(786)                        ! master can't.
175           RETURN
176 C
177 3300      CALL RSPEAK(1057)                       ! polite reply.
178           GO TO 10
179 C
180           END
181 C page
182 C THIEFD- Intermove thief demon
183 C
184 C Declarations
185 C
186 C This routine details on bit 6 of PRSFLG
187 C
188           SUBROUTINE THIEFD
189           IMPLICIT INTEGER (A-Z)
190           %include dparam
191           LOGICAL DFLAG,ONCE,PROB,QHERE,QSTILL,LIT,WINNIN,WASLIT
192 C
193 C Functions AND DATA
194 C
195           QSTILL(R)=(QHERE(STILL,R).OR.(OADV(STILL).EQ.-THIEF))
196 C page
197 C THIEFD, PAGE 2
198 C
199 C old     DFLAG=(PRSFLG.AND.64).NE.0              ! set up detail flag.
200           DFLAG=AND(PRSFLG,64).NE.0               ! set up detail flag.
201           ONCE=.FALSE.                                      ! init flag.
202 1025      WASLIT=LIT(HERE)                        ! record if lit.
203           RHERE=OROOM(THIEF)                      ! visible pos.
204           IF(RHERE.NE.0) THFPOS=RHERE
205 C
206           IF((THFPOS.EQ.HERE).AND..NOT.DEADF) GO TO 1100    ! thief in live win rm?
207           IF(THFPOS.NE.TREAS) GO TO 1400                    ! thief not in treas?
208 C
209 C Thief is in treasure room, and winner is not.
210 C
211           IF(DFLAG) PRINT 10
212 10        FORMAT(' THIEFD-- IN TREASURE ROOM')
213           IF(RHERE.EQ.0) GO TO 1050               ! visible?
214           CALL NEWSTA(THIEF,0,0,0,0)              ! yes, vanish.
215           RHERE=0
216           IF(QSTILL(TREAS)) CALL NEWSTA(STILL,0,0,THIEF,0)
217           DO 1040 I=1,OLNT                        ! loop through objects.
218 C old       IF(QHERE(I,THFPOS))
219 C old     &         OFLAG1(I)=OFLAG1(I).OR.VISIBT ! make objects visible
220             IF(QHERE(I,THFPOS))
221           &         OFLAG1(I)=OR(OFLAG1(I),VISIBT)          ! make objects visible
222 1040      CONTINUE
223 1050      I=ROBADV(-THIEF,THFPOS,0,0)             ! drop valuables.
224 C old     IF(QHERE(EGG,THFPOS)) OFLAG2(EGG)=OFLAG2(EGG).OR.OPENBT
225           IF(QHERE(EGG,THFPOS)) OFLAG2(EGG)=OR(OFLAG2(EGG),OPENBT)
226           GO TO 1700
227 C page
228 C THIEFD, PAGE 3
229 C
230 C Thief and (live) winner in same room.
231 C
232 1100      IF(THFPOS.EQ.TREAS) GO TO 1700                    ! if treas room, nothing.
233 C old     IF((RFLAG(THFPOS).AND.RLIGHT).NE.0) GO TO 1400 ! not if light.
234           IF((AND(RFLAG(THFPOS),RLIGHT)).NE.0) GO TO 1400 ! not if light.
235           IF(DFLAG) PRINT 20
236 20        FORMAT(' THIEFD-- IN ADV ROOM')
237           IF(THFFLG) GO TO 1300                             ! thief announced?
238           IF((RHERE.NE.0).OR.PROB(70,70))         GO TO 1150          ! if invis and 30%.
239           IF(OCAN(STILL).NE.THIEF) GO TO 1700     ! abort if no stilletto.
240           CALL NEWSTA(THIEF,583,THFPOS,0,0)       ! insert thief into room.
241           THFFLG=.TRUE.                                     ! thief is announced.
242           RETURN
243 C
244 C old 1150          IF((RHERE.EQ.0).OR.((OFLAG2(THIEF).AND.FITEBT).EQ.0))
245 C old     &         GO TO 1200                              ! if visible and fight.
246 1150      IF((RHERE.EQ.0).OR.((AND(OFLAG2(THIEF),FITEBT)).EQ.0))
247           &         GO TO 1200                              ! if visible and fight.
248           IF(WINNIN(THIEF,PLAYER)) GO TO 1175     ! winning?
249           CALL NEWSTA(THIEF,584,0,0,0)            ! no, vanish thief.
250 C old     OFLAG2(THIEF)=OFLAG2(THIEF).AND. .NOT.FITEBT
251           OFLAG2(THIEF)=AND(OFLAG2(THIEF), COMPL(FITEBT))
252           IF(QSTILL(THFPOS)) CALL NEWSTA(STILL,0,0,THIEF,0)
253           RETURN
254 C
255 1175      IF(PROB(90,90)) GO TO 1700              ! 90% chance to stay.
256 C
257 1200      IF((RHERE.EQ.0).OR.PROB(70,70)) GO TO 1250 ! if visible and 30%
258           CALL NEWSTA(THIEF,585,0,0,0)            ! vanish thief.
259           IF(QSTILL(THFPOS)) CALL NEWSTA(STILL,0,0,THIEF,0)
260           RETURN
261 C
262 1300      IF(RHERE.EQ.0) GO TO 1700               ! announced.  visible?
263 1250      IF(PROB(70,70)) RETURN                            ! 70% chance to do nothing.
264           THFFLG=.TRUE.
265           NR=ROBRM(THFPOS,100,0,0,-THIEF)+ROBADV(PLAYER,0,0,-THIEF)
266           I=586                                             ! robbed em.
267           IF(RHERE.NE.0) I=588                              ! was he visible?
268           CALL NEWSTA(THIEF,I+MIN0(1,NR),0,0,0)   ! vanish thief, give result.
269           IF(QSTILL(THFPOS))
270           &         CALL NEWSTA(STILL,0,0,THIEF,0)          ! reclaim stilletto.
271           IF(WASLIT.AND..NOT.LIT(HERE).AND.(HERE.EQ.AROOM(PLAYER)))
272           &         CALL RSPEAK(915)              ! leave player in dark?
273           RHERE=0
274           GO TO 1700                                        ! onward.
275 C page
276 C THIEFD, PAGE 4
277 C
278 C Not in adventurers room, or adventurer dead, or room lit.
279 C
280 1400      CALL NEWSTA(THIEF,0,0,0,0)              ! vanish.
281           RHERE=0
282           IF(DFLAG) PRINT 30,THFPOS
283 30        FORMAT(' THIEFD-- IN ROOM ',I4)
284           IF(QSTILL(THFPOS)) CALL NEWSTA(STILL,0,0,THIEF,0)
285 C old     IF((RFLAG(THFPOS).AND.RSEEN).EQ.0) GO TO 1700     ! cant rob unseen.
286           IF((AND(RFLAG(THFPOS),RSEEN)).EQ.0) GO TO 1700    ! cant rob unseen.
287           RMK=1045                                ! first object to vanish.
288           I=ROBRM(THFPOS,75,0,0,-5555)            ! rob room 75% to hyperspace.
289           DO 1410 I=1,OLNT                        ! loop through objects.
290             IF(OADV(I).NE.-5555) GO TO 1410       ! in hyperspace?
291             CALL NEWSTA(I,0,0,0,-THIEF)           ! move to thief.
292             IF((THFPOS.EQ.HERE).AND..NOT.DEADF)   ! thief's remarks.
293           &         CALL RSPSUB(RMK,ODESC2(I))
294             RMK=1083                                        ! for next object.
295 1410      CONTINUE
296 C
297           IF((THFPOS.LT.MAZE1).OR.(THFPOS.GT.MAZ15).OR.
298           &         (HERE.LT.MAZE1).OR.(HERE.GT.MAZ15)) GO TO 1500
299           DO 1450 I=1,OLNT                        ! both in maze.
300 C old       IF(.NOT.QHERE(I,THFPOS).OR.PROB(60,60).OR.(I.EQ.WATER).OR.
301 C old     &         ((OFLAG1(I).AND.(VISIBT+TAKEBT)).NE.(VISIBT+TAKEBT)))
302 C old     &         GO TO 1450
303             IF(.NOT.QHERE(I,THFPOS).OR.PROB(60,60).OR.(I.EQ.WATER).OR.
304           &         ((AND(OFLAG1(I),(VISIBT+TAKEBT))).NE.(VISIBT+TAKEBT)))
305           &         GO TO 1450
306             IF(.NOT.DEADF) CALL RSPSUB(590,ODESC2(I))       ! thief's remarks.
307             IF(PROB(40,20)) GO TO 1700
308             CALL NEWSTA(I,0,0,0,-THIEF)           ! steal it.
309 C old       OFLAG2(I)=OFLAG2(I).OR.TCHBT
310             OFLAG2(I)=OR(OFLAG2(I),TCHBT)
311             GO TO 1700
312 1450      CONTINUE
313           GO TO 1700
314 C
315 1500      DO 1550 I=1,OLNT                        ! not in maze.
316 C old       IF(.NOT.QHERE(I,THFPOS).OR.(OTVAL(I).NE.0).OR.
317 C old     &         PROB(80,60).OR.(I.EQ.WATER).OR.
318 C old     &         ((OFLAG1(I).AND.(VISIBT+TAKEBT)).NE.(VISIBT+TAKEBT)))
319 C old     &         GO TO 1550
320             IF(.NOT.QHERE(I,THFPOS).OR.(OTVAL(I).NE.0).OR.
321           &         PROB(80,60).OR.(I.EQ.WATER).OR.
322           &         ((AND(OFLAG1(I),(VISIBT+TAKEBT))).NE.(VISIBT+TAKEBT)))
323           &         GO TO 1550
324             CALL NEWSTA(I,0,0,0,-THIEF)
325 C           OFLAG2(I)=OFLAG2(I).OR.TCHBT
326             OFLAG2(I)=OR(OFLAG2(I),TCHBT)
327             IF((THFPOS.EQ.HERE).AND..NOT.DEADF)
328           &         CALL RSPSUB(RMK,ODESC2(I))    ! vanishes before you.
329             GO TO 1700
330 1550      CONTINUE
331 C page
332 C THIEFD, PAGE 5
333 C
334 C Now move to new room.
335 C
336 1700      IF(OADV(ROPE).NE.-THIEF) GO TO 1725     ! did he steal rope?
337           DOMEF=.FALSE.
338           TTIE=0
339 1725      IF(ONCE) GO TO 1800
340           ONCE=.NOT.ONCE
341 1750      THFPOS=THFPOS-1                                   ! next room.
342           IF(THFPOS.LE.0) THFPOS=RLNT
343 C old     IF((RFLAG(THFPOS).AND.(RLAND+RSACRD+REND)).NE.RLAND)
344 C old     &         GO TO 1750                              ! must be land, profane.
345           IF((AND(RFLAG(THFPOS),(RLAND+RSACRD+REND))).NE.RLAND)
346           &         GO TO 1750                              ! must be land, profane.
347           THFFLG=.FALSE.                                    ! not announced.
348           GO TO 1025                                        ! once more.
349 C
350 C All done.
351 C
352 1800      IF(THFPOS.EQ.TREAS) RETURN              ! in treasure room?
353           J=1055                                            ! no, drop junky stuff.
354           IF(THFPOS.NE.HERE) J=0
355           DO 1850 I=1,OLNT
356             IF((OADV(I).NE.-THIEF).OR.PROB(70,30).OR.
357           &         (OTVAL(I).GT.0)) GO TO 1850
358             CALL NEWSTA(I,J,THFPOS,0,0)
359             J=0
360 1850      CONTINUE
361           RETURN
362 C
363           END