1 C Clock events, demons, actors for DUNGEON.
  2 C
  3 C COPYRIGHT 1980, 1990, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA.
  4 C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
  5 C WRITTEN BY R. M. SUPNIK
  6 C
  7 C 27-Sep-94         RMS       Fixed bugs in thief demon, fight demon, master actor,
  8 C                             robot actor, dead player, balloon, bell.
  9 C 30-Jan-94         RMS       Fixed bugs from MS DOS port.
 10 C 18-Jan-94         RMS       Fixed bug in dead player recovery.
 11 C 01-Jul-92         RMS       Removed extraneous function from CEVAPP.
 12 C 30-Jun-92         RMS       Changed file names to lower case.
 13 C
 14 C CLOCKD- Intermove clock events demon
 15 C
 16 C Declarations
 17 C
 18           LOGICAL FUNCTION CLOCKD(X)
 19           IMPLICIT INTEGER (A-Z)
 20           %include dparam
 21 C
 22           CLOCKD=.FALSE.                                    ! assume no action.
 23           DO 100 I=1,CLNT
 24             IF(.NOT.CFLAG(I) .OR.(CTICK(I).EQ.0)) GO TO 100
 25             IF(CTICK(I).LT.0) GO TO 50            ! permanent entry?
 26             CTICK(I)=CTICK(I)-1
 27             IF(CTICK(I).NE.0) GO TO 100           ! timer expired?
 28 50          CLOCKD=.TRUE.
 29             CALL CEVAPP(CACTIO(I))                ! do action.
 30 100       CONTINUE
 31           RETURN
 32 C
 33           END
 34 C page
 35 C CEVAPP- Clock event applicables
 36 C
 37 C Declarations
 38 C
 39           SUBROUTINE CEVAPP(RI)
 40           IMPLICIT INTEGER (A-Z)
 41           %include dparam
 42           INTEGER CNDTCK(10),LMPTCK(12)
 43           LOGICAL FINDXT,LIT,RMDESC,QOPEN,MOVETO
 44           LOGICAL F,QLEDGE,QHERE,PROB,WASLIT
 45 C
 46 C Functions and data
 47 C
 48 C old     QOPEN(R)=(OFLAG2(R).AND.OPENBT).NE.0
 49           QOPEN(R)=AND(OFLAG2(R),OPENBT).NE.0
 50           QLEDGE(R)=(R.EQ.LEDG2).OR.(R.EQ.LEDG3).OR.(R.EQ.LEDG4)
 51           DATA CNDTCK/50,20,10,5,0,156,156,156,157,0/
 52           DATA LMPTCK/50,30,20,10,4,0,154,154,154,154,155,0/
 53 C
 54           IF(RI.EQ.0) RETURN                      ! ignore disabled.
 55           WASLIT=LIT(HERE)
 56           GO TO (1000,2000,3000,4000,5000,6000,7000,8000,9000,10000,
 57           & 11000,12000,13000,14000,15000,16000,17000,18000,19000,
 58           & 20000,21000,22000,23000,24000,25000,26000,27000,28000,
 59           & 29000,30000),RI
 60           CALL BUG(3,RI)
 61 C
 62 C Return here to test for change in light.
 63 C
 64 50        IF(WASLIT.AND..NOT.LIT(HERE)) CALL RSPEAK(406)
 65           RETURN
 66 C page
 67 C CEVAPP, PAGE 2
 68 C
 69 C CEV1--  Cure clock.  Let player slowly recover.
 70 C
 71 1000      ASTREN(PLAYER)=MIN0(0,ASTREN(PLAYER)+1) ! recover.
 72           IF(ASTREN(PLAYER).GE.0) RETURN                    ! fully recovered?
 73           CFLAG(CEVCUR)=.TRUE.
 74           CTICK(CEVCUR)=30                        ! no, wait some more.
 75           RETURN
 76 C
 77 C CEV2--  Maint-room with leak.  Raise the water level.
 78 C
 79 2000      IF(HERE.EQ.MAINT) CALL RSPEAK(71+(RVMNT/2)) ! describe.
 80           RVMNT=RVMNT+1                                     ! raise water level.
 81           IF(RVMNT.LE.16) RETURN                            ! if not full, exit.
 82           CTICK(CEVMNT)=0                                   ! full, disable clock.
 83 C old     RFLAG(MAINT)=RFLAG(MAINT).OR.RMUNG      ! mung room.
 84           RFLAG(MAINT)=OR(RFLAG(MAINT),RMUNG)     ! mung room.
 85           RDESC1(MAINT)=80                        ! say it is full of water.
 86           IF(HERE.EQ.MAINT) CALL JIGSUP(81)       ! drown him if present.
 87           RETURN
 88 C
 89 C CEV3--  Lantern.  Describe growing dimness.
 90 C
 91 3000      CALL LITINT(LAMP,ORLAMP,CEVLNT,LMPTCK,12) ! do light interrupt.
 92           GO TO 50                                ! go see if now dark.
 93 C
 94 C CEV4--  Match.  Out it goes.
 95 C
 96 4000      CALL RSPEAK(153)                        ! match is out.
 97 C old     OFLAG1(MATCH)=OFLAG1(MATCH).AND. .NOT.(ONBT+FLAMBT+LITEBT)
 98           OFLAG1(MATCH)=AND(OFLAG1(MATCH), COMPL((ONBT+FLAMBT+LITEBT)))
 99           GO TO 50                                ! go see if now dark.
