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)
	LOGICAL*1 B1(74),B2(74),X1
C
C DECLARATIONS
C
	LOGICAL TELFLG
	COMMON /PLAY/ WINNER,HERE,TELFLG
C
	COMMON /RMSG/ MLNT,RTEXT(1050)
	COMMON /CHAN/ INPCH,OUTCH,DBCH
C
C CONVERT ALL ARGUMENTS FROM DICTIONARY NUMBERS (IF POSITIVE)
C TO ABSOLUTE RECORD NUMBERS.
C
	X=A					!SET UP WORK VARIABLES.
	Y=B
	Z=C
	IF(X.GT.0) X=RTEXT(X)			!IF >0, LOOK UP IN RTEXT.
	IF(Y.GT.0) Y=RTEXT(Y)
	IF(Z.GT.0) Z=RTEXT(Z)
	X=IABS(X)				!TAKE ABS VALUE.
	Y=IABS(Y)
	Z=IABS(Z)
	IF(X.EQ.0) RETURN			!ANYTHING TO DO?
	TELFLG=.TRUE.				!SAID SOMETHING.
C
	READ(DBCH'X) OLDREC,B1			!READ FIRST LINE.
100	DO 150 I=1,74
	  X1=(X.AND.31)+I
	  B1(I)=B1(I).XOR.X1
150	CONTINUE
C
200	IF(Y.EQ.0) GO TO 400			!ANY SUBSTITUTABLE?
	DO 300 I=1,74				!YES, LOOK FOR #.
	  IF(B1(I).EQ.'#') GO TO 1000
300	CONTINUE
C
400	DO 500 I=74,1,-1			!BACKSCAN FOR BLANKS.
	  IF(B1(I).NE.' ') GO TO 600
500	CONTINUE
C
600	WRITE(OUTCH,650) (B1(J),J=1,I)		!OUTPUT LINE.
650	FORMAT(1X,74A1)
	X=X+1					!ON TO NEXT RECORD.
	READ(DBCH'X) NEWREC,B1			!READ NEXT RECORD.
	IF(OLDREC.EQ.NEWREC) GO TO 100		!CONTINUATION?
	RETURN					!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					!TO
	DO 1100 K1=I+1,74			!COPY REST OF B1.
	  B2(K2)=B1(K1)
	  K2=K2+1
1100	CONTINUE
C
	READ(DBCH'Y) J,(B1(K1),K1=I,74)		!READ SUB RECORD.
	DO 1150 K1=I,74
	  X1=(Y.AND.31)+K1-I+1
	  B1(K1)=B1(K1).XOR.X1
1150	CONTINUE
C
	DO 1200 J=74,1,-1			!ELIM TRAILING BLANKS.
	  IF(B1(J).NE.' ') GO TO 1300
1200	CONTINUE
C
1300	K1=1					!FROM
	DO 1400 K2=J+1,74			!COPY REST OF B1 BACK.
	  B1(K2)=B2(K1)
	  K1=K1+1
1400	CONTINUE
C
	Y=Z					!SET UP FOR NEXT
	Z=0					!SUBSTITUTION AND
	GO TO 200				!RECHECK LINE.
C
	END
C OBJACT-- APPLY OBJECTS FROM PARSE VECTOR
C
C DECLARATIONS
C
	LOGICAL FUNCTION OBJACT(X)
	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.				!ASSUME WINS.
	IF(PRSI.EQ.0) GO TO 100			!IND OBJECT?
	IF(OAPPLI(OACTIO(PRSI),0)) RETURN	!YES, LET IT HANDLE.
C
100	IF(PRSO.EQ.0) GO TO 200			!DIR OBJECT?
	IF(OAPPLI(OACTIO(PRSO),0)) RETURN	!YES, LET IT HANDLE.
C
200	OBJACT=.FALSE.				!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
C
	TYPE 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		!IN ROOM?
	DO 100 I=1,R2LNT			!NO, SCH ROOM2.
	  IF((O2(I).EQ.OBJ).AND.(R2(I).EQ.RM)) RETURN
100	CONTINUE
	QHERE=.FALSE.				!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.				!ASSUME LOSE.
	DO 100 I=1,OLNT
	  IF(OCAN(I).EQ.OBJ) RETURN		!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
	COMMON /DEBUG/ DBGFLG
C
C ROOMS
C
	COMMON /ROOMS/ RLNT,RDESC2,RDESC1(200),REXIT(200),
	1	RACTIO(200),RVAL(200),RFLAG(200)
	INTEGER RRAND(200)
	EQUIVALENCE (RVAL,RRAND)
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*1 TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF
	LOGICAL*1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF
	LOGICAL*1 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF
	LOGICAL*1 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF
	LOGICAL*1 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF
	LOGICAL*1 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF
	LOGICAL*1 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF
	LOGICAL*1 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)			!DESCRIBE SAD STATE.
	PRSCON=1				!STOP PARSER.
	IF(DBGFLG.NE.0) RETURN			!IF DBG, EXIT.
	AVEHIC(WINNER)=0			!GET RID OF VEHICLE.
	IF(WINNER.EQ.PLAYER) GO TO 100		!HIMSELF?
	CALL RSPSUB(432,ODESC2(AOBJ(WINNER)))	!NO, SAY WHO DIED.
	CALL NEWSTA(AOBJ(WINNER),0,0,0,0)	!SEND TO HYPER SPACE.
	RETURN
C
100	IF(ENDGMF) GO TO 900			!NO RECOVERY IN END GAME.
	IF(DEATHS.GE.2) GO TO 1000		!DEAD TWICE? KICK HIM OFF.
	IF(.NOT.YESNO(10,9,8)) GO TO 1100	!CONTINUE?
C
	DO 50 J=1,OLNT				!TURN OFF FIGHTING.
	  IF(QHERE(J,HERE)) OFLAG2(J)=OFLAG2(J).AND. .NOT.FITEBT
50	CONTINUE
C
	DEATHS=DEATHS+1
	CALL SCRUPD(-10)			!CHARGE TEN POINTS.
	F=MOVETO(FORE1,WINNER)			!REPOSITION HIM.
	EGYPTF=.TRUE.				!RESTORE COFFIN.
	IF(OADV(COFFI).EQ.WINNER) CALL NEWSTA(COFFI,0,EGYPT,0,0)
	OFLAG2(DOOR)=OFLAG2(DOOR).AND. .NOT.TCHBT !RESTORE DOOR.
	OFLAG1(ROBOT)=(OFLAG1(ROBOT).OR.VISIBT) .AND. .NOT.NDSCBT
	IF((OROOM(LAMP).NE.0).OR.(OADV(LAMP).EQ.WINNER))
	1	CALL NEWSTA(LAMP,0,LROOM,0,0)	!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				!LOOP THRU OBJECTS.
	  IF((OADV(J).NE.WINNER).OR.(OTVAL(J).NE.0))
	1	GO TO 200			!GET HIS NON-VAL OBJS.
	  I=I+1
	  IF(I.GT.9) GO TO 400			!MOVE TO RANDOM LOCATIONS.
	  CALL NEWSTA(J,0,RLIST(I),0,0)
200	CONTINUE
C
400	I=RLNT+1				!NOW MOVE VALUABLES.
	NONOFL=RAIR+RWATER+RSACRD+REND		!DONT MOVE HERE.
	DO 300 J=1,OLNT
	  IF((OADV(J).NE.WINNER).OR.(OTVAL(J).EQ.0))
	1	GO TO 300			!ON ADV AND VALUABLE?
250	  I=I-1					!FIND NEXT ROOM.
	  IF((RFLAG(I).AND.NONOFL).NE.0) GO TO 250	!SKIP IF NONO.
	  CALL NEWSTA(J,0,I,0,0)		!YES, MOVE.
300	CONTINUE
C
	DO 500 J=1,OLNT				!NOW GET RID OF REMAINDER.
	  IF(OADV(J).NE.WINNER) GO TO 500
450	  I=I-1					!FIND NEXT ROOM.
	  IF((RFLAG(I).AND.NONOFL).NE.0) GO TO 450	!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)			!IN ENDGAME, LOSE.
	GO TO 1100
C
1000	CALL RSPEAK(7)				!INVOLUNTARY EXIT.
1100	CALL SCORE(.FALSE.)			!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				!LOOP THRU ACTORS.
	  OACTOR=I				!ASSUME FOUND.
	  IF(AOBJ(I).EQ.OBJ) RETURN		!FOUND IT?
100	CONTINUE
	CALL BUG(40,OBJ)			!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*1 TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF
	LOGICAL*1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF
	LOGICAL*1 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF
	LOGICAL*1 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF
	LOGICAL*1 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF
	LOGICAL*1 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF
	LOGICAL*1 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF
	LOGICAL*1 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					!ASSUME GOOD LUCK.
	IF(BADLKF) I=B				!IF BAD, TOO BAD.
	PROB=RND(100).LT.I			!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
C
C ROOMS
C
	COMMON /ROOMS/ RLNT,RDESC2,RDESC1(200),REXIT(200),
	1	RACTIO(200),RVAL(200),RFLAG(200)
	INTEGER RRAND(200)
	EQUIVALENCE (RVAL,RRAND)
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*1 TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF
	LOGICAL*1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF
	LOGICAL*1 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF
	LOGICAL*1 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF
	LOGICAL*1 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF
	LOGICAL*1 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF
	LOGICAL*1 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF
	LOGICAL*1 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.				!ASSUME WINS.
	IF(PRSO.LT.XMIN) GO TO 50		!IF DIRECTION,
	FROMDR=PRSO				!SAVE AND
	PRSO=0					!CLEAR.
50	IF(HERE.EQ.AROOM(PLAYER)) GO TO 100	!PLAYER JUST MOVE?
	CALL RSPEAK(2)				!NO, JUST SAY DONE.
	PRSA=WALKIW				!SET UP WALK IN ACTION.
	RETURN
C
100	IF(LIT(HERE)) GO TO 300			!LIT?
	CALL RSPEAK(430)			!WARN OF GRUE.
	RMDESC=.FALSE.
	RETURN
C
300	RA=RACTIO(HERE)				!GET ROOM ACTION.
	IF(FULL.EQ.1) GO TO 600			!OBJ ONLY?
	I=RDESC2-HERE				!ASSUME SHORT DESC.
	IF((FULL.EQ.0)
	1	.AND. (SUPERF.OR.(((RFLAG(HERE).AND.RSEEN).NE.0)
	1	.AND. (BRIEFF.OR.PROB(80,80))))) GO TO 400
	I=RDESC1(HERE)				!USE LONG.
	IF((I.NE.0).OR.(RA.EQ.0)) GO TO 400	!IF GOT DESC, SKIP.
	PRSA=LOOKW				!PRETEND LOOK AROUND.
	IF(.NOT.RAPPLI(RA)) GO TO 100		!ROOM HANDLES, NEW DESC?
	PRSA=FOOW				!NOP PARSER.
	GO TO 500
C
400	CALL RSPEAK(I)				!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)=RFLAG(HERE).OR.RSEEN	!INDICATE ROOM SEEN.
	IF((FULL.NE.0).OR.(RA.EQ.0)) RETURN	!ANYTHING MORE?
	PRSA=WALKIW				!GIVE HIM A SURPISE.
	IF(.NOT.RAPPLI(RA)) GO TO 100		!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.				!ASSUME WINS.
	IF(RI.EQ.0) RETURN			!IF ZERO, WIN.
	IF(RI.LT.NEWRMS) RAPPLI=RAPPL1(RI)	!IF OLD, PROCESSOR 1.
	IF(RI.GE.NEWRMS) RAPPLI=RAPPL2(RI)	!IF NEW, PROCESSOR 2.
	RETURN
	END