C Game debugging tool for DUNGEON
C
C COPYRIGHT 1980, 1990, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA.
C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
C WRITTEN BY R. M. SUPNIK
C
C Declarations
C
      SUBROUTINE GDT
      IMPLICIT INTEGER (A-Z)
      INCLUDE 'dparam.for'
      PARAMETER (DBGMAX=38)                     ! number of debug commands
      CHARACTER*2 CMD,DBGCMD(DBGMAX),DBGSML(DBGMAX)
      INTEGER ARGTYP(DBGMAX)
      LOGICAL VALID1,VALID2,VALID3
C
C Equivalanced array definitions
C
      INTEGER EQR(RMAX,5)
      EQUIVALENCE (EQR(1,1),RDESC1(1))
      INTEGER EQO(OMAX,14)
      EQUIVALENCE (EQO(1,1),ODESC1(1))
      INTEGER EQC(CMAX,2)
      EQUIVALENCE (EQC(1,1),CTICK(1))
      INTEGER EQV(VMAX,5)
      EQUIVALENCE (EQV(1,1),VILLNS(1))
      INTEGER EQA(AMAX,7)
      EQUIVALENCE (EQA(1,1),AROOM(1))
C
C Functions and data
C
      VALID1(A1,L1)=(A1.GT.0).AND.(A1.LE.L1)
      VALID2(A1,A2,L1)=VALID1(A1,L1).AND.VALID1(A2,L1).AND.
     1(A1.LE.A2)
      VALID3(A1,L1,A2,L2)=VALID1(A1,L1).AND.VALID1(A2,L2)
      DATA DBGCMD/'DR','DO','DA','DC','DX','DH','DL','DV','DF','DS',
     1'AF','HE','NR','NT','NC','ND','RR','RT','RC','RD',
     2'TK','EX','AR','AO','AA','AC','AX','AV','D2','DN',
     3'AN','DM','DT','AH','DP','PD','DZ','AZ'/
      DATA DBGSML/'dr','do','da','dc','dx','dh','dl','dv','df','ds',
     1'af','he','nr','nt','nc','nd','rr','rt','rc','rd',
     2'tk','ex','ar','ao','aa','ac','ax','av','d2','dn',
     3'an','dm','dt','ah','dp','pd','dz','az'/
      DATA ARGTYP/  2 ,  2 ,  2 ,  2 ,  2 ,  0 ,  0 ,  2 ,  2 ,  0 ,
     1  1 ,  0 ,  0 ,  0 ,  0 ,  0 ,  0 ,  0 ,  0 ,  0 ,
     2  1 ,  0 ,  3 ,  3 ,  3 ,  3 ,  1 ,  3 ,  2 ,  2 ,
     3  1 ,  2 ,  1 ,  0 ,  0 ,  0 ,  0 ,  1 /

C GDT, PAGE 2
C
C First, validate that the caller is an implementer.
C
      IF(GDTFLG.NE.0) GO TO 2000                ! if ok, skip.
      WRITE(OUTCH,100)                          ! not an implementer.
      RETURN                                    ! boot him off
C
100   FORMAT(' You are not an authorized user.')

c GDT, PAGE 2A
C
C Here to get next command.
C
2000  WRITE(OUTCH,200)                          ! output prompt.
      READ(INPCH,210,ERR=2200,END=31000) CMD    ! get command.
      IF(CMD.EQ.'  ') GO TO 2000                ! ignore blanks.
      DO 2100 I=1,DBGMAX                        ! look it up.
        IF((CMD.EQ.DBGCMD(I)).OR.(CMD.EQ.DBGSML(I))) GO TO 2300
2100  CONTINUE                                  ! found?
2200  WRITE(OUTCH,220)                          ! no, lose.
      GO TO 2000
C
200   FORMAT(' GDT> ',$)
210   FORMAT(A2)
220   FORMAT(' ?')
230   FORMAT(2I6)
240   FORMAT(I6)
225   FORMAT(' Limits:   ',$)
235   FORMAT(' Entry:    ',$)
245   FORMAT(' Idx,Ary:  ',$)
c
2300  GO TO (2400,2500,2600,2700),ARGTYP(I)+1   ! branch on arg type.
      GO TO 2200                                ! illegal type.
