Dungeon sources (part 2 of 7)
Bill Randle
# dinit.ftn.F dmain.ftn.f dso1.for.f dso2.for.f dso3.for.f dso4.for.f dso5.for.f dso6.for.f dso7.f
echo x - dinit.ftn.F
cat >dinit.ftn.F <<'!Funky!Stuff!'
#ifndef INDXFILE
#define INDXFILE '/usr/games/lib/dunlib/dindx.dat'
#endif
#ifndef TEXTFILE
#define TEXTFILE '/usr/games/lib/dunlib/dtext.dat'
#endif
C INIT-- DUNGEON INITIALIZATION SUBROUTINE
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 INIT(X)
IMPLICIT INTEGER (A-Z)
LOGICAL PROTCT
INTEGER DATARRY(3)
C
C PARSER OUTPUT
C
LOGICAL PRSWON
COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON
C
C PARSER STATE
C
COMMON /SYNFLG/ SDIR
COMMON /ORPHS/ OFLAG,OACT,OSLOT,OPREP,ONAME
COMMON /LAST/ LASTIT
C
C GAME STATE
C
LOGICAL TELFLG
COMMON /PLAY/ WINNER,HERE,TELFLG
COMMON /STATE/ MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD,
& LTSHFT,BLOC,MUNGRM,HS,EGSCOR,EGMXSC
C
C SCREEN OF LIGHT
C
COMMON /SCREEN/ FROMDR,SCOLRM,SCOLAC
C
C MESSAGE INDEX
C
COMMON /RMSG/ MLNT,RTEXT(1050)
C
C MISCELLANEOUS VARIABLES
C
COMMON /STAR/ MBASE,STRBIT
COMMON /VERS/ VMAJ,VMIN,VEDIT
COMMON /TIME/ PLTIME,SHOUR,SMIN,SSEC
COMMON /CHAN/ INPCH,OUTCH,DBCH
COMMON /DEBUG/ DBGFLG,PRSFLG,GDTFLG
COMMON /HYPER/ HFACTR
C
C ROOMS
C
COMMON /ROOMS/ RLNT,RDESC2,RDESC1(200),REXIT(200),
& RACTIO(200),RVAL(200),RFLAG(200)
INTEGER RRAND(200)
EQUIVALENCE (RVAL,RRAND)
C
COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR,
& 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 EXITS
C
COMMON /EXITS/ XLNT,TRAVEL(900)
C
COMMON /CURXT/ XTYPE,XROOM1,XSTRNG,XACTIO,XOBJ
EQUIVALENCE (XFLAG,XOBJ)
C
COMMON /XPARS/ XRMASK,XDMASK,XFMASK,XFSHFT,XASHFT,
& XELNT(4),XNORM,XNO,XCOND,XDOOR,XLFLAG
C
C OBJECTS
C
COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220),
& OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
& OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
& OADV(220),OCAN(220),OREAD(220)
C
COMMON /OROOM2/ R2LNT,O2(20),R2(20)
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 CLOCK INTERRUPTS
C
LOGICAL CFLAG
COMMON /CEVENT/ CLNT,CTICK(25),CACTIO(25),CFLAG(25)
C
C VILLAINS AND DEMONS
C
LOGICAL THFFLG,SWDACT,THFACT
COMMON /HACK/ THFPOS,THFFLG,THFACT,SWDACT,SWDSTA
COMMON /VILL/ VLNT,VILLNS(4),VPROB(4),VOPPS(4),VBEST(4),VMELEE(4)
C
C ADVENTURERS
C
COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4),
& 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,
& DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF,
& MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF,
& EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF,
& GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF,
& GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF,
& MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF,
& 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
LOGICAL FLAGS(46)
INTEGER SWITCH(22)
EQUIVALENCE (FLAGS(1),TROLLF)
EQUIVALENCE (SWITCH(1),BTIEF)
C INIT, PAGE 2
C
C FIRST CHECK FOR PROTECTION VIOLATION
C
IF(PROTCT(X)) GO TO 10000
PRINT 10100
10100 FORMAT(' There appears before you a threatening figure clad
& all over'/' in heavy black armor. His legs seem like the
& massive trunk'/' of the oak tree. His broad shoulders and
& helmeted head loom'/' high over your own puny frame, and
& you realize that his powerful'/' arms could easily crush the
& very life from your body. There'/' hangs from his belt a
& veritable arsenal of deadly weapons:'/' sword, mace, ball
& and chain, dagger, lance, and trident.'/' He speaks with a
& commanding voice:'//20X,'"You shall not pass."'//' As
& he grabs you by the neck all grows dim about you.')
CALL EXIT
C
C NOW START INITIALIZATION PROPER
C
10000 INIT=.FALSE.
MMAX=1050
OMAX=220
RMAX=200
VMAX=4
AMAX=4
CMAX=25
FMAX=46
SMAX=22
XMAX=900
R2MAX=20
DIRMAX=15
C
MLNT=0
OLNT=0
RLNT=0
VLNT=0
ALNT=0
CLNT=0
XLNT=1
R2LNT=0
C
LTSHFT=10
MXSCOR=LTSHFT
EGSCOR=0
EGMXSC=0
MXLOAD=100
RWSCOR=0
DEATHS=0
MOVES=0
PLTIME=0
MUNGRM=0
HS=0
PRSA=0
PRSI=0
PRSO=0
PRSCON=1
OFLAG=0
OACT=0
OSLOT=0
OPREP=0
ONAME=0
THFFLG=.FALSE.
THFACT=.TRUE.
SWDACT=.FALSE.
SWDSTA=0
C
RECNO=1
MBASE=0
C LOGICAL UNIT NRS: 5=STDIN, 6=STDOUT
INPCH=5
OUTCH=6
DBCH=2
C INIT, PAGE 3
C
C INIT ALL ARRAYS.
C
DO 5 I=1,CMAX
CFLAG(I)=.FALSE.
CTICK(I)=0
CACTIO(I)=0
5 CONTINUE
C
DO 10 I=1,FMAX
FLAGS(I)=.FALSE.
10 CONTINUE
BUOYF=.TRUE.
EGYPTF=.TRUE.
CAGETF=.TRUE.
MR1F=.TRUE.
MR2F=.TRUE.
FOLLWF=.TRUE.
DO 12 I=1,SMAX
SWITCH(I)=0
12 CONTINUE
ORMTCH=4
LCELL=1
PNUMB=1
MDIR=270
MLOC=MRB
CPHERE=10
C
DO 15 I=1,R2MAX
R2(I)=0
O2(I)=0
15 CONTINUE
C
DO 20 I=1,XMAX
TRAVEL(I)=0
20 CONTINUE
C
DO 30 I=1,VMAX
VOPPS(I)=0
VPROB(I)=0
VILLNS(I)=0
VBEST(I)=0
VMELEE(I)=0
30 CONTINUE
C
DO 40 I=1,OMAX
ODESC1(I)=0
ODESC2(I)=0
ODESCO(I)=0
OREAD(I)=0
OACTIO(I)=0
OFLAG1(I)=0
OFLAG2(I)=0
OFVAL(I)=0
OTVAL(I)=0
OSIZE(I)=0
OCAPAC(I)=0
OCAN(I)=0
OADV(I)=0
OROOM(I)=0
40 CONTINUE
C
RDESC2=0
DO 50 I=1,RMAX
RDESC1(I)=0
RACTIO(I)=0
RFLAG(I)=0
RVAL(I)=0
REXIT(I)=0
50 CONTINUE
C
DO 60 I=1,MMAX
RTEXT(I)=0
60 CONTINUE
C
DO 70 I=1,AMAX
AROOM(I)=0
ASCORE(I)=0
AVEHIC(I)=0
AOBJ(I)=0
AACTIO(I)=0
ASTREN(I)=0
AFLAG(I)=0
70 CONTINUE
C
DBGFLG=0
PRSFLG=0
GDTFLG=0
C
FROMDR=0
SCOLRM=0
SCOLAC=0
C INIT, PAGE 4
C
C NOW RESTORE FROM EXISTING INDEX FILE.
C
OPEN(UNIT=1,file=INDXFILE,status='OLD',
& FORM='FORMATTED',ACCESS='SEQUENTIAL',ERR=1900)
READ(1,130) I,J,K
IF((I.NE.VMAJ).OR.(J.NE.VMIN))
& GO TO 1925
OPEN(UNIT=DBCH,file=TEXTFILE,status='OLD',
& FORM='UNFORMATTED',ACCESS='DIRECT',
& recl=76,ERR=1950)
C D PRINT 150
C D150 FORMAT(' RESTORING FROM "dindx.dat"')
READ(1,130) MXSCOR,STRBIT,EGMXSC
READ(1,130) RLNT,RDESC2,RDESC1,REXIT,RACTIO,RVAL,RFLAG
READ(1,130) XLNT,TRAVEL
READ(1,130) OLNT,ODESC1,ODESC2,ODESCO,OACTIO,OFLAG1,OFLAG2,
& OFVAL,OTVAL,OSIZE,OCAPAC,OROOM,OADV,OCAN,
& OREAD
READ(1,130) R2LNT,O2,R2
READ(1,130) CLNT,CTICK,CACTIO
READ(1,135) CFLAG
READ(1,130) VLNT,VILLNS,VPROB,VOPPS,VBEST,VMELEE
READ(1,130) ALNT,AROOM,ASCORE,AVEHIC,AOBJ,AACTIO,ASTREN,AFLAG
READ(1,130) MBASE,MLNT,RTEXT
C
CLOSE(1)
GO TO 1025
C
C 130 FORMAT(I8)
130 FORMAT(I6)
135 FORMAT(L4)
C INIT, PAGE 5
C
C THE INTERNAL DATA BASE IS NOW ESTABLISHED.
C SET UP TO PLAY THE GAME.
C
1025 CALL ITIME(SHOUR,SMIN,SSEC)
C CALL IDATE(I,J,K)
CALL IDATE(DATARRY(1))
CALL INIRND(or(DATARRY(1),or(DATARRY(2),DATARRY(3))),
& or(SHOUR,or(SMIN,SSEC)))
C
WINNER=PLAYER
LASTIT=AOBJ(PLAYER)
HERE=AROOM(WINNER)
THFPOS=OROOM(THIEF)
BLOC=OROOM(BALLO)
INIT=.TRUE.
C
C D PRINT 1050,RLNT,RMAX,XLNT,XMAX,OLNT,OMAX,MLNT,MMAX,
C & VLNT,VMAX,ALNT,AMAX,CLNT,CMAX,R2LNT,R2MAX
C D1050 FORMAT(' USED:'/1X,I5,' OF',I5,' ROOMS'/
C & 1X,I5,' OF',I5,' EXITS'/
C & 1X,I5,' OF',I5,' OBJECTS'/
C & 1X,I5,' OF',I5,' MESSAGES'/
C & 1X,I5,' OF',I5,' VILLAINS'/
C & 1X,I5,' OF',I5,' ADVENTURERS'/
C & 1X,I5,' OF',I5,' CLOCK EVENTS'/
C & 1X,I5,' OF',I5,' ROOM2 SLOTS')
C D PRINT 1150,MXSCOR,EGMXSC,RECNO,RDESC2,MBASE,STRBIT
C D1150 FORMAT(' MAX SCORE=',I5/' EG SCORE=',I5/
C & ' MAX RECNO=',I5/' RDESC2 BASE=',I5/
C & ' MELEE START=',I5/' STAR MASK=',I7)
C D PAUSE 1
C
RETURN
C INIT, PAGE 6
C
C ERRORS-- INIT FAILS.
C
1900 PRINT 910
PRINT 980
RETURN
1925 PRINT 920,I,J,K,VMAJ,VMIN,VEDIT
PRINT 980
RETURN
1950 PRINT 960
PRINT 980
RETURN
910 FORMAT(' I can''t open ',INDXFILE,'.')
920 FORMAT(' "dindx.dat" is version ',I1,'.',I1,A1,'.'/
& ' I require version ',I1,'.',I1,A1,'.')
960 FORMAT(' I can''t open ',TEXTFILE,'.')
980 FORMAT(' Suddenly a sinister, wraithlike figure appears before
& you'/' seeming to float in the air. In a low, sorrowful voice
& he says,'/' "Alas, the very nature of the world has changed,
& and the dungeon'/' cannot be found. All must now pass away."
& Raising his oaken staff'/' in farewell, he fades into the
& spreading darkness. In his place'/' appears a tastefully
& lettered sign reading:'//23X,'INITIALIZATION FAILURE'//
& ' The darkness becomes all encompassing, and your vision fails.')
C
END
C PROTCT-- CHECK FOR USER VIOLATION
C
C THIS ROUTINE SHOULD BE MODIFIED IF YOU WISH TO ADD SYSTEM
C DEPENDANT PROTECTION AGAINST ABUSE.
C
C AT THE MOMENT, PLAY IS PERMITTED UNDER ALL CIRCUMSTANCES.
C
LOGICAL FUNCTION PROTCT(X)
IMPLICIT INTEGER(A-Z)
C
PROTCT=.TRUE.
RETURN
END
!Funky!Stuff!
echo x - dmain.ftn.f
cat >dmain.ftn.f <<'!Funky!Stuff!'
C DUNGEON-- MAIN PROGRAM
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
PROGRAM DUNGEO
C
C DECLARATIONS
C
IMPLICIT INTEGER (A-Z)
LOGICAL INIT
C
C PARSER OUTPUT
C
LOGICAL PRSWON
COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON
C
C PARSER STATE
C
COMMON /ORPHS/ OFLAG,OACT,OSLOT,OPREP,ONAME
COMMON /LAST/ LASTIT
COMMON /PV/ ACT,OBJ1,OBJ2,PREP1,PREP2
COMMON /SYNTAX/ SYN(11)
COMMON /SYNFLG/ SDIR,SIND,SSTD,SFLIP,SDRIV,SVMASK
COMMON /OBJFLG/ VABIT,VRBIT,VTBIT,VCBIT,VEBIT,VFBIT,VPMASK
C
C GAME STATE
C
LOGICAL TELFLG
COMMON /PLAY/ WINNER,HERE,TELFLG
COMMON /STATE/ MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD,
& LTSHFT,BLOC,MUNGRM,HS,EGSCOR,EGMXSC
C
C SCREEN OF LIGHT STATE
C
COMMON /SCREEN/ FROMDR,SCOLRM,SCOLAC
COMMON /SCREEN/ SCOLDR(8),SCOLWL(12)
C
C PUZZLE ROOM STATE
C
COMMON /PUZZLE/ CPDR(16),CPWL(8),CPVEC(64)
C
C MESSAGE INDEX
C
COMMON /RMSG/ MLNT,RTEXT(1050)
C
C MISCELLANEOUS VARIABLES
C
CHARACTER VEDIT
CHARACTER INBUF(78)
COMMON /INPUT/ INLNT,INBUF(78)
COMMON /STAR/ MBASE,STRBIT
COMMON /VERS/ VMAJ,VMIN,VEDIT
COMMON /TIME/ PLTIME,SHOUR,SMIN,SSEC
COMMON /BATS/ BATDRP(9)
COMMON /CHAN/ INPCH,OUTCH,DBCH
COMMON /DEBUG/ DBGFLG,PRSFLG,GDTFLG
COMMON /HYPER/ HFACTR
C
C ROOMS
C
COMMON /ROOMS/ RLNT,RDESC2,RDESC1(200),REXIT(200),
& RACTIO(200),RVAL(200),RFLAG(200)
INTEGER RRAND(200)
EQUIVALENCE (RVAL,RRAND)
C
COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR,
& 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 EXITS
C
COMMON /EXITS/ XLNT,TRAVEL(900)
C
COMMON /CURXT/ XTYPE,XROOM1,XSTRNG,XACTIO,XOBJ
EQUIVALENCE (XFLAG,XOBJ)
C
COMMON /XPARS/ XRMASK,XDMASK,XFMASK,XFSHFT,XASHFT,
& XELNT(4),XNORM,XNO,XCOND,XDOOR,XLFLAG
C
COMMON /XSRCH/ XMIN,XMAX,XDOWN,XUP,
& XNORTH,XSOUTH,XENTER,XEXIT,XEAST,XWEST
C
C OBJECTS
C
COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220),
& OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
& OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
& OADV(220),OCAN(220),OREAD(220)
C
COMMON /OROOM2/ R2LNT,O2(20),R2(20)
C
COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT,
& NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT,
& TOOLBT,TURNBT,ONBT
COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT,
& WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT,
& 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 CLOCK INTERRUPTS
C
LOGICAL CFLAG
COMMON /CEVENT/ CLNT,CTICK(25),CACTIO(25),CFLAG(25)
C
COMMON /CINDEX/ CEVCUR,CEVMNT,CEVLNT,CEVMAT,CEVCND,
& CEVBAL,CEVBRN,CEVFUS,CEVLED,CEVSAF,CEVVLG,
& CEVGNO,CEVBUC,CEVSPH,CEVEGH,
& CEVFOR,CEVSCL,CEVZGI,CEVZGO,CEVSTE,
& CEVMRS,CEVPIN,CEVINQ,CEVFOL
C
C VILLAINS AND DEMONS
C
LOGICAL THFFLG,SWDACT,THFACT
COMMON /HACK/ THFPOS,THFFLG,THFACT,SWDACT,SWDSTA
COMMON /VILL/ VLNT,VILLNS(4),VPROB(4),VOPPS(4),VBEST(4),VMELEE(4)
C
C ADVENTURERS
C
COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4),
& AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4)
C
COMMON /AFLAGS/ ASTAG
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,
& DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF,
& MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF,
& EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF,
& GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF,
& GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF,
& MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF,
& 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 DUNGEON, PAGE 2
C
C DATA STATEMENTS FOR CONSTANT ARRAYS
C
DATA VMAJ/2/,VMIN/5/,VEDIT/'A'/
C
DATA SDIR/o'40000'/,SIND/o'20000'/,SSTD/o'10000'/,
& SFLIP/o'4000'/,SDRIV/o'2000'/,SVMASK/o'777'/
DATA VABIT/o'40000'/,VRBIT/o'20000'/,VTBIT/o'10000'/,
& VCBIT/o'4000'/,VEBIT/o'2000'/,VFBIT/o'1000'/,
& VPMASK/o'777'/
C
DATA BATDRP/66,67,68,69,70,71,72,65,73/
C
DATA SCOLDR/o'2000',153,o'12000',154,o'6000',152,o'16000',151/
DATA SCOLWL/151,207,o'6000',152,208,o'16000',
& 153,206,o'12000',154,205,o'2000'/
C
DATA HFACTR/500/
C
DATA CPDR/o'2000',-8,o'4000',-7,o'6000',1,o'10000',9,
& o'12000',8,o'14000',7,o'16000',-1,o'20000',-9/
DATA CPWL/205,-8,206,8,207,1,208,-1/
DATA CPVEC/1,1,1,1,1,1,1,1,
& 1,0,-1,0,0,-1,0,1,
& 1,-1,0,1,0,-2,0,1,
& 1,0,0,0,0,1,0,1,
& 1,-3,0,0,-1,-1,0,1,
& 1,0,0,-1,0,0,0,1,
& 1,1,1,0,0,0,1,1,
& 1,1,1,1,1,1,1,1/
C
DATA CEVCUR/1/,CEVMNT/2/,CEVLNT/3/,CEVMAT/4/,
& CEVCND/5/,CEVBAL/6/,CEVBRN/7/,CEVFUS/8/,
& CEVLED/9/,CEVSAF/10/,CEVVLG/11/,CEVGNO/12/,
& CEVBUC/13/,CEVSPH/14/,CEVEGH/15/,
& CEVFOR/16/,CEVSCL/17/,CEVZGI/18/,CEVZGO/19/,
& CEVSTE/20/,CEVMRS/21/,CEVPIN/22/,CEVINQ/23/,
& CEVFOL/24/
C
DATA XRMASK/o'377'/,XDMASK/o'76000'/,XFMASK/3/
DATA XFSHFT/256/,XASHFT/256/
DATA XNORM/1/,XNO/2/,XCOND/3/,XDOOR/4/
DATA XELNT/1,2,3,3/,XLFLAG/o'100000'/
DATA XMIN/o'2000'/,XMAX/o'40000'/,XUP/o'22000'/,XDOWN/o'24000'/
DATA XNORTH/o'2000'/,XSOUTH/o'12000'/,XENTER/o'32000'/,
& XEXIT/o'34000'/
DATA XEAST/o'6000'/,XWEST/o'16000'/
C
DATA PLAYER/1/,AROBOT/2/,AMASTR/3/
DATA ASTAG/o'100000'/
C
DATA RSEEN/o'100000'/,RLIGHT/o'40000'/,RLAND/o'20000'/
DATA RWATER/o'10000'/,RAIR/o'4000'/,RSACRD/o'2000'/,
& RFILL/o'1000'/
DATA RMUNG/o'400'/,RBUCK/o'200'/,RHOUSE/o'100'/,
& RNWALL/o'40'/,REND/o'20'/
C
DATA WHOUS/2/,LROOM/8/,CELLA/9/
DATA MTROL/10/,MAZE1/11/
DATA MGRAT/25/,MAZ15/30/
DATA FORE1/31/,FORE3/33/,CLEAR/36/,RESER/40/
DATA STREA/42/,EGYPT/44/,ECHOR/49/
DATA TSHAF/61/
DATA BSHAF/76/,MMACH/77/,DOME/79/,MTORC/80/
DATA CAROU/83/
DATA RIDDL/91/,LLD2/94/,TEMP1/96/,TEMP2/97/,MAINT/100/
DATA MCYCL/101/,BLROO/102/,TREAS/103/,RIVR1/107/,RIVR2/108/
DATA RIVR3/109/
DATA RIVR4/112/,RIVR5/113/,FCHMP/114/,MBARR/119/,FALLS/120/
DATA MRAIN/121/,POG/122/,VLBOT/126/,VAIR1/127/,VAIR2/128/
DATA VAIR3/129/,VAIR4/130/
DATA LEDG2/131/,LEDG3/132/,LEDG4/133/,MSAFE/135/,CAGER/140/
DATA CAGED/141/,TWELL/142/,BWELL/143/,ALICE/144/,ALISM/145/
DATA ALITR/146/,MTREE/147/,BKENT/148/
DATA BKVW/151/,BKTWI/153/,BKVAU/154/,BKBOX/155/
DATA CRYPT/157/,TSTRS/158/,MRANT/159/
DATA MREYE/160/,MRA/161/,MRB/162/,MRC/163/,MRG/164/
DATA MRD/165/,FDOOR/166/,MRAE/167/
DATA MRCE/171/,MRCW/172/,MRGE/173/,MRGW/174/,MRDW/176/
DATA INMIR/177/,SCORR/179/
DATA NCORR/182/,PARAP/183/,CELL/184/,PCELL/185/,NCELL/186/
DATA CPANT/188/,CPOUT/189/
DATA CPUZZ/190/
C
DATA CINTW/1/,DEADXW/2/,FRSTQW/3/,INXW/4/
DATA OUTXW/5/,WALKIW/6/,FIGHTW/7/,FOOW/8/
C
DATA READW/100/,MELTW/101/
DATA INFLAW/102/,DEFLAW/103/,ALARMW/104/,EXORCW/105/
DATA PLUGW/106/,KICKW/107/,WAVEW/108/,RAISEW/109/,LOWERW/110/
DATA RUBW/111/,PUSHW/112/,UNTIEW/113/,TIEW/114/,TIEUPW/115/
DATA TURNW/116/,BREATW/117/,KNOCKW/118/,LOOKW/119/
DATA EXAMIW/120/,SHAKEW/121/,MOVEW/122/,TRNONW/123/,TRNOFW/124/
DATA OPENW/125/,CLOSEW/126/,FINDW/127/,WAITW/128/,SPINW/129/
DATA BOARDW/130/,UNBOAW/131/,TAKEW/132/,INVENW/133/
DATA FILLW/134/,EATW/135/,DRINKW/136/,BURNW/137/
DATA MUNGW/138/,KILLW/139/,ATTACW/141/
DATA SWINGW/140/,WALKW/142/,TELLW/143/,PUTW/144/
DATA DROPW/145/,GIVEW/146/,POURW/147/,THROWW/148/
C
DATA DIGW/89/,LEAPW/91/,STAYW/73/,FOLLOW/85/
DATA HELLOW/151/,LOOKIW/152/,LOOKUW/153/,PUMPW/154/
DATA WINDW/155/,CLMBW/156/,CLMBUW/157/,CLMBDW/158/,TRNTOW/159/
C
DATA VISIBT/o'100000'/,READBT/o'40000'/,TAKEBT/o'20000'/,
& DOORBT/o'10000'/,TRANBT/o'4000'/,FOODBT/o'2000'/,
& NDSCBT/o'1000'/,DRNKBT/o'400'/, CONTBT/o'200'/,
& LITEBT/o'100'/,VICTBT/o'40'/,BURNBT/o'20'/,
& FLAMBT/o'10'/,TOOLBT/o'4'/,TURNBT/o'2'/,ONBT/o'1'/
C
DATA FINDBT/o'100000'/,SLEPBT/o'40000'/,SCRDBT/o'20000'/,
& TIEBT/o'10000'/, CLMBBT/o'4000'/,ACTRBT/o'2000'/,
& WEAPBT/o'1000'/,FITEBT/o'400'/, VILLBT/o'200'/,
& STAGBT/o'100'/,TRYBT/o'40'/,NOCHBT/o'20'/,
& OPENBT/o'10'/,TCHBT/o'4'/,VEHBT/o'2'/,SCHBT/o'1'/
C
DATA GARLI/2/,FOOD/3/,GUNK/4/,COAL/5/,MACHI/7/,DIAMO/8/
DATA TCASE/9/,BOTTL/10/
DATA WATER/11/,ROPE/12/,KNIFE/13/,SWORD/14/,LAMP/15/,BLAMP/16/
DATA RUG/17/,LEAVE/18/,TROLL/19/,AXE/20/
DATA RKNIF/21/,KEYS/23/,BAR/26/,ICE/30/
DATA COFFI/33/,TORCH/34/,TBASK/35/,FBASK/36/,IRBOX/39/
DATA GHOST/42/,TRUNK/45/,BELL/46/,BOOK/47/,CANDL/48/
DATA MATCH/51/,TUBE/54/,PUTTY/55/,WRENC/56/,SCREW/57/
DATA CYCLO/58/,CHALI/59/
DATA THIEF/61/,STILL/62/,WINDO/63/,GRATE/65/,DOOR/66/
DATA HPOLE/71/,RBUTT/79/,LEAK/78/,RAILI/75/
DATA POT/85/,STATU/86/,IBOAT/87/,DBOAT/88/,PUMP/89/,RBOAT/90/
DATA STICK/92/,BUOY/94/,SHOVE/96/,GUANO/97/,BALLO/98/,RECEP/99/
DATA BROPE/101/,HOOK1/102/,HOOK2/103/,SAFE/105/,SSLOT/107/
DATA BRICK/109/,FUSE/110/
DATA GNOME/111/,BLABE/112/,DBALL/113/,TOMB/119/
DATA LCASE/123/,CAGE/124/,RCAGE/125/,SPHER/126/,SQBUT/127/
DATA FLASK/132/,POOL/133/,SAFFR/134/,BUCKE/137/,ORICE/139/
DATA ECAKE/138/,RDICE/140/
DATA BLICE/141/,ROBOT/142/,FTREE/145/,BILLS/148/,PORTR/149/
DATA SCOL/151/,ZGNOM/152/,EGG/154/,BEGG/155/,BAUBL/156/
DATA CANAR/157/,BCANA/158/,YLWAL/159/
DATA RDWAL/161/,PINDR/164/
DATA RBEAM/171/,ODOOR/172/,QDOOR/173/,CDOOR/175/
DATA NUM1/178/
DATA NUM8/185/,WARNI/186/,CSLIT/187/,GCARD/188/,STLDR/189/
DATA ITOBJ/192/,OPLAY/193/,EVERY/194/
DATA VALUA/195/,SAILO/196/,TEETH/197/,WALL/198/
DATA HANDS/200/,LUNGS/201/,AVIAT/202/
DATA WNORT/205/,GWATE/209/,MASTER/215/
C DUNGEON, PAGE 3
C
C 1) INITIALIZE DATA STRUCTURES
C 2) PLAY GAME
C
IF(INIT(X)) CALL GAME
CALL EXIT
END
!Funky!Stuff!
echo x - dso1.for.f
cat >dso1.for.f <<'!Funky!Stuff!'
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
C
C GAME STATE
C
LOGICAL TELFLG
COMMON /PLAY/ WINNER,HERE,TELFLG
C
C ROOMS
C
COMMON /ROOMS/ RLNT,RDESC2,RDESC1(200),REXIT(200),
& RACTIO(200),RVAL(200),RFLAG(200)
INTEGER RRAND(200)
EQUIVALENCE (RVAL,RRAND)
C
COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR,
& RSACRD,RFILL,RMUNG,RBUCK,RHOUSE,RNWALL,REND
C
C
C OBJECTS
C
COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220),
& OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
& OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
& OADV(220),OCAN(220),OREAD(220)
C
COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT,
& NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT,
& TOOLBT,TURNBT,ONBT
COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT,
& WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT,
& TCHBT,VEHBT,SCHBT
C
COMMON /OINDEX/ GARLI,FOOD,GUNK,COAL,MACHI,DIAMO,TCASE,BOTTL
C
C ADVENTURERS
C
COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4),
& 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,
& DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF,
& MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF,
& EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF,
& GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF,
& GLACMF,ENDGMF,FROBZF,BADLKF,THFENF,SINGSF,
& MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF,
& 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
C PRINCR, PAGE 2
C
J=329
DO 500 I=1,OLNT
IF(.NOT.QHERE(I,RM).OR.(and(OFLAG1(I),(VISIBT+NDSCBT)).NE.
& VISIBT).OR.(I.EQ.AVEHIC(WINNER))) GO TO 500
IF(.NOT.FULL.AND.(SUPERF.OR.(BRIEFF.AND.
& (and(RFLAG(HERE),RSEEN).NE.0)))) GO TO 200
C
C DO LONG DESCRIPTION OF OBJECT.
C
K=ODESCO(I)
IF((K.EQ.0).OR.(and(OFLAG2(I),TCHBT).NE.0)) K=ODESC1(I)
CALL RSPEAK(K)
GO TO 500
C DO SHORT DESCRIPTION OF OBJECT.
C
200 CALL RSPSUB(J,ODESC2(I))
J=502
C
500 CONTINUE
C
C NOW LOOP TO PRINT CONTENTS OF OBJECTS IN ROOM.
C
DO 1000 I=1,OLNT
IF(.NOT.QHERE(I,RM).OR.(and(OFLAG1(I),(VISIBT+NDSCBT)).NE.
& VISIBT)) GO TO 1000
IF(and(OFLAG2(I),ACTRBT).NE.0) CALL INVENT(OACTOR(I))
IF(((and(OFLAG1(I),TRANBT).EQ.0)
& .AND.(and(OFLAG2(I),OPENBT).EQ.0))
& .OR.QEMPTY(I)) GO TO 1000
C
C OBJECT IS NOT EMPTY AND IS OPEN OR TRANSPARENT.
C
J=573
IF(I.NE.TCASE) GO TO 600
J=574
IF((BRIEFF.OR.SUPERF).AND. .NOT.FULL) GO TO 1000
600 CALL PRINCO(I,J)
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),
& OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
& OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
& OADV(220),OCAN(220),OREAD(220)
C
COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT,
& NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT,
& TOOLBT,TURNBT,ONBT
COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT,
& WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT,
& TCHBT,VEHBT,SCHBT
C
C
C ADVENTURERS
C
COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4),
& AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4)
C
COMMON /AINDEX/ PLAYER,AROBOT,AMASTR
C INVENT, PAGE 2
C
I=575
IF(ADV.NE.PLAYER) I=576
DO 10 J=1,OLNT
IF((OADV(J).NE.ADV).OR.(and(OFLAG1(J),VISIBT).EQ.0))
& 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
IF(ADV.EQ.PLAYER) CALL RSPEAK(578)
RETURN
C
25 DO 100 J=1,OLNT
IF((OADV(J).NE.ADV).OR.(and(OFLAG1(J),VISIBT).EQ.0).OR.
& ((and(OFLAG1(J),TRANBT).EQ.0).AND.
& (and(OFLAG2(J),OPENBT).EQ.0))) GO TO 100
IF(.NOT.QEMPTY(J)) CALL PRINCO(J,573)
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),
& OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
& OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
& OADV(220),OCAN(220),OREAD(220)
C
CALL RSPSUB(DESC,ODESC2(OBJ))
DO 100 I=1,OLNT
IF(OCAN(I).EQ.OBJ) CALL RSPSUB(502,ODESC2(I))
100 CONTINUE
RETURN
C
END
!Funky!Stuff!
echo x - dso2.for.f
cat >dso2.for.f <<'!Funky!Stuff!'
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),
& RACTIO(200),RVAL(200),RFLAG(200)
INTEGER RRAND(200)
EQUIVALENCE (RVAL,RRAND)
C
COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR,
& RSACRD,RFILL,RMUNG,RBUCK,RHOUSE,RNWALL,REND
C
C OBJECTS
C
COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220),
& OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
& OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
& 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),
& AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4)
C
COMMON /AINDEX/ PLAYER,AROBOT,AMASTR
C MOVETO, PAGE 2
C
MOVETO=.FALSE.
LHR=and(RFLAG(HERE),RLAND).NE.0
LNR=and(RFLAG(NR),RLAND).NE.0
J=AVEHIC(WHO)
C
IF(J.NE.0) GO TO 100
IF(LNR) GO TO 500
CALL RSPEAK(427)
RETURN
C
100 BITS=0
IF(J.EQ.RBOAT) BITS=RWATER
IF(J.EQ.BALLO) BITS=RAIR
IF(J.EQ.BUCKE) BITS=RBUCK
NLV=and(RFLAG(NR),BITS).EQ.0
IF((.NOT.LNR .AND.NLV) .OR.
& (LNR.AND.LHR.AND.NLV.AND.(BITS.NE.RLAND)))
& GO TO 800
C
500 MOVETO=.TRUE.
IF(and(RFLAG(NR),RMUNG).EQ.0) GO TO 600
CALL RSPEAK(RRAND(NR))
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))
RVAL(NR)=0
RETURN
C
800 CALL RSPSUB(428,ODESC2(J))
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
COMMON /PLAY/ WINNER,HERE,TELFLG
COMMON /STATE/ MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD,
& LTSHFT,BLOC,MUNGRM,HS,EGSCOR,EGMXSC
C
COMMON /CHAN/ INPCH,OUTCH,DBCH
C
C ADVENTURERS
C
COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4),
& 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,
& DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF,
& MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF,
& EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF,
& GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF,
& GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF,
& MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF,
& 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
AS=ASCORE(WINNER)
C
IF(ENDGMF) GO TO 60
IF(FLG) WRITE(OUTCH,100)
IF(.NOT.FLG) WRITE(OUTCH,110)
IF(MOVES.NE.1) WRITE(OUTCH,120) AS,MXSCOR,MOVES
IF(MOVES.EQ.1) WRITE(OUTCH,130) AS,MXSCOR,MOVES
C
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 IF(FLG) WRITE(OUTCH,140)
IF(.NOT.FLG) WRITE(OUTCH,150)
WRITE(OUTCH,120) EGSCOR,EGMXSC,MOVES
DO 70 I=1,5
IF((EGSCOR*20/EGMXSC).GE.ERANK(I)) GO TO 80
70 CONTINUE
80 CALL RSPEAK(786+I)
RETURN
100 FORMAT(' Your score would be',$)
110 FORMAT(' Your score is',$)
120 FORMAT('+',I4,' [total of',I4,' points], in',I5,' moves.')
130 FORMAT('+',I4,' [total of',I4,' points], in',I5,' move.')
140 FORMAT(' Your score in the endgame would be',$)
150 FORMAT(' Your score in the endgame is',$)
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,
& 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,
& CEVBAL,CEVBRN,CEVFUS,CEVLED,CEVSAF,CEVVLG,
& CEVGNO,CEVBUC,CEVSPH,CEVEGH,
& CEVFOR,CEVSCL,CEVZGI,CEVZGO,CEVSTE,
& CEVMRS,CEVPIN,CEVINQ,CEVFOL
C
C ADVENTURERS
C
COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4),
& 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,
& DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF,
& MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF,
& EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF,
& GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF,
& GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF,
& MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF,
& 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
ASCORE(WINNER)=ASCORE(WINNER)+N
RWSCOR=RWSCOR+N
IF(ASCORE(WINNER).LT.(MXSCOR-(10*DEATHS))) RETURN
CFLAG(CEVEGH)=.TRUE.
CTICK(CEVEGH)=15
RETURN
C
100 EGSCOR=EGSCOR+N
RETURN
END
!Funky!Stuff!
echo x - dso3.for.f
cat >dso3.for.f <<'!Funky!Stuff!'
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),
& RACTIO(200),RVAL(200),RFLAG(200)
INTEGER RRAND(200)
EQUIVALENCE (RVAL,RRAND)
C
C EXITS
C
COMMON /EXITS/ XLNT,TRAVEL(900)
C
COMMON /CURXT/ XTYPE,XROOM1,XSTRNG,XACTIO,XOBJ
EQUIVALENCE (XFLAG,XOBJ)
C
COMMON /XPARS/ XRMASK,XDMASK,XFMASK,XFSHFT,XASHFT,
& XELNT(4),XNORM,XNO,XCOND,XDOOR,XLFLAG
C
FINDXT=.TRUE.
XI=REXIT(RM)
IF(XI.EQ.0) GO TO 1000
C
100 I=TRAVEL(XI)
XROOM1=and(I,XRMASK)
XTYPE=and((and(I,not(XLFLAG))/XFSHFT),XFMASK)+1
GO TO (110,120,130,130),XTYPE
CALL BUG(10,XTYPE)
C
130 XOBJ=and(TRAVEL(XI+2),XRMASK)
XACTIO=TRAVEL(XI+2)/XASHFT
120 XSTRNG=TRAVEL(XI+1)
110 XI=XI+XELNT(XTYPE)
IF(and(I,XDMASK).EQ.DIR) RETURN
IF(and(I,XLFLAG).EQ.0) GO TO 100
1000 FINDXT=.FALSE.
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),
& OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
& OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
& OADV(220),OCAN(220),OREAD(220)
C
COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT,
& NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT,
& TOOLBT,TURNBT,ONBT
COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT,
& WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT,
& TCHBT,VEHBT,SCHBT
C
FWIM=0
DO 1000 I=1,OLNT
IF(((RM.EQ.0).OR.(OROOM(I).NE.RM)) .AND.
& ((ADV.EQ.0).OR.(OADV(I).NE.ADV)) .AND.
& ((CON.EQ.0).OR.(OCAN(I).NE.CON)))
& GO TO 1000
C
C OBJECT IS ON LIST... IS IT A MATCH?
C
IF(and(OFLAG1(I),VISIBT).EQ.0) GO TO 1000
IF(and(not(NOCARE),(and(OFLAG1(I),TAKEBT).EQ.0)) .OR.
& ((and(OFLAG1(I),F1).EQ.0).AND.
& (and(OFLAG2(I),F2).EQ.0))) GO TO 500
IF(FWIM.EQ.0) GO TO 400
FWIM=-FWIM
RETURN
C
400 FWIM=I
C
C DOES OBJECT CONTAIN A MATCH?
C
500 IF(and(OFLAG2(I),OPENBT).EQ.0) GO TO 1000
DO 700 J=1,OLNT
IF((OCAN(J).NE.I).OR.(and(OFLAG1(J),VISIBT).EQ.0) .OR.
& ((and(OFLAG1(J),F1).EQ.0).AND.
& (and(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
CHARACTER ANS
C
100 CALL RSPEAK(Q)
READ(INPCH,110) ANS
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)
GO TO 100
C
200 YESNO=.TRUE.
CALL RSPEAK(Y)
RETURN
C
300 YESNO=.FALSE.
CALL RSPEAK(N)
RETURN
C
END
!Funky!Stuff!
echo x - dso4.for.f
cat >dso4.for.f <<'!Funky!Stuff!'
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),
& OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
& OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
& OADV(220),OCAN(220),OREAD(220)
C
COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT,
& NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT,
& TOOLBT,TURNBT,ONBT
COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT,
& WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT,
& TCHBT,VEHBT,SCHBT
C
ROBADV=0
DO 100 I=1,OLNT
IF((OADV(I).NE.ADV).OR.(OTVAL(I).LE.0).OR.
& (and(OFLAG2(I),SCRDBT).NE.0)) GO TO 100
CALL NEWSTA(I,0,NR,NC,NA)
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),
& OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
& OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
& OADV(220),OCAN(220),OREAD(220)
C
COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT,
& NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT,
& TOOLBT,TURNBT,ONBT
COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT,
& WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT,
& TCHBT,VEHBT,SCHBT
C
ROBRM=0
DO 100 I=1,OLNT
IF(.NOT. QHERE(I,RM)) GO TO 100
IF((OTVAL(I).LE.0).OR.(and(OFLAG2(I),SCRDBT).NE.0).OR.
& (and(OFLAG1(I),VISIBT).EQ.0).OR.(.NOT.PROB(PR,PR)))
& GO TO 50
CALL NEWSTA(I,0,NR,NC,NA)
ROBRM=ROBRM+1
OFLAG2(I)=or(OFLAG2(I),TCHBT)
GO TO 100
50 IF(and(OFLAG2(I),ACTRBT).NE.0)
& 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),
& OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
& OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
& OADV(220),OCAN(220),OREAD(220)
C
VS=OCAPAC(VL)
PS=VS-FIGHTS(HR,.TRUE.)
WINNIN=PROB(90,100)
IF(PS.GT.3) RETURN
WINNIN=PROB(75,85)
IF(PS.GT.0) RETURN
WINNIN=PROB(50,30)
IF(PS.EQ.0) RETURN
WINNIN=PROB(25,25)
IF(VS.GT.1) RETURN
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,
& LTSHFT,BLOC,MUNGRM,HS,EGSCOR,EGMXSC
C
C ADVENTURERS
C
COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4),
& 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),
& OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
& OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
& OADV(220),OCAN(220),OREAD(220)
C
COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT,
& NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT,
& TOOLBT,TURNBT,ONBT
COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT,
& WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT,
& 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,
& DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF,
& MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF,
& EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF,
& GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF,
& GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF,
& MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF,
& 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.
VILSTR=MIN0(VILSTR,2)
C
100 DO 200 I=1,VLNT
IF((VILLNS(I).EQ.V).AND.(PRSI.EQ.VBEST(I)))
& VILSTR=MAX0(1,VILSTR-1)
200 CONTINUE
RETURN
END
!Funky!Stuff!
echo x - dso5.for.f
cat >dso5.for.f <<'!Funky!Stuff!'
C GTTIME-- GET TOTAL TIME PLAYED
C
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),
& OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
& OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
& OADV(220),OCAN(220),OREAD(220)
C
COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT,
& NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT,
& TOOLBT,TURNBT,ONBT
COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT,
& WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT,
& 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)=and(OFLAG2(O),OPENBT).NE.0
C
OPNCLS=.TRUE.
IF(PRSA.EQ.CLOSEW) GO TO 100
IF(PRSA.EQ.OPENW) GO TO 50
OPNCLS=.FALSE.
RETURN
C
50 IF(QOPEN(OBJ)) GO TO 200
CALL RSPEAK(SO)
OFLAG2(OBJ)=or(OFLAG2(OBJ),OPENBT)
RETURN
C
100 IF(.NOT.QOPEN(OBJ)) GO TO 200
CALL RSPEAK(SC)
OFLAG2(OBJ)=and(OFLAG2(OBJ),not(OPENBT))
RETURN
C
200 CALL RSPEAK(125+RND(3))
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),
& RACTIO(200),RVAL(200),RFLAG(200)
INTEGER RRAND(200)
EQUIVALENCE (RVAL,RRAND)
C
COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR,
& RSACRD,RFILL,RMUNG,RBUCK,RHOUSE,RNWALL,REND
C
C OBJECTS
C
COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220),
& OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
& OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
& OADV(220),OCAN(220),OREAD(220)
C
COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT,
& NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT,
& TOOLBT,TURNBT,ONBT
COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT,
& WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT,
& TCHBT,VEHBT,SCHBT
C
C ADVENTURERS
C
COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4),
& AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4)
C
LIT=.TRUE.
IF(and(RFLAG(RM),RLIGHT).NE.0) RETURN
C
DO 1000 I=1,OLNT
IF(QHERE(I,RM)) GO TO 100
OA=OADV(I)
IF(OA.LE.0) GO TO 1000
IF(AROOM(OA).NE.RM) GO TO 1000
C
C OBJ IN ROOM OR ON ADV IN ROOM
C
100 IF(and(OFLAG1(I),ONBT).NE.0) RETURN
IF((and(OFLAG1(I),VISIBT).EQ.0).OR.
& ((and(OFLAG1(I),TRANBT).EQ.0).AND.
& (and(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.(and(OFLAG1(J),ONBT).NE.0))
& 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),
& OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
& OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
& OADV(220),OCAN(220),OREAD(220)
C
WEIGHT=0
DO 100 I=1,OLNT
IF(OSIZE(I).GE.10000) GO TO 100
IF((QHERE(I,RM).AND.(RM.NE.0)).OR.
& ((OADV(I).EQ.AD).AND.(AD.NE.0))) GO TO 50
J=I
25 J=OCAN(J)
IF(J.EQ.0) GO TO 100
IF(J.NE.CN) GO TO 25
50 WEIGHT=WEIGHT+OSIZE(I)
100 CONTINUE
RETURN
END
!Funky!Stuff!
echo x - dso6.for.f
cat >dso6.for.f <<'!Funky!Stuff!'
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),
& RACTIO(200),RVAL(200),RFLAG(200)
INTEGER RRAND(200)
EQUIVALENCE (RVAL,RRAND)
C
COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR,
& 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.
GO TO (1000,1000,1000,1000,1000,1000,
& 1000,1000,1000,1000,1000,
& 2000,3000,4000,5000,5000,5000,6000,
& 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=and(RFLAG(RM),(RWATER+RFILL)).NE.0
RETURN
C
C 7000-- GLOBAL GUARDIANS
C
7000 GHERE=((RM.GE.MRC).AND.(RM.LE.MRD)).OR.
& ((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
9000 GHERE=((RM.GE.MRA).AND.(RM.LE.MRC)).OR.
& ((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.
& (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,
& DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF,
& MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF,
& EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF,
& GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF,
& GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF,
& MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF,
& 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
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.
& ((RM.GT.MLOC).AND.(MDIR.GT.180))) MRHERE=2
RETURN
END
!Funky!Stuff!
echo x - dso7.f
cat >dso7.f <<'!Funky!Stuff!'
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)
CHARACTER KEYW(6),UKEYW(6)
INTEGER UINW(6)
DATA KEYW/'E','C','O','R','M','S'/
C
UINWS=0
UKEYWS=0
J=1
DO 100 I=1,6
UKEYW(I)=char(ichar(KEYW(I))-64)
IF(INW(J).LE.char(64)) J=1
UINW(I)=ichar(ichar(INW(J))-64)
UKEYWS=UKEYWS+ichar(UKEYW(I))
UINWS=UINWS+UINW(I)
J=J+1
100 CONTINUE
C
USUM=MOD(UINWS,8)+(8*MOD(UKEYWS,8))
DO 200 I=1,6
J=and(xor(xor(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),
& RACTIO(200),RVAL(200),RFLAG(200)
INTEGER RRAND(200)
EQUIVALENCE (RVAL,RRAND)
C
COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR,
& 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),
& OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
& OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
& OADV(220),OCAN(220),OREAD(220)
C
COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT,
& NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT,
& TOOLBT,TURNBT,ONBT
COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT,
& WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT,
& 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,
& DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF,
& MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF,
& EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF,
& GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF,
& GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF,
& MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF,
& 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)=and(RFLAG(CPUZZ),not(RSEEN))
DO 100 I=1,OLNT
IF((OROOM(I).EQ.CPUZZ).AND.
& (and(OFLAG2(I),(ACTRBT+VILLBT)).EQ.0))
& CALL NEWSTA(I,0,CPHERE*HFACTR,0,0)
IF(OROOM(I).EQ.(ST*HFACTR))
& 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 DGM(8),PICT(5),QMK
C
COMMON /CHAN/ INPCH,OUTCH,DBCH
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,
& DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF,
& MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF,
& EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF,
& GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF,
& GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF,
& MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF,
& 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
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)
IF((IABS(J).EQ.1).OR.(IABS(J).EQ.8)) GO TO 100
K=8
IF(J.LT.0) K=-8
L=J-K
IF((CPVEC(ST+K).NE.0).AND.(CPVEC(ST+L).NE.0))
& DGM(I)=QMK
100 CONTINUE
WRITE(OUTCH,10) DGM
C
IF(ST.EQ.10) CALL RSPEAK(870)
IF(ST.EQ.37) CALL RSPEAK(871)
I=872
IF(CPOUTF) I=873
IF(ST.EQ.52) CALL RSPEAK(I)
IF(CPVEC(ST+1).EQ.-2) CALL RSPEAK(874)
IF(CPVEC(ST-1).EQ.-3) CALL RSPEAK(875)
RETURN
C
10 FORMAT(' |',A2,1X,A2,1X,A2,'|'/,
& ' West |',A2,' .. ',A2,'| East',/
& ' |',A2,1X,A2,1X,A2,'|')
C
END
!Funky!Stuff!
exit 0
--
-Bill Randle
Tektronix, Inc.
bi...@tekred.TEK.COM