	SUBROUTINE ASKTT( OUTBUF, INBUF, NCHAR, TIMEOUT, ISTAT, DEVICE)
C  Jim Walker, Aug 1987 for VAX/VMS.
C  Asks one question of the user with the terminal in half duplex
C  so other subprocesses can't get in the way.
C	OUTBUF - character string holding the question
C	INBUF - character string getting the answer
C	NCHAR - length of data put into INBUF.
C	TIMEOUT - number of seconds to wait before giving up. (should be >2)
C	ISTAT returns QIO error code or -1 for timeout error.
C	ISTAT = -2 for ^Z, -3 for ^Y.
C	ISTAT = -4 Device is not a terminal.
C	DEVICE - character string holding the device name, usually 'TT:'
C
	IMPLICIT NONE
	CHARACTER*(*) OUTBUF, INBUF, DEVICE
	INTEGER*4 SYS$QIOW, SYS$ASSIGN, SYS$DASSGN, ISTAT2
	INTEGER*4 LIB$DISABLE_CTRL, LIB$ENABLE_CTRL, LIB$GETDVI

	INTEGER*4 CHARBUF(3), SAVEBUF, TIMEOUT, ISTAT, NCHAR, SAVECTRL
	INTEGER*2 ITTCHAN, IOSB(4)
	EXTERNAL CTRLYAST
	INCLUDE '($DCDEF)'
	INCLUDE '($DVIDEF)'
	INCLUDE '($IODEF)'
	INCLUDE '($LIBCLIDEF)'
	INCLUDE '($SSDEF)'
	INCLUDE '($TTDEF)'
	INCLUDE '($TT2DEF)'
C
	ISTAT = SYS$ASSIGN(DEVICE,ITTCHAN,,)
D	TYPE*,'ASSIGN ISTAT=',ISTAT
	IF(ISTAT.EQ.SS$_NOSUCHDEV) THEN
		ISTAT = -4
		GOTO 9000
	ENDIF
	IF (.NOT. ISTAT) CALL LIB$SIGNAL ( %VAL(ISTAT) )
C
C Make sure device is a terminal
C
	ISTAT = LIB$GETDVI( DVI$_DEVCLASS, , DEVICE, ISTAT2,,)
	IF (.NOT. ISTAT) CALL LIB$SIGNAL ( %VAL(ISTAT) )
	IF(ISTAT2.NE.DC$_TERM) THEN
		ISTAT = -4
		GOTO 9000
	ENDIF
C
C Get current terminal characteristics.
C
	ISTAT = SYS$QIOW ( , %VAL(ITTCHAN), %VAL(IO$_SENSEMODE),
	1 IOSB, , , CHARBUF, %VAL(12), , , , )
D	TYPE*,' SENSEMODE ISTAT=', ISTAT, IOSB
	IF (.NOT. ISTAT) CALL LIB$SIGNAL ( %VAL(ISTAT) )
	IF (.NOT. IOSB(1)) CALL LIB$SIGNAL ( %VAL(IOSB(1)) )
C
C  Set up the ^Y AST.
C
	ISTAT = LIB$DISABLE_CTRL(LIB$M_CLI_CTRLY, SAVECTRL)
	IF (.NOT. ISTAT) CALL LIB$SIGNAL ( %VAL(ISTAT) )
D	TYPE*,'LIB$ENABLE ', ISTAT,SAVECTRL,LIB$M_CLI_CTRLY
C
	ISTAT = SYS$QIOW ( , %VAL(ITTCHAN), 
	1 %VAL(IO$_SETMODE + IO$M_CTRLYAST ),
	1 IOSB, , , CTRLYAST, , , , ,)
D	TYPE*,' SET ^Y ISTAT=', ISTAT, IOSB
	IF (.NOT. ISTAT) CALL LIB$SIGNAL ( %VAL(ISTAT) )
	IF (.NOT. IOSB(1)) CALL LIB$SIGNAL ( %VAL(IOSB(1)) )
C
C $ SET TERMINAL/HALFDUPLEX
C
	SAVEBUF=CHARBUF(2)
      	CHARBUF(2) = IBSET( CHARBUF(2), TT$V_HALFDUP )
	ISTAT = SYS$QIOW ( , %VAL(ITTCHAN), %VAL(IO$_SETMODE),
	1 IOSB, , , CHARBUF, %VAL(12), , , ,)
