c HVPLOT Part I c c Basic Subroutines for HVPLOT c c Dr R N Caffin and S L Hewett c CSIRO Div of Textile Physics c 338 Blaxland Rd c Ryde N S W 2112 c Australia c c 21-Sep-84 c c c Note regarding VT125 Subroutines c c Note that the pair (xx,yy) is used for user coordinate space, while c the pair (x,y) is used for the absolute VT125 space. Thus some basic c routines contain a call to SCL for conversion, while others work at c the user level. c****** To draw the coordinate axis for a graph and mark the scales c at the spacing specified by xunit and yunit. Subroutine AXIS(xx,yy,xunit,yunit) !AXIS common /zzhv/hv,plonsw byte hv,plonsw common /zzhpf/xmin,xmax,ymin,ymax common /zzvf/xminv,xmaxv,yminv,ymaxv common /zzhpb/etx,si,so,esc,EPp(3),Ebsl(2),dum byte etx,si,so,esc,EPp,Ebsl,dum if(hv)goto 500 10 if(.not.plonsw)goto 999 call jump(xmin,yy) call draw(xmax,yy) if(xunit.lt.0.001)goto 150 50 do 100 i=ifix(xmin/xunit),ifix(xmax/xunit) xt=i*xunit if(xt.le.xmin)goto 100 !Skip left end if(xt.eq.xx)goto 100 !Skip origin if(xt.ge.xmax)goto 100 !Skip right end call jump(xt,yy) write(9,1000) 1000 format('XT;') 100 continue 150 call jump(xx,ymin) call draw(xx,ymax) if(yunit.lt.0.001)goto 250 do 200 i=ifix(ymin/yunit),ifix(ymax/yunit) yt=i*yunit if(yt.le.ymin)goto 200 !Skip bottom end if(yt.eq.yy)goto 200 !Skip origin if(yt.ge.ymax)goto 200 !Skip top end call jump(xx,yt) write(9,1010) 1010 format('YT;') 200 continue 250 call jump(xx,yy) goto 999 c*** For the VT125 500 call jump(xminv,yy) call draw(xmaxv,yy) if(xunit.lt.0.001)goto 650 550 do 600 i=ifix(xminv/xunit)+1,ifix(xmaxv/xunit) call jump(i*xunit,yy) call atick(.true.) 600 continue 650 call jump(xx,yminv) call draw(xx,ymaxv) if(yunit.lt.0.001)goto 750 do 700 i=ifix(yminv/yunit)+1,ifix(ymaxv/yunit) call jump(xx,i*yunit) call atick(.false.) 700 continue 750 call jump(xx,yy) 999 return end c****** To specify the absolute direction in which characters are to c be lettered,the angle in degrees relative to the x direction c to be specified. Subroutine DIR(degree) !DIR common /zzhv/hv,plonsw byte hv,plonsw common /zzhpb/etx,si,so,esc,EPp(3),Ebsl(2),dum byte etx,si,so,esc,EPp,Ebsl,dum if(hv)goto 500 10 if(.not.plonsw)goto 999 pi=3.1412 theta=((degree/180.)*pi) run=cos(theta) rise=sin(theta) write(9,1000)run,rise 1000 format('DI ',2f7.4,';') goto 999 c*** Character tilt, only only multiples of 45 degrees c supported by the VT125. Only 0 and 90 degree are catered c for at the moment since varying character size is not 500 If(ifix(degree).eq.90)goto 510 type 5000,EPp,Ebsl 5000 format('+',3a1,'T(S1,D0,S1)',2a1) goto 999 510 type 5010,EPp,Ebsl 5010 format('+',3a1,'T(D90,S[16,10])',2a1) 999 return end c****** To specify the relative direction in which characters are to c be lettered,the angle in degrees relative to the P1,P2 settings. Subroutine DIRREL(degree) !DIRREL common /zzhv/hv,plonsw byte hv,plonsw if(hv)goto 500 10 if(.not.plonsw)goto 999 pi=3.1412 theta=((degree/180.)*pi) run=cos(theta) rise=sin(theta) write(9,1000)run,rise 1000 format('DR ',2f7.4,';') goto 999 c*** Variable direction lettering is not yet supported: incoherent VT125 c documentation is at least partly to blame. 500 continue 999 return end c****** To draw a line from current position to new location. Subroutine DRAW(xx,yy) !DRAW common /zzhv/hv,plonsw,flh,flv,flsh,flsv byte hv,plonsw,flh,flv,flsh,flsv common /zzhpb/etx,si,so,esc,EPp(3),Ebsl(2),dum byte etx,si,so,esc,EPp,Ebsl,dum if(hv)goto 500 10 if(.not.plonsw)goto 999 if(.not.(flh.and.flsh))stop 'Call INIT and SCALE first' write(9,1000) xx,yy 1000 format('PD ',2f10.3,';') goto 999 c*** See note at top for definition of xx,yy 500 call scl(xx,yy,x,y) !Scale to screen units. type 5000,EPp,x,y,Ebsl 5000 format('+',3a1,'V[',F10.3,',',F10.3,']',2a1) 999 return end c****** To send pen head to corner position for maximum view of plot and c and restore pen to holder. Also force buffer dump via rewind. Subroutine HOME !HOME common /zzhv/hv,plonsw byte hv,plonsw common /zzhpf/xmin,xmax,ymin,ymax common /zzvf/xminv,xmaxv,yminv,ymaxv if(hv)goto 500 10 if(.not.plonsw)goto 999 call setsm(' ') call select(0) call jump(xmin,ymin) goto 999 c*** To put the cursor in the top corner. 500 call jump(xminv,yminv) 999 return end c****** To jump a character size reference distance. c Note that a caps character is actually 0.5 units high. Subroutine JMPCH(xx,yy) !JMPCH common /zzhv/hv,plonsw byte hv,plonsw if(hv)goto 500 10 if(.not.plonsw)goto 999 write(9,1000) xx,yy 1000 format('CP ',2f10.3,';') goto 999 c*** Dummy jmpch for VT125 500 continue 999 return end c****** To move the pen to a new location without drawing. Subroutine JUMP(xx,yy) !JUMP common /zzhv/hv,plonsw,flh,flv,flsh,flsv byte hv,plonsw,flh,flv,flsh,flsv common /zzhpb/etx,si,so,esc,EPp(3),Ebsl(2),dum byte etx,si,so,esc,EPp,Ebsl,dum if(hv)goto 500 10 if(.not.plonsw)goto 999 if(.not.(flh.and.flsh))stop 'Call INIT and SCALE first' write(9,1000) xx,yy 1000 format('PU ',2f10.3,';') goto 999 c*** To move the cursor to a new position. 500 call scl(xx,yy,x,y) !Scale to screen units. type 5000,EPp,x,y,Ebsl 5000 format('+',3a1,'P[',F10.3,',',F10.3,']',2a1) 999 return end c****** To output a text string at the current position. The character set, c direction,size,slant must be predefined if default values are not c required. Subroutine LABEL(string) !LABEL common /zzhv/hv,plonsw byte hv,plonsw common /zzhpb/etx,si,so,esc,EPp(3),Ebsl(2),dum byte etx,si,so,esc,EPp,Ebsl,dum byte string(1) byte post,spare data post/"042/ if(hv)goto 500 10 if(.not.plonsw)goto 999 l=len(string) write(9,1000) (string(i),i=1,l),etx 1000 format('LB',80A1) goto 999 c*** To output a text string at current position. 500 n=len(string) type 5000,EPp,post,(string(i),i=1,n),post 5000 format('+',3a1,'T',80A1) type 5010,Ebsl 5010 format('+',2a1) 999 return end c****** To send one character from the second character set.The character set, c direction,size,slant must be predefined if default values are not c required. Subroutine LABELA(char) !LABELA common /zzhv/hv,plonsw byte hv,plonsw common /zzhpb/etx,si,so,esc,EPp(3),Ebsl(2),dum byte etx,si,so,esc,EPp,Ebsl,dum byte char if(hv)goto 500 10 if(.not.plonsw)goto 999 write(9,1000) so,char,si,etx 1000 format('LB',4A1) goto 999 c*** Alternate character sets are not yet supported for VT125: try c ordinary VT100 writing (I think - documentation!@#). 500 continue 999 return end c****** To print an integer number at the current location. The c character set, direction,size,slant must be predefined if default c values are not required. Subroutine LABELN(n) !LABELN common /zzhv/hv,plonsw byte hv,plonsw common /zzhpb/etx,si,so,esc,EPp(3),Ebsl(2),dum byte etx,si,so,esc,EPp,Ebsl,dum byte s(6) if(hv)goto 500 10 if(.not.plonsw)goto 999 encode(6,1010,s) n !Encode number 1010 format(I6) do 100 i=1,5 !Won't be > 5 shifts if(s(1).gt."40)goto 200 !Look for non-space first char do 80 j=1,5 !Not yet, so 80 s(j)=s(j+1) ! left shift string 1 place 100 s(6)=2 !Jam no-op character at end 200 write(9,1000) s,etx !Now write out left-aligned 1000 format('LB',6A1,A1) ! string, followed by no-ops goto 999 c*** Put an integer label on a tick mark. Assume user can position c string properly on X or Y axis for the present. 500 encode(6,5010,s) n !Encode number 5010 format(I6) do 520 i=1,5 !Won't be > 5 shifts if(s(1).gt."40)goto 530 !Look for non-space first char do 510 j=1,5 !Not yet, so 510 s(j)=s(j+1) ! left shift string 1 place 520 s(6)=0 !Jam null character at end 530 call label(s) !Now bung out the string 999 return end c*******To label x or y axis Subroutine LABEXY(xx,yy,scale,degree,string) !LABEXY common /zzhv/hv,plonsw byte hv,plonsw common /zzhpb/etx,si,so,esc,EPp(3),Ebsl(2),dum byte etx,si,so,esc,EPp,Ebsl,dum if(hv)goto 500 10 if(.not.plonsw)goto 999 call jump(xx,yy) if(xx.eq.0.)call jmpch(-2.,0.) if(yy.eq.0.)call jmpch(0.,-1.) call size(scale,1.5*scale) call dir(degree) call label(string) goto 999 c*** For VT125 500 call jump(xx,yy) if(xx.eq.0.)call pick(4,18) !Pixel units if(yy.eq.0.)call pick(6,4) idegre=degree if(idegre.gt.45.)goto 510 ! <45 = 0 ; >45 = 90 so there! type 5000,EPp,Ebsl 5000 format('+',3a1,'T[9,0](M[1,2],D0,S[9,16])',2a1) type 5010,EPp,Ebsl 5010 format('+',3a1,'T(S1,D0,S1)',2a1) call label(string) goto 999 510 type 5020,EPp,Ebsl 5020 format('+',3a1,'T[0,-16](M[2,1],D90,S[16,10])',2a1) call label(string) type 5010,EPp,Ebsl 999 return end c****** To put the pen down at current location. A rewind is again done. Subroutine PENDN() !PENDN common /zzhv/hv,plonsw byte hv,plonsw if(hv)goto 500 10 if(.not.plonsw)goto 999 write(9,1000) 1000 format('PD;') rewind 9 goto 999 c*** No-op routines for pen control. 500 continue 999 return end c****** To lift the pen remaining at current location c This also forces a rewind or a buffer dump to ensure the plot c buffer is actually output to the plotter. c Subroutine PENUP() !PENUP common /zzhv/hv,plonsw byte hv,plonsw if(hv)goto 500 10 if(.not.plonsw)goto 999 write(9,1000) 1000 format('PU;') rewind 9 goto 999 c*** For VT125 500 continue 999 return end c****** To plot a point at a specified location. Subroutine POINT(xx,yy) !POINT common /zzhv/hv,plonsw byte hv,plonsw common /zzhpb/etx,si,so,esc,EPp(3),Ebsl(2),dum byte etx,si,so,esc,EPp,Ebsl,dum if(hv)goto 500 10 if(.not.plonsw)goto 999 call jump(xx,yy) call pendn call penup goto 999 c*** For VT125 500 call jump(xx,yy) !Move to location. type 5000,EPp,Ebsl 5000 format('+',3a1,'V[]',2a1) !Plot point. 999 return end c****** To send an arbitrary string of characters to the plotter, to handle c any unforseen situations Subroutine SEND(string) !SEND common /zzhv/hv,plonsw byte hv,plonsw common /zzhpb/etx,si,so,esc,EPp(3),Ebsl(2),dum byte etx,si,so,esc,EPp,Ebsl,dum byte string(1) if(hv)goto 500 10 if(.not.plonsw)goto 999 l=len(string) write(9,1000)(string(i),i=1,l) 1000 format(80a1) goto 999 c*** To send an arbitrary string of characters to the VT125 to handle c any unforseen situations 500 l=len(string) type 5000,EPp,(string(i),i=1,l) 5000 format('+',3a1,,80a1) type 5010,Ebsl 5010 format('+',2a1) 999 return end c****** To set the absolute character size, parameters w (width), h (height) c in centimeters. Subroutine SIZE(w,h) !SIZE common /zzhv/hv,plonsw byte hv,plonsw if(hv)goto 500 10 if(.not.plonsw)goto 999 if(w.eq.0)goto 100 write(9,1000) w,h 1000 format('SI ',2f10.3,';') goto 999 100 write(9,1010) 1010 format('SI;') goto 999 c*** Variable character size not yet supported. 500 continue 999 return end c****** To print a string specifying location, size and angle. Subroutine TEXT(xx,yy,scale,degree,string) !TEXT common /zzhv/hv,plonsw byte hv,plonsw common /zzhpb/etx,si,so,esc,EPp(3),Ebsl(2),dum byte etx,si,so,esc,EPp,Ebsl,dum if(hv)goto 500 10 if(.not.plonsw)goto 999 pi=3.1412 call jump(xx,yy) call size(scale,1.5*scale) call dir(degree) call label(string) goto 999 c*** Draw a text string: different from simply writing c Don't try 90 degrees c scale ignored if not between 0 and 15 500 call jump(xx,yy) ics=scale if(ics.gt.16.or.ics.lt.0)ics=1 type 5000,EPp,ics,Ebsl 5000 format('+',3a1,'T(S',I2,')',2a1) call label(string) 999 return end