1 C Main program for DUNGEON
  2 C
  3 C COPYRIGHT 1980, 1990, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA.
  4 C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
  5 C WRITTEN BY R. M. SUPNIK
  6 C
  7 C 16-Aug-94         RMS       Version 3.2.
  8 C 30-Jun-92         RMS       Changed file names to lower case.
  9 C 29-Jun-92         RMS       Changed OUTCH to 6 for VAX, UNIX compatibility.
 10 C
 11           PROGRAM DUNGEON
 12 C
 13 C Declarations
 14 C
 15           IMPLICIT INTEGER (A-Z)
 16           LOGICAL INITFL
 17           %include dparam
 18 C page
 19 C DUNGEON, PAGE 2
 20 C
 21 C 1) Initialize data structures
 22 C 2) Initialize files
 23 C 3) Play game
 24 C
 25           MLNT=0                                            ! init array counters.
 26           OLNT=0                                            ! array limits are parameters
 27           RLNT=0
 28           VLNT=0
 29           ALNT=0
 30           CLNT=0
 31           XLNT=1
 32           R2LNT=0
 33 C
 34           LTSHFT=10                               ! set up state variables.
 35           MXSCOR=LTSHFT
 36           EGSCOR=0
 37           EGMXSC=0
 38           MXLOAD=100
 39           RWSCOR=0
 40           DEATHS=0
 41           MOVES=0
 42           PLTIME=0
 43           MUNGRM=0
 44           HS=0
 45           PRSA=0                                            ! clear parse vector.
 46           PRSI=0
 47           PRSO=0
 48           PRSCON=1
 49           OFLAG=0                                           ! clear orphans.
 50           OACT=0
 51           OPREP1=0
 52           OOBJ1=0
 53           OPREP=0
 54           ONAME=' '
 55           OPREP2=0
 56           OOBJ2=0
 57           BUNLNT=0                                ! clear bunch vector.
 58           BUNSUB=0
 59           DO 100 I=1,BUNMAX
 60             BUNVEC(I)=0
 61 100       CONTINUE
 62           THFFLG=.FALSE.                                    ! thief not introduced but
 63           THFACT=.TRUE.                                     ! is active.
 64           SWDACT=.FALSE.                                    ! sword is inactive.
 65           SWDSTA=0                                ! sword is off.
 66 C
 67           MBASE=0                                           ! init melee base.
 68           INPCH=5                                           ! tty input
 69           OUTCH=6                                           ! tty output.
 70           DBCH=2                                            ! data base.
 71 C page
 72 C DUNGEON, PAGE 3
 73 C
 74 C Init all arrays.
 75 C
 76           DO 200 I=1,CMAX                                   ! clear clock events
 77             CFLAG(I)=.FALSE.
 78             CCNCEL(I)=.FALSE.
 79             CTICK(I)=0
 80             CACTIO(I)=0
 81 200       CONTINUE
 82 C
 83           DO 300 I=1,FMAX                                   ! clear flags.
 84             FLAGS(I)=.FALSE.
 85 300       CONTINUE
 86           EGYPTF=.TRUE.                                     ! some start as true.
 87           CAGETF=.TRUE.
 88           MR1F=.TRUE.
 89           MR2F=.TRUE.
 90           FOLLWF=.TRUE.
 91           DO 400 I=1,SMAX                                   ! clear switches.
 92             SWITCH(I)=0
 93 400       CONTINUE
 94           ORMTCH=4                                ! number of matches.
 95           LCELL=1
 96           PNUMB=1
 97           MDIR=270
 98           MLOC=MRB
 99           CPHERE=10