C
2700  WRITE(OUTCH,245)                          ! type 3, request array coords.
      READ(INPCH,230,ERR=2200,END=2000) J,K
      GO TO 2400
C
2600  WRITE(OUTCH,225)                          ! type 2, read bounds.
      READ(INPCH,230,ERR=2200,END=2000) J,K
      IF(K.EQ.0) K=J
      GO TO 2400
C
2500  WRITE(OUTCH,235)                          ! type 1, read entry no.
      READ(INPCH,240,ERR=2200,END=2000) J
2400  GO TO (10000,11000,12000,13000,14000,15000,16000,17000,18000,
     119000,20000,21000,22000,23000,24000,25000,26000,27000,28000,
     229000,30000,31000,32000,33000,34000,35000,36000,37000,38000,
     339000,40000,41000,42000,43000,44000,45000,46000,47000),I
      GO TO 2200                                ! what???

C GDT, PAGE 3
C
C DR-- Display Rooms
C
10000 IF(.NOT.VALID2(J,K,RLNT)) GO TO 2200      ! args valid?
      WRITE(OUTCH,300)                          ! col hdrs.
      DO 10100 I=J,K
        WRITE(OUTCH,310) I,(EQR(I,L),L=1,5)
10100 CONTINUE
      GO TO 2000
C
300   FORMAT(' RM#  DESC1  EXITS ACTION  VALUE  FLAGS')
310   FORMAT(1X,I3,4(1X,I6),1X,Z6)
C
C DO-- Display Objects
C
11000 IF(.NOT.VALID2(J,K,OLNT)) GO TO 2200      ! args valid?
      WRITE(OUTCH,320)                          ! col hdrs
      DO 11100 I=J,K
        WRITE(OUTCH,330) I,(EQO(I,L),L=1,14)
11100 CONTINUE
      GO TO 2000
C
320   FORMAT(' OB# DESC1 DESC2 DESCO ACT FLAGS1 FLAGS2 FV TV',
     1'  SIZE CAPAC  ROOM ADV CON  READ')
330   FORMAT(1X,I3,3I6,I4,2Z7,2I3,2I6,I6,2I4,I6)
C
C DA-- Display Adventurers
C
12000 IF(.NOT.VALID2(J,K,ALNT)) GO TO 2200      ! args valid?
      WRITE(OUTCH,340)
      DO 12100 I=J,K
        WRITE(OUTCH,350) I,(EQA(I,L),L=1,7)
12100 CONTINUE
      GO TO 2000
C
340   FORMAT(' AD#   ROOM  SCORE  VEHIC OBJECT ACTION  STREN  FLAGS')
350   FORMAT(1X,I3,6(1X,I6),1X,Z6)
C
C DC-- Display Clock Events
C
13000 IF(.NOT.VALID2(J,K,CLNT)) GO TO 2200      ! args valid?
      WRITE(OUTCH,360)
      DO 13100 I=J,K
        WRITE(OUTCH,370) I,(EQC(I,L),L=1,2),CFLAG(I),CCNCEL(I)
13100 CONTINUE
      GO TO 2000
C
360   FORMAT(' CL#   TICK ACTION  FLAG  CANCEL')
370   FORMAT(1X,I3,1X,I6,1X,I6,5X,L1,5X,L1)
C
C DX-- Display Exits
C
14000 IF(.NOT.VALID2(J,K,XLNT)) GO TO 2200      ! args valid?
      WRITE(OUTCH,380)                          ! col hdrs.
      DO 14100 I=J,K,10                         ! ten per line.
        L=MIN0(I+9,K)                           ! compute end of line.
        WRITE(OUTCH,390) I,L
        DO 14050 L1=I,L                         ! loop through data
          IF(TRAVEL(L1).GE.0) WRITE(OUTCH,391) TRAVEL(L1)
          IF(TRAVEL(L1).LT.0) WRITE(OUTCH,392) TRAVEL(L1)
14050   CONTINUE
      WRITE(OUTCH,393)
14100 CONTINUE
      GO TO 2000
C
380   FORMAT('     RANGE CONTENTS')
390   FORMAT(1X,I4,'-',I4,1X,$)
391   FORMAT('+',Z7,$)
392   FORMAT('+',I7,$)
393   FORMAT('+')
C
C DH-- Display Hacks
C
15000 WRITE(OUTCH,400) THFPOS,THFFLG,THFACT,SWDACT,SWDSTA
      GO TO 2000
