Source to dungeon-2.5.6/dso.f
C PRINCR- PRINT CONTENTS OF ROOM
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 PRINCR(FULL,RM)
IMPLICIT INTEGER (A-Z)
LOGICAL QEMPTY,QHERE,FULL, test
C
C GAME STATE
C
LOGICAL TELFLG
COMMON /PLAY/ WINNER,HERE,TELFLG
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
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 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 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,ENDGMF,FROBZF,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,ENDGMF,FROBZF,BADLKF,THFENF,SINGSF,
6 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF,
7 FOLLWF,SPELLF,CPOUTF,CPUSHF
COMMON /FINDEX/ BTIEF,BINFF
COMMON /FINDEX/ RVMNT,RVCLR,RVCYC,RVGUA,RVSND
COMMON /FINDEX/ ORRUG,ORCAND,ORMTCH,ORLAMP
COMMON /FINDEX/ MDIR,MLOC,POLEUF
COMMON /FINDEX/ QUESNO,NQATT,CORRCT
COMMON /FINDEX/ LCELL,PNUMB,ACELL,DCELL,CPHERE
*
* Added to get full descriptions of egg and canary to print (as
* they it once did).
*
* The SAVE declaration is unneeded in most forms of Fortran,
* because they default to static variables anyway.
*
* "nest" refers to the birds nest, and is a hard-wired fix.
save nest
integer nest
data nest /153/
C PRINCR, PAGE 2
C
J=329
C ASSUME SUPERBRIEF FORMAT.
DO 500 I=1,OLNT
C LOOP ON OBJECTS
IF(.NOT.QHERE(I,RM).OR.(ZAND(OFLAG1(I),(VISIBT+NDSCBT)).NE.
1 VISIBT).OR.(I.EQ.AVEHIC(WINNER))) GO TO 500
IF(.NOT.FULL.AND.(SUPERF.OR.(BRIEFF.AND.
1 (ZAND(RFLAG(HERE),RSEEN).NE.0)))) GO TO 200
C
C DO LONG DESCRIPTION OF OBJECT.
C
K=ODESCO(I)
C GET UNTOUCHED.
IF((K.EQ.0).OR.(ZAND(OFLAG2(I),TCHBT).NE.0)) K=ODESC1(I)
CALL RSPEAK(K)
C DESCRIBE.
GO TO 500
C DO SHORT DESCRIPTION OF OBJECT.
C
200 CALL RSPSUB(J,ODESC2(I))
C YOU CAN SEE IT.
J=502
C
500 CONTINUE
C
C NOW LOOP TO PRINT CONTENTS OF OBJECTS IN ROOM.
C
DO 1000 I=1,OLNT
C LOOP ON OBJECTS.
IF(.NOT.QHERE(I,RM).OR.(ZAND(OFLAG1(I),(VISIBT+NDSCBT)).NE.
1 VISIBT)) GO TO 1000
IF(ZAND(OFLAG2(I),ACTRBT).NE.0) CALL INVENT(OACTOR(I))
IF(((ZAND(OFLAG1(I),TRANBT).EQ.0).AND.(ZAND(OFLAG2(I),OPENBT)
1 .EQ.0)).OR.QEMPTY(I)) GO TO 1000
C
C OBJECT IS NOT EMPTY AND IS OPEN OR TRANSPARENT.
C
* Lower case text reflects "fix" of egg's and canary's long
* description conditions.
* Includes a jump out of a structured IF to prevent a second
* (short) description of these special object's contents.
* Open egg with untouched canary inside?
if (i .eq. egg) then
test = zand(oflag2(canar),tchbt).eq.0 .and. (ocan(canar).eq.egg)
if (test) then
k = odesco(canar)
call rspeak(k)
go to 1000
endif
endif
* Open, broken egg with untouched, broken canary inside?
if (i .eq. begg) then
test = zand(oflag2(bcana),tchbt).eq.0.and. (ocan(bcana).eq.begg)
if (test) then
k = odesco(bcana)
call rspeak(k)
go to 1000
endif
endif
* Nest with untouched egg inside?
if (i .eq. nest) then
test = zand(oflag2(egg),tchbt) .eq. 0 .and. (ocan(egg).eq.nest)
if (test) then
k = odesco(egg)
call rspeak(k)
go to 1000
endif
endif
*
* End of modifications.
*
J=573
IF(I.NE.TCASE) GO TO 600
C TROPHY CASE?
J=574
IF((BRIEFF.OR.SUPERF).AND. .NOT.FULL) GO TO 1000
600 CALL PRINCO(I,J)
C PRINT CONTENTS.
C
1000 CONTINUE
RETURN
C
END
C INVENT- PRINT CONTENTS OF ADVENTURER
C
C DECLARATIONS
C
SUBROUTINE INVENT(ADV)
IMPLICIT INTEGER (A-Z)
LOGICAL QEMPTY
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
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 INVENT, PAGE 2
C
I=575
C FIRST LINE.
IF(ADV.NE.PLAYER) I=576
C IF NOT ME.
DO 10 J=1,OLNT
C LOOP
IF((OADV(J).NE.ADV).OR.(ZAND(OFLAG1(J),VISIBT).EQ.0))
1 GO TO 10
CALL RSPSUB(I,ODESC2(AOBJ(ADV)))
I=0
CALL RSPSUB(502,ODESC2(J))
10 CONTINUE
C
IF(I.EQ.0) GO TO 25
C ANY OBJECTS?
IF(ADV.EQ.PLAYER) CALL RSPEAK(578)
C NO, TELL HIM.
RETURN
C
25 DO 100 J=1,OLNT
C LOOP.
IF((OADV(J).NE.ADV).OR.(ZAND(OFLAG1(J),VISIBT).EQ.0).OR.
1 ((ZAND(OFLAG1(J),TRANBT).EQ.0).AND.
2 (ZAND(OFLAG2(J),OPENBT).EQ.0))) GO TO 100
IF(.NOT.QEMPTY(J)) CALL PRINCO(J,573)
C IF NOT EMPTY, LIST.
100 CONTINUE
RETURN
C
END
C PRINCO- PRINT CONTENTS OF OBJECT
C
C DECLARATIONS
C
SUBROUTINE PRINCO(OBJ,DESC)
IMPLICIT INTEGER(A-Z)
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
CALL RSPSUB(DESC,ODESC2(OBJ))
C PRINT HEADER.
DO 100 I=1,OLNT
C LOOP THRU.
IF(OCAN(I).EQ.OBJ) CALL RSPSUB(502,ODESC2(I))
100 CONTINUE
RETURN
C
END
C MOVETO- MOVE PLAYER TO NEW ROOM
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 MOVETO(NR,WHO)
IMPLICIT INTEGER (A-Z)
LOGICAL NLV,LHR,LNR
C
C GAME STATE
C
LOGICAL TELFLG
COMMON /PLAY/ WINNER,HERE,TELFLG
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 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 /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 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 MOVETO, PAGE 2
C
MOVETO=.FALSE.
C ASSUME FAILS.
LHR=ZAND(RFLAG(HERE),RLAND).NE.0
C LAND HERE FLAG.
LNR=ZAND(RFLAG(NR),RLAND).NE.0
C LAND THERE FLAG.
J=AVEHIC(WHO)
C HIS VEHICLE
C
IF(J.NE.0) GO TO 100
C IN VEHICLE?
IF(LNR) GO TO 500
C NO, GOING TO LAND?
CALL RSPEAK(427)
C CAN'T GO WITHOUT VEHICLE.
RETURN
C
100 BITS=0
C ASSUME NOWHERE.
IF(J.EQ.RBOAT) BITS=RWATER
C IN BOAT?
IF(J.EQ.BALLO) BITS=RAIR
C IN BALLOON?
IF(J.EQ.BUCKE) BITS=RBUCK
C IN BUCKET?
NLV=ZAND(RFLAG(NR),BITS).EQ.0
C GOT WRONG VEHICLE FLAG.
IF((.NOT.LNR .AND.NLV) .OR.
1 (LNR.AND.LHR.AND.NLV.AND.(BITS.NE.RLAND)))
2 GO TO 800
C GOT WRONG VEHICLE?
C
500 MOVETO=.TRUE.
C MOVE SHOULD SUCCEED.
IF(ZAND(RFLAG(NR),RMUNG).EQ.0) GO TO 600
C ROOM MUNGED?
CALL RSPEAK(RVAL(NR))
C YES, TELL HOW.
RETURN
C
600 IF(WHO.NE.PLAYER) CALL NEWSTA(AOBJ(WHO),0,NR,0,0)
IF(J.NE.0) CALL NEWSTA(J,0,NR,0,0)
HERE=NR
AROOM(WHO)=HERE
CALL SCRUPD(RVAL(NR))
C SCORE ROOM
RVAL(NR)=0
RETURN
C
800 CALL RSPSUB(428,ODESC2(J))
C WRONG VEHICLE.
RETURN
END
C SCORE-- PRINT OUT CURRENT SCORE
C
C DECLARATIONS
C
SUBROUTINE SCORE(FLG)
IMPLICIT INTEGER (A-Z)
LOGICAL FLG
INTEGER RANK(10),ERANK(5)
C
C GAME STATE
C
LOGICAL TELFLG
CHARACTER*2 MMOVE
COMMON /PLAY/ WINNER,HERE,TELFLG
COMMON /STATE/ MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD,
1 LTSHFT,BLOC,MUNGRM,HS,EGSCOR,EGMXSC
C
COMMON /CHAN/ INPCH,OUTCH,DBCH,ZRECL
C
C ADVENTURERS
C
COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4),
1 AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4)
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
DATA RANK/20,19,18,16,12,8,4,2,1,0/
DATA ERANK/20,15,10,5,0/
C SCORE, PAGE 2
C
IF(FLG)AS=0
C STATEMENT ABOVE IS A DUMMY
MMOVE = '. '
IF(MOVES.NE.1)MMOVE = 's.'
AS=ASCORE(WINNER)
IF(ENDGMF) GO TO 60
C ENDGAME?
WRITE(OUTCH,120) AS,MXSCOR,MOVES,MMOVE
DO 10 I=1,10
IF((AS*20/MXSCOR).GE.RANK(I)) GO TO 50
10 CONTINUE
50 CALL RSPEAK(484+I)
RETURN
C
60 WRITE(OUTCH,130) EGSCOR,EGMXSC,MOVES,MMOVE
DO 70 I=1,5
IF((EGSCOR*20/EGMXSC).GE.ERANK(I)) GO TO 80
70 CONTINUE
80 CALL RSPEAK(786+I)
RETURN
C
120 FORMAT(' Your score is',I4,' [total of',I4,' points], in'
1 ,I5,' move',A2)
130 FORMAT(' Your score in the endgame is',I4,' [total of',I4,
1 ' points], in',I5,' move',A2)
C
END
C SCRUPD- UPDATE WINNER'S SCORE
C
C DECLARATIONS
C
SUBROUTINE SCRUPD(N)
IMPLICIT INTEGER (A-Z)
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 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 ADVENTURERS
C
COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4),
1 AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4)
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
IF(ENDGMF) GO TO 100
C ENDGAME?
ASCORE(WINNER)=ASCORE(WINNER)+N
C UPDATE SCORE
RWSCOR=RWSCOR+N
C UPDATE RAW SCORE
IF(ASCORE(WINNER).LT.(MXSCOR-(10*DEATHS))) RETURN
CFLAG(CEVEGH)=.TRUE.
C TURN ON END GAME
CTICK(CEVEGH)=15
RETURN
C
100 EGSCOR=EGSCOR+N
C UPDATE EG SCORE.
RETURN
END
C FINDXT- FIND EXIT FROM ROOM
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 FINDXT(DIR,RM)
IMPLICIT INTEGER (A-Z)
C
C ROOMS
C
COMMON /ROOMS/ RLNT,RDESC2,RDESC1(200),REXIT(200),
1 RACTIO(200),RVAL(200),RFLAG(200)
C
C EXITS
C
COMMON /EXITS/ XLNT,TRAVEL(900)
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
FINDXT=.TRUE.
C ASSUME WINS.
XI=REXIT(RM)
C FIND FIRST ENTRY.
IF(XI.EQ.0) GO TO 1000
C NO EXITS?
C
100 I=TRAVEL(XI)
C GET ENTRY.
XROOM1=ZAND(I,XRMASK)
C ISOLATE ROOM.
XTYPE=ZAND((ZAND(I,ZNOT(XLFLAG))/XFSHFT),XFMASK)+1
GO TO (110,120,130,130),XTYPE
C BRANCH ON ENTRY.
CALL BUG(10,XTYPE)
C
130 XOBJ=ZAND(TRAVEL(XI+2),XRMASK)
C DOOR/CEXIT- GET OBJ/FLAG.
XACTIO=TRAVEL(XI+2)/XASHFT
120 XSTRNG=TRAVEL(XI+1)
C DOOR/CEXIT/NEXIT - STRING.
110 XI=XI+XELNT(XTYPE)
C ADVANCE TO NEXT ENTRY.
IF(ZAND(I,XDMASK).EQ.DIR) RETURN
C MATCH?
IF(ZAND(I,XLFLAG).EQ.0) GO TO 100
C LAST ENTRY?
1000 FINDXT=.FALSE.
C YES, LOSE.
RETURN
END
C FWIM- FIND WHAT I MEAN
C
C DECLARATIONS
C
INTEGER FUNCTION FWIM(F1,F2,RM,CON,ADV,NOCARE)
IMPLICIT INTEGER (A-Z)
LOGICAL NOCARE
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
FWIM=0
C ASSUME NOTHING.
DO 1000 I=1,OLNT
C LOOP
IF(((RM.EQ.0).OR.(OROOM(I).NE.RM)) .AND.
1 ((ADV.EQ.0).OR.(OADV(I).NE.ADV)) .AND.
2 ((CON.EQ.0).OR.(OCAN(I).NE.CON)))
3 GO TO 1000
C
C OBJECT IS ON LIST... IS IT A MATCH?
C
IF(ZAND(OFLAG1(I),VISIBT).EQ.0) GO TO 1000
IF((.NOT.NOCARE .AND.(ZAND(OFLAG1(I),TAKEBT).EQ.0)) .OR.
1 ((ZAND(OFLAG1(I),F1).EQ.0).AND.
2 (ZAND(OFLAG2(I),F2).EQ.0))) GO TO 500
IF(FWIM.EQ.0) GO TO 400
C ALREADY GOT SOMETHING?
FWIM=-FWIM
C YES, AMBIGUOUS.
RETURN
C
400 FWIM=I
C NOTE MATCH.
C
C DOES OBJECT CONTAIN A MATCH?
C
500 IF(ZAND(OFLAG2(I),OPENBT).EQ.0) GO TO 1000
C CLOSED?
DO 700 J=1,OLNT
C NO, SEARCH CONTENTS.
IF((OCAN(J).NE.I).OR.(ZAND(OFLAG1(J),VISIBT).EQ.0) .OR.
1 ((ZAND(OFLAG1(J),F1).EQ.0).AND.
2 (ZAND(OFLAG2(J),F2).EQ.0))) GO TO 700
IF(FWIM.EQ.0) GO TO 600
FWIM=-FWIM
RETURN
C
600 FWIM=J
700 CONTINUE
1000 CONTINUE
RETURN
END
C YESNO- OBTAIN YES/NO ANSWER
C
C CALLED BY-
C
C YES-IS-TRUE=YESNO(QUESTION,YES-STRING,NO-STRING)
C
LOGICAL FUNCTION YESNO(Q,Y,N)
IMPLICIT INTEGER(A-Z)
COMMON /CHAN/ INPCH,OUTCH,DBCH,ZRECL
CHARACTER ANS
C
100 CALL RSPEAK(Q)
C ASK
READ(INPCH,110) ANS
C GET ANSWER
110 FORMAT(A1)
IF((ANS.EQ.'Y').OR.(ANS.EQ.'y')) GO TO 200
IF((ANS.EQ.'N').OR.(ANS.EQ.'n')) GO TO 300
CALL RSPEAK(6)
C SCOLD.
GO TO 100
C
200 YESNO=.TRUE.
C YES,
CALL RSPEAK(Y)
C OUT WITH IT.
RETURN
C
300 YESNO=.FALSE.
C NO,
CALL RSPEAK(N)
C LIKEWISE.
RETURN
C
END
C ROBADV-- STEAL WINNER'S VALUABLES
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
INTEGER FUNCTION ROBADV(ADV,NR,NC,NA)
IMPLICIT INTEGER (A-Z)
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
ROBADV=0
C COUNT OBJECTS
DO 100 I=1,OLNT
IF((OADV(I).NE.ADV).OR.(OTVAL(I).LE.0).OR.
1 (ZAND(OFLAG2(I),SCRDBT).NE.0)) GO TO 100
CALL NEWSTA(I,0,NR,NC,NA)
C STEAL OBJECT
ROBADV=ROBADV+1
100 CONTINUE
RETURN
END
C ROBRM-- STEAL ROOM VALUABLES
C
C DECLARATIONS
C
INTEGER FUNCTION ROBRM(RM,PR,NR,NC,NA)
IMPLICIT INTEGER (A-Z)
LOGICAL PROB,QHERE
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
ROBRM=0
C COUNT OBJECTS
DO 100 I=1,OLNT
C LOOP ON OBJECTS.
IF(.NOT. QHERE(I,RM)) GO TO 100
IF((OTVAL(I).LE.0).OR.(ZAND(OFLAG2(I),SCRDBT).NE.0).OR.
1 (ZAND(OFLAG1(I),VISIBT).EQ.0).OR.(.NOT.PROB(PR,PR)))
2 GO TO 50
CALL NEWSTA(I,0,NR,NC,NA)
ROBRM=ROBRM+1
OFLAG2(I)=ZOR(OFLAG2(I),TCHBT)
GO TO 100
50 IF(ZAND(OFLAG2(I),ACTRBT).NE.0)
1 ROBRM=ROBRM+ROBADV(OACTOR(I),NR,NC,NA)
100 CONTINUE
RETURN
END
C WINNIN-- SEE IF VILLAIN IS WINNING
C
C DECLARATIONS
C
LOGICAL FUNCTION WINNIN(VL,HR)
IMPLICIT INTEGER (A-Z)
LOGICAL PROB
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
VS=OCAPAC(VL)
C VILLAIN STRENGTH
PS=VS-FIGHTS(HR,.TRUE.)
C HIS MARGIN OVER HERO
WINNIN=PROB(90,100)
IF(PS.GT.3) RETURN
C +3... 90% WINNING
WINNIN=PROB(75,85)
IF(PS.GT.0) RETURN
C >0... 75% WINNING
WINNIN=PROB(50,30)
IF(PS.EQ.0) RETURN
C =0... 50% WINNING
WINNIN=PROB(25,25)
IF(VS.GT.1) RETURN
C ANY VILLAIN STRENGTH.
WINNIN=PROB(10,0)
RETURN
END
C FIGHTS-- COMPUTE FIGHT STRENGTH
C
C DECLARATIONS
C
INTEGER FUNCTION FIGHTS(H,FLG)
IMPLICIT INTEGER (A-Z)
LOGICAL FLG
C
C GAME STATE
C
COMMON /STATE/ MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD,
1 LTSHFT,BLOC,MUNGRM,HS,EGSCOR,EGMXSC
C
C ADVENTURERS
C
COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4),
1 AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4)
C
C FUNCTIONS AND DATA
C
DATA SMAX/7/,SMIN/2/
C
FIGHTS=SMIN+((((SMAX-SMIN)*ASCORE(H))+(MXSCOR/2))/MXSCOR)
IF(FLG) FIGHTS=FIGHTS+ASTREN(H)
RETURN
END
C VILSTR- COMPUTE VILLAIN STRENGTH
C
C DECLARATIONS
C
INTEGER FUNCTION VILSTR(V)
IMPLICIT INTEGER (A-Z)
C
C PARSER OUTPUT
C
LOGICAL PRSWON
COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON
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
COMMON /VILL/ VLNT,VILLNS(4),VPROB(4),VOPPS(4),VBEST(4),VMELEE(4)
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 VILSTR, PAGE 2
C
VILSTR=OCAPAC(V)
IF(VILSTR.LE.0) RETURN
IF((V.NE.THIEF).OR..NOT.THFENF) GO TO 100
THFENF=.FALSE.
C THIEF UNENGROSSED.
VILSTR=MIN0(VILSTR,2)
C NO BETTER THAN 2.
C
100 DO 200 I=1,VLNT
C SEE IF BEST WEAPON.
IF((VILLNS(I).EQ.V).AND.(PRSI.EQ.VBEST(I)))
1 VILSTR=MAX0(1,VILSTR-1)
200 CONTINUE
RETURN
END
C GTTIME-- GET TOTAL TIME PLAYED
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 GTTIME(T)
IMPLICIT INTEGER(A-Z)
C
COMMON /TIME/ PLTIME,SHOUR,SMIN,SSEC
C
CALL ITIME(H,M,S)
T=((H*60)+M)-((SHOUR*60)+SMIN)
IF(T.LT.0) T=T+1440
T=T+PLTIME
RETURN
END
C OPNCLS-- PROCESS OPEN/CLOSE FOR DOORS
C
C DECLARATIONS
C
LOGICAL FUNCTION OPNCLS(OBJ,SO,SC)
IMPLICIT INTEGER (A-Z)
LOGICAL QOPEN
C
C PARSER OUTPUT
C
LOGICAL PRSWON
COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON
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
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 FUNCTIONS AND DATA
C
QOPEN(O)=ZAND(OFLAG2(O),OPENBT).NE.0
C
OPNCLS=.TRUE.
C ASSUME WINS.
IF(PRSA.EQ.CLOSEW) GO TO 100
C CLOSE?
IF(PRSA.EQ.OPENW) GO TO 50
C OPEN?
OPNCLS=.FALSE.
C LOSE
RETURN
C
50 IF(QOPEN(OBJ)) GO TO 200
C OPEN... IS IT?
CALL RSPEAK(SO)
OFLAG2(OBJ)=ZOR(OFLAG2(OBJ),OPENBT)
RETURN
C
100 IF(.NOT.QOPEN(OBJ)) GO TO 200
C CLOSE... IS IT?
CALL RSPEAK(SC)
OFLAG2(OBJ)=ZAND(OFLAG2(OBJ),ZNOT(OPENBT))
RETURN
C
200 CALL RSPEAK(125+ZRND(3))
C DUMMY.
RETURN
END
C LIT-- IS ROOM LIT?
C
C DECLARATIONS
C
LOGICAL FUNCTION LIT(RM)
IMPLICIT INTEGER (A-Z)
LOGICAL QHERE
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 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
C ADVENTURERS
C
COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4),
1 AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4)
C
LIT=.TRUE.
C ASSUME WINS
IF(ZAND(RFLAG(RM),RLIGHT).NE.0) RETURN
C ROOM LIT?
C
DO 1000 I=1,OLNT
C LOOK FOR LIT OBJ
IF(QHERE(I,RM)) GO TO 100
C IN ROOM?
OA=OADV(I)
C NO
IF(OA.LE.0) GO TO 1000
C ON ADV?
IF(AROOM(OA).NE.RM) GO TO 1000
C ADV IN ROOM?
C
C OBJ IN ROOM OR ON ADV IN ROOM
C
100 IF(ZAND(OFLAG1(I),ONBT).NE.0) RETURN
C LIT?
IF((ZAND(OFLAG1(I),VISIBT).EQ.0).OR.
1 ((ZAND(OFLAG1(I),TRANBT).EQ.0).AND.
2 (ZAND(OFLAG2(I),OPENBT).EQ.0))) GO TO 1000
C
C OBJ IS VISIBLE AND OPEN OR TRANSPARENT
C
DO 500 J=1,OLNT
IF((OCAN(J).EQ.I).AND.(ZAND(OFLAG1(J),ONBT).NE.0))
1 RETURN
500 CONTINUE
1000 CONTINUE
LIT=.FALSE.
RETURN
END
C WEIGHT- RETURNS SUM OF WEIGHT OF QUALIFYING OBJECTS
C
C DECLARATIONS
C
INTEGER FUNCTION WEIGHT(RM,CN,AD)
IMPLICIT INTEGER (A-Z)
LOGICAL QHERE
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
WEIGHT=0
DO 100 I=1,OLNT
C OMIT BIG FIXED ITEMS.
IF(OSIZE(I).GE.10000) GO TO 100
C IF FIXED, FORGET IT.
IF((QHERE(I,RM).AND.(RM.NE.0)).OR.
1 ((OADV(I).EQ.AD).AND.(AD.NE.0))) GO TO 50
J=I
C SEE IF CONTAINED.
25 J=OCAN(J)
C GET NEXT LEVEL UP.
IF(J.EQ.0) GO TO 100
C END OF LIST?
IF(J.NE.CN) GO TO 25
50 WEIGHT=WEIGHT+OSIZE(I)
100 CONTINUE
RETURN
END
C GHERE-- IS GLOBAL ACTUALLY IN THIS ROOM?
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 GHERE(OBJ,RM)
IMPLICIT INTEGER(A-Z)
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
COMMON /STAR/ MBASE,STRBIT
C GHERE, PAGE 2
C
GHERE=.TRUE.
C ASSUME WINS.
GO TO (1000,1000,1000,1000,1000,1000,
1 1000,1000,1000,1000,1000,
2 2000,3000,4000,5000,5000,5000,6000,
3 7000,8000,9000,9100,8000,10000,11000),OBJ-STRBIT
CALL BUG(60,OBJ)
C
C 1000-- STARS ARE ALWAYS HERE
C
1000 RETURN
C
C 2000-- BIRD
C
2000 GHERE=((RM.GE.FORE1).AND.(RM.LT.CLEAR)).OR.(RM.EQ.MTREE)
RETURN
C
C 3000-- TREE
C
3000 GHERE=((RM.GE.FORE1).AND.(RM.LT.CLEAR)).AND.(RM.NE.FORE3)
RETURN
C
C 4000-- NORTH WALL
C
4000 GHERE=((RM.GE.BKVW).AND.(RM.LE.BKBOX)).OR.(RM.EQ.CPUZZ)
RETURN
C
C 5000-- EAST, SOUTH, WEST WALLS
C
5000 GHERE=((RM.GE.BKVW).AND.(RM.LT.BKBOX)).OR.(RM.EQ.CPUZZ)
RETURN
C
C 6000-- GLOBAL WATER
C
6000 GHERE=ZAND(RFLAG(RM),(RWATER+RFILL)).NE.0
RETURN
C
C 7000-- GLOBAL GUARDIANS
C
7000 GHERE=((RM.GE.MRC).AND.(RM.LE.MRD)).OR.
1 ((RM.GE.MRCE).AND.(RM.LE.MRDW)).OR.(RM.EQ.INMIR)
RETURN
C
C 8000-- ROSE/CHANNEL
C
8000 GHERE=((RM.GE.MRA).AND.(RM.LE.MRD)).OR.(RM.EQ.INMIR)
RETURN
C
C 9000-- MIRROR
C 9100 PANEL
C
9100 IF(RM.EQ.FDOOR) RETURN
C PANEL AT FDOOR.
9000 GHERE=((RM.GE.MRA).AND.(RM.LE.MRC)).OR.
1 ((RM.GE.MRAE).AND.(RM.LE.MRCW))
RETURN
C
C 10000-- MASTER
C
10000 GHERE=(RM.EQ.FDOOR).OR.(RM.EQ.NCORR).OR.(RM.EQ.PARAP).OR.
1 (RM.EQ.CELL)
RETURN
C
C 11000-- LADDER
C
11000 GHERE=(RM.EQ.CPUZZ)
RETURN
C
END
C MRHERE-- IS MIRROR HERE?
C
C DECLARATIONS
C
INTEGER FUNCTION MRHERE(RM)
IMPLICIT INTEGER(A-Z)
C
C ROOMS
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 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 MRHERE, PAGE 2
C
IF((RM.LT.MRAE).OR.(RM.GT.MRDW)) GO TO 100
C
C RM IS AN E-W ROOM, MIRROR MUST BE N-S (MDIR= 0 OR 180)
C
MRHERE=1
C ASSUME MIRROR 1 HERE.
IF(MOD(RM-MRAE,2).EQ.(MDIR/180)) MRHERE=2
RETURN
C
C RM IS NORTH OR SOUTH OF MIRROR. IF MIRROR IS N-S OR NOT
C WITHIN ONE ROOM OF RM, LOSE.
C
100 MRHERE=0
IF((IABS(MLOC-RM).NE.1).OR.(MOD(MDIR,180).EQ.0)) RETURN
C
C RM IS WITHIN ONE OF MLOC, AND MDIR IS E-W
C
MRHERE=1
IF(((RM.LT.MLOC).AND.(MDIR.LT.180)).OR.
1 ((RM.GT.MLOC).AND.(MDIR.GT.180))) MRHERE=2
RETURN
END
C ENCRYP-- ENCRYPT PASSWORD
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 ENCRYP(INW,OUTW)
IMPLICIT INTEGER(A-Z)
CHARACTER INW(6),OUTW(6),KEYW(6)
CHARACTER UINW(6),UKEYW(6)
DATA KEYW/'E','C','O','R','M','S'/
C
UINWS=0
C UNBIASED INW SUM.
UKEYWS=0
C UNBIASED KEYW SUM.
J=1
C POINTER IN KEYWORD.
DO 100 I=1,6
C UNBIAS, COMPUTE SUMS.
UKEYW(I)=CHAR(ICHAR(KEYW(I))-64)
C STRIP ASCII.
IF(ICHAR(INW(J)).LE.64) J=1
C RECYCLE ON BAD.
UINW(I)=CHAR(ICHAR(INW(J))-64)
UKEYWS=UKEYWS+ICHAR(UKEYW(I))
UINWS=UINWS+ICHAR(UINW(I))
J=J+1
100 CONTINUE
C
USUM=MOD(UINWS,8)+(8*MOD(UKEYWS,8))
C COMPUTE MASK.
DO 200 I=1,6
J=ZAND( ZXOR(ZXOR(ICHAR(UINW(I)),ICHAR(UKEYW(I))),USUM) ,31)
USUM=MOD(USUM+1,32)
IF(J.GT.26) J=MOD(J,26)
OUTW(I)=CHAR(MAX0(1,J)+64)
200 CONTINUE
RETURN
C
END
C CPGOTO-- MOVE TO NEXT STATE IN PUZZLE ROOM
C
C DECLARATIONS
C
SUBROUTINE CPGOTO(ST)
IMPLICIT INTEGER(A-Z)
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
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 CPGOTO, PAGE 2
C
RFLAG(CPUZZ)=ZAND(RFLAG(CPUZZ),ZNOT(RSEEN))
DO 100 I=1,OLNT
C RELOCATE OBJECTS.
IF((OROOM(I).EQ.CPUZZ).AND.
1 (ZAND(OFLAG2(I),(ACTRBT+VILLBT)).EQ.0))
2 CALL NEWSTA(I,0,CPHERE*HFACTR,0,0)
IF(OROOM(I).EQ.(ST*HFACTR))
1 CALL NEWSTA(I,0,CPUZZ,0,0)
100 CONTINUE
CPHERE=ST
RETURN
C
END
C CPINFO-- DESCRIBE PUZZLE ROOM
C
C DECLARATIONS
C
SUBROUTINE CPINFO(RMK,ST)
IMPLICIT INTEGER(A-Z)
INTEGER DGMOFT(8)
CHARACTER*2 DGM(8),PICT(5),QMK
C
COMMON /CHAN/ INPCH,OUTCH,DBCH,ZRECL
C
C PUZZLE ROOM
C
COMMON /PUZZLE/ CPDR(16),CPWL(8),CPVEC(64)
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 LOCAL DATA
C
DATA DGMOFT/-9,-8,-7,-1,1,7,8,9/
DATA PICT/'SS','SS','SS',' ','MM'/
DATA QMK/'??'/
C CPINFO, PAGE 2
C
CALL RSPEAK(RMK)
DO 100 I=1,8
J=DGMOFT(I)
DGM(I)=PICT(CPVEC(ST+J)+4)
C GET PICTURE ELEMENT.
IF((IABS(J).EQ.1).OR.(IABS(J).EQ.8)) GO TO 100
K=8
IF(J.LT.0) K=-8
C GET ORTHO DIR.
L=J-K
IF((CPVEC(ST+K).NE.0).AND.(CPVEC(ST+L).NE.0))
1 DGM(I)=QMK
100 CONTINUE
WRITE(OUTCH,10) DGM
C
IF(ST.EQ.10) CALL RSPEAK(870)
C AT HOLE?
IF(ST.EQ.37) CALL RSPEAK(871)
C AT NICHE?
I=872
C DOOR OPEN?
IF(CPOUTF) I=873
IF(ST.EQ.52) CALL RSPEAK(I)
C AT DOOR?
IF(CPVEC(ST+1).EQ.-2) CALL RSPEAK(874)
C EAST LADDER?
IF(CPVEC(ST-1).EQ.-3) CALL RSPEAK(875)
C WEST LADDER?
RETURN
C
10 FORMAT(' |',A2,1X,A2,1X,A2,'|'/,
1 ' West |',A2,' .. ',A2,'| East',/
2' |',A2,1X,A2,1X,A2,'|')
C
END