! SAMPLE.TPU 3-AUG-1988 16:08 Page 1 !++ ! Table of Contents ! ! SAMPLE.TPU ! 3-AUG-1988 16:08 ! ! Procedure name Page Description ! -------------- ---- ------------ ! ! sample_module_ident 2 Ident ! sample_menus_module_init 2 Module Init ! eve_mouse_pad 3 User command: display mouse pad ! sample_key_def 4 Create a mouse pad "key" pushbotton ! sample_key_dispatch 5 Field pushbutton widget callbacks ! sample_row_to_pix 6 convert a row number to pixels ! sample_col_to_pix 6 convert a column number to pixels ! sample_key_height 6 Cvt. Y dimension in rows to pix ! sample_key_width 6 Cvt. X dimension in cols to pix !-- ! Sample TPU module to implement a "mouse pad" in VAXTPU ! SAMPLE.TPU Page 2 procedure sample_module_ident ! Ident return "V01-001"; endprocedure; procedure sample_menus_module_init ! Module Init endprocedure; ! TPU Declarations for DECWindows Toolkit constants ! Use these constants as arguments to the DEFINE_WIDGET builtin. ! (the strings are actually the symbols which evaluate to the ! widget class records for the DECwindows widgets.) constant sample_kt_labelwidgetclass := "labelwidgetclassrec", sample_kt_dialogwidgetclass := "dialogwidgetclassrec", sample_kt_pushbuttonwidgetclass := "pushbuttonwidgetclassrec"; ! Use these constants as arguments to the CREAT_WIDGET builtin. ! They should be used as the resource name strings passed to the ! DECwindows toolkit. constant sample_kt_cstyle := "style", sample_kt_modeless := 2, sample_kt_nunits := "units", sample_kt_pixelunits := 1, sample_kt_ntitle := "title", sample_kt_nx := "x", sample_kt_ny := "y", sample_kt_nheight := "height", sample_kt_nwidth := "width", sample_kt_nlabel := "label", sample_kt_nactivate_callback := "activateCallback", sample_kt_nborderwidth := "borderWidth", sample_kt_nconformToText := "conformToText", sample_kt_cractivate := 10; ! These constants defined and used only by the sample program - constant sample_kt_x_pos := 500, ! Screen position for mouse pad sample_kt_y_pos := 500, sample_kt_keypad_border := 5, ! Width of border between keys and edge sample_kt_key_height := 30, ! Key dimensions sample_kt_key_width := 60, sample_kt_button_border_frac := 3, ! Determines inter-key spacing sample_kt_overall_height := (sample_kt_key_height * 5) + ((sample_kt_key_height / sample_kt_button_border_frac) * 5) + sample_kt_keypad_border, sample_kt_overall_width := (sample_kt_key_width * 4) + ((sample_kt_key_width / sample_kt_button_border_frac) * 4) + sample_kt_keypad_border, sample_kt_keymap := '', ! If blank, current keymap list is used sample_kt_pad_title := "Sample mouse pad", ! Title of the mouse pad sample_kt_closure := ''; ! Not currently used ! SAMPLE.TPU Page 3 procedure eve_mouse_pad ! User command: display mouse pad on_error [TPU$_CONTROLC]: eve$learn_abort; abort; endon_error ! First, conditionally define the dialog box widget class and create one for ! use as the container for the mouse pad. if get_info (sample_kt_dialog_class, 'type') <> INTEGER then sample_kt_dialog_class := define_widget_class (sample_kt_dialogwidgetclass, "dwt$dialog_box_popup_create"); endif; sample_keypad := create_widget (sample_kt_dialog_class, "Keypad", SCREEN, "message('callback activated')", "sample_kt_closure ", sample_kt_cstyle, sample_kt_modeless, sample_kt_nunits, sample_kt_pixelunits, sample_kt_ntitle, sample_kt_pad_title, sample_kt_nheight, sample_kt_overall_height, sample_kt_nwidth, sample_kt_overall_width, sample_kt_nx, sample_kt_x_pos, sample_kt_ny, sample_kt_y_pos); ! Next do some initializaton. Conditionaly define the pushbutton widget class if get_info (sample_kt_pushbutton_class, 'type') <> INTEGER then sample_kt_pushbutton_class := define_widget_class (sample_kt_pushbuttonwidgetclass, "dwt$push_button_create"); endif; ! Initialize data to be repeatedly passed to the sample_key_def routine sample_attributes := create_array; ! Widget oriented initialization sample_attributes {sample_kt_nactivate_callback} := 0; sample_attributes {sample_kt_nborderwidth} := 2; sample_pad_program := compile ("sample_key_dispatch"); ! Create and manage all of the keys in the mouse pad. sample_key_def ! returns a variable of type widget, so just use the returned value as ! an argument to manage_widget. manage_widget (sample_key_def ("PF1", 0, 0, 1, 1, sample_pad_program), sample_key_def ("PF2", 1, 0, 1, 1, sample_pad_program), sample_key_def ("PF3", 2, 0, 1, 1, sample_pad_program), sample_key_def ("PF4", 3, 0, 1, 1, sample_pad_program), sample_key_def ("KP7", 0, 1, 1, 1, sample_pad_program), sample_key_def ("KP8", 1, 1, 1, 1, sample_pad_program), sample_key_def ("KP9", 2, 1, 1, 1, sample_pad_program), sample_key_def ("-", 3, 1, 1, 1, sample_pad_program, "minus"), sample_key_def ("KP4", 0, 2, 1, 1, sample_pad_program), sample_key_def ("KP5", 1, 2, 1, 1, sample_pad_program), sample_key_def ("KP6", 2, 2, 1, 1, sample_pad_program), sample_key_def (",", 3, 2, 1, 1, sample_pad_program, "comma"), sample_key_def ("KP1", 0, 3, 1, 1, sample_pad_program), sample_key_def ("KP2", 1, 3, 1, 1, sample_pad_program), sample_key_def ("KP3", 2, 3, 1, 1, sample_pad_program), sample_key_def ("Enter", 3, 3, 2, 1, sample_pad_program, "enter"), sample_key_def ("KP0", 0, 4, 1, 2, sample_pad_program), sample_key_def (".", 2, 4, 1, 1, sample_pad_program, "period")); sample_shift_was_last := FALSE; ! Start out unshifted manage_widget (sample_keypad); ! Now display the resulting mouse pad return (TRUE); endprocedure ! $mouse_pad ! SAMPLE.TPU Page 4 procedure sample_key_def ! Create a mouse pad "key" pushbotton (the_legend, ! What to show on the push button label the_row, the_col, ! Location of the key rel to mousepad corner the_width, the_height, ! Dimentions of the key the_pgm; ! What to specify as program to create_widget the_string); ! Key name as a string if <> to legend if get_info (the_string, 'type') = UNSPECIFIED then the_string := the_legend; ! the_string is optional endif; return create_widget (sample_kt_pushbutton_class, "Key", sample_keypad, the_pgm, (sample_kt_keymap + ' ' + the_string), sample_attributes, sample_kt_nconformToText, 0, sample_kt_nlabel, the_legend, sample_kt_nheight, sample_key_height (the_width), sample_kt_nwidth, sample_key_width (the_height), sample_kt_nx, sample_col_to_pix (the_row), sample_kt_ny, sample_row_to_pix (the_col)); endprocedure ! sample_key_def ! SAMPLE.TPU Page 5 procedure sample_key_dispatch ! Field pushbutton widget callbacks local status, ! returned from get_info of callback_parameters temp_array, ! holds callback parameters the_key, ! key string expressed as a key gold_key; ! keyname of the gold key on_error [TPU$_CONTROLC]: eve$learn_abort; abort; endon_error status := get_info (widget, "callback_parameters", temp_array); $widget := temp_array {'widget'}; $widget_tag := temp_array {'closure'}; $widget_reason := temp_array {'reason_code'}; the_key := execute ("return(key_name (" + $widget_tag + "))"); gold_key := get_info (eve$current_key_map_list, "shift_key"); if the_key = gold_key then sample_shift_was_last := TRUE; ! User pressed Gold Key else if sample_shift_was_last then the_key := key_name (the_key, SHIFT_KEY); endif; case $widget_reason [sample_kt_cractivate]: execute (the_key); [OTHERWISE]: eve_show_key (the_key) endcase; sample_shift_was_last := FALSE; endif; return; endprocedure ! sample_key_dispatch ! SAMPLE.TPU Page 6 ! These routines implement key (pushbutton widget) position and ! size calculations procedure sample_row_to_pix (row) ! convert a row number to pixels return sample_kt_keypad_border + (row * (sample_kt_key_height + (sample_kt_key_height / sample_kt_button_border_frac))); endprocedure ! sample_row_to_pix procedure sample_col_to_pix (col) ! convert a column number to pixels return sample_kt_keypad_border + (col * ((sample_kt_key_width + sample_kt_key_width) / sample_kt_button_border_frac )); endprocedure ! sample_col_to_pix procedure sample_key_height (given_height) ! Cvt. Y dimension in rows to pix if given_height = 1 then return sample_kt_key_height; else return ((sample_kt_key_height * given_height) + (sample_kt_key_height / sample_kt_button_border_frac) * (given_height - 1)); endif; endprocedure ! sample_key_height procedure sample_key_width (given_width) ! Cvt. X dimension in cols to pix if given_width = 1 then return sample_kt_key_width; else return ((sample_kt_key_width * given_width) + (sample_kt_key_width / sample_kt_button_border_frac) * (given_width - 1)); endif; endprocedure ! sample_key_width