usr/src/contrib/dungeon/gdt.F

C GDT- GAME DEBUGGING TOOL
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
        SUBROUTINE GDT
        IMPLICIT INTEGER (A-Z)
#ifdef PDP
C
C       no debugging tool available in pdp version
C
        call nogdt
        return
#else
        CHARACTER*2 DBGCMD(38),CMD
        INTEGER ARGTYP(38)
        LOGICAL VALID1,VALID2,VALID3
        character*2 ldbgcm(38)
#include "parser.h"
#include "gamestate.h"
#include "state.h"
#include "screen.h"
#include "puzzle.h"
C
C MISCELLANEOUS VARIABLES
C
        COMMON /STAR/ MBASE,STRBIT
#include "io.h"
#include "mindex.h"
#include "debug.h"
#include "rooms.h"
#include "rindex.h"
#include "exits.h"
#include "objects.h"
#include "oindex.h"
#include "clock.h"
#include "villians.h"
#include "advers.h"
#include "flags.h"
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.
&               (A1.LE.A2)
        VALID3(A1,L1,A2,L2)=VALID1(A1,L1).AND.VALID1(A2,L2)
        DATA CMDMAX/38/
        DATA DBGCMD/'DR','DO','DA','DC','DX','DH','DL','DV','DF','DS',
&               'AF','HE','NR','NT','NC','ND','RR','RT','RC','RD',
&               'TK','EX','AR','AO','AA','AC','AX','AV','D2','DN',
&               'AN','DM','DT','AH','DP','PD','DZ','AZ'/
        DATA ldbgcm/'dr','do','da','dc','dx','dh','dl','dv','df','ds',
&               'af','he','nr','nt','nc','nd','rr','rt','rc','rd',
&               'tk','ex','ar','ao','aa','ac','ax','av','d2','dn',
&               'an','dm','dt','ah','dp','pd','dz','az'/
        DATA ARGTYP/  2 ,  2 ,  2 ,  2 ,  2 ,  0 ,  0 ,  2 ,  2 ,  0 ,
&                 1 ,  0 ,  0 ,  0 ,  0 ,  0 ,  0 ,  0 ,  0 ,  0 ,
&                 1 ,  0 ,  3 ,  3 ,  3 ,  3 ,  1 ,  3 ,  2 ,  2 ,
&                 1 ,  2 ,  1 ,  0 ,  0 ,  0 ,  0 ,  1 /
C GDT, PAGE 2
C
C FIRST, VALIDATE THAT THE CALLER IS AN IMPLEMENTER.
C
        FMAX=46
C                                               !SET ARRAY LIMITS.
        SMAX=22
C
        IF(GDTFLG.NE.0) GO TO 2000
C                                               !IF OK, SKIP.
        WRITE(OUTCH,100)
C                                               !NOT AN IMPLEMENTER.
        RETURN
C                                               !BOOT HIM OFF
C
#ifdef NOCC
100     FORMAT('You are not an authorized user.')
#else NOCC
100     FORMAT(' You are not an authorized user.')
#endif NOCC
c GDT, PAGE 2A
C
C HERE TO GET NEXT COMMAND
C
2000    WRITE(OUTCH,200)
C                                               !OUTPUT PROMPT.
        READ(INPCH,210) CMD
C                                               !GET COMMAND.
        IF(CMD.EQ.'  ') GO TO 2000
C                                               !IGNORE BLANKS.
        DO 2100 I=1,CMDMAX
C                                               !LOOK IT UP.
          IF(CMD.EQ.DBGCMD(I)) GO TO 2300
C                                               !FOUND?
C         check for lower case command, as well
          if(cmd .eq. ldbgcm(i)) go to 2300
2100    CONTINUE
2200    WRITE(OUTCH,220)
C                                               !NO, LOSE.
        GO TO 2000
C
#ifdef NOCC
200     FORMAT('GDT>',$)
#else NOCC
200     FORMAT(' GDT>',$)
#endif NOCC
210     FORMAT(A2)
#ifdef NOCC
220     FORMAT('?')
#else NOCC
220     FORMAT(' ?')
#endif NOCC
230     FORMAT(2I6)
240     FORMAT(I6)
#ifdef NOCC
225     FORMAT('Limits:   ',$)
235     FORMAT('Entry:    ',$)
245     FORMAT('Idx,Ary:  ',$)
#else NOCC
225     FORMAT(' Limits:   ',$)
235     FORMAT(' Entry:    ',$)
245     FORMAT(' Idx,Ary:  ',$)
#endif NOCC
c
2300    GO TO (2400,2500,2600,2700),ARGTYP(I)+1
C                                               !BRANCH ON ARG TYPE.
        GO TO 2200
