Created
May 4, 2016 20:04
-
-
Save srerickson/14780cef17f6a315475fa28cdc266c93 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
PROGRAM ADVENT | |
C ADVENTURES | |
C CURRENT LIMITS: | |
C 9650 WORDS OF MESSAGE TEXT (LINES, LINSIZ). | |
C 750 TRAVEL OPTIONS (TRAVEL, TRVSIZ). | |
C 300 VOCABULARY WORDS (KTAB, ATAB, TABSIZ). | |
C 150 LOCATIONS (LTEXT, STEXT, KEY, COND, ABB, ATLOC, LOCSIZ). | |
C 100 OBJECTS (PLAC, PLACE, FIXD, FIXED, LINK (TWICE), PTEXT, PROP). | |
C 35 "ACTION" VERBS (ACTSPK, VRBSIZ). | |
C 205 RANDOM MESSAGES (RTEXT, RTXSIZ). | |
C 12 DIFFERENT PLAYER CLASSIFICATIONS (CTEXT, CVAL, CLSMAX). | |
C 20 HINTS, LESS 3 (HINTLC, HINTED, HINTS, HNTSIZ). | |
C 35 MAGIC MESSAGES (MTEXT, MAGSIZ). | |
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 | |
IMPLICIT INTEGER(A-Z) | |
LOGICAL DSEEN,BLKLIN,HINTED,YES,START | |
COMMON /TXTCOM/ RTEXT,LINES | |
COMMON /BLKCOM/ BLKLIN | |
COMMON /VOCCOM/ KTAB,ATAB,TABSIZ | |
COMMON /PLACOM/ ATLOC,LINK,PLACE,FIXED,HOLDNG | |
COMMON /MTXCOM/ MTEXT | |
COMMON /PTXCOM/ PTEXT | |
COMMON /ABBCOM/ ABB | |
COMMON /WIZCOM/ WKDAY,WKEND,HOLID,HBEGIN,HEND,HNAME, | |
1 SHORT,MAGIC,MAGNM,LATNCY,SAVED,SAVET,SETUP | |
DIMENSION LINES(9650) | |
DIMENSION TRAVEL(750) | |
DIMENSION KTAB(300),ATAB(300) | |
DIMENSION LTEXT(150),STEXT(150),KEY(150),COND(150),ABB(150), | |
1 ATLOC(150) | |
DIMENSION PLAC(100),PLACE(100),FIXD(100),FIXED(100),LINK(200), | |
1 PTEXT(100),PROP(100) | |
DIMENSION ACTSPK(35) | |
DIMENSION RTEXT(205) | |
DIMENSION CTEXT(12),CVAL(12) | |
DIMENSION HINTLC(20),HINTED(20),HINTS(20,4) | |
DIMENSION MTEXT(35) | |
DIMENSION TK(20),DSEEN(6),DLOC(6),ODLOC(6),HNAME(4) | |
C | |
C AVOID MAKING THE COMPILER WORRY ABOUT MODIFYING THE DO INDEX | |
C | |
INTEGER IDONDX | |
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 | |
LOGICAL TOTING,HERE,AT,BITSET,DARK,WZDARK,LMWARN,CLOSNG,PANIC, | |
1 CLOSED,GAVEUP,SCORNG,DEMO,YEA | |
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)=(COND(L).AND.SHIFT(1,N)).NE.0 | |
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 | |
C | |
DATA LINSIZ/9650/,TRVSIZ/750/,TABSIZ/300/,LOCSIZ/150/, | |
1 VRBSIZ/35/,RTXSIZ/205/,CLSMAX/12/,HNTSIZ/20/,MAGSIZ/35/ | |
DATA SETUP/0/,BLKLIN/.TRUE./ | |
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 300<N<=500 N-300 IS USED IN A COMPUTED GOTO TO | |
C A SECTION OF SPECIAL CODE. | |
C IF N>500 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<M<100 IT IS DONE WITH M% PROBABILITY. | |
C IF M=100 UNCONDITIONAL, BUT FORBIDDEN TO DWARVES. | |
C IF 100<M<=200 HE MUST BE CARRYING OBJECT M-100. | |
C IF 200<M<=300 MUST BE CARRYING OR IN SAME ROOM AS M-200. | |
C IF 300<M<=400 PROP(M MOD 100) MUST *NOT* BE 0. | |
C IF 400<M<=500 PROP(M MOD 100) MUST *NOT* BE 1. | |
C IF 500<M<=600 PROP(M MOD 100) MUST *NOT* BE 2, ETC. | |
C IF THE CONDITION (IF ANY) IS NOT MET, THEN THE NEXT *DIFFERENT* | |
C "DESTINATION" VALUE IS USED (UNLESS IT FAILS TO MEET *ITS* CONDITIONS, | |
C IN WHICH CASE THE NEXT IS FOUND, ETC.). TYPICALLY, THE NEXT DEST WILL | |
C BE FOR ONE OF THE SAME VERBS, SO THAT ITS ONLY USE IS AS THE ALTERNATE | |
C DESTINATION FOR THOSE VERBS. FOR INSTANCE: | |
C 15 110022 29 31 34 35 23 43 | |
C 15 14 29 | |
C THIS SAYS THAT, FROM LOC 15, ANY OF THE VERBS 29, 31, ETC., WILL TAKE | |
C HIM TO 22 IF HE'S CARRYING OBJECT 10, AND OTHERWISE WILL GO TO 14. | |
C 11 303008 49 | |
C 11 9 50 | |
C THIS SAYS THAT, FROM 11, 49 TAKES HIM TO 8 UNLESS PROP(3)=0, IN WHICH | |
C CASE HE GOES TO 9. VERB 50 TAKES HIM TO 9 REGARDLESS OF PROP(3). | |
C SECTION 4: VOCABULARY. EACH LINE CONTAINS A NUMBER (N), A TAB, AND A | |
C FIVE-LETTER WORD. CALL M=N/1000. IF M=0, THEN THE WORD IS A MOTION | |
C VERB FOR USE IN TRAVELLING (SEE SECTION 3). ELSE, IF M=1, THE WORD IS | |
C AN OBJECT. ELSE, IF M=2, THE WORD IS AN ACTION VERB (SUCH AS "CARRY" | |
C OR "ATTACK"). ELSE, IF M=3, THE WORD IS A SPECIAL CASE VERB (SUCH AS | |
C "DIG") AND N MOD 1000 IS AN INDEX INTO SECTION 6. OBJECTS FROM 50 TO | |
C (CURRENTLY, ANYWAY) 79 ARE CONSIDERED TREASURES (FOR PIRATE, CLOSEOUT). | |
C SECTION 5: OBJECT DESCRIPTIONS. EACH LINE CONTAINS A NUMBER (N), A TAB, | |
C AND A MESSAGE. IF N IS FROM 1 TO 100, THE MESSAGE IS THE "INVENTORY" | |
C MESSAGE FOR OBJECT N. OTHERWISE, N SHOULD BE 000, 100, 200, ETC., AND | |
C THE MESSAGE SHOULD BE THE DESCRIPTION OF THE PRECEDING OBJECT WHEN ITS | |
C PROP VALUE IS N/100. THE N/100 IS USED ONLY TO DISTINGUISH MULTIPLE | |
C MESSAGES FROM MULTI-LINE MESSAGES; THE PROP INFO ACTUALLY REQUIRES ALL | |
C MESSAGES FOR AN OBJECT TO BE PRESENT AND CONSECUTIVE. PROPERTIES WHICH | |
C PRODUCE NO MESSAGE SHOULD BE GIVEN THE MESSAGE ">$<". | |
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 1 IF BIT 2 IS ON: ON FOR OIL, OFF FOR WATER | |
C 2 LIQUID ASSET, SEE BIT 1 | |
C 3 PIRATE DOESN'T GO HERE UNLESS FOLLOWING PLAYER | |
C OTHER BITS ARE USED TO INDICATE AREAS OF INTEREST TO "HINT" ROUTINES: | |
C 4 TRYING TO GET INTO CAVE | |
C 5 TRYING 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: MAGIC MESSAGES. IDENTICAL TO SECTION 6 EXCEPT PUT IN A SEPARATE | |
C SECTION FOR EASIER REFERENCE. MAGIC 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 | |
TYPE 1000 | |
1000 FORMAT(' INITIALIZING...') | |
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 1001 I=1,300 | |
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 | |
C CALL IFILE(1,'ADVENT') | |
SETUP=1 | |
LINUSE=1 | |
TRVS=1 | |
CLSSES=1 | |
C START NEW DATA SECTION. SECT IS THE SECTION NUMBER. | |
1002 READ(1,1003)SECT | |
1003 FORMAT(G) | |
OLDLOC=-1 | |
GOTO(1100,1004,1004,1030,1040,1004,1004,1050,1060,1070,1004, | |
1 1080,1004) (SECT+1) | |
C (0) (1) (2) (3) (4) (5) (6) (7) (8) (9) (10) | |
C (11) (12) | |
CALL BUG(9) | |
C SECTIONS 1, 2, 5, 6, 10, 12. READ MESSAGES AND SET UP POINTERS. | |
1004 READ(1,1005)LOC,(LINES(J),J=LINUSE+1,LINUSE+14),KK | |
1005 FORMAT(1G,15A5) | |
IF(KK.NE.' ')CALL BUG(0) | |
IF(LOC.EQ.-1)GOTO 1002 | |
DO 1006 K=1,14 | |
KK=LINUSE+15-K | |
IF(LINES(KK).NE.' ')GOTO 1007 | |
1006 CONTINUE | |
IF(LOC.EQ.0)GOTO 1004 | |
C ABOVE KLUGE IS TO AVOID F40 BUG IF CRLF BROKEN ACROSS RECORD BOUNDARY | |
CALL BUG(1) | |
1007 LINES(LINUSE)=KK+1 | |
IF(LOC.EQ.OLDLOC)GOTO 1020 | |
LINES(LINUSE)=-LINES(LINUSE) | |
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.LE.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=KK+1 | |
LINES(LINUSE)=-1 | |
OLDLOC=LOC | |
IF(LINUSE+14.GT.LINSIZ)CALL BUG(2) | |
GOTO 1004 | |
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(1,1031)LOC,NEWLOC,TK | |
1031 FORMAT(99G) | |
IF(LOC.EQ.0)GOTO 1030 | |
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)=-TRAVEL(TRVS-1) | |
1035 DO 1037 L=1,20 | |
IF(TK(L).EQ.0)GOTO 1039 | |
TRAVEL(TRVS)=NEWLOC*1000+TK(L) | |
TRVS=TRVS+1 | |
IF(TRVS.EQ.TRVSIZ)CALL BUG(3) | |
1037 CONTINUE | |
1039 TRAVEL(TRVS-1)=-TRAVEL(TRVS-1) | |
GOTO 1030 | |
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 | |
1043 READ(1,1041)KTAB(TABNDX),ATAB(TABNDX) | |
1041 FORMAT(G,A5) | |
IF(KTAB(TABNDX).EQ.0)GOTO 1043 | |
C ABOVE KLUGE IS TO AVOID AFOREMENTIONED F40 BUG | |
IF(KTAB(TABNDX).EQ.-1)GOTO 1002 | |
1042 ATAB(TABNDX)=ATAB(TABNDX).XOR.'PHROG' | |
CALL BUG(4) | |
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(1,1031)OBJ,J,K | |
IF(OBJ.EQ.-1)GOTO 1002 | |
PLAC(OBJ)=J | |
FIXD(OBJ)=K | |
GOTO 1050 | |
C READ DEFAULT MESSAGE NUMBERS FOR ACTION VERBS, STORE IN ACTSPK. | |
1060 READ(1,1031)VERB,J | |
IF(VERB.EQ.-1)GOTO 1002 | |
ACTSPK(VERB)=J | |
GOTO 1060 | |
C READ INFO ABOUT AVAILABLE LIQUIDS AND OTHER CONDITIONS, STORE IN COND. | |
1070 READ(1,1031)K,TK | |
IF(K.EQ.-1)GOTO 1002 | |
DO 1071 I=1,20 | |
LOC=TK(I) | |
IF(LOC.EQ.0)GOTO 1070 | |
IF(BITSET(LOC,K))CALL BUG(8) | |
1071 COND(LOC)=COND(LOC)+SHIFT(1,K) | |
GOTO 1070 | |
C READ DATA FOR HINTS. | |
1080 HNTMAX=0 | |
1081 READ(1,1031)K,TK | |
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 | |
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 | |
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(MOD(IABS(TRAVEL(K)),1000).EQ.1)COND(I)=2 | |
1102 ATLOC(I)=0 | |
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)) | |
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) | |
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 | |
C 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) | |
C 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) | |
C THESE ARE MOTION-VERB NUMBERS. | |
BACK=VOCAB('BACK',0) | |
LOOK=VOCAB('LOOK',0) | |
CAVE=VOCAB('CAVE',0) | |
NULL=VOCAB('NULL',0) | |
ENTRNC=VOCAB('ENTRA',0) | |
DPRSSN=VOCAB('DEPRE',0) | |
C AND SOME ACTION VERBS. | |
SAY=VOCAB('SAY',2) | |
LOCK=VOCAB('LOCK',2) | |
THROW=VOCAB('THROW',2) | |
FIND=VOCAB('FIND',2) | |
INVENT=VOCAB('INVEN',2) | |
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 1 REACHED HALL OF MISTS, BUT HASN'T MET FIRST DWARF | |
C 2 MET FIRST DWARF, OTHERS START MOVING, NO KNIVES THROWN YET | |
C 3 A 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 | |
1700 DSEEN(I)=.FALSE. | |
DFLAG=0 | |
DLOC(1)=19 | |
DLOC(2)=27 | |
DLOC(3)=33 | |
DLOC(4)=44 | |
DLOC(5)=64 | |
DLOC(6)=CHLOC | |
DALTLC=18 | |
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 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 LOGICALS WERE EXPLAINED EARLIER | |
TURNS=0 | |
LMWARN=.FALSE. | |
IWEST=0 | |
KNFLOC=0 | |
DETAIL=0 | |
ABBNUM=5 | |
DO 1800 I=0,4 | |
1800 IF(RTEXT(2*I+81).NE.0)MAXDIE=I+1 | |
NUMDIE=0 | |
HOLDNG=0 | |
DKILL=0 | |
FOOBAR=0 | |
BONUS=0 | |
CLOCK1=30 | |
CLOCK2=50 | |
SAVED=0 | |
CLOSNG=.FALSE. | |
PANIC=.FALSE. | |
CLOSED=.FALSE. | |
GAVEUP=.FALSE. | |
SCORNG=.FALSE. | |
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 | |
KK=LOCSIZ+1-K | |
IF(LTEXT(KK).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 | |
TYPE 1999,LINUSE,LINSIZ,TRVS,TRVSIZ,TABNDX,TABSIZ,KK | |
1 ,LOCSIZ,OBJ,K,VERB,VRBSIZ,J,RTXSIZ,CLSSES,CLSMAX | |
2 ,HNTMAX,HNTSIZ,I,MAGSIZ | |
1999 FORMAT (' TABLE SPACE USED:'/ | |
1 ' ',I6,' OF ',I6,' WORDS OF MESSAGES'/ | |
2 ' ',I6,' OF ',I6,' TRAVEL OPTIONS'/ | |
3 ' ',I6,' OF ',I6,' VOCABULARY WORDS'/ | |
4 ' ',I6,' OF ',I6,' LOCATIONS'/ | |
5 ' ',I6,' OF ',I6,' OBJECTS'/ | |
6 ' ',I6,' OF ',I6,' ACTION VERBS'/ | |
7 ' ',I6,' OF ',I6,' RTEXT MESSAGES'/ | |
8 ' ',I6,' OF ',I6,' CLASS MESSAGES'/ | |
9 ' ',I6,' OF ',I6,' HINTS'/ | |
1 ' ',I6,' OF ',I6,' MAGIC MESSAGES'/ | |
2 ) | |
C FINALLY, SINCE WE'RE CLEARLY SETTING THINGS UP FOR THE FIRST TIME... | |
CALL POOF | |
PAUSE 'INIT DONE' | |
C START-UP, DWARF STUFF | |
1 DEMO=START(0) | |
CALL MOTD(.FALSE.) | |
I=RAN(1) | |
HINTED(3)=YES(65,1,0) | |
NEWLOC=1 | |
SETUP=3 | |
LIMIT=330 | |
IF(HINTED(3))LIMIT=1000 | |
C CAN'T LEAVE CAVE ONCE IT'S CLOSING (EXCEPT BY MAIN OFFICE). | |
2 IF(NEWLOC.GE.9.OR.NEWLOC.EQ.0.OR..NOT.CLOSNG)GOTO 71 | |
CALL RSPEAK(130) | |
NEWLOC=LOC | |
IF(.NOT.PANIC)CLOCK2=15 | |
PANIC=.TRUE. | |
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 | |
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. | |
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 | |
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))GOTO 2000 | |
DFLAG=2 | |
DO 6001 I=1,2 | |
J=1+RAN(5) | |
C IF SAVED NOT = -1, HE BYPASSED THE "START" CALL. | |
6001 IF(PCT(50).AND.SAVED.EQ.-1)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 | |
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 | |
DO 6030 I=1,6 | |
IF(DLOC(I).EQ.0)GOTO 6030 | |
J=1 | |
KK=DLOC(I) | |
KK=KEY(KK) | |
IF(KK.EQ.0)GOTO 6016 | |
6012 NEWLOC=MOD(IABS(TRAVEL(KK))/1000,1000) | |
IF(NEWLOC.GT.300.OR.NEWLOC.LT.15.OR.NEWLOC.EQ.ODLOC(I) | |
1 .OR.(J.GT.1.AND.NEWLOC.EQ.TK(J-1)).OR.J.GE.20 | |
2 .OR.NEWLOC.EQ.DLOC(I).OR.FORCED(NEWLOC) | |
3 .OR.(I.EQ.6.AND.BITSET(NEWLOC,3)) | |
4 .OR.IABS(TRAVEL(KK))/1000000.EQ.100)GOTO 6014 | |
TK(J)=NEWLOC | |
J=J+1 | |
6014 KK=KK+1 | |
IF(TRAVEL(KK-1).GE.0)GOTO 6012 | |
6016 TK(J)=ODLOC(I) | |
J=1+RAN(J) | |
ODLOC(I)=DLOC(I) | |
DLOC(I)=TK(J) | |
DSEEN(I)=(DSEEN(I).AND.LOC.GE.15) | |
1 .OR.(DLOC(I).EQ.LOC.OR.ODLOC(I).EQ.LOC) | |
IF(.NOT.DSEEN(I))GOTO 6030 | |
DLOC(I)=LOC | |
IF(I.NE.6)GOTO 6027 | |
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 | |
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) | |
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 | |
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(1000).LT.95*(DFLAG-2))STICK=STICK+1 | |
6030 CONTINUE | |
C NOW WE KNOW WHAT'S HAPPENING. LET'S TELL THE POOR SUCKER ABOUT IT. | |
IF(DTOTAL.EQ.0)GOTO 2000 | |
IF(DTOTAL.EQ.1)GOTO 75 | |
TYPE 67,DTOTAL | |
67 FORMAT(/' THERE ARE ',I1,' THREATENING LITTLE DWARVES IN THE' | |
1 ,' ROOM WITH YOU.') | |
GOTO 77 | |
75 CALL RSPEAK(4) | |
77 IF(ATTACK.EQ.0)GOTO 2000 | |
IF(DFLAG.EQ.2)DFLAG=3 | |
C IF SAVED NOT = -1, HE BYPASSED THE "START" CALL. DWARVES GET *VERY* MAD! | |
IF(SAVED.NE.-1)DFLAG=20 | |
IF(ATTACK.EQ.1)GOTO 79 | |
TYPE 78,ATTACK | |
78 FORMAT(/' ',I1,' 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 TYPE 68,STICK | |
68 FORMAT(/' ',I1,' OF THEM GET YOU!') | |
84 OLDLC2=LOC | |
GOTO 99 | |
79 CALL RSPEAK(5) | |
K=52 | |
GOTO 82 | |
C DESCRIBE THE CURRENT LOCATION AND (MAYBE) GET NEXT COMMAND. | |
C PRINT TEXT FOR CURRENT LOC. | |
2000 IF(LOC.EQ.0)GOTO 99 | |
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 | |
IF(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) | |
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 2012 | |
ABB(LOC)=ABB(LOC)+1 | |
I=ATLOC(LOC) | |
2004 IF(I.EQ.0)GOTO 2012 | |
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 | |
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 | |
CALL PSPEAK(OBJ,KK) | |
2008 I=LINK(I) | |
GOTO 2004 | |
2009 K=54 | |
2010 SPK=K | |
2011 CALL RSPEAK(SPK) | |
2012 VERB=0 | |
OBJ=0 | |
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 | |
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)) | |
1 CALL 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) | |
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. | |
2608 FOOBAR=MIN0(0,-FOOBAR) | |
IF(TURNS.EQ.0.AND.WD1.EQ.'MAGIC'.AND.WD2.EQ.'MODE')CALL MAINT | |
TURNS=TURNS+1 | |
IF(DEMO.AND.TURNS.GE.SHORT)GOTO 13000 | |
IF(VERB.EQ.SAY.AND.WD2.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 | |
IF(WD1.EQ.'ENTER'.AND.(WD2.EQ.'STREA'.OR.WD2.EQ.'WATER')) | |
1 GOTO 2010 | |
IF(WD1.EQ.'ENTER'.AND.WD2.NE.0)GOTO 2800 | |
IF((WD1.NE.'WATER'.AND.WD1.NE.'OIL') | |
1 .OR.(WD2.NE.'PLANT'.AND.WD2.NE.'DOOR'))GOTO 2610 | |
IF(AT(VOCAB(WD2,1)))WD2='POUR' | |
2610 IF(WD1.NE.'WEST')GOTO 2630 | |
IWEST=IWEST+1 | |
IF(IWEST.EQ.10)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 | |
CALL BUG(22) | |
C GET SECOND WORD FOR ANALYSIS. | |
2800 WD1=WD2 | |
WD1X=WD2X | |
WD2=0 | |
GOTO 2610 | |
C GEE, I DON'T UNDERSTAND. | |
3000 SPK=60 | |
IF(PCT(20))SPK=61 | |
IF(PCT(20))SPK=13 | |
CALL RSPEAK(SPK) | |
GOTO 2600 | |
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(WD2.NE.0.AND.VERB.NE.SAY)GOTO 2800 | |
IF(VERB.EQ.SAY)OBJ=WD2 | |
IF(OBJ.NE.0)GOTO 4090 | |
C ANALYSE AN INTRANSITIVE VERB (IE, NO OBJECT GIVEN YET). | |
4080 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)VERB | |
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 | |
CALL BUG(23) | |
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)VERB | |
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 | |
CALL BUG(24) | |
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. | |
5000 OBJ=K | |
IF(FIXED(K).NE.LOC.AND..NOT.HERE(K))GOTO 5100 | |
5010 IF(WD2.NE.0)GOTO 2800 | |
IF(VERB.NE.0)GOTO 4090 | |
CALL A5TOA1(WD1,WD1X,'?',TK,K) | |
TYPE 5015,(TK(I),I=1,K) | |
5015 FORMAT(/' WHAT DO YOU WANT TO DO WITH THE ',20A1) | |
GOTO 2600 | |
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.WD2.EQ.0)GOTO 5010 | |
CALL A5TOA1(WD1,WD1X,'HERE.',TK,K) | |
TYPE 5199,(TK(I),I=1,K) | |
5199 FORMAT(/' I SEE NO ',20A1) | |
GOTO 2012 | |
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)) | |
IF(MOD(LL,1000).EQ.1.OR.MOD(LL,1000).EQ.K)GOTO 10 | |
IF(TRAVEL(KK).LT.0)GOTO 50 | |
KK=KK+1 | |
GOTO 9 | |
10 LL=LL/1000 | |
11 NEWLOC=LL/1000 | |
K=MOD(NEWLOC,100) | |
IF(NEWLOC.LE.300)GOTO 13 | |
IF(PROP(K).NE.NEWLOC/100-3)GOTO 16 | |
12 IF(TRAVEL(KK).LT.0)CALL BUG(25) | |
KK=KK+1 | |
NEWLOC=IABS(TRAVEL(KK))/1000 | |
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 | |
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)NEWLOC | |
CALL BUG(20) | |
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 | |
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 | |
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(SPICES).LT.0)TALLY2=TALLY2+1 | |
OLDLC2=NEWLOC | |
GOTO 99 | |
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=MOD((IABS(TRAVEL(KK))/1000),1000) | |
IF(LL.EQ.K)GOTO 25 | |
IF(LL.GT.300)GOTO 22 | |
J=KEY(LL) | |
IF(FORCED(LL).AND.MOD((IABS(TRAVEL(J))/1000),1000).EQ.K)K2=KK | |
22 IF(TRAVEL(KK).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=MOD(IABS(TRAVEL(KK)),1000) | |
KK=KEY(LOC) | |
GOTO 9 | |
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 | |
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 | |
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 | |
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 | |
C OKAY, HE'S DEAD. LET'S GET ON WITH IT. | |
99 IF(CLOSNG)GOTO 95 | |
YEA=YES(81+NUMDIE*2,82+NUMDIE*2,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 | |
DO 98 J=1,100 | |
I=101-J | |
IF(.NOT.TOTING(I))GOTO 98 | |
K=OLDLC2 | |
IF(I.EQ.LAMP)K=1 | |
CALL DROP(I,K) | |
98 CONTINUE | |
LOC=3 | |
OLDLOC=LOC | |
GOTO 2000 | |
C HE DIED DURING CLOSING TIME. NO RESURRECTION. TALLY UP A DEATH AND EXIT. | |
95 CALL RSPEAK(131) | |
NUMDIE=NUMDIE+1 | |
GOTO 20000 | |
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 CALL A5TOA1(WD1,WD1X,'WHAT?',TK,K) | |
TYPE 8002,(TK(I),I=1,K) | |
8002 FORMAT(/' ',20A1) | |
OBJ=0 | |
GOTO 2600 | |
C CARRY, NO OBJECT GIVEN YET. OK IF ONLY ONE OBJECT PRESENT. | |
8010 IF(ATLOC(LOC).EQ.0.OR.LINK(ATLOC(LOC)).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) | |
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(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) | |
1 CALL CARRY(BIRD+CAGE-OBJ,LOC) | |
CALL CARRY(OBJ,LOC) | |
K=LIQ(0) | |
IF(OBJ.EQ.BOTTLE.AND.K.NE.0)PLACE(K)=-1 | |
GOTO 2009 | |
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. | |
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) | |
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) | |
GOTO 2012 | |
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).OR.PROP(DRAGON).NE.0)GOTO 9026 | |
CALL RSPEAK(154) | |
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.EQ.VASE.AND.LOC.NE.PLAC(PILLOW))GOTO 9028 | |
CALL RSPEAK(54) | |
GOTO 9021 | |
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 | |
C SAY. ECHO WD2 (OR WD1 IF NO WD2 (SAY WHAT?, ETC.).) MAGIC WORDS OVERRIDE. | |
9030 CALL A5TOA1(WD2,WD2X,'".',TK,K) | |
IF(WD2.EQ.0)CALL A5TOA1(WD1,WD1X,'".',TK,K) | |
IF(WD2.NE.0)WD1=WD2 | |
I=VOCAB(WD1,-1) | |
IF(I.EQ.62.OR.I.EQ.65.OR.I.EQ.71.OR.I.EQ.2025)GOTO 9035 | |
TYPE 9032,(TK(I),I=1,K) | |
9032 FORMAT(/' OKAY, "',20A1) | |
GOTO 2012 | |
9035 WD2=0 | |
OBJ=0 | |
GOTO 2630 | |
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 | |
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 | |
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 | |
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 | |
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 2000 | |
GOTO 2012 | |
C LAMP OFF | |
9080 IF(.NOT.HERE(LAMP))GOTO 2011 | |
PROP(LAMP)=0 | |
CALL RSPEAK(40) | |
IF(DARK(0))CALL RSPEAK(16) | |
GOTO 2012 | |
C WAVE. NO EFFECT UNLESS WAVING ROD AT FISSURE. | |
9090 IF((.NOT.TOTING(OBJ)).AND.(OBJ.NE.ROD.OR..NOT.TOTING(ROD2))) | |
1 SPK=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 | |
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(OBJ.GT.100)GOTO 8000 | |
IF(OBJ.NE.0)GOTO 9124 | |
C CAN'T ATTACK BIRD BY THROWING AXE. | |
IF(HERE(BIRD).AND.VERB.NE.THROW)OBJ=BIRD | |
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.BEAR)SPK=165+(PROP(BEAR)+1)/2 | |
IF(OBJ.NE.DRAGON.OR.PROP(DRAGON).NE.0)GOTO 2011 | |
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.NE.'Y'.AND.WD1.NE.'YES')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 | |
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 | |
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 DSTROY(FOOD) | |
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)SPK=71 | |
GOTO 2011 | |
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.OR.LIQ(0).NE.WATER.OR..NOT.HERE(BOTTLE))GOTO 2011 | |
PROP(BOTTLE)=1 | |
PLACE(WATER)=0 | |
SPK=74 | |
GOTO 2011 | |
C RUB. YIELDS VARIOUS SNIDE REMARKS. | |
9160 IF(OBJ.NE.LAMP)SPK=76 | |
GOTO 2011 | |
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. (ONLY WAY TO DO SO!) | |
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(OBJ.GE.50.AND.OBJ.LE.MAXTRS.AND.AT(TROLL))GOTO 9178 | |
IF(OBJ.EQ.FOOD.AND.HERE(BEAR))GOTO 9177 | |
IF(OBJ.NE.AXE)GOTO 9020 | |
DO 9171 I=1,5 | |
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 | |
OBJ=0 | |
GOTO 9120 | |
9172 SPK=48 | |
C IF SAVED NOT = -1, HE BYPASSED THE "START" CALL. | |
IF(RAN(3).EQ.0.OR.SAVED.NE.-1)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 | |
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 | |
C BUT THROWING FOOD IS ANOTHER STORY. | |
9177 OBJ=BEAR | |
GOTO 9210 | |
9178 SPK=159 | |
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 | |
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 | |
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 | |
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 | |
C FEED. IF BIRD, NO SEED. SNAKE, DRAGON, TROLL: QUIP. IF DWARF, MAKE HIM | |
C MAD. BEAR, SPECIAL. | |
9210 IF(OBJ.NE.BIRD)GOTO 9212 | |
SPK=100 | |
GOTO 2011 | |
9212 IF(OBJ.NE.SNAKE.AND.OBJ.NE.DRAGON.AND.OBJ.NE.TROLL)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.OR.CLOSED.OR..NOT.HERE(BIRD))GOTO 2011 | |
SPK=101 | |
CALL DSTROY(BIRD) | |
PROP(BIRD)=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 SPK=14 | |
GOTO 2011 | |
C FILL. BOTTLE MUST BE EMPTY, AND SOME LIQUID AVAILABLE. (VASE IS NASTY.) | |
9220 IF(OBJ.EQ.VASE)GOTO 9222 | |
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 | |
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 | |
C SCORE. GO TO SCORING SECTION, WHICH WILL RETURN TO 8241 IF SCORNG IS TRUE. | |
8240 SCORNG=.TRUE. | |
GOTO 20000 | |
8241 SCORNG=.FALSE. | |
TYPE 8243,SCORE,MXSCOR | |
8243 FORMAT(/' IF YOU WERE TO QUIT NOW, YOU WOULD SCORE',I4 | |
1 ,' OUT OF A POSSIBLE',I4,'.') | |
GAVEUP=YES(143,54,54) | |
GOTO 8185 | |
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 | |
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) | |
1 PROP(TROLL)=1 | |
K=2 | |
IF(HERE(EGGS))K=1 | |
IF(LOC.EQ.PLAC(EGGS))K=0 | |
CALL MOVE(EGGS,PLAC(EGGS)) | |
CALL PSPEAK(EGGS,K) | |
GOTO 2012 | |
C BRIEF. INTRANSITIVE ONLY. SUPPRESS LONG DESCRIPTIONS AFTER FIRST TIME. | |
8260 SPK=156 | |
ABBNUM=10000 | |
DETAIL=3 | |
GOTO 2011 | |
C READ. MAGAZINES IN DWARVISH, 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(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.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 | |
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 | |
C WAKE. ONLY USE IS TO DISTURB THE DWARVES. | |
9290 IF(OBJ.NE.DWARF.OR..NOT.CLOSED)GOTO 2011 | |
CALL RSPEAK(199) | |
GOTO 19000 | |
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 SPK=201 | |
IF(DEMO)GOTO 2011 | |
TYPE 8302,LATNCY | |
8302 FORMAT(/' I CAN SUSPEND YOUR ADVENTURE FOR YOU SO THAT YOU CAN', | |
1 ' RESUME LATER, BUT'/' YOU WILL HAVE TO WAIT AT LEAST', | |
2 I3,' MINUTES BEFORE CONTINUING.') | |
IF(.NOT.YES(200,54,54))GOTO 2012 | |
CALL DATIME(SAVED,SAVET) | |
SETUP=-1 | |
CALL CIAO | |
8305 YEA=START(0) | |
SETUP=3 | |
K=NULL | |
GOTO 8 | |
C HOURS. REPORT CURRENT NON-PRIME-TIME HOURS. | |
8310 CALL MSPEAK(6) | |
CALL HOURS | |
GOTO 2012 | |
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 GOTO (40400,40500,40600,40700,40800,40900)(HINT-3) | |
C CAVE BIRD SNAKE MAZE DARK WITT | |
CALL BUG(27) | |
40010 HINTLC(HINT)=0 | |
IF(.NOT.YES(HINTS(HINT,3),0,54))GOTO 2602 | |
TYPE 40012,HINTS(HINT,2) | |
40012 FORMAT(/' I AM PREPARED TO GIVE YOU A HINT, BUT IT WILL COST YOU', | |
1 I2,' 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 2602 | |
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 | |
C CAVE CLOSING AND SCORING | |
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 | |
C MUST HAVE BEEN ACTIVATED, SINCE WE'VE FOUND CHEST. | |
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 | |
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 | |
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 | |
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 IFE'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 | |
C AND, OF COURSE, DEMO GAMES ARE ENDED BY THE WIZARD. | |
13000 CALL MSPEAK(1) | |
GOTO 20000 | |
C OH DEAR, HE'S DISTURBED THE DWARVES. | |
19000 CALL RSPEAK(136) | |
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 144 | |
C SURVIVING (MAX-NUM)*10 30 | |
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: 350 | |
C (POINTS CAN ALSO BE DEDUCTED FOR USING HINTS.) | |
20000 SCORE=0 | |
MXSCOR=0 | |
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 | |
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 | |
C DID HE COME TO WITT'S END AS HE SHOULD? | |
IF(PLACE(MAGZIN).EQ.108)SCORE=SCORE+1 | |
MXSCOR=MXSCOR+1 | |
C ROUND IT OFF. | |
SCORE=SCORE+2 | |
MXSCOR=MXSCOR+2 | |
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) | |
C RETURN TO SCORE COMMAND IF THAT'S WHERE WE CAME FROM. | |
IF(SCORNG)GOTO 8241 | |
C THAT SHOULD BE GOOD ENOUGH. LET'S TELL HIM ALL ABOUT IT. | |
TYPE 20100,SCORE,MXSCOR,TURNS | |
20100 FORMAT(///' YOU SCORED',I4,' OUT OF A POSSIBLE',I4, | |
1 ', USING',I5,' TURNS.') | |
DO 20200 I=1,CLSSES | |
IF(CVAL(I).GE.SCORE)GOTO 20210 | |
20200 CONTINUE | |
TYPE 20202 | |
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 | |
KK='S.' | |
IF(K.EQ.1)KK='. ' | |
TYPE 20212,K,KK | |
20212 FORMAT(/' TO ACHIEVE THE NEXT HIGHER RATING, YOU NEED',I3, | |
1 ' MORE POINT',A2/) | |
GOTO 25000 | |
20220 TYPE 20222 | |
20222 FORMAT(/' TO ACHIEVE THE NEXT HIGHER RATING ', | |
1 'WOULD BE A NEAT TRICK!'//' CONGRATULATIONS!!'/) | |
25000 STOP | |
END | |
C I/O ROUTINES (SPEAK, PSPEAK, RSPEAK, GETIN, YES, A5TOA1) | |
SUBROUTINE SPEAK(N) | |
C PRINT THE MESSAGE WHICH STARTS AT LINES(N). PRECEDE IT WITH A BLANK LINE | |
C UNLESS BLKLIN IS FALSE. | |
IMPLICIT INTEGER(A-Z) | |
LOGICAL BLKLIN | |
COMMON /TXTCOM/ RTEXT,LINES | |
COMMON /BLKCOM/ BLKLIN | |
DIMENSION RTEXT(205),LINES(9650) | |
IF(N.EQ.0)RETURN | |
IF(LINES(N+1).EQ.'>$<')RETURN | |
IF(BLKLIN)TYPE 2 | |
K=N | |
1 L=IABS(LINES(K))-1 | |
K=K+1 | |
TYPE 2,(LINES(I),I=K,L) | |
2 FORMAT(' ',14A5) | |
K=L+1 | |
IF(LINES(K).GE.0)GOTO 1 | |
RETURN | |
END | |
SUBROUTINE PSPEAK(MSG,SKIP) | |
C FIND THE SKIP+1ST MESSAGE FROM MSG AND PRINT IT. MSG SHOULD BE THE INDEX OF | |
C THE INVENTORY MESSAGE FOR OBJECT. (INVEN+N+1 MESSAGE IS PROP=N MESSAGE). | |
IMPLICIT INTEGER(A-Z) | |
COMMON /TXTCOM/ RTEXT,LINES | |
COMMON /PTXCOM/ PTEXT | |
DIMENSION RTEXT(205),LINES(9650),PTEXT(100) | |
M=PTEXT(MSG) | |
IF(SKIP.LT.0)GOTO 9 | |
DO 3 I=0,SKIP | |
1 M=IABS(LINES(M)) | |
IF(LINES(M).GE.0)GOTO 1 | |
3 CONTINUE | |
9 CALL SPEAK(M) | |
RETURN | |
END | |
SUBROUTINE RSPEAK(I) | |
C PRINT THE I-TH "RANDOM" MESSAGE (SECTION 6 OF DATABASE). | |
IMPLICIT INTEGER(A-Z) | |
COMMON /TXTCOM/ RTEXT | |
DIMENSION RTEXT(205) | |
IF(I.NE.0)CALL SPEAK(RTEXT(I)) | |
RETURN | |
END | |
SUBROUTINE MSPEAK(I) | |
C PRINT THE I-TH "MAGIC" MESSAGE (SECTION 12 OF DATABASE). | |
IMPLICIT INTEGER(A-Z) | |
COMMON /MTXCOM/ MTEXT | |
DIMENSION MTEXT(35) | |
IF(I.NE.0)CALL SPEAK(MTEXT(I)) | |
RETURN | |
END | |
SUBROUTINE GETIN(WORD1,WORD1X,WORD2,WORD2X) | |
C GET A COMMAND FROM THE ADVENTURER. SNARF OUT THE FIRST WORD, PAD IT WITH | |
C BLANKS, AND RETURN IT IN WORD1. CHARS 6 THRU 10 ARE RETURNED IN WORD1X, IN | |
C CASE WE NEED TO PRINT OUT THE WHOLE WORD IN AN ERROR MESSAGE. ANY NUMBER OF | |
C BLANKS MAY FOLLOW THE WORD. IF A SECOND WORD APPEARS, IT IS RETURNED IN | |
C WORD2 (CHARS 6 THRU 10 IN WORD2X), ELSE WORD2 IS SET TO ZERO. | |
IMPLICIT INTEGER(A-Z) | |
LOGICAL BLKLIN | |
COMMON /BLKCOM/ BLKLIN | |
DIMENSION A(5),MASKS(6) | |
DATA MASKS/"4000000000,"20000000,"100000,"400,"2,0/ | |
1 ,BLANKS/' '/ | |
IF(BLKLIN)TYPE 1 | |
1 FORMAT() | |
2 ACCEPT 3,(A(I),I=1,4) | |
3 FORMAT(4A5) | |
J=0 | |
DO 9 I=1,4 | |
IF(A(I).NE.BLANKS)J=1 | |
9 A(I)=A(I).AND.(SHIFT((A(I).AND.'@@@@@'),-1).XOR.-1) | |
IF(BLKLIN.AND.J.EQ.0)GOTO 2 | |
SECOND=0 | |
WORD1=A(1) | |
WORD1X=A(2) | |
WORD2=0 | |
DO 10 J=1,4 | |
DO 10 K=1,5 | |
MSK="774000000000 | |
IF(K.NE.1)MSK="177*MASKS(K) | |
IF(((A(J).XOR.BLANKS).AND.MSK).EQ.0)GOTO 15 | |
IF(SECOND.EQ.0)GOTO 10 | |
MSK=-MASKS(6-K) | |
WORD2=(SHIFT(A(J),7*(K-1)).AND.MSK) | |
1 +(SHIFT(A(J+1),7*(K-6)).AND.(-2-MSK)) | |
WORD2X=(SHIFT(A(J+1),7*(K-1)).AND.MSK) | |
1 +(SHIFT(A(J+2),7*(K-6)).AND.(-2-MSK)) | |
RETURN | |
15 IF(SECOND.EQ.1)GOTO 10 | |
SECOND=1 | |
IF(J.EQ.1)WORD1=(WORD1.AND.-MASKS(K)) | |
1 .OR.(BLANKS.AND.(-MASKS(K).XOR.-1)) | |
10 CONTINUE | |
RETURN | |
END | |
LOGICAL FUNCTION YES(X,Y,Z) | |
C CALL YESX (BELOW) WITH MESSAGES FROM SECTION 6. | |
IMPLICIT INTEGER(A-Z) | |
EXTERNAL RSPEAK | |
LOGICAL YESX | |
YES=YESX(X,Y,Z,RSPEAK) | |
RETURN | |
END | |
LOGICAL FUNCTION YESM(X,Y,Z) | |
C CALL YESX (BELOW) WITH MESSAGES FROM SECTION 12. | |
IMPLICIT INTEGER(A-Z) | |
EXTERNAL MSPEAK | |
LOGICAL YESX | |
YESM=YESX(X,Y,Z,MSPEAK) | |
RETURN | |
END | |
LOGICAL FUNCTION YESX(X,Y,Z,SPK) | |
C PRINT MESSAGE X, WAIT FOR YES/NO ANSWER. IF YES, PRINT Y AND LEAVE YEA | |
C TRUE; IF NO, PRINT Z AND LEAVE YEA FALSE. SPK IS EITHER RSPEAK OR MSPEAK. | |
IMPLICIT INTEGER(A-Z) | |
1 IF(X.NE.0)CALL SPK(X) | |
CALL GETIN(REPLY,JUNK1,JUNK2,JUNK3) | |
IF(REPLY.EQ.'YES'.OR.REPLY.EQ.'Y')GOTO 10 | |
IF(REPLY.EQ.'NO'.OR.REPLY.EQ.'N')GOTO 20 | |
TYPE 9 | |
9 FORMAT(/' PLEASE ANSWER THE QUESTION.') | |
GOTO 1 | |
10 YESX=.TRUE. | |
IF(Y.NE.0)CALL SPK(Y) | |
RETURN | |
20 YESX=.FALSE. | |
IF(Z.NE.0)CALL SPK(Z) | |
RETURN | |
END | |
SUBROUTINE A5TOA1(A,B,C,CHARS,LENG) | |
C A AND B CONTAIN A 1- TO 9-CHARACTER WORD IN A5 FORMAT, C CONTAINS ANOTHER | |
C WORD AND/OR PUNCTUATION. THEY ARE UNPACKED TO ONE CHARACTER PER WORD IN THE | |
C ARRAY "CHARS", WITH EXACTLY ONE BLANK BETWEEN B AND C (OR NONE, IF C >= 0). | |
C THE INDEX OF THE LAST NON-BLANK CHAR IN CHARS IS RETURNED IN LENG. | |
IMPLICIT INTEGER(A-Z) | |
DIMENSION CHARS(20),WORDS(3) | |
DATA MASK,BLANK/"774000000000,' '/ | |
WORDS(1)=A | |
WORDS(2)=B | |
WORDS(3)=C | |
POSN=1 | |
DO 1 WORD=1,3 | |
IF(WORD.EQ.2.AND.POSN.NE.6)GOTO 1 | |
IF(WORD.EQ.3.AND.C.LT.0)POSN=POSN+1 | |
DO 2 CH=1,5 | |
CHARS(POSN)=(WORDS(WORD).AND.MASK)+(BLANK-(BLANK.AND.MASK)) | |
IF(CHARS(POSN).EQ.BLANK)GOTO 1 | |
LENG=POSN | |
WORDS(WORD)=SHIFT(WORDS(WORD),7) | |
2 POSN=POSN+1 | |
1 CONTINUE | |
RETURN | |
END | |
C DATA STRUCTURE ROUTINES (VOCAB, DSTROY, JUGGLE, MOVE, PUT, CARRY, DROP) | |
INTEGER FUNCTION VOCAB(ID,INIT) | |
C LOOK UP ID IN THE VOCABULARY (ATAB) AND RETURN ITS "DEFINITION" (KTAB), OR | |
C -1 IF NOT FOUND. IF INIT IS POSITIVE, THIS IS AN INITIALISATION CALL SETTING | |
C UP A KEYWORD VARIABLE, AND NOT FINDING IT CONSTITUTES A BUG. IT ALSO MEANS | |
C THAT ONLY KTAB VALUES WHICH TAKEN OVER 1000 EQUAL INIT MAY BE CONSIDERED. | |
C (THUS "STEPS", WHICH IS A MOTION VERB AS WELL AS AN OBJECT, MAY BE LOCATED | |
C AS AN OBJECT.) AND IT ALSO MEANS THE KTAB VALUE IS TAKEN MOD 1000. | |
IMPLICIT INTEGER(A-Z) | |
COMMON /VOCCOM/ KTAB,ATAB,TABSIZ | |
DIMENSION KTAB(300),ATAB(300) | |
HASH=ID.XOR.'PHROG' | |
DO 1 I=1,TABSIZ | |
IF(KTAB(I).EQ.-1)GOTO 2 | |
IF(INIT.GE.0.AND.KTAB(I)/1000.NE.INIT)GOTO 1 | |
IF(ATAB(I).EQ.HASH)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(OBJECT) | |
C PERMANENTLY ELIMINATE "OBJECT" BY MOVING TO A NON-EXISTENT LOCATION. | |
IMPLICIT INTEGER(A-Z) | |
CALL MOVE(OBJECT,0) | |
RETURN | |
END | |
SUBROUTINE JUGGLE(OBJECT) | |
C JUGGLE AN OBJECT BY PICKING IT UP AND PUTTING IT DOWN AGAIN, THE PURPOSE | |
C BEING TO GET THE OBJECT TO THE FRONT OF THE CHAIN OF THINGS AT ITS LOC. | |
IMPLICIT INTEGER(A-Z) | |
COMMON /PLACOM/ ATLOC,LINK,PLACE,FIXED,HOLDNG | |
DIMENSION ATLOC(150),LINK(200),PLACE(100),FIXED(100) | |
I=PLACE(OBJECT) | |
J=FIXED(OBJECT) | |
CALL MOVE(OBJECT,I) | |
CALL MOVE(OBJECT+100,J) | |
RETURN | |
END | |
SUBROUTINE MOVE(OBJECT,WHERE) | |
C PLACE ANY OBJECT ANYWHERE BY PICKING IT UP AND DROPPING IT. MAY ALREADY BE | |
C TOTING, IN WHICH CASE THE CARRY IS A NO-OP. MUSTN'T PICK UP OBJECTS WHICH | |
C ARE NOT AT ANY LOC, SINCE CARRY WANTS TO REMOVE OBJECTS FROM ATLOC CHAINS. | |
IMPLICIT INTEGER(A-Z) | |
COMMON /PLACOM/ ATLOC,LINK,PLACE,FIXED,HOLDNG | |
DIMENSION ATLOC(150),LINK(200),PLACE(100),FIXED(100) | |
IF(OBJECT.GT.100)GOTO 1 | |
FROM=PLACE(OBJECT) | |
GOTO 2 | |
1 FROM=FIXED(OBJECT-100) | |
2 IF(FROM.GT.0.AND.FROM.LE.300)CALL CARRY(OBJECT,FROM) | |
CALL DROP(OBJECT,WHERE) | |
RETURN | |
END | |
INTEGER FUNCTION PUT(OBJECT,WHERE,PVAL) | |
C PUT IS THE SAME AS MOVE, EXCEPT IT RETURNS A VALUE USED TO SET UP THE | |
C NEGATED PROP VALUES FOR THE REPOSITORY OBJECTS. | |
IMPLICIT INTEGER(A-Z) | |
CALL MOVE(OBJECT,WHERE) | |
PUT=(-1)-PVAL | |
RETURN | |
END | |
SUBROUTINE CARRY(OBJECT,WHERE) | |
C START TOTING AN OBJECT, REMOVING IT FROM THE LIST OF THINGS AT ITS FORMER | |
C LOCATION. INCR HOLDNG UNLESS IT WAS ALREADY BEING TOTED. IF OBJECT>100 | |
C (MOVING "FIXED" SECOND LOC), DON'T CHANGE PLACE OR HOLDNG. | |
IMPLICIT INTEGER(A-Z) | |
COMMON /PLACOM/ ATLOC,LINK,PLACE,FIXED,HOLDNG | |
DIMENSION ATLOC(150),LINK(200),PLACE(100),FIXED(100) | |
IF(OBJECT.GT.100)GOTO 5 | |
IF(PLACE(OBJECT).EQ.-1)RETURN | |
PLACE(OBJECT)=-1 | |
HOLDNG=HOLDNG+1 | |
5 IF(ATLOC(WHERE).NE.OBJECT)GOTO 6 | |
ATLOC(WHERE)=LINK(OBJECT) | |
RETURN | |
6 TEMP=ATLOC(WHERE) | |
7 IF(LINK(TEMP).EQ.OBJECT)GOTO 8 | |
TEMP=LINK(TEMP) | |
GOTO 7 | |
8 LINK(TEMP)=LINK(OBJECT) | |
RETURN | |
END | |
SUBROUTINE DROP(OBJECT,WHERE) | |
C PLACE AN OBJECT AT A GIVEN LOC, PREFIXING IT ONTO THE ATLOC LIST. DECR | |
C HOLDNG IF THE OBJECT WAS BEING TOTED. | |
IMPLICIT INTEGER(A-Z) | |
COMMON /PLACOM/ ATLOC,LINK,PLACE,FIXED,HOLDNG | |
DIMENSION ATLOC(150),LINK(200),PLACE(100),FIXED(100) | |
IF(OBJECT.GT.100)GOTO 1 | |
IF(PLACE(OBJECT).EQ.-1)HOLDNG=HOLDNG-1 | |
PLACE(OBJECT)=WHERE | |
GOTO 2 | |
1 FIXED(OBJECT-100)=WHERE | |
2 IF(WHERE.LE.0)RETURN | |
LINK(OBJECT)=ATLOC(WHERE) | |
ATLOC(WHERE)=OBJECT | |
RETURN | |
END | |
C WIZARDRY ROUTINES (START, MAINT, WIZARD, HOURS(X), NEWHRS(X), MOTD, POOF) | |
LOGICAL FUNCTION START(DUMMY) | |
C CHECK TO SEE IF THIS IS "PRIME TIME". IF SO, ONLY WIZARDS MAY PLAY, THOUGH | |
C OTHERS MAY BE ALLOWED A SHORT GAME FOR DEMONSTRATION PURPOSES. IF SETUP<0, | |
C WE'RE CONTINUING FROM A SAVED GAME, SO CHECK FOR SUITABLE LATENCY. RETURN | |
C TRUE IF THIS IS A DEMO GAME (VALUE IS IGNORED FOR RESTARTS). | |
IMPLICIT INTEGER(A-Z) | |
LOGICAL PTIME,SOON,YESM | |
DIMENSION HNAME(4) | |
COMMON /WIZCOM/ WKDAY,WKEND,HOLID,HBEGIN,HEND,HNAME, | |
1 SHORT,MAGIC,MAGNM,LATNCY,SAVED,SAVET,SETUP | |
C FIRST FIND OUT WHETHER IT IS PRIME TIME (SAVE IN PTIME) AND, IF RESTARTING, | |
C WHETHER IT'S TOO SOON (SAVE IN SOON). PRIME-TIME SPECS ARE IN WKDAY, WKEND, | |
C AND HOLID; SEE MAINT ROUTINE FOR DETAILS. LATNCY IS REQUIRED DELAY BEFORE | |
C RESTARTING. WIZARDS MAY CUT THIS TO A THIRD. | |
CALL DATIME(D,T) | |
PRIMTM=WKDAY | |
IF(MOD(D,7).LE.1)PRIMTM=WKEND | |
IF(D.GE.HBEGIN.AND.D.LE.HEND)PRIMTM=HOLID | |
PTIME=(PRIMTM.AND.SHIFT(1,T/60)).NE.0 | |
SOON=.FALSE. | |
IF(SETUP.GE.0)GOTO 20 | |
DELAY=(D-SAVED)*1440+(T-SAVET) | |
IF(DELAY.GE.LATNCY)GOTO 20 | |
TYPE 10,DELAY | |
10 FORMAT(' THIS ADVENTURE WAS SUSPENDED A MERE',I3,' MINUTES AGO.') | |
SOON=.TRUE. | |
GOTO 20 | |
CALL MSPEAK(2) | |
STOP | |
C IF NEITHER TOO SOON NOR PRIME TIME, NO PROBLEM. ELSE SPECIFY WHAT'S WRONG. | |
20 START=.FALSE. | |
IF(SOON)GOTO 30 | |
IF(PTIME)GOTO 25 | |
22 SAVED=-1 | |
RETURN | |
C COME HERE IF NOT RESTARTING TOO SOON (MAYBE NOT RESTARTING AT ALL), BUT IT'S | |
C PRIME TIME. GIVE OUR HOURS AND SEE IF HE'S A WIZARD. IF NOT, THEN CAN'T | |
C RESTART, BUT IF JUST BEGINNING THEN WE CAN OFFER A SHORT GAME. | |
25 CALL MSPEAK(3) | |
CALL HOURS | |
CALL MSPEAK(4) | |
IF(WIZARD(0))GOTO 22 | |
IF(SETUP.LT.0)GOTO 33 | |
START=YESM(5,7,7) | |
IF(START)GOTO 22 | |
STOP | |
C COME HERE IF RESTARTING TOO SOON. IF HE'S A WIZARD, LET HIM GO (AND NOTE | |
C THAT IT THEN DOESN'T MATTER WHETHER IT'S PRIME TIME). ELSE, TOUGH BEANS. | |
30 CALL MSPEAK(8) | |
IF(WIZARD(0))GOTO 22 | |
33 CALL MSPEAK(9) | |
STOP | |
END | |
SUBROUTINE MAINT | |
C SOMEONE SAID THE MAGIC WORD TO INVOKE MAINTENANCE MODE. MAKE SURE HE'S A | |
C WIZARD. IF SO, LET HIM TWEAK ALL SORTS OF RANDOM THINGS, THEN EXIT SO CAN | |
C SAVE TWEAKED VERSION. SINCE MAGIC WORD MUST BE FIRST COMMAND GIVEN, ONLY | |
C THING WHICH NEEDS TO BE FIXED UP IS ABB(1). | |
IMPLICIT INTEGER(A-Z) | |
LOGICAL YESM,BLKLIN | |
DIMENSION HNAME(4),ABB(150) | |
COMMON /BLKCOM/ BLKLIN | |
COMMON /ABBCOM/ ABB | |
COMMON /WIZCOM/ WKDAY,WKEND,HOLID,HBEGIN,HEND,HNAME, | |
1 SHORT,MAGIC,MAGNM,LATNCY,SAVED,SAVET,SETUP | |
IF(.NOT.WIZARD(0))RETURN | |
BLKLIN=.FALSE. | |
IF(YESM(10,0,0))CALL HOURS | |
IF(YESM(11,0,0))CALL NEWHRS | |
IF(.NOT.YESM(26,0,0))GOTO 10 | |
CALL MSPEAK(27) | |
ACCEPT 1,HBEGIN | |
1 FORMAT(G) | |
CALL MSPEAK(28) | |
ACCEPT 1,HEND | |
CALL DATIME(D,T) | |
HBEGIN=HBEGIN+D | |
HEND=HBEGIN+HEND-1 | |
CALL MSPEAK(29) | |
ACCEPT 2,HNAME | |
2 FORMAT(4A5) | |
10 TYPE 12,SHORT | |
12 FORMAT(' LENGTH OF SHORT GAME (NULL TO LEAVE AT',I3,'):') | |
ACCEPT 1,X | |
IF(X.GT.0)SHORT=X | |
CALL MSPEAK(12) | |
CALL GETIN(X,Y,Y,Y) | |
IF(X.NE.' ')MAGIC=X | |
CALL MSPEAK(13) | |
ACCEPT 1,X | |
IF(X.GT.0)MAGNM=X | |
TYPE 16,LATNCY | |
16 FORMAT(' LATENCY FOR RESTART (NULL TO LEAVE AT',I3,'):') | |
ACCEPT 1,X | |
IF(X.GT.0.AND.X.LT.45)CALL MSPEAK(30) | |
IF(X.GT.0)LATNCY=MAX0(45,X) | |
IF(YESM(14,0,0))CALL MOTD(.TRUE.) | |
SAVED=0 | |
SETUP=2 | |
ABB(1)=0 | |
CALL MSPEAK(15) | |
BLKLIN=.TRUE. | |
CALL CIAO | |
END | |
LOGICAL FUNCTION WIZARD(DUMMY) | |
C ASK IF HE'S A WIZARD. IF HE SAYS YES, MAKE HIM PROVE IT. RETURN TRUE IF HE | |
C REALLY IS A WIZARD. | |
IMPLICIT INTEGER(A-Z) | |
LOGICAL YESM | |
DIMENSION HNAME(4),VAL(5) | |
COMMON /WIZCOM/ WKDAY,WKEND,HOLID,HBEGIN,HEND,HNAME, | |
1 SHORT,MAGIC,MAGNM,LATNCY,SAVED,SAVET,SETUP | |
WIZARD=YESM(16,0,7) | |
IF(.NOT.WIZARD)RETURN | |
C HE SAYS HE IS. FIRST STEP: DOES HE KNOW ANYTHING MAGICAL? | |
CALL MSPEAK(17) | |
CALL GETIN(WORD,X,Y,Z) | |
IF(WORD.NE.MAGIC)GOTO 99 | |
C HE DOES. GIVE HIM A RANDOM CHALLENGE AND CHECK HIS REPLY. | |
CALL DATIME(D,T) | |
T=T*2+1 | |
WORD='@@@@@' | |
DO 15 Y=1,5 | |
X=79+MOD(D,5) | |
D=D/5 | |
DO 12 Z=1,X | |
12 T=MOD(T*1027,1048576) | |
VAL(Y)=(T*26)/1048576+1 | |
15 WORD=WORD+SHIFT(VAL(Y),36-7*Y) | |
IF(YESM(18,0,0))GOTO 99 | |
TYPE 18,WORD | |
18 FORMAT(/1X,A5) | |
CALL GETIN(WORD,X,Y,Z) | |
CALL DATIME(D,T) | |
T=(T/60)*40+(T/10)*10 | |
D=MAGNM | |
DO 19 Y=1,5 | |
Z=MOD(Y,5)+1 | |
X=MOD(IABS(VAL(Y)-VAL(Z))*MOD(D,10)+MOD(T,10),26)+1 | |
T=T/10 | |
D=D/10 | |
19 WORD=WORD-SHIFT(X,36-7*Y) | |
C IF(WORD.NE.'@@@@@')GOTO 99 | |
C BY GEORGE, HE REALLY *IS* A WIZARD! | |
CALL MSPEAK(19) | |
RETURN | |
C AHA! AN IMPOSTOR! | |
99 CALL MSPEAK(20) | |
WIZARD=.FALSE. | |
RETURN | |
END | |
SUBROUTINE HOURS | |
C ANNOUNCE THE CURRENT HOURS WHEN THE CAVE IS OPEN FOR ADVENTURING. THIS INFO | |
C IS STORED IN WKDAY, WKEND, AND HOLID, WHERE BIT SHIFT(1,N) IS ON IFF THE | |
C HOUR FROM N:00 TO N:59 IS "PRIME TIME" (CAVE CLOSED). WKDAY IS FOR | |
C WEEKDAYS, WKEND FOR WEEKENDS, HOLID FOR HOLIDAYS. NEXT HOLIDAY IS FROM | |
C HBEGIN TO HEND. | |
IMPLICIT INTEGER(A-Z) | |
DIMENSION HNAME(4),VAL(5) | |
COMMON /WIZCOM/ WKDAY,WKEND,HOLID,HBEGIN,HEND,HNAME | |
TYPE 1 | |
1 FORMAT() | |
CALL HOURSX(WKDAY,'MON -',' FRI:') | |
CALL HOURSX(WKEND,'SAT -',' SUN:') | |
CALL HOURSX(HOLID,'HOLID','AYS: ') | |
CALL DATIME(D,T) | |
IF(HEND.LT.D.OR.HEND.LT.HBEGIN)RETURN | |
IF(HBEGIN.GT.D)GOTO 10 | |
TYPE 5,HNAME | |
5 FORMAT(/' TODAY IS A HOLIDAY, NAMELY ',4A5) | |
RETURN | |
10 D=HBEGIN-D | |
T='DAYS,' | |
IF(D.EQ.1)T='DAY, ' | |
TYPE 15,D,T,HNAME | |
15 FORMAT(/' THE NEXT HOLIDAY WILL BE IN',I3,' ',A5,' NAMELY ',4A5) | |
RETURN | |
END | |
SUBROUTINE HOURSX(H,DAY1,DAY2) | |
C USED BY HOURS (ABOVE) TO PRINT HOURS FOR EITHER WEEKDAYS OR WEEKENDS. | |
IMPLICIT INTEGER(A-Z) | |
LOGICAL FIRST | |
FIRST=.TRUE. | |
FROM=-1 | |
IF(H.NE.0)GOTO 10 | |
TYPE 2,DAY1,DAY2 | |
2 FORMAT(10X,2A5,' OPEN ALL DAY') | |
RETURN | |
10 FROM=FROM+1 | |
IF((H.AND.SHIFT(1,FROM)).NE.0)GOTO 10 | |
IF(FROM.GE.24)GOTO 20 | |
TILL=FROM | |
14 TILL=TILL+1 | |
IF((H.AND.SHIFT(1,TILL)).EQ.0.AND.TILL.NE.24)GOTO 14 | |
IF(FIRST)TYPE 16,DAY1,DAY2,FROM,TILL | |
IF(.NOT.FIRST)TYPE 18,FROM,TILL | |
16 FORMAT(10X,2A5,I4,':00 TO',I3,':00') | |
18 FORMAT(20X,I4,':00 TO',I3,':00') | |
FIRST=.FALSE. | |
FROM=TILL | |
GOTO 10 | |
20 IF(FIRST)TYPE 22,DAY1,DAY2 | |
22 FORMAT(10X,2A5,' CLOSED ALL DAY') | |
RETURN | |
END | |
SUBROUTINE NEWHRS | |
C SET UP NEW HOURS FOR THE CAVE. SPECIFIED AS INVERSE--I.E., WHEN IS IT | |
C CLOSED DUE TO PRIME TIME? SEE HOURS (ABOVE) FOR DESC OF VARIABLES. | |
IMPLICIT INTEGER(A-Z) | |
DIMENSION HNAME(4) | |
COMMON /WIZCOM/ WKDAY,WKEND,HOLID,HBEGIN,HEND,HNAME | |
CALL MSPEAK(21) | |
WKDAY=NEWHRX('WEEKD','AYS:') | |
WKEND=NEWHRX('WEEKE','NDS:') | |
HOLID=NEWHRX('HOLID','AYS:') | |
CALL MSPEAK(22) | |
CALL HOURS | |
RETURN | |
END | |
INTEGER FUNCTION NEWHRX(DAY1,DAY2) | |
C INPUT PRIME TIME SPECS AND SET UP A WORD OF INTERNAL FORMAT. | |
IMPLICIT INTEGER(A-Z) | |
NEWHRX=0 | |
TYPE 1,DAY1,DAY2 | |
1 FORMAT(' PRIME TIME ON ',2A5) | |
10 TYPE 2 | |
2 FORMAT(' FROM:') | |
ACCEPT 3,FROM | |
3 FORMAT(G) | |
IF(FROM.LT.0.OR.FROM.GE.24)RETURN | |
TYPE 4 | |
4 FORMAT(' TILL:') | |
ACCEPT 3,TILL | |
TILL=TILL-1 | |
IF(TILL.LT.FROM.OR.TILL.GE.24)RETURN | |
DO 5 I=FROM,TILL | |
IDONDX=I | |
5 NEWHRX=(NEWHRX.OR.SHIFT(1,IDONDX)) | |
GOTO 10 | |
END | |
SUBROUTINE MOTD(ALTER) | |
C HANDLES MESSAGE OF THE DAY. IF ALTER IS TRUE, READ A NEW MESSAGE FROM THE | |
C WIZARD. ELSE PRINT THE CURRENT ONE. MESSAGE IS INITIALLY NULL. | |
IMPLICIT INTEGER(A-Z) | |
LOGICAL ALTER | |
DIMENSION MSG(100) | |
DATA MSG/100*-1/ | |
IF(ALTER)GOTO 50 | |
K=1 | |
10 IF(MSG(K).LT.0)RETURN | |
TYPE 20,(MSG(I),I=K+1,MSG(K)-1) | |
20 FORMAT(' ',14A5) | |
K=MSG(K) | |
GOTO 10 | |
50 M=1 | |
CALL MSPEAK(23) | |
55 ACCEPT 56,(MSG(I),I=M+1,M+14),K | |
56 FORMAT(15A5) | |
IF(K.EQ.' ')GOTO 60 | |
CALL MSPEAK(24) | |
GOTO 55 | |
60 DO 62 I=1,14 | |
K=M+15-I | |
IF(MSG(K).NE.' ')GOTO 65 | |
62 CONTINUE | |
GOTO 90 | |
65 MSG(M)=K+1 | |
M=K+1 | |
IF(M+14.LT.100)GOTO 55 | |
CALL MSPEAK(25) | |
90 MSG(M)=-1 | |
RETURN | |
END | |
SUBROUTINE POOF | |
C AS PART OF DATABASE INITIALISATION, WE CALL POOF TO SET UP SOME DUMMY | |
C PRIME-TIME SPECS, MAGIC WORDS, ETC. | |
IMPLICIT INTEGER(A-Z) | |
DIMENSION HNAME(4) | |
COMMON /WIZCOM/ WKDAY,WKEND,HOLID,HBEGIN,HEND,HNAME, | |
1 SHORT,MAGIC,MAGNM,LATNCY,SAVED,SAVET,SETUP | |
WKDAY="00777400 | |
WKEND=0 | |
HOLID=0 | |
HBEGIN=0 | |
HEND=-1 | |
SHORT=30 | |
MAGIC='DWARF' | |
MAGNM=11111 | |
LATNCY=90 | |
RETURN | |
END | |
C UTILITY ROUTINES (SHIFT, RAN, DATIME, CIAO, BUG) | |
INTEGER FUNCTION SHIFT(VAL,DIST) | |
IMPLICIT INTEGER(A-Z) | |
C RETURN VAL LEFT-SHIFTED (LOGICALLY) DIST BITS (RIGHT-SHIFT IF DIST<0). | |
SHIFT=VAL | |
IF(DIST)10,20,30 | |
10 IDIST=-DIST | |
DO 11 I=1,IDIST | |
J=0 | |
IF(SHIFT.LT.0)J="200000000000 | |
11 SHIFT=((SHIFT.AND."377777777777)/2)+J | |
20 RETURN | |
30 DO 31 I=1,DIST | |
J=0 | |
IF((SHIFT.AND."200000000000).NE.0)J="400000000000 | |
31 SHIFT=(SHIFT.AND."177777777777)*2+J | |
RETURN | |
END | |
INTEGER FUNCTION RAN(RANGE) | |
C SINCE THE RAN FUNCTION IN LIB40 SEEMS TO BE A REAL LOSE, WE'LL USE ONE OF | |
C OUR OWN. IT'S BEEN RUN THROUGH MANY OF THE TESTS IN KNUTH VOL. 2 AND | |
C SEEMS TO BE QUITE RELIABLE. RAN RETURNS A VALUE UNIFORMLY SELECTED | |
C BETWEEN 0 AND RANGE-1. NOTE RESEMBLANCE TO ALG USED IN WIZARD. | |
IMPLICIT INTEGER(A-Z) | |
DATA R/0/ | |
D=1 | |
IF(R.NE.0)GOTO 1 | |
CALL DATIME(D,T) | |
R=18*T+5 | |
D=1000+MOD(D,1000) | |
1 DO 2 T=1,D | |
2 R=MOD(R*1021,1048576) | |
RAN=(RANGE*R)/1048576 | |
RETURN | |
END | |
SUBROUTINE DATIME(D,T) | |
C RETURN THE DATE AND TIME IN D AND T. D IS NUMBER OF DAYS SINCE 01-JAN-77, | |
C T IS MINUTES PAST MIDNIGHT. THIS IS HARDER THAN IT SOUNDS, BECAUSE THE | |
C FINAGLED DEC FUNCTIONS RETURN THE VALUES ONLY AS ASCII STRINGS! | |
IMPLICIT INTEGER(A-Z) | |
DIMENSION DAT(2),MONTHS(12),HATH(12) | |
DATA MONTHS/'-JAN-','-FEB-','-MAR-','-APR-','-MAY-','-JUN-', | |
1 '-JUL-','-AUG-','-SEP-','-OCT-','-NOV-','-DEC-'/ | |
DATA HATH/31,28,31,30,31,30,31,31,30,31,30,31/ | |
C FUNCTION I2 TAKES 2-DIGIT ASCII AND YIELDS DECIMAL VALUE. | |
I2(X)=(SHIFT(X,-29).AND.15)*10+(SHIFT(X,-22).AND.15) | |
CALL DATE(DAT) | |
CALL TIME(TIM) | |
YEAR=I2(SHIFT(DAT(2),14))-77 | |
D=I2(DAT(1))-1 | |
X=((SHIFT(DAT(1),14).OR.SHIFT(DAT(2),-21)).AND..NOT."1004020001) | |
1 .OR.'-@@@-' | |
C ABOVE FUNNY EXPRESSION GUARANTEES (A) UPPER-CASE, AND (B) BOTTOM BIT OKAY. | |
DO 1 MON=1,12 | |
IF(X.EQ.MONTHS(MON))GOTO 2 | |
1 D=D+HATH(MON) | |
CALL BUG(28) | |
2 D=D+YEAR*365+YEAR/4 | |
IF(MOD(YEAR,4).EQ.3.AND.MON.GT.2)D=D+1 | |
T=I2(TIM)*60+I2(SHIFT(TIM,21)) | |
RETURN | |
END | |
SUBROUTINE CIAO | |
C EXITS, AFTER ISSUING REMINDER TO SAVE NEW CORE IMAGE. USED WHEN SUSPENDING | |
C AND WHEN CREATING NEW VERSION VIA MAGIC MODE. ON SOME SYSTEMS, THE CORE | |
C IMAGE IS LOST ONCE THE PROGRAM EXITS. IF SO, SET K=31 INSTEAD OF 32. | |
IMPLICIT INTEGER(A-Z) | |
DATA K/32/ | |
CALL MSPEAK(K) | |
IF(K.EQ.31)CALL GETIN(A,B,C,D) | |
STOP | |
END | |
SUBROUTINE BUG(NUM) | |
IMPLICIT INTEGER(A-Z) | |
C THE FOLLOWING CONDITIONS ARE CURRENTLY CONSIDERED FATAL BUGS. NUMBERS < 20 | |
C ARE DETECTED WHILE READING THE DATABASE; THE OTHERS OCCUR AT "RUN TIME". | |
C 0 MESSAGE LINE > 70 CHARACTERS | |
C 1 NULL LINE IN MESSAGE | |
C 2 TOO MANY WORDS OF MESSAGES | |
C 3 TOO MANY TRAVEL OPTIONS | |
C 4 TOO MANY VOCABULARY WORDS | |
C 5 REQUIRED VOCABULARY WORD NOT FOUND | |
C 6 TOO MANY RTEXT OR MTEXT MESSAGES | |
C 7 TOO MANY HINTS | |
C 8 LOCATION HAS COND BIT BEING SET TWICE | |
C 9 INVALID SECTION NUMBER IN DATABASE | |
C 20 SPECIAL TRAVEL (500>L>300) EXCEEDS GOTO LIST | |
C 21 RAN OFF END OF VOCABULARY TABLE | |
C 22 VOCABULARY TYPE (N/1000) NOT BETWEEN 0 AND 3 | |
C 23 INTRANSITIVE ACTION VERB EXCEEDS GOTO LIST | |
C 24 TRANSITIVE ACTION VERB EXCEEDS GOTO LIST | |
C 25 CONDITIONAL TRAVEL ENTRY WITH NO ALTERNATIVE | |
C 26 LOCATION HAS NO TRAVEL ENTRIES | |
C 27 HINT NUMBER EXCEEDS GOTO LIST | |
C 28 INVALID MONTH RETURNED BY DATE FUNCTION | |
TYPE 1, NUM | |
1 FORMAT (' FATAL ERROR, SEE SOURCE CODE FOR INTERPRETATION.'/ | |
1 ' PROBABLE CAUSE: ERRONEOUS INFO IN DATABASE.'/ | |
2 ' ERROR CODE =',I2/) | |
STOP | |
END |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment