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