xref: /csrg-svn/contrib/dungeon/dinit.F (revision 35973)

#include "files.h"

#ifndef INDXFILE
#define INDXFILE '/usr/games/lib/dunlib/dindx.dat'
#endif
#ifndef TEXTFILE
#define TEXTFILE '/usr/games/lib/dunlib/dtext.dat'
#endif
#ifndef WIZARDID
#define WIZARDID 0
#endif

C INIT-- DUNGEON INITIALIZATION SUBROUTINE
C
C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
C WRITTEN BY R. M. SUPNIK
C
C DECLARATIONS
C
	LOGICAL FUNCTION INIT(X)
	IMPLICIT INTEGER (A-Z)
#ifndef PDP
	LOGICAL PROTCT
	INTEGER DATARR(3)
#endif PDP
#include "parser.h"
#include "gamestate.h"
#include "state.h"
#include "screen.h"
#include "mindex.h"
C
C MISCELLANEOUS VARIABLES
C
	COMMON /STAR/ MBASE,STRBIT
	COMMON /VERS/ VMAJ,VMIN,VEDIT
	COMMON /TIME/ PLTIME,SHOUR,SMIN,SSEC
#include "io.h"
#include "debug.h"
	COMMON /HYPER/ HFACTR
#include "rooms.h"
#include "rflag.h"
#include "rindex.h"
#include "exits.h"
#include "curxt.h"
#include "xpars.h"
#include "objects.h"
#include "oindex.h"
#include "clock.h"
#include "villians.h"
#include "advers.h"
#include "flags.h"
C INIT, PAGE 2
C
#ifndef PDP
#ifdef SYSV
C make output unbuffered
	call unbuf
C
#endif
C FIRST CHECK FOR PROTECTION VIOLATION
C
	IF(PROTCT(X)) GO TO 10000
C						!PROTECTION VIOLATION?
	PRINT 10100
#ifdef NOCC
10100	FORMAT('There appears before you a threatening figure clad '
&	'all over'/'in heavy black armor.  His legs seem like the '
&	'massive trunk'/'of the oak tree.  His broad shoulders and '
&	'helmeted head loom'/'high over your own puny frame, and '
&	'you realize that his powerful'/'arms could easily crush the '
&	'very life from your body.  There'/'hangs from his belt a '
&	'veritable arsenal of deadly weapons:'/'sword, mace, ball '
&	'and chain, dagger, lance, and trident.'/'He speaks with a '
&	'commanding voice:'//20X,'"You shall not pass."'//'As '
&	'he grabs you by the neck all grows dim about you.')
#else NOCC
10100	FORMAT(' There appears before you a threatening figure clad '
&	'all over'/' in heavy black armor.  His legs seem like the '
&	'massive trunk'/' of the oak tree.  His broad shoulders and '
&	'helmeted head loom'/' high over your own puny frame, and '
&	'you realize that his powerful'/' arms could easily crush the '
&	'very life from your body.  There'/' hangs from his belt a '
&	'veritable arsenal of deadly weapons:'/' sword, mace, ball '
&	'and chain, dagger, lance, and trident.'/' He speaks with a '
&	'commanding voice:'//20X,'"You shall not pass."'//' As '
&	'he grabs you by the neck all grows dim about you.')
#endif NOCC
	CALL EXIT
#endif PDP
C
C NOW START INITIALIZATION PROPER
C
#ifdef PDP
C
C   Note: arrays FLAGS & SWITCH are initialized in the following
C           DATA statements, instead of using DO loops and assignments
C           as used before.  This saves some code space.
C
	DATA FLAGS/.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,
&		   .FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,
&		   .FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,
&		    .TRUE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.TRUE.,
&		   .FALSE.,.FALSE.,.FALSE.,.TRUE.,.FALSE.,.FALSE.,
&		   .FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,
&		   .FALSE.,.FALSE.,.FALSE.,.TRUE.,.TRUE.,.FALSE.,
&		    .TRUE.,.FALSE.,.FALSE.,.FALSE./
C
	DATA SWITCH/0,0,0,0,0,0,0,0,0,