C
400   FORMAT(' THFPOS=',I6,', THFFLG=',L2,', THFACT=',L2/
     1' SWDACT=',L2,', SWDSTA=',I2)
C
C DL-- Display Lengths
C
16000 WRITE(OUTCH,410) RLNT,XLNT,OLNT,CLNT,VLNT,ALNT,MLNT,R2LNT,
     1MBASE,STRBIT
      GO TO 2000
C
410   FORMAT(' R=',I6,', X=',I6,', O=',I6,', C=',I6/
     1' V=',I6,', A=',I6,', M=',I6,', R2=',I5/
     2' MBASE=',I6,', STRBIT=',I6)
C
C DV-- Display Villains
C
17000 IF(.NOT.VALID2(J,K,VLNT)) GO TO 2200      ! args valid?
      WRITE(OUTCH,420)                          ! col hdrs
      DO 17100 I=J,K
        WRITE(OUTCH,430) I,(EQV(I,L),L=1,5)
17100 CONTINUE
      GO TO 2000
C
420   FORMAT(' VL# OBJECT   PROB   OPPS   BEST  MELEE')
430   FORMAT(1X,I3,5(1X,I6))
C
C DF-- Display Flags
C
18000 IF(.NOT.VALID2(J,K,FMAX)) GO TO 2200      ! args valid?
      DO 18100 I=J,K
        WRITE(OUTCH,440) I,FLAGS(I)
18100 CONTINUE
      GO TO 2000
C
440   FORMAT(' Flag #',I2,' = ',L1)
C
C DS-- Display State
C
19000 WRITE(OUTCH,450) PRSA,PRSO,PRSI,PRSWON,PRSCON
      WRITE(OUTCH,460) WINNER,HERE,TELFLG
      WRITE(OUTCH,470) MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD,LTSHFT,BLOC,
     1MUNGRM,HS,EGSCOR,EGMXSC
      WRITE(OUTCH,475) FROMDR,SCOLRM,SCOLAC
      GO TO 2000
C
450   FORMAT(' Parse vector=',3(1X,I6),1X,L6,1X,I6)
460   FORMAT(' Play vector= ',2(1X,I6),1X,L6)
470   FORMAT(' State vector=',7(1X,I6)/14X,4(1X,I6))
475   FORMAT(' Scol vector= ',1X,Z6,2(1X,I6))

C GDT, PAGE 4
C
C AF-- Alter Flags
C
20000 IF(.NOT.VALID1(J,FMAX)) GO TO 2200        ! entry no valid?
      WRITE(OUTCH,480) FLAGS(J)                 ! type old, get new.
      READ(INPCH,490,ERR=2200,END=2000) FLAGS(J)
      GO TO 2000
C
480   FORMAT(' Old=',L2,6X,'New= ',$)
490   FORMAT(L1)
C
C 21000-- Help
C
21000 WRITE(OUTCH,900)
      GO TO 2000
C
900   FORMAT(' Valid commands are:'/' AA- Alter ADVS'/
     1' AC- Alter CEVENT'/' AF- Alter FINDEX'/' AH- Alter HERE'/
     2' AN- Alter switches'/' AO- Alter OBJCTS'/' AR- Alter ROOMS'/
     3' AV- Alter VILLS'/' AX- Alter EXITS'/
     3' AZ- Alter PUZZLE'/' DA- Display ADVS'/
     4' DC- Display CEVENT'/' DF- Display FINDEX'/' DH- Display HACKS'/
     5' DL- Display lengths'/' DM- Display RTEXT'/
     6' DN- Display switches'/
     6' DO- Display OBJCTS'/' DP- Display parser'/
     6' DR- Display ROOMS'/' DS- Display state'/' DT- Display text'/
     7' DV- Display VILLS'/' DX- Display EXITS'/' DZ- Display PUZZLE'/
     8' D2- Display ROOM2'/' EX- Exit'/' HE- Type this message'/
     9' NC- No cyclops'/' ND- No deaths'/' NR- No robber'/
     1' NT- No troll'/' PD- Program detail'/
     1' RC- Restore cyclops'/' RD- Restore deaths'/
     2' RR- Restore robber'/' RT- Restore troll'/' TK- Take.')
