	subroutine prnt_on
c
c Turn Auto-print on
c
	byte esc
	data esc/27/
c
	type 2,esc
2	format(1x,a1,'[?5i')
	return
	end
	subroutine prnt_off
c
c Turn Auto-print off
c
	byte esc
	data esc/27/
c
	type 2,esc
2	format(1x,a1,'[?4i')
	return
	end
	subroutine count(time)
C
C ROUTINE TO INITIATE A COUNT OF 'TIME' SECONDS
C
	include 'newdif.inc'
c
	itime=1000.0*time+0.5
	dif_lock=1
	write(ioutchn,2)itime
2	format('T',i7)
	call outformat
	dif_lock=0
	return
	end
	subroutine reformat
c
c Routine to reformat an output string
c
	include 'newdif.inc'
	character*80 lastchr
	common /last/lastchr,alph,nchar
	byte ctrlg,cr,alph(81)
	data ctrlg/7/,cr/13/
c
	lastchr=ioutchn
	alph(1)=ctrlg
	read(ioutchn,2)(alph(i),i=2,40)
2	format(80a1)
c strip trailing blanks
	do i=40,1,-1
	  if(alph(i).ne.' ')go to 100
	enddo
	i=1
100	alph(i+1)=cr
	nchar=i+1
	return
	end
	subroutine outformat
c
c Routine to reformat an output string and call the output routines
c
	include 'newdif.inc'
	character*80 lastchr
	common /last/lastchr,alph,nchar
	byte alph(81)
c
	call reformat
	call outstring(alph,nchar)
	return
	end
	subroutine informat(ival,iflg)
C
C Routine to reformat a request for information and get reply
c
	include 'trmprg.inc'
	include 'newdif.inc'
	character*80 lastchr
	common /last/lastchr,alph,nchar
	byte alph(81),outch
	dimension ival(10)
	character*80 chbuf
c
	call reformat
	outch=alph(2)
	call instring(alph,nchar)
	if(nchar.eq.0)then
c PDP-11 did not respond
	  iflg=1
	  return
	endif
	iflg=0
c Special Handling for 'are-you-alive' check
	if(outch.eq.'@')return
c
c add commas to end of buffer
c
	do i=nchar+1,nchar+12
	  alph(i)=','
	enddo
	write(chbuf,2)(alph(i),i=1,nchar+12)
2	format(80a1)
	read(chbuf,4,err=1000)ival
4	format(10i10)
	return
1000	do i=1,10
	  ival(i)=0
	enddo
c	type 6,lastchr,chbuf
6	format(' Error in INFORMAT Buffer, Last Request:',a
	1/' Data:',a)
	return
c	call exit
	end
	subroutine do_drive(i,xp,degpm)
c
c comment to transmit drive command to PDP-11
c
	include 'newdif.inc'
c calculate number of steps needed for drive
	ifp=stpdg(i)*xp
c calculate speed parameter
	if(degpm.le.0.0)then
	  isp=0
	else
	  isp=60000.0/(degpm*stpdg(i))
	endif
	dif_lock=1
	write(ioutchn,2,err=1000)i,ifp,isp
2	format('D',i1,2(',',i8))
	call outformat
	dif_lock=0
	return
1000	type 4,i,ifp,isp
4	format(' Error formatting DRIVE, Parameters:',3i15)
	return
	end
        options /extend
	SUBROUTINE GETEXP(TIME)
C
C ROUTINE TO GET CRYSTAL EXPOSURE TIME
C
	include 'newdif.inc'
	dimension itime(10)
	dif_lock=1
	write(ioutchn,2)
2	format('R0')
	call informat(itime,iflg)
	if(iflg.ne.0)write(*,*)'Diffractometer Failed to Respond in GETEXP'
	dif_lock=0
	time=itime(1)*0.001
	RETURN
	END
	options /extend
	FUNCTION ISTATS
