Subroutine Txtblk c c *********************************************************************** c * * c * Subroutine Txtblk - To print out a text block 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 Dimension Xvec(5),Yvec(5) Dimension Xchar(10),Ychar(10) c Dimension Llabel(50),Space(50),Just(50),Sizlab(50),Alen(50) Integer Txblch,Txblcl,Txbloc,Txbord c Integer Spchar,Xtop Byte Label(1750) Character*80 Labelc Equivalence (Label,Labelc) c Common/Ptype/Idev,Xtop,Spchar,Chscal Common/Labls/Nlab,Lachst,Lacolr,Nleg,Lechst,Lecolr,Legtit,Labcrd, $ Iprtot Common/Textbl/Ntxbl Common/Axis/Xmin,Xmax,Ymin,Ymax,Xinc,Yinc,Xlen,Ylen,Xnumbr, $ Ynumbr,Xaxis,Yaxis,Axthik,Axchst,Axtypx,Axtypy,Axcolr,Textsz, $ Ticdir,Atxclr Common/Txplot/Xtxorg(20),Ytxorg(20),Xtlen(20),Ytlen(20), $ Loctx(20),Txszratio(20),Txspac(20),Txlen(20) c c Set the labels coordinate system c If (Ntxbl .EQ. 0) Return ! No text blocks 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 X1 = Xmin(1) X2 = Xmax(1) Y1 = Ymin(1) Y2 = Ymax(1) 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 X1 = 0.0 X2 = 1.0 Y1 = 0.0 Y2 = 1.0 c End If c Read(12,*,END=99,ERR=99) I !Read in a unusable variable c Do 50 Loop=1,Ntxbl c c Read in the text block parameters c Read(12,*,END=99,ERR=99) Ntxl,Txtblx,Txtbly,Txblch,Txblcl, $ Txbloc,Txbord,Txblsp If (Ntxl .EQ. 0) Go To 50 If (Idev .LE. 0) Txbord = 1 c c Set the color and text character set c If (Idev .LE. 0) Txblcl = 1 If (Txblcl .EQ. 0) Txblcl = Lacolr If (Txblch .EQ. -1) Txblch = Lachst Call Stplco(Txblcl) Call Sttxco(Txblcl) c If (Txblch .GT. 0) Then Call Stsoft Call Stcstn(Txblch) If (Spchar .GT. 1) Call Stcspa(1,0,0) Else Call Sthard End If c c Compute the true text size c Do 10 I=1,10 If (I .EQ. 1) Then A = 1.7 Else If (I .EQ. 2) Then A = 2.3 Else A = I End If Call Stccsz(A*0.03*Chscal,A*0.042*Chscal) Call Gtccsz(Xchar(I),Ychar(I)) 10 Continue c c Read in the text data and compute the length of the text c Ymx = 0.0 Txlen(Loop) = 0.0 Sidemx = 0.0 Ctrmax = 0.0 Do 20 I = 1,Ntxl Call Point(K,I,Llabel) Read(12,*,END=99,ERR=99) Space(I),Sizlab(I),Just(I) Read(12,125,END=99,ERR=99) Llabel(I),(Label(J),J=K, $ K+Llabel(I)-1) 125 Format(Q,132A1) c If (Sizlab(I) .EQ. 1.0) Sizlab(I) = 1.7 If (Sizlab(I) .EQ. 2.0) Sizlab(I) = 2.3 c If (I .GT. 1 .AND. Space(I) .GE. 0.0) Then Space(I) = Space(I) * Txblsp Txlen(Loop) = Txlen(Loop) + Ychar(Int(Sizlab(I))) Else Txlen(Loop) = Txlen(Loop) + (1.0 + Space(I)) * $ Ychar(Int(Sizlab(I))) End If c Call Strn(Label(K),Llabel(I),Txblch) Call Stccsz(Sizlab(I)*0.03*Chscal,Sizlab(I)*0.042*Chscal) c c Text block label lengths c Call Gtstln(Llabel(I),Label(K),Alen(I)) Call Gtstln(3,'888',Xsz) If (Just(I) .EQ. 2) Then Ctrmax = Amax1(Ctrmax,Xsz) Else Sidemx = Amax1(Sidemx,Xsz) End If Ymx = Ymx + (1.0 + Space(I)) * Ychar(Int(Sizlab(I))) 20 Continue Xside = 0.0 Xcentr = 0.0 c Do 30 I=1,Ntxl If (Just(I) .NE. 2) Then Xside = Amax1(Alen(I) + Sidemx,Xside) Else Xcentr = Amax1(Alen(I) + Ctrmax,Xcentr) End If 30 Continue c Xmx = Amax1(Xcentr,Xside) If (Xcentr .GT. Xside) Then Delx = Ctrmax / 2.0 * Xscale Else Delx = Sidemx / 2.0 * Xscale End If c c Compute the size of the text block c c Get the location of the lower left corner c Ybord = Amax1(Ychar(Int(Sizlab(1))),Ychar(Int(Sizlab(Ntxl)))) Txlen(Loop) = (Txlen(Loop) + 1.7 * Ybord) * Yscale Ymx = Ymx + 1.7 * Ybord Xorig = Txtblx Yorig = Txtbly Xtxlen = Xscale * Xmx Ytxlen = Yscale * Ymx Xtlen(Loop) = Xtxlen Ytlen(Loop) = Ytxlen Txspac(Loop) = Txblsp c c Compute the lower left corner of the text block c If (Txbloc .EQ. 1) Then Yorig = Yorig - Ytxlen Else If (Txbloc .EQ. 5) Then Xorig = Xorig - Xtxlen / 2.0 Yorig = Yorig - Ytxlen / 2.0 Else If (Txbloc .EQ. 3) Then Yorig = Yorig - Ytxlen Xorig = Xorig - Xtxlen Else If (Txbloc .EQ. 4) Then Xorig = Xorig - Xtxlen Else If (Txbloc .EQ. 6) Then Yorig = Yorig - Ytxlen / 2.0 Else If (Txbloc .EQ. 7) Then Yorig = Yorig - Ytxlen / 2.0 Xorig = Xorig - Xtxlen Else If (Txbloc .EQ. 8) Then Yorig = Yorig - Ytxlen Xorig = Xorig - Xtxlen / 2.0 Else If (Txbloc .EQ. 9) Then Xorig = Xorig - Xtxlen / 2.0 End If c Xtxorg(Loop) = Xorig Ytxorg(Loop) = Yorig Loctx(Loop) = Txbloc c c See if the text block falls outside of the plot region; c if so, turn off the protection if the box is not drawn c Iprot = 1 Ytop = Yorig + Ytxlen - 0.7 * Ybord * Yscale Ybot = Yorig + Ybord * Yscale Xleft = Xorig + Delx * Xscale Xright = Xorig + Xtxlen - Delx * Xscale c If (Xright .LE. X1 .OR. Xleft .GE. X2 .OR. $ Ytop .LE. Y1 .OR. Ybot .GE. Y2) Iprot = 0 c c Write out the text block labels and symbols and lines c If (Idev .GT. 0) Then Ypoint = Yorig + Ytxlen - 0.7 * Ybord * Yscale Do 40 I=1,Ntxl c Call Point(K,I,Llabel) c c Compute The Text block label Locations: c Ypoint = Ypoint - Ychar(Int(Sizlab(I)))* (1.0 + $ Space(I)) * Yscale If (Sizlab(I) .EQ. 0.0) Go To 40 Call Stccsz(Sizlab(I)*0.03*Chscal,Sizlab(I)*0.042* $ Chscal) Call Stjust(Just(I)) If (Just(I) .EQ. 1) Then Call Movawc(Xorig+Delx,Ypoint) Else If (Just(I) .EQ. 2) Then Call Movawc(Xorig+Xtxlen/2.0,Ypoint) Else If (Just(I) .EQ. 3) Then Call Movawc(Xorig+Xtxlen-Delx,Ypoint) End If c c Write the text block labels c Call Grtxcp(Llabel(I),Label(K)) c 40 Continue Else Call Movawc(Xorig+Xtxlen/2.0,Yorig+Ytxlen/2.0) Call Stjust(5) Call Stccsz(0.3*Chscal,0.42*Chscal) Write(Labelc,100) Loop 100 Format('@@@1(TEXT BLOCK',I3,')') Call Gtstln(19,Label,Alenn) Ratio = 0.75 * Xtxlen/(Alenn * Xscale) Ratio = Amin1(Ratio,0.7) Call Stccsz(Ratio*0.3*Chscal,Ratio*0.42*Chscal) Call Grtxcp(19,Label) Txszratio(Loop) = Ratio End If c c Draw a box c Call Stplco(Txblcl) Call Stlint(1) Call Stlthc(Axthik) c If (Txbord .EQ. 1) Then Xvec(1) = Xorig Yvec(1) = Yorig Xvec(2) = Xorig+Xtxlen Yvec(2) = Yorig Xvec(3) = Xorig+Xtxlen Yvec(3) = Yorig+Ytxlen Xvec(4) = Xorig Yvec(4) = Yorig+Ytxlen Xvec(5) = Xorig Yvec(5) = Yorig Call Wccurv(Xvec,Yvec,5) End If c c Set the text protection about the box c If ((Txbord .NE. 1 .AND. Iprot .EQ. 0) .OR. Idev .LE. 0) $ Go To 50 Call Wctosc(Xorig,Yorig,Xx1,Yy1) Call Wctosc(Xorig+Xtxlen,Yorig+Ytxlen,Xx2,Yy2) Call Stprot(Xx1,Xx2,Yy1,Yy2) 50 Continue c 99 Continue Return End