C RESIDENT SUBROUTINES FOR DUNGEON
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 RSPEAK-- OUTPUT RANDOM MESSAGE ROUTINE
C
C CALLED BY--
C
C       CALL RSPEAK(MSGNUM)
C
       SUBROUTINE RSPEAK(N)
       IMPLICIT INTEGER(A-Z)
C
       CALL RSPSB2(N,0,0)
       RETURN
       END
C RSPSUB-- OUTPUT RANDOM MESSAGE WITH SUBSTITUTABLE ARGUMENT
C
C CALLED BY--
C
C       CALL RSPSUB(MSGNUM,SUBNUM)
C
       SUBROUTINE RSPSUB(N,S1)
       IMPLICIT INTEGER(A-Z)
C
       CALL RSPSB2(N,S1,0)
       RETURN
       END
C RSPSB2-- OUTPUT RANDOM MESSAGE WITH SUBSTITUTABLE ARGUMENTS
C
C CALLED BY--
C
C       CALL RSPSB2(MSGNUM,S1,S2)
C
       SUBROUTINE RSPSB2(A,B,C)
       IMPLICIT INTEGER(A-Z)
       CHARACTER B1(74),B2(74)
C
C DECLARATIONS
C
       LOGICAL TELFLG
       COMMON /PLAY/ WINNER,HERE,TELFLG
C
       COMMON /RMSG/ MLNT,RTEXT(1050)
       COMMON /CHAN/ INPCH,OUTCH,DBCH,ZRECL
C
C CONVERT ALL ARGUMENTS FROM DICTIONARY NUMBERS (IF POSITIVE)
C TO ABSOLUTE RECORD NUMBERS.
C
       X=A
C SET UP WORK VARIABLES.
       Y=B
       Z=C
       IF(X.GT.0) X=RTEXT(X)
C IF >0, LOOK UP IN RTEXT.
       IF(Y.GT.0) Y=RTEXT(Y)
       IF(Z.GT.0) Z=RTEXT(Z)
       X=IABS(X)
C TAKE ABS VALUE.
       Y=IABS(Y)
       Z=IABS(Z)
       IF(X.EQ.0) RETURN
C ANYTHING TO DO?
       TELFLG=.TRUE.
C SAID SOMETHING.
C
       READ(DBCH,REC=X) OLDREC,B1
C READ FIRST LINE.
100       DO 150 I=1,74
c         X1=ZAND(X,31)+I
        b1(i)=char( zxor(ichar(b1(i)),10) )
CJDM????????         B1(I)=CHAR(ZXOR(ICHAR(B1(I)),X1))
150       CONTINUE
C
200       IF(Y.EQ.0) GO TO 400
C ANY SUBSTITUTABLE?
       DO 300 I=1,74
C YES, LOOK FOR #.
         IF(B1(I).EQ.'#') GO TO 1000
300       CONTINUE
C
400       DO 500 I=74,1,-1
C BACKSCAN FOR BLANKS.
         IF(B1(I).NE.' ') GO TO 600
500       CONTINUE
C
600       WRITE(OUTCH,650) (B1(J),J=1,I)
C OUTPUT LINE.
650       FORMAT(1X,74A1)
       X=X+1
C ON TO NEXT RECORD.
       READ(DBCH,REC=X) NEWREC,B1
C READ NEXT RECORD.
       IF(OLDREC.EQ.NEWREC) GO TO 100
C CONTINUATION?
       RETURN
C NO, EXIT.
C
C SUBSTITUTION WITH SUBSTITUTABLE AVAILABLE.
C I IS INDEX OF # IN B1.
C Y IS NUMBER OF RECORD TO SUBSTITUTE.
C
C PROCEDURE:
C   1) COPY REST OF B1 TO B2
C   2) READ SUBSTITUTABLE OVER B1
C   3) RESTORE TAIL OF ORIGINAL B1
C
C THE IMPLICIT ASSUMPTION HERE IS THAT THE SUBSTITUTABLE STRING
C IS VERY SHORT.
C
1000       K2=1
C TO
       DO 1100 K1=I+1,74
C COPY REST OF B1.
         B2(K2)=B1(K1)
         K2=K2+1
1100       CONTINUE
C
       READ(DBCH,REC=Y) J,(B1(K1),K1=I,74)
C READ SUB RECORD.
       DO 1150 K1=I,74
        b1(k1)=char( zxor(ichar(b1(k1)),10) )
c         X1=ZAND(Y,31)+K1-I+1
CJDM?????????????         B1(K1)=CHAR(ZXOR(ICHAR(B1(K1)),X1))
1150       CONTINUE
C
       DO 1200 J=74,1,-1
