?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE Screen Formatting : Process Screen Input Output' ??
MODULE fdm$process_screen_input_output;

{ PURPOSE:
{   This module process requests to do terminal input and output.
{
{ DESIGN:
{   The Screen Manager is called to do terminal input and output.

?? LIBRARY := 'TUF$LIBRARY' ??

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

?? PUSH (LISTEXT := ON) ??
*copyc amk$base_keypoint_values
*copyc cle$ecc_lexical
*copyc cse$condition_codes
*copyc cst$event_name_identifier
*copyc cst$event_type
*copyc cst$key_type
*copyc cst$string
*copyc csv$vector
*copyc cyd$run_time_error_condition
*copyc fdc$basic_capability
*copyc fdc$im_smart_capability
*copyc fdc$message_form_capability
*copyc fdc$reassign_event_capability
*copyc fdc$validation_capability
*copyc fdc$integer_length
*copyc fdc$new_line_character
*copyc fdc$message_form_name
*copyc fdc$message_variable_name
*copyc fdc$real_length
*copyc fdc$system_design_table_name
*copyc fdc$system_display_name
*copyc fde$condition_identifiers
*copyc fdk$screen_formatting_keypoints
*copyc fdt$display_index
*copyc fdt$event_index
*copyc fdt$event_menu
*copyc fdt$event_position
*copyc fdt$form_attributes
*copyc fdt$form_object_definition
*copyc fdt$form_object_key
*copyc fdt$message_text
*copyc fdt$number_errors
*copyc fdt$object_definition
*copyc fdt$object_attribute
*copyc fdt$screen_change_index
*copyc fdt$screen_to_form_event
*copyc fdt$screen_variable_length
*copyc fdt$table_attribute
*copyc fdt$valid_integer_index
*copyc fdt$valid_real_index
*copyc fdt$valid_string_index
*copyc fdt$variable_attribute
*copyc fdt$variable_status
*copyc fdt$work_area_length
*copyc ife$error_codes
*copyc jme$transaction_job_disconnect
*copyc lle$loader_status_conditions
*copyc ost$name
?? POP ??

*copyc fdv$application_event_table
*copyc fdv$screen_status
*copyc fdv$colors
*copyc fdv$message_variable_name

*copyc clp$find_form
*copyc clp$validate_name

*copyc fdp$add_form
*copyc fdp$change_form
*copyc fdp$close_form
*copyc fdp$convert_yymmdd_to_date_time
*copyc fdp$create_form
*copyc fdp$create_form_status
*copyc fdp$create_event_form
*copyc fdp$create_message_form
*copyc fdp$create_object
*copyc fdp$create_table
*copyc fdp$create_variable
*copyc fdp$date_variable
*copyc fdp$delete_screen_changes
*copyc fdp$end_form
*copyc fdp$find_display_name
*copyc fdp$find_form_definition
*copyc fdp$find_form_status
*copyc fdp$find_object_definition
*copyc fdp$get_message
*copyc fdp$initialize_form_objects
*copyc fdp$initialize_form_record
*copyc fdp$move_to_program_variable
*copyc fdp$ptr_displays
*copyc fdp$ptr_events
*copyc fdp$ptr_objects
*copyc fdp$ptr_record_definitions
*copyc fdp$ptr_screen_variable
*copyc fdp$ptr_table_objects
*copyc fdp$ptr_table_variables
*copyc fdp$ptr_tables
*copyc fdp$ptr_text
*copyc fdp$ptr_valid_integers
*copyc fdp$ptr_valid_reals
*copyc fdp$ptr_valid_strings
*copyc fdp$ptr_variable
*copyc fdp$ptr_variables
*copyc fdp$record_screen_change
*copyc fdp$replace_string_variable
*copyc fdp$reset_object_attribute
*copyc fdp$set_cursor_position
*copyc fdp$set_object_attribute
*copyc fdp$validate_cobol_data
*copyc fdp$validate_integer
*copyc fdp$validate_real
*copyc fdp$validate_string

*copyc i#move
*copyc mlp$move_bytes
*copyc mmp$delete_scratch_segment
*copyc osp$disestablish_cond_handler
*copyc osp$establish_condition_handler
*copyc osp$append_status_integer
*copyc osp$append_status_parameter
*copyc osp$set_status_condition
*copyc osp$get_status_condition_string
*copyc osp$set_status_abnormal

*copyc pmp$continue_to_cause
*copyc pmp$exit

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

  CONST
    fdc$forms_to_expand = 7,
    fdc$hidden_editing_multiplier = 2,
    fdc$screen_changes_to_expand = 10;

  TYPE
    fdt$data_position = (fdc$top_of_box, fdc$bottom_of_box, fdc$shift_characters,
          fdc$page_data_first, fdc$page_data_last, fdc$page_data_forward,
          fdc$page_data_backward, fdc$scroll_data_forward, fdc$scroll_data_backward,
          fdc$current_data_position),

    fdt$target_position = record
      case key: fdt$data_position of
      = fdc$top_of_box, fdc$bottom_of_box, fdc$scroll_data_forward, fdc$scroll_data_backward =
        data_index: fdt$text_length,
      = fdc$shift_characters =
        shift: integer,
      = fdc$page_data_first, fdc$page_data_last, fdc$page_data_forward,
              fdc$page_data_backward, fdc$current_data_position =
        ,
      casend
    recend;

  VAR
    record_separator: [READ, STATIC] string (1) := $CHAR(30),
    screen_event_table: [READ, STATIC] array [csc$insert_line .. csc$clear] of fdt$event_trigger :=
          [fdc$insert_line, fdc$delete_line, fdc$home_cursor, fdc$clear_screen],
    standard_event_table: [READ, STATIC] array [csc$next .. csc$sh_undo] of fdt$event_trigger :=
          [fdc$next, fdc$shift_next, fdc$help, fdc$shift_help, fdc$stop, fdc$shift_stop, fdc$back,
          fdc$shift_back, fdc$up, fdc$shift_up, fdc$down, fdc$shift_down, fdc$forward, fdc$shift_forward,
          fdc$backward, fdc$shift_backward, fdc$edit, fdc$shift_edit, fdc$data, fdc$shift_data, fdc$undo,
          fdc$undo];

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

  PROCEDURE [XDCL] fdp$change_screen
    (VAR status: ost$status);

    VAR
      current_form_identifier: fdt$next_form_identifier,
      cursor_character_position: fdt$character_position,
      display_attribute_set: fdt$display_attribute_set,
      end_character_position: cst$character_position,
      field_number: cst$field_number,
      form_identifier: fdt$form_identifier,
      form_name: ost$name,
      local_status: ost$status,
      n: integer,
      next_object_index: fdt$object_index,
      object_index: fdt$object_index,
      output_character_position: cst$character_position,
      output_line_position: cst$line_number,
      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_object_statuses: ^array [1 .. * ] of fdt$form_object_status,
      p_form_status: ^fdt$form_status,
      p_form_table_definition: ^fdt$form_table_definition,
      p_form_variable_definition: ^fdt$form_variable_definition,
      p_screen_change: ^fdt$screen_change,
      p_screen_text: ^fdt$text,
      p_table_objects: ^array [1 .. * ] of fdt$table_object,
      p_table_variable: ^fdt$table_variable,
      p_table_variables: ^array [1 .. * ] of fdt$table_variable,
      screen_visible_length: fdt$screen_variable_length,
      shift: integer,
      start_character_position: cst$character_position,
      table_index: fdt$table_index,
      table_shifted: boolean,
      target_position: fdt$target_position,
      terminal_status: ost$status,
      variable_index: fdt$variable_index;

?? NEWTITLE := 'clean_up', EJECT ??

    PROCEDURE [INLINE] clean_up;

      fdv$screen_status.number_screen_changes := 0;
      EXIT fdp$change_screen;
    PROCEND clean_up;

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

    PROCEDURE compute_new_screen_size;

      VAR
        actual_screen_height: cst$line_number,
        actual_screen_width: cst$visible_character_position,
        dimensions_accepted: boolean,
        form_x_position: fdt$x_position,
        form_y_position: fdt$y_position,
        new_screen_height: fdt$height,
        new_screen_width: fdt$width,
        p_event_form_status: ^fdt$form_status,
        screen_height: fdt$height,
        screen_width: fdt$width;

      current_form_identifier := fdv$screen_status.current_form_identifier;
      new_screen_width := 1;
      new_screen_height := 1;

      /compute_screen_size/
        REPEAT
          p_form_status := ^fdv$screen_status.p_forms_status^ [current_form_identifier];
          IF (p_form_status^.added OR p_form_status^.combined) THEN
            p_form_definition := p_form_status^.p_form_definition;
            form_x_position := p_form_status^.form_x_position;
            form_y_position := p_form_status^.form_y_position;
            screen_height := form_y_position + p_form_definition^.height - 1;
            screen_width := form_x_position + p_form_definition^.width - 1;

            IF screen_width > new_screen_width THEN
              new_screen_width := screen_width;
              form_name := p_form_definition^.form_name;
            IFEND;

            IF screen_height > new_screen_height THEN
              new_screen_height := screen_height;
              form_name := p_form_definition^.form_name;
            IFEND;

          IFEND;
          current_form_identifier := p_form_status^.next_lower_form;
        UNTIL current_form_identifier = 0;

        IF ((fdv$screen_status.current_screen_width = new_screen_width) AND
              (fdv$screen_status.current_screen_height = new_screen_height)) THEN
          RETURN;
        IFEND;

        csv$vector.change_device_dimensions^ (new_screen_width, new_screen_height, dimensions_accepted,
              terminal_status);
        IF NOT terminal_status.normal THEN
          fdp$convert_terminal_status (terminal_status, status);
          clean_up;
        IFEND;

        csv$vector.get_device_dimensions^ (actual_screen_width, actual_screen_height, terminal_status);
        IF NOT terminal_status.normal THEN
          fdp$convert_terminal_status (terminal_status, status);
          clean_up;
        IFEND;

        fdv$screen_status.current_screen_width := actual_screen_width;
        fdv$screen_status.current_screen_height := actual_screen_height;
        IF ((actual_screen_width < new_screen_width) OR (actual_screen_height < new_screen_height)) THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$form_too_large_for_screen, ' ', status);
          clean_up;
        IFEND;

      current_form_identifier := fdv$screen_status.current_form_identifier;
      /reposition_event_form/
        REPEAT
          p_form_status := ^fdv$screen_status.p_forms_status^ [current_form_identifier];
          IF (p_form_status^.added OR p_form_status^.combined) THEN
            IF p_form_status^.event_form_defined THEN
              p_event_form_status := ^fdv$screen_status.p_forms_status^
                    [p_form_status^.event_form_identifier];
              IF NOT p_event_form_status^.displayed_on_screen THEN
                p_event_form_status^.form_y_position := actual_screen_height -
                      p_event_form_status^.p_form_definition^.height + 1;
              IFEND;
            IFEND;
          IFEND;
          current_form_identifier := p_form_status^.next_lower_form;
        UNTIL current_form_identifier = 0;

      PROCEND compute_new_screen_size;

?? OLDTITLE, EJECT ??

    status.normal := TRUE;
    IF fdv$screen_status.compute_new_screen_size THEN
      fdv$screen_status.compute_new_screen_size := FALSE;
      IF fdv$screen_status.current_form_identifier <> 0 THEN

{ Forms have been added, deleted, or positioned.  Compute new screen
{ size needed to contain all forms.

        compute_new_screen_size;
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;
    IFEND;

{ Update screen from list of changes to forms.

    FOR n := 1 TO fdv$screen_status.number_screen_changes DO
      p_screen_change := ^fdv$screen_status.p_screen_changes^ [n];
      CASE p_screen_change^.key OF

      = fdc$add_form =
        p_form_status := ^fdv$screen_status.p_forms_status^ [p_screen_change^.form_identifier];
        create_screen_objects (p_form_status, status);
        IF NOT status.normal THEN
          delete_screen_objects (p_form_status, local_status);
          clean_up;
        IFEND;

        fdv$screen_status.number_active_forms := fdv$screen_status.number_active_forms + 1;
        p_form_status^.displayed_on_screen := TRUE;
        p_form_status^.events_active := TRUE;

      = fdc$change_table_size =
        p_form_status := ^fdv$screen_status.p_forms_status^ [p_screen_change^.table_form_identifier];
        shift_table (p_form_status, ^p_form_status^.p_form_table_definitions^ [p_screen_change^.table_index],
              p_screen_change^.table_index, 0, 0, status);
        IF NOT status.normal THEN
          delete_screen_objects (p_form_status, local_status);
          clean_up;
        IFEND;

      = fdc$close_form =
        p_form_status := ^fdv$screen_status.p_forms_status^ [p_screen_change^.close_form_identifier];
        IF p_form_status^.displayed_on_screen THEN
          fdv$screen_status.number_active_forms := fdv$screen_status.number_active_forms - 1;
          delete_screen_objects (p_form_status, local_status);
          p_form_status^.displayed_on_screen := FALSE;
        IFEND;

        IF p_form_status^.p_form_object_statuses <> NIL THEN
          FREE p_form_status^.p_form_object_statuses;
        IFEND;
        IF p_form_status^.defined_dynamically THEN
          mmp$delete_scratch_segment (p_form_status^.segment_pointer, local_status);
        IFEND;
        p_form_status^.entry_used := FALSE;

      = fdc$create_mark =
        p_form_status := ^fdv$screen_status.p_forms_status^ [p_screen_change^.create_mark_form_identifier];
        field_number := p_form_status^.p_form_object_statuses^ [p_screen_change^.create_mark_object_index].
              field_number;
        start_character_position := p_screen_change^.start_x_position;
        end_character_position := p_screen_change^.end_x_position;
        csv$vector.mark^ (field_number, start_character_position, 1, end_character_position, 1,
              csc$character_marking, terminal_status);
        IF NOT terminal_status.normal THEN
          fdp$convert_terminal_status (terminal_status, status);
          clean_up;
        IFEND;

      = fdc$delete_form, fdc$erase_form =
        p_form_status := ^fdv$screen_status.p_forms_status^ [p_screen_change^.form_identifier];
        fdv$screen_status.number_active_forms := fdv$screen_status.number_active_forms - 1;
        p_form_status^.displayed_on_screen := FALSE;
        delete_screen_objects (p_form_status, status);
        IF NOT status.normal THEN
          fdp$convert_terminal_status (terminal_status, status);
          clean_up;
        IFEND;

      = fdc$delete_mark =
        p_form_status := ^fdv$screen_status.p_forms_status^ [p_screen_change^.create_mark_form_identifier];
        csv$vector.mark^ (p_form_status^.p_form_object_statuses^ [p_screen_change^.
              delete_mark_object_index]. field_number, 1, 1, 1, 1, csc$unmark, terminal_status);
        IF NOT terminal_status.normal THEN
          fdp$convert_terminal_status (terminal_status, status);
          clean_up;
        IFEND;

    = fdc$format_text_box =
      p_form_status := ^fdv$screen_status.p_forms_status^ [p_screen_change^.format_text_form_identifier];
      target_position.key := fdc$current_data_position;
      object_index := p_screen_change^.format_text_object_index;
      p_form_object_definition := ^p_form_status^.p_form_object_definitions^ [object_index];
      format_screen_text (p_screen_change^.p_format_text, p_form_status, object_index,
            p_form_object_definition^.variable_box_fragment_index,
            p_form_object_definition^.variable_box_processing,
            p_form_object_definition^.variable_box_width,
            p_form_object_definition^.variable_box_height,
            target_position, status);

      = fdc$no_screen_change =

{ Do nothing. Some more recent change eliminated the change.

      = fdc$open_form =

{ Do nothing at this time. When part of Screen Formatting runs on
{ a micro downline load form.

      = fdc$replace_variable =
        p_form_status := ^fdv$screen_status.p_forms_status^ [p_screen_change^.variable_form_identifier];
        object_index := p_screen_change^.variable_object_index;
        p_form_object_definition := ^p_form_status^.p_form_object_definitions^ [object_index];

        CASE p_form_object_definition^.key OF

        = fdc$form_constant_text =
          target_position.key := fdc$current_data_position;
          replace_screen_variable (p_screen_change^.p_text, object_index, object_index,
                p_form_object_definition^.constant_text_width, p_form_status, target_position, status);
          IF NOT status.normal THEN
            clean_up;
          IFEND;

        = fdc$form_constant_text_box =
          target_position.key := fdc$current_data_position;
          format_screen_text (p_screen_change^.p_text, p_form_status, object_index,
                p_form_object_definition^.constant_box_fragment_index,
                p_form_object_definition^.constant_box_processing,
                p_form_object_definition^.constant_box_width, p_form_object_definition^.constant_box_height,
                target_position, status);
          IF NOT status.normal THEN
            clean_up;
          IFEND;

        = fdc$form_variable_text_box =
          next_object_index := p_form_object_definition^.variable_box_fragment_index;
          target_position.key := fdc$current_data_position;
          format_screen_text (p_screen_change^.p_text, p_form_status, object_index, next_object_index,
                p_form_object_definition^.variable_box_processing,
                p_form_object_definition^.variable_box_width, p_form_object_definition^.variable_box_height,
                target_position, status);
          IF NOT status.normal THEN
            clean_up;
          IFEND;

        = fdc$form_variable_text =
          p_form_variable_definition := ^p_form_status^.p_form_variable_definitions^
                [p_form_object_definition^.text_variable_index];
          IF p_form_variable_definition^.table_exists THEN
            table_index := p_form_variable_definition^.table_index;
            IF p_form_status^.p_form_table_statuses^ [table_index].
                  first_displayed_occurrence <> 1 THEN

{ The table has been scrolled.  Find place to replace variable.

              p_form_table_definition := ^p_form_status^.p_form_table_definitions^ [table_index];
              p_table_variables := fdp$ptr_table_variables (p_form_table_definition^.table_variables,
                  p_form_status^.p_form_module);

            /find_table_variable/
              FOR variable_index := 1 TO p_form_table_definition^.table_variables.active_number DO
                p_table_variable := ^p_table_variables^ [variable_index];
                IF p_table_variable^.name = p_form_object_definition^.name THEN
                  EXIT /find_table_variable/;
                IFEND;
              FOREND /find_table_variable/;

              p_table_objects := fdp$ptr_table_objects (p_table_variable^.table_objects,
                    p_form_status^.p_form_module);
              object_index := p_table_objects^ [p_form_object_definition^.occurrence -
                    p_form_status^.p_form_table_statuses^ [table_index].first_displayed_occurrence +
                    1].object_index;
              p_form_object_definition := ^p_form_status^.p_form_object_definitions^ [object_index];
            IFEND;
          IFEND;

          target_position.key := fdc$current_data_position;
          replace_screen_variable (p_screen_change^.p_text, object_index,
                p_screen_change^.variable_object_index,
                p_form_object_definition^.text_variable_width,
                p_form_status, target_position, status);
          IF NOT status.normal THEN
              clean_up;
          IFEND;

        = fdc$form_stored_variable =
          p_form_variable_definition := ^p_form_status^.p_form_variable_definitions^
                [p_form_object_definition^.stored_variable_index];
          table_index := p_form_variable_definition^.table_index;
          p_form_table_definition := ^p_form_status^.p_form_table_definitions^ [table_index];
          p_table_variables := fdp$ptr_table_variables (p_form_table_definition^.table_variables,
                p_form_status^.p_form_module);

        /find_variable/
          FOR variable_index := 1 TO p_form_table_definition^.table_variables.active_number DO
            p_table_variable := ^p_table_variables^ [variable_index];
            IF p_table_variable^.name = p_form_object_definition^.name THEN
              EXIT /find_variable/;
            IFEND;
          FOREND /find_variable/;

          p_table_objects := fdp$ptr_table_objects (p_table_variable^.table_objects,
                p_form_status^.p_form_module);
          object_index := p_table_objects^ [p_form_object_definition^.occurrence -
                p_form_status^.p_form_table_statuses^ [table_index].first_displayed_occurrence +
                1].object_index;
          p_form_object_definition := ^p_form_status^.p_form_object_definitions^ [object_index];
          target_position.key := fdc$current_data_position;
          replace_screen_variable (p_screen_change^.p_text, object_index,
                p_screen_change^.variable_object_index, p_form_object_definition^.text_variable_width,
                p_form_status, target_position, status);
          IF NOT status.normal THEN
            clean_up;
          IFEND;

        ELSE
          osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
                'invalid object for screen change', status);
          clean_up;
        CASEND;

      = fdc$reset_event_variable =

{ This action removes the highlight from a event menu variable.  The event menu
{ variable was highlighted when the terminal user pressed the associated
{ key. This change was scheduled during the last read_forms request.  Since the
{ last read_forms request the application may have deleted the event menu form.

        form_identifier := p_screen_change^.attribute_form_identifier;
        p_form_status := ^fdv$screen_status.p_forms_status^ [form_identifier];
        IF (p_form_status^.entry_used AND p_form_status^.displayed_on_screen) THEN
          p_form_object_statuses := p_form_status^.p_form_object_statuses;
          p_form_object_definitions := p_form_status^.p_form_object_definitions;
          object_index := p_screen_change^.attribute_object_index;
          p_form_object_definition := ^p_form_object_definitions^ [object_index];
          p_form_variable_definition := ^p_form_status^.p_form_variable_definitions^
                [p_form_object_definition^.text_variable_index];
          put_text_attribute (p_form_object_statuses^ [object_index].field_number,
                p_screen_change^.attribute, p_form_variable_definition^.io_mode, local_status);
        IFEND;

      = fdc$set_attribute =
        form_identifier := p_screen_change^.attribute_form_identifier;
        p_form_status := ^fdv$screen_status.p_forms_status^ [form_identifier];
        p_form_object_statuses := p_form_status^.p_form_object_statuses;
        p_form_object_definitions := p_form_status^.p_form_object_definitions;
        object_index := p_screen_change^.attribute_object_index;
        p_form_object_definition := ^p_form_object_definitions^ [object_index];

        CASE p_form_object_definition^.key OF

        = fdc$form_box, fdc$form_line =
          put_graphic_attribute (p_form_object_statuses^ [object_index].graphic_identifier,
                p_screen_change^.attribute, status);
          IF NOT status.normal THEN
            clean_up;
          IFEND;

        = fdc$form_constant_text_box =
          display_attribute_set := p_screen_change^.attribute;
          put_text_attribute (p_form_object_statuses^ [object_index].field_number, display_attribute_set,
                fdc$terminal_output, status);
          IF NOT status.normal THEN
            clean_up;
          IFEND;

          object_index := p_form_object_definition^.constant_box_fragment_index;
          WHILE object_index <> 0 DO
            put_text_attribute (p_form_object_statuses^ [object_index].field_number, display_attribute_set,
                  fdc$terminal_output, status);
            IF NOT status.normal THEN
              clean_up;
            IFEND;
            object_index := p_form_object_definitions^ [object_index].next_fragment_object_index;
          WHILEND;

        = fdc$form_stored_variable =
          p_form_variable_definition := ^p_form_status^.p_form_variable_definitions^
                [p_form_object_definition^.stored_variable_index];

{ If the variable is a member of a table, the table may be shifted to make the
{ variable visible to the terminal user.

          set_attribute (p_form_status, p_form_variable_definition, p_screen_change^.attribute, object_index,
                p_form_object_definition, table_shifted, status);
          IF NOT status.normal THEN
            clean_up;
          IFEND;

          IF table_shifted THEN

{ Delete any changes done while  shifting the table.

            delete_replace_variable (p_form_status, form_identifier, p_form_variable_definition^.table_index,
                  n);
          IFEND;

        = fdc$form_variable_text_box =
          p_form_variable_definition := ^p_form_status^.p_form_variable_definitions^
                [p_form_object_definition^.variable_box_variable_index];
          field_number := p_form_object_statuses^ [object_index].field_number;
          display_attribute_set := p_screen_change^.attribute;
          put_text_attribute (p_form_object_statuses^ [object_index].field_number, display_attribute_set,
                p_form_variable_definition^.io_mode, status);
          IF NOT status.normal THEN
            clean_up;
          IFEND;

          object_index := p_form_object_definition^.variable_box_fragment_index;
          WHILE object_index <> 0 DO
            put_text_attribute (p_form_object_statuses^ [object_index].field_number, display_attribute_set,
                  p_form_variable_definition^.io_mode, status);
            IF NOT status.normal THEN
              clean_up;
            IFEND;
            object_index := p_form_object_definitions^ [object_index].next_fragment_object_index;
          WHILEND;

        = fdc$form_variable_text =
          p_form_variable_definition := ^p_form_status^.p_form_variable_definitions^
                [p_form_object_definition^.text_variable_index];

{ If the variable is a member of a table, the table may be shifted to make
{ the variable visible to the terminal user.

          set_attribute (p_form_status, p_form_variable_definition, p_screen_change^.attribute, object_index,
                p_form_object_definition, table_shifted, status);
          IF NOT status.normal THEN
            clean_up;
          IFEND;

          IF table_shifted THEN

{ Delete any changes done while shifting the table.

            delete_replace_variable (p_form_status, form_identifier, p_form_variable_definition^.table_index,
                  n);
          IFEND;

        = fdc$form_constant_text =
          put_text_attribute (p_form_object_statuses^ [object_index].field_number, p_screen_change^.attribute,
                fdc$terminal_output, status);
          IF NOT status.normal THEN
            clean_up;
          IFEND;

        ELSE
          osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
                'invalid object for screen change', status);
          clean_up;
        CASEND;

      = fdc$add_object =
        p_form_status := ^fdv$screen_status.p_forms_status^ [p_screen_change^.object_form_identifier];
        add_screen_object (p_form_status, p_screen_change^.object_definition, p_screen_change^.object_index,
              status);
        IF NOT status.normal THEN
          clean_up;
        IFEND;

      = fdc$delete_object =
        p_form_status := ^fdv$screen_status.p_forms_status^ [p_screen_change^.object_form_identifier];
        p_form_object_statuses := p_form_status^.p_form_object_statuses;
        object_index := p_screen_change^.object_index;
        CASE p_form_object_statuses^ [object_index].key OF

        = fdc$graphic_identifier =
          csv$vector.delete_graphic^ (p_form_object_statuses^ [object_index].graphic_identifier,
                terminal_status);

        = fdc$field_identifier =
          csv$vector.delete_field^ (p_form_object_statuses^ [object_index].field_number, terminal_status);

        ELSE
          osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
                'invalid object status key', terminal_status);
        CASEND;

        p_form_object_statuses^ [object_index].key := fdc$unused_identifier;
        IF NOT terminal_status.normal THEN
          fdp$convert_terminal_status (terminal_status, status);
          clean_up;
        IFEND;

      = fdc$set_cursor =
        form_identifier := p_screen_change^.cursor_form_identifier;
        p_form_status := ^fdv$screen_status.p_forms_status^ [form_identifier];
        p_form_object_statuses := p_form_status^.p_form_object_statuses;
        p_form_object_definitions := p_form_status^.p_form_object_definitions;
        object_index := p_screen_change^.cursor_object_index;
        p_form_object_definition := ^p_form_object_definitions^ [object_index];
        cursor_character_position := p_screen_change^.cursor_character_position;
        CASE p_form_object_definition^.key OF

        = fdc$form_constant_text =
          screen_visible_length := p_form_object_definition^.constant_text_width;
          compute_cursor_shift (screen_visible_length,
                p_form_object_statuses^ [object_index].character_position, cursor_character_position, shift);
          IF shift <> 0 THEN

{ Shift the variable to make the cursor position visible to the terminal user.

            p_screen_text := fdp$ptr_text (p_form_object_definition^.constant_text,
                  p_form_status^.p_form_module);
            target_position.key := fdc$shift_characters;
            target_position.shift := shift;
            replace_screen_variable (p_screen_text, object_index, object_index, screen_visible_length,
                  p_form_status, target_position, status);
            IF NOT status.normal THEN
              clean_up;
            IFEND;
          IFEND;

          cursor_character_position := cursor_character_position -
                p_form_object_statuses^ [object_index].character_position + 1;
          csv$vector.position_cursor^ (p_form_status^.p_form_object_statuses^
                [object_index].field_number, cursor_character_position, 1,
                output_character_position, output_line_position, terminal_status);
          IF NOT terminal_status.normal THEN
            fdp$convert_terminal_status (terminal_status, status);
            clean_up;
          IFEND;

          fdv$screen_status.cursor_set := TRUE;

        = fdc$form_constant_text_box =
          p_screen_text := fdp$ptr_text (p_form_object_definition^.constant_box_text,
                p_form_status^.p_form_module);
          set_text_box_cursor_position (p_form_status, p_screen_text, object_index,
                p_form_object_definition^.constant_box_fragment_index,
                p_form_object_definition^.constant_box_processing,
                p_form_object_definition^.constant_box_width, p_form_object_definition^.constant_box_height,
                cursor_character_position, status);
          IF NOT status.normal THEN
            clean_up;
          IFEND;

          fdv$screen_status.cursor_set := TRUE;

        = fdc$form_stored_variable =
          p_form_variable_definition := ^p_form_status^.p_form_variable_definitions^
                [p_form_object_definition^.stored_variable_index];

{ If the variable is a member of a table, the table may be shifted to make
{ the variable visible to the terminal user.

          set_table_cursor_position (p_form_status, p_form_variable_definition, p_form_object_definition,
                object_index, cursor_character_position, table_shifted, status);
          IF NOT status.normal THEN
            clean_up;
          IFEND;
          fdv$screen_status.cursor_set := TRUE;

          IF table_shifted THEN

{ Delete any changes done while shifting the table.

            delete_replace_variable (p_form_status, form_identifier, p_form_variable_definition^.table_index,
                  n);
          IFEND;

        = fdc$form_variable_text =
          p_form_variable_definition := ^p_form_status^.p_form_variable_definitions^
                [p_form_object_definition^.text_variable_index];
          IF p_form_variable_definition^.table_exists THEN
            set_table_cursor_position (p_form_status, p_form_variable_definition, p_form_object_definition,
                  object_index, cursor_character_position, table_shifted, status);
            IF NOT status.normal THEN
              clean_up;
            IFEND;
            fdv$screen_status.cursor_set := TRUE;

            IF table_shifted THEN

{ Delete any changes done while shifting the table.

              delete_replace_variable (p_form_status, form_identifier,
                    p_form_variable_definition^.table_index, n);
            IFEND;

          ELSE

{ The object does not belong to a table.

            screen_visible_length := p_form_object_definition^.text_variable_width;
            compute_cursor_shift (screen_visible_length,
                  p_form_object_statuses^ [object_index].character_position, cursor_character_position,
                  shift);
            IF shift <> 0 THEN

{ Shift the variable to make the cursor position visible to the terminal user.

              fdp$ptr_screen_variable (p_form_status^.p_screen_record,
                    p_form_variable_definition^.screen_record_position, p_form_variable_definition^.
                    screen_variable_length, p_screen_text);
              target_position.key := fdc$shift_characters;
              target_position.shift := shift;
              replace_screen_variable (p_screen_text, object_index, object_index, screen_visible_length,
                    p_form_status, target_position, status);
              IF NOT status.normal THEN
                clean_up;
              IFEND;

            IFEND;

            cursor_character_position := cursor_character_position -
                  p_form_object_statuses^ [object_index].character_position + 1;
            csv$vector.position_cursor^ (p_form_status^.p_form_object_statuses^
                  [object_index].field_number, cursor_character_position, 1,
                  output_character_position, output_line_position, terminal_status);
            IF NOT terminal_status.normal THEN
              fdp$convert_terminal_status (terminal_status, status);
              clean_up;
            IFEND;
            fdv$screen_status.cursor_set := TRUE;
          IFEND;

        = fdc$form_variable_text_box =
          p_form_variable_definition := ^p_form_status^.p_form_variable_definitions^
                [p_form_object_definition^.variable_box_variable_index];
          fdp$ptr_screen_variable (p_form_status^.p_screen_record,
                p_form_variable_definition^.screen_record_position, p_form_variable_definition^.
                screen_variable_length, p_screen_text);
          set_text_box_cursor_position (p_form_status, p_screen_text, object_index,
                p_form_object_definition^.variable_box_fragment_index,
                p_form_object_definition^.variable_box_processing,
                p_form_object_definition^.variable_box_width, p_form_object_definition^.variable_box_height,
                cursor_character_position, status);
          IF NOT status.normal THEN
            clean_up;
          IFEND;
          fdv$screen_status.cursor_set := TRUE;

        ELSE
          osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
                'invalid object for screen change', status);
          clean_up;
        CASEND;

      ELSE
        osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error, 'invalid screen change',
              status);
        clean_up;
      CASEND;
    FOREND;

    clean_up;
  PROCEND fdp$change_screen;

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

  PROCEDURE [XDCL] fdp$convert_terminal_status
    (    terminal_status: ost$status;
     VAR new_status: ost$status);

    VAR
      status: ost$status,
      str_rec: ost$string;

    CASE terminal_status.condition OF

    = ife$connection_break_disconnect, ife$job_disconnect_interactive, ife$job_disconnect_batch,
      jme$transaction_job_disconnect =
      osp$set_status_abnormal (fdc$format_display_identifier, fde$terminal_disconnected, '', new_status);

    = lle$entry_point_not_found, cle$improper_name, cse$undefined_terminal_model=
      osp$set_status_abnormal (fdc$format_display_identifier, fde$terminal_not_identified, '', new_status);

    = ife$terminate_break_received =
      pmp$exit (terminal_status);

    ELSE
      osp$get_status_condition_string (terminal_status.condition, str_rec, status);
      osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error, str_rec.
            value (1, str_rec.size), new_status);
    CASEND;

  PROCEND fdp$convert_terminal_status;

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

  PROCEDURE [XDCL] fdp$create_design_form
    (VAR form_identifier: fdt$form_identifier;
     VAR form_attributes: fdt$form_attributes;
     VAR status: ost$status);

    VAR
      design_form_attributes: array [1 .. 1] of fdt$form_attribute,
      form_height: fdt$height,
      form_width: fdt$width,
      form_x_position: fdt$x_position,
      form_y_position: fdt$y_position,
      p_errors: ^SEQ ( * ),
      p_initial_value: ^fdt$text,
      local_status: ost$status,
      number_of_characters: cst$visible_character_position,
      number_of_lines: cst$line_number,
      number_errors: fdt$number_errors,
      object_definition: fdt$object_definition,
      object_attributes: array [1 .. 2] of fdt$object_attribute,
      p_form_definition: ^fdt$form_definition,
      p_form_status: ^fdt$form_status,
      table_attributes: array [1 .. 3] of fdt$table_attribute,
      table_name: ost$name,
      terminal_status: ost$status,
      variable_attributes: array [1 .. 2] of fdt$variable_attribute,
      variable_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 fdp$create_design_form;
      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_design_form;
      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$create_form (form_identifier, form_attributes, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    fdp$find_form_definition (form_identifier, p_form_status, status);
    p_form_definition := p_form_status^.p_form_definition;
    table_name := fdc$system_design_table_name;
    variable_name := p_form_status^.design_variable_name;
    CASE p_form_definition^.form_area.key OF

    = fdc$defined_area =
      form_x_position := p_form_definition^.form_area.x_position;
      form_y_position := p_form_definition^.form_area.y_position;
      form_width := p_form_definition^.form_area.width;
      form_height := p_form_definition^.form_area.height;

    = fdc$screen_area =
      form_x_position := 1;
      form_y_position := 1;
      IF NOT fdv$screen_status.screen_mode_active THEN
        csv$vector.change_capability_level^ (csc$screen_level, terminal_status);
        IF ((NOT terminal_status.normal) AND (terminal_status.condition <> cse$redundant_screen_level)) THEN
          fdp$convert_terminal_status (terminal_status, status);
          fdp$close_form (form_identifier, local_status);
          RETURN;
        IFEND;
        fdv$screen_status.screen_mode_active := TRUE;
      IFEND;

{ The design form has the current dimensions of the terminal. }
{ Its dimensions cannot be changed. }

      csv$vector.get_device_dimensions^ (number_of_characters, number_of_lines, terminal_status);
      IF NOT terminal_status.normal THEN
        fdp$convert_terminal_status (terminal_status, status);
        fdp$close_form (form_identifier, local_status);
        RETURN;
      IFEND;

      form_width := number_of_characters;
      form_height := number_of_lines;
      design_form_attributes [1].key := fdc$form_area;
      design_form_attributes [1].form_area.key := fdc$defined_area;
      design_form_attributes [1].form_area.x_position := 1;
      design_form_attributes [1].form_area.y_position := 1;
      design_form_attributes [1].form_area.width := number_of_characters;
      design_form_attributes [1].form_area.height := number_of_lines;
      fdp$change_form (form_identifier, design_form_attributes, status);
      IF NOT status.normal THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
             'create design form create table failed', status);
        fdp$close_form (form_identifier, local_status);
      IFEND;
    ELSE
    CASEND;

{ Create a table that covers the screen.  The table has one variable. }
{ The variable allows programs to get and replace free text on the design form. }

    table_attributes [1].key := fdc$stored_occurrence;
    table_attributes [1].stored_occurrence := form_height;
    table_attributes [2].key := fdc$visible_occurrence;
    table_attributes [2].visible_occurrence := form_height;
    table_attributes [3].key := fdc$add_table_variable;
    table_attributes [3].variable_name := variable_name;
    fdp$create_table (form_identifier, table_name, table_attributes, status);
    IF NOT status.normal THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
           'create design form create table failed', status);
      fdp$close_form (form_identifier, local_status);
      RETURN;
    IFEND;

    variable_attributes [1].key := fdc$variable_length;
    variable_attributes [1].variable_length := form_width;
    variable_attributes [2].key := fdc$program_data_type;
    variable_attributes [2].program_data_type := fdc$program_character_type;
    fdp$create_variable (form_identifier, variable_name, variable_attributes, status);
    IF NOT status.normal THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
           'create design form create variable failed', status);
      fdp$close_form (form_identifier, local_status);
      RETURN;
    IFEND;

{ Create text objects for the screen table. }

    p_form_status^.design_form := TRUE;
    object_definition.key := fdc$variable_text;
    object_definition.variable_text_width := form_width;
    PUSH p_initial_value: [form_width];
    p_initial_value^ := ' ';
    object_definition.p_variable_text := p_initial_value;
    object_attributes [1].key := fdc$object_name;
    object_attributes [1].object_name := variable_name;
    object_attributes [2].key := fdc$object_display;
    object_attributes [2].display_attribute := $fdt$display_attribute_set [];

    FOR y_position := 1 TO form_height DO
      object_attributes [1].occurrence := y_position;
      fdp$create_object (form_identifier, 1, y_position, object_definition, object_attributes, status);
      IF NOT status.normal THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
             'create design form create object failed', status);
        fdp$close_form (form_identifier, local_status);
        RETURN;
      IFEND;
    FOREND;

    fdp$end_form (form_identifier, NIL, number_errors, p_errors, status);
    IF NOT status.normal THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
           'create design form end form failed', status);
      fdp$close_form (form_identifier, local_status);
      RETURN;
    IFEND;

    IF number_errors <> 0 THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
           'create design form end form failed', status);
      fdp$close_form (form_identifier, local_status);
    IFEND;

    ALLOCATE p_form_status^.p_form_image;
    IF p_form_status^.p_form_image = NIL THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available,'',status);
      RETURN;
    IFEND;

    FOR y_position := 1 to fdc$maximum_y_position DO
      p_form_status^.p_form_image^ [y_position] := ' ';
    FOREND;

  PROCEND fdp$create_design_form;
?? TITLE := 'fdp$create_form_events', EJECT ??
*copyc fdh$create_form_events

  PROCEDURE [XDCL] fdp$create_form_events
    (    form_identifier: fdt$form_identifier;
         display_attribute_set: fdt$display_attribute_set;
     VAR status: ost$status);

    TYPE
      fdt$event_trigger_set = set of fdt$event_trigger;

    TYPE
      fdt$shift_event_map = record
        case shift_trigger_exists: boolean of
        = FALSE =
          event_trigger: fdt$event_trigger,
        = TRUE =
          unshifted_event_trigger: fdt$event_trigger,
        casend,
      recend;

    VAR
      application_trigger_exists: boolean,
      application_trigger_set: [READ] set of fdt$event_trigger :=
            [fdc$function_1, fdc$function_2, fdc$function_3, fdc$function_4, fdc$function_5, fdc$function_6,
            fdc$function_7, fdc$function_8, fdc$function_9, fdc$function_10, fdc$function_11, fdc$function_12,
            fdc$function_13, fdc$function_14, fdc$function_15, fdc$function_16, fdc$shift_function_1,
            fdc$shift_function_2, fdc$shift_function_3, fdc$shift_function_4, fdc$shift_function_5,
            fdc$shift_function_6, fdc$shift_function_7, fdc$shift_function_8, fdc$shift_function_9,
            fdc$shift_function_10, fdc$shift_function_11, fdc$shift_function_12, fdc$shift_function_13,
            fdc$shift_function_14, fdc$shift_function_15, fdc$shift_function_16],
      event_index: fdt$event_index,
      event_form_identifier: fdt$form_identifier,
      event_trigger: fdt$event_trigger,
      form_attributes: array [1 .. 4] of fdt$form_attribute,
      local_status: ost$status,
      n: integer,
      next_event_trigger: fdt$event_trigger,
      number_application_events: integer,
      number_events: integer,
      p_event_definition: ^fdt$event_definition,
      p_event_definitions: ^array [1 .. * ] of fdt$event_definition,
      p_event_menus: ^array [1 .. * ] of fdt$event_menu,
      p_form_definition: ^fdt$form_definition,
      p_form_event_statuses: ^array [1 .. * ] of fdt$form_event_status,
      p_form_status: ^fdt$form_status,
      preferred_triggers: [READ] array [1 .. 32] of fdt$event_trigger :=
            [fdc$function_1, fdc$function_2, fdc$function_3, fdc$function_4, fdc$function_5, fdc$function_6,
            fdc$function_7, fdc$function_8, fdc$shift_function_1, fdc$shift_function_2, fdc$shift_function_3,
            fdc$shift_function_4, fdc$shift_function_5, fdc$shift_function_6, fdc$shift_function_7,
            fdc$shift_function_8, fdc$function_9, fdc$function_10, fdc$function_11, fdc$function_12,
            fdc$function_13, fdc$function_14, fdc$function_15, fdc$function_16, fdc$shift_function_9,
            fdc$shift_function_10, fdc$shift_function_11, fdc$shift_function_12, fdc$shift_function_13,
            fdc$shift_function_14, fdc$shift_function_15, fdc$shift_function_16],
      shift_event_maps: [READ] array [fdc$next .. fdc$variable_trigger] of fdt$shift_event_map :=
            [[FALSE, fdc$next], [FALSE, fdc$help], [FALSE, fdc$stop], [FALSE, fdc$back], [FALSE, fdc$up],
            [FALSE, fdc$down], [FALSE, fdc$forward], [FALSE, fdc$backward], [FALSE, fdc$undo],
            [FALSE, fdc$redo], [FALSE, fdc$quit], [FALSE, fdc$exit], [FALSE, fdc$first], [FALSE, fdc$last],
            [FALSE, fdc$edit], [FALSE, fdc$data], [FALSE, fdc$function_1], [FALSE, fdc$function_2],
            [FALSE, fdc$function_3], [FALSE, fdc$function_4], [FALSE, fdc$function_5],
            [FALSE, fdc$function_6], [FALSE, fdc$function_7], [FALSE, fdc$function_8],
            [FALSE, fdc$function_9], [FALSE, fdc$function_10], [FALSE, fdc$function_11],
            [FALSE, fdc$function_12], [FALSE, fdc$function_13], [FALSE, fdc$function_14],
            [FALSE, fdc$function_15], [FALSE, fdc$function_16], [TRUE, fdc$next], [TRUE, fdc$help],
            [TRUE, fdc$stop], [TRUE, fdc$back], [TRUE, fdc$up], [TRUE, fdc$down], [TRUE, fdc$forward],
            [TRUE, fdc$backward], [TRUE, fdc$edit], [TRUE, fdc$data], [TRUE, fdc$function_1],
            [TRUE, fdc$function_2], [TRUE, fdc$function_3], [TRUE, fdc$function_4], [TRUE, fdc$function_5],
            [TRUE, fdc$function_6], [TRUE, fdc$function_7], [TRUE, fdc$function_8], [TRUE, fdc$function_9],
            [TRUE, fdc$function_10], [TRUE, fdc$function_11], [TRUE, fdc$function_12],
            [TRUE, fdc$function_13], [TRUE, fdc$function_14], [TRUE, fdc$function_15],
            [TRUE, fdc$function_16], [FALSE, fdc$pick], [FALSE, fdc$insert_line], [FALSE, fdc$delete_line],
            [FALSE, fdc$home_cursor], [FALSE, fdc$clear_screen], [FALSE, fdc$time_out],
            [FALSE, fdc$variable_trigger]],
      shifted_preferred_triggers: [READ] array [1 .. 16] of fdt$event_trigger :=
            [fdc$shift_function_1, fdc$shift_function_2, fdc$shift_function_3, fdc$shift_function_4,
            fdc$shift_function_5, fdc$shift_function_6, fdc$shift_function_7, fdc$shift_function_8,
            fdc$shift_function_9, fdc$shift_function_10, fdc$shift_function_11, fdc$shift_function_12,
            fdc$shift_function_13, fdc$shift_function_14, fdc$shift_function_15, fdc$shift_function_16],
      standard_trigger_set: [READ] set of fdt$event_trigger :=
            [fdc$help, fdc$stop, fdc$shift_stop, fdc$back, fdc$forward, fdc$shift_forward, fdc$backward,
            fdc$shift_backward, fdc$undo, fdc$undo],
      unshifted_preferred_triggers: [READ] array [1 .. 16] of fdt$event_trigger :=
            [fdc$function_1, fdc$function_2, fdc$function_3, fdc$function_4, fdc$function_5, fdc$function_6,
            fdc$function_7, fdc$function_8, fdc$function_9, fdc$function_10, fdc$function_11, fdc$function_12,
            fdc$function_13, fdc$function_14, fdc$function_15, fdc$function_16];

?? NEWTITLE := 'assign_trigger', EJECT ??

    PROCEDURE assign_trigger;

?? NEWTITLE := 'store_assignment', EJECT ??

      PROCEDURE [INLINE] store_assignment;

        fdv$screen_status.p_screen_event_statuses^ [event_trigger].event_used := TRUE;
        p_form_event_statuses^ [event_index].event_exists := TRUE;
        event_trigger := fdv$screen_status.p_screen_event_statuses^ [event_trigger].event_trigger;
        p_form_event_statuses^ [event_index].event_trigger := event_trigger;
        IF event_trigger IN application_trigger_set THEN
          application_trigger_exists := TRUE;
        IFEND;

      PROCEND store_assignment;

?? OLDTITLE, EJECT ??

{ First try to use the event trigger defined by the application during form
{ definition that
{ corresponds to the Terminal Definition key.

      IF (fdv$screen_status.p_screen_event_statuses^ [event_trigger].event_exists AND
            (NOT fdv$screen_status.p_screen_event_statuses^ [event_trigger].event_used)) THEN
        IF (fdv$screen_status.p_screen_event_statuses^ [event_trigger].event_trigger = event_trigger) THEN
          store_assignment;
          RETURN;

{ The terminal definition has reassigned the function key.

        ELSEIF reassign_trigger(event_index) THEN
          store_assignment;
          RETURN;
        IFEND;
      IFEND;

{ If event trigger does not exist on terminal then assign event trigger from
{ list of terminal triggers in priority order.
{ Try to minimize the number of terminal keys used.

      IF NOT reassign_trigger(event_index) THEN
        RETURN;
      IFEND;

      FOR n := LOWERBOUND (preferred_triggers) TO UPPERBOUND (preferred_triggers) DO
        event_trigger := preferred_triggers [n];
        IF (fdv$screen_status.p_screen_event_statuses^ [event_trigger].event_exists AND
              (NOT fdv$screen_status.p_screen_event_statuses^ [event_trigger].event_used)) THEN
          store_assignment;
          RETURN;
        IFEND;
      FOREND;
    PROCEND assign_trigger;

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

    PROCEDURE assign_trigger_pair;

      VAR
        trial_event_trigger: fdt$event_trigger,
        shifted_event_trigger: fdt$event_trigger;

?? NEWTITLE := 'store_assignment', EJECT ??

      PROCEDURE [INLINE] store_assignment;

        fdv$screen_status.p_screen_event_statuses^ [event_trigger].event_used := TRUE;
        fdv$screen_status.p_screen_event_statuses^ [next_event_trigger].event_used := TRUE;
        p_form_event_statuses^ [event_index].event_exists := TRUE;
        event_trigger := fdv$screen_status.p_screen_event_statuses^ [event_trigger].event_trigger;
        p_form_event_statuses^ [event_index].event_trigger := event_trigger;
        p_form_event_statuses^ [event_index + 1].event_exists := TRUE;
        next_event_trigger := fdv$screen_status.p_screen_event_statuses^ [next_event_trigger].event_trigger;
        p_form_event_statuses^ [event_index + 1].event_trigger := next_event_trigger;
        IF event_trigger IN application_trigger_set THEN
          application_trigger_exists := TRUE;
        IFEND;

      PROCEND store_assignment;

?? OLDTITLE, EJECT ??

{ First try to use the event trigger defined by the application during form
{ definition that
{ corresponds to the Terminal Definition key.


      IF (fdv$screen_status.p_screen_event_statuses^ [event_trigger].event_exists AND
            (NOT fdv$screen_status.p_screen_event_statuses^ [event_trigger].event_used) AND
            fdv$screen_status.p_screen_event_statuses^ [next_event_trigger].event_exists AND
            (NOT fdv$screen_status.p_screen_event_statuses^ [next_event_trigger].event_used)) THEN
        IF (fdv$screen_status.p_screen_event_statuses^ [event_trigger].event_trigger =  event_trigger) AND
              (fdv$screen_status.p_screen_event_statuses^ [next_event_trigger].event_trigger =
              next_event_trigger) THEN

{ The triggers exist on the terminal.

            store_assignment;
            RETURN;

{ The triggers do not exist on the terminal.  Assign only if user says reassignment is valid.

        ELSEIF (reassign_trigger(event_index) AND reassign_trigger(event_index+1)) THEN
          store_assignment;
            RETURN;
        IFEND;
      IFEND;

{ If event trigger does not exist on terminal then assign trigger
{ form terminal in given priority order.
{ Try to minimize the number of terminal keys used.

      IF NOT reassign_trigger(event_index) THEN
        RETURN;
      IFEND;

      FOR n := LOWERBOUND (shifted_preferred_triggers) TO UPPERBOUND (shifted_preferred_triggers) DO
        trial_event_trigger := unshifted_preferred_triggers [n];
        shifted_event_trigger := shifted_preferred_triggers [n];
        IF (fdv$screen_status.p_screen_event_statuses^ [trial_event_trigger].event_exists AND
              NOT fdv$screen_status.p_screen_event_statuses^ [trial_event_trigger].event_used AND
              fdv$screen_status.p_screen_event_statuses^ [shifted_event_trigger].event_exists AND
              NOT fdv$screen_status.p_screen_event_statuses^ [shifted_event_trigger].event_used) THEN
          fdv$screen_status.p_screen_event_statuses^ [trial_event_trigger].event_used := TRUE;
          fdv$screen_status.p_screen_event_statuses^ [shifted_event_trigger].event_used := TRUE;
          p_form_event_statuses^ [event_index].event_exists := TRUE;
          trial_event_trigger := fdv$screen_status.p_screen_event_statuses^ [trial_event_trigger].
                event_trigger;
          p_form_event_statuses^ [event_index].event_trigger := trial_event_trigger;
          p_form_event_statuses^ [event_index + 1].event_exists := TRUE;
          shifted_event_trigger := fdv$screen_status.p_screen_event_statuses^ [shifted_event_trigger].
                event_trigger;
          p_form_event_statuses^ [event_index + 1].event_trigger := shifted_event_trigger;
          application_trigger_exists := TRUE;
          RETURN;
        IFEND;
      FOREND;

{ The events could not be paired on a single key.

      assign_trigger;
    PROCEND assign_trigger_pair;

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

    FUNCTION reassign_trigger(event_index:fdt$event_index): boolean;

      IF p_form_definition^.screen_formatting_version < fdc$reassign_event_capability THEN
        reassign_trigger := TRUE;
      ELSE
        reassign_trigger := p_event_definitions^ [event_index].event_trigger_reassignment;
      IFEND;

    FUNCEND reassign_trigger;


?? OLDTITLE, EJECT ??

    status.normal := TRUE;
    IF fdv$screen_status.p_screen_event_statuses = NIL THEN

{ Get terminal event definitions from the Screen Manager.

      fdp$get_screen_events (status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

{ Assign like event triggers of different forms to the same terminal key.

    p_form_status := ^fdv$screen_status.p_forms_status^ [form_identifier];
    application_trigger_exists := FALSE;
    p_form_definition := p_form_status^.p_form_definition;
    p_form_event_statuses := p_form_status^.p_form_event_statuses;
    p_event_definitions := p_form_status^.p_event_definitions;

    FOR event_trigger := LOWERBOUND (fdv$screen_status.p_screen_event_statuses^)
          TO UPPERBOUND (fdv$screen_status.p_screen_event_statuses^) DO
      fdv$screen_status.p_screen_event_statuses^ [event_trigger].event_used := FALSE;
    FOREND;

    number_events := p_form_definition^.event_definitions.active_number;
    FOR event_index := 1 TO number_events DO
      p_form_event_statuses^ [event_index].event_exists := FALSE;
    FOREND;

{ Assign standard triggers.  Any standard triggers not used by the form are
{ available for
{ assignment to other events.

  /assign_standard_triggers/
    FOR event_index := 1 TO number_events DO
      event_trigger := p_event_definitions^ [event_index].event_trigger;
      IF NOT (event_trigger IN standard_trigger_set) THEN
        CYCLE /assign_standard_triggers/;
      IFEND;

      IF (fdv$screen_status.p_screen_event_statuses^ [event_trigger].event_exists AND
            NOT fdv$screen_status.p_screen_event_statuses^ [event_trigger].event_used) THEN
        IF(fdv$screen_status.p_screen_event_statuses^ [event_trigger].
              event_trigger <> event_trigger) THEN

{ The standard trigger has been assigned to a terminal application function
{ key. The standard trigger
{ does not exist on the terminal.

          IF reassign_trigger(event_index) THEN
            next_event_trigger := fdv$screen_status.p_screen_event_statuses^ [event_trigger].event_trigger;
            fdv$screen_status.p_screen_event_statuses^ [next_event_trigger].event_used := TRUE;
            fdv$screen_status.p_screen_event_statuses^ [event_trigger].event_used := TRUE;
            p_form_event_statuses^ [event_index].event_exists := TRUE;
            p_form_event_statuses^ [event_index].event_trigger := next_event_trigger;
            application_trigger_exists := TRUE;
          IFEND;

        ELSE

{ The standard trigger exists on the terminal.

          fdv$screen_status.p_screen_event_statuses^ [event_trigger].event_used := TRUE;
          p_form_event_statuses^ [event_index].event_exists := TRUE;
          p_form_event_statuses^ [event_index].event_trigger := event_trigger;
        IFEND;
      IFEND;
    FOREND /assign_standard_triggers/;

{ Create event triggers the form requires.
{ The event triggers are sorted in high to low priority assignment order.
{ Ignore events that cannot be assigned on terminal.  The  application program
{ has assigned a priority to the terminal events and will interact with
{ the terminal up to the capability of the terminal.

  /assign_event_trigger/
    FOR event_index := 1 TO number_events DO
      IF p_form_event_statuses^ [event_index].event_exists THEN
        CYCLE /assign_event_trigger/;
      IFEND;

{ Attempt to pair unshifted and shifted triggers.

      event_trigger := p_event_definitions^ [event_index].event_trigger;
      IF ((event_index + 1) <= number_events) THEN
        next_event_trigger := p_event_definitions^ [event_index + 1].event_trigger;
        IF (shift_event_maps [next_event_trigger].shift_trigger_exists) AND
              (shift_event_maps [next_event_trigger].unshifted_event_trigger = event_trigger) THEN
          assign_trigger_pair;
          CYCLE /assign_event_trigger/;
        IFEND;
      IFEND;

      assign_trigger;
    FOREND /assign_event_trigger/;

    IF ((application_trigger_exists) AND (p_form_definition^.event_form_definition.key =
          fdc$system_default_event_form)) THEN
      number_application_events := 0;

{ Create screen formatting default event form.

      FOR event_index := 1 TO number_events DO
        IF p_form_event_statuses^ [event_index].event_exists THEN
          number_application_events := number_application_events + 1;
        IFEND;
      FOREND;

      PUSH p_event_menus: [1 .. number_application_events];
      number_application_events := 0;
      FOR event_index := 1 TO number_events DO
        p_event_definition := ^p_event_definitions^ [event_index];
        IF p_form_event_statuses^ [event_index].event_exists THEN
          number_application_events := number_application_events + 1;
          p_event_menus^ [number_application_events].event_trigger :=
                p_form_event_statuses^ [event_index].event_trigger;
          p_event_menus^ [number_application_events].event_name := p_event_definition^.event_name;
          p_event_menus^ [number_application_events].event_label := p_event_definition^.event_label;
        IFEND;
      FOREND;

      form_attributes [1].key := fdc$add_display_definition;
      form_attributes [1].display_name := fdc$system_display_name;
      form_attributes [1].display_attribute := $fdt$display_attribute_set
            [fdc$low_intensity, fdc$inverse_video];
      form_attributes [2].key := fdc$form_display_attribute;
      form_attributes [2].form_display_attribute := display_attribute_set -
            $fdt$display_attribute_set [fdc$fine_border, fdc$medium_border, fdc$bold_border];
      form_attributes [3].key := fdc$form_processor;
      form_attributes [3].form_processor := p_form_definition^.processor;
      form_attributes [4].key := fdc$fast_form_creation;
      form_attributes [4].fast_form_creation := TRUE;
      fdp$create_event_form (p_event_menus^, form_attributes, event_form_identifier, status);
      p_form_status := ^fdv$screen_status.p_forms_status^ [form_identifier];
      p_form_status^.event_form_identifier := event_form_identifier;
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      fdp$open_form (osc$null_name, event_form_identifier, status);
      IF NOT status.normal THEN
        fdp$close_form (event_form_identifier, local_status);
        RETURN;
      IFEND;
      p_form_status^.event_form_defined := TRUE;
    IFEND;
  PROCEND fdp$create_form_events;

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

{ DESIGN:
{   This procedure searches the object definitions until the first one beyond the specified position is
{   encountered.  The object definitions are ordered by location.
{

  PROCEDURE [XDCL] fdp$find_next_object
    (    x_position: fdt$x_position;
         y_position: fdt$y_position;
         p_form_status: ^fdt$form_status;
     VAR object_index: fdt$object_index);

    VAR
      p_form_object_definition: ^fdt$form_object_definition,
      p_form_object_definitions: ^array [1 .. * ] of fdt$form_object_definition;

    p_form_object_definitions := p_form_status^.p_form_object_definitions;

{ All form objects are sorted by form location.  Look for next object.

    FOR object_index := 1 TO p_form_status^.p_form_definition^.form_object_definitions.active_number DO
      p_form_object_definition := ^p_form_object_definitions^ [object_index];
      CASE p_form_object_definition^.key OF

      = fdc$form_variable_text, fdc$form_text_box_fragment, fdc$form_variable_text_box =
        IF ((p_form_object_definition^.y_position = y_position) AND
              (p_form_object_definition^.x_position > x_position)) THEN

{ Found the next object on the same terminal line.

          RETURN;
        IFEND;

        IF p_form_object_definition^.y_position > y_position THEN

{ Found the next object on a following terminal line.

          RETURN;
        IFEND;

      ELSE

{ Ignore objects that are not variables and objects that do not have an x, y position.

      CASEND;
    FOREND;

{ No objects follow the specified position.  Start search from the beginning of the form.

    object_index := 1;

  PROCEND fdp$find_next_object;

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

  PROCEDURE [XDCL] fdp$get_screen_events
    (VAR status: ost$status);

    VAR
      application_function: cst$application_functions,
      device_attributes: array [1 .. 1] of cst$device_attribute,
      event_trigger: fdt$event_trigger,
      event_identifier: cst$event_name_identifier,
      form_to_screen_events: [READ, STATIC] array [fdc$next .. fdc$variable_trigger] of
            fdt$screen_to_form_event := [[FALSE, csc$standard_function, csc$next],
            [FALSE, csc$standard_function, csc$help], [FALSE, csc$standard_function, csc$stop],
            [FALSE, csc$standard_function, csc$back], [FALSE, csc$standard_function, csc$up],
            [FALSE, csc$standard_function, csc$down], [FALSE, csc$standard_function, csc$forward],
            [FALSE, csc$standard_function, csc$backward], [FALSE, csc$standard_function, csc$undo],
            [TRUE, csc$standard_function, csc$sh_undo], [FALSE, csc$unused_entry] {fdc$quit} ,
            [TRUE, csc$unused_entry]
            {fdc$exit} , [TRUE, csc$unused_entry] {fdc$first} , [TRUE, csc$unused_entry] {fdc$last} ,
            [FALSE, csc$standard_function, csc$edit], [FALSE, csc$standard_function, csc$data],
            [FALSE, csc$application_function, csc$f1], [FALSE, csc$application_function, csc$f2],
            [FALSE, csc$application_function, csc$f3], [FALSE, csc$application_function, csc$f4],
            [FALSE, csc$application_function, csc$f5], [FALSE, csc$application_function, csc$f6],
            [FALSE, csc$application_function, csc$f7], [FALSE, csc$application_function, csc$f8],
            [FALSE, csc$application_function, csc$f9], [FALSE, csc$application_function, csc$f10],
            [FALSE, csc$application_function, csc$f11], [FALSE, csc$application_function, csc$f12],
            [FALSE, csc$application_function, csc$f13], [FALSE, csc$application_function, csc$f14],
            [FALSE, csc$application_function, csc$f15], [FALSE, csc$application_function, csc$f16],
            [TRUE, csc$standard_function, csc$sh_next], [TRUE, csc$standard_function, csc$sh_help],
            [TRUE, csc$standard_function, csc$sh_stop], [TRUE, csc$standard_function, csc$sh_back],
            [TRUE, csc$standard_function, csc$sh_up], [TRUE, csc$standard_function, csc$sh_down],
            [TRUE, csc$standard_function, csc$sh_forward], [TRUE, csc$standard_function, csc$sh_backward],
            [TRUE, csc$standard_function, csc$sh_edit], [TRUE, csc$standard_function, csc$sh_data],
            [TRUE, csc$application_function, csc$sf1], [TRUE, csc$application_function, csc$sf2],
            [TRUE, csc$application_function, csc$sf3], [TRUE, csc$application_function, csc$sf4],
            [TRUE, csc$application_function, csc$sf5], [TRUE, csc$application_function, csc$sf6],
            [TRUE, csc$application_function, csc$sf7], [TRUE, csc$application_function, csc$sf8],
            [TRUE, csc$application_function, csc$sf9], [TRUE, csc$application_function, csc$sf10],
            [TRUE, csc$application_function, csc$sf11], [TRUE, csc$application_function, csc$sf12],
            [TRUE, csc$application_function, csc$sf13], [TRUE, csc$application_function, csc$sf14],
            [TRUE, csc$application_function, csc$sf15], [TRUE, csc$application_function, csc$sf16],
            [FALSE, csc$unused_entry], [FALSE, csc$screen_function, csc$insert_line],
            [FALSE, csc$screen_function, csc$delete_line], [FALSE, csc$screen_function, csc$home],
            [FALSE, csc$screen_function, csc$clear], [FALSE, csc$unused_entry], [FALSE, csc$unused_entry]],
      mapped: boolean,
      menu_type: cst$key_type,
      key_label_length: 0 .. osc$max_name_size,
      terminal_status: ost$status;

    status.normal := TRUE;
    ALLOCATE fdv$screen_status.p_screen_event_statuses;
    IF fdv$screen_status.p_screen_event_statuses = NIL THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
      RETURN;
    IFEND;

    FOR event_trigger := LOWERBOUND (fdv$screen_status.p_screen_event_statuses^)
          TO UPPERBOUND (fdv$screen_status.p_screen_event_statuses^) DO
      fdv$screen_status.p_screen_event_statuses^ [event_trigger].event_exists := FALSE;
      fdv$screen_status.p_screen_event_statuses^ [event_trigger].event_used := FALSE;
    FOREND;

{ Set terminal to screen mode.

    IF NOT fdv$screen_status.screen_mode_active THEN
      csv$vector.change_capability_level^ (csc$screen_level, terminal_status);
      IF ((NOT terminal_status.normal) AND (terminal_status.condition <> cse$redundant_screen_level)) THEN
        fdp$convert_terminal_status (terminal_status, status);
        FREE fdv$screen_status.p_screen_event_statuses;
        RETURN;
      IFEND;
      fdv$screen_status.screen_mode_active := TRUE;
    IFEND;

{ Screen Formatting gets only changes made by the terminal user to text.

    csv$vector.change_changed_text_mode^ (TRUE, terminal_status);
    IF NOT terminal_status.normal THEN
      fdp$convert_terminal_status (terminal_status, status);
      FREE fdv$screen_status.p_screen_event_statuses;
      RETURN;
    IFEND;

{ Determine event triggers that are available on the terminal for latter
{ assignment to forms events.

  /get_screen_events/
    FOR event_trigger := LOWERBOUND (fdv$screen_status.p_screen_event_statuses^)
          TO UPPERBOUND (fdv$screen_status.p_screen_event_statuses^) DO

      event_identifier.event_type := csc$field_event;
      menu_type := form_to_screen_events [event_trigger].event_type;
      CASE menu_type OF

      = csc$standard_function =
        event_identifier.field_event.event_type := csc$field_standard_function;
        event_identifier.field_event.standard_function := form_to_screen_events [event_trigger].
              standard_function;

{ Get label for terminal key. The terminal user recognizes the key by seeing
{ the label on the event form.

        csv$vector.get_event_name^ (event_identifier, fdv$screen_status.p_screen_event_statuses^
             [event_trigger].event_label, key_label_length, terminal_status);
        IF NOT terminal_status.normal THEN
          fdp$convert_terminal_status (terminal_status, status);
          FREE fdv$screen_status.p_screen_event_statuses;
          RETURN;
        IFEND;

        fdv$screen_status.p_screen_event_statuses^ [event_trigger].event_trigger := event_trigger;
        IF key_label_length = 0 THEN
          fdv$screen_status.p_screen_event_statuses^ [event_trigger].event_label := osc$null_name;
          CYCLE /get_screen_events/;
        IFEND;

        fdv$screen_status.p_screen_event_statuses^ [event_trigger].event_exists := TRUE;

{ A standard function key may be mapped to an application function key if the
{ standard function
{ key does not exist on the terminal.  If the standard key is mapped to an
{ application function key,
{ the application function key will not be available for assignment.

        csv$vector.get_event_mapping^ (event_identifier.field_event.standard_function,
              application_function, mapped, terminal_status);
        IF NOT terminal_status.normal THEN
          fdp$convert_terminal_status (terminal_status, status);
          FREE fdv$screen_status.p_screen_event_statuses;
          RETURN;
        IFEND;
        IF mapped THEN
          fdv$screen_status.p_screen_event_statuses^ [event_trigger].event_trigger :=
                fdv$application_event_table [application_function];
        IFEND;

      = csc$application_function =

        event_identifier.field_event.event_type := csc$field_application_function;
        event_identifier.field_event.application_function :=
              form_to_screen_events [event_trigger].application_function;
        csv$vector.get_event_name^ (event_identifier, fdv$screen_status.p_screen_event_statuses^
             [event_trigger].event_label, key_label_length, terminal_status);
        IF NOT terminal_status.normal THEN
          fdp$convert_terminal_status (terminal_status, status);
          FREE fdv$screen_status.p_screen_event_statuses;
          RETURN;
        IFEND;

        fdv$screen_status.p_screen_event_statuses^ [event_trigger].event_exists := (key_label_length <> 0);
        fdv$screen_status.p_screen_event_statuses^ [event_trigger].event_trigger := event_trigger;
        IF key_label_length = 0 THEN
          fdv$screen_status.p_screen_event_statuses^ [event_trigger].event_label := osc$null_name;
        IFEND;

      = csc$screen_function =
        event_identifier.field_event.event_type := csc$field_screen;
        event_identifier.field_event.screen_event := form_to_screen_events [event_trigger].screen_function;
        csv$vector.get_event_name^ (event_identifier, fdv$screen_status.p_screen_event_statuses^
             [event_trigger].event_label, key_label_length, terminal_status);
        IF NOT terminal_status.normal THEN
          fdp$convert_terminal_status (terminal_status, status);
          FREE fdv$screen_status.p_screen_event_statuses;
          RETURN;
        IFEND;
        fdv$screen_status.p_screen_event_statuses^ [event_trigger].event_exists := (key_label_length <> 0);
        fdv$screen_status.p_screen_event_statuses^ [event_trigger].event_trigger := event_trigger;
        IF key_label_length = 0 THEN
          fdv$screen_status.p_screen_event_statuses^ [event_trigger].event_label := osc$null_name;
        IFEND;
      ELSE { Ignore any other menu types. }
      CASEND;
    FOREND /get_screen_events/;

{ Get screen sizes in order to determine if a form will fit on screen.

    device_attributes [1].key := csc$da_screen_dimensions;
    csv$vector.get_device_attributes^ (device_attributes, terminal_status);
    IF NOT terminal_status.normal THEN
      fdp$convert_terminal_status (terminal_status, status);
      FREE fdv$screen_status.p_screen_event_statuses;
      RETURN;
    IFEND;
    fdv$screen_status.screen_dimensions := device_attributes [1].screen_dimensions;

  PROCEND fdp$get_screen_events;

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

  PROCEDURE [XDCL] fdp$get_screen_input
    (VAR event_name: ost$name;
     VAR event_normal: boolean;
     VAR event_position: fdt$event_position;
     VAR status: ost$status);

    VAR
      active_number_objects: fdt$number_objects,
      bad_key_displayed: boolean,
      character_position: cst$character_position,
      current_form_identifier: fdt$current_form_identifier,
      event_action: fdt$event_action,
      event_defined: boolean,
      event_highlighted: boolean,
      event_on_message_form: boolean,
      event_recognized: boolean,
      event_trigger: fdt$event_trigger,
      field_number: cst$field_number,
      first_stored_occurrence: integer,
      flush_events: boolean,
      form_identifier: fdt$next_form_identifier,
      form_object: boolean,
      highlight_event_change: fdt$screen_change,
      line_number: cst$line_number,
      local_status: ost$status,
      next_object_index: fdt$object_index,
      message_form_added: boolean,
      message_text: fdt$message_text,
      object_exists: boolean,
      object_index: fdt$object_index,
      occurrence_shift: integer,
      output_character_position: cst$character_position,
      output_line_position: cst$line_number,
      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_object_statuses:  ^array [1 .. * ] of fdt$form_object_status,
      p_form_table_definition: ^fdt$form_table_definition,
      p_form_table_status: ^fdt$form_status,
      p_form_status: ^fdt$form_status,
      p_form_variable_definition: ^fdt$form_variable_definition,
      p_parent_object_definition: ^fdt$form_object_definition,
      p_record_form_status: ^fdt$form_status,
      p_text: ^fdt$text,
      parent_object_index: fdt$object_index,
      position: integer,
      reset_event_change: fdt$screen_change,
      screen_record_position: fdt$record_position,
      screen_visible_length: fdt$screen_variable_length,
      shift: integer,
      table_index: fdt$table_index,
      target_position: fdt$target_position,
      terminal_status: ost$status,
      text_length: fdt$text_length,
      variable_index: fdt$variable_index;

?? NEWTITLE := 'compute_event_highlight', EJECT ??

{ PURPOSE:
{   This procedure computes the highlight for the event executed by the terminal user.
{   Two screen changes are computed. One has the attributes to highlight the event.
{   The other screen change is the attributes to reset the event to initial attributes.

  PROCEDURE compute_event_highlight;

    VAR
      added_form_identifier: fdt$form_identifier,
      display_name: ost$name,
      name_exists: boolean,
      object_occurrence_exists: boolean,
      p_display_definition: ^fdt$display_definition,
      p_event_form_status: ^fdt$form_status,
      p_event_form_object_definition: ^fdt$form_object_definition;


    event_highlighted := FALSE;
    IF NOT event_defined THEN
      RETURN;
    IFEND;

    IF p_form_status^.combined  THEN
      added_form_identifier := p_form_status^.added_form_identifier;
    ELSE
      added_form_identifier := form_identifier;
    IFEND;

    IF NOT fdv$screen_status.p_forms_status^ [added_form_identifier].event_form_defined THEN
      RETURN;
    IFEND;

{ If the application has defined an event form, the object for the event may not exist
{ or the display name for the attribute may not exist.  If the event form does not use
{ the standard conventions, do not highlight the  event pressed by the terminal user.

    highlight_event_change.attribute_form_identifier := fdv$screen_status.p_forms_status^
          [added_form_identifier].event_form_identifier;
    p_event_form_status := ^fdv$screen_status.p_forms_status^ [highlight_event_change.
          attribute_form_identifier];
    highlight_event_change.key := fdc$set_attribute;
    fdp$find_object_definition (event_name, 1, p_event_form_status^.p_form_object_definitions,
          p_event_form_status^.p_form_definition^.form_object_definitions.active_number,
          p_event_form_object_definition, highlight_event_change.attribute_object_index, name_exists,
          object_occurrence_exists);
    IF (NOT name_exists) OR (NOT object_occurrence_exists) THEN
      RETURN;
    IFEND;

    display_name := fdc$system_display_name;
    fdp$find_display_name (display_name, p_event_form_status^.p_display_definitions,
          p_event_form_status^.p_form_definition^.display_definitions.active_number,
          p_display_definition, name_exists);
    IF NOT name_exists THEN
      RETURN;
    IFEND;


    highlight_event_change.attribute := p_display_definition^.attribute;
    reset_event_change := highlight_event_change;
    reset_event_change.key :=fdc$reset_event_variable;
    reset_event_change.attribute := p_event_form_object_definition^.display_attribute;
    event_highlighted := TRUE;

  PROCEND compute_event_highlight;

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

{ PURPOSE:
{   This procedure maps Screen Manager field identifier to Screen Formatting
{   form identifier and object index. It determines whether the event occurred on
{   a form area containing no object or on an object.

  PROCEDURE find_screen_identifier;

    VAR
      p_form_object_status: ^fdt$form_object_status;

    form_identifier := fdv$screen_status.current_form_identifier;
    form_object := FALSE;
    object_exists := FALSE;

    WHILE form_identifier <> 0 DO
      p_form_status := ^fdv$screen_status.p_forms_status^ [form_identifier];
      IF p_form_status^.displayed_on_screen THEN
        p_form_object_statuses := p_form_status^.p_form_object_statuses;
        IF p_form_status^.field_number = field_number THEN

{ The object is the form itself.

          form_object := TRUE;
          RETURN;
        IFEND;

        IF p_form_object_statuses <> NIL THEN
          FOR object_index := LOWERBOUND (p_form_object_statuses^) TO UPPERBOUND (p_form_object_statuses^) DO
            p_form_object_status := ^p_form_object_statuses^ [object_index];
            CASE p_form_object_status^.key OF

            = fdc$field_identifier =
              IF p_form_object_status^.field_number = field_number THEN
                object_exists := TRUE;
                RETURN;
              IFEND;

            ELSE
            CASEND;
          FOREND;
        IFEND;
      IFEND;
      form_identifier := p_form_status^.next_lower_form;
    WHILEND;
  PROCEND find_screen_identifier;

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

{ PURPOSE:
{   This procedure finds the table to page/scroll. When only one table exists on
{   a form, the cursor does not need to be positioned on the table.

  PROCEDURE find_table_to_page;

    VAR
      added_form_identifier: fdt$form_identifier,
      current_form_identifier: fdt$current_form_identifier,
      p_current_form_status: ^fdt$form_status;


{ Find the added (base) form.

    IF p_form_status^.combined THEN
      added_form_identifier := p_form_status^.added_form_identifier;
    ELSE
      added_form_identifier := form_identifier;
    IFEND;

{ Only one table must exist for added form and all forms combined with added form.
{ If no tables exist or more than one table exists the event must be ignored.

     p_current_form_status := ^fdv$screen_status.p_forms_status^ [added_form_identifier];
     IF (p_current_form_status^.p_form_definition^.form_table_definitions.active_number > 1) THEN
       event_defined := FALSE;
       RETURN;
     IFEND;

     p_form_table_definition := NIL;
     IF (p_current_form_status^.p_form_definition^.form_table_definitions.active_number = 1) THEN
       p_form_table_definition := ^p_current_form_status^.p_form_table_definitions^ [1];
       p_form_table_status := p_current_form_status;
     IFEND;

{ Examine forms combined with added form.

    current_form_identifier := fdv$screen_status.current_form_identifier;
    WHILE current_form_identifier <> 0 DO
      p_current_form_status := ^fdv$screen_status.p_forms_status^ [current_form_identifier];
      IF p_current_form_status^.entry_used THEN
        IF p_current_form_status^.combined AND
             (p_current_form_status^.added_form_identifier = added_form_identifier) THEN
          IF (p_current_form_status^.p_form_definition^.form_table_definitions.active_number > 1) THEN
            event_defined := FALSE;
            RETURN;
          IFEND;

          IF (p_current_form_status^.p_form_definition^.form_table_definitions.active_number = 1) THEN
            IF (p_form_table_definition = NIL) THEN
              p_form_table_definition := ^p_current_form_status^.p_form_table_definitions^ [1];
              p_form_table_status := p_current_form_status;
            ELSE
              event_defined := FALSE;
              RETURN;
            IFEND;
          IFEND;
        IFEND;
      IFEND;
      current_form_identifier := p_current_form_status^.next_lower_form;
    WHILEND;

    event_defined :=  p_form_table_definition <> NIL;

  PROCEND find_table_to_page;

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

{ PURPOSE:
{   This procedure moves data changed by the terminal user to Screen Formatting storage.

  PROCEDURE get_screen_variables;


    VAR
      end_of_changes: boolean,
      hidden_editing: boolean,
      visible_screen_length: fdt$screen_variable_length;

?? NEWTITLE := 'get_terminal-data', EJECT ??

    PROCEDURE get_terminal_data;


      VAR
        data_string_length: cst$data_string_length,
        end_of_line: boolean,
        end_of_text: boolean,
        first_displayed_occurrence: fdt$occurrence,
        object_name_exists: boolean,
        object_occurrence_exists: boolean,
        p_data_string: ^cst$data_string,
        p_status_object_definition: ^fdt$form_object_definition,
        p_table_objects: ^array [1 .. * ] of fdt$table_object,
        p_table_variable: ^fdt$table_variable,
        p_table_variables: ^array [1 .. * ] of fdt$table_variable,
        status_object_index: fdt$object_index,
        text_length: fdt$text_length,
        variable_name: ost$name,
        visible_record_position: fdt$record_position;

?? NEWTITLE := 'update_data', EJECT ??

      PROCEDURE update_data;

        VAR
          data_index: fdt$text_length,
          data_length: fdt$text_length,
          data_length_change: integer,
          formatted_data_length: fdt$text_length,
          fragment_object_index: fdt$object_index,
          local_status: ost$status,
          move_length: integer,
          p_data: ^fdt$text,
          p_save_data: ^fdt$text,
          p_user_data: ^cst$data_string,
          record_position: fdt$record_position,
          save_move_length: fdt$record_position,
          screen_change: fdt$screen_change,
          user_data_length: cst$data_string_length,
          visible_length: fdt$text_length;

?? NEWTITLE := 'update_text_pointers', EJECT ??

{ PURPOSE:
{   This procedure updates the pointers that describe how the data for an object is formatted.
{   For each object, the pointers specifies the first character of text mapped into the
{   object and the number of characters. If a terminal user deletes or inserts characters, the
{   character position for each subsequent object needs adjustment by the data length change
{   induced by the deletes and inserts.

        PROCEDURE update_text_pointers;

          VAR
            last_position: fdt$text_length;

          IF (p_form_object_definition^.key = fdc$form_variable_text_box) THEN
            fragment_object_index := p_form_object_definitions^ [object_index].variable_box_fragment_index;
          ELSE { fdc$form_text_box_fragment }
            fragment_object_index := p_form_object_definitions^ [object_index].next_fragment_object_index;
          IFEND;

          p_form_object_statuses^ [object_index].data_length := formatted_data_length;
          last_position := p_form_object_statuses^ [object_index].character_position +
                p_form_object_statuses^ [object_index].data_length;
          WHILE fragment_object_index <> 0 DO
            IF ((p_form_object_statuses^ [fragment_object_index].character_position + data_length_change) <=
                  p_form_variable_definition^.screen_variable_length) THEN
              p_form_object_statuses^ [fragment_object_index].character_position := last_position;
            ELSE
              p_form_object_statuses^ [fragment_object_index].character_position :=
                    p_form_variable_definition^.screen_variable_length;
            IFEND;

{ Change data length if data length exceeds length of variable.

            IF (p_form_object_statuses^ [fragment_object_index].character_position - 1 +
                  p_form_object_statuses^ [fragment_object_index].data_length >
                  p_form_variable_definition^.screen_variable_length) THEN
              p_form_object_statuses^ [fragment_object_index].data_length :=
                    p_form_variable_definition^.screen_variable_length -
                    p_form_object_statuses^ [fragment_object_index].character_position + 1;
            IFEND;

            last_position := p_form_object_statuses^ [fragment_object_index].character_position +
                  p_form_object_statuses^ [fragment_object_index].data_length;
            fragment_object_index := p_form_object_definitions^ [fragment_object_index].
                  next_fragment_object_index;
          WHILEND;

{ Delete all previous scheduled screen changes due to insertion or deletions of characters in
{ variable text box.

          delete_format_screen_change (form_identifier, parent_object_index);

{ Schedule a form update to show the terminal user how the data was affected by
{ the deletion or insertion of characters. For example, the deletion of a character may
{ mean previously hidden data becomes visible.

          screen_change.key := fdc$format_text_box;
          screen_change.format_text_form_identifier := form_identifier;
          screen_change.format_text_object_index := parent_object_index;
          fdp$ptr_screen_variable (p_form_status^.p_screen_record,
                p_form_variable_definition^.screen_record_position,
                p_form_variable_definition^.screen_variable_length, screen_change.p_format_text);
          fdp$record_screen_change (screen_change, local_status);

        PROCEND update_text_pointers;

?? OLDTITLE, EJECT ??

        CASE p_form_object_definition^.key OF

        = fdc$form_variable_text =

{ If hidden editing is in effect, the Screen Manager field length equals the screen variable
{ length (program data length). Otherwise, the Screen Manager field length equals the object
{ width.

          IF hidden_editing THEN
            PUSH p_user_data: [p_form_variable_definition^.screen_variable_length];
          ELSE
            PUSH p_user_data: [visible_screen_length];
          IFEND;
          csv$vector.get_text^ (p_user_data^, user_data_length, end_of_line, end_of_text, terminal_status);
          IF NOT terminal_status.normal THEN
            fdp$convert_terminal_status (terminal_status, status);
            RETURN;
          IFEND;

          IF hidden_editing THEN
            text_length := p_form_variable_definition^.screen_variable_length -
                  p_form_object_statuses^ [object_index].character_position + 1;
          ELSE
            text_length := visible_screen_length;
          IFEND;
          fdp$ptr_screen_variable (p_form_status^.p_screen_record, visible_record_position, text_length,
                p_data);
          p_data^ (1, text_length) := p_user_data^ (1, user_data_length);

        = fdc$form_variable_text_box, fdc$form_text_box_fragment =

{ If hidden editing is in effect, the Screen Manager field length equals the twice the
{ visible width of the object.  Otherwise the Screen Manager field length equals
{ the visible width of the object.

          IF hidden_editing THEN
            PUSH p_user_data: [p_parent_object_definition^.variable_box_width *
                  fdc$hidden_editing_multiplier];
          ELSE
            PUSH p_user_data: [visible_screen_length];
          IFEND;

          csv$vector.get_text^ (p_user_data^, user_data_length, end_of_line, end_of_text, terminal_status);
          IF NOT terminal_status.normal THEN
            fdp$convert_terminal_status (terminal_status, status);
            RETURN;
          IFEND;

          text_length := p_form_variable_definition^.screen_variable_length -
                p_form_object_statuses^ [object_index].character_position + 1;
          fdp$ptr_screen_variable (p_form_status^.p_screen_record, visible_record_position, text_length,
                p_data);

{ Compute the change in length.  Deleted characters cause a negative change in length.
{ Inserted characters cause a positive change in length.

          data_length := p_form_object_statuses^ [object_index].data_length;
          record_position := p_form_object_statuses^ [object_index].character_position;
          IF p_parent_object_definition^.variable_box_processing = fdc$wrap_words THEN

{ Trailing blanks for word wrap should be removed before computing the change in length.
{ The formatting procedure previously computed the data length of a line of text for the object
{ by using one trailing blank.

          /find_end_of_data/
            FOR data_index := user_data_length DOWNTO 1 DO
              IF p_user_data^ (data_index, 1) <> ' ' THEN
                EXIT /find_end_of_data/;
              IFEND;
            FOREND /find_end_of_data/;

            IF user_data_length = 0 THEN

{ The terminal user did a clear to end of line.

              formatted_data_length := 0;
            ELSEIF data_index = user_data_length THEN

{ The line was completely full.  The formatting procedure could not end the line with a blank.

              formatted_data_length := user_data_length;
            ELSE

{ Account for the trailing blank specified by the formatting procedure.

              formatted_data_length := data_index + 1;
            IFEND;
          ELSE { fdc$character_wrap
            IF hidden_editing THEN
              formatted_data_length := user_data_length;
            ELSE
              formatted_data_length := visible_screen_length;
              p_user_data^ (user_data_length + 1, * ) := ' ';
            IFEND;
          IFEND;

          data_length_change := formatted_data_length - data_length;
          IF (data_length_change = 0) THEN

{ The terminal user did not change the data length.  Simply replace the data.

            p_data^ (1, formatted_data_length) := p_user_data^ (1, formatted_data_length);

          ELSE

{ The terminal user deleted or inserted some data.  Replace the data for the changed object.

            IF ((record_position - 1 + formatted_data_length) >
                  p_form_variable_definition^.screen_variable_length) THEN

{ The terminal user data goes over the end of the end of the record.

              move_length := p_form_variable_definition^.screen_variable_length - record_position + 1;
              p_data^ (1, move_length) := p_user_data^ (1, move_length);
              formatted_data_length := move_length;
              update_text_pointers;
              RETURN;
            IFEND;

{ If the change lies in the middle of the record, save the data beyond the change.

            save_move_length := p_form_variable_definition^.screen_variable_length -
                  (record_position - 1 + data_length);
            IF save_move_length >= 0 THEN

              PUSH p_save_data: [save_move_length];
              p_save_data^ := p_data^ (data_length + 1, save_move_length);

{ Shift the screen formatting data right for a delete of a character(s).  Shift the screen formatting
{ data to the left for an insert of a character(s).

              move_length := p_form_variable_definition^.screen_variable_length -
                    (record_position - 1 + formatted_data_length);
              IF move_length >= 0 THEN
                p_data^ (formatted_data_length + 1, move_length) := p_save_data^;
              IFEND;
            IFEND;

{ Move the terminal user data into the space created by the above shift.

            p_data^ (1, formatted_data_length) := p_user_data^ (1, formatted_data_length);

{ Update the pointers describing the first character and number of characters mapped into the object.

            update_text_pointers;
          IFEND;
        CASEND;

      PROCEND update_data;

?? OLDTITLE, EJECT ??

      IF p_form_variable_definition^.table_exists THEN
        table_index := p_form_variable_definition^.table_index;
        p_form_table_definition := ^p_form_status^.p_form_table_definitions^ [table_index];
        first_displayed_occurrence := p_form_status^.p_form_table_statuses^ [table_index].
              first_displayed_occurrence;
        variable_name := p_form_variable_definition^.name;
        p_table_variables := fdp$ptr_table_variables (p_form_table_definition^.table_variables,
              p_form_status^.p_form_module);

      /find_variable/
        FOR variable_index := 1 TO p_form_table_definition^.table_variables.active_number DO
          p_table_variable := ^p_table_variables^ [variable_index];
          IF p_table_variable^.name = variable_name THEN
            p_table_objects := fdp$ptr_table_objects (p_table_variable^.table_objects,
                  p_form_status^.p_form_module);
            IF first_displayed_occurrence = 1 THEN
              visible_record_position := p_table_objects^ [p_parent_object_definition^.occurrence].
                    screen_record_position + p_form_object_statuses^ [object_index].character_position - 1;
              p_form_object_statuses^ [parent_object_index].changed_by_read_forms_index :=
                    fdv$screen_status.read_forms_index;
              p_form_object_statuses^ [parent_object_index].user_changed_field := TRUE;
              p_form_object_statuses^ [parent_object_index].user_entered_field := TRUE;

            ELSE

{ The table was scrolled. Another occurrence occupies the visible occurrence.

              fdp$find_object_definition (variable_name, p_parent_object_definition^.occurrence +
                    first_displayed_occurrence - 1, p_form_status^.p_form_object_definitions,
                    p_form_status^.p_form_definition^.form_object_definitions.active_number,
                    p_status_object_definition, status_object_index, object_name_exists,
                    object_occurrence_exists);
              IF object_name_exists AND object_occurrence_exists THEN
                visible_record_position := p_table_objects^ [p_parent_object_definition^.occurrence +
                      first_displayed_occurrence - 1].screen_record_position +
                      p_form_object_statuses^ [status_object_index].character_position - 1;
                p_form_object_statuses^ [status_object_index].changed_by_read_forms_index :=
                      fdv$screen_status.read_forms_index;
                p_form_object_statuses^ [status_object_index].user_changed_field := TRUE;
                p_form_object_statuses^ [status_object_index].user_entered_field := TRUE;
                object_index := status_object_index;
              ELSE
                osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error, 'get terminal data',
                      status);
                RETURN;
              IFEND;
            IFEND;
          IFEND;

        FOREND /find_variable/;

      ELSE

{ Variable is not member of a table.

        visible_record_position := p_form_variable_definition^.screen_record_position +
              p_form_object_statuses^ [object_index].character_position - 1;
        p_form_object_statuses^ [parent_object_index].changed_by_read_forms_index :=
              fdv$screen_status.read_forms_index;
        p_form_object_statuses^ [parent_object_index].user_changed_field := TRUE;
        p_form_object_statuses^ [parent_object_index].user_entered_field := TRUE;
      IFEND;

      update_data;

    PROCEND get_terminal_data;

?? OLDTITLE, EJECT ??

    REPEAT

    /get_terminal_user_changes/
      BEGIN

{ Screen Formatting uses the Screen Manager change text mode.  That is,
{ the Screen Formatting gets only changes made by the terminal user to the
{ screen.

        csv$vector.get_io_position^ (field_number, line_number, end_of_changes, terminal_status);
        IF NOT terminal_status.normal THEN
          fdp$convert_terminal_status (terminal_status, status);
          RETURN;
        IFEND;

        IF end_of_changes THEN
          RETURN;
        IFEND;

{ Translate Screen Manager field number to Screen Formatting form and form object.

        find_screen_identifier;
        IF NOT object_exists THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error, 'field number not found',
                status);
          RETURN;
        IFEND;

        p_form_object_definitions := p_form_status^.p_form_object_definitions;
        p_form_object_definition := ^p_form_object_definitions^ [object_index];
        p_form_object_statuses := p_form_status^.p_form_object_statuses;
        hidden_editing := p_form_status^.p_form_definition^.hidden_editing;

        CASE p_form_object_definition^.key OF

        = fdc$form_variable_text =
          p_form_variable_definition := ^p_form_status^.p_form_variable_definitions^
                [p_form_object_definition^.text_variable_index];
          visible_screen_length := p_form_object_definition^.text_variable_width;
          p_parent_object_definition := p_form_object_definition;
          parent_object_index := object_index;
          get_terminal_data;
          IF NOT status.normal THEN
            RETURN;
          IFEND;

        = fdc$form_variable_text_box =
          p_form_variable_definition := ^p_form_status^.p_form_variable_definitions^
                [p_form_object_definition^.variable_box_variable_index];
          visible_screen_length := p_form_object_definition^.variable_box_width;
          p_parent_object_definition := p_form_object_definition;
          parent_object_index := object_index;
          get_terminal_data;
          IF NOT status.normal THEN
            RETURN;
          IFEND;

        ELSE {fdc$form_text_box_fragment}

          parent_object_index := p_form_object_definition^.parent_text_box_object_index;
          p_parent_object_definition := ^p_form_object_definitions^ [parent_object_index];
          visible_screen_length := p_parent_object_definition^.variable_box_width;
          p_form_variable_definition := ^p_form_status^.p_form_variable_definitions^ [
                p_parent_object_definition^.variable_box_variable_index];
          get_terminal_data;
          IF NOT status.normal THEN
            RETURN;
          IFEND;

        CASEND;

      END /get_terminal_user_changes/;
    UNTIL end_of_changes;

  PROCEND get_screen_variables;


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

{ PURPOSE:
{   This procedure highlights the event executed by the terminal user.
{   The object on the form menu is immediately highlighted.  The reset of
{   of the object attribute is scheduled for the next screen update.

  PROCEDURE highlight_event;

    compute_event_highlight;
    IF NOT event_highlighted  THEN
      RETURN;
    IFEND;

    fdp$record_screen_change (highlight_event_change, local_status);
    fdp$change_screen (local_status);

{ Update the screen immediately so that the terminal user sees the highlighted function key
{ while the application program is processing the event.

    csv$vector.update_device^ (local_status);

{ Schedule the reset of the object attribute for the next screen update.  This usually occurs
{ on the next read or show forms call.

    fdp$record_screen_change (reset_event_change, local_status);

  PROCEND highlight_event;

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

{ PURPOSE:
{   This procedure processes events that occurred on no object within a form.

    PROCEDURE process_screen_form_event;

      event_position.form_identifier := form_identifier;
      event_position.form_x_position := fdv$screen_status.event_identifier.
            field_event_character_position;
      event_position.form_y_position := fdv$screen_status.event_identifier.
            field_event_line_number;
      event_position.screen_x_position := p_form_status^.form_x_position +
            event_position.form_x_position - 1;
      event_position.screen_y_position := p_form_status^.form_y_position +
            event_position.form_y_position - 1;
      event_position.key := fdc$form_event;

      fdv$screen_status.last_cursor_position_valid := TRUE;
      fdv$screen_status.last_cursor_form_identifier := form_identifier;

      p_form_status^.last_cursor_position_valid := TRUE;
      p_form_status^.last_cursor_form_x_position :=
            event_position.form_x_position;
      p_form_status^.last_cursor_form_y_position :=
            event_position.form_y_position;
      p_form_object_definitions := p_form_status^.p_form_object_definitions;
      p_form_definition := p_form_status^.p_form_definition;
      translate_screen_event;
      IF NOT event_defined THEN
        RETURN;
      IFEND;

      CASE event_action OF

      = fdc$return_program_normal, fdc$return_program_abnormal,
            fdc$ignore_event =

{ The above events will be processed later.

      = fdc$display_help =
        display_form_help (p_form_status, status);

      = fdc$erase_help =
        erase_message_form (status);

      = fdc$page_table_backward =
        find_table_to_page;
        IF event_defined THEN
          occurrence_shift := -p_form_table_definition^.visible_occurrence;
          page_table (p_form_table_status, p_form_table_definition, 1,
                occurrence_shift, p_form_status^.field_number,
                event_position.form_x_position, event_position.form_y_position,
                status);
        IFEND;

      = fdc$page_table_forward =
        find_table_to_page;
        IF event_defined THEN
          occurrence_shift := p_form_table_definition^.visible_occurrence;
          page_table (p_form_table_status, p_form_table_definition, 1,
                occurrence_shift, p_form_status^.field_number,
                event_position.form_x_position, event_position.form_y_position,
                status);
        IFEND;

      = fdc$page_table_first =
        find_table_to_page;
        IF event_defined THEN

{ Specify maximum shift.  Shift_table will compute actual shift need.

          occurrence_shift := -p_form_table_definition^.stored_occurrence;
          page_table (p_form_table_status, p_form_table_definition, 1,
                occurrence_shift, p_form_status^.field_number,
                event_position.form_x_position, event_position.form_y_position,
                status);
        IFEND;

      = fdc$page_table_last =
        find_table_to_page;
        IF event_defined THEN

{ Specify maximum shift.  Shift_table will compute actual shifted needed.

          occurrence_shift := p_form_table_definition^.stored_occurrence;
          page_table (p_form_table_status, p_form_table_definition, 1,
                occurrence_shift, p_form_status^.field_number,
                event_position.form_x_position, event_position.form_y_position,
                status);
        IFEND;

      = fdc$tab_to_next_form_field =
        IF p_form_status^.p_form_definition^.form_object_definitions.
              active_number > 0 THEN
          fdp$find_next_object (fdv$screen_status.event_position.
                form_x_position, fdv$screen_status.event_position.
                form_y_position, p_form_status, object_index);
          fdp$tab_to_next_variable (p_form_status, object_index, status);
        IFEND;

      = fdc$tab_to_previous_form_field =
        IF p_form_status^.p_form_definition^.form_object_definitions.
              active_number > 0 THEN
          find_previous_object (fdv$screen_status.event_position.
                form_x_position, fdv$screen_status.event_position.
                form_y_position, p_form_status, object_index);
          tab_to_previous_variable (p_form_status, object_index, status);
        IFEND;

      ELSE
        event_defined := FALSE;
      CASEND;

    PROCEND process_screen_form_event;

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

{ PURPOSE:
{   This procedure processes events that occurred on an object within a form.
{   Determine object and its location. Perform specified action on object.

  PROCEDURE process_screen_object_event;

  VAR
    p_save_data: ^fdt$text,
    start_move_position: fdt$text_length;

    p_form_object_definitions := p_form_status^.p_form_object_definitions;
    p_form_object_definition := ^p_form_object_definitions^ [object_index];
    fdv$screen_status.last_cursor_position_valid := TRUE;
    fdv$screen_status.last_cursor_form_identifier := form_identifier;
    p_form_status^.last_cursor_position_valid := TRUE;
    p_form_status^.last_cursor_form_x_position :=
          p_form_object_definition^.x_position +
          fdv$screen_status.event_identifier.field_event_character_position -
          1;
    p_form_status^.last_cursor_form_y_position :=
          p_form_object_definition^.y_position +
          fdv$screen_status.event_identifier.field_event_line_number - 1;

    event_position.form_identifier := form_identifier;
    event_position.key := fdc$object_event;
    event_position.form_identifier := form_identifier;
    event_position.object_name := p_form_object_definition^.name;
    event_position.object_occurrence := p_form_object_definition^.occurrence;
    event_position.screen_x_position := p_form_status^.form_x_position +
          p_form_object_definition^.x_position - 1 +
          fdv$screen_status.event_identifier.field_event_character_position -
          1;
    event_position.screen_y_position := p_form_status^.form_y_position +
          p_form_object_definition^.y_position - 1 +
          fdv$screen_status.event_identifier.field_event_line_number - 1;
    event_position.form_x_position := p_form_object_definition^.x_position +
          fdv$screen_status.event_identifier.field_event_character_position -
          1;
    event_position.form_y_position := p_form_object_definition^.y_position +
          fdv$screen_status.event_identifier.field_event_line_number - 1;
    event_position.object_x_position := p_form_object_definition^.x_position;
    event_position.object_y_position := p_form_object_definition^.y_position;
    translate_screen_event;
    IF NOT event_defined THEN
      RETURN;
    IFEND;

    position := fdv$screen_status.event_identifier.
          field_event_character_position;

    CASE p_form_object_definition^.key OF

    = fdc$form_box =
      event_position.object_definition_key := fdc$box;
      CASE event_action OF

      = fdc$return_program_normal, fdc$return_program_abnormal,
            fdc$ignore_event =

      = fdc$display_help =
        display_form_help (p_form_status, status);

      = fdc$erase_help =
        erase_message_form (status);

      = fdc$page_table_backward =
        find_table_to_page;
        IF event_defined THEN
          occurrence_shift := -p_form_table_definition^.visible_occurrence;
          page_table (p_form_table_status, p_form_table_definition, 1,
                occurrence_shift, p_form_status^.field_number,
                event_position.form_x_position, event_position.form_y_position,
                status);
        IFEND;

      = fdc$page_table_forward =
        find_table_to_page;
        IF event_defined THEN
          occurrence_shift := p_form_table_definition^.visible_occurrence;
          page_table (p_form_table_status, p_form_table_definition, 1,
                occurrence_shift, p_form_status^.field_number,
                event_position.form_x_position, event_position.form_y_position,
                status);
        IFEND;

      = fdc$page_table_first =
        find_table_to_page;
        IF event_defined THEN

{ Specify maximum shift.  Shift_table will compute actual shift need.

          occurrence_shift := -p_form_table_definition^.stored_occurrence;
          page_table (p_form_table_status, p_form_table_definition, 1,
                occurrence_shift, p_form_status^.field_number,
                event_position.form_x_position, event_position.form_y_position,
                status);
        IFEND;

      = fdc$page_table_last =
        find_table_to_page;
        IF event_defined THEN

{ Specify maximum shift.  Shift_table will compute actual shifted needed.

          occurrence_shift := p_form_table_definition^.stored_occurrence;
          page_table (p_form_table_status, p_form_table_definition, 1,
                occurrence_shift, p_form_status^.field_number,
                event_position.form_x_position, event_position.form_y_position,
                status);
        IFEND;

      ELSE
        event_defined := FALSE;
      CASEND;

    = fdc$form_line =
      event_position.object_definition_key := fdc$line;
      CASE event_action OF

      = fdc$return_program_normal, fdc$return_program_abnormal,
            fdc$ignore_event =

      = fdc$display_help =
        display_form_help (p_form_status, status);

      = fdc$erase_help =
        erase_message_form (status);

      ELSE
        event_defined := FALSE;
      CASEND;

    = fdc$form_constant_text =
      event_position.object_definition_key := fdc$constant_text;
      screen_visible_length := p_form_object_definition^.constant_text_width;
      p_text := fdp$ptr_text (p_form_object_definition^.constant_text,
            p_form_status^.p_form_module);
      CASE event_action OF

      = fdc$return_program_normal, fdc$return_program_abnormal,
            fdc$ignore_event =

      = fdc$display_help =
        display_form_help (p_form_status, status);

      = fdc$erase_help =
        erase_message_form (status);

      = fdc$page_variable_backward =
        target_position.key := fdc$page_data_backward;
        shift_text_line (target_position, p_text, object_index, screen_visible_length,
              p_form_status, fdv$screen_status.event_identifier.
              field_event_character_position, status);

      = fdc$page_variable_first =
        target_position.key := fdc$page_data_first;
        shift_text_line (target_position, p_text, object_index, screen_visible_length,
              p_form_status, fdv$screen_status.event_identifier.
              field_event_character_position, status);

      = fdc$page_variable_forward =
        target_position.key := fdc$page_data_forward;
        shift_text_line (target_position, p_text, object_index, screen_visible_length,
              p_form_status, fdv$screen_status.event_identifier.
              field_event_character_position, status);

      = fdc$page_variable_last =
        target_position.key := fdc$page_data_last;
        shift_text_line (target_position, p_text, object_index, screen_visible_length,
              p_form_status, fdv$screen_status.event_identifier.
              field_event_character_position, status);

      = fdc$page_table_backward =
        find_table_to_page;
        IF event_defined THEN
          occurrence_shift := -p_form_table_definition^.visible_occurrence;
          page_table (p_form_table_status, p_form_table_definition, 1,
                occurrence_shift, p_form_status^.field_number,
                event_position.form_x_position, event_position.form_y_position,
                status);
        IFEND;

      = fdc$page_table_forward =
        find_table_to_page;
        IF event_defined THEN
          occurrence_shift := p_form_table_definition^.visible_occurrence;
          page_table (p_form_table_status, p_form_table_definition, 1,
                occurrence_shift, p_form_status^.field_number,
                event_position.form_x_position, event_position.form_y_position,
                status);
        IFEND;

      = fdc$page_table_first =
        find_table_to_page;
        IF event_defined THEN

{ Specify maximum shift.  Shift_table will compute actual shift need.

          occurrence_shift := -p_form_table_definition^.stored_occurrence;
          page_table (p_form_table_status, p_form_table_definition, 1,
                occurrence_shift, p_form_status^.field_number,
                event_position.form_x_position, event_position.form_y_position,
                status);
        IFEND;

      = fdc$page_table_last =
        find_table_to_page;
        IF event_defined THEN

{ Specify maximum shift.  Shift_table will compute actual shifted needed.

          occurrence_shift := p_form_table_definition^.stored_occurrence;
          page_table (p_form_table_status, p_form_table_definition, 1,
                occurrence_shift, p_form_status^.field_number,
                event_position.form_x_position, event_position.form_y_position,
                status);
        IFEND;

      = fdc$scroll_variable_backward =
        target_position.key := fdc$scroll_data_backward;
        target_position.data_index := fdv$screen_status.event_identifier.
              field_event_character_position + p_form_status^.p_form_object_statuses^ [object_index].
              character_position - 1;
        shift_text_line (target_position, p_text, object_index, screen_visible_length,
              p_form_status, fdv$screen_status.event_identifier.
              field_event_character_position, status);

      = fdc$scroll_variable_forward =
        target_position.key := fdc$scroll_data_forward;
        target_position.data_index := fdv$screen_status.event_identifier.
              field_event_character_position + p_form_status^.p_form_object_statuses^ [object_index].
              character_position - 1;
        shift_text_line (target_position, p_text, object_index, screen_visible_length,
              p_form_status, fdv$screen_status.event_identifier.
              field_event_character_position, status);

      = fdc$tab_to_next_form_field =
        IF p_form_status^.p_form_definition^.form_object_definitions.
              active_number > 0 THEN
          fdp$find_next_object (fdv$screen_status.event_position.
                form_x_position, fdv$screen_status.event_position.
                form_y_position, p_form_status, object_index);
          fdp$tab_to_next_variable (p_form_status, object_index, status);
        IFEND;

      = fdc$tab_to_previous_form_field =
        IF p_form_status^.p_form_definition^.form_object_definitions.
              active_number > 0 THEN
          find_previous_object (fdv$screen_status.event_position.
                form_x_position, fdv$screen_status.event_position.
                form_y_position, p_form_status, object_index);
          tab_to_previous_variable (p_form_status, object_index, status);
        IFEND;

      ELSE
        event_defined := FALSE;
      CASEND;

    = fdc$form_constant_text_box =
      event_position.object_definition_key := fdc$constant_text_box;
      screen_visible_length := p_form_object_definition^.constant_box_width *
            p_form_object_definition^.constant_box_height;
      p_text := fdp$ptr_text (p_form_object_definition^.constant_box_text,
            p_form_status^.p_form_module);
      next_object_index := p_form_object_definition^.
            constant_box_fragment_index;
      CASE event_action OF

      = fdc$return_program_normal, fdc$return_program_abnormal,
            fdc$ignore_event =

      = fdc$display_help =
        display_form_help (p_form_status, status);

      = fdc$erase_help =
        erase_message_form (status);

      = fdc$page_table_backward =
        find_table_to_page;
        IF event_defined THEN
          occurrence_shift := -p_form_table_definition^.visible_occurrence;
          page_table (p_form_table_status, p_form_table_definition, 1,
                occurrence_shift, p_form_status^.field_number,
                event_position.form_x_position, event_position.form_y_position,
                status);
        IFEND;

      = fdc$page_table_forward =
        find_table_to_page;
        IF event_defined THEN
          occurrence_shift := p_form_table_definition^.visible_occurrence;
          page_table (p_form_table_status, p_form_table_definition, 1,
                occurrence_shift, p_form_status^.field_number,
                event_position.form_x_position, event_position.form_y_position,
                status);
        IFEND;

      = fdc$page_table_first =
        find_table_to_page;
        IF event_defined THEN

{ Specify maximum shift.  Shift_table will compute actual shift need.

          occurrence_shift := -p_form_table_definition^.stored_occurrence;
          page_table (p_form_table_status, p_form_table_definition, 1,
                occurrence_shift, p_form_status^.field_number,
                event_position.form_x_position, event_position.form_y_position,
                status);
        IFEND;

      = fdc$page_table_last =
        find_table_to_page;
        IF event_defined THEN

{ Specify maximum shift.  Shift_table will compute actual shifted needed.

          occurrence_shift := p_form_table_definition^.stored_occurrence;
          page_table (p_form_table_status, p_form_table_definition, 1,
                occurrence_shift, p_form_status^.field_number,
                event_position.form_x_position, event_position.form_y_position,
                status);
        IFEND;

      = fdc$page_variable_backward =
        target_position.key := fdc$page_data_backward;
        shift_text_box (p_text, p_form_status, object_index, next_object_index,
              p_form_object_definition^.constant_box_processing,
              p_form_object_definition^.constant_box_width,
              p_form_object_definition^.constant_box_height, object_index,
              fdv$screen_status.event_identifier.
              field_event_character_position, target_position, status);

      = fdc$page_variable_first =
        target_position.key := fdc$page_data_first;
        shift_text_box (p_text, p_form_status, object_index, next_object_index,
              p_form_object_definition^.constant_box_processing,
              p_form_object_definition^.constant_box_width,
              p_form_object_definition^.constant_box_height, object_index,
              fdv$screen_status.event_identifier.
              field_event_character_position, target_position, status);

      = fdc$page_variable_forward =
        target_position.key := fdc$page_data_forward;
        shift_text_box (p_text, p_form_status, object_index, next_object_index,
              p_form_object_definition^.constant_box_processing,
              p_form_object_definition^.constant_box_width,
              p_form_object_definition^.constant_box_height, object_index,
              fdv$screen_status.event_identifier.
              field_event_character_position, target_position, status);

      = fdc$page_variable_last =
        target_position.key := fdc$page_data_last;
        shift_text_box (p_text, p_form_status, object_index, next_object_index,
              p_form_object_definition^.constant_box_processing,
              p_form_object_definition^.constant_box_width,
              p_form_object_definition^.constant_box_height, object_index,
              fdv$screen_status.event_identifier.
              field_event_character_position, target_position, status);

      = fdc$scroll_variable_backward =
        target_position.key := fdc$scroll_data_backward;
        target_position.data_index := fdv$screen_status.event_identifier.
              field_event_character_position + p_form_status^.p_form_object_statuses^ [object_index].
              character_position - 1;
        shift_text_box (p_text, p_form_status, object_index, next_object_index,
              p_form_object_definition^.constant_box_processing,
              p_form_object_definition^.constant_box_width,
              p_form_object_definition^.constant_box_height, object_index,
              fdv$screen_status.event_identifier.
              field_event_character_position, target_position, status);

      = fdc$scroll_variable_forward =
        target_position.key := fdc$scroll_data_forward;
        target_position.data_index := fdv$screen_status.event_identifier.
              field_event_character_position + p_form_status^.p_form_object_statuses^ [object_index].
              character_position - 1;
        shift_text_box (p_text, p_form_status, object_index, next_object_index,
              p_form_object_definition^.constant_box_processing,
              p_form_object_definition^.constant_box_width,
              p_form_object_definition^.constant_box_height, object_index,
              fdv$screen_status.event_identifier.
              field_event_character_position, target_position, status);

      = fdc$tab_to_next_form_field =
        IF p_form_status^.p_form_definition^.form_object_definitions.
              active_number > 0 THEN
          fdp$find_next_object (fdv$screen_status.event_position.
                form_x_position, fdv$screen_status.event_position.
                form_y_position, p_form_status, object_index);
          fdp$tab_to_next_variable (p_form_status, object_index, status);
        IFEND;

      = fdc$tab_to_previous_form_field =
        IF p_form_status^.p_form_definition^.form_object_definitions.
              active_number > 0 THEN
          find_previous_object (fdv$screen_status.event_position.
                form_x_position, fdv$screen_status.event_position.
                form_y_position, p_form_status, object_index);
          tab_to_previous_variable (p_form_status, object_index, status);
        IFEND;

      ELSE
        event_defined := FALSE;
      CASEND;

    = fdc$form_text_box_fragment =
      parent_object_index := p_form_object_definition^.
            parent_text_box_object_index;
      p_parent_object_definition := ^p_form_object_definitions^
            [parent_object_index];
      event_position.object_x_position := p_parent_object_definition^.
            x_position;
      event_position.object_y_position := p_parent_object_definition^.
            y_position;
      CASE p_form_object_definitions^ [parent_object_index].key OF

      = fdc$form_variable_text_box =
        p_form_variable_definition := ^p_form_status^.
              p_form_variable_definitions^ [p_parent_object_definition^.
              variable_box_variable_index];
        IF p_form_variable_definition^.table_exists THEN
          event_position.object_occurrence :=
                event_position.object_occurrence +
                p_form_status^.p_form_table_statuses^ [
                p_form_variable_definition^.table_index].
                first_displayed_occurrence - 1;
        IFEND;

        event_position.object_definition_key := fdc$variable_text_box;
        event_position.character_position :=
              fdv$screen_status.event_identifier.
              field_event_character_position +
              p_form_status^.p_form_object_statuses^ [parent_object_index].
              character_position - 1 + ((p_form_object_definition^.y_position -
              p_parent_object_definition^.y_position) *
              p_parent_object_definition^.variable_box_width);
        variable_index := p_parent_object_definition^.
              variable_box_variable_index;
        p_form_variable_definition := ^p_form_status^.
              p_form_variable_definitions^ [variable_index];
        screen_visible_length := p_parent_object_definition^.
              variable_box_width * p_parent_object_definition^.
              variable_box_height;
        fdp$ptr_screen_variable (p_form_status^.p_screen_record,
              p_form_variable_definition^.screen_record_position,
              p_form_variable_definition^.screen_variable_length, p_text);
        next_object_index := p_parent_object_definition^.
              variable_box_fragment_index;
        CASE event_action OF

        = fdc$return_program_normal, fdc$return_program_abnormal,
              fdc$ignore_event =

{ The above events will be processed later.

        = fdc$delete_variable_line =

{ Shift the screen record data to the left to remove the deleted line.  Then reformat the
{ screen variable in the text box.

       start_move_position := p_form_object_statuses^ [object_index].character_position +
             p_form_object_statuses^ [object_index].data_length;
       text_length := p_form_variable_definition^.screen_variable_length - start_move_position + 1;
       PUSH p_save_data: [text_length];
       p_save_data^ := p_text^ (start_move_position, text_length);
       p_text^ (p_form_object_statuses^ [object_index].character_position, *) :=  p_save_data^;
       p_form_object_statuses^ [parent_object_index].user_changed_field := TRUE;
       p_form_object_statuses^ [parent_object_index].user_entered_field := TRUE;
       target_position.key := fdc$current_data_position;
       format_screen_text (p_text, p_form_status, parent_object_index, next_object_index,
             p_parent_object_definition^.variable_box_processing,
             p_parent_object_definition^.variable_box_width,
             p_parent_object_definition^.variable_box_height, target_position, status);

{ Delete any scheduled screen changes due to insertion or deletions of characters in
{ variable text box.

        delete_format_screen_change (form_identifier, parent_object_index);

{ Set the cursor back to where the terminal user had left it.  Other processing moved the cursor.

        csv$vector.position_cursor^ (p_form_object_statuses^ [object_index].field_number,
             fdv$screen_status.event_identifier.field_event_character_position, 1,
             output_character_position, output_line_position, terminal_status);


        = fdc$display_help =
          display_variable_help (p_form_status, form_identifier,
                p_form_variable_definition, event_position.object_occurrence,
                status);

        = fdc$erase_help =
          erase_message_form (status);

        = fdc$insert_variable_line =

       start_move_position := p_form_object_statuses^ [object_index].character_position;
       text_length := p_form_variable_definition^.screen_variable_length - start_move_position + 1;
       PUSH p_save_data: [text_length];
       p_save_data^ := p_text^ (start_move_position, text_length);
       IF p_parent_object_definition^.variable_box_processing = fdc$wrap_words THEN

{ For a text box with with word wrap, place a record separator in the data.  At this time
{ we cannot determine how the words will be broken into lines. Later formatting will generate
{ a blank line upon seeing the record separator.

         p_text^ (start_move_position, 1) := record_separator;
         IF ((p_form_object_statuses^ [object_index].character_position + 1) <
               p_form_variable_definition^.screen_variable_length) THEN
           p_text^ (p_form_object_statuses^ [object_index].character_position + 1, text_length - 1)
                 := p_save_data^;
         IFEND;

       ELSE {fdc$wrap_characters}

{ For a text box with character, wrap we simply put a line of blanks in the data.

         p_text^ (start_move_position, p_parent_object_definition^.variable_box_width) := '';
         IF ((start_move_position + p_parent_object_definition^.variable_box_width) <
               p_form_variable_definition^.screen_variable_length) THEN
           p_text^ (start_move_position + p_parent_object_definition^.variable_box_width,
                 text_length - p_parent_object_definition^.variable_box_width) :=  p_save_data^;
         IFEND;
       IFEND;
       p_form_object_statuses^ [parent_object_index].user_changed_field := TRUE;
       p_form_object_statuses^ [parent_object_index].user_entered_field := TRUE;
       target_position.key := fdc$current_data_position;
       format_screen_text (p_text, p_form_status, parent_object_index, next_object_index,
             p_parent_object_definition^.variable_box_processing,
             p_parent_object_definition^.variable_box_width,
             p_parent_object_definition^.variable_box_height, target_position, status);

{ Delete any scheduled screen changes due to insertion or deletions of characters in
{ variable text box.

        delete_format_screen_change (form_identifier, parent_object_index);

{ Set the cursor back to where the terminal user had left it.  Other processing moved the cursor.

       csv$vector.position_cursor^ (p_form_object_statuses^ [object_index].field_number,
             fdv$screen_status.event_identifier.field_event_character_position, 1,
             output_character_position, output_line_position, terminal_status);

        = fdc$page_table_backward =
          find_table_to_page;
          IF event_defined THEN
            occurrence_shift := -p_form_table_definition^.visible_occurrence;
            page_table (p_form_table_status, p_form_table_definition, 1,
                  occurrence_shift, p_form_status^.field_number,
                  event_position.form_x_position,
                  event_position.form_y_position, status);
          IFEND;

        = fdc$page_table_forward =
          find_table_to_page;
          IF event_defined THEN
            occurrence_shift := p_form_table_definition^.visible_occurrence;
            page_table (p_form_table_status, p_form_table_definition, 1,
                  occurrence_shift, p_form_status^.field_number,
                  event_position.form_x_position,
                  event_position.form_y_position, status);
          IFEND;

        = fdc$page_table_first =
          find_table_to_page;
          IF event_defined THEN

{ Specify maximum shift.  Shift_table will compute actual shift need.

            occurrence_shift := -p_form_table_definition^.stored_occurrence;
            page_table (p_form_table_status, p_form_table_definition, 1,
                  occurrence_shift, p_form_status^.field_number,
                  event_position.form_x_position,
                  event_position.form_y_position, status);
          IFEND;

        = fdc$page_table_last =
          find_table_to_page;
          IF event_defined THEN

{ Specify maximum shift.  Shift_table will compute actual shifted needed.

            occurrence_shift := p_form_table_definition^.stored_occurrence;
            page_table (p_form_table_status, p_form_table_definition, 1,
                  occurrence_shift, p_form_status^.field_number,
                  event_position.form_x_position,
                  event_position.form_y_position, status);
          IFEND;

        = fdc$page_variable_backward =
          target_position.key := fdc$page_data_backward;
          shift_variable (p_form_status, p_form_variable_definition,
                parent_object_index, object_index, screen_visible_length,
                target_position, status);


        = fdc$page_variable_first =
          target_position.key := fdc$page_data_first;
          shift_variable (p_form_status, p_form_variable_definition,
                parent_object_index, object_index, screen_visible_length,
                target_position, status);

        = fdc$page_variable_forward =
          target_position.key := fdc$page_data_forward;
          shift_variable (p_form_status, p_form_variable_definition,
                parent_object_index, object_index, screen_visible_length,
                target_position, status);

        = fdc$page_variable_last =
          target_position.key := fdc$page_data_last;
          shift_variable (p_form_status, p_form_variable_definition,
                parent_object_index, object_index, screen_visible_length,
                target_position, status);

        = fdc$scroll_variable_backward =
          target_position.key := fdc$scroll_data_backward;
          target_position.data_index := fdv$screen_status.event_identifier.
              field_event_character_position + p_form_status^.p_form_object_statuses^ [object_index].
              character_position - 1;
          shift_variable (p_form_status, p_form_variable_definition,
                parent_object_index, object_index, screen_visible_length,
                target_position, status);

        = fdc$scroll_variable_forward =
          target_position.data_index := fdv$screen_status.event_identifier.
              field_event_character_position + p_form_status^.p_form_object_statuses^ [object_index].
              character_position - 1;
          target_position.key := fdc$scroll_data_forward;
          shift_variable (p_form_status, p_form_variable_definition,
                parent_object_index, object_index, screen_visible_length,
                target_position, status);

        = fdc$tab_to_next_form_field =
          object_index := object_index + 1;
          fdp$tab_to_next_variable (p_form_status, object_index, status);

        = fdc$tab_to_previous_form_field =
          IF fdv$screen_status.event_identifier.
                field_event_character_position = 1 THEN
            object_index := object_index - 1;
          IFEND;
          tab_to_previous_variable (p_form_status, object_index, status);

        ELSE
          event_defined := FALSE;
        CASEND;

      = fdc$form_constant_text_box =
        event_position.object_definition_key := fdc$constant_text_box;
        screen_visible_length := p_parent_object_definition^.
              constant_box_width * p_parent_object_definition^.
              constant_box_height;
        p_text := fdp$ptr_text (p_parent_object_definition^.constant_box_text,
              p_form_status^.p_form_module);
        next_object_index := p_parent_object_definition^.
              constant_box_fragment_index;
        CASE event_action OF

        = fdc$return_program_normal, fdc$return_program_abnormal,
              fdc$ignore_event =

        = fdc$display_help =
          display_form_help (p_form_status, status);

        = fdc$erase_help =
          erase_message_form (status);

        = fdc$page_table_backward =
          find_table_to_page;
          IF event_defined THEN
            occurrence_shift := -p_form_table_definition^.visible_occurrence;
            page_table (p_form_table_status, p_form_table_definition, 1,
                  occurrence_shift, p_form_status^.field_number,
                  event_position.form_x_position,
                  event_position.form_y_position, status);
          IFEND;

        = fdc$page_table_forward =
          find_table_to_page;
          IF event_defined THEN
            occurrence_shift := p_form_table_definition^.visible_occurrence;
            page_table (p_form_table_status, p_form_table_definition, 1,
                  occurrence_shift, p_form_status^.field_number,
                  event_position.form_x_position,
                  event_position.form_y_position, status);
          IFEND;

        = fdc$page_table_first =
          find_table_to_page;
          IF event_defined THEN

{ Specify maximum shift.  Shift_table will compute actual shift need.

            occurrence_shift := -p_form_table_definition^.stored_occurrence;
            page_table (p_form_table_status, p_form_table_definition, 1,
                  occurrence_shift, p_form_status^.field_number,
                  event_position.form_x_position,
                  event_position.form_y_position, status);
          IFEND;

        = fdc$page_table_last =
          find_table_to_page;
          IF event_defined THEN

{ Specify maximum shift.  Shift_table will compute actual shifted needed.

            occurrence_shift := p_form_table_definition^.stored_occurrence;
            page_table (p_form_table_status, p_form_table_definition, 1,
                  occurrence_shift, p_form_status^.field_number,
                  event_position.form_x_position,
                  event_position.form_y_position, status);
          IFEND;

        = fdc$page_variable_backward =
          target_position.key := fdc$scroll_data_backward;
          target_position.data_index := fdv$screen_status.event_identifier.
              field_event_character_position + p_form_status^.p_form_object_statuses^ [object_index].
              character_position - 1;
          shift_text_box (p_text, p_form_status, parent_object_index,
                next_object_index, p_parent_object_definition^.
                constant_box_processing, p_parent_object_definition^.
                constant_box_width, p_parent_object_definition^.
                constant_box_height, object_index,
                fdv$screen_status.event_identifier.
                field_event_character_position, target_position, status);

        = fdc$page_variable_first =
          target_position.key := fdc$page_data_first;
          shift_text_box (p_text, p_form_status, parent_object_index,
                next_object_index, p_parent_object_definition^.
                constant_box_processing, p_parent_object_definition^.
                constant_box_width, p_parent_object_definition^.
                constant_box_height, object_index,
                fdv$screen_status.event_identifier.
                field_event_character_position, target_position, status);

        = fdc$page_variable_forward =
          target_position.key := fdc$page_data_forward;
          shift_text_box (p_text, p_form_status, parent_object_index,
                next_object_index, p_parent_object_definition^.
                constant_box_processing, p_parent_object_definition^.
                constant_box_width, p_parent_object_definition^.
                constant_box_height, object_index,
                fdv$screen_status.event_identifier.
                field_event_character_position, target_position, status);

        = fdc$page_variable_last =
          target_position.key := fdc$page_data_last;
          shift_text_box (p_text, p_form_status, parent_object_index,
                next_object_index, p_parent_object_definition^.
                constant_box_processing, p_parent_object_definition^.
                constant_box_width, p_parent_object_definition^.
                constant_box_height, object_index,
                fdv$screen_status.event_identifier.
                field_event_character_position, target_position, status);

        = fdc$scroll_variable_backward =
          target_position.key := fdc$scroll_data_backward;
          target_position.data_index := fdv$screen_status.event_identifier.
              field_event_character_position + p_form_status^.p_form_object_statuses^ [object_index].
              character_position - 1;
          shift_text_box (p_text, p_form_status, parent_object_index,
                next_object_index, p_parent_object_definition^.
                constant_box_processing, p_parent_object_definition^.
                constant_box_width, p_parent_object_definition^.
                constant_box_height, object_index,
                fdv$screen_status.event_identifier.
                field_event_character_position, target_position, status);

        = fdc$scroll_variable_forward =
          target_position.key := fdc$scroll_data_forward;
          target_position.data_index := fdv$screen_status.event_identifier.
              field_event_character_position + p_form_status^.p_form_object_statuses^ [object_index].
              character_position - 1;
          shift_text_box (p_text, p_form_status, parent_object_index,
                next_object_index, p_parent_object_definition^.
                constant_box_processing, p_parent_object_definition^.
                constant_box_width, p_parent_object_definition^.
                constant_box_height, object_index,
                fdv$screen_status.event_identifier.
                field_event_character_position, target_position, status);

        = fdc$tab_to_next_form_field =
          IF p_form_status^.p_form_definition^.form_object_definitions.
                active_number > 0 THEN
            fdp$find_next_object (fdv$screen_status.event_position.
                  form_x_position, fdv$screen_status.event_position.
                  form_y_position, p_form_status, object_index);
            fdp$tab_to_next_variable (p_form_status, object_index, status);
          IFEND;

        = fdc$tab_to_previous_form_field =
          IF p_form_status^.p_form_definition^.form_object_definitions.
                active_number > 0 THEN
            find_previous_object (fdv$screen_status.event_position.
                  form_x_position, fdv$screen_status.event_position.
                  form_y_position, p_form_status, object_index);
            tab_to_previous_variable (p_form_status, object_index, status);
          IFEND;

        ELSE
          event_defined := FALSE;
        CASEND;

      ELSE
        osp$set_status_abnormal (fdc$format_display_identifier,
              fde$system_error, 'invalid parent object ', status);
      CASEND;

    = fdc$form_variable_text =
      event_position.object_definition_key := fdc$variable_text;
      variable_index := p_form_object_definition^.text_variable_index;
      p_form_variable_definition := ^p_form_status^.
            p_form_variable_definitions^ [variable_index];
      screen_visible_length := p_form_object_definition^.text_variable_width;
      p_form_variable_definition := ^p_form_status^.
            p_form_variable_definitions^ [variable_index];

      CASE event_action OF

      = fdc$return_program_normal, fdc$return_program_abnormal =
        event_position.character_position :=
              fdv$screen_status.event_identifier.
              field_event_character_position +
              p_form_status^.p_form_object_statuses^ [object_index].
              character_position - 1;
        p_form_variable_definition := ^p_form_status^.
              p_form_variable_definitions^ [p_form_object_definition^.
              text_variable_index];

        IF p_form_variable_definition^.table_exists THEN
          event_position.object_occurrence :=
                event_position.object_occurrence +
                p_form_status^.p_form_table_statuses^ [
                p_form_variable_definition^.table_index].
                first_displayed_occurrence - 1;
        IFEND;

      = fdc$display_help =
        display_variable_help (p_form_status, form_identifier,
              p_form_variable_definition, event_position.object_occurrence,
              status);

      = fdc$erase_help =
        erase_message_form (status);

      = fdc$ignore_event =

{ Do nothing at this time.

      = fdc$page_table_backward =
        IF p_form_variable_definition^.table_exists THEN
          table_index := p_form_variable_definition^.table_index;
          p_form_table_definition := ^p_form_status^.
                p_form_table_definitions^ [table_index];
          occurrence_shift := -p_form_table_definition^.visible_occurrence;
          page_table (p_form_status, p_form_table_definition, table_index,
                occurrence_shift, p_form_status^.field_number,
                event_position.form_x_position, event_position.form_y_position,
                status);
        ELSE
          find_table_to_page;
          IF event_defined THEN
            occurrence_shift := -p_form_table_definition^.visible_occurrence;
            page_table (p_form_table_status, p_form_table_definition, 1,
                  occurrence_shift, p_form_status^.field_number,
                  event_position.form_x_position,
                  event_position.form_y_position, status);
          IFEND;
        IFEND;

      = fdc$page_table_forward =
        IF p_form_variable_definition^.table_exists THEN
          table_index := p_form_variable_definition^.table_index;
          p_form_table_definition := ^p_form_status^.
                p_form_table_definitions^ [table_index];
          occurrence_shift := p_form_table_definition^.visible_occurrence;
          page_table (p_form_status, p_form_table_definition, table_index,
                occurrence_shift, p_form_status^.field_number,
                event_position.form_x_position, event_position.form_y_position,
                status);
        ELSE
          find_table_to_page;
          IF event_defined THEN
            occurrence_shift := p_form_table_definition^.visible_occurrence;
            page_table (p_form_table_status, p_form_table_definition, 1,
                  occurrence_shift, p_form_status^.field_number,
                  event_position.form_x_position,
                  event_position.form_y_position, status);
          IFEND;
        IFEND;

      = fdc$page_table_first =
        IF p_form_variable_definition^.table_exists THEN
          table_index := p_form_variable_definition^.table_index;
          p_form_table_definition := ^p_form_status^.
                p_form_table_definitions^ [table_index];

{ Specify maximum shift.  Shift_table will compute actual shift need.

          occurrence_shift := -p_form_table_definition^.stored_occurrence;
          page_table (p_form_status, p_form_table_definition, table_index,
                occurrence_shift, p_form_status^.field_number,
                event_position.form_x_position, event_position.form_y_position,
                status);
        ELSE
          find_table_to_page;
          IF event_defined THEN
            occurrence_shift := -p_form_table_definition^.stored_occurrence;
            page_table (p_form_table_status, p_form_table_definition, 1,
                  occurrence_shift, p_form_status^.field_number,
                  event_position.form_x_position,
                  event_position.form_y_position, status);
          IFEND;
        IFEND;

      = fdc$page_table_last =
        IF p_form_variable_definition^.table_exists THEN
          table_index := p_form_variable_definition^.table_index;
          p_form_table_definition := ^p_form_status^.
                p_form_table_definitions^ [table_index];

{ Specify maximum shift.  Shift_table will compute actual shifted needed.

          occurrence_shift := p_form_table_definition^.stored_occurrence;
          page_table (p_form_status, p_form_table_definition, table_index,
                occurrence_shift, p_form_status^.field_number,
                event_position.form_x_position, event_position.form_y_position,
                status);
        ELSE
          find_table_to_page;
          IF event_defined THEN
            occurrence_shift := p_form_table_definition^.stored_occurrence;
            page_table (p_form_table_status, p_form_table_definition, 1,
                  occurrence_shift, p_form_status^.field_number,
                  event_position.form_x_position,
                  event_position.form_y_position, status);
          IFEND;
        IFEND;

      = fdc$scroll_table_backward =
        IF p_form_variable_definition^.table_exists THEN
          table_index := p_form_variable_definition^.table_index;
          p_form_table_definition := ^p_form_status^.
                p_form_table_definitions^ [table_index];
          occurrence_shift := -(p_form_table_definition^.visible_occurrence -
                p_form_object_definition^.occurrence);
          shift_table (p_form_status, p_form_table_definition, table_index,
                occurrence_shift, 0, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

          csv$vector.position_cursor^ (p_form_status^.
                p_form_object_statuses^ [object_index].field_number, position,
                1, output_character_position, output_line_position,
                terminal_status);
          IF NOT terminal_status.normal THEN
            fdp$convert_terminal_status (terminal_status, status);
            RETURN;
          IFEND;
        IFEND;

      = fdc$scroll_table_forward =
        IF p_form_variable_definition^.table_exists THEN
          table_index := p_form_variable_definition^.table_index;
          p_form_table_definition := ^p_form_status^.
                p_form_table_definitions^ [table_index];
          occurrence_shift := p_form_object_definition^.occurrence - 1;
          shift_table (p_form_status, p_form_table_definition, table_index,
                occurrence_shift, 0, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

          csv$vector.position_cursor^ (p_form_status^.
                p_form_object_statuses^ [object_index].field_number, position,
                1, output_character_position, output_line_position,
                terminal_status);
          IF NOT terminal_status.normal THEN
            fdp$convert_terminal_status (terminal_status, status);
          IFEND;
        IFEND;

      = fdc$page_variable_backward =
        target_position.key := fdc$page_data_backward;
        shift_variable (p_form_status, p_form_variable_definition,
              object_index, object_index, screen_visible_length, target_position,
              status);

      = fdc$page_variable_first =
        target_position.key := fdc$page_data_first;
        shift_variable (p_form_status, p_form_variable_definition,
              object_index, object_index, screen_visible_length, target_position,
              status);


      = fdc$page_variable_forward =
        target_position.key := fdc$page_data_forward;
        shift_variable (p_form_status, p_form_variable_definition,
              object_index, object_index, screen_visible_length, target_position,
              status);

      = fdc$page_variable_last =
        target_position.key := fdc$page_data_last;
        shift_variable (p_form_status, p_form_variable_definition,
              object_index, object_index, screen_visible_length, target_position,
              status);

      = fdc$scroll_variable_backward =
        target_position.key := fdc$scroll_data_backward;
        target_position.data_index := fdv$screen_status.event_identifier.
              field_event_character_position + p_form_status^.p_form_object_statuses^ [object_index].
              character_position - 1;
        shift_variable (p_form_status, p_form_variable_definition,
              object_index, object_index, screen_visible_length, target_position,
              status);

      = fdc$scroll_variable_forward =
        target_position.key := fdc$scroll_data_forward;
        target_position.data_index := fdv$screen_status.event_identifier.
              field_event_character_position + p_form_status^.p_form_object_statuses^ [object_index].
              character_position - 1;
        shift_variable (p_form_status, p_form_variable_definition,
              object_index, object_index, screen_visible_length, target_position,
              status);

      = fdc$tab_to_next_form_field =
        object_index := object_index + 1;
        fdp$tab_to_next_variable (p_form_status, object_index, status);

      = fdc$tab_to_previous_form_field =
        IF fdv$screen_status.event_identifier.field_event_character_position =
              1 THEN
          object_index := object_index - 1;
        IFEND;
        tab_to_previous_variable (p_form_status, object_index, status);

      ELSE
        event_defined := FALSE;
      CASEND;

    = fdc$form_variable_text_box =
      event_position.object_definition_key := fdc$variable_text_box;
      variable_index := p_form_object_definition^.variable_box_variable_index;
      p_form_variable_definition := ^p_form_status^.
            p_form_variable_definitions^ [variable_index];
      screen_visible_length := p_form_object_definition^.variable_box_width *
            p_form_object_definition^.variable_box_height;
      fdp$ptr_screen_variable (p_form_status^.p_screen_record,
            p_form_variable_definition^.screen_record_position,
            p_form_variable_definition^.screen_variable_length, p_text);
      next_object_index := p_form_object_definition^.
            variable_box_fragment_index;

      CASE event_action OF

     = fdc$return_program_normal, fdc$return_program_abnormal =
        event_position.character_position :=
              fdv$screen_status.event_identifier.
              field_event_character_position +
              p_form_status^.p_form_object_statuses^ [object_index].
              character_position - 1;

      = fdc$display_help =
        display_variable_help (p_form_status, form_identifier,
              p_form_variable_definition, event_position.object_occurrence,
              status);

      = fdc$erase_help =
        erase_message_form (status);

      = fdc$delete_variable_line =

{ Shift the screen record data to the left to remove the deleted line.  Then reformat the
{ screen variable in the text box.

       start_move_position := p_form_object_statuses^ [object_index].character_position +
             p_form_object_statuses^ [object_index].data_length;
       text_length := p_form_variable_definition^.screen_variable_length - start_move_position + 1;
       PUSH p_save_data: [text_length];
       p_save_data^ := p_text^ (start_move_position, text_length);
       p_form_object_statuses^ [object_index].user_changed_field := TRUE;
       p_form_object_statuses^ [object_index].user_entered_field := TRUE;
       p_text^ (p_form_object_statuses^ [object_index].character_position, *) :=  p_save_data^;
       target_position.key := fdc$current_data_position;
       format_screen_text (p_text, p_form_status, object_index, next_object_index,
             p_form_object_definition^.variable_box_processing,
             p_form_object_definition^.variable_box_width,
             p_form_object_definition^.variable_box_height, target_position, status);

{ Delete any scheduled screen changes due to insertion or deletions of characters in
{ variable text box.

        delete_format_screen_change (form_identifier, object_index);

{ Set the cursor back to where the terminal user had left it.  Other processing moved the cursor.

        csv$vector.position_cursor^ (p_form_object_statuses^ [object_index].field_number,
             fdv$screen_status.event_identifier.field_event_character_position, 1,
             output_character_position, output_line_position, terminal_status);


      = fdc$ignore_event =

{ Do nothing at this time. This event will be handled later.

      = fdc$insert_variable_line =

{ For a text box with with word wrap, place a record separator in the data.  At this time
{ we cannot determine how the words will be broken into lines. Later formatting will generate
{ a blank line upon seeing the record separator.

       start_move_position := p_form_object_statuses^ [object_index].character_position;
       text_length := p_form_variable_definition^.screen_variable_length - start_move_position + 1;
       PUSH p_save_data: [text_length];
       p_save_data^ := p_text^ (start_move_position, text_length);
       IF p_form_object_definition^.variable_box_processing = fdc$wrap_words THEN
         p_text^ (start_move_position, 1) := record_separator;
         IF ((p_form_object_statuses^ [object_index].character_position + 1) <
               p_form_variable_definition^.screen_variable_length) THEN
           p_text^ (p_form_object_statuses^ [object_index].character_position + 1, text_length - 1)
                 :=  p_save_data^;
         IFEND;
       ELSE {fdc$wrap_characters}
         p_text^ (start_move_position, p_form_object_definition^.variable_box_width) := '';
         IF ((start_move_position + p_form_object_definition^.variable_box_width) <
               p_form_variable_definition^.screen_variable_length) THEN
           p_text^ (start_move_position + p_form_object_definition^.variable_box_width,
               text_length - p_form_object_definition^.variable_box_width) :=  p_save_data^;
         IFEND;
       IFEND;
       p_form_object_statuses^ [object_index].user_changed_field := TRUE;
       p_form_object_statuses^ [object_index].user_entered_field := TRUE;
       target_position.key := fdc$current_data_position;
       format_screen_text (p_text, p_form_status, object_index, next_object_index,
             p_form_object_definition^.variable_box_processing,
             p_form_object_definition^.variable_box_width,
             p_form_object_definition^.variable_box_height, target_position, status);

{ Delete any scheduled screen changes due to insertion or deletions of characters in
{ variable text box.

        delete_format_screen_change (form_identifier, object_index);

{ Set the cursor back to where the terminal user had left it.  Other processing moved the cursor.

       csv$vector.position_cursor^ (p_form_object_statuses^ [object_index].field_number,
             fdv$screen_status.event_identifier.field_event_character_position, 1,
             output_character_position, output_line_position, terminal_status);

      = fdc$page_table_backward =
        find_table_to_page;
        IF event_defined THEN
          occurrence_shift := -p_form_table_definition^.visible_occurrence;
          page_table (p_form_table_status, p_form_table_definition, 1,
                occurrence_shift, p_form_status^.field_number,
                event_position.form_x_position, event_position.form_y_position,
                status);
        IFEND;

      = fdc$page_table_forward =
        find_table_to_page;
        IF event_defined THEN
          occurrence_shift := p_form_table_definition^.visible_occurrence;
          page_table (p_form_table_status, p_form_table_definition, 1,
                occurrence_shift, p_form_status^.field_number,
                event_position.form_x_position, event_position.form_y_position,
                status);
        IFEND;

      = fdc$page_table_first =
        find_table_to_page;
        IF event_defined THEN

{ Specify maximum shift.  Shift_table will compute actual shift need.

          occurrence_shift := -p_form_table_definition^.stored_occurrence;
          page_table (p_form_table_status, p_form_table_definition, 1,
                occurrence_shift, p_form_status^.field_number,
                event_position.form_x_position, event_position.form_y_position,
                status);
        IFEND;

      = fdc$page_table_last =
        find_table_to_page;
        IF event_defined THEN

{ Specify maximum shift.  Shift_table will compute actual shifted needed.

          occurrence_shift := p_form_table_definition^.stored_occurrence;
          page_table (p_form_table_status, p_form_table_definition, 1,
                occurrence_shift, p_form_status^.field_number,
                event_position.form_x_position, event_position.form_y_position,
                status);
        IFEND;

      = fdc$page_variable_backward =
        target_position.key := fdc$page_data_backward;
        shift_variable (p_form_status, p_form_variable_definition,
              object_index, object_index, screen_visible_length, target_position,
              status);

      = fdc$page_variable_first =
        target_position.key := fdc$page_data_first;
        shift_variable (p_form_status, p_form_variable_definition,
              object_index, object_index, screen_visible_length, target_position,
              status);

      = fdc$page_variable_forward =
        target_position.key := fdc$page_data_forward;
        shift_variable (p_form_status, p_form_variable_definition,
              object_index, object_index, screen_visible_length, target_position,
              status);

      = fdc$page_variable_last =
        target_position.key := fdc$page_data_last;
        shift_variable (p_form_status, p_form_variable_definition,
              object_index, object_index, screen_visible_length, target_position,
              status);

      = fdc$scroll_variable_backward =
        target_position.key := fdc$scroll_data_backward;
        target_position.data_index := fdv$screen_status.event_identifier.
              field_event_character_position + p_form_status^.p_form_object_statuses^ [object_index].
              character_position - 1;
        shift_variable (p_form_status, p_form_variable_definition,
              object_index, object_index, screen_visible_length, target_position,
              status);

      = fdc$scroll_variable_forward =
        target_position.key := fdc$scroll_data_forward;
        target_position.data_index := fdv$screen_status.event_identifier.
              field_event_character_position + p_form_status^.p_form_object_statuses^ [object_index].
              character_position - 1;
        shift_variable (p_form_status, p_form_variable_definition,
              object_index, object_index, screen_visible_length, target_position,
              status);

      = fdc$tab_to_next_form_field =
        object_index := object_index + 1;
        fdp$tab_to_next_variable (p_form_status, object_index, status);

      = fdc$tab_to_previous_form_field =
        IF fdv$screen_status.event_identifier.field_event_character_position =
              1 THEN
          object_index := object_index - 1;
        IFEND;
        tab_to_previous_variable (p_form_status, object_index, status);

      ELSE
        event_defined := FALSE;
      CASEND;

    ELSE

{ Invalid object definition key.

      osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
            'invalid object definition key ', status);
    CASEND;
  PROCEND process_screen_object_event;

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

{ PURPOSE:
{   This procedure process events that occurred on no form or
{   on graphic objects on a form. Determine the event position.  Perform the
{   specified action.

  PROCEDURE process_screen_page_event;

?? NEWTITLE := 'find_screen_object', EJECT ??

{ PURPOSE:
{   This procedure finds graphic objects on a form. The Screen Manager returns a page
{   event when the event occurs on a graphic object.

  PROCEDURE find_screen_object;

    VAR
      object_x_position: fdt$x_position,
      object_y_position: fdt$x_position;

    event_position.screen_x_position := fdv$screen_status.event_identifier.page_event_x_position;
    event_position.screen_y_position := fdv$screen_status.event_identifier.page_event_y_position;
    form_identifier := fdv$screen_status.current_form_identifier;

    WHILE form_identifier <> 0 DO
      p_form_status := ^fdv$screen_status.p_forms_status^ [form_identifier];
      IF p_form_status^.displayed_on_screen THEN
        p_form_definition := p_form_status^.p_form_definition;

{ Look on all forms top to bottom residing on terminal screen for object.

       IF event_position.screen_x_position >= p_form_status^.form_x_position THEN
         IF event_position.screen_y_position >= p_form_status^.form_y_position THEN
            IF event_position.screen_x_position <= p_form_status^.form_x_position + p_form_definition^.width -
                  1 THEN
              IF event_position.screen_y_position <= p_form_status^.form_y_position +
                  p_form_definition^.height - 1 THEN

{ Object is inside form. Find particular object.

                p_form_object_definitions := p_form_status^.p_form_object_definitions;
                fdv$screen_status.last_cursor_position_valid := TRUE;
                fdv$screen_status.last_cursor_form_identifier := form_identifier;
                p_form_status^.last_cursor_position_valid := TRUE;
                p_form_status^.last_cursor_form_x_position := event_position.screen_x_position -
                      p_form_status^.form_x_position + 1;
                p_form_status^.last_cursor_form_y_position := event_position.screen_y_position -
                    p_form_status^.form_y_position + 1;

                event_position.form_identifier := form_identifier;
                event_position.form_x_position := p_form_status^.last_cursor_form_x_position;
                event_position.form_y_position := p_form_status^.last_cursor_form_y_position;

              /check_form_objects/
                FOR object_index := p_form_status^.p_form_definition^.form_object_definitions.
                      active_number DOWNTO 1 DO
                  p_form_object_definition := ^p_form_object_definitions^ [object_index];
                  object_x_position := p_form_object_definition^.x_position + p_form_status^.form_x_position -
                          1;
                  object_y_position := p_form_object_definition^.y_position + p_form_status^.form_y_position -
                          1;
                  IF event_position.screen_x_position >= object_x_position THEN
                    IF event_position.screen_y_position >= object_y_position THEN
                      CASE p_form_object_definition^.key OF

                      = fdc$form_box =
                        IF event_position.screen_x_position <= object_x_position +
                                p_form_object_definition^.box_width - 1 THEN
                          IF ((event_position.screen_y_position = object_y_position) OR
                                (event_position.screen_y_position = object_y_position +
                                p_form_object_definition^.box_height - 1)) THEN
                            event_position.key := fdc$object_event;
                            event_position.object_x_position := p_form_object_definition^.x_position;
                            event_position.object_y_position := p_form_object_definition^.y_position;
                            event_position.object_name := p_form_object_definition^.name;
                            event_position.object_occurrence := p_form_object_definition^.occurrence;
                            event_position.object_definition_key := fdc$box;
                            object_exists := TRUE;
                            RETURN;
                         IFEND;
                        IFEND;

                        IF ((event_position.screen_x_position = object_x_position) OR
                              (event_position.screen_x_position = object_x_position +
                              p_form_object_definition^.box_width - 1)) THEN
                          IF event_position.screen_y_position <= object_y_position +
                                p_form_object_definition^.box_height - 1 THEN
                            event_position.key := fdc$object_event;
                            event_position.object_x_position := p_form_object_definition^.x_position;
                            event_position.object_y_position := p_form_object_definition^.y_position;
                            event_position.object_name := p_form_object_definition^.name;
                            event_position.object_occurrence := p_form_object_definition^.occurrence;
                            event_position.object_definition_key := fdc$box;
                            object_exists := TRUE;
                            RETURN;
                          IFEND;
                        IFEND;

                      = fdc$form_line =
                        IF event_position.screen_x_position <= object_x_position +
                              p_form_object_definition^.x_increment THEN
                          IF event_position.screen_y_position <= object_y_position +
                              p_form_object_definition^.y_increment THEN
                            event_position.key := fdc$object_event;
                            event_position.object_x_position := p_form_object_definition^.x_position;
                            event_position.object_y_position := p_form_object_definition^.y_position;
                            event_position.object_name := p_form_object_definition^.name;
                            event_position.object_occurrence := p_form_object_definition^.occurrence;
                            event_position.object_definition_key := fdc$line;
                            object_exists := TRUE;
                            RETURN;
                          IFEND;
                        IFEND;

                      ELSE
                      CASEND;
                    IFEND;
                  IFEND;
                FOREND /check_form_objects/;

{ The event occurred on the form, but not on any form object.

                object_exists := TRUE;
                event_position.key := fdc$form_event;
                RETURN;
              IFEND;
            IFEND;
         IFEND;
        IFEND;
      IFEND;
      form_identifier := p_form_status^.next_lower_form;
    WHILEND;
  PROCEND find_screen_object;

?? OLDTITLE, EJECT ??

{ Any event on a graphic object is considered a page event.
{ Find the the form and object based on the screen (page) location.

    find_screen_object;
    IF NOT object_exists THEN
      RETURN;
    IFEND;

    IF NOT p_form_status^.events_active THEN
      RETURN;
    IFEND;

    translate_screen_event;
    IF NOT event_defined THEN
      RETURN;
    IFEND;

    CASE event_action OF

    = fdc$return_program_normal, fdc$return_program_abnormal,
          fdc$ignore_event =

{ The above events will be processed later.

    = fdc$display_help =
      display_form_help (p_form_status, status);

    = fdc$erase_help =
      erase_message_form (status);

    = fdc$page_table_backward =
      find_table_to_page;
      IF event_defined THEN
        occurrence_shift := -p_form_table_definition^.visible_occurrence;
        page_table (p_form_table_status,
              p_form_table_definition, 1, occurrence_shift,
              p_form_status^.field_number, event_position.form_x_position,
              event_position.form_y_position, status);
      IFEND;

    = fdc$page_table_forward =
      find_table_to_page;
      IF event_defined THEN
        occurrence_shift := p_form_table_definition^.visible_occurrence;
        page_table (p_form_table_status, p_form_table_definition, 1,
              occurrence_shift, p_form_status^.field_number,
              event_position.form_x_position, event_position.form_y_position,
              status);
      IFEND;

    = fdc$page_table_first =
      find_table_to_page;
      IF event_defined THEN

{ Specify maximum shift.  Shift_table will compute actual shift need.

        occurrence_shift := -p_form_table_definition^.stored_occurrence;
        page_table (p_form_table_status, p_form_table_definition, 1,
              occurrence_shift, p_form_status^.field_number,
              event_position.form_x_position, event_position.form_y_position,
              status);
      IFEND;

    = fdc$page_table_last =
      find_table_to_page;
      IF event_defined THEN

{ Specify maximum shift.  Shift_table will compute actual shifted needed.


        occurrence_shift := p_form_table_definition^.stored_occurrence;
        page_table (p_form_table_status, p_form_table_definition, 1,
              occurrence_shift, p_form_status^.field_number,
              event_position.form_x_position, event_position.form_y_position,
              status);
      IFEND;

    = fdc$tab_to_next_form_field =
      IF p_form_status^.p_form_definition^.form_object_definitions.
            active_number > 0 THEN
        fdp$find_next_object (fdv$screen_status.event_position.form_x_position,
              fdv$screen_status.event_position.form_y_position, p_form_status,
              object_index);
        fdp$tab_to_next_variable (p_form_status, object_index, status);
      IFEND;

    = fdc$tab_to_previous_form_field =
      IF p_form_status^.p_form_definition^.form_object_definitions.
            active_number > 0 THEN
        find_previous_object (fdv$screen_status.event_position.form_x_position,
              fdv$screen_status.event_position.form_y_position, p_form_status,
              object_index);
        tab_to_previous_variable (p_form_status, object_index, status);
      IFEND;

    ELSE
      event_defined := FALSE;
    CASEND;

  PROCEND process_screen_page_event;

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

{ PURPOSE:
{   This procedure maps the Screen Manager event to the Screen Formatting event.
{ DESIGN:
{   Event_recognized and event_defined are FALSE on entry.

  PROCEDURE translate_screen_event;

    VAR
      event_index: fdt$event_index,
      p_event_definition: ^fdt$event_definition,
      p_event_form_status: ^fdt$form_status;

    IF NOT p_form_status^.events_active THEN
      RETURN;
    IFEND;

{ Translate Screen Manager event to Screen Formatting event trigger.

    CASE fdv$screen_status.event_identifier.event_type OF

    = csc$timeout_event =
      event_recognized := TRUE;
      event_trigger := fdc$time_out;

    = csc$page_event =
      CASE fdv$screen_status.event_identifier.page_event.event_type OF

      = csc$locate =
        event_recognized := TRUE;
        event_trigger := fdc$pick;

      = csc$page_standard_function =
        event_recognized := TRUE;
        event_trigger := standard_event_table [fdv$screen_status.event_identifier.page_event.
              standard_function];

      = csc$page_application_function =
        event_recognized := TRUE;
        event_trigger := fdv$application_event_table [fdv$screen_status.event_identifier.page_event.
              application_function];

      = csc$page_screen =
        event_recognized := TRUE;
        event_trigger := screen_event_table [fdv$screen_status.event_identifier.page_event.screen_event];

      ELSE
        RETURN;
      CASEND;

    = csc$field_event =
      CASE fdv$screen_status.event_identifier.field_event.event_type OF

      = csc$pick =
        event_recognized := TRUE;
        event_trigger := fdc$pick;

      = csc$field_screen =
        event_recognized := TRUE;
        event_trigger := screen_event_table [fdv$screen_status.event_identifier.field_event.screen_event];

      = csc$field_standard_function =
        event_recognized := TRUE;
        event_trigger := standard_event_table [fdv$screen_status.event_identifier.field_event.
              standard_function];

      = csc$field_application_function =
        event_recognized := TRUE;
        event_trigger := fdv$application_event_table [fdv$screen_status.event_identifier.field_event.
              application_function];

      ELSE { Event is not recognized.
        RETURN;
      CASEND;
    ELSE { Event is not recognized.
      RETURN;
    CASEND;

    IF p_form_status^.added THEN

{ Translate Screen Formatting event trigger to application program event name.
{ Use only event definitions of added form.

      FOR event_index := 1 TO p_form_status^.p_form_definition^.event_definitions.active_number DO
        p_event_definition := ^p_form_status^.p_event_definitions^ [event_index];
        IF (p_form_status^.p_form_event_statuses^ [event_index].event_exists AND
              (p_form_status^.p_form_event_statuses^ [event_index].event_trigger =
              event_trigger)) THEN
          event_action := p_event_definition^.event_action;
          event_name := p_event_definition^.event_name;
          event_defined := TRUE;
          RETURN;
        IFEND;
      FOREND;

    ELSE

{ This is a combined form.

      p_event_form_status := ^fdv$screen_status.p_forms_status^ [p_form_status^.added_form_identifier];

      IF p_form_status^.combined_events THEN

{ Use event definitions of combined form and added form.  The event definition of
{ the combined form is used if present; otherwise the event of the added form
{ is used.  Translate Screen Formatting event trigger to
{ application program event name.

        FOR event_index := 1 TO p_form_status^.p_form_definition^.event_definitions.active_number DO
          p_event_definition := ^p_form_status^.p_event_definitions^ [event_index];
          IF (p_form_status^.p_form_event_statuses^ [event_index].event_exists AND
                (p_form_status^.p_form_event_statuses^ [event_index].event_trigger =
                      event_trigger)) THEN
            event_action := p_event_definition^.event_action;
            event_name := p_event_definition^.event_name;
            event_defined := TRUE;
            RETURN;
          IFEND;
        FOREND;

        FOR event_index := 1 TO p_event_form_status^.p_form_definition^.event_definitions.active_number DO
          p_event_definition := ^p_event_form_status^.p_event_definitions^ [event_index];
          IF (p_event_form_status^.p_form_event_statuses^ [event_index].event_exists AND
                (p_event_form_status^.p_form_event_statuses^ [event_index].event_trigger =
                      event_trigger)) THEN
            event_action := p_event_definition^.event_action;
            event_name := p_event_definition^.event_name;
            event_defined := TRUE;
            RETURN;
          IFEND;
        FOREND;

      ELSE

{ The events are not combined.  Use the events of the added form.

        FOR event_index := 1 TO p_event_form_status^.p_form_definition^.event_definitions.active_number DO
          p_event_definition := ^p_event_form_status^.p_event_definitions^ [event_index];
          IF (p_event_form_status^.p_form_event_statuses^ [event_index].event_exists AND
                (p_event_form_status^.p_form_event_statuses^ [event_index].event_trigger =
                      event_trigger)) THEN
            event_action := p_event_definition^.event_action;
            event_name := p_event_definition^.event_name;
            event_defined := TRUE;
            RETURN;
          IFEND;
        FOREND;
      IFEND;
    IFEND;

  PROCEND translate_screen_event;

?? OLDTITLE, EJECT ??

    status.normal := TRUE;
    bad_key_displayed := FALSE;
    event_highlighted := FALSE;

    REPEAT
      flush_events := TRUE;

{ Do not flush buffer on most page events. For example, do not lose the
{ carriage return for the home key. On a clear screen event, the
{ Screen Manager has already cleared the screen, just remove the
{ the following events to make the application behave well.

      CASE fdv$screen_status.event_identifier.event_type OF

      = csc$page_event =
        CASE fdv$screen_status.event_identifier.page_event.event_type OF

        = csc$page_screen =
          IF fdv$screen_status.event_identifier.page_event.screen_event <> csc$clear THEN
            flush_events := FALSE;
          IFEND;

        ELSE
        CASEND;

      = csc$field_event =
        CASE fdv$screen_status.event_identifier.field_event.event_type OF

        = csc$field_screen =
          IF fdv$screen_status.event_identifier.field_event.screen_event <> csc$clear THEN
            flush_events := FALSE;
          IFEND;

        ELSE
        CASEND;

      ELSE
      CASEND;

      IF flush_events THEN
        csv$vector.flush_events^ (terminal_status);
        IF NOT terminal_status.normal THEN
          fdp$convert_terminal_status (terminal_status, status);
          erase_message_form (local_status);
          RETURN;
        IFEND;
      IFEND;

      csv$vector.get_event^ (fdv$screen_status.event_identifier, terminal_status);
      IF NOT terminal_status.normal THEN
        fdp$convert_terminal_status (terminal_status, status);
        erase_message_form (local_status);
        RETURN;
      IFEND;

{ Update Screen Formatting screen data associated with all forms on the screen.
{ Updating program data about a form depends on the action specified with the
{ terminal user event.

      get_screen_variables;
      IF NOT status.normal THEN
        erase_message_form (local_status);
        RETURN;
      IFEND;

      event_defined := FALSE;
      event_on_message_form := FALSE;
      event_recognized := FALSE;
      form_object := FALSE;
      object_exists := FALSE;

{ All normal program, abnormal program, and ignore events will be processed
{ at the end of this CASE statement.


      CASE fdv$screen_status.event_identifier.event_type OF

      = csc$page_event =
        process_screen_page_event;

      = csc$field_event =
        field_number := fdv$screen_status.event_identifier.field_event_field_number;
        find_screen_identifier;
        IF p_form_status^.events_active THEN
          IF form_object THEN

{ The event occurred on an area of the form that contained no object.

            process_screen_form_event;


          ELSEIF object_exists THEN

{ The event occurred on a form area that contained an object.

            process_screen_object_event;

          IFEND;
        IFEND;

      = csc$timeout_event =
        erase_message_form (local_status);
        event_normal := FALSE;
        osp$set_status_abnormal (fdc$format_display_identifier,
              fde$terminal_timed_out, ' ', status);
        RETURN;

      ELSE { Invalid event type. }
        osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error, 'invalid event ', status);
      CASEND;

      IF NOT status.normal THEN
        erase_message_form (local_status);
        RETURN;
      IFEND;

      event_on_message_form :=
        (fdv$screen_status.message_form_displayed AND
        (fdv$screen_status.message_form_identifier = form_identifier));

    /process_program_return/
      BEGIN
        IF NOT event_defined THEN
          IF (event_recognized AND ((event_trigger = fdc$clear_screen)
                OR (event_trigger = fdc$home_cursor))) THEN
            erase_message_form (local_status);
            bad_key_displayed := FALSE;
            EXIT /process_program_return/;
          IFEND;

          IF NOT bad_key_displayed THEN
            erase_message_form (local_status);
            fdp$get_message (fde$system_bad_key_message, message_text);
            display_message_text (^message_text, osc$null_name, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            bad_key_displayed := TRUE;
          ELSE

{ Terminal user is confused.  The user depressed another bad key.
{ Remove bad key message.

            erase_message_form (local_status);
            bad_key_displayed := FALSE;
          IFEND;
          EXIT /process_program_return/;
        IFEND;

{ Event is defined.  Remove any previous bad key pressed message.

        IF bad_key_displayed THEN
          bad_key_displayed := FALSE;
          erase_message_form (local_status);
        IFEND;

        CASE event_action OF

        = fdc$return_program_normal =
          erase_message_form (local_status);
          IF event_on_message_form THEN
            EXIT /process_program_return/;
          IFEND;

{ Update the program records of combined forms where the event occurred.

          IF p_form_status^.combined THEN
            form_identifier := p_form_status^.added_form_identifier;
            p_form_status := ^fdv$screen_status.p_forms_status^ [form_identifier];
          IFEND;

          update_program_record (p_form_status, form_identifier, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          IF fdv$screen_status.message_form_displayed  THEN
            EXIT /process_program_return/;
          IFEND;

          current_form_identifier := fdv$screen_status.current_form_identifier;
          WHILE current_form_identifier <> 0 DO
            p_record_form_status := ^fdv$screen_status.p_forms_status^ [current_form_identifier];
            IF p_record_form_status^.entry_used THEN
              IF (p_record_form_status^.combined AND (p_record_form_status^.added_form_identifier =
                    form_identifier)) THEN
                update_program_record (p_record_form_status, current_form_identifier, status);
                IF NOT status.normal THEN
                  RETURN;
                IFEND;
                IF fdv$screen_status.message_form_displayed  THEN
                  EXIT /process_program_return/;
                IFEND;
              IFEND;
            IFEND;
            current_form_identifier := p_record_form_status^.next_lower_form;
          WHILEND;

{ Highlight event executed by terminal user on event menu form.

          highlight_event;
          event_normal := TRUE;
          RETURN;

        = fdc$return_program_abnormal =
          erase_message_form (local_status);
          IF event_on_message_form THEN
            EXIT /process_program_return/;
          IFEND;

{ Highlight event executed by terminal user on event menu form.

          highlight_event;
          event_normal := FALSE;
          RETURN;

        = fdc$ignore_event =
          erase_message_form (local_status);

{ Ignore this event and accept another event from the terminal user.
{ Set the cursor position because the Screen Manager assumes Screen Formatting maintains cursor.

          IF form_object OR object_exists THEN
            character_position := event_position.form_x_position;
            line_number := event_position.form_y_position;
            csv$vector.position_cursor^ (p_form_status^.field_number,
                  character_position, line_number,
                  output_character_position, output_line_position,
                  local_status);
          IFEND;
        ELSE

{ A page, scroll, or tab event occurred.
{ Leave error and help forms displayed while terminal user pages, scrolls, and tabs.

        CASEND;
      END /process_program_return/;

{ Process more events from terminal user.  Current event is processed by Screen Formatting
{ and not the application program. Highlight event pressed by terminal user.

      compute_event_highlight;
      IF event_highlighted THEN
        fdp$record_screen_change (highlight_event_change, local_status);
      IFEND;

      fdp$change_screen (local_status);
      fdv$screen_status.cursor_set := FALSE;
      IF event_highlighted THEN
        csv$vector.update_device^ (local_status);
        fdp$record_screen_change (reset_event_change, local_status);
        fdp$change_screen (local_status);
        event_highlighted := FALSE;
      IFEND;

    UNTIL FALSE;

  PROCEND fdp$get_screen_input;

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

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

    VAR
      dynamic_form: boolean,
      name_is_valid: boolean,
      p_form_definition: ^fdt$form_definition,
      p_form_module: ^fdt$form_module,
      p_form_status: ^fdt$form_status,
      screen_change: fdt$screen_change,
      screen_formatting_version: integer,
      valid_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$open_form;
        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$open_form;
        IFEND;

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

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

    PROCEDURE free_form_storage;

      IF p_form_status^.p_form_event_statuses <> NIL THEN
        FREE p_form_status^.p_form_event_statuses;
      IFEND;

      IF p_form_status^.p_screen_record <> NIL THEN
        FREE p_form_status^.p_screen_record;
      IFEND;

      IF p_form_status^.p_program_record <> NIL THEN
        FREE p_form_status^.p_program_record;
      IFEND;

      IF p_form_status^.p_form_object_statuses <> NIL THEN
        FREE p_form_status^.p_form_object_statuses;
      IFEND;

      IF p_form_status^.p_form_table_statuses <> NIL THEN
        FREE p_form_status^.p_form_table_statuses;
      IFEND;
    PROCEND free_form_storage;

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

    PROCEDURE allocate_form_storage;

      VAR
        object_index: fdt$object_index,
        p_form_definition: ^fdt$form_definition,
        p_form_object_statuses: ^array [1 .. * ] of fdt$form_object_status;


      status.normal := TRUE;
      free_form_storage;
      p_form_definition := p_form_status^.p_form_definition;
      IF p_form_definition^.screen_record_length <> 0 THEN

{ Allocate space for screen variable text. This is text the terminal user types in as
{ characters.

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

{ Allocate space for holding the record transfers to and from the
{ program. This record holds the data in program data types of real, integer, and character.

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

{ Allocate array for object status.
{ Object status holds the current display attributes and first displayed character for an object.
{ This information is used for scrolling and paging.

      IF p_form_definition^.form_object_definitions.active_number > 0 THEN
        ALLOCATE p_form_status^.p_form_object_statuses: [1 .. p_form_definition^.form_object_definitions.
              total_number];
        IF p_form_status^.p_form_object_statuses = NIL THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
          RETURN;
        IFEND;

        p_form_status^.active_form_object_statuses := p_form_definition^.form_object_definitions.total_number;
        p_form_status^.total_form_object_statuses := p_form_status^.active_form_object_statuses;
        p_form_object_statuses := p_form_status^.p_form_object_statuses;
        FOR object_index := 1 TO UPPERBOUND (p_form_object_statuses^) DO
          p_form_object_statuses^ [object_index].key := fdc$unused_identifier;
        FOREND;
      IFEND;

      IF p_form_definition^.form_table_definitions.active_number > 0 THEN

{ Allocate space to hold the current status for tables.
{ This records the first displayed occurrence of a table.
{ This information is used for scrolling and paging.

        ALLOCATE p_form_status^.p_form_table_statuses: [1 .. p_form_definition^.form_table_definitions.
              active_number];
        IF p_form_status^.p_form_table_statuses = NIL THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
          RETURN;
        IFEND;
      IFEND;

      IF p_form_definition^.event_definitions.active_number > 0 THEN

{ Allocate space to hold the currently assigned mapping of terminal function keys
{ to form events.

        ALLOCATE p_form_status^.p_form_event_statuses: [1 .. p_form_definition^.event_definitions.
              active_number];
        IF p_form_status^.p_form_event_statuses = NIL THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
          RETURN;
        IFEND;
      IFEND;
      p_form_status^.storage_allocated := TRUE;
    PROCEND allocate_form_storage;

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

    PROCEDURE initialize_form;

    VAR
      local_status: ost$status;

      p_form_status^.form_x_position := p_form_definition^.x_position;
      p_form_status^.form_y_position := p_form_definition^.y_position;

      allocate_form_storage;
      IF NOT status.normal THEN
        free_form_storage;
        p_form_status^.entry_used := FALSE;
        RETURN;
      IFEND;

      IF p_form_definition^.screen_formatting_version >= fdc$im_smart_capability THEN
        p_form_status^.invalid_data_character := p_form_definition^.invalid_data_character;
      ELSE
        p_form_status^.invalid_data_character.defined := FALSE;
      IFEND;

{ Move initial values of variables to screen and program record for form.

      fdp$initialize_form_record (form_identifier, p_form_status, FALSE, variable_status, status);
      IF NOT status.normal THEN
        free_form_storage;
        p_form_status^.entry_used := FALSE;
        RETURN;
      IFEND;

{ Set initial display attributes for form objects.

      fdp$initialize_form_objects (form_identifier, p_form_status, FALSE, local_status);

{ Assign terminal function keys to program events.

      fdp$create_form_events (form_identifier, p_form_definition^.display_attribute, status);
      p_form_status := ^fdv$screen_status.p_forms_status^ [form_identifier];
      IF NOT status.normal THEN
        free_form_storage;
        p_form_status^.entry_used := FALSE;
        RETURN;
      IFEND;

      screen_change.key := fdc$open_form;
      screen_change.open_form_identifier := form_identifier;
      fdp$record_screen_change (screen_change, status);
      IF NOT status.normal THEN
        free_form_storage;
        p_form_status^.entry_used := FALSE;
        RETURN;
      IFEND;
      p_form_status^.opened := TRUE;
    PROCEND initialize_form;

?? OLDTITLE, EJECT ??
    osp$establish_condition_handler (^condition_handler, FALSE);
    status.normal := TRUE;
    IF fdv$screen_status.p_forms_status <> NIL THEN

{ If user specifies a null form name, then the form identifier specifies the form to open.

      IF form_name = osc$null_name THEN
        IF ((form_identifier > 0) AND (form_identifier <= UPPERBOUND (fdv$screen_status.p_forms_status^)))
              THEN
          p_form_status := ^fdv$screen_status.p_forms_status^ [form_identifier];
          IF (p_form_status^.entry_used AND p_form_status^.defined_dynamically AND
                NOT p_form_status^.owned_by_system) THEN
            p_form_definition := p_form_status^.p_form_definition;
            IF p_form_definition^.form_ended THEN
              IF NOT p_form_status^.opened THEN
                initialize_form;
                RETURN;
              ELSE
                osp$set_status_abnormal (fdc$format_display_identifier, fde$form_already_open, form_name,
                      status);
                RETURN;
              IFEND;
            ELSE
              osp$set_status_abnormal (fdc$format_display_identifier, fde$form_not_ended, form_name, status);
              RETURN;
            IFEND;
          ELSE
            osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_form_identifier, '', status);
            osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (form_identifier), 10, FALSE,
                  status);
            RETURN;
          IFEND;
        ELSE
          osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_form_identifier, '', status);
          osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (form_identifier), 10, FALSE,
                status);
          RETURN;
        IFEND;
      IFEND;
    IFEND;

    clp$validate_name (form_name, valid_name, name_is_valid);
    IF NOT name_is_valid THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_form_name, form_name, status);
      RETURN;
    IFEND;

{ Search dynamically created forms for form name.
{ These forms are in memory, not in a library.

    IF fdv$screen_status.p_forms_status <> NIL THEN

    /find_dynamic_form/
      FOR form_identifier := LOWERBOUND (fdv$screen_status.p_forms_status^)
            TO UPPERBOUND (fdv$screen_status.p_forms_status^) DO
        p_form_status := ^fdv$screen_status.p_forms_status^ [form_identifier];
        IF (p_form_status^.entry_used AND p_form_status^.defined_dynamically AND
              NOT p_form_status^.owned_by_system) THEN
          p_form_definition := p_form_status^.p_form_definition;
          IF p_form_definition^.form_ended THEN
            IF valid_name = p_form_definition^.form_name THEN
              IF NOT p_form_status^.opened THEN
                initialize_form;
                RETURN;
              ELSE
                osp$set_status_abnormal (fdc$format_display_identifier, fde$form_already_open, form_name,
                      status);
                RETURN;
              IFEND;
            IFEND;
          IFEND;
        IFEND;
      FOREND /find_dynamic_form/;
    IFEND;

{ Search forms in command list for form name.

    clp$find_form (valid_name, p_form_module, status);
    IF ((NOT status.normal) OR (p_form_module = NIL)) THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$unknown_form_name, form_name, status);
      RETURN;
    IFEND;

    RESET p_form_module;
    i#move (^p_form_module^, ^screen_formatting_version, fdc$integer_length);
    IF (screen_formatting_version < fdc$basic_capability) THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$form_requires_conversion, form_name,
            status);
      RETURN;
    IFEND;

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

{ Create pointers to often used arrays to make access efficient during
{ form interaction with the terminal user.

    p_form_status^.p_form_module := p_form_module;
    NEXT p_form_definition IN p_form_module;
    p_form_status^.p_form_definition := p_form_definition;
    p_form_status^.p_form_variable_definitions := fdp$ptr_variables (p_form_status);
    p_form_status^.p_form_object_definitions := fdp$ptr_objects (p_form_status);
    p_form_status^.p_form_table_definitions := fdp$ptr_tables (p_form_status);
    p_form_status^.p_form_record_definitions := fdp$ptr_record_definitions (p_form_status);
    p_form_status^.p_event_definitions := fdp$ptr_events (p_form_status);
    p_form_status^.p_display_definitions := fdp$ptr_displays (p_form_status);
    initialize_form;
  PROCEND fdp$open_form;


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

  PROCEDURE [XDCL] fdp$read_forms
    (VAR status: ost$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$read_forms;
        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$read_forms;
        IFEND;

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

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

{ PURPOSE:
{   This procedure performs the pre-processing that is required for each active form.
{
{ NOTES:
{   At least one event must be active for terminal user input.

    PROCEDURE [INLINE] process_active_forms;

      VAR
        current_form_identifier: fdt$current_form_identifier,
        event_found: boolean,
        event_index: fdt$event_index,
        p_form_status: ^fdt$form_status,
        p_form_event_statuses: ^array [1 .. * ] of fdt$form_event_status,
        reset_read_forms_index: boolean;


      event_found := FALSE;
      IF fdv$screen_status.read_forms_index < fdc$maximum_read_forms_index THEN
        fdv$screen_status.read_forms_index := fdv$screen_status.read_forms_index + 1;
        reset_read_forms_index := FALSE;
      ELSE
        fdv$screen_status.read_forms_index := 1;
        reset_read_forms_index := TRUE;
      IFEND;

      IF fdv$screen_status.current_form_identifier <> 0 THEN
        current_form_identifier := fdv$screen_status.current_form_identifier;

        REPEAT
          p_form_status := ^fdv$screen_status.p_forms_status^ [current_form_identifier];
          IF p_form_status^.push_count = 0 THEN
            p_form_status^.changed_variable_search.status := fdc$not_searched;
            p_form_status^.input_error_search.status := fdc$not_searched;
            p_form_status^.output_error_search.status := fdc$search_not_allowed;
            IF p_form_status^.events_active THEN
              p_form_event_statuses := p_form_status^.p_form_event_statuses;
              IF (NOT event_found) AND (p_form_event_statuses <> NIL) THEN

              /find_event/
                FOR event_index := LOWERBOUND (p_form_event_statuses^)
                      TO UPPERBOUND (p_form_event_statuses^) DO
                  IF p_form_event_statuses^ [event_index].event_exists THEN
                    event_found := TRUE;
                    EXIT /find_event/;
                  IFEND;
                FOREND /find_event/;
              IFEND;
            IFEND;
          IFEND;
          IF reset_read_forms_index THEN
            reset_read_forms_indices (current_form_identifier);
          IFEND;
          current_form_identifier := p_form_status^.next_lower_form;
        UNTIL current_form_identifier = 0;

      IFEND;

      IF NOT event_found THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$no_events_active, '', status);
      IFEND;

    PROCEND process_active_forms;
?? OLDTITLE ??

    osp$establish_condition_handler (^condition_handler, FALSE);
    status.normal := TRUE;
    IF fdv$screen_status.p_forms_status = NIL THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$no_forms_to_read, '', status);
      RETURN;
    IFEND;

{ Send all screen changes to the Screen Manager.

    fdp$change_screen (status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF fdv$screen_status.number_active_forms = 0 THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$no_forms_to_read, '', status);
      RETURN;
    IFEND;

{ Do pre-processing for all active forms.

    process_active_forms;
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    fdp$set_screen_cursor (status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ Process the data entry of the terminal user.

    fdp$get_screen_input (fdv$screen_status.event_name, fdv$screen_status.event_normal,
          fdv$screen_status.event_position, status);

  PROCEND fdp$read_forms;

?? TITLE := 'fdp$set_line_mode', EJECT ??
*copy fdh$set_line_mode

  PROCEDURE [XDCL] fdp$set_line_mode
    (VAR status: ost$status);

    VAR
      form_identifier: fdt$form_identifier,
      local_status: ost$status,
      p_form_status: ^fdt$form_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$set_line_mode;
        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$set_line_mode;
        IFEND;

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

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

  PROCEDURE initialize_screen_status
    (VAR status: ost$status);

    IF fdv$screen_status.p_screen_changes <> NIL THEN
      FREE fdv$screen_status.p_screen_changes;
    IFEND;

    IF fdv$screen_status.p_screen_event_statuses <> NIL THEN
      FREE fdv$screen_status.p_screen_event_statuses;
    IFEND;

   fdv$screen_status.compute_new_screen_size := TRUE;
   fdv$screen_status.current_form_identifier := 0;
   fdv$screen_status.current_push_count := 0;
   fdv$screen_status.current_screen_height := 1;
   fdv$screen_status.current_screen_width := 1;
   fdv$screen_status.cursor_set := FALSE;
   fdv$screen_status.error_attribute_displayed := FALSE;
   fdv$screen_status.last_cursor_position_valid := FALSE;
   fdv$screen_status.message_form_displayed := FALSE;
   fdv$screen_status.number_active_forms := 0;
   fdv$screen_status.number_screen_changes := 0;
   fdv$screen_status.read_forms_index := 1;
   fdv$screen_status.screen_mode_active := FALSE;

   csv$vector.change_capability_level^ (csc$line_level, status);
   status.normal := TRUE;
  PROCEND initialize_screen_status;

?? OLDTITLE, EJECT ??
    osp$establish_condition_handler (^condition_handler, FALSE);
    status.normal := TRUE;
    IF fdv$screen_status.p_forms_status = NIL THEN
      initialize_screen_status (status);
      RETURN;
    IFEND;

{ Deallocate resources held by all forms.

    /free_form_resources/
    FOR form_identifier := LOWERBOUND (fdv$screen_status.p_forms_status^)
        TO UPPERBOUND (fdv$screen_status.p_forms_status^) DO
      p_form_status := ^fdv$screen_status.p_forms_status^ [form_identifier];
      IF NOT (p_form_status^.entry_used AND p_form_status^.opened) THEN
        CYCLE /free_form_resources/;
      IFEND;

      IF p_form_status^.p_form_object_statuses <> NIL THEN
        FREE p_form_status^.p_form_object_statuses;
      IFEND;

      IF p_form_status^.defined_dynamically THEN
        mmp$delete_scratch_segment (p_form_status^.segment_pointer, local_status);
      IFEND;

      IF p_form_status^.p_program_record <> NIL THEN
        FREE p_form_status^.p_program_record;
      IFEND;

      IF p_form_status^.p_screen_record <> NIL THEN
        FREE p_form_status^.p_screen_record;
      IFEND;

      IF p_form_status^.p_form_table_statuses <> NIL THEN
        FREE p_form_status^.p_form_table_statuses;
      IFEND;

      IF p_form_status^.p_form_event_statuses <> NIL THEN
        FREE p_form_status^.p_form_event_statuses;
      IFEND;

      IF p_form_status^.p_form_image <> NIL THEN
        FREE p_form_status^.p_form_image;
      IFEND;

    FOREND /free_form_resources/;

    FREE fdv$screen_status.p_forms_status;
    initialize_screen_status (status);
  PROCEND fdp$set_line_mode;
?? TITLE := 'fdp$set_screen_cursor', EJECT ??
*copyc fdh$set_screen_cursor

  PROCEDURE [XDCL] fdp$set_screen_cursor
    (VAR status: ost$status);

    VAR
      character_position: cst$character_position,
      current_form_identifier: fdt$current_form_identifier,
      field_number: cst$field_number,
      line_number: cst$line_number,
      p_form_definition: ^fdt$form_definition,
      p_form_status: ^fdt$form_status,
      terminal_status: ost$status;

    status.normal := TRUE;
    IF fdv$screen_status.cursor_set THEN

{ The application program set the cursor position. Do nothing else.

      fdv$screen_status.cursor_set := FALSE;

    ELSEIF fdv$screen_status.last_cursor_position_valid THEN
      p_form_status := ^fdv$screen_status.p_forms_status^ [fdv$screen_status.last_cursor_form_identifier];
      IF p_form_status^.design_form THEN

{ Position the cursor on the last event position for a design form.

        csv$vector.position_cursor^ (p_form_status^.field_number, p_form_status^
             .last_cursor_form_x_position, p_form_status^.last_cursor_form_y_position,
             character_position, line_number, terminal_status);

      ELSE

{ The form is not a design form.
{ Position cursor on first input variable if one exists.

        p_form_definition := p_form_status^.p_form_definition;
        IF p_form_definition^.first_input_object_defined THEN
          field_number := p_form_status^.p_form_object_statuses^
                [p_form_definition^.first_input_object_index].field_number;
          csv$vector.position_cursor^ (field_number, 1, 1, character_position, line_number,
                terminal_status);
        ELSE

{ If no input or input/output variable exists position the cursor on the upper
{ left corner of the form.

          csv$vector.position_cursor^ (p_form_status^.field_number, 1, 1, character_position,
                line_number, terminal_status);
        IFEND;
      IFEND;

{ Forms have been added or deleted.  Place the cursor on the highest priority
{ form.

    ELSEIF fdv$screen_status.current_form_identifier <> 0 THEN
      current_form_identifier := fdv$screen_status.current_form_identifier;

    /find_cursor/
      BEGIN
        REPEAT
          p_form_status := ^fdv$screen_status.p_forms_status^ [current_form_identifier];
          IF p_form_status^.events_active THEN
            IF p_form_status^.added OR p_form_status^.combined THEN
              IF p_form_status^.design_form AND
                    p_form_status^.last_cursor_position_valid THEN
                csv$vector.position_cursor^ (p_form_status^.field_number, p_form_status^
                      .last_cursor_form_x_position, p_form_status^.last_cursor_form_y_position,
                      character_position, line_number, terminal_status);
                EXIT /find_cursor/;
              IFEND;

              p_form_definition := p_form_status^.p_form_definition;
              IF p_form_definition^.first_input_object_defined THEN
                field_number := p_form_status^.p_form_object_statuses^
                      [p_form_definition^.first_input_object_index].field_number;
                csv$vector.position_cursor^ (field_number, 1, 1, character_position, line_number,
                      terminal_status);
                EXIT /find_cursor/;
              IFEND;

              IF p_form_status^.p_event_definitions <> NIL THEN
                csv$vector.position_cursor^ (p_form_status^.field_number, 1, 1, character_position,
                      line_number, terminal_status);
                EXIT /find_cursor/;
              IFEND;
            IFEND;
          IFEND;
          current_form_identifier := p_form_status^.next_lower_form;
        UNTIL current_form_identifier = 0;
      END /find_cursor/;
    IFEND;

  PROCEND fdp$set_screen_cursor;

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

  PROCEDURE [XDCL] fdp$show_forms
    (VAR status: ost$status);

    VAR
      terminal_status: ost$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$show_forms;
        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$show_forms;
        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);
    status.normal := TRUE;

    IF fdv$screen_status.p_forms_status = NIL THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$no_forms_to_show, '', status);
      RETURN;
    IFEND;

{ Send terminal screen changes to Screen Manager.

    fdp$change_screen (status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF fdv$screen_status.number_active_forms = 0 THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$no_forms_to_show, '', status);
      RETURN;
    IFEND;

{ Display all changes to the screen.  No input is expected from the
{ terminal user.

    fdp$set_screen_cursor (status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    fdp$update_screen (status);

  PROCEND fdp$show_forms;

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

  PROCEDURE [XDCL] fdp$tab_to_next_field
    (VAR status: ost$status);

    VAR
      form_status: fdt$form_status,
      object_index: fdt$object_index,
      p_form_status: ^fdt$form_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$tab_to_next_field;
        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$tab_to_next_field;
        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);
    status.normal := TRUE;
    IF (fdv$screen_status.p_forms_status = NIL) OR (fdv$screen_status.number_active_forms = 0) THEN
      osp$set_status_condition (fde$no_forms_are_scheduled, status);
      RETURN;
    IFEND;

    fdp$find_form_status (fdv$screen_status.event_position.form_identifier, p_form_status, status);
    IF NOT status.normal THEN

{ The form that the last event was entered from is now closed.  Leave cursor alone.  This is not an error
{ condition.

      RETURN;
    IFEND;

    IF (NOT (p_form_status^.added OR p_form_status^.combined)) OR (NOT p_form_status^.displayed_on_screen) OR
            (p_form_status^.p_form_definition^.form_object_definitions.active_number < 1) THEN

{ Either the form that the last event was entered from is no longer on the screen or it has no objects.
{ Leave cursor alone.  This is not an error condition.

      RETURN;
    IFEND;

    fdp$find_next_object (fdv$screen_status.event_position.form_x_position,
         fdv$screen_status.event_position.form_y_position, p_form_status, object_index);

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

  PROCEND fdp$tab_to_next_field;

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

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

    VAR
      end_object_index: fdt$object_index,
      ignore_character_position: cst$character_position,
      ignore_line_number: cst$line_number,
      next_object_index: fdt$object_index,
      p_form_variable_definition: ^fdt$form_variable_definition,
      p_form_variable_definitions: ^array [1 .. * ] of fdt$form_variable_definition,
      p_form_object_definition: ^fdt$form_object_definition,
      p_form_object_definitions: ^array [1 .. * ] of fdt$form_object_definition,
      p_parent_object_definition: ^fdt$form_object_definition,
      start_object_index: fdt$object_index,
      terminal_status: ost$status;

?? NEWTITLE := 'check_variable', EJECT ??

{ PURPOSE:
{   This procedure verifies that the variable field is a valid input field and positions the cursor to it.
{ NOTES:
{   The field must be an input field and it must not be covered by another form.
{

    PROCEDURE [INLINE] check_variable;

      IF ((p_form_variable_definition^.io_mode = fdc$terminal_input) OR
            (p_form_variable_definition^.io_mode = fdc$terminal_input_output)) AND
            (NOT (fdc$protect IN
            p_form_status^.p_form_object_statuses^ [next_object_index].display_attribute_set)) AND
            (NOT location_covered_by_form (p_form_status, p_form_object_definition^.x_position +
            p_form_status^.form_x_position - 1, p_form_object_definition^.y_position +
            p_form_status^.form_y_position - 1)) THEN
        csv$vector.position_cursor^ (p_form_status^.p_form_object_statuses^ [next_object_index].field_number,
              1, 1, ignore_character_position, ignore_line_number, terminal_status);
        IF NOT terminal_status.normal THEN
          fdp$convert_terminal_status (terminal_status, status);
        IFEND;
        fdv$screen_status.cursor_set := TRUE;
        EXIT fdp$tab_to_next_variable;
      IFEND;

    PROCEND check_variable;
?? OLDTITLE, EJECT ??
?? NEWTITLE := 'search_object_definitions', EJECT ??

{ PURPOSE:
{   This procedure finds the next input variable in the form.
{ DESIGN:
{   The procedure searches the object definitions which are ordered by location.
{ NOTES:
{   Tabbing can only occur to a variable that has an input or input/output mode.

    PROCEDURE [INLINE] search_object_definitions;

      FOR next_object_index := start_object_index TO end_object_index DO
        p_form_object_definition := ^p_form_object_definitions^ [next_object_index];
        CASE p_form_object_definition^.key OF

        = fdc$form_variable_text =
          p_form_variable_definition := ^p_form_variable_definitions^
                [p_form_object_definition^.text_variable_index];
          check_variable;

{ If the variable checks out, a non-local EXIT is performed and control does not return here.

        = fdc$form_variable_text_box =
          p_form_variable_definition := ^p_form_variable_definitions^
                [p_form_object_definition^.variable_box_variable_index];
          check_variable;

{ If the variable checks out, a non-local EXIT is performed and control does not return here.

        = fdc$form_text_box_fragment =
          p_parent_object_definition := ^p_form_object_definitions^
                [p_form_object_definition^.parent_text_box_object_index];
          IF (p_parent_object_definition^.key = fdc$form_variable_text_box) THEN
            p_form_variable_definition := ^p_form_variable_definitions^
                  [p_parent_object_definition^.variable_box_variable_index];
            check_variable;

{ If the variable checks out, a non-local EXIT is performed and control does not return here.

          IFEND;
        ELSE

{ Other objects are ignored.

        CASEND;
      FOREND;

    PROCEND search_object_definitions;
?? OLDTITLE, EJECT ??
    status.normal := TRUE;
    p_form_variable_definitions := p_form_status^.p_form_variable_definitions;
    p_form_object_definitions := p_form_status^.p_form_object_definitions;

    end_object_index := p_form_status^.p_form_definition^.form_object_definitions.active_number;
    IF object_index <= end_object_index THEN
      start_object_index := object_index;
      search_object_definitions;

{ If the next variable is found, a non-local EXIT is performed and control does not return here.

      end_object_index := start_object_index;
    IFEND;

{ Wrap around to beginning of form and then try to find an input field.

    start_object_index := 1;
    search_object_definitions;

{ No input variable was found in the form.  The cursor position is not changed and no error is generated.

  PROCEND fdp$tab_to_next_variable;

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

  PROCEDURE [XDCL] fdp$update_screen
    (VAR status: ost$status);

    VAR
      terminal_status: ost$status;

    status.normal := TRUE;
    csv$vector.update_device^ (terminal_status);
    IF NOT status.normal THEN
      fdp$convert_terminal_status (terminal_status, status);
    IFEND;

  PROCEND fdp$update_screen;

?? TITLE := 'add_screen_constant_text_box', EJECT ??

  PROCEDURE add_screen_constant_text_box
    (    x_position: fdt$x_position;
         y_position: fdt$y_position;
         object_index: fdt$object_index;
         p_form_status: ^fdt$form_status;
     VAR status: ost$status);

    VAR
      boundary_processing: cst$boundary_processing,
      current_y_position: fdt$y_position,
      data_characters: cst$character_position,
      display_attribute_set: fdt$display_attribute_set,
      field_number: cst$field_number,
      fragment_object_index: fdt$object_index,
      next_object_index: fdt$object_index,
      p_text: ^fdt$text,
      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,
      screen_visible_length: fdt$screen_variable_length,
      target_position: fdt$target_position,
      terminal_status: ost$status,
      visible_characters: cst$visible_character_position;

    p_form_object_definitions := p_form_status^.p_form_object_definitions;
    p_form_object_definition := ^p_form_object_definitions^ [object_index];
    boundary_processing.boundary_type := csc$clip;

{ Create first line of text box.

    visible_characters := p_form_object_definition^.constant_box_width;

{ If form uses hidden editing create Screen Manager field with twice the width of the
{ object.  Otherwise, create a field with the width of the object.

    IF p_form_status^.p_form_definition^.hidden_editing THEN
      data_characters := p_form_object_definition^.constant_box_width *
            fdc$hidden_editing_multiplier;
      IF (data_characters > csc$max_string) THEN
        data_characters := csc$max_string;
      IFEND;
    ELSE
      data_characters := p_form_object_definition^.constant_box_width;
    IFEND;
    csv$vector.create_field^ (x_position, y_position, visible_characters, 1, data_characters,
          1, FALSE, TRUE, csc$no_justification, boundary_processing, field_number,
          terminal_status);
    IF NOT terminal_status.normal THEN
      fdp$convert_terminal_status (terminal_status, status);
      RETURN;
    IFEND;

    display_attribute_set := p_form_object_definition^.display_attribute;
    p_form_object_statuses := p_form_status^.p_form_object_statuses;
    p_form_object_statuses^ [object_index].display_attribute_set := display_attribute_set;
    p_form_object_statuses^ [object_index].key := fdc$field_identifier;
    p_form_object_statuses^ [object_index].field_number := field_number;
    p_form_object_statuses^ [object_index].character_position := 1;
    p_form_object_statuses^ [object_index].data_length := data_characters;
    put_text_attribute (field_number, display_attribute_set, fdc$terminal_output, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ Create second, third, and so on lines of text box.  These lines are called fragments.
{ Objects for these lines are linked to the first line.
{ The first line is called the parent.

    fragment_object_index := p_form_object_definition^.constant_box_fragment_index;
    current_y_position := y_position;
    WHILE fragment_object_index <> 0 DO
      current_y_position := current_y_position + 1;
      csv$vector.create_field^ (x_position, current_y_position, visible_characters, 1, data_characters,
            1, FALSE, TRUE, csc$no_justification, boundary_processing, field_number, terminal_status);
      IF NOT terminal_status.normal THEN
        fdp$convert_terminal_status (terminal_status, status);
        RETURN;
      IFEND;

      p_form_object_statuses^ [fragment_object_index].display_attribute_set := display_attribute_set;
      p_form_object_statuses^ [fragment_object_index].key := fdc$field_identifier;
      p_form_object_statuses^ [fragment_object_index].field_number := field_number;
      p_form_object_statuses^ [fragment_object_index].character_position := 1;
      put_text_attribute (field_number, display_attribute_set, fdc$terminal_output, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

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

    next_object_index := p_form_object_definition^.constant_box_fragment_index;
    p_text := fdp$ptr_text (p_form_object_definition^.constant_box_text, p_form_status^.p_form_module);
    target_position.key := fdc$page_data_first;
    format_screen_text (p_text, p_form_status, object_index, next_object_index,
          p_form_object_definition^.constant_box_processing, p_form_object_definition^.constant_box_width,
          p_form_object_definition^.constant_box_height, target_position, status);
  PROCEND add_screen_constant_text_box;

?? TITLE := 'add_screen_object', EJECT ??

  PROCEDURE add_screen_object
    (    p_form_status: ^fdt$form_status;
         object_definition: fdt$form_object_definition;
         object_index: fdt$object_index;
     VAR status: ost$status);

    VAR
      boundary_processing: cst$boundary_processing,
      character_index: cst$character_position,
      data_characters: cst$character_position,
      field_number: cst$field_number,
      graphic_identifier: cst$graphic_identifier,
      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_object_statuses: ^array [1 .. * ] of fdt$form_object_status,
      p_text: ^fdt$text,
      target_position: fdt$target_position,
      terminal_status: ost$status,
      visible_characters: cst$visible_character_position,
      x_position: cst$x_position,
      y_position: cst$y_position;

    status.normal := TRUE;
    p_form_object_statuses := p_form_status^.p_form_object_statuses;
    p_form_object_definitions := p_form_status^.p_form_object_definitions;
    p_form_module := p_form_status^.p_form_module;
    p_form_definition := p_form_status^.p_form_definition;
    p_form_object_definition := ^p_form_status^.p_form_object_definitions^ [object_index];
    x_position := object_definition.x_position + p_form_status^.form_x_position - 1;
    y_position := object_definition.y_position + p_form_status^.form_y_position - 1;
    CASE object_definition.key OF

    = fdc$form_box =
      create_screen_box (x_position, y_position, object_definition.box_width, object_definition.box_height,
            p_form_object_definition^.display_attribute, graphic_identifier, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      p_form_object_statuses^ [object_index].key := fdc$graphic_identifier;
      p_form_object_statuses^ [object_index].graphic_identifier := graphic_identifier;
      p_form_object_statuses^ [object_index].display_attribute_set := object_definition.display_attribute;

    = fdc$form_line =
      create_screen_line (x_position, y_position, object_definition.x_increment,
            object_definition.y_increment, p_form_object_definition^.display_attribute, graphic_identifier,
            status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      p_form_object_statuses^ [object_index].key := fdc$graphic_identifier;
      p_form_object_statuses^ [object_index].graphic_identifier := graphic_identifier;
      p_form_object_statuses^ [object_index].display_attribute_set := object_definition.display_attribute;

    = fdc$form_constant_text_box =
      p_form_object_definition := ^p_form_object_definitions^ [object_index];
      add_screen_constant_text_box (x_position, y_position, object_index, p_form_status, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

    = fdc$form_constant_text =
      p_text := fdp$ptr_text (object_definition.constant_text, p_form_module);
      visible_characters := object_definition.constant_text_width;
      IF p_form_status^.p_form_definition^.hidden_editing THEN
          data_characters := STRLENGTH (p_text^);
        ELSE
          data_characters := visible_characters;
      IFEND;

      boundary_processing.boundary_type := csc$clip;
      csv$vector.create_field^ (x_position, y_position, visible_characters, 1, data_characters, 1,
            FALSE, TRUE, csc$no_justification, boundary_processing, field_number, terminal_status);
      IF NOT terminal_status.normal THEN
        fdp$convert_terminal_status (terminal_status, status);
        RETURN;
      IFEND;

      p_form_object_statuses^ [object_index].key := fdc$field_identifier;
      p_form_object_statuses^ [object_index].field_number := field_number;
      p_form_object_statuses^ [object_index].character_position := 1;
      p_form_object_statuses^ [object_index].data_length := data_characters;
      target_position.key := fdc$current_data_position;
      replace_screen_variable (p_text, object_index, object_index, visible_characters,
            p_form_status, target_position, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      p_form_object_statuses^ [object_index].display_attribute_set := object_definition.display_attribute;
      put_text_attribute (field_number, object_definition.display_attribute, fdc$terminal_output, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

    = fdc$form_stored_variable =

{ Do nothing.  A stored variable has no screen representation.

    ELSE { fdc$form_text_box_fragment }

{ Do nothing now.  This object is created when the associated constant or variable text box
{ is processed.

    CASEND;
  PROCEND add_screen_object;

?? TITLE := 'compute_cursor_shift', EJECT ??

  PROCEDURE [INLINE] compute_cursor_shift
    (    width: fdt$width;
         first_character_position: fdt$character_position;
         cursor_character_position: fdt$character_position;
     VAR shift: integer);

    VAR
      last_character_position: integer;

    last_character_position := first_character_position + width - 1;

{ Determine shift to make character position visibile.

    IF cursor_character_position < first_character_position THEN

{ Scroll text backward.

        shift := cursor_character_position - first_character_position;

    ELSEIF cursor_character_position > last_character_position THEN

{ Scroll text forward.

      shift := cursor_character_position - first_character_position;

    ELSE

{ The text cursor character is visible.  No shift is necessary.

      shift := 0;
    IFEND;
  PROCEND compute_cursor_shift;


?? TITLE := 'compute_forward_scroll', EJECT ??

?? TITLE := 'create_screen_box', EJECT ??

  PROCEDURE create_screen_box
    (    x_position: cst$x_position;
         y_position: cst$y_position;
         box_width: fdt$width;
         box_height: fdt$height;
         display_attribute_set: fdt$display_attribute_set;
     VAR graphic_identifier: cst$graphic_identifier;
     VAR status: ost$status);

    VAR
      box_coordinates: array [1 .. 5] of cst$xy_coordinate,
      intersection_types: array [1 .. 4] of cst$intersection_type,
      terminal_status: ost$status,
      xy_coordinates: array [1 .. 4] of cst$xy_coordinate;

    status.normal := TRUE;

    { Create vertical and horizontal lines for box.

    box_coordinates [1].x := x_position;
    box_coordinates [1].y := y_position;
    box_coordinates [2].x := box_width + x_position - 1;
    box_coordinates [2].y := y_position;
    box_coordinates [3].x := box_coordinates [2].x;
    box_coordinates [3].y := y_position + box_height - 1;
    box_coordinates [4].x := x_position;
    box_coordinates [4].y := box_coordinates [3].y;
    box_coordinates [5].x := x_position;
    box_coordinates [5].y := y_position;

    csv$vector.poly_hv_line^ (box_coordinates, graphic_identifier, terminal_status);
    IF NOT terminal_status.normal THEN
      fdp$convert_terminal_status (terminal_status, status);
      RETURN;
    IFEND;

    put_graphic_attribute (graphic_identifier, display_attribute_set, status);
    IF NOT status.normal THEN
      fdp$convert_terminal_status (terminal_status, status);
      RETURN;
    IFEND;

{ Create intersections for vertical and horizontal lines of box.

    intersection_types [1] := csc$upper_left;
    intersection_types [2] := csc$upper_right;
    intersection_types [3] := csc$lower_right;
    intersection_types [4] := csc$lower_left;
    xy_coordinates [1].x := x_position;
    xy_coordinates [1].y := y_position;
    xy_coordinates [2].y := y_position;
    xy_coordinates [2].x := x_position + box_width - 1;
    xy_coordinates [3].y := y_position + box_height - 1;
    xy_coordinates [3].x := x_position + box_width - 1;
    xy_coordinates [4].y := y_position + box_height - 1;
    xy_coordinates [4].x := x_position;
    csv$vector.poly_intersect^ (graphic_identifier, xy_coordinates, intersection_types, terminal_status);
    IF NOT terminal_status.normal THEN
      fdp$convert_terminal_status (terminal_status, status);
    IFEND;

  PROCEND create_screen_box;

?? TITLE := 'create_screen_line', EJECT ??

  PROCEDURE create_screen_line
    (    x_position: cst$x_position;
         y_position: cst$x_position;
         x_increment: fdt$x_increment;
         y_increment: fdt$y_increment;
         display_attribute_set: fdt$display_attribute_set;
     VAR graphic_identifier: cst$graphic_identifier;
     VAR status: ost$status);

    VAR
      line_coordinates: array [1 .. 2] of cst$xy_coordinate,
      terminal_status: ost$status;

    status.normal := TRUE;
    line_coordinates [1].x := x_position;
    line_coordinates [1].y := y_position;
    line_coordinates [2].x := x_position + x_increment;
    line_coordinates [2].y := y_position + y_increment;

    csv$vector.poly_hv_line^ (line_coordinates, graphic_identifier, terminal_status);
    IF NOT terminal_status.normal THEN
      fdp$convert_terminal_status (terminal_status, status);
      RETURN;
    IFEND;

    put_graphic_attribute (graphic_identifier, display_attribute_set, status);

  PROCEND create_screen_line;

?? TITLE := 'create_screen_objects', EJECT ??

{ PURPOSE:
{   This procedure creates objects required by the form.

  PROCEDURE create_screen_objects
    (    p_form_status: ^fdt$form_status;
     VAR status: ost$status);

    VAR
      boundary_processing: cst$boundary_processing,
      character_index: cst$character_position,
      end_of_text: boolean,
      data_characters: cst$character_position,
      display_attribute_set: fdt$display_attribute_set,
      field_justification: cst$field_justification,
      field_number: cst$field_number,
      first_displayed_occurrence: fdt$occurrence,
      form_x_position: fdt$x_position,
      form_y_position: fdt$y_position,
      fragment_object_index: fdt$object_index,
      graphic_identifier: cst$graphic_identifier,
      input: boolean,
      io_mode: fdt$io_mode,
      next_object_index: fdt$object_index,
      number_objects: fdt$number_objects,
      object_index: fdt$object_index,
      output: boolean,
      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_record_definitions: ^array [1 .. * ] of fdt$variable_record_definition,
      p_form_table_definition: ^fdt$form_table_definition,
      p_form_table_definitions: ^array [1 .. * ] of fdt$form_table_definition,
      p_form_variable_definition: ^fdt$form_variable_definition,
      p_form_variable_definitions: ^array [1 .. * ] of fdt$form_variable_definition,
      p_form_object_statuses: ^array [1 .. * ] of fdt$form_object_status,
      p_screen_variable: ^fdt$text,
      p_table_object: ^fdt$table_object,
      p_table_objects: ^array [1 .. * ] of fdt$table_object,
      p_form_table_statuses: ^array [1 .. * ] of fdt$table_status,
      p_screen_text: ^fdt$text,
      p_table_variable: ^fdt$table_variable,
      p_table_variables: ^array [1 .. * ] of fdt$table_variable,
      p_text: ^fdt$text,
      p_variable_record_definition: ^fdt$variable_record_definition,
      record_index: fdt$variable_index,
      screen_visible_length: fdt$screen_variable_length,
      stored_characters: cst$character_position,
      stored_lines: cst$line_number,
      table_object_index: fdt$object_index,
      target_position: fdt$target_position,
      terminal_status: ost$status,
      variable_index: fdt$variable_index,
      visible_characters: cst$visible_character_position,
      visible_lines: cst$line_number,
      x_position: cst$x_position,
      y_position: cst$y_position;

    status.normal := TRUE;

{ Create field for entire form.  Fields for form objects will overlay this field.
{ This field causes the form to be opaque.  Any screen data lying underneath the
{ form must be covered up.

    p_form_definition := p_form_status^.p_form_definition;
    form_x_position := p_form_status^.form_x_position;
    form_y_position := p_form_status^.form_y_position;

    CASE p_form_definition^.form_area.key OF

    = fdc$defined_area =
      visible_lines := p_form_definition^.height;
      visible_characters := p_form_definition^.width;
      stored_lines := visible_lines;
      stored_characters := visible_characters;

    ELSE { fdc$screen_area }
      visible_lines := fdv$screen_status.current_screen_height;
      visible_characters := fdv$screen_status.current_screen_width;
      stored_lines := visible_lines;
      stored_characters := visible_characters;

    CASEND;

    boundary_processing.boundary_type := csc$clip;
    csv$vector.create_field^ (form_x_position, form_y_position, visible_characters, visible_lines,
          stored_characters, stored_lines, FALSE, TRUE, csc$no_justification, boundary_processing,
          field_number, terminal_status);
    IF NOT terminal_status.normal THEN
      CASE terminal_status.condition OF

      = cse$field_beyond_page_boundary, cse$field_off_screen =
        osp$set_status_abnormal (fdc$format_display_identifier, fde$form_too_large_for_screen,
              p_form_definition^.form_name, status);
        RETURN;
      ELSE
        fdp$convert_terminal_status (terminal_status, status);
        RETURN;
      CASEND;
    IFEND;
    p_form_status^.field_number_defined := TRUE;
    p_form_status^.field_number := field_number;

{ Specify form colors.

    display_attribute_set := p_form_definition^.display_attribute *
          fdv$colors + $fdt$display_attribute_set [fdc$protect];
    put_text_attribute (field_number, display_attribute_set, fdc$terminal_output, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ Create form border by drawing a box.

    IF (NOT p_form_status^.design_form AND
           ((fdc$fine_border IN p_form_definition^.display_attribute) OR
           (fdc$medium_border IN p_form_definition^.display_attribute) OR
           (fdc$bold_border IN p_form_definition^.display_attribute))) THEN
      create_screen_box (form_x_position, form_y_position, stored_characters, stored_lines,
            p_form_definition^.display_attribute, graphic_identifier, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      p_form_status^.graphic_identifier := graphic_identifier;
      p_form_status^.graphic_identifier_defined := TRUE;
    IFEND;

    p_form_object_definitions := p_form_status^.p_form_object_definitions;
    IF p_form_object_definitions = NIL THEN
      RETURN;
    IFEND;

{ Create objects on screen for form objects.

    p_form_module := p_form_status^.p_form_module;
    number_objects := p_form_status^.p_form_definition^.form_object_definitions.active_number;
    p_form_variable_definitions := p_form_status^.p_form_variable_definitions;
    p_form_object_statuses := p_form_status^.p_form_object_statuses;

    FOR object_index := 1 TO number_objects DO
      p_form_object_definition := ^p_form_object_definitions^ [object_index];
      CASE p_form_object_definition^.key OF

      = fdc$form_box =
        x_position := p_form_object_definition^.x_position + form_x_position - 1;
        y_position := p_form_object_definition^.y_position + form_y_position - 1;
        create_screen_box (x_position, y_position, p_form_object_definition^.box_width,
              p_form_object_definition^.box_height, p_form_object_statuses^ [object_index].
              display_attribute_set, graphic_identifier, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        p_form_object_statuses^ [object_index].key := fdc$graphic_identifier;
        p_form_object_statuses^ [object_index].graphic_identifier := graphic_identifier;

      = fdc$form_constant_text =
        x_position := p_form_object_definition^.x_position + form_x_position - 1;
        y_position := p_form_object_definition^.y_position + form_y_position - 1;
        visible_characters := p_form_object_definition^.constant_text_width;
        p_text := fdp$ptr_text (p_form_object_definition^.constant_text, p_form_module);

        IF p_form_status^.p_form_definition^.hidden_editing THEN
          data_characters := STRLENGTH (p_text^);
        ELSE
          data_characters := visible_characters;
        IFEND;

        boundary_processing.boundary_type := csc$clip;
        csv$vector.create_field^ (x_position, y_position, visible_characters, 1, data_characters, 1,
              FALSE, TRUE, csc$no_justification, boundary_processing, field_number, terminal_status);
        IF NOT terminal_status.normal THEN
          fdp$convert_terminal_status (terminal_status, status);
          RETURN;
        IFEND;

        p_form_object_statuses^ [object_index].key := fdc$field_identifier;
        p_form_object_statuses^ [object_index].field_number := field_number;
        csv$vector.change_io_position^ (field_number, 1, terminal_status);
        IF NOT terminal_status.normal THEN
          fdp$convert_terminal_status (terminal_status, status);
          RETURN;
        IFEND;

        IF STRLENGTH (p_text^) > visible_characters THEN
          p_screen_text := ^p_text^ (1, visible_characters);
        ELSE
          p_screen_text := p_text;
        IFEND;
        csv$vector.put_text^ (p_screen_text, TRUE, end_of_text, terminal_status);
        IF NOT terminal_status.normal THEN
          fdp$convert_terminal_status (terminal_status, status);
          RETURN;
        IFEND;

        put_text_attribute (field_number, p_form_object_statuses^ [object_index].display_attribute_set,
              fdc$terminal_output, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

      = fdc$form_constant_text_box =
        x_position := p_form_object_definition^.x_position + form_x_position - 1;
        y_position := p_form_object_definition^.y_position + form_y_position - 1;
        add_screen_constant_text_box (x_position, y_position, object_index, p_form_status, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

      = fdc$form_line =
        x_position := p_form_object_definition^.x_position + form_x_position - 1;
        y_position := p_form_object_definition^.y_position + form_y_position - 1;
        create_screen_line (x_position, y_position, p_form_object_definition^.x_increment,
              p_form_object_definition^.y_increment, p_form_object_statuses^ [object_index].
              display_attribute_set, graphic_identifier, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        p_form_object_statuses^ [object_index].key := fdc$graphic_identifier;
        p_form_object_statuses^ [object_index].graphic_identifier := graphic_identifier;

      = fdc$form_stored_variable =
        p_form_object_statuses^ [object_index].key := fdc$unused_identifier;

{ Do nothing.  A stored object has no screen representation.

      = fdc$form_table =
        x_position := p_form_object_definition^.x_position + form_x_position - 1;
        y_position := p_form_object_definition^.y_position + form_y_position - 1;
        boundary_processing.boundary_type := csc$clip;
        visible_characters := p_form_object_definition^.table_width;
        visible_lines := p_form_object_definition^.table_height;
        csv$vector.create_field^ (x_position, y_position, visible_characters, visible_lines,
              visible_characters, visible_lines, FALSE, TRUE, csc$no_justification,
              boundary_processing, field_number, terminal_status);
        IF NOT terminal_status.normal THEN
          fdp$convert_terminal_status (terminal_status, status);
          RETURN;
        IFEND;

        p_form_object_statuses^ [object_index].key := fdc$field_identifier;
        p_form_object_statuses^ [object_index].field_number := field_number;
        put_text_attribute (field_number, p_form_object_statuses^ [object_index].display_attribute_set,
              fdc$terminal_output, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

      = fdc$form_text_box_fragment =

{ Do nothing now. These objects are processing when the associated constant or
{ variable text box is processed.

      = fdc$form_variable_text =
        x_position := p_form_object_definition^.x_position + form_x_position - 1;
        y_position := p_form_object_definition^.y_position + form_y_position - 1;
        IF p_form_object_definition^.text_variable_exists THEN
          p_form_variable_definition := ^p_form_variable_definitions^
                [p_form_object_definition^.text_variable_index];

          io_mode := p_form_variable_definition^.io_mode;
          CASE p_form_variable_definition^.io_mode OF

          = fdc$terminal_input =
            input := TRUE;
            output := FALSE;

          = fdc$terminal_input_output =
            input := TRUE;
            output := TRUE;

          ELSE {fdc$terminal_output}
            input := FALSE;
            output := TRUE;
          CASEND;

        ELSE

{ Variable does not exist.

          input := FALSE;
          output := TRUE;
          io_mode := fdc$terminal_output;
        IFEND;

        boundary_processing.boundary_type := csc$clip;
        visible_characters := p_form_object_definition^.text_variable_width;
        IF p_form_definition^.hidden_editing THEN
          data_characters := p_form_variable_definition^.screen_variable_length;
        ELSE
          data_characters := visible_characters;
        IFEND;

        csv$vector.create_field^ (x_position, y_position, visible_characters, 1, data_characters, 1,
              input, output, csc$no_justification, boundary_processing, field_number, terminal_status);
        IF NOT terminal_status.normal THEN
          fdp$convert_terminal_status (terminal_status, status);
          RETURN;
        IFEND;

        p_form_object_statuses^ [object_index].key := fdc$field_identifier;
        p_form_object_statuses^ [object_index].field_number := field_number;
        put_text_attribute (field_number, p_form_object_statuses^ [object_index].display_attribute_set,
              io_mode, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

      = fdc$form_variable_text_box =
        x_position := p_form_object_definition^.x_position + form_x_position - 1;
        y_position := p_form_object_definition^.y_position + form_y_position - 1;
        display_attribute_set := p_form_object_statuses^ [object_index].display_attribute_set;

        IF p_form_object_definition^.variable_box_variable_exists THEN
          p_form_variable_definition := ^p_form_variable_definitions^
                [p_form_object_definition^.variable_box_variable_index];
          io_mode := p_form_variable_definition^.io_mode;
          CASE p_form_variable_definition^.io_mode OF

          = fdc$terminal_input =
            input := TRUE;
            output := FALSE;

          = fdc$terminal_input_output =
            input := TRUE;
            output := TRUE;

          ELSE { fdc$terminal_output }
            input := FALSE;
            output := TRUE;
          CASEND;

        ELSE

{ The variable has not been defined. Make the variable a constant.

          input := FALSE;
          output := TRUE;
          io_mode := fdc$terminal_output;
        IFEND;

        boundary_processing.boundary_type := csc$clip;
        visible_characters := p_form_object_definition^.variable_box_width;
        IF p_form_status^.p_form_definition^.hidden_editing THEN
          data_characters := fdc$hidden_editing_multiplier * visible_characters;
        ELSE
          data_characters := visible_characters;
        IFEND;
        csv$vector.create_field^ (x_position, y_position, visible_characters, 1, data_characters,
              1, input, output, csc$no_justification, boundary_processing, field_number,
              terminal_status);
        IF NOT terminal_status.normal THEN
          fdp$convert_terminal_status (terminal_status, status);
          RETURN;
        IFEND;

        p_form_object_statuses^ [object_index].key := fdc$field_identifier;
        p_form_object_statuses^ [object_index].field_number := field_number;
        put_text_attribute (field_number, display_attribute_set, io_mode, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

        fragment_object_index := p_form_object_definition^.variable_box_fragment_index;
        WHILE fragment_object_index <> 0 DO
          y_position := y_position + 1;
          csv$vector.create_field^ (x_position, y_position, visible_characters, 1, data_characters,
                1, input, output, csc$no_justification, boundary_processing, field_number, terminal_status);
          IF NOT terminal_status.normal THEN
            fdp$convert_terminal_status (terminal_status, status);
            RETURN;
          IFEND;

          p_form_object_statuses^ [fragment_object_index].key := fdc$field_identifier;
          p_form_object_statuses^ [fragment_object_index].field_number := field_number;
          put_text_attribute (field_number, display_attribute_set, io_mode, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          fragment_object_index := p_form_object_definitions^ [fragment_object_index].
                next_fragment_object_index;
        WHILEND;

      ELSE { fdc$form_unused_object }
      CASEND;
    FOREND;

    IF (p_form_status^.design_form AND
           ((fdc$fine_border IN p_form_definition^.display_attribute) OR
           (fdc$medium_border IN p_form_definition^.display_attribute) OR
           (fdc$bold_border IN p_form_definition^.display_attribute))) THEN
      create_screen_box (form_x_position, form_y_position, stored_characters, stored_lines,
            p_form_definition^.display_attribute, graphic_identifier, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      p_form_status^.graphic_identifier := graphic_identifier;
      p_form_status^.graphic_identifier_defined := TRUE;
    IFEND;

{ Put data from form record into variable form objects.

    p_form_record_definitions := p_form_status^.p_form_record_definitions;
    IF p_form_record_definitions = NIL THEN
      RETURN;
    IFEND;

    p_form_table_definitions := p_form_status^.p_form_table_definitions;
    p_form_table_statuses := p_form_status^.p_form_table_statuses;
    target_position.key := fdc$page_data_first;

  /create_screen_text/
    FOR record_index := 1 TO UPPERBOUND (p_form_record_definitions^) DO
      p_variable_record_definition := ^p_form_record_definitions^ [record_index];
      CASE p_variable_record_definition^.key OF

      = fdc$record_table =
        p_form_table_definition := ^p_form_table_definitions^ [p_variable_record_definition^.table_index];
        IF NOT p_form_table_definition^.valid THEN
          CYCLE /create_screen_text/;
        IFEND;

        first_displayed_occurrence := p_form_table_statuses^ [p_variable_record_definition^.table_index].
              first_displayed_occurrence;
        p_table_variables := fdp$ptr_table_variables (p_form_table_definition^.table_variables,
              p_form_module);
        IF p_table_variables <> NIL THEN
          FOR variable_index := 1 TO p_form_table_definition^.table_variables.active_number DO
            p_table_variable := ^p_table_variables^ [variable_index];
            p_form_variable_definition := ^p_form_status^.p_form_variable_definitions^
                  [p_table_variable^.variable_index];
            p_table_objects := fdp$ptr_table_objects (p_table_variable^.table_objects, p_form_module);

          /create_table_object_text/
            FOR table_object_index := 1 TO p_form_table_definition^.visible_occurrence DO
              p_table_object := ^p_table_objects^ [table_object_index + first_displayed_occurrence - 1];
              IF NOT p_table_object^.object_exists THEN
                CYCLE /create_table_object_text/;
              IFEND;

              object_index := p_table_objects^ [table_object_index].object_index;
              p_form_object_definition := ^p_form_object_definitions^ [object_index];
              CASE p_form_object_definition^.key OF

              = fdc$form_variable_text_box =
                next_object_index := p_form_object_definition^.variable_box_fragment_index;
                fdp$ptr_screen_variable (p_form_status^.p_screen_record,
                      p_table_object^.screen_record_position, p_form_variable_definition^.
                      screen_variable_length, p_screen_variable);
                format_screen_text (p_screen_variable, p_form_status, object_index, next_object_index,
                      p_form_object_definition^.variable_box_processing,
                      p_form_object_definition^.variable_box_width,
                      p_form_object_definition^.variable_box_height, target_position, status);
                IF NOT status.normal THEN
                  RETURN;
                IFEND;

              = fdc$form_variable_text =
                fdp$ptr_screen_variable (p_form_status^.p_screen_record,
                      p_table_object^.screen_record_position, p_form_object_definition^.
                      text_variable_width, p_screen_variable);
                replace_screen_variable (p_screen_variable, object_index, object_index,
                      p_form_object_definition^.text_variable_width, p_form_status,
                      target_position, status);
                IF NOT status.normal THEN
                  RETURN;
                IFEND;
              ELSE
              CASEND;
            FOREND /create_table_object_text/;
          FOREND;
        IFEND;

      = fdc$record_variable =
        p_form_variable_definition := ^p_form_status^.p_form_variable_definitions^ [
              p_variable_record_definition^.variable_index];
        IF NOT p_form_variable_definition^.object_exists THEN
          CYCLE /create_screen_text/;
        IFEND;

        object_index := p_form_variable_definition^.object_index;
        p_form_object_definition := ^p_form_object_definitions^ [object_index];
        CASE p_form_object_definition^.key OF

        = fdc$form_variable_text_box =
          next_object_index := p_form_object_definition^.variable_box_fragment_index;
          fdp$ptr_screen_variable (p_form_status^.p_screen_record,
                p_form_variable_definition^.screen_record_position, p_form_variable_definition^.
                screen_variable_length, p_screen_variable);
          format_screen_text (p_screen_variable, p_form_status, object_index, next_object_index,
                p_form_object_definition^.variable_box_processing,
                p_form_object_definition^.variable_box_width, p_form_object_definition^.variable_box_height,
                target_position, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

        ELSE { fdc$form_variable_text }
          fdp$ptr_screen_variable (p_form_status^.p_screen_record,
                p_form_variable_definition^.screen_record_position, p_form_variable_definition^.
                screen_variable_length, p_screen_variable);
          replace_screen_variable (p_screen_variable, object_index, object_index,
                p_form_object_definition^.text_variable_width, p_form_status, target_position, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        CASEND;

      ELSE

{ Invalid record definition key.

        osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
              'invalid record definition key', status);
      CASEND;
    FOREND /create_screen_text/;

  PROCEND create_screen_objects;

?? TITLE := 'delete_format_screen_change', EJECT ??

{ PURPOSE:
{   This procedure deletes unnecessary formatting of text box screen changes.  The caller of this
{   procedure has already done the formatting. A format text box screen change is scheduled
{   whenever the terminal user inserts or deletes characters in a text box.

  PROCEDURE delete_format_screen_change
    (    form_identifier: fdt$form_identifier;
         object_index: fdt$object_index);

  VAR
    screen_change: integer;

    FOR screen_change := 1 TO fdv$screen_status.number_screen_changes DO

{ Delete all scheduled formatting.  The terminal user may have done more than one
{ add/delete character actions.

      IF ((fdv$screen_status.p_screen_changes^ [screen_change].key = fdc$format_text_box) AND
            (fdv$screen_status.p_screen_changes^ [screen_change].format_text_form_identifier =
            form_identifier) AND (fdv$screen_status.p_screen_changes^ [screen_change].
            format_text_object_index = object_index)) THEN
        fdv$screen_status.p_screen_changes^ [screen_change].key := fdc$no_screen_change;
      IFEND;
    FOREND;

  PROCEND delete_format_screen_change;

?? TITLE := 'delete_replace_variable', EJECT ??

  PROCEDURE delete_replace_variable
    (    p_form_status: ^fdt$form_status;
         form_identifier: fdt$form_identifier;
         table_index: fdt$table_index;
         screen_change_index: integer);

    VAR
      m: integer,
      p_screen_change: ^fdt$screen_change,
      p_form_object_definition: ^fdt$form_object_definition,
      p_form_object_definitions: ^array [1 .. * ] of fdt$form_object_definition,
      p_form_variable_definitions: ^array [1 .. * ] of fdt$form_variable_definition;

    p_form_object_definitions := p_form_status^.p_form_object_definitions;
    p_form_variable_definitions := p_form_status^.p_form_variable_definitions;

    FOR m := screen_change_index + 1 TO fdv$screen_status.number_screen_changes DO
      p_screen_change := ^fdv$screen_status.p_screen_changes^ [m];
      IF p_screen_change^.key = fdc$replace_variable THEN
        IF p_screen_change^.variable_form_identifier = form_identifier THEN
          p_form_object_definition := ^p_form_object_definitions^ [p_screen_change^.variable_object_index];
          CASE p_form_object_definition^.key OF

          = fdc$form_stored_variable =
            IF p_form_variable_definitions^ [p_form_object_definition^.stored_variable_index].
                  table_exists THEN
              IF p_form_variable_definitions^ [p_form_object_definition^.stored_variable_index].table_index =
                    table_index THEN
                p_screen_change^.key := fdc$no_screen_change;
              IFEND;
            IFEND;

          = fdc$form_variable_text =
            IF p_form_variable_definitions^ [p_form_object_definition^.text_variable_index].table_exists THEN
              IF p_form_variable_definitions^ [p_form_object_definition^.text_variable_index].table_index =
                    table_index THEN
                p_screen_change^.key := fdc$no_screen_change;
              IFEND;
            IFEND;

          = fdc$form_variable_text_box =
            IF p_form_variable_definitions^ [p_form_object_definition^.variable_box_variable_index].
                  table_exists THEN
              IF p_form_variable_definitions^ [p_form_object_definition^.variable_box_variable_index].
                    table_index = table_index THEN
                p_screen_change^.key := fdc$no_screen_change;
              IFEND;
            IFEND;
          ELSE
          CASEND;
        IFEND;
      IFEND;
    FOREND;
  PROCEND delete_replace_variable;

?? TITLE := 'delete_screen_objects', EJECT ??

  PROCEDURE [INLINE] delete_screen_objects
    (    p_form_status: ^fdt$form_status;
     VAR status: ost$status);

    VAR
      object_index: fdt$object_index,
      p_form_object_status: ^fdt$form_object_status,
      p_form_object_statuses: ^array [1 .. * ] of fdt$form_object_status,
      terminal_status: ost$status;

    status.normal := TRUE;
    IF p_form_status^.field_number_defined THEN

{ Delete field containing form.

      p_form_status^.field_number_defined := FALSE;
      csv$vector.delete_field^ (p_form_status^.field_number, terminal_status);
      IF NOT terminal_status.normal THEN
        fdp$convert_terminal_status (terminal_status, status);
        RETURN;
      IFEND;

      IF p_form_status^.graphic_identifier_defined THEN

{ Delete box around form.

        p_form_status^.graphic_identifier_defined := FALSE;
        csv$vector.delete_graphic^ (p_form_status^.graphic_identifier, terminal_status);
        IF NOT terminal_status.normal THEN
          fdp$convert_terminal_status (terminal_status, status);
          RETURN;
        IFEND;
      IFEND;
    IFEND;

{ Delete objects on form.

    p_form_object_statuses := p_form_status^.p_form_object_statuses;
    FOR object_index := 1 TO p_form_status^.active_form_object_statuses DO
      p_form_object_status := ^p_form_object_statuses^ [object_index];
      CASE p_form_object_status^.key OF

      = fdc$field_identifier =
        csv$vector.delete_field^ (p_form_object_status^.field_number, terminal_status);
        p_form_object_status^.key := fdc$unused_identifier;
        IF NOT terminal_status.normal THEN
          fdp$convert_terminal_status (terminal_status, status);
          RETURN;
        IFEND;

      = fdc$graphic_identifier =
        csv$vector.delete_graphic^ (p_form_object_status^.graphic_identifier, terminal_status);
        p_form_object_status^.key := fdc$unused_identifier;
        IF NOT terminal_status.normal THEN
          fdp$convert_terminal_status (terminal_status, status);
          RETURN;
        IFEND;

      ELSE { Ignore other status keys. }
      CASEND;
    FOREND;
  PROCEND delete_screen_objects;

?? TITLE := 'display_form_help', EJECT ??

  PROCEDURE display_form_help
    (    p_form_status: ^fdt$form_status;
     VAR status: ost$status);

    VAR
      local_status: ost$status,
      message_text: fdt$message_text,
      p_text: ^fdt$text;

{ Erase any current message form.

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

    CASE p_form_status^.p_form_definition^.help_definition.key OF

    = fdc$help_form =
      fdp$open_form (p_form_status^.p_form_definition^.help_definition.help_form,
            fdv$screen_status.message_form_identifier, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      fdv$screen_status.message_form_displayed := TRUE;

      fdp$add_form (fdv$screen_status.message_form_identifier, status);
      IF NOT status.normal THEN
        erase_message_form (local_status);
        RETURN;
      IFEND;


    = fdc$no_help_response =

{ Do nothing. The application program will handle the help.

    = fdc$system_default_help =
      IF p_form_status^.p_form_definition^.screen_formatting_version < fdc$validation_capability THEN
        RETURN;
      IFEND;

      fdp$get_message (fde$system_help_message, message_text);
      IF p_form_status^.p_form_definition^.screen_formatting_version < fdc$message_form_capability THEN
        display_message_text (^message_text, osc$null_name, status);
      ELSE
        display_message_text (^message_text,
              p_form_status^.p_form_definition^.help_message_form, status);
      IFEND;
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      fdp$set_cursor_position (fdv$screen_status.message_form_identifier, fdv$message_variable_name, 1, 1,
            status);

    = fdc$help_message =
      p_text := #PTR (p_form_status^.p_form_definition^.help_definition.p_help_message,
            p_form_status^.p_form_module^);
      IF p_form_status^.p_form_definition^.screen_formatting_version < fdc$message_form_capability THEN
        display_message_text (p_text, osc$null_name, status);
      ELSE
        display_message_text (p_text,
              p_form_status^.p_form_definition^.help_message_form, status);
      IFEND;
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      fdp$set_cursor_position (fdv$screen_status.message_form_identifier, fdv$message_variable_name, 1, 1,
            status);

    ELSE
      osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error, 'bad form help definition',
            status);
    CASEND;

  PROCEND display_form_help;

?? TITLE := 'display_message_text', EJECT ??

  PROCEDURE display_message_text
    (    p_text: ^fdt$text;
         message_form_name: ost$name;
     VAR status: ost$status);

    VAR
      local_status: ost$status,
      variable_status: fdt$variable_status;

    IF message_form_name = osc$null_name THEN

{ Use default message form.
{ If default message form exists in command list, use it.
{ Otherwise, create a message form.

      fdp$open_form (fdc$message_form_name, fdv$screen_status.message_form_identifier, status);
      IF NOT status.normal THEN
        fdp$create_message_form (fdv$screen_status.message_form_identifier, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

{ Set form as displayed so that created form resources will be deallocated.

        fdv$screen_status.message_form_displayed := TRUE;
        fdp$open_form (osc$null_name, fdv$screen_status.message_form_identifier, status);
        IF NOT status.normal THEN
          erase_message_form (local_status);
          RETURN;
        IFEND;
      IFEND;

    ELSE { Use form specified in form definition. }

      fdp$open_form (message_form_name, fdv$screen_status.message_form_identifier, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

    fdv$screen_status.message_form_displayed := TRUE;
    fdp$add_form (fdv$screen_status.message_form_identifier, status);
    IF NOT status.normal THEN
      erase_message_form (local_status);
      RETURN;
    IFEND;

    fdp$replace_string_variable (fdv$screen_status.message_form_identifier, fdv$message_variable_name, 1,
          p_text^, variable_status, status);
    IF NOT status.normal THEN
      erase_message_form (local_status);
      RETURN;
    IFEND;

  PROCEND display_message_text;

?? TITLE := 'display_variable_error', EJECT ??

  PROCEDURE display_variable_error
    (    p_form_status: ^fdt$form_status;
         form_identifier: fdt$form_identifier;
         p_form_variable_definition: ^fdt$form_variable_definition;
         object_index: fdt$object_index;
         occurrence: fdt$occurrence;
     VAR status: ost$status);

    VAR
      local_status: ost$status,
      message_text: fdt$message_text,
      p_text: ^fdt$text,
      screen_change: fdt$screen_change;

{ Set up to display error display attribute for variable.  Note that some
{ error definitions for the variable will not use the error display attribute.

    screen_change.key := fdc$set_attribute;
    screen_change.attribute_form_identifier := form_identifier;
    screen_change.attribute_object_index := object_index;
    screen_change.attribute := p_form_status^.p_form_object_definitions^ [object_index].display_attribute +
          p_form_variable_definition^.error_displays;

{ Response to terminal user error using variable definition for error processing.

    CASE p_form_variable_definition^.error_definition.key OF

{ Display an error form.

    = fdc$error_form =
      fdp$open_form (p_form_variable_definition^.error_definition.error_form,
            fdv$screen_status.message_form_identifier, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      fdv$screen_status.message_form_displayed := TRUE;

      fdp$add_form (fdv$screen_status.message_form_identifier, status);
      IF NOT status.normal THEN
        erase_message_form (local_status);
        RETURN;
      IFEND;

{ Display variable with error attribute.

      fdp$record_screen_change (screen_change, status);
      IF NOT status.normal THEN
        erase_message_form (local_status);
        RETURN;
      IFEND;

      p_form_status^.p_form_object_statuses^ [object_index].display_attribute_set := screen_change.attribute;
      fdv$screen_status.error_attribute_displayed := TRUE;
      fdv$screen_status.error_identifier := form_identifier;
      fdv$screen_status.error_name := p_form_variable_definition^.name;
      fdv$screen_status.error_occurrence := occurrence;

      fdp$set_cursor_position (form_identifier, p_form_variable_definition^.name, occurrence, 1, status);
      IF NOT status.normal THEN
        erase_message_form (local_status);
        RETURN;
      IFEND;

    = fdc$no_error_response =

{ Do nothing. The application program will handle the error.

    = fdc$system_default_error =
      IF p_form_status^.p_form_definition^.screen_formatting_version < fdc$validation_capability THEN
        RETURN;
      IFEND;

{ Display default error form with default error message.

      fdp$get_message(fde$system_error_message, message_text);
      display_message_text (^message_text,
            p_form_status^.p_form_definition^.error_message_form, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

{ Display variable with error attribute.

      fdp$record_screen_change (screen_change, status);
      IF NOT status.normal THEN
        erase_message_form (local_status);
        RETURN;
      IFEND;

      p_form_status^.p_form_object_statuses^ [object_index].display_attribute_set := screen_change.attribute;
      fdv$screen_status.error_attribute_displayed := TRUE;
      fdv$screen_status.error_identifier := form_identifier;
      fdv$screen_status.error_name := p_form_variable_definition^.name;
      fdv$screen_status.error_occurrence := occurrence;

      fdp$set_cursor_position (form_identifier, p_form_variable_definition^.name, occurrence, 1, status);
      IF NOT status.normal THEN
        erase_message_form (local_status);
        RETURN;
      IFEND;

    = fdc$error_message =

{ Display default error form with error message defined form variable.

      p_text := #PTR (p_form_variable_definition^.error_definition.p_error_message,
            p_form_status^.p_form_module^);
      display_message_text (p_text,
            p_form_status^.p_form_definition^.error_message_form, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

{ Display variable with error attribute.

      fdp$record_screen_change (screen_change, status);
      IF NOT status.normal THEN
        erase_message_form (local_status);
        RETURN;
      IFEND;
      p_form_status^.p_form_object_statuses^ [object_index].display_attribute_set := screen_change.attribute;
      fdv$screen_status.error_attribute_displayed := TRUE;
      fdv$screen_status.error_identifier := form_identifier;
      fdv$screen_status.error_name := p_form_variable_definition^.name;
      fdv$screen_status.error_occurrence := occurrence;

      fdp$set_cursor_position (form_identifier, p_form_variable_definition^.name, occurrence, 1, status);
      IF NOT status.normal THEN
        erase_message_form (local_status);
        RETURN;
      IFEND;

    ELSE
      osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error, 'bad variable definition',
            status);
    CASEND;
  PROCEND display_variable_error;

?? TITLE := 'display_variable_help', EJECT ??

  PROCEDURE display_variable_help
    (    p_form_status: ^fdt$form_status;
         form_identifier: fdt$form_identifier;
         p_form_variable_definition: ^fdt$form_variable_definition;
         occurrence: fdt$occurrence;
     VAR status: ost$status);

    VAR
      local_status: ost$status,
      message_text: fdt$message_text,
      p_text: ^fdt$text;


{ Delete any previous help or error forms.

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

{ Provide help specified in the variable definition.

    CASE p_form_variable_definition^.help_definition.key OF

    = fdc$help_form =

{ Display form user specified in the variable definition.

      fdp$open_form (p_form_variable_definition^.help_definition.help_form,
            fdv$screen_status.message_form_identifier, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      fdv$screen_status.message_form_displayed := TRUE;

      fdp$add_form (fdv$screen_status.message_form_identifier, status);
      IF NOT status.normal THEN
        erase_message_form (local_status);
        RETURN;
      IFEND;

      fdp$set_cursor_position (form_identifier, p_form_variable_definition^.name, occurrence, 1, status);
      IF NOT status.normal THEN
        erase_message_form (local_status);
        RETURN;
      IFEND;

    = fdc$no_help_response =
      display_form_help (p_form_status, status);

    = fdc$system_default_help =
      IF p_form_status^.p_form_definition^.screen_formatting_version < fdc$validation_capability THEN
        RETURN;
      IFEND;

{ Display default help message in the default message form.

      fdp$get_message (fde$system_help_message, message_text);
      IF p_form_status^.p_form_definition^.screen_formatting_version < fdc$message_form_capability THEN
        display_message_text (^message_text, osc$null_name, status);
      ELSE
        display_message_text (^message_text,
              p_form_status^.p_form_definition^.help_message_form, status);
      IFEND;
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      fdp$set_cursor_position (form_identifier, p_form_variable_definition^.name, occurrence, 1, status);
      IF NOT status.normal THEN
        erase_message_form (local_status);
        RETURN;
      IFEND;

    = fdc$help_message =

{ Display help message specified by the user in the variable definition.

      p_text := #PTR (p_form_variable_definition^.help_definition.p_help_message,
            p_form_status^.p_form_module^);
      IF p_form_status^.p_form_definition^.screen_formatting_version < fdc$message_form_capability THEN
        display_message_text (p_text, osc$null_name, status);
      ELSE
        display_message_text (p_text,
              p_form_status^.p_form_definition^.help_message_form, status);
      IFEND;
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      fdp$set_cursor_position (form_identifier, p_form_variable_definition^.name, occurrence, 1, status);
      IF NOT status.normal THEN
        erase_message_form (local_status);
        RETURN;
      IFEND;

    ELSE
    CASEND;
  PROCEND display_variable_help;

?? TITLE := 'erase_message_form', EJECT ??

  PROCEDURE erase_message_form
    (VAR status: ost$status);


    VAR
      local_status: ost$status;

    status.normal := TRUE;
    IF fdv$screen_status.message_form_displayed THEN

{ Delete message form.

      fdv$screen_status.message_form_displayed := FALSE;
      fdp$close_form (fdv$screen_status.message_form_identifier, status);
      IF NOT status.normal THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error, 'close of message form',
              status);
        RETURN;
      IFEND;

      IF fdv$screen_status.error_attribute_displayed THEN

{ Remove error display attribute.

        fdv$screen_status.error_attribute_displayed := FALSE;
        fdp$reset_object_attribute (fdv$screen_status.error_identifier, fdv$screen_status.error_name,
              fdv$screen_status.error_occurrence, local_status);
      IFEND;
    IFEND;
  PROCEND erase_message_form;

?? TITLE := 'find_previous_object', EJECT ??

{ PURPOSE:
{   This procedure finds the previous object on the screen from the specified position.
{ DESIGN:
{   This procedure searches the object definitions until the first one before the specified position is
{   encountered.  The object definitions are ordered by location.
{

  PROCEDURE [INLINE] find_previous_object
    (    x_position: fdt$x_position;
         y_position: fdt$y_position;
         p_form_status: ^fdt$form_status;
     VAR object_index: fdt$object_index);

    VAR
      p_form_object_definition: ^fdt$form_object_definition,
      p_form_object_definitions: ^array [1 .. * ] of fdt$form_object_definition;

    p_form_object_definitions := p_form_status^.p_form_object_definitions;

{ All objects are sorted by form location.  Look for the previous object.

    FOR object_index := p_form_status^.p_form_definition^.form_object_definitions.active_number DOWNTO 1 DO
      p_form_object_definition := ^p_form_object_definitions^ [object_index];
      CASE p_form_object_definition^.key OF

        = fdc$form_variable_text, fdc$form_text_box_fragment, fdc$form_variable_text_box =
        IF ((p_form_object_definition^.y_position = y_position) AND
              (p_form_object_definition^.x_position < x_position)) THEN

{ Found the previous object on the same terminal line.

          RETURN;
        IFEND;

        IF p_form_object_definition^.y_position < y_position THEN

{ Found the previous object on a previous terminal line.

          RETURN;
        IFEND;

      ELSE

{ Ignore objects that are not variables and objects that do not have an x, y position.

      CASEND;
    FOREND;

{ No objects precede the specified position.  Start search from the end of the form.

    object_index := p_form_status^.p_form_definition^.form_object_definitions.active_number;

  PROCEND find_previous_object;

?? OLDTITLE ??
?? TITLE := 'format_screen_text', EJECT ??

{ PURPOSE:
{   This procedure transfers text for variable and constant text box objects to
{   the Screen Manager.

  PROCEDURE format_screen_text
    (    p_text: ^fdt$text;
         p_form_status: ^fdt$form_status;
         object_index: fdt$object_index;
         next_object_index: fdt$object_index;
         text_box_processing: fdt$text_box_processing;
         width: fdt$width;
         height: fdt$height;
         target_position: fdt$target_position;
     VAR status: ost$status);

    VAR
      fragment_object_index: fdt$object_index,
      next_fragment_object_index: fdt$object_index,
      p_form_object_definitions: ^array [1 .. * ] of fdt$form_object_definition,
      p_form_object_statuses: ^array [1 .. * ] of fdt$form_object_status,
      space: [READ, STATIC] string (1) := ' ';

?? NEWTITLE := 'output_screen_text', EJECT ??

    PROCEDURE output_screen_text
      (    field_number: cst$field_number;
           p_output_text: ^fdt$text);

      VAR
        end_of_text: boolean,
        terminal_status: ost$status;

      csv$vector.change_io_position^ (field_number, 1, terminal_status);
      IF NOT terminal_status.normal THEN
        fdp$convert_terminal_status (terminal_status, status);
        RETURN;
      IFEND;

      csv$vector.put_text^ (p_output_text, TRUE, end_of_text, terminal_status);
      IF NOT terminal_status.normal THEN
        fdp$convert_terminal_status (terminal_status, status);
      IFEND;

    PROCEND output_screen_text;

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

{ PURPOSE:
{   This procedure wraps characters into a text box.

    PROCEDURE wrap_characters;

      VAR
        end_text_index: fdt$text_length,
        formatted_width: fdt$width,
        p_screen_text: ^fdt$text,
        position: integer,
        screen_visible_length: fdt$screen_variable_length,
        shift: integer,
        start_text_index: integer,
        text_length: fdt$text_length;

{ Compute shift needed to reformat the text. First specify the maximum shift needed.  Later
{ processing will insure that the shift does not cause the data to be outside the limits
{ of the text box. For example, a shift might cause the starting position to be less than one
{ or greater than area for text in the object.

      screen_visible_length := height * width;
      CASE target_position.key OF

      = fdc$page_data_first =

{ Specify the maximum shift need to move the first character of the text to the first character of
{ the object.

        shift := - STRLENGTH (p_text^);

      = fdc$page_data_last =

{ Specify the maximum shift need to move the last character of the text to the last character
{ of the object.

        shift := STRLENGTH (p_text^);

      = fdc$page_data_forward =

{ Shift the data forward by the visible area of the object.

        shift := screen_visible_length;

      = fdc$page_data_backward =

{ Shift the data backward by the visible area of the object.

        shift := -screen_visible_length;

      = fdc$scroll_data_forward =

{ Move the character under the cursor to the first character position of the object.

        shift := target_position.data_index - p_form_object_statuses^ [object_index].character_position;

      = fdc$scroll_data_backward =

{ Move the character under the cursor to the last character position of the object.

        shift := p_form_object_statuses^ [object_index].character_position + screen_visible_length - 1 -
              target_position.data_index;
        shift := -shift;

      = fdc$current_data_position =
        shift := 0;

      = fdc$shift_characters =
        shift := target_position.shift;

      ELSE { fdc$top_of_box, fdc$bottom_of_box do not apply.}
        shift := 0;
      CASEND;

{ Make sure the shift lies within the range of the text.

      position := p_form_object_statuses^ [object_index].character_position + shift;
      IF position < 1 THEN
        start_text_index := 1;
      ELSE
        start_text_index := position;
      IFEND;

{ The text length may be less than the size of the object.
{ If text is less than the size of the object, set starting index to show all of text.
{ If the terminal user alters the text, the changes must lie within the text.

      text_length := STRLENGTH (p_text^);
      IF ((start_text_index + screen_visible_length - 1) > text_length) THEN
        start_text_index := text_length - screen_visible_length + 1;
      IFEND;
      IF start_text_index < 1 THEN
        start_text_index := 1;
      IFEND;

      next_fragment_object_index := next_object_index;

{ Break the text into lines (fragments) for the object.

    /break_text_into_objects/
      WHILE TRUE DO
        IF (start_text_index > text_length) THEN
          next_fragment_object_index := fragment_object_index;
          EXIT /break_text_into_objects/;
        IFEND;

        IF ((start_text_index + width - 1) > text_length) THEN

{ This is last line of characters in the object.

          formatted_width := text_length - start_text_index + 1;
          p_screen_text := ^p_text^ (start_text_index, formatted_width);
          p_form_object_statuses^ [fragment_object_index].character_position := start_text_index;
          p_form_object_statuses^ [fragment_object_index].data_length := formatted_width;
          output_screen_text (p_form_status^.p_form_object_statuses^ [fragment_object_index].field_number,
                p_screen_text);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          EXIT /break_text_into_objects/;
        IFEND;

{ Output next line of text to first/next object fragment.

        p_screen_text := ^p_text^ (start_text_index, width);
        p_form_object_statuses^ [fragment_object_index].character_position := start_text_index;
        p_form_object_statuses^ [fragment_object_index].data_length := width;
        output_screen_text (p_form_status^.p_form_object_statuses^ [fragment_object_index].field_number,
              p_screen_text);
        ;
        IF NOT status.normal THEN
          RETURN;
        IFEND;

        IF next_fragment_object_index = 0 THEN
          EXIT /break_text_into_objects/;
        IFEND;

{ Get next line of text and the next object fragment.

        start_text_index := start_text_index + width;
        fragment_object_index := next_fragment_object_index;
        next_fragment_object_index := p_form_object_definitions^ [fragment_object_index].
              next_fragment_object_index;
      WHILEND /break_text_into_objects/;

{ All of text has been processed. Space fill any remaining objects in the text box.

      start_text_index := start_text_index + formatted_width;
      p_screen_text := ^space;
      fragment_object_index := next_fragment_object_index;
      WHILE fragment_object_index <> 0 DO
        p_form_object_statuses^ [fragment_object_index].character_position := start_text_index;
        p_form_object_statuses^ [fragment_object_index].data_length := 0;
        output_screen_text (p_form_status^.p_form_object_statuses^ [fragment_object_index].field_number,
              p_screen_text);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        fragment_object_index := p_form_object_definitions^ [fragment_object_index].
              next_fragment_object_index;
      WHILEND;

    PROCEND wrap_characters;

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

{ PURPOSE:
{   This procedure wraps words into a text box.

    PROCEDURE wrap_words;

      TYPE
        fdt$character_processing = (fdc$process_word_delimiter, fdc$process_new_line, fdc$process_new_record,
              fdc$process_next_character),
        fdt$line_processing = (fdc$get_next_character, fdc$start_next_line, fdc$remove_leading_spaces,
              fdc$record_line, fdc$process_last_line, fdc$line_processing_complete),
        fdt$line_splits = record
          position: fdt$text_length,
          length: fdt$text_length,
        recend,
        fdt$box_processing = (fdc$box_space_available, fdc$box_space_full);

      VAR
        box_processing: fdt$box_processing,
        character_processing: fdt$character_processing,
        end_word_index: integer,
        line_count: 0 .. fdc$maximum_y_position,
        line_processing: fdt$line_processing,
        line_text_count: 0 .. fdc$maximum_x_position,
        p_line_splits: ^array [1 .. * ] of fdt$line_splits,
        position: integer,
        start_line_index: integer,
        text_index: integer,
        text_count: integer,
        word_ended: boolean,
        word_started: boolean,
        word_wrap_target_position: fdt$target_position;

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

{ PURPOSE:
{   This procedure gets text characters  and moves the characters to lines of
{   the object. This procedure uses a state tree to determine what processing needs
{   to be done. Each call can change only one state.

      PROCEDURE fill_line;

        CASE line_processing OF

{ Get the next character of text for a line in a text box.

        = fdc$get_next_character, fdc$remove_leading_spaces =
          IF text_count >= width THEN

{ Formatted text is at end of object line.  On the next call record the line;

            line_processing := fdc$record_line;
            RETURN;
          IFEND;

{ Get next character to format in current line.


          IF text_index >= STRLENGTH (p_text^) THEN

{ Last character of data was processed, so on next call process the last line.

            line_processing := fdc$process_last_line;
            RETURN;
          IFEND;

          text_index := text_index + 1;
          get_character (p_text^ (text_index, 1), character_processing);

{ Determine what to do with the character.

          CASE character_processing OF

          = fdc$process_next_character =
            IF line_processing = fdc$remove_leading_spaces THEN

{ Processing has started a new line for the text box. We want to remove leading spaces.
{ We have found the first non space character on the line.  Now start the
{ gathering of characters for the line.

              start_line_index := text_index;
              line_processing := fdc$get_next_character;
              text_count := 0;
            IFEND;

            word_started := TRUE;
            text_count := text_count + 1;

          = fdc$process_word_delimiter =
            IF word_started THEN

{ If possible, break lines after the word delimiter. Including the delimiter with the
{ last work on the line helps to prevent later insertions and deletions to cause
{ words to run together.

              word_ended := TRUE;
              end_word_index := text_index;
            IFEND;

            text_count := text_count + 1;

          ELSE {fdc$process_new_record, fdc$process_new_line

{ A terminal user insert line action causes a new record character to be inserted in the text.
{ Now we want to show the terminal user a line of spaces.

            line_processing := fdc$start_next_line;

{ Complete the current line.

            line_text_count := text_index - start_line_index + 1;
            record_line;

{ If the current line had any data, then add a new blank line for the insert line or new line.
{ Otherwise we already have a blank line.

            IF text_count <> 0 THEN
              start_line_index := text_index;
              line_text_count := 1;
              record_line;
            IFEND;
            start_line_index := text_index + 1;

          CASEND;

        = fdc$record_line =

{ If possible, break the line at the end of the last word.

          line_processing := fdc$start_next_line;
          IF word_ended THEN
            line_text_count := end_word_index - start_line_index + 1;
            text_index := end_word_index;
          ELSE { The word occupies the entire width of the text box.
            line_text_count := text_index - start_line_index + 1;
          IFEND;

{ Record line can change the line_processing state.  All the specified text may have been
{ collected and processing is nearly complete.

          record_line;
          start_line_index := text_index + 1;

        = fdc$process_last_line =
          line_processing := fdc$line_processing_complete;
          IF text_count > 0 THEN
            IF word_ended THEN
              line_text_count := end_word_index - start_line_index + 1;
              text_index := end_word_index;
            ELSE
              line_text_count := text_index - start_line_index + 1;
            IFEND;
            record_line;
          IFEND;

        ELSE {fdc$start_next_line}
          word_ended := FALSE;
          word_started := FALSE;
          text_count := 0;
          line_processing := fdc$remove_leading_spaces;

        CASEND;
      PROCEND fill_line;

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

{ PURPOSE:
{   This procedure determines the processing required for a character.

      PROCEDURE get_character
        (    next_character: string (1);
         VAR character_processing: fdt$character_processing);

        IF next_character = space THEN
          character_processing := fdc$process_word_delimiter;
        ELSEIF next_character = fdc$new_line_character THEN
          character_processing := fdc$process_new_line;
        ELSEIF next_character = record_separator THEN
          character_processing := fdc$process_new_record;
        ELSE
          character_processing := fdc$process_next_character;
        IFEND;
      PROCEND get_character;

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

{ PURPOSE:
{   This procedure records how text is broken up into lines for the object.  This procedure
{   may also determine the desired text has been placed in the object and now processing
{   is complete. The processing atttemps to keep the object backed by corresponding
{   characters of text.  We want to avoid having the terminal user type into an object
{   that cannot be mapped into the text.

      PROCEDURE record_line;

        VAR
          push_index: 1 .. fdc$maximum_y_position;


?? NEWTITLE := 'test_for_last_line', EJECT ??

{ PURPOSE:
{   This procedure determines if a full object contains the specified data character in
{   the desired target position. If so, then processing is done.

        PROCEDURE test_for_last_line;

          CASE word_wrap_target_position.key OF
          = fdc$top_of_box =
            IF ((p_line_splits^ [1].position >= word_wrap_target_position.data_index) AND
                  (word_wrap_target_position.data_index < p_line_splits^ [1].position +
                  p_line_splits^ [1].length)) THEN
              line_processing := fdc$line_processing_complete;
            IFEND;

          ELSE {fdc$bottom_of_box}
            IF (word_wrap_target_position.data_index < (p_line_splits^ [height].
                  position + p_line_splits^ [height].length)) THEN
              line_processing := fdc$line_processing_complete;
            IFEND;
          CASEND;
        PROCEND test_for_last_line;

?? OLDTITLE ??

        CASE box_processing OF

        = fdc$box_space_available =

{ Add a line of text to the object.
{ We want to fill the object with text if possible.

          line_count := line_count + 1;
          p_line_splits^ [line_count].position := start_line_index;
          p_line_splits^ [line_count].length := line_text_count;
          IF line_count = height THEN
            box_processing := fdc$box_space_full;
            test_for_last_line;
          IFEND;


        ELSE { fdc$box_space_full }

{ Push lines up in the object and then put the new line at the end.

          FOR push_index := 2 TO height DO
            p_line_splits^ [push_index - 1].position := p_line_splits^ [push_index].position;
            p_line_splits^ [push_index - 1].length := p_line_splits^ [push_index].length;
          FOREND;

          p_line_splits^ [height].position := start_line_index;
          p_line_splits^ [height].length := line_text_count;

{ When the object is full, test to see if the object contains the desired data at the
{ desired position.

          test_for_last_line;

        CASEND;

      PROCEND record_line;

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

{ PURPOSE:
{   This procedure picks up text to write out to the terminal.  The width of the
{   text written to the terminal manager must equal the width of the object.  When
{   the terminal user types into the visible area of the object, the terminal user
{   believes he/she is replacing characters.  If the text length were less than the width
{   of the object, the terminal user would see spaces to separate words, but the end of the
{   input is the last typed character on the line.

      PROCEDURE write_text_box;

        VAR
          current_line: 0 .. fdc$maximum_y_position,
          last_position: fdt$text_length,
          p_screen_text: ^fdt$text;

        PUSH p_screen_text: [width];
        IF line_count > 0 THEN
          p_screen_text^ := p_text^ (p_line_splits^ [1].position, p_line_splits^ [1].length);
          p_form_object_statuses^ [fragment_object_index].character_position := p_line_splits^ [1].position;
          p_form_object_statuses^ [fragment_object_index].data_length := p_line_splits^ [1].length;

        ELSE { Space fill rest of text box.
          p_screen_text^ := '';
          p_form_object_statuses^ [fragment_object_index].character_position := 1;
          p_form_object_statuses^ [fragment_object_index].data_length := 0;
        IFEND;

        output_screen_text (p_form_status^.p_form_object_statuses^ [fragment_object_index].field_number,
              p_screen_text);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

        last_position := p_form_object_statuses^ [fragment_object_index].character_position +
              p_form_object_statuses^ [fragment_object_index].data_length - 1;
        current_line := 1;
        fragment_object_index := next_object_index;

        WHILE fragment_object_index <> 0 DO
          IF current_line < line_count THEN
            current_line := current_line + 1;
            p_screen_text^ := p_text^ (p_line_splits^ [current_line].position,
                  p_line_splits^ [current_line].length);
            p_form_object_statuses^ [fragment_object_index].character_position :=
                  p_line_splits^ [current_line].position;
            p_form_object_statuses^ [fragment_object_index].data_length :=
                  p_line_splits^ [current_line].length;
            last_position := p_form_object_statuses^ [fragment_object_index].character_position +
                  p_form_object_statuses^ [fragment_object_index].data_length - 1;

          ELSE { Space fill rest of text box.
            p_screen_text^ := '';
            p_form_object_statuses^ [fragment_object_index].character_position := last_position;
            p_form_object_statuses^ [fragment_object_index].data_length := 0;
          IFEND;

          output_screen_text (p_form_status^.p_form_object_statuses^ [fragment_object_index].field_number,
                p_screen_text);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

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

      PROCEND write_text_box;

?? OLDTITLE, EJECT ??

      word_wrap_target_position := target_position;

      CASE target_position.key OF

      = fdc$page_data_first =

{ Move the first character of text to the top of the object.

        word_wrap_target_position.key := fdc$top_of_box;
        word_wrap_target_position.data_index := 1;

      = fdc$page_data_last =

{ Move the last character of text to the bottom of the object.

        word_wrap_target_position.key := fdc$bottom_of_box;
        word_wrap_target_position.data_index := STRLENGTH (p_text^);
        ;

      = fdc$page_data_forward =

{ Move first character of the next page to top of object.  The first character of the next page
{ is the last character of this page + 1;

        word_wrap_target_position.key := fdc$top_of_box;
        word_wrap_target_position.data_index := p_form_object_statuses^ [object_index].character_position +
              p_form_object_statuses^ [object_index].data_length;
        next_fragment_object_index := next_object_index;

      /find_last_character_in_box/
        WHILE next_fragment_object_index <> 0 DO
          word_wrap_target_position.data_index := p_form_object_statuses^ [next_fragment_object_index].
                character_position + p_form_object_statuses^ [next_fragment_object_index].data_length;
          next_fragment_object_index := p_form_object_definitions^ [next_fragment_object_index].
                next_fragment_object_index;
        WHILEND /find_last_character_in_box/;

      = fdc$page_data_backward =

{ Move first character of the object - 1 to bottom of the object.

        word_wrap_target_position.key := fdc$bottom_of_box;
        IF p_form_object_statuses^ [object_index].character_position > 1 THEN
          word_wrap_target_position.data_index := p_form_object_statuses^ [object_index].character_position -
                1;
        ELSE
          word_wrap_target_position.data_index := 1;
        IFEND;

      = fdc$scroll_data_forward =
        word_wrap_target_position.key := fdc$top_of_box;

      = fdc$scroll_data_backward =
        word_wrap_target_position.key := fdc$bottom_of_box;

      = fdc$current_data_position =
        word_wrap_target_position.key := fdc$top_of_box;
        word_wrap_target_position.data_index := p_form_object_statuses^ [object_index].character_position;

      = fdc$shift_characters =
        word_wrap_target_position.key := fdc$top_of_box;
        position := p_form_object_statuses^ [object_index].character_position + target_position.shift;
        IF position < 1 THEN
          position := 1;
        IFEND;
        IF position > STRLENGTH (p_text^) THEN
          position := STRLENGTH (p_text^) + 1;
        IFEND;
        word_wrap_target_position.data_index := position;
      ELSE { fdc$top_of_box, fdc$bottom_of_box are already setup.}
      CASEND;

      line_processing := fdc$start_next_line;
      start_line_index := 1;
      text_index := 0;
      PUSH p_line_splits: [1 .. height];
      line_count := 0;
      box_processing := fdc$box_space_available;

      REPEAT

{ Each cycle may change no more than one line processing state.

        fill_line;
      UNTIL line_processing = fdc$line_processing_complete;
      write_text_box;
    PROCEND wrap_words;

?? OLDTITLE, EJECT ??

    status.normal := TRUE;
    p_form_object_statuses := p_form_status^.p_form_object_statuses;
    p_form_object_definitions := p_form_status^.p_form_object_definitions;
    fragment_object_index := object_index;

    CASE text_box_processing OF

    = fdc$wrap_characters =
      wrap_characters;

    ELSE {fdc$wrap_words}
      wrap_words;

    CASEND;

  PROCEND format_screen_text;

?? NEWTITLE := 'location_covered_by_form', EJECT ??

{ PURPOSE:
{   This function verifies that the specified location is not covered by another form.
{ NOTE:
{   The only forms that need to be checkes are those 'higher' than the form containing the object.

  FUNCTION location_covered_by_form
    (    p_form_status: ^fdt$form_status;
         x_position: fdt$x_position;
         y_position: fdt$y_position): boolean;

    VAR
      form_area: fdt$form_area,
      form_identifier: fdt$form_identifier,
      p_new_form_status: ^fdt$form_status;

    location_covered_by_form := FALSE;
    p_new_form_status := p_form_status;
    WHILE (p_new_form_status^.next_higher_form <> 0) DO
      p_new_form_status := ^fdv$screen_status.p_forms_status^ [p_new_form_status^.next_higher_form];
      form_area := p_new_form_status^.p_form_definition^.form_area;
      IF form_area.key = fdc$defined_area THEN
        IF (x_position >= p_new_form_status^.form_x_position) AND
              (x_position <= (p_new_form_status^.form_x_position + form_area.width - 1)) AND
              (y_position >= p_new_form_status^.form_y_position) AND
              (y_position <= (p_new_form_status^.form_y_position + form_area.height - 1)) THEN
          location_covered_by_form := TRUE;
          RETURN;
        IFEND;
      ELSE

{ The entire screen is covered by the form.

        location_covered_by_form := TRUE;
        RETURN;
      IFEND;
    WHILEND;

  FUNCEND location_covered_by_form;


?? OLDTITLE ??
?? TITLE := 'page_table', EJECT ??

  PROCEDURE page_table
    (    p_form_status: ^fdt$form_status;
         p_form_table_definition: ^fdt$form_table_definition;
         table_index: fdt$table_index;
         occurrence_shift: integer;
         field_number: cst$field_number;
         cursor_character_position: cst$character_position;
         cursor_line_number: cst$line_number;
     VAR status: ost$status);

    VAR
      character_position: cst$character_position,
      line_number: cst$line_number,
      terminal_status: ost$status;

    status.normal := TRUE;
    shift_table (p_form_status, p_form_table_definition, table_index, occurrence_shift, 0, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    csv$vector.position_cursor^ (field_number, cursor_character_position, cursor_line_number,
          character_position, line_number, terminal_status);
    IF NOT terminal_status.normal THEN
      fdp$convert_terminal_status (terminal_status, status);
    IFEND;

  PROCEND page_table;

?? OLDTITLE ??
?? TITLE := 'put_graphic_attribute', EJECT ??

  PROCEDURE put_graphic_attribute
    (    graphic_identifier: cst$graphic_identifier;
         display_attribute_set: fdt$display_attribute_set;
     VAR status: ost$status);

    VAR
      attribute_set: cst$attribute_set,
      display_attribute: fdt$display_attribute,
      terminal_status: ost$status;

    status.normal := TRUE;
    IF (display_attribute_set <> $fdt$display_attribute_set []) THEN
      attribute_set := $cst$attribute_set [];
      FOR display_attribute := LOWERVALUE (fdt$display_attribute) TO UPPERVALUE (fdt$display_attribute) DO
        IF display_attribute IN display_attribute_set THEN

{ Translate Screen Formatting display attributes to Screen Manager display
{ attributes.

          CASE display_attribute OF

          = fdc$black_foreground =
            attribute_set := attribute_set + $cst$attribute_set [csc$f_black];

          = fdc$black_background =
            attribute_set := attribute_set + $cst$attribute_set [csc$b_black];

          = fdc$blue_foreground =
            attribute_set := attribute_set + $cst$attribute_set [csc$f_blue];

          = fdc$blue_background =
            attribute_set := attribute_set + $cst$attribute_set [csc$b_blue];

          = fdc$green_foreground =
            attribute_set := attribute_set + $cst$attribute_set [csc$f_green];

          = fdc$green_background =
            attribute_set := attribute_set + $cst$attribute_set [csc$b_green];

          = fdc$magenta_foreground =
            attribute_set := attribute_set + $cst$attribute_set [csc$f_magenta];

          = fdc$magenta_background =
            attribute_set := attribute_set + $cst$attribute_set [csc$b_magenta];

          = fdc$red_foreground =
            attribute_set := attribute_set + $cst$attribute_set [csc$f_red];

          = fdc$red_background =
            attribute_set := attribute_set + $cst$attribute_set [csc$b_red];

          = fdc$cyan_foreground =
            attribute_set := attribute_set + $cst$attribute_set [csc$f_cyan];

          = fdc$cyan_background =
            attribute_set := attribute_set + $cst$attribute_set [csc$b_cyan];

          = fdc$yellow_foreground =
            attribute_set := attribute_set + $cst$attribute_set [csc$f_yellow];

          = fdc$yellow_background =
            attribute_set := attribute_set + $cst$attribute_set [csc$b_yellow];

          = fdc$white_foreground =
            attribute_set := attribute_set + $cst$attribute_set [csc$f_white];

          = fdc$white_background =
            attribute_set := attribute_set + $cst$attribute_set [csc$b_white];

          = fdc$fine_line, fdc$fine_border =
            attribute_set := attribute_set + $cst$attribute_set [csc$line_fine];

          = fdc$medium_line, fdc$medium_border =
            attribute_set := attribute_set + $cst$attribute_set [csc$line_medium];

          = fdc$bold_line, fdc$bold_border =
            attribute_set := attribute_set + $cst$attribute_set [csc$line_bold];

          = fdc$protect =
            attribute_set := attribute_set + $cst$attribute_set [csc$protected];

          = fdc$inverse_video =
            attribute_set := attribute_set + $cst$attribute_set [csc$p_inverse];

          = fdc$low_intensity =
            attribute_set := attribute_set + $cst$attribute_set [csc$p_alternate_intensity];

          = fdc$high_intensity =
            attribute_set := attribute_set + $cst$attribute_set [csc$p_alternate_intensity];

          = fdc$blink =
            attribute_set := attribute_set + $cst$attribute_set [csc$p_blink];

          ELSE { Display attribute does not apply to graphic. }
          CASEND;
        IFEND;
      FOREND;

      attribute_set := attribute_set + $cst$attribute_set [csc$protected];
      csv$vector.change_graphic_attributes^ (graphic_identifier, attribute_set, terminal_status);
      IF NOT terminal_status.normal THEN
        fdp$convert_terminal_status (terminal_status, status);
      IFEND;
    IFEND;
  PROCEND put_graphic_attribute;

?? TITLE := 'put_text_attribute', EJECT ??

  PROCEDURE put_text_attribute
    (    field_number: cst$field_number;
         display_attribute_set: fdt$display_attribute_set;
         io_mode: fdt$io_mode;
     VAR status: ost$status);

    VAR
      attribute_set: cst$attribute_set,
      field_attributes: array [1 .. 1] of cst$field_attribute,
      display_attribute: fdt$display_attribute,
      terminal_status: ost$status;

    status.normal := TRUE;
    attribute_set := $cst$attribute_set [];
    FOR display_attribute := LOWERVALUE (fdt$display_attribute) TO UPPERVALUE (fdt$display_attribute) DO
      IF display_attribute IN display_attribute_set THEN

{ Translate Screen Formatting display attributes to Screen Manager display
{ attributes.

        CASE display_attribute OF

        = fdc$black_foreground =
          attribute_set := attribute_set + $cst$attribute_set [csc$f_black];

        = fdc$black_background =
          attribute_set := attribute_set + $cst$attribute_set [csc$b_black];

        = fdc$blue_foreground =
          attribute_set := attribute_set + $cst$attribute_set [csc$f_blue];

        = fdc$blue_background =
          attribute_set := attribute_set + $cst$attribute_set [csc$b_blue];

        = fdc$green_foreground =
          attribute_set := attribute_set + $cst$attribute_set [csc$f_green];

        = fdc$green_background =
          attribute_set := attribute_set + $cst$attribute_set [csc$b_green];

        = fdc$magenta_foreground =
          attribute_set := attribute_set + $cst$attribute_set [csc$f_magenta];

        = fdc$magenta_background =
          attribute_set := attribute_set + $cst$attribute_set [csc$b_magenta];

        = fdc$red_foreground =
          attribute_set := attribute_set + $cst$attribute_set [csc$f_red];

        = fdc$red_background =
          attribute_set := attribute_set + $cst$attribute_set [csc$b_red];

        = fdc$cyan_foreground =
          attribute_set := attribute_set + $cst$attribute_set [csc$f_cyan];

        = fdc$cyan_background =
          attribute_set := attribute_set + $cst$attribute_set [csc$b_cyan];

        = fdc$yellow_foreground =
          attribute_set := attribute_set + $cst$attribute_set [csc$f_yellow];

        = fdc$yellow_background =
          attribute_set := attribute_set + $cst$attribute_set [csc$b_yellow];

        = fdc$white_foreground =
          attribute_set := attribute_set + $cst$attribute_set [csc$f_white];

        = fdc$white_background =
          attribute_set := attribute_set + $cst$attribute_set [csc$b_white];

        = fdc$protect =
          attribute_set := attribute_set + $cst$attribute_set [csc$protected];

        = fdc$hidden =
          attribute_set := attribute_set + $cst$attribute_set [csc$hidden];

        = fdc$inverse_video =
          attribute_set := attribute_set + $cst$attribute_set [csc$p_inverse];

        = fdc$low_intensity =
          attribute_set := attribute_set + $cst$attribute_set [csc$p_alternate_intensity];

        = fdc$high_intensity =
          attribute_set := attribute_set + $cst$attribute_set [csc$p_alternate_intensity];

        = fdc$blink =
          attribute_set := attribute_set + $cst$attribute_set [csc$p_blink];

        = fdc$underline =
          attribute_set := attribute_set + $cst$attribute_set [csc$p_underline];

        = fdc$italic_display_attribute =
          attribute_set := attribute_set + $cst$attribute_set [csc$l_italic];

        = fdc$title_display_attribute =
          attribute_set := attribute_set + $cst$attribute_set [csc$l_title];

        = fdc$input_display_attribute =
          attribute_set := attribute_set + $cst$attribute_set [csc$l_input];

        = fdc$error_display_attribute =
          attribute_set := attribute_set + $cst$attribute_set [csc$l_error];

        = fdc$message_display_attribute =
          attribute_set := attribute_set + $cst$attribute_set [csc$l_message];

        = fdc$display_left_to_right =
          csv$vector.change_field_direction^ (field_number, csc$direction_left_to_right, terminal_status);
          IF NOT terminal_status.normal THEN
            fdp$convert_terminal_status (terminal_status, status);
            RETURN;
          IFEND;

        = fdc$display_right_to_left =
          csv$vector.change_field_direction^ (field_number, csc$direction_right_to_left, terminal_status);
          IF NOT terminal_status.normal THEN
            fdp$convert_terminal_status (terminal_status, status);
            RETURN;
          IFEND;


        ELSE { Attribute does not apply. }
        CASEND;
      IFEND;
    FOREND;

    CASE io_mode OF

    = fdc$terminal_input, fdc$terminal_input_output =
      field_attributes [1].key := csc$fld_input;
      IF fdc$protect IN display_attribute_set THEN
        field_attributes [1].input := FALSE;
      ELSE
        field_attributes [1].input := TRUE;
      IFEND;
      csv$vector.change_field_attributes^ (field_number, field_attributes, terminal_status);
      IF NOT terminal_status.normal THEN
        fdp$convert_terminal_status (terminal_status, status);
      IFEND;
    ELSE
    CASEND;

    csv$vector.change_text_attributes^ (field_number, attribute_set, terminal_status);
    IF NOT terminal_status.normal THEN
      fdp$convert_terminal_status (terminal_status, status);
    IFEND;
  PROCEND put_text_attribute;

?? TITLE := 'replace_screen_variable ', EJECT ??

{ PURPOSE:
{   This procedure transfers text for variable and constant text objects to the Screen Manager.

  PROCEDURE replace_screen_variable
    (    p_text: ^fdt$text;
         field_object_index: fdt$object_index;
         status_object_index: fdt$object_index;
         screen_visible_length: fdt$screen_variable_length;
         p_form_status: ^fdt$form_status;
         target_position: fdt$target_position;
     VAR status: ost$status);

    VAR
      end_of_text: boolean,
      formatted_text_length: integer,
      p_form_object_statuses: ^array [1 .. * ] of fdt$form_object_status,
      p_screen_text: ^fdt$text,
      position: integer,
      shift: integer,
      terminal_status: ost$status,
      text_length: fdt$text_length;

    status.normal := TRUE;
    p_form_object_statuses := p_form_status^.p_form_object_statuses;
    csv$vector.change_io_position^ (p_form_status^.p_form_object_statuses^ [field_object_index].
          field_number, 1, terminal_status);
    IF NOT terminal_status.normal THEN
      fdp$convert_terminal_status (terminal_status, status);
      RETURN;
    IFEND;

      CASE target_position.key OF

    = fdc$page_data_first =

{ Use maximun shift needed to put first character of data in first character position of object.

      shift := - STRLENGTH(p_text^);

    = fdc$page_data_last =

{ Use maximun shift needed to put last character of data in last character position of object.

      shift := STRLENGTH(p_text^);

    = fdc$page_data_forward =

{ Shift data forward the size of the object.

      shift := screen_visible_length;

    = fdc$page_data_backward =

{ Shift data backward the size of the object.

      shift := - screen_visible_length;
    = fdc$scroll_data_forward =

{ Compute shift needed to move character under cursor to first position in object.

      shift := target_position.data_index - p_form_object_statuses^ [field_object_index].character_position;

   = fdc$scroll_data_backward =

{ Compute shift needed to move character under cursor to last position in object.

      shift := p_form_object_statuses^ [field_object_index].character_position + screen_visible_length
              - 1 - target_position.data_index;
      shift := -shift;

    = fdc$current_data_position =
      shift := 0;

    = fdc$shift_characters =
      shift := target_position.shift;

    ELSE { fdc$top_of_box, fdc$bottom_of_box do not apply.}
      shift := 0;
    CASEND;

    position := p_form_object_statuses^ [status_object_index].character_position + shift;

{ If shift is past the first character of the text, set to display first character of text.

    IF position < 1 THEN
      position := 1;
    IFEND;


{ If first displayed character position puts the end of the text outside the visible screen
{ area, set the first displayed character position so that end of text is displayed.

    text_length := STRLENGTH (p_text^);
    IF ((position + screen_visible_length - 1) > text_length) THEN
      position := text_length - screen_visible_length + 1;
    IFEND;
    IF position < 1 THEN
      position := 1;
    IFEND;

    p_form_object_statuses^ [status_object_index].character_position := position;
    formatted_text_length := text_length - position + 1;

{ If hidden editing is specified, give the Screen Manager all of the text the terminal user
{ can edit. The text the terminal user may edit is less than the Screen Manager field length
{ when the text is not at position 1. Screen Formatting cannot resize the Screen Manager field
{ since changes the field priority.  That is a partially hidden field may become completely
{ visibile. When the text the user can modify is shorter than the Screen Manager field length
{ an insert character followed by a delete character will restore the last character.
{ If hidden editing is not specified,
{  give the Screen Manager no more text than the visible length of text object on the screen.

    IF NOT p_form_status^.p_form_definition^.hidden_editing THEN
      IF text_length > screen_visible_length THEN
        formatted_text_length := screen_visible_length;
      IFEND;
    IFEND;

    p_form_object_statuses^ [status_object_index].data_length := formatted_text_length;
    p_screen_text := ^p_text^ (position, formatted_text_length);
    csv$vector.put_text^ (p_screen_text, TRUE, end_of_text, terminal_status);
    IF NOT terminal_status.normal THEN
      fdp$convert_terminal_status (terminal_status, status);
    IFEND;

  PROCEND replace_screen_variable;

?? TITLE := 'reset_read_forms_indices', EJECT ??

{ PURPOSE:
{   This procedure resets the read forms index of all variable objects in the form.
{

  PROCEDURE [INLINE] reset_read_forms_indices
    (    form_identifier: fdt$form_identifier);

    VAR
      object_index: fdt$object_index,
      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_form_status := ^fdv$screen_status.p_forms_status^ [form_identifier];
    p_form_object_definitions := p_form_status^.p_form_object_definitions;
    p_form_object_statuses := p_form_status^.p_form_object_statuses;

    FOR object_index := 1 TO UPPERBOUND (p_form_object_statuses^) DO
      CASE p_form_object_definitions^ [object_index].key OF
      = fdc$form_stored_variable, fdc$form_variable_text, fdc$form_variable_text_box =
        p_form_object_statuses^ [object_index].changed_by_read_forms_index := 0;
      ELSE
      CASEND;
    FOREND;

  PROCEND reset_read_forms_indices;

?? TITLE := 'set_attribute', EJECT ??

  PROCEDURE set_attribute
    (    p_form_status: ^fdt$form_status;
         p_form_variable_definition: ^fdt$form_variable_definition;
         display_attribute_set: fdt$display_attribute_set;
         object_index: fdt$object_index;
         p_form_object_definition: ^fdt$form_object_definition;
     VAR table_shifted: boolean;
     VAR status: ost$status);

    VAR
      first_displayed_occurrence: fdt$occurrence,
      first_stored_occurrence: integer,
      last_displayed_occurrence: fdt$occurrence,
      occurrence_shift: integer,
      p_form_module: ^fdt$form_module,
      p_form_object_statuses: ^array [1 .. * ] of fdt$form_object_status,
      p_form_table_definition: ^fdt$form_table_definition,
      p_table_object: ^fdt$table_object,
      p_table_objects: ^array [1 .. * ] of fdt$table_object,
      p_table_variable: ^fdt$table_variable,
      p_table_variables: ^array [1 .. * ] of fdt$table_variable,
      table_index: fdt$table_index,
      variable_index: fdt$variable_index;

    table_shifted := FALSE;
    status.normal := TRUE;
    p_form_object_statuses := p_form_status^.p_form_object_statuses;
    IF NOT p_form_variable_definition^.table_exists THEN

{ The variable does not belong to a table.

      put_text_attribute (p_form_object_statuses^ [object_index].field_number, display_attribute_set,
            p_form_variable_definition^.io_mode, status);
      RETURN;
    IFEND;

{ The variable is a member of a table.

    table_index := p_form_variable_definition^.table_index;
    p_form_table_definition := ^p_form_status^.p_form_table_definitions^ [table_index];
    first_displayed_occurrence := p_form_status^.p_form_table_statuses^ [table_index].
          first_displayed_occurrence;
    last_displayed_occurrence := first_displayed_occurrence + p_form_table_definition^.visible_occurrence - 1;
    IF ((p_form_object_definition^.occurrence < first_displayed_occurrence) OR
          (p_form_object_definition^.occurrence > last_displayed_occurrence)) THEN
      first_stored_occurrence := p_form_object_definition^.occurrence -
            (p_form_table_definition^.visible_occurrence DIV 2);
      occurrence_shift := first_stored_occurrence - first_displayed_occurrence;
      shift_table (p_form_status, p_form_table_definition, table_index, occurrence_shift, 0, status);
      first_displayed_occurrence := p_form_status^.p_form_table_statuses^ [table_index].
            first_displayed_occurrence;
      table_shifted := TRUE;
    ELSE

{ Do not shift the variables in the table when the object is visible so that
{ the screen changes to
{ the terminal user are minimized.

      p_form_module := p_form_status^.p_form_module;
      p_table_variables := fdp$ptr_table_variables (p_form_table_definition^.table_variables, p_form_module);

    /find_variable/
      FOR variable_index := 1 TO p_form_table_definition^.table_variables.active_number DO
        p_table_variable := ^p_table_variables^ [variable_index];
        IF p_table_variable^.name = p_form_object_definition^.name THEN
          EXIT /find_variable/;
        IFEND;
      FOREND /find_variable/;

      p_table_objects := fdp$ptr_table_objects (p_table_variable^.table_objects, p_form_module);
      p_table_object := ^p_table_objects^ [p_form_object_definition^.occurrence - first_displayed_occurrence +
            1];
      put_text_attribute (p_form_object_statuses^ [p_table_object^.object_index].field_number,
            display_attribute_set, p_form_variable_definition^.io_mode, status);
    IFEND;
  PROCEND set_attribute;

?? TITLE := 'set_table_cursor_position', EJECT ??

  PROCEDURE set_table_cursor_position
    (    p_form_status: ^fdt$form_status;
         p_form_variable_definition: ^fdt$form_variable_definition;
         p_form_object_definition: ^fdt$form_object_definition;
     VAR cursor_object_index: fdt$object_index;
     VAR cursor_character_position: fdt$character_position;
     VAR table_shifted: boolean;
     VAR status: ost$status);

    VAR
      character_position: cst$character_position,
      first_displayed_occurrence: fdt$occurrence,
      first_object_index: fdt$object_index,
      first_stored_occurrence: integer,
      last_displayed_occurrence: fdt$occurrence,
      line_number: cst$line_number,
      object_index: fdt$object_index,
      occurrence_shift: integer,
      p_first_object_definition: ^fdt$form_object_definition,
      p_form_module: ^fdt$form_module,
      p_form_object_statuses: ^array [1 .. * ] of fdt$form_object_status,
      p_form_table_definition: ^fdt$form_table_definition,
      p_table_object: ^fdt$table_object,
      p_table_objects: ^array [1 .. * ] of fdt$table_object,
      p_table_variable: ^fdt$table_variable,
      p_table_variables: ^array [1 .. * ] of fdt$table_variable,
      table_index: fdt$table_index,
      terminal_status: ost$status,
      variable_index: fdt$variable_index,
      variable_name: ost$name,
      variable_shift: integer,
      width: fdt$width;

?? NEWTITLE := 'set_invalid_cursor_position', EJECT??
    PROCEDURE set_invalid_cursor_position;
      osp$set_status_abnormal (fdc$format_display_identifier, fde$unknown_occurrence, '', status);
      osp$append_status_integer (osc$status_parameter_delimiter,
            $INTEGER (p_form_object_definition^.occurrence), 10, FALSE, status);
      osp$append_status_parameter (osc$status_parameter_delimiter,
            p_form_object_definition^.name, status);
      osp$append_status_parameter (osc$status_parameter_delimiter,
            p_form_status^.p_form_definition^.form_name, status);
    PROCEND set_invalid_cursor_position;

?? OLDTITLE, EJECT ??

{ Shift table object occurrences to make cursor object visible.
{ Shift text for variable object to make cursor character position visible.

    status.normal := TRUE;
    table_shifted := FALSE;
    table_index := p_form_variable_definition^.table_index;
    variable_name := p_form_variable_definition^.name;
    p_form_object_statuses := p_form_status^.p_form_object_statuses;
    p_form_table_definition := ^p_form_status^.p_form_table_definitions^ [table_index];

{ The user may change the table size after setting the cursor position.
{ Check to make sure the cursor is within the active size of the table.

    IF p_form_object_definition^.occurrence >
          p_form_status^.p_form_table_statuses^[table_index].last_active_occurrence THEN
      set_invalid_cursor_position;
      RETURN;
    IFEND;

    first_displayed_occurrence := p_form_status^.p_form_table_statuses^ [table_index].
          first_displayed_occurrence;
    first_stored_occurrence := first_displayed_occurrence;
    last_displayed_occurrence := first_displayed_occurrence + p_form_table_definition^.visible_occurrence - 1;
    p_form_module := p_form_status^.p_form_module;
    p_table_variables := fdp$ptr_table_variables (p_form_table_definition^.table_variables, p_form_module);

{ Find objects for variable definition.

  /find_variable/
    FOR variable_index := 1 TO p_form_table_definition^.table_variables.active_number DO
      p_table_variable := ^p_table_variables^ [variable_index];
      IF p_table_variable^.name = variable_name THEN
        EXIT /find_variable/;
      IFEND;
    FOREND /find_variable/;

    p_table_objects := fdp$ptr_table_objects (p_table_variable^.table_objects, p_form_module);
    first_object_index := p_table_objects^ [1].object_index;
    p_first_object_definition := ^p_form_status^.p_form_object_definitions^ [first_object_index];
    width := p_first_object_definition^.text_variable_width;
    compute_cursor_shift (width,
          p_form_object_statuses^ [cursor_object_index].character_position, cursor_character_position,
          variable_shift);
    IF variable_shift <> 0 THEN
      table_shifted := TRUE;

{ The variables must be shifted left or right to make the cursor visible to the
{ terminal user.

      occurrence_shift := 0;
    IFEND;
    IF ((p_form_object_definition^.occurrence < first_displayed_occurrence) OR
          (p_form_object_definition^.occurrence > last_displayed_occurrence)) THEN
      table_shifted := TRUE;

{ The table occurrences must be be shifted forward or backward to make the
{ cursor visible to the
{ terminal user.

      first_stored_occurrence := p_form_object_definition^.occurrence -
            (p_form_table_definition^.visible_occurrence DIV 2);
      occurrence_shift := first_stored_occurrence - first_displayed_occurrence;
    IFEND;
    IF table_shifted THEN
      shift_table (p_form_status, p_form_table_definition, table_index, occurrence_shift, variable_shift,
            status);
      first_stored_occurrence := p_form_status^.p_form_table_statuses^ [table_index].
            first_displayed_occurrence;
    IFEND;
    cursor_object_index := p_table_objects^ [p_form_object_definition^.occurrence - first_stored_occurrence +
          1].object_index;
    cursor_character_position := cursor_character_position -
          p_form_object_statuses^ [cursor_object_index].character_position + 1;
    csv$vector.position_cursor^ (p_form_status^.p_form_object_statuses^ [cursor_object_index].
          field_number, cursor_character_position, 1, character_position, line_number, terminal_status);
    IF NOT terminal_status.normal THEN
      set_invalid_cursor_position;
    IFEND;

  PROCEND set_table_cursor_position;

?? TITLE := 'set_text_box_cursor_position', EJECT ??

  PROCEDURE set_text_box_cursor_position
    (    p_form_status: ^fdt$form_status;
         p_text: ^fdt$text;
         object_index: fdt$object_index;
         next_object_index: fdt$object_index;
         text_box_processing: fdt$text_box_processing;
         width: fdt$width;
         height: fdt$height;
         cursor_character_position: fdt$character_position;
     VAR status: ost$status);

    VAR
      character_position: cst$character_position,
      cursor_object_index: fdt$object_index,
      current_object_index: fdt$object_index,
      first_displayed_character: integer,
      first_stored_character: integer,
      last_displayed_character: integer,
      line_number: cst$line_number,
      p_form_object_definitions: ^array [1 .. * ] of fdt$form_object_definition,
      p_form_object_statuses: ^array [1 .. * ] of fdt$form_object_status,
      target_position: fdt$target_position,
      terminal_status: ost$status,
      screen_visible_length: fdt$text_length,
      shift: integer;

{ If cursor position is visible, then do not shift the data in the
{ text box.  Otherwise try to shift the cursor position to the
{ middle of the text box.

    status.normal := TRUE;
    p_form_object_statuses := p_form_status^.p_form_object_statuses;
    p_form_object_definitions := p_form_status^.p_form_object_definitions;
    first_stored_character := p_form_status^.p_form_object_statuses^ [object_index].character_position;
    first_displayed_character := first_stored_character;
    screen_visible_length := width * height;
    last_displayed_character := first_displayed_character + screen_visible_length - 1;
    IF ((cursor_character_position < first_displayed_character) OR
          (cursor_character_position > last_displayed_character)) THEN

{ Cursor is not visible.
{ Shift stored data to make cursor visible.  Try to put cursor in middle of text box.

      first_stored_character := cursor_character_position - (screen_visible_length DIV 2);
      target_position.key := fdc$shift_characters;
      target_position.shift := first_stored_character - p_form_object_statuses^
            [object_index].character_position;
      format_screen_text (p_text, p_form_status, object_index, next_object_index, text_box_processing, width,
            height, target_position, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

{ Find object that contains the cursor position.

    cursor_object_index := object_index;
    last_displayed_character := p_form_object_statuses^ [object_index].character_position + width - 1;
    current_object_index := next_object_index;

  /find_fragment/
    WHILE current_object_index <> 0 DO
      IF last_displayed_character >= cursor_character_position THEN
        EXIT /find_fragment/;
      IFEND;

      last_displayed_character := last_displayed_character + width;
      cursor_object_index := current_object_index;
      current_object_index := p_form_object_definitions^ [current_object_index].next_fragment_object_index;
    WHILEND /find_fragment/;

    character_position := width - (last_displayed_character - cursor_character_position);
    csv$vector.position_cursor^ (p_form_object_statuses^ [cursor_object_index].field_number,
          character_position, 1, character_position, line_number, terminal_status);
    IF NOT terminal_status.normal THEN
      fdp$convert_terminal_status (terminal_status, status);
    IFEND;

  PROCEND set_text_box_cursor_position;


?? TITLE := 'shift_table', EJECT ??

  PROCEDURE shift_table
    (    p_form_status: ^fdt$form_status;
         p_form_table_definition: ^fdt$form_table_definition;
         table_index: fdt$table_index;
         occurrence_shift: integer;
         variable_shift: integer;
     VAR status: ost$status);

    VAR
      next_object_index: fdt$object_index,
      object_index: fdt$object_index,
      occurrence: integer,
      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_object_statuses: ^array [1 .. * ] of fdt$form_object_status,
      p_form_variable_definition: ^fdt$form_variable_definition,
      p_form_variable_definitions: ^array [1 .. * ] of fdt$form_variable_definition,
      p_screen_record: ^array [1 .. *] of cell,
      p_screen_variable: ^fdt$text,
      p_table_object: ^fdt$table_object,
      p_table_objects: ^array [1 .. * ] of fdt$table_object,
      p_table_variable: ^fdt$table_variable,
      p_table_variables: ^array [1 .. * ] of fdt$table_variable,
      position: integer,
      record_position: fdt$record_position,
      screen_variable_length: fdt$text_length,
      screen_visible_length: fdt$text_length,
      status_object_index: fdt$object_index,
      table_object_index: fdt$object_index,
      target_position: fdt$target_position,
      variable_index: fdt$variable_index,
      screen_object_index: fdt$object_index;

    status.normal := TRUE;

{ Compute first displayed variable occurrence. The first displayed occurrence
{ must not be less than
{ 1.  The last displayed occurrence must not be greater than the number of
{ stored occurrences
{ in the table.

    occurrence := p_form_status^.p_form_table_statuses^ [table_index].first_displayed_occurrence +
          occurrence_shift;
    IF occurrence < 1 THEN
      occurrence := 1;
    ELSEIF (occurrence + p_form_table_definition^.visible_occurrence - 1) >
          p_form_status^.p_form_table_statuses^ [table_index].last_active_occurrence THEN
      occurrence := p_form_status^.p_form_table_statuses^ [table_index].last_active_occurrence -
            p_form_table_definition^.visible_occurrence + 1;
      IF occurrence < 1 THEN
        occurrence := 1;
      IFEND;
    IFEND;

    target_position.key := fdc$shift_characters;
    target_position.shift := variable_shift;
    p_form_status^.p_form_table_statuses^ [table_index].first_displayed_occurrence := occurrence;
    p_form_variable_definitions := p_form_status^.p_form_variable_definitions;
    p_form_module := p_form_status^.p_form_module;
    p_table_variables := fdp$ptr_table_variables (p_form_table_definition^.table_variables, p_form_module);
    p_screen_record := p_form_status^.p_screen_record;
    p_form_object_statuses := p_form_status^.p_form_object_statuses;
    p_form_object_definitions := p_form_status^.p_form_object_definitions;


{ Shift text for all objects for all variables in the table.

  /get_next_variable/
    FOR variable_index := 1 TO p_form_table_definition^.table_variables.active_number DO
      p_table_variable := ^p_table_variables^ [variable_index];
      p_table_objects := fdp$ptr_table_objects (p_table_variable^.table_objects, p_form_module);
      p_form_variable_definition := ^p_form_variable_definitions^ [p_table_variable^.variable_index];
      screen_variable_length := p_form_variable_definition^.screen_variable_length;
      screen_object_index := 1;

    /shift_object/
      FOR table_object_index := 1 TO p_form_table_definition^.visible_occurrence DO

{ Get object definition for visible object.

        p_table_object := ^p_table_objects^ [table_object_index];
        object_index := p_table_object^.object_index;
        p_form_object_definition := ^p_form_object_definitions^ [object_index];

{ Get stored text to display in visible object.

        p_table_object := ^p_table_objects^ [occurrence + table_object_index - 1];
        status_object_index := p_table_object^.object_index;
        fdp$ptr_screen_variable (p_screen_record,
                p_table_object^.screen_record_position, screen_variable_length, p_screen_variable);
        CASE p_form_object_definition^.key OF

        = fdc$form_variable_text_box =
          next_object_index := p_form_object_definition^.variable_box_fragment_index;
          format_screen_text (p_screen_variable, p_form_status, object_index, next_object_index,
                p_form_object_definition^.variable_box_processing,
                p_form_object_definition^.variable_box_width, p_form_object_definition^.variable_box_height,
                target_position, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

        = fdc$form_variable_text =
          target_position.key := fdc$shift_characters;
          target_position.shift := variable_shift;
          replace_screen_variable (p_screen_variable, object_index, object_index,
                p_form_object_definition^.text_variable_width, p_form_status, target_position, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

{ The text from the stored object may have different display attributes than
{ the visible object.
{ Use attributes of stored object for visible object.

          put_text_attribute (p_form_object_statuses^ [object_index].
                field_number, p_form_object_statuses^ [status_object_index].display_attribute_set,
                p_form_variable_definition^.io_mode, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        ELSE
        CASEND;
      FOREND /shift_object/;

{ Update current character position for all stored, non-visible occurrences of
{ variable objects.

      IF variable_shift <> 0 THEN
        record_position := p_form_object_statuses^ [object_index].character_position;
        FOR table_object_index := p_form_table_definition^.visible_occurrence +
              1 TO p_form_table_definition^.stored_occurrence DO
          p_form_object_statuses^ [p_table_objects^ [table_object_index].object_index].character_position :=
                record_position;
        FOREND;
      IFEND;
    FOREND /get_next_variable/;

  PROCEND shift_table;

?? TITLE := 'shift_table_variable', EJECT ??

  PROCEDURE shift_table_variable
    (    p_form_status: ^fdt$form_status;
         p_form_variable_definition: ^fdt$form_variable_definition;
         target_position: fdt$target_position;
     VAR status: ost$status);

    VAR
      next_object_index: fdt$object_index,
      object_index: fdt$object_index,
      occurrence: fdt$occurrence,
      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_table_definition: ^fdt$form_table_definition,
      p_form_object_statuses: ^array [1 .. * ] of fdt$form_object_status,
      p_screen_record: ^array [1 .. *] of cell,
      p_screen_variable: ^fdt$text,
      p_table_object: ^fdt$table_object,
      p_table_objects: ^array [1 .. * ] of fdt$table_object,
      p_table_variable: ^fdt$table_variable,
      p_table_variables: ^array [1 .. * ] of fdt$table_variable,
      position: integer,
      record_position: fdt$record_position,
      screen_variable_length: fdt$text_length,
      screen_visible_length: fdt$text_length,
      status_object_index: fdt$object_index,
      table_index: fdt$table_index,
      table_object_index: fdt$object_index,
      variable_index: fdt$variable_index,
      variable_name: ost$name;

    status.normal := TRUE;
    table_index := p_form_variable_definition^.table_index;
    variable_name := p_form_variable_definition^.name;
    p_form_table_definition := ^p_form_status^.p_form_table_definitions^ [table_index];
    p_form_module := p_form_status^.p_form_module;
    p_table_variables := fdp$ptr_table_variables (p_form_table_definition^.table_variables, p_form_module);
    p_screen_record := p_form_status^.p_screen_record;
    p_form_object_statuses := p_form_status^.p_form_object_statuses;
    p_form_object_definitions := p_form_status^.p_form_object_definitions;
    occurrence := p_form_status^.p_form_table_statuses^ [table_index].first_displayed_occurrence;

{ Find the variable in the table definition to locate the objects related to
{ the variable definition.

  /find_variable/
    FOR variable_index := 1 TO p_form_table_definition^.table_variables.active_number DO
      p_table_variable := ^p_table_variables^ [variable_index];
      IF (p_table_variable^.name = variable_name) THEN
        EXIT /find_variable/;
      IFEND;
    FOREND /find_variable/;

    p_table_objects := fdp$ptr_table_objects (p_table_variable^.table_objects, p_form_module);
    screen_variable_length := p_form_variable_definition^.screen_variable_length;

{  Shift all the text in all the visible screen objects related to the variable.

  /shift_variable/
    FOR table_object_index := 1 TO p_form_table_definition^.visible_occurrence DO
      p_table_object := ^p_table_objects^ [table_object_index];

{ Get the visible object definition.

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

{ Get the stored text to be displayed in the visible object definition.

      p_table_object := ^p_table_objects^ [occurrence + table_object_index - 1];
      fdp$ptr_screen_variable (p_screen_record,
              p_table_object^.screen_record_position, screen_variable_length, p_screen_variable);
      CASE p_form_object_definition^.key OF

      = fdc$form_variable_text_box =
        next_object_index := p_form_object_definition^.variable_box_fragment_index;
        format_screen_text (p_screen_variable, p_form_status, object_index, next_object_index,
              p_form_object_definition^.variable_box_processing, p_form_object_definition^.variable_box_width,
              p_form_object_definition^.variable_box_height, target_position, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

      = fdc$form_variable_text =
        replace_screen_variable (p_screen_variable, object_index, object_index,
              p_form_object_definition^.text_variable_width, p_form_status, target_position, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

      ELSE
      CASEND;
    FOREND /shift_variable/;

{ Update current character position for all stored, non-visible occurrences of
{ the objects for the variable. The terminal user may later page to see these objects.

    IF target_position.key = fdc$shift_characters THEN
      record_position := p_form_object_statuses^ [object_index].character_position;
      FOR table_object_index := p_form_table_definition^.visible_occurrence +
            1 TO p_form_table_definition^.stored_occurrence DO
        p_form_object_statuses^ [p_table_objects^ [table_object_index].object_index].character_position :=
              record_position;
      FOREND;
    IFEND;
  PROCEND shift_table_variable;

?? TITLE := 'shift_text_box', EJECT ??

  PROCEDURE shift_text_box
    (    p_text: ^fdt$text;
         p_form_status: ^fdt$form_status;
         parent_object_index: fdt$object_index;
         next_object_index: fdt$object_index;
         text_box_processing: fdt$text_box_processing;
         width: fdt$width;
         height: fdt$height;
         cursor_object_index: fdt$object_index;
         character_position: cst$character_position;
         target_position: fdt$target_position;
     VAR status: ost$status);

    VAR
      form_identifier: fdt$form_identifier,
      line_number: cst$line_number,
      output_character_position: cst$character_position,
      terminal_status: ost$status;

    format_screen_text (p_text, p_form_status, parent_object_index, next_object_index, text_box_processing,
          width, height, target_position, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ Delete any previous scheduled formatting due to insertion or deletions of characters.

    form_identifier :=  1 + ((#OFFSET (p_form_status) - #OFFSET (fdv$screen_status.p_forms_status))
          DIV #SIZE (fdt$form_status));
    delete_format_screen_change (form_identifier, parent_object_index);

{ Screen Formatting has moved the cursor. Reposition the cursor to where the terminal user
{ caused the event.

    csv$vector.position_cursor^ (p_form_status^.p_form_object_statuses^ [cursor_object_index].
          field_number, character_position, 1, output_character_position, line_number, terminal_status);
    IF NOT terminal_status.normal THEN
      fdp$convert_terminal_status (terminal_status, status);
    IFEND;
  PROCEND shift_text_box;

?? TITLE := 'shift_text_line', EJECT ??

  PROCEDURE shift_text_line
    (    target_position: fdt$target_position;
         p_text: ^fdt$text;
         object_index: fdt$object_index;
         screen_visible_length: fdt$text_length;
         p_form_status: ^fdt$form_status;
         character_position: cst$character_position;
     VAR status: ost$status);

    VAR
      line_number: cst$line_number,
      output_character_position: cst$character_position,
      terminal_status: ost$status;

    replace_screen_variable (p_text, object_index, object_index, screen_visible_length,
          p_form_status, target_position, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    csv$vector.position_cursor^ (p_form_status^.p_form_object_statuses^ [object_index].field_number,
          character_position, 1, output_character_position, line_number, terminal_status);
    IF NOT terminal_status.normal THEN
      fdp$convert_terminal_status (terminal_status, status);
    IFEND;

  PROCEND shift_text_line;

?? TITLE := 'shift_variable', EJECT ??
{ PURPOSE:
{   This procedure shifts a variable.  The shift may be caused by either paging or scrolling
{   events.  The procedure handles a variable that is not a member of a table and a
{   variable that is a member of a table.  Both variable text and variable text box objects are
{   handled.

  PROCEDURE shift_variable
    (    p_form_status: ^fdt$form_status;
         p_form_variable_definition: ^fdt$form_variable_definition;
         object_index: fdt$object_index;
         cursor_object_index: fdt$object_index;
         screen_visible_length: fdt$screen_variable_length;
         target_position: fdt$target_position;
     VAR status: ost$status);

    VAR
      character_position: cst$character_position,
      line_number: cst$line_number,
      p_form_object_definition: ^fdt$form_object_definition,
      p_text: ^fdt$text,
      terminal_status: ost$status;

    IF NOT p_form_variable_definition^.table_exists THEN

{ This is a variable that does not belong to a table.

     fdp$ptr_screen_variable (p_form_status^.p_screen_record,
           p_form_variable_definition^.screen_record_position,
           p_form_variable_definition^.screen_variable_length, p_text);
     p_form_object_definition := ^p_form_status^.p_form_object_definitions^ [object_index];
     IF p_form_object_definition^.key = fdc$form_variable_text THEN
       shift_text_line (target_position, p_text, object_index, screen_visible_length, p_form_status,
             fdv$screen_status.event_identifier.field_event_character_position, status);
     ELSE
       shift_text_box (p_text, p_form_status, object_index,
             p_form_object_definition^.variable_box_fragment_index,
             p_form_object_definition^.variable_box_processing,
             p_form_object_definition^.variable_box_width,
             p_form_object_definition^.variable_box_height, cursor_object_index,
             fdv$screen_status.event_identifier.field_event_character_position,
             target_position, status);
      IFEND;
      RETURN;
    IFEND;

{ This is a table variable, find the associated object list and scroll all of them.

    shift_table_variable (p_form_status, p_form_variable_definition, target_position, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    csv$vector.position_cursor^ (p_form_status^.p_form_object_statuses^ [cursor_object_index].
          field_number, fdv$screen_status.event_identifier.field_event_character_position, 1,
          character_position, line_number, terminal_status);
    IF NOT terminal_status.normal THEN
      fdp$convert_terminal_status (terminal_status, status);
    IFEND;

  PROCEND shift_variable;

?? TITLE := 'tab_to_previous_variable', EJECT ??

{ PURPOSE:
{   This procedure positions the cursor to first variable field previous to it on the terminal screen.
{

  PROCEDURE [XDCL] tab_to_previous_variable
    (    p_form_status: ^fdt$form_status;
         object_index: fdt$object_index;
     VAR status: ost$status);

    VAR
      end_object_index: fdt$object_index,
      ignore_character_position: cst$character_position,
      ignore_line_number: cst$line_number,
      next_object_index: fdt$object_index,
      p_form_variable_definition: ^fdt$form_variable_definition,
      p_form_variable_definitions: ^array [1 .. * ] of fdt$form_variable_definition,
      p_form_object_definition: ^fdt$form_object_definition,
      p_form_object_definitions: ^array [1 .. * ] of fdt$form_object_definition,
      p_parent_object_definition: ^fdt$form_object_definition,
      start_object_index: fdt$object_index,
      terminal_status: ost$status;

?? NEWTITLE := 'check_variable', EJECT ??

{ PURPOSE:
{   This procedure verifies that the variable field is a valid input field and positions the cursor to it.
{ NOTES:
{   The field must be an input field and it must not be covered by another form.

    PROCEDURE [INLINE] check_variable;

      IF ((p_form_variable_definition^.io_mode = fdc$terminal_input) OR
            (p_form_variable_definition^.io_mode = fdc$terminal_input_output)) AND
            (NOT (fdc$protect IN
            p_form_status^.p_form_object_statuses^ [next_object_index].display_attribute_set)) AND
            (NOT location_covered_by_form (p_form_status, p_form_object_definition^.x_position +
            p_form_status^.form_x_position - 1, p_form_object_definition^.y_position +
            p_form_status^.form_y_position - 1)) THEN
        csv$vector.position_cursor^ (p_form_status^.p_form_object_statuses^ [next_object_index].field_number,
              1, 1, ignore_character_position, ignore_line_number, terminal_status);
        IF NOT terminal_status.normal THEN
          fdp$convert_terminal_status (terminal_status, status);
        IFEND;
        fdv$screen_status.cursor_set := TRUE;
        EXIT tab_to_previous_variable;
      IFEND;

    PROCEND check_variable;
?? OLDTITLE, EJECT ??
?? NEWTITLE := 'search_object_definitions', EJECT ??

{ PURPOSE:
{   This procedure finds the previous input variable in the form.
{ DESIGN:
{   The procedure searches the object definitions which are ordered by location.
{ NOTES:
{   Tabbing can only occur to a variable that has an input or input/output mode.

    PROCEDURE [INLINE] search_object_definitions;


      FOR next_object_index := start_object_index DOWNTO end_object_index DO
        p_form_object_definition := ^p_form_object_definitions^ [next_object_index];
        CASE p_form_object_definition^.key OF

        = fdc$form_variable_text =
          p_form_variable_definition := ^p_form_variable_definitions^
                [p_form_object_definition^.text_variable_index];
          check_variable;

{ If the variable checks out, a non-local EXIT is performed and control does not return here.

        = fdc$form_variable_text_box =
          p_form_variable_definition := ^p_form_variable_definitions^
                [p_form_object_definition^.variable_box_variable_index];
          check_variable;

{ If the variable checks out, a non-local EXIT is performed and control does not return here.

        = fdc$form_text_box_fragment =
          p_parent_object_definition := ^p_form_object_definitions^
                [p_form_object_definition^.parent_text_box_object_index];
          IF (p_parent_object_definition^.key = fdc$form_variable_text_box) THEN
            p_form_variable_definition := ^p_form_variable_definitions^
                  [p_parent_object_definition^.variable_box_variable_index];
            check_variable;

{ If the variable checks out, a non-local EXIT is performed and control does not return here.

          IFEND;
        ELSE

{ Other objects are ignored.

        CASEND;
      FOREND;

    PROCEND search_object_definitions;
?? OLDTITLE, EJECT ??
    status.normal := TRUE;
    p_form_variable_definitions := p_form_status^.p_form_variable_definitions;
    p_form_object_definitions := p_form_status^.p_form_object_definitions;

    end_object_index := 1;
    IF object_index <= p_form_status^.p_form_definition^.form_object_definitions.active_number THEN
      start_object_index := object_index;
      search_object_definitions;

{ If the previous variable is found, a non-local EXIT is performed and control does not return here.

      end_object_index := start_object_index;
    IFEND;

{ Wrap around to end of form and then try to find an input field.

    start_object_index := p_form_status^.p_form_definition^.form_object_definitions.active_number;
    search_object_definitions;

{ No input variable was found in the form.  The cursor position is not changed and no error is generated.

  PROCEND tab_to_previous_variable;

?? TITLE := 'update_program_record', EJECT ??

  PROCEDURE update_program_record
    (    p_form_status: ^fdt$form_status;
         form_identifier: fdt$form_identifier;
     VAR status: ost$status);

    VAR
      object_index: fdt$object_index,
      p_form_object_definition: ^fdt$form_object_definition,
      p_form_object_definitions: ^array [1 .. * ] of fdt$form_object_definition,
      p_form_object_status: ^fdt$form_object_status,
      p_form_object_statuses: ^array [1 .. * ] of fdt$form_object_status,
      p_form_table_definitions: ^array [1 .. * ] of fdt$form_table_definition,
      p_form_variable_definition: ^fdt$form_variable_definition,
      p_form_variable_definitions: ^array [1 .. * ] of fdt$form_variable_definition,
      variable_status: fdt$variable_status;

    status.normal := TRUE;
    variable_status := fdc$no_error;
    p_form_variable_definitions := p_form_status^.p_form_variable_definitions;
    p_form_object_definitions := p_form_status^.p_form_object_definitions;
    p_form_object_statuses := p_form_status^.p_form_object_statuses;
    IF p_form_object_statuses = NIL THEN
      RETURN;
    IFEND;

  /find_record_changes/
    FOR object_index := LOWERBOUND (p_form_object_statuses^) TO UPPERBOUND (p_form_object_statuses^) DO
      p_form_object_status := ^p_form_object_statuses^ [object_index];
      CASE p_form_object_status^.key OF

      = fdc$field_identifier, fdc$unused_identifier =
        IF NOT p_form_object_status^.user_changed_field THEN
          CYCLE /find_record_changes/;
        IFEND;

        p_form_object_definition := ^p_form_object_definitions^ [object_index];
        CASE p_form_object_definition^.key OF

        = fdc$form_variable_text =
          IF p_form_object_definition^.text_variable_exists THEN
            p_form_variable_definition := ^p_form_status^.p_form_variable_definitions^
                  [p_form_object_definition^.text_variable_index];
            update_variable (p_form_status, form_identifier, p_form_variable_definition,
                  p_form_object_definition, object_index, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            IF fdv$screen_status.message_form_displayed THEN
              RETURN;
            IFEND;
          IFEND;
          p_form_object_status^.user_changed_field := FALSE;

        = fdc$form_stored_variable =
          IF p_form_object_definition^.stored_variable_exists THEN
            p_form_variable_definition := ^p_form_status^.p_form_variable_definitions^
                  [p_form_object_definition^.stored_variable_index];
            update_variable (p_form_status, form_identifier, p_form_variable_definition,
                  p_form_object_definition, object_index, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            IF fdv$screen_status.message_form_displayed THEN
              RETURN;
            IFEND;
          IFEND;
          p_form_object_status^.user_changed_field := FALSE;

        = fdc$form_variable_text_box =
          IF p_form_object_definition^.variable_box_variable_exists THEN
            p_form_variable_definition := ^p_form_status^.p_form_variable_definitions^
                  [p_form_object_definition^.variable_box_variable_index];
            update_variable (p_form_status, form_identifier, p_form_variable_definition,
                  p_form_object_definition, object_index, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            IF fdv$screen_status.message_form_displayed THEN
              RETURN;
            IFEND;
          IFEND;
          p_form_object_status^.user_changed_field := FALSE;

        ELSE { Ignore other object definitions. }
        CASEND;
      ELSE { Ignore other status identifiers. }
      CASEND;
    FOREND /find_record_changes/;

  /check_must_enter/
    FOR object_index := LOWERBOUND (p_form_object_statuses^) TO UPPERBOUND (p_form_object_statuses^) DO
      p_form_object_status := ^p_form_object_statuses^ [object_index];
      CASE p_form_object_status^.key OF

      = fdc$field_identifier, fdc$unused_identifier =
        IF p_form_object_status^.user_entered_field THEN
          CYCLE /check_must_enter/;
        IFEND;

        p_form_object_definition := ^p_form_object_definitions^ [object_index];
        CASE p_form_object_definition^.key OF

        = fdc$form_variable_text =
          IF p_form_object_definition^.text_variable_exists THEN
            p_form_variable_definition := ^p_form_status^.p_form_variable_definitions^
                  [p_form_object_definition^.text_variable_index];
            IF fdc$must_enter IN p_form_variable_definition^.terminal_user_entry THEN
              display_variable_error (p_form_status, form_identifier,
                    p_form_variable_definition, object_index, p_form_object_definition^.occurrence,
                    status);
              RETURN;
            IFEND;
          IFEND;

        = fdc$form_stored_variable =
          IF p_form_object_definition^.stored_variable_exists THEN
            p_form_variable_definition := ^p_form_status^.p_form_variable_definitions^
                  [p_form_object_definition^.stored_variable_index];
            IF fdc$must_enter IN p_form_variable_definition^.terminal_user_entry THEN
              display_variable_error (p_form_status, form_identifier,
                    p_form_variable_definition, object_index, p_form_object_definition^.occurrence,
                    status);
              RETURN;
            IFEND;
          IFEND;

        = fdc$form_variable_text_box =
          IF p_form_object_definition^.variable_box_variable_exists THEN
            p_form_variable_definition := ^p_form_status^.p_form_variable_definitions^
                  [p_form_object_definition^.variable_box_variable_index];
            IF fdc$must_enter IN p_form_variable_definition^.terminal_user_entry THEN
              display_variable_error (p_form_status, form_identifier,
                    p_form_variable_definition, object_index, p_form_object_definition^.occurrence,
                    status);
              RETURN;
            IFEND;
          IFEND;

        ELSE { Ignore other object definitions. }
        CASEND;
      ELSE { Ignore other status identifiers. }
      CASEND;
    FOREND /check_must_enter/;

  PROCEND update_program_record;

?? TITLE := 'update_variable', EJECT ??

  PROCEDURE update_variable
    (    p_form_status: ^fdt$form_status;
         form_identifier: fdt$form_identifier;
         p_form_variable_definition: ^fdt$form_variable_definition;
         p_form_object_definition: ^fdt$form_object_definition;
         object_index: fdt$object_index;
     VAR status: ost$status);

    VAR
      error: mlt$error,
      ignore_date_time: clt$date_time,
      integer_number: integer,
      p_form_table_definition: ^fdt$form_table_definition,
      p_formatted_screen_variable: ^fdt$text,
      p_program_variable: ^cell,
      p_screen_variable: ^fdt$text,
      p_table_objects: ^array [1 .. * ] of fdt$table_object,
      p_table_variable: ^fdt$table_variable,
      p_table_variables: ^array [1 .. * ] of fdt$table_variable,
      p_text: ^fdt$text,
      p_valid_string: ^fdt$valid_string,
      previous_character_space: boolean,
      program_record_position: fdt$record_position,
      program_variable_length: fdt$program_variable_length,
      real_number: real,
      screen_index: fdt$text_length,
      screen_record_position: fdt$record_position,
      screen_variable_length: fdt$text_length,
      separator_index: fdt$text_length,
      table_index: fdt$table_index,
      variable_index: fdt$variable_index,
      variable_name: ost$name,
      variable_status: fdt$variable_status;

    status.normal := TRUE;
    variable_status := fdc$no_error;
    program_variable_length := p_form_variable_definition^.program_variable_length;
    screen_variable_length := p_form_variable_definition^.screen_variable_length;

{ Determine variable position in screen record and program record.

    IF p_form_variable_definition^.table_exists THEN
      table_index := p_form_variable_definition^.table_index;
      p_form_table_definition := ^p_form_status^.p_form_table_definitions^ [table_index];
      variable_name := p_form_variable_definition^.name;
      p_table_variables := fdp$ptr_table_variables (p_form_table_definition^.table_variables,
            p_form_status^.p_form_module);

    /find_variable/
      FOR variable_index := 1 TO p_form_table_definition^.table_variables.active_number DO
        p_table_variable := ^p_table_variables^ [variable_index];
        IF p_table_variable^.name = variable_name THEN
          p_table_objects := fdp$ptr_table_objects (p_table_variable^.table_objects,
                p_form_status^.p_form_module);
          program_record_position := p_table_objects^ [p_form_object_definition^.occurrence].
                program_record_position;
          screen_record_position := p_table_objects^ [p_form_object_definition^.occurrence].
                screen_record_position;
          EXIT /find_variable/;
        IFEND;
      FOREND /find_variable/;

    ELSE

{ The variable is not a member of a table.

      program_record_position := p_form_variable_definition^.program_record_position;
      screen_record_position := p_form_variable_definition^.screen_record_position;
    IFEND;

    fdp$ptr_screen_variable (p_form_status^.p_screen_record,
          screen_record_position, screen_variable_length, p_screen_variable);

{ Remove the record separator from a variable text box with word wrap for data transfered to
{ the application program.  The record separator was used to insert a line of spaces.
{ Keep the record separator in the screen variable so the terminal user can still see the
{ inserted line.  Also remove extra spaces.  The terminal user's editing tends to
{ cause extra spaces at the end of a line.

    IF ((p_form_object_definition^.key = fdc$form_variable_text_box) AND
          (p_form_object_definition^.variable_box_processing = fdc$wrap_words)) THEN
      screen_index := 0;
      PUSH p_formatted_screen_variable: [screen_variable_length];
      previous_character_space := FALSE;
      /format_program_data/
        FOR separator_index := 1 TO screen_variable_length DO
          IF p_screen_variable^ (separator_index, 1) <> record_separator THEN
            IF (p_screen_variable^ (separator_index, 1) = ' ') THEN
              IF previous_character_space THEN
                CYCLE /format_program_data/;
              IFEND;
              previous_character_space := TRUE;
              screen_index := screen_index + 1;
              p_formatted_screen_variable^ (screen_index, 1) := p_screen_variable^
                    (separator_index, 1);
              CYCLE /format_program_data/;
            IFEND;
            previous_character_space := FALSE;
            screen_index := screen_index + 1;
            p_formatted_screen_variable^ (screen_index, 1) := p_screen_variable^ (separator_index, 1);
          IFEND;
        FOREND /format_program_data/;

{ Space fill to end of screen variable.

      IF screen_index < separator_index THEN
        p_formatted_screen_variable^ (screen_index + 1, *) := '';
      IFEND;
      p_screen_variable := p_formatted_screen_variable;
    IFEND;

{ Convert character screen data to program data type.

    p_program_variable := ^p_form_status^.p_program_record^ [program_record_position];
    fdp$move_to_program_variable (p_form_status, p_form_variable_definition,
          p_screen_variable, p_program_variable, variable_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    p_form_status^.p_form_object_statuses^ [object_index].variable_input_status := variable_status;

{ The output status is now obsolete.

    p_form_status^.p_form_object_statuses^ [object_index].variable_output_status := fdc$no_error;

{ If character data entered by terminal user could not be converted to
{ program data type, display error message (if error message exists).

    IF variable_status <> fdc$no_error THEN
      display_variable_error (p_form_status, form_identifier, p_form_variable_definition, object_index,
            p_form_object_definition^.occurrence, status);
      RETURN;
    IFEND;

{ Check terminal user input for valid values.

    CASE p_form_variable_definition^.program_data_type OF

    = fdc$program_character_type, fdc$program_upper_case_type =
      fdp$ptr_screen_variable (p_form_status^.p_program_record,
            program_record_position, program_variable_length, p_text);
      fdp$validate_string (p_text, program_variable_length, p_form_variable_definition^.valid_strings,
            p_form_status, p_valid_string, variable_status);
      IF variable_status <> fdc$no_error THEN
        p_form_status^.p_form_object_statuses^ [object_index].variable_input_status := variable_status;
        display_variable_error (p_form_status, form_identifier, p_form_variable_definition, object_index,
              p_form_object_definition^.occurrence, status);
        RETURN;

      ELSE
        IF p_valid_string <> NIL THEN
          mlp$move_bytes (p_valid_string, STRLENGTH (p_valid_string^), p_program_variable,
                program_variable_length, error);
        IFEND;
      IFEND;

    = fdc$program_integer_type =
      i#move (p_program_variable, ^integer_number, fdc$integer_length);
      IF fdp$date_variable(p_form_variable_definition) THEN
        fdp$convert_yymmdd_to_date_time (integer_number, ignore_date_time, variable_status);
        IF (integer_number = 0) AND (fdc$must_enter IN p_form_variable_definition^.terminal_user_entry) THEN
          variable_status := fdc$invalid_integer;
        IFEND;
      ELSE
      fdp$validate_integer (integer_number, p_form_variable_definition^.valid_integer_ranges, p_form_status,
            variable_status);
      IFEND;
      IF variable_status <> fdc$no_error THEN
        p_form_status^.p_form_object_statuses^ [object_index].variable_input_status := variable_status;
        display_variable_error (p_form_status, form_identifier, p_form_variable_definition, object_index,
              p_form_object_definition^.occurrence, status);
        RETURN;
      IFEND;

    = fdc$program_real_type =
      i#move (p_program_variable, ^real_number, fdc$real_length);
      fdp$validate_real (real_number, p_form_variable_definition^.valid_real_ranges, p_form_status,
            variable_status);
      IF variable_status <> fdc$no_error THEN
        p_form_status^.p_form_object_statuses^ [object_index].variable_input_status := variable_status;
        display_variable_error (p_form_status, form_identifier, p_form_variable_definition, object_index,
              p_form_object_definition^.occurrence, status);
        RETURN;
      IFEND;

    ELSE {fdc$program_cobol_type

      fdp$validate_cobol_data (p_form_status, p_form_variable_definition,
            p_program_variable, p_valid_string, variable_status);
      IF variable_status <> fdc$no_error THEN
        p_form_status^.p_form_object_statuses^ [object_index].variable_input_status := variable_status;
        display_variable_error (p_form_status, form_identifier, p_form_variable_definition, object_index,
              p_form_object_definition^.occurrence, status);
        RETURN;

      ELSE {No error for variable_status
        IF p_valid_string <> NIL THEN
          mlp$move_bytes (p_valid_string, STRLENGTH (p_valid_string^), p_program_variable,
                program_variable_length, error);
        IFEND;
      IFEND;
    CASEND;

  PROCEND update_variable;

MODEND fdm$process_screen_input_output;
