Dungeon sources (part 1 of 7)
Bill Randle
# 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.
bi...@tekred.TEK.COM