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 eframe(xmin,xmax,xlen,modx,xctit,
00021 * ymin,ymax,ylen,mody,yctit)
00022 save
00023 c
00024 character*(*) xctit,yctit
00025 character*100 outbuf
00026 c
00027 common/scales/xl,xr,dinchx,ybot,ytop,dinchy,rlen,slen
00028 common/dev status/idevon,idevpen,idevwt
00029 common/frdraw/mode/frhts/htl,htn/frwts/iwts(4)
00030 common/frpens/icolors(3)/frrotn/irot
00031 common/frticks/tiks(3),tikl/frint/iframe
00032 common/frconf/scent,rnuml,rnumr,snumt,snumb,dsnums,jrot,stopnum
00033 common/frbare/ibare
00034 common/frsetax/kax,lax
00035 common/dev init/init dev
00036 common/debug trace/itrace
00037 c
00038 c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
00039 c
00040 c Draw frame for plot with tick marks, numerical labels, and
00041 c titles, using the extended (SIMBOL) font set.
00042 c
00043 c
00044 c input: ( y is similar to x)
00045 c ------
00046 c
00047 c xmin plot value at left hand side
00048 c xmax plot value at right hand side
00049 c xlen length of x axis in inches
00050 c modx = 1 linear plot limits correspond to xmin xmax
00051 c modx = 2 linear plot limits adjusted to contain to xmin xmax
00052 c modx =-1 log plot limits correspond to xmin xmax
00053 c modx =-2 log plot limits adjusted to contain to xmin xmax
00054 c xctit (character) contains x title
00055 c *** for log plot enter actual variable, i.e. .01 not -2
00056 c
00057 c
00058 c output:
00059 c -------
00060 c
00061 c xl actual value of left limit
00062 c xr actual value of right limit
00063 c dinchx inches per plot unit, i.e. xlen/(xr-xl)
00064 c ybot actual value of bottom limit
00065 c ytop actual value of top limit
00066 c dinchy inches per plot unit, i.e. ylen/(ytop-ybot)
00067 c *** for log plots limit is log10 of variable
00068 c
00069 c
00070 c switches:
00071 c ---------
00072 c
00073 c the following common blocks each may contain one integer*4
00074 c variable (imode, say), whose effect is as described.
00075 c
00076 c (i) /frdraw/ if imode is nonzero, only scaling information is
00077 c returned -- nothing is drawn,
00078 c (ii) /frbnds/ for nonzero imode, only that part of the
00079 c graph (produced by m(d)line) lying within the
00080 c "frame"-defined box is actually plotted,
00081 c (iii)/frlbx/ the x-axis is numbered only for imode=0,
00082 c (iv) /frlby/ the y-axis is numbered only for imode=0.
00083 c (v) /frrotn/ an attempt will be made to keep all y-axis
00084 c labels horizontal if imode is zero. numerical labels
00085 c longer than six characters and text labels with
00086 c length greater than max( 1.2, 7.5*htl )
00087 c will still be plotted vertically.
00088 c (vi) /frplain/ if imode is nonzero, eframe will use "nombr" for the
00089 c numbers, to save on time.
00090 c (vii) /frbare/ if imode is nonzero, no labels will be drawn and
00091 c "numbr" will be used for the numbers.
00092 c
00093 c
00094 c The switches in (i) to (v) above may be set with
00095 c "call setmod(im1,im2,im3,im4,im5)".
00096 c /frplain/ is set using subroutine setsym.
00097 c
00098 c Thus, if no switch is set, entire graphs will be drawn and both
00099 c axes will be numbered (with horizontal labels, if possible).
00100 c
00101 c
00102 c Other variable parameters:
00103 c --------------------------
00104 c
00105 c (vi) htl, htn, in common block /frhts/, give the sizes of the
00106 c titles and numerical labels, respectively. defaults are .15, .15.
00107 c The sizes of all tick marks along the axes scale with htn.
00108 c
00109 c Set heights with "call sethts(ht1,ht2)".
00110 c
00111 c (vii) the weights of various components of the frame may be set
00112 c individually via the integer*4 array iwts in common /frwts/:
00113 c
00114 c iwts(1): box and tick marks.
00115 c iwts(2): numerical labels (excluding exponents, if any).
00116 c iwts(3): exponents (default = iwts(2)).
00117 c iwts(4): text labels.
00118 c
00119 c s/r weight is called with argument iwts(.), when necessary.
00120 c defaults are 0,0,0,0.
00121 c
00122 c Set weights with "call setwts(iw1,iw2,iw3,iw4)".
00123 c
00124 c (viii) the pen types (colors) of various frame components may be set
00125 c individually via the integer*4 array icolors in common /frpens/:
00126 c
00127 c icolors(1): box and tick marks.
00128 c icolors(2): numerical labels (including exponents, if any).
00129 c icolors(3): text labels.
00130 c
00131 c s/r color is called with argument icolors(.), when necessary.
00132 c defaults are 0,0,0.
00133 c
00134 c Set pens with "call setpens(ip1,ip2,ip3)".
00135 c
00136 c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
00137 c
00138 data kountmax/5/
00139 c
00140 if(itrace.eq.1)open(2,file='UNIT2')
00141 c
00142 if(xmax.eq.xmin.or.ymax.eq.ymin.or.xlen.eq.0..or.ylen.eq.0.
00143 + .or.(modx.lt.0.and.(xmin.le.0..or.xmax.le.0.))
00144 + .or.(mody.lt.0.and.(ymin.le.0..or.ymax.le.0.)))then
00145 call display text('error in eframe arguments:',26)
00146 write(outbuf,11111)'x',xmin,xmax,xlen,modx
00147 11111 format(a1,': ',1p3e15.6,i10)
00148 call display text(outbuf,58)
00149 write(outbuf,11111)'y',ymin,ymax,ylen,mody
00150 call display text(outbuf,58)
00151 xl=0.
00152 xr=0.
00153 dinchx=0.
00154 ybot=0.
00155 ytop=0.
00156 dinchy=0.
00157 rlen=0.
00158 slen=0.
00159 return
00160 end if
00161 c
00162 if(init dev.eq.0)then
00163 init dev=-1
00164 call mcinit
00165 call devon
00166 call clear
00167 end if
00168 if(idevon.eq.0)call devon
00169 c
00170 call routine id('eframe')
00171 iframe=1
00172 c
00173 c Experimental precautionary measure:
00174 c
00175 call clrstr
00176 c
00177 c-----------------------------------------------------------------------------
00178 c
00179 c Adjust label and tick sizes, if the plot is small.
00180 c
00181 dmin=min(xlen,ylen)
00182 if(dmin.gt.2.)then
00183 if(htl.eq.0.)htl=.15
00184 if(htn.eq.0.)htn=.15
00185 else
00186 if(htl.eq.0.)htl=.075*dmin
00187 if(htn.eq.0.)htn=htl
00188 end if
00189 c
00190 tiks(1)=.2*htn
00191 tiks(2)=.30*htn
00192 tiks(3)=.45*htn
00193 tikl=.2*htn
00194 c
00195 c Save current heights, pen and weight settings, for restoration at the end.
00196 c
00197 htlsto=htl
00198 htnsto=htn
00199 call getstatus(idum1,idum2,icolorinit,iwtinit)
00200 irotsto=irot
00201 c
00202 c These will inform a new X-window of the curent colors...
00203 c
00204 call color(icolorinit)
00205 call weight(iwtinit)
00206 c
00207 c Common variables:
00208 c ----------------
00209 c
00210 modex=modx
00211 modey=mody
00212 rlen=xlen
00213 slen=ylen
00214 c
00215 c Initialize parameters set by the fr*dr routines.
00216 c
00217 iconf=0
00218 scent=.5*slen
00219 c
00220 if (icolors(1).gt.0) call color(icolors(1))
00221 c
00222 c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
00223 c
00224 c Set axis, tick, and label info, then draw the axes and labels.
00225 c
00226 c The x-axis action is controlled by x1, x2, y1, y2, modex, mode, kax.
00227 c The y-axis action is controlled by x1, x2, y1, y2, modey, mode, lax.
00228 c
00229 c NOTE that both axes must be "set" first, and the fr*set routines
00230 c may modify x1, x2, y1, and y2.
00231 c
00232 c NOTE also that the fr*dr routines return global variables used
00233 c by the "labels" routine.
00234 c
00235 c Determine appropriate x tick spacings...
00236 c
00237 x1=xmin
00238 x2=xmax
00239 if (modex.gt.0) then
00240 call frlnset(x1,x2,xlen,modex,dxs,dxm,dxl,
00241 & labxsp,labxdp,lpowx)
00242 c
00243 c On return from frlnset,
00244 c
00245 c labxsp = total number of spaces for label
00246 c labxdp=-1 : integer format
00247 c labxdp.gt.0 : number of places to right of decimal point
00248 c lpowx.ne.0 : E format, otherwise F format
00249 c
00250 c (Same for y below...)
00251 c
00252 else
00253 call frlgset(x1,x2,xlen,modex,dxs,dxm,dxl)
00254 end if
00255 c
00256 c ...and set the x scaling in common /scales/.
00257 c
00258 xl=x1
00259 xr=x2
00260 dinchx=xlen/(xr-xl)
00261 c
00262 c Do the same for y.
00263 c
00264 y1=ymin
00265 y2=ymax
00266 if (modey.gt.0) then
00267 call frlnset(y1,y2,ylen,modey,dys,dym,dyl,
00268 & labysp,labydp,lpowy)
00269 else
00270 call frlgset(y1,y2,ylen,modey,dys,dym,dyl)
00271 end if
00272 c
00273 ybot=y1
00274 ytop=y2
00275 dinchy=ylen/(ytop-ybot)
00276 c
00277 c Draw axes, tick marks, labels.
00278 c -----------------------------
00279 c
00280
00281 c write(6,*)'iwts = ',iwts
00282 c write(6,*)'icolors = ',icolors
00283 c write(6,*)'mode, kax = ',mode,kax
00284
00285 if (mode.eq.0.and.kax.gt.0) then
00286 if (modex.gt.0) then
00287 call frlnxdr(y1,x1,x2,dxs,dxm,dxl,
00288 $ 1,1,labxsp,labxdp,lpowx)
00289 call frlnxdr(y2,x1,x2,dxs,dxm,dxl,
00290 $ 2,0,labxsp,labxdp,lpowx)
00291 else
00292 call frlgxdr(y1,x1,x2,dxs,dxm,dxl,1,1)
00293 call frlgxdr(y2,x1,x2,dxs,dxm,dxl,2,0)
00294 end if
00295 call labl(1,xctit)
00296 end if
00297 c
00298 if (mode.eq.0.and.lax.ge.0) then
00299 c
00300 c Numbers are always drawn horizontally.
00301 c
00302 irot=0
00303 c
00304 if (modey.gt.0) then
00305 call frlnydr(x1,y1,y2,dys,dym,dyl,
00306 $ 1,1,labysp,labydp,lpowy)
00307 call frlnydr(x2,y1,y2,dys,dym,dyl,
00308 $ 2,0,labysp,labydp,lpowy)
00309 else
00310 call frlgydr(x1,y1,y2,dys,dym,dyl,1,1)
00311 call frlgydr(x2,y1,y2,dys,dym,dyl,2,0)
00312 end if
00313 irot = irotsto
00314 call labl(2,yctit)
00315 end if
00316 c
00317 c-----------------------------------------------------------------------------
00318 c
00319 c Restore "true" settings (just in case).
00320 c
00321 htl = htlsto
00322 htn = htnsto
00323 call color(icolorinit)
00324 call weight(iwtinit)
00325 irot = irotsto
00326 c
00327 iframe=0
00328 c
00329 end
00330
00331
00332 subroutine labl(which,string)
00333 save
00334 integer which
00335 character*(*) string
00336 c
00337 common /frdraw/mode
00338 common /frbare/ibare
00339 common /frwts/iwts(4)
00340 common /frpens/icolors(3)
00341 c
00342 c Draw the x- or the y-label.
00343 c
00344 if (mode.eq.0.and.ibare.ne.1.and.iwts(4).ge.0) then
00345 c
00346 c Save current settings.
00347 c
00348 call getstatus(idum1,idum2,ipsto,iwsto)
00349 c
00350 if (iwts(4).gt.0) call weight(iwts(4))
00351 if (icolors(3).gt.0) call color(icolors(3))
00352 c
00353 if (which.eq.1) then
00354 call labels(string,' ')
00355 else
00356 call labels(' ',string)
00357 end if
00358 c
00359 c Restore settings.
00360 c
00361 call color(ipsto)
00362 call weight(iwsto)
00363 c
00364 end if
00365 c
00366 end
