SUBROUTINE STD.INPUT(COLUMN, ROW, REQ.FLAG, DEFAULT, MATCH.PAT, CHECK.EXPR, CONV.CODE, FMT.PAT, HELP.TEXT, CONTROL , RESULT) **** * std.input - standard screen input subroutine LastUpdated... = "Rev: 09:46 01DEC88 MIS.ATM REP 34 Z UTILITIES>BP>STD.INPUT.IBAS" **** * * Parameters * ========== * I/O Req Parameter Description * --- --- ---------- ---------------------------------------------------------------------------------------------- * (I) Req COLUMN Prompt column * (I) Req ROW Prompt row * (I) Req REQ.FLAG TRUE$: RESULT may not be null ; FALSE$: null RESULT permitted * (I) Opt DEFAULT Default value if null user entry * (I) Opt MATCH.PAT Info/Basic MATCH{ES} pattern for normal entries * (I) Opt CHECK.EXPR Special interpreted expression for additional verification (see syntax below) * (I) Opt CONV.CODE Info/Basic ICONV/OCONV code for input verification/conversion (ICONV) and display (OCONV) * (I) Opt FMT.PAT Info/Basic FMT pattern for input size and display formatting * (I) Opt HELP.TEXT Text message(s) to print on message line (see structure description below) * (I) Opt CONTROL Info/Basic MATCH{ES} pattern for "control" entries * * (Output) RESULT Return value [ICONV'd] * * DESCRIPTION * * 0. The prompt text is displayed on the message line. * 1. The cursor is positioned at COLUMN,ROW where the default value is converted, formatted, and displayed. * 2. The user enters a value terminated by . If the terminal is in PTERM -ECHO DELAY mode, only characters up to * the length specified in FMT.PAT are displayed. Non-printing characters are removed from the input value. * 3. Special user input values are handled (see below). * 4. A normal input value is valid if it meets the following conditions for any non-null parameters: * a. input MATCH{ES} MATCH.PAT * b. internal conversion [ICONV()] returns STATUS() = 0 (i.e. no error) * c. CHECK.EXPR evaluates to TRUE * 5. If the user entry was invalid, a message is displayed and the process is repeated from step 1. * 6. If the user entry was valid, the RESULT is re-displayed and returned to the calling program. * * SPECIAL USER INPUT VALUES * * ? The prompt text is displayed. * ! The parameters MATCH.PAT, CHECK.EXPR, CONV.CODE, FMT.PAT, and CONTROL are displayed. * The checking is skipped and the entry is returned to the caller if it matches the CONTROL string. * * SYNTAX FOR CHECK EXPRESSION * * [ [ (symbol) (space) (value) ] (space) ] . . . * * symbol One of the following: * > >= < <= * space A single space * value Any numeric or string value (MUST NOT CONTAIN SPACES) * Converted using OCONV() and CONV.CODE for display in error message. * * HELP.TEXT STRUCTURE * * Field Message When displayed * ----- -------- ------------------------------------------------------------- * <1> Prompt once upon entry and whenever ? is entered. * <2> Required if user entry is null, REQ.FLAG is true, and DEFAULT is null. * <3> Match if user entry doesn't match MATCH.PAT * <4> Check if user entry fails tests of CHECK.EXPR * <5> Status if user entry fails conversion via ICONV() or FMT(). * **** * R E V I S I O N L O G * PR# WHEN WHO WHY * ======= ======== ========== ========================================== * m1017 01-14-87 j dignan initial coding * m1109 02-16-87 j dignan don't do checking of default value if null entered * hc0091 06-05-87 j dignan evaluate CHECK.EXPR using ICONV'd values; * ALWAYS check entered value for validity, including the default value. * **** **** begin code COMMON /STDINP/ INITIALIZED, BADCHARS TRUE$ = 1 FALSE$ = 0 OTHERS$ = 1 ** main routine GOSUB INITIALIZE VALID = FALSE$ LOOP GOSUB DISPLAY.VALUE UNTIL VALID GOSUB GET.INPUT GOSUB VALIDATE.ENTRY REPEAT RETURN ** subroutines DISPLAY.VALUE: ;* value => oconv.val => dispval OCONV.VAL = OCONV(VALUE, CONV.CODE) DISPVAL = FMT(OCONV.VAL, FMT.PAT) GOSUB CHECK.STATUS IF LEN(MSG) THEN CRT @(0,23):MSG:@(-4): VALID = FALSE$ ;* they aren't going anywhere . . . END PRINT @(COLUMN,ROW): DISPVAL: RETURN * GET.INPUT: PRINT @(COLUMN,ROW): INPUT INVAL,MAX.SIZE_: ;* MAX.SIZE=0 IS UNLIMITED INPUT CONVERT BADCHARS TO '' IN INVAL RETURN * VALIDATE.ENTRY: BEGIN CASE CASE (INVAL EQ '?') ;* help MSG = HELP.MSG CASE (INVAL EQ '!') ;* extended help MSG = EXTENDED.HELP.MSG CASE (NOT(LEN(INVAL)) AND REQ.FLAG AND NOT(LEN(DEFAULT))) ;* entry required MSG = REQ.MSG CASE (LEN(CONTROL) AND (INVAL MATCHES CONTROL)) ;* control entry VALID = TRUE$ RESULT = INVAL CASE (TRUE$) ;* non-null, non-control values GOSUB CHECK.NORMAL.ENTRY END CASE CRT @(0,23):MSG:@(-4): RETURN * CHECK.NORMAL.ENTRY: ;* default => inval => iconv.val => result => value IF NOT(LEN(INVAL)) THEN ;* supply default value [OCONV'd] INVAL = OCONV.VAL IF NOT(LEN(INVAL)) THEN RESULT = INVAL VALID = TRUE$ RETURN END END IF LEN(MATCH.PAT) THEN ;* verify INVAL against match pattern IF NOT(INVAL MATCH MATCH.PAT) THEN MSG = MATCH.MSG RETURN END END ICONV.VAL = ICONV(INVAL,CONV.CODE) ;* convert to internal representation GOSUB CHECK.STATUS IF LEN(MSG) THEN RETURN IF LEN(CHECK.EXPR) THEN ;* verify ICONV.VAL against check expression GOSUB EXPRESSION.CHECK IF LEN(MSG) THEN RETURN END ;* re-assign the return value if all tests passed RESULT = ICONV.VAL VALUE = RESULT VALID = TRUE$ RETURN * EXPRESSION.CHECK: EXPR = EXPR ;* reset remove pointer MORE = LEN(EXPR) LOOP WHILE (MORE) OP = REMOVE(EXPR, MORE) N = REMOVE(EXPR, MORE) BEGIN CASE CASE (OP EQ "<") IF NOT(ICONV.VAL < N) THEN MSG = "Must be less than " END CASE (OP EQ "<=") IF NOT(ICONV.VAL <= N) THEN MSG = "Must be less than or equal to " END CASE (OP EQ ">") IF NOT(ICONV.VAL > N) THEN MSG = "Must be greater than " END CASE (OP EQ ">=") IF NOT(ICONV.VAL >= N) THEN MSG = "Must be greater than or equal to " END CASE (TRUE$) MSG = "Invalid operator in check expression (": OP: ")" RETURN END CASE IF LEN(MSG) THEN IF LEN(CHECK.EXPR.MSG) THEN MSG = CHECK.EXPR.MSG ;* override default message END ELSE MSG := OCONV(N,CONV.CODE): " (": INVAL: ")": @SYS.BELL END RETURN END REPEAT RETURN * CHECK.STATUS: ;* check result of STATUS() function STAT = STATUS() BEGIN CASE CASE (STAT EQ 0) MSG = '' RETURN CASE (STAT EQ 1) MSG = STATUS.MSG CASE (STAT EQ 2) MSG = "Invalid conversion code (": CONV.CODE: ") or format pattern (": FMT.PAT: ")" CASE (STAT EQ 3) MSG = "Invalid date (": INVAL: ")" CASE (STAT EQ -1) MSG = "Precision error in numeric conversion." CASE (TRUE$) MSG = "Unexpected format/conversion error - status: ": STAT END CASE MSG := @SYS.BELL RETURN * INITIALIZE: VALUE = DEFAULT ;* default => value PROMPT '' IF NOT(INITIALIZED) THEN ;* store unprintable characters string in labelled common BADCHARS = '' FOR I = 0 TO 31 BADCHARS := CHAR(I) NEXT I BADCHARS := CHAR(127) INITIALIZED = TRUE$ END ;* parse error messages from HELP.TEXT HELP.MSG = HELP.TEXT<1> IF LEN(HELP.MSG) THEN CRT @(0,23):HELP.MSG:@(-4): END ELSE HELP.MSG = "No help available." END REQ.MSG = HELP.TEXT<2> IF NOT(LEN(REQ.MSG)) THEN REQ.MSG = "Entry is required.":@SYS.BELL END MATCH.MSG = HELP.TEXT<3> IF NOT(LEN(MATCH.MSG)) THEN MATCH.MSG = "Must match the following: ": MATCH.PAT: @SYS.BELL CONVERT @VM TO ',' IN MATCH.MSG END CHECK.EXPR.MSG = HELP.TEXT<4> STATUS.MSG = HELP.TEXT<5> IF NOT(LEN(STATUS.MSG)) THEN STATUS.MSG = "Invalid entry.": @SYS.BELL END EXTENDED.HELP.MSG = "Match: ": MATCH.PAT: " Expr: ": CHECK.EXPR: " Conv: ": CONV.CODE: " Fmt: ": FMT.PAT: " Ctrl: ": CONTROL CONVERT @VM TO ',' IN EXTENDED.HELP.MSG EXPR = CHECK.EXPR ;* set up for REMOVE() CONVERT ' ' TO @FM IN EXPR ;* determine maximum input size from format pattern MAX.SIZE = MATCHFIELD(FMT.PAT,"0N0X",1) + 0 IF (MAX.SIZE GT 0) THEN RETURN MAX.SIZE = MATCHFIELD(FMT.PAT,"0X0N",2) + 0 IF (MAX.SIZE GT 0) THEN RETURN MAX.SIZE = COUNT(FMT.PAT,'#') RETURN ** to avoid compiler warnings about unassigned variables . . . RESPONSE = 0 **** end code END