C CEVAPP- CLOCK EVENT APPLICABLES
C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
C WRITTEN BY R. M. SUPNIK
INTEGER CNDTCK(10),LMPTCK(12)
LOGICAL FINDXT,LIT,RMDESC,QOPEN,MOVETO
LOGICAL F,QLEDGE,QVAIR,QHERE,PROB
QOPEN(R)=(and(OFLAG2(R),OPENBT)).NE.0
QLEDGE(R)=(R.EQ.LEDG2).OR.(R.EQ.LEDG3).OR.(R.EQ.LEDG4).OR.
QVAIR(R)=(R.EQ.VAIR1).OR.(R.EQ.VAIR2).OR.(R.EQ.VAIR3).OR.
DATA CNDTCK/50,20,10,5,0,156,156,156,157,0/
DATA LMPTCK/50,30,20,10,4,0,154,154,154,154,155,0/
GO TO (1000,2000,3000,4000,5000,6000,7000,8000,9000,10000,
& 11000,12000,13000,14000,15000,16000,17000,18000,19000,
& 20000,21000,22000,23000,24000),RI
C CEV1-- CURE CLOCK. LET PLAYER SLOWLY RECOVER.
1000 ASTREN(PLAYER)=MIN0(0,ASTREN(PLAYER)+1)
IF(ASTREN(PLAYER).GE.0) RETURN
C CEV2-- MAINT-ROOM WITH LEAK. RAISE THE WATER LEVEL.
2000 IF(HERE.EQ.MAINT) CALL RSPEAK(71+(RVMNT/2))
RFLAG(MAINT)=or(RFLAG(MAINT),RMUNG)
C !SAY IT IS FULL OF WATER.
IF(HERE.EQ.MAINT) CALL JIGSUP(81)
C CEV3-- LANTERN. DESCRIBE GROWING DIMNESS.
3000 CALL LITINT(LAMP,ORLAMP,CEVLNT,LMPTCK,12)
C CEV4-- MATCH. OUT IT GOES.
OFLAG1(MATCH)=and(OFLAG1(MATCH), not(ONBT))
C CEV5-- CANDLE. DESCRIBE GROWING DIMNESS.
5000 CALL LITINT(CANDL,ORCAND,CEVCND,CNDTCK,10)
F=AVEHIC(WINNER).EQ.BALLO
IF(BLOC.EQ.VLBOT) GO TO 6800
IF(QLEDGE(BLOC)) GO TO 6700
IF(QOPEN(RECEP).AND.(BINFF.NE.0))
C BALLOON IS IN MIDAIR AND IS DEFLATED (OR HAS RECEPTACLE CLOSED).
IF(BLOC.NE.VAIR1) GO TO 6300
CALL NEWSTA(BALLO,0,BLOC,0,0)
IF(QLEDGE(HERE)) CALL RSPEAK(530)
6200 F=MOVETO(BLOC,WINNER)
IF(BINFF.EQ.0) GO TO 6250
6250 CALL NEWSTA(BALLO,532,0,0,0)
C !NO, BALLOON & CONTENTS DIE.
CALL NEWSTA(DBALL,0,BLOC,0,0)
C !NOT IN VAIR1, DESCEND.
CALL NEWSTA(BALLO,0,BLOC,0,0)
IF(QLEDGE(HERE)) CALL RSPEAK(533)
C !IF ON LEDGE, DESCRIBE.
6400 F=MOVETO(BLOC,WINNER)
C BALLOON IS IN MIDAIR AND IS INFLATED, UP-UP-AND-AWAY
6500 IF(BLOC.NE.VAIR4) GO TO 6600
CALL NEWSTA(BALLO,0,0,0,0)
C !BALLOON & CONTENTS DIE.
CALL NEWSTA(DBALL,0,BLOC,0,0)
C !SUBSTITUTE DEAD BALLOON.
IF(QLEDGE(HERE)) CALL RSPEAK(535)
C !IF HE CAN SEE, DESCRIBE.
C !IN BALLOON AT CRASH, DIE.
CALL NEWSTA(BALLO,0,BLOC,0,0)
IF(QLEDGE(HERE)) CALL RSPEAK(537)
6650 F=MOVETO(BLOC,WINNER)
C ON LEDGE, GOES TO MIDAIR ROOM WHETHER INFLATED OR NOT.
6700 BLOC=BLOC+(VAIR2-LEDG2)
CALL NEWSTA(BALLO,0,BLOC,0,0)
IF(QLEDGE(HERE)) CALL RSPEAK(539)
6750 F=MOVETO(BLOC,WINNER)
C AT BOTTOM, GO UP IF INFLATED, DO NOTHING IF DEFLATED.
6800 IF((BINFF.EQ.0).OR..NOT.QOPEN(RECEP)) RETURN
CALL NEWSTA(BALLO,0,BLOC,0,0)
IF(QLEDGE(HERE)) CALL RSPEAK(541)
6850 F=MOVETO(BLOC,WINNER)
IF((RECEP.EQ.OCAN(I)).AND.((and(OFLAG1(I),FLAMBT)).NE.0))
7200 CALL NEWSTA(I,0,0,0,0)
IF(HERE.EQ.BLOC) CALL RSPSUB(292,ODESC2(I))
8000 IF(OCAN(FUSE).NE.BRICK) GO TO 8500
IF((BR.EQ.0).AND.(BC.NE.0)) BR=OROOM(BC)
CALL NEWSTA(FUSE,0,0,0,0)
CALL NEWSTA(BRICK,0,0,0,0)
IF((BR.NE.0).AND.(BR.NE.HERE)) GO TO 8100
RFLAG(HERE)=or(RFLAG(HERE),RMUNG)
IF(BR.NE.MSAFE) GO TO 8200
CALL NEWSTA(SSLOT,0,0,0,0)
OFLAG2(SAFE)=or(OFLAG2(SAFE),OPENBT)
IF(QHERE(I,BR) .AND. ((and(OFLAG1(I),TAKEBT)).NE.0))
IF(OCAN(I).EQ.TCASE) CALL NEWSTA(I,0,0,0,0)
8500 IF(QHERE(FUSE,HERE).OR.(OADV(FUSE).EQ.WINNER))
CALL NEWSTA(FUSE,0,0,0,0)
9000 RFLAG(LEDG4)=or(RFLAG(LEDG4),RMUNG)
IF(HERE.EQ.LEDG4) GO TO 9100
9100 IF(AVEHIC(WINNER).NE.0) GO TO 9200
9200 IF(BTIEF.NE.0) GO TO 9300
CALL NEWSTA(BALLO,0,0,0,0)
C !BALLOON & CONTENTS DIE.
CALL NEWSTA(DBALL,0,BLOC,0,0)
10000 RFLAG(MUNGRM)=or(RFLAG(MUNGRM),RMUNG)
IF(HERE.EQ.MUNGRM) GO TO 10100
IF(MUNGRM.EQ.MSAFE) CTICK(CEVLED)=8
IF((and(RFLAG(HERE),RHOUSE)).NE.0) I=117
11000 IF(QLEDGE(HERE)) GO TO 11100
11100 CALL NEWSTA(GNOME,118,HERE,0,0)
C !YES, MATERIALIZE GNOME.
C CEV12-- VOLCANO GNOME DISAPPEARS
12000 CALL NEWSTA(GNOME,149,0,0,0)
13000 IF(OCAN(WATER).EQ.BUCKE)
& CALL NEWSTA(WATER,0,0,0,0)
C CEV14-- SPHERE. IF EXPIRES, HE'S TRAPPED.
14000 RFLAG(CAGER)=or(RFLAG(CAGER),RMUNG)
C CEV15-- END GAME HERALD.
16000 CFLAG(CEVFOR)=(HERE.EQ.MTREE).OR.
& ((HERE.GE.FORE1).AND.(HERE.LT.CLEAR))
IF(CFLAG(CEVFOR).AND.PROB(10,10)) CALL RSPEAK(635)
17000 IF(HERE.EQ.BKTWI) CFLAG(CEVZGI)=.TRUE.
IF(HERE.EQ.BKVAU) CALL JIGSUP(636)
C CEV18-- ENTER GNOME OF ZURICH
18000 CFLAG(CEVZGO)=.TRUE.
CALL NEWSTA(ZGNOM,0,BKTWI,0,0)
IF(HERE.EQ.BKTWI) CALL RSPEAK(637)
19000 CALL NEWSTA(ZGNOM,0,0,0,0)
IF(HERE.EQ.BKTWI) CALL RSPEAK(638)
C CEV20-- START OF ENDGAME
20000 IF(SPELLF) GO TO 20200
IF(.NOT.LIT(HERE)) GO TO 20100
CALL NEWSTA(I,0,OROOM(I),OCAN(I),0)
CALL NEWSTA(LAMP,0,0,0,PLAYER)
CALL NEWSTA(SWORD,0,0,0,PLAYER)
OFLAG1(LAMP)=and((or(OFLAG1(LAMP),LITEBT)), not(ONBT))
OFLAG2(LAMP)=or(OFLAG2(LAMP),TCHBT)
OFLAG2(SWORD)=or(OFLAG2(SWORD),TCHBT)
IF(HERE.EQ.MRANT) CALL RSPEAK(728)
IF((HERE.EQ.INMIR).OR.(MRHERE(HERE).EQ.1))
22000 IF(WDOPNF) CALL RSPEAK(730)
C CEV23-- INQUISITOR'S QUESTION
23000 IF(AROOM(PLAYER).NE.FDOOR) RETURN
24000 IF(AROOM(AMASTR).EQ.HERE) RETURN
IF((HERE.NE.CELL).AND.(HERE.NE.PCELL)) GO TO 24100
IF(FOLLWF) CALL RSPEAK(811)
DO 24200 J=XMIN,XMAX,XMIN
IF(FINDXT(J,AROOM(AMASTR)).AND.(XROOM1.EQ.HERE))
CALL NEWSTA(MASTER,0,HERE,0,0)
C LITINT- LIGHT INTERRUPT PROCESSOR
SUBROUTINE LITINT(OBJ,CTR,CEV,TICKS,TICKLN)
IF(CTICK(CEV).NE.0) GO TO 100
OFLAG1(OBJ)=and(OFLAG1(OBJ), not(LITEBT+FLAMBT+ONBT))
IF((OROOM(OBJ).EQ.HERE).OR.(OADV(OBJ).EQ.WINNER))
& CALL RSPSUB(293,ODESC2(OBJ))
100 IF((OROOM(OBJ).EQ.HERE).OR.(OADV(OBJ).EQ.WINNER))
& CALL RSPEAK(TICKS(CTR+(TICKLN/2)))