File: INITAD.LS of Disk: V50/Source/Source-Listing-FORTRAN-2
(Source file text)
FORTRAN IV V50-A (A6) 24-JUL-20
C ADVENTURES
0002 SUBROUTINE INIT
C
C MODIFIED BY KENT BLACKETT
C ENGINEERING SYSTEMS GROUP
C DIGITAL EQUIPMENT CORP.
C 15-JUL-77
C MODIFIED BY BOB SUPNIK
C DISK ENGINEERING
C 21-OCT-77
C MODIFIED BY BOB SUPNIK
C DISK ENGINEERING
C 25-AUG-78
C MODIFIED BY BOB SUPNIK
C SMALL SYSTEMS
C 12-NOV-78
C ORIGINAL VERSION WAS FOR DECSYSTEM-10
C NEXT VERSION WAS FOR FORTRAN IV-PLUS UNDER
C THE IAS OPERATING SYSTEM ON THE PDP-11/70
C THIS VERSION IS FOR FORTRAN IV (V01C OR LATER)
C UNDER RT-11 ON *ANY* PDP-11
C
C
C CURRENT LIMITS:
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 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
C IMPLICIT INTEGER (A-Z)
0003 LOGICAL LMWARN,CLOSNG,PANIC,HINTED,
1 CLOSED,GAVEUP,SCORNG,DSEEN,BITSET
C
0004 LOGICAL WRITN
0005 COMMON /VERSN/ VMAJ, VMIN, VEDIT
0006 COMMON /FILES/ INDXNM, TEXTNM, SAVENM, INPTNM
0007 COMMON /TXTCOM/ RTEXT,LINES,ASCVAR,TXTLOC,DATA
0010 COMMON /VOCCOM/ KTAB,ATAB,TABSIZ
0011 COMMON /PLACOM/ ATLOC,LINK,PLACE,FIXED,HOLDNG
0012 COMMON /PTXCOM/ PTEXT
0013 COMMON /ABBCOM/ ABB
0014 COMMON /MISCOM/ LINUSE,TRVS,CLSSES,OLDLOC,LOC,CVAL,TK,NEWLOC,
1 KEY,PLAC,FIXD,ACTSPK,COND,HINTS,HNTMAX,PROP,TALLY,TALLY2,
2 HINTLC,CHLOC,CHLOC2,DSEEN,DFLAG,DLOC,DALTLC,KEYS,LAMP,GRATE
0015 COMMON /MISCOM/
3 CAGE,ROD,ROD2,STEPS,BIRD,DOOR,PILLOW,SNAKE,FISSUR,TABLET,
FORTRAN IV V50-A (A6) 24-JUL-20
4 CLAM,OYSTER,MAGZIN,DWARF,KNIFE,FOOD,BOTTLE,WATER,OIL,PLANT,
5 PLANT2,AXE,MIRROR,DRAGON,CHASM,TROLL,TROLL2,BEAR,MESSAG,VEND,
6 BATTER,NUGGET,COINS,CHEST,EGGS,TRIDNT,VASE,EMRALD,PYRAM
0016 COMMON /MISCOM/
7 PEARL,RUG,CHAIN,BACK,LOOK,CAVE,NULL,ENTRNC,DPRSSN,SAY,LOCK,
8 THROW,FIND,INVENT,TURNS,LMWARN,KNFLOC,DETAIL,ABBNUM,
9 NUMDIE,MAXDIE,DKILL,FOOBAR,BONUS,CLOCK1,CLOCK2,
1 CLOSNG,PANIC,CLOSED,GAVEUP,SCORNG,ODLOC,STREAM,SPICES
0017 COMMON /MISC2/ I,RTXSIZ,CLSMAX,LOCSIZ,CTEXT,STEXT,LTEXT,
1 SECT,TRAVEL,TRVCON,TRVLOC,TRVSIZ,TABNDX,OBJ,J,K,VERB,HNTSIZ,
2 MAXTRS,HINTED,HNTLOC,KK
C
0020 INTEGER LINES(12),DATA(78)
C The TRAVEL, TRVCON, and TRVLOC arrays are
C Packed with words 0,1,2 holding the data. Saves lots
C of wasted space at the expense of some complexity.
0021 INTEGER TRAVEL(250), TRVCON(250), TRVLOC(250), TRVSIZ
0022 INTEGER KTAB(300),ATAB(300),TABSIZ
0023 INTEGER LTEXT(150),STEXT(150),KEY(150),COND(150),ABB(150),
1 ATLOC(150)
0024 INTEGER PLAC(100),PLACE(100),FIXD(100),FIXED(100),LINK(200),
1 PTEXT(100),PROP(100),HOLDNG
0025 INTEGER ACTSPK(35)
0026 INTEGER RTEXT(205)
0027 INTEGER CTEXT(12),CVAL(12)
0030 INTEGER HINTLC(20),HINTS(20,4)
0031 DIMENSION HINTED(20)
0032 INTEGER TK(20),DLOC(6),ODLOC(6)
0033 DIMENSION DSEEN(6)
0034 INTEGER ASCVAR, TXTLOC, TRVS, CLSSES, OLDLOC
0035 INTEGER HNTSIZ, HNTMAX, TALLY, TALLY2, CHLOC, CHLOC2, DFLAG
0036 INTEGER DALTLC,GRATE,CAGE,ROD,ROD2,STEPS,BIRD,DOOR,PILLOW,SNAKE
0037 INTEGER FISSUR,TABLET,CLAM,OYSTER,MAGZIN,DWARF,KNIFE,FOOD,BOTTLE
0040 INTEGER WATER,OIL,PLANT,PLANT2,AXE,MIRROR,DRAGON,CHASM
0041 INTEGER BEAR,MESSAG,VEND,BATTER,COINS,CHEST,EGGS,TRIDNT,VASE,EMRALD
0042 INTEGER PYRAM,PEARL,RUG,CHAIN,BACK,LOOK,CAVE,NULL,ENTRNC,DPRSSN,SAY
0043 INTEGER LOCK,THROW,FIND,INVENT,TURNS,KNFLOC,DETAIL,ABBNUM
0044 INTEGER NUMDIE,MAXDIE,DKILL,FOOBAR,BONUS,CLOCK1,CLOCK2
0045 INTEGER TROLL,TROLL2,STREAM,SPICES
0046 INTEGER RTXSIZ,CLSMAX,LOCSIZ,SECT,TABNDX,OBJ
0047 INTEGER VERB,HNTLOC,KK
0050 INTEGER INDXNM(3),TEXTNM(3),SAVENM(3),INPTNM(3),CODE,NAME(3)
C
C
C ISHFT(NUMBER,IPOSIT)=NUMBER*(2**IPOSIT)
C BITSET(L,N)=(COND(L).AND.ISHFT(1,N)).NE.0
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 COMMA, AND A LINE OF TEXT. THE SET OF (NECESSARILY ADJACENT) LINES
C WHOSE NUMBERS ARE X FORM THE LONG DESCRIPTION OF LOCATION X.
FORTRAN IV V50-A (A6) 24-JUL-20
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
C IN THIS IMPLEMENTATION, THE SECOND LOCATION NUMBER Y HAS BEEN
C SPLIT INTO M, CONDITIONS, AND N, LOCATION.
C
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).
FORTRAN IV V50-A (A6) 24-JUL-20
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
C
0051 ISEED=0
C
C FILSIZ Was 900 for RT-11 but we pack 6 records per.
C
0052 FILSIZ=150
0053 TABSIZ=300
0054 LOCSIZ=150
0055 VRBSIZ=35
0056 RTXSIZ = 205
0057 HNTSIZ = 20
FORTRAN IV V50-A (A6) 24-JUL-20
0060 MAGSIZ = 35
0061 TRVSIZ = 750
0062 CLSMAX = 12
C VCNT = 0
CDEBUG WRITE(4,1000)
CDEBUG1000 FORMAT(' INITIALIZING...')
C
C FIRST, TRY TO RESTORE PRE-EXISTING COPY OF DATA BASE
C
0063 CALL USR(6,'ADVENT.IN',2,ERR)
0064 IF (ERR .EQ. 0) GOTO 30
0065 20 CALL SIXOUT('L]OCATION OF TEXT DATABASE ([ATEXT.DA]) >',21,2)
0066 WRITE(4,121)
0067 121 FORMAT('+',$)
0070 READ(4,21) TEXTNM
0071 21 FORMAT(3A6)
0072 IF (TEXTNM(1) .NE. ' ') GOTO 22
0073 TEXTNM(1) = 'ATEXT.'
0074 TEXTNM(2) = 'DA'
0075 TEXTNM(3) = ' '
0076 22 CALL SIXOUT('L]OCATION OF TEXT INDEX ([AINDX.DA]) >',21,2)
0077 WRITE(4,121)
0100 READ(4,21) INDXNM
0101 IF (INDXNM(1) .NE. ' ') GOTO 23
0102 INDXNM(1) = 'AINDX.'
0103 INDXNM(2) = 'DA'
0104 INDXNM(3) = ' '
0105 23 CALL SIXOUT('L]OCATION OF SAVED GAMES ([ASAVE.DA]) >',21,2)
0106 WRITE(4,121)
0107 READ(4,21) SAVENM
0110 IF (SAVENM(1) .NE. ' ') GOTO 24
0111 SAVENM(1) = 'ASAVE.'
0112 SAVENM(2) = 'DA'
0113 SAVENM(3) = ' '
0114 24 CALL SIXOUT('L]OCATION OF TEXT INPUT ([ADVENT.TX]) >',21,2)
0115 WRITE(4,121)
0116 READ(4,21)INPTNM
0117 IF (INPTNM(1) .NE. ' ') GOTO 25
0120 INPTNM(1) = 'ADVENT'
0121 INPTNM(2) = '.TX'
0122 INPTNM(3) = ' '
0123 25 CONTINUE
0124 CALL USR(6, 'ADVENT.IN',3,ERR)
0125 IF (ERR .NE. 0) WRITE(4,28)
0126 28 FORMAT(' CAN''T SAVE SETTINGS IN ADVENT.IN')
0127 IF (ERR.NE.0) GOTO 40
0130 WRITE(6, 29)INDXNM,TEXTNM,SAVENM,INPTNM
0131 29 FORMAT(' ADVENTURE SETUP FILE',/,
1 'INDX=',3A6,/,'TEXT=',3A6,/,'SAVE=',3A6,/,'INPT=',3A6)
0132 CALL USR(6, 'ADVENT.IN',4,ERR)
0133 GOTO 40
FORTRAN IV V50-A (A6) 24-JUL-20
0134 30 INDXNM(1) = 'AINDX.'
0135 INDXNM(2) = 'DA'
0136 INDXNM(3) = ' '
0137 TEXTNM(1) = 'ATEXT.'
0140 TEXTNM(2) = 'DA'
0141 TEXTNM(3) = ' '
0142 SAVENM(1) = 'ASAVE.'
0143 SAVENM(2) = 'DA'
0144 SAVENM(3) = ' '
0145 INPTNM(1) = 'ADVENT'
0146 INPTNM(2) = '.TX'
0147 INPTNM(3) = ' '
0150 31 CALL CHKEOF(EOF)
0151 READ(6, 32) CODE, NAME
0152 IF (EOF .NE. 0) GOTO 34
0153 32 FORMAT(A4,1X,3A6)
0154 DO 33 I = 1, 3
0155 IF (CODE .EQ. 'INDX') INDXNM(I) = NAME(I)
0156 IF (CODE .EQ. 'TEXT') TEXTNM(I) = NAME(I)
0157 IF (CODE .EQ. 'SAVE') SAVENM(I) = NAME(I)
0160 IF (CODE .EQ. 'INPT') INPTNM(I) = NAME(I)
0161 33 CONTINUE
0162 GO TO 31
0163 34 CONTINUE
0164 40 CALL RSTRGM(.FALSE.,I)
0165 IF(I.NE.0) GO TO 10
0166 CALL USR(8, TEXTNM, 2, ERR)
C
C If that can't be opened for input, gotta rebuild
C
0167 IF (ERR.NE.0) GOTO 10
C
C Hack to set the DEFINE FILE stuff up
C
0170 CALL SETIDL
C CALL USR(6, 'ADVENT.TX', 2, ERR)
C IF (ERR.EQ.0) GOTO 1235
C CALL SIXOUT('C]AN''T OPEN [ADVENT.TX] FOR INPUT, QUITTING!',23,0)
C STOP
0171 1235 WRITN = .FALSE.
0172 GO TO 5000
C
C CLEAR OUT THE VARIOUS TEXT-POINTER ARRAYS. ALL TEXT IS STORED IN DISK
C FILE (RANDOM ACCESS ON UNIT 2). THE TEXT-POINTER ARRAYS CONTAIN RECORD
C NUMBERS IN THE FILE. 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.
C
0173 WRITN = .TRUE.
0174 10 DO 1001 I=1,TABSIZ
0175 KTAB(I)=0
FORTRAN IV V50-A (A6) 24-JUL-20
0176 ATAB(I)=0
C
C A2TAB not used on the '8
C A2TAB(I)=0
0177 IF(I.GT.100) GO TO 1990
0200 PTEXT(I)=0
0201 PROP(I)=0
0202 PLAC(I)=0
0203 PLACE(I)=0
0204 FIXD(I)=0
0205 FIXED(I)=0
0206 LINK(I)=0
0207 LINK(I+100)=0
0210 1990 IF(I.LE.RTXSIZ)RTEXT(I)=0
0211 IF(I.LE.CLSMAX)CTEXT(I)=0
C IF(I.LE.MAGSIZ)MTEXT(I)=0
0212 IF(I.LE.VRBSIZ)ACTSPK(I)=0
0213 IF(I.GT.LOCSIZ)GOTO 1001
0214 KEY(I)=0
0215 ABB(I)=0
0216 ATLOC(I)=0
0217 STEXT(I)=0
0220 LTEXT(I)=0
0221 COND(I)=0
0222 1001 CONTINUE
C
0223 CALL USR(6, INPTNM, 2, ERR)
0224 IF(ERR.EQ.0)GOTO 1236
0225 CALL SIXOUT('C]AN''T OPEN ',6,2)
0226 CALL SIXOUT(INPTNM, 9, 3)
0227 CALL SIXOUT(' ]FOR INPUT!',6,1)
0230 STOP
0231 1236 CALL USR(8, TEXTNM, 3, ERR)
0232 IF (ERR.EQ.0) GOTO 1237
0233 CALL SIXOUT('C]AN''T OPEN ',6,2)
0234 CALL SIXOUT(TEXTNM, 9, 3)
0235 CALL SIXOUT(' ]FOR OUTPUT',6,1)
0236 STOP
C Below uses FILSIZ/3 for OS/8
0237 1237 DEFINE FILE 8(FILSIZ/3,78,U,RECORD)
0240 RECORD = 1
0241 ASCVAR = 1
0242 LINUSE=1
0243 TRVS=1
0244 CLSSES=1
C
C START NEW DATA SECTION. ISECT IS THE SECTION NUMBER.
C
0245 1002 READ(6,1003)ISECT
0246 1003 FORMAT(I5)
CDEBUG WRITE(4,930)ISECT
CDEBUG930 FORMAT(' NOW LOADING SECTION',I3)
0247 OLDLOC=-1
0250 GOTO(1100,1004,1004,1030,1040,1004,1004,1050,1060,1070,1004,
1 1080,1004) (ISECT+1)
FORTRAN IV V50-A (A6) 24-JUL-20
C (0) (1) (2) (3) (4) (5) (6) (7) (8) (9) (10)
C (11) (12)
0251 CALL BUG(9)
C
C SECTIONS 1, 2, 5, 6, 10, 12. READ MESSAGES AND SET UP POINTERS.
C
0252 1004 READ(6,1005) LOC,LINES
0253 1005 FORMAT(I4,12A6)
C WRITE(8'ASCVAR) LOC,LINES
0254 MULT = 13 * MOD(ASCVAR-1,6)+1
0255 DATA(MULT) = LOC
0256 DO 1006 I = 1,12
0257 1006 DATA(I+MULT) = LINES(I)
0260 ASCVAR = ASCVAR + 1
0261 IF (MOD(ASCVAR,6) .EQ. 0) WRITE(8'RECORD)DATA
0262 1007 LINUSE = ASCVAR-1
0263 IF(LOC .EQ. -1) GO TO 1002
0264 IF(LOC .EQ. OLDLOC) GO TO 1020
0265 IF(ISECT.EQ.12)GOTO 1020
0266 IF(ISECT.EQ.10)GOTO 1012
0267 IF(ISECT.EQ.6)GOTO 1011
0270 IF(ISECT.EQ.5)GOTO 1010
0271 IF(ISECT.EQ.1)GOTO 1008
C
0272 IF(LOC.GT.LOCSIZ) CALL BUG(11)
0273 STEXT(LOC)=LINUSE
0274 GOTO 1020
C
0275 1008 IF(LOC.GT.LOCSIZ) CALL BUG(11)
0276 LTEXT(LOC)=LINUSE
0277 GOTO 1020
C
0300 1010 IF(LOC.GT.0.AND.LOC.LE.100)PTEXT(LOC)=LINUSE
0301 GOTO 1020
C
0302 1011 IF(LOC .GT. RTXSIZ) CALL BUG(6)
0303 RTEXT(LOC)=LINUSE
0304 GOTO 1020
C
0305 1012 IF(CLSSES.GT.CLSMAX) CALL BUG(12)
0306 CTEXT(CLSSES)=LINUSE
0307 CVAL(CLSSES)=LOC
0310 CLSSES=CLSSES+1
C GOTO 1020
C1013
C IF(LOC.GT.MAGSIZ)CALL BUG(6)
C MTEXT(LOC)=LINUSE
C
0311 1020 OLDLOC = LOC
0312 IF(RECORD .GE. FILSIZ) CALL BUG(2)
0313 GOTO 1004
C
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 KEYWORD (FROM SECTION 4, MOTION VERBS), AND IS NEGATED IF
FORTRAN IV V50-A (A6) 24-JUL-20
C THIS IS THE LAST ENTRY FOR THIS LOCATION. KEY(N) IS THE INDEX IN TRAVEL
C OF THE FIRST OPTION AT LOCATION N.
C
C SPECIAL CONDITIONS ON TRAVEL ARE ENCODED IN THE CORRESPONDING
C ENTRIES OF TRVCON. THE NEW LOCATION IS IN TRVLOC.
C
C
0314 1030 READ(6,1031)LOC,J,NEWLOC,TK
0315 1031 FORMAT(99I6)
0316 IF(LOC.EQ.-1)GOTO 1002
0317 IF(KEY(LOC).NE.0)GOTO 1033
0320 KEY(LOC)=TRVS
0321 GOTO 1035
C1033 TRAVEL(TRVS-1)=-TRAVEL(TRVS-1)
0322 1033 ITEMP = GETWRD(TRAVEL, TRVS-1, 0)
0323 ITEMP=-ITEMP
0324 CALL PUTWRD(TRAVEL, TRVS-1, ITEMP)
0325 1035 DO 1037 L=1,20
0326 IF(TK(L).EQ.0)GOTO 1039
C TRAVEL(TRVS)=TK(L)
0327 CALL PUTWRD(TRAVEL, TRVS, TK(L))
C TRVLOC(TRVS)=NEWLOC
0330 CALL PUTWRD(TRVLOC, TRVS, NEWLOC)
C TRVCON(TRVS)=J
0331 CALL PUTWRD(TRVCON, TRVS, J)
0332 TRVS=TRVS+1
0333 IF(TRVS.EQ.TRVSIZ)CALL BUG(3)
0334 1037 CONTINUE
C1039 TRAVEL(TRVS-1)=-TRAVEL(TRVS-1)
0335 1039 ITEMP = GETWRD(TRAVEL, TRVS-1, 0)
0336 ITEMP=-ITEMP
0337 CALL PUTWRD(TRAVEL, TRVS-1, ITEMP)
0340 GOTO 1030
C
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.
C OS/8 note: only reading first four characters as that's what's matched
C for vocabulary.
C
0341 1040 DO 1042 TABNDX=1,TABSIZ
0342 1043 READ(6,1041)KTAB(TABNDX),ATAB(TABNDX)
0343 1041 FORMAT(I6,A4)
0344 IF(KTAB(TABNDX).EQ.-1)GOTO 1002
0345 1042 CONTINUE
0346 CALL BUG(4)
C
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.
C
0347 1050 READ(6,1031)IOBJ,J,K
0350 IF(IOBJ.EQ.-1)GOTO 1002
0351 IF(IOBJ.GT.100) CALL BUG(13)
0352 PLAC(IOBJ)=J
FORTRAN IV V50-A (A6) 24-JUL-20
0353 FIXD(IOBJ)=K
0354 GOTO 1050
C
C READ DEFAULT MESSAGE NUMBERS FOR ACTION VERBS, STORE IN ACTSPK.
C
0355 1060 READ(6,1031)VERB,J
0356 IF(VERB.EQ.-1)GOTO 1002
0357 IF(VERB.GT.VRBSIZ) CALL BUG(10)
0360 ACTSPK(VERB)=J
0361 VCNT=MAX0(VERB,VCNT)
0362 GOTO 1060
C
C READ INFO ABOUT AVAILABLE LIQUIDS AND OTHER CONDITIONS, STORE IN COND.
C
0363 1070 READ(6,1031)K,TK
0364 IF(K.EQ.-1)GOTO 1002
0365 DO 1071 I=1,20
0366 LOC=TK(I)
0367 IF(LOC.EQ.0)GOTO 1070
0370 IF (BITSET(LOC,K)) CALL BUG(8)
0371 1071 COND(LOC)=COND(LOC)+ISHFT(1,K)
0372 GOTO 1070
C
C READ DATA FOR HINTS.
C
0373 1080 HNTMAX=0
0374 1081 READ(6,1031)K,TK
0375 IF(K.EQ.-1)GOTO 1002
0376 IF(K.LT.0.OR.K.GT.HNTSIZ)CALL BUG(7)
0377 DO 1083 I=1,4
0400 1083 HINTS(K,I)=TK(I)
0401 HNTMAX=MAX0(HNTMAX,K)
0402 GOTO 1081
C FINISH CONSTRUCTING INTERNAL DATA FORMAT
C THEN SAVE THE RESULTS
C
0403 1100 IF (MOD(ASCVAR,6) .NE. 0) WRITE(8'RECORD)DATA
0404 CALL USR(8,TEXTNM,4,IERR)
0405 CALL USR(8,TEXTNM,2,IERR)
C
C Restore the "DEFINE FILE" settings
C
0406 CALL SETIDL
C1100 CALL CLOSE(1)
0407 CALL SAVEGM(.FALSE.,I)
0410 CONTINUE
C
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(IOBJ) AS THE NEXT OBJECT AT THE SAME LOCATION
C AS IOBJ. (IOBJ>100 INDICATES THAT FIXED(IOBJ-100)=LOC; LINK(IOBJ) 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.
C
FORTRAN IV V50-A (A6) 24-JUL-20
C
C IF THE FIRST MOTION VERB IS 1 (ILLEGAL), THEN THIS IS A FORCED
C MOTION ENTRY.
C
0411 5000 DO 1102 I=1,LOCSIZ
0412 IF(LTEXT(I).EQ.0.OR.KEY(I).EQ.0)GOTO 1102
0413 K=KEY(I)
C IF(IABS(TRAVEL(K)).EQ.1)COND(I)=2
0414 ITEMP = GETWRD(TRAVEL, K, 0)
0415 IF (IABS(ITEMP).EQ.1)COND(I)=2
0416 1102 CONTINUE
C
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.
C
0417 DO 1106 I=1,100
0420 K=101-I
0421 IF(FIXD(K).LE.0)GOTO 1106
0422 CALL DROP(K+100,FIXD(K))
0423 CALL DROP(K,PLAC(K))
0424 1106 CONTINUE
C
0425 DO 1107 I=1,100
0426 K=101-I
0427 FIXED(K)=FIXD(K)
0430 1107 IF(PLAC(K).NE.0.AND.FIXD(K).LE.0)CALL DROP(K,PLAC(K))
C
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).
C
0431 MAXTRS=79
0432 TALLY=0
0433 TALLY2=0
0434 DO 1200 I=50,MAXTRS
0435 IF(PTEXT(I).NE.0)PROP(I)=-1
0436 1200 TALLY=TALLY-PROP(I)
C
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.
C
0437 DO 1300 I=1,HNTMAX
0440 HINTED(I)=.FALSE.
0441 1300 HINTLC(I)=0
C
CDEBUG WRITE(4,931)TABNDX,TABSIZ,VCNT,VRBSIZ,CLSSES,CLSMAX,
CDEBUG 1 HNTMAX,HNTSIZ,TRVS,TRVSIZ,LINUSE,FILSIZ
CDEBUG931 FORMAT(' USED VS MAX TABLE VALUES:'/
CDEBUG 1 1X,I5,' OF ',I5,' VOCAB ENTRIES'/
FORTRAN IV V50-A (A6) 24-JUL-20
CDEBUG 2 1X,I5,' OF ',I5,' VERB ENTRIES'/
CDEBUG 3 1X,I5,' OF ',I5,' CLASS ENTRIES'/
CDEBUG 4 1X,I5,' OF ',I5,' HINT ENTRIES'/
CDEBUG 5 1X,I5,' OF ',I5,' TRAVEL ENTRIES'/
CDEBUG 6 1X,I5,' OF ',I5,' FILE RECORDS'/)
C
C DEFINE SOME HANDY MNEMONICS. THESE CORRESPOND TO OBJECT NUMBERS.
C
0442 KEYS=VOCAB('KEYS',1)
0443 LAMP=VOCAB('LAMP',1)
0444 GRATE=VOCAB('GRAT',1)
0445 CAGE=VOCAB('CAGE',1)
0446 ROD=VOCAB('ROD ',1)
0447 ROD2=ROD+1
0450 STEPS=VOCAB('STEP',1)
0451 BIRD=VOCAB('BIRD',1)
0452 DOOR=VOCAB('DOOR',1)
0453 PILLOW=VOCAB('PILL',1)
0454 SNAKE=VOCAB('SNAK',1)
0455 FISSUR=VOCAB('FISS',1)
0456 TABLET=VOCAB('TABL',1)
0457 CLAM=VOCAB('CLAM',1)
0460 OYSTER=VOCAB('OYST',1)
0461 MAGZIN=VOCAB('MAGA',1)
0462 DWARF=VOCAB('DWAR',1)
0463 KNIFE=VOCAB('KNIF',1)
0464 FOOD=VOCAB('FOOD',1)
0465 BOTTLE=VOCAB('BOTT',1)
0466 WATER=VOCAB('WATE',1)
0467 OIL=VOCAB('OIL ',1)
0470 PLANT=VOCAB('PLAN',1)
0471 PLANT2=PLANT+1
0472 AXE=VOCAB('AXE ',1)
0473 MIRROR=VOCAB('MIRR',1)
0474 DRAGON=VOCAB('DRAG',1)
0475 CHASM=VOCAB('CHAS',1)
0476 TROLL=VOCAB('TROL',1)
0477 TROLL2=TROLL+1
0500 BEAR=VOCAB('BEAR',1)
0501 MESSAG=VOCAB('MESS',1)
0502 VEND=VOCAB('VEND',1)
0503 BATTER=VOCAB('BATT',1)
C
C OBJECTS FROM 50 THROUGH WHATEVER ARE TREASURES. HERE ARE A FEW.
C
0504 NUGGET=VOCAB('GOLD',1)
0505 COINS=VOCAB('COIN',1)
0506 CHEST=VOCAB('CHES',1)
0507 EGGS=VOCAB('EGGS',1)
0510 TRIDNT=VOCAB('TRID',1)
0511 VASE=VOCAB('VASE',1)
0512 EMRALD=VOCAB('EMER',1)
0513 PYRAM=VOCAB('PYRA',1)
0514 PEARL=VOCAB('PEAR',1)
0515 RUG=VOCAB('RUG ',1)
FORTRAN IV V50-A (A6) 24-JUL-20
0516 CHAIN=VOCAB('CHAI',1)
C
C THESE ARE MOTION-VERB NUMBERS.
C
0517 BACK=VOCAB('BACK',0)
0520 LOOK=VOCAB('LOOK',0)
0521 CAVE=VOCAB('CAVE',0)
0522 NULL=VOCAB('NULL',0)
0523 ENTRNC=VOCAB('ENTR',0)
0524 DPRSSN=VOCAB('DEPR',0)
0525 STREAM=VOCAB('STRE',0)
C
C AND SOME ACTION VERBS.
C
0526 SAY=VOCAB('SAY ',2)
0527 LOCK=VOCAB('LOCK',2)
0530 THROW=VOCAB('THRO',2)
0531 FIND=VOCAB('FIND',2)
0532 INVENT=VOCAB('INVE',2)
C
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.
C
0533 CHLOC=114
0534 CHLOC2=140
0535 DO 1700 I=1,6
0536 1700 DSEEN(I)=.FALSE.
0537 DFLAG=0
0540 DLOC(1)=19
0541 DLOC(2)=27
0542 DLOC(3)=33
0543 DLOC(4)=44
0544 DLOC(5)=64
0545 DLOC(6)=CHLOC
0546 DALTLC=18
C
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 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
FORTRAN IV V50-A (A6) 24-JUL-20
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
C
0547 TURNS=0
0550 LMWARN=.FALSE.
0551 KNFLOC=0
0552 DETAIL=0
0553 ABBNUM=5
0554 DO 1800 I=0,4
0555 1800 IF(RTEXT(2*I+81).NE.0)MAXDIE=I+1
0556 NUMDIE=0
0557 HOLDNG=0
0560 DKILL=0
0561 FOOBAR=0
0562 BONUS=0
0563 CLOCK1=30
0564 CLOCK2=50
0565 CLOSNG=.FALSE.
0566 PANIC=.FALSE.
0567 CLOSED=.FALSE.
0570 GAVEUP=.FALSE.
0571 SCORNG=.FALSE.
C
C
C
C FINALLY, SINCE WE'RE CLEARLY SETTING THINGS UP FOR THE FIRST TIME...
C
C PAUSE 'INIT DONE'
0572 RETURN
0573 END