C ELIM TRAILING BLANKS.
         IF(B1(J).NE.' ') GO TO 1300
1200       CONTINUE
C
1300       K1=1
C FROM
       DO 1400 K2=J+1,74
C COPY REST OF B1 BACK.
         B1(K2)=B2(K1)
         K1=K1+1
1400       CONTINUE
C
       Y=Z
C SET UP FOR NEXT
       Z=0
C SUBSTITUTION AND
       GO TO 200
C RECHECK LINE.
C
       END
C OBJACT-- APPLY OBJECTS FROM PARSE VECTOR
C
C DECLARATIONS
C
       LOGICAL FUNCTION OBJACT()
       IMPLICIT INTEGER (A-Z)
       LOGICAL OAPPLI
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
       OBJACT=.TRUE.
C ASSUME WINS.
       IF(PRSI.EQ.0) GO TO 100
C IND OBJECT?
       IF(OAPPLI(OACTIO(PRSI),0)) RETURN
C YES, LET IT HANDLE.
C
100       IF(PRSO.EQ.0) GO TO 200
C DIR OBJECT?
       IF(OAPPLI(OACTIO(PRSO),0)) RETURN
C YES, LET IT HANDLE.
C
200       OBJACT=.FALSE.
C LOSES.
       RETURN
       END
C BUG-- REPORT FATAL SYSTEM ERROR
C
C CALLED BY--
C
C       CALL BUG(NO,PAR)
C
       SUBROUTINE BUG(A,B)
       IMPLICIT INTEGER(A-Z)
C
       COMMON /DEBUG/ DBGFLG,PRSFLG,GDTFLG
C
       WRITE(*, 100)A,B
       IF(DBGFLG.NE.0) RETURN
       CALL EXIT
C
100       FORMAT(' PROGRAM ERROR ',I2,', PARAMETER=',I6)
       END
C NEWSTA-- SET NEW STATUS FOR OBJECT
C
C CALLED BY--
C
C       CALL NEWSTA(OBJECT,STRING,NEWROOM,NEWCON,NEWADV)
C
       SUBROUTINE NEWSTA(O,R,RM,CN,AD)
       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 RSPEAK(R)
       OROOM(O)=RM
       OCAN(O)=CN
       OADV(O)=AD
       RETURN
       END
C QHERE-- TEST FOR OBJECT IN ROOM
C
C DECLARATIONS
C
       LOGICAL FUNCTION QHERE(OBJ,RM)
       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 /OROOM2/ R2LNT,O2(20),R2(20)
C
       QHERE=.TRUE.
       IF(OROOM(OBJ).EQ.RM) RETURN
C IN ROOM?
       DO 100 I=1,R2LNT
C NO, SCH ROOM2.
         IF((O2(I).EQ.OBJ).AND.(R2(I).EQ.RM)) RETURN
100       CONTINUE
       QHERE=.FALSE.
C NOT PRESENT.
       RETURN
       END
C QEMPTY-- TEST FOR OBJECT EMPTY
C
C DECLARATIONS
C
       LOGICAL FUNCTION QEMPTY(OBJ)
       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
       QEMPTY=.FALSE.
C ASSUME LOSE.
       DO 100 I=1,OLNT
         IF(OCAN(I).EQ.OBJ) RETURN
C INSIDE TARGET?
100       CONTINUE
       QEMPTY=.TRUE.
       RETURN
       END
C JIGSUP- YOU ARE DEAD
C
C DECLARATIONS
C
       SUBROUTINE JIGSUP(DESC)
       IMPLICIT INTEGER (A-Z)
       LOGICAL YESNO,MOVETO,QHERE,F
       INTEGER RLIST(9)
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
       COMMON /CHAN/ INPCH,OUTCH,DBCH,ZRECL
       COMMON /DEBUG/ DBGFLG,PRSFLG,GDTFLG
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 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,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 RLIST/8,6,36,35,34,4,34,6,5/
C JIGSUP, PAGE 2
C
       CALL RSPEAK(DESC)
C DESCRIBE SAD STATE.
       PRSCON=1
C STOP PARSER.
       IF(DBGFLG.NE.0) RETURN
C IF DBG, EXIT.
       AVEHIC(WINNER)=0
C GET RID OF VEHICLE.
       IF(WINNER.EQ.PLAYER) GO TO 100
C HIMSELF?
       CALL RSPSUB(432,ODESC2(AOBJ(WINNER)))
C NO, SAY WHO DIED.
       CALL NEWSTA(AOBJ(WINNER),0,0,0,0)
C SEND TO HYPER SPACE.
       RETURN
