PRINT "Formula to Evaluate => ";
eval$ = ""
eval$ = eval$ + i$
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
exp$
= "(" + t$
+ ")" 'Starting and finishing brackets for our parse routine.
c = 0
c = c + 1
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.
'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
CASE "0" TO "9", ".", "-" 'At this point, we should only have number values left.
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
IF J
= PL
(P
) THEN 'Priority levels match IF op
> 0 AND op
< lowest
THEN lowest
= op: OpOn
= P
IF OpOn
= 0 THEN EXIT DO 'We haven't gotten to the proper PL for this OP to be processed yet. numset = 0
'*** SPECIAL OPERATION RULESETS
IF OName
(OpOn
) = "-" THEN 'check for BOOLEAN operators before the - CASE "NOT", "XOR", "AND", "EQV", "IMP" EXIT DO 'Not an operator, it's a negative
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 CASE ELSE 'Not a valid digit, we found our separator c = c + 1
e = op + c
c = 0
c = 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
c1 = c1 + 1
CASE "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "." bad = -1
'It's a negative sign and needs to count as part of our numbers
CASE ELSE 'Not a valid digit, we found our separator 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 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)
EvaluateNumbers$
= "ERROR - Invalid comma (" + num
(1) + ")":
EXIT FUNCTION SELECT CASE OName
(p
) 'only certain commands should pass a comma value CASE "C_RG", "C_RA", "_RGB", "_RGBA", "_RED", "_GREEN", "C_BL", "_ALPHA" num
(2) = LEFT$(num
(2), l2
- 1)
SELECT CASE PL
(p
) 'divide up the work so we want do as much case checking 'Note, these are special cases and work with the number BEFORE the command and not after
n1 = 3.14159265358979323846264338327950288## 'Future compatable in case something ever stores extra digits for PI
n$ = num(2)
IF c1
= 0 THEN 'there's no comma in the command to parse. It's a grayscale value ELSEIF c2
= 0 THEN 'there's one comma and not 2. It's grayscale with alpha. ELSEIF c3
= 0 THEN 'there's two commas. It's _RGB values ELSEIF c4
= 0 THEN 'there's three commas. It's _RGBA values 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 n$ = num(2)
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$ = num(2)
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.
CASE 0 TO 2, 7 TO 13, 256, 32 'these are the good screen values EvaluateNumbers$
= "ERROR - Invalid Screen Mode (" + STR$(n4
) + ")":
EXIT FUNCTION n$ = num(2)
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.
CASE 0 TO 2, 7 TO 13, 256, 32 'these are the good screen values EvaluateNumbers$
= "ERROR - Invalid Screen Mode (" + STR$(n5
) + ")":
EXIT FUNCTION n1
= _RGBA(n
, n2
, n3
, n4
, t
) CASE "_RED", "_GREEN", "_BLUE", "_ALPHA" n$ = num(2)
IF c1
= 0 THEN EvaluateNumbers$
= "ERROR - " + OName
(p
) + " requires 2 parameters for Color, ScreenMode.":
EXIT FUNCTION IF c2
THEN EvaluateNumbers$
= "ERROR - " + OName
(p
) + " requires 2 parameters for Color, ScreenMode.":
EXIT FUNCTION CASE 0 TO 2, 7 TO 13, 256, 32 'these are the good screen values EvaluateNumbers$
= "ERROR - Invalid Screen Mode (" + STR$(n2
) + ")":
EXIT FUNCTION CASE "C_RX", "C_GR", "C_BL", "C_AL" n$ = 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))) n1
= VAL(num
(1)): n2
= VAL(num
(2)) n3 = 1## / n2
n1 = sign * (n1 ^ n3)
n1
= VAL(num
(1)) \
VAL(num
(2)) EvaluateNumbers$ = "ERROR - Bad operation (We shouldn't see this)"
n1
= VAL(num
(1)) - VAL(num
(2)) CASE 70 'Relational Operators =, >, <, <>, <=, >= CASE ELSE 'a value we haven't processed elsewhere
'PRINT "AFTEREVN:"; EvaluateNumbers$
'To deal with duplicate operators in our code.
'Such as -- becomes a +
'++ becomes a +
'+- becomes a -
'-+ becomes a -
bad = 0
'PRINT "FIXING: "; t$
DWD$ = t$
REDIM PP_TypeMod
(100) AS STRING, PP_ConvertedMod
(100) AS STRING 'Large enough to hold all values to begin with 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$ = ""
IF t$
= "" THEN e$
= "ERROR -- NULL string; nothing to evaluate":
EXIT SUB
'ERROR CHECK by counting our brackets
l = 0
l = 0
'Modify so that NOT will process properly
l = 0
l
= INSTR(l
+ 1, t$
, "NOT") '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") t$
= LEFT$(t$
, l
- 1) + "(" + MID$(t$
, l
, l1
- l
) + ")" + MID$(t$
, l
+ l1
- l
) l = l + 3
'PRINT t$
l = 0
l
= INSTR(l
+ 1, t$
, PP_TypeMod
(j
)) i
= 0: l1
= 0: l2
= 0: lo
= LEN(PP_TypeMod
(j
)) i = i + lo
'PRINT "L1:"; l1; "L"; l
m$
= MID$(t$
, l1
+ 1, l
- l1
- 1) r$
= PP_ConvertedMod
(j
) + MID$(t$
, l
+ lo
) '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
l
= INSTR(l
+ 1, t$
, "(") IF l
AND l
> 2 THEN 'Don't check the starting bracket; there's nothing before it. good = 0
'PRINT "BEFORE: "; t$; l
'IF OName(i) = "C_SI" THEN PRINT "CONVERT TO SINGLE", m$
IF m$
= OName
(i
) THEN good
= -1:
EXIT FOR 'We found an operator after our ), and it's not a CONST (like PI) 'PRINT t$; l
l = l + 1
'Check for bad operators after a ) bracket
l = 0
l
= INSTR(l
+ 1, t$
, ")") good = 0
m$
= MID$(t$
, l
+ 1, LEN(OName
(i
))) IF m$
= OName
(i
) THEN good
= -1:
EXIT FOR 'We found an operator after our ), and it's not a CONST (like PI 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
CASE "0" TO "9", "A" TO "F" 'All is good, our next digit is a number, continue to add to the hex$ good = 0
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) 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
CASE "0", "1" 'All is good, our next digit is a number, continue to add to the hex$ good = 0
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) E = E - 1
finished = -1
bin$
= MID$(t$
, l
+ 2, E
- l
- 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
CASE "0" TO "9", ".", "(", ")", ",": j
= j
+ 1 good = 0
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) IF NOT good
THEN t$
= "ERROR - Bad Operational value. (" + comp$
+ ")":
EXIT SUB
'PRINT "Before notation:"; exp$
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.
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 r&& = r&& + 1
CASE 0 'what the heck? We solved it already? 'l$ = l$
l$ = "0" + l$
l$ = "0." + l$
l$ = l$ + "0"
N2S$ = sign$ + l$
'PRINT "After notation:"; N2S$