cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc cc Version 1.1 cc cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c penplot-like package. Produces Tektronix output. c c calls c c scale c initializes from parameters in scale.plt c window(xmin,ymin,xmax,ymax) c initializes, sets lower left and upper right corner, enters graphics mode c view(xvmin,yvmin,xvmax,yvmax) c sets viewport. Screen is 0,0,100,100 (default) c plot(x,y) c if pen is up, moves to new point (x,y), lowers pen c if pen is down, draws line to new point (x,y) c penup c raises pen c endplt c finishes plot (flushes buffer) c erase c erases screen c gmode c put into graphics mode c tmode c put into text mode c on an xterm window, puts focus back in vt102 window c readvar(fn,names,values,num) c reads a .var type of file named fn c returns real values for each of the variables 1..num named c in the names array. c readvara(fn,names,valuesa,num) c same but returns ascii character*20 strings instead c c subroutine readvar(fn,names,values,num) character*(*) fn character*20 names(150) real values(150) character*80 st open(unit=1,file=fn(1:lnblnk(fn)),status='old') 100 read(1,1,end=999)st 1 format(a) if(index(st,'#').gt.1)then st=st(1:index(st,'#')-1) else if(index(st,'#').eq.1)then goto 100 endif j=index(st,'=') if(j.eq.0)goto 100 do 10 i=1,num if(st(1:j-1).eq.names(i))read(st(j+1:lnblnk(st)),*)values(i) 10 continue goto 100 999 close(1) return end subroutine readvara(fn,names,values,num) character*(*) fn character*20 names(150),values(150) character*80 st open(unit=1,file=fn(1:lnblnk(fn)),status='old') 100 read(1,1,end=999)st 1 format(a) if(index(st,'#').gt.1)then st=st(1:index(st,'#')-1) else if(index(st,'#').eq.1)then goto 100 endif j=index(st,'=') if(j.eq.0)goto 100 do 10 i=1,num if(st(1:j-1).eq.names(i))values(i)=st(j+1:lnblnk(st)) 10 continue goto 100 999 close(1) return end subroutine tekmode include 'penplot.com' if(xtermfl.eq.-1)then xtermfl=1 call pointqq(27) call pointqq(91) call pointqq(63) call pointqq(51) call pointqq(56) call pointqq(104) endif return end subroutine tmode include 'penplot.com' call pointqq(31) if (xtermfl.eq.1)then call pointqq(27) call pointqq(3) xtermfl=-1 endif return end subroutine gmode include 'penplot.com' call tekmode call pointqq(29) return end block data include 'penplot.com' data xv0,yv0,xv1,yv1/0.0,0.0,100.0,100.0/ data x0,y0,x1,y1/0.0,0.0,1.0,1.0/ data ax,bx,ay,by/0.01,0.0,0.01,0.0/ data p9,hy0,ly0,llx0,lly0,hx0,lx0/0,-1,-1,-1,-1,-1,-1/ data xtermfl/0/ end subroutine view(xva,yva,xvb,yvb) character*20 envval include 'penplot.com' call getenv('TERM',envval) if(envval.eq.'xterm')then xtermfl= -1 else xtermfl = 0 endif c write(*,*)'xtermfl',xtermfl call tekmode call pointqq(29) xv0=xva yv0=yva xv1=xvb yv1=yvb ax=(xv1-xv0)/(x1-x0) bx=-ax*x0+xv0 ay=(yv1-yv0)/(y1-y0) by=-ay*y0+yv0 p9=0 hx0=-1 hy0=-1 lx0=-1 ly0=-1 return end subroutine window(xa,ya,xb,yb) character*20 envval include 'penplot.com' call getenv('TERM',envval) if(envval.eq.'xterm')then xtermfl= -1 else xtermfl = 0 endif c write(*,*)'xtermfl',xtermfl call tekmode call pointqq(29) x0=xa y0=ya x1=xb y1=yb ax=(xv1-xv0)/(x1-x0) bx=-ax*x0+xv0 ay=(yv1-yv0)/(y1-y0) by=-ay*y0+yv0 p9=0 hx0=-1 hy0=-1 lx0=-1 ly0=-1 return end subroutine endplt include 'penplot.com' call pointqq(31) c write(*,*)'after leadout' call tmode c write(*,*)'after tsend' return end subroutine penup include 'penplot.com' call pointqq(29) P9=0 return end subroutine erase include 'penplot.com' call pointqq(31) call pointqq(27) call pointqq(12) call pointqq(29) call cflush(6) p9=0 return end subroutine plot(x,y) include 'penplot.com' integer hx,hy,lx,ly,llx,lly xp=ax*x+bx yp=ay*y+by if(xp.lt.xv0-0.001 .or. xp.gt.xv1+0.001 .or. $ yp.lt.yv0-0.001 .or. yp.gt.yv1+0.001)then call penup return endif ix=xp*40.95+.4999999 iy=yp*31.19+.4999999 hy=iy/128 lly=iy-128*hy ly=lly/4 lly=lly-4*ly hx=ix/128 llx=ix-128*hx lx=llx/4 llx=llx-4*lx i=0 if(hy.ne.hy0)then i=i+1 call pointqq(hy+32) endif if(lly.ne.lly0 .or .llx.ne.llx0)then i=i+1 call pointqq(96+4*lly+llx) i=i+1 call pointqq(ly+96) elseif(ly.ne.ly0 .or. hx.ne.hx0)then i=i+1 call pointqq(ly+96) endif if(hx.ne.hx0)then i=i+1 call pointqq(hx+32) endif i=i+1 call pointqq(lx+64) hy0=hy ly0=ly hx0=hx lx0=lx lly0=lly llx0=llx return end subroutine plota(xp,yp) include 'penplot.com' integer hx,hy,lx,ly,llx,lly if(xp.lt.0.0 .or. xp.gt.100.0 .or. $ yp.lt.0.0 .or. yp.gt. 100.0)then call penup return endif ix=xp*40.95+.4999999 iy=yp*31.19+.4999999 hy=iy/128 lly=iy-128*hy ly=lly/4 lly=lly-4*ly hx=ix/128 llx=ix-128*hx lx=llx/4 llx=llx-4*lx i=0 if(hy.ne.hy0)then i=i+1 call pointqq(hy+32) endif if(lly.ne.lly0 .or .llx.ne.llx0)then i=i+1 call pointqq(96+4*lly+llx) i=i+1 call pointqq(ly+96) elseif(ly.ne.ly0 .or. hx.ne.hx0)then i=i+1 call pointqq(ly+96) endif if(hx.ne.hx0)then i=i+1 call pointqq(hx+32) endif i=i+1 call pointqq(lx+64) hy0=hy ly0=ly hx0=hx lx0=lx lly0=lly llx0=llx return end subroutine scale character*20 envval include 'penplot.com' character*20 names(8) data names/'xvmin','yvmin','xvmax','yvmax', $ 'xmin','ymin','xmax','ymax'/ call getenv('TERM',envval) if(envval.eq.'xterm')then xtermfl= -1 else xtermfl = 0 endif c write(*,*)'xtermfl',xtermfl call tekmode call pointqq(29) call readvar('plot.var',names,xv0,8) c relies on order in penplot.com and names above. c call tmode c write(*,*)xv0,yv0,xv1,yv1,x0,y0,x1,y1 c call tekmode ax=(xv1-xv0)/(x1-x0) bx=-ax*x0+xv0 ay=(yv1-yv0)/(y1-y0) by=-ay*y0+yv0 p9=0 hx0=-1 hy0=-1 lx0=-1 ly0=-1 return end