Author Topic: Steve's Math Evaluator  (Read 1524 times)

0 Members and 1 Guest are viewing this topic.

This topic contains a post which is marked as Best Answer or Most Recent Update. Press here if you would like to see it.

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3623
    • Steve’s QB64 Archive Forum
Steve's Math Evaluator
« on: August 01, 2019, 12:58:22 PM »
Here's my little math evaluation routine, which everybody's been using for ages, even if they don't know they have!  :D

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 SUB

If 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$)

 
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline BSpinoza

  • Newbie
  • Posts: 69
Re: Steve's Math Evaluator
« Reply #1 on: September 02, 2019, 03:27:35 PM »
Thanks!
« Last Edit: September 04, 2019, 06:15:00 AM by BSpinoza »
"Ich sage euch: man muss noch Chaos in sich haben, um einen tanzenden Stern gebären zu können. Ich sage euch: ihr habt noch Chaos in euch." (from Friedrich Nietzsche: "Also sprach Zarathustra")

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3623
    • Steve’s QB64 Archive Forum
Re: Steve's Math Evaluator
« Reply #2 on: January 05, 2020, 12:05:59 PM »
An updated version of the code, for testing purposes as I expand it:

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....   
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline FellippeHeitor

  • QB64 Developer
  • Forum Resident
  • Posts: 3077
  • Let it go, this too shall pass.
    • QB64.org
Re: Steve's Math Evaluator
« Reply #3 on: January 05, 2020, 03:21:17 PM »
It's giving invalid comma count when passing alpha to _RGB32:
 


Line 335:

Code: Text: [Select]
  1. IF c3 THEN c4 = INSTR(c3 + 1, n$, ",") 'instead of IF c3 THEN c4 = INSTR(c2 + 1, n$, ",")
« Last Edit: January 05, 2020, 03:26:38 PM by FellippeHeitor »

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3623
    • Steve’s QB64 Archive Forum
Re: Steve's Math Evaluator
« Reply #4 on: January 05, 2020, 03:40:39 PM »
Corrected.

