
?? RIGHT := 110 ??
*copyc osd$default_pragmats
MODULE fdm$create_event_form;

*copyc cyd$run_time_error_condition

*copyc csp$change_capability_level
*copyc csp$get_device_attributes
*copyc csp$get_device_dimensions

*copyc fdp$change_form
*copyc fdp$close_form
*copyc fdp$create_form
*copyc fdp$create_object
*copyc fdp$create_table
*copyc fdp$end_form
*copyc fdp$convert_terminal_status
*copyc fdp$create_variable
*copyc fdp$get_screen_events
*copyc fdp$open_form
*copyc fdt$event_label_v1
*copyc fdt$event_menu
*copyc fdt$event_trigger
*copyc fdt$screen_status
*copyc fdt$x_position
*copyc fdt$y_position

*copyc pmp$continue_to_cause

*copyc osp$disestablish_cond_handler
*copyc osp$establish_condition_handler
*copyc osp$set_status_abnormal

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

  PROCEDURE [XDCL] fdp$create_event_form
    (    event_menus: array [1 .. * ] OF fdt$event_menu;
     VAR form_attributes: fdt$form_attributes;
     VAR form_identifier: fdt$form_identifier;
     VAR status: ost$status);

    VAR
      application_functions: cst$application_functions,
      blank_label: [READ, STATIC] string (6) := ' ',
      device_attributes: array [1 .. 1] of cst$device_attribute,
      event_form_attributes: array [1 .. 1] of fdt$form_attribute,
      event_label_positions: [READ, STATIC] array [1 .. 16] of fdt$x_position :=
            [4, 14, 24, 34, 44, 54, 64, 74, 4, 14, 24, 34, 44, 54, 64, 74],
      event_labels: array [1 .. 16] of fdt$event_label_v1,
      event_names: array [1 .. 16] of ost$name,
      fdv$screen_status: [XREF] fdt$screen_status,
      key_label_increment: 0 .. 8,
      key_label_positions: [READ, STATIC] array [1 .. 16] of fdt$x_position :=
            [1, 11, 21, 31, 41, 51, 61, 71, 1, 11, 21, 31, 41, 51, 61, 71],
      line_number: cst$line_number,
      local_status: ost$status,
      n: integer,
      non_shifted_1_8: 0 .. 1,
      non_shifted_9_16: 0 .. 1,
      number_errors: fdt$number_errors,
      number_menu_rows: integer,
      object_definition: fdt$object_definition,
      object_attributes: array [1 .. 2] of fdt$object_attribute,
      p_errors: ^SEQ ( * ),
      shifted_1_8: 0 .. 1,
      shifted_9_16: 0 .. 1,
      shift_event_labels: array [1 .. 16] of fdt$event_label_v1,
      shift_event_names: array [1 .. 16] of ost$name,
      terminal_status: ost$status,
      variable_attributes: array [1 .. 2] of fdt$variable_attribute,
      variable_name: ost$name,
      visible_character_position: cst$visible_character_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_event_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_event_form;
      IFEND;

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

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

    PROCEDURE [INLINE] create_labels
      (    first_label: integer;
           last_label: integer;
           first_event_trigger: fdt$event_trigger;
           p_event_labels: ^array [1 .. * ] OF fdt$event_label_v1;
           p_event_names: ^array [1 .. * ] OF ost$name;
           y_position: fdt$y_position;
       VAR status: ost$status);

      VAR
        event_trigger: fdt$event_trigger,
        object_attributes: array [1 .. 2] of fdt$object_attribute;

      event_trigger := first_event_trigger;
      /create_label_objects/
      FOR n := first_label TO last_label DO

