*******************************************************************************
*
*	PTERM_VERB
*
*	Module	%M%	Version	%I% 	Date	%H%
*
*	(c) Copyright 1998 Ardent Software Inc. - All Rights Reserved
*	This is unpublished proprietary source code of Ardent Software Inc.
*	The copyright notice above does not evidence any actual or intended
*	publication of such source code.
*
*******************************************************************************
*
*	Maintenence log - insert most recent change descriptions at top
*
*	Date.... GTAR# WHO Description.........................................
*	10/14/98 23801 SAP Change copyrights. 
*	01/05/96 17705 PGW MS Windows changes, and removed previous fix
*	05/15/95 16523 SJM Added 'unsupported option' code
*	07/26/90 6272  JWT Add U6072 & U9072 per Ken Pike of Ultimate
*	04/09/90 6997  JWT fix PTERM syntax
*	11/13/89 6543  JWT Fix LPTR syntax error bug
*	02/03/89 5736  PHH Defaults for control characters
*	02/01/89 5718  GPS Correct file names that can't be opened
*	12/08/88 5005  PHH Allow leading dash on command tokens.
*	07/25/88   -    -  Maintenence log purged at 5.2.1, see release 5.1.10.
*
*******************************************************************************

$include	UNIVERSE.INCLUDE TTY
$include	UNIVERSE.INCLUDE MACHINE.NAME

printer off

open "PTERM.FILE,COMM" to f.cmd else stop "Can't open the 'PTERM.FILE,COMM' file."
open "PTERM.FILE,DISP" to f.dis else stop "Can't open the 'PTERM.FILE,DISP' file."
open "PTERM.FILE,BAUD" to f.bau else stop "Can't open the 'PTERM.FILE,BAUD' file."

cmd = trim(@SENTENCE)
cnt = dcount(cmd, " ")
dim tok(cnt)


matparse tok from cmd," "
ptr = 2
dis = 0

if ptr > cnt then goto helpem
token = upcase(tok(ptr))
begin case
case token = "LPTR"
	ptr += 1
	if ptr > cnt then goto skiptok
	mode = 1;
	if (num(tok(ptr)))
	then
		unit = tok(ptr)
		ptr += 1
	end
	else
		unit = 0
	end
	
case token = "MTU"
	ptr += 1
	if ptr > cnt then goto skiptok
	mode = 2;
	if (num(tok(ptr)))
	then
		unit = tok(ptr)
		ptr += 1
	end
	else
		unit = 0
	end
	
case token = "DEVICE"
	ptr += 1
	if ptr > cnt then goto skiptok
	mode = 4
	unit = tok(ptr)
	ptr += 1
	
case 1
	mode = 3
end case

skiptok:

begin case
case mode = 1
	TTYGET tty$ FROM LPTR unit ELSE goto badtty
	device.letter = "S"     ;* serial device
case mode = 2
	TTYGET tty$ FROM MTU  unit ELSE goto badtty
	device.letter = "M"     ;* not supported - TTYGET will fail
case mode = 3
	TTYGET tty$                ELSE goto badtty
	if @TTY[1,6] = "telnet" then
		device.letter = "T"
	end else
		* assume it's a console window
		device.letter = "C"
	end
case mode = 4
	OPENDEV unit TO dev.file ELSE
		STOP "PTERM: cannot open device ":unit
	END
	TTYGET tty$ FROM dev.file  ELSE goto badtty
	device.letter = "S"     ;* serial device
end case
	
loop:
loop
while ptr <= cnt do
	opt.in.error = tok(ptr)
	token = upcase(tok(ptr))
try:
	read ctrl from f.cmd, token
	else
		if token[1,1] = "-" then
			token = token[2,999]
			goto try
		end else
			stop "Unidentified Token ":quote(token):"."
		end
	end
	ptr += 1
		
	type = ctrl<1>
	begin case
	case type = "$C"
		if ptr > cnt then goto notok
		opt.in.error := " ":tok(ptr)
		val = tok(ptr); ptr += 1
		begin case
		case upcase(val) = "ON" ; val = ctrl<3>
		case upcase(val) = "OFF"; val = -1
		case val         = "^?" ; val = 127
		case val[1,1]    = "^"  ; val = seq(upcase(val[2,1]))-seq("A")+1
		case 1                  ; val = seq(val)
		end case
		sel = 1
	case type = "$N"
		if ptr > cnt then goto notok
		opt.in.error := " ":tok(ptr)
		val = tok(ptr); ptr += 1
		sel = 1
	case type = "$D"
		dis = 1
		sel = 1
	case type = "$B"
		sel = 1
		if ptr > cnt then goto notok
		opt.in.error := " ":tok(ptr)
		val = tok(ptr); ptr += 1
		sselect f.bau to 1
		loop
			while readnext baud from 1 
			read rec from f.bau, baud then
				locate val in rec setting loc then
					val = baud
					goto ok
				end
			end
		repeat
		stop "Illegal BAUD rate: '":val:"'"
	case type = ""
		val = ""
		sel = 1
	case 1
		if ptr > cnt then
			if type<1,1> = "" then
				sel = 1; goto ok
			end else
				goto notok
			end
		end
		opt.in.error := " ":tok(ptr)
		nxt = upcase(tok(ptr)); ptr += 1
		nty = dcount(type, @VM)
		val = ""
		for sel = 1 to nty
			if nxt = type<1,sel> then
				if nxt = "" then ptr -= 1
				goto ok
			end
		next
		stop "Unknown value ":quote(nxt):" used with ":quote(token):"."
	end case