100 C
101           DO 500 I=1,R2MAX                        ! clear room 2 array.
102             R2(I)=0
103             O2(I)=0
104 500       CONTINUE
105 C
106           DO 600 I=1,XXMAX                        ! clear travel array.
107             TRAVEL(I)=0
108 600       CONTINUE
109 C
110           DO 700 I=1,VMAX                                   ! clear villains arrays.
111             VOPPS(I)=0
112             VPROB(I)=0
113             VILLNS(I)=0
114             VBEST(I)=0
115             VMELEE(I)=0
116 700       CONTINUE
117 C page
118 C DUNGEON, PAGE 4
119 C
120           DO 800 I=1,OMAX                                   ! clear object arrays.
121             ODESC1(I)=0
122             ODESC2(I)=0
123             ODESCO(I)=0
124             OREAD(I)=0
125             OACTIO(I)=0
126             OFLAG1(I)=0
127             OFLAG2(I)=0
128             OFVAL(I)=0
129             OTVAL(I)=0
130             OSIZE(I)=0
131             OCAPAC(I)=0
132             OCAN(I)=0
133             OADV(I)=0
134             OROOM(I)=0
135 800       CONTINUE
136 C
137           RDESC2=0                                ! clear desc base ptr.
138           DO 900 I=1,RMAX                                   ! clear room arrays.
139             RDESC1(I)=0
140             RACTIO(I)=0
141             RFLAG(I)=0
142             RVAL(I)=0
143             REXIT(I)=0
144 900       CONTINUE
145 C
146           DO 1000 I=1,MMAX                        ! clear message directory.
147             RTEXT(I)=0
148 1000      CONTINUE
149 C
150           DO 1100 I=1,AMAX                        ! clear adventurer's arrays.
151             AROOM(I)=0
152             ASCORE(I)=0
153             AVEHIC(I)=0
154             AOBJ(I)=0
155             AACTIO(I)=0
156             ASTREN(I)=0
157             AFLAG(I)=0
158 1100      CONTINUE
159 C
160           DBGFLG=0
161           PRSFLG=0
162           GDTFLG=1
163 C
164           FROMDR=0                                ! init scol goodies.
165           SCOLRM=0
166           SCOLAC=0
167 C
168           IF(INITFL(X)) CALL GAME                           ! if init files, play game.
169           CALL EXIT                               ! done
170           END
171           BLOCK DATA FOO
172           IMPLICIT INTEGER (A-Z)
173           %include dparam
174 C
175 C Data statements for constant arrays
176 C
177           DATA VMAJ/3/,VMIN/2/,VEDIT/'B'/
178 C
179           DATA BATDRP/66,67,68,69,70,71,72,65,73/
180 C
181           DATA SCOLDR/XNORTH,BKTWI,XSOUTH,BKVAU,XEAST,BKVE,XWEST,BKVW/
182           DATA SCOLWL/BKVW,271,XEAST,BKVE,272,XWEST,
183           &         BKTWI,270,XSOUTH,BKVAU,269,XNORTH/
184 C
185           DATA CPDR/XNORTH,-8,XNE,-7,XEAST,1,XSE,9,
186           &         XSOUTH,8,XSW,7,XWEST,-1,XNW,-9/
187           DATA CPWL/269,-8,270,8,271,1,272,-1/
188           DATA CPVEC/1,1,1,1,1,1,1,1,
189           &         1,0,-1,0,0,-1,0,1,
190           &         1,-1,0,1,0,-2,0,1,
191           &         1,0,0,0,0,1,0,1,
192           &         1,-3,0,0,-1,-1,0,1,
193           &         1,0,0,-1,0,0,0,1,
194           &         1,1,1,0,0,0,1,1,
195           &         1,1,1,1,1,1,1,1/
196 C
197           DATA XELNT/1,2,3,3/
198           END
199 C page
200 C TXCRYP - Subroutine to encrypt/decrypt text strings.
201 C
202 C This subroutine performs a reversible encryption on a text string.
203 C The purpose is not to protect the data base but to make it more
204 C difficult for the casual game user to read the data base file.
205 C It is located here, rather than in the SUBRoutine module, because
206 C it is used by both the game and the separate data base compiler.
207 C
208           SUBROUTINE TXCRYP(R,LINE)
209           IMPLICIT INTEGER (A-Z)
210           CHARACTER*(*) LINE
211 C
212           DO 100 I=1,LEN(LINE)
213 C old       X=(R.AND.31)+I
214 C old       LINE(I:I)=CHAR(ICHAR(LINE(I:I)).XOR.X)
215             X=AND(R,31)+I
216             LINE(I:I)=CHAR(INT(XOR(ICHAR(LINE(I:I)),X)))
217 100       CONTINUE
218           RETURN
219           END