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 addition of terminal identification,colour and line types on C regis terminals,device names & controlled abort flag C C 3-Mar-88 by E Grigolato C Boyne Smelters Ltd C Gladstone, Qld. 4680 C Australia 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 C HP and TT contain the device numbers for the terminal and the plotter integer hp,tt common /HPTTNO/hp,tt 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.00001)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(hp,1000) 1000 format('XT;') 100 continue 150 call jump(xx,ymin) call draw(xx,ymax) if(yunit.lt.0.00001)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(hp,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.00001)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.00001)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 C HP and TT contain the device numbers for the terminal and the plotter integer hp,tt common /HPTTNO/hp,tt 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(hp,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 write(tt,5000)EPp,Ebsl 5000 format('+',3a1,'T(S1,D0,S1)',2a1) goto 999 510 write(tt,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 C HP and TT contain the device numbers for the terminal and the plotter integer hp,tt common /HPTTNO/hp,tt 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(hp,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 C HP and TT contain the device numbers for the terminal and the plotter integer hp,tt common /HPTTNO/hp,tt real*8 plotter real*4 sclx1,sclx2,scly1,scly2 common/plotid/plotter,sclx1,sclx2,scly1,scly2 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' t1=xx*sclx1+sclx2 t2=yy*scly1+scly2 write(hp,1000) t1,t2 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. write(tt,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 C HP and TT contain the device numbers for the terminal and the plotter integer hp,tt common /HPTTNO/hp,tt 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 C HP and TT contain the device numbers for the terminal and the plotter integer hp,tt common /HPTTNO/hp,tt common /zzhv/hv,plonsw byte hv,plonsw if(hv)goto 500 10 if(.not.plonsw)goto 999 write(hp,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 C HP and TT contain the device numbers for the terminal and the plotter integer hp,tt common /HPTTNO/hp,tt real*8 plotter real*4 sclx1,sclx2,scly1,scly2 common/plotid/plotter,sclx1,sclx2,scly1,scly2 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' t1=xx*sclx1+sclx2 t2=yy*scly1+scly2 write(hp,1000) t1,t2 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. write(tt,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 C HP and TT contain the device numbers for the terminal and the plotter integer hp,tt common /HPTTNO/hp,tt 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(hp,1000) (string(i),i=1,l),etx 1000 format('LB',100A1) goto 999 c*** To output a text string at current position. 500 n=len(string) write(tt,5000)EPp,post,(string(i),i=1,n),post 5000 format('+',3a1,'T',100A1) write(tt,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 C HP and TT contain the device numbers for the terminal and the plotter integer hp,tt common /HPTTNO/hp,tt 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(hp,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 C HP and TT contain the device numbers for the terminal and the plotter integer hp,tt common /HPTTNO/hp,tt 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(hp,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 C HP and TT contain the device numbers for the terminal and the plotter integer hp,tt common /HPTTNO/hp,tt 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! write(tt,5000)EPp,Ebsl 5000 format('+',3a1,'T[9,0](M[1,2],D0,S[9,16])',2a1) write(tt,5010)EPp,Ebsl 5010 format('+',3a1,'T(S1,D0,S1)',2a1) call label(string) goto 999 510 write(tt,5020)EPp,Ebsl 5020 format('+',3a1,'T[0,-16](M[2,1],D90,S[16,10])',2a1) call label(string) write(tt,5010)EPp,Ebsl 999 return end c****** To put the pen down at current location. A rewind is again done. Subroutine PENDN() !PENDN C HP and TT contain the device numbers for the terminal and the plotter integer hp,tt common /HPTTNO/hp,tt common /zzhv/hv,plonsw byte hv,plonsw if(hv)goto 500 10 if(.not.plonsw)goto 999 write(hp,1000) 1000 format('PD;') rewind hp 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 C HP and TT contain the device numbers for the terminal and the plotter integer hp,tt common /HPTTNO/hp,tt common /zzhv/hv,plonsw byte hv,plonsw if(hv)goto 500 10 if(.not.plonsw)goto 999 write(hp,1000) 1000 format('PU;') rewind hp goto 999 c*** For VT125 500 continue 999 return end c****** To plot a point at a specified location. Subroutine POINT(xx,yy) !POINT C HP and TT contain the device numbers for the terminal and the plotter integer hp,tt common /HPTTNO/hp,tt 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. write(tt,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 C HP and TT contain the device numbers for the terminal and the plotter integer hp,tt common /HPTTNO/hp,tt 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(hp,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) write(tt,5000)EPp,(string(i),i=1,l) 5000 format('+',3a1,,80a1) write(tt,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 C HP and TT contain the device numbers for the terminal and the plotter integer hp,tt common /HPTTNO/hp,tt common /zzhv/hv,plonsw byte hv,plonsw if(hv)goto 500 10 if(.not.plonsw)goto 999 if(w.eq.0)goto 100 write(hp,1000) w,h 1000 format('SI ',2f10.3,';') goto 999 100 write(hp,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 C HP and TT contain the device numbers for the terminal and the plotter integer hp,tt common /HPTTNO/hp,tt 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 write(tt,5000)EPp,ics,Ebsl 5000 format('+',3a1,'T(S',I2,')',2a1) call label(string) 999 return end c****** To print a string AT THE BOTTOM OF THE SCREEN Subroutine STATUS !STATUS LINE C HP and TT contain the device numbers for the terminal and the plotter integer hp,tt common /HPTTNO/hp,tt 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 logical*1 output(82) if(hv)goto 500 GOTO 999 c*** clear status line and set cursor to start of line 500 ics=1 write(tt,4000)27 4000 format('+',a1,'[24;1f') call repeat(' ',output,80) write(tt,6000)(output(i),i=1,80) 6000 format('+',80a1,$) write(tt,2000)EPp,Ebsl 2000 format('+',3a1,'P[0,460];',2a1) C now print your string using standard fortran with a format statement C of the form format('+',......,$) goto 999 999 return end c****** To plot a symbol at a specified location. Subroutine symbol(xx,yy,no) !symbol no=symbol type C HP and TT contain the device numbers for the terminal and the plotter integer hp,tt common /HPTTNO/hp,tt common /zzhv/hv,plonsw byte hv,plonsw real*8 plotter real*4 sclx1,sclx2,scly1,scly2 common/plotid/plotter,sclx1,sclx2,scly1,scly2 common /zzhpb/etx,si,so,esc,EPp(3),Ebsl(2),dum byte etx,si,so,esc,EPp,Ebsl,dum logical*1 SYM(10),blk data blk/' '/ integer*2 no,NO1 c c these symbols will work on all plotters,centred symbols from c character set 5 can cause some difficulties c NO1=NO if ((no1.lt.1).or.(no1.gt.8))no1=mod(no1,8) if (no1.eq.0)no1=8 if(hv)goto 500 10 if(.not.plonsw)goto 999 CALL SCOPY(' o+x*yQ#',SYM) call jump(xx,yy) call pendn call penup IF (no1.eq.1)goto 999 call setsm(sym(no1)) t1=xx*sclx1+sclx2 t2=yy*scly1+scly2 write(hp,20)t1,t2 20 FORMAT('PA ',2f10.3,';') call setsm(blk) goto 999 c*** For VT125 500 call jump(xx,yy) !Move to location. write(tt,5000)EPp,Ebsl 5000 format('+',3a1,'V[]',2a1) !Plot point. goto (999,600,700,800,900,920,940,960),no1 return C symbol=circle 600 write(tt,610)EPp,Ebsl 610 format('+',3a1,'C[+5]',2a1) !Plot circle. return C symbol=PLUS SIGN 700 write(tt,710)EPp,Ebsl !Plot PLUS SIGN 710 format('+',3a1,'P[,+5]V[,-10]P[-5,+5]V[+11]P[-6,]',2a1) return C symbol=X sign 800 write(tt,810)EPp,Ebsl !Plot multiply SIGN 810 format('+',3a1, 1 'P[-5,-5]V[+5,+5]P[+5,+5]V[-5,-5]P[+5,-5]', 2 'V[-5,+5]P[-5,+5]V[+5,-5]',2a1) return C symbol=asterik 900 write(tt,910)EPp,Ebsl !Plot asterik SIGN 910 format('+',3a1, 1 'P[-5,-5]V[+5,+5]P[+5,+5]V[-5,-5]P[+5,-5]', 2 'V[-5,+5]P[-5,+5]V[+5,-5]', 3 'P[-7,]V[+7,]V[+7,]P[-7,]',2a1) return C symbol=Y sign 920 write(tt,930)EPp,Ebsl !Plot Y SIGN 930 format('+',3a1, 1 'P[-5,-5]V[+5,+5]P[+5,-5]V[-5,+5]V[,+5]P[,-5]',2a1) return C SYMBOL=Q SIGN 940 write(tt,950)EPp,Ebsl 950 format('+',3a1,'C[+5]V[+5,+5]P[-5,-5]',2a1) !Plot Q return C symbol=# sign 960 write(tt,970)EPp,Ebsl 970 format('+',3a1,'P[-5,-2]V[+10,]P[-10,+4]V[+10,]P[-3,+3]', 1 'V[,-10]P[-4,+10]V[,-10]P[-2,+5]',2a1) !Plot # SIGN return C not used in standard library,can be used if centred characters C are available in the hardware C symbol=square 980 write(tt,990)EPp,Ebsl !Plot square 990 format('+',3a1, 1 'P[-5,-5]V[+10,]V[,+10]V[-10,]V[,-10]P[+5,+5]',2a1) return C symbol=DIAMOND 1000 write(tt,1010)EPp,Ebsl !Plot diamond 1010 format('+',3a1, 1 'P[+5,]V[-5,+5]V[-5,-5],V[+5,-5]V[+5,+5]P[-5,]',2a1) 999 return end