C THIS IS THE FIRST LINE OF THE SETUP OF ADVENTURE. C THE COMMENTS ARE IN THE MAIN PROGRAM IMPLICIT INTEGER(A-Z) LOGICAL DSEEN,BLKLIN,HINTED,YES,START,TERSE,ISWIZ,LOGOUT LOGICAL WZDARK,KILLED,RDFLAG,LIVING CHARACTER*6 DTK(9),ATAB,DJJ,DK,DKK,DL,DLL CHARACTER*6 VTXT,OTXT,IOTXT,TXT DIMENSION PHUCE2(2,4) COMMON/IZWIZ/ISWIZ COMMON /ADJCOM/ ADJKEY(50),ADJTAB(150),ADJSIZ COMMON /BITCOM/ OPENBT,LOCKBT,BURNBT,WEARBT COMMON /BLKCOM/ BLKLIN COMMON /CONCOM/ LOCCON(250),OBJCON(150) COMMON /DIECOM/ NUMDIE,MAXDIE,TURNS,KILLED COMMON /DWFCOM/ DWARF,KNIFE,KNFLOC,DFLAG,DSEEN(6),DLOC(6), 1 ODLOC(6),DWFMAX COMMON /HLDCOM/ HOLDER(150),HLINK(150) COMMON /HNTCOM/ HINTLC(20),HINTED(20),HINTS(20,4),HNTSIZ,HNTMIN COMMON /LIQCOM/ BOTTLE,CASK,WATER,OIL,WINE,LIQTYP(5) COMMON /LOCCOM/ LOC,OLDLOC,OLDLC2,NEWLOC,MAXLOC COMMON /LTXCOM/ LTEXT(250),STEXT(250),KEY(250),ABB(250),LOCSIZ COMMON /MNECOM/ BACK,CAVE,DPRSSN,ENTRNC,EXIT,GO,LOOK,NULL, 1 AXE,BEAR,BOAT,BOOK,BOOK2,BOOTH,CARVNG,CHASM,CHASM2,DOOR,GNOME, 2 GRATE,LAMP,PDOOR,PLANT,PLANT2,ROCKS,ROD,ROD2,SAFE, 3 TDOOR,TDOOR2,TROLL,TROLL2,EMRALD,SPICES, 4 FIND,YELL,INVENT,LEAVE,POUR,SAY,TAKE,THROW, 5 IWEST,PHUCE(2,4),TK(20) COMMON /OBJCOM/ PLAC(150),FIXD(150),WEIGHT(150),PROP(150), 1 POINTS(150) COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150), 1 FIXED(150),MAXOBJ COMMON /PRPCOM/ VKEY(60),PTAB(300),VKYSIZ,PTBSIZ COMMON /TRVCOM/ TRAVEL(1600) COMMON /TXTCOM/ LINES(25000),RTEXT(450),PTEXT(150) COMMON /UTXCOM/ WDX COMMON /VOCCOM/ KTAB(600),TABSIZ COMMON /WRDCOM/ VERBS(45),VRBX,OBJS(45), 1 OBJX,IOBJS(15),IOBX,PREP,WORDS(45) COMMON /SAVCOM/ABBNUM,ADJ,ATBS,ATTACK,BCROSS,BONUS,CHASE, 1 CLOCK1,CLOCK2,CLOCK3,CLOSED,CLOSNG,CLSMAX,COMBO,DEADBT, 2 DETAIL,DKILL,DTOTAL,DWARFN,FLG239, 3 FOO,FOOBAR,FOOD,GAVEUP,HEALTH,HINT,HIT,HNTMAX,I,IKK,ILOC, 4 IOBJ,J,JJ,JK1,JKK,K,K1,KK,L,L1,LIMIT, 5 LINSIZ,LL,LMWARN,LOCK,LOGOUT,MESSAG,OBJ,PANIC, 6 PORTAL,PTBS,RDFLAG,RETN,RTXSIZ,SCORE,SCORNG,SECT, 7 SKEY,SLOC,SPK,START,STICK,TABNDX,TALLY,TALLY2,TERSE, 8 TRVS,TRVSIZ,VEND,VERB,VRBSIZ,WASTE,WKDAY,WKEND,WZDARK, 9 YEA,ACTSPK,CTEXT,CVAL,HNAME COMMON /SV2COM/ANVIL,BATTER,BEES,BILLBD,BIRD,BRUSH,CAGE, 1 CAKES,CHAIN,CHEST,CHLOC,CHLOC2,CLAM,CLOAK,CLSSES,COINS,CROWN, 2 DALTLC,DOG,DRAGON,EGGS,FISSUR,FLOWER,GATLOC,GRAIL,HIVE, 3 HONEY,HORN,JEWELS,KEYS,LYRE, 4 MAGZIN,MIRROR,MUSHRM,MXSCOR,NUGGET,OYSTER,PEARL,PHONE, 5 PILLOW,POLE,POSTER,PREPAT,PREPDN,PREPFR,PREPIN,PREPOF, 6 PREPON,PYRAM,RADIUM,RING,RUG,SAPPHI,SHIELD,SHOES, 7 SHUT,SLUGS,SNAKE,SPHERE,STEPS,STICKS,SWORD,TABLET,TRIDNT, 8 UNLOCK,VASE,WALL,WALL2,WEAR,WUMPUS,Y2,YANK COMMON /SV3COM/DTK,ATAB(600),VTXT(45,2),OTXT(45,2),IOTXT(15,2) 1 ,TXT(35,2) DIMENSION ACTSPK(60),CTEXT(12),CVAL(12) DIMENSION HNAME(10) LOGICAL AJAR,AT,ATHAND,BITSET,BLIND,CLOSED,CLOSNG, 1 DARK,DEAD,EDIBLE,ENCLSD,FORCED, 2 GAVEUP,HERE,HINGED,HOLDNG,INSIDE,LMWARN,LOCKS,OUTSID,OPAQUE, 3 PANIC,PCT,PLURAL,PORTAL,PRINTD,SCORNG,SMALL, 4 TOTING,TREASR,LOCKED,VESSEL,WEARNG,WORN,YEA, 5 YESM C DATA LINSIZ/25000/,TRVSIZ/1600/,TABSIZ/600/,LOCSIZ/250/, C 1 VRBSIZ/60/,RTXSIZ/450/,CLSMAX/12/,HNTSIZ/20/, C 2 MAXOBJ/150/,MAXLOC/300/,HNTMIN/7/,PTBSIZ/300/,ADJSIZ/50/, C 3 VKYSIZ/60/,BLKLIN/.TRUE./,DWFMAX/6/,ISWIZ/.FALSE./ DATA LINUSE/0/ C PHUCE CONSISTS OF FOUR PAIRS OF ORIGIN/DESTINATION LOCATIONS FROM/TO C WHICH ONE IS TRANSPORTED ON UTTERING THE ELFIN CURSE AT THE TINY C DOOR. HE CAN GO FROM BIG TO SMALL OR SMALL TO BIG, ON EITHER SIDE OF C THE DOOR. DATA PHUCE2/158,160,160,158,167,166,166,167/ C DATA DEADBT,OPENBT,LOCKBT,BURNBT,WEARBT /10,2,4,6,12/ C STATEMENT FUNCTIONS C C C AJAR(OBJ = TRUE IF THE OBJECT IS OPEN C AT(OBJ) = TRUE IF ON EITHER SIDE OF TWO-PLACED OBJECT C ATHAND(OBJ) = TRUE IF OBJECT IS HERE AND NOT IN CLOSED CONTAINER. C BITSET(COND,L,N) = TRUE IF COND(L) HAS BIT N SET (BIT 0 IS UNITS BIT) C BLIND(DUMMY) = TRUE IF HERO CAN'T SEE (TOO DARK OR GLAREY) C DARK(DUMMY) = TRUE IF LOCATION "LOC" IS DARK C DEAD(OBJ) = TRUE IF CRITTER IS KILLED (OR IN ENCHANTED SLEEP) C FORCED(LOC) = TRUE IF LOC MOVES WITHOUT ASKING FOR INPUT (COND=2) C HERE(OBJ) = TRUE IF THE OBJ IS AT "LOC" (OR IS BEING CARRIED) C HINGED(OBJ) = TRUE IF OBJECT CAN BE OPENED/SHUT. C INSIDE(LOC) = TRUE IF LOCATION IS WELL WITHIN THE CAVE C LIQ(DUMMY) = OBJECT NUMBER OF LIQUID IN BOTTLE C LIQLOC(LOC) = OBJECT NUMBER OF LIQUID (IF ANY) AT LOC C LIVING(OBJ) = TRUE IF OBJ IS SOME SORT OF CRITTER C LOCKED(OBJ) = TRUE IF OBJECT IS LOCKED. (NEED NOT HAVE A LOCK, C E.G., RUSTY DOOR) C LOCKS(OBJ) = TRUE IF OBJECT HAS A LOCK. C OPAQUE(OBJ) = TRUE IF CONTAINER IS NOT TRANSPARENT (SACK, CHEST) C TRANSPARENT OBJS: BOTTLE(GLASS), CAGE(WICKER) C OUTSID(LOC) = TRUE IF LOCATION IS OUTSIDE THE CAVE C PCT(N) = TRUE N% OF THE TIME (N INTEGER FROM 0 TO 100) C PLURAL(OBJ) = TRUE IF IT IS A PLURAL OBJ (SHOES, KEYS, ETC.) C PORTAL(LOC) = TRUE IS LOCATION IS IN CAVE "ENTRANCE" C PRINTD(OBJ) = TRUE IF OBJECT CAN BE READ. C SMALL(OBJ) = TRUE IF OBJ FITS INTO SACK C TOTING(OBJ) = TRUE IF THE OBJ IS BEING CARRIED C TREASR(OBJ) = TRUE IF OBJECT IS A TREASURE C VESSEL(OBJ) = TRUE IF OBJECT IS A CONTAINER C WEARNG(OBJ) = TRUE IF OBJECT IS BEING WORN C WORN(OBJ) = TRUE IF THE OBJECT CAN BE WORN C C CLOSED SAYS WHETHER WE'RE ALL THE WAY CLOSED C CLOSNG SAYS WHETHER ITS CLOSING TIME YET C DEMO IS TRUE IF THIS IS A PRIME-TIME DEMONSTRATION GAME C GAVEUP SAYS WHETHER HE EXITED VIA "QUIT" C LMWARN SAYS WHETHER HE'S BEEN WARNED ABOUT LAMP GOING DIM C PANIC SAYS WHETHER HE'S FOUND OUT HE'S TRAPPED IN THE CAVE C SCORNG INDICATES TO THE RATING ROUTINE WHETHER WE'RE DOING A "SCORE" COMMAND C WZDARK SAYS WHETHER THE LOC HE'S LEAVING WAS DARK C YEA IS RANDOM YES/NO REPLY C CLEAR OUT THE VARIOUS TEXT-POINTER ARRAYS. ALL TEXT IS STORED IN ARRAY C LINES; EACH LINE IS PRECEDED BY A WORD POINTING TO THE NEXT POINTER (I.E. C THE WORD FOLLOWING THE END OF THE LINE). THE POINTER IS NEGATIVE IF THIS IS C FIRST LINE OF A MESSAGE. THE TEXT-POINTER ARRAYS CONTAIN INDICES OF C POINTER-WORDS IN LINES. STEXT(N) IS SHORT DESCRIPTION OF LOCATION N. C LTEXT(N) IS LONG DESCRIPTION. PTEXT(N) POINTS TO MESSAGE FOR PROP( PROPN)=0 C SUCCESSIVE PROP MESSAGES ARE FOUND BY CHASING POINTERS. RTEXT CONTAINS C SECTION 6'S STUFF. CTEXT(N) POINTS TO A PLAYER-CLASS MESSAGE. MTEXT IS FOR C SECTION 12. WE ALSO CLEAR COND. SEE DESCRIPTION OF SECTION 9 FOR DETAILS. DEADBT = 10 OPENBT = 2 LOCKBT = 4 BURNBT = 6 WEARBT = 12 DO 2238 I = 1,2 DO 2239 J = 1,4 PHUCE(I,J) = PHUCE2(I,J) 2239 CONTINUE 2238 CONTINUE C DATA LINSIZ/25000/,TRVSIZ/1600/,TABSIZ/600/,LOCSIZ/250/, C 1 VRBSIZ/60/,RTXSIZ/450/,CLSMAX/12/,HNTSIZ/20/, C 2 MAXOBJ/150/,MAXLOC/300/,HNTMIN/7/,PTBSIZ/300/,ADJSIZ/50/, C 3 VKYSIZ/60/,BLKLIN/.TRUE./,DWFMAX/6/,ISWIZ/.FALSE./ LINSIZ = 25000 TRVSIZ = 1600 TABSIZ = 600 LOCSIZ = 250 VRBSIZ = 60 RTXSIZ = 450 CLSMAX = 12 HNTSIZ = 20 MAXOBJ = 150 MAXLOC = 300 HNTMIN = 7 PTBSIZ = 300 ADJSIZ = 50 VKYSIZ = 60 BLKLIN = .TRUE. DWFMAX = 6 ISWIZ = .FALSE. ZCLYD = ICHAR('c')+256*(ICHAR('L')+ 256*(ICHAR('y') 1 +256*ICHAR('D'))) ALLSPACE = 32+256*(32+256*(32+256*32)) DO 1001 I=1,MAXLOC IF(I.LE.MAXOBJ)PTEXT(I)=0 IF(I.LE.RTXSIZ)RTEXT(I)=0 IF(I.LE.CLSMAX)CTEXT(I)=0 IF(I.GT.LOCSIZ)GOTO 1001 STEXT(I)=0 LTEXT(I)=0 LOCCON(I)=0 1001 CONTINUE DO 1278 I=1,MAXOBJ POINTS(I)=0 1278 OBJCON(I)=0 OPEN (UNIT=2,FILE='ADVDAT',STATUS='OLD') DO 1279 I=1,250 KEY(I) = 0 1279 CONTINUE DO 1280 I = 1,50 1280 ADJKEY(I) = 0 DO 1281 I=1,150 WEIGHT(I) = 0 PLAC(I) = 0 FIXD(I) = 0 1281 ADJTAB(I) = 0 LINUSE=1 TRVS=1 PTBS=1 ATBS=1 CLSSES=1 C START NEW DATA SECTION. SECT IS THE SECTION NUMBER. 1002 READ(2,1003)SECT 1003 FORMAT(I8) WRITE(*,1015)SECT 1015 FORMAT (' READING TABLE ',I2,'...') OLDLOC=-1 GOTO(1190,1004,1004,1040,1030,1004,1004,1050,1060,1070,1004, 1 1080,0999,0999,1100,1120,1140),(SECT+1) C (0) (1) (2) (3) (4) (5) (6) (7) (8) (9) (10) C (11) (12) (13) (14) (15) (16) 999 CALL BUG(9) C SECTIONS 1, 2, 5, 6, 10 READ MESSAGES AND SET UP POINTERS. 1004 JL1=LINUSE+1 JL2=LINUSE+18 READ(2,1005)LOC,(LINES(J12),J12=JL1,JL2),KK 1005 FORMAT(I8,19A4) IF(KK.EQ.ALLSPACE)GOTO 1017 PRINT 1016,LOC 1016 FORMAT (1X,'LINE FOR LOCN ',I4,' TOO LONG.') CALL BUG(0) 1017 IF(LOC.EQ.-1)GOTO 1002 DO 1006 K=1,18 JKK=LINUSE+19-K IF(LINES(JKK).NE.ALLSPACE)GOTO 1007 1006 CONTINUE IF(LOC.EQ.0)GOTO 1004 C ABOVE KLUGE IS TO AVOID F40 BUG IF CRLF BROKEN ACROSS RECORD BOUNDARY CALL BUG(1) 1007 JL1=LINUSE+1 DO 1008 JK1=JL1,JKK 1008 LINES(JK1)=IEOR(LINES(JK1),ZCLYD) LINES(LINUSE)=JKK+1 IF(LOC.EQ.OLDLOC)GOTO 1020 IF(LOC.GT.OLDLOC.OR.SECT.EQ.5)GOTO 1019 PRINT 1018,LOC,SECT 1018 FORMAT (/' LINE ',I3,' OUT OF ORDER IN SECTION ',I2) CALL BUG(10) 1019 LINES(LINUSE)=-LINES(LINUSE) IF(SECT.EQ.10)GOTO 1012 IF(SECT.EQ.6)GOTO 1011 IF(SECT.EQ.5)GOTO 1010 IF(SECT.EQ.1)GOTO 1009 STEXT(LOC)=LINUSE GOTO 1020 1009 LTEXT(LOC)=LINUSE GOTO 1020 1010 IF(LOC.GT.0.AND.LOC.LE.MAXOBJ)PTEXT(LOC)=LINUSE GOTO 1020 1011 IF(LOC.GT.RTXSIZ)CALL BUG(6) RTEXT(LOC)=LINUSE GOTO 1020 1012 CTEXT(CLSSES)=LINUSE CVAL(CLSSES)=LOC CLSSES=CLSSES+1 GOTO 1020 1020 LINUSE=JKK+1 LINES(LINUSE)=-1 OLDLOC=LOC IF(LINUSE+18.GT.LINSIZ)CALL BUG(2) GOTO 1004 C THE STUFF FOR SECTION 4 IS ENCODED HERE. EACH "FROM-LOCATION" GETS A C CONTIGUOUS SECTION OF THE "TRAVEL" ARRAY. EACH ENTRY IN TRAVEL IS C NEWLOC*1000 + KEYWORD (FROM SECTION 3, MOTION VERBS), AND IS NEGATED IF C THIS IS THE LAST ENTRY FOR THIS LOCATION. KEY(N) IS THE INDEX IN TRAVEL C OF THE FIRST OPTION AT LOCATION N. 1030 READ(2,1031)LOC,JNEW,(DTK(I),I=1,8) 1031 FORMAT(2I8,8(A6,2X)) IF(LOC.EQ.0)GOTO 1030 C ABOVE KLUGE IS TO AVOID AFOREMENTIONED F40 BUG IF(LOC.EQ.-1)GOTO 1002 IF(LOC.GE.OLDLOC)GOTO 1032 PRINT 1018,LOC,SECT CALL BUG(10) 1032 IF(KEY(LOC).NE.0)GOTO 1033 KEY(LOC)=TRVS GOTO 1035 1033 TRAVEL(TRVS-1)=-TRAVEL(TRVS-1) 1035 DO 1037 L=1,8 IF(DTK(L).EQ.' ')GOTO 1039 K=VOCABX(DTK(L),-1) TRAVEL(TRVS)=JNEW*1000+K TRVS=TRVS+1 IF(TRVS.EQ.TRVSIZ)CALL BUG(3) 1037 CONTINUE 1039 TRAVEL(TRVS-1)=-TRAVEL(TRVS-1) GOTO 1030 C HERE WE READ IN THE VOCABULARY. KTAB(N) IS THE WORD NUMBER, ATAB(N) IS C THE CORRESPONDING WORD. THE -1 AT THE END OF SECTION 3 IS LEFT IN KTAB C AS AN END-MARKER. THE WORDS ARE GIVEN A MINIMAL HASH TO MAKE READING THE C CORE-IMAGE HARDER. 1040 DO 1042 TABNDX=1,TABSIZ 1043 READ(2,1041)KTAB(TABNDX),ATAB(TABNDX) 1041 FORMAT(I8,A6) C IF(KTAB(TABNDX).EQ.0)GOTO 1043 C ABOVE KLUGE IS TO AVOID AFOREMENTIONED F40 BUG IF(KTAB(TABNDX).EQ.-1)GOTO 1002 1042 CONTINUE CALL BUG(4) C READ IN THE INITIAL LOCATIONS FOR EACH OBJECT. ALSO THE IMMOVABILITY INFO. C PLAC CONTAINS INITIAL LOCATIONS OF OBJECTS. FIXD IS -1 FOR IMMOVABLE C OBJECTS (INCLUDING THE SNAKE), OR = SECOND LOC FOR TWO-PLACED OBJECTS. C WEIGHT CONTAINS THE HEAVINESS OF EACH OBJ, ON A SCALE OF 1-10. 1050 READ(2,1052) OBJ,J,K,KK,DL,DLL,(TK(I),I=1,3) 1052 FORMAT(4I8,2(A6,2X),3I8) IF(OBJ.EQ.-1)GOTO 1002 IF(OBJ.LE.0.OR.OBJ.GT.MAXOBJ)CALL BUG(17) PLAC(OBJ)=J FIXD(OBJ)=K WEIGHT(OBJ)=KK C READ DEFAULT OBJECT NAMES. FOR USE IN 'TAKE ALL' COMMANDS. C READ POINT VALUES FOR TREASURES. K=1 IF(TK(3).LT.0)K=-1 POINTS(OBJ)= (TK(1)*1000000*K) + (TK(2)*1000*K) + TK(3) GOTO 1050 C READ DEFAULT MESSAGE NUMBERS FOR ACTION VERBS, STORE IN ACTSPK. 1060 READ(2,1061)VERB,J 1061 FORMAT(10I8) IF(VERB.EQ.-1)GOTO 1002 ACTSPK(VERB)=J GOTO 1060 C READ INFO ABOUT AVAILABLE LIQUIDS AND OTHER CONDITIONS, STORE IN COND. 1070 READ(2,1061)K,(TK(I),I=1,9) IF(K.EQ.-1)GOTO 1002 DO 1071 I=1,9 LOC=TK(I) IF(LOC.EQ.0)GOTO 1070 IF(K.GT.7)GOTO 1072 IF(BITSET(LOCCON(LOC),K))CALL BUG(8) LOCCON(LOC)=LOCCON(LOC)+BITS(K) GOTO 1071 1072 LOCCON(LOC)=IOR(LOCCON(LOC),(256*(K-7))) 1071 CONTINUE GOTO 1070 C READ DATA FOR HINTS. 1080 HNTMAX=0 1081 READ(2,1061)K,(TK(I),I=1,9) IF(K.EQ.-1)GOTO 1002 IF(K.EQ.0)GOTO 1081 IF(K.LT.0.OR.K.GT.HNTSIZ)CALL BUG(7) DO 1083 I=1,4 1083 HINTS(K,I)=TK(I) HNTMAX=MAX0(HNTMAX,K) GOTO 1081 C SECTION 14 IS THE PREPOSITION TABLE. 1100 READ(2,1101)DK,DKK,(DTK(I),I=1,8) 1101 FORMAT(10(A6,2X)) C IF(DK.EQ.0)GOTO 1100 C ABOVE KLUGE IS TO AVOID AFOREMENTIONED F40 BUG IF(DK.EQ.'-1 ')GOTO 1002 VERB=VAL(VOCABX(DK,-4)) DJJ=DK IF(VERB.EQ.-1)GOTO 7645 PREP=VAL(VOCABX(DKK,-6)) DJJ=DKK IF(PREP.EQ.-1)GOTO 7645 IF(VKEY(VERB).NE.0)GOTO 1104 VKEY(VERB)=PTBS GOTO 1105 7645 PRINT 1107,DJJ CALL BUG(14) GOTO 1100 1104 PTAB(PTBS-1)=-PTAB(PTBS-1) 1105 DO 1110 L=1,8 IF(DTK(L).EQ.' ')GOTO 1111 K=VAL(VOCABX(DTK(L),-3)) IF(K.NE.-1)GOTO 1108 K=999 IF(L.EQ.1.AND.DTK(1).EQ.'ANY ')GOTO 1108 DJJ=DTK(L) 1106 PRINT 1107,DJJ 1107 FORMAT(/' UNRECOGNIZED WORD "',A6,'" IN PREP/OBJ TABLE.') CALL BUG(14) 1108 PTAB(PTBS)=PREP*1000+K PTBS=PTBS+1 IF(PTBS.EQ.PTBSIZ)CALL BUG(15) 1110 CONTINUE 1111 PTAB(PTBS-1)=-PTAB(PTBS-1) GOTO 1100 C READ CONDITION BITS FOR OBJECTS. KK IS THE BIT; TK(I), THE OBJ LIST. 1120 READ(2,1061)IKK,(TK(I),I=1,9) IF(IKK.EQ.-1)GOTO 1002 DO 1125 I=1,9 OBJ=TK(I) IF(OBJ.EQ.0)GOTO 1120 IF(OBJ.LE.0.OR.OBJ.GT.MAXOBJ)CALL BUG(17) IF(.NOT.BITSET(OBJCON(OBJ),IKK))GOTO 1125 WRITE(6,101)OBJ,IKK 101 FORMAT('BIT SET TWICE OBJ=',I5,' BIT= ',I5) CALL BUG(16) 1125 OBJCON(OBJ)=IOR(OBJCON(OBJ),BITS(IKK)) GOTO 1120 C SECTION 17 IS THE ADJECTIVE TABLE. 1140 CONTINUE READ(2,1141)DK,(DTK(I),I=1,9) 1141 FORMAT(10(A6,2X)) C IF(DK.EQ.0)GOTO 1140 C ABOVE KLUGE IS TO AVOID AFOREMENTIONED F40 BUG IF(DK.EQ.'-1 ')GOTO 1002 ADJ=VOCABX(DK,-7) DJJ=DK IF(ADJ.EQ.-1.OR.CLASS(ADJ).NE.6)GOTO 1148 ADJ=VAL(ADJ) IF(ADJKEY(ADJ).NE.0)GOTO 1142 ADJKEY(ADJ)=ATBS GOTO 1143 1142 ADJTAB(ATBS-1)=-ADJTAB(ATBS-1) 1143 DO 1145 L=1,9 IF(DTK(L).EQ.' ')GOTO 1146 DJJ=DTK(L) K=VOCABX(DTK(L),-3) IF(K.EQ.-1.OR.CLASS(K).NE.2)GOTO 1148 ADJTAB(ATBS)=VAL(K) ATBS=ATBS+1 IF(ATBS.EQ.MAXOBJ)CALL BUG(18) 1145 CONTINUE 1146 ADJTAB(ATBS-1)=-ADJTAB(ATBS-1) GOTO 1140 1148 PRINT 1149,DJJ 1149 FORMAT(/' UNRECOGNIZED WORD "',A6,'" IN ADJECTIVE TABLE.') CALL BUG(13) C EVERYTHING IS READ! NOW FINISH CONSTRUCTING INTERNAL DATA FORMAT. C DEFINE SOME HANDY MNEMONICS. THESE CORRESPOND TO OBJECT NUMBERS. C (INCLUDES TREASURES.) 1190 CLOSE(UNIT=2) ANVIL=VOCABX('ANVIL ',2) AXE=VOCABX('AXE ',2) BATTER=VOCABX('BATTER',2) BEAR=VOCABX('BEAR ',2) BEES=VOCABX('BEES ',2) BILLBD=VOCABX('BILLBO',2) BIRD=VOCABX('BIRD ',2) BOAT=VOCABX('BOAT ',2) BOOK=VOCABX('BOOK ',2) BOOK2=BOOK+1 BOOTH=VOCABX('BOOTH ',2) BOTTLE=VOCABX('BOTTLE',2) BRUSH=VOCABX('BRUSH ',2) CAGE=VOCABX('CAGE ',2) CAKES=VOCABX('CAKES ',2) CARVNG=VOCABX('CARVIN',2) CASK=VOCABX('CASK ',2) CHAIN=VOCABX('CHAIN ',2) CHASM=VOCABX('CHASM ',2) CHASM2=CHASM+1 CHEST=VOCABX('CHEST ',2) CLAM=VOCABX('CLAM ',2) CLOAK=VOCABX('CLOAK ',2) COINS=VOCABX('COINS ',2) CROWN=VOCABX('CROWN ',2) DOG=VOCABX('DOG ',2) DOOR=VOCABX('DOOR ',2) DRAGON=VOCABX('DRAGON',2) DWARF=VOCABX('DWARF ',2) EGGS=VOCABX('EGGS ',2) EMRALD=VOCABX('EMERAL',2) FISSUR=VOCABX('FISSUR',2) FLOWER=VOCABX('FLOWER',2) FOOD=VOCABX('FOOD ',2) GNOME=VOCABX('GNOME ',2) GRAIL=VOCABX('GRAIL ',2) GRATE=VOCABX('GRATE ',2) HIVE=VOCABX('HIVE ',2) HONEY=VOCABX('HONEY ',2) HORN=VOCABX('HORN ',2) JEWELS=VOCABX('JEWELS',2) KEYS=VOCABX('KEYS ',2) KNIFE=VOCABX('KNIFE ',2) LAMP=VOCABX('LAMP ',2) LYRE=VOCABX('LYRE ',2) MAGZIN=VOCABX('MAGAZI',2) MESSAG=VOCABX('MESSAG',2) MIRROR=VOCABX('MIRROR',2) MUSHRM=VOCABX('MUSHRO',2) NUGGET=VOCABX('NUGGET',2) OIL=VOCABX('OIL ',2) C OIL2=OIL+1 OYSTER=VOCABX('OYSTER',2) PEARL=VOCABX('PEARL ',2) PHONE=VOCABX('PHONE ',2) PILLOW=VOCABX('PILLOW',2) PLANT=VOCABX('PLANT ',2) PLANT2=PLANT+1 POLE=VOCABX('POLE ',2) POSTER=VOCABX('POSTER',2) PYRAM=VOCABX('PYRAMI',2) RADIUM=VOCABX('RADIUM',2) RING=VOCABX('RING ',2) ROCKS=VOCABX('ROCKS ',2) ROD= VOCABX('ROD ',2) ROD2=ROD+1 RUG=VOCABX('RUG ',2) SAFE=VOCABX('SAFE ',2) SAPPHI=VOCABX('SAPPHI',2) SHIELD=VOCABX('TUBE ',2) SHOES=VOCABX('SHOES ',2) SKEY=VOCABX('KEY ',2) SLUGS=VOCABX('SLUGS ',2) SNAKE=VOCABX('SNAKE ',2) SPICES=VOCABX('SPICES',2) SPHERE=VOCABX('SPHERE',2) STEPS=VOCABX('STEPS ',2) STICKS=VOCABX('STICKS',2) SWORD=VOCABX('SWORD ',2) TABLET=VOCABX('TABLET',2) TDOOR=DOOR+1 TDOOR2=TDOOR+1 PDOOR=TDOOR2+1 TRIDNT=VOCABX('TRIDEN',2) TROLL=VOCABX('TROLL ',2) TROLL2=TROLL+1 VASE=VOCABX('VASE ',2) VEND=VOCABX('MACHIN',2) WALL=VOCABX('WALL ',2) WALL2=WALL+1 WATER=VOCABX('WATER ',2) C WATER2=WATER+1 WINE=VOCABX('WINE ',2) C WINE2=WINE+1 WUMPUS=VOCABX('WUMPUS',2) C THESE ARE MOTION-VERB NUMBERS. BACK=VOCABX('BACK ',1) CAVE=VOCABX('CAVE ',1) DPRSSN=VOCABX('DEPRES',1) ENTRNC=VOCABX('ENTRAN',1) EXIT=VOCABX('EXIT ',1) NULL=VOCABX('NULL ',1) C AND SOME ACTION VERBS. FIND=VOCABX('FIND ',3) GO=VOCABX('GO ',3) HIT=VOCABX('HIT ',3) LOOK=VOCABX('LOOK ',3) YELL=VOCABX('CALL ',3) INVENT=VOCABX('INVENT',3) LEAVE=VOCABX('LEAVE ',3) LOCK=VOCABX('LOCK ',3) SAY=VOCABX('SAY ',3) SHUT=VOCABX('CLOSE ',3) TAKE=VOCABX('TAKE ',3) THROW=VOCABX('THROW ',3) UNLOCK=VOCABX('UNLOCK',3) WEAR=VOCABX('WEAR ',3) YANK=VOCABX('YANK ',3) C AND A FEW PREPOSITIONS. PREFIX 'PREP' TO DISTINGUISH THEM FROM FUNCTIONS & R PREPAT=VOCABX('AT ',5) PREPDN=VOCABX('DOWN ',5) PREPFR=VOCABX('FROM ',5) PREPIN=VOCABX('IN ',5) PREPOF=VOCABX('OFF ',5) PREPON=VOCABX('ON ',5) C A POPULAR LOCATION IS: Y2=33 1200 CONTINUE C HAVING READ IN THE DATABASE, CERTAIN THINGS ARE NOW CONSTRUCTED. PROPS ARE C SET TO ZERO. WE FINISH SETTING UP COND BY CHECKING FOR FORCED-MOTION TRAVEL C ENTRIES. THE PLAC AND FIXD ARRAYS ARE USED TO SET UP ATLOC(N) AS THE FIRST C OBJECT AT LOCATION N, AND LINK(OBJ) AS THE NEXT OBJECT AT THE SAME LOCATION C AS OBJ. (OBJ>MAXOBJ INDICATES THAT FIXED(OBJ-MAXOBJ)=LOC; LINK(OBJ) IS STILL C THE CORRECT LINK TO USE.) ABB IS ZEROED; IT CONTROLS WHETHER THE ABBREVIATED C DESCRIPTION IS PRINTED. COUNTS MOD 5 UNLESS "LOOK" IS USED. LOC = 1 DO 1201 I=1,MAXOBJ PLACE(I)=0 PROP(I)=0 HOLDER(I)=0 HLINK(I)=0 LINK(I)=0 1201 LINK(I+MAXOBJ)=0 DO 1202 I=1,LOCSIZ ABB(I)=0 IF(LTEXT(I).EQ.0.OR.KEY(I).EQ.0)GOTO 1202 K=KEY(I) IF(MOD(IABS(TRAVEL(K)),0001000).EQ.1)LOCCON(I)=2 1202 ATLOC(I)=0 C SET UP THE ATLOC AND LINK ARRAYS AS DESCRIBED ABOVE. WE'LL USE THE DROP C SUBROUTINE, WHICH PREFACES NEW OBJECTS ON THE LISTS. SINCE WE WANT THINGS C IN THE OTHER ORDER, WE'LL RUN THE LOOP BACKWARDS. IF THE OBJECT IS IN TWO C LOCS, WE DROP IT TWICE. THIS ALSO SETS UP "PLACE" AND "FIXED" AS COPIES OF C "PLAC" AND "FIXD". ALSO, SINCE TWO-PLACED OBJECTS ARE TYPICALLY BEST C DESCRIBED LAST, WE'LL DROP THEM FIRST. DO 1206 I=1,MAXOBJ K=MAXOBJ+1-I IF(FIXD(K).LE.0)GOTO 1206 CALL DROP(K+MAXOBJ,FIXD(K)) CALL DROP(K,PLAC(K)) 1206 CONTINUE DO 1207 I=1,MAXOBJ K=MAXOBJ+1-I FIXED(K)=FIXD(K) 1207 IF(PLAC(K).NE.0.AND.FIXD(K).LE.0)CALL DROP(K,PLAC(K)) C MAKE SURE ALL THE RIGHT THINGS GET CLOSED AND LOCKED, ETC., BEFORE C WE GET STARTED. C TREASURES, AS NOTED EARLIER, ARE OBJECTS WITH BITSET(14) IN OBJCON. C THEIR PROPS ARE INITIALLY -1, AND ARE SET TO 0 THE FIRST TIME THEY ARE C DESCRIBED. TALLY KEEPS TRACK OF HOW MANY ARE NOT YET FOUND, SO WE KNOW C WHEN TO CLOSE THE CAVE. TALLY2 COUNTS HOW MANY CAN NEVER BE FOUND (E.G. IF C LOST BIRD OR BRIDGE). TALLY=0 TALLY2=0 DO 1240 I=1,MAXOBJ IF(.NOT.TREASR(I))GOTO 1240 IF(PTEXT(I).NE.0)PROP(I)=-1 1240 TALLY=TALLY-PROP(I) C CLEAR THE HINT STUFF. HINTLC(I) IS HOW LONG HE'S BEEN AT LOC WITH COND BIT C I. HINTED(I) IS TRUE IFF HINT I HAS BEEN USED. DO 1300 I=1,HNTMAX HINTED(I)=.FALSE. 1300 HINTLC(I)=0 C INITIALISE THE DWARVES. DLOC IS LOC OF DWARVES, HARD-WIRED IN. ODLOC IS C PRIOR LOC OF EACH DWARF, INITIALLY GARBAGE. DALTLC IS ALTERNATE INITIAL LOC C FOR DWARF, IN CASE ONE OF THEM STARTS OUT ON TOP OF THE ADVENTURER. (NO 2 C OF THE 5 INITIAL LOCS ARE ADJACENT.) DSEEN IS TRUE IF DWARF HAS SEEN HIM. C DFLAG CONTROLS THE LEVEL OF ACTIVATION OF ALL THIS: C 0 NO DWARF STUFF YET (WAIT UNTIL REACHES HALL OF MISTS) C 1 REACHED HALL OF MISTS, BUT HASN'T MET FIRST DWARF C 2 MET FIRST DWARF, OTHERS START MOVING, NO KNIVES THROWN YET C 3 A KNIFE HAS BEEN THROWN (FIRST SET ALWAYS MISSES) C 3+ DWARVES ARE MAD (INCREASES THEIR ACCURACY) C SIXTH DWARF IS SPECIAL (THE PIRATE). HE ALWAYS STARTS AT HIS CHEST'S C EVENTUAL LOCATION INSIDE THE MAZE. THIS LOC IS SAVED IN CHLOC FOR REF. C THE DEAD END IN THE OTHER MAZE HAS ITS LOC STORED IN CHLOC2. CHLOC=114 CHLOC2=140 DO 1700 I=1,DWFMAX 1700 DSEEN(I)=.FALSE. DFLAG=0 DLOC(1)=PLAC(SNAKE) DLOC(2)=PLAC(BOOTH) DLOC(3)=Y2 DLOC(4)=44 DLOC(5)=PLAC(CLAM) C DLOC(6)=PLAC(VEND) DLOC(DWFMAX)=CHLOC DALTLC=PLAC(NUGGET) C OTHER RANDOM FLAGS AND COUNTERS, AS FOLLOWS: C ABBNUM HOW OFTEN WE SHOULD PRINT NON-ABBREVIATED DESCRIPTIONS C BCROSS NUMBER OF TIMES COLLAPSING BRIDGE HAS BEEN TRAVERSED. C BONUS USED TO DETERMINE AMOUNT OF BONUS IF HE REACHES CLOSING C CHASE TELLS HOW CLOSE THE WUMPUS IS TO GOBBLING HIM UP C CLOCK1 NUMBER OF TURNS FROM FINDING LAST TREASURE TILL CLOSING C CLOCK2 NUMBER OF TURNS FROM FIRST WARNING TILL BLINDING FLASH C CLOCK3 NUMBER OF TURNS IN REPOSITORY TILL PHONE RINGS. C AFTER TICKING TO 0, TICKS 7 TIMES TO WAKE DWARVES. C COMBO CURRENT PROGRESS IN GIVING SAFE'S COMBINATION C DETAIL HOW OFTEN WE'VE SAID "NOT ALLOWED TO GIVE MORE DETAIL" C DKILL NUMBER OF DWARVES KILLED (UNUSED IN SCORING, NEEDED FOR MSG) C FOOBAR CURRENT PROGRESS IN SAYING "FEE FIE FOE FOO". C HEALTH PERCENTAGE OF MAXIMUM (100) FITNESS C IWEST HOW MANY TIMES HE'S SAID "WEST" INSTEAD OF "W" C KNFLOC 0 IF NO KNIFE HERE, LOC IF KNIFE HERE, -1 AFTER CAVEAT C LIMIT LIFETIME OF LAMP (NOT SET HERE) C MAXDIE NUMBER OF REINCARNATION MESSAGES AVAILABLE (UP TO 5) C NUMDIE NUMBER OF TIMES KILLED SO FAR C TERSE IF TRUE, NEVER PRINT LONG LOCATION DESCRIPTIONS C TURNS TALLIES HOW MANY COMMANDS HE'S GIVEN (IGNORES YES/NO) C WASTE TELLS HOW LONG HE HAS USED LAMP IN LIGHTED AREA. C LOGICALS WERE EXPLAINED EARLIER ABBNUM=5 BCROSS=0 BONUS=0 CLOCK1=30 CLOCK2=50 CLOCK3=20+RANZ(20) CHASE=0 CLOSED=.FALSE. CLOSNG=.FALSE. COMBO=0 DETAIL=0 DKILL=0 FOOBAR=0 GAVEUP=.FALSE. HEALTH=100 IWEST=0 KNFLOC=0 LMWARN=.FALSE. DO 1800 I=0,4 1800 IF(RTEXT(2*I+81).NE.0)MAXDIE=I+1 NUMDIE=0 PANIC=.FALSE. SCORNG=.FALSE. TERSE=.FALSE. TURNS=0 WASTE=0 C SETUP THE LIQUIDS ACCORDING TO CONTAINER PROP VALUES LIQTYP(1)=WATER LIQTYP(2)=0 LIQTYP(3)=OIL LIQTYP(4)=0 LIQTYP(5)=WINE PROP(POLE)=1 PROP(SKEY)=1 PLACE(WATER)=-1 CALL INSERT(WATER,BOTTLE) PLACE(BOOK)=-1 CALL INSERT(BOOK,SAFE) C AND CLEAR OUT ANY LEFTOVER WORD VECTORS... CALL CLRLIN DO 1810 WDX=1,35 1810 WORDS(WDX)=0 WDX=0 C IF SETUP=1, REPORT ON AMOUNT OF ARRAYS ACTUALLY USED, TO PERMIT REDUCTIONS. JJ=0 DO 1989 K=1,VKYSIZ 1989 IF(VKEY(K).NE.0)JJ=JJ+1 DO 1998 K=1,LOCSIZ KK=LOCSIZ+1-K IF(LTEXT(KK).NE.0)GOTO 1997 1998 CONTINUE 1997 LL=0 OBJ=0 DO 1996 K=1,MAXOBJ IF(TREASR(K))LL=LL+1 1996 IF(PTEXT(K).NE.0)OBJ=OBJ+1 DO 1995 K=1,TABNDX 1995 IF(KTAB(K)/1000.EQ.2)VERB=KTAB(K)-2000 DO 1994 K=1,RTXSIZ J=RTXSIZ+1-K IF(RTEXT(J).NE.0)GOTO 1993 1994 CONTINUE 1993 CONTINUE 1992 CONTINUE 1991 CALL RATING(SCORE,0,.FALSE.,.FALSE.,.FALSE.,.FALSE., 1 HNTMAX) K=MAXOBJ PRINT 1999,LINUSE,LINSIZ,TRVS,TRVSIZ,TABNDX,TABSIZ,KK, 1 LOCSIZ,OBJ,K,LL,VERB,VRBSIZ,J,RTXSIZ,CLSSES,CLSMAX, 2 HNTMAX,HNTSIZ,PTBS,PTBSIZ,JJ,VERB, 3 MXSCOR 1999 FORMAT (' TABLE SPACE USED:'/ 1 ' ',I6,' OF ',I6,' WORDS OF MESSAGES'/ 2 ' ',I6,' OF ',I6,' TRAVEL OPTIONS'/ 3 ' ',I6,' OF ',I6,' VOCABULARY WORDS'/ 4 ' ',I6,' OF ',I6,' LOCATIONS'/ 5 ' ',I6,' OF ',I6,' OBJECTS OF WHICH ',I2,' ARE TREASURES.'/ 6 ' ',I6,' OF ',I6,' ACTION VERBS'/ 7 ' ',I6,' OF ',I6,' RTEXT MESSAGES'/ 8 ' ',I6,' OF ',I6,' CLASS MESSAGES'/ 9 ' ',I6,' OF ',I6,' HINTS'/ 2 ' ',I6,' OF ',I6,' VERB/PREP/OBJ OPTIONS'/ 3 ' ',I6,' OF ',I6,' VERBS TAKE PREPOSITIONS'/ 4 /' MAXIMUM SCORE FOR THIS VERSION IS ',I4,' POINTS.'/ 5 ) 8445 OPEN (UNIT=16,FILE='ADVTXT',STATUS='UNKNOWN',FORM= 1 'UNFORMATTED',ACCESS='SEQUENTIAL') WRITE(16)ISWIZ,ADJKEY,ADJTAB,ADJSIZ,OPENBT,LOCKBT,BURNBT,WEARBT WRITE(16)BLKLIN,LOCCON,OBJCON,NUMDIE,MAXDIE,TURNS,KILLED WRITE(16)DWARF,KNIFE,KNFLOC,DFLAG,DSEEN,DLOC,ODLOC,DWFMAX WRITE(16)HOLDER,HLINK,HINTLC,HINTED,HINTS,HNTSIZ,HNTMIN WRITE(16)BOTTLE,CASK,WATER,OIL,WINE,LIQTYP WRITE(16)LOC,OLDLOC,OLDLC2,NEWLOC,MAXLOC WRITE(16) LTEXT,STEXT,KEY,ABB,LOCSIZ WRITE(16) BACK,CAVE,DPRSSN,ENTRNC,EXIT,GO,LOOK,NULL, 1 AXE,BEAR,BOAT,BOOK,BOOK2,BOOTH,CARVNG,CHASM,CHASM2,DOOR,GNOME, 2 GRATE,LAMP,PDOOR,PLANT,PLANT2,ROCKS,ROD,ROD2,SAFE, 3 TDOOR,TDOOR2,TROLL,TROLL2,EMRALD,SPICES, 4 FIND,YELL,INVENT,LEAVE,POUR,SAY,TAKE,THROW, 5 IWEST,PHUCE,TK WRITE(16)PLAC,FIXD,WEIGHT,PROP,POINTS WRITE(16) ATLOC,LINK,PLACE, 1 FIXED,MAXOBJ WRITE(16) VKEY,PTAB,VKYSIZ,PTBSIZ,TRAVEL WRITE(16)LINES,RTEXT,PTEXT,WDX,KTAB,TABSIZ WRITE(16) VERBS,VRBX,OBJS, 1 OBJX,IOBJS,IOBX,PREP,WORDS WRITE(16)ABBNUM,ADJ,ATBS,ATTACK,BCROSS,BONUS,CHASE, 1 CLOCK1,CLOCK2,CLOCK3,CLOSED,CLOSNG,CLSMAX,COMBO,DEADBT, 2 DETAIL,DKILL,DTOTAL,DWARFN,FLG239, 3 FOO,FOOBAR,FOOD,GAVEUP,HEALTH,HINT,HIT,HNTMAX,I,IKK,ILOC, 4 IOBJ,J,JJ,JK1,JKK,K,K1,KK,L,L1,LIMIT, 5 LINSIZ,LL,LMWARN,LOCK,LOGOUT,MESSAG,OBJ,PANIC, 6 PORTAL,PTBS,RDFLAG,RETN,RTXSIZ,SCORE,SCORNG,SECT, 7 SKEY,SLOC,SPK,START,STICK,TABNDX,TALLY,TALLY2,TERSE, 8 TRVS,TRVSIZ,VEND,VERB,VRBSIZ,WASTE,WKDAY,WKEND,WZDARK, 9 YEA,ACTSPK,CTEXT,CVAL,HNAME WRITE(16)ANVIL,BATTER,BEES,BILLBD,BIRD,BRUSH,CAGE, 1 CAKES,CHAIN,CHEST,CHLOC,CHLOC2,CLAM,CLOAK,CLSSES,COINS,CROWN, 2 DALTLC,DOG,DRAGON,EGGS,FISSUR,FLOWER,GATLOC,GRAIL,HIVE, 3 HONEY,HORN,JEWELS,KEYS,LYRE, 4 MAGZIN,MIRROR,MUSHRM,MXSCOR,NUGGET,OYSTER,PEARL,PHONE, 5 PILLOW,POLE,POSTER,PREPAT,PREPDN,PREPFR,PREPIN,PREPOF, 6 PREPON,PYRAM,RADIUM,RING,RUG,SAPPHI,SHIELD,SHOES, 7 SHUT,SLUGS,SNAKE,SPHERE,STEPS,STICKS,SWORD,TABLET,TRIDNT, 8 UNLOCK,VASE,WALL,WALL2,WEAR,WUMPUS,Y2,YANK WRITE(16)DTK,ATAB,VTXT,OTXT,IOTXT 1 ,TXT CLOSE(16) STOP END