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: 2268 |
|