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