
C+
C	EXIT_DTC
C
C	This subroutine establishes the exit handler for the DTC
C	package.  Since, all kinds of screen formatting is being
C	done (if the terminal is a VT100) with scroll regions, large
C	letters, etc., the only safe way to get out of the program
C	via a control-Y and leave the terminal in a defined state,
C	is to allways exit via an exit handler which will reset
C	the scroll region (full screen) and erase the screen.
c
C	Note that this routine also sets the terminal up for NO_WRAP
C	and resets it to whatever its initial characteristics were
C	when the exit handler is called at exit.  The reason for
C	setting the terminal for no wrap is that we do not want
C	erroniously long input lines to wrap around to the next line
C	and screw up the display.
C
C		CALL EXIT_DTC(Iterminal,TTchan)
C	Where
C		Itermianl  I*4	Terminal type found from $GETDVI
C		TTchan	   I*2	Channel # for SYS$INPUT obtained
C				from SYS$ASSIGN
C
C	Written by:	James G. Downward
C			KMS Fusion, Inc.
C			PO Box 1567
C			Ann Arbor, Mich 48106
C
C		IDENT	/2/
C-
	SUBROUTINE EXIT_DTC(Iterminal,TTchan)
	IMPLICIT	INTEGER*4 (A - Z)		!
	INTEGER*2	TTchan,TTchan2			!
	INTEGER*4	EXIT_STATUS, EXIT_BLOCK(5)	!
	INTEGER*4	Iterminal			! What kind of term
	INTEGER*4	Pid
	EXTERNAL	EXIT_DTC2			! Call on exit
	COMMON	/Term_channel/	TTchan2			! Pass it our I/O chnl
	COMMON		/PID/ PID


	PID=0						! No subprocesses at 1st
C	Declare exit handler				!
	EXIT_BLOCK(2) = %LOC(EXIT_DTC2)			!
	EXIT_BLOCK(3) = 2				!
	EXIT_BLOCK(4) = %LOC(EXIT_STATUS)		!
	EXIT_BLOCK(5) = %LOC(ITERMINAL)			!
	TTchan2=TTchan					! Transfer to EXIT_DTC2
	STATUS = SYS$DCLEXH (EXIT_BLOCK)		! Requires Implicit
	Is_Set=.TRUE.					! Light a candle
	IF (.NOT. STATUS) CALL LIB$STOP (%VAL(STATUS))	!  INTEGER*4 (A-Z)
	CALL Enable_AST(TTchan)				! Enable ^Y ast
	RETURN						! Back to mainline
	END						!

	SUBROUTINE	EXIT_DTC2(EXIT_STATUS, Iterminal)
C
C  ..  This routine is called when the program tries to exit.  It does
C      a number of things.  It tries to erase the screen. How it does this
C      depends on the type of terminal we have.  Only VT100's and Tek 4014
C      really erase, the rest just space up.  It also resets scrolling
C      regions on VT100 type terminals, resets any changed terminal 
C      characteristics, and cancels any outstanding I/O.  If a sbprocess
C      window exists (PID <> 0), it deletes the subprocess.
C
	IMPLICIT	INTEGER*4 (A - Z)		!
	CHARACTER*1 	Cescape,Cform_Feed,Cline_Feed	!
	CHARACTER*1	Ckeypad		/'>'/		! Reset keypad mode
	CHARACTER*2	Clights		/'[q'/		! Reset lights off
	CHARACTER*4	Corigin		/'[?6l'/	! Reset Origin mode
	CHARACTER*4	Cjump		/'[?4l'/	! Reset Jump mode
	CHARACTER*7	Cscroll		/'[1;24;r'/	! Scoll window
	CHARACTER*4	Clarge		/'[?3l'/	! Make large characters
	CHARACTER*12 	Cpage				!
	LOGICAL		Is_Set				! If Subprocess in use
	INTEGER*2	TTchan				!
	INTEGER*4	Term_Char			!
	INTEGER*4	DELAY_INTERVAL(2)		! For SETIMR
	INTEGER*4	PID				!
	EXTERNAL	IO$_SETMODE			!
	COMMON	/CTL_MASK/	Old_Mask		! Reestablisy ^Y state
	COMMON	/Terminal_characteristics/ Term_char(3)	!
	COMMON	/Term_channel/	TTchan			!
	COMMON		/PID/ PID			!

	DATA Cescape	/27/				!
	DATA Cform_feed /12/				!
	DATA Cline_feed /10/				!

	PARAMETER (DT$_TTYUNKN=	0)			! Unknown
	PARAMETER (DT$_VT05=	1)			! **Unknown**
	PARAMETER (DT$_VK100=	2)			! Vk100 video board
	PARAMETER (DT$_VT173=	3)			! **Unknown**
	PARAMETER (DT$_FT1=	16)			! Tek 4014 term
	PARAMETER (DT$_FT2=	17)			! NBI Term
	PARAMETER (DT$_FT3=	18)			! **Unknown**
	PARAMETER (DT$_FT4=	19)			! **Unknown**
	PARAMETER (DT$_FT5=	20)			! **Unknown**
	PARAMETER (DT$_FT6=	21)			! **Unknown**
	PARAMETER (DT$_FT7=	22)			! **Unknown**
	PARAMETER (DT$_FT8=	23)			! **Unknown**
