QB64/QB64-PE
QB64/QB64-PE
1
1
Fork 0
mirror of https://github.com/QB64-Phoenix-Edition/QB64pe.git synced 2024-05-12 12:00:13 +00:00
Code Issues Releases Wiki Activity

Add support for ASC() and CHR$()

Browse source
This commit is contained in:
Matthew Kilgore 2024-01-17 21:17:27 -05:00
parent 90941fffa7
commit 1a087609bf
5 changed files with 56 additions and 24 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

62
source/utilities/const_eval.bas
View file

@ -10,7 +10,9 @@ END TYPE
'Steve Subs/Functins for _MATH support with CONST
FUNCTION Evaluate_Expression$ (e$, num AS ParseNum)
t$ = e$ 'So we preserve our original data, we parse a temp copy of it
PreParse t$
IF CONST_EVAL_DEBUG THEN _Echo "t$: " + t$
IF LEFT$(t$, 5) = "ERROR" THEN Evaluate_Expression$ = t$: EXIT FUNCTION
@ -23,16 +25,10 @@ FUNCTION Evaluate_Expression$ (e$, num AS ParseNum)
FindInnerParens exp$, C, Eval_E
IF Eval_E > 0 THEN
IF c = 0 THEN Evaluate_Expression$ = "ERROR -- BAD () Count": EXIT FUNCTION
IF c = 0 THEN Evaluate_Expression$ = "ERROR - BAD () Count": EXIT FUNCTION
eval$ = getelements$(exp$, c + 1, Eval_E - 1)
IF CONST_EVAL_DEBUG THEN _Echo "C: " + str$(c) + ", eval_e: " + str$(eval_e)
IF CONST_EVAL_DEBUG THEN _Echo "exp: " + exp$
IF CONST_EVAL_DEBUG THEN _Echo "inner element list: " + eval$
IF CONST_EVAL_DEBUG THEN _Echo "getelements: " + getelements$(exp$, c + 1, Eval_E - 1)
ParseExpression2 eval$
IF CONST_EVAL_DEBUG THEN _Echo "orig eval$: " + eval$
eval$ = LTRIM$(RTRIM$(eval$))
IF LEFT$(eval$, 5) = "ERROR" THEN Evaluate_Expression$ = eval$: EXIT FUNCTION
@ -41,7 +37,6 @@ FUNCTION Evaluate_Expression$ (e$, num AS ParseNum)
' If so, evaluate it now using the argument list we have
funcOp& = IsFunctionIdentifier(getelement$(exp$, c - 1))
IF funcOp& > 0 THEN
IF CONST_EVAL_DEBUG THEN _Echo "Function evaluate! " + getelement$(exp$, c - 1)
eval$ = EvaluateFunction$(funcOp&, eval$)
IF LEFT$(eval$, 5) = "ERROR" THEN Evaluate_Expression$ = eval$: EXIT FUNCTION
@ -157,8 +152,8 @@ END SUB
'
' unary := '-' exponent | exponent
'
' ' Note: NOT a special case here similar to -, but it is handled in PreParse
' ' via parenthesis insertion
' ' Note: NOT is a special case here similar to -, but it is handled in
' ' PreParse via parenthesis insertion
' exponent := numeric '^' unary
' | numeric 'ROOT' unary
' | numeric
@ -500,7 +495,6 @@ FUNCTION Term&(exp$, state AS ParserState)
IF ele$ = "+" THEN
ele$ = getnextelement$(exp$, state.index, state.strIndex)
IF ParseMod&(exp$, state) = 0 THEN FixupErrorMessage state, "+": EXIT FUNCTION
IF CONST_EVAL_DEBUG THEN _Echo "term parsing!"
IF (num.typ AND ISFLOAT) OR (state.num.typ AND ISFLOAT) THEN
ParseNumSetF num, FLOATTYPE - ISPOINTER, num.f + state.num.f
@ -521,7 +515,6 @@ FUNCTION Term&(exp$, state AS ParserState)
ParseNumSetI num, INTEGER64TYPE - ISPOINTER, num.i - state.num.i
END IF
ELSE
IF CONST_EVAL_DEBUG THEN _Echo "Term done! ele: " + ele$
state.num = num
Term& = -1
EXIT FUNCTION
@ -853,7 +846,6 @@ SUB Set_ConstFunctions
i = i + 1: ConstFuncs(i).nam = "_SEC": ConstFuncs(i).ArgCount = 1
i = i + 1: ConstFuncs(i).nam = "_CSC": ConstFuncs(i).ArgCount = 1
i = i + 1: ConstFuncs(i).nam = "_COT": ConstFuncs(i).ArgCount = 1
' i = i + 1: ConstFuncs(i).nam = "ASC": ConstFuncs(i).ArgCount = 1
i = i + 1: ConstFuncs(i).nam = "_RGB32": ConstFuncs(i).ArgCount = -1
i = i + 1: ConstFuncs(i).nam = "_RGBA32": ConstFuncs(i).ArgCount = 4
@ -868,6 +860,9 @@ SUB Set_ConstFunctions
i = i + 1: ConstFuncs(i).nam = "_BLUE": ConstFuncs(i).ArgCount = 2
i = i + 1: ConstFuncs(i).nam = "_ALPHA": ConstFuncs(i).ArgCount = 2
i = i + 1: ConstFuncs(i).nam = "CHR$": ConstFuncs(i).ArgCount = 1
i = i + 1: ConstFuncs(i).nam = "ASC": ConstFuncs(i).ArgCount = -1
REDIM _PRESERVE ConstFuncs(i) AS ConstFunction
END SUB
@ -876,7 +871,8 @@ END SUB
' Each argument should be a single element
FUNCTION EvaluateFunction$ (p, args AS STRING)
DIM n1 AS _FLOAT, nstr AS STRING
Dim argCount As Long, args(5) As ParseNum
Dim argCount As Long, args(5) As ParseNum, origArgs(5) As String
argCount = countFunctionElements(args)
@ -889,16 +885,20 @@ FUNCTION EvaluateFunction$ (p, args AS STRING)
FOR i = 1 to argCount
ele$ = getelement$(args, 1 + (i - 1) * 2)
origArgs(i) = ele$
IF CONST_EVAL_DEBUG THEN _Echo "arg is string: " + STR$(elementIsString(ele$)) + ", argCount: " + STR$(ConstFuncs(p).ArgCount)
IF elementIsNumber(ele$) THEN
' skip the commas
args(i).typ = elementGetNumericValue&(ele$, args(i).f, args(i).i, args(i).ui)
ELSEIF elementIsString(ele$) AND ConstFuncs(p).ArgCount > 0 THEN ' positive arg count means arguments are all numbers
ELSEIF elementIsString(ele$) AND ConstFuncs(p).ArgCount < 0 THEN ' positive arg count means arguments are all numbers
args(i).typ = elementGetStringValue&(ele$, args(i).s)
ELSE
EvaluateFunction$ = "ERROR - Unexpected argument: " + ele$
EXIT FUNCTION
END IF
' args(i) = getelement$(args, 1 + (i - 1) * 2)
IF CONST_EVAL_DEBUG THEN _Echo "Argument: " + str$(args(i).f) + ", str: " + getelement$(args, 1 + (i - 1) * 2)
NEXT
@ -1020,9 +1020,31 @@ FUNCTION EvaluateFunction$ (p, args AS STRING)
CASE "_SEC": n1 = _SEC(args(1).f)
CASE "_CSC": n1 = _CSC(args(1).f)
CASE "_COT": n1 = _COT(args(1).f)
CASE "CHR$":
IF args(1).ui > 255 THEN EvaluateFunction$ = "ERROR - Invalid argument to CHR$, valid range is 0-255: " + origArgs(1): EXIT FUNCTION
nstr = CHR$(args(1).ui)
typ& = STRINGTYPE
CASE "ASC":
IF argCount < 1 OR argCount > 2 THEN EvaluateNumbers$ = "ERROR - Wrong number of arguments provided to ASC$": EXIT FUNCTION
IF (args(1).typ AND ISSTRING) = 0 THEN EvaluateFunction$ = "ERROR - Unexpected argument: '" + origArgs(1) + "'": EXIT FUNCTION
IF argCount = 1 THEN
n1 = ASC(args(1).s)
ELSE
IF args(2).typ AND ISSTRING THEN EvaluateFunction$ = "ERROR - Expected integer argument: '" + origArgs(2) + "'": EXIT FUNCTION
n1 = ASC(args(1).s, args(2).i)
END IF
typ& = INTEGER64TYPE - ISPOINTER
END SELECT
IF typ& AND ISFLOAT THEN
IF typ& AND ISSTRING THEN
EvaluateFunction$ = createElementString$(nstr)
ELSEIF typ& AND ISFLOAT THEN
EvaluateFunction$ = _TRIM$(STR$(n1))
ELSE
n&& = n1
@ -1063,7 +1085,7 @@ SUB PreParse (e$)
t$ = e$ 'preserve the original string
t$ = eleucase$(t$)
IF t$ = "" THEN e$ = "ERROR -- NULL string; nothing to evaluate": EXIT SUB
IF t$ = "" THEN e$ = "ERROR - NULL string; nothing to evaluate": EXIT SUB
'ERROR CHECK by counting our brackets
count = numelements(t$)
@ -1072,9 +1094,9 @@ SUB PreParse (e$)
IF ele$ = "(" THEN c = c + 1
IF ele$ = ")" THEN c = c - 1
IF c < 0 THEN e$ = "ERROR -- Bad Parenthesis, too many )": EXIT SUB
IF c < 0 THEN e$ = "ERROR - Bad Parenthesis, too many )": EXIT SUB
NEXT
IF c <> 0 THEN e$ = "ERROR -- Bad Parenthesis": EXIT SUB
IF c <> 0 THEN e$ = "ERROR - Bad Parenthesis": EXIT SUB
'Modify so that NOT will process properly
FOR l = 1 to numelements(t$)

