Source to dungeon-2.5.6/nobjs.f
C NOBJS- NEW OBJECTS PROCESSOR
C OBJECTS IN THIS MODULE CANNOT CALL RMINFO, JIGSUP,
C MAJOR VERBS, OR OTHER NON-RESIDENT SUBROUTINES
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 NOBJS(RI,ARG)
IMPLICIT INTEGER (A-Z)
LOGICAL QOPEN,MOVETO,F
LOGICAL QHERE,OPNCLS,MIRPAN
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 SCREEN OF LIGHT
C
COMMON /SCREEN/ FROMDR,SCOLRM,SCOLAC
COMMON /SCREEN/ SCOLDR(8),SCOLWL(12)
C
C PUZZLE ROOM
C
COMMON /PUZZLE/ CPDR(16),CPWL(8),CPVEC(64)
C
C MISCELLANEOUS VARIABLES
C
COMMON /HYPER/ HFACTR
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 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 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
QOPEN(R)=ZAND(OFLAG2(R),OPENBT).NE.0
I=ARG
C NOBJS, PAGE 2
C
IF(PRSO.NE.0) ODO2=ODESC2(PRSO)
IF(PRSI.NE.0) ODI2=ODESC2(PRSI)
AV=AVEHIC(WINNER)
NOBJS=.TRUE.
C
GO TO (1000,2000,3000,4000,5000,6000,7000,8000,9000,
1 10000,11000,12000,13000,14000,15000,16000,17000,
2 18000,19000,20000,21000),
3 (RI-31)
CALL BUG(6,RI)
C
C RETURN HERE TO DECLARE FALSE RESULT
C
10 NOBJS=.FALSE.
RETURN
C
C O32-- BILLS
C
1000 IF(PRSA.NE.EATW) GO TO 1100
C EAT?
CALL RSPEAK(639)
C JOKE.
RETURN
C
1100 IF(PRSA.EQ.BURNW) CALL RSPEAK(640)
C BURN? JOKE.
GO TO 10
C LET IT BE HANDLED.
C NOBJS, PAGE 3
C
C O33-- SCREEN OF LIGHT
C
2000 TARGET=SCOL
C TARGET IS SCOL.
2100 IF(PRSO.NE.TARGET) GO TO 2400
C PRSO EQ TARGET?
IF((PRSA.NE.PUSHW).AND.(PRSA.NE.MOVEW).AND.
1 (PRSA.NE.TAKEW).AND.(PRSA.NE.RUBW)) GO TO 2200
CALL RSPEAK(673)
C HAND PASSES THRU.
RETURN
C
2200 IF((PRSA.NE.KILLW).AND.(PRSA.NE.ATTACW).AND.
1 (PRSA.NE.MUNGW)) GO TO 2400
C AGGRESSIVE?
CALL RSPSUB(674,ODI2)
C PASSES THRU.
RETURN
C
2400 IF((PRSA.NE.THROWW).OR.(PRSI.NE.TARGET)) GO TO 10
IF(HERE.EQ.BKBOX) GO TO 2600
C THRU SCOL?
CALL NEWSTA(PRSO,0,BKBOX,0,0)
C NO, THRU WALL.
CALL RSPSUB(675,ODO2)
C ENDS UP IN BOX ROOM.
CTICK(CEVSCL)=0
C CANCEL ALARM.
SCOLRM=0
C RESET SCOL ROOM.
RETURN
C
2600 IF(SCOLRM.EQ.0) GO TO 2900
C TRIED TO GO THRU?
CALL NEWSTA(PRSO,0,SCOLRM,0,0)
C SUCCESS.
CALL RSPSUB(676,ODO2)
C ENDS UP SOMEWHERE.
CTICK(CEVSCL)=0
C CANCEL ALARM.
SCOLRM=0
C RESET SCOL ROOM.
RETURN
C
2900 CALL RSPEAK(213)
C CANT DO IT.
RETURN
C NOBJS, PAGE 4
C
C O34-- GNOME OF ZURICH
C
3000 IF((PRSA.NE.GIVEW).AND.(PRSA.NE.THROWW)) GO TO 3200
IF(OTVAL(PRSO).NE.0) GO TO 3100
C THROW A TREASURE?
CALL NEWSTA(PRSO,641,0,0,0)
C NO, GO POP.
RETURN
C
3100 CALL NEWSTA(PRSO,0,0,0,0)
C YES, BYE BYE TREASURE.
CALL RSPSUB(642,ODO2)
CALL NEWSTA(ZGNOM,0,0,0,0)
C BYE BYE GNOME.
CTICK(CEVZGO)=0
C CANCEL EXIT.
F=MOVETO(BKENT,WINNER)
C NOW IN BANK ENTRANCE.
RETURN
C
3200 IF((PRSA.NE.ATTACW).AND.(PRSA.NE.KILLW).AND.
1 (PRSA.NE.MUNGW)) GO TO 3300
C AGGRESSIVE?
CALL NEWSTA(ZGNOM,643,0,0,0)
C VANISH GNOME.
CTICK(CEVZGO)=0
C CANCEL EXIT.
RETURN
C
3300 CALL RSPEAK(644)
C GNOME IS IMPATIENT.
RETURN
C
C O35-- EGG
C
4000 IF((PRSA.NE.OPENW).OR.(PRSO.NE.EGG)) GO TO 4500
IF(.NOT.QOPEN(EGG)) GO TO 4100
C OPEN ALREADY?
CALL RSPEAK(649)
C YES.
RETURN
C
4100 IF(PRSI.NE.0) GO TO 4200
C WITH SOMETHING?
CALL RSPEAK(650)
C NO, CANT.
RETURN
C
4200 IF(PRSI.NE.HANDS) GO TO 4300
C WITH HANDS?
CALL RSPEAK(651)
C NOT RECOMMENDED.
RETURN
C
4300 I=652
C MUNG MESSAGE.
IF((ZAND(OFLAG1(PRSI),TOOLBT).NE.0).OR.
1 (ZAND(OFLAG2(PRSI),WEAPBT).NE.0)) GO TO 4600
I=653
C NOVELTY 1.
IF(ZAND(OFLAG2(PRSO),FITEBT).NE.0) I=654
C NOVELTY 2.
OFLAG2(PRSO)=ZOR(OFLAG2(PRSO),FITEBT)
CALL RSPSUB(I,ODI2)
RETURN
C
4500 IF((PRSA.NE.OPENW).AND.(PRSA.NE.MUNGW)) GO TO 4800
I=655
C YOU BLEW IT.
4600 CALL NEWSTA(BEGG,I,OROOM(EGG),OCAN(EGG),OADV(EGG))
CALL NEWSTA(EGG,0,0,0,0)
C VANISH EGG.
OTVAL(BEGG)=2
C BAD EGG HAS VALUE.
IF(OCAN(CANAR).NE.EGG) GO TO 4700
C WAS CANARY INSIDE?
CALL RSPEAK(ODESCO(BCANA))
C YES, DESCRIBE RESULT.
OTVAL(BCANA)=1
RETURN
C
4700 CALL NEWSTA(BCANA,0,0,0,0)
C NO, VANISH IT.
RETURN
C
4800 IF((PRSA.NE.DROPW).OR.(HERE.NE.MTREE)) GO TO 10
CALL NEWSTA(BEGG,658,FORE3,0,0)
C DROPPED EGG.
CALL NEWSTA(EGG,0,0,0,0)
OTVAL(BEGG)=2
IF(OCAN(CANAR).NE.EGG) GO TO 4700
OTVAL(BCANA)=1
C BAD CANARY.
RETURN
C NOBJS, PAGE 5
C
C O36-- CANARIES, GOOD AND BAD
C
5000 IF(PRSA.NE.WINDW) GO TO 10
C WIND EM UP?
IF(PRSO.EQ.CANAR) GO TO 5100
C RIGHT ONE?
CALL RSPEAK(645)
C NO, BAD NEWS.
RETURN
C
5100 IF(.NOT.SINGSF.AND.((HERE.EQ.MTREE).OR.
1 ((HERE.GE.FORE1).AND.(HERE.LT.CLEAR))))
2 GO TO 5200
C FIRST SONG IN FOR?
CALL RSPEAK(646)
C NO, MEDIOCRE NEWS.
RETURN
C
5200 SINGSF=.TRUE.
C SANG SONG.
I=HERE
IF(I.EQ.MTREE) I=FORE3
C PLACE BAUBLE.
CALL NEWSTA(BAUBL,647,I,0,0)
RETURN
C
C O37-- WHITE CLIFFS
C
6000 IF((PRSA.NE.CLMBW).AND.(PRSA.NE.CLMBUW).AND.
1 (PRSA.NE.CLMBDW)) GO TO 10
C CLIMB?
CALL RSPEAK(648)
C OH YEAH?
RETURN
C
C O38-- WALL
C
7000 IF((IABS(HERE-MLOC).NE.1).OR.(MRHERE(HERE).NE.0).OR.
1 (PRSA.NE.PUSHW)) GO TO 7100
CALL RSPEAK(860)
C PUSHED MIRROR WALL.
RETURN
C
7100 IF(ZAND(RFLAG(HERE),RNWALL).EQ.0) GO TO 10
CALL RSPEAK(662)
C NO WALL.
RETURN
C NOBJS, PAGE 6
C
C O39-- SONG BIRD GLOBAL
C
8000 IF(PRSA.NE.FINDW) GO TO 8100
C FIND?
CALL RSPEAK(666)
RETURN
C
8100 IF(PRSA.NE.EXAMIW) GO TO 10
C EXAMINE?
CALL RSPEAK(667)
RETURN
C
C O40-- PUZZLE/SCOL WALLS
C
9000 IF(HERE.NE.CPUZZ) GO TO 9500
C PUZZLE WALLS?
IF(PRSA.NE.PUSHW) GO TO 10
C PUSH?
DO 9100 I=1,8,2
C LOCATE WALL.
IF(PRSO.EQ.CPWL(I)) GO TO 9200
9100 CONTINUE
CALL BUG(80,PRSO)
C WHAT?
C
9200 J=CPWL(I+1)
C GET DIRECTIONAL OFFSET.
NXT=CPHERE+J
C GET NEXT STATE.
WL=CPVEC(NXT)
C GET C(NEXT STATE).
GO TO (9300,9300,9300,9250,9350),(WL+4)
C PROCESS.
C
9250 CALL RSPEAK(876)
C CLEAR CORRIDOR.
RETURN
C
9300 IF(CPVEC(NXT+J).EQ.0) GO TO 9400
C MOVABLE, ROOM TO MOVE?
9350 CALL RSPEAK(877)
C IMMOVABLE, NO ROOM.
RETURN
C
9400 I=878
C ASSUME FIRST PUSH.
IF(CPUSHF) I=879
C NOT?
CPUSHF=.TRUE.
CPVEC(NXT+J)=WL
C MOVE WALL.
CPVEC(NXT)=0
C VACATE NEXT STATE.
CALL CPGOTO(NXT)
C ONWARD.
CALL CPINFO(I,NXT)
C DESCRIBE.
CALL PRINCR(.TRUE.,HERE)
C PRINT ROOMS CONTENTS.
RFLAG(HERE)=ZOR(RFLAG(HERE),RSEEN)
RETURN
C
9500 IF(HERE.NE.SCOLAC) GO TO 9700
C IN SCOL ACTIVE ROOM?
DO 9600 I=1,12,3
TARGET=SCOLWL(I+1)
C ASSUME TARGET.
IF(SCOLWL(I).EQ.HERE) GO TO 2100
C TREAT IF FOUND.
9600 CONTINUE
C
9700 IF(HERE.NE.BKBOX) GO TO 10
C IN BOX ROOM?
TARGET=WNORT
GO TO 2100
C NOBJS, PAGE 7
C
C O41-- SHORT POLE
C
10000 IF(PRSA.NE.RAISEW) GO TO 10100
C LIFT?
I=749
C ASSUME UP.
IF(POLEUF.EQ.2) I=750
C ALREADY UP?
CALL RSPEAK(I)
POLEUF=2
C POLE IS RAISED.
RETURN
C
10100 IF((PRSA.NE.LOWERW).AND.(PRSA.NE.PUSHW)) GO TO 10
IF(POLEUF.NE.0) GO TO 10200
C ALREADY LOWERED?
CALL RSPEAK(751)
C CANT DO IT.
RETURN
C
10200 IF(MOD(MDIR,180).NE.0) GO TO 10300
C MIRROR N-S?
POLEUF=0
C YES, LOWER INTO
CALL RSPEAK(752)
C CHANNEL.
RETURN
C
10300 IF((MDIR.NE.270).OR.(MLOC.NE.MRB)) GO TO 10400
POLEUF=0
C LOWER INTO HOLE.
CALL RSPEAK(753)
RETURN
C
10400 CALL RSPEAK(753+POLEUF)
C POLEUF = 1 OR 2.
POLEUF=1
C NOW ON FLOOR.
RETURN
C
C O42-- MIRROR SWITCH
C
11000 IF(PRSA.NE.PUSHW) GO TO 10
C PUSH?
IF(MRPSHF) GO TO 11300
C ALREADY PUSHED?
CALL RSPEAK(756)
C BUTTON GOES IN.
DO 11100 I=1,OLNT
C BLOCKED?
IF(QHERE(I,MREYE).AND.(I.NE.RBEAM)) GO TO 11200
11100 CONTINUE
CALL RSPEAK(757)
C NOTHING IN BEAM.
RETURN
C
11200 CFLAG(CEVMRS)=.TRUE.
C MIRROR OPENS.
CTICK(CEVMRS)=7
MRPSHF=.TRUE.
MROPNF=.TRUE.
RETURN
C
11300 CALL RSPEAK(758)
C MIRROR ALREADYOPEN.
RETURN
C NOBJS, PAGE 8
C
C O43-- BEAM FUNCTION
C
12000 IF((PRSA.NE.TAKEW).OR.(PRSO.NE.RBEAM)) GO TO 12100
CALL RSPEAK(759)
C TAKE BEAM, JOKE.
RETURN
C
12100 I=PRSO
C ASSUME BLK WITH DIROBJ.
IF((PRSA.EQ.PUTW).AND.(PRSI.EQ.RBEAM)) GO TO 12200
IF((PRSA.NE.MUNGW).OR.(PRSO.NE.RBEAM).OR.
1 (PRSI.EQ.0)) GO TO 10
C BREAK BEAM WITH X?
I=PRSI
12200 IF(OADV(I).NE.WINNER) GO TO 12300
C CARRYING?
CALL NEWSTA(I,0,HERE,0,0)
C DROP OBJ.
CALL RSPSUB(760,ODESC2(I))
RETURN
C
12300 J=761
C ASSUME NOT IN ROOM.
IF(QHERE(J,HERE)) I=762
C IN ROOM?
CALL RSPSUB(J,ODESC2(I))
C DESCRIBE.
RETURN
C
C O44-- BRONZE DOOR
C
13000 IF((HERE.EQ.NCELL).OR.((LCELL.EQ.4).AND.
1 ((HERE.EQ.CELL).OR.(HERE.EQ.SCORR))))
2 GO TO 13100
CALL RSPEAK(763)
C DOOR NOT THERE.
RETURN
C
13100 IF(.NOT.OPNCLS(ODOOR,764,765)) GO TO 10
C OPEN/CLOSE?
IF((HERE.EQ.NCELL).AND.QOPEN(ODOOR))
1 CALL RSPEAK(766)
C DESCR VIEW.
RETURN
C
C O45-- QUIZ DOOR
C
14000 IF((PRSA.NE.OPENW).AND.(PRSA.NE.CLOSEW)) GO TO 14100
CALL RSPEAK(767)
C DOOR WONT MOVE.
RETURN
C
14100 IF(PRSA.NE.KNOCKW) GO TO 10
C KNOCK?
IF(INQSTF) GO TO 14200
C TRIED IT ALREADY?
INQSTF=.TRUE.
C START INQUISITION.
CFLAG(CEVINQ)=.TRUE.
CTICK(CEVINQ)=2
QUESNO=ZRND(8)
C SELECT QUESTION.
NQATT=0
CORRCT=0
CALL RSPEAK(768)
C ANNOUNCE RULES.
CALL RSPEAK(769)
CALL RSPEAK(770+QUESNO)
C ASK QUESTION.
RETURN
C
14200 CALL RSPEAK(798)
C NO REPLY.
RETURN
C
C O46-- LOCKED DOOR
C
15000 IF(PRSA.NE.OPENW) GO TO 10
C OPEN?
CALL RSPEAK(778)
C CANT.
RETURN
C
C O47-- CELL DOOR
C
16000 NOBJS=OPNCLS(CDOOR,779,780)
C OPEN/CLOSE?
RETURN
C NOBJS, PAGE 9
C
C O48-- DIALBUTTON
C
17000 IF(PRSA.NE.PUSHW) GO TO 10
C PUSH?
CALL RSPEAK(809)
C CLICK.
IF(QOPEN(CDOOR)) CALL RSPEAK(810)
C CLOSE CELL DOOR.
C
DO 17100 I=1,OLNT
C RELOCATE OLD TO HYPER.
IF((OROOM(I).EQ.CELL).AND.(ZAND(OFLAG1(I),DOORBT).EQ.0))
1 CALL NEWSTA(I,0,LCELL*HFACTR,0,0)
IF(OROOM(I).EQ.(PNUMB*HFACTR))
1 CALL NEWSTA(I,0,CELL,0,0)
C MOVE IN NEW HYPER.
17100 CONTINUE
C
OFLAG2(ODOOR)=ZAND(OFLAG2(ODOOR),ZNOT(OPENBT))
OFLAG2(CDOOR)=ZAND(OFLAG2(CDOOR),ZNOT(OPENBT))
OFLAG1(ODOOR)=ZAND(OFLAG1(ODOOR),ZNOT(VISIBT))
IF(PNUMB.EQ.4) OFLAG1(ODOOR)=ZOR(OFLAG1(ODOOR),VISIBT)
C
IF(AROOM(PLAYER).NE.CELL) GO TO 17400
C PLAYER IN CELL?
IF(LCELL.NE.4) GO TO 17200
C IN RIGHT CELL?
OFLAG1(ODOOR)=ZOR(OFLAG1(ODOOR), VISIBT)
F=MOVETO(NCELL,PLAYER)
C YES, MOVETO NCELL.
GO TO 17400
17200 F=MOVETO(PCELL,PLAYER)
C NO, MOVETO PCELL.
C
17400 LCELL=PNUMB
RETURN
C NOBJS, PAGE 10
C
C O49-- DIAL INDICATOR
C
18000 IF(PRSA.NE.SPINW) GO TO 18100
C SPIN?
PNUMB=ZRND(8)+1
C WHEE
C
CALL RSPSUB(797,712+PNUMB)
RETURN
C
18100 IF((PRSA.NE.MOVEW).AND.(PRSA.NE.PUTW).AND.
1 (PRSA.NE.TRNTOW)) GO TO 10
IF(PRSI.NE.0) GO TO 18200
C TURN DIAL TO X?
CALL RSPEAK(806)
C MUST SPECIFY.
RETURN
C
18200 IF((PRSI.GE.NUM1).AND.(PRSI.LE.NUM8)) GO TO 18300
CALL RSPEAK(807)
C MUST BE DIGIT.
RETURN
C
18300 PNUMB=PRSI-NUM1+1
C SET UP NEW.
CALL RSPSUB(808,712+PNUMB)
RETURN
C
C O50-- GLOBAL MIRROR
C
19000 NOBJS=MIRPAN(832,.FALSE.)
RETURN
C
C O51-- GLOBAL PANEL
C
20000 IF(HERE.NE.FDOOR) GO TO 20100
C AT FRONT DOOR?
IF((PRSA.NE.OPENW).AND.(PRSA.NE.CLOSEW)) GO TO 10
CALL RSPEAK(843)
C PANEL IN DOOR, NOGO.
RETURN
C
20100 NOBJS=MIRPAN(838,.TRUE.)
RETURN
C
C O52-- PUZZLE ROOM SLIT
C
21000 IF((PRSA.NE.PUTW).OR.(PRSI.NE.CSLIT)) GO TO 10
IF(PRSO.NE.GCARD) GO TO 21100
C PUT CARD IN SLIT?
CALL NEWSTA(PRSO,863,0,0,0)
C KILL CARD.
CPOUTF=.TRUE.
C OPEN DOOR.
OFLAG1(STLDR)=ZAND(OFLAG1(STLDR),ZNOT(VISIBT))
C VANISH DOOR.
RETURN
C
21100 IF((ZAND(OFLAG1(PRSO),VICTBT).EQ.0).AND.
1 (ZAND(OFLAG2(PRSO),VILLBT).EQ.0)) GO TO 21200
CALL RSPEAK(ZRND(5)+552)
C JOKE FOR VILL, VICT.
RETURN
C
21200 CALL NEWSTA(PRSO,0,0,0,0)
C KILL OBJECT.
CALL RSPSUB(864,ODO2)
C DESCRIBE.
RETURN
C
END
C MIRPAN-- PROCESSOR FOR GLOBAL MIRROR/PANEL
C
C DECLARATIONS
C
LOGICAL FUNCTION MIRPAN(ST,PNF)
IMPLICIT INTEGER(A-Z)
LOGICAL PNF
C
C GAME STATE
C
LOGICAL TELFLG
COMMON /PLAY/ WINNER,HERE,TELFLG
C
C PARSER OUTPUT
C
LOGICAL PRSWON
COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON
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 MIRPAN, PAGE 2
C
MIRPAN=.TRUE.
NUM=MRHERE(HERE)
C GET MIRROR NUM.
IF(NUM.NE.0) GO TO 100
C ANY HERE?
CALL RSPEAK(ST)
C NO, LOSE.
RETURN
C
100 MRBF=0
C ASSUME MIRROR OK.
IF(((NUM.EQ.1).AND..NOT.MR1F).OR.
1 ((NUM.EQ.2).AND..NOT.MR2F)) MRBF=1
IF((PRSA.NE.MOVEW).AND.(PRSA.NE.OPENW)) GO TO 200
CALL RSPEAK(ST+1)
C CANT OPEN OR MOVE.
RETURN
C
200 IF(PNF.OR.((PRSA.NE.LOOKIW).AND.(PRSA.NE.EXAMIW).AND.
1 (PRSA.NE.LOOKW))) GO TO 300
CALL RSPEAK(844+MRBF)
C LOOK IN MIRROR.
RETURN
C
300 IF(PRSA.NE.MUNGW) GO TO 400
C BREAK?
CALL RSPEAK(ST+2+MRBF)
C DO IT.
IF((NUM.EQ.1).AND..NOT.PNF) MR1F=.FALSE.
IF((NUM.EQ.2).AND..NOT.PNF) MR2F=.FALSE.
RETURN
C
400 IF(PNF.OR.(MRBF.EQ.0)) GO TO 500
C BROKEN MIRROR?
CALL RSPEAK(846)
RETURN
C
500 IF(PRSA.NE.PUSHW) GO TO 600
C PUSH?
CALL RSPEAK(ST+3+NUM)
RETURN
C
600 MIRPAN=.FALSE.
C CANT HANDLE IT.
RETURN
C
END
C SOBJS- SIMPLE OBJECTS PROCESSOR
C OBJECTS IN THIS MODULE CANNOT CALL RMINFO, JIGSUP,
C MAJOR VERBS, OR OTHER NON-RESIDENT SUBROUTINES
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 SOBJS(RI,ARG)
IMPLICIT INTEGER (A-Z)
LOGICAL QOPEN
LOGICAL MOVETO,OPNCLS,LIT
LOGICAL QHERE,F
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
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 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 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
QOPEN(R)=ZAND(OFLAG2(R),OPENBT).NE.0
C SOBJS, PAGE 2
C
c There is a bug here if command "land" is used while inside
c of the raft. PRSO is set to 12288 and the attempt to look
c up ODO2 results in a seg fault under Linux 2.0.x. Since
c ODO2 isn't used after the lookup, work around this with a
c range check. -- Rick Slater 10/15/98
if( (PRSO .lt. 221) .and. (PRSO .gt. 0) ) then
IF(PRSO.NE.0) ODO2=ODESC2(PRSO)
end if
IF(PRSI.NE.0) ODI2=ODESC2(PRSI)
AV=AVEHIC(WINNER)
SOBJS=.TRUE.
C
GO TO (1000,3000,4000,6000,7000,8000,9000,
1 13000,14000,16000,17000,
2 21000,23000,24000,27000,28000,29000,30000,
3 31000,33000,34000,36000,37000,38000,
4 41000,42000,43000,44000,46000,
5 53000,56000)
6 RI
CALL BUG(6,RI)
C
C RETURN HERE TO DECLARE FALSE RESULT
C
10 SOBJS=.FALSE.
RETURN
C SOBJS, PAGE 3
C
C O1-- GUNK FUNCTION
C
1000 IF(OCAN(GUNK).EQ.0) GO TO 10
C NOT INSIDE? F
CALL NEWSTA(GUNK,122,0,0,0)
C FALLS APART.
RETURN
C
C O2-- TROPHY CASE
C
3000 IF(PRSA.NE.TAKEW) GO TO 10
C TAKE?
CALL RSPEAK(128)
C CANT.
RETURN
C
C O3-- BOTTLE FUNCTION
C
4000 IF(PRSA.NE.THROWW) GO TO 4100
C THROW?
CALL NEWSTA(PRSO,129,0,0,0)
C BREAKS.
RETURN
C
4100 IF(PRSA.NE.MUNGW) GO TO 10
C MUNG?
CALL NEWSTA(PRSO,131,0,0,0)
C BREAKS.
RETURN
C SOBJS, PAGE 4
C
C O4-- ROPE FUNCTION
C
6000 IF(HERE.EQ.DOME) GO TO 6100
C IN DOME?
DOMEF=.FALSE.
C NO,
IF(PRSA.NE.UNTIEW) GO TO 6050
C UNTIE?
CALL RSPEAK(134)
C CANT
RETURN
C
6050 IF(PRSA.NE.TIEW) GO TO 10
C TIE?
CALL RSPEAK(135)
C CANT TIE
RETURN
C
6100 IF((PRSA.NE.TIEW).OR.(PRSI.NE.RAILI)) GO TO 6200
IF(DOMEF) GO TO 6150
C ALREADY TIED?
DOMEF=.TRUE.
C NO, TIE IT.
OFLAG1(ROPE)=ZOR(OFLAG1(ROPE),NDSCBT)
OFLAG2(ROPE)=ZOR(OFLAG2(ROPE),CLMBBT)
CALL NEWSTA(ROPE,137,DOME,0,0)
RETURN
C
6150 CALL RSPEAK(136)
C DUMMY.
RETURN
C
6200 IF(PRSA.NE.UNTIEW) GO TO 6300
C UNTIE?
IF(DOMEF) GO TO 6250
C TIED?
CALL RSPEAK(134)
C NO, DUMMY.
RETURN
C
6250 DOMEF=.FALSE.
C YES, UNTIE IT.
OFLAG1(ROPE)=ZAND(OFLAG1(ROPE),ZNOT(NDSCBT))
OFLAG2(ROPE)=ZAND(OFLAG2(ROPE),ZNOT(CLMBBT))
CALL RSPEAK(139)
RETURN
C
6300 IF(DOMEF.OR.(PRSA.NE.DROPW)) GO TO 6400
C DROP & UNTIED?
CALL NEWSTA(ROPE,140,MTORC,0,0)
C YES, DROP.
RETURN
C
6400 IF((PRSA.NE.TAKEW).OR. .NOT.DOMEF) GO TO 10
CALL RSPEAK(141)
C TAKE & TIED.
RETURN
C
C O5-- SWORD FUNCTION
C
7000 IF((PRSA.EQ.TAKEW).AND.(WINNER.EQ.PLAYER))
1 SWDACT=.TRUE.
C TURN ON DEMON.
GO TO 10
C
C O6-- LANTERN
C
8000 IF(PRSA.NE.THROWW) GO TO 8100
C THROW?
CALL NEWSTA(LAMP,0,0,0,0)
C KILL LAMP,
CALL NEWSTA(BLAMP,142,HERE,0,0)
C REPLACE WITH BROKEN.
RETURN
C
8100 IF(PRSA.EQ.TRNONW) CFLAG(CEVLNT)=.TRUE.
IF(PRSA.EQ.TRNOFW) CFLAG(CEVLNT)=.FALSE.
GO TO 10
C
C O7-- RUG FUNCTION
C
9000 IF(PRSA.NE.RAISEW) GO TO 9100
C RAISE?
CALL RSPEAK(143)
C CANT
RETURN
C
9100 IF(PRSA.NE.TAKEW) GO TO 9200
C TAKE?
CALL RSPEAK(144)
C CANT
RETURN
C
9200 IF(PRSA.NE.MOVEW) GO TO 9300
C MOVE?
CALL RSPEAK(145+ORRUG)
ORRUG=1
OFLAG1(DOOR)=ZOR(OFLAG1(DOOR),VISIBT)
C REVEAL DOOR.
RETURN
C
9300 IF((PRSA.NE.LOOKUW).OR.(ORRUG.NE.0).OR.
1 QOPEN(DOOR)) GO TO 10
C LOOK UNDER RUG?
CALL RSPEAK(345)
RETURN
C SOBJS, PAGE 5
C
C O8-- SKELETON
C
13000 I=ROBRM(HERE,100,LLD2,0,0)+ROBADV(WINNER,LLD2,0,0)
IF(I.NE.0) CALL RSPEAK(162)
C IF ROBBED, SAY SO.
RETURN
C
C O9-- MIRROR
C
14000 IF(MIRRMF.OR.(PRSA.NE.RUBW)) GO TO 14500
MROOM=ZXOR(HERE,1)
C CALCULATE NEW RM.
DO 14100 I=1,OLNT
C INTERCHANGE OBJS.
IF(OROOM(I).EQ.HERE) OROOM(I)=-1
IF(OROOM(I).EQ.MROOM) OROOM(I)=HERE
IF(OROOM(I).EQ.-1) OROOM(I)=MROOM
14100 CONTINUE
F=MOVETO(MROOM,WINNER)
CALL RSPEAK(163)
C SHAKE WORLD.
RETURN
C
14500 IF((PRSA.NE.LOOKW).AND.(PRSA.NE.LOOKIW).AND.
1 (PRSA.NE.EXAMIW)) GO TO 14600
I=164
C MIRROR OK.
IF(MIRRMF) I=165
C MIRROR DEAD.
CALL RSPEAK(I)
RETURN
C
14600 IF(PRSA.NE.TAKEW) GO TO 14700
C TAKE?
CALL RSPEAK(166)
C JOKE.
RETURN
C
14700 IF((PRSA.NE.MUNGW).AND.(PRSA.NE.THROWW)) GO TO 10
I=167
C MIRROR BREAKS.
IF(MIRRMF) I=168
C MIRROR ALREADY BROKEN.
MIRRMF=.TRUE.
BADLKF=.TRUE.
CALL RSPEAK(I)
RETURN
C SOBJS, PAGE 6
C
C O10-- DUMBWAITER
C
16000 IF(PRSA.NE.RAISEW) GO TO 16100
C RAISE?
IF(CAGETF) GO TO 16400
C ALREADY AT TOP?
CALL NEWSTA(TBASK,175,TSHAF,0,0)
C NO, RAISE BASKET.
CALL NEWSTA(FBASK,0,BSHAF,0,0)
CAGETF=.TRUE.
C AT TOP.
RETURN
C
16100 IF(PRSA.NE.LOWERW) GO TO 16200
C LOWER?
IF(.NOT.CAGETF) GO TO 16400
C ALREADY AT BOTTOM?
CALL NEWSTA(TBASK,176,BSHAF,0,0)
C NO, LOWER BASKET.
CALL NEWSTA(FBASK,0,TSHAF,0,0)
CAGETF=.FALSE.
IF(.NOT.LIT(HERE)) CALL RSPEAK(406)
C IF DARK, DIE.
RETURN
C
16200 IF((PRSO.NE.FBASK).AND.(PRSI.NE.FBASK)) GO TO 16300
CALL RSPEAK(130)
C WRONG BASKET.
RETURN
C
16300 IF(PRSA.NE.TAKEW) GO TO 10
C TAKE?
CALL RSPEAK(177)
C JOKE.
RETURN
C
16400 CALL RSPEAK(125+ZRND(3))
C DUMMY.
RETURN
C
C O11-- GHOST FUNCTION
C
17000 I=178
C ASSUME DIRECT.
IF(PRSO.NE.GHOST) I=179
C IF NOT, INDIRECT.
CALL RSPEAK(I)
RETURN
C SPEAK AND EXIT.
C SOBJS, PAGE 7
C
C O12-- TUBE
C
21000 IF((PRSA.NE.PUTW).OR.(PRSI.NE.TUBE)) GO TO 10
CALL RSPEAK(186)
C CANT PUT BACK IN.
RETURN
C
C O13-- CHALICE
C
23000 IF((PRSA.NE.TAKEW).OR.(OCAN(PRSO).NE.0).OR.
1 (OROOM(PRSO).NE.TREAS).OR.(OROOM(THIEF).NE.TREAS).OR.
2 (ZAND(OFLAG2(THIEF),FITEBT).EQ.0).OR.
3 .NOT. THFACT) GO TO 10
CALL RSPEAK(204)
C CANT TAKE.
RETURN
C
C O14-- PAINTING
C
24000 IF(PRSA.NE.MUNGW) GO TO 10
C MUNG?
CALL RSPEAK(205)
C DESTROY PAINTING.
OFVAL(PRSO)=0
OTVAL(PRSO)=0
ODESC1(PRSO)=207
ODESC2(PRSO)=206
RETURN
C SOBJS, PAGE 8
C
C O15-- BOLT
C
27000 IF(PRSA.NE.TURNW) GO TO 10
C TURN BOLT?
IF(PRSI.NE.WRENC) GO TO 27500
C WITH WRENCH?
IF(GATEF) GO TO 27100
C PROPER BUTTON PUSHED?
CALL RSPEAK(210)
C NO, LOSE.
RETURN
C
27100 IF(LWTIDF) GO TO 27200
C LOW TIDE NOW?
LWTIDF=.TRUE.
C NO, EMPTY DAM.
CALL RSPEAK(211)
OFLAG2(COFFI)=ZAND(OFLAG2(COFFI),ZNOT(SCRDBT))
OFLAG1(TRUNK)=ZOR(OFLAG1(TRUNK),VISIBT)
C MATERIALIZE TRUNK.
RFLAG(RESER)=ZAND(ZOR(RFLAG(RESER),RLAND),
1 ZNOT(RWATER+RSEEN))
C KEEP THIEF AWAY.
RETURN
C
27200 LWTIDF=.FALSE.
C YES, FILL DAM.
CALL RSPEAK(212)
IF(QHERE(TRUNK,RESER)) OFLAG1(TRUNK)=ZAND(OFLAG1(TRUNK)
1 ,ZNOT(VISIBT))
RFLAG(RESER)=ZAND(ZOR(RFLAG(RESER),RWATER) ,ZNOT(RLAND))
RETURN
C
27500 CALL RSPSUB(299,ODI2)
C NOT WITH THAT.
RETURN
C
C O16-- GRATING
C
28000 IF((PRSA.NE.OPENW).AND.(PRSA.NE.CLOSEW)) GO TO 10
IF(GRUNLF) GO TO 28200
C UNLOCKED?
CALL RSPEAK(214)
C NO, LOCKED.
RETURN
C
28200 I=215
C UNLOCKED, VIEW FRM CLR.
IF(HERE.NE.CLEAR) I=216
C VIEW FROM BELOW.
SOBJS=OPNCLS(GRATE,I,885)
C OPEN/CLOSE.
RFLAG(MGRAT)=ZAND(RFLAG(MGRAT),ZNOT(RLIGHT))
C SET LIGHT/DARK.
IF(QOPEN(GRATE)) RFLAG(MGRAT)=ZOR(RFLAG(MGRAT),RLIGHT)
IF(.NOT.LIT(HERE)) CALL RSPEAK(406)
C IF DARK, DIE.
RETURN
C
C O17-- TRAP DOOR
C
29000 IF(HERE.NE.LROOM) GO TO 29100
C FROM LIVING ROOM?
SOBJS=OPNCLS(DOOR,218,219)
C OPEN/CLOSE.
RETURN
C
29100 IF(HERE.NE.CELLA) GO TO 10
C FROM CELLAR?
IF((PRSA.NE.OPENW).OR.QOPEN(DOOR)) GO TO 29200
CALL RSPEAK(220)
C CANT OPEN CLOSED DOOR.
RETURN
C
29200 SOBJS=OPNCLS(DOOR,0,22)
C NORMAL OPEN/CLOSE.
RETURN
C
C O18-- DURABLE DOOR
C
30000 I=0
C ASSUME NO APPL.
IF(PRSA.EQ.OPENW) I=221
C OPEN?
IF(PRSA.EQ.BURNW) I=222
C BURN?
IF(PRSA.EQ.MUNGW) I=223+ZRND(3)
C MUNG?
IF(I.EQ.0) GO TO 10
CALL RSPEAK(I)
RETURN
C
C O19-- MASTER SWITCH
C
31000 IF(PRSA.NE.TURNW) GO TO 10
C TURN?
IF(PRSI.NE.SCREW) GO TO 31500
C WITH SCREWDRIVER?
IF(QOPEN(MACHI)) GO TO 31600
C LID UP?
CALL RSPEAK(226)
C NO, ACTIVATE.
IF(OCAN(COAL).NE.MACHI) GO TO 31400
C COAL INSIDE?
CALL NEWSTA(COAL,0,0,0,0)
C KILL COAL,
CALL NEWSTA(DIAMO,0,0,MACHI,0)
C REPLACE WITH DIAMOND.
RETURN
C
31400 DO 31450 I=1,OLNT
C KILL NONCOAL OBJECTS.
IF(OCAN(I).NE.MACHI) GO TO 31450
C INSIDE MACHINE?
CALL NEWSTA(I,0,0,0,0)
C KILL OBJECT AND CONTENTS.
CALL NEWSTA(GUNK,0,0,MACHI,0)
C REDUCE TO GUNK.
31450 CONTINUE
RETURN
C
31500 CALL RSPSUB(300,ODI2)
C CANT TURN WITH THAT.
RETURN
C
31600 CALL RSPEAK(227)
C LID IS UP.
RETURN
C SOBJS, PAGE 9
C
C O20-- LEAK
C
33000 IF((PRSO.NE.LEAK).OR.(PRSA.NE.PLUGW).OR.(RVMNT.LE.0))
1 GO TO 10
C PLUG ACTIVE LEAK?
IF(PRSI.NE.PUTTY) GO TO 33100
C WITH PUTTY?
RVMNT=-1
C DISABLE LEAK.
CTICK(CEVMNT)=0
CALL RSPEAK(577)
RETURN
C
33100 CALL RSPSUB(301,ODI2)
C CANT WITH THAT.
RETURN
C
C O21-- DROWNING BUTTONS
C
34000 IF(PRSA.NE.PUSHW) GO TO 10
C PUSH?
GO TO (34100,34200,34300,34400),(PRSO-RBUTT+1)
GO TO 10
C NOT A BUTTON.
C
34100 RFLAG(HERE)=ZXOR(RFLAG(HERE),RLIGHT)
C RED, ZAP LIGHTS.
I=230
IF(ZAND(RFLAG(HERE),RLIGHT).NE.0) I=231
CALL RSPEAK(I)
RETURN
C
34200 GATEF=.TRUE.
C RELEASE GATE.
CALL RSPEAK(232)
RETURN
C
34300 GATEF=.FALSE.
C INTERLOCK GATE.
CALL RSPEAK(232)
RETURN
C
34400 IF(RVMNT.NE.0) GO TO 34500
C LEAK ALREADY STARTED?
CALL RSPEAK(233)
C NO, START LEAK.
RVMNT=1
CTICK(CEVMNT)=-1
RETURN
C
34500 CALL RSPEAK(234)
C BUTTON JAMMED.
RETURN
C
C O22-- INFLATABLE BOAT
C
36000 IF(PRSA.NE.INFLAW) GO TO 10
C INFLATE?
IF(OROOM(IBOAT).NE.0) GO TO 36100
C IN ROOM?
CALL RSPEAK(235)
C NO, JOKE.
RETURN
C
36100 IF(PRSI.NE.PUMP) GO TO 36200
C WITH PUMP?
CALL NEWSTA(IBOAT,0,0,0,0)
C KILL DEFL BOAT,
CALL NEWSTA(RBOAT,236,HERE,0,0)
C REPL WITH INF.
DEFLAF=.FALSE.
RETURN
C
36200 I=237
C JOKES.
IF(PRSI.NE.LUNGS) I=303
CALL RSPSUB(I,ODI2)
RETURN
C
C O23-- DEFLATED BOAT
C
37000 IF(PRSA.NE.INFLAW) GO TO 37100
C INFLATE?
CALL RSPEAK(238)
C JOKE.
RETURN
C
37100 IF(PRSA.NE.PLUGW) GO TO 10
C PLUG?
IF(PRSI.NE.PUTTY) GO TO 33100
C WITH PUTTY?
CALL NEWSTA(IBOAT,239,OROOM(DBOAT),OCAN(DBOAT),OADV(DBOAT))
CALL NEWSTA(DBOAT,0,0,0,0)
C KILL DEFL BOAT, REPL.
RETURN
C SOBJS, PAGE 10
C
C O24-- RUBBER BOAT
C
38000 IF(ARG.NE.0) GO TO 10
C DISMISS READIN, OUT.
IF((PRSA.NE.BOARDW).OR.(OADV(STICK).NE.WINNER)) GO TO 38100
CALL NEWSTA(RBOAT,0,0,0,0)
C KILL INFL BOAT,
CALL NEWSTA(DBOAT,240,HERE,0,0)
C REPL WITH DEAD.
DEFLAF=.TRUE.
RETURN
C
38100 IF(PRSA.NE.INFLAW) GO TO 38200
C INFLATE?
CALL RSPEAK(367)
C YES, JOKE.
RETURN
C
38200 IF(PRSA.NE.DEFLAW) GO TO 10
C DEFLATE?
IF(AV.EQ.RBOAT) GO TO 38300
C IN BOAT?
IF(OROOM(RBOAT).EQ.0) GO TO 38400
C ON GROUND?
CALL NEWSTA(RBOAT,0,0,0,0)
C KILL INFL BOAT,
CALL NEWSTA(IBOAT,241,HERE,0,0)
C REPL WITH DEFL.
DEFLAF=.TRUE.
RETURN
C
38300 CALL RSPEAK(242)
C IN BOAT.
RETURN
C
38400 CALL RSPEAK(243)
C NOT ON GROUND.
RETURN
C
C O25-- BRAIDED ROPE
C
41000 IF((PRSA.NE.TIEW).OR.(PRSO.NE.BROPE).OR.
1 ((PRSI.NE.HOOK1).AND.(PRSI.NE.HOOK2)))
2 GO TO 41500
C TIE TO HOOK?
BTIEF=PRSI
C RECORD LOCATION.
CFLAG(CEVBAL)=.FALSE.
C STALL ASCENT.
CALL RSPEAK(248)
RETURN
C
41500 IF((PRSA.NE.UNTIEW).OR.(PRSO.NE.BROPE)) GO TO 10
IF(BTIEF.NE.0) GO TO 41600
C TIED UP?
CALL RSPEAK(249)
C NO, JOKE.
RETURN
C
41600 CALL RSPEAK(250)
BTIEF=0
C UNTIE.
CTICK(CEVBAL)=3
C RESTART CLOCK.
CFLAG(CEVBAL)=.TRUE.
RETURN
C
C O26-- SAFE
C
42000 I=0
C ASSUME UNPROCESSED.
IF(PRSA.EQ.TAKEW) I=251
C TAKE?
IF((PRSA.EQ.OPENW).AND.SAFEF) I=253
C OPEN AFTER BLAST?
IF((PRSA.EQ.OPENW).AND..NOT.SAFEF) I=254
C OPEN BEFORE BLAST?
IF((PRSA.EQ.CLOSEW).AND.SAFEF) I=253
C CLOSE AFTER?
IF((PRSA.EQ.CLOSEW).AND..NOT.SAFEF) I=255
IF(I.EQ.0) GO TO 10
CALL RSPEAK(I)
RETURN
C
C O27-- FUSE
C
43000 IF(PRSA.NE.BURNW) GO TO 10
C BURN?
CALL RSPEAK(256)
CTICK(CEVFUS)=2
C START COUNTDOWN.
RETURN
C
C O28-- GNOME
C
44000 IF((PRSA.NE.GIVEW).AND.(PRSA.NE.THROWW)) GO TO 44500
IF(OTVAL(PRSO).EQ.0) GO TO 44100
C TREASURE?
CALL RSPSUB(257,ODO2)
C YES, GET DOOR.
CALL NEWSTA(PRSO,0,0,0,0)
CALL NEWSTA(GNOME,0,0,0,0)
C VANISH GNOME.
GNODRF=.TRUE.
RETURN
C
44100 CALL RSPSUB(258,ODO2)
C NO, LOSE OBJECT.
CALL NEWSTA(PRSO,0,0,0,0)
RETURN
C
44500 CALL RSPEAK(259)
C NERVOUS GNOME.
IF(.NOT.GNOMEF) CTICK(CEVGNO)=5
C SCHEDULE BYEBYE.
GNOMEF=.TRUE.
RETURN
C
C O29-- COKE BOTTLES
C
46000 IF((PRSA.NE.THROWW).AND.(PRSA.NE.MUNGW)) GO TO 10
CALL NEWSTA(PRSO,262,0,0,0)
C MUNG BOTTLES.
RETURN
C SOBJS, PAGE 11
C
C
C O30-- ROBOT
C
53000 IF(PRSA.NE.GIVEW) GO TO 53200
C GIVE?
CALL NEWSTA(PRSO,0,0,0,AROBOT)
C PUT ON ROBOT.
CALL RSPSUB(302,ODO2)
RETURN
C
53200 IF((PRSA.NE.MUNGW).AND.(PRSA.NE.THROWW)) GO TO 10
CALL NEWSTA(ROBOT,285,0,0,0)
C KILL ROBOT.
RETURN
C
C O31-- GRUE
C
56000 IF(PRSA.NE.EXAMIW) GO TO 56100
C EXAMINE?
CALL RSPEAK(288)
RETURN
C
56100 IF(PRSA.NE.FINDW) GO TO 10
C FIND?
CALL RSPEAK(289)
RETURN
C
END