C
100       IF(ENDGMF) GO TO 900
C NO RECOVERY IN END GAME.
       IF(DEATHS.GE.2) GO TO 1000
C DEAD TWICE? KICK HIM OFF.
       IF(.NOT.YESNO(10,9,8)) GO TO 1100
C CONTINUE?
C
       DO 50 J=1,OLNT
C TURN OFF FIGHTING.
         IF(QHERE(J,HERE)) OFLAG2(J)=ZAND(OFLAG2(J),ZNOT(FITEBT))
50       CONTINUE
C
       DEATHS=DEATHS+1
       CALL SCRUPD(-10)
C CHARGE TEN POINTS.
       F=MOVETO(FORE1,WINNER)
C REPOSITION HIM.
       EGYPTF=.TRUE.
C RESTORE COFFIN.
       IF(OADV(COFFI).EQ.WINNER) CALL NEWSTA(COFFI,0,EGYPT,0,0)
       OFLAG2(DOOR)=ZAND(OFLAG2(DOOR), ZNOT(TCHBT)) 
C RESTORE DOOR.
       OFLAG1(ROBOT)=ZAND(ZOR(OFLAG1(ROBOT),VISIBT), ZNOT(NDSCBT))
       IF((OROOM(LAMP).NE.0).OR.(OADV(LAMP).EQ.WINNER))
     1       CALL NEWSTA(LAMP,0,LROOM,0,0)
C RESTORE LAMP.
C
C NOW REDISTRIBUTE HIS VALUABLES AND OTHER BELONGINGS.
C
C THE LAMP HAS BEEN PLACED IN THE LIVING ROOM.
C THE FIRST 8 NON-VALUABLES ARE PLACED IN LOCATIONS AROUND THE HOUSE.
C HIS VALUABLES ARE PLACED AT THE END OF THE MAZE.
C REMAINING NON-VALUABLES ARE PLACED AT THE END OF THE MAZE.
C
       I=1
       DO 200 J=1,OLNT
C LOOP THRU OBJECTS.
         IF((OADV(J).NE.WINNER).OR.(OTVAL(J).NE.0))
     1       GO TO 200
C GET HIS NON-VAL OBJS.
         I=I+1
         IF(I.GT.9) GO TO 400
C MOVE TO RANDOM LOCATIONS.
         CALL NEWSTA(J,0,RLIST(I),0,0)
200       CONTINUE
C
400       I=RLNT+1
C NOW MOVE VALUABLES.
       NONOFL=RAIR+RWATER+RSACRD+REND
C DONT MOVE HERE.
       DO 300 J=1,OLNT
         IF((OADV(J).NE.WINNER).OR.(OTVAL(J).EQ.0))
     1       GO TO 300
C ON ADV AND VALUABLE?
250         I=I-1
C FIND NEXT ROOM.
         IF(ZAND(RFLAG(I),NONOFL).NE.0) GO TO 250
C SKIP IF NONO.
         CALL NEWSTA(J,0,I,0,0)
C YES, MOVE.
300       CONTINUE
C
       DO 500 J=1,OLNT
C NOW GET RID OF REMAINDER.
         IF(OADV(J).NE.WINNER) GO TO 500
450         I=I-1
C FIND NEXT ROOM.
         IF(ZAND(RFLAG(I),NONOFL).NE.0) GO TO 450
C SKIP IF NONO.
         CALL NEWSTA(J,0,I,0,0)
500       CONTINUE
       RETURN
C
C CANT OR WONT CONTINUE, CLEAN UP AND EXIT.
C
900       CALL RSPEAK(625)
C IN ENDGAME, LOSE.
       GO TO 1100
C
1000       CALL RSPEAK(7)
C INVOLUNTARY EXIT.
1100       CALL SCORE(.FALSE.)
C TELL SCORE.
       CLOSE (UNIT=DBCH)
       CALL EXIT
C
       END
C OACTOR-       GET ACTOR ASSOCIATED WITH OBJECT
C
C DECLARATIONS
C
       INTEGER FUNCTION OACTOR(OBJ)
       IMPLICIT INTEGER(A-Z)
C
C ADVENTURERS
C
       COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4),
     1       AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4)
C
       DO 100 I=1,ALNT
C LOOP THRU ACTORS.
         OACTOR=I
C ASSUME FOUND.
         IF(AOBJ(I).EQ.OBJ) RETURN
C FOUND IT?
100       CONTINUE
       CALL BUG(40,OBJ)
C NO, DIE.
       RETURN
       END
C PROB-              COMPUTE PROBABILITY
C
C DECLARATIONS
C
       LOGICAL FUNCTION PROB(G,B)
       IMPLICIT INTEGER(A-Z)
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
       I=G
