usr/src/contrib/dungeon/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
#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