Program Key;
 {[A+,B+,L-,K+,R+] Pasmat directive }

{  Program descriptor: This program may be used to program the function
   keys on a VT220 terminal.  Its function are as described below:

        >KEY F6=PA3 KEYS/ERR/NOWALK
        >KEY ?  - to obtain help 
        >KEY  - to be prompted for input 
        >KEY @  - to reprogram saved key definitions 
{

}
  { Last Edit: 29-SEP-1986 16:17:22 

    Author: Randy Baldwin
    Creation date: 5-JUN-1985 15:53:57 
    File spec: KEY.PAS
    Descr: VT2xx function key programmer.
    Version: 1.0.7
    History: 

     29-Sep-86.  Philip Hannay.  Modified to correct bug when 
       using indirect (@T acted the same as @).  Enhanced so that
       blank lines in KEYFILE.TXT are ignored and don't cause an
       error.

}

 %INCLUDE 'ex:[22,320]GENERAL3.TYP';
 %INCLUDE 'ex:[22,320]STRING.PKG';
 %INCLUDE 'EX:[22,320]CASTWO.EXT';


  PROCEDURE GMCR;
    EXTERNAL;

  VAR
    Fyle: TEXT;
    Inbuff: CH80;
    Sbuff: PACKED ARRAY [0..80] OF CHAR;
    Keybuf: CH4;
    Send: CH2;
    Search_String: PACKED ARRAY [0..1] OF CHAR;
    Count, Next, Len, x, i: INTEGER;
    Status, Index, F_key: INTEGER;
    Success: BOOLEAN;




  FUNCTION WHICH(VAR BUF: CH4): INTEGER;


    BEGIN
      CASE BUF[2] OF
        '2': i := 34; {F20}
        '6': i := 17; {F6}
        '7': i := 18; {F7}
        '8': i := 19; {F8}
        '9': i := 20; {F9}
        'O', 'o': i := 29; {DO}
        OTHERWISE i := - 1;
        END; {CASE}
      IF i = - 1 THEN
        BEGIN
        CASE BUF[3] OF
          '0': i := 21; {F10}
          '1': i := 23; {F11}
          '2': i := 24; {F12}
          '3': i := 25; {F13}
          '4': i := 26; {F14}
          'L', 'l': i := 28; {HELP}
          '7': i := 31; {F17}
          '8': i := 32; {F18}
          '9': i := 33; {F19}
          OTHERWISE i := - 1;
          END; {CASE}
        END;
      WHICH := i;
    END;



{----------------------------- FUNCTION HEX ---------------------------------}


  FUNCTION HEX(number: INTEGER): CH2;

    TYPE
      table_type = ARRAY [1..16] OF CHAR;

    VAR
      X1, X2: INTEGER;
      C1, C2: CHAR;
      temp: CH2;

    CONST
      table = table_type( { 0 } '0',
      {  1 } '1',
      {  2 } '2',
      {  3 } '3',
      {  4 } '4',
      {  5 } '5',
      {  6 } '6',
      {  7 } '7',
      {  8 } '8',
      {  9 } '9',
      { 10 } 'A',
      { 11 } 'B',
      { 12 } 'C',
      { 13 } 'D',
      { 14 } 'E',
      { 15 } 'F');


    BEGIN
      X1 := number DIV 16;
      X2 := number MOD 16;
      C1 := table[X1 + 1];
      C2 := table[X2 + 1];
      temp[1] := C1;
      temp[2] := C2;
      HEX := temp;
    END;


  PROCEDURE ASCHEX(WHAT: CHAR);


    BEGIN
      Send := HEX(ORD(WHAT));
    END;




  PROCEDURE HELP;


    BEGIN
      WRITELN;
WRITELN('  KEY - VT220 FUNCTION KEY PROGRAMMER PROGRAM -- HELP TEXT');
WRITELN;
WRITELN('  VT2XX function keys can be programmed.  This',
                ' applies only to the shifted');
WRITELN('  key (ie. <SHIFT><F7>).  Likewise, they cannot',
                 ' be programmed from set up,');
WRITELN('  but only from escape sequences sent to the',
                 ' terminal from the host.');
WRITELN('  The KEY program allows us to do this.  ');
WRITELN;
WRITELN('  You can invoke KEY in three modes.  One is',
                 ' to program your VT220 keys only,');
WRITELN('  another is to program both keys and save',
                 ' those commands is a text file, and');
WRITELN('  the third is to program the keys from commands',
                 ' in an existing text file.');
WRITELN;
WRITELN('  To program keys only, invoke KEY without',
                 ' a command line and then enter');
WRITELN('  the command after the prompt (ie. type "KEY" only).');
WRITELN;
WRITELN('  To program keys and save in text file called',
                 ' KEYFILE.TXT, type "KEY command"');
WRITELN('  where command is a valid key command.');
WRITELN;
WRITELN('  Finally, to use commands in an existing command',
                 ' file, type "KEY @filename"');
WRITELN('  where filename is a valid command file. ',
                 ' If you just type "KEY @", then');
WRITELN('  the filename "KEYFILE.TXT" will be assumed.',
                 '  This is handy if you wish');
WRITELN('  to have a KEYFILE.TXT is your login UFD that',
                 ' is invoked by your LOGIN.CMD');
WRITELN('  or if you want to switch from one group of',
                 ' keys to another by having');
WRITELN('  several command files like DTRKEY.TXT, MACROKEY.TXT,',
                 ' and PASCALKEY.TXT.');
WRITELN;
WRITELN('  KEY commands take the form "keyname=keydef"',
                 ' where keyname is a valid');
WRITELN('  VT220 key name from F6 thru f20, and HELP',
                 ' and DO, and keydef is the');
WRITELN('  string of characters that will be associated',
                 ' with the key.  The string');
WRITELN('  is not quoted, and can include non-printable',
                 ' characters by using the');
WRITELN('  Macro-11 type definition delimited by backslashes. ');
WRITELN;
WRITELN('  For example (double quotes delimit command',
                 ' and are not part of syntax):');
WRITELN;
WRITELN('    "F6=SHOW "');
WRITELN('    "F7=USERS\<13><12>\"');
WRITELN('    "F8=TERMINAL\<13><12>\"');
WRITELN('    "F9=RING BELL\<7><7><7><13><12>\"');
WRITELN('    "HELP=!SEE SYSTEM PROGRAMMER\<13><12>\"');
WRITELN;
WRITELN('  Note that the non-printable characters are',
                 ' indicated by their ascii');
WRITELN('  decimal number delimited by <>.  The nonprintable',
                 ' characters are then');
WRITELN('  delimited by backslashes (\).  Note that',
                 ' you can use EDT to imbed non');
WRITELN('  printable characters in the text of a command',
                 ' file without using this');
WRITELN('  above method of indicating nonprintable characters.  ');
WRITELN;
WRITELN('  This help file is invoked by typing "KEY ?"');
WRITELN;
      WRITELN;
    END;




  PROCEDURE DOPROG;

    VAR
      Match, Start, Stop, x: INTEGER;
      Hold: word;


    BEGIN
      Len := SLEN(Sbuff); {see how long the buffer is}
      Search_String[0] := CHR(1);
      Search_String[1] := '='; {look for an = sign in buff}
      Next := SSEARCH(Sbuff, Search_String, 1);
      IF (Next <= 5) AND (Next <> 0) THEN {if zero no find, must be <= 5 for
                                           valid keyname}
        BEGIN
        FOR x := Index TO Next - 1 DO Keybuf[x] := Sbuff[x];
        F_key := WHICH(Keybuf);
        END
      ELSE Success := FALSE;
      IF (NOT Success) OR (F_key = - 1) THEN
        BEGIN
        Success := FALSE;
        WRITELN(' ***  KEY> Unrecognized command, process aborted.');
        END
      ELSE
        BEGIN
        Start := 1;
        WRITE(CHR(144), '1;1|', F_key: 1, '/');
        x := Index + Next;
        REPEAT
          BEGIN
          IF Sbuff[x] <> '\' THEN
            BEGIN
            ASCHEX(Sbuff[x]);
            WRITE(Send);
            END
          ELSE
            BEGIN
            x := x + 1; {skip first \}
            Search_String[0] := CHR(1);
            Search_String[1] := '\'; {look for a matching \ in buff}
            Match := SSEARCH(Sbuff, Search_String, x);
            IF Match = 0 THEN
              BEGIN
              x := Len;
              WRITELN(CHR(156));
              WRITELN(' *** KEY>  Syntax error, No matching \ character.');
              END
            ELSE
              BEGIN
              WHILE (Sbuff[x] <> '\') AND (x < Len) DO
                BEGIN
                Search_String[0] := CHR(1);
                Search_String[1] := '<'; {look for an < sign in buff}
                Start := SSEARCH(Sbuff, Search_String, Start);
                Search_String[1] := '>'; {look for an > sign in buff}
                Stop := SSEARCH(Sbuff, Search_String, Start);
                IF Stop = 0 THEN
                  BEGIN
                  WRITELN(CHR(156));
                  WRITELN(' *** KEY>  Syntax Error, No matching > sign.');
                  x := Len;
                  END
                ELSE
                  BEGIN
                  Start := Start + 1;
                  Castwo(Sbuff, Hold, Start, 10);
                  Send := HEX(Hold);
                  WRITE(Send);
                  Start := Stop + 1;
                  x := Start;
                  END;
                END;
              END;
            END;
          x := x + 1;
          Count := Count + 2;
          END;
        UNTIL x > Len;
        WRITELN(CHR(156));
        END;
    END;




  PROCEDURE INDIRECT;

    VAR
      x, Start, span: INTEGER;
      fylename: CH13;


    BEGIN
      Start := 6;
      span := SLEN(Inbuff);
      IF span >= 6 THEN ssubstr(fylename, Inbuff, Start, span)
      ELSE sassign(fylename, 'KEYFILE.TXT');
      Count := 0;
      CLOSE(Fyle);
      RESET(Fyle, fylename, , Status);
      IF Status <> 1 THEN
        WRITELN(' *** KEY>  Unable to open file. Process aborted.')
      ELSE
        BEGIN
        WRITELN('  The following keys are being restored: ');
        WHILE NOT EOF(Fyle) DO
          BEGIN
          SREAD(Fyle, Sbuff);
          Len := SLEN(Sbuff);
          IF Len > 0 THEN
            BEGIN
            WRITE(' **  ');
            FOR x := 1 TO ORD(Sbuff[0]) DO WRITE(Sbuff[x]);
            IF Count + Len > 256 THEN
              WRITELN(' BUFFER OVERFLOW, UNABLE TO PROGRAM ALL STORED COMMANDS')
            ELSE
              BEGIN
              Index := 1;
              DOPROG;
              END;
            END;
          END;
        END;
    END;




  PROCEDURE DIRECT;

    VAR
      x: INTEGER;


    BEGIN
      WRITELN(' ENTER KEY AND STRING TO');
      WRITE('           PROGRAM [F20=FUBAR]: ');
      SREAD(INPUT, Inbuff);
      ssubstr(Sbuff, Inbuff, 1, 80);
      Index := 1;
      DOPROG;
    END;




  BEGIN
    Success := TRUE;
    FOR x := 1 TO 80 DO Sbuff[x] := CHR(0);
    SCLEAR(Inbuff);
    SCLEAR(Sbuff);
    GMCR;
    Index := 5;
    SREAD(INPUT, Inbuff);
    IF Inbuff[4] = CHR(0) THEN Inbuff[Index] := 'P';
    CASE Inbuff[Index] OF
      '@': INDIRECT;
      '?': HELP;
      'P': DIRECT;
      'F', 'H', 'D', 'f', 'h', 'd':
        BEGIN
        RESET(Fyle, 'KEYFILE.TXT/RW/APD', , Status);
        IF Status = - 1 THEN REWRITE(Fyle, 'KEYFILE.TXT/RW/APD', , Status);
        ssubstr(Sbuff, Inbuff, 5, 80);
        Index := 1;
        DOPROG;
        IF Success THEN
          BEGIN
          SWRITE(Fyle, Sbuff);
          WRITELN(Fyle);
          END;
        END;
      OTHERWISE
        BEGIN
        Success := FALSE;
        HELP;
        END;
      END; {case}
    CLOSE(Fyle);
  END.