ok:
	action = ctrl<2,sel>
	nact   = dcount(action,@SVM)
	for i = 1 to nact
		act = action<1,1,i>
		if index(act,"=",1) then
			var = field(act,"=",1)
			num = field(act,"=",2)
		end else
			var = act
			num = val
		end

		read disp from f.dis,var
		else stop "Unknown Variable ":quote(var):"."

		if disp<6> # "" and index(disp<6>, device.letter, 1) = 0 then
			if len(opt.in.error) > 0 then
				print "Warning: option ":quote(opt.in.error):
				print " is not supported for this device."
				opt.in.error = "" ;* Don't complain twice
			end
			goto next.action
		end
			
		if disp<5> = "$S"
			then assign tty$<disp<1>,disp<2>> to status()

		tty$<disp<1>,disp<2>> = num
next.action:
	next i
repeat

if dis then

	HUSH ON
	PERFORM "SSELECT PTERM.FILE,DISP BY FMC BY VMC"
	HUSH OFF

	cw    = @CRTWIDE
	class = ""
	loop
		readnext id    else exit
		read item from f.dis,id else item = ""

		if item<5> = "$E" and MODE.TYPE # MODE$EMULATE then goto rep
		if item<5> = "$C" and MODE.TYPE # MODE$CHAR    then goto rep
		if item<6> # "" and index(item<6>, device.letter, 1) = 0 then
			goto rep
		end

		data = tty$<item<1>,item<2>>
		code = item<3>
		text = item<4>

		begin case
		case code = "C"
			begin case
			case data =  -1; ans=text:"OFF"
			case data <  32; ans=text:"^":char(data+64):" "
			case data < 127; ans=text:char(data):"  "
			case data = 127; ans=text:"DEL"
			case 1;		 ans=text:oconv(data,"mo") "R\\%3"
			end case
		case code = "N"
			ans = text:data
		case code = "T"
			ans = text<1,data+1>
		case code = "-"
			if data then ans = text else ans = "-":text
		case code = "O"
			if data then ans = text:"ON" else ans = text:"OFF"
		case code = "Y"
			if data then ans = text:"YES" else ans = text:"NO"
		case code = "B"
			readv ans from f.bau,data,1 else ans = "Unknown"
			ans = text:ans
		case 1
			ans = text
		end case

		c = field(id,".",1)
		if c # class then
			if class # "" then print
			print c "l#15 ":
			class = c
			l = 16
		end
		if l + len(ans) + 1 >= cw then
			print; print space(16):
			l = 16;
		end
		print ans:" ":
		l += len(ans)+1
rep:
	repeat
	print

end

begin case
case mode = 1
	TTYSET tty$ ON LPTR unit ELSE goto badtty
case mode = 2
	TTYSET tty$ ON MTU  unit ELSE goto badtty
case mode = 3
	TTYSET tty$              ELSE goto badtty
case mode = 4
	TTYSET tty$ ON dev.file  ELSE goto badtty
	CLOSE dev.file
end case

stop

badtty:
	stop "PTERM: Not a terminal!"

notok:
	stop "PTERM: Option '":token:"' requires an argument"

helpem:
print "PTERM options are:"

print "ERASE    char | ON | OFF       KILL     char | ON | OFF"
print "WERASE   char | ON | OFF       RPRNT    char | ON | OFF"
print "INTR     char | ON | OFF       QUIT     char | ON | OFF"
print "EOF      char | ON | OFF       EOL      char | ON | OFF"
print "EOL2     char | ON | OFF       LCONT    char | ON | OFF"
print "FMC      char | ON | OFF       VMC      char | ON | OFF"
print "SMC      char | ON | OFF"
print
print "BAUD     50 - 9600"
print "BREAK	ON | OFF | INTR | IGNORE | NUL"
print "BSDELAY  ON | OFF"
print "CASE     INVERT | NOINVERT | LC-IN | LC-OUT | UC-IN | UC-OUT | XCASE | NOXCASE"
print "CRMODE   INLCR |  -INLCR | IGNCR |  -IGNCR | ICRNL  | -OICRNL |"
print "         ONLCR |  -ONLCR | OCRNL |  -CRNL  | ONLRET | -ONLRET |"
print "         ON | OFF"
print "DATABITS 5 - 8"
print "ECHO     ON | OFF | CTRL | NOCTRL | FAST | MEDIUM | SLOW | LF | NOLF"
print "FFDELAY  0 - 3"
print "FILL     ON | OFF | NUL | DEL"
print "INPUTCTL ON | OFF | TCL.RESET"
print "LFDELAY  0 - 8"
print "PARITY   EVEN | ODD | NONE | ENABLE | DISABLE | ERR_IGN | ERR_MRK | ERR_NUL"
print "STOPBITS 1 - 2"
print "TABS     ON | OFF"
print "VTDELAY  ON | OFF"
print "XON      ON | OFF | STARTANY | NOSTARTANY | TANDEM | NOTANDEM"
stop