&		    4,0,270,0,0,0,0,0,
&		    1,1,0,0,10/
C
C   Note: SWITCH(13) or MLOC is initialized equal to MRB later.
C
C
	DATA LTSHFT/10/
	DATA EGSCOR/0/
	DATA EGMXSC/0/
	DATA MXLOAD/100/
	DATA RWSCOR/0/
	DATA DEATHS/0/
	DATA MOVES/0/
	DATA PLTIME/0/
	DATA MUNGRM/0/
	DATA HS/0/
	DATA PRSA/0/
	DATA PRSI/0/
	DATA PRSO/0/
	DATA PRSCON/1/
	DATA OFLAG/0/
	DATA OACT/0/
	DATA OSLOT/0/
	DATA OPREP/0/
	DATA ONAME/0/
	DATA THFFLG/.FALSE./
	DATA THFACT/.TRUE./
	DATA SWDACT/.FALSE./
	DATA SWDSTA/0/
C
	DATA RECNO/1/
	DATA MBASE/0/
	DATA INPCH/5/
	DATA OUTCH/5/
	DATA DBCH/2/
C
C INIT, PAGE 3
C
C
	DATA DBGFLG/0/
	DATA PRSFLG/0/
	DATA GDTFLG/0/
C
	FROMDR=0
	SCOLRM=0
	SCOLAC=0
	INIT=.FALSE.
	MLOC=MRB
C
C INIT, PAGE 4
C
C NOW RESTORE FROM EXISTING INDEX FILE.
C
	call intrd(i)
	call intrd(j)
	call intrd(k)
	IF((I.NE.VMAJ).OR.(J.NE.VMIN))
&		GO TO 1925
C
	call intrd(MXSCOR)
	call intrd(STRBIT)
	call intrd(EGMXSC)
C
	call intrd(RLNT)
	call intrd(RDESC2)
	call aryrd(200,RDESC1)
	call aryrd(200,REXIT)
	call aryrd(200,RACTIO)
	call aryrd(200,RVAL)
	call aryrd(200,RFLAG)
C
	call intrd(XLNT)
	call aryrd(900,TRAVEL)
	call intrd(OLNT)
	call aryrd(220,ODESC1)
	call aryrd(220,ODESC2)
	call aryrd(220,ODESCO)
	call aryrd(220,OACTIO)
	call aryrd(220,OFLAG1)
	call aryrd(220,OFLAG2)
	call aryrd(220,OFVAL)
	call aryrd(220,OTVAL)
	call aryrd(220,OSIZE)
	call aryrd(220,OCAPAC)
	call aryrd(220,OROOM)
	call aryrd(220,OADV)
	call aryrd(220,OCAN)
	call aryrd(220,OREAD)
C
	call intrd(R2LNT)
	call aryrd(20,OROOM2)
	call aryrd(20,RROOM2)
C
	call intrd(CLNT)
	call aryrd(25,CTICK)
	call aryrd(25,CACTIO)
C
	do 990 i=1,25
	cflag(i)=.TRUE.
	call logrd(j)
	if(j.EQ.0) CFLAG(i)=.FALSE.
990	continue
C
	call intrd(VLNT)
	call aryrd(4,VILLNS)
	call aryrd(4,VPROB)
	call aryrd(4,VOPPS)
	call aryrd(4,VBEST)
	call aryrd(4,VMELEE)
C
	call intrd(ALNT)
	call aryrd(4,AROOM)
	call aryrd(4,ASCORE)
	call aryrd(4,AVEHIC)
	call aryrd(4,AOBJ)
	call aryrd(4,AACTIO)
	call aryrd(4,ASTREN)
	call aryrd(4,AFLAG)
C
	call intrd(MBASE)
	call intrd(MLNT)
C
C   The RTEXT array is not used here, and isn't read (it's used
C   in "speak.F")
C
	call initnd
C
C INIT, PAGE 5
C
C THE INTERNAL DATA BASE IS NOW ESTABLISHED.
C SET UP TO PLAY THE GAME.
C
1025	CALL ITIME(SHOUR,SMIN,SSEC)
	CALL INIRND(or(SHOUR,or(SMIN,SSEC)))
C
	WINNER=PLAYER
	LASTIT=AOBJ(PLAYER)
	HERE=AROOM(WINNER)
	THFPOS=OROOM(THIEF)
	BLOC=OROOM(BALLO)
	INIT=.TRUE.
#ifdef debug
C
C	Normally, PRSFLG is setable in gdt to allow seeing various
C	parse results.  Since the pdp version does not have gdt,
C	PRSFLG is set to show full debugging info when debug is enabled.
C
	PRSFLG=65535
#endif debug
C
C
	RETURN
