R LINK
LDUDK.SAV,LDUDK.MAP=LDUDK,SCRNCH,GETDEF,UTIL,TCFL.CSL/I/W//
RK0:SYSLIB.EFB
SY:TSXLIB
//
$SHORT

^C
	PROGRAM LDUDK
C
C	Load the DEC VT200 series terminal's User Defined Keys (UDK)
C
C	Created with:
C		R LINK
C		LDUDK.SAV,LDUDK.MAP=LDUDK,SCRNCH,GETDEF,UTIL,TCFL.CSL/I/W//
C	        TSXLIB
C	        //
C		$SHORT
C
C		^C
C
C	Author:  S.C. Cribbs		          Version 2.0    85/02/02
C		 Atomic Energy of Canada Limited
C		 Pinawa, Manitoba
C		 Canada  R0E 1L0
C
C	Version 2.1  - Fixed Indirect File execution detection  (85/03/18)
C	Version 2.2  - Added support for TSX+ at version 5.0    (85/05/24)
C	             - Now just exits if (run from an RT-11 command file &
C	               TT: set QUIET & UDK keys locked) at startup.
C	Version 2.3  - Fixed "quiet" mode operation to properly exit the
C	               command file if at startup the UDKs are locked.
C	               When run from a command file under, at least,
C	               RT-11 v5.1c, programs must handle lowercase input
C	               even when the LC bit in the JSW has not been set.
C	               Although the terminal manual says that UDK
C	               definitions that exceed UDK buffer capacity will
C	               cause the UDK lock to be set, it doesn't happen.
C	               Overflow characters and future key definitions are
C	               just ignored. (86/01/06) 
C
	INTEGER TID(10),I,J,KP,KTRMID,LPRVTE,UDKSTS,EXTCDE,MONTYP
	LOGICAL*1 QUIET,GETDEF,RT11
	BYTE INITRM(20),TM2007(9),SRESET(5),TFOREN(237),ERLOCK(251)
	BYTE STRING,ECONT,CLRHME(11),PID,BEEP(3),UDKLKD(236)
	BYTE CMENU1(255),CMENU2(192),CPRMPT(12),ST(4),PREAMB(7)
	BYTE CLUDKP(61),LKUDKP(74),YESNOP,CLRUDK(9),LOKUDK(9)
	BYTE BUFR(524),BADKEY(120)
	COMMON /UDK00/  PID(41)
	COMMON /UDK01/  STRING(82)
	COMMON /UDK02/  ECONT(54)
	COMMON /UDK03/  YESNOP(112)
	COMMON /UDK04/  EXTCDE
	DATA SRESET /"33,'[','!','p',"200/   !VT200 series soft reset
	DATA TM2007 /"33,'[','6','2',';','1','"','p',"200/ !VT200 series
	DATA INITRM /"33,'<',"33,'(','B',"17,"33,'>',"33,'[','1',';',
     #	 '2','4','r',"33,'[','0','m',"200/
	DATA CLRHME /"33,'[','2','J',"33,'[','1',';','1','H',"200/
	DATA JSW /"44/, BEEP /"7,"7,"200/
	DATA PID    /"33,'[','2','J',"33,'[','1',';','7','H',"33,'#',
     #	 '6','L','D','U','D','K',' ','/',' ','R','T','-','1','1',' ',
     #	 ' ',' ','V','e','r','s','i','o','n',' ','2','.','3',"200/
	DATA CLUDKP /"33,'[','2',';','1','H',"33,'[','0','J',"33,'[',
     #	 '1','0',';','2','3','H',"33,'[','1','m','C','l','e','a','r',
     #	 ' ','a','l','l',' ','p','r','e','s','e','n','t',' ','U','D',
     #	 'K',' ','d','e','f','i','n','i','t','i','o','n','s','?',"33,
     #	 '[','0','m',"200/
	DATA LKUDKP /"33,'[','2',';','1','H',"33,'[','0','J',"33,'[',
     #	 '1','0',';','1','6','H',"33,'[','1','m','L','o','c','k',' ',
     #	 't','h','e',' ','U','D','K',' ','d','e','f','i','n','i','t',
     #	 'i','o','n','s',' ','a','g','a','i','n','s','t',' ','f','u',
     #	 't','u','r','e',' ','c','h','a','n','g','e','?',"33,'[','0',
     #	 'm',"200/
	DATA ERLOCK /"7,"7,"33,'[','2',';','1','H',"33,'[','0','J',"33,
     #	 '[','6',';','1','4','H',"33,'[','1','m','T','h','e',' ','t',
     #	 'e','r','m','i','n','a','l',' ','h','a','s',' ','l','o','c',
     #	 'k','e','d',' ','i','t','s','e','l','f',' ','a','g','a','i',
     #	 'n','s','t',' ','r','e','d','e','f','i','n','i','t','i','o',
     #	 'n','.',"33,'[','0','m',"33,'[','8',';','2','0','H','T','h',
     #	 'i','s',' ','i','s',' ','l','i','k','e','l','y',' ','b','e',
     #	 'c','a','u','s','e',' ','i','t',"47,'s',' ','U','D','K',' ',
     #	 '2','5','6',' ','b','y','t','e',"33,'[','1','0',';','2','3',
     #	 'H','s','t','o','r','a','g','e',' ','c','a','p','a','c','i',
     #	 't','y',' ','h','a','s',' ','b','e','e','n',' ','e','x','c',
     #	 'e','e','d','e','d','.',"33,'[','1','6',';','3','6','H',"33,
     #	 '[','5','m','W','A','R','N','I','N','G',"33,'[','0','m',"33,
     #	 '[','1','8',';','1','5','H','T','h','e',' ','k','e','y',' ',
     #	 'd','e','f','i','n','i','t','i','o','n',' ','l','a','s','t',
     #	 ' ','e','n','t','e','r','e','d',' ','m','a','y',' ','b','e',
     #	 ' ','i','n','c','o','m','p','l','e','t','e','.',"200/
	DATA YESNOP /"33,'[','2','1',';','1','2','H','T','y','p','e',
     #	 ' ','e','i','t','h','e','r',' ',"33,'[','7',';','1','m','Y',
     #	 "33,'[','0',';','1','m','e','s',"33,'[','0','m',' ',"33,'[',
     #	 '7','m','R','E','T','U','R','N',"33,'[','0','m',' ','o','r',
     #	 ' ','s','i','m','p','l','y',' ',"33,'[','7','m','R','E','T',
     #	 'U','R','N',"33,'[','0','m',' ','t','o',' ','i','n','d','i',
     #	 'c','a','t','e',' ',"33,'[','1','m','N','o',"33,'[','0','m',
     #	 '.',"33,'[','2','3',';','4','0','H',"200/
	DATA CLRUDK /"33,'P','0',';','1','|',"33,'\',"200/
	DATA LOKUDK /"33,'P','1',';','0','|',"33,'\',"200/
	DATA PREAMB /"33,'P','1',';','1','|',0/
	DATA ST     /"33,'\',"200,0/
	DATA CMENU1 /"33,'[','2',';','1','H',"33,'[','0','J',"33,'[',
     #	 '8',';','2','1','H',"33,'[','1','m','N','a','m','e',' ','o',
     #	 'f',' ','t','h','e',' ','k','e','y',' ','t','o',' ','b','e',
     #	 ' ','p','r','o','g','r','a','m','m','e','d',':',"33,'[','0',
     #	 'm',"33,'[','1','5',';','9','H','T','y','p','e',' ','i','n',
     #	 ' ','a',' ','k','e','y',' ','n','a','m','e',' ','f','r','o',
     #	 'm',' ','t','h','e',' ','l','i','s','t',' ','b','e','l','o',
     #	 'w',' ','a','n','d',' ','t','h','e','n',' ','p','r','e','s',
     #	 's',' ',"33,'[','7','m','R','E','T','U','R','N',"33,'[','0',
     #	 'm',"33,'[','1','7',';','3','9','H','o','r',"33,'[','1','9',
     #	 ';','2','2','H','s','i','m','p','l','y',' ','p','r','e','s',
     #	 's',' ',"33,'[','7','m','R','E','T','U','R','N',"33,'[','0',
     #	 'm',' ','t','o',' ','e','x','i','t',' ','L','D','U','D','K',
     #	 '.',"33,'[','2','2',';','3','1','H','P','r','o','g','r','a',
     #	 'm','m','a','b','l','e',' ','K','e','y','s',':',"33,'[','2',
     #	 '4',';','6','H',"33,'[','1',';','7','m','F','6',"33,'[','0',
     #	 'm',' ',"33,'[','1',';','7','m','F','7',"33,'[','0','m',' ',
     #	 "33,'[',"200/
	DATA CMENU2 /'1',';','7','m','F','8',"33,'[','0','m',' ',"33,
     #	 '[','1',';','7','m','F','9',"33,'[','0','m',' ',"33,'[','1',
     #	 ';','7','m','F','1','0',"33,'[','0','m',"33,'[','4','C',"33,
     #	 '[','1',';','7','m','F','1','1',"33,'[','0','m',' ',"33,'[',
     #	 '1',';','7','m','F','1','2',"33,'[','0','m',' ',"33,'[','1',
     #	 ';','7','m','F','1','3',"33,'[','0','m',' ',"33,'[','1',';',
     #	 '7','m','F','1','4',"33,'[','0','m',"33,'[','4','C',"33,'[',
     #	 '1',';','7','m','H','e','l','p',"33,'[','0','m',' ',"33,'[',
     #	 '1',';','7','m',' ',' ','D','o',' ',' ',"33,'[','0','m',' ',
     #	 "33,'[','4','C',"33,'[','1',';','7','m','F','1','7',"33,'[',
     #	 '0','m',' ',"33,'[','1',';','7','m','F','1','8',"33,'[','0',
     #	 'm',' ',"33,'[','1',';','7','m','F','1','9',"33,'[','0','m',
     #	 ' ',"33,'[','1',';','7','m','F','2','0',"33,'[','0','m',"200/
	DATA CPRMPT /"33,'[','8',';','5','6','H',"33,'[','0','K',"200/
	DATA TFOREN /"7,"7,"33,'[','2',';','1','H',"33,'[','0','J',"33,
     #	 '[','5',';','1','9','H','T','h','i','s',' ','p','r','o','g',
     #	 'r','a','m',' ','h','a','s',' ','b','e','e','n',' ','d','e',
     #	 's','i','g','n','e','d',' ','f','o','r',' ','u','s','e',' ',
     #	 'o','n',"33,'[','7',';','2','9','H','V','T','2','0','0',' ',
     #	 's','e','r','i','e','s',' ','t','e','r','m','i','n','a','l',
     #	 's',"33,'[','9',';','1','9','H','w','i','t','h',' ','t','h',
     #	 'e',' ','U','s','e','r',' ','D','e','f','i','n','e','d',' ',
     #	 'K','e','y','s',' ','(','U','D','K',')',' ','f','e','a','t',
     #	 'u','r','e','.',"33,'[','1','4',';','1','9','H','T','h','i',
     #	 's',' ','t','e','r','m','i','n','a','l',' ','d','i','d',' ',
     #	 'n','o','t',' ','r','e','s','p','o','n','d',' ','a','s',' ',
     #	 'e','x','p','e','c','t','e','d','.',"33,'[','1','7',';','3',
     #	 '7','H',"33,'[','1','m','S','o','r','r','y',',',"33,'[','1',
     #	 '9',';','3','1','H','p','r','o','g','r','a','m',' ','m','u',
     #	 's','t',' ','a','b','o','r','t','.',"33,'[','0','m',"200/
	DATA UDKLKD /"7,"7,"33,'[','2',';','1','H',"33,'[','0','J',"33,
     #	 '[','5',';','2','7','H','T','h','e',' ','t','e','r','m','i',
     #	 'n','a','l',' ','r','e','p','o','r','t','s',' ','t','h','a',
     #	 't',"33,'[','7',';','2','2','H','i','t',"47,'s',' ','U','s',
     #	 'e','r',' ','D','e','f','i','n','e','d',' ','K','e','y',' ',
     #	 '(','U','D','K',')',' ','f','e','a','t','u','r','e',"33,'[',
     #	 '9',';','3','5','H','i','s',' ','l','o','c','k','e','d','.',
     #	 "33,'[','1','2',';','2','2','H','T','h','i','s',' ','m','u',
     #	 's','t',' ','b','e',' ','m','a','n','u','a','l','l','y',' ',
     #	 'r','e','s','e','t',' ','t','h','r','o','u','g','h',"33,'[',
     #	 '1','4',';','2','4','H','t','h','e',' ','t','e','r','m','i',
     #	 'n','a','l',"47,'s',' ','S','e','t','-','U','p',' ','p','r',
     #	 'o','c','e','d','u','r','e','.',"33,'[','1','7',';','3','7',
     #	 'H',"33,'[','1','m','S','o','r','r','y',',',"33,'[','1','9',
     #	 ';','3','1','H','p','r','o','g','r','a','m',' ','m','u','s',
     #	 't',' ','a','b','o','r','t','.',"33,'[','0','m',"200/
	DATA BADKEY /"7,"7,"33,'[','2',';','1','H',"33,'[','0','J',"33,
     #	 '[','9',';','1','4','H','A','n',' ','i','n','v','a','l','i',
     #	 'd',' ','U','D','K',' ','n','a','m','e',' ','w','a','s',' ',
     #	 'r','e','a','d',' ','f','r','o','m',' ','t','h','e',' ','i',
     #	 'n','p','u','t',' ','s','t','r','e','a','m','.',"33,'[','1',
     #	 '7',';','3','7','H',"33,'[','1','m','S','o','r','r','y',',',
     #	 "33,'[','1','9',';','3','1','H','p','r','o','g','r','a','m',
     #	 ' ','m','u','s','t',' ','a','b','o','r','t','.',"33,'[','0',
     #	 'm',"200/
	DATA ECONT  /"33,'[','0','m',"33,'[','2','2',';','2','7','H',
     #	 'P','r','e','s','s',' ',"33,'[','7','m','R','E','T','U','R',
     #	 'N',"33,'[','0','m',' ','t','o',' ','c','o','n','t','i','n',
     #	 'u','e','.',"33,'[','2','3',';','4','0','H',"200/