C
C ROUTINE TO RETURN STATUS OF INTERFACE
C
C	VALUE	INTERPRETATION
C
C	0	NOTHING BUSY
C	1	1 OR MORE MOTORS DRIVING
C	2	SCALER RUNNING
C	3	MOTORS AND SCALER BUSY
C      -1	LIMIT
C
	include 'newdif.inc'
	dimension inval(10)
c
	dif_lock=1
	write(ioutchn,2)
2	format('S')
	call informat(inval,iflg)
	if(iflg.ne.0)write(*,*)'Diffractometer Failed to Respond in ISTATS'
	dif_lock=0
	istats=0
	if(inval(3).ne.0)istats=1
	if(inval(2).ne.0)istats=istats.or.2
	if(inval(1).ne.0)istats=-1
	RETURN
	END
	subroutine ldmtr(i,x)
C
C ROUTINE TO LOAD A MOTOR POSITION
C
	include 'newdif.inc'
c
	nstp=stpdg(i)*x
	dif_lock=1
	write(ioutchn,2)i,nstp
2	format('L',i1,',',i7)
	call outformat
	dif_lock=0
	return
	end
	subroutine ofattn
C
C ROUTINE TO DEACTIVATE THE ATTENUATOR
C
	include 'newdif.inc'
c
	idvmsk=7
	go to 1000
c
	entry ofbeam
C
C ROUTINE TO CLOSE SHUTTER - TURN BEAM OFF
C
	idvmsk=5
	go to 1000
c
	entry ofchrt
C
C ROUTINE TO TURN OFF CHART
C
	idvmsk=6
	go to 1000
c
	entry oftest
c
C ROUTINE TO DEACTIVATE TEST MODE
C
	idvmsk=8
	go to 1000
c
	entry onattn
C
C ROUTINE TO ACTIVATE THE ATTENUATOR
C
	idvmsk=3
	go to 1000
c
	entry onbeam
C
C ROUTINE TO OPEN SHUTTER - TURN BEAM ON
C
	idvmsk=1
	go to 1000
c
	entry onchrt
C
C ROUTINE TO TURN ON CHART RECORDER
C
	idvmsk=3
	go to 1000
c
	entry ontest
C
C ROUTINE TO ACTIVATE TEST MODE
C
	idvmsk=4
	go to 1000
c
1000	dif_lock=1
	write(ioutchn,2)idvmsk
2	format('A',i1)
	call outformat
	dif_lock=0
	if(idvmsk.eq.1)call delay(shtdly)	!Delay if shutter going on
	return
	end
	function rdmtr(i)
C
C Return Current Position of a Single Motor
C
	dimension angl(4)
	call RdAllMTR(angl)
	rdmtr=angl(i)
	return
	end
	options /extend
	subroutine RdAllMTR(angl)
C
C Return Current Positions of All Motors
C
	include 'newdif.inc'
	include 'single.inc'
	dimension ipos(10),angl(4)
	dif_lock=1
	itry = 0
	iflg = 1
	do while (iflg.ne.0.and.itry.lt.20)
	    write(ioutchn,2)
2	    format('M')
	    call informat(ipos,iflg)
	    if(iflg.ne.0)write(*,*)'Diffractometer Failed to Respond in RdAllMTR'
	    itry = itry + 1
	end do
	dif_lock=0
	do i=1,4
	  angl(i)=ipos(i)/stpdg(i)
	enddo
	if(ndcp.ne.0)angl(2)=angl(2)-0.5*angl(1)
	return
	end
	options /extend
	FUNCTION RDSCLR()
C
C READ THE SCALER
C
	include 'newdif.inc'
	dimension iscl(10)
	dif_lock=1
	write(ioutchn,2)
2	format('R6')
c	call outformat
	call informat(iscl,iflg)
	if(iflg.ne.0)write(*,*)'Diffractometer Failed to Respond in RDSCLR'
	dif_lock=0
	rdsclr=iscl(1)
	RETURN
	END
	options /extend
	FUNCTION RDTIME
C
C RETURN CURRENT VALUE OF TIMER
C
	include 'newdif.inc'
	dimension itime(10)
	dif_lock=1
	write(ioutchn,2)