Code: QB64: [Select]
  1. REDIM SHARED OName(0) AS STRING 'Operation Name
  2. REDIM SHARED PL(0) AS INTEGER 'Priority Level
  3. DIM SHARED QuickReturn AS INTEGER
  4. Set_OrderOfOperations
  5.  
  6.     i$ = INPUT$(1)
  7.     CLS
  8.     SELECT CASE i$
  9.         CASE CHR$(8)
  10.             eval$ = LEFT$(eval$, LEN(eval$) - 1)
  11.         CASE CHR$(13)
  12.             eval$ = ""
  13.         CASE CHR$(27)
  14.             SYSTEM
  15.         CASE ELSE
  16.             eval$ = eval$ + i$
  17.     END SELECT
  18.     PRINT eval$
  19.     PRINT Evaluate_Expression(eval$)
  20.  
  21.  
  22. 'Steve Subs/Functins for _MATH support with CONST
  23. FUNCTION Evaluate_Expression$ (e$)
  24.     t$ = e$ 'So we preserve our original data, we parse a temp copy of it
  25.  
  26.     b = INSTR(UCASE$(e$), "EQL") 'take out assignment before the preparser sees it
  27.     IF b THEN t$ = MID$(e$, b + 3): var$ = UCASE$(LTRIM$(RTRIM$(MID$(e$, 1, b - 1))))
  28.  
  29.     QuickReturn = 0
  30.     PreParse t$
  31.  
  32.     IF QuickReturn THEN Evaluate_Expression$ = t$: EXIT FUNCTION
  33.  
  34.     IF LEFT$(t$, 5) = "ERROR" THEN Evaluate_Expression$ = t$: EXIT FUNCTION
  35.  
  36.     'Deal with brackets first
  37.     EXP$ = "(" + t$ + ")" 'Starting and finishing brackets for our parse routine.
  38.  
  39.     DO
  40.         Eval_E = INSTR(EXP$, ")")
  41.         IF Eval_E > 0 THEN
  42.             c = 0
  43.             DO UNTIL Eval_E - c <= 0
  44.                 c = c + 1
  45.                 IF Eval_E THEN
  46.                     IF MID$(EXP$, Eval_E - c, 1) = "(" THEN EXIT DO
  47.                 END IF
  48.             LOOP
  49.             s = Eval_E - c + 1
  50.             IF s < 1 THEN Evaluate_Expression$ = "ERROR -- BAD () Count": EXIT SUB
  51.             eval$ = " " + MID$(EXP$, s, Eval_E - s) + " " 'pad with a space before and after so the parser can pick up the values properly.
  52.             ParseExpression eval$
  53.  
  54.             eval$ = LTRIM$(RTRIM$(eval$))
  55.             IF LEFT$(eval$, 5) = "ERROR" THEN Evaluate_Expression$ = eval$: EXIT SUB
  56.             EXP$ = DWD(LEFT$(EXP$, s - 2) + eval$ + MID$(EXP$, Eval_E + 1))
  57.             IF MID$(EXP$, 1, 1) = "N" THEN MID$(EXP$, 1) = "-"
  58.  
  59.             temppp$ = DWD(LEFT$(EXP$, s - 2) + " ## " + eval$ + " ## " + MID$(EXP$, E + 1))
  60.         END IF
  61.     LOOP UNTIL Eval_E = 0
  62.     c = 0
  63.     DO
  64.         c = c + 1
  65.         SELECT CASE MID$(EXP$, c, 1)
  66.             CASE "0" TO "9", ".", "-" 'At this point, we should only have number values left.
  67.             CASE ELSE: Evaluate_Expression$ = "ERROR - Unknown Diagnosis: (" + EXP$ + ") ": EXIT SUB
  68.         END SELECT
  69.     LOOP UNTIL c >= LEN(EXP$)
  70.  
  71.     Evaluate_Expression$ = EXP$
  72.  
  73.  
  74.  
  75. SUB ParseExpression (EXP$)
  76.     DIM num(10) AS STRING
  77.     'PRINT exp$
  78.     'We should now have an expression with no () to deal with
  79.     IF MID$(EXP$, 2, 1) = "-" THEN EXP$ = "0+" + MID$(EXP$, 2)
  80.     FOR J = 1 TO 250
  81.         lowest = 0
  82.         DO UNTIL lowest = LEN(EXP$)
  83.             lowest = LEN(EXP$): OpOn = 0
  84.             FOR P = 1 TO UBOUND(OName)
  85.                 'Look for first valid operator
  86.                 IF J = PL(P) THEN 'Priority levels match
  87.                     IF LEFT$(EXP$, 1) = "-" THEN op = INSTR(2, EXP$, OName(P)) ELSE op = INSTR(EXP$, OName(P))
  88.                     IF op > 0 AND op < lowest THEN lowest = op: OpOn = P
  89.                 END IF
  90.             NEXT
  91.             IF OpOn = 0 THEN EXIT DO 'We haven't gotten to the proper PL for this OP to be processed yet.
  92.             IF LEFT$(EXP$, 1) = "-" THEN op = INSTR(2, EXP$, OName(OpOn)) ELSE op = INSTR(EXP$, OName(OpOn))
  93.             numset = 0
  94.  
  95.             '*** SPECIAL OPERATION RULESETS
  96.             IF OName(OpOn) = "-" THEN 'check for BOOLEAN operators before the -
  97.                 SELECT CASE MID$(EXP$, op - 3, 3)
  98.                     CASE "NOT", "XOR", "AND", "EQV", "IMP"
  99.                         EXIT DO 'Not an operator, it's a negative
  100.                 END SELECT
  101.                 IF MID$(EXP$, op - 3, 2) = "OR" THEN EXIT DO 'Not an operator, it's a negative
  102.             END IF
  103.  
  104.             IF op THEN
  105.                 c = LEN(OName(OpOn)) - 1
  106.                 DO
  107.                     SELECT CASE MID$(EXP$, op + c + 1, 1)
  108.                         CASE "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", ".", "N": numset = -1 'Valid digit
  109.                         CASE "-" 'We need to check if it's a minus or a negative
  110.                             IF OName(OpOn) = "_PI" OR numset THEN EXIT DO
  111.                         CASE ",": numset = 0
  112.                         CASE ELSE 'Not a valid digit, we found our separator
  113.                             EXIT DO
  114.                     END SELECT
  115.                     c = c + 1
  116.                 LOOP UNTIL op + c >= LEN(EXP$)
  117.                 E = op + c
  118.  
  119.                 c = 0
  120.                 DO
  121.                     c = c + 1
  122.                     SELECT CASE MID$(EXP$, op - c, 1)
  123.                         CASE "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", ".", "N" 'Valid digit
  124.                         CASE "-" 'We need to check if it's a minus or a negative
  125.                             c1 = c
  126.                             bad = 0
  127.                             DO
  128.                                 c1 = c1 + 1
  129.                                 SELECT CASE MID$(EXP$, op - c1, 1)
  130.                                     CASE "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "."
  131.                                         bad = -1
  132.                                         EXIT DO 'It's a minus sign
  133.                                     CASE ELSE
  134.                                         'It's a negative sign and needs to count as part of our numbers
  135.                                 END SELECT
  136.                             LOOP UNTIL op - c1 <= 0
  137.                             IF bad THEN EXIT DO 'We found our seperator
  138.                         CASE ELSE 'Not a valid digit, we found our separator
  139.                             EXIT DO
  140.                     END SELECT
  141.                 LOOP UNTIL op - c <= 0
  142.                 s = op - c
  143.                 num(1) = MID$(EXP$, s + 1, op - s - 1) 'Get our first number
  144.                 num(2) = MID$(EXP$, op + LEN(OName(OpOn)), E - op - LEN(OName(OpOn)) + 1) 'Get our second number
  145.                 IF MID$(num(1), 1, 1) = "N" THEN MID$(num(1), 1) = "-"
  146.                 IF MID$(num(2), 1, 1) = "N" THEN MID$(num(2), 1) = "-"
  147.                 num(3) = EvaluateNumbers(OpOn, num())
  148.                 IF MID$(num(3), 1, 1) = "-" THEN MID$(num(3), 1) = "N"
  149.                 'PRINT "*************"
  150.                 'PRINT num(1), OName(OpOn), num(2), num(3), exp$
  151.                 IF LEFT$(num(3), 5) = "ERROR" THEN EXP$ = num(3): EXIT SUB
  152.                 EXP$ = LTRIM$(N2S(DWD(LEFT$(EXP$, s) + RTRIM$(LTRIM$(num(3))) + MID$(EXP$, E + 1))))
  153.                 'PRINT exp$
  154.             END IF
  155.             op = 0
  156.         LOOP
  157.     NEXT
  158.  
  159.  
  160.  
  161.  
  162. SUB Set_OrderOfOperations
  163.     'PL sets our priortity level. 1 is highest to 65535 for the lowest.
  164.     'I used a range here so I could add in new priority levels as needed.
  165.     'OName ended up becoming the name of our commands, as I modified things.... Go figure!  LOL!
  166.  
  167.     'Constants get evaluated first, with a Priority Level of 1
  168.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_PI"
  169.     REDIM _PRESERVE PL(i): PL(i) = 1
  170.     '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...
  171.     'I'm putting it here for now, and if anyone knows someplace better for it in our order of operations, let me know.
  172.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "%"
  173.     REDIM _PRESERVE PL(i): PL(i) = 5
  174.     'Then Functions with PL 10
  175.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_ACOS"
  176.     REDIM _PRESERVE PL(i): PL(i) = 10
  177.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_ASIN"
  178.     REDIM _PRESERVE PL(i): PL(i) = 10
  179.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_ARCSEC"
  180.     REDIM _PRESERVE PL(i): PL(i) = 10
  181.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_ARCCSC"
  182.     REDIM _PRESERVE PL(i): PL(i) = 10
  183.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_ARCCOT"
  184.     REDIM _PRESERVE PL(i): PL(i) = 10
  185.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_SECH"
  186.     REDIM _PRESERVE PL(i): PL(i) = 10
  187.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_CSCH"
  188.     REDIM _PRESERVE PL(i): PL(i) = 10
  189.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_COTH"
  190.     REDIM _PRESERVE PL(i): PL(i) = 10
  191.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "COS"
  192.     REDIM _PRESERVE PL(i): PL(i) = 10
  193.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "SIN"
  194.     REDIM _PRESERVE PL(i): PL(i) = 10
  195.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "TAN"
  196.     REDIM _PRESERVE PL(i): PL(i) = 10
  197.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "LOG"
  198.     REDIM _PRESERVE PL(i): PL(i) = 10
  199.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "EXP"
  200.     REDIM _PRESERVE PL(i): PL(i) = 10
  201.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "ATN"
  202.     REDIM _PRESERVE PL(i): PL(i) = 10
  203.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_D2R"
  204.     REDIM _PRESERVE PL(i): PL(i) = 10
  205.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_D2G"
  206.     REDIM _PRESERVE PL(i): PL(i) = 10
  207.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_R2D"
  208.     REDIM _PRESERVE PL(i): PL(i) = 10
  209.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_R2G"
  210.     REDIM _PRESERVE PL(i): PL(i) = 10
  211.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_G2D"
  212.     REDIM _PRESERVE PL(i): PL(i) = 10
  213.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_G2R"
  214.     REDIM _PRESERVE PL(i): PL(i) = 10
  215.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "ABS"
  216.     REDIM _PRESERVE PL(i): PL(i) = 10
  217.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "SGN"
  218.     REDIM _PRESERVE PL(i): PL(i) = 10
  219.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "INT"
  220.     REDIM _PRESERVE PL(i): PL(i) = 10
  221.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_ROUND"
  222.     REDIM _PRESERVE PL(i): PL(i) = 10
  223.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "FIX"
  224.     REDIM _PRESERVE PL(i): PL(i) = 10
  225.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_SEC"
  226.     REDIM _PRESERVE PL(i): PL(i) = 10
  227.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_CSC"
  228.     REDIM _PRESERVE PL(i): PL(i) = 10
  229.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_COT"
  230.     REDIM _PRESERVE PL(i): PL(i) = 10
  231.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "ASC"
  232.     REDIM _PRESERVE PL(i): PL(i) = 10
  233.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "CHR$"
  234.     REDIM _PRESERVE PL(i): PL(i) = 10
  235.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_RGB32"
  236.     REDIM _PRESERVE PL(i): PL(i) = 10
  237.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_RGBA32"
  238.     REDIM _PRESERVE PL(i): PL(i) = 10
  239.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_RGB"
  240.     REDIM _PRESERVE PL(i): PL(i) = 10
  241.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_RGBA"
  242.     REDIM _PRESERVE PL(i): PL(i) = 10
  243.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_RED"
  244.     REDIM _PRESERVE PL(i): PL(i) = 10
  245.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_GREEN"
  246.     REDIM _PRESERVE PL(i): PL(i) = 10
  247.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_BLUE"
  248.     REDIM _PRESERVE PL(i): PL(i) = 10
  249.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_ALPHA"
  250.     REDIM _PRESERVE PL(i): PL(i) = 10
  251.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_RED32"
  252.     REDIM _PRESERVE PL(i): PL(i) = 10
  253.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_GREEN32"
  254.     REDIM _PRESERVE PL(i): PL(i) = 10
  255.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_BLUE32"
  256.     REDIM _PRESERVE PL(i): PL(i) = 10
  257.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_ALPHA32"
  258.     REDIM _PRESERVE PL(i): PL(i) = 10
  259.  
  260.     'Exponents with PL 20
  261.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "^"
  262.     REDIM _PRESERVE PL(i): PL(i) = 20
  263.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "SQR"
  264.     REDIM _PRESERVE PL(i): PL(i) = 20
  265.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "ROOT"
  266.     REDIM _PRESERVE PL(i): PL(i) = 20
  267.     'Multiplication and Division PL 30
  268.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "*"
  269.     REDIM _PRESERVE PL(i): PL(i) = 30
  270.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "/"
  271.     REDIM _PRESERVE PL(i): PL(i) = 30
  272.     'Integer Division PL 40
  273.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "\"
  274.     REDIM _PRESERVE PL(i): PL(i) = 40
  275.     'MOD PL 50
  276.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "MOD"
  277.     REDIM _PRESERVE PL(i): PL(i) = 50
  278.     'Addition and Subtraction PL 60
  279.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "+"
  280.     REDIM _PRESERVE PL(i): PL(i) = 60
  281.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "-"
  282.     REDIM _PRESERVE PL(i): PL(i) = 60
  283.  
  284.     'Relational Operators =, >, <, <>, <=, >=   PL 70
  285.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "<>"
  286.     REDIM _PRESERVE PL(i): PL(i) = 70
  287.     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
  288.     REDIM _PRESERVE PL(i): PL(i) = 70
  289.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "<="
  290.     REDIM _PRESERVE PL(i): PL(i) = 70
  291.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = ">="
  292.     REDIM _PRESERVE PL(i): PL(i) = 70
  293.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "=<" 'I personally can never keep these things straight.  Is it < = or = <...
  294.     REDIM _PRESERVE PL(i): PL(i) = 70
  295.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "=>" 'Who knows, check both!
  296.     REDIM _PRESERVE PL(i): PL(i) = 70
  297.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = ">"
  298.     REDIM _PRESERVE PL(i): PL(i) = 70
  299.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "<"
  300.     REDIM _PRESERVE PL(i): PL(i) = 70
  301.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "="
  302.     REDIM _PRESERVE PL(i): PL(i) = 70
  303.     'Logical Operations PL 80+
  304.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "NOT"
  305.     REDIM _PRESERVE PL(i): PL(i) = 80
  306.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "AND"
  307.     REDIM _PRESERVE PL(i): PL(i) = 90
  308.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "OR"
  309.     REDIM _PRESERVE PL(i): PL(i) = 100
  310.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "XOR"
  311.     REDIM _PRESERVE PL(i): PL(i) = 110
  312.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "EQV"
  313.     REDIM _PRESERVE PL(i): PL(i) = 120
  314.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "IMP"
  315.     REDIM _PRESERVE PL(i): PL(i) = 130
  316.  
  317.  
  318. FUNCTION EvaluateNumbers$ (p, num() AS STRING)
  319.     DIM n1 AS _FLOAT, n2 AS _FLOAT, n3 AS _FLOAT
  320.     IF INSTR(num(1), ",") THEN EvaluateNumbers$ = "ERROR - Invalid comma (" + num(1) + ")": EXIT FUNCTION
  321.     IF INSTR(num(2), ",") THEN
  322.         SELECT CASE OName(p) 'only certain commands should pass a comma value
  323.             CASE "_RGB32", "_RGBA32", "_RGB", "_RGBA", "_RED", "_GREEN", "_BLUE", "_ALPHA"
  324.             CASE ELSE
  325.                 EvaluateNumbers$ = "ERROR - Invalid comma (" + num(2) + ")": EXIT FUNCTION
  326.         END SELECT
  327.     END IF
  328.  
  329.     SELECT CASE PL(p) 'divide up the work so we want do as much case checking
  330.         CASE 10 'functions
  331.             SELECT CASE OName(p) 'Depending on our operator..
  332.                 CASE "_ACOS": n1 = _ACOS(VAL(num(2)))
  333.                 CASE "_ASIN": n1 = _ASIN(VAL(num(2)))
  334.                 CASE "_ARCSEC": n1 = _ARCSEC(VAL(num(2)))
  335.                 CASE "_ARCCSC": n1 = _ARCCSC(VAL(num(2)))
  336.                 CASE "_ARCCOT": n1 = _ARCCOT(VAL(num(2)))
  337.                 CASE "_SECH": n1 = _SECH(VAL(num(2)))
  338.                 CASE "_CSCH": n1 = _CSCH(VAL(num(2)))
  339.                 CASE "_COTH": n1 = _COTH(VAL(num(2)))
  340.                 CASE "_RGB32"
  341.                     n$ = num(2)
  342.                     IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null _RGB32": EXIT FUNCTION
  343.                     c1 = INSTR(n$, ",")
  344.                     IF c1 THEN c2 = INSTR(c1 + 1, n$, ",")
  345.                     IF c2 THEN c3 = INSTR(c2 + 1, n$, ",")
  346.                     IF c3 THEN c4 = INSTR(c3 + 1, n$, ",")
  347.                     IF c1 = 0 THEN 'there's no comma in the command to parse.  It's a grayscale value
  348.                         n = VAL(num(2))
  349.                         n1 = _RGB32(n, n, n)
  350.                     ELSEIF c2 = 0 THEN 'there's one comma and not 2.  It's grayscale with alpha.
  351.                         n = VAL(LEFT$(num(2), c1))
  352.                         n2 = VAL(MID$(num(2), c1 + 1))
  353.                         n1 = _RGBA32(n, n, n, n2)
  354.                     ELSEIF c3 = 0 THEN 'there's two commas.  It's _RGB values
  355.                         n = VAL(LEFT$(num(2), c1))
  356.                         n2 = VAL(MID$(num(2), c1 + 1))
  357.                         n3 = VAL(MID$(num(2), c2 + 1))
  358.                         n1 = _RGB32(n, n2, n3)
  359.                     ELSEIF c4 = 0 THEN 'there's three commas.  It's _RGBA values
  360.                         n = VAL(LEFT$(num(2), c1))
  361.                         n2 = VAL(MID$(num(2), c1 + 1))
  362.                         n3 = VAL(MID$(num(2), c2 + 1))
  363.                         n4 = VAL(MID$(num(2), c3 + 1))
  364.                         n1 = _RGBA32(n, n2, n3, n4)
  365.                     ELSE 'we have more than three commas.  I have no idea WTH type of values got passed here!
  366.                         EvaluateNumbers$ = "ERROR - Invalid comma count (" + num(2) + ")": EXIT FUNCTION
  367.                     END IF
  368.                 CASE "_RGBA32"
  369.                     n$ = num(2)
  370.                     IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null _RGBA32": EXIT FUNCTION
  371.                     c1 = INSTR(n$, ",")
  372.                     IF c1 THEN c2 = INSTR(c1 + 1, n$, ",")
  373.                     IF c2 THEN c3 = INSTR(c2 + 1, n$, ",")
  374.                     IF c3 THEN c4 = INSTR(c3 + 1, n$, ",")
  375.                     IF c3 = 0 OR c4 <> 0 THEN EvaluateNumbers$ = "ERROR - Invalid comma count (" + num(2) + ")": EXIT FUNCTION
  376.                     'we have to have 3 commas; not more, not less.
  377.                     n = VAL(LEFT$(num(2), c1))
  378.                     n2 = VAL(MID$(num(2), c1 + 1))
  379.                     n3 = VAL(MID$(num(2), c2 + 1))
  380.                     n4 = VAL(MID$(num(2), c3 + 1))
  381.                     n1 = _RGBA32(n, n2, n3, n4)
  382.                 CASE "_RGB"
  383.                     n$ = num(2)
  384.                     IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null _RGB": EXIT FUNCTION
  385.                     c1 = INSTR(n$, ",")
  386.                     IF c1 THEN c2 = INSTR(c1 + 1, n$, ",")
  387.                     IF c2 THEN c3 = INSTR(c2 + 1, n$, ",")
  388.                     IF c3 THEN c4 = INSTR(c3 + 1, n$, ",")
  389.                     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
  390.                     'we have to have 3 commas; not more, not less.
  391.                     n = VAL(LEFT$(num(2), c1))
  392.                     n2 = VAL(MID$(num(2), c1 + 1))
  393.                     n3 = VAL(MID$(num(2), c2 + 1))
  394.                     n4 = VAL(MID$(num(2), c3 + 1))
  395.                     SELECT CASE n4
  396.                         CASE 0 TO 2, 7 TO 13, 256, 32 'these are the good screen values
  397.                         CASE ELSE
  398.                             EvaluateNumbers$ = "ERROR - Invalid Screen Mode (" + STR$(n4) + ")": EXIT FUNCTION
  399.                     END SELECT
  400.                     t = _NEWIMAGE(1, 1, n4)
  401.                     n1 = _RGB(n, n2, n3, t)
  402.                     _FREEIMAGE t
  403.                 CASE "_RGBA"
  404.                     n$ = num(2)
  405.                     IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null _RGBA": EXIT FUNCTION
  406.                     c1 = INSTR(n$, ",")
  407.                     IF c1 THEN c2 = INSTR(c1 + 1, n$, ",")
  408.                     IF c2 THEN c3 = INSTR(c2 + 1, n$, ",")
  409.                     IF c3 THEN c4 = INSTR(c3 + 1, n$, ",")
  410.                     IF c4 THEN c5 = INSTR(c4 + 1, n$, ",")
  411.                     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
  412.                     'we have to have 4 commas; not more, not less.
  413.                     n = VAL(LEFT$(num(2), c1))
  414.                     n2 = VAL(MID$(num(2), c1 + 1))
  415.                     n3 = VAL(MID$(num(2), c2 + 1))
  416.                     n4 = VAL(MID$(num(2), c3 + 1))
  417.                     n5 = VAL(MID$(num(2), c4 + 1))
  418.                     SELECT CASE n5
  419.                         CASE 0 TO 2, 7 TO 13, 256, 32 'these are the good screen values
  420.                         CASE ELSE
  421.                             EvaluateNumbers$ = "ERROR - Invalid Screen Mode (" + STR$(n5) + ")": EXIT FUNCTION
  422.                     END SELECT
  423.                     t = _NEWIMAGE(1, 1, n5)
  424.                     n1 = _RGBA(n, n2, n3, n4, t)
  425.                     _FREEIMAGE t
  426.                 CASE "_RED", "_GREEN", "_BLUE", "_ALPHA"
  427.                     n$ = num(2)
  428.                     IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null " + OName(p): EXIT FUNCTION
  429.                     c1 = INSTR(n$, ",")
  430.                     IF c1 = 0 THEN EvaluateNumbers$ = "ERROR - " + OName(p) + " requires 2 parameters for Color, ScreenMode.": EXIT FUNCTION
  431.                     IF c1 THEN c2 = INSTR(c1 + 1, n$, ",")
  432.                     IF c2 THEN EvaluateNumbers$ = "ERROR - " + OName(p) + " requires 2 parameters for Color, ScreenMode.": EXIT FUNCTION
  433.                     n = VAL(LEFT$(num(2), c1))
  434.                     n2 = VAL(MID$(num(2), c1 + 1))
  435.                     SELECT CASE n2
  436.                         CASE 0 TO 2, 7 TO 13, 256, 32 'these are the good screen values
  437.                         CASE ELSE
  438.                             EvaluateNumbers$ = "ERROR - Invalid Screen Mode (" + STR$(n2) + ")": EXIT FUNCTION
  439.                     END SELECT
  440.                     t = _NEWIMAGE(1, 1, n4)
  441.                     SELECT CASE OName(p)
  442.                         CASE "_RED": n1 = _RED(n, t)
  443.                         CASE "_BLUE": n1 = _BLUE(n, t)
  444.                         CASE "_GREEN": n1 = _GREEN(n, t)
  445.                         CASE "_ALPHA": n1 = _ALPHA(n, t)
  446.                     END SELECT
  447.                     _FREEIMAGE t
  448.                 CASE "_RED32", "_GREEN32", "_BLUE32", "_ALPHA32"
  449.                     n$ = num(2)
  450.                     IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null " + OName(p): EXIT FUNCTION
  451.                     n = VAL(num(2))
  452.                     SELECT CASE OName(p)
  453.                         CASE "_RED32": n1 = _RED32(n)
  454.                         CASE "_BLUE32": n1 = _BLUE32(n)
  455.                         CASE "_GREEN32": n1 = _GREEN32(n)
  456.                         CASE "_ALPHA32": n1 = _ALPHA32(n)
  457.                     END SELECT
  458.                 CASE "COS": n1 = COS(VAL(num(2)))
  459.                 CASE "SIN": n1 = SIN(VAL(num(2)))
  460.                 CASE "TAN": n1 = TAN(VAL(num(2)))
  461.                 CASE "LOG": n1 = LOG(VAL(num(2)))
  462.                 CASE "EXP": n1 = EXP(VAL(num(2)))
  463.                 CASE "ATN": n1 = ATN(VAL(num(2)))
  464.                 CASE "_D2R": n1 = 0.0174532925 * (VAL(num(2)))
  465.                 CASE "_D2G": n1 = 1.1111111111 * (VAL(num(2)))
  466.                 CASE "_R2D": n1 = 57.2957795 * (VAL(num(2)))
  467.                 CASE "_R2G": n1 = 0.015707963 * (VAL(num(2)))
  468.                 CASE "_G2D": n1 = 0.9 * (VAL(num(2)))
  469.                 CASE "_G2R": n1 = 63.661977237 * (VAL(num(2)))
  470.                 CASE "ABS": n1 = ABS(VAL(num(2)))
  471.                 CASE "SGN": n1 = SGN(VAL(num(2)))
  472.                 CASE "INT": n1 = INT(VAL(num(2)))
  473.                 CASE "_ROUND": n1 = _ROUND(VAL(num(2)))
  474.                 CASE "FIX": n1 = FIX(VAL(num(2)))
  475.                 CASE "_SEC": n1 = _SEC(VAL(num(2)))
  476.                 CASE "_CSC": n1 = _CSC(VAL(num(2)))
  477.                 CASE "_COT": n1 = _COT(VAL(num(2)))
  478.             END SELECT
  479.         CASE 20 TO 60 'Math Operators
  480.             SELECT CASE OName(p) 'Depending on our operator..
  481.                 CASE "^": n1 = VAL(num(1)) ^ VAL(num(2))
  482.                 CASE "SQR": n1 = SQR(VAL(num(2)))
  483.                 CASE "ROOT"
  484.                     n1 = VAL(num(1)): n2 = VAL(num(2))
  485.                     IF n2 = 1 THEN EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1))): EXIT FUNCTION
  486.                     IF n1 < 0 AND n2 >= 1 THEN sign = -1: n1 = -n1 ELSE sign = 1
  487.                     n3 = 1## / n2
  488.                     IF n3 <> INT(n3) AND n2 < 1 THEN sign = SGN(n1): n1 = ABS(n1)
  489.                     n1 = sign * (n1 ^ n3)
  490.                 CASE "*": n1 = VAL(num(1)) * VAL(num(2))
  491.                 CASE "/": n1 = VAL(num(1)) / VAL(num(2))
  492.                 CASE "\"
  493.                     IF VAL(num(2)) <> 0 THEN
  494.                         n1 = VAL(num(1)) \ VAL(num(2))
  495.                     ELSE
  496.                         EvaluateNumbers$ = "ERROR - Bad operation (We shouldn't see this)"
  497.                         EXIT FUNCTION
  498.                     END IF
  499.                 CASE "MOD": n1 = VAL(num(1)) MOD VAL(num(2))
  500.                 CASE "+": n1 = VAL(num(1)) + VAL(num(2))
  501.                 CASE "-": n1 = VAL(num(1)) - VAL(num(2))
  502.             END SELECT
  503.         CASE 70 'Relational Operators =, >, <, <>, <=, >=
  504.             SELECT CASE OName(p) 'Depending on our operator..
  505.                 CASE "=": n1 = VAL(num(1)) = VAL(num(2))
  506.                 CASE ">": n1 = VAL(num(1)) > VAL(num(2))
  507.                 CASE "<": n1 = VAL(num(1)) < VAL(num(2))
  508.                 CASE "<>", "><": n1 = VAL(num(1)) <> VAL(num(2))
  509.                 CASE "<=", "=<": n1 = VAL(num(1)) <= VAL(num(2))
  510.                 CASE ">=", "=>": n1 = VAL(num(1)) >= VAL(num(2))
  511.             END SELECT
  512.         CASE ELSE 'a value we haven't processed elsewhere
  513.             SELECT CASE OName(p) 'Depending on our operator..
  514.                 CASE "_PI": n1 = 3.14159265358979323846264338327950288## 'Future compatable in case something ever stores extra digits for PI
  515.                 CASE "%": n1 = (VAL(num(1))) / 100 'Note percent is a special case and works with the number BEFORE the % command and not after
  516.                 CASE "NOT": n1 = NOT VAL(num(2))
  517.                 CASE "AND": n1 = VAL(num(1)) AND VAL(num(2))
  518.                 CASE "OR": n1 = VAL(num(1)) OR VAL(num(2))
  519.                 CASE "XOR": n1 = VAL(num(1)) XOR VAL(num(2))
  520.                 CASE "EQV": n1 = VAL(num(1)) EQV VAL(num(2))
  521.                 CASE "IMP": n1 = VAL(num(1)) IMP VAL(num(2))
  522.             END SELECT
  523.     END SELECT
  524.  
  525.     EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1)))
  526.  
  527. FUNCTION DWD$ (EXP$) 'Deal With Duplicates
  528.     'To deal with duplicate operators in our code.
  529.     'Such as --  becomes a +
  530.     '++ becomes a +
  531.     '+- becomes a -
  532.     '-+ becomes a -
  533.     t$ = EXP$
  534.     DO
  535.         bad = 0
  536.         DO
  537.             l = INSTR(t$, "++")
  538.             IF l THEN t$ = LEFT$(t$, l - 1) + "+" + MID$(t$, l + 2): bad = -1
  539.         LOOP UNTIL l = 0
  540.         DO
  541.             l = INSTR(t$, "+-")
  542.             IF l THEN t$ = LEFT$(t$, l - 1) + "-" + MID$(t$, l + 2): bad = -1
  543.         LOOP UNTIL l = 0
  544.         DO
  545.             l = INSTR(t$, "-+")
  546.             IF l THEN t$ = LEFT$(t$, l - 1) + "-" + MID$(t$, l + 2): bad = -1
  547.         LOOP UNTIL l = 0
  548.         DO
  549.             l = INSTR(t$, "--")
  550.             IF l THEN t$ = LEFT$(t$, l - 1) + "+" + MID$(t$, l + 2): bad = -1
  551.         LOOP UNTIL l = 0
  552.     LOOP UNTIL NOT bad
  553.     DWD$ = t$
  554.     VerifyString t$
  555.  
  556. SUB PreParse (e$)
  557.     DIM f AS _FLOAT
  558.  
  559.     t$ = e$
  560.  
  561.     'First strip all spaces
  562.     t$ = ""
  563.     FOR i = 1 TO LEN(e$)
  564.         IF MID$(e$, i, 1) <> " " THEN t$ = t$ + MID$(e$, i, 1)
  565.     NEXT
  566.  
  567.     t$ = UCASE$(t$)
  568.     IF t$ = "" THEN e$ = "ERROR -- NULL string; nothing to evaluate": EXIT SUB
  569.  
  570.     'ERROR CHECK by counting our brackets
  571.     l = 0
  572.     DO
  573.         l = INSTR(l + 1, t$, "("): IF l THEN c = c + 1
  574.     LOOP UNTIL l = 0
  575.     l = 0
  576.     DO
  577.         l = INSTR(l + 1, t$, ")"): IF l THEN c1 = c1 + 1
  578.     LOOP UNTIL l = 0
  579.     IF c <> c1 THEN e$ = "ERROR -- Bad Parenthesis:" + STR$(c) + "( vs" + STR$(c1) + ")": EXIT SUB
  580.  
  581.     'Modify so that NOT will process properly
  582.     l = 0
  583.     DO
  584.         l = INSTR(l + 1, t$, "NOT")
  585.         IF l THEN
  586.             'We need to work magic on the statement so it looks pretty.
  587.             ' 1 + NOT 2 + 1 is actually processed as 1 + (NOT 2 + 1)
  588.             'Look for something not proper
  589.             l1 = INSTR(l + 1, t$, "AND")
  590.             IF l1 = 0 OR (INSTR(l + 1, t$, "OR") > 0 AND INSTR(l + 1, t$, "OR") < l1) THEN l1 = INSTR(l + 1, t$, "OR")
  591.             IF l1 = 0 OR (INSTR(l + 1, t$, "XOR") > 0 AND INSTR(l + 1, t$, "XOR") < l1) THEN l1 = INSTR(l + 1, t$, "XOR")
  592.             IF l1 = 0 OR (INSTR(l + 1, t$, "EQV") > 0 AND INSTR(l + 1, t$, "EQV") < l1) THEN l1 = INSTR(l + 1, t$, "EQV")
  593.             IF l1 = 0 OR (INSTR(l + 1, t$, "IMP") > 0 AND INSTR(l + 1, t$, "IMP") < l1) THEN l1 = INSTR(l + 1, t$, "IMP")
  594.             IF l1 = 0 THEN l1 = LEN(t$) + 1
  595.             t$ = LEFT$(t$, l - 1) + "(" + MID$(t$, l, l1 - l) + ")" + MID$(t$, l + l1 - l)
  596.             l = l + 3
  597.             'PRINT t$
  598.         END IF
  599.     LOOP UNTIL l = 0
  600.  
  601.     'Check for bad operators before a ( bracket
  602.     l = 0
  603.     DO
  604.         l = INSTR(l + 1, t$, "(")
  605.         IF l AND l > 2 THEN 'Don't check the starting bracket; there's nothing before it.
  606.             good = 0
  607.             FOR i = 1 TO UBOUND(OName)
  608.                 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)
  609.             NEXT
  610.             IF NOT good THEN e$ = "ERROR - Improper operations before (.": EXIT SUB
  611.             l = l + 1
  612.         END IF
  613.     LOOP UNTIL l = 0
  614.  
  615.     'Check for bad operators after a ) bracket
  616.     l = 0
  617.     DO
  618.         l = INSTR(l + 1, t$, ")")
  619.         IF l AND l < LEN(t$) THEN
  620.             good = 0
  621.             FOR i = 1 TO UBOUND(OName)
  622.                 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)
  623.             NEXT
  624.             IF MID$(t$, l + 1, 1) = ")" THEN good = -1
  625.             IF NOT good THEN e$ = "ERROR - Improper operations after ).": EXIT SUB
  626.             l = l + 1
  627.         END IF
  628.     LOOP UNTIL l = 0 OR l = LEN(t$) 'last symbol is a bracket
  629.  
  630.     'Turn all &H (hex) numbers into decimal values for the program to process properly
  631.     l = 0
  632.     DO
  633.         l = INSTR(t$, "&H")
  634.         IF l THEN
  635.             E = l + 1: finished = 0
  636.             DO
  637.                 E = E + 1
  638.                 comp$ = MID$(t$, E, 1)
  639.                 SELECT CASE comp$
  640.                     CASE "0" TO "9", "A" TO "F" 'All is good, our next digit is a number, continue to add to the hex$
  641.                     CASE ELSE
  642.                         good = 0
  643.                         FOR i = 1 TO UBOUND(OName)
  644.                             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)
  645.                         NEXT
  646.                         IF NOT good THEN e$ = "ERROR - Improper &H value. (" + comp$ + ")": EXIT SUB
  647.                         E = E - 1
  648.                         finished = -1
  649.                 END SELECT
  650.             LOOP UNTIL finished OR E = LEN(t$)
  651.             t$ = LEFT$(t$, l - 1) + LTRIM$(RTRIM$(STR$(VAL(MID$(t$, l, E - l + 1))))) + MID$(t$, E + 1)
  652.         END IF
  653.     LOOP UNTIL l = 0
  654.  
  655.     'Turn all &B (binary) numbers into decimal values for the program to process properly
  656.     l = 0
  657.     DO
  658.         l = INSTR(t$, "&B")
  659.         IF l THEN
  660.             E = l + 1: finished = 0
  661.             DO
  662.                 E = E + 1
  663.                 comp$ = MID$(t$, E, 1)
  664.                 SELECT CASE comp$
  665.                     CASE "0", "1" 'All is good, our next digit is a number, continue to add to the hex$
  666.                     CASE ELSE
  667.                         good = 0
  668.                         FOR i = 1 TO UBOUND(OName)
  669.                             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)
  670.                         NEXT
  671.                         IF NOT good THEN e$ = "ERROR - Improper &B value. (" + comp$ + ")": EXIT SUB
  672.                         E = E - 1
  673.                         finished = -1
  674.                 END SELECT
  675.             LOOP UNTIL finished OR E = LEN(t$)
  676.             bin$ = MID$(t$, l + 2, E - l - 1)
  677.             FOR i = 1 TO LEN(bin$)
  678.                 IF MID$(bin$, i, 1) = "1" THEN f = f + 2 ^ (LEN(bin$) - i)
  679.             NEXT
  680.             t$ = LEFT$(t$, l - 1) + LTRIM$(RTRIM$(STR$(f))) + MID$(t$, E + 1)
  681.         END IF
  682.     LOOP UNTIL l = 0
  683.  
  684.     t$ = N2S(t$)
  685.     VerifyString t$
  686.  
  687.     e$ = t$
  688.  
  689.  
  690.  
  691. SUB VerifyString (t$)
  692.     'ERROR CHECK for unrecognized operations
  693.     j = 1
  694.     DO
  695.         comp$ = MID$(t$, j, 1)
  696.         SELECT CASE comp$
  697.             CASE "0" TO "9", ".", "(", ")", ",": j = j + 1
  698.             CASE ELSE
  699.                 good = 0
  700.                 FOR i = 1 TO UBOUND(OName)
  701.                     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)
  702.                 NEXT
  703.                 IF NOT good THEN t$ = "ERROR - Bad Operational value. (" + comp$ + ")": EXIT SUB
  704.                 j = j + LEN(OName(i))
  705.         END SELECT
  706.     LOOP UNTIL j > LEN(t$)
  707.  
  708. FUNCTION N2S$ (EXP$) 'scientific Notation to String
  709.     t$ = LTRIM$(RTRIM$(EXP$))
  710.     IF LEFT$(t$, 1) = "-" THEN sign$ = "-": t$ = MID$(t$, 2)
  711.  
  712.     dp = INSTR(t$, "D+"): dm = INSTR(t$, "D-")
  713.     ep = INSTR(t$, "E+"): em = INSTR(t$, "E-")
  714.     check1 = SGN(dp) + SGN(dm) + SGN(ep) + SGN(em)
  715.     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!
  716.  
  717.     SELECT CASE l 'l now tells us where the SN starts at.
  718.         CASE IS < dp: l = dp
  719.         CASE IS < dm: l = dm
  720.         CASE IS < ep: l = ep
  721.         CASE IS < em: l = em
  722.     END SELECT
  723.  
  724.     l$ = LEFT$(t$, l - 1) 'The left of the SN
  725.     r$ = MID$(t$, l + 1): r&& = VAL(r$) 'The right of the SN, turned into a workable long
  726.  
  727.  
  728.     IF INSTR(l$, ".") THEN 'Location of the decimal, if any
  729.         IF r&& > 0 THEN
  730.             r&& = r&& - LEN(l$) + 2
  731.         ELSE
  732.             r&& = r&& + 1
  733.         END IF
  734.         l$ = LEFT$(l$, 1) + MID$(l$, 3)
  735.     END IF
  736.  
  737.     SELECT CASE r&&
  738.         CASE 0 'what the heck? We solved it already?
  739.             'l$ = l$
  740.         CASE IS < 0
  741.             FOR i = 1 TO -r&&
  742.                 l$ = "0" + l$
  743.             NEXT
  744.             l$ = "0." + l$
  745.         CASE ELSE
  746.             FOR i = 1 TO r&&
  747.                 l$ = l$ + "0"
  748.             NEXT
  749.     END SELECT
  750.  
  751.     N2S$ = sign$ + l$
  752.  

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.  ;)
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1062
  • TOXIC
