?? RIGHT := 110 ??
?? NEWTITLE := 'CREATE_ORDER_DEFINITION Subutility: DEFINE_TAPE_ATTRIBUTES Subcommand.' ??
MODULE ram$define_tape_attributes;

{ PURPOSE:
{   This module contains the procedures to set the tape attributes.
{
{ DESIGN:
{   A record was saved in the scratch segment for the tape attributes
{   information.  This module fills in the fields of that record.
{   The compiled module resides in RAF$LIBRARY.
{
{ NOTES:
{

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc rac$tape_types
*copyc rae$package_software_cc
?? POP ??
*copyc clp$convert_string_to_integer
*copyc clp$get_set_count
*copyc clp$evaluate_parameters
*copyc osp$set_status_abnormal
*copyc osv$lower_to_upper
*copyc rav$packing_list_header_p
*copyc rav$tape_information

?? TITLE := 'Global Declarations Declared by This Module', EJECT ??

?? TITLE := '[XDCL] rap$define_tape_attributes', EJECT ??

{ PURPOSE:
{   This procedure sets the tape attributes.
{
{ DESIGN:
{   A record was saved in the scratch segment for the tape attributes
{   information.  This module fills in the fields of that record.
{
{ NOTES:
{   The SIZES parameter defaults to 2400, when mt9$1600 or mt9$6250 are
{   specified.  An error is returned if the SIZES parameter is specified
{   along with mt18$38000.  The size assigned for mt18$38000 is 540.
{

  PROCEDURE [XDCL] rap$define_tape_attributes
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{     PROCEDURE defta_pdt (
{       vsn_seed, vs: any of
{           string 1..6
{           name 1..6
{         anyend = $required
{       type, t: key
{           mt9$1600, mt9$6250, mt18$38000
{         keyend = mt9$6250
{       sizes, size, s: list of key
{           t3600, t2400, t1200, t600, t200
{         keyend = $optional
{       percent_usable, pu: (hidden) integer 1..100 = 98
{       status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 10] of clt$pdt_parameter_name,
      parameters: array [1 .. 5] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$string_type_qualifier,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$name_type_qualifier,
        recend,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 3] of clt$keyword_specification,
        default_value: string (8),
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier_v2,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 5] of clt$keyword_specification,
        recend,
      recend,
      type4: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (2),
      recend,
      type5: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [93, 6, 11, 14, 56, 53, 298],
    clc$command, 10, 5, 1, 0, 1, 0, 5, ''], [
    ['PERCENT_USABLE                 ',clc$nominal_entry, 4],
    ['PU                             ',clc$abbreviation_entry, 4],
    ['S                              ',clc$abbreviation_entry, 3],
    ['SIZE                           ',clc$alias_entry, 3],
    ['SIZES                          ',clc$nominal_entry, 3],
    ['STATUS                         ',clc$nominal_entry, 5],
    ['T                              ',clc$abbreviation_entry, 2],
    ['TYPE                           ',clc$nominal_entry, 2],
    ['VS                             ',clc$abbreviation_entry, 1],
    ['VSN_SEED                       ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [10, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation,
  clc$standard_parameter_checking, 33, clc$required_parameter, 0, 0],
{ PARAMETER 2
    [8, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation,
  clc$standard_parameter_checking, 118, clc$optional_default_parameter, 0, 8],
{ PARAMETER 3
    [5, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation,
  clc$standard_parameter_checking, 208, clc$optional_parameter, 0, 0],
{ PARAMETER 4
    [1, clc$hidden_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation,
  clc$standard_parameter_checking, 20, clc$optional_default_parameter, 0, 2],
{ PARAMETER 5
    [6, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation,
  clc$standard_parameter_checking, 3, clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$union_type], [[clc$name_type, clc$string_type],
    TRUE, 2],
    8, [[1, 0, clc$string_type], [1, 6, FALSE]],
    5, [[1, 0, clc$name_type], [1, 6]]
    ],
{ PARAMETER 2
    [[1, 0, clc$keyword_type], [3], [
    ['MT18$38000                     ', clc$nominal_entry,
  clc$normal_usage_entry, 3],
    ['MT9$1600                       ', clc$nominal_entry,
  clc$normal_usage_entry, 1],
    ['MT9$6250                       ', clc$nominal_entry,
  clc$normal_usage_entry, 2]]
    ,
    'mt9$6250'],
{ PARAMETER 3
    [[1, 0, clc$list_type], [192, 1, clc$max_list_size, 0, FALSE, FALSE],
      [[1, 0, clc$keyword_type], [5], [
      ['T1200                          ', clc$nominal_entry,
  clc$normal_usage_entry, 3],
      ['T200                           ', clc$nominal_entry,
  clc$normal_usage_entry, 5],
      ['T2400                          ', clc$nominal_entry,
  clc$normal_usage_entry, 2],
      ['T3600                          ', clc$nominal_entry,
  clc$normal_usage_entry, 1],
      ['T600                           ', clc$nominal_entry,
  clc$normal_usage_entry, 4]]
      ]
    ],
{ PARAMETER 4
    [[1, 0, clc$integer_type], [1, 100, 10],
    '98'],
{ PARAMETER 5
    [[1, 0, clc$status_type]]];

?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$vsn_seed = 1,
      p$type = 2,
      p$sizes = 3,
      p$percent_usable = 4,
      p$status = 5;

    VAR
      pvt: array [1 .. 5] of clt$parameter_value;

    VAR
      i: 0 .. rac$max_tape_sizes,
      size: clt$integer,
      sizes_p: ^clt$data_value,
      tape_sizes: rat$tape_sizes;


    status.normal := TRUE;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF rav$packing_list_header_p = NIL THEN
      osp$set_status_abnormal ('RA', rae$define_order_not_called, '', status);
      RETURN;
    IFEND;

    IF rav$packing_list_header_p^.order_medium <> rac$tape THEN
      osp$set_status_abnormal ('RA', rae$order_medium_not_tape, '', status);
      RETURN;
    IFEND;

    IF (pvt [p$type].value^.name_value = rac$mt18$38000) AND (pvt [p$sizes].specified) THEN
      osp$set_status_abnormal ('RA', rae$invalid_with_cartridge_tape, '', status);
      RETURN;
    IFEND;

    IF pvt[p$vsn_seed].value^.kind = clc$string THEN
      #TRANSLATE (osv$lower_to_upper, pvt [p$vsn_seed].value^.string_value^, rav$tape_information.vsn_seed);
    ELSE  { name value }
      rav$tape_information.vsn_seed := pvt [p$vsn_seed].value^.name_value;
    IFEND;

    rav$tape_information.tape_type := pvt [p$type].value^.name_value;
    rav$tape_information.percent_usable := pvt [p$percent_usable].value^.integer_value.value;

    { Set the tape class and density in the packing list header record.

    IF rav$tape_information.tape_type = rac$mt9$6250 THEN
      rav$packing_list_header_p^.tape_class := rmc$mt9;
      rav$packing_list_header_p^.tape_density := rmc$6250;
    ELSEIF rav$tape_information.tape_type = rac$mt9$1600 THEN
      rav$packing_list_header_p^.tape_class := rmc$mt9;
      rav$packing_list_header_p^.tape_density := rmc$1600;
    ELSE { rav$tape_information.tape_type = rac$mt18$38000 }
      rav$packing_list_header_p^.tape_class := rmc$mt18;
      rav$packing_list_header_p^.tape_density := rmc$38000;
    IFEND;

    { Register the available tape sizes with the tape information.

    FOR i := 1 TO rac$max_tape_sizes DO
      tape_sizes [i].feet := 0;
      tape_sizes [i].usable_bytes := 0;
    FOREND;

    IF rav$tape_information.tape_type = rac$mt18$38000 THEN
      tape_sizes [1].feet := 540;

    ELSE { tape_type = rac$mt9$1600 OR rac$mt9$6250 }
      IF NOT pvt [p$sizes].specified THEN
        tape_sizes [1].feet := 2400;  {use the default}
      ELSE {sizes parameter specified}

        sizes_p := pvt [p$sizes].value;
        i := 0;

        WHILE sizes_p <> NIL DO
          i := i + 1;

          clp$convert_string_to_integer (sizes_p^.element_value^.name_value (2, * ), size, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

          tape_sizes [i].feet := size.value;
          sizes_p := sizes_p^.link;
        WHILEND;

        sort_tape_sizes (tape_sizes);
      IFEND;
    IFEND;

    rav$tape_information.sizes := tape_sizes;

  PROCEND rap$define_tape_attributes;

?? TITLE := 'sort_tape_sizes', EJECT ??

{ PURPOSE:
{   This procedure sorts the tape_sizes in descending order
{   and deletes duplicate entries.
{
{ DESIGN:
{   This procedure uses a shell sort technique.
{
{ NOTES:
{
{

  PROCEDURE sort_tape_sizes
    (VAR tape_sizes: rat$tape_sizes);

    VAR
      current: integer,
      gap: integer,
      start: integer,
      swap: integer;


    gap := UPPERBOUND (tape_sizes);
    WHILE gap > 1 DO
      gap := 2 * (gap DIV 4) + 1;
      FOR start := LOWERBOUND (tape_sizes) TO UPPERBOUND (tape_sizes) - gap DO
        current := start;
        WHILE (current > 0) AND (tape_sizes [current].feet < tape_sizes [current + gap].feet) DO
          swap := tape_sizes [current].feet;
          tape_sizes [current].feet := tape_sizes [current + gap].feet;
          tape_sizes [current + gap].feet := swap;
          current := current - gap;
        WHILEND;
      FOREND;
    WHILEND;

  /delete_duplicates/
    FOR start := LOWERBOUND (tape_sizes) TO UPPERBOUND (tape_sizes) - 1 DO
      IF tape_sizes [start + 1].feet = 0 THEN
        EXIT /delete_duplicates/;
      ELSEIF tape_sizes [start].feet = tape_sizes [start + 1].feet THEN
        tape_sizes [start + 1].feet := 0;
        sort_tape_sizes (tape_sizes);
      IFEND;
    FOREND /delete_duplicates/;

  PROCEND sort_tape_sizes;

MODEND ram$define_tape_attributes;
