Source to dungeon-2.5.6/clockr.f
C CEVAPP- CLOCK EVENT APPLICABLES
C
C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
C WRITTEN BY R. M. SUPNIK
C
C DECLARATIONS
C
SUBROUTINE CEVAPP(RI)
IMPLICIT INTEGER (A-Z)
INTEGER CNDTCK(10),LMPTCK(12)
LOGICAL FINDXT,LIT,RMDESC,QOPEN,MOVETO
LOGICAL F,QLEDGE,QVAIR,QHERE,PROB
C
C GAME STATE
C
LOGICAL TELFLG
COMMON /PLAY/ WINNER,HERE,TELFLG
COMMON /STATE/ MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD,
1 LTSHFT,BLOC,MUNGRM,HS,EGSCOR,EGMXSC
C
C ROOMS
C
COMMON /ROOMS/ RLNT,RDESC2,RDESC1(200),REXIT(200),
1 RACTIO(200),RVAL(200),RFLAG(200)
C
COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR,
1 RSACRD,RFILL,RMUNG,RBUCK,RHOUSE,RNWALL,REND
C
COMMON /RINDEX/ WHOUS,LROOM,CELLA
COMMON /RINDEX/ MTROL,MAZE1
COMMON /RINDEX/ MGRAT,MAZ15
COMMON /RINDEX/ FORE1,FORE3,CLEAR,RESER
COMMON /RINDEX/ STREA,EGYPT,ECHOR
COMMON /RINDEX/ TSHAF
COMMON /RINDEX/ BSHAF,MMACH,DOME,MTORC
COMMON /RINDEX/ CAROU
COMMON /RINDEX/ RIDDL,LLD2,TEMP1,TEMP2,MAINT
COMMON /RINDEX/ BLROO,TREAS,RIVR1,RIVR2,RIVR3,MCYCL
COMMON /RINDEX/ RIVR4,RIVR5,FCHMP,FALLS,MBARR
COMMON /RINDEX/ MRAIN,POG,VLBOT,VAIR1,VAIR2,VAIR3,VAIR4
COMMON /RINDEX/ LEDG2,LEDG3,LEDG4,MSAFE,CAGER
COMMON /RINDEX/ CAGED,TWELL,BWELL,ALICE,ALISM,ALITR
COMMON /RINDEX/ MTREE,BKENT,BKVW,BKTWI,BKVAU,BKBOX
COMMON /RINDEX/ CRYPT,TSTRS,MRANT,MREYE
COMMON /RINDEX/ MRA,MRB,MRC,MRG,MRD,FDOOR
COMMON /RINDEX/ MRAE,MRCE,MRCW,MRGE,MRGW,MRDW,INMIR
COMMON /RINDEX/ SCORR,NCORR,PARAP,CELL,PCELL,NCELL
COMMON /RINDEX/ CPANT,CPOUT,CPUZZ
C
C OBJECTS
C
COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220),
1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
3 OADV(220),OCAN(220),OREAD(220)
C
COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT,
1 NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT,
2 TOOLBT,TURNBT,ONBT
COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT,
1 WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT,
2 TCHBT,VEHBT,SCHBT
C
COMMON /OINDEX/ GARLI,FOOD,GUNK,COAL,MACHI,DIAMO,TCASE,BOTTL
COMMON /OINDEX/ WATER,ROPE,KNIFE,SWORD,LAMP,BLAMP,RUG
COMMON /OINDEX/ LEAVE,TROLL,AXE
COMMON /OINDEX/ RKNIF,KEYS,ICE,BAR
COMMON /OINDEX/ COFFI,TORCH,TBASK,FBASK,IRBOX
COMMON /OINDEX/ GHOST,TRUNK,BELL,BOOK,CANDL
COMMON /OINDEX/ MATCH,TUBE,PUTTY,WRENC,SCREW,CYCLO,CHALI
COMMON /OINDEX/ THIEF,STILL,WINDO,GRATE,DOOR
COMMON /OINDEX/ HPOLE,LEAK,RBUTT,RAILI
COMMON /OINDEX/ POT,STATU,IBOAT,DBOAT,PUMP,RBOAT
COMMON /OINDEX/ STICK,BUOY,SHOVE,BALLO,RECEP,GUANO
COMMON /OINDEX/ BROPE,HOOK1,HOOK2,SAFE,SSLOT,BRICK,FUSE
COMMON /OINDEX/ GNOME,BLABE,DBALL,TOMB
COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT
COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE
COMMON /OINDEX/ ROBOT,FTREE,BILLS,PORTR,SCOL,ZGNOM
COMMON /OINDEX/ EGG,BEGG,BAUBL,CANAR,BCANA
COMMON /OINDEX/ YLWAL,RDWAL,PINDR,RBEAM
COMMON /OINDEX/ ODOOR,QDOOR,CDOOR,NUM1,NUM8
COMMON /OINDEX/ WARNI,CSLIT,GCARD,STLDR
COMMON /OINDEX/ HANDS,WALL,LUNGS,SAILO,AVIAT,TEETH
COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,WNORT,GWATE,MASTER
C
C CLOCK INTERRUPTS
C
LOGICAL CFLAG
COMMON /CEVENT/ CLNT,CTICK(25),CACTIO(25),CFLAG(25)
C
COMMON /CINDEX/ CEVCUR,CEVMNT,CEVLNT,CEVMAT,CEVCND,
1 CEVBAL,CEVBRN,CEVFUS,CEVLED,CEVSAF,CEVVLG,
2 CEVGNO,CEVBUC,CEVSPH,CEVEGH,
3 CEVFOR,CEVSCL,CEVZGI,CEVZGO,CEVSTE,
5 CEVMRS,CEVPIN,CEVINQ,CEVFOL
C
C EXITS
C
COMMON /CURXT/ XTYPE,XROOM1,XSTRNG,XACTIO,XOBJ
C
COMMON /XSRCH/ XMIN,XMAX,XDOWN,XUP,
1 XNORTH,XSOUTH,XENTER,XEXIT,XEAST,XWEST
C
C VILLAINS AND DEMONS
C
LOGICAL THFFLG,SWDACT,THFACT
COMMON /HACK/ THFPOS,THFFLG,THFACT,SWDACT,SWDSTA
C
C ADVENTURERS
C
COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4),
1 AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4)
C
COMMON /AINDEX/ PLAYER,AROBOT,AMASTR
C
C FLAGS
C
LOGICAL TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF
LOGICAL DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF
LOGICAL MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF
LOGICAL EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF
LOGICAL GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF
LOGICAL GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF
LOGICAL MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF
LOGICAL FOLLWF,SPELLF,CPOUTF,CPUSHF
COMMON /FINDEX/ TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF,
1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF,
2 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF,
3 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF,
4 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF,
5 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF,
6 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF,
7 FOLLWF,SPELLF,CPOUTF,CPUSHF
COMMON /FINDEX/ BTIEF,BINFF
COMMON /FINDEX/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA
COMMON /FINDEX/ ORRUG,ORCAND,ORMTCH,ORLAMP
COMMON /FINDEX/ MDIR,MLOC,POLEUF
COMMON /FINDEX/ QUESNO,NQATT,CORRCT
COMMON /FINDEX/ LCELL,PNUMB,ACELL,DCELL,CPHERE
C
C FUNCTIONS AND DATA
C
QOPEN(R)=(ZAND(OFLAG2(R),OPENBT)).NE.0
QLEDGE(R)=(R.EQ.LEDG2).OR.(R.EQ.LEDG3).OR.(R.EQ.LEDG4).OR.
1 (R.EQ.VLBOT)
QVAIR(R)=(R.EQ.VAIR1).OR.(R.EQ.VAIR2).OR.(R.EQ.VAIR3).OR.
1 (R.EQ.VAIR4)
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/
C CEVAPP, PAGE 2
C
IF(RI.EQ.0) RETURN
C IGNORE DISABLED.
GO TO (1000,2000,3000,4000,5000,6000,7000,8000,9000,10000,
1 11000,12000,13000,14000,15000,16000,17000,18000,19000,
2 20000,21000,22000,23000,24000),RI
CALL BUG(3,RI)
C
C CEV1-- CURE CLOCK. LET PLAYER SLOWLY RECOVER.
C
1000 ASTREN(PLAYER)=MIN0(0,ASTREN(PLAYER)+1)
C RECOVER.
IF(ASTREN(PLAYER).GE.0) RETURN
C FULLY RECOVERED?
CTICK(CEVCUR)=30
C NO, WAIT SOME MORE.
RETURN
C
C CEV2-- MAINT-ROOM WITH LEAK. RAISE THE WATER LEVEL.
C
2000 IF(HERE.EQ.MAINT) CALL RSPEAK(71+(RVMNT/2))
C DESCRIBE.
RVMNT=RVMNT+1
C RAISE WATER LEVEL.
IF(RVMNT.LE.16) RETURN
C IF NOT FULL, EXIT.
CTICK(CEVMNT)=0
C FULL, DISABLE CLOCK.
RFLAG(MAINT)=ZOR(RFLAG(MAINT),RMUNG)
C MUNG ROOM.
RVAL(MAINT)=80
C SAY IT IS FULL OF WATER.
IF(HERE.EQ.MAINT) CALL JIGSUP(81)
C DROWN HIM IF PRESENT.
RETURN
C
C CEV3-- LANTERN. DESCRIBE GROWING DIMNESS.
C
3000 CALL LITINT(LAMP,ORLAMP,CEVLNT,LMPTCK,12)
C DO LIGHT INTERRUPT.
RETURN
C
C CEV4-- MATCH. OUT IT GOES.
C
4000 CALL RSPEAK(153)
C MATCH IS OUT.
OFLAG1(MATCH)=ZAND(OFLAG1(MATCH), ZNOT(ONBT))
RETURN
C
C CEV5-- CANDLE. DESCRIBE GROWING DIMNESS.
C
5000 CALL LITINT(CANDL,ORCAND,CEVCND,CNDTCK,10)
C DO CANDLE INTERRUPT.
RETURN
C CEVAPP, PAGE 3
C
C CEV6-- BALLOON
C
6000 CTICK(CEVBAL)=3
C RESCHEDULE INTERRUPT.
F=AVEHIC(WINNER).EQ.BALLO
C SEE IF IN BALLOON.
IF(BLOC.EQ.VLBOT) GO TO 6800
C AT BOTTOM?
IF(QLEDGE(BLOC)) GO TO 6700
C ON LEDGE?
IF(QOPEN(RECEP).AND.(BINFF.NE.0))
1 GO TO 6500
C INFLATED AND RECEP OPEN?.
C
C BALLOON IS IN MIDAIR AND IS DEFLATED (OR HAS RECEPTACLE CLOSED).
C FALL TO NEXT ROOM.
C
IF(BLOC.NE.VAIR1) GO TO 6300
C IN VAIR1?
BLOC=VLBOT
C YES, NOW AT VLBOT.
CALL NEWSTA(BALLO,0,BLOC,0,0)
IF(F) GO TO 6200
C IN BALLOON?
IF(QLEDGE(HERE)) CALL RSPEAK(530)
C ON LEDGE, DESCRIBE.
RETURN
C
6200 F=MOVETO(BLOC,WINNER)
C MOVE HIM.
IF(BINFF.EQ.0) GO TO 6250
C IN BALLOON. INFLATED?
CALL RSPEAK(531)
C YES, LANDED.
F=RMDESC(0)
C DESCRIBE.
RETURN
C
6250 CALL NEWSTA(BALLO,532,0,0,0)
C NO, BALLOON & CONTENTS DIE.
CALL NEWSTA(DBALL,0,BLOC,0,0)
C INSERT DEAD BALLOON.
AVEHIC(WINNER)=0
C NOT IN VEHICLE.
CFLAG(CEVBAL)=.FALSE.
C DISABLE INTERRUPTS.
CFLAG(CEVBRN)=.FALSE.
BINFF=0
BTIEF=0
RETURN
C
6300 BLOC=BLOC-1
C NOT IN VAIR1, DESCEND.
CALL NEWSTA(BALLO,0,BLOC,0,0)
IF(F) GO TO 6400
C IS HE IN BALLOON?
IF(QLEDGE(HERE)) CALL RSPEAK(533)
C IF ON LEDGE, DESCRIBE.
RETURN
C
6400 F=MOVETO(BLOC,WINNER)
C IN BALLOON, MOVE HIM.
CALL RSPEAK(534)
C DESCRIBE.
F=RMDESC(0)
RETURN
C
C BALLOON IS IN MIDAIR AND IS INFLATED, UP-UP-AND-AWAY
C
C
6500 IF(BLOC.NE.VAIR4) GO TO 6600
C AT VAIR4?
CTICK(CEVBRN)=0
C DISABLE INTERRUPTS.
CTICK(CEVBAL)=0
BINFF=0
BTIEF=0
BLOC=VLBOT
C FALL TO BOTTOM.
CALL NEWSTA(BALLO,0,0,0,0)
C BALLOON & CONTENTS DIE.
CALL NEWSTA(DBALL,0,BLOC,0,0)
C SUBSTITUTE DEAD BALLOON.
IF(F) GO TO 6550
C WAS HE IN IT?
IF(QLEDGE(HERE)) CALL RSPEAK(535)
C IF HE CAN SEE, DESCRIBE.
RETURN
C
6550 CALL JIGSUP(536)
C IN BALLOON AT CRASH, DIE.
RETURN
C
6600 BLOC=BLOC+1
C NOT AT VAIR4, GO UP.
CALL NEWSTA(BALLO,0,BLOC,0,0)
IF(F) GO TO 6650
C IN BALLOON?
IF(QLEDGE(HERE)) CALL RSPEAK(537)
C CAN HE SEE IT?
RETURN
C
6650 F=MOVETO(BLOC,WINNER)
C MOVE PLAYER.
CALL RSPEAK(538)
C DESCRIBE.
F=RMDESC(0)
RETURN
C
C ON LEDGE, GOES TO MIDAIR ROOM WHETHER INFLATED OR NOT.
C
6700 BLOC=BLOC+(VAIR2-LEDG2)
C MOVE TO MIDAIR.
CALL NEWSTA(BALLO,0,BLOC,0,0)
IF(F) GO TO 6750
C IN BALLOON?
IF(QLEDGE(HERE)) CALL RSPEAK(539)
C NO, STRANDED.
CTICK(CEVVLG)=10
C MATERIALIZE GNOME.
RETURN
C
6750 F=MOVETO(BLOC,WINNER)
C MOVE TO NEW ROOM.
CALL RSPEAK(540)
C DESCRIBE.
F=RMDESC(0)
RETURN
C
C AT BOTTOM, GO UP IF INFLATED, DO NOTHING IF DEFLATED.
C
6800 IF((BINFF.EQ.0).OR..NOT.QOPEN(RECEP)) RETURN
BLOC=VAIR1
C INFLATED AND OPEN,
CALL NEWSTA(BALLO,0,BLOC,0,0)
C GO UP TO VAIR1.
IF(F) GO TO 6850
C IN BALLOON?
IF(QLEDGE(HERE)) CALL RSPEAK(541)
C IF CAN SEE, DESCRIBE.
RETURN
C
6850 F=MOVETO(BLOC,WINNER)
C MOVE PLAYER.
CALL RSPEAK(542)
F=RMDESC(0)
RETURN
C CEVAPP, PAGE 4
C
C CEV7-- BALLOON BURNUP
C
7000 DO 7100 I=1,OLNT
C FIND BURNING OBJECT
IF((RECEP.EQ.OCAN(I)).AND.(ZAND(OFLAG1(I),FLAMBT).NE.0))
1 GO TO 7200
C IN RECEPTACLE.
7100 CONTINUE
CALL BUG(4,0)
C
7200 CALL NEWSTA(I,0,0,0,0)
C VANISH OBJECT.
BINFF=0
C UNINFLATED.
IF(HERE.EQ.BLOC) CALL RSPSUB(292,ODESC2(I))
C DESCRIBE.
RETURN
C
C CEV8-- FUSE FUNCTION
C
8000 IF(OCAN(FUSE).NE.BRICK) GO TO 8500
C IGNITED BRICK?
BR=OROOM(BRICK)
C GET BRICK ROOM.
BC=OCAN(BRICK)
C GET CONTAINER.
IF((BR.EQ.0).AND.(BC.NE.0)) BR=OROOM(BC)
CALL NEWSTA(FUSE,0,0,0,0)
C KILL FUSE.
CALL NEWSTA(BRICK,0,0,0,0)
C KILL BRICK.
IF((BR.NE.0).AND.(BR.NE.HERE)) GO TO 8100
C BRICK ELSEWHERE?
C
RFLAG(HERE)=ZOR(RFLAG(HERE),RMUNG)
C BLEW SELF.
RVAL(HERE)=114
C MUNG ROOM.
CALL JIGSUP(150)
C DEAD.
RETURN
C
8100 CALL RSPEAK(151)
C BOOM.
MUNGRM=BR
C SAVE ROOM THAT BLEW.
CTICK(CEVSAF)=5
C SET SAFE INTERRUPT.
IF(BR.NE.MSAFE) GO TO 8200
C BLEW SAFE ROOM?
IF(BC.NE.SSLOT) RETURN
C WAS BRICK IN SAFE?
CALL NEWSTA(SSLOT,0,0,0,0)
C KILL SLOT.
OFLAG2(SAFE)=ZOR(OFLAG2(SAFE),OPENBT)
C OPEN SAFE.
SAFEF=.TRUE.
C INDICATE SAFE BLOWN.
RETURN
C
8200 DO 8250 I=1,OLNT
C BLEW WRONG ROOM.
IF(QHERE(I,BR) .AND. (ZAND(OFLAG1(I),TAKEBT).NE.0))
1 CALL NEWSTA(I,0,0,0,0)
C VANISH CONTENTS.
8250 CONTINUE
IF(BR.NE.LROOM) RETURN
C BLEW LIVING ROOM?
DO 8300 I=1,OLNT
IF(OCAN(I).EQ.TCASE) CALL NEWSTA(I,0,0,0,0)
C KILL TROPHY CASE.
8300 CONTINUE
RETURN
C
8500 IF(QHERE(FUSE,HERE).OR.(OADV(FUSE).EQ.WINNER))
1 CALL RSPEAK(152)
CALL NEWSTA(FUSE,0,0,0,0)
C KILL FUSE.
RETURN
C CEVAPP, PAGE 5
C
C CEV9-- LEDGE MUNGE.
C
9000 RFLAG(LEDG4)=ZOR(RFLAG(LEDG4),RMUNG)
C LEDGE COLLAPSES.
RVAL(LEDG4)=109
IF(HERE.EQ.LEDG4) GO TO 9100
C WAS HE THERE?
CALL RSPEAK(110)
C NO, NARROW ESCAPE.
RETURN
C
9100 IF(AVEHIC(WINNER).NE.0) GO TO 9200
C IN VEHICLE?
CALL JIGSUP(111)
C NO, DEAD.
RETURN
C
9200 IF(BTIEF.NE.0) GO TO 9300
C TIED TO LEDGE?
CALL RSPEAK(112)
C NO, NO PLACE TO LAND.
RETURN
C
9300 BLOC=VLBOT
C YES, CRASH BALLOON.
CALL NEWSTA(BALLO,0,0,0,0)
C BALLOON & CONTENTS DIE.
CALL NEWSTA(DBALL,0,BLOC,0,0)
C INSERT DEAD BALLOON.
BTIEF=0
BINFF=0
CFLAG(CEVBAL)=.FALSE.
CFLAG(CEVBRN)=.FALSE.
CALL JIGSUP(113)
C DEAD
RETURN
C
C CEV10-- SAFE MUNG.
C
10000 RFLAG(MUNGRM)=ZOR(RFLAG(MUNGRM),RMUNG)
C MUNG TARGET.
RVAL(MUNGRM)=114
IF(HERE.EQ.MUNGRM) GO TO 10100
C IS HE PRESENT?
CALL RSPEAK(115)
C LET HIM KNOW.
IF(MUNGRM.EQ.MSAFE) CTICK(CEVLED)=8
C START LEDGE CLOCK.
RETURN
C
10100 I=116
C HE'S DEAD,
IF(ZAND(RFLAG(HERE),RHOUSE).NE.0) I=117
C ONE WAY OR ANOTHER.
CALL JIGSUP(I)
C LET HIM KNOW.
RETURN
C CEVAPP, PAGE 6
C
C CEV11-- VOLCANO GNOME
C
11000 IF(QLEDGE(HERE)) GO TO 11100
C IS HE ON LEDGE?
CTICK(CEVVLG)=1
C NO, WAIT A WHILE.
RETURN
C
11100 CALL NEWSTA(GNOME,118,HERE,0,0)
C YES, MATERIALIZE GNOME.
RETURN
C
C CEV12-- VOLCANO GNOME DISAPPEARS
C
12000 CALL NEWSTA(GNOME,149,0,0,0)
C DISAPPEAR THE GNOME.
RETURN
C
C CEV13-- BUCKET.
C
13000 IF(OCAN(WATER).EQ.BUCKE)
1 CALL NEWSTA(WATER,0,0,0,0)
C WATER LEAKS OUT.
RETURN
C
C CEV14-- SPHERE. IF EXPIRES, HE'S TRAPPED.
C
14000 RFLAG(CAGER)=ZOR(RFLAG(CAGER),RMUNG)
C MUNG ROOM.
RVAL(CAGER)=147
CALL JIGSUP(148)
C MUNG PLAYER.
RETURN
C
C CEV15-- END GAME HERALD.
C
15000 ENDGMF=.TRUE.
C WE'RE IN ENDGAME.
CALL RSPEAK(119)
C INFORM OF ENDGAME.
RETURN
C CEVAPP, PAGE 7
C
C CEV16-- FOREST MURMURS
C
16000 CFLAG(CEVFOR)=(HERE.EQ.MTREE).OR.
1 ((HERE.GE.FORE1).AND.(HERE.LT.CLEAR))
IF(CFLAG(CEVFOR).AND.PROB(10,10)) CALL RSPEAK(635)
RETURN
C
C CEV17-- SCOL ALARM
C
17000 IF(HERE.EQ.BKTWI) CFLAG(CEVZGI)=.TRUE.
C IF IN TWI, GNOME.
IF(HERE.EQ.BKVAU) CALL JIGSUP(636)
C IF IN VAU, DEAD.
RETURN
C
C CEV18-- ENTER GNOME OF ZURICH
C
18000 CFLAG(CEVZGO)=.TRUE.
C EXITS, TOO.
CALL NEWSTA(ZGNOM,0,BKTWI,0,0)
C PLACE IN TWI.
IF(HERE.EQ.BKTWI) CALL RSPEAK(637)
C ANNOUNCE.
RETURN
C
C CEV19-- EXIT GNOME
C
19000 CALL NEWSTA(ZGNOM,0,0,0,0)
C VANISH.
IF(HERE.EQ.BKTWI) CALL RSPEAK(638)
C ANNOUNCE.
RETURN
C CEVAPP, PAGE 8
C
C CEV20-- START OF ENDGAME
C
20000 IF(SPELLF) GO TO 20200
C SPELL HIS WAY IN?
IF(HERE.NE.CRYPT) RETURN
C NO, STILL IN TOMB?
IF(.NOT.LIT(HERE)) GO TO 20100
C LIGHTS OFF?
CTICK(CEVSTE)=3
C RESCHEDULE.
RETURN
C
20100 CALL RSPEAK(727)
C ANNOUNCE.
20200 DO 20300 I=1,OLNT
C STRIP HIM OF OBJS.
CALL NEWSTA(I,0,OROOM(I),OCAN(I),0)
20300 CONTINUE
CALL NEWSTA(LAMP,0,0,0,PLAYER)
C GIVE HIM LAMP.
CALL NEWSTA(SWORD,0,0,0,PLAYER)
C GIVE HIM SWORD.
C
OFLAG1(LAMP)=ZAND(ZOR(OFLAG1(LAMP),LITEBT), ZNOT(ONBT))
OFLAG2(LAMP)=ZOR(OFLAG2(LAMP),TCHBT)
CFLAG(CEVLNT)=.FALSE.
C LAMP IS GOOD AS NEW.
CTICK(CEVLNT)=350
ORLAMP=0
OFLAG2(SWORD)=ZOR(OFLAG2(SWORD),TCHBT)
C RECREATE SWORD.
SWDACT=.TRUE.
SWDSTA=0
C
THFACT=.FALSE.
C THIEF GONE.
ENDGMF=.TRUE.
C ENDGAME RUNNING.
CFLAG(CEVMAT)=.FALSE.
C MATCHES GONE,
CFLAG(CEVCND)=.FALSE.
C CANDLES GONE.
C
CALL SCRUPD(RVAL(CRYPT))
C SCORE CRYPT,
RVAL(CRYPT)=0
C BUT ONLY ONCE.
F=MOVETO(TSTRS,WINNER)
C TO TOP OF STAIRS,
F=RMDESC(3)
C AND DESCRIBE.
RETURN
C BAM
C
C
C CEV21-- MIRROR CLOSES.
C
21000 MRPSHF=.FALSE.
C BUTTON IS OUT.
MROPNF=.FALSE.
C MIRROR IS CLOSED.
IF(HERE.EQ.MRANT) CALL RSPEAK(728)
C DESCRIBE BUTTON.
IF((HERE.EQ.INMIR).OR.(MRHERE(HERE).EQ.1))
1 CALL RSPEAK(729)
C DESCRIBE MIRROR.
RETURN
C CEVAPP, PAGE 9
C
C CEV22-- DOOR CLOSES.
C
22000 IF(WDOPNF) CALL RSPEAK(730)
C DESCRIBE.
WDOPNF=.FALSE.
C CLOSED.
RETURN
C
C CEV23-- INQUISITOR'S QUESTION
C
23000 IF(AROOM(PLAYER).NE.FDOOR) RETURN
C IF PLAYER LEFT, DIE.
CALL RSPEAK(769)
CALL RSPEAK(770+QUESNO)
CTICK(CEVINQ)=2
RETURN
C
C CEV24-- MASTER FOLLOWS
C
24000 IF(AROOM(AMASTR).EQ.HERE) RETURN
C NO MOVEMENT, DONE.
IF((HERE.NE.CELL).AND.(HERE.NE.PCELL)) GO TO 24100
IF(FOLLWF) CALL RSPEAK(811)
C WONT GO TO CELLS.
FOLLWF=.FALSE.
RETURN
C
24100 FOLLWF=.TRUE.
C FOLLOWING.
I=812
C ASSUME CATCHES UP.
DO 24200 J=XMIN,XMAX,XMIN
IF(FINDXT(J,AROOM(AMASTR)).AND.(XROOM1.EQ.HERE))
1 I=813
C ASSUME FOLLOWS.
24200 CONTINUE
CALL RSPEAK(I)
CALL NEWSTA(MASTER,0,HERE,0,0)
C MOVE MASTER OBJECT.
AROOM(AMASTR)=HERE
C MOVE MASTER PLAYER.
RETURN
C
END
C LITINT- LIGHT INTERRUPT PROCESSOR
C
C DECLARATIONS
C
SUBROUTINE LITINT(OBJ,CTR,CEV,TICKS,TICKLN)
IMPLICIT INTEGER (A-Z)
INTEGER TICKS(TICKLN)
C
C GAME STATE
C
LOGICAL TELFLG
COMMON /PLAY/ WINNER,HERE,TELFLG
C
C OBJECTS
C
COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220),
1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
3 OADV(220),OCAN(220),OREAD(220)
C
COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT,
1 NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT,
2 TOOLBT,TURNBT,ONBT
COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT,
1 WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT,
2 TCHBT,VEHBT,SCHBT
C
C CLOCK INTERRUPTS
C
LOGICAL CFLAG
COMMON /CEVENT/ CLNT,CTICK(25),CACTIO(25),CFLAG(25)
C
CTR=CTR+1
C ADVANCE STATE CNTR.
CTICK(CEV)=TICKS(CTR)
C RESET INTERRUPT.
IF(CTICK(CEV).NE.0) GO TO 100
C EXPIRED?
OFLAG1(OBJ)=ZAND(OFLAG1(OBJ), ZNOT(LITEBT+FLAMBT+ONBT))
IF((OROOM(OBJ).EQ.HERE).OR.(OADV(OBJ).EQ.WINNER))
1 CALL RSPSUB(293,ODESC2(OBJ))
RETURN
C
100 IF((OROOM(OBJ).EQ.HERE).OR.(OADV(OBJ).EQ.WINNER))
1 CALL RSPEAK(TICKS(CTR+(TICKLN/2)))
RETURN
C
END