|
|
1.1 root 1: C CEVAPP- CLOCK EVENT APPLICABLES
2: C
3: C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
4: C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
5: C WRITTEN BY R. M. SUPNIK
6: C
7: C DECLARATIONS
8: C
9: SUBROUTINE CEVAPP(RI)
10: IMPLICIT INTEGER (A-Z)
11: INTEGER CNDTCK(10),LMPTCK(12)
12: LOGICAL FINDXT,LIT,RMDESC,QOPEN,MOVETO
13: LOGICAL F,QLEDGE,QVAIR,QHERE,PROB
14: #include "gamestate.h"
15: #include "state.h"
16: #include "rooms.h"
17: #include "rflag.h"
18: #include "rindex.h"
19: #include "objects.h"
20: #include "oflags.h"
21: #include "oindex.h"
22: #include "clock.h"
23: #include "curxt.h"
24: #include "xsrch.h"
25: #include "villians.h"
26: #include "advers.h"
27: #include "flags.h"
28: C
29: C FUNCTIONS AND DATA
30: C
31: QOPEN(R)=(and(OFLAG2(R),OPENBT)).NE.0
32: QLEDGE(R)=(R.EQ.LEDG2).OR.(R.EQ.LEDG3).OR.(R.EQ.LEDG4).OR.
33: & (R.EQ.VLBOT)
34: QVAIR(R)=(R.EQ.VAIR1).OR.(R.EQ.VAIR2).OR.(R.EQ.VAIR3).OR.
35: & (R.EQ.VAIR4)
36: DATA CNDTCK/50,20,10,5,0,156,156,156,157,0/
37: DATA LMPTCK/50,30,20,10,4,0,154,154,154,154,155,0/
38: C CEVAPP, PAGE 2
39: C
40: IF(RI.EQ.0) RETURN
41: C !IGNORE DISABLED.
42: GO TO (1000,2000,3000,4000,5000,6000,7000,8000,9000,10000,
43: & 11000,12000,13000,14000,15000,16000,17000,18000,19000,
44: & 20000,21000,22000,23000,24000),RI
45: CALL BUG(3,RI)
46: C
47: C CEV1-- CURE CLOCK. LET PLAYER SLOWLY RECOVER.
48: C
49: 1000 ASTREN(PLAYER)=MIN0(0,ASTREN(PLAYER)+1)
50: C !RECOVER.
51: IF(ASTREN(PLAYER).GE.0) RETURN
52: C !FULLY RECOVERED?
53: CTICK(CEVCUR)=30
54: C !NO, WAIT SOME MORE.
55: RETURN
56: C
57: C CEV2-- MAINT-ROOM WITH LEAK. RAISE THE WATER LEVEL.
58: C
59: 2000 IF(HERE.EQ.MAINT) CALL RSPEAK(71+(RVMNT/2))
60: C !DESCRIBE.
61: RVMNT=RVMNT+1
62: C !RAISE WATER LEVEL.
63: IF(RVMNT.LE.16) RETURN
64: C !IF NOT FULL, EXIT.
65: CTICK(CEVMNT)=0
66: C !FULL, DISABLE CLOCK.
67: RFLAG(MAINT)=or(RFLAG(MAINT),RMUNG)
68: RRAND(MAINT)=80
69: C !SAY IT IS FULL OF WATER.
70: IF(HERE.EQ.MAINT) CALL JIGSUP(81)
71: C !DROWN HIM IF PRESENT.
72: RETURN
73: C
74: C CEV3-- LANTERN. DESCRIBE GROWING DIMNESS.
75: C
76: 3000 CALL LITINT(LAMP,ORLAMP,CEVLNT,LMPTCK,12)
77: C !DO LIGHT INTERRUPT.
78: RETURN
79: C
80: C CEV4-- MATCH. OUT IT GOES.
81: C
82: 4000 CALL RSPEAK(153)
83: C !MATCH IS OUT.
84: OFLAG1(MATCH)=and(OFLAG1(MATCH), not(ONBT))
85: RETURN
86: C
87: C CEV5-- CANDLE. DESCRIBE GROWING DIMNESS.
88: C
89: 5000 CALL LITINT(CANDL,ORCAND,CEVCND,CNDTCK,10)
90: C !DO CANDLE INTERRUPT.
91: RETURN
92: C CEVAPP, PAGE 3
93: C
94: C CEV6-- BALLOON
95: C
96: 6000 CTICK(CEVBAL)=3
97: C !RESCHEDULE INTERRUPT.
98: F=AVEHIC(WINNER).EQ.BALLO
99: C !SEE IF IN BALLOON.
100: IF(BLOC.EQ.VLBOT) GO TO 6800
101: C !AT BOTTOM?
102: IF(QLEDGE(BLOC)) GO TO 6700
103: C !ON LEDGE?
104: IF(QOPEN(RECEP).AND.(BINFF.NE.0))
105: & GO TO 6500
106: C
107: C BALLOON IS IN MIDAIR AND IS DEFLATED (OR HAS RECEPTACLE CLOSED).
108: C FALL TO NEXT ROOM.
109: C
110: IF(BLOC.NE.VAIR1) GO TO 6300
111: C !IN VAIR1?
112: BLOC=VLBOT
113: C !YES, NOW AT VLBOT.
114: CALL NEWSTA(BALLO,0,BLOC,0,0)
115: IF(F) GO TO 6200
116: C !IN BALLOON?
117: IF(QLEDGE(HERE)) CALL RSPEAK(530)
118: C !ON LEDGE, DESCRIBE.
119: RETURN
120: C
121: 6200 F=MOVETO(BLOC,WINNER)
122: C !MOVE HIM.
123: IF(BINFF.EQ.0) GO TO 6250
124: C !IN BALLOON. INFLATED?
125: CALL RSPEAK(531)
126: C !YES, LANDED.
127: F=RMDESC(0)
128: C !DESCRIBE.
129: RETURN
130: C
131: 6250 CALL NEWSTA(BALLO,532,0,0,0)
132: C !NO, BALLOON & CONTENTS DIE.
133: CALL NEWSTA(DBALL,0,BLOC,0,0)
134: C !INSERT DEAD BALLOON.
135: AVEHIC(WINNER)=0
136: C !NOT IN VEHICLE.
137: CFLAG(CEVBAL)=.FALSE.
138: C !DISABLE INTERRUPTS.
139: CFLAG(CEVBRN)=.FALSE.
140: BINFF=0
141: BTIEF=0
142: RETURN
143: C
144: 6300 BLOC=BLOC-1
145: C !NOT IN VAIR1, DESCEND.
146: CALL NEWSTA(BALLO,0,BLOC,0,0)
147: IF(F) GO TO 6400
148: C !IS HE IN BALLOON?
149: IF(QLEDGE(HERE)) CALL RSPEAK(533)
150: C !IF ON LEDGE, DESCRIBE.
151: RETURN
152: C
153: 6400 F=MOVETO(BLOC,WINNER)
154: C !IN BALLOON, MOVE HIM.
155: CALL RSPEAK(534)
156: C !DESCRIBE.
157: F=RMDESC(0)
158: RETURN
159: C
160: C BALLOON IS IN MIDAIR AND IS INFLATED, UP-UP-AND-AWAY
161: C !
162: C
163: 6500 IF(BLOC.NE.VAIR4) GO TO 6600
164: C !AT VAIR4?
165: CTICK(CEVBRN)=0
166: CTICK(CEVBAL)=0
167: BINFF=0
168: BTIEF=0
169: BLOC=VLBOT
170: C !FALL TO BOTTOM.
171: CALL NEWSTA(BALLO,0,0,0,0)
172: C !BALLOON & CONTENTS DIE.
173: CALL NEWSTA(DBALL,0,BLOC,0,0)
174: C !SUBSTITUTE DEAD BALLOON.
175: IF(F) GO TO 6550
176: C !WAS HE IN IT?
177: IF(QLEDGE(HERE)) CALL RSPEAK(535)
178: C !IF HE CAN SEE, DESCRIBE.
179: RETURN
180: C
181: 6550 CALL JIGSUP(536)
182: C !IN BALLOON AT CRASH, DIE.
183: RETURN
184: C
185: 6600 BLOC=BLOC+1
186: C !NOT AT VAIR4, GO UP.
187: CALL NEWSTA(BALLO,0,BLOC,0,0)
188: IF(F) GO TO 6650
189: C !IN BALLOON?
190: IF(QLEDGE(HERE)) CALL RSPEAK(537)
191: C !CAN HE SEE IT?
192: RETURN
193: C
194: 6650 F=MOVETO(BLOC,WINNER)
195: C !MOVE PLAYER.
196: CALL RSPEAK(538)
197: C !DESCRIBE.
198: F=RMDESC(0)
199: RETURN
200: C
201: C ON LEDGE, GOES TO MIDAIR ROOM WHETHER INFLATED OR NOT.
202: C
203: 6700 BLOC=BLOC+(VAIR2-LEDG2)
204: C !MOVE TO MIDAIR.
205: CALL NEWSTA(BALLO,0,BLOC,0,0)
206: IF(F) GO TO 6750
207: C !IN BALLOON?
208: IF(QLEDGE(HERE)) CALL RSPEAK(539)
209: C !NO, STRANDED.
210: CTICK(CEVVLG)=10
211: C !MATERIALIZE GNOME.
212: RETURN
213: C
214: 6750 F=MOVETO(BLOC,WINNER)
215: C !MOVE TO NEW ROOM.
216: CALL RSPEAK(540)
217: C !DESCRIBE.
218: F=RMDESC(0)
219: RETURN
220: C
221: C AT BOTTOM, GO UP IF INFLATED, DO NOTHING IF DEFLATED.
222: C
223: 6800 IF((BINFF.EQ.0).OR..NOT.QOPEN(RECEP)) RETURN
224: BLOC=VAIR1
225: C !INFLATED AND OPEN,
226: CALL NEWSTA(BALLO,0,BLOC,0,0)
227: C !GO UP TO VAIR1.
228: IF(F) GO TO 6850
229: C !IN BALLOON?
230: IF(QLEDGE(HERE)) CALL RSPEAK(541)
231: C !IF CAN SEE, DESCRIBE.
232: RETURN
233: C
234: 6850 F=MOVETO(BLOC,WINNER)
235: C !MOVE PLAYER.
236: CALL RSPEAK(542)
237: F=RMDESC(0)
238: RETURN
239: C CEVAPP, PAGE 4
240: C
241: C CEV7-- BALLOON BURNUP
242: C
243: 7000 DO 7100 I=1,OLNT
244: C !FIND BURNING OBJECT
245: IF((RECEP.EQ.OCAN(I)).AND.((and(OFLAG1(I),FLAMBT)).NE.0))
246: & GO TO 7200
247: 7100 CONTINUE
248: CALL BUG(4,0)
249: C
250: 7200 CALL NEWSTA(I,0,0,0,0)
251: C !VANISH OBJECT.
252: BINFF=0
253: C !UNINFLATED.
254: IF(HERE.EQ.BLOC) CALL RSPSUB(292,ODESC2(I))
255: C !DESCRIBE.
256: RETURN
257: C
258: C CEV8-- FUSE FUNCTION
259: C
260: 8000 IF(OCAN(FUSE).NE.BRICK) GO TO 8500
261: C !IGNITED BRICK?
262: BR=OROOM(BRICK)
263: C !GET BRICK ROOM.
264: BC=OCAN(BRICK)
265: C !GET CONTAINER.
266: IF((BR.EQ.0).AND.(BC.NE.0)) BR=OROOM(BC)
267: CALL NEWSTA(FUSE,0,0,0,0)
268: C !KILL FUSE.
269: CALL NEWSTA(BRICK,0,0,0,0)
270: C !KILL BRICK.
271: IF((BR.NE.0).AND.(BR.NE.HERE)) GO TO 8100
272: C !BRICK ELSEWHERE?
273: C
274: RFLAG(HERE)=or(RFLAG(HERE),RMUNG)
275: RRAND(HERE)=114
276: C !MUNG ROOM.
277: CALL JIGSUP(150)
278: C !DEAD.
279: RETURN
280: C
281: 8100 CALL RSPEAK(151)
282: C !BOOM.
283: MUNGRM=BR
284: C !SAVE ROOM THAT BLEW.
285: CTICK(CEVSAF)=5
286: C !SET SAFE INTERRUPT.
287: IF(BR.NE.MSAFE) GO TO 8200
288: C !BLEW SAFE ROOM?
289: IF(BC.NE.SSLOT) RETURN
290: C !WAS BRICK IN SAFE?
291: CALL NEWSTA(SSLOT,0,0,0,0)
292: C !KILL SLOT.
293: OFLAG2(SAFE)=or(OFLAG2(SAFE),OPENBT)
294: SAFEF=.TRUE.
295: C !INDICATE SAFE BLOWN.
296: RETURN
297: C
298: 8200 DO 8250 I=1,OLNT
299: C !BLEW WRONG ROOM.
300: IF(QHERE(I,BR) .AND. ((and(OFLAG1(I),TAKEBT)).NE.0))
301: & CALL NEWSTA(I,0,0,0,0)
302: 8250 CONTINUE
303: IF(BR.NE.LROOM) RETURN
304: C !BLEW LIVING ROOM?
305: DO 8300 I=1,OLNT
306: IF(OCAN(I).EQ.TCASE) CALL NEWSTA(I,0,0,0,0)
307: C !KILL TROPHY CASE.
308: 8300 CONTINUE
309: RETURN
310: C
311: 8500 IF(QHERE(FUSE,HERE).OR.(OADV(FUSE).EQ.WINNER))
312: & CALL RSPEAK(152)
313: CALL NEWSTA(FUSE,0,0,0,0)
314: C !KILL FUSE.
315: RETURN
316: C CEVAPP, PAGE 5
317: C
318: C CEV9-- LEDGE MUNGE.
319: C
320: 9000 RFLAG(LEDG4)=or(RFLAG(LEDG4),RMUNG)
321: RRAND(LEDG4)=109
322: IF(HERE.EQ.LEDG4) GO TO 9100
323: C !WAS HE THERE?
324: CALL RSPEAK(110)
325: C !NO, NARROW ESCAPE.
326: RETURN
327: C
328: 9100 IF(AVEHIC(WINNER).NE.0) GO TO 9200
329: C !IN VEHICLE?
330: CALL JIGSUP(111)
331: C !NO, DEAD.
332: RETURN
333: C
334: 9200 IF(BTIEF.NE.0) GO TO 9300
335: C !TIED TO LEDGE?
336: CALL RSPEAK(112)
337: C !NO, NO PLACE TO LAND.
338: RETURN
339: C
340: 9300 BLOC=VLBOT
341: C !YES, CRASH BALLOON.
342: CALL NEWSTA(BALLO,0,0,0,0)
343: C !BALLOON & CONTENTS DIE.
344: CALL NEWSTA(DBALL,0,BLOC,0,0)
345: C !INSERT DEAD BALLOON.
346: BTIEF=0
347: BINFF=0
348: CFLAG(CEVBAL)=.FALSE.
349: CFLAG(CEVBRN)=.FALSE.
350: CALL JIGSUP(113)
351: C !DEAD
352: RETURN
353: C
354: C CEV10-- SAFE MUNG.
355: C
356: 10000 RFLAG(MUNGRM)=or(RFLAG(MUNGRM),RMUNG)
357: RRAND(MUNGRM)=114
358: IF(HERE.EQ.MUNGRM) GO TO 10100
359: C !IS HE PRESENT?
360: CALL RSPEAK(115)
361: C !LET HIM KNOW.
362: IF(MUNGRM.EQ.MSAFE) CTICK(CEVLED)=8
363: C !START LEDGE CLOCK.
364: RETURN
365: C
366: 10100 I=116
367: C !HE'S DEAD,
368: IF((and(RFLAG(HERE),RHOUSE)).NE.0) I=117
369: CALL JIGSUP(I)
370: C !LET HIM KNOW.
371: RETURN
372: C CEVAPP, PAGE 6
373: C
374: C CEV11-- VOLCANO GNOME
375: C
376: 11000 IF(QLEDGE(HERE)) GO TO 11100
377: C !IS HE ON LEDGE?
378: CTICK(CEVVLG)=1
379: C !NO, WAIT A WHILE.
380: RETURN
381: C
382: 11100 CALL NEWSTA(GNOME,118,HERE,0,0)
383: C !YES, MATERIALIZE GNOME.
384: RETURN
385: C
386: C CEV12-- VOLCANO GNOME DISAPPEARS
387: C
388: 12000 CALL NEWSTA(GNOME,149,0,0,0)
389: C !DISAPPEAR THE GNOME.
390: RETURN
391: C
392: C CEV13-- BUCKET.
393: C
394: 13000 IF(OCAN(WATER).EQ.BUCKE)
395: & CALL NEWSTA(WATER,0,0,0,0)
396: RETURN
397: C
398: C CEV14-- SPHERE. IF EXPIRES, HE'S TRAPPED.
399: C
400: 14000 RFLAG(CAGER)=or(RFLAG(CAGER),RMUNG)
401: RRAND(CAGER)=147
402: CALL JIGSUP(148)
403: C !MUNG PLAYER.
404: RETURN
405: C
406: C CEV15-- END GAME HERALD.
407: C
408: 15000 ENDGMF=.TRUE.
409: C !WE'RE IN ENDGAME.
410: CALL RSPEAK(119)
411: C !INFORM OF ENDGAME.
412: RETURN
413: C CEVAPP, PAGE 7
414: C
415: C CEV16-- FOREST MURMURS
416: C
417: 16000 CFLAG(CEVFOR)=(HERE.EQ.MTREE).OR.
418: & ((HERE.GE.FORE1).AND.(HERE.LT.CLEAR))
419: IF(CFLAG(CEVFOR).AND.PROB(10,10)) CALL RSPEAK(635)
420: RETURN
421: C
422: C CEV17-- SCOL ALARM
423: C
424: 17000 IF(HERE.EQ.BKTWI) CFLAG(CEVZGI)=.TRUE.
425: C !IF IN TWI, GNOME.
426: IF(HERE.EQ.BKVAU) CALL JIGSUP(636)
427: C !IF IN VAU, DEAD.
428: RETURN
429: C
430: C CEV18-- ENTER GNOME OF ZURICH
431: C
432: 18000 CFLAG(CEVZGO)=.TRUE.
433: C !EXITS, TOO.
434: CALL NEWSTA(ZGNOM,0,BKTWI,0,0)
435: C !PLACE IN TWI.
436: IF(HERE.EQ.BKTWI) CALL RSPEAK(637)
437: C !ANNOUNCE.
438: RETURN
439: C
440: C CEV19-- EXIT GNOME
441: C
442: 19000 CALL NEWSTA(ZGNOM,0,0,0,0)
443: C !VANISH.
444: IF(HERE.EQ.BKTWI) CALL RSPEAK(638)
445: C !ANNOUNCE.
446: RETURN
447: C CEVAPP, PAGE 8
448: C
449: C CEV20-- START OF ENDGAME
450: C
451: 20000 IF(SPELLF) GO TO 20200
452: C !SPELL HIS WAY IN?
453: IF(HERE.NE.CRYPT) RETURN
454: C !NO, STILL IN TOMB?
455: IF(.NOT.LIT(HERE)) GO TO 20100
456: C !LIGHTS OFF?
457: CTICK(CEVSTE)=3
458: C !RESCHEDULE.
459: RETURN
460: C
461: 20100 CALL RSPEAK(727)
462: C !ANNOUNCE.
463: 20200 DO 20300 I=1,OLNT
464: C !STRIP HIM OF OBJS.
465: CALL NEWSTA(I,0,OROOM(I),OCAN(I),0)
466: 20300 CONTINUE
467: CALL NEWSTA(LAMP,0,0,0,PLAYER)
468: C !GIVE HIM LAMP.
469: CALL NEWSTA(SWORD,0,0,0,PLAYER)
470: C !GIVE HIM SWORD.
471: C
472: OFLAG1(LAMP)=and((or(OFLAG1(LAMP),LITEBT)), not(ONBT))
473: OFLAG2(LAMP)=or(OFLAG2(LAMP),TCHBT)
474: CFLAG(CEVLNT)=.FALSE.
475: C !LAMP IS GOOD AS NEW.
476: CTICK(CEVLNT)=350
477: ORLAMP=0
478: OFLAG2(SWORD)=or(OFLAG2(SWORD),TCHBT)
479: SWDACT=.TRUE.
480: SWDSTA=0
481: C
482: THFACT=.FALSE.
483: C !THIEF GONE.
484: ENDGMF=.TRUE.
485: C !ENDGAME RUNNING.
486: CFLAG(CEVMAT)=.FALSE.
487: C !MATCHES GONE,
488: CFLAG(CEVCND)=.FALSE.
489: C !CANDLES GONE.
490: C
491: CALL SCRUPD(RVAL(CRYPT))
492: C !SCORE CRYPT,
493: RVAL(CRYPT)=0
494: C !BUT ONLY ONCE.
495: F=MOVETO(TSTRS,WINNER)
496: C !TO TOP OF STAIRS,
497: F=RMDESC(3)
498: C !AND DESCRIBE.
499: RETURN
500: C !BAM
501: C !
502: C
503: C CEV21-- MIRROR CLOSES.
504: C
505: 21000 MRPSHF=.FALSE.
506: C !BUTTON IS OUT.
507: MROPNF=.FALSE.
508: C !MIRROR IS CLOSED.
509: IF(HERE.EQ.MRANT) CALL RSPEAK(728)
510: C !DESCRIBE BUTTON.
511: IF((HERE.EQ.INMIR).OR.(MRHERE(HERE).EQ.1))
512: & CALL RSPEAK(729)
513: RETURN
514: C CEVAPP, PAGE 9
515: C
516: C CEV22-- DOOR CLOSES.
517: C
518: 22000 IF(WDOPNF) CALL RSPEAK(730)
519: C !DESCRIBE.
520: WDOPNF=.FALSE.
521: C !CLOSED.
522: RETURN
523: C
524: C CEV23-- INQUISITOR'S QUESTION
525: C
526: 23000 IF(AROOM(PLAYER).NE.FDOOR) RETURN
527: C !IF PLAYER LEFT, DIE.
528: CALL RSPEAK(769)
529: CALL RSPEAK(770+QUESNO)
530: CTICK(CEVINQ)=2
531: RETURN
532: C
533: C CEV24-- MASTER FOLLOWS
534: C
535: 24000 IF(AROOM(AMASTR).EQ.HERE) RETURN
536: C !NO MOVEMENT, DONE.
537: IF((HERE.NE.CELL).AND.(HERE.NE.PCELL)) GO TO 24100
538: IF(FOLLWF) CALL RSPEAK(811)
539: C !WONT GO TO CELLS.
540: FOLLWF=.FALSE.
541: RETURN
542: C
543: 24100 FOLLWF=.TRUE.
544: C !FOLLOWING.
545: I=812
546: C !ASSUME CATCHES UP.
547: DO 24200 J=XMIN,XMAX,XMIN
548: IF(FINDXT(J,AROOM(AMASTR)).AND.(XROOM1.EQ.HERE))
549: & I=813
550: 24200 CONTINUE
551: CALL RSPEAK(I)
552: CALL NEWSTA(MASTER,0,HERE,0,0)
553: C !MOVE MASTER OBJECT.
554: AROOM(AMASTR)=HERE
555: C !MOVE MASTER PLAYER.
556: RETURN
557: C
558: END
559: C LITINT- LIGHT INTERRUPT PROCESSOR
560: C
561: C DECLARATIONS
562: C
563: SUBROUTINE LITINT(OBJ,CTR,CEV,TICKS,TICKLN)
564: IMPLICIT INTEGER (A-Z)
565: INTEGER TICKS(TICKLN)
566: #include "gamestate.h"
567: #include "objects.h"
568: #include "oflags.h"
569: #include "clock.h"
570: C
571: CTR=CTR+1
572: C !ADVANCE STATE CNTR.
573: CTICK(CEV)=TICKS(CTR)
574: C !RESET INTERRUPT.
575: IF(CTICK(CEV).NE.0) GO TO 100
576: C !EXPIRED?
577: OFLAG1(OBJ)=and(OFLAG1(OBJ), not(LITEBT+FLAMBT+ONBT))
578: IF((OROOM(OBJ).EQ.HERE).OR.(OADV(OBJ).EQ.WINNER))
579: & CALL RSPSUB(293,ODESC2(OBJ))
580: RETURN
581: C
582: 100 IF((OROOM(OBJ).EQ.HERE).OR.(OADV(OBJ).EQ.WINNER))
583: & CALL RSPEAK(TICKS(CTR+(TICKLN/2)))
584: RETURN
585: C
586: END
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.