C INIT, PAGE 6
C
C ERRORS-- INIT FAILS.
C
1925	continue
	END
#else PDP
10000	INIT=.FALSE.
C						!ASSUME INIT FAILS.
	MMAX=1050
C						!SET UP ARRAY LIMITS.
	OMAX=220
	RMAX=200
	VMAX=4
	AMAX=4
	CMAX=25
	FMAX=46
	SMAX=22
	XMAX=900
	R2MAX=20
	DIRMAX=15
C
	MLNT=0
C						!INIT ARRAY COUNTERS.
	OLNT=0
	RLNT=0
	VLNT=0
	ALNT=0
	CLNT=0
	XLNT=1
	R2LNT=0
C
	LTSHFT=10
C						!SET UP STATE VARIABLES.
	MXSCOR=LTSHFT
	EGSCOR=0
	EGMXSC=0
	MXLOAD=100
	RWSCOR=0
	DEATHS=0
	MOVES=0
	PLTIME=0
	MUNGRM=0
	HS=0
	PRSA=0
C						!CLEAR PARSE VECTOR.
	PRSI=0
	PRSO=0
	PRSCON=1
	OFLAG=0
C						!CLEAR ORPHANS.
	OACT=0
	OSLOT=0
	OPREP=0
	ONAME=0
	THFFLG=.FALSE.
C						!THIEF NOT INTRODUCED BUT
	THFACT=.TRUE.
C						!IS ACTIVE.
	SWDACT=.FALSE.
C						!SWORD IS INACTIVE.
	SWDSTA=0
C						!SWORD IS OFF.
C
	RECNO=1
C						!INIT DB FILE POINTER.
	MBASE=0
C						!INIT MELEE BASE.
C   LOGICAL UNIT NRS: 5=STDIN, 6=STDOUT
	INPCH=5
C						!TTY INPUT
	OUTCH=6
	DBCH=2
C						!DATA BASE.
C INIT, PAGE 3
C
C INIT ALL ARRAYS.
C
	DO 5 I=1,CMAX
C						!CLEAR CLOCK EVENTS
	  CFLAG(I)=.FALSE.
	  CTICK(I)=0
	  CACTIO(I)=0
5	CONTINUE
C
	DO 10 I=1,FMAX
C						!CLEAR FLAGS.
	  FLAGS(I)=.FALSE.
10	CONTINUE
	BUOYF=.TRUE.
C						!SOME START AS TRUE.
	EGYPTF=.TRUE.
	CAGETF=.TRUE.
	MR1F=.TRUE.
	MR2F=.TRUE.
	FOLLWF=.TRUE.
	DO 12 I=1,SMAX
C						!CLEAR SWITCHES.
	  SWITCH(I)=0
12	CONTINUE
	ORMTCH=4
C						!NUMBER OF MATCHES.
	LCELL=1
	PNUMB=1
	MDIR=270
	MLOC=MRB
	CPHERE=10
C
	DO 15 I=1,R2MAX
C						!CLEAR ROOM 2 ARRAY.
	  RROOM2(I)=0
	  OROOM2(I)=0
15	CONTINUE
C
	DO 20 I=1,XMAX
C						!CLEAR TRAVEL ARRAY.
	  TRAVEL(I)=0
20	CONTINUE
C
	DO 30 I=1,VMAX
C						!CLEAR VILLAINS ARRAYS.
	  VOPPS(I)=0
	  VPROB(I)=0
	  VILLNS(I)=0
	  VBEST(I)=0
	  VMELEE(I)=0
30	CONTINUE
C
	DO 40 I=1,OMAX
C						!CLEAR OBJECT ARRAYS.
	  ODESC1(I)=0
	  ODESC2(I)=0
	  ODESCO(I)=0
	  OREAD(I)=0
	  OACTIO(I)=0
	  OFLAG1(I)=0
	  OFLAG2(I)=0
	  OFVAL(I)=0
	  OTVAL(I)=0
	  OSIZE(I)=0
	  OCAPAC(I)=0
	  OCAN(I)=0
	  OADV(I)=0
	  OROOM(I)=0
40	CONTINUE
C
	RDESC2=0
C						!CLEAR DESC BASE PTR.
	DO 50 I=1,RMAX
C						!CLEAR ROOM ARRAYS.
	  RDESC1(I)=0
	  RACTIO(I)=0
	  RFLAG(I)=0
	  RVAL(I)=0
	  REXIT(I)=0
