![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to gdt.F CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDReno / games / dungeon|
Return to gdt.F CVS log | Up to [CSRG BSD Unix] / 43BSDReno / games / dungeon |
1.1 root 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
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.