C ASSUME GOOD LUCK.
       IF(BADLKF) I=B
C IF BAD, TOO BAD.
       PROB=ZRND(100).LT.I
C COMPUTE.
       RETURN
       END
C RMDESC-- PRINT ROOM DESCRIPTION
C
C RMDESC PRINTS A DESCRIPTION OF THE CURRENT ROOM.
C IT IS ALSO THE PROCESSOR FOR VERBS 'LOOK' AND 'EXAMINE'.
C
       LOGICAL FUNCTION RMDESC(FULL)
C
C FULL=       0/1/2/3=       SHORT/OBJ/ROOM/FULL
C
C DECLARATIONS
C
       IMPLICIT INTEGER (A-Z)
       LOGICAL PROB,LIT,RAPPLI
C
C PARSER OUTPUT
C
       LOGICAL PRSWON
       COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON
C
C GAME STATE
C
       LOGICAL TELFLG
       COMMON /PLAY/ WINNER,HERE,TELFLG
C
C SCREEN OF LIGHT
C
       COMMON /SCREEN/ FROMDR,SCOLRM,SCOLAC
       COMMON /SCREEN/ SCOLDR(8),SCOLWL(12)
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 /XSRCH/ XMIN,XMAX,XDOWN,XUP,
     1       XNORTH,XSOUTH,XENTER,XEXIT,XEAST,XWEST
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
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 RMDESC, PAGE 2
C
       RMDESC=.TRUE.
C ASSUME WINS.
       IF(PRSO.LT.XMIN) GO TO 50
C IF DIRECTION,
       FROMDR=PRSO
C SAVE AND
       PRSO=0
C CLEAR.
50       IF(HERE.EQ.AROOM(PLAYER)) GO TO 100
C PLAYER JUST MOVE?
       CALL RSPEAK(2)
C NO, JUST SAY DONE.
       PRSA=WALKIW
C SET UP WALK IN ACTION.
       RETURN
C
100       IF(LIT(HERE)) GO TO 300
C LIT?
       CALL RSPEAK(430)
C WARN OF GRUE.
       RMDESC=.FALSE.
       RETURN
C
300       RA=RACTIO(HERE)
C GET ROOM ACTION.
       IF(FULL.EQ.1) GO TO 600
C OBJ ONLY?
       I=RDESC2-HERE
C ASSUME SHORT DESC.
       IF((FULL.EQ.0)
     1       .AND. (SUPERF.OR.((ZAND(RFLAG(HERE),RSEEN).NE.0)
     1       .AND. (BRIEFF.OR.PROB(80,80))))) GO TO 400
       I=RDESC1(HERE)
C USE LONG.
       IF((I.NE.0).OR.(RA.EQ.0)) GO TO 400
C IF GOT DESC, SKIP.
       PRSA=LOOKW
C PRETEND LOOK AROUND.
       IF(.NOT.RAPPLI(RA)) GO TO 100
C ROOM HANDLES, NEW DESC?
       PRSA=FOOW
C NOP PARSER.
       GO TO 500
C
400       CALL RSPEAK(I)
C OUTPUT DESCRIPTION.
500    IF(AVEHIC(WINNER).NE.0) CALL RSPSUB(431,ODESC2(AVEHIC(WINNER)))
C
600       IF(FULL.NE.2) CALL PRINCR(FULL.NE.0,HERE)
       RFLAG(HERE)=ZOR(RFLAG(HERE),RSEEN)
C INDICATE ROOM SEEN.
       IF((FULL.NE.0).OR.(RA.EQ.0)) RETURN
C ANYTHING MORE?
       PRSA=WALKIW
C GIVE HIM A SURPISE.
       IF(.NOT.RAPPLI(RA)) GO TO 100
C ROOM HANDLES, NEW DESC?
       PRSA=FOOW
       RETURN
C
       END
C RAPPLI-       ROUTING ROUTINE FOR ROOM APPLICABLES
C
C DECLARATIONS
C
       LOGICAL FUNCTION RAPPLI(RI)
       IMPLICIT INTEGER(A-Z)
       LOGICAL RAPPL1,RAPPL2
       DATA NEWRMS/38/
C
       RAPPLI=.TRUE.
C ASSUME WINS.
       IF(RI.EQ.0) RETURN
C IF ZERO, WIN.
       IF(RI.LT.NEWRMS) RAPPLI=RAPPL1(RI)
C IF OLD, PROCESSOR 1.
       IF(RI.GE.NEWRMS) RAPPLI=RAPPL2(RI)
C IF NEW, PROCESSOR 2.
       RETURN
       END