50	CONTINUE
C
	DO 60 I=1,MMAX
C						!CLEAR MESSAGE DIRECTORY.
	  RTEXT(I)=0
60	CONTINUE
C
	DO 70 I=1,AMAX
C						!CLEAR ADVENTURER'S ARRAYS.
	  AROOM(I)=0
	  ASCORE(I)=0
	  AVEHIC(I)=0
	  AOBJ(I)=0
	  AACTIO(I)=0
	  ASTREN(I)=0
	  AFLAG(I)=0
70	CONTINUE
C
	DBGFLG=0
	PRSFLG=0
	GDTFLG=0
C
C allow setting gdtflg true if user id matches wizard id
C this way, the wizard doesn't have to recompile to use gdt
C
	if (getuid() .eq. WIZARDID) gdtflg=1
C
	FROMDR=0
C						!INIT SCOL GOODIES.
	SCOLRM=0
	SCOLAC=0
C INIT, PAGE 4
C
C NOW RESTORE FROM EXISTING INDEX FILE.
C
	OPEN(UNIT=1,file=INDXFILE,status='OLD',
#ifdef XELOS
&		FORM='FORMATTED',ACCESS='SEQUENTIAL',ERR=1900,recl=1)
#else
&		FORM='FORMATTED',ACCESS='SEQUENTIAL',ERR=1900)
#endif
	rewind(unit=1, err=1900)
	READ(1,130) I,J,K
C						!GET VERSION.
	IF((I.NE.VMAJ).OR.(J.NE.VMIN))
&		GO TO 1925

	OPEN(UNIT=DBCH,file=TEXTFILE,status='OLD',
&		FORM='UNFORMATTED',ACCESS='DIRECT',
&		recl=76,ERR=1950)
	rewind(unit=dbch, err=1950)

#ifdef debug
	PRINT 150
#ifdef NOCC
150	FORMAT('RESTORING FROM "dindx.dat"')
#else NOCC
150	FORMAT(' RESTORING FROM "dindx.dat"')
#endif NOCC
#endif debug
	READ(1,130) MXSCOR,STRBIT,EGMXSC
	READ(1,130) RLNT,RDESC2,RDESC1,REXIT,RACTIO,RVAL,RFLAG
	READ(1,130) XLNT,TRAVEL
	READ(1,130) OLNT,ODESC1,ODESC2,ODESCO,OACTIO,OFLAG1,OFLAG2,
&		OFVAL,OTVAL,OSIZE,OCAPAC,OROOM,OADV,OCAN,
&		OREAD
	READ(1,130) R2LNT,OROOM2,RROOM2
	READ(1,130) CLNT,CTICK,CACTIO
	READ(1,135) CFLAG
	READ(1,130) VLNT,VILLNS,VPROB,VOPPS,VBEST,VMELEE
	READ(1,130) ALNT,AROOM,ASCORE,AVEHIC,AOBJ,AACTIO,ASTREN,AFLAG
	READ(1,130) MBASE,MLNT,RTEXT
C
	CLOSE(1)
	GO TO 1025
C						!INIT DONE.
C
C 130	FORMAT(I8)
130	FORMAT(I6)
135	FORMAT(L4)
C INIT, PAGE 5
C
C THE INTERNAL DATA BASE IS NOW ESTABLISHED.
C SET UP TO PLAY THE GAME.
C
1025	CALL ITIME(SHOUR,SMIN,SSEC)
C						!GET TIME AND DATE.
C	CALL IDATE(I,J,K)
	CALL IDATE(DATARR(1))
	CALL INIRND(or(DATARR(1),or(DATARR(2),DATARR(3))),
&		or(SHOUR,or(SMIN,SSEC)))
C
	WINNER=PLAYER
	LASTIT=AOBJ(PLAYER)
	HERE=AROOM(WINNER)
	THFPOS=OROOM(THIEF)
	BLOC=OROOM(BALLO)
	INIT=.TRUE.
C
#ifdef debug
	PRINT 1050,RLNT,RMAX,XLNT,XMAX,OLNT,OMAX,MLNT,MMAX,
