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 13C INIT-- DUNGEON INITIALIZATION SUBROUTINE 14C 15C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142 16C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED 17C WRITTEN BY R. M. SUPNIK 18C 19C DECLARATIONS 20C 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" 32C 33C MISCELLANEOUS VARIABLES 34C 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" 53C INIT, PAGE 2 54C 55#ifndef PDP 56#ifdef SYSV 57C make output unbuffered 58 call unbuf 59C 60#endif 61C FIRST CHECK FOR PROTECTION VIOLATION 62C 63 IF(PROTCT(X)) GO TO 10000 64C !PROTECTION VIOLATION? 65 PRINT 10100 66#ifdef NOCC 6710100 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 7810100 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 91C 92C NOW START INITIALIZATION PROPER 93C 94#ifdef PDP 95C 96C Note: arrays FLAGS & SWITCH are initialized in the following 97C DATA statements, instead of using DO loops and assignments 98C as used before. This saves some code space. 99C 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./ 108C 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/ 112C 113C Note: SWITCH(13) or MLOC is initialized equal to MRB later. 114C 115C 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/ 139C 140 DATA RECNO/1/ 141 DATA MBASE/0/ 142 DATA INPCH/5/ 143 DATA OUTCH/5/ 144 DATA DBCH/2/ 145C 146C INIT, PAGE 3 147C 148C 149 DATA DBGFLG/0/ 150 DATA PRSFLG/0/ 151 DATA GDTFLG/0/ 152C 153 FROMDR=0 154 SCOLRM=0 155 SCOLAC=0 156 INIT=.FALSE. 157 MLOC=MRB 158C 159C INIT, PAGE 4 160C 161C NOW RESTORE FROM EXISTING INDEX FILE. 162C 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 168C 169 call intrd(MXSCOR) 170 call intrd(STRBIT) 171 call intrd(EGMXSC) 172C 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) 180C 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) 198C 199 call intrd(R2LNT) 200 call aryrd(20,OROOM2) 201 call aryrd(20,RROOM2) 202C 203 call intrd(CLNT) 204 call aryrd(25,CTICK) 205 call aryrd(25,CACTIO) 206C 207 do 990 i=1,25 208 cflag(i)=.TRUE. 209 call logrd(j) 210 if(j.EQ.0) CFLAG(i)=.FALSE. 211990 continue 212C 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) 219C 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) 228C 229 call intrd(MBASE) 230 call intrd(MLNT) 231C 232C The RTEXT array is not used here, and isn't read (it's used 233C in "speak.F") 234C 235 call initnd 236C 237C INIT, PAGE 5 238C 239C THE INTERNAL DATA BASE IS NOW ESTABLISHED. 240C SET UP TO PLAY THE GAME. 241C 2421025 CALL ITIME(SHOUR,SMIN,SSEC) 243 CALL INIRND(or(SHOUR,or(SMIN,SSEC))) 244C 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 252C 253C Normally, PRSFLG is setable in gdt to allow seeing various 254C parse results. Since the pdp version does not have gdt, 255C PRSFLG is set to show full debugging info when debug is enabled. 256C 257 PRSFLG=65535 258#endif debug 259C 260C 261 RETURN 262C INIT, PAGE 6 263C 264C ERRORS-- INIT FAILS. 265C 2661925 continue 267 END 268#else PDP 26910000 INIT=.FALSE. 270C !ASSUME INIT FAILS. 271 MMAX=1050 272C !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 283C 284 MLNT=0 285C !INIT ARRAY COUNTERS. 286 OLNT=0 287 RLNT=0 288 VLNT=0 289 ALNT=0 290 CLNT=0 291 XLNT=1 292 R2LNT=0 293C 294 LTSHFT=10 295C !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 307C !CLEAR PARSE VECTOR. 308 PRSI=0 309 PRSO=0 310 PRSCON=1 311 OFLAG=0 312C !CLEAR ORPHANS. 313 OACT=0 314 OSLOT=0 315 OPREP=0 316 ONAME=0 317 THFFLG=.FALSE. 318C !THIEF NOT INTRODUCED BUT 319 THFACT=.TRUE. 320C !IS ACTIVE. 321 SWDACT=.FALSE. 322C !SWORD IS INACTIVE. 323 SWDSTA=0 324C !SWORD IS OFF. 325C 326 RECNO=1 327C !INIT DB FILE POINTER. 328 MBASE=0 329C !INIT MELEE BASE. 330C LOGICAL UNIT NRS: 5=STDIN, 6=STDOUT 331 INPCH=5 332C !TTY INPUT 333 OUTCH=6 334 DBCH=2 335C !DATA BASE. 336C INIT, PAGE 3 337C 338C INIT ALL ARRAYS. 339C 340 DO 5 I=1,CMAX 341C !CLEAR CLOCK EVENTS 342 CFLAG(I)=.FALSE. 343 CTICK(I)=0 344 CACTIO(I)=0 3455 CONTINUE 346C 347 DO 10 I=1,FMAX 348C !CLEAR FLAGS. 349 FLAGS(I)=.FALSE. 35010 CONTINUE 351 BUOYF=.TRUE. 352C !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 359C !CLEAR SWITCHES. 360 SWITCH(I)=0 36112 CONTINUE 362 ORMTCH=4 363C !NUMBER OF MATCHES. 364 LCELL=1 365 PNUMB=1 366 MDIR=270 367 MLOC=MRB 368 CPHERE=10 369C 370 DO 15 I=1,R2MAX 371C !CLEAR ROOM 2 ARRAY. 372 RROOM2(I)=0 373 OROOM2(I)=0 37415 CONTINUE 375C 376 DO 20 I=1,XMAX 377C !CLEAR TRAVEL ARRAY. 378 TRAVEL(I)=0 37920 CONTINUE 380C 381 DO 30 I=1,VMAX 382C !CLEAR VILLAINS ARRAYS. 383 VOPPS(I)=0 384 VPROB(I)=0 385 VILLNS(I)=0 386 VBEST(I)=0 387 VMELEE(I)=0 38830 CONTINUE 389C 390 DO 40 I=1,OMAX 391C !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 40640 CONTINUE 407C 408 RDESC2=0 409C !CLEAR DESC BASE PTR. 410 DO 50 I=1,RMAX 411C !CLEAR ROOM ARRAYS. 412 RDESC1(I)=0 413 RACTIO(I)=0 414 RFLAG(I)=0 415 RVAL(I)=0 416 REXIT(I)=0 41750 CONTINUE 418C 419 DO 60 I=1,MMAX 420C !CLEAR MESSAGE DIRECTORY. 421 RTEXT(I)=0 42260 CONTINUE 423C 424 DO 70 I=1,AMAX 425C !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 43370 CONTINUE 434C 435 DBGFLG=0 436 PRSFLG=0 437 GDTFLG=0 438C 439C allow setting gdtflg true if user id matches wizard id 440C this way, the wizard doesn't have to recompile to use gdt 441C 442 if (getuid() .eq. WIZARDID) gdtflg=1 443C 444 FROMDR=0 445C !INIT SCOL GOODIES. 446 SCOLRM=0 447 SCOLAC=0 448C INIT, PAGE 4 449C 450C NOW RESTORE FROM EXISTING INDEX FILE. 451C 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 460C !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 472150 FORMAT('RESTORING FROM "dindx.dat"') 473#else NOCC 474150 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 489C 490 CLOSE(1) 491 GO TO 1025 492C !INIT DONE. 493C 494C 130 FORMAT(I8) 495130 FORMAT(I6) 496135 FORMAT(L4) 497C INIT, PAGE 5 498C 499C THE INTERNAL DATA BASE IS NOW ESTABLISHED. 500C SET UP TO PLAY THE GAME. 501C 5021025 CALL ITIME(SHOUR,SMIN,SSEC) 503C !GET TIME AND DATE. 504C 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))) 508C 509 WINNER=PLAYER 510 LASTIT=AOBJ(PLAYER) 511 HERE=AROOM(WINNER) 512 THFPOS=OROOM(THIEF) 513 BLOC=OROOM(BALLO) 514 INIT=.TRUE. 515C 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 5201050 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 5291050 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 5401150 FORMAT('MAX SCORE=',I5/'EG SCORE=',I5/ 541& 'MAX RECNO=',I5/'RDESC2 BASE=',I5/ 542& 'MELEE START=',I5/'STAR MASK=',I7) 543#else NOCC 5441150 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 550C 551 RETURN 552C INIT, PAGE 6 553C 554C ERRORS-- INIT FAILS. 555C 5561900 PRINT 910 557 PRINT 980 558 RETURN 5591925 PRINT 920,I,J,K,VMAJ,VMIN,VEDIT 560 PRINT 980 561 RETURN 5621950 PRINT 960 563 PRINT 980 564 RETURN 565#ifdef NOCC 566910 FORMAT('I can''t open ',INDXFILE,'.') 567920 FORMAT('"dindx.dat" is version ',I1,'.',I1,A1,'.'/ 568& 'I require version ',I1,'.',I1,A1,'.') 569960 FORMAT('I can''t open ',TEXTFILE,'.') 570980 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 579910 FORMAT(' I can''t open ',INDXFILE,'.') 580920 FORMAT(' "dindx.dat" is version ',I1,'.',I1,A1,'.'/ 581& ' I require version ',I1,'.',I1,A1,'.') 582960 FORMAT(' I can''t open ',TEXTFILE,'.') 583980 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 592C 593 END 594C PROTCT-- CHECK FOR USER VIOLATION 595C 596C THIS ROUTINE SHOULD BE MODIFIED IF YOU WISH TO ADD SYSTEM 597C DEPENDANT PROTECTION AGAINST ABUSE. 598C 599C AT THE MOMENT, PLAY IS PERMITTED UNDER ALL CIRCUMSTANCES. 600C 601 LOGICAL FUNCTION PROTCT(X) 602 IMPLICIT INTEGER(A-Z) 603C 604 PROTCT=.TRUE. 605 RETURN 606 END 607#endif PDP 608