CODE2T=ADVENTURE II, NO TEXT PACKING. C ADVENTURE II:JACK PIKE & PETER LUCKETT (RAE BEDFORD/FARNBOROUGH) C ORIGINATOR:WILLIE CROWTHER (STAMFORD UNIVERSITY) C MOST FEATURES OF EARLY VERSION: DON WOODS (DON @ SU AI). C FORTRAN IV VERSION:JACK PIKE. C BUGS,COMMENTS,QUERIES,SUGGESTIONS ETC. TO JP PLEASE. C C Adapted to F77 by Mike Arnautov (MLA), September 2001. C Character*100000 worked around by Volker Blasius, 25 September 2001. C Endian trouble on 'I SEE NO X' fixed by Dave Picton. 28 September 2001. C The Character*100000 buffer reduced to the sufficient size of 68000 C Volker Blasius. 29 September 2001. C Dummy varible ORC in sub ORCALL also in COMMON! Dummy removed Jack C Pike (JP) Nov 2001 C Thirst comments increased JP Nov 2001 C SAY command WRITE instruction given back its FORMAT statement as it C was printing ASCII numbers not the letters using * O/P. JP Nov 2001 C BLOW when dark is now allowed, with HORN/OWL implications. JP Nov 2001 C WRITE instructions given back their FORMAT statements to fix space C padding of numbers by gfortran. MLA Nov 2013 C Adapted to work with gfortran as well as f77; Arthur O'Dwyer Nov 2013. C Fixed ORCALL; Arthur O'Dwyer Nov 2013. C C THE PROGRAM IS IN USA STANDARD FORTRAN (ANSI) C (Now in F77. MLA) C C I/O SPECIFICATION IS DONE IN FUNCTION 'DATA' AT END OF PROGRAM. C ALTER THIS TO SUIT YOUR SYSTEM. C C THIS PROGRAM IS SUPPLIED ON THE UNDERSTANDING THAT THE NAMES OF THE C ORIGINATORS IS RETAINED IN THE DATABASE. C CC 1 C ADVENTURE II C ------------ C THIS IS ADVENTURE MAIN. TO RUN YOU NEED ALSO THE FOLLOWING: C C 1.) ADSUBS.FOR (Not actually the case! MLA 12 Sep 2001) C 2.) ADVENT.DAT C C ADVENTURE ORIGINATED FROM STAMFORD UNIVERSITY. THIS COPY COMES C TO YOU COURTESY OF THE ROYAL AIRCRAFT ESTABLISHMENT, BEDFORD/ C FARNBOROUGH, ENGLAND. C C THIS COPY HAS BEEN HEAVILY MODIFIED (NEW CAVES, TREASURES AND C FEATURES) BY JACK PIKE (3 X 3, RAE BEDFORD) AND PETER LUCKETT C (M & C DEPT., RAE FARNBOROUGH.) CONTACT THEM WITH ANY PROBLEMS, C COMMENTS ETC. C C THIS PROGRAM IS SUPPLIED ON THE UNDERSTANDING THAT THE AUTHORS C NAMES AND PLACE OF ORIGIN IS RETAINED IN THE DATABASE. C C THIS VERSION: 31 DECEMBER 1978. C (F77 mods version: 29 September 2001.) C C C TO RUN THIS PROGRAM ON A DECSYSTEM-10 USE THE FOLLOWING COMMAND: C C EX ADVENT.FOR,ADSUBS.FOR C C C C CC 2 C ADVENTURES C CURRENT LIMITS: C 15000 WORDS OF MESSAGE TEXT (LINES, LINSIZ). C 1000 TRAVEL OPTIONS (TRAVEL, TRVSIZ). C 500 VOCABULARY WORDS (KTAB, ATAB, TABSIZ). C 300 LOCATIONS (LTEXT, STEXT, KEY, COND, ABB, ATLOC, LOCSIZ). C 100 OBJECTS (PLAC, PLACE, FIXD, FIXED, LINK (TWICE), PTEXT, PROP). C 38 "ACTION" VERBS (ACTSPK). C 300 RANDOM MESSAGES (RTEXT, RTXSIZ). C 12 DIFFERENT PLAYER CLASSIFICATIONS (CTEXT, CVAL, CLSMAX). C 20 HINTS, LESS 3 (HINTLC, HINTED, HINTS, HNTSIZ). C 35 CIMAG MESSAGES (MTEXT, MAGSIZ). C CIMAG=MAGIC, AND THROUGHOUT PROGRAM, EXCEPT IN TEXT. C THERE ARE ALSO LIMITS WHICH CANNOT BE EXCEEDED DUE TO THE STRUCTURE OF C THE DATABASE. (E.G., THE VOCABULARY USES N/1000 TO DETERMINE WORD TYPE, C SO THERE CAN'T BE MORE THAN 1000 WORDS.) THESE UPPER LIMITS ARE: C 1000 NON-SYNONYMOUS VOCABULARY WORDS C 300 LOCATIONS C 100 OBJECTS C LOGICAL DSEEN,BLKLIN,HINTED,YES,WIZENT COMMON /TXTCOM/ RTEXT,LINEX COMMON /BLKCOM/ BLKLIN COMMON /VOCCOM/ KTAB,ATAB,TABSIZ COMMON /PLACOM/ ATLOC,LINK,PLACE,FIXED,HOLDNG COMMON /PTXCOM/ PTEXT COMMON /TRVCOM/ TK,TRAVEL,KEY,COND COMMON /DTOCOM/ DOBJ,DLOC,PLAC,FIXD,PROP,LOC,MAXTRS COMMON/TURN/TURNS,IRAN CHARACTER*32767 LINES INTEGER*4 LINEX(17000) EQUIVALENCE(LINES,LINEX) CHARACTER*80 TLINES CHARACTER*7 VOCWRD INTEGER TRAVEL(1000,3) INTEGER KTAB(400),ATAB(400,7),WD1(10),WD2(10) INTEGER LTEXT(200),STEXT(200),KEY(200),COND(200),ABB(200) INTEGER PLAC(100),PLACE(100),FIXD(100),FIXED(100),LINK(200) INTEGER ACTSPK(38),ATLOC(300),PTEXT(100),PROP(100) INTEGER RTEXT(300) INTEGER CTEXT(12),CVAL(12) INTEGER HINTLC(20),MTEXT(40),HINTS(20,4) INTEGER TK(20),DLOC(6),ODLOC(6),DOBJ(5),ORC(5) DIMENSION HINTED(20),DSEEN(6) CC 3 C AVOID MAKING THE COMPILER WORRY ABOUT MODIFYING THE DO INDEX C INTEGER IDONDX INTEGER KEYS,GRATE,CAGE,ROD,ROD2,STEPS,BIRD,DOOR,SNAKE,FISSUR, 2TABLET,CLAM,OYSTER,DWARF,FOOD,BOTTLE,WATER,OIL,PLANT,PLANT2, 4AXE,DRAGON,CHASM,TROLL,TROLL2,BEAR,PILLOW, 5VEND,BATTER,OWL,SPIDER,DCMNTS,WEB,SPOON,HORN,RAT,GIANT INTEGER SILVER,COINS,CHEST,EGGS,TRIDNT,VASE,EMRALD,PYRAM,PEARL, 2RUG,CHAIN,CROWN,CHALIC,TUSK,ORB INTEGER BACK,LOOK,CAVE,NULL,ENTRNC,DPRSSN INTEGER SAY,THROW,FIND,HOOT,BLOW,CIM INTEGER TRVSIZ,TABSIZ,RTXSIZ,CLSMAX,HNTSIZ,SETUP,OPDUMP 1,TRVS,CLSSES,SECT,OLDLOC,NEWLOC,TABNDX,T,OBJ,VERB,HNTMAX 1,TALLY,TALLY2,CHLOC,CHLOC2,DFLAG,DALTLC,ORCT,ORCT1,TURNS,DETAIL 2,ABBNUM,HOLDNG,DKILL,FOOBAR,BONUS,CLOCK1,CLOCK2,DUNG0,THROWC 3,DTOTAL,ATTACK,STICK,OLDLC2,TIDE,TIDE0,SPK,HINT,FOO 4,WD1X,WD2X,V1,V2,SCORE,PBOTL,DUMMY,VOCAB,RAN,DISTNT,PUT CC 4 C STATEMENT FUNCTIONS C C C TOTING(OBJ) = TRUE IF THE OBJ IS BEING CARRIED C HERE(OBJ) = TRUE IF THE OBJ IS AT "LOC" (OR IS BEING CARRIED) C AT(OBJ) = TRUE IF ON EITHER SIDE OF TWO-PLACED OBJECT C LIQ(DUMMY) = OBJECT NUMBER OF LIQUID IN BOTTLE C LIQLOC(LOC) = OBJECT NUMBER OF LIQUID (IF ANY) AT LOC C BITSET(L,N) = TRUE IF COND(L) HAS BIT N SET (BIT 0 IS UNITS BIT) C FORCED(LOC) = TRUE IF LOC MOVES WITHOUT ASKING FOR INPUT (COND=2) C DARK(DUMMY) = TRUE IF LOCATION "LOC" IS DARK C PCT(N) = TRUE N% OF THE TIME (N INTEGER FROM 0 TO 100) C C WZDARK SAYS WHETHER THE LOC HE'S LEAVING WAS DARK C LMWARN SAYS WHETHER HE'S BEEN WARNED ABOUT LAMP GOING DIM C CLOSNG SAYS WHETHER ITS CLOSING TIME YET C PANIC SAYS WHETHER HE'S FOUND OUT HE'S TRAPPED IN THE CAVE C CLOSED SAYS WHETHER WE'RE ALL THE WAY CLOSED C GAVEUP SAYS WHETHER HE EXITED VIA "QUIT" C SCORNG INDICATES TO THE SCORE ROUTINE WHETHER WE'RE DOING A "SCORE" COMMAND C DEMO IS TRUE IF THIS IS A PRIME-TIME DEMONSTRATION GAME C YEA IS RANDOM YES/NO REPLY C EXTERNAL RAN LOGICAL TOTING,HERE,AT,BITSET,DARK,WZDARK,LMWARN,CLOSNG,PANIC, 1CLOSED,GAVEUP,SCORNG,DEMO,YEA,FORCED,PCT DATA LINSIZ/68000/,TRVSIZ/1000/,LOCSIZ/200/,SETUP/0/, 1 RTXSIZ/300/,CLSMAX/12/,HNTSIZ/20/,MAGSIZ/40/ CC 25 C DEFINE SOME HANDY MNEMONICS. THESE CORRESPOND TO OBJECT NUMBERS. DATA KEYS/01/,LAMP/02/,GRATE/03/,CAGE/04/,ROD/05/, 1ROD2/6/,STEPS/7/, 1BIRD/08/,DOOR/09/,PILLOW/10/,SNAKE/11/,FISSUR/12/, 2TABLET/13/,CLAM/14/,OYSTER/15/,MAGZIN/16/,DWARF/17/, 2KNIFE/18/,FOOD/19/, 3BOTTLE/20/,WATER/21/,OIL/22/,PLANT/24/,PLANT2/25/, 4AXE/28/,MIRROR/23/,DRAGON/31/,CHASM/32/,TROLL/33/, 4TROLL2/34/,BEAR/35/, 5MESSAG/36/,VEND/38/,BATTER/39/,OWL/41/,SPIDER/43/, 6DCMNTS/44/,WEB/42/,SPOON/45/,HORN/46/,RAT/47/,GIANT/48/ CC 26 C OBJECTS FROM 50 THROUGH WHATEVER ARE TREASURES. HERE ARE A FEW. DATA NUGGET/50/,SILVER/52/,COINS/54/,CHEST/55/,EGGS/56/, 1TRIDNT/57/,VASE/58/,EMRALD/59/,PYRAM/60/,PEARL/61/, 2RUG/62/,CHAIN/64/,CROWN/65/,CHALIC/67/,TUSK/66/, 3ORB/69/ CC 27 C THESE ARE MOTION-VERB NUMBERS. DATA BACK/8/,LOOK/57/,CAVE/67/,NULL/21/,ENTRNC/64/, 1DPRSSN/63/ CC 28 C AND SOME ACTION VERBS. DATA SAY/03/,LOCK/06/,THROW/17/,FIND/19/,INVENT/20/,HOOT/32/, 1BLOW/33/ TOTING(OBJ)=PLACE(OBJ).EQ.-1 HERE(OBJ)=PLACE(OBJ).EQ.LOC.OR.TOTING(OBJ) AT(OBJ)=PLACE(OBJ).EQ.LOC.OR.FIXED(OBJ).EQ.LOC LIQ2(PBOTL)=(1-PBOTL)*WATER+(PBOTL/2)*(WATER+OIL) LIQ(DUMMY)=LIQ2(MAX0(PROP(BOTTLE),-1-PROP(BOTTLE))) LIQLOC(LOC)=LIQ2((MOD(COND(LOC)/2*2,8)-5)*MOD(COND(LOC)/4,2)+1) BITSET(L,N)=MOD(COND(L),2**(N+1)).GE.2**N FORCED(LOC)=COND(LOC).EQ.2 DARK(DUMMY)=MOD(COND(LOC),2).EQ.0.AND.(PROP(LAMP).EQ.0.OR. 1.NOT.HERE(LAMP)) PCT(N)=RAN(100).LT.N BLKLIN=.TRUE. CC 5 C DESCRIPTION OF THE DATABASE FORMAT C C C THE DATA FILE CONTAINS SEVERAL SECTIONS. EACH BEGINS WITH A LINE CONTAINING C A NUMBER IDENTIFYING THE SECTION, AND ENDS WITH A LINE CONTAINING "-1". C C SECTION 1: LONG FORM DESCRIPTIONS. EACH LINE CONTAINS A LOCATION NUMBER, C A TAB, AND A LINE OF TEXT. THE SET OF (NECESSARILY ADJACENT) LINES C WHOSE NUMBERS ARE X FORM THE LONG DESCRIPTION OF LOCATION X. C SECTION 2: SHORT FORM DESCRIPTIONS. SAME FORMAT AS LONG FORM. NOT ALL C PLACES HAVE SHORT DESCRIPTIONS. C SECTION 3: TRAVEL TABLE. EACH LINE CONTAINS A LOCATION NUMBER (X), A SECOND C LOCATION NUMBER (Y), AND A LIST OF MOTION NUMBERS (SEE SECTION 4). C EACH MOTION REPRESENTS A VERB WHICH WILL GO TO Y IF CURRENTLY AT X. C Y, IN TURN, IS INTERPRETED AS FOLLOWS. LET M=Y/1000, N=Y MOD 1000. C IF N<=300 IT IS THE LOCATION TO GO TO. C IF 300500 MESSAGE N-500 FROM SECTION 6 IS PRINTED, C AND HE STAYS WHEREVER HE IS. C MEANWHILE, M SPECIFIES THE CONDITIONS ON THE MOTION. C IF M=0 IT'S UNCONDITIONAL. C IF 0$<". C SECTION 6: ARBITRARY MESSAGES. SAME FORMAT AS SECTIONS 1, 2, AND 5, EXCEPT C THE NUMBERS BEAR NO RELATION TO ANYTHING (EXCEPT FOR SPECIAL VERBS C IN SECTION 4). C SECTION 7: OBJECT LOCATIONS. EACH LINE CONTAINS AN OBJECT NUMBER AND ITS C INITIAL LOCATION (ZERO (OR OMITTED) IF NONE). IF THE OBJECT IS C IMMOVABLE, THE LOCATION IS FOLLOWED BY A "-1". IF IT HAS TWO LOCATIONS C (E.G. THE GRATE) THE FIRST LOCATION IS FOLLOWED WITH THE SECOND, AND C THE OBJECT IS ASSUMED TO BE IMMOVABLE. C SECTION 8: ACTION DEFAULTS. EACH LINE CONTAINS AN "ACTION-VERB" NUMBER AND C THE INDEX (IN SECTION 6) OF THE DEFAULT MESSAGE FOR THE VERB. C SECTION 9: LIQUID ASSETS, ETC. EACH LINE CONTAINS A NUMBER (N) AND UP TO 20 C LOCATION NUMBERS. BIT N (WHERE 0 IS THE UNITS BIT) IS SET IN COND(LOC) C FOR EACH LOC GIVEN. THE COND BITS CURRENTLY ASSIGNED ARE: C 0 LIGHT C 1IF BIT 2 IS ON: ON FOR OIL, OFF FOR WATER C 2LIQUID ASSET, SEE BIT 1 C 3PIRATE DOESN'T GO HERE UNLESS FOLLOWING PLAYER C OTHER BITS ARE USED TO INDICATE AREAS OF INTEREST TO "HINT" ROUTINES: C 4TRYING TO GET INTO CAVE C 5TRYING TO CATCH BIRD C 6 TRYING TO DEAL WITH SNAKE C 7 LOST IN MAZE C 8 PONDERING DARK ROOM C 9 AT WITT'S END C COND(LOC) IS SET TO 2, OVERRIDING ALL OTHER BITS, IF LOC HAS FORCED C MOTION. C SECTION 10: CLASS MESSAGES. EACH LINE CONTAINS A NUMBER (N), A TAB, AND A C MESSAGE DESCRIBING A CLASSIFICATION OF PLAYER. THE SCORING SECTION C SELECTS THE APPROPRIATE MESSAGE, WHERE EACH MESSAGE IS CONSIDERED TO C APPLY TO PLAYERS WHOSE SCORES ARE HIGHER THAN THE PREVIOUS N BUT NOT C HIGHER THAN THIS N. NOTE THAT THESE SCORES PROBABLY CHANGE WITH EVERY C MODIFICATION (AND PARTICULARLY EXPANSION) OF THE PROGRAM. C SECTION 11: HINTS. EACH LINE CONTAINS A HINT NUMBER (CORRESPONDING TO A C COND BIT, SEE SECTION 9), THE NUMBER OF TURNS HE MUST BE AT THE RIGHT C LOC(S) BEFORE TRIGGERING THE HINT, THE POINTS DEDUCTED FOR TAKING THE C HINT, THE MESSAGE NUMBER (SECTION 6) OF THE QUESTION, AND THE MESSAGE C NUMBER OF THE HINT. THESE VALUES ARE STASHED IN THE "HINTS" ARRAY. C HNTMAX IS SET TO THE MAX HINT NUMBER (<= HNTSIZ). NUMBERS 1-3 ARE C UNUSABLE SINCE COND BITS ARE OTHERWISE ASSIGNED, SO 2 IS USED TO C REMEMBER IF HE'S READ THE CLUE IN THE REPOSITORY, AND 3 IS USED TO C REMEMBER WHETHER HE ASKED FOR INSTRUCTIONS (GETS MORE TURNS, BUT LOSES C POINTS). C SECTION 12: CIMAG MESSAGES. IDENTICAL TO SECTION 6 EXCEPT PUT IN A SEPARATE C SECTION FOR EASIER REFERENCE. CIMAG MESSAGES ARE USED BY THE STARTUP, C MAINTENANCE MODE, AND RELATED ROUTINES. C SECTION 0: END OF DATABASE. C READ THE DATABASE IF WE HAVE NOT YET DONE SO IF(SETUP.NE.0)GOTO 1100 IPDATA=IODATA(1) IOPDEV=IODATA(2) IPDUMP=IODATA(3) OPDUMP=IODATA(4) WRITE(IOPDEV,1000) 1000 FORMAT(/' INITIALIZING..') CC 6 C CLEAR OUT THE VARIOUS TEXT-POINTER ARRAYS. ALL TEXT IS STORED IN ARRAY C LINES; EACH LINE IS PRECEDED BY A WORD POINTING TO THE NEXT POINTER (I.E. C THE WORD FOLLOWING THE END OF THE LINE). THE POINTER IS NEGATIVE IF THIS IS C FIRST LINE OF A MESSAGE. THE TEXT-POINTER ARRAYS CONTAIN INDICES OF C POINTER-WORDS IN LINES. STEXT(N) IS SHORT DESCRIPTION OF LOCATION N. C LTEXT(N) IS LONG DESCRIPTION. PTEXT(N) POINTS TO MESSAGE FOR PROP(N)=0. C SUCCESSIVE PROP MESSAGES ARE FOUND BY CHASING POINTERS. RTEXT CONTAINS C SECTION 6'S STUFF. CTEXT(N) POINTS TO A PLAYER-CLASS MESSAGE. MTEXT IS FOR C SECTION 12. WE ALSO CLEAR COND. SEE DESCRIPTION OF SECTION 9 FOR DETAILS. DO 999 I=1,400 DO 999 J=1,7 999 ATAB(I,J)=ICHAR(' ') DO 1001 I=1,200 KEY(I)=0 IF(I.LE.100)PTEXT(I)=0 IF(I.LE.RTXSIZ)RTEXT(I)=0 IF(I.LE.CLSMAX)CTEXT(I)=0 IF(I.LE.MAGSIZ)MTEXT(I)=0 IF(I.GT.LOCSIZ)GOTO 1001 STEXT(I)=0 LTEXT(I)=0 COND(I)=0 1001 CONTINUE IBL=ICHAR(' ') CIM=ICHAR('M') WIZENT=.FALSE. SETUP=1 LINUSE=1 TRVS=1 CLSSES=1 TABSIZ=400 IRAN=0 KK=0 OPEN (UNIT=IPDATA,FILE='advII.dat') CC 7 C START NEW DATA SECTION. SECT IS THE SECTION NUMBER. 1002 READ(IPDATA,1003)SECT 1003 FORMAT(I2) OLDLOC=-1 ISECT=SECT+1 GOTO(1100,1004,1004,1030,1040,1004,1004,1050,1060,1070,1004, 1 1080,1004),ISECT CC 8 C (0) (1) (2) (3) (4) (5) (6) (7) (8) (9) (10) C (11) (12) CC 9 C SECTIONS 1, 2, 5, 6, 10, 12. READ MESSAGES AND SET UP POINTERS. 1004 READ(IPDATA,1005)LOC,TLINES 1005 FORMAT(I4,A) IF(LOC.EQ.-1)GOTO 1002 KKK=80 DO 10055 J=1,80 IF (TLINES(KKK:KKK).NE.' ') GOTO 10056 KKK=KKK-1 10055 CONTINUE 10056 CONTINUE IF(LOC.GE.157.AND.LOC.LE.162.AND.SECT.EQ.1)GOTO 1004 KKK=((KKK+3)/4)*4 KK=KKK-4 KKKK=KKK DO 1006 J=1,4 KK=KK+1 IF (TLINES(KK:KK).NE.' ') GOTO 10061 1006 KKKK=KKKK-1 10061 K=LINUSE+1 LINES(K:K+KKK-KK)=TLINES(KK:KKK) K=K+KKK-KK-3 KK=KKK-3 1007 KK=KK-4 IF (KK.LT.1) GOTO 10075 K=K+4 LINES(K:K+3)=TLINES(KK:KK+3) GOTO 1007 10075 CONTINUE KK=KKK IF (LOC.NE.OLDLOC) KK=KK+128 LINES(LINUSE:LINUSE)=CHAR(KK) IF(LOC.EQ.OLDLOC)GOTO 1020 IF(SECT.EQ.12)GOTO 1013 IF(SECT.EQ.10)GOTO 1012 IF(SECT.EQ.6)GOTO 1011 IF(SECT.EQ.5)GOTO 1010 IF(SECT.EQ.1)GOTO 1008 STEXT(LOC)=LINUSE GOTO 1020 1008 LTEXT(LOC)=LINUSE GOTO 1020 1010 IF(LOC.GT.0.AND.LOC.LT.100)PTEXT(LOC)=LINUSE GOTO 1020 1011 IF(LOC.GT.RTXSIZ)CALL BUG(6) RTEXT(LOC)=LINUSE GOTO 1020 1012 CTEXT(CLSSES)=LINUSE CVAL(CLSSES)=LOC CLSSES=CLSSES+1 GOTO 1020 1013 IF(LOC.GT.MAGSIZ)CALL BUG(6) MTEXT(LOC)=LINUSE 1020 LINUSE=LINUSE+KKK+1 LINES(LINUSE:LINUSE)=CHAR(128) OLDLOC=LOC 10201 FORMAT(I6,I6,I6,I8,I8) IF(LINUSE+1.GT.LINSIZ)CALL BUG(2) GOTO 1004 CC 10 (This comment has been misplaced from somewhere above. MLA 12 Sep 2001) CC (The kluge in question is by now probably irrelevant anyway.) C ABOVE KLUGE IS TO AVOID F40 BUG IF CRLF BROKEN ACROSS RECORD BOUNDARY CC 11 C THE STUFF FOR SECTION 3 IS ENCODED HERE. EACH "FROM-LOCATION" GETS A C CONTIGUOUS SECTION OF THE "TRAVEL" ARRAY. EACH ENTRY IN TRAVEL IS C NEWLOC*1000 + KEYWORD (FROM SECTION 4, MOTION VERBS), AND IS NEGATED IF C THIS IS THE LAST ENTRY FOR THIS LOCATION. KEY(N) IS THE INDEX IN TRAVEL C OF THE FIRST OPTION AT LOCATION N. 1030 READ(IPDATA,1031)LOC,NEWLOC,NEWLO,(TK(J),J=1,10) 1031 FORMAT(13I3) IF(LOC.EQ.0)GOTO 1030 CC 12 C ABOVE KLUGE IS TO AVOID AFOREMENTIONED F40 BUG IF(LOC.EQ.-1)GOTO 1002 IF(KEY(LOC).NE.0)GOTO 1033 KEY(LOC)=TRVS GOTO 1035 1033 TRAVEL(TRVS-1,3)=-TRAVEL(TRVS-1,3) 1035 DO 1037 L=1,13 IF(TK(L).EQ.0)GOTO 1039 TRAVEL(TRVS,3)=TK(L) TRAVEL(TRVS,2)=NEWLO TRAVEL(TRVS,1)=NEWLOC TRVS=TRVS+1 IF(TRVS.EQ.TRVSIZ)CALL BUG(3) 1037 CONTINUE 1039 TRAVEL(TRVS-1,3)=-TRAVEL(TRVS-1,3) GOTO 1030 CC 13 C HERE WE READ IN THE VOCABULARY. KTAB(N) IS THE WORD NUMBER, ATAB(N) IS C THE CORRESPONDING WORD. THE -1 AT THE END OF SECTION 4 IS LEFT IN KTAB C AS AN END-MARKER. THE WORDS ARE GIVEN A MINIMAL HASH TO MAKE READING THE C CORE-IMAGE HARDER. NOTE THAT '/7-08' HAD BETTER NOT BE IN THE LIST, SINCE C IT COULD HASH TO -1. 1040 DO 1042 TABNDX=1,TABSIZ T=TABNDX READ(IPDATA,1041)KTAB(T),VOCWRD 1041 FORMAT(I4,A7) ATAB(T,1)=ICHAR(VOCWRD(1:1)) ATAB(T,2)=ICHAR(VOCWRD(2:2)) ATAB(T,3)=ICHAR(VOCWRD(3:3)) ATAB(T,4)=ICHAR(VOCWRD(4:4)) ATAB(T,5)=ICHAR(VOCWRD(5:5)) ATAB(T,6)=ICHAR(VOCWRD(6:6)) ATAB(T,7)=ICHAR(VOCWRD(7:7)) IF(KTAB(TABNDX).EQ.-1)GOTO 1002 1042 CONTINUE CC 15 C 1.XOR.'PHROG' CALL BUG(4) CC 16 C READ IN THE INITIAL LOCATIONS FOR EACH OBJECT. ALSO THE IMMOVABILITY INFO. C PLAC CONTAINS INITIAL LOCATIONS OF OBJECTS. FIXD IS -1 FOR IMMOVABLE C OBJECTS (INCLUDING THE SNAKE), OR = SECOND LOC FOR TWO-PLACED OBJECTS. 1050 READ(IPDATA,21033)OBJ,J,K 21033 FORMAT(3I3) IF(OBJ.EQ.-1)GOTO 1002 PLAC(OBJ)=J FIXD(OBJ)=K GOTO 1050 CC 17 C READ DEFAULT MESSAGE NUMBERS FOR ACTION VERBS, STORE IN ACTSPK. 1060 READ(IPDATA,21033)VERB,J IF(VERB.EQ.-1)GOTO 1002 ACTSPK(VERB)=J GOTO 1060 CC 18 C READ INFO ABOUT AVAILABLE LIQUIDS AND OTHER CONDITIONS, STORE IN COND. 1069 FORMAT(I3,I6,10I3) 1070 READ(IPDATA,1069)K,(TK(J),J=1,10) IF(K.EQ.-1)GOTO 1002 DO 1071 I=1,10 LOC=TK(I) IF(LOC.EQ.0)GOTO 1070 IF(BITSET(LOC,K))CALL BUG(8) 1071 COND(LOC)=COND(LOC)+2**K GOTO 1070 CC 19 C READ DATA FOR HINTS. 1080 HNTMAX=0 1081 READ(IPDATA,1069)K,(TK(J),J=1,10) IF(K.EQ.-1)GOTO 1002 IF(K.EQ.0)GOTO 1081 IF(K.LT.0.OR.K.GT.HNTSIZ)CALL BUG(7) DO 1083 I=1,4 1083 HINTS(K,I)=TK(I) HNTMAX=MAX0(HNTMAX,K) GOTO 1081 CC 20 C FINISH CONSTRUCTING INTERNAL DATA FORMAT C IF SETUP=2 WE DON'T NEED TO DO THIS. IT'S ONLY NECESSARY IF WE HAVEN'T DONE C IT AT ALL OR IF THE PROGRAM HAS BEEN RUN SINCE THEN. 1100 IF(SETUP.EQ.2)GOTO 1 IF(SETUP.EQ.-1)GOTO 8305 CC 21 C HAVING READ IN THE DATABASE, CERTAIN THINGS ARE NOW CONSTRUCTED. PROPS ARE C SET TO ZERO. WE FINISH SETTING UP COND BY CHECKING FOR FORCED-MOTION TRAVEL C ENTRIES. THE PLAC AND FIXD ARRAYS ARE USED TO SET UP ATLOC(N) AS THE FIRST C OBJECT AT LOCATION N, AND LINK(OBJ) AS THE NEXT OBJECT AT THE SAME LOCATION C AS OBJ. (OBJ>100 INDICATES THAT FIXED(OBJ-100)=LOC; LINK(OBJ) IS STILL THE C CORRECT LINK TO USE.) ABB IS ZEROED; IT CONTROLS WHETHER THE ABBREVIATED C DESCRIPTION IS PRINTED. COUNTS MOD 5 UNLESS "LOOK" IS USED. DO 1101 I=1,100 PLACE(I)=0 PROP(I)=0 LINK(I)=0 1101 LINK(I+100)=0 DO 1102 I=1,LOCSIZ ABB(I)=0 IF(LTEXT(I).EQ.0.OR.KEY(I).EQ.0)GOTO 1102 K=KEY(I) IF(IABS(TRAVEL(K,3)).EQ.1)COND(I)=2 1102 ATLOC(I)=0 CC 22 C SET UP THE ATLOC AND LINK ARRAYS AS DESCRIBED ABOVE. WE'LL USE THE DROP C SUBROUTINE, WHICH PREFACES NEW OBJECTS ON THE LISTS. SINCE WE WANT THINGS C IN THE OTHER ORDER, WE'LL RUN THE LOOP BACKWARDS. IF THE OBJECT IS IN TWO C LOCS, WE DROP IT TWICE. THIS ALSO SETS UP "PLACE" AND "FIXED" AS COPIES OF C "PLAC" AND "FIXD". ALSO, SINCE TWO-PLACED OBJECTS ARE TYPICALLY BEST C DESCRIBED LAST, WE'LL DROP THEM FIRST. DO 1106 I=1,100 K=101-I IF(FIXD(K).LE.0)GOTO 1106 CALL DROP(K+100,FIXD(K)) CALL DROP(K,PLAC(K)) 1106 CONTINUE DO 1107 I=1,100 K=101-I FIXED(K)=FIXD(K) 1107 IF(PLAC(K).NE.0.AND.FIXD(K).LE.0)CALL DROP(K,PLAC(K)) CC 23 C TREASURES, AS NOTED EARLIER, ARE OBJECTS 50 THROUGH MAXTRS (CURRENTLY 79). C THEIR PROPS ARE INITIALLY -1, AND ARE SET TO 0 THE FIRST TIME THEY ARE C DESCRIBED. TALLY KEEPS TRACK OF HOW MANY ARE NOT YET FOUND, SO WE KNOW C WHEN TO CLOSE THE CAVE. TALLY2 COUNTS HOW MANY CAN NEVER BE FOUND (E.G. IF C LOST BIRD OR BRIDGE). MAXTRS=79 TALLY=0 TALLY2=0 DO 1200 I=50,MAXTRS IF(PTEXT(I).NE.0)PROP(I)=-1 1200 TALLY=TALLY-PROP(I) CC 24 C CLEAR THE HINT STUFF. HINTLC(I) IS HOW LONG HE'S BEEN AT LOC WITH COND BIT C I. HINTED(I) IS TRUE IFF HINT I HAS BEEN USED. DO 1300 I=1,HNTMAX HINTED(I)=.FALSE. 1300 HINTLC(I)=0 CC 29 C INITIALISE THE DWARVES. DLOC IS LOC OF DWARVES, HARD-WIRED IN. ODLOC IS C PRIOR LOC OF EACH DWARF, INITIALLY GARBAGE. DALTLC IS ALTERNATE INITIAL LOC C FOR DWARF, IN CASE ONE OF THEM STARTS OUT ON TOP OF THE ADVENTURER. (NO 2 C OF THE 5 INITIAL LOCS ARE ADJACENT.) DSEEN IS TRUE IF DWARF HAS SEEN HIM. C DFLAG CONTROLS THE LEVEL OF ACTIVATION OF ALL THIS: C 0 NO DWARF STUFF YET (WAIT UNTIL REACHES HALL OF MISTS) C 1REACHED HALL OF MISTS, BUT HASN'T MET FIRST DWARF C 2MET FIRST DWARF, OTHERS START MOVING, NO KNIVES THROWN YET C 3A KNIFE HAS BEEN THROWN (FIRST SET ALWAYS MISSES) C 3+ DWARVES ARE MAD (INCREASES THEIR ACCURACY) C SIXTH DWARF IS SPECIAL (THE PIRATE). HE ALWAYS STARTS AT HIS CHEST'S C EVENTUAL LOCATION INSIDE THE MAZE. THIS LOC IS SAVED IN CHLOC FOR REF. C THE DEAD END IN THE OTHER MAZE HAS ITS LOC STORED IN CHLOC2. CHLOC=114 CHLOC2=140 DO 1700 I=1,6 ODLOC(i)=-1 1700 DSEEN(I)=.FALSE. DFLAG=0 DLOC(1)=19 DLOC(2)=27 DLOC(3)=113 DLOC(4)=44 DLOC(5)=64 DLOC(6)=CHLOC DALTLC=18 ORCT=0 ORCT1=0 DO 1710 I=1,5 ORC(I)=0 1710 DOBJ(I)=0 CALL MOVE(HORN,163) CALL MOVE(FOOD,3) CC 30 C OTHER RANDOM FLAGS AND COUNTERS, AS FOLLOWS: C TURNS TALLIES HOW MANY COMMANDS HE'S GIVEN (IGNORES YES/NO) C LIMIT LIFETIME OF LAMP (NOT SET HERE) C LIMIT2 THIRST COUNTER (BASED ON HOLDNG) C IWEST HOW MANY TIMES HE'S SAID "WEST" INSTEAD OF "W" C KNFLOC 0 IF NO KNIFE HERE, LOC IF KNIFE HERE, -1 AFTER CAVEAT C DETAIL HOW OFTEN WE'VE SAID "NOT ALLOWED TO GIVE MORE DETAIL" C ABBNUM HOW OFTEN WE SHOULD PRINT NON-ABBREVIATED DESCRIPTIONS C MAXDIE NUMBER OF REINCARNATION MESSAGES AVAILABLE (UP TO 5) C NUMDIE NUMBER OF TIMES KILLED SO FAR C HOLDNG NUMBER OF OBJECTS BEING CARRIED C DKILL NUMBER OF DWARVES KILLED (UNUSED IN SCORING, NEEDED FOR MSG) C FOOBAR CURRENT PROGRESS IN SAYING "FEE FIE FOE FOO". C BONUS USED TO DETERMINE AMOUNT OF BONUS IF HE REACHES CLOSING C CLOCK1 NUMBER OF TURNS FROM FINDING LAST TREASURE TILL CLOSING C CLOCK2 NUMBER OF TURNS FROM FIRST WARNING TILL BLINDING FLASH C TIDE TIDAL COUNTER C INSC1 SPOON INSCRIPTION C DUNG0 IN DUNGEON COUNT C THROWC NUMBER OF OBJECTS THROWN AT CELLAR VIEW C LOGICALS WERE EXPLAINED EARLIER TURNS=0 LMWARN=.FALSE. IWEST=0 LIMIT2=-200 KNFLOC=0 DETAIL=0 ABBNUM=5 DO 1800 I=1,5 1800 IF(RTEXT(2*I+79).NE.0)MAXDIE=I NUMDIE=0 HOLDNG=0 DKILL=0 FOOBAR=0 BONUS=0 CLOCK1=30 CLOCK2=50 TIDE=100 INSC1=0 DUNG0=0 THROWC=0 CLOSNG=.FALSE. PANIC=.FALSE. CLOSED=.FALSE. GAVEUP=.FALSE. SCORNG=.FALSE. CC 31 C IF SETUP=1, REPORT ON AMOUNT OF ARRAYS ACTUALLY USED, TO PERMIT REDUCTIONS. IF(SETUP.NE.1)GOTO 1 SETUP=2 DO 1998 K=1,LOCSIZ LOCUSD=LOCSIZ+1-K IF(LTEXT(LOCUSD).NE.0)GOTO 1997 1998 CONTINUE OBJ=0 1997 DO 1996 K=1,100 1996 IF(PTEXT(K).NE.0)OBJ=OBJ+1 DO 1995 K=1,TABNDX 1995 IF(KTAB(K)/1000.EQ.2)VERB=KTAB(K)-2000 DO 1994 K=1,RTXSIZ J=RTXSIZ+1-K IF(RTEXT(J).NE.0)GOTO 1993 1994 CONTINUE 1993 DO 1992 K=1,MAGSIZ I=MAGSIZ+1-K IF(MTEXT(I).NE.0)GOTO 1991 1992 CONTINUE 1991 K=100 CC 32 C FINALLY, SINCE WE'RE CLEARLY SETTING THINGS UP FOR THE FIRST TIME... C START-UP, DWARF STUFF 1 DEMO=.FALSE. IF(YES(273,54,0))GOTO 8305 I=RAN(1) HINTED(3)=.FALSE. IF(.NOT.WIZENT)HINTED(3)=YES(65,1,0) OLDLOC=1 LOC=1 NEWLOC=1 SETUP=3 LIMIT=330 IF(HINTED(3))LIMIT=1000 IF(.NOT.WIZENT)GO TO 2 DO 61 KK=1,LOCUSD ABB(KK)=1 61 CONTINUE ABBNUM=10000 DETAIL=3 CC 33 C CAN'T LEAVE CAVE ONCE IT'S CLOSING (EXCEPT BY MAIN OFFICE). 2 IF((NEWLOC.GE.9.AND.NEWLOC.NE.167).OR.NEWLOC.EQ.0.OR..NOT.CLOSNG 2)GOTO 71 CALL RSPEAK(130) NEWLOC=LOC IF(.NOT.PANIC)CLOCK2=15 PANIC=.TRUE. CC 34 C SEE IF A DWARF HAS SEEN HIM AND HAS COME FROM WHERE HE WANTS TO GO. IF SO, C THE DWARF'S BLOCKING HIS WAY. IF COMING FROM PLACE FORBIDDEN TO PIRATE C (DWARVES ROOTED IN PLACE) LET HIM GET OUT (AND ATTACKED). 71 IF(NEWLOC.EQ.LOC.OR.FORCED(LOC).OR.BITSET(LOC,3))GOTO 74 DO 73 I=1,5 IF(ODLOC(I).NE.NEWLOC.OR..NOT.DSEEN(I))GOTO 73 NEWLOC=LOC CALL RSPEAK(2) GOTO 74 73 CONTINUE 74 LOC=NEWLOC CC 35 C OWL STUFF. RUNS AWAY IF YOU LAND ON HIM WITH YOUR LIGHT ON 76 IF(.NOT.HERE(OWL).OR.DARK(0))GOTO 7405 SPK=206 7402 I=LOC 7403 I=DISTNT(I,3) IF(I.EQ.LOC.OR.MOD(COND(I),2).NE.0.OR.I.EQ.PLAC(SPIDER))GOTO 7403 CALL MOVE(OWL,I) 7404 CALL RSPEAK(SPK) CC 36 C DWARF STUFF. SEE EARLIER COMMENTS FOR DESCRIPTION OF VARIABLES. REMEMBER C SIXTH DWARF IS PIRATE AND IS THUS VERY DIFFERENT EXCEPT FOR MOTION RULES. C FIRST OFF, DON'T LET THE DWARVES FOLLOW HIM INTO A PIT OR A WALL. ACTIVATE C THE WHOLE MESS THE FIRST TIME HE GETS AS FAR AS THE HALL OF MISTS (LOC 15). C IF NEWLOC IS FORBIDDEN TO PIRATE (IN PARTICULAR, IF IT'S BEYOND THE TROLL C BRIDGE), BYPASS DWARF STUFF. THAT WAY PIRATE CAN'T STEAL RETURN TOLL, AND C DWARVES CAN'T MEET THE BEAR. ALSO MEANS DWARVES WON'T FOLLOW HIM INTO DEAD C END IN MAZE, BUT C'EST LA VIE. THEY'LL WAIT FOR HIM OUTSIDE THE DEAD END. 7405 IF(LOC.EQ.0.OR.FORCED(LOC).OR.BITSET(NEWLOC,3))GOTO 2000 IF(DFLAG.NE.0)GOTO 6000 IF(LOC.GE.15)DFLAG=1 GOTO 2000 CC 37 C WHEN WE ENCOUNTER THE FIRST DWARF, WE KILL 0, 1, OR 2 OF THE 5 DWARVES. IF C ANY OF THE SURVIVORS IS AT LOC, REPLACE HIM WITH THE ALTERNATE. 6000 IF(DFLAG.NE.1)GOTO 6010 IF(LOC.LT.15.OR.PCT(95).OR.DARK(0))GOTO 2000 DFLAG=2 DO 6001 I=1,2 J=1+RAN(5) CC 38 C IF SAVED NOT = -1, HE BYPASSED THE "START" CALL. 6001 IF(PCT(50))DLOC(J)=0 DO 6002 I=1,5 IF(DLOC(I).EQ.LOC)DLOC(I)=DALTLC 6002 ODLOC(I)=DLOC(I) CALL RSPEAK(3) CALL DROP(AXE,LOC) GOTO 2000 CC 39 C THINGS ARE IN FULL SWING. MOVE EACH DWARF AT RANDOM, EXCEPT IF HE'S SEEN US C HE STICKS WITH US. DWARVES NEVER GO TO LOCS <15. IF WANDERING AT RANDOM, C THEY DON'T BACK UP UNLESS THERE'S NO ALTERNATIVE. IF THEY DON'T HAVE TO C MOVE, THEY ATTACK. AND, OF COURSE, DEAD DWARVES DON'T DO MUCH OF ANYTHING. 6010 DTOTAL=0 ATTACK=0 STICK=0 CALL DTOT DO 6030 I=1,6 IF(DLOC(I).EQ.0)GOTO 6028 J=1 KK=DLOC(I) KK=KEY(KK) IF(KK.EQ.0)GOTO 6016 6012 NEWLOC=TRAVEL(KK,2) IF(NEWLOC.EQ.CHLOC)GOTO 6014 IF(NEWLOC.GT.300.OR.NEWLOC.LT.15.OR.NEWLOC.EQ.ODLOC(I))GOTO 6014 IF(J.LE.1)GOTO6013 IF(NEWLOC.EQ.TK(J-1).OR.J.GE.20)GOTO6014 6013 IF(NEWLOC.EQ.DLOC(I).OR.FORCED(NEWLOC) 3.OR.(I.EQ.6.AND.BITSET(NEWLOC,3)).OR.NEWLOC.EQ.PLACE(OWL) 4.OR.TRAVEL(KK,1).EQ.100)GOTO 6014 TK(J)=NEWLOC J=J+1 6014 KK=KK+1 IF(TRAVEL(KK-1,3).GE.0)GOTO 6012 6016 TK(J)=ODLOC(I) IF(J.GE.2)J=J-1 J=1+RAN(J) ODLOC(I)=DLOC(I) DLOC(I)=TK(J) DSEEN(I)=(DSEEN(I).AND.LOC.GE.15.AND.IABS(LOC-182).GT.6) 1.OR.(DLOC(I).EQ.LOC.OR.ODLOC(I).EQ.LOC) IF(.NOT.DSEEN(I))GOTO 6030 DLOC(I)=LOC IDWARF=I IF(I.NE.6)GOTO 6027 CC 40 C THE PIRATE'S SPOTTED HIM. HE LEAVES HIM ALONE ONCE WE'VE FOUND CHEST. C K COUNTS IF A TREASURE IS HERE. IF NOT, AND TALLY=TALLY2 PLUS ONE FOR C AN UNSEEN CHEST, LET THE PIRATE BE SPOTTED. IF(LOC.EQ.CHLOC.OR.PROP(CHEST).GE.0)GOTO 6030 K=0 DO 6020 J=50,MAXTRS CC 41 C PIRATE WON'T TAKE PYRAMID FROM PLOVER ROOM OR DARK ROOM (TOO EASY!). IF(J.EQ.PYRAM.AND.(LOC.EQ.PLAC(PYRAM) 1.OR.LOC.EQ.PLAC(EMRALD)))GOTO 6020 IDONDX=J IF(TOTING(IDONDX))GOTO 6022 6020 IF(HERE(IDONDX))K=1 IF(TALLY.EQ.TALLY2+1.AND.K.EQ.0.AND.PLACE(CHEST).EQ.0 1.AND.HERE(LAMP).AND.PROP(LAMP).EQ.1)GOTO 6025 IF(ODLOC(6).NE.DLOC(6).AND.PCT(20))CALL RSPEAK(127) GOTO 6030 6022 CALL RSPEAK(128) CC 42 C DON'T STEAL CHEST BACK FROM TROLL! IF(PLACE(MESSAG).EQ.0)CALL MOVE(CHEST,CHLOC) CALL MOVE(MESSAG,CHLOC2) DO 6023 J=50,MAXTRS IF(J.EQ.PYRAM.AND.(LOC.EQ.PLAC(PYRAM) 1.OR.LOC.EQ.PLAC(EMRALD)))GOTO 6023 IDONDX=J IF(AT(IDONDX).AND.FIXED(IDONDX).EQ.0) 1 CALL CARRY(IDONDX,LOC) IF(TOTING(IDONDX))CALL DROP(IDONDX,CHLOC) 6023 CONTINUE 6024 DLOC(6)=CHLOC ODLOC(6)=CHLOC DSEEN(6)=.FALSE. GOTO 6030 6025 CALL RSPEAK(186) CALL MOVE(CHEST,CHLOC) CALL MOVE(MESSAG,CHLOC2) GOTO 6024 CC 43 C THIS THREATENING LITTLE DWARF IS IN THE ROOM WITH HIM! 6027 DTOTAL=DTOTAL+1 IF(ODLOC(I).NE.DLOC(I))GOTO 6030 ATTACK=ATTACK+1 IF(KNFLOC.GE.0)KNFLOC=LOC IF(RAN(10).LT.DFLAG-2)STICK=STICK+1 GOTO 6030 CC 44 C DWALF RESURRECTION 6028 IF(RAN(400).LT.1)DLOC(I)=163 6030 CONTINUE NEWLOC=LOC CC 45 C*** C DO 6031 II=1,6 C WRITE(IOPDEV,*)LOC,DLOC(II),DOBJ(II) C 6031 CONTINUE C NOW WE KNOW WHAT'S HAPPENING. LET'S TELL THE POOR SUCKER ABOUT IT. IF(DTOTAL.EQ.0.OR.DARK(0))GOTO 2000 IF(DTOTAL.EQ.1)GOTO 75 WRITE(IOPDEV,*) WRITE(IOPDEV,*)' THERE ARE ',DTOTAL, 1 ' THREATENING LITTLE DWARVES IN THE ROOM WITH YOU.' C* 67 FORMAT(/11H THERE ARE ,I1,36H THREATENING LITTLE DWARVES IN THE C* 1 ,16H ROOM WITH YOU. ) GOTO 77 75 CALL RSPEAK(4) IF(ATTACK.EQ.0.AND.DOBJ(IDWARF).NE.0)CALL RSPEAK(231) 77 IF(ATTACK.EQ.0)GOTO 2000 IF(DFLAG.EQ.2)DFLAG=3 CC 46 C IF SAVED NOT = -1, HE BYPASSED THE "START" CALL. DWARVES GET *VERY* MAD! IF(ATTACK.EQ.1)GOTO 79 WRITE(IOPDEV,*)' ',ATTACK,' OF THEM THROW KNIVES AT YOU!' C*78 FORMAT(/2H ,I1,29H OF THEM THROW KNIVES AT YOU!) K=6 82 IF(STICK.GT.1)GOTO 83 CALL RSPEAK(K+STICK) IF(STICK.EQ.0)GOTO 2000 GOTO 84 83 WRITE(IOPDEV,*)' ',STICK,' OF THEM GET YOU!' C* 68 FORMAT(/2H ,I1,17H OF THEM GET YOU!) 84 OLDLC2=LOC GOTO 99 79 CALL RSPEAK(5) K=52 GOTO 82 CC 47 C DWALVES TOTING CONTROL IN SUB DTOT C PRINT TIDAL COMMENTS IF IN CULVERT (& BYPASS ORC & THIRST) C THIRST COUNTER AND COMMENTS. C CALL ORC EVERY 40 MOVES,UNLESS A FURTHER TREASURE IS FOUND C DESCRIBE THE CURRENT LOCATION AND (MAYBE) GET NEXT COMMAND. C PRINT TEXT FOR CURRENT LOC. 2000 IF(LOC.EQ.0)GOTO 99 TIDE=TIDE+1 IF(TIDE.EQ.15)TIDE=-15 IF(LOC.LT.176.OR.LOC.GT.187)GOTO 203 IF(TIDE.GE.100.AND.LOC.EQ.178)TIDE=3 IF(IABS(TIDE).GE.5.AND.LOC.EQ.178)LOC=179 IF(LOC.LT.180.OR.LOC.GT.182)GOTO 202 IF(LOC.EQ.182)PROP(47)=MOD(PROP(47)+1,7) TIDE0=214+2*181-364+IABS(TIDE)-2 IF(TIDE0.GT.214)GOTO 201 CALL RSPEAK(214) GOTO 99 201 IF(TIDE0.GE.221)TIDE0=221 CALL RSPEAK(TIDE0) 202 IF(LOC.LT.183.OR.LOC.GT.186.OR.TIDE.NE.0)GOTO 205 CALL RSPEAK(222) GOTO 99 203 CONTINUE LIMIT1=LIMIT2 LIMIT2=LIMIT2+2+HOLDNG IF(LOC.EQ.126)LIMIT2=440+LIMIT2/2 IF(LIMIT2.LE.800)GOTO 204 IF(LIMIT1.LT.800)SPK=270 IF(LIMIT2.GE.880)SPK=271 IF(LIMIT2.GE.900)SPK=272 IF(IABS(SPK-271).LE.1)CALL RSPEAK(SPK) IF(SPK.EQ.272)GOTO 99 204 SPK=0 IF(ORCT.LT.40)GOTO 205 IF(CLOSNG.OR.CLOSED.OR.DTOTAL.NE.0.OR.LOC.LT.20)GOTO 205 IF(LOC.GT.150)GOTO 205 IF(TALLY.EQ.ORCT1.AND..NOT.DARK(0))CALL ORCALL ORCT1=TALLY ORCT=0 205 ORCT=ORCT+1 KK=STEXT(LOC) IF(MOD(ABB(LOC),ABBNUM).EQ.0.OR.KK.EQ.0)KK=LTEXT(LOC) IF(FORCED(LOC).OR..NOT.DARK(0))GOTO 2001 C*** C WRITE(IOPDEV,*)'VERB,OBJ=',VERB,OBJ IF(VERB.NE.HOOT.AND.VERB.NE.BLOW.AND.WZDARK.AND.PCT(35))GOTO 90 KK=RTEXT(16) 2001 IF(TOTING(BEAR))CALL RSPEAK(141) CALL SPEAK(KK) K=1 IF(FORCED(LOC))GOTO 8 IF(LOC.EQ.33.AND.PCT(25).AND..NOT.CLOSNG)CALL RSPEAK(8) CC 48 C PRINT OUT DESCRIPTIONS OF OBJECTS AT THIS LOCATION. IF NOT CLOSING AND C PROPERTY VALUE IS NEGATIVE, TALLY OFF ANOTHER TREASURE. RUG IS SPECIAL C CASE; ONCE SEEN, ITS PROP IS 1 (DRAGON ON IT) TILL DRAGON IS KILLED. C SIMILARLY FOR CHAIN; PROP IS INITIALLY 1 (LOCKED TO BEAR). THESE HACKS C ARE BECAUSE PROP=0 IS NEEDED TO GET FULL SCORE. IF(DARK(0))GOTO 206 ABB(LOC)=ABB(LOC)+1 I=ATLOC(LOC) 2004 IF(I.EQ.0)GOTO 206 OBJ=I IF(OBJ.GT.100)OBJ=OBJ-100 IF(OBJ.EQ.STEPS.AND.TOTING(NUGGET))GOTO 2008 IF(PROP(OBJ).GE.0)GOTO 2006 IF(CLOSED)GOTO 2008 PROP(OBJ)=0 IF(OBJ.EQ.RUG.OR.OBJ.EQ.CHAIN)PROP(OBJ)=1 TALLY=TALLY-1 CC 49 C IF REMAINING TREASURES TOO ELUSIVE, ZAP HIS LAMP. IF(TALLY.EQ.TALLY2.AND.TALLY.NE.0)LIMIT=MIN0(35,LIMIT) 2006 KK=PROP(OBJ) IF(OBJ.EQ.STEPS.AND.LOC.EQ.FIXED(STEPS))KK=1 C COMPRESS DESCRIPTION AT BUILDING AFTER 200 TURNS IF(LOC.EQ.3.AND.TURNS.GT.200)BLKLIN=.FALSE. CALL PSPEAK(OBJ,KK) IF(LOC.EQ.3)BLKLIN=.TRUE. 2008 I=LINK(I) GOTO 2004 206 IF(PROP(47).EQ.6.AND.LOC.EQ.182)GOTO 99 IF(MOD(PROP(GIANT),2).EQ.1)GOTO 30500 IF(LOC.EQ.145)GOTO 30600 IF(PROP(CHALIC).NE.1.OR.PLACE(CHALIC).EQ.LOC)GOTO 207 FIXED(CHALIC)=0 CALL MOVE(CHALIC,0) 207 GOTO 2012 2009 K=54 2010 SPK=K 2011 CALL RSPEAK(SPK) 2012 VERB=0 OBJ=0 CC 50 C CHECK IF THIS LOC IS ELIGIBLE FOR ANY HINTS. IF BEEN HERE LONG ENOUGH, C BRANCH TO HELP SECTION (ON LATER PAGE). HINTS ALL COME BACK HERE EVENTUALLY C TO FINISH THE LOOP. IGNORE "HINTS" < 4 (SPECIAL STUFF, SEE DATABASE NOTES). 2600 DO 2602 HINT=4,HNTMAX IF(HINTED(HINT))GOTO 2602 IDONDX=HINT IF(.NOT.BITSET(LOC,IDONDX))HINTLC(HINT)=-1 HINTLC(HINT)=HINTLC(HINT)+1 IF(HINTLC(HINT).GE.HINTS(HINT,1))GOTO 40000 2602 CONTINUE 2603 CONTINUE CC 51 C KICK THE RANDOM NUMBER GENERATOR JUST TO ADD VARIETY TO THE CHASE. ALSO, C IF CLOSING TIME, CHECK FOR ANY OBJECTS BEING TOTED WITH PROP < 0 AND SET C THE PROP TO -1-PROP. THIS WAY OBJECTS WON'T BE DESCRIBED UNTIL THEY'VE C BEEN PICKED UP AND PUT DOWN SEPARATE FROM THEIR RESPECTIVE PILES. DON'T C TICK CLOCK1 UNLESS WELL INTO CAVE (AND NOT AT Y2). IF(.NOT.CLOSED)GOTO 2605 IF(PROP(OYSTER).LT.0.AND.TOTING(OYSTER)) 1CALL PSPEAK(OYSTER,1) DO 2604 I=1,100 IDONDX=I 2604 IF(TOTING(IDONDX).AND.PROP(IDONDX).LT.0) 1 PROP(IDONDX)=-1-PROP(IDONDX) 2605 WZDARK=DARK(0) IF(KNFLOC.GT.0.AND.KNFLOC.NE.LOC)KNFLOC=0 I=RAN(1) CALL GETIN(WD1,WD1X,WD2,WD2X) CC 52 C EVERY INPUT, CHECK "FOOBAR" FLAG. IF ZERO, NOTHING'S GOING ON. IF POS, C MAKE NEG. IF NEG, HE SKIPPED A WORD, SO MAKE IT ZERO. C 2608 FOOBAR=MIN0(0,-FOOBAR) IF(TURNS.EQ.0.AND.WD1(1).EQ.CIM.AND.WD2(1).EQ.CIM) 1WIZENT=.TRUE. TURNS=TURNS+1 IF(VERB.EQ.SAY.AND.WD2X.NE.0)VERB=0 IF(VERB.EQ.SAY)GOTO 4090 IF(TALLY.EQ.0.AND.LOC.GE.15.AND.LOC.NE.33)CLOCK1=CLOCK1-1 IF(CLOCK1.EQ.0)GOTO 10000 IF(CLOCK1.LT.0)CLOCK2=CLOCK2-1 IF(CLOCK2.EQ.0)GOTO 11000 IF(PROP(LAMP).EQ.1)LIMIT=LIMIT-1 IF(LIMIT.LE.30.AND.HERE(BATTER).AND.PROP(BATTER).EQ.0 1.AND.HERE(LAMP))GOTO 12000 IF(LIMIT.EQ.0)GOTO 12400 IF(LIMIT.LT.0.AND.LOC.LE.8)GOTO 12600 IF(LIMIT.LE.30)GOTO 12200 19999 K=43 IF(LIQLOC(LOC).EQ.WATER)K=70 V1=VOCAB(WD1,-1) V2=VOCAB(WD2,-1) IF(V1.EQ.3.AND.(V2.EQ.14.OR.V2.EQ.1021))GOTO 2010 IF(V1.EQ.3.AND.WD2X.NE.0)GOTO 2800 IF((V1.NE.1021.AND.V1.NE.1022) 1.OR.(V2.NE.1024.AND.V2.NE.1009))GOTO 2610 IF(.NOT.AT(VOCAB(WD2,1)))GOTO 2610 WD2(1)=ICHAR('P') WD2(2)=ICHAR('O') WD2(3)=ICHAR('U') WD2(4)=ICHAR('R') WD2(5)=IBL WD2(6)=IBL WD2(7)=IBL WD2X=4 2610 IF(V1.NE.44)GOTO 2630 IWEST=IWEST+1 IF(IWEST.EQ.10.AND.WD1(2).NE.IBL)CALL RSPEAK(17) 2630 I=VOCAB(WD1,-1) IF(I.EQ.-1)GOTO 3000 K=MOD(I,1000) KQ=I/1000+1 GOTO (8,5000,4000,2010),KQ CC 53 C GET SECOND WORD FOR ANALYSIS. 2800 WD1X=WD2X DO 2801 IW=1,10 WD1(IW)=WD2(IW) 2801 WD2(IW)=IBL WD2X=0 GOTO 2610 CC 54 C GEE, I DON'T UNDERSTAND. 3000 SPK=60 IF(PCT(20))SPK=61 IF(PCT(20))SPK=13 CALL RSPEAK(SPK) GOTO 2600 CC 55 C ANALYSE A VERB. REMEMBER WHAT IT WAS, GO BACK FOR OBJECT IF SECOND WORD C UNLESS VERB IS "SAY", WHICH SNARFS ARBITRARY SECOND WORD. 4000 VERB=K SPK=ACTSPK(VERB) IF(WD2X.NE.0.AND.VERB.NE.SAY)GOTO 2800 IF(VERB.EQ.SAY)OBJ=WD2X IF(OBJ.NE.0)GOTO 4090 CC 56 C ANALYSE AN INTRANSITIVE VERB (IE, NO OBJECT GIVEN YET). GOTO(8010,8000,8000,8040,2009,8040,9070,9080,8000,8000, 1 2011,9120,9130,8140,9150,8000,8000,8180,8000,8200, 2 8000,9220,9230,8240,8250,8260,8270,8000,8000,8300, 3 8310,8320,8000,8340,8000,8004,8006,8008),VERB CC 57 C TAKE DROP SAY OPEN NOTH LOCK ON OFF WAVE CALM C WALK KILL POUR EAT DRNK RUB TOSS QUIT FIND INVN C FEED FILL BLST SCOR FOO BRF READ BREK WAKE SUSP C HOUR HOOT BLOW FLY RIDE SLEE REST SCRE CC 58 C ANALYSE A TRANSITIVE VERB. 4090 GOTO(9010,9020,9030,9040,2009,9040,9070,9080,9090,2011, 1 2011,9120,9130,9140,9150,9160,9170,2011,9190,9190, 2 9210,9220,9230,2011,2011,2011,9270,9280,9290,2011, 3 2011,2011,9330,2011,9350,8004,8006,8008),VERB CC 59 C TAKE DROP SAY OPEN NOTH LOCK ON OFF WAVE CALM C WALK KILL POUR EAT DRNK RUB TOSS QUIT FIND INVN C FEED FILL BLST SCOR FOO BRF READ BREK WAKE SUSP C HOUR HOOT BLOW FLY RIDE SLEE REST SCRE CC 60 C ANALYSE AN OBJECT WORD. SEE IF THE THING IS HERE, WHETHER WE'VE GOT A VERB C YET, AND SO ON. OBJECT MUST BE HERE UNLESS VERB IS "FIND" OR "INVENT(ORY)" C (AND NO NEW VERB YET TO BE ANALYSED). WATER AND OIL ARE ALSO FUNNY, SINCE C THEY ARE NEVER ACTUALLY DROPPED AT ANY LOCATION, BUT MIGHT BE HERE INSIDE C THE BOTTLE OR AS A FEATURE OF THE LOCATION. C C 5000 OBJ=K IF(FIXED(K).NE.LOC.AND..NOT.HERE(K))GOTO 5100 5010 IF(WD2X.NE.0)GOTO 2800 IF(VERB.NE.0)GOTO 5200 IF(OBJ.EQ.OWL)GOTO 5020 WRITE(IOPDEV,5015)'WHAT DO YOU WANT TO DO WITH THE ',WD1 5015 FORMAT(/A,10A1) GOTO 2600 5020 SPK=208 GOTO 2011 5100 IF(K.NE.GRATE)GOTO 5110 IF(LOC.EQ.1.OR.LOC.EQ.4.OR.LOC.EQ.7)K=DPRSSN IF(LOC.GT.9.AND.LOC.LT.15)K=ENTRNC IF(K.NE.GRATE)GOTO 8 5110 IF(K.NE.DWARF)GOTO 5120 DO 5112 I=1,5 IF(DLOC(I).EQ.LOC.AND.DFLAG.GE.2)GOTO 5010 5112 CONTINUE 5120 IF((LIQ(0).EQ.K.AND.HERE(BOTTLE)).OR.K.EQ.LIQLOC(LOC))GOTO 5010 IF(OBJ.NE.PLANT.OR..NOT.AT(PLANT2).OR.PROP(PLANT2).EQ.0)GOTO 5130 OBJ=PLANT2 GOTO 5010 5130 IF(OBJ.NE.KNIFE.OR.KNFLOC.NE.LOC)GOTO 5140 KNFLOC=-1 SPK=116 GOTO 2011 5140 IF(OBJ.NE.ROD.OR..NOT.HERE(ROD2))GOTO 5190 OBJ=ROD2 GOTO 5010 5190 IF((VERB.EQ.FIND.OR.VERB.EQ.INVENT).AND.WD2X.EQ.0)GOTO 5010 WRITE(IOPDEV,5199)(CHAR(WD1(I)),I=1,10) 5199 FORMAT(/' I SEE NO ',10A) GOTO 2012 5200 IF(OBJ.NE.OWL)GOTO 4090 SPK=209 GOTO 2011 CC 61 C FIGURE OUT THE NEW LOCATION C C GIVEN THE CURRENT LOCATION IN "LOC", AND A MOTION VERB NUMBER IN "K", PUT C THE NEW LOCATION IN "NEWLOC". THE CURRENT LOC IS SAVED IN "OLDLOC" IN CASE C HE WANTS TO RETREAT. THE CURRENT OLDLOC IS SAVED IN OLDLC2, IN CASE HE C DIES. (IF HE DOES, NEWLOC WILL BE LIMBO, AND OLDLOC WILL BE WHAT KILLED C HIM, SO WE NEED OLDLC2, WHICH IS THE LAST PLACE HE WAS SAFE.) 8 KK=KEY(LOC) NEWLOC=LOC IF(KK.EQ.0)CALL BUG(26) IF(K.EQ.NULL)GOTO 2 IF(K.EQ.BACK)GOTO 20 IF(K.EQ.LOOK)GOTO 30 IF(K.EQ.CAVE)GOTO 40 OLDLC2=OLDLOC OLDLOC=LOC 9 LL=IABS(TRAVEL(KK,3)) IF(LL.EQ.1.OR.LL.EQ.K)GOTO 10 IF(TRAVEL(KK,3).LT.0)GOTO 50 KK=KK+1 GOTO 9 10 LL=TRAVEL(KK,2) 11 NEWLOC=TRAVEL(KK,1) K=MOD(NEWLOC,100) IF(NEWLOC.LE.300)GOTO 13 IF(PROP(K).NE.NEWLOC/100-3)GOTO 16 12 IF(TRAVEL(KK,3).LT.0)CALL BUG(25) KK=KK+1 NEWLOC=TRAVEL(KK,2) IF(NEWLOC.EQ.LL)GOTO 12 LL=NEWLOC GOTO 11 13 IF(NEWLOC.LE.100)GOTO 14 IF(TOTING(K).OR.(NEWLOC.GT.200.AND.AT(K)))GOTO 16 GOTO 12 14 IF(NEWLOC.NE.0.AND..NOT.PCT(NEWLOC))GOTO 12 16 NEWLOC=MOD(LL,1000) IF(NEWLOC.LE.300)GOTO 2 IF(NEWLOC.LE.500)GOTO 30000 CALL RSPEAK(NEWLOC-500) NEWLOC=LOC GOTO 2 CC 62 C SPECIAL MOTIONS COME HERE. LABELLING CONVENTION: STATEMENT NUMBERS NNNXX C (XX=00-99) ARE USED FOR SPECIAL CASE NUMBER NNN (NNN=301-500). 30000 NEWLOC=NEWLOC-300 GOTO (30100,30200,30300,30400,30500,30600),NEWLOC CC 63 C TRAVEL 301. PLOVER-ALCOVE PASSAGE. CAN CARRY ONLY EMERALD. NOTE: TRAVEL C TABLE MUST INCLUDE "USELESS" ENTRIES GOING THROUGH PASSAGE, WHICH CAN NEVER C BE USED FOR ACTUAL MOTION, BUT CAN BE SPOTTED BY "GO BACK". 30100 NEWLOC=99+100-LOC IF(HOLDNG.EQ.0.OR.(HOLDNG.EQ.1.AND.TOTING(EMRALD)))GOTO 2 NEWLOC=LOC CALL RSPEAK(117) GOTO 2 CC 64 C TRAVEL 302. PLOVER TRANSPORT. DROP THE EMERALD (ONLY USE SPECIAL TRAVEL IF C TOTING IT), SO HE'S FORCED TO USE THE PLOVER-PASSAGE TO GET IT OUT. HAVING C DROPPED IT, GO BACK AND PRETEND HE WASN'T CARRYING IT AFTER ALL. 30200 CALL DROP(EMRALD,LOC) GOTO 12 CC 65 C TRAVEL 303. TROLL BRIDGE. MUST BE DONE ONLY AS SPECIAL MOTION SO THAT C DWARVES WON'T WANDER ACROSS AND ENCOUNTER THE BEAR. (THEY WON'T FOLLOW THE C PLAYER THERE BECAUSE THAT REGION IS FORBIDDEN TO THE PIRATE.) IF C PROP(TROLL)=1, HE'S CROSSED SINCE PAYING, SO STEP OUT AND BLOCK HIM. C (STANDARD TRAVEL ENTRIES CHECK FOR PROP(TROLL)=0.) SPECIAL STUFF FOR BEAR. 30300 IF(PROP(TROLL).NE.1)GOTO 30310 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 2 30310 NEWLOC=PLAC(TROLL)+FIXD(TROLL)-LOC IF(PROP(TROLL).EQ.0)PROP(TROLL)=1 IF(.NOT.TOTING(BEAR))GOTO 2 CALL RSPEAK(162) PROP(CHASM)=1 PROP(TROLL)=2 CALL DROP(BEAR,NEWLOC) FIXED(BEAR)=-1 PROP(BEAR)=3 IF(PROP(63).LT.0)TALLY2=TALLY2+1 OLDLC2=NEWLOC GOTO 99 CC 66 C SEWER SECTION. KEEP BOTTLE, VASE ETC OUT AND TUSK IN. 30400 NEWLOC=350-LOC IF(TOTING(VASE).OR.TOTING(BOTTLE).OR.TOTING(CAGE))GOTO 30410 IF(TOTING(TUSK).OR.TOTING(NUGGET).OR.TOTING(CHEST))GOTO 30410 IF(TOTING(CHALIC).OR.TOTING(SILVER).OR.TOTING(TRIDNT))GOTO 30410 IF(TOTING(PYRAM).OR.TOTING(EGGS).OR.TOTING(CROWN))GOTO 30410 GOTO 2 30410 NEWLOC=LOC CALL RSPEAK(260) GOTO 2 CC 67 C GIANT SECTION. PACIFY GIANT WITH GOLDEN EGGS, OTHERWISE EXIT TO C PANTRY (IF TOTING FOOD OR TREASURE) ELSE DUNGEON. LEGAL DOCUM(44) GET C EXCHANGED FOR RUBY(68). 30500 IF(PROP(GIANT).GT.0.OR.TOTING(EGGS))GOTO 30510 LOC=143 PROP(GIANT)=1 IF(HOLDNG.LE.1)PROP(GIANT)=3 GOTO 2000 30510 IF(PROP(GIANT).EQ.2)GOTO 30520 IF(.NOT.TOTING(EGGS))GOTO 30530 PROP(GIANT)=2 CALL MOVE(EGGS,0) CALL RSPEAK(243) 30520 LOC=143 IF(.NOT.TOTING(44))GOTO 30525 CALL RSPEAK(250) CALL MOVE(44,0) CALL MOVE(68,143) 30525 GOTO 2000 30530 LOC=145 IF(.NOT.TOTING(FOOD))GOTO 30540 CALL RSPEAK(244) CALL MOVE(FOOD,163) LOC=173 30540 DO 30550 KOB=28,MAXTRS KOBJ=KOB IF(.NOT.TOTING(KOBJ))GOTO 30550 CALL DROP(KOBJ,143) IF(KOBJ.GE.50)LOC=173 30550 CONTINUE IF(LOC.NE.173)GOTO 30560 CALL RSPEAK(245) PROP(GIANT)=0 GOTO 2000 30560 IF(OLDLOC.EQ.145)GOTO 30565 DUNG0=0 CALL RSPEAK(246) 30565 PROP(GIANT)=0 IF(OLDLC2.NE.145)GOTO 30570 CALL RSPEAK(248) GOTO 99 30570 CALL RSPEAK(247) GOTO 2000 CC 68 C IN DUNGEON, CAN HE FIND THE WELL BEFORE THE GIANT GRABS HIM. 30600 DUNG0=DUNG0+1 IF(DARK(0))GOTO 2012 IF((DUNG0.EQ.3.OR.DUNG0.EQ.5).AND.PROP(GIANT).NE.2) 1CALL RSPEAK(252) IF(DUNG0.EQ.4)CALL RSPEAK(253) IF(DUNG0.EQ.7.AND.PROP(GIANT).NE.2)GOTO 30560 GOTO 2012 CC 69 C END OF SPECIALS. C HANDLE "GO BACK". LOOK FOR VERB WHICH GOES FROM LOC TO OLDLOC, OR TO OLDLC2 C IF OLDLOC HAS FORCED-MOTION. K2 SAVES ENTRY -> FORCED LOC -> PREVIOUS LOC. 20 K=OLDLOC IF(FORCED(K))K=OLDLC2 OLDLC2=OLDLOC OLDLOC=LOC K2=0 IF(K.NE.LOC)GOTO 21 CALL RSPEAK(91) GOTO 2 21 LL=TRAVEL(KK,2) IF(LL.EQ.K)GOTO 25 IF(LL.GT.300)GOTO 22 J=KEY(LL) IF(FORCED(LL).AND.TRAVEL(J,2).EQ.K)K2=KK 22 IF(TRAVEL(KK,3).LT.0)GOTO 23 KK=KK+1 GOTO 21 23 KK=K2 IF(KK.NE.0)GOTO 25 CALL RSPEAK(140) GOTO 2 25 K=IABS(TRAVEL(KK,3)) KK=KEY(LOC) GOTO 9 CC 70 C LOOK. CAN'T GIVE MORE DETAIL. PRETEND IT WASN'T DARK (THOUGH IT MAY "NOW" C BE DARK) SO HE WON'T FALL INTO A PIT WHILE STARING INTO THE GLOOM. 30 IF(DETAIL.LT.3)CALL RSPEAK(15) DETAIL=DETAIL+1 WZDARK=.FALSE. ABB(LOC)=0 GOTO 2 CC 71 C CAVE. DIFFERENT MESSAGES DEPENDING ON WHETHER ABOVE GROUND. 40 IF(LOC.LT.8)CALL RSPEAK(57) IF(LOC.GE.8)CALL RSPEAK(58) GOTO 2 CC 72 C NON-APPLICABLE MOTION. VARIOUS MESSAGES DEPENDING ON WORD GIVEN. 50 SPK=12 IF(K.GE.43.AND.K.LE.50)SPK=9 IF(K.EQ.29.OR.K.EQ.30)SPK=9 IF(K.EQ.7.OR.K.EQ.36.OR.K.EQ.37)SPK=10 IF(K.EQ.11.OR.K.EQ.19)SPK=11 IF(VERB.EQ.FIND.OR.VERB.EQ.INVENT)SPK=59 IF(K.EQ.62.OR.K.EQ.65)SPK=42 IF(K.EQ.17)SPK=80 CALL RSPEAK(SPK) GOTO 2 CC 73 C "YOU'RE DEAD, JIM." C C IF THE CURRENT LOC IS ZERO, IT MEANS THE CLOWN GOT HIMSELF KILLED. WE'LL C ALLOW THIS MAXDIE TIMES. MAXDIE IS AUTOMATICALLY SET BASED ON THE NUMBER OF C SNIDE MESSAGES AVAILABLE. EACH DEATH RESULTS IN A MESSAGE (81, 83, ETC.) C WHICH OFFERS REINCARNATION; IF ACCEPTED, THIS RESULTS IN MESSAGE 82, 84, C ETC. THE LAST TIME, IF HE WANTS ANOTHER CHANCE, HE GETS A SNIDE REMARK AS C WE EXIT. WHEN REINCARNATED, ALL OBJECTS BEING CARRIED GET DROPPED AT OLDLC2 C (PRESUMABLY THE LAST PLACE PRIOR TO BEING KILLED) WITHOUT CHANGE OF PROPS. C THE LOOP RUNS BACKWARDS TO ASSURE THAT THE BIRD IS DROPPED BEFORE THE CAGE. C (THIS KLUGE COULD BE CHANGED ONCE WE'RE SURE ALL REFERENCES TO BIRD AND CAGE C ARE DONE BY KEYWORDS.) THE LAMP IS A SPECIAL CASE (IT WOULDN'T DO TO LEAVE C IT IN THE CAVE). IT IS TURNED OFF AND LEFT OUTSIDE THE BUILDING (ONLY IF HE C WAS CARRYING IT, OF COURSE). HE HIMSELF IS LEFT INSIDE THE BUILDING (AND C HEAVEN HELP HIM IF HE TRIES TO XYZZY BACK INTO THE CAVE WITHOUT THE LAMP!). C OLDLOC IS ZAPPED SO HE CAN'T JUST "RETREAT". C THE EASIEST WAY TO GET KILLED IS TO FALL INTO A PIT IN PITCH DARKNESS. 90 CALL RSPEAK(23) OLDLC2=LOC CC 74 C OKAY, HE'S DEAD. LET'S GET ON WITH IT. 99 IF(CLOSNG)GOTO 95 YEA=YES(NUMDIE*2+81,NUMDIE*2+82,54) NUMDIE=NUMDIE+1 IF(NUMDIE.EQ.MAXDIE.OR..NOT.YEA)GOTO 20000 PLACE(WATER)=0 PLACE(OIL)=0 IF(TOTING(LAMP))PROP(LAMP)=0 LIMIT2=0 DO 98 J=1,100 I=101-J IF(.NOT.TOTING(I))GOTO 98 K=OLDLC2 IF(LOC.GE.178.AND.LOC.LE.186.OR.LOC.EQ.176)K=180 IF(I.EQ.LAMP)K=1 CALL DROP(I,K) 98 CONTINUE LOC=3 OLDLOC=LOC GOTO 2000 CC 75 C HE DIED DURING CLOSING TIME. NO RESURRECTION. TALLY UP A DEATH AND EXIT. 95 CALL RSPEAK(131) NUMDIE=NUMDIE+1 GOTO 20000 CC 76 C ROUTINES FOR PERFORMING THE VARIOUS ACTION VERBS C STATEMENT NUMBERS IN THIS SECTION ARE 8000 FOR INTRANSITIVE VERBS, 9000 FOR C TRANSITIVE, PLUS TEN TIMES THE VERB NUMBER. MANY INTRANSITIVE VERBS USE THE C TRANSITIVE CODE, AND SOME VERBS USE CODE FOR OTHER VERBS, AS NOTED BELOW. C RANDOM INTRANSITIVE VERBS COME HERE. CLEAR OBJ JUST IN CASE (SEE "ATTACK"). 8000 WRITE(IOPDEV,8002)' WHAT DO YOU WANT TO ',WD1 8002 FORMAT(/A,10A1) OBJ=0 GOTO 2600 C SLEEP 8004 CALL RSPEAK(274) GOTO 2012 C REST 8006 CALL RSPEAK(276) GOTO 2012 C SCREAM 8008 CALL RSPEAK(278) GOTO 2012 CC 77 C CARRY, NO OBJECT GIVEN YET. OK IF ONLY ONE OBJECT PRESENT. 8010 IF(ATLOC(LOC).EQ.0)GOTO 8000 IATLOC=ATLOC(LOC) IF(LINK(IATLOC).NE.0)GOTO 8000 DO 8012 I=1,5 IF(DLOC(I).EQ.LOC.AND.DFLAG.GE.2)GOTO 8000 8012 CONTINUE OBJ=ATLOC(LOC) CC 78 C CARRY AN OBJECT. SPECIAL CASES FOR BIRD AND CAGE (IF BIRD IN CAGE, CAN'T C TAKE ONE WITHOUT THE OTHER. LIQUIDS ALSO SPECIAL, SINCE THEY DEPEND ON C STATUS OF BOTTLE. ALSO VARIOUS SIDE EFFECTS, ETC. 9010 IF(TOTING(OBJ))GOTO 2011 SPK=25 IF(OBJ.EQ.PLANT.AND.PROP(PLANT).LE.0)SPK=115 IF(OBJ.EQ.BEAR.AND.PROP(BEAR).EQ.1)SPK=169 IF(OBJ.EQ.CHAIN.AND.PROP(BEAR).NE.0)SPK=170 IF(OBJ.EQ.80)SPK=266 IF(OBJ.NE.49.OR.LOC.NE.145)GOTO 9012 CALL RSPEAK(254) DUNG0=0 LOC=165 GOTO 2000 9012 IF(FIXED(OBJ).NE.0)GOTO 2011 IF(OBJ.NE.WATER.AND.OBJ.NE.OIL)GOTO 9017 IF(HERE(BOTTLE).AND.LIQ(0).EQ.OBJ)GOTO 9018 OBJ=BOTTLE IF(TOTING(BOTTLE).AND.PROP(BOTTLE).EQ.1)GOTO 9220 IF(PROP(BOTTLE).NE.1)SPK=105 IF(.NOT.TOTING(BOTTLE))SPK=104 GOTO 2011 9018 OBJ=BOTTLE 9017 IF(HOLDNG.LT.7)GOTO 9016 CALL RSPEAK(92) GOTO 2012 9016 IF(OBJ.NE.BIRD)GOTO 9014 IF(PROP(BIRD).NE.0)GOTO 9014 IF(.NOT.TOTING(ROD))GOTO 9013 CALL RSPEAK(26) GOTO 2012 9013 IF(TOTING(CAGE))GOTO 9015 CALL RSPEAK(27) GOTO 2012 9015 PROP(BIRD)=1 9014 IF((OBJ.EQ.BIRD.OR.OBJ.EQ.CAGE).AND.PROP(BIRD).NE.0) 1CALL CARRY(BIRD+CAGE-OBJ,LOC) CALL CARRY(OBJ,LOC) K=LIQ(0) IF(OBJ.EQ.BOTTLE.AND.K.NE.0)PLACE(K)=-1 IF(OBJ.EQ.DCMNTS)PROP(DCMNTS)=1 GOTO 2009 CC 79 C DISCARD OBJECT. "THROW" ALSO COMES HERE FOR MOST OBJECTS. SPECIAL CASES FOR C BIRD (MIGHT ATTACK SNAKE OR DRAGON) AND CAGE (MIGHT CONTAIN BIRD) AND VASE. C DROP COINS AT VENDING MACHINE FOR EXTRA BATTERIES. C FOR SEWER LOC,OBJECT TO SEA VIEW 9020 IF(TOTING(ROD2).AND.OBJ.EQ.ROD.AND..NOT.TOTING(ROD))OBJ=ROD2 IF(.NOT.TOTING(OBJ))GOTO 2011 IF(OBJ.NE.BIRD.OR..NOT.HERE(SNAKE))GOTO 9024 CALL RSPEAK(30) IF(CLOSED)GOTO 19000 CALL DSTROY(SNAKE) CC 80 C SET PROP FOR USE BY TRAVEL OPTIONS PROP(SNAKE)=1 9021 K=LIQ(0) IF(K.EQ.OBJ)OBJ=BOTTLE IF(OBJ.EQ.BOTTLE.AND.K.NE.0)PLACE(K)=0 IF(OBJ.EQ.CAGE.AND.PROP(BIRD).NE.0)CALL DROP(BIRD,LOC) IF(OBJ.EQ.BIRD)PROP(BIRD)=0 CALL DROP(OBJ,LOC) IF(LOC.EQ.195)CALL MOVE(OBJ,163) IF(LOC.EQ.154)GOTO 9022 IF(.NOT.AT(WEB))GOTO 2012 IF(HERE(SPIDER))CALL JUGGLE(SPIDER) CALL JUGGLE(WEB) GO TO 2012 9022 LOC=41+RAN(3)+RAN(2)*28 IF (OBJ.EQ.CAGE.AND.PROP(BIRD).NE.0) CALL MOVE(BIRD,LOC) CALL MOVE(OBJ,LOC) CALL RSPEAK(263) NEWLOC=LOC IF(PLACE(ORB).NE.154)PROP(80)=1 I=ATLOC(198) 9023 IF(I.EQ.80)GOTO 2000 CALL MOVE(I,163) I=LINK(I) GOTO 9023 9024 IF(OBJ.NE.COINS.OR..NOT.HERE(VEND))GOTO 9025 CALL DSTROY(COINS) CALL DROP(BATTER,LOC) CALL PSPEAK(BATTER,0) GOTO 2012 9025 IF(OBJ.NE.BIRD.OR.(.NOT.AT(DRAGON).AND..NOT.AT(SPIDER)))GOTO 9026 IF(AT(DRAGON).AND.PROP(DRAGON).NE.0)GOTO 9026 SPK=154 IF(AT(SPIDER))SPK=213 CALL RSPEAK(SPK) CALL DSTROY(BIRD) PROP(BIRD)=0 IF(PLACE(SNAKE).EQ.PLAC(SNAKE))TALLY2=TALLY2+1 GOTO 2012 9026 IF(OBJ.NE.BEAR.OR..NOT.AT(TROLL))GOTO 9027 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 9021 9027 IF(OBJ.NE.VASE.OR.LOC.EQ.PLAC(PILLOW))GOTO 9028 PROP(VASE)=2 IF(AT(PILLOW))PROP(VASE)=0 CALL PSPEAK(VASE,PROP(VASE)+1) IF(PROP(VASE).NE.0)FIXED(VASE)=-1 GOTO 9021 9028 IF(LOC.LT.176.OR.LOC.GT.186)GOTO 9029 IF(LOC.EQ.180.OR.LOC.EQ.177)GOTO 9029 IF(OBJ.NE.FOOD)CALL DROP(OBJ,180) SPK=223 IF(OBJ.NE.FOOD)GOTO 9031 CALL DROP(OBJ,163) IF(LOC.NE.182)GOTO 9031 PROP(47)=0 SPK=240 9031 IF(LOC.LT.180)SPK=230 CALL RSPEAK(SPK) GOTO 2012 9029 CALL RSPEAK(54) IF(OBJ.EQ.TUSK.AND.LOC.EQ.3)CALL RSPEAK(238) IF(OBJ.NE.SPOON)GOTO 9021 IF(INSC1.EQ.0)CALL RSPEAK(224) GO TO 9021 CC 81 C SAY. ECHO WD2 (OR WD1 IF NO WD2 (SAY WHAT?, ETC.).) CIMAG WORDS OVERRIDE. 9030 IF(WD2X.EQ.0)GOTO 9034 DO 9033 IW=1,10 WD1(IW)=WD2(IW) 9033 CONTINUE 9034 WD1X=WD2X I=VOCAB(WD1,-1) IF(I.EQ.62.OR.I.EQ.65.OR.I.EQ.71.OR.I.EQ.2025.OR.I.EQ.2032) 1 GOTO 9035 WRITE(IOPDEV,*) C WRITE(IOPDEV,9032)' OKAY, "',WD1,'".' C WRITE(IOPDEV,9032)WD1 C 9032 FORMAT(/8H OKAY, ",10A1,3H ". ) DO 90345 IW=1,10 K=11-IW IF(WD1(K).NE.IBL)GOTO 90346 90345 CONTINUE 90346 WRITE(IOPDEV,9032)'OKAY, "',(WD1(I),I=1,K),'".' 9032 FORMAT(A8,12A1) GOTO 2012 9035 DO 9036 IW=1,10 9036 WD2(IW)=IBL WD2X=0 OBJ=0 GOTO 2630 CC 82 C LOCK, UNLOCK, NO OBJECT GIVEN. ASSUME VARIOUS THINGS IF PRESENT. 8040 SPK=28 IF(HERE(CLAM))OBJ=CLAM IF(HERE(OYSTER))OBJ=OYSTER IF(AT(DOOR))OBJ=DOOR IF(AT(GRATE))OBJ=GRATE IF(OBJ.NE.0.AND.HERE(CHAIN))GOTO 8000 IF(HERE(CHAIN))OBJ=CHAIN IF(OBJ.EQ.0)GOTO 2011 CC 83 C LOCK, UNLOCK OBJECT. SPECIAL STUFF FOR OPENING CLAM/OYSTER AND FOR CHAIN. 9040 IF(OBJ.EQ.CLAM.OR.OBJ.EQ.OYSTER)GOTO 9046 IF(OBJ.EQ.DOOR)SPK=111 IF(OBJ.EQ.DOOR.AND.PROP(DOOR).EQ.1)SPK=54 IF(OBJ.EQ.CAGE)SPK=32 IF(OBJ.EQ.KEYS)SPK=55 IF(OBJ.EQ.GRATE.OR.OBJ.EQ.CHAIN)SPK=31 IF(SPK.NE.31.OR..NOT.HERE(KEYS))GOTO 2011 IF(OBJ.EQ.CHAIN)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.EQ.LOCK)PROP(GRATE)=0 K=K+2*PROP(GRATE) GOTO 2010 CC 84 C CLAM/OYSTER. 9046 K=0 IF(OBJ.EQ.OYSTER)K=1 SPK=124+K IF(TOTING(OBJ))SPK=120+K IF(.NOT.TOTING(TRIDNT))SPK=122+K IF(VERB.EQ.LOCK)SPK=61 IF(SPK.NE.124)GOTO 2011 CALL DSTROY(CLAM) CALL DROP(OYSTER,LOC) CALL DROP(PEARL,105) GOTO 2011 CC 85 C CHAIN. 9048 IF(VERB.EQ.LOCK)GOTO 9049 SPK=171 IF(PROP(BEAR).EQ.0)SPK=41 IF(PROP(CHAIN).EQ.0)SPK=37 IF(SPK.NE.171)GOTO 2011 PROP(CHAIN)=0 FIXED(CHAIN)=0 IF(PROP(BEAR).NE.3)PROP(BEAR)=2 FIXED(BEAR)=2-PROP(BEAR) GOTO 2011 9049 SPK=172 IF(PROP(CHAIN).NE.0)SPK=34 IF(LOC.NE.PLAC(CHAIN))SPK=173 IF(SPK.NE.172)GOTO 2011 PROP(CHAIN)=2 IF(TOTING(CHAIN))CALL DROP(CHAIN,LOC) FIXED(CHAIN)=-1 GOTO 2011 CC 86 C LIGHT LAMP 9070 IF(.NOT.HERE(LAMP))GOTO 2011 SPK=184 IF(LIMIT.LT.0)GOTO 2011 PROP(LAMP)=1 CALL RSPEAK(39) IF(WZDARK)GOTO 76 GOTO 2012 CC 87 C LAMP OFF 9080 IF(.NOT.HERE(LAMP))GOTO 2011 PROP(LAMP)=0 CALL RSPEAK(40) IF(DARK(0))CALL RSPEAK(16) GOTO 2012 CC 88 C WAVE. NO EFFECT UNLESS WAVING ROD AT FISSURE. 9090 IF((.NOT.TOTING(OBJ)).AND.(OBJ.NE.ROD.OR..NOT.TOTING(ROD2))) 1SPK=29 IF(OBJ.NE.ROD.OR..NOT.AT(FISSUR).OR..NOT.TOTING(OBJ) 1.OR.CLOSNG)GOTO 2011 PROP(FISSUR)=1-PROP(FISSUR) CALL PSPEAK(FISSUR,2-PROP(FISSUR)) GOTO 2012 CC 89 C ATTACK. ASSUME TARGET IF UNAMBIGUOUS. "THROW" ALSO LINKS HERE. ATTACKABLE C OBJECTS FALL INTO TWO CATEGORIES: ENEMIES (SNAKE, DWARF, ETC.) AND OTHERS C (BIRD, CLAM). AMBIGUOUS IF TWO ENEMIES, OR IF NO ENEMIES BUT TWO OTHERS. 9120 DO 9121 I=1,5 IF(DLOC(I).EQ.LOC.AND.DFLAG.GE.2)GOTO 9122 9121 CONTINUE I=0 9122 IF(OBJ.NE.0)GOTO 9124 IF(I.NE.0)OBJ=DWARF IF(HERE(SNAKE))OBJ=OBJ*100+SNAKE IF(AT(DRAGON).AND.PROP(DRAGON).EQ.0)OBJ=OBJ*100+DRAGON IF(AT(TROLL))OBJ=OBJ*100+TROLL IF(HERE(BEAR).AND.PROP(BEAR).EQ.0)OBJ=OBJ*100+BEAR IF(HERE(SPIDER))OBJ=OBJ*100+SPIDER IF(OBJ.GT.100)GOTO 8000 IF(OBJ.NE.0)GOTO 9124 CC 90 C CAN'T ATTACK BIRD BY THROWING AXE. IF(HERE(BIRD).AND.VERB.NE.THROW)OBJ=BIRD CC 91 C CLAM AND OYSTER BOTH TREATED AS CLAM FOR INTRANSITIVE CASE; NO HARM DONE. IF(HERE(CLAM).OR.HERE(OYSTER))OBJ=100*OBJ+CLAM IF(OBJ.GT.100)GOTO 8000 9124 IF(OBJ.NE.BIRD)GOTO 9125 SPK=137 IF(CLOSED)GOTO 2011 CALL DSTROY(BIRD) PROP(BIRD)=0 IF(PLACE(SNAKE).EQ.PLAC(SNAKE))TALLY2=TALLY2+1 SPK=45 9125 IF(OBJ.EQ.0)SPK=44 IF(OBJ.EQ.CLAM.OR.OBJ.EQ.OYSTER)SPK=150 IF(OBJ.EQ.SNAKE)SPK=46 IF(OBJ.EQ.DWARF)SPK=49 IF(OBJ.EQ.DWARF.AND.CLOSED)GOTO 19000 IF(OBJ.EQ.DRAGON)SPK=167 IF(OBJ.EQ.TROLL)SPK=157 IF(OBJ.EQ.SPIDER)SPK=211 IF(OBJ.EQ.BEAR)SPK=165+(PROP(BEAR)+1)/2 IF(OBJ.NE.DRAGON.OR.PROP(DRAGON).NE.0)GOTO 2011 CC 92 C FUN STUFF FOR DRAGON. IF HE INSISTS ON ATTACKING IT, WIN! SET PROP TO DEAD, C MOVE DRAGON TO CENTRAL LOC (STILL FIXED), MOVE RUG THERE (NOT FIXED), AND C 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(1).NE.ICHAR('Y'))GOTO 2608 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 9126 OBJ=1,100 IDONDX=OBJ IF(PLACE(IDONDX).EQ.PLAC(DRAGON).OR. 1 PLACE(IDONDX).EQ.FIXD(DRAGON)) 2 CALL MOVE(IDONDX,K) 9126 CONTINUE LOC=K K=NULL GOTO 8 CC 93 C POUR. IF NO OBJECT, OR OBJECT IS BOTTLE, ASSUME CONTENTS OF BOTTLE. C SPECIAL TESTS FOR POURING WATER OR OIL ON PLANT OR RUSTY DOOR. 9130 IF(OBJ.EQ.BOTTLE.OR.OBJ.EQ.0)OBJ=LIQ(0) IF(OBJ.EQ.0)GOTO 8000 IF(.NOT.TOTING(OBJ))GOTO 2011 SPK=78 IF(OBJ.NE.OIL.AND.OBJ.NE.WATER)GOTO 2011 PROP(BOTTLE)=1 PLACE(OBJ)=0 SPK=77 IF(.NOT.(AT(PLANT).OR.AT(DOOR)))GOTO 2011 IF(AT(DOOR))GOTO 9132 SPK=112 IF(OBJ.NE.WATER)GOTO 2011 CALL PSPEAK(PLANT,PROP(PLANT)+1) PROP(PLANT)=MOD(PROP(PLANT)+2,6) PROP(PLANT2)=PROP(PLANT)/2 K=NULL GOTO 8 9132 PROP(DOOR)=0 IF(OBJ.EQ.OIL)PROP(DOOR)=1 SPK=113+PROP(DOOR) GOTO 2011 CC 94 C EAT. INTRANSITIVE: ASSUME FOOD IF PRESENT, ELSE ASK WHAT. TRANSITIVE: FOOD C OK, SOME THINGS LOSE APPETITE, REST ARE RIDICULOUS. 8140 IF(.NOT.HERE(FOOD))GOTO 8000 8142 CALL MOVE(FOOD,163) SPK=72 GOTO 2011 9140 IF(OBJ.EQ.FOOD)GOTO 8142 IF(OBJ.EQ.BIRD.OR.OBJ.EQ.SNAKE.OR.OBJ.EQ.CLAM.OR.OBJ.EQ.OYSTER 1.OR.OBJ.EQ.DWARF.OR.OBJ.EQ.DRAGON.OR.OBJ.EQ.TROLL 2.OR.OBJ.EQ.BEAR.OR.OBJ.EQ.SPIDER)SPK=71 GOTO 2011 CC 95 C DRINK. IF NO OBJECT, ASSUME WATER AND LOOK FOR IT HERE. IF WATER IS IN C THE BOTTLE, DRINK THAT, ELSE MUST BE AT A WATER LOC, SO DRINK STREAM. 9150 IF(OBJ.EQ.0.AND.LIQLOC(LOC).NE.WATER.AND.(LIQ(0).NE.WATER 1.OR..NOT.HERE(BOTTLE)))GOTO 8000 IF(OBJ.NE.0.AND.OBJ.NE.WATER)SPK=110 IF(SPK.EQ.110)GOTO 2011 IF(LIQLOC(LOC).EQ.WATER)LIMIT2=0 IF(TOTING(CHALIC).AND.(LOC.EQ.38.OR.LOC.EQ.113))GOTO 9155 IF(LIQ(0).NE.WATER.OR..NOT.HERE(BOTTLE))GOTO 2011 PROP(BOTTLE)=1 PLACE(WATER)=0 IF(LIMIT2.GE.800)CALL RSPEAK(72) LIMIT2=0 SPK=74 GOTO 2011 9155 YEA=YES(255,258,256) IF(.NOT.YEA)CALL MOVE(CHALIC,0) IF(.NOT.YEA)GOTO 2000 CALL DROP(CHALIC,LOC) PROP(CHALIC)=1 FIXED(CHALIC)=-1 GOTO 2000 CC 96 C RUB. YIELDS VARIOUS SNIDE REMARKS. 9160 IF(OBJ.NE.LAMP)SPK=76 IF(HERE(SPOON).AND.OBJ.EQ.SPOON.AND.INSC1.EQ.0)SPK=224 GOTO 2011 CC 97 C THROW. SAME AS DISCARD UNLESS AXE. THEN SAME AS ATTACK EXCEPT IGNORE BIRD, C AND IF DWARF IS PRESENT THEN ONE MIGHT BE KILLED (IF NOT DARK). C AXE ALSO SPECIAL FOR DRAGON, BEAR, AND TROLL. TREASURES SPECIAL FOR TROLL. 9170 IF(TOTING(ROD2).AND.OBJ.EQ.ROD.AND..NOT.TOTING(ROD))OBJ=ROD2 IF(.NOT.TOTING(OBJ))GOTO 2011 IF(DARK(0))GOTO 9020 IF(OBJ.GE.50.AND.OBJ.LE.MAXTRS.AND.AT(TROLL))GOTO 9178 IF(OBJ.EQ.FOOD.AND.HERE(BEAR))GOTO 9177 IF(LOC.EQ.198)GOTO 9173 IF(OBJ.NE.AXE)GOTO 9020 DO 9171 I=1,5 CC 98 C NEEDN'T CHECK DFLAG IF AXE IS HERE. IF(DLOC(I).EQ.LOC)GOTO 9172 9171 CONTINUE SPK=152 IF(AT(DRAGON).AND.PROP(DRAGON).EQ.0)GOTO 9175 SPK=158 IF(AT(TROLL))GOTO 9175 IF(HERE(BEAR).AND.PROP(BEAR).EQ.0)GOTO 9176 IF(HERE(GIANT))GOTO 9179 OBJ=0 GOTO 9120 9173 IF(OBJ.EQ.VASE.OR.OBJ.EQ.CAGE.OR.OBJ.EQ.TUSK.OR.OBJ.EQ. 1NUGGET.OR.OBJ.EQ.CHALIC.OR.OBJ.EQ.BIRD)GOTO 9020 IF(OBJ.EQ.BOTTLE.OR.OBJ.EQ.OIL.OR.OBJ.EQ.WATER)GOTO 9020 SPK=264 CALL DROP(OBJ,180) IF(OBJ.EQ.FOOD)CALL MOVE(FOOD,163) THROWC=THROWC+RAN(3)+1 IF(THROWC.LT.4.OR.PROP(80).NE.0)GO TO 2011 CALL MOVE(ORB,180) PROP(80)=1 SPK=265 GOTO 2011 9172 SPK=48 CC 99 C IF SAVED NOT = -1, HE BYPASSED THE "START" CALL. IF(RAN(3).EQ.0)GOTO 9175 DSEEN(I)=.FALSE. DLOC(I)=0 SPK=47 DKILL=DKILL+1 IF(DKILL.EQ.1)SPK=149 9175 CALL RSPEAK(SPK) CALL DROP(AXE,LOC) K=NULL GOTO 8 CC100 C THIS'LL TEACH HIM TO THROW THE AXE AT THE BEAR! 9176 SPK=164 CALL DROP(AXE,LOC) FIXED(AXE)=-1 PROP(AXE)=1 CALL JUGGLE(BEAR) GOTO 2011 CC101 C BUT THROWING FOOD IS ANOTHER STORY. 9177 OBJ=BEAR GOTO 9210 9178 SPK=159 CC102 C 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 2011 CC103 C THE GIANT DOES NOT LIKE IT. 9179 CALL DROP(AXE,LOC) CALL RSPEAK(249) GOTO 99 CC104 C QUIT. INTRANSITIVE ONLY. VERIFY INTENT AND EXIT IF THAT'S WHAT HE WANTS. 8180 GAVEUP=YES(22,54,54) 8185 IF(GAVEUP)GOTO 20000 GOTO 2012 CC105 C FIND. MIGHT BE CARRYING IT, OR IT MIGHT BE HERE. ELSE GIVE CAVEAT. 9190 IF(AT(OBJ).OR.(LIQ(0).EQ.OBJ.AND.AT(BOTTLE)) 1.OR.K.EQ.LIQLOC(LOC))SPK=94 DO 9192 I=1,5 9192 IF(DLOC(I).EQ.LOC.AND.DFLAG.GE.2.AND.OBJ.EQ.DWARF)SPK=94 IF(CLOSED)SPK=138 IF(TOTING(OBJ))SPK=24 GOTO 2011 CC106 C INVENTORY. IF OBJECT, TREAT SAME AS FIND. ELSE REPORT ON CURRENT BURDEN. 8200 SPK=98 DO 8201 I=1,100 IDONDX=I IF(IDONDX.EQ.BEAR.OR..NOT.TOTING(IDONDX))GOTO 8201 IF(SPK.EQ.98)CALL RSPEAK(99) BLKLIN=.FALSE. CALL PSPEAK(IDONDX,-1) BLKLIN=.TRUE. SPK=0 8201 CONTINUE IF(TOTING(BEAR))SPK=141 GOTO 2011 CC107 C FEED. IF BIRD, NO SEED. SNAKE, DRAGON, TROLL, SPIDER: QUIP. IF DWARF, MAKE C MAD. BEAR, SPECIAL. IF RATS, DELAYS THEM EATING YOU. 9210 IF(OBJ.NE.BIRD)GOTO 9212 SPK=100 GOTO 2011 9212 IF(OBJ.NE.SNAKE.AND.OBJ.NE.DRAGON.AND.OBJ.NE.TROLL 1.AND.OBJ.NE.SPIDER)GOTO 9213 SPK=102 IF(OBJ.EQ.DRAGON.AND.PROP(DRAGON).NE.0)SPK=110 IF(OBJ.EQ.TROLL)SPK=182 IF((OBJ.NE.SNAKE.AND.OBJ.NE.SPIDER).OR.CLOSED 1.OR..NOT.HERE(BIRD))GOTO 2011 SPK=101 IF(OBJ.EQ.SPIDER)SPK=212 CALL DSTROY(BIRD) PROP(BIRD)=0 IF(PROP(SNAKE).EQ.0)TALLY2=TALLY2+1 GOTO 2011 9213 IF(OBJ.NE.DWARF)GOTO 9214 IF(.NOT.HERE(FOOD))GOTO 2011 SPK=103 DFLAG=DFLAG+1 GOTO 2011 9214 IF(OBJ.NE.BEAR)GOTO 9215 IF(PROP(BEAR).EQ.0)SPK=102 IF(PROP(BEAR).EQ.3)SPK=110 IF(.NOT.HERE(FOOD))GOTO 2011 CALL DSTROY(FOOD) PROP(BEAR)=1 FIXED(AXE)=0 PROP(AXE)=0 SPK=168 GOTO 2011 9215 IF(OBJ.NE.RAT.AND.OBJ*PROP(CHALIC).NE.CHALIC)GOTO 9216 IF(.NOT.HERE(FOOD))GOTO 2011 CALL MOVE(FOOD,163) PROP(47)=0 SPK=240 IF(OBJ.EQ.CHALIC)SPK=267 GOTO 2011 9216 SPK=14 GOTO 2011 CC108 C FILL. BOTTLE MUST BE EMPTY, AND SOME LIQUID AVAILABLE. (VASE IS NASTY.) 9220 IF(OBJ.EQ.VASE)GOTO 9222 IF(OBJ.EQ.CHALIC)SPK=227 IF(OBJ.NE.0.AND.OBJ.NE.BOTTLE)GOTO 2011 IF(OBJ.EQ.0.AND..NOT.HERE(BOTTLE))GOTO 8000 SPK=107 IF(LIQLOC(LOC).EQ.0)SPK=106 IF(LIQ(0).NE.0)SPK=105 IF(SPK.NE.107)GOTO 2011 PROP(BOTTLE)=MOD(COND(LOC),4)/2*2 K=LIQ(0) IF(TOTING(BOTTLE))PLACE(K)=-1 IF(K.EQ.OIL)SPK=108 GOTO 2011 9222 SPK=29 IF(LIQLOC(LOC).EQ.0)SPK=144 IF(LIQLOC(LOC).EQ.0.OR..NOT.TOTING(VASE))GOTO 2011 CALL RSPEAK(145) PROP(VASE)=2 FIXED(VASE)=-1 GOTO 9024 CC109 C BLAST. NO EFFECT UNLESS YOU'VE GOT DYNAMITE, WHICH IS A NEAT TRICK! 9230 IF(PROP(ROD2).LT.0.OR..NOT.CLOSED)GOTO 2011 BONUS=133 IF(LOC.EQ.115)BONUS=134 IF(HERE(ROD2))BONUS=135 CALL RSPEAK(BONUS) GOTO 20000 CC110 C SCORE. GO TO SCORING SECTION, WHICH WILL RETURN TO 8241 IF SCORNG IS TRUE. 8240 SCORNG=.TRUE. GOTO 20000 8241 SCORNG=.FALSE. WRITE(IOPDEV,*) WRITE(IOPDEV,*)'IF YOU WERE TO QUIT NOW, YOU WOULD SCORE ', 1 SCORE,' OUT OF A POSSIBLE ',MXSCOR,'.' C* 8243 FORMAT(/41H IF YOU WERE TO QUIT NOW, YOU WOULD SCORE,I4 C* 1,18H OUT OF A POSSIBLE,I4,2H .) GAVEUP=YES(143,54,54) GOTO 8185 CC111 C FEE FIE FOE FOO (AND FUM). ADVANCE TO NEXT STATE IF GIVEN IN PROPER ORDER. C LOOK UP WD1 IN SECTION 3 OF VOCAB TO DETERMINE WHICH WORD WE'VE GOT. LAST C WORD ZIPS THE EGGS BACK TO THE GIANT ROOM (UNLESS ALREADY THERE). 8250 K=VOCAB(WD1,3) SPK=42 IF(FOOBAR.EQ.1-K)GOTO 8252 IF(FOOBAR.NE.0)SPK=151 GOTO 2011 8252 FOOBAR=K IF(K.NE.4)GOTO 2009 FOOBAR=0 IF(PLACE(EGGS).EQ.PLAC(EGGS) 1.OR.(TOTING(EGGS).AND.LOC.EQ.PLAC(EGGS)))GOTO 2011 CC112 C BRING BACK TROLL IF WE STEAL THE EGGS BACK FROM HIM BEFORE CROSSING. IF(PLACE(EGGS).EQ.0.AND.PLACE(TROLL).EQ.0.AND.PROP(TROLL).EQ.0) 1PROP(TROLL)=1 K=2 IF(HERE(EGGS))K=1 IF(LOC.EQ.PLAC(EGGS))K=0 CALL MOVE(EGGS,PLAC(EGGS)) CALL PSPEAK(EGGS,K) GOTO 2012 CC113 C BRIEF. INTRANSITIVE ONLY. SUPPRESS LONG DESCRIPTIONS AFTER FIRST TIME. 8260 SPK=156 ABBNUM=10000 DETAIL=3 GOTO 2011 CC114 C READ. MAGAZINES IN DWARVISH,SPOON=EPNS, MESSAGE WE'VE SEEN, AND OYSTER? 8270 IF(HERE(MAGZIN))OBJ=MAGZIN IF(HERE(TABLET))OBJ=OBJ*100+TABLET IF(HERE(MESSAG))OBJ=OBJ*100+MESSAG IF(HERE(DCMNTS))OBJ=DCMNTS IF(CLOSED.AND.TOTING(OYSTER))OBJ=OYSTER IF(OBJ.GT.100.OR.OBJ.EQ.0.OR.DARK(0))GOTO 8000 9270 IF(DARK(0))GOTO 5190 IF(OBJ.EQ.MAGZIN)SPK=190 IF(OBJ.EQ.TABLET)SPK=196 IF(OBJ.EQ.MESSAG)SPK=191 IF(OBJ.EQ.SPOON)SPK=225 IF(OBJ.EQ.SPOON)INSC1=1 IF(OBJ.EQ.DCMNTS)SPK=251 IF(OBJ.EQ.OYSTER.AND.HINTED(2).AND.TOTING(OYSTER))SPK=194 IF(OBJ.NE.OYSTER.OR.HINTED(2).OR..NOT.TOTING(OYSTER) 1.OR..NOT.CLOSED)GOTO 2011 HINTED(2)=YES(192,193,54) GOTO 2012 CC115 C BREAK. ONLY WORKS FOR MIRROR IN REPOSITORY AND, OF COURSE, THE VASE. 9280 IF(OBJ.EQ.MIRROR)SPK=148 IF(OBJ.EQ.VASE.AND.PROP(VASE).EQ.0)GOTO 9282 IF(OBJ.NE.MIRROR.OR..NOT.CLOSED)GOTO 2011 CALL RSPEAK(197) GOTO 19000 9282 SPK=198 IF(TOTING(VASE))CALL DROP(VASE,LOC) PROP(VASE)=2 FIXED(VASE)=-1 GOTO 2011 CC116 C WAKE. ONLY USE IS TO DISTURB THE DWARVES. 9290 IF(OBJ.NE.DWARF.OR..NOT.CLOSED)GOTO 2011 CALL RSPEAK(199) GOTO 19000 CC117 C SUSPEND. OFFER TO EXIT LEAVING THINGS RESTARTABLE, BUT REQUIRING A DELAY C BEFORE RESTARTING (SO CAN'T SAVE THE WORLD BEFORE TRYING SOMETHING RISKY). C UPON RESTARTING, SETUP=-1 CAUSES RETURN TO 8305 TO PICK UP AGAIN. 8300 WRITE(IOPDEV,8302) 8302 FORMAT(' I CAN DUMP THIS ADVENTURE SO YOU CAN RESUME LATER.') IF(.NOT.YES(200,54,54))GOTO 2012 SETUP=-1 OPEN(UNIT=OPDUMP,FILE='advII.sav',ERR=83045) WRITE(OPDUMP,8303)COND,ATLOC,PLACE,FIXED,LINK,PROP, 1DLOC,ODLOC,DOBJ,ORC,TALLY,TURNS,IWEST,LIMIT2,KNFLOC,DETAIL,NUMDIE, 2HOLDNG,DKILL,FOOBAR,BONUS,CLOCK1,CLOCK2,TIDE,INSC1,DUNG0,THROWC, 3LOC,OLDLOC,OLDLC2,DFLAG,ORCT,ORCT1,LIMIT,TALLY2 8303 FORMAT(18I4) WRITE(OPDUMP,8304)DSEEN,LMWARN,CLOSNG,PANIC,CLOSED,GAVEUP,SCORNG, 1HINTED,WIZENT 8304 FORMAT(60L1) CLOSE(UNIT=OPDUMP) CALL MOVE(LAMP,0) GOTO 20000 83045 WRITE(IOPDEV,83046) 83046 FORMAT(' SORRY, CANNOT OPEN FILE advII.sav!') GOTO 20000 8305 YEA=.FALSE. SETUP=3 K=NULL OPEN(UNIT=IPDUMP,FILE='advII.sav',ERR=83065) WRITE(IOPDEV,8306) 8306 FORMAT(' INPUT OF DUMPED VALUES.') READ(IPDUMP,8303)COND,ATLOC,PLACE,FIXED,LINK,PROP, 1DLOC,ODLOC,DOBJ,ORC,TALLY,TURNS,IWEST,LIMIT2,KNFLOC,DETAIL,NUMDIE, 2HOLDNG,DKILL,FOOBAR,BONUS,CLOCK1,CLOCK2,TIDE,INSC1,DUNG0,THROWC, 3LOC,OLDLOC,OLDLC2,DFLAG,ORCT,ORCT1,LIMIT,TALLY2 READ(IPDUMP,8304)DSEEN,LMWARN,CLOSNG,PANIC,CLOSED,GAVEUP,SCORNG, 1HINTED,WIZENT CLOSE(UNIT=IPDUMP) GOTO 8 83065 WRITE(IOPDEV,83046) CC118 C HOURS. REPORT CURRENT NON-PRIME-TIME HOURS. 8310 WRITE(IOPDEV,8311) 8311 FORMAT(' THE CAVE IS OPEN AT ALL HOURS.') GOTO 2012 CC119 C HOOT. VARIOUS OWL EFFECTS DEPENDING ON LIGHT AND SPIDER (OR OTHER OCCUPANT) C THE OWL EATS DWALVES! C 8320 IF(CLOSED)GO TO 8324 SPK=42 IF((LOC.GE.176.AND.LOC.LE.187).OR.LOC.EQ.145.OR.(LOC.GE.154 1.AND.LOC.LE.166))GOTO 2011 IF(IABS(LOC-PLACE(OWL))/25.GT.RAN(5))GOTO 8321 IF(DARK(0))GOTO 8322 IF(MOD(COND(LOC),2).NE.0)GOTO 8321 SPK=202 GOTO 7402 8321 SPK=203 GOTO 7404 8322 IF(HERE(SPIDER))GOTO 8323 SPK=203 IF((AT(DRAGON).AND.PROP(DRAGON).EQ.0).OR.HERE(SNAKE).OR. 1HERE(BEAR).OR.(AT(TROLL).AND.PROP(TROLL).LT.2) 2.OR.LOC.EQ.114)GOTO 7402 SPK=204 IF(HERE(OWL))SPK=207 CALL MOVE(OWL,LOC) 8326 DO 8325 I=1,5 IF(DLOC(I).NE.LOC)GOTO 8325 SPK=205 DLOC(I)=0 ODLOC(I)=0 8325 CONTINUE GOTO 7404 8323 SPK=205 CALL DSTROY(SPIDER) CALL MOVE(DCMNTS,LOC) CALL MOVE(OWL,LOC) CALL JUGGLE(WEB) GOTO 8326 8324 CALL RSPEAK(210) GO TO 19000 CC120 C BLOW. ONLY USE TO BLOW HORN. 9330 IF(OBJ.EQ.HORN)GOTO 9331 SPK=110 GOTO 2011 9331 IF(LOC.GE.15)GOTO 9333 SPK=237 GOTO 2011 9333 CALL RSPEAK(232) IF(BITSET(LOC,3))GOTO 2012 IF(HERE(OWL).OR.FORCED(LOC))GOTO 2012 SPK=236 C IM=3+RAN(3) DO 9332 I=1,5 IF(DLOC(I).GT.0.OR.I.EQ.1)DLOC(I)=LOC IF(DLOC(I).GT.0.OR.I.EQ.1)ODLOC(I)=LOC 9332 CONTINUE GOTO7404 CC121 C FLY. FOR WIZARD TRANSPORT 8340 SPK=234 IF(.NOT.WIZENT)GOTO 2011 CALL RSPEAK(235) READ(*,8342)NEWLOC 8342 FORMAT(I3) GOTO 2 CC122 C HINTS C COME HERE IF HE'S BEEN LONG ENOUGH AT REQUIRED LOC(S) FOR SOME UNUSED HINT. C HINT NUMBER IS IN VARIABLE "HINT". BRANCH TO QUICK TEST FOR ADDITIONAL C CONDITIONS, THEN COME BACK TO DO NEAT STUFF. GOTO 40010 IF CONDITIONS ARE C MET AND WE WANT TO OFFER THE HINT. GOTO 40020 TO CLEAR HINTLC BACK TO ZERO, C 40030 TO TAKE NO ACTION YET. 40000 IHINT=HINT-3 GOTO (40400,40500,40600,40700,40800,40900),IHINT CC123 C CAVE BIRD SNAKE MAZE DARK WITT 40010 HINTLC(HINT)=0 IF(.NOT.YES(HINTS(HINT,3),0,54))GOTO 2603 WRITE(IOPDEV,*) WRITE(IOPDEV,*) 1' I AM PREPARED TO GIVE YOU A HINT, BUT IT WILL COST YOU ', 2 HINTS(HINT,2),' POINTS.' C* 40012 FORMAT(/55H I AM PREPARED TO GIVE YOU A HINT, BUT IT WILL COST YOU C* 1 ,I2,9H POINTS.) HINTED(HINT)=YES(175,HINTS(HINT,4),54) IF(HINTED(HINT).AND.LIMIT.GT.30)LIMIT=LIMIT+30*HINTS(HINT,2) 40020 HINTLC(HINT)=0 40030 GOTO 2603 CC124 C NOW FOR THE QUICK TESTS. SEE DATABASE DESCRIPTION FOR ONE-LINE NOTES. 40400 IF(PROP(GRATE).EQ.0.AND..NOT.HERE(KEYS))GOTO 40010 GOTO 40020 40500 IF(HERE(BIRD).AND.TOTING(ROD).AND.OBJ.EQ.BIRD)GOTO 40010 GOTO 40030 40600 IF(HERE(SNAKE).AND..NOT.HERE(BIRD))GOTO 40010 GOTO 40020 40700 IF(ATLOC(LOC).EQ.0.AND.ATLOC(OLDLOC).EQ.0 1.AND.ATLOC(OLDLC2).EQ.0.AND.HOLDNG.GT.1)GOTO 40010 GOTO 40020 40800 IF(PROP(EMRALD).NE.-1.AND.PROP(PYRAM).EQ.-1)GOTO 40010 GOTO 40020 40900 GOTO 40010 CC125 C CAVE CLOSING AND SCORING 9350 IF(OBJ.NE.CHALIC.OR.PROP(CHALIC).NE.1)GOTO 9352 CALL RSPEAK(257) GOTO 20000 9352 SPK=110 GOTO 2011 CC126 C THESE SECTIONS HANDLE THE CLOSING OF THE CAVE. THE CAVE CLOSES "CLOCK1" C TURNS AFTER THE LAST TREASURE HAS BEEN LOCATED (INCLUDING THE PIRATE'S C CHEST, WHICH MAY OF COURSE NEVER SHOW UP). NOTE THAT THE TREASURES NEED NOT C HAVE BEEN TAKEN YET, JUST LOCATED. HENCE CLOCK1 MUST BE LARGE ENOUGH TO GET C OUT OF THE CAVE (IT ONLY TICKS WHILE INSIDE THE CAVE). WHEN IT HITS ZERO, C WE BRANCH TO 10000 TO START CLOSING THE CAVE, AND THEN SIT BACK AND WAIT FOR C HIM TO TRY TO GET OUT. IF HE DOESN'T WITHIN CLOCK2 TURNS, WE CLOSE THE C CAVE; IF HE DOES TRY, WE ASSUME HE PANICS, AND GIVE HIM A FEW ADDITIONAL C TURNS TO GET FRANTIC BEFORE WE CLOSE. WHEN CLOCK2 HITS ZERO, WE BRANCH TO C 11000 TO TRANSPORT HIM INTO THE FINAL PUZZLE. NOTE THAT THE PUZZLE DEPENDS C UPON ALL SORTS OF RANDOM THINGS. FOR INSTANCE, THERE MUST BE NO WATER OR C OIL, SINCE THERE ARE BEANSTALKS WHICH WE DON'T WANT TO BE ABLE TO WATER, C SINCE THE CODE CAN'T HANDLE IT. ALSO, WE CAN HAVE NO KEYS, SINCE THERE IS A C GRATE (HAVING MOVED THE FIXED OBJECT!) THERE SEPARATING HIM FROM ALL THE C TREASURES. MOST OF THESE PROBLEMS ARISE FROM THE USE OF NEGATIVE PROP C NUMBERS TO SUPPRESS THE OBJECT DESCRIPTIONS UNTIL HE'S ACTUALLY MOVED THE C OBJECTS. C WHEN THE FIRST WARNING COMES, WE LOCK THE GRATE, DESTROY THE BRIDGE, KILL C ALL THE DWARVES (AND THE PIRATE), REMOVE THE TROLL AND BEAR (UNLESS DEAD), C AND SET "CLOSNG" TO TRUE. LEAVE THE DRAGON; TOO MUCH TROUBLE TO MOVE IT. C FROM NOW UNTIL CLOCK2 RUNS OUT, HE CANNOT UNLOCK THE GRATE, MOVE TO ANY C LOCATION OUTSIDE THE CAVE (LOC<9), OR CREATE THE BRIDGE. NOR CAN HE BE C RESURRECTED IF HE DIES. NOTE THAT THE SNAKE IS ALREADY GONE, SINCE HE GOT C TO THE TREASURE ACCESSIBLE ONLY VIA THE HALL OF THE MT. KING. ALSO, HE'S C BEEN IN GIANT ROOM (TO GET EGGS), SO WE CAN REFER TO IT. ALSO ALSO, HE'S C GOTTEN THE PEARL, SO WE KNOW THE BIVALVE IS AN OYSTER. *AND*, THE DWARVES 10000 PROP(GRATE)=0 PROP(FISSUR)=0 DO 10010 I=1,6 DSEEN(I)=.FALSE. 10010 DLOC(I)=0 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).NE.3)CALL DSTROY(BEAR) PROP(CHAIN)=0 FIXED(CHAIN)=0 PROP(AXE)=0 FIXED(AXE)=0 CALL RSPEAK(129) CLOCK1=-1 CLOSNG=.TRUE. GOTO 19999 CC127 C ONCE HE'S PANICKED, AND CLOCK2 HAS RUN OUT, WE COME HERE TO SET UP THE C STORAGE ROOM. THE ROOM HAS TWO LOCS, HARDWIRED AS 115 (NE) AND 116 (SW). C AT THE NE END, WE PLACE EMPTY BOTTLES, A NURSERY OF PLANTS, A BED OF C OYSTERS, A PILE OF LAMPS, RODS WITH STARS, SLEEPING DWARVES, AND HIM. AND C THE SW END WE PLACE GRATE OVER TREASURES, SNAKE PIT, COVEY OF CAGED BIRDS, C MORE RODS, AND PILLOWS. A MIRROR STRETCHES ACROSS ONE WALL. MANY OF THE C OBJECTS COME FROM KNOWN LOCATIONS AND/OR STATES (E.G. THE SNAKE IS KNOWN TO C HAVE BEEN DESTROYED AND NEEDN'T BE CARRIED AWAY FROM ITS OLD "PLACE"), C MAKING THE VARIOUS OBJECTS BE HANDLED DIFFERENTLY. WE ALSO DROP ALL OTHER C OBJECTS HE MIGHT BE CARRYING (LEST HE HAVE SOME WHICH COULD CAUSE TROUBLE, C SUCH AS THE KEYS). WE DESCRIBE THE FLASH OF LIGHT AND TRUNDLE BACK. 11000 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 CC128 C 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 11010 I=1,100 IDONDX=I 11010 IF(TOTING(IDONDX))CALL DSTROY(IDONDX) CALL RSPEAK(132) CLOSED=.TRUE. GOTO 2 CC129 C ANOTHER WAY WE CAN FORCE AN END TO THINGS IS BY HAVING THE LAMP GIVE OUT. C WHEN IT GETS CLOSE, WE COME HERE TO WARN HIM. WE GO TO 12000 IF THE LAMP C AND FRESH BATTERIES ARE HERE, IN WHICH CASE WE REPLACE THE BATTERIES AND C CONTINUE. 12200 IS FOR OTHER CASES OF LAMP DYING. 12400 IS WHEN IT GOES C OUT, AND 12600 IS IF HE'S WANDERED OUTSIDE AND THE LAMP IS USED UP, IN WHICH C CASE WE FORCE HIM TO GIVE UP. 12000 CALL RSPEAK(188) PROP(BATTER)=1 IF(TOTING(BATTER))CALL DROP(BATTER,LOC) LIMIT=LIMIT+2500 LMWARN=.FALSE. GOTO 19999 12200 IF(LMWARN.OR..NOT.HERE(LAMP))GOTO 19999 LMWARN=.TRUE. SPK=187 IF(PLACE(BATTER).EQ.0)SPK=183 IF(PROP(BATTER).EQ.1)SPK=189 CALL RSPEAK(SPK) GOTO 19999 12400 LIMIT=-1 PROP(LAMP)=0 IF(HERE(LAMP))CALL RSPEAK(184) GOTO 19999 12600 CALL RSPEAK(185) GAVEUP=.TRUE. GOTO 20000 CC131 C OH DEAR, HE'S DISTURBED THE DWARVES. 19000 CALL RSPEAK(136) CC132 C EXIT CODE. WILL EVENTUALLY INCLUDE SCORING. FOR NOW, HOWEVER, ... C THE PRESENT SCORING ALGORITHM IS AS FOLLOWS: C OBJECTIVE: POINTS: PRESENT TOTAL POSSIBLE: C GETTING WELL INTO CAVE 25 25 C EACH TREASURE < CHEST 12 60 C TREASURE CHEST ITSELF 14 14 C EACH TREASURE > CHEST 16 224 C SURVIVING (MAX-NUM)*10 40 C NOT QUITTING 4 4 C REACHING "CLOSNG" 25 25 C "CLOSED": QUIT/KILLED 10 C KLUTZED 25 C WRONG WAY 30 C SUCCESS 45 45 C CAME TO WITT'S END 1 1 C ROUND OUT THE TOTAL 2 2 C TOTAL: 440 C (POINTS CAN ALSO BE DEDUCTED FOR USING HINTS.) 20000 SCORE=0 MXSCOR=0 CC133 C FIRST TALLY UP THE TREASURES. MUST BE IN BUILDING AND NOT BROKEN. C GIVE THE POOR GUY 2 POINTS JUST FOR FINDING EACH TREASURE. DO 20010 I=50,MAXTRS IF(PTEXT(I).EQ.0)GOTO 20010 K=12 IF(I.EQ.CHEST)K=14 IF(I.GT.CHEST)K=16 IF(PROP(I).GE.0)SCORE=SCORE+2 IF(PLACE(I).EQ.3.AND.PROP(I).EQ.0)SCORE=SCORE+K-2 MXSCOR=MXSCOR+K 20010 CONTINUE CC134 C NOW LOOK AT HOW HE FINISHED AND HOW FAR HE GOT. MAXDIE AND NUMDIE TELL US C HOW WELL HE SURVIVED. GAVEUP SAYS WHETHER HE EXITED VIA QUIT. DFLAG WILL C TELL US IF HE EVER GOT SUITABLY DEEP INTO THE CAVE. CLOSNG STILL INDICATES C WHETHER HE REACHED THE ENDGAME. AND IF HE GOT AS FAR AS "CAVE CLOSED" C (INDICATED BY "CLOSED"), THEN BONUS IS ZERO FOR MUNDANE EXITS OR 133, 134, C 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.NE.0)SCORE=SCORE+25 MXSCOR=MXSCOR+25 IF(CLOSNG)SCORE=SCORE+25 MXSCOR=MXSCOR+25 IF(.NOT.CLOSED)GOTO 20020 IF(BONUS.EQ.0)SCORE=SCORE+10 IF(BONUS.EQ.135)SCORE=SCORE+25 IF(BONUS.EQ.134)SCORE=SCORE+30 IF(BONUS.EQ.133)SCORE=SCORE+45 20020 MXSCOR=MXSCOR+45 CC135 C DID HE COME TO WITT'S END AS HE SHOULD? IF(PLACE(MAGZIN).EQ.108)SCORE=SCORE+1 MXSCOR=MXSCOR+1 CC136 C ROUND IT OFF. SCORE=SCORE+2 MXSCOR=MXSCOR+2 CC137 C DEDUCT POINTS FOR HINTS. HINTS < 4 ARE SPECIAL; SEE DATABASE DESCRIPTION. DO 20030 I=1,HNTMAX 20030 IF(HINTED(I))SCORE=SCORE-HINTS(I,2) CC138 C RETURN TO SCORE COMMAND IF THAT'S WHERE WE CAME FROM. IF(SCORNG)GOTO 8241 CC139 C THAT SHOULD BE GOOD ENOUGH. LET'S TELL HIM ALL ABOUT IT. WRITE(IOPDEV,*) WRITE(IOPDEV,*) WRITE(IOPDEV,*)'YOU SCORED ',SCORE,' OUT OF A POSSIBLE ', 1 MXSCOR,', USING ',TURNS,' TURNS.' C* 20100 FORMAT(///12H YOU SCORED,I4,19H OUT OF A POSSIBLE,I4, C* 18H , USING,I5,8H TURNS.) DO 20200 I=1,CLSSES IF(CVAL(I).GE.SCORE)GOTO 20210 20200 CONTINUE WRITE(IOPDEV,*) WRITE(IOPDEV,*)' YOU JUST WENT OFF MY SCALE!!' WRITE(IOPDEV,*) C* 20202 FORMAT(/' YOU JUST WENT OFF MY SCALE!!'/) GOTO 25000 20210 CALL SPEAK(CTEXT(I)) IF(I.EQ.CLSSES-1)GOTO 20220 K=CVAL(I)+1-SCORE WRITE(IOPDEV,*) WRITE(IOPDEV,*)'TO ACHIEVE THE NEXT HIGHER RATING, YOU NEED', 1 K,' MORE POINTS.' WRITE(IOPDEV,*) GOTO 25000 20220 WRITE(IOPDEV,20222) 20222 FORMAT(/' TO ACHIEVE THE NEXT HIGHER RATING ', 1 'WOULD BE A NEAT TRICK!'// ' CONGRATULATIONS!!'/) 25000 STOP END SUBROUTINE SPEAK(N) CHARACTER*32767 LINES INTEGER*4 LINEX(17000) EQUIVALENCE(LINES,LINEX) LOGICAL BLKLIN COMMON /TXTCOM/ RTEXT,LINEX COMMON /BLKCOM/ BLKLIN INTEGER RTEXT(300) IOPDEV=IODATA(2) IF(N.EQ.0)RETURN IF (LINES(N+1:N+2).EQ.'>$') RETURN IF(BLKLIN)WRITE(IOPDEV,3) 3 FORMAT() K=N 1 L=ICHAR(LINES(K:K)) IF (L.LT.0) L=L+128 IF (L.GT.128) L=L-128 WRITE(IOPDEV,2)LINES(K+1:K+L) 2 FORMAT(' ',A) K=K+L+1 L=ICHAR(LINES(K:K)) IF (L.GE.0.AND.L.LT.128) GOTO 1 RETURN END SUBROUTINE PSPEAK(MSG,SKIP) CHARACTER*32767 LINES INTEGER*4 LINEX(17000) EQUIVALENCE(LINES,LINEX) COMMON /TXTCOM/ RTEXT,LINEX COMMON /PTXCOM/ PTEXT INTEGER RTEXT(300),PTEXT(100),SKIP IOPDEV=IODATA(2) M=PTEXT(MSG) IF(SKIP.LT.0)GOTO 9 ISKIP=SKIP+1 K=ICHAR(LINES(M:M)) DO 3 I=1,ISKIP 1 IF (K.LT.0) K=K+128 IF (K.GE.128) K=K-128 M=M+K+1 K=ICHAR(LINES(M:M)) IF (K.GE.0.AND.K.LT.128) GOTO 1 3 CONTINUE C DO 3 I=1,ISKIP C1 K=ICHAR(LINES(M:M)) C write(6,*)ichar(lines(m:m)) C IF (K.LT.0.OR.K.GE.128) GOTO 2 C M=M+K+1 C GOTO 1 C2 IF (K.LT.0) K=K+128 C IF (K.GT.128) K=K-128 C M=M+K+1 C3 CONTINUE 9 CALL SPEAK(M) RETURN END SUBROUTINE RSPEAK(I) CHARACTER*32767 LINES INTEGER*4 LINEX(17000) EQUIVALENCE(LINES,LINEX) INTEGER RTEXT(300) COMMON /TXTCOM/ RTEXT,LINEX IF(I.NE.0)CALL SPEAK(RTEXT(I)) RETURN END SUBROUTINE GETIN(WORD1,WORD1X,WORD2,WORD2X) LOGICAL BLKLIN COMMON/BLKCOM/BLKLIN INTEGER WORDS(24),WORD1(10),WORD2(10),WORD1X,WORD2X CHARACTER*24 COMLIN IBL=ICHAR(' ') IOPDEV=IODATA(2) IF(BLKLIN)WRITE(IOPDEV,12) 12 FORMAT() DO 11 I=1,24 11 WORDS(I)=IBL WORD1X=0 WORD2X=0 DO 1 I=1,10 WORD1(I)=IBL 1 WORD2(I)=IBL 2 READ(*,22)COMLIN 22 FORMAT(A24) DO 222 I=1,24 WORDS(I)=ICHAR(COMLIN(I:I)) IF (WORDS(I).GT.ICHAR('Z')) WORDS(I)=WORDS(I)-32 222 CONTINUE DO 3 J=1,24 IF(WORDS(J).NE.IBL)GOTO 4 3 CONTINUE GOTO 2 4 DO 5 I=J,24 IF(WORDS(I).EQ.IBL)GOTO 6 WORD1X=WORD1X+1 IF (WORD1X.LE.10) WORD1(WORD1X)=WORDS(I) 5 CONTINUE 6 IF (I.GT.23) RETURN DO 7 J=I,24 IF(WORDS(J).NE.IBL)GOTO 9 IF(WORD2X.EQ.0) GOTO 7 GOTO 8 9 WORD2X=WORD2X+1 WORD2(WORD2X)=WORDS(J) IF (WORD2X.EQ.10) GOTO 8 7 CONTINUE 8 CONTINUE RETURN END LOGICAL FUNCTION YES(X,Y,Z) INTEGER X,Y,Z EXTERNAL RSPEAK LOGICAL YESX YES=YESX(X,Y,Z,RSPEAK) RETURN END LOGICAL FUNCTION YESX(X,Y,Z,SPEK) INTEGER X,Y,Z,REPLY CHARACTER*1 R 1 IF(X.NE.0)CALL SPEK(X) IOPDEV=IODATA(2) READ(*,8)R 8 FORMAT(A1) REPLY=ICHAR(R) IF(REPLY.EQ.ICHAR('Y').OR.REPLY.EQ.ICHAR('y'))GOTO 10 IF(REPLY.EQ.ICHAR('N').OR.REPLY.EQ.ICHAR('n'))GOTO 20 WRITE(IOPDEV,9) 9 FORMAT(/' PLEASE ANSWER THE QUESTION.') GOTO 1 10 YESX=.TRUE. IF(Y.NE.0)CALL SPEK(Y) RETURN 20 YESX=.FALSE. IF(Z.NE.0)CALL SPEK(Z) RETURN END INTEGER FUNCTION VOCAB(ID,INIT) COMMON /VOCCOM/ KTAB,ATAB,TABSIZ INTEGER KTAB(400),ATAB(400,7),ID(10),TABSIZ IBL=ICHAR(' ') DO 1 I=1,TABSIZ IF(KTAB(I).EQ.-1)GOTO 2 IF(INIT.GE.0.AND.KTAB(I)/1000.NE.INIT)GOTO 1 DO 4 J=1,7 IF (J.GT.5.AND.ID(J).EQ.IBL) GOTO 3 IF(ATAB(I,J).NE.ID(J))GOTO 1 4 CONTINUE GOTO 3 1 CONTINUE CALL BUG(21) 2 VOCAB=-1 IF(INIT.LT.0)RETURN CALL BUG(5) 3 VOCAB=KTAB(I) IF(INIT.GE.0)VOCAB=MOD(VOCAB,1000) RETURN END SUBROUTINE DSTROY(IOBJ) CALL MOVE(IOBJ,0) RETURN END SUBROUTINE JUGGLE(IOBJ) COMMON /PLACOM/ ATLOC,LINK,PLACE,FIXED,HOLDNG INTEGER ATLOC(300),LINK(200),PLACE(100),FIXED(100),HOLDNG I=PLACE(IOBJ) J=FIXED(IOBJ) CALL MOVE(IOBJ,I) CALL MOVE(IOBJ+100,J) RETURN END SUBROUTINE MOVE(IOBJ,WHERE) COMMON /PLACOM/ ATLOC,LINK,PLACE,FIXED,HOLDNG INTEGER ATLOC(300),LINK(200),PLACE(100),FIXED(100),WHERE,FROM 1,HOLDNG IF(IOBJ.GT.100)GOTO 1 FROM=PLACE(IOBJ) GOTO 2 1 FROM=FIXED(IOBJ-100) 2 IF(FROM.GT.0.AND.FROM.LE.300)CALL CARRY(IOBJ,FROM) CALL DROP(IOBJ,WHERE) RETURN END INTEGER FUNCTION PUT(IOBJ,WHERE,PVAL) INTEGER WHERE,PVAL CALL MOVE(IOBJ,WHERE) PUT=(-1)-PVAL RETURN END SUBROUTINE CARRY(IOBJ,WHERE) COMMON /PLACOM/ ATLOC,LINK,PLACE,FIXED,HOLDNG INTEGER ATLOC(300),LINK(200),PLACE(100),FIXED(100),WHERE,HOLDNG IF(IOBJ.GT.100)GOTO 5 IF(PLACE(IOBJ).EQ.-1)RETURN PLACE(IOBJ)=-1 HOLDNG=HOLDNG+1 5 IF(ATLOC(WHERE).NE.IOBJ)GOTO 6 ATLOC(WHERE)=LINK(IOBJ) RETURN 6 IT=ATLOC(WHERE) 7 IF(LINK(IT).EQ.IOBJ)GOTO 8 IT=LINK(IT) GOTO 7 8 LINK(IT)=LINK(IOBJ) RETURN END SUBROUTINE DROP(IOBJ,WHERE) COMMON /PLACOM/ ATLOC,LINK,PLACE,FIXED,HOLDNG INTEGER ATLOC(300),LINK(200),PLACE(100),FIXED(100),WHERE,HOLDNG IF(IOBJ.GT.100)GOTO 1 IF(PLACE(IOBJ).EQ.-1)HOLDNG=HOLDNG-1 PLACE(IOBJ)=WHERE GOTO 2 1 FIXED(IOBJ-100)=WHERE 2 IF(WHERE.LE.0)RETURN LINK(IOBJ)=ATLOC(WHERE) ATLOC(WHERE)=IOBJ RETURN END INTEGER FUNCTION DISTNT(FROM,NO) EXTERNAL RAN COMMON/TRVCOM/TK,TRAVEL,KEY,COND INTEGER TK(20),KEY(200),TRAVEL(1000,3),COND(200),FROM,RAN 1 DISTNT=FROM DO 4 I=1,NO K=KEY(DISTNT) J=0 2 N=TRAVEL(K,2) IF(J.LE.0)GOTO 10 IF(N.EQ.TK(J))GOTO 3 10 IF(N.GT.300.OR.N.LE.9 1 .OR.(N.GE.176.AND.N.LE.187) 1 .OR.COND(N).EQ.2.OR.N.EQ.FROM.OR.J.GE.20)GO TO 3 J=J+1 TK(J)=N 3 K=K+1 IF(TRAVEL(K-1,3).GE.0)GO TO 2 IF(J.EQ.0)GO TO 1 JJ=1+RAN(J) DISTNT=TK(JJ) 4 CONTINUE C* If the destination is the cellar (no exits!), make it the chapel. MLA. IF(DISTNT.EQ.154.OR.DISTNT.EQ.FROM)DISTNT=141 RETURN END SUBROUTINE DTOT COMMON/PLACOM/ ATLOC,LINK,PLACE,FIXED,HOLDNG COMMON/DTOCOM/ DOBJ,DLOC,PLAC,FIXD,PROP,LOC,MAXTRS INTEGER ATLOC(300),LINK(200),PLACE(100),FIXED(100),HOLDNG INTEGER DOBJ(5),DLOC(6),PLAC(100),FIXD(100),PROP(100) DO 40 I=1,3 K=DOBJ(I) L=DLOC(I) IF(K.EQ.0)GOTO 20 IF(L.EQ.0.OR.PLAC(K).NE.L)GOTO 10 CALL MOVE(K,L) DOBJ(I)=0 10 CONTINUE IF(L.NE.0)GOTO 20 IF(PLACE(K).EQ.188)CALL MOVE(K,LOC) CALL PSPEAK(K,PROP(K)) DOBJ(I)=0 20 IF(L.EQ.0)GOTO 40 KH=ATLOC(L) KN=K IF(KH.EQ.0)GOTO 40 30 IF(KH.GE.100)GOTO 32 IF(PLAC(KH).EQ.L.OR.FIXD(KH).NE.0)GOTO 32 IF((KH.GE.4.AND.KH.LE.15).OR.KH.EQ.18.OR.KH.EQ.20)GOTO 32 IF(KH.EQ.21.OR.KH.EQ.22.OR.KH.EQ.28.OR.KH.EQ.34)GOTO 32 IF(KH.EQ.35.OR.KH.EQ.41)GOTO 32 IF(KH.GT.KN)KN=KH 32 KH=LINK(KH) IF(KH.NE.0)GOTO 30 IF(KN.EQ.K)GOTO 40 DOBJ(I)=KN CALL MOVE(KN,188) IF(K.GT.0)CALL MOVE(K,L) 40 CONTINUE RETURN END INTEGER FUNCTION RAN(IR) COMMON/DTOCOM/DOBJ,DLOC,PLAC,FIXD,PROP,LOC,MAXTRS COMMON/TURN/TURNS,IRAN INTEGER DOBJ(5),DLOC(6),PLAC(100),FIXD(100),PROP(100),TURNS,R DATA R/0/ R=LOC+137*MOD(TURNS,7)+IRAN DO 100 I=1,5 100 R=R+DOBJ(I)+DLOC(I)*7 DO 200 I=1,7 200 R=R+PLAC(I)+PROP(I) IRAN=MOD(R,173) RAN=MOD(R,IR) RETURN END SUBROUTINE BUG(NUM) IOPDEV=IODATA(2) WRITE(IOPDEV,1)NUM 1 FORMAT (50H FATAL ERROR, SEE SOURCE CODE FOR INTERPRETATION./ 1 45H PROBABLE CAUSE: ERRONEOUS INFO IN DATABASE./ 2 14H ERROR CODE =,I2/) STOP END SUBROUTINE ORCALL COMMON/DTOCOM/ DOBJ,DLOC,PLAC,FIXD,PROP,LOC,MAXTRS INTEGER DOBJ(5),DLOC(6),PLAC(100),FIXD(100),PROP(100),ORC(5),SPK IF(PROP(12).NE.0.OR.ORC(1).EQ.1)GOTO 200 SPK=229 ORC(1)=1 GOTO 900 200 IF(PROP(67).NE.-1.OR.ORC(2).GE.1)GOTO 300 SPK=239 ORC(2)=1 GOTO 900 300 IF(PROP(9).NE.1.OR.ORC(3).GE.1)GOTO 900 SPK=268 ORC(3)=1 CALL RSPEAK(SPK) 900 RETURN END C INTEGER FUNCTION IODATA(N) INTEGER OPDUMP C IPDATA, UNIT NUMBER OF INPUT DEVICE FOR DATA BASE. IPDATA=24 C IOPDEV, UNIT NUMBER OF DEVICE (EG TTY) AT WHICH GAME IS TO BE PLAYED. IOPDEV=6 C IPDUMP, INPUT DEVICE FOR PREVIOUSLY DUMPED POSITION. IPDUMP=22 C OPDUMP, OUTPUT DEVICE FOR DUMP OF CURRENT POSITION. OPDUMP=22 C DUMP FACILITIES WRITTEN TO SAVE YOUR POSITION ON PAPER TAPE. C TO USE DISK MAY NEED TO MOD PROG AT CC117-CC118 TO SUIT SYSTEM. IF(N.EQ.1)IODATA=IPDATA IF(N.EQ.2)IODATA=IOPDEV IF(N.EQ.3)IODATA=IPDUMP IF(N.EQ.4)IODATA=OPDUMP RETURN END