Re: Steve's Math Evaluator
« Reply #5 on: January 05, 2020, 04:17:36 PM »
I always enjoyed playing with this. My favorite interaction (with result) is

Code: QB64: [Select]
  1. ((6=6)-(5=5))^((4=4)-(3=3))
  2. 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]
  1. -(COS(3))
  2. 0

Code: QB64: [Select]
  1. -(-3+2)
  2. 0

« Last Edit: January 05, 2020, 04:27:07 PM by STxAxTIC »
TOXIC

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3623
    • Steve’s QB64 Archive Forum
Re: Steve's Math Evaluator
« Reply #6 on: January 05, 2020, 05:03:07 PM »
I always enjoyed playing with this. My favorite interaction (with result) is

Code: QB64: [Select]
  1. ((6=6)-(5=5))^((4=4)-(3=3))
  2. 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]
  1. -(COS(3))
  2. 0

Code: QB64: [Select]
  1. -(-3+2)
  2. 0

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.
« Last Edit: January 05, 2020, 05:09:17 PM by SMcNeill »
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline FellippeHeitor

  • QB64 Developer
  • Forum Resident
  • Posts: 3077
  • Let it go, this too shall pass.
    • QB64.org
Re: Steve's Math Evaluator
« Reply #7 on: January 05, 2020, 08:49:41 PM »
_PI should take parameters like the function does (multipliers), like _PI(.5), _PI(2).

