OpenVMS Source Code Demos

BASIC_TERMINAL_CHARACTERISTICS_DEMO.BAS

1000	%title "Demo_Terminal_Characteristics"
	%ident			    "version 101.1"				! <<<---***
	declare string constant k_version = "101.1"				!
	!========================================================================================================================
	! title  : Demo_Terminal_Characteristics_xxx.bas
	! author : Neil Rieck (https://neilrieck.net)
	! history:
	! ver who when   what
	! --- --- ------ --------------------------------------------------------------------------------------------------------
	! 100 NSR 050715 1. original work (just hacking around)
	!     NSR 050716 2. added field definitions from the OpenVMS I/O User's Manual (terminal driver)
	! 101 NSR 050718 1. moved the terminal code into a function
	!========================================================================================================================
	option type=explicit
	set no prompt
	declare string constant k_program = "Demo_Terminal_Characteristics"
	!
	external sub access_terminal_characteristics(string,long,long)
	!
	!	variable declarations
	!
	declare	string		old_tty_settings$	,&
				debug$			,&
		long		debug%
	!
	!====================================================================================================
	!	main
	!====================================================================================================
	main:
	print k_program +"_"+ k_version						!
	print string$(len(k_program +"_"+ k_version), asc("="))			!
	!
	input "debug level? (0-3) ";debug$					!
	when error in								!
	    debug% = integer(debug$)						!
	use									!
	    debug% = 3								!
	end when								!
	!
	print ">>> reading old tty settings"
	call access_terminal_characteristics(old_tty_settings$,0,debug%)	! read current settings
	sleep 2
	print ">>> disabling broadcast"
	call access_terminal_characteristics(old_tty_settings$,2,debug%)	! disable broadcast 
	sleep 2	
	print ">>> restoring original tty settings"
	call access_terminal_characteristics(old_tty_settings$,1,debug%)	! restore original
	sleep 2	
	!
32000	end									!
	!
	!########################################################################################################################
	!
	!	access terminal characteristics
	!
	!	switch%	0	= read  tty characteristics into terminal_char_bits$
	!		1	= write tty characteristics from terminal_char_bits$
	!		2	= use  terminal_char$ as a template to disable broadcasts
	!
32100	sub access_terminal_characteristics(string terminal_char_bits$, long switch%, long debug%)
	option type=explicit
	!
	%include "starlet"	%from %library "sys$library:basic$starlet"	! system services
	%include "$ssdef"	%from %library "sys$library:basic$starlet"	! ss$
	%include "$iodef"	%from %library "sys$library:basic$starlet"	! io$
	%include "$ttdef"	%from %library "sys$library:basic$starlet"	! tt$
	%include "$tt2def"	%from %library "sys$library:basic$starlet"	! tt2$
	%include "lib$routines"	%from %library "sys$library:basic$starlet"	! lib$
	%include "$libdef"	%from %library "sys$library:basic$starlet"	! eg. lib$_normal
	%include "$dvidef"	%from %library "sys$library:basic$starlet"	! dvi$
	!
	!	record: I/O Status Block
	!
	record IosbRec								! structure of I/O Status Block
	    variant
		case
		    group one							! this variation is used with I/O transfers
			word		rc					! return code
			word		xfer_count				! transfer count
			long		long_0					! device specific info
		    end group one
		case
		    group two							! this variation is used to satisfy the compiler
			basic$quadword	quad_0					! unsigned quad (system calls)
		    end group two
		case
		    group three							! this variation is used in $SNDJBC + $SNDJBCW
			long		job_status				! job status
			long		long_3					! device specific info
		    end group three
	    end variant
	end record IosbRec
	!
	!	record: terminal characteristics
	!
	record tty_chars							! terminal chracteristics buffer layout
	    variant
		case
		    group one							! for hacking
			long DataBitsL(2)					! 0-2	= 3 *4	=12	bytes
		    end group							!
		case
		    group two							! for hacking
			byte DataBitsB(11)					! 0-11	=12 		bytes
		    end group							!
		case
		    group three							!
			string DataBits$ = 12					! 12 bytes
		    end group							!
		case
		    group four							! I/O User's Reference Manual (terminal driver)
			byte	term_class					!
			byte	term_type					!
			word	page_width					!
			long	basic_char					! TT$M_	 stuff; also includes page length
			long	exten_char					! TT2$M_ stuff
		    end group
	    end variant
	end record
	!
	!	variable declarations
	!
	declare word		item_w		,	&
				chan_w		,	&
		long		rc%		,	&
				junk%		,	&
				item%		,	&
				i%		,	&
		string		junk$		,	&
				terminal_name$
	declare IosbRec 	IosbVar						!
	declare tty_chars	characteristics					! terminal characteristics variable
	!
	!========================================================================================================================
	main:
	for i% = 0 to 2								! init
	    characteristics::DataBitsL(i%) = 0					!
	next i%									!
	!
	!	find out the attched device name (usually a terminal but could be a disk if this is a batch job)
	!
	!	LIB$GETDVI item-code [,channel] [,device-name] [,longword-integer-value] [,resultant-string] [,resultant-length]
	!
	item% = Dvi$_TT_phyDevNam						!
	rc% = lib$getdvi(item%,,"SYS$INPUT",,terminal_name$,)			! find the input device name (could be disk)
	if (rc% and 7%) <> 1 then						!
	    print "-e-lib$getdvi-rc: ";rc%	if debug% >= 1			!
	    goto sub_exit							!
	end if									!
	print "-i-name:"; terminal_name$ if debug% >= 2				!
	!
	!	get an i/o channel
	!
	rc% = sys$assign( terminal_name$, chan_w,,)				!
	if (rc% and 7%) <> 1 then						!
	    print "-e-sys$assign-rc: ";rc%	if debug% >= 1			!
	    goto sub_exit							!
	end if									!
	print "-i-chan: "+str$(chan_w) if debug% >= 2				!
	!
	!	SYS$QIO [efn] ,chan ,func ,[iosb] ,[astadr] ,[astprm] ,[p1] ,[p2] ,[p3] ,[p4] ,[p5] ,[p6]
	!
	select switch%
	    case 0								!
		item_w = IO$_SENSEMODE
	    case 1								!
		item_w = IO$_SETMODE
		characteristics::DataBits$ = terminal_char_bits$		!
	    case else								!
		item_w = IO$_SETMODE						!
		characteristics::DataBits$ = terminal_char_bits$					! copy
		characteristics::basic_char = characteristics::basic_char or  tt$m_nobrdcst		! set   bit
		characteristics::exten_char = characteristics::exten_char and (-1% - tt2$m_brdcstmbx)	! clear bit
	end select
	rc% = sys$QioW(								! event flag		&
			,chan_w				by value		! channel		&
			,item_w				by value		! function		&
			,IosbVar::quad_0		by ref			! iosb			&
			,							! ast address		&
			,							! ast parameter		&
			,characteristics::DataBitsL(0)	by ref			! p1 buff addr		&
			,12%				by value		! p2 buff length	&
			,,,,				)
	if (rc% and 7%) <> 1 then
	    print "sys$qiow-rc: ";rc%	if debug% >=1 
	    goto sub_exit
	end if
	!
	if switch% = 0 then
	    terminal_char_bits$ = characteristics::DataBits$			! pass back sensed data
	end if
	!
	if debug% >= 2 then
	    print "-i-iosb rc : ";str$( IosbVar::rc)				! what was the rc% of the request? 
	    print "-i-iosb cnt: ";str$( IosbVar::xfer_count )			!
	    print "-i-iosb lng: ";str$( IosbVar::long_0 )			!
	end if
	!
!~	for i% = 0 to 11
!~		print "debugB: ";characteristics::DataBitsB(i%)
!~	next i%
	!
!~	for i% = 0 to 2
!~		print "debugL: "; characteristics::DataBitsL(i%)
!~	next i%
	!
	if debug% >= 2 then
	    print "-i-term_class   : "; characteristics::term_class
	    print "-i-term_type    : "; characteristics::term_type
	    print "-i-page_width   : "; characteristics::page_width
	    print "-i-basic_char   : "; characteristics::basic_char
	    print "-i-extended_char: "; characteristics::exten_char
	end if
	!
	sub_exit:
	if chan_w <> 0 then							! if we've got a channel assigned...
	    rc% = sys$dassgn(chan_w)						!
	    if (rc% and 7%) <> 1 then						!
		print "-e- $dassgn rc: ";rc% if debug% >= 1			!
	    end if								!
	end if									!
	!
	end sub
	!

Back to Home
Neil Rieck
Waterloo, Ontario, Canada.