![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to dinit.F CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDReno / games / dungeon|
Return to dinit.F CVS log | Up to [CSRG BSD Unix] / 43BSDReno / games / dungeon |
1.1 root 1: #include "files.h"
2:
3: #ifndef INDXFILE
4: #define INDXFILE '/usr/games/lib/dunlib/dindx.dat'
5: #endif
6: #ifndef TEXTFILE
7: #define TEXTFILE '/usr/games/lib/dunlib/dtext.dat'
8: #endif
9: #ifndef WIZARDID
10: #define WIZARDID 0
11: #endif
12:
13: C INIT-- DUNGEON INITIALIZATION SUBROUTINE
14: C
15: C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
16: C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
17: C WRITTEN BY R. M. SUPNIK
18: C
19: C DECLARATIONS
20: C
21: LOGICAL FUNCTION INIT(X)
22: IMPLICIT INTEGER (A-Z)
23: #ifndef PDP
24: LOGICAL PROTCT
25: INTEGER DATARR(3)
26: #endif PDP
27: #include "parser.h"
28: #include "gamestate.h"
29: #include "state.h"
30: #include "screen.h"
31: #include "mindex.h"
32: C
33: C MISCELLANEOUS VARIABLES
34: C
35: COMMON /STAR/ MBASE,STRBIT
36: COMMON /VERS/ VMAJ,VMIN,VEDIT
37: COMMON /TIME/ PLTIME,SHOUR,SMIN,SSEC
38: #include "io.h"
39: #include "debug.h"
40: COMMON /HYPER/ HFACTR
41: #include "rooms.h"
42: #include "rflag.h"
43: #include "rindex.h"
44: #include "exits.h"
45: #include "curxt.h"
46: #include "xpars.h"
47: #include "objects.h"
48: #include "oindex.h"
49: #include "clock.h"
50: #include "villians.h"
51: #include "advers.h"
52: #include "flags.h"
53: C INIT, PAGE 2
54: C
55: #ifndef PDP
56: #ifdef SYSV
57: C make output unbuffered
58: call unbuf
59: C
60: #endif
61: C FIRST CHECK FOR PROTECTION VIOLATION
62: C
63: IF(PROTCT(X)) GO TO 10000
64: C !PROTECTION VIOLATION?
65: PRINT 10100
66: #ifdef NOCC
67: 10100 FORMAT('There appears before you a threatening figure clad '
68: & 'all over'/'in heavy black armor. His legs seem like the '
69: & 'massive trunk'/'of the oak tree. His broad shoulders and '
70: & 'helmeted head loom'/'high over your own puny frame, and '
71: & 'you realize that his powerful'/'arms could easily crush the '
72: & 'very life from your body. There'/'hangs from his belt a '
73: & 'veritable arsenal of deadly weapons:'/'sword, mace, ball '
74: & 'and chain, dagger, lance, and trident.'/'He speaks with a '
75: & 'commanding voice:'//20X,'"You shall not pass."'//'As '
76: & 'he grabs you by the neck all grows dim about you.')
77: #else NOCC
78: 10100 FORMAT(' There appears before you a threatening figure clad '
79: & 'all over'/' in heavy black armor. His legs seem like the '
80: & 'massive trunk'/' of the oak tree. His broad shoulders and '
81: & 'helmeted head loom'/' high over your own puny frame, and '
82: & 'you realize that his powerful'/' arms could easily crush the '
83: & 'very life from your body. There'/' hangs from his belt a '
84: & 'veritable arsenal of deadly weapons:'/' sword, mace, ball '
85: & 'and chain, dagger, lance, and trident.'/' He speaks with a '
86: & 'commanding voice:'//20X,'"You shall not pass."'//' As '
87: & 'he grabs you by the neck all grows dim about you.')
88: #endif NOCC
89: CALL EXIT
90: #endif PDP
91: C
92: C NOW START INITIALIZATION PROPER
93: C
94: #ifdef PDP
95: C
96: C Note: arrays FLAGS & SWITCH are initialized in the following
97: C DATA statements, instead of using DO loops and assignments
98: C as used before. This saves some code space.
99: C
100: DATA FLAGS/.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,
101: & .FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,
102: & .FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,
103: & .TRUE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.TRUE.,
104: & .FALSE.,.FALSE.,.FALSE.,.TRUE.,.FALSE.,.FALSE.,
105: & .FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,
106: & .FALSE.,.FALSE.,.FALSE.,.TRUE.,.TRUE.,.FALSE.,
107: & .TRUE.,.FALSE.,.FALSE.,.FALSE./
108: C
109: DATA SWITCH/0,0,0,0,0,0,0,0,0,
110: & 4,0,270,0,0,0,0,0,
111: & 1,1,0,0,10/
112: C
113: C Note: SWITCH(13) or MLOC is initialized equal to MRB later.
114: C
115: C
116: DATA LTSHFT/10/
117: DATA EGSCOR/0/
118: DATA EGMXSC/0/
119: DATA MXLOAD/100/
120: DATA RWSCOR/0/
121: DATA DEATHS/0/
122: DATA MOVES/0/
123: DATA PLTIME/0/
124: DATA MUNGRM/0/
125: DATA HS/0/
126: DATA PRSA/0/
127: DATA PRSI/0/
128: DATA PRSO/0/
129: DATA PRSCON/1/
130: DATA OFLAG/0/
131: DATA OACT/0/
132: DATA OSLOT/0/
133: DATA OPREP/0/
134: DATA ONAME/0/
135: DATA THFFLG/.FALSE./
136: DATA THFACT/.TRUE./
137: DATA SWDACT/.FALSE./
138: DATA SWDSTA/0/
139: C
140: DATA RECNO/1/
141: DATA MBASE/0/
142: DATA INPCH/5/
143: DATA OUTCH/5/
144: DATA DBCH/2/
145: C
146: C INIT, PAGE 3
147: C
148: C
149: DATA DBGFLG/0/
150: DATA PRSFLG/0/
151: DATA GDTFLG/0/
152: C
153: FROMDR=0
154: SCOLRM=0
155: SCOLAC=0
156: INIT=.FALSE.
157: MLOC=MRB
158: C
159: C INIT, PAGE 4
160: C
161: C NOW RESTORE FROM EXISTING INDEX FILE.
162: C
163: call intrd(i)
164: call intrd(j)
165: call intrd(k)
166: IF((I.NE.VMAJ).OR.(J.NE.VMIN))
167: & GO TO 1925
168: C
169: call intrd(MXSCOR)
170: call intrd(STRBIT)
171: call intrd(EGMXSC)
172: C
173: call intrd(RLNT)
174: call intrd(RDESC2)
175: call aryrd(200,RDESC1)
176: call aryrd(200,REXIT)
177: call aryrd(200,RACTIO)
178: call aryrd(200,RVAL)
179: call aryrd(200,RFLAG)
180: C
181: call intrd(XLNT)
182: call aryrd(900,TRAVEL)
183: call intrd(OLNT)
184: call aryrd(220,ODESC1)
185: call aryrd(220,ODESC2)
186: call aryrd(220,ODESCO)
187: call aryrd(220,OACTIO)
188: call aryrd(220,OFLAG1)
189: call aryrd(220,OFLAG2)
190: call aryrd(220,OFVAL)
191: call aryrd(220,OTVAL)
192: call aryrd(220,OSIZE)
193: call aryrd(220,OCAPAC)
194: call aryrd(220,OROOM)
195: call aryrd(220,OADV)
196: call aryrd(220,OCAN)
197: call aryrd(220,OREAD)
198: C
199: call intrd(R2LNT)
200: call aryrd(20,OROOM2)
201: call aryrd(20,RROOM2)
202: C
203: call intrd(CLNT)
204: call aryrd(25,CTICK)
205: call aryrd(25,CACTIO)
206: C
207: do 990 i=1,25
208: cflag(i)=.TRUE.
209: call logrd(j)
210: if(j.EQ.0) CFLAG(i)=.FALSE.
211: 990 continue
212: C
213: call intrd(VLNT)
214: call aryrd(4,VILLNS)
215: call aryrd(4,VPROB)
216: call aryrd(4,VOPPS)
217: call aryrd(4,VBEST)
218: call aryrd(4,VMELEE)
219: C
220: call intrd(ALNT)
221: call aryrd(4,AROOM)
222: call aryrd(4,ASCORE)
223: call aryrd(4,AVEHIC)
224: call aryrd(4,AOBJ)
225: call aryrd(4,AACTIO)
226: call aryrd(4,ASTREN)
227: call aryrd(4,AFLAG)
228: C
229: call intrd(MBASE)
230: call intrd(MLNT)
231: C
232: C The RTEXT array is not used here, and isn't read (it's used
233: C in "speak.F")
234: C
235: call initnd
236: C
237: C INIT, PAGE 5
238: C
239: C THE INTERNAL DATA BASE IS NOW ESTABLISHED.
240: C SET UP TO PLAY THE GAME.
241: C
242: 1025 CALL ITIME(SHOUR,SMIN,SSEC)
243: CALL INIRND(or(SHOUR,or(SMIN,SSEC)))
244: C
245: WINNER=PLAYER
246: LASTIT=AOBJ(PLAYER)
247: HERE=AROOM(WINNER)
248: THFPOS=OROOM(THIEF)
249: BLOC=OROOM(BALLO)
250: INIT=.TRUE.
251: #ifdef debug
252: C
253: C Normally, PRSFLG is setable in gdt to allow seeing various
254: C parse results. Since the pdp version does not have gdt,
255: C PRSFLG is set to show full debugging info when debug is enabled.
256: C
257: PRSFLG=65535
258: #endif debug
259: C
260: C
261: RETURN
262: C INIT, PAGE 6
263: C
264: C ERRORS-- INIT FAILS.
265: C
266: 1925 continue
267: END
268: #else PDP
269: 10000 INIT=.FALSE.
270: C !ASSUME INIT FAILS.
271: MMAX=1050
272: C !SET UP ARRAY LIMITS.
273: OMAX=220
274: RMAX=200
275: VMAX=4
276: AMAX=4
277: CMAX=25
278: FMAX=46
279: SMAX=22
280: XMAX=900
281: R2MAX=20
282: DIRMAX=15
283: C
284: MLNT=0
285: C !INIT ARRAY COUNTERS.
286: OLNT=0
287: RLNT=0
288: VLNT=0
289: ALNT=0
290: CLNT=0
291: XLNT=1
292: R2LNT=0
293: C
294: LTSHFT=10
295: C !SET UP STATE VARIABLES.
296: MXSCOR=LTSHFT
297: EGSCOR=0
298: EGMXSC=0
299: MXLOAD=100
300: RWSCOR=0
301: DEATHS=0
302: MOVES=0
303: PLTIME=0
304: MUNGRM=0
305: HS=0
306: PRSA=0
307: C !CLEAR PARSE VECTOR.
308: PRSI=0
309: PRSO=0
310: PRSCON=1
311: OFLAG=0
312: C !CLEAR ORPHANS.
313: OACT=0
314: OSLOT=0
315: OPREP=0
316: ONAME=0
317: THFFLG=.FALSE.
318: C !THIEF NOT INTRODUCED BUT
319: THFACT=.TRUE.
320: C !IS ACTIVE.
321: SWDACT=.FALSE.
322: C !SWORD IS INACTIVE.
323: SWDSTA=0
324: C !SWORD IS OFF.
325: C
326: RECNO=1
327: C !INIT DB FILE POINTER.
328: MBASE=0
329: C !INIT MELEE BASE.
330: C LOGICAL UNIT NRS: 5=STDIN, 6=STDOUT
331: INPCH=5
332: C !TTY INPUT
333: OUTCH=6
334: DBCH=2
335: C !DATA BASE.
336: C INIT, PAGE 3
337: C
338: C INIT ALL ARRAYS.
339: C
340: DO 5 I=1,CMAX
341: C !CLEAR CLOCK EVENTS
342: CFLAG(I)=.FALSE.
343: CTICK(I)=0
344: CACTIO(I)=0
345: 5 CONTINUE
346: C
347: DO 10 I=1,FMAX
348: C !CLEAR FLAGS.
349: FLAGS(I)=.FALSE.
350: 10 CONTINUE
351: BUOYF=.TRUE.
352: C !SOME START AS TRUE.
353: EGYPTF=.TRUE.
354: CAGETF=.TRUE.
355: MR1F=.TRUE.
356: MR2F=.TRUE.
357: FOLLWF=.TRUE.
358: DO 12 I=1,SMAX
359: C !CLEAR SWITCHES.
360: SWITCH(I)=0
361: 12 CONTINUE
362: ORMTCH=4
363: C !NUMBER OF MATCHES.
364: LCELL=1
365: PNUMB=1
366: MDIR=270
367: MLOC=MRB
368: CPHERE=10
369: C
370: DO 15 I=1,R2MAX
371: C !CLEAR ROOM 2 ARRAY.
372: RROOM2(I)=0
373: OROOM2(I)=0
374: 15 CONTINUE
375: C
376: DO 20 I=1,XMAX
377: C !CLEAR TRAVEL ARRAY.
378: TRAVEL(I)=0
379: 20 CONTINUE
380: C
381: DO 30 I=1,VMAX
382: C !CLEAR VILLAINS ARRAYS.
383: VOPPS(I)=0
384: VPROB(I)=0
385: VILLNS(I)=0
386: VBEST(I)=0
387: VMELEE(I)=0
388: 30 CONTINUE
389: C
390: DO 40 I=1,OMAX
391: C !CLEAR OBJECT ARRAYS.
392: ODESC1(I)=0
393: ODESC2(I)=0
394: ODESCO(I)=0
395: OREAD(I)=0
396: OACTIO(I)=0
397: OFLAG1(I)=0
398: OFLAG2(I)=0
399: OFVAL(I)=0
400: OTVAL(I)=0
401: OSIZE(I)=0
402: OCAPAC(I)=0
403: OCAN(I)=0
404: OADV(I)=0
405: OROOM(I)=0
406: 40 CONTINUE
407: C
408: RDESC2=0
409: C !CLEAR DESC BASE PTR.
410: DO 50 I=1,RMAX
411: C !CLEAR ROOM ARRAYS.
412: RDESC1(I)=0
413: RACTIO(I)=0
414: RFLAG(I)=0
415: RVAL(I)=0
416: REXIT(I)=0
417: 50 CONTINUE
418: C
419: DO 60 I=1,MMAX
420: C !CLEAR MESSAGE DIRECTORY.
421: RTEXT(I)=0
422: 60 CONTINUE
423: C
424: DO 70 I=1,AMAX
425: C !CLEAR ADVENTURER'S ARRAYS.
426: AROOM(I)=0
427: ASCORE(I)=0
428: AVEHIC(I)=0
429: AOBJ(I)=0
430: AACTIO(I)=0
431: ASTREN(I)=0
432: AFLAG(I)=0
433: 70 CONTINUE
434: C
435: DBGFLG=0
436: PRSFLG=0
437: GDTFLG=0
438: C
439: C allow setting gdtflg true if user id matches wizard id
440: C this way, the wizard doesn't have to recompile to use gdt
441: C
442: if (getuid() .eq. WIZARDID) gdtflg=1
443: C
444: FROMDR=0
445: C !INIT SCOL GOODIES.
446: SCOLRM=0
447: SCOLAC=0
448: C INIT, PAGE 4
449: C
450: C NOW RESTORE FROM EXISTING INDEX FILE.
451: C
452: OPEN(UNIT=1,file=INDXFILE,status='OLD',
453: #ifdef XELOS
454: & FORM='FORMATTED',ACCESS='SEQUENTIAL',ERR=1900,recl=1)
455: #else
456: & FORM='FORMATTED',ACCESS='SEQUENTIAL',ERR=1900)
457: #endif
458: rewind(unit=1, err=1900)
459: READ(1,130) I,J,K
460: C !GET VERSION.
461: IF((I.NE.VMAJ).OR.(J.NE.VMIN))
462: & GO TO 1925
463:
464: OPEN(UNIT=DBCH,file=TEXTFILE,status='OLD',
465: & FORM='UNFORMATTED',ACCESS='DIRECT',
466: & recl=76,ERR=1950)
467: rewind(unit=dbch, err=1950)
468:
469: #ifdef debug
470: PRINT 150
471: #ifdef NOCC
472: 150 FORMAT('RESTORING FROM "dindx.dat"')
473: #else NOCC
474: 150 FORMAT(' RESTORING FROM "dindx.dat"')
475: #endif NOCC
476: #endif debug
477: READ(1,130) MXSCOR,STRBIT,EGMXSC
478: READ(1,130) RLNT,RDESC2,RDESC1,REXIT,RACTIO,RVAL,RFLAG
479: READ(1,130) XLNT,TRAVEL
480: READ(1,130) OLNT,ODESC1,ODESC2,ODESCO,OACTIO,OFLAG1,OFLAG2,
481: & OFVAL,OTVAL,OSIZE,OCAPAC,OROOM,OADV,OCAN,
482: & OREAD
483: READ(1,130) R2LNT,OROOM2,RROOM2
484: READ(1,130) CLNT,CTICK,CACTIO
485: READ(1,135) CFLAG
486: READ(1,130) VLNT,VILLNS,VPROB,VOPPS,VBEST,VMELEE
487: READ(1,130) ALNT,AROOM,ASCORE,AVEHIC,AOBJ,AACTIO,ASTREN,AFLAG
488: READ(1,130) MBASE,MLNT,RTEXT
489: C
490: CLOSE(1)
491: GO TO 1025
492: C !INIT DONE.
493: C
494: C 130 FORMAT(I8)
495: 130 FORMAT(I6)
496: 135 FORMAT(L4)
497: C INIT, PAGE 5
498: C
499: C THE INTERNAL DATA BASE IS NOW ESTABLISHED.
500: C SET UP TO PLAY THE GAME.
501: C
502: 1025 CALL ITIME(SHOUR,SMIN,SSEC)
503: C !GET TIME AND DATE.
504: C CALL IDATE(I,J,K)
505: CALL IDATE(DATARR(1))
506: CALL INIRND(or(DATARR(1),or(DATARR(2),DATARR(3))),
507: & or(SHOUR,or(SMIN,SSEC)))
508: C
509: WINNER=PLAYER
510: LASTIT=AOBJ(PLAYER)
511: HERE=AROOM(WINNER)
512: THFPOS=OROOM(THIEF)
513: BLOC=OROOM(BALLO)
514: INIT=.TRUE.
515: C
516: #ifdef debug
517: PRINT 1050,RLNT,RMAX,XLNT,XMAX,OLNT,OMAX,MLNT,MMAX,
518: & VLNT,VMAX,ALNT,AMAX,CLNT,CMAX,R2LNT,R2MAX
519: #ifdef NOCC
520: 1050 FORMAT('USED:'/I5,' OF',I5,' ROOMS'/
521: & I5,' OF',I5,' EXITS'/
522: & I5,' OF',I5,' OBJECTS'/
523: & I5,' OF',I5,' MESSAGES'/
524: & I5,' OF',I5,' VILLAINS'/
525: & I5,' OF',I5,' ADVENTURERS'/
526: & I5,' OF',I5,' CLOCK EVENTS'/
527: & I5,' OF',I5,' ROOM2 SLOTS')
528: #else NOCC
529: 1050 FORMAT(' USED:'/1X,I5,' OF',I5,' ROOMS'/
530: & 1X,I5,' OF',I5,' EXITS'/
531: & 1X,I5,' OF',I5,' OBJECTS'/
532: & 1X,I5,' OF',I5,' MESSAGES'/
533: & 1X,I5,' OF',I5,' VILLAINS'/
534: & 1X,I5,' OF',I5,' ADVENTURERS'/
535: & 1X,I5,' OF',I5,' CLOCK EVENTS'/
536: & 1X,I5,' OF',I5,' ROOM2 SLOTS')
537: #endif NOCC
538: PRINT 1150,MXSCOR,EGMXSC,RECNO,RDESC2,MBASE,STRBIT
539: #ifdef NOCC
540: 1150 FORMAT('MAX SCORE=',I5/'EG SCORE=',I5/
541: & 'MAX RECNO=',I5/'RDESC2 BASE=',I5/
542: & 'MELEE START=',I5/'STAR MASK=',I7)
543: #else NOCC
544: 1150 FORMAT(' MAX SCORE=',I5/' EG SCORE=',I5/
545: & ' MAX RECNO=',I5/' RDESC2 BASE=',I5/
546: & ' MELEE START=',I5/' STAR MASK=',I7)
547: #endif NOCC
548: PAUSE 1
549: #endif debug
550: C
551: RETURN
552: C INIT, PAGE 6
553: C
554: C ERRORS-- INIT FAILS.
555: C
556: 1900 PRINT 910
557: PRINT 980
558: RETURN
559: 1925 PRINT 920,I,J,K,VMAJ,VMIN,VEDIT
560: PRINT 980
561: RETURN
562: 1950 PRINT 960
563: PRINT 980
564: RETURN
565: #ifdef NOCC
566: 910 FORMAT('I can''t open ',INDXFILE,'.')
567: 920 FORMAT('"dindx.dat" is version ',I1,'.',I1,A1,'.'/
568: & 'I require version ',I1,'.',I1,A1,'.')
569: 960 FORMAT('I can''t open ',TEXTFILE,'.')
570: 980 FORMAT('Suddenly a sinister, wraithlike figure appears before '
571: & 'you,'/'seeming to float in the air. In a low, sorrowful voice'
572: & ' he says,'/'"Alas, the very nature of the world has changed, '
573: & 'and the dungeon'/'cannot be found. All must now pass away."'
574: & ' Raising his oaken staff'/'in farewell, he fades into the '
575: & 'spreading darkness. In his place'/'appears a tastefully '
576: & 'lettered sign reading:'//23X,'INITIALIZATION FAILURE'//
577: & 'The darkness becomes all encompassing, and your vision fails.')
578: #else NOCC
579: 910 FORMAT(' I can''t open ',INDXFILE,'.')
580: 920 FORMAT(' "dindx.dat" is version ',I1,'.',I1,A1,'.'/
581: & ' I require version ',I1,'.',I1,A1,'.')
582: 960 FORMAT(' I can''t open ',TEXTFILE,'.')
583: 980 FORMAT(' Suddenly a sinister, wraithlike figure appears before '
584: & 'you,'/' seeming to float in the air. In a low, sorrowful voice'
585: & ' he says,'/' "Alas, the very nature of the world has changed, '
586: & 'and the dungeon'/' cannot be found. All must now pass away."'
587: & ' Raising his oaken staff'/' in farewell, he fades into the '
588: & 'spreading darkness. In his place'/' appears a tastefully '
589: & 'lettered sign reading:'//23X,'INITIALIZATION FAILURE'//
590: & ' The darkness becomes all encompassing, and your vision fails.')
591: #endif NOCC
592: C
593: END
594: C PROTCT-- CHECK FOR USER VIOLATION
595: C
596: C THIS ROUTINE SHOULD BE MODIFIED IF YOU WISH TO ADD SYSTEM
597: C DEPENDANT PROTECTION AGAINST ABUSE.
598: C
599: C AT THE MOMENT, PLAY IS PERMITTED UNDER ALL CIRCUMSTANCES.
600: C
601: LOGICAL FUNCTION PROTCT(X)
602: IMPLICIT INTEGER(A-Z)
603: C
604: PROTCT=.TRUE.
605: RETURN
606: END
607: #endif PDP
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.