&	  VLNT,VMAX,ALNT,AMAX,CLNT,CMAX,R2LNT,R2MAX
#ifdef NOCC
1050	FORMAT('USED:'/I5,' OF',I5,' ROOMS'/
&	  I5,' OF',I5,' EXITS'/
&	  I5,' OF',I5,' OBJECTS'/
&	  I5,' OF',I5,' MESSAGES'/
&	  I5,' OF',I5,' VILLAINS'/
&	  I5,' OF',I5,' ADVENTURERS'/
&	  I5,' OF',I5,' CLOCK EVENTS'/
&	  I5,' OF',I5,' ROOM2 SLOTS')
#else NOCC
1050	FORMAT(' USED:'/1X,I5,' OF',I5,' ROOMS'/
&	  1X,I5,' OF',I5,' EXITS'/
&	  1X,I5,' OF',I5,' OBJECTS'/
&	  1X,I5,' OF',I5,' MESSAGES'/
&	  1X,I5,' OF',I5,' VILLAINS'/
&	  1X,I5,' OF',I5,' ADVENTURERS'/
&	  1X,I5,' OF',I5,' CLOCK EVENTS'/
&	  1X,I5,' OF',I5,' ROOM2 SLOTS')
#endif NOCC
	PRINT 1150,MXSCOR,EGMXSC,RECNO,RDESC2,MBASE,STRBIT
#ifdef NOCC
1150	FORMAT('MAX SCORE=',I5/'EG SCORE=',I5/
&	  'MAX RECNO=',I5/'RDESC2 BASE=',I5/
&	  'MELEE START=',I5/'STAR MASK=',I7)
#else NOCC
1150	FORMAT(' MAX SCORE=',I5/' EG SCORE=',I5/
&	  ' MAX RECNO=',I5/' RDESC2 BASE=',I5/
&	  ' MELEE START=',I5/' STAR MASK=',I7)
#endif NOCC
	PAUSE 1
#endif debug
C
	RETURN
C INIT, PAGE 6
C
C ERRORS-- INIT FAILS.
C
1900	PRINT 910
	PRINT 980
	RETURN
1925	PRINT 920,I,J,K,VMAJ,VMIN,VEDIT
	PRINT 980
	RETURN
1950	PRINT 960
	PRINT 980
	RETURN
#ifdef NOCC
910	FORMAT('I can''t open ',INDXFILE,'.')
920	FORMAT('"dindx.dat" is version ',I1,'.',I1,A1,'.'/
&		'I require version ',I1,'.',I1,A1,'.')
960	FORMAT('I can''t open ',TEXTFILE,'.')
980	FORMAT('Suddenly a sinister, wraithlike figure appears before '
&	'you,'/'seeming to float in the air.  In a low, sorrowful voice'
&	' he says,'/'"Alas, the very nature of the world has changed, '
&	'and the dungeon'/'cannot be found.  All must now pass away."'
&	'  Raising his oaken staff'/'in farewell, he fades into the '
&	'spreading darkness.  In his place'/'appears a tastefully '
&	'lettered sign reading:'//23X,'INITIALIZATION FAILURE'//
&	'The darkness becomes all encompassing, and your vision fails.')
#else NOCC
910	FORMAT(' I can''t open ',INDXFILE,'.')
920	FORMAT(' "dindx.dat" is version ',I1,'.',I1,A1,'.'/
&		' I require version ',I1,'.',I1,A1,'.')
960	FORMAT(' I can''t open ',TEXTFILE,'.')
980	FORMAT(' Suddenly a sinister, wraithlike figure appears before '
&	'you,'/' seeming to float in the air.  In a low, sorrowful voice'
&	' he says,'/' "Alas, the very nature of the world has changed, '
&	'and the dungeon'/' cannot be found.  All must now pass away."'
&	'  Raising his oaken staff'/' in farewell, he fades into the '
&	'spreading darkness.  In his place'/' appears a tastefully '
&	'lettered sign reading:'//23X,'INITIALIZATION FAILURE'//
&	' The darkness becomes all encompassing, and your vision fails.')
#endif NOCC
C
	END
C PROTCT-- CHECK FOR USER VIOLATION
C
C THIS ROUTINE SHOULD BE MODIFIED IF YOU WISH TO ADD SYSTEM
C DEPENDANT PROTECTION AGAINST ABUSE.
C
C AT THE MOMENT, PLAY IS PERMITTED UNDER ALL CIRCUMSTANCES.
C
	LOGICAL FUNCTION PROTCT(X)
	IMPLICIT INTEGER(A-Z)
C
	PROTCT=.TRUE.
	RETURN
	END
#endif PDP