*copy osd$default_pragmats
?? NEWTITLE := 'Display File Manager' ??
MODULE dum$display_file_manager;
{ PURPOSE: Provide common processing procedures that are used for symbolic
{          output.
{
{ DESIGN:  The value of the parameter file is interrogated. If it is not
{          different from the global file, the global display file is used.

?? PUSH (LISTEXT := ON) ??
*copyc clc$standard_file_names
*copyc clp$close_display
*copyc clp$horizontal_tab_display
*copyc clp$new_display_line
*copyc clp$open_display_reference
*copyc clp$put_display
*copyc clp$put_partial_display
*copyc clp$reset_for_next_display_page
*copyc pmp$get_legible_date_time
*copyc pmp$get_os_version
?? POP ??
?? TITLE := '  Global Definitions', EJECT ??
  CONST
    long_date_start = 91,
    long_header_length = 132,
    long_os_version_start = 33,
    long_page_number_start = 128, {includes leading blank}
    long_page_title_start = 123,
    long_time_start = 110,
    long_product_name_start = 56,
    os_version_length = 22,
    page_number_length = 5, {includes leading blank}
    short_product_name_start = 34,
    short_base_name_start = 41,
    short_base_title_start = 34,
    short_date_start = 2,
    short_header_length = 72,
    short_os_version_start = 9,
    short_page_number_start = 63, {includes leading blank}
    short_page_title_start = 58,
    short_time_start = 49;

  CONST
    db_product_name = 'DEBUG',
    db_product_name_length = 5,
    db_version = '1.5 ',
    db_version_length = 4,
    db_level_length = 5;

  VAR
    default_file_display_control: clt$display_control,
    default_file_open: boolean := FALSE,
    default_output_file: [READ] ost$name := clc$standard_output,
    v$level: string (db_level_length) := '*RJT*';

  CONST
    max_string_size = 65535,
    smallest_graphic = ' ',
    largest_graphic = '~',
    max_set_element = 32767,
    value_spacer = 2,
    record_indent = 2,
    first_character = 0,
    last_character = 255,
    true_value = 1,
    false_value = 0,
    bytes_per_word = 8,
    bits_per_byte = 8;

  TYPE
    value_record = record
      case boolean of
      = TRUE =
        bits: packed array [0 .. 63] of boolean,
      = FALSE =
        word_sized_value: integer,
      casend,
    recend;

?? TITLE := '  dup$close_display', EJECT ??
*copyc duh$close_display

  PROCEDURE [XDCL] dup$close_display (VAR display_control_pointer: ^clt$display_control;
        close_default_file: boolean;
    VAR status: ost$status);

{ This procedure flushes any partial line.  It will close the default output
{ file only if the boolean close_default_file is true. Otherwise, it
{ closes the file if its FID is not the same as that of the default output
{ file. All bad statuses are ignored.

    IF display_control_pointer^.data_in_line = TRUE THEN
      clp$put_partial_display (display_control_pointer^, '', clc$trim,
            amc$terminate, status);
      status.normal := TRUE;
    IFEND;
    IF close_default_file THEN
      clp$close_display (default_file_display_control, status);
      default_file_open := FALSE;
    ELSE
      IF display_control_pointer^.file_id <> default_file_display_control.
            file_id THEN
        clp$close_display (display_control_pointer^, status);
      IFEND;
    IFEND;
    status.normal := TRUE;

  PROCEND dup$close_display;
?? TITLE := '  dup$display_string', EJECT ??
{ PURPOSE: Verify that the new text will fit on the current line. Skip to the
{          next line if it won't.
{ NOTES:   If a string is longer than the line, it will be folded by BAM or the
{          terminal.

  PROCEDURE [XDCL] dup$display_string (VAR display_control_pointer: ^clt$display_control;
        space_required: amt$page_width;
        str: string ( * );
        indent_count: ost$string_size;
    VAR status: ost$status);

    IF (display_control_pointer^.column_number + space_required - 1 ) >
          display_control_pointer^.page_width THEN
      clp$new_display_line (display_control_pointer^, clc$next_display_line,
            status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF indent_count > 0 THEN
        clp$horizontal_tab_display (display_control_pointer^, indent_count + 1,
              status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;
    IFEND;

    clp$put_partial_display (display_control_pointer^, str, clc$no_trim,
          amc$continue, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

  PROCEND dup$display_string;
?? TITLE := '  dup$open_display', EJECT ??
*copyc duh$open_display

  PROCEDURE [XDCL] dup$open_display (file_name: fst$file_reference;
    VAR display_control_pointer: ^clt$display_control;
    VAR status: ost$status);

{This procedure interrogates the file-name parameter.  If it is not the
{default output file, it is opened using the parameter passed as
{display_control.  If it is the default output file, no open is
{performed unless the default file is not open.  The display_control_block for
{the default output file is owned by this module.

    VAR
      ring_attributes: amt$ring_attributes;

    ring_attributes.r1 := #RING (^ring_attributes);
    ring_attributes.r2 := #RING (^ring_attributes);
    ring_attributes.r3 := #RING (^ring_attributes);

    IF file_name = default_output_file THEN
      IF NOT default_file_open THEN
        clp$open_display_reference (file_name, ^generate_title, fsc$list, ring_attributes,
              default_file_display_control, status);
        IF NOT status.normal THEN
          RETURN; {------->
        IFEND;
        default_file_open := TRUE;
      IFEND;
      display_control_pointer := ^default_file_display_control;
    ELSE
      clp$open_display_reference (file_name, ^generate_title, fsc$list, ring_attributes,
            display_control_pointer^, status);
    IFEND;
  PROCEND dup$open_display;
?? TITLE := '  generate_title', EJECT ??

  PROCEDURE generate_title (VAR display_control: {input, output}
    clt$display_control;
        page_number: integer;
    VAR status: ost$status);

{This procedure generates and outputs the standard title.  This title may
{take from 1 to 2 lines depending on the page width of the file to which
{it is destined.

    VAR
      j: integer,
      str: string (10),
      str1: string (18),
      str1_length: 0 .. 18,
      str2: string (12),
      str2_length: 0 .. 12,
      str3: string (35),
      str3_length: 0 .. 35;

    VAR
      datemdy: ost$date,
      header1: string (long_header_length),
      header1_length: 0 .. long_header_length,
      header2: string (long_header_length),
      header2_length: 0 .. long_header_length,
      os_version: pmt$os_name,
      timehms: ost$time;

    pmp$get_legible_date_time (osc$default_date, datemdy, osc$default_time, timehms,
          status);
    CASE datemdy.date_format OF
      =osc$mdy_date=
        str1 := datemdy.mdy;
        str1_length := STRLENGTH (datemdy.mdy);
      =osc$month_date=
        str1 := datemdy.month;
        str1_length := STRLENGTH (datemdy.month);
      =osc$iso_date=
        str1 := datemdy.iso;
        str1_length := STRLENGTH (datemdy.iso);
      =osc$ordinal_date=
        str1 := datemdy.ordinal;
        str1_length := STRLENGTH (datemdy.ordinal);
      =osc$dmy_date=
        str1 := datemdy.dmy;
        str1_length := STRLENGTH (datemdy.dmy);
    CASEND;
    CASE timehms.time_format OF
      =osc$ampm_time=
        str2 := timehms.ampm;
        str2_length := STRLENGTH (timehms.ampm);
      =osc$hms_time=
        str2 := timehms.hms;
        str2_length := STRLENGTH (timehms.hms);
      =osc$millisecond_time=
        str2 := timehms.millisecond;
        str2_length := STRLENGTH (timehms.millisecond);
    CASEND;
    str3 := db_product_name CAT ' ' CAT db_version CAT ' ';
    str3_length := 2 + db_product_name_length + db_version_length;
    str3(2 + db_product_name_length + db_version_length + 1, db_level_length) := v$level;
    str3_length := str3_length + db_level_length;
    pmp$get_os_version (os_version, status);

    clp$reset_for_next_display_page (display_control, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    STRINGREP (str, j, page_number);
    header1 := '     ';
    IF (display_control.page_width < long_header_length) THEN
      header2 := '     ';
      header1_length := short_header_length;
      header2_length := short_header_length;
      header1 (short_os_version_start, os_version_length) := os_version;
      header2 (short_date_start, str1_length ) := str1(1,str1_length);
      header1 (short_time_start, str2_length ) := str2(1,str2_length);
      header1 (short_page_title_start, 4) := 'PAGE';
      header2 (short_product_name_start, str3_length) :=
            str3;
      header1 (short_page_number_start, j) := str (1, j);
      clp$put_display (display_control, header1 (1, header1_length), clc$trim,
            status);
      IF NOT status.normal THEN
        RETURN; {------->
      IFEND;
      clp$put_display (display_control, header2 (1, header2_length), clc$trim,
            status);
      IF NOT status.normal THEN
        RETURN; {------->
      IFEND;
    ELSE
      header1_length := long_header_length;
      header1 (long_os_version_start, os_version_length) := os_version;
      header1 (long_date_start, str1_length ) := str1(1,str1_length);
      header1 (long_time_start, str2_length ) := str2(1,str2_length);
      header1 (long_page_title_start, 4) := 'PAGE';


      header1 (long_product_name_start, str3_length) :=
            str3;
      header1 (long_page_number_start, j) := str (1, j);
      clp$put_display (display_control, header1 (1, header1_length), clc$trim,
            status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

{skip a line
  clp$new_display_line (display_control,1,status);
  PROCEND generate_title;
?? OLDTITLE ??
MODEND dum$display_file_manager;