{ Create program event label.

      object_attributes [1].key := fdc$object_display;
      object_attributes [1].display_attribute := $fdt$display_attribute_set [fdc$inverse_video];
        IF (p_event_names^ [n] = osc$null_name) THEN
          object_attributes [2].key := fdc$unused_object_entry;
          object_definition.key := fdc$constant_text;
          object_definition.constant_text_width := 6;
          object_definition.p_constant_text := ^blank_label;
          fdp$create_object (form_identifier, event_label_positions [n], y_position, object_definition,
                object_attributes, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

        ELSE

{ For a non-blank event name, create a variable object.  A application program
{ may change the program event label by using the event name in a replace string variable request.
{ The program event label tells the terminal user what the event does.  Examples are copy, delete,
{ and add.

          object_attributes [2].key := fdc$object_name;
          object_attributes [2].object_name := p_event_names^ [n];
          object_attributes [2].occurrence := 1;
          object_definition.key := fdc$variable_text;
          object_definition.variable_text_width := 6;
          object_definition.p_variable_text := ^p_event_labels^ [n];
          fdp$create_object (form_identifier, event_label_positions [n], y_position, object_definition,
                object_attributes, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        IFEND;

{ Create label for terminal function key. This tells the terminal user what key(s) to press.

        object_attributes [1].key := fdc$unused_object_entry;
        object_attributes [2].key := fdc$unused_object_entry;
        object_definition.key := fdc$constant_text;
        object_definition.constant_text_width := 2;
        object_definition.p_constant_text := ^fdv$screen_status.p_screen_event_statuses^ [event_trigger].
              event_label;
        fdp$create_object (form_identifier, key_label_positions [n], y_position, object_definition,
              object_attributes, status);
        IF NOT status.normal THEN
            RETURN;
        IFEND;

        event_trigger := SUCC (event_trigger);
      FOREND /create_label_objects/;
    PROCEND create_labels;

?? OLDTITLE, EJECT ??

    osp$establish_condition_handler (^condition_handler, FALSE);
    status.normal := TRUE;

{ Get terminal event definitions. }

    IF fdv$screen_status.p_screen_event_statuses = NIL THEN
      fdp$get_screen_events (status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

    shifted_1_8 := 0;
    shifted_9_16 := 0;
    non_shifted_1_8 := 0;
    non_shifted_9_16 := 0;

    FOR n := LOWERBOUND (event_names) to UPPERBOUND (event_names) DO
      event_names [n] := osc$null_name;
      event_labels [n] := '';
      shift_event_names [n] := osc$null_name;
      shift_event_labels [n] := '';
    FOREND;

{ Determine events user requires.

    FOR n := LOWERBOUND (event_menus) TO UPPERBOUND (event_menus) DO
      CASE event_menus [n].event_trigger OF

      = fdc$function_1 =
        event_labels [1] := event_menus [n].event_label;
        event_names [1] := event_menus [n].event_name;
        non_shifted_1_8 := 1;

      = fdc$function_2 =
        event_labels [2] := event_menus [n].event_label;
        event_names [2] := event_menus [n].event_name;
        non_shifted_1_8 := 1;

      = fdc$function_3 =
        event_labels [3] := event_menus [n].event_label;
        event_names [3] := event_menus [n].event_name;
        non_shifted_1_8 := 1;

      = fdc$function_4 =
        event_labels [4] := event_menus [n].event_label;
        event_names [4] := event_menus [n].event_name;
        non_shifted_1_8 := 1;

      = fdc$function_5 =
        event_labels [5] := event_menus [n].event_label;
        event_names [5] := event_menus [n].event_name;
        non_shifted_1_8 := 1;

      = fdc$function_6 =
        event_labels [6] := event_menus [n].event_label;
        event_names [6] := event_menus [n].event_name;
        non_shifted_1_8 := 1;

      = fdc$function_7 =
        event_labels [7] := event_menus [n].event_label;
        event_names [7] := event_menus [n].event_name;
        non_shifted_1_8 := 1;

      = fdc$function_8 =
        event_labels [8] := event_menus [n].event_label;
        event_names [8] := event_menus [n].event_name;
        non_shifted_1_8 := 1;

      = fdc$function_9 =
        event_labels [9] := event_menus [n].event_label;
        event_names [9] := event_menus [n].event_name;
        number_menu_rows := 2;
        non_shifted_9_16 := 1;

      = fdc$function_10 =
        event_labels [10] := event_menus [n].event_label;
        event_names [10] := event_menus [n].event_name;
        non_shifted_9_16 := 1;

      = fdc$function_11 =
        event_labels [11] := event_menus [n].event_label;
        event_names [11] := event_menus [n].event_name;
        non_shifted_9_16 := 1;

      = fdc$function_12 =
        event_labels [12] := event_menus [n].event_label;
        event_names [12] := event_menus [n].event_name;
        non_shifted_9_16 := 1;

      = fdc$function_13 =
        event_labels [13] := event_menus [n].event_label;
        event_names [13] := event_menus [n].event_name;
        non_shifted_9_16 := 1;

      = fdc$function_14 =
        event_labels [14] := event_menus [n].event_label;
        event_names [14] := event_menus [n].event_name;
        non_shifted_9_16 := 1;

      = fdc$function_15 =
        event_labels [15] := event_menus [n].event_label;
        event_names [15] := event_menus [n].event_name;
        non_shifted_9_16 := 1;

      = fdc$function_16 =
        event_labels [16] := event_menus [n].event_label;
        event_names [16] := event_menus [n].event_name;
        non_shifted_9_16 := 1;

      = fdc$shift_function_1 =
        shift_event_labels [1] := event_menus [n].event_label;
        shift_event_names [1] := event_menus [n].event_name;
        shifted_1_8 := 1;

      = fdc$shift_function_2 =
        shift_event_labels [2] := event_menus [n].event_label;
        shift_event_names [2] := event_menus [n].event_name;
        shifted_1_8 := 1;

      = fdc$shift_function_3 =
        shift_event_labels [3] := event_menus [n].event_label;
        shift_event_names [3] := event_menus [n].event_name;
        shifted_1_8 := 1;

      = fdc$shift_function_4 =
        shift_event_labels [4] := event_menus [n].event_label;
        shift_event_names [4] := event_menus [n].event_name;
        shifted_1_8 := 1;

      = fdc$shift_function_5 =
        shift_event_labels [5] := event_menus [n].event_label;
        shift_event_names [5] := event_menus [n].event_name;
        shifted_1_8 := 1;

      = fdc$shift_function_6 =
        shift_event_labels [6] := event_menus [n].event_label;
        shift_event_names [6] := event_menus [n].event_name;
        shifted_1_8 := 1;

      = fdc$shift_function_7 =
        shift_event_labels [7] := event_menus [n].event_label;
        shift_event_names [7] := event_menus [n].event_name;
        shifted_1_8 := 1;

      = fdc$shift_function_8 =
        shift_event_labels [8] := event_menus [n].event_label;
        shift_event_names [8] := event_menus [n].event_name;
        shifted_1_8 := 1;

      = fdc$shift_function_9 =
        shift_event_labels [9] := event_menus [n].event_label;
        shift_event_names [9] := event_menus [n].event_name;
        shifted_9_16 := 1;

      = fdc$shift_function_10 =
        shift_event_labels [10] := event_menus [n].event_label;
        shift_event_names [10] := event_menus [n].event_name;
        shifted_9_16 := 1;

      = fdc$shift_function_11 =
        shift_event_labels [11] := event_menus [n].event_label;
        shift_event_names [11] := event_menus [n].event_name;
        shifted_9_16 := 1;

      = fdc$shift_function_12 =
        shift_event_labels [12] := event_menus [n].event_label;
        shift_event_names [12] := event_menus [n].event_name;
        shifted_9_16 := 1;

      = fdc$shift_function_13 =
        shift_event_labels [13] := event_menus [n].event_label;
        shift_event_names [13] := event_menus [n].event_name;
        shifted_9_16 := 1;

      = fdc$shift_function_14 =
        shift_event_labels [14] := event_menus [n].event_label;
        shift_event_names [14] := event_menus [n].event_name;
        shifted_9_16 := 1;

      = fdc$shift_function_15 =
        shift_event_labels [15] := event_menus [n].event_label;
        shift_event_names [15] := event_menus [n].event_name;
        shifted_9_16 := 1;

      = fdc$shift_function_16 =
        shift_event_labels [16] := event_menus [n].event_label;
        shift_event_names [16] := event_menus [n].event_name;
        shifted_9_16 := 1;

      ELSE { Do nothing for these event triggers.}
      CASEND;
    FOREND;

{ Obtain terminal device attributes to determine form size
{ and position.  If the home cursor position is on the last line
{ of the terminal screen, then the event form must not overlay
{ the last line.

    IF NOT fdv$screen_status.screen_mode_active THEN
      csp$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);
        RETURN;
      IFEND;
      fdv$screen_status.screen_mode_active := TRUE;
    IFEND;

    device_attributes [1].key := csc$da_home_at_top;
    csp$get_device_attributes (device_attributes, terminal_status);
    IF NOT terminal_status.normal THEN
      fdp$convert_terminal_status (terminal_status, status);
      RETURN;
    IFEND;

    csp$get_device_dimensions (visible_character_position, line_number, terminal_status);
    IF NOT terminal_status.normal THEN
      fdp$convert_terminal_status (terminal_status, status);
      RETURN;
    IFEND;

{ Define event form. }
{ The application programmers"s attributes for form size and position will be }
{ replaced by those computed by Screen Formatting. }

    fdp$create_form (form_identifier, form_attributes, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ Attempt to minimize the space required for the event form. }
{ Only application terminal events appear on the event form. }
{ If a shifted terminal event occurs, then the corresponding non-shifted }
{ terminal event must also be shown on the terminal. }

    IF shifted_1_8 <> 0 THEN
      non_shifted_1_8 := 1;
    IFEND;
    IF shifted_9_16 <> 0 THEN
      non_shifted_9_16 := 1;
    IFEND;

    y_position := shifted_1_8 + non_shifted_1_8 + shifted_9_16 + non_shifted_9_16;
    IF ((non_shifted_1_8 <> 0) AND (non_shifted_9_16 <> 0)) THEN
      y_position := y_position + 1;
    IFEND;

    event_form_attributes [1].key := fdc$form_area;
    event_form_attributes [1].form_area.key := fdc$defined_area;
    event_form_attributes [1].form_area.x_position := 1;
    event_form_attributes [1].form_area.height := y_position;
    IF device_attributes [1].home_at_top THEN
      event_form_attributes [1].form_area.y_position := line_number + 1 - y_position;
    ELSE
      event_form_attributes [1].form_area.y_position := line_number - y_position;
    IFEND;

    event_form_attributes [1].form_area.width := 80;
    fdp$change_form (form_identifier, event_form_attributes, status);
    IF NOT status.normal THEN
      fdp$close_form (form_identifier, local_status);
      RETURN;
    IFEND;

    variable_attributes [1].key := fdc$program_data_type;
    variable_attributes [1].program_data_type := fdc$program_character_type;
    variable_attributes [2].key := fdc$io_mode;
    variable_attributes [2].io_mode := fdc$terminal_output;

{ Create variables for event names. }
{ The application programmer may change the values and attributes by }
{ using these variable names. }

    FOR n := LOWERBOUND (event_names) to UPPERBOUND (event_names) DO
      IF (event_names [n] <> osc$null_name) THEN
        fdp$create_variable (form_identifier, event_names [n], variable_attributes, status);
        IF NOT status.normal THEN
           osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
              'creating event form', status);
          fdp$close_form (form_identifier, local_status);
          RETURN;
        IFEND;
      IFEND;
    FOREND;

    FOR n := LOWERBOUND (shift_event_names) to UPPERBOUND (shift_event_names) DO
      IF (shift_event_names [n] <> osc$null_name) THEN
        fdp$create_variable (form_identifier, shift_event_names [n], variable_attributes, status);
        IF NOT status.normal THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
                'creating event form', status);
          fdp$close_form (form_identifier, local_status);
          RETURN;
        IFEND;
      IFEND;
    FOREND;


{ Create event labels on the terminal screen. }

    y_position := 1;

{ Create shifted labels for application functions 1-8. }

    IF (shifted_1_8 <> 0) THEN
      create_labels (1, 8, fdc$shift_function_1, ^shift_event_labels, ^shift_event_names,
          y_position, status);
      y_position := y_position + 1;
      IF NOT status.normal THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
           'creating event form', status);
        fdp$close_form (form_identifier, local_status);
        RETURN;
      IFEND;
    IFEND;

{ Create non-shifted labels for application functions 1-8. }

    IF (non_shifted_1_8 <> 0) THEN
      create_labels (1, 8, fdc$function_1, ^event_labels, ^event_names, y_position, status);
      y_position := y_position + 1;
      IF NOT status.normal THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
           'creating event form', status);
        fdp$close_form (form_identifier, local_status);
        RETURN;
      IFEND;
    IFEND;

{ Create shifted labels for application functions 9-16. }

    IF (non_shifted_1_8 <> 0) THEN

{ Put blank line between functions 1-8 and functions 9-16.

      y_position := y_position + 1;

    IFEND;

    IF (shifted_9_16 <> 0) THEN
      create_labels (9, 16, fdc$shift_function_9, ^shift_event_labels,
          ^shift_event_names, y_position, status);
      y_position := y_position + 1;
      IF NOT status.normal THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
           'creating event form', status);
        fdp$close_form (form_identifier, local_status);
        RETURN;
      IFEND;
    IFEND;

{ Create non-shifted labels for application functions 9-16. }

    IF (non_shifted_9_16 <> 0) THEN
      create_labels (9, 16, fdc$function_9, ^event_labels, ^event_names, y_position, status);
      IF NOT status.normal THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
           'creating event form', status);
        fdp$close_form (form_identifier, local_status);
        RETURN;
      IFEND;
    IFEND;

    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,
           'creating event form', 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,
           'creating event form', status);
      fdp$close_form (form_identifier, local_status);
    IFEND;
  PROCEND fdp$create_event_form;

MODEND fdm$create_event_form;