C ...
C ... hard copy terminals
C ...
	PARAMETER (DT$_LAX=	32)			! Send 7 LF FF to all
	PARAMETER (DT$_LA36=	32)			! hard copy terminals
	PARAMETER (DT$_LA120=	33)			! unless have form ctl
	PARAMETER (DT$_LA34=	34)			!
	PARAMETER (DT$_LA38=	35)			!
	PARAMETER (DT$_LA12=	36)			!
	PARAMETER (DT$_LA24=	37)			!
	PARAMETER (DT$_LA100=	37)			!
	PARAMETER (DT$_LQP02=	38)			!
C ...
C ... Video terminals
C ...
	PARAMETER (DT$_VT5X=	64)			!  **Unknown**
	PARAMETER (DT$_VT52=	64)			! Treat as VT52
	PARAMETER (DT$_VT55=	65)			! Treat as VT52
	PARAMETER (DT$_VT100=   96)			! VT100
C ...
C ... Delete dead subprocess if any
C ...
	IF(PID.NE.0) Istatus=SYS$DELPRC(PID,)
C ...
C ... Restore terminal characteristics (if modified)
C ...
	Set_Mode   = %LOC(IO$_SETMODE)			!
	STATUS = SYS$QIOW (,%VAL(TTCHAN), %VAL(Set_mode)! Reset any changed 
     -		           ,,,,Term_Char, %VAL(8),,,,)	!  term charact.
	IF (.NOT. STATUS) CALL LIB$STOP (%VAL(STATUS))	!
C ...
C ... Allow the ^Y to go to DCL now
C ...
	STATUS = LIB$ENABLE_CTRL(Old_Mask)		!  for catching ^Y AST

C ...
C ... Erase the terminal screen
C ...
	IF(Iterminal.GE.DT$_VT100)		THEN	! If a VT100
	   Cpage=Cescape//'[1;H'//Cescape//'[2J'	!
	   Length=9					!
	ELSE IF(Iterminal.EQ.DT$_FT1)	THEN		! If a 4014
	   Cpage=Cescape//Cform_Feed			!
	   Length=2					!
	ELSE IF(Iterminal.EQ.DT$_FT2	  .OR.		! If a NBI beastie
     -		Iterminal.EQ.DT$_LA120 	  .OR.		!  or a LA120
     -		Iterminal.EQ.DT$_VK100)		THEN	!   or VK100 vid board
	   Cpage=Cform_Feed				! then use a FF
	   Length=1					!
	ELSE 						! Else use 7 linefeeds
	   DO I=1,7					!  to simulate a page
	     Cpage(I:I)=Cline_Feed			!
	   END DO					!
	   Length=7					!
	END IF						!
