1 SUB SMG_INPUT(STRING Prompt, LONG Row, LONG Col, LONG Length, & STRING Inpstr, LONG Timeout, BYTE Vir_disp_num) !---------------------------------------------------------------& ! & ! SMG_INPUT & ! & ! Creation Date: 3-July-1985 & ! Author: Ken Messer & ! Purpose: General input routine & ! & ! 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 EXTERNAL LONG FUNCTION SMG$Read_string, & SMG$Set_cursor_abs, & SMG$Ring_bell, & SMG$Put_chars, & SMG$Get_display_attr, & SMG$Change_virtual_display, & SMG$Change_rendition EXTERNAL LONG CONSTANT SS$_Normal EXTERNAL STRING FUNCTION Get_Error_Message(LONG) !---------------------------------------------------------------& ! & ! M a i n P r o g r a m L o g i c & ! & !---------------------------------------------------------------& ! Set up the input field read column SELECT LEN(Prompt) CASE 0 Readcol = Col CASE ELSE Readcol = Col + LEN(Prompt) + 1 END SELECT Inpstr = "" Total_char_recvd = 0 Max_length = Length ! write the prompt 100 RS = SMG$Put_chars(Display_id(Vir_disp_num),Prompt,Row,Col,,,,) IF RS AND SS$_Normal = 0 THEN PRINT Get_Error_Message(RS) STOP END IF ! get the current video attributes so we can save them 200 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 ! change the default video attributes to reverse video 300 RS = SMG$Change_virtual_display(Display_id(Vir_disp_num), & Display_rows,Display_cols,Def_disp_attr,Input_Display_attr,) IF RS AND SS$_Normal = 0 THEN PRINT Get_Error_Message(RS) STOP END IF ! Display the input field paint character 400 RS = SMG$Put_chars(Display_id(Vir_disp_num), & STRING$(Max_length,ASCII(Paint_char)),Row,Readcol,,,,) IF RS AND SS$_Normal = 0 THEN PRINT Get_Error_Message(RS) STOP END IF ! reset the cursor 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 ! do the read Get_input: 600 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 Total_char_recvd = Total_char_recvd + Received_string_length IF Partial_flag THEN Inpstr = Partial_Inpstr + Inpstr Partial_flag = False END IF ! See what was done 700 SELECT Term_code CASE 13 ! carriage return ! OK CASE 0 TO 12,14 TO 17,19,20,22,23,25 TO 31 ! illegal terminators - don't allow RS = 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 - the user wants to ! 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 ! delete - write the delete sequence and go back ! for more input SELECT Total_char_recvd CASE 0 RS = 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 key - valid only if first ! character typed - otherwise, ignore it GOTO Handle_function_keys IF LEN(Inpstr) = 0 RS = 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 Done 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: ! Execute a one character read - nothing echos - allow only ! a carriage return, delete, or CRTL-X, CTRL-U, or CTRL-R 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 Timeout = -1 CASE ELSE ! anything else not allowed RS = SMG$Ring_bell(Display_id(Vir_disp_num),) GOTO Final_read END SELECT END SELECT GOTO Done 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 Done: 32000 Timeout = 0 UNLESS Timeout = -1 ! turn input display attribute off RS = SMG$Change_rendition(Display_id(Vir_disp_num),Row,Readcol, & 1,Length,Input_display_attr,Input_display_attr) IF RS AND SS$_Normal = 0 THEN PRINT Get_Error_Message(RS) STOP END IF ! change back to default video rendition 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 ! 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 RS = SMG$Put_chars(Display_id(Vir_disp_num), & SPACE$(Length - LEN(Inpstr)),Row,Readcol+LEN(Inpstr),,,,) IF RS AND SS$_Normal = 0 THEN PRINT Get_Error_Message(RS) STOP END IF END IF 32767 SUBEXIT END SUB