xref: /csrg-svn/contrib/dungeon/clockr.F (revision 35973)

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
#include "gamestate.h"
#include "state.h"
#include "rooms.h"
#include "rflag.h"
#include "rindex.h"
#include "objects.h"
#include "oflags.h"
#include "oindex.h"
#include "clock.h"
#include "curxt.h"
#include "xsrch.h"
#include "villians.h"
#include "advers.h"
#include "flags.h"
C
C FUNCTIONS AND DATA
C
	QOPEN(R)=(and(OFLAG2(R),OPENBT)).NE.0
	QLEDGE(R)=(R.EQ.LEDG2).OR.(R.EQ.LEDG3).OR.(R.EQ.LEDG4).OR.
&		(R.EQ.VLBOT)
	QVAIR(R)=(R.EQ.VAIR1).OR.(R.EQ.VAIR2).OR.(R.EQ.VAIR3).OR.
&		 (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,
&	 11000,12000,13000,14000,15000,16000,17000,18000,19000,
&	 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)=or(RFLAG(MAINT),RMUNG)
	RRAND(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)=and(OFLAG1(MATCH), not(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))
&		GO TO 6500
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
	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.((and(OFLAG1(I),FLAMBT)).NE.0))
&		GO TO 7200
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)=or(RFLAG(HERE),RMUNG)
	RRAND(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)=or(OFLAG2(SAFE),OPENBT)
	SAFEF=.TRUE.
C						!INDICATE SAFE BLOWN.
	RETURN
C
8200	DO 8250 I=1,OLNT
C						!BLEW WRONG ROOM.
	  IF(QHERE(I,BR) .AND. ((and(OFLAG1(I),TAKEBT)).NE.0))
&		CALL NEWSTA(I,0,0,0,0)
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))
&		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)=or(RFLAG(LEDG4),RMUNG)
	RRAND(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)=or(RFLAG(MUNGRM),RMUNG)
	RRAND(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((and(RFLAG(HERE),RHOUSE)).NE.0) I=117
	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)
&		CALL NEWSTA(WATER,0,0,0,0)
	RETURN
C
C CEV14--	SPHERE.  IF EXPIRES, HE'S TRAPPED.
C
14000	RFLAG(CAGER)=or(RFLAG(CAGER),RMUNG)
	RRAND(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.
&		((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)=and((or(OFLAG1(LAMP),LITEBT)), not(ONBT))
	OFLAG2(LAMP)=or(OFLAG2(LAMP),TCHBT)
	CFLAG(CEVLNT)=.FALSE.
C						!LAMP IS GOOD AS NEW.
	CTICK(CEVLNT)=350
	ORLAMP=0
	OFLAG2(SWORD)=or(OFLAG2(SWORD),TCHBT)
	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))
&		CALL RSPEAK(729)
	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))
&		I=813
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)
#include "gamestate.h"
#include "objects.h"
#include "oflags.h"
#include "clock.h"
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)=and(OFLAG1(OBJ), not(LITEBT+FLAMBT+ONBT))
	IF((OROOM(OBJ).EQ.HERE).OR.(OADV(OBJ).EQ.WINNER))
&		CALL RSPSUB(293,ODESC2(OBJ))
	RETURN
C
100	IF((OROOM(OBJ).EQ.HERE).OR.(OADV(OBJ).EQ.WINNER))
&		CALL RSPEAK(TICKS(CTR+(TICKLN/2)))
	RETURN
C
	END