Path: uunet!zephyr.ens.tek.com!tekred!saab!billr
From: billr@saab.CNA.TEK.COM (Bill Randle)
Newsgroups: comp.sources.games
Subject: v09i089: adven - original adventure game in FORTRAN, Part01/08
Message-ID: <5628@tekred.CNA.TEK.COM>
Date: 18 May 90 18:19:03 GMT
Sender: news@tekred.CNA.TEK.COM
Lines: 1401
Approved: billr@saab.CNA.TEK.COM
Submitted-by: Chris Rende <cfctech!rphroy!trux!car@uunet.uu.net>
Posting-number: Volume 9, Issue 89
Archive-name: adven/Part01
[This is said to be the original FORTRAN version of
adventure, though I suspect it has been modified from
the original. Dust off your FOR{TRAN|TRASH} compiler
and enjoy. :-) -br]
#! /bin/sh
# This is a shell archive. Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file". To overwrite existing
# files, type "sh file -c". You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g.. If this archive is complete, you
# will see the following message at the end:
# "End of archive 1 (of 8)."
# Contents: README MANIFEST main.f.1
# Wrapped by billr@saab on Thu May 17 14:47:25 1990
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'README' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'README'\"
else
echo shar: Extracting \"'README'\" \(1086 characters\)
sed "s/^X//" >'README' <<'END_OF_FILE'
XI know nothing about the history of this particular version of
Xadventure, although the submitter claims that it is the original
XFORTRAN version.
X
XThere are no copyright notices in any of the code and there is no
Xauthor information either. I have not tried to compile this, but it
Xhas been around long enough that it shouldn't be a problem as long
Xas you have a fortran compiler that understands this syntax. Note that
Xthere may be system specific routines (e.g., SRCH$$(), SAVE$$()) that
Xwould need to be renamed.
X
XThe .f.alt files are ones that someone used at onetime to disable
Xgripe and log messages and the wizard monitor.
X
X -Bill Randle
X Moderator, comp.sources.games
X Tektronix, Inc.
X billr@saab.CNA.TEK.COM
X May 18, 1990
X
XP.S. Be sure to combine all three parts of main.f (main.f.1, main.f.2,
Xmain.f.3) into a single main.f file and to combine the three parts of
Xthe data file (adv.data.1, adv.data.2, adv.data.3) into a single
Xadv.data file.
X
XP.P.S. As an exercise to the reader, one is welcome to convert this
Xto C using the f2c translator and submit the results for posting.
END_OF_FILE
if test 1086 -ne `wc -c <'README'`; then
echo shar: \"'README'\" unpacked with wrong size!
fi
# end of 'README'
fi
if test -f 'MANIFEST' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'MANIFEST'\"
else
echo shar: Extracting \"'MANIFEST'\" \(3307 characters\)
sed "s/^X//" >'MANIFEST' <<'END_OF_FILE'
X File Name Archive # Description
X-----------------------------------------------------------
X MANIFEST 1 This shipping list
X README 1
X a1toa5.f 4
X a5toa1.f 8
X adv.data.1 3
X adv.data.2 4
X adv.data.3 2
X ajar.f 8
X at.f 8
X athand.f 8
X bitoff.f 8
X biton.f 8
X bits.f 8
X bitset.f 8
X blind.f 8
X bug.f 5
X burden.f 8
X carry.f 7
X ciao.f 6
X class.f 7
X clrlin.f 7
X confuz.f 7
X dark.f 7
X datime.f 7
X dead.f 8
X drop.f 7
X dstroy.f 8
X edible.f 8
X enclsd.f 7
X eqv.f 8
X forced.f 7
X getin.f 7
X getlin.f 5
X getobj.f 4
X getwds.f 6
X gripe.f 6
X gripe.f.alt 8
X gspeak.f 7
X here.f 7
X hinged.f 7
X holding.f 7
X hours.f 7
X hoursx.f 7
X insert.f 7
X inside.f 7
X juggle.f 7
X liq.f 7
X liq2.f 7
X liqloc.f 7
X living.f 7
X locked.f 7
X locks.f 8
X log.f 5
X log.f.alt 8
X login.f 7
X logout.f 7
X lookin.f 7
X main.f.1 1
X main.f.2 5
X main.f.3 6
X maint.f 6
X monitr.f 2
X monitr.f.alt 2
X motd.f 5
X motd.f.alt 8
X move.f 7
X mspeak.f 7
X newhrs.f 7
X newhrx.f 7
X noway.f 7
X opaque.f 7
X outsid.f 7
X pct.f 8
X plural.f 7
X pma1.pma 7
X pma2.pma 7
X poof.f 7
X portal.f 7
X printd.f 7
X pspeak.f 7
X put.f 7
X ran.f 7
X rating.f 3
X remove.f 7
X rspeak.f 7
X small.f 7
X speak.f 7
X start.f 5
X toting.f 7
X travl.f 4
X treasr.f 7
X val.f 8
X vessel.f 7
X vocab.f 7
X vocabx.f 7
X wearing.f 7
X wizard.f 5
X worn.f 8
X xmap.f 5
X xspeak.f 7
X yes.f 8
X yesm.f 7
X yesx.f 7
END_OF_FILE
if test 3307 -ne `wc -c <'MANIFEST'`; then
echo shar: \"'MANIFEST'\" unpacked with wrong size!
fi
# end of 'MANIFEST'
fi
if test -f 'main.f.1' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'main.f.1'\"
else
echo shar: Extracting \"'main.f.1'\" \(45748 characters\)
sed "s/^X//" >'main.f.1' <<'END_OF_FILE'
XC THIS IS THE FIRST LINE OF ADVENTURE, MAIN MODULE.
X
X SUBROUTINE MAIN
XC CURRENT LIMITS:
XC 20000 WORDS OF MESSAGE TEXT (LINES, LINSIZ).
XC 1600 TRAVEL OPTIONS (TRAVEL, TRVSIZ).
XC 600 VOCABULARY WORDS (KTAB, ATAB, TABSIZ).
XC 250 LOCATIONS (LTEXT, STEXT, KEY, LOCCON, ABB, ATLOC,
XC LOCSIZ, MAXLOC).
XC 150 OBJECTS (PLAC, PLACE, FIXD, FIXED, LINK (TWICE), PTEXT, POINTS,
XC HOLDER, HLINK, OBJCND, OBJCON, PROP, WEIGHT, MAXOBJ).
XC 60 "ACTION" VERBS (ACTSPK, VRBSIZ, VKEY).
XC 300 VERB/PREP/OBJ COMBINATIONS (PTAB, PTBSIZ).
XC 50 ADJECTIVES (ADJKEY, ADJSIZ)
XC 150 MODIFIED NOUNS (ADJTAB, MAXOBJ)
XC 400 RANDOM MESSAGES (RTEXT, RTXSIZ).
XC 12 DIFFERENT PLAYER CLASSIFICATIONS (CTEXT, CVAL, CLSMAX).
XC 20 HINTS, LESS 3 (HINTLC, HINTED, HINTS, HNTSIZ, HNTMIN).
XC 35 MAGIC MESSAGES (MTEXT, MAGSIZ).
X
XC THERE ARE ALSO LIMITS WHICH CANNOT BE EXCEEDED DUE TO THE STRUCTURE OF
XC THE DATABASE. (E.G., THE VOCABULARY USES N/1000 TO DETERMINE WORD TYPE,
XC SO THERE CAN'T BE MORE THAN 1000 WORDS OF ANY CLASS.) THESE UPPER
XC LIMITS ARE:
XC 1000 NON-SYNONYMOUS VOCABULARY WORDS OF EACH CLASS. CURRENTLY DEFINED
XC CLASSES ARE:
XC 1. MOTION/DIRECTION WORDS (EAST, WEST, UP, JUMP, ETC.)
XC 2. NOUNS/OBJECTS (LAMP, KEYS, TROLL, ETC.)
XC 3. ACTION VERBS, TRANSITIVE & INTRANSITIVE (TAKE, DROP, KILL, IN
XC 4. MISCELLANEOUS WORDS; MOSTLY THINGS OR ACTIONS WHICH GENERATE
XC FIXED REPLIES (FEE-FIE-FOE-FOO, TREE, CAVE, CURSES)
XC 5. PREPOSITIONS, DUPLICATES MANY WORDS IN SECTION 1.
XC 6. ADJECTIVES
XC 7. CONJUNCTIONS
XC 450 LOCATIONS
XC 100 OBJECTS WHICH CAN BE USED IN TRAVEL TABLE (PLUS 900 MORE, WHICH CAN'
X
X
XC DESCRIPTION OF THE DATABASE FORMAT
XC
XC
XC THE DATA FILE CONTAINS SEVERAL SECTIONS. EACH BEGINS WITH A LINE CONTAINING
XC A NUMBER IDENTIFYING THE SECTION, AND ENDS WITH A LINE CONTAINING "-1".
XC
XC SECTION 1: LONG FORM DESCRIPTIONS. EACH LINE CONTAINS A LOCATION NUMBER,
XC A TAB, AND A LINE OF TEXT. THE SET OF (NECESSARILY ADJACENT) LINES
XC WHOSE NUMBERS ARE X FORM THE LONG DESCRIPTION OF LOCATION X.
XC
XC SECTION 2: SHORT FORM DESCRIPTIONS. SAME FORMAT AS LONG FORM. NOT ALL
XC PLACES HAVE SHORT DESCRIPTIONS.
XC
XC SECTION 3: VOCABULARY. EACH LINE CONTAINS A NUMBER (N), A TAB, AND A
XC FIVE-LETTER WORD. CALL M=N/1000. IF M=0, THEN THE WORD IS A MOTION
XC VERB FOR USE IN TRAVELLING (SEE SECTION 4). ELSE, IF M=1, THE WORD IS
XC AN OBJECT. ELSE, IF M=2, THE WORD IS AN ACTION VERB (SUCH AS "CARRY"
XC OR "ATTACK"). ELSE, IF M=3, THE WORD IS A SPECIAL CASE VERB (SUCH AS
XC "DIG") AND N MOD 1000 IS AN INDEX INTO SECTION 6. OBJECTS FROM 50 TO
XC (CURRENTLY, ANYWAY) 79 ARE CONSIDERED TREASURES (FOR PIRATE, CLOSEOUT).
XC
XC SECTION 4: TRAVEL TABLE. EACH LINE CONTAINS A LOCATION NUMBER (X), A SECOND
XC LOCATION NUMBER (Y), AND A LIST OF MOTION VERBS (SEE SECTION 3).
XC EACH MOTION REPRESENTS A VERB WHICH WILL GO TO Y IF CURRENTLY AT X.
XC Y, IN TURN, IS INTERPRETED AS FOLLOWS. LET M=Y/1000, N=Y MOD 1000.
XC IF N<=MAXLOC IT IS THE LOCATION TO GO TO.
XC IF MAXLOC<N<=500 N-MAXLOC IS USED IN A COMPUTED GOTO
XC TO A SECTION OF SPECIAL CODE.
XC IF N>500 MESSAGE N-500 FROM SECTION 6 IS PRINTED,
XC AND HE STAYS WHEREVER HE IS.
XC MEANWHILE, M SPECIFIES THE CONDITIONS ON THE MOTION.
XC IF M=0 IT'S UNCONDITIONAL.
XC IF 0<M<100 IT IS DONE WITH M% PROBABILITY.
XC IF M=100 UNCONDITIONAL, BUT FORBIDDEN TO DWARVES.
XC IF 100<M<=200 HE MUST BE CARRYING OBJECT M-100.
XC IF 200<M<=300 MUST BE CARRYING OR IN SAME ROOM AS M-200.
XC IF 300<M<=400 PROP(M MOD 100) MUST *NOT* BE 0.
XC IF 400<M<=500 PROP(M MOD 100) MUST *NOT* BE 1.
XC IF 500<M<=600 PROP(M MOD 100) MUST *NOT* BE 2, ETC.
XC IF THE CONDITION (IF ANY) IS NOT MET, THEN THE NEXT *DIFFERENT*
XC "DESTINATION" VALUE IS USED (UNLESS IT FAILS TO MEET *ITS* CONDITIONS,
XC IN WHICH CASE THE NEXT IS FOUND, ETC.). TYPICALLY, THE NEXT DEST WILL
XC BE FOR ONE OF THE SAME VERBS, SO THAT ITS ONLY USE IS AS THE ALTERNATE
XC DESTINATION FOR THOSE VERBS. FOR INSTANCE:
XC 15 110022 29 31 34 35 23 43
XC 15 14 29
XC THIS SAYS THAT, FROM LOC 15, ANY OF THE VERBS 29, 31, ETC., WILL TAKE
XC HIM TO 22 IF HE'S CARRYING OBJECT 10, AND OTHERWISE WILL GO TO 14.
XC 11 303008 49
XC 11 9 50
XC THIS SAYS THAT, FROM 11, 49 TAKES HIM TO 8 UNLESS PROP(3)=0, IN WHICH
XC CASE HE GOES TO 9. VERB 50 TAKES HIM TO 9 REGARDLESS OF PROP(3).
XC (SEE DESCRIPTION FOR SECTION 14 FOR A SCHEMATIC OF TABLES.)
XC
XC SECTION 5: OBJECT DESCRIPTIONS. EACH LINE CONTAINS A NUMBER (N), A TAB,
XC AND A MESSAGE. IF N IS FROM 1 TO MAXOBJ, THE MESSAGE IS THE "INVENTORY"
XC MESSAGE FOR OBJECT N. OTHERWISE, N SHOULD BE 0000, 1000, 2000, ETC., AN
XC THE MESSAGE SHOULD BE THE DESCRIPTION OF THE PRECEDING OBJECT WHEN ITS
XC PROP VALUE IS N/1000. THE N/1000 IS USED ONLY TO DISTINGUISH MULTIPLE
XC MESSAGES FROM MULTI-LINE MESSAGES; THE PROP INFO ACTUALLY REQUIRES ALL
XC MESSAGES FOR AN OBJECT TO BE PRESENT AND CONSECUTIVE. PROPERTIES WHICH
XC PRODUCE NO MESSAGE SHOULD BE GIVEN THE MESSAGE ">$<". NOTE THAT
XC OBJECTS WITH N>100 CANNOT BE USED FOR CONDITIONAL MOTIONS IN
XC TRAVEL TABLE.
XC
XC SECTION 6: ARBITRARY MESSAGES. SAME FORMAT AS SECTIONS 1, 2, AND 5, EXCEPT
XC THE NUMBERS BEAR NO RELATION TO ANYTHING (EXCEPT FOR SPECIAL VERBS
XC IN SECTION 3).
XC
XC SECTION 7: CONTAINS LOTS OF OBJECT INFO:
XC (1) OBJECT LOCATIONS & WEIGHTS. EACH LINE CONTAINS AN OBJECT NUMBER
XC AND ITS INITIAL LOCATION (ZERO (OR OMITTED) IF NONE). IF THE OBJECT IS
XC IMMOVABLE, THE LOCATION IS FOLLOWED BY A "-1". IF IT HAS TWO LOCATIONS
XC (E.G. THE GRATE) THE FIRST LOCATION IS FOLLOWED WITH THE SECOND, AND
XC THE OBJECT IS ASSUMED TO BE IMMOVABLE. IF THE OBJECT IS MOVABLE, IT
XC HAS A THIRD NUMBER WHICH IS ITS RELATIVE WEIGHT.
XC (2) DEFAULT OBJECT NAMES. TEN CHARACTER MAXIMUM, TO PERMIT PRINTING
XC OBJECT NAMES WHEN HERO SAYS 'TAKE ALL' OR SUCH.
XC (3) POINTS. OBJECT NUMBER, A SCORE
XC VALUE, A PROP VALUE, AND A LOCATION NUMBER. THE SCORE IS
XC FOR LEAVING IT AT THE NAMED LOCATION WITH THE RIGHT PROP VALUE.
XC SCORES ARE ASSIGNED ON A DIFFICULTY SCALE OF 1-5 (1 IS
XC FOR EASY TREASURES; 5 IS FOR REAL HARD ONES), AND ARE MULTIPLIED
XC BY SOME APPROPRIATE FACTOR AT SCORING TIME.
XC
XC SECTION 8: ACTION DEFAULTS. EACH LINE CONTAINS AN "ACTION-VERB" NUMBER AND
XC THE INDEX (IN SECTION 6) OF THE DEFAULT MESSAGE FOR THE VERB.
XC
XC SECTION 9: LIQUID ASSETS, ETC. EACH LINE CONTAINS A NUMBER (N) AND UP TO 20
XC LOCATION NUMBERS. BIT N (WHERE 0 IS THE UNITS BIT) IS SET IN LOCCON(LOC
XC FOR EACH LOC GIVEN. THE COND BITS CURRENTLY ASSIGNED ARE:
XC 0 LIGHT
XC 1 IF BIT 3 IS ON: ON FOR OIL, OFF FOR WATER
XC 2 IF BIT 3 IS ON: ON FOR WINE, OFF FOR WATER & OIL
XC 3 LIQUID ASSET, SEE BITS 1 & 2
XC 4 PIRATE DOESN'T GO HERE UNLESS FOLLOWING PLAYER
XC 5 ALL LOCATIONS IN EITHER 'PORTAL'; I.E., NOT OUTSIDE
XC CAVE, BUT NOT FAR IN
XC 6 ALL LOCATIONS OUTSIDE THE CAVE
XC OTHER BITS ARE USED TO INDICATE AREAS OF INTEREST TO "HINT" ROUTINES:
XC 7 LOST IN MAZE
XC 8 PONDERING DARK ROOM
XC 9 AT WITT'S END
XC 10 TRYING TO EXTRACT SWORD
XC 11 TRYING TO GO UP SLIDE
XC 12 TRYING TO GET INTO CAVE VIA SEA ENTRANCE
XC 13 TRYING TO FIND CAVE (ANY ENTRANCE)
XC 14 TRYING TO CATCH BIRD
XC 15 TRYING TO GET OVER THE RAINBOW
XC 16 STYMIED BY DOG
XC 17 TRYING TO DEAL WITH SNAKE
XC LOCCON(LOC) IS SET TO 2, OVERRIDING ALL OTHER BITS, IF LOC HAS FORCED
XC MOTION.
XC
XC SECTION 10: CLASS MESSAGES. EACH LINE CONTAINS A NUMBER (N), A TAB, AND A
XC MESSAGE DESCRIBING A CLASSIFICATION OF PLAYER. THE SCORING SECTION
XC SELECTS THE APPROPRIATE MESSAGE, WHERE EACH MESSAGE IS CONSIDERED TO
XC APPLY TO PLAYERS WHOSE SCORES ARE HIGHER THAN THE PREVIOUS N BUT NOT
XC HIGHER THAN THIS N. NOTE THAT THESE SCORES PROBABLY CHANGE WITH EVERY
XC MODIFICATION (AND PARTICULARLY EXPANSION) OF THE PROGRAM.
XC
XC SECTION 11: HINTS. EACH LINE CONTAINS A HINT NUMBER (CORRESPONDING TO A
XC COND BIT, SEE SECTION 9), THE NUMBER OF TURNS HE MUST BE AT THE RIGHT
XC LOC(S) BEFORE TRIGGERING THE HINT, THE POINTS DEDUCTED FOR TAKING THE
XC HINT, THE MESSAGE NUMBER (SECTION 6) OF THE QUESTION, AND THE MESSAGE
XC NUMBER OF THE HINT. THESE VALUES ARE STASHED IN THE "HINTS" ARRAY.
XC HNTMAX IS SET TO THE MAX HINT NUMBER (<= HNTSIZ). NUMBERS 1-6 ARE
XC UNUSABLE SINCE COND BITS ARE OTHERWISE ASSIGNED, SO 2 IS USED TO
XC REMEMBER IF HE'S READ THE CLUE IN THE REPOSITORY, AND 3 IS USED TO
XC REMEMBER WHETHER HE ASKED FOR INSTRUCTIONS (GETS MORE TURNS, BUT LOSES
XC POINTS). HNTMIN IS SET TO THE NUMBER OF THE FIRST USABLE HINT.
XC
XC SECTION 12: MAGIC MESSAGES. IDENTICAL TO SECTION 6 EXCEPT PUT IN A SEPARATE
XC SECTION FOR EASIER REFERENCE. MAGIC MESSAGES ARE USED BY THE STARTUP,
XC MAINTENANCE MODE, AND RELATED ROUTINES.
XC
XC SECTION 14: PREPOSITION TABLE. EACH LINE CONTAINS A VERB, A PREPOSITION
XC AND VALID OBJECTS FOR THAT VERB/PREP COMBINATION. THEY ARE CONVERTED
XC INTO TWO TABLES SIMILAR IN FORMAT TO THE TRAVEL TABLE. THE FIRST
XC TABLE, VKEY, HAS ONE ENTRY PER VERB. A ZERO ENTRY INDICATES NO
XC PREPOSITION IS VALID WITH THAT VERB. A NON-ZERO ENTRY POINTS TO THE
XC BEGINNING OF THE PREP/OBJ LIST FOR THAT VERB. THE POSITION OF THE
XC ENTRY IN VKEY CORRESPONDS TO THE VERB NUMBER. THE PREP/OBJ LIST,
XC PTAB, FOR A GIVEN VERB CONSISTS OF A SERIES OF ONE-WORD ENTRIES
XC DELIMITED BY A NEGATIVE ENTRY. EACH WORD CONTAINS THE PREPOSITION
XC NUMBER TIMES 1000 PLUS THE NUMBER OF A VALID OBJECT. A SCHEMATIC
XC FOLLOWS. ENTRIES IN VKEY ARE REPRESENTED BY V1, V2, ... VN.
XC ENTRIES IN PTAB ARE REPRESENTED BY P1, P2, ..., PN (PREPOSITIONS),
XC AND OB1, OB2,..., OBN (OBJECTS).
XC
XC I VKEY(I) PTAB(J) J
XC - ------- ------- -
XC 1. V1==========>> P1,OB1 1.
XC P1,OB2 2.
XC P1,OB3 3.
XC P1,OB4 4.
XC P1,OB5 5.
XC P2,OB1 6.
XC P2,OB2 7.
XC P3,OB1 8.
XC P3,OB2 9.
XC P3,OB3 10.
XC -P3,OB4 11.
XC 2. V2==========>> P1,OB1 12.
XC P1,OB2 13.
XC P2,OB1 14.
XC -P3,OB1 15.
XC 3. 0 (THE VERB CORRESPONDING TO THIS POSITION TAKES NO PREPOSITION
XC 4. V3==========>> P1,OB1 16.
XC -P2,OB1 17.
XC
XC SECTION 15: OBJECT ATTRIBUTES. EACH LINE CONTAINS A BIT NUMBER AND
XC UP TO 20 OBJECT NUMBERS. BIT N (WHERE ZERO IS THE UNITS BIT) IS SET
XC IN OBJCON(OBJ) FOR EACH OBJECT GIVEN. THE BITS CURRENTLY ASSIGNED
XC ARE:
XC 1 THE OBJ CAN BE OPENED/CLOSED. (DOORS, GRATE, CLAM, ETC.)
XC 2 THE OBJ IS CURRENTLY OPEN.
XC 3 IT HAS A LOCK. (GRATE, CHAIN, ELFIN DOOR, ETC.)
XC 4 IT IS CURRENTLY LOCKED.
XC 5 FLAMMABLE. (IT WILL BURN IF IGNITED.)
XC 6 IT IS CURRENTLY BURNING.
XC 7 EDIBLE. FOOD, MUSHROOMS, ETC.
XC 8 PRINTED MATERIAL, ANYTHING READABLE
XC 9 A LIVING BEASTIE, E.G., DWARF, DOG, WUMPUS, ETC.
XC 10 DEAD (KILLED) BEASTIE: WUMPUS, DRAGON, SLEEPING DOG
XC 11 CAN BE WORN: CROWN, SHOES, CLOAK, JEWELS
XC 12 IS CURRENTLY BEING WORN
XC 13 REQUIRES PLURAL RESPONSES (SHOES, COINS, ETC.)
XC 14 TREASURE.
XC 15 CONTAINER.
XC 16 OBJECT IS "SMALL". (CAN FIT INTO SACK OR CHEST)
XC 17 CONTAINER IS OPAQUE -- CONTENTS ARE NOT VISIBLE UNLESS
XC CONTAINER IS OPEN.
XC
XC SECTION 16: ADJECTIVE/NOUN LIST. EACH VALID ADJECTIVE IS FOLLOWED BY
XC ALL NOUNS WHICH IT MAY MODIFY.
XC
XC SECTION 0: END OF DATABASE.
X
X IMPLICIT INTEGER(A-Z)
X LOGICAL DSEEN,BLKLIN,HINTED,YES,START,TERSE,ISWIZ,LOGOUT
X LOGICAL WZDARK,KILLED,RDFLAG,LIVING
X INTEGER*4 BITS,TRAVEL,POINTS,OBJCND,LOCCON,STEXT,RTEXT,MTEXT
X INTEGER*4 LINUSE,KK,LINSIZ,K1,PTAB,WKDAY,WKEND,HOLID,LTEXT
X INTEGER*4 PTEXT,OBJCON,J12,JL1,JL2,JKK,JK1,LINES,JNEW,RETN,CTEXT
X DOUBLE PRECISION DTK(9),ATAB,NTXT,DJJ,DK,DKK,DL,DLL
X DOUBLE PRECISION VTXT,OTXT,IOTXT,MAGIC,TXT
X
X COMMON/IZWIZ/ISWIZ
X INTEGER*4 MESSGS
X COMMON/LNKCOM/ACTIVE(32),USER(15,32),MESSGS(32),MONITO(32),
X 1 TEXT(70,32)
X LOGICAL ACTIVE
X COMMON /ADJCOM/ ADJKEY(50),ADJTAB(150),ADJSIZ
X COMMON /ALLCOM/ NTXT(150,2)
X COMMON /BITCOM/ OPENBT,LOCKBT,BURNBT,WEARBT
X COMMON /BLKCOM/ BLKLIN
X COMMON /CONCOM/ LOCCON(250),OBJCON(150)
X COMMON /DIECOM/ NUMDIE,MAXDIE,TURNS
X COMMON /DWFCOM/ DWARF,KNIFE,KNFLOC,DFLAG,DSEEN(6),DLOC(6),
X 1 ODLOC(6),DWFMAX
X COMMON /HLDCOM/ HOLDER(150),HLINK(150)
X COMMON /HNTCOM/ HINTLC(20),HINTED(20),HINTS(20,4),HNTSIZ,HNTMIN
X COMMON /LIQCOM/ BOTTLE,CASK,WATER,OIL,WINE,LIQTYP(5)
X COMMON /LOCCOM/ LOC,OLDLOC,OLDLC2,NEWLOC,MAXLOC
X COMMON /MNECOM/ BACK,CAVE,DPRSSN,ENTRNC,EXIT,GO,LOOK,NULL,
X 1 AXE,BEAR,BOAT,BOOK,BOOK2,BOOTH,CARVNG,CHASM,CHASM2,DOOR,GNOME,
X 2 GRATE,LAMP,PDOOR,PLANT,PLANT2,ROCKS,ROD,ROD2,SAFE,
X 3 TDOOR,TDOOR2,TROLL,TROLL2,EMRALD,SPICES,
X 4 FIND,YELL,INVENT,LEAVE,POUR,SAY,TAKE,THROW,
X 5 KILLED,IWEST,PHUCE(2,4),TK(20)
X
X COMMON /LTXCOM/ LTEXT(250),STEXT(250),KEY(250),ABB(250),LOCSIZ
X COMMON /OBJCOM/ PLAC(150),FIXD(150),WEIGHT(150),PROP(150),
X 1 POINTS(150)
X COMMON /PLACOM/ ATLOC(250),LINK(300),PLACE(150),
X 1 FIXED(150),MAXOBJ
X COMMON /PRPCOM/ VKEY(60),PTAB(300),VKYSIZ,PTBSIZ
X COMMON /TRVCOM/ TRAVEL(1600)
X COMMON /TXTCOM/ LINES(25000),RTEXT(400),PTEXT(150),MTEXT(45)
X COMMON /UTXCOM/ TXT(35,2),WDX
X COMMON /VOCCOM/ KTAB(600),ATAB(600),TABSIZ
X COMMON /WIZCOM/ WKDAY,WKEND,HOLID,HBEGIN,HEND,HNAME,
X 1 SHORT,MAGIC,MAGNM,LATNCY,SAVED,SAVET,SETUP
X COMMON /WRDCOM/ VERBS(45),VTXT(45,2),VRBX,OBJS(45),OTXT(45,2),
X 1 OBJX,IOBJS(15),IOTXT(15,2),IOBX,PREP,WORDS(45)
X
X DIMENSION OBJCND(150),ACTSPK(60),CTEXT(12),CVAL(12)
X DIMENSION HNAME(10)
X
X LOGICAL AJAR,AT,ATHAND,BITSET,BLIND,CLOSED,CLOSNG,
X 1 DARK,DEAD,DEMO,EDIBLE,ENCLSD,FORCED,
X 2 GAVEUP,HERE,HINGED,HOLDNG,INSIDE,LMWARN,LOCKS,OUTSID,OPAQUE,
X 3 PANIC,PCT,PLURAL,PORTAL,PRINTD,SCORNG,SMALL,
X 4 TOTING,TREASR,LOCKED,VESSEL,WEARNG,WORN,YEA,
X 5 YESM
X
X DATA LINSIZ/25000/,TRVSIZ/1600/,TABSIZ/600/,LOCSIZ/250/,
X 1 VRBSIZ/60/,RTXSIZ/400/,CLSMAX/12/,HNTSIZ/20/,MAGSIZ/45/,
X 2 MAXOBJ/150/,MAXLOC/300/,HNTMIN/7/,PTBSIZ/300/,ADJSIZ/50/,
X 3 VKYSIZ/60/,SETUP/0/,BLKLIN/.TRUE./,DWFMAX/6/,ISWIZ/.FALSE./
X
X DATA OBJCND/150*0/,LINUSE/0/
XC PHUCE CONSISTS OF FOUR PAIRS OF ORIGIN/DESTINATION LOCATIONS FROM/TO
XC WHICH ONE IS TRANSPORTED ON UTTERING THE ELFIN CURSE AT THE TINY
XC DOOR. HE CAN GO FROM BIG TO SMALL OR SMALL TO BIG, ON EITHER SIDE OF
XC THE DOOR.
X DATA PHUCE/158,160,160,158,167,166,166,167/
XC DATA PHROG/'PH','RO','GS'/
X
XC BITS(N) IS A ONE-BIT IN POSITION N, WHERE THE RIGHTMOST BIT IS BIT ZERO.
XC DATA BITS/
XC 1 1,2,4,8,16,32,64,128,256,512,1024,2048,
XC 2 :10000,:20000,:40000,
XC 3 :100000,:200000,:400000,
XC 4 :1000000,:2000000,:4000000,
XC 5 :10000000,:20000000,:40000000,
XC 6 :100000000,:200000000,:400000000,
XC 7 :1000000000,:2000000000,:4000000000,
XC 8 :10000000000,:20000000000,:40000000000,
XC 9 :100000000000,:200000000000,:400000000000/
X
X DATA DEADBT,OPENBT,LOCKBT,BURNBT,WEARBT /10,2,4,6,12/
XC STATEMENT FUNCTIONS
XC
XC
XC AJAR(OBJ = TRUE IF THE OBJECT IS OPEN
XC AT(OBJ) = TRUE IF ON EITHER SIDE OF TWO-PLACED OBJECT
XC ATHAND(OBJ) = TRUE IF OBJECT IS HERE AND NOT IN CLOSED CONTAINER.
XC BITSET(COND,L,N) = TRUE IF COND(L) HAS BIT N SET (BIT 0 IS UNITS BIT)
XC BLIND(DUMMY) = TRUE IF HERO CAN'T SEE (TOO DARK OR GLAREY)
XC DARK(DUMMY) = TRUE IF LOCATION "LOC" IS DARK
XC DEAD(OBJ) = TRUE IF CRITTER IS KILLED (OR IN ENCHANTED SLEEP)
XC FORCED(LOC) = TRUE IF LOC MOVES WITHOUT ASKING FOR INPUT (COND=2)
XC HERE(OBJ) = TRUE IF THE OBJ IS AT "LOC" (OR IS BEING CARRIED)
XC HINGED(OBJ) = TRUE IF OBJECT CAN BE OPENED/SHUT.
XC INSIDE(LOC) = TRUE IF LOCATION IS WELL WITHIN THE CAVE
XC LIQ(DUMMY) = OBJECT NUMBER OF LIQUID IN BOTTLE
XC LIQLOC(LOC) = OBJECT NUMBER OF LIQUID (IF ANY) AT LOC
XC LIVING(OBJ) = TRUE IF OBJ IS SOME SORT OF CRITTER
XC LOCKED(OBJ) = TRUE IF OBJECT IS LOCKED. (NEED NOT HAVE A LOCK,
XC E.G., RUSTY DOOR)
XC LOCKS(OBJ) = TRUE IF OBJECT HAS A LOCK.
XC OPAQUE(OBJ) = TRUE IF CONTAINER IS NOT TRANSPARENT (SACK, CHEST)
XC TRANSPARENT OBJS: BOTTLE(GLASS), CAGE(WICKER)
XC OUTSID(LOC) = TRUE IF LOCATION IS OUTSIDE THE CAVE
XC PCT(N) = TRUE N% OF THE TIME (N INTEGER FROM 0 TO 100)
XC PLURAL(OBJ) = TRUE IF IT IS A PLURAL OBJ (SHOES, KEYS, ETC.)
XC PORTAL(LOC) = TRUE IS LOCATION IS IN CAVE "ENTRANCE"
XC PRINTD(OBJ) = TRUE IF OBJECT CAN BE READ.
XC SMALL(OBJ) = TRUE IF OBJ FITS INTO SACK
XC TOTING(OBJ) = TRUE IF THE OBJ IS BEING CARRIED
XC TREASR(OBJ) = TRUE IF OBJECT IS A TREASURE
XC VESSEL(OBJ) = TRUE IF OBJECT IS A CONTAINER
XC WEARNG(OBJ) = TRUE IF OBJECT IS BEING WORN
XC WORN(OBJ) = TRUE IF THE OBJECT CAN BE WORN
XC
XC CLOSED SAYS WHETHER WE'RE ALL THE WAY CLOSED
XC CLOSNG SAYS WHETHER ITS CLOSING TIME YET
XC DEMO IS TRUE IF THIS IS A PRIME-TIME DEMONSTRATION GAME
XC GAVEUP SAYS WHETHER HE EXITED VIA "QUIT"
XC LMWARN SAYS WHETHER HE'S BEEN WARNED ABOUT LAMP GOING DIM
XC PANIC SAYS WHETHER HE'S FOUND OUT HE'S TRAPPED IN THE CAVE
XC SCORNG INDICATES TO THE RATING ROUTINE WHETHER WE'RE DOING A "SCORE" COMMAND
XC WZDARK SAYS WHETHER THE LOC HE'S LEAVING WAS DARK
XC YEA IS RANDOM YES/NO REPLY
X
X
X
X IF(SETUP.NE.0)GOTO 1200
X PRINT 1000
X1000 FORMAT(' INITIALISING...')
X
X DO 10 I=1,32
X10 ACTIVE(I)=.FALSE.
XC CLEAR OUT THE VARIOUS TEXT-POINTER ARRAYS. ALL TEXT IS STORED IN ARRAY
XC LINES; EACH LINE IS PRECEDED BY A WORD POINTING TO THE NEXT POINTER (I.E.
XC THE WORD FOLLOWING THE END OF THE LINE). THE POINTER IS NEGATIVE IF THIS IS
XC FIRST LINE OF A MESSAGE. THE TEXT-POINTER ARRAYS CONTAIN INDICES OF
XC POINTER-WORDS IN LINES. STEXT(N) IS SHORT DESCRIPTION OF LOCATION N.
XC LTEXT(N) IS LONG DESCRIPTION. PTEXT(N) POINTS TO MESSAGE FOR PROP( PROPN)=0
XC SUCCESSIVE PROP MESSAGES ARE FOUND BY CHASING POINTERS. RTEXT CONTAINS
XC SECTION 6'S STUFF. CTEXT(N) POINTS TO A PLAYER-CLASS MESSAGE. MTEXT IS FOR
XC SECTION 12. WE ALSO CLEAR COND. SEE DESCRIPTION OF SECTION 9 FOR DETAILS.
X
X DO 1001 I=1,MAXLOC
X IF(I.LE.MAXOBJ)PTEXT(I)=0
X IF(I.LE.RTXSIZ)RTEXT(I)=0
X IF(I.LE.CLSMAX)CTEXT(I)=0
X IF(I.LE.MAGSIZ)MTEXT(I)=0
X IF(I.GT.LOCSIZ)GOTO 1001
X STEXT(I)=0
X LTEXT(I)=0
X LOCCON(I)=0
X1001 CONTINUE
X
X CALL SRCH$$(1,'ADVE.BASE',9,1,TYPE,CODE)
X SETUP=1
X LINUSE=1
X TRVS=1
X PTBS=1
X ATBS=1
X CLSSES=1
X
XC START NEW DATA SECTION. SECT IS THE SECTION NUMBER.
X
X1002 READ(5,1003)SECT
X1003 FORMAT(I8)
X PRINT 1015,SECT
X1015 FORMAT (' READING TABLE ',I2,'...')
X OLDLOC=-1
X GOTO(1190,1004,1004,1040,1030,1004,1004,1050,1060,1070,1004,
X 1 1080,1004,0999,1100,1120,1140),(SECT+1)
XC (0) (1) (2) (3) (4) (5) (6) (7) (8) (9) (10)
XC (11) (12) (13) (14) (15) (16)
X999 CALL BUG(9)
X
XC SECTIONS 1, 2, 5, 6, 10, 12. READ MESSAGES AND SET UP POINTERS.
X
X1004 JL1=LINUSE+1
X JL2=LINUSE+18
X READ(5,1005)LOC,(LINES(J12),J12=JL1,JL2),KK
X1005 FORMAT(I8,19A4)
X IF(KK.EQ.' ')GOTO 1017
X PRINT 1016,LOC
X1016 FORMAT (1X,'LINE FOR LOCN ',I4,' TOO LONG.')
X CALL BUG(0)
X
X1017 IF(LOC.EQ.-1)GOTO 1002
X DO 1006 K=1,18
X JKK=LINUSE+19-K
X IF(LINES(JKK).NE.' ')GOTO 1007
X1006 CONTINUE
X IF(LOC.EQ.0)GOTO 1004
XC ABOVE KLUGE IS TO AVOID F40 BUG IF CRLF BROKEN ACROSS RECORD BOUNDARY
X CALL BUG(1)
X
X1007 JL1=LINUSE+1
X DO 1008 JK1=JL1,JKK
X1008 LINES(JK1)=XOR(LINES(JK1),'CLYD')
X LINES(LINUSE)=JKK+1
X IF(LOC.EQ.OLDLOC)GOTO 1020
X IF(LOC.GT.OLDLOC.OR.SECT.EQ.5)GOTO 1019
X PRINT 1018,LOC,SECT
X1018 FORMAT (/' LINE ',I3,' OUT OF ORDER IN SECTION ',I2)
X CALL BUG(10)
X
X1019 LINES(LINUSE)=-LINES(LINUSE)
X IF(SECT.EQ.12)GOTO 1013
X IF(SECT.EQ.10)GOTO 1012
X IF(SECT.EQ.6)GOTO 1011
X IF(SECT.EQ.5)GOTO 1010
X IF(SECT.EQ.1)GOTO 1009
X
X STEXT(LOC)=LINUSE
X GOTO 1020
X
X1009 LTEXT(LOC)=LINUSE
X GOTO 1020
X
X1010 IF(LOC.GT.0.AND.LOC.LE.MAXOBJ)PTEXT(LOC)=LINUSE
X GOTO 1020
X
X1011 IF(LOC.GT.RTXSIZ)CALL BUG(6)
X RTEXT(LOC)=LINUSE
X GOTO 1020
X
X1012 CTEXT(CLSSES)=LINUSE
X CVAL(CLSSES)=LOC
X CLSSES=CLSSES+1
X GOTO 1020
X
X1013 IF(LOC.GT.MAGSIZ)CALL BUG(6)
X MTEXT(LOC)=LINUSE
X
X1020 LINUSE=JKK+1
X LINES(LINUSE)=-1
X OLDLOC=LOC
X IF(LINUSE+18.GT.LINSIZ)CALL BUG(2)
X GOTO 1004
X
XC THE STUFF FOR SECTION 4 IS ENCODED HERE. EACH "FROM-LOCATION" GETS A
XC CONTIGUOUS SECTION OF THE "TRAVEL" ARRAY. EACH ENTRY IN TRAVEL IS
XC NEWLOC*1000 + KEYWORD (FROM SECTION 3, MOTION VERBS), AND IS NEGATED IF
XC THIS IS THE LAST ENTRY FOR THIS LOCATION. KEY(N) IS THE INDEX IN TRAVEL
XC OF THE FIRST OPTION AT LOCATION N.
X
X1030 READ(5,1031)LOC,JNEW,(DTK(I),I=1,8)
X1031 FORMAT(2I8,8(A6,2X))
X IF(LOC.EQ.0)GOTO 1030
XC ABOVE KLUGE IS TO AVOID AFOREMENTIONED F40 BUG
X IF(LOC.EQ.-1)GOTO 1002
X IF(LOC.GE.OLDLOC)GOTO 1032
X PRINT 1018,LOC,SECT
X CALL BUG(10)
X
X1032 IF(KEY(LOC).NE.0)GOTO 1033
X KEY(LOC)=TRVS
X GOTO 1035
X
X1033 TRAVEL(TRVS-1)=-TRAVEL(TRVS-1)
X1035 DO 1037 L=1,8
X IF(DTK(L).EQ.' ')GOTO 1039
X K=VOCABX(DTK(L),-1)
X TRAVEL(TRVS)=JNEW*1000+K
X TRVS=TRVS+1
X IF(TRVS.EQ.TRVSIZ)CALL BUG(3)
X1037 CONTINUE
X1039 TRAVEL(TRVS-1)=-TRAVEL(TRVS-1)
X GOTO 1030
X
XC HERE WE READ IN THE VOCABULARY. KTAB(N) IS THE WORD NUMBER, ATAB(N) IS
XC THE CORRESPONDING WORD. THE -1 AT THE END OF SECTION 3 IS LEFT IN KTAB
XC AS AN END-MARKER. THE WORDS ARE GIVEN A MINIMAL HASH TO MAKE READING THE
XC CORE-IMAGE HARDER. NOTE THAT '/7-08' HAD BETTER NOT BE IN THE LIST, SINCE
XC IT COULD HASH TO -1.
X
X1040 DO 1042 TABNDX=1,TABSIZ
X1043 READ(5,1041)KTAB(TABNDX),ATAB(TABNDX)
X1041 FORMAT(I8,A6)
X IF(KTAB(TABNDX).EQ.0)GOTO 1043
XC ABOVE KLUGE IS TO AVOID AFOREMENTIONED F40 BUG
X IF(KTAB(TABNDX).EQ.-1)GOTO 1002
X1042 CONTINUE
X CALL BUG(4)
X
XC READ IN THE INITIAL LOCATIONS FOR EACH OBJECT. ALSO THE IMMOVABILITY INFO.
XC PLAC CONTAINS INITIAL LOCATIONS OF OBJECTS. FIXD IS -1 FOR IMMOVABLE
XC OBJECTS (INCLUDING THE SNAKE), OR = SECOND LOC FOR TWO-PLACED OBJECTS.
XC WEIGHT CONTAINS THE HEAVINESS OF EACH OBJ, ON A SCALE OF 1-10.
X
X1050 READ(5,1052) OBJ,J,K,KK,DL,DLL,(TK(I),I=1,3)
X1052 FORMAT(4I8,2(A6,2X),3I8)
X IF(OBJ.EQ.-1)GOTO 1002
X IF(OBJ.LE.0.OR.OBJ.GT.MAXOBJ)CALL BUG(17)
X PLAC(OBJ)=J
X FIXD(OBJ)=K
X WEIGHT(OBJ)=KK
XC READ DEFAULT OBJECT NAMES. FOR USE IN 'TAKE ALL' COMMANDS.
X NTXT(OBJ,1)=DL
X NTXT(OBJ,2)=DLL
XC READ POINT VALUES FOR TREASURES.
X K=1
X IF(TK(3).LT.0)K=-1
X POINTS(OBJ)= (TK(1)*1000000*K) + (TK(2)*1000*K) + TK(3)
X GOTO 1050
X
XC READ DEFAULT MESSAGE NUMBERS FOR ACTION VERBS, STORE IN ACTSPK.
X
X1060 READ(5,1061)VERB,J
X1061 FORMAT(10I8)
X IF(VERB.EQ.-1)GOTO 1002
X ACTSPK(VERB)=J
X GOTO 1060
X
XC READ INFO ABOUT AVAILABLE LIQUIDS AND OTHER CONDITIONS, STORE IN COND.
X
X1070 READ(5,1061)K,(TK(I),I=1,9)
X IF(K.EQ.-1)GOTO 1002
X DO 1071 I=1,20
X LOC=TK(I)
X IF(LOC.EQ.0)GOTO 1070
X IF(BITSET(LOCCON(LOC),K))CALL BUG(8)
X1071 LOCCON(LOC)=LOCCON(LOC)+BITS(K)
X GOTO 1070
X
XC READ DATA FOR HINTS.
X
X1080 HNTMAX=0
X1081 READ(5,1061)K,(TK(I),I=1,9)
X IF(K.EQ.-1)GOTO 1002
X IF(K.EQ.0)GOTO 1081
X IF(K.LT.0.OR.K.GT.HNTSIZ)CALL BUG(7)
X DO 1083 I=1,4
X1083 HINTS(K,I)=TK(I)
X HNTMAX=MAX0(HNTMAX,K)
X GOTO 1081
X
XC SECTION 14 IS THE PREPOSITION TABLE.
X1100 READ(5,1101)DK,DKK,(DTK(I),I=1,8)
X1101 FORMAT(10(A6,2X))
X IF(DK.EQ.0)GOTO 1100
XC ABOVE KLUGE IS TO AVOID AFOREMENTIONED F40 BUG
X IF(DK.EQ.'-1 ')GOTO 1002
X VERB=VAL(VOCABX(DK,-4))
X DJJ=DK
X IF(VERB.EQ.-1)GOTO 1106
X PREP=VAL(VOCABX(DKK,-6))
X DJJ=DKK
X IF(PREP.EQ.-1)GOTO 1106
X
X IF(VKEY(VERB).NE.0)GOTO 1104
X VKEY(VERB)=PTBS
X GOTO 1105
X
X1104 PTAB(PTBS-1)=-PTAB(PTBS-1)
X1105 DO 1110 L=1,8
X IF(DTK(L).EQ.' ')GOTO 1111
X K=VAL(VOCABX(DTK(L),-3))
X IF(K.NE.-1)GOTO 1108
X K=999
X IF(L.EQ.1.AND.DTK(1).EQ.'ANY ')GOTO 1108
X DJJ=DTK(L)
X GO TO 1106
X
X1108 PTAB(PTBS)=PREP*1000+K
X PTBS=PTBS+1
X IF(PTBS.EQ.PTBSIZ)CALL BUG(15)
X1110 CONTINUE
X1111 PTAB(PTBS-1)=-PTAB(PTBS-1)
X GOTO 1100
X
XC only come here via "GO TO 1106", never should drop in.
X1106 PRINT 1107,DJJ
X1107 FORMAT(/' UNRECOGNIZED WORD "',A6,'" IN PREP/OBJ TABLE.')
X CALL BUG(14)
X
XC READ CONDITION BITS FOR OBJECTS. KK IS THE BIT; TK(I), THE OBJ LIST.
X
X1120 READ(5,1061)IKK,(TK(I),I=1,9)
X IF(IKK.EQ.-1)GOTO 1002
X DO 1125 I=1,9
X OBJ=TK(I)
X IF(OBJ.EQ.0)GOTO 1120
X IF(OBJ.LE.0.OR.OBJ.GT.MAXOBJ)CALL BUG(17)
X IF(.NOT.BITSET(OBJCND(OBJ),IKK))GOTO 1125
X WRITE(1,101)OBJ,IKK
X101 FORMAT('BIT SET TWICE OBJ=',I5,' BIT= ',I5)
X CALL BUG(16)
X1125 OBJCND(OBJ)=OBJCND(OBJ)+BITS(IKK)
X GOTO 1120
X
XC SECTION 17 IS THE ADJECTIVE TABLE.
X1140 READ(5,1141)DK,(DTK(I),I=1,9)
X1141 FORMAT(10(A6,2X))
X IF(DK.EQ.0)GOTO 1140
XC ABOVE KLUGE IS TO AVOID AFOREMENTIONED F40 BUG
X IF(DK.EQ.'-1 ')GOTO 1002
X ADJ=VOCABX(DK,-7)
X DJJ=DK
X IF(ADJ.EQ.-1.OR.CLASS(ADJ).NE.6)GOTO 1148
X ADJ=VAL(ADJ)
X IF(ADJKEY(ADJ).NE.0)GOTO 1142
X ADJKEY(ADJ)=ATBS
X GOTO 1143
X
X1142 ADJTAB(ATBS-1)=-ADJTAB(ATBS-1)
X1143 DO 1145 L=1,9
X IF(DTK(L).EQ.' ')GOTO 1146
X DJJ=DTK(L)
X K=VOCABX(DTK(L),-3)
X IF(K.EQ.-1.OR.CLASS(K).NE.2)GOTO 1148
X ADJTAB(ATBS)=VAL(K)
X ATBS=ATBS+1
X IF(ATBS.EQ.MAXOBJ)CALL BUG(18)
X1145 CONTINUE
X1146 ADJTAB(ATBS-1)=-ADJTAB(ATBS-1)
X GOTO 1140
X
X1148 PRINT 1149,DJJ
X1149 FORMAT(/' UNRECOGNIZED WORD "',A6,'" IN ADJECTIVE TABLE.')
X CALL BUG(13)
X
X
XC EVERYTHING IS READ! NOW FINISH CONSTRUCTING INTERNAL DATA FORMAT.
XC DEFINE SOME HANDY MNEMONICS. THESE CORRESPOND TO OBJECT NUMBERS.
XC (INCLUDES TREASURES.)
X
X1190 CALL CLOS$A(1)
X ANVIL=VOCABX('ANVIL ',2)
X AXE=VOCABX('AXE ',2)
X BATTER=VOCABX('BATTER ',2)
X BEAR=VOCABX('BEAR ',2)
X BEES=VOCABX('BEES ',2)
X BILLBD=VOCABX('BILLBO ',2)
X BIRD=VOCABX('BIRD ',2)
X BOAT=VOCABX('BOAT ',2)
X BOOK=VOCABX('BOOK ',2)
X BOOK2=BOOK+1
X BOOTH=VOCABX('BOOTH ',2)
X BOTTLE=VOCABX('BOTTLE ',2)
X BRUSH=VOCABX('BRUSH ',2)
X CAGE=VOCABX('CAGE ',2)
X CAKES=VOCABX('CAKES ',2)
X CARVNG=VOCABX('CARVIN ',2)
X CASK=VOCABX('CASK ',2)
X CHAIN=VOCABX('CHAIN ',2)
X CHASM=VOCABX('CHASM ',2)
X CHASM2=CHASM+1
X CHEST=VOCABX('CHEST ',2)
X CLAM=VOCABX('CLAM ',2)
X CLOAK=VOCABX('CLOAK ',2)
X COINS=VOCABX('COINS ',2)
X CROWN=VOCABX('CROWN ',2)
X DOG=VOCABX('DOG ',2)
X DOOR=VOCABX('DOOR ',2)
X DRAGON=VOCABX('DRAGON ',2)
X DWARF=VOCABX('DWARF ',2)
X EGGS=VOCABX('EGGS ',2)
X EMRALD=VOCABX('EMERAL ',2)
X FISSUR=VOCABX('FISSUR ',2)
X FLOWER=VOCABX('FLOWER ',2)
X FLY=VOCABX('FLY ',2)
X FOOD=VOCABX('FOOD ',2)
X GNOME=VOCABX('GNOME ',2)
X GRAIL=VOCABX('GRAIL ',2)
X GRATE=VOCABX('GRATE ',2)
X HIVE=VOCABX('HIVE ',2)
X HONEY=VOCABX('HONEY ',2)
X HORN=VOCABX('HORN ',2)
X JEWELS=VOCABX('JEWELS ',2)
X KEYS=VOCABX('KEYS ',2)
X KNIFE=VOCABX('KNIFE ',2)
X LAMP=VOCABX('LAMP ',2)
X LYRE=VOCABX('LYRE ',2)
X MAGZIN=VOCABX('MAGAZI ',2)
X MESSAG=VOCABX('MESSAG ',2)
X MIRROR=VOCABX('MIRROR ',2)
X MUSHRM=VOCABX('MUSHRO ',2)
X NUGGET=VOCABX('NUGGET ',2)
X OIL=VOCABX('OIL ',2)
XC OIL2=OIL+1
X OYSTER=VOCABX('OYSTER ',2)
X PLAQUE=VOCABX('PLAQUE ',2)
X PEARL=VOCABX('PEARL ',2)
X PHONE=VOCABX('PHONE ',2)
X PILLOW=VOCABX('PILLOW ',2)
X PLANT=VOCABX('PLANT ',2)
X PLANT2=PLANT+1
X POLE=VOCABX('POLE ',2)
X POSTER=VOCABX('POSTER ',2)
X PYRAM=VOCABX('PYRAMI ',2)
X RADIUM=VOCABX('RADIUM ',2)
X RING=VOCABX('RING ',2)
X ROCKS=VOCABX('ROCKS ',2)
X ROD=VOCABX('ROD ',2)
X ROD2=ROD+1
X RUG=VOCABX('RUG ',2)
X SAFE=VOCABX('SAFE ',2)
X SHIELD=VOCABX('TUBE ',2)
X SHOES=VOCABX('SHOES ',2)
X SKEY=VOCABX('KEY ',2)
X SLUGS=VOCABX('SLUGS ',2)
X SNAKE=VOCABX('SNAKE ',2)
X SPICES=VOCABX('SPICES ',2)
X SPIDER=VOCABX('SPIDER ',2)
X STEPS=VOCABX('STEPS ',2)
X STICKS=VOCABX('STICKS ',2)
X SWORD=VOCABX('SWORD ',2)
X TABLET=VOCABX('TABLET ',2)
X TDOOR=DOOR+1
X TDOOR2=TDOOR+1
X PDOOR=TDOOR2+1
X TRIDNT=VOCABX('TRIDEN ',2)
X TROLL=VOCABX('TROLL ',2)
X TROLL2=TROLL+1
X VASE=VOCABX('VASE ',2)
X VEND=VOCABX('MACHIN ',2)
X WALL=VOCABX('WALL ',2)
X WALL2=WALL+1
X WATER=VOCABX('WATER ',2)
XC WATER2=WATER+1
X WINE=VOCABX('WINE ',2)
XC WINE2=WINE+1
X WUMPUS=VOCABX('WUMPUS ',2)
X
XC THESE ARE MOTION-VERB NUMBERS.
X
X BACK=VOCABX('BACK ',1)
X CAVE=VOCABX('CAVE ',1)
X DPRSSN=VOCABX('DEPRES ',1)
X ENTRNC=VOCABX('ENTRAN ',1)
X EXIT=VOCABX('EXIT ',1)
X NULL=VOCABX('NULL ',1)
X
XC AND SOME ACTION VERBS.
X
X FIND=VOCABX('FIND ',3)
X GO=VOCABX('GO ',3)
X HIT=VOCABX('HIT ',3)
X LOOK=VOCABX('LOOK ',3)
X YELL=VOCABX('CALL ',3)
X INVENT=VOCABX('INVENT ',3)
X LEAVE=VOCABX('LEAVE ',3)
X LOCK=VOCABX('LOCK ',3)
X SAY=VOCABX('SAY ',3)
X SHUT=VOCABX('CLOSE ',3)
X TAKE=VOCABX('TAKE ',3)
X THROW=VOCABX('THROW ',3)
X UNLOCK=VOCABX('UNLOCK ',3)
X WEAR=VOCABX('WEAR ',3)
X YANK=VOCABX('YANK ',3)
X
XC AND A FEW PREPOSITIONS. PREFIX 'PREP' TO DISTINGUISH THEM FROM FUNCTIONS & R
X
X PREPAT=VOCABX('AT ',5)
X PREPDN=VOCABX('DOWN ',5)
X PREPFR=VOCABX('FROM ',5)
X PREPIN=VOCABX('IN ',5)
X PREPOF=VOCABX('OFF ',5)
X PREPON=VOCABX('ON ',5)
X
XC A POPULAR LOCATION IS:
X
X Y2=33
XC IF SETUP=2 WE DON'T NEED TO DO THIS. IT'S ONLY NECESSARY IF WE HAVEN'T DONE
XC IT AT ALL OR IF THE PROGRAM HAS BEEN RUN SINCE THEN.
X
X1200 IF(SETUP.EQ.2)GOTO 1
X IF(SETUP.EQ.-1)GOTO 13050
X
XC HAVING READ IN THE DATABASE, CERTAIN THINGS ARE NOW CONSTRUCTED. PROPS ARE
XC SET TO ZERO. WE FINISH SETTING UP COND BY CHECKING FOR FORCED-MOTION TRAVEL
XC ENTRIES. THE PLAC AND FIXD ARRAYS ARE USED TO SET UP ATLOC(N) AS THE FIRST
XC OBJECT AT LOCATION N, AND LINK(OBJ) AS THE NEXT OBJECT AT THE SAME LOCATION
XC AS OBJ. (OBJ>MAXOBJ INDICATES THAT FIXED(OBJ-MAXOBJ)=LOC; LINK(OBJ) IS STILL
XC THE CORRECT LINK TO USE.) ABB IS ZEROED; IT CONTROLS WHETHER THE ABBREVIATED
XC DESCRIPTION IS PRINTED. COUNTS MOD 5 UNLESS "LOOK" IS USED.
X
X DO 1201 I=1,MAXOBJ
X PLACE(I)=0
X PROP(I)=0
X HOLDER(I)=0
X HLINK(I)=0
X LINK(I)=0
X1201 LINK(I+MAXOBJ)=0
X
X DO 1202 I=1,LOCSIZ
X ABB(I)=0
X IF(LTEXT(I).EQ.0.OR.KEY(I).EQ.0)GOTO 1202
X K=KEY(I)
X IF(MOD(IABS(TRAVEL(K)),0001000).EQ.1)LOCCON(I)=2
X1202 ATLOC(I)=0
X
XC SET UP THE ATLOC AND LINK ARRAYS AS DESCRIBED ABOVE. WE'LL USE THE DROP
XC SUBROUTINE, WHICH PREFACES NEW OBJECTS ON THE LISTS. SINCE WE WANT THINGS
XC IN THE OTHER ORDER, WE'LL RUN THE LOOP BACKWARDS. IF THE OBJECT IS IN TWO
XC LOCS, WE DROP IT TWICE. THIS ALSO SETS UP "PLACE" AND "FIXED" AS COPIES OF
XC "PLAC" AND "FIXD". ALSO, SINCE TWO-PLACED OBJECTS ARE TYPICALLY BEST
XC DESCRIBED LAST, WE'LL DROP THEM FIRST.
X
X DO 1206 I=1,MAXOBJ
X K=MAXOBJ+1-I
X IF(FIXD(K).LE.0)GOTO 1206
X CALL DROP(K+MAXOBJ,FIXD(K))
X CALL DROP(K,PLAC(K))
X1206 CONTINUE
X
X DO 1207 I=1,MAXOBJ
X K=MAXOBJ+1-I
X FIXED(K)=FIXD(K)
X1207 IF(PLAC(K).NE.0.AND.FIXD(K).LE.0)CALL DROP(K,PLAC(K))
X
XC MAKE SURE ALL THE RIGHT THINGS GET CLOSED AND LOCKED, ETC., BEFORE
XC WE GET STARTED.
X
X DO 1220 I=1,MAXOBJ
X1220 OBJCON(I)=OBJCND(I)
X
XC TREASURES, AS NOTED EARLIER, ARE OBJECTS WITH BITSET(14) IN OBJCON.
XC THEIR PROPS ARE INITIALLY -1, AND ARE SET TO 0 THE FIRST TIME THEY ARE
XC DESCRIBED. TALLY KEEPS TRACK OF HOW MANY ARE NOT YET FOUND, SO WE KNOW
XC WHEN TO CLOSE THE CAVE. TALLY2 COUNTS HOW MANY CAN NEVER BE FOUND (E.G. IF
XC LOST BIRD OR BRIDGE).
X
X TALLY=0
X TALLY2=0
X DO 1240 I=1,MAXOBJ
X IF(.NOT.TREASR(I))GOTO 1240
X IF(PTEXT(I).NE.0)PROP(I)=-1
X1240 TALLY=TALLY-PROP(I)
X
X
XC CLEAR THE HINT STUFF. HINTLC(I) IS HOW LONG HE'S BEEN AT LOC WITH COND BIT
XC I. HINTED(I) IS TRUE IFF HINT I HAS BEEN USED.
X
X DO 1300 I=1,HNTMAX
X HINTED(I)=.FALSE.
X1300 HINTLC(I)=0
X
XC INITIALISE THE DWARVES. DLOC IS LOC OF DWARVES, HARD-WIRED IN. ODLOC IS
XC PRIOR LOC OF EACH DWARF, INITIALLY GARBAGE. DALTLC IS ALTERNATE INITIAL LOC
XC FOR DWARF, IN CASE ONE OF THEM STARTS OUT ON TOP OF THE ADVENTURER. (NO 2
XC OF THE 5 INITIAL LOCS ARE ADJACENT.) DSEEN IS TRUE IF DWARF HAS SEEN HIM.
XC DFLAG CONTROLS THE LEVEL OF ACTIVATION OF ALL THIS:
XC 0 NO DWARF STUFF YET (WAIT UNTIL REACHES HALL OF MISTS)
XC 1 REACHED HALL OF MISTS, BUT HASN'T MET FIRST DWARF
XC 2 MET FIRST DWARF, OTHERS START MOVING, NO KNIVES THROWN YET
XC 3 A KNIFE HAS BEEN THROWN (FIRST SET ALWAYS MISSES)
XC 3+ DWARVES ARE MAD (INCREASES THEIR ACCURACY)
XC SIXTH DWARF IS SPECIAL (THE PIRATE). HE ALWAYS STARTS AT HIS CHEST'S
XC EVENTUAL LOCATION INSIDE THE MAZE. THIS LOC IS SAVED IN CHLOC FOR REF.
XC THE DEAD END IN THE OTHER MAZE HAS ITS LOC STORED IN CHLOC2.
X
X CHLOC=114
X CHLOC2=140
X DO 1700 I=1,DWFMAX
X1700 DSEEN(I)=.FALSE.
X DFLAG=0
X DLOC(1)=PLAC(SNAKE)
X DLOC(2)=PLAC(BOOTH)
X DLOC(3)=Y2
X DLOC(4)=44
X DLOC(5)=PLAC(CLAM)
XC DLOC(6)=PLAC(VEND)
X DLOC(DWFMAX)=CHLOC
X DALTLC=PLAC(NUGGET)
X
XC OTHER RANDOM FLAGS AND COUNTERS, AS FOLLOWS:
XC ABBNUM HOW OFTEN WE SHOULD PRINT NON-ABBREVIATED DESCRIPTIONS
XC BCROSS NUMBER OF TIMES COLLAPSING BRIDGE HAS BEEN TRAVERSED.
XC BONUS USED TO DETERMINE AMOUNT OF BONUS IF HE REACHES CLOSING
XC CHASE TELLS HOW CLOSE THE WUMPUS IS TO GOBBLING HIM UP
XC CLOCK1 NUMBER OF TURNS FROM FINDING LAST TREASURE TILL CLOSING
XC CLOCK2 NUMBER OF TURNS FROM FIRST WARNING TILL BLINDING FLASH
XC CLOCK3 NUMBER OF TURNS IN REPOSITORY TILL PHONE RINGS.
XC AFTER TICKING TO 0, TICKS 7 TIMES TO WAKE DWARVES.
XC COMBO CURRENT PROGRESS IN GIVING SAFE'S COMBINATION
XC DETAIL HOW OFTEN WE'VE SAID "NOT ALLOWED TO GIVE MORE DETAIL"
XC DKILL NUMBER OF DWARVES KILLED (UNUSED IN SCORING, NEEDED FOR MSG)
XC FOOBAR CURRENT PROGRESS IN SAYING "FEE FIE FOE FOO".
XC HEALTH PERCENTAGE OF MAXIMUM (100) FITNESS
XC IWEST HOW MANY TIMES HE'S SAID "WEST" INSTEAD OF "W"
XC KNFLOC 0 IF NO KNIFE HERE, LOC IF KNIFE HERE, -1 AFTER CAVEAT
XC LIMIT LIFETIME OF LAMP (NOT SET HERE)
XC MAXDIE NUMBER OF REINCARNATION MESSAGES AVAILABLE (UP TO 5)
XC NUMDIE NUMBER OF TIMES KILLED SO FAR
XC TERSE IF TRUE, NEVER PRINT LONG LOCATION DESCRIPTIONS
XC TURNS TALLIES HOW MANY COMMANDS HE'S GIVEN (IGNORES YES/NO)
XC WASTE TELLS HOW LONG HE HAS USED LAMP IN LIGHTED AREA.
X
XC LOGICALS WERE EXPLAINED EARLIER
X
X ABBNUM=5
X BCROSS=0
X BONUS=0
X CLOCK1=30
X CLOCK2=50
X CLOCK3=20+RAN(20)
X CHASE=0
X CLOSED=.FALSE.
X CLOSNG=.FALSE.
X COMBO=0
X DETAIL=0
X DKILL=0
X FOOBAR=0
X GAVEUP=.FALSE.
X HEALTH=100
X IWEST=0
X KNFLOC=0
X LMWARN=.FALSE.
X DO 1800 I=0,4
X1800 IF(RTEXT(2*I+81).NE.0)MAXDIE=I+1
X NUMDIE=0
X PANIC=.FALSE.
X SAVED=0
X SCORNG=.FALSE.
X TERSE=.FALSE.
X TURNS=0
X WASTE=0
X
XC SETUP THE LIQUIDS ACCORDING TO CONTAINER PROP VALUES
X LIQTYP(1)=WATER
X LIQTYP(2)=0
X LIQTYP(3)=OIL
X LIQTYP(4)=0
X LIQTYP(5)=WINE
X
X PROP(POLE)=1
X PROP(SKEY)=1
X PLACE(WATER)=-1
X CALL INSERT(WATER,BOTTLE)
X PLACE(BOOK)=-1
X CALL INSERT(BOOK,SAFE)
X
XC AND CLEAR OUT ANY LEFTOVER WORD VECTORS...
X CALL CLRLIN
X DO 1810 WDX=1,35
X1810 WORDS(WDX)=0
X WDX=0
X
XC IF SETUP=1, REPORT ON AMOUNT OF ARRAYS ACTUALLY USED, TO PERMIT REDUCTIONS.
X
X IF(SETUP.NE.1)GOTO 1
X SETUP=2
X
X JJ=0
X DO 1989 K=1,VKYSIZ
X1989 IF(VKEY(K).NE.0)JJ=JJ+1
X
X DO 1998 K=1,LOCSIZ
X KK=LOCSIZ+1-K
X IF(LTEXT(KK).NE.0)GOTO 1997
X1998 CONTINUE
X
X1997 LL=0
X OBJ=0
X DO 1996 K=1,MAXOBJ
X IF(TREASR(K))LL=LL+1
X1996 IF(PTEXT(K).NE.0)OBJ=OBJ+1
X
X DO 1995 K=1,TABNDX
X1995 IF(KTAB(K)/1000.EQ.2)VERB=KTAB(K)-2000
X
X DO 1994 K=1,RTXSIZ
X J=RTXSIZ+1-K
X IF(RTEXT(J).NE.0)GOTO 1993
X1994 CONTINUE
X
X1993 DO 1992 K=1,MAGSIZ
X I=MAGSIZ+1-K
X IF(MTEXT(I).NE.0)GOTO 1991
X1992 CONTINUE
X
X1991 CALL RATING(SCORE,MXSCOR,0,0,0,0,0)
X K=MAXOBJ
X PRINT 1999,LINUSE,LINSIZ,TRVS,TRVSIZ,TABNDX,TABSIZ,KK,
X 1 LOCSIZ,OBJ,K,LL,VERB,VRBSIZ,J,RTXSIZ,CLSSES,CLSMAX,
X 2 HNTMAX,HNTSIZ,I,MAGSIZ,PTBS,PTBSIZ,JJ,VERB,
X 3 MXSCOR
X1999 FORMAT (' TABLE SPACE USED:'/
X 1 ' ',I6,' OF ',I6,' WORDS OF MESSAGES'/
X 2 ' ',I6,' OF ',I6,' TRAVEL OPTIONS'/
X 3 ' ',I6,' OF ',I6,' VOCABULARY WORDS'/
X 4 ' ',I6,' OF ',I6,' LOCATIONS'/
X 5 ' ',I6,' OF ',I6,' OBJECTS OF WHICH ',I2,' ARE TREASURES.'/
X 6 ' ',I6,' OF ',I6,' ACTION VERBS'/
X 7 ' ',I6,' OF ',I6,' RTEXT MESSAGES'/
X 8 ' ',I6,' OF ',I6,' CLASS MESSAGES'/
X 9 ' ',I6,' OF ',I6,' HINTS'/
X 1 ' ',I6,' OF ',I6,' MAGIC MESSAGES'/
X 2 ' ',I6,' OF ',I6,' VERB/PREP/OBJ OPTIONS'/
X 3 ' ',I6,' OF ',I6,' VERBS TAKE PREPOSITIONS'/
X 4 /' MAXIMUM SCORE FOR THIS VERSION IS ',I4,' POINTS.'/
X 5 )
X
XC FINALLY, SINCE WE'RE CLEARLY SETTING THINGS UP FOR THE FIRST TIME...
X
X IF(YESM(33,0,0))CALL XMAP
X CALL POOF
X PAUSE 5
XC START-UP, DWARF STUFF
X
X1 DEMO=START(0)
X CALL MOTD(.FALSE.)
X I=RAN(1)
X CALL RSPEAK(325)
X HINTED(3)=YES(65,1,0)
X NEWLOC=1
X SETUP=3
X LIMIT=280
X IF(HINTED(3))LIMIT=550
X
XC CAN'T LEAVE CAVE ONCE IT'S CLOSING (EXCEPT BY MAIN OFFICE).
X
X2 IF(.NOT.OUTSID(NEWLOC).OR.NEWLOC.EQ.0.OR..NOT.CLOSNG)GOTO 71
X CALL RSPEAK(130)
X NEWLOC=LOC
X IF(.NOT.PANIC)CLOCK2=15
X PANIC=.TRUE.
X
XC SEE IF A DWARF HAS SEEN HIM AND HAS COME FROM WHERE HE WANTS TO GO. IF SO,
XC THE DWARF'S BLOCKING HIS WAY. IF COMING FROM PLACE FORBIDDEN TO PIRATE
XC (DWARVES ROOTED IN PLACE) LET HIM GET OUT (AND ATTACKED).
X
X71 IF(NEWLOC.EQ.LOC)GOTO 74
X ILOC=LOC
X171 IF(FORCED(ILOC))GOTO 74
X172 IF(AND(LOCCON(ILOC),000016).NE.0)GOTO 74
X L1=DWFMAX-1
X DO 73 I=1,L1
X IF(ODLOC(I).NE.NEWLOC.OR..NOT.DSEEN(I))GOTO 73
X NEWLOC=LOC
X CALL RSPEAK(2)
X GOTO 74
X73 CONTINUE
X74 LOC=NEWLOC
X
XC DWARF STUFF. SEE EARLIER COMMENTS FOR DESCRIPTION OF VARIABLES. REMEMBER
XC SIXTH DWARF IS PIRATE AND IS THUS VERY DIFFERENT EXCEPT FOR MOTION RULES.
X
XC FIRST OFF, DON'T LET THE DWARVES FOLLOW HIM INTO A PIT OR A WALL. ACTIVATE
XC THE WHOLE MESS THE FIRST TIME HE GETS AS FAR AS THE HALL OF MISTS (LOC 15).
XC IF NEWLOC IS FORBIDDEN TO PIRATE (IN PARTICULAR, IF IT'S BEYOND THE TROLL
XC BRIDGE), BYPASS DWARF STUFF. THAT WAY PIRATE CAN'T STEAL RETURN TOLL, AND
XC DWARVES CAN'T MEET THE BEAR. ALSO MEANS DWARVES WON'T FOLLOW HIM INTO DEAD
XC END IN MAZE, BUT C'EST LA VIE. THEY'LL WAIT FOR HIM OUTSIDE THE DEAD END.
X
X IF(LOC.EQ.0.OR.FORCED(LOC).OR.AND(LOCCON(NEWLOC),000016).NE.0)
X 1 GOTO 2000
X IF(DFLAG.NE.0)GOTO 6000
X IF(INSIDE(LOC))DFLAG=1
X GOTO 2000
X
XC WHEN WE ENCOUNTER THE FIRST DWARF, WE KILL 0, 1, OR 2 OF THE DWFMAX DWARVES.
XC IF ANY OF THE SURVIVORS IS AT LOC, REPLACE HIM WITH THE ALTERNATE.
X
X6000 IF(DFLAG.NE.1)GOTO 6010
X IF(.NOT.INSIDE(LOC).OR.PCT(95))GOTO 2000
X DFLAG=2
X DO 6001 I=1,2
X J=1+RAN(DWFMAX-1)
XC IF SAVED NOT = -1, HE BYPASSED THE "START" CALL.
X6001 IF(PCT(50).AND.SAVED.EQ.-1)DLOC(J)=0
X L1=DWFMAX-1
X DO 6002 I=1,L1
X IF(DLOC(I).EQ.LOC)DLOC(I)=DALTLC
X6002 ODLOC(I)=DLOC(I)
X CALL RSPEAK(3)
X CALL DROP(AXE,LOC)
X GOTO 2000
X
XC THINGS ARE IN FULL SWING. MOVE EACH DWARF AT RANDOM, EXCEPT IF HE'S SEEN US
XC HE STICKS WITH US. DWARVES NEVER GO TO LOCS WHICH ARE OUTSIDE OR IN
XC EITHER OF THE TWO PORTAL AREAS. IF WANDERING AT RANDOM, THEY
XC DON'T BACK UP UNLESS THERE'S NO ALTERNATIVE. IF THEY DON'T HAVE TO
XC MOVE, THEY ATTACK. AND, OF COURSE, DEAD DWARVES DON'T DO MUCH OF ANYTHING.
X
X6010 DTOTAL=0
X ATTACK=0
X STICK=0
X DO 6030 I=1,DWFMAX
X IF(DLOC(I).EQ.0)GOTO 6030
X J=1
X KK=KEY(DLOC(I))
X IF(KK.EQ.0)GOTO 6016
X6012 NEWLOC=MOD(IABS(TRAVEL(KK))/1000,1000)
X IF(NEWLOC.GT.MAXLOC.OR.NEWLOC.EQ.ODLOC(I)
X 1 .OR..NOT.INSIDE(NEWLOC)
X 2 .OR.(J.GT.1.AND.NEWLOC.EQ.TK(J-1)).OR.J.GE.20
X 3 .OR.NEWLOC.EQ.DLOC(I).OR.FORCED(NEWLOC)
X 4 .OR.(I.EQ.DWFMAX.AND.AND(LOCCON(NEWLOC),000016).NE.0)
X 5 .OR.IABS(TRAVEL(KK))/1000.EQ.100)GOTO 6014
X TK(J)=NEWLOC
X J=J+1
X6014 KK=KK+1
X IF(TRAVEL(KK-1).GE.0)GOTO 6012
X6016 TK(J)=ODLOC(I)
X IF(J.GE.2)J=J-1
X J=1+RAN(J)
X ODLOC(I)=DLOC(I)
X DLOC(I)=TK(J)
X DSEEN(I)=(DSEEN(I).AND.INSIDE(LOC))
X 1 .OR.(DLOC(I).EQ.LOC.OR.ODLOC(I).EQ.LOC)
X IF(.NOT.DSEEN(I))GOTO 6030
X DLOC(I)=LOC
X IF(I.NE.DWFMAX)GOTO 6027
X
XC THE PIRATE'S SPOTTED HIM. HE LEAVES HIM ALONE ONCE WE'VE FOUND CHEST.
XC K COUNTS IF A TREASURE IS HERE. IF NOT, AND TALLY=TALLY2 PLUS ONE FOR
XC AN UNSEEN CHEST, LET THE PIRATE BE SPOTTED.
X
X IF(LOC.EQ.CHLOC.OR.PROP(CHEST).GE.0)GOTO 6030
X K=0
X DO 6020 J=1,MAXOBJ
XC PIRATE WON'T TAKE PYRAMID FROM PLOVER ROOM OR DARK ROOM (TOO EASY!).
X IF(.NOT.TREASR(J).OR.(J.EQ.CASK.AND.LIQ(CASK).NE.WINE))GOTO 6020
X IF(J.EQ.PYRAM.AND.(LOC.EQ.PLAC(PYRAM)
X 1 .OR.LOC.EQ.PLAC(EMRALD)))GOTO 6020
X IF(TOTING(J).AND.ATHAND(J))GOTO 6022
X6020 IF(HERE(J).AND.TREASR(J))K=1
X IF(TALLY.EQ.TALLY2+1.AND.K.EQ.0.AND.PLACE(CHEST).EQ.0
X 1 .AND.ATHAND(LAMP).AND.PROP(LAMP).EQ.1)GOTO 6025
X IF(ODLOC(DWFMAX).NE.DLOC(DWFMAX).AND.PCT(30))CALL RSPEAK(127)
X GOTO 6030
X
X6022 CALL RSPEAK(128)
XC DON'T STEAL CHEST BACK FROM TROLL!
X IF(PLACE(MESSAG).EQ.0)CALL MOVE(CHEST,CHLOC)
X CALL MOVE(MESSAG,CHLOC2)
X DO 6023 J=1,MAXOBJ
X IF(.NOT.TREASR(J).OR.(J.EQ.PYRAM.AND.
X 1 (LOC.EQ.PLAC(PYRAM).OR.LOC.EQ.PLAC(EMRALD))).OR.
X 2 (J.EQ.CASK.AND.LIQ(CASK).NE.WINE).OR.
X 3 (ENCLSD(J).AND..NOT.ATHAND(J)))GOTO 6023
X IF(AT(J).AND.FIXED(J).EQ.0)CALL CARRY(J,LOC)
X IF(ENCLSD(J))CALL REMOVE(J)
X IF(.NOT.HOLDNG(J))GOTO 6023
X CALL INSERT(J,CHEST)
X IF(.NOT.WEARNG(J))GOTO 6023
X PROP(J)=0
X CALL BITOFF(J,WEARBT)
X6023 CONTINUE
X6024 DLOC(DWFMAX)=CHLOC
X ODLOC(DWFMAX)=CHLOC
X DSEEN(DWFMAX)=.FALSE.
X GOTO 6030
X
X6025 CALL RSPEAK(186)
X CALL MOVE(CHEST,CHLOC)
X CALL MOVE(MESSAG,CHLOC2)
X GOTO 6024
X
XC THIS THREATENING LITTLE DWARF IS IN THE ROOM WITH HIM!
X
X6027 DTOTAL=DTOTAL+1
X IF(ODLOC(I).NE.DLOC(I))GOTO 6030
X ATTACK=ATTACK+1
X IF(KNFLOC.GE.0)KNFLOC=LOC
X IF(RAN(1000).LT.95*(DFLAG-2))STICK=STICK+1
X6030 CONTINUE
X
END_OF_FILE
if test 45748 -ne `wc -c <'main.f.1'`; then
echo shar: \"'main.f.1'\" unpacked with wrong size!
fi
# end of 'main.f.1'
fi
echo shar: End of archive 1 \(of 8\).
cp /dev/null ark1isdone
MISSING=""
for I in 1 2 3 4 5 6 7 8 ; do
if test ! -f ark${I}isdone ; then
MISSING="${MISSING} ${I}"
fi
done
if test "${MISSING}" = "" ; then
echo You have unpacked all 8 archives.
rm -f ark[1-9]isdone
else
echo You still need to unpack the following archives:
echo " " ${MISSING}
fi
## End of shell archive.
exit 0