! ADVENTURE 7 MAXIMUM 560 POINTS. RE-WRITTEN IN STANDARD FORTRAN 2008 FROM ADVENTURE 6 WITH CORRECTIONS AND ADDITIONS ! OF SOUNDS, COLOR, BASILISK, MERMAID AND RUBY YACHT BY NEAL VAN ECK, 2011. ! Adventure 6 was based on Adventure 5 with additions by David Long, and an anonymous coder around 1984. ! Doug McDonald changed it so that it would compile with f77 in 1990. ! Adventure 5 was extended from the 350 point original to 501 points by David Long at the University of Chicago around 1978. ! NOTE: PROGRAM AGENDAT CREATES THE INTERNAL DATABASE USED BY ADVENTURE ! CURRENT LIMITS: ! 22000 WORDS OF MESSAGE TEXT (LINES, LINSIZ). ! 1400 TRAVEL OPTIONS (TRAVEL, TRVSIZ). ! 600 VOCABULARY WORDS (KTAB, ATAB, TABSIZ). ! 250 LOCATIONS (LTEXT, STEXT, KEY, LOCCON, ABB, ATLOC, LOCSIZ, MAXLOC). ! 150 OBJECTS (PLAC, PLACE, FIXD, FIXED, LINK (TWICE), PTEXT, POINTS, HOLDER, HLINK, OBJCON, PROP, WEIGHT, MAXOBJ). ! 60 "ACTION" VERBS (ACTSPK, VRBSIZ, VKEY). ! 300 VERB/PREP/OBJ COMBINATIONS (PTAB, PTBSIZ). ! 50 ADJECTIVES (ADJKEY, ADJSIZ) ! 150 MODIFIED NOUNS (ADJTAB, MAXOBJ) ! 450 RANDOM MESSAGES (RTEXT, RTXSIZ). ! 12 DIFFERENT ADVENTURER CLASSIFICATIONS (CTEXT, CVAL, CLSMAX). ! 20 HINTS, LESS 3 (HINTLC, HINTED, HINTS, HNTSIZ, HNTMIN). ! THERE ARE ALSO LIMITS WHICH CANNOT BE EXCEEDED DUE TO THE STRUCTURE OF THE DATABASE. (E.G., THE VOCABULARY USES N/1000 TO ! DETERMINE WORD TYPE, SO THERE CAN'T BE MORE THAN 1000 WORDS OF ANY CLASS.) THESE UPPER LIMITS ARE: ! 1000 NON-SYNONYMOUS VOCABULARY WORDS OF EACH CLASS. CURRENTLY DEFINED CLASSES ARE: ! 1. MOTION/DIRECTION WORDS (EAST, WEST, UP, JUMP, ETC.) ! 2. NOUNS/OBJECTS (LAMP, KEYS, TROLL, ETC.) ! 3. ACTION VERBS, TRANSITIVE & INTRANSITIVE (TAKE, DROP, KILL, IN ! 4. MISCELLANEOUS WORDS; MOSTLY THINGS OR ACTIONS WHICH GENERATE FIXED REPLIES (FEE-FIE-FOE-FOO, TREE, CAVE, CURSES) ! 5. PREPOSITIONS, DUPLICATES MANY WORDS IN SECTION 1. ! 6. ADJECTIVES ! 7. CONJUNCTIONS ! 450 LOCATIONS ! 100 OBJECTS WHICH CAN BE USED IN TRAVEL TABLE (PLUS 900 MORE, WHICH CAN'T) ! THE DATA FILE CONTAINS SEVERAL SECTIONS. EACH BEGINS WITH A LINE CONTAINING ! A NUMBER IDENTIFYING THE SECTION, AND ENDS WITH A LINE CONTAINING "-1". ! SECTION 1: LONG FORM DESCRIPTIONS. EACH LINE CONTAINS A LOCATION NUMBER AND A LINE OF TEXT. THE SET OF ADJACENT LINES ! WHOSE NUMBERS ARE X FORM THE LONG DESCRIPTION OF LOCATION X. ! SECTION 2: SHORT FORM DESCRIPTIONS. SAME FORMAT AS LONG FORM. NOT ALL PLACES HAVE SHORT DESCRIPTIONS. ! SECTION 3: VOCABULARY. EACH LINE CONTAINS A NUMBER (N) AND A FIVE-LETTER WORD. LET M=N/1000. THEN IF: ! M=0: THE WORD IS A MOTION VERB FOR USE IN TRAVELLING (SEE SECTION 4). ! M=1: THE WORD IS AN OBJECT. ! M=2: THE WORD IS AN ACTION VERB (SUCH AS "CARRY" OR "ATTACK"). ! M=3: THE WORD IS A SPECIAL CASE VERB (SUCH AS "DIG") AND N MOD 1000 IS AN INDEX INTO SECTION 6. ! SECTION 4: TRAVEL TABLE. EACH LINE CONTAINS A LOCATION NUMBER (X), A SECOND LOCATION NUMBER (Y), AND A LIST ! OF MOTION VERBS (SEE SECTION 3). EACH MOTION REPRESENTS A VERB WHICH WILL GO TO Y IF CURRENTLY AT X. ! Y, IN TURN, IS INTERPRETED AS FOLLOWS. LET M=Y/1000, N=Y MOD 1000. ! IF N<=MAXLOC IT IS THE LOCATION TO GO TO. ! IF MAXLOC500 MESSAGE N-500 FROM SECTION 6 IS PRINTED, AND ADVENTURER STAYS IN CURRENT LOCATION. ! M SPECIFIES THE CONDITIONS ON THE MOTION: ! IF M=0 IT'S UNCONDITIONAL. ! IF 0100 ! CANNOT BE USED FOR CONDITIONAL MOTIONS IN TRAVEL TABLE. ! SECTION 6: ARBITRARY MESSAGES. SAME FORMAT AS SECTIONS 1, 2, AND 5, EXCEPT THE NUMBERS BEAR NO RELATION TO ANYTHING (EXCEPT FOR ! SPECIAL VERBS IN SECTION 3). ! SECTION 7: CONTAINS LOTS OF OBJECT INFO: ! (1) OBJECT LOCATIONS & WEIGHTS. EACH LINE CONTAINS AN OBJECT NUMBER AND ITS INITIAL LOCATION (ZERO OR BLANK IF NONE) ! FOLLOWED BY A "-1" IF IT IS IMMOVABLE. IF IT HAS TWO LOCATIONS (E.G., GRATE) THE FIRST LOCATION IS FOLLOWED WITH ! THE SECOND, AND THE OBJECT IS ASSUMED IMMOVABLE. IF THE OBJECT IS MOVABLE, IT HAS A THIRD NUMBER WHICH IS ITS ! RELATIVE WEIGHT. ! (2) DEFAULT OBJECT NAMES. TEN CHARACTER MAXIMUM. ! (3) POINTS. A SCORE VALUE, A PROP VALUE, AND A LOCATION NUMBER. THE SCORE IS FOR LEAVING IT AT THE ! NAMED LOCATION WITH THE RIGHT PROP VALUE. SCORES ARE ASSIGNED ON A DIFFICULTY SCALE OF 1-5 (1 IS FOR EASY ! TREASURES; 5 IS FOR REAL HARD ONES) AND ARE MULTIPLIED BY SOME APPROPRIATE FACTOR AT SCORING TIME. ! SECTION 8: ACTION DEFAULTS. EACH LINE CONTAINS AN "ACTION-VERB" NUMBER AND ! SECTION 9: LIQUID ASSETS, ETC. EACH LINE CONTAINS A NUMBER (N) AND UP TO 20 LOCATION NUMBERS. FOR THE LOW BYTE BIT N (WHERE 0 ! IS THE UNITS BIT) IS SET IN LOCCON(LOC) FOR EACH LOC GIVEN. THE COND BITS CURRENTLY ASSIGNED ARE: ! 0 LIGHT ! 1 IF BIT 3 IS ON: ON FOR OIL, OFF FOR WATER ! 2 IF BIT 3 IS ON: ON FOR WINE, OFF FOR WATER & OIL ! 3 LIQUID ASSET, SEE BITS 1 & 2 ! 4 PIRATE DOESN'T GO HERE UNLESS FOLLOWING ADVENTURER ! 5 ALL LOCATIONS IN EITHER 'PORTAL'; I.E., NOT OUTSIDE CAVE, BUT NOT FAR IN ! 6 ALL LOCATIONS OUTSIDE THE CAVE ! THE HIGH BYTE IS USED TO INDICATE AREAS OF INTEREST TO "HINT" ROUTINES: THE NUMBER 256*(BIT-7) INDICATES THE HINT ! 1 LOST IN MAZE ! 2 PONDERING DARK ROOM ! 3 AT WITT'S END ! 4 TRYING TO EXTRACT SWORD ! 5 TRYING TO GO UP SLIDE ! 6 TRYING TO GET INTO CAVE VIA SEA ENTRANCE ! 7 TRYING TO FIND CAVE (ANY ENTRANCE) ! 8 TRYING TO CATCH BIRD ! 9 TRYING TO GET OVER THE RAINBOW ! 10 STYMIED BY DOG ! 11 TRYING TO DEAL WITH SNAKE ! 12 TRYING TO GET TO THE CASTLE ! ONLY ONE HINT PER LOC IS ALLOWED LOCCON(LOC) IS SET TO 2, OVERRIDING ALL OTHER BITS, IF LOC HAS FORCED MOTION. ! SECTION 10: CLASS MESSAGES. EACH LINE CONTAINS A NUMBER (N) AND A MESSAGE DESCRIBING A CLASSIFICATION OF ADVENTURER. ! THE SCORING SECTION SELECTS THE APPROPRIATE MESSAGE, WHERE EACH MESSAGE IS CONSIDERED TO APPLY TO ADVENTURERS WHOSE ! SCORES ARE HIGHER THAN THE PREVIOUS N BUT NOT HIGHER THAN THIS N. ! SECTION 11: HINTS. EACH LINE CONTAINS A HINT NUMBER (CORRESPONDING TO A COND BIT, SEE SECTION 9), THE NUMBER OF TURNS MUST ! TAKE AT THE RIGHT LOC(S) BEFORE TRIGGERING THE HINT, THE POINTS DEDUCTED FOR TAKING THE HINT, THE MESSAGE NUMBER ! (SECTION 6) OF THE QUESTION, AND THE MESSAGE NUMBER OF THE HINT. THESE VALUES ARE STASHED IN THE "HINTS" ARRAY. ! HNTMAX IS SET TO THE MAX HINT NUMBER (<= HNTSIZ). NUMBERS 1-6 ARE UNUSABLE SINCE COND BITS ARE OTHERWISE ASSIGNED, ! SO 2 IS USED TO REMEMBER IF ADVENTURER READ THE CLUE IN THE REPOSITORY, AND 3 IS USED TO REMEMBER IF ADVENTURER ASKED ! FOR INSTRUCTIONS (GETS MORE TURNS, BUT LOSES POINTS). HNTMIN IS SET TO THE NUMBER OF THE FIRST USABLE HINT. ! SECTION 14: PREPOSITION TABLE. EACH LINE CONTAINS A VERB, A PREPOSITION AND VALID OBJECTS FOR THAT VERB/PREP COMBINATION. THEY ! ARE CONVERTED INTO TWO TABLES SIMILAR IN FORMAT TO THE TRAVEL TABLE. THE FIRST TABLE, VKEY, HAS ONE ENTRY PER VERB. ! A ZERO ENTRY INDICATES NO PREPOSITION IS VALID WITH THAT VERB. A NON-ZERO ENTRY POINTS TO THE BEGINNING OF THE ! PREP/OBJ LIST FOR THAT VERB. THE POSITION OF THE ENTRY IN VKEY CORRESPONDS TO THE VERB NUMBER. THE PREP/OBJ LIST, ! PTAB, FOR A GIVEN VERB CONSISTS OF A SERIES OF ONE-WORD ENTRIES DELIMITED BY A NEGATIVE ENTRY. EACH WORD CONTAINS ! THE PREPOSITION NUMBER TIMES 1000 PLUS A VALID OBJECT NUMBER. A SCHEMATIC FOLLOWS. ENTRIES IN VKEY ARE REPRESENTED ! BY V1, V2, ... VN. ENTRIES IN PTAB ARE REPRESENTED BY P1, P2, ..., PN (PREPOSITIONS) AND OB1, OB2,...,OBN (OBJECTS). ! I VKEY(I) PTAB(J) J ! - ------- ------- - ! 1. V1==========>> P1,OB1 1. ! P1,OB2 2. ! P1,OB3 3. ! P1,OB4 4. ! P1,OB5 5. ! P2,OB1 6. ! P2,OB2 7. ! P3,OB1 8. ! P3,OB2 9. ! P3,OB3 10. ! -P3,OB4 11. ! 2. V2==========>> P1,OB1 12. ! P1,OB2 13. ! P2,OB1 14. ! -P3,OB1 15. ! 3. 0 (THE VERB CORRESPONDING TO THIS POSITION TAKES NO PREPOSITION ! 4. V3==========>> P1,OB1 16. ! -P2,OB1 17. ! SECTION 15: OBJECT ATTRIBUTES. EACH LINE CONTAINS A BIT NUMBER AND UP TO 20 OBJECT NUMBERS. BIT N (WHERE ZERO IS THE UNITS BIT) ! IS SET IN OBJCON(OBJ) FOR EACH OBJECT GIVEN. THE BITS CURRENTLY ASSIGNED ARE: ! 1 THE OBJ CAN BE OPENED/CLOSED. (DOORS, GRATE, CLAM, ETC.) ! 2 THE OBJ IS CURRENTLY OPEN ! 3 IT HAS A LOCK. (GRATE, CHAIN, ELFIN DOOR, ETC.) ! 4 IT IS CURRENTLY LOCKED. ! 5 FLAMMABLE. (IT WILL BURN IF IGNITED) ! 6 IT IS CURRENTLY BURNING. ! 7 EDIBLE. FOOD, MUSHROOMS, ETC. ! 8 PRINTED MATERIAL, ANYTHING READABLE ! 9 A LIVING BEASTIE, E.G., DWARF, DOG, WUMPUS, ETC. ! 10 DEAD (KILLED) BEASTIE: WUMPUS, DRAGON, SLEEPING DOG ! 11 CAN BE WORN: CROWN, SHOES, CLOAK, JEWELS ! 12 IS CURRENTLY BEING WORN ! 13 REQUIRES PLURAL RESPONSES (SHOES, COINS, ETC.) ! 14 TREASURE ! 15 CONTAINER ! 16 OBJECT IS "SMALL". (CAN FIT INTO SACK OR CHEST) ! 17 CONTAINER IS OPAQUE -- CONTENTS ARE NOT VISIBLE UNLESS CONTAINER IS OPEN ! SECTION 16: ADJECTIVE/NOUN LIST. EACH VALID ADJECTIVE IS FOLLOWED BY ALL NOUNS WHICH IT MAY MODIFY. ! SECTION 0: END OF DATABASE. ! PHUCE CONSISTS OF FOUR PAIRS OF ORIGIN/DESTINATION LOCATIONS FROM/TO WHICH THE ADVENTURER 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. ! AJAR(OBJ) = TRUE IF 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() = TRUE IF CAN'T SEE (TOO DARK OR GLAREY) ! DARK() = 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 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 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 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 USE ALLCOM; USE IFQWIN; USE IFCORE INTEGER TRVS,TRVSIZ,VEND,VERB,VRBSIZ,WASTE,WKDAY,WKEND,UNLOCK,RANZ,LIQ,CONFUZ,NOWAY,VAL,CLASS,BURDEN,LIQLOC,VOCABX,& PUT,IRET,LEN_FILNAM,I,J,K,KK,JKK,LL LOGICAL YES,WASDARK,LIVING,ISFIXED CHARACTER ZAPP*20,KK2C*2,FILNAM*80,LASTSAVE*80 LOGICAL AJAR,AT,ATHAND,BLIND,DARK,DEAD,EDIBLE,ENCLSD,FORCED,HERE,HINGED,HOLDNG,INSIDE,LOCKS,OUTSID,OPAQUE,PCT,PLURAL,PRINTD,& SMALL,TOTING,TREASURE,LOCKED,VESSEL,WEARNG,WEARABLE,RESULT IRET=SETEXITQQ(QWIN$EXITNOPERSIST) RESULT=DELETEMENUQQ(6,0) !delete help menu because can't use it RESULT=DELETEMENUQQ(1,0) !delete file (MAKES EDIT MENU NOW MENU 1) RESULT=DELETEMENUQQ(2,0) !delete view menu because full screen jerks !DO NOT DELETE STATE (PAUSE/RESUME) --NEEDED FOR EDITS CALL SETSCREEN(80,42,0) LOC=CLICKMENUQQ(QWIN$STATUS) !TURN OFF STATUS BAR RESULT=DELETEMENUQQ(3,0) !DELETE WINDOW MENU ! 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 A ADVENTURER-CLASS MESSAGE. MTEXT IS FOR SECTION 12. WE ALSO CLEAR COND. ! SEE DESCRIPTION OF SECTION 9 FOR DETAILS. ! ****** GET DATABASE FROM DISK OPEN (UNIT=16,FILE='ADV.DAT',STATUS='OLD',FORM='UNFORMATTED',ACCESS='SEQUENTIAL',IOSTAT=I) IF (I.NE.0) CALL BUG('CAN''T OPEN DATABASE; FILE MISSING') READ(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) CALL POOF(0) CALL COLOR(1) LOC = 1 INDENT = 0 NEWLOC=1 LIMIT=650 FLG239=0 CALL SOUND('Welcome to adventure') CALL SPEAK(RTEXT(1)) !WELCOME, INSTRUCTIONS CALL RANDOM_SEED 2 IF (NEWLOC.GT.0) THEN IF (OUTSID(NEWLOC).AND.CLOSNG) THEN NEWLOC=LOC CALL COLOR(LOC) CALL SOUND('EXIT CLOSED') CALL SPEAK(RTEXT(130)) ! CAN'T LEAVE CAVE ONCE IT'S CLOSING EXCEPT BY MAIN OFFICE. IF (.NOT.PANIC) CLOCK2=15 PANIC=.TRUE. ENDIF ENDIF ! SEE IF A DWARF HAS SEEN US AND CAME FROM WHERE WE WANT TO GO. IF SO, THE DWARF'S BLOCKING THE WAY. ! IF COMING FROM PLACE FORBIDDEN TO PIRATE LET ADVENTURER GET OUT (AND ATTACKED). IF (NEWLOC.NE.LOC) THEN ILOC=LOC IF (.NOT.FORCED(ILOC)) THEN IF (IAND(LOCCON(ILOC),16).EQ.0) THEN DO I=1,DWFMAX-1 IF (ODLOC(I).EQ.NEWLOC.AND.DSEEN(I)) THEN NEWLOC=LOC CALL SPEAK(RTEXT(2)) EXIT ENDIF END DO ENDIF ENDIF ENDIF LOC=NEWLOC ! DWARF STUFF. SIXTH DWARF IS PIRATE AND IS VERY DIFFERENT EXCEPT FOR MOTION RULES. ! ACTIVATE DWARVES FIRST TIME ADVENTURER GETS AS FAR AS HALL OF MISTS (LOC 15). DON'T LET DWARVES FOLLOW ADVENTURER INTO A PIT ! OR A WALL. IF NEWLOC FORBIDDEN TO PIRATE (I.E., IF IT'S BEYOND THE TROLL BRIDGE), BYPASS DWARF STUFF. THAT WAY PIRATE ! CAN'T STEAL RETURN TOLL AND DWARVES CAN'T MEET THE BEAR. DWARVES WON'T FOLLOW INTO DEAD END IN MAZE, BUT THEY WAIT OUTSIDE. IF (LOC.EQ.0) GO TO 2000 IF (FORCED(LOC).OR.IAND(LOCCON(NEWLOC),16).NE.0) GO TO 2000 IF (DFLAG.EQ.0) THEN IF (INSIDE(LOC)) DFLAG=1 GO TO 2000 ENDIF ! WHEN WE ENCOUNTER THE FIRST DWARF, KILL 0, 1, OR 2 OF THEM. IF ANY OF THE SURVIVORS IS AT LOC, REPLACE HIM WITH THE ALTERNATE. IF (DFLAG.EQ.1) THEN IF (INSIDE(LOC).AND.PCT(5)) THEN DFLAG=2 DO I=1,2 J=1+RANZ(DWFMAX-1) IF (PCT(50)) DLOC(J)=0 END DO DO I=1,DWFMAX-1 IF (DLOC(I).EQ.LOC) DLOC(I)=DALTLC ODLOC(I)=DLOC(I) END DO ODLOC(DWFMAX)=DLOC(DWFMAX) CALL SOUND('AXE THROW') CALL SPEAK(RTEXT(3)) WRITE (*,"(' ')") CALL DROP(AXE,LOC) ENDIF GO TO 2000 ENDIF ! MOVE DWARVES AT RANDOM, EXCEPT IF DWARVES SEE US THEY STICK WITH US. DWARVES NEVER GO TO OUTSIDE LOCS OR EITHER OF THE PORTAL ! IF WANDERING AT RANDOM, THEY DON'T BACK UP UNLESS THERE'S NO ALTERNATIVE. IF THEY DON'T HAVE TO MOVE, THEY ATTACK. DTOTAL=0 ATTACK=0 STICK=0 DO I=1,DWFMAX IF (DLOC(I).EQ.0) CYCLE J=1 KK=KEY(DLOC(I)) !GET NEXT TRAVEL LOCATION FOR DWARF IF (KK.NE.0) THEN 6012 NEWLOC=MOD(IABS(TRAVEL(KK))/1000,1000) IF (NEWLOC.LE.MAXLOC) THEN IF (NEWLOC.EQ.ODLOC(I).OR..NOT.INSIDE(NEWLOC).OR.NEWLOC.EQ.DLOC(I).OR.FORCED(NEWLOC).OR.& (I.EQ.DWFMAX.AND.IAND(LOCCON(NEWLOC),16).NE.0).OR.IABS(TRAVEL(KK))/1000.EQ.100) GO TO 6014 IF (J.GT.1.AND.J.LT.20) THEN IF (NEWLOC.NE.TK(J-1)) THEN TK(J)=NEWLOC J=J+1 ENDIF ENDIF ENDIF 6014 KK=KK+1 IF (TRAVEL(KK-1).GE.0) GO TO 6012 ENDIF TK(J)=ODLOC(I) IF (J.GE.2)J=J-1 J=1+RANZ(J) ODLOC(I)=DLOC(I) DLOC(I)=TK(J) DSEEN(I)=(DSEEN(I).AND.INSIDE(LOC)).OR.(DLOC(I).EQ.LOC.OR.ODLOC(I).EQ.LOC) IF (.NOT.DSEEN(I)) CYCLE DLOC(I)=LOC IF (I.NE.DWFMAX) GO TO 6027 ! THE PIRATE'S SPOTTED US, BUT LEAVES US ALONE ONCE WE'VE FOUND CHEST. K COUNTS IF A TREASURE IS HERE. ! IF NOT, AND TALLY=TALLY2 PLUS ONE FOR AN UNSEEN CHEST, LET THE PIRATE BE SPOTTED. IF (LOC.EQ.CHLOC.OR.PROP(CHEST).GE.0) CYCLE K=0 DO J=1,MAXOBJ ! PIRATE WON'T TAKE PYRAMID FROM PLOVER ROOM OR DARK ROOM (TOO EASY!). IF (TREASURE(J).AND. .NOT.(J.EQ.CASK.AND.LIQ(CASK).EQ.WINE)) THEN IF (.NOT.(J.EQ.PYRAM.AND.(LOC.EQ.PLAC(PYRAM).OR.LOC.EQ.PLAC(EMRALD)))) THEN IF (TOTING(J).AND.ATHAND(J)) GO TO 6022 !EXIT IF FOUND A TREASURE TO STEAL ENDIF IF (HERE(J)) K=1 !INDICATE STILL HAVE CASK WITH WINE OR PYRAMID ENDIF END DO IF (TALLY.EQ.TALLY2+1.AND.K.EQ.0.AND.PLACE(CHEST).EQ.0.AND.ATHAND(LAMP).AND.PROP(LAMP).EQ.1) GO TO 6025 IF (ODLOC(DWFMAX).NE.DLOC(DWFMAX).AND.PCT(90)) CALL SPEAK(RTEXT(127)) CYCLE 6022 CALL SPEAK(RTEXT(128)) !PIRATE TAKES TREASURE ! DON'T STEAL CHEST BACK FROM TROLL! IF (PLACE(MESSAG).EQ.0) CALL MOVE(CHEST,CHLOC) CALL MOVE(MESSAG,CHLOC2) DO J=1,MAXOBJ IF (.NOT.TREASURE(J).OR.(J.EQ.PYRAM.AND.(LOC.EQ.PLAC(PYRAM).OR.LOC.EQ.PLAC(EMRALD))).OR.& (J.EQ.CASK.AND.LIQ(CASK).NE.WINE).OR.(ENCLSD(J).AND..NOT.ATHAND(J))) CYCLE IF (AT(J).AND.FIXED(J).EQ.0) CALL CARRY(J,LOC) IF (ENCLSD(J)) CALL REMOVE(J) IF (HOLDNG(J)) THEN CALL INSERT(J,CHEST) IF (WEARNG(J)) THEN PROP(J)=0 OBJCON(J)=IBCLR(OBJCON(J),WEARBT) ENDIF ENDIF END DO 6024 DLOC(DWFMAX)=CHLOC ODLOC(DWFMAX)=CHLOC DSEEN(DWFMAX)=.FALSE. CYCLE 6025 CALL SPEAK(RTEXT(186)) CALL MOVE(CHEST,CHLOC) CALL MOVE(MESSAG,CHLOC2) GO TO 6024 ! THIS THREATENING LITTLE DWARF IS IN THE ROOM! 6027 DTOTAL=DTOTAL+1 IF (ODLOC(I).NE.DLOC(I)) CYCLE ATTACK=ATTACK+1 IF (KNFLOC.GE.0) KNFLOC=LOC IF (RANZ(1000).LT.250*(DFLAG-2)) STICK=STICK+1 END DO ! TELL ADVENTURER WHAT'S HAPPENING. IF (DTOTAL.GT.0) THEN IF (DTOTAL.EQ.1) THEN CALL SPEAK(RTEXT(4)) ELSE WRITE(*,"(/' There are ',I1,' threatening little dwarves in the room with you!')")DTOTAL ENDIF IF (ATTACK.EQ.0) GO TO 2000 IF (DFLAG.EQ.2) DFLAG=3 DO I=1,ATTACK CALL SOUND('KNIFE THROW') IF (I.LE.STICK) CALL SOUND('SMACK') END DO IF (ATTACK.EQ.1) THEN CALL SPEAK(RTEXT(5)) !ONE SHARP KNIFE K=52 ELSE WRITE (*,"(/I2,' of them throw knives at you!')") ATTACK K=6 ENDIF IF (STICK.GT.1) THEN WRITE (*,"(/I2,' of them get you!')") STICK ELSE CALL SPEAK(RTEXT(K+STICK)) !NONE OR ONE GETS YOU IF (STICK.EQ.0) GO TO 2000 ENDIF OLDLC2=LOC GO TO 94100 ENDIF ! DESCRIBE THE CURRENT LOCATION AND (MAYBE) GET NEXT COMMAND. 2000 IF (LOC.EQ.0) GO TO 94100 JKK=STEXT(LOC) IF (VERB.EQ.LOOK.OR.JKK.EQ.0.OR.(.NOT.TERSE.AND.MOD(ABB(LOC),ABBNUM).EQ.0)) JKK=LTEXT(LOC) IF ((FORCED(LOC).OR..NOT.DARK()).AND.LOC.NE.200) GO TO 2001 IF (LOC.EQ.200.OR.(DARK().AND.PROP(LAMP).NE.0.AND.ATHAND(LAMP))) THEN IF (PROP(LAMP).EQ.0.OR..NOT.ATHAND(LAMP)) GO TO 2020 IF (PCT(35)) GO TO 94000 JKK=RTEXT(294) GO TO 2020 ENDIF IF (WASDARK.AND.PCT(35)) GO TO 94000 JKK=RTEXT(16) 2001 IF (HOLDNG(BEAR).AND..NOT.DARK()) CALL SPEAK(RTEXT(141)) IF (LOC.EQ.206) THEN IF (PROP(BASILISK).LT.3.AND.PROP(BASILISK).GT.0) THEN PROP(BASILISK)=PROP(BASILISK)+1 IF (HOLDNG(GLASS)) THEN PROP(BASILISK)=4 OBJCON(BASILISK)=IBSET(OBJCON(BASILISK),DEADBT) ENDIF CALL PSPEAK(BASILISK,PROP(BASILISK)) IF (PROP(BASILISK).EQ.3) GO TO 94100 ENDIF ENDIF 2020 CALL SPEAK(JKK) K=1 ABB(LOC)=ABB(LOC)+1 IF (FORCED(LOC)) THEN CALL TRAVL(K,BCROSS,TALLY2) IF (KILLED) GO TO 94100 GO TO 2 ENDIF ABB(LOC)=ABB(LOC)-1 IF (LOC.EQ.Y2.AND.PCT(25).AND..NOT.CLOSNG) CALL SPEAK(RTEXT(8)) IF (LOC.EQ.147.AND.ABB(LOC).EQ.1) CALL SPEAK(RTEXT(216)) ! SEE IF WASTING BATTERIES OUT IN THE OPEN. K=0 IF (OUTSID(LOC).AND.PROP(LAMP).NE.0) THEN K=WASTE+1 IF (K.GT.12) THEN CALL SPEAK(RTEXT(324)) K=0 ENDIF ENDIF WASTE=K ! IF WUMPUS IS CHASING, SEE IF CAUGHT. IF (CHASE.NE.0) THEN CHASE=CHASE+1 KK=CHASE/2 PROP(WUMPUS)=KK CALL MOVE(WUMPUS,LOC) IF (KK.GE.5) THEN IF (DARK()) CALL SPEAK(RTEXT(270)) CALL PSPEAK(WUMPUS,5) GO TO 94100 ENDIF ENDIF ! CHECK FOR RADIATION POISONING. K=1 IF (OUTSID(LOC))K=3 HEALTH=MIN0(HEALTH+K,100) IF (HERE(RADIUM).and.(PLACE(RADIUM).NE.-SHIELD.OR.AJAR(SHIELD))) THEN HEALTH=HEALTH-7 IF (HEALTH.LT.60) THEN CALL SPEAK(RTEXT(391+(60-HEALTH)/10)) IF (HEALTH.LE.0) GO TO 94100 ENDIF ENDIF ! PRINT OUT DESCRIPTIONS OF OBJECTS AT THIS LOCATION. IF NOT CLOSING AND PROPERTY VALUE IS NEGATIVE, TALLY ! OFF ANOTHER TREASURE. RUG IS SPECIAL CASE; ONCE SEEN, ITS PROP IS 1 (DRAGON ON IT) UNTIL DRAGON IS KILLED. ! SIMILARLY FOR CHAIN; PROP IS INITIALLY 1 (LOCKED TO BEAR). FOR SWORD MUST PROVE ELFIN ROYALTY. IF (OLDLOC.EQ.188.AND.LOC.NE.189.AND.LOC.NE.188.AND.PROP(BOOTH).EQ.1) THEN CALL MOVE(GNOME,0) PROP(BOOTH)=0 ENDIF IF (BLIND()) GO TO 2100 ABB(LOC)=ABB(LOC)+1 I=ATLOC(LOC) 2004 IF (I.EQ.0) GO TO 2100 OBJ=I IF (OBJ.GT.MAXOBJ) OBJ=OBJ-MAXOBJ IF (OBJ.EQ.STEPS.AND.TOTING(NUGGET)) GO TO 2008 IF (PROP(OBJ).LT.0) THEN IF (CLOSED) GO TO 2008 PROP(OBJ)=0 IF (OBJ.EQ.RUG.OR.OBJ.EQ.CHAIN.OR.OBJ.EQ.SWORD.OR.OBJ.EQ.CASK) PROP(OBJ)=1 IF (OBJ.EQ.CLOAK.OR.OBJ.EQ.RING) PROP(OBJ)=2 TALLY=TALLY-1 IF (TALLY.EQ.TALLY2.AND.TALLY.NE.0) LIMIT=MIN0(35,LIMIT) !IF REMAINING TREASURES TOO ELUSIVE, ZAP LAMP. ENDIF KK=PROP(OBJ) IF (OBJ.EQ.STEPS.AND.LOC.EQ.FIXED(STEPS)) KK=1 CALL PSPEAK(OBJ,KK) IF (OBJ.EQ.MERMAID) THEN IF (PROP(MERMAID).EQ.1) THEN CALL DROP(GLASS,154) !MERMAID DROPS MIRROR CALL MOVE(MERMAID,0) !AND DIVES INTO SEA ELSE PROP(MERMAID)=1 ENDIF ENDIF CALL LOOKIN(OBJ) 2008 I=LINK(I) GO TO 2004 ! "I DON'T UNDERSTAND THAT!" 2060 SPK=CONFUZ() GO TO 2011 ! "YOU CAN'T DO THAT!" (AN IMPOSSIBLE ACT, E.G., "OPEN SWORD", "FEED BOAT", ETC. 2070 SPK=NOWAY() GO TO 2011 2009 SPK=54 2011 IF (OBJ.NE.0.AND.(OBJS(2).NE.0.OR.IOBJS(2).NE.0)) THEN CALL PSPEAK(OBJ,-1) INDENT=1; BLKLIN=.FALSE. ENDIF IF (SPK.NE.0) CALL SPEAK(RTEXT(SPK)) BLKLIN=.TRUE. 2100 RDFLAG=.FALSE. IF (OBJX.NE.0) THEN OBJX=OBJX+1 IF (OBJS(OBJX).EQ.0) OBJX=0 ENDIF IF (OBJX.GT.0) THEN IF (OBJS(OBJX).NE.0) GO TO 2120 ENDIF IF (IOBX.NE.0) THEN IOBX=IOBX+1 IF (IOBJS(IOBX).EQ.0) IOBX=0 IF (IOBX.NE.0.AND.OBJS(1).NE.0) OBJX=1 ENDIF 2120 IF (OBJX.LE.0.AND.IOBX.LE.0) THEN IF (OBJS(1).NE.0) OBJX=1 IF (IOBJS(1).NE.0)IOBX=1 VRBX=VRBX+1 IF (VERBS(VRBX).EQ.0) THEN CALL CLRLIN RDFLAG=.TRUE. ENDIF ENDIF ! CHECK LOC IS ELIGIBLE FOR ANY HINTS. IF BEEN HERE LONG ENOUGH, BRANCH TO HELP SECTION HINTS COME ! BACK HERE TO FINISH THE LOOP. IGNORE "HINTS" < HNTMIN (SPECIAL STUFF, SEE DATABASE NOTES). 2600 DO HINT=HNTMIN,HNTMAX IF (HINTED(HINT)) CYCLE IF ((LOCCON(LOC)/256).NE.HINT-6) HINTLC(HINT)=-1 HINTLC(HINT)=HINTLC(HINT)+1 IF (HINTLC(HINT).GE.HINTS(HINT,1)) GO TO 40000 END DO ! IF CLOSING TIME, CHECK FOR TOTED OBJECTS WITH PROP < 0 AND SET PROP TO -1-PROP. THIS WAY OBJECTS WON'T BE DESCRIBED UNTIL ! THEY'RE PICKED UP AND PUT DOWN SEPARATE FROM THEIR RESPECTIVE PILES. DON'T TICK CLOCK1 UNLESS WELL INTO CAVE (AND NOT AT Y2). 2602 IF (CLOSED) THEN IF (PROP(OYSTER).LT.0.AND.TOTING(OYSTER)) CALL PSPEAK(OYSTER,1) DO I=1,MAXOBJ IF (TOTING(I).AND.PROP(I).LT.0)PROP(I)=-1-PROP(I) END DO ENDIF WASDARK=DARK() IF (KNFLOC.GT.0.AND.KNFLOC.NE.LOC) KNFLOC=0 I=RANZ(1) IF (RDFLAG) THEN !GET A NEW INPUT CLAUSE, OR FINISH GETTING CURRENT ONE. CALL GETWDS VRBX=1 OBJX=0 IF (OBJS(1).NE.0) OBJX=1 IOBX=0 IF (IOBJS(1).NE.0) IOBX=1 RDFLAG=.TRUE. ENDIF ! EVERY INPUT CHECK "FOOBAR" FLAG. IF ZERO, NOTHING'S GOING ON. IF POS, MAKE NEG. IF NEG, SKIPPED A WORD, SO MAKE IT ZERO. FOOBAR=MIN0(0,-FOOBAR) COMBO=MIN0(0,-COMBO) TURNS=TURNS+1 IF (TURNS.EQ.310.AND.ABBNUM.NE.10000.AND..NOT.TERSE) CALL SPEAK(RTEXT(273)) ! BUMP CLOCKS FOR RECONNING BATTERY LIFE AND CLOSING. IF (CLOSED) CLOCK3=CLOCK3-1 IF (CLOCK3.EQ.-7) GO TO 93300 IF (CLOCK3.EQ.0) THEN PROP(PHONE)=0 PROP(BOOTH)=0 CALL SPEAK(RTEXT(284)) ENDIF IF (TALLY.EQ.0.AND.INSIDE(LOC).AND.LOC.NE.Y2) CLOCK1=CLOCK1-1 IF (CLOCK1.EQ.0) GO TO 90000 IF (CLOCK1.LT.0) CLOCK2=CLOCK2-1 IF (CLOCK2.EQ.0) GO TO 91000 IF (PROP(LAMP).EQ.1) LIMIT=LIMIT-1 IF (LIMIT.EQ.0) THEN LIMIT=-1 !LAMP WENT OUT PROP(LAMP)=0 IF (HERE(LAMP)) CALL SPEAK(RTEXT(184)) ELSEIF (LIMIT.LT.0.AND.OUTSID(LOC)) THEN CALL SPEAK(RTEXT(185)) !WANDERED OUTSIDE AND LAMP USED UP GAVEUP=.TRUE. GO TO 95000 ELSEIF (LIMIT.LE.40) THEN IF (.NOT.LMWARN.AND.HERE(LAMP)) THEN LMWARN=.TRUE. SPK=187 !LAMP IS DYING IF (PROP(BATTER).EQ.1) SPK=323 IF (PLACE(BATTER).EQ.0) SPK=183 IF (PROP(VEND).EQ.1) SPK=189 CALL SPEAK(RTEXT(SPK)) ENDIF ENDIF 19999 VERB=VAL(VERBS(VRBX)) OBJ=0 IF (OBJX.NE.0) OBJ=OBJS(OBJX) IOBJ=0 IF (IOBX.NE.0)IOBJ=IOBJS(IOBX) IF (KNFLOC.EQ.LOC.AND.(OBJ.EQ.KNIFE.OR.IOBJ.EQ.KNIFE)) THEN KNFLOC=-1 SPK=116 GO TO 2011 ENDIF SELECT CASE (CLASS(VERBS(VRBX))) CASE (1) !MOTION VERB. ANALYZE & LOOP TO 2 IF NOT DEAD. CALL TRAVL(VERB,BCROSS,TALLY2) IF (KILLED) GO TO 94100 GO TO 2 CASE (3); GO TO 4000 CASE (4) SPK=VERB GO TO 2011 END SELECT CALL BUG('INVALID VERB CLASS')! ANALYSE A VERB. 4000 SPK=ACTSPK(VERB) IF (OBJ.EQ.0.AND.IOBJ.EQ.0) THEN ! ANALYSE AN INTRANSITIVE VERB (IE, NO OBJECT GIVEN YET). SELECT CASE (VERB) CASE (1,32,44:47); GO TO 10100 !TAKE, YANK, GET, INSERT, REMOVE, BURN CASE (2,3,9,10,16,17,19,21,27:29,33,34,39:43); GO TO 10000 !DROP, SAY, WAVE, CALM, RUB, THROW, FIND, FEED, READ, BREAK, !WAKE, WEAR, HIT, PLAY, PICK, PUT, TURN, GET CASE (4,6,49,50); GO TO 10400 !OPEN, CLOSE, LOCK, UNLOCK CASE (5); GO TO 2009 !NOTHING CASE (7); GO TO 20700 !ON CASE (8); GO TO 20800 !OFF CASE (11); GO TO 2011 !WALK CASE (12); GO TO 21200 !KILL CASE (13); GO TO 11300 !POUR CASE (14); GO TO 11400 !EAT CASE (15); GO TO 11500 !DRINK CASE (18); GO TO 11800 !QUIT CASE (20); GO TO 12000 !INVENTORY CASE (22); GO TO 12200 !FILL CASE (23); GO TO 12300 !BLAST CASE (24); GO TO 12400 !SCORE CASE (25); GO TO 12500 !FOO CASE (26); GO TO 12600 !BRIEF CASE (30); GO TO 13000 !SUSPEND/SAVE CASE (31); GO TO 13100 !RESUME CASE (35); GO TO 13500 !ANSWER CASE (36); GO TO 23600 !BLOW CASE (37) !LEAVE CALL BUG("ACTION VERB 'LEAVE' HAS NO OBJECT.") CASE (38); GO TO 13800 !YELL CASE (48); GO TO 2011 !GRIPE CASE (51); GO TO 25100 !HEALTH CASE (52); GO TO 25200 !LOOK CASE (53); GO TO 25300 !COMBO CASE (54); GO TO 25400 !SWEEP CASE (55); GO TO 25500 !TERSE CASE (56); GO TO 25600 !WIZ CASE (57,59); GO TO 25900 !MAP (DWARVES, PIRATE) WIZARD MODE ONLY CASE (58); GO TO 25800 !GATE CASE DEFAULT; CALL BUG('INTRANSITIVE ACTION VERB EXCEEDS CASE LIST') END SELECT ELSE ! ANALYSE A TRANSITIVE VERB. SELECT CASE (VERB) CASE (1); GO TO 20100 !TAKE CASE (2,37); GO TO 20200 !DROP, LEAVE CASE (3,38) !SAY, YELL CALL BUG("VERB 'SAY' OR 'YELL' SLIPPED THROUGH WITH AN OBJECT.") CASE (4); GO TO 20400 !OPEN CASE (5); GO TO 2009 !NOTH CASE (6); GO TO 20600 !CLOSE CASE (7); GO TO 20700 !ON CASE (8); GO TO 20800 !OFF CASE (9); GO TO 20900 !WAVE CASE (10,11,18,24,25,30,31); GO TO 2011 !CALM, WALK, QUIT, SCORE, FOO, SUSPD, HOUR CASE (12); GO TO 21200 !KILL CASE (13); GO TO 21300 !POUR CASE (14); GO TO 21400 !EAT CASE (15); GO TO 21500 !DRINK CASE (16); GO TO 21600 !RUB CASE (17); GO TO 21700 !THROW CASE (19,20); GO TO 21900 !FIND, INVENTORY CASE (21); GO TO 22100 !FEED CASE (22); GO TO 22200 !FILL CASE (23); GO TO 12300 !BLAST CASE (26); GO TO 22600 !BRIEF CASE (27); GO TO 22700 !READ CASE (28); GO TO 22800 !BREAK CASE (29); GO TO 22900 !WAKE CASE (32); GO TO 23200 !YANK CASE (33); GO TO 23300 !WEAR CASE (34); GO TO 23400 !HIT CASE (35); GO TO 23500 !ANSWER CASE (36); GO TO 23600 !BLOW CASE (39); GO TO 23900 !DIAL CASE (40); GO TO 24000 !PLAY CASE (41); GO TO 24100 !PICK CASE (42); GO TO 24200 !PUT CASE (43); GO TO 24300 !TURN CASE (44); GO TO 24400 !GET CASE (45); GO TO 24500 !INSERT CASE (46); GO TO 24600 !REMOVE CASE (47); GO TO 2011 !BURN CASE (48); GO TO 2011 !GRIPE CASE (51,55:59); GO TO 2060 !HEALTH, TERSE, WIZ, MAP, GATE CASE (49); GO TO 24900 !LOCK CASE (50); GO TO 25000 !UNLOCK CASE (52); GO TO 25200 !LOOK CASE (53); GO TO 2070 !COMBO CASE (54); GO TO 25400 !SWEEP CASE DEFAULT; CALL BUG('TRANSITIVE ACTION VERB EXCEEDS CASE LIST') END SELECT ENDIF ! ROUTINES FOR PERFORMING THE VARIOUS ACTION VERBS ! CLEAR OBJ JUST IN CASE (SEE "ATTACK"). 10000 ZAPP=VTXT(VRBX); ZAPP(LEN_TRIM(ZAPP)+1:)=' what?' CALL LOWER_CASE(ZAPP) CALL UPPER_CASE(ZAPP(1:1)) WRITE(*,"(/' ',A)") ZAPP OBJS(1)=0 OBJX=0 GO TO 2600 10010 ZAPP=VTXT(VRBX); ZAPP(LEN_TRIM(ZAPP)+1:)=' it?' CALL LOWER_CASE(ZAPP) WRITE(*,"(/' Where do you want to ',A)") ZAPP GO TO 2600 ! CONSTRUCT MSG: "I DON'T KNOW HOW TO [VERB] THE [OBJ]", AND VARIANTS. ! CARRY, NO OBJECT GIVEN YET. OK IF ONLY ONE OBJECT PRESENT. 10100 IF (ATLOC(LOC).EQ.0) GO TO 10000 IF (LINK(ATLOC(LOC)).NE.0.OR.BLIND()) GO TO 10000 DO I=1,DWFMAX-1 IF (DLOC(I).EQ.LOC.AND.DFLAG.GE.2) GO TO 10000 END DO OBJ=ATLOC(LOC) IF (VERB.EQ.YANK) GO TO 23200 IF (VERB.EQ.WEAR) GO TO 23300 ! CARRY OBJECT. IF BIRD IN CAGE, MUST TAKE BOTH. LIQUIDS DEPEND ON STATUS OF BOTTLE. ! "YANK" AND "WEAR" WEAVE INTO THIS CODE SINCE THEY ARE MOSTLY RESTRICTED TO CARRYS. 20100 IF (OBJ.EQ.BOAT) SPK=281 IF (OBJ.EQ.YACHT) THEN IF (LOC.EQ.206) THEN IF (.NOT.DEAD(BASILISK)) THEN PROP(BASILISK)=PROP(BASILISK)+1 IF (HOLDNG(GLASS)) THEN PROP(BASILISK)=4 OBJCON(BASILISK)=IBSET(OBJCON(BASILISK),DEADBT) ENDIF CALL PSPEAK(BASILISK,PROP(BASILISK)) IF (PROP(BASILISK).EQ.3) GO TO 94100 IF (PROP(BASILISK).NE.4) GO TO 2600 PROP(BASILISK)=5 ENDIF ENDIF PROP(YACHT)=1 ENDIF IF (PLURAL(OBJ)) SPK=297 IF (OBJ.EQ.BIRD.AND..NOT.CLOSED.AND.ATHAND(BIRD).AND.PLACE(BIRD).NE.LOC) THEN CALL SPEAK(RTEXT(407)) GO TO 2 ENDIF IF (PREP.EQ.PREPOF) THEN IF (OBJ.NE.0.AND.IOBJ.NE.0) GO TO 2060 IF (OBJ.EQ.0) OBJ=IOBJ IOBJ=0 GO TO 20200 ENDIF IF (HOLDNG(OBJ)) GO TO 2011 CALL NOT_TOTING_SPK(ISFIXED) IF (LOC.EQ.154) THEN IF (PLACE(MERMAID).EQ.LOC) THEN SPK=399 CALL DROP(GLASS,154) !MERMAID DROPS MIRROR CALL MOVE(MERMAID,0) !AND DIVES INTO SEA ENDIF ENDIF IF (ISFIXED) GO TO 2011 IF (PREP.EQ.PREPIN) GO TO 24500 IF (PREP.EQ.PREPFR.OR.ENCLSD(OBJ)) GO TO 24600 ! THE NEXT LINES ARE FOR 'TAKING' LIQUIDS (WATER, OIL & WINE). IF HOLDING A CONTAINER (BOTTLE OR CASK), ! TAKE THE LIQUID BY FILLING IT. IF A CONTAINER HOLDING THE REQUESTED LIQUID IS NEARBY, PICK IT UP. IF (IOBJ.NE.0) THEN SPK=313 IF (OBJ.NE.CASK.AND.OBJ.NE.BOTTLE) GO TO 2011 K=0 IF (OBJ.EQ.CASK)K=1 IOBJ=IOBJ+K IF (LIQ(OBJ).EQ.IOBJ) GO TO 20116 SPK=302+K IF (PROP(OBJ).NE.1) GO TO 2011 GO TO 20118 ENDIF IF (OBJ.NE.WATER.AND.OBJ.NE.OIL.AND.OBJ.NE.WINE) GO TO 20120 IOBJ=OBJ K=0 OBJ=BOTTLE IF (HERE(BOTTLE)) THEN IF (PROP(BOTTLE).EQ.1) THEN IF (.NOT.HERE(CASK).OR.(HERE(CASK).AND.PROP(CASK).EQ.1)) GO TO 20118 OBJ=0 CALL SPEAK(RTEXT(304)) GO TO 2600 ENDIF IF (LIQ(BOTTLE).EQ.IOBJ) GO TO 20116 ENDIF SPK=312 IF (HERE(CASK)) THEN OBJ=CASK K=1 IF (PROP(CASK).EQ.1) GO TO 20118 IF (LIQ(CASK).EQ.IOBJ) GO TO 20116 SPK=315 IF (.NOT.ATHAND(BOTTLE)) SPK=303 ENDIF GO TO 2011 20116 IF (.NOT.HOLDNG(OBJ)) GO TO 20120 SPK=302+K GO TO 2011 20118 IF (HOLDNG(OBJ)) GO TO 22200 ! *** END OF LIQUID STUFF ! 'WEAR' AND 'YANK' WEAVE IN HERE. 20120 SPK=343 IF (OBJ.EQ.BEAR) THEN SPK=141 ELSEIF (BURDEN(0)+BURDEN(OBJ).GT.15 ) THEN SPK=92 IF (WEARNG(OBJ)) THEN PROP(OBJ)=0 OBJCON(OBJ)=IBCLR(OBJCON(OBJ),WEARBT) ENDIF GO TO 2011 ENDIF ! CLOAK IF (OBJ.EQ.CLOAK.AND.PROP(CLOAK).EQ.2) THEN PROP(ROCKS)=1 PROP(CLOAK)=0 FIXED(CLOAK)=0 CALL CARRY(CLOAK,LOC) CALL SPEAK(RTEXT(241)) IF (AT(WUMPUS).AND.PROP(WUMPUS).EQ.0) GO TO 22900 GO TO 2100 ENDIF ! POSTER: HIDES WALL SAFE. IF (OBJ.EQ.POSTER.AND.PLACE(SAFE).EQ.0) THEN PROP(POSTER)=1 SPK=362 ! MOVE SAFE AND WALL CONTAINING SAFE INTO VIEW. CALL DROP(SAFE,LOC) CALL DROP(WALL2,LOC) GO TO 20180 ENDIF ! BOAT: NEED THE POLE TO PUSH IT IF (OBJ.EQ.BOAT) THEN SPK=218 IF (.NOT.TOTING(POLE).AND.PLACE(POLE).NE.-BOAT) GO TO 2011 PROP(BOAT)=1 SPK=221 GO TO 20180 ENDIF ! BIRD: GOT TO HAVE CAGE, BUT ROD CAN'T BE AROUND TO TAKE BIRD IF (OBJ.EQ.BIRD.AND.PROP(BIRD).EQ.0) THEN SPK=26 IF (ATHAND(ROD)) GO TO 2011 SPK=27 IF (.NOT.HOLDNG(CAGE)) GO TO 2011 CALL INSERT(BIRD,CAGE) OBJCON(CAGE)=IBCLR(OBJCON(CAGE),OPENBT) GO TO 2009 ENDIF ! SWORD: IF IN ANVIL, NEEDS CROWN & MUST YANK. IF (OBJ.NE.SWORD.OR.PROP(SWORD).EQ.0) GO TO 20180 IF (IOBJ.NE.0.AND.IOBJ.NE.ANVIL) GO TO 2070 IF (VERB.NE.YANK) THEN ! WANTS THE SWORD, BUT HASN'T ESTABLISHED ROYAL BLOOD, OR HASN'T PULLED HARD ENOUGH, OR NEITHER. IF (.NOT.YES(215,0,0)) GO TO 2009 ENDIF IF (.NOT.WEARNG(CROWN)) THEN CALL PSPEAK(SWORD,2) IF (CLOSED) GO TO 93000 FIXED(SWORD)=-1 PROP(SWORD)=3 GO TO 2100 ENDIF 20180 CALL CARRY(OBJ,LOC) IF (OBJ.EQ.POLE.OR.OBJ.EQ.SKEY.OR.OBJ.EQ.SWORD.OR.((OBJ.EQ.CLOAK.OR.OBJ.EQ.RING).AND..NOT.WEARNG(OBJ))) PROP(OBJ)=0 IF (VERB.EQ.YANK.AND.OBJ.NE.SWORD) SPK=204 IF (OBJ.EQ.GLASS) PROP(GLASS)=1 GO TO 2011 ! DROP/DISCARD OBJECT. "THROW" ALSO COMES HERE FOR MOST OBJECTS. SPECIAL CASES FOR BIRD (MIGHT ATTACK SNAKE OR DRAGON) AND CAGE ! (MIGHT CONTAIN BIRD) AND VASE. DROP COINS IN VENDING MACHINE FOR EXTRA BATTERIES. 20200 IF (HOLDNG(ROD2).AND.OBJ.EQ.ROD.AND..NOT.HOLDNG(ROD)) OBJ=ROD2 IF (PLURAL(OBJ)) SPK=105 K=LIQ(BOTTLE) IF (K.EQ.OBJ) OBJ=BOTTLE IF (OBJ.NE.BOTTLE) K=LIQ(CASK) IF (OBJ.NE.BOTTLE.AND.K.EQ.OBJ) OBJ=CASK IF (.NOT.TOTING(OBJ)) GO TO 2011 IF (PREP.EQ.PREPIN) GO TO 24500 IF (OBJ.EQ.BIRD.AND.HERE(SNAKE)) THEN CALL SPEAK(RTEXT(30)) IF (CLOSED) GO TO 93000 CALL REMOVE(BIRD) CALL DESTROY(SNAKE) PROP(SNAKE)=1 !SET SNAKE PROP FOR USE BY TRAVEL OPTIONS CALL DROP(BIRD,LOC) GO TO 2100 ENDIF SPK=344 IF (VERB.EQ.LEAVE) SPK=353 IF (VERB.EQ.THROW) THEN SPK=352 IF (OBJ.EQ.28) CALL SOUND('AXE THROW') ENDIF IF (VERB.EQ.TAKE) SPK=54 IF (OBJ.EQ.POLE.AND.HOLDNG(BOAT)) THEN SPK=280 GO TO 2011 ENDIF IF (OBJ.EQ.BIRD.AND.AT(DRAGON).AND.PROP(DRAGON).EQ.0) THEN CALL SPEAK(RTEXT(154)) CALL REMOVE(BIRD) CALL DESTROY(BIRD) IF (PLACE(SNAKE).EQ.PLAC(SNAKE)) TALLY2=TALLY2+1 GO TO 2100 ENDIF IF (OBJ.EQ.BEAR.AND.AT(TROLL)) THEN SPK=163 CALL DESTROY(TROLL) CALL DESTROY(TROLL+MAXOBJ) CALL MOVE(TROLL2,PLAC(TROLL)) CALL MOVE(TROLL2+MAXOBJ,FIXD(TROLL)) CALL JUGGLE(CHASM) PROP(TROLL)=2 GO TO 20290 ENDIF IF (OBJ.EQ.VASE.AND.LOC.NE.PLAC(PILLOW)) THEN IF (ENCLSD(OBJ)) CALL REMOVE(OBJ) CALL DROP(OBJ,LOC) IF (OBJ.NE.0.AND.(OBJS(2).NE.0.OR.IOBJS(2).NE.0)) THEN CALL PSPEAK(OBJ,-1) INDENT=1; BLKLIN=.FALSE. ENDIF CALL SPEAK(RTEXT(SPK)) BLKLIN=.TRUE. PROP(VASE)=2 IF (AT(PILLOW)) PROP(VASE)=0 CALL PSPEAK(VASE,PROP(VASE)+1) IF (PROP(VASE).NE.0) FIXED(VASE)=-1 GO TO 2100 ELSE IF (WEARABLE(OBJ).OR.OBJ.EQ.POLE.OR.OBJ.EQ.BOAT) PROP(OBJ)=0 IF (WEARABLE(OBJ)) OBJCON(OBJ)=IBCLR(OBJCON(OBJ),WEARBT) IF (OBJ.EQ.POLE) PROP(BOAT)=0 ENDIF 20290 IF (ENCLSD(OBJ)) CALL REMOVE(OBJ) CALL DROP(OBJ,LOC) GO TO 2011 ! OPEN/CLOSE/LOCK/UNLOCK: NO OBJECT GIVEN. ASSUME VARIOUS THINGS IF PRESENT. 10400 SPK=28 K=0 DO I=1,MAXOBJ IF (.NOT.(HERE(I).AND.HINGED(I))) CYCLE OBJ=I K=K+1 END DO IF (K.GT.1) GO TO 10000 IF (OBJ.EQ.0) THEN IF (VERB.EQ.LOCK.OR.VERB.EQ.UNLOCK) GO TO 2011 GO TO 10000 ENDIF IF (VERB.EQ.LOCK) GO TO 24900 IF (VERB.EQ.UNLOCK) GO TO 25000 IF (VERB.EQ.SHUT) GO TO 20600 ! SPECIAL STUFF FOR OPENING CLAM/OYSTER. THE FOLLOWING CAN BE OPENED WITHOUT A KEY: CLAM/OYSTER, DOOR, PDOOR, BOTTLE, CASK, CAGE 20400 IF (.NOT.HINGED(OBJ)) GO TO 2070 SPK=253 IF (OBJ.EQ.PDOOR.AND.PROP(PDOOR).EQ.1) GO TO 2011 SPK=336 IF (AJAR(OBJ)) GO TO 2011 IF (LOCKS(OBJ).OR.IOBJ.EQ.KEYS.OR.IOBJ.EQ.SKEY) GO TO 25000 SPK=337 IF (OBJ.EQ.DOOR) SPK=111 IF (LOCKED(OBJ)) GO TO 2011 IF (OBJ.NE.CLAM.AND.OBJ.NE.OYSTER) THEN OBJCON(OBJ)=IBSET(OBJCON(OBJ),OPENBT) GO TO 2009 ENDIF ! CLAM/OYSTER. K=0 IF (OBJ.EQ.OYSTER) K=1 SPK=124+K IF (HOLDNG(OBJ)) SPK=120+K IF (.NOT.ATHAND(TRIDNT)) SPK=122+K IF (IOBJ.NE.0.AND.IOBJ.NE.TRIDNT) SPK=376+K IF (SPK.NE.124) GO TO 2011 CALL DESTROY(CLAM) CALL DROP(OYSTER,LOC) CALL DROP(PEARL,105) GO TO 2011 ! CLOSE/SHUT. THE FOLLOWING CAN BE CLOSED WITHOUT KEYS: DOOR, PDOOR, BOTTLE, CASK, CAGE 20600 IF (.NOT.HINGED(OBJ)) GO TO 2070 SPK=338 IF (.NOT.AJAR(OBJ)) GO TO 2011 IF (LOCKS(OBJ)) GO TO 24900 OBJCON(OBJ)=IBCLR(OBJCON(OBJ),OPENBT) GO TO 2009 ! LIGHT LAMP 20700 IF (.NOT.ATHAND(LAMP)) GO TO 2011 SPK=184 IF (LIMIT.LT.0) GO TO 2011 SPK=321 IF (PROP(LAMP).EQ.1) GO TO 2011 PROP(LAMP)=1 K=39 IF (LOC.EQ.200) K=108 CALL SPEAK(RTEXT(K)) IF (WASDARK) THEN CALL COLOR(LOC) GO TO 2000 ENDIF GO TO 2100 ! LAMP OFF 20800 IF (.NOT.ATHAND(LAMP)) GO TO 2011 SPK=322 IF (PROP(LAMP).EQ.0) GO TO 2011 PROP(LAMP)=0 CALL SPEAK(RTEXT(40)) IF (DARK()) THEN CALL COLOR(LOC) CALL SPEAK(RTEXT(16)) ENDIF GO TO 2100 ! WAVE. NO EFFECT UNLESS WAVING ROD AT FISSURE. 20900 IF ((.NOT.HOLDNG(OBJ)).AND.(OBJ.NE.ROD.OR..NOT.HOLDNG(ROD2))) SPK=29 IF (OBJ.NE.ROD.OR..NOT.AT(FISSUR).OR..NOT.HOLDNG(OBJ).OR.CLOSNG) GO TO 2011 IF (IOBJ.NE.0.AND.IOBJ.NE.FISSUR) GO TO 2011 PROP(FISSUR)=1-PROP(FISSUR) CALL PSPEAK(FISSUR,2-PROP(FISSUR)) IF (CHASE.EQ.0.OR.PROP(FISSUR).NE.0) GO TO 2100 ! DEMISE OF THE WUMPUS. CHAMP MUST HAVE JUST CROSSED BRIDGE. IF ((LOC.EQ.17.AND.OLDLOC.EQ.27).OR.(LOC.EQ.27.AND.OLDLOC.EQ.17)) THEN CALL SPEAK(RTEXT(244)) CHASE=0 CALL DROP(RING,209) CALL MOVE(WUMPUS,209) PROP(WUMPUS)=6 OBJCON(WUMPUS)=IBSET(OBJCON(WUMPUS),DEADBT) IF (PLACE(AXE).EQ.PLAC(WUMPUS)) THEN FIXED(AXE)=0 PROP(AXE)=0 ENDIF ENDIF GO TO 2100 ! ATTACK/THROW. ASSUME TARGET IF UNAMBIGUOUS. ATTACKABLE OBJECTS FALL INTO TWO CATEGORIES: ! ENEMIES (SNAKE, DWARF, ETC.) AND OTHERS (BIRD, CLAM). AMBIGUOUS IF TWO ENEMIES, OR TWO OTHERS. ! KILL OBJ WITH IOBJ. 21200 DO DWARFN=1,DWFMAX-1 IF (DLOC(DWARFN).EQ.LOC.AND.DFLAG.GE.2) GO TO 21220 END DO DWARFN=0 21220 IF (OBJ.EQ.0) THEN IF (DWARFN.NE.0) OBJ=DWARF IF (HERE(SNAKE)) OBJ=OBJ*MAXOBJ+SNAKE IF (AT(DRAGON).AND.PROP(DRAGON).EQ.0) OBJ=OBJ*MAXOBJ+DRAGON IF (AT(TROLL)) OBJ=OBJ*MAXOBJ+TROLL IF (HERE(GNOME)) OBJ=OBJ*MAXOBJ+GNOME IF (HERE(BEAR).AND.PROP(BEAR).EQ.0) OBJ=OBJ*MAXOBJ+BEAR IF (HERE(WUMPUS).AND.PROP(WUMPUS).EQ.0) OBJ=OBJ*MAXOBJ+WUMPUS IF (OBJ.GT.MAXOBJ) GO TO 10000 IF (OBJ.EQ.0) THEN IF (HERE(BIRD).AND.VERB.NE.THROW) OBJ=BIRD !CAN'T ATTACK BIRD BY THROWING AXE. IF (HERE(CLAM).OR.HERE(OYSTER)) OBJ=MAXOBJ*OBJ+CLAM !OYSTER BOTH TREATED AS CLAM FOR INTRANSITIVE CASE; NO HARM DONE. IF (OBJ.GT.MAXOBJ) GO TO 10000 ENDIF ENDIF IF (OBJ.EQ.BIRD) THEN SPK=137 IF (CLOSED) GO TO 2011 CALL DESTROY(BIRD) PROP(BIRD)=0 IF (PLACE(SNAKE).EQ.PLAC(SNAKE)) TALLY2=TALLY2+1 SPK=45 ENDIF IF (OBJ.EQ.DWARF) GO TO 21270 IF (OBJ.EQ.0) SPK=44 IF (OBJ.EQ.CLAM.OR.OBJ.EQ.OYSTER) SPK=150 IF (AT(DOG).AND.PROP(DOG).EQ.1) SPK=291 IF (OBJ.EQ.SNAKE) SPK=46 IF (OBJ.EQ.DRAGON.OR.(OBJ.EQ.WUMPUS.AND.PROP(WUMPUS).EQ.6)) SPK=167 IF (OBJ.EQ.TROLL) SPK=157 IF (OBJ.EQ.BEAR) SPK=165+(PROP(BEAR)+1)/2 IF (OBJ.EQ.GNOME) SPK=320 IF (IOBJ.EQ.AXE .AND. VERB.NE.THROW .AND. (OBJ.EQ.DOG.OR.OBJ.EQ.WUMPUS.OR.OBJ.EQ.DRAGON.OR.OBJ.EQ.TROLL) ) THEN IOBJ=OBJ OBJ=IOBJS(IOBX) SPK=110 GO TO 21700 ENDIF IF (IOBJ.NE.0.AND.IOBJ.NE.AXE) GO TO 2070 IF (OBJ.NE.DRAGON.OR.PROP(DRAGON).NE.0) THEN IF (OBJ.NE.TROLL.AND.SPK.EQ.158) SPK=110 GO TO 2011 ENDIF ! DRAGON. IF ADVENTURER INSISTS ON ATTACKING, WIN! SET PROP TO DEAD, MOVE DRAGON (STILL FIXED), RUG (NOT FIXED) AND ADVENTURER ! TO CENTRAL LOC. DO NULL MOTION TO GET NEW DESCRIPTION. THERE IS SOME PAIN HERE TO FORCE GETWDS TO DO THE RIGHT THING. CALL SPEAK(RTEXT(49)) CALL GETLIN WDX=0 CALL CLRLIN IF (TXT(1).EQ.'N'.OR.TXT(1).EQ.'NO') THEN WORDS(1)=-2 RDFLAG=.TRUE. GO TO 2600 ENDIF CALL PSPEAK(DRAGON,1) OBJCON(DRAGON)=IBSET(OBJCON(DRAGON),DEADBT) PROP(DRAGON)=2 PROP(RUG)=0 K=(PLAC(DRAGON)+FIXD(DRAGON))/2 CALL MOVE(DRAGON+MAXOBJ,-1) CALL MOVE(RUG+MAXOBJ,0) CALL MOVE(DRAGON,K) CALL MOVE(RUG,K) DO OBJ=1,MAXOBJ IF (PLACE(OBJ).EQ.PLAC(DRAGON).OR.PLACE(OBJ).EQ.FIXD(DRAGON)) CALL MOVE(OBJ,K) END DO WORDS(1)=0 LOC=K NEWLOC=K GO TO 2 ! ATTACKING A DWARF. IF USING SOMETHING OTHER THAN AXE OR SWORD, GOODBYE CHARLIE. IF USING NOTHING, DON'T PERMIT. ! IF USING AXE OR SWORD, THE FOLLOWING ODDS PREVAIL (THE END OF LINE FIGURE IS THE CULULATIVE PROBABILITY OF THE EVENT): ! .25 - KILLS DWARF (.25) ! .75 - MISSES ! .25 - GETS KNIFE IN RIBS. DIES. (.1875) ! .75 - CAN'T MAKE A CLEAN THRUST ! .36 - STANDOFF (.2) ! .64 - DWARF SLASHES ! .61 - DWARF MISSES! (.22) ! .39 - DWARF KILLS (.14) ! HAS 1/3 CHANCE OF GETTING NAILED, 1/4 CHANCE OF NAILING DWARF. ALL BY WAY OF ENCOURAGING THROWING THE AXE. 21270 IF (OBJ.EQ.DWARF.AND.CLOSED) GO TO 93000 SPK=49 IF (IOBJ.EQ.0) GO TO 2011 SPK=355 IF (IOBJ.EQ.AXE.OR.IOBJ.EQ.SWORD) THEN CALL SOUND('AXE THROW') IF (PCT(25)) GO TO 21753 IF (PCT(75)) THEN CALL SPEAK(RTEXT(354)) IF (PCT(36)) GO TO 2100 CALL SPEAK(RTEXT(356)) SPK=52 IF (PCT(61)) GO TO 2011 SPK=53 ENDIF ENDIF ! ADVENTURER IS GONZO. CALL SPEAK(RTEXT(SPK)) OLDLC2=LOC GO TO 94100 ! POUR. IF NO OBJECT, ASSUME LIQ IN CONTAINER IF HOLDING ONLY ONE. SPECIAL TESTS FOR POURING WATER, OIL ON PLANT OR RUSTY DOOR. 11300 IF (.NOT.HOLDNG(BOTTLE).AND..NOT.HOLDNG(CASK)) GO TO 10000 K=LIQ(BOTTLE) KK=LIQ(CASK) IF (HOLDNG(BOTTLE).AND.K.NE.0.AND.HOLDNG(CASK).AND.KK.NE.0) GO TO 10000 IF (KK.NE.0.AND.HOLDNG(CASK)) OBJ=CASK IF (K.NE.0.AND.HOLDNG(BOTTLE)) OBJ=BOTTLE IF (OBJ.EQ.0) GO TO 10000 ! POUR OBJ FROM IOBJ. 21300 SPK=78 IF (OBJ.EQ.BOTTLE.OR.OBJ.EQ.CASK) THEN IOBJ=OBJ OBJ=LIQ(IOBJ) SPK=316 IF (OBJ.EQ.0) GO TO 2011 ELSEIF (OBJ.EQ.SAFE.OR.OBJ.EQ.CHEST) THEN SPK=358 GO TO 2011 ELSE IF (OBJ.LT.WATER.OR.OBJ.GT.WINE+1) GO TO 2011 SPK=29 IF (.NOT.HOLDNG(BOTTLE).AND..NOT.HOLDNG(CASK)) GO TO 2011 IF (HOLDNG(BOTTLE).AND.LIQ(BOTTLE).EQ.OBJ) IOBJ=BOTTLE IF (HOLDNG(CASK).AND.LIQ(CASK).EQ.OBJ) IOBJ=CASK IF (IOBJ.EQ.0) GO TO 2011 ENDIF SPK=335 IF (.NOT.AJAR(IOBJ)) GO TO 2011 IF (IOBJ.EQ.CASK) OBJ=OBJ+1 PROP(IOBJ)=1 CALL REMOVE(OBJ) PLACE(OBJ)=0 SPK=77 IF (IOBJ.EQ.CASK) THEN OBJ=OBJ-1 SPK=104 ENDIF IF (.NOT. (AT(PLANT).OR.AT(DOOR).OR.AT(SWORD)) .OR. AT(SWORD).AND.PROP(SWORD).EQ.0) GO TO 2011 IF (.NOT.AT(DOOR)) THEN IF (AT(SWORD)) GO TO 21350 SPK=112 IF (OBJ.NE.WATER) GO TO 2011 CALL PSPEAK(PLANT,PROP(PLANT)+1) PROP(PLANT)=MOD(PROP(PLANT)+2,6) PROP(PLANT2)=PROP(PLANT)/2 NEWLOC=LOC GO TO 2 ENDIF PROP(DOOR)=0 IF (OBJ.EQ.OIL) THEN PROP(DOOR)=1 OBJCON(DOOR)=IBCLR(OBJCON(DOOR),LOCKBT) OBJCON(DOOR)=IBSET(OBJCON(DOOR),OPENBT) ENDIF SPK=113+PROP(DOOR) GO TO 2011 ! IF SWORD IS ALREADY OILY, DON'T ALLOW CLEANING IT. NO SOAP. 21350 IF (PROP(SWORD).NE.5) THEN PROP(SWORD)=4 IF (OBJ.EQ.OIL) THEN PROP(SWORD)=5 FIXED(SWORD)=-1 ENDIF ENDIF SPK=206+PROP(SWORD)-4 GO TO 2011 ! EAT. ASSUME EDIBLE IF PRESENT, ELSE ASK WHAT. FOOD/MUSHROOMS/CAKES OK, SOME THINGS LOSE APPETITE, ! REST ARE RIDICULOUS. IF MORE THAN ONE EDIBLE OR NONE, 'EAT' IS AMBIGUOUS WITHOUT AN EXPLICIT OBJECT. 11400 K=0 DO I=1,MAXOBJ IF (.NOT.(HERE(I).AND.EDIBLE(I))) CYCLE K=K+1 KK=I END DO IF (K.NE.1) GO TO 10000 OBJ=KK IF (OBJ.NE.FOOD.AND.OBJ.NE.HONEY) GO TO 21400 11420 IF (OBJ.EQ.HONEY)TALLY2=TALLY2+1 CALL DESTROY(OBJ) SPK=72 GO TO 2011 ! IF ATE THE RIGHT THING AND IS IN THE RIGHT PLACE, MOVE TO THE OTHER PLACE. OTHERWISE, NARKY MESSAGE. 21400 IF (OBJ.EQ.FOOD.OR.OBJ.EQ.HONEY) GO TO 11420 IF (OBJ.EQ.BIRD.OR.OBJ.EQ.SNAKE.OR.OBJ.EQ.CLAM.OR.OBJ.EQ.OYSTER.OR.OBJ.EQ.FLOWER) SPK=301 IF (OBJ.EQ.DWARF.OR.OBJ.EQ.DRAGON.OR.OBJ.EQ.TROLL.OR.OBJ.EQ.DOG.OR.OBJ.EQ.WUMPUS.OR.OBJ.EQ.BEAR.OR.OBJ.EQ.GNOME) SPK=250 IF (OBJ.NE.MUSHRM.AND.OBJ.NE.CAKES) GO TO 2011 K=OBJ-MUSHRM LL=229+K K=159-K KK=SKEY IF (OBJ.EQ.MUSHRM) KK=TDOOR IF (OBJ.EQ.MUSHRM.AND.LOC.NE.158) TALLY2=TALLY2+1 CALL DESTROY(OBJ) SPK=228 IF (.NOT. (HERE(KK).OR.FIXED(KK).EQ.LOC) ) GO TO 2011 CALL SPEAK(RTEXT(LL)) ! IF HASN'T TAKEN TINY KEY OFF SHELF, DON'T LET ADVENTURER GET IT FOR FREE! DO OBJ=1,MAXOBJ IF (OBJ.EQ.SKEY.AND.PROP(SKEY).EQ.1) CYCLE IF (PLACE(OBJ).EQ.PLAC(KK).AND.FIXED(OBJ).EQ.0) CALL MOVE(OBJ,K) END DO IF (LOC.EQ.PLAC(SKEY).AND.PLACE(SKEY).EQ.PLAC(SKEY)) TALLY2=TALLY2+1 LOC=K NEWLOC=K GO TO 2 ! DRINK. IF NO OBJECT, ASSUME WATER OR WINE AND LOOK FOR THEM HERE. IF POTABLE IS IN BOTTLE OR CASK, DRINK IT. IF NOT, SEE IF ! SOMETHING DRINKABLE NEARBY (STREAM, LAKE, WINE FOUNTAIN, ETC.) AND DRINK THAT. IF HAS STUFF IN BOTH CONTAINERS, ASK WHICH. 11500 LL=LIQLOC() IF (.NOT.ATHAND(BOTTLE).AND..NOT.ATHAND(CASK).AND.LL.NE.WINE.AND.LL.NE.WATER) GO TO 10000 K=LIQ(BOTTLE) KK=LIQ(CASK) IF (ATHAND(BOTTLE).AND.K.NE.0) THEN IF (ATHAND(CASK).AND.KK.NE.0.AND.KK.NE.K) GO TO 10000 OBJ=K IOBJ=BOTTLE ELSEIF (ATHAND(CASK).AND.KK.NE.0) THEN OBJ=KK IOBJ=CASK GO TO 21560 ELSE IF (LL.EQ.0) GO TO 10000 OBJ=LL IOBJ=-1 ENDIF GO TO 21560 21500 IF (OBJ.EQ.0.AND.(IOBJ.EQ.BOTTLE.OR.IOBJ.EQ.CASK)) OBJ=LIQ(IOBJ) SPK=110 IF (OBJ.EQ.OIL) SPK=301 IF (OBJ.NE.WATER.AND.OBJ.NE.WINE) GO TO 2011 IF (IOBJ.NE.0) GO TO 21560 IF (OBJ.EQ.LIQLOC())IOBJ=-1 IF (ATHAND(CASK).AND.OBJ.EQ.LIQ(CASK))IOBJ=CASK IF (ATHAND(BOTTLE).AND.OBJ.EQ.LIQ(BOTTLE))IOBJ=BOTTLE 21560 SPK=73 IF (IOBJ.NE.-1) THEN IF (IOBJ.EQ.CASK) OBJ=OBJ+1 CALL REMOVE(OBJ) PLACE(OBJ)=0 PROP(IOBJ)=1 SPK=74 IF (IOBJ.EQ.CASK) SPK=299 ENDIF IF (OBJ.EQ.WATER.OR.OBJ.EQ.WATER+1) GO TO 2011 ! TOO MUCH WINE. ADVENTURER WANDERS AROUND AWHILE, THEN WAKES UP SOMEWHERE OR OTHER, HAVING DROPPED MOST OF THE STUFF. CALL SPEAK(RTEXT(300)) IF (PROP(LAMP).EQ.1) LIMIT=LIMIT-RANZ(LIMIT)/2 IF (LIMIT.LT.10)LIMIT=25 K=0 IF (PCT(15))K=49 IF (K.EQ.0.AND.PCT(15)) K=53 IF (K.EQ.0.AND.PCT(25)) K=132 IF (K.EQ.0)K=175 IF (OUTSID(LOC))K=5 IF (K.EQ.LOC) GO TO 2100 IF (HOLDNG(AXE)) CALL MOVE(AXE,K) IF (HOLDNG(LAMP)) CALL MOVE(LAMP,K) DO J=1,MAXOBJ IF (WEARNG(J)) OBJCON(J)=IBCLR(OBJCON(J),WEARBT) IF (HOLDNG(J)) CALL DROP(J,LOC) END DO LOC=K NEWLOC=K GO TO 2 ! RUB. YIELDS VARIOUS SNIDE REMARKS. 21600 IF (OBJ.NE.LAMP) SPK=76 GO TO 2011 ! THROW OBJ AT IOBJ; SAME AS DROP UNLESS AXE; THEN SAME AS ATTACK BUT IGNORE BIRD AND IF DWARVES PRESENT ONE MIGHT BE KILLED. ! AXE SPECIAL FOR DRAGON, BEAR, DOG, WUMPUS AND TROLL. TREASURES SPECIAL FOR TROLL. IF THROWING FOOD AT SOMEONE WHO MIGHT BE ! HUNGRY, FEED THEM. 21700 IF (PREP.EQ.PREPDN) GO TO 24200 IF (HOLDNG(ROD2).AND.OBJ.EQ.ROD.AND..NOT.HOLDNG(ROD)) OBJ=ROD2 IF (.NOT.HOLDNG(OBJ)) GO TO 2011 IF (OBJ.EQ.BOAT.OR.OBJ.EQ.BEAR) GO TO 2070 DWARFN=0 IF (IOBJ.NE.0) GO TO 21750 ! NO INDIRECT OBJ SPECIFIED. IF A DWARF IS PRESENT ASSUME IT IS THE IOBJ. IF NOT, LOOK FOR ANY OTHER LIVING THING. ! IF NO LIVING THINGS PRESENT, TREAT 'THROW' AS 'DROP'. DO DWARFN=1,DWFMAX-1 IF (DLOC(DWARFN).EQ.LOC.AND.DFLAG.GE.2) GO TO 21718 END DO DWARFN=0 ! NO DWARVES PRESENT; FIGURE OUT PLAUSIBLE OBJECT. K=0 DO I=1,MAXOBJ IF (.NOT. (AT(I).AND.LIVING(I)) ) CYCLE IOBJ=I K=K+1 END DO IF (K.EQ.0) GO TO 20200 ! IT IS A BEASTIE OF SOME SORT. IS THERE MORE THAN ONE? DON'T KILL THE BIRD BY DEFAULT. IF (K.NE.1) THEN CALL SPEAK(RTEXT(43)) GO TO 2600 ENDIF 21718 IF (IOBJ.EQ.BIRD) GO TO 20200 IF (TREASURE(OBJ).AND.AT(TROLL)) IOBJ=TROLL 21750 IF (TREASURE(OBJ).AND.IOBJ.EQ.TROLL) GO TO 21790 IF (OBJ.EQ.SWORD.OR.OBJ.EQ.BOTTLE) GO TO 22800 IF (DWARFN.NE.0) IOBJ=DWARF IF (OBJ.EQ.FLOWER.AND.IOBJ.EQ.HIVE) IOBJ=BEES IF (EDIBLE(OBJ).AND.LIVING(IOBJ)) GO TO 22100 IF (OBJ.NE.AXE) GO TO 20200 SPK=152 IF (IOBJ.EQ.DRAGON.AND.PROP(DRAGON).EQ.0) GO TO 21755 SPK=158 IF (IOBJ.EQ.TROLL) GO TO 21755 IF (IOBJ.NE.DWARF) GO TO 21760 SPK=48 IF (RANZ(4).EQ.0) GO TO 21755 IF (DWARFN.EQ.0) THEN DO DWARFN=1,DWFMAX-1 IF (DLOC(DWARFN).EQ.LOC.AND.DFLAG.GE.2) EXIT END DO ENDIF ! 'ATTACK' WITH AXE OR SWORD LINKS IN HERE. 21753 DSEEN(DWARFN)=.FALSE. DLOC(DWARFN)=0 SPK=47 DKILL=DKILL+1 IF (DKILL.EQ.1) SPK=149 21755 CALL SPEAK(RTEXT(SPK)) CALL DROP(AXE,LOC) NEWLOC=LOC GO TO 2 ! THIS'LL TEACH THEM TO THROW THE AXE AT THE BEAR! 21760 IF (IOBJ.EQ.BEAR.AND.PROP(BEAR).EQ.0) THEN SPK=164 CALL DROP(AXE,LOC) FIXED(AXE)=-1 PROP(AXE)=1 CALL JUGGLE(BEAR) GO TO 2011 ENDIF ! OR THE WUMPUS! IF (IOBJ.EQ.WUMPUS.AND.PROP(WUMPUS).NE.6) THEN IF (PROP(WUMPUS).EQ.6) GO TO 20200 SPK=245 PROP(AXE)=2 IF (PROP(WUMPUS).EQ.0) GO TO 21780 SPK=243 CALL DESTROY(AXE) GO TO 2011 ENDIF ! OR THE NICE DOGGIE! IF (IOBJ.NE.DOG.OR.PROP(DOG).EQ.1) GO TO 21790 SPK=248 PROP(AXE)=3 21780 CALL DROP(AXE,LOC) FIXED(AXE)=-1 CALL JUGGLE(IOBJ) GO TO 2011 ! SNARF A TREASURE FOR THE TROLL. 21790 IF (IOBJ.EQ.TROLL) THEN PREP=0 IF (OBJ.EQ.CASK.AND.LIQ(CASK).NE.WINE) GO TO 20200 SPK=159 CALL DROP(OBJ,0) IF (OBJ.EQ.CASK) PLACE(WINE+1)=0 CALL MOVE(TROLL,0) CALL MOVE(TROLL+MAXOBJ,0) CALL DROP(TROLL2,PLAC(TROLL)) CALL DROP(TROLL2+MAXOBJ,FIXD(TROLL)) CALL JUGGLE(CHASM) GO TO 2011 ENDIF ! THROWING AXE AT NONE OF THE ABOVE. ASSUME 'ATTACK'. OBJ=IOBJ IOBJ=OBJS(OBJX) GO TO 21200 ! QUIT. INTRANSITIVE ONLY. VERIFY INTENT AND EXIT IF THAT'S WHAT ADVENTURER WANTS. 11800 GAVEUP=YES(22,54,54) IF (GAVEUP) GO TO 95000 GO TO 2100 ! FIND. MIGHT BE CARRYING IT, OR IT MIGHT BE HERE. ELSE GIVE CAVEAT. 21900 IF (AT(OBJ).OR.(LIQ(BOTTLE).EQ.OBJ.AND.AT(BOTTLE)).OR.K.EQ.LIQLOC()) SPK=94 DO I=1,DWFMAX-1 IF (DLOC(I).EQ.LOC.AND.DFLAG.GE.2.AND.OBJ.EQ.DWARF) SPK=94 END DO IF (CLOSED) SPK=138 IF (ATHAND(OBJ)) SPK=24 GO TO 2011 ! INVENTORY. IF OBJECT, TREAT SAME AS FIND, ELSE REPORT ON CURRENT BURDEN. THERE ARE SOME FUNNY CASES--THE WEARABLE THINGS AND ! BOAT AND BEAR, WHICH AREN'T REALLY CARRIED. LIST OUTER-LEVEL CONTAINERS AND CONTENTS, IF CONTAINER IS OPEN OR TRANSPARENT. 12000 SPK=98 DO I=1,MAXOBJ IF (I.EQ.BEAR.OR.I.EQ.BOAT.OR..NOT.HOLDNG(I)) CYCLE IF (WEARNG(I)) CYCLE IF (SPK.EQ.98) CALL SPEAK(RTEXT(99)) BLKLIN=.FALSE. CALL PSPEAK(I,-1) SPK=0 IF (I.NE.BOAT) CALL LOOKIN(I) END DO ! TELL WHAT IS WORN. K=0 DO I=1,MAXOBJ IF (.NOT.WEARNG(I)) CYCLE IF (K.EQ.0) WRITE(*,"(' You are wearing:')") INDENT=1 CALL PSPEAK(I,-1) K=-1 END DO IF (HOLDNG(BOAT)) THEN CALL SPEAK(RTEXT(221)) CALL LOOKIN(BOAT) ENDIF IF (HOLDNG(BEAR)) SPK=141 GO TO 2011 ! FEED. IF BIRD, NO SEED. SNAKE, DRAGON, TROLL: QUIP. IF DWARF, MAKE HIM MAD. BEAR, SPECIAL. 22100 IF (IOBJ.NE.0) THEN IF (LIVING(IOBJ)) GO TO 22120 ENDIF SPK=100 IF (OBJ.EQ.BIRD) GO TO 2011 IF (.NOT.LIVING(OBJ)) GO TO 2070 ! SEE IF THERE IS ANYTHING EDIBLE AROUND HERE. KK=0 K=0 DO I=1,MAXOBJ IF (.NOT.HERE(I).OR..NOT.EDIBLE(I)) CYCLE K=K+1 KK=I END DO IOBJ=OBJ OBJ=KK IF (K.EQ.1.OR.DEAD(IOBJ)) GO TO 22120 ZAPP=OTXT(OBJX); ZAPP(LEN_TRIM(ZAPP)+1:)='?' CALL LOWER_CASE(ZAPP) WRITE(*,"(/' What do you want to feed the ',A)") ZAPP OBJS(1)=0 OBJX=0 GO TO 2600 ! FEED OBJ TO IOBJ. 22120 IF (IOBJ.EQ.SNAKE.OR.IOBJ.EQ.DRAGON.OR.IOBJ.EQ.TROLL) THEN SPK=102 IF (IOBJ.EQ.DRAGON.AND.PROP(DRAGON).NE.0) SPK=NOWAY() IF (IOBJ.EQ.TROLL) SPK=182 IF (IOBJ.EQ.SNAKE.AND.CLOSED.AND.OBJ.EQ.BIRD) THEN SPK=101 CALL DESTROY(BIRD) PROP(BIRD)=0 TALLY2=TALLY2+1 ENDIF GO TO 2011 ENDIF ! FEED DWARF? IF (IOBJ.EQ.DWARF) THEN SPK=103 DFLAG=DFLAG+1 GO TO 2011 ENDIF ! FEED BEAR? SPK=102 IF (IOBJ.EQ.BEAR) THEN IF (PROP(BEAR).EQ.3) SPK=NOWAY() IF (PROP(BEAR).EQ.1.OR.PROP(BEAR).EQ.2) SPK=264 IF (OBJ.EQ.FOOD) SPK=278 IF (OBJ.EQ.HONEY) THEN PROP(BEAR)=1 FIXED(AXE)=0 PROP(AXE)=0 SPK=168 CALL DESTROY(HONEY) ENDIF GO TO 2011 ENDIF ! FEED DOG? IF (IOBJ.EQ.DOG) THEN IF (PROP(DOG).EQ.1) SPK=291 IF (OBJ.EQ.FOOD.AND.PROP(DOG).NE.1) THEN SPK=249 CALL DESTROY(FOOD) ENDIF GO TO 2011 ENDIF ! FEED WUMPUS? IF (IOBJ.EQ.WUMPUS) THEN IF (PROP(WUMPUS).EQ.6) SPK=326 IF (PROP(WUMPUS).EQ.0) SPK=327 IF (OBJ.EQ.FOOD) SPK=240 GO TO 2011 ENDIF ! FEED BEES? IF (IOBJ.NE.BEES.OR.OBJ.NE.FLOWER) GO TO 2070 IF (ENCLSD(FLOWER)) CALL REMOVE(FLOWER) CALL DROP(FLOWER,LOC) FIXED(FLOWER)=-1 PROP(FLOWER)=1 CALL DROP(HONEY,LOC) CALL JUGGLE(HONEY) SPK=267 PROP(HIVE)=1 GO TO 2011 ! FILL. BOTTLE/CASK MUST BE EMPTY, AND SOME LIQUID AVAILABLE. 12200 IF (HERE(BOTTLE).EQV.HERE(CASK)) GO TO 10000 !MUST BE ONLY ONE OR THE OTHER IF (PROP(CASK).EQ.1.AND.HERE(CASK)) OBJ=CASK IF (PROP(BOTTLE).EQ.1.AND.HERE(BOTTLE)) OBJ=BOTTLE IF (OBJ.EQ.0) GO TO 10000 ! FILL OBJ WITH IOBJ 22200 SPK=313 IF (.NOT.VESSEL(OBJ)) GO TO 2011 IF (IOBJ.EQ.0) IOBJ=LIQLOC() IF (OBJ.EQ.BOTTLE.OR.OBJ.EQ.CASK) THEN K=0 IF (OBJ.EQ.CASK) K=1 SPK=0 IF (IOBJ.EQ.0) SPK=304+K IF (LIQ(OBJ).NE.0) SPK=302+K IF (SPK.EQ.0) THEN SPK=306+K IF (IOBJ.EQ.OIL) SPK=308+K IF (IOBJ.EQ.WINE) SPK=310+K PROP(OBJ)=MOD(LOCCON(LOC),8)/2*2 PLACE(IOBJ+K)=-1 CALL INSERT(IOBJ+K,OBJ) ENDIF GO TO 2011 ENDIF ! VASE IF (OBJ.EQ.VASE) THEN SPK=144 IF (IOBJ.EQ.0.OR..NOT.HOLDNG(VASE)) GO TO 2011 CALL SPEAK(RTEXT(145)) !DELICATE VASE CRACKS PROP(VASE)=2 FIXED(VASE)=-1 GO TO 20290 ENDIF ! GRAIL OR OTHER SPK=339 IF (OBJ.EQ.GRAIL) SPK=298 GO TO 2011 ! BLAST. NO EFFECT UNLESS YOU'VE GOT DYNAMITE, WHICH IS A NEAT TRICK! 12300 IF (CLOSED) THEN BONUS=135 IF (PLACE(ROD2).EQ.212.AND.LOC.EQ.116) BONUS=133 IF (PLACE(ROD2).EQ.116.AND.LOC.NE.116) BONUS=134 CALL SPEAK(RTEXT(BONUS)) GO TO 95000 ENDIF GO TO 2011 ! SCORE 12400 SCORNG=.TRUE. CALL RATING(SCORE,BONUS,GAVEUP,SCORNG,CLOSNG,CLOSED) SCORNG=.FALSE. WRITE(*,"(/' If you were to quit now, you would score ',I0,' out of ',I0,' using ',I0,' turns.')") SCORE,MXSCOR,TURNS GO TO 2100 ! FEE FIE FOE FOO (AND FUM). ADVANCE TO NEXT STATE IF GIVEN IN PROPER ORDER. LOOK UP WD1 IN SECTION 3 OF VOCAB TO DETERMINE ! WHICH ONE WE'VE GOT. LAST WORD ZIPS THE EGGS BACK TO THE GIANT ROOM. 12500 K=VOCABX(VTXT(VRBX),4) SPK=42 IF (FOOBAR.NE.1-K) THEN IF (FOOBAR.NE.0) SPK=151 GO TO 2011 ENDIF FOOBAR=K IF (K.NE.4) GO TO 2009 FOOBAR=0 IF (PLACE(EGGS).EQ.PLAC(EGGS).OR.(TOTING(EGGS).AND.LOC.EQ.PLAC(EGGS))) GO TO 2011 ! BRING BACK TROLL IF WE STEAL THE EGGS BACK FROM HIM BEFORE CROSSING. IF (PLACE(EGGS).EQ.0.AND.PLACE(TROLL).EQ.0.AND.PROP(TROLL).EQ.0) PROP(TROLL)=1 K=2 IF (HERE(EGGS))K=1 IF (LOC.EQ.PLAC(EGGS))K=0 CALL MOVE(EGGS,PLAC(EGGS)) CALL PSPEAK(EGGS,K) GO TO 2100 ! BRIEF/UNBRIEF. SUPPRESS LONG DESCRIPTIONS AFTER FIRST TIME. 12600 DETAIL=3 TERSE=.FALSE. IF (ABBNUM.NE.10000) THEN SPK=156 ABBNUM=10000 ELSE ABBNUM=5 SPK=374 ENDIF GO TO 2011 22600 IF (OBJ.NE.0) THEN IF (LIVING(OBJ).AND.IOBJ.NE.0) GO TO 2011 ENDIF GO TO 2060 ! READ. MAGAZINES IN DWARVISH, MESSAGE WE'VE SEEN, AND . . . OYSTER? 22700 IF (BLIND()) GO TO 2011 IF (OBJ.NE.0.AND.IOBJ.NE.0) GO TO 2060 SPK=CONFUZ() IF (OBJ.EQ.0) OBJ=IOBJ IF (OBJ.EQ.BOOK.OR.OBJ.EQ.BOOK2) SPK=142 IF (OBJ.EQ.BILLBD) SPK=361 IF (OBJ.EQ.CARVNG) SPK=372 IF (OBJ.EQ.MAGZIN) SPK=190 IF (OBJ.EQ.MESSAG) SPK=191 IF (OBJ.EQ.OYSTER.AND.HINTED(2).AND.HOLDNG(OYSTER)) SPK=194 IF (OBJ.EQ.POSTER) SPK=370 IF (OBJ.EQ.TABLET) SPK=196 IF (OBJ.NE.OYSTER.OR.HINTED(2).OR..NOT.HOLDNG(OYSTER).OR..NOT.CLOSED) GO TO 2011 HINTED(2)=YES(192,193,54) GO TO 2100 ! BREAK. WORKS FOR MIRROR IN REPOSITORY AND, OF COURSE, THE VASE AND BOTTLE. ALSO, THE SWORD IS MORE BRITTLE THAN IT APPEARS. 22800 IF (OBJ.EQ.MIRROR) SPK=148 IF (OBJ.NE.VASE.OR.PROP(VASE).NE.0) THEN IF (OBJ.EQ.BOTTLE.AND.PROP(BOTTLE).NE.3) GO TO 22840 IF (OBJ.EQ.SWORD) GO TO 22860 IF (OBJ.NE.MIRROR.OR..NOT.CLOSED) GO TO 2011 CALL SPEAK(RTEXT(197)) GO TO 93000 ENDIF SPK=198 PROP(VASE)=2 22830 IF (ENCLSD(OBJ)) CALL REMOVE(OBJ) IF (HOLDNG(OBJ)) CALL DROP(OBJ,LOC) FIXED(OBJ)=-1 GO TO 2011 22840 SPK=231 K=LIQ(BOTTLE) PROP(BOTTLE)=3 IF (K.EQ.0) GO TO 22830 CALL REMOVE(K) PLACE(K)=0 GO TO 22830 ! BETTER NOT SLING THE SWORD AROUND! 22860 SPK=29 IF (.NOT.HOLDNG(SWORD)) GO TO 2011 SPK=279 PROP(SWORD)=4 GO TO 22830 ! DISTURB THE DWARVES OR THE WUMPUS 22900 IF (AT(WUMPUS)) THEN CHASE=1 PROP(WUMPUS)=1 SPK=276 GO TO 2011 ENDIF IF (AT(DOG).AND.PROP(DOG).EQ.1) SPK=291 IF (OBJ.NE.DWARF.OR..NOT.CLOSED) GO TO 2011 CALL SPEAK(RTEXT(199)) GO TO 93000 13000 CALL FILEOPEN(FILNAM) IF (FILNAM.EQ.'') THEN WRITE(*,"('SAVE cancelled'/)") ELSE LEN_FILNAM=LEN_TRIM(FILNAM) CALL UPPER_CASE(FILNAM) IF (INDEX(FILNAM,'.SAV').EQ.0) FILNAM(LEN_FILNAM+1:)='.SAV' LASTSAVE=FILNAM OPEN (UNIT=16,FILE=FILNAM,STATUS='UNKNOWN',FORM='UNFORMATTED',ACCESS='SEQUENTIAL',ERR=13000) WRITE(16,IOSTAT=I) & ISWIZ,BLKLIN,LOCCON,OBJCON,NUMDIE,MAXDIE,TURNS,KILLED,DWARF,KNIFE,KNFLOC,DFLAG,DSEEN,DLOC,ODLOC,DWFMAX,HOLDER,& HLINK,BOTTLE,CASK,WATER,OIL,WINE,LIQTYP,LOC,OLDLOC,OLDLC2,NEWLOC,MAXLOC,LTEXT,STEXT,KEY,ABB,LOCSIZ,PLAC,FIXD,& WEIGHT,PROP,POINTS,ATLOC,LINK,PLACE,FIXED,MAXOBJ,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 CLOSE(16,STATUS='KEEP') IF (I.NE.0) THEN CALL GERROR(FILNAM) WRITE(*,"('SAVE failed: ',A/)") FILNAM ENDIF ENDIF GO TO 2100 ! RESUME RESUME GAME BROM BACKUP FILE 13100 CALL FILEOPEN(FILNAM) IF (FILNAM.EQ.'') THEN WRITE (*,"('RESTORE cancelled'/)") GO TO 2100 ELSE OPEN (UNIT=16,FILE=FILNAM,STATUS='OLD',FORM='UNFORMATTED',ACCESS='SEQUENTIAL',ERR=13100) READ(16) ISWIZ,BLKLIN,LOCCON,OBJCON,NUMDIE,MAXDIE,TURNS,KILLED,DWARF,KNIFE,KNFLOC,DFLAG,DSEEN,DLOC,ODLOC,DWFMAX,HOLDER,& HLINK,BOTTLE,CASK,WATER,OIL,WINE,LIQTYP,LOC,OLDLOC,OLDLC2,NEWLOC,MAXLOC,LTEXT,STEXT,KEY,ABB,LOCSIZ,PLAC,FIXD,& WEIGHT,PROP,POINTS,ATLOC,LINK,PLACE,FIXED,MAXOBJ,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 CLOSE(16,STATUS='KEEP') CALL UPPER_CASE(FILNAM) IF (FILNAM.NE.LASTSAVE) CALL SOUND('WHERE BEEN') CALL COLOR(LOC) DETAIL=3 GO TO 25200 !GO LOOK ENDIF ! YANK. A VARIANT OF 'CARRY'. IN GENERAL, NOT A GOOD IDEA. AT MOST, IT GETS THE CLOAK OR A COUPLE SNIDE COMMENTS. 23200 IF (TOTING(OBJ)) GO TO 20200 IF (OBJ.NE.PLANT.AND.OBJ.NE.SWORD.AND.OBJ.NE.CHAIN) THEN SPK=205 IF (OBJ.EQ.BEAR.AND.PROP(CHAIN).EQ.1) GO TO 2011 IF (OBJ.EQ.CLOAK.AND.PROP(CLOAK).EQ.2) GO TO 20120 ENDIF GO TO 20100 ! WEAR: ONLY GOOD FOR JEWELS, RUBY SLIPPERS, CLOAK & CROWN. BUT ADVENTURER MIGHT TRY THE SWORD. ANOTHER VARIANT OF 'CARRY'. 23300 SPK=209 IF (OBJ.EQ.SWORD.AND.PROP(SWORD).NE.3) GO TO 2011 IF (WEARABLE(OBJ)) GO TO 23320 23310 ZAPP=OTXT(OBJX); ZAPP(LEN_TRIM(ZAPP)+1:)='?' CALL LOWER_CASE(ZAPP) WRITE(*,"(/' Just exactly how does one wear a ',A)") ZAPP GO TO 2100 23320 SPK=242 IF (OBJ.EQ.CLOAK.AND.PROP(CLOAK).EQ.2) GO TO 2011 SPK=210 IF (OBJ.EQ.SHOES) SPK=227 IF (WEARNG(OBJ)) GO TO 2011 PROP(OBJ)=1 OBJCON(OBJ)=IBSET(OBJCON(OBJ),WEARBT) IF (ENCLSD(OBJ)) CALL REMOVE(OBJ) IF (HOLDNG(OBJ)) GO TO 2009 GO TO 20120 ! HIT. IF NOT PUNCHING OUT TELEPHONE, ASSUME ATTACK. 23400 IF (AT(WUMPUS).AND.PROP(WUMPUS).EQ.0) GO TO 22900 IF (OBJ.NE.PHONE) GO TO 21200 IF (CLOSED) GO TO 93100 SPK=256 IF (PROP(PHONE).EQ.2) GO TO 2011 CALL DROP(SLUGS,LOC) SPK=257 PROP(PHONE)=2 PROP(BOOTH)=2 GO TO 2011 ! ANSWER TELEPHONE. SMARTASS FOR ANYTHING ELSE. 13500 IF (LOC.NE.189.OR.PROP(PHONE).NE.0) GO TO 10000 OBJ=PHONE 23500 IF (OBJ.EQ.PHONE) THEN SPK=269 IF (PROP(PHONE).NE.0) GO TO 2011 IF (CLOSED) GO TO 93200 SPK=261 PROP(PHONE)=1 PROP(BOOTH)=2 GO TO 2011 ENDIF IF (OBJ.EQ.DWARF.OR.OBJ.EQ.WUMPUS.OR.OBJ.EQ.SNAKE.OR.OBJ.EQ.BEAR.OR.OBJ.EQ.DRAGON) SPK=259 IF (OBJ.EQ.TROLL) SPK=258 IF (OBJ.EQ.BIRD) SPK=260 GO TO 2011 ! BLOW. JOSHUA FIT DE BATTLE OF JERICHO, AND DE WALLS.... 23600 IF (OBJ.NE.0.AND.IOBJ.NE.0) GO TO 2060 IF (OBJ.EQ.0) OBJ=IOBJ IOBJ=0 IF (OBJ.EQ.0) SPK=268 IF (OBJ.NE.HORN) GO TO 2011 SPK=266 IF (OUTSID(LOC)) SPK=277 IF (AT(WUMPUS)) THEN IF (PROP(WUMPUS).NE.0) GO TO 2011 CALL SPEAK(RTEXT(SPK)) GO TO 22900 ENDIF IF (PROP(WALL).EQ.1.OR.(LOC.NE.102.AND.LOC.NE.194)) GO TO 2011 K=196 IF (LOC.EQ.194) K=195 CALL SPEAK(RTEXT(265)) PROP(WALL)=1 DO OBJ=1,MAXOBJ IF (PLACE(OBJ).EQ.LOC.OR.FIXED(OBJ).EQ.LOC) CALL MOVE(OBJ,K) END DO NEWLOC=K GO TO 2 ! CALL. IF NO PHONE IS HANDY, YELL. 13800 IF (.NOT.HERE(PHONE)) GO TO 10000 GO TO 23910 ! DIAL. NO EFFECT UNLESS AT PHONE. 23900 IF (OBJ.NE.PHONE) GO TO 2011 23910 IF (CLOSED) GO TO 93200 SPK=271 GO TO 2011 ! PLAY HORN OR LYRE 24000 IF (OBJ.NE.0.AND.IOBJ.NE.0) GO TO 2060 IF (OBJ.EQ.0) OBJ=IOBJ IOBJ=0 IF (OBJ.EQ.HORN) GO TO 23600 IF (OBJ.NE.LYRE) GO TO 2011 SPK=287 IF (.NOT.HERE(DOG).OR.DEAD(DOG)) GO TO 2011 PROP(DOG)=1 OBJCON(DOG)=IBSET(OBJCON(DOG),DEADBT) FIXED(AXE)=0 PROP(AXE)=0 SPK=288 GO TO 2011 ! PICK/PICK UP. CAN PICK FLOWERS & MUSHROOMS, BUT MUST 'PICK UP' EVERYTHING EL 24100 IF (OBJ.EQ.0) OBJ=IOBJ IOBJ=0 IF (OBJ.EQ.FLOWER.OR.OBJ.EQ.MUSHRM.OR.PREP.NE.0) GO TO 20100 GO TO 2060 ! PUT DOWN: EQUIVALENT TO DROP. ! PUT IN: IF LIQUID, MEANS 'FILL'. ! PUT ON: WEAR OR DROP. 24200 IF (PREP.EQ.0) THEN ZAPP=OTXT(OBJX); ZAPP(LEN_TRIM(ZAPP)+1:)='?' CALL LOWER_CASE(ZAPP) WRITE(*,"(/' Where do you want to put the ',A)") ZAPP GO TO 2600 ENDIF IF (PREP.EQ.PREPIN) GO TO 24500 ! PUT ON: "WEAR" OR "PUT OBJ ON IOBJ". IF (PREP.EQ.PREPON) THEN IF (OBJ.EQ.0) THEN OBJ=IOBJ OTXT(OBJX)=IOTXT(IOBX) IOBJ=0 ENDIF IF (WEARABLE(OBJ)) GO TO 23300 IF (IOBJ.EQ.0) GO TO 23310 GO TO 20200 ENDIF ! PUT DOWN: "DROP" IF (OBJ.NE.0.AND.IOBJ.NE.0) GO TO 2070 IF (OBJ.EQ.0) OBJ=IOBJ IOBJ=0 GO TO 20200 ! TURN ON/OFF. 24300 IF (PREP.EQ.0) GO TO 2060 IF (OBJ.EQ.0.AND.IOBJ.EQ.LAMP) OBJ=LAMP IF (OBJ.NE.LAMP) GO TO 2070 IF (PREP.EQ.PREPON) GO TO 20700 GO TO 20800 ! GET (NO PREP): "TAKE" ! GET IN: "ENTER" ! GET OUT: "LEAVE" 24400 IF (PREP.NE.0.AND.PREP.NE.PREPFR) THEN IF (OBJ.NE.0) GO TO 2060 OBJ=IOBJ IOBJ=0 PREP=0 ENDIF GO TO 20100 ! INSERT/PUT IN. 24500 IF (IOBJ.EQ.0) GO TO 10010 SPK=NOWAY() IF (OBJ.EQ.SWORD.AND.IOBJ.EQ.ANVIL.AND.PROP(SWORD).EQ.0) SPK=350 IF (.NOT.VESSEL(IOBJ)) GO TO 2011 CALL NOT_TOTING_SPK(ISFIXED) IF (ISFIXED) GO TO 2011 IF (IOBJ.NE.BOTTLE.AND.IOBJ.NE.CASK.AND.IOBJ.NE.VASE.AND.IOBJ.NE.GRAIL.AND.(OBJ.LT.WATER.OR.OBJ.GT.WINE+1)) THEN SPK=252 IF (OBJ.NE.IOBJ) THEN SPK=358 IF (AJAR(IOBJ)) THEN IF (IOBJ.EQ.BOAT.OR.IOBJ.EQ.CHEST) THEN IF (IOBJ.EQ.CHEST.AND.OBJ.EQ.BOAT) GO TO 2070 GO TO 24590 ENDIF ! BIRD GOES ONLY INTO CAGE; CAGE HOLDS NOTHING ELSE. BAR VASE & PILLOW FROM SAFE TO FORCE PUTTING DOWN ON FLOOR. SPK=329 !WON'T FIT IF (IOBJ.EQ.CAGE) THEN IF (IOBJ.EQ.BIRD) GO TO 20120 ELSEIF (OBJ.EQ.BIRD) THEN SPK=351 !WOULD SUFFOCATE ELSEIF (IOBJ.EQ.SAFE.AND.(OBJ.EQ.VASE.OR.OBJ.EQ.PILLOW)) THEN ELSEIF (IOBJ.EQ.SHIELD.AND.OBJ.NE.RADIUM) THEN ELSEIF (IOBJ.EQ.PHONE) THEN IF (OBJ.NE.COINS.AND.OBJ.NE.SLUGS) GO TO 2070 CALL DESTROY(OBJ) SPK=330 ELSE GO TO 24530 !OK ENDIF ENDIF ENDIF GO TO 2011 !WON'T FIT OR WOULD SUFFOCATE ELSE OBJ=IOBJ IOBJ=OBJS(OBJX) GO TO 22200 ENDIF 24530 IF (IOBJ.EQ.VEND) THEN IF (OBJ.NE.COINS.AND.OBJ.NE.SLUGS) GO TO 2070 CALL DESTROY(OBJ) CALL MOVE(BATTER,LOC) IF (PROP(BATTER).EQ.1) THEN CALL SPEAK(RTEXT(317)) PROP(VEND)=1 ENDIF PROP(BATTER)=0 CALL PSPEAK(BATTER,0) GO TO 2100 ENDIF ! PUT BATTERIES IN LAMP. IF ADVENTURER GETS 3RD SET OF BATTERIES BEFORE 2ND SET INSERTED, 2ND SET DISAPPEARS! ***FIX SOMETIME IF (IOBJ.EQ.LAMP) THEN IF (OBJ.NE.BATTER.OR.PROP(BATTER).NE.0) GO TO 2070 PROP(BATTER)=1 IF (ENCLSD(BATTER)) CALL REMOVE(BATTER) IF (HOLDNG(BATTER)) CALL DROP(BATTER,LOC) LIMIT=400 PROP(LAMP)=1 LMWARN=.FALSE. SPK=188 GO TO 2011 ENDIF IF (.NOT.SMALL(OBJ)) GO TO 2011 24590 IF (WEARNG(OBJ)) OBJCON(OBJ)=IBCLR(OBJCON(OBJ),WEARBT) IF (WEARABLE(OBJ)) PROP(OBJ) = 0 IF (ENCLSD(OBJ)) CALL REMOVE(OBJ) CALL INSERT(OBJ,IOBJ) GO TO 2009 ! REMOVE/TAKE FROM 24600 IF (OBJ.EQ.RING.AND.PROP(RING).EQ.2) THEN PREP=0 IOBJ=0 GO TO 20100 ENDIF SPK=343 IF (IOBJ.EQ.0) THEN IF (.NOT.ENCLSD(OBJ)) SPK=340 IOBJ=-PLACE(OBJ) ENDIF IF (OBJ.NE.0) THEN IF (PLACE(OBJ).NE.-IOBJ) SPK=341 IF (.NOT.AJAR(IOBJ)) SPK=335 IF (OBJ.EQ.WATER.OR.OBJ.EQ.OIL.OR.OBJ.EQ.WINE) SPK=342 IF (.NOT.TOTING(OBJ).AND.BURDEN(0)+BURDEN(OBJ).GT.15) SPK=92 IF (SPK.NE.343) GO TO 2011 CALL REMOVE(OBJ) IF (OBJ.EQ.BIRD) GO TO 20200 ENDIF GO TO 2009 ! LOCK CHAIN, GRATE, CHEST, ELFIN DOOR 24900 IF (.NOT.HINGED(OBJ))THEN ZAPP=OTXT(OBJX); ZAPP(LEN_TRIM(ZAPP)+1:)='.' CALL LOWER_CASE(ZAPP) WRITE(*,"(/' I don''t know how to lock or unlock the ',A)") ZAPP GO TO 2100 ENDIF SPK=375 IF (.NOT.LOCKS(OBJ)) SPK=32 IF (LOCKED(OBJ)) SPK=34 IF (.NOT.(ATHAND(KEYS).OR.ATHAND(SKEY).OR.OBJ.EQ.SAFE)) SPK=31 IF (SPK.NE.375) GO TO 2011 ! CHAIN IF (OBJ.EQ.CHAIN) THEN IF (.NOT.ATHAND(KEYS)) GO TO 2011 SPK=173 IF (LOC.NE.PLAC(CHAIN)) GO TO 2011 SPK=172 PROP(CHAIN)=2 IF (ENCLSD(CHAIN)) CALL REMOVE(CHAIN) IF (HOLDNG(CHAIN)) CALL DROP(CHAIN,LOC) FIXED(CHAIN)=-1 ! CHEST ELSEIF (OBJ.EQ.CHEST) THEN IF (.NOT.ATHAND(KEYS)) GO TO 2011 SPK=334 ! ELFIN DOOR ELSEIF (OBJ.EQ.TDOOR.OR.OBJ.EQ.TDOOR2) THEN SPK=224 IF (.NOT.TOTING(SKEY)) GO TO 2011 PROP(TDOOR)=0 PROP(TDOOR2)=0 SPK=234+2*PROP(TDOOR)+(TDOOR2-OBJ) K=TDOOR+(TDOOR2-OBJ) OBJCON(K)=IBSET(OBJCON(K),LOCKBT) OBJCON(K)=IBCLR(OBJCON(K),OPENBT) ! GRATE ELSEIF (OBJ.EQ.GRATE) THEN IF (.NOT.ATHAND(KEYS)) GO TO 2011 PROP(GRATE)=0 SPK=35 ! SAFE. ELSE PROP(SAFE)=0 SPK=367 ENDIF OBJCON(OBJ)=IBSET(OBJCON(OBJ),LOCKBT) OBJCON(OBJ)=IBCLR(OBJCON(OBJ),OPENBT) GO TO 2011 ! UNLOCK CHAIN, GRATE, CHEST, ELFIN DOOR 25000 SPK=55 IF (OBJ.EQ.KEYS.OR.OBJ.EQ.SKEY) GO TO 2011 IF (.NOT.HINGED(OBJ)) GO TO 24900 SPK=375 IF (.NOT.LOCKED(OBJ)) SPK=37 IF (.NOT.LOCKS(OBJ)) SPK=32 IF (OBJ.EQ.SAFE) SPK=342 IF (OBJ.EQ.SAFE.AND.(IOBJ.EQ.KEYS.OR.IOBJ.EQ.SKEY)) SPK=368 IF (.NOT.(ATHAND(KEYS).OR.ATHAND(SKEY).OR.OBJ.EQ.SAFE)) SPK=31 IF (SPK.NE.375) GO TO 2011 ! CHAIN IF (OBJ.EQ.CHAIN)THEN IF (.NOT.ATHAND(KEYS)) GO TO 2011 SPK=171 IF (PROP(BEAR).EQ.0) SPK=41 IF (SPK.NE.171) GO TO 2011 PROP(CHAIN)=0 FIXED(CHAIN)=0 IF (PROP(BEAR).NE.3) PROP(BEAR)=2 FIXED(BEAR)=2-PROP(BEAR) ! CHEST ELSEIF (OBJ.EQ.CHEST) THEN IF (.NOT.ATHAND(KEYS)) GO TO 2011 SPK=333 ! ELFIN DOOR. LOCK/UNLOCK TINY DOOR W/SPECIAL KEY. THE DAMN THING IS REALLY AT FOUR PLACES, AND WE WANT THE RIGHT ! MESSAGES IF ADVENTURER ONLY HAS 'BIG' KEYS OR NO KEYS. CAN UNLOCK WHILE BIG OR SMALL. ELSEIF (OBJ.EQ.TDOOR.OR.OBJ.EQ.TDOOR2) THEN SPK=224 IF (.NOT.ATHAND(SKEY)) GO TO 2011 IF (CLOSNG) GO TO 25060 PROP(TDOOR)=1 PROP(TDOOR2)=1 SPK=234+2*PROP(TDOOR)+(TDOOR2-OBJ) K=TDOOR+(TDOOR2-OBJ) OBJCON(K)=IBCLR(OBJCON(K),LOCKBT) OBJCON(K)=IBSET(OBJCON(K),OPENBT) ELSE ! GRATE IF (.NOT.ATHAND(KEYS)) GO TO 2011 IF (CLOSNG) GO TO 25060 PROP(GRATE)=1 SPK=36 ENDIF OBJCON(OBJ)=IBCLR(OBJCON(OBJ),LOCKBT) OBJCON(OBJ)=IBSET(OBJCON(OBJ),OPENBT) GO TO 2011 ! CLOSING. NO EXIT THIS WAY. 25060 SPK=130 IF (.NOT.PANIC) CLOCK2=15 PANIC=.TRUE. GO TO 2011 ! HEALTH. GIVE A DIAGNOSIS. 25100 IF (HEALTH.LT.100) WRITE(*,"(/' You''re health rating is ',I0,' out of a possible 100.')") HEALTH IF (PCT(50)) SPK=349 IF (HEALTH.LT.95) SPK=381 + (100-HEALTH)/20 GO TO 2011 ! LOOK. PRETEND NOT DARK SO WON'T FALL INTO A PIT WHILE STARING INTO THE GLOOM. 25200 IF (OBJ.NE.0) GO TO 2060 IF (IOBJ.NE.0) GO TO 25210 25201 IF (DETAIL.LT.3) CALL SPEAK(RTEXT(15)) DETAIL=DETAIL+1 WASDARK=.FALSE. ABB(LOC)=0 NEWLOC=LOC GO TO 2 ! LOOK INTO SOMETHING (A CONTAINER). 25210 IF (VESSEL(IOBJ)) THEN IF (.NOT.AJAR(IOBJ).AND.OPAQUE(IOBJ)) GO TO 2011 SPK=359 IF (HOLDER(IOBJ).EQ.0) GO TO 2011 WRITE(*,"(1X)") CALL LOOKIN(IOBJ) GO TO 2100 ENDIF ! LOOK AT SOMETHING. IF WRITTEN, READ IT. IF (PRINTD(IOBJ)) THEN OBJ=IOBJ IOBJ=0 GO TO 22700 ENDIF IF (IOBJ.NE.SPHERE) GO TO 25201 IF (INSIDE(LOC).AND.(.NOT.ATHAND(SAPPHI))) THEN CALL SPEAK(RTEXT(400)) WRITE(*,"(1X)") SLOC=PLACE(SAPPHI) IF ((MOD(LOCCON(SLOC),2).EQ.0.OR.ENCLSD(SAPPHI)).AND.SLOC.NE.200.AND..NOT.(PLACE(LAMP).EQ.SLOC.AND.PROP(LAMP).NE.0)) THEN CALL SPEAK(RTEXT(401)) ELSE CALL SPEAK(LTEXT(SLOC)) IF (SLOC.EQ.239.AND.FLG239.EQ.0) THEN CALL SPEAK(RTEXT(403)) FLG239=1 ENDIF ENDIF WRITE(*,"(1X)") CALL SPEAK(RTEXT(402)) ELSE CALL SPEAK(RTEXT(42)) ENDIF GO TO 2100 ! COMBO: TRYING TO OPEN SAFE 25300 IF (.NOT.AT(SAFE)) GO TO 2060 K=VOCABX(VTXT(VRBX),4)-10 SPK=42 IF (COMBO.NE.1-K) THEN IF (COMBO.NE.0) SPK=366 GO TO 2011 ENDIF COMBO=K SPK=371 IF (K.NE.3) GO TO 2011 COMBO=0 OBJCON(SAFE)=IBCLR(OBJCON(SAFE),LOCKBT) OBJCON(SAFE)=IBSET(OBJCON(SAFE),OPENBT) PROP(SAFE)=1 SPK=365 IF (PROP(BOOK).GE.0) GO TO 2011 TALLY=TALLY-1 PROP(BOOK)=0 ! IF REMAINING TREASURES TOO ELUSIVE, ZAP LAMP. THIS COPIES SOME CODE LOCATED AROUND LABEL 2000. MUST BE DONE ! HERE SINCE BOOK IS CONTAINED IN SAFE & TALLY STUFF ONLY WORKS FOR THINGS DEPOSITED AT A LOC. IF (TALLY.EQ.TALLY2.AND.TALLY.NE.0) LIMIT=MIN0(35,LIMIT) GO TO 2011 ! DUST/SWEEP 25400 IF (.NOT.ATHAND(BRUSH)) SPK=342 IF (AT(CARVNG).AND.ATHAND(BRUSH).AND.PROP(CARVNG).NE.1) THEN PROP(CARVNG)=1 CALL SPEAK(RTEXT(363)) SPK=372 ENDIF GO TO 2011 ! TERSE/UNTERSE. SUPRESS ALL LONG-FORM DESCRIPTIONS. 25500 TERSE=.NOT.TERSE DETAIL=3 GO TO 2009 ! COMMENT THE FOLLOWING LINE TO DEACTIVATE WIZARD MODE 25600 ISWIZ = .TRUE. 25800 IF (ISWIZ) THEN WRITE(*,"('CURRENT LOCATION IS ',I0)") LOC WRITE(*,"('LOCATION ? ',$)") READ (*,"(I4)",ERR=25800) GATLOC IF ((GATLOC.GT.0).AND.(GATLOC.LE.MAXLOC)) THEN LOC=GATLOC CALL COLOR(LOC) ENDIF ENDIF DETAIL=3 GO TO 25200 !GO LOOK 25900 IF (ISWIZ) THEN WRITE(*,"(' DWARVES ARE AT LOCATIONS',5I4,' PIRATE IS AT LOCATION ',I0,/' CLOCKS ARE',3I3, ' TALLY ',I0)") & DLOC,CLOCK1,CLOCK2,CLOCK3,TALLY ELSE SPK=345 GO TO 2011 ENDIF GO TO 2009 ! HINTS ! COME HERE IF ADVENTURE'S BEEN LONG ENOUGH AT REQUIRED LOC(S) FOR SOME UNUSED HINT. 40000 HINTLC(HINT)=0 !RESET LOCATION TIME SELECT CASE ((HINT+1-HNTMIN)) CASE (1) !MAZE IF (ATLOC(LOC).EQ.0.AND.ATLOC(OLDLOC).EQ.0.AND.ATLOC(OLDLC2).EQ.0.AND.BURDEN(0).GT.1) GO TO 40010 CASE (2) !DARK IF (PROP(EMRALD).NE.-1.AND.PROP(PYRAM).EQ.-1) GO TO 40010 CASE (3,5,12); GO TO 40010 !WITT'S END, SLIDE, GRATE CASE (4) !SWORD IF ( (PROP(SWORD).EQ.1.OR.PROP(SWORD).EQ.5).AND..NOT.TOTING(CROWN)) GO TO 40010 CASE (6) !CAVE1 IF (PROP(GRATE).EQ.0.AND..NOT.ATHAND(KEYS)) GO TO 40010 CASE (7) !BIRD IF (HERE(BIRD).AND.ATHAND(ROD).AND.OBJ.EQ.BIRD) GO TO 40010 GO TO 2602 CASE (8) !CAVE2 IF (ABB(159).EQ.0) GO TO 40010 CASE (9) !RAINBOW IF (.NOT.TOTING(SHOES).OR.ABB(205).EQ.0) GO TO 40010 CASE (10) !SNAKE IF (.NOT.ATHAND(LYRE).AND.PROP(DOG).NE.1) GO TO 40010 CASE (11) !STYX IF (HERE(SNAKE).AND..NOT.HERE(BIRD)) GO TO 40010 CASE DEFAULT WRITE(LASTSAVE,"(' TRYING TO PRINT HINT # ',I0,/)") HINT CALL BUG(LASTSAVE) END SELECT GO TO 2602 40010 IF (YES(HINTS(HINT,3),0,54)) THEN WRITE(*,"(/' I am prepared to give you a hint, but it will cost you ',I0,' points.')") HINTS(HINT,2) HINTED(HINT)=YES(175,HINTS(HINT,4),54) IF (HINTED(HINT).AND.LIMIT.GT.30) LIMIT=LIMIT+30*HINTS(HINT,2) ENDIF GO TO 2602 ! CAVE CLOSING AND SCORING ! CAVE CLOSES "CLOCK1" TURNS AFTER LAST TREASURE IS LOCATED, INCLUDING THE PIRATE'S CHEST, WHICH MAY NEVER SHOW UP. TREASURES ! NEED NOT BE TAKEN YET, JUST LOCATED. HENCE CLOCK1 MUST BE LARGE ENOUGH TO GET OUT OF THE CAVE (IT ONLY TICKS WHILE INSIDE THE ! CAVE). WHEN IT HITS ZERO, BRANCH TO 90000 TO START CLOSING THE CAVE. AFTER CLOCK2 TURNS, CLOSE THE CAVE. IF ADVENTURER TRIES ! TO GET OUT, ASSUME PANICS AND GIVE A FEW ADDITIONAL TURNS TO GET FRANTIC BEFORE CLOSING. WHEN CLOCK2 HITS ZERO BRANCH TO ! 90000 TO TRANSPORT ADVENTURER INTO THE FINAL PUZZLE, SEPARATING ADVENTURER FROM ALL TREASURES. THE PUZZLE DEPENDS UPON ALL ! SORTS OF RANDOM THINGS. FOR INSTANCE, THERE MUST BE NO WATER OR OIL, SINCE THERE ARE BEANSTALKS WE DON'T WANT TO BE ABLE TO ! WATER AND THE CODE CAN'T HANDLE IT. WE CAN HAVE NO KEYS SINCE THERE IS A GRATE. MOST OF THESE PROBLEMS ARISE FROM THE USE OF ! NEGATIVE PROP NUMBERS TO SUPPRESS THE OBJECT DESCRIPTIONS UNTIL ADVENTURER ACTUALLY MOVED THEM. ! WHEN THE FIRST WARNING COMES, LOCK THE GRATE, DESTROY THE BRIDGE, KILL THE DWARVES AND PIRATE, REMOVE TROLL AND BEAR UNLESS ! DEAD, AND SET "CLOSNG" TO TRUE. LEAVE THE DRAGON; TOO MUCH TROUBLE TO MOVE IT. FROM NOW UNTIL CLOCK2 RUNS OUT CAN'T UNLOCK ! GRATE, MOVE TO ANY LOCATION OUTSIDE THE CAVE, OR CREATE THE BRIDGE. NOT RESURRECTED IF DIES. SNAKE IS ALREADY GONE, SINCE ! GOT TO THE TREASURE ACCESSIBLE ONLY VIA THE HALL OF THE MT. KING. ALSO, ADVENTURE'S BEEN IN GIANT ROOM TO GET EGGS, SO WE CAN ! REFER TO IT. GOT THE PEARL SO KNOWS BIVALVE IS AN OYSTER AND THE DWARVES ARE ACTIVATED SINCE WE FOUND CHEST. 90000 PROP(GRATE)=0 PROP(FISSUR)=0 PROP(TDOOR)=0 PROP(TDOOR2)=0 DSEEN=.FALSE. !SET ALL DWARVES AND PIRATE TO NOT SEEN DLOC=0 !SET LOCATIONS OF ALL DWARVES AND PIRATE TO 0 CALL MOVE(TROLL,0) CALL MOVE(TROLL+MAXOBJ,0) CALL MOVE(TROLL2,PLAC(TROLL)) CALL MOVE(TROLL2+MAXOBJ,FIXD(TROLL)) CALL JUGGLE(CHASM) IF (PROP(BEAR).NE.3) CALL DESTROY(BEAR) PROP(CHAIN)=0 FIXED(CHAIN)=0 PROP(AXE)=0 FIXED(AXE)=0 CALL SPEAK(RTEXT(129)) CLOCK1=-1 CLOSNG=.TRUE. GO TO 19999 ! ONCE ADVENTURER'S PANICKED AND CLOCK2 RUNS OUT, COME HERE TO SET UP STORAGE ROOM. THE ROOM HAS TWO LOCS, HARDWIRED AS 115 (NE) ! AND 116 (SW). AT NE END, PLACE EMPTY BOTTLES, A NURSERY OF PLANTS, BED OF OYSTERS, PILE OF LAMPS, RODS, AND STARS, SLEEPING ! DWARVES, PHONE BOOTH AND AT THE SW END WE PLACE GRATE OVER TREASURES, SNAKE PIT, COVEY OF CAGED BIRDS, PILLOWS. A MIRROR ! STRETCHES ACROSS ONE WALL. MANY OF THE OBJECTS COME FROM KNOWN LOCATIONS AND/OR STATES (E.G. SNAKE IS KNOWN TO BE DESTROYED ! AND NEEDN'T BE CARRIED AWAY FROM ITS OLD "PLACE"), MAKING THE VARIOUS OBJECTS BE HANDLED DIFFERENTLY. DROP ALL OTHER OBJECTS ! THAT MIGHT BE CARRIED LEST THERE SOME WHICH COULD CAUSE TROUBLE, SUCH AS THE AS THE KEYS. DESCRIBE THE FLASH OF LIGHT AND ! TRUNDLE BACK. THE PHONE MAKES IT IMPOSSIBLE FOR ADVENTURER TO DINK AROUND THE REPOSITORY TOO LONG. WHEN CLOCK3 TICKS TO ZERO, ! PHONE STARTS RINGING; WHEN IT HITS -7, DWARVES WAKE UP. IF ADVENTURER FIDDLES WITH THE PHONE, GETS ZONKED IN OTHER WAYS. 91000 PROP(BOTTLE)=PUT(BOTTLE,115,1) PROP(PLANT)=PUT(PLANT,115,0) PROP(OYSTER)=PUT(OYSTER,115,0) PROP(LAMP)=PUT(LAMP,115,0) PROP(ROD)=PUT(ROD,115,0) PROP(DWARF)=PUT(DWARF,115,0) LOC=115 OLDLOC=115 NEWLOC=115 ! LEAVE THE GRATE WITH NORMAL (NON-NEGATIVE PROPERTY). FOO=PUT(GRATE,116,0) PROP(SNAKE)=PUT(SNAKE,116,1) PROP(BIRD)=PUT(BIRD,116,1) PROP(CAGE)=PUT(CAGE,116,0) PROP(ROD2)=PUT(ROD2,116,0) PROP(PILLOW)=PUT(PILLOW,116,0) PROP(BOOTH)=PUT(BOOTH,116,-4) FIXED(BOOTH)=115 PROP(PHONE)=PUT(PHONE,212,-4) PROP(MIRROR)=PUT(MIRROR,115,0) PROP(BOOK2)=PUT(BOOK2,115,0) FIXED(MIRROR)=116 DO I=1,MAXOBJ IF (TOTING(I).AND.ENCLSD(I)) CALL REMOVE(I) IF (TOTING(I)) CALL DESTROY(I) END DO CALL SPEAK(RTEXT(132)) CALL WAIT(10.) CALL POOF(0) CLOSED=.TRUE. GO TO 2 ! DISTURBED THE DWARVES. 93000 CALL SPEAK(RTEXT(136)) GO TO 95000 ! HIT THE PHONE. JINGLE, JANGLE, CRASH! 93100 CALL SPEAK(RTEXT(282)) GO TO 93000 ! WHOOPS. DOWN THE CHUTE. 93200 CALL SPEAK(RTEXT(283)) GO TO 95000 ! DWARVES CAN'T SLEEP THRU ALL THIS RINGING! 93300 CALL SPEAK(RTEXT(254)) GO TO 95000 ! IF THE CURRENT LOC IS ZERO, ADVENTURER WAS KILLED, WHICH IS ALLOWED MAXDIE TIMES. MAXDIE IS AUTOMATICALLY SET BASED ON NUMBER ! OF SNIDE MESSAGES AVAILABLE. EACH DEATH RESULTS IN A MESSAGE (81, 83, ETC.) OFFERING REINCARNATION; IF ACCEPTED, THIS RESULTS ! IN MESSAGE 82, 84, ETC. WHEN REINCARNATED, ALL OBJECTS BEING CARRIED GET DROPPED AT OLDLC2 (PRESUMABLY THE LAST PLACE PRIOR TO ! BEING KILLED) WITHOUT CHANGE OF PROPS. THE LAMP IS TURNED OFF AND LEFT OUTSIDE THE BUILDING IF IT WAS CARRIED. ADVENTURER LEFT ! INSIDE THE BUILDING; OLDLOC ZAPPED SO ADVENTURER CAN'T JUST "RETREAT". 94000 CALL SPEAK(RTEXT(23)) OLDLC2=LOC ! DIED 94100 IF (.NOT.CLOSNG) THEN YEA=YES(81+NUMDIE*2,82+NUMDIE*2,54) NUMDIE=NUMDIE+1 IF (NUMDIE.EQ.MAXDIE.OR..NOT.YEA) GO TO 95000 IF (CHASE.NE.0) THEN ! CHASED BY WUMPUS, & DIED ANOTHER WAY. PUT WUMPUS BACK TO SLEEP IN CASE ADVENTURER STILL HASN'T GOT THE CLOAK. CHASE=0 PROP(WUMPUS)=0 CALL MOVE(WUMPUS,174) ENDIF IF (TOTING(LAMP)) PROP(LAMP)=0 DO J=1,MAXOBJ IF (HOLDNG(J)) THEN LOC=OLDLC2 IF (J.EQ.LAMP) LOC=1 CALL DROP(J,LOC) IF (WEARNG(J)) THEN PROP(J)=0 OBJCON(J)=IBCLR(OBJCON(J),WEARBT) ENDIF ENDIF END DO LOC=3 OLDLOC=LOC WDX=0 WORDS(1)=0 CALL CLRLIN HEALTH=100 GO TO 2000 ENDIF ! DIED DURING CLOSING TIME. NO RESURRECTION. TALLY UP A DEATH AND EXIT. CALL SPEAK(RTEXT(131)) NUMDIE=NUMDIE+1 ! IT'S OVER. TALLY SCORE. 95000 CALL RATING(SCORE,BONUS,GAVEUP,SCORNG,CLOSNG,CLOSED,HNTMAX) WRITE(*,"(///' You scored ',I0,' out of a possible ',I0,', using ',I0,' turns.')") SCORE,MXSCOR,TURNS IF (SCORE.LT.MXSCOR) THEN DO I=1,CLSSES IF (CVAL(I).GE.SCORE) THEN CALL SPEAK(CTEXT(I)) IF (I.EQ.CLSSES-1) THEN WRITE(*,"(/' To achieve the next higher rating would be a neat trick!'//' CONGRATULATIONS!!'/)") ELSE K=CVAL(I)+1-SCORE KK2C='s.' IF (K.EQ.1)KK2C='. ' WRITE(*,"(/' To achieve the next higher rating, you need ',I0,' more point',A2,'..'/)") K,KK2C ENDIF EXIT ENDIF END DO ENDIF CALL WAIT(25.) CALL POOF(0) END