home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol045 / clockr.ftn < prev    next >
Encoding:
Text File  |  1984-04-29  |  16.7 KB  |  580 lines
  1. C CEVAPP- CLOCK EVENT APPLICABLES
  2. C
  3. C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
  4. C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
  5. C WRITTEN BY R. M. SUPNIK
  6. C
  7. C DECLARATIONS
  8. C
  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. C
  15. C GAME STATE
  16. C
  17.     LOGICAL TELFLG
  18.     COMMON /PLAY/ WINNER,HERE,TELFLG
  19.     COMMON /STATE/ MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD,
  20.     1    LTSHFT,BLOC,MUNGRM,HS,EGSCOR,EGMXSC
  21. C
  22. C ROOMS
  23. C
  24.     COMMON /ROOMS/ RLNT,RDESC2,RDESC1(200),REXIT(200),
  25.     1    RACTIO(200),RVAL(200),RFLAG(200)
  26.     INTEGER RRAND(200)
  27.     EQUIVALENCE (RVAL,RRAND)
  28. C
  29.     COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR,
  30.     1    RSACRD,RFILL,RMUNG,RBUCK,RHOUSE,RNWALL,REND
  31. C
  32.     COMMON /RINDEX/ WHOUS,LROOM,CELLA
  33.     COMMON /RINDEX/ MTROL,MAZE1    
  34.     COMMON /RINDEX/ MGRAT,MAZ15    
  35.     COMMON /RINDEX/ FORE1,FORE3,CLEAR,RESER
  36.     COMMON /RINDEX/ STREA,EGYPT,ECHOR
  37.     COMMON /RINDEX/ TSHAF    
  38.     COMMON /RINDEX/ BSHAF,MMACH,DOME,MTORC
  39.     COMMON /RINDEX/ CAROU    
  40.     COMMON /RINDEX/ RIDDL,LLD2,TEMP1,TEMP2,MAINT
  41.     COMMON /RINDEX/ BLROO,TREAS,RIVR1,RIVR2,RIVR3,MCYCL
  42.     COMMON /RINDEX/ RIVR4,RIVR5,FCHMP,FALLS,MBARR
  43.     COMMON /RINDEX/ MRAIN,POG,VLBOT,VAIR1,VAIR2,VAIR3,VAIR4
  44.     COMMON /RINDEX/ LEDG2,LEDG3,LEDG4,MSAFE,CAGER
  45.     COMMON /RINDEX/ CAGED,TWELL,BWELL,ALICE,ALISM,ALITR
  46.     COMMON /RINDEX/ MTREE,BKENT,BKVW,BKTWI,BKVAU,BKBOX
  47.     COMMON /RINDEX/ CRYPT,TSTRS,MRANT,MREYE
  48.     COMMON /RINDEX/ MRA,MRB,MRC,MRG,MRD,FDOOR
  49.     COMMON /RINDEX/ MRAE,MRCE,MRCW,MRGE,MRGW,MRDW,INMIR
  50.     COMMON /RINDEX/ SCORR,NCORR,PARAP,CELL,PCELL,NCELL
  51.     COMMON /RINDEX/ CPANT,CPOUT,CPUZZ
  52. C
  53. C OBJECTS
  54. C
  55.     COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220),
  56.     1    OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
  57.     2    OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
  58.     3    OADV(220),OCAN(220),OREAD(220)
  59. C
  60.     COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT,
  61.     1    NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT,
  62.     2    TOOLBT,TURNBT,ONBT
  63.     COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT,
  64.     1    WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT,
  65.     2    TCHBT,VEHBT,SCHBT
  66. C
  67.     COMMON /OINDEX/ GARLI,FOOD,GUNK,COAL,MACHI,DIAMO,TCASE,BOTTL
  68.     COMMON /OINDEX/ WATER,ROPE,KNIFE,SWORD,LAMP,BLAMP,RUG
  69.     COMMON /OINDEX/    LEAVE,TROLL,AXE
  70.     COMMON /OINDEX/ RKNIF,KEYS,ICE,BAR
  71.     COMMON /OINDEX/ COFFI,TORCH,TBASK,FBASK,IRBOX
  72.     COMMON /OINDEX/ GHOST,TRUNK,BELL,BOOK,CANDL
  73.     COMMON /OINDEX/ MATCH,TUBE,PUTTY,WRENC,SCREW,CYCLO,CHALI
  74.     COMMON /OINDEX/ THIEF,STILL,WINDO,GRATE,DOOR
  75.     COMMON /OINDEX/ HPOLE,LEAK,RBUTT,RAILI
  76.     COMMON /OINDEX/ POT,STATU,IBOAT,DBOAT,PUMP,RBOAT
  77.     COMMON /OINDEX/ STICK,BUOY,SHOVE,BALLO,RECEP,GUANO
  78.     COMMON /OINDEX/ BROPE,HOOK1,HOOK2,SAFE,SSLOT,BRICK,FUSE
  79.     COMMON /OINDEX/ GNOME,BLABE,DBALL,TOMB
  80.     COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT
  81.     COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE
  82.     COMMON /OINDEX/ ROBOT,FTREE,BILLS,PORTR,SCOL,ZGNOM
  83.     COMMON /OINDEX/ EGG,BEGG,BAUBL,CANAR,BCANA
  84.     COMMON /OINDEX/ YLWAL,RDWAL,PINDR,RBEAM
  85.     COMMON /OINDEX/ ODOOR,QDOOR,CDOOR,NUM1,NUM8
  86.     COMMON /OINDEX/ WARNI,CSLIT,GCARD,STLDR
  87.     COMMON /OINDEX/ HANDS,WALL,LUNGS,SAILO,AVIAT,TEETH
  88.     COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,WNORT,GWATE,MASTER
  89. C
  90. C CLOCK INTERRUPTS
  91. C
  92.     LOGICAL*1 CFLAG
  93.     COMMON /CEVENT/ CLNT,CTICK(25),CACTIO(25),CFLAG(25)
  94. C
  95.     COMMON /CINDEX/ CEVCUR,CEVMNT,CEVLNT,CEVMAT,CEVCND,
  96.     1    CEVBAL,CEVBRN,CEVFUS,CEVLED,CEVSAF,CEVVLG,
  97.     2    CEVGNO,CEVBUC,CEVSPH,CEVEGH,
  98.     3    CEVFOR,CEVSCL,CEVZGI,CEVZGO,CEVSTE,
  99.     5    CEVMRS,CEVPIN,CEVINQ,CEVFOL
  100. C
  101. C EXITS
  102. C
  103.     COMMON /CURXT/ XTYPE,XROOM1,XSTRNG,XACTIO,XOBJ
  104.     EQUIVALENCE (XFLAG,XOBJ)
  105. C
  106.     COMMON /XSRCH/ XMIN,XMAX,XDOWN,XUP,
  107.     1    XNORTH,XSOUTH,XENTER,XEXIT,XEAST,XWEST
  108. C
  109. C VILLAINS AND DEMONS
  110. C
  111.     LOGICAL THFFLG,SWDACT,THFACT
  112.     COMMON /HACK/ THFPOS,THFFLG,THFACT,SWDACT,SWDSTA
  113. C
  114. C ADVENTURERS
  115. C
  116.     COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4),
  117.     1    AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4)
  118. C
  119.     COMMON /AINDEX/ PLAYER,AROBOT,AMASTR
  120. C
  121. C FLAGS
  122. C
  123.     LOGICAL*1 TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF
  124.     LOGICAL*1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF
  125.     LOGICAL*1 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF
  126.     LOGICAL*1 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF
  127.     LOGICAL*1 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF
  128.     LOGICAL*1 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF
  129.     LOGICAL*1 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF
  130.     LOGICAL*1 FOLLWF,SPELLF,CPOUTF,CPUSHF
  131.     COMMON /FINDEX/ TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF,
  132.     1    DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF,
  133.     2    MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF,
  134.     3    EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF,
  135.     4    GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF,
  136.     5    GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF,
  137.     6    MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF,
  138.     7    FOLLWF,SPELLF,CPOUTF,CPUSHF
  139.     COMMON /FINDEX/ BTIEF,BINFF
  140.     COMMON /FINDEX/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA
  141.     COMMON /FINDEX/ ORRUG,ORCAND,ORMTCH,ORLAMP
  142.     COMMON /FINDEX/ MDIR,MLOC,POLEUF
  143.     COMMON /FINDEX/ QUESNO,NQATT,CORRCT
  144.     COMMON /FINDEX/ LCELL,PNUMB,ACELL,DCELL,CPHERE
  145. C
  146. C FUNCTIONS AND DATA
  147. C
  148.     QOPEN(R)=(OFLAG2(R).AND.OPENBT).NE.0
  149.     QLEDGE(R)=(R.EQ.LEDG2).OR.(R.EQ.LEDG3).OR.(R.EQ.LEDG4).OR.
  150.     1    (R.EQ.VLBOT)
  151.     QVAIR(R)=(R.EQ.VAIR1).OR.(R.EQ.VAIR2).OR.(R.EQ.VAIR3).OR.
  152.     1     (R.EQ.VAIR4)
  153.     DATA CNDTCK/50,20,10,5,0,156,156,156,157,0/
  154.     DATA LMPTCK/50,30,20,10,4,0,154,154,154,154,155,0/
  155. C CEVAPP, PAGE 2
  156. C
  157.     IF(RI.EQ.0) RETURN            !IGNORE DISABLED.
  158.     GO TO (1000,2000,3000,4000,5000,6000,7000,8000,9000,10000,
  159.     1 11000,12000,13000,14000,15000,16000,17000,18000,19000,
  160.     2 20000,21000,22000,23000,24000),RI
  161.     CALL BUG(3,RI)
  162. C
  163. C CEV1--    CURE CLOCK.  LET PLAYER SLOWLY RECOVER.
  164. C
  165. 1000    ASTREN(PLAYER)=MIN0(0,ASTREN(PLAYER)+1)        !RECOVER.
  166.     IF(ASTREN(PLAYER).GE.0) RETURN        !FULLY RECOVERED?
  167.     CTICK(CEVCUR)=30            !NO, WAIT SOME MORE.
  168.     RETURN
  169. C
  170. C CEV2--    MAINT-ROOM WITH LEAK.  RAISE THE WATER LEVEL.
  171. C
  172. 2000    IF(HERE.EQ.MAINT) CALL RSPEAK(71+(RVMNT/2)) !DESCRIBE.
  173.     RVMNT=RVMNT+1                !RAISE WATER LEVEL.
  174.     IF(RVMNT.LE.16) RETURN            !IF NOT FULL, EXIT.
  175.     CTICK(CEVMNT)=0                !FULL, DISABLE CLOCK.
  176.     RFLAG(MAINT)=RFLAG(MAINT).OR.RMUNG    !MUNG ROOM.
  177.     RRAND(MAINT)=80                !SAY IT IS FULL OF WATER.
  178.     IF(HERE.EQ.MAINT) CALL JIGSUP(81)    !DROWN HIM IF PRESENT.
  179.     RETURN
  180. C
  181. C CEV3--    LANTERN.  DESCRIBE GROWING DIMNESS.
  182. C
  183. 3000    CALL LITINT(LAMP,ORLAMP,CEVLNT,LMPTCK,12) !DO LIGHT INTERRUPT.
  184.     RETURN
  185. C
  186. C CEV4--    MATCH.  OUT IT GOES.
  187. C
  188. 4000    CALL RSPEAK(153)            !MATCH IS OUT.
  189.     OFLAG1(MATCH)=OFLAG1(MATCH).AND. .NOT.ONBT
  190.     RETURN
  191. C
  192. C CEV5--    CANDLE.  DESCRIBE GROWING DIMNESS.
  193. C
  194. 5000    CALL LITINT(CANDL,ORCAND,CEVCND,CNDTCK,10) !DO CANDLE INTERRUPT.
  195.     RETURN
  196. C CEVAPP, PAGE 3
  197. C
  198. C CEV6--    BALLOON
  199. C
  200. 6000    CTICK(CEVBAL)=3                !RESCHEDULE INTERRUPT.
  201.     F=AVEHIC(WINNER).EQ.BALLO        !SEE IF IN BALLOON.
  202.     IF(BLOC.EQ.VLBOT) GO TO 6800        !AT BOTTOM?
  203.     IF(QLEDGE(BLOC)) GO TO 6700        !ON LEDGE?
  204.     IF(QOPEN(RECEP).AND.(BINFF.NE.0))
  205.     1    GO TO 6500            !INFLATED AND RECEP OPEN?.
  206. C
  207. C BALLOON IS IN MIDAIR AND IS DEFLATED (OR HAS RECEPTACLE CLOSED).
  208. C FALL TO NEXT ROOM.
  209. C
  210.     IF(BLOC.NE.VAIR1) GO TO 6300        !IN VAIR1?
  211.     BLOC=VLBOT                !YES, NOW AT VLBOT.
  212.     CALL NEWSTA(BALLO,0,BLOC,0,0)
  213.     IF(F) GO TO 6200            !IN BALLOON?
  214.     IF(QLEDGE(HERE)) CALL RSPEAK(530)    !ON LEDGE, DESCRIBE.
  215.     RETURN
  216. C
  217. 6200    F=MOVETO(BLOC,WINNER)            !MOVE HIM.
  218.     IF(BINFF.EQ.0) GO TO 6250        !IN BALLOON.  INFLATED?
  219.     CALL RSPEAK(531)            !YES, LANDED.
  220.     F=RMDESC(0)                !DESCRIBE.
  221.     RETURN
  222. C
  223. 6250    CALL NEWSTA(BALLO,532,0,0,0)        !NO, BALLOON & CONTENTS DIE.
  224.     CALL NEWSTA(DBALL,0,BLOC,0,0)        !INSERT DEAD BALLOON.
  225.     AVEHIC(WINNER)=0            !NOT IN VEHICLE.
  226.     CFLAG(CEVBAL)=.FALSE.            !DISABLE INTERRUPTS.
  227.     CFLAG(CEVBRN)=.FALSE.
  228.     BINFF=0
  229.     BTIEF=0
  230.     RETURN
  231. C
  232. 6300    BLOC=BLOC-1                !NOT IN VAIR1, DESCEND.
  233.     CALL NEWSTA(BALLO,0,BLOC,0,0)
  234.     IF(F) GO TO 6400            !IS HE IN BALLOON?
  235.     IF(QLEDGE(HERE)) CALL RSPEAK(533)    !IF ON LEDGE, DESCRIBE.
  236.     RETURN
  237. C
  238. 6400    F=MOVETO(BLOC,WINNER)            !IN BALLOON, MOVE HIM.
  239.     CALL RSPEAK(534)            !DESCRIBE.
  240.     F=RMDESC(0)
  241.     RETURN
  242. C
  243. C BALLOON IS IN MIDAIR AND IS INFLATED, UP-UP-AND-AWAY!
  244. C
  245. 6500    IF(BLOC.NE.VAIR4) GO TO 6600        !AT VAIR4?
  246.     CTICK(CEVBRN)=.FALSE.            !DISABLE INTERRUPTS.
  247.     CTICK(CEVBAL)=.FALSE.
  248.     BINFF=0
  249.     BTIEF=0
  250.     BLOC=VLBOT                !FALL TO BOTTOM.
  251.     CALL NEWSTA(BALLO,0,0,0,0)        !BALLOON & CONTENTS DIE.
  252.     CALL NEWSTA(DBALL,0,BLOC,0,0)        !SUBSTITUTE DEAD BALLOON.
  253.     IF(F) GO TO 6550            !WAS HE IN IT?
  254.     IF(QLEDGE(HERE)) CALL RSPEAK(535)    !IF HE CAN SEE, DESCRIBE.
  255.     RETURN
  256. C
  257. 6550    CALL JIGSUP(536)            !IN BALLOON AT CRASH, DIE.
  258.     RETURN
  259. C
  260. 6600    BLOC=BLOC+1                !NOT AT VAIR4, GO UP.
  261.     CALL NEWSTA(BALLO,0,BLOC,0,0)
  262.     IF(F) GO TO 6650            !IN BALLOON?
  263.     IF(QLEDGE(HERE)) CALL RSPEAK(537)    !CAN HE SEE IT?
  264.     RETURN
  265. C
  266. 6650    F=MOVETO(BLOC,WINNER)            !MOVE PLAYER.
  267.     CALL RSPEAK(538)            !DESCRIBE.
  268.     F=RMDESC(0)
  269.     RETURN
  270. C
  271. C ON LEDGE, GOES TO MIDAIR ROOM WHETHER INFLATED OR NOT.
  272. C
  273. 6700    BLOC=BLOC+(VAIR2-LEDG2)            !MOVE TO MIDAIR.
  274.     CALL NEWSTA(BALLO,0,BLOC,0,0)
  275.     IF(F) GO TO 6750            !IN BALLOON?
  276.     IF(QLEDGE(HERE)) CALL RSPEAK(539)    !NO, STRANDED.
  277.     CTICK(CEVVLG)=10            !MATERIALIZE GNOME.
  278.     RETURN
  279. C
  280. 6750    F=MOVETO(BLOC,WINNER)            !MOVE TO NEW ROOM.
  281.     CALL RSPEAK(540)            !DESCRIBE.
  282.     F=RMDESC(0)
  283.     RETURN
  284. C
  285. C AT BOTTOM, GO UP IF INFLATED, DO NOTHING IF DEFLATED.
  286. C
  287. 6800    IF((BINFF.EQ.0).OR..NOT.QOPEN(RECEP)) RETURN
  288.     BLOC=VAIR1                !INFLATED AND OPEN,
  289.     CALL NEWSTA(BALLO,0,BLOC,0,0)        !GO UP TO VAIR1.
  290.     IF(F) GO TO 6850            !IN BALLOON?
  291.     IF(QLEDGE(HERE)) CALL RSPEAK(541)    !IF CAN SEE, DESCRIBE.
  292.     RETURN
  293. C
  294. 6850    F=MOVETO(BLOC,WINNER)            !MOVE PLAYER.
  295.     CALL RSPEAK(542)
  296.     F=RMDESC(0)
  297.     RETURN
  298. C CEVAPP, PAGE 4
  299. C
  300. C CEV7--    BALLOON BURNUP
  301. C
  302. 7000    DO 7100 I=1,OLNT            !FIND BURNING OBJECT
  303.       IF((RECEP.EQ.OCAN(I)).AND.((OFLAG1(I).AND.FLAMBT).NE.0))
  304.     1    GO TO 7200            !IN RECEPTACLE.
  305. 7100    CONTINUE
  306.     CALL BUG(4,0)
  307. C
  308. 7200    CALL NEWSTA(I,0,0,0,0)        !VANISH OBJECT.
  309.     BINFF=0                    !UNINFLATED.
  310.     IF(HERE.EQ.BLOC) CALL RSPSUB(292,ODESC2(I))    !DESCRIBE.
  311.     RETURN
  312. C
  313. C CEV8--    FUSE FUNCTION
  314. C
  315. 8000    IF(OCAN(FUSE).NE.BRICK) GO TO 8500    !IGNITED BRICK?
  316.     BR=OROOM(BRICK)                !GET BRICK ROOM.
  317.     BC=OCAN(BRICK)                !GET CONTAINER.
  318.     IF((BR.EQ.0).AND.(BC.NE.0)) BR=OROOM(BC)
  319.     CALL NEWSTA(FUSE,0,0,0,0)        !KILL FUSE.
  320.     CALL NEWSTA(BRICK,0,0,0,0)        !KILL BRICK.
  321.     IF((BR.NE.0).AND.(BR.NE.HERE)) GO TO 8100 !BRICK ELSEWHERE?
  322. C
  323.     RFLAG(HERE)=RFLAG(HERE).OR.RMUNG    !BLEW SELF.
  324.     RRAND(HERE)=114                !MUNG ROOM.
  325.     CALL JIGSUP(150)            !DEAD.
  326.     RETURN
  327. C
  328. 8100    CALL RSPEAK(151)            !BOOM.
  329.     MUNGRM=BR                !SAVE ROOM THAT BLEW.
  330.     CTICK(CEVSAF)=5                !SET SAFE INTERRUPT.
  331.     IF(BR.NE.MSAFE) GO TO 8200        !BLEW SAFE ROOM?
  332.     IF(BC.NE.SSLOT) RETURN            !WAS BRICK IN SAFE?
  333.     CALL NEWSTA(SSLOT,0,0,0,0)        !KILL SLOT.
  334.     OFLAG2(SAFE)=OFLAG2(SAFE).OR.OPENBT    !OPEN SAFE.
  335.     SAFEF=.TRUE.                !INDICATE SAFE BLOWN.
  336.     RETURN
  337. C
  338. 8200    DO 8250 I=1,OLNT            !BLEW WRONG ROOM.
  339.       IF(QHERE(I,BR) .AND. ((OFLAG1(I).AND.TAKEBT).NE.0))
  340.     1    CALL NEWSTA(I,0,0,0,0)        !VANISH CONTENTS.
  341. 8250    CONTINUE
  342.     IF(BR.NE.LROOM) RETURN            !BLEW LIVING ROOM?
  343.     DO 8300 I=1,OLNT
  344.       IF(OCAN(I).EQ.TCASE) CALL NEWSTA(I,0,0,0,0) !KILL TROPHY CASE.
  345. 8300    CONTINUE
  346.     RETURN
  347. C
  348. 8500    IF(QHERE(FUSE,HERE).OR.(OADV(FUSE).EQ.WINNER))
  349.     1    CALL RSPEAK(152)
  350.     CALL NEWSTA(FUSE,0,0,0,0)        !KILL FUSE.
  351.     RETURN
  352. C CEVAPP, PAGE 5
  353. C
  354. C CEV9--    LEDGE MUNGE.
  355. C
  356. 9000    RFLAG(LEDG4)=RFLAG(LEDG4).OR.RMUNG    !LEDGE COLLAPSES.
  357.     RRAND(LEDG4)=109
  358.     IF(HERE.EQ.LEDG4) GO TO 9100        !WAS HE THERE?
  359.     CALL RSPEAK(110)            !NO, NARROW ESCAPE.
  360.     RETURN
  361. C
  362. 9100    IF(AVEHIC(WINNER).NE.0) GO TO 9200    !IN VEHICLE?
  363.     CALL JIGSUP(111)            !NO, DEAD.
  364.     RETURN
  365. C
  366. 9200    IF(BTIEF.NE.0) GO TO 9300        !TIED TO LEDGE?
  367.     CALL RSPEAK(112)            !NO, NO PLACE TO LAND.
  368.     RETURN
  369. C
  370. 9300    BLOC=VLBOT                !YES, CRASH BALLOON.
  371.     CALL NEWSTA(BALLO,0,0,0,0)        !BALLOON & CONTENTS DIE.
  372.     CALL NEWSTA(DBALL,0,BLOC,0,0)        !INSERT DEAD BALLOON.
  373.     BTIEF=0
  374.     BINFF=0
  375.     CFLAG(CEVBAL)=.FALSE.
  376.     CFLAG(CEVBRN)=.FALSE.
  377.     CALL JIGSUP(113)            !DEAD
  378.     RETURN
  379. C
  380. C CEV10--    SAFE MUNG.
  381. C
  382. 10000    RFLAG(MUNGRM)=RFLAG(MUNGRM).OR.RMUNG    !MUNG TARGET.
  383.     RRAND(MUNGRM)=114
  384.     IF(HERE.EQ.MUNGRM) GO TO 10100        !IS HE PRESENT?
  385.     CALL RSPEAK(115)            !LET HIM KNOW.
  386.     IF(MUNGRM.EQ.MSAFE) CTICK(CEVLED)=8    !START LEDGE CLOCK.
  387.     RETURN
  388. C
  389. 10100    I=116                    !HE'S DEAD,
  390.     IF((RFLAG(HERE).AND.RHOUSE).NE.0) I=117    !ONE WAY OR ANOTHER.
  391.     CALL JIGSUP(I)                !LET HIM KNOW.
  392.     RETURN
  393. C CEVAPP, PAGE 6
  394. C
  395. C CEV11--    VOLCANO GNOME
  396. C
  397. 11000    IF(QLEDGE(HERE)) GO TO 11100        !IS HE ON LEDGE?
  398.     CTICK(CEVVLG)=1                !NO, WAIT A WHILE.
  399.     RETURN
  400. C
  401. 11100    CALL NEWSTA(GNOME,118,HERE,0,0)        !YES, MATERIALIZE GNOME.
  402.     RETURN
  403. C
  404. C CEV12--    VOLCANO GNOME DISAPPEARS
  405. C
  406. 12000    CALL NEWSTA(GNOME,149,0,0,0)        !DISAPPEAR THE GNOME.
  407.     RETURN
  408. C
  409. C CEV13--    BUCKET.
  410. C
  411. 13000    IF(OCAN(WATER).EQ.BUCKE)
  412.     1    CALL NEWSTA(WATER,0,0,0,0)    !WATER LEAKS OUT.
  413.     RETURN
  414. C
  415. C CEV14--    SPHERE.  IF EXPIRES, HE'S TRAPPED.
  416. C
  417. 14000    RFLAG(CAGER)=RFLAG(CAGER).OR.RMUNG    !MUNG ROOM.
  418.     RRAND(CAGER)=147
  419.     CALL JIGSUP(148)            !MUNG PLAYER.
  420.     RETURN
  421. C
  422. C CEV15--    END GAME HERALD.
  423. C
  424. 15000    ENDGMF=.TRUE.                !WE'RE IN ENDGAME.
  425.     CALL RSPEAK(119)            !INFORM OF ENDGAME.
  426.     RETURN
  427. C CEVAPP, PAGE 7
  428. C
  429. C CEV16--    FOREST MURMURS
  430. C
  431. 16000    CFLAG(CEVFOR)=(HERE.EQ.MTREE).OR.
  432.     1    ((HERE.GE.FORE1).AND.(HERE.LT.CLEAR))
  433.     IF(CFLAG(CEVFOR).AND.PROB(10,10)) CALL RSPEAK(635)
  434.     RETURN
  435. C
  436. C CEV17--    SCOL ALARM
  437. C
  438. 17000    IF(HERE.EQ.BKTWI) CFLAG(CEVZGI)=.TRUE.    !IF IN TWI, GNOME.
  439.     IF(HERE.EQ.BKVAU) CALL JIGSUP(636)    !IF IN VAU, DEAD.
  440.     RETURN
  441. C
  442. C CEV18--    ENTER GNOME OF ZURICH
  443. C
  444. 18000    CFLAG(CEVZGO)=.TRUE.            !EXITS, TOO.
  445.     CALL NEWSTA(ZGNOM,0,BKTWI,0,0)        !PLACE IN TWI.
  446.     IF(HERE.EQ.BKTWI) CALL RSPEAK(637)    !ANNOUNCE.
  447.     RETURN
  448. C
  449. C CEV19--    EXIT GNOME
  450. C
  451. 19000    CALL NEWSTA(ZGNOM,0,0,0,0)        !VANISH.
  452.     IF(HERE.EQ.BKTWI) CALL RSPEAK(638)    !ANNOUNCE.
  453.     RETURN
  454. C CEVAPP, PAGE 8
  455. C
  456. C CEV20--    START OF ENDGAME
  457. C
  458. 20000    IF(SPELLF) GO TO 20200            !SPELL HIS WAY IN?
  459.     IF(HERE.NE.CRYPT) RETURN        !NO, STILL IN TOMB?
  460.     IF(.NOT.LIT(HERE)) GO TO 20100        !LIGHTS OFF?
  461.     CTICK(CEVSTE)=3                !RESCHEDULE.
  462.     RETURN
  463. C
  464. 20100    CALL RSPEAK(727)            !ANNOUNCE.
  465. 20200    DO 20300 I=1,OLNT            !STRIP HIM OF OBJS.
  466.       CALL NEWSTA(I,0,OROOM(I),OCAN(I),0)
  467. 20300    CONTINUE
  468.     CALL NEWSTA(LAMP,0,0,0,PLAYER)        !GIVE HIM LAMP.
  469.     CALL NEWSTA(SWORD,0,0,0,PLAYER)        !GIVE HIM SWORD.
  470. C
  471.     OFLAG1(LAMP)=(OFLAG1(LAMP).OR.LITEBT).AND. .NOT.ONBT
  472.     OFLAG2(LAMP)=OFLAG2(LAMP).OR.TCHBT
  473.     CFLAG(CEVLNT)=.FALSE.            !LAMP IS GOOD AS NEW.
  474.     CTICK(CEVLNT)=350
  475.     ORLAMP=0
  476.     OFLAG2(SWORD)=OFLAG2(SWORD).OR.TCHBT    !RECREATE SWORD.
  477.     SWDACT=.TRUE.
  478.     SWDSTA=0
  479. C
  480.     THFACT=.FALSE.                !THIEF GONE.
  481.     ENDGMF=.TRUE.                !ENDGAME RUNNING.
  482.     CFLAG(CEVMAT)=.FALSE.            !MATCHES GONE,
  483.     CFLAG(CEVCND)=.FALSE.            !CANDLES GONE.
  484. C
  485.     CALL SCRUPD(RVAL(CRYPT))        !SCORE CRYPT,
  486.     RVAL(CRYPT)=0                !BUT ONLY ONCE.
  487.     F=MOVETO(TSTRS,WINNER)            !TO TOP OF STAIRS,
  488.     F=RMDESC(3)                !AND DESCRIBE.
  489.     RETURN                    !BAM!
  490. C
  491. C CEV21--    MIRROR CLOSES.
  492. C
  493. 21000    MRPSHF=.FALSE.            !BUTTON IS OUT.
  494.     MROPNF=.FALSE.                !MIRROR IS CLOSED.
  495.     IF(HERE.EQ.MRANT) CALL RSPEAK(728)    !DESCRIBE BUTTON.
  496.     IF((HERE.EQ.INMIR).OR.(MRHERE(HERE).EQ.1))
  497.     1    CALL RSPEAK(729)        !DESCRIBE MIRROR.
  498.     RETURN
  499. C CEVAPP, PAGE 9
  500. C
  501. C CEV22--    DOOR CLOSES.
  502. C
  503. 22000    IF(WDOPNF) CALL RSPEAK(730)        !DESCRIBE.
  504.     WDOPNF=.FALSE.                !CLOSED.
  505.     RETURN
  506. C
  507. C CEV23--    INQUISITOR'S QUESTION
  508. C
  509. 23000    IF(AROOM(PLAYER).NE.FDOOR) RETURN    !IF PLAYER LEFT, DIE.
  510.     CALL RSPEAK(769)
  511.     CALL RSPEAK(770+QUESNO)
  512.     CTICK(CEVINQ)=2
  513.     RETURN
  514. C
  515. C CEV24--    MASTER FOLLOWS
  516. C
  517. 24000    IF(AROOM(AMASTR).EQ.HERE) RETURN    !NO MOVEMENT, DONE.
  518.     IF((HERE.NE.CELL).AND.(HERE.NE.PCELL)) GO TO 24100
  519.     IF(FOLLWF) CALL RSPEAK(811)        !WONT GO TO CELLS.
  520.     FOLLWF=.FALSE.
  521.     RETURN
  522. C
  523. 24100    FOLLWF=.TRUE.                !FOLLOWING.
  524.     I=812                    !ASSUME CATCHES UP.
  525.     DO 24200 J=XMIN,XMAX,XMIN
  526.       IF(FINDXT(J,AROOM(AMASTR)).AND.(XROOM1.EQ.HERE))
  527.     1    I=813                !ASSUME FOLLOWS.
  528. 24200    CONTINUE
  529.     CALL RSPEAK(I)
  530.     CALL NEWSTA(MASTER,0,HERE,0,0)        !MOVE MASTER OBJECT.
  531.     AROOM(AMASTR)=HERE        !MOVE MASTER PLAYER.
  532.     RETURN
  533. C
  534.     END
  535. C LITINT-    LIGHT INTERRUPT PROCESSOR
  536. C
  537. C DECLARATIONS
  538. C
  539.     SUBROUTINE LITINT(OBJ,CTR,CEV,TICKS,TICKLN)
  540.     IMPLICIT INTEGER (A-Z)
  541.     INTEGER TICKS(TICKLN)
  542. C
  543. C GAME STATE
  544. C
  545.     LOGICAL TELFLG
  546.     COMMON /PLAY/ WINNER,HERE,TELFLG
  547. C
  548. C OBJECTS
  549. C
  550.     COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220),
  551.     1    OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
  552.     2    OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
  553.     3    OADV(220),OCAN(220),OREAD(220)
  554. C
  555.     COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT,
  556.     1    NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT,
  557.     2    TOOLBT,TURNBT,ONBT
  558.     COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT,
  559.     1    WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT,
  560.     2    TCHBT,VEHBT,SCHBT
  561. C
  562. C CLOCK INTERRUPTS
  563. C
  564.     LOGICAL*1 CFLAG
  565.     COMMON /CEVENT/ CLNT,CTICK(25),CACTIO(25),CFLAG(25)
  566. C
  567.     CTR=CTR+1                !ADVANCE STATE CNTR.
  568.     CTICK(CEV)=TICKS(CTR)        !RESET INTERRUPT.
  569.     IF(CTICK(CEV).NE.0) GO TO 100        !EXPIRED?
  570.     OFLAG1(OBJ)=OFLAG1(OBJ).AND. .NOT.(LITEBT+FLAMBT+ONBT)
  571.     IF((OROOM(OBJ).EQ.HERE).OR.(OADV(OBJ).EQ.WINNER))
  572.     1    CALL RSPSUB(293,ODESC2(OBJ))
  573.     RETURN
  574. C
  575. 100    IF((OROOM(OBJ).EQ.HERE).OR.(OADV(OBJ).EQ.WINNER))
  576.     1    CALL RSPEAK(TICKS(CTR+(TICKLN/2)))
  577.     RETURN
  578. C
  579.     END
  580.