Offline Pete

  • Forum Resident
  • Posts: 2576
  • Cuz I sez so, varmint!
Re: Steve's Math Evaluator
« Reply #8 on: January 05, 2020, 09:30:22 PM »
You fellers er talkin' over my head agin... And I'z be a wearing my hat, too!

- Sam

Offline FellippeHeitor

  • QB64 Developer
  • Forum Resident
  • Posts: 3077
  • Let it go, this too shall pass.
    • QB64.org
Re: Steve's Math Evaluator
« Reply #9 on: January 05, 2020, 09:46:13 PM »
_CEIL is missing.

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3623
    • Steve’s QB64 Archive Forum
Re: Steve's Math Evaluator
« Reply #10 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]
  1. SCREEN _NEWIMAGE(1024, 720, 32)
  2. REDIM SHARED OName(0) AS STRING 'Operation Name
  3. REDIM SHARED PL(0) AS INTEGER 'Priority Level
  4. DIM SHARED QuickReturn AS INTEGER
  5. Set_OrderOfOperations
  6.  
  7.     i$ = INPUT$(1)
  8.     CLS
  9.     SELECT CASE i$
  10.         CASE CHR$(8)
  11.             eval$ = LEFT$(eval$, LEN(eval$) - 1)
  12.         CASE CHR$(13)
  13.             eval$ = ""
  14.         CASE CHR$(27)
  15.             SYSTEM
  16.         CASE ELSE
  17.             eval$ = eval$ + i$
  18.     END SELECT
  19.     PRINT eval$
  20.     PRINT Evaluate_Expression(eval$)
  21.  
  22.  
  23. 'Steve Subs/Functins for _MATH support with CONST
  24. FUNCTION Evaluate_Expression$ (e$)
  25.     t$ = e$ 'So we preserve our original data, we parse a temp copy of it
  26.  
  27.     b = INSTR(UCASE$(e$), "EQL") 'take out assignment before the preparser sees it
  28.     IF b THEN t$ = MID$(e$, b + 3): var$ = UCASE$(LTRIM$(RTRIM$(MID$(e$, 1, b - 1))))
  29.  
  30.     QuickReturn = 0
  31.     PreParse t$
  32.  
  33.     IF QuickReturn THEN Evaluate_Expression$ = t$: EXIT FUNCTION
  34.  
  35.     IF LEFT$(t$, 5) = "ERROR" THEN Evaluate_Expression$ = t$: EXIT FUNCTION
  36.  
  37.     'Deal with brackets first
  38.     EXP$ = "(" + t$ + ")" 'Starting and finishing brackets for our parse routine.
  39.  
  40.     DO
  41.         Eval_E = INSTR(EXP$, ")")
  42.         IF Eval_E > 0 THEN
  43.             c = 0
  44.             DO UNTIL Eval_E - c <= 0
  45.                 c = c + 1
  46.                 IF Eval_E THEN
  47.                     IF MID$(EXP$, Eval_E - c, 1) = "(" THEN EXIT DO
  48.                 END IF
  49.             LOOP
  50.             s = Eval_E - c + 1
  51.             IF s < 1 THEN Evaluate_Expression$ = "ERROR -- BAD () Count": EXIT SUB
  52.             eval$ = " " + MID$(EXP$, s, Eval_E - s) + " " 'pad with a space before and after so the parser can pick up the values properly.
  53.             ParseExpression eval$
  54.  
  55.             eval$ = LTRIM$(RTRIM$(eval$))
  56.             IF LEFT$(eval$, 5) = "ERROR" THEN Evaluate_Expression$ = eval$: EXIT SUB
  57.             EXP$ = DWD(LEFT$(EXP$, s - 2) + eval$ + MID$(EXP$, Eval_E + 1))
  58.             IF MID$(EXP$, 1, 1) = "N" THEN MID$(EXP$, 1) = "-"
  59.  
  60.             temppp$ = DWD(LEFT$(EXP$, s - 2) + " ## " + eval$ + " ## " + MID$(EXP$, E + 1))
  61.         END IF
  62.     LOOP UNTIL Eval_E = 0
  63.     c = 0
  64.     DO
  65.         c = c + 1
  66.         SELECT CASE MID$(EXP$, c, 1)
  67.             CASE "0" TO "9", ".", "-" 'At this point, we should only have number values left.
  68.             CASE ELSE: Evaluate_Expression$ = "ERROR - Unknown Diagnosis: (" + EXP$ + ") ": EXIT SUB
  69.         END SELECT
  70.     LOOP UNTIL c >= LEN(EXP$)
  71.  
  72.     Evaluate_Expression$ = EXP$
  73.  
  74.  
  75.  
  76. SUB ParseExpression (EXP$)
  77.     DIM num(10) AS STRING
  78.     'PRINT exp$
  79.     'We should now have an expression with no () to deal with
  80.     IF MID$(EXP$, 2, 1) = "-" THEN EXP$ = "0+" + MID$(EXP$, 2)
  81.     FOR J = 1 TO 250
  82.         lowest = 0
  83.         DO UNTIL lowest = LEN(EXP$)
  84.             lowest = LEN(EXP$): OpOn = 0
  85.             FOR P = 1 TO UBOUND(OName)
  86.                 'Look for first valid operator
  87.                 IF J = PL(P) THEN 'Priority levels match
  88.                     IF LEFT$(EXP$, 1) = "-" THEN op = INSTR(2, EXP$, OName(P)) ELSE op = INSTR(EXP$, OName(P))
  89.                     IF op > 0 AND op < lowest THEN lowest = op: OpOn = P
  90.                 END IF
  91.             NEXT
  92.             IF OpOn = 0 THEN EXIT DO 'We haven't gotten to the proper PL for this OP to be processed yet.
  93.             IF LEFT$(EXP$, 1) = "-" THEN op = INSTR(2, EXP$, OName(OpOn)) ELSE op = INSTR(EXP$, OName(OpOn))
  94.             numset = 0
  95.  
  96.             '*** SPECIAL OPERATION RULESETS
  97.             IF OName(OpOn) = "-" THEN 'check for BOOLEAN operators before the -
  98.                 SELECT CASE MID$(EXP$, op - 3, 3)
  99.                     CASE "NOT", "XOR", "AND", "EQV", "IMP"
  100.                         EXIT DO 'Not an operator, it's a negative
  101.                 END SELECT
  102.                 IF MID$(EXP$, op - 3, 2) = "OR" THEN EXIT DO 'Not an operator, it's a negative
  103.             END IF
  104.  
  105.             IF op THEN
  106.                 c = LEN(OName(OpOn)) - 1
  107.                 DO
  108.                     SELECT CASE MID$(EXP$, op + c + 1, 1)
  109.                         CASE "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", ".", "N": numset = -1 'Valid digit
  110.                         CASE "-" 'We need to check if it's a minus or a negative
  111.                             IF OName(OpOn) = "_PI" OR numset THEN EXIT DO
  112.                         CASE ",": numset = 0
  113.                         CASE ELSE 'Not a valid digit, we found our separator
  114.                             EXIT DO
  115.                     END SELECT
  116.                     c = c + 1
  117.                 LOOP UNTIL op + c >= LEN(EXP$)
  118.                 E = op + c
  119.  
  120.                 c = 0
  121.                 DO
  122.                     c = c + 1
  123.                     SELECT CASE MID$(EXP$, op - c, 1)
  124.                         CASE "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", ".", "N" 'Valid digit
  125.                         CASE "-" 'We need to check if it's a minus or a negative
  126.                             c1 = c
  127.                             bad = 0
  128.                             DO
  129.                                 c1 = c1 + 1
  130.                                 SELECT CASE MID$(EXP$, op - c1, 1)
  131.                                     CASE "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "."
  132.                                         bad = -1
  133.                                         EXIT DO 'It's a minus sign
  134.                                     CASE ELSE
  135.                                         'It's a negative sign and needs to count as part of our numbers
  136.                                 END SELECT
  137.                             LOOP UNTIL op - c1 <= 0
  138.                             IF bad THEN EXIT DO 'We found our seperator
  139.                         CASE ELSE 'Not a valid digit, we found our separator
  140.                             EXIT DO
  141.                     END SELECT
  142.                 LOOP UNTIL op - c <= 0
  143.                 s = op - c
  144.                 num(1) = MID$(EXP$, s + 1, op - s - 1) 'Get our first number
  145.                 num(2) = MID$(EXP$, op + LEN(OName(OpOn)), E - op - LEN(OName(OpOn)) + 1) 'Get our second number
  146.                 IF MID$(num(1), 1, 1) = "N" THEN MID$(num(1), 1) = "-"
  147.                 IF MID$(num(2), 1, 1) = "N" THEN MID$(num(2), 1) = "-"
  148.                 num(3) = EvaluateNumbers(OpOn, num())
  149.                 IF MID$(num(3), 1, 1) = "-" THEN MID$(num(3), 1) = "N"
  150.                 'PRINT "*************"
  151.                 'PRINT num(1), OName(OpOn), num(2), num(3), exp$
  152.                 IF LEFT$(num(3), 5) = "ERROR" THEN EXP$ = num(3): EXIT SUB
  153.                 EXP$ = LTRIM$(N2S(DWD(LEFT$(EXP$, s) + RTRIM$(LTRIM$(num(3))) + MID$(EXP$, E + 1))))
  154.                 'PRINT exp$
  155.             END IF
  156.             op = 0
  157.         LOOP
  158.     NEXT
  159.  
  160.  
  161.  
  162.  
  163. SUB Set_OrderOfOperations
  164.     'PL sets our priortity level. 1 is highest to 65535 for the lowest.
  165.     'I used a range here so I could add in new priority levels as needed.
  166.     'OName ended up becoming the name of our commands, as I modified things.... Go figure!  LOL!
  167.  
  168.     'Constants get evaluated first, with a Priority Level of 1
  169.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_PI"
  170.     REDIM _PRESERVE PL(i): PL(i) = 10
  171.     '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...
  172.     'I'm putting it here for now, and if anyone knows someplace better for it in our order of operations, let me know.
  173.  
  174.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_UOF" 'convert to unsigned offset
  175.     REDIM _PRESERVE PL(i): PL(i) = 5
  176.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_OF" 'convert to offset
  177.     REDIM _PRESERVE PL(i): PL(i) = 5
  178.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_UBY" 'convert to unsigned byte
  179.     REDIM _PRESERVE PL(i): PL(i) = 5
  180.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_BY" 'convert to byte
  181.     REDIM _PRESERVE PL(i): PL(i) = 5
  182.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_UIN" 'convert to unsigned integer
  183.     REDIM _PRESERVE PL(i): PL(i) = 5
  184.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_IN" 'convert to integer
  185.     REDIM _PRESERVE PL(i): PL(i) = 5
  186.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_UIF" 'convert to unsigned int64
  187.     REDIM _PRESERVE PL(i): PL(i) = 5
  188.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_IF" 'convert to int64
  189.     REDIM _PRESERVE PL(i): PL(i) = 5
  190.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_ULO" 'convert to unsigned long
  191.     REDIM _PRESERVE PL(i): PL(i) = 5
  192.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_LO" 'convert to long
  193.     REDIM _PRESERVE PL(i): PL(i) = 5
  194.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_SI" 'convert to single
  195.     REDIM _PRESERVE PL(i): PL(i) = 5
  196.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_FL" 'convert to float
  197.     REDIM _PRESERVE PL(i): PL(i) = 5
  198.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_DO" 'convert to double
  199.     REDIM _PRESERVE PL(i): PL(i) = 5
  200.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_UBI" 'convert to unsigned bit
  201.     REDIM _PRESERVE PL(i): PL(i) = 5
  202.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_BI" 'convert to bit
  203.     REDIM _PRESERVE PL(i): PL(i) = 5
  204.  
  205.     'Then Functions with PL 10
  206.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_ACOS"
  207.     REDIM _PRESERVE PL(i): PL(i) = 10
  208.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_ASIN"
  209.     REDIM _PRESERVE PL(i): PL(i) = 10
  210.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_ARCSEC"
  211.     REDIM _PRESERVE PL(i): PL(i) = 10
  212.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_ARCCSC"
  213.     REDIM _PRESERVE PL(i): PL(i) = 10
  214.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_ARCCOT"
  215.     REDIM _PRESERVE PL(i): PL(i) = 10
  216.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_SECH"
  217.     REDIM _PRESERVE PL(i): PL(i) = 10
  218.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_CSCH"
  219.     REDIM _PRESERVE PL(i): PL(i) = 10
  220.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_COTH"
  221.     REDIM _PRESERVE PL(i): PL(i) = 10
  222.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "COS"
  223.     REDIM _PRESERVE PL(i): PL(i) = 10
  224.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "SIN"
  225.     REDIM _PRESERVE PL(i): PL(i) = 10
  226.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "TAN"
  227.     REDIM _PRESERVE PL(i): PL(i) = 10
  228.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "LOG"
  229.     REDIM _PRESERVE PL(i): PL(i) = 10
  230.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "EXP"
  231.     REDIM _PRESERVE PL(i): PL(i) = 10
  232.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "ATN"
  233.     REDIM _PRESERVE PL(i): PL(i) = 10
  234.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_D2R"
  235.     REDIM _PRESERVE PL(i): PL(i) = 10
  236.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_D2G"
  237.     REDIM _PRESERVE PL(i): PL(i) = 10
  238.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_R2D"
  239.     REDIM _PRESERVE PL(i): PL(i) = 10
  240.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_R2G"
  241.     REDIM _PRESERVE PL(i): PL(i) = 10
  242.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_G2D"
  243.     REDIM _PRESERVE PL(i): PL(i) = 10
  244.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_G2R"
  245.     REDIM _PRESERVE PL(i): PL(i) = 10
  246.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "ABS"
  247.     REDIM _PRESERVE PL(i): PL(i) = 10
  248.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "SGN"
  249.     REDIM _PRESERVE PL(i): PL(i) = 10
  250.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "INT"
  251.     REDIM _PRESERVE PL(i): PL(i) = 10
  252.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_ROUND"
  253.     REDIM _PRESERVE PL(i): PL(i) = 10
  254.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "FIX"
  255.     REDIM _PRESERVE PL(i): PL(i) = 10
  256.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_SEC"
  257.     REDIM _PRESERVE PL(i): PL(i) = 10
  258.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_CSC"
  259.     REDIM _PRESERVE PL(i): PL(i) = 10
  260.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_COT"
  261.     REDIM _PRESERVE PL(i): PL(i) = 10
  262.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "ASC"
  263.     REDIM _PRESERVE PL(i): PL(i) = 10
  264.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "CHR$"
  265.     REDIM _PRESERVE PL(i): PL(i) = 10
  266.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_RGB32"
  267.     REDIM _PRESERVE PL(i): PL(i) = 10
  268.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_RGBA32"
  269.     REDIM _PRESERVE PL(i): PL(i) = 10
  270.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_RGB"
  271.     REDIM _PRESERVE PL(i): PL(i) = 10
  272.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_RGBA"
  273.     REDIM _PRESERVE PL(i): PL(i) = 10
  274.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_RED"
  275.     REDIM _PRESERVE PL(i): PL(i) = 10
  276.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_GREEN"
  277.     REDIM _PRESERVE PL(i): PL(i) = 10
  278.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_BLUE"
  279.     REDIM _PRESERVE PL(i): PL(i) = 10
  280.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_ALPHA"
  281.     REDIM _PRESERVE PL(i): PL(i) = 10
  282.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_RED32"
  283.     REDIM _PRESERVE PL(i): PL(i) = 10
  284.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_GREEN32"
  285.     REDIM _PRESERVE PL(i): PL(i) = 10
  286.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_BLUE32"
  287.     REDIM _PRESERVE PL(i): PL(i) = 10
  288.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_ALPHA32"
  289.     REDIM _PRESERVE PL(i): PL(i) = 10
  290.  
  291.     'Exponents with PL 20
  292.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "^"
  293.     REDIM _PRESERVE PL(i): PL(i) = 20
  294.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "SQR"
  295.     REDIM _PRESERVE PL(i): PL(i) = 20
  296.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "ROOT"
  297.     REDIM _PRESERVE PL(i): PL(i) = 20
  298.     'Multiplication and Division PL 30
  299.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "*"
  300.     REDIM _PRESERVE PL(i): PL(i) = 30
  301.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "/"
  302.     REDIM _PRESERVE PL(i): PL(i) = 30
  303.     'Integer Division PL 40
  304.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "\"
  305.     REDIM _PRESERVE PL(i): PL(i) = 40
  306.     'MOD PL 50
  307.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "MOD"
  308.     REDIM _PRESERVE PL(i): PL(i) = 50
  309.     'Addition and Subtraction PL 60
  310.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "+"
  311.     REDIM _PRESERVE PL(i): PL(i) = 60
  312.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "-"
  313.     REDIM _PRESERVE PL(i): PL(i) = 60
  314.  
  315.     'Relational Operators =, >, <, <>, <=, >=   PL 70
  316.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "<>"
  317.     REDIM _PRESERVE PL(i): PL(i) = 70
  318.     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
  319.     REDIM _PRESERVE PL(i): PL(i) = 70
  320.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "<="
  321.     REDIM _PRESERVE PL(i): PL(i) = 70
  322.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = ">="
  323.     REDIM _PRESERVE PL(i): PL(i) = 70
  324.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "=<" 'I personally can never keep these things straight.  Is it < = or = <...
  325.     REDIM _PRESERVE PL(i): PL(i) = 70
  326.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "=>" 'Who knows, check both!
  327.     REDIM _PRESERVE PL(i): PL(i) = 70
  328.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = ">"
  329.     REDIM _PRESERVE PL(i): PL(i) = 70
  330.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "<"
  331.     REDIM _PRESERVE PL(i): PL(i) = 70
  332.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "="
  333.     REDIM _PRESERVE PL(i): PL(i) = 70
  334.     'Logical Operations PL 80+
  335.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "NOT"
  336.     REDIM _PRESERVE PL(i): PL(i) = 80
  337.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "AND"
  338.     REDIM _PRESERVE PL(i): PL(i) = 90
  339.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "OR"
  340.     REDIM _PRESERVE PL(i): PL(i) = 100
  341.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "XOR"
  342.     REDIM _PRESERVE PL(i): PL(i) = 110
  343.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "EQV"
  344.     REDIM _PRESERVE PL(i): PL(i) = 120
  345.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "IMP"
  346.     REDIM _PRESERVE PL(i): PL(i) = 130
  347.  
  348.  
  349.  
  350. FUNCTION EvaluateNumbers$ (p, num() AS STRING)
  351.     DIM n1 AS _FLOAT, n2 AS _FLOAT, n3 AS _FLOAT
  352.     IF INSTR(num(1), ",") THEN EvaluateNumbers$ = "ERROR - Invalid comma (" + num(1) + ")": EXIT FUNCTION
  353.     IF INSTR(num(2), ",") THEN
  354.         SELECT CASE OName(p) 'only certain commands should pass a comma value
  355.             CASE "_RGB32", "_RGBA32", "_RGB", "_RGBA", "_RED", "_GREEN", "_BLUE", "_ALPHA"
  356.             CASE ELSE
  357.                 EvaluateNumbers$ = "ERROR - Invalid comma (" + num(2) + ")": EXIT FUNCTION
  358.         END SELECT
  359.     END IF
  360.  
  361.     SELECT CASE PL(p) 'divide up the work so we want do as much case checking
  362.         CASE 5 'Type conversions
  363.             'Note, these are special cases and work with the number BEFORE the command and not after
  364.             SELECT CASE OName(p) 'Depending on our operator..
  365.                 CASE "C_UOF": n1~%& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~%&)))
  366.                 CASE "C_ULO": n1%& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1%&)))
  367.                 CASE "C_UBY": n1~%% = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~%%)))
  368.                 CASE "C_UIN": n1~% = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~%)))
  369.                 CASE "C_BY": n1%% = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1%%)))
  370.                 CASE "C_IN": n1% = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1%)))
  371.                 CASE "C_UIF": n1~&& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~&&)))
  372.                 CASE "C_OF": n1~& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~&)))
  373.                 CASE "C_IF": n1&& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1&&)))
  374.                 CASE "C_LO": n1& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1&)))
  375.                 CASE "C_UBI": n1~` = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~`)))
  376.                 CASE "C_BI": n1` = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1`)))
  377.                 CASE "C_FL": n1## = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1##)))
  378.                 CASE "C_DO": n1# = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1#)))
  379.                 CASE "C_SI": n1! = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1!)))
  380.             END SELECT
  381.             EXIT FUNCTION
  382.         CASE 10 'functions
  383.             SELECT CASE OName(p) 'Depending on our operator..
  384.                 CASE "_PI"
  385.                     n1 = 3.14159265358979323846264338327950288## 'Future compatable in case something ever stores extra digits for PI
  386.                     IF num(2) <> "" THEN n1 = n1 * VAL(num(2))
  387.                 CASE "_ACOS": n1 = _ACOS(VAL(num(2)))
  388.                 CASE "_ASIN": n1 = _ASIN(VAL(num(2)))
  389.                 CASE "_ARCSEC": n1 = _ARCSEC(VAL(num(2)))
  390.                 CASE "_ARCCSC": n1 = _ARCCSC(VAL(num(2)))
  391.                 CASE "_ARCCOT": n1 = _ARCCOT(VAL(num(2)))
  392.                 CASE "_SECH": n1 = _SECH(VAL(num(2)))
  393.                 CASE "_CSCH": n1 = _CSCH(VAL(num(2)))
  394.                 CASE "_COTH": n1 = _COTH(VAL(num(2)))
  395.                 CASE "_RGB32"
  396.                     n$ = num(2)
  397.                     IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null _RGB32": EXIT FUNCTION
  398.                     c1 = INSTR(n$, ",")
  399.                     IF c1 THEN c2 = INSTR(c1 + 1, n$, ",")
  400.                     IF c2 THEN c3 = INSTR(c2 + 1, n$, ",")
  401.                     IF c3 THEN c4 = INSTR(c3 + 1, n$, ",")
  402.                     IF c1 = 0 THEN 'there's no comma in the command to parse.  It's a grayscale value
  403.                         n = VAL(num(2))
  404.                         n1 = _RGB32(n, n, n)
  405.                     ELSEIF c2 = 0 THEN 'there's one comma and not 2.  It's grayscale with alpha.
  406.                         n = VAL(LEFT$(num(2), c1))
  407.                         n2 = VAL(MID$(num(2), c1 + 1))
  408.                         n1 = _RGBA32(n, n, n, n2)
  409.                     ELSEIF c3 = 0 THEN 'there's two commas.  It's _RGB values
  410.                         n = VAL(LEFT$(num(2), c1))
  411.                         n2 = VAL(MID$(num(2), c1 + 1))
  412.                         n3 = VAL(MID$(num(2), c2 + 1))
  413.                         n1 = _RGB32(n, n2, n3)
  414.                     ELSEIF c4 = 0 THEN 'there's three commas.  It's _RGBA values
  415.                         n = VAL(LEFT$(num(2), c1))
  416.                         n2 = VAL(MID$(num(2), c1 + 1))
  417.                         n3 = VAL(MID$(num(2), c2 + 1))
  418.                         n4 = VAL(MID$(num(2), c3 + 1))
  419.                         n1 = _RGBA32(n, n2, n3, n4)
  420.                     ELSE 'we have more than three commas.  I have no idea WTH type of values got passed here!
  421.                         EvaluateNumbers$ = "ERROR - Invalid comma count (" + num(2) + ")": EXIT FUNCTION
  422.                     END IF
  423.                 CASE "_RGBA32"
  424.                     n$ = num(2)
  425.                     IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null _RGBA32": EXIT FUNCTION
  426.                     c1 = INSTR(n$, ",")
  427.                     IF c1 THEN c2 = INSTR(c1 + 1, n$, ",")
  428.                     IF c2 THEN c3 = INSTR(c2 + 1, n$, ",")
  429.                     IF c3 THEN c4 = INSTR(c3 + 1, n$, ",")
  430.                     IF c3 = 0 OR c4 <> 0 THEN EvaluateNumbers$ = "ERROR - Invalid comma count (" + num(2) + ")": EXIT FUNCTION
  431.                     'we have to have 3 commas; not more, not less.
  432.                     n = VAL(LEFT$(num(2), c1))
  433.                     n2 = VAL(MID$(num(2), c1 + 1))
  434.                     n3 = VAL(MID$(num(2), c2 + 1))
  435.                     n4 = VAL(MID$(num(2), c3 + 1))
  436.                     n1 = _RGBA32(n, n2, n3, n4)
  437.                 CASE "_RGB"
  438.                     n$ = num(2)
  439.                     IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null _RGB": EXIT FUNCTION
  440.                     c1 = INSTR(n$, ",")
  441.                     IF c1 THEN c2 = INSTR(c1 + 1, n$, ",")
  442.                     IF c2 THEN c3 = INSTR(c2 + 1, n$, ",")