MODULE ram$create_key_definitions;
?? RIGHT := 110 ??
?? PUSH (LISTEXT := ON) ??
*copyc amp$close
*copyc amp$get_segment_pointer
*copyc amp$get_next
*copyc amp$open
*copyc amp$put_next
*copyc amp$set_segment_eoi

*copyc clp$end_scan_command_file
*copyc clp$get_value
*copyc clp$pop_utility
*copyc clp$push_utility
*copyc clp$scan_command_file
*copyc clp$scan_parameter_list
*copyc clp$test_parameter

*copyc ifp$store_term_conn_attributes

*copyc osp$set_status_abnormal

*copyc osv$lower_to_upper

*copyc pmp$manage_sense_switches
?? POP ??

  CONST
    next_key = 18;

  TYPE
    key_def = record
      definition: string (64),
      def_length: 0 .. 64,
      carriage_return,
      half_duplex,
      hex_input,
      defined: boolean,
      label: string (7),
    recend,
    key_set = record
      include_screen_edit: boolean,
      mk,
      ck: 0 .. 45,
      defs: array [1 .. 45] of key_def,
      include_screen_scroll: boolean,
      fk,
      bk: 0 .. 45,
    recend,
    out_def_rec = packed record
      prefix: string (8),
      define: string (132),
    recend;

  VAR
    backward_key,
    copy_key,
    forward_key,
    mark_key : 0 .. 45 := 0,
    on,
    off,
    current: pmt$sense_switches,
    version_conflict,
    version_4 : boolean,

    address: amt$file_byte_address,
    command_file: amt$local_file_name := clc$current_command_input,
    def_in: ^key_set,
    def_out: out_def_rec,
    place : integer,
    fid: amt$file_identifier,
    file_in: amt$local_file_name,
    file_out: amt$local_file_name := clc$standard_output,
    seg_ptr: amt$segment_pointer,
    tfid: amt$file_identifier,
    vkx_utility_name: string (31) := 'DEFINE_VKX_KEYS                ',
    vkx_prompt_string: string (3) := 'DVK';
?? NEWTITLE := '******  output_def_prolog  ******', EJECT ??
  PROCEDURE output_def_prolog (VAR status: ost$status);