C                                               !ILLEGAL TYPE.
C
2700    WRITE(OUTCH,245)
C                                               !TYPE 3, REQUEST ARRAY COORDS.
        READ(INPCH,230) J,K
        GO TO 2400
C
2600    WRITE(OUTCH,225)
C                                               !TYPE 2, READ BOUNDS.
        READ(INPCH,230) J,K
        IF(K.EQ.0) K=J
        GO TO 2400
C
2500    WRITE(OUTCH,235)
C                                               !TYPE 1, READ ENTRY NO.
        READ(INPCH,240) J
2400    GO TO (10000,11000,12000,13000,14000,15000,16000,17000,18000,
&        19000,20000,21000,22000,23000,24000,25000,26000,27000,28000,
&        29000,30000,31000,32000,33000,34000,35000,36000,37000,38000,
&        39000,40000,41000,42000,43000,44000,45000,46000,47000),I
        GO TO 2200
C                                               !WHAT???
C GDT, PAGE 3
C
C DR-- DISPLAY ROOMS
C
10000   IF(.NOT.VALID2(J,K,RLNT)) GO TO 2200
C                                               !ARGS VALID?
        WRITE(OUTCH,300)
C                                               !COL HDRS.
        DO 10100 I=J,K
          WRITE(OUTCH,310) I,(EQR(I,L),L=1,5)
10100   CONTINUE
        GO TO 2000
C
#ifdef NOCC
300     FORMAT('RM#  DESC1  EXITS ACTION  VALUE  FLAGS')
310     FORMAT(I3,4(1X,I6),1X,I6)
#else NOCC
300     FORMAT(' RM#  DESC1  EXITS ACTION  VALUE  FLAGS')
310     FORMAT(1X,I3,4(1X,I6),1X,I6)
#endif NOCC
C
C DO-- DISPLAY OBJECTS
C
11000   IF(.NOT.VALID2(J,K,OLNT)) GO TO 2200
C                                               !ARGS VALID?
        WRITE(OUTCH,320)
C                                               !COL HDRS
        DO 11100 I=J,K
          WRITE(OUTCH,330) I,(EQO(I,L),L=1,14)
11100   CONTINUE
        GO TO 2000
