Subroutine Movleg c *********************************************************************** c * * c * Subroutine Movleg - To move or change the legend. * c * * c * Programmed by Steven C. Fisher, DTRC Code 1522 * c * * c *********************************************************************** c Common/Legmov/Xorig,Yorig,Xlegln,Ylegln,Lesize,Legcnr,Leglin, $ Gblspc c 10 Continue c Write(6,100) 27,27 100 Format(A,'[HLEGEND: Select (M)ove, (T)ext size, (V)ertical', $ ' spacing, or (S)top ',A,'[K') c Call Instrg('MmTtVvSs',8,Ido) Ido = (Ido+1)/2 c If (Ido .EQ. 1) Then Write(6,150) 27,27 150 Format(A,'[HPut crosshair on the legend corner to move', $ ' using. ',A,'[K') Call Crosshair('Ss ',3,Xpos,Ypos,Nflag) If (Nflag .EQ. 1 .OR. Nflag .EQ. 2) Go To 10 c Call Near_Legend(Xpos,Ypos,Nc,Xorig,Yorig,Xlegln,Ylegln) c Write(6,200) 27,7,27 200 Format(A,'[HNow, move the cursor to the place to move the', $ ' legend to ',2A,'[K') Call Crosshair('Ss ',3,Xpos,Ypos,Nflag) If (Nflag .EQ. 1 .OR. Nflag .EQ. 2) Go To 10 c c If the point is close to the axes, move it c over to the axes c Call Gtwind(Xl,Xr,Yb,Yt) If (Abs((Xpos-Xl)/(Xr-Xl)) .LT. 0.010) Then Xpos = Xl End If If (Abs((Xpos-Xr)/(Xr-Xl)) .LT. 0.010) Then Xpos = Xr End If If (Abs((Ypos-Yb)/(Yt-Yb)) .LT. 0.010) Then Ypos = Yb End If If (Abs((Ypos-Yt)/(Yt-Yb)) .LT. 0.010) Then Ypos = Yt End If c Call Plot_Delete_Start Call Plot_Leg Call Plot_Delete_End c Call New_Legend(Xpos,Ypos,Nc,Xorig,Yorig,Xlegln,Ylegln) Call Plot_On Call Plot_Leg Call Boxax Call Plot_Off Legcnr = Nc c Else If (Ido .EQ. 2) Then c Write(6,300) 27,27 300 Format(A,'[HEnter the new legend text size ',A,'[K') Call Inchek(1,10,Isize) If (Isize .EQ. Lesize) Go To 10 c c Scale the legend size c If (Isize .EQ. 1) Then Size = 1.7 Else If (Isize .EQ. 2) Then Size = 2.3 Else Size = Isize End If c If (Lesize .EQ. 1) Then Sizel = 1.7 Else If (Lesize .EQ. 2) Then Sizel = 2.3 Else Sizel = Lesize End If c Call Plot_Delete_Start Call Plot_Leg Call Plot_Delete_End c Ratio = Size / Sizel Lesize = Isize Call Size_Legend(Xorig,Yorig,Legcnr,Xlegln,Ylegln,Ratio) Call Plot_On Call Plot_Leg Call Boxax Call Plot_Off c Else If (Ido .EQ. 3) Then 30 Continue Write(6,350) 27,27 350 Format(A,'[HEnter the new vertical spacing factor ', $ ' (0.3 to 2.0) ',A,'[K') Read(5,*,END=30,ERR=30) Gb Gb = Amin1(2.0,Amax1(0.3,Gb)) If (Gb .EQ. Gblspc) Go To 10 c Call Plot_Delete_Start Call Plot_Leg Call Plot_Delete_End c Ratio = (1.5+Leglin*(1.0+Gb))/(1.5+Leglin*(1.0+Gblspc)) Call Vert_Legend(Yorig,Legcnr,Ylegln,Ratio) Gblspc = Gb c Call Plot_On Call Plot_Leg Call Boxax Call Plot_Off Else Return End If c Go To 10 c End Subroutine Near_Legend(Xpos,Ypos,N,Xog,Yog,Xlen,Ylen) c *********************************************************************** c * * c * Subroutine Near_Legend - To determine which corner or * c * control point on the legend (or text block) is closest to * c * the terminal crosshairs. * c * * c * Programmed by Steven C. Fisher, DTRC Code 1522 * c * * c *********************************************************************** c Common/Cross/Xsmin,Xsmax,Ysmin,Ysmax Dimension D(9) c Call Gtscrn(Xsl,Xsr,Ysb,Yst) c Dx = (Xpos-Xsmin)/(Xsmax-Xsmin)*(Xsr-Xsl) + Xsl Dy = (Ypos-Ysmin)/(Ysmax-Ysmin)*(Yst-Ysb) + Ysb Rmin = 100.0 * (Xsr**2 + Yst**2) N = 0 c Xo = (Xog-Xsmin)/(Xsmax-Xsmin)*(Xsr-Xsl) + Xsl Yo = (Yog-Ysmin)/(Ysmax-Ysmin)*(Yst-Ysb) + Ysb Xl = Xlen/(Xsmax-Xsmin)*(Xsr-Xsl) Yl = Ylen/(Ysmax-Ysmin)*(Yst-Ysb) c D(1) = (Dx-Xo)**2 + (Dy-Yo-Yl)**2 D(2) = (Dx-Xo)**2 + (Dy-Yo)**2 D(3) = (Dx-Xo-Xl)**2 + (Dy-Yo-Yl)**2 D(4) = (Dx-Xo-Xl)**2 + (Dy-Yo)**2 D(5) = (Dx-Xo-Xl/2.0)**2 + (Dy-Yo-Yl/2.0)**2 D(6) = (Dx-Xo)**2 + (Dy-Yo-Yl/2.0)**2 D(7) = (Dx-Xo-Xl)**2 + (Dy-Yo-Yl/2.0)**2 D(8) = (Dx-Xo-Xl/2.0)**2 + (Dy-Yo-Yl)**2 D(9) = (Dx-Xo-Xl/2.0)**2 + (Dy-Yo)**2 c Do 10 I=1,9 If (Rmin .GT. D(I)) Then N = I Rmin = D(I) End If 10 Continue c Return End Subroutine New_Legend(Xpos,Ypos,N,Xo,Yo,Xlen,Ylen) c *********************************************************************** c * * c * Subroutine New_Legend c * * c * Programmed by Steven C. Fisher, DTRC Code 1522 * c * * c *********************************************************************** c If (N .EQ. 1) Then Xo = Xpos Yo = Ypos - Ylen Else If (N .EQ. 2) Then Xo = Xpos Yo = Ypos Else If (N .EQ. 3) Then Xo = Xpos - Xlen Yo = Ypos - Ylen Else If (N .EQ. 4) Then Xo = Xpos - Xlen Yo = Ypos Else If (N .EQ. 5) Then Xo = Xpos - Xlen/2.0 Yo = Ypos - Ylen/2.0 Else If (N .EQ. 6) Then Xo = Xpos Yo = Ypos - Ylen/2.0 Else If (N .EQ. 7) Then Xo = Xpos - Xlen Yo = Ypos - Ylen/2.0 Else If (N .EQ. 8) Then Xo = Xpos - Xlen/2.0 Yo = Ypos - Ylen Else Xo = Xpos - Xlen/2.0 Yo = Ypos End If c Return End Subroutine Size_Legend(Xpos,Ypos,N,Xlen,Ylen,Ratio) c *********************************************************************** c * * c * Subroutine Size_Legend - To compute the legend position * c * after changing the legend text size. * c * * c * Programmed by Steven C. Fisher, DTRC Code 1522 * c * * c *********************************************************************** c If (N .EQ. 1) Then Ypos = Ypos + Ylen - Ylen * Ratio Else If (N .EQ. 3) Then Xpos = Xpos + Xlen - Xlen * Ratio Ypos = Ypos + Ylen - Ylen * Ratio Else If (N .EQ. 4) Then Xpos = Xpos + Xlen - Xlen * Ratio Else If (N .EQ. 5) Then Xpos = Xpos + Xlen/2.0 - Xlen/2.0 * Ratio Ypos = Ypos + Ylen/2.0 - Ylen/2.0 * Ratio Else If (N .EQ. 6) Then Ypos = Ypos + Ylen/2.0 - Ylen/2.0 * Ratio Else If (N .EQ. 7) Then Xpos = Xpos + Xlen - Xlen * Ratio Ypos = Ypos + Ylen/2.0 - Ylen/2.0 * Ratio Else If (N .EQ. 8) Then Xpos = Xpos + Xlen/2.0 - Xlen/2.0 * Ratio Ypos = Ypos + Ylen - Ylen * Ratio Else If (N .EQ. 9) Then Xpos = Xpos + Xlen/2.0 - Xlen/2.0 * Ratio End If c Xlen = Xlen * Ratio Ylen = Ylen * Ratio c Return End Subroutine Vert_Legend(Ypos,N,Ylen,Ratio) c *********************************************************************** c * * c * Subroutine Vert_Legend - To compute the new legend (and * c * text block) Y position due to changing the legend and text * c * block vertical and global spacing factors, respectively. * c * * c * Programmed by Steven C. Fisher, DTRC Code 1522 * c * * c *********************************************************************** c If (N .EQ. 1) Then Ypos = Ypos + Ylen - Ylen * Ratio Else If (N .EQ. 3) Then Ypos = Ypos + Ylen - Ylen * Ratio Else If (N .EQ. 5) Then Ypos = Ypos + Ylen/2.0 - Ylen/2.0 * Ratio Else If (N .EQ. 6) Then Ypos = Ypos + Ylen/2.0 - Ylen/2.0 * Ratio Else If (N .EQ. 7) Then Ypos = Ypos + Ylen/2.0 - Ylen/2.0 * Ratio Else If (N .EQ. 8) Then Ypos = Ypos + Ylen - Ylen * Ratio End If c Ylen = Ylen * Ratio c Return End Subroutine Plot_Leg c *********************************************************************** c * * c * Subroutine Plot_Leg - To draw the legend border on the * c * screen. * c * * c * Programmed by Steven C. Fisher, DTRC Code 1522 * c * * c *********************************************************************** c Dimension X(5),Y(5) Common/Legmov/Xorig,Yorig,Xlegln,Ylegln,Lesize,Legcnr,Leglin, $ Gblspc Common/Ptype/Idev,Xtop,Spchar,Chscal,Chsc1 c X(1) = Xorig Y(1) = Yorig X(2) = Xorig + Xlegln Y(2) = Yorig X(3) = X(2) Y(3) = Yorig + Ylegln X(4) = Xorig Y(4) = Y(3) X(5) = Xorig Y(5) = Yorig c If (Lesize .EQ. 1) Then Sizel = 1.7 Else If (Lesize .EQ. 2) Then Sizel = 2.3 Else Sizel = Lesize End If c Call Wccurv(X,Y,5) Call Stjust(5) Call Movawc(Xorig+Xlegln/2.0,Yorig+Ylegln/2.0) Call Stccsz(Sizel*0.03*Chscal,Sizel*0.042*Chscal) Call Grtxcp(99,'@@@1(LEGEND)\') c Return End Subroutine Boxax c *********************************************************************** c * * c * Subroutine Boxax - To redraw the box around the axes, which * c * may be erased when erasing a legend or text block. * c * * c * Programmed by Steven C. Fisher, DTRC Code 1522 * c * * c *********************************************************************** c Dimension Xmin(2),Ymin(2),Xmax(2),Ymax(2),Xinc(2),Yinc(2) Integer Xnumbr,Ynumbr,Axchst,Axtypx,Axtypy,Axcolr,Ticdir Byte Xaxis(2,80),Yaxis(2,80) c Byte Titl(80),Char c Integer Atxclr,Spchar,Xtop c Common/Ptype/Idev,Xtop,Spchar,Chscal Common/Labls/Nold,Lachst,Lacolr,Nleg,Lechst,Lecolr,Legtit,Labcrd, $ Iprtot,Irott Common/Axis/Xmin,Xmax,Ymin,Ymax,Xinc,Yinc,Xlen,Ylen,Xnumbr, $ Ynumbr,Xaxis,Yaxis,Axthik,Axchst,Axtypx,Axtypy,Axcolr,Textsz, $ Ticdir,Atxclr c If (Labcrd .EQ. 0) Then c c Set up local coordinate system c Call Plwin(Xmin(1),Xmax(1),Ymin(1),Ymax(1),Xlen,Ylen) Call Wframe Call Plcord(Xmin(1),Xmax(1),Ymin(1),Ymax(1),Xlen,Ylen) c Else c c Set up global coordinate system c Call Plwin(0.0,1.0,0.0,1.0,Xlen,Ylen) Call Wframe Call Plcord(0.0,1.0,0.0,1.0,Xlen,Ylen) c End If c Return End Subroutine Movtxbl c *********************************************************************** c * * c * Subroutine Movtxbl - To move or change a text block. * c * * c * Programmed by Steven C. Fisher, DTRC Code 1522 * c * * c *********************************************************************** c Common/Textbl/Ntxbl Common/Txplot/Xtxorg(20),Ytxorg(20),Xtlen(20),Ytlen(20), $ Loctx(20),Txszratio(20),Txspac(20),Txlen(20) c If (Ntxbl .EQ. 0) Return 10 Continue c Write(6,100) 27,27 100 Format(A,'[HTEXT BLOCKS: Select (M)ove, (G)lobal Spacing', $ ' factor, or (S)top ',A,'[K') c Call Instrg('MmGgSs',6,Ido) Ido = (Ido+1)/2 c If (Ido .EQ. 1) Then c c Moving a text block. First, find which point on the text c block you will use as a reference. This also identifies c which text block to move c Write(6,150) 27,27 150 Format(A,'[HPut crosshair on the text block corner to move', $ ' using. ',A,'[K') Call Crosshair('Ss ',3,Xpos,Ypos,Nflag) If (Nflag .EQ. 1 .OR. Nflag .EQ. 2) Go To 10 c Call Nearest_Tb(Xpos,Ypos,N) Call Near_Legend(Xpos,Ypos,Nc,Xtxorg(N),Ytxorg(N), $ Xtlen(N),Ytlen(N)) c Write(6,200) 27,7,27 200 Format(A,'[HNow, move the cursor to the place to move the', $ ' text block to ',2A,'[K') Call Crosshair('Ss ',3,Xpos,Ypos,Nflag) If (Nflag .EQ. 1 .OR. Nflag .EQ. 2) Go To 10 c c If the point is close to the axes, move it c over to the axes c Call Gtwind(Xl,Xr,Yb,Yt) If (Abs((Xpos-Xl)/(Xr-Xl)) .LT. 0.01) Then Xpos = Xl End If If (Abs((Xpos-Xr)/(Xr-Xl)) .LT. 0.01) Then Xpos = Xr End If If (Abs((Ypos-Yb)/(Yt-Yb)) .LT. 0.01) Then Ypos = Yb End If If (Abs((Ypos-Yt)/(Yt-Yb)) .LT. 0.01) Then Ypos = Yt End If c c Erase text block c Call Plot_Delete_Start Call Plot_Text(N) Call Plot_Delete_End c c Compute the new text block position, and redraw it c Call New_Legend(Xpos,Ypos,Nc,Xtxorg(N),Ytxorg(N), $ Xtlen(N),Ytlen(N)) Call Plot_On Call Plot_Text(N) Call Boxax Call Plot_Off Loctx(N) = Nc c Else If (Ido .EQ. 2) Then c c Change the text block global spacing factor..... c First, see which text block if more than one exist c If (Ntxbl .GT. 1) Then 30 Continue Write(6,250) 27,27 250 Format(A,'[HPut crosshair on the text block to change', $ A,'[K') Call Crosshair('Ss ',3,Xpos,Ypos,Nflag) If (Nflag .EQ. 1 .OR. Nflag .EQ. 2) Go To 10 c Call Nearest_Tb(Xpos,Ypos,N) Else N = 1 End If c c Get the global spacing factor from the user c Write(6,300) 27,27 300 Format(A,'[HEnter the global spacing factor value ',A,'[K') Read(5,*,END=30,ERR=30) Gb Gb = Amax1(0.0,Gb) If (Gb .EQ. Txspac(N)) Go To 10 c c Erase current text block c Call Plot_Delete_Start Call Plot_Text(N) Call Plot_Delete_End c c Get the new text block size c Y = Gb/Txspac(N) * (Ytlen(N)-Txlen(N)) + Txlen(N) Ratio = Y / Ytlen(N) Txspac(N) = Gb Call Vert_Legend(Ytxorg(N),Loctx(N),Ytlen(N),Ratio) c c Draw the new text block c Call Plot_On Call Plot_Text(N) Call Boxax Call Plot_Off c Else Return End If c Go To 10 c End Subroutine Plot_Text(N) c *********************************************************************** c * * c * Subroutine Plot_Text - To draw the text block border, * c * and write the label "text block N" inside of it. * c * * c * Programmed by Steven C. Fisher, DTRC Code 1522 * c * * c *********************************************************************** c Dimension X(5),Y(5) Common/Txplot/Xtxorg(20),Ytxorg(20),Xtlen(20),Ytlen(20), $ Loctx(20),Txszratio(20),Txspac(20),Txlen(20) Common/Ptype/Idev,Xtop,Spchar,Chscal,Chsc1 Character Stringc*20 Byte Stringb(20) Equivalence (Stringc,Stringb) c X(1) = Xtxorg(N) Y(1) = Ytxorg(N) X(2) = Xtxorg(N) + Xtlen(N) Y(2) = Ytxorg(N) X(3) = X(2) Y(3) = Ytxorg(N) + Ytlen(N) X(4) = Xtxorg(N) Y(4) = Y(3) X(5) = Xtxorg(N) Y(5) = Ytxorg(N) c Call Wccurv(X,Y,5) Call Stjust(5) Call Movawc(Xtxorg(N)+Xtlen(N)/2.0,Ytxorg(N)+Ytlen(N)/2.0) Call Stccsz(Txszratio(N)*0.3*Chscal,Txszratio(N)*0.42*Chscal) Write(Stringc,100) N 100 Format('@@@1(TEXT BLOCK',I3,')') Call Grtxcp(19,Stringb) c Return End Subroutine Nearest_Tb(Xpos,Ypos,N) c *********************************************************************** c * * c * Subroutine Nearest_Tb - To find which text block is * c * closest to the terminal crosshair position. * c * * c * Programmed by Steven C. Fisher, DTRC Code 1522 * c * * c *********************************************************************** c Common/Cross/Xsmin,Xsmax,Ysmin,Ysmax Common/Textbl/Ntxbl Common/Txplot/Xtxorg(20),Ytxorg(20),Xtlen(20),Ytlen(20), $ Loctx(20),Txszratio(20),Txspac(20),Txlen(20) c Call Gtscrn(Xsl,Xsr,Ysb,Yst) Rmin = 100.0 * (Xsr**2 + Yst**2) Dx = (Xpos-Xsmin)/(Xsmax-Xsmin)*(Xsr-Xsl) + Xsl Dy = (Ypos-Ysmin)/(Ysmax-Ysmin)*(Yst-Ysb) + Ysb N = 0 c c Loop over the text blocks to see which is closest c to the crosshairs. Use screen units. c Do 10 I=1,Ntxbl Xo = (Xtxorg(I)-Xsmin)/(Xsmax-Xsmin)*(Xsr-Xsl) + Xsl Yo = (Ytxorg(I)-Ysmin)/(Ysmax-Ysmin)*(Yst-Ysb) + Ysb Xl = Xtlen(I)/(Xsmax-Xsmin)*(Xsr-Xsl) Yl = Ytlen(I)/(Ysmax-Ysmin)*(Yst-Ysb) c Xint = Amin1(Xo+Xl,Amax1(Xo,Dx)) Yint = Amin1(Yo+Yl,Amax1(Yo,Dy)) Delta = (Dx-Xint)**2 + (Dy-Yint)**2 c If (Rmin .GT. Delta) Then Rmin = Delta N = I End If c 10 Continue Return End