'This program, set up to run as a demo right now, is intended
'to read input strings for text-based games, remove non-alphanumeric
'characters (except spaces) from them, remove multiple spaces from
'them, lcase them, separate them into individual words, and them
'elminate unneccessary words (prepositions [on, in, etc.] and
'determiners [a, the, etc.], so that only the important words in
'the command (hopefully: verb, direct object, indirect object)
'survive to be processed. This allows text-based games to be way
'more flexible about the input it can accept. Check out the demo.
DECLARE SUB FilterCommand (strString AS STRING, strWords() AS STRING, intNumWords AS INTEGER)
DECLARE FUNCTION AlphaNumeric$ (strString AS STRING)
DECLARE FUNCTION PrepareString$ (strString AS STRING)
DECLARE FUNCTION RemoveDoubleSpaces$ (strString AS STRING)
DECLARE SUB GetWords (strString AS STRING, strWords() AS STRING, intNumWords AS INTEGER)
DECLARE SUB ResizeArrayOfStrings (strArray() AS STRING, intNewSize AS INTEGER)
DECLARE SUB FilterExtraWords (strWords() AS STRING, intNumWords AS INTEGER)
DECLARE SUB ListDeterminers (strDeterminers() AS STRING, intNumDeterminers AS INTEGER)
DECLARE SUB ListPrepositions (strPrepositions() AS STRING, intNumPrepositions AS INTEGER)
DECLARE SUB RemoveWord (strWords() AS STRING, intNumWords AS INTEGER, intWord AS INTEGER)
'DECLARE SUB ResizeArrayOfStrings (strArray() AS STRING, intNewSize AS INTEGER)
'Dimension bounds:
DIM intNumWords AS INTEGER
DIM intNumObjects AS INTEGER
'Initialize Variables:
DIM strString AS STRING
DIM strWords(1 TO intNumWords) AS STRING
'Demo Code:
'Get a string form the user.
INPUT ">", strString
'Filter the user's string into an array of words (strWords()).
CALL FilterCommand(strString, strWords(), intNumWords)
'Output the array of words for the user to see.
DIM I AS INTEGER
FOR I = 1 TO intNumWords
PRINT I, strWords(I)
NEXT I
END
FUNCTION AlphaNumeric$ (strString AS STRING)
'SUMMARY:
'AlphaNumeric$ filters all punctuation and symbols out
'of string, leaving only letters (Aa-Zz), numerals
'(0-9), and spaces.
'INPUT:
'strString: The input string being filtered.
'OUTPUT:
'AlphaNumeric$: Returns only the input string's
'alphanumeric characters and spaces.
'Dimension Variables:
DIM intI AS INTEGER 'Increment Variable.
DIM intStringLength AS INTEGER 'The length of the string.
DIM strCharacter AS STRING * 1 'The character currently being tested.
DIM strOutput AS STRING 'The new string, with only AlphaNumeric characters.
'Get the next character to be tested.
strCharacter = MID$(strString, intI, 1)
'Add the current character to the output if:
' 1. It belongs to (a-z).
IF ((strCharacter >= "a") AND (strCharacter <= "z")) THEN
strOutput = strOutput + strCharacter
' 2. It belongs to (A-Z).
ELSEIF ((strCharacter >= "A") AND (strCharacter <= "Z")) THEN
strOutput = strOutput + strCharacter
' 3. It belongs to (0-9).
ELSEIF ((strCharacter >= "0") AND (strCharacter <= "9")) THEN
strOutput = strOutput + strCharacter
' 4. It is a space.
ELSEIF (strCharacter = " ") THEN
strOutput = strOutput + strCharacter
END IF
NEXT intI
'Output:
AlphaNumeric$ = strOutput
END FUNCTION
SUB FilterCommand (strString AS STRING, strWords() AS STRING, intNumWords AS INTEGER)
strString = AlphaNumeric$(strString)
strString = PrepareString$(strString)
strString = RemoveDoubleSpaces$(strString)
CALL GetWords(strString, strWords(), intNumWords)
CALL FilterExtraWords(strWords(), intNumWords)
END SUB
SUB FilterExtraWords (strWords() AS STRING, intNumWords AS INTEGER)
DIM intNumFilter AS INTEGER
intNumFilter = 1
DIM strFilter(1 TO intNumFilter) AS STRING
DIM intI AS INTEGER
DIM intJ AS INTEGER
DIM intFound AS INTEGER
CALL ListPrepositions(strFilter(), intNumFilter)
FOR intH = 1 TO 2
IF intH = 1 THEN
CALL ListPrepositions(strFilter(), intNumFilter)
ELSEIF intH = 2 THEN
CALL ListDeterminers(strFilter(), intNumFilter)
END IF
intI = 1
WHILE (intI <= intNumWords)
intJ = 1
WHILE (intJ <= intNumFilter) AND (intFound = 0)
IF strWords(intI) = strFilter(intJ) THEN
CALL RemoveWord(strWords(), intNumWords, intI)
intFound = 1
END IF
intJ = intJ + 1
WEND
IF (NOT intFound) THEN intI = intI + 1
intFound = 0
WEND
NEXT intH
END SUB
SUB GetWords (strString AS STRING, strWords() AS STRING, intNumWords AS INTEGER)
'Getwords extracts individual words from the input string.
'Dimension Variables:
DIM intLocation AS INTEGER
DIM intStart AS INTEGER
SUB RemoveWord (strWords() AS STRING, intNumWords AS INTEGER, intWord AS INTEGER)
DIM intI AS INTEGER
intI = intWord
strWords(intI) = ""
WHILE (intI < intNumWords)
strWords(intI) = strWords(intI + 1)
intI = intI + 1
WEND
intNumWords = intNumWords - 1
CALL ResizeArrayOfStrings(strWords(), intNumWords)
END SUB
SUB ResizeArrayOfStrings (strArray() AS STRING, intNewSize AS INTEGER)
'DIMENSION VARIABLES:
DIM intI AS INTEGER
DIM intJ AS INTEGER
'PREPROCESSING:
'Dimension the temporary array:
DIM TempArray(1 TO intNewSize) AS STRING
'Determine the lesser bound to avoid reading/writing past the end of one of the arrays:
IF (intNewSize < UBOUND(strArray)) THEN
intJ = intNewSize
ELSE
intJ = UBOUND(strArray)
END IF
'PROCESSING:
'Copy the array to the temporary array:
FOR intI = 1 TO intJ
TempArray(intI) = strArray(intI)
NEXT intI
'Redimension the array:
REDIM strArray(1 TO intNewSize) AS STRING
'Copy the temporary array to the array:
FOR intI = 1 TO intJ
strArray(intI) = TempArray(intI)
NEXT intI
END SUB