Source to dungeon-2.5.6/dsub.f
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