100 C
101 C CEV5--  Candle.  Describe growing dimness.
102 C
103 5000      CALL LITINT(CANDL,ORCAND,CEVCND,CNDTCK,10) ! do candle interrupt.
104           GO TO 50                                ! go see if now dark.
105 C page
106 C CEVAPP, PAGE 3
107 C
108 C CEV6--  Balloon.
109 C
110 6000      CFLAG(CEVBAL)=.TRUE.
111           CTICK(CEVBAL)=3                                   ! reschedule interrupt.
112           F=AVEHIC(WINNER).EQ.BALLO               ! see if in balloon.
113           IF(BLOC.EQ.VLBOT) GO TO 6800            ! at bottom?
114           IF(QLEDGE(BLOC)) GO TO 6700             ! on ledge?
115           IF(QOPEN(RECEP).AND.(BINFF.NE.0))
116           &         GO TO 6500                              ! inflated and recep open?
117 C
118 C Balloon is in midair and is deflated (or has receptacle closed).
119 C Fall to next room.
120 C
121           IF(BLOC.NE.VAIR1) GO TO 6300            ! in vair1?
122           BLOC=VLBOT                                        ! yes, now at vlbot.
123           CALL NEWSTA(BALLO,0,BLOC,0,0)
124           IF(F) GO TO 6200                        ! in balloon?
125           IF(QLEDGE(HERE).OR.(HERE.EQ.VLBOT))
126           &         CALL RSPEAK(530)              ! if can see, describe.
127           RETURN
128 C
129 6200      F=MOVETO(BLOC,WINNER)                             ! move him.
130           IF(BINFF.EQ.0) GO TO 6250               ! in balloon.  inflated?
131           CALL RSPEAK(531)                        ! yes, landed.
132           F=RMDESC(0)                                       ! describe.
133           RETURN
134 C
135 6250      CALL NEWSTA(BALLO,532,0,0,0)            ! no, balloon & contents die.
136           CALL NEWSTA(DBALL,0,BLOC,0,0)           ! insert dead balloon.
137           IF(LASTIT.EQ.BALLO) LASTIT=DBALL        ! fix last it reference.
138           AVEHIC(WINNER)=0                        ! not in vehicle.
139           CFLAG(CEVBAL)=.FALSE.                             ! disable interrupts.
140           CFLAG(CEVBRN)=.FALSE.
141           RETURN
142 C
143 6300      BLOC=BLOC-1                                       ! not in vair1, descend.
144           CALL NEWSTA(BALLO,0,BLOC,0,0)
145           IF(F) GO TO 6400                        ! is he in balloon?
146           IF(QLEDGE(HERE).OR.(HERE.EQ.VLBOT))
147           &         CALL RSPEAK(533)              ! if can see, describe.
148           RETURN
149 C
150 6400      F=MOVETO(BLOC,WINNER)                             ! in balloon, move him.
151           CALL RSPEAK(534)                        ! describe.
152           F=RMDESC(0)
153           RETURN
154 C
155 C Balloon is in midair and is inflated, up-up-and-away!
156 c
157 6500      IF(BLOC.NE.VAIR4) GO TO 6600            ! at vair4?
158           CFLAG(CEVBRN)=.FALSE.                             ! disable interrupts.
159           CFLAG(CEVBAL)=.FALSE.
160           BINFF=0
161           BLOC=VLBOT                                        ! fall to bottom.
162           CALL NEWSTA(BALLO,0,0,0,0)              ! balloon & contents die.
163           CALL NEWSTA(DBALL,0,BLOC,0,0)           ! substitute dead balloon.
164           IF(LASTIT.EQ.BALLO) LASTIT=DBALL        ! fix last it reference.
165           IF(F) GO TO 6550                        ! was he in it?
166           IF(QLEDGE(HERE)) CALL RSPEAK(535)       ! if can see, describe.
167           IF(HERE.EQ.VLBOT) CALL RSPEAK(925)      ! if at bottom, describe
168           RETURN
169 C
170 6550      CALL JIGSUP(536)                        ! in balloon at crash, die.
171           RETURN
172 C
173 6600      BLOC=BLOC+1                                       ! not at vair4, go up.
174           CALL NEWSTA(BALLO,0,BLOC,0,0)
175           IF(F) GO TO 6650                        ! in balloon?
176           IF(QLEDGE(HERE).OR.(HERE.EQ.VLBOT))
177           &         CALL RSPEAK(537)              ! if can see, describe.
178           RETURN
179 C
180 6650      F=MOVETO(BLOC,WINNER)                             ! move player.
181           CALL RSPEAK(538)                        ! describe.
182           F=RMDESC(0)
183           RETURN
184 C
185 C On ledge, goes to midair room whether inflated or not.
186 C
187 6700      BLOC=BLOC+(VAIR2-LEDG2)                           ! move to midair.
188           CALL NEWSTA(BALLO,0,BLOC,0,0)
189           IF(F) GO TO 6750                        ! in balloon?
190           IF(QLEDGE(HERE).OR.(HERE.EQ.VLBOT))
191           &         CALL RSPEAK(539)              ! if can see, describe.
192           CFLAG(CEVVLG)=.TRUE.                              ! stranded.
193           CTICK(CEVVLG)=10                        ! materialize gnome.
194           RETURN
195 C
196 6750      F=MOVETO(BLOC,WINNER)                             ! move to new room.
197           CALL RSPEAK(540)                        ! describe.
198           F=RMDESC(0)
199           RETURN
200 C
201 C At bottom, go up if inflated, do nothing if deflated.
202 C
203 6800      IF((BINFF.EQ.0).OR..NOT.QOPEN(RECEP)) RETURN
204           BLOC=VAIR1                                        ! inflated and open,
205           CALL NEWSTA(BALLO,0,BLOC,0,0)           ! go up to vair1.
206           IF(F) GO TO 6850                        ! in balloon?
207           IF(QLEDGE(HERE).OR.(HERE.EQ.VLBOT))
208           &         CALL RSPEAK(541)              ! if can see, describe.
209           RETURN
210 C
211 6850      F=MOVETO(BLOC,WINNER)                             ! move player.
212           CALL RSPEAK(542)
213           F=RMDESC(0)
214           RETURN
215 C page
216 C CEVAPP, PAGE 4
217 C
218 C CEV7--  Balloon burnup.
219 C
220 7000      DO 7100 I=1,OLNT                        ! find burning object
221 C old       IF((RECEP.EQ.OCAN(I)).AND.((OFLAG1(I).AND.FLAMBT).NE.0))
222 C old     &         GO TO 7200                              ! in receptacle.
223             IF((RECEP.EQ.OCAN(I)).AND.((AND(OFLAG1(I),FLAMBT)).NE.0))
224           &         GO TO 7200                              ! in receptacle.
225 7100      CONTINUE
226           CALL BUG(4,0)
227 C
228 7200      CALL NEWSTA(I,0,0,0,0)                            ! vanish object.
229           BINFF=0                                           ! uninflated.
230           IF(HERE.EQ.BLOC) CALL RSPSUB(292,ODESC2(I))       ! describe.
231           RETURN
232 C
233 C CEV8--  Fuse function.
234 C
235 8000      IF(OCAN(FUSE).NE.BRICK) GO TO 8500      ! ignited brick?
236           BR=OROOM(BRICK)                                   ! get brick room.
237           BC=OCAN(BRICK)                                    ! get container.
238           IF((BR.EQ.0).AND.(BC.NE.0)) BR=OROOM(BC)
239           IF(BR.EQ.0) BR=HERE                     ! it's here...
240           CALL NEWSTA(FUSE,0,0,0,0)               ! kill fuse.
241           CALL NEWSTA(BRICK,0,0,0,0)              ! kill brick.
242           IF(BR.NE.HERE) GO TO 8100               ! brick elsewhere?
243 C
244 C old     RFLAG(HERE)=RFLAG(HERE).OR.RMUNG        ! blew self.
245           RFLAG(HERE)=OR(RFLAG(HERE),RMUNG)       ! blew self.
246           RDESC1(HERE)=114                        ! mung room.
247           CALL JIGSUP(150)                        ! dead.
248           RETURN
249 C
250 8100      CALL RSPEAK(151)                        ! boom.
251           MUNGRM=BR                               ! save room that blew.
252           CFLAG(CEVSAF)=.TRUE.
253           CTICK(CEVSAF)=5                                   ! set safe interrupt.
254           IF(BR.NE.MSAFE) GO TO 8200              ! blew safe room?
255           IF(BC.NE.SSLOT) RETURN                            ! was brick in safe?
256           CALL NEWSTA(SSLOT,0,0,0,0)              ! kill slot.
257 C old     OFLAG2(SAFE)=OFLAG2(SAFE).OR.OPENBT     ! open safe.
258           OFLAG2(SAFE)=OR(OFLAG2(SAFE),OPENBT)    ! open safe.
259           SAFEF=.TRUE.                                      ! indicate safe blown.
260           RETURN
261 C
262 8200      DO 8250 I=1,OLNT                        ! blew wrong room.
263 C old       IF(QHERE(I,BR) .AND. ((OFLAG1(I).AND.TAKEBT).NE.0))
264 C old     &         CALL NEWSTA(I,0,0,0,0)                  ! vanish contents.
265             IF(QHERE(I,BR) .AND. ((AND(OFLAG1(I),TAKEBT)).NE.0))
266           &         CALL NEWSTA(I,0,0,0,0)                  ! vanish contents.
267 8250      CONTINUE
268           IF(BR.NE.LROOM) RETURN                            ! blew living room?
269           DO 8300 I=1,OLNT
270             IF(OCAN(I).EQ.TCASE) CALL NEWSTA(I,0,0,0,0) ! kill trophy case.
271 8300      CONTINUE
272           RETURN
273 C
274 8500      IF(QHERE(FUSE,HERE).OR.(OADV(FUSE).EQ.WINNER))
275           &         CALL RSPEAK(152)
276           CALL NEWSTA(FUSE,0,0,0,0)               ! kill fuse.
277           RETURN
278 C page
279 C CEVAPP, PAGE 5
280 C
281 C CEV9--  Ledge munge.
282 C
283 C old 9000          RFLAG(LEDG4)=RFLAG(LEDG4).OR.RMUNG      ! ledge collapses.
284 9000      RFLAG(LEDG4)=OR(RFLAG(LEDG4),RMUNG)     ! ledge collapses.
285           RDESC1(LEDG4)=109
286           IF(HERE.EQ.LEDG4) GO TO 9100            ! was he there?
287           CALL RSPEAK(110)                        ! no, narrow escape.
288           RETURN
289 C
290 9100      IF(AVEHIC(WINNER).NE.0) GO TO 9200      ! in vehicle?
291           CALL JIGSUP(111)                        ! no, dead.
292           RETURN
293 C
294 9200      IF(BTIEF.NE.0) GO TO 9300               ! tied to ledge?
295           CALL RSPEAK(112)                        ! no, no place to land.
296           RETURN
297 C
298 9300      BLOC=VLBOT                                        ! yes, crash balloon.
299           CALL NEWSTA(BALLO,0,0,0,0)              ! balloon & contents die.
300           CALL NEWSTA(DBALL,0,BLOC,0,0)           ! insert dead balloon.
301           IF(LASTIT.EQ.BALLO) LASTIT=DBALL        ! fix last it reference.
302           ODESC1(BTIEF)=1073                      ! restore description.
303           BTIEF=0
304           BINFF=0
305           CFLAG(CEVBAL)=.FALSE.
306           CFLAG(CEVBRN)=.FALSE.
307           CALL JIGSUP(113)                        ! dead.
308           RETURN
309 C
310 C CEV10-- Safe munge.
311 C
312 C old 10000         RFLAG(MUNGRM)=RFLAG(MUNGRM).OR.RMUNG    ! mung target.
313 10000     RFLAG(MUNGRM)=OR(RFLAG(MUNGRM),RMUNG)   ! mung target.
314           RDESC1(MUNGRM)=114
315           IF(HERE.EQ.MUNGRM) GO TO 10100                    ! is he present?
316           CALL RSPEAK(115)                        ! let him know.
317           IF(MUNGRM.NE.MSAFE) RETURN
318           CFLAG(CEVLED)=.TRUE.
319           CTICK(CEVLED)=8                                   ! start ledge clock.
320           RETURN
321 C
322 10100     I=116                                             ! he's dead,
323 C old     IF((RFLAG(HERE).AND.RHOUSE).NE.0) I=117 ! one way or another.
324           IF((AND(RFLAG(HERE),RHOUSE)).NE.0) I=117          ! one way or another.
325           CALL JIGSUP(I)                                    ! let him know.
326           RETURN
327 C page
328 C CEVAPP, PAGE 6
329 C
330 C CEV11-- Volcano gnome entrance.
331 C
332 11000     IF(QLEDGE(HERE)) GO TO 11100            ! is he on ledge?
333           CFLAG(CEVVLG)=.TRUE.
334           CTICK(CEVVLG)=1                                   ! no, wait a while.
335           RETURN
336 C
337 11100     CALL NEWSTA(GNOME,118,HERE,0,0)                   ! yes, materialize gnome.
338           RETURN
339 C
340 C CEV12-- Volcano gnome exit.
341 C
342 12000     IF(OROOM(GNOME).EQ.HERE) CALL RSPEAK(149) ! player here to hear?
343           CALL NEWSTA(GNOME,0,0,0,0)              ! disappear the gnome.
344           RETURN
345 C
346 C CEV13-- Bucket.
347 C
348 13000     IF(OCAN(WATER).EQ.BUCKE)
349           &         CALL NEWSTA(WATER,0,0,0,0)    ! water leaks out.
350           RETURN
351 C
352 C CEV14-- Sphere.  If expires, he's trapped.
353 C
354 C old 14000         RFLAG(CAGER)=RFLAG(CAGER).OR.RMUNG      ! mung room.
355 14000     RFLAG(CAGER)=OR(RFLAG(CAGER),RMUNG)     ! mung room.
356           RDESC1(CAGER)=147
357           WINNER=PLAYER                                     ! kill player, not robot.
358           CALL JIGSUP(148)                        ! mung player.
359           RETURN
360 C
361 C CEV15-- END GAME HERALD.
362 C
363 15000     ENDGMF=.TRUE.                                     ! we're in endgame.
364           CALL RSPEAK(119)                        ! inform of endgame.
365           RETURN
366 C page
367 C CEVAPP, PAGE 7
368 C
369 C CEV16-- Forest murmurs.
370 C
371 16000     CFLAG(CEVFOR)=(HERE.EQ.MTREE).OR.
372           &         ((HERE.GE.FORE1).AND.(HERE.LT.CLEAR))
373           IF(CFLAG(CEVFOR).AND.PROB(10,10)) CALL RSPEAK(635)
374           RETURN
375 C
376 C CEV17-- Scol alarm.
377 C
378 17000     IF(HERE.EQ.BKVAU) CALL JIGSUP(636)      ! if in vau, dead.
379           IF(ZGNOMF.OR.(HERE.NE.BKTWI)) RETURN    ! if not in twi, nothing.
380           ZGNOMF=.TRUE.                                     ! gnome only comes once
381           CFLAG(CEVZGI)=.TRUE.                              ! turn on gnome timer
382           CTICK(CEVZGI)=5
383           RETURN
384 C
385 C CEV18-- Gnome of Zurich entrance.
386 C
387 18000     IF(HERE.NE.BKTWI) RETURN                ! player here?
388           CFLAG(CEVZGO)=.TRUE.                              ! exits, too.
389           CTICK(CEVZGO)=12
390           CALL NEWSTA(ZGNOM,637,BKTWI,0,0)        ! place in twi.
391           RETURN
392 C
393 C CEV19-- Gnome of Zurich exits.
394 C
395 19000     CALL NEWSTA(ZGNOM,0,0,0,0)              ! vanish.
396           IF(HERE.EQ.BKTWI) CALL RSPEAK(638)      ! announce.
397           RETURN
398 C page
399 C CEVAPP, PAGE 8
400 C
401 C CEV20-- Start of endgame.
402 C
403 20000     IF(SPELLF) GO TO 20200                            ! spell his way in?
404           IF(HERE.NE.CRYPT) RETURN                ! no, still in tomb?
405           IF(.NOT.LIT(HERE)) GO TO 20100                    ! lights off?
406           CFLAG(CEVSTE)=.TRUE.
407           CTICK(CEVSTE)=3                                   ! reschedule.
408           RETURN
409 C
410 20100     CALL RSPEAK(727)                        ! announce.
411 20200     DO 20300 I=1,OLNT                       ! strip him of objs.
412             CALL NEWSTA(I,0,OROOM(I),OCAN(I),0)
413 20300     CONTINUE
414           CALL NEWSTA(LAMP,0,0,0,PLAYER)                    ! give him lamp.
415           CALL NEWSTA(SWORD,0,0,0,PLAYER)                   ! give him sword.
416 C
417 C old     OFLAG1(LAMP)=(OFLAG1(LAMP).OR.LITEBT).AND. .NOT.ONBT
418           OFLAG1(LAMP)=AND((OR(OFLAG1(LAMP),LITEBT)), COMPL(ONBT))
419 C old     OFLAG2(LAMP)=OFLAG2(LAMP).OR.TCHBT
420           OFLAG2(LAMP)=OR(OFLAG2(LAMP),TCHBT)
421           CFLAG(CEVLNT)=.FALSE.                             ! lamp is good as new.
422           CTICK(CEVLNT)=350
423           ORLAMP=0
424 C old     OFLAG2(SWORD)=OFLAG2(SWORD).OR.TCHBT    ! recreate sword.
425           OFLAG2(SWORD)=OR(OFLAG2(SWORD),TCHBT)   ! recreate sword.
426           SWDACT=.TRUE.
427           SWDSTA=0
428 C
429           THFACT=.FALSE.                                    ! thief gone.
430           ENDGMF=.TRUE.                                     ! endgame running.
431           CFLAG(CEVEGH)=.FALSE.                             ! herald gone,
432           CFLAG(CEVMAT)=.FALSE.                             ! matches gone,
433           CFLAG(CEVCND)=.FALSE.                             ! candles gone.
434 C
435           CALL SCRUPD(RVAL(CRYPT))                ! score crypt,
436           RVAL(CRYPT)=0                                     ! but only once.
437           F=MOVETO(TSTRS,WINNER)                            ! to top of stairs,
438           F=RMDESC(3)                                       ! and describe.
439           RETURN                                            ! bam!
440 C
441 C CEV21-- Mirror closes.
442 C
443 21000     MRPSHF=.FALSE.                                    ! button is out.
444           MROPNF=.FALSE.                                    ! mirror is closed.
445           IF(HERE.EQ.MRANT) CALL RSPEAK(728)      ! describe button.
446           IF((HERE.EQ.INMIR).OR.(MRHERE(HERE).EQ.1))
447           &         CALL RSPEAK(729)              ! describe mirror.
448           RETURN
449 C page
450 C CEVAPP, PAGE 9
451 C
452 C CEV22-- Door closes.
453 C
454 22000     IF(WDOPNF) CALL RSPEAK(730)             ! describe.
455           WDOPNF=.FALSE.                                    ! closed.
456           RETURN
457 C
458 C CEV23-- Inquisitor's question.
459 C
460 23000     IF(AROOM(PLAYER).NE.FDOOR) RETURN       ! if player left, die.
461           CALL RSPEAK(769)
462           CALL RSPEAK(770+QUESNO)
463           CFLAG(CEVINQ)=.TRUE.
464           CTICK(CEVINQ)=2
465           RETURN
466 C
467 C CEV24-- Master follows.
468 C
469 24000     IF(AROOM(AMASTR).EQ.HERE) RETURN        ! no movement, done.
470           IF((HERE.NE.CELL).AND.(HERE.NE.PCELL)) GO TO 24100
471           IF(FOLLWF) CALL RSPEAK(811)             ! wont go to cells.
472           FOLLWF=.FALSE.
473           RETURN
474 C
475 24100     FOLLWF=.TRUE.                                     ! following.
476           I=812                                             ! assume catches up.
477           DO 24200 J=XMIN,XMAX,XMIN
478             IF(FINDXT(J,AROOM(AMASTR)).AND.(XROOM1.EQ.HERE))
479           &         I=813                                   ! assume follows.
480 24200     CONTINUE
481           CALL RSPEAK(I)
482           CALL NEWSTA(MASTER,0,HERE,0,0)                    ! move master object.
483           AROOM(AMASTR)=HERE                      ! move master actor.
484           RETURN
485 C
486 C CEV25-- Brochure arrives.
487 C
488 25000     CALL NEWSTA(BROCH,948,0,MAILB,0)        ! put brochure in mailbox
489           BROC2F=.TRUE.                                     ! flag arrival
490           RETURN
491 C page
492 C CEVAPP, PAGE 10
493 C
494 C CEV26-- Cyclops.
495 C
496 26000     IF(HERE.NE.MCYCL.OR.MAGICF) GO TO 26500 ! player or cyclops gone?
497           IF(CYCLOF) RETURN                       ! if asleep, check later
498           IF(IABS(RVCYC).LE.5) GO TO 26200        ! cyclops overly annoyed?
499           CFLAG(CEVCYC)=.FALSE.                             ! disable cyclops timer
500           CALL JIGSUP(188)                        ! player munched for lunch
501           RETURN
502 C
503 26200     IF(RVCYC.LT.0) RVCYC=RVCYC-1            ! cyclops gets more annoyed
504           IF(RVCYC.GE.0) RVCYC=RVCYC+1
505           CALL RSPEAK(193+IABS(RVCYC))            ! report cyclops state
506           RETURN
507 C
508 26500     CFLAG(CEVCYC)=.FALSE.                             ! disable cyclops timer
509           RETURN
510 C
511 C CEV27-- Slippery slide.
512 C
513 27000     IF((HERE.LT.SLID1).OR.(HERE.GE.SLEDG)) RETURN     ! in slide?
514           CALL RSPEAK(1034)                       ! slide to cellar
515           F=MOVETO(CELLA,WINNER)                            ! into cellar
516           F=RMDESC(3)                                       ! describe
517           RETURN
518 C
519 C CEV28-- Exorcism bell.
520 C
521 28000     IF(.NOT.EXORCF.AND.(HERE.EQ.LLD1)) CALL RSPEAK(970)
522           EXORBF=.FALSE.                                    ! spell broken
523           RETURN
524 C
525 C CEV29-- Exorcism candles.
526 C
527 29000     EXORCF=.FALSE.                                    ! spell broken
528           GO TO 28000
529 C
530 C CEV30-- Hot bell cools down.
531 C
532 30000     CALL NEWSTA(HBELL,0,0,0,0)              ! banish hot bell
533           CALL NEWSTA(BELL,0,LLD1,0,0)            ! get normal bell
534           IF(LASTIT.EQ.HBELL) LASTIT=BELL                   ! fix last it reference.
535           IF(HERE.EQ.LLD1) CALL RSPEAK(971)       ! tell player if here
536           RETURN
537 C
538           END
539 C page
540 C LITINT- Light interrupt processor
541 C
542 C Declarations
543 C
544           SUBROUTINE LITINT(OBJ,CTR,CEV,TICKS,TICKLN)
545           IMPLICIT INTEGER (A-Z)
546           %include dparam
547           INTEGER TICKS(TICKLN)
548 C
549           CTR=CTR+1                               ! advance state cntr.
550           CTICK(CEV)=TICKS(CTR)                             ! reset interrupt.
551           IF(CTICK(CEV).NE.0) GO TO 100           ! expired?
552 C old     OFLAG1(OBJ)=OFLAG1(OBJ).AND. .NOT.(LITEBT+FLAMBT+ONBT)
553           OFLAG1(OBJ)=AND(OFLAG1(OBJ), COMPL(LITEBT+FLAMBT+ONBT))
554           IF((OROOM(OBJ).EQ.HERE).OR.(OADV(OBJ).EQ.WINNER))
555           &         CALL RSPSUB(293,ODESC2(OBJ))
556           RETURN
557 C
558 100       CFLAG(CEV)=.TRUE.
559           IF((OROOM(OBJ).EQ.HERE).OR.(OADV(OBJ).EQ.WINNER))
560           &         CALL RSPEAK(TICKS(CTR+(TICKLN/2)))
561           RETURN
562 C
563           END
564 C page
565 C FIGHTD- Intermove fight demon
566 C
567 C Declarations
568 C
569           SUBROUTINE FIGHTD
570           IMPLICIT INTEGER (A-Z)
571           %include dparam
572           LOGICAL PROB,OAPPLI,F
573 C
574 C Functions and data
575 C
576           DATA ROUT/1/
577 C page
578 C FIGHTD, PAGE 2
579 C
580           DO 2400 I=1,VLNT                        ! loop thru villains.
581             VOPPS(I)=0                                      ! clear opponent slot.
582             OBJ=VILLNS(I)                                   ! get object no.
583             RA=OACTIO(OBJ)                        ! get his action.
584             IF(HERE.NE.OROOM(OBJ)) GO TO 2200     ! adventurer still here?
585             IF((OBJ.NE.THIEF).OR. .NOT.THFENF) GO TO 2010 ! thief engrossed?
586             THFENF=.FALSE.                        ! yes, not anymore.
587             GO TO 2400
588 C
589 2010        IF(OCAPAC(OBJ).GE.0) GO TO 2050       ! no, vill awake?
590             IF((VPROB(I).EQ.0).OR..NOT.PROB(VPROB(I),(100+VPROB(I))/2))
591           &         GO TO 2025                              ! no, see if wakes up.
592             OCAPAC(OBJ)=IABS(OCAPAC(OBJ))
593             VPROB(I)=0
594             IF(RA.EQ.0) GO TO 2400                ! anything to do?
595             PRSA=INXW                                       ! yes, wake him up.
596             F=OAPPLI(RA,0)
597             GO TO 2400                                      ! nothing else happens.
598 C
599 2025        VPROB(I)=VPROB(I)+10                            ! increase wakeup prob.
600             GO TO 2400                                      ! nothing else.
601 C
602 C old 2050            IF((OFLAG2(OBJ).AND.FITEBT).EQ.0) GO TO 2100
603 2050        IF((AND(OFLAG2(OBJ),FITEBT)).EQ.0) GO TO 2100
604             VOPPS(I)=OBJ                                    ! fighting, set up opp.
605             GO TO 2400
606 C
607 2100        IF(RA.EQ.0) GO TO 2400                ! not fighting,
608             PRSA=FRSTQW                                     ! set up probability
609             IF(.NOT.OAPPLI(RA,0)) GO TO 2400      ! of fighting.
610 C old       OFLAG2(OBJ)=OFLAG2(OBJ).OR.FITEBT
611             OFLAG2(OBJ)=OR(OFLAG2(OBJ),FITEBT)
612             VOPPS(I)=OBJ                                    ! set up opp.
613             PRSCON=0                                        ! stop cmd stream.
614             GO TO 2400
615 C
616 C old 2200            IF(((OFLAG2(OBJ).AND.FITEBT).EQ.0).OR.(RA.EQ.0))
617 C old     &         GO TO 2300                              ! nothing to do.
618 2200        IF(((AND(OFLAG2(OBJ),FITEBT)).EQ.0).OR.(RA.EQ.0))
619           &         GO TO 2300                              ! nothing to do.
620             PRSA=FIGHTW                                     ! have a fight.
621             F=OAPPLI(RA,0)
622 2300        IF(OBJ.EQ.THIEF) THFENF=.FALSE.       ! turn off engrossed.
623 C old       AFLAG(PLAYER)=AFLAG(PLAYER).AND. .NOT.ASTAG
624             AFLAG(PLAYER)=AND(AFLAG(PLAYER), COMPL(ASTAG))
625 C old       OFLAG2(OBJ)=OFLAG2(OBJ).AND. .NOT.(STAGBT+FITEBT)
626             OFLAG2(OBJ)=AND(OFLAG2(OBJ), COMPL(STAGBT+FITEBT))
627             IF((OCAPAC(OBJ).GE.0).OR.(RA.EQ.0))
628           &         GO TO 2400
629             PRSA=INXW                                       ! wake him up.
630             F=OAPPLI(RA,0)
631             OCAPAC(OBJ)=IABS(OCAPAC(OBJ))
632 2400      CONTINUE
633 C page
634 C FIGHTD, PAGE 3
635 C
636 C Now do actual counterblows.
637 C
638           OUT=0                                             ! assume hero ok.
639 2600      DO 2700 I=1,VLNT                        ! loop thru opps.
640             J=VOPPS(I)
641             IF(J.EQ.0) GO TO 2700                           ! slot empty?
642             PRSCON=0                                        ! stop cmd stream.
643             RA=OACTIO(J)
644             IF(RA.EQ.0) GO TO 2650                ! villain action?
645             PRSA=FIGHTW                                     ! see if
646             IF(OAPPLI(RA,0)) GO TO 2700           ! special action.
647 2650        RES=BLOW(PLAYER,J,VMELEE(I),.FALSE.,OUT) ! strike blow.
648             IF(RES.LT.0) RETURN                             ! if hero dead, exit.
649             IF(RES.EQ.ROUT) OUT=2+RND(3)                    ! if hero out, set flg.
650 2700      CONTINUE
651           OUT=OUT-1                               ! decrement out count.
652           IF(OUT.GT.0) GO TO 2600                           ! if still out, go again.
653           RETURN
654 C
655           END
656 C page
657 C BLOW- Strike blow
658 C
659 C Declarations
660 C
661           INTEGER FUNCTION BLOW(H,V,RMK,HFLG,OUT)
662           IMPLICIT INTEGER (A-Z)
663           %include dparam
664           LOGICAL HFLG,OAPPLI,PROB,F
665           INTEGER DEF1R(3),DEF2R(4),DEF3R(5)
666           INTEGER RVECTR(66),RSTATE(45)
667 C
668 C Functions and data
669 C
670           DATA RMISS/0/,ROUT/1/,RKILL/2/,RXXX/3/
671           DATA RSER/4/,RSTAG/5/,RLOSE/6/,RHES/7/,RSIT/8/
672           DATA DEF1R/1,2,3/
673           DATA DEF2R/13,23,24,25/
674           DATA DEF3R/35,36,46,47,57/
675 C
676           DATA RVECTR/0,0,0,0,5,5,1,1,2,2,2,2,
677           &         0,0,0,0,0,5,5,3,3,1,
678           &         0,0,0,5,5,3,3,3,1,2,2,2,
679           &         0,0,0,0,0,5,5,3,3,4,4,
680           &         0,0,0,5,5,3,3,3,4,4,4,
681           &         0,5,5,3,3,3,3,4,4,4/
682           DATA RSTATE/5000,3005,3008,4011,3015,3018,1021,0,0,
683           &         5022,3027,3030,4033,3037,3040,1043,0,0,
684           &         4044,2048,4050,4054,5058,4063,4067,3071,1074,
685           &         4075,1079,4080,4084,4088,4092,4096,4100,1104,
686           &         4105,2109,4111,4115,4119,4123,4127,3131,3134/
687 C page
688 C BLOW, PAGE 2
689 C
690           RA=OACTIO(V)                                      ! get villain action,
691           DV=ODESC2(V)                                      ! description.
692           BLOW=RMISS                                        ! assume no result.
693 C D       TYPE 10,H,V,RMK,HFLG,OUT
694 C D10     FORMAT(' BLOW 10-- ',3I7,L7,I7)
695           IF(.NOT.HFLG) GO TO 1000                ! hero striking blow?
696 C
697 C Hero is attacker, villain is defender.
698 C
699           PBLOSE=10                               ! bad lk prob.
700 C old     OFLAG2(V)=OFLAG2(V).OR.FITEBT           ! yes, villain gets mad.
701           OFLAG2(V)=OR(OFLAG2(V),FITEBT)          ! yes, villain gets mad.
702 C old     IF((AFLAG(H).AND.ASTAG).EQ.0) GO TO 100 ! hero stag?
703           IF((AND(AFLAG(H),ASTAG)).EQ.0) GO TO 100          ! hero stag?
704           CALL RSPEAK(591)                        ! yes, cant fight.
705 C old     AFLAG(H)=AFLAG(H).AND. .NOT.ASTAG
706           AFLAG(H)=AND(AFLAG(H), COMPL(ASTAG))
707           RETURN
708 C
709 100       ATT=MAX0(1,FIGHTS(H,.TRUE.))            ! get his strength.
710           OA=ATT
711           DEF=VILSTR(V)                                     ! get vill strength.
712           OD=DEF
713           DWEAP=0                                           ! assume no weapon.
714           DO 200 I=1,OLNT                                   ! search villain.
715 C old       IF((OCAN(I).EQ.V).AND.((OFLAG2(I).AND.WEAPBT).NE.0))
716 C old     &         DWEAP=I
717             IF((OCAN(I).EQ.V).AND.((AND(OFLAG2(I),WEAPBT)).NE.0))
718           &         DWEAP=I
719 200       CONTINUE
720           IF(V.EQ.AOBJ(PLAYER)) GO TO 300                   ! killing self?
721           IF(DEF.NE.0) GO TO 2000                           ! defender alive?
722           CALL RSPSUB(592,DV)                     ! villain dead.
723           RETURN
724 C
725 300       CALL JIGSUP(593)                        ! killing self.
726           RETURN
727 C
728 C Villain is attacker, hero is defender.
729 C
730 1000      PRSCON=0                                ! stop cmd stream.
731           PBLOSE=50                               ! bad lk prob.
732 C old     AFLAG(H)=AFLAG(H).AND..NOT.ASTAG        ! vill striking.
733           AFLAG(H)=AND(AFLAG(H),COMPL(ASTAG))     ! vill striking.
734 C old     IF((OFLAG2(V).AND.STAGBT).EQ.0) GO TO 1200 ! vill staggered?
735           IF((AND(OFLAG2(V),STAGBT)).EQ.0) GO TO 1200 ! vill staggered?
736 C old     OFLAG2(V)=OFLAG2(V).AND. .NOT.STAGBT    ! make him ok.
737           OFLAG2(V)=AND(OFLAG2(V), COMPL(STAGBT)) ! make him ok.
738           CALL RSPSUB(594,DV)                     ! describe.
739           RETURN
740 C
741 1200      ATT=VILSTR(V)                                     ! set up att, def.
742           OA=ATT
743           DEF=FIGHTS(H,.TRUE.)
744           IF(DEF.LE.0) RETURN                     ! dont allow dead def.
745           OD=FIGHTS(H,.FALSE.)
746           DWEAP=IABS(FWIM(0,WEAPBT,0,0,H,.TRUE.)) ! find a weapon.
747 C page
748 C BLOW, PAGE 3
749 C
750 C Parties are now equipped.  DEF cannot be zero.
751 C ATT must be > 0.
752 C
753 2000      CONTINUE
754 C D       TYPE 2050,ATT,OA,DEF,OD,DWEAP
755 C D2050   FORMAT(' BLOW 2050-- ',5I7)
756           IF(DEF.GT.0) GO TO 2100                           ! def alive?
757           RES=RKILL
758           IF(HFLG) CALL RSPSUB(595,DV)            ! deader.
759           GO TO 3000
760 C
761 2100      IF(DEF-2) 2200,2300,2400                ! def <2,=2,>2
762 2200      ATT=MIN0(ATT,3)                                   ! scale att.
763           TBL=DEF1R(ATT)                                    ! choose table.
764           GO TO 2500
765 C
766 2300      ATT=MIN0(ATT,4)                                   ! scale att.
767           TBL=DEF2R(ATT)                                    ! choose table.
768           GO TO 2500
769 C
770 2400      ATT=ATT-DEF                                       ! scale att.
771           ATT=MIN0(2,MAX0(-2,ATT))+3
772           TBL=DEF3R(ATT)
773 C
774 2500      RES=RVECTR(TBL+RND(10))                           ! get result.
775           IF(OUT.EQ.0) GO TO 2600                           ! was he out?
776           IF(RES.EQ.RSTAG) GO TO 2550             ! yes, stag--> hes.
777           RES=RSIT                                ! otherwise, sitting.
778           GO TO 2600
779 2550      RES=RHES
780 2600      IF((RES.EQ.RSTAG).AND.(DWEAP.NE.0).AND.PROB(25,PBLOSE))
781           &         RES=RLOSE                     ! lose weapon.
782 C
783           MI=RSTATE(((RMK-1)*9)+RES+1)            ! choose table entry.
784           IF(MI.EQ.0) GO TO 3000
785           I=(MOD(MI,1000)+RND(MI/1000))+MBASE+1
786           J=DV
787           IF(.NOT.HFLG .AND.(DWEAP.NE.0)) J=ODESC2(DWEAP)
788 C D       TYPE 2650,RES,MI,I,J,MBASE
789 C D2650   FORMAT(' BLOW 2650-- ',5I7)
790           CALL RSPSUB(I,J)                        ! present result.
791 C page
792 C BLOW, PAGE 4
793 C
794 C Now apply result.
795 C
796 3000      GO TO (4000,3100,3200,3300,3400,3500,3600,4000,3200),RES+1
797 C                miss, out,kill,lght,svre,stag,lose, hes, sit
798 C
799 3100      IF(HFLG) DEF=-DEF                       ! unconscious.
800           GO TO 4000
801 C
802 3200      DEF=0                                             ! killed or sitting duck.
803           GO TO 4000
804 C
805 3300      DEF=MAX0(0,DEF-1)                       ! light wound.
806           GO TO 4000
807 C
808 3400      DEF=MAX0(0,DEF-2)                       ! serious wound.
809           GO TO 4000
810 C
811 3500      IF(HFLG) GO TO 3550                     ! staggered.
812 C old     AFLAG(H)=AFLAG(H).OR.ASTAG
813           AFLAG(H)=OR(AFLAG(H),ASTAG)
814           GO TO 4000
815 C
816 C old 3550          OFLAG2(V)=OFLAG2(V).OR.STAGBT
817 3550      OFLAG2(V)=OR(OFLAG2(V),STAGBT)
818           GO TO 4000
819 C
820 3600      CALL NEWSTA(DWEAP,0,HERE,0,0)           ! lose weapon.
821           DWEAP=0
822           IF(HFLG) GO TO 4000                     ! if hero, done.
823           DWEAP=IABS(FWIM(0,WEAPBT,0,0,H,.TRUE.)) ! get new.
824           IF(DWEAP.NE.0) CALL RSPSUB(605,ODESC2(DWEAP))
825 C page
826 C BLOW, PAGE 5
827 C
828 4000      BLOW=RES                                ! return result.
829           IF(.NOT.HFLG) GO TO 4500                ! hero?
830           OCAPAC(V)=DEF                                     ! store new capacity.
831           IF(DEF.NE.0) GO TO 4100                           ! dead?
832 C old     OFLAG2(V)=OFLAG2(V).AND. .NOT.FITEBT    ! yes, not fighting.
833           OFLAG2(V)=AND(OFLAG2(V), COMPL(FITEBT)) ! yes, not fighting.
834           CALL RSPSUB(572,DV)                     ! he dies.
835           CALL NEWSTA(V,0,0,0,0)                            ! make him disappear.
836           IF(RA.EQ.0) RETURN                      ! if nx to do, exit.
837           PRSA=DEADXW                                       ! let him know.
838           F=OAPPLI(RA,0)
839           RETURN
840 C
841 4100      IF((RES.NE.ROUT).OR.(RA.EQ.0)) RETURN
842           PRSA=OUTXW                                        ! let him be out.
843           F=OAPPLI(RA,0)
844           RETURN
845 C
846 4500      ASTREN(H)=-10000                        ! assume dead.
847           IF(DEF.NE.0) ASTREN(H)=DEF-OD
848           IF(DEF.GE.OD) GO TO 4600
849           CTICK(CEVCUR)=30
850           CFLAG(CEVCUR)=.TRUE.
851 4600      IF(FIGHTS(H,.TRUE.).GT.0) RETURN
852           ASTREN(H)=1-FIGHTS(H,.FALSE.)           ! he's dead.
853           CALL JIGSUP(596)
854           BLOW=-1
855           RETURN
856 C
857           END
858 C page
859 C SWORDD- Intermove sword demon
860 C
861 C Declarations
862 C
863           SUBROUTINE SWORDD
864           IMPLICIT INTEGER (A-Z)
865           %include dparam
866           LOGICAL INFEST,FINDXT
867 C
868           IF(OADV(SWORD).NE.PLAYER) GO TO 500     ! holding sword?
869           NG=2                                              ! assume vill close.
870           IF(INFEST(HERE)) GO TO 300              ! vill here?
871           NG=1
872           DO 200 I=XMIN,XMAX,XMIN                           ! no, search rooms.
873             IF(.NOT.FINDXT(I,HERE)) GO TO 200     ! room that way?
874             GO TO (50,200,50,50),XTYPE            ! see if room at all.
875 50          IF(INFEST(XROOM1)) GO TO 300                    ! check room.
876 200       CONTINUE
877           NG=0                                              ! no glow.
878 C
879 300       IF(NG.EQ.SWDSTA) RETURN                           ! any state change?
880           CALL RSPEAK(NG+495)                     ! yes, tell new state.
881           SWDSTA=NG
882           RETURN
883 C
884 500       SWDACT=.FALSE.                                    ! dropped sword,
885           RETURN                                            ! disable demon.
886           END