Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP Path: utzoo!mnetor!seismo!mcnc!ece-csc!ncrcae!ncr-sd!hp-sdd!hplabs!pesnta!amd!intelca!mipos3!omepd!psu-cs!reed!tektronix!tekgen!tekred!billr From: billr@tekred.UUCP (Bill Randle) Newsgroups: net.sources.games Subject: Dungeon sources (part 1 of 7) Message-ID: <926@tekred.UUCP> Date: Fri, 9-Jan-87 17:01:27 EST Article-I.D.: tekred.926 Posted: Fri Jan 9 17:01:27 1987 Date-Received: Fri, 16-Jan-87 00:46:40 EST Reply-To: billr@tekred.TEK.COM (Bill Randle) Distribution: world Organization: Tektronix, Inc., Beaverton, OR. Lines: 2222 # 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, 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.COM