1 C Game debugging tool 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 Declarations
  8 C
  9           SUBROUTINE GDT
 10           IMPLICIT INTEGER (A-Z)
 11           %include dparam
 12           PARAMETER (DBGMAX=38)                             ! number of debug commands
 13           CHARACTER*2 CMD,DBGCMD(DBGMAX),DBGSML(DBGMAX)
 14           INTEGER ARGTYP(DBGMAX)
 15           LOGICAL VALID1,VALID2,VALID3
 16 C
 17 C Equivalanced array definitions
 18 C
 19           INTEGER EQR(RMAX,5)
 20           EQUIVALENCE (EQR(1,1),RDESC1(1))
 21           INTEGER EQO(OMAX,14)
 22           EQUIVALENCE (EQO(1,1),ODESC1(1))
 23           INTEGER EQC(CMAX,2)
 24           EQUIVALENCE (EQC(1,1),CTICK(1))
 25           INTEGER EQV(VMAX,5)
 26           EQUIVALENCE (EQV(1,1),VILLNS(1))
 27           INTEGER EQA(AMAX,7)
 28           EQUIVALENCE (EQA(1,1),AROOM(1))
 29 C
 30 C Functions and data
 31 C
 32           VALID1(A1,L1)=(A1.GT.0).AND.(A1.LE.L1)
 33           VALID2(A1,A2,L1)=VALID1(A1,L1).AND.VALID1(A2,L1).AND.
 34           &         (A1.LE.A2)
 35           VALID3(A1,L1,A2,L2)=VALID1(A1,L1).AND.VALID1(A2,L2)
 36           DATA DBGCMD/'DR','DO','DA','DC','DX','DH','DL','DV','DF','DS',
 37           &         'AF','HE','NR','NT','NC','ND','RR','RT','RC','RD',
 38           &         'TK','EX','AR','AO','AA','AC','AX','AV','D2','DN',
 39           &         'AN','DM','DT','AH','DP','PD','DZ','AZ'/
 40           DATA DBGSML/'dr','do','da','dc','dx','dh','dl','dv','df','ds',
 41           &         'af','he','nr','nt','nc','nd','rr','rt','rc','rd',
 42           &         'tk','ex','ar','ao','aa','ac','ax','av','d2','dn',
 43           &         'an','dm','dt','ah','dp','pd','dz','az'/
 44           DATA ARGTYP/  2 ,  2 ,  2 ,  2 ,  2 ,  0 ,  0 ,  2 ,  2 ,  0 ,
 45           &           1 ,  0 ,  0 ,  0 ,  0 ,  0 ,  0 ,  0 ,  0 ,  0 ,
 46           &           1 ,  0 ,  3 ,  3 ,  3 ,  3 ,  1 ,  3 ,  2 ,  2 ,
 47           &           1 ,  2 ,  1 ,  0 ,  0 ,  0 ,  0 ,  1 /
 48 C page
 49 C GDT, PAGE 2
 50 C
 51 C First, validate that the caller is an implementer.
 52 C
 53           IF(GDTFLG.NE.0) GO TO 2000              ! if ok, skip.
 54           WRITE(OUTCH,100)                        ! not an implementer.
 55           RETURN                                            ! boot him off
 56 C
 57 100       FORMAT(' You are not an authorized user.')
 58 C page
 59 c GDT, PAGE 2A
 60 C
 61 C Here to get next command.
 62 C
 63 2000      WRITE(OUTCH,200)                        ! output prompt.
 64           READ(INPCH,210,ERR=2200,END=31000) CMD  ! get command.
 65           IF(CMD.EQ.'  ') GO TO 2000              ! ignore blanks.
 66           DO 2100 I=1,DBGMAX                      ! look it up.
 67             IF((CMD.EQ.DBGCMD(I)).OR.(CMD.EQ.DBGSML(I))) GO TO 2300
 68 2100      CONTINUE                                ! found?
 69 2200      WRITE(OUTCH,220)                        ! no, lose.
 70           GO TO 2000
 71 C
 72 200       FORMAT(' GDT> ',$)
 73 210       FORMAT(A2)
 74 220       FORMAT(' ?')
 75 230       FORMAT(2I6)
 76 240       FORMAT(I6)
 77 225       FORMAT(' Limits:   ',$)
 78 235       FORMAT(' Entry:    ',$)
 79 245       FORMAT(' Idx,Ary:  ',$)
 80 c
 81 2300      GO TO (2400,2500,2600,2700),ARGTYP(I)+1 ! branch on arg type.
 82           GO TO 2200                                        ! illegal type.
 83 C
 84 2700      WRITE(OUTCH,245)                        ! type 3, request array coords.
 85           READ(INPCH,230,ERR=2200,END=2000) J,K
 86           GO TO 2400
 87 C
 88 2600      WRITE(OUTCH,225)                        ! type 2, read bounds.
 89           READ(INPCH,230,ERR=2200,END=2000) J,K
 90           IF(K.EQ.0) K=J
 91           GO TO 2400
 92 C
 93 2500      WRITE(OUTCH,235)                        ! type 1, read entry no.
 94           READ(INPCH,240,ERR=2200,END=2000) J
 95 2400      GO TO (10000,11000,12000,13000,14000,15000,16000,17000,18000,
 96           & 19000,20000,21000,22000,23000,24000,25000,26000,27000,28000,
 97           & 29000,30000,31000,32000,33000,34000,35000,36000,37000,38000,
 98           & 39000,40000,41000,42000,43000,44000,45000,46000,47000),I
 99           GO TO 2200                                        ! what???
