1 SUB SMG_DEF_INPUT(STRING Prompt,LONG Row,LONG Col,LONG Length, & STRING Inpstr,LONG Timeout,LONG 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) & ! & ! 2-May-86 Redisplay default if user backs up to first & ! character with "delete" keystroke & ! 20-Nov-86 Repaint pasteboard if ctrl-W typed & ! & !---------------------------------------------------------------& ! & ! 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 LONG Partial_flag, & Return_status, & Readcol, & Max_length, & Def_input_display_attr DECLARE LONG CONSTANT True = -1, & False = 0 DECLARE WORD Term_code, & Total_char_recvd, & Received_string_length DECLARE STRING Dummy, & Partial_inpstr, & Default_response EXTERNAL LONG FUNCTION SMG$Put_chars, & SMG$Read_string, & SMG$Set_cursor_abs, & SMG$Change_rendition EXTERNAL LONG CONSTANT SS$_Normal, & SMG$M_Bold EXTERNAL STRING FUNCTION Get_Error_Message(LONG) EXTERNAL SUB SMG$Ring_bell, & SMG$Repaint_Screen !---------------------------------------------------------------& ! & ! M a i n P r o g r a m L o g i c & ! & !---------------------------------------------------------------& ! & ! P r o g r a m F l o w & ! & ! 1) Calculate the column where input will start based upon & ! the length (or absence) of the prompt. If a prompt & ! exists, input will start two spaces beyond its' end, & ! otherwise, it will take place at row/column. & ! 2) Display the prompt (if any) at the location specified & ! by the row/column parameters. & ! 3) Display the default response. & ! 4) Reset the cursor to the location calculated in step 1. & ! 5) Take the first character of input. If a carraige & ! return is struck, return the default response in the & ! input variable and exit. If a character is entered, & ! display that character, display the rest of the input & ! field as paint characters, and wait for the balance of & ! the input. ! & !---------------------------------------------------------------& Set_Up: SELECT LEN(Prompt) CASE 0 Readcol = Col CASE ELSE Readcol = Col + LEN(Prompt) + 1 END SELECT Default_response = Inpstr Inpstr = "" Total_char_recvd = 1 Max_length = Length - 1 Def_input_display_attr = Input_display_attr OR SMG$M_Bold Display_Prompt: Return_status = SMG$Put_chars(Display_id(Vir_disp_num),Prompt, & Row,Col,,,,) & UNLESS Prompt = "" IF Return_status AND SS$_Normal = 0 THEN PRINT Get_Error_Message(Return_status) STOP END IF Display_Default_Response: Return_status = SMG$Put_chars(Display_id(Vir_disp_num), & Default_response, Row,Readcol,,Def_input_display_attr,,) IF Return_status AND SS$_Normal = 0 THEN PRINT Get_Error_Message(Return_status) STOP END IF Reset_Cursor: Return_status = SMG$Set_cursor_abs(Display_id(Vir_disp_num),Row,Readcol) IF Return_status AND SS$_Normal = 0 THEN PRINT Get_Error_Message(Return_status) STOP END IF Get_First_Character: ! 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 IF Timeout < 1 THEN Return_status = 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),,Def_input_display_attr,) ELSE Return_status = 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),,Def_input_display_attr,) END IF IF Return_status AND SS$_Normal = 0 THEN PRINT Get_Error_Message(Return_status) STOP END IF Parse_Terminator_Code: SELECT Term_code CASE 13 ! CR - take the default response and exit Inpstr = Default_response GOTO Input_Complete CASE 23 ! ctrl-W - repaint screen CALL SMG$Repaint_Screen(Current_pasteboard_id) Inpstr = "" Total_char_recvd = 1 Max_length = Length - 1 GOTO Display_Default_Response 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 Return_status = SMG$Put_chars(Display_id(Vir_disp_num), & Partial_inpstr, Row,Readcol,,Def_input_display_attr,,) IF Return_status AND SS$_Normal = 0 THEN PRINT Get_Error_Message(Return_status) STOP END IF Return_status = SMG$Put_chars(Display_id(Vir_disp_num), & STRING$(Length-1,ASCII(Paint_char)),Row,Readcol+1,, & Def_input_display_attr,,) IF Return_status AND SS$_Normal = 0 THEN PRINT Get_Error_Message(Return_status) STOP END IF Return_status = SMG$Set_cursor_abs(Display_id(Vir_disp_num),Row,Readcol+1) IF Return_status AND SS$_Normal = 0 THEN PRINT Get_Error_Message(Return_status) 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_Character END SELECT Get_Input: ! User didn't take default - get the balance of the input IF Timeout < 1 THEN Return_status = 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),,Def_input_display_attr,) ELSE Return_status = 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),,Def_input_display_attr,) END IF IF Return_status AND SS$_Normal = 0 THEN PRINT Get_Error_Message(Return_status) 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 SELECT Term_code CASE 13 ! carriage return - fall through to final read ! OK CASE 0 TO 12,14 TO 17,19,20,22,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 - before doing this, we ! need to make sure any characters which ! have been typed are erased from the display Return_status = SMG$Put_chars(Display_id(Vir_disp_num), & SPACE$(Total_char_recvd),Row, & Readcol,,Def_input_display_attr,,) IF Return_status AND SS$_Normal = 0 THEN PRINT Get_Error_Message(Return_status) STOP END IF Inpstr = "" Partial_flag = False Total_char_recvd = 1 Max_length = Length - 1 GOTO Display_Default_Response CASE 23 ! ctrl-W - repaint screen CALL SMG$Repaint_Screen(Current_pasteboard_id) Inpstr = "" Total_char_recvd = 1 Max_length = Length - 1 GOTO Display_Default_Response CASE 127 ! a delete - back up, repaint the paint character, ! reposition, and try again ! if the delete occurred in the second byte of ! the field, start over from the beginning - that ! is, redisplay the default, etc. SELECT Total_char_recvd CASE 0 CALL SMG$Ring_bell(Display_id(Vir_disp_num),) GOTO Get_Input CASE 1 Inpstr = "" Total_char_recvd = 1 Max_length = Length - 1 Partial_flag = False GOTO Display_default_response CASE ELSE Total_char_recvd = Total_char_recvd - 1 Max_length = Length - Total_char_recvd Return_status = SMG$Put_chars(Display_id(Vir_disp_num), & del_seq,,,,Def_input_display_attr,,) 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,ctrl-W ! will be allowed to terminate the read - ! anything else will be ignored (ring the bell) Final_Read: IF Timeout < 1 THEN Return_status = SMG$Read_string(Current_keyboard_id,Dummy,,1,& Input_function_modifier2,,,,Term_code, & Display_id(Vir_disp_num),,Def_input_display_attr,) ELSE Return_status = SMG$Read_string(Current_keyboard_id,Dummy,,1,& Input_function_modifier2,Timeout,,,Term_code,& Display_id(Vir_disp_num),,Def_input_display_attr,) END IF IF Return_status AND SS$_Normal = 0 THEN PRINT Get_Error_Message(Return_status) STOP END IF SELECT Term_code CASE 13 ! CR ! OK CASE 18,21,24 ! ctrl-R,ctrl-U,ctrl-X Return_status = SMG$Put_chars(Display_id(Vir_disp_num), & SPACE$(Length),Row,Readcol,, & Def_input_display_attr,,) IF Return_status AND SS$_Normal = 0 THEN PRINT Get_Error_Message(Return_status) STOP END IF Inpstr = "" Partial_flag = False Total_char_recvd = 1 Max_length = Length - 1 GOTO Display_Default_Response CASE 23 ! ctrl-W - repaint screen CALL SMG$Repaint_Screen(Current_pasteboard_id) Inpstr = "" Total_char_recvd = 1 Max_length = Length - 1 GOTO Display_Default_Response CASE 127 ! delete Max_length = 1 Total_char_recvd = Length - 1 Return_status = SMG$Put_chars(Display_id(Vir_disp_num), & del_seq,,,,Def_input_display_attr,,) 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: 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 ! turn input display attribute off Return_status = SMG$Change_rendition(Display_id(Vir_disp_num),Row,Readcol, & 1,Length,Def_input_display_attr, Def_input_display_attr) IF Return_status AND SS$_Normal = 0 THEN PRINT Get_Error_Message(Return_status) STOP END IF ! if paint character is not blank and input taken was less than ! max length, wipe out the remaining paint characters IF Paint_char <> SP AND LEN(Inpstr) < Length THEN Return_status = SMG$Put_chars(Display_id(Vir_disp_num), & SPACE$(Length - LEN(Inpstr)),Row,Readcol+LEN(Inpstr),,,,) IF Return_status AND SS$_Normal = 0 THEN PRINT Get_Error_Message(Return_status) STOP END IF END IF End_Routine: SUBEXIT END SUB