billr@tekred.UUCP (Bill Randle) (01/10/87)
# The rest of this file is a shell script which will extract:
# Makefile README act.1 actors.ftn.f ballop.for.f clockr.ftn.f demons.ftn.f dgame.f
echo x - Makefile
cat >Makefile <<'!Funky!Stuff!'
# Makefile for creating dungeon
.c.o:
cc -c -O $*.c
.f.o:
f77 -c -O $*.f
.F.o:
f77 -c $(FFLAGS) $*.F
# f77 compiler flags for files run thru C preprocessor
FFLAGS = -O -Dvax # -Ddebug
# Directory path for data files - default is /usr/games/lib/dunlib
DDIR = .
OBJS = actors.ftn.o ballop.for.o clockr.ftn.o demons.ftn.o\
dgame.o dinit.ftn.o dmain.ftn.o dso1.for.o dso2.for.o\
dso3.for.o dso4.for.o dso5.for.o dso6.for.o dso7.o\
dsub.ftn.o dverb1.o dverb2.o gdt.ftn.o lightp.for.o\
nobjs.for.o np.o np1.o np2.o np3.for.o nrooms.for.o objcts.o\
rooms.for.o rtim.o sobjs.o sverbs.ftn.o verbs.o villns.for.o
dungeon: $(OBJS)
f77 -o dungeon $(OBJS)
dinit.ftn.o: dinit.ftn.F
### to use other than default directory, uncomment following line
###
### f77 -O -DINDXFILE=\'$(DDIR)/dindx.dat\' -DTEXTFILE=\'$(DDIR)/dtext.dat\' -c dinit.ftn.F
install: dungeon
cp dungeon /usr/games/dungeon
-mkdir /usr/games/lib/dunlib
cp dindx.dat dtext.dat /usr/games/lib/dunlib
!Funky!Stuff!
echo x - README
cat >README <<'!Funky!Stuff!'
.../dungeon/vax
This directory contains the files to build a vax version
of the dungeon game. The vax version requires large addressing
capability (the object size is 151.5K stripped). This
version has full save/restore as well as the game debugging
tool.
Files that end in '.f' are standard f77 files; files that end in
'.F' have C-preprocessor #ifdefs in them (handled automatically
by the f77 compiler). Of the '.F' files, only one actually
has an "#ifdef vax" in it; the others have debugging #ifdefs
in them. The "#ifdef vax" is used in the file "dsub.ftn.F" and
is used to change the byte ordering from pdp to vax when
reading the data file.
!Funky!Stuff!
echo x - act.1
cat >act.1 <<'!Funky!Stuff!'
Usage: uuencode [infile] remotefile
!Funky!Stuff!
echo x - actors.ftn.f
cat >actors.ftn.f <<'!Funky!Stuff!'
C AAPPLI- APPLICABLES FOR ADVENTURERS
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 AAPPLI(RI)
IMPLICIT INTEGER (A-Z)
LOGICAL F,MOVETO
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 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 /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 /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 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 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 AAPPLI, PAGE 2
C
IF(RI.EQ.0) GO TO 10
AAPPLI=.TRUE.
GO TO (1000,2000),RI
CALL BUG(11,RI)
C
C COMMON FALSE RETURN.
C
10 AAPPLI=.FALSE.
RETURN
C
C A1-- ROBOT. PROCESS MOST COMMANDS GIVEN TO ROBOT.
C
1000 IF((PRSA.NE.RAISEW).OR.(PRSO.NE.RCAGE)) GO TO 1200
CFLAG(CEVSPH)=.FALSE.
WINNER=PLAYER
F=MOVETO(CAGER,WINNER)
CALL NEWSTA(CAGE,567,CAGER,0,0)
CALL NEWSTA(ROBOT,0,CAGER,0,0)
AROOM(AROBOT)=CAGER
CAGESF=.TRUE.
OFLAG1(ROBOT)=and(OFLAG1(ROBOT),not(NDSCBT))
OFLAG1(SPHER)=or(OFLAG1(SPHER),TAKEBT)
RETURN
C
1200 IF((PRSA.NE.DRINKW).AND.(PRSA.NE.EATW)) GO TO 1300
CALL RSPEAK(568)
RETURN
C
1300 IF(PRSA.NE.READW) GO TO 1400
CALL RSPEAK(569)
RETURN
C
1400 IF((PRSA.EQ.WALKW).OR.(PRSA.EQ.TAKEW).OR.(PRSA.EQ.DROPW)
& .OR.(PRSA.EQ.PUTW).OR.(PRSA.EQ.PUSHW).OR.(PRSA.EQ.THROWW)
& .OR.(PRSA.EQ.TURNW).OR.(PRSA.EQ.LEAPW)) GO TO 10
CALL RSPEAK(570)
RETURN
C AAPPLI, PAGE 3
C
C A2-- MASTER. PROCESS MOST COMMANDS GIVEN TO MASTER.
C
2000 IF(and(OFLAG2(QDOOR),OPENBT).NE.0) GO TO 2100
CALL RSPEAK(783)
RETURN
C
2100 IF(PRSA.NE.WALKW) GO TO 2200
I=784
IF(((HERE.EQ.SCORR).AND.
& ((PRSO.EQ.XNORTH).OR.(PRSO.EQ.XENTER))).OR.
& ((HERE.EQ.NCORR).AND.
& ((PRSO.EQ.XSOUTH).OR.(PRSO.EQ.XENTER))))
& I=785
CALL RSPEAK(I)
RETURN
C
2200 IF((PRSA.EQ.TAKEW).OR.(PRSA.EQ.DROPW).OR.(PRSA.EQ.PUTW).OR.
& (PRSA.EQ.THROWW).OR.(PRSA.EQ.PUSHW).OR.(PRSA.EQ.TURNW).OR.
& (PRSA.EQ.SPINW).OR.(PRSA.EQ.TRNTOW).OR.(PRSA.EQ.FOLLOW).OR.
& (PRSA.EQ.STAYW).OR.(PRSA.EQ.OPENW).OR.(PRSA.EQ.CLOSEW).OR.
& (PRSA.EQ.KILLW)) GO TO 10
CALL RSPEAK(786)
RETURN
C
END
C THIEFD- INTERMOVE THIEF DEMON
C
C DECLARATIONS
C
SUBROUTINE THIEFD
IMPLICIT INTEGER (A-Z)
LOGICAL DFLAG,ONCE,PROB,QHERE,QSTILL,LIT,WINNIN
C
C GAME STATE
C
LOGICAL TELFLG
COMMON /PLAY/ WINNER,HERE,TELFLG
C
COMMON /DEBUG/ DBGFLG,PRSFLG
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
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 VILLAINS AND DEMONS
C
LOGICAL THFFLG,SWDACT,THFACT
COMMON /HACK/ THFPOS,THFFLG,THFACT,SWDACT,SWDSTA
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
QSTILL(R)=(QHERE(STILL,R).OR.(OADV(STILL).EQ.-THIEF))
C THIEFD, PAGE 2
C
C D DFLAG=(PRSFLG.AND."100000).NE.0
ONCE=.FALSE.
1025 RHERE=OROOM(THIEF)
IF(RHERE.NE.0) THFPOS=RHERE
C
IF(THFPOS.EQ.HERE) GO TO 1100
IF(THFPOS.NE.TREAS) GO TO 1400
C
C THIEF IS IN TREASURE ROOM, AND WINNER IS NOT.
C
C D IF(DFLAG) TYPE 10
C D10 FORMAT(' THIEFD-- IN TREASURE ROOM')
IF(RHERE.EQ.0) GO TO 1050
CALL NEWSTA(THIEF,0,0,0,0)
RHERE=0
IF(QSTILL(TREAS)) CALL NEWSTA(STILL,0,0,THIEF,0)
1050 I=ROBADV(-THIEF,THFPOS,0,0)
IF(QHERE(EGG,THFPOS)) OFLAG2(EGG)=or(OFLAG2(EGG),OPENBT)
GO TO 1700
C
C THIEF AND WINNER IN SAME ROOM.
C
1100 IF(THFPOS.EQ.TREAS) GO TO 1700
IF(and(RFLAG(THFPOS),RLIGHT).NE.0) GO TO 1400
C D IF(DFLAG) TYPE 20
C D20 FORMAT(' THIEFD-- IN ADV ROOM')
IF(THFFLG) GO TO 1300
IF((RHERE.NE.0).OR.PROB(70,70)) GO TO 1150
IF(OCAN(STILL).NE.THIEF) GO TO 1700
CALL NEWSTA(THIEF,583,THFPOS,0,0)
THFFLG=.TRUE.
RETURN
C
1150 IF((RHERE.EQ.0).OR.(and(OFLAG2(THIEF),FITEBT).EQ.0))
& GO TO 1200
IF(WINNIN(THIEF,WINNER)) GO TO 1175
CALL NEWSTA(THIEF,584,0,0,0)
OFLAG2(THIEF)=and(OFLAG2(THIEF), not(FITEBT))
IF(QSTILL(THFPOS)) CALL NEWSTA(STILL,0,0,THIEF,0)
RETURN
C
1175 IF(PROB(90,90)) GO TO 1700
C
1200 IF((RHERE.EQ.0).OR.PROB(70,70)) GO TO 1250
CALL NEWSTA(THIEF,585,0,0,0)
IF(QSTILL(THFPOS)) CALL NEWSTA(STILL,0,0,THIEF,0)
RETURN
C
1300 IF(RHERE.EQ.0) GO TO 1700
1250 IF(PROB(70,70)) RETURN
THFFLG=.TRUE.
NR=ROBRM(THFPOS,100,0,0,-THIEF)+ROBADV(WINNER,0,0,-THIEF)
I=586
IF(RHERE.NE.0) I=588
IF(NR.NE.0) I=I+1
CALL NEWSTA(THIEF,I,0,0,0)
IF(QSTILL(THFPOS))
& CALL NEWSTA(STILL,0,0,THIEF,0)
IF((NR.NE.0).AND..NOT.LIT(THFPOS)) CALL RSPEAK(406)
RHERE=0
GO TO 1700
C
C NOT IN ADVENTURERS ROOM.
C
1400 CALL NEWSTA(THIEF,0,0,0,0)
RHERE=0
C D IF(DFLAG) TYPE 30,THFPOS
C D30 FORMAT(' THIEFD-- IN ROOM ',I4)
IF(QSTILL(THFPOS))
& CALL NEWSTA(STILL,0,0,THIEF,0)
IF(and(RFLAG(THFPOS),RSEEN).EQ.0) GO TO 1700
I=ROBRM(THFPOS,75,0,0,-THIEF)
IF((THFPOS.LT.MAZE1).OR.(THFPOS.GT.MAZ15).OR.
& (HERE.LT.MAZE1).OR.(HERE.GT.MAZ15)) GO TO 1500
DO 1450 I=1,OLNT
IF(.NOT.QHERE(I,THFPOS).OR.PROB(60,60).OR.
& (and(OFLAG1(I),(VISIBT+TAKEBT)).NE.(VISIBT+TAKEBT)))
& GO TO 1450
CALL RSPSUB(590,ODESC2(I))
IF(PROB(40,20)) GO TO 1700
CALL NEWSTA(I,0,0,0,-THIEF)
OFLAG2(I)=or(OFLAG2(I),TCHBT)
GO TO 1700
1450 CONTINUE
GO TO 1700
C
1500 DO 1550 I=1,OLNT
IF(.NOT.QHERE(I,THFPOS).OR.(OTVAL(I).NE.0).OR.PROB(80,60).OR.
& (and(OFLAG1(I),(VISIBT+TAKEBT)).NE.(VISIBT+TAKEBT)))
& GO TO 1550
CALL NEWSTA(I,0,0,0,-THIEF)
OFLAG2(I)=or(OFLAG2(I),TCHBT)
GO TO 1700
1550 CONTINUE
C
C NOW MOVE TO NEW ROOM.
C
1700 IF(OADV(ROPE).EQ.-THIEF) DOMEF=.FALSE.
IF(ONCE) GO TO 1800
ONCE=.NOT.ONCE
1750 THFPOS=THFPOS-1
IF(THFPOS.LE.0) THFPOS=RLNT
IF(and(RFLAG(THFPOS),(RLAND+RSACRD+REND)).NE.RLAND)
& GO TO 1750
THFFLG=.FALSE.
GO TO 1025
C
C ALL DONE.
C
1800 IF(THFPOS.EQ.TREAS) RETURN
J=591
IF(THFPOS.NE.HERE) J=0
DO 1850 I=1,OLNT
IF((OADV(I).NE.-THIEF).OR.PROB(70,70).OR.
& (OTVAL(I).GT.0)) GO TO 1850
CALL NEWSTA(I,J,THFPOS,0,0)
J=0
1850 CONTINUE
RETURN
C
END
!Funky!Stuff!
echo x - ballop.for.f
cat >ballop.for.f <<'!Funky!Stuff!'
C BALLOP- BALLOON FUNCTION
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 BALLOP(ARG)
IMPLICIT INTEGER (A-Z)
LOGICAL FINDXT,QEMPTY
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,
& LTSHFT,BLOC,MUNGRM,HS,EGSCOR,EGMXSC
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 EXITS
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 /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 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 BALLOP, PAGE 2
C
BALLOP=.TRUE.
IF(ARG.NE.2) GO TO 200
IF(PRSA.NE.LOOKW) GO TO 10
IF(BINFF.NE.0) GO TO 50
CALL RSPEAK(543)
GO TO 100
50 CALL RSPSUB(544,ODESC2(BINFF))
100 IF(BTIEF.NE.0) CALL RSPEAK(545)
RETURN
C
200 IF(ARG.NE.1) GO TO 500
IF(PRSA.NE.WALKW) GO TO 300
IF(FINDXT(PRSO,HERE)) GO TO 250
CALL RSPEAK(546)
RETURN
C
250 IF(BTIEF.EQ.0) GO TO 275
CALL RSPEAK(547)
RETURN
C
275 IF(XTYPE.NE.XNORM) GO TO 10
IF(and(RFLAG(XROOM1),RMUNG).EQ.0) BLOC=XROOM1
10 BALLOP=.FALSE.
RETURN
C
300 IF((PRSA.NE.TAKEW).OR.(PRSO.NE.BINFF)) GO TO 350
CALL RSPSUB(548,ODESC2(BINFF))
RETURN
C
350 IF((PRSA.NE.PUTW).OR.(PRSI.NE.RECEP).OR.QEMPTY(RECEP))
& GO TO 10
CALL RSPEAK(549)
RETURN
C
500 IF((PRSA.NE.UNBOAW).OR.(and(RFLAG(HERE),RLAND).EQ.0))
& GO TO 600
IF(BINFF.NE.0) CTICK(CEVBAL)=3
GO TO 10
C
600 IF((PRSA.NE.BURNW).OR.(OCAN(PRSO).NE.RECEP)) GO TO 700
CALL RSPSUB(550,ODESC2(PRSO))
CTICK(CEVBRN)=OSIZE(PRSO)*20
OFLAG1(PRSO)=or(OFLAG1(PRSO),
& and((ONBT+FLAMBT+LITEBT), not(TAKEBT+READBT)))
IF(BINFF.NE.0) RETURN
IF(.NOT.BLABF) CALL NEWSTA(BLABE,0,0,BALLO,0)
BLABF=.TRUE.
BINFF=PRSO
CTICK(CEVBAL)=3
CALL RSPEAK(551)
RETURN
C
700 IF((PRSA.EQ.UNBOAW).AND.(BINFF.NE.0).AND.
& (and(RFLAG(HERE),RLAND).NE.0))
& CTICK(CEVBAL)=3
GO TO 10
C
END
!Funky!Stuff!
echo x - clockr.ftn.f
cat >clockr.ftn.f <<'!Funky!Stuff!'
C CEVAPP- CLOCK EVENT APPLICABLES
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 CEVAPP(RI)
IMPLICIT INTEGER (A-Z)
INTEGER CNDTCK(10),LMPTCK(12)
LOGICAL FINDXT,LIT,RMDESC,QOPEN,MOVETO
LOGICAL F,QLEDGE,QVAIR,QHERE,PROB
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 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
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 EXITS
C
COMMON /CURXT/ XTYPE,XROOM1,XSTRNG,XACTIO,XOBJ
EQUIVALENCE (XFLAG,XOBJ)
C
COMMON /XSRCH/ XMIN,XMAX,XDOWN,XUP,
& XNORTH,XSOUTH,XENTER,XEXIT,XEAST,XWEST
C
C VILLAINS AND DEMONS
C
LOGICAL THFFLG,SWDACT,THFACT
COMMON /HACK/ THFPOS,THFFLG,THFACT,SWDACT,SWDSTA
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
C
C FUNCTIONS AND DATA
C
QOPEN(R)=(and(OFLAG2(R),OPENBT)).NE.0
QLEDGE(R)=(R.EQ.LEDG2).OR.(R.EQ.LEDG3).OR.(R.EQ.LEDG4).OR.
& (R.EQ.VLBOT)
QVAIR(R)=(R.EQ.VAIR1).OR.(R.EQ.VAIR2).OR.(R.EQ.VAIR3).OR.
& (R.EQ.VAIR4)
DATA CNDTCK/50,20,10,5,0,156,156,156,157,0/
DATA LMPTCK/50,30,20,10,4,0,154,154,154,154,155,0/
C CEVAPP, PAGE 2
C
IF(RI.EQ.0) RETURN
GO TO (1000,2000,3000,4000,5000,6000,7000,8000,9000,10000,
& 11000,12000,13000,14000,15000,16000,17000,18000,19000,
& 20000,21000,22000,23000,24000),RI
CALL BUG(3,RI)
C
C CEV1-- CURE CLOCK. LET PLAYER SLOWLY RECOVER.
C
1000 ASTREN(PLAYER)=MIN0(0,ASTREN(PLAYER)+1)
IF(ASTREN(PLAYER).GE.0) RETURN
CTICK(CEVCUR)=30
RETURN
C
C CEV2-- MAINT-ROOM WITH LEAK. RAISE THE WATER LEVEL.
C
2000 IF(HERE.EQ.MAINT) CALL RSPEAK(71+(RVMNT/2))
RVMNT=RVMNT+1
IF(RVMNT.LE.16) RETURN
CTICK(CEVMNT)=0
RFLAG(MAINT)=or(RFLAG(MAINT),RMUNG)
RRAND(MAINT)=80
IF(HERE.EQ.MAINT) CALL JIGSUP(81)
RETURN
C
C CEV3-- LANTERN. DESCRIBE GROWING DIMNESS.
C
3000 CALL LITINT(LAMP,ORLAMP,CEVLNT,LMPTCK,12)
RETURN
C
C CEV4-- MATCH. OUT IT GOES.
C
4000 CALL RSPEAK(153)
OFLAG1(MATCH)=and(OFLAG1(MATCH), not(ONBT))
RETURN
C
C CEV5-- CANDLE. DESCRIBE GROWING DIMNESS.
C
5000 CALL LITINT(CANDL,ORCAND,CEVCND,CNDTCK,10)
RETURN
C CEVAPP, PAGE 3
C
C CEV6-- BALLOON
C
6000 CTICK(CEVBAL)=3
F=AVEHIC(WINNER).EQ.BALLO
IF(BLOC.EQ.VLBOT) GO TO 6800
IF(QLEDGE(BLOC)) GO TO 6700
IF(QOPEN(RECEP).AND.(BINFF.NE.0))
& GO TO 6500
C
C BALLOON IS IN MIDAIR AND IS DEFLATED (OR HAS RECEPTACLE CLOSED).
C FALL TO NEXT ROOM.
C
IF(BLOC.NE.VAIR1) GO TO 6300
BLOC=VLBOT
CALL NEWSTA(BALLO,0,BLOC,0,0)
IF(F) GO TO 6200
IF(QLEDGE(HERE)) CALL RSPEAK(530)
RETURN
C
6200 F=MOVETO(BLOC,WINNER)
IF(BINFF.EQ.0) GO TO 6250
CALL RSPEAK(531)
F=RMDESC(0)
RETURN
C
6250 CALL NEWSTA(BALLO,532,0,0,0)
CALL NEWSTA(DBALL,0,BLOC,0,0)
AVEHIC(WINNER)=0
CFLAG(CEVBAL)=.FALSE.
CFLAG(CEVBRN)=.FALSE.
BINFF=0
BTIEF=0
RETURN
C
6300 BLOC=BLOC-1
CALL NEWSTA(BALLO,0,BLOC,0,0)
IF(F) GO TO 6400
IF(QLEDGE(HERE)) CALL RSPEAK(533)
RETURN
C
6400 F=MOVETO(BLOC,WINNER)
CALL RSPEAK(534)
F=RMDESC(0)
RETURN
C
C BALLOON IS IN MIDAIR AND IS INFLATED, UP-UP-AND-AWAY
C
6500 IF(BLOC.NE.VAIR4) GO TO 6600
CTICK(CEVBRN)=0
CTICK(CEVBAL)=0
BINFF=0
BTIEF=0
BLOC=VLBOT
CALL NEWSTA(BALLO,0,0,0,0)
CALL NEWSTA(DBALL,0,BLOC,0,0)
IF(F) GO TO 6550
IF(QLEDGE(HERE)) CALL RSPEAK(535)
RETURN
C
6550 CALL JIGSUP(536)
RETURN
C
6600 BLOC=BLOC+1
CALL NEWSTA(BALLO,0,BLOC,0,0)
IF(F) GO TO 6650
IF(QLEDGE(HERE)) CALL RSPEAK(537)
RETURN
C
6650 F=MOVETO(BLOC,WINNER)
CALL RSPEAK(538)
F=RMDESC(0)
RETURN
C
C ON LEDGE, GOES TO MIDAIR ROOM WHETHER INFLATED OR NOT.
C
6700 BLOC=BLOC+(VAIR2-LEDG2)
CALL NEWSTA(BALLO,0,BLOC,0,0)
IF(F) GO TO 6750
IF(QLEDGE(HERE)) CALL RSPEAK(539)
CTICK(CEVVLG)=10
RETURN
C
6750 F=MOVETO(BLOC,WINNER)
CALL RSPEAK(540)
F=RMDESC(0)
RETURN
C
C AT BOTTOM, GO UP IF INFLATED, DO NOTHING IF DEFLATED.
C
6800 IF((BINFF.EQ.0).OR..NOT.QOPEN(RECEP)) RETURN
BLOC=VAIR1
CALL NEWSTA(BALLO,0,BLOC,0,0)
IF(F) GO TO 6850
IF(QLEDGE(HERE)) CALL RSPEAK(541)
RETURN
C
6850 F=MOVETO(BLOC,WINNER)
CALL RSPEAK(542)
F=RMDESC(0)
RETURN
C CEVAPP, PAGE 4
C
C CEV7-- BALLOON BURNUP
C
7000 DO 7100 I=1,OLNT
IF((RECEP.EQ.OCAN(I)).AND.((and(OFLAG1(I),FLAMBT)).NE.0))
& GO TO 7200
7100 CONTINUE
CALL BUG(4,0)
C
7200 CALL NEWSTA(I,0,0,0,0)
BINFF=0
IF(HERE.EQ.BLOC) CALL RSPSUB(292,ODESC2(I))
RETURN
C
C CEV8-- FUSE FUNCTION
C
8000 IF(OCAN(FUSE).NE.BRICK) GO TO 8500
BR=OROOM(BRICK)
BC=OCAN(BRICK)
IF((BR.EQ.0).AND.(BC.NE.0)) BR=OROOM(BC)
CALL NEWSTA(FUSE,0,0,0,0)
CALL NEWSTA(BRICK,0,0,0,0)
IF((BR.NE.0).AND.(BR.NE.HERE)) GO TO 8100
C
RFLAG(HERE)=or(RFLAG(HERE),RMUNG)
RRAND(HERE)=114
CALL JIGSUP(150)
RETURN
C
8100 CALL RSPEAK(151)
MUNGRM=BR
CTICK(CEVSAF)=5
IF(BR.NE.MSAFE) GO TO 8200
IF(BC.NE.SSLOT) RETURN
CALL NEWSTA(SSLOT,0,0,0,0)
OFLAG2(SAFE)=or(OFLAG2(SAFE),OPENBT)
SAFEF=.TRUE.
RETURN
C
8200 DO 8250 I=1,OLNT
IF(QHERE(I,BR) .AND. ((and(OFLAG1(I),TAKEBT)).NE.0))
& CALL NEWSTA(I,0,0,0,0)
8250 CONTINUE
IF(BR.NE.LROOM) RETURN
DO 8300 I=1,OLNT
IF(OCAN(I).EQ.TCASE) CALL NEWSTA(I,0,0,0,0)
8300 CONTINUE
RETURN
C
8500 IF(QHERE(FUSE,HERE).OR.(OADV(FUSE).EQ.WINNER))
& CALL RSPEAK(152)
CALL NEWSTA(FUSE,0,0,0,0)
RETURN
C CEVAPP, PAGE 5
C
C CEV9-- LEDGE MUNGE.
C
9000 RFLAG(LEDG4)=or(RFLAG(LEDG4),RMUNG)
RRAND(LEDG4)=109
IF(HERE.EQ.LEDG4) GO TO 9100
CALL RSPEAK(110)
RETURN
C
9100 IF(AVEHIC(WINNER).NE.0) GO TO 9200
CALL JIGSUP(111)
RETURN
C
9200 IF(BTIEF.NE.0) GO TO 9300
CALL RSPEAK(112)
RETURN
C
9300 BLOC=VLBOT
CALL NEWSTA(BALLO,0,0,0,0)
CALL NEWSTA(DBALL,0,BLOC,0,0)
BTIEF=0
BINFF=0
CFLAG(CEVBAL)=.FALSE.
CFLAG(CEVBRN)=.FALSE.
CALL JIGSUP(113)
RETURN
C
C CEV10-- SAFE MUNG.
C
10000 RFLAG(MUNGRM)=or(RFLAG(MUNGRM),RMUNG)
RRAND(MUNGRM)=114
IF(HERE.EQ.MUNGRM) GO TO 10100
CALL RSPEAK(115)
IF(MUNGRM.EQ.MSAFE) CTICK(CEVLED)=8
RETURN
C
10100 I=116
IF((and(RFLAG(HERE),RHOUSE)).NE.0) I=117
CALL JIGSUP(I)
RETURN
C CEVAPP, PAGE 6
C
C CEV11-- VOLCANO GNOME
C
11000 IF(QLEDGE(HERE)) GO TO 11100
CTICK(CEVVLG)=1
RETURN
C
11100 CALL NEWSTA(GNOME,118,HERE,0,0)
RETURN
C
C CEV12-- VOLCANO GNOME DISAPPEARS
C
12000 CALL NEWSTA(GNOME,149,0,0,0)
RETURN
C
C CEV13-- BUCKET.
C
13000 IF(OCAN(WATER).EQ.BUCKE)
& CALL NEWSTA(WATER,0,0,0,0)
RETURN
C
C CEV14-- SPHERE. IF EXPIRES, HE'S TRAPPED.
C
14000 RFLAG(CAGER)=or(RFLAG(CAGER),RMUNG)
RRAND(CAGER)=147
CALL JIGSUP(148)
RETURN
C
C CEV15-- END GAME HERALD.
C
15000 ENDGMF=.TRUE.
CALL RSPEAK(119)
RETURN
C CEVAPP, PAGE 7
C
C CEV16-- FOREST MURMURS
C
16000 CFLAG(CEVFOR)=(HERE.EQ.MTREE).OR.
& ((HERE.GE.FORE1).AND.(HERE.LT.CLEAR))
IF(CFLAG(CEVFOR).AND.PROB(10,10)) CALL RSPEAK(635)
RETURN
C
C CEV17-- SCOL ALARM
C
17000 IF(HERE.EQ.BKTWI) CFLAG(CEVZGI)=.TRUE.
IF(HERE.EQ.BKVAU) CALL JIGSUP(636)
RETURN
C
C CEV18-- ENTER GNOME OF ZURICH
C
18000 CFLAG(CEVZGO)=.TRUE.
CALL NEWSTA(ZGNOM,0,BKTWI,0,0)
IF(HERE.EQ.BKTWI) CALL RSPEAK(637)
RETURN
C
C CEV19-- EXIT GNOME
C
19000 CALL NEWSTA(ZGNOM,0,0,0,0)
IF(HERE.EQ.BKTWI) CALL RSPEAK(638)
RETURN
C CEVAPP, PAGE 8
C
C CEV20-- START OF ENDGAME
C
20000 IF(SPELLF) GO TO 20200
IF(HERE.NE.CRYPT) RETURN
IF(.NOT.LIT(HERE)) GO TO 20100
CTICK(CEVSTE)=3
RETURN
C
20100 CALL RSPEAK(727)
20200 DO 20300 I=1,OLNT
CALL NEWSTA(I,0,OROOM(I),OCAN(I),0)
20300 CONTINUE
CALL NEWSTA(LAMP,0,0,0,PLAYER)
CALL NEWSTA(SWORD,0,0,0,PLAYER)
C
OFLAG1(LAMP)=and((or(OFLAG1(LAMP),LITEBT)), not(ONBT))
OFLAG2(LAMP)=or(OFLAG2(LAMP),TCHBT)
CFLAG(CEVLNT)=.FALSE.
CTICK(CEVLNT)=350
ORLAMP=0
OFLAG2(SWORD)=or(OFLAG2(SWORD),TCHBT)
SWDACT=.TRUE.
SWDSTA=0
C
THFACT=.FALSE.
ENDGMF=.TRUE.
CFLAG(CEVMAT)=.FALSE.
CFLAG(CEVCND)=.FALSE.
C
CALL SCRUPD(RVAL(CRYPT))
RVAL(CRYPT)=0
F=MOVETO(TSTRS,WINNER)
F=RMDESC(3)
RETURN
C
C CEV21-- MIRROR CLOSES.
C
21000 MRPSHF=.FALSE.
MROPNF=.FALSE.
IF(HERE.EQ.MRANT) CALL RSPEAK(728)
IF((HERE.EQ.INMIR).OR.(MRHERE(HERE).EQ.1))
& CALL RSPEAK(729)
RETURN
C CEVAPP, PAGE 9
C
C CEV22-- DOOR CLOSES.
C
22000 IF(WDOPNF) CALL RSPEAK(730)
WDOPNF=.FALSE.
RETURN
C
C CEV23-- INQUISITOR'S QUESTION
C
23000 IF(AROOM(PLAYER).NE.FDOOR) RETURN
CALL RSPEAK(769)
CALL RSPEAK(770+QUESNO)
CTICK(CEVINQ)=2
RETURN
C
C CEV24-- MASTER FOLLOWS
C
24000 IF(AROOM(AMASTR).EQ.HERE) RETURN
IF((HERE.NE.CELL).AND.(HERE.NE.PCELL)) GO TO 24100
IF(FOLLWF) CALL RSPEAK(811)
FOLLWF=.FALSE.
RETURN
C
24100 FOLLWF=.TRUE.
I=812
DO 24200 J=XMIN,XMAX,XMIN
IF(FINDXT(J,AROOM(AMASTR)).AND.(XROOM1.EQ.HERE))
& I=813
24200 CONTINUE
CALL RSPEAK(I)
CALL NEWSTA(MASTER,0,HERE,0,0)
AROOM(AMASTR)=HERE
RETURN
C
END
C LITINT- LIGHT INTERRUPT PROCESSOR
C
C DECLARATIONS
C
SUBROUTINE LITINT(OBJ,CTR,CEV,TICKS,TICKLN)
IMPLICIT INTEGER (A-Z)
INTEGER TICKS(TICKLN)
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 CLOCK INTERRUPTS
C
LOGICAL CFLAG
COMMON /CEVENT/ CLNT,CTICK(25),CACTIO(25),CFLAG(25)
C
CTR=CTR+1
CTICK(CEV)=TICKS(CTR)
IF(CTICK(CEV).NE.0) GO TO 100
OFLAG1(OBJ)=and(OFLAG1(OBJ), not(LITEBT+FLAMBT+ONBT))
IF((OROOM(OBJ).EQ.HERE).OR.(OADV(OBJ).EQ.WINNER))
& CALL RSPSUB(293,ODESC2(OBJ))
RETURN
C
100 IF((OROOM(OBJ).EQ.HERE).OR.(OADV(OBJ).EQ.WINNER))
& CALL RSPEAK(TICKS(CTR+(TICKLN/2)))
RETURN
C
END
!Funky!Stuff!
echo x - demons.ftn.f
cat >demons.ftn.f <<'!Funky!Stuff!'
C FIGHTD- INTERMOVE FIGHT DEMON
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 FIGHTD
IMPLICIT INTEGER (A-Z)
LOGICAL PROB,OAPPLI
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 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
C VILLAINS AND DEMONS
C
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
LOGICAL F
C
C FUNCTIONS AND DATA
C
DATA ROUT/1/
C FIGHTD, PAGE 2
C
DO 2400 I=1,VLNT
VOPPS(I)=0
OBJ=VILLNS(I)
RA=OACTIO(OBJ)
IF(HERE.NE.OROOM(OBJ)) GO TO 2200
IF((OBJ.EQ.THIEF).AND.THFENF) GO TO 2400
IF(OCAPAC(OBJ).GE.0) GO TO 2050
IF((VPROB(I).EQ.0).OR..NOT.PROB(VPROB(I),VPROB(I)))
& GO TO 2025
OCAPAC(OBJ)=IABS(OCAPAC(OBJ))
VPROB(I)=0
IF(RA.EQ.0) GO TO 2400
PRSA=INXW
F=OAPPLI(RA,0)
GO TO 2400
C
2025 VPROB(I)=VPROB(I)+10
GO TO 2400
C
2050 IF((and(OFLAG2(OBJ),FITEBT)).EQ.0) GO TO 2100
VOPPS(I)=OBJ
GO TO 2400
C
2100 IF(RA.EQ.0) GO TO 2400
PRSA=FRSTQW
IF(.NOT.OAPPLI(RA,0)) GO TO 2400
OFLAG2(OBJ)=or(OFLAG2(OBJ),FITEBT)
VOPPS(I)=OBJ
GO TO 2400
C
2200 IF((and(OFLAG2(OBJ),FITEBT).EQ.0).OR.(RA.EQ.0))
& GO TO 2300
PRSA=FIGHTW
F=OAPPLI(RA,0)
2300 IF(OBJ.EQ.THIEF) THFENF=.FALSE.
AFLAG(PLAYER)=and(AFLAG(PLAYER), not(ASTAG))
OFLAG2(OBJ)=and(OFLAG2(OBJ), not(STAGBT+FITEBT))
IF((OCAPAC(OBJ).GE.0).OR.(RA.EQ.0))
& GO TO 2400
PRSA=INXW
F=OAPPLI(RA,0)
OCAPAC(OBJ)=IABS(OCAPAC(OBJ))
2400 CONTINUE
C FIGHTD, PAGE 3
C
C NOW DO ACTUAL COUNTERBLOWS.
C
OUT=0
2600 DO 2700 I=1,VLNT
J=VOPPS(I)
IF(J.EQ.0) GO TO 2700
PRSCON=1
RA=OACTIO(J)
IF(RA.EQ.0) GO TO 2650
PRSA=FIGHTW
IF(OAPPLI(RA,0)) GO TO 2700
2650 RES=BLOW(PLAYER,J,VMELEE(I),.FALSE.,OUT)
IF(RES.LT.0) RETURN
IF(RES.EQ.ROUT) OUT=2+RND(3)
2700 CONTINUE
OUT=OUT-1
IF(OUT.GT.0) GO TO 2600
RETURN
C
END
C BLOW- STRIKE BLOW
C
C DECLARATIONS
C
INTEGER FUNCTION BLOW(H,V,RMK,HFLG,OUT)
IMPLICIT INTEGER (A-Z)
LOGICAL HFLG,OAPPLI,PROB
INTEGER DEF1R(3),DEF2R(4),DEF3R(5)
INTEGER RVECTR(66),RSTATE(45)
C
C GAME STATE
C
LOGICAL TELFLG
COMMON /PLAY/ WINNER,HERE,TELFLG
C
C PARSE VECTOR
C
LOGICAL PRSWON
COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON
C
C MISCELLANEOUS VARIABLES
C
COMMON /STAR/ MBASE,STRBIT
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 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
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
C
LOGICAL F
C
C FUNCTIONS AND DATA
C
DATA RMISS/0/,ROUT/1/,RKILL/2/,RLIGHT/3/
DATA RSER/4/,RSTAG/5/,RLOSE/6/,RHES/7/,RSIT/8/
DATA DEF1R/1,2,3/
DATA DEF2R/13,23,24,25/
DATA DEF3R/35,36,46,47,57/
C
DATA RVECTR/0,0,0,0,5,5,1,1,2,2,2,2,
& 0,0,0,0,0,5,5,3,3,1,
& 0,0,0,5,5,3,3,3,1,2,2,2,
& 0,0,0,0,0,5,5,3,3,4,4,
& 0,0,0,5,5,3,3,3,4,4,4,
& 0,5,5,3,3,3,3,4,4,4/
DATA RSTATE/5000,3005,3008,4011,3015,3018,1021,0,0,
& 5022,3027,3030,4033,3037,3040,1043,0,0,
& 4044,2048,4050,4054,5058,4063,4067,3071,1074,
& 4075,1079,4080,4084,4088,4092,4096,4100,1104,
& 4105,2109,4111,4115,4119,4123,4127,3131,3134/
C BLOW, PAGE 3
C
RA=OACTIO(V)
DV=ODESC2(V)
BLOW=RMISS
C D TYPE 10,H,V,RMK,HFLG,OUT
C D10 FORMAT(' BLOW 10-- ',3I7,L7,I7)
IF(.NOT.HFLG) GO TO 1000
C
C HERO IS ATTACKER, VILLAIN IS DEFENDER.
C
PBLOSE=10
OFLAG2(V)=or(OFLAG2(V),FITEBT)
IF(and(AFLAG(H),ASTAG).EQ.0) GO TO 100
CALL RSPEAK(591)
AFLAG(H)=and(AFLAG(H), not(ASTAG))
RETURN
C
100 ATT=FIGHTS(H,.TRUE.)
OA=ATT
DEF=VILSTR(V)
OD=DEF
DWEAP=0
DO 200 I=1,OLNT
IF((OCAN(I).EQ.V).AND.(and(OFLAG2(I),WEAPBT).NE.0))
& DWEAP=I
200 CONTINUE
IF(V.EQ.AOBJ(PLAYER)) GO TO 300
IF(DEF.NE.0) GO TO 2000
CALL RSPSUB(592,DV)
RETURN
C
300 CALL JIGSUP(593)
RETURN
C
C VILLAIN IS ATTACKER, HERO IS DEFENDER.
C
1000 PBLOSE=50
AFLAG(H)=and(AFLAG(H),not(ASTAG))
IF(and(OFLAG2(V),STAGBT).EQ.0) GO TO 1200
OFLAG2(V)=and(OFLAG2(V), not(STAGBT))
CALL RSPSUB(594,DV)
RETURN
C
1200 ATT=VILSTR(V)
OA=ATT
DEF=FIGHTS(H,.TRUE.)
IF(DEF.LE.0) RETURN
OD=FIGHTS(H,.FALSE.)
DWEAP=IABS(FWIM(0,WEAPBT,0,0,H,.TRUE.))
C BLOW, PAGE 4
C
C PARTIES ARE NOW EQUIPPED. DEF CANNOT BE ZERO.
C ATT MUST BE > 0.
C
2000 CONTINUE
C D TYPE 2050,ATT,OA,DEF,OD,DWEAP
C D2050 FORMAT(' BLOW 2050-- ',5I7)
IF(DEF.GT.0) GO TO 2100
RES=RKILL
IF(HFLG) CALL RSPSUB(595,DV)
GO TO 3000
C
2100 IF(DEF-2) 2200,2300,2400
2200 ATT=MIN0(ATT,3)
TBL=DEF1R(ATT)
GO TO 2500
C
2300 ATT=MIN0(ATT,4)
TBL=DEF2R(ATT)
GO TO 2500
C
2400 ATT=ATT-DEF
ATT=MIN0(2,MAX0(-2,ATT))+3
TBL=DEF3R(ATT)
C
2500 RES=RVECTR(TBL+RND(10))
IF(OUT.EQ.0) GO TO 2600
IF(RES.EQ.RSTAG) GO TO 2550
RES=RSIT
GO TO 2600
2550 RES=RHES
2600 IF((RES.EQ.RSTAG).AND.(DWEAP.NE.0).AND.PROB(25,PBLOSE))
& RES=RLOSE
C
MI=RSTATE(((RMK-1)*9)+RES+1)
IF(MI.EQ.0) GO TO 3000
I=(MOD(MI,1000)+RND(MI/1000))+MBASE+1
J=DV
IF(.NOT.HFLG .AND.(DWEAP.NE.0)) J=ODESC2(DWEAP)
C D TYPE 2650,RES,MI,I,J,MBASE
C D2650 FORMAT(' BLOW 2650-- ',5I7)
CALL RSPSUB(I,J)
C BLOW, PAGE 5
C
C NOW APPLY RESULT
C
3000 GO TO (4000,3100,3200,3300,3400,3500,3600,4000,3200),RES+1
C
3100 IF(HFLG) DEF=-DEF
GO TO 4000
C
3200 DEF=0
GO TO 4000
C
3300 DEF=MAX0(0,DEF-1)
GO TO 4000
C
3400 DEF=MAX0(0,DEF-2)
GO TO 4000
C
3500 IF(HFLG) GO TO 3550
AFLAG(H)=or(AFLAG(H),ASTAG)
GO TO 4000
C
3550 OFLAG2(V)=or(OFLAG2(V),STAGBT)
GO TO 4000
C
3600 CALL NEWSTA(DWEAP,0,HERE,0,0)
DWEAP=0
IF(HFLG) GO TO 4000
DWEAP=IABS(FWIM(0,WEAPBT,0,0,H,.TRUE.))
IF(DWEAP.NE.0) CALL RSPSUB(605,ODESC2(DWEAP))
C BLOW, PAGE 6
C
4000 BLOW=RES
IF(.NOT.HFLG) GO TO 4500
OCAPAC(V)=DEF
IF(DEF.NE.0) GO TO 4100
OFLAG2(V)=and(OFLAG2(V), not(FITEBT))
CALL RSPSUB(572,DV)
CALL NEWSTA(V,0,0,0,0)
IF(RA.EQ.0) RETURN
PRSA=DEADXW
F=OAPPLI(RA,0)
RETURN
C
4100 IF((RES.NE.ROUT).OR.(RA.EQ.0)) RETURN
PRSA=OUTXW
F=OAPPLI(RA,0)
RETURN
C
4500 ASTREN(H)=-10000
IF(DEF.NE.0) ASTREN(H)=DEF-OD
IF(DEF.GE.OD) GO TO 4600
CTICK(CEVCUR)=30
CFLAG(CEVCUR)=.TRUE.
4600 IF(FIGHTS(H,.TRUE.).GT.0) RETURN
ASTREN(H)=1-FIGHTS(H,.FALSE.)
CALL JIGSUP(596)
BLOW=-1
RETURN
C
END
C SWORDD- SWORD INTERMOVE DEMON
C
C DECLARATIONS
C
SUBROUTINE SWORDD
IMPLICIT INTEGER(A-Z)
LOGICAL INFEST,FINDXT
C
C GAME STATE
C
LOGICAL TELFLG
COMMON /PLAY/ WINNER,HERE,TELFLG
C
C EXITS
C
COMMON /CURXT/ XTYPE,XROOM1,XSTRNG,XACTIO,XOBJ
EQUIVALENCE (XFLAG,XOBJ)
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 /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 VILLAINS AND DEMONS
C
LOGICAL THFFLG,SWDACT,THFACT
COMMON /HACK/ THFPOS,THFFLG,THFACT,SWDACT,SWDSTA
C
C ADVENTURERS
C
COMMON /AINDEX/ PLAYER,AROBOT,AMASTR
C SWORDD, PAGE 2
C
IF(OADV(SWORD).NE.PLAYER) GO TO 500
NG=2
IF(INFEST(HERE)) GO TO 300
NG=1
DO 200 I=XMIN,XMAX,XMIN
IF(.NOT.FINDXT(I,HERE)) GO TO 200
GO TO (50,200,50,50),XTYPE
50 IF(INFEST(XROOM1)) GO TO 300
200 CONTINUE
NG=0
C
300 IF(NG.EQ.SWDSTA) RETURN
CALL RSPEAK(NG+495)
SWDSTA=NG
RETURN
C
500 SWDACT=.FALSE.
RETURN
END
C INFEST- SUBROUTINE TO TEST FOR INFESTED ROOM
C
C DECLARATIONS
C
LOGICAL FUNCTION INFEST(R)
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 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 VILLAINS AND DEMONS
C
LOGICAL THFFLG,SWDACT,THFACT
COMMON /HACK/ THFPOS,THFFLG,THFACT,SWDACT,SWDSTA
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(.NOT.ENDGMF) INFEST=(OROOM(CYCLO).EQ.R).OR.
& (OROOM(TROLL).EQ.R).OR.
& ((OROOM(THIEF).EQ.R).AND.THFACT)
IF(ENDGMF) INFEST=(R.EQ.MRG).OR.(R.EQ.MRGE).OR.
& (R.EQ.MRGW).OR.
& ((R.EQ.INMIR).AND.(MLOC.EQ.MRG))
RETURN
END
!Funky!Stuff!
echo x - dgame.f
cat >dgame.f <<'!Funky!Stuff!'
C GAME- MAIN COMMAND LOOP 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 DECLARATIONS
C
SUBROUTINE GAME
IMPLICIT INTEGER (A-Z)
LOGICAL RMDESC,VAPPLI,RAPPLI,AAPPLI
LOGICAL F,PARSE,FINDXT,XVEHIC,LIT
CHARACTER SECHO(4)
CHARACTER GDTSTR(3)
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,
& LTSHFT,BLOC,MUNGRM,HS,EGSCOR,EGMXSC
C
C MISCELLANEOUS VARIABLES
C
CHARACTER INLINE(78)
COMMON /INPUT/ INLNT,INLINE
COMMON /CHAN/ INPCH,OUTCH,DBCH
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 /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
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
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
C FUNCTIONS AND DATA
C
DATA SECHO/'E','C','H','O'/
DATA GDTSTR/'G','D','T'/
C GAME, PAGE 2
C
C START UP, DESCRIBE CURRENT LOCATION.
C
CALL RSPEAK(1)
F=RMDESC(3)
C
C NOW LOOP, READING AND EXECUTING COMMANDS.
C
100 WINNER=PLAYER
TELFLG=.FALSE.
IF(PRSCON.LE.1) CALL RDLINE(INLINE,INLNT,1)
DO 150 I=1,3
IF(INLINE(I+PRSCON-1).NE.GDTSTR(I)) GO TO 200
150 CONTINUE
CALL GDT
GO TO 100
C
200 MOVES=MOVES+1
PRSWON=PARSE(INLINE,INLNT,.TRUE.)
IF(.NOT.PRSWON) GO TO 400
IF(XVEHIC(1)) GO TO 400
C
IF(PRSA.EQ.TELLW) GO TO 2000
300 IF((PRSO.EQ.VALUA).OR.(PRSO.EQ.EVERY)) GO TO 900
IF(.NOT.VAPPLI(PRSA)) GO TO 400
350 IF(.NOT.ECHOF.AND.(HERE.EQ.ECHOR)) GO TO 1000
F=RAPPLI(RACTIO(HERE))
C
400 CALL XENDMV(TELFLG)
IF(.NOT.LIT(HERE)) PRSCON=1
GO TO 100
C
900 CALL VALUAC(VALUA)
GO TO 350
C GAME, PAGE 3
C
C SPECIAL CASE-- ECHO ROOM.
C IF INPUT IS NOT 'ECHO' OR A DIRECTION, JUST ECHO.
C
1000 CALL RDLINE(INLINE,INLNT,0)
MOVES=MOVES+1
DO 1100 I=1,4
IF(INLINE(I).NE.SECHO(I)) GO TO 1300
1100 CONTINUE
C
C Note: the following DO loop was changed from DO 1200 I=5,78
C The change was necessary because the RDLINE function was changed,
C and no longer provides a 78 character buffer padded with blanks.
C
DO 1200 I=5,INLNT
IF(INLINE(I).NE.' ') GO TO 1300
1200 CONTINUE
C
CALL RSPEAK(571)
ECHOF=.TRUE.
OFLAG2(BAR)=and(OFLAG2(BAR), not(SCRDBT))
PRSWON=.TRUE.
PRSCON=1
GO TO 400
C
1300 PRSWON=PARSE(INLINE,INLNT,.FALSE.)
IF(.NOT.PRSWON .OR. (PRSA.NE.WALKW))
& GO TO 1400
IF(FINDXT(PRSO,HERE)) GO TO 300
C
1400 WRITE(OUTCH,1410) (INLINE(J),J=1,INLNT)
1410 FORMAT(1X,78A1)
TELFLG=.TRUE.
GO TO 1000
C GAME, PAGE 4
C
C SPECIAL CASE-- TELL <ACTOR>, NEW COMMAND
C NOTE THAT WE CANNOT BE IN THE ECHO ROOM.
C
2000 IF(and(OFLAG2(PRSO),ACTRBT).NE.0) GO TO 2100
CALL RSPEAK(602)
GO TO 350
C
2100 WINNER=OACTOR(PRSO)
HERE=AROOM(WINNER)
IF(PRSCON.LE.1) GO TO 2700
IF(PARSE(INLINE,INLNT,.TRUE.)) GO TO 2150
2700 I=341
IF(TELFLG) I=604
CALL RSPEAK(I)
2600 WINNER=PLAYER
HERE=AROOM(WINNER)
GO TO 350
C
2150 IF(AAPPLI(AACTIO(WINNER))) GO TO 2400
IF(XVEHIC(1)) GO TO 2400
IF((PRSO.EQ.VALUA).OR.(PRSO.EQ.EVERY)) GO TO 2900
IF(.NOT.VAPPLI(PRSA)) GO TO 2400
2350 F=RAPPLI(RACTIO(HERE))
C
2400 CALL XENDMV(TELFLG)
GO TO 2600
C
2900 CALL VALUAC(VALUA)
GO TO 350
C
END
C XENDMV- EXECUTE END OF MOVE FUNCTIONS.
C
C DECLARATIONS
C
SUBROUTINE XENDMV(FLAG)
IMPLICIT INTEGER(A-Z)
LOGICAL F,CLOCKD,FLAG,XVEHIC
C
C PARSER OUTPUT
C
LOGICAL PRSWON
COMMON /PRSVEC/ PRSA,PRSO,PRSI,PRSWON,PRSCON
C
C VILLAINS AND DEMONS
C
LOGICAL THFFLG,SWDACT,THFACT
COMMON /HACK/ THFPOS,THFFLG,THFACT,SWDACT,SWDSTA
C
IF(.NOT.FLAG) CALL RSPEAK(341)
IF(THFACT) CALL THIEFD
IF(PRSWON) CALL FIGHTD
IF(SWDACT) CALL SWORDD
IF(PRSWON) F=CLOCKD(X)
IF(PRSWON) F=XVEHIC(2)
RETURN
END
C XVEHIC- EXECUTE VEHICLE FUNCTION
C
C DECLARATIONS
C
LOGICAL FUNCTION XVEHIC(N)
IMPLICIT INTEGER(A-Z)
LOGICAL OAPPLI
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
C ADVENTURERS
C
COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4),
& AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4)
C
XVEHIC=.FALSE.
AV=AVEHIC(WINNER)
IF(AV.NE.0) XVEHIC=OAPPLI(OACTIO(AV),N)
RETURN
END
!Funky!Stuff!
exit 0
--
-Bill Randle
Tektronix, Inc.
billr@tekred.TEK.COMbillr@tekred.UUCP (Bill Randle) (01/10/87)
# The rest of this file is a shell script which will extract:
# 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.
billr@tekred.TEK.COM