100 C page
101 C GDT, PAGE 3
102 C
103 C DR-- Display Rooms
104 C
105 10000     IF(.NOT.VALID2(J,K,RLNT)) GO TO 2200    ! args valid?
106           WRITE(OUTCH,300)                        ! col hdrs.
107           DO 10100 I=J,K
108             WRITE(OUTCH,310) I,(EQR(I,L),L=1,5)
109 10100     CONTINUE
110           GO TO 2000
111 C
112 300       FORMAT(' RM#  DESC1  EXITS ACTION  VALUE  FLAGS')
113 310       FORMAT(1X,I3,4(1X,I6),1X,O6)
114 C
115 C DO-- Display Objects
116 C
117 11000     IF(.NOT.VALID2(J,K,OLNT)) GO TO 2200    ! args valid?
118           WRITE(OUTCH,320)                        ! col hdrs
119           DO 11100 I=J,K
120             WRITE(OUTCH,330) I,(EQO(I,L),L=1,14)
121 11100     CONTINUE
122           GO TO 2000
123 C
124 320       FORMAT(' OB# DESC1 DESC2 DESCO ACT FLAGS1 FLAGS2 FV TV',
125           & '  SIZE CAPAC  ROOM ADV CON  READ')
126 330       FORMAT(1X,I3,3I6,I4,2O7,2I3,2I6,I6,2I4,I6)
127 C
128 C DA-- Display Adventurers
129 C
130 12000     IF(.NOT.VALID2(J,K,ALNT)) GO TO 2200    ! args valid?
131           WRITE(OUTCH,340)
132           DO 12100 I=J,K
133             WRITE(OUTCH,350) I,(EQA(I,L),L=1,7)
134 12100     CONTINUE
135           GO TO 2000
136 C
137 340       FORMAT(' AD#   ROOM  SCORE  VEHIC OBJECT ACTION  STREN  FLAGS')
138 350       FORMAT(1X,I3,6(1X,I6),1X,O6)
139 C
140 C DC-- Display Clock Events
141 C
142 13000     IF(.NOT.VALID2(J,K,CLNT)) GO TO 2200    ! args valid?
143           WRITE(OUTCH,360)
144           DO 13100 I=J,K
145             WRITE(OUTCH,370) I,(EQC(I,L),L=1,2),CFLAG(I),CCNCEL(I)
146 13100     CONTINUE
147           GO TO 2000
148 C
149 360       FORMAT(' CL#   TICK ACTION  FLAG  CANCEL')
150 370       FORMAT(1X,I3,1X,I6,1X,I6,5X,L1,5X,L1)
151 C
152 C DX-- Display Exits
153 C
154 14000     IF(.NOT.VALID2(J,K,XLNT)) GO TO 2200    ! args valid?
155           WRITE(OUTCH,380)                        ! col hdrs.
156           DO 14100 I=J,K,10                       ! ten per line.
157             L=MIN0(I+9,K)                                   ! compute end of line.
158             WRITE(OUTCH,390) I,L
159             DO 14050 L1=I,L                       ! loop through data
160               IF(TRAVEL(L1).GE.0) WRITE(OUTCH,391) TRAVEL(L1)
161               IF(TRAVEL(L1).LT.0) WRITE(OUTCH,392) TRAVEL(L1)
162 14050       CONTINUE
163           WRITE(OUTCH,393)
164 14100     CONTINUE
165           GO TO 2000
166 C
167 380       FORMAT('     RANGE CONTENTS')
168 390       FORMAT(1X,I4,'-',I4,1X,$)
169 391       FORMAT('+',O7,$)
170 392       FORMAT('+',I7,$)
171 393       FORMAT('+')
172 C
173 C DH-- Display Hacks
174 C
175 15000     WRITE(OUTCH,400) THFPOS,THFFLG,THFACT,SWDACT,SWDSTA
176           GO TO 2000
177 C
178 400       FORMAT(' THFPOS=',I6,', THFFLG=',L2,', THFACT=',L2/
179           &' SWDACT=',L2,', SWDSTA=',I2)
180 C
181 C DL-- Display Lengths
182 C
183 16000     WRITE(OUTCH,410) RLNT,XLNT,OLNT,CLNT,VLNT,ALNT,MLNT,R2LNT,
184           &         MBASE,STRBIT
185           GO TO 2000
186 C
187 410       FORMAT(' R=',I6,', X=',I6,', O=',I6,', C=',I6/
188           &' V=',I6,', A=',I6,', M=',I6,', R2=',I5/
189           &' MBASE=',I6,', STRBIT=',I6)
190 C
191 C DV-- Display Villains
192 C
193 17000     IF(.NOT.VALID2(J,K,VLNT)) GO TO 2200    ! args valid?
194           WRITE(OUTCH,420)                        ! col hdrs
195           DO 17100 I=J,K
196             WRITE(OUTCH,430) I,(EQV(I,L),L=1,5)
197 17100     CONTINUE
198           GO TO 2000
199 C
200 420       FORMAT(' VL# OBJECT   PROB   OPPS   BEST  MELEE')
201 430       FORMAT(1X,I3,5(1X,I6))
202 C
203 C DF-- Display Flags
204 C
205 18000     IF(.NOT.VALID2(J,K,FMAX)) GO TO 2200    ! args valid?
206           DO 18100 I=J,K
207             WRITE(OUTCH,440) I,FLAGS(I)
208 18100     CONTINUE
209           GO TO 2000
210 C
211 440       FORMAT(' Flag #',I2,' = ',L1)
212 C
213 C DS-- Display State
214 C
215 19000     WRITE(OUTCH,450) PRSA,PRSO,PRSI,PRSWON,PRSCON
216           WRITE(OUTCH,460) WINNER,HERE,TELFLG
217           WRITE(OUTCH,470) MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD,LTSHFT,BLOC,
218           &         MUNGRM,HS,EGSCOR,EGMXSC
219           WRITE(OUTCH,475) FROMDR,SCOLRM,SCOLAC
220           GO TO 2000
221 C
222 450       FORMAT(' Parse vector=',3(1X,I6),1X,L6,1X,I6)
223 460       FORMAT(' Play vector= ',2(1X,I6),1X,L6)
224 470       FORMAT(' State vector=',7(1X,I6)/14X,4(1X,I6))
225 475       FORMAT(' Scol vector= ',1X,O6,2(1X,I6))
226 C page
227 C GDT, PAGE 4
228 C
229 C AF-- Alter Flags
230 C
231 20000     IF(.NOT.VALID1(J,FMAX)) GO TO 2200      ! entry no valid?
232           WRITE(OUTCH,480) FLAGS(J)               ! type old, get new.
233           READ(INPCH,490,ERR=2200,END=2000) FLAGS(J)
234           GO TO 2000
235 C
236 480       FORMAT(' Old=',L2,6X,'New= ',$)
237 490       FORMAT(L1)
238 C
239 C 21000-- Help
240 C
241 21000     WRITE(OUTCH,900)
242           GO TO 2000
243 C
244 900       FORMAT(' Valid commands are:'/' AA- Alter ADVS'/
245           &' AC- Alter CEVENT'/' AF- Alter FINDEX'/' AH- Alter HERE'/
246           &' AN- Alter switches'/' AO- Alter OBJCTS'/' AR- Alter ROOMS'/
247           &' AV- Alter VILLS'/' AX- Alter EXITS'/
248           &' AZ- Alter PUZZLE'/' DA- Display ADVS'/
249           &' DC- Display CEVENT'/' DF- Display FINDEX'/' DH- Display HACKS'/
250           &' DL- Display lengths'/' DM- Display RTEXT'/
251           &' DN- Display switches'/
252           &' DO- Display OBJCTS'/' DP- Display parser'/
253           &' DR- Display ROOMS'/' DS- Display state'/' DT- Display text'/
254           &' DV- Display VILLS'/' DX- Display EXITS'/' DZ- Display PUZZLE'/
255           &' D2- Display ROOM2'/' EX- Exit'/' HE- Type this message'/
256           &' NC- No cyclops'/' ND- No deaths'/' NR- No robber'/
257           &' NT- No troll'/' PD- Program detail'/
258           &' RC- Restore cyclops'/' RD- Restore deaths'/
259           &' RR- Restore robber'/' RT- Restore troll'/' TK- Take.')
260 C
261 C NR-- No Robber
262 C
263 22000     THFFLG=.FALSE.                                    ! disable robber.
264           THFACT=.FALSE.
265           CALL NEWSTA(THIEF,0,0,0,0)              ! vanish thief.
266           WRITE(OUTCH,500)
267           GO TO 2000
268 C
269 500       FORMAT(' No robber.')
270 C
271 C NT-- No Troll
272 C
273 23000     TROLLF=.TRUE.
274           CALL NEWSTA(TROLL,0,0,0,0)
275           WRITE(OUTCH,510)
276           GO TO 2000
277 C
278 510       FORMAT(' No troll.')
279 C
280 C NC-- No Cyclops
281 C
282 24000     CYCLOF=.TRUE.
283           CALL NEWSTA(CYCLO,0,0,0,0)
284           WRITE(OUTCH,520)
285           GO TO 2000
286 C
287 520       FORMAT(' No cyclops.')
288 C
289 C ND-- Immortality Mode
290 C
291 25000     DBGFLG=1
292           WRITE(OUTCH,530)
293           GO TO 2000
294 C
295 530       FORMAT(' No deaths.')
296 C
297 C RR-- Restore Robber
298 C
299 26000     THFACT=.TRUE.
300           WRITE(OUTCH,540)
301           GO TO 2000
302 C
303 540       FORMAT(' Restored robber.')
304 C
305 C RT-- Restore Troll
306 C
307 27000     TROLLF=.FALSE.
308           CALL NEWSTA(TROLL,0,MTROL,0,0)
309           WRITE(OUTCH,550)
310           GO TO 2000
311 C
312 550       FORMAT(' Restored troll.')
313 C
314 C RC-- Restore Cyclops
315 C
316 28000     CYCLOF=.FALSE.
317           MAGICF=.FALSE.
318           CALL NEWSTA(CYCLO,0,MCYCL,0,0)
319           WRITE(OUTCH,560)
320           GO TO 2000
321 C
322 560       FORMAT(' Restored cyclops.')
323 C
324 C RD-- Mortal Mode
325 C
326 29000     DBGFLG=0
327           WRITE(OUTCH,570)
328           GO TO 2000
329 C
330 570       FORMAT(' Restored deaths.')
331 C page
332 C GDT, PAGE 5
333 C
334 C TK-- Take
335 C
336 30000     IF(.NOT.VALID1(J,OLNT)) GO TO 2200      ! valid object?
337           CALL NEWSTA(J,0,0,0,WINNER)             ! yes, take object.
338           WRITE(OUTCH,580)                        ! tell.
339           GO TO 2000
340 C
341 580       FORMAT(' Taken.')
342 C
343 C EX-- Goodbye
344 C
345 31000     RETURN
346 C
347 C AR-- Alter Room Entry
348 C
349 32000     IF(.NOT.VALID3(J,RLNT,K,5)) GO TO 2200  ! indices valid?
350           WRITE(OUTCH,590) EQR(J,K)               ! type old, get new.
351           READ(INPCH,600,ERR=2200,END=2000) EQR(J,K)
352           GO TO 2000
353 C
354 590       FORMAT(' Old= ',I6,6X,'New= ',$)
355 600       FORMAT(I6)
356 C
357 C AO-- Alter Object Entry
358 C
359 33000     IF(.NOT.VALID3(J,OLNT,K,14)) GO TO 2200 ! indices valid?
360           WRITE(OUTCH,590) EQO(J,K)
361           READ(INPCH,600,ERR=2200,END=2000) EQO(J,K)
362           GO TO 2000
363 C
364 C AA-- Alter Advs Entry
365 C
366 34000     IF(.NOT.VALID3(J,ALNT,K,7)) GO TO 2200  ! indices valid?
367           WRITE(OUTCH,590) EQA(J,K)
368           READ(INPCH,600,ERR=2200,END=2000) EQA(J,K)
369           GO TO 2000
370 C
371 C AC-- Alter Clock Events
372 C
373 35000     IF(.NOT.VALID3(J,CLNT,K,4)) GO TO 2200  ! indices valid?
374           IF(K.EQ.3) GO TO 35500                            ! flags entry?
375           IF(K.EQ.4) GO TO 35600                            ! cancel entry?
376           WRITE(OUTCH,590) EQC(J,K)
377           READ(INPCH,600,ERR=2200,END=2000) EQC(J,K)
378           GO TO 2000
379 C
380 35500     WRITE(OUTCH,480) CFLAG(J)
381           READ(INPCH,490,ERR=2200,END=2000) CFLAG(J)
382           GO TO 2000
383 C
384 35600     WRITE(OUTCH,480) CCNCEL(J)
385           READ(INPCH,490,ERR=2200,END=2000) CCNCEL(J)
386           GO TO 2000
387 C page
388 C GDT, PAGE 6
389 C
390 C AX-- Alter Exits
391 C
392 36000     IF(.NOT.VALID1(J,XLNT)) GO TO 2200      ! entry no valid?
393           IF(TRAVEL(J).LT.0) GO TO 36100                    ! string entry?
394           WRITE(OUTCH,610) TRAVEL(J)
395           READ(INPCH,620,ERR=2200,END=2000) TRAVEL(J)
396           GO TO 2000
397 C
398 36100     WRITE(OUTCH,590) TRAVEL(J)
399           READ(INPCH,600,ERR=2200,END=2000) TRAVEL(J)
400           GO TO 2000
401 C
402 610       FORMAT(' Old= ',O6,6X,'New= ',$)
403 620       FORMAT(O6)
404 C
405 C AV-- Alter Villains
406 C
407 37000     IF(.NOT.VALID3(J,VLNT,K,5)) GO TO 2200  ! indices valid?
408           WRITE(OUTCH,590) EQV(J,K)
409           READ(INPCH,600,ERR=2200,END=2000) EQV(J,K)
410           GO TO 2000
411 C
412 C D2-- Display Room2 List
413 C
414 38000     IF(.NOT.VALID2(J,K,R2LNT)) GO TO 2200
415           DO 38100 I=J,K
416             WRITE(OUTCH,630) I,R2(I),O2(I)
417 38100     CONTINUE
418           GO TO 2000
419 C
420 630       FORMAT(' #',I2,'   Room=',I6,'   Obj=',I6)
421 C
422 C DN-- Display Switches
423 C
424 39000     IF(.NOT.VALID2(J,K,SMAX)) GO TO 2200    ! valid?
425           DO 39100 I=J,K
426             WRITE(OUTCH,640) I,SWITCH(I)
427 39100     CONTINUE
428           GO TO 2000
429 C
430 640       FORMAT(' Switch #',I2,' = ',I6)
431 C
432 C AN-- Alter Switches
433 C
434 40000     IF(.NOT.VALID1(J,SMAX)) GO TO 2200      ! valid entry?
435           WRITE(OUTCH,590) SWITCH(J)
436           READ(INPCH,600,ERR=2200,END=2000) SWITCH(J)
437           GO TO 2000
438 C
439 C DM-- Display Messages
440 C
441 41000     IF(.NOT.VALID2(J,K,MLNT)) GO TO 2200    ! valid limits?
442           WRITE(OUTCH,380)
443           DO 41100 I=J,K,10
444             L=MIN0(I+9,K)
445             WRITE(OUTCH,650) I,L,(RTEXT(L1),L1=I,L)
446 41100     CONTINUE
447           GO TO 2000
448 C
449 650       FORMAT(1X,I4,'-',I4,10(1X,I6))
450 C
451 C DT-- Display Text
452 C
453 42000     CALL RSPEAK(J)
454           GO TO 2000
455 C
456 C AH-- Alter Here
457 C
458 43000     WRITE(OUTCH,590) HERE
459           READ(INPCH,600,ERR=2200,END=2000) HERE
460           AROOM(PLAYER)=HERE
461           GO TO 2000
462 C
463 C DP-- Display Parser State
464 C
465 44000     WRITE(OUTCH,660)
466           &         OFLAG,OACT,OPREP1,OOBJ1,OPREP,ONAME,OPREP2,OOBJ2,
467           &         LASTIT,ACT,OBJ1,OBJ2,PREP1,PREP2,SYN,
468           &         BUNLNT,BUNSUB,BUNVEC
469           GO TO 2000
470 C
471 660       FORMAT(' ORPHS= ',5I7,' "',A,'" ',2I7/' IT=    ',I7/
472           &' PV=    ',5I7/' SYN=   ',2O7,4I7/15X,O7,4I7/
473           &' BUNCH= ',7I7/22X,5I7)
474 C
475 C PD-- Program Detail
476 C
477 45000     WRITE(OUTCH,610) PRSFLG                           ! type old, get new.
478           READ(INPCH,620,ERR=2200,END=2000) PRSFLG
479           GO TO 2000
480 C
481 C DZ-- Display Puzzle Room
482 C
483 46000     DO 46100 I=1,64,8                       ! display puzzle
484             WRITE(OUTCH,670) (CPVEC(J),J=I,I+7)
485 46100     CONTINUE
486           GO TO 2000
487 C
488 670       FORMAT(2X,8I3)
489 C
490 C AZ-- Alter Puzzle Room
491 C
492 47000     IF(.NOT.VALID1(J,64)) GO TO 2200        ! valid entry?
493           WRITE(OUTCH,590) CPVEC(J)               ! output old,
494           READ(OUTCH,600) CPVEC(J)                ! get new.
495           GO TO 2000
496 C
497           END