C
C ... We may already have had output printing to the terminal.  Now one
C ... can not do output in an AST routine to a channel which has output
C ... blocked on it (by the AST routine).  So for the purpose of erasing
C ... the screen, etc. we will open a new unit (channel) and do our
C ... terminal control I/O to it.
C ...
	OPEN(UNIT=5,NAME='SYS$OUTPUT',STATUS='UNKNOWN')	!
	WRITE(5,5) Cpage(1:Length)			! Output control char
5	FORMAT('+',A,$)					!
	IF(Iterminal.GE.96)			THEN	!
	  WRITE(5,20)Cescape//Ckeypad//Cescape//Clights//
     -		        Cescape//Corigin//
     -			Cescape//Cscroll//Cescape//Cjump//
     -			Cescape//Clarge
20	  FORMAT('+',A,$)				!
	END IF						!
	IF(Iterminal.EQ.DT$_FT1)		THEN	! Set delay 10 sec
	    STATUS = SYS$BINTIM ('0 00:00:02',DELAY_INTERVAL)! Cnvt ASCII to binary	
	    STATUS = SYS$SETIMR (%VAL(1), DELAY_INTERVAL,,)! Now wait
	    STATUS = SYS$WAITFR (%VAL(1))		!
	END IF						!
	RETURN
	END



	SUBROUTINE	ENABLE_AST (TTCHAN)

C	This subroutine enables a ^Y attention AST
C	for the terminal.  This means that ^Y will go to this task rather
C	than DCL.  We must be sure to reenable ^Y prior to exit or we
C       will not be able to use it later.

	IMPLICIT	INTEGER*4 (A - Z)
	INTEGER*2	TTCHAN				!
	INTEGER*4	Imask				!
	INTEGER*4	Old_Mask			!
	INTEGER*4	Term_char, New_char(3)		!
	EXTERNAL	CTRL_Y_AST			! Catches ^Y's
	EXTERNAL	IO$_SETMODE, IO$M_CTRLYAST	! for QIO's
	EXTERNAL	IO$_SENSEMODE,TT$V_WRAP		!
	PARAMETER	(LIB$M_CLI_CTRLY = '02000000'X)	! Disable ^Y bit

	COMMON	/CTL_MASK/	Old_Mask		!
	COMMON	/Terminal_characteristics/  Term_char(3)!

	Imask = LIB$M_CLI_CTRLY				!
	STATUS = LIB$DISABLE_CTRL(Imask,Old_Mask)	! Disable ^Y for CLI
	SET_AST = %LOC(IO$_SETMODE) .OR. %LOC(IO$M_CTRLYAST)
C ...
C ... Find out what the terminal characteristics are and then set
C ... the terminal for NO_WRAP
C ...
	Sense_mode = %LOC(IO$_SENSEMODE)		!
	Set_Mode   = %LOC(IO$_SETMODE)			!

C
C .. Get the current terminal characteristics
C
	STATUS = SYS$QIOW (,%VAL(TTCHAN), %VAL(Sense_mode)
     -		           ,,,,Term_Char, %VAL(8),,,,)	!
	IF (.NOT. STATUS) CALL LIB$STOP (%VAL(STATUS))	! Die if fails
	New_Char(1)=Term_Char(1)			! Transfer charact
	New_char(2)=IBCLR(Term_Char(2),%LOC(TT$V_WRAP))	! Clear wrap bit
	STATUS = SYS$QIOW (,%VAL(TTCHAN), %VAL(Set_mode)
     -		           ,,,,New_Char, %VAL(8),,,,)	! Set for nowrap
	IF (.NOT. STATUS) CALL LIB$STOP (%VAL(STATUS))

C ...
C ...	Enable AST recognition
C ...
	STATUS = SYS$QIOW (,%VAL(TTCHAN), %VAL(SET_AST)	!
     -		           ,,,,CTRL_Y_AST, TTCHAN,,,,)	!
	IF (.NOT. STATUS) CALL LIB$STOP (%VAL(STATUS))	!

	RETURN						! Done
	END

	SUBROUTINE	CTRL_Y_AST (TTCHAN)
	INTEGER*2	TTchan
	CALL EXIT					! exit to exit handler
	RETURN
	END