C
C NR-- No Robber
C
22000 THFFLG=.FALSE.                            ! disable robber.
      THFACT=.FALSE.
      CALL NEWSTA(THIEF,0,0,0,0)                ! vanish thief.
      WRITE(OUTCH,500)
      GO TO 2000
C
500   FORMAT(' No robber.')
C
C NT-- No Troll
C
23000 TROLLF=.TRUE.
      CALL NEWSTA(TROLL,0,0,0,0)
      WRITE(OUTCH,510)
      GO TO 2000
C
510   FORMAT(' No troll.')
C
C NC-- No Cyclops
C
24000 CYCLOF=.TRUE.
      CALL NEWSTA(CYCLO,0,0,0,0)
      WRITE(OUTCH,520)
      GO TO 2000
C
520   FORMAT(' No cyclops.')
C
C ND-- Immortality Mode
C
25000 DBGFLG=1
      WRITE(OUTCH,530)
      GO TO 2000
C
530   FORMAT(' No deaths.')
C
C RR-- Restore Robber
C
26000 THFACT=.TRUE.
      WRITE(OUTCH,540)
      GO TO 2000
C
540   FORMAT(' Restored robber.')
C
C RT-- Restore Troll
C
27000 TROLLF=.FALSE.
      CALL NEWSTA(TROLL,0,MTROL,0,0)
      WRITE(OUTCH,550)
      GO TO 2000
C
550   FORMAT(' Restored troll.')
C
C RC-- Restore Cyclops
C
28000 CYCLOF=.FALSE.
      MAGICF=.FALSE.
      CALL NEWSTA(CYCLO,0,MCYCL,0,0)
      WRITE(OUTCH,560)
      GO TO 2000
C
560   FORMAT(' Restored cyclops.')
C
C RD-- Mortal Mode
C
29000 DBGFLG=0
      WRITE(OUTCH,570)
      GO TO 2000
C
570   FORMAT(' Restored deaths.')

C GDT, PAGE 5
C
C TK-- Take
C
30000 IF(.NOT.VALID1(J,OLNT)) GO TO 2200        ! valid object?
      CALL NEWSTA(J,0,0,0,WINNER)               ! yes, take object.
      WRITE(OUTCH,580)                          ! tell.
      GO TO 2000
C
580   FORMAT(' Taken.')
C
C EX-- Goodbye
C
31000 RETURN
C
C AR-- Alter Room Entry
C
32000 IF(.NOT.VALID3(J,RLNT,K,5)) GO TO 2200    ! indices valid?
      WRITE(OUTCH,590) EQR(J,K)                 ! type old, get new.
      READ(INPCH,600,ERR=2200,END=2000) EQR(J,K)
      GO TO 2000
C
590   FORMAT(' Old= ',I6,6X,'New= ',$)
600   FORMAT(I6)
C
C AO-- Alter Object Entry
C
33000 IF(.NOT.VALID3(J,OLNT,K,14)) GO TO 2200   ! indices valid?
      WRITE(OUTCH,590) EQO(J,K)
      READ(INPCH,600,ERR=2200,END=2000) EQO(J,K)
      GO TO 2000
C
C AA-- Alter Advs Entry
C
34000 IF(.NOT.VALID3(J,ALNT,K,7)) GO TO 2200    ! indices valid?
      WRITE(OUTCH,590) EQA(J,K)
      READ(INPCH,600,ERR=2200,END=2000) EQA(J,K)
      GO TO 2000
C
C AC-- Alter Clock Events
C
35000 IF(.NOT.VALID3(J,CLNT,K,4)) GO TO 2200    ! indices valid?
      IF(K.EQ.3) GO TO 35500                    ! flags entry?
      IF(K.EQ.4) GO TO 35600                    ! cancel entry?
      WRITE(OUTCH,590) EQC(J,K)
      READ(INPCH,600,ERR=2200,END=2000) EQC(J,K)
      GO TO 2000
C
35500 WRITE(OUTCH,480) CFLAG(J)
      READ(INPCH,490,ERR=2200,END=2000) CFLAG(J)
      GO TO 2000
C
35600 WRITE(OUTCH,480) CCNCEL(J)
      READ(INPCH,490,ERR=2200,END=2000) CCNCEL(J)
      GO TO 2000

