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