1 C Room processors 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 11-Sep-94         RMS       Fixed bugs in Tree, Slide, Cave2, Magnet, object
  8 C                             substitution.  Added Puzzle Anteroom.
  9 C 30-Jun-92         RMS       Changed file names to lower case.
 10 C
 11 C RAPPLI- Room routines
 12 C
 13 C Declarations
 14 C
 15           SUBROUTINE RAPPLI(RI)
 16           IMPLICIT INTEGER (A-Z)
 17           %include dparam
 18           LOGICAL QOPEN,QON,QHERE,PROB,F
 19           LOGICAL MOVETO,LIT,RMDESC,QEMPTY
 20 C
 21 C Functions and data
 22 C
 23 C old     QOPEN(R)=(OFLAG2(R).AND.OPENBT).NE.0
 24           QOPEN(R)=AND(OFLAG2(R),OPENBT).NE.0
 25 C old     QON(R)=(OFLAG1(R).AND.ONBT).NE.0
 26           QON(R)=AND(OFLAG1(R),ONBT).NE.0
 27 C
 28           IF(RI.EQ.0) RETURN                      ! return if naught.
 29           GO TO (  1000, 2000, 3000, 4000, 5000, 6000, 7000, 8000, 9000,
 30           & 10000,11000,12000,13000,14000,15000,16000,17000,18000,19000,
 31           & 20000,21000,22000,23000,24000,25000,26000,27000,28000,29000,
 32           & 30000,31000,32000,33000,34000,35000,36000,37000,38000,39000,
 33           & 40000,41000,42000,43000,44000,45000,46000,47000,48000,49000,
 34           & 50000,51000,52000,53000,54000,55000,56000,57000,58000,59000,
 35           & 60000,61000,62000,63000,64000),RI
 36           CALL BUG(1,RI)
 37 C page
 38 C RAPPLI, PAGE 2
 39 C
 40 C R1--    East of house
 41 C
 42 1000      IF(PRSA.NE.LOOKW) RETURN                ! look?
 43           I=13                                              ! assume closed.
 44           IF(QOPEN(WINDO)) I=12                             ! if open, ajar.
 45           CALL RSPSUB(11,I)                       ! describe.
 46           RETURN
 47 C
 48 C R2--    Kitchen
 49 C
 50 2000      IF(PRSA.NE.LOOKW) GO TO 2100            ! look?
 51           I=13                                              ! assume closed.
 52           IF(QOPEN(WINDO)) I=12                             ! if open, ajar.
 53           CALL RSPSUB(14,I)                       ! describe.
 54           RETURN
 55 C
 56 2100      IF((PRSA.NE.WALKIW).OR.DEADF.OR..NOT.BROC1F.OR.BROC2F) RETURN
 57           CFLAG(CEVBRO)=.TRUE.                              ! send for brochure.
 58           CTICK(CEVBRO)=3
 59           RETURN
 60 C
 61 C R3--    Living Room
 62 C
 63 3000      IF(PRSA.NE.LOOKW) GO TO 3500            ! look?
 64           I=15                                              ! assume no hole.
 65           IF(MAGICF) I=16                                   ! if magicf, cyclops hole.
 66           CALL RSPEAK(I)                                    ! describe.
 67           I=17+ORRUG                                        ! assume initial state.
 68           IF(QOPEN(DOOR)) I=I+2                             ! door open?
 69           CALL RSPEAK(I)                                    ! describe.
 70           RETURN
 71 C
 72 C Not a look word, reevaluate trophy case.
 73 C
 74 3500      IF((PRSA.NE.TAKEW).AND.((PRSA.NE.PUTW).OR.(PRSI.NE.TCASE)))
 75           &         RETURN                                  ! take or put in?
 76           ASCORE(WINNER)=RWSCOR                             ! score trophy case.
 77           DO 3600 I=1,OLNT                        ! retain raw score as well.
 78             J=I                                             ! find out if in case.
 79 3550        J=OCAN(J)                                       ! trace ownership.
 80             IF(J.EQ.0) GO TO 3600
 81             IF(J.NE.TCASE) GO TO 3550             ! do all levels.
 82             ASCORE(WINNER)=ASCORE(WINNER)+OTVAL(I)
 83 3600      CONTINUE
 84           CALL SCRUPD(0)                                    ! see if endgame trig.
 85           RETURN
 86 C page
 87 C RAPPLI, PAGE 3
 88 C
 89 C R4--    Cellar
 90 C
 91 4000      IF(PRSA.NE.LOOKW) GO TO 4500            ! look?
 92           CALL RSPEAK(21)                                   ! describe cellar.
 93           IF(QOPEN(DOOR)) CALL RSPEAK(623)        ! describe trap door if open.
 94           RETURN
 95 C
 96 4500      IF(PRSA.NE.WALKIW) RETURN               ! walkin?
 97 C old     IF((OFLAG2(DOOR).AND.(OPENBT+TCHBT)).NE.OPENBT) RETURN
 98           IF(AND(OFLAG2(DOOR),(OPENBT+TCHBT)).NE.OPENBT) RETURN
 99 C old     OFLAG2(DOOR)=(OFLAG2(DOOR).OR.TCHBT).AND. .NOT.OPENBT
