![[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.