Input formatting (QBASIC)

From LiteratePrograms

The two functions described in this article are intended to be used for data validation and for formatted input. The first function,InputUsing$, takes a description of the required input, aMask, and a default value for that input, aText, and allows the user to enter or delete characters, only if the result fits the description. The second function, ValidInput$, takes the same description of the required input, text which has already been validated and text which requires validation and provides a result which fits the description.

Description

<<Function definitions>>=
FUNCTION InputUsing$ (aMask AS STRING, aText AS STRING)
   DIM dX AS INTEGER
   DIM dY AS INTEGER
   DIM dBuffer AS STRING
   DIM dNewChar AS STRING
   LET dBuffer = ValidInput$(aMask, "", aText)
   LET dX = POS(0)
   LET dY = CSRLIN
   LOCATE dY, dX
   PRINT dBuffer; SPACE$(LEN(aMask) - LEN(dBuffer));
   LOCATE dY, dX, 1
   DO
      LET dNewChar = INKEY$
      SELECT CASE LEN(dNewChar)
      CASE 0
         REM No character typed so do nothing
      CASE 1
         SELECT CASE ASC(dNewChar)
         CASE 8
            LET dNewChar = ""
            IF LEN(dBuffer) > 0 THEN
               LET dBuffer = LEFT$(dBuffer, LEN(dBuffer) - 1)
            END IF
         CASE 13
            LET dNewChar = ""
            PRINT
            IF LEN(dBuffer) = LEN(aMask) THEN
               EXIT DO
            END IF
         CASE 27
            LET dBuffer = aText
            LET dNewChar = ""
            PRINT
            EXIT DO
         CASE ELSE
            LET dBuffer = ValidInput$(aMask, dBuffer, dNewChar)
         END SELECT
         LOCATE dY, dX
         PRINT dBuffer; SPACE$(LEN(aMask) - LEN(dBuffer));
         LOCATE dY, dX + LEN(dBuffer), 1
      CASE ELSE
         SELECT CASE ASC(MID$(dNewChar, 2, 1))
         CASE ELSE
            LET dNewChar = ""
         END SELECT
      END SELECT
   LOOP
   LET InputUsing = dBuffer
END FUNCTION
FUNCTION ValidInput$ (aMask AS STRING, aChecked AS STRING, aUnchecked AS STRING)
   CONST cNumeric = "0123456789"
   CONST cUpper = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
   CONST cLower = "abcdefghijklmnopqrstuvwxyz"
   CONST cAlpha = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
   CONST cAlphaNumeric = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
   DIM J AS INTEGER
   DIM dBuffer AS STRING
   DIM dChar AS STRING
   LET dBuffer = aChecked
   LET J = 1
   DO WHILE J <= LEN(aUnchecked)
      LET dChar = MID$(aUnchecked, J, 1)
      SELECT CASE UCASE$(MID$(aMask, LEN(dBuffer) + 1, 1))
      CASE "0"
         IF INSTR(cNumeric, dChar) = 0 THEN
            LET dChar = ""
         END IF
      CASE "U"
         IF INSTR(cUpper, dChar) = 0 THEN
            LET dChar = ""
         END IF
      CASE "L"
         IF INSTR(cLower, dChar) = 0 THEN
            LET dChar = ""
         END IF
      CASE "A"
         IF INSTR(cAlpha, dChar) = 0 THEN
            LET dChar = ""
         END IF
      CASE "X"
         IF INSTR(cAlphaNumeric, dChar) = 0 THEN
            LET dChar = ""
         END IF
      CASE "?"
         REM Any character is okay so do nothing
      CASE ELSE
         IF MID$(aMask, LEN(dBuffer) + 1, 1) <> dChar THEN
            LET dChar = ""
         END IF
      END SELECT
      LET dBuffer = dBuffer + dChar
      LET J = J + 1
   LOOP
   LET ValidInput = dBuffer
END FUNCTION

In order to check the results a test harness has been provided. At the moment it does not contain a comprehensive set of tests but they can easily be added.

<<Test harness>>=
DECLARE FUNCTION ValidInput$ (aMask AS STRING, aChecked AS STRING, aUnchecked AS STRING)
DECLARE FUNCTION InputUsing$ (aMask AS STRING, aText AS STRING)
DIM mStatus AS STRING
DIM mTest AS STRING
DIM mMask AS STRING
DIM mChecked AS STRING
DIM mUnchecked AS STRING
DIM mExpected AS STRING
DIM mGot AS STRING
CLS
RESTORE TestCases
mStatus = ""
DO WHILE mStatus = ""
   READ mTest
   IF mTest = "" THEN
      mStatus = "All tests Succeeded"
   ELSE
      READ mMask, mChecked, mUnchecked, mExpected
      mGot = ValidInput$(mMask, mChecked, mUnchecked)
      PRINT "'" + mMask + "' '" + mChecked + "'+'" + mUnchecked + "': '" + mGot + "'"
      IF mExpected <> mGot THEN
         mStatus = "Last test failed (Expected '" + mExpected + "')"
      END IF
   END IF
LOOP
PRINT mStatus
SYSTEM
TestCases:
   DATA "*","(000) 000-0000","","(401) 522-7946","(401) 522-7946"
   DATA "*","(000) 000-0000","","(401) 522 7946","(401) 522"
   DATA "*","A0A 0A0","D3Z 4Q","9","D3Z 4Q9"
   DATA ""

<<InpUsing.bas>>=
Test harness
Function definitions

Download code