C PROGRAM MODIFY C MODIFY HAS A LIMITED HOUSEKEEPING LIBRARY,BUT DRAWS ITS ENORMOUS C POWER FROM ITS EDITING CAPABILITIES.MODIFY CAN COPY OR DELETE VECTORS C (FROM ANYWHERE IN THE TABLE OF VECTORS).MODIFY INVOKES THE CROSSHAIRS C TO PINPOINT THE ENDS OF THE VECTORS TO BE CHANGED,AND THEN SHIFTS C THE ENTIRE TABLE ACCORDINGLY.ALTHOUGH THE PROGRAM SEEMS LENGTHY,IT C IS FAR SIMPLER THAN IT WOULD BE IF A LINKED LIST WERE USED INSTEAD. C FURTHERMORE,THE PROGRAM SHIFTS THE LIST INSTANTLY,SO THERE IS NO C WAITING TIME. C D CHAINS TO DRAW.SV C E ERASES SCREEN C G CHAINS TO GFIC.SV C M PROCEDE TO MODIFY.SV C T CHAINS TO TAPE.SV C W WRITES TABLE C X EXITS FROM PROGRAM C 1 COPYING MODE C 2 DELETION MODE C 3 RETURN TO COMMAND-QUERY MODE C FORTRAN II C SR : ERASE.FT / FDIS.FT / ALPHA.FT / RKB.FT / JOY.FT C CH : TAPE.SV / DRAW.SV / GFIC.SV C BEARBEITUNG VON DECUS #8-773 COMMON NTAB,IPT DIMENSION NTAB (500,3) GOTO 2 1 CALL ERASE 2 CALL FDIS (0,0,767) CALL ALPHA CALL RKB(K) C W-WRITE,E-ERASE,T-TAPE,D-DRAW,G-GFIC,M-MODIFY,X-EXIT IF (K-1504) 3,13,3 3 IF (K-352) 4,1,4 4 IF (K-1312) 5,10,5 5 IF (K-288) 6,11,6 6 IF (K-480) 7,12,7 7 IF (K-864) 8,15,8 8 IF (K-1568) 2,9,2 9 CALL EXIT 10 CALL CHAIN ('TAPE') 11 CALL CHAIN ('DRAW') 12 CALL CHAIN ('GFIC') 13 DO 14 N=1,IPT 14 CALL FDIS(NTAB(N,1),NTAB(N,2),NTAB(N,3)) GOTO 2 C MODIFY ROUTINE 15 READ (1,100) I 100 FORMAT ('1=COPY,2=DELETE,3=CANCEL 'I1) IF (I-3) 16,2,2 16 CALL JOY (IX,IY,K) DO 20 N=1,IPT DO 17 N3=0,4 IF (NTAB(N,2)-IX+N3-2) 17,18,17 17 CONTINUE GOTO 20 18 CONTINUE DO 19 N3=0,4 IF (NTAB(N,3)-IY+N3-2) 19,21,19 19 CONTINUE 20 CONTINUE WRITE (1,101) 101 FORMAT ('WRONG COORDINATES') GOTO 16 21 NZ=N-1 NZ2=N 22 CALL JOY(IX,IY,K) DO 26 N=NZ2,IPT DO 23 N3=0,4 IF (NTAB(N,2)-IX+N3-2) 23,24,23 23 CONTINUE GOTO 26 24 CONTINUE DO 25 N3=0,4 IF (NTAB(N,3)-IY+N3-2) 25,27,25 25 CONTINUE 26 CONTINUE WRITE (1,102) 102 FORMAT ('BAD COORDINATES') GOTO 22 27 IZ=N-1 IF (I-1) 2,28,28 C ORDERED PAIRS 28 IF (NZ-IZ) 29,30,30 29 N3=IZ IZ=NZ NZ=N3 30 IF (I-1)2,33,31 C DELETE FROM N=IZ TO N=NZ BY MOVING UP 31 CONTINUE IP=NZ-IZ IZ=NZ+1 NTAB(IZ,1)=0 IPT=IPT-IP+1 IZ=IZ-IP+1 DO 32 N=IZ,IPT N2=N+NZ-IZ+1 NTAB(N,1)=NTAB(N2,1) NTAB(N,2)=NTAB(N2,2) NTAB(N,3)=NTAB(N2,3) 32 CONTINUE CALL ERASE GOTO 13 C COPY ROUTINE 33 WRITE (1,103) 103 FORMAT ('NEW POSITION FOR FIRST COORDINATE') CALL JOY(KX,KY,K) IP=NZ-IZ+1 IZ=IZ+1 NZ=NZ+IP KX=KX-NTAB(IZ,2) KY=KY-NTAB(IZ,3) N3=IPT-IZ+NZ NTAB(IPT+1,1)=0 NTAB(IPT+1,2)=NTAB(IZ+1,2)+KX NTAB(IPT+1,3)=NTAB(IZ+1,3)+KY IPT=IPT+2 DO 34 N=IPT,N3 N2=N+IZ-IPT NTAB(N,1)=NTAB(N2,1) NTAB(N,2)=NTAB(N2,2)+KX NTAB(N,3)=NTAB(N2,3)+KY 34 CONTINUE IPT=N3 CALL ERASE GOTO 13 END