A large commit.
[pdp8.git] / sw / adventure / 0906 / INITAD.FT
CommitLineData
84b5715c
PH
1C ADVENTURES\r
2 SUBROUTINE INIT\r
3C\r
4C MODIFIED BY KENT BLACKETT\r
5C ENGINEERING SYSTEMS GROUP\r
6C DIGITAL EQUIPMENT CORP.\r
7C 15-JUL-77\r
8C MODIFIED BY BOB SUPNIK\r
9C DISK ENGINEERING\r
10C 21-OCT-77\r
11C MODIFIED BY BOB SUPNIK\r
12C DISK ENGINEERING\r
13C 25-AUG-78\r
14C MODIFIED BY BOB SUPNIK\r
15C SMALL SYSTEMS\r
16C 12-NOV-78\r
17C ORIGINAL VERSION WAS FOR DECSYSTEM-10\r
18C NEXT VERSION WAS FOR FORTRAN IV-PLUS UNDER\r
19C THE IAS OPERATING SYSTEM ON THE PDP-11/70\r
20C THIS VERSION IS FOR FORTRAN IV (V01C OR LATER)\r
21C UNDER RT-11 ON *ANY* PDP-11\r
22C\r
23C\r
24C CURRENT LIMITS:\r
25C 300 VOCABULARY WORDS (KTAB, ATAB, TABSIZ).\r
26C 150 LOCATIONS (LTEXT, STEXT, KEY, COND, ABB, ATLOC, LOCSIZ).\r
27C 100 OBJECTS (PLAC, PLACE, FIXD, FIXED, LINK (TWICE), PTEXT, PROP).\r
28C 35 "ACTION" VERBS (ACTSPK, VRBSIZ).\r
29C 205 RANDOM MESSAGES (RTEXT, RTXSIZ).\r
30C 12 DIFFERENT PLAYER CLASSIFICATIONS (CTEXT, CVAL, CLSMAX).\r
31C 20 HINTS, LESS 3 (HINTLC, HINTED, HINTS, HNTSIZ).\r
32C THERE ARE ALSO LIMITS WHICH CANNOT BE EXCEEDED DUE TO THE STRUCTURE OF\r
33C THE DATABASE. (E.G., THE VOCABULARY USES N/1000 TO DETERMINE WORD TYPE,\r
34C SO THERE CAN'T BE MORE THAN 1000 WORDS.) THESE UPPER LIMITS ARE:\r
35C 1000 NON-SYNONYMOUS VOCABULARY WORDS\r
36C 300 LOCATIONS\r
37C 100 OBJECTS\r
38C\r
39C IMPLICIT INTEGER (A-Z)\r
40 LOGICAL LMWARN,CLOSNG,PANIC,HINTED,\r
41 1 CLOSED,GAVEUP,SCORNG,DSEEN,BITSET\r
42C\r
43 LOGICAL WRITN\r
44 COMMON /VERSN/ VMAJ, VMIN, VEDIT\r
45 COMMON /FILES/ INDXNM, TEXTNM, SAVENM, INPTNM\r
46 COMMON /TXTCOM/ RTEXT,LINES,ASCVAR,TXTLOC,DATA\r
47 COMMON /VOCCOM/ KTAB,ATAB,TABSIZ\r
48 COMMON /PLACOM/ ATLOC,LINK,PLACE,FIXED,HOLDNG\r
49 COMMON /PTXCOM/ PTEXT\r
50 COMMON /ABBCOM/ ABB\r
51 COMMON /MISCOM/ LINUSE,TRVS,CLSSES,OLDLOC,LOC,CVAL,TK,NEWLOC,\r
52 1 KEY,PLAC,FIXD,ACTSPK,COND,HINTS,HNTMAX,PROP,TALLY,TALLY2,\r
53 2 HINTLC,CHLOC,CHLOC2,DSEEN,DFLAG,DLOC,DALTLC,KEYS,LAMP,GRATE\r
54 COMMON /MISCOM/\r
55 3 CAGE,ROD,ROD2,STEPS,BIRD,DOOR,PILLOW,SNAKE,FISSUR,TABLET,\r
56 4 CLAM,OYSTER,MAGZIN,DWARF,KNIFE,FOOD,BOTTLE,WATER,OIL,PLANT,\r
57 5 PLANT2,AXE,MIRROR,DRAGON,CHASM,TROLL,TROLL2,BEAR,MESSAG,VEND,\r
58 6 BATTER,NUGGET,COINS,CHEST,EGGS,TRIDNT,VASE,EMRALD,PYRAM\r
59 COMMON /MISCOM/\r
60 7 PEARL,RUG,CHAIN,BACK,LOOK,CAVE,NULL,ENTRNC,DPRSSN,SAY,LOCK,\r
61 8 THROW,FIND,INVENT,TURNS,LMWARN,KNFLOC,DETAIL,ABBNUM,\r
62 9 NUMDIE,MAXDIE,DKILL,FOOBAR,BONUS,CLOCK1,CLOCK2,\r
63 1 CLOSNG,PANIC,CLOSED,GAVEUP,SCORNG,ODLOC,STREAM,SPICES\r
64 COMMON /MISC2/ I,RTXSIZ,CLSMAX,LOCSIZ,CTEXT,STEXT,LTEXT,\r
65 1 SECT,TRAVEL,TRVCON,TRVLOC,TRVSIZ,TABNDX,OBJ,J,K,VERB,HNTSIZ,\r
66 2 MAXTRS,HINTED,HNTLOC,KK\r
67C\r
68 INTEGER LINES(12),DATA(78)\r
69C The TRAVEL, TRVCON, and TRVLOC arrays are\r
70C Packed with words 0,1,2 holding the data. Saves lots\r
71C of wasted space at the expense of some complexity.\r
72 INTEGER TRAVEL(250), TRVCON(250), TRVLOC(250), TRVSIZ\r
73 INTEGER KTAB(300),ATAB(300),TABSIZ\r
74 INTEGER LTEXT(150),STEXT(150),KEY(150),COND(150),ABB(150),\r
75 1 ATLOC(150)\r
76 INTEGER PLAC(100),PLACE(100),FIXD(100),FIXED(100),LINK(200),\r
77 1 PTEXT(100),PROP(100),HOLDNG\r
78 INTEGER ACTSPK(35)\r
79 INTEGER RTEXT(205)\r
80 INTEGER CTEXT(12),CVAL(12)\r
81 INTEGER HINTLC(20),HINTS(20,4)\r
82 DIMENSION HINTED(20)\r
83 INTEGER TK(20),DLOC(6),ODLOC(6)\r
84 DIMENSION DSEEN(6)\r
85 INTEGER ASCVAR, TXTLOC, TRVS, CLSSES, OLDLOC\r
86 INTEGER HNTSIZ, HNTMAX, TALLY, TALLY2, CHLOC, CHLOC2, DFLAG\r
87 INTEGER DALTLC,GRATE,CAGE,ROD,ROD2,STEPS,BIRD,DOOR,PILLOW,SNAKE\r
88 INTEGER FISSUR,TABLET,CLAM,OYSTER,MAGZIN,DWARF,KNIFE,FOOD,BOTTLE\r
89 INTEGER WATER,OIL,PLANT,PLANT2,AXE,MIRROR,DRAGON,CHASM\r
90 INTEGER BEAR,MESSAG,VEND,BATTER,COINS,CHEST,EGGS,TRIDNT,VASE,EMRALD\r
91 INTEGER PYRAM,PEARL,RUG,CHAIN,BACK,LOOK,CAVE,NULL,ENTRNC,DPRSSN,SAY\r
92 INTEGER LOCK,THROW,FIND,INVENT,TURNS,KNFLOC,DETAIL,ABBNUM\r
93 INTEGER NUMDIE,MAXDIE,DKILL,FOOBAR,BONUS,CLOCK1,CLOCK2\r
94 INTEGER TROLL,TROLL2,STREAM,SPICES\r
95 INTEGER RTXSIZ,CLSMAX,LOCSIZ,SECT,TABNDX,OBJ\r
96 INTEGER VERB,HNTLOC,KK\r
97 INTEGER INDXNM(3),TEXTNM(3),SAVENM(3),INPTNM(3),CODE,NAME(3)\r
98C\r
99C\r
100C ISHFT(NUMBER,IPOSIT)=NUMBER*(2**IPOSIT)\r
101C BITSET(L,N)=(COND(L).AND.ISHFT(1,N)).NE.0\r
102\fC DESCRIPTION OF THE DATABASE FORMAT\r
103C\r
104C\r
105C THE DATA FILE CONTAINS SEVERAL SECTIONS. EACH BEGINS WITH A LINE CONTAINING\r
106C A NUMBER IDENTIFYING THE SECTION, AND ENDS WITH A LINE CONTAINING "-1".\r
107C\r
108C SECTION 1: LONG FORM DESCRIPTIONS. EACH LINE CONTAINS A LOCATION NUMBER,\r
109C A COMMA, AND A LINE OF TEXT. THE SET OF (NECESSARILY ADJACENT) LINES\r
110C WHOSE NUMBERS ARE X FORM THE LONG DESCRIPTION OF LOCATION X.\r
111C SECTION 2: SHORT FORM DESCRIPTIONS. SAME FORMAT AS LONG FORM. NOT ALL\r
112C PLACES HAVE SHORT DESCRIPTIONS.\r
113C SECTION 3: TRAVEL TABLE. EACH LINE CONTAINS A LOCATION NUMBER (X), A SECOND\r
114C LOCATION NUMBER (Y), AND A LIST OF MOTION NUMBERS (SEE SECTION 4).\r
115C EACH MOTION REPRESENTS A VERB WHICH WILL GO TO Y IF CURRENTLY AT X.\r
116C Y, IN TURN, IS INTERPRETED AS FOLLOWS. LET M=Y/1000, N=Y MOD 1000.\r
117C IF N<=300 IT IS THE LOCATION TO GO TO.\r
118C IF 300<N<=500 N-300 IS USED IN A COMPUTED GOTO TO\r
119C A SECTION OF SPECIAL CODE.\r
120C IF N>500 MESSAGE N-500 FROM SECTION 6 IS PRINTED,\r
121C AND HE STAYS WHEREVER HE IS.\r
122C MEANWHILE, M SPECIFIES THE CONDITIONS ON THE MOTION.\r
123C IF M=0 IT'S UNCONDITIONAL.\r
124C IF 0<M<100 IT IS DONE WITH M% PROBABILITY.\r
125C IF M=100 UNCONDITIONAL, BUT FORBIDDEN TO DWARVES.\r
126C IF 100<M<=200 HE MUST BE CARRYING OBJECT M-100.\r
127C IF 200<M<=300 MUST BE CARRYING OR IN SAME ROOM AS M-200.\r
128C IF 300<M<=400 PROP(M MOD 100) MUST *NOT* BE 0.\r
129C IF 400<M<=500 PROP(M MOD 100) MUST *NOT* BE 1.\r
130C IF 500<M<=600 PROP(M MOD 100) MUST *NOT* BE 2, ETC.\r
131C IF THE CONDITION (IF ANY) IS NOT MET, THEN THE NEXT *DIFFERENT*\r
132C "DESTINATION" VALUE IS USED (UNLESS IT FAILS TO MEET *ITS* CONDITIONS,\r
133C IN WHICH CASE THE NEXT IS FOUND, ETC.). TYPICALLY, THE NEXT DEST WILL\r
134C BE FOR ONE OF THE SAME VERBS, SO THAT ITS ONLY USE IS AS THE ALTERNATE\r
135C DESTINATION FOR THOSE VERBS. FOR INSTANCE:\r
136C 15 110022 29 31 34 35 23 43\r
137C 15 14 29\r
138C THIS SAYS THAT, FROM LOC 15, ANY OF THE VERBS 29, 31, ETC., WILL TAKE\r
139C HIM TO 22 IF HE'S CARRYING OBJECT 10, AND OTHERWISE WILL GO TO 14.\r
140C 11 303008 49\r
141C 11 9 50\r
142C THIS SAYS THAT, FROM 11, 49 TAKES HIM TO 8 UNLESS PROP(3)=0, IN WHICH\r
143C CASE HE GOES TO 9. VERB 50 TAKES HIM TO 9 REGARDLESS OF PROP(3).\r
144C\r
145C IN THIS IMPLEMENTATION, THE SECOND LOCATION NUMBER Y HAS BEEN\r
146C SPLIT INTO M, CONDITIONS, AND N, LOCATION.\r
147C\r
148C SECTION 4: VOCABULARY. EACH LINE CONTAINS A NUMBER (N), A TAB, AND A\r
149C FIVE-LETTER WORD. CALL M=N/1000. IF M=0, THEN THE WORD IS A MOTION\r
150C VERB FOR USE IN TRAVELLING (SEE SECTION 3). ELSE, IF M=1, THE WORD IS\r
151C AN OBJECT. ELSE, IF M=2, THE WORD IS AN ACTION VERB (SUCH AS "CARRY"\r
152C OR "ATTACK"). ELSE, IF M=3, THE WORD IS A SPECIAL CASE VERB (SUCH AS\r
153C "DIG") AND N MOD 1000 IS AN INDEX INTO SECTION 6. OBJECTS FROM 50 TO\r
154C (CURRENTLY, ANYWAY) 79 ARE CONSIDERED TREASURES (FOR PIRATE, CLOSEOUT).\r
155C SECTION 5: OBJECT DESCRIPTIONS. EACH LINE CONTAINS A NUMBER (N), A TAB,\r
156C AND A MESSAGE. IF N IS FROM 1 TO 100, THE MESSAGE IS THE "INVENTORY"\r
157C MESSAGE FOR OBJECT N. OTHERWISE, N SHOULD BE 000, 100, 200, ETC., AND\r
158C THE MESSAGE SHOULD BE THE DESCRIPTION OF THE PRECEDING OBJECT WHEN ITS\r
159C PROP VALUE IS N/100. THE N/100 IS USED ONLY TO DISTINGUISH MULTIPLE\r
160C MESSAGES FROM MULTI-LINE MESSAGES; THE PROP INFO ACTUALLY REQUIRES ALL\r
161C MESSAGES FOR AN OBJECT TO BE PRESENT AND CONSECUTIVE. PROPERTIES WHICH\r
162C PRODUCE NO MESSAGE SHOULD BE GIVEN THE MESSAGE ">$<".\r
163C SECTION 6: ARBITRARY MESSAGES. SAME FORMAT AS SECTIONS 1, 2, AND 5, EXCEPT\r
164C THE NUMBERS BEAR NO RELATION TO ANYTHING (EXCEPT FOR SPECIAL VERBS\r
165C IN SECTION 4).\r
166C SECTION 7: OBJECT LOCATIONS. EACH LINE CONTAINS AN OBJECT NUMBER AND ITS\r
167C INITIAL LOCATION (ZERO (OR OMITTED) IF NONE). IF THE OBJECT IS\r
168C IMMOVABLE, THE LOCATION IS FOLLOWED BY A "-1". IF IT HAS TWO LOCATIONS\r
169C (E.G. THE GRATE) THE FIRST LOCATION IS FOLLOWED WITH THE SECOND, AND\r
170C THE OBJECT IS ASSUMED TO BE IMMOVABLE.\r
171C SECTION 8: ACTION DEFAULTS. EACH LINE CONTAINS AN "ACTION-VERB" NUMBER AND\r
172C THE INDEX (IN SECTION 6) OF THE DEFAULT MESSAGE FOR THE VERB.\r
173C SECTION 9: LIQUID ASSETS, ETC. EACH LINE CONTAINS A NUMBER (N) AND UP TO 20\r
174C LOCATION NUMBERS. BIT N (WHERE 0 IS THE UNITS BIT) IS SET IN COND(LOC)\r
175C FOR EACH LOC GIVEN. THE COND BITS CURRENTLY ASSIGNED ARE:\r
176C 0 LIGHT\r
177C 1 IF BIT 2 IS ON: ON FOR OIL, OFF FOR WATER\r
178C 2 LIQUID ASSET, SEE BIT 1\r
179C 3 PIRATE DOESN'T GO HERE UNLESS FOLLOWING PLAYER\r
180C OTHER BITS ARE USED TO INDICATE AREAS OF INTEREST TO "HINT" ROUTINES:\r
181C 4 TRYING TO GET INTO CAVE\r
182C 5 TRYING TO CATCH BIRD\r
183C 6 TRYING TO DEAL WITH SNAKE\r
184C 7 LOST IN MAZE\r
185C 8 PONDERING DARK ROOM\r
186C 9 AT WITT'S END\r
187C COND(LOC) IS SET TO 2, OVERRIDING ALL OTHER BITS, IF LOC HAS FORCED\r
188C MOTION.\r
189C SECTION 10: CLASS MESSAGES. EACH LINE CONTAINS A NUMBER (N), A TAB, AND A\r
190C MESSAGE DESCRIBING A CLASSIFICATION OF PLAYER. THE SCORING SECTION\r
191C SELECTS THE APPROPRIATE MESSAGE, WHERE EACH MESSAGE IS CONSIDERED TO\r
192C APPLY TO PLAYERS WHOSE SCORES ARE HIGHER THAN THE PREVIOUS N BUT NOT\r
193C HIGHER THAN THIS N. NOTE THAT THESE SCORES PROBABLY CHANGE WITH EVERY\r
194C MODIFICATION (AND PARTICULARLY EXPANSION) OF THE PROGRAM.\r
195C SECTION 11: HINTS. EACH LINE CONTAINS A HINT NUMBER (CORRESPONDING TO A\r
196C COND BIT, SEE SECTION 9), THE NUMBER OF TURNS HE MUST BE AT THE RIGHT\r
197C LOC(S) BEFORE TRIGGERING THE HINT, THE POINTS DEDUCTED FOR TAKING THE\r
198C HINT, THE MESSAGE NUMBER (SECTION 6) OF THE QUESTION, AND THE MESSAGE\r
199C NUMBER OF THE HINT. THESE VALUES ARE STASHED IN THE "HINTS" ARRAY.\r
200C HNTMAX IS SET TO THE MAX HINT NUMBER (<= HNTSIZ). NUMBERS 1-3 ARE\r
201C UNUSABLE SINCE COND BITS ARE OTHERWISE ASSIGNED, SO 2 IS USED TO\r
202C REMEMBER IF HE'S READ THE CLUE IN THE REPOSITORY, AND 3 IS USED TO\r
203C REMEMBER WHETHER HE ASKED FOR INSTRUCTIONS (GETS MORE TURNS, BUT LOSES\r
204C POINTS).\r
205C SECTION 12: MAGIC MESSAGES. IDENTICAL TO SECTION 6 EXCEPT PUT IN A SEPARATE\r
206C SECTION FOR EASIER REFERENCE. MAGIC MESSAGES ARE USED BY THE STARTUP,\r
207C MAINTENANCE MODE, AND RELATED ROUTINES.\r
208C SECTION 0: END OF DATABASE.\r
209\fC READ THE DATABASE IF WE HAVE NOT YET DONE SO\r
210C\r
211 ISEED=0\r
212C\r
213C FILSIZ Was 900 for RT-11 but we pack 6 records per.\r
214C\r
215 FILSIZ=150\r
216 TABSIZ=300\r
217 LOCSIZ=150\r
218 VRBSIZ=35\r
219 RTXSIZ = 205\r
220 HNTSIZ = 20\r
221 MAGSIZ = 35\r
222 TRVSIZ = 750\r
223 CLSMAX = 12\r
224C VCNT = 0\r
225CDEBUG WRITE(4,1000)\r
226CDEBUG1000 FORMAT(' INITIALIZING...')\r
227C\r
228C FIRST, TRY TO RESTORE PRE-EXISTING COPY OF DATA BASE\r
229C\r
230 CALL USR(6,'ADVENT.IN',2,ERR)\r
231 IF (ERR .EQ. 0) GOTO 30\r
23220 CALL SIXOUT('L]OCATION OF TEXT DATABASE ([ATEXT.DA]) >',21,2)\r
233 WRITE(4,121)\r
234121 FORMAT('+',$)\r
235 READ(4,21) TEXTNM\r
23621 FORMAT(3A6)\r
237 IF (TEXTNM(1) .NE. ' ') GOTO 22\r
238 TEXTNM(1) = 'ATEXT.'\r
239 TEXTNM(2) = 'DA'\r
240 TEXTNM(3) = ' '\r
24122 CALL SIXOUT('L]OCATION OF TEXT INDEX ([AINDX.DA]) >',21,2)\r
242 WRITE(4,121)\r
243 READ(4,21) INDXNM\r
244 IF (INDXNM(1) .NE. ' ') GOTO 23\r
245 INDXNM(1) = 'AINDX.'\r
246 INDXNM(2) = 'DA'\r
247 INDXNM(3) = ' '\r
24823 CALL SIXOUT('L]OCATION OF SAVED GAMES ([ASAVE.DA]) >',21,2)\r
249 WRITE(4,121)\r
250 READ(4,21) SAVENM\r
251 IF (SAVENM(1) .NE. ' ') GOTO 24\r
252 SAVENM(1) = 'ASAVE.'\r
253 SAVENM(2) = 'DA'\r
254 SAVENM(3) = ' '\r
25524 CALL SIXOUT('L]OCATION OF TEXT INPUT ([ADVENT.TX]) >',21,2)\r
256 WRITE(4,121)\r
257 READ(4,21)INPTNM\r
258 IF (INPTNM(1) .NE. ' ') GOTO 25\r
259 INPTNM(1) = 'ADVENT'\r
260 INPTNM(2) = '.TX'\r
261 INPTNM(3) = ' '\r
26225 CONTINUE\r
263\r
264 CALL USR(6, 'ADVENT.IN',3,ERR)\r
265 IF (ERR .NE. 0) WRITE(4,28)\r
266\r
26728 FORMAT(' CAN''T SAVE SETTINGS IN ADVENT.IN')\r
268 IF (ERR.NE.0) GOTO 40\r
269\r
270 WRITE(6, 29)INDXNM,TEXTNM,SAVENM,INPTNM\r
27129 FORMAT(' ADVENTURE SETUP FILE',/,\r
272 1 'INDX=',3A6,/,'TEXT=',3A6,/,'SAVE=',3A6,/,'INPT=',3A6)\r
273 CALL USR(6, 'ADVENT.IN',4,ERR)\r
274 GOTO 40\r
275\r
27630 INDXNM(1) = 'AINDX.'\r
277 INDXNM(2) = 'DA'\r
278 INDXNM(3) = ' '\r
279 TEXTNM(1) = 'ATEXT.'\r
280 TEXTNM(2) = 'DA'\r
281 TEXTNM(3) = ' '\r
282 SAVENM(1) = 'ASAVE.'\r
283 SAVENM(2) = 'DA'\r
284 SAVENM(3) = ' '\r
285 INPTNM(1) = 'ADVENT'\r
286 INPTNM(2) = '.TX'\r
287 INPTNM(3) = ' '\r
28831 CALL CHKEOF(EOF)\r
289 READ(6, 32) CODE, NAME\r
290 IF (EOF .NE. 0) GOTO 34\r
29132 FORMAT(A4,1X,3A6)\r
292 DO 33 I = 1, 3\r
293 IF (CODE .EQ. 'INDX') INDXNM(I) = NAME(I)\r
294 IF (CODE .EQ. 'TEXT') TEXTNM(I) = NAME(I)\r
295 IF (CODE .EQ. 'SAVE') SAVENM(I) = NAME(I)\r
296 IF (CODE .EQ. 'INPT') INPTNM(I) = NAME(I)\r
29733 CONTINUE\r
298 GO TO 31\r
299\r
30034 CONTINUE\r
30140 CALL RSTRGM(.FALSE.,I)\r
302 IF(I.NE.0) GO TO 10\r
303 CALL USR(8, TEXTNM, 2, ERR)\r
304C\r
305C If that can't be opened for input, gotta rebuild\r
306C\r
307 IF (ERR.NE.0) GOTO 10\r
308C\r
309C Hack to set the DEFINE FILE stuff up\r
310C\r
311 CALL SETIDL\r
312C CALL USR(6, 'ADVENT.TX', 2, ERR)\r
313C IF (ERR.EQ.0) GOTO 1235\r
314C CALL SIXOUT('C]AN''T OPEN [ADVENT.TX] FOR INPUT, QUITTING!',23,0)\r
315C STOP\r
316\r
3171235 WRITN = .FALSE.\r
318 GO TO 5000\r
319C\r
320C CLEAR OUT THE VARIOUS TEXT-POINTER ARRAYS. ALL TEXT IS STORED IN DISK\r
321C FILE (RANDOM ACCESS ON UNIT 2). THE TEXT-POINTER ARRAYS CONTAIN RECORD\r
322C NUMBERS IN THE FILE. STEXT(N) IS SHORT DESCRIPTION OF LOCATION N.\r
323C LTEXT(N) IS LONG DESCRIPTION. PTEXT(N) POINTS TO MESSAGE FOR PROP(N)=0.\r
324C SUCCESSIVE PROP MESSAGES ARE FOUND BY CHASING POINTERS. RTEXT CONTAINS\r
325C SECTION 6'S STUFF. CTEXT(N) POINTS TO A PLAYER-CLASS MESSAGE. MTEXT IS FOR\r
326C SECTION 12. WE ALSO CLEAR COND. SEE DESCRIPTION OF SECTION 9 FOR DETAILS.\r
327C\r
328 WRITN = .TRUE.\r
32910 DO 1001 I=1,TABSIZ\r
330 KTAB(I)=0\r
331 ATAB(I)=0\r
332C\r
333C A2TAB not used on the '8\r
334C A2TAB(I)=0\r
335 IF(I.GT.100) GO TO 1990\r
336 PTEXT(I)=0\r
337 PROP(I)=0\r
338 PLAC(I)=0\r
339 PLACE(I)=0\r
340 FIXD(I)=0\r
341 FIXED(I)=0\r
342 LINK(I)=0\r
343 LINK(I+100)=0\r
3441990 IF(I.LE.RTXSIZ)RTEXT(I)=0\r
345 IF(I.LE.CLSMAX)CTEXT(I)=0\r
346C IF(I.LE.MAGSIZ)MTEXT(I)=0\r
347 IF(I.LE.VRBSIZ)ACTSPK(I)=0\r
348 IF(I.GT.LOCSIZ)GOTO 1001\r
349 KEY(I)=0\r
350 ABB(I)=0\r
351 ATLOC(I)=0\r
352 STEXT(I)=0\r
353 LTEXT(I)=0\r
354 COND(I)=0\r
3551001 CONTINUE\r
356C\r
357 CALL USR(6, INPTNM, 2, ERR)\r
358 IF(ERR.EQ.0)GOTO 1236\r
359 CALL SIXOUT('C]AN''T OPEN ',6,2)\r
360 CALL SIXOUT(INPTNM, 9, 3)\r
361 CALL SIXOUT(' ]FOR INPUT!',6,1)\r
362 STOP\r
3631236 CALL USR(8, TEXTNM, 3, ERR)\r
364 IF (ERR.EQ.0) GOTO 1237\r
365 CALL SIXOUT('C]AN''T OPEN ',6,2)\r
366 CALL SIXOUT(TEXTNM, 9, 3)\r
367 CALL SIXOUT(' ]FOR OUTPUT',6,1)\r
368 STOP\r
3691237 DEFINE FILE 8(FILSIZ,78,U,RECORD)\r
370 RECORD = 1\r
371 ASCVAR = 1\r
372 LINUSE=1\r
373 TRVS=1\r
374 CLSSES=1\r
375C\r
376C START NEW DATA SECTION. ISECT IS THE SECTION NUMBER.\r
377C\r
3781002 READ(6,1003)ISECT\r
3791003 FORMAT(I5)\r
380CDEBUG WRITE(4,930)ISECT\r
381CDEBUG930 FORMAT(' NOW LOADING SECTION',I3)\r
382 OLDLOC=-1\r
383 GOTO(1100,1004,1004,1030,1040,1004,1004,1050,1060,1070,1004,\r
384 1 1080,1004) (ISECT+1)\r
385C (0) (1) (2) (3) (4) (5) (6) (7) (8) (9) (10)\r
386C (11) (12)\r
387 CALL BUG(9)\r
388C\r
389C SECTIONS 1, 2, 5, 6, 10, 12. READ MESSAGES AND SET UP POINTERS.\r
390C\r
3911004 READ(6,1005) LOC,LINES\r
3921005 FORMAT(I4,12A6)\r
393C WRITE(8'ASCVAR) LOC,LINES\r
394 MULT = 13 * MOD(ASCVAR-1,6)+1\r
395 DATA(MULT) = LOC\r
396 DO 1006 I = 1,12\r
3971006 DATA(I+MULT) = LINES(I)\r
398 ASCVAR = ASCVAR + 1\r
399 IF (MOD(ASCVAR,6) .EQ. 0) WRITE(8'RECORD)DATA\r
4001007 LINUSE = ASCVAR-1\r
401 IF(LOC .EQ. -1) GO TO 1002\r
402 IF(LOC .EQ. OLDLOC) GO TO 1020\r
403 IF(ISECT.EQ.12)GOTO 1020\r
404 IF(ISECT.EQ.10)GOTO 1012\r
405 IF(ISECT.EQ.6)GOTO 1011\r
406 IF(ISECT.EQ.5)GOTO 1010\r
407 IF(ISECT.EQ.1)GOTO 1008\r
408C\r
409 IF(LOC.GT.LOCSIZ) CALL BUG(11)\r
410 STEXT(LOC)=LINUSE\r
411 GOTO 1020\r
412C\r
4131008 IF(LOC.GT.LOCSIZ) CALL BUG(11)\r
414 LTEXT(LOC)=LINUSE\r
415 GOTO 1020\r
416C\r
4171010 IF(LOC.GT.0.AND.LOC.LE.100)PTEXT(LOC)=LINUSE\r
418 GOTO 1020\r
419C\r
4201011 IF(LOC .GT. RTXSIZ) CALL BUG(6)\r
421 RTEXT(LOC)=LINUSE\r
422 GOTO 1020\r
423C\r
4241012 IF(CLSSES.GT.CLSMAX) CALL BUG(12)\r
425 CTEXT(CLSSES)=LINUSE\r
426 CVAL(CLSSES)=LOC\r
427 CLSSES=CLSSES+1\r
428C GOTO 1020\r
429C1013\r
430C IF(LOC.GT.MAGSIZ)CALL BUG(6)\r
431C MTEXT(LOC)=LINUSE\r
432C\r
4331020 OLDLOC = LOC\r
434 IF(RECORD .GE. FILSIZ) CALL BUG(2)\r
435 GOTO 1004\r
436C\r
437C THE STUFF FOR SECTION 3 IS ENCODED HERE. EACH "FROM-LOCATION" GETS A\r
438C CONTIGUOUS SECTION OF THE "TRAVEL" ARRAY. EACH ENTRY IN TRAVEL IS\r
439C KEYWORD (FROM SECTION 4, MOTION VERBS), AND IS NEGATED IF\r
440C THIS IS THE LAST ENTRY FOR THIS LOCATION. KEY(N) IS THE INDEX IN TRAVEL\r
441C OF THE FIRST OPTION AT LOCATION N.\r
442C\r
443C SPECIAL CONDITIONS ON TRAVEL ARE ENCODED IN THE CORRESPONDING\r
444C ENTRIES OF TRVCON. THE NEW LOCATION IS IN TRVLOC.\r
445C\r
446C\r
4471030 READ(6,1031)LOC,J,NEWLOC,TK\r
4481031 FORMAT(99I6)\r
449 IF(LOC.EQ.-1)GOTO 1002\r
450 IF(KEY(LOC).NE.0)GOTO 1033\r
451 KEY(LOC)=TRVS\r
452 GOTO 1035\r
453C1033 TRAVEL(TRVS-1)=-TRAVEL(TRVS-1)\r
4541033 ITEMP = GETWRD(TRAVEL, TRVS-1, 0)\r
455 ITEMP=-ITEMP\r
456 CALL PUTWRD(TRAVEL, TRVS-1, ITEMP)\r
4571035 DO 1037 L=1,20\r
458 IF(TK(L).EQ.0)GOTO 1039\r
459C TRAVEL(TRVS)=TK(L)\r
460 CALL PUTWRD(TRAVEL, TRVS, TK(L))\r
461C TRVLOC(TRVS)=NEWLOC\r
462 CALL PUTWRD(TRVLOC, TRVS, NEWLOC)\r
463C TRVCON(TRVS)=J\r
464 CALL PUTWRD(TRVCON, TRVS, J)\r
465 TRVS=TRVS+1\r
466 IF(TRVS.EQ.TRVSIZ)CALL BUG(3)\r
4671037 CONTINUE\r
468C1039 TRAVEL(TRVS-1)=-TRAVEL(TRVS-1)\r
4691039 ITEMP = GETWRD(TRAVEL, TRVS-1, 0)\r
470 ITEMP=-ITEMP\r
471 CALL PUTWRD(TRAVEL, TRVS-1, ITEMP)\r
472 GOTO 1030\r
473C\r
474C HERE WE READ IN THE VOCABULARY. KTAB(N) IS THE WORD NUMBER, ATAB(N) IS\r
475C THE CORRESPONDING WORD. THE -1 AT THE END OF SECTION 4 IS LEFT IN KTAB\r
476C AS AN END-MARKER.\r
477C OS/8 note: only reading first four characters as that's what's matched\r
478C for vocabulary.\r
479C\r
4801040 DO 1042 TABNDX=1,TABSIZ\r
4811043 READ(6,1041)KTAB(TABNDX),ATAB(TABNDX)\r
4821041 FORMAT(I6,A4)\r
483 IF(KTAB(TABNDX).EQ.-1)GOTO 1002\r
4841042 CONTINUE\r
485 CALL BUG(4)\r
486C\r
487C READ IN THE INITIAL LOCATIONS FOR EACH OBJECT. ALSO THE IMMOVABILITY INFO.\r
488C PLAC CONTAINS INITIAL LOCATIONS OF OBJECTS. FIXD IS -1 FOR IMMOVABLE\r
489C OBJECTS (INCLUDING THE SNAKE), OR = SECOND LOC FOR TWO-PLACED OBJECTS.\r
490C\r
4911050 READ(6,1031)IOBJ,J,K\r
492 IF(IOBJ.EQ.-1)GOTO 1002\r
493 IF(IOBJ.GT.100) CALL BUG(13)\r
494 PLAC(IOBJ)=J\r
495 FIXD(IOBJ)=K\r
496 GOTO 1050\r
497C\r
498C READ DEFAULT MESSAGE NUMBERS FOR ACTION VERBS, STORE IN ACTSPK.\r
499C\r
5001060 READ(6,1031)VERB,J\r
501 IF(VERB.EQ.-1)GOTO 1002\r
502 IF(VERB.GT.VRBSIZ) CALL BUG(10)\r
503 ACTSPK(VERB)=J\r
504 VCNT=MAX0(VERB,VCNT)\r
505 GOTO 1060\r
506C\r
507C READ INFO ABOUT AVAILABLE LIQUIDS AND OTHER CONDITIONS, STORE IN COND.\r
508C\r
5091070 READ(6,1031)K,TK\r
510 IF(K.EQ.-1)GOTO 1002\r
511 DO 1071 I=1,20\r
512 LOC=TK(I)\r
513 IF(LOC.EQ.0)GOTO 1070\r
514 IF (BITSET(LOC,K)) CALL BUG(8)\r
5151071 COND(LOC)=COND(LOC)+ISHFT(1,K)\r
516 GOTO 1070\r
517C\r
518C READ DATA FOR HINTS.\r
519C\r
5201080 HNTMAX=0\r
5211081 READ(6,1031)K,TK\r
522 IF(K.EQ.-1)GOTO 1002\r
523 IF(K.LT.0.OR.K.GT.HNTSIZ)CALL BUG(7)\r
524 DO 1083 I=1,4\r
5251083 HINTS(K,I)=TK(I)\r
526 HNTMAX=MAX0(HNTMAX,K)\r
527 GOTO 1081\r
528\fC FINISH CONSTRUCTING INTERNAL DATA FORMAT\r
529C THEN SAVE THE RESULTS\r
530C\r
5311100 IF (MOD(ASCVAR,6) .NE. 0) WRITE(8'RECORD)DATA\r
532 CALL USR(8,TEXTNM,4,IERR)\r
533 CALL USR(8,TEXTNM,2,IERR)\r
534C\r
535C Restore the "DEFINE FILE" settings\r
536C\r
537 CALL SETIDL\r
538C1100 CALL CLOSE(1)\r
539 CALL SAVEGM(.FALSE.,I)\r
540 CONTINUE\r
541C\r
542C HAVING READ IN THE DATABASE, CERTAIN THINGS ARE NOW CONSTRUCTED. PROPS ARE\r
543C SET TO ZERO. WE FINISH SETTING UP COND BY CHECKING FOR FORCED-MOTION TRAVEL\r
544C ENTRIES. THE PLAC AND FIXD ARRAYS ARE USED TO SET UP ATLOC(N) AS THE FIRST\r
545C OBJECT AT LOCATION N, AND LINK(IOBJ) AS THE NEXT OBJECT AT THE SAME LOCATION\r
546C AS IOBJ. (IOBJ>100 INDICATES THAT FIXED(IOBJ-100)=LOC; LINK(IOBJ) IS STILL THE\r
547C CORRECT LINK TO USE.) ABB IS ZEROED; IT CONTROLS WHETHER THE ABBREVIATED\r
548C DESCRIPTION IS PRINTED. COUNTS MOD 5 UNLESS "LOOK" IS USED.\r
549C\r
550C\r
551C IF THE FIRST MOTION VERB IS 1 (ILLEGAL), THEN THIS IS A FORCED\r
552C MOTION ENTRY.\r
553C\r
5545000 DO 1102 I=1,LOCSIZ\r
555 IF(LTEXT(I).EQ.0.OR.KEY(I).EQ.0)GOTO 1102\r
556 K=KEY(I)\r
557C IF(IABS(TRAVEL(K)).EQ.1)COND(I)=2\r
558 ITEMP = GETWRD(TRAVEL, K, 0)\r
559 IF (IABS(ITEMP).EQ.1)COND(I)=2\r
5601102 CONTINUE\r
561C\r
562C SET UP THE ATLOC AND LINK ARRAYS AS DESCRIBED ABOVE. WE'LL USE THE DROP\r
563C SUBROUTINE, WHICH PREFACES NEW OBJECTS ON THE LISTS. SINCE WE WANT THINGS\r
564C IN THE OTHER ORDER, WE'LL RUN THE LOOP BACKWARDS. IF THE OBJECT IS IN TWO\r
565C LOCS, WE DROP IT TWICE. THIS ALSO SETS UP "PLACE" AND "FIXED" AS COPIES OF\r
566C "PLAC" AND "FIXD". ALSO, SINCE TWO-PLACED OBJECTS ARE TYPICALLY BEST\r
567C DESCRIBED LAST, WE'LL DROP THEM FIRST.\r
568C\r
569 DO 1106 I=1,100\r
570 K=101-I\r
571 IF(FIXD(K).LE.0)GOTO 1106\r
572 CALL DROP(K+100,FIXD(K))\r
573 CALL DROP(K,PLAC(K))\r
5741106 CONTINUE\r
575C\r
576 DO 1107 I=1,100\r
577 K=101-I\r
578 FIXED(K)=FIXD(K)\r
5791107 IF(PLAC(K).NE.0.AND.FIXD(K).LE.0)CALL DROP(K,PLAC(K))\r
580C\r
581C TREASURES, AS NOTED EARLIER, ARE OBJECTS 50 THROUGH MAXTRS (CURRENTLY 79).\r
582C THEIR PROPS ARE INITIALLY -1, AND ARE SET TO 0 THE FIRST TIME THEY ARE\r
583C DESCRIBED. TALLY KEEPS TRACK OF HOW MANY ARE NOT YET FOUND, SO WE KNOW\r
584C WHEN TO CLOSE THE CAVE. TALLY2 COUNTS HOW MANY CAN NEVER BE FOUND (E.G. IF\r
585C LOST BIRD OR BRIDGE).\r
586C\r
587 MAXTRS=79\r
588 TALLY=0\r
589 TALLY2=0\r
590 DO 1200 I=50,MAXTRS\r
591 IF(PTEXT(I).NE.0)PROP(I)=-1\r
5921200 TALLY=TALLY-PROP(I)\r
593C\r
594C CLEAR THE HINT STUFF. HINTLC(I) IS HOW LONG HE'S BEEN AT LOC WITH COND BIT\r
595C I. HINTED(I) IS TRUE IFF HINT I HAS BEEN USED.\r
596C\r
597 DO 1300 I=1,HNTMAX\r
598 HINTED(I)=.FALSE.\r
5991300 HINTLC(I)=0\r
600C\r
601CDEBUG WRITE(4,931)TABNDX,TABSIZ,VCNT,VRBSIZ,CLSSES,CLSMAX,\r
602CDEBUG 1 HNTMAX,HNTSIZ,TRVS,TRVSIZ,LINUSE,FILSIZ\r
603CDEBUG931 FORMAT(' USED VS MAX TABLE VALUES:'/\r
604CDEBUG 1 1X,I5,' OF ',I5,' VOCAB ENTRIES'/\r
605CDEBUG 2 1X,I5,' OF ',I5,' VERB ENTRIES'/\r
606CDEBUG 3 1X,I5,' OF ',I5,' CLASS ENTRIES'/\r
607CDEBUG 4 1X,I5,' OF ',I5,' HINT ENTRIES'/\r
608CDEBUG 5 1X,I5,' OF ',I5,' TRAVEL ENTRIES'/\r
609CDEBUG 6 1X,I5,' OF ',I5,' FILE RECORDS'/)\r
610C\r
611C DEFINE SOME HANDY MNEMONICS. THESE CORRESPOND TO OBJECT NUMBERS.\r
612C\r
613 KEYS=VOCAB('KEYS',1)\r
614 LAMP=VOCAB('LAMP',1)\r
615 GRATE=VOCAB('GRAT',1)\r
616 CAGE=VOCAB('CAGE',1)\r
617 ROD=VOCAB('ROD ',1)\r
618 ROD2=ROD+1\r
619 STEPS=VOCAB('STEP',1)\r
620 BIRD=VOCAB('BIRD',1)\r
621 DOOR=VOCAB('DOOR',1)\r
622 PILLOW=VOCAB('PILL',1)\r
623 SNAKE=VOCAB('SNAK',1)\r
624 FISSUR=VOCAB('FISS',1)\r
625 TABLET=VOCAB('TABL',1)\r
626 CLAM=VOCAB('CLAM',1)\r
627 OYSTER=VOCAB('OYST',1)\r
628 MAGZIN=VOCAB('MAGA',1)\r
629 DWARF=VOCAB('DWAR',1)\r
630 KNIFE=VOCAB('KNIF',1)\r
631 FOOD=VOCAB('FOOD',1)\r
632 BOTTLE=VOCAB('BOTT',1)\r
633 WATER=VOCAB('WATE',1)\r
634 OIL=VOCAB('OIL ',1)\r
635 PLANT=VOCAB('PLAN',1)\r
636 PLANT2=PLANT+1\r
637 AXE=VOCAB('AXE ',1)\r
638 MIRROR=VOCAB('MIRR',1)\r
639 DRAGON=VOCAB('DRAG',1)\r
640 CHASM=VOCAB('CHAS',1)\r
641 TROLL=VOCAB('TROL',1)\r
642 TROLL2=TROLL+1\r
643 BEAR=VOCAB('BEAR',1)\r
644 MESSAG=VOCAB('MESS',1)\r
645 VEND=VOCAB('VEND',1)\r
646 BATTER=VOCAB('BATT',1)\r
647C\r
648C OBJECTS FROM 50 THROUGH WHATEVER ARE TREASURES. HERE ARE A FEW.\r
649C\r
650 NUGGET=VOCAB('GOLD',1)\r
651 COINS=VOCAB('COIN',1)\r
652 CHEST=VOCAB('CHES',1)\r
653 EGGS=VOCAB('EGGS',1)\r
654 TRIDNT=VOCAB('TRID',1)\r
655 VASE=VOCAB('VASE',1)\r
656 EMRALD=VOCAB('EMER',1)\r
657 PYRAM=VOCAB('PYRA',1)\r
658 PEARL=VOCAB('PEAR',1)\r
659 RUG=VOCAB('RUG ',1)\r
660 CHAIN=VOCAB('CHAI',1)\r
661C\r
662C THESE ARE MOTION-VERB NUMBERS.\r
663C\r
664 BACK=VOCAB('BACK',0)\r
665 LOOK=VOCAB('LOOK',0)\r
666 CAVE=VOCAB('CAVE',0)\r
667 NULL=VOCAB('NULL',0)\r
668 ENTRNC=VOCAB('ENTR',0)\r
669 DPRSSN=VOCAB('DEPR',0)\r
670 STREAM=VOCAB('STRE',0)\r
671C\r
672C AND SOME ACTION VERBS.\r
673C\r
674 SAY=VOCAB('SAY ',2)\r
675 LOCK=VOCAB('LOCK',2)\r
676 THROW=VOCAB('THRO',2)\r
677 FIND=VOCAB('FIND',2)\r
678 INVENT=VOCAB('INVE',2)\r
679C\r
680C INITIALISE THE DWARVES. DLOC IS LOC OF DWARVES, HARD-WIRED IN. ODLOC IS\r
681C PRIOR LOC OF EACH DWARF, INITIALLY GARBAGE. DALTLC IS ALTERNATE INITIAL LOC\r
682C FOR DWARF, IN CASE ONE OF THEM STARTS OUT ON TOP OF THE ADVENTURER. (NO 2\r
683C OF THE 5 INITIAL LOCS ARE ADJACENT.) DSEEN IS TRUE IF DWARF HAS SEEN HIM.\r
684C DFLAG CONTROLS THE LEVEL OF ACTIVATION OF ALL THIS:\r
685C 0 NO DWARF STUFF YET (WAIT UNTIL REACHES HALL OF MISTS)\r
686C 1 REACHED HALL OF MISTS, BUT HASN'T MET FIRST DWARF\r
687C 2 MET FIRST DWARF, OTHERS START MOVING, NO KNIVES THROWN YET\r
688C 3 A KNIFE HAS BEEN THROWN (FIRST SET ALWAYS MISSES)\r
689C 3+ DWARVES ARE MAD (INCREASES THEIR ACCURACY)\r
690C SIXTH DWARF IS SPECIAL (THE PIRATE). HE ALWAYS STARTS AT HIS CHEST'S\r
691C EVENTUAL LOCATION INSIDE THE MAZE. THIS LOC IS SAVED IN CHLOC FOR REF.\r
692C THE DEAD END IN THE OTHER MAZE HAS ITS LOC STORED IN CHLOC2.\r
693C\r
694 CHLOC=114\r
695 CHLOC2=140\r
696 DO 1700 I=1,6\r
6971700 DSEEN(I)=.FALSE.\r
698 DFLAG=0\r
699 DLOC(1)=19\r
700 DLOC(2)=27\r
701 DLOC(3)=33\r
702 DLOC(4)=44\r
703 DLOC(5)=64\r
704 DLOC(6)=CHLOC\r
705 DALTLC=18\r
706C\r
707C OTHER RANDOM FLAGS AND COUNTERS, AS FOLLOWS:\r
708C TURNS TALLIES HOW MANY COMMANDS HE'S GIVEN (IGNORES YES/NO)\r
709C LIMIT LIFETIME OF LAMP (NOT SET HERE)\r
710C KNFLOC 0 IF NO KNIFE HERE, LOC IF KNIFE HERE, -1 AFTER CAVEAT\r
711C DETAIL HOW OFTEN WE'VE SAID "NOT ALLOWED TO GIVE MORE DETAIL"\r
712C ABBNUM HOW OFTEN WE SHOULD PRINT NON-ABBREVIATED DESCRIPTIONS\r
713C MAXDIE NUMBER OF REINCARNATION MESSAGES AVAILABLE (UP TO 5)\r
714C NUMDIE NUMBER OF TIMES KILLED SO FAR\r
715C HOLDNG NUMBER OF OBJECTS BEING CARRIED\r
716C DKILL NUMBER OF DWARVES KILLED (UNUSED IN SCORING, NEEDED FOR MSG)\r
717C FOOBAR CURRENT PROGRESS IN SAYING "FEE FIE FOE FOO".\r
718C BONUS USED TO DETERMINE AMOUNT OF BONUS IF HE REACHES CLOSING\r
719C CLOCK1 NUMBER OF TURNS FROM FINDING LAST TREASURE TILL CLOSING\r
720C CLOCK2 NUMBER OF TURNS FROM FIRST WARNING TILL BLINDING FLASH\r
721C LOGICALS WERE EXPLAINED EARLIER\r
722C\r
723 TURNS=0\r
724 LMWARN=.FALSE.\r
725 KNFLOC=0\r
726 DETAIL=0\r
727 ABBNUM=5\r
728 DO 1800 I=0,4\r
7291800 IF(RTEXT(2*I+81).NE.0)MAXDIE=I+1\r
730 NUMDIE=0\r
731 HOLDNG=0\r
732 DKILL=0\r
733 FOOBAR=0\r
734 BONUS=0\r
735 CLOCK1=30\r
736 CLOCK2=50\r
737 CLOSNG=.FALSE.\r
738 PANIC=.FALSE.\r
739 CLOSED=.FALSE.\r
740 GAVEUP=.FALSE.\r
741 SCORNG=.FALSE.\r
742C\r
743C\r
744C\r
745C FINALLY, SINCE WE'RE CLEARLY SETTING THINGS UP FOR THE FIRST TIME...\r
746C\r
747C PAUSE 'INIT DONE'\r
748 RETURN\r
749 END\r