[unix-history] / 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
Commit	Line	Data
8b22683c KB	1	C GDT- GAME DEBUGGING TOOL
	2	C
	3	C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
	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	#ifdef PDP
	12	C
	13	C no debugging tool available in pdp version
	14	C
	15	call nogdt
	16	return
	17	#else
	18	CHARACTER*2 DBGCMD(38),CMD
	19	INTEGER ARGTYP(38)
	20	LOGICAL VALID1,VALID2,VALID3
	21	character*2 ldbgcm(38)
	22	#include "parser.h"
	23	#include "gamestate.h"
	24	#include "state.h"
	25	#include "screen.h"
	26	#include "puzzle.h"
	27	C
	28	C MISCELLANEOUS VARIABLES
	29	C
	30	COMMON /STAR/ MBASE,STRBIT
	31	#include "io.h"
	32	#include "mindex.h"
	33	#include "debug.h"
	34	#include "rooms.h"
	35	#include "rindex.h"
	36	#include "exits.h"
	37	#include "objects.h"
	38	#include "oindex.h"
	39	#include "clock.h"
	40	#include "villians.h"
	41	#include "advers.h"
	42	#include "flags.h"
	43	C
	44	C FUNCTIONS AND DATA
	45	C
	46	VALID1(A1,L1)=(A1.GT.0).AND.(A1.LE.L1)
	47	VALID2(A1,A2,L1)=VALID1(A1,L1).AND.VALID1(A2,L1).AND.
	48	& (A1.LE.A2)
	49	VALID3(A1,L1,A2,L2)=VALID1(A1,L1).AND.VALID1(A2,L2)
	50	DATA CMDMAX/38/
	51	DATA DBGCMD/'DR','DO','DA','DC','DX','DH','DL','DV','DF','DS',
	52	& 'AF','HE','NR','NT','NC','ND','RR','RT','RC','RD',
	53	& 'TK','EX','AR','AO','AA','AC','AX','AV','D2','DN',
	54	& 'AN','DM','DT','AH','DP','PD','DZ','AZ'/
	55	DATA ldbgcm/'dr','do','da','dc','dx','dh','dl','dv','df','ds',
	56	& 'af','he','nr','nt','nc','nd','rr','rt','rc','rd',
	57	& 'tk','ex','ar','ao','aa','ac','ax','av','d2','dn',
	58	& 'an','dm','dt','ah','dp','pd','dz','az'/
	59	DATA ARGTYP/ 2 , 2 , 2 , 2 , 2 , 0 , 0 , 2 , 2 , 0 ,
	60	& 1 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 ,
	61	& 1 , 0 , 3 , 3 , 3 , 3 , 1 , 3 , 2 , 2 ,
	62	& 1 , 2 , 1 , 0 , 0 , 0 , 0 , 1 /
	63	C GDT, PAGE 2
	64	C
