Everhart, Glenn
From:	mathog@seqaxp.bio.caltech.edu
Sent:	Monday, December 14, 1998 11:18 AM
To:	Info-VAX@Mvb.Saic.Com
Subject:	Re: Q: Reading single Keys
In article <3673A466.463A020A@gauss.mpip-mainz.mpg.de>, Matthias Koch <koch@gauss.mpip-mainz.mpg.de> writes:
>Hi!
>
>Is there a possibility to read a single Key in a FORTRAN or PASCAL
>program? It should be possible via $QIO, but I couldn't figure out how.

Following my signature you'll find a routine I used to employ to do this. 
It's getting a bit long in the tooth (as am I) but it should still work.  I
have not used it in 12 years, but I just tried to compile it, and it went
through cleanly, so it probably does still work.

Regards,
David Mathog
mathog@seqaxp.bio.caltech.edu
Manager, sequence analysis facility, biology division, Caltech 
**************************************************************************
*                                RIP VMS                                 *
**************************************************************************


c	NOWAIT3.FOR
c	*********************************************************
c								|
c	Programmer		David Mathog			|
c				UCSF Biochemistry/Genetics	|
c	Last Update		8/23/85				|
c	*********************************************************
c
c	Modified version of NOWAIT.  This enables AST's to be intercepted.
c	This version is designed to be used in place of the old NOWAIT routines
c	in a polled environment.  Polling can continue as before, but if a key
c	is hit while the process is asleep, the AST routine will cancel the
c	scheduled wake up call and do one immediately.  As long as HIBERs are
c	only being used to ease up CPU use, this will not effect the program.
c	If hibers are being used to specify timed events, these timed events
c	will occur at incorrect times.  The event flag mechanism is still
c	used so that multiple devices can be used by the program and other
c	timed events can go on (such as flickering).
c
c	The bottom line:
c	THIS ROUTINE SHOULD ONLY BE USED IN PROGRAMS WHERE THE HIBER STATE IS
c	USED SOLELY TO EASE UP CPU POLLING LOAD.
c
c	*****************************************************************
c	Below is the code modified from NOWAIT 
c	*****************************************************************
c
c	This is a modification of CHARFETCH. The purpose is to allow
c	a program to qio and then go about its business without
c	waiting around for the io to finish. Only reads single characters
c	from terminals
c
c	ARGUMENTS
c
c	COMMAND	:char	:Single character passed back
c	TERMINAL:CHAR*(*):name of terminal to run from	
c	IMODE	:i*4	:as below
c
c	(Imode is a bit mask, bits are)		default
c	1	('1'x)	get a channel		don't get a channel
c	2	('2'x)	read			no read
c	3	('4'x)	purge			no purge
c	4	('8'x)	noecho			echo
c	5	('10'x)	return upper case	return upper and lower
c	6	('20'x)	nofilter(^U,^R,DEL)	terminal responds to list
c	7	('40'x) use IO$_TTYREADALL	Bypasses Driver on read.
c
c	>>>>>Imode always resets to 0
c
c	All bits 0 is signal for check status of IO
c	if complete iret=0, else 1
c
c	COMMAND_CHAN	:i*4	:channel to terminal, must be opened on first
c			call with imode=0
c	IEFN	:i*4	:event flag, range 0 to 31.
c	IRET	:i*4	:1 if an outstanding IO present, 0 if none.
c
c
	subroutine nowait(COMMAND,terminal,imode,command_chan,iefn,iret)
c
c
	Character*1 COMMAND
        character*1 TERMINATOR
	character terminal*(*)

	External SS$_NOTRAN,SS$_NORMAL,SS$_PARTESCAPE,sys$qio
	External IO$M_CVTLOW,IO$M_NOECHO,IO$M_TIMED,IO$_READVBLK
        external IO$M_PURGE,IO$M_NOFILTR,IO$_TTYREADALL
	EXTERNAL WAKEUP

	integer SUCCESS,SYS$QIO,SYS$ASSIGN,sys$readef
	Integer CHANNEL,OLD_DISPLAY,COMMAND_CHAN,TIME_OUT
        integer SS$_NOTRAN,SS$_NORMAL,SS$_PARTESCAPE
        integer qio_read,purge,length,term_type,level,flag,pass

        integer*2 iosb(4),char_count

c
c	check status if requested
c
	if(imode.eq.0)then
		success=sys$readef(%val(iefn),istate)
		if(.not.success)type*,'BLEW efn read'
		if(jiand(istate,jishft(1,iefn)).eq.0)then
			iret=1
		else			!efn set
			iret=0
			if(iosb(2).eq.0)then  !what type of terminator?
				igarb=iosb(3)
				command=char(igarb)
			end if
		end if
		return
	end if
c
c	set up for qio
c
	pass=1
	QIO_READ=0
c
	if(jiand(imode,1).eq.1)then
		krtemp=len(terminal)
		itemp=index(terminal,' ')
		if(itemp.eq.0)then		!the whole thing
			itemp=krtemp
		else if(itemp.eq.1)then		!First character is zip
			type*,'NOWAIT:ABORT:Terminal is unspecified'
			return
		else				!everything before the space
			itemp=itemp-1
		end if
		success=SYS$ASSIGN(terminal(1:itemp),COMMAND_CHAN,,)
	        if(.not.success) write(*,'(/,'' assign rts= '',z12,/)') success
c		make sure iefn is in first cluster
		if(iefn.gt.31.or.iefn.lt.0)stop 'IEFN IMPOSSIBLE'
		if(imode.eq.1)then	!no qio if no read!!!
			imode=0
			return
		end if
	end if
c
c	read? (default is no read)
c
	if(jiand(imode,2).eq.2)then
		QIO_READ=QIO_READ+%Loc(IO$_READVBLK)
	end if
c
c	purge? (default is no purge)
c
	if(jiand(imode,4).eq.4)then
		PURGE=%Loc(IO$M_PURGE)
	else
		PURGE=0
	end if
c
c	noecho? (default is echo)
c
	if(jiand(imode,8).eq.8)then
		QIO_READ=QIO_READ+%Loc(IO$M_NOECHO)
	end if
c
c	lower to upper? (default is no convert)
c
	if(jiand(imode,'10'x).eq.'10'x)then
		QIO_READ=QIO_READ+%loc(IO$M_CVTLOW)
	end if
c
c	pass ^U,^R,DEL (default is let term interpret)
c
	if(jiand(imode,'20'x).eq.'20'x)then
		QIO_READ=QIO_READ+%loc(IO$M_NOFILTR)
	end if
c
c	use TTYREADALL,bypasses the driver on reads
c
	if(jiand(imode,'40'x).eq.'40'x)then
		QIO_READ=QIO_READ+%loc(IO$_TTYREADALL)
	end if
	imode=0
	iret=1
c
21	continue
22	command=char(0)
	success=SYS$QIO(%val(iefn),%Val(COMMAND_CHAN),%Val(QIO_READ+PURGE),
     &	iosb,WAKEUP,,%Ref(COMMAND),%Val(pass),,,,)
        if(.not.success) write(*,'(/,'' qio rts= '',z12,/)') success
c
	return
c
c	
	End



	subroutine wakeup
c
c	wake up the calling routine (cancels hibernates)
c
	external sys$wake,sys$canwak
	integer sys$wake,sys$canwak
	istat=sys$canwak(,)
	istat=sys$wake(,)
	return
	end