100           OFLAG2(DOOR)=AND(OR(OFLAG2(DOOR),TCHBT), COMPL(OPENBT))
101           CALL RSPEAK(22)                                   ! slam and bolt door.
102           RETURN
103 C
104 C R5--    Grating Room
105 C
106 5000      IF(PRSA.NE.LOOKW) RETURN                ! look?
107           CALL RSPEAK(23)                                   ! describe.
108           I=24                                              ! assume locked.
109           IF(GRUNLF) I=26                                   ! unlocked?
110           IF(QOPEN(GRATE)) I=25                             ! open?
111           CALL RSPEAK(I)                                    ! describe grate.
112           RETURN
113 C
114 C R6--    Clearing
115 C
116 6000      IF(PRSA.NE.LOOKW) RETURN                ! look?
117           CALL RSPEAK(27)                                   ! describe.
118           I=0                                               ! assume no grating.
119           IF(RVCLR.NE.0) I=28                     ! leaves moved?
120           IF(QOPEN(GRATE)) I=29                             ! grate open?
121           CALL RSPEAK(I)                                    ! describe grate.
122           RETURN
123 C page
124 C RAPPLI, PAGE 4
125 C
126 C R7--    Reservoir south
127 C
128 7000      IF(PRSA.NE.LOOKW) RETURN                ! look?
129           I=31                                              ! assume full.
130           IF(LWTIDF) I=32                                   ! if low tide, empty.
131           CALL RSPEAK(I)                                    ! describe.
132           CALL RSPEAK(33)                                   ! describe exits.
133           RETURN
134 C
135 C R8--    Reservoir
136 C
137 8000      IF(PRSA.NE.LOOKW) RETURN                ! look?
138           I=34                                              ! assume full.
139           IF(LWTIDF) I=35                                   ! if low tide, emtpy.
140           CALL RSPEAK(I)                                    ! describe.
141           RETURN
142 C
143 C R9--    Reservoir north
144 C
145 9000      IF(PRSA.NE.LOOKW) RETURN                ! look?
146           I=36                                              ! you get the idea.
147           IF(LWTIDF) I=37
148           CALL RSPEAK(I)
149           CALL RSPEAK(38)
150           RETURN
151 C
152 C R10--   Glacier Room
153 C
154 10000     IF(PRSA.NE.LOOKW) RETURN                ! look?
155           CALL RSPEAK(39)                                   ! basic description.
156           I=0                                               ! assume no changes.
157           IF(GLACMF) I=40                                   ! partial melt?
158           IF(GLACRF) I=41                                   ! complete melt?
159           CALL RSPEAK(I)                                    ! describe.
160           RETURN
161 C
162 C R11--   Forest Room
163 C
164 11000     IF(PRSA.NE.WALKIW) RETURN
165           CFLAG(CEVFOR)=.TRUE.                              ! if walk in, birdie.
166           CTICK(CEVFOR)=-1
167           RETURN
168 C
169 C R12--   Mirror Room
170 C
171 12000     IF(PRSA.NE.LOOKW) RETURN                ! look?
172           CALL RSPEAK(42)                                   ! describe.
173           IF(MIRRMF) CALL RSPEAK(43)              ! if broken, nasty remark.
174           RETURN
175 C page
176 C RAPPLI, PAGE 5
177 C
178 C R13--   Cave2
179 C
180 13000     IF(PRSA.NE.WALKIW) RETURN               ! walkin?
181           IF(PROB(50,20).OR.(OADV(CANDL).NE.WINNER).OR.
182           &         .NOT.QON(CANDL)) RETURN                 ! blow em out?
183 C old     OFLAG1(CANDL)=OFLAG1(CANDL).AND. .NOT. ONBT       ! yes.
184           OFLAG1(CANDL)=AND(OFLAG1(CANDL), COMPL(ONBT))     ! yes.
185           CALL RSPEAK(47)                                   ! tell of winds.
186           CFLAG(CEVCND)=.FALSE.                             ! halt candle countdown.
187           IF(.NOT.LIT(HERE)) CALL RSPEAK(406)     ! now pitch black.
188           RETURN
189 C
190 C R14--   Boom Room
191 C
192 14000     J=ODESC2(CANDL)                                   ! assume candle.
193           IF((OADV(CANDL).EQ.WINNER).AND.QON(CANDL)) GO TO 14100
194           J=ODESC2(TORCH)                                   ! assume torch.
195           IF((OADV(TORCH).EQ.WINNER).AND.QON(TORCH)) GO TO 14100
196           J=ODESC2(MATCH)
197           IF((OADV(MATCH).EQ.WINNER).AND.QON(MATCH)) GO TO 14100
198           RETURN                                            ! safe
199 C
200 14100     IF((PRSA.NE.TRNONW).AND.(PRSA.NE.BURNW))
201           &         GO TO 14200                             ! turn on or burn?
202           CALL RSPSUB(294,J)                      ! boom!
203           CALL JIGSUP(44)
204           RETURN
205 C
206 14200     IF(PRSA.NE.WALKIW) RETURN               ! walkin?
207           CALL RSPSUB(295,J)                      ! boom!
208           CALL JIGSUP(44)
209           RETURN
210 C
211 C R15--   No-objs
212 C
213 15000     EMPTHF=.TRUE.                                     ! assume true.
214           DO 15100 I=1,OLNT                       ! see if carrying.
215             IF(OADV(I).EQ.WINNER) EMPTHF=.FALSE.
216 15100     CONTINUE
217 C
218           IF((HERE.NE.BSHAF).OR.(.NOT.LIT(HERE))) RETURN
219           CALL SCRUPD(LTSHFT)                     ! score light shaft.
220           LTSHFT=0                                ! never again.
221           RETURN
222 C page
223 C RAPPLI, PAGE 6
224 C
225 C R16--   Machine Room
226 C
227 16000     IF(PRSA.NE.LOOKW) RETURN                ! look?
228           I=46                                              ! assume lid closed.
229           IF(QOPEN(MACHI)) I=12                             ! if open, open.
230           CALL RSPSUB(45,I)                       ! describe.
231           RETURN
232 C
233 C R17--   Bat Room
234 C
235 17000     IF(PRSA.NE.LOOKW) GO TO 17500           ! look?
236           CALL RSPEAK(48)                                   ! describe room.
237           IF(OADV(GARLI).EQ.WINNER) CALL RSPEAK(49) ! bat holds nose.
238           RETURN
239 C
240 17500     IF((PRSA.NE.WALKIW).OR.(OADV(GARLI).EQ.WINNER)
241           &         .OR.DEADF) RETURN             ! garlic or dead?
242           CALL RSPEAK(50)                                   ! time to fly, jack.
243           F=MOVETO(BATDRP(RND(9)+1),WINNER)       ! select random dest.
244           F=RMDESC(0)                                       ! new room description.
245           PRSCON=0                                ! kill parser.
246           RETURN
247 C
248 C R18--   Dome Room
249 C
250 18000     IF(PRSA.NE.LOOKW) GO TO 18500           ! look?
251           CALL RSPEAK(51)                                   ! describe.
252           IF(DOMEF) CALL RSPEAK(52)               ! if rope, describe.
253           RETURN
254 C
255 18500     IF(PRSA.EQ.LEAPW) CALL JIGSUP(53)       ! did he jump???
256           RETURN
257 C
258 C R19--   Torch Room
259 C
260 19000     IF(PRSA.NE.LOOKW) RETURN                ! look?
261           CALL RSPEAK(54)                                   ! describe.
262           IF(DOMEF) CALL RSPEAK(55)               ! if rope, describe.
263           RETURN
264 C
265 C R20--   Carousel Room
266 C
267 20000     IF(PRSA.NE.LOOKW) GO TO 20500           ! look?
268           CALL RSPEAK(56)                                   ! describe.
269           IF(.NOT.(CAROFF.OR.DEADF)) CALL RSPEAK(57) ! if not flipped, spin.
270           RETURN
271 C
272 20500     IF((PRSA.EQ.WALKIW).AND.CAROZF.AND..NOT.DEADF)
273           &         CALL JIGSUP(58)                         ! walked in, zoom, not dead.
274           RETURN
275 C page
276 C RAPPLI, PAGE 7
277 C
278 C R21--   Land of the Living Dead
279 C
280 21000     IF(PRSA.NE.LOOKW) GO TO 21100           ! look?
281           CALL RSPEAK(59)                                   ! describe.
282           IF(.NOT.LLDF) CALL RSPEAK(60)           ! if not vanished, ghosts.
283           RETURN
284 C
285 21100     IF(LLDF.OR.(PRSA.NE.RINGW).OR.(PRSO.NE.BELL))
286           &         GO TO 21200                             ! ring bell?
287           EXORBF=.TRUE.                                     ! set exorcism bell flag.
288           CALL NEWSTA(BELL,0,0,0,0)               ! vanish bell.
289           CALL NEWSTA(HBELL,967,HERE,0,0)                   ! insert hot bell.
290           IF(LASTIT.EQ.BELL) LASTIT=HBELL                   ! fix last it reference.
291           IF(.NOT.QON(CANDL).OR.(OADV(CANDL).NE.WINNER))
292           &         GO TO 21150                             ! carrying lit candles?
293           CALL NEWSTA(CANDL,968,HERE,0,0)                   ! drop and go out.
294 C old     OFLAG1(CANDL)=OFLAG1(CANDL).AND..NOT.ONBT
295           OFLAG1(CANDL)=AND(OFLAG1(CANDL),COMPL(ONBT))
296           CFLAG(CEVCND)=.FALSE.                             ! disable candle timer.
297 21150     CFLAG(CEVXB)=.TRUE.                     ! start bell timer.
298           CTICK(CEVXB)=6
299           CFLAG(CEVXBH)=.TRUE.                              ! start cooling timer.
300           CTICK(CEVXBH)=20
301           RETURN
302 C
303 C old 21200         IF(.NOT.EXORBF.OR.EXORCF.OR.(OADV(CANDL).NE.WINNER).OR.
304 C old     &         ((OFLAG1(CANDL).AND.ONBT).EQ.0)) GO TO 21300
305 21200     IF(.NOT.EXORBF.OR.EXORCF.OR.(OADV(CANDL).NE.WINNER).OR.
306           &         (AND(OFLAG1(CANDL),ONBT).EQ.0)) GO TO 21300
307           EXORCF=.TRUE.                                     ! set exorcism candle flag.
308           CALL RSPEAK(969)
309           CFLAG(CEVXB)=.FALSE.                              ! turn off bell timer.
310           CFLAG(CEVXC)=.TRUE.                     ! turn on candle timer.
311           CTICK(CEVXC)=3
312           RETURN
313 C
314 21300     IF(.NOT.EXORCF.OR.(PRSA.NE.READW).OR.(PRSO.NE.BOOK))
315           &         GO TO 21400                             ! read book?
316           CALL NEWSTA(GHOST,63,0,0,0)             ! exorcism complete.
317           LLDF=.TRUE.                                       ! set flag.
318           CFLAG(CEVXC)=.FALSE.                              ! turn off candle timer.
319           RETURN
320 C
321 21400     IF(PRSA.NE.EXORCW) RETURN               ! trying exorcism?
322           IF(LLDF) GO TO 21600                              ! trying again?
323           IF((OADV(BELL).EQ.WINNER).AND.(OADV(BOOK).EQ.WINNER).AND.
324           &         (OADV(CANDL).EQ.WINNER).AND.QON(CANDL)) GO TO 21500
325           CALL RSPEAK(62)                                   ! not equipped.
326           RETURN
327 C
328 21500     CALL RSPEAK(1044)                       ! must do it the hard way.
329           RETURN
330 C
331 21600     CALL JIGSUP(61)                                   ! twice, exorcise you.
332           RETURN
333 C page
334 C RAPPLI, PAGE 7A
335 C
336 C R22--   Land of the Living Dead interior
337 C
338 22000     IF(PRSA.NE.LOOKW) RETURN                ! look?
339           CALL RSPEAK(64)                                   ! describe.
340           IF(ONPOLF) CALL RSPEAK(65)              ! on pole?
341           RETURN
342 C
343 C R23--   Dam Room
344 C
345 23000     IF(PRSA.NE.LOOKW) RETURN                ! look?
346           CALL RSPEAK(66)                                   ! describe.
347           I=67
348           IF(LWTIDF) I=68
349           CALL RSPEAK(I)                                    ! describe reservoir.
350           CALL RSPEAK(69)                                   ! describe panel.
351           IF(GATEF) CALL RSPEAK(70)               ! bubble is glowing.
352           RETURN
353 C
354 C R24--   Tree Room
355 C
356 24000     IF(PRSA.NE.LOOKW) GO TO 24300           ! look?
357           CALL RSPEAK(660)                        ! describe.
358           I=661                                             ! set flag for below.
359           DO 24200 J=1,OLNT                       ! describe obj in fore3.
360             IF(.NOT.QHERE(J,FORE3).OR.(J.EQ.FTREE)) GO TO 24200
361             CALL RSPEAK(I)                        ! set stage,
362             I=0
363             CALL RSPSUB(502,ODESC2(J))            ! describe.
364 24200     CONTINUE
365           RETURN
366 C
367 24300     IF(PRSA.NE.WALKIW) GO TO 24400                    ! walk in?
368           CFLAG(CEVFOR)=.TRUE.                              ! start forest noise timer.
369           CTICK(CEVFOR)=-1
370           RETURN
371 C
372 24400     IF((PRSA.NE.DROPW).AND.(PRSA.NE.THROWW).AND.(PRSA.NE.SHAKEW))
373           &         RETURN                                  ! drop, throw, shake?
374           DO 24600 I=1,OLNT                       ! loop through objects
375             IF((I.EQ.TTREE).OR.(I.EQ.NEST).OR.
376           &         .NOT.QHERE(I,HERE)) GO TO 24600 !  is it here?
377             IF(I.EQ.EGG) GO TO 24500              ! egg?
378             CALL NEWSTA(I,0,FORE3,0,0)            ! no, drop to forest floor.
379             CALL RSPSUB(659,ODESC2(I))
380             GO TO 24600
381 C
382 24500       CALL NEWSTA(EGG,0,0,0,0)              ! vanish egg.
383             CALL NEWSTA(BEGG,658,FORE3,0,0)       ! insert broken egg.
384             IF(LASTIT.EQ.EGG) LASTIT=BEGG                   ! fix last it reference.
385             OTVAL(BEGG)=2
386             IF(OCAN(CANAR).NE.EGG) GO TO 24550    ! canary inside?
387             OTVAL(BCANA)=1
388             GO TO 24600
389 24550       CALL NEWSTA(BCANA,0,0,0,0)            ! no, vanish broken canary.
390 24600     CONTINUE
391           RETURN
392 C page
393 C RAPPLI, PAGE 8
394 C
395 C R25--   Cyclops Room
396 C
397 25000     IF(PRSA.NE.LOOKW) GO TO 25100           ! look?
398           CALL RSPEAK(606)                        ! describe.
399           I=607                                             ! assume basic state.
400           IF(RVCYC.GT.0) I=608                              ! >0?  hungry.
401           IF(RVCYC.LT.0) I=609                              ! <0?  thirsty.
402           IF(CYCLOF) I=610                        ! asleep?
403           IF(MAGICF) I=611                        ! gone?
404           CALL RSPEAK(I)                                    ! describe.
405           RETURN
406 C
407 25100     IF((PRSA.NE.WALKIW).OR.(RVCYC.EQ.0).OR.DEADF) RETURN
408           CFLAG(CEVCYC)=.TRUE.                              ! walked in, restart timer.
409           CTICK(CEVCYC)=-1
410           RETURN
411 C
412 C R26--   Bank Box Room
413 C
414 26000     IF(PRSA.NE.WALKIW) RETURN               ! surprise him.
415           DO 26100 I=1,8,2                        ! scolrm depends on
416             IF(FROMDR.EQ.SCOLDR(I)) SCOLRM=SCOLDR(I+1)
417 26100     CONTINUE                                ! entry direction.
418           RETURN
419 C
420 C R27--   Treasure Room
421 C
422 27000     IF((PRSA.NE.WALKIW).OR.DEADF.OR..NOT.THFACT)
423           &         RETURN                                  ! walkin, thief active?
424           IF(OROOM(THIEF).NE.HERE)
425           &         CALL NEWSTA(THIEF,82,HERE,0,0)          ! no, materialize him.
426           THFPOS=HERE                                       ! reset search pattern.
427 C old     OFLAG2(THIEF)=OFLAG2(THIEF).OR.FITEBT   ! he's angry.
428           OFLAG2(THIEF)=OR(OFLAG2(THIEF),FITEBT)  ! he's angry.
429 C
430 C Vanish everything in room.
431 C
432           J=0                                               ! assume nothing to vanish.
433           DO 27200 I=1,OLNT
434             IF((I.EQ.CHALI).OR.(I.EQ.THIEF).OR..NOT.QHERE(I,HERE))
435           &         GO TO 27200                             ! here?
436             J=83                                            ! flag byebye.
437 C old       OFLAG1(I)=OFLAG1(I).AND..NOT.VISIBT   ! away it goes.
438             OFLAG1(I)=AND(OFLAG1(I),COMPL(VISIBT))          ! away it goes.
439 27200     CONTINUE
440           CALL RSPEAK(J)                                    ! describe.
441           RETURN
442 C
443 C R28--   Cliff Room
444 C
445 28000     DEFLAF=OADV(RBOAT).NE.WINNER            ! true if not carrying.
446           RETURN
447 C page
448 C RAPPLI, PAGE 9
449 C
450 C R29--   Rivr4 Room
451 C
452 29000     IF(BUOYF.OR.(OADV(BUOY).NE.WINNER)) RETURN
453           CALL RSPEAK(84)                                   ! give hint,
454           BUOYF=.TRUE.                                      ! then disable.
455           RETURN
456 C
457 C R30--   Overfalls
458 C
459 30000     IF(PRSA.NE.LOOKW) CALL JIGSUP(85)       ! over you go.
460           RETURN
461 C
462 C R31--   Slide Ledge
463 C
464 31000     IF(PRSA.NE.WALKIW) RETURN               ! walk in?
465           CFLAG(CEVSLI)=.FALSE.                             ! disable slippery rope.
466           RETURN
467 C
468 C R32--   Slide
469 C
470 32000     IF(PRSA.NE.LOOKW) RETURN                ! look?
471           CALL RSPEAK(1012)                       ! describe.
472           IF(TTIE.EQ.0) RETURN                              ! timber tied?
473           IF(OROOM(TTIE).EQ.HERE) CALL RSPSUB(1013,ODESC2(TTIE))
474           RETURN
475 C
476 C R33--   Aragain Falls
477 C
478 33000     IF(PRSA.NE.LOOKW) RETURN                ! look?
479           CALL RSPEAK(96)                                   ! describe.
480           I=97                                              ! assume no rainbow.
481           IF(RAINBF) I=98                                   ! got one?
482           CALL RSPEAK(I)                                    ! describe.
483           RETURN
484 C page
485 C RAPPLI, PAGE 10
486 C
487 C R34--   Ledge Room
488 C
489 34000     IF(PRSA.NE.LOOKW) RETURN                ! look?
490           CALL RSPEAK(100)                        ! describe.
491           I=102                                             ! assume safe room ok.
492 C old     IF((RFLAG(MSAFE).AND.RMUNG).NE.0) I=101 ! if munged, room gone.
493           IF(AND(RFLAG(MSAFE),RMUNG).NE.0) I=101  ! if munged, room gone.
494           CALL RSPEAK(I)                                    ! describe.
495           RETURN
496 C
497 C R35--   Safe Room
498 C
499 35000     IF(PRSA.NE.LOOKW) RETURN                ! look?
500           CALL RSPEAK(104)                        ! describe.
501           I=105                                             ! assume ok.
502           IF(SAFEF) I=106                                   ! blown?
503           CALL RSPEAK(I)                                    ! describe.
504           RETURN
505 C
506 C R36--   Magnet Room
507 C
508 36000     IF(PRSA.NE.LOOKW) GO TO 36500           ! look?
509           CALL RSPEAK(107)                        ! describe.
510           RETURN
511 C
512 36500     IF((PRSA.NE.WALKIW).OR.DEADF.OR..NOT.CAROFF) RETURN         ! walkin?
513           IF(CAROZF) GO TO 36600                            ! zoom?
514           IF(WINNER.EQ.PLAYER) CALL RSPEAK(108)   ! no, spin his compass.
515           RETURN
516 C
517 36600     I=58                                              ! spin his insides.
518           IF(WINNER.NE.PLAYER) I=99               ! spin robot.
519           CALL JIGSUP(I)                                    ! dead.
520           RETURN
521 C
522 C R37--   Cage Room
523 C
524 37000     IF(CAGESF) F=MOVETO(CAGER,WINNER)       ! if solved, move.
525           RETURN
526 C page
527 C RAPPLI, PAGE 11
528 C
529 C R38--   Mirror D Room
530 C
531 38000     IF(PRSA.EQ.LOOKW) CALL LOOKTO(FDOOR,MRG,0,682,681)
532           RETURN
533 C
534 C R39--   Mirror G Room
535 C
536 39000     IF(PRSA.EQ.WALKIW) CALL JIGSUP(685)
537           RETURN
538 C
539 C R40--   Mirror C Room
540 C
541 40000     IF(PRSA.EQ.LOOKW) CALL LOOKTO(MRG,MRB,683,0,681)
542           RETURN
543 C
544 C R41--   Mirror B Room
545 C
546 41000     IF(PRSA.EQ.LOOKW) CALL LOOKTO(MRC,MRA,0,0,681)
547           RETURN
548 C
549 C R42--   Mirror A Room
550 C
551 42000     IF(PRSA.EQ.LOOKW) CALL LOOKTO(MRB,0,0,684,681)
552           RETURN
553 C page
554 C RAPPLI, PAGE 12
555 C
556 C R43--   Mirror C East/West
557 C
558 43000     IF(PRSA.EQ.LOOKW) CALL EWTELL(HERE,683)
559           RETURN
560 C
561 C R44--   Mirror B East/West
562 C
563 44000     IF(PRSA.EQ.LOOKW) CALL EWTELL(HERE,686)
564           RETURN
565 C
566 C R45--   Mirror A East/West
567 C
568 45000     IF(PRSA.EQ.LOOKW) CALL EWTELL(HERE,687)
569           RETURN
570 C
571 C R46--   Inside Mirror
572 C
573 46000     IF(PRSA.NE.LOOKW) RETURN                ! look?
574           CALL RSPEAK(688)                        ! describe
575 C
576 C Now describe pole state.
577 C
578 C Cases 1,2--       MDIR=270 & MLOC=MRB, pole is up or in hole
579 C Cases 3,4--       MDIR=0 V MDIR=180, pole is up or in channel
580 C Case 5--          Pole is up
581 C
582           I=689                                             ! assume case 5.
583           IF((MDIR.EQ.270).AND.(MLOC.EQ.MRB))
584           &         I=690+MIN0(POLEUF,1)                    ! cases 1,2.
585           IF(MOD(MDIR,180).EQ.0)
586           &         I=692+MIN0(POLEUF,1)                    ! cases 3,4.
587           CALL RSPEAK(I)                                    ! describe pole.
588           CALL RSPSUB(694,695+(MDIR/45))                    ! describe arrow.
589           RETURN
590 C page
591 C RAPPLI, PAGE 13
592 C
593 C R47--   Mirror Eye Room
594 C
595 47000     IF(PRSA.NE.LOOKW) RETURN                ! look?
596           I=704                                             ! assume beam stop.
597           DO 47100 J=1,OLNT
598             IF(QHERE(J,HERE).AND.(J.NE.RBEAM)) GO TO 47200
599 47100     CONTINUE
600           I=703
601 47200     CALL RSPSUB(I,ODESC2(J))                ! describe beam.
602           CALL LOOKTO(MRA,0,0,0,0)                ! look north.
603           RETURN
604 C
605 C R48--   Inside Crypt
606 C
607 48000     IF(PRSA.NE.LOOKW) RETURN                ! look?
608           I=46                                              ! crypt is open/closed.
609           IF(QOPEN(TOMB)) I=12
610           CALL RSPSUB(705,I)
611           RETURN
612 C
613 C R49--   South Corridor
614 C
615 49000     IF(PRSA.NE.LOOKW) RETURN                ! look?
616           CALL RSPEAK(706)                        ! describe.
617           I=46                                              ! odoor is open/closed.
618           IF(QOPEN(ODOOR)) I=12
619           IF(LCELL.EQ.4) CALL RSPSUB(707,I)       ! describe odoor if there.
620           RETURN
621 C
622 C R50--   Behind Door
623 C
624 50000     IF(PRSA.NE.WALKIW) GO TO 50100                    ! walk in?
625           CFLAG(CEVFOL)=.TRUE.                              ! master follows.
626           CTICK(CEVFOL)=-1
627           RETURN
628 C
629 50100     IF(PRSA.NE.LOOKW) RETURN                ! look?
630           I=46                                              ! qdoor is open/closed.
631           IF(QOPEN(QDOOR)) I=12
632           CALL RSPSUB(708,I)
633           RETURN
634 C page
635 C RAPPLI, PAGE 14
636 C
637 C R51--   Front Door
638 C
639 51000     IF(PRSA.EQ.WALKIW) CTICK(CEVFOL)=0      ! if exits, kill follow.
640           IF(PRSA.NE.LOOKW) RETURN                ! look?
641           CALL LOOKTO(0,MRD,709,0,0)              ! describe south.
642           I=46                                              ! panel is open/closed.
643           IF(CFLAG(CEVINQ).AND.(CTICK(CEVINQ).NE.0)) I=12   ! open if inq in prog.
644           J=46                                              ! qdoor is open/closed.
645           IF(QOPEN(QDOOR)) J=12
646           CALL RSPSB2(710,I,J)
647           RETURN
648 C
649 C R52--   North Corridor
650 C
651 52000     IF(PRSA.NE.LOOKW) RETURN                ! look?
652           I=46
653           IF(QOPEN(CDOOR)) I=12                             ! cdoor is open/closed.
654           CALL RSPSUB(711,I)
655           RETURN
656 C
657 C R53--   Parapet
658 C
659 53000     IF(PRSA.EQ.LOOKW) CALL RSPSUB(712,712+PNUMB)
660           RETURN
661 C
662 C R54--   Cell
663 C
664 54000     IF(PRSA.NE.LOOKW) RETURN                ! look?
665           I=721                                             ! cdoor is open/closed.
666           IF(QOPEN(CDOOR)) I=722
667           CALL RSPEAK(I)
668           I=46                                              ! odoor is open/closed.
669           IF(QOPEN(ODOOR)) I=12
670           IF(LCELL.EQ.4) CALL RSPSUB(723,I)       ! describe.
671           RETURN
672 C
673 C R55--   Prison Cell
674 C
675 55000     IF(PRSA.EQ.LOOKW) CALL RSPEAK(724)      ! look?
676           RETURN
677 C
678 C R56--   Nirvana Cell
679 C
680 56000     IF(PRSA.NE.LOOKW) RETURN                ! look?
681           I=46                                              ! odoor is open/closed.
682           IF(QOPEN(ODOOR)) I=12
683           CALL RSPSUB(725,I)
684           RETURN
685 C page
686 C RAPPLI, PAGE 15
687 C
688 C R57--   Nirvana and end of game
689 C
690 57000     IF(PRSA.NE.WALKIW) RETURN               ! walkin?
691           PAUSE '--More--'
692           CALL RSPEAK(726)
693           PAUSE '--More--'
694           CALL SCORE(.FALSE.)
695           CALL EXIT
696 C
697 C R58--   Tomb Room
698 C
699 58000     IF(PRSA.NE.LOOKW) RETURN                ! look?
700           I=46                                              ! tomb is open/closed.
701           IF(QOPEN(TOMB)) I=12
702           CALL RSPSUB(792,I)
703           RETURN
704 C
705 C R59--   Puzzle Side Room
706 C
707 59000     IF(PRSA.NE.LOOKW) RETURN                ! look?
708           I=861                                             ! assume door closed.
709           IF(CPOUTF) I=862                        ! open?
710           CALL RSPEAK(I)                                    ! describe.
711           RETURN
712 C
713 C R60--   Puzzle Room
714 C
715 60000     IF(PRSA.NE.LOOKW) RETURN                ! look?
716           IF(CPUSHF) GO TO 60100                            ! started puzzle?
717           CALL RSPEAK(868)                        ! no, describe.
718 C old     IF((OFLAG2(WARNI).AND.TCHBT).NE.0) CALL RSPEAK(869)
719           IF((AND(OFLAG2(WARNI),TCHBT)).NE.0) CALL RSPEAK(869)
720           RETURN
721 C
722 60100     CALL CPINFO(880,CPHERE)                           ! describe room.
723           RETURN
724 C page
725 C RAPPLI, PAGE 16
726 C
727 C R61--   Palantir Room
728 C
729 61000     IF(PRSA.NE.LOOKW) GO TO 62400           ! look?
730           CALL RSPEAK(1015)
731           I=699                                             ! string is south.
732           GO TO 62100                                       ! join common code.
733 C
734 C R62--   Prm Room
735 C
736 62000     IF(PRSA.NE.LOOKW) GO TO 62400           ! look?
737           CALL RSPEAK(1016)                       ! string is north.
738           I=695
739 C
740 62100     IF(PLOOKF) GO TO 62400                            ! thru window? skip door.
741           CALL RSPSUB(1017,I)
742           I=1018                                            ! assume lid open.
743           IF(.NOT.QOPEN(HERE-PRM+PLID1)) I=1019   ! closed.
744           CALL RSPEAK(I)                                    ! describe lock.
745           DO 62200 I=1,OLNT                       ! loop through objects.
746             IF(OCAN(I).NE.(HERE-PRM+PKH1)) GO TO 62200
747             CALL RSPSUB(1020,ODESC2(I))           ! object in keyhole.
748             GO TO 62300
749 62200     CONTINUE
750 C
751 62300     IF(QOPEN(PDOOR)) CALL RSPEAK(1042)      ! door open?
752           IF(.NOT.MATF) GO TO 62400               ! mat under door?
753           CALL RSPEAK(1021)
754           IF((MATOBJ.NE.0).AND.((HERE.EQ.PALRM).OR.QOPEN(PDOOR)))
755           &         CALL RSPSUB(1022,ODESC2(MATOBJ))        ! obj on mat?
756           GO TO 62400
757 C
758 62400     PLOOKF=.FALSE.                                    ! clear window flag.
759           IF(PRSO.EQ.0) RETURN                              ! any object?
760           IF((PRSA.NE.TAKEW).OR..NOT.QEMPTY(HERE-PRM+PKH1).OR.
761           &  ((PRSO.NE.SCREW).AND.(PRSO.NE.STICK).AND.
762           &   (PRSO.NE.PKEY).AND.(PRSO.NE.KEYS))) GO TO 62500
763           IF(.NOT.PTOUCF) GO TO 62450             ! touched?
764           IF(QOPEN(HERE-PRM+PLID1)) CALL RSPEAK(1043)       ! lid closes.
765 C old     OFLAG2(HERE-PRM+PLID1)=OFLAG2(HERE-PRM+PLID1).AND..NOT.OPENBT
766           OFLAG2(HERE-PRM+PLID1)=AND(OFLAG2(HERE-PRM+PLID1),COMPL(OPENBT))
767 62450     PTOUCF=.TRUE.                                     ! touched now.
768 C
769 C old 62500         OFLAG1(SCREW)=OFLAG1(SCREW).AND..NOT.NDSCBT
770 62500     OFLAG1(SCREW)=AND(OFLAG1(SCREW),COMPL(NDSCBT))
771 C old     IF((OCAN(SCREW).EQ.PKH1).OR.(OCAN(SCREW).EQ.PKH2))
772 C old     &         OFLAG1(SCREW)=OFLAG1(SCREW).OR.NDSCBT
773           IF((OCAN(SCREW).EQ.PKH1).OR.(OCAN(SCREW).EQ.PKH2))
774           &         OFLAG1(SCREW)=OR(OFLAG1(SCREW),NDSCBT)
775 C old     OFLAG1(STICK)=OFLAG1(STICK).AND..NOT.NDSCBT
776           OFLAG1(STICK)=AND(OFLAG1(STICK),COMPL(NDSCBT))
777 C old     IF((OCAN(STICK).EQ.PKH1).OR.(OCAN(STICK).EQ.PKH2))
778 C old     &         OFLAG1(STICK)=OFLAG1(STICK).OR.NDSCBT
779           IF((OCAN(STICK).EQ.PKH1).OR.(OCAN(STICK).EQ.PKH2))
780           &         OFLAG1(STICK)=OR(OFLAG1(STICK),NDSCBT)
781 C old     OFLAG1(PKEY)=OFLAG1(PKEY).AND..NOT.NDSCBT
782           OFLAG1(PKEY)=AND(OFLAG1(PKEY),COMPL(NDSCBT))
783 C old     IF((OCAN(PKEY).EQ.PKH1).OR.(OCAN(PKEY).EQ.PKH2))
784 C old     &         OFLAG1(PKEY)=OFLAG1(PKEY).OR.NDSCBT
785           IF((OCAN(PKEY).EQ.PKH1).OR.(OCAN(PKEY).EQ.PKH2))
786           &         OFLAG1(PKEY)=OR(OFLAG1(PKEY),NDSCBT)
787 C old     OFLAG1(KEYS)=OFLAG1(KEYS).AND..NOT.NDSCBT
788           OFLAG1(KEYS)=AND(OFLAG1(KEYS),COMPL(NDSCBT))
789 C old     IF((OCAN(KEYS).EQ.PKH1).OR.(OCAN(KEYS).EQ.PKH2))
790 C old     &         OFLAG1(KEYS)=OFLAG1(KEYS).OR.NDSCBT
791           IF((OCAN(KEYS).EQ.PKH1).OR.(OCAN(KEYS).EQ.PKH2))
792           &         OFLAG1(KEYS)=OR(OFLAG1(KEYS),NDSCBT)
793           IF((OROOM(MAT).NE.PRM).AND.(OROOM(MAT).NE.PALRM)) MATF=.FALSE.
794 C old     OFLAG1(MAT)=OFLAG1(MAT).AND..NOT.NDSCBT
795           OFLAG1(MAT)=AND(OFLAG1(MAT),COMPL(NDSCBT))
796           IF(.NOT.MATF) RETURN
797 C old     OFLAG1(MAT)=OFLAG1(MAT).OR.NDSCBT
798           OFLAG1(MAT)=OR(OFLAG1(MAT),NDSCBT)
799           CALL NEWSTA(MAT,0,HERE,0,0)
800           RETURN
801 C page
802 C RAPPLI, PAGE 17
803 C
804 C R63--   Inslide
805 C
806 63000     DO 63100 I=1,OLNT                       ! loop through objects
807 C old       IF(.NOT.QHERE(I,HERE).OR.
808 C old     &         ((OFLAG1(I).AND.TAKEBT).EQ.0)) GO TO 63100
809             IF(.NOT.QHERE(I,HERE).OR.
810           &         (AND(OFLAG1(I),TAKEBT).EQ.0)) GO TO 63100
811             CALL NEWSTA(I,0,CELLA,0,0)            ! drop to cellar,
812             IF(I.EQ.WATER) CALL NEWSTA(I,0,0,0,0) ! unless water
813             CALL RSPSUB(1011,ODESC2(I))
814 63100     CONTINUE
815           RETURN
816 C
817 C R64--   Puzzle Anteroom
818 C
819 64000     IF(PRSA.NE.LOOKW) RETURN                ! look?
820           I=1068                                            ! not blocked.
821           IF(CPVEC(10).NE.0) I=1069               ! blocked.
822           CALL RSPEAK(I)                                    ! describe.
823           RETURN
824 C
825           END
826 C page
827 C LOOKTO--          Describe view in mirror hallway
828 C
829 C Declarations
830 C
831           SUBROUTINE LOOKTO(NRM,SRM,NT,ST,HT)
832           IMPLICIT INTEGER (A-Z)
833           %include dparam
834 C
835           CALL RSPEAK(HT)                                   ! describe hall.
836           CALL RSPEAK(NT)                                   ! describe north view.
837           CALL RSPEAK(ST)                                   ! describe south view.
838           DIR=0                                             ! assume no direction.
839           IF(IABS(MLOC-HERE).NE.1) GO TO 200      ! mirror to n or s?
840           IF(MLOC.EQ.NRM) DIR=695
841           IF(MLOC.EQ.SRM) DIR=699                           ! dir=n/s.
842           IF(MOD(MDIR,180).NE.0) GO TO 100        ! mirror n-s?
843           CALL RSPSUB(847,DIR)                              ! yes, he sees panel
844           CALL RSPSB2(848,DIR,DIR)                ! and narrow rooms.
845           GO TO 200
846 C
847 100       M1=MRHERE(HERE)                                   ! which mirror?
848           MRBF=0                                            ! assume intact.
849           IF(((M1.EQ.1).AND..NOT.MR1F).OR.
850           &  ((M1.EQ.2).AND..NOT.MR2F)) MRBF=1    ! broken?
851           CALL RSPSUB(849+MRBF,DIR)               ! describe.
852           IF((M1.EQ.1).AND.MROPNF) CALL RSPEAK(823+MRBF)
853           IF(MRBF.NE.0) CALL RSPEAK(851)
854 C
855 200       I=0                                               ! assume no more to do.
856           IF((NT.EQ.0).AND.((DIR.EQ.0).OR.(DIR.EQ.699))) I=852
857           IF((ST.EQ.0).AND.((DIR.EQ.0).OR.(DIR.EQ.695))) I=853
858           IF((NT+ST+DIR).EQ.0) I=854
859           IF(HT.NE.0) CALL RSPEAK(I)              ! describe halls.
860           RETURN
861 C
862           END
863 C page
864 C EWTELL--          Describe e/w narrow rooms
865 C
866 C Declarations
867 C
868           SUBROUTINE EWTELL(RM,ST)
869           IMPLICIT INTEGER (A-Z)
870           %include dparam
871           LOGICAL M1
872 C
873 C Note that we are east or west of mirror, and
874 C mirror must be n-s.
875 C
876           M1=(MDIR+(MOD(RM-MRAE,2)*180)).EQ.180
877           I=MOD(RM-MRAE,2)                        ! get basic e/w flag.
878           IF((M1.AND..NOT.MR1F).OR.(.NOT.M1.AND..NOT.MR2F))
879           &         I=I+2                                   ! mirror broken?
880           CALL RSPEAK(819+I)
881           IF(M1.AND.MROPNF) CALL RSPEAK(823+(I/2))
882           CALL RSPEAK(825)
883           CALL RSPEAK(ST)
884           RETURN
885 C
886           END