C
C	Initialize VT240 video terminal operation
C
	CALL PRINT(TM2007)  !Make sure that soft reset will work (VT240)
	CALL PRINT(SRESET)  !Request a VT240 soft reset
C
C	Identify the operating system
C
	STRING(1) = PID(27) !Enable use of SCOPY routine
	CALL SCOPY('RT-11',PID(22))
	RT11 = .TRUE.
	IF(MONTYP() .EQ. 0)  GO TO 1  !Skip if this is really RT-11
	RT11 = .FALSE.
	CALL SCOPY('TSX+ ',PID(22))
	CALL TSXSTU         !Enable TSX+ single character activation
    1	PID(27) = STRING(1)
	IF(RT11)  CALL FNCRLF   !Force monitor into NO_CRLF state
	EXTCDE = 1              !Set exit code status to SUCCS$
C
C	Determine if this task is running under control of
C	an RT-11 command file and that SET TT: QUIET has been set.
C
	CALL IDFSTS(QUIET)
	IF(QUIET)  GO TO 5
C
C	Initialize terminal operation
C
	CALL PRINT(INITRM)  !Define basic terminal operation states
C
C	Identify the program
C
	CALL PRINT(PID)
C
C	Identify the terminal and be sure UDK keys are unlocked
C
C	NOTE:  Not all VT2?? series terminals seem to reset themselves
C	       within the 0.5 second (30 ticks) allowed in the call to
C	       the ISLEEP subroutine.  If this  program fails when run
C	       from your VT2?? terminal with a report that it's a
C	       foreign device, increase the sleep time until it works.
C
    5	CALL ISLEEP(0,0,0,30)              !Ensure terminal has caught up
