!*! Updated on 31-Oct-91 at 2:44 PM by Michele Tonti; edit time: 0:00:18 !*************************** AMUS Program Label ****************************** ! Filename: ADVENT.RUN Date: 10/16/89 ! Category: GAME Hash Code: 703-743-613-535 Version: 1.0(1) ! Initials: Name: VARIOUS AUTHORS ! Company: Telephone #: ! Related Files: ADVENT.HRS, ADVENT.INX, ADVENT.RND ! Min. Op. Sys.: Expertise Level: BEG ! Special: ! Description: Now, back by popular demand - the long-awaited, ever-popular ! game of ADVENTURE!! This interactive game leads you through secret passages, ! hidden dangers and other exciting adventures. Have fun! !***************************************************************************** ! ! Download ADVENT.* to run program !*! Updated on 24-Oct-89 at 9:23 AM by Matt Badger; edit time: 0:01:13 ! ADVENT.BAS - ***ADVENTURES** - ! ! ! MODIFIED BY PHILIP J. HUNT ! MAY 13, 1979 ! F.W. WOOLWORTH ! ADDED MAINT,WIZARD,HOURS SECTIONS ! ! MODIFIED BY DARREL A. MAZZARI ! MAY 29,1978 ! CCA ! ! ! MODIFIED BY KENT BLACKETT ! ENGINEERING SYSTEMS GROUP ! DIGITAL EQUIPMENT CORP. ! 15-JUL-77 ! MODIFIED BY BOB SUPNIK ! DISK ENGINEERING ! 21-OCT-77 ! ORIGINAL VERSION WAS FOR DECSYSTEM-10 ! NEXT VERSION WAS FOR FORTRAN IV-PLUS UNDER ! THE IAS OPERATING SYSTEM ON THE PDP-11/70 ! NEXT VERSION WAS FOR FORTRAN IV (V01C OR LATER) ! UNDER RT-11 ON *ANY* PDP-11 ! THIS VERSION FOR AMOS BASIC ON AM-100 MICROCOMPUTER ! ! ! CURRENT LIMITS: ! 750 TRAVEL OPTIONS (TRAVEL, TRVSIZ). ! 300 VOCABULARY WORDS (KTAB, ATAB, TABSIZ). ! 150 LOCATIONS (LTEXT, STEXT, KEY, COND, ABB, ATLOC, LOCSIZ). ! 100 OBJECTS (PLAC, PLACE, FIXD, FIXED, LINK (TWICE), PTEXT, PROP). ! 35 "ACTION" VERBS (ACTSPK, VRBSIZ). ! 200 RANDOM MESSAGES (RTEXT, RTXSIZ). ! 12 DIFFERENT PLAYER CLASSIFICATIONS (CTEXT, CVAL, CLSMAX). ! 20 HINTS, LESS 3 (HINTLC, HINTED, HINTS, HNTSIZ). ! [MAGIC MESSAGES ARE CURRENTLY DECOMMITTED] ! 35 MAGIC MESSAGES (MTEXT, MAGSIZ). ! 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.) THESE UPPER LIMITS ARE: ! 1000 NON-SYNONYMOUS VOCABULARY WORDS ! 300 LOCATIONS ! 100 OBJECTS ! ! DEFINE LOAD RECORD ! MAP1 HNTMAX,F,6,20 MAP1 INXREC MAP2 LINUSE,F,6 : MAP2 ASCVAR,F,6 : MAP2 FILSIZ,F,6 MAP2 TABSIZ,F,6 : MAP2 LOCSIZ,F,6 : MAP2 VRBSIZ,F,6 MAP2 HNTSIZ,F,6 : MAP2 TRVSIZ,F,6 : MAP2 MAGSIZ,F,6 MAP2 CLSMAX,F,6 : MAP2 VCOUNT,F,6 : MAP2 MAXTRS,F,6 ! ! DEFINE VERBS ! MAP2 PLANT2,F,6 : MAP2 TROLL2,F,6 : MAP2 ROD2,F,6 MAP2 KEYS,F,6 : MAP2 LAMP,F,6 : MAP2 GRATE,F,6 MAP2 CAGE,F,6 : MAP2 ROD,F,6 : MAP2 STEPS,F,6 MAP2 BIRD,F,6 : MAP2 DOOR,F,6 : MAP2 PILLOW,F,6 MAP2 SNAKE,F,6 : MAP2 FISSUR,F,6 : MAP2 TABLET,F,6 MAP2 CLAM,F,6 : MAP2 OYSTER,F,6 : MAP2 MAGZIN,F,6 MAP2 DWARF,F,6 : MAP2 KNIFE,F,6 : MAP2 FOOD,F,6 MAP2 BOTTLE,F,6 : MAP2 WATER,F,6 : MAP2 OIL,F,6 MAP2 PLANT,F,6 : MAP2 AXE,F,6 : MAP2 MIRROR,F,6 MAP2 DRAGON,F,6 : MAP2 CHASM,F,6 : MAP2 TROLL,F,6 MAP2 BEAR,F,6 : MAP2 MESSAG,F,6 : MAP2 VEND,F,6 MAP2 BATTER,F,6 : MAP2 NUGGET,F,6 : MAP2 COINS,F,6 MAP2 EGGS,F,6 : MAP2 TRIDNT,F,6 : MAP2 CHEST,F,6 MAP2 VASE,F,6 : MAP2 EMRALD,F,6 : MAP2 PYRAM,F,6 MAP2 PEARL,F,6 : MAP2 RUG,F,6 : MAP2 CHAINS,F,6 MAP2 BACK,F,6 : MAP2 LOOK,F,6 : MAP2 CAVE,F,6 MAP2 NULL,F,6 : MAP2 ENTRNC,F,6 : MAP2 DPRSSN,F,6 MAP2 STREAM,F,6 : MAP2 SAY,F,6 : MAP2 ALOCK,F,6 MAP2 THROW,F,6 : MAP2 FIND,F,6 : MAP2 INVENT,F,6 ! MAP2 BLKLIN,B,5 : MAP2 NOINPT,B,5 MAP2 HINTED,B,5 MAP2 TRUE,B,5,-1 : MAP2 FALSE,B,5,0 MAP2 HERE,B,5 : MAP2 AT,B,5 : MAP2 LIQ2,B,5 : MAP2 LIQ,B,5 MAP2 BIN1,B,1 : MAP2 BIN2,B,2 MAP2 HLD(3),B,2 : MAP2 LIQLOC,B,5 : MAP2 DARK,B,5 : MAP2 YES,B,5 MAP2 YESX,B,5 : MAP2 YEA,B,5 : MAP2 IHR,B,5 : MAP2 IDAY,B,5 MAP2 TLOC,B,1 : MAP2 TOLDLOC,B,1 ! MAP2 TIM$,S,8 MAP2 DAT,B,4 MAP2 TEDATE,@DAT MAP3 IMO,B,1 MAP3 IDY,B,1 MAP3 IYR,B,1 MAP3 IFLX,B,1 ! MAP2 RNDBLK MAP3 LINES,S,72 MAP3 LOC,B,1 ! MAP2 MESG,@RNDBLK MAP3 MOTD,S,60,"ADVENT.ADV" MAP3 MOTDFILLER,X,13,"restore" ! MAP2 IANS,S,2 ! MAP2 ATB MAP3 ATAB(300),S,4 ! MAP2 TRAVEL(750),B,2 : MAP2 TRVCON(750),B,2 : MAP2 TRVLOC(750),B,2 MAP2 KTAB(300),B,2 MAP2 WORDX,S,8 : MAP2 PUNC$,S,2 MAP2 LTEXT(150),B,2 : MAP2 STEXT(150),B,2 MAP2 PLAC(100),B,5 : MAP2 PLACE(100),B,5 : MAP2 FIXD(100),B,5 MAP2 FIXED(100),B,5 MAP2 PTEXT(80),B,2 : MAP2 PROP(100),B,5 MAP2 ACTSPK(35),B,2 MAP2 RTEXT(200),B,2 MAP2 CTEXT(12),B,2 : MAP2 CVAL(12),B,2 MAP2 HINTED(20),B,2 : MAP2 HINTS(20,4),B,2 ! MAP2 MAGICWORD,S,6 ! MAP2 TIMM$,S,8 MAP2 SAVDAT MAP4 IMO2,B,1 MAP4 IDY2,B,1 MAP4 IYR3,B,1 MAP4 IFL2,B,1 MAP2 ODLOC(6),B,1 MAP2 INIT,B,5 MAP2 I,F,6 : MAP2 TURNS,B,2 MAP2 SPK,B,5 : MAP2 OLDLC2,B,5 MAP2 SLOC,B,5 : MAP2 NEWLOC,B,5 MAP2 KNFLOC,B,5 : MAP2 DFLAG,B,5 MAP2 DETAIL,B,5 : MAP2 ABBNUM,B,5 MAP2 BONUS,B,5 : MAP2 KENT,B,5 MAP2 ATTACK,B,5 : MAP2 STICK,B,5 MAP2 OBJ,B,5 : MAP2 VERB,B,5 MAP2 KK,B,5 : MAP2 DLOC(6),B,1 MAP2 COND(150),B,2 : MAP2 ABB(150),B,2 MAP2 KEY(150),B,2 : MAP2 ATLOC(150),B,2 MAP2 CLOSED,B,5 : MAP2 WIZARD,B,2 MAP2 LIMIT,B,5 : MAP2 OLDLOC,B,2 MAP2 CVAL,B,5 : MAP2 TALLY,B,5 MAP2 TALLY2,B,5 : MAP2 CHLOC,B,5 : MAP2 CHLOC2,B,5 MAP2 DALTLC,B,2 : MAP2 NUMDIE,B,2 : MAP2 DKILL,B,5 MAP2 FOOBAR,B,5 : MAP2 CLOCK1,B,5 : MAP2 CLOCK2,B,5 MAP2 LL,B,5 : MAP2 J,F,6 : MAP2 K,F,6 MAP2 HOLDNG,B,5 : MAP2 K2,F,6 : MAP2 HINTLC(20),B,5 MAP2 FILL'VAR,B,1 MAP2 TK(20),B,2 : MAP2 LINK(200),B,2 : MAP2 WZDARK,B,5 MAP2 CLOSNG,B,5 : MAP2 LMWARN,B,5 : MAP2 DSEEN(6),B,5 MAP2 PANIC,B,5 : MAP2 GAVEUP,B,5 : MAP2 SCORNG,B,5 MAP2 MAXDIE,B,2 : MAP2 CLSSES,B,2 MAP2 FILL'REC,X,2 ! MAP1 IXREC(806),X,16,@INXREC ! MAP1 WORD1,S,10 MAP1 WORD2,S,10 ! ! THE FOLLOWING 2 EQUATES DETERMINE STATUS OF GAME. IF IDEMO IS SET TO ! FALSE, ISHORT IS IGNORED AND WE HAVE A REGULAR GAME. BUT, IF IDEMO ! IS SET TO TRUE, THEN IT IS A DEMO GAME, AND ISHORT TURNS ARE ALLOWED ! BEFORE THE USER IS KICKED OUT. ALSO, SAVE/RESTORE IS TURNED OFF IN A ! DEMO GAME ! IDEMO=FALSE ISHORT=30 !30 TURNS ON A DEMO GAME IS GOOD ! ! OPEN #3, "ADVENT.HRS",INPUT ! INPUT #3, IST,IEND,IWKST,IWKEND,ISHORT,MAGICWORD,LATNCY ! INPUT #3, MOTD ! ! CLOSE #3 ! ISTHR=IST ! IENDHR=IEND ! CALL DAYWEK !RETURNS IDAY ! IF(IDAY> 1)GOTO I140 ! ISTHR=IWKST ! IENDHR=IWKEND ! !I140: WIZARD = FALSE ! CALL TIMHR !RETURNS IHR ! ! IF(IHR>= ISTHR AND IHR<IENDHR)GOTO I700 !I150: IDEMO=FALSE ! I151: ! CALL INIT ! ! WRITE MESSAGE OF THE DAY ! ! PRINT MOTD : PRINT CALL MAIN GOTO ENDR ! ! HOURS CHECK ROUTINE PJH ! !I700: PRINT:PRINT "I'm sorry, but Colossal Cave is closed right now." ! CALL HOURS !I720: PRINT "Only WIZARDS are allowed inside the cave right now." ! PRINT : PRINT ! CALL WIZARD : IF (WIZARD)GOTO I150 ! !I800: PRINT : PRINT "We do allow short demonstration games during "; ! PRINT "prime time." : PRINT : PRINT ! INPUT "Would you like to play one ? ";IANS ! IF(IANS[1,1] # "Y")GOTO I850 ! IDEMO=TRUE ! GOTO I151 ! !I850: PRINT : PRINT "OK. As you wish....." : PRINT : PRINT : PRINT ! GOTO ENDR ! INIT: !SUBROUTINE INIT ! FILEBASE 1 RANDOMIZE ! PRINT : PRINT "There will be a short wait while we set up"; PRINT " the cave..." : PRINT : PRINT ! ! READ THE ARRAYS AS CONTIGOUOUS SECTION OF DISK FILE ! OPEN #40,"ADVENT.INX", RANDOM'FORCED, 16,RECINX FOR RECINX=1 TO 806 READ #40, IXREC(RECINX) NEXT RECINX CLOSE #40 ! OPEN #2, "ADVENT.RND", RANDOM'FORCED, 73, LINUSE ! RETURN ! MAIN: !SUBROUTINE MAIN ! ! ! WZDARK SAYS WHETHER THE LOC HE'S LEAVING WAS DARK ! LMWARN SAYS WHETHER HE'S BEEN WARNED ABOUT LAMP GOING DIM ! CLOSNG SAYS WHETHER ITS CLOSING TIME YET ! PANIC SAYS WHETHER HE'S FOUND OUT HE'S TRAPPED IN THE CAVE ! CLOSED SAYS WHETHER WE'RE ALL THE WAY CLOSED ! GAVEUP SAYS WHETHER HE EXITED VIA "QUIT" ! SCORNG INDICATES TO THE SCORE ROUTINE WHETHER WE'RE DOING A "SCORE" COMMAND ! IDEMO IS TRUE IF THIS IS A PRIME-TIME DEMONSTRATION GAME ! YES IS RANDOM YES/NO REPLY ! ! ! ! START-UP, DWARF STUFF ! 1 I=INT(RND) YESX=65:YESY=1:YESZ=0:CALL YES:HINTED(3)=YES NEWLOC=1 LOC = NEWLOC LIMIT=330 IF(HINTED(3))LIMIT=1000 ! ! CAN'T LEAVE CAVE ONCE IT'S CLOSING (EXCEPT BY MAIN OFFICE). ! 2 IF(NEWLOC >= 9 OR NEWLOC = 0 OR (NOT CLOSNG))GOTO 71 RSPKI=130:CALL RSPEAK NEWLOC=LOC IF(NOT PANIC)CLOCK2=15 PANIC= TRUE ! ! SEE IF A DWARF HAS SEEN HIM AND HAS COME FROM WHERE HE WANTS TO GO. IF SO, ! THE DWARF'S BLOCKING HIS WAY. IF COMING FROM PLACE FORBIDDEN TO PIRATE ! (DWARVES ROOTED IN PLACE) LET HIM GET OUT (AND ATTACKED). ! 71 ISHN=3 : CALL ISHFT : BITSET=(COND(LOC) AND ISHFT) # 0 IF (NEWLOC = LOC OR (COND(LOC)=2) OR BITSET) GO TO 74 ! FOR I=1 TO 5 IF(ODLOC(I) # NEWLOC OR (NOT DSEEN(I)))GOTO 73 NEWLOC=LOC RSPKI=2:CALL RSPEAK I=6 73 NEXT I 74 LOC=NEWLOC ! ! DWARF STUFF. SEE EARLIER COMMENTS FOR DESCRIPTION OF VARIABLES. REMEMBER ! SIXTH DWARF IS PIRATE AND IS THUS VERY DIFFERENT EXCEPT FOR MOTION RULES. ! ! FIRST OFF, DON'T LET THE DWARVES FOLLOW HIM INTO A PIT OR A WALL. ACTIVATE ! THE WHOLE MESS THE FIRST TIME HE GETS AS FAR AS THE HALL OF MISTS (LOC 15). ! IF NEWLOC IS FORBIDDEN TO PIRATE (IN PARTICULAR, 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. ALSO MEANS DWARVES WON'T FOLLOW HIM INTO DEAD ! END IN MAZE, BUT C'EST LA VIE. THEY'LL WAIT FOR HIM OUTSIDE THE DEAD END. ! IF(LOC=0)GOTO 2000 ISHN=3 : CALL ISHFT : BITSET=(COND(NEWLOC) AND ISHFT) # 0 IF((COND(LOC)=2) OR BITSET)GOTO 2000 ! ! IF(DFLAG # 0)GOTO 6000 IF(LOC >= 15)DFLAG=1 GOTO 2000 ! ! WHEN WE ENCOUNTER THE FIRST DWARF, WE KILL 0, 1, OR 2 OF THE 5 DWARVES. IF ! ANY OF THE SURVIVORS IS AT LOC, REPLACE HIM WITH THE ALTERNATE. ! 6000 IF(DFLAG # 1)GOTO 6010 IF (LOC < 15 OR RND<0.95)GOTO 2000 ! DFLAG=2 FOR I=1 TO 2 J=1+INT(RND*5) XYZ%=RND NEXT I IF (RND<0.50)DLOC(J)=0 ! FOR I=1 TO 5 IF(DLOC(I) = LOC)DLOC(I)=DALTLC ODLOC(I)=DLOC(I) NEXT I RSPKI=3:CALL RSPEAK OBJECT=AXE:WHERE=LOC:CALL DROP GOTO 2000 ! ! THINGS ARE IN FULL SWING. MOVE EACH DWARF AT RANDOM, EXCEPT IF HE'S SEEN US ! HE STICKS WITH US. DWARVES NEVER GO TO LOCS <15. IF WANDERING AT RANDOM, ! THEY DON'T BACK UP UNLESS THERE'S NO ALTERNATIVE. IF THEY DON'T HAVE TO ! MOVE, THEY ATTACK. AND, OF COURSE, DEAD DWARVES DON'T DO MUCH OF ANYTHING. ! 6010 DTOTAL=0 ATTACK=0 STICK=0 FOR I=1 TO 6 IF(DLOC(I) = 0)GOTO 6030 J=1 KK=DLOC(I) KK=KEY(KK) IF(KK = 0)GOTO 6016 6012 NEWLOC=TRVLOC(KK) IF NEWLOC>300 THEN GOTO 6014 ! CHECK FOR BAD SUBSCRIPT DRB ISHN=3 : CALL ISHFT : BITSET=(COND(NEWLOC) AND ISHFT) # 0 XYZHLD%=0 IF(J>1)THEN IF(NEWLOC=TK(J-1))THEN XYZHLD%=-1 IF(NEWLOC < 15 OR NEWLOC = ODLOC(I) & OR (XYZHLD%) OR J >= 20 & OR NEWLOC = DLOC(I) OR (COND(NEWLOC)=2) & OR (I = 6 AND BITSET) & OR TRVCON(KK) = 100)GOTO 6014 TK(J)=NEWLOC J=J+1 6014 KK=KK+1 IF(TRAVEL(KK-1) <=32767)GOTO 6012 6016 TK(J)=ODLOC(I) IF(J >= 2)J=J-1 J=INT(1+(RND*J)) ODLOC(I)=DLOC(I) DLOC(I)=TK(J) DSEEN(I)=(DSEEN(I) AND LOC >= 15)OR(DLOC(I)=LOC OR ODLOC(I)=LOC) IF(NOT DSEEN(I))GOTO 6030 DLOC(I)=LOC IF(I # 6)GOTO 6027 ! ! THE PIRATE'S SPOTTED HIM. HE LEAVES HIM 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 = CHLOC OR PROP(CHEST) >= 0)GOTO 6030 K=0 FOR J=50 TO MAXTRS ! PIRATE WON'T TAKE PYRAMID FROM PLOVER ROOM OR DARK ROOM (TOO EASY!). IF(J = PYRAM AND (LOC = PLAC(PYRAM) OR LOC=PLAC(EMRALD)))GOTO 6020 IF(PLACE(J) = -1)GOTO 6022 6020 OBJECT=J : CALL HERE IF( HERE )K=1 NEXT J OBJECT=LAMP : CALL HERE IF(TALLY = TALLY2+1 AND K = 0 AND PLACE(CHEST) = 0 & AND HERE AND PROP(LAMP) = 1)GOTO 6025 IF(ODLOC(6) # DLOC(6) AND RND<0.20)RSPKI=127:CALL RSPEAK GOTO 6030 ! 6022 RSPKI=128:CALL RSPEAK ! DON'T STEAL CHEST BACK FROM TROLL! IF(PLACE(MESSAG) = 0)OBJECT=CHEST:WHERE=CHLOC:CALL MOVE OBJECT=MESSAG:WHERE=CHLOC2:CALL MOVE FOR J=50 TO MAXTRS IF(J = PYRAM AND (LOC = PLAC(PYRAM) OR LOC=PLAC(EMRALD)))GOTO 6023 OBJECT=J : CALL AT IF( AT AND FIXED(J) = 0)OBJECT=J:WHERE=LOC:CALL CARRY IF(PLACE(J) = -1)OBJECT=J:WHERE=CHLOC:CALL DROP 6023 NEXT J 6024 DLOC(6)=CHLOC ODLOC(6)=CHLOC DSEEN(6)= FALSE GOTO 6030 ! 6025 RSPKI=186:CALL RSPEAK OBJECT=CHEST:WHERE=CHLOC:CALL MOVE OBJECT=MESSAG:WHERE=CHLOC2:CALL MOVE GOTO 6024 ! ! THIS THREATENING LITTLE DWARF IS IN THE ROOM WITH HIM! ! 6027 DTOTAL=DTOTAL+1 IF(ODLOC(I) # DLOC(I))GOTO 6030 ATTACK=ATTACK+1 IF(KNFLOC >= 0)KNFLOC=LOC RAND=INT(RND*1000) IF(RAND < 95*(DFLAG-2))STICK=STICK+1 6030 NEXT I ! ! NOW WE KNOW WHAT'S HAPPENING. LET'S TELL THE POOR SUCKER ABOUT IT. ! IF(DTOTAL = 0)GOTO 2000 IF(DTOTAL = 1)GOTO 75 PRINT :PRINT "There are ";DTOTAL;" threatening LITTLE DWARVES in the"; PRINT " room with you." GOTO 77 75 RSPKI=4:CALL RSPEAK 77 IF(ATTACK = 0)GOTO 2000 IF(DFLAG = 2)DFLAG=3 IF(ATTACK = 1)GOTO 79 PRINT ATTACK;" of them throw KNIVES at you!" K=6 82 IF(STICK > 1)GOTO 83 RSPKI=K+STICK:CALL RSPEAK IF(STICK = 0)GOTO 2000 GOTO 84 83 PRINT STICK;" of them GET YOU!" 84 OLDLC2=LOC GOTO 99 ! 79 RSPKI=5:CALL RSPEAK K=52 GOTO 82 ! DESCRIBE THE CURRENT LOCATION AND (MAYBE) GET NEXT COMMAND. ! ! PRINT TEXT FOR CURRENT LOC. ! 2000 IF(LOC = 0)GOTO 99 KK=STEXT(LOC) KENT=0 XYZZHLD%=ABB(LOC) B2000: IF XYZZHLD%>=ABBNUM THEN XYZZHLD%=XYZZHLD%-ABBNUM : GOTO B2000 IF (ABBNUM # 0) KENT=XYZZHLD% IF (KENT = 0 OR KK = 0) KK=LTEXT(LOC) CALL DARK IF ((COND(LOC)=2) OR (NOT DARK)) GO TO 2001 IF (WZDARK AND RND<0.35)GOTO 90 KK=RTEXT(16) 2001 IF((PLACE(BEAR) = -1))RSPKI=141:CALL RSPEAK LINUSE=KK:CALL SPEAK K=1 IF (COND(LOC)=2) GO TO 8 IF(LOC = 33 AND RND<0.25 AND (NOT CLOSNG))RSPKI=8: CALL RSPEAK ! ! 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) TILL DRAGON IS KILLED. ! SIMILARLY FOR CHAINS; PROP IS INITIALLY 1 (LOCKED TO BEAR). THESE HACKS ! ARE BECAUSE PROP=0 IS NEEDED TO GET FULL SCORE. ! CALL DARK IF(DARK)GOTO 2012 ABB(LOC)=ABB(LOC)+1 I=ATLOC(LOC) 2004 IF(I = 0)GOTO 2012 OBJ=I IF(OBJ > 100)OBJ=OBJ-100 IF(OBJ = STEPS AND (PLACE(NUGGET) = -1))GOTO 2008 IF(PROP(OBJ) >= 0)GOTO 2006 IF(CLOSED)GOTO 2008 PROP(OBJ)=0 IF(OBJ = RUG OR OBJ = CHAINS)PROP(OBJ)=1 TALLY=TALLY-1 ! IF REMAINING TREASURES TOO ELUSIVE, ZAP HIS LAMP. IF(TALLY = TALLY2 AND TALLY # 0)LIMIT=35 MIN LIMIT 2006 KK=PROP(OBJ) IF(OBJ = STEPS AND LOC = FIXED(STEPS))KK=1 MSG=OBJ:SKIP=KK:CALL PSPEAK 2008 I=LINK(I) GOTO 2004 ! 2009 K=54 2010 SPK=K 2011 RSPKI=SPK:CALL RSPEAK ! 2012 VERB=0 OBJ=0 ! ! CHECK IF THIS LOC IS ELIGIBLE FOR ANY HINTS. IF BEEN HERE LONG ENOUGH, ! BRANCH TO HELP SECTION (ON LATER PAGE). HINTS ALL COME BACK HERE EVENTUALLY ! TO FINISH THE LOOP. IGNORE "HINTS" < 4 (SPECIAL STUFF, SEE DATABASE NOTES). ! 2600 FOR HINT=4 TO HNTMAX IF(HINTED(HINT))GOTO 2602 ISHN=HINT : CALL ISHFT : BITSET=(COND(LOC) AND ISHFT) # 0 IF(NOT BITSET)HINTLC(HINT)=-1 HINTLC(HINT)=HINTLC(HINT)+1 IF(HINTLC(HINT) >= HINTS(HINT,1))HNT2=HINT:HINT=1000 2602 NEXT HINT ! DOB IF(HINT>999)HINT=HNT2:GOTO 40000 ! ! KICK THE RANDOM NUMBER GENERATOR JUST TO ADD VARIETY TO THE CHASE. ALSO, ! IF CLOSING TIME, CHECK FOR ANY OBJECTS BEING TOTED WITH PROP < 0 AND SET ! THE PROP TO -1-PROP. THIS WAY OBJECTS WON'T BE DESCRIBED UNTIL THEY'VE ! BEEN PICKED UP AND PUT DOWN SEPARATE FROM THEIR RESPECTIVE PILES. DON'T ! TICK CLOCK1 UNLESS WELL INTO CAVE (AND NOT AT Y2). ! IF(NOT CLOSED)GOTO 2605 IF(PROP(OYSTER) < 0 AND (PLACE(OYSTER) = -1))MSG=OYSTER:SKIP=1:CALL PSPEAK FOR I=1 TO 100 IF((PLACE(I) = -1) AND PROP(I) < 0)PROP(I)=-1-PROP(I) NEXT I 2605 CALL DARK WZDARK=DARK IF(KNFLOC > 0 AND KNFLOC # LOC)KNFLOC=0 I=INT(RND) CALL GETIN ! ! EVERY INPUT, CHECK "FOOBAR" FLAG. IF ZERO, NOTHING'S GOING ON. IF POS, ! MAKE NEG. IF NEG, HE SKIPPED A WORD, SO MAKE IT ZERO. ! 2608 FOOBAR=0 MIN -FOOBAR ! ! CHECK IF DEMO GAME ! IF(IDEMO = -1 AND TURNS >= ISHORT)GOTO 13000 ! IF(TURNS<>0 OR WORD1<>"MAGIC" OR WORD2<>"MODE") GOTO 2620 ! ! CALL WIZARD : IF (WIZARD)CALL MAINT ! 2620 IF(TURNS = 0 AND WORD1[1,4]="REST")GOTO 8400 ! ! TURNS=TURNS+1 IF(TALLY = 0 AND LOC >= 15 AND LOC # 33)CLOCK1=CLOCK1-1 IF(CLOCK1 = 0)GOTO 10000 IF(CLOCK1 < 0)CLOCK2=CLOCK2-1 IF(CLOCK2 = 0)GOTO 11000 IF(PROP(LAMP) = 1)LIMIT=LIMIT-1 OBJECT=BATTER : CALL HERE : HER2=HERE : OBJECT=LAMP : CALL HERE IF(LIMIT <= 30 AND HER2 AND PROP(BATTER) = 0 & AND HERE )GOTO 12000 IF(LIMIT = 0)GOTO 12400 IF(LIMIT < 0 AND LOC <= 8)GOTO 12600 IF(LIMIT <= 30)GOTO 12200 19999 K=43 LARG=LOC : CALL LIQLOC IF(LIQLOC = WATER)K=70 ! ! DO PRELIMINARY ANALYSIS OF SENTENCE TO FIND CERTAIN SPECIAL ! CASES, VIZ, ! ! ENTER <WATER,STREAM> ! ENTER <LOCATION> ! <WATER,OIL> <PLANT,DOOR> ! WORDX=WORD1 : INIT=-1 : CALL VOCAB : I=V WORDX=WORD2 : INIT = -1:CALL VOCAB:J=V IF(WORD1[1,4] # "ENTE") GO TO 2609 IF(J = (WATER+1000) OR J = STREAM) GO TO 2010 IF(WORD2#"") GO TO 2800 2609 IF((I # (WATER+1000) AND I # (OIL+1000)) & OR (J # (PLANT+1000) AND J # (DOOR+1000))) & GO TO 2610 WORD2="POUR" 2610 IF(WORD1 = "WEST" AND RND<0.10)RSPKI=17: CALL RSPEAK 2630 WORDX=WORD1 : INIT=-1 : CALL VOCAB : I=V IF(I = -1)GOTO 3000 K=I A2630: IF K>=1000 THEN K=K-1000 : GOTO A2630 KQ=INT(I/1000+1) ON KQ GOTO 8,5000,4000,2010 NUM=22 : CALL BUG ! ! GET SECOND WORD FOR ANALYSIS. ! 2800 WORD1=WORD2 WORD2="" GOTO 2610 ! ! GEE, I DON'T UNDERSTAND. ! 3000 SPK=60 IF (RND<0.20) SPK=61 IF (RND<0.20) SPK=13 RSPKI=SPK:CALL RSPEAK GOTO 2600 ! ! ANALYSE A VERB. REMEMBER WHAT IT WAS, GO BACK FOR OBJECT IF SECOND WORD ! UNLESS VERB IS "SAY", WHICH SNARFS ARBITRARY SECOND WORD. ! 4000 VERB=K SPK=ACTSPK(VERB) IF(WORD2# "" AND VERB # SAY)GOTO 2800 IF(VERB = SAY)OBJ=0 : IF (WORD2 # "")OBJ=-1 IF(OBJ # 0)GOTO 4090 ! ! ANALYSE AN INTRANSITIVE VERB (IE, NO OBJECT GIVEN YET). ! 4080 ON VERB GOTO 8010,8000,8000,8040,2009,8040,9070,9080,8000,8000, & 2011,9120,9130,8140,9150,8000,8000,8180,8000,8200, & 8000,9220,9230,8240,8250,8260,8270,8000,8000,8300, & 8310 ! TAKE DROP SAY OPEN NOTH LOCK ON OFF WAVE CALM ! WALK KILL POUR EAT DRNK RUB TOSS QUIT FIND INVN ! FEED FILL BLST SCOR FOO BRF READ BREK WAKE SUSP ! HOUR NUM= 23 : CALL BUG ! ! ANALYSE A TRANSITIVE VERB. ! 4090 ON VERB GOTO 9010,9020,9030,9040,2009,9040,9070,9080,9090,2011, & 2011,9120,9130,9140,9150,9160,9170,2011,9190,9190, & 9210,9220,9230,2011,2011,2011,9270,9280,9290,2011, & 2011 ! TAKE DROP SAY OPEN NOTH LOCK ON OFF WAVE CALM ! WALK KILL POUR EAT DRNK RUB TOSS QUIT FIND INVN ! FEED FILL BLST SCOR FOO BRF READ BREK WAKE SUSP ! HOUR NUM=24 : CALL BUG ! ! ANALYSE AN OBJECT WORD. SEE IF THE THING IS HERE, WHETHER WE'VE GOT A VERB ! YET, AND SO ON. OBJECT MUST BE HERE UNLESS VERB IS "FIND" OR "INVENT(ORY)" ! (AND NO NEW VERB YET TO BE ANALYSED). WATER AND OIL ARE ALSO FUNNY, SINCE ! THEY ARE NEVER ACTUALLY DROPPED AT ANY LOCATION, BUT MIGHT BE HERE INSIDE ! THE BOTTLE OR AS A FEATURE OF THE LOCATION. ! 5000 OBJ=K OBJECT=K : CALL HERE IF(FIXED(K) # LOC AND (NOT HERE))GOTO 5100 5010 IF(WORD2 # "")GOTO 2800 IF(VERB # 0)GOTO 4090 5015 PRINT "What do you want to do with the ";WORD1;"?" GOTO 2600 ! 5100 IF(K # GRATE)GOTO 5110 IF(LOC = 1 OR LOC = 4 OR LOC = 7)K=DPRSSN IF(LOC > 9 AND LOC < 15)K=ENTRNC IF(K # GRATE)GOTO 8 5110 IF(K # DWARF)GOTO 5120 FOR I=1 TO 5 IF(DLOC(I) = LOC AND DFLAG >= 2)GOTO 5010 5112 NEXT I 5120 CALL LIQ OBJECT=BOTTLE : CALL HERE LARG=LOC : CALL LIQLOC IF((LIQ = K AND HERE ) OR K = LIQLOC)GOTO 5010 OBJECT=PLANT2 : CALL AT IF(OBJ # PLANT OR (NOT AT) OR PROP(PLANT2) = 0)GOTO 5130 OBJ=PLANT2 GOTO 5010 5130 IF(OBJ # KNIFE OR KNFLOC # LOC)GOTO 5140 KNFLOC=-1 SPK=116 GOTO 2011 5140 OBJECT=ROD2 : CALL HERE IF(OBJ # ROD OR (NOT HERE))GOTO 5190 OBJ=ROD2 GOTO 5010 5190 IF((VERB = FIND OR VERB = INVENT) AND WORD2="")GOTO 5010 PRINT "I don't see any ";WORD1;"." GOTO 2012 ! FIGURE OUT THE NEW LOCATION ! ! GIVEN THE CURRENT LOCATION IN "LOC", AND A MOTION VERB NUMBER IN "K", PUT ! THE NEW LOCATION IN "NEWLOC". THE CURRENT LOC IS SAVED IN "OLDLOC" IN CASE ! HE WANTS TO RETREAT. THE CURRENT OLDLOC IS SAVED IN OLDLC2, IN CASE HE ! DIES. (IF HE DOES, NEWLOC WILL BE LIMBO, AND OLDLOC WILL BE WHAT KILLED ! HIM, SO WE NEED OLDLC2, WHICH IS THE LAST PLACE HE WAS SAFE.) ! 8 KK=KEY(LOC) NEWLOC=LOC IF(KK = 0)NUM=26 : CALL BUG IF(K = NULL)GOTO 2 IF(K = BACK)GOTO 20 IF(K = LOOK)GOTO 30 IF(K = CAVE)GOTO 40 OLDLC2=OLDLOC OLDLOC=LOC ! 9 LL=TRAVEL(KK) : IF TRAVEL(KK)>32767 THEN LL=65536-TRAVEL(KK) IF(LL = 1 OR LL = K)GOTO 10 IF(TRAVEL(KK) >32767)GOTO 50 KK=KK+1 GOTO 9 ! 10 NEWLOC=TRVCON(KK) K=NEWLOC A10A: IF K>=100 THEN K=K-100 : GOTO A10A IF(NEWLOC <= 300)GOTO 13 IF(PROP(K) # INT(NEWLOC/100-3))GOTO 16 12 IF(TRAVEL(KK) >32767)NUM=25 : CALL BUG KK=KK+1 GO TO 10 ! 13 IF(NEWLOC <= 100)GOTO 14 OBJECT=K : CALL AT IF((PLACE(K) = -1) OR (NEWLOC > 200 AND AT ))GOTO 16 GOTO 12 ! 14 RAND=INT(RND*100) IF(NEWLOC # 0 AND RAND>=NEWLOC) GO TO 12 16 NEWLOC=TRVLOC(KK) IF(NEWLOC <= 300)GOTO 2 IF(NEWLOC <= 500)GOTO 30000 RSPKI=NEWLOC-500:CALL RSPEAK NEWLOC=LOC GOTO 2 ! ! SPECIAL MOTIONS COME HERE. LABELLING CONVENTION: STATEMENT NUMBERS NNNXX ! (XX=00-99) ARE USED FOR SPECIAL CASE NUMBER NNN (NNN=301-500). ! 30000 NEWLOC=NEWLOC-300 ON NEWLOC GOTO 30100,30200,30300 NUM=20 :CALL BUG ! ! TRAVEL 301. PLOVER-ALCOVE PASSAGE. CAN CARRY ONLY EMERALD. NOTE: TRAVEL ! TABLE MUST INCLUDE "USELESS" ENTRIES GOING THROUGH PASSAGE, WHICH CAN NEVER ! BE USED FOR ACTUAL MOTION, BUT CAN BE SPOTTED BY "GO BACK". ! 30100 NEWLOC=99+100-LOC IF(HOLDNG = 0 OR (HOLDNG = 1 AND (PLACE(EMRALD) = -1)))GOTO 2 NEWLOC=LOC RSPKI=117:CALL RSPEAK GOTO 2 ! ! TRAVEL 302. PLOVER TRANSPORT. DROP THE EMERALD (ONLY USE SPECIAL TRAVEL IF ! TOTING IT), SO HE'S FORCED TO USE THE PLOVER-PASSAGE TO GET IT OUT. HAVING ! DROPPED IT, GO BACK AND PRETEND HE WASN'T CARRYING IT AFTER ALL. ! 30200 OBJECT=EMRALD:WHERE=LOC:CALL DROP GOTO 12 ! ! TRAVEL 303. TROLL BRIDGE. MUST BE DONE ONLY AS SPECIAL MOTION SO THAT ! DWARVES WON'T WANDER ACROSS AND ENCOUNTER THE BEAR. (THEY WON'T FOLLOW THE ! PLAYER THERE BECAUSE THAT REGION IS FORBIDDEN TO THE PIRATE.) IF ! PROP(TROLL)=1, HE'S CROSSED SINCE PAYING, SO STEP OUT AND BLOCK HIM. ! (STANDARD TRAVEL ENTRIES CHECK FOR PROP(TROLL)=0.) SPECIAL STUFF FOR BEAR. ! 30300 IF(PROP(TROLL) # 1)GOTO 30310 MSG=TROLL:SKIP=1:CALL PSPEAK PROP(TROLL)=0 OBJECT=TROLL2 : WHERE=0:CALL MOVE OBJECT=TROLL2+100:WHERE=0:CALL MOVE OBJECT=TROLL:WHERE=PLAC(TROLL):CALL MOVE OBJECT=TROLL+100:WHERE=FIXD(TROLL):CALL MOVE OBJECT=CHASM:CALL JUGGLE NEWLOC=LOC GOTO 2 ! 30310 NEWLOC=PLAC(TROLL)+FIXD(TROLL)-LOC IF(PROP(TROLL) = 0)PROP(TROLL)=1 IF((NOT PLACE(BEAR)=-1))GOTO 2 RSPKI=162:CALL RSPEAK PROP(CHASM)=1 PROP(TROLL)=2 OBJECT=BEAR:WHERE=NEWLOC:CALL DROP FIXED(BEAR)=-1 PROP(BEAR)=3 IF(PROP(SPICES) < 0)TALLY2=TALLY2+1 OLDLC2=NEWLOC GOTO 99 ! ! END OF SPECIALS. ! ! HANDLE "GO BACK". LOOK FOR VERB WHICH GOES FROM LOC TO OLDLOC, OR TO OLDLC2 ! IF OLDLOC HAS FORCED-MOTION. K2 SAVES ENTRY -> FORCED LOC -> PREVIOUS LOC. ! 20 K=OLDLOC IF (COND(K)=2) K=OLDLC2 OLDLC2=OLDLOC OLDLOC=LOC K2=0 IF(K # LOC)GOTO 21 RSPKI=91:CALL RSPEAK GOTO 2 ! 21 LL=TRVLOC(KK) IF(LL = K)GOTO 25 IF(LL > 300)GOTO 22 J=KEY(LL) IF (COND(LL)=2 AND TRVLOC(KK) = K) K2=KK 22 IF(TRAVEL(KK) >32767)GOTO 23 KK=KK+1 GOTO 21 ! 23 KK=K2 IF(KK # 0)GOTO 25 RSPKI=140:CALL RSPEAK GOTO 2 ! 25 K=TRAVEL(KK) : IF K>32767 THEN K=65536-TRAVEL(KK) KK=KEY(LOC) GOTO 9 ! ! LOOK. CAN'T GIVE MORE DETAIL. PRETEND IT WASN'T DARK (THOUGH IT MAY "NOW" ! BE DARK) SO HE WON'T FALL INTO A PIT WHILE STARING INTO THE GLOOM. ! 30 IF(DETAIL < 3)RSPKI=15:CALL RSPEAK DETAIL=DETAIL+1 WZDARK= FALSE ABB(LOC)=0 GOTO 2 ! ! CAVE. DIFFERENT MESSAGES DEPENDING ON WHETHER ABOVE GROUND. ! 40 IF(LOC < 8)RSPKI=57:CALL RSPEAK IF(LOC >= 8)RSPKI=58:CALL RSPEAK GOTO 2 ! ! NON-APPLICABLE MOTION. VARIOUS MESSAGES DEPENDING ON WORD GIVEN. ! 50 SPK=12 IF(K >= 43 AND K <= 50)SPK=9 IF(K = 29 OR K = 30)SPK=9 IF(K = 7 OR K = 36 OR K = 37)SPK=10 IF(K = 11 OR K = 19)SPK=11 IF(VERB = FIND OR VERB = INVENT)SPK=59 IF(K = 62 OR K = 65)SPK=42 IF(K = 17)SPK=80 RSPKI=SPK:CALL RSPEAK GOTO 2 ! ! "YOU'RE DEAD, JIM." ! ! IF THE CURRENT LOC IS ZERO, IT MEANS THE CLOWN GOT HIMSELF KILLED. WE'LL ! ALLOW THIS MAXDIE TIMES. MAXDIE IS AUTOMATICALLY SET BASED ON THE NUMBER OF ! SNIDE MESSAGES AVAILABLE. EACH DEATH RESULTS IN A MESSAGE (81, 83, ETC.) ! WHICH OFFERS REINCARNATION; IF ACCEPTED, THIS RESULTS IN MESSAGE 82, 84, ! ETC. THE LAST TIME, IF HE WANTS ANOTHER CHANCE, HE GETS A SNIDE REMARK AS ! WE EXIT. WHEN REINCARNATED, ALL OBJECTS BEING CARRIED GET DROPPED AT OLDLC2 ! (PRESUMABLY THE LAST PLACE PRIOR TO BEING KILLED) WITHOUT CHANGE OF PROPS. ! THE LOOP RUNS BACKWARDS TO ASSURE THAT THE BIRD IS DROPPED BEFORE THE CAGE. ! (THIS KLUGE COULD BE CHANGED ONCE WE'RE SURE ALL REFERENCES TO BIRD AND CAGE ! ARE DONE BY KEYWORDS.) THE LAMP IS A SPECIAL CASE (IT WOULDN'T DO TO LEAVE ! IT IN THE CAVE). IT IS TURNED OFF AND LEFT OUTSIDE THE BUILDING (ONLY IF HE ! WAS CARRYING IT, OF COURSE). HE HIMSELF IS LEFT INSIDE THE BUILDING (AND ! HEAVEN HELP HIM IF HE TRIES TO XYZZY BACK INTO THE CAVE WITHOUT THE LAMP!). ! OLDLOC IS ZAPPED SO HE CAN'T JUST "RETREAT". ! ! THE EASIEST WAY TO GET KILLED IS TO FALL INTO A PIT IN PITCH DARKNESS. ! 90 RSPKI=23:CALL RSPEAK OLDLC2=LOC ! ! OKAY, HE'S DEAD. LET'S GET ON WITH IT. ! 99 IF(CLOSNG)GOTO 95 YESX=81+NUMDIE*2:YESY=82+NUMDIE*2:YESZ=54:CALL YES YEA=YES NUMDIE=NUMDIE+1 IF(NUMDIE = MAXDIE OR (NOT YEA))GOTO 20000 PLACE(WATER)=0 PLACE(OIL)=0 IF((PLACE(LAMP) = -1))PROP(LAMP)=0 FOR J=1 TO 100 I=101-J IF((NOT PLACE(I)=-1))GOTO 98 K=OLDLC2 IF(I = LAMP)K=1 OBJECT=I:WHERE=K:CALL DROP 98 NEXT J LOC=3 OLDLOC=LOC GOTO 2000 ! ! HE DIED DURING CLOSING TIME. NO RESURRECTION. TALLY UP A DEATH AND EXIT. ! 95 RSPKI=131:CALL RSPEAK NUMDIE=NUMDIE+1 GOTO 20000 ! ROUTINES FOR PERFORMING THE VARIOUS ACTION VERBS ! ! STATEMENT NUMBERS IN THIS SECTION ARE 8000 FOR INTRANSITIVE VERBS, 9000 FOR ! TRANSITIVE, PLUS TEN TIMES THE VERB NUMBER. MANY INTRANSITIVE VERBS USE THE ! TRANSITIVE CODE, AND SOME VERBS USE CODE FOR OTHER VERBS, AS NOTED BELOW. ! ! RANDOM INTRANSITIVE VERBS COME HERE. CLEAR OBJ JUST IN CASE (SEE "ATTACK"). ! 8000 PRINT "I don't understand ";WORD1;"." OBJ=0 GOTO 2600 ! ! CARRY, NO OBJECT GIVEN YET. OK IF ONLY ONE OBJECT PRESENT. ! 8010 IF(ATLOC(LOC) = 0 OR LINK(ATLOC(LOC)) # 0)GOTO 8000 FOR I=1 TO 5 IF(DLOC(I) = LOC AND DFLAG >= 2)GOTO 8000 8012 NEXT I OBJ=ATLOC(LOC) ! ! CARRY AN OBJECT. SPECIAL CASES FOR BIRD AND CAGE (IF BIRD IN CAGE, CAN'T ! TAKE ONE WITHOUT THE OTHER. LIQUIDS ALSO SPECIAL, SINCE THEY DEPEND ON ! STATUS OF BOTTLE. ALSO VARIOUS SIDE EFFECTS, ETC. ! 9010 IF((PLACE(OBJ) = -1))GOTO 2011 SPK=25 IF(OBJ = PLANT AND PROP(PLANT) <= 0)SPK=115 IF(OBJ = BEAR AND PROP(BEAR) = 1)SPK=169 IF(OBJ = CHAINS AND PROP(BEAR) # 0)SPK=170 IF(FIXED(OBJ) # 0)GOTO 2011 IF(OBJ # WATER AND OBJ # OIL)GOTO 9017 CALL LIQ OBJECT=BOTTLE : CALL HERE IF( HERE AND LIQ = OBJ)GOTO 9018 OBJ=BOTTLE IF((PLACE(BOTTLE) = -1) AND PROP(BOTTLE) = 1)GOTO 9220 IF(PROP(BOTTLE) # 1)SPK=105 IF((NOT PLACE(BOTTLE)=-1))SPK=104 GOTO 2011 9018 OBJ=BOTTLE 9017 IF(HOLDNG < 7)GOTO 9016 RSPKI=92:CALL RSPEAK GOTO 2012 9016 IF(OBJ # BIRD)GOTO 9014 IF(PROP(BIRD) # 0)GOTO 9014 IF((NOT PLACE(ROD)=-1))GOTO 9013 RSPKI=26:CALL RSPEAK GOTO 2012 9013 IF((PLACE(CAGE) = -1))GOTO 9015 RSPKI=27:CALL RSPEAK GOTO 2012 9015 PROP(BIRD)=1 9014 IF((OBJ = BIRD OR OBJ = CAGE) AND PROP(BIRD) # 0) & OBJECT=BIRD+CAGE-OBJ:WHERE=LOC:CALL CARRY OBJECT=OBJ:WHERE=LOC:CALL CARRY CALL LIQ K=LIQ IF(OBJ = BOTTLE AND K # 0)PLACE(K)=-1 GOTO 2009 ! ! 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 AT VENDING MACHINE FOR EXTRA BATTERIES. ! 9020 IF((PLACE(ROD2) = -1) AND OBJ = ROD AND (NOT PLACE(ROD)#-1))OBJ=ROD2 IF((NOT PLACE(OBJ)=-1))GOTO 2011 OBJECT=SNAKE : CALL HERE IF(OBJ # BIRD OR (NOT HERE))GOTO 9024 RSPKI=30:CALL RSPEAK IF(CLOSED)GOTO 19000 OBJECT=SNAKE:CALL DSTROY ! SET PROP FOR USE BY TRAVEL OPTIONS PROP(SNAKE)=1 9021 CALL LIQ K=LIQ IF(K = OBJ)OBJ=BOTTLE IF(OBJ = BOTTLE AND K # 0)PLACE(K)=0 IF(OBJ = CAGE AND PROP(BIRD) # 0)OBJECT=BIRD:WHERE=LOC:CALL DROP IF(OBJ = BIRD)PROP(BIRD)=0 OBJECT=OBJ:WHERE=LOC:CALL DROP GOTO 2012 ! 9024 OBJECT=VEND : CALL HERE IF(OBJ # COINS OR (NOT HERE))GOTO 9025 OBJECT=COINS:CALL DSTROY OBJECT=BATTER:WHERE=LOC:CALL DROP MSG=BATTER:SKIP=0:CALL PSPEAK GOTO 2012 ! 9025 OBJECT=DRAGON : CALL AT IF(OBJ # BIRD OR (NOT AT) OR PROP(DRAGON) # 0)GOTO 9026 RSPKI=154:CALL RSPEAK OBJECT=BIRD:CALL DSTROY PROP(BIRD)=0 IF(PLACE(SNAKE) = PLAC(SNAKE))TALLY2=TALLY2+1 GOTO 2012 ! 9026 OBJECT=TROLL : CALL AT IF(OBJ # BEAR OR (NOT AT))GOTO 9027 RSPKI=163:CALL RSPEAK OBJECT=TROLL:WHERE=0:CALL MOVE OBJECT=TROLL+100:WHERE=0:CALL MOVE OBJECT=TROLL2:WHERE=PLAC(TROLL):CALL MOVE OBJECT=TROLL2+100:WHERE=FIXD(TROLL):CALL MOVE OBJECT=CHASM:CALL JUGGLE PROP(TROLL)=2 GOTO 9021 ! 9027 IF(OBJ = VASE AND LOC # PLAC(PILLOW))GOTO 9028 RSPKI=54:CALL RSPEAK GOTO 9021 ! 9028 PROP(VASE)=2 OBJECT=PILLOW : CALL AT IF( AT )PROP(VASE)=0 MSG=VASE:SKIP=PROP(VASE)+1:CALL PSPEAK IF(PROP(VASE) # 0)FIXED(VASE)=-1 GOTO 9021 ! ! SAY. ECHO WORD2 (OR WORD1 IF NO WD2 (SAY WHAT?, ETC.).) MAGIC WORDS OVERRIDE. ! 9030 IF WORD2<>"" THEN WORD1=WORD2 : WORD1X=WORD2X 9031 WORDX=WORD1 :INIT=-1:CALL VOCAB:I=V IF(I = 62 OR I = 65 OR I = 71 OR I = 2025)GOTO 9035 9032 PRINT "Okay, '";WORD1;"'." GOTO 2012 ! 9035 WORD2="" OBJ=0 GOTO 2630 ! ! LOCK, UNLOCK, NO OBJECT GIVEN. ASSUME VARIOUS THINGS IF PRESENT. ! 8040 SPK=28 OBJECT=CLAM : CALL HERE IF( HERE )OBJ=CLAM OBJECT=OYSTER : CALL HERE IF( HERE )OBJ=OYSTER OBJECT=DOOR : CALL AT IF( AT )OBJ=DOOR OBJECT=GRATE : CALL AT IF( AT )OBJ=GRATE OBJECT=CHAINS : CALL HERE IF(OBJ # 0 AND HERE )GOTO 8000 OBJECT=CHAINS : CALL HERE IF( HERE )OBJ=CHAINS IF(OBJ = 0)GOTO 2011 ! ! LOCK, UNLOCK OBJECT. SPECIAL STUFF FOR OPENING CLAM/OYSTER AND FOR CHAINS. ! 9040 IF(OBJ = CLAM OR OBJ = OYSTER)GOTO 9046 IF(OBJ = DOOR)SPK=111 IF(OBJ = DOOR AND PROP(DOOR) = 1)SPK=54 IF(OBJ = CAGE)SPK=32 IF(OBJ = KEYS)SPK=55 IF(OBJ = GRATE OR OBJ = CHAINS)SPK=31 OBJECT=KEYS : CALL HERE IF(SPK # 31 OR (NOT HERE))GOTO 2011 IF(OBJ = CHAINS)GOTO 9048 IF(NOT CLOSNG)GOTO 9043 K=130 IF(NOT PANIC)CLOCK2=15 PANIC= TRUE GOTO 2010 ! 9043 K=34+PROP(GRATE) PROP(GRATE)=1 IF (VERB = ALOCK) PROP(GRATE)=0 K=K+2*PROP(GRATE) GOTO 2010 ! ! CLAM/OYSTER. 9046 K=0 IF(OBJ = OYSTER)K=1 SPK=124+K IF((PLACE(OBJ) = -1))SPK=120+K IF((NOT PLACE(TRIDNT)=-1))SPK=122+K IF (VERB = ALOCK) SPK=61 IF(SPK # 124)GOTO 2011 OBJECT=CLAM:CALL DSTROY OBJECT=OYSTER:WHERE=LOC:CALL DROP OBJECT=PEARL:WHERE=105:CALL DROP GOTO 2011 ! ! CHAINS. 9048 IF (VERB = ALOCK) GOTO 9049 SPK=171 IF(PROP(BEAR) = 0)SPK=41 IF(PROP(CHAINS) = 0)SPK=37 IF(SPK # 171)GOTO 2011 PROP(CHAINS)=0 FIXED(CHAINS)=0 IF(PROP(BEAR) # 3)PROP(BEAR)=2 FIXED(BEAR)=2-PROP(BEAR) GOTO 2011 ! 9049 SPK=172 IF(PROP(CHAINS) # 0)SPK=34 IF(LOC # PLAC(CHAINS))SPK=173 IF(SPK # 172)GOTO 2011 PROP(CHAINS)=2 IF((PLACE(CHAINS) = -1))OBJECT=CHAINS:WHERE=LOC:CALL DROP FIXED(CHAINS)=-1 GOTO 2011 ! ! LIGHT LAMP ! 9070 OBJECT=LAMP : CALL HERE IF(NOT HERE )GOTO 2011 SPK=184 IF(LIMIT < 0)GOTO 2011 PROP(LAMP)=1 RSPKI=39:CALL RSPEAK IF(WZDARK)GOTO 2000 GOTO 2012 ! ! LAMP OFF ! 9080 OBJECT=LAMP : CALL HERE IF(NOT HERE )GOTO 2011 PROP(LAMP)=0 RSPKI=40:CALL RSPEAK CALL DARK IF(DARK)RSPKI=16:CALL RSPEAK GOTO 2012 ! ! WAVE. NO EFFECT UNLESS WAVING ROD AT FISSURE. ! 9090 IF((NOT PLACE(OBJ)=-1) AND (OBJ # ROD OR (NOT PLACE(ROD2)=-1)))SPK=29 OBJECT=FISSUR : CALL AT IF(OBJ # ROD OR (NOT AT) OR (NOT PLACE(OBJ)=-1) OR CLOSNG)GOTO 2011 PROP(FISSUR)=1-PROP(FISSUR) MSG=FISSUR:SKIP=2-PROP(FISSUR):CALL PSPEAK GOTO 2012 ! ! ATTACK. ASSUME TARGET IF UNAMBIGUOUS. "THROW" ALSO LINKS HERE. ATTACKABLE ! OBJECTS FALL INTO TWO CATEGORIES: ENEMIES (SNAKE, DWARF, ETC.) AND OTHERS ! (BIRD, CLAM). AMBIGUOUS IF TWO ENEMIES, OR IF NO ENEMIES BUT TWO OTHERS. ! 9120 FOR I=1 TO 5 IF(DLOC(I) = LOC AND DFLAG >= 2)II=1 : I=1000 9121 NEXT I IF(I>999)I=II : GOTO 9122 I=0 9122 IF(OBJ # 0)GOTO 9124 IF(I # 0)OBJ=DWARF OBJECT=SNAKE : CALL HERE IF( HERE )OBJ=OBJ*100+SNAKE OBJECT=DRAGON : CALL AT IF( AT AND PROP(DRAGON) = 0)OBJ=OBJ*100+DRAGON OBJECT=TROLL : CALL AT IF( AT )OBJ=OBJ*100+TROLL OBJECT=BEAR : CALL HERE IF( HERE AND PROP(BEAR) = 0)OBJ=OBJ*100+BEAR IF(OBJ > 100)GOTO 8000 IF(OBJ # 0)GOTO 9124 ! CAN'T ATTACK BIRD BY THROWING AXE. OBJECT=BIRD : CALL HERE IF( HERE AND VERB # THROW)OBJ=BIRD ! CLAM AND OYSTER BOTH TREATED AS CLAM FOR INTRANSITIVE CASE; NO HARM DONE. OBJECT=CLAM : CALL HERE HER2=HERE:OBJECT=OYSTER:CALL HERE IF( HER2 OR HERE)OBJ=100*OBJ+CLAM IF(OBJ > 100)GOTO 8000 9124 IF(OBJ # BIRD)GOTO 9125 SPK=137 IF(CLOSED)GOTO 2011 OBJECT=BIRD:CALL DSTROY PROP(BIRD)=0 IF(PLACE(SNAKE) = PLAC(SNAKE))TALLY2=TALLY2+1 SPK=45 9125 IF(OBJ = 0)SPK=44 IF(OBJ = CLAM OR OBJ = OYSTER)SPK=150 IF(OBJ = SNAKE)SPK=46 IF(OBJ = DWARF)SPK=49 IF(OBJ = DWARF AND CLOSED)GOTO 19000 IF(OBJ = DRAGON)SPK=167 IF(OBJ = TROLL)SPK=157 IF(OBJ = BEAR)SPK=INT(165+(PROP(BEAR)+1)/2) IF(OBJ # DRAGON OR PROP(DRAGON) # 0)GOTO 2011 ! FUN STUFF FOR DRAGON. IF HE INSISTS ON ATTACKING IT, WIN! SET PROP TO DEAD, ! MOVE DRAGON TO CENTRAL LOC (STILL FIXED), MOVE RUG THERE (NOT FIXED), AND ! MOVE HIM THERE, TOO. THEN DO A NULL MOTION TO GET NEW DESCRIPTION. RSPKI=49:CALL RSPEAK VERB=0 OBJ=0 CALL GETIN IF(WORD1[1,1]#"Y")GOTO 2608 MSG=DRAGON:SKIP=1:CALL PSPEAK PROP(DRAGON)=2 PROP(RUG)=0 K=INT((PLAC(DRAGON)+FIXD(DRAGON))/2) OBJECT=DRAGON+100:WHERE=-1:CALL MOVE OBJECT=RUG+100:WHERE=0:CALL MOVE OBJECT=DRAGON:WHERE=K:CALL MOVE OBJECT=RUG:WHERE=K:CALL MOVE FOR XOBJ=1 TO 100:OBJ=XOBJ IF(PLACE(OBJ) = PLAC(DRAGON) OR PLACE(OBJ) = FIXD(DRAGON)) & OBJECT=OBJ:WHERE=K:CALL MOVE 9126 NEXT XOBJ:OBJ=XOBJ LOC=K K=NULL GOTO 8 ! ! POUR. IF NO OBJECT, OR OBJECT IS BOTTLE, ASSUME CONTENTS OF BOTTLE. ! SPECIAL TESTS FOR POURING WATER OR OIL ON PLANT OR RUSTY DOOR. ! 9130 CALL LIQ IF(OBJ = BOTTLE OR OBJ = 0)OBJ=LIQ IF(OBJ = 0)GOTO 8000 IF((NOT PLACE(OBJ)=-1))GOTO 2011 SPK=78 IF(OBJ # OIL AND OBJ # WATER)GOTO 2011 PROP(BOTTLE)=1 PLACE(OBJ)=0 SPK=77 OBJECT=PLANT : CALL AT:AT2=AT:OBJECT=DOOR:CALL AT IF(NOT (AT2 OR AT))GOTO 2011 ! OBJECT=DOOR : CALL AT IF(AT)GOTO 9132 SPK=112 IF(OBJ # WATER)GOTO 2011 MSG=PLANT:SKIP=PROP(PLANT)+1:CALL PSPEAK XYZHLD%=PROP(PLANT)+2 A9130: IF(XYZHLD%>=6)XYZHLD%=XYZHLD%-6:GOTO A9130 PROP(PLANT)=XYZHLD% PROP(PLANT2)=XYZHLD%/2 K=NULL GOTO 8 ! 9132 PROP(DOOR)=0 IF(OBJ = OIL)PROP(DOOR)=1 SPK=113+PROP(DOOR) GOTO 2011 ! ! EAT. INTRANSITIVE: ASSUME FOOD IF PRESENT, ELSE ASK WHAT. TRANSITIVE: FOOD ! OK, SOME THINGS LOSE APPETITE, REST ARE RIDICULOUS. ! 8140 OBJECT=FOOD : CALL HERE IF(NOT HERE )GOTO 8000 8142 OBJECT=FOOD:CALL DSTROY SPK=72 GOTO 2011 ! 9140 IF(OBJ = FOOD)GOTO 8142 IF(OBJ = BIRD OR OBJ = SNAKE OR OBJ = CLAM OR OBJ = OYSTER & OR OBJ = DWARF OR OBJ = DRAGON OR OBJ = TROLL & OR OBJ = BEAR)SPK=71 GOTO 2011 ! ! DRINK. IF NO OBJECT, ASSUME WATER AND LOOK FOR IT HERE. IF WATER IS IN ! THE BOTTLE, DRINK THAT, ELSE MUST BE AT A WATER LOC, SO DRINK STREAM. ! 9150 CALL LIQ OBJECT=BOTTLE : CALL HERE LARG=LOC : CALL LIQLOC IF(OBJ = 0 AND LIQLOC # WATER AND (LIQ # WATER & OR (NOT HERE)))GOTO 8000 IF(OBJ # 0 AND OBJ # WATER)SPK=110 CALL LIQ OBJECT=BOTTLE : CALL HERE IF(SPK = 110 OR LIQ # WATER OR (NOT HERE))GOTO 2011 PROP(BOTTLE)=1 PLACE(WATER)=0 SPK=74 GOTO 2011 ! ! RUB. YIELDS VARIOUS SNIDE REMARKS. ! 9160 IF(OBJ # LAMP)SPK=76 GOTO 2011 ! ! THROW. SAME AS DISCARD UNLESS AXE. THEN SAME AS ATTACK EXCEPT IGNORE BIRD, ! AND IF DWARF IS PRESENT THEN ONE MIGHT BE KILLED. (ONLY WAY TO DO SO!) ! AXE ALSO SPECIAL FOR DRAGON, BEAR, AND TROLL. TREASURES SPECIAL FOR TROLL. ! 9170 IF(PLACE(ROD2)=-1 AND OBJ = ROD AND (NOT PLACE(ROD)=-1))OBJ=ROD2 IF((NOT PLACE(OBJ)=-1))GOTO 2011 OBJECT=TROLL : CALL AT IF(OBJ >= 50 AND OBJ <= MAXTRS AND AT )GOTO 9178 OBJECT=BEAR : CALL HERE IF(OBJ = FOOD AND HERE )GOTO 9177 IF(OBJ # AXE)GOTO 9020 FOR I=1 TO 5 ! NEEDN'T CHECK DFLAG IF AXE IS HERE. IF(DLOC(I) = LOC)GOTO 9172 9171 NEXT I SPK=152 OBJECT=DRAGON : CALL AT IF( AT AND PROP(DRAGON) = 0)GOTO 9175 SPK=158 OBJECT=TROLL : CALL AT IF( AT )GOTO 9175 OBJECT=BEAR : CALL HERE IF( HERE AND PROP(BEAR) = 0)GOTO 9176 OBJ=0 GOTO 9120 ! 9172 SPK=48 IF(RND < 0.33)GOTO 9175 DSEEN(I)= FALSE DLOC(I)=0 SPK=47 DKILL=DKILL+1 IF(DKILL = 1)SPK=149 9175 RSPKI=SPK:CALL RSPEAK OBJECT=AXE:WHERE=LOC:CALL DROP K=NULL GOTO 8 ! ! THIS'LL TEACH HIM TO THROW THE AXE AT THE BEAR! 9176 SPK=164 OBJECT=AXE:WHERE=LOC:CALL DROP FIXED(AXE)=-1 PROP(AXE)=1 OBJECT=BEAR:CALL JUGGLE GOTO 2011 ! ! BUT THROWING FOOD IS ANOTHER STORY. 9177 OBJ=BEAR GOTO 9210 ! 9178 SPK=159 ! SNARF A TREASURE FOR THE TROLL. OBJECT=OBJ:WHERE=0:CALL DROP OBJECT=TROLL:WHERE=0:CALL MOVE OBJECT=TROLL+100:WHERE=0:CALL MOVE OBJECT=TROLL2:WHERE=PLAC(TROLL):CALL DROP OBJECT=TROLL2+100:WHERE=FIXD(TROLL):CALL DROP OBJECT=CHASM:CALL JUGGLE GOTO 2011 ! ! QUIT. INTRANSITIVE ONLY. VERIFY INTENT AND EXIT IF THAT'S WHAT HE WANTS. ! 8180 YESX=22:YESY=54:YESZ=54:CALL YES:GAVEUP=YES 8185 IF(GAVEUP)GOTO 20000 GOTO 2012 ! ! FIND. MIGHT BE CARRYING IT, OR IT MIGHT BE HERE. ELSE GIVE CAVEAT. ! 9190 CALL LIQ OBJECT=OBJ : CALL AT :AT2=AT:OBJECT=BOTTLE:CALL AT LARG=LOC : CALL LIQLOC IF( AT2 OR (LIQ = OBJ AND AT) OR K=LIQLOC)SPK=94 FOR I=1 TO 5 9192 IF(DLOC(I) = LOC AND DFLAG >= 2 AND OBJ = DWARF)SPK=94 NEXT I IF(CLOSED)SPK=138 IF((PLACE(OBJ) = -1))SPK=24 GOTO 2011 ! ! INVENTORY. IF OBJECT, TREAT SAME AS FIND. ELSE REPORT ON CURRENT BURDEN. ! 8200 SPK=98 FOR I=1 TO 80 IF(I = BEAR OR (NOT PLACE(I)=-1))GOTO 8201 IF(SPK = 98)RSPKI=99:CALL RSPEAK BLKLIN= FALSE MSG=I:SKIP=-1:CALL PSPEAK BLKLIN= TRUE SPK=0 8201 NEXT I IF(PLACE(BEAR) = -1)SPK=141 GOTO 2011 ! ! FEED. IF BIRD, NO SEED. SNAKE, DRAGON, TROLL: QUIP. IF DWARF, MAKE HIM ! MAD. BEAR, SPECIAL. ! 9210 IF(OBJ # BIRD)GOTO 9212 SPK=100 GOTO 2011 ! 9212 IF(OBJ # SNAKE AND OBJ # DRAGON AND OBJ # TROLL)GOTO 9213 SPK=102 IF(OBJ = DRAGON AND PROP(DRAGON) # 0)SPK=110 IF(OBJ = TROLL)SPK=182 OBJECT=BIRD : CALL HERE IF(OBJ # SNAKE OR CLOSED OR (NOT HERE))GOTO 2011 SPK=101 OBJECT=BIRD:CALL DSTROY PROP(BIRD)=0 TALLY2=TALLY2+1 GOTO 2011 ! 9213 IF(OBJ # DWARF)GOTO 9214 OBJECT=FOOD : CALL HERE IF(NOT HERE )GOTO 2011 SPK=103 DFLAG=DFLAG+1 GOTO 2011 ! 9214 IF(OBJ # BEAR)GOTO 9215 IF(PROP(BEAR) = 0)SPK=102 IF(PROP(BEAR) = 3)SPK=110 OBJECT=FOOD : CALL HERE IF(NOT HERE)GOTO 2011 OBJECT=FOOD:CALL DSTROY PROP(BEAR)=1 FIXED(AXE)=0 PROP(AXE)=0 SPK=168 GOTO 2011 ! 9215 SPK=14 GOTO 2011 ! ! FILL. BOTTLE MUST BE EMPTY, AND SOME LIQUID AVAILABLE. (VASE IS NASTY.) ! 9220 IF(OBJ = VASE)GOTO 9222 IF(OBJ # 0 AND OBJ # BOTTLE)GOTO 2011 OBJECT=BOTTLE : CALL HERE IF(OBJ = 0 AND (NOT HERE))GOTO 8000 SPK=107 LARG=LOC : CALL LIQLOC IF(LIQLOC = 0)SPK=106 CALL LIQ IF(LIQ # 0)SPK=105 IF(SPK # 107)GOTO 2011 XYZHOLD=COND(LOC) A9222: IF XYZHOLD>=4 THEN XYZHOLD=XYZHOLD-4 : GOTO A9222 PROP(BOTTLE)=INT(XYZHOLD/2)*2 CALL LIQ K=LIQ IF((PLACE(BOTTLE) = -1))PLACE(K)=-1 IF(K = OIL)SPK=108 GOTO 2011 ! 9222 SPK=29 LARG=LOC:CALL LIQLOC IF(LIQLOC = 0)SPK=144 IF(LIQLOC = 0 OR (NOT PLACE(VASE)=-1))GOTO 2011 RSPKI=145:CALL RSPEAK PROP(VASE)=2 FIXED(VASE)=-1 GOTO 9024 ! ! BLAST. NO EFFECT UNLESS YOU'VE GOT DYNAMITE, WHICH IS A NEAT TRICK! ! 9230 IF(PROP(ROD2) < 0 OR (NOT CLOSED))GOTO 2011 BONUS=133 IF(LOC = 115)BONUS=134 OBJECT=ROD2 : CALL HERE IF( HERE )BONUS=135 RSPKI=BONUS:CALL RSPEAK GOTO 20000 ! ! SCORE. GO TO SCORING SECTION, WHICH WILL RETURN TO 8241 IF SCORNG IS TRUE. ! 8240 SCORNG= TRUE GOTO 20000 ! 8241 SCORNG= FALSE 8243 PRINT "If you were to quit now, you would score ";SCORE; PRINT " out of a possible ";MXSCOR;"." YESX=143:YESY=54:YESZ=54 : CALL YES GAVEUP=YES GOTO 8185 ! ! 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 WORD WE'VE GOT. LAST ! WORD ZIPS THE EGGS BACK TO THE GIANT ROOM (UNLESS ALREADY THERE). ! 8250 WORDX=WORD1:INIT=3:CALL VOCAB:K=V SPK=42 IF(FOOBAR = 1-K)GOTO 8252 IF(FOOBAR # 0)SPK=151 GOTO 2011 ! 8252 FOOBAR=K IF(K # 4)GOTO 2009 FOOBAR=0 IF(PLACE(EGGS) = PLAC(EGGS) & OR ((PLACE(EGGS) = -1) AND LOC = PLAC(EGGS)))GOTO 2011 ! BRING BACK TROLL IF WE STEAL THE EGGS BACK FROM HIM BEFORE CROSSING. IF(PLACE(EGGS) = 0 AND PLACE(TROLL) = 0 AND PROP(TROLL) = 0) & PROP(TROLL)=1 K=2 OBJECT=EGGS : CALL HERE IF( HERE )K=1 IF(LOC = PLAC(EGGS))K=0 OBJECT=EGGS:WHERE=PLAC(EGGS):CALL MOVE MSG=EGGS:SKIP=K:CALL PSPEAK GOTO 2012 ! ! BRIEF. INTRANSITIVE ONLY. SUPPRESS LONG DESCRIPTIONS AFTER FIRST TIME. ! 8260 SPK=156 ABBNUM=10000 DETAIL=3 GOTO 2011 ! ! READ. MAGAZINES IN DWARVISH, MESSAGE WE'VE SEEN, AND . . . OYSTER? ! 8270 OBJECT=MAGZIN : CALL HERE IF( HERE )OBJ=MAGZIN OBJECT=TABLET : CALL HERE IF( HERE )OBJ=OBJ*100+TABLET OBJECT=MESSAG : CALL HERE IF( HERE )OBJ=OBJ*100+MESSAG IF(CLOSED AND (PLACE(OYSTER) = -1))OBJ=OYSTER CALL DARK IF(OBJ > 100 OR OBJ = 0 OR DARK)GOTO 8000 ! 9270 CALL DARK IF(DARK)GOTO 5190 IF(OBJ = MAGZIN)SPK=190 IF(OBJ = TABLET)SPK=196 IF(OBJ = MESSAG)SPK=191 IF(OBJ = OYSTER AND HINTED(2) AND (PLACE(OYSTER) = -1))SPK=194 IF(OBJ # OYSTER OR HINTED(2) OR (NOT PLACE(OYSTER)=-1) & OR (NOT CLOSED))GOTO 2011 YESX=192:YESY=193:YESZ=54 :CALL YES HINTED(2)=YES GOTO 2012 ! ! BREAK. ONLY WORKS FOR MIRROR IN REPOSITORY AND, OF COURSE, THE VASE. ! 9280 IF(OBJ = MIRROR)SPK=148 IF(OBJ = VASE AND PROP(VASE) = 0)GOTO 9282 IF(OBJ # MIRROR OR (NOT CLOSED))GOTO 2011 RSPKI=197:CALL RSPEAK GOTO 19000 ! 9282 SPK=198 IF((PLACE(VASE) = -1))OBJECT=VASE : WHERE=LOC:CALL DROP PROP(VASE)=2 FIXED(VASE)=-1 GOTO 2011 ! ! WAKE. ONLY USE IS TO DISTURB THE DWARVES. ! 9290 IF(OBJ # DWARF OR (NOT CLOSED))GOTO 2011 RSPKI=199:CALL RSPEAK GOTO 19000 ! ! SUSPEND. SUSPEND USER GAME ! 8300 IF(IDEMO = -1)GOTO 9295 ! PRINT : PRINT "I can suspend your game so you can resume later, but" ! PRINT " you will have to wait ";LATNCY;" minutes before continuing" ! PRINT ! YESX=200:YESY=54:YESZ=54:CALL YES ! IF(NOT YES)GOTO 2012 ! ! CALL TIMR !RTNS TIM$ ! CALL IDATE !RTNS IMO,IDY,IYR PRINT PRINT "What name would you like to save this game under "; INPUT SAVNAM$ : IF SAVNAM$="" THEN 2000 IF INSTR(1,SAVNAM$,".")=0 THEN SAVNAM$=SAVNAM$+".ADV" LOOKUP SAVNAM$,SIZ : IF SIZ THEN KILL SAVNAM$ ALLOCATE SAVNAM$,26 OPEN #8, SAVNAM$, RANDOM,16, BLK ! SLOC=LOC ! SAVDAT=TEDATE ! TIMM$=TIM$ BLK=1 FOR BLK=1 TO 806 WRITE #8, IXREC(BLK) NEXT BLK ! PRINT "Your ADVENTURE has been suspended!!" : PRINT : PRINT CLOSE #8 ! RETURN ! ! CANT SUSPEND AS THIS IS A DEMO GAME ! 9295 PRINT : PRINT "It really doesn't make any sense to suspend a demo" PRINT " game, now does it!!" : PRINT : PRINT GOTO 2012 ! ! HOURS. DISPLAY THE PRIME TIME HOURS FOR USER ! !**NEXT LINE UNTIL HOURS REIMPLEMENTED*** THEN DELETE 8310 PRINT "Collossal cave is *ALWAYS* open if this is your AM-100!" PRINT !8310 CALL HOURS GO TO 2012 ! ! RESTORE. ATTEMPT TO RESTORE THE GAME ! 8400 IF(IDEMO = -1)GOTO 8470 PRINT "What is the name of your saved game "; INPUT SAVNAM$ : IF SAVNAM$="" GOTO 2000 IF INSTR(1,SAVNAM$,".")=0 THEN SAVNAM$=SAVNAM$+".ADV" LOOKUP SAVNAM$,SIZ IF SIZ=0 THEN PRINT "I can't seem to find your saved game!!":PRINT: & GOTO 8400 OPEN #7, SAVNAM$,RANDOM,16,BLK ! CALL TIMR !RTNS TIM$ ! CALL IDATE !RTNS IMO,IDY,IYR FOR BLK=1 TO 806 READ #7, IXREC(BLK) NEXT BLK ! LOC=SLOC ! **NEXT LINE USED UNITL TIME/HOURS REIMPLEMENTED**THEN DELETE GOTO 2000 ! ITOT= (2000*(IYR2-75))+(100*IMO2)+IDY2 ! ICTOT=(2000*(IYR-75))+(100*IMO)+IDY ! ! DO TIME CHECK FOR LATNCY ! ! ICHR=TIM$[1,2] ! IOHR=TIMM$[1,2] ! IOMIN=TIMM$[4,5] ! ICMIN=TIM$[4,5] ! ! CHECK DAY FIRST ! ! ITTOT=ICTOT-ITOT ! IF(ITTOT > 1)GOTO 2000 ! IF(ITTOT = 1)ICHR=ICHR+24 ! ! ONLY CHECK IF WIZARD IF WITHIN THE WIZARD ONLY RESTART TIMES ! ! ITO=(60*IOHR)+IOMIN ! ITC=(60*ICHR)+ICMIN ! ! ITTO=ITC-ITO ! LATCY3=INT(LATNCY / 3) ! IF(NOT (ITTO >= LATCY3 AND ITTO < LATNCY))GOTO W84101 ! IF(WIZARD # -1)CALL WIZARD ! ! IF GUY IS A WIZARD, THEN LATNCY IS CUT TO 1/3 ! !W84101: LATCY2=LATNCY ! IF(WIZARD = -1)LATCY2=LATCY3 ! ITOO=ITO+LATCY2 ! IF(ITOO < ITC)GOTO 2000 ! PRINT " Come on! This adventure was suspended a mere ";ITTO; ! PRINT " minutes ago" : PRINT ! ! IF(WIZARD = -1) & ! PRINT : PRINT "Even WIZARDS must wait longer than that!" ! PRINT " Try again later!" : PRINT : PRINT ! ! GOTO ENDR ! ! DEMO GAME ! 8470 PRINT "You cannot restore a demo game...." : PRINT ! PRINT "Try again later!!" : PRINT : PRINT GOTO 2012 ! ! HINTS ! ! COME HERE IF HE'S BEEN LONG ENOUGH AT REQUIRED LOC(S) FOR SOME UNUSED HINT. ! HINT NUMBER IS IN VARIABLE "HINT". BRANCH TO QUICK TEST FOR ADDITIONAL ! CONDITIONS, THEN COME BACK TO DO NEAT STUFF. GOTO 40010 IF CONDITIONS ARE ! MET AND WE WANT TO OFFER THE HINT. GOTO 40020 TO CLEAR HINTLC BACK TO ZERO, ! 40030 TO TAKE NO ACTION YET. ! 40000 ON HINT-3 GOTO 40400,40500,40600,40700,40800,40900 ! CAVE BIRD SNAKE MAZE DARK WITT NUM=27 :CALL BUG ! 40010 HINTLC(HINT)=0 YESX=HINTS(HINT,3) : YESY=0:YESZ=54: CALL YES IF(NOT YES)GOTO 2602 PRINT " I am prepared to give you a hint, but IT WILL COST YOU"; PRINT HINTS(HINT,2);" POINTS." YESX=175:YESY=HINTS(HINT,4) : YESZ=54 : CALL YES HINTED(HINT)=YES IF(HINTED(HINT) AND LIMIT > 30)LIMIT=LIMIT+30*HINTS(HINT,2) 40020 HINTLC(HINT)=0 40030 GOTO 2602 ! ! NOW FOR THE QUICK TESTS. SEE DATABASE DESCRIPTION FOR ONE-LINE NOTES. ! 40400 OBJECT=KEYS : CALL HERE IF(PROP(GRATE) = 0 AND (NOT HERE))GOTO 40010 GOTO 40020 ! 40500 OBJECT=BIRD : CALL HERE IF( HERE AND (PLACE(ROD) = -1) AND OBJ = BIRD)GOTO 40010 GOTO 40030 ! 40600 OBJECT=SNAKE : CALL HERE HER2=HERE : OBJECT=BIRD : CALL HERE IF(HER2 AND (NOT HERE))GOTO 40010 GOTO 40020 ! 40700 IF(ATLOC(LOC) = 0 AND ATLOC(OLDLOC) = 0 & AND ATLOC(OLDLC2) = 0 AND HOLDNG > 1)GOTO 40010 GOTO 40020 ! 40800 IF(PROP(EMRALD) # -1 AND PROP(PYRAM) = -1)GOTO 40010 GOTO 40020 ! 40900 GOTO 40010 ! CAVE CLOSING AND SCORING ! ! ! THESE SECTIONS HANDLE THE CLOSING OF THE CAVE. THE CAVE CLOSES "CLOCK1" ! TURNS AFTER THE LAST TREASURE HAS BEEN LOCATED (INCLUDING THE PIRATE'S ! CHEST, WHICH MAY OF COURSE NEVER SHOW UP). NOTE THAT THE TREASURES NEED NOT ! HAVE BEEN 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, ! WE BRANCH TO 10000 TO START CLOSING THE CAVE, AND THEN SIT BACK AND WAIT FOR ! HIM TO TRY TO GET OUT. IF HE DOESN'T WITHIN CLOCK2 TURNS, WE CLOSE THE ! CAVE; IF HE DOES TRY, WE ASSUME HE PANICS, AND GIVE HIM A FEW ADDITIONAL ! TURNS TO GET FRANTIC BEFORE WE CLOSE. WHEN CLOCK2 HITS ZERO, WE BRANCH TO ! 11000 TO TRANSPORT HIM INTO THE FINAL PUZZLE. NOTE THAT THE PUZZLE DEPENDS ! UPON ALL SORTS OF RANDOM THINGS. FOR INSTANCE, THERE MUST BE NO WATER OR ! OIL, SINCE THERE ARE BEANSTALKS WHICH WE DON'T WANT TO BE ABLE TO WATER, ! SINCE THE CODE CAN'T HANDLE IT. ALSO, WE CAN HAVE NO KEYS, SINCE THERE IS A ! GRATE (HAVING MOVED THE FIXED OBJECT!) THERE SEPARATING HIM FROM ALL THE ! TREASURES. MOST OF THESE PROBLEMS ARISE FROM THE USE OF NEGATIVE PROP ! NUMBERS TO SUPPRESS THE OBJECT DESCRIPTIONS UNTIL HE'S ACTUALLY MOVED THE ! OBJECTS. ! ! WHEN THE FIRST WARNING COMES, WE LOCK THE GRATE, DESTROY THE BRIDGE, KILL ! ALL THE DWARVES (AND THE PIRATE), REMOVE THE 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, HE CANNOT UNLOCK THE GRATE, MOVE TO ANY ! LOCATION OUTSIDE THE CAVE (LOC<9), OR CREATE THE BRIDGE. NOR CAN HE BE ! RESURRECTED IF HE DIES. NOTE THAT THE SNAKE IS ALREADY GONE, SINCE HE GOT ! TO THE TREASURE ACCESSIBLE ONLY VIA THE HALL OF THE MT. KING. ALSO, HE'S ! BEEN IN GIANT ROOM (TO GET EGGS), SO WE CAN REFER TO IT. ALSO ALSO, HE'S ! GOTTEN THE PEARL, SO WE KNOW THE BIVALVE IS AN OYSTER. *AND*, THE DWARVES ! MUST HAVE BEEN ACTIVATED, SINCE WE'VE FOUND CHEST. ! 10000 PROP(GRATE)=0 PROP(FISSUR)=0 FOR I=1 TO 6 DSEEN(I)= FALSE 10010 DLOC(I)=0 NEXT I OBJECT=TROLL:WHERE=0:CALL MOVE OBJECT=TROLL+100:WHERE=0:CALL MOVE OBJECT=TROLL2:WHERE=PLAC(TROLL):CALL MOVE OBJECT=TROLL2+100:WHERE=FIXD(TROLL):CALL MOVE OBJECT=CHASM:CALL JUGGLE IF(PROP(BEAR) # 3)OBJECT=BEAR:CALL DSTROY PROP(CHAINS)=0 FIXED(CHAINS)=0 PROP(AXE)=0 FIXED(AXE)=0 RSPKI=129:CALL RSPEAK CLOCK1=-1 CLOSNG= TRUE GOTO 19999 ! ! ONCE HE'S PANICKED, AND CLOCK2 HAS RUN OUT, WE COME HERE TO SET UP THE ! STORAGE ROOM. THE ROOM HAS TWO LOCS, HARDWIRED AS 115 (NE) AND 116 (SW). ! AT THE NE END, WE PLACE EMPTY BOTTLES, A NURSERY OF PLANTS, A BED OF ! OYSTERS, A PILE OF LAMPS, RODS WITH STARS, SLEEPING DWARVES, AND HIM. AND ! THE SW END WE PLACE GRATE OVER TREASURES, SNAKE PIT, COVEY OF CAGED BIRDS, ! MORE RODS, AND PILLOWS. A MIRROR STRETCHES ACROSS ONE WALL. MANY OF THE ! OBJECTS COME FROM KNOWN LOCATIONS AND/OR STATES (E.G. THE SNAKE IS KNOWN TO ! HAVE BEEN DESTROYED AND NEEDN'T BE CARRIED AWAY FROM ITS OLD "PLACE"), ! MAKING THE VARIOUS OBJECTS BE HANDLED DIFFERENTLY. WE ALSO DROP ALL OTHER ! OBJECTS HE MIGHT BE CARRYING (LEST HE HAVE SOME WHICH COULD CAUSE TROUBLE, ! SUCH AS THE KEYS). WE DESCRIBE THE FLASH OF LIGHT AND TRUNDLE BACK. ! 11000 OBJECT=BOTTLE : WHERE=115 : PUTA=1 : CALL PUT PROP(BOTTLE)=PUT OBJECT=PLANT : WHERE=115 : PUTA=0 : CALL PUT PROP(PLANT)=PUT OBJECT= OYSTER : WHERE=115 : PUTA=0 : CALL PUT PROP(OYSTER)=PUT OBJECT=LAMP : WHERE=115 : PUTA=0 : CALL PUT PROP(LAMP)=PUT OBJECT=ROD : WHERE=115 : PUTA=0 : CALL PUT PROP(ROD)=PUT OBJECT=DWARF : WHERE=115 : PUTA=0 : CALL PUT PROP(DWARF)=PUT LOC=115 OLDLOC=115 NEWLOC=115 ! ! LEAVE THE GRATE WITH NORMAL (NON-NEGATIVE PROPERTY). ! OBJECT=GRATE : WHERE=116 : PUTA=0 : CALL PUT I=PUT OBJECT=SNAKE : WHERE=116 : PUTA=1 : CALL PUT PROP(SNAKE)=PUT OBJECT=BIRD : WHERE=116 : PUTA=1 : CALL PUT PROP(BIRD)=PUT OBJECT=CAGE :WHERE=116 : PUTA=0 : CALL PUT PROP(CAGE)=PUT OBJECT=ROD2 : WHERE=116 : PUTA=0 : CALL PUT PROP(ROD2)=PUT OBJECT=PILLOW : WHERE=116 : PUTA=0 : CALL PUT PROP(PILLOW)=PUT ! OBJECT=MIRROR : WHERE=115 : PUTA=0 : CALL PUT PROP(MIRROR)=PUT FIXED(MIRROR)=116 ! FOR I=1 TO 100 11010 IF(PLACE(I) = -1)OBJECT=I : CALL DSTROY NEXT I ! RSPKI=132:CALL RSPEAK CLOSED= TRUE GOTO 2 ! ! ANOTHER WAY WE CAN FORCE AN END TO THINGS IS BY HAVING THE LAMP GIVE OUT. ! WHEN IT GETS CLOSE, WE COME HERE TO WARN HIM. WE GO TO 12000 IF THE LAMP ! AND FRESH BATTERIES ARE HERE, IN WHICH CASE WE REPLACE THE BATTERIES AND ! CONTINUE. 12200 IS FOR OTHER CASES OF LAMP DYING. 12400 IS WHEN IT GOES ! OUT, AND 12600 IS IF HE'S WANDERED OUTSIDE AND THE LAMP IS USED UP, IN WHICH ! CASE WE FORCE HIM TO GIVE UP. ! 12000 RSPKI=188:CALL RSPEAK PROP(BATTER)=1 IF(PLACE(BATTER) = -1)OBJECT=BATTER:WHERE=LOC:CALL DROP LIMIT=LIMIT+2500 LMWARN= FALSE GOTO 19999 ! 12200 OBJECT=LAMP : CALL HERE IF(LMWARN OR (NOT HERE))GOTO 19999 LMWARN= TRUE SPK=187 IF(PLACE(BATTER) = 0)SPK=183 IF(PROP(BATTER) = 1)SPK=189 RSPKI=SPK:CALL RSPEAK GOTO 19999 ! 12400 LIMIT=-1 PROP(LAMP)=0 OBJECT=LAMP : CALL HERE IF( HERE )RSPKI=184:CALL RSPEAK GOTO 19999 ! 12600 RSPKI=185:CALL RSPEAK GAVEUP= TRUE GOTO 20000 ! ! ! OH DEAR, HE'S DISTURBED THE DWARVES. ! 19000 RSPKI=136:CALL RSPEAK ! ! EXIT CODE. ! ! THE PRESENT SCORING ALGORITHM IS AS FOLLOWS: ! OBJECTIVE: POINTS: PRESENT TOTAL POSSIBLE: ! GETTING WELL INTO CAVE 25 25 ! EACH TREASURE < CHEST 12 60 ! TREASURE CHEST ITSELF 14 14 ! EACH TREASURE > CHEST 16 144 ! SURVIVING (MAX-NUM)*10 30 ! NOT QUITTING 4 4 ! REACHING "CLOSNG" 25 25 ! "CLOSED": QUIT/KILLED 10 ! KLUTZED 25 ! WRONG WAY 30 ! SUCCESS 45 45 ! CAME TO WITT'S END 1 1 ! ROUND OUT THE TOTAL 2 2 ! TOTAL: 350 ! (POINTS CAN ALSO BE DEDUCTED FOR USING HINTS.) ! 20000 SCORE=0 MXSCOR=0 ! ! FIRST TALLY UP THE TREASURES. MUST BE IN BUILDING AND NOT BROKEN. ! GIVE THE POOR GUY 2 POINTS JUST FOR FINDING EACH TREASURE. ! FOR I=50 TO MAXTRS IF(PTEXT(I) = 0)GOTO 20010 K=12 IF(I = CHEST)K=14 IF(I > CHEST)K=16 IF(PROP(I) >= 0)SCORE=SCORE+2 IF(PLACE(I) = 3 AND PROP(I) = 0)SCORE=SCORE+K-2 MXSCOR=MXSCOR+K 20010 NEXT I ! ! NOW LOOK AT HOW HE FINISHED AND HOW FAR HE GOT. MAXDIE AND NUMDIE TELL US ! HOW WELL HE SURVIVED. GAVEUP SAYS WHETHER HE EXITED VIA QUIT. DFLAG WILL ! TELL US IF HE EVER GOT SUITABLY DEEP INTO THE CAVE. CLOSNG STILL INDICATES ! WHETHER HE REACHED THE ENDGAME. AND IF HE GOT AS FAR AS "CAVE CLOSED" ! (INDICATED BY "CLOSED"), THEN BONUS IS ZERO FOR MUNDANE EXITS OR 133, 134, ! 135 IF HE BLEW IT (SO TO SPEAK). ! SCORE=SCORE+(MAXDIE-NUMDIE)*10 MXSCOR=MXSCOR+MAXDIE*10 IF(NOT (SCORNG OR GAVEUP))SCORE=SCORE+4 MXSCOR=MXSCOR+4 IF(DFLAG # 0)SCORE=SCORE+25 MXSCOR=MXSCOR+25 IF(CLOSNG)SCORE=SCORE+25 MXSCOR=MXSCOR+25 IF(NOT CLOSED)GOTO 20020 IF(BONUS = 0)SCORE=SCORE+10 IF(BONUS = 135)SCORE=SCORE+25 IF(BONUS = 134)SCORE=SCORE+30 IF(BONUS = 133)SCORE=SCORE+45 20020 MXSCOR=MXSCOR+45 ! ! DID HE COME TO WITT'S END AS HE SHOULD? ! IF(PLACE(MAGZIN) = 108)SCORE=SCORE+1 MXSCOR=MXSCOR+1 ! ! ROUND IT OFF. ! SCORE=SCORE+2 MXSCOR=MXSCOR+2 ! ! DEDUCT POINTS FOR HINTS. HINTS < 4 ARE SPECIAL; SEE DATABASE DESCRIPTION. ! FOR I=1 TO HNTMAX 20030 IF(HINTED(I))SCORE=SCORE-HINTS(I,2) NEXT I ! ! RETURN TO SCORE COMMAND IF THAT'S WHERE WE CAME FROM. ! IF(SCORNG)GOTO 8241 ! ! THAT SHOULD BE GOOD ENOUGH. LET'S TELL HIM ALL ABOUT IT. ! PRINT PRINT "You scored";SCORE;" out of a possible ";MXSCOR; PRINT ", using";TURNS;" turns." ! FOR I=1 TO CLSSES IF(CVAL(I) >= SCORE)GOTO 20210 20200 NEXT I PRINT : PRINT "YOU JUST WENT OFF MY SCALE!!" GOTO 25000 ! 20210 LINUSE=CTEXT(I):CALL SPEAK IF(I = CLSSES-1)GOTO 20220 K=CVAL(I)+1-SCORE PRINT : PRINT "To achieve the next higher rating, you need";K; PRINT " more point"; IF(K = 1)PRINT IF(K # 1)PRINT "s." PRINT : PRINT GOTO 25000 ! 20220 PRINT "To achieve the next higher rating "; PRINT "would be a NEAT TRICK!" : PRINT : PRINT "CONGRATULATIONS!!" ! 25000 RETURN ! ! 13000 PRINT "A wisp of orange smoke appears and a bellowing voice" PRINT "says IT HAS BEEN TOO LONG.... You are transported away" PRINT "from the cave until another day. Goodbye!!" PRINT : PRINT ! SCORNG = FALSE ! ! GIVE USER HIS SCORE ! GOTO 20000 ! !*********************S U B R O U T I N E S************************* ! ! ! DATA STRUCTURE ROUTINES (VOCAB, DSTROY, JUGGLE, MOVE, PUT, CARRY, DROP) ! ! VOCAB: !SUBROUTINE VOCAB(ID1,ID2,INIT,V) ! ! LOOK UP WORDX IN THE VOCABULARY (ATAB) ! AND RETURN ITS "DEFINITION" (KTAB), OR ! -1 IF NOT FOUND. IF INIT IS POSITIVE, THIS IS AN INIT CALL SETTING ! UP A KEYWORD VARIABLE, AND NOT FINDING IT CONSTITUTES A BUG. IT ALSO MEANS ! THAT ONLY KTAB VALUES WHICH TAKEN OVER 1000 EQUAL INIT MAY BE CONSIDERED. ! (THUS "STEPS", WHICH IS A MOTION VERB AS WELL AS AN OBJECT, MAY BE LOCATED ! AS AN OBJECT.) AND IT ALSO MEANS THE KTAB VALUE IS TAKEN MOD 1000. ! MAP1 WORDXX,S,4 ! VOCII=1 VOCAB2: VOCI=INSTR(VOCII,ATB,WORDX[1,4]) IF(VOCI=0)GOTO VOCERR VOCII=VOCI+1 VOCI=((VOCI-1)/4)+1 WORDXX=ATB[VOCII-1;4] IF(VOCI # INT(VOCI) OR WORDXX # WORDX[1,4])GOTO VOCAB2 IF(INIT>=0 AND INT(KTAB(VOCI)/1000) # INIT)GOTO VOCAB2 V=KTAB(VOCI) IF(INIT<0)RETURN VLP: IF(V>=1000)V=V-1000 : GOTO VLP RETURN ! VOCERR: V=-1 IF(INIT<0)RETURN PRINT "Keyword=";WORDX NUM=5 : CALL BUG ! ! DSTROY: !SUBROUTINE DSTROY(OBJECT) ! ! PERMANENTLY ELIMINATE "OBJECT" BY MOVING TO A NON-EXISTENT LOCATION. ! WHERE=0 : CALL MOVE RETURN ! ! ! JUGGLE: !SUBROUTINE JUGGLE(OBJECT) ! ! JUGGLE AN OBJECT BY PICKING IT UP AND PUTTING IT DOWN AGAIN, THE PURPOSE ! BEING TO GET THE OBJECT TO THE FRONT OF THE CHAIN OF THINGS AT ITS LOC. ! ! JUGI=PLACE(OBJECT) JUGJ=FIXED(OBJECT) WHERE=JUGI :CALL MOVE OBJECT2=OBJECT OBJECT=OBJECT+100:WHERE=JUGJ:CALL MOVE OBJECT=OBJECT2 RETURN ! ! MOVE: !SUBROUTINE MOVE(OBJECT,WHERE) ! ! PLACE ANY OBJECT ANYWHERE BY PICKING IT UP AND DROPPING IT. MAY ALREADY BE ! TOTING, IN WHICH CASE THE CARRY IS A NO-OP. MUSTN'T PICK UP OBJECTS WHICH ! ARE NOT AT ANY LOC, SINCE CARRY WANTS TO REMOVE OBJECTS FROM ATLOC CHAINS. ! ! IF(OBJECT > 100)GOTO MOVE1 FROM=PLACE(OBJECT) GOTO MOVE2 MOVE1: FROM=FIXED(OBJECT-100) MOVE2: IF(FROM>0 AND FROM<=300)WHERE2=WHERE:WHERE=FROM:CALL CARRY:WHERE=WHERE2 CALL DROP RETURN ! ! ! PUT: !INTEGER FUNCTION PUT(OBJECT,WHERE,PUTA) ! ! PUT IS THE SAME AS MOVE, EXCEPT IT RETURNS A VALUE USED TO SET UP THE ! NEGATED PROP VALUES FOR THE REPOSITORY OBJECTS. ! ! CALL MOVE PUT=(-1)-PUTA RETURN ! ! CARRY: !SUBROUTINE CARRY(OBJECT,WHERE) ! ! START TOTING AN OBJECT, REMOVING IT FROM THE LIST OF THINGS AT ITS FORMER ! LOCATION. INCR HOLDNG UNLESS IT WAS ALREADY BEING TOTED. IF OBJECT>100 ! (MOVING "FIXED" SECOND LOC), DON'T CHANGE PLACE OR HOLDNG. ! IF(OBJECT > 100)GOTO CAR5 IF(PLACE(OBJECT) = -1)RETURN PLACE(OBJECT)=-1 HOLDNG=HOLDNG+1 CAR5: IF(ATLOC(WHERE) # OBJECT)GOTO CAR6 ATLOC(WHERE)=LINK(OBJECT) RETURN CAR6: TEMP=ATLOC(WHERE) CAR7: IF(LINK(TEMP) = OBJECT)GOTO CAR8 TEMP=LINK(TEMP) GOTO CAR7 CAR8: LINK(TEMP)=LINK(OBJECT) RETURN ! ! ! DROP: !SUBROUTINE DROP(OBJECT,WHERE) ! ! PLACE AN OBJECT AT A GIVEN LOC, PREFIXING IT ONTO THE ATLOC LIST. DECR ! HOLDNG IF THE OBJECT WAS BEING TOTED. ! IF(OBJECT > 100)GOTO OBJ1 IF(PLACE(OBJECT) = -1)HOLDNG=HOLDNG-1 PLACE(OBJECT)=WHERE GOTO OBJ2 OBJ1: FIXED(OBJECT-100)=WHERE OBJ2: IF(WHERE <= 0)RETURN LINK(OBJECT)=ATLOC(WHERE) ATLOC(WHERE)=OBJECT RETURN ! ! UTILITY ROUTINES (BUG, TIMHR) ! BUG: !SUBROUTINE BUG(NUM) ! ! THE FOLLOWING CONDITIONS ARE CURRENTLY CONSIDERED FATAL BUGS. NUMBERS < 20 ! ARE DETECTED WHILE READING THE DATABASE; THE OTHERS OCCUR AT "RUN TIME". ! 0 MESSAGE LINE > 70 CHARACTERS ! 1 NULL LINE IN MESSAGE ! 2 TOO MANY WORDS OF MESSAGES ! 3 TOO MANY TRAVEL OPTIONS ! 4 TOO MANY VOCABULARY WORDS ! 5 REQUIRED VOCABULARY WORD NOT FOUND ! 6 TOO MANY RTEXT OR MTEXT MESSAGES ! 7 TOO MANY HINTS ! 8 LOCATION HAS COND BIT BEING SET TWICE ! 9 INVALID SECTION NUMBER IN DATABASE ! 20 SPECIAL TRAVEL (500>L>300) EXCEEDS GOTO LIST ! 21 RAN OFF END OF VOCABULARY TABLE ! 22 VOCABULARY TYPE(N/1000) NOT BETWEEN 0 AND 3 ! 23 INTRANSITIVE ACTION VERB EXCEEDS GOTO LIST ! 24 TRANSITIVE ACTION VERB EXCEEDS GOTO LIST ! 25 CONDITIONAL TRAVEL ENTRY WITH NO ALTERNATIVE ! 26 LOCATION HAS NO TRAVEL ENTRIES ! 27 HINT NUMBER EXCEEDS GOTO LIST ! 28 INVALID MONTH RETURNED BY DATE FUNCTION ! PRINT " FATAL ERROR ";NUM;", Consult your local WIZARD." ! GOTO ENDR ! ! !TIMHR: !UBROUTINE TIMHR(ITMHR) ! ! THIS SUBROUTINE WILL RETURN THE CURRENT HOUR IN MILITARY FORMAT (00-23) ! ! IHR=INT(TIME/ 216000) !TICKS IN AN HOUR ! RETURN ! ! ************************************************* ! ! EXTENDED FUNCTION ROUTINES (WIZARD,HOURS) ! PJH 5/13/79 FWW ! !HOURS: !SUBROUTINE HOURS ! ! MAP1 ST$,S,2 : MAP1 EN$,S,2 : MAP1 MSK,S,2,"#Z" ! ! ST$=IST USING MSK ! EN$=IEND USING MSK ! PRINT : PRINT "Collossal Cave is open to regular travelers "; ! PRINT "during the following hours:" :PRINT : PRINT !! ! PRINT "Weekdays "; ! IF(IST=0 AND IEND=0 )GOTO HR17 ! PRINT " 00:00 - ";ST$;":00" ! PRINT TAB(19);EN$;":00 - 00:00" ! GOTO HR20 !HR17: PRINT " **Open ALL day**" !HR20: PRINT : PRINT "Saturday-Sunday "; ! IF(IWKST = 0 AND IWKEND = 0)GOTO HR24 ! ST$=IWKST USING MSK ! EN$=IWKEND USING MSK ! PRINT " 00:00 - ";ST$;":00" ! PRINT TAB(19);EN$;":00 - 00:00" ! GOTO HR27 !HR24: PRINT " **Open ALL day**" !! !HR27: PRINT :RETURN !! ! ! !WIZARD: !LOGICAL FUNCTION WIZARD(DUMMY) ! ! THIS FUNCTION WILL DETERMINE IF THE USER IS A WIZARD ! ! ! ! DEFMAGIC$="DWARF" !! !! IF THERE IS NO MAGIC WORD, SET IT TO 'DWARF' !! ! IF(MAGICWORD = "")MAGICWORD=DEFMAGIC$ !! ! INPUT "Are you a wizard ? ";IANS ! IF (IANS[1,1] # "Y")GOTO WIZ100 ! PRINT : PRINT "PROVE IT! Say the magic word!!" ! INPUT "";DEFMAGIC$ ! IF(MAGICWORD # DEFMAGIC$) GOTO WIZ90 ! PRINT ! PRINT "Oh dear, you really *ARE* a wizard! "; ! PRINT "Sorry to have bothered you. . ." : PRINT : PRINT ! WIZARD= TRUE ! GOTO WIZ200 !! !WIZ90: PRINT "Foo! You are nothing but a CHARLATAN!!" : PRINT : PRINT ! !WIZ100: WIZARD= FALSE !! !WIZ200: RETURN ! ! !MAINT: !SUBROUTINE MAINT(DUMMY) !! !! THIS ROUTINE WILL LET THE OLD WIZARD CHANGE ALL SYSTEM PARAMETERS !! ! CLOSE #2 !! ! PRINT : PRINT "****MAINTENANCE MODE****" : PRINT : PRINT ! LOOKUP "ADVENT.HRS",SIZ ! IF SIZ THEN KILL "ADVENT.HRS" ! OPEN #4, "ADVENT.HRS", OUTPUT !! ! PRINT "Change DAILY prime time from ";IST;"-";IEND;" ?? "; ! INPUT IST,IEND !! ! PRINT "Change WEEKEND prime time from ";IWKST;"-";IWKEND;" ?? "; ! INPUT IWKST,IWKEND !! ! PRINT "Input a message of the day: " ! INPUT MOTD !! ! PRINT "Change short game turns from ";ISHORT;" to ?? "; ! INPUT ISHORT ! PRINT "Change Latency Time from ";LATNCY;" to ?? "; ! INPUT LATNCY !! ! PRINT "Change MAGIC WORD from '";MAGICWORD;"' to ?? "; ! INPUT MAGICWORD !! !! ALL PARAMETERS INPUT, NOW WRITE IT OUT !! ! PRINT #4 IST;",";IEND;",";IWKST;",";IWKEND;",";ISHORT;",";MAGICWORD; ! PRINT #4, ",";LATNCY ! PRINT #4, MOTD !! ! CLOSE #4 !! ! PRINT : PRINT " System parameters have been changed!!" ! PRINT : PRINT !! ! GOTO ENDR ! ! RETURN ! ! !DAYWEK: !SUBROUTINE DAYWEK(IDAY) ! ! THIS ROUTINE WILL RETURN A NUMBER FROM 0-6 DESIGNATING THE DAY OF ! THE WEEK.. 0 IS SATURDAY, 1 IS SUNDAY ETC. ! ! MAP1 IDLNG(12),B,2 ! DATA 0,31,59,90,118,149,179,210,241,271,302,332 ! RESTORE : FOR IIXX=1 TO 12 : READ IDLNG(IIXX) : NEXT IIXX ! ! CALL IDATE !RTNS IMO,IDY,IYR ! IDAY=IDY+IDLNG(IMO)+(IYR-77)*365+INT((IYR-78)/4)+1 ! !DLOOP: IF IDAY>=7 THEN IDAY=IDAY-7 : GOTO DLOOP ! RETURN ! ! !TIMR: !SUBROUTINE TIMR(TIM$) ! ! THIS ROUTINE WILL RETURN AS AN ASCII STRING THE CURRENT TIME ! ! MAP1 HR$,S,2 : MAP1 MINS$,S,2 : MAP1 SEC$,S,2 ! TIM=TIME ! HR$=INT(TIM/216000) USING "#Z": TIM=TIM-(HR$*216000) ! MINS$=INT(TIM/3600) USING "#Z": TIM=TIM-(MINS$*3600) ! SEC$=INT(TIM/60) USING "Z#" ! TIM$=HR$+":"+MINS$+":"+SEC$ ! RETURN ! ! !IDATE: !SUBROUTINE IDATE(IMO,IDY,IYR) ! ! THIS ROUTINE WILL RETURN THE CURRENT DATE ! ! DAT=DATE ! IF IMO<1 OR IMO>12 THEN NUM=28 : CALL BUG : GOTO ENDR ! RETURN ! ! ISHFT: !FUNCTION ISHFT (IX,N) ! ! IX MUST BE 1 ! N = 0 (NO SHIFT, NO ANSWER) ! N > 0 (LEFT SHIFT) ! N < 0 (RIGHT SHIFT) ! ! MAP1 ISH(17),B,2 ! ISH(1)=1 : ISH(2)=2 : ISH(3)=4 : ISH(4)=8 : ISH(5)=16 : ISH(6)=32 ISH(7)=64 : ISH(8)=128 : ISH(9)=256 : ISH(10)=512 : ISH(11)=1024 ISH(12)=2048 : ISH(13)=4096 : ISH(14)=8192 : ISH(15)=16384 ISH(16)=32768 : ISH(17)=0 ! ! IF (ISHN = 0) GO TO SH90 SHFI=ISHN+1 IF (ISHN < 0) SHFI=18+ISHN IF ((ISHN < -17) OR (ISHN > 16)) SHFI=17 IF (ISHN = 0) SHFI=1 ISHFT = ISH(SHFI) ! SH90: RETURN ! ! ! *********************************************** ! I/O ROUTINES (SPEAK, PSPEAK, RSPEAK, GETIN, YES, A5TOA1) ! ! SPEAK: !SUBROUTINE SPEAK(LINUSE) ! ! PRINT THE MESSAGE IN RECORD LINUSE OF THE RANDOM ACCESS MESSAGE FILE. ! PRECEDE IT WITH A BLANK LINE UNLESS BLKLIN IS FALSE. ! ! IF(LINUSE = 0)RETURN TLOC=LOC READ #2, RNDBLK IF (LINES[1,2]=">$") LOC=TLOC :RETURN IF(BLKLIN AND NOINPT)PRINT NOINPT= TRUE SPK1: TOLDLOC = LOC PRINT LINES LINUSE= LINUSE+1 READ #2, RNDBLK IF(LOC = TOLDLOC) GO TO SPK1 LOC=TLOC RETURN ! ! ! PSPEAK: !SUBROUTINE PSPEAK(MSG,SKIP) ! ! FIND THE SKIP+1ST MESSAGE FOR OBJECT MSG AND PRINT IT. ! MSG SHOULD BE THE INDEX OF ! THE OBJECT. (INVEN+N+1 MESSAGE IS PROP=N MESSAGE). ! TLOC=LOC LINUSE =PTEXT(MSG) IF(SKIP < 0)GOTO PSPK9 TOLDLOC=MSG FOR PSPKI=1 TO SKIP+1 ! PSPK1: READ #2, RNDBLK LINUSE = LINUSE +1 IF(LOC = TOLDLOC) GO TO PSPK1 TOLDLOC=LOC NEXT PSPKI LINUSE=LINUSE-1 PSPK9: LOC=TLOC : CALL SPEAK RETURN ! ! ! RSPEAK: !SUBROUTINE RSPEAK(RSPKI) ! ! PRINT THE RSPKI-TH "RANDOM" MESSAGE (SECTION 6 OF DATABASE). ! IF RSPKI > 200 PRINT RSPKI : STOP IF(RSPKI # 0)LINUSE=RTEXT(RSPKI) : CALL SPEAK RETURN ! ! ! GETIN: !SUBROUTINE GETIN(WORD1,WORD1A,WORD1X,WORD2,WORD2A,WORD2X) ! ! GET A COMMAND FROM THE ADVENTURER. SNARF OUT THE FIRST WORD ! AND RETURN IN IN WORD1 ! THE SECOND WORD IF PRESENT IS RETURNED IN WORD2 ! MAP1 FRST,S,30 ! NOINPT= FALSE IF(BLKLIN)PRINT INPUT FRST WORD1="" WORD2="" ST2=INSTR(1,FRST," ") IF (ST2=0)WORD1=FRST : WORD2="" IF ST2 THEN WORD1=FRST[1,ST2-1] : WORD2=FRST[ST2+1,-1] WORD1 = UCS(WORD1) : WORD2 = UCS(WORD2) RETURN ! ! YES: !LOGICAL FUNCTION YES(X,Y,Z) ! ! CALL YESX (BELOW) WITH MESSAGES FROM SECTION 6. ! ! CALL YESX YES=YESX RETURN ! ! YESX: !LOGICAL FUNCTION YESX(X,Y,Z,SPK) ! ! PRINT MESSAGE X, WAIT FOR YES/NO ANSWER. IF YES, PRINT Y AND LEAVE YEA ! TRUE; IF NO, PRINT Z AND LEAVE YEA FALSE. ! IF(YESX # 0)RSPKI=YESX :CALL RSPEAK !SPK(X) CALL GETIN IF WORD1[1,1]="Y" THEN GOTO YESY ELSE IF WORD1[1,1]="N" GOTO YESN ! ! WRONG ANSWER ! PRINT "Please answer the question with YES or NO" ! GOTO YESX YESY: YESX= TRUE ! IF(YESY # 0)RSPKI=YESY : CALL RSPEAK RETURN ! YESN: YESX= FALSE IF(YESZ # 0)RSPKI=YESZ:CALL RSPEAK RETURN ! ! **************SINGLE LINE FUNCTION XLATES****** ! DARK: XYZHLD=COND(LOC) DRK2: IF XYZHLD>=2 THEN XYZHLD=XYZHLD-2 : GOTO DRK2 OBJECT=LAMP : CALL HERE DARK=XYZHLD = 0 AND (PROP(LAMP)=0 OR (NOT HERE)) RETURN ! LIQ: XYZHLD=PROP(BOTTLE) MAX -1-PROP(BOTTLE) PBOTL=XYZHLD : CALL LIQ2 LIQ= LIQ2 RETURN ! LIQ2: LIQ2=(1-PBOTL)*WATER+INT((PBOTL/2))*(WATER+OIL) RETURN ! HERE: HERE=(PLACE(OBJECT)=LOC) OR PLACE(OBJECT)=-1 RETURN ! AT: AT=PLACE(OBJECT)=LOC OR FIXED(OBJECT)=LOC RETURN ! LIQLOC: XYZ%=INT(COND(LARG)/2)*2 LILP: IF XYZ%>=8 THEN XYZ%=XYZ%-8 : GOTO LILP XYZ%=XYZ%-5% XYZZ%=COND(LARG)/4 LILP2: IF XYZZ%>=2% THEN XYZZ%=XYZZ%-2% : GOTO LILP2 PBOTL=XYZ%*XYZZ%+1 CALL LIQ2 LIQLOC=LIQ2 RETURN ! ENDR: END