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
|
Last modified: 1989-12-01
Generated: 2016-12-26 |
Generated by src2html V0.67
page hit count: 2234 |
|