?? NEWTITLE := '~~~~~   common deck DSI$K_DISPLAY_CONTROL', EJECT ??
{********************************************************

{  Display control, deck DSI$K_DISPLAY_CONTROL.

{ ********************************************************

  CONST
    line_width = 60, {display line width in characters
    header_line = 1, {header line on k display
    message_line = 22, {k display line for message output
    operator_echo_line = 23; {k display line for operator echo

  TYPE
    scroll_types = (scroll, no_scroll, auto),
    kdispb_line = ARRAY [1 .. 7] OF PACKED ARRAY [0 .. 9] OF 0 .. 63,
    param_type = string (line_width);

  VAR
    position: integer, {current position in buffer
    line_position: integer := 1,
    beginning_line_position: integer := 1,
    active_cmnds_file: boolean,
    default_recovery: boolean := TRUE;

?? SKIP := 3 ??
{**********************************************************

{ PURPOSE:
{   Clear k display screen.


  PROCEDURE clear_screen;

    VAR
      i: integer;

    FOR i := 1 TO message_line - 1 DO
      show_message (' ', i, no_scroll);
    FOREND;

  PROCEND clear_screen;
  ?? SKIP := 3 ??
{**********************************************************

{ PURPOSE:
{   Convert k display title to display code.


  PROCEDURE convert_title
    (    k_display_title: string (16));

    VAR
      ktitle: [XREF] ARRAY [1 .. 2] OF PACKED ARRAY [0 .. 9] OF 0 .. 63,
      dcwi: integer,
      dcci: 0 .. 9,
      si: ost$string_index,
      eol: boolean;

    si := 1;
    dcwi := 1;
    dcci := 0;
    eol := TRUE;
    utp$convert_string_to_dc_string (utc$ascii64, ktitle, dcwi, dcci,
          k_display_title, si, eol);

  PROCEND convert_title;
  ?? SKIP := 3 ??
{**********************************************************

{ PURPOSE:
{   Show k display screen.


  PROCEDURE show_message
    (    s: string ( * ),
         line: integer,
         scroll_k_display: scroll_types);

    TYPE
      k_output_copy = ARRAY [1 .. operator_echo_line] OF PACKED RECORD
        header: 0 .. 777777777777(8),
        stuff: 0 .. 77777777(8),
        rest: ARRAY [1 .. 6] OF integer,
      RECEND;

    VAR
      kdispb: [XREF] ARRAY [1 .. operator_echo_line] OF kdispb_line,
      k_display_buffer: ^k_output_copy,
      save_header: 0 .. 777777777777(8),
      display_line: 0 .. operator_echo_line,
      i: integer,
      dcwi: integer,
      scroll_dir: scroll_types,
      dcci: 0 .. 9,
      si: ost$string_index,
      eol: boolean,
      new_string: string (60);

    scroll_dir := scroll_k_display;
    IF scroll_k_display = auto THEN
      IF line_position = 20 THEN
        scroll_dir := scroll;
      ELSE
        scroll_dir := no_scroll;
        line_position := line_position + 1;
      IFEND;
    IFEND;

    k_display_buffer := #LOC (kdispb);
    new_string := s;
    si := 1;
    dcwi := 1;
    dcci := 6;
    eol := TRUE;
    IF scroll_dir = scroll THEN
      FOR i := beginning_line_position TO 19 DO
        save_header := k_display_buffer^ [i].header;
        k_display_buffer^ [i] := k_display_buffer^ [i + 1];
        k_display_buffer^ [i].header := save_header;
      FOREND;
      display_line := 20;
    ELSE
      display_line := line;
    IFEND;
    utp$convert_string_to_dc_string (utc$ascii64, kdispb [display_line], dcwi,
          dcci, new_string, si, eol);

  PROCEND show_message;
  ?? SKIP := 3 ??
{**********************************************************

{ PURPOSE:
{   Skip blanks in input buffer.

  PROCEDURE skip_blanks;

    FOR position := position TO line_width DO
      IF text_line (position) <> ' ' THEN
        RETURN;
      IFEND;
    FOREND;

  PROCEND skip_blanks;
  ?? SKIP := 3 ??
{********************************************************

{ PURPOSE:
{   Extract parameter from the command line.


  PROCEDURE extract_param
    (VAR param_value: param_type;
         param_position: integer);

    VAR
      param_cnt: integer,
      number_of_char,
      begin_of_param,
      end_of_param: integer;

{  Skip leading blanks.

    position := 1;
    skip_blanks;

    param_cnt := 0;
    begin_of_param := position;
    end_of_param := 0;
    number_of_char := 0;

{  Find parameter; parameter delimiters are /blank/, /=/ and
{  command is terminated by '.' character.

  /search/
    WHILE position <= line_width DO
      CASE text_line (position) OF
      = '=', ' ', ',' =
        IF param_cnt < param_position THEN
          position := position + 1; {skip separator character
          begin_of_param := position;
          number_of_char := 0;
          param_cnt := param_cnt + 1;
          skip_blanks; {skip leading blanks
          CYCLE /search/;
        ELSEIF param_cnt = param_position THEN
          end_of_param := number_of_char;
          EXIT /search/;
        IFEND;
      = '.' =
        IF param_cnt < param_position THEN
          end_of_param := 0;
        ELSE
          end_of_param := number_of_char;
        IFEND;
        EXIT /search/; {period found
      ELSE
        position := position + 1;
        number_of_char := number_of_char + 1;
      CASEND;
    WHILEND /search/;

    param_value := text_line (begin_of_param, end_of_param);

  PROCEND extract_param;
  ?? SKIP := 3 ??
{********************************************************

{ PURPOSE:
{   Make integer from parameter list.


  TYPE
    number_type = (none, bin, oct, dec, hex);

  PROCEDURE make_number
    (VAR number_param: param_type,
         number_value: c180_word,
         error: boolean;
         default_base: number_type);

    CONST
      max_chars_param = 30; {max number of characters in a parameter

    TYPE
      half_c180w = PACKED RECORD
        ovfl: 0 .. 0fffffff(16), {28 bits
        digits: 0 .. 0ffffffff(16), {32 bits
      RECEND;

    VAR
      digit_array: [STATIC] ARRAY [0 .. 15] OF char := ['0', '1', '2', '3',
        '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F'],
      c180_number_template: PACKED RECORD
        pad1: 0 .. 0fffffff(16),
        u_fld: 0 .. 0ffffffff(16),
        pad2: 0 .. 0fffffff(16),
        l_fld: 0 .. 0ffffffff(16),
      RECEND,
      u: ^half_c180w,
      l: ^half_c180w,
      u_value: integer,
      l_value: integer,
      display_digit: integer,
      digit_cnt: integer,
      scaler: integer,
      i,
      j: integer;

{  Initialize return parameters.

    error := TRUE;
    number_value.left := 0;
    number_value.right := 0;

{  Find prefix base if specified.

    CASE number_param (1) OF
    = 'X', 'H' =
      scaler := 16;
      position := 2;
    = 'O' =
      scaler := 8;
      position := 2;
    ELSE
      CASE default_base OF
      = bin =
        scaler := 2;
      = oct =
        scaler := 8;
      = dec =
        scaler := 10;
      = hex =
        scaler := 16;
      ELSE
        scaler := 10;
      CASEND;
      position := 1;
    CASEND;

{  Find postfix base when prefix base not specified.

    i := position;
    WHILE (number_param (i) <> '(') AND (number_param (i) <> ' ') AND (i <
          max_chars_param - 3) DO
      i := i + 1;
    WHILEND;
    IF number_param (i) = '(' THEN
      IF position = 2 THEN
        RETURN;
      IFEND;
      IF number_param (i + 2) = ')' THEN {1 digit suffix
        IF number_param (i + 1) = '8' THEN
          scaler := 8;
        ELSEIF number_param (i + 1) = '2' THEN
          scaler := 2;
        ELSE
          RETURN;
        IFEND;
      ELSEIF (number_param (i + 1) = '1') AND (number_param (i + 3) = ')') THEN
        IF number_param (i + 2) = '0' THEN
          scaler := 10;
        ELSEIF number_param (i + 2) = '6' THEN
          scaler := 16;
        ELSE
          RETURN;
        IFEND;
      ELSE
        RETURN;
      IFEND;
    IFEND;

{  Make number.

{  Extract digits.

    u := #LOC (u_value);
    l := #LOC (l_value);
    u_value := 0;
    l_value := 0;

    FOR digit_cnt := position TO i - 1 DO

    /get_digit/
      FOR j := 0 TO 15 DO
        IF number_param (digit_cnt) = digit_array [j] THEN
          display_digit := j;
          EXIT /get_digit/;
        IFEND;
      FOREND /get_digit/;
      IF number_param (digit_cnt) <> digit_array [j] THEN
        RETURN;
      IFEND;

      IF display_digit >= scaler THEN
        RETURN;
      IFEND;

{  Scale partial result.

      l_value := l_value * scaler;
      u_value := u_value * scaler;
      l_value := l_value + display_digit;
      u_value := u_value + l^.ovfl;
      l^.ovfl := 0;
    FOREND;

{  Produce c180 word result.

    IF u^.ovfl <> 0 THEN
      RETURN;
    IFEND; {number too big
    error := FALSE;
    number_value.left := u^.digits;
    number_value.right := l^.digits;

  PROCEND make_number;
?? OLDTITLE ??
