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,TCFL.CSL/I/W C $SHORT C C ^C C C Author: S.C. Cribbs 85/01/22 C Atomic Energy of Canada Limited C Pinawa, Manitoba C Canada R0E 1L0 C INTEGER TID(10),I,J,KP,KTRMID,LPRVTE,UDKSTS LOGICAL*1 GETDEF BYTE INITRM(20),TM2007(9),SRESET(5),TFOREN(237),ERLOCK(251) BYTE STRING,ECONT,CLRHME(11),PID(41),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) COMMON /UDK01/ STRING(82) COMMON /UDK02/ ECONT(54) COMMON /UDK03/ YESNOP(112) DATA SRESET /"33,'[','!','p',"200/ !VT240 soft reset 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',' ','1','.','1',"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 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 or VT100 video terminal operation C CALL PRINT(TM2007) !Make sure that soft reset will work (VT240) CALL PRINT(SRESET) !Request a VT240 soft reset CALL PRINT(TM2007) !Ensure reset didn't leave TTY in VT100 mode CALL PRINT(INITRM) C C Implement non-terminating .GTLIN and turn off SL: (RT11.V5) C CALL IPOKE(JSW,IPEEK(JSW) .OR. "30) C C Identify the program C CALL PRINT(PID) C C Identify the terminal and be sure UDK keys are unlocked C CALL ISLEEP(0,0,0,30) !Ensure terminal has caught up I = KTRMID(10,TID,LPRVTE) IF(I .LE. 0) GO TO 70 !Insist on a response IF(TID(1) .NE. 62) GO TO 70 !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 70 10 IF(UDKSTS()) 70,15,75 !UDK feature unlocked? 15 CALL PRINT(CLUDKP) !Clear all previous definitions? CALL GTLIN(STRING,YESNOP) IF(LEN(STRING).EQ.0 .OR. STRING(1).NE.'Y') GO TO 20 CALL PRINT(CLRUDK) C C Query user for a key to program C 20 CALL PRINT(CMENU1) CALL PRINT(CMENU2) 25 CALL GTLIN(STRING,CPRMPT) C C Validate and decode key name C CALL SCRNCH(STRING,I) IF(I .EQ. 0) GO TO 60 IF(STRING(1) .EQ. 'F') GO TO 35 KP = 15 IF(ISCOMP(STRING,'HELP') .EQ. 0) GO TO 40 KP = 16 IF(ISCOMP(STRING,'DO') .EQ. 0) GO TO 40 30 CALL PRINT(BEEP) GO TO 25 35 IF(I .LT. 2 .OR. I .GT. 3) GO TO 30 DECODE(I-1,100,STRING(2),ERR=30) KP 100 FORMAT(I) IF(KP .LT. 6 .OR. KP .GT. 20) GO TO 30 40 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))) GO TO 20 !Query user for new definition CALL CONCAT(BUFR,ST,BUFR) !Add in string terminator CALL PRINT(BUFR) !Send definition to the terminal IF(UDKSTS()) 70,20,80 !Be sure the terminal accepted it C C Program Termination Section C 60 CALL PRINT(LKUDKP) !Lock against future definitions? CALL GTLIN(STRING,YESNOP) IF(LEN(STRING).EQ.0 .OR. STRING(1).NE.'Y') GO TO 65 CALL PRINT(LOKUDK) 65 CALL PRINT(SRESET) CALL PRINT(CLRHME) CALL EXIT C C Error Handler C 70 CALL PRINT(TFOREN) GO TO 95 75 CALL PRINT(UDKLKD) GO TO 95 80 CALL PRINT(ERLOCK) 95 CALL GTLIN(STRING,ECONT) GO TO 65 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 .LE. 0) RETURN IF(STRING(2).NE.'[' .OR. STRING(3).NE.'?' .OR. # STRING(4).NE.'2' .OR. STRING(6).NE. 'n') RETURN IF(STRING(5) .EQ. '0') UDKSTS = 0 !UDK keys are unlocked IF(STRING(5) .EQ. '1') UDKSTS = 1 !UDK feature locked RETURN END