C
#ifdef NOCC
320     FORMAT('OB# DESC1 DESC2 DESCO ACT FLAGS1 FLAGS2 FVL TVL
&         SIZE CAPAC ROOM ADV CON  READ')
330     FORMAT(I3,3I6,I4,2I7,2I4,2I6,1X,3I4,I6)
#else NOCC
320     FORMAT(' OB# DESC1 DESC2 DESCO ACT FLAGS1 FLAGS2 FVL TVL
&         SIZE CAPAC ROOM ADV CON  READ')
330     FORMAT(1X,I3,3I6,I4,2I7,2I4,2I6,1X,3I4,I6)
#endif NOCC
C
C DA-- DISPLAY ADVENTURERS
C
12000   IF(.NOT.VALID2(J,K,ALNT)) GO TO 2200
C                                               !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
#ifdef NOCC
340     FORMAT('AD#   ROOM  SCORE  VEHIC OBJECT ACTION  STREN  FLAGS')
350     FORMAT(I3,6(1X,I6),1X,I6)
#else NOCC
340     FORMAT(' AD#   ROOM  SCORE  VEHIC OBJECT ACTION  STREN  FLAGS')
350     FORMAT(1X,I3,6(1X,I6),1X,I6)
#endif NOCC
C
C DC-- DISPLAY CLOCK EVENTS
C
13000   IF(.NOT.VALID2(J,K,CLNT)) GO TO 2200
C                                               !ARGS VALID?
        WRITE(OUTCH,360)
        DO 13100 I=J,K
          WRITE(OUTCH,370) I,(EQC(I,L),L=1,2),CFLAG(I)
13100   CONTINUE
        GO TO 2000
C
#ifdef NOCC
360     FORMAT('CL#   TICK ACTION  FLAG')
370     FORMAT(I3,1X,I6,1X,I6,5X,L1)
#else NOCC
360     FORMAT(' CL#   TICK ACTION  FLAG')
370     FORMAT(1X,I3,1X,I6,1X,I6,5X,L1)
#endif NOCC
C
C DX-- DISPLAY EXITS
C
14000   IF(.NOT.VALID2(J,K,XLNT)) GO TO 2200
C                                               !ARGS VALID?
        WRITE(OUTCH,380)
C                                               !COL HDRS.
        DO 14100 I=J,K,10
C                                               !TEN PER LINE.
          L=MIN0(I+9,K)
C                                               !COMPUTE END OF LINE.
          WRITE(OUTCH,390) I,L,(TRAVEL(L1),L1=I,L)
14100   CONTINUE
        GO TO 2000
C
#ifdef NOCC
380     FORMAT('  RANGE   CONTENTS')
390     FORMAT(I3,'-',I3,3X,10I7)
#else NOCC
380     FORMAT('   RANGE   CONTENTS')
390     FORMAT(1X,I3,'-',I3,3X,10I7)
#endif NOCC
C
C DH-- DISPLAY HACKS
C
15000   WRITE(OUTCH,400) THFPOS,THFFLG,THFACT,SWDACT,SWDSTA
        GO TO 2000
C
#ifdef NOCC
400     FORMAT('THFPOS=',I6,', THFFLG=',L2,',THFACT=',L2/
&       ' SWDACT=',L2,', SWDSTA=',I2)
#else NOCC
400     FORMAT(' THFPOS=',I6,', THFFLG=',L2,',THFACT=',L2/
&       ' SWDACT=',L2,', SWDSTA=',I2)
#endif NOCC
C
C DL-- DISPLAY LENGTHS
C
16000   WRITE(OUTCH,410) RLNT,XLNT,OLNT,CLNT,VLNT,ALNT,MLNT,R2LNT,
&               MBASE,STRBIT
        GO TO 2000
C
#ifdef NOCC
410     FORMAT('R=',I6,', X=',I6,', O=',I6,', C=',I6/
&       'V=',I6,', A=',I6,', M=',I6,', R2=',I5/
&       'MBASE=',I6,', STRBIT=',I6)
#else NOCC
410     FORMAT(' R=',I6,', X=',I6,', O=',I6,', C=',I6/
&       ' V=',I6,', A=',I6,', M=',I6,', R2=',I5/
&       ' MBASE=',I6,', STRBIT=',I6)
#endif NOCC
C
C DV-- DISPLAY VILLAINS
C
17000   IF(.NOT.VALID2(J,K,VLNT)) GO TO 2200
C                                               !ARGS VALID?
        WRITE(OUTCH,420)
C                                               !COL HDRS
        DO 17100 I=J,K
          WRITE(OUTCH,430) I,(EQV(I,L),L=1,5)
17100   CONTINUE
        GO TO 2000
C
#ifdef NOCC
420     FORMAT('VL# OBJECT   PROB   OPPS   BEST  MELEE')
430     FORMAT(I3,5(1X,I6))
#else NOCC
420     FORMAT(' VL# OBJECT   PROB   OPPS   BEST  MELEE')
430     FORMAT(1X,I3,5(1X,I6))
#endif NOCC
C
C DF-- DISPLAY FLAGS
C
18000   IF(.NOT.VALID2(J,K,FMAX)) GO TO 2200
C                                               !ARGS VALID?
        DO 18100 I=J,K
          WRITE(OUTCH,440) I,FLAGS(I)
18100   CONTINUE
        GO TO 2000
C
#ifdef NOCC
440     FORMAT('Flag #',I2,' = ',L1)
#else NOCC
440     FORMAT(' Flag #',I2,' = ',L1)
#endif NOCC
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,
&               MUNGRM,HS,EGSCOR,EGMXSC
        WRITE(OUTCH,475) FROMDR,SCOLRM,SCOLAC
        GO TO 2000
C
#ifdef NOCC
450     FORMAT('Parse vector=',3(1X,I6),1X,L6,1X,I6)
460     FORMAT('Play vector= ',2(1X,I6),1X,L6)
470     FORMAT('State vector=',9(1X,I6)/14X,2(1X,I6))
475     FORMAT('Scol vector= ',1X,I6,2(1X,I6))
#else NOCC
450     FORMAT(' Parse vector=',3(1X,I6),1X,L6,1X,I6)
460     FORMAT(' Play vector= ',2(1X,I6),1X,L6)
470     FORMAT(' State vector=',9(1X,I6)/14X,2(1X,I6))
475     FORMAT(' Scol vector= ',1X,I6,2(1X,I6))
#endif NOCC
C GDT, PAGE 4
C
C AF-- ALTER FLAGS
C
20000   IF(.NOT.VALID1(J,FMAX)) GO TO 2200
C                                               !ENTRY NO VALID?
        WRITE(OUTCH,480) FLAGS(J)
C                                               !TYPE OLD, GET NEW.
        READ(INPCH,490) FLAGS(J)
        GO TO 2000
C
#ifdef NOCC
480     FORMAT('Old=',L2,6X,'New= ',$)
#else NOCC
480     FORMAT(' Old=',L2,6X,'New= ',$)
#endif NOCC
490     FORMAT(L1)
C
C 21000-- HELP
C
21000   WRITE(OUTCH,900)
        GO TO 2000
C
#ifdef NOCC
900     FORMAT('Valid commands are:'/'AA- Alter ADVS'/
&       'AC- Alter CEVENT'/'AF- Alter FINDEX'/'AH- Alter HERE'/
&       'AN- Alter switches'/'AO- Alter OBJCTS'/'AR- Alter ROOMS'/
&       'AV- Alter VILLS'/'AX- Alter EXITS'/
&       'AZ- Alter PUZZLE'/'DA- Display ADVS'/
&       'DC- Display CEVENT'/'DF- Display FINDEX'/'DH- Display HACKS'/
&       'DL- Display lengths'/'DM- Display RTEXT'/
&       'DN- Display switches'/
&       'DO- Display OBJCTS'/'DP- Display parser'/
&       'DR- Display ROOMS'/'DS- Display state'/'DT- Display text'/
&       'DV- Display VILLS'/'DX- Display EXITS'/'DZ- Display PUZZLE'/
&       'D2- Display ROOM2'/'EX- Exit'/'HE- Type this message'/
&       'NC- No cyclops'/'ND- No deaths'/'NR- No robber'/
&       'NT- No troll'/'PD- Program detail'/
&       'RC- Restore cyclops'/'RD- Restore deaths'/
&       'RR- Restore robber'/'RT- Restore troll'/'TK- Take.')
#else NOCC
900     FORMAT(' Valid commands are:'/' AA- Alter ADVS'/
&       ' AC- Alter CEVENT'/' AF- Alter FINDEX'/' AH- Alter HERE'/
&       ' AN- Alter switches'/' AO- Alter OBJCTS'/' AR- Alter ROOMS'/
&       ' AV- Alter VILLS'/' AX- Alter EXITS'/
&       ' AZ- Alter PUZZLE'/' DA- Display ADVS'/
&       ' DC- Display CEVENT'/' DF- Display FINDEX'/' DH- Display HACKS'/
&       ' DL- Display lengths'/' DM- Display RTEXT'/
&       ' DN- Display switches'/
&       ' DO- Display OBJCTS'/' DP- Display parser'/
&       ' DR- Display ROOMS'/' DS- Display state'/' DT- Display text'/
&       ' DV- Display VILLS'/' DX- Display EXITS'/' DZ- Display PUZZLE'/
&       ' D2- Display ROOM2'/' EX- Exit'/' HE- Type this message'/
&       ' NC- No cyclops'/' ND- No deaths'/' NR- No robber'/
&       ' NT- No troll'/' PD- Program detail'/
&       ' RC- Restore cyclops'/' RD- Restore deaths'/
&       ' RR- Restore robber'/' RT- Restore troll'/' TK- Take.')
#endif NOCC
C
C NR-- NO ROBBER
C
22000   THFFLG=.FALSE.
C                                               !DISABLE ROBBER.
        THFACT=.FALSE.
        CALL NEWSTA(THIEF,0,0,0,0)
C                                               !VANISH THIEF.
        WRITE(OUTCH,500)
        GO TO 2000
C
#ifdef NOCC
500     FORMAT('No robber.')
#else NOCC
500     FORMAT(' No robber.')
#endif NOCC
C
C NT-- NO TROLL
C
23000   TROLLF=.TRUE.
        CALL NEWSTA(TROLL,0,0,0,0)
        WRITE(OUTCH,510)
        GO TO 2000
C
#ifdef NOCC
510     FORMAT('No troll.')
#else NOCC
510     FORMAT(' No troll.')
#endif NOCC
C
C NC-- NO CYCLOPS
C
24000   CYCLOF=.TRUE.
        CALL NEWSTA(CYCLO,0,0,0,0)
        WRITE(OUTCH,520)
        GO TO 2000
C
#ifdef NOCC
520     FORMAT('No cyclops.')
#else NOCC
520     FORMAT(' No cyclops.')
#endif NOCC
C
C ND-- IMMORTALITY MODE
C
25000   DBGFLG=1
        WRITE(OUTCH,530)
        GO TO 2000
C
#ifdef NOCC
530     FORMAT('No deaths.')
#else NOCC
530     FORMAT(' No deaths.')
#endif NOCC
C
C RR-- RESTORE ROBBER
C
26000   THFACT=.TRUE.
        WRITE(OUTCH,540)
        GO TO 2000
C
#ifdef NOCC
540     FORMAT('Restored robber.')
#else NOCC
540     FORMAT(' Restored robber.')
#endif NOCC
C
C RT-- RESTORE TROLL
C
27000   TROLLF=.FALSE.
        CALL NEWSTA(TROLL,0,MTROL,0,0)
        WRITE(OUTCH,550)
        GO TO 2000
C
#ifdef NOCC
550     FORMAT('Restored troll.')
#else NOCC
550     FORMAT(' Restored troll.')
#endif NOCC
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
#ifdef NOCC
560     FORMAT('Restored cyclops.')
#else NOCC
560     FORMAT(' Restored cyclops.')
#endif NOCC
C
C RD-- MORTAL MODE
C
29000   DBGFLG=0
        WRITE(OUTCH,570)
        GO TO 2000
C
#ifdef NOCC
570     FORMAT('Restored deaths.')
#else NOCC
570     FORMAT(' Restored deaths.')
#endif NOCC
C GDT, PAGE 5
C
C TK-- TAKE
C
30000   IF(.NOT.VALID1(J,OLNT)) GO TO 2200
C                                               !VALID OBJECT?
        CALL NEWSTA(J,0,0,0,WINNER)
C                                               !YES, TAKE OBJECT.
        WRITE(OUTCH,580)
C                                               !TELL.
        GO TO 2000
C
#ifdef NOCC
580     FORMAT('Taken.')
#else NOCC
580     FORMAT(' Taken.')
#endif NOCC
C
C EX-- GOODBYE
C
31000   PRSCON=1
        RETURN
C
C AR--  ALTER ROOM ENTRY
C
32000   IF(.NOT.VALID3(J,RLNT,K,5)) GO TO 2200
C                                               !INDICES VALID?
        WRITE(OUTCH,590) EQR(J,K)
C                                               !TYPE OLD, GET NEW.
        READ(INPCH,600) EQR(J,K)
        GO TO 2000
C
#ifdef NOCC
590     FORMAT('Old= ',I6,6X,'New= ',$)
#else NOCC
590     FORMAT(' Old= ',I6,6X,'New= ',$)
#endif NOCC
600     FORMAT(I6)
C
C AO-- ALTER OBJECT ENTRY
C
33000   IF(.NOT.VALID3(J,OLNT,K,14)) GO TO 2200
C                                               !INDICES VALID?
        WRITE(OUTCH,590) EQO(J,K)
        READ(INPCH,600) EQO(J,K)
        GO TO 2000
C
C AA-- ALTER ADVS ENTRY
C
34000   IF(.NOT.VALID3(J,ALNT,K,7)) GO TO 2200
C                                               !INDICES VALID?
        WRITE(OUTCH,590) EQA(J,K)
        READ(INPCH,600) EQA(J,K)
        GO TO 2000
C
C AC-- ALTER CLOCK EVENTS
C
35000   IF(.NOT.VALID3(J,CLNT,K,3)) GO TO 2200
C                                               !INDICES VALID?
        IF(K.EQ.3) GO TO 35500
C                                               !FLAGS ENTRY?
        WRITE(OUTCH,590) EQC(J,K)
        READ(INPCH,600) EQC(J,K)
        GO TO 2000
C
35500   WRITE(OUTCH,480) CFLAG(J)
        READ(INPCH,490) CFLAG(J)
        GO TO 2000
C GDT, PAGE 6
C
C AX-- ALTER EXITS
C
36000   IF(.NOT.VALID1(J,XLNT)) GO TO 2200
C                                               !ENTRY NO VALID?
        WRITE(OUTCH,610) TRAVEL(J)
        READ(INPCH,620) TRAVEL(J)
        GO TO 2000
C
#ifdef NOCC
610     FORMAT('Old= ',I6,6X,'New= ',$)
#else NOCC
610     FORMAT(' Old= ',I6,6X,'New= ',$)
#endif NOCC
620     FORMAT(I6)
C
C AV-- ALTER VILLAINS
C
37000   IF(.NOT.VALID3(J,VLNT,K,5)) GO TO 2200
C                                               !INDICES VALID?
        WRITE(OUTCH,590) EQV(J,K)
        READ(INPCH,600) 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,RROOM2(I),OROOM2(I)
38100   CONTINUE
        GO TO 2000
C
#ifdef NOCC
630     FORMAT('#',I2,'   Room=',I6,'   Obj=',I6)
#else NOCC
630     FORMAT(' #',I2,'   Room=',I6,'   Obj=',I6)
#endif NOCC
C
C DN-- DISPLAY SWITCHES
C
39000   IF(.NOT.VALID2(J,K,SMAX)) GO TO 2200
C                                               !VALID?
        DO 39100 I=J,K
          WRITE(OUTCH,640) I,SWITCH(I)
39100   CONTINUE
        GO TO 2000
C
#ifdef NOCC
640     FORMAT('Switch #',I2,' = ',I6)
#else NOCC
640     FORMAT(' Switch #',I2,' = ',I6)
#endif NOCC
C
C AN-- ALTER SWITCHES
C
40000   IF(.NOT.VALID1(J,SMAX)) GO TO 2200
C                                               !VALID ENTRY?
        WRITE(OUTCH,590) SWITCH(J)
        READ(INPCH,600) SWITCH(J)
        GO TO 2000
C
C DM-- DISPLAY MESSAGES
C
41000   IF(.NOT.VALID2(J,K,MLNT)) GO TO 2200
C                                               !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
#ifdef NOCC
650     FORMAT(I3,'-',I3,3X,10(1X,I6))
#else NOCC
650     FORMAT(1X,I3,'-',I3,3X,10(1X,I6))
#endif NOCC
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) HERE
        EQA(1,1)=HERE
        GO TO 2000
C
C DP--  DISPLAY PARSER STATE
C
44000   WRITE(OUTCH,660) ORP,LASTIT,PVEC,SYN
        GO TO 2000
C
#ifdef NOCC
660     FORMAT('ORPHS= ',I7,I7,4I7/
&       'PV=    ',I7,4I7/'SYN=   ',6I7/15X,5I7)
#else NOCC
660     FORMAT(' ORPHS= ',I7,I7,4I7/
&       ' PV=    ',I7,4I7/' SYN=   ',6I7/15X,5I7)
#endif NOCC
C
C PD--  PROGRAM DETAIL DEBUG
C
45000   WRITE(OUTCH,610) PRSFLG
C                                               !TYPE OLD, GET NEW.
        READ(INPCH,620) PRSFLG
        GO TO 2000
C
C DZ--  DISPLAY PUZZLE ROOM
C
46000   DO 46100 I=1,64,8
C                                               !DISPLAY PUZZLE
          WRITE(OUTCH,670) (CPVEC(J),J=I,I+7)
46100   CONTINUE
        GO TO 2000
C
#ifdef NOCC
670     FORMAT(1X,8I3)
#else NOCC
670     FORMAT(2X,8I3)
#endif NOCC
C
C AZ--  ALTER PUZZLE ROOM
C
47000   IF(.NOT.VALID1(J,64)) GO TO 2200
C                                               !VALID ENTRY?
        WRITE(OUTCH,590) CPVEC(J)
C                                               !OUTPUT OLD,
        READ(INPCH,600) CPVEC(J)
        GO TO 2000
C
#endif PDP
        END