2
source/utilities/elements.bas
View file

@ -536,7 +536,7 @@ END FUNCTION
FUNCTION elementIsString&(ele$)
' String elements are always surounded by quotes
elementIsString& = INSTR(ele$, CHR$(34))
elementIsString& = INSTR(ele$, CHR$(34)) <> 0
END FUNCTION
FUNCTION elementGetStringValue&(ele$, value AS STRING)

2
tests/compile_tests.sh
View file

@ -137,6 +137,8 @@ do
ERR=$?
popd > /dev/null
cat >"$RESULTS_DIR/$category-$testName-run-output.txt" <<<"$testResult"
(exit $ERR)
assert_success_named "run" "Execution Error:" echo "$testResult"

10
tests/compile_tests/const/math_funcs.bas
View file

@ -33,7 +33,6 @@ CONST const_FIX = FIX(20.5)
CONST const_SEC = _SEC(2)
CONST const_CSC = _CSC(2)
CONST const_COT = _COT(2)
' CONST const_ASC = ASC("a") ' Bugged, not implemented
CONST const__RGB32 = _RGB32(2, 3, 4)
CONST const__RGBA32 = _RGBA32(2, 3, 4, 5)
CONST const__RGB32_1 = _RGB32(2)
@ -52,6 +51,10 @@ CONST const__ALPHA = _ALPHA(2222, 0)
CONST const_SQR = SQR(20)
CONST const_ROOT = 20 ROOT 3
CONST const_CHR = CHR$(34) + CHR$(9)
CONST const_ASC = ASC("\")
CONST const_nested = CHR$(ASC(CHR$(ASC("\"))))
' The answers have to be within the allowed range, to account for floating point
' differences.
PRINT "PI: "; 3.141592653589793 * .999999 < const_PI; 3.141592653589793 * 1.000001 > const_PI
@ -89,7 +92,6 @@ PRINT "INT: "; const_INT
PRINT "ROUND: "; const_ROUND
PRINT "CEIL: "; const_CEIL
PRINT "FIX: "; const_FIX
PRINT "ASC: "; const_ASC
PRINT "RGB32: "; HEX$(const__RGB32)
PRINT "RGBA32: "; HEX$(const__RGBA32)
PRINT "1: "; HEX$(const__RGB32_1)
@ -106,4 +108,8 @@ PRINT "GREEN: "; const__GREEN
PRINT "BLUE: "; const__BLUE
PRINT "ALPHA: "; const__ALPHA
PRINT "CHR: "; const_CHR
PRINT "ASC: "; const_ASC
PRINT "nested: "; const_nested
SYSTEM

4
tests/compile_tests/const/math_funcs.output
View file

@ -31,7 +31,6 @@ INT: 20
ROUND: 20
CEIL: 21
FIX: 20
ASC: 0
RGB32: FF020304
RGBA32: 5020304
1: FF020202
@ -47,3 +46,6 @@ RED: 0
GREEN: 0
BLUE: 0
ALPHA: 255
CHR: "
ASC: 92
nested: \