D	TYPE*,' SET HALF DUP ISTAT=', ISTAT, IOSB
	IF (.NOT. ISTAT) CALL LIB$SIGNAL ( %VAL(ISTAT) )
	IF (.NOT. IOSB(1)) CALL LIB$SIGNAL ( %VAL(IOSB(1)) )
C
C  Ask the question, get the answer.
	ISTAT = SYS$QIOW( , %VAL(ITTCHAN),
	1	%VAL( IO$_READPROMPT + IO$M_TIMED ),
	2	IOSB, , ,
	3	%REF(INBUF), %VAL(LEN(INBUF)), %VAL(TIMEOUT), , 
	4	%REF(OUTBUF), %VAL(LEN(OUTBUF)) )
D	TYPE*,'READ ISTAT=',ISTAT,IOSB,INBUF(1:10)
	IF (.NOT. ISTAT) CALL LIB$SIGNAL ( %VAL(ISTAT) )
C
C  Tell main program how long the data was.
	NCHAR = IOSB(2)
C
C  If we timed out, set ISTAT = -1 and tell user to never mind.
	IF(IOSB(1).EQ.SS$_TIMEOUT) THEN
	   IF(IOSB(1).EQ.SS$_TIMEOUT) ISTAT = -1
	    ISTAT2 = SYS$QIOW( , %VAL(ITTCHAN),
	1	%VAL( IO$_WRITEVBLK ),
	2	IOSB, , ,
	3	%REF(' Never mind.'//CHAR(13)//CHAR(10)), 
	4	%VAL(14), , , , )
D	    TYPE*,'WRITE ISTAT2=',ISTAT2,IOSB,INBUF(1:10)
	    IF(.NOT. ISTAT2) CALL LIB$SIGNAL ( %VAL(ISTAT2) )
	    IF(.NOT. IOSB(1)) CALL LIB$SIGNAL ( %VAL(IOSB(1)) )
	ELSEIF(IOSB(3).EQ.26.AND.IOSB(1).EQ.1) THEN
		ISTAT = -2
	ELSEIF(IOSB(1).EQ.SS$_CONTROLY) THEN
		ISTAT = -3
	ELSEIF(.NOT. IOSB(1)) THEN
C  Signal non timeout errors from readprompt qio.
		CALL LIB$SIGNAL ( %VAL(IOSB(1)) )
	ENDIF
C
C  Set the terminal back the way it was.
	CHARBUF(2)=SAVEBUF
	ISTAT2 = SYS$QIOW ( , %VAL(ITTCHAN), %VAL(IO$_SETMODE),
	1 IOSB, , , CHARBUF, %VAL(12), , , ,)
D	TYPE*,' RESETMODE ISTAT2=', ISTAT2, IOSB
	IF (.NOT. ISTAT2) CALL LIB$SIGNAL ( %VAL(ISTAT2) )
	IF (.NOT. IOSB(1)) CALL LIB$SIGNAL ( %VAL(IOSB(1)) )
C
	ISTAT2 = LIB$ENABLE_CTRL(SAVECTRL, )
	IF (.NOT. ISTAT2) CALL LIB$SIGNAL ( %VAL(ISTAT2) )
D	TYPE*,' LIB$ENABLE ', ISTAT2, SAVECTRL,LIB$M_CLI_CTRLY
C
C  Deassign the channel from the terminal.
9000	ISTAT2=SYS$DASSGN(%VAL(ITTCHAN))
D	TYPE*,'DEASSIGN ISTAT2=',ISTAT2
	RETURN
	END
C
	SUBROUTINE CTRLYAST
	RETURN
D	END
C
D	PROGRAM TEST
C
D	CHARACTER*80 INBUF
D	INTEGER*4 NCHAR, ISTAT
D	CALL ASKTT( 'Talk to me: ', INBUF, NCHAR, 10, ISTAT, 'TT:')
D	TYPE*,' ISTAT=',ISTAT,' NCHAR=',NCHAR
D	TYPE*,' DATA="',INBUF(1:NCHAR),'"'
	END
