SUBROUTINE TVGMOD C C This subroutine allows you to modify the parameters. C COMMON /INPUT/ NCHRS, NAT, NTO, IN(130) COMMON /TEXTS/ DA, DO, DS, A(96), O(96), X(96), Y(96), 1 S(96), ICHRS(96), DC, C(96), QQ, TEXT(130,96) COMMON /PLTR/ ILun,IDev,IsTerm,IMode,IXMax,IYmax, 1 Cnvrsn,CMag,CnvMag,IX0,IY0,KSetNo,IFancy,IBfDv3, 1 CSize,DeltaH,DeltaV,Upsiln,CosUP,SinUP LOGICAL DEFALT, NEWTXT LOGICAL*1 IN, DC, C, TEXT, IT, QQ DIMENSION LTEXT(65,96) EQUIVALENCE (LTEXT(1,1),TEXT(1,1)) C C - WHAT TO DO? 100 NAT = NAT + 1 IF( NAT .GT. NCHRS ) RETURN NDO = ITWAS( IN( NAT ), 'ACOPSTB', 7 ) IF( NDO .EQ. 8 ) GO TO 100 C C - FIND WHICH TEXT NLO = NAT+1 DO 1000 N=NLO,NCHRS NAT = N IF ( NDO .EQ. 6 ) GOTO 200 IF( ITWAS( IN( N ), '+-.0123456789', 13 ) .LT. 14 ) GO TO 1200 200 NTEXT = (IN(N)-"40).AND."177 IF ( ( NTEXT.LE.0 ) .OR. ( NTEXT .GT. 96 )) 1 GO TO 1000 IF( NTEXT .LE. 96 ) GO TO 1100 1000 CONTINUE RETURN C C - SET NON-DEFAULT 1100 DEFALT = .FALSE. NEWTXT = .FALSE. NAT = N+1 GO TO 1300 C C - SET FOR DEFAULT VALUE 1200 IF ((N+1).GT.NCHRS) GOTO 1210 IF (IN(N+1).NE."40) GOTO 1210 NTEXT=(IN(N)-"40).AND."177 NAT = N+2 GOTO 1100 1210 DEFALT = .TRUE. C C - GO TO PROPER SECTION IF NO NUMBER SHOULD FOLLOW. 1300 IF( NDO .EQ. 4 ) GO TO 1500 IF( NDO .EQ. 6 ) GO TO 1600 C!!!!! IF( NDO .EQ. 7 ) GO TO 2100 C!!!!! C C - GET NUMBER. CALL NUMBER( IN, NCHRS, NAT, 3, VALUE ) IF( VALUE .LT. 0 ) RETURN IF( DEFALT ) GO TO 1400 C C - SET TEXT VALUES. IF( NDO .EQ. 1 ) A( NTEXT ) = VALUE IF( NDO .EQ. 2 ) C( NTEXT ) = IFIX( VALUE ) IF( NDO .EQ. 3 ) O( NTEXT ) = VALUE IF( NDO .EQ. 5 ) S( NTEXT ) = VALUE RETURN C C - SET DEFAULT VALUE. 1400 IF( NDO .EQ. 1 ) DA = VALUE IF( NDO .EQ. 2 ) DC = IFIX( VALUE ) IF( NDO .EQ. 3 ) DO = VALUE IF( NDO .EQ. 5 ) DS = VALUE RETURN C C - GET NEW POSITION. 1500 IF( ILun .EQ. 0 ) RETURN IF( A(NTEXT) .GE. -1) GOTO 1501 X1=X(NTEXT) Y1=Y(NTEXT) CALL CALPLT( X1-.05, Y1,3) CALL CALPLT( X1+.05, Y1, 2) CALL CALPLT( X1, Y1-.05, 3) CALL CALPLT( X1, Y1+.05, 2) 1501 CALL GIN( X(NTEXT), Y(NTEXT), IT ) IF( ITWAS( IT, 'LCR', 3 ) .EQ. 4 ) RETURN IF (A(NTEXT).LE.-1.)RETURN A( NTEXT ) = ITWAS( IT, 'LCR ', 4)*.5 - .5 RETURN C C - FILL IN NEW TEXT. 1600 NEWTXT = .FALSE. IF( ICHRS( NTEXT ) .LE. 0 ) NEWTXT = .TRUE. ICHRS( NTEXT ) = NCHRS - NAT + 1 IF( ICHRS( NTEXT ) .LE. 0 ) RETURN IF( .NOT. NEWTXT ) GO TO 1700 A( NTEXT ) = DA C( NTEXT ) = DC O( NTEXT ) = DO S( NTEXT ) = DS 1700 DO 2000 N=1,ICHRS( NTEXT ) 2000 TEXT( N, NTEXT ) = IN( NAT+N-1 ) NAT = NCHRS IF( NEWTXT ) GO TO 1500 RETURN C!!!!! C C - DRAW LINE SEGS C C 2100 NEWTXT=.FALSE. IF ( ICHRS(NTEXT).LE.0)NEWTXT=.TRUE. CALL GIN(X(NTEXT),Y(NTEXT),IT) IF (IT.EQ.'E')RETURN CALL CALPLT(X(NTEXT),Y(NTEXT),3) IVEC = 0 X1=X(NTEXT) Y1=Y(NTEXT) 2110 CALL GIN(XX,YY,IT) CALL CALPLT(X1,Y1,3) IVEC = IVEC + 1 CALL CALPLT(XX,YY,2) X1=XX Y1=YY LTEXT(2*IVEC-1,NTEXT)=(XX-X(NTEXT))*2500. LTEXT(2*IVEC,NTEXT)=(YY-Y(NTEXT))*2500. IF ( IVEC .EQ. 32 )GOTO 2190 IT=IT.AND."337 IF (IT.EQ.'E')GOTO 2190 IF (IT.NE.'C')GOTO 2110 IVEC = IVEC + 1 LTEXT(2*IVEC-1,NTEXT)=0 LTEXT(2*IVEC,NTEXT)=0 CALL CALPLT(X(NTEXT),Y(NTEXT),2) 2190 ICHRS(NTEXT)=I*4 CALL TOUTPT( "15 ) A( NTEXT ) = -IVEC ICHRS( NTEXT ) = IVEC RETURN END