# 2.11BSD#431 - /usr/src/new/PORT/dungeon/gdt.F

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