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