C
	I = KTRMID(10,TID,LPRVTE)
	IF(I .LE. 0)  GO TO 75             !Insist on a response
	IF(TID(1) .NE. 62)  GO TO 75       !Must be of VT200 series
	DO 1000 J = 2,I
	IF(TID(J) .EQ. 8)  GO TO 10        !Look for UDK capability
 1000	CONTINUE
	GO TO 75
   10	IF(UDKSTS()) 75,15,79              !UDK feature unlocked?
C
C	Clear all previous definitions?
C
   15	IF(QUIET)  GO TO 20
	CALL PRINT(CLUDKP)
	CALL PRINT(YESNOP)
   20	CALL GTLIN(STRING)
	IF(LEN(STRING).EQ.0 .OR. (STRING(1).NE.'Y'.AND.STRING(1).NE.'y'))
     #	 GO TO 25
	CALL PRINT(CLRUDK)
C
C	Query user for a key to program
C
   25	IF(QUIET)  GO TO 30
	CALL PRINT(CMENU1)
	CALL PRINT(CMENU2)
   30	IF(.NOT.QUIET)  CALL PRINT(CPRMPT)
	CALL GTLIN(STRING)
C
C	Validate and decode key name
C
	CALL SCRNCH(STRING,I)
	IF(I .EQ. 0)  GO TO 60
