/* ADVENTURES CURRENT LIMITS: 9650 WORDS OF MESSAGE TEXT (LINES, LINSIZ). 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). 205 RANDOM MESSAGES (RTEXT, RTXSIZ). 12 DIFFERENT PLAYER CLASSIFICATIONS (CTEXT, CVAL, CLSMAX). 20 HINTS, LESS 3 (HINTLC, HINTED, HINTS, HNTSIZ). 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 */ 1 /* (SUBSCRIPTRANGE,STRINGRANGE): */ ADVENT: PROC OPTIONS (MAIN); DCL CAVES FILE INPUT; DCL FCL CHAR(30) INIT(' '); DCL FL PIC'ZZZZZZZZZZZZZZZ' INIT(0); DCL FL1 CHAR(30) INIT(' '); DCL FCL1 CHAR(30) INIT(' '); DCL CHRIS CHAR(72) INIT(' '); DCL FRANK PIC'ZZZZZZZZZZZZZZZ' INIT(0); DCL FRANK1 PIC'ZZZZZZZZZZZZZZZ' INIT(0); DCL YES1 CHAR(72) INIT('YES'); DCL ASKED CHAR(72) INIT(' '); DCL RANDU ENTRY (FIXED BIN(31),FIXED BIN(31),FLOAT BIN(31)) OPTIONS (ASM INTER); DCL ITIME ENTRY (FIXED BIN(31)) OPTIONS (ASM INTER); DCL 1 TXTCOM STATIC, 2 RTEXT(205) FIXED BIN(31), 2 LINES(9650) CHAR(5); DCL 1 BLKCOM STATIC, 2 BLKLIN BIT(1) INIT ('1'B); DCL 1 PTXCOM STATIC, 2 PTEXT(100) FIXED BIN(31); DCL 1 VOCCOM STATIC, 2 KTAB(300) FIXED BIN(31), 2 ATAB(300) CHAR(5), 2 TABSIZ FIXED BIN(31) INIT(300); DCL 1 PLACOM STATIC, 2 ATLOC(150) FIXED BIN(31), 2 LINK(200) FIXED BIN(31), 2 PLACE(100) FIXED BIN(31), 2 FIXED(100) FIXED BIN(31), 2 HOLDNG FIXED BIN(31); DCL 1 ABBCOM STATIC, 2 ABB(150) FIXED BIN(31); DCL PICWORD PICTURE 'S9999' STATIC; 1 DCL 1 ADVARS STATIC, 2 ABBNUM FIXED BIN(31) INIT(0), 2 IX FIXED BIN(31) INIT (65549), 2 IY FIXED BIN(31) INIT(0), 2 Y FLOAT BIN(31) , 2 AXE FIXED BIN(31) INIT(0), 2 BACK FIXED BIN(31) INIT(0), 2 BATTER FIXED BIN(31) INIT(0), 2 BEAR FIXED BIN(31) INIT(0), 2 BIRD FIXED BIN(31) INIT(0), 2 BONUS FIXED BIN(31) INIT(0), 2 BOTTLE FIXED BIN(31) INIT(0), 2 CAGE FIXED BIN(31) INIT(0), 2 CAVE FIXED BIN(31) INIT(0), 2 CCODE FIXED BIN(31) INIT(0), 2 CH FIXED BIN(31) INIT(0), 2 CHAIN FIXED BIN(31) INIT(0), 2 CHASM FIXED BIN(31) INIT(0), 2 CHEST FIXED BIN(31) INIT(0), 2 CHLOC FIXED BIN(31) INIT(0), 2 CHLOC2 FIXED BIN(31) INIT(0), 2 CLAM FIXED BIN(31) INIT(0), 2 CLOCK1 FIXED BIN(31) INIT(0), 2 CLOCK2 FIXED BIN(31) INIT(0), 2 CLSSES FIXED BIN(31) INIT(0), 2 CLSSIZ FIXED BIN(31) INIT(12), 2 COINS FIXED BIN(31) INIT(0), 2 DALTLC FIXED BIN(31) INIT(0), 2 DETAIL FIXED BIN(31) INIT(0), 2 DFLAG FIXED BIN(31) INIT(0), 2 DKILL FIXED BIN(31) INIT(0), 2 DOOR FIXED BIN(31) INIT(0), 2 DPRSSN FIXED BIN(31) INIT(0), 2 DRAGON FIXED BIN(31) INIT(0), 2 DTOTAL FIXED BIN(31) INIT(0), 2 DWARF FIXED BIN(31) INIT(0), 2 EGGS FIXED BIN(31) INIT(0), 2 EMRALD FIXED BIN(31) INIT(0), 2 ENTRNC FIXED BIN(31) INIT(0), 2 FIND FIXED BIN(31) INIT(0), 2 FISSUR FIXED BIN(31) INIT(0), 2 FOO FIXED BIN(31) INIT(0), 2 FOOBAR FIXED BIN(31) INIT(0), 2 FOOD FIXED BIN(31) INIT(0), 2 FROM FIXED BIN(31) INIT(0), 2 GRATE FIXED BIN(31) INIT(0), 2 HINT FIXED BIN(31) INIT(0), 2 HINTLC(20) FIXED BIN(31) INIT((20)0), 2 HNTMAX FIXED BIN(31) INIT(0), 2 I FIXED BIN(31) INIT(0), 2 INLEN FIXED BIN(31) INIT(0), 2 INSTR CHAR(72) , 2 INVENT FIXED BIN(31) INIT(0), 2 IWEST FIXED BIN(31) INIT(0), 2 J FIXED BIN(31) INIT(0), 2 JUNK1 CHAR(5) , 2 JUNK2 CHAR(5) , 2 JUNK3 CHAR(5) , 2 K FIXED BIN(31) INIT(0), 2 KEYS FIXED BIN(31) INIT(0), 2 KK FIXED BIN(31) INIT(0), 2 KKWORD CHAR(2) , 2 KNFLOC FIXED BIN(31) INIT(0), 2 KNIFE FIXED BIN(31) INIT(0), 2 KQ FIXED BIN(31) INIT(0), 2 K2 FIXED BIN(31) INIT(0), 2 L FIXED BIN(31) INIT(0), 2 LAMP FIXED BIN(31) INIT(0), 2 LIMIT FIXED BIN(31) INIT(0), 2 LINUSE FIXED BIN(31) INIT(0), 2 LL FIXED BIN(31) INIT(0), 2 LOC FIXED BIN(31) INIT(0), 2 LOCK FIXED BIN(31) INIT(0), 2 LOOK FIXED BIN(31) INIT(0), 2 M FIXED BIN(31) INIT(0), 2 MAGZIN FIXED BIN(31) INIT(0), 2 MAXDIE FIXED BIN(31) INIT(0), 2 MAXTRS FIXED BIN(31) INIT(0), 2 MESSAG FIXED BIN(31) INIT(0), 2 MIRROR FIXED BIN(31) INIT(0), 2 MXSCOR FIXED BIN(31) INIT(0), 2 NEWLOC FIXED BIN(31) INIT(0), 2 NUGGET FIXED BIN(31) INIT(0), 2 NULLX FIXED BIN(31) INIT(0), 2 NUMDIE FIXED BIN(31) INIT(0), 2 OBJ FIXED BIN(31) INIT(0), 2 OIL FIXED BIN(31) INIT(0), 2 OLDLC2 FIXED BIN(31) INIT(0), 2 OLDLOC FIXED BIN(31) INIT(0), 2 OUTSTR CHAR(72) VAR , 2 OYSTER FIXED BIN(31) INIT(0), 2 PEARL FIXED BIN(31) INIT(0), 2 PILLOW FIXED BIN(31) INIT(0), 2 PLANT FIXED BIN(31) INIT(0), 2 PLANT2 FIXED BIN(31) INIT(0), 2 POSN FIXED BIN(31) INIT(0), 2 PYRAM FIXED BIN(31) INIT(0), 2 REPLY CHAR(5) , 2 ROD FIXED BIN(31) INIT(0), 2 ROD2 FIXED BIN(31) INIT(0), 2 RUG FIXED BIN(31) INIT(0), 2 SAY FIXED BIN(31) INIT(0), 2 SCORE FIXED BIN(31) INIT(0), 2 SECT FIXED BIN(31) INIT(0), 2 SNAKE FIXED BIN(31) INIT(0), 2 SPICES FIXED BIN(31) INIT(0), 2 SPK FIXED BIN(31) INIT(0), 2 STEPS FIXED BIN(31) INIT(0), 2 STICK FIXED BIN(31) INIT(0), 2 TABLET FIXED BIN(31) INIT(0), 2 TABNDX FIXED BIN(31) INIT(0), 2 TALLY FIXED BIN(31) INIT(0), 2 TALLY2 FIXED BIN(31) INIT(0), 2 TEMP FIXED BIN(31) INIT(0), 2 THROW FIXED BIN(31) INIT(0), 2 TRAVEL(750) FIXED BIN(31) INIT((750)0), 2 ATTACK FIXED BIN(31) INIT(0), 2 TRIDNT FIXED BIN(31) INIT(0), 2 TROLL FIXED BIN(31) INIT(0), 2 TROLL2 FIXED BIN(31) INIT(0), 2 TRVS FIXED BIN(31) INIT(0), 2 TURNS FIXED BIN(31) INIT(0), 2 VASE FIXED BIN(31) INIT(0), 2 VEND FIXED BIN(31) INIT(0), 2 VERB FIXED BIN(31) INIT(0), 2 WATER FIXED BIN(31) INIT(0), 2 WD1 CHAR(5) , 2 WD1X CHAR(5) , 2 WD2 CHAR(5) , 2 WD2X CHAR(5) , 2 WORD FIXED BIN(31) INIT(0), 2 WORDEND FIXED BIN(31) INIT(0), 2 WORDSIZE FIXED BIN(31) INIT(0), 2 WORDSTRT FIXED BIN(31) INIT(0), 2 LTEXT(150) FIXED BIN(31) INIT((150)0), 2 STEXT(150) FIXED BIN(31) INIT((150)0), 2 KEY(150) FIXED BIN(31) INIT((150)0), 2 COND(150) FIXED BIN(31) INIT((150)0), 2 PLAC(100) FIXED BIN(31) INIT((100)0), 2 FIXD(100) FIXED BIN(31) INIT((100)0), 2 PROP(100) FIXED BIN(31) INIT((100)0), 2 ACTSPK(35) FIXED BIN(31) INIT((35)0), 2 CTEXT(12) FIXED BIN(31) INIT((12)0), 2 CVAL(12) FIXED BIN(31) INIT((12)0), 2 HINTS(20,4) FIXED BIN(31) INIT((80)0), 2 HINTED(20) BIT(1) , 2 TK(20) FIXED BIN(31) , 2 TKWORD(10) CHAR(1) , 2 DLOC(6) FIXED BIN(31) , 2 ODLOC(6) FIXED BIN(31) , 2 DSEEN(6) BIT(1) , 2 LINSIZ FIXED BIN(31) INIT (9650) , 2 TRVSIZ FIXED BIN(31) INIT (750) , 2 LOCSIZ FIXED BIN(31) INIT (150) , 2 VRBSIZ FIXED BIN(31) INIT (35) , 2 RTXSIZ FIXED BIN(31) INIT (205) , 2 CLSMAX FIXED BIN(31) INIT (12) , 2 HNTSIZ FIXED BIN(31) INIT (20) , 2 WZDARK BIT(1) , 2 LMWARN BIT(1) , 2 CLOSNG BIT(1) , 2 PANIC BIT(1) , 2 CLOSED BIT(1) , 2 GAVEUP BIT(1) , 2 SCORNG BIT(1) , 2 LOGON BIT(1) INIT ('0'B), 2 YEA BIT(1) ; 1/* 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 YEA IS RANDOM YES/NO REPLY */ 1/* DESCRIPTION OF THE DATABASE FORMAT 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, A TAB, AND A LINE OF TEXT. THE SET OF (NECESSARILY 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: TRAVEL TABLE. EACH LINE CONTAINS A LOCATION NUMBER (X), A SECOND LOCATION NUMBER (Y), AND A LIST OF MOTION NUMBERS (SEE SECTION 4). 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<=300 IT IS THE LOCATION TO GO TO. IF 300500 MESSAGE N-500 FROM SECTION 6 IS PRINTED, AND HE STAYS WHEREVER HE IS. MEANWHILE, M SPECIFIES THE CONDITIONS ON THE MOTION. IF M=0 IT'S UNCONDITIONAL. IF 0$<". 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 4). SECTION 7: OBJECT LOCATIONS. EACH LINE CONTAINS AN OBJECT NUMBER AND ITS INITIAL LOCATION (ZERO (OR OMITTED) IF NONE). IF THE OBJECT IS IMMOVABLE, THE LOCATION IS FOLLOWED BY A "-1". IF IT HAS TWO LOCATIONS (E.G. THE GRATE) THE FIRST LOCATION IS FOLLOWED WITH THE SECOND, AND THE OBJECT IS ASSUMED TO BE IMMOVABLE. SECTION 8: ACTION DEFAULTS. EACH LINE CONTAINS AN "ACTION-VERB" NUMBER AND THE INDEX (IN SECTION 6) OF THE DEFAULT MESSAGE FOR THE VERB. SECTION 9: LIQUID ASSETS, ETC. EACH LINE CONTAINS A NUMBER (N) AND UP TO 20 LOCATION NUMBERS. BIT N (WHERE 0 IS THE UNITS BIT) IS SET IN COND(LOC) FOR EACH LOC GIVEN. THE COND BITS CURRENTLY ASSIGNED ARE: 0 LIGHT 1 IF BIT 2 IS ON: ON FOR OIL, OFF FOR WATER 2 LIQUID ASSET, SEE BIT 1 3 PIRATE DOESN'T GO HERE UNLESS FOLLOWING PLAYER OTHER BITS ARE USED TO INDICATE AREAS OF INTEREST TO "HINT" ROUTINES: 4 TRYING TO GET INTO CAVE 5 TRYING TO CATCH BIRD 6 TRYING TO DEAL WITH SNAKE 7 LOST IN MAZE 8 PONDERING DARK ROOM 9 AT WITT'S END COND(LOC) IS SET TO 2, OVERRIDING ALL OTHER BITS, IF LOC HAS FORCED MOTION. SECTION 10: CLASS MESSAGES. EACH LINE CONTAINS A NUMBER (N), A TAB, AND A MESSAGE DESCRIBING A CLASSIFICATION OF PLAYER. THE SCORING SECTION SELECTS THE APPROPRIATE MESSAGE, WHERE EACH MESSAGE IS CONSIDERED TO APPLY TO PLAYERS WHOSE SCORES ARE HIGHER THAN THE PREVIOUS N BUT NOT HIGHER THAN THIS N. NOTE THAT THESE SCORES PROBABLY CHANGE WITH EVERY MODIFICATION (AND PARTICULARLY EXPANSION) OF THE PROGRAM. SECTION 11: HINTS. EACH LINE CONTAINS A HINT NUMBER (CORRESPONDING TO A COND BIT, SEE SECTION 9), THE NUMBER OF TURNS HE MUST BE 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-3 ARE UNUSABLE SINCE COND BITS ARE OTHERWISE ASSIGNED, SO 2 IS USED TO REMEMBER IF HE'S READ THE CLUE IN THE REPOSITORY, AND 3 IS USED TO REMEMBER WHETHER HE ASKED FOR INSTRUCTIONS (GETS MORE TURNS, BUT LOSES POINTS). SECTION 12: MAGIC MESSAGES. IDENTICAL TO SECTION 6 EXCEPT PUT IN A SEPARATE SECTION FOR EASIER REFERENCE. MAGIC MESSAGES ARE USED BY THE STARTUP, MAINTENANCE MODE, AND RELATED ROUTINES. SECTION 0: END OF DATABASE. */ ON ERROR BEGIN; PUT SKIP DATA (ADVARS); END; 1/* READ THE DATABASE IF WE HAVE NOT YET DONE SO */ PUT STRING (OUTSTR) EDIT ('Initializing...') (A); CALL LINEOUT; /* 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(N)=0. SUCCESSIVE PROP MESSAGES ARE FOUND BY CHASING POINTERS. RTEXT CONTAINS SECTION 6'S STUFF. CTEXT(N) POINTS TO A PLAYER-CLASS MESSAGE. MTEXT IS FOR SECTION 12. WE ALSO CLEAR COND. SEE DESCRIPTION OF SECTION 9 FOR DETAILS. */ DO I=1 TO 300; IF I <= 100 THEN PTEXT(I)=0; IF I <= RTXSIZ THEN RTEXT(I)=0; IF I <= CLSMAX THEN CTEXT(I)=0; IF I <= LOCSIZ THEN DO; STEXT(I)=0; LTEXT(I)=0; COND(I)=0; END; END; KEY=0; LINUSE=1; TRVS=1; CLSSES=1; /* START NEW DATA SECTION. SECT IS THE SECTION NUMBER. */ L1002: GET FILE (CAVES) EDIT (SECT) (COL(1),F(8)); OLDLOC=-1; PUT STRING (OUTSTR) EDIT ('Reading section #',SECT) (A,F(2)); CALL LINEOUT; SELECT (SECT); WHEN (00) GO TO L1100; /* (0) */ WHEN (01) GO TO L1004; /* (1) */ WHEN (02) GO TO L1004; /* (2) */ WHEN (03) GO TO L1030; /* (3) */ WHEN (04) GO TO L1040; /* (4) */ WHEN (05) GO TO L1004; /* (5) */ WHEN (06) GO TO L1004; /* (6) */ WHEN (07) GO TO L1050; /* (7) */ WHEN (08) GO TO L1060; /* (8) */ WHEN (09) GO TO L1070; /* (9) */ WHEN (10) GO TO L1004; /* (10) */ WHEN (11) GO TO L1080; /* (11) */ END; CALL BUG(9); /* SECTIONS 1, 2, 5, 6, 10. READ MESSAGES AND SET UP POINTERS. */ L1004: GET FILE (CAVES) EDIT (LOC,(LINES(J) DO J=LINUSE+1 TO LINUSE+14),KKWORD) (COL(1),F(8),14 A(5),A(2)); IF KKWORD ¬= ' ' THEN CALL BUG(0); IF LOC = -1 THEN GOTO L1002; DO K=1 TO 14; KK=LINUSE+15-K; IF LINES(KK) ¬= ' ' THEN GOTO L1007; END; CALL BUG(1); L1007: PICWORD=KK+1; LINES(LINUSE)=PICWORD; IF LOC = OLDLOC THEN GOTO L1020; PICWORD=-LINES(LINUSE); LINES(LINUSE)=PICWORD; IF SECT = 10 THEN GOTO L1012; IF SECT = 6 THEN GOTO L1011; IF SECT = 5 THEN GOTO L1010; IF SECT = 1 THEN GOTO L1008; STEXT(LOC)=LINUSE; GOTO L1020; L1008: LTEXT(LOC)=LINUSE; GOTO L1020; L1010: IF LOC > 0 & LOC <= 100 THEN PTEXT(LOC)=LINUSE; GOTO L1020; L1011: IF LOC > RTXSIZ THEN CALL BUG(6); RTEXT(LOC)=LINUSE; GOTO L1020; L1012: CTEXT(CLSSES)=LINUSE; CVAL(CLSSES)=LOC; CLSSES=CLSSES+1; L1020: LINUSE=KK+1; LINES(LINUSE)='-1 '; OLDLOC=LOC; IF LINUSE+14 > LINSIZ THEN CALL BUG(2); GOTO L1004; 1/* THE STUFF FOR SECTION 3 IS ENCODED HERE. EACH "FROM-LOCATION" GETS A CONTIGUOUS SECTION OF THE "TRAVEL" ARRAY. EACH ENTRY IN TRAVEL IS NEWLOC*1000 + KEYWORD (FROM SECTION 4, MOTION VERBS), AND IS NEGATED IF THIS IS THE LAST ENTRY FOR THIS LOCATION. KEY(N) IS THE INDEX IN TRAVEL OF THE FIRST OPTION AT LOCATION N. */ L1030: GET FILE (CAVES) EDIT (LOC,NEWLOC,(TK(I) DO I=1 TO 8)) (COL(1),10 F(8)); IF LOC = -1 THEN GOTO L1002; IF KEY(LOC) ¬= 0 THEN GOTO L1033; KEY(LOC)=TRVS; GOTO L1035; L1033: TRAVEL(TRVS-1)=-TRAVEL(TRVS-1); L1035: DO L=1 TO 8; IF TK(L) = 0 THEN GOTO L1039; TRAVEL(TRVS)=NEWLOC*1000+TK(L); TRVS=TRVS+1; IF TRVS = TRVSIZ THEN CALL BUG(3); END; L1039: TRAVEL(TRVS-1)=-TRAVEL(TRVS-1); GOTO L1030; /* HERE WE READ IN THE VOCABULARY. KTAB(N) IS THE WORD NUMBER, ATAB(N) IS THE CORRESPONDING WORD. THE -1 AT THE END OF SECTION 4 IS LEFT IN KTAB AS AN END-MARKER. THE WORDS ARE GIVEN A MINIMAL HASH TO MAKE READING THE CORE-IMAGE HARDER. NOTE THAT '/7-08' HAD BETTER NOT BE IN THE LIST, SINCE IT COULD HASH TO -1. (HASHING REMOVED IN PL/1 VERSION..BRD) */ L1040: DO TABNDX=1 TO TABSIZ; L1043: GET FILE (CAVES) EDIT (KTAB(TABNDX),ATAB(TABNDX)) (COL(1),F(8),A (5)); IF KTAB(TABNDX) = -1 THEN GOTO L1002; END; CALL BUG(4); /* READ IN THE INITIAL LOCATIONS FOR EACH OBJECT. ALSO THE IMMOVABILITY INFO. PLAC CONTAINS INITIAL LOCATIONS OF OBJECTS. FIXD IS -1 FOR IMMOVABLE OBJECTS (INCLUDING THE SNAKE), OR = SECOND LOC FOR TWO-PLACED OBJECTS. */ L1050: GET FILE (CAVES) EDIT (OBJ,J,K) (COL(1),3 F(8)); IF OBJ = -1 THEN GOTO L1002; PLAC(OBJ)=J; FIXD(OBJ)=K; GOTO L1050; /* READ DEFAULT MESSAGE NUMBERS FOR ACTION VERBS, STORE IN ACTSPK. */ L1060: GET FILE (CAVES) EDIT (VERB,J) (COL(1),2 F(8)); IF VERB = -1 THEN GOTO L1002; ACTSPK(VERB)=J; GOTO L1060; /* READ INFO ABOUT AVAILABLE LIQUIDS AND OTHER CONDITIONS, STORE IN COND. */ L1070: GET FILE (CAVES) EDIT (K,(TK(I) DO I=1 TO 9)) (COL(1),10 F(8)); IF K = -1 THEN GOTO L1002; DO I=1 TO 9; LOC=TK(I); IF LOC = 0 THEN GOTO L1070; IF BITSET(LOC,K) THEN CALL BUG(8); COND(LOC)=COND(LOC)+2**K; END; GOTO L1070; /* READ DATA FOR HINTS. */ L1080: HNTMAX=0; L1081: GET FILE (CAVES) EDIT (K,(TK(I) DO I=1 TO 4)) (COL(1),5 F(8)); IF K = -1 THEN GOTO L1002; IF K = 0 THEN GOTO L1081; IF K < 0 | K > HNTSIZ THEN CALL BUG(7); DO I=1 TO 4; HINTS(K,I)=TK(I); END; HNTMAX=MAX(HNTMAX,K); GOTO L1081; 1/* FINISH CONSTRUCTING INTERNAL DATA FORMAT HAVING READ IN THE DATABASE, CERTAIN THINGS ARE NOW CONSTRUCTED. PROPS ARE SET TO ZERO. WE FINISH SETTING UP COND BY CHECKING FOR FORCED-MOTION TRAVEL ENTRIES. THE PLAC AND FIXD ARRAYS ARE USED TO SET UP ATLOC(N) AS THE FIRST OBJECT AT LOCATION N, AND LINK(OBJ) AS THE NEXT OBJECT AT THE SAME LOCATION AS OBJ. (OBJ>100 INDICATES THAT FIXED(OBJ-100)=LOC, LINK(OBJ) IS STILL THE CORRECT LINK TO USE.) ABB IS ZEROED, IT CONTROLS WHETHER THE ABBREVIATED DESCRIPTION IS PRINTED. COUNTS MOD 5 UNLESS "LOOK" IS USED. */ L1100: DO I=1 TO 100; PLACE(I)=0; PROP(I)=0; LINK(I)=0; LINK(I+100)=0; END; DO I=1 TO LOCSIZ; ABB(I)=0; IF LTEXT(I) = 0 | KEY(I) = 0 THEN GOTO L1102; K=KEY(I); IF MOD(ABS(TRAVEL(K)),1000) = 1 THEN COND(I)=2; L1102: ATLOC(I)=0; END; /* SET UP THE ATLOC AND LINK ARRAYS AS DESCRIBED ABOVE. WE'LL USE THE DROP SUBROUTINE, WHICH PREFACES NEW OBJECTS ON THE LISTS. SINCE WE WANT THINGS IN THE OTHER ORDER, WE'LL RUN THE LOOP BACKWARDS. IF THE OBJECT IS IN TWO LOCS, WE DROP IT TWICE. THIS ALSO SETS UP "PLACE" AND "FIXED" AS COPIES OF "PLAC" AND "FIXD". ALSO, SINCE TWO-PLACED OBJECTS ARE TYPICALLY BEST DESCRIBED LAST, WE'LL DROP THEM FIRST. */ DO I=1 TO 100; K=101-I; IF FIXD(K) > 0 THEN DO; CALL DROP(K+100,FIXD(K)); CALL DROP(K,PLAC(K)); END; END; DO I=1 TO 100; K=101-I; FIXED(K)=FIXD(K); IF PLAC(K) ¬= 0 & FIXD(K) <= 0 THEN CALL DROP(K,PLAC(K)); END; /* TREASURES, AS NOTED EARLIER, ARE OBJECTS 50 THROUGH MAXTRS (CURRENTLY 79). THEIR PROPS ARE INITIALLY -1, AND ARE SET TO 0 THE FIRST TIME THEY ARE DESCRIBED. TALLY KEEPS TRACK OF HOW MANY ARE NOT YET FOUND, SO WE KNOW WHEN TO CLOSE THE CAVE. TALLY2 COUNTS HOW MANY CAN NEVER BE FOUND (E.G. IF LOST BIRD OR BRIDGE). */ MAXTRS=79; TALLY=0; TALLY2=0; DO I=50 TO MAXTRS; IF PTEXT(I) ¬= 0 THEN PROP(I)=-1; TALLY=TALLY-PROP(I); END; /* CLEAR THE HINT STUFF. HINTLC(I) IS HOW LONG HE'S BEEN AT LOC WITH COND BIT I. HINTED(I) IS TRUE IFF HINT I HAS BEEN USED. */ DO I=1 TO HNTMAX; HINTED(I)='0'B; HINTLC(I)=0; END; /* DEFINE SOME HANDY MNEMONICS. THESE CORRESPOND TO OBJECT NUMBERS. */ KEYS=VOCAB('KEYS',1); LAMP=VOCAB('LAMP',1); GRATE=VOCAB('GRATE',1); CAGE=VOCAB('CAGE',1); ROD=VOCAB('ROD',1); ROD2=ROD+1; STEPS=VOCAB('STEPS',1); BIRD=VOCAB('BIRD',1); DOOR=VOCAB('DOOR',1); PILLOW=VOCAB('PILLO',1); SNAKE=VOCAB('SNAKE',1); FISSUR=VOCAB('FISSU',1); TABLET=VOCAB('TABLE',1); CLAM=VOCAB('CLAM',1); OYSTER=VOCAB('OYSTE',1); MAGZIN=VOCAB('MAGAZ',1); DWARF=VOCAB('DWARF',1); KNIFE=VOCAB('KNIFE',1); FOOD=VOCAB('FOOD',1); BOTTLE=VOCAB('BOTTL',1); WATER=VOCAB('WATER',1); OIL=VOCAB('OIL',1); PLANT=VOCAB('PLANT',1); PLANT2=PLANT+1; AXE=VOCAB('AXE',1); MIRROR=VOCAB('MIRRO',1); DRAGON=VOCAB('DRAGO',1); CHASM=VOCAB('CHASM',1); TROLL=VOCAB('TROLL',1); TROLL2=TROLL+1; BEAR=VOCAB('BEAR',1); MESSAG=VOCAB('MESSA',1); VEND=VOCAB('VENDI',1); BATTER=VOCAB('BATTE',1); /* OBJECTS FROM 50 THROUGH WHATEVER ARE TREASURES. HERE ARE A FEW. */ NUGGET=VOCAB('GOLD',1); COINS=VOCAB('COINS',1); CHEST=VOCAB('CHEST',1); EGGS=VOCAB('EGGS',1); TRIDNT=VOCAB('TRIDE',1); VASE=VOCAB('VASE',1); EMRALD=VOCAB('EMERA',1); PYRAM=VOCAB('PYRAM',1); PEARL=VOCAB('PEARL',1); RUG=VOCAB('RUG',1); CHAIN=VOCAB('CHAIN',1); /* THESE ARE MOTION-VERB NUMBERS. */ BACK=VOCAB('BACK',0); LOOK=VOCAB('LOOK',0); CAVE=VOCAB('CAVE',0); NULLX=VOCAB('NULL',0); ENTRNC=VOCAB('ENTRA',0); DPRSSN=VOCAB('DEPRE',0); /* AND SOME ACTION VERBS. */ SAY=VOCAB('SAY',2); LOCK=VOCAB('LOCK',2); THROW=VOCAB('THROW',2); FIND=VOCAB('FIND',2); INVENT=VOCAB('INVEN',2); /* INITIALIZE THE DWARVES. DLOC IS LOC OF DWARVES, HARD-WIRED IN. ODLOC IS PRIOR LOC OF EACH DWARF, INITIALLY GARBAGE. DALTLC IS ALTERNATE INITIAL LOC FOR DWARF, IN CASE ONE OF THEM STARTS OUT ON TOP OF THE ADVENTURER. (NO 2 OF THE 5 INITIAL LOCS ARE ADJACENT.) DSEEN IS TRUE IF DWARF HAS SEEN HIM. DFLAG CONTROLS THE LEVEL OF ACTIVATION OF ALL THIS: 0 NO DWARF STUFF YET (WAIT UNTIL REACHES HALL OF MISTS) 1 REACHED HALL OF MISTS, BUT HASN'T MET FIRST DWARF 2 MET FIRST DWARF, OTHERS START MOVING, NO KNIVES THROWN YET 3 A KNIFE HAS BEEN THROWN (FIRST SET ALWAYS MISSES) 3+ DWARVES ARE MAD (INCREASES THEIR ACCURACY) SIXTH DWARF IS SPECIAL (THE PIRATE). HE ALWAYS STARTS AT HIS CHEST'S EVENTUAL LOCATION INSIDE THE MAZE. THIS LOC IS SAVED IN CHLOC FOR REF. THE DEAD END IN THE OTHER MAZE HAS ITS LOC STORED IN CHLOC2. */ CHLOC=114; CHLOC2=140; DO I=1 TO 6; DSEEN(I)='0'B; END; DFLAG=0; DLOC(1)=19; DLOC(2)=27; DLOC(3)=33; DLOC(4)=44; DLOC(5)=64; DLOC(6)=CHLOC; DALTLC=18; 1/* OTHER RANDOM FLAGS AND COUNTERS, AS FOLLOWS: TURNS TALLIES HOW MANY COMMANDS HE'S GIVEN (IGNORES YES/NO) LIMIT LIFETIME OF LAMP (NOT SET HERE) IWEST HOW MANY TIMES HE'S SAID "WEST" INSTEAD OF "W" KNFLOC 0 IF NO KNIFE HERE, LOC IF KNIFE HERE, -1 AFTER CAVEAT DETAIL HOW OFTEN WE'VE SAID "NOT ALLOWED TO GIVE MORE DETAIL" ABBNUM HOW OFTEN WE SHOULD PRINT NON-ABBREVIATED DESCRIPTIONS MAXDIE NUMBER OF REINCARNATION MESSAGES AVAILABLE (UP TO 5) NUMDIE NUMBER OF TIMES KILLED SO FAR HOLDNG NUMBER OF OBJECTS BEING CARRIED DKILL NUMBER OF DWARVES KILLED (UNUSED IN SCORING, NEEDED FOR MSG) FOOBAR CURRENT PROGRESS IN SAYING "FEE FIE FOE FOO". BONUS USED TO DETERMINE AMOUNT OF BONUS IF HE REACHES CLOSING CLOCK1 NUMBER OF TURNS FROM FINDING LAST TREASURE TILL CLOSING CLOCK2 NUMBER OF TURNS FROM FIRST WARNING TILL BLINDING FLASH LOGICALS WERE EXPLAINED EARLIER */ TURNS=0; LMWARN='0'B; IWEST=0; KNFLOC=0; DETAIL=0; ABBNUM=5; DO I=0 TO 4; IF RTEXT(2*I+81) ¬= 0 THEN MAXDIE=I+1; END; NUMDIE=0; HOLDNG=0; DKILL=0; FOOBAR=0; BONUS=0; CLOCK1=30; CLOCK2=50; CLOSNG='0'B; PANIC='0'B; CLOSED='0'B; GAVEUP='0'B; SCORNG='0'B; 1/* REPORT ON AMOUNT OF ARRAYS ACTUALLY USED, TO PERMIT REDUCTIONS. */ DO K=1 TO LOCSIZ; KK=LOCSIZ+1-K; IF LTEXT(KK) ¬= 0 THEN GOTO L1997; END; OBJ=0; L1997: DO K=1 TO 100; IF PTEXT(K) ¬= 0 THEN OBJ=OBJ+1; END; DO K=1 TO TABNDX; IF KTAB(K)/1000 = 2 THEN VERB=KTAB(K)-2000; END; DO K=1 TO RTXSIZ; J=RTXSIZ+1-K; IF RTEXT(J) ¬= 0 THEN GOTO L1991; END; L1991: K=100; CALL LINESKP; PUT STRING (OUTSTR) EDIT (LINUSE,' of ',LINSIZ, ' words of messages') (F(6),A,F(6),A); CALL LINEOUT; PUT STRING (OUTSTR) EDIT (TRVS,' of ',TRVSIZ, ' travel options') (F(6),A,F(6),A); CALL LINEOUT; PUT STRING (OUTSTR) EDIT (TABNDX,' of ',TABSIZ, ' vocabulary words') (F(6),A,F(6),A); CALL LINEOUT; PUT STRING (OUTSTR) EDIT (KK,' of ',LOCSIZ, ' locations') (F(6),A,F(6),A); CALL LINEOUT; PUT STRING (OUTSTR) EDIT (OBJ,' of ',K, ' objects') (F(6),A,F(6),A); CALL LINEOUT; PUT STRING (OUTSTR) EDIT (VERB,' of ',VRBSIZ, ' action verbs') (F(6),A,F(6),A); CALL LINEOUT; PUT STRING (OUTSTR) EDIT (J,' of ',RTXSIZ, ' rtext messages') (F(6),A,F(6),A); CALL LINEOUT; PUT STRING (OUTSTR) EDIT (CLSSES,' of ',CLSSIZ, ' class messages') (F(6),A,F(6),A); CALL LINEOUT; PUT STRING (OUTSTR) EDIT (HNTMAX,' of ',HNTSIZ, ' hints') (F(6),A,F(6),A); CALL LINEOUT; CALL LINESKP; /* FINALLY, SINCE WE'RE CLEARLY SETTING THINGS UP FOR THE FIRST TIME... */ PUT STRING (OUTSTR) EDIT ('Done!') (A); CALL LINEOUT; CALL LINESKP; CALL LINESKP; 1/* START-UP, DWARF STUFF */ L1: CALL ITIME(I); DO J=1 TO I; CALL RAN(1); END; I=RAN(1); HINTED(3)=YES(65,1,0); LOC,NEWLOC=1; LIMIT=500; IF HINTED(3) THEN LIMIT=1000; /* CAN'T LEAVE CAVE ONCE IT'S CLOSING (EXCEPT BY MAIN OFFICE). */ L2: IF NEWLOC >= 9 | NEWLOC = 0 | ¬ CLOSNG THEN GOTO L71; CALL RSPEAK(130); NEWLOC=LOC; IF ¬ PANIC THEN CLOCK2=15; PANIC='1'B; /* 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). */ L71: IF NEWLOC = LOC | FORCED(LOC) | BITSET(LOC,3) THEN GOTO L74; DO I=1 TO 5; IF ¬ (ODLOC(I) ¬= NEWLOC | ¬ DSEEN(I)) THEN DO; NEWLOC=LOC; CALL RSPEAK(2); GOTO L74; END; END; L74: 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 | FORCED(LOC) | BITSET(NEWLOC,3) THEN GOTO L2000; IF DFLAG ¬= 0 THEN GOTO L6000; IF LOC >= 15 THEN DFLAG=1; GOTO L2000; /* 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. */ L6000: IF DFLAG ¬= 1 THEN GOTO L6010; IF LOC < 15 | PCT(95) THEN GOTO L2000; DFLAG=2; DO I=1 TO 2; J=1+RAN(5); IF PCT(50) THEN DLOC(J)=0; END; DO I=1 TO 5; IF DLOC(I) = LOC THEN DLOC(I)=DALTLC; ODLOC(I)=DLOC(I); END; CALL RSPEAK(3); CALL DROP(AXE,LOC); GOTO L2000; /* 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. */ L6010: DTOTAL=0; ATTACK=0; STICK=0; DO I=1 TO 6; IF DLOC(I) = 0 THEN GOTO L6030; J=1; KK=DLOC(I); KK=KEY(KK); IF KK = 0 THEN GOTO L6016; L6012: NEWLOC=MOD(ABS(TRAVEL(KK))/1000,1000); IF NEWLOC > 300 | NEWLOC < 15 | NEWLOC = ODLOC(I) | (J > 1 & NEWLOC = TK(J-1)) | J >= 20 | NEWLOC = DLOC(I) | FORCED(NEWLOC) | (I = 6 & BITSET(NEWLOC,3)) | ABS(TRAVEL(KK))/1000000 = 100 THEN GOTO L6014; TK(J)=NEWLOC; J=J+1; L6014: KK=KK+1; IF TRAVEL(KK-1) >= 0 THEN GOTO L6012; L6016: TK(J)=ODLOC(I); IF J >= 2 THEN J=J-1; J=1+RAN(J); ODLOC(I)=DLOC(I); DLOC(I)=TK(J); DSEEN(I)=(DSEEN(I) & LOC >= 15) | (DLOC(I) = LOC | ODLOC(I) = LOC); IF ¬DSEEN(I) THEN GOTO L6030; DLOC(I)=LOC; IF I ¬= 6 THEN GOTO L6027; /* 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 | PROP(CHEST) >= 0 THEN GOTO L6030; K=0; DO J=50 TO MAXTRS; /* PIRATE WON'T TAKE PYRAMID FROM PLOVER ROOM OR DARK ROOM (TOO EASY!). */ IF J = PYRAM & (LOC = PLAC(PYRAM) | LOC = PLAC(EMRALD)) THEN GOTO L6020; IF TOTING(J) THEN GOTO L6022; L6020: IF HERE(J) THEN K=1; END; IF TALLY = TALLY2+1 & K = 0 & PLACE(CHEST) = 0 & HERE(LAMP) & PROP(LAMP) = 1 THEN GOTO L6025; IF ODLOC(6) ¬= DLOC(6) & PCT(20) THEN CALL RSPEAK(127); GOTO L6030; L6022: CALL RSPEAK(128); /* DON'TSTEAL CHEST BACK FROM TROLL! */ IF PLACE(MESSAG) = 0 THEN CALL MOVE(CHEST,CHLOC); CALL MOVE(MESSAG,CHLOC2); DO J=50 TO MAXTRS; IF J = PYRAM & (LOC = PLAC(PYRAM) | LOC = PLAC(EMRALD)) THEN GOTO L6023; IF AT(J) & FIXED(J) = 0 THEN CALL CARRY(J,LOC); IF TOTING(J) THEN CALL DROP(J,CHLOC); L6023: END; L6024: DLOC(6)=CHLOC; ODLOC(6)=CHLOC; DSEEN(6)='0'B; GOTO L6030; L6025: CALL RSPEAK(186); CALL MOVE(CHEST,CHLOC); CALL MOVE(MESSAG,CHLOC2); GOTO L6024; /* THIS THREATENING LITTLE DWARF IS IN THE ROOM WITH HIM! */ L6027: DTOTAL=DTOTAL+1; IF ODLOC(I) ¬= DLOC(I) THEN GOTO L6030; ATTACK=ATTACK+1; IF KNFLOC >= 0 THEN KNFLOC=LOC; IF RAN(1000) < 95*(DFLAG-2) THEN STICK=STICK+1; L6030: END; /* NOW WE KNOW WHAT'S HAPPENING. LET'S TELL THE POOR SUCKER ABOUT IT. */ IF DTOTAL = 0 THEN GOTO L2000; IF DTOTAL = 1 THEN GOTO L75; CALL LINESKP; PUT STRING (OUTSTR) EDIT ('There are ',DTOTAL, ' threatening little dwarves in the room with you.') (A,F(1),A); CALL LINEOUT; GOTO L77; L75: CALL RSPEAK(4); L77: IF ATTACK = 0 THEN GOTO L2000; IF DFLAG = 2 THEN DFLAG=3; /* DWARVES GET *VERY* MAD! */ IF ATTACK = 1 THEN GOTO L79; PUT STRING (OUTSTR) EDIT (ATTACK, ' of them throw knives at you!') (F(1),A); CALL LINEOUT; K=6; L82: IF STICK > 1 THEN GOTO L83; CALL RSPEAK(K+STICK); IF STICK = 0 THEN GOTO L2000; GOTO L84; L83: PUT STRING (OUTSTR) EDIT (STICK,' of them get you!') (F(1),A); CALL LINEOUT; L84: OLDLC2=LOC; GOTO L99; L79: CALL RSPEAK(5); K=52; GOTO L82; 1/* DESCRIBE THE CURRENT LOCATION AND (MAYBE) GET NEXT COMMAND. */ /* PRINT TEXT FOR CURRENT LOC. */ L2000: IF LOC = 0 THEN GOTO L99; KK=STEXT(LOC); IF MOD(ABB(LOC),ABBNUM) = 0 | KK = 0 THEN KK=LTEXT(LOC); IF FORCED(LOC) | ¬ DARK(0) THEN GOTO L2001; IF WZDARK & PCT(35) THEN GOTO L90; KK=RTEXT(16); L2001: IF TOTING(BEAR) THEN CALL RSPEAK(141); CALL SPEAK(KK); K=1; IF FORCED(LOC) THEN GOTO L8; IF LOC = 33 & PCT(25) & ¬ CLOSNG THEN CALL RSPEAK(8); /* 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 CHAIN, PROP IS INITIALLY 1 (LOCKED TO BEAR). THESE HACKS ARE BECAUSE PROP=0 IS NEEDED TO GET FULL SCORE. */ IF DARK(0) THEN GOTO L2012; ABB(LOC)=ABB(LOC)+1; I=ATLOC(LOC); L2004: IF I = 0 THEN GOTO L2012; OBJ=I; IF OBJ > 100 THEN OBJ=OBJ-100; IF OBJ = STEPS & TOTING(NUGGET) THEN GOTO L2008; IF PROP(OBJ) >= 0 THEN GOTO L2006; IF CLOSED THEN GOTO L2008; PROP(OBJ)=0; IF OBJ = RUG | OBJ = CHAIN THEN PROP(OBJ)=1; TALLY=TALLY-1; /* IF REMAINING TREASURES TOO ELUSIVE, ZAP HIS LAMP. */ IF TALLY = TALLY2 & TALLY ¬= 0 THEN LIMIT=MIN(35,LIMIT); L2006: KK=PROP(OBJ); IF OBJ = STEPS & LOC = FIXED(STEPS) THEN KK=1; CALL PSPEAK(OBJ,KK); L2008: I=LINK(I); GOTO L2004; L2009: K=54; L2010: SPK=K; L2011: CALL RSPEAK(SPK); L2012: 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). */ L2600: DO HINT=4 TO HNTMAX; IF ¬ (HINTED(HINT)) THEN DO; IF ¬BITSET(LOC,HINT) THEN HINTLC(HINT)=-1; HINTLC(HINT)=HINTLC(HINT)+1; IF HINTLC(HINT) >= HINTS(HINT,1) THEN GOTO L40000; END; END; /* 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). */ L2602: IF ¬CLOSED THEN GOTO L2605; IF PROP(OYSTER) < 0 & TOTING(OYSTER) THEN CALL PSPEAK(OYSTER,1); DO I=1 TO 100; IF TOTING(I) & PROP(I) < 0 THEN PROP(I)=-1-PROP(I); END; L2605: WZDARK=DARK(0); IF KNFLOC > 0 & KNFLOC ¬= LOC THEN KNFLOC=0; I=RAN(1); CALL GETIN(WD1,WD1X,WD2,WD2X); /* 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. */ L2608: FOOBAR=MIN(0,-FOOBAR); TURNS=TURNS+1; IF VERB = SAY & WD2 ¬= ' ' THEN VERB=0; IF VERB = SAY THEN GOTO L4090; IF TALLY = 0 & LOC >= 15 & LOC ¬= 33 THEN CLOCK1=CLOCK1-1; IF CLOCK1 = 0 THEN GOTO L10000; IF CLOCK1 < 0 THEN CLOCK2=CLOCK2-1; IF CLOCK2 = 0 THEN GOTO L11000; IF PROP(LAMP) = 1 THEN LIMIT=LIMIT-1; IF LIMIT <= 30 & HERE(BATTER) & PROP(BATTER) = 0 & HERE(LAMP) THEN GOTO L12000; IF LIMIT = 0 THEN GOTO L12400; IF LIMIT < 0 & LOC <= 8 THEN GOTO L12600; IF LIMIT <= 30 THEN GOTO L12200; L19999: K=43; IF LIQLOC(LOC) = WATER THEN K=70; IF WD1 = 'ENTER' & (WD2 = 'STREA' | WD2 = 'WATER') THEN GOTO L2010; IF WD1 = 'ENTER' & WD2 ¬= ' ' THEN GOTO L2800; IF (WD1 ¬= 'WATER' & WD1 ¬= 'OIL') | (WD2 ¬= 'PLANT' & WD2 ¬= 'DOOR') THEN GOTO L2610; IF AT(VOCAB(WD2,1)) THEN WD2='POUR'; L2610: IF WD1 ¬= 'WEST' THEN GOTO L2630; IWEST=IWEST+1; IF IWEST = 10 THEN CALL RSPEAK(17); L2630: I=VOCAB(WD1,-1); IF I = -1 THEN GOTO L3000; K=MOD(I,1000); KQ=I/1000+1; SELECT (KQ-1); WHEN (0) GO TO L8; WHEN (1) GO TO L5000; WHEN (2) GO TO L4000; WHEN (3) GO TO L2010; END; CALL BUG(22); /* GET SECOND WORD FOR ANALYSIS. */ L2800: WD1=WD2; WD1X=WD2X; WD2=' '; GOTO L2610; /* GEE, I DON'T UNDERSTAND. */ L3000: SPK=60; IF PCT(20) THEN SPK=61; IF PCT(20) THEN SPK=13; CALL RSPEAK(SPK); GOTO L2600; /* ANALYSE A VERB. REMEMBER WHAT IT WAS, GO BACK FOR OBJECT IF SECOND WORD UNLESS VERB IS "SAY", WHICH SNARFS ARBITRARY SECOND WORD. */ L4000: VERB=K; SPK=ACTSPK(VERB); IF WD2 ¬= ' ' & VERB ¬= SAY THEN GOTO L2800; IF VERB = SAY THEN IF WD2 = ' ' THEN GO TO L4080; ELSE GO TO L4090; IF OBJ ¬= 0 THEN GOTO L4090; /* ANALYSE AN INTRANSITIVE VERB (IE, NO OBJECT GIVEN YET). */ L4080: SELECT (VERB); WHEN (01) GO TO L8010; /* TAKE */ WHEN (02) GO TO L8000; /* DROP */ WHEN (03) GO TO L8000; /* SAY */ WHEN (04) GO TO L8040; /* OPEN */ WHEN (05) GO TO L2009; /* NOTH */ WHEN (06) GO TO L8040; /* LOCK */ WHEN (07) GO TO L9070; /* ON */ WHEN (08) GO TO L9080; /* OFF */ WHEN (09) GO TO L8000; /* WAVE */ WHEN (10) GO TO L8000; /* CALM */ WHEN (11) GO TO L2011; /* WALK */ WHEN (12) GO TO L9120; /* KILL */ WHEN (13) GO TO L9130; /* POUR */ WHEN (14) GO TO L8140; /* EAT */ WHEN (15) GO TO L9150; /* DRNK */ WHEN (16) GO TO L8000; /* RUB */ WHEN (17) GO TO L8000; /* TOSS */ WHEN (18) GO TO L8180; /* QUIT */ WHEN (19) GO TO L8000; /* FIND */ WHEN (20) GO TO L8200; /* INVN */ WHEN (21) GO TO L8000; /* FEED */ WHEN (22) GO TO L9220; /* FILL */ WHEN (23) GO TO L9230; /* BLST */ WHEN (24) GO TO L8240; /* SCOR */ WHEN (25) GO TO L8250; /* FOO */ WHEN (26) GO TO L8260; /* BRF */ WHEN (27) GO TO L8270; /* READ */ WHEN (28) GO TO L8000; /* BREK */ WHEN (29) GO TO L8000; /* WAKE */ WHEN (30) GO TO L8300; /* SUSP */ WHEN (31) GO TO L8310; /* HOUR */ WHEN (32) GO TO SETLOG; /* LOG */ END; CALL BUG(23); /* ANALYSE A TRANSITIVE VERB. */ L4090: SELECT (VERB); WHEN (01) GO TO L9010; /* TAKE */ WHEN (02) GO TO L9020; /* DROP */ WHEN (03) GO TO L9030; /* SAY */ WHEN (04) GO TO L9040; /* OPEN */ WHEN (05) GO TO L2009; /* NOTH */ WHEN (06) GO TO L9040; /* LOCK */ WHEN (07) GO TO L9070; /* ON */ WHEN (08) GO TO L9080; /* OFF */ WHEN (09) GO TO L9090; /* WAVE */ WHEN (10) GO TO L2011; /* CALM */ WHEN (11) GO TO L2011; /* WALK */ WHEN (12) GO TO L9120; /* KILL */ WHEN (13) GO TO L9130; /* POUR */ WHEN (14) GO TO L9140; /* EAT */ WHEN (15) GO TO L9150; /* DRNK */ WHEN (16) GO TO L9160; /* RUB */ WHEN (17) GO TO L9170; /* TOSS */ WHEN (18) GO TO L2011; /* QUIT */ WHEN (19) GO TO L9190; /* FIND */ WHEN (20) GO TO L9190; /* INVN */ WHEN (21) GO TO L9210; /* FEED */ WHEN (22) GO TO L9220; /* FILL */ WHEN (23) GO TO L9230; /* BLST */ WHEN (24) GO TO L2011; /* SCOR */ WHEN (25) GO TO L2011; /* FOO */ WHEN (26) GO TO L2011; /* BRF */ WHEN (27) GO TO L9270; /* READ */ WHEN (28) GO TO L9280; /* BREK */ WHEN (29) GO TO L9290; /* WAKE */ WHEN (30) GO TO L2011; /* SUSP */ WHEN (31) GO TO L2011; /* HOUR */ WHEN (32) GO TO L2011; /* LOG */ END; CALL BUG(24); /* 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. */ L5000: OBJ=K; IF FIXED(K) ¬= LOC & ¬ HERE(K) THEN GOTO L5100; L5010: IF WD2 ¬= ' ' THEN GOTO L2800; IF VERB ¬= 0 THEN GOTO L4090; CALL A5TOA1(WD1,WD1X,TKWORD,K); CALL LINESKP; PUT STRING (OUTSTR) EDIT ('What do you want to do with the ', (TKWORD(I) DO I=1 TO K)) (A,20 A); CALL LINEOUT; GOTO L2600; L5100: IF K ¬= GRATE THEN GOTO L5110; IF LOC = 1 | LOC = 4 | LOC = 7 THEN K=DPRSSN; IF LOC > 9 & LOC < 15 THEN K=ENTRNC; IF K ¬= GRATE THEN GOTO L8; L5110: IF K ¬= DWARF THEN GOTO L5120; DO I=1 TO 5; IF DLOC(I) = LOC & DFLAG >= 2 THEN GOTO L5010; END; L5120: IF (LIQ(0) = K & HERE(BOTTLE)) | K = LIQLOC(LOC) THEN GOTO L5010; IF OBJ ¬= PLANT | ¬ AT(PLANT2) | PROP(PLANT2) = 0 THEN GOTO L5130; OBJ=PLANT2; GOTO L5010; L5130: IF OBJ ¬= KNIFE | KNFLOC ¬= LOC THEN GOTO L5140; KNFLOC=-1; SPK=116; GOTO L2011; L5140: IF OBJ ¬= ROD | ¬HERE(ROD2) THEN GOTO L5190; OBJ=ROD2; GOTO L5010; L5190: IF (VERB = FIND | VERB = INVENT) & WD2 = ' ' THEN GOTO L5010; CALL A5TOA1(WD1,WD1X,TKWORD,K); CALL LINESKP; PUT STRING (OUTSTR) EDIT ('I see no ',(TKWORD(I) DO I=1 TO K),' here!') (A,20 A); CALL LINEOUT; GOTO L2012; 1/* 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.) */ L8: KK=KEY(LOC); NEWLOC=LOC; IF KK = 0 THEN CALL BUG(26); IF K = NULLX THEN GOTO L2; IF K = BACK THEN GOTO L20; IF K = LOOK THEN GOTO L30; IF K = CAVE THEN GOTO L40; OLDLC2=OLDLOC; OLDLOC=LOC; L9: LL=ABS(TRAVEL(KK)); IF MOD(LL,1000) = 1 | MOD(LL,1000) = K THEN GOTO L10; IF TRAVEL(KK) < 0 THEN GOTO L50; KK=KK+1; GOTO L9; L10: LL=LL/1000; L11: NEWLOC=LL/1000; K=MOD(NEWLOC,100); IF NEWLOC <= 300 THEN GOTO L13; IF PROP(K) ¬= NEWLOC/100-3 THEN GOTO L16; L12: IF TRAVEL(KK) < 0 THEN CALL BUG(25); KK=KK+1; NEWLOC=ABS(TRAVEL(KK))/1000; IF NEWLOC = LL THEN GOTO L12; LL=NEWLOC; GOTO L11; L13: IF NEWLOC <= 100 THEN GOTO L14; IF TOTING(K) | (NEWLOC > 200 & AT(K)) THEN GOTO L16; GOTO L12; L14: IF NEWLOC ¬= 0 & ¬PCT(NEWLOC) THEN GOTO L12; L16: NEWLOC=MOD(LL,1000); IF NEWLOC <= 300 THEN GOTO L2; IF NEWLOC <= 500 THEN GOTO L30000; CALL RSPEAK(NEWLOC-500); NEWLOC=LOC; GOTO L2; /* SPECIAL MOTIONS COME HERE. LABELLING CONVENTION: STATEMENT NUMBERS NNNXX (XX=00-99) ARE USED FOR SPECIAL CASE NUMBER NNN (NNN=301-500). */ L30000: NEWLOC=NEWLOC-300; SELECT (NEWLOC-1); WHEN (00) GO TO L30100; WHEN (01) GO TO L30200; WHEN (02) GO TO L30300; END; CALL BUG(20); /* 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". */ L30100: NEWLOC=99+100-LOC; IF HOLDNG = 0 | (HOLDNG = 1 & TOTING(EMRALD)) THEN GOTO L2; NEWLOC=LOC; CALL RSPEAK(117); GOTO L2; /* 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. */ L30200: CALL DROP(EMRALD,LOC); GOTO L12; /* 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. */ L30300: IF PROP(TROLL) ¬= 1 THEN GOTO L30310; CALL PSPEAK(TROLL,1); PROP(TROLL)=0; CALL MOVE(TROLL2,0); CALL MOVE(TROLL2+100,0); CALL MOVE(TROLL,PLAC(TROLL)); CALL MOVE(TROLL+100,FIXD(TROLL)); CALL JUGGLE(CHASM); NEWLOC=LOC; GOTO L2; L30310: NEWLOC=PLAC(TROLL)+FIXD(TROLL)-LOC; IF PROP(TROLL) = 0 THEN PROP(TROLL)=1; IF ¬TOTING(BEAR) THEN GOTO L2; CALL RSPEAK(162); PROP(CHASM)=1; PROP(TROLL)=2; CALL DROP(BEAR,NEWLOC); FIXED(BEAR)=-1; PROP(BEAR)=3; IF PROP(SPICES) < 0 THEN TALLY2=TALLY2+1; OLDLC2=NEWLOC; GOTO L99; /* 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. */ L20: K=OLDLOC; IF FORCED(K) THEN K=OLDLC2; OLDLC2=OLDLOC; OLDLOC=LOC; K2=0; IF K ¬= LOC THEN GOTO L21; CALL RSPEAK(91); GOTO L2; L21: LL=MOD((ABS(TRAVEL(KK))/1000),1000); IF LL = K THEN GOTO L25; IF LL > 300 THEN GOTO L22; J=KEY(LL); IF FORCED(LL) & MOD((ABS(TRAVEL(J))/1000),1000) = K THEN K2=KK; L22: IF TRAVEL(KK) < 0 THEN GOTO L23; KK=KK+1; GOTO L21; L23: KK=K2; IF KK ¬= 0 THEN GOTO L25; CALL RSPEAK(140); GOTO L2; L25: K=MOD(ABS(TRAVEL(KK)),1000); KK=KEY(LOC); GOTO L9; /* 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. */ L30: IF DETAIL < 3 THEN CALL RSPEAK(15); DETAIL=DETAIL+1; WZDARK='0'B; ABB(LOC)=0; GOTO L2; /* CAVE. DIFFERENT MESSAGES DEPENDING ON WHETHER ABOVE GROUND. */ L40: IF LOC < 8 THEN CALL RSPEAK(57); IF LOC >= 8 THEN CALL RSPEAK(58); GOTO L2; /* NON-APPLICABLE MOTION. VARIOUS MESSAGES DEPENDING ON WORD GIVEN. */ L50: SPK=12; IF K >= 43 & K <= 50 THEN SPK=9; IF K = 29 | K = 30 THEN SPK=9; IF K = 7 | K = 36 | K = 37 THEN SPK=10; IF K = 11 | K = 19 THEN SPK=11; IF VERB = FIND | VERB = INVENT THEN SPK=59; IF K = 62 | K = 65 THEN SPK=42; IF K = 17 THEN SPK=80; CALL RSPEAK(SPK); GOTO L2; 1/* "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. */ L90: CALL RSPEAK(23); OLDLC2=LOC; /* OKAY, HE'S DEAD. LET'S GET ON WITH IT. */ L99: IF CLOSNG THEN GOTO L95; YEA=YES(81+NUMDIE*2,82+NUMDIE*2,54); NUMDIE=NUMDIE+1; IF NUMDIE = MAXDIE | ¬YEA THEN GOTO L20000; PLACE(WATER)=0; PLACE(OIL)=0; IF TOTING(LAMP) THEN PROP(LAMP)=0; DO J=1 TO 100; I=101-J; IF ¬TOTING(I) THEN GOTO L98; K=OLDLC2; IF I = LAMP THEN K=1; CALL DROP(I,K); L98: END; LOC=3; OLDLOC=LOC; GOTO L2000; /* HE DIED DURING CLOSING TIME. NO RESURRECTION. TALLY UP A DEATH AND EXIT. */ L95: CALL RSPEAK(131); NUMDIE=NUMDIE+1; GOTO L20000; 1/* 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"). */ L8000: CALL A5TOA1(WD1,WD1X,TKWORD,K); CALL LINESKP; PUT STRING (OUTSTR) EDIT ((TKWORD(I) DO I=1 TO K),' what?') (A,20 A); CALL LINEOUT; OBJ=0; GOTO L2600; /* CARRY, NO OBJECT GIVEN YET. OK IF ONLY ONE OBJECT PRESENT. */ L8010: IF ATLOC(LOC) = 0 | LINK(ATLOC(LOC)) ¬= 0 THEN GOTO L8000; DO I=1 TO 5; IF DLOC(I) = LOC & DFLAG >= 2 THEN GOTO L8000; END; 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. */ L9010: IF TOTING(OBJ) THEN GOTO L2011; SPK=25; IF OBJ = PLANT & PROP(PLANT) <= 0 THEN SPK=115; IF OBJ = BEAR & PROP(BEAR) = 1 THEN SPK=169; IF OBJ = CHAIN & PROP(BEAR) ¬= 0 THEN SPK=170; IF FIXED(OBJ) ¬= 0 THEN GOTO L2011; IF OBJ ¬= WATER & OBJ ¬= OIL THEN GOTO L9017; IF HERE(BOTTLE) & LIQ(0) = OBJ THEN GOTO L9018; OBJ=BOTTLE; IF TOTING(BOTTLE) & PROP(BOTTLE) = 1 THEN GOTO L9220; IF PROP(BOTTLE) ¬= 1 THEN SPK=105; IF ¬TOTING(BOTTLE) THEN SPK=104; GOTO L2011; L9018: OBJ=BOTTLE; L9017: IF HOLDNG < 7 THEN GOTO L9016; CALL RSPEAK(92); GOTO L2012; L9016: IF OBJ ¬= BIRD THEN GOTO L9014; IF PROP(BIRD) ¬= 0 THEN GOTO L9014; IF ¬TOTING(ROD) THEN GOTO L9013; CALL RSPEAK(26); GOTO L2012; L9013: IF TOTING(CAGE) THEN GOTO L9015; CALL RSPEAK(27); GOTO L2012; L9015: PROP(BIRD)=1; L9014: IF (OBJ = BIRD | OBJ = CAGE) & PROP(BIRD) ¬= 0 THEN CALL CARRY(BIRD+CAGE-OBJ,LOC); CALL CARRY(OBJ,LOC); K=LIQ(0); IF OBJ = BOTTLE & K ¬= 0 THEN PLACE(K)=-1; GOTO L2009; /* 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. */ L9020: IF TOTING(ROD2) & OBJ = ROD & ¬ TOTING(ROD) THEN OBJ=ROD2; IF ¬TOTING(OBJ) THEN GOTO L2011; IF OBJ ¬= BIRD | ¬ HERE(SNAKE) THEN GOTO L9024; CALL RSPEAK(30); IF CLOSED THEN GOTO L19000; CALL DSTROY(SNAKE); /* SET PROP FOR USE BY TRAVEL OPTIONS */ PROP(SNAKE)=1; L9021: K=LIQ(0); IF K = OBJ THEN OBJ=BOTTLE; IF OBJ = BOTTLE & K ¬= 0 THEN PLACE(K)=0; IF OBJ = CAGE & PROP(BIRD) ¬= 0 THEN CALL DROP(BIRD,LOC); IF OBJ = BIRD THEN PROP(BIRD)=0; CALL DROP(OBJ,LOC); GOTO L2012; L9024: IF OBJ ¬= COINS | ¬ HERE(VEND) THEN GOTO L9025; CALL DSTROY(COINS); CALL DROP(BATTER,LOC); CALL PSPEAK(BATTER,0); GOTO L2012; L9025: IF OBJ ¬= BIRD | ¬ AT(DRAGON) | PROP(DRAGON) ¬= 0 THEN GOTO L9026; CALL RSPEAK(154); CALL DSTROY(BIRD); PROP(BIRD)=0; IF PLACE(SNAKE) = PLAC(SNAKE) THEN TALLY2=TALLY2+1; GOTO L2012; L9026: IF OBJ ¬= BEAR | ¬AT(TROLL) THEN GOTO L9027; CALL RSPEAK(163); CALL MOVE(TROLL,0); CALL MOVE(TROLL+100,0); CALL MOVE(TROLL2,PLAC(TROLL)); CALL MOVE(TROLL2+100,FIXD(TROLL)); CALL JUGGLE(CHASM); PROP(TROLL)=2; GOTO L9021; L9027: IF OBJ = VASE & LOC ¬= PLAC(PILLOW) THEN GOTO L9028; CALL RSPEAK(54); GOTO L9021; L9028: PROP(VASE)=2; IF AT(PILLOW) THEN PROP(VASE)=0; CALL PSPEAK(VASE,PROP(VASE)+1); IF PROP(VASE) ¬= 0 THEN FIXED(VASE)=-1; GOTO L9021; /* SAY. ECHO WD2 (OR WD1 IF NO WD2 (SAY WHAT?, ETC.).) MAGIC WORDS OVERRIDE. */ L9030: CALL A5TOA1(WD2,WD2X,TKWORD,K); IF WD2 = ' ' THEN CALL A5TOA1(WD1,WD1X,TKWORD,K); IF WD2 ¬= ' ' THEN WD1=WD2; I=VOCAB(WD1,-1); IF I = 62 | I = 65 | I = 71 | I = 2025 THEN GOTO L9035; CALL LINESKP; PUT STRING (OUTSTR) EDIT ('Okay, "',(TKWORD(I) DO I=1 TO K),'".') (A,20 A); CALL LINEOUT; GOTO L2012; L9035: WD2=' '; OBJ=0; GOTO L2630; /* LOCK, UNLOCK, NO OBJECT GIVEN. ASSUME VARIOUS THINGS IF PRESENT. */ L8040: SPK=28; IF HERE(CLAM) THEN OBJ=CLAM; IF HERE(OYSTER) THEN OBJ=OYSTER; IF AT(DOOR) THEN OBJ=DOOR; IF AT(GRATE) THEN OBJ=GRATE; IF OBJ ¬= 0 & HERE(CHAIN) THEN GOTO L8000; IF HERE(CHAIN) THEN OBJ=CHAIN; IF OBJ = 0 THEN GOTO L2011; /* LOCK, UNLOCK OBJECT. SPECIAL STUFF FOR OPENING CLAM/OYSTER AND FOR CHAIN. */ L9040: IF OBJ = CLAM | OBJ = OYSTER THEN GOTO L9046; IF OBJ = DOOR THEN SPK=111; IF OBJ = DOOR & PROP(DOOR) = 1 THEN SPK=54; IF OBJ = CAGE THEN SPK=32; IF OBJ = KEYS THEN SPK=55; IF OBJ = GRATE | OBJ = CHAIN THEN SPK=31; IF SPK ¬= 31 | ¬ HERE(KEYS) THEN GOTO L2011; IF OBJ = CHAIN THEN GOTO L9048; IF ¬CLOSNG THEN GOTO L9043; K=130; IF ¬PANIC THEN CLOCK2=15; PANIC='1'B; GOTO L2010; L9043: K=34+PROP(GRATE); PROP(GRATE)=1; IF VERB = LOCK THEN PROP(GRATE)=0; K=K+2*PROP(GRATE); GOTO L2010; /* CLAM/OYSTER. */ L9046: K=0; IF OBJ = OYSTER THEN K=1; SPK=124+K; IF TOTING(OBJ) THEN SPK=120+K; IF ¬TOTING(TRIDNT) THEN SPK=122+K; IF VERB = LOCK THEN SPK=61; IF SPK ¬= 124 THEN GOTO L2011; CALL DSTROY(CLAM); CALL DROP(OYSTER,LOC); CALL DROP(PEARL,105); GOTO L2011; /* CHAIN. */ L9048: IF VERB = LOCK THEN GOTO L9049; SPK=171; IF PROP(BEAR) = 0 THEN SPK=41; IF PROP(CHAIN) = 0 THEN SPK=37; IF SPK ¬= 171 THEN GOTO L2011; PROP(CHAIN)=0; FIXED(CHAIN)=0; IF PROP(BEAR) ¬= 3 THEN PROP(BEAR)=2; FIXED(BEAR)=2-PROP(BEAR); GOTO L2011; L9049: SPK=172; IF PROP(CHAIN) ¬= 0 THEN SPK=34; IF LOC ¬= PLAC(CHAIN) THEN SPK=173; IF SPK ¬= 172 THEN GOTO L2011; PROP(CHAIN)=2; IF TOTING(CHAIN) THEN CALL DROP(CHAIN,LOC); FIXED(CHAIN)=-1; GOTO L2011; /* LIGHT LAMP */ L9070: IF ¬HERE(LAMP) THEN GOTO L2011; SPK=184; IF LIMIT < 0 THEN GOTO L2011; PROP(LAMP)=1; CALL RSPEAK(39); IF WZDARK THEN GOTO L2000; GOTO L2012; /* LAMP OFF */ L9080: IF ¬HERE(LAMP) THEN GOTO L2011; PROP(LAMP)=0; CALL RSPEAK(40); IF DARK(0) THEN CALL RSPEAK(16); GOTO L2012; /* WAVE. NO EFFECT UNLESS WAVING ROD AT FISSURE. */ L9090: IF (¬TOTING(OBJ)) & (OBJ ¬= ROD | ¬ TOTING(ROD2)) THEN SPK=29; IF OBJ ¬= ROD | ¬ AT(FISSUR) | ¬ TOTING(OBJ) | CLOSNG THEN GOTO L2011; PROP(FISSUR)=1-PROP(FISSUR); CALL PSPEAK(FISSUR,2-PROP(FISSUR)); GOTO L2012; /* 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. */ L9120: DO I=1 TO 5; IF DLOC(I) = LOC & DFLAG >= 2 THEN GOTO L9122; END; I=0; L9122: IF OBJ ¬= 0 THEN GOTO L9124; IF I ¬= 0 THEN OBJ=DWARF; IF HERE(SNAKE) THEN OBJ=OBJ*100+SNAKE; IF AT(DRAGON) & PROP(DRAGON) = 0 THEN OBJ=OBJ*100+DRAGON; IF AT(TROLL) THEN OBJ=OBJ*100+TROLL; IF HERE(BEAR) & PROP(BEAR) = 0 THEN OBJ=OBJ*100+BEAR; IF OBJ > 100 THEN GOTO L8000; IF OBJ ¬= 0 THEN GOTO L9124; /* CAN'T ATTACK BIRD BY THROWING AXE. */ IF HERE(BIRD) & VERB ¬= THROW THEN OBJ=BIRD; /* CLAM AND OYSTER BOTH TREATED AS CLAM FOR INTRANSITIVE CASE, NO HARM DONE. */ IF HERE(CLAM) | HERE(OYSTER) THEN OBJ=100*OBJ+CLAM; IF OBJ > 100 THEN GOTO L8000; L9124: IF OBJ ¬= BIRD THEN GOTO L9125; SPK=137; IF CLOSED THEN GOTO L2011; CALL DSTROY(BIRD); PROP(BIRD)=0; IF PLACE(SNAKE) = PLAC(SNAKE) THEN TALLY2=TALLY2+1; SPK=45; L9125: IF OBJ = 0 THEN SPK=44; IF OBJ = CLAM | OBJ = OYSTER THEN SPK=150; IF OBJ = SNAKE THEN SPK=46; IF OBJ = DWARF THEN SPK=49; IF OBJ = DWARF & CLOSED THEN GOTO L19000; IF OBJ = DRAGON THEN SPK=167; IF OBJ = TROLL THEN SPK=157; IF OBJ = BEAR THEN SPK=165+(PROP(BEAR)+1)/2; IF OBJ ¬= DRAGON | PROP(DRAGON) ¬= 0 THEN GOTO L2011; /* 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. */ CALL RSPEAK(49); VERB=0; OBJ=0; CALL GETIN(WD1,WD1X,WD2,WD2X); IF WD1 ¬= 'Y' & WD1 ¬= 'YES' THEN GOTO L2608; CALL PSPEAK(DRAGON,1); PROP(DRAGON)=2; PROP(RUG)=0; K=(PLAC(DRAGON)+FIXD(DRAGON))/2; CALL MOVE(DRAGON+100,-1); CALL MOVE(RUG+100,0); CALL MOVE(DRAGON,K); CALL MOVE(RUG,K); DO OBJ=1 TO 100; IF PLACE(OBJ) = PLAC(DRAGON) | PLACE(OBJ) = FIXD(DRAGON) THEN CALL MOVE(OBJ,K); END; LOC=K; K=NULLX; GOTO L8; /* POUR. IF NO OBJECT, OR OBJECT IS BOTTLE, ASSUME CONTENTS OF BOTTLE. SPECIAL TESTS FOR POURING WATER OR OIL ON PLANT OR RUSTY DOOR. */ L9130: IF OBJ = BOTTLE | OBJ = 0 THEN OBJ=LIQ(0); IF OBJ = 0 THEN GOTO L8000; IF ¬TOTING(OBJ) THEN GOTO L2011; SPK=78; IF OBJ ¬= OIL & OBJ ¬= WATER THEN GOTO L2011; PROP(BOTTLE)=1; PLACE(OBJ)=0; SPK=77; IF ¬(AT(PLANT) | AT(DOOR)) THEN GOTO L2011; IF AT(DOOR) THEN GOTO L9132; SPK=112; IF OBJ ¬= WATER THEN GOTO L2011; CALL PSPEAK(PLANT,PROP(PLANT)+1); PROP(PLANT)=MOD(PROP(PLANT)+2,6); PROP(PLANT2)=PROP(PLANT)/2; K=NULLX; GOTO L8; L9132: PROP(DOOR)=0; IF OBJ = OIL THEN PROP(DOOR)=1; SPK=113+PROP(DOOR); GOTO L2011; /* EAT. INTRANSITIVE: ASSUME FOOD IF PRESENT, ELSE ASK WHAT. TRANSITIVE: FOOD OK, SOME THINGS LOSE APPETITE, REST ARE RIDICULOUS. */ L8140: IF ¬HERE(FOOD) THEN GOTO L8000; L8142: CALL DSTROY(FOOD); SPK=72; GOTO L2011; L9140: IF OBJ = FOOD THEN GOTO L8142; IF OBJ = BIRD | OBJ = SNAKE | OBJ = CLAM | OBJ = OYSTER | OBJ = DWARF | OBJ = DRAGON | OBJ = TROLL | OBJ = BEAR THEN SPK=71; GOTO L2011; /* 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. */ L9150: IF OBJ = 0 & LIQLOC(LOC) ¬= WATER & (LIQ(0) ¬= WATER | ¬ HERE(BOTTLE)) THEN GOTO L8000; IF OBJ ¬= 0 & OBJ ¬= WATER THEN SPK=110; IF SPK = 110 | LIQ(0) ¬= WATER | ¬ HERE(BOTTLE) THEN GOTO L2011; PROP(BOTTLE)=1; PLACE(WATER)=0; SPK=74; GOTO L2011; /* RUB. YIELDS VARIOUS SNIDE REMARKS. */ L9160: IF OBJ ¬= LAMP THEN SPK=76; GOTO L2011; /* 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. */ L9170: IF TOTING(ROD2) & OBJ = ROD & ¬ TOTING(ROD) THEN OBJ=ROD2; IF ¬TOTING(OBJ) THEN GOTO L2011; IF OBJ >= 50 & OBJ <= MAXTRS & AT(TROLL) THEN GOTO L9178; IF OBJ = FOOD & HERE(BEAR) THEN GOTO L9177; IF OBJ ¬= AXE THEN GOTO L9020; DO I=1 TO 5; /* NEEDN'T CHECK DFLAG IF AXE IS HERE. */ IF DLOC(I) = LOC THEN GOTO L9172; END; SPK=152; IF AT(DRAGON) & PROP(DRAGON) = 0 THEN GOTO L9175; SPK=158; IF AT(TROLL) THEN GOTO L9175; IF HERE(BEAR) & PROP(BEAR) = 0 THEN GOTO L9176; OBJ=0; GOTO L9120; L9172: SPK=48; IF RAN(3) = 0 THEN GO TO L9175; DSEEN(I)='0'B; DLOC(I)=0; SPK=47; DKILL=DKILL+1; IF DKILL = 1 THEN SPK=149; L9175: CALL RSPEAK(SPK); CALL DROP(AXE,LOC); K=NULLX; GOTO L8; /* THIS'LL TEACH HIM TO THROW THE AXE AT THE BEAR! */ L9176: SPK=164; CALL DROP(AXE,LOC); FIXED(AXE)=-1; PROP(AXE)=1; CALL JUGGLE(BEAR); GOTO L2011; /* BUT THROWING FOOD IS ANOTHER STORY. */ L9177: OBJ=BEAR; GOTO L9210; L9178: SPK=159; /* SNARF A TREASURE FOR THE TROLL. */ CALL DROP(OBJ,0); CALL MOVE(TROLL,0); CALL MOVE(TROLL+100,0); CALL DROP(TROLL2,PLAC(TROLL)); CALL DROP(TROLL2+100,FIXD(TROLL)); CALL JUGGLE(CHASM); GOTO L2011; /* QUIT. INTRANSITIVE ONLY. VERIFY INTENT AND EXIT IF THAT'S WHAT HE WANTS. */ L8180: GAVEUP=YES(22,54,54); L8185: IF GAVEUP THEN GOTO L20000; GOTO L2012; /* FIND. MIGHT BE CARRYING IT, OR IT MIGHT BE HERE. ELSE GIVE CAVEAT. */ L9190: IF AT(OBJ) | (LIQ(0) = OBJ & AT(BOTTLE)) | K = LIQLOC(LOC) THEN SPK=94; DO I=1 TO 5; IF DLOC(I) = LOC & DFLAG >= 2 & OBJ = DWARF THEN SPK=94; END; IF CLOSED THEN SPK=138; IF TOTING(OBJ) THEN SPK=24; GOTO L2011; /* INVENTORY. IF OBJECT, TREAT SAME AS FIND. ELSE REPORT ON CURRENT BURDEN. */ L8200: SPK=98; DO I=1 TO 100; IF I = BEAR | ¬ TOTING(I) THEN GOTO L8201; IF SPK = 98 THEN CALL RSPEAK(99); BLKLIN='0'B; CALL PSPEAK(I,-1); BLKLIN='1'B; SPK=0; L8201: END; IF TOTING(BEAR) THEN SPK=141; GOTO L2011; /* FEED. IF BIRD, NO SEED. SNAKE, DRAGON, TROLL: QUIP. IF DWARF, MAKE HIM MAD. BEAR, SPECIAL. */ L9210: IF OBJ ¬= BIRD THEN GOTO L9212; SPK=100; GOTO L2011; L9212: IF OBJ ¬= SNAKE & OBJ ¬= DRAGON & OBJ ¬= TROLL THEN GOTO L9213 SPK=102; IF OBJ = DRAGON & PROP(DRAGON) ¬= 0 THEN SPK=110; IF OBJ = TROLL THEN SPK=182; IF OBJ ¬= SNAKE | CLOSED | ¬ HERE(BIRD) THEN GOTO L2011; SPK=101; CALL DSTROY(BIRD); PROP(BIRD)=0; TALLY2=TALLY2+1; GOTO L2011; L9213: IF OBJ ¬= DWARF THEN GOTO L9214; IF ¬HERE(FOOD) THEN GOTO L2011; SPK=103; DFLAG=DFLAG+1; GOTO L2011; L9214: IF OBJ ¬= BEAR THEN GOTO L9215; IF PROP(BEAR) = 0 THEN SPK=102; IF PROP(BEAR) = 3 THEN SPK=110; IF ¬HERE(FOOD) THEN GOTO L2011; CALL DSTROY(FOOD); PROP(BEAR)=1; FIXED(AXE)=0; PROP(AXE)=0; SPK=168; GOTO L2011; L9215: SPK=14; GOTO L2011; /* FILL. BOTTLE MUST BE EMPTY, AND SOME LIQUID AVAILABLE. (VASE IS NASTY.) */ L9220: IF OBJ = VASE THEN GOTO L9222; IF OBJ ¬= 0 & OBJ ¬= BOTTLE THEN GOTO L2011; IF OBJ = 0 & ¬ HERE(BOTTLE) THEN GOTO L8000; SPK=107; IF LIQLOC(LOC) = 0 THEN SPK=106; IF LIQ(0) ¬= 0 THEN SPK=105; IF SPK ¬= 107 THEN GOTO L2011; PROP(BOTTLE)=MOD(COND(LOC),4)/2; PROP(BOTTLE)=PROP(BOTTLE)*2; K=LIQ(0); IF TOTING(BOTTLE) THEN PLACE(K)=-1; IF K = OIL THEN SPK=108; GOTO L2011; L9222: SPK=29; IF LIQLOC(LOC) = 0 THEN SPK=144; IF LIQLOC(LOC) = 0 | ¬TOTING(VASE) THEN GOTO L2011; CALL RSPEAK(145); PROP(VASE)=2; FIXED(VASE)=-1; GOTO L9024; /* BLAST. NO EFFECT UNLESS YOU'VE GOT DYNAMITE, WHICH IS A NEAT TRICK! */ L9230: IF PROP(ROD2) < 0 | ¬ CLOSED THEN GOTO L2011; BONUS=133; IF LOC = 115 THEN BONUS=134; IF HERE(ROD2) THEN BONUS=135; CALL RSPEAK(BONUS); GOTO L20000; /* SCORE. GO TO SCORING SECTION, WHICH WILL RETURN TO 8241 IF SCORNG IS TRUE. */ L8240: SCORNG='1'B; GOTO L20000; L8241: SCORNG='0'B; CALL LINESKP; PUT STRING (OUTSTR) EDIT ('If you were to quit now, you would score ', SCORE,' out of a possible',MXSCOR,'.') (A,F(4),A,F(4),A); CALL LINEOUT; GAVEUP=YES(143,54,54); GOTO L8185; /* 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). */ L8250: K=VOCAB(WD1,3); SPK=42; IF FOOBAR = 1-K THEN GOTO L8252; IF FOOBAR ¬= 0 THEN SPK=151; GOTO L2011; L8252: FOOBAR=K; IF K ¬= 4 THEN GOTO L2009; FOOBAR=0; IF PLACE(EGGS) = PLAC(EGGS) | (TOTING(EGGS) & LOC = PLAC(EGGS)) THEN GOTO L2011; /* BRING BACK TROLL IF WE STEAL THE EGGS BACK FROM HIM BEFORE CROSSING. */ IF PLACE(EGGS) = 0 & PLACE(TROLL) = 0 & PROP(TROLL) = 0 THEN PROP(TROLL)=1; K=2; IF HERE(EGGS) THEN K=1; IF LOC = PLAC(EGGS) THEN K=0; CALL MOVE(EGGS,PLAC(EGGS)); CALL PSPEAK(EGGS,K); GOTO L2012; /* BRIEF. INTRANSITIVE ONLY. SUPPRESS LONG DESCRIPTIONS AFTER FIRST TIME. */ L8260: SPK=156; ABBNUM=10000; DETAIL=3; GOTO L2011; /* READ. MAGAZINES IN DWARVISH, MESSAGE WE'VE SEEN, AND . . . OYSTER? */ L8270: IF HERE(MAGZIN) THEN OBJ=MAGZIN; IF HERE(TABLET) THEN OBJ=OBJ*100+TABLET; IF HERE(MESSAG) THEN OBJ=OBJ*100+MESSAG; IF CLOSED & TOTING(OYSTER) THEN OBJ=OYSTER; IF OBJ > 100 | OBJ = 0 | DARK(0) THEN GOTO L8000; L9270: IF DARK(0) THEN GOTO L5190; IF OBJ = MAGZIN THEN SPK=190; IF OBJ = TABLET THEN SPK=196; IF OBJ = MESSAG THEN SPK=191; IF OBJ = OYSTER & HINTED(2) & TOTING(OYSTER) THEN SPK=194; IF OBJ ¬= OYSTER | HINTED(2) | ¬TOTING(OYSTER) | ¬CLOSED THEN GOTO L2011; HINTED(2)=YES(192,193,54); GOTO L2012; /* BREAK. ONLY WORKS FOR MIRROR IN REPOSITORY AND, OF COURSE, THE VASE. */ L9280: IF OBJ = MIRROR THEN SPK=148; IF OBJ = VASE & PROP(VASE) = 0 THEN GOTO L9282; IF OBJ ¬= MIRROR | ¬CLOSED THEN GOTO L2011; CALL RSPEAK(197); GOTO L19000; L9282: SPK=198; IF TOTING(VASE) THEN CALL DROP(VASE,LOC); PROP(VASE)=2; FIXED(VASE)=-1; GOTO L2011; /* WAKE. ONLY USE IS TO DISTURB THE DWARVES. */ L9290: IF OBJ ¬= DWARF | ¬CLOSED THEN GOTO L2011; CALL RSPEAK(199); GOTO L19000; /* SUSPEND. OFFER TO EXIT LEAVING THINGS RESTARTABLE, BUT REQUIRING A DELAY BEFORE RESTARTING (SO CAN'T SAVE THE WORLD BEFORE TRYING SOMETHING RISKY). UPON RESTARTING, SETUP=-1 CAUSES RETURN TO 8305 TO PICK UP AGAIN. */ L8300: PUT STRING (OUTSTR) EDIT ('Can''t suspend on this machine') (A); CALL LINEOUT; GO TO L2012; /* HOURS. REPORT CURRENT NON-PRIME-TIME HOURS. */ L8310: PUT STRING (OUTSTR) EDIT ('Open all day!') (A); FRANK=CLOCK1; FRANK1=CLOCK2; FCL=FRANK; FCL1=FRANK1; FL=LIMIT; FL1=FL; DISPLAY (FCL); DISPLAY(FCL1); DISPLAY(FL1); GOTO L2; CALL LINEOUT; GOTO L2012; /* LOG. TOGGLE LOGGIN EITHER ON OR OFF */ SETLOG: LOGON = ¬ LOGON; IF LOGON THEN PUT STRING (OUTSTR) EDIT ('Log on.') (A); ELSE PUT STRING (OUTSTR) EDIT ('Log off.') (A); CALL LINEOUT; CALL LINESKP; GO TO L2012; 1/* 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. */ L40000: SELECT (HINT-4); WHEN (00) GO TO L40400; /* CAVE */ WHEN (01) GO TO L40500; /* BIRD */ WHEN (02) GO TO L40600; /* SNAKE */ WHEN (03) GO TO L40700; /* MAZE */ WHEN (04) GO TO L40800; /* DARK */ WHEN (05) GO TO L40900; /* WITT */ END; CALL BUG(27); L40010: HINTLC(HINT)=0; IF ¬YES(HINTS(HINT,3),0,54) THEN GOTO L2602; CALL LINESKP; PUT STRING (OUTSTR) EDIT ('I am prepared to give you a hint, but it will cost you', HINTS(HINT,2),' points.') (A,F(2),A); CALL LINEOUT; HINTED(HINT)=YES(175,HINTS(HINT,4),54); IF HINTED(HINT) & LIMIT > 30 THEN LIMIT=LIMIT+30*HINTS(HINT,2); L40020: HINTLC(HINT)=0; L40030: GOTO L2602; /* NOW FOR THE QUICK TESTS. SEE DATABASE DESCRIPTION FOR ONE-LINE NOTES. */ L40400: IF PROP(GRATE) = 0 & ¬ HERE(KEYS) THEN GOTO L40010; GOTO L40020; L40500: IF HERE(BIRD) & TOTING(ROD) & OBJ = BIRD THEN GOTO L40010; GOTO L40030; L40600: IF HERE(SNAKE) & ¬ HERE(BIRD) THEN GOTO L40010; GOTO L40020; L40700: IF ATLOC(LOC) = 0 & ATLOC(OLDLOC) = 0 & ATLOC(OLDLC2) = 0 & HOLDNG > 1 THEN GOTO L40010; GOTO L40020; L40800: IF PROP(EMRALD) ¬= -1 & PROP(PYRAM) = -1 THEN GOTO L40010; GOTO L40020; L40900: GOTO L40010; 1/* 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. */ L10000: PROP(GRATE)=0; PROP(FISSUR)=0; DO I=1 TO 6; DSEEN(I)='0'B; END; CALL MOVE(TROLL,0); CALL MOVE(TROLL+100,0); CALL MOVE(TROLL2,PLAC(TROLL)); CALL MOVE(TROLL2+100,FIXD(TROLL)); CALL JUGGLE(CHASM); IF PROP(BEAR) ¬= 3 THEN CALL DSTROY(BEAR); PROP(CHAIN)=0; FIXED(CHAIN)=0; PROP(AXE)=0; FIXED(AXE)=0; CALL RSPEAK(129); CLOCK1=-1; CLOSNG='1'B; GOTO L19999; /* 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. */ L11000: 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(MIRROR)=PUT(MIRROR,115,0); FIXED(MIRROR)=116; DO I=1 TO 100; IF TOTING(I) THEN CALL DSTROY(I); END; CALL RSPEAK(132); CLOSED='1'B; GOTO L2; /* 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. */ L12000: CALL RSPEAK(188); PROP(BATTER)=1; IF TOTING(BATTER) THEN CALL DROP(BATTER,LOC); LIMIT=LIMIT+2500; LMWARN='0'B; GOTO L19999; L12200: IF LMWARN | ¬HERE(LAMP) THEN GOTO L19999; LMWARN='1'B; SPK=187; IF PLACE(BATTER) = 0 THEN SPK=183; IF PROP(BATTER) = 1 THEN SPK=189; CALL RSPEAK(SPK); GOTO L19999; L12400: LIMIT=-1; PROP(LAMP)=0; IF HERE(LAMP) THEN CALL RSPEAK(184); GOTO L19999; L12600: CALL RSPEAK(185); GAVEUP='1'B; GOTO L20000; /* OH DEAR, HE'S DISTURBED THE DWARVES. */ L19000: CALL RSPEAK(136); /* EXIT CODE. WILL EVENTUALLY INCLUDE SCORING. FOR NOW, HOWEVER, ... 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.) */ L20000: 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. */ DO I=50 TO MAXTRS; IF PTEXT(I) ¬= 0 THEN DO; K=12; IF I = CHEST THEN K=14; IF I > CHEST THEN K=16; IF PROP(I) >= 0 THEN SCORE=SCORE+2; IF PLACE(I) = 3 & PROP(I) = 0 THEN SCORE=SCORE+K-2; MXSCOR=MXSCOR+K; END; END; /* 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 ¬(SCORNG | GAVEUP) THEN SCORE=SCORE+4; MXSCOR=MXSCOR+4; IF DFLAG ¬= 0 THEN SCORE=SCORE+25; MXSCOR=MXSCOR+25; IF CLOSNG THEN SCORE=SCORE+25; MXSCOR=MXSCOR+25; IF ¬CLOSED THEN GOTO L20020; IF BONUS = 0 THEN SCORE=SCORE+10; IF BONUS = 135 THEN SCORE=SCORE+25; IF BONUS = 134 THEN SCORE=SCORE+30; IF BONUS = 133 THEN SCORE=SCORE+45; L20020: MXSCOR=MXSCOR+45; /* DID HE COME TO WITT'S END AS HE SHOULD? */ IF PLACE(MAGZIN) = 108 THEN 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. */ DO I=1 TO HNTMAX; IF HINTED(I) THEN SCORE=SCORE-HINTS(I,2); END; /* RETURN TO SCORE COMMAND IF THAT'S WHERE WE CAME FROM. */ IF SCORNG THEN GOTO L8241; /* THAT SHOULD BE GOOD ENOUGH. LET'S TELL HIM ALL ABOUT IT. */ CALL LINESKP; CALL LINESKP; CALL LINESKP; PUT STRING (OUTSTR) EDIT ('You scored',SCORE,' out of a possible', MXSCOR,' using',TURNS,' turns.') (A,F(4),A,F(4),A,F(4),A); CALL LINEOUT; DO I=1 TO CLSSES; IF CVAL(I) >= SCORE THEN GOTO L20210; END; CALL LINESKP; PUT STRING (OUTSTR) EDIT ('You just went of my scale!!') (A); CALL LINEOUT; GOTO L25000; L20210: CALL SPEAK(CTEXT(I)); IF I = CLSSES-1 THEN GOTO L20220; K=CVAL(I)+1-SCORE; KKWORD='s.'; IF K = 1 THEN KKWORD='. '; CALL LINESKP; PUT STRING (OUTSTR) EDIT ('To achieve the next higher rating, you need', K,' more point',KKWORD) (A,F(3),A,A(2)); CALL LINEOUT; GOTO L25000; L20220: CALL LINESKP; PUT STRING (OUTSTR) EDIT ('To achieve the next higher rating would be a neat trick!') (A); CALL LINEOUT; CALL LINESKP; PUT STRING (OUTSTR) EDIT ('Congratulations!!') (A); CALL LINEOUT; L25000: CALL LINESKP; STOP; 1/* SUBROUTINES/FUNCTIONS TOTING(OBJ) = TRUE IF THE OBJ IS BEING CARRIED HERE(OBJ) = TRUE IF THE OBJ IS AT "LOC" (OR IS BEING CARRIED) AT(OBJ) = TRUE IF ON EITHER SIDE OF TWO-PLACED OBJECT LIQ(DUMMY) = OBJECT NUMBER OF LIQUID IN BOTTLE LIQLOC(LOC) = OBJECT NUMBER OF LIQUID (IF ANY) AT LOC BITSET(L,N) = TRUE IF COND(L) HAS BIT N SET (BIT 0 IS UNITS BIT) FORCED(LOC) = TRUE IF LOC MOVES WITHOUT ASKING FOR INPUT (COND=2) DARK(DUMMY) = TRUE IF LOCATION "LOC" IS DARK PCT(N) = TRUE N% OF THE TIME (N INTEGER FROM 0 TO 100) */ TOTING: PROC (OBJ) RETURNS (BIT(1)); DCL OBJ FIXED BIN(31); RETURN(PLACE(OBJ) = -1); END; HERE: PROC (OBJ) RETURNS (BIT(1)); DCL OBJ FIXED BIN(31); RETURN(PLACE(OBJ) = LOC | TOTING(OBJ)); END; AT: PROC (OBJ) RETURNS (BIT(1)); DCL OBJ FIXED BIN (31); RETURN(PLACE(OBJ) = LOC | FIXED (OBJ) = LOC); END; LIQ2: PROC (PBOTL) RETURNS (FIXED BIN(31)); DCL PBOTL FIXED BIN(31); DCL LIQ2TEMP FIXED BIN(31); LIQ2TEMP=PBOTL/2; RETURN((1-PBOTL)*WATER+(LIQ2TEMP)*(WATER+OIL)); END; LIQ: PROC (DUMMY) RETURNS (FIXED BIN(31)); DCL DUMMY FIXED BIN(31); RETURN(LIQ2(MAX(PROP(BOTTLE),-1-PROP(BOTTLE)))); END; LIQLOC: PROC (LOC) RETURNS (FIXED BIN(31)); DCL LOC FIXED BIN(31); DCL (LIQTEMP1,LIQTEMP2) FIXED BIN(31); LIQTEMP1=COND(LOC)/2; LIQTEMP1=LIQTEMP1*2; LIQTEMP2=COND(LOC)/4; RETURN(LIQ2((MOD(LIQTEMP1,8)-5)*MOD(LIQTEMP2,2)+1)); END; BITSET: PROC (L,N) RETURNS (BIT(1)); DCL (L,N) FIXED BIN(31); DCL BITTEMP FIXED BIN(31) STATIC; BITTEMP=COND(L)/2**N; RETURN(MOD(BITTEMP,2) ¬= 0); END; FORCED: PROC (LOC) RETURNS (BIT(1)); DCL LOC FIXED BIN(31); RETURN(COND(LOC) = 2); END; DARK: PROC (DUMMY) RETURNS (BIT(1)); DCL DUMMY FIXED BIN(31); RETURN(MOD(COND(LOC),2) = 0 & (PROP(LAMP) = 0 | ¬ HERE(LAMP))); END; PCT: PROC (N) RETURNS (BIT(1)); DCL N FIXED BIN(31); RETURN(RAN(100) < N); END; 1/* I/O ROUTINES (SPEAK, PSPEAK, RSPEAK, GETIN, YES, A5TOA1) */ SPEAK: PROC (N); DCL N FIXED BIN(31); DCL (I,K,L) FIXED BIN (31); /* PRINT THE MESSAGE WHICH STARTS AT LINES(N). PRECEDE IT WITH A BLANK LINE UNLESS BLKLIN IS FALSE. */ IF N = 0 THEN RETURN; IF LINES(N+1) = '>$<' THEN RETURN; IF (BLKLIN) THEN CALL LINESKP; K=N; L1: L=ABS(LINES(K))-1; K=K+1; PUT STRING (OUTSTR) EDIT ((LINES(I) DO I=K TO L)) (14 A(5)); CALL LINEOUT; K=L+1; IF LINES(K) >= 0 THEN GOTO L1; RETURN; END; PSPEAK:PROC (MSG,SKIP); DCL (MSG,SKIP) FIXED BIN(31); DCL (I,M) FIXED BIN (31); /* FIND THE SKIP+1ST MESSAGE FROM MSG AND PRINT IT. MSG SHOULD BE THE INDEX OF THE INVENTORY MESSAGE FOR OBJECT. (INVEN+N+1 MESSAGE IS PROP=N MESSAGE). */ M=PTEXT(MSG); IF SKIP < 0 THEN GOTO L9; DO I=0 TO SKIP; L1: M=ABS(LINES(M)); IF LINES(M) >= 0 THEN GOTO L1; END; L9: CALL SPEAK(M); RETURN; END; RSPEAK: PROC (I); DCL I FIXED BIN(31); /* PRINT THE I-TH "RANDOM" MESSAGE (SECTION 6 OF DATABASE). */ IF I ¬= 0 THEN CALL SPEAK(RTEXT(I)); RETURN; END; GETIN: PROC (WORD1,WORD1X,WORD2,WORD2X); /* GET A COMMAND FROM THE ADVENTURER. SNARF OUT THE FIRST WORD, PAD IT WITH BLANKS, AND RETURN IT IN WORD1. CHARS 6 THRU 10 ARE RETURNED IN WORD1X, IN CASE WE NEED TO PRINT OUT THE WHOLE WORD IN AN ERROR MESSAGE. ANY NUMBER OF BLANKS MAY FOLLOW THE WORD. IF A SECOND WORD APPEARS, IT IS RETURNED IN WORD2 (CHARS 6 THRU 10 IN WORD2X), ELSE WORD2 IS SET TO ZERO. */ DCL (WORD1,WORD1X,WORD2,WORD2X) CHAR(5); WORD1,WORD1X,WORD2,WORD2X=' '; IF LOGON THEN PUT SKIP; WORDSTRT=0; IF BLKLIN THEN CALL LINESKP; X1:DISPLAY (' ') REPLY(CHRIS); IF CHRIS = ' ' THEN GOTO X1; ADVARS.INSTR=CHRIS; CCODE=1; OUTSTR=INSTR; WORDSTRT=VERIFY(OUTSTR,' '); IF LOGON THEN PUT SKIP EDIT (OUTSTR) (A); OUTSTR=SUBSTR(OUTSTR,WORDSTRT); WORDEND=INDEX(OUTSTR,' ')-1; IF WORDEND=-1 THEN WORDEND=LENGTH(OUTSTR); WORDSIZE=MIN(WORDEND,5); WORD1=SUBSTR(OUTSTR,1,WORDSIZE); IF WORDEND > 5 THEN DO; WORDSIZE=MIN(WORDEND-5,5); WORD1X=SUBSTR(OUTSTR,6,WORDSIZE); END; IF WORDEND=LENGTH(OUTSTR) THEN RETURN; OUTSTR=SUBSTR(OUTSTR,WORDEND+1); WORDSTRT=VERIFY(OUTSTR,' '); IF WORDSTRT = 0 THEN RETURN; OUTSTR=SUBSTR(OUTSTR,WORDSTRT); WORDEND=INDEX(OUTSTR,' ')-1; IF WORDEND = -1 THEN WORDEND=LENGTH(OUTSTR); WORDSIZE=MIN(WORDEND,5); WORD2=SUBSTR(OUTSTR,1,WORDSIZE); IF WORDEND > 5 THEN DO; WORDSIZE=MIN(WORDEND-5,5); WORD2X=SUBSTR(OUTSTR,6,WORDSIZE); END; RETURN; END; YES: PROC (X,Y,Z) RETURNS (BIT(1)); DCL (X,Y,Z) FIXED BIN(31); /* PRINT MESSAGE X, WAIT FOR YES/NO ANSWER. IF YES, PRINT Y AND LEAVE YEA TRUE, IF NO, PRINT Z AND LEAVE YEA FALSE. */ L1: IF X ¬= 0 THEN CALL RSPEAK(X); CALL GETIN(REPLY,JUNK1,JUNK2,JUNK3); IF REPLY = 'YES' | REPLY = 'Y' THEN GOTO L10; IF REPLY = 'NO' | REPLY = 'N' THEN GOTO L20; CALL LINESKP; PUT STRING (OUTSTR) EDIT ('Please answer the question!') (A); CALL LINEOUT; GOTO L1; L10: IF Y ¬= 0 THEN CALL RSPEAK(Y); RETURN('1'B); L20: IF Z ¬=0 THEN CALL RSPEAK(Z); RETURN('0'B); END; A5TOA1: PROC (A,B,CHARS,LENG); /* A AND B CONTAN A 1-10 CHARACTER WORD IN A5 FORMAT. THEY ARE CONCATENATED AND MOVED INTO A CHAR(1) ARRAY UNTIL A BLANK IS ENCOUNTERED. THE TOTAL LENGTH IS RETURNED IN LENG. */ DCL (A,B) CHAR(5); DCL LENG FIXED BIN(31); DCL CHARS(10) CHAR(1); DCL WORDS(2) CHAR(5); DCL XLATETO CHAR(26) INIT ('abcdefghijklmnopqrstuvwxyz'); DCL XLATEFR CHAR(26) INIT ('ABCDEFGHIJKLMNOPQRSTUVWXYZ'); WORDS(1)=TRANSLATE(A,XLATETO,XLATEFR); WORDS(2)=TRANSLATE(B,XLATETO,XLATEFR); LENG=0; DO WORD=1 TO 2; DO CH=1 TO 5; CHARS(LENG+1)=SUBSTR(WORDS(WORD),CH,1); IF CHARS(LENG+1) = ' ' THEN RETURN; LENG=LENG+1; END; END; RETURN; END; 1/* DATA STRUCTURE ROUTINES (VOCAB, DSTROY, JUGGLE, MOVE, PUT, CARRY, DROP) */ VOCAB: PROC (ID,INIT) RETURNS(FIXED BIN(31)); DCL ID CHAR(5); DCL INIT FIXED BIN(31); DCL I FIXED BIN(31); /* LOOK UP ID IN THE VOCABULARY (ATAB) AND RETURN ITS "DEFINITION" (KTAB), OR -1 IF NOT FOUND. IF INIT IS POSITIVE, THIS IS AN INITIALISATION 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. */ DCL VOCRTN FIXED BIN(31); DO I=1 TO TABSIZ; IF KTAB(I) = -1 THEN GOTO L2; IF INIT >= 0 & KTAB(I)/1000 ¬= INIT THEN GOTO L1; IF ATAB(I) = ID THEN GOTO L3; L1: END; CALL BUG(21); L2: IF INIT < 0 THEN RETURN(-1); CALL BUG(5); L3: VOCRTN=KTAB(I); IF INIT >= 0 THEN VOCRTN=MOD(VOCRTN,1000); RETURN(VOCRTN); END; DSTROY: PROC (OBJECT); DCL OBJECT FIXED BIN(31); /* PERMANENTLY ELIMINATE "OBJECT" BY MOVING TO A NON-EXISTANT LOCATION. */ CALL MOVE(OBJECT,0); RETURN; END; JUGGLE: PROC (OBJECT); DCL OBJECT FIXED BIN(31); DCL (I,J) FIXED BIN(31); /* 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. */ I=PLACE(OBJECT); J=FIXED(OBJECT); CALL MOVE(OBJECT,I); CALL MOVE(OBJECT+100,J); RETURN; END; MOVE: PROC (OBJECT,WHERE); DCL (OBJECT,WHERE) FIXED BIN(31); /* 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 THEN GOTO L1; FROM=PLACE(OBJECT); GOTO L2; L1: FROM=FIXED(OBJECT-100); L2: IF FROM > 0 & FROM <= 300 THEN CALL CARRY(OBJECT,FROM); CALL DROP(OBJECT,WHERE); RETURN; END; PUT: PROC (OBJECT,WHERE,PVAL) RETURNS(FIXED BIN(31)); DCL (OBJECT,WHERE,PVAL) FIXED BIN(31); /* 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(OBJECT,WHERE); RETURN((-1)-PVAL); END; CARRY: PROC (OBJECT,WHERE); DCL (OBJECT,WHERE) FIXED BIN(31); /* 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 THEN GOTO L5; IF PLACE(OBJECT) = -1 THEN RETURN; PLACE(OBJECT)=-1; HOLDNG=HOLDNG+1; L5: IF ATLOC(WHERE) ¬= OBJECT THEN GOTO L6; ATLOC(WHERE)=LINK(OBJECT); RETURN; L6: TEMP=ATLOC(WHERE); L7: IF LINK(TEMP) = OBJECT THEN GOTO L8; TEMP=LINK(TEMP); GOTO L7; L8: LINK(TEMP)=LINK(OBJECT); RETURN; END; DROP: PROC (OBJECT,WHERE); DCL (OBJECT,WHERE) FIXED BIN(31); /* PLACE AN OBJECT AT A GIVEN LOC, PREFIXING IT ONTO THE ATLOC LIST. DECR HOLDNG IF THE OBJECT WAS BEING TOTED. */ IF OBJECT > 100 THEN GOTO L1; IF PLACE(OBJECT) = -1 THEN HOLDNG=HOLDNG-1; PLACE(OBJECT)=WHERE; GOTO L2; L1: FIXED(OBJECT-100)=WHERE; L2: IF WHERE <= 0 THEN RETURN; LINK(OBJECT)=ATLOC(WHERE); ATLOC(WHERE)=OBJECT; RETURN; END; 1/* UTILITY ROUTINES (RAN, CIAO, BUG) */ CIAO: PROC; /* EXITS...NO MESSAGE OUTPUT SINCE CAN'T SAVE CORE IMAGE */ STOP; END; BUG: PROC (NUM); DCL NUM FIXED BIN(31); /* 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 */ PUT STRING (OUTSTR) EDIT ('Fatal error # ',NUM) (A,F(2)); CALL LINEOUT; STOP; END; LINESKP: PROC; /* OUTPUTS A BLANK LINE */ OUTSTR=' '; CALL LINEOUT; RETURN; END; LINEOUT: PROC; /* OUTPUT A LINE TO MILTEN */ INSTR=OUTSTR; IF LOGON & OUTSTR ¬= ' ' THEN PUT SKIP EDIT (OUTSTR) (A); CCODE=0; DISPLAY (OUTSTR); RETURN; END; RAN: PROC (N) RETURNS (FIXED BIN(31)); /* RETURNS RANDOM NUMBER BETWEEN 0 AND N-1 */ DCL N FIXED BIN(31); DCL RANRTN FIXED BIN(31); RANRTN=N; DO WHILE (RANRTN = N); CALL RANDU(IX,IY,Y); IX=IY; RANRTN=Y*N; END; RETURN(RANRTN); END; FINISH:END ADVENT;