Source to dungeon-2.5.6/ballop.f
C BALLOP- BALLOON FUNCTION
C
C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA
C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
C WRITTEN BY R. M. SUPNIK
C
C DECLARATIONS
C
LOGICAL FUNCTION BALLOP(ARG)
IMPLICIT INTEGER (A-Z)
LOGICAL FINDXT,QEMPTY
C
C PARSER OUTPUT
C
LOGICAL PRSWON
COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON
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
C EXITS
C
COMMON /CURXT/ XTYPE,XROOM1,XSTRNG,XACTIO,XOBJ
C
COMMON /XPARS/ XRMASK,XDMASK,XFMASK,XFSHFT,XASHFT,
1 XELNT(4),XNORM,XNO,XCOND,XDOOR,XLFLAG
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,
4 CEVMRS,CEVPIN,CEVINQ,CEVFOL
C
C VERBS
C
COMMON /VINDEX/ CINTW,DEADXW,FRSTQW,INXW,OUTXW
COMMON /VINDEX/ WALKIW,FIGHTW,FOOW
COMMON /VINDEX/ MELTW,READW,INFLAW,DEFLAW,ALARMW,EXORCW
COMMON /VINDEX/ PLUGW,KICKW,WAVEW,RAISEW,LOWERW,RUBW
COMMON /VINDEX/ PUSHW,UNTIEW,TIEW,TIEUPW,TURNW,BREATW
COMMON /VINDEX/ KNOCKW,LOOKW,EXAMIW,SHAKEW,MOVEW,TRNONW,TRNOFW
COMMON /VINDEX/OPENW,CLOSEW,FINDW,WAITW,SPINW,BOARDW,UNBOAW,TAKEW
COMMON /VINDEX/ INVENW,FILLW,EATW,DRINKW,BURNW
COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW
COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW
COMMON /VINDEX/ DIGW,LEAPW,STAYW,FOLLOW
COMMON /VINDEX/ HELLOW,LOOKIW,LOOKUW,PUMPW,WINDW
COMMON /VINDEX/ CLMBW,CLMBUW,CLMBDW,TRNTOW
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 BALLOP, PAGE 2
C
BALLOP=.TRUE.
C ASSUME WINS.
IF(ARG.NE.2) GO TO 200
C READOUT?
IF(PRSA.NE.LOOKW) GO TO 10
C ONLY PROCESS LOOK.
IF(BINFF.NE.0) GO TO 50
C INFLATED?
CALL RSPEAK(543)
C NO.
GO TO 100
50 CALL RSPSUB(544,ODESC2(BINFF))
C YES.
100 IF(BTIEF.NE.0) CALL RSPEAK(545)
C HOOKED?
RETURN
C
200 IF(ARG.NE.1) GO TO 500
C READIN?
IF(PRSA.NE.WALKW) GO TO 300
C WALK?
IF(FINDXT(PRSO,HERE)) GO TO 250
C VALID EXIT?
CALL RSPEAK(546)
C NO, JOKE.
RETURN
C
250 IF(BTIEF.EQ.0) GO TO 275
C TIED UP?
CALL RSPEAK(547)
C YES, JOKE.
RETURN
C
275 IF(XTYPE.NE.XNORM) GO TO 10
C NORMAL EXIT?
IF(ZAND(RFLAG(XROOM1),RMUNG).EQ.0) BLOC=XROOM1
10 BALLOP=.FALSE.
RETURN
C
300 IF((PRSA.NE.TAKEW).OR.(PRSO.NE.BINFF)) GO TO 350
CALL RSPSUB(548,ODESC2(BINFF))
C RECEP CONT TOO HOT.
RETURN
C
350 IF((PRSA.NE.PUTW).OR.(PRSI.NE.RECEP).OR.QEMPTY(RECEP))
1 GO TO 10
C RECEP ALREADY FULL.
CALL RSPEAK(549)
RETURN
C
500 IF((PRSA.NE.UNBOAW).OR.(ZAND(RFLAG(HERE),RLAND).EQ.0))
1 GO TO 600
C DISEMBARK ON LAND?
IF(BINFF.NE.0) CTICK(CEVBAL)=3
C HE GOT OUT, START B
GO TO 10
C
600 IF((PRSA.NE.BURNW).OR.(OCAN(PRSO).NE.RECEP)) GO TO 700
CALL RSPSUB(550,ODESC2(PRSO))
C LIGHT FIRE IN RECEP
CTICK(CEVBRN)=OSIZE(PRSO)*20
OFLAG1(PRSO)=ZAND(ZOR(OFLAG1(PRSO),(ONBT+FLAMBT+LITEBT)),
1 ZNOT(TAKEBT+READBT))
C BURN IT.
IF(BINFF.NE.0) RETURN
C ALREADY INFLATED?
IF(.NOT.BLABF) CALL NEWSTA(BLABE,0,0,BALLO,0)
C INSERT LABE
BLABF=.TRUE.
C ONLY ONCE.
BINFF=PRSO
CTICK(CEVBAL)=3
C START COUNTDOWN.
CALL RSPEAK(551)
RETURN
C
700 IF((PRSA.EQ.UNBOAW).AND.(BINFF.NE.0).AND.
1 (ZAND(RFLAG(HERE),RLAND).NE.0))
1 CTICK(CEVBAL)=3
GO TO 10
C
END
C
C LIGHTP- LIGHT PROCESSOR
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
LOGICAL FUNCTION LIGHTP(OBJ)
IMPLICIT INTEGER (A-Z)
LOGICAL QON
C
C PARSER OUTPUT
C
LOGICAL PRSWON
COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON
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
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 VERBS
C
COMMON /VINDEX/ CINTW,DEADXW,FRSTQW,INXW,OUTXW
COMMON /VINDEX/ WALKIW,FIGHTW,FOOW
COMMON /VINDEX/ MELTW,READW,INFLAW,DEFLAW,ALARMW,EXORCW
COMMON /VINDEX/ PLUGW,KICKW,WAVEW,RAISEW,LOWERW,RUBW
COMMON /VINDEX/ PUSHW,UNTIEW,TIEW,TIEUPW,TURNW,BREATW
COMMON /VINDEX/ KNOCKW,LOOKW,EXAMIW,SHAKEW,MOVEW,TRNONW,TRNOFW
COMMON /VINDEX/OPENW,CLOSEW,FINDW,WAITW,SPINW,BOARDW,UNBOAW,TAKEW
COMMON /VINDEX/ INVENW,FILLW,EATW,DRINKW,BURNW
COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW
COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW
COMMON /VINDEX/ DIGW,LEAPW,STAYW,FOLLOW
COMMON /VINDEX/ HELLOW,LOOKIW,LOOKUW,PUMPW,WINDW
COMMON /VINDEX/ CLMBW,CLMBUW,CLMBDW,TRNTOW
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
QON(R)=ZAND(OFLAG1(R),ONBT).NE.0
C LIGHTP, PAGE 2
C
LIGHTP=.TRUE.
C ASSUME WINS
FLOBTS=FLAMBT+LITEBT+ONBT
IF(OBJ.NE.CANDL) GO TO 20000
C CANDLE?
IF(ORCAND.NE.0) GO TO 19100
C FIRST REF?
ORCAND=1
C YES, CANDLES ARE
CTICK(CEVCND)=50
C BURNING WHEN SEEN.
C
19100 IF(PRSI.EQ.CANDL) GO TO 10
C IGNORE IND REFS.
IF(PRSA.NE.TRNOFW) GO TO 19200
C TURN OFF?
I=513
C ASSUME OFF.
IF(QON(CANDL)) I=514
C IF ON, DIFFERENT.
CFLAG(CEVCND)=.FALSE.
C DISABLE COUNTDOWN.
OFLAG1(CANDL)=ZAND(OFLAG1(CANDL), ZNOT(ONBT))
CALL RSPEAK(I)
RETURN
C
19200 IF((PRSA.NE.BURNW).AND.(PRSA.NE.TRNONW)) GO TO 10
IF(ZAND(OFLAG1(CANDL),LITEBT).NE.0) GO TO 19300
CALL RSPEAK(515)
C CANDLES TOO SHORT.
RETURN
C
19300 IF(PRSI.NE.0) GO TO 19400
C ANY FLAME?
CALL RSPEAK(516)
C NO, LOSE.
PRSWON=.FALSE.
RETURN
C
19400 IF((PRSI.NE.MATCH).OR. .NOT.QON(MATCH)) GO TO 19500
I=517
C ASSUME OFF.
IF(QON(CANDL)) I=518
C IF ON, JOKE.
OFLAG1(CANDL)=ZOR(OFLAG1(CANDL),ONBT)
C LITE CANDLES.
CFLAG(CEVCND)=.TRUE.
C RESUME COUNTDOWN.
CALL RSPEAK(I)
RETURN
C
19500 IF((PRSI.NE.TORCH).OR. .NOT.QON(TORCH)) GO TO 19600
IF(QON(CANDL)) GO TO 19700
C ALREADY ON?
CALL NEWSTA(CANDL,521,0,0,0)
C NO, VAPORIZE.
RETURN
C
19600 CALL RSPEAK(519)
C CANT LIGHT WITH THAT.
RETURN
C
19700 CALL RSPEAK(520)
C ALREADY ON.
RETURN
C
20000 IF(OBJ.NE.MATCH) CALL BUG(6,OBJ)
IF((PRSA.NE.TRNONW).OR.(PRSO.NE.MATCH)) GO TO 20500
IF(ORMTCH.NE.0) GO TO 20100
C ANY MATCHES LEFT?
CALL RSPEAK(183)
C NO, LOSE.
RETURN
C
20100 ORMTCH=ORMTCH-1
C DECREMENT NO MATCHES.
OFLAG1(MATCH)=ZOR(OFLAG1(MATCH),FLOBTS)
CTICK(CEVMAT)=2
C COUNTDOWN.
CALL RSPEAK(184)
RETURN
C
20500 IF((PRSA.NE.TRNOFW).OR.(ZAND(OFLAG1(MATCH),ONBT).EQ.0))
1 GO TO 10
C EXTINGUISH?
OFLAG1(MATCH)=ZAND(OFLAG1(MATCH), ZNOT(FLOBTS))
CTICK(CEVMAT)=0
CALL RSPEAK(185)
RETURN
C
C HERE FOR FALSE RETURN
C
10 LIGHTP=.FALSE.
RETURN
END