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
Last modified: 1988-10-21
Generated: 2016-12-26
Generated by src2html V0.67
page hit count: 683
Valid CSS Valid XHTML 1.0 Strict