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

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