00001
00002 c
00003 c Copyright (c) 1986,1987,1988,1989,1990,1991,1992,1993,
00004 c by Steve McMillan, Drexel University, Philadelphia, PA.
00005 c
00006 c All rights reserved.
00007 c
00008 c Redistribution and use in source and binary forms are permitted
00009 c provided that the above copyright notice and this paragraph are
00010 c duplicated in all such forms and that any documentation,
00011 c advertising materials, and other materials related to such
00012 c distribution and use acknowledge that the software was developed
00013 c by the author named above.
00014 c
00015 c THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
00016 c IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
00017 c WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
00018 c
00019
00020 subroutine labels(xctit,yctit)
00021 save
00022 c
00023 character*(*) xctit,yctit
00024 c
00025 common /scales/ xl,xr,dinchx,ybot,ytop,dinchy,rlen,slen
00026 common /fr hts/htl,htn
00027 common /fontc1/ dum2(5),rmax,rmin,smax,smin
00028 common /fr xnums/ xnumbot
00029 common /fr ylab pos/ slab
00030 common /fr rotn/ irot
00031 common /fr setax/ kax,lax
00032 common /dev details/ itek,ivers
00033 common /debug trace/ itrace
00034 common /fr conf/ scent,rnuml,rnumr,snumt,snumb,
00035 & dsnums,jrot,stopnum
00036 c
00037 parameter (kountmax = 1)
00038 c
00039 logical debug
00040 data debug/.false./
00041 c
00042 c Label axes with extended font set. S/R fr spaces now looks for
00043 c five spaces or a non-printing character to terminate the string.
00044 c
00045 c As specified, label sizes are both determined by htl. Allow the
00046 c labels to be rescaled by embedding a '!scale!' at the start.
00047 c
00048 c Note that this routine makes no permanent changes to pen/font size,
00049 c etc. It is assumed that these have already been set up in advance.
00050 c
00051 c First, the x-label.
00052 c ------------------
00053 c
00054 call fr spaces(xctit,nxtit)
00055 c
00056 if (nxtit.gt.0.and.kax.ne.0) then
00057 c
00058 c Plot the x-label
00059 c
00060 lx = len(xctit)
00061 c
00062 c Check for embedded rescaling.
00063 c
00064 call lscale(xctit,nxtit,factor,ifirst)
00065 htlsave = htl
00066 htl = htl*factor
00067 nxtit = nxtit - ifirst + 1
00068 c
00069 c Determine the extent of the label.
00070 c
00071 call simbol(0.,0.,-htl,xctit(ifirst:lx),0.,nxtit)
00072 siml = rmax-rmin
00073 simh = smax-smin
00074 c
00075 c Dimensions of the label are siml wide by simh high.
00076 c
00077 if (siml.gt.rlen) then
00078 htl = htl*rlen/siml
00079 simh = simh*rlen/siml
00080 end if
00081 xltop = xnumbot-.3*(htn+htl)
00082 simbot = xltop-sihm
00083 c
00084 c Draw the label.
00085 c
00086 call getbot(spbot)
00087 if (simbot.lt.spbot)htl = htl*(xltop-spbot)/simh
00088 call strpos(.5,1.)
00089 if (itrace.eq.1) write(2,*)'x call to simbol:',
00090 & .5*rlen,xltop,htl,xctit(ifirst:ifirst+nxtit-1)
00091 call simbol(.5*rlen,xltop,htl,xctit(ifirst:lx),0.,nxtit)
00092 call clrstr
00093 c
00094 htl = htlsave
00095 end if
00096 c
00097 c Now for the y-label.
00098 c -------------------
00099 c
00100 if (lax.lt.0) return
00101 c
00102 if (debug) write(6,*)'y-label...'
00103 kount = 0
00104 ileadsp = 0
00105 inbl = 1
00106 ly = len(yctit)
00107 htlsave = htl
00108 c
00109 c Convention: leading spaces in yctit
00110 c = = > strip and plot the label VERTICALLY.
00111 c
00112 call fr spaces(yctit,nytit)
00113 do 100 inbl = 1,nytit
00114 if (yctit(inbl:inbl).gt.' ') go to 110
00115 100 continue
00116 go to 500
00117 c
00118 110 if (inbl.gt.1) then
00119 ileadsp = 1
00120 nytit = nytit-inbl+1
00121 end if
00122 c
00123 c Check for embedded rescaling.
00124 c
00125 call lscale(yctit(inbl:inbl+nytit-1),nytit,factor,ifirst)
00126 htl = htl*factor
00127 inbl = inbl + ifirst - 1
00128 nytit = nytit - ifirst + 1
00129 c
00130 c Determine the extent of the label.
00131 c
00132 call simbol(0.,0.,-htl,yctit(inbl:ly),0.,nytit)
00133 siml = rmax - rmin
00134 simh = smax - smin
00135 c
00136 c Dimensions of the label are siml wide by simh high.
00137 c Now determine its left and right edges. Note that this uses
00138 c information returned by the last calls to the number-drawing
00139 c routines used by eframe:
00140 c
00141 c rnuml = the left-most extent of the numeric labels
00142 c rnumr = the right-most extent of the numeric labels
00143 c scent = the vertical center of the box
00144 c snumb = the level of the next numeric label below the center
00145 c snumt = the level of the next numeric label above the center
00146 c dsnums = the vertical label spacing
00147 c stopnum = the level of the top numeric label
00148 c jrot = 1 iff the numeric labels are drawn vertically
00149 c
00150 if (debug) write(6,*)'lax,ileadsp,siml,irot,nytit = ',
00151 & lax,ileadsp,siml,irot,nytit
00152
00153 if (lax.le.1) then
00154 rttlmax = rnuml-.5*htn
00155 call getlhe(rttlmin)
00156 rttlmin = max(rttlmin,-.3*rlen)
00157 else
00158 rttlmin = rnumr+.5*htn
00159 call getrhe(rttlmax)
00160 rttlmax = min(rttlmax,1.3*rlen)
00161 end if
00162 c
00163 c The basic dimensions of the label layout are now set.
00164 c
00165 c See if the user wants a horizontal label.
00166 c
00167 if (ileadsp.eq.0.and.irot.eq.0
00168 & .and.(siml.le.7.5*simh.or.siml.le..25*slen)) go to 300
00169 c
00170 c Plot the y-label vertically
00171 c
00172 200 slab = scent
00173 if (lax.le.1) then
00174 rlab = rttlmax-simh
00175 rlablhs = rttlmax-2.*simh
00176 rlabrhs = rlab
00177 else
00178 rlab = rttlmin+simh
00179 rlablhs = rlab
00180 rlabrhs = rttlmin+2.*simh
00181 end if
00182 c
00183 c Check label positioning.
00184 c
00185 if (debug) write(6,*)'Checking position for vertical label...'
00186 if (rlablhs.lt.rttlmin.or.rlabrhs.gt.rttlmax) then
00187 drwant = rttlmax-rttlmin
00188 if (drwant.le..25*simh.and.(itek.ne.1.or.ivers.eq.1)) then
00189 call display text('No room for the y-label.',24)
00190 go to 500
00191 end if
00192 if (debug) write(6,*)'simh,drwant,htn = ',simh,drwant,htn
00193 if (simh-drwant.lt..25*htn) then
00194 if (lax.le.1) then
00195 rlab = rttlmin+.5*simh
00196 else
00197 rlab = rttlmax-.5*simh
00198 end if
00199 else
00200 htl = htl*drwant/simh
00201 siml = siml*drwant/simh
00202 rlab = .5*(rttlmin+rttlmax)
00203 end if
00204 end if
00205 c
00206 if (siml.gt.slen)htl = htl*slen/siml
00207 th = 90.
00208 if (lax.gt.1) th = -th
00209 if (debug) write(6,*)'th = ',th
00210 c
00211 go to 400
00212 c
00213 c Try to make the y-label horizontal.
00214 c ----------------------------------
00215 c
00216 c First, check vertical positioning
00217 c
00218 300 slab = scent
00219 imovr = 0
00220 if (debug) write(6,*)'At 300: jrot = ',jrot
00221 c
00222 if (jrot.eq.0) then
00223 c
00224 c Horizontal numerical labels.
00225 c
00226 if (min(snumt-scent,scent-snumb).gt.1.5*(simh+htn))
00227 & go to 350
00228 c
00229 slab = .5*(snumb+snumt)
00230 if (slab.lt.scent.and.slab+dsnums.lt.stopnum) then
00231 snumb = snumb+dsnums
00232 snumt = snumt+dsnums
00233 slab = slab+dsnums
00234 end if
00235 sclear = min(snumt-slab-.5*simh,slab-snumb-.5*simh)
00236 if (sclear.gt..75*simh) go to 350
00237 end if
00238 c
00239 c Not enough clearance to move right(left): put label's r(l)h edge
00240 c at l(r)h edge of numbers
00241 c
00242 rright = rttlmax
00243 rleft = rttlmin
00244 go to 360
00245 c
00246 c Label can be moved right(left).
00247 c
00248 350 if (debug) write(6,*)'At 350: Move right...'
00249 if (lax.le.1) then
00250 rright = rttlmax
00251 if (rnuml.lt.-2.*htl) rright = .75*rnuml
00252 rleft = rright-siml
00253 if (rleft.gt.rnuml)rright = rnuml+siml
00254 else
00255 dr = rnumr-slen
00256 rleft = rttlmin
00257 if (dr.gt.2.*htl) rleft = rnumr-.25*dr
00258 rright = rleft + siml
00259 if (rright.lt.rnumr)rleft = rnumr-siml
00260 end if
00261 c
00262 imovr = 1
00263 c
00264 c Right(left)-hand edge of label is now set. Check the left(right) end.
00265 c
00266 360 if (lax.le.1) then
00267 room = rright-rttlmin
00268 else
00269 room = rttlmax-rleft
00270 end if
00271 if (debug) write(6,*)'room = ',room
00272 c
00273 if (room.lt.siml) then
00274 kount = kount+1
00275 if (kount.le.kountmax) then
00276 siml = siml*.95
00277 simh = simh*.95
00278 htl = htl*.95
00279 if (debug) write(6,*)'Reducing y-label size.'
00280 go to 300
00281 end if
00282 if (kount.eq.kountmax+1.and.(itek.ne.1.or.ivers.eq.1))
00283 & call display text('Warning: problem plotting'
00284 & ' y-label horizontally.',47)
00285 if (room.lt..9*siml) then
00286 if (imovr.eq.1) then
00287 c
00288 c Try to move label farther right(left).
00289 c
00290 imovr = 2
00291 if (lax.le.1) then
00292 rright = min(rttlmin + siml,-htn)
00293 rleft = rright - siml
00294 else
00295 rleft = rttlmax
00296 rright = rleft + siml
00297 end if
00298 go to 360
00299 end if
00300 c
00301 c Give up--plot the label vertically!
00302 c
00303 siml = siml*htlsave*factor/htl
00304 simh = simh*htlsave*factor/htl
00305 htl = htlsave*factor
00306 if (itek.ne.1.or.ivers.eq.1)
00307 & call display text('Attempting to plot the'
00308 & ' y-label vertically.',42)
00309 go to 200
00310 end if
00311 kount = kount+1
00312 fac = room/siml
00313 htl = htl*fac
00314 siml = siml*fac
00315 simh = simh*fac
00316 go to 350
00317 end if
00318 rlab = rright-.5*siml
00319 th = 0.
00320 c
00321 c Plot the y-label.
00322 c
00323 400 if (debug) write(6,*)'Plotting the label !',rlab,slab
00324 call simbol(rlab,slab,htl,yctit(inbl:ly),th,-nytit)
00325 if (itrace.eq.1) write(2,*)'y call to simbol:',
00326 & rlab,slab,htl,yctit(1:nytit)
00327 c
00328 500 htl = htlsave
00329 c
00330 end
