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

