Subroutine LEGEND c c *********************************************************************** c * * c * Subroutine LEGEND - To print out a legend on the plot * c * * c * Programmed by Steven C. Fisher, DTNSRDC 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 Leglab(600),Junk(15) Integer Boxleg,Symleg,Atxclr Dimension Lt(10),Triangle(8) Dimension Symleg(25),Linleg(25),Lleg(25),Icolor(25) c Dimension Xvec(5),Yvec(5) c Data Junk/15*'8'/ Data Lt/1,22,52,5222,11,4444,7242,1414,7111,9252/ Data Triangle/3.0,0.0,0.0,0.5,-0.5,-0.577,0.289,0.289/ c Integer Spchar,Xtop Byte Char c Common/Ptype/Idev,Xtop,Spchar,Chscal Common/Labls/Nlab,Lachst,Lacolr,Nleg,Lechst,Lecolr,Legtit,Labcrd, $ Iprtot Common/Axis/Xmin,Xmax,Ymin,Ymax,Xinc,Yinc,Xlen,Ylen,Xnumbr, $ Ynumbr,Xaxis,Yaxis,Axthik,Axchst,Axtypx,Axtypy,Axcolr,Textsz, $ Ticdir,Atxclr Common/Legmov/Xorig,Yorig,Xlegln,Ylegln,Lesize,Legcnr,Leglin, $ Gblspc c c Set the labels coordinate system c If (Nleg .EQ. 0) Return ! No labels to draw c If (Labcrd .EQ. 0) Then c c Set up local coordinate system c Call Plcord(Xmin(1),Xmax(1),Ymin(1),Ymax(1),Xlen,Ylen) Xscale = (Xmax(1) - Xmin(1)) / Xlen Yscale = (Ymax(1) - Ymin(1)) / Ylen c Else c c Set up global coordinate system c Call Plcord(0.0,1.0,0.0,1.0,Xlen,Ylen) Xscale = 1.0/Xlen Yscale = 1.0/Ylen c End If c c Read in the legend characteristics c Read(12,*) Xleg,Yleg,Locleg,Boxleg,Sizleg,Legsz,Cvthik,Gblspc c Lesize = Sizleg Legcnr = Locleg If (Sizleg .EQ. 1.0) Sizleg = 1.7 If (Sizleg .EQ. 2.0) Sizleg = 2.3 c c Set the color, character set, and line thicknesses c Call Stplco(Lecolr) Call Sttxco(Lecolr) Call Stlthc(Cvthik) c If (Lechst .GT. 0) Then Call Stsoft Call Stcstn(Lechst) If (Spchar .GT. 1) Call Stcspa(1,0,0) Else Call Sthard End If c c Set the text size c Call Stccsz(Sizleg*0.03*Chscal,Sizleg*0.042*Chscal) Call Gtccsz(Xchar,Ychar) c c Set the symbol size c Call Stsysz(Xchar*1.3) ! Don't multiply by Chscal - Xchar compensates c c Read in the legend data and compute the length of the text c Xmx = 0.0 Do 10 I = 1,Nleg Call Point(K,I,Lleg) Read(12,*) Lleg(I),Symleg(I),Linleg(I),Icolor(I) Read(12,125) (Leglab(J),J=K,K+Lleg(I)-1) 125 Format(A1) If (Sizleg .EQ. 0.0) Go To 10 Call Strn(Leglab(K),Lleg(I),Lechst) If (I .GT. 1) Then c c Legend label lengths c Call Gtstln(Lleg(I),Leglab(K),Alen) If( Alen .GT. Xmx) Xmx = Alen Else c c Legend Title length c If (Lleg(1) .GT. 0) Then Call Gtstln(Lleg(1),Leglab(1),Tlen) Else If (Nleg .EQ. 1) Return Tlen = 0.0 End If End If 10 Continue If (Sizleg .EQ. 0.0) Return c c Compute the size of the legend c If (Legsz .EQ. 0) Nsp = 2 If (Legsz .EQ. 1) Nsp = 5 If (Legsz .EQ. 2) Nsp = 12 c Call Gtstln(Nsp,Junk,Xsp) Call Gtstln(2,Junk,X2sp) c If (Tlen .GT. Xmx + Xsp) Then Delta = (Tlen-(Xmx+Xsp))/2.0 Xmx = Tlen - Xsp Else Delta = 0.0 End If c c Get the location of the lower left corner c If (Legtit .EQ. 0) Then Numleg = Nleg - 1 Else Numleg = Nleg End If c Xorig = Xleg Yorig = Yleg Leglin = Numleg Xlegln = Xscale * (Xsp + Xmx + X2sp) Ylegln = Yscale*Ychar * (Numleg*(1.0+Gblspc) + 1.5) c c Compute the lower left corner of the legend c If (Locleg .EQ. 1) Then Yorig = Yorig - Ylegln Else If (Locleg .EQ. 5) Then Xorig = Xorig - Xlegln / 2.0 Yorig = Yorig - Ylegln / 2.0 Else If (Locleg .EQ. 3) Then Yorig = Yorig - Ylegln Xorig = Xorig - Xlegln Else If (Locleg .EQ. 4) Then Xorig = Xorig - Xlegln Else If (Locleg .EQ. 6) Then Yorig = Yorig - Ylegln / 2.0 Else If (Locleg .EQ. 7) Then Yorig = Yorig - Ylegln / 2.0 Xorig = Xorig - Xlegln Else If (Locleg .EQ. 8) Then Yorig = Yorig - Ylegln Xorig = Xorig - Xlegln / 2.0 Else If (Locleg .EQ. 9) Then Xorig = Xorig - Xlegln / 2.0 End If c If (Idev .GT. 0) Then c Call Stjust(1) c c Write out the legend labels and symbols and lines c Do 20 I=1,Nleg L = I If (Legtit .EQ. 0) L = L - 1 c Call Point(K,I,Lleg) If (I .GT. 1) Then c c Legend labels: c Call Stjust(1) Call Movawc(Xorig+(Xsp+Delta)*Xscale,Yorig+Ylegln- $ Yscale*Ychar*(2.0+(L-1)*(1.0+Gblspc))) Call Grtxcp(Lleg(I),Leglab(K)) Else c c Legend titles c Call Stjust(2) Call Movawc(Xorig+Xlegln/2.0,Yorig+Ylegln-Yscale* $ Ychar*(2.0+(L-1)*(1.0+Gblspc))) If (Lleg(1) .GT. 0) Call Grtxcp(Lleg(1),Leglab(1)) End If c c Set the line and symbol color c Call Stplco(Icolor(I)) Call Stsyco(Icolor(I)) If (Symleg(I) .GT. 0) Then c c Draw a preceeding symbol? c If (Symleg(I) .LT. 11) Then Call Stsyty(10+Symleg(I)) Call Wcsymb(Xorig+(Xsp/2.0+Delta)*Xscale, $ Yorig+Ylegln-Yscale*Ychar*(1.5+(L-1)*(1.0+Gblspc))) Else Call Wcsymd(Xorig+(Xsp/2.0+Delta)*Xscale, $ Yorig+Ylegln-Yscale*Ychar*(1.5+(L-1)*(1.0+Gblspc)), $ Triangle) End If End If c c Draw a preceeding line? c If (Linleg(I) .NE. 0) Then Call Stlint(Lt(Linleg(I))) Xvec(1) = Xorig+(X2sp+Delta)*Xscale Yvec(1) = Yorig+Ylegln-Yscale*Ychar*(1.5+(L-1)* $ (1.0+Gblspc)) Xvec(2) = Xorig+(X2sp*Xscale*5.0)+ Delta*Xscale Yvec(2) = Yvec(1) Call Wccurv(Xvec,Yvec,2) Call Stlint(1) End If 20 Continue Else Call Stjust(5) Call Movawc(Xorig+Xlegln/2.0,Yorig+Ylegln/2.0) Call Grtxcp(99,'@@@1(LEGEND)\') End If c c Draw a box c Call Stplco(Lecolr) Call Stlint(1) Call Stlthc(Axthik) c If (Boxleg .EQ. 1) Then Xvec(1) = Xorig Yvec(1) = Yorig Xvec(2) = Xorig+Xlegln Yvec(2) = Yorig Xvec(3) = Xorig+Xlegln Yvec(3) = Yorig+Ylegln Xvec(4) = Xorig Yvec(4) = Yorig+Ylegln Xvec(5) = Xorig Yvec(5) = Yorig Call Wccurv(Xvec,Yvec,5) End If c c Set the text protection about the box c If (Idev .GT. 0) Then Call Wctosc(Xorig,Yorig,X1,Y1) Call Wctosc(Xorig+Xlegln,Yorig+Ylegln,X2,Y2) Call Stprot(X1,X2,Y1,Y2) End If c Return End