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 plot(rin,sin,npin)
00021 save
00022 c **********
00023 c Move/draw lines on the output device. * PLOT *
00024 c **********
00025 c
00026 c NOTE: Very little of this is actually device/site-specific,
00027 c but we don't want to include any more subroutine calls than are
00028 c really necessary, as this is already a very low-level routine.
00029 c
00030 character*80 device
00031 c
00032 common /plot sizes/ xsize,ysize
00033 common /plot device/ device,aspect,idev
00034 common /framesize/ nxpix,nx0,xfac,nypix,ny0,yfac
00035 common /plain font/ wid
00036 common /plot origin/ ro,so
00037 common /last point/ rl,sl
00038 common /dev status/ idevon,idevpen,idevwt
00039 common /dev init/ init
00040 c
00041 c PostScript info:
00042 c ---------------
00043 c
00044 common /ps enforced/ ibounds,ps rmax,ps smax
00045 common /ps strokes/ nstroke,nstrpage,nstroketot
00046 common /ps bounding box/ ixleft,iybot,ixright,iytop
00047 c
00048 parameter (NSMAX = 100)
00049 c
00050 c SparcPrinter has problem with short lines:
00051 c -----------------------------------------
00052 c
00053 common /sparcbug/ isp
00054 parameter (SPARCTOL = 0.25)
00055 c
00056 c For use with idev = 1:
00057 c ---------------------
00058 c
00059 character*3 ich,jch
00060 c
00061 c This is for the benefit of NCAR:
00062 c -------------------------------
00063 c
00064 common /sysplt/ mmajx ,mmajy ,mminx ,mminy ,mxlab ,mylab ,
00065 & mflg ,mtype ,mxa ,mya ,mxb ,myb ,
00066 & mx ,my ,mtypex ,mtypey ,xxa ,yya ,
00067 & xxb ,yyb ,xxc ,yyc ,xxd ,yyd ,
00068 & xfactr ,yfactr ,xadd ,yadd ,xx ,yy ,
00069 & mfmtx(3) ,mfmty(3) ,mumx ,mumy ,
00070 & msizx ,msizy ,mxdec ,mydec ,mxor ,mop(19),
00071 & mname(19) ,mxold ,myold ,mxmax ,mymax ,
00072 & mxfac ,myfac ,modef ,mf2er ,mshftx ,mshfty ,
00073 & mmgrx ,mmgry ,mmnrx ,mmnry ,mfrend ,mfrlst ,
00074 & mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
00075 & mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
00076 & mxysto ,mprint ,msybuf(360) ,mncpw ,minst ,
00077 & mbufa ,mbuflu ,mfwa(12) ,mlwa(12) ,
00078 & mipair ,mbprs(16) ,mbufl ,munit ,small
00079 c
00080 c For the HP plotter:
00081 c ------------------
00082 c
00083 character*30 hpout
00084 common /pen posn/ npo
00085 common /mline on/ imline
00086 c
00087 c For the X interface:
00088 c
00089 external mcdxmove !$pragma C (mcdxmove)
00090 external mcdxdraw !$pragma C (mcdxdraw)
00091 c
00092 c For the Tektronix options:
00093 c -------------------------
00094 c
00095 character*1 ctrl(0:31),
00096 & null,ctrla,tab,lf,ff,cr,ctrlx,ctrlz,esc,gs,del
00097 common /ctrlch/ ctrl,
00098 & null,ctrla,tab,lf,ff,cr,ctrlx,ctrlz,esc,gs,del
00099 c
00100 character*1 vec(0:5),up(3),down(3)
00101 data up/' ','L','F'/down/' ','L','G'/
00102 c
00103 data ro/0./so/0./npo/3/rl,sl/0.,0./imline/0/
00104 c
00105 c-----------------------------------------------------------------------------
00106 c
00107 up(1) = esc
00108 down(1) = esc
00109 vec(0) = gs
00110 c
00111 if (init.eq.0) then
00112 init = -1
00113 call noclear
00114 call mcinit
00115 call devon
00116 call clear
00117 end if
00118 c
00119 r = rin
00120 s = sin
00121 npen = npin
00122 iloop = 0
00123 c
00124 10 np = abs(npen)
00125 if (idevon.eq.0) call devon
00126 c
00127 c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
00128 c
00129 if (idev.eq.15) then
00130 c
00131 c SunCore
00132 c -------
00133 c
00134 if (np.eq.2) then
00135 call lineabs2(r+ro,s+so)
00136 else
00137 call moveabs2(r+ro,s+so)
00138 end if
00139 go to 998
00140 c
00141 c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
00142 c
00143 else if (idev.eq.16) then
00144 c
00145 c PostScript
00146 c ----------
00147 c
00148 rr = min(ps rmax,max(0.,nx0+xfac*(r+ro)))
00149 ss = min(999.9,max(0.,ny0+yfac*(s+so)))
00150 if (ibounds.ne.0) ss = min(ps smax,ss)
00151 c
00152 if (np.eq.2) then
00153 c
00154 if (isp.ne.0) then
00155 c
00156 c The SparcPrinter can't draw short lines!
00157 c
00158 if (xfac*abs(r-rl) + yfac*abs(s-sl).lt.SPARCTOL)
00159 & write(42,30)rr,ss,'p'
00160 else
00161 write(42,30)rr,ss,'l'
00162 30 format(f7.3,f8.3,1x,a1,'%')
00163 c
00164 c NOTE: The trailing "%" is for identification purposes
00165 c when erasing output...
00166 c
00167 end if
00168 else if (np.eq.3) then
00169 write(42,30)rr,ss,'m'
00170 end if
00171 c
00172 c if (np.eq.2.or.ixleft.eq.10000) then
00173 if (np.eq.2) then
00174 irr = rr
00175 iss = ss
00176 ixleft = min(ixleft,irr)
00177 iybot = min(iybot,iss)
00178 ixright = max(ixright,irr+1)
00179 iytop = max(iytop,iss+1)
00180 end if
00181 c
00182 if (nstroke.ge.NSMAX) then
00183 call ps stroke
00184 write(42,30)rr,ss,'m'
00185 end if
00186 nstroke = nstroke+1
00187 nstrpage = nstrpage+1
00188 c
00189 c Only count "real" strokes in the total.
00190 c
00191 if (np.eq.2) nstroketot = nstroketot + 1
00192 go to 998
00193 c
00194 else if (idev.eq.17) then
00195 c
00196 c X
00197 c -
00198 c
00199 if (np.eq.2) then
00200 call mcdxdraw(r+ro,s+so)
00201 else
00202 call mcdxmove(r+ro,s+so)
00203 end if
00204 go to 998
00205 c
00206 c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
00207 c
00208 end if
00209 c
00210 c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
00211 c
00212 c Determine scalings for other devices
00213 c ------------------------------------
00214 c
00215 i = nx0+xfac*(r+ro)
00216 j = ny0+yfac*(s+so)
00217 if (idev.ne.2) then
00218 i = max(0,min(nxpix,i))
00219 j = max(0,min(nypix,j))
00220 end if
00221 if (idev.ge.7)go to 400
00222 go to (100,200,400,400,500,501), idev
00223 c
00224 c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
00225 c
00226 c Output to "plot file"
00227 c ---------------------
00228 c
00229 100 ip = npen
00230 if (ip.lt.0)ip = ip+3
00231 call reduce(i,ich)
00232 call reduce(j,jch)
00233 write(60,110)ip,ich,jch
00234 110 format(i1,2a3)
00235 go to 998
00236 c
00237 c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
00238 c
00239 c NCAR
00240 c ----
00241 c
00242 200 mx = max0(0,min0(i,32767))
00243 my = max0(0,min0(j,32767))
00244 ipen = 3-np
00245 minst = max0(0,min0(1,ipen))
00246 c
00247 call put42
00248 go to 998
00249 c
00250 c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
00251 c
00252 c Tektronix/Versaterm-PRO
00253 c -----------------------
00254 c
00255 400 if ((idev.eq.7.or.idev.eq.8.or.idev.eq.11.or.idev.eq.12)
00256 & .and.idevwt.gt.1) then
00257 i = i-idevwt/2
00258 j = j+idevwt/2
00259 end if
00260 c
00261 if (nxpix.gt.1023) then
00262 i4 = i/4
00263 ii = i-4*i4
00264 j4 = j/4
00265 jj = j-4*j4
00266 vec(2) = char(96+ii+4*jj)
00267 i = i4
00268 j = j4
00269 else
00270 vec(2) = '`'
00271 end if
00272 j32 = j/32
00273 vec(1) = char(32+j32)
00274 vec(3) = char(96+(j-32*j32))
00275 i32 = i/32
00276 vec(4) = char(32+i32)
00277 vec(5) = char(64+(i-32*i32))
00278 c
00279 c (These assignments are ok because none of the values are >127)
00280 c
00281 if (idev.lt.13) then
00282 if (np.eq.3) then
00283 call type string(vec(0),6)
00284 else
00285 call type string(vec(1),5)
00286 end if
00287 else
00288 if (np.eq.3) then
00289 call type string(up,3)
00290 else
00291 call type string(down,3)
00292 end if
00293 call type string(vec(1),5)
00294 end if
00295 go to 998
00296 c
00297 c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
00298 c
00299 c HP plotter
00300 c ----------
00301 c
00302 500 continue
00303 501 if (imline.eq.1.and.r.eq.rl.and.s.eq.sl.and.npen.eq.3)
00304 & go to 999
00305 c
00306 c (Quick fix for possible use of plotin in mline)
00307 c
00308 if (np.ne.npo) then
00309 if (np.eq.2) then
00310 write(hpout(1:3),510)'PD'
00311 510 format(a2,';')
00312 else
00313 write(hpout(1:3),510)'PU'
00314 end if
00315 iout = 3
00316 else
00317 iout = 0
00318 end if
00319 write(hpout(iout+1:iout+14),520)i,j
00320 520 format('PA',i5,',',i5,';')
00321 write(6,525)(hpout(k:k),k=1,14+iout)
00322 525 format(1x,30a1)
00323 c
00324 c-----------------------------------------------------------------------------
00325 c
00326 c End of routine -- clean up.
00327 c --------------------------
00328 c
00329 998 if (npen.lt.0) then
00330 ro = ro+r
00331 so = so+s
00332 rl = 0.
00333 sl = 0.
00334 call getlhe(rr)
00335 call setlhe(rr-r)
00336 call getbot(ss)
00337 call setbot(ss-s)
00338 else
00339 rl = r
00340 sl = s
00341 end if
00342 npo = np
00343 999 if (iloop.le.0) return
00344 go to 1000
00345 c
00346 c Variation -- combined move and draw.
00347 c
00348 entry segment(r1,s1,r2,s2)
00349 iloop = 1
00350 npen = 3
00351 r = r1
00352 s = s1
00353 go to 10
00354 c
00355 1000 iloop = iloop-1
00356 if (iloop.lt.0) return
00357 npen = 2
00358 r = r2
00359 s = s2
00360 go to 10
00361 c
00362 end