{  This procedure does the following :
{   Clear all host loaded codes - 1e,2e
{   Disable keyboard            - 1e,12,4d
{   Normal numeric keypad       - 1e,12,6c
{   Disable CR delimiter        - 1e,12,5a

    VAR
      i: integer,
      prolog_str: string (14),
      prolog_table: [STATIC] array [1 .. 14] of 0 .. 0ff(16) := [ 1e(16), 2e(16), 1e(16), 2e(16),
                  1e(16), 12(16), 4d(16), 1e(16), 12(16), 6c(16), 1e(16), 12(16), 5a(16), 0d(16)];


    FOR i := 1 TO 14 DO
      prolog_str (i) := $CHAR (prolog_table [i]);
    FOREND;
    amp$put_next (tfid, #LOC (prolog_str), #SIZE (prolog_str), address, status);

  PROCEND output_def_prolog;
?? OLDTITLE ??
?? NEWTITLE := '******  load_controlware_programs  ******', EJECT ??
  PROCEDURE load_controlware_programs (VAR status: ost$status);

    VAR
      i: integer, { cd 42 }
      routine_str: string (291),

{  The values placed in the following variables are obtained by assembling
{  the deck VKM$VIKING_CONTROLWARE.
{
{  The values are listed with the load address followed by the binary for
{  the routine.

      push_routine_table: [STATIC] array [1 .. 25] of 0 .. 0ff(16) := [0d0(16), 000(16),
        011(16), 041(16), 0D0(16), 001(16), 0F3(16), 000(16), 021(16), 0E0(16), 0D7(16), 0ED(16), 0B0(16),
        03A(16), 047(16), 0E0(16), 032(16), 034(16), 0D1(16), 03A(16), 0B9(16), 0E0(16), 032(16), 035(16),
        0D1(16)],
      term_setup_table: [STATIC] array [1 .. 20] of 0 .. 0ff(16) := [0d0(16), 017(16),
        0AF(16), 032(16), 0B9(16), 0E0(16), 001(16), 0F2(16), 000(16), 021(16), 0E0(16), 0D7(16), 011(16),
        0E1(16), 0D7(16), 036(16), 030(16), 0ED(16), 0B0(16), 0C9(16)],
      pop_routine_table: [STATIC] array [1 .. 26] of 0 .. 0ff(16) := [0D0(16), 029(16),
        021(16), 041(16), 0D0(16), 001(16), 0F3(16), 000(16), 011(16), 0E0(16), 0D7(16), 0ED(16), 0B0(16),
        03A(16), 034(16), 0D1(16), 032(16), 047(16), 0E0(16), 03A(16), 035(16), 0D1(16), 032(16), 0B9(16),
        0E0(16), 0C9(16)],
      mark_routine_table: [STATIC] array [1 .. 120] of 0 .. 0ff(16) := [0d1(16), 038(16),
        0CD(16), 04D(16), 0D1(16), 03A(16), 0B5(16), 0E0(16), 0A7(16), 020(16), 045(16), 03A(16), 0E6(16),
        0E0(16), 0A7(16), 028(16), 019(16), 03E(16), 0FF(16), 032(16), 032(16), 0D2(16), 0C9(16), 0CD(16),
        02D(16), 0D2(16), 0F8(16), 0CD(16), 019(16), 0D2(16), 03D(16), 032(16), 032(16), 0D2(16), 023(16),
        0CB(16), 096(16), 023(16), 015(16), 020(16), 0F9(16), 0C9(16), 0CD(16), 02D(16), 0D2(16), 0F2(16),
        068(16), 0D1(16), 03E(16), 01D(16), 047(16), 0CD(16), 019(16), 0D2(16), 0AF(16), 023(16), 0CB(16),
        06E(16), 028(16), 003(16), 0CB(16), 0D6(16), 03C(16), 023(16), 015(16), 020(16), 0F4(16), 0A7(16),
        020(16), 005(16), 005(16), 078(16), 0F2(16), 069(16), 0D1(16), 078(16), 032(16), 032(16), 0D2(16),
        0C9(16), 0CD(16), 02D(16), 0D2(16), 0F2(16), 08E(16), 0D1(16), 03E(16), 01D(16), 047(16), 032(16),
        032(16), 0D2(16), 0F8(16), 0CD(16), 019(16), 0D2(16), 0CD(16), 023(16), 0D2(16), 02B(16), 0BE(16),
        020(16), 008(16), 02B(16), 015(16), 020(16), 0F8(16), 078(16), 03D(16), 018(16), 0E9(16), 023(16),
        0CB(16), 0D6(16), 02B(16), 02B(16), 015(16), 020(16), 0F9(16), 0C9(16)],
      copy_routine_table: [STATIC] array [1 .. 97] of 0 .. 0ff(16) := [0d1(16), 0ae(16),
        03A(16), 0E6(16), 0E0(16), 0A7(16), 020(16), 039(16), 03A(16), 0B5(16), 0E0(16), 0A7(16), 020(16),
        03D(16), 0CD(16), 02D(16), 0D2(16), 0F8(16), 0CD(16), 019(16), 0D2(16), 023(16), 0CB(16), 056(16),
        020(16), 007(16), 023(16), 015(16), 020(16), 0F7(16), 0C3(16), 047(16), 0D1(16), 0CB(16), 096(16),
        02B(16), 046(16), 0D5(16), 03A(16), 0A9(16), 0E0(16), 0F5(16), 0F6(16), 020(16), 032(16), 0A9(16),
        0E0(16), 0C5(16), 0CD(16), 039(16), 000(16), 0C1(16), 0F1(16), 032(16), 0A9(16), 0E0(16), 0CD(16),
        087(16), 000(16), 0D1(16), 015(16), 0CA(16), 047(16), 0D1(16), 0C9(16), 0CD(16), 0BA(16), 0D1(16),
        0CD(16), 02D(16), 0D2(16), 0F2(16), 0ED(16), 0D1(16), 0C9(16), 0CD(16), 02D(16), 0D2(16), 0F8(16),
        0CD(16), 019(16), 0D2(16), 023(16), 0CB(16), 056(16), 028(16), 003(16), 0CB(16), 096(16), 0C9(16),
        023(16), 015(16), 0CA(16), 047(16), 0D1(16), 018(16), 0F1(16)],
      next_routine_table: [STATIC] array [1 .. 40] of 0 .. 0ff(16) := [0d2(16), 00d(16),
        0CD(16), 04D(16), 0D1(16), 006(16), 00D(16), 0CD(16), 087(16), 000(16), 0CD(16), 039(16), 000(16),
        0C9(16), 06F(16), 026(16), 0E0(16), 0CD(16), 03F(16), 000(16), 0EB(16), 016(16), 084(16), 0C9(16),
        0D5(16), 011(16), 007(16), 001(16), 0ED(16), 05A(16), 0D1(16), 03E(16), 020(16), 0C9(16), 03A(16),
        032(16), 0D2(16), 0A7(16), 0C9(16), 0FF(16)],
      scroll_routine_table: [STATIC] array [1 .. 143] of 0 .. 0ff(16) := [0D2(16), 035(16),
        03E(16), 01C(16), 0CD(16), 054(16), 0D3(16), 03E(16), 062(16), 011(16), 000(16), 040(16), 021(16),
        0F2(16), 040(16), 001(16), 008(16), 001(16), 0EB(16), 073(16), 023(16), 072(16), 023(16), 0EB(16),
        0ED(16), 04A(16), 03D(16), 020(16), 0F5(16), 011(16), 0F3(16), 040(16), 021(16), 0F2(16), 040(16),
        001(16), 008(16), 064(16), 036(16), 020(16), 0ED(16), 0B0(16), 021(16), 000(16), 0E0(16), 0CD(16),
        03F(16), 000(16), 021(16), 051(16), 0D3(16), 07B(16), 0BE(16), 028(16), 012(16), 0EB(16), 022(16),
        051(16), 0D3(16), 0CD(16), 088(16), 0D2(16), 02A(16), 051(16), 0D3(16), 011(16), 054(16), 0D3(16),
        001(16), 008(16), 001(16), 0ED(16), 0B0(16), 0CD(16), 0A5(16), 000(16), 03A(16), 0D6(16), 0D8(16),
        0A7(16), 020(16), 0D8(16), 0C3(16), 033(16), 000(16), 03A(16), 053(16), 0D3(16), 0FE(16), 061(16),
        028(16), 00B(16), 0CD(16), 0B2(16), 0D2(16), 03A(16), 053(16), 0D3(16), 03C(16), 032(16), 053(16),
        0D3(16), 0C9(16), 021(16), 000(16), 040(16), 054(16), 05D(16), 04E(16), 023(16), 046(16), 0C5(16),
        023(16), 001(16), 0C2(16), 000(16), 0ED(16), 0B0(16), 0E1(16), 07D(16), 012(16), 013(16), 07C(16),
        012(16), 0EB(16), 018(16), 007(16), 007(16), 06F(16), 026(16), 040(16), 05E(16), 023(16), 056(16),
        021(16), 054(16), 0D3(16), 001(16), 008(16), 001(16), 0ED(16), 0B0(16), 0C9(16)],
      fwd_routine_table: [STATIC] array [1 .. 70] of 0 .. 0ff(16) := [ 0D2(16), 0C2(16),
        03A(16), 053(16), 0D3(16), 0FE(16), 061(16), 0C8(16), 03C(16), 007(16), 06F(16), 026(16), 040(16),
        05E(16), 023(16), 056(16), 0D5(16), 021(16), 000(16), 0E0(16), 0CD(16), 03F(16), 000(16), 0EB(16),
        011(16), 054(16), 0D3(16), 001(16), 008(16), 001(16), 0ED(16), 0B0(16), 0CD(16), 081(16), 000(16),
        021(16), 01D(16), 0E0(16), 0CD(16), 03F(16), 000(16), 0E1(16), 0E5(16), 001(16), 008(16), 001(16),
        0ED(16), 0B0(16), 0D1(16), 0CD(16), 0B9(16), 0D2(16), 021(16), 000(16), 0E0(16), 0CD(16), 03F(16),
        000(16), 0EB(16), 022(16), 051(16), 0D3(16), 03A(16), 053(16), 0D3(16), 03C(16), 032(16), 053(16),
        0D3(16), 0C9(16)],
      bkw_routine_table: [STATIC] array [1 .. 80] of 0 .. 0ff(16) := [ 0D3(16), 006(16),
        03A(16), 053(16), 0D3(16), 0A7(16), 0CA(16), 033(16), 000(16), 007(16), 06F(16), 026(16), 040(16),
        05E(16), 023(16), 056(16), 0D5(16), 021(16), 01D(16), 0E0(16), 0CD(16), 03F(16), 000(16), 0EB(16),
        011(16), 054(16), 0D3(16), 001(16), 008(16), 001(16), 0ED(16), 0B0(16), 03A(16), 0BF(16), 0E0(16),
        0F5(16), 03E(16), 002(16), 032(16), 0BF(16), 0E0(16), 0CD(16), 081(16), 000(16), 0F1(16), 032(16),
        0BF(16), 0E0(16), 021(16), 000(16), 0E0(16), 0CD(16), 03F(16), 000(16), 0EB(16), 022(16), 051(16),
        0D3(16), 0EB(16), 0E1(16), 0E5(16), 001(16), 008(16), 001(16), 0ED(16), 0B0(16), 0D1(16), 03A(16),
        053(16), 0D3(16), 03D(16), 032(16), 053(16), 0D3(16), 0C3(16), 0B9(16), 0D2(16), 010(16), 0E1(16),
        000(16)],
      CFR_routine_table: [STATIC] array [1 .. 56] of 0 .. 0ff(16) := [ 0D3(16), 054(16),
        0D3(16), 070(16), 03A(16), 000(16), 0AF(16), 0FE(16), 0C3(16), 020(16), 01E(16), 021(16), 084(16),
        0B3(16), 022(16), 0DD(16), 0D1(16), 022(16), 016(16), 0D2(16), 021(16), 0C8(16), 0BC(16), 022(16),
        0E5(16), 0D1(16), 022(16), 013(16), 0D2(16), 021(16), 0D8(16), 0BA(16), 022(16), 07D(16), 0D2(16),
        021(16), 080(16), 0D3(16), 0C3(16), 063(16), 000(16), 021(16), 085(16), 0D3(16), 018(16), 0F8(16),
        01E(16), 012(16), 065(16), 032(16), 0FF(16), 01E(16), 012(16), 065(16), 031(16), 0FF(16)];

    routine_str (1) := $CHAR (1e(16));
    routine_str (2) := $CHAR (09(16));
    routine_str (3) := $CHAR (7f(16)); { controlware definition }
    routine_str (4) := '2';
    IF def_in^.include_screen_scroll THEN
      FOR i := 1 TO 56 DO
        routine_str (2 * i + 3) := $CHAR (CFR_routine_table [i] DIV 10(16) + 20(16));
        routine_str (2 * i + 4) := $CHAR (CFR_routine_table [i] MOD 10(16) + 60(16));
      FOREND;
      routine_str (117) := $CHAR (0d(16));
      amp$put_next (tfid, #LOC (routine_str), 117, address, status);
      FOR i := 1 TO 143 DO
        routine_str (2 * i + 3) := $CHAR (scroll_routine_table [i] DIV 10(16) + 20(16));
        routine_str (2 * i + 4) := $CHAR (scroll_routine_table [i] MOD 10(16) + 60(16));
      FOREND;
      routine_str (291) := $CHAR (0d(16));
      amp$put_next (tfid, #LOC (routine_str), 291, address, status);
      turn_on_light(3,1, status);

      routine_str (3) := $CHAR (def_in^.fk + 30(16));
      FOR i := 1 TO 70 DO
        routine_str (2 * i + 3) := $CHAR (fwd_routine_table [i] DIV 10(16) + 20(16));
        routine_str (2 * i + 4) := $CHAR (fwd_routine_table [i] MOD 10(16) + 60(16));
      FOREND;
      routine_str (145) := $CHAR (0d(16));
      amp$put_next (tfid, #LOC (routine_str), 145, address, status);
      turn_on_light(2,3, status);

      routine_str (3) := $CHAR (def_in^.bk + 30(16));
      FOR i := 1 TO 80 DO
        routine_str (2 * i + 3) := $CHAR (bkw_routine_table [i] DIV 10(16) + 20(16));
        routine_str (2 * i + 4) := $CHAR (bkw_routine_table [i] MOD 10(16) + 60(16));
      FOREND;
      routine_str (165) := $CHAR (0d(16));
      amp$put_next (tfid, #LOC (routine_str), 165, address, status);
      turn_on_light(1,2, status);
    IFEND;

    IF def_in^.include_screen_edit THEN
      routine_str (3) := $CHAR (def_in^.mk + 30(16));
      FOR i := 1 TO 120 DO
        routine_str (2 * i + 3) := $CHAR (mark_routine_table [i] DIV 10(16) + 20(16));
        routine_str (2 * i + 4) := $CHAR (mark_routine_table [i] MOD 10(16) + 60(16));
      FOREND;
      routine_str (245) := $CHAR (0d(16));
      amp$put_next (tfid, #LOC (routine_str), 245, address, status);
      turn_on_light(3,1, status);

      routine_str (3) := $CHAR (def_in^.ck + 30(16));
      FOR i := 1 TO 97 DO
        routine_str (2 * i + 3) := $CHAR (copy_routine_table [i] DIV 10(16) + 20(16));
        routine_str (2 * i + 4) := $CHAR (copy_routine_table [i] MOD 10(16) + 60(16));
      FOREND;
      routine_str (199) := $CHAR (0d(16));
      amp$put_next (tfid, #LOC (routine_str), 199, address, status);
      turn_on_light(2,3, status);

      routine_str (3) := $CHAR (next_key + 30(16));
      FOR i := 1 TO 40 DO
        routine_str (2 * i + 3) := $CHAR (next_routine_table [i] DIV 10(16) + 20(16));
        routine_str (2 * i + 4) := $CHAR (next_routine_table [i] MOD 10(16) + 60(16));
      FOREND;
      routine_str (85) := $CHAR (0d(16));
      amp$put_next (tfid, #LOC (routine_str), 85, address, status);
      turn_on_light(1,2, status);
    IFEND;

    routine_str (3) := 'p';
    FOR i := 1 TO 25 DO
      routine_str (2 * i + 3) := $CHAR (push_routine_table [i] DIV 10(16) + 20(16));
      routine_str (2 * i + 4) := $CHAR (push_routine_table [i] MOD 10(16) + 60(16));
    FOREND;
    routine_str (55) := $CHAR (0d(16));
    amp$put_next (tfid, #LOC (routine_str), 55, address, status);
    turn_on_light(3,1, status);

    routine_str (3) := 'r';
    FOR i := 1 TO 20 DO
      routine_str (2 * i + 3) := $CHAR (term_setup_table [i] DIV 10(16) + 20(16));
      routine_str (2 * i + 4) := $CHAR (term_setup_table [i] MOD 10(16) + 60(16));
    FOREND;
    routine_str (45) := $CHAR (0d(16));
    amp$put_next (tfid, #LOC (routine_str), 45, address, status);
    turn_on_light(2,3, status);

    routine_str (3) := 'q';
    FOR i := 1 TO 26 DO
      routine_str (2 * i + 3) := $CHAR (pop_routine_table [i] DIV 10(16) + 20(16));
      routine_str (2 * i + 4) := $CHAR (pop_routine_table [i] MOD 10(16) + 60(16));
    FOREND;
    routine_str (57) := $CHAR (0d(16));
    amp$put_next (tfid, #LOC (routine_str), 57, address, status);
    turn_on_light(1,2, status);

  PROCEND load_controlware_programs;
?? OLDTITLE ??
?? NEWTITLE := '******  turn on light  ******', EJECT ??
  PROCEDURE turn_on_light (on_light, off_light : 0 .. 3; VAR status : ost$status);

    VAR
      light_string : string(8);

    light_string(1) := $char(1e(16));
    light_string(2) := $char(12(16));
    light_string(3) := 'e';
    light_string(4) := $char(on_light + 30(16));
    light_string(5) := $char(1e(16));
    light_string(6) := $char(12(16));
    light_string(7) := 'f';
    light_string(8) := $char(off_light + 30(16));
    amp$put_next (tfid, #LOC (light_string), #SIZE (light_string), address, status);

  PROCEND turn_on_light;
?? OLDTITLE ??
?? NEWTITLE := '******  activate controlware  ******', EJECT ??
  PROCEDURE activate_controlware (VAR status: ost$status);

    VAR
      routine_str: string (4);


    turn_on_light(1,1, status);

    routine_str (1) := $CHAR (1e(16));
    routine_str (2) := $CHAR (12(16));
    routine_str (4) := $CHAR (0d(16));

{ enable keyboard }
    routine_str (3) := 'N';
    amp$put_next (tfid, #LOC (routine_str), 4, address, status);

{ activate monitor function for scrolling }
    routine_str (3) := $CHAR (7f(16));
    amp$put_next (tfid, #LOC (routine_str), 4, address, status);


  PROCEND activate_controlware;
?? OLDTITLE ??
?? NEWTITLE := '******  convert_normal_def  ******', EJECT ??
  PROCEDURE convert_normal_def (key: 1 .. 45);

    VAR
      pos: 1 .. 64;


    pos := 1;
    place := 1;
    REPEAT
      def_out.define (place) := $CHAR ($INTEGER (def_in^.defs [key].definition (pos)) DIV 10(16) + 20(16));
      def_out.define (place + 1) := $CHAR ($INTEGER (def_in^.defs [key].definition (pos)) MOD 10(16) +
            60(16));
      place := place + 2;
      pos := pos + 1;
    UNTIL def_in^.defs [key].def_length < pos;

    IF def_in^.defs [key].carriage_return THEN
      def_out.define (place) := ' ';
      def_out.define (place + 1) := 'm';
      place := place + 2;
    IFEND;

  PROCEND convert_normal_def;
?? OLDTITLE ??
?? NEWTITLE := '******  convert_hex_def  ******', EJECT ??
  PROCEDURE convert_hex_def (key: 1 .. 45);

    VAR
      pos: 1 .. 64;


    pos := 1;
    place := 1;
    WHILE def_in^.defs [key].def_length >= pos DO
      IF (def_in^.defs [key].definition (pos) >= '0') AND (def_in^.defs [key].definition (pos) <= '9') THEN
        def_out.define (place) := $CHAR ($INTEGER (def_in^.defs [key].definition (pos)) - 10(16));
      ELSEIF (def_in^.defs [key].definition (pos) >= 'A') AND (def_in^.defs [key].definition (pos) <= 'F')
            THEN
        def_out.define (place) := $CHAR ($INTEGER (def_in^.defs [key].definition (pos)) - 17(16));
      ELSE
        RETURN
      IFEND;
      pos := pos + 1;
      place := place + 1;
      IF (def_in^.defs [key].definition (pos) >= '0') AND (def_in^.defs [key].definition (pos) <= '9') THEN
        def_out.define (place) := $CHAR ($INTEGER (def_in^.defs [key].definition (pos)) + 30(16));
      ELSEIF (def_in^.defs [key].definition (pos) >= 'A') AND (def_in^.defs [key].definition (pos) <= 'F')
            THEN
        def_out.define (place) := $CHAR ($INTEGER (def_in^.defs [key].definition (pos)) + 29(16));
      ELSE
        RETURN
      IFEND;
      pos := pos + 1;
      place := place + 1;
    WHILEND;

  PROCEND convert_hex_def;
?? OLDTITLE ??
?? NEWTITLE := '******  test_revision_number  ******', EJECT ??
  PROCEDURE test_revision_number (VAR status : ost$status);

    VAR
      bytes : amt$transfer_count,
      cfid: amt$file_identifier,
      position : amt$file_position,
      model_report : string(42),
      prompt_string : array [1..1] of ift$connection_attribute,
      model_report_request : string(4);


    amp$open (clc$job_input, amc$record, NIL, cfid, status);
    model_report_request  :=', C0';
    model_report_request (2) := CHR (1e(16));
    prompt_string[1].key := ifc$prompt_string;
    prompt_string[1].prompt_string.size := 4;
    prompt_string[1].prompt_string.value := model_report_request;
    ifp$store_term_conn_attributes (cfid, prompt_string, status);
    amp$get_next (cfid, #LOC (model_report), #SIZE (model_report), bytes, address, position, status);
    IF bytes < 40 THEN
      osp$set_status_abnormal ('VK', 0, 'Terminal does not respond as a 721', status);
      RETURN
    IFEND;

    version_4 := model_report (41) = '4';

  PROCEND test_revision_number;
?? OLDTITLE ??
?? NEWTITLE := '******  rap$load_keys  ******', EJECT ??
  PROCEDURE [XDCL, #GATE] rap$load_keys (parameter_list: clt$parameter_list;
    VAR status: ost$status);

{ PDT load_keys_pdt (
{   input, i : file = $local.key_definitions
{   status)

?? PUSH (LISTEXT := ON) ??
    VAR
      load_keys_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^load_keys_pdt_names,
        ^load_keys_pdt_params];
    VAR
      load_keys_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of
        clt$parameter_name_descriptor := [['INPUT', 1], ['I', 1], ['STATUS', 2]];
    VAR
      load_keys_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 2] of clt$parameter_descriptor := [
{ INPUT I }
      [[clc$optional_with_default, ^load_keys_pdt_dv1], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
        clc$file_value]],
{ STATUS }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
        clc$array_not_allowed, clc$status_value]]];
    VAR
      load_keys_pdt_dv1: [STATIC, READ, cls$pdt_names_and_defaults] string (22) := '$local.key_definitions';
?? POP ??

    VAR
      byte_count: [STATIC] 2 .. 0fff(16) := 2,
      key: 1 .. 45,
      transparent : array [1..3] of ift$connection_attribute,
      acc_sel: amt$file_access_selections,
      parameter: clt$value;


    status.normal := TRUE;
    on := $pmt$sense_switches [];
    off := $pmt$sense_switches [];
    pmp$manage_sense_switches (on, off, current, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;

    IF NOT (2 IN current) THEN
      clp$scan_parameter_list (parameter_list, load_keys_pdt, status);
      IF NOT status.normal THEN
        RETURN
      IFEND;
      clp$get_value ('INPUT', 1, 1, clc$low, parameter, status);
      IF NOT status.normal THEN
        RETURN
      IFEND;
      file_in := parameter.file.local_file_name;
    IFEND;

    PUSH acc_sel: [1 .. 1];
    acc_sel^ [1].key := amc$access_mode;
    acc_sel^ [1].access_mode := $pft$usage_selections [pfc$shorten, pfc$append, pfc$read];
    amp$open (file_in, amc$segment, acc_sel, fid, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;
    amp$get_segment_pointer (fid, amc$sequence_pointer, seg_ptr, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;
    RESET seg_ptr.sequence_pointer;
    NEXT def_in IN seg_ptr.sequence_pointer;

    amp$open (file_out, amc$record, acc_sel, tfid, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;
    transparent[1].key := ifc$input_editing_mode;
    transparent[1].input_editing_mode := ifc$trans_edit;
    transparent[2].key := ifc$trans_character_mode;
    transparent[2].trans_character_mode := ifc$trans_char_forward;
    transparent[3].key := ifc$trans_length_mode;
    transparent[3].trans_length_mode := ifc$no_trans_len;
    ifp$store_term_conn_attributes (tfid, transparent, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;

    test_revision_number (status);
    IF NOT status.normal THEN
      RETURN
    IFEND;

    output_def_prolog (status);
    IF NOT status.normal THEN
      RETURN
    IFEND;

    load_controlware_programs (status); { activates at completion }
    IF NOT status.normal THEN
      RETURN
    IFEND;

    turn_on_light(1,3, status);
    def_out.prefix (1) := $CHAR (1e(16));
    def_out.prefix (2) := $CHAR (09(16));
    def_out.prefix (5) := ',';
    version_conflict := FALSE;
    FOR key := 1 TO 45 DO
      IF def_in^.defs [key].defined THEN
        def_out.prefix (3) := $CHAR (key + 30(16));
        IF def_in^.defs [key].half_duplex AND version_4 THEN
          def_out.prefix (4) := '4';
        ELSE
          def_out.prefix (4) := '1';
          IF def_in^.defs [key].half_duplex AND NOT(version_4) THEN
            version_conflict := TRUE;
          IFEND;
        IFEND;
        def_out.prefix (6) := $CHAR (byte_count DIV 100(16) + 60(16));
        def_out.prefix (7) := $CHAR ((byte_count DIV 10(16)) MOD 10(16) + 20(16));
        def_out.prefix (8) := $CHAR (byte_count MOD 10(16) + 60(16));
        IF NOT (def_in^.defs [key].hex_input) THEN
          convert_normal_def (key);
        ELSE
          convert_hex_def (key);
        IFEND;
        def_out.define (place) := '/';
        def_out.define (place + 1) := 'o';
        byte_count := byte_count + place DIV 2 + 1;
        def_out.define (place + 2) := $CHAR (0d(16));
        amp$put_next (tfid, #LOC (def_out), place + 10, address, status);
        IF NOT status.normal THEN
          RETURN
        IFEND;
      IFEND;
    FOREND;

    activate_controlware (status);
    transparent[1].input_editing_mode := ifc$normal_edit;
    transparent[2].trans_character_mode := ifc$trans_char_fwd_terminate;
    ifp$store_term_conn_attributes (tfid, transparent, status);
    amp$close (tfid, status);
    amp$close (fid, status);

    IF version_conflict THEN;
      osp$set_status_abnormal ('VK', 0, 'All definitions in FULL_DUPLEX', status);
    IFEND;

  PROCEND rap$load_keys;
?? OLDTITLE ??
?? NEWTITLE := '******  rap$display_keys  ******', EJECT ??
  PROCEDURE [XDCL, #GATE] rap$display_keys (parameter_list: clt$parameter_list;
    VAR status: ost$status);

{ PDT display_keys_pdt (
{   input, i : file = $local.key_definitions
{   status)

?? PUSH (LISTEXT := ON) ??
    VAR
      display_keys_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^display_keys_pdt_names,
        ^display_keys_pdt_params];
    VAR
      display_keys_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of
        clt$parameter_name_descriptor := [['INPUT', 1], ['I', 1], ['STATUS', 2]];
    VAR
      display_keys_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 2] of clt$parameter_descriptor
        := [
{ INPUT I }
      [[clc$optional_with_default, ^display_keys_pdt_dv1], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
        clc$file_value]],
{ STATUS }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
        clc$array_not_allowed, clc$status_value]]];
    VAR
      display_keys_pdt_dv1: [STATIC, READ, cls$pdt_names_and_defaults] string (22) :=
        '$local.key_definitions';
?? POP ??

    VAR
      key: 1 .. 45,
      out_str: string (24),
      len: integer,
      acc_sel: amt$file_access_selections,
      parameter: clt$value,
      key_id: [STATIC] array [1 .. 45] of string (5) := ['F1   ', 'F2   ', 'F3   ', 'F4   ', 'F5   ', 'F6   ',
        'F7   ', 'F8   ', 'F9   ', 'F10  ', 'F11  ', 'F12  ', 'F13  ', 'F14  ', 'F15  ', 'RTAB ', 'LTAB ',
        'NEXT ', 'DOWN ', 'UP   ', 'FWD  ', 'BKW  ', 'HELP ', 'ERASE', 'EDIT ', 'BACK ', 'LAB  ', 'DATA ',
        'STOP ', 'INSRT', 'DLETE', 'CLEAR', 'PRINT', 'PAD 1', 'PAD 2', 'PAD 3', 'PAD 4', 'PAD 5', 'PAD 6',
        'PAD 7', 'PAD 8', 'PAD 9', 'PAD 0', 'PAD ,', 'PAD .'];


    status.normal := TRUE;
    clp$scan_parameter_list (parameter_list, display_keys_pdt, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;

    clp$get_value ('INPUT', 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;

    file_in := parameter.file.local_file_name;
    PUSH acc_sel: [1 .. 1];
    acc_sel^ [1].key := amc$access_mode;
    acc_sel^ [1].access_mode := $pft$usage_selections [pfc$shorten, pfc$append, pfc$read];

    amp$open (file_in, amc$segment, acc_sel, fid, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;
    amp$get_segment_pointer (fid, amc$sequence_pointer, seg_ptr, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;

    amp$open (file_out, amc$record, acc_sel, tfid, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;

    RESET seg_ptr.sequence_pointer;
    NEXT def_in IN seg_ptr.sequence_pointer;
    FOR key := 1 TO 17 DO
      STRINGREP (out_str, len, ',', key: 3, ' ', key_id [key], ' ', $CHAR (6), $CHAR (1e(16)), 'D',
                 def_in^.defs [key].label, $CHAR (15(16)), $CHAR (1e(16)), 'E');
      IF (key MOD 4) = 1 THEN
        out_str (1) := ' ';
      IFEND;
      IF out_str (15) = $CHAR (0) THEN
        out_str (15, 7) := '       ';
      IFEND;
      amp$put_next (tfid, #LOC (out_str), #SIZE (out_str), address, status);
    FOREND;

    FOR key := 19 TO 45 DO
      STRINGREP (out_str, len, ',', key: 3, ' ', key_id [key], ' ', $CHAR (6), $CHAR (1e(16)), 'D',
                 def_in^.defs [key].label, $CHAR (15(16)), $CHAR (1e(16)), 'E');
      IF ((key - 1) MOD 4) = 1 THEN
        out_str (1) := ' ';
      IFEND;
      IF out_str (15) = $CHAR (0) THEN
        out_str (15, 7) := '       ';
      IFEND;
      amp$put_next (tfid, #LOC (out_str), #SIZE (out_str), address, status);
    FOREND;

    amp$close (tfid, status);
    amp$close (fid, status);

  PROCEND rap$display_keys;
?? OLDTITLE ??
?? NEWTITLE := '******  define_vkx_keys  ******', EJECT ??
  PROCEDURE define_vkx_keys (parameter_list: clt$parameter_list;
    VAR status: ost$status);

{ PDT define_vkx_keys_pdt (
{   key_number, k : integer 1 .. 45 = $required
{   definition, d : string 0..63
{   carriage_return, cr : boolean = false
{   half_duplex, hd : boolean = false
{   hex_input, h : boolean = false
{   label, l : string
{   status)

?? PUSH (LISTEXT := ON) ??
    VAR
      define_vkx_keys_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
        [^define_vkx_keys_pdt_names, ^define_vkx_keys_pdt_params];
    VAR
      define_vkx_keys_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 13] of
        clt$parameter_name_descriptor := [['KEY_NUMBER', 1], ['K', 1], ['DEFINITION', 2], ['D', 2], [
        'CARRIAGE_RETURN', 3], ['CR', 3], ['HALF_DUPLEX', 4], ['HD', 4], ['HEX_INPUT', 5], ['H', 5], ['LABEL',
        6], ['L', 6], ['STATUS', 7]];
    VAR
      define_vkx_keys_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 7] of
        clt$parameter_descriptor := [
{ KEY_NUMBER K }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 1, 45]],
{ DEFINITION D }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$string_value, 0, 63]],
{ CARRIAGE_RETURN CR }
      [[clc$optional_with_default, ^define_vkx_keys_pdt_dv3], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
        clc$boolean_value]],
{ HALF_DUPLEX HD }
      [[clc$optional_with_default, ^define_vkx_keys_pdt_dv4], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
        clc$boolean_value]],
{ HEX_INPUT H }
      [[clc$optional_with_default, ^define_vkx_keys_pdt_dv5], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
        clc$boolean_value]],
{ LABEL L }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$string_value, 0,
        osc$max_string_size]],
{ STATUS }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
        clc$array_not_allowed, clc$status_value]]];
    VAR
      define_vkx_keys_pdt_dv3: [STATIC, READ, cls$pdt_names_and_defaults] string (5) := 'false';
    VAR
      define_vkx_keys_pdt_dv4: [STATIC, READ, cls$pdt_names_and_defaults] string (5) := 'false';
    VAR
      define_vkx_keys_pdt_dv5: [STATIC, READ, cls$pdt_names_and_defaults] string (5) := 'false';
?? POP ??

    VAR
      key: 1 .. 45,
      key_definition: [STATIC] key_def := ['', 0, FALSE, FALSE, FALSE, TRUE, ''],
      specified: boolean,
      parameter: clt$value,
      acc_sel: amt$file_access_selections;


    status.normal := TRUE;
    PUSH acc_sel: [1 .. 1];
    acc_sel^ [1].key := amc$access_mode;
    acc_sel^ [1].access_mode := $pft$usage_selections [pfc$shorten, pfc$append, pfc$read];

    amp$open (file_in, amc$segment, acc_sel, fid, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;
    amp$get_segment_pointer (fid, amc$sequence_pointer, seg_ptr, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;
    RESET seg_ptr.sequence_pointer;
    NEXT def_in IN seg_ptr.sequence_pointer;

    clp$scan_parameter_list (parameter_list, define_vkx_keys_pdt, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;

    clp$get_value ('KEY_NUMBER', 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;
    key := parameter.int.value;
    IF (key = next_key) THEN
      osp$set_status_abnormal ('VK', 0, 'You can not define the next key', status);
      RETURN
    ELSEIF (key = def_in^.mk) OR (key = def_in^.ck) THEN
      osp$set_status_abnormal ('VK', 1, 'This key used by the screen_edit routine', status);
      RETURN
    ELSEIF (key = def_in^.fk) OR (key = def_in^.bk) THEN
      osp$set_status_abnormal ('VK', 2, 'This key used by the screen_scrolling routine', status);
      RETURN
    IFEND;

    clp$get_value ('DEFINITION', 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;
    key_definition.definition := parameter.str.value;
    key_definition.def_length := parameter.str.size;
    IF key_definition.def_length = 0 THEN
      key_definition.defined := FALSE;
    ELSE
      key_definition.defined := TRUE;
    IFEND;

    clp$get_value ('CARRIAGE_RETURN', 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;
    key_definition.carriage_return := parameter.bool.value;

    clp$get_value ('HALF_DUPLEX', 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;
    key_definition.half_duplex := parameter.bool.value;

    clp$get_value ('HEX_INPUT', 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;
    key_definition.hex_input := parameter.bool.value;
    IF key_definition.hex_input THEN
      #translate (osv$lower_to_upper, key_definition.definition, key_definition.definition);
    IFEND;

    clp$test_parameter ('LABEL', specified, status);
    IF specified THEN
      clp$get_value ('LABEL', 1, 1, clc$low, parameter, status);
      IF NOT status.normal THEN
        RETURN
      IFEND;
      key_definition.label := parameter.str.value;
    ELSE
      #translate (osv$lower_to_upper, key_definition.definition, key_definition.label);
    IFEND;

    def_in^.defs [key] := key_definition;

    amp$set_segment_eoi (fid, seg_ptr, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;
    amp$close (fid, status);

  PROCEND define_vkx_keys;
?? OLDTITLE ??
?? NEWTITLE := '******  include_screen_edit ******', EJECT ??
  PROCEDURE include_screen_edit (parameter_list: clt$parameter_list;
    VAR status: ost$status);

{   PDT inc_screen_edit_pdt (
{    mark_key, mk : integer 1..45 =14
{    copy_key, ck : integer 1..45 =15
{    on : boolean = true
{    status)

?? PUSH (LISTEXT := ON) ??
    VAR
      inc_screen_edit_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
        [^inc_screen_edit_pdt_names, ^inc_screen_edit_pdt_params];
    VAR
      inc_screen_edit_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 6] of
        clt$parameter_name_descriptor := [['MARK_KEY', 1], ['MK', 1], ['COPY_KEY', 2], ['CK', 2], ['ON', 3],
        ['STATUS', 4]];
    VAR
      inc_screen_edit_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 4] of
        clt$parameter_descriptor := [
{ MARK_KEY MK }
      [[clc$optional_with_default, ^inc_screen_edit_pdt_dv1], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
        clc$integer_value, 1, 45]],
{ COPY_KEY CK }
      [[clc$optional_with_default, ^inc_screen_edit_pdt_dv2], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
        clc$integer_value, 1, 45]],
{ ON }
      [[clc$optional_with_default, ^inc_screen_edit_pdt_dv3], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
        clc$boolean_value]],
{ STATUS }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
        clc$array_not_allowed, clc$status_value]]];
    VAR
      inc_screen_edit_pdt_dv1: [STATIC, READ, cls$pdt_names_and_defaults] string (2) := '15';
    VAR
      inc_screen_edit_pdt_dv2: [STATIC, READ, cls$pdt_names_and_defaults] string (2) := '14';
    VAR
      inc_screen_edit_pdt_dv3: [STATIC, READ, cls$pdt_names_and_defaults] string (4) := 'true';
?? POP ??

    VAR
      option_on: boolean,
      acc_sel: amt$file_access_selections,
      parameter: clt$value;


    status.normal := TRUE;
    clp$scan_parameter_list (parameter_list, inc_screen_edit_pdt, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;

    clp$get_value ('MARK_KEY', 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;
    IF next_key = parameter.int.value THEN
      osp$set_status_abnormal ('VK', 0, 'You can not define the next key', status);
      RETURN
    IFEND;
    mark_key := parameter.int.value;

    clp$get_value ('COPY_KEY', 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;
    IF next_key = parameter.int.value THEN
      osp$set_status_abnormal ('VK', 0, 'You can not define the next key', status);
      RETURN
    IFEND;
    copy_key := parameter.int.value;

    clp$get_value ('ON', 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;
    option_on := parameter.bool.value;

    PUSH acc_sel: [1 .. 1];
    acc_sel^ [1].key := amc$access_mode;
    acc_sel^ [1].access_mode := $pft$usage_selections [pfc$shorten, pfc$append, pfc$read];

    amp$open (file_in, amc$segment, acc_sel, fid, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;
    amp$get_segment_pointer (fid, amc$sequence_pointer, seg_ptr, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;
    RESET seg_ptr.sequence_pointer;
    NEXT def_in IN seg_ptr.sequence_pointer;
    IF (mark_key = def_in^.fk) OR (mark_key = def_in^.bk) THEN
      osp$set_status_abnormal ('VK', 2, 'This key used by the screen_scrolling routine', status);
      RETURN
    ELSEIF (copy_key = def_in^.fk) OR (copy_key = def_in^.bk) THEN
      osp$set_status_abnormal ('VK', 2, 'This key used by the screen_scrolling routine', status);
      RETURN
    IFEND;

    def_in^.include_screen_edit := option_on;
    IF def_in^.mk <> 0 THEN
      def_in^.defs [def_in^.mk].label := '       ';
      def_in^.defs [def_in^.ck].label := '       ';
    IFEND;
    IF option_on THEN
      def_in^.defs [mark_key].defined := FALSE;
      def_in^.defs [copy_key].defined := FALSE;
      def_in^.defs [mark_key].label := ' MARK  ';
      def_in^.defs [copy_key].label := ' COPY  ';
      def_in^.mk := mark_key;
      def_in^.ck := copy_key;
    ELSE
      def_in^.mk := 0;
      def_in^.ck := 0;
    IFEND;

    amp$set_segment_eoi (fid, seg_ptr, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;
    amp$close (fid, status);

  PROCEND include_screen_edit;
?? OLDTITLE ??
?? NEWTITLE := '******  include_screen_scroll ******', EJECT ??
  PROCEDURE include_screen_scroll (parameter_list: clt$parameter_list;
    VAR status: ost$status);

{   PDT inc_screen_scroll_pdt (
{    forward_key, fk : integer 1..45 =35
{    backward_key, bk : integer 1..45 =41
{    on : boolean = true
{    status)

?? PUSH (LISTEXT := ON) ??
    VAR
      inc_screen_scroll_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
        [^inc_screen_scroll_pdt_names, ^inc_screen_scroll_pdt_params];
    VAR
      inc_screen_scroll_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 6] of
        clt$parameter_name_descriptor := [['BACKWARD_KEY', 1], ['BK', 1], ['FORWARD_KEY', 2], ['FK', 2], [
        'ON', 3], ['STATUS', 4]];
    VAR
      inc_screen_scroll_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 4] of
        clt$parameter_descriptor := [
{ BACKWARD_KEY BK }
      [[clc$optional_with_default, ^inc_screen_scroll_pdt_dv1], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
        clc$integer_value, 1, 45]],
{ FORWARD_KEY FK }
      [[clc$optional_with_default, ^inc_screen_scroll_pdt_dv2], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
        clc$integer_value, 1, 45]],
{ ON }
      [[clc$optional_with_default, ^inc_screen_scroll_pdt_dv3], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
        clc$boolean_value]],
{ STATUS }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
        clc$array_not_allowed, clc$status_value]]];
    VAR
      inc_screen_scroll_pdt_dv1: [STATIC, READ, cls$pdt_names_and_defaults] string (2) := '35';
    VAR
      inc_screen_scroll_pdt_dv2: [STATIC, READ, cls$pdt_names_and_defaults] string (2) := '41';
    VAR
      inc_screen_scroll_pdt_dv3: [STATIC, READ, cls$pdt_names_and_defaults] string (4) := 'true';
?? POP ??

    VAR
      option_on: boolean,
      acc_sel: amt$file_access_selections,
      parameter: clt$value;


    status.normal := TRUE;
    clp$scan_parameter_list (parameter_list, inc_screen_scroll_pdt, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;

    clp$get_value ('BACKWARD_KEY', 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;
    IF next_key = parameter.int.value THEN
      osp$set_status_abnormal ('VK', 0, 'You can not define the next key', status);
      RETURN
    IFEND;
    backward_key := parameter.int.value;

    clp$get_value ('FORWARD_KEY', 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;
    IF next_key = parameter.int.value THEN
      osp$set_status_abnormal ('VK', 0, 'You can not define the next key', status);
      RETURN
    IFEND;
    forward_key := parameter.int.value;

    clp$get_value ('ON', 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;
    option_on := parameter.bool.value;

    PUSH acc_sel: [1 .. 1];
    acc_sel^ [1].key := amc$access_mode;
    acc_sel^ [1].access_mode := $pft$usage_selections [pfc$shorten, pfc$append, pfc$read];

    amp$open (file_in, amc$segment, acc_sel, fid, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;
    amp$get_segment_pointer (fid, amc$sequence_pointer, seg_ptr, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;
    RESET seg_ptr.sequence_pointer;
    NEXT def_in IN seg_ptr.sequence_pointer;
    IF (backward_key = def_in^.mk) OR (backward_key = def_in^.ck) THEN
      osp$set_status_abnormal ('VK', 1, 'This key used by the screen_edit routine', status);
      RETURN
    ELSEIF (forward_key = def_in^.mk) OR (forward_key = def_in^.ck) THEN
      osp$set_status_abnormal ('VK', 1, 'This key used by the screen_edit routine', status);
      RETURN
    IFEND;

    def_in^.include_screen_scroll := option_on;
    IF def_in^.fk <> 0 THEN
      def_in^.defs [def_in^.fk].label := '       ';
      def_in^.defs [def_in^.bk].label := '       ';
    IFEND;
    IF option_on THEN
      def_in^.defs [forward_key].defined := FALSE;
      def_in^.defs [backward_key].defined := FALSE;
      def_in^.defs [forward_key].label := 'FORWARD';
      def_in^.defs [backward_key].label := 'BCKWARD';
      def_in^.fk := forward_key;
      def_in^.bk := backward_key;
    ELSE
      def_in^.fk := 0;
      def_in^.bk := 0;
    IFEND;

    amp$set_segment_eoi (fid, seg_ptr, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;
    amp$close (fid, status);

  PROCEND include_screen_scroll;
?? OLDTITLE ??
?? NEWTITLE := '******  quit  ******', EJECT ??
  PROCEDURE quit (parameter_list: clt$parameter_list;
    VAR status: ost$status);

{ PDT quit_pdt (
{   load, l : boolean = true
{   status)

?? PUSH (LISTEXT := ON) ??
    VAR
      quit_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^quit_pdt_names, ^quit_pdt_params];
    VAR
      quit_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of
        clt$parameter_name_descriptor := [['LOAD', 1], ['L', 1], ['STATUS', 2]];
    VAR
      quit_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 2] of clt$parameter_descriptor := [
{ LOAD L }
      [[clc$optional_with_default, ^quit_pdt_dv1], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
        clc$boolean_value]],
{ STATUS }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
        clc$array_not_allowed, clc$status_value]]];
    VAR
      quit_pdt_dv1: [STATIC, READ, cls$pdt_names_and_defaults] string (4) := 'true';
?? POP ??

    VAR
      parameter: clt$value;


    status.normal := TRUE;
    clp$scan_parameter_list (parameter_list, quit_pdt, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;

    clp$get_value ('LOAD', 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;
    IF parameter.bool.value THEN
      on := $pmt$sense_switches [2];
      off := $pmt$sense_switches [];
      pmp$manage_sense_switches (on, off, current, status);
      IF NOT status.normal THEN
        RETURN
      IFEND;
      rap$load_keys (parameter_list, status);
    IFEND;

    on := $pmt$sense_switches [];
    off := $pmt$sense_switches [1,2];
    pmp$manage_sense_switches (on, off, current, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;

    clp$end_scan_command_file (vkx_utility_name, status);

  PROCEND quit;
?? OLDTITLE ??
?? NEWTITLE := '******  rap$edit_keys  ******', EJECT ??
  PROCEDURE [XDCL, #GATE] rap$edit_keys (parameter_list: clt$parameter_list;
    VAR status: ost$status);

{ PDT edit_keys_pdt (
{   input, i : file = $local.key_definitions
{   status)

?? PUSH (LISTEXT := ON) ??
    VAR
      edit_keys_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^edit_keys_pdt_names,
        ^edit_keys_pdt_params];
    VAR
      edit_keys_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of
        clt$parameter_name_descriptor := [['INPUT', 1], ['I', 1], ['STATUS', 2]];
    VAR
      edit_keys_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 2] of clt$parameter_descriptor := [
{ INPUT I }
      [[clc$optional_with_default, ^edit_keys_pdt_dv1], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
        clc$file_value]],
{ STATUS }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
        clc$array_not_allowed, clc$status_value]]];
    VAR
      edit_keys_pdt_dv1: [STATIC, READ, cls$pdt_names_and_defaults] string (22) := '$local.key_definitions';
?? POP ??

    VAR
      parameter: clt$value;


{ table edit_keys_command_list
{  command (define_vkx_keys, defvk      , defk), define_vkx_keys
{  command (include_screen_edit, incse  , ince), include_screen_edit
{  command (include_screen_scroll, incss, incs), include_screen_scroll
{  command (load_keys, loak                   ), rap$load_keys
{  command (quit, qui, end              , e   ), quit

?? PUSH (LISTEXT := ON) ??
VAR
  edit_keys_command_list: [STATIC, READ] ^clt$command_table := ^edit_keys_command_list_entries,

  edit_keys_command_list_entries: [STATIC, READ] array [1 .. 15] of  clt$command_table_entry := [
  {} ['DEFINE_VKX_KEYS                ', clc$nominal_entry, clc$advertised_entry, 1,
        clc$automatically_log, clc$linked_call, ^define_vkx_keys],
  {} ['DEFK                           ', clc$abbreviation_entry, clc$advertised_entry, 1,
        clc$automatically_log, clc$linked_call, ^define_vkx_keys],
  {} ['DEFVK                          ', clc$alias_entry, clc$advertised_entry, 1,
        clc$automatically_log, clc$linked_call, ^define_vkx_keys],
  {} ['E                              ', clc$abbreviation_entry, clc$advertised_entry, 5,
        clc$automatically_log, clc$linked_call, ^quit],
  {} ['END                            ', clc$alias_entry, clc$advertised_entry, 5,
        clc$automatically_log, clc$linked_call, ^quit],
  {} ['INCE                           ', clc$abbreviation_entry, clc$advertised_entry, 2,
        clc$automatically_log, clc$linked_call, ^include_screen_edit],
  {} ['INCLUDE_SCREEN_EDIT            ', clc$nominal_entry, clc$advertised_entry, 2,
        clc$automatically_log, clc$linked_call, ^include_screen_edit],
  {} ['INCLUDE_SCREEN_SCROLL          ', clc$nominal_entry, clc$advertised_entry, 3,
        clc$automatically_log, clc$linked_call, ^include_screen_scroll],
  {} ['INCS                           ', clc$abbreviation_entry, clc$advertised_entry, 3,
        clc$automatically_log, clc$linked_call, ^include_screen_scroll],
  {} ['INCSE                          ', clc$alias_entry, clc$advertised_entry, 2,
        clc$automatically_log, clc$linked_call, ^include_screen_edit],
  {} ['INCSS                          ', clc$alias_entry, clc$advertised_entry, 3,
        clc$automatically_log, clc$linked_call, ^include_screen_scroll],
  {} ['LOAD_KEYS                      ', clc$nominal_entry, clc$advertised_entry, 4,
        clc$automatically_log, clc$linked_call, ^rap$load_keys],
  {} ['LOAK                           ', clc$abbreviation_entry, clc$advertised_entry, 4,
        clc$automatically_log, clc$linked_call, ^rap$load_keys],
  {} ['QUI                            ', clc$alias_entry, clc$advertised_entry, 5,
        clc$automatically_log, clc$linked_call, ^quit],
  {} ['QUIT                           ', clc$nominal_entry, clc$advertised_entry, 5,
        clc$automatically_log, clc$linked_call, ^quit]];
?? POP ??

    status.normal := TRUE;
    on := $pmt$sense_switches [1];
    off := $pmt$sense_switches [2];
    pmp$manage_sense_switches (on, off, current, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;

    clp$scan_parameter_list (parameter_list, edit_keys_pdt, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;

    clp$get_value ('INPUT', 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;
    file_in := parameter.file.local_file_name;

    clp$push_utility (vkx_utility_name, clc$global_command_search, edit_keys_command_list, NIL, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;

    clp$scan_command_file (command_file, vkx_utility_name, vkx_prompt_string, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;

    clp$pop_utility (status);

  PROCEND rap$edit_keys;
?? OLDTITLE ??
MODEND ram$create_key_definitions;
