
?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE Screen Formatting: Create Form' ??
MODULE fdm$process_object;

{ PURPOSE:
{   This module creates, changes, and gets data about a form object definition.
{
{ DESIGN:
{   Do not make any changes to a stored form object definition if any of the
{   changes are invalid.
{
{ NOTES:
{  All external procedures appear first in alphabetical order.  Then all the
{  procedures internal to this module.

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??

?? PUSH (LISTEXT := ON) ??
*copyc cyd$run_time_error_condition
*copyc fde$condition_identifiers
*copyc fdc$system_design_variable_name
*copyc fdc$system_occurrence
*copyc fdt$form_identifier
*copyc fdt$form_object_definition
*copyc fdt$form_objects
*copyc fdt$get_object_attributes
*copyc fdt$number_objects
*copyc fdt$object_attributes
*copyc fdt$object_definition
*copyc fdt$object_attribute_index
*copyc ost$name
?? POP ??

*copyc fdv$background_colors
*copyc fdv$colors
*copyc fdv$foreground_colors
*copyc fdv$object_display_directions

*copyc fdp$check_for_overlayed_objects
*copyc fdp$find_change_form_definition
*copyc fdp$find_form_definition
*copyc fdp$find_object_definition
*copyc fdp$find_variable_definition
*copyc fdp$get_string_variable
*copyc fdp$locate_added_variable_facts
*copyc fdp$ptr_event_command
*copyc fdp$ptr_objects
*copyc fdp$ptr_text
*copyc fdp$rel_event_command
*copyc fdp$rel_events
*copyc fdp$rel_objects
*copyc fdp$rel_text
*copyc fdp$record_screen_change
*copyc fdp$replace_string_variable
*copyc fdp$validate_name
*copyc pmp$continue_to_cause
*copyc osp$append_status_integer
*copyc osp$append_status_parameter
*copyc osp$disestablish_cond_handler
*copyc osp$establish_condition_handler
*copyc osp$set_status_abnormal

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

  CONST
    fdc$initial_x_position = 1,
    fdc$initial_y_position = 1,
    fdc$objects_to_expand = 20;

?? TITLE := 'fdp$add_object_to_form_image', EJECT ??
*copyc fdh$add_object_to_form_image

  PROCEDURE [XDCL] fdp$add_object_to_form_image
    (    p_form_image: ^fdt$form_image;
         p_form_object_definition: ^fdt$form_object_definition);

    VAR
      current_x_position: fdt$x_position,
      current_y_position: fdt$y_position,
      end_object_x_position: fdt$x_position,
      end_object_y_position: fdt$y_position,
      x_position: fdt$x_position,
      y_position: fdt$y_position;

    x_position := p_form_object_definition^.x_position;
    y_position := p_form_object_definition^.y_position;

{ Mark characters in form image occupied by object.  Other procedures check the
{ character image of the form to make sure that objects do not overlay each other.

    CASE p_form_object_definition^.key OF

    = fdc$form_box =
      end_object_x_position := x_position + p_form_object_definition^.box_width - 1;
      end_object_y_position := y_position + p_form_object_definition^.box_height - 1;

{ Create top and bottom line of box.

      FOR current_x_position := x_position TO end_object_x_position DO
        p_form_image^ [y_position] (current_x_position, 1) := '-';
        p_form_image^ [end_object_y_position] (current_x_position, 1) := '-';
      FOREND;


{ Create left and right vertical line of box.

      FOR current_y_position := y_position + 1 TO end_object_y_position - 1 DO
        p_form_image^ [current_y_position] (x_position, 1) := '|';
        p_form_image^ [current_y_position] (end_object_x_position, 1) := '|';
      FOREND;

    = fdc$form_line =
      IF (p_form_object_definition^.y_increment = 0) THEN

{ Create a horizontal line.

        FOR current_x_position := x_position TO x_position + p_form_object_definition^.x_increment DO
          p_form_image^ [y_position] (current_x_position, 1) := '-';
        FOREND;

      ELSE

{ Create a vertical line.

        FOR current_y_position := y_position TO y_position + p_form_object_definition^.y_increment DO
          p_form_image^ [current_y_position] (x_position, 1) := '|';
        FOREND;
      IFEND;

    = fdc$form_variable_text =
      FOR current_x_position := x_position TO x_position + p_form_object_definition^.text_variable_width -
            1 DO
        p_form_image^ [y_position] (current_x_position, 1) := 'v';
      FOREND;

    = fdc$form_variable_text_box =
      FOR current_y_position := y_position TO y_position + p_form_object_definition^.variable_box_height -
            1 DO
        FOR current_x_position := x_position TO x_position + p_form_object_definition^.variable_box_width -
              1 DO
          p_form_image^ [current_y_position] (current_x_position, 1) := 'v';
        FOREND;
      FOREND;

    = fdc$form_constant_text =
      FOR current_x_position := x_position TO x_position + p_form_object_definition^.constant_text_width -
            1 DO
        p_form_image^ [y_position] (current_x_position, 1) := 'c';
      FOREND;

    = fdc$form_constant_text_box =
      FOR current_y_position := y_position TO y_position + p_form_object_definition^.constant_box_height -
            1 DO
        FOR current_x_position := x_position TO x_position + p_form_object_definition^.constant_box_width -
              1 DO
          p_form_image^ [current_y_position] (current_x_position, 1) := 'c';
        FOREND;
      FOREND;

    ELSE { Ignore object. }
    CASEND;

  PROCEND fdp$add_object_to_form_image;

?? TITLE := 'fdp$allocate_object', EJECT ??

  PROCEDURE [XDCL] fdp$allocate_object
    (    p_form_status: ^fdt$form_status;
     VAR p_form_object_definition: ^fdt$form_object_definition;
     VAR object_index: fdt$object_index;
     VAR status: ost$status);

    VAR
      i: fdt$object_index,
      number_objects: fdt$number_objects,
      p_new_object_definitions: ^array [1 .. * ] of fdt$form_object_definition,
      p_old_object_definitions: ^array [1 .. * ] of fdt$form_object_definition,
      p_form_definition: ^fdt$form_definition;

?? OLDTITLE ??
?? NEWTITLE := 'allocate_form_object_statuses', EJECT ??

    PROCEDURE [INLINE] allocate_form_object_statuses;

      VAR
        n: fdt$object_index,
        p_new_form_object_statuses: ^array [1 .. * ] of fdt$form_object_status,
        p_old_form_object_statuses: ^array [1 .. * ] of fdt$form_object_status;

      p_old_form_object_statuses := p_form_status^.p_form_object_statuses;

{ Allocate object status to record the current dynamic data for a form object.
{ It contains data about the current display attributes and first character position displayed.
{ Program requests change the current display attributes and the first character position displayed.
{ Terminal user paging and scrolling commands change the first character position displayed.

      ALLOCATE p_new_form_object_statuses: [1 .. UPPERBOUND (p_form_status^.p_form_object_definitions^)];
      IF p_new_form_object_statuses = NIL THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
        RETURN;
      IFEND;

      p_form_status^.total_form_object_statuses := UPPERBOUND (p_form_status^.p_form_object_definitions^);
      p_form_status^.active_form_object_statuses := UPPERBOUND (p_form_status^.p_form_object_definitions^);

{ Copy old objects to new array.

      IF p_old_form_object_statuses <> NIL THEN
        FOR n := 1 TO UPPERBOUND (p_old_form_object_statuses^) DO
          p_new_form_object_statuses^ [n] := p_old_form_object_statuses^ [n];
        FOREND;

        FOR n := UPPERBOUND (p_old_form_object_statuses^) + 1 TO UPPERBOUND (p_new_form_object_statuses^) DO
          p_new_form_object_statuses^ [n].key := fdc$unused_identifier;
        FOREND;

        FREE p_old_form_object_statuses;
      IFEND;
      p_form_status^.p_form_object_statuses := p_new_form_object_statuses;
    PROCEND allocate_form_object_statuses;

?? OLDTITLE, EJECT ??

    status.normal := TRUE;
    p_old_object_definitions := p_form_status^.p_form_object_definitions;
    p_form_definition := p_form_status^.p_form_definition;
    IF p_old_object_definitions = NIL THEN
      NEXT p_new_object_definitions: [1 .. fdc$objects_to_expand] IN p_form_status^.p_form_module;
      IF p_new_object_definitions = NIL THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
        RETURN;
      IFEND;

      fdp$rel_objects (p_new_object_definitions, p_form_status);
      p_form_object_definition := ^p_new_object_definitions^ [1];
      p_form_definition^.form_object_definitions.active_number := 1;
      object_index := 1;
      IF p_form_status^.opened THEN
        allocate_form_object_statuses;
      IFEND;
      RETURN;
    IFEND;

{ Try to find an inactive entry for new object.

    number_objects := p_form_definition^.form_object_definitions.active_number;
    IF number_objects < p_form_definition^.form_object_definitions.total_number THEN
      number_objects := number_objects + 1;
      p_form_definition^.form_object_definitions.active_number := number_objects;
      p_form_object_definition := ^p_old_object_definitions^ [number_objects];
      object_index := number_objects;
      RETURN;
    IFEND;

{ Expand the array for objects.  Minimize number of allocates by including a few extra entries.

    NEXT p_new_object_definitions: [1 .. fdc$objects_to_expand + number_objects] IN
          p_form_status^.p_form_module;
    IF p_new_object_definitions = NIL THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
      RETURN;
    IFEND;

{ Copy old objects to new array.

    FOR i := 1 TO number_objects DO
      p_new_object_definitions^ [i] := p_old_object_definitions^ [i];
    FOREND;

    fdp$rel_objects (p_new_object_definitions, p_form_status);
    number_objects := number_objects + 1;
    p_form_definition^.form_object_definitions.active_number := number_objects;
    p_form_object_definition := ^p_new_object_definitions^ [number_objects];
    object_index := number_objects;
    IF p_form_status^.opened THEN
      allocate_form_object_statuses;
    IFEND;
  PROCEND fdp$allocate_object;

?? TITLE := 'fdp$change_object', EJECT ??
*copyc fdh$change_object

  PROCEDURE [XDCL] fdp$change_object
    (    form_identifier: fdt$form_identifier;
         x_position: fdt$x_position;
         y_position: fdt$y_position;
     VAR object_attributes: fdt$object_attributes;
     VAR status: ost$status);

    VAR
      form_object_key: fdt$form_object_key,
      fragment_object_index: fdt$object_index,
      new_object_definition: fdt$form_object_definition,
      new_object_index: fdt$object_index,
      object_attribute_index: fdt$object_attribute_index,
      object_exists: boolean,
      occurrence: fdt$occurrence,
      old_object_definition: fdt$form_object_definition,
      old_object_index: fdt$object_index,
      p_form_definition: ^fdt$form_definition,
      p_form_module: ^fdt$form_module,
      p_form_object_definitions: ^array [1 .. * ] of fdt$form_object_definition,
      p_form_object_statuses: ^array [1 .. * ] of fdt$form_object_status,
      p_form_status: ^fdt$form_status,
      p_new_object_definition: ^fdt$form_object_definition,
      p_old_object_definition: ^fdt$form_object_definition,
      p_text: ^fdt$text,
      screen_change: fdt$screen_change,
      variable_name: ost$name,
      text_length: fdt$text_length,
      variable_status: fdt$variable_status;

?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$change_object;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$change_object;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE, EJECT ??
    osp$establish_condition_handler (^condition_handler, FALSE);
    FOR object_attribute_index := LOWERBOUND (object_attributes) TO UPPERBOUND (object_attributes) DO
      object_attributes [object_attribute_index].put_value_status := fdc$unprocessed_put_value;
    FOREND;

    fdp$find_change_form_definition (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    p_form_definition := p_form_status^.p_form_definition;
    p_form_object_definitions := p_form_status^.p_form_object_definitions;
    find_form_object (p_form_status, x_position, y_position, p_form_object_definitions,
          p_form_definition^.form_object_definitions.active_number, p_old_object_definition,
          old_object_index, object_exists);
    IF NOT object_exists THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$no_object_at_position, '', status);
      osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (x_position), 10, FALSE, status);
      osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (y_position), 10, FALSE, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
      RETURN;
    IFEND;


{ Work with a copy of the form object definition to prevent any invalid changes being made to it.

    old_object_definition := p_old_object_definition^;
    p_new_object_definition := p_old_object_definition;
    new_object_definition := p_new_object_definition^;
    change_object (p_form_status, p_form_definition, ^new_object_definition, object_attributes, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{  The object must reside inside form.

    IF NOT p_form_status^.fast_form_creation THEN
      fdp$check_object_inside_form (p_form_definition^.form_area, ^new_object_definition,
            p_form_definition^.form_name, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

{ Delete old object from the form character image to allow later checking of overlaying of other
{ objects.

    IF p_form_status^.p_form_image <> NIL THEN
      IF NOT (p_form_status^.design_form AND (old_object_definition.key = fdc$form_variable_text) AND
            (p_form_status^.design_variable_name = old_object_definition.name)) THEN
        delete_object_from_form_image (p_form_status^.p_form_image,
             ^old_object_definition);
      IFEND;
    IFEND;

{ The object cannot overlay any existing objects.

    IF p_form_status^.p_form_image <> NIL THEN
      fdp$check_for_overlayed_objects (p_form_status^.p_form_image, ^new_object_definition,
            p_form_definition^.form_name, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

{ Record object in character image of form to allow easy checking of overlaying of objects.

    IF p_form_status^.p_form_image <> NIL THEN
      IF NOT (p_form_status^.design_form AND (old_object_definition.key =
            fdc$form_variable_text) AND
            (p_form_status^.design_variable_name = old_object_definition.name)) THEN
        fdp$add_object_to_form_image (p_form_status^.p_form_image, ^new_object_definition);
      IFEND;
    IFEND;

{ If all changes are valid, update the object in the form.

    CASE new_object_definition.key OF

    = fdc$form_constant_text_box =

{ Create new objects for constant text box.  The position, height, and width
{ of object fragments may have changed.

      fdp$allocate_object (p_form_status, p_new_object_definition,
            new_object_index, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      p_new_object_definition^ := new_object_definition;
      fragment_object_index := 0;
      IF new_object_definition.constant_box_height > 1 THEN
        create_fragments (p_form_status, new_object_index,
              new_object_definition.constant_box_width,
              new_object_definition.constant_box_height,
              fragment_object_index, p_new_object_definition,
              p_form_object_definitions, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;

      p_new_object_definition^.constant_box_fragment_index := fragment_object_index;

{ Delete old objects for constant text box.

      fragment_object_index := old_object_definition.constant_box_fragment_index;
      WHILE fragment_object_index <> 0 DO
        delete_form_object (fragment_object_index, p_form_object_definitions);
        fragment_object_index :=  p_form_object_definitions^
              [fragment_object_index].next_fragment_object_index;
      WHILEND;
      delete_form_object (old_object_index, p_form_object_definitions);

    = fdc$form_variable_text_box =

{ Create new objects for variable text box.  The position, height, and width
{ of object fragments may have changed.

      fdp$allocate_object (p_form_status, p_new_object_definition,
            new_object_index, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      p_new_object_definition^ := new_object_definition;
      fragment_object_index := 0;
      IF new_object_definition.variable_box_height > 1 THEN
        create_fragments (p_form_status, new_object_index,
              new_object_definition.variable_box_width,
              new_object_definition.variable_box_height,
              fragment_object_index, p_new_object_definition,
              p_form_object_definitions, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        p_new_object_definition^.variable_box_fragment_index := fragment_object_index;

{ Delete old objects.

      fragment_object_index := old_object_definition.variable_box_fragment_index;
      WHILE fragment_object_index <> 0 DO
        delete_form_object (fragment_object_index, p_form_object_definitions);
        fragment_object_index := p_form_object_definitions^
              [fragment_object_index].next_fragment_object_index;
      WHILEND;

        delete_form_object (old_object_index, p_form_object_definitions);
      IFEND;

    ELSE

{ Only one object is involved, so simply replace it.

      new_object_index := old_object_index;
      p_new_object_definition^ := new_object_definition;
    CASEND;

    IF NOT p_form_status^.design_form THEN
      RETURN;
    IFEND;

{ Delete any free text under an object, so that the free text will not appear if the
{ object is later deleted.  The free text also needs to be deleted so constant objects
{ are not latter created with the fdp$create_constant_text request.

    delete_free_text_under_object (form_identifier, p_new_object_definition^,
          p_form_definition, p_form_status, status);

{ Record screen changes for next screen update.

    p_form_object_statuses := p_form_status^.p_form_object_statuses;
    form_object_key := old_object_definition.key;
    screen_change.key := fdc$delete_object;
    screen_change.object_form_identifier := form_identifier;
    screen_change.object_definition := old_object_definition;
    CASE form_object_key OF

    = fdc$form_constant_text_box =
      fragment_object_index := old_object_definition.constant_box_fragment_index;
      IF (p_form_status^.displayed_on_screen AND p_form_status^.added) THEN
        screen_change.object_index := old_object_index;
        fdp$record_screen_change (screen_change, status);
      ELSE
        p_form_object_statuses^ [old_object_index].key := fdc$unused_identifier;
      IFEND;

      WHILE fragment_object_index <> 0 DO
        IF (p_form_status^.displayed_on_screen AND p_form_status^.added) THEN
          screen_change.object_index := fragment_object_index;
          fdp$record_screen_change (screen_change, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        ELSE
          p_form_object_statuses^ [fragment_object_index].key := fdc$unused_identifier;
        IFEND;

        fragment_object_index := p_form_object_definitions^
              [fragment_object_index].next_fragment_object_index;
      WHILEND;

    = fdc$form_variable_text_box =
      fragment_object_index := old_object_definition.variable_box_fragment_index;
      IF (p_form_status^.displayed_on_screen AND p_form_status^.added) THEN
        screen_change.object_index := old_object_index;
        fdp$record_screen_change (screen_change, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      ELSE
        p_form_object_statuses^ [old_object_index].key := fdc$unused_identifier;
      IFEND;

      WHILE fragment_object_index <> 0 DO
        IF (p_form_status^.displayed_on_screen AND p_form_status^.added) THEN
          screen_change.object_index := fragment_object_index;
          fdp$record_screen_change (screen_change, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        ELSE
          p_form_object_statuses^ [fragment_object_index].key := fdc$unused_identifier;
        IFEND;
        fragment_object_index := p_form_object_definitions^
              [fragment_object_index].next_fragment_object_index;
      WHILEND;

    ELSE
      IF (p_form_status^.displayed_on_screen AND p_form_status^.added) THEN
        screen_change.object_index := old_object_index;
        fdp$record_screen_change (screen_change, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      ELSE
        p_form_object_statuses^ [old_object_index].key := fdc$unused_identifier;
      IFEND;
    CASEND;

    IF ((p_form_status^.added) AND (p_form_status^.displayed_on_screen)) THEN
      screen_change.key := fdc$add_object;
      screen_change.object_index := new_object_index;
      screen_change.object_definition := p_new_object_definition^;
      fdp$record_screen_change (screen_change, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

    ELSE
      p_form_status^.p_form_object_statuses^ [new_object_index].
            display_attribute_set := p_new_object_definition^.display_attribute;
    IFEND;

  PROCEND fdp$change_object;

?? TITLE := 'fdp$change_stored_object', EJECT ??
*copyc fdh$change_stored_object

  PROCEDURE [XDCL] fdp$change_stored_object
    (    form_identifier: fdt$form_identifier;
         name: ost$name;
         occurrence: fdt$occurrence;
         text: fdt$text;
         display_attribute_set: fdt$display_attribute_set;
     VAR status: ost$status);

    VAR
      name_is_valid: boolean,
      object_index: fdt$object_index,
      object_name_exists: boolean,
      object_occurrence_exists: boolean,
      p_form_definition: ^fdt$form_definition,
      p_form_object_definition: ^fdt$form_object_definition,
      p_form_object_definitions: ^array [1 .. * ] of fdt$form_object_definition,
      p_form_status: ^fdt$form_status,
      p_new_text: ^fdt$text,
      p_stored_text: ^fdt$text,
      valid_name: ost$name;

?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$change_stored_object;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$change_stored_object;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE, EJECT ??
    osp$establish_condition_handler (^condition_handler, FALSE);
    fdp$find_change_form_definition (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    p_form_definition := p_form_status^.p_form_definition;
    p_form_object_definitions := p_form_status^.p_form_object_definitions;
    fdp$validate_name (name, p_form_definition^.processor, valid_name, name_is_valid);
    IF NOT name_is_valid THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_object_name, name, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    IF ((occurrence < 1) OR (occurrence > fdc$maximum_occurrence)) THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_occurrence, '', status);
      osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (occurrence), 10, FALSE, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, name, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    p_form_object_definitions := p_form_status^.p_form_object_definitions;

{ The object name and occurrence must exist.

    fdp$find_object_definition (valid_name, occurrence, p_form_object_definitions,
          p_form_definition^.form_object_definitions.active_number, p_form_object_definition, object_index,
          object_name_exists, object_occurrence_exists);
    IF NOT object_name_exists THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$unknown_object_name, name, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    IF NOT object_occurrence_exists THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_occurrence, '', status);
      osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (occurrence), 10, FALSE, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, valid_name, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    NEXT p_new_text: [STRLENGTH (text)] IN p_form_status^.p_form_module;
    IF p_new_text = NIL THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
      RETURN;
    IFEND;

{ Update initial text and display attributes for stored object.

    fdp$rel_text (p_new_text, p_form_status^.p_form_module, p_form_object_definition^.stored_variable_text);
    p_new_text^ := text;
    fdp$set_display_attributes (p_form_definition^.display_attribute, display_attribute_set,
          p_form_object_definition^.display_attribute);

  PROCEND fdp$change_stored_object;

?? TITLE := 'fdp$check_object_inside_form', EJECT ??
*copyc fdh$check_object_inside_form

  PROCEDURE [XDCL] fdp$check_object_inside_form
    (    form_area: fdt$form_area;
         p_form_object_definition: ^fdt$form_object_definition;
         form_name: ost$name;
     VAR status: ost$status);

    VAR
      highest_x_position: fdt$x_position,
      highest_y_position: fdt$y_position,
      x_position: fdt$x_position,
      y_position: fdt$y_position;

    status.normal := TRUE;
    IF form_area.key = fdc$defined_area THEN

{ If form area is the terminal screen area, no checks can be made.
{ Screen Formatting does not know what size the terminal screen is
{ until the application actually uses the form to interact with a
{ terminal user.

      x_position := p_form_object_definition^.x_position;
      y_position := p_form_object_definition^.y_position;

{ Compute the highest x and y positions.

      CASE p_form_object_definition^.key OF

      = fdc$form_box =
        highest_x_position := x_position + p_form_object_definition^.box_width - 1;
        highest_y_position := y_position + p_form_object_definition^.box_height - 1;


      = fdc$form_line =
        highest_x_position := x_position + p_form_object_definition^.x_increment;
        highest_y_position := y_position + p_form_object_definition^.y_increment;

      = fdc$form_variable_text =
        highest_x_position := p_form_object_definition^.text_variable_width + x_position - 1;
        highest_y_position := y_position;

      = fdc$form_variable_text_box =
        highest_x_position := x_position + p_form_object_definition^.variable_box_width - 1;
        highest_y_position := y_position + p_form_object_definition^.variable_box_height - 1;

      = fdc$form_constant_text =
        highest_x_position := p_form_object_definition^.constant_text_width + x_position - 1;
        highest_y_position := y_position;

      = fdc$form_constant_text_box =
        highest_x_position := x_position + p_form_object_definition^.constant_box_width - 1;
        highest_y_position := y_position + p_form_object_definition^.constant_box_height - 1;

      ELSE { Ignore object. }
        RETURN;
      CASEND;

      IF ((highest_x_position > form_area.width) OR (highest_y_position > form_area.height)) THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$object_not_in_form, '', status);
        osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (x_position), 10, FALSE, status);
        osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (y_position), 10, FALSE, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, form_name, status);
      IFEND;
    IFEND;
  PROCEND fdp$check_object_inside_form;

?? TITLE := 'fdp$create_object', EJECT ??
*copyc fdh$create_object

  PROCEDURE [XDCL] fdp$create_object
    (    form_identifier: fdt$form_identifier;
         x_position: fdt$x_position;
         y_position: fdt$y_position;
         object_definition: fdt$object_definition;
     VAR object_attributes: fdt$object_attributes;
     VAR status: ost$status);

    VAR
      display_attribute_set: fdt$display_attribute_set,
      form_object_definition: fdt$form_object_definition,
      fragment_object_index: fdt$object_index,
      high_x_position: fdt$x_position,
      high_y_position: fdt$y_position,
      number_objects: fdt$number_objects,
      object_attribute_index: fdt$object_attribute_index,
      object_exists: boolean,
      object_index: fdt$object_index,
      occurrence: fdt$occurrence,
      p_form_definition: ^fdt$form_definition,
      p_form_module: ^fdt$form_module,
      p_form_object_definition: ^fdt$form_object_definition,
      p_form_object_definitions: ^array [1 .. * ] of fdt$form_object_definition,
      p_form_status: ^fdt$form_status,
      p_text: ^fdt$text,
      screen_change: fdt$screen_change,
      text_length: fdt$text_length,
      variable_name: ost$name,
      variable_status: fdt$variable_status;

?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$create_object;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$create_object;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE ??
?? OLDTITLE, EJECT ??

    osp$establish_condition_handler (^condition_handler, FALSE);
    FOR object_attribute_index := LOWERBOUND (object_attributes) TO UPPERBOUND (object_attributes) DO
      object_attributes [object_attribute_index].put_value_status := fdc$unprocessed_put_value;
    FOREND;

    fdp$find_change_form_definition (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    p_form_definition := p_form_status^.p_form_definition;
    IF ((x_position < 1) OR (x_position > fdc$maximum_x_position)) THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_x_position, '', status);
      osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (x_position), 10, FALSE, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    IF ((y_position < 1) OR (y_position > fdc$maximum_y_position)) THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_y_position, '', status);
      osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (y_position), 10, FALSE, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    p_form_object_definitions := p_form_status^.p_form_object_definitions;
    number_objects := p_form_definition^.form_object_definitions.active_number;
    p_form_module := p_form_status^.p_form_module;

    fdp$set_display_attributes (p_form_definition^.display_attribute, $fdt$display_attribute_set
          [fdc$protect], form_object_definition.display_attribute);

{ Set generic default values for form object definition.

    form_object_definition.name := osc$null_name;
    form_object_definition.occurrence := 1;
    form_object_definition.x_position := x_position;
    form_object_definition.y_position := y_position;

{ Validate object definition according to type of object.
{ Set default values appropriate to type of object.

    CASE object_definition.key OF

    = fdc$box =
      IF ((object_definition.box_width < 1) OR (object_definition.box_width > fdc$maximum_x_position)) THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_width, '', status);
        osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (object_definition.box_width), 10,
              FALSE, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
        RETURN;
      IFEND;

      IF ((object_definition.box_height < 1) OR (object_definition.box_height > fdc$maximum_y_position)) THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_height, '', status);
        osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (object_definition.box_height),
              10, FALSE, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
        RETURN;
      IFEND;

      form_object_definition.key := fdc$form_box;
      form_object_definition.box_width := object_definition.box_width;
      form_object_definition.box_height := object_definition.box_height;
      form_object_definition.display_attribute := form_object_definition.display_attribute +
            $fdt$display_attribute_set [fdc$medium_line];

    = fdc$line =
      IF ((object_definition.x_increment < 0) OR (object_definition.x_increment > fdc$maximum_x_position))
            THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_x_increment, '', status);
        osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (object_definition.x_increment),
              10, FALSE, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
        RETURN;
      IFEND;

      IF ((object_definition.y_increment < 0) OR (object_definition.y_increment > fdc$maximum_y_position))
            THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_y_increment, '', status);
        osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (object_definition.y_increment),
              10, FALSE, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
        RETURN;
      IFEND;

      form_object_definition.key := fdc$form_line;
      form_object_definition.x_increment := object_definition.x_increment;
      form_object_definition.y_increment := object_definition.y_increment;
      form_object_definition.display_attribute := form_object_definition.display_attribute +
            $fdt$display_attribute_set [fdc$medium_line];

    = fdc$constant_text =
      IF ((object_definition.constant_text_width < 1) OR (object_definition.constant_text_width >
            fdc$maximum_x_position)) THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_width, '', status);
        osp$append_status_integer (osc$status_parameter_delimiter,
              $INTEGER (object_definition.constant_text_width), 10, FALSE, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
        RETURN;
      IFEND;

      IF object_definition.p_constant_text = NIL THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$no_text_for_object,
              p_form_definition^.form_name, status);
        RETURN;
      IFEND;

      NEXT p_text: [STRLENGTH (object_definition.p_constant_text^)] IN p_form_status^.p_form_module;
      IF p_text = NIL THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
        RETURN;
      IFEND;

      form_object_definition.key := fdc$form_constant_text;
      p_text^ := object_definition.p_constant_text^;
      fdp$rel_text (p_text, p_form_module, form_object_definition.constant_text);
      form_object_definition.constant_text_width := object_definition.constant_text_width;

    = fdc$constant_text_box =
      IF ((object_definition.constant_box_width < 1) OR (object_definition.constant_box_width >
            fdc$maximum_x_position)) THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_width, '', status);
        osp$append_status_integer (osc$status_parameter_delimiter,
              $INTEGER (object_definition.constant_box_width), 10, FALSE, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
        RETURN;
      IFEND;

      IF ((object_definition.constant_box_height < 1) OR (object_definition.constant_box_height >
            fdc$maximum_y_position)) THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_height, '', status);
        osp$append_status_integer (osc$status_parameter_delimiter,
              $INTEGER (object_definition.constant_box_height), 10, FALSE, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
        RETURN;
      IFEND;

      CASE object_definition.constant_box_processing OF

      = fdc$wrap_characters, fdc$wrap_words =

      ELSE
        osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_text_processing,
              p_form_definition^.form_name, status);
        RETURN;
      CASEND;

      form_object_definition.constant_box_processing := object_definition.constant_box_processing;
      IF object_definition.p_constant_box_text = NIL THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$no_text_for_object,
              p_form_definition^.form_name, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
        RETURN;
      IFEND;

      NEXT p_text: [STRLENGTH (object_definition.p_constant_box_text^)] IN p_form_status^.p_form_module;
      IF p_text = NIL THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
        RETURN;
      IFEND;

      form_object_definition.key := fdc$form_constant_text_box;
      form_object_definition.constant_box_width := object_definition.constant_box_width;
      form_object_definition.constant_box_height := object_definition.constant_box_height;
      form_object_definition.constant_box_fragment_index := 0;
      p_text^ := object_definition.p_constant_box_text^;
      fdp$rel_text (p_text, p_form_module, form_object_definition.constant_box_text);

    = fdc$table =
      IF ((object_definition.table_width < 1) OR (object_definition.table_width > fdc$maximum_x_position))
            THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_width, '', status);
        osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (object_definition.table_width),
              10, FALSE, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
        RETURN;
      IFEND;

      IF ((object_definition.table_height < 1) OR (object_definition.table_height > fdc$maximum_y_position))
            THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_height, '', status);
        osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (object_definition.table_height),
              10, FALSE, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
        RETURN;
      IFEND;

      form_object_definition.key := fdc$form_table;
      form_object_definition.table_height := object_definition.table_height;
      form_object_definition.table_width := object_definition.table_width;

    = fdc$variable_text =
      IF ((object_definition.variable_text_width < 1) OR (object_definition.variable_text_width >
            fdc$maximum_x_position)) THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_width, '', status);
        osp$append_status_integer (osc$status_parameter_delimiter,
              $INTEGER (object_definition.variable_text_width), 10, FALSE, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
        RETURN;
      IFEND;

      IF object_definition.p_variable_text = NIL THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$no_text_for_object,
              p_form_definition^.form_name, status);
        RETURN;
      IFEND;

      NEXT p_text: [STRLENGTH (object_definition.p_variable_text^)] IN p_form_status^.p_form_module;
      IF p_text = NIL THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
        RETURN;
      IFEND;

      form_object_definition.key := fdc$form_variable_text;
      form_object_definition.text_variable_exists := FALSE;
      form_object_definition.text_variable_width := object_definition.variable_text_width;
      p_text^ := object_definition.p_variable_text^;
      fdp$rel_text (p_text, p_form_module, form_object_definition.text_variable_text);

    = fdc$variable_text_box =
      IF ((object_definition.variable_box_width < 1) OR (object_definition.variable_box_width >
            fdc$maximum_x_position)) THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_width, '', status);
        osp$append_status_integer (osc$status_parameter_delimiter,
              $INTEGER (object_definition.variable_box_width), 10, FALSE, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
        RETURN;
      IFEND;

      IF ((object_definition.variable_box_height < 1) OR (object_definition.variable_box_height >
            fdc$maximum_y_position)) THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_height, '', status);
        osp$append_status_integer (osc$status_parameter_delimiter,
              $INTEGER (object_definition.variable_box_height), 10, FALSE, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
        RETURN;
      IFEND;

      IF object_definition.p_variable_box_text = NIL THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$no_text_for_object,
              p_form_definition^.form_name, status);
        RETURN;
      IFEND;

      CASE object_definition.variable_box_processing OF
      = fdc$wrap_characters, fdc$wrap_words =
      ELSE
        osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_text_processing,
              p_form_definition^.form_name, status);
        RETURN;
      CASEND;

      NEXT p_text: [STRLENGTH (object_definition.p_variable_box_text^)] IN p_form_status^.p_form_module;
      IF p_text = NIL THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
        RETURN;
      IFEND;

      form_object_definition.key := fdc$form_variable_text_box;
      form_object_definition.variable_box_variable_exists := FALSE;
      form_object_definition.variable_box_width := object_definition.variable_box_width;
      form_object_definition.variable_box_height := object_definition.variable_box_height;
      form_object_definition.variable_box_processing := object_definition.variable_box_processing;
      form_object_definition.variable_box_fragment_index := 0;
      p_text^ := object_definition.p_variable_box_text^;
      fdp$rel_text (p_text, p_form_module, form_object_definition.variable_box_text);

    ELSE

{ Invalid object definition key.

      osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_object_key,
            p_form_definition^.form_name, status);
      RETURN;
    CASEND;

{ Process object attributes.

    change_object (p_form_status, p_form_definition, ^form_object_definition, object_attributes, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ The object must reside inside the form.

    IF NOT p_form_status^.fast_form_creation THEN
      fdp$check_object_inside_form (p_form_definition^.form_area, ^form_object_definition,
            p_form_definition^.form_name, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

{ The object must not overlay any other objects.

    IF p_form_status^.p_form_image <> NIL THEN
      fdp$check_for_overlayed_objects (p_form_status^.p_form_image, ^form_object_definition,
            p_form_definition^.form_name, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

{ The object must be large enough to contain the output/Cobol formatting.

    CASE form_object_definition.key OF

    = fdc$form_variable_text =
      check_object_size (p_form_status, form_object_definition.name,
            form_object_definition.text_variable_width, status);
     IF NOT status.normal THEN
       RETURN;
     IFEND;

   = fdc$form_variable_text_box =
     check_object_size (p_form_status, form_object_definition.name,
           form_object_definition.variable_box_width *
           form_object_definition.variable_box_height, status);
     IF NOT status.normal THEN
       RETURN;
     IFEND;

   ELSE { Ignore other objects. }
   CASEND;

    fdp$allocate_object (p_form_status, p_form_object_definition, object_index, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    p_form_object_definitions := p_form_status^.p_form_object_definitions;

{ The object definition is valid.  Update the form definition to include the object.

    p_form_object_definition^ := form_object_definition;

    IF p_form_status^.p_form_image <> NIL THEN
      IF NOT (p_form_status^.design_form AND
            (form_object_definition.key = fdc$form_variable_text) AND
            (p_form_status^.design_variable_name = form_object_definition.name)) THEN
        fdp$add_object_to_form_image (p_form_status^.p_form_image, ^form_object_definition);
      IFEND;
    IFEND;

    CASE form_object_definition.key OF

    = fdc$form_constant_text_box =
      fragment_object_index :=  0;
      IF form_object_definition.constant_box_height > 1 THEN
        create_fragments (p_form_status, object_index,
              form_object_definition.constant_box_width,
              form_object_definition.constant_box_height,
              fragment_object_index, p_form_object_definition,
              p_form_object_definitions, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;
      p_form_object_definition^.constant_box_fragment_index := fragment_object_index;

    = fdc$form_variable_text_box =
      fragment_object_index :=  0;
      IF form_object_definition.variable_box_height > 1 THEN
        create_fragments (p_form_status, object_index,
              form_object_definition.variable_box_width,
              form_object_definition.variable_box_height,
              fragment_object_index, p_form_object_definition,
              p_form_object_definitions, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;
      p_form_object_definition^.variable_box_fragment_index := fragment_object_index;

    ELSE
    CASEND;

    IF NOT p_form_status^.design_form THEN
      RETURN;
    IFEND;

    IF NOT p_form_status^.opened THEN
      RETURN;
    IFEND;

{ Delete any free text under an object, so that the free text will not appear if the
{ object is later deleted.  The free text also needs to be deleted so constant objects
{ are not latter created with the fdp$create_constant_text request.

    delete_free_text_under_object (form_identifier, p_form_object_definition^,
          p_form_definition, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ Record changes for next screen update.

    IF (p_form_status^.displayed_on_screen AND p_form_status^.added) THEN
      screen_change.key := fdc$add_object;
      screen_change.object_form_identifier := form_identifier;
      screen_change.object_definition := p_form_object_definition^;
      screen_change.object_index := object_index;
      fdp$record_screen_change (screen_change, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

    ELSE

{ Set attributes of object for correct display when the form is on the screen.

      CASE p_form_object_definition^.key OF

      = fdc$form_constant_text_box =
        p_form_status^.p_form_object_statuses^ [object_index].display_attribute_set :=
              p_form_object_definition^.display_attribute;
        fragment_object_index := p_form_object_definition^.constant_box_fragment_index;
        WHILE fragment_object_index <> 0 DO
          p_form_status^.p_form_object_statuses^ [object_index].display_attribute_set :=
                p_form_object_definition^.display_attribute;
          fragment_object_index :=  p_form_object_definitions^
                [fragment_object_index].next_fragment_object_index;
        WHILEND;

      = fdc$form_variable_text_box =
        p_form_status^.p_form_object_statuses^ [object_index].display_attribute_set :=
              p_form_object_definition^.display_attribute;
        fragment_object_index := p_form_object_definition^.variable_box_fragment_index;
        WHILE fragment_object_index <> 0 DO
          p_form_status^.p_form_object_statuses^ [object_index].display_attribute_set :=
                p_form_object_definition^.display_attribute;
          fragment_object_index :=  p_form_object_definitions^
                [fragment_object_index].next_fragment_object_index;
        WHILEND;

      ELSE { Only one object is affect by attribute.
        p_form_status^.p_form_object_statuses^ [object_index].display_attribute_set :=
              p_form_object_definition^.display_attribute;
      CASEND;
    IFEND;

  PROCEND fdp$create_object;

?? TITLE := 'fdp$create_stored_object', EJECT ??
*copyc fdh$create_stored_object

  PROCEDURE [XDCL] fdp$create_stored_object
    (    form_identifier: fdt$form_identifier;
         name: ost$name;
         occurrence: fdt$occurrence;
         text: fdt$text;
         display_attribute_set: fdt$display_attribute_set;
     VAR status: ost$status);

    VAR
      name_exists: boolean,
      name_is_valid: boolean,
      object_index: fdt$object_index,
      object_name_exists: boolean,
      object_occurrence_exists: boolean,
      p_form_definition: ^fdt$form_definition,
      p_form_object_definition: ^fdt$form_object_definition,
      p_form_object_definitions: ^array [1 .. * ] of fdt$form_object_definition,
      p_form_status: ^fdt$form_status,
      p_new_text: ^fdt$text,
      p_stored_text: ^fdt$text,
      valid_name: ost$name;

?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$create_stored_object;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$create_stored_object;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE, EJECT ??
    osp$establish_condition_handler (^condition_handler, FALSE);
    fdp$find_change_form_definition (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    p_form_definition := p_form_status^.p_form_definition;
    p_form_object_definitions := p_form_status^.p_form_object_definitions;
    fdp$validate_name (name, p_form_definition^.processor, valid_name, name_is_valid);
    IF NOT name_is_valid THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_object_name, name, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    IF ((occurrence < 1) OR (occurrence > fdc$maximum_occurrence)) THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_occurrence, '', status);
      osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (occurrence), 10, FALSE, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, name, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    find_object_name (valid_name, occurrence, p_form_object_definitions,
          p_form_definition^.form_object_definitions.active_number, p_form_object_definition, object_index,
          name_exists);
    IF name_exists THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$object_occurrence_exists, '', status);
      osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (occurrence), 10, FALSE, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, name, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    NEXT p_new_text: [STRLENGTH (text)] IN p_form_status^.p_form_module;
    IF p_new_text = NIL THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
      RETURN;
    IFEND;

    fdp$allocate_object (p_form_status, p_form_object_definition, object_index, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    p_form_object_definition^.name := valid_name;
    p_form_object_definition^.occurrence := occurrence;
    p_form_object_definition^.x_position := 1;
    p_form_object_definition^.y_position := 1;
    p_form_object_definition^.key := fdc$form_stored_variable;
    fdp$rel_text (p_new_text, p_form_status^.p_form_module, p_form_object_definition^.stored_variable_text);
    p_new_text^ := text;
    fdp$set_display_attributes (p_form_definition^.display_attribute, display_attribute_set,
          p_form_object_definition^.display_attribute);

  PROCEND fdp$create_stored_object;

?? TITLE := 'fdp$delete_object', EJECT ??
*copyc fdh$delete_object

  PROCEDURE [XDCL] fdp$delete_object
    (    form_identifier: fdt$form_identifier;
         x_position: fdt$x_position;
         y_position: fdt$y_position;
     VAR status: ost$status);

    VAR
      form_object_key: fdt$form_object_key,
      fragment_object_index: fdt$object_index,
      fragment_y_position: fdt$y_position,
      height: fdt$height,
      local_status: ost$status,
      object_exists: boolean,
      object_index: fdt$object_index,
      p_form_definition: ^fdt$form_definition,
      p_form_image: ^fdt$form_image,
      p_form_object_definition: ^fdt$form_object_definition,
      p_form_object_definitions: ^array [1 .. * ] of fdt$form_object_definition,
      p_form_object_statuses: ^array [1 .. * ] of fdt$form_object_status,
      p_form_status: ^fdt$form_status,
      screen_change: fdt$screen_change;

?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$delete_object;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$delete_object;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE, EJECT ??
    osp$establish_condition_handler (^condition_handler, FALSE);
    fdp$find_change_form_definition (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    p_form_definition := p_form_status^.p_form_definition;
    p_form_object_definitions := p_form_status^.p_form_object_definitions;
    find_form_object (p_form_status, x_position, y_position, p_form_object_definitions,
          p_form_definition^.form_object_definitions.active_number, p_form_object_definition, object_index,
          object_exists);
    IF NOT object_exists THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$no_object_at_position, '', status);
      osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (x_position), 10, FALSE, status);
      osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (y_position), 10, FALSE, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    p_form_image := p_form_status^.p_form_image;
    p_form_object_statuses := p_form_status^.p_form_object_statuses;
    form_object_key := p_form_object_definition^.key;
    screen_change.key := fdc$delete_object;
    screen_change.object_form_identifier := form_identifier;
    CASE form_object_key OF

    = fdc$form_constant_text_box =
      screen_change.object_definition := p_form_object_definition^;
      fragment_object_index := p_form_object_definition^.constant_box_fragment_index;
      IF p_form_image <> NIL THEN
        delete_object_from_form_image (p_form_image, p_form_object_definition);
      IFEND;
      delete_form_object (object_index, p_form_object_definitions);
      IF p_form_status^.design_form THEN
        IF (p_form_status^.displayed_on_screen AND p_form_status^.added) THEN
          screen_change.object_definition := p_form_object_definition^;
          screen_change.object_index := object_index;
          fdp$record_screen_change (screen_change, local_status);
          IF NOT local_status.normal THEN
            status := local_status;
          IFEND;
        ELSE
          p_form_object_statuses^ [object_index].key := fdc$unused_identifier;
        IFEND;
      IFEND;

      WHILE fragment_object_index <> 0 DO
        delete_form_object (fragment_object_index, p_form_object_definitions);
        IF p_form_status^.design_form THEN
          IF (p_form_status^.displayed_on_screen AND p_form_status^.added) THEN
            screen_change.object_definition := p_form_object_definition^;
            screen_change.object_index := fragment_object_index;
            fdp$record_screen_change (screen_change, local_status);
            IF NOT local_status.normal THEN
              status := local_status;
            IFEND;
          ELSE
            p_form_object_statuses^ [fragment_object_index].key := fdc$unused_identifier;
          IFEND;
        IFEND;

        fragment_object_index := p_form_object_definitions^ [fragment_object_index].
              next_fragment_object_index;
      WHILEND;

    = fdc$form_variable_text_box =
      fragment_object_index := p_form_object_definition^.variable_box_fragment_index;
      screen_change.object_definition := p_form_object_definition^;
      IF p_form_image <> NIL THEN
        delete_object_from_form_image (p_form_image, p_form_object_definition);
      IFEND;
      delete_form_object (object_index, p_form_object_definitions);
      IF p_form_status^.design_form THEN
        IF (p_form_status^.displayed_on_screen AND p_form_status^.added) THEN
          screen_change.object_definition := p_form_object_definition^;
          screen_change.object_index := object_index;
          fdp$record_screen_change (screen_change, local_status);
          IF NOT local_status.normal THEN
            status := local_status;
          IFEND;
        ELSE
          p_form_object_statuses^ [object_index].key := fdc$unused_identifier;
        IFEND;
      IFEND;

      WHILE fragment_object_index <> 0 DO
        delete_form_object (fragment_object_index, p_form_object_definitions);
        IF p_form_status^.design_form THEN
          IF (p_form_status^.displayed_on_screen AND p_form_status^.added) THEN
            screen_change.object_definition := p_form_object_definition^;
            screen_change.object_index := fragment_object_index;
            fdp$record_screen_change (screen_change, local_status);
            IF NOT local_status.normal THEN
              status := local_status;
            IFEND;
          ELSE
            p_form_object_statuses^ [fragment_object_index].key := fdc$unused_identifier;
          IFEND;
        IFEND;
        fragment_object_index := p_form_object_definitions^ [fragment_object_index].
              next_fragment_object_index;
      WHILEND;
    ELSE
      IF p_form_image <> NIL THEN
        delete_object_from_form_image (p_form_image, p_form_object_definition);
      IFEND;
      delete_form_object (object_index, p_form_object_definitions);
      IF p_form_status^.design_form THEN
        IF (p_form_status^.displayed_on_screen AND p_form_status^.added) THEN
          screen_change.object_definition := p_form_object_definition^;
          screen_change.object_index := object_index;
          fdp$record_screen_change (screen_change, local_status);
          IF NOT local_status.normal THEN
            status := local_status;
          IFEND;
        ELSE
          p_form_object_statuses^ [object_index].key := fdc$unused_identifier;
        IFEND;
      IFEND;
    CASEND;
  PROCEND fdp$delete_object;

?? TITLE := 'fdp$delete_stored_object', EJECT ??
*copyc fdh$delete_stored_object

  PROCEDURE [XDCL] fdp$delete_stored_object
    (    form_identifier: fdt$form_identifier;
         name: ost$name;
         occurrence: fdt$occurrence;
     VAR status: ost$status);

    VAR
      name_is_valid: boolean,
      object_index: fdt$object_index,
      object_name_exists: boolean,
      object_occurrence_exists: boolean,
      p_form_definition: ^fdt$form_definition,
      p_form_object_definition: ^fdt$form_object_definition,
      p_form_status: ^fdt$form_status,
      valid_name: ost$name;

?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$delete_stored_object;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$delete_stored_object;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE, EJECT ??
    osp$establish_condition_handler (^condition_handler, FALSE);
    fdp$find_change_form_definition (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    p_form_definition := p_form_status^.p_form_definition;
    fdp$validate_name (name, p_form_definition^.processor, valid_name, name_is_valid);
    IF NOT name_is_valid THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_object_name, name, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    IF ((occurrence < 1) OR (occurrence > fdc$maximum_occurrence)) THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_occurrence, '', status);
      osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (occurrence), 10, FALSE, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, name, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    fdp$find_object_definition (valid_name, occurrence, p_form_status^.p_form_object_definitions,
          p_form_definition^.form_object_definitions.active_number, p_form_object_definition, object_index,
          object_name_exists, object_occurrence_exists);
    IF NOT object_name_exists THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$unknown_object_name, name, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    IF NOT object_occurrence_exists THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_occurrence, '', status);
      osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (occurrence), 10, FALSE, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, name, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    delete_form_object (object_index, p_form_status^.p_form_object_definitions);

  PROCEND fdp$delete_stored_object;

?? TITLE := 'fdp$get_form_objects', EJECT ??
*copyc fdh$get_form_objects

  PROCEDURE [XDCL] fdp$get_form_objects
    (    form_identifier: fdt$form_identifier;
     VAR form_objects: fdt$form_objects;
     VAR number_objects: fdt$number_objects;
     VAR status: ost$status);

    VAR
      n: integer,
      object_definition_key: fdt$object_definition_key,
      p_form_definition: ^fdt$form_definition,
      p_form_object_definition: ^fdt$form_object_definition,
      p_form_object_definitions: ^array [1 .. * ] of fdt$form_object_definition,
      p_form_status: ^fdt$form_status,
      total_number_objects: fdt$number_objects;

?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$get_form_objects;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$get_form_objects;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE, EJECT ??
    osp$establish_condition_handler (^condition_handler, FALSE);
    fdp$find_form_definition (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    number_objects := 0;
    total_number_objects := UPPERBOUND (form_objects);
    p_form_object_definitions := p_form_status^.p_form_object_definitions;
    p_form_definition := p_form_status^.p_form_definition;

  /get_objects/
    FOR n := 1 TO p_form_definition^.form_object_definitions.active_number DO
      p_form_object_definition := ^p_form_object_definitions^ [n];
      CASE p_form_object_definition^.key OF

      = fdc$form_box =
        object_definition_key := fdc$box;

      = fdc$form_line =
        object_definition_key := fdc$line;

      = fdc$form_constant_text_box =
        object_definition_key := fdc$constant_text_box;

      = fdc$form_constant_text =
        object_definition_key := fdc$constant_text;

      = fdc$form_table =
        object_definition_key := fdc$table;

      = fdc$form_variable_text =
        object_definition_key := fdc$variable_text;

      = fdc$form_variable_text_box =
        object_definition_key := fdc$variable_text_box;

      ELSE { This is an object that the user did not create. }
        CYCLE /get_objects/;
      CASEND;

      IF number_objects > total_number_objects THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$too_many_form_objects,
              p_form_definition^.form_name, status);
        RETURN;
      IFEND;

      number_objects := number_objects + 1;
      form_objects [number_objects].x_position := p_form_object_definition^.x_position;
      form_objects [number_objects].y_position := p_form_object_definition^.y_position;
      form_objects [number_objects].name := p_form_object_definition^.name;
      form_objects [number_objects].occurrence := p_form_object_definition^.occurrence;
      form_objects [number_objects].object := object_definition_key;
    FOREND /get_objects/;
  PROCEND fdp$get_form_objects;

?? TITLE := 'fdp$get_object_attributes', EJECT ??
*copyc fdh$get_object_attributes

  PROCEDURE [XDCL] fdp$get_object_attributes
    (    form_identifier: fdt$form_identifier;
         x_position: fdt$x_position;
         y_position: fdt$y_position;
     VAR get_object_attributes: fdt$get_object_attributes;
     VAR status: ost$status);

    VAR
      n: fdt$object_attribute_index,
      form_object_key: fdt$form_object_key,
      object_exists: boolean,
      object_index: fdt$object_index,
      p_form_definition: ^fdt$form_definition,
      p_form_module: ^fdt$form_module,
      p_form_object_definition: ^fdt$form_object_definition,
      p_form_object_definitions: ^array [1 .. * ] of fdt$form_object_definition,
      p_form_status: ^fdt$form_status,
      p_text: ^fdt$text,
      text_length: fdt$text_length;


?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$get_object_attributes;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$get_object_attributes;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE, EJECT ??
    osp$establish_condition_handler (^condition_handler, FALSE);

    FOR n := LOWERBOUND (get_object_attributes) TO UPPERBOUND (get_object_attributes) DO
      get_object_attributes [n].get_value_status := fdc$unprocessed_get_value;
    FOREND;

    fdp$find_form_definition (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    p_form_definition := p_form_status^.p_form_definition;
    p_form_object_definitions := p_form_status^.p_form_object_definitions;
    find_form_object (p_form_status, x_position, y_position, p_form_object_definitions,
          p_form_definition^.form_object_definitions.active_number, p_form_object_definition, object_index,
          object_exists);
    IF NOT object_exists THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$no_object_at_position, '', status);
      osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (x_position), 10, FALSE, status);
      osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (y_position), 10, FALSE, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    form_object_key := p_form_object_definition^.key;
    CASE form_object_key OF

    = fdc$form_text_box_fragment =

{ Use parent object for object consisting of a number of object fragments.
{ The first line of a text box is the parent.

      p_form_object_definition := ^p_form_object_definitions^
            [p_form_object_definition^.parent_text_box_object_index];
      form_object_key := p_form_object_definition^.key;
    ELSE { Ignore other objects.
    CASEND;

    p_form_module := p_form_status^.p_form_module;

  /return_object_attributes/
    FOR n := LOWERBOUND (get_object_attributes) TO UPPERBOUND (get_object_attributes) DO

      CASE get_object_attributes [n].key OF

      = fdc$get_object_definition =
        get_object_attributes [n].get_value_status := fdc$user_defined_value;
        CASE form_object_key OF

        = fdc$form_box =
          get_object_attributes [n].get_object_definition.key := fdc$box;
          get_object_attributes [n].get_object_definition.box_width := p_form_object_definition^.box_width;
          get_object_attributes [n].get_object_definition.box_height := p_form_object_definition^.box_height;

        = fdc$form_constant_text =
          get_object_attributes [n].get_object_definition.key := fdc$constant_text;
          get_object_attributes [n].get_object_definition.constant_text_width :=
                p_form_object_definition^.constant_text_width;
          p_text := fdp$ptr_text (p_form_object_definition^.constant_text, p_form_module);
          IF p_text <> NIL THEN
            get_object_attributes [n].get_object_definition.constant_text_length := STRLENGTH (p_text^);
          ELSE
            get_object_attributes [n].get_object_definition.constant_text_length := 0;
          IFEND;

        = fdc$form_constant_text_box =
          get_object_attributes [n].get_object_definition.key := fdc$constant_text_box;
          get_object_attributes [n].get_object_definition.constant_box_width :=
                p_form_object_definition^.constant_box_width;
          get_object_attributes [n].get_object_definition.constant_box_height :=
                p_form_object_definition^.constant_box_height;
          get_object_attributes [n].get_object_definition.constant_box_processing :=
                p_form_object_definition^.constant_box_processing;
          p_text := fdp$ptr_text (p_form_object_definition^.constant_box_text, p_form_module);
          IF p_text <> NIL THEN
            get_object_attributes [n].get_object_definition.constant_box_text_length := STRLENGTH (p_text^);
          ELSE
            get_object_attributes [n].get_object_definition.constant_box_text_length := 0;
          IFEND;

        = fdc$form_line =
          get_object_attributes [n].get_object_definition.x_increment :=
                p_form_object_definition^.x_increment;
          get_object_attributes [n].get_object_definition.y_increment :=
                p_form_object_definition^.y_increment;
          get_object_attributes [n].get_object_definition.key := fdc$line;

        = fdc$form_table =
          get_object_attributes [n].get_object_definition.key := fdc$table;
          get_object_attributes [n].get_object_definition.table_width :=
                p_form_object_definition^.table_width;
          get_object_attributes [n].get_object_definition.table_height :=
                p_form_object_definition^.table_height;

        = fdc$form_variable_text =
          get_object_attributes [n].get_object_definition.key := fdc$variable_text;
          get_object_attributes [n].get_object_definition.variable_text_width :=
                p_form_object_definition^.text_variable_width;
          p_text := fdp$ptr_text (p_form_object_definition^.text_variable_text, p_form_module);
          IF p_text <> NIL THEN
            get_object_attributes [n].get_object_definition.variable_text_length := STRLENGTH (p_text^);
          ELSE
            get_object_attributes [n].get_object_definition.variable_text_length := 0;
          IFEND;

        = fdc$form_variable_text_box =
          get_object_attributes [n].get_object_definition.key := fdc$variable_text_box;
          get_object_attributes [n].get_object_definition.variable_box_width :=
                p_form_object_definition^.variable_box_width;
          get_object_attributes [n].get_object_definition.variable_box_height :=
                p_form_object_definition^.variable_box_height;
          get_object_attributes [n].get_object_definition.variable_box_processing :=
                p_form_object_definition^.variable_box_processing;
          p_text := fdp$ptr_text (p_form_object_definition^.variable_box_text, p_form_module);
          IF p_text <> NIL THEN
            get_object_attributes [n].get_object_definition.variable_box_text_length := STRLENGTH (p_text^);
          ELSE
            get_object_attributes [n].get_object_definition.variable_box_text_length := 0;
          IFEND;

        ELSE

{ Invalid form object case.

          osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error, '', status);
          RETURN;
        CASEND;

      = fdc$get_object_display =
        get_object_attributes [n].display_attribute := p_form_object_definition^.display_attribute;
        IF p_form_object_definition^.display_attribute = p_form_definition^.display_attribute THEN
          get_object_attributes [n].get_value_status := fdc$system_computed_value;
        ELSE
          get_object_attributes [n].get_value_status := fdc$user_defined_value;
        IFEND;

      = fdc$get_object_name =
        IF p_form_object_definition^.name <> osc$null_name THEN
          get_object_attributes [n].object_name := p_form_object_definition^.name;
          get_object_attributes [n].occurrence := p_form_object_definition^.occurrence;
          get_object_attributes [n].get_value_status := fdc$user_defined_value;
        ELSE
          get_object_attributes [n].get_value_status := fdc$undefined_value;
        IFEND;

      = fdc$get_object_text =
        IF get_object_attributes [n].p_text = NIL THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_address,
                p_form_definition^.form_name, status);
          RETURN;
        IFEND;

        CASE form_object_key OF

        = fdc$form_box, fdc$form_line =
          osp$set_status_abnormal (fdc$format_display_identifier, fde$no_text_at_position, '', status);
          osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (x_position),
                10, FALSE, status);
          osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (y_position),
                10, FALSE, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
          RETURN;

        = fdc$form_constant_text =
          p_text := fdp$ptr_text (p_form_object_definition^.constant_text, p_form_status^.p_form_module);
          IF STRLENGTH (get_object_attributes [n].p_text^) >= STRLENGTH (p_text^) THEN
            get_object_attributes [n].p_text^ := p_text^;
          ELSE
            osp$set_status_abnormal (fdc$format_display_identifier, fde$string_too_small, '', status);
            RETURN;
          IFEND;

        = fdc$form_constant_text_box =
          p_text := fdp$ptr_text (p_form_object_definition^.constant_box_text, p_form_status^.p_form_module);
          IF STRLENGTH (get_object_attributes [n].p_text^) >= STRLENGTH (p_text^) THEN
            get_object_attributes [n].p_text^ := p_text^;
          ELSE
            osp$set_status_abnormal (fdc$format_display_identifier, fde$string_too_small, '', status);
            RETURN;
          IFEND;

        = fdc$form_variable_text =
          p_text := fdp$ptr_text (p_form_object_definition^.text_variable_text, p_form_status^.p_form_module);
          IF STRLENGTH (get_object_attributes [n].p_text^) >= STRLENGTH (p_text^) THEN
            get_object_attributes [n].p_text^ := p_text^;
          ELSE
            osp$set_status_abnormal (fdc$format_display_identifier, fde$string_too_small, '', status);
            RETURN;
          IFEND;

        = fdc$form_variable_text_box =
          p_text := fdp$ptr_text (p_form_object_definition^.variable_box_text, p_form_status^.p_form_module);
          IF STRLENGTH (get_object_attributes [n].p_text^) >= STRLENGTH (p_text^) THEN
            get_object_attributes [n].p_text^ := p_text^;
          ELSE
            osp$set_status_abnormal (fdc$format_display_identifier, fde$string_too_small, '', status);
            RETURN;
          IFEND;

        ELSE

{ The object key is invalid.

          osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error, '', status);
          RETURN;
        CASEND;
        get_object_attributes [n].get_value_status := fdc$user_defined_value;

        = fdc$get_object_text_length =
        CASE form_object_key OF

        = fdc$form_constant_text =
          p_text := fdp$ptr_text (p_form_object_definition^.constant_text, p_form_status^.p_form_module);

        = fdc$form_constant_text_box =
          p_text := fdp$ptr_text (p_form_object_definition^.constant_box_text, p_form_status^.p_form_module);


        = fdc$form_variable_text =
          p_text := fdp$ptr_text (p_form_object_definition^.text_variable_text, p_form_status^.p_form_module);


        = fdc$form_variable_text_box =
          p_text := fdp$ptr_text (p_form_object_definition^.variable_box_text, p_form_status^.p_form_module);

        ELSE

{ The object has no text.

          osp$set_status_abnormal (fdc$format_display_identifier, fde$no_text_at_position, '', status);
          osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (x_position),
                10, FALSE, status);
          osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (y_position),
                10, FALSE, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
          RETURN;
        CASEND;

{ The object may have text.

          IF p_text <> NIL THEN
            get_object_attributes [n].text_length := STRLENGTH (p_text^);
          ELSE
            get_object_attributes [n].text_length := 0;
          IFEND;
          get_object_attributes [n].get_value_status := fdc$user_defined_value;

      = fdc$get_unused_object_entry =
        get_object_attributes [n].get_value_status := fdc$undefined_value;

      ELSE

{ Invalid object attribute.

        osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_object_attribute,
              p_form_definition^.form_name, status);
        RETURN;

      CASEND;
    FOREND /return_object_attributes/;
  PROCEND fdp$get_object_attributes;

?? TITLE := 'fdp$get_stored_object', EJECT ??
*copyc fdh$get_stored_object

  PROCEDURE [XDCL] fdp$get_stored_object
    (    form_identifier: fdt$form_identifier;
         name: ost$name;
         occurrence: fdt$occurrence;
     VAR text: fdt$text;
     VAR text_length: fdt$text_length;
     VAR display_attribute_set: fdt$display_attribute_set;
     VAR status: ost$status);

    VAR
      name_is_valid: boolean,
      object_index: fdt$object_index,
      object_name_exists: boolean,
      object_occurrence_exists: boolean,
      p_form_definition: ^fdt$form_definition,
      p_form_object_definition: ^fdt$form_object_definition,
      p_form_status: ^fdt$form_status,
      p_stored_text: ^fdt$text,
      valid_name: ost$name;

?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$get_stored_object;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$get_stored_object;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE, EJECT ??
    osp$establish_condition_handler (^condition_handler, FALSE);
    fdp$find_form_definition (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    p_form_definition := p_form_status^.p_form_definition;
    fdp$validate_name (name, p_form_definition^.processor, valid_name, name_is_valid);
    IF NOT name_is_valid THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_object_name, name, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    IF ((occurrence < 1) OR (occurrence > fdc$maximum_occurrence)) THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_occurrence, '', status);
      osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (occurrence), 10, FALSE, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, name, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    fdp$find_object_definition (valid_name, occurrence, p_form_status^.
          p_form_object_definitions, p_form_definition^.form_object_definitions.active_number,
          p_form_object_definition, object_index, object_name_exists, object_occurrence_exists);
    IF NOT object_name_exists THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$unknown_object_name, name, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    IF NOT object_occurrence_exists THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_occurrence, '', status);
      osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (occurrence), 10, FALSE, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, name, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
      RETURN;
    IFEND;

{ Return text and display attributes to caller.

    p_stored_text := fdp$ptr_text (p_form_object_definition^.stored_variable_text,
          p_form_status^.p_form_module);
    text_length := STRLENGTH (p_stored_text^);
    text := p_stored_text^;
    display_attribute_set := p_form_object_definition^.display_attribute;
  PROCEND fdp$get_stored_object;

?? TITLE := 'fdp$set_display_attributes', EJECT ??
*copyc fdh$set_display_attributes

  PROCEDURE [XDCL] fdp$set_display_attributes
    (    form_display_attributes: fdt$display_attribute_set;
         object_display_attributes: fdt$display_attribute_set;
     VAR display_attribute_set: fdt$display_attribute_set);

    display_attribute_set := object_display_attributes;

{ If user did not specify a background color, use background color of form.

    IF ((object_display_attributes * fdv$background_colors) = $fdt$display_attribute_set []) THEN
      IF ((form_display_attributes * fdv$background_colors) <> $fdt$display_attribute_set []) THEN
        display_attribute_set := display_attribute_set + (form_display_attributes * fdv$background_colors);
      IFEND;
    IFEND;

{ If user did not specify a foreground color, use foreground color of form.

    IF ((object_display_attributes * fdv$foreground_colors) = $fdt$display_attribute_set []) THEN
      IF ((form_display_attributes * fdv$foreground_colors) <> $fdt$display_attribute_set []) THEN
        display_attribute_set := display_attribute_set + (form_display_attributes * fdv$foreground_colors);
      IFEND;
    IFEND;

{ If user did not specify display direction, use direction of form.

    IF ((object_display_attributes * fdv$object_display_directions) = $fdt$display_attribute_set []) THEN
      IF ((form_display_attributes * fdv$object_display_directions) <> $fdt$display_attribute_set []) THEN
        display_attribute_set := display_attribute_set + (form_display_attributes *
              fdv$object_display_directions);
      IFEND;
    IFEND;

  PROCEND fdp$set_display_attributes;

?? TITLE := 'change_object', EJECT ??

  PROCEDURE change_object
    (    p_form_status: ^fdt$form_status;
         p_form_definition: ^fdt$form_definition;
         p_form_object_definition: ^fdt$form_object_definition;
     VAR object_attributes: fdt$object_attributes;
     VAR status: ost$status);

    VAR
      n: fdt$object_attribute_index,
      name_is_valid: boolean,
      name_exists: boolean,
      new_array: boolean,
      object_index: fdt$object_index,
      p_duplicate_object_definition: ^fdt$form_object_definition,
      p_form_module: ^fdt$form_module,
      p_form_variable_definition: ^fdt$form_variable_definition,
      p_new_text: ^fdt$text,
      p_text: ^fdt$text,
      text_length: fdt$text_length,
      valid_name: ost$name,
      x_position: fdt$x_position,
      y_position: fdt$y_position;

?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT change_object;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT change_object;
        IFEND;

      = pmc$block_exit_processing =
        handler_status.normal := TRUE;
        RETURN;
      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE, EJECT ??
    osp$establish_condition_handler (^condition_handler, FALSE);
    status.normal := TRUE;
    p_form_module := p_form_status^.p_form_module;
    x_position := p_form_object_definition^.x_position;
    y_position := p_form_object_definition^.y_position;

  /change_object_attributes/
    FOR n := LOWERBOUND (object_attributes) TO UPPERBOUND (object_attributes) DO
      CASE object_attributes [n].key OF

      = fdc$object_display =
        fdp$set_display_attributes (p_form_definition^.display_attribute,
              object_attributes [n].display_attribute, p_form_object_definition^.display_attribute);
        CASE p_form_object_definition^.key OF

        = fdc$form_variable_text_box, fdc$form_variable_text =

{ Do nothing.

        ELSE

{ Always protect constant text, lines and boxes.

          p_form_object_definition^.display_attribute := p_form_object_definition^.display_attribute +
                $fdt$display_attribute_set [fdc$protect];
        CASEND;

        object_attributes [n].put_value_status := fdc$put_value_accepted;

      = fdc$object_height =
        IF ((object_attributes [n].height < 1) OR (object_attributes [n].height > fdc$maximum_y_position))
              THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_height, '', status);
          osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (object_attributes [n].height),
                10, FALSE, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
          RETURN;
        IFEND;

        CASE p_form_object_definition^.key OF

        = fdc$form_box =
          p_form_object_definition^.box_height := object_attributes [n].height;
          object_attributes [n].put_value_status := fdc$put_value_accepted;

        = fdc$form_constant_text_box =
          p_form_object_definition^.constant_box_height := object_attributes [n].height;
          object_attributes [n].put_value_status := fdc$put_value_accepted;

        = fdc$form_table =
          p_form_object_definition^.table_height := object_attributes [n].height;
          object_attributes [n].put_value_status := fdc$put_value_accepted;

        = fdc$form_variable_text_box =
          check_object_size (p_form_status, p_form_object_definition^.name,
                object_attributes [n].height * p_form_object_definition^.variable_box_width,
                status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

          p_form_object_definition^.variable_box_height := object_attributes [n].height;
          object_attributes [n].put_value_status := fdc$put_value_accepted;

        = fdc$form_constant_text, fdc$form_variable_text =
          osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_object_change, '', status);
          RETURN;

        ELSE

{ Invalid object definition key.

          osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_object_key,
                p_form_definition^.form_name, status);
          RETURN;
        CASEND;

      = fdc$object_width =
        IF ((object_attributes [n].width < 1) OR (object_attributes [n].width > fdc$maximum_x_position)) THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_width, '', status);
          osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (object_attributes [n].width),
                10, FALSE, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
          RETURN;
        IFEND;

        CASE p_form_object_definition^.key OF

        = fdc$form_box =
          p_form_object_definition^.box_width := object_attributes [n].width;
          object_attributes [n].put_value_status := fdc$put_value_accepted;

        = fdc$form_constant_text =
          p_form_object_definition^.constant_text_width := object_attributes [n].width;
          object_attributes [n].put_value_status := fdc$put_value_accepted;

        = fdc$form_constant_text_box =
          p_form_object_definition^.constant_box_width := object_attributes [n].width;
          object_attributes [n].put_value_status := fdc$put_value_accepted;

        = fdc$form_table =
          p_form_object_definition^.table_width := object_attributes [n].width;
          object_attributes [n].put_value_status := fdc$put_value_accepted;

        = fdc$form_variable_text =
          check_object_size (p_form_status, p_form_object_definition^.name,
                object_attributes [n].width, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

          p_form_object_definition^.text_variable_width := object_attributes [n].width;
          object_attributes [n].put_value_status := fdc$put_value_accepted;

        = fdc$form_variable_text_box =
          check_object_size (p_form_status, p_form_object_definition^.name,
                object_attributes [n].width * p_form_object_definition^.variable_box_height,
                status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

          p_form_object_definition^.variable_box_width := object_attributes [n].width;
          object_attributes [n].put_value_status := fdc$put_value_accepted;

        ELSE

{ Invalid object definition key.

          osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
                p_form_definition^.form_name, status);
          RETURN;
        CASEND;

      = fdc$object_line_x_increment =
        IF ((object_attributes [n].x_increment < 0) OR (object_attributes [n].x_increment >
              fdc$maximum_x_position)) THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_x_increment, '', status);
          osp$append_status_integer (osc$status_parameter_delimiter,
                $INTEGER (object_attributes [n].x_increment), 10, FALSE, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
          RETURN;
        IFEND;

        IF p_form_object_definition^.key = fdc$form_line THEN
          p_form_object_definition^.x_increment := object_attributes [n].x_increment;
          object_attributes [n].put_value_status := fdc$put_value_accepted;

        ELSE

{ The object is not a line whose x increment can be changed.

          osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_object_change,
                p_form_definition^.form_name, status);
          RETURN;
        IFEND;

      = fdc$object_line_y_increment =
        IF ((object_attributes [n].y_increment < 0) OR (object_attributes [n].y_increment >
              fdc$maximum_y_position)) THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_y_increment, '', status);
          osp$append_status_integer (osc$status_parameter_delimiter,
                $INTEGER (object_attributes [n].y_increment), 10, FALSE, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
          RETURN;
        IFEND;

        IF p_form_object_definition^.key = fdc$form_line THEN
          p_form_object_definition^.y_increment := object_attributes [n].y_increment;
          object_attributes [n].put_value_status := fdc$put_value_accepted;

        ELSE

{ The object is not a line whose y increment can be changed.

          osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_object_change,
                p_form_definition^.form_name, status);
          RETURN;
        IFEND;

      = fdc$object_name =
        IF object_attributes [n].object_name = osc$null_name THEN
          p_form_object_definition^.name := osc$null_name;
          p_form_object_definition^.occurrence := 1;
          object_attributes [n].put_value_status := fdc$put_value_accepted;
          CYCLE /change_object_attributes/;
        IFEND;

        fdp$validate_name (object_attributes [n].object_name, p_form_definition^.processor, valid_name,
              name_is_valid);
        IF NOT name_is_valid THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_object_name,
                object_attributes [n].object_name, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
          RETURN;
        IFEND;

        IF ((object_attributes [n].occurrence < 1) OR (object_attributes [n].occurrence >
              fdc$maximum_occurrence)) THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_occurrence, '', status);
          osp$append_status_integer (osc$status_parameter_delimiter,
                $INTEGER (object_attributes [n].occurrence), 10, FALSE, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, object_attributes [n].object_name,
                status);
          osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
          RETURN;
        IFEND;

        find_object_name (valid_name, object_attributes [n].occurrence,
              p_form_status^.p_form_object_definitions, p_form_definition^.form_object_definitions.
              active_number, p_duplicate_object_definition, object_index, name_exists);
        IF name_exists THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$object_occurrence_exists, '', status);
          osp$append_status_integer (osc$status_parameter_delimiter,
                $INTEGER (object_attributes [n].occurrence), 10, FALSE, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, object_attributes [n].object_name,
                status);
          osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
          RETURN;
        IFEND;

        p_form_object_definition^.name := valid_name;
        p_form_object_definition^.occurrence := object_attributes [n].occurrence;
        object_attributes [n].put_value_status := fdc$put_value_accepted;

      = fdc$object_position =
        IF object_attributes [n].x_position > fdc$maximum_x_position THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_x_position, '', status);
          osp$append_status_integer (osc$status_parameter_delimiter,
                $INTEGER (object_attributes [n].x_position), 10, FALSE, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
          RETURN;
        IFEND;

        IF object_attributes [n].y_position > fdc$maximum_y_position THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_y_position, '', status);
          osp$append_status_integer (osc$status_parameter_delimiter,
                $INTEGER (object_attributes [n].y_position), 10, FALSE, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
          RETURN;
        IFEND;

        p_form_object_definition^.x_position := object_attributes [n].x_position;
        p_form_object_definition^.y_position := object_attributes [n].y_position;
        object_attributes [n].put_value_status := fdc$put_value_accepted;

      = fdc$object_text =
        IF object_attributes [n].p_text = NIL THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$no_text_for_object,
                p_form_definition^.form_name, status);
          RETURN;
        IFEND;

        p_text := object_attributes [n].p_text;
        text_length := STRLENGTH (p_text^);
        NEXT p_new_text: [text_length] IN p_form_status^.p_form_module;
        IF p_new_text = NIL THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
          RETURN;
        IFEND;

        p_new_text^ := p_text^;
        CASE p_form_object_definition^.key OF

        = fdc$form_constant_text =
          fdp$rel_text (p_new_text, p_form_module, p_form_object_definition^.constant_text);

        = fdc$form_constant_text_box =
          fdp$rel_text (p_new_text, p_form_module, p_form_object_definition^.constant_box_text);

        = fdc$form_variable_text =
          fdp$rel_text (p_new_text, p_form_module, p_form_object_definition^.text_variable_text);

        = fdc$form_variable_text_box =
          fdp$rel_text (p_new_text, p_form_module, p_form_object_definition^.variable_box_text);

        = fdc$form_box, fdc$form_line =

{ The object cannot have text changed with this request.

          osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_object_change,
                p_form_definition^.form_name, status);
          RETURN;

        ELSE
          osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error, '', status);
          RETURN;
        CASEND;
        object_attributes [n].put_value_status := fdc$put_value_accepted;

      = fdc$object_text_processing =
        CASE object_attributes [n].text_box_processing OF

        = fdc$wrap_characters, fdc$wrap_words =

        ELSE
          osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_text_processing,
                p_form_definition^.form_name, status);
          RETURN;
        CASEND;

        CASE p_form_object_definition^.key OF

        = fdc$form_constant_text_box =
          p_form_object_definition^.constant_box_processing := object_attributes [n].text_box_processing;

        = fdc$form_variable_text_box =
          p_form_object_definition^.variable_box_processing := object_attributes [n].text_box_processing;

        = fdc$form_variable_text, fdc$form_constant_text, fdc$form_box, fdc$form_line =
          osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_object_change, '', status);
          RETURN;

        ELSE

{ Invalid object definition key.

          osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
                p_form_definition^.form_name, status);
          RETURN;
        CASEND;
        object_attributes [n].put_value_status := fdc$put_value_accepted;

      = fdc$unused_object_entry =
        object_attributes [n].put_value_status := fdc$put_value_accepted;

{ Do nothing.

      ELSE

{ Invalid object attribute.

        osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_object_attribute,
              p_form_definition^.form_name, status);
        RETURN;

      CASEND;
    FOREND /change_object_attributes/;

  PROCEND change_object;

?? TITLE := 'check_object_size', EJECT ??

  PROCEDURE check_object_size
    (    p_form_status: ^fdt$form_status;
         object_name: ost$name;
         screen_variable_length: fdt$screen_variable_length;
     VAR status: ost$status);

    VAR
      name_exists: boolean,
      p_added_variable_definition: ^fdt$added_variable_definition,
      p_form_variable_definition: ^fdt$form_variable_definition,
      variable_index: fdt$variable_index;

    status.normal := TRUE;
    fdp$find_variable_definition (object_name,  p_form_status^.
          p_form_variable_definitions,  p_form_status^.p_form_definition^.
          form_variable_definitions.active_number,
          p_form_variable_definition, variable_index, name_exists);
    IF NOT name_exists THEN
      RETURN;
    IFEND;

    IF p_form_variable_definition^.program_data_type <> fdc$program_cobol_type THEN
      RETURN;
    IFEND;

    fdp$locate_added_variable_facts (p_form_status^.p_form_module,
          p_form_variable_definition, p_added_variable_definition);

    IF NOT p_added_variable_definition^.form_cobol_display_clause.defined THEN
      RETURN;
    IFEND;

    IF p_added_variable_definition^.display_cobol_description.size >
          screen_variable_length THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$object_size_coboL_mismatch, '', status);
      osp$append_status_integer (osc$status_parameter_delimiter,
            $INTEGER (p_added_variable_definition^.display_cobol_description.size), 10, FALSE,  status);
      osp$append_status_integer (osc$status_parameter_delimiter,
            $INTEGER (screen_variable_length), 10, FALSE, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, object_name, status);
      osp$append_status_parameter (osc$status_parameter_delimiter,
           p_form_status^.p_form_definition^.form_name, status);
     IFEND;

    PROCEND check_object_size;

?? TITLE := 'create_fragments', EJECT ??

    PROCEDURE create_fragments
      (    p_form_status: ^fdt$form_status;
           object_index: fdt$object_index;
           width: fdt$width;
           height: fdt$height;
       VAR fragment_object_index: fdt$object_index;
       VAR p_form_object_definition: ^fdt$form_object_definition;
       VAR p_form_object_definitions: ^array [1 .. *] of fdt$form_object_definition;
       VAR status: ost$status);

      VAR
        fragment_index: fdt$object_index,
        p_fragment_object_definition: ^fdt$form_object_definition,
        p_fragment_object_indexes: ^array [1 .. * ] of fdt$object_index,
        p_last_object_definition: ^fdt$form_object_definition;

      PUSH p_fragment_object_indexes: [1 .. height];
      FOR fragment_index := 1 TO height - 1 DO
        fdp$allocate_object (p_form_status, p_fragment_object_definition, fragment_object_index, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        p_fragment_object_indexes^ [fragment_index] := fragment_object_index;
      FOREND;

      p_form_object_definitions := p_form_status^.p_form_object_definitions;
      p_form_object_definition  :=  ^p_form_object_definitions^ [object_index];

      FOR fragment_index := 1 TO height - 1 DO
        p_fragment_object_definition := ^p_form_object_definitions^
              [p_fragment_object_indexes^ [fragment_index]];
        p_fragment_object_definition^.key := fdc$form_text_box_fragment;
        p_fragment_object_definition^.x_position :=
              p_form_object_definition^.x_position;
        p_fragment_object_definition^.y_position :=
              p_form_object_definition^.y_position + fragment_index;
        p_fragment_object_definition^.name := p_form_object_definition^.name;
        p_fragment_object_definition^.occurrence := p_form_object_definition^.occurrence;
        p_fragment_object_definition^.display_attribute := p_form_object_definition^.display_attribute;
        p_fragment_object_definition^.fragment_width := width;
        p_fragment_object_definition^.parent_text_box_object_index := object_index;
        IF fragment_index > 1 THEN
          p_last_object_definition^.next_fragment_object_index := p_fragment_object_indexes^ [fragment_index];
        IFEND;
        p_last_object_definition := p_fragment_object_definition;
      FOREND;

      p_fragment_object_definition^.next_fragment_object_index := 0;
      fragment_object_index := p_fragment_object_indexes^ [1];
    PROCEND create_fragments;


?? TITLE := 'delete_form_object', EJECT ??

  PROCEDURE [INLINE] delete_form_object
    (    object_index: fdt$object_index;
         p_form_object_definitions: ^array [1 .. * ] of fdt$form_object_definition);

    p_form_object_definitions^ [object_index].key := fdc$form_unused_object;
  PROCEND delete_form_object;

?? TITLE := 'delete_free_text_under_object', EJECT ??

  PROCEDURE delete_free_text_under_object
    (    form_identifier: fdt$form_identifier;
         form_object_definition: fdt$form_object_definition;
         p_form_definition: ^fdt$form_definition;
         p_form_status: ^fdt$form_status;
     VAR status: ost$status);

    VAR
      high_x_position: fdt$x_position,
      high_y_position: fdt$y_position,
      occurrence: fdt$occurrence,
      p_text: ^fdt$text,
      variable_name: ost$name,
      variable_status: fdt$variable_status;

{ Set characters under object to spaces, so that objects created
{ later can be placed here.

    PUSH p_text: [p_form_definition^.form_area.width];
    variable_name := p_form_status^.design_variable_name;
    CASE form_object_definition.key OF

    = fdc$form_box =

{ Delete free text under top line of box.

      fdp$get_string_variable (form_identifier, variable_name, form_object_definition.y_position, p_text^,
            variable_status, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      p_text^ (form_object_definition.x_position, form_object_definition.box_width) := ' ';
      fdp$replace_string_variable (form_identifier, variable_name, form_object_definition.y_position, p_text^,
            variable_status, status);

{ Delete free text under vertical lines of box.

      high_y_position := form_object_definition.y_position + form_object_definition.box_height - 1;
      high_x_position := form_object_definition.x_position + form_object_definition.box_width - 1;
      FOR occurrence := form_object_definition.y_position + 1 TO (high_y_position - 1) DO
        fdp$get_string_variable (form_identifier, variable_name, occurrence, p_text^, variable_status,
              status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

        p_text^ (form_object_definition.x_position, 1) := ' ';
        p_text^ (high_x_position, 1) := ' ';
        fdp$replace_string_variable (form_identifier, variable_name, occurrence, p_text^, variable_status,
              status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      FOREND;

{ Delete free text under bottom line of box.

      fdp$get_string_variable (form_identifier, variable_name, high_y_position, p_text^, variable_status,
            status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      p_text^ (form_object_definition.x_position, form_object_definition.box_width) := ' ';
      fdp$replace_string_variable (form_identifier, variable_name, high_y_position, p_text^, variable_status,
            status);

    = fdc$form_constant_text =
      fdp$get_string_variable (form_identifier, variable_name, form_object_definition.y_position, p_text^,
            variable_status, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      p_text^ (form_object_definition.x_position, form_object_definition.constant_text_width) := ' ';
      fdp$replace_string_variable (form_identifier, variable_name, form_object_definition.y_position, p_text^,
            variable_status, status);

    = fdc$form_constant_text_box =
      FOR occurrence := form_object_definition.y_position TO
            (form_object_definition.y_position + form_object_definition.constant_box_height - 1) DO
        fdp$get_string_variable (form_identifier, variable_name, occurrence, p_text^, variable_status,
              status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

        p_text^ (form_object_definition.x_position, form_object_definition.constant_box_width) := ' ';
        fdp$replace_string_variable (form_identifier, variable_name, occurrence, p_text^, variable_status,
              status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      FOREND;

    = fdc$form_line =
      IF (form_object_definition.y_increment = 0) THEN

{ Delete free text for horizontal line.

        fdp$get_string_variable (form_identifier, variable_name, form_object_definition.y_position, p_text^,
              variable_status, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

        p_text^ (form_object_definition.x_position, form_object_definition.x_increment + 1) := ' ';
        fdp$replace_string_variable (form_identifier, variable_name, form_object_definition.y_position,
              p_text^, variable_status, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

      ELSE

{ Delete free text for vertical line.

        high_y_position := form_object_definition.y_position + form_object_definition.y_increment;
        FOR occurrence := form_object_definition.y_position TO (high_y_position) DO
          fdp$get_string_variable (form_identifier, variable_name, occurrence, p_text^, variable_status,
                status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

          p_text^ (form_object_definition.x_position, 1) := ' ';
          fdp$replace_string_variable (form_identifier, variable_name, occurrence, p_text^, variable_status,
                status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        FOREND;
      IFEND;

    ELSE { Ignore other objects. }
    CASEND;
  PROCEND delete_free_text_under_object;

?? TITLE := 'delete_object_from_form_image', EJECT ??

  PROCEDURE delete_object_from_form_image
    (    p_form_image: ^fdt$form_image;
         p_form_object_definition: ^fdt$form_object_definition);

    VAR
      current_x_position: fdt$x_position,
      current_y_position: fdt$y_position,
      end_object_x_position: fdt$x_position,
      end_object_y_position: fdt$y_position,
      x_position: fdt$x_position,
      y_position: fdt$y_position;

    x_position := p_form_object_definition^.x_position;
    y_position := p_form_object_definition^.y_position;

{ Set character image of form to spaces for area occupied by deleted object.

    CASE p_form_object_definition^.key OF

    = fdc$form_box =
      end_object_x_position := x_position + p_form_object_definition^.box_width - 1;
      end_object_y_position := y_position + p_form_object_definition^.box_height - 1;

{ Delete top line of box.

      p_form_image^ [y_position] (x_position, p_form_object_definition^.box_width) := ' ';

{ Delete bottom line of box.

      p_form_image^ [end_object_y_position] (x_position, p_form_object_definition^.box_width) := ' ';

{ Delete left vertical line of box.

      FOR current_y_position := y_position + 1 TO end_object_y_position - 1 DO
        p_form_image^ [current_y_position] (x_position, 1) := ' ';
      FOREND;

{ Delete left right vertical line of box.

      FOR current_y_position := y_position + 1 TO end_object_y_position - 1 DO
        p_form_image^ [current_y_position] (end_object_x_position, 1) := ' ';
      FOREND;

    = fdc$form_line =
      IF (p_form_object_definition^.y_increment = 0) THEN

{ Delete horizontal line.

        p_form_image^ [y_position] (x_position, p_form_object_definition^.x_increment + 1) := ' ';

      ELSE

{ Delete vertical line.

        FOR current_y_position := y_position TO y_position + p_form_object_definition^.y_increment DO
          p_form_image^ [current_y_position] (x_position, 1) := ' ';
        FOREND;
      IFEND;

    = fdc$form_variable_text =
      p_form_image^ [y_position] (x_position, p_form_object_definition^.text_variable_width) := ' ';

    = fdc$form_variable_text_box =
      FOR current_y_position := y_position TO y_position + p_form_object_definition^.variable_box_height -
            1 DO
        p_form_image^ [current_y_position] (x_position, p_form_object_definition^.variable_box_width) := ' ';
      FOREND;

    = fdc$form_constant_text =
      p_form_image^ [y_position] (x_position, p_form_object_definition^.constant_text_width) := ' ';

    = fdc$form_constant_text_box =
      FOR current_y_position := y_position TO y_position + p_form_object_definition^.constant_box_height -
            1 DO
        p_form_image^ [current_y_position] (x_position, p_form_object_definition^.constant_box_width) := ' ';
      FOREND;

    ELSE { Ignore other objects. }
    CASEND;

  PROCEND delete_object_from_form_image;

?? TITLE := 'find_form_object', EJECT ??

  PROCEDURE [INLINE] find_form_object
    (    p_form_status: ^fdt$form_status;
         x_position: fdt$x_position;
         y_position: fdt$y_position;
         p_form_object_definitions: ^array [1 .. * ] of fdt$form_object_definition;
         number_objects: fdt$number_objects;
     VAR p_form_object_definition: ^fdt$form_object_definition;
     VAR object_index: fdt$object_index;
     VAR object_exists: boolean);

    VAR
      design_form: boolean;

    design_form := p_form_status^.design_form;
    object_exists := FALSE;

  /find_object/
    FOR object_index := 1 TO number_objects DO
      p_form_object_definition := ^p_form_object_definitions^ [object_index];
      IF ((p_form_object_definition^.key = fdc$form_unused_object) OR
           (p_form_object_definition^.key = fdc$form_stored_variable)) THEN
        CYCLE /find_object/;
      IFEND;

      IF ((x_position = p_form_object_definition^.x_position) AND
            (p_form_object_definition^.y_position = y_position)) THEN
        IF NOT design_form THEN
          object_exists := TRUE;
          EXIT /find_object/;
        ELSE

{ The variable that holds free text on the design form should not be considered as an object.

          IF p_form_object_definition^.name <> p_form_status^.design_variable_name THEN
            object_exists := TRUE;
            EXIT /find_object/;
          IFEND;
        IFEND;
      IFEND;
    FOREND /find_object/;
  PROCEND find_form_object;

?? TITLE := 'find_object_name', EJECT ??

  PROCEDURE [INLINE] find_object_name
    (    object_name: ost$name;
         object_occurrence: fdt$occurrence;
         p_form_object_definitions: ^array [1 .. * ] of fdt$form_object_definition;
         number_objects: fdt$number_objects;
     VAR p_form_object_definition: ^fdt$form_object_definition;
     VAR object_index: fdt$object_index;
     VAR object_exists: boolean);

    object_exists := FALSE;

  /find_object/
    FOR object_index := 1 TO number_objects DO
      p_form_object_definition := ^p_form_object_definitions^ [object_index];
      IF p_form_object_definition^.key <> fdc$form_unused_object THEN
        IF object_name = p_form_object_definition^.name THEN
          IF object_occurrence = p_form_object_definition^.occurrence THEN
            object_exists := TRUE;
            EXIT /find_object/;
          IFEND;
        IFEND;
      IFEND;
    FOREND /find_object/;
  PROCEND find_object_name;

MODEND fdm$process_object;