C GDT, PAGE 6
C
C AX-- Alter Exits
C
36000 IF(.NOT.VALID1(J,XLNT)) GO TO 2200        ! entry no valid?
      IF(TRAVEL(J).LT.0) GO TO 36100            ! string entry?
      WRITE(OUTCH,610) TRAVEL(J)
      READ(INPCH,620,ERR=2200,END=2000) TRAVEL(J)
      GO TO 2000
C
36100 WRITE(OUTCH,590) TRAVEL(J)
      READ(INPCH,600,ERR=2200,END=2000) TRAVEL(J)
      GO TO 2000
C
610   FORMAT(' Old= ',Z6,6X,'New= ',$)
620   FORMAT(Z6)
C
C AV-- Alter Villains
C
37000 IF(.NOT.VALID3(J,VLNT,K,5)) GO TO 2200    ! indices valid?
      WRITE(OUTCH,590) EQV(J,K)
      READ(INPCH,600,ERR=2200,END=2000) EQV(J,K)
      GO TO 2000
C
C D2-- Display Room2 List
C
38000 IF(.NOT.VALID2(J,K,R2LNT)) GO TO 2200
      DO 38100 I=J,K
        WRITE(OUTCH,630) I,R2(I),O2(I)
38100 CONTINUE
      GO TO 2000
C
630   FORMAT(' #',I2,'   Room=',I6,'   Obj=',I6)
C
C DN-- Display Switches
C
39000 IF(.NOT.VALID2(J,K,SMAX)) GO TO 2200      ! valid?
      DO 39100 I=J,K
        WRITE(OUTCH,640) I,SWITCH(I)
39100 CONTINUE
      GO TO 2000
C
640   FORMAT(' Switch #',I2,' = ',I6)
C
C AN-- Alter Switches
C
40000 IF(.NOT.VALID1(J,SMAX)) GO TO 2200        ! valid entry?
      WRITE(OUTCH,590) SWITCH(J)
      READ(INPCH,600,ERR=2200,END=2000) SWITCH(J)
      GO TO 2000
C
C DM-- Display Messages
C
41000 IF(.NOT.VALID2(J,K,MLNT)) GO TO 2200      ! valid limits?
      WRITE(OUTCH,380)
      DO 41100 I=J,K,10
        L=MIN0(I+9,K)
        WRITE(OUTCH,650) I,L,(RTEXT(L1),L1=I,L)
41100 CONTINUE
      GO TO 2000
C
650   FORMAT(1X,I4,'-',I4,10(1X,I6))
C
C DT-- Display Text
C
42000 CALL RSPEAK(J)
      GO TO 2000
C
C AH-- Alter Here
C
43000 WRITE(OUTCH,590) HERE
      READ(INPCH,600,ERR=2200,END=2000) HERE
      AROOM(PLAYER)=HERE
      GO TO 2000
C
C DP-- Display Parser State
C
44000 WRITE(OUTCH,660)
     1OFLAG,OACT,OPREP1,OOBJ1,OPREP,ONAME,OPREP2,OOBJ2,
     2LASTIT,ACT,OBJ1,OBJ2,PREP1,PREP2,SYN,
     3BUNLNT,BUNSUB,BUNVEC
      GO TO 2000
C
660   FORMAT(' ORPHS= ',5I7,' "',A,'" ',2I7/' IT=    ',I7/
     1' PV=    ',5I7/' SYN=   ',2Z7,4I7/15X,Z7,4I7/
     2' BUNCH= ',7I7/22X,5I7)
C
C PD-- Program Detail
C
45000 WRITE(OUTCH,610) PRSFLG                   ! type old, get new.
      READ(INPCH,620,ERR=2200,END=2000) PRSFLG
      GO TO 2000
C
C DZ-- Display Puzzle Room
C
46000 DO 46100 I=1,64,8                         ! display puzzle
        WRITE(OUTCH,670) (CPVEC(J),J=I,I+7)
46100 CONTINUE
      GO TO 2000
C
670   FORMAT(2X,8I3)
C
C AZ-- Alter Puzzle Room
C
47000 IF(.NOT.VALID1(J,64)) GO TO 2200          ! valid entry?
      WRITE(OUTCH,590) CPVEC(J)                 ! output old,
      READ(OUTCH,600) CPVEC(J)                  ! get new.
      GO TO 2000
C
      END