65	C FIRST, VALIDATE THAT THE CALLER IS AN IMPLEMENTER.
66	C
67	FMAX=46
68	C !SET ARRAY LIMITS.
69	SMAX=22
70	C
71	IF(GDTFLG.NE.0) GO TO 2000
72	C !IF OK, SKIP.
73	WRITE(OUTCH,100)
74	C !NOT AN IMPLEMENTER.
75	RETURN
76	C !BOOT HIM OFF
77	C
78	#ifdef NOCC
79	100 FORMAT('You are not an authorized user.')
80	#else NOCC
81	100 FORMAT(' You are not an authorized user.')
82	#endif NOCC
83	c GDT, PAGE 2A
84	C
85	C HERE TO GET NEXT COMMAND
86	C
87	2000 WRITE(OUTCH,200)
88	C !OUTPUT PROMPT.
89	READ(INPCH,210) CMD
90	C !GET COMMAND.
91	IF(CMD.EQ.' ') GO TO 2000
92	C !IGNORE BLANKS.
93	DO 2100 I=1,CMDMAX
94	C !LOOK IT UP.
95	IF(CMD.EQ.DBGCMD(I)) GO TO 2300
96	C !FOUND?
97	C check for lower case command, as well
98	if(cmd .eq. ldbgcm(i)) go to 2300
99	2100 CONTINUE
100	2200 WRITE(OUTCH,220)
101	C !NO, LOSE.
102	GO TO 2000
103	C
104	#ifdef NOCC
105	200 FORMAT('GDT>',$)
106	#else NOCC
107	200 FORMAT(' GDT>',$)
108	#endif NOCC
109	210 FORMAT(A2)
110	#ifdef NOCC
111	220 FORMAT('?')
112	#else NOCC
113	220 FORMAT(' ?')
114	#endif NOCC
115	230 FORMAT(2I6)
116	240 FORMAT(I6)
117	#ifdef NOCC
118	225 FORMAT('Limits: ',$)
119	235 FORMAT('Entry: ',$)
120	245 FORMAT('Idx,Ary: ',$)
121	#else NOCC
122	225 FORMAT(' Limits: ',$)
123	235 FORMAT(' Entry: ',$)
124	245 FORMAT(' Idx,Ary: ',$)
125	#endif NOCC
126	c
127	2300 GO TO (2400,2500,2600,2700),ARGTYP(I)+1
128	C !BRANCH ON ARG TYPE.
129	GO TO 2200
130	C !ILLEGAL TYPE.
131	C
132	2700 WRITE(OUTCH,245)
133	C !TYPE 3, REQUEST ARRAY COORDS.
134	READ(INPCH,230) J,K
135	GO TO 2400
136	C
137	2600 WRITE(OUTCH,225)
138	C !TYPE 2, READ BOUNDS.
139	READ(INPCH,230) J,K
140	IF(K.EQ.0) K=J
141	GO TO 2400
142	C
143	2500 WRITE(OUTCH,235)
144	C !TYPE 1, READ ENTRY NO.
145	READ(INPCH,240) J
146	2400 GO TO (10000,11000,12000,13000,14000,15000,16000,17000,18000,
147	& 19000,20000,21000,22000,23000,24000,25000,26000,27000,28000,
148	& 29000,30000,31000,32000,33000,34000,35000,36000,37000,38000,
149	& 39000,40000,41000,42000,43000,44000,45000,46000,47000),I
150	GO TO 2200
151	C !WHAT???
152	C GDT, PAGE 3
153	C
154	C DR-- DISPLAY ROOMS
155	C
156	10000 IF(.NOT.VALID2(J,K,RLNT)) GO TO 2200
157	C !ARGS VALID?
158	WRITE(OUTCH,300)
159	C !COL HDRS.
160	DO 10100 I=J,K
161	WRITE(OUTCH,310) I,(EQR(I,L),L=1,5)
162	10100 CONTINUE
163	GO TO 2000
164	C
165	#ifdef NOCC
166	300 FORMAT('RM# DESC1 EXITS ACTION VALUE FLAGS')
167	310 FORMAT(I3,4(1X,I6),1X,I6)
168	#else NOCC
169	300 FORMAT(' RM# DESC1 EXITS ACTION VALUE FLAGS')
170	310 FORMAT(1X,I3,4(1X,I6),1X,I6)
171	#endif NOCC
172	C
173	C DO-- DISPLAY OBJECTS
174	C
175	11000 IF(.NOT.VALID2(J,K,OLNT)) GO TO 2200
176	C !ARGS VALID?
177	WRITE(OUTCH,320)
178	C !COL HDRS
179	DO 11100 I=J,K
180	WRITE(OUTCH,330) I,(EQO(I,L),L=1,14)
181	11100 CONTINUE
182	GO TO 2000
183	C
184	#ifdef NOCC
185	320 FORMAT('OB# DESC1 DESC2 DESCO ACT FLAGS1 FLAGS2 FVL TVL
186	& SIZE CAPAC ROOM ADV CON READ')
187	330 FORMAT(I3,3I6,I4,2I7,2I4,2I6,1X,3I4,I6)
188	#else NOCC
189	320 FORMAT(' OB# DESC1 DESC2 DESCO ACT FLAGS1 FLAGS2 FVL TVL
190	& SIZE CAPAC ROOM ADV CON READ')
191	330 FORMAT(1X,I3,3I6,I4,2I7,2I4,2I6,1X,3I4,I6)
192	#endif NOCC
193	C
194	C DA-- DISPLAY ADVENTURERS
195	C
196	12000 IF(.NOT.VALID2(J,K,ALNT)) GO TO 2200
197	C !ARGS VALID?
198	WRITE(OUTCH,340)
199	DO 12100 I=J,K
200	WRITE(OUTCH,350) I,(EQA(I,L),L=1,7)
201	12100 CONTINUE
202	GO TO 2000
203	C
204	#ifdef NOCC
205	340 FORMAT('AD# ROOM SCORE VEHIC OBJECT ACTION STREN FLAGS')
206	350 FORMAT(I3,6(1X,I6),1X,I6)
207	#else NOCC
208	340 FORMAT(' AD# ROOM SCORE VEHIC OBJECT ACTION STREN FLAGS')
209	350 FORMAT(1X,I3,6(1X,I6),1X,I6)
210	#endif NOCC
211	C
212	C DC-- DISPLAY CLOCK EVENTS
213	C
214	13000 IF(.NOT.VALID2(J,K,CLNT)) GO TO 2200
215	C !ARGS VALID?
216	WRITE(OUTCH,360)
217	DO 13100 I=J,K
218	WRITE(OUTCH,370) I,(EQC(I,L),L=1,2),CFLAG(I)
219	13100 CONTINUE
220	GO TO 2000
221	C
222	#ifdef NOCC
223	360 FORMAT('CL# TICK ACTION FLAG')
224	370 FORMAT(I3,1X,I6,1X,I6,5X,L1)
225	#else NOCC
226	360 FORMAT(' CL# TICK ACTION FLAG')
227	370 FORMAT(1X,I3,1X,I6,1X,I6,5X,L1)
228	#endif NOCC
229	C
230	C DX-- DISPLAY EXITS
231	C
232	14000 IF(.NOT.VALID2(J,K,XLNT)) GO TO 2200
233	C !ARGS VALID?
234	WRITE(OUTCH,380)
235	C !COL HDRS.
236	DO 14100 I=J,K,10
237	C !TEN PER LINE.
238	L=MIN0(I+9,K)
239	C !COMPUTE END OF LINE.
240	WRITE(OUTCH,390) I,L,(TRAVEL(L1),L1=I,L)
241	14100 CONTINUE
242	GO TO 2000
243	C
244	#ifdef NOCC
245	380 FORMAT(' RANGE CONTENTS')
246	390 FORMAT(I3,'-',I3,3X,10I7)
247	#else NOCC
248	380 FORMAT(' RANGE CONTENTS')
249	390 FORMAT(1X,I3,'-',I3,3X,10I7)
250	#endif NOCC
251	C
252	C DH-- DISPLAY HACKS
253	C
254	15000 WRITE(OUTCH,400) THFPOS,THFFLG,THFACT,SWDACT,SWDSTA
255	GO TO 2000
256	C
257	#ifdef NOCC
258	400 FORMAT('THFPOS=',I6,', THFFLG=',L2,',THFACT=',L2/
259	& ' SWDACT=',L2,', SWDSTA=',I2)
260	#else NOCC
261	400 FORMAT(' THFPOS=',I6,', THFFLG=',L2,',THFACT=',L2/
262	& ' SWDACT=',L2,', SWDSTA=',I2)
263	#endif NOCC
264	C
265	C DL-- DISPLAY LENGTHS
266	C
267	16000 WRITE(OUTCH,410) RLNT,XLNT,OLNT,CLNT,VLNT,ALNT,MLNT,R2LNT,
268	& MBASE,STRBIT
269	GO TO 2000
270	C
271	#ifdef NOCC
272	410 FORMAT('R=',I6,', X=',I6,', O=',I6,', C=',I6/
273	& 'V=',I6,', A=',I6,', M=',I6,', R2=',I5/
274	& 'MBASE=',I6,', STRBIT=',I6)
275	#else NOCC
276	410 FORMAT(' R=',I6,', X=',I6,', O=',I6,', C=',I6/
277	& ' V=',I6,', A=',I6,', M=',I6,', R2=',I5/
278	& ' MBASE=',I6,', STRBIT=',I6)
279	#endif NOCC
280	C
281	C DV-- DISPLAY VILLAINS
282	C
283	17000 IF(.NOT.VALID2(J,K,VLNT)) GO TO 2200
284	C !ARGS VALID?
285	WRITE(OUTCH,420)
286	C !COL HDRS
287	DO 17100 I=J,K
288	WRITE(OUTCH,430) I,(EQV(I,L),L=1,5)
289	17100 CONTINUE
290	GO TO 2000
291	C
292	#ifdef NOCC
293	420 FORMAT('VL# OBJECT PROB OPPS BEST MELEE')
294	430 FORMAT(I3,5(1X,I6))
295	#else NOCC
296	420 FORMAT(' VL# OBJECT PROB OPPS BEST MELEE')
297	430 FORMAT(1X,I3,5(1X,I6))
298	#endif NOCC
299	C
300	C DF-- DISPLAY FLAGS
301	C
302	18000 IF(.NOT.VALID2(J,K,FMAX)) GO TO 2200
303	C !ARGS VALID?
304	DO 18100 I=J,K
305	WRITE(OUTCH,440) I,FLAGS(I)
306	18100 CONTINUE
307	GO TO 2000
308	C
309	#ifdef NOCC
310	440 FORMAT('Flag #',I2,' = ',L1)
311	#else NOCC
312	440 FORMAT(' Flag #',I2,' = ',L1)
313	#endif NOCC
314	C
315	C DS-- DISPLAY STATE
316	C
317	19000 WRITE(OUTCH,450) PRSA,PRSO,PRSI,PRSWON,PRSCON
318	WRITE(OUTCH,460) WINNER,HERE,TELFLG
319	WRITE(OUTCH,470) MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD,LTSHFT,BLOC,
320	& MUNGRM,HS,EGSCOR,EGMXSC
321	WRITE(OUTCH,475) FROMDR,SCOLRM,SCOLAC
322	GO TO 2000
323	C
324	#ifdef NOCC
325	450 FORMAT('Parse vector=',3(1X,I6),1X,L6,1X,I6)
326	460 FORMAT('Play vector= ',2(1X,I6),1X,L6)
327	470 FORMAT('State vector=',9(1X,I6)/14X,2(1X,I6))
328	475 FORMAT('Scol vector= ',1X,I6,2(1X,I6))
329	#else NOCC
330	450 FORMAT(' Parse vector=',3(1X,I6),1X,L6,1X,I6)
331	460 FORMAT(' Play vector= ',2(1X,I6),1X,L6)
332	470 FORMAT(' State vector=',9(1X,I6)/14X,2(1X,I6))
333	475 FORMAT(' Scol vector= ',1X,I6,2(1X,I6))
334	#endif NOCC
335	C GDT, PAGE 4
336	C
337	C AF-- ALTER FLAGS
338	C
339	20000 IF(.NOT.VALID1(J,FMAX)) GO TO 2200
340	C !ENTRY NO VALID?
341	WRITE(OUTCH,480) FLAGS(J)
342	C !TYPE OLD, GET NEW.
343	READ(INPCH,490) FLAGS(J)
344	GO TO 2000
345	C
346	#ifdef NOCC
347	480 FORMAT('Old=',L2,6X,'New= ',$)
348	#else NOCC
349	480 FORMAT(' Old=',L2,6X,'New= ',$)
350	#endif NOCC
351	490 FORMAT(L1)
352	C
353	C 21000-- HELP
354	C
355	21000 WRITE(OUTCH,900)
356	GO TO 2000
357	C
358	#ifdef NOCC
359	900 FORMAT('Valid commands are:'/'AA- Alter ADVS'/
360	& 'AC- Alter CEVENT'/'AF- Alter FINDEX'/'AH- Alter HERE'/
361	& 'AN- Alter switches'/'AO- Alter OBJCTS'/'AR- Alter ROOMS'/
362	& 'AV- Alter VILLS'/'AX- Alter EXITS'/
363	& 'AZ- Alter PUZZLE'/'DA- Display ADVS'/
364	& 'DC- Display CEVENT'/'DF- Display FINDEX'/'DH- Display HACKS'/
365	& 'DL- Display lengths'/'DM- Display RTEXT'/
366	& 'DN- Display switches'/
367	& 'DO- Display OBJCTS'/'DP- Display parser'/
368	& 'DR- Display ROOMS'/'DS- Display state'/'DT- Display text'/
369	& 'DV- Display VILLS'/'DX- Display EXITS'/'DZ- Display PUZZLE'/
370	& 'D2- Display ROOM2'/'EX- Exit'/'HE- Type this message'/
371	& 'NC- No cyclops'/'ND- No deaths'/'NR- No robber'/
372	& 'NT- No troll'/'PD- Program detail'/
373	& 'RC- Restore cyclops'/'RD- Restore deaths'/
374	& 'RR- Restore robber'/'RT- Restore troll'/'TK- Take.')
375	#else NOCC
376	900 FORMAT(' Valid commands are:'/' AA- Alter ADVS'/
377	& ' AC- Alter CEVENT'/' AF- Alter FINDEX'/' AH- Alter HERE'/
378	& ' AN- Alter switches'/' AO- Alter OBJCTS'/' AR- Alter ROOMS'/
379	& ' AV- Alter VILLS'/' AX- Alter EXITS'/
380	& ' AZ- Alter PUZZLE'/' DA- Display ADVS'/
381	& ' DC- Display CEVENT'/' DF- Display FINDEX'/' DH- Display HACKS'/
382	& ' DL- Display lengths'/' DM- Display RTEXT'/
383	& ' DN- Display switches'/
384	& ' DO- Display OBJCTS'/' DP- Display parser'/
385	& ' DR- Display ROOMS'/' DS- Display state'/' DT- Display text'/
386	& ' DV- Display VILLS'/' DX- Display EXITS'/' DZ- Display PUZZLE'/
387	& ' D2- Display ROOM2'/' EX- Exit'/' HE- Type this message'/
388	& ' NC- No cyclops'/' ND- No deaths'/' NR- No robber'/
389	& ' NT- No troll'/' PD- Program detail'/
390	& ' RC- Restore cyclops'/' RD- Restore deaths'/
391	& ' RR- Restore robber'/' RT- Restore troll'/' TK- Take.')
392	#endif NOCC
393	C
394	C NR-- NO ROBBER
395	C
396	22000 THFFLG=.FALSE.
397	C !DISABLE ROBBER.
398	THFACT=.FALSE.
399	CALL NEWSTA(THIEF,0,0,0,0)
400	C !VANISH THIEF.
401	WRITE(OUTCH,500)
402	GO TO 2000
403	C
404	#ifdef NOCC
405	500 FORMAT('No robber.')
406	#else NOCC
407	500 FORMAT(' No robber.')
408	#endif NOCC
409	C
410	C NT-- NO TROLL
411	C
412	23000 TROLLF=.TRUE.
413	CALL NEWSTA(TROLL,0,0,0,0)
414	WRITE(OUTCH,510)
415	GO TO 2000
416	C
417	#ifdef NOCC
418	510 FORMAT('No troll.')
419	#else NOCC
420	510 FORMAT(' No troll.')
421	#endif NOCC
422	C
423	C NC-- NO CYCLOPS
424	C
425	24000 CYCLOF=.TRUE.
426	CALL NEWSTA(CYCLO,0,0,0,0)
427	WRITE(OUTCH,520)
428	GO TO 2000
429	C
430	#ifdef NOCC
431	520 FORMAT('No cyclops.')
432	#else NOCC
433	520 FORMAT(' No cyclops.')
434	#endif NOCC
435	C
436	C ND-- IMMORTALITY MODE
437	C
438	25000 DBGFLG=1
439	WRITE(OUTCH,530)
440	GO TO 2000
441	C
442	#ifdef NOCC
443	530 FORMAT('No deaths.')
444	#else NOCC
445	530 FORMAT(' No deaths.')
446	#endif NOCC
447	C
448	C RR-- RESTORE ROBBER
449	C
450	26000 THFACT=.TRUE.
451	WRITE(OUTCH,540)
452	GO TO 2000
453	C
454	#ifdef NOCC
455	540 FORMAT('Restored robber.')
456	#else NOCC
457	540 FORMAT(' Restored robber.')
458	#endif NOCC
459	C
460	C RT-- RESTORE TROLL
461	C
462	27000 TROLLF=.FALSE.
463	CALL NEWSTA(TROLL,0,MTROL,0,0)
464	WRITE(OUTCH,550)
465	GO TO 2000
466	C
467	#ifdef NOCC
468	550 FORMAT('Restored troll.')
469	#else NOCC
470	550 FORMAT(' Restored troll.')
471	#endif NOCC
472	C
473	C RC-- RESTORE CYCLOPS
474	C
475	28000 CYCLOF=.FALSE.
476	MAGICF=.FALSE.
477	CALL NEWSTA(CYCLO,0,MCYCL,0,0)
478	WRITE(OUTCH,560)
479	GO TO 2000
480	C
481	#ifdef NOCC
482	560 FORMAT('Restored cyclops.')
483	#else NOCC
484	560 FORMAT(' Restored cyclops.')
485	#endif NOCC
486	C
487	C RD-- MORTAL MODE
488	C
489	29000 DBGFLG=0
490	WRITE(OUTCH,570)
491	GO TO 2000
492	C
493	#ifdef NOCC
494	570 FORMAT('Restored deaths.')
495	#else NOCC
496	570 FORMAT(' Restored deaths.')
497	#endif NOCC
498	C GDT, PAGE 5
499	C
500	C TK-- TAKE
501	C
502	30000 IF(.NOT.VALID1(J,OLNT)) GO TO 2200
503	C !VALID OBJECT?
504	CALL NEWSTA(J,0,0,0,WINNER)
505	C !YES, TAKE OBJECT.
506	WRITE(OUTCH,580)
507	C !TELL.
508	GO TO 2000
509	C
510	#ifdef NOCC
511	580 FORMAT('Taken.')
512	#else NOCC
513	580 FORMAT(' Taken.')
514	#endif NOCC
515	C
516	C EX-- GOODBYE
517	C
518	31000 PRSCON=1
519	RETURN
520	C
521	C AR-- ALTER ROOM ENTRY
522	C
523	32000 IF(.NOT.VALID3(J,RLNT,K,5)) GO TO 2200
524	C !INDICES VALID?
525	WRITE(OUTCH,590) EQR(J,K)
526	C !TYPE OLD, GET NEW.
527	READ(INPCH,600) EQR(J,K)
528	GO TO 2000
529	C
530	#ifdef NOCC
531	590 FORMAT('Old= ',I6,6X,'New= ',$)
532	#else NOCC
533	590 FORMAT(' Old= ',I6,6X,'New= ',$)
534	#endif NOCC
535	600 FORMAT(I6)
536	C
537	C AO-- ALTER OBJECT ENTRY
538	C
539	33000 IF(.NOT.VALID3(J,OLNT,K,14)) GO TO 2200
540	C !INDICES VALID?
541	WRITE(OUTCH,590) EQO(J,K)
542	READ(INPCH,600) EQO(J,K)
543	GO TO 2000
544	C
545	C AA-- ALTER ADVS ENTRY
546	C
547	34000 IF(.NOT.VALID3(J,ALNT,K,7)) GO TO 2200
548	C !INDICES VALID?
549	WRITE(OUTCH,590) EQA(J,K)
550	READ(INPCH,600) EQA(J,K)
551	GO TO 2000
552	C
553	C AC-- ALTER CLOCK EVENTS
554	C
555	35000 IF(.NOT.VALID3(J,CLNT,K,3)) GO TO 2200
556	C !INDICES VALID?
557	IF(K.EQ.3) GO TO 35500
558	C !FLAGS ENTRY?
559	WRITE(OUTCH,590) EQC(J,K)
560	READ(INPCH,600) EQC(J,K)
561	GO TO 2000
562	C
563	35500 WRITE(OUTCH,480) CFLAG(J)
564	READ(INPCH,490) CFLAG(J)
565	GO TO 2000
566	C GDT, PAGE 6
567	C
568	C AX-- ALTER EXITS
569	C
570	36000 IF(.NOT.VALID1(J,XLNT)) GO TO 2200
571	C !ENTRY NO VALID?
572	WRITE(OUTCH,610) TRAVEL(J)
573	READ(INPCH,620) TRAVEL(J)
574	GO TO 2000
575	C
576	#ifdef NOCC
577	610 FORMAT('Old= ',I6,6X,'New= ',$)
578	#else NOCC
579	610 FORMAT(' Old= ',I6,6X,'New= ',$)
580	#endif NOCC
581	620 FORMAT(I6)
582	C
583	C AV-- ALTER VILLAINS
584	C
585	37000 IF(.NOT.VALID3(J,VLNT,K,5)) GO TO 2200
586	C !INDICES VALID?
587	WRITE(OUTCH,590) EQV(J,K)
588	READ(INPCH,600) EQV(J,K)
589	GO TO 2000
590	C
591	C D2-- DISPLAY ROOM2 LIST
592	C
593	38000 IF(.NOT.VALID2(J,K,R2LNT)) GO TO 2200
594	DO 38100 I=J,K
595	WRITE(OUTCH,630) I,RROOM2(I),OROOM2(I)
596	38100 CONTINUE
597	GO TO 2000
598	C
599	#ifdef NOCC
600	630 FORMAT('#',I2,' Room=',I6,' Obj=',I6)
601	#else NOCC
602	630 FORMAT(' #',I2,' Room=',I6,' Obj=',I6)
603	#endif NOCC
604	C
605	C DN-- DISPLAY SWITCHES
606	C
607	39000 IF(.NOT.VALID2(J,K,SMAX)) GO TO 2200
608	C !VALID?
609	DO 39100 I=J,K
610	WRITE(OUTCH,640) I,SWITCH(I)
611	39100 CONTINUE
612	GO TO 2000
613	C
614	#ifdef NOCC
615	640 FORMAT('Switch #',I2,' = ',I6)
616	#else NOCC
617	640 FORMAT(' Switch #',I2,' = ',I6)
618	#endif NOCC
619	C
620	C AN-- ALTER SWITCHES
621	C
622	40000 IF(.NOT.VALID1(J,SMAX)) GO TO 2200
623	C !VALID ENTRY?
624	WRITE(OUTCH,590) SWITCH(J)
625	READ(INPCH,600) SWITCH(J)
626	GO TO 2000
627	C
628	C DM-- DISPLAY MESSAGES
629	C
630	41000 IF(.NOT.VALID2(J,K,MLNT)) GO TO 2200
631	C !VALID LIMITS?
632	WRITE(OUTCH,380)
633	DO 41100 I=J,K,10
634	L=MIN0(I+9,K)
635	WRITE(OUTCH,650) I,L,(RTEXT(L1),L1=I,L)
636	41100 CONTINUE
637	GO TO 2000
638	C
639	#ifdef NOCC
640	650 FORMAT(I3,'-',I3,3X,10(1X,I6))
641	#else NOCC
642	650 FORMAT(1X,I3,'-',I3,3X,10(1X,I6))
643	#endif NOCC
644	C
645	C DT-- DISPLAY TEXT
646	C
647	42000 CALL RSPEAK(J)
648	GO TO 2000
649	C
650	C AH-- ALTER HERE
651	C
652	43000 WRITE(OUTCH,590) HERE
653	READ(INPCH,600) HERE
654	EQA(1,1)=HERE
655	GO TO 2000
656	C
657	C DP-- DISPLAY PARSER STATE
658	C
659	44000 WRITE(OUTCH,660) ORP,LASTIT,PVEC,SYN
660	GO TO 2000
661	C
662	#ifdef NOCC
663	660 FORMAT('ORPHS= ',I7,I7,4I7/
664	& 'PV= ',I7,4I7/'SYN= ',6I7/15X,5I7)
665	#else NOCC
666	660 FORMAT(' ORPHS= ',I7,I7,4I7/
667	& ' PV= ',I7,4I7/' SYN= ',6I7/15X,5I7)
668	#endif NOCC
669	C
670	C PD-- PROGRAM DETAIL DEBUG
671	C
672	45000 WRITE(OUTCH,610) PRSFLG
673	C !TYPE OLD, GET NEW.
674	READ(INPCH,620) PRSFLG
675	GO TO 2000
676	C
677	C DZ-- DISPLAY PUZZLE ROOM
678	C
679	46000 DO 46100 I=1,64,8
680	C !DISPLAY PUZZLE
681	WRITE(OUTCH,670) (CPVEC(J),J=I,I+7)
682	46100 CONTINUE
683	GO TO 2000
684	C
685	#ifdef NOCC
686	670 FORMAT(1X,8I3)
687	#else NOCC
688	670 FORMAT(2X,8I3)
689	#endif NOCC
690	C
691	C AZ-- ALTER PUZZLE ROOM
692	C
693	47000 IF(.NOT.VALID1(J,64)) GO TO 2200
694	C !VALID ENTRY?
695	WRITE(OUTCH,590) CPVEC(J)
696	C !OUTPUT OLD,
697	READ(INPCH,600) CPVEC(J)
698	GO TO 2000
699	C
700	#endif PDP
701	END