! ADVGENDAT: GENERATES ADV.DAT FROM ADV.TXT USE ALLCOM; USE IFQWIN IMPLICIT INTEGER(A-Z) LOGICAL WASDARK,TREASURE CHARACTER(6) DJJ,DK,DKK,DL,DLL,MSG*52 INTEGER PHUCE2(2,4) DATA LINUSE/0/ ! PHUCE CONSISTS OF FOUR PAIRS OF ORIGIN/DESTINATION LOCATIONS FROM/TO ! WHICH ONE IS TRANSPORTED ON UTTERING THE ELFIN CURSE AT THE TINY DOOR. ! CAN GO FROM BIG TO SMALL OR SMALL TO BIG, ON EITHER SIDE OF THE DOOR. DATA PHUCE2/158,160,160,158,167,166,166,167/ ! AJAR(OBJ = TRUE IF THE OBJECT IS OPEN ! AT(OBJ) = TRUE IF ON EITHER SIDE OF TWO-PLACED OBJECT ! ATHAND(OBJ) = TRUE IF OBJECT IS HERE AND NOT IN CLOSED CONTAINER. ! BLIND(DUMMY) = TRUE IF HERO CAN'T SEE (TOO DARK OR GLAREY) ! DARK(DUMMY) = TRUE IF LOCATION "LOC" IS DARK ! DEAD(OBJ) = TRUE IF CRITTER IS KILLED (OR IN ENCHANTED SLEEP) ! FORCED(LOC) = TRUE IF LOC MOVES WITHOUT ASKING FOR INPUT (COND=2) ! HERE(OBJ) = TRUE IF THE OBJ IS AT "LOC" (OR IS BEING CARRIED) ! HINGED(OBJ) = TRUE IF OBJECT CAN BE OPENED/SHUT. ! INSIDE(LOC) = TRUE IF LOCATION IS WELL WITHIN THE CAVE ! LIQ(DUMMY) = OBJECT NUMBER OF LIQUID IN BOTTLE ! LIQLOC(LOC) = OBJECT NUMBER OF LIQUID (IF ANY) AT LOC ! LIVING(OBJ) = TRUE IF OBJ IS SOME SORT OF CRITTER ! LOCKED(OBJ) = TRUE IF OBJECT IS LOCKED. (NEED NOT HAVE A LOCK,E.G., RUSTY DOOR) ! LOCKS(OBJ) = TRUE IF OBJECT HAS A LOCK. ! OPAQUE(OBJ) = TRUE IF CONTAINER IS NOT TRANSPARENT (SACK, CHEST). TRANSPARENT OBJS: BOTTLE(GLASS), CAGE(WICKER) ! OUTSID(LOC) = TRUE IF LOCATION IS OUTSIDE THE CAVE ! PCT(N) = TRUE N% OF THE TIME (N INTEGER FROM 0 TO 100) ! PLURAL(OBJ) = TRUE IF IT IS A PLURAL OBJ (SHOES, KEYS, ETC.) ! PRINTD(OBJ) = TRUE IF OBJECT CAN BE READ. ! SMALL(OBJ) = TRUE IF OBJ FITS INTO SACK ! TOTING(OBJ) = TRUE IF THE OBJ IS BEING CARRIED ! TREASURE(OBJ) = TRUE IF OBJECT IS A TREASURE ! VESSEL(OBJ) = TRUE IF OBJECT IS A CONTAINER ! WEARNG(OBJ) = TRUE IF OBJECT IS BEING WORN ! WEARABLE(OBJ)= TRUE IF THE OBJECT CAN BE WORN ! CLOSED SAYS WHETHER WE'RE ALL THE WAY CLOSED ! CLOSNG SAYS WHETHER ITS CLOSING TIME YET ! GAVEUP SAYS WHETHER EXITED VIA "QUIT" ! LMWARN SAYS WHETHER BEEN WARNED ABOUT LAMP GOING DIM ! PANIC SAYS WHETHER FOUND OUT TRAPPED IN THE CAVE ! SCORNG INDICATES TO THE RATING ROUTINE WHETHER WE'RE DOING A "SCORE" COMMAND ! WASDARK SAYS WHETHER THE LOC ADVENTURER'S LEAVING WAS DARK ! YEA IS RANDOM YES/NO REPLY ! CLEAR OUT THE VARIOUS TEXT-POINTER ARRAYS. ALL TEXT IS STORED IN ARRAY LINES; EACH LINE IS PRECEDED BY A WORD ! POINTING TO THE NEXT POINTER (I.E. THE WORD FOLLOWING THE END OF THE LINE). THE POINTER IS NEGATIVE IF THIS IS FIRST ! LINE OF A MESSAGE. THE TEXT-POINTER ARRAYS CONTAIN INDICES OF POINTER-WORDS IN LINES. STEXT(N) IS SHORT DESCRIPTION ! OF LOCATION N. LTEXT(N) IS LONG DESCRIPTION. PTEXT(N) POINTS TO MESSAGE FOR PROP(PROPN)=0 SUCCESSIVE PROP MESSAGES ! ARE FOUND BY CHASING POINTERS. RTEXT CONTAINS SECTION 6'S STUFF. CTEXT(N) POINTS TO AN ADVENTURER-CLASS MESSAGE. ! MTEXT IS FOR SECTION 12. WE ALSO CLEAR COND. SEE DESCRIPTION OF SECTION 9 FOR DETAILS. PHUCE = PHUCE2 LINSIZ = MAX_LINES TRVSIZ = MAX_TRAVEL TABSIZ = TAB_SIZE LOCSIZ = LOC_SIZE VRBSIZ = MAX_VERB RTXSIZ = RTEXT_SIZE CLSMAX = 12 HNTSIZ = 20 MAXOBJ = MAX_OBJECT MAXLOC = MAX_LOC HNTMIN = 7 PTBSIZ = MAX_PREP ADJSIZ = MAX_ADJ VKYSIZ = MAX_VERB BLKLIN = .TRUE. DWFMAX = MAX_DWARF ISWIZ = .FALSE. ZCLYD = ICHAR('c')+256*(ICHAR('L')+ 256*(ICHAR('y')+256*ICHAR('D'))) ZLS = ICHAR('<')+256*(ICHAR('$')+256*(ICHAR('$')+256*ICHAR('<'))) !MASK FOR <$$< INDICATING NULL MESSAGE (SEE TEXT TABLES) XCLYD=IEOR(ZCLYD,ZLS) ALLSPACE = 32+256*(32+256*(32+256*32)) DO 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) CYCLE STEXT(I)=0 LTEXT(I)=0 LOCCON(I)=0 END DO DO I=1,MAXOBJ POINTS(I)%VAL=0 OBJCON(I)=0 END DO OPEN (UNIT=2,FILE='ADV.TXT',STATUS='OLD') KEY = 0 ADJKEY = 0 DO I=1,MAXOBJ WEIGHT(I) = 0 PLAC(I) = 0 FIXD(I) = 0 ADJTAB(I) = 0 END DO LINUSE=1 TRVS=1 PTBS=1 ATBS=1 CLSSES=1 ! START NEW DATA SECTION. SECT IS THE SECTION NUMBER. 1002 READ(2,"(I8)") SECT WRITE(*,"(' READING TABLE ',I2,'...')") SECT OLDLOC=-1 SELECT CASE (SECT) CASE (0); GO TO 1190 CASE (1,2,5,6,10); GO TO 1004 CASE (3); GO TO 1040 CASE (4); GO TO 1030 CASE (7); GO TO 1050 CASE (8); GO TO 1060 CASE (9); GO TO 1070 CASE (11); GO TO 1080 CASE (12,13); CALL BUG('INVALID SECTION NUMBER IN DATABASE') CASE (14); GO TO 1100 CASE (15); GO TO 1120 CASE (16); GO TO 1140 END SELECT ! SECTIONS 1, 2, 5, 6, 10 READ MESSAGES AND SET UP POINTERS. 1004 JL1=LINUSE+1 !BEGINNING OF LINE JL2=LINUSE+18 !ALLOW 72 CHARACTERS FOR EACH LINE READ (2,"(I8,19A4)") LOC,(LINES(J12),J12=JL1,JL2),KK IF (KK.NE.ALLSPACE) THEN WRITE(MSG,"(' LINE FOR LOCATION ',I0,' TOO LONG.')") LOC CALL BUG(MSG) STOP ENDIF IF (LOC.EQ.-1) GO TO 1002 !CHECK FOR NEW SECTION DO K=1,18 JKK=LINUSE+19-K IF (LINES(JKK).NE.ALLSPACE) GO TO 1007 !FIND LAST WORD END DO 1007 JL1=LINUSE+1 DO JK1=JL1,JKK LINES(JK1)=IEOR(LINES(JK1),ZCLYD) !OR IN MASK BITS END DO LINES(LINUSE)=JKK+1 !POINT TO NEXT LINE SLOT FOR NEXT MESSAGE AND ASSUME CONTINUED MESSAGE (POSITIVE NUMBER) IF (LOC.NE.OLDLOC) THEN IF (LOC.LE.OLDLOC.AND.SECT.NE.5) THEN WRITE (MSG,"(/' LINE ',I0,' OUT OF ORDER IN SECTION ',I0)") LOC,SECT CALL BUG(MSG) ENDIF LINES(LINUSE)=-LINES(LINUSE) !INDICATE WAS BEGINNING OF NEW MESSAGE (NEGATIVE NUMBER) SELECT CASE (SECT) CASE (10) CTEXT(CLSSES)=LINUSE CVAL(CLSSES)=LOC CLSSES=CLSSES+1 CASE(6) IF (LOC.GT.RTXSIZ) CALL BUG('TOO MANY RTEXT OR MTEXT MESSAGES') RTEXT(LOC)=LINUSE CASE(5) IF (LOC.GT.0.AND.LOC.LE.MAXOBJ) PTEXT(LOC)=LINUSE CASE(1) LTEXT(LOC)=LINUSE CASE DEFAULT STEXT(LOC)=LINUSE END SELECT ENDIF LINUSE=JKK+1 LINES(LINUSE)=-1 OLDLOC=LOC IF (LINUSE+18.GT.LINSIZ) CALL BUG('TOO MANY WORDS OF MESSAGES') GO TO 1004 ! THE STUFF FOR SECTION 4 IS ENCODED HERE. EACH "FROM-LOCATION" GETS A CONTIGUOUS SECTION OF THE "TRAVEL" ARRAY. ! EACH ENTRY IN TRAVEL IS NEWLOC*1000 + KEYWORD (FROM SECTION 3, MOTION VERBS), AND IS NEGATED IF IT IS THE ! LAST ENTRY FOR THIS LOCATION. KEY(N) IS THE INDEX IN TRAVEL OF THE FIRST OPTION AT LOCATION N. 1030 READ(2,"(2I8,8(A6,2X))") LOC,JNEW,(DTK(I),I=1,8) IF (LOC.EQ.0) GO TO 1030 IF (LOC.EQ.-1) GO TO 1002 IF (LOC.LT.OLDLOC) THEN WRITE (MSG,"(/' LINE ',I0,' OUT OF ORDER IN SECTION ',I0)") LOC,SECT CALL BUG('OUT OF ORDER LOCS OR RSPEAK ENTRIES.') ENDIF IF (KEY(LOC).EQ.0) THEN KEY(LOC)=TRVS ELSE TRAVEL(TRVS-1)=-TRAVEL(TRVS-1) ENDIF DO L=1,8 IF (DTK(L).EQ.' ') EXIT K=VOCABX(DTK(L),-1) TRAVEL(TRVS)=JNEW*1000+K TRVS=TRVS+1 IF (TRVS.EQ.TRVSIZ) CALL BUG('TOO MANY TRAVEL OPTIONS') END DO TRAVEL(TRVS-1)=-TRAVEL(TRVS-1) GO TO 1030 ! READ IN THE VOCABULARY. KTAB(N) IS THE WORD NUMBER, ATAB(N) IS THE CORRESPONDING WORD. THE -1 AT THE END OF ! SECTION 3 IS LEFT IN KTAB AS AN END-MARKER. THE WORDS ARE GIVEN A MINIMAL HASH TO MAKE READING THE CORE-IMAGE HARDER. 1040 DO TABNDX=1,TABSIZ READ(2,"(I8,A6)") KTAB(TABNDX),ATAB(TABNDX) IF (KTAB(TABNDX).EQ.-1) GO TO 1002 END DO CALL BUG('TOO MANY VOCABULARY WORDS') ! READ IN THE INITIAL LOCATIONS FOR EACH OBJECT. ALSO THE IMMOVABILITY INFO. PLAC CONTAINS INITIAL LOCATIONS OF OBJECTS. ! FIXD IS -1 FOR IMMOVABLE OBJECTS (INCLUDING THE SNAKE), OR = SECOND LOC FOR TWO-PLACED OBJECTS. WEIGHT CONTAINS THE ! HEAVINESS OF EACH OBJ, ON A SCALE OF 1-10. 1050 READ(2,"(4I8,2(A6,2X),3I8)") OBJ,J,K,KK,DL,DLL,(TK(I),I=1,3) IF (OBJ.EQ.-1) GO TO 1002 IF (OBJ.LE.0.OR.OBJ.GT.MAXOBJ) CALL BUG('OBJECT NUMBER TOO LARGE') PLAC(OBJ)=J FIXD(OBJ)=K WEIGHT(OBJ)=KK ! READ DEFAULT OBJECT NAMES. FOR USE IN 'TAKE ALL' COMMANDS. READ POINT VALUES FOR TREASURES. K=1 IF (TK(3).LT.0) K=-1 POINTS(OBJ)%VAL=TK(1) POINTS(OBJ)%PROP=TK(2) POINTS(OBJ)%LOC=TK(3) GO TO 1050 ! READ DEFAULT MESSAGE NUMBERS FOR ACTION VERBS, STORE IN ACTSPK. 1060 READ(2,"(10I8)") VERB,J IF (VERB.EQ.-1) GO TO 1002 ACTSPK(VERB)=J GO TO 1060 ! READ INFO ABOUT AVAILABLE LIQUIDS AND OTHER CONDITIONS, STORE IN COND. 1070 READ (2,"(10I8)") K,(TK(I),I=1,9) IF (K.EQ.-1)GO TO 1002 DO I=1,9 LOC=TK(I) IF (LOC.EQ.0) EXIT IF (BTEST(LOCCON(LOC),K)) CALL BUG('LOCATION HAS BIT SET TWICE') LOCCON(LOC)=IBSET(LOCCON(LOC),K) END DO GO TO 1070 ! READ DATA FOR HINTS. 1080 HNTMAX=0 1081 READ(2,"(10I8)")K,(TK(I),I=1,9) IF (K.EQ.-1) GO TO 1002 IF (K.NE.0) THEN IF (K.LT.0.OR.K.GT.HNTSIZ) CALL BUG('TOO MANY HINTS') HINTS(K,1:4)=TK(1:4) HNTMAX=MAX0(HNTMAX,K) ENDIF GO TO 1081 ! SECTION 14 IS THE PREPOSITION TABLE. 1100 READ(2,"(10(A6,2X))")DK,DKK,(DTK(I),I=1,8) IF (DK.EQ.'-1 ') GO TO 1002 VERB=VAL(VOCABX(DK,-4)) DJJ=DK IF (VERB.NE.-1) THEN PREP=VAL(VOCABX(DKK,-6)) DJJ=DKK IF (PREP.NE.-1) THEN IF (VKEY(VERB).NE.0) GO TO 1104 VKEY(VERB)=PTBS GO TO 1105 ENDIF ENDIF GO TO 1110 1104 PTAB(PTBS-1)=-PTAB(PTBS-1) 1105 DO L=1,8 IF (DTK(L).EQ.' ') EXIT K=VAL(VOCABX(DTK(L),-3)) IF (K.EQ.-1) THEN K=999 IF (L.NE.1.OR.DTK(1).NE.'ANY') THEN DJJ=DTK(L) GO TO 1110 ENDIF ENDIF PTAB(PTBS)=PREP*1000+K PTBS=PTBS+1 IF (PTBS.EQ.PTBSIZ) CALL BUG('TOO MANY ENTRIES IN PREP/OBJ TABLE') END DO PTAB(PTBS-1)=-PTAB(PTBS-1) GO TO 1100 1110 WRITE(MSG,"(/' UNRECOGNIZED WORD ',A6,' IN PREP/OBJ TABLE.')") DJJ CALL BUG(MSG) GO TO 1100 ! READ CONDITION BITS FOR OBJECTS. IKK IS THE BIT; TK(I), THE OBJ LIST. 1120 READ(2,"(10I8)")IKK,(TK(I),I=1,9) IF (IKK.EQ.-1) GO TO 1002 DO I=1,9 OBJ=TK(I) IF (OBJ.EQ.0) GO TO 1120 IF (OBJ.LE.0.OR.OBJ.GT.MAXOBJ) CALL BUG('OBJECT NUMBER TOO LARGE') IF (BTEST(OBJCON(OBJ),IKK)) THEN WRITE(MSG,"('BIT SET TWICE OBJ=',I5,' BIT= ',I5)") OBJ,IKK CALL BUG(MSG) ENDIF OBJCON(OBJ)=IBSET(OBJCON(OBJ),IKK) END DO GO TO 1120 ! SECTION 16 IS THE ADJECTIVE TABLE. 1140 READ (2,"(10(A6,2X))" ) DK,(DTK(I),I=1,9) IF (DK.EQ.'-1 ') GO TO 1002 ADJ=VOCABX(DK,-7) DJJ=DK IF (ADJ.EQ.-1.OR.CLASS(ADJ).NE.6) GO TO 1148 ADJ=VAL(ADJ) IF (ADJKEY(ADJ).EQ.0) THEN ADJKEY(ADJ)=ATBS ELSE ADJTAB(ATBS-1)=-ADJTAB(ATBS-1) ENDIF DO L=1,9 IF (DTK(L).EQ.' ') EXIT DJJ=DTK(L) K=VOCABX(DTK(L),-3) IF (K.EQ.-1.OR.CLASS(K).NE.2) GO TO 1148 ADJTAB(ATBS)=VAL(K) ATBS=ATBS+1 IF (ATBS.EQ.MAXOBJ) CALL BUG('TOO MANY ENTRIES IN ADJECTIVE/NOUN TABLE') END DO ADJTAB(ATBS-1)=-ADJTAB(ATBS-1) GO TO 1140 1148 WRITE(MSG,"(' UNRECOGNIZED WORD ',A6,' IN ADJECTIVE TABLE.')") DJJ CALL BUG(MSG) ! DEFINE SOME HANDY MNEMONICS CORRESPONDING TO OBJECT NUMBERS. (INCLUDES TREASURES.) 1190 CLOSE(UNIT=2) ANVIL=VOCABX('ANVIL ',2) AXE=VOCABX('AXE ',2) BASILISK=VOCABX('BASILI',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) GLASS=VOCABX('GLASS ',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) MERMAID=VOCABX('MERMAI',2) MESSAG=VOCABX('MESSAG',2) MIRROR=VOCABX('MIRROR',2) MUSHRM=VOCABX('MUSHRO',2) NUGGET=VOCABX('NUGGET',2) OIL=VOCABX('OIL ',2) 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) WINE=VOCABX('WINE ',2) WUMPUS=VOCABX('WUMPUS',2) YACHT=VOCABX('YACHT ',2) ! 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) ! AND SOME ACTION VERBS. FIND=VOCABX('FIND ',3) GO=VOCABX('GO ',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) ! 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) ! A POPULAR LOCATION IS: Y2=33 ! DATABASE READ. PROPS ARE SET TO ZERO. FINISH SETTING UP COND BY CHECKING FOR FORCED-MOTION TRAVEL ENTRIES. THE PLAC AND FIXD ! ARRAYS ARE USED TO SET UP ATLOC(N) AS THE FIRST OBJECT AT LOCATION N AND LINK(OBJ) AS THE NEXT OBJECT AT THE SAME LOCATION AS ! OBJ. OBJ>MAXOBJ INDICATES THAT FIXED(OBJ-MAXOBJ)=LOC; LINK(OBJ) IS STILL THE CORRECT LINK TO USE. ABB IS ZEROED; IT CONTROLS ! WHETHER THE ABBREVIATED DESCRIPTION IS PRINTED. COUNTS MOD 5 UNLESS "LOOK" IS USED. LOC = 1 DO I=1,MAXOBJ PLACE(I)=0 PROP(I)=0 HOLDER(I)=0 HLINK(I)=0 LINK(I)=0 LINK(I+MAXOBJ)=0 END DO DO I=1,LOCSIZ ABB(I)=0 IF (LTEXT(I).EQ.0.OR.KEY(I).EQ.0) EXIT K=KEY(I) IF (MOD(IABS(TRAVEL(K)),0001000).EQ.1) LOCCON(I)=2 ATLOC(I)=0 END DO ! SET UP ATLOC AND LINK ARRAYS AS DESCRIBED ABOVE. USE THE DROP SUBROUTINE, WHICH PREFACES NEW OBJECTS ON THE LISTS. SINCE WE ! WANT THINGS IN THE OTHER ORDER, WE RUN THE LOOP BACKWARDS. IF THE OBJECT IS IN TWO LOCS, DROP IT TWICE. SET UP "PLACE" ! AND "FIXED" AS COPIES OF "PLAC" AND "FIXD". SINCE TWO-PLACED OBJECTS ARE TYPICALLY BEST DESCRIBED LAST, DROP THEM FIRST. DO I=MAXOBJ,1,-1 IF (FIXD(I).LE.0) CYCLE CALL DROP(I+MAXOBJ,FIXD(I)) CALL DROP(I,PLAC(I)) END DO DO I=MAXOBJ,1,-1 FIXED(I)=FIXD(I) IF (PLAC(I).NE.0.AND.FIXD(I).LE.0) CALL DROP(I,PLAC(I)) END DO ! MAKE SURE ALL THE RIGHT THINGS GET CLOSED AND LOCKED, ETC., BEFORE WE GET STARTED. ! TREASURES, AS NOTED EARLIER, ARE OBJECTS WITH BIT 14 SET IN OBJCON. THEIR PROPS ARE INITIALLY -1, AND ARE SET TO 0 THE FIRST ! TIME THEY ARE DESCRIBED. TALLY KEEPS TRACK OF HOW MANY ARE NOT YET FOUND, SO WE KNOW WHEN TO CLOSE THE CAVE. TALLY2 COUNTS ! HOW MANY CAN NEVER BE FOUND (E.G. IF LOST BIRD OR BRIDGE). TALLY=0; TALLY2=0 DO I=1,MAXOBJ IF (TREASURE(I)) THEN IF (PTEXT(I).NE.0) PROP(I)=-1 ENDIF TALLY=TALLY-PROP(I) END DO ! CLEAR THE HINT STUFF. HINTLC(I) IS HOW LONG ADVENTURER'S BEEN AT LOC WITH COND BIT I. HINTED(I) TRUE IF HINT I WAS USED. DO I=1,HNTMAX HINTED(I)=.FALSE. HINTLC(I)=0 END DO ! INITIALISE THE DWARVES. DLOC IS LOC OF DWARVES, HARD-WIRED IN. ODLOC IS PRIOR LOC OF EACH DWARF, INITIALLY GARBAGE. ! DALTLC IS ALTERNATE INITIAL LOC FOR DWARF, IN CASE ONE OF THEM STARTS OUT ON TOP OF THE ADVENTURER. (NO 2 OF THE 5 ! INITIAL LOCS ARE ADJACENT.) DSEEN IS TRUE IF DWARF HAS SEEN US. DFLAG CONTROLS THE LEVEL OF ACTIVATION OF ALL THIS: ! 0 NO DWARF STUFF YET (WAIT UNTIL REACHES HALL OF MISTS) ! 1 REACHED HALL OF MISTS, BUT HASN'T MET FIRST DWARF ! 2 MET FIRST DWARF, OTHERS START MOVING, NO KNIVES THROWN YET ! 3 A KNIFE HAS BEEN THROWN (FIRST SET ALWAYS MISSES) ! 3+ DWARVES ARE MAD (INCREASES THEIR ACCURACY) ! LAST DWARF IS SPECIAL (THE PIRATE). PIRATE ALWAYS STARTS AT THE CHEST'S EVENTUAL LOCATION INSIDE THE MAZE. THIS LOC IS ! SAVED IN CHLOC FOR REF. THE DEAD END IN THE OTHER MAZE HAS ITS LOC STORED IN CHLOC2. CHLOC=114 CHLOC2=140 DSEEN=.FALSE. DFLAG=0 DLOC(1)=PLAC(SNAKE) DLOC(2)=PLAC(BOOTH) DLOC(3)=Y2 DLOC(4)=44 DLOC(5)=PLAC(CLAM) ! DLOC(6)=PLAC(VEND) DLOC(DWFMAX)=CHLOC DALTLC=PLAC(NUGGET) ! OTHER RANDOM FLAGS AND COUNTERS, AS FOLLOWS: ! ABBNUM HOW OFTEN WE SHOULD PRINT NON-ABBREVIATED DESCRIPTIONS ! BCROSS NUMBER OF TIMES COLLAPSING BRIDGE HAS BEEN TRAVERSED. ! BONUS USED TO DETERMINE AMOUNT OF BONUS FOR REACHING CLOSING ! CHASE TELLS HOW CLOSE THE WUMPUS IS TO GOBBLING ADVENTURER UP ! CLOCK1 NUMBER OF TURNS FROM FINDING LAST TREASURE TILL CLOSING ! CLOCK2 NUMBER OF TURNS FROM FIRST WARNING TILL BLINDING FLASH ! CLOCK3 NUMBER OF TURNS IN REPOSITORY TILL PHONE RINGS. AFTER TICKING TO 0, TICKS 7 TIMES TO WAKE DWARVES. ! COMBO CURRENT PROGRESS IN GIVING SAFE'S COMBINATION ! DETAIL HOW OFTEN WE'VE SAID "NOT ALLOWED TO GIVE MORE DETAIL" ! DKILL NUMBER OF DWARVES KILLED (UNUSED IN SCORING, NEEDED FOR MSG) ! FOOBAR CURRENT PROGRESS IN SAYING "FEE FIE FOE FOO". ! HEALTH PERCENTAGE OF MAXIMUM (100) FITNESS ! IWEST HOW MANY TIMES "WEST" SAID INSTEAD OF "W" ! KNFLOC 0 IF NO KNIFE HERE, LOC IF KNIFE HERE, -1 AFTER CAVEAT ! LIMIT LIFETIME OF LAMP (NOT SET HERE) ! MAXDIE NUMBER OF REINCARNATION MESSAGES AVAILABLE (UP TO 5) ! NUMDIE NUMBER OF TIMES KILLED SO FAR ! TERSE IF TRUE, NEVER PRINT LONG LOCATION DESCRIPTIONS ! TURNS TALLIES HOW MANY COMMANDS ADVENTURER'S GIVEN (IGNORES YES/NO) ! WASTE TELLS HOW LONG LAMP USED IN LIGHTED AREA. ABBNUM=5 BCROSS=0 BONUS=0 CLOCK1=25 CLOCK2=25 CLOCK3=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 I=0,4 IF (RTEXT(2*I+81).NE.0) MAXDIE=I+1 END DO NUMDIE=0 PANIC=.FALSE. SCORNG=.FALSE. TERSE=.FALSE. TURNS=0 WASTE=0 ! 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) ! AND CLEAR OUT ANY LEFTOVER WORD VECTORS... CALL CLRLIN WORDS(1:35)=0 WDX=0 ! IF SETUP=1, REPORT ON AMOUNT OF ARRAYS ACTUALLY USED, TO PERMIT REDUCTIONS. JJ=0 DO K=1,VKYSIZ IF (VKEY(K).NE.0) JJ=JJ+1 END DO DO K=1,LOCSIZ KK=LOCSIZ+1-K IF (LTEXT(KK).NE.0) EXIT END DO LL=0 OBJ=0 DO K=1,MAXOBJ IF (TREASURE(K)) LL=LL+1 IF (PTEXT(K).NE.0) OBJ=OBJ+1 END DO DO K=1,TABNDX IF (KTAB(K)/1000.EQ.2) VERB=KTAB(K)-2000 END DO DO K=1,RTXSIZ J=RTXSIZ+1-K IF (RTEXT(J).NE.0) EXIT END DO CALL RATING(SCORE,0,.FALSE.,.FALSE.,.FALSE.,.FALSE.) K=MAXOBJ PRINT 1999,LINUSE,LINSIZ,TRVS,TRVSIZ,TABNDX,TABSIZ,KK,LOCSIZ,OBJ,K,LL,VERB,VRBSIZ,J,RTXSIZ,CLSSES,CLSMAX,HNTMAX,HNTSIZ,PTBS,& PTBSIZ,JJ,VERB,MXSCOR 1999 FORMAT (' TABLE SPACE USED:'/& ' ',I6,' OF ',I6,' WORDS OF MESSAGES'/& ' ',I6,' OF ',I6,' TRAVEL OPTIONS'/& ' ',I6,' OF ',I6,' VOCABULARY WORDS'/& ' ',I6,' OF ',I6,' LOCATIONS'/& ' ',I6,' OF ',I6,' OBJECTS OF WHICH ',I2,' ARE TREASURES.'/& ' ',I6,' OF ',I6,' ACTION VERBS'/& ' ',I6,' OF ',I6,' RTEXT MESSAGES'/& ' ',I6,' OF ',I6,' CLASS MESSAGES'/& ' ',I6,' OF ',I6,' HINTS'/& ' ',I6,' OF ',I6,' VERB/PREP/OBJ OPTIONS'/& ' ',I6,' OF ',I6,' VERBS TAKE PREPOSITIONS'/& /' MAXIMUM SCORE FOR THIS VERSION IS ',I0,' POINTS.'/) OPEN (UNIT=16,FILE='ADV.DAT',STATUS='UNKNOWN',FORM='UNFORMATTED',ACCESS='SEQUENTIAL') WRITE(16) ISWIZ,ADJKEY,ADJTAB,ADJSIZ,BLKLIN,LOCCON,OBJCON,NUMDIE,MAXDIE,TURNS,KILLED,DWARF,KNIFE,KNFLOC,DFLAG,DSEEN,DLOC,& ODLOC,DWFMAX,HOLDER,HLINK,HINTLC,HINTED,HINTS,HNTSIZ,HNTMIN,BOTTLE,CASK,WATER,OIL,WINE,LIQTYP,LOC,OLDLOC,OLDLC2,& NEWLOC,MAXLOC, LTEXT,STEXT,KEY,ABB,LOCSIZ,BACK,CAVE,DPRSSN,ENTRNC,EXIT,GO,LOOK,NULL,AXE,BEAR,BOAT,BOOK,BOOK2,BOOTH,& CARVNG,CHASM,CHASM2,DOOR,GNOME,GRATE,LAMP,PDOOR,PLANT,PLANT2,ROCKS,ROD,ROD2,SAFE,TDOOR,TDOOR2,TROLL,TROLL2,EMRALD,& SPICES,FIND,YELL,INVENT,LEAVE,POUR,SAY,TAKE,THROW,IWEST,PHUCE,TK, PLAC,FIXD,WEIGHT,PROP,POINTS,ATLOC,LINK,PLACE,& FIXED,MAXOBJ,VKEY,PTAB,VKYSIZ,PTBSIZ,TRAVEL,LINES,RTEXT,PTEXT,WDX,KTAB,TABSIZ,VERBS,VRBX,OBJS,OBJX,IOBJS,IOBX,PREP,& WORDS,ABBNUM,ADJ,ATBS,ATTACK,BCROSS,BONUS,CHASE,CLOCK1,CLOCK2,CLOCK3,CLOSED,CLOSNG,CLSMAX,COMBO,DETAIL,DKILL,& DTOTAL,DWARFN,FLG239,FOO,FOOBAR,FOOD,GAVEUP,HEALTH,HINT,HNTMAX,ILOC,IOBJ,LIMIT,LINSIZ,LMWARN,LOCK,MESSAG,OBJ,& PANIC,PTBS,RDFLAG,RTXSIZ,SCORE,SCORNG,SECT,SKEY,SLOC,SPK,START,STICK,TABNDX,TALLY,TALLY2,TERSE,TRVS,TRVSIZ,VEND,& VERB,VRBSIZ,WASTE,WKDAY,WKEND,WASDARK,YEA,ACTSPK,CTEXT,CVAL,HNAME,ANVIL,BASILISK,BATTER,BEES,BILLBD,BIRD,BRUSH,& CAGE,CAKES,CHAIN,CHEST,CHLOC,CHLOC2,CLAM,CLOAK,CLSSES,COINS,CROWN,DALTLC,DOG,DRAGON,EGGS,FISSUR,FLOWER,GATLOC,& GLASS,GRAIL,HIVE,HONEY,HORN,JEWELS,KEYS,LYRE,MAGZIN,MERMAID,MIRROR,MUSHRM,MXSCOR,NUGGET,OYSTER, PEARL,PHONE,PILLOW,& POLE,POSTER,PREPAT,PREPDN,PREPFR,PREPIN,PREPOF,PREPON,PYRAM,RADIUM,RING,RUG,SAPPHI,SHIELD,SHOES,SHUT,SLUGS,SNAKE,& SPHERE,STEPS,STICKS,SWORD,TABLET,TRIDNT,UNLOCK,VASE,WALL,WALL2,WEAR,WUMPUS,YACHT,Y2,YANK,DTK,ATAB,VTXT,OTXT,IOTXT,& TXT,ZCLYD,XCLYD CLOSE(16) END