2	format('R5')
c	call outformat
	call informat(itime,iflg)
	if(iflg.ne.0)write(*,*)'Diffractometer Failed to Respond in RDTIME'
	dif_lock=0
	rdtime=itime(1)*0.001
	RETURN
	END
	subroutine sclhlt
C
C ROUTINE TO HALT SCALER/TIMER
C
	byte ctrlp
	data ctrlp/'20'O/
	include 'newdif.inc'
c
	mask=0
	go to 1000
c
	entry stpall
C
C ROUTINE TO STOP EVERYTHING, ENTERED IF CTRL/P TYPED
C
	call outstring(ctrlp,1)
	return
c
	entry mtrhlt(i)
C
C ROUTINE TO HALT MOTORS
C
	mask=i
	go to 1000
c
1000	mask=mask.or.'60'O
	dif_lock=1
	write(ioutchn,2)mask
2	format('K',a1)
	call outformat
	dif_lock=0
	return
	end
	SUBROUTINE SETEXP(TIME)
C
C SET/RESET CRYSTAL EXPOSURE TIME
C
	include 'newdif.inc'
	itime=time
	dif_lock=1
	write(ioutchn,2)itime
2	format('L0,',i9.9)
	call outformat
	dif_lock=0
	RETURN
	END
	subroutine kcinit
c
c Initialization routine
c
	include 'newdif.inc'
	include 'trmprg.inc'
c
c probe remote supervisor to check for life
c
	dif_lock=1
	write(ioutchn,2)
2	format('@')
c	call outformat
	call informat(i,iflg)
	if(iflg.ne.0)then
	  type 4
4	  format(' Supervisor Program does not seem to be running'
	1	,' - Type LOAD command.')
	  dif_lock=1
	else
	  bufpnto=bufpnti
	  write(ioutchn,6)itmin,n_step,n_stpsz,n_spcchi
6	  format('P',6(i3.3,','),i3.3)
	  call outformat
	  dif_lock=0
	endif
c 
	return
	end
	SUBROUTINE WAIT
C
C ROUTINE TO WAIT FOR ALL MOTORS AND SCALERS INACTIVE
C
c Loop through all motors
	do i=1,4
	  call wtmtr(i)
	enddo
	call sclwt
	return
	end
	subroutine sclwt
c
c Routine to Wait for Scaler to finish
c
	BYTE joutchn(5),CR,BELL,alph(10)
	include 'newdif.inc'
	dimension inval(10)
	DATA CR,BELL/13,7/
c
100	dif_lock=1
	alph(1)=bell
	alph(2)='S'
	alph(3)=cr
	n=3
	call instring(alph,n)
	dif_lock=0
	if(alph(3).ne.'0')then
	  call delay(250)	!delay for a quarter second
	  go to 100
	endif
	RETURN
	END
	options /extend
	subroutine wtmtr(i)
c
c routine to wait for motor 'i' to finish
c
	include 'newdif.inc'
	byte bell,cr,alph(10)
	dimension inval(10),mtrcode(4)
	data bell,cr/7,13/
	data mtrcode/1,2,4,8/
c
	icnt=0
100	dif_lock=1
	alph(1)=bell
	alph(2)='S'
	alph(3)=cr
	n=3
	call instring(alph,n)
	dif_lock=0
	if(n.gt.0)then
	  if(alph(1).ne.'0')then
c LIMIT
	    call delay(100)
	    icnt=icnt+1
	    if(icnt.lt.100)go to 100
	    type *,'LIMIT on Diffractometer'
c Drop back to SINGLE Prompt
	    call lib$signal(%val(9999))
	  endif
	  icnt=0
	  jnval=alph(5)-'0'
	  if(n.gt.7)jnval=jnval*10+alph(6)-'0'
	  if((alph(1).eq.'0').and.((jnval.and.mtrcode(i)).ne.0))then
	    call delay(250)	!delay for a quarter second
	    go to 100
	  endif
	else
	  call delay(250)
	  go to 100
	endif
	return
	end
