1C CEVAPP- CLOCK EVENT APPLICABLES 2C 3C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142 4C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED 5C WRITTEN BY R. M. SUPNIK 6C 7C DECLARATIONS 8C 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" 28C 29C FUNCTIONS AND DATA 30C 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/ 38C CEVAPP, PAGE 2 39C 40 IF(RI.EQ.0) RETURN 41C !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) 46C 47C CEV1-- CURE CLOCK. LET PLAYER SLOWLY RECOVER. 48C 491000 ASTREN(PLAYER)=MIN0(0,ASTREN(PLAYER)+1) 50C !RECOVER. 51 IF(ASTREN(PLAYER).GE.0) RETURN 52C !FULLY RECOVERED? 53 CTICK(CEVCUR)=30 54C !NO, WAIT SOME MORE. 55 RETURN 56C 57C CEV2-- MAINT-ROOM WITH LEAK. RAISE THE WATER LEVEL. 58C 592000 IF(HERE.EQ.MAINT) CALL RSPEAK(71+(RVMNT/2)) 60C !DESCRIBE. 61 RVMNT=RVMNT+1 62C !RAISE WATER LEVEL. 63 IF(RVMNT.LE.16) RETURN 64C !IF NOT FULL, EXIT. 65 CTICK(CEVMNT)=0 66C !FULL, DISABLE CLOCK. 67 RFLAG(MAINT)=or(RFLAG(MAINT),RMUNG) 68 RRAND(MAINT)=80 69C !SAY IT IS FULL OF WATER. 70 IF(HERE.EQ.MAINT) CALL JIGSUP(81) 71C !DROWN HIM IF PRESENT. 72 RETURN 73C 74C CEV3-- LANTERN. DESCRIBE GROWING DIMNESS. 75C 763000 CALL LITINT(LAMP,ORLAMP,CEVLNT,LMPTCK,12) 77C !DO LIGHT INTERRUPT. 78 RETURN 79C 80C CEV4-- MATCH. OUT IT GOES. 81C 824000 CALL RSPEAK(153) 83C !MATCH IS OUT. 84 OFLAG1(MATCH)=and(OFLAG1(MATCH), not(ONBT)) 85 RETURN 86C 87C CEV5-- CANDLE. DESCRIBE GROWING DIMNESS. 88C 895000 CALL LITINT(CANDL,ORCAND,CEVCND,CNDTCK,10) 90C !DO CANDLE INTERRUPT. 91 RETURN 92C CEVAPP, PAGE 3 93C 94C CEV6-- BALLOON 95C 966000 CTICK(CEVBAL)=3 97C !RESCHEDULE INTERRUPT. 98 F=AVEHIC(WINNER).EQ.BALLO 99C !SEE IF IN BALLOON. 100 IF(BLOC.EQ.VLBOT) GO TO 6800 101C !AT BOTTOM? 102 IF(QLEDGE(BLOC)) GO TO 6700 103C !ON LEDGE? 104 IF(QOPEN(RECEP).AND.(BINFF.NE.0)) 105& GO TO 6500 106C 107C BALLOON IS IN MIDAIR AND IS DEFLATED (OR HAS RECEPTACLE CLOSED). 108C FALL TO NEXT ROOM. 109C 110 IF(BLOC.NE.VAIR1) GO TO 6300 111C !IN VAIR1? 112 BLOC=VLBOT 113C !YES, NOW AT VLBOT. 114 CALL NEWSTA(BALLO,0,BLOC,0,0) 115 IF(F) GO TO 6200 116C !IN BALLOON? 117 IF(QLEDGE(HERE)) CALL RSPEAK(530) 118C !ON LEDGE, DESCRIBE. 119 RETURN 120C 1216200 F=MOVETO(BLOC,WINNER) 122C !MOVE HIM. 123 IF(BINFF.EQ.0) GO TO 6250 124C !IN BALLOON. INFLATED? 125 CALL RSPEAK(531) 126C !YES, LANDED. 127 F=RMDESC(0) 128C !DESCRIBE. 129 RETURN 130C 1316250 CALL NEWSTA(BALLO,532,0,0,0) 132C !NO, BALLOON & CONTENTS DIE. 133 CALL NEWSTA(DBALL,0,BLOC,0,0) 134C !INSERT DEAD BALLOON. 135 AVEHIC(WINNER)=0 136C !NOT IN VEHICLE. 137 CFLAG(CEVBAL)=.FALSE. 138C !DISABLE INTERRUPTS. 139 CFLAG(CEVBRN)=.FALSE. 140 BINFF=0 141 BTIEF=0 142 RETURN 143C 1446300 BLOC=BLOC-1 145C !NOT IN VAIR1, DESCEND. 146 CALL NEWSTA(BALLO,0,BLOC,0,0) 147 IF(F) GO TO 6400 148C !IS HE IN BALLOON? 149 IF(QLEDGE(HERE)) CALL RSPEAK(533) 150C !IF ON LEDGE, DESCRIBE. 151 RETURN 152C 1536400 F=MOVETO(BLOC,WINNER) 154C !IN BALLOON, MOVE HIM. 155 CALL RSPEAK(534) 156C !DESCRIBE. 157 F=RMDESC(0) 158 RETURN 159C 160C BALLOON IS IN MIDAIR AND IS INFLATED, UP-UP-AND-AWAY 161C ! 162C 1636500 IF(BLOC.NE.VAIR4) GO TO 6600 164C !AT VAIR4? 165 CTICK(CEVBRN)=0 166 CTICK(CEVBAL)=0 167 BINFF=0 168 BTIEF=0 169 BLOC=VLBOT 170C !FALL TO BOTTOM. 171 CALL NEWSTA(BALLO,0,0,0,0) 172C !BALLOON & CONTENTS DIE. 173 CALL NEWSTA(DBALL,0,BLOC,0,0) 174C !SUBSTITUTE DEAD BALLOON. 175 IF(F) GO TO 6550 176C !WAS HE IN IT? 177 IF(QLEDGE(HERE)) CALL RSPEAK(535) 178C !IF HE CAN SEE, DESCRIBE. 179 RETURN 180C 1816550 CALL JIGSUP(536) 182C !IN BALLOON AT CRASH, DIE. 183 RETURN 184C 1856600 BLOC=BLOC+1 186C !NOT AT VAIR4, GO UP. 187 CALL NEWSTA(BALLO,0,BLOC,0,0) 188 IF(F) GO TO 6650 189C !IN BALLOON? 190 IF(QLEDGE(HERE)) CALL RSPEAK(537) 191C !CAN HE SEE IT? 192 RETURN 193C 1946650 F=MOVETO(BLOC,WINNER) 195C !MOVE PLAYER. 196 CALL RSPEAK(538) 197C !DESCRIBE. 198 F=RMDESC(0) 199 RETURN 200C 201C ON LEDGE, GOES TO MIDAIR ROOM WHETHER INFLATED OR NOT. 202C 2036700 BLOC=BLOC+(VAIR2-LEDG2) 204C !MOVE TO MIDAIR. 205 CALL NEWSTA(BALLO,0,BLOC,0,0) 206 IF(F) GO TO 6750 207C !IN BALLOON? 208 IF(QLEDGE(HERE)) CALL RSPEAK(539) 209C !NO, STRANDED. 210 CTICK(CEVVLG)=10 211C !MATERIALIZE GNOME. 212 RETURN 213C 2146750 F=MOVETO(BLOC,WINNER) 215C !MOVE TO NEW ROOM. 216 CALL RSPEAK(540) 217C !DESCRIBE. 218 F=RMDESC(0) 219 RETURN 220C 221C AT BOTTOM, GO UP IF INFLATED, DO NOTHING IF DEFLATED. 222C 2236800 IF((BINFF.EQ.0).OR..NOT.QOPEN(RECEP)) RETURN 224 BLOC=VAIR1 225C !INFLATED AND OPEN, 226 CALL NEWSTA(BALLO,0,BLOC,0,0) 227C !GO UP TO VAIR1. 228 IF(F) GO TO 6850 229C !IN BALLOON? 230 IF(QLEDGE(HERE)) CALL RSPEAK(541) 231C !IF CAN SEE, DESCRIBE. 232 RETURN 233C 2346850 F=MOVETO(BLOC,WINNER) 235C !MOVE PLAYER. 236 CALL RSPEAK(542) 237 F=RMDESC(0) 238 RETURN 239C CEVAPP, PAGE 4 240C 241C CEV7-- BALLOON BURNUP 242C 2437000 DO 7100 I=1,OLNT 244C !FIND BURNING OBJECT 245 IF((RECEP.EQ.OCAN(I)).AND.((and(OFLAG1(I),FLAMBT)).NE.0)) 246& GO TO 7200 2477100 CONTINUE 248 CALL BUG(4,0) 249C 2507200 CALL NEWSTA(I,0,0,0,0) 251C !VANISH OBJECT. 252 BINFF=0 253C !UNINFLATED. 254 IF(HERE.EQ.BLOC) CALL RSPSUB(292,ODESC2(I)) 255C !DESCRIBE. 256 RETURN 257C 258C CEV8-- FUSE FUNCTION 259C 2608000 IF(OCAN(FUSE).NE.BRICK) GO TO 8500 261C !IGNITED BRICK? 262 BR=OROOM(BRICK) 263C !GET BRICK ROOM. 264 BC=OCAN(BRICK) 265C !GET CONTAINER. 266 IF((BR.EQ.0).AND.(BC.NE.0)) BR=OROOM(BC) 267 CALL NEWSTA(FUSE,0,0,0,0) 268C !KILL FUSE. 269 CALL NEWSTA(BRICK,0,0,0,0) 270C !KILL BRICK. 271 IF((BR.NE.0).AND.(BR.NE.HERE)) GO TO 8100 272C !BRICK ELSEWHERE? 273C 274 RFLAG(HERE)=or(RFLAG(HERE),RMUNG) 275 RRAND(HERE)=114 276C !MUNG ROOM. 277 CALL JIGSUP(150) 278C !DEAD. 279 RETURN 280C 2818100 CALL RSPEAK(151) 282C !BOOM. 283 MUNGRM=BR 284C !SAVE ROOM THAT BLEW. 285 CTICK(CEVSAF)=5 286C !SET SAFE INTERRUPT. 287 IF(BR.NE.MSAFE) GO TO 8200 288C !BLEW SAFE ROOM? 289 IF(BC.NE.SSLOT) RETURN 290C !WAS BRICK IN SAFE? 291 CALL NEWSTA(SSLOT,0,0,0,0) 292C !KILL SLOT. 293 OFLAG2(SAFE)=or(OFLAG2(SAFE),OPENBT) 294 SAFEF=.TRUE. 295C !INDICATE SAFE BLOWN. 296 RETURN 297C 2988200 DO 8250 I=1,OLNT 299C !BLEW WRONG ROOM. 300 IF(QHERE(I,BR) .AND. ((and(OFLAG1(I),TAKEBT)).NE.0)) 301& CALL NEWSTA(I,0,0,0,0) 3028250 CONTINUE 303 IF(BR.NE.LROOM) RETURN 304C !BLEW LIVING ROOM? 305 DO 8300 I=1,OLNT 306 IF(OCAN(I).EQ.TCASE) CALL NEWSTA(I,0,0,0,0) 307C !KILL TROPHY CASE. 3088300 CONTINUE 309 RETURN 310C 3118500 IF(QHERE(FUSE,HERE).OR.(OADV(FUSE).EQ.WINNER)) 312& CALL RSPEAK(152) 313 CALL NEWSTA(FUSE,0,0,0,0) 314C !KILL FUSE. 315 RETURN 316C CEVAPP, PAGE 5 317C 318C CEV9-- LEDGE MUNGE. 319C 3209000 RFLAG(LEDG4)=or(RFLAG(LEDG4),RMUNG) 321 RRAND(LEDG4)=109 322 IF(HERE.EQ.LEDG4) GO TO 9100 323C !WAS HE THERE? 324 CALL RSPEAK(110) 325C !NO, NARROW ESCAPE. 326 RETURN 327C 3289100 IF(AVEHIC(WINNER).NE.0) GO TO 9200 329C !IN VEHICLE? 330 CALL JIGSUP(111) 331C !NO, DEAD. 332 RETURN 333C 3349200 IF(BTIEF.NE.0) GO TO 9300 335C !TIED TO LEDGE? 336 CALL RSPEAK(112) 337C !NO, NO PLACE TO LAND. 338 RETURN 339C 3409300 BLOC=VLBOT 341C !YES, CRASH BALLOON. 342 CALL NEWSTA(BALLO,0,0,0,0) 343C !BALLOON & CONTENTS DIE. 344 CALL NEWSTA(DBALL,0,BLOC,0,0) 345C !INSERT DEAD BALLOON. 346 BTIEF=0 347 BINFF=0 348 CFLAG(CEVBAL)=.FALSE. 349 CFLAG(CEVBRN)=.FALSE. 350 CALL JIGSUP(113) 351C !DEAD 352 RETURN 353C 354C CEV10-- SAFE MUNG. 355C 35610000 RFLAG(MUNGRM)=or(RFLAG(MUNGRM),RMUNG) 357 RRAND(MUNGRM)=114 358 IF(HERE.EQ.MUNGRM) GO TO 10100 359C !IS HE PRESENT? 360 CALL RSPEAK(115) 361C !LET HIM KNOW. 362 IF(MUNGRM.EQ.MSAFE) CTICK(CEVLED)=8 363C !START LEDGE CLOCK. 364 RETURN 365C 36610100 I=116 367C !HE'S DEAD, 368 IF((and(RFLAG(HERE),RHOUSE)).NE.0) I=117 369 CALL JIGSUP(I) 370C !LET HIM KNOW. 371 RETURN 372C CEVAPP, PAGE 6 373C 374C CEV11-- VOLCANO GNOME 375C 37611000 IF(QLEDGE(HERE)) GO TO 11100 377C !IS HE ON LEDGE? 378 CTICK(CEVVLG)=1 379C !NO, WAIT A WHILE. 380 RETURN 381C 38211100 CALL NEWSTA(GNOME,118,HERE,0,0) 383C !YES, MATERIALIZE GNOME. 384 RETURN 385C 386C CEV12-- VOLCANO GNOME DISAPPEARS 387C 38812000 CALL NEWSTA(GNOME,149,0,0,0) 389C !DISAPPEAR THE GNOME. 390 RETURN 391C 392C CEV13-- BUCKET. 393C 39413000 IF(OCAN(WATER).EQ.BUCKE) 395& CALL NEWSTA(WATER,0,0,0,0) 396 RETURN 397C 398C CEV14-- SPHERE. IF EXPIRES, HE'S TRAPPED. 399C 40014000 RFLAG(CAGER)=or(RFLAG(CAGER),RMUNG) 401 RRAND(CAGER)=147 402 CALL JIGSUP(148) 403C !MUNG PLAYER. 404 RETURN 405C 406C CEV15-- END GAME HERALD. 407C 40815000 ENDGMF=.TRUE. 409C !WE'RE IN ENDGAME. 410 CALL RSPEAK(119) 411C !INFORM OF ENDGAME. 412 RETURN 413C CEVAPP, PAGE 7 414C 415C CEV16-- FOREST MURMURS 416C 41716000 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 421C 422C CEV17-- SCOL ALARM 423C 42417000 IF(HERE.EQ.BKTWI) CFLAG(CEVZGI)=.TRUE. 425C !IF IN TWI, GNOME. 426 IF(HERE.EQ.BKVAU) CALL JIGSUP(636) 427C !IF IN VAU, DEAD. 428 RETURN 429C 430C CEV18-- ENTER GNOME OF ZURICH 431C 43218000 CFLAG(CEVZGO)=.TRUE. 433C !EXITS, TOO. 434 CALL NEWSTA(ZGNOM,0,BKTWI,0,0) 435C !PLACE IN TWI. 436 IF(HERE.EQ.BKTWI) CALL RSPEAK(637) 437C !ANNOUNCE. 438 RETURN 439C 440C CEV19-- EXIT GNOME 441C 44219000 CALL NEWSTA(ZGNOM,0,0,0,0) 443C !VANISH. 444 IF(HERE.EQ.BKTWI) CALL RSPEAK(638) 445C !ANNOUNCE. 446 RETURN 447C CEVAPP, PAGE 8 448C 449C CEV20-- START OF ENDGAME 450C 45120000 IF(SPELLF) GO TO 20200 452C !SPELL HIS WAY IN? 453 IF(HERE.NE.CRYPT) RETURN 454C !NO, STILL IN TOMB? 455 IF(.NOT.LIT(HERE)) GO TO 20100 456C !LIGHTS OFF? 457 CTICK(CEVSTE)=3 458C !RESCHEDULE. 459 RETURN 460C 46120100 CALL RSPEAK(727) 462C !ANNOUNCE. 46320200 DO 20300 I=1,OLNT 464C !STRIP HIM OF OBJS. 465 CALL NEWSTA(I,0,OROOM(I),OCAN(I),0) 46620300 CONTINUE 467 CALL NEWSTA(LAMP,0,0,0,PLAYER) 468C !GIVE HIM LAMP. 469 CALL NEWSTA(SWORD,0,0,0,PLAYER) 470C !GIVE HIM SWORD. 471C 472 OFLAG1(LAMP)=and((or(OFLAG1(LAMP),LITEBT)), not(ONBT)) 473 OFLAG2(LAMP)=or(OFLAG2(LAMP),TCHBT) 474 CFLAG(CEVLNT)=.FALSE. 475C !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 481C 482 THFACT=.FALSE. 483C !THIEF GONE. 484 ENDGMF=.TRUE. 485C !ENDGAME RUNNING. 486 CFLAG(CEVMAT)=.FALSE. 487C !MATCHES GONE, 488 CFLAG(CEVCND)=.FALSE. 489C !CANDLES GONE. 490C 491 CALL SCRUPD(RVAL(CRYPT)) 492C !SCORE CRYPT, 493 RVAL(CRYPT)=0 494C !BUT ONLY ONCE. 495 F=MOVETO(TSTRS,WINNER) 496C !TO TOP OF STAIRS, 497 F=RMDESC(3) 498C !AND DESCRIBE. 499 RETURN 500C !BAM 501C ! 502C 503C CEV21-- MIRROR CLOSES. 504C 50521000 MRPSHF=.FALSE. 506C !BUTTON IS OUT. 507 MROPNF=.FALSE. 508C !MIRROR IS CLOSED. 509 IF(HERE.EQ.MRANT) CALL RSPEAK(728) 510C !DESCRIBE BUTTON. 511 IF((HERE.EQ.INMIR).OR.(MRHERE(HERE).EQ.1)) 512& CALL RSPEAK(729) 513 RETURN 514C CEVAPP, PAGE 9 515C 516C CEV22-- DOOR CLOSES. 517C 51822000 IF(WDOPNF) CALL RSPEAK(730) 519C !DESCRIBE. 520 WDOPNF=.FALSE. 521C !CLOSED. 522 RETURN 523C 524C CEV23-- INQUISITOR'S QUESTION 525C 52623000 IF(AROOM(PLAYER).NE.FDOOR) RETURN 527C !IF PLAYER LEFT, DIE. 528 CALL RSPEAK(769) 529 CALL RSPEAK(770+QUESNO) 530 CTICK(CEVINQ)=2 531 RETURN 532C 533C CEV24-- MASTER FOLLOWS 534C 53524000 IF(AROOM(AMASTR).EQ.HERE) RETURN 536C !NO MOVEMENT, DONE. 537 IF((HERE.NE.CELL).AND.(HERE.NE.PCELL)) GO TO 24100 538 IF(FOLLWF) CALL RSPEAK(811) 539C !WONT GO TO CELLS. 540 FOLLWF=.FALSE. 541 RETURN 542C 54324100 FOLLWF=.TRUE. 544C !FOLLOWING. 545 I=812 546C !ASSUME CATCHES UP. 547 DO 24200 J=XMIN,XMAX,XMIN 548 IF(FINDXT(J,AROOM(AMASTR)).AND.(XROOM1.EQ.HERE)) 549& I=813 55024200 CONTINUE 551 CALL RSPEAK(I) 552 CALL NEWSTA(MASTER,0,HERE,0,0) 553C !MOVE MASTER OBJECT. 554 AROOM(AMASTR)=HERE 555C !MOVE MASTER PLAYER. 556 RETURN 557C 558 END 559C LITINT- LIGHT INTERRUPT PROCESSOR 560C 561C DECLARATIONS 562C 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" 570C 571 CTR=CTR+1 572C !ADVANCE STATE CNTR. 573 CTICK(CEV)=TICKS(CTR) 574C !RESET INTERRUPT. 575 IF(CTICK(CEV).NE.0) GO TO 100 576C !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 581C 582100 IF((OROOM(OBJ).EQ.HERE).OR.(OADV(OBJ).EQ.WINNER)) 583& CALL RSPEAK(TICKS(CTR+(TICKLN/2))) 584 RETURN 585C 586 END 587