billr@saab.CNA.TEK.COM (Bill Randle) (08/23/90)
Submitted-by: Doug McDonald <mcdonald@aries.scs.uiuc.edu>
Posting-number: Volume 11, Issue 30
Archive-name: adven2/Part04
Supersedes: adven: Volume 9, Issue 89-96
#! /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 4 (of 7)."
# Contents: aamain.f.xab advent.doc
# Wrapped by billr@saab on Wed Aug 22 16:47:42 1990
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'aamain.f.xab' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'aamain.f.xab'\"
else
echo shar: Extracting \"'aamain.f.xab'\" \(41617 characters\)
sed "s/^X//" >'aamain.f.xab' <<'END_OF_FILE'
X OBJ=KK
X IOBJ=CASK
X GOTO 21560
X
X11540 IF(LL.EQ.0)GOTO 10000
X OBJ=LL
X IOBJ=-1
X GOTO 21560
X
X21500 IF(OBJ.EQ.0.AND.(IOBJ.EQ.BOTTLE.OR.IOBJ.EQ.CASK))OBJ=LIQ(IOBJ)
X SPK=110
X IF(OBJ.EQ.OIL)SPK=301
X IF(OBJ.NE.WATER.AND.OBJ.NE.WINE)GOTO 2011
X IF(IOBJ.NE.0)GOTO 21560
X IF(OBJ.EQ.LIQLOC(LOC))IOBJ=-1
X IF(ATHAND(CASK).AND.OBJ.EQ.LIQ(CASK))IOBJ=CASK
X IF(ATHAND(BOTTLE).AND.OBJ.EQ.LIQ(BOTTLE))IOBJ=BOTTLE
X21560 SPK=73
X IF(IOBJ.EQ.-1)GOTO 21570
X IF(IOBJ.EQ.CASK)OBJ=OBJ+1
X CALL REMOVE(OBJ)
X PLACE(OBJ)=0
X PROP(IOBJ)=1
X SPK=74
X IF(IOBJ.EQ.CASK)SPK=299
X21570 IF(OBJ.EQ.WATER.OR.OBJ.EQ.WATER+1)GOTO 2011
X
XC UH-OH. HE'S A WINO. LET HIM REAP THE REWARDS OF INCONTINENCE.
XC HE'LL WANDER AROUND FOR AWHILE, THEN WAKE UP SOMEWHERE OR OTHER,
XC HAVING DROPPED MOST OF HIS STUFF.
X
X CALL RSPEAK(300)
X IF(PROP(LAMP).EQ.1)LIMIT=LIMIT-RANZ(LIMIT)/2
X IF(LIMIT.LT.10)LIMIT=25
X K=0
X IF(PCT(15))K=49
X IF(K.EQ.0.AND.PCT(15))K=53
X IF(K.EQ.0.AND.PCT(25))K=132
X IF(K.EQ.0)K=175
X IF(OUTSID(LOC))K=5
X IF(K.EQ.LOC)GOTO 2100
X IF(HOLDNG(AXE))CALL MOVE(AXE,K)
X IF(HOLDNG(LAMP))CALL MOVE(LAMP,K)
X DO 21580 J=1,MAXOBJ
X IF(WEARNG(J))CALL BITOFF(J,WEARBT)
X21580 IF(HOLDNG(J))CALL DROP(J,LOC)
X LOC=K
X NEWLOC=K
X GOTO 2
X
X
X
X
X
XC RUB. YIELDS VARIOUS SNIDE REMARKS.
X
X21600 IF(OBJ.NE.LAMP)SPK=76
X GOTO 2011
XC THROW OBJ AT IOBJ.
XC SAME AS DISCARD UNLESS AXE. THEN SAME AS ATTACK EXCEPT IGNORE BIRD,
XC AND IF DWARF IS PRESENT THEN ONE MIGHT BE KILLED.
XC AXE ALSO SPECIAL FOR DRAGON, BEAR, DOG, WUMPUS AND TROLL.
XC TREASURES SPECIAL FOR TROLL.
XC IF THROWING FOOD AT SOMEONE WHO MIGHT BE HUNGRY, GO FEED HIM.
X
X21700 IF(PREP.EQ.PREPDN)GOTO 24200
X IF(HOLDNG(ROD2).AND.OBJ.EQ.ROD.AND..NOT.HOLDNG(ROD))OBJ=ROD2
X IF(.NOT.HOLDNG(OBJ))GOTO 2011
X IF(OBJ.EQ.BOAT.OR.OBJ.EQ.BEAR)GOTO 2070
X DWARFN=0
X IF(IOBJ.NE.0)GOTO 21750
X
XC NO INDIRECT OBJ WAS SPECIFIED. IF A DWARF IS PRESENT, ASSUME IT
XC IS THE IOBJ. IF NOT, LOOK FOR ANY OTHER LIVING THING. IF NO LIVING
XC THINGS PRESENT, TREAT 'THROW' AS 'DROP'.
X
X L1=DWFMAX-1
X DO 21710 DWARFN=1,L1
X IF(DLOC(DWARFN).EQ.LOC.AND.DFLAG.GE.2)GOTO 21718
X21710 CONTINUE
X DWARFN=0
X
XC NO DWARVES PRESENT; FIGURE OUT PLAUSIBLE OBJECT.
X
X K=0
X DO 21715 I=1,MAXOBJ
X IF(.NOT. (AT(I).AND.LIVING(I)) )GOTO 21715
X IOBJ=I
X K=K+1
X21715 CONTINUE
X IF(K.EQ.0)GOTO 20200
X
XC IT IS A BEASTIE OF SOME SORT. IS THERE MORE THAN ONE?
XC DON'T KILL THE BIRD BY DEFAULT.
X
X21717 IF(K.EQ.1)GOTO 21718
X CALL RSPEAK(43)
X GOTO 2600
X
X21718 IF(IOBJ.EQ.BIRD)GOTO 20200
X IF(TREASR(OBJ).AND.AT(TROLL))IOBJ=TROLL
X
X21750 IF(TREASR(OBJ).AND.IOBJ.EQ.TROLL)GOTO 21790
X IF(OBJ.EQ.SWORD.OR.OBJ.EQ.BOTTLE)GOTO 22800
X IF(DWARFN.NE.0)IOBJ=DWARF
X IF(OBJ.EQ.FLOWER.AND.IOBJ.EQ.HIVE)IOBJ=BEES
X IF(EDIBLE(OBJ).AND.LIVING(IOBJ))GOTO 22100
X IF(OBJ.NE.AXE)GOTO 20200
X SPK=152
X IF(IOBJ.EQ.DRAGON.AND.PROP(DRAGON).EQ.0)GOTO 21755
X SPK=158
X IF(IOBJ.EQ.TROLL)GOTO 21755
X IF(IOBJ.NE.DWARF)GOTO 21760
X SPK=48
X IF(RANZ(4).EQ.0)GOTO 21755
X IF(DWARFN.NE.0)GOTO 21753
X L1=DWFMAX-1
X DO 21752 DWARFN=1,L1
X IF(DLOC(DWARFN).EQ.LOC.AND.DFLAG.GE.2)GOTO 21753
X21752 CONTINUE
XC 'ATTACK' WITH AXE OR SWORD LINKS IN HERE.
X21753 DSEEN(DWARFN)=.FALSE.
X DLOC(DWARFN)=0
X SPK=47
X DKILL=DKILL+1
X IF(DKILL.EQ.1)SPK=149
X21755 CALL RSPEAK(SPK)
X CALL DROP(AXE,LOC)
X NEWLOC=LOC
X GOTO 2
X
XC THIS'LL TEACH HIM TO THROW THE AXE AT THE BEAR!
X21760 IF(IOBJ.NE.BEAR.OR.PROP(BEAR).NE.0)GOTO 21765
X SPK=164
X CALL DROP(AXE,LOC)
X FIXED(AXE)=-1
X PROP(AXE)=1
X CALL JUGGLE(BEAR)
X GOTO 2011
X
XC OR THE WUMPUS!
X21765 IF(IOBJ.NE.WUMPUS.OR.PROP(WUMPUS).EQ.6)GOTO 21770
X IF(PROP(WUMPUS).EQ.6)GOTO 20200
X SPK=245
X PROP(AXE)=2
X IF(PROP(WUMPUS).EQ.0)GOTO 21780
X SPK=243
X CALL DSTROY(AXE)
X GOTO 2011
X
XC OR THE NICE DOGGIE!
X21770 IF(IOBJ.NE.DOG.OR.PROP(DOG).EQ.1)GOTO 21790
X SPK=248
X PROP(AXE)=3
X21780 CALL DROP(AXE,LOC)
X FIXED(AXE)=-1
X CALL JUGGLE(IOBJ)
X GOTO 2011
X
XC SNARF A TREASURE FOR THE TROLL.
X21790 IF(IOBJ.NE.TROLL)GOTO 21795
X PREP=0
X IF(OBJ.EQ.CASK.AND.LIQ(CASK).NE.WINE)GOTO 20200
X SPK=159
X CALL DROP(OBJ,0)
X IF(OBJ.EQ.CASK)PLACE(WINE+1)=0
X CALL MOVE(TROLL,0)
X CALL MOVE(TROLL+MAXOBJ,0)
X CALL DROP(TROLL2,PLAC(TROLL))
X CALL DROP(TROLL2+MAXOBJ,FIXD(TROLL))
X CALL JUGGLE(CHASM)
X GOTO 2011
X
XC THROWING AXE AT NONE OF THE ABOVE. ASSUME 'ATTACK'.
X21795 OBJ=IOBJ
X IOBJ=OBJS(OBJX)
X GOTO 21200
XC QUIT. INTRANSITIVE ONLY. VERIFY INTENT AND EXIT IF THAT'S WHAT HE WANTS.
X
X11800 GAVEUP=YES(22,54,54)
X11850 IF(GAVEUP)GOTO 95000
X GOTO 2100
X
XC FIND. MIGHT BE CARRYING IT, OR IT MIGHT BE HERE. ELSE GIVE CAVEAT.
X
X21900 IF(AT(OBJ).OR.(LIQ(BOTTLE).EQ.OBJ.AND.AT(BOTTLE))
X 1 .OR.K.EQ.LIQLOC(LOC))SPK=94
X L1=DWFMAX-1
X DO 21920 I=1,L1
X21920 IF(DLOC(I).EQ.LOC.AND.DFLAG.GE.2.AND.OBJ.EQ.DWARF)SPK=94
X IF(CLOSED)SPK=138
X IF(ATHAND(OBJ))SPK=24
X GOTO 2011
X
X
X
XC INVENTORY. IF OBJECT, TREAT SAME AS FIND. ELSE REPORT ON CURRENT BURDEN.
XC THERE ARE SOME FUNNY CASES, LIKE THE WEARABLE THINGS. ALSO, BOAT
XC AND BEAR, WHICH AREN'T REALLY CARRIED. LIST OUTER-LEVEL CONTAINERS
XC AND CONTENTS, IF CONTAINER IS OPEN OR TRANSPARENT.
X
X12000 SPK=98
X DO 12050 I=1,MAXOBJ
X IF(I.EQ.BEAR.OR.I.EQ.BOAT.OR..NOT.HOLDNG(I))GOTO 12050
X IF(WEARNG(I))GOTO 12050
X IF(SPK.EQ.98)CALL RSPEAK(99)
X BLKLIN=.FALSE.
X CALL PSPEAK(I,-1)
X SPK=0
X IF(I.NE.BOAT)CALL LOOKIN(I)
X12050 CONTINUE
X
XC TELL HIM WHAT HE IS WEARING.
X
X K=0
X DO 12060 I=1,MAXOBJ
X IF(.NOT.WEARNG(I))GOTO 12060
X IF(K.EQ.0)WRITE(*,12052)
X12052 FORMAT(' You are wearing:')
X CALL TNOUA
X CALL PSPEAK(I,-1)
X K=-1
X12060 CONTINUE
X
X IF(.NOT.HOLDNG(BOAT))GOTO 12090
X CALL RSPEAK(221)
X CALL LOOKIN(BOAT)
X12090 IF(HOLDNG(BEAR))SPK=141
X GOTO 2011
XC FEED. IF BIRD, NO SEED. SNAKE, DRAGON, TROLL: QUIP. IF DWARF, MAKE HIM
XC MAD. BEAR, SPECIAL.
X
XC CASE 1: FEED CRITTER. *OR*
XC CASE 2: FEED CRITTER EDIBLE.
XC [** THIS CASE TRANSFORMED BY PARSER INTO CASE 3 **]
XC CASE 3: FEED EDIBLE TO CRITTER.
X
X22100 IF(IOBJ.NE.0.AND.LIVING(IOBJ))GOTO 22120
X SPK=100
X IF(OBJ.EQ.BIRD)GOTO 2011
X IF(.NOT.LIVING(OBJ))GOTO 2070
X
XC SEE IF THERE IS ANYTHING EDIBLE AROUND HERE.
X KK=0
X K=0
X DO 22110 I=1,MAXOBJ
X IF(.NOT.HERE(I).OR..NOT.EDIBLE(I))GOTO 22110
X K=K+1
X KK=I
X22110 CONTINUE
X IOBJ=OBJ
X OBJ=KK
X IF(K.EQ.1.OR.DEAD(IOBJ))GOTO 22120
X CALL A5TOA1(OTXT(OBJX,1),OTXT(OBJX,2),'? ',ZAPP,K)
X WRITE(*,22112)(ZAPP(I),I=1,K)
X22112 FORMAT (/' What do you want to feed the ',20A1)
X OBJS(1)=0
X OBJX=0
X GOTO 2600
X
XC FEED OBJ TO IOBJ.
X22120 IF(IOBJ.NE.SNAKE.AND.IOBJ.NE.DRAGON.AND.IOBJ.NE.TROLL)GOTO 22130
X SPK=102
X IF(IOBJ.EQ.DRAGON.AND.PROP(DRAGON).NE.0)SPK=NOWAY(0)
X IF(IOBJ.EQ.TROLL)SPK=182
X IF(IOBJ.NE.SNAKE.OR.CLOSED.OR.OBJ.NE.BIRD)GOTO 2011
X SPK=101
X CALL DSTROY(BIRD)
X PROP(BIRD)=0
X TALLY2=TALLY2+1
X GOTO 2011
X
XC FEED DWARF?
X22130 IF(IOBJ.NE.DWARF)GOTO 22140
X SPK=103
X DFLAG=DFLAG+1
X GOTO 2011
X
XC FEED BEAR?
X22140 SPK=102
X IF(IOBJ.NE.BEAR)GOTO 22150
X IF(PROP(BEAR).EQ.3)SPK=NOWAY(0)
X IF(PROP(BEAR).EQ.1.OR.PROP(BEAR).EQ.2)SPK=264
X IF(OBJ.EQ.FOOD)SPK=278
X IF(OBJ.NE.HONEY)GOTO 2011
X PROP(BEAR)=1
X FIXED(AXE)=0
X PROP(AXE)=0
X SPK=168
X CALL DSTROY(HONEY)
X GOTO 2011
X
XC FEED DOG?
X22150 IF(IOBJ.NE.DOG)GOTO 22160
X IF(PROP(DOG).EQ.1)SPK=291
X IF(OBJ.NE.FOOD.OR.PROP(DOG).EQ.1)GOTO 2011
X SPK=249
X CALL DSTROY(FOOD)
X GOTO 2011
X
XC FEED WUMPUS?
X22160 IF(IOBJ.NE.WUMPUS)GOTO 22170
X IF(PROP(WUMPUS).EQ.6)SPK=326
X IF(PROP(WUMPUS).EQ.0)SPK=327
X IF(OBJ.EQ.FOOD)SPK=240
X GOTO 2011
X
XC FEED BEES?
X22170 IF(IOBJ.NE.BEES.OR.OBJ.NE.FLOWER)GOTO 2070
X IF(ENCLSD(FLOWER))CALL REMOVE(FLOWER)
X CALL DROP(FLOWER,LOC)
X FIXED(FLOWER)=-1
X PROP(FLOWER)=1
X CALL DROP(HONEY,LOC)
X CALL JUGGLE(HONEY)
X SPK=267
X PROP(HIVE)=1
X GOTO 2011
XC FILL. BOTTLE/CASK MUST BE EMPTY, AND SOME LIQUID AVAILABLE.
XC (VASE IS NASTY & GRAIL IS CRACKED.)
X12200 IF( (.NOT.HERE(BOTTLE).AND..NOT.HERE(CASK)) .OR.
X 1 (HERE(BOTTLE).AND.HERE(CASK)) )GOTO 10000
X IF(PROP(CASK).EQ.1.AND.HERE(CASK))OBJ=CASK
X IF(PROP(BOTTLE).EQ.1.AND.HERE(BOTTLE))OBJ=BOTTLE
X IF(OBJ.EQ.0)GOTO 10000
X
XC FILL OBJ WITH IOBJ
X22200 SPK=313
X IF(.NOT.VESSEL(OBJ))GOTO 2011
X IF(IOBJ.EQ.0)IOBJ=LIQLOC(LOC)
X IF(OBJ.NE.BOTTLE.AND.OBJ.NE.CASK)GOTO 22220
X K=0
X IF(OBJ.EQ.CASK)K=1
X SPK=0
X IF(IOBJ.EQ.0)SPK=304+K
X IF(LIQ(OBJ).NE.0)SPK=302+K
X IF(SPK.NE.0)GOTO 2011
X SPK=306+K
X IF(IOBJ.EQ.OIL)SPK=308+K
X IF(IOBJ.EQ.WINE)SPK=310+K
X PROP(OBJ)=MOD(LOCCON(LOC),8)/2*2
X PLACE(IOBJ+K)=-1
X CALL INSERT(IOBJ+K,OBJ)
X GOTO 2011
X
XC VASE. (NASTY).
X22220 IF(OBJ.NE.VASE)GOTO 22230
X SPK=144
X IF(IOBJ.EQ.0.OR..NOT.HOLDNG(VASE))GOTO 2011
X CALL RSPEAK(145)
X PROP(VASE)=2
X FIXED(VASE)=-1
X GOTO 20290
X
XC GRAIL OR OTHER.
X22230 SPK=339
X IF(OBJ.EQ.GRAIL)SPK=298
X GOTO 2011
X
XC BLAST. NO EFFECT UNLESS YOU'VE GOT DYNAMITE, WHICH IS A NEAT TRICK!
X
X12300 IF(CLOSED)GOTO 12310
X GO TO 2011
X12310 BONUS=135
X IF(PLACE(ROD2).EQ.212.AND.LOC.EQ.116)BONUS=133
X IF(PLACE(ROD2).EQ.116.AND.LOC.NE.116)BONUS=134
X CALL RSPEAK(BONUS)
X GOTO 95000
XC SCORE.
X
X12400 SCORNG=.TRUE.
X CALL RATING(SCORE,BONUS,GAVEUP,SCORNG,CLOSNG,CLOSED
X 1 ,HNTMAX)
X SCORNG=.FALSE.
X WRITE(*,12412)SCORE,MXSCOR,TURNS
X12412 FORMAT(/' If you were to quit now, you would score',I4
X 1 ,' out of',I4,' using',I4,' turns.')
XC GAVEUP=YES(143,54,54)
XC GOTO 11850
X GOTO 2100
X
XC FEE FIE FOE FOO (AND FUM). ADVANCE TO NEXT STATE IF GIVEN IN PROPER ORDER.
XC LOOK UP WD1 IN SECTION 3 OF VOCAB TO DETERMINE WHICH WORD WE'VE GOT. LAST
XC WORD ZIPS THE EGGS BACK TO THE GIANT ROOM (UNLESS ALREADY THERE).
X
X12500 K=VOCABX(VTXT(VRBX,1),4)
X SPK=42
X IF(FOOBAR.EQ.1-K)GOTO 12520
X IF(FOOBAR.NE.0)SPK=151
X GOTO 2011
X
X12520 FOOBAR=K
X IF(K.NE.4)GOTO 2009
X FOOBAR=0
X IF(PLACE(EGGS).EQ.PLAC(EGGS)
X 1 .OR.(TOTING(EGGS).AND.LOC.EQ.PLAC(EGGS)))GOTO 2011
XC BRING BACK TROLL IF WE STEAL THE EGGS BACK FROM HIM BEFORE CROSSING.
X IF(PLACE(EGGS).EQ.0.AND.PLACE(TROLL).EQ.0.AND.PROP(TROLL).EQ.0)
X 1 PROP(TROLL)=1
X K=2
X IF(HERE(EGGS))K=1
X IF(LOC.EQ.PLAC(EGGS))K=0
X CALL MOVE(EGGS,PLAC(EGGS))
X CALL PSPEAK(EGGS,K)
X GOTO 2100
X
XC BRIEF/UNBRIEF. INTRANSITIVE ONLY.
XC SUPPRESS LONG DESCRIPTIONS AFTER FIRST TIME.
X
X12600 DETAIL=3
X TERSE=.FALSE.
X IF(ABBNUM.EQ.10000)GOTO 12610
X SPK=156
X ABBNUM=10000
X GOTO 2011
X
X12610 ABBNUM=5
X SPK=374
X GOTO 2011
X
X22600 IF(OBJ.NE.0.AND.LIVING(OBJ).AND.IOBJ.NE.0)GOTO 2011
X GOTO 2060
X
XC READ. MAGAZINES IN DWARVISH, MESSAGE WE'VE SEEN, AND . . . OYSTER?
X
X22700 IF(BLIND(0))GOTO 2011
X IF(OBJ.NE.0.AND.IOBJ.NE.0)GOTO 2060
X SPK=CONFUZ(0)
X IF(OBJ.EQ.0)OBJ=IOBJ
X IF(OBJ.EQ.BOOK.OR.OBJ.EQ.BOOK2)SPK=142
X IF(OBJ.EQ.BILLBD)SPK=361
X IF(OBJ.EQ.CARVNG)SPK=372
X IF(OBJ.EQ.MAGZIN)SPK=190
X IF(OBJ.EQ.MESSAG)SPK=191
X IF(OBJ.EQ.OYSTER.AND.HINTED(2).AND.HOLDNG(OYSTER))SPK=194
X IF(OBJ.EQ.POSTER)SPK=370
X IF(OBJ.EQ.TABLET)SPK=196
X IF(OBJ.NE.OYSTER.OR.HINTED(2).OR..NOT.HOLDNG(OYSTER)
X 1 .OR..NOT.CLOSED)GOTO 2011
X HINTED(2)=YES(192,193,54)
X GOTO 2100
XC BREAK. WORKS FOR MIRROR IN REPOSITORY AND, OF COURSE, THE
XC VASE AND BOTTLE. ALSO, THE SWORD IS MORE BRITTLE THAN IT APPEARS.
X
X22800 IF(OBJ.EQ.MIRROR)SPK=148
X IF(OBJ.EQ.VASE.AND.PROP(VASE).EQ.0)GOTO 22820
X IF(OBJ.EQ.BOTTLE.AND.PROP(BOTTLE).NE.3)GOTO 22840
X IF(OBJ.EQ.SWORD)GOTO 22860
X IF(OBJ.NE.MIRROR.OR..NOT.CLOSED)GOTO 2011
X CALL RSPEAK(197)
X GOTO 93000
X
X22820 SPK=198
X PROP(VASE)=2
X22830 IF(ENCLSD(OBJ))CALL REMOVE(OBJ)
X IF(HOLDNG(OBJ))CALL DROP(OBJ,LOC)
X FIXED(OBJ)=-1
X GOTO 2011
X
X22840 SPK=231
X K=LIQ(BOTTLE)
X PROP(BOTTLE)=3
X IF(K.EQ.0)GOTO 22830
X CALL REMOVE(K)
X PLACE(K)=0
X GOTO 22830
X
XC HE'D BETTER NOT SLING THE SWORD AROUND!
X22860 SPK=29
X IF(.NOT.HOLDNG(SWORD))GOTO 2011
X SPK=279
X PROP(SWORD)=4
X GOTO 22830
X
XC ERWACHE. ONLY USE IS TO DISTURB THE DWARVES OR THE WUMPUS.
XC OTHER WUMPUS-WAKERS LINK HERE.
X
X22900 IF(.NOT.AT(WUMPUS))GOTO 22940
X CHASE=1
X PROP(WUMPUS)=1
X SPK=276
X GOTO 2011
X
X22940 IF(AT(DOG).AND.PROP(DOG).EQ.1)SPK=291
X IF(OBJ.NE.DWARF.OR..NOT.CLOSED)GOTO 2011
X CALL RSPEAK(199)
X GOTO 93000
X
X13000 SPK=201
X
X OPEN (UNIT=16,FILE='ASAVE',STATUS='UNKNOWN',FORM=
X 1 'UNFORMATTED',ACCESS='SEQUENTIAL')
X WRITE(16)ISWIZ,OPENBT,LOCKBT,BURNBT,WEARBT
X WRITE(16)BLKLIN,LOCCON,OBJCON,NUMDIE,MAXDIE,TURNS,KILLED
X WRITE(16)DWARF,KNIFE,KNFLOC,DFLAG,DSEEN,DLOC,ODLOC,DWFMAX
X WRITE(16)HOLDER,HLINK
X WRITE(16)BOTTLE,CASK,WATER,OIL,WINE,LIQTYP
X WRITE(16)LOC,OLDLOC,OLDLC2,NEWLOC,MAXLOC
X WRITE(16) LTEXT,STEXT,KEY,ABB,LOCSIZ
X
X WRITE(16)PLAC,FIXD,WEIGHT,PROP,POINTS
X WRITE(16) ATLOC,LINK,PLACE,
X 1 FIXED,MAXOBJ
X WRITE(16) VERBS,VRBX,OBJS,
X 1 OBJX,IOBJS,IOBX,PREP,WORDS
X
X WRITE(16)ABBNUM,ADJ,ATBS,ATTACK,BCROSS,BONUS,CHASE,
X 1 CLOCK1,CLOCK2,CLOCK3,CLOSED,CLOSNG,CLSMAX,COMBO,DEADBT,
X 2 DETAIL,DKILL,DTOTAL,DWARFN,FLG239,
X 3 FOO,FOOBAR,FOOD,GAVEUP,HEALTH,HINT,HIT,HNTMAX,I,IKK,ILOC,
X 4 IOBJ,J,JJ,JK1,JKK,K,K1,KK,L,L1,LIMIT,
X 5 LINSIZ,LL,LMWARN,LOCK,LOGOUT,MESSAG,OBJ,PANIC,
X 6 PORTAL,PTBS,RDFLAG,RETN,RTXSIZ,SCORE,SCORNG,SECT,
X 7 SKEY,SLOC,SPK,START,STICK,TABNDX,TALLY,TALLY2,TERSE,
X 8 TRVS,TRVSIZ,VEND,VERB,VRBSIZ,WASTE,WKDAY,WKEND,WZDARK,
X 9 YEA,ACTSPK,CTEXT,CVAL,HNAME
X CLOSE(16)
X
X
X
X GOTO 2100
XC THE ZSAVE FUNCTION MUST BE CHANGED IF ANY NEW VARIABLES
XC WHICH CHANGE DURING EXECUTION ARE ADDED.
X
X
XC RESUME RESUME GAME BROM BACKUP FILE
X
X13100 CONTINUE
XC ****************************
XC SEE THE COMMENT ON SUSPEND ABOVE!!!!!!!!!!!
X
X OPEN (UNIT=16,FILE='ASAVE',STATUS='OLD',FORM=
X 1 'UNFORMATTED',ACCESS='SEQUENTIAL')
X REWIND(16)
X READ(16)ISWIZ,OPENBT,LOCKBT,BURNBT,WEARBT
X READ(16)BLKLIN,LOCCON,OBJCON,NUMDIE,MAXDIE,TURNS
X READ(16)DWARF,KNIFE,KNFLOC,DFLAG,DSEEN,DLOC,ODLOC,DWFMAX
X READ(16)HOLDER,HLINK
X READ(16)BOTTLE,CASK,WATER,OIL,WINE,LIQTYP
X READ(16)LOC,OLDLOC,OLDLC2,NEWLOC,MAXLOC
X READ(16) LTEXT,STEXT,KEY,ABB,LOCSIZ
X
X READ(16)PLAC,FIXD,WEIGHT,PROP,POINTS
X READ(16) ATLOC,LINK,PLACE,
X 1 FIXED,MAXOBJ
X READ(16) VERBS,VRBX,OBJS,
X 1 OBJX,IOBJS,IOBX,PREP,WORDS
X
X READ(16)ABBNUM,ADJ,ATBS,ATTACK,BCROSS,BONUS,CHASE,
X 1 CLOCK1,CLOCK2,CLOCK3,CLOSED,CLOSNG,CLSMAX,COMBO,DEADBT,
X 2 DETAIL,DKILL,DTOTAL,DWARFN,FLG239,
X 3 FOO,FOOBAR,FOOD,GAVEUP,HEALTH,HINT,HIT,HNTMAX,I,IKK,ILOC,
X 4 IOBJ,J,JJ,JK1,JKK,K,K1,KK,L,L1,LIMIT,
X 5 LINSIZ,LL,LMWARN,LOCK,LOGOUT,MESSAG,OBJ,PANIC,
X 6 PORTAL,PTBS,RDFLAG,RETN,RTXSIZ,SCORE,SCORNG,SECT,
X 7 SKEY,SLOC,SPK,START,STICK,TABNDX,TALLY,TALLY2,TERSE,
X 8 TRVS,TRVSIZ,VEND,VERB,VRBSIZ,WASTE,WKDAY,WKEND,WZDARK,
X 9 YEA,ACTSPK,CTEXT,CVAL,HNAME
X CLOSE(16)
X
X
X
X GOTO 2100
X
X
XC YANK. A VARIANT OF 'CARRY'. IN GENERAL, NOT A GOOD IDEA.
XC AT MOST, IT GETS THE CLOAK OR A COUPLE SNIDE COMMENTS.
X
X23200 IF(TOTING(OBJ))GOTO 20200
X IF(OBJ.EQ.PLANT.OR.OBJ.EQ.SWORD.OR.OBJ.EQ.CHAIN)GOTO 20100
X SPK=205
X IF(OBJ.EQ.BEAR.AND.PROP(CHAIN).EQ.1)GOTO 2011
X IF(OBJ.EQ.CLOAK.AND.PROP(CLOAK).EQ.2)GOTO 20120
X GOTO 20100
X
XC WEAR: ONLY GOOD FOR JEWELS, RUBY SLIPPERS, CLOAK & CROWN.
XC BUT HE MIGHT TRY THE SWORD. ANYTHING ELSE IS RIDICULOUS.
XC ANOTHER VARIANT OF 'CARRY'.
X
X23300 SPK=209
X IF(OBJ.EQ.SWORD.AND.PROP(SWORD).NE.3)GOTO 2011
X IF(WORN(OBJ))GOTO 23320
X23310 CALL A5TOA1(OTXT(OBJX,1),OTXT(OBJX,2),'? ',ZAPP,K)
X WRITE(*,23312)(ZAPP(I),I=1,K)
X23312 FORMAT(/' Just exactly how does one wear a ',20A1)
X GOTO 2100
X
X23320 SPK=242
X IF(OBJ.EQ.CLOAK.AND.PROP(CLOAK).EQ.2)GOTO 2011
X SPK=210
X IF(OBJ.EQ.SHOES)SPK=227
X IF(WEARNG(OBJ))GOTO 2011
X PROP(OBJ)=1
X CALL BITON(OBJ,WEARBT)
X IF(ENCLSD(OBJ))CALL REMOVE(OBJ)
X IF(HOLDNG(OBJ))GOTO 2009
X GOTO 20120
XC HIT. IF NOT PUNCHING OUT TELEPHONE, ASSUME ATTACK.
X
X23400 IF(AT(WUMPUS).AND.PROP(WUMPUS).EQ.0)GOTO 22900
X IF(OBJ.NE.PHONE)GOTO 21200
X IF(CLOSED)GOTO 93100
X SPK=256
X IF(PROP(PHONE).EQ.2)GOTO 2011
X CALL DROP(SLUGS,LOC)
X SPK=257
X PROP(PHONE)=2
X PROP(BOOTH)=2
X GOTO 2011
X
XC ANSWER (TELEPHONE). SMARTASS FOR ANYTHING ELSE.
X13500 IF(LOC.NE.189.OR.PROP(PHONE).NE.0)GOTO 10000
X OBJ=PHONE
X23500 IF(OBJ.NE.PHONE)GOTO 23520
X SPK=269
X IF(PROP(PHONE).NE.0)GOTO 2011
X IF(CLOSED)GOTO 93200
X SPK=261
X PROP(PHONE)=1
X PROP(BOOTH)=2
X GOTO 2011
X
X23520 IF(OBJ.EQ.DWARF.OR.OBJ.EQ.WUMPUS.OR.OBJ.EQ.SNAKE.OR.OBJ.EQ.BEAR
X 1 .OR.OBJ.EQ.DRAGON)SPK=259
X IF(OBJ.EQ.TROLL)SPK=258
X IF(OBJ.EQ.BIRD)SPK=260
X GOTO 2011
XC BLOW. JOSHUA FIT DE BATTLE OF JERICHO, AND DE WALLS....
X
X23600 IF(OBJ.NE.0.AND.IOBJ.NE.0)GOTO 2060
X IF(OBJ.EQ.0)OBJ=IOBJ
X IOBJ=0
X IF(OBJ.EQ.0)SPK=268
X IF(OBJ.NE.HORN)GOTO 2011
X SPK=266
X IF(OUTSID(LOC))SPK=277
X IF(.NOT.AT(WUMPUS))GOTO 23610
X IF(PROP(WUMPUS).NE.0)GOTO 2011
X CALL RSPEAK(SPK)
X GOTO 22900
X
X23610 IF(PROP(WALL).EQ.1.OR.(LOC.NE.102.AND.LOC.NE.194))GOTO 2011
X K=196
X IF(LOC.EQ.194)K=195
X CALL RSPEAK(265)
X PROP(WALL)=1
X DO 23620 OBJ=1,MAXOBJ
X IF(PLACE(OBJ).EQ.LOC.OR.FIXED(OBJ).EQ.LOC)CALL MOVE(OBJ,K)
X23620 CONTINUE
X NEWLOC=K
X GOTO 2
X
X
XC CALL. IF NO PHONE IS HANDY, YELL.
X
X13800 IF(.NOT.HERE(PHONE))GOTO 10000
X GOTO 23910
X
XC DIAL. NO EFFECT UNLESS AT PHONE.
X
X23900 IF(OBJ.NE.PHONE)GOTO 2011
X23910 IF(CLOSED)GOTO 93200
X SPK=271
X GOTO 2011
X
X
XC PLAY. ONLY FOR HORN OR LYRE.
X24000 IF(OBJ.NE.0.AND.IOBJ.NE.0)GOTO 2060
X IF(OBJ.EQ.0)OBJ=IOBJ
X IOBJ=0
X IF(OBJ.EQ.HORN)GOTO 23600
X IF(OBJ.NE.LYRE)GOTO 2011
X SPK=287
X IF(.NOT.HERE(DOG).OR.DEAD(DOG))GOTO 2011
X PROP(DOG)=1
X CALL BITON(DOG,DEADBT)
X FIXED(AXE)=0
X PROP(AXE)=0
X SPK=288
X GOTO 2011
X
X
XC PICK/PICK UP. CAN PICK FLOWERS & MUSHROOMS, BUT MUST 'PICK UP' EVERYTHING EL
X
X24100 IF(OBJ.EQ.0)OBJ=IOBJ
X IOBJ=0
X IF(OBJ.EQ.FLOWER.OR.OBJ.EQ.MUSHRM)GOTO 20100
X IF(PREP.NE.0)GOTO 20100
X GOTO 2060
XC PUT DOWN: EQUIVALENT TO DROP.
XC PUT IN: IF LIQUID, MEANS 'FILL'.
XC PUT ON: WEAR OR DROP.
X
X24200 IF(PREP.NE.0)GOTO 24210
X CALL A5TOA1(OTXT(OBJX,1),OTXT(OBJX,2),'? ',ZAPP,K)
X WRITE(*,24204)(ZAPP(I),I=1,K)
X24204 FORMAT(/' Where do you want to put the ',20A1)
X GOTO 2600
X
X24210 IF(PREP.EQ.PREPIN)GOTO 24500
X
XC PUT ON: "WEAR" OR "PUT OBJ ON IOBJ".
X24240 IF(PREP.NE.PREPON)GOTO 24250
X IF(OBJ.NE.0)GOTO 24242
X OBJ=IOBJ
X OTXT(OBJX,1)=IOTXT(IOBX,1)
X OTXT(OBJX,2)=IOTXT(IOBX,2)
X IOBJ=0
X24242 IF(WORN(OBJ))GOTO 23300
X IF(IOBJ.EQ.0)GOTO 23310
X GOTO 20200
X
XC PUT DOWN: "DROP"
X24250 IF(OBJ.EQ.0.OR.IOBJ.EQ.0)GOTO 24252
X GOTO 2070
X
X24252 IF(OBJ.EQ.0)OBJ=IOBJ
X IOBJ=0
X GOTO 20200
X
X
XC TURN ON/OFF.
X
X24300 IF(PREP.EQ.0)GOTO 2060
X IF(OBJ.EQ.0.AND.IOBJ.EQ.LAMP)OBJ=LAMP
X IF(OBJ.NE.LAMP)GOTO 2070
X IF(PREP.EQ.PREPON)GOTO 20700
X GOTO 20800
X
X
XC GET (NO PREP): "TAKE"
XC GET IN: "ENTER"
XC GET OUT: "LEAVE"
XC****** NEEDS WORK
X
X24400 IF(PREP.EQ.0.OR.PREP.EQ.PREPFR)GOTO 20100
X IF(OBJ.NE.0)GOTO 2060
X OBJ=IOBJ
X IOBJ=0
X PREP=0
X GOTO 20100
XC INSERT/PUT IN.
X
X24500 IF(IOBJ.EQ.0)GOTO 10010
X SPK=NOWAY(0)
X IF(OBJ.EQ.SWORD.AND.IOBJ.EQ.ANVIL.AND.PROP(SWORD).EQ.0)SPK=350
X IF(.NOT.VESSEL(IOBJ))GOTO 2011
X ASSIGN 24510 TO RETN
X GOTO 20190
X
X24510 IF(IOBJ.NE.BOTTLE.AND.IOBJ.NE.CASK.AND.IOBJ.NE.VASE
X 1 .AND.IOBJ.NE.GRAIL.AND.(OBJ.LT.WATER.OR.OBJ.GT.WINE+1))
X 2 GOTO 24515
X OBJ=IOBJ
X IOBJ=OBJS(OBJX)
X GOTO 22200
X
X24515 SPK=252
X IF(OBJ.EQ.IOBJ)GOTO 2011
X SPK=358
X IF(.NOT.AJAR(IOBJ))GOTO 2011
X IF(IOBJ.NE.BOAT.AND.IOBJ.NE.CHEST)GOTO 24520
X IF(IOBJ.EQ.CHEST.AND.OBJ.EQ.BOAT)GOTO 2070
X GOTO 24590
X
XC BIRD GOES INTO CAGE AND ONLY CAGE. CAGE HOLDS NOTHING ELSE.
XC BAR VASE & PILLOW FROM SAFE, TO FORCE PUTTING DOWN ON FLOOR.
X24520 SPK=351
X IF(OBJ.EQ.BIRD.AND.IOBJ.NE.CAGE)GOTO 2011
X SPK=329
X IF(IOBJ.EQ.CAGE.AND.OBJ.NE.BIRD)GOTO 2011
X IF(OBJ.EQ.BIRD)GOTO 20120
X IF(IOBJ.EQ.SAFE.AND.(OBJ.EQ.VASE.OR.OBJ.EQ.PILLOW))GOTO 2011
X IF(IOBJ.EQ.SHIELD.AND.OBJ.NE.RADIUM)GOTO 2011
X IF(IOBJ.NE.PHONE)GOTO 24530
X IF(OBJ.NE.COINS.AND.OBJ.NE.SLUGS)GOTO 2070
X CALL DSTROY(OBJ)
X SPK=330
X GOTO 2011
X
X24530 IF(IOBJ.NE.VEND)GOTO 24540
X IF(OBJ.NE.COINS.AND.OBJ.NE.SLUGS)GOTO 2070
X CALL DSTROY(OBJ)
X CALL MOVE(BATTER,LOC)
X IF(PROP(BATTER).NE.1)GOTO 24535
X CALL RSPEAK(317)
X PROP(VEND)=1
X24535 PROP(BATTER)=0
X CALL PSPEAK(BATTER,0)
X GOTO 2100
X
XC PUT BATTERIES IN LAMP.
XC THERE IS A GLITCH HERE, IN THAT IF HE TRIES TO GET A THIRD SET OF
XC BATTERIES BEFORE THE SECOND SET HAS BEEN INSERTED, THE SECOND SET
XC DISAPPEARS! ***FIX THIS SOMETIME***
X24540 IF(IOBJ.NE.LAMP)GOTO 24550
X IF(OBJ.NE.BATTER.OR.PROP(BATTER).NE.0)GOTO 2070
X PROP(BATTER)=1
X IF(ENCLSD(BATTER))CALL REMOVE(BATTER)
X IF(HOLDNG(BATTER))CALL DROP(BATTER,LOC)
X LIMIT=400
X PROP(LAMP)=1
X LMWARN=.FALSE.
X SPK=188
X GOTO 2011
X
X24550 IF(.NOT.SMALL(OBJ))GOTO 2011
X24590 IF(WEARNG(OBJ))CALL BITOFF(OBJ,WEARBT)
X IF(WORN(OBJ))PROP(OBJ) = 0
X IF(ENCLSD(OBJ))CALL REMOVE(OBJ)
X CALL INSERT(OBJ,IOBJ)
X GOTO 2009
XC REMOVE/TAKE FROM.
X
X24600 IF(OBJ.NE.RING.OR.PROP(RING).NE.2)GOTO 24610
X PREP=0
X IOBJ=0
X GOTO 20100
X
X24610 SPK=343
X IF(IOBJ.NE.0)GOTO 24620
X IF(.NOT.ENCLSD(OBJ))SPK=340
X IOBJ=-PLACE(OBJ)
X24620 IF(PLACE(OBJ).NE.-IOBJ)SPK=341
X IF(.NOT.AJAR(IOBJ))SPK=335
X IF(OBJ.EQ.WATER.OR.OBJ.EQ.OIL.OR.OBJ.EQ.WINE)SPK=342
X IF(.NOT.TOTING(OBJ).AND.BURDEN(0)+BURDEN(OBJ).GT.15)SPK=92
X IF(SPK.NE.343)GOTO 2011
X CALL REMOVE(OBJ)
X IF(OBJ.EQ.BIRD)GOTO 20200
X GOTO 2009
X
X
XC BURN
X
X24700 GOTO 2011
X
X
XC GRIPE/COMPLAIN/SUGGEST.
X
X14800 CONTINUE
XC A SUGGESTION MECHANISM USED TO GO HERE. IT IS NOT NEEDED FOR A
XC SINGLE-USER GAME
X GOTO 2011
XC LOCK. CHAIN, GRATE, CHEST, ELFIN DOOR
XC HERE ARE THE CURRENT LOCK/UNLOCK MESSAGES & NUMBERS:
XC 31 YOU HAVE NO KEYS.
XC 32 IT HAS NO LOCK.
XC 34 IT'S ALREADY LOCKED.
XC 35 THE GRATE IS NOW LOCKED.
XC 36 THE GRATE IS NOW UNLOCKED.
XC 37 IT WAS ALREADY UNLOCKED.
XC 55 YOU CAN'T UNLOCK THE KEYS.
XC 171 THE CHAIN IS NOW UNLOCKED.
XC 172 THE CHAIN IS NOW LOCKED.
XC 173 THERE IS NOTHING HERE TO WHICH THE CHAIN CAN BE LOCKED.
XC 224 YOUR KEYS ARE ALL TOO LARGE.
XC 234 THE WROUGHT-IRON DOOR IS NOW LOCKED.
XC 235 THE TINY DOOR IS NOW LOCKED.
XC 236 THE WROUGHT-IRON DOOR IS NOW UNLOCKED.
XC 237 THE TINY DOOR IS NOW UNLOCKED.
XC 375 YOU DON'T HAVE THE RIGHT KEY.
XC 333 THE CHEST IS NOW LOCKED.
XC 334 THE CHEST IS NOW UNLOCKED.
XC 367 THE SAFE'S DOOR SWINGS SHUT.
X
X24900 IF(HINGED(OBJ))GOTO 24905
X CALL A5TOA1(OTXT(OBJX,1),OTXT(OBJX,2),'. ',ZAPP,K)
X WRITE(*,24903)(ZAPP(I),I=1,K)
X24903 FORMAT(/' I don''t know how to lock or unlock the ',20A1)
X GOTO 2100
X
X24905 SPK=375
X IF(.NOT.LOCKS(OBJ))SPK=32
X IF(LOCKED(OBJ))SPK=34
X IF(.NOT.(ATHAND(KEYS).OR.ATHAND(SKEY).OR.OBJ.EQ.SAFE))SPK=31
X IF(SPK.NE.375)GOTO 2011
X
XC CHAIN.
X IF(OBJ.NE.CHAIN)GOTO 24910
X IF(.NOT.ATHAND(KEYS))GOTO 2011
X SPK=173
X IF(LOC.NE.PLAC(CHAIN))GOTO 2011
X SPK=172
X PROP(CHAIN)=2
X IF(ENCLSD(CHAIN))CALL REMOVE(CHAIN)
X IF(HOLDNG(CHAIN))CALL DROP(CHAIN,LOC)
X FIXED(CHAIN)=-1
X GOTO 24990
X
XC CHEST.
X24910 IF(OBJ.NE.CHEST)GOTO 24920
X IF(.NOT.ATHAND(KEYS))GOTO 2011
X SPK=334
X GOTO 24990
X
XC ELFIN DOOR.
X24920 IF(OBJ.NE.TDOOR.AND.OBJ.NE.TDOOR2)GOTO 24930
X SPK=224
X IF(.NOT.TOTING(SKEY))GOTO 2011
X PROP(TDOOR)=0
X PROP(TDOOR2)=0
X SPK=234+2*PROP(TDOOR)+(TDOOR2-OBJ)
X K=TDOOR+(TDOOR2-OBJ)
X CALL BITON(K,LOCKBT)
X CALL BITOFF(K,OPENBT)
X GOTO 24990
X
XC GRATE.
X24930 IF(OBJ.NE.GRATE)GOTO 24940
X IF(.NOT.ATHAND(KEYS))GOTO 2011
X PROP(GRATE)=0
X SPK=35
X GOTO 24990
X
XC SAFE.
X24940 PROP(SAFE)=0
X SPK=367
XC GOTO 24990
X
X24990 CALL BITON(OBJ,LOCKBT)
X CALL BITOFF(OBJ,OPENBT)
X GOTO 2011
XC UNLOCK. CHAIN, GRATE, CHEST, ELFIN DOOR.
X
X25000 SPK=55
X IF(OBJ.EQ.KEYS.OR.OBJ.EQ.SKEY)GOTO 2011
X IF(.NOT.HINGED(OBJ))GOTO 24900
X SPK=375
X IF(.NOT.LOCKED(OBJ))SPK=37
X IF(.NOT.LOCKS(OBJ))SPK=32
X IF(OBJ.EQ.SAFE)SPK=342
X IF(OBJ.EQ.SAFE.AND.(IOBJ.EQ.KEYS.OR.IOBJ.EQ.SKEY))SPK=368
X IF(.NOT.(ATHAND(KEYS).OR.ATHAND(SKEY).OR.OBJ.EQ.SAFE))SPK=31
X IF(SPK.NE.375)GOTO 2011
X
XC CHAIN.
X IF(OBJ.NE.CHAIN)GOTO 25020
X IF(.NOT.ATHAND(KEYS))GOTO 2011
X SPK=171
X IF(PROP(BEAR).EQ.0)SPK=41
X IF(SPK.NE.171)GOTO 2011
X PROP(CHAIN)=0
X FIXED(CHAIN)=0
X IF(PROP(BEAR).NE.3)PROP(BEAR)=2
X FIXED(BEAR)=2-PROP(BEAR)
X GOTO 25090
X
XC CHEST.
X25020 IF(OBJ.NE.CHEST)GOTO 25030
X IF(.NOT.ATHAND(KEYS))GOTO 2011
X SPK=333
X GOTO 25090
X
XC ELFIN DOOR.
XC STUFF TO LOCK/UNLOCK TINY DOOR W/SPECIAL KEY.
XC THE DAMN THING IS REALLY AT FOUR PLACES, AND WE WANT THE RIGHT
XC MESSAGES IF HE ONLY HAS 'BIG' KEYS (OR NO KEYS). ALSO, HE
XC CAN UNLOCK IT EITHER WHILE HE IS BIG OR SMALL.
X25030 IF(OBJ.NE.TDOOR.AND.OBJ.NE.TDOOR2)GOTO 25040
X SPK=224
X IF(.NOT.ATHAND(SKEY))GOTO 2011
X IF(CLOSNG)GOTO 25060
X PROP(TDOOR)=1
X PROP(TDOOR2)=1
X SPK=234+2*PROP(TDOOR)+(TDOOR2-OBJ)
X K=TDOOR+(TDOOR2-OBJ)
X CALL BITOFF(K,LOCKBT)
X CALL BITON(K,OPENBT)
X GOTO 25090
X
XC GRATE.
X25040 IF(.NOT.ATHAND(KEYS))GOTO 2011
X IF(CLOSNG)GOTO 25060
X PROP(GRATE)=1
X SPK=36
X
X25090 CALL BITOFF(OBJ,LOCKBT)
X CALL BITON(OBJ,OPENBT)
X GOTO 2011
X
XC CLOSING. NO EXIT THIS WAY.
X25060 SPK=130
X IF(.NOT.PANIC)CLOCK2=15
X PANIC=.TRUE.
X GOTO 2011
X
X
XC HEALTH. GIVE HIM A DIAGNOSIS.
X
X25100 IF(HEALTH.LT.100)WRITE(*,25102)HEALTH
X25102 FORMAT(/' You''re health rating is ',I2,
X 1 ' out of a possible 100.')
X IF(PCT(50))SPK=349
X IF(HEALTH.GE.95)GOTO 2011
X SPK=381 + (100-HEALTH)/20
X GOTO 2011
X
X
XC LOOK. CAN'T GIVE MORE DETAIL. PRETEND IT WASN'T DARK (THOUGH IT MAY "NOW"
XC BE DARK) SO HE WON'T FALL INTO A PIT WHILE STARING INTO THE GLOOM.
X
X25200 IF(OBJ.NE.0)GOTO 2060
X IF(IOBJ.NE.0)GOTO 25210
X25201 IF(DETAIL.LT.3)CALL RSPEAK(15)
X DETAIL=DETAIL+1
X WZDARK=.FALSE.
X ABB(LOC)=0
X NEWLOC=LOC
X GOTO 2
X
XC LOOK INTO SOMETHING (A CONTAINER).
X25210 IF(.NOT.VESSEL(IOBJ))GOTO 25220
X IF(.NOT.AJAR(IOBJ).AND.OPAQUE(IOBJ))GOTO 2011
X SPK=359
X IF(HOLDER(IOBJ).EQ.0)GOTO 2011
X WRITE(*,25212)
X25212 FORMAT(' ')
X CALL LOOKIN(IOBJ)
X GOTO 2100
X
XC LOOK AT SOMETHING. IF WRITTEN, READ IT.
X25220 IF(.NOT.PRINTD(IOBJ))GOTO 25230
X OBJ=IOBJ
X IOBJ=0
X GOTO 22700
X
X25230 IF(IOBJ.NE.SPHERE)GOTO 25201
X IF(INSIDE(LOC).AND.(.NOT.ATHAND(SAPPHI)))GOTO 25232
X CALL RSPEAK(42)
X GO TO 2100
X25232 CALL RSPEAK(400)
X WRITE(*,*)' '
X SLOC=PLACE(SAPPHI)
X IF((MOD(LOCCON(SLOC),2).EQ.0.OR.ENCLSD(SAPPHI)).AND.SLOC.NE.200
X 1 .AND..NOT.(PLACE(LAMP).EQ.SLOC.AND.PROP(LAMP).NE.0))
X 1 GO TO 25234
X CALL SPEAK(LTEXT(SLOC))
X IF(SLOC.NE.239.OR.FLG239.NE.0)GOTO 25235
X CALL RSPEAK(403)
X FLG239=1
X25235 GO TO 25236
X25234 CALL RSPEAK(401)
X25236 WRITE(*,*)' '
X CALL RSPEAK(402)
X GO TO 2100
X
XC COMBO: TRYING TO OPEN SAFE. SEE COMMENTS FOR FEE FIE FOE FOO.
X
X25300 IF(.NOT.AT(SAFE))GOTO 2060
X K=VOCABX(VTXT(VRBX,1),4)-10
X SPK=42
X IF(COMBO.EQ.1-K)GOTO 25320
X IF(COMBO.NE.0)SPK=366
X GOTO 2011
X
X25320 COMBO=K
X SPK=371
X IF(K.NE.3)GOTO 2011
X COMBO=0
X CALL BITOFF(SAFE,LOCKBT)
X CALL BITON(SAFE,OPENBT)
X PROP(SAFE)=1
X SPK=365
X IF(PROP(BOOK).GE.0)GOTO 2011
X TALLY=TALLY-1
X PROP(BOOK)=0
XC IF REMAINING TREASURES TOO ELUSIVE, ZAP HIS LAMP.
XC THIS COPIES SOME CODE LOCATED AROUND LABEL 2000. MUST BE DONE
XC HERE SINCE BOOK IS CONTAINED IN SAFE & TALLY STUFF ONLY WORKS FOR THINGS
XC DEPOSITED AT A LOC.
X IF(TALLY.EQ.TALLY2.AND.TALLY.NE.0)LIMIT=MIN0(35,LIMIT)
X GOTO 2011
XC DUST/SWEEP.
X25400 IF(.NOT.ATHAND(BRUSH))SPK=342
X IF(.NOT.AT(CARVNG).OR..NOT.ATHAND(BRUSH).OR.PROP(CARVNG).EQ.1)
X 1 GOTO 2011
X PROP(CARVNG)=1
X CALL RSPEAK(363)
X SPK=372
X GOTO 2011
X
X
XC TERSE/UNTERSE. SUPRESS ALL LONG-FORM DESCRIPTIONS.
X
X25500 TERSE=.NOT.TERSE
X DETAIL=3
X GOTO 2009
XC WIZ STUFF
X
X25600 CONTINUE
XC ???????????? UNCOMMENT THE FOLLOWING LINE TO ACTIVATE WIZARD MODE:
XC ISWIZ = .NOT.ISWIZ
X25700 GOTO 2009
X25800 IF(.NOT.ISWIZ) GOTO 2009
X WRITE(*,25801)
X25801 FORMAT (1X,'LOCATION ?')
X READ (*,25802) GATLOC
X25802 FORMAT (I4)
X IF ((GATLOC.GT.0).AND.(GATLOC.LE.MAXLOC))
X + LOC=GATLOC
X GOTO 2009
X25900 IF(ISWIZ)WRITE(*,25902)(DLOC(KQQQ),KQQQ=1,DWFMAX-1)
X25902 FORMAT(1X,'THE DWARFS ARE AT LOCATIONS ',/,
X 1 8I6)
X IF(ISWIZ) WRITE(*,25901) DLOC(DWFMAX)
X25901 FORMAT(1X,'THE PIRATE IS AT LOCATION ',I4)
X GOTO 2009
X
XC HINTS
X
XC COME HERE IF HE'S BEEN LONG ENOUGH AT REQUIRED LOC(S) FOR SOME UNUSED HINT.
XC HINT NUMBER IS IN VARIABLE "HINT". BRANCH TO QUICK TEST FOR ADDITIONAL
XC CONDITIONS, THEN COME BACK TO DO NEAT STUFF. GOTO 40010 IF CONDITIONS ARE
XC MET AND WE WANT TO OFFER THE HINT. GOTO 40020 TO CLEAR HINTLC BACK TO ZERO,
XC 40030 TO TAKE NO ACTION YET.
X
X40000 GOTO (40700,40800,40900,41000,41100,41200,41300,41400,41500,
X 1 41600,41700,40010),(HINT+1-HNTMIN)
XC MAZE DARK WITT SWORD SLIDE CAVE1 BIRD CAVE2 RNBOW
XC SNAKE STYX
X
X WRITE(*,40002)HINT
X40002 FORMAT (' TRYING TO PRINT HINT # ',I1,/)
X CALL BUG(27)
X
X40010 HINTLC(HINT)=0
X IF(.NOT.YES(HINTS(HINT,3),0,54))GOTO 2602
X WRITE(*,40012)HINTS(HINT,2)
X40012 FORMAT(/' I am prepared to give you a hint, but it will cost
X 1 you', I2,' points.')
X HINTED(HINT)=YES(175,HINTS(HINT,4),54)
X IF(HINTED(HINT).AND.LIMIT.GT.30)LIMIT=LIMIT+30*HINTS(HINT,2)
X40020 HINTLC(HINT)=0
X40030 GOTO 2602
X
XC NOW FOR THE QUICK TESTS. SEE DATABASE DESCRIPTION FOR ONE-LINE NOTES.
X
X40700 IF(ATLOC(LOC).EQ.0.AND.ATLOC(OLDLOC).EQ.0.AND.
X 1 ATLOC(OLDLC2).EQ.0.AND.BURDEN(0).GT.1)GOTO 40010
X GOTO 40020
X
X40800 IF(PROP(EMRALD).NE.-1.AND.PROP(PYRAM).EQ.-1)GOTO 40010
X GOTO 40020
X
X40900 GOTO 40010
X
X41000 IF( (PROP(SWORD).EQ.1.OR.PROP(SWORD).EQ.5)
X 1 .AND..NOT.TOTING(CROWN))GOTO 40010
X GOTO 40020
X
X41100 GOTO 40010
X
X41200 IF(PROP(GRATE).EQ.0.AND..NOT.ATHAND(KEYS))GOTO 40010
X GOTO 40020
X
X41300 IF(HERE(BIRD).AND.ATHAND(ROD).AND.OBJ.EQ.BIRD)GOTO 40010
X GOTO 40030
X
X41400 IF(ABB(159).EQ.0)GOTO 40010
X GOTO 40020
X
X41500 IF(.NOT.TOTING(SHOES).OR.ABB(205).EQ.0)GOTO 40010
X GOTO 40020
X
X41600 IF(.NOT.ATHAND(LYRE).AND.PROP(DOG).NE.1)GOTO 40010
X GOTO 40020
X
X41700 IF(HERE(SNAKE).AND..NOT.HERE(BIRD))GOTO 40010
X GOTO 40020
XC CAVE CLOSING AND SCORING
X
X
XC THESE SECTIONS HANDLE THE CLOSING OF THE CAVE. THE CAVE CLOSES "CLOCK1"
XC TURNS AFTER THE LAST TREASURE HAS BEEN LOCATED (INCLUDING THE PIRATE'S
XC CHEST, WHICH MAY OF COURSE NEVER SHOW UP). NOTE THAT THE TREASURES NEED NOT
XC HAVE BEEN TAKEN YET, JUST LOCATED. HENCE CLOCK1 MUST BE LARGE ENOUGH TO GET
XC OUT OF THE CAVE (IT ONLY TICKS WHILE INSIDE THE CAVE). WHEN IT HITS ZERO,
XC WE BRANCH TO 90000 TO START CLOSING THE CAVE, AND THEN SIT BACK AND WAIT FOR
XC HIM TO TRY TO GET OUT. IF HE DOESN'T WITHIN CLOCK2 TURNS, WE CLOSE THE
XC CAVE; IF HE DOES TRY, WE ASSUME HE PANICS, AND GIVE HIM A FEW ADDITIONAL
XC TURNS TO GET FRANTIC BEFORE WE CLOSE. WHEN CLOCK2 HITS ZERO, WE BRANCH TO
XC 90000 TO TRANSPORT HIM INTO THE FINAL PUZZLE. NOTE THAT THE PUZZLE DEPENDS
XC UPON ALL SORTS OF RANDOM THINGS. FOR INSTANCE, THERE MUST BE NO WATER OR
XC OIL, SINCE THERE ARE BEANSTALKS WHICH WE DON'T WANT TO BE ABLE TO WATER,
XC SINCE THE CODE CAN'T HANDLE IT. ALSO, WE CAN HAVE NO KEYS, SINCE THERE IS A
XC GRATE (HAVING MOVED THE FIXED OBJECT!) THERE SEPARATING HIM FROM ALL THE
XC TREASURES. MOST OF THESE PROBLEMS ARISE FROM THE USE OF NEGATIVE PROP
XC NUMBERS TO SUPPRESS THE OBJECT DESCRIPTIONS UNTIL HE'S ACTUALLY MOVED THE
XC OBJECTS.
X
XC WHEN THE FIRST WARNING COMES, WE LOCK THE GRATE, DESTROY THE BRIDGE, KILL
XC ALL THE DWARVES (AND THE PIRATE), REMOVE THE TROLL AND BEAR (UNLESS DEAD),
XC AND SET "CLOSNG" TO TRUE. LEAVE THE DRAGON; TOO MUCH TROUBLE TO MOVE IT.
XC FROM NOW UNTIL CLOCK2 RUNS OUT, HE CANNOT UNLOCK THE GRATE, MOVE TO ANY
XC LOCATION OUTSIDE THE CAVE (LOC=BITSET(LOCCON,6)), OR CREATE THE BRIDGE. NOR
XC RESURRECTED IF HE DIES. NOTE THAT THE SNAKE IS ALREADY GONE, SINCE HE GOT
XC TO THE TREASURE ACCESSIBLE ONLY VIA THE HALL OF THE MT. KING. ALSO, HE'S
XC BEEN IN GIANT ROOM (TO GET EGGS), SO WE CAN REFER TO IT. ALSO ALSO, HE'S
XC GOTTEN THE PEARL, SO WE KNOW THE BIVALVE IS AN OYSTER. *AND*, THE DWARVES
XC MUST HAVE BEEN ACTIVATED, SINCE WE'VE FOUND CHEST.
X
X90000 PROP(GRATE)=0
X PROP(FISSUR)=0
X PROP(TDOOR)=0
X PROP(TDOOR2)=0
X DO 90010 I=1,6
X DSEEN(I)=.FALSE.
X90010 DLOC(I)=0
X CALL MOVE(TROLL,0)
X CALL MOVE(TROLL+MAXOBJ,0)
X CALL MOVE(TROLL2,PLAC(TROLL))
X CALL MOVE(TROLL2+MAXOBJ,FIXD(TROLL))
X CALL JUGGLE(CHASM)
X IF(PROP(BEAR).NE.3)CALL DSTROY(BEAR)
X PROP(CHAIN)=0
X FIXED(CHAIN)=0
X PROP(AXE)=0
X FIXED(AXE)=0
X CALL RSPEAK(129)
X CLOCK1=-1
X CLOSNG=.TRUE.
X GOTO 19999
X
XC ONCE HE'S PANICKED, AND CLOCK2 HAS RUN OUT, WE COME HERE TO SET UP THE
XC STORAGE ROOM. THE ROOM HAS TWO LOCS, HARDWIRED AS 115 (NE) AND 116 (SW).
XC AT THE NE END, WE PLACE EMPTY BOTTLES, A NURSERY OF PLANTS, A BED OF
XC OYSTERS, A PILE OF LAMPS, RODS WITH STARS, SLEEPING DWARVES, PHONE BOOTH AND
XC AT THE SW END WE PLACE GRATE OVER TREASURES, SNAKE PIT, COVEY OF CAGED BIRDS,
XC MORE RODS, AND PILLOWS. A MIRROR STRETCHES ACROSS ONE WALL. MANY OF THE
XC OBJECTS COME FROM KNOWN LOCATIONS AND/OR STATES (E.G. THE SNAKE IS KNOWN TO
XC HAVE BEEN DESTROYED AND NEEDN'T BE CARRIED AWAY FROM ITS OLD "PLACE"),
XC MAKING THE VARIOUS OBJECTS BE HANDLED DIFFERENTLY. WE ALSO DROP ALL OTHER
XC OBJECTS HE MIGHT BE CARRYING (LEST HE HAVE SOME WHICH COULD CAUSE TROUBLE,
XC SUCH AS THE KEYS). WE DESCRIBE THE FLASH OF LIGHT AND TRUNDLE BACK.
XC THE PHONE MAKES IT IMPOSSIBLE FOR THE WALDO TO FART AROUND IN THE
XC REPOSITORY TOO LONG. WHEN CLOCK3 TICKS TO ZERO, THE PHONE STARTS
XC RINGING. WHEN IT HITS -7, THE DWARVES WAKE UP. IF HE FIDDLES WITH
XC THE PHONE, HE GETS ZONKED IN OTHER WAYS.
X
X91000 PROP(BOTTLE)=PUT(BOTTLE,115,1)
X PROP(PLANT)=PUT(PLANT,115,0)
X PROP(OYSTER)=PUT(OYSTER,115,0)
X PROP(LAMP)=PUT(LAMP,115,0)
X PROP(ROD)=PUT(ROD,115,0)
X PROP(DWARF)=PUT(DWARF,115,0)
X LOC=115
X OLDLOC=115
X NEWLOC=115
X
XC LEAVE THE GRATE WITH NORMAL (NON-NEGATIVE PROPERTY).
X
X FOO=PUT(GRATE,116,0)
X PROP(SNAKE)=PUT(SNAKE,116,1)
X PROP(BIRD)=PUT(BIRD,116,1)
X PROP(CAGE)=PUT(CAGE,116,0)
X PROP(ROD2)=PUT(ROD2,116,0)
X PROP(PILLOW)=PUT(PILLOW,116,0)
X
X PROP(BOOTH)=PUT(BOOTH,116,-4)
X FIXED(BOOTH)=115
X PROP(PHONE)=PUT(PHONE,212,-4)
X
X PROP(MIRROR)=PUT(MIRROR,115,0)
X PROP(BOOK2)=PUT(BOOK2,115,0)
X FIXED(MIRROR)=116
X
X DO 91010 I=1,MAXOBJ
X IF(TOTING(I).AND.ENCLSD(I))CALL REMOVE(I)
X91010 IF(TOTING(I))CALL DSTROY(I)
X
X CALL RSPEAK(132)
X CLOSED=.TRUE.
X GOTO 2
XC ANOTHER WAY WE CAN FORCE AN END TO THINGS IS BY HAVING THE LAMP GIVE OUT.
XC WHEN IT GETS CLOSE, WE COME HERE TO WARN HIM.
XC 92000 IS FOR CASES OF LAMP DYING. 92400 IS WHEN IT GOES OUT,
XC AND 92600 IS IF HE'S WANDERED OUTSIDE AND THE LAMP IS USED UP, IN WHICH
XC CASE WE FORCE HIM TO GIVE UP.
X
X92000 IF(LMWARN.OR..NOT.HERE(LAMP))GOTO 19999
X LMWARN=.TRUE.
X SPK=187
X IF(PROP(BATTER).EQ.1)SPK=323
X IF(PLACE(BATTER).EQ.0)SPK=183
X IF(PROP(VEND).EQ.1)SPK=189
X CALL RSPEAK(SPK)
X GOTO 19999
X
X92400 LIMIT=-1
X PROP(LAMP)=0
X IF(HERE(LAMP))CALL RSPEAK(184)
X GOTO 19999
X
X92600 CALL RSPEAK(185)
X GAVEUP=.TRUE.
X GOTO 95000
X
X
XC OH DEAR, HE'S DISTURBED THE DWARVES.
X
X93000 CALL RSPEAK(136)
X GOTO 95000
X
XC HIT THE PHONE. JINGLE, JANGLE, CRASH!
X93100 CALL RSPEAK(282)
X GOTO 93000
X
XC WHOOPS. DOWN THE CHUTE.
X93200 CALL RSPEAK(283)
X GOTO 95000
X
XC DWARVES CAN'T SLEEP THRU ALL THIS RINGING!
X93300 CALL RSPEAK(254)
X GOTO 95000
XC "YOU'RE DEAD, FRED." "YOU DIED, CLYDE?"
XC
XC IF THE CURRENT LOC IS ZERO, IT MEANS THE CLOWN GOT HIMSELF KILLED. WE'LL
XC ALLOW THIS MAXDIE TIMES. MAXDIE IS AUTOMATICALLY SET BASED ON THE NUMBER OF
XC SNIDE MESSAGES AVAILABLE. EACH DEATH RESULTS IN A MESSAGE (81, 83, ETC.)
XC WHICH OFFERS REINCARNATION; IF ACCEPTED, THIS RESULTS IN MESSAGE 82, 84,
XC ETC. THE LAST TIME, IF HE WANTS ANOTHER CHANCE, HE GETS A SNIDE REMARK AS
XC WE EXIT. WHEN REINCARNATED, ALL OBJECTS BEING CARRIED GET DROPPED AT OLDLC2
XC (PRESUMABLY THE LAST PLACE PRIOR TO BEING KILLED) WITHOUT CHANGE OF PROPS.
XC THE LOOP RUNS BACKWARDS TO ASSURE THAT THE BIRD IS DROPPED BEFORE THE CAGE.
XC (THIS KLUGE COULD BE CHANGED ONCE WE'RE SURE ALL REFERENCES TO BIRD AND CAGE
XC ARE DONE BY KEYWORDS.) THE LAMP IS A SPECIAL CASE (IT WOULDN'T DO TO LEAVE
XC IT IN THE CAVE). IT IS TURNED OFF AND LEFT OUTSIDE THE BUILDING (ONLY IF HE
XC WAS CARRYING IT, OF COURSE). HE HIMSELF IS LEFT INSIDE THE BUILDING (AND
XC HEAVEN HELP HIM IF HE TRIES TO XYZZY BACK INTO THE CAVE WITHOUT THE LAMP!).
XC OLDLOC IS ZAPPED SO HE CAN'T JUST "RETREAT".
X
XC THE EASIEST WAY TO GET KILLED IS TO FALL INTO A PIT IN PITCH DARKNESS.
X
X94000 CALL RSPEAK(23)
X OLDLC2=LOC
X
XC OKAY, HE'S DEAD. LET'S GET ON WITH IT.
X
X94100 IF(CLOSNG)GOTO 94500
X YEA=YES(81+NUMDIE*2,82+NUMDIE*2,54)
X NUMDIE=NUMDIE+1
X IF(NUMDIE.EQ.MAXDIE.OR..NOT.YEA)GOTO 95000
X IF(CHASE.EQ.0)GOTO 94160
X
XC CHAMP WAS BEING CHASED BY WUMPUS, & DIED ANOTHER WAY.
XC PUT WUMPUS BACK TO SLEEP, IN CASE OUR HERO STILL HASN'T GOT THE CLOAK.
X CHASE=0
X PROP(WUMPUS)=0
X CALL MOVE(WUMPUS,174)
X94160 IF(TOTING(LAMP))PROP(LAMP)=0
X DO 94200 J=1,MAXOBJ
X IF(.NOT.HOLDNG(J))GOTO 94200
X LOC=OLDLC2
X IF(J.EQ.LAMP)LOC=1
X CALL DROP(J,LOC)
X IF(.NOT.WEARNG(J))GOTO 94200
X PROP(J)=0
X CALL BITOFF(J,WEARBT)
X94200 CONTINUE
X LOC=3
X OLDLOC=LOC
X WDX=0
X WORDS(1)=0
X CALL CLRLIN
X HEALTH=100
X GOTO 2000
X
XC HE DIED DURING CLOSING TIME. NO RESURRECTION. TALLY UP A DEATH AND EXIT.
X
X94500 CALL RSPEAK(131)
X NUMDIE=NUMDIE+1
X GOTO 95000
XC IT'S OVER. TALLY SCORE.
X
X95000 CALL RATING(SCORE,BONUS,GAVEUP,SCORNG,CLOSNG,CLOSED
X 1 ,HNTMAX)
X
XC THAT SHOULD BE GOOD ENOUGH. LET'S TELL HIM ALL ABOUT IT.
X
X
X WRITE(*,95100)SCORE,MXSCOR,TURNS
X95100 FORMAT(///' You scored',I4,' out of a possible',I4,
X 1 ', using',I5,' turns.')
X
X DO 95200 I=1,CLSSES
X IF(CVAL(I).GE.SCORE)GOTO 95210
X95200 CONTINUE
X WRITE(*,95202)
X95202 FORMAT(/' You just went off my scale!!'/)
X GOTO 98000
X
X95210 CALL SPEAK(CTEXT(I))
X IF(I.EQ.CLSSES-1)GOTO 95220
X K=CVAL(I)+1-SCORE
X KK2C='s.'
X IF(K.EQ.1)KK2C='. '
X WRITE(*,95212)K,KK2C
X95212 FORMAT(/' To achieve the next higher rating, you need',I3,
X 1 ' more point',A2/)
X GOTO 98000
X
X95220 WRITE(*,95222)
X95222 FORMAT(/' To achieve the next higher rating ',
X 1 'would be a neat trick!'//' CONGRATULATIONS!!'/)
X
XC98000 STOP
X98000 STOP
X
X END
X
X
X
X
X
X
X
END_OF_FILE
if test 41617 -ne `wc -c <'aamain.f.xab'`; then
echo shar: \"'aamain.f.xab'\" unpacked with wrong size!
fi
# end of 'aamain.f.xab'
fi
if test -f 'advent.doc' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'advent.doc'\"
else
echo shar: Extracting \"'advent.doc'\" \(4732 characters\)
sed "s/^X//" >'advent.doc' <<'END_OF_FILE'
XThis is the hopefully portable ADVENTURE 551 program. Its BETA!!!!!
XI've tested it as well as I can, but you never know!!!! It comes as three
XFortran files, aamain.f, the main game program; asetup.f, a program that
Xreads the ASCII data file ADVDAT and makes a runtime data file ADVTXT;
Xasubs.f, that needs to be liked with each of the above; and ADVDAT,
Xthe ASCII data file itself (note all caps for Unix users).
X
X
XIt is based on the old old old Fortran one posted recently in comp.sources.
Xgames - or rather one very close to that. I added a small piece of game,
Xand the version I started from was lacking a tiny (and uncompleted) part.
XBut mostly I fixed bugs. Oh! My! What a mess it was. You think it is
Xbad now? Well, it is still F66 spaghetti, but previously it was full
Xof Holleriths, system dependencies, and just plain bugs. Code bugs,
Xgame bugs, out of range subscripts ad nauseum. I played it to
Xcompletion, and got all 551 points. That means it is possible to win. But
Xit does NOT guarantee no bugs - as I found a bad one just playing it
Xthis last time. So have other testers. The only blatent non-portability
Xis that it assumes ASCII.
X
XFor Unix people with Fortran, first make sure that the file is ADVDAT,
Xall upper case, make sure the name of your Fortran compiler is right in the
Xmakefile and then type 'make'. To play, type "adventure".
X
XIf your Unix system lacks the MIL std Fortran functions ior, ieor, and iand,
Xyou'll have to make up some with whatever bit functions you do have.
XIt's up to you. These functions just take two integer variables and
Xreturn the appropriate bitwise functions OR, XOR, and AND. If you get them
Xwrong the asetup program will die at section 9 of the data file.
X
XFor folks on MS-DOS, rename the .f files to .for. Then compile and link
Xasetup with asubs to make asetup.exe. Make SURE to have your Fortran compiler
Xuse 4-byte integers!!! (Use /4I4 for Microsoft Fortran). Run asetup.exe.
XThen compile aamain.for and link with asubs.obj to make aamain.exe.
XRename aamain.exe to "adventure" and play the game.
X
XFor VMS folks, do as MS-DOS except that you have to add ".dat" to the advdat
Xfilename, and compile with /check=noover. This last is necessary as the
Xrandom number generator actually depends on overflows.
X
X
XFor folks with Unix systems and no (or broken!!! - Sun 3's) Fortran compilers,
Xit works with the "f2c" program available from research.att.com. This took
Xme a bit of work on our Mips machine. It is easy to generate the f2c program
Xand its two libraries libF77 and libI77 but it didn't link right. The solution
Xwas to use the librarian (ar) to make a single library libF2C with all the
X.o files from BOTH libraries, put that in the directory you are working
Xwith and tell cc to use that as an ordinary object file - i.e.
Xf2c *.f
X<<edit iors.c as instructed in the iors.f file!!!!!>>
Xcc -c *.c
Xcc asetup.o asubs.o iors.o libF2C -lm -lc
Xa.out
Xcc aamain.o asubs.o iors.o libF2C -lm -lc
Xmv a.out adventure
X
X(Note the lack of a -l before the libF2C - read the READMEs that
Xcome with f2c.)
X
Xthen just play! I suppose I could distribute the .c files f2c produces,
Xbut the main problem is that I would also have to distribute the libs,
Xwhich are the big problem anyway.
X
X
XIt hopefully will just work. There are two places to look at the
Xsource code: First, look in asubs.f for the string ?????, which occurs
Xtwice. Thereabouts is code which works on VMS, the IBM-PC, and f2c to allow
Xyou to get a prompt on the same line as your response. It fails miserably in
XF77 on my MIPS Unix machine. If you can make this or some other prompting
Xmechanism work on your machine, PLEASE report it to me. Second, in aamain.f
Xlook for the the string ?????. There you can uncomment a line to activate
XWizard mode, which allows a modest amount of cheating. Uncautious use
Xof it, however, can prevent actually winning.
X
XThis version compiles and runs using f77 on a MIPS unix box, on the VAX using
XVMS VAX Fortran or using Ultrix and its Fortran compiler (though you must
Xsupply the bitwise functions), on the IBM PC using either the MicroWay 386
X32-bit compiler or Microsoft Fortran 4.1 in large model, and on the IBM
XRiscstation 6000.
X
XIt compiles but does NOT run on a Sun 3 (with a F77 compiler with a 1988
Xdate) due to the compiler simply being unable (with no help from
Xswitches) to compile correctly the main program. Tests indicate that
Xthis compiler barfs on files with much more than 400 lines of significant code.
XIf anybody can get it to run on a Sun 3, please let me know how.
XI find it hard to believe that they would let out a compiler this limited.
X
X
X
X
XDoug McDonald (mcdonald@aries.scs.uiuc.edu)
X
XAdventurer Grandmaster!!!
X(its not easy, even if you do read the source code)
END_OF_FILE
if test 4732 -ne `wc -c <'advent.doc'`; then
echo shar: \"'advent.doc'\" unpacked with wrong size!
fi
# end of 'advent.doc'
fi
echo shar: End of archive 4 \(of 7\).
cp /dev/null ark4isdone
MISSING=""
for I in 1 2 3 4 5 6 7 ; do
if test ! -f ark${I}isdone ; then
MISSING="${MISSING} ${I}"
fi
done
if test "${MISSING}" = "" ; then
echo You have unpacked all 7 archives.
echo "now type 'sh combine.sh'"
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