Post by: SMcNeill on August 01, 2019, 12:58:22 pm
Code: [Select]
REDIM SHARED OName(0) AS STRING 'Operation Name
REDIM SHARED PL(0) AS INTEGER 'Priority Level
DIM SHARED QuickReturn AS INTEGER
Set_OrderOfOperations 'This will also make certain our directories are valid, and if not make them.
DO
INPUT math$
PRINT Evaluate_Expression(math$)
LOOP
'Steve Subs/Functins for _MATH support with CONST
FUNCTION Evaluate_Expression$ (e$)
t$ = e$ 'So we preserve our original data, we parse a temp copy of it
b = INSTR(UCASE$(e$), "EQL") 'take out assignment before the preparser sees it
IF b THEN t$ = MID$(e$, b + 3): var$ = UCASE$(LTRIM$(RTRIM$(MID$(e$, 1, b - 1))))
QuickReturn = 0
PreParse t$
IF QuickReturn THEN Evaluate_Expression$ = t$: EXIT FUNCTION
IF LEFT$(t$, 5) = "ERROR" THEN Evaluate_Expression$ = t$: EXIT FUNCTION
'Deal with brackets first
exp$ = "(" + t$ + ")" 'Starting and finishing brackets for our parse routine.
DO
Eval_E = INSTR(exp$, ")")
IF Eval_E > 0 THEN
c = 0
DO UNTIL Eval_E - c <= 0
c = c + 1
IF Eval_E THEN
IF MID$(exp$, Eval_E - c, 1) = "(" THEN EXIT DO
END IF
LOOP
s = Eval_E - c + 1
IF s < 1 THEN PRINT "ERROR -- BAD () Count": END
eval$ = " " + MID$(exp$, s, Eval_E - s) + " " 'pad with a space before and after so the parser can pick up the values properly.
ParseExpression eval$
eval$ = LTRIM$(RTRIM$(eval$))
IF LEFT$(eval$, 5) = "ERROR" THEN Evaluate_Expression$ = eval$: EXIT SUB
exp$ = DWD(LEFT$(exp$, s - 2) + eval$ + MID$(exp$, Eval_E + 1))
IF MID$(exp$, 1, 1) = "N" THEN MID$(exp$, 1) = "-"
temppp$ = DWD(LEFT$(exp$, s - 2) + " ## " + eval$ + " ## " + MID$(exp$, E + 1))
END IF
LOOP UNTIL Eval_E = 0
c = 0
DO
c = c + 1
SELECT CASE MID$(exp$, c, 1)
CASE "0" TO "9", ".", "-" 'At this point, we should only have number values left.
CASE ELSE: Evaluate_Expression$ = "ERROR - Unknown Diagnosis: (" + exp$ + ") ": EXIT SUB
END SELECT
LOOP UNTIL c >= LEN(exp$)
Evaluate_Expression$ = exp$
END FUNCTION
SUB ParseExpression (exp$)
DIM num(10) AS STRING
'We should now have an expression with no () to deal with
IF MID$(exp$, 2, 1) = "-" THEN exp$ = "0+" + MID$(exp$, 2)
FOR J = 1 TO 250
lowest = 0
DO UNTIL lowest = LEN(exp$)
lowest = LEN(exp$): OpOn = 0
FOR P = 1 TO UBOUND(OName)
'Look for first valid operator
IF J = PL(P) THEN 'Priority levels match
IF LEFT$(exp$, 1) = "-" THEN op = INSTR(2, exp$, OName(P)) ELSE op = INSTR(exp$, OName(P))
IF op > 0 AND op < lowest THEN lowest = op: OpOn = P
END IF
NEXT
IF OpOn = 0 THEN EXIT DO 'We haven't gotten to the proper PL for this OP to be processed yet.
IF LEFT$(exp$, 1) = "-" THEN op = INSTR(2, exp$, OName(OpOn)) ELSE op = INSTR(exp$, OName(OpOn))
numset = 0
'*** SPECIAL OPERATION RULESETS
IF OName(OpOn) = "-" THEN 'check for BOOLEAN operators before the -
SELECT CASE MID$(exp$, op - 3, 3)
CASE "NOT", "XOR", "AND", "EQV", "IMP"
EXIT DO 'Not an operator, it's a negative
END SELECT
IF MID$(exp$, op - 3, 2) = "OR" THEN EXIT DO 'Not an operator, it's a negative
END IF
IF op THEN
c = LEN(OName(OpOn)) - 1
DO
SELECT CASE MID$(exp$, op + c + 1, 1)
CASE "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", ".", "N": numset = -1 'Valid digit
CASE "-" 'We need to check if it's a minus or a negative
IF OName(OpOn) = "_PI" OR numset THEN EXIT DO
CASE ELSE 'Not a valid digit, we found our separator
EXIT DO
END SELECT
c = c + 1
LOOP UNTIL op + c >= LEN(exp$)
E = op + c
c = 0
DO
c = c + 1
SELECT CASE MID$(exp$, op - c, 1)
CASE "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", ".", "N" 'Valid digit
CASE "-" 'We need to check if it's a minus or a negative
c1 = c
bad = 0
DO
c1 = c1 + 1
SELECT CASE MID$(exp$, op - c1, 1)
CASE "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "."
bad = -1
EXIT DO 'It's a minus sign
CASE ELSE
'It's a negative sign and needs to count as part of our numbers
END SELECT
LOOP UNTIL op - c1 <= 0
IF bad THEN EXIT DO 'We found our seperator
CASE ELSE 'Not a valid digit, we found our separator
EXIT DO
END SELECT
LOOP UNTIL op - c <= 0
s = op - c
num(1) = MID$(exp$, s + 1, op - s - 1) 'Get our first number
num(2) = MID$(exp$, op + LEN(OName(OpOn)), E - op - LEN(OName(OpOn)) + 1) 'Get our second number
IF MID$(num(1), 1, 1) = "N" THEN MID$(num(1), 1) = "-"
IF MID$(num(2), 1, 1) = "N" THEN MID$(num(2), 1) = "-"
num(3) = EvaluateNumbers(OpOn, num())
IF MID$(num(3), 1, 1) = "-" THEN MID$(num(3), 1) = "N"
'PRINT "*************"
'PRINT num(1), OName(OpOn), num(2), num(3), exp$
IF LEFT$(num(3), 5) = "ERROR" THEN exp$ = num(3): EXIT SUB
exp$ = LTRIM$(N2S(DWD(LEFT$(exp$, s) + RTRIM$(LTRIM$(num(3))) + MID$(exp$, E + 1))))
'PRINT exp$
END IF
op = 0
LOOP
NEXT
END SUB
SUB Set_OrderOfOperations
'PL sets our priortity level. 1 is highest to 65535 for the lowest.
'I used a range here so I could add in new priority levels as needed.
'OName ended up becoming the name of our commands, as I modified things.... Go figure! LOL!
'Constants get evaluated first, with a Priority Level of 1
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_PI"
REDIM _PRESERVE PL(i): PL(i) = 1
'I'm not certain where exactly percentages should go. They kind of seem like a special case to me. COS10% should be COS.1 I'd think...
'I'm putting it here for now, and if anyone knows someplace better for it in our order of operations, let me know.
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "%"
REDIM _PRESERVE PL(i): PL(i) = 5
'Then Functions with PL 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_ACOS"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_ASIN"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_ARCSEC"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_ARCCSC"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_ARCCOT"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_SECH"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_CSCH"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_COTH"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "COS"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "SIN"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "TAN"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "LOG"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "EXP"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "ATN"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_D2R"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_D2G"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_R2D"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_R2G"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_G2D"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_G2R"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "ABS"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "SGN"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "INT"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_ROUND"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "FIX"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_SEC"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_CSC"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_COT"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "ASC"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "CHR$"
REDIM _PRESERVE PL(i): PL(i) = 10
'Exponents with PL 20
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "^"
REDIM _PRESERVE PL(i): PL(i) = 20
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "SQR"
REDIM _PRESERVE PL(i): PL(i) = 20
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "ROOT"
REDIM _PRESERVE PL(i): PL(i) = 20
'Multiplication and Division PL 30
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "*"
REDIM _PRESERVE PL(i): PL(i) = 30
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "/"
REDIM _PRESERVE PL(i): PL(i) = 30
'Integer Division PL 40
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "\"
REDIM _PRESERVE PL(i): PL(i) = 40
'MOD PL 50
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "MOD"
REDIM _PRESERVE PL(i): PL(i) = 50
'Addition and Subtraction PL 60
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "+"
REDIM _PRESERVE PL(i): PL(i) = 60
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "-"
REDIM _PRESERVE PL(i): PL(i) = 60
'Relational Operators =, >, <, <>, <=, >= PL 70
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "<>"
REDIM _PRESERVE PL(i): PL(i) = 70
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "><" 'These next three are just reversed symbols as an attempt to help process a common typo
REDIM _PRESERVE PL(i): PL(i) = 70
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "<="
REDIM _PRESERVE PL(i): PL(i) = 70
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = ">="
REDIM _PRESERVE PL(i): PL(i) = 70
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "=<" 'I personally can never keep these things straight. Is it < = or = <...
REDIM _PRESERVE PL(i): PL(i) = 70
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "=>" 'Who knows, check both!
REDIM _PRESERVE PL(i): PL(i) = 70
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = ">"
REDIM _PRESERVE PL(i): PL(i) = 70
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "<"
REDIM _PRESERVE PL(i): PL(i) = 70
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "="
REDIM _PRESERVE PL(i): PL(i) = 70
'Logical Operations PL 80+
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "NOT"
REDIM _PRESERVE PL(i): PL(i) = 80
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "AND"
REDIM _PRESERVE PL(i): PL(i) = 90
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "OR"
REDIM _PRESERVE PL(i): PL(i) = 100
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "XOR"
REDIM _PRESERVE PL(i): PL(i) = 110
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "EQV"
REDIM _PRESERVE PL(i): PL(i) = 120
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "IMP"
REDIM _PRESERVE PL(i): PL(i) = 130
END SUB
FUNCTION EvaluateNumbers$ (p, num() AS STRING)
DIM n1 AS _FLOAT, n2 AS _FLOAT, n3 AS _FLOAT
SELECT CASE OName(p) 'Depending on our operator..
CASE "_PI": n1 = 3.14159265358979323846264338327950288## 'Future compatable in case something ever stores extra digits for PI
CASE "%": n1 = (VAL(num(1))) / 100 'Note percent is a special case and works with the number BEFORE the % command and not after
CASE "_ACOS": n1 = _ACOS(VAL(num(2)))
CASE "_ASIN": n1 = _ASIN(VAL(num(2)))
CASE "_ARCSEC": n1 = _ARCSEC(VAL(num(2)))
CASE "_ARCCSC": n1 = _ARCCSC(VAL(num(2)))
CASE "_ARCCOT": n1 = _ARCCOT(VAL(num(2)))
CASE "_SECH": n1 = _SECH(VAL(num(2)))
CASE "_CSCH": n1 = _CSCH(VAL(num(2)))
CASE "_COTH": n1 = _COTH(VAL(num(2)))
CASE "COS": n1 = COS(VAL(num(2)))
CASE "SIN": n1 = SIN(VAL(num(2)))
CASE "TAN": n1 = TAN(VAL(num(2)))
CASE "LOG": n1 = LOG(VAL(num(2)))
CASE "EXP": n1 = EXP(VAL(num(2)))
CASE "ATN": n1 = ATN(VAL(num(2)))
CASE "_D2R": n1 = 0.0174532925 * (VAL(num(2)))
CASE "_D2G": n1 = 1.1111111111 * (VAL(num(2)))
CASE "_R2D": n1 = 57.2957795 * (VAL(num(2)))
CASE "_R2G": n1 = 0.015707963 * (VAL(num(2)))
CASE "_G2D": n1 = 0.9 * (VAL(num(2)))
CASE "_G2R": n1 = 63.661977237 * (VAL(num(2)))
CASE "ABS": n1 = ABS(VAL(num(2)))
CASE "SGN": n1 = SGN(VAL(num(2)))
CASE "INT": n1 = INT(VAL(num(2)))
CASE "_ROUND": n1 = _ROUND(VAL(num(2)))
CASE "FIX": n1 = FIX(VAL(num(2)))
CASE "_SEC": n1 = _SEC(VAL(num(2)))
CASE "_CSC": n1 = _CSC(VAL(num(2)))
CASE "_COT": n1 = _COT(VAL(num(2)))
CASE "^": n1 = VAL(num(1)) ^ VAL(num(2))
CASE "SQR": n1 = SQR(VAL(num(2)))
CASE "ROOT"
n1 = VAL(num(1)): n2 = VAL(num(2))
IF n2 = 1 THEN EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1))): EXIT FUNCTION
IF n1 < 0 AND n2 >= 1 THEN sign = -1: n1 = -n1 ELSE sign = 1
n3 = 1## / n2
IF n3 <> INT(n3) AND n2 < 1 THEN sign = SGN(n1): n1 = ABS(n1)
n1 = sign * (n1 ^ n3)
CASE "*": n1 = VAL(num(1)) * VAL(num(2))
CASE "/": n1 = VAL(num(1)) / VAL(num(2))
CASE "\"
IF VAL(num(2)) <> 0 THEN
n1 = VAL(num(1)) \ VAL(num(2))
ELSE
EvaluateNumbers$ = "ERROR - Bad operation (We shouldn't see this)"
EXIT FUNCTION
END IF
CASE "MOD": n1 = VAL(num(1)) MOD VAL(num(2))
CASE "+": n1 = VAL(num(1)) + VAL(num(2))
CASE "-": n1 = VAL(num(1)) - VAL(num(2))
CASE "=": n1 = VAL(num(1)) = VAL(num(2))
CASE ">": n1 = VAL(num(1)) > VAL(num(2))
CASE "<": n1 = VAL(num(1)) < VAL(num(2))
CASE "<>", "><": n1 = VAL(num(1)) <> VAL(num(2))
CASE "<=", "=<": n1 = VAL(num(1)) <= VAL(num(2))
CASE ">=", "=>": n1 = VAL(num(1)) >= VAL(num(2))
CASE "NOT": n1 = NOT VAL(num(2))
CASE "AND": n1 = VAL(num(1)) AND VAL(num(2))
CASE "OR": n1 = VAL(num(1)) OR VAL(num(2))
CASE "XOR": n1 = VAL(num(1)) XOR VAL(num(2))
CASE "EQV": n1 = VAL(num(1)) EQV VAL(num(2))
CASE "IMP": n1 = VAL(num(1)) IMP VAL(num(2))
CASE ELSE
EvaluateNumbers$ = "ERROR - Bad operation (We shouldn't see this)" 'Let's say we're bad...
END SELECT
EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1)))
END FUNCTION
FUNCTION DWD$ (exp$) 'Deal With Duplicates
'To deal with duplicate operators in our code.
'Such as -- becomes a +
'++ becomes a +
'+- becomes a -
'-+ becomes a -
t$ = exp$
DO
bad = 0
DO
l = INSTR(t$, "++")
IF l THEN t$ = LEFT$(t$, l - 1) + "+" + MID$(t$, l + 2): bad = -1
LOOP UNTIL l = 0
DO
l = INSTR(t$, "+-")
IF l THEN t$ = LEFT$(t$, l - 1) + "-" + MID$(t$, l + 2): bad = -1
LOOP UNTIL l = 0
DO
l = INSTR(t$, "-+")
IF l THEN t$ = LEFT$(t$, l - 1) + "-" + MID$(t$, l + 2): bad = -1
LOOP UNTIL l = 0
DO
l = INSTR(t$, "--")
IF l THEN t$ = LEFT$(t$, l - 1) + "+" + MID$(t$, l + 2): bad = -1
LOOP UNTIL l = 0
LOOP UNTIL NOT bad
DWD$ = t$
VerifyString t$
END FUNCTION
SUB PreParse (e$)
DIM f AS _FLOAT
t$ = e$
'First strip all spaces
t$ = ""
FOR i = 1 TO LEN(e$)
IF MID$(e$, i, 1) <> " " THEN t$ = t$ + MID$(e$, i, 1)
NEXT
t$ = UCASE$(t$)
IF t$ = "" THEN e$ = "ERROR -- NULL string; nothing to evaluate": EXIT SUB
'ERROR CHECK by counting our brackets
l = 0
DO
l = INSTR(l + 1, t$, "("): IF l THEN c = c + 1
LOOP UNTIL l = 0
l = 0
DO
l = INSTR(l + 1, t$, ")"): IF l THEN c1 = c1 + 1
LOOP UNTIL l = 0
IF c <> c1 THEN e$ = "ERROR -- Bad Parenthesis:" + STR$(c) + "( vs" + STR$(c1) + ")": EXIT SUB
'Modify so that NOT will process properly
l = 0
DO
l = INSTR(l + 1, t$, "NOT")
IF l THEN
'We need to work magic on the statement so it looks pretty.
' 1 + NOT 2 + 1 is actually processed as 1 + (NOT 2 + 1)
'Look for something not proper
l1 = INSTR(l + 1, t$, "AND")
IF l1 = 0 OR (INSTR(l + 1, t$, "OR") > 0 AND INSTR(l + 1, t$, "OR") < l1) THEN l1 = INSTR(l + 1, t$, "OR")
IF l1 = 0 OR (INSTR(l + 1, t$, "XOR") > 0 AND INSTR(l + 1, t$, "XOR") < l1) THEN l1 = INSTR(l + 1, t$, "XOR")
IF l1 = 0 OR (INSTR(l + 1, t$, "EQV") > 0 AND INSTR(l + 1, t$, "EQV") < l1) THEN l1 = INSTR(l + 1, t$, "EQV")
IF l1 = 0 OR (INSTR(l + 1, t$, "IMP") > 0 AND INSTR(l + 1, t$, "IMP") < l1) THEN l1 = INSTR(l + 1, t$, "IMP")
IF l1 = 0 THEN l1 = LEN(t$) + 1
t$ = LEFT$(t$, l - 1) + "(" + MID$(t$, l, l1 - l) + ")" + MID$(t$, l + l1 - l)
l = l + 3
'PRINT t$
END IF
LOOP UNTIL l = 0
'Check for bad operators before a ( bracket
l = 0
DO
l = INSTR(l + 1, t$, "(")
IF l AND l > 2 THEN 'Don't check the starting bracket; there's nothing before it.
good = 0
FOR i = 1 TO UBOUND(OName)
IF MID$(t$, l - LEN(OName(i)), LEN(OName(i))) = OName(i) AND PL(i) > 1 AND PL(i) <= 250 THEN good = -1: EXIT FOR 'We found an operator after our ), and it's not a CONST (like PI)
NEXT
IF NOT good THEN e$ = "ERROR - Improper operations before (.": EXIT SUB
l = l + 1
END IF
LOOP UNTIL l = 0
'Check for bad operators after a ) bracket
l = 0
DO
l = INSTR(l + 1, t$, ")")
IF l AND l < LEN(t$) THEN
good = 0
FOR i = 1 TO UBOUND(OName)
IF MID$(t$, l + 1, LEN(OName(i))) = OName(i) AND PL(i) > 1 AND PL(i) <= 250 THEN good = -1: EXIT FOR 'We found an operator after our ), and it's not a CONST (like PI)
NEXT
IF MID$(t$, l + 1, 1) = ")" THEN good = -1
IF NOT good THEN e$ = "ERROR - Improper operations after ).": EXIT SUB
l = l + 1
END IF
LOOP UNTIL l = 0 OR l = LEN(t$) 'last symbol is a bracket
'Turn all &H (hex) numbers into decimal values for the program to process properly
l = 0
DO
l = INSTR(t$, "&H")
IF l THEN
E = l + 1: finished = 0
DO
E = E + 1
comp$ = MID$(t$, E, 1)
SELECT CASE comp$
CASE "0" TO "9", "A" TO "F" 'All is good, our next digit is a number, continue to add to the hex$
CASE ELSE
good = 0
FOR i = 1 TO UBOUND(OName)
IF MID$(t$, E, LEN(OName(i))) = OName(i) AND PL(i) > 1 AND PL(i) <= 250 THEN good = -1: EXIT FOR 'We found an operator after our ), and it's not a CONST (like PI)
NEXT
IF NOT good THEN e$ = "ERROR - Improper &H value. (" + comp$ + ")": EXIT SUB
E = E - 1
finished = -1
END SELECT
LOOP UNTIL finished OR E = LEN(t$)
t$ = LEFT$(t$, l - 1) + LTRIM$(RTRIM$(STR$(VAL(MID$(t$, l, E - l + 1))))) + MID$(t$, E + 1)
END IF
LOOP UNTIL l = 0
'Turn all &B (binary) numbers into decimal values for the program to process properly
l = 0
DO
l = INSTR(t$, "&B")
IF l THEN
E = l + 1: finished = 0
DO
E = E + 1
comp$ = MID$(t$, E, 1)
SELECT CASE comp$
CASE "0", "1" 'All is good, our next digit is a number, continue to add to the hex$
CASE ELSE
good = 0
FOR i = 1 TO UBOUND(OName)
IF MID$(t$, E, LEN(OName(i))) = OName(i) AND PL(i) > 1 AND PL(i) <= 250 THEN good = -1: EXIT FOR 'We found an operator after our ), and it's not a CONST (like PI)
NEXT
IF NOT good THEN e$ = "ERROR - Improper &B value. (" + comp$ + ")": EXIT SUB
E = E - 1
finished = -1
END SELECT
LOOP UNTIL finished OR E = LEN(t$)
bin$ = MID$(t$, l + 2, E - l - 1)
FOR i = 1 TO LEN(bin$)
IF MID$(bin$, i, 1) = "1" THEN f = f + 2 ^ (LEN(bin$) - i)
NEXT
t$ = LEFT$(t$, l - 1) + LTRIM$(RTRIM$(STR$(f))) + MID$(t$, E + 1)
END IF
LOOP UNTIL l = 0
t$ = N2S(t$)
VerifyString t$
e$ = t$
END SUB
SUB VerifyString (t$)
'ERROR CHECK for unrecognized operations
j = 1
DO
comp$ = MID$(t$, j, 1)
SELECT CASE comp$
CASE "0" TO "9", ".", "(", ")": j = j + 1
CASE ELSE
good = 0
FOR i = 1 TO UBOUND(OName)
IF MID$(t$, j, LEN(OName(i))) = OName(i) THEN good = -1: EXIT FOR 'We found an operator after our ), and it's not a CONST (like PI)
NEXT
IF NOT good THEN t$ = "ERROR - Bad Operational value. (" + comp$ + ")": EXIT SUB
j = j + LEN(OName(i))
END SELECT
LOOP UNTIL j > LEN(t$)
END SUB
FUNCTION N2S$ (exp$) 'scientific Notation to String
t$ = LTRIM$(RTRIM$(exp$))
IF LEFT$(t$, 1) = "-" THEN sign$ = "-": t$ = MID$(t$, 2)
dp = INSTR(t$, "D+"): dm = INSTR(t$, "D-")
ep = INSTR(t$, "E+"): em = INSTR(t$, "E-")
check1 = SGN(dp) + SGN(dm) + SGN(ep) + SGN(em)
IF check1 < 1 OR check1 > 1 THEN N2S = exp$: EXIT SUB 'If no scientic notation is found, or if we find more than 1 type, it's not SN!
SELECT CASE l 'l now tells us where the SN starts at.
CASE IS < dp: l = dp
CASE IS < dm: l = dm
CASE IS < ep: l = ep
CASE IS < em: l = em
END SELECT
l$ = LEFT$(t$, l - 1) 'The left of the SN
r$ = MID$(t$, l + 1): r&& = VAL(r$) 'The right of the SN, turned into a workable long
IF INSTR(l$, ".") THEN 'Location of the decimal, if any
IF r&& > 0 THEN
r&& = r&& - LEN(l$) + 2
ELSE
r&& = r&& + 1
END IF
l$ = LEFT$(l$, 1) + MID$(l$, 3)
END IF
SELECT CASE r&&
CASE 0 'what the heck? We solved it already?
'l$ = l$
CASE IS < 0
FOR i = 1 TO -r&&
l$ = "0" + l$
NEXT
l$ = "0." + l$
CASE ELSE
FOR i = 1 TO r&&
l$ = l$ + "0"
NEXT
END SELECT
N2S$ = sign$ + l$
END SUBIf you look inside QB64.bas, you'll see these routines, which are what the IDE uses to calculate math values for use with CONST and then substitute the finished product into your code.
When you type: CONST P = _PI(2), it's these routines which substitute 6.28 instead of _PI(2), so the code is processed as CONST P = 6.24....
Feel free to plug it in and use it for any of your needs. It's rather simple, just call Evaluate_Expression$ with your string formula for it to solve, like in the above: PRINT Evaluate_Expression(math$)
Post by: SMcNeill on January 05, 2020, 12:05:59 pm
Code: [Select]
REDIM SHARED OName(0) AS STRING 'Operation Name
REDIM SHARED PL(0) AS INTEGER 'Priority Level
DIM SHARED QuickReturn AS INTEGER
Set_OrderOfOperations
DO
i$ = INPUT$(1)
CLS
SELECT CASE i$
CASE CHR$(8)
eval$ = LEFT$(eval$, LEN(eval$) - 1)
CASE CHR$(13)
eval$ = ""
CASE CHR$(27)
SYSTEM
CASE ELSE
eval$ = eval$ + i$
END SELECT
PRINT eval$
PRINT Evaluate_Expression(eval$)
LOOP
'Steve Subs/Functins for _MATH support with CONST
FUNCTION Evaluate_Expression$ (e$)
t$ = e$ 'So we preserve our original data, we parse a temp copy of it
b = INSTR(UCASE$(e$), "EQL") 'take out assignment before the preparser sees it
IF b THEN t$ = MID$(e$, b + 3): var$ = UCASE$(LTRIM$(RTRIM$(MID$(e$, 1, b - 1))))
QuickReturn = 0
PreParse t$
IF QuickReturn THEN Evaluate_Expression$ = t$: EXIT FUNCTION
IF LEFT$(t$, 5) = "ERROR" THEN Evaluate_Expression$ = t$: EXIT FUNCTION
'Deal with brackets first
exp$ = "(" + t$ + ")" 'Starting and finishing brackets for our parse routine.
DO
Eval_E = INSTR(exp$, ")")
IF Eval_E > 0 THEN
c = 0
DO UNTIL Eval_E - c <= 0
c = c + 1
IF Eval_E THEN
IF MID$(exp$, Eval_E - c, 1) = "(" THEN EXIT DO
END IF
LOOP
s = Eval_E - c + 1
IF s < 1 THEN Evaluate_Expression$ = "ERROR -- BAD () Count": EXIT SUB
eval$ = " " + MID$(exp$, s, Eval_E - s) + " " 'pad with a space before and after so the parser can pick up the values properly.
ParseExpression eval$
eval$ = LTRIM$(RTRIM$(eval$))
IF LEFT$(eval$, 5) = "ERROR" THEN Evaluate_Expression$ = eval$: EXIT SUB
exp$ = DWD(LEFT$(exp$, s - 2) + eval$ + MID$(exp$, Eval_E + 1))
IF MID$(exp$, 1, 1) = "N" THEN MID$(exp$, 1) = "-"
temppp$ = DWD(LEFT$(exp$, s - 2) + " ## " + eval$ + " ## " + MID$(exp$, E + 1))
END IF
LOOP UNTIL Eval_E = 0
c = 0
DO
c = c + 1
SELECT CASE MID$(exp$, c, 1)
CASE "0" TO "9", ".", "-" 'At this point, we should only have number values left.
CASE ELSE: Evaluate_Expression$ = "ERROR - Unknown Diagnosis: (" + exp$ + ") ": EXIT SUB
END SELECT
LOOP UNTIL c >= LEN(exp$)
Evaluate_Expression$ = exp$
END FUNCTION
SUB ParseExpression (exp$)
DIM num(10) AS STRING
'PRINT exp$
'We should now have an expression with no () to deal with
IF MID$(exp$, 2, 1) = "-" THEN exp$ = "0+" + MID$(exp$, 2)
FOR J = 1 TO 250
lowest = 0
DO UNTIL lowest = LEN(exp$)
lowest = LEN(exp$): OpOn = 0
FOR P = 1 TO UBOUND(OName)
'Look for first valid operator
IF J = PL(P) THEN 'Priority levels match
IF LEFT$(exp$, 1) = "-" THEN op = INSTR(2, exp$, OName(P)) ELSE op = INSTR(exp$, OName(P))
IF op > 0 AND op < lowest THEN lowest = op: OpOn = P
END IF
NEXT
IF OpOn = 0 THEN EXIT DO 'We haven't gotten to the proper PL for this OP to be processed yet.
IF LEFT$(exp$, 1) = "-" THEN op = INSTR(2, exp$, OName(OpOn)) ELSE op = INSTR(exp$, OName(OpOn))
numset = 0
'*** SPECIAL OPERATION RULESETS
IF OName(OpOn) = "-" THEN 'check for BOOLEAN operators before the -
SELECT CASE MID$(exp$, op - 3, 3)
CASE "NOT", "XOR", "AND", "EQV", "IMP"
EXIT DO 'Not an operator, it's a negative
END SELECT
IF MID$(exp$, op - 3, 2) = "OR" THEN EXIT DO 'Not an operator, it's a negative
END IF
IF op THEN
c = LEN(OName(OpOn)) - 1
DO
SELECT CASE MID$(exp$, op + c + 1, 1)
CASE "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", ".", "N": numset = -1 'Valid digit
CASE "-" 'We need to check if it's a minus or a negative
IF OName(OpOn) = "_PI" OR numset THEN EXIT DO
CASE ",": numset = 0
CASE ELSE 'Not a valid digit, we found our separator
EXIT DO
END SELECT
c = c + 1
LOOP UNTIL op + c >= LEN(exp$)
E = op + c
c = 0
DO
c = c + 1
SELECT CASE MID$(exp$, op - c, 1)
CASE "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", ".", "N" 'Valid digit
CASE "-" 'We need to check if it's a minus or a negative
c1 = c
bad = 0
DO
c1 = c1 + 1
SELECT CASE MID$(exp$, op - c1, 1)
CASE "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "."
bad = -1
EXIT DO 'It's a minus sign
CASE ELSE
'It's a negative sign and needs to count as part of our numbers
END SELECT
LOOP UNTIL op - c1 <= 0
IF bad THEN EXIT DO 'We found our seperator
CASE ELSE 'Not a valid digit, we found our separator
EXIT DO
END SELECT
LOOP UNTIL op - c <= 0
s = op - c
num(1) = MID$(exp$, s + 1, op - s - 1) 'Get our first number
num(2) = MID$(exp$, op + LEN(OName(OpOn)), E - op - LEN(OName(OpOn)) + 1) 'Get our second number
IF MID$(num(1), 1, 1) = "N" THEN MID$(num(1), 1) = "-"
IF MID$(num(2), 1, 1) = "N" THEN MID$(num(2), 1) = "-"
num(3) = EvaluateNumbers(OpOn, num())
IF MID$(num(3), 1, 1) = "-" THEN MID$(num(3), 1) = "N"
'PRINT "*************"
'PRINT num(1), OName(OpOn), num(2), num(3), exp$
IF LEFT$(num(3), 5) = "ERROR" THEN exp$ = num(3): EXIT SUB
exp$ = LTRIM$(N2S(DWD(LEFT$(exp$, s) + RTRIM$(LTRIM$(num(3))) + MID$(exp$, E + 1))))
'PRINT exp$
END IF
op = 0
LOOP
NEXT
END SUB
SUB Set_OrderOfOperations
'PL sets our priortity level. 1 is highest to 65535 for the lowest.
'I used a range here so I could add in new priority levels as needed.
'OName ended up becoming the name of our commands, as I modified things.... Go figure! LOL!
'Constants get evaluated first, with a Priority Level of 1
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_PI"
REDIM _PRESERVE PL(i): PL(i) = 1
'I'm not certain where exactly percentages should go. They kind of seem like a special case to me. COS10% should be COS.1 I'd think...
'I'm putting it here for now, and if anyone knows someplace better for it in our order of operations, let me know.
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "%"
REDIM _PRESERVE PL(i): PL(i) = 5
'Then Functions with PL 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_ACOS"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_ASIN"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_ARCSEC"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_ARCCSC"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_ARCCOT"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_SECH"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_CSCH"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_COTH"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "COS"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "SIN"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "TAN"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "LOG"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "EXP"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "ATN"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_D2R"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_D2G"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_R2D"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_R2G"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_G2D"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_G2R"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "ABS"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "SGN"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "INT"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_ROUND"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "FIX"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_SEC"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_CSC"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_COT"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "ASC"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "CHR$"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_RGB32"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_RGBA32"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_RGB"
REDIM _PRESERVE PL(i): PL(i) = 10
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_RGBA"
REDIM _PRESERVE PL(i): PL(i) = 10
'Exponents with PL 20
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "^"
REDIM _PRESERVE PL(i): PL(i) = 20
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "SQR"
REDIM _PRESERVE PL(i): PL(i) = 20
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "ROOT"
REDIM _PRESERVE PL(i): PL(i) = 20
'Multiplication and Division PL 30
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "*"
REDIM _PRESERVE PL(i): PL(i) = 30
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "/"
REDIM _PRESERVE PL(i): PL(i) = 30
'Integer Division PL 40
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "\"
REDIM _PRESERVE PL(i): PL(i) = 40
'MOD PL 50
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "MOD"
REDIM _PRESERVE PL(i): PL(i) = 50
'Addition and Subtraction PL 60
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "+"
REDIM _PRESERVE PL(i): PL(i) = 60
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "-"
REDIM _PRESERVE PL(i): PL(i) = 60
'Relational Operators =, >, <, <>, <=, >= PL 70
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "<>"
REDIM _PRESERVE PL(i): PL(i) = 70
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "><" 'These next three are just reversed symbols as an attempt to help process a common typo
REDIM _PRESERVE PL(i): PL(i) = 70
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "<="
REDIM _PRESERVE PL(i): PL(i) = 70
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = ">="
REDIM _PRESERVE PL(i): PL(i) = 70
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "=<" 'I personally can never keep these things straight. Is it < = or = <...
REDIM _PRESERVE PL(i): PL(i) = 70
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "=>" 'Who knows, check both!
REDIM _PRESERVE PL(i): PL(i) = 70
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = ">"
REDIM _PRESERVE PL(i): PL(i) = 70
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "<"
REDIM _PRESERVE PL(i): PL(i) = 70
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "="
REDIM _PRESERVE PL(i): PL(i) = 70
'Logical Operations PL 80+
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "NOT"
REDIM _PRESERVE PL(i): PL(i) = 80
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "AND"
REDIM _PRESERVE PL(i): PL(i) = 90
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "OR"
REDIM _PRESERVE PL(i): PL(i) = 100
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "XOR"
REDIM _PRESERVE PL(i): PL(i) = 110
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "EQV"
REDIM _PRESERVE PL(i): PL(i) = 120
i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "IMP"
REDIM _PRESERVE PL(i): PL(i) = 130
END SUB
FUNCTION EvaluateNumbers$ (p, num() AS STRING)
DIM n1 AS _FLOAT, n2 AS _FLOAT, n3 AS _FLOAT
IF INSTR(num(1), ",") THEN EvaluateNumbers$ = "ERROR - Invalid comma (" + num(1) + ")": EXIT FUNCTION
IF INSTR(num(2), ",") THEN
SELECT CASE OName(p) 'only certain commands should pass a comma value
CASE "_RGB32", "_RGBA32", "_RGB", "_RGBA"
CASE ELSE
EvaluateNumbers$ = "ERROR - Invalid comma (" + num(2) + ")": EXIT FUNCTION
END SELECT
END IF
SELECT CASE OName(p) 'Depending on our operator..
CASE "_PI": n1 = 3.14159265358979323846264338327950288## 'Future compatable in case something ever stores extra digits for PI
CASE "%": n1 = (VAL(num(1))) / 100 'Note percent is a special case and works with the number BEFORE the % command and not after
CASE "_ACOS": n1 = _ACOS(VAL(num(2)))
CASE "_ASIN": n1 = _ASIN(VAL(num(2)))
CASE "_ARCSEC": n1 = _ARCSEC(VAL(num(2)))
CASE "_ARCCSC": n1 = _ARCCSC(VAL(num(2)))
CASE "_ARCCOT": n1 = _ARCCOT(VAL(num(2)))
CASE "_SECH": n1 = _SECH(VAL(num(2)))
CASE "_CSCH": n1 = _CSCH(VAL(num(2)))
CASE "_COTH": n1 = _COTH(VAL(num(2)))
CASE "_RGB32"
n$ = num(2)
IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null _RGB32": EXIT FUNCTION
c1 = INSTR(n$, ",")
IF c1 THEN c2 = INSTR(c1 + 1, n$, ",")
IF c2 THEN c3 = INSTR(c2 + 1, n$, ",")
IF c3 THEN c4 = INSTR(c2 + 1, n$, ",")
IF c1 = 0 THEN 'there's no comma in the command to parse. It's a grayscale value
n = VAL(num(2))
n1 = _RGB32(n, n, n)
ELSEIF c2 = 0 THEN 'there's one comma and not 2. It's grayscale with alpha.
n = VAL(LEFT$(num(2), c1))
n2 = VAL(MID$(num(2), c1 + 1))
n1 = _RGBA32(n, n, n, n2)
ELSEIF c3 = 0 THEN 'there's two commas. It's _RGB values
n = VAL(LEFT$(num(2), c1))
n2 = VAL(MID$(num(2), c1 + 1))
n3 = VAL(MID$(num(2), c2 + 1))
n1 = _RGB32(n, n2, n3)
ELSEIF c4 = 0 THEN 'there's three commas. It's _RGBA values
n = VAL(LEFT$(num(2), c1))
n2 = VAL(MID$(num(2), c1 + 1))
n3 = VAL(MID$(num(2), c2 + 1))
n4 = VAL(MID$(num(2), c3 + 1))
n1 = _RGBA32(n, n2, n3, n4)
ELSE 'we have more than three commas. I have no idea WTH type of values got passed here!
EvaluateNumbers$ = "ERROR - Invalid comma count (" + num(2) + ")": EXIT FUNCTION
END IF
CASE "_RGBA32"
n$ = num(2)
IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null _RGBA32": EXIT FUNCTION
c1 = INSTR(n$, ",")
IF c1 THEN c2 = INSTR(c1 + 1, n$, ",")
IF c2 THEN c3 = INSTR(c2 + 1, n$, ",")
IF c3 THEN c4 = INSTR(c3 + 1, n$, ",")
IF c3 = 0 OR c4 <> 0 THEN EvaluateNumbers$ = "ERROR - Invalid comma count (" + num(2) + ")": EXIT FUNCTION
'we have to have 3 commas; not more, not less.
n = VAL(LEFT$(num(2), c1))
n2 = VAL(MID$(num(2), c1 + 1))
n3 = VAL(MID$(num(2), c2 + 1))
n4 = VAL(MID$(num(2), c3 + 1))
n1 = _RGBA32(n, n2, n3, n4)
CASE "_RGB"
n$ = num(2)
IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null _RGB": EXIT FUNCTION
c1 = INSTR(n$, ",")
IF c1 THEN c2 = INSTR(c1 + 1, n$, ",")
IF c2 THEN c3 = INSTR(c2 + 1, n$, ",")
IF c3 THEN c4 = INSTR(c3 + 1, n$, ",")
IF c3 = 0 OR c4 <> 0 THEN EvaluateNumbers$ = "ERROR - Invalid comma count (" + num(2) + "). _RGB requires 4 parameters for Red, Green, Blue, ScreenMode.": EXIT FUNCTION
'we have to have 3 commas; not more, not less.
n = VAL(LEFT$(num(2), c1))
n2 = VAL(MID$(num(2), c1 + 1))
n3 = VAL(MID$(num(2), c2 + 1))
n4 = VAL(MID$(num(2), c3 + 1))
SELECT CASE n4
CASE 0 TO 2, 7 TO 13, 256, 32 'these are the good screen values
CASE ELSE
EvaluateNumbers$ = "ERROR - Invalid Screen Mode (" + STR$(n4) + ")": EXIT FUNCTION
END SELECT
t = _NEWIMAGE(1, 1, n4)
n1 = _RGB(n, n2, n3, t)
_FREEIMAGE t
CASE "_RGBA"
n$ = num(2)
IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null _RGBA": EXIT FUNCTION
c1 = INSTR(n$, ",")
IF c1 THEN c2 = INSTR(c1 + 1, n$, ",")
IF c2 THEN c3 = INSTR(c2 + 1, n$, ",")
IF c3 THEN c4 = INSTR(c3 + 1, n$, ",")
IF c4 THEN c5 = INSTR(c4 + 1, n$, ",")
IF c4 = 0 OR c5 <> 0 THEN EvaluateNumbers$ = "ERROR - Invalid comma count (" + num(2) + "). _RGBA requires 5 parameters for Red, Green, Blue, Alpha, ScreenMode.": EXIT FUNCTION
'we have to have 4 commas; not more, not less.
n = VAL(LEFT$(num(2), c1))
n2 = VAL(MID$(num(2), c1 + 1))
n3 = VAL(MID$(num(2), c2 + 1))
n4 = VAL(MID$(num(2), c3 + 1))
n5 = VAL(MID$(num(2), c4 + 1))
SELECT CASE n5
CASE 0 TO 2, 7 TO 13, 256, 32 'these are the good screen values
CASE ELSE
EvaluateNumbers$ = "ERROR - Invalid Screen Mode (" + STR$(n5) + ")": EXIT FUNCTION
END SELECT
t = _NEWIMAGE(1, 1, n5)
n1 = _RGBA(n, n2, n3, n4, t)
_FREEIMAGE t
CASE "COS": n1 = COS(VAL(num(2)))
CASE "SIN": n1 = SIN(VAL(num(2)))
CASE "TAN": n1 = TAN(VAL(num(2)))
CASE "LOG": n1 = LOG(VAL(num(2)))
CASE "EXP": n1 = EXP(VAL(num(2)))
CASE "ATN": n1 = ATN(VAL(num(2)))
CASE "_D2R": n1 = 0.0174532925 * (VAL(num(2)))
CASE "_D2G": n1 = 1.1111111111 * (VAL(num(2)))
CASE "_R2D": n1 = 57.2957795 * (VAL(num(2)))
CASE "_R2G": n1 = 0.015707963 * (VAL(num(2)))
CASE "_G2D": n1 = 0.9 * (VAL(num(2)))
CASE "_G2R": n1 = 63.661977237 * (VAL(num(2)))
CASE "ABS": n1 = ABS(VAL(num(2)))
CASE "SGN": n1 = SGN(VAL(num(2)))
CASE "INT": n1 = INT(VAL(num(2)))
CASE "_ROUND": n1 = _ROUND(VAL(num(2)))
CASE "FIX": n1 = FIX(VAL(num(2)))
CASE "_SEC": n1 = _SEC(VAL(num(2)))
CASE "_CSC": n1 = _CSC(VAL(num(2)))
CASE "_COT": n1 = _COT(VAL(num(2)))
CASE "^": n1 = VAL(num(1)) ^ VAL(num(2))
CASE "SQR": n1 = SQR(VAL(num(2)))
CASE "ROOT"
n1 = VAL(num(1)): n2 = VAL(num(2))
IF n2 = 1 THEN EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1))): EXIT FUNCTION
IF n1 < 0 AND n2 >= 1 THEN sign = -1: n1 = -n1 ELSE sign = 1
n3 = 1## / n2
IF n3 <> INT(n3) AND n2 < 1 THEN sign = SGN(n1): n1 = ABS(n1)
n1 = sign * (n1 ^ n3)
CASE "*": n1 = VAL(num(1)) * VAL(num(2))
CASE "/": n1 = VAL(num(1)) / VAL(num(2))
CASE "\"
IF VAL(num(2)) <> 0 THEN
n1 = VAL(num(1)) \ VAL(num(2))
ELSE
EvaluateNumbers$ = "ERROR - Bad operation (We shouldn't see this)"
EXIT FUNCTION
END IF
CASE "MOD": n1 = VAL(num(1)) MOD VAL(num(2))
CASE "+": n1 = VAL(num(1)) + VAL(num(2))
CASE "-": n1 = VAL(num(1)) - VAL(num(2))
CASE "=": n1 = VAL(num(1)) = VAL(num(2))
CASE ">": n1 = VAL(num(1)) > VAL(num(2))
CASE "<": n1 = VAL(num(1)) < VAL(num(2))
CASE "<>", "><": n1 = VAL(num(1)) <> VAL(num(2))
CASE "<=", "=<": n1 = VAL(num(1)) <= VAL(num(2))
CASE ">=", "=>": n1 = VAL(num(1)) >= VAL(num(2))
CASE "NOT": n1 = NOT VAL(num(2))
CASE "AND": n1 = VAL(num(1)) AND VAL(num(2))
CASE "OR": n1 = VAL(num(1)) OR VAL(num(2))
CASE "XOR": n1 = VAL(num(1)) XOR VAL(num(2))
CASE "EQV": n1 = VAL(num(1)) EQV VAL(num(2))
CASE "IMP": n1 = VAL(num(1)) IMP VAL(num(2))
CASE ELSE
EvaluateNumbers$ = "ERROR - Bad operation (We shouldn't see this)" 'Let's say we're bad...
END SELECT
EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1)))
END FUNCTION
FUNCTION DWD$ (exp$) 'Deal With Duplicates
'To deal with duplicate operators in our code.
'Such as -- becomes a +
'++ becomes a +
'+- becomes a -
'-+ becomes a -
t$ = exp$
DO
bad = 0
DO
l = INSTR(t$, "++")
IF l THEN t$ = LEFT$(t$, l - 1) + "+" + MID$(t$, l + 2): bad = -1
LOOP UNTIL l = 0
DO
l = INSTR(t$, "+-")
IF l THEN t$ = LEFT$(t$, l - 1) + "-" + MID$(t$, l + 2): bad = -1
LOOP UNTIL l = 0
DO
l = INSTR(t$, "-+")
IF l THEN t$ = LEFT$(t$, l - 1) + "-" + MID$(t$, l + 2): bad = -1
LOOP UNTIL l = 0
DO
l = INSTR(t$, "--")
IF l THEN t$ = LEFT$(t$, l - 1) + "+" + MID$(t$, l + 2): bad = -1
LOOP UNTIL l = 0
LOOP UNTIL NOT bad
DWD$ = t$
VerifyString t$
END FUNCTION
SUB PreParse (e$)
DIM f AS _FLOAT
t$ = e$
'First strip all spaces
t$ = ""
FOR i = 1 TO LEN(e$)
IF MID$(e$, i, 1) <> " " THEN t$ = t$ + MID$(e$, i, 1)
NEXT
t$ = UCASE$(t$)
IF t$ = "" THEN e$ = "ERROR -- NULL string; nothing to evaluate": EXIT SUB
'ERROR CHECK by counting our brackets
l = 0
DO
l = INSTR(l + 1, t$, "("): IF l THEN c = c + 1
LOOP UNTIL l = 0
l = 0
DO
l = INSTR(l + 1, t$, ")"): IF l THEN c1 = c1 + 1
LOOP UNTIL l = 0
IF c <> c1 THEN e$ = "ERROR -- Bad Parenthesis:" + STR$(c) + "( vs" + STR$(c1) + ")": EXIT SUB
'Modify so that NOT will process properly
l = 0
DO
l = INSTR(l + 1, t$, "NOT")
IF l THEN
'We need to work magic on the statement so it looks pretty.
' 1 + NOT 2 + 1 is actually processed as 1 + (NOT 2 + 1)
'Look for something not proper
l1 = INSTR(l + 1, t$, "AND")
IF l1 = 0 OR (INSTR(l + 1, t$, "OR") > 0 AND INSTR(l + 1, t$, "OR") < l1) THEN l1 = INSTR(l + 1, t$, "OR")
IF l1 = 0 OR (INSTR(l + 1, t$, "XOR") > 0 AND INSTR(l + 1, t$, "XOR") < l1) THEN l1 = INSTR(l + 1, t$, "XOR")
IF l1 = 0 OR (INSTR(l + 1, t$, "EQV") > 0 AND INSTR(l + 1, t$, "EQV") < l1) THEN l1 = INSTR(l + 1, t$, "EQV")
IF l1 = 0 OR (INSTR(l + 1, t$, "IMP") > 0 AND INSTR(l + 1, t$, "IMP") < l1) THEN l1 = INSTR(l + 1, t$, "IMP")
IF l1 = 0 THEN l1 = LEN(t$) + 1
t$ = LEFT$(t$, l - 1) + "(" + MID$(t$, l, l1 - l) + ")" + MID$(t$, l + l1 - l)
l = l + 3
'PRINT t$
END IF
LOOP UNTIL l = 0
'Check for bad operators before a ( bracket
l = 0
DO
l = INSTR(l + 1, t$, "(")
IF l AND l > 2 THEN 'Don't check the starting bracket; there's nothing before it.
good = 0
FOR i = 1 TO UBOUND(OName)
IF MID$(t$, l - LEN(OName(i)), LEN(OName(i))) = OName(i) AND PL(i) > 1 AND PL(i) <= 250 THEN good = -1: EXIT FOR 'We found an operator after our ), and it's not a CONST (like PI)
NEXT
IF NOT good THEN e$ = "ERROR - Improper operations before (.": EXIT SUB
l = l + 1
END IF
LOOP UNTIL l = 0
'Check for bad operators after a ) bracket
l = 0
DO
l = INSTR(l + 1, t$, ")")
IF l AND l < LEN(t$) THEN
good = 0
FOR i = 1 TO UBOUND(OName)
IF MID$(t$, l + 1, LEN(OName(i))) = OName(i) AND PL(i) > 1 AND PL(i) <= 250 THEN good = -1: EXIT FOR 'We found an operator after our ), and it's not a CONST (like PI)
NEXT
IF MID$(t$, l + 1, 1) = ")" THEN good = -1
IF NOT good THEN e$ = "ERROR - Improper operations after ).": EXIT SUB
l = l + 1
END IF
LOOP UNTIL l = 0 OR l = LEN(t$) 'last symbol is a bracket
'Turn all &H (hex) numbers into decimal values for the program to process properly
l = 0
DO
l = INSTR(t$, "&H")
IF l THEN
E = l + 1: finished = 0
DO
E = E + 1
comp$ = MID$(t$, E, 1)
SELECT CASE comp$
CASE "0" TO "9", "A" TO "F" 'All is good, our next digit is a number, continue to add to the hex$
CASE ELSE
good = 0
FOR i = 1 TO UBOUND(OName)
IF MID$(t$, E, LEN(OName(i))) = OName(i) AND PL(i) > 1 AND PL(i) <= 250 THEN good = -1: EXIT FOR 'We found an operator after our ), and it's not a CONST (like PI)
NEXT
IF NOT good THEN e$ = "ERROR - Improper &H value. (" + comp$ + ")": EXIT SUB
E = E - 1
finished = -1
END SELECT
LOOP UNTIL finished OR E = LEN(t$)
t$ = LEFT$(t$, l - 1) + LTRIM$(RTRIM$(STR$(VAL(MID$(t$, l, E - l + 1))))) + MID$(t$, E + 1)
END IF
LOOP UNTIL l = 0
'Turn all &B (binary) numbers into decimal values for the program to process properly
l = 0
DO
l = INSTR(t$, "&B")
IF l THEN
E = l + 1: finished = 0
DO
E = E + 1
comp$ = MID$(t$, E, 1)
SELECT CASE comp$
CASE "0", "1" 'All is good, our next digit is a number, continue to add to the hex$
CASE ELSE
good = 0
FOR i = 1 TO UBOUND(OName)
IF MID$(t$, E, LEN(OName(i))) = OName(i) AND PL(i) > 1 AND PL(i) <= 250 THEN good = -1: EXIT FOR 'We found an operator after our ), and it's not a CONST (like PI)
NEXT
IF NOT good THEN e$ = "ERROR - Improper &B value. (" + comp$ + ")": EXIT SUB
E = E - 1
finished = -1
END SELECT
LOOP UNTIL finished OR E = LEN(t$)
bin$ = MID$(t$, l + 2, E - l - 1)
FOR i = 1 TO LEN(bin$)
IF MID$(bin$, i, 1) = "1" THEN f = f + 2 ^ (LEN(bin$) - i)
NEXT
t$ = LEFT$(t$, l - 1) + LTRIM$(RTRIM$(STR$(f))) + MID$(t$, E + 1)
END IF
LOOP UNTIL l = 0
t$ = N2S(t$)
VerifyString t$
e$ = t$
END SUB
SUB VerifyString (t$)
'ERROR CHECK for unrecognized operations
j = 1
DO
comp$ = MID$(t$, j, 1)
SELECT CASE comp$
CASE "0" TO "9", ".", "(", ")", ",": j = j + 1
CASE ELSE
good = 0
FOR i = 1 TO UBOUND(OName)
IF MID$(t$, j, LEN(OName(i))) = OName(i) THEN good = -1: EXIT FOR 'We found an operator after our ), and it's not a CONST (like PI)
NEXT
IF NOT good THEN t$ = "ERROR - Bad Operational value. (" + comp$ + ")": EXIT SUB
j = j + LEN(OName(i))
END SELECT
LOOP UNTIL j > LEN(t$)
END SUB
FUNCTION N2S$ (exp$) 'scientific Notation to String
t$ = LTRIM$(RTRIM$(exp$))
IF LEFT$(t$, 1) = "-" THEN sign$ = "-": t$ = MID$(t$, 2)
dp = INSTR(t$, "D+"): dm = INSTR(t$, "D-")
ep = INSTR(t$, "E+"): em = INSTR(t$, "E-")
check1 = SGN(dp) + SGN(dm) + SGN(ep) + SGN(em)
IF check1 < 1 OR check1 > 1 THEN N2S = exp$: EXIT SUB 'If no scientic notation is found, or if we find more than 1 type, it's not SN!
SELECT CASE l 'l now tells us where the SN starts at.
CASE IS < dp: l = dp
CASE IS < dm: l = dm
CASE IS < ep: l = ep
CASE IS < em: l = em
END SELECT
l$ = LEFT$(t$, l - 1) 'The left of the SN
r$ = MID$(t$, l + 1): r&& = VAL(r$) 'The right of the SN, turned into a workable long
IF INSTR(l$, ".") THEN 'Location of the decimal, if any
IF r&& > 0 THEN
r&& = r&& - LEN(l$) + 2
ELSE
r&& = r&& + 1
END IF
l$ = LEFT$(l$, 1) + MID$(l$, 3)
END IF
SELECT CASE r&&
CASE 0 'what the heck? We solved it already?
'l$ = l$
CASE IS < 0
FOR i = 1 TO -r&&
l$ = "0" + l$
NEXT
l$ = "0." + l$
CASE ELSE
FOR i = 1 TO r&&
l$ = l$ + "0"
NEXT
END SELECT
N2S$ = sign$ + l$
END SUB
For you guys who don't know, this routine is something which you probably already use a lot of the time without even realizing it -- it's the way CONST does our math calculations for us in QB64, when we type something like CONST x = 123 + 456 * 789 + COS(.1) + SIN(_D2R(45))
Recent releases of QB64 have had issues with CONST acting up with a few different things (in particular the color commands), and if you check the original post for this routine, you might be able to see why fairly easily: They weren't included in the basic math handler here, so they had to be processed manually via a different method.
The interaction of this substitution method and that substitution method, along with commas and multiple variables being on the same line... just got lost, muddled, and corrupted somewhere.
CONST Red = _RGB32(255,0,0) works as it should.
CONST Red = _RGB32(255,0,0), Yellow = _RGB32(0,255,0) <-- this gets corrupted between all the various substitution methods and goofs up for us.
So, as a simple way to streamline the process and clean up the CONST command so it won't be as hard to both expand and debug in the future, I've expanded the math evaluator.
In the past, we only worked with basic single values. SIN(x) for example, or "2 + 3". We could work with one operator (plus, minus, SIN, ect), and one value to the left of it, and one value to the right of it.
1 + 2 <-- this used the left 1, the right 2, and the operator +
SIN(.2) <-- this just used the right .2, and the operator SIN
Commands with multiple parameters didn't work, so we couldn't use them.
_RGB32(255,0,0) <--- the commas in here separate our three values, and would error out...
This overhaul of the math evaluator removes that restriction. We can now teach it to parse and process functions with multiple parameters, such as _RGB, _RGB32, and all.
In the long run, this will end up being something which I'll swap out to expand/replace our current math evaluation routine, but it could use some extra user testing to make certain nothing glitches out, locks up, or returns false values first.
So...
Kindly test it out. Toss it all sorts of values (particularly any related to the various _RGB, _RGB32, _RGBA, _RGBA32 commands, and any with stray commas anywhere you'd like), and see if it works as intended. This thing actually does a good bit of error checking for us, so you'll get a whole variety of error messages to help you diagnose what's wrong with your formula as you type it -- if any seem inappropriate, are worded in a confusing manner, or wrong, kindly report those back to me and I'll try and make them more concise to help debug the issue.
Test it, try to break it, and report back on your results, while I go ahead and assume it's working as intended and expand it to work with several more commands/values which it's currently missing like _RED, _GREEN, _BLUE, _RED32, _GREEN32, _BLUE32, _ALPHA....
Post by: FellippeHeitor on January 05, 2020, 03:21:17 pm
Line 335:
Code: Text: [Select]
- IF c3 THEN c4 = INSTR(c3 + 1, n$, ",") 'instead of IF c3 THEN c4 = INSTR(c2 + 1, n$, ",")
Post by: SMcNeill on January 05, 2020, 03:40:39 pm
Code: QB64: [Select]
- Set_OrderOfOperations
- eval$ = ""
- eval$ = eval$ + i$
- PRINT eval$
- 'Steve Subs/Functins for _MATH support with CONST
- t$ = e$ 'So we preserve our original data, we parse a temp copy of it
- QuickReturn = 0
- PreParse t$
- 'Deal with brackets first
- c = 0
- c = c + 1
- s = Eval_E - c + 1
- ParseExpression eval$
- c = 0
- c = c + 1
- Evaluate_Expression$ = exp$
- 'PRINT exp$
- 'We should now have an expression with no () to deal with
- lowest = 0
- 'Look for first valid operator
- numset = 0
- '*** SPECIAL OPERATION RULESETS
- c = c + 1
- E = op + c
- c = 0
- c = c + 1
- c1 = c
- bad = 0
- c1 = c1 + 1
- bad = -1
- 'It's a negative sign and needs to count as part of our numbers
- s = op - c
- num(3) = EvaluateNumbers(OpOn, num())
- 'PRINT "*************"
- 'PRINT num(1), OName(OpOn), num(2), num(3), exp$
- 'PRINT exp$
- op = 0
- SUB Set_OrderOfOperations
- 'PL sets our priortity level. 1 is highest to 65535 for the lowest.
- 'I used a range here so I could add in new priority levels as needed.
- 'OName ended up becoming the name of our commands, as I modified things.... Go figure! LOL!
- 'Constants get evaluated first, with a Priority Level of 1
- 'I'm not certain where exactly percentages should go. They kind of seem like a special case to me. COS10% should be COS.1 I'd think...
- 'I'm putting it here for now, and if anyone knows someplace better for it in our order of operations, let me know.
- 'Then Functions with PL 10
- 'Exponents with PL 20
- 'Multiplication and Division PL 30
- 'Integer Division PL 40
- 'MOD PL 50
- 'Addition and Subtraction PL 60
- 'Relational Operators =, >, <, <>, <=, >= PL 70
- 'Logical Operations PL 80+
- CASE "_RGB32"
- n$ = num(2)
- ELSE 'we have more than three commas. I have no idea WTH type of values got passed here!
- CASE "_RGBA32"
- n$ = num(2)
- 'we have to have 3 commas; not more, not less.
- CASE "_RGB"
- n$ = num(2)
- 'we have to have 3 commas; not more, not less.
- CASE "_RGBA"
- n$ = num(2)
- 'we have to have 4 commas; not more, not less.
- n$ = num(2)
- n$ = num(2)
- CASE "ROOT"
- n3 = 1## / n2
- n1 = sign * (n1 ^ n3)
- CASE "\"
- EvaluateNumbers$ = "ERROR - Bad operation (We shouldn't see this)"
- CASE "_PI": n1 = 3.14159265358979323846264338327950288## 'Future compatable in case something ever stores extra digits for PI
- 'To deal with duplicate operators in our code.
- 'Such as -- becomes a +
- '++ becomes a +
- '+- becomes a -
- '-+ becomes a -
- t$ = exp$
- bad = 0
- DWD$ = t$
- VerifyString t$
- t$ = e$
- 'First strip all spaces
- t$ = ""
- 'ERROR CHECK by counting our brackets
- l = 0
- l = 0
- 'Modify so that NOT will process properly
- l = 0
- 'We need to work magic on the statement so it looks pretty.
- ' 1 + NOT 2 + 1 is actually processed as 1 + (NOT 2 + 1)
- 'Look for something not proper
- l = l + 3
- 'PRINT t$
- 'Check for bad operators before a ( bracket
- l = 0
- good = 0
- l = l + 1
- 'Check for bad operators after a ) bracket
- l = 0
- good = 0
- l = l + 1
- 'Turn all &H (hex) numbers into decimal values for the program to process properly
- l = 0
- E = l + 1: finished = 0
- E = E + 1
- good = 0
- E = E - 1
- finished = -1
- 'Turn all &B (binary) numbers into decimal values for the program to process properly
- l = 0
- E = l + 1: finished = 0
- E = E + 1
- good = 0
- E = E - 1
- finished = -1
- t$ = N2S(t$)
- VerifyString t$
- e$ = t$
- 'ERROR CHECK for unrecognized operations
- j = 1
- good = 0
- r&& = r&& + 1
- 'l$ = l$
- l$ = "0" + l$
- l$ = "0." + l$
- l$ = l$ + "0"
- N2S$ = sign$ + l$
This now also has _RED, _GREEN, _BLUE, _ALPHA, _RED32, _GREEN32, _ALPHA32, _BLUE32...
Also did a little restructuring of the SELECT CASE which we use to finally calculate values, in an attempt to try and reduce a little CPU usage and processing time once it's swapped back into QB64.
QB64 parses everything we type over and over and over, with each and every keypress which we hit in the IDE. This little routine has now grown to where it contains over 60 different functions which it can calculate values for... IF the value we're looking for is down at the bottom of the list, that's 60+ IF calculations which we check and compare against with every keypress...
To reduce that burden, this now breaks things down by first the priority level and then the operation. In a stand-alone evaluation program, like the demo here, it doesn't make that much of a difference, but I'm hoping the internal change might help inside QB64 itself, as it reduces the amount of comparisons which it has to do over and over inside CONST for us. ;)
Post by: STxAxTIC on January 05, 2020, 04:17:36 pm
Code: QB64: [Select]
- ((6=6)-(5=5))^((4=4)-(3=3))
- 1
Anyway, I noticed that 0--7 correctly returns 7, but 0---7 returns 0. If you make the function that replaces "--" with "-" recursive or loopy you can deal with this whole class if problems. Of course, three minus signs is kinda rare, but someone could easily try to pass three euqal signs in a row if they confuse QB64 with JavaScript. Hm... maybe you don't need this suggestion...
EDIT:
Found a few errors when a minus sign leads the expression. Here's a simple one or two:
Code: QB64: [Select]
- 0
Code: QB64: [Select]
- -(-3+2)
- 0
Post by: SMcNeill on January 05, 2020, 05:03:07 pm
I always enjoyed playing with this. My favorite interaction (with result) isCode: QB64: [Select]
Anyway, I noticed that 0--7 correctly returns 7, but 0---7 returns 0. If you make the function that replaces "--" with "-" recursive or loopy you can deal with this whole class if problems. Of course, three minus signs is kinda rare, but someone could easily try to pass three euqal signs in a row if they confuse QB64 with JavaScript. Hm... maybe you don't need this suggestion...
EDIT:
Found a few errors when a minus sign leads the expression. Here's a simple one or two:Code: QB64: [Select]
I’m surprised no one has caught the - - - bug before! I’ll sort on this as well for us, while I’m in here working on things. There’s a DWD (deal with duplicates) function that should process and handle these things. I’ll have to see why it’s ignoring them for us. ;)
I also noticed that % is a percent symbol, which we can’t use in QB64, as it’s a type indicator for us. I’m kinda surprised that’s never affected anyone either.
1.1% * 100 should be 100, not 1.1.
Post by: FellippeHeitor on January 05, 2020, 08:49:41 pm
Post by: Pete on January 05, 2020, 09:30:22 pm
- Sam
Post by: FellippeHeitor on January 05, 2020, 09:46:13 pm
Post by: SMcNeill on January 05, 2020, 09:56:54 pm
_PI should take parameters like the function does (multipliers), like _PI(.5), _PI(2).
Added.
Code: QB64: [Select]
- Set_OrderOfOperations
- eval$ = ""
- eval$ = eval$ + i$
- PRINT eval$
- 'Steve Subs/Functins for _MATH support with CONST
- t$ = e$ 'So we preserve our original data, we parse a temp copy of it
- QuickReturn = 0
- PreParse t$
- 'Deal with brackets first
- c = 0
- c = c + 1
- s = Eval_E - c + 1
- ParseExpression eval$
- c = 0
- c = c + 1
- Evaluate_Expression$ = exp$
- 'PRINT exp$
- 'We should now have an expression with no () to deal with
- lowest = 0
- 'Look for first valid operator
- numset = 0
- '*** SPECIAL OPERATION RULESETS
- c = c + 1
- E = op + c
- c = 0
- c = c + 1
- c1 = c
- bad = 0
- c1 = c1 + 1
- bad = -1
- 'It's a negative sign and needs to count as part of our numbers
- s = op - c
- num(3) = EvaluateNumbers(OpOn, num())
- 'PRINT "*************"
- 'PRINT num(1), OName(OpOn), num(2), num(3), exp$
- 'PRINT exp$
- op = 0
- SUB Set_OrderOfOperations
- 'PL sets our priortity level. 1 is highest to 65535 for the lowest.
- 'I used a range here so I could add in new priority levels as needed.
- 'OName ended up becoming the name of our commands, as I modified things.... Go figure! LOL!
- 'Constants get evaluated first, with a Priority Level of 1
- 'I'm not certain where exactly percentages should go. They kind of seem like a special case to me. COS10% should be COS.1 I'd think...
- 'I'm putting it here for now, and if anyone knows someplace better for it in our order of operations, let me know.
- 'Then Functions with PL 10
- 'Exponents with PL 20
- 'Multiplication and Division PL 30
- 'Integer Division PL 40
- 'MOD PL 50
- 'Addition and Subtraction PL 60
- 'Relational Operators =, >, <, <>, <=, >= PL 70
- 'Logical Operations PL 80+
- 'Note, these are special cases and work with the number BEFORE the command and not after
- CASE "_PI"
- n1 = 3.14159265358979323846264338327950288## 'Future compatable in case something ever stores extra digits for PI
- CASE "_RGB32"
- n$ = num(2)
- ELSE 'we have more than three commas. I have no idea WTH type of values got passed here!
- CASE "_RGBA32"
- n$ = num(2)
- 'we have to have 3 commas; not more, not less.
- CASE "_RGB"
- n$ = num(2)
- 'we have to have 3 commas; not more, not less.
- CASE "_RGBA"
- n$ = num(2)
- 'we have to have 4 commas; not more, not less.
- n$ = num(2)
- n$ = num(2)
- CASE "ROOT"
- n3 = 1## / n2
- n1 = sign * (n1 ^ n3)
- CASE "\"
- EvaluateNumbers$ = "ERROR - Bad operation (We shouldn't see this)"
- 'To deal with duplicate operators in our code.
- 'Such as -- becomes a +
- '++ becomes a +
- '+- becomes a -
- '-+ becomes a -
- t$ = exp$
- bad = 0
- DWD$ = t$
- VerifyString t$
- TypeMod(1) = "~`": ConvertedMod(1) = "C_UBI" 'unsigned bit
- TypeMod(2) = "~%%": ConvertedMod(2) = "C_UBY" 'unsigned byte
- TypeMod(3) = "~%&": ConvertedMod(3) = "C_UOF" 'unsigned offset
- TypeMod(4) = "~%": ConvertedMod(4) = "C_UIN" 'unsigned integer
- TypeMod(5) = "~&&": ConvertedMod(5) = "C_UIF" 'unsigned integer64
- TypeMod(6) = "~&": ConvertedMod(6) = "C_ULO" 'unsigned long
- TypeMod(7) = "`": ConvertedMod(7) = "C_BI" 'bit
- TypeMod(8) = "%%": ConvertedMod(8) = "C_BY" 'byte
- TypeMod(9) = "%&": ConvertedMod(9) = "C_OF" 'offset
- TypeMod(10) = "%": ConvertedMod(10) = "C_IN" 'integer
- TypeMod(11) = "&&": ConvertedMod(11) = "C_IF" 'integer64
- TypeMod(12) = "&": ConvertedMod(12) = "C_LO" 'long
- TypeMod(13) = "!": ConvertedMod(13) = "C_SI" 'single
- TypeMod(14) = "##": ConvertedMod(14) = "C_FL" 'float
- TypeMod(15) = "#": ConvertedMod(15) = "C_DO" 'double
- t$ = e$
- 'First strip all spaces
- t$ = ""
- 'ERROR CHECK by counting our brackets
- l = 0
- l = 0
- 'Modify so that NOT will process properly
- l = 0
- 'We need to work magic on the statement so it looks pretty.
- ' 1 + NOT 2 + 1 is actually processed as 1 + (NOT 2 + 1)
- 'Look for something not proper
- l = l + 3
- 'PRINT t$
- 'Modify so that % will process properly
- l = 0
- i = i + lo
- 'PRINT "L1:"; l1; "L"; l
- 'PRINT "Y$: "; TypeMod(j)
- 'PRINT "L$: "; l$
- 'PRINT "M$: "; m$
- 'PRINT "R$: "; r$
- t$ = l$ + "(" + m$ + ")" + r$
- 'PRINT "T$: "; t$
- l = l + 2 + LEN(TypeMod(j)) 'move forward from the length of the symbol we checked + the new "(" and ")"
- 'PRINT "HERE: "; t$
- 'Check for bad operators before a ( bracket
- l = 0
- good = 0
- 'PRINT "BEFORE: "; t$; l
- 'IF OName(i) = "C_SI" THEN PRINT "CONVERT TO SINGLE", m$
- 'PRINT t$; l
- l = l + 1
- 'Check for bad operators after a ) bracket
- l = 0
- good = 0
- l = l + 1
- 'Turn all &H (hex) numbers into decimal values for the program to process properly
- l = 0
- E = l + 1: finished = 0
- E = E + 1
- good = 0
- E = E - 1
- finished = -1
- 'Turn all &B (binary) numbers into decimal values for the program to process properly
- l = 0
- E = l + 1: finished = 0
- E = E + 1
- good = 0
- E = E - 1
- finished = -1
- 'PRINT "ALMOST:"; t$
- t$ = N2S(t$)
- 'PRINT "ALMOST2:"; t$
- VerifyString t$
- e$ = t$
- 'ERROR CHECK for unrecognized operations
- j = 1
- good = 0
- r&& = r&& + 1
- 'l$ = l$
- l$ = "0" + l$
- l$ = "0." + l$
- l$ = l$ + "0"
- N2S$ = sign$ + l$
Also have added in the type conversion symbols for use -- and they're usable in more places here than where QB64 itself normally lets us use them!!
For example:
Code: [Select]
_RGB32(255,0,0)&The above would give us the LONG value for full red on a 32-bit screen.
Code: [Select]
_RGB32(255,0,0)~&And the above here will give us the UNSIGNED LONG value instead.
QB64 itself doesn't allow our variable types to be used with functions (and not always with numbers either, oddly enough!), but the routine here lets us toss them in wherever we need to so we can get back exactly whatever type value we want.
Next TO DO: Sort out what the heck is going on with multiple negatives corrupting values when they shouldn't, as STx pointed out above.
Post by: SMcNeill on January 05, 2020, 10:01:25 pm
_CEIL is missing.
Added.
Code: QB64: [Select]
- Set_OrderOfOperations
- eval$ = ""
- eval$ = eval$ + i$
- PRINT eval$
- 'Steve Subs/Functins for _MATH support with CONST
- t$ = e$ 'So we preserve our original data, we parse a temp copy of it
- QuickReturn = 0
- PreParse t$
- 'Deal with brackets first
- c = 0
- c = c + 1
- s = Eval_E - c + 1
- ParseExpression eval$
- c = 0
- c = c + 1
- Evaluate_Expression$ = exp$
- 'PRINT exp$
- 'We should now have an expression with no () to deal with
- lowest = 0
- 'Look for first valid operator
- numset = 0
- '*** SPECIAL OPERATION RULESETS
- c = c + 1
- E = op + c
- c = 0
- c = c + 1
- c1 = c
- bad = 0
- c1 = c1 + 1
- bad = -1
- 'It's a negative sign and needs to count as part of our numbers
- s = op - c
- num(3) = EvaluateNumbers(OpOn, num())
- 'PRINT "*************"
- 'PRINT num(1), OName(OpOn), num(2), num(3), exp$
- 'PRINT exp$
- op = 0
- SUB Set_OrderOfOperations
- 'PL sets our priortity level. 1 is highest to 65535 for the lowest.
- 'I used a range here so I could add in new priority levels as needed.
- 'OName ended up becoming the name of our commands, as I modified things.... Go figure! LOL!
- 'Constants get evaluated first, with a Priority Level of 1
- 'I'm not certain where exactly percentages should go. They kind of seem like a special case to me. COS10% should be COS.1 I'd think...
- 'I'm putting it here for now, and if anyone knows someplace better for it in our order of operations, let me know.
- 'Then Functions with PL 10
- 'Exponents with PL 20
- 'Multiplication and Division PL 30
- 'Integer Division PL 40
- 'MOD PL 50
- 'Addition and Subtraction PL 60
- 'Relational Operators =, >, <, <>, <=, >= PL 70
- 'Logical Operations PL 80+
- 'Note, these are special cases and work with the number BEFORE the command and not after
- CASE "_PI"
- n1 = 3.14159265358979323846264338327950288## 'Future compatable in case something ever stores extra digits for PI
- CASE "_RGB32"
- n$ = num(2)
- ELSE 'we have more than three commas. I have no idea WTH type of values got passed here!
- CASE "_RGBA32"
- n$ = num(2)
- 'we have to have 3 commas; not more, not less.
- CASE "_RGB"
- n$ = num(2)
- 'we have to have 3 commas; not more, not less.
- CASE "_RGBA"
- n$ = num(2)
- 'we have to have 4 commas; not more, not less.
- n$ = num(2)
- n$ = num(2)
- CASE "ROOT"
- n3 = 1## / n2
- n1 = sign * (n1 ^ n3)
- CASE "\"
- EvaluateNumbers$ = "ERROR - Bad operation (We shouldn't see this)"
- 'To deal with duplicate operators in our code.
- 'Such as -- becomes a +
- '++ becomes a +
- '+- becomes a -
- '-+ becomes a -
- t$ = exp$
- bad = 0
- DWD$ = t$
- VerifyString t$
- TypeMod(1) = "~`": ConvertedMod(1) = "C_UBI" 'unsigned bit
- TypeMod(2) = "~%%": ConvertedMod(2) = "C_UBY" 'unsigned byte
- TypeMod(3) = "~%&": ConvertedMod(3) = "C_UOF" 'unsigned offset
- TypeMod(4) = "~%": ConvertedMod(4) = "C_UIN" 'unsigned integer
- TypeMod(5) = "~&&": ConvertedMod(5) = "C_UIF" 'unsigned integer64
- TypeMod(6) = "~&": ConvertedMod(6) = "C_ULO" 'unsigned long
- TypeMod(7) = "`": ConvertedMod(7) = "C_BI" 'bit
- TypeMod(8) = "%%": ConvertedMod(8) = "C_BY" 'byte
- TypeMod(9) = "%&": ConvertedMod(9) = "C_OF" 'offset
- TypeMod(10) = "%": ConvertedMod(10) = "C_IN" 'integer
- TypeMod(11) = "&&": ConvertedMod(11) = "C_IF" 'integer64
- TypeMod(12) = "&": ConvertedMod(12) = "C_LO" 'long
- TypeMod(13) = "!": ConvertedMod(13) = "C_SI" 'single
- TypeMod(14) = "##": ConvertedMod(14) = "C_FL" 'float
- TypeMod(15) = "#": ConvertedMod(15) = "C_DO" 'double
- t$ = e$
- 'First strip all spaces
- t$ = ""
- 'ERROR CHECK by counting our brackets
- l = 0
- l = 0
- 'Modify so that NOT will process properly
- l = 0
- 'We need to work magic on the statement so it looks pretty.
- ' 1 + NOT 2 + 1 is actually processed as 1 + (NOT 2 + 1)
- 'Look for something not proper
- l = l + 3
- 'PRINT t$
- 'Modify so that % will process properly
- l = 0
- i = i + lo
- 'PRINT "L1:"; l1; "L"; l
- 'PRINT "Y$: "; TypeMod(j)
- 'PRINT "L$: "; l$
- 'PRINT "M$: "; m$
- 'PRINT "R$: "; r$
- t$ = l$ + "(" + m$ + ")" + r$
- 'PRINT "T$: "; t$
- l = l + 2 + LEN(TypeMod(j)) 'move forward from the length of the symbol we checked + the new "(" and ")"
- 'PRINT "HERE: "; t$
- 'Check for bad operators before a ( bracket
- l = 0
- good = 0
- 'PRINT "BEFORE: "; t$; l
- 'IF OName(i) = "C_SI" THEN PRINT "CONVERT TO SINGLE", m$
- 'PRINT t$; l
- l = l + 1
- 'Check for bad operators after a ) bracket
- l = 0
- good = 0
- l = l + 1
- 'Turn all &H (hex) numbers into decimal values for the program to process properly
- l = 0
- E = l + 1: finished = 0
- E = E + 1
- good = 0
- E = E - 1
- finished = -1
- 'Turn all &B (binary) numbers into decimal values for the program to process properly
- l = 0
- E = l + 1: finished = 0
- E = E + 1
- good = 0
- E = E - 1
- finished = -1
- 'PRINT "ALMOST:"; t$
- t$ = N2S(t$)
- 'PRINT "ALMOST2:"; t$
- VerifyString t$
- e$ = t$
- 'ERROR CHECK for unrecognized operations
- j = 1
- good = 0
- r&& = r&& + 1
- 'l$ = l$
- l$ = "0" + l$
- l$ = "0." + l$
- l$ = l$ + "0"
- N2S$ = sign$ + l$
Any other commands which are missing? I haven't had a change to look over the whole list of what QB64 offers yet, so I don't know if I'm missing anything or not.
Post by: FellippeHeitor on January 05, 2020, 10:07:29 pm
Any other commands which are missing? I haven't had a change to look over the whole list of what QB64 offers yet, so I don't know if I'm missing anything or not.
Here's from my interpreter, grabbed this list from subs_functions (of course there's more here than math functions):
Code: QB64: [Select]
- CASE "cos"
- CASE "val"
- CASE "int"
- CASE "asc"
- CASE "sin"
- CASE "len"
- CASE "rnd"
- GetVal## = RND
- CASE "timer"
- GetVal## = TIMER
- CASE "time$"
- foundAsText = true
- textReturn$ = TIME$
- CASE "date$"
- foundAsText = true
- textReturn$ = DATE$
- CASE "chr$"
- foundAsText = true
- CASE "str$"
- foundAsText = true
- CASE "inkey$"
- foundAsText = true
- textReturn$ = INKEY$
- CASE "_width"
- GetVal## = _WIDTH
- CASE "_height"
- GetVal## = _HEIGHT
- CASE "_mousex"
- GetVal## = _MOUSEX
- CASE "_mousey"
- GetVal## = _MOUSEY
- CASE "_mousebutton"
- CASE "_resize"
- GetVal## = _RESIZE
- CASE "_resizewidth"
- GetVal## = _RESIZEWIDTH
- CASE "_resizeheight"
- GetVal## = _RESIZEHEIGHT
- CASE "_scaledwidth"
- GetVal## = _SCALEDWIDTH
- CASE "_scaledheight"
- GetVal## = _SCALEDHEIGHT
- CASE "_screenhide"
- GetVal## = _SCREENHIDE
- CASE "_console"
- GetVal## = _CONSOLE
- CASE "_blink"
- GetVal## = _BLINK
- CASE "_fileexists"
- CASE "_direxists"
- CASE "_devices"
- GetVal## = _DEVICES
- CASE "_device$"
- foundAsText = true
- textReturn$ = _DEVICE$
- CASE "_deviceinput"
- GetVal## = _DEVICEINPUT
- CASE "_lastbutton"
- GetVal## = _LASTBUTTON
- CASE "_lastaxis"
- GetVal## = _LASTAXIS
- CASE "_lastwheel"
- GetVal## = _LASTWHEEL
- CASE "_button"
- GetVal## = _BUTTON
- CASE "_buttonchange"
- GetVal## = _BUTTONCHANGE
- CASE "_axis"
- GetVal## = _AXIS
- CASE "_wheel"
- GetVal## = _WHEEL
- CASE "_screenx"
- GetVal## = _SCREENX
- CASE "_screeny"
- GetVal## = _SCREENY
- CASE "_os$"
- foundAsText = true
- textReturn$ = _OS$
- CASE "_title$"
- foundAsText = true
- textReturn$ = _TITLE$
- CASE "_mapunicode"
- CASE "_keydown"
- CASE "_keyhit"
- GetVal## = _KEYHIT
- CASE "_windowhandle"
- GetVal## = _WINDOWHANDLE
- CASE "_screenimage"
- GetVal## = _SCREENIMAGE
- CASE "_freetimer"
- GetVal## = _FREETIMER
- CASE "_fullscreen"
- GetVal## = _FULLSCREEN
- CASE "_smooth"
- GetVal## = _SMOOTH
- CASE "_windowhasfocus"
- GetVal## = _WINDOWHASFOCUS
- CASE "_clipboard$"
- foundAsText = true
- textReturn$ = _CLIPBOARD$
- CASE "_clipboardimage"
- GetVal## = _CLIPBOARDIMAGE
- CASE "_exit"
- GetVal## = _EXIT
- CASE "_openhost"
- CASE "_connected"
- foundAsText = true
- CASE "_openconnection"
- CASE "_openclient"
- CASE "environ$"
- foundAsText = true
- CASE "_errorline"
- GetVal## = lineThatErrored
- CASE "_inclerrorline"
- 'GetVal## = _INCLERRORLINE
- CASE "_acceptfiledrop"
- GetVal## = _ACCEPTFILEDROP
- CASE "_totaldroppedfiles"
- GetVal## = _TOTALDROPPEDFILES
- foundAsText = true
- textReturn$ = _DROPPEDFILE$
- CASE "_newimage"
- 'GetVal## = _newimage
- CASE "_loadimage"
- CASE "_copyimage"
- CASE "_source"
- GetVal## = _SOURCE
- CASE "_dest"
- GetVal## = _DEST
- CASE "_display"
- GetVal## = _DISPLAY
- CASE "_pixelsize"
- GetVal## = _PIXELSIZE
- CASE "_clearcolor"
- GetVal## = _CLEARCOLOR
- CASE "_blend"
- GetVal## = _BLEND
- CASE "_defaultcolor"
- GetVal## = _DEFAULTCOLOR
- CASE "_backgroundcolor"
- GetVal## = _BACKGROUNDCOLOR
- CASE "_palettecolor"
- CASE "_loadfont"
- 'GetVal## = _loadfont
- CASE "_fontwidth"
- GetVal## = _FONTWIDTH
- CASE "_fontheight"
- GetVal## = _FONTHEIGHT
- CASE "_font"
- GetVal## = _FONT
- CASE "_printwidth"
- CASE "_printmode"
- GetVal## = _PRINTMODE
- CASE "_rgba"
- 'GetVal## = _rgba
- CASE "_rgba32"
- 'GetVal## = _rgba32
- CASE "_rgb"
- 'GetVal## = _rgb
- CASE "_rgb32"
- 'GetVal## = _rgb32
- CASE "_red"
- 'GetVal## = _red
- CASE "_red32"
- 'GetVal## = _red32
- CASE "_green"
- 'GetVal## = _green
- CASE "_green32"
- 'GetVal## = _green32
- CASE "_blue"
- 'GetVal## = _blue
- CASE "_blue32"
- 'GetVal## = _blue32
- CASE "_alpha"
- 'GetVal## = _alpha
- CASE "_alpha32"
- 'GetVal## = _alpha32
- CASE "_mouseinput"
- GetVal## = _MOUSEINPUT
- CASE "_mousewheel"
- GetVal## = _MOUSEWHEEL
- CASE "freefile"
- GetVal## = FREEFILE
- CASE "shell"
- CASE "_shellhide"
- CASE "command$"
- foundAsText = true
- CASE "_commandcount"
- GetVal## = _COMMANDCOUNT
- CASE "_sndrate"
- GetVal## = _SNDRATE
- CASE "_sndopenraw"
- GetVal## = _SNDOPENRAW
- CASE "_sndrawlen"
- GetVal## = _SNDRAWLEN
- CASE "_sndlen"
- CASE "_sndpaused"
- CASE "_sndopen"
- CASE "_sndgetpos"
- CASE "_sndplaying"
- CASE "_sndcopy"
- CASE "seek"
- CASE "loc"
- CASE "eof"
- CASE "lof"
- CASE "screen"
- 'GetVal## = screen
- CASE "point"
- 'GetVal## = point
- CASE "tab"
- foundAsText = true
- CASE "spc"
- foundAsText = true
- CASE "inp"
- CASE "pos"
- CASE "sgn"
- CASE "lbound"
- 'GetVal## = lbound
- CASE "ubound"
- 'GetVal## = ubound
- CASE "oct$"
- foundAsText = true
- CASE "hex$"
- foundAsText = true
- CASE "exp"
- CASE "fix"
- CASE "cdbl"
- CASE "csng"
- CASE "_round"
- CASE "cint"
- CASE "clng"
- CASE "csrlin"
- GetVal## = CSRLIN
- CASE "mki$"
- foundAsText = true
- CASE "mkl$"
- foundAsText = true
- CASE "mks$"
- foundAsText = true
- CASE "mkd$"
- foundAsText = true
- CASE "mksmbf$"
- foundAsText = true
- CASE "mkdmbf$"
- foundAsText = true
- CASE "_mk$"
- foundAsText = true
- 'textReturn$ = _mk$
- CASE "cvsmbf"
- CASE "cvdmbf"
- CASE "cvi"
- CASE "cvl"
- CASE "cvs"
- CASE "cvd"
- CASE "_cv"
- 'GetVal## = _cv
- CASE "string$"
- 'foundAsText = true
- 'textReturn$ = string$(temp##)
- CASE "space$"
- foundAsText = true
- CASE "instr"
- 'GetVal## = instr
- CASE "_instrrev"
- 'GetVal## = _instrrev
- CASE "mid$"
- 'foundAsText = true
- 'textReturn$ = mid$
- CASE "sqr"
- CASE "tan"
- CASE "atn"
- CASE "log"
- CASE "abs"
- CASE "erl"
- GetVal## = lineThatErrored
- CASE "err"
- GetVal## = ERR
- CASE "ucase$"
- foundAsText = true
- CASE "lcase$"
- foundAsText = true
- CASE "left$"
- 'foundAsText = true
- 'textReturn$ = left$
- CASE "right$"
- 'foundAsText = true
- 'textReturn$ = right$
- CASE "ltrim$"
- foundAsText = true
- CASE "rtrim$"
- foundAsText = true
- CASE "_trim$"
- foundAsText = true
- CASE "_cwd$"
- foundAsText = true
- textReturn$ = _CWD$
- CASE "_startdir$"
- foundAsText = true
- textReturn$ = _STARTDIR$
- CASE "_dir$"
- foundAsText = true
- CASE "_inclerrorfile$"
- foundAsText = true
- textReturn$ = _INCLERRORFILE$
- CASE "_atan2"
- 'GetVal## = _atan2
- CASE "_hypot"
- 'GetVal## = _hypot
- CASE "_pi"
- CASE "_desktopheight"
- GetVal## = _DESKTOPHEIGHT
- CASE "_desktopwidth"
- GetVal## = _DESKTOPWIDTH
- CASE "_screenexists"
- GetVal## = _SCREENEXISTS
- CASE "_controlchr"
- GetVal## = _CONTROLCHR
- CASE "_stricmp"
- 'GetVal## = _stricmp
- CASE "_strcmp"
- 'GetVal## = _strcmp
- CASE "_autodisplay"
- GetVal## = _AUTODISPLAY
- CASE "_shr"
- 'GetVal## = _shr
- CASE "_shl"
- 'GetVal## = _shl
- CASE "_deflate$"
- foundAsText = true
- CASE "_inflate$"
- foundAsText = true
- CASE "_readbit"
- 'GetVal## = _readbit
- CASE "_setbit"
- 'GetVal## = _setbit
- CASE "_resetbit"
- 'GetVal## = _resetbit
- CASE "_togglebit"
- 'GetVal## = _togglebit
Post by: SMcNeill on January 05, 2020, 10:55:53 pm
Here's from my interpreter, grabbed this list from subs_functions (of course there's more here than math functions):Code: QB64: [Select]
Not a list that's going to do me a whole lot of good. There's no way we can sort out even half of these for use with CONST. "_mousey", "_width", "_screenexists"...
The list from the wiki is just as useful as this one is. :P
If somebody notices a command missing, which we can get and use, like you noticed _CEIL, just point it out and I'll add it for us.
Should something semi-constant like _DESKTOPWIDTH be added? It *can* change, if the user goes in, in the middle of their program operation, and changes desktop settings -- but that doesn't happen very often, and most people don't program for that type of event anyway. If they do, would they be very likely to try and set it as a CONST, knowing it can change??
Honestly, I don't know if it's something I should add into the math evaluator or not...
I'll leave it up to you guys to decide. I don't care one way or the other. I don't think I'd ever set _DESKTOPWIDTH as a constant, knowing it can change, but somebody else out there might want to, just so they can have their program compile with constant values and not variables.
Post by: FellippeHeitor on January 05, 2020, 11:04:56 pm
Not a list that's going to do me a whole lot of good. There's no way we can sort out even half of these for use with CONST. "_mousey", "_width", "_screenexists"...
The list from the wiki is just as useful as this one is. :P
If somebody notices a command missing, which we can get and use, like you noticed _CEIL, just point it out and I'll add it for us.
Should something semi-constant like _DESKTOPWIDTH be added? It *can* change, if the user goes in, in the middle of their program operation, and changes desktop settings -- but that doesn't happen very often, and most people don't program for that type of event anyway. If they do, would they be very likely to try and set it as a CONST, knowing it can change??
Honestly, I don't know if it's something I should add into the math evaluator or not...
I'll leave it up to you guys to decide. I don't care one way or the other. I don't think I'd ever set _DESKTOPWIDTH as a constant, knowing it can change, but somebody else out there might want to, just so they can have their program compile with constant values and not variables.
If it's not math, it shouldn't be there. I'm only giving you the list here as it contains all functions, whether math or not, so it's a list you can peek.
On another note, this one more serious:
Below you will find your code from the previous update (when you added _CEIL) with relevant changes for use with $NOPREFIX. The changes I'm adding below are already working in my local copy of the branch I'm using to work on $NOPREFIX, and they don't alter your code's current test state in anything, except that, if you uncomment the line qb64prefix_set = 1 you will end up allowing non-prefixed operators, just like it will happen when $NOPREFIX is used..
If you'd be so kind to continue working on your improvements from this version, it'll make it much easier to inject it back into QB64 once your testing is done.
Code: QB64: [Select]
- Set_OrderOfOperations
- 'qb64prefix_set = 1 'which means the $NOPREFIX metacommand was used and _PI can be used as PI
- eval$ = ""
- eval$ = eval$ + i$
- PRINT eval$
- 'Steve Subs/Functins for _MATH support with CONST
- t$ = e$ 'So we preserve our original data, we parse a temp copy of it
- QuickReturn = 0
- PreParse t$
- 'Deal with brackets first
- c = 0
- c = c + 1
- s = Eval_E - c + 1
- ParseExpression eval$
- c = 0
- c = c + 1
- Evaluate_Expression$ = EXP$
- 'PRINT exp$
- 'We should now have an expression with no () to deal with
- lowest = 0
- 'Look for first valid operator
- 'try again without prefix
- lowest = lowest + 1
- numset = 0
- '*** SPECIAL OPERATION RULESETS
- c = c + 1
- E = op + c
- c = 0
- c = c + 1
- c1 = c
- bad = 0
- c1 = c1 + 1
- bad = -1
- 'It's a negative sign and needs to count as part of our numbers
- s = op - c
- num(3) = EvaluateNumbers(OpOn, num())
- 'PRINT "*************"
- 'PRINT num(1), OName(OpOn), num(2), num(3), exp$
- 'PRINT exp$
- op = 0
- SUB Set_OrderOfOperations
- 'PL sets our priortity level. 1 is highest to 65535 for the lowest.
- 'I used a range here so I could add in new priority levels as needed.
- 'OName ended up becoming the name of our commands, as I modified things.... Go figure! LOL!
- 'Constants get evaluated first, with a Priority Level of 1
- 'I'm not certain where exactly percentages should go. They kind of seem like a special case to me. COS10% should be COS.1 I'd think...
- 'I'm putting it here for now, and if anyone knows someplace better for it in our order of operations, let me know.
- 'Then Functions with PL 10
- 'Exponents with PL 20
- 'Multiplication and Division PL 30
- 'Integer Division PL 40
- 'MOD PL 50
- 'Addition and Subtraction PL 60
- 'Relational Operators =, >, <, <>, <=, >= PL 70
- 'Logical Operations PL 80+
- 'Note, these are special cases and work with the number BEFORE the command and not after
- CASE "_PI"
- n1 = 3.14159265358979323846264338327950288## 'Future compatable in case something ever stores extra digits for PI
- CASE "_RGB32"
- n$ = num(2)
- ELSE 'we have more than three commas. I have no idea WTH type of values got passed here!
- CASE "_RGBA32"
- n$ = num(2)
- 'we have to have 3 commas; not more, not less.
- CASE "_RGB"
- n$ = num(2)
- 'we have to have 3 commas; not more, not less.
- CASE "_RGBA"
- n$ = num(2)
- 'we have to have 4 commas; not more, not less.
- n$ = num(2)
- n$ = num(2)
- CASE "ROOT"
- n3 = 1## / n2
- n1 = sign * (n1 ^ n3)
- CASE "\"
- EvaluateNumbers$ = "ERROR - Bad operation (We shouldn't see this)"
- 'To deal with duplicate operators in our code.
- 'Such as -- becomes a +
- '++ becomes a +
- '+- becomes a -
- '-+ becomes a -
- t$ = EXP$
- bad = 0
- DWD$ = t$
- VerifyString t$
- TypeMod(1) = "~`": ConvertedMod(1) = "C_UBI" 'unsigned bit
- TypeMod(2) = "~%%": ConvertedMod(2) = "C_UBY" 'unsigned byte
- TypeMod(3) = "~%&": ConvertedMod(3) = "C_UOF" 'unsigned offset
- TypeMod(4) = "~%": ConvertedMod(4) = "C_UIN" 'unsigned integer
- TypeMod(5) = "~&&": ConvertedMod(5) = "C_UIF" 'unsigned integer64
- TypeMod(6) = "~&": ConvertedMod(6) = "C_ULO" 'unsigned long
- TypeMod(7) = "`": ConvertedMod(7) = "C_BI" 'bit
- TypeMod(8) = "%%": ConvertedMod(8) = "C_BY" 'byte
- TypeMod(9) = "%&": ConvertedMod(9) = "C_OF" 'offset
- TypeMod(10) = "%": ConvertedMod(10) = "C_IN" 'integer
- TypeMod(11) = "&&": ConvertedMod(11) = "C_IF" 'integer64
- TypeMod(12) = "&": ConvertedMod(12) = "C_LO" 'long
- TypeMod(13) = "!": ConvertedMod(13) = "C_SI" 'single
- TypeMod(14) = "##": ConvertedMod(14) = "C_FL" 'float
- TypeMod(15) = "#": ConvertedMod(15) = "C_DO" 'double
- t$ = e$
- 'First strip all spaces
- t$ = ""
- 'ERROR CHECK by counting our brackets
- l = 0
- l = 0
- 'Modify so that NOT will process properly
- l = 0
- 'We need to work magic on the statement so it looks pretty.
- ' 1 + NOT 2 + 1 is actually processed as 1 + (NOT 2 + 1)
- 'Look for something not proper
- l = l + 3
- 'PRINT t$
- 'Modify so that % will process properly
- l = 0
- i = i + lo
- 'PRINT "L1:"; l1; "L"; l
- 'PRINT "Y$: "; TypeMod(j)
- 'PRINT "L$: "; l$
- 'PRINT "M$: "; m$
- 'PRINT "R$: "; r$
- t$ = l$ + "(" + m$ + ")" + r$
- 'PRINT "T$: "; t$
- l = l + 2 + LEN(TypeMod(j)) 'move forward from the length of the symbol we checked + the new "(" and ")"
- 'PRINT "HERE: "; t$
- 'Check for bad operators before a ( bracket
- l = 0
- good = 0
- 'PRINT "BEFORE: "; t$; l
- 'IF OName(i) = "C_SI" THEN PRINT "CONVERT TO SINGLE", m$
- 'try without prefix
- 'PRINT t$; l
- l = l + 1
- 'Check for bad operators after a ) bracket
- l = 0
- good = 0
- 'try without prefix
- l = l + 1
- 'Turn all &H (hex) numbers into decimal values for the program to process properly
- l = 0
- E = l + 1: finished = 0
- E = E + 1
- good = 0
- E = E - 1
- finished = -1
- 'Turn all &B (binary) numbers into decimal values for the program to process properly
- l = 0
- E = l + 1: finished = 0
- E = E + 1
- good = 0
- E = E - 1
- finished = -1
- 'PRINT "ALMOST:"; t$
- t$ = N2S(t$)
- 'PRINT "ALMOST2:"; t$
- VerifyString t$
- e$ = t$
- 'ERROR CHECK for unrecognized operations
- j = 1
- good = 0
- extrachar = 0
- 'try without prefix
- r&& = r&& + 1
- 'l$ = l$
- l$ = "0" + l$
- l$ = "0." + l$
- l$ = l$ + "0"
- N2S$ = sign$ + l$
PS: qb64prefix_set is the actual control variable name being used for $NOPREFIX internally, so it's verbatim the way it should be in the final version as well.
PS2: If you use a diff tool the changes should be pretty self-explanatory.
Post by: SMcNeill on January 06, 2020, 12:02:05 am
Code: QB64: [Select]
- Set_OrderOfOperations
- eval$ = ""
- eval$ = eval$ + i$
- PRINT eval$
- 'Steve Subs/Functins for _MATH support with CONST
- t$ = e$ 'So we preserve our original data, we parse a temp copy of it
- PreParse t$
- 'Deal with brackets first
- c = 0
- c = c + 1
- s = Eval_E - c + 1
- 'PRINT "PRE-PARSE: "; eval$
- ParseExpression eval$
- 'PRINT "AFTER PARSE: "; eval$
- 'PRINT exp$
- 'temppp$ = DWD(LEFT$(exp$, s - 2) + " ## " + eval$ + " ## " + MID$(exp$, e + 1))
- c = 0
- c = c + 1
- Evaluate_Expression$ = exp$
- 'PRINT exp$
- 'We should now have an expression with no () to deal with
- 'IF MID$(exp$, 2, 1) = "-" THEN exp$ = "0+" + MID$(exp$, 2)
- lowest = 0
- 'Look for first valid operator
- numset = 0
- '*** SPECIAL OPERATION RULESETS
- c = c + 1
- e = op + c
- c = 0
- c = c + 1
- c1 = c
- bad = 0
- c1 = c1 + 1
- bad = -1
- 'It's a negative sign and needs to count as part of our numbers
- s = op - c
- num(3) = "N" + EvaluateNumbers(OpOn, num())
- num(3) = EvaluateNumbers(OpOn, num())
- 'PRINT "*************"
- 'PRINT num(1), OName(OpOn), num(2), num(3), exp$
- 'PRINT exp$
- op = 0
- SUB Set_OrderOfOperations
- 'PL sets our priortity level. 1 is highest to 65535 for the lowest.
- 'I used a range here so I could add in new priority levels as needed.
- 'OName ended up becoming the name of our commands, as I modified things.... Go figure! LOL!
- 'Constants get evaluated first, with a Priority Level of 1
- 'I'm not certain where exactly percentages should go. They kind of seem like a special case to me. COS10% should be COS.1 I'd think...
- 'I'm putting it here for now, and if anyone knows someplace better for it in our order of operations, let me know.
- 'Then Functions with PL 10
- 'Exponents with PL 20
- 'Multiplication and Division PL 30
- 'Integer Division PL 40
- 'MOD PL 50
- 'Addition and Subtraction PL 60
- 'Relational Operators =, >, <, <>, <=, >= PL 70
- 'Logical Operations PL 80+
- 'PRINT "EN$: "; num(1), num(2), OName(p)
- 'Note, these are special cases and work with the number BEFORE the command and not after
- CASE "_PI"
- n1 = 3.14159265358979323846264338327950288## 'Future compatable in case something ever stores extra digits for PI
- CASE "C_RG"
- n$ = num(2)
- ELSE 'we have more than three commas. I have no idea WTH type of values got passed here!
- CASE "C_RA"
- n$ = num(2)
- 'we have to have 3 commas; not more, not less.
- CASE "_RGB"
- n$ = num(2)
- 'we have to have 3 commas; not more, not less.
- CASE "_RGBA"
- n$ = num(2)
- 'we have to have 4 commas; not more, not less.
- n$ = num(2)
- n$ = num(2)
- CASE "ROOT"
- n3 = 1## / n2
- n1 = sign * (n1 ^ n3)
- CASE "\"
- EvaluateNumbers$ = "ERROR - Bad operation (We shouldn't see this)"
- CASE "-":
- 'To deal with duplicate operators in our code.
- 'Such as -- becomes a +
- '++ becomes a +
- '+- becomes a -
- '-+ becomes a -
- t$ = exp$
- bad = 0
- 'PRINT "FIXING: "; t$
- DWD$ = t$
- TypeMod(1) = "~`": ConvertedMod(1) = "C_UBI" 'unsigned bit
- TypeMod(2) = "~%%": ConvertedMod(2) = "C_UBY" 'unsigned byte
- TypeMod(3) = "~%&": ConvertedMod(3) = "C_UOF" 'unsigned offset
- TypeMod(4) = "~%": ConvertedMod(4) = "C_UIN" 'unsigned integer
- TypeMod(5) = "~&&": ConvertedMod(5) = "C_UIF" 'unsigned integer64
- TypeMod(6) = "~&": ConvertedMod(6) = "C_ULO" 'unsigned long
- TypeMod(7) = "`": ConvertedMod(7) = "C_BI" 'bit
- TypeMod(8) = "%%": ConvertedMod(8) = "C_BY" 'byte
- TypeMod(9) = "%&": ConvertedMod(9) = "C_OF" 'offset
- TypeMod(10) = "%": ConvertedMod(10) = "C_IN" 'integer
- TypeMod(11) = "&&": ConvertedMod(11) = "C_IF" 'integer64
- TypeMod(12) = "&": ConvertedMod(12) = "C_LO" 'long
- TypeMod(13) = "!": ConvertedMod(13) = "C_SI" 'single
- TypeMod(14) = "##": ConvertedMod(14) = "C_FL" 'float
- TypeMod(15) = "#": ConvertedMod(15) = "C_DO" 'double
- TypeMod(16) = "_RGB32": ConvertedMod(16) = "C_RG" 'rgb32
- TypeMod(17) = "_RGBA32": ConvertedMod(17) = "C_RA" 'rgba32
- TypeMod(18) = "_RED32": ConvertedMod(18) = "C_RX" 'red32
- TypeMod(19) = "_GREEN32": ConvertedMod(19) = "C_GR" 'green32
- TypeMod(20) = "_BLUE32": ConvertedMod(20) = "C_BL" 'blue32
- TypeMod(21) = "_ALPHA32": ConvertedMod(21) = "C_AL" 'alpha32
- t$ = e$
- 'First strip all spaces
- t$ = ""
- 'ERROR CHECK by counting our brackets
- l = 0
- l = 0
- 'Modify so that NOT will process properly
- l = 0
- 'We need to work magic on the statement so it looks pretty.
- ' 1 + NOT 2 + 1 is actually processed as 1 + (NOT 2 + 1)
- 'Look for something not proper
- l = l + 3
- 'PRINT t$
- 'Modify so that % will process properly
- l = 0
- i = i + lo
- 'PRINT "L1:"; l1; "L"; l
- 'PRINT "Y$: "; TypeMod(j)
- 'PRINT "L$: "; l$
- 'PRINT "M$: "; m$
- 'PRINT "R$: "; r$
- t$ = l$ + m$ + r$ 'replacement routine for commands which might get confused with others, like _RGB and _RGB32
- 'the first 15 commands need to properly place the parenthesis around the value we want to convert.
- t$ = l$ + "(" + m$ + ")" + r$
- 'PRINT "T$: "; t$
- l = l + 2 + LEN(TypeMod(j)) 'move forward from the length of the symbol we checked + the new "(" and ")"
- 'PRINT "HERE: "; t$
- 'Check for bad operators before a ( bracket
- l = 0
- good = 0
- 'PRINT "BEFORE: "; t$; l
- 'IF OName(i) = "C_SI" THEN PRINT "CONVERT TO SINGLE", m$
- 'PRINT t$; l
- l = l + 1
- 'Check for bad operators after a ) bracket
- l = 0
- good = 0
- l = l + 1
- 'Turn all &H (hex) numbers into decimal values for the program to process properly
- l = 0
- E = l + 1: finished = 0
- E = E + 1
- good = 0
- E = E - 1
- finished = -1
- 'Turn all &B (binary) numbers into decimal values for the program to process properly
- l = 0
- E = l + 1: finished = 0
- E = E + 1
- good = 0
- E = E - 1
- finished = -1
- 'PRINT "ALMOST:"; t$
- t$ = N2S(t$)
- 'PRINT "ALMOST2:"; t$
- VerifyString t$
- e$ = t$
- 'ERROR CHECK for unrecognized operations
- j = 1
- good = 0
- r&& = r&& + 1
- 'l$ = l$
- l$ = "0" + l$
- l$ = "0." + l$
- l$ = l$ + "0"
- N2S$ = sign$ + l$
Sorry, Fellippe; I was working on making changes and didn't see your post until after I finished. I'll see about swapping the $NOPREFIX stuff into the code sometime tomorrow -- I'm going to head on out to bed here in just a few moments and doubt I'll do any more coding on anything tonight. ;)
So let's recap what all has been altered in this so far:
1) multiple negatives have been corrected and sorted out.
2) all the type suffixes are now available for use with the command, to make certain our return values are the type we want them to be.
3) _CEIL has been added.
4) _PI now accepts optional parameters
5) ALL the _RGB, _RGBA, _RED, _GREEN, _BLUE, _ALPHA (and their 32 bit versions) have been added.
6) Program flow has been tweaked a little to make it more responsive, for when called inside QB64 itself over and over and over.
Post by: FellippeHeitor on January 06, 2020, 12:15:02 am
Code: QB64: [Select]
- Set_OrderOfOperations
- 'qb64prefix_set = 1 'which means the $NOPREFIX metacommand was used and _PI can be used as PI
- eval$ = ""
- eval$ = eval$ + i$
- PRINT eval$
- 'Steve Subs/Functins for _MATH support with CONST
- t$ = e$ 'So we preserve our original data, we parse a temp copy of it
- PreParse t$
- 'Deal with brackets first
- c = 0
- c = c + 1
- s = Eval_E - c + 1
- 'PRINT "PRE-PARSE: "; eval$
- ParseExpression eval$
- 'PRINT "AFTER PARSE: "; eval$
- 'PRINT exp$
- 'temppp$ = DWD(LEFT$(exp$, s - 2) + " ## " + eval$ + " ## " + MID$(exp$, e + 1))
- c = 0
- c = c + 1
- Evaluate_Expression$ = EXP$
- 'PRINT exp$
- 'We should now have an expression with no () to deal with
- 'IF MID$(exp$, 2, 1) = "-" THEN exp$ = "0+" + MID$(exp$, 2)
- lowest = 0
- 'Look for first valid operator
- 'try again without prefix
- lowest = lowest + 1
- numset = 0
- '*** SPECIAL OPERATION RULESETS
- c = c + 1
- e = op + c
- c = 0
- c = c + 1
- c1 = c
- bad = 0
- c1 = c1 + 1
- bad = -1
- 'It's a negative sign and needs to count as part of our numbers
- s = op - c
- num(3) = "N" + EvaluateNumbers(OpOn, num())
- num(3) = EvaluateNumbers(OpOn, num())
- 'PRINT "*************"
- 'PRINT num(1), OName(OpOn), num(2), num(3), exp$
- 'PRINT exp$
- op = 0
- SUB Set_OrderOfOperations
- 'PL sets our priortity level. 1 is highest to 65535 for the lowest.
- 'I used a range here so I could add in new priority levels as needed.
- 'OName ended up becoming the name of our commands, as I modified things.... Go figure! LOL!
- 'Constants get evaluated first, with a Priority Level of 1
- 'I'm not certain where exactly percentages should go. They kind of seem like a special case to me. COS10% should be COS.1 I'd think...
- 'I'm putting it here for now, and if anyone knows someplace better for it in our order of operations, let me know.
- 'Then Functions with PL 10
- 'Exponents with PL 20
- 'Multiplication and Division PL 30
- 'Integer Division PL 40
- 'MOD PL 50
- 'Addition and Subtraction PL 60
- 'Relational Operators =, >, <, <>, <=, >= PL 70
- 'Logical Operations PL 80+
- 'PRINT "EN$: "; num(1), num(2), OName(p)
- 'Note, these are special cases and work with the number BEFORE the command and not after
- CASE "_PI"
- n1 = 3.14159265358979323846264338327950288## 'Future compatable in case something ever stores extra digits for PI
- CASE "C_RG"
- n$ = num(2)
- ELSE 'we have more than three commas. I have no idea WTH type of values got passed here!
- CASE "C_RA"
- n$ = num(2)
- 'we have to have 3 commas; not more, not less.
- CASE "_RGB"
- n$ = num(2)
- 'we have to have 3 commas; not more, not less.
- CASE "_RGBA"
- n$ = num(2)
- 'we have to have 4 commas; not more, not less.
- n$ = num(2)
- n$ = num(2)
- CASE "ROOT"
- n3 = 1## / n2
- n1 = sign * (n1 ^ n3)
- CASE "\"
- EvaluateNumbers$ = "ERROR - Bad operation (We shouldn't see this)"
- CASE "-":
- 'To deal with duplicate operators in our code.
- 'Such as -- becomes a +
- '++ becomes a +
- '+- becomes a -
- '-+ becomes a -
- t$ = EXP$
- bad = 0
- 'PRINT "FIXING: "; t$
- DWD$ = t$
- TypeMod(1) = "~`": ConvertedMod(1) = "C_UBI" 'unsigned bit
- TypeMod(2) = "~%%": ConvertedMod(2) = "C_UBY" 'unsigned byte
- TypeMod(3) = "~%&": ConvertedMod(3) = "C_UOF" 'unsigned offset
- TypeMod(4) = "~%": ConvertedMod(4) = "C_UIN" 'unsigned integer
- TypeMod(5) = "~&&": ConvertedMod(5) = "C_UIF" 'unsigned integer64
- TypeMod(6) = "~&": ConvertedMod(6) = "C_ULO" 'unsigned long
- TypeMod(7) = "`": ConvertedMod(7) = "C_BI" 'bit
- TypeMod(8) = "%%": ConvertedMod(8) = "C_BY" 'byte
- TypeMod(9) = "%&": ConvertedMod(9) = "C_OF" 'offset
- TypeMod(10) = "%": ConvertedMod(10) = "C_IN" 'integer
- TypeMod(11) = "&&": ConvertedMod(11) = "C_IF" 'integer64
- TypeMod(12) = "&": ConvertedMod(12) = "C_LO" 'long
- TypeMod(13) = "!": ConvertedMod(13) = "C_SI" 'single
- TypeMod(14) = "##": ConvertedMod(14) = "C_FL" 'float
- TypeMod(15) = "#": ConvertedMod(15) = "C_DO" 'double
- TypeMod(16) = "_RGB32": ConvertedMod(16) = "C_RG" 'rgb32
- TypeMod(17) = "_RGBA32": ConvertedMod(17) = "C_RA" 'rgba32
- TypeMod(18) = "_RED32": ConvertedMod(18) = "C_RX" 'red32
- TypeMod(19) = "_GREEN32": ConvertedMod(19) = "C_GR" 'green32
- TypeMod(20) = "_BLUE32": ConvertedMod(20) = "C_BL" 'blue32
- TypeMod(21) = "_ALPHA32": ConvertedMod(21) = "C_AL" 'alpha32
- t$ = e$
- 'First strip all spaces
- t$ = ""
- 'ERROR CHECK by counting our brackets
- l = 0
- l = 0
- 'Modify so that NOT will process properly
- l = 0
- 'We need to work magic on the statement so it looks pretty.
- ' 1 + NOT 2 + 1 is actually processed as 1 + (NOT 2 + 1)
- 'Look for something not proper
- l = l + 3
- 'PRINT t$
- 'Modify so that % will process properly
- l = 0
- i = i + lo
- 'PRINT "L1:"; l1; "L"; l
- 'PRINT "Y$: "; TypeMod(j)
- 'PRINT "L$: "; l$
- 'PRINT "M$: "; m$
- 'PRINT "R$: "; r$
- t$ = l$ + m$ + r$ 'replacement routine for commands which might get confused with others, like _RGB and _RGB32
- 'the first 15 commands need to properly place the parenthesis around the value we want to convert.
- t$ = l$ + "(" + m$ + ")" + r$
- 'PRINT "T$: "; t$
- l = l + 2 + LEN(TypeMod(j)) 'move forward from the length of the symbol we checked + the new "(" and ")"
- 'PRINT "HERE: "; t$
- 'Check for bad operators before a ( bracket
- l = 0
- good = 0
- 'PRINT "BEFORE: "; t$; l
- 'IF OName(i) = "C_SI" THEN PRINT "CONVERT TO SINGLE", m$
- 'try without prefix
- 'PRINT t$; l
- l = l + 1
- 'Check for bad operators after a ) bracket
- l = 0
- good = 0
- 'try without prefix
- l = l + 1
- 'Turn all &H (hex) numbers into decimal values for the program to process properly
- l = 0
- E = l + 1: finished = 0
- E = E + 1
- good = 0
- E = E - 1
- finished = -1
- 'Turn all &B (binary) numbers into decimal values for the program to process properly
- l = 0
- E = l + 1: finished = 0
- E = E + 1
- good = 0
- E = E - 1
- finished = -1
- 'PRINT "ALMOST:"; t$
- t$ = N2S(t$)
- 'PRINT "ALMOST2:"; t$
- VerifyString t$
- e$ = t$
- 'ERROR CHECK for unrecognized operations
- j = 1
- good = 0
- extrachar = 0
- 'try without prefix
- r&& = r&& + 1
- 'l$ = l$
- l$ = "0" + l$
- l$ = "0." + l$
- l$ = l$ + "0"
- N2S$ = sign$ + l$
Post by: SMcNeill on January 07, 2020, 10:30:23 am
Code: QB64: [Select]
- PRINT "Formula to Evaluate => ";
- eval$ = ""
- eval$ = eval$ + i$
- PRINT eval$
- result$ = Evaluate_Expression(eval$)
- PRINT "Result: "; result$
- 'Steve Subs/Functins for _MATH support with CONST
- t$ = e$ 'So we preserve our original data, we parse a temp copy of it
- PreParse t$
- 'Deal with brackets first
- c = 0
- c = c + 1
- s = Eval_E - c + 1
- 'PRINT "Before ParseExpression: "; eval$
- ParseExpression eval$
- 'PRINT "After ParseExpression: "; eval$
- 'PRINT exp$
- 'temppp$ = DWD(LEFT$(exp$, s - 2) + " ## " + eval$ + " ## " + MID$(exp$, e + 1))
- c = 0
- c = c + 1
- Evaluate_Expression$ = exp$
- 'PRINT exp$
- 'We should now have an expression with no () to deal with
- 'IF MID$(exp$, 2, 1) = "-" THEN exp$ = "0+" + MID$(exp$, 2)
- lowest = 0
- 'Look for first valid operator
- numset = 0
- '*** SPECIAL OPERATION RULESETS
- c = c + 1
- e = op + c
- c = 0
- c = c + 1
- c1 = c
- bad = 0
- c1 = c1 + 1
- bad = -1
- 'It's a negative sign and needs to count as part of our numbers
- s = op - c
- num(3) = "N" + EvaluateNumbers(OpOn, num())
- num(3) = EvaluateNumbers(OpOn, num())
- 'PRINT "*************"
- 'PRINT num(1), OName(OpOn), num(2), num(3), exp$
- 'PRINT exp$
- op = 0
- SUB Set_OrderOfOperations
- 'PL sets our priortity level. 1 is highest to 65535 for the lowest.
- 'I used a range here so I could add in new priority levels as needed.
- 'OName ended up becoming the name of our commands, as I modified things.... Go figure! LOL!
- 'Constants get evaluated first, with a Priority Level of 1
- i = i + 1: OName(i) = "C_UOF": PL(i) = 5 'convert to unsigned offset
- i = i + 1: OName(i) = "C_OF": PL(i) = 5 'convert to offset
- i = i + 1: OName(i) = "C_UBY": PL(i) = 5 'convert to unsigned byte
- i = i + 1: OName(i) = "C_BY": PL(i) = 5 'convert to byte
- i = i + 1: OName(i) = "C_UIN": PL(i) = 5 'convert to unsigned integer
- i = i + 1: OName(i) = "C_IN": PL(i) = 5 'convert to integer
- i = i + 1: OName(i) = "C_UIF": PL(i) = 5 'convert to unsigned int64
- i = i + 1: OName(i) = "C_IF": PL(i) = 5 'convert to int64
- i = i + 1: OName(i) = "C_ULO": PL(i) = 5 'convert to unsigned long
- i = i + 1: OName(i) = "C_LO": PL(i) = 5 'convert to long
- i = i + 1: OName(i) = "C_SI": PL(i) = 5 'convert to single
- i = i + 1: OName(i) = "C_FL": PL(i) = 5 'convert to float
- i = i + 1: OName(i) = "C_DO": PL(i) = 5 'convert to double
- i = i + 1: OName(i) = "C_UBI": PL(i) = 5 'convert to unsigned bit
- i = i + 1: OName(i) = "C_BI": PL(i) = 5 'convert to bit
- 'Then Functions with PL 10
- i = i + 1:: OName(i) = "_PI": PL(i) = 10
- i = i + 1: OName(i) = "_ACOS": PL(i) = 10
- i = i + 1: OName(i) = "_ASIN": PL(i) = 10
- i = i + 1: OName(i) = "_ARCSEC": PL(i) = 10
- i = i + 1: OName(i) = "_ARCCSC": PL(i) = 10
- i = i + 1: OName(i) = "_ARCCOT": PL(i) = 10
- i = i + 1: OName(i) = "_SECH": PL(i) = 10
- i = i + 1: OName(i) = "_CSCH": PL(i) = 10
- i = i + 1: OName(i) = "_COTH": PL(i) = 10
- i = i + 1: OName(i) = "COS": PL(i) = 10
- i = i + 1: OName(i) = "SIN": PL(i) = 10
- i = i + 1: OName(i) = "TAN": PL(i) = 10
- i = i + 1: OName(i) = "LOG": PL(i) = 10
- i = i + 1: OName(i) = "EXP": PL(i) = 10
- i = i + 1: OName(i) = "ATN": PL(i) = 10
- i = i + 1: OName(i) = "_D2R": PL(i) = 10
- i = i + 1: OName(i) = "_D2G": PL(i) = 10
- i = i + 1: OName(i) = "_R2D": PL(i) = 10
- i = i + 1: OName(i) = "_R2G": PL(i) = 10
- i = i + 1: OName(i) = "_G2D": PL(i) = 10
- i = i + 1: OName(i) = "_G2R": PL(i) = 10
- i = i + 1: OName(i) = "ABS": PL(i) = 10
- i = i + 1: OName(i) = "SGN": PL(i) = 10
- i = i + 1: OName(i) = "INT": PL(i) = 10
- i = i + 1: OName(i) = "_ROUND": PL(i) = 10
- i = i + 1: OName(i) = "_CEIL": PL(i) = 10
- i = i + 1: OName(i) = "FIX": PL(i) = 10
- i = i + 1: OName(i) = "_SEC": PL(i) = 10
- i = i + 1: OName(i) = "_CSC": PL(i) = 10
- i = i + 1: OName(i) = "_COT": PL(i) = 10
- i = i + 1: OName(i) = "ASC": PL(i) = 10
- i = i + 1: OName(i) = "CHR$": PL(i) = 10
- i = i + 1: OName(i) = "C_RG": PL(i) = 10 '_RGB32 converted
- i = i + 1: OName(i) = "C_RA": PL(i) = 10 '_RGBA32 converted
- i = i + 1: OName(i) = "_RGB": PL(i) = 10
- i = i + 1: OName(i) = "_RGBA": PL(i) = 10
- i = i + 1: OName(i) = "C_RX": PL(i) = 10 '_RED32 converted
- i = i + 1: OName(i) = "C_GR": PL(i) = 10 ' _GREEN32 converted
- i = i + 1: OName(i) = "C_BL": PL(i) = 10 '_BLUE32 converted
- i = i + 1: OName(i) = "C_AL": PL(i) = 10 '_ALPHA32 converted
- i = i + 1: OName(i) = "_RED": PL(i) = 10
- i = i + 1: OName(i) = "_GREEN": PL(i) = 10
- i = i + 1: OName(i) = "_BLUE": PL(i) = 10
- i = i + 1: OName(i) = "_ALPHA": PL(i) = 10
- 'Exponents with PL 20
- i = i + 1: OName(i) = "^": PL(i) = 20
- i = i + 1: OName(i) = "SQR": PL(i) = 20
- i = i + 1: OName(i) = "ROOT": PL(i) = 20
- 'Multiplication and Division PL 30
- i = i + 1: OName(i) = "*": PL(i) = 30
- i = i + 1: OName(i) = "/": PL(i) = 30
- 'Integer Division PL 40
- i = i + 1: OName(i) = "\": PL(i) = 40
- 'MOD PL 50
- i = i + 1: OName(i) = "MOD": PL(i) = 50
- 'Addition and Subtraction PL 60
- i = i + 1: OName(i) = "+": PL(i) = 60
- i = i + 1: OName(i) = "-": PL(i) = 60
- 'Relational Operators =, >, <, <>, <=, >= PL 70
- i = i + 1: OName(i) = "<>": PL(i) = 70 'These next three are just reversed symbols as an attempt to help process a common typo
- i = i + 1: OName(i) = "><": PL(i) = 70
- i = i + 1: OName(i) = "<=": PL(i) = 70
- i = i + 1: OName(i) = ">=": PL(i) = 70
- i = i + 1: OName(i) = "=<": PL(i) = 70 'I personally can never keep these things straight. Is it < = or = <...
- i = i + 1: OName(i) = "=>": PL(i) = 70 'Who knows, check both!
- i = i + 1: OName(i) = ">": PL(i) = 70
- i = i + 1: OName(i) = "<": PL(i) = 70
- i = i + 1: OName(i) = "=": PL(i) = 70
- 'Logical Operations PL 80+
- i = i + 1: OName(i) = "NOT": PL(i) = 80
- i = i + 1: OName(i) = "AND": PL(i) = 90
- i = i + 1: OName(i) = "OR": PL(i) = 100
- i = i + 1: OName(i) = "XOR": PL(i) = 110
- i = i + 1: OName(i) = "EQV": PL(i) = 120
- i = i + 1: OName(i) = "IMP": PL(i) = 130
- i = i + 1: OName(i) = ",": PL(i) = 1000
- 'PRINT "EVALNUM:"; OName(p), num(1), num(2)
- 'Note, these are special cases and work with the number BEFORE the command and not after
- CASE "_PI"
- n1 = 3.14159265358979323846264338327950288## 'Future compatable in case something ever stores extra digits for PI
- CASE "C_RG"
- n$ = num(2)
- ELSE 'we have more than three commas. I have no idea WTH type of values got passed here!
- CASE "C_RA"
- n$ = num(2)
- 'we have to have 3 commas; not more, not less.
- CASE "_RGB"
- n$ = num(2)
- 'we have to have 3 commas; not more, not less.
- CASE "_RGBA"
- n$ = num(2)
- 'we have to have 4 commas; not more, not less.
- n$ = num(2)
- n$ = num(2)
- CASE "ROOT"
- n3 = 1## / n2
- n1 = sign * (n1 ^ n3)
- CASE "\"
- EvaluateNumbers$ = "ERROR - Bad operation (We shouldn't see this)"
- CASE "-":
- 'PRINT "AFTEREVN:"; EvaluateNumbers$
- 'To deal with duplicate operators in our code.
- 'Such as -- becomes a +
- '++ becomes a +
- '+- becomes a -
- '-+ becomes a -
- t$ = exp$
- bad = 0
- 'PRINT "FIXING: "; t$
- DWD$ = t$
- PP_TypeMod(0) = "Initialized" 'Set so we don't do this section over and over, as we keep the values in shared memory.
- Set_OrderOfOperations 'Call this once to set up our proper order of operations and variable list
- 'and the below is a conversion list so symbols don't get cross confused.
- i = i + 1: PP_TypeMod(i) = "~`": PP_ConvertedMod(i) = "C_UBI" 'unsigned bit
- i = i + 1: PP_TypeMod(i) = "~%%": PP_ConvertedMod(i) = "C_UBY" 'unsigned byte
- i = i + 1: PP_TypeMod(i) = "~%&": PP_ConvertedMod(i) = "C_UOF" 'unsigned offset
- i = i + 1: PP_TypeMod(i) = "~%": PP_ConvertedMod(i) = "C_UIN" 'unsigned integer
- i = i + 1: PP_TypeMod(i) = "~&&": PP_ConvertedMod(i) = "C_UIF" 'unsigned integer64
- i = i + 1: PP_TypeMod(i) = "~&": PP_ConvertedMod(i) = "C_ULO" 'unsigned long
- i = i + 1: PP_TypeMod(i) = "`": PP_ConvertedMod(i) = "C_BI" 'bit
- i = i + 1: PP_TypeMod(i) = "%%": PP_ConvertedMod(i) = "C_BY" 'byte
- i = i + 1: PP_TypeMod(i) = "%&": PP_ConvertedMod(i) = "C_OF" 'offset
- i = i + 1: PP_TypeMod(i) = "%": PP_ConvertedMod(i) = "C_IN" 'integer
- i = i + 1: PP_TypeMod(i) = "&&": PP_ConvertedMod(i) = "C_IF" 'integer64
- i = i + 1: PP_TypeMod(i) = "&": PP_ConvertedMod(i) = "C_LO" 'long
- i = i + 1: PP_TypeMod(i) = "!": PP_ConvertedMod(i) = "C_SI" 'single
- i = i + 1: PP_TypeMod(i) = "##": PP_ConvertedMod(i) = "C_FL" 'float
- i = i + 1: PP_TypeMod(i) = "#": PP_ConvertedMod(i) = "C_DO" 'double
- i = i + 1: PP_TypeMod(i) = "_RGB32": PP_ConvertedMod(i) = "C_RG" 'rgb32
- i = i + 1: PP_TypeMod(i) = "_RGBA32": PP_ConvertedMod(i) = "C_RA" 'rgba32
- i = i + 1: PP_TypeMod(i) = "_RED32": PP_ConvertedMod(i) = "C_RX" 'red32
- i = i + 1: PP_TypeMod(i) = "_GREEN32": PP_ConvertedMod(i) = "C_GR" 'green32
- i = i + 1: PP_TypeMod(i) = "_BLUE32": PP_ConvertedMod(i) = "C_BL" 'blue32
- i = i + 1: PP_TypeMod(i) = "_ALPHA32": PP_ConvertedMod(i) = "C_AL" 'alpha32
- t$ = e$
- 'First strip all spaces
- t$ = ""
- 'ERROR CHECK by counting our brackets
- l = 0
- l = 0
- 'Modify so that NOT will process properly
- l = 0
- 'We need to work magic on the statement so it looks pretty.
- ' 1 + NOT 2 + 1 is actually processed as 1 + (NOT 2 + 1)
- 'Look for something not proper
- l = l + 3
- 'PRINT t$
- l = 0
- i = i + lo
- 'PRINT "L1:"; l1; "L"; l
- 'PRINT "Y$: "; TypeMod(j)
- 'PRINT "L$: "; l$
- 'PRINT "M$: "; m$
- 'PRINT "R$: "; r$
- t$ = l$ + m$ + r$ 'replacement routine for commands which might get confused with others, like _RGB and _RGB32
- 'the first 15 commands need to properly place the parenthesis around the value we want to convert.
- t$ = l$ + "(" + m$ + ")" + r$
- 'PRINT "T$: "; t$
- l = l + 2 + LEN(PP_TypeMod(j)) 'move forward from the length of the symbol we checked + the new "(" and ")"
- ' PRINT "HERE: "; t$
- 'Check for bad operators before a ( bracket
- l = 0
- good = 0
- 'PRINT "BEFORE: "; t$; l
- 'IF OName(i) = "C_SI" THEN PRINT "CONVERT TO SINGLE", m$
- 'PRINT t$; l
- l = l + 1
- 'Check for bad operators after a ) bracket
- l = 0
- good = 0
- l = l + 1
- 'Turn all &H (hex) numbers into decimal values for the program to process properly
- l = 0
- E = l + 1: finished = 0
- E = E + 1
- good = 0
- E = E - 1
- finished = -1
- 'Turn all &B (binary) numbers into decimal values for the program to process properly
- l = 0
- E = l + 1: finished = 0
- E = E + 1
- good = 0
- E = E - 1
- finished = -1
- 'PRINT "ALMOST:"; t$
- t$ = N2S(t$)
- 'PRINT "ALMOST2:"; t$
- VerifyString t$
- 'PRINT "Out of PreParse: "; e$
- e$ = t$
- 'ERROR CHECK for unrecognized operations
- j = 1
- good = 0
- 'PRINT "Before notation:"; exp$
- r&& = r&& + 1
- 'l$ = l$
- l$ = "0" + l$
- l$ = "0." + l$
- l$ = l$ + "0"
- N2S$ = sign$ + l$
- 'PRINT "After notation:"; N2S$
This doesn't have any of the $NOPREFIX code in it yet, as I was having issues before with just plugging it into QB64 and having it work as a replacement when I tried it. If this holds up here, as a stand-alone EXE, and nobody encounters any further glitches with it, I'll start with adding it into my personal repo first -- where's there's no $NOPREFIX in it. Then, once I've got it up and interacting with my version of QB64, I'll take what I learn from that testing and push it into the main development branch and get it up and going...
...and then I can add the $NOPREFIX code back in and get it to working with it properly. ;)
So, still several steps before this ends up inside QB64 replacing our existing process, but it's moving ever so slowly forward, towards that goal. :)
Post by: STxAxTIC on March 10, 2020, 07:00:27 am
Post by: SMcNeill on March 10, 2020, 03:23:22 pm
Can we get a bump and a Best Answer for this thread?
Sure. ;D
Post by: FellippeHeitor on March 10, 2020, 03:30:10 pm
Quote
...and then I can add the $NOPREFIX code back in and get it to working with it properly. ;)
So, still several steps before this ends up inside QB64 replacing our existing process, but it's moving ever so slowly forward, towards that goal. :)
Important to notice this has already been adapted to work with $NOPREFIX and has been added to QB64 before the v1.4 release.
Post by: STxAxTIC on March 10, 2020, 04:14:29 pm