C-------- Protection from Command file lower case
	CALL TRANSL(STRING,STRING,'ABCDEFGHIJKLMNOPQRSTUVWXYZ',
     #	'abcdefghijklmnopqrstuvwxyz')
	IF(STRING(1) .EQ. 'F')  GO TO 40
	KP = 15
	IF(ISCOMP(STRING,'HELP') .EQ. 0)  GO TO 45
	KP = 16
	IF(ISCOMP(STRING,'DO') .EQ. 0)    GO TO 45
   35	IF(QUIET)  GO TO 90
	CALL PRINT(BEEP)
	GO TO 30
   40	IF(I .LT. 2 .OR. I .GT. 3)  GO TO 35
	DECODE(I-1,100,STRING(2),ERR=35)  KP
  100	FORMAT(I)
	IF(KP .LT. 6 .OR. KP .GT. 20)  GO TO 35
   45	KP = KP + 11
	IF(KP .GT. 21)  KP = KP + 1
	IF(KP .GT. 26)  KP = KP + 1
	IF(KP .GT. 29)  KP = KP + 1
	CALL SCOPY(PREAMB,BUFR)
	ENCODE(3,200,BUFR(7)) KP
  200	FORMAT(I2,'/')
	BUFR(10) = 0
	IF(.NOT.GETDEF(BUFR(10),QUIET))  GO TO 25 !Get new definition
	CALL CONCAT(BUFR,ST,BUFR)       !Add in string terminator
	CALL PRINT(BUFR)                !Send definition to the terminal
C
C	Note:  The VT240 Programmer's Reference Manual indicates that the
C	       terminal will lock the UDK keys if it notes an error in the
C	       definition string, or UDK capacity is exceeded.  The call
C	       to function UDKSTS is supposed to catch this an inform the
C	       user.  On my terminal, this never happens.  If the definitions
C	       overflow the 256 byte UDK buffer, the remainder of the
C	       definitions are accepted by the terminal but just ignored.
C
	IF(UDKSTS())  75,25,85          !Be sure the terminal accepted it
C
C	Program Termination Section
C
C	Lock against future definitions?
C
   60	IF(QUIET)  GO TO 65
	CALL PRINT(LKUDKP)
	CALL PRINT(YESNOP)
   65	CALL GTLIN(STRING)
	IF(LEN(STRING).EQ.0 .OR. (STRING(1).NE.'Y'.AND.STRING(1).NE.'y'))
     #	 GO TO 70
	CALL PRINT(LOKUDK)
   70	CALL IPOKEB("53,EXTCDE)         !Define monitor's User Error Byte
	IF(QUIET)  CALL EXIT
	CALL PRINT(INITRM)
	CALL PRINT(CLRHME)
	IF(RT11)  CALL ENCRLF           !Restore monitor's initial CRLF state
	CALL EXIT
C
C	Error Handler
C
   75	CALL PRINT(PID)
	CALL PRINT(TFOREN)
	GO TO 95
   79	EXTCDE = "10                    !Set exit code status to SEVER$
	IF(QUIET)  GO TO 70      !Gracefully exit, this is probably a re-boot
   80	CALL PRINT(PID)
	CALL PRINT(UDKLKD)
	GO TO 95
   85	CALL PRINT(PID)
	CALL PRINT(ERLOCK)
	GO TO 95
   90	CALL PRINT(PID)
	CALL PRINT(BADKEY)
   95	CALL GTLIN(STRING,ECONT)
	EXTCDE = "10                    !Set exit code status to SEVER$
	GO TO 70
	END
	INTEGER FUNCTION UDKSTS()
C
C	Query terminal to determine whether on not the UDK feature
C	has been locked against further change.
C	Function return value = -1  - No or bad response from terminal
C	                         0  - Unlocked
C	                        +1  - Locked
C
	INTEGER LESCSQ,I
	BYTE UDKQRY(7),STRING
	COMMON /UDK01/  STRING(82)
	DATA UDKQRY /"33,'[','?','2','5','n',"200/
	UDKSTS = -1                        !Assume no or bad response
	CALL PRINT(UDKQRY)                 !Ask "Are UDK's locked?"
	I = LESCSQ(STRING)                 !Accept response
	IF(I