1 SUB SMG_DEF_INPUT_CLR(STRING Prompt,LONG Row,LONG Col,LONG Length,& STRING Inpstr,LONG Timeout,BYTE Vir_disp_num) !---------------------------------------------------------------& ! & ! SMG_DEF_INPUT & ! & ! Creation Date: 3-July-1985 & ! Author: Ken Messer & ! Purpose: Accept input from a virtual & ! keyboard, specifying a default & ! input value & ! & ! Modification history & ! & ! Date Description of change(s) & ! & !---------------------------------------------------------------& ! & ! Copyright (c) 1985 - Ken Messer, Allied Electronics, Inc., & ! 401 E. 8th St., Ft. Worth, TX 76102 & ! & ! This software may be copied and distributed freely to anyone & ! for non-commerical use provided that this copyright notice is & ! included. & !---------------------------------------------------------------& OPTION TYPE = INTEGER, SIZE = INTEGER LONG %include "SMG$LIBRARY:SMG.DFN" DECLARE BYTE Partial_flag DECLARE BYTE CONSTANT True = -1, & False = 0 DECLARE WORD Term_code, & Received_string_length, & Total_char_recvd DECLARE LONG RS, & Readcol, & Max_length, & Display_rows, & Display_cols, & Def_disp_attr, & Def_video_attr DECLARE STRING Partial_inpstr, & Default_response EXTERNAL LONG FUNCTION SMG$Read_string, & SMG$Set_cursor_abs, & SMG$Put_chars, & SMG$Get_Display_attr, & SMG$Change_virtual_display, & SMG$Erase_line EXTERNAL LONG CONSTANT SS$_Normal, & SMG$M_Bold EXTERNAL SUB SMG$Ring_bell EXTERNAL STRING FUNCTION Get_Error_Message(LONG) !---------------------------------------------------------------& ! & ! M a i n P r o g r a m L o g i c & ! & !---------------------------------------------------------------& ! See how long the prompt is - define the column for the first ! character of input as the length of the prompt plus 1 ! if there is no prompt, this value is equal to the column argument SELECT LEN(Prompt) CASE 0 Readcol = Col CASE ELSE Readcol = Col + LEN(Prompt) + 1 END SELECT ! Pass the default response over to its own variable and clear the ! input string Default_response = Inpstr Inpstr = "" Total_char_recvd = 1 Max_length = Length - 1 ! get the default attributes of this virtual display so we can ! set video attributes back after we're done 100 RS = SMG$Get_display_attr(Display_id(Vir_disp_num),Display_rows, & Display_cols,Def_disp_attr,Def_video_attr,) IF RS AND SS$_Normal = 0 THEN PRINT Get_Error_Message(RS) STOP END IF ! display the prompt (if one exists) 200 RS = SMG$Put_chars(Display_id(Vir_disp_num),Prompt,Row,Col,,,,) & UNLESS Prompt = "" IF RS AND SS$_Normal = 0 THEN PRINT Get_Error_Message(RS) STOP END IF ! change the default video attributes of this display to ! bold reverse video 300 RS = SMG$Change_virtual_display(Display_id(Vir_disp_num), & Display_rows,Display_cols,Def_disp_attr, & Input_Display_attr OR SMG$M_Bold,) IF RS AND SS$_Normal = 0 THEN PRINT Get_Error_Message(RS) STOP END IF ! write the default response on the display - the user can now see ! this and respond to it 400 RS = SMG$Put_chars(Display_id(Vir_disp_num),Default_response, & Row,Readcol,,,,) IF RS AND SS$_Normal = 0 THEN PRINT Get_Error_Message(RS) STOP END IF ! set the cursor back to the beginning of the input field 500 RS = SMG$Set_cursor_abs(Display_id(Vir_disp_num),Row,Readcol) IF RS AND SS$_Normal = 0 THEN PRINT Get_Error_Message(RS) STOP END IF Get_first_char: ! do a one character read - if the user types anything except a ! carriage return, we will assume he didn't want to take the default - ! the default response is erased and the character he typed is ! displayed along with the paint character in the rest of the ! input field - from here on out everything is handled as normal input ! if the user takes the default, pass the default input back to ! the input field and exit the routine ! things are further complicated by watching out for a timeout - ! if the user has specified a timeout value, pass this along ! to the function 600 IF Timeout THEN RS = SMG$Read_string(Current_keyboard_id,Partial_inpstr,,1, & Input_function_modifier2,Timeout, & Term_set_mask_desc(0) BY REF,, & Term_code,Display_id(Vir_disp_num)) ELSE RS = SMG$Read_string(Current_keyboard_id,Partial_inpstr,,1, & Input_function_modifier2,,Term_set_mask_desc(0) BY REF, & ,Term_code,Display_id(Vir_disp_num)) END IF IF RS AND SS$_Normal = 0 THEN PRINT Get_Error_Message(RS) STOP END IF ! see what happened SELECT Term_code CASE 13 ! CR - take the default response and exit Inpstr = Default_response GOTO Input_complete CASE 256 to 316 ! function key was typed - this is OK ! since it was the first character GOTO Handle_function_keys CASE 509 ! timeout - flag it, save the default response, and exit Timeout = -1 Inpstr = Default_response GOTO Input_complete CASE 510 ! buffer full - something was typed - echo it, ! display paint char in rest of field, and ! reposition cursor Partial_flag = True RS = SMG$Put_chars(Display_id(Vir_disp_num),Partial_inpstr, & Row,Readcol,,,,) IF RS AND SS$_Normal = 0 THEN PRINT Get_Error_Message(RS) STOP END IF RS = SMG$Put_chars(Display_id(Vir_disp_num), & STRING$(Length-1,ASCII(Paint_char)),Row,Readcol+1,,,,) IF RS AND SS$_Normal = 0 THEN PRINT Get_Error_Message(RS) STOP END IF RS = SMG$Set_cursor_abs(Display_id(Vir_disp_num),Row,Readcol+1) IF RS AND SS$_Normal = 0 THEN PRINT Get_Error_Message(RS) STOP END IF CASE ELSE ! invalid character - ring the bell and go try again CALL SMG$Ring_bell(Display_id(Vir_disp_num),) GOTO Get_first_char END SELECT Get_input: ! User didn't take default - get the balance of the input IF Timeout THEN RS = SMG$Read_string(Current_keyboard_id,Inpstr,,Max_length, & Input_function_modifier1,Timeout, & Term_set_mask_desc(0) BY REF,Received_string_length, & Term_code,Display_id(Vir_disp_num)) ELSE RS = SMG$Read_string(Current_keyboard_id,Inpstr,,Max_length, & Input_function_modifier1,,Term_set_mask_desc(0) BY REF, & Received_string_length,Term_code,Display_id(Vir_disp_num)) END IF IF RS AND SS$_Normal = 0 THEN PRINT Get_Error_Message(RS) STOP END IF Total_char_recvd = Total_char_recvd + Received_string_length IF Partial_flag THEN Inpstr = Partial_inpstr + Inpstr Partial_flag = false END IF ! Handle the response 700 SELECT Term_code CASE 13 ! carriage return - fall through to final read ! OK CASE 0 to 12,14 to 17,19,20,22,23,25 to 31 ! invalid terminators - ring the bell and try again CALL SMG$Ring_bell(Display_id(Vir_disp_num),) Max_length = Length - Received_string_length Partial_flag = True Partial_inpstr = Inpstr Inpstr = "" GOTO Get_input CASE 18,21,24 ! ctrl-R,ctrl-U,ctrl-X ! assume the user wants to clear the buffer ! and start over RS = SMG$Put_chars(Display_id(Vir_disp_num), & STRING$(Max_length,ASCII(Paint_char)), & Row,Readcol,,,,) RS = SMG$Set_cursor_abs(Display_id(Vir_disp_num), & Row,Readcol) Inpstr = "" Partial_flag = false Max_length = Length GOTO Get_input CASE 127 ! a delete - back up, repaint the paint character ! reposition, and try again SELECT Total_char_recvd CASE 0 CALL SMG$Ring_bell(Display_id(Vir_disp_num),) GOTO Get_input CASE ELSE Total_char_recvd = Total_char_recvd - 1 Max_length = Length - Total_char_recvd RS = SMG$Put_chars(Display_id(Vir_disp_num), & del_seq,,,,,,) Partial_flag = True Partial_inpstr = SEG$(Inpstr,1,Total_char_recvd) GOTO Get_input END SELECT CASE 256 to 316 ! function keys - not allowed since not the ! first character of input CALL SMG$Ring_bell(Display_id(Vir_disp_num),) Max_length = Length - Received_string_length Partial_flag = True Partial_inpstr = Inpstr Inpstr = "" GOTO Get_input CASE 509 ! Timeout - flag it and exit Timeout = -1 GOTO Input_complete CASE 510 ! buffer full - do another read - only a ! CR, DEL, or ctrl-U,ctrl-R,ctrl-X will be ! allowed to terminate the read - anything ! else will be ignored (ring the bell) Final_read: IF Timeout THEN RS = SMG$Read_string(Current_keyboard_id,dummy$,,1,& Input_function_modifier2,Timeout,,,Term_code,& Display_id(Vir_disp_num)) ELSE RS = SMG$Read_string(Current_keyboard_id,dummy$,,1,& Input_function_modifier2,,,,Term_code, & Display_id(Vir_disp_num)) END IF IF RS AND SS$_Normal = 0 THEN PRINT Get_Error_Message(RS) STOP END IF SELECT Term_code CASE 13 ! CR ! OK CASE 18,21,24 ! ctrl-R,ctrl-U,ctrl-X RS = SMG$Put_chars(Display_id(Vir_disp_num), & STRING$(Max_length,ASCII(Paint_char)),Row, & Readcol,,,,) RS = SMG$Set_cursor_abs(Display_id(Vir_disp_num), & Row,Readcol) Inpstr = "" Partial_flag = false Max_length = Length GOTO Get_input CASE 127 ! delete Max_length = 1 Total_char_recvd = Length - 1 RS = SMG$Put_chars(Display_id(Vir_disp_num), & del_seq,,,,,,) Partial_flag = True Partial_inpstr = SEG$(Inpstr,1,Length - 1) GOTO Get_input CASE 509 ! Timeout - flag it and exit Timeout = -1 CASE ELSE CALL SMG$Ring_bell(Display_id(Vir_disp_num),) GOTO Final_read END SELECT END SELECT GOTO Input_complete Handle_function_keys: 800 SELECT Term_code CASE 256 TO 259 ! PF1 to PF4 Inpstr = "~PF" + num1$(Term_code - 255) + "~" CASE 260 TO 269 ! application keypad keys Inpstr = "~KP" + num1$(Term_code - 260) + "~" CASE 270 Inpstr = "~ENTER~" CASE 271 Inpstr = "~MINUS~" CASE 272 Inpstr = "~COMMA~" CASE 273 Inpstr = "~PERIOD~" CASE 274 Inpstr = "~UP~" CASE 275 Inpstr = "~DOWN~" CASE 276 Inpstr = "~LEFT~" CASE 277 Inpstr = "~RIGHT~" CASE 286 TO 294, 297 TO 300 Inpstr = "~F" + num1$(Term_code - 280) + "~" CASE 295 Inpstr = "~HELP~" CASE 296 Inpstr = "~DO~" CASE 311 Inpstr = "~FIND~" CASE 312 Inpstr = "~INSERT HERE~" CASE 313 Inpstr = "~REMOVE~" CASE 314 Inpstr = "~SELECT~" CASE 315 Inpstr = "~PREV SCREEN~" CASE 316 Inpstr = "~NEXT SCREEN~" END SELECT Input_complete: Timeout = 0 unless Timeout = -1 RS = SMG$Change_virtual_display(Display_id(Vir_disp_num), & Display_rows,Display_cols,Def_disp_attr,Def_video_attr,) IF RS AND SS$_Normal = 0 THEN PRINT Get_Error_Message(RS) STOP END IF Clear_line: ! erase the line RS = SMG$Erase_line(Display_id(Vir_disp_num),Row,1) IF RS AND SS$_Normal = 0 THEN PRINT Get_Error_Message(RS) STOP END IF 32767 SUBEXIT END SUB