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

0 Members and 1 Guest are viewing this topic.

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

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • 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 SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Steve's Math Evaluator
« Reply #1 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!

FellippeHeitor

  • Guest
Re: Steve's Math Evaluator
« Reply #2 on: January 05, 2020, 03:21:17 pm »
It's giving invalid comma count when passing alpha to _RGB32:
 
Captura de Tela 2020-01-05 às 17.20.37.png


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: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Steve's Math Evaluator
« Reply #3 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: 1091
  • he lives
    • View Profile
Re: Steve's Math Evaluator
« Reply #4 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 »
You're not done when it works, you're done when it's right.

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Steve's Math Evaluator
« Reply #5 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!

FellippeHeitor

  • Guest
Re: Steve's Math Evaluator
« Reply #6 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: 2361
  • Cuz I sez so, varmint!
    • View Profile
Re: Steve's Math Evaluator
« Reply #7 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
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/

FellippeHeitor

  • Guest
Re: Steve's Math Evaluator
« Reply #8 on: January 05, 2020, 09:46:13 pm »
_CEIL is missing.

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Steve's Math Evaluator
« Reply #9 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$, ",")
  443.                     IF c3 THEN c4 = INSTR(c3 + 1, n$, ",")
  444.                     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
  445.                     'we have to have 3 commas; not more, not less.
  446.                     n = VAL(LEFT$(num(2), c1))
  447.                     n2 = VAL(MID$(num(2), c1 + 1))
  448.                     n3 = VAL(MID$(num(2), c2 + 1))
  449.                     n4 = VAL(MID$(num(2), c3 + 1))
  450.                     SELECT CASE n4
  451.                         CASE 0 TO 2, 7 TO 13, 256, 32 'these are the good screen values
  452.                         CASE ELSE
  453.                             EvaluateNumbers$ = "ERROR - Invalid Screen Mode (" + STR$(n4) + ")": EXIT FUNCTION
  454.                     END SELECT
  455.                     t = _NEWIMAGE(1, 1, n4)
  456.                     n1 = _RGB(n, n2, n3, t)
  457.                     _FREEIMAGE t
  458.                 CASE "_RGBA"
  459.                     n$ = num(2)
  460.                     IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null _RGBA": EXIT FUNCTION
  461.                     c1 = INSTR(n$, ",")
  462.                     IF c1 THEN c2 = INSTR(c1 + 1, n$, ",")
  463.                     IF c2 THEN c3 = INSTR(c2 + 1, n$, ",")
  464.                     IF c3 THEN c4 = INSTR(c3 + 1, n$, ",")
  465.                     IF c4 THEN c5 = INSTR(c4 + 1, n$, ",")
  466.                     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
  467.                     'we have to have 4 commas; not more, not less.
  468.                     n = VAL(LEFT$(num(2), c1))
  469.                     n2 = VAL(MID$(num(2), c1 + 1))
  470.                     n3 = VAL(MID$(num(2), c2 + 1))
  471.                     n4 = VAL(MID$(num(2), c3 + 1))
  472.                     n5 = VAL(MID$(num(2), c4 + 1))
  473.                     SELECT CASE n5
  474.                         CASE 0 TO 2, 7 TO 13, 256, 32 'these are the good screen values
  475.                         CASE ELSE
  476.                             EvaluateNumbers$ = "ERROR - Invalid Screen Mode (" + STR$(n5) + ")": EXIT FUNCTION
  477.                     END SELECT
  478.                     t = _NEWIMAGE(1, 1, n5)
  479.                     n1 = _RGBA(n, n2, n3, n4, t)
  480.                     _FREEIMAGE t
  481.                 CASE "_RED", "_GREEN", "_BLUE", "_ALPHA"
  482.                     n$ = num(2)
  483.                     IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null " + OName(p): EXIT FUNCTION
  484.                     c1 = INSTR(n$, ",")
  485.                     IF c1 = 0 THEN EvaluateNumbers$ = "ERROR - " + OName(p) + " requires 2 parameters for Color, ScreenMode.": EXIT FUNCTION
  486.                     IF c1 THEN c2 = INSTR(c1 + 1, n$, ",")
  487.                     IF c2 THEN EvaluateNumbers$ = "ERROR - " + OName(p) + " requires 2 parameters for Color, ScreenMode.": EXIT FUNCTION
  488.                     n = VAL(LEFT$(num(2), c1))
  489.                     n2 = VAL(MID$(num(2), c1 + 1))
  490.                     SELECT CASE n2
  491.                         CASE 0 TO 2, 7 TO 13, 256, 32 'these are the good screen values
  492.                         CASE ELSE
  493.                             EvaluateNumbers$ = "ERROR - Invalid Screen Mode (" + STR$(n2) + ")": EXIT FUNCTION
  494.                     END SELECT
  495.                     t = _NEWIMAGE(1, 1, n4)
  496.                     SELECT CASE OName(p)
  497.                         CASE "_RED": n1 = _RED(n, t)
  498.                         CASE "_BLUE": n1 = _BLUE(n, t)
  499.                         CASE "_GREEN": n1 = _GREEN(n, t)
  500.                         CASE "_ALPHA": n1 = _ALPHA(n, t)
  501.                     END SELECT
  502.                     _FREEIMAGE t
  503.                 CASE "_RED32", "_GREEN32", "_BLUE32", "_ALPHA32"
  504.                     n$ = num(2)
  505.                     IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null " + OName(p): EXIT FUNCTION
  506.                     n = VAL(num(2))
  507.                     SELECT CASE OName(p)
  508.                         CASE "_RED32": n1 = _RED32(n)
  509.                         CASE "_BLUE32": n1 = _BLUE32(n)
  510.                         CASE "_GREEN32": n1 = _GREEN32(n)
  511.                         CASE "_ALPHA32": n1 = _ALPHA32(n)
  512.                     END SELECT
  513.                 CASE "COS": n1 = COS(VAL(num(2)))
  514.                 CASE "SIN": n1 = SIN(VAL(num(2)))
  515.                 CASE "TAN": n1 = TAN(VAL(num(2)))
  516.                 CASE "LOG": n1 = LOG(VAL(num(2)))
  517.                 CASE "EXP": n1 = EXP(VAL(num(2)))
  518.                 CASE "ATN": n1 = ATN(VAL(num(2)))
  519.                 CASE "_D2R": n1 = 0.0174532925 * (VAL(num(2)))
  520.                 CASE "_D2G": n1 = 1.1111111111 * (VAL(num(2)))
  521.                 CASE "_R2D": n1 = 57.2957795 * (VAL(num(2)))
  522.                 CASE "_R2G": n1 = 0.015707963 * (VAL(num(2)))
  523.                 CASE "_G2D": n1 = 0.9 * (VAL(num(2)))
  524.                 CASE "_G2R": n1 = 63.661977237 * (VAL(num(2)))
  525.                 CASE "ABS": n1 = ABS(VAL(num(2)))
  526.                 CASE "SGN": n1 = SGN(VAL(num(2)))
  527.                 CASE "INT": n1 = INT(VAL(num(2)))
  528.                 CASE "_ROUND": n1 = _ROUND(VAL(num(2)))
  529.                 CASE "FIX": n1 = FIX(VAL(num(2)))
  530.                 CASE "_SEC": n1 = _SEC(VAL(num(2)))
  531.                 CASE "_CSC": n1 = _CSC(VAL(num(2)))
  532.                 CASE "_COT": n1 = _COT(VAL(num(2)))
  533.             END SELECT
  534.         CASE 20 TO 60 'Math Operators
  535.             SELECT CASE OName(p) 'Depending on our operator..
  536.                 CASE "^": n1 = VAL(num(1)) ^ VAL(num(2))
  537.                 CASE "SQR": n1 = SQR(VAL(num(2)))
  538.                 CASE "ROOT"
  539.                     n1 = VAL(num(1)): n2 = VAL(num(2))
  540.                     IF n2 = 1 THEN EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1))): EXIT FUNCTION
  541.                     IF n1 < 0 AND n2 >= 1 THEN sign = -1: n1 = -n1 ELSE sign = 1
  542.                     n3 = 1## / n2
  543.                     IF n3 <> INT(n3) AND n2 < 1 THEN sign = SGN(n1): n1 = ABS(n1)
  544.                     n1 = sign * (n1 ^ n3)
  545.                 CASE "*": n1 = VAL(num(1)) * VAL(num(2))
  546.                 CASE "/": n1 = VAL(num(1)) / VAL(num(2))
  547.                 CASE "\"
  548.                     IF VAL(num(2)) <> 0 THEN
  549.                         n1 = VAL(num(1)) \ VAL(num(2))
  550.                     ELSE
  551.                         EvaluateNumbers$ = "ERROR - Bad operation (We shouldn't see this)"
  552.                         EXIT FUNCTION
  553.                     END IF
  554.                 CASE "MOD": n1 = VAL(num(1)) MOD VAL(num(2))
  555.                 CASE "+": n1 = VAL(num(1)) + VAL(num(2))
  556.                 CASE "-": n1 = VAL(num(1)) - VAL(num(2))
  557.             END SELECT
  558.         CASE 70 'Relational Operators =, >, <, <>, <=, >=
  559.             SELECT CASE OName(p) 'Depending on our operator..
  560.                 CASE "=": n1 = VAL(num(1)) = VAL(num(2))
  561.                 CASE ">": n1 = VAL(num(1)) > VAL(num(2))
  562.                 CASE "<": n1 = VAL(num(1)) < VAL(num(2))
  563.                 CASE "<>", "><": n1 = VAL(num(1)) <> VAL(num(2))
  564.                 CASE "<=", "=<": n1 = VAL(num(1)) <= VAL(num(2))
  565.                 CASE ">=", "=>": n1 = VAL(num(1)) >= VAL(num(2))
  566.             END SELECT
  567.         CASE ELSE 'a value we haven't processed elsewhere
  568.             SELECT CASE OName(p) 'Depending on our operator..
  569.                 CASE "NOT": n1 = NOT VAL(num(2))
  570.                 CASE "AND": n1 = VAL(num(1)) AND VAL(num(2))
  571.                 CASE "OR": n1 = VAL(num(1)) OR VAL(num(2))
  572.                 CASE "XOR": n1 = VAL(num(1)) XOR VAL(num(2))
  573.                 CASE "EQV": n1 = VAL(num(1)) EQV VAL(num(2))
  574.                 CASE "IMP": n1 = VAL(num(1)) IMP VAL(num(2))
  575.             END SELECT
  576.     END SELECT
  577.  
  578.     EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1)))
  579.  
  580. FUNCTION DWD$ (exp$) 'Deal With Duplicates
  581.     'To deal with duplicate operators in our code.
  582.     'Such as --  becomes a +
  583.     '++ becomes a +
  584.     '+- becomes a -
  585.     '-+ becomes a -
  586.     t$ = exp$
  587.     DO
  588.         bad = 0
  589.         DO
  590.             l = INSTR(t$, "++")
  591.             IF l THEN t$ = LEFT$(t$, l - 1) + "+" + MID$(t$, l + 2): bad = -1
  592.         LOOP UNTIL l = 0
  593.         DO
  594.             l = INSTR(t$, "+-")
  595.             IF l THEN t$ = LEFT$(t$, l - 1) + "-" + MID$(t$, l + 2): bad = -1
  596.         LOOP UNTIL l = 0
  597.         DO
  598.             l = INSTR(t$, "-+")
  599.             IF l THEN t$ = LEFT$(t$, l - 1) + "-" + MID$(t$, l + 2): bad = -1
  600.         LOOP UNTIL l = 0
  601.         DO
  602.             l = INSTR(t$, "--")
  603.             IF l THEN t$ = LEFT$(t$, l - 1) + "+" + MID$(t$, l + 2): bad = -1
  604.         LOOP UNTIL l = 0
  605.     LOOP UNTIL NOT bad
  606.     DWD$ = t$
  607.     VerifyString t$
  608.  
  609. SUB PreParse (e$)
  610.     DIM f AS _FLOAT
  611.     STATIC TypeMod(1 TO 15) AS STRING, ConvertedMod(1 TO 15) AS STRING
  612.     IF TypeMod(1) = "" THEN
  613.         TypeMod(1) = "~`": ConvertedMod(1) = "C_UBI" 'unsigned bit
  614.         TypeMod(2) = "~%%": ConvertedMod(2) = "C_UBY" 'unsigned byte
  615.         TypeMod(3) = "~%&": ConvertedMod(3) = "C_UOF" 'unsigned offset
  616.         TypeMod(4) = "~%": ConvertedMod(4) = "C_UIN" 'unsigned integer
  617.         TypeMod(5) = "~&&": ConvertedMod(5) = "C_UIF" 'unsigned integer64
  618.         TypeMod(6) = "~&": ConvertedMod(6) = "C_ULO" 'unsigned long
  619.         TypeMod(7) = "`": ConvertedMod(7) = "C_BI" 'bit
  620.         TypeMod(8) = "%%": ConvertedMod(8) = "C_BY" 'byte
  621.         TypeMod(9) = "%&": ConvertedMod(9) = "C_OF" 'offset
  622.         TypeMod(10) = "%": ConvertedMod(10) = "C_IN" 'integer
  623.         TypeMod(11) = "&&": ConvertedMod(11) = "C_IF" 'integer64
  624.         TypeMod(12) = "&": ConvertedMod(12) = "C_LO" 'long
  625.         TypeMod(13) = "!": ConvertedMod(13) = "C_SI" 'single
  626.         TypeMod(14) = "##": ConvertedMod(14) = "C_FL" 'float
  627.         TypeMod(15) = "#": ConvertedMod(15) = "C_DO" 'double
  628.     END IF
  629.     t$ = e$
  630.  
  631.     'First strip all spaces
  632.     t$ = ""
  633.     FOR i = 1 TO LEN(e$)
  634.         IF MID$(e$, i, 1) <> " " THEN t$ = t$ + MID$(e$, i, 1)
  635.     NEXT
  636.  
  637.     t$ = UCASE$(t$)
  638.     IF t$ = "" THEN e$ = "ERROR -- NULL string; nothing to evaluate": EXIT SUB
  639.  
  640.     'ERROR CHECK by counting our brackets
  641.     l = 0
  642.     DO
  643.         l = INSTR(l + 1, t$, "("): IF l THEN c = c + 1
  644.     LOOP UNTIL l = 0
  645.     l = 0
  646.     DO
  647.         l = INSTR(l + 1, t$, ")"): IF l THEN c1 = c1 + 1
  648.     LOOP UNTIL l = 0
  649.     IF c <> c1 THEN e$ = "ERROR -- Bad Parenthesis:" + STR$(c) + "( vs" + STR$(c1) + ")": EXIT SUB
  650.  
  651.     'Modify so that NOT will process properly
  652.     l = 0
  653.     DO
  654.         l = INSTR(l + 1, t$, "NOT")
  655.         IF l THEN
  656.             'We need to work magic on the statement so it looks pretty.
  657.             ' 1 + NOT 2 + 1 is actually processed as 1 + (NOT 2 + 1)
  658.             'Look for something not proper
  659.             l1 = INSTR(l + 1, t$, "AND")
  660.             IF l1 = 0 OR (INSTR(l + 1, t$, "OR") > 0 AND INSTR(l + 1, t$, "OR") < l1) THEN l1 = INSTR(l + 1, t$, "OR")
  661.             IF l1 = 0 OR (INSTR(l + 1, t$, "XOR") > 0 AND INSTR(l + 1, t$, "XOR") < l1) THEN l1 = INSTR(l + 1, t$, "XOR")
  662.             IF l1 = 0 OR (INSTR(l + 1, t$, "EQV") > 0 AND INSTR(l + 1, t$, "EQV") < l1) THEN l1 = INSTR(l + 1, t$, "EQV")
  663.             IF l1 = 0 OR (INSTR(l + 1, t$, "IMP") > 0 AND INSTR(l + 1, t$, "IMP") < l1) THEN l1 = INSTR(l + 1, t$, "IMP")
  664.             IF l1 = 0 THEN l1 = LEN(t$) + 1
  665.             t$ = LEFT$(t$, l - 1) + "(" + MID$(t$, l, l1 - l) + ")" + MID$(t$, l + l1 - l)
  666.             l = l + 3
  667.             'PRINT t$
  668.         END IF
  669.     LOOP UNTIL l = 0
  670.  
  671.     'Modify so that % will process properly
  672.  
  673.     FOR j = 1 TO 15
  674.         l = 0
  675.         DO
  676.             l = INSTR(l + 1, t$, TypeMod(j))
  677.             IF l = 0 THEN EXIT DO
  678.             i = 0: l1 = 0: l2 = 0: lo = LEN(TypeMod(j))
  679.             DO
  680.                 IF PL(i) > 10 THEN
  681.                     l2 = _INSTRREV(l, t$, OName$(i))
  682.                     IF l2 > 0 AND l2 > l1 THEN l1 = l2
  683.                 END IF
  684.                 i = i + lo
  685.             LOOP UNTIL i > UBOUND(PL)
  686.             'PRINT "L1:"; l1; "L"; l
  687.             l$ = LEFT$(t$, l1)
  688.             m$ = MID$(t$, l1 + 1, l - l1 - 1)
  689.             r$ = ConvertedMod(j) + MID$(t$, l + lo)
  690.             'PRINT "Y$: "; TypeMod(j)
  691.             'PRINT "L$: "; l$
  692.             'PRINT "M$: "; m$
  693.             'PRINT "R$: "; r$
  694.             t$ = l$ + "(" + m$ + ")" + r$
  695.             'PRINT "T$: "; t$
  696.             l = l + 2 + LEN(TypeMod(j)) 'move forward from the length of the symbol we checked + the new "(" and  ")"
  697.         LOOP
  698.     NEXT
  699.     'PRINT "HERE: "; t$
  700.  
  701.  
  702.     'Check for bad operators before a ( bracket
  703.     l = 0
  704.     DO
  705.         l = INSTR(l + 1, t$, "(")
  706.         IF l AND l > 2 THEN 'Don't check the starting bracket; there's nothing before it.
  707.             good = 0
  708.             'PRINT "BEFORE: "; t$; l
  709.             FOR i = 1 TO UBOUND(OName)
  710.  
  711.                 m$ = MID$(t$, l - LEN(OName(i)), LEN(OName(i)))
  712.                 'IF OName(i) = "C_SI" THEN PRINT "CONVERT TO SINGLE", m$
  713.                 IF m$ = OName(i) THEN
  714.                     IF 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)
  715.                 END IF
  716.             NEXT
  717.             'PRINT t$; l
  718.             IF NOT good THEN e$ = "ERROR - Improper operations before (.": EXIT SUB
  719.             l = l + 1
  720.         END IF
  721.     LOOP UNTIL l = 0
  722.  
  723.     'Check for bad operators after a ) bracket
  724.     l = 0
  725.     DO
  726.         l = INSTR(l + 1, t$, ")")
  727.         IF l AND l < LEN(t$) THEN
  728.             good = 0
  729.             FOR i = 1 TO UBOUND(oname)
  730.                 m$ = MID$(t$, l + 1, LEN(OName(i)))
  731.                 IF m$ = OName(i) THEN
  732.                     IF 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)
  733.                 END IF
  734.             NEXT
  735.             IF MID$(t$, l + 1, 1) = ")" THEN good = -1
  736.             IF NOT good THEN e$ = "ERROR - Improper operations after ).": EXIT SUB
  737.             l = l + 1
  738.         END IF
  739.     LOOP UNTIL l = 0 OR l = LEN(t$) 'last symbol is a bracket
  740.  
  741.     'Turn all &H (hex) numbers into decimal values for the program to process properly
  742.     l = 0
  743.     DO
  744.         l = INSTR(t$, "&H")
  745.         IF l THEN
  746.             E = l + 1: finished = 0
  747.             DO
  748.                 E = E + 1
  749.                 comp$ = MID$(t$, E, 1)
  750.                 SELECT CASE comp$
  751.                     CASE "0" TO "9", "A" TO "F" 'All is good, our next digit is a number, continue to add to the hex$
  752.                     CASE ELSE
  753.                         good = 0
  754.                         FOR i = 1 TO UBOUND(oname)
  755.                             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)
  756.                         NEXT
  757.                         IF NOT good THEN e$ = "ERROR - Improper &H value. (" + comp$ + ")": EXIT SUB
  758.                         E = E - 1
  759.                         finished = -1
  760.                 END SELECT
  761.             LOOP UNTIL finished OR E = LEN(t$)
  762.             t$ = LEFT$(t$, l - 1) + LTRIM$(RTRIM$(STR$(VAL(MID$(t$, l, E - l + 1))))) + MID$(t$, E + 1)
  763.         END IF
  764.     LOOP UNTIL l = 0
  765.  
  766.     'Turn all &B (binary) numbers into decimal values for the program to process properly
  767.     l = 0
  768.     DO
  769.         l = INSTR(t$, "&B")
  770.         IF l THEN
  771.             E = l + 1: finished = 0
  772.             DO
  773.                 E = E + 1
  774.                 comp$ = MID$(t$, E, 1)
  775.                 SELECT CASE comp$
  776.                     CASE "0", "1" 'All is good, our next digit is a number, continue to add to the hex$
  777.                     CASE ELSE
  778.                         good = 0
  779.                         FOR i = 1 TO UBOUND(oname)
  780.                             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)
  781.                         NEXT
  782.                         IF NOT good THEN e$ = "ERROR - Improper &B value. (" + comp$ + ")": EXIT SUB
  783.                         E = E - 1
  784.                         finished = -1
  785.                 END SELECT
  786.             LOOP UNTIL finished OR E = LEN(t$)
  787.             bin$ = MID$(t$, l + 2, E - l - 1)
  788.             FOR i = 1 TO LEN(bin$)
  789.                 IF MID$(bin$, i, 1) = "1" THEN f = f + 2 ^ (LEN(bin$) - i)
  790.             NEXT
  791.             t$ = LEFT$(t$, l - 1) + LTRIM$(RTRIM$(STR$(f))) + MID$(t$, E + 1)
  792.         END IF
  793.     LOOP UNTIL l = 0
  794.  
  795.     'PRINT "ALMOST:"; t$
  796.  
  797.     t$ = N2S(t$)
  798.     'PRINT "ALMOST2:"; t$
  799.     VerifyString t$
  800.  
  801.     e$ = t$
  802.  
  803.  
  804.  
  805. SUB VerifyString (t$)
  806.     'ERROR CHECK for unrecognized operations
  807.     j = 1
  808.     DO
  809.         comp$ = MID$(t$, j, 1)
  810.         SELECT CASE comp$
  811.             CASE "0" TO "9", ".", "(", ")", ",": j = j + 1
  812.             CASE ELSE
  813.                 good = 0
  814.                 FOR i = 1 TO UBOUND(OName)
  815.                     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)
  816.                 NEXT
  817.                 IF NOT good THEN t$ = "ERROR - Bad Operational value. (" + comp$ + ")": EXIT SUB
  818.                 j = j + LEN(OName(i))
  819.         END SELECT
  820.     LOOP UNTIL j > LEN(t$)
  821.  
  822. FUNCTION N2S$ (exp$) 'scientific Notation to String
  823.     t$ = LTRIM$(RTRIM$(exp$))
  824.     IF LEFT$(t$, 1) = "-" THEN sign$ = "-": t$ = MID$(t$, 2)
  825.  
  826.     dp = INSTR(t$, "D+"): dm = INSTR(t$, "D-")
  827.     ep = INSTR(t$, "E+"): em = INSTR(t$, "E-")
  828.     check1 = SGN(dp) + SGN(dm) + SGN(ep) + SGN(em)
  829.     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!
  830.  
  831.     SELECT CASE l 'l now tells us where the SN starts at.
  832.         CASE IS < dp: l = dp
  833.         CASE IS < dm: l = dm
  834.         CASE IS < ep: l = ep
  835.         CASE IS < em: l = em
  836.     END SELECT
  837.  
  838.     l$ = LEFT$(t$, l - 1) 'The left of the SN
  839.     r$ = MID$(t$, l + 1): r&& = VAL(r$) 'The right of the SN, turned into a workable long
  840.  
  841.  
  842.     IF INSTR(l$, ".") THEN 'Location of the decimal, if any
  843.         IF r&& > 0 THEN
  844.             r&& = r&& - LEN(l$) + 2
  845.         ELSE
  846.             r&& = r&& + 1
  847.         END IF
  848.         l$ = LEFT$(l$, 1) + MID$(l$, 3)
  849.     END IF
  850.  
  851.     SELECT CASE r&&
  852.         CASE 0 'what the heck? We solved it already?
  853.             'l$ = l$
  854.         CASE IS < 0
  855.             FOR i = 1 TO -r&&
  856.                 l$ = "0" + l$
  857.             NEXT
  858.             l$ = "0." + l$
  859.         CASE ELSE
  860.             FOR i = 1 TO r&&
  861.                 l$ = l$ + "0"
  862.             NEXT
  863.     END SELECT
  864.  
  865.     N2S$ = sign$ + l$

Also have added in the type conversion symbols for use -- and they're usable in more places here than where QB64 itself normally lets us use them!!

For example:
Code: [Select]
_RGB32(255,0,0)&
The above would give us the LONG value for full red on a 32-bit screen.

Code: [Select]
_RGB32(255,0,0)~&
And the above here will give us the UNSIGNED LONG value instead.

QB64 itself doesn't allow our variable types to be used with functions (and not always with numbers either, oddly enough!), but the routine here lets us toss them in wherever we need to so we can get back exactly whatever type value we want.



Next TO DO:  Sort out what the heck is going on with multiple negatives corrupting values when they shouldn't, as STx pointed out above.


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

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Steve's Math Evaluator
« Reply #10 on: January 05, 2020, 10:01:25 pm »
_CEIL is missing.

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) = "_CEIL"
  255.     REDIM _PRESERVE PL(i): PL(i) = 10
  256.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "FIX"
  257.     REDIM _PRESERVE PL(i): PL(i) = 10
  258.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_SEC"
  259.     REDIM _PRESERVE PL(i): PL(i) = 10
  260.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_CSC"
  261.     REDIM _PRESERVE PL(i): PL(i) = 10
  262.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_COT"
  263.     REDIM _PRESERVE PL(i): PL(i) = 10
  264.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "ASC"
  265.     REDIM _PRESERVE PL(i): PL(i) = 10
  266.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "CHR$"
  267.     REDIM _PRESERVE PL(i): PL(i) = 10
  268.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_RGB32"
  269.     REDIM _PRESERVE PL(i): PL(i) = 10
  270.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_RGBA32"
  271.     REDIM _PRESERVE PL(i): PL(i) = 10
  272.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_RGB"
  273.     REDIM _PRESERVE PL(i): PL(i) = 10
  274.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_RGBA"
  275.     REDIM _PRESERVE PL(i): PL(i) = 10
  276.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_RED"
  277.     REDIM _PRESERVE PL(i): PL(i) = 10
  278.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_GREEN"
  279.     REDIM _PRESERVE PL(i): PL(i) = 10
  280.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_BLUE"
  281.     REDIM _PRESERVE PL(i): PL(i) = 10
  282.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_ALPHA"
  283.     REDIM _PRESERVE PL(i): PL(i) = 10
  284.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_RED32"
  285.     REDIM _PRESERVE PL(i): PL(i) = 10
  286.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_GREEN32"
  287.     REDIM _PRESERVE PL(i): PL(i) = 10
  288.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_BLUE32"
  289.     REDIM _PRESERVE PL(i): PL(i) = 10
  290.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_ALPHA32"
  291.     REDIM _PRESERVE PL(i): PL(i) = 10
  292.  
  293.     'Exponents with PL 20
  294.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "^"
  295.     REDIM _PRESERVE PL(i): PL(i) = 20
  296.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "SQR"
  297.     REDIM _PRESERVE PL(i): PL(i) = 20
  298.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "ROOT"
  299.     REDIM _PRESERVE PL(i): PL(i) = 20
  300.     'Multiplication and Division PL 30
  301.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "*"
  302.     REDIM _PRESERVE PL(i): PL(i) = 30
  303.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "/"
  304.     REDIM _PRESERVE PL(i): PL(i) = 30
  305.     'Integer Division PL 40
  306.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "\"
  307.     REDIM _PRESERVE PL(i): PL(i) = 40
  308.     'MOD PL 50
  309.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "MOD"
  310.     REDIM _PRESERVE PL(i): PL(i) = 50
  311.     'Addition and Subtraction PL 60
  312.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "+"
  313.     REDIM _PRESERVE PL(i): PL(i) = 60
  314.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "-"
  315.     REDIM _PRESERVE PL(i): PL(i) = 60
  316.  
  317.     'Relational Operators =, >, <, <>, <=, >=   PL 70
  318.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "<>"
  319.     REDIM _PRESERVE PL(i): PL(i) = 70
  320.     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
  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) = ">="
  325.     REDIM _PRESERVE PL(i): PL(i) = 70
  326.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "=<" 'I personally can never keep these things straight.  Is it < = or = <...
  327.     REDIM _PRESERVE PL(i): PL(i) = 70
  328.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "=>" 'Who knows, check both!
  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.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "="
  335.     REDIM _PRESERVE PL(i): PL(i) = 70
  336.     'Logical Operations PL 80+
  337.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "NOT"
  338.     REDIM _PRESERVE PL(i): PL(i) = 80
  339.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "AND"
  340.     REDIM _PRESERVE PL(i): PL(i) = 90
  341.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "OR"
  342.     REDIM _PRESERVE PL(i): PL(i) = 100
  343.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "XOR"
  344.     REDIM _PRESERVE PL(i): PL(i) = 110
  345.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "EQV"
  346.     REDIM _PRESERVE PL(i): PL(i) = 120
  347.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "IMP"
  348.     REDIM _PRESERVE PL(i): PL(i) = 130
  349.  
  350.  
  351.  
  352. FUNCTION EvaluateNumbers$ (p, num() AS STRING)
  353.     DIM n1 AS _FLOAT, n2 AS _FLOAT, n3 AS _FLOAT
  354.     IF INSTR(num(1), ",") THEN EvaluateNumbers$ = "ERROR - Invalid comma (" + num(1) + ")": EXIT FUNCTION
  355.     IF INSTR(num(2), ",") THEN
  356.         SELECT CASE OName(p) 'only certain commands should pass a comma value
  357.             CASE "_RGB32", "_RGBA32", "_RGB", "_RGBA", "_RED", "_GREEN", "_BLUE", "_ALPHA"
  358.             CASE ELSE
  359.                 EvaluateNumbers$ = "ERROR - Invalid comma (" + num(2) + ")": EXIT FUNCTION
  360.         END SELECT
  361.     END IF
  362.  
  363.     SELECT CASE PL(p) 'divide up the work so we want do as much case checking
  364.         CASE 5 'Type conversions
  365.             'Note, these are special cases and work with the number BEFORE the command and not after
  366.             SELECT CASE OName(p) 'Depending on our operator..
  367.                 CASE "C_UOF": n1~%& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~%&)))
  368.                 CASE "C_ULO": n1%& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1%&)))
  369.                 CASE "C_UBY": n1~%% = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~%%)))
  370.                 CASE "C_UIN": n1~% = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~%)))
  371.                 CASE "C_BY": n1%% = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1%%)))
  372.                 CASE "C_IN": n1% = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1%)))
  373.                 CASE "C_UIF": n1~&& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~&&)))
  374.                 CASE "C_OF": n1~& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~&)))
  375.                 CASE "C_IF": n1&& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1&&)))
  376.                 CASE "C_LO": n1& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1&)))
  377.                 CASE "C_UBI": n1~` = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~`)))
  378.                 CASE "C_BI": n1` = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1`)))
  379.                 CASE "C_FL": n1## = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1##)))
  380.                 CASE "C_DO": n1# = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1#)))
  381.                 CASE "C_SI": n1! = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1!)))
  382.             END SELECT
  383.             EXIT FUNCTION
  384.         CASE 10 'functions
  385.             SELECT CASE OName(p) 'Depending on our operator..
  386.                 CASE "_PI"
  387.                     n1 = 3.14159265358979323846264338327950288## 'Future compatable in case something ever stores extra digits for PI
  388.                     IF num(2) <> "" THEN n1 = n1 * VAL(num(2))
  389.                 CASE "_ACOS": n1 = _ACOS(VAL(num(2)))
  390.                 CASE "_ASIN": n1 = _ASIN(VAL(num(2)))
  391.                 CASE "_ARCSEC": n1 = _ARCSEC(VAL(num(2)))
  392.                 CASE "_ARCCSC": n1 = _ARCCSC(VAL(num(2)))
  393.                 CASE "_ARCCOT": n1 = _ARCCOT(VAL(num(2)))
  394.                 CASE "_SECH": n1 = _SECH(VAL(num(2)))
  395.                 CASE "_CSCH": n1 = _CSCH(VAL(num(2)))
  396.                 CASE "_COTH": n1 = _COTH(VAL(num(2)))
  397.                 CASE "_RGB32"
  398.                     n$ = num(2)
  399.                     IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null _RGB32": EXIT FUNCTION
  400.                     c1 = INSTR(n$, ",")
  401.                     IF c1 THEN c2 = INSTR(c1 + 1, n$, ",")
  402.                     IF c2 THEN c3 = INSTR(c2 + 1, n$, ",")
  403.                     IF c3 THEN c4 = INSTR(c3 + 1, n$, ",")
  404.                     IF c1 = 0 THEN 'there's no comma in the command to parse.  It's a grayscale value
  405.                         n = VAL(num(2))
  406.                         n1 = _RGB32(n, n, n)
  407.                     ELSEIF c2 = 0 THEN 'there's one comma and not 2.  It's grayscale with alpha.
  408.                         n = VAL(LEFT$(num(2), c1))
  409.                         n2 = VAL(MID$(num(2), c1 + 1))
  410.                         n1 = _RGBA32(n, n, n, n2)
  411.                     ELSEIF c3 = 0 THEN 'there's two commas.  It's _RGB values
  412.                         n = VAL(LEFT$(num(2), c1))
  413.                         n2 = VAL(MID$(num(2), c1 + 1))
  414.                         n3 = VAL(MID$(num(2), c2 + 1))
  415.                         n1 = _RGB32(n, n2, n3)
  416.                     ELSEIF c4 = 0 THEN 'there's three commas.  It's _RGBA values
  417.                         n = VAL(LEFT$(num(2), c1))
  418.                         n2 = VAL(MID$(num(2), c1 + 1))
  419.                         n3 = VAL(MID$(num(2), c2 + 1))
  420.                         n4 = VAL(MID$(num(2), c3 + 1))
  421.                         n1 = _RGBA32(n, n2, n3, n4)
  422.                     ELSE 'we have more than three commas.  I have no idea WTH type of values got passed here!
  423.                         EvaluateNumbers$ = "ERROR - Invalid comma count (" + num(2) + ")": EXIT FUNCTION
  424.                     END IF
  425.                 CASE "_RGBA32"
  426.                     n$ = num(2)
  427.                     IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null _RGBA32": EXIT FUNCTION
  428.                     c1 = INSTR(n$, ",")
  429.                     IF c1 THEN c2 = INSTR(c1 + 1, n$, ",")
  430.                     IF c2 THEN c3 = INSTR(c2 + 1, n$, ",")
  431.                     IF c3 THEN c4 = INSTR(c3 + 1, n$, ",")
  432.                     IF c3 = 0 OR c4 <> 0 THEN EvaluateNumbers$ = "ERROR - Invalid comma count (" + num(2) + ")": EXIT FUNCTION
  433.                     'we have to have 3 commas; not more, not less.
  434.                     n = VAL(LEFT$(num(2), c1))
  435.                     n2 = VAL(MID$(num(2), c1 + 1))
  436.                     n3 = VAL(MID$(num(2), c2 + 1))
  437.                     n4 = VAL(MID$(num(2), c3 + 1))
  438.                     n1 = _RGBA32(n, n2, n3, n4)
  439.                 CASE "_RGB"
  440.                     n$ = num(2)
  441.                     IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null _RGB": EXIT FUNCTION
  442.                     c1 = INSTR(n$, ",")
  443.                     IF c1 THEN c2 = INSTR(c1 + 1, n$, ",")
  444.                     IF c2 THEN c3 = INSTR(c2 + 1, n$, ",")
  445.                     IF c3 THEN c4 = INSTR(c3 + 1, n$, ",")
  446.                     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
  447.                     'we have to have 3 commas; not more, not less.
  448.                     n = VAL(LEFT$(num(2), c1))
  449.                     n2 = VAL(MID$(num(2), c1 + 1))
  450.                     n3 = VAL(MID$(num(2), c2 + 1))
  451.                     n4 = VAL(MID$(num(2), c3 + 1))
  452.                     SELECT CASE n4
  453.                         CASE 0 TO 2, 7 TO 13, 256, 32 'these are the good screen values
  454.                         CASE ELSE
  455.                             EvaluateNumbers$ = "ERROR - Invalid Screen Mode (" + STR$(n4) + ")": EXIT FUNCTION
  456.                     END SELECT
  457.                     t = _NEWIMAGE(1, 1, n4)
  458.                     n1 = _RGB(n, n2, n3, t)
  459.                     _FREEIMAGE t
  460.                 CASE "_RGBA"
  461.                     n$ = num(2)
  462.                     IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null _RGBA": EXIT FUNCTION
  463.                     c1 = INSTR(n$, ",")
  464.                     IF c1 THEN c2 = INSTR(c1 + 1, n$, ",")
  465.                     IF c2 THEN c3 = INSTR(c2 + 1, n$, ",")
  466.                     IF c3 THEN c4 = INSTR(c3 + 1, n$, ",")
  467.                     IF c4 THEN c5 = INSTR(c4 + 1, n$, ",")
  468.                     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
  469.                     'we have to have 4 commas; not more, not less.
  470.                     n = VAL(LEFT$(num(2), c1))
  471.                     n2 = VAL(MID$(num(2), c1 + 1))
  472.                     n3 = VAL(MID$(num(2), c2 + 1))
  473.                     n4 = VAL(MID$(num(2), c3 + 1))
  474.                     n5 = VAL(MID$(num(2), c4 + 1))
  475.                     SELECT CASE n5
  476.                         CASE 0 TO 2, 7 TO 13, 256, 32 'these are the good screen values
  477.                         CASE ELSE
  478.                             EvaluateNumbers$ = "ERROR - Invalid Screen Mode (" + STR$(n5) + ")": EXIT FUNCTION
  479.                     END SELECT
  480.                     t = _NEWIMAGE(1, 1, n5)
  481.                     n1 = _RGBA(n, n2, n3, n4, t)
  482.                     _FREEIMAGE t
  483.                 CASE "_RED", "_GREEN", "_BLUE", "_ALPHA"
  484.                     n$ = num(2)
  485.                     IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null " + OName(p): EXIT FUNCTION
  486.                     c1 = INSTR(n$, ",")
  487.                     IF c1 = 0 THEN EvaluateNumbers$ = "ERROR - " + OName(p) + " requires 2 parameters for Color, ScreenMode.": EXIT FUNCTION
  488.                     IF c1 THEN c2 = INSTR(c1 + 1, n$, ",")
  489.                     IF c2 THEN EvaluateNumbers$ = "ERROR - " + OName(p) + " requires 2 parameters for Color, ScreenMode.": EXIT FUNCTION
  490.                     n = VAL(LEFT$(num(2), c1))
  491.                     n2 = VAL(MID$(num(2), c1 + 1))
  492.                     SELECT CASE n2
  493.                         CASE 0 TO 2, 7 TO 13, 256, 32 'these are the good screen values
  494.                         CASE ELSE
  495.                             EvaluateNumbers$ = "ERROR - Invalid Screen Mode (" + STR$(n2) + ")": EXIT FUNCTION
  496.                     END SELECT
  497.                     t = _NEWIMAGE(1, 1, n4)
  498.                     SELECT CASE OName(p)
  499.                         CASE "_RED": n1 = _RED(n, t)
  500.                         CASE "_BLUE": n1 = _BLUE(n, t)
  501.                         CASE "_GREEN": n1 = _GREEN(n, t)
  502.                         CASE "_ALPHA": n1 = _ALPHA(n, t)
  503.                     END SELECT
  504.                     _FREEIMAGE t
  505.                 CASE "_RED32", "_GREEN32", "_BLUE32", "_ALPHA32"
  506.                     n$ = num(2)
  507.                     IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null " + OName(p): EXIT FUNCTION
  508.                     n = VAL(num(2))
  509.                     SELECT CASE OName(p)
  510.                         CASE "_RED32": n1 = _RED32(n)
  511.                         CASE "_BLUE32": n1 = _BLUE32(n)
  512.                         CASE "_GREEN32": n1 = _GREEN32(n)
  513.                         CASE "_ALPHA32": n1 = _ALPHA32(n)
  514.                     END SELECT
  515.                 CASE "COS": n1 = COS(VAL(num(2)))
  516.                 CASE "SIN": n1 = SIN(VAL(num(2)))
  517.                 CASE "TAN": n1 = TAN(VAL(num(2)))
  518.                 CASE "LOG": n1 = LOG(VAL(num(2)))
  519.                 CASE "EXP": n1 = EXP(VAL(num(2)))
  520.                 CASE "ATN": n1 = ATN(VAL(num(2)))
  521.                 CASE "_D2R": n1 = 0.0174532925 * (VAL(num(2)))
  522.                 CASE "_D2G": n1 = 1.1111111111 * (VAL(num(2)))
  523.                 CASE "_R2D": n1 = 57.2957795 * (VAL(num(2)))
  524.                 CASE "_R2G": n1 = 0.015707963 * (VAL(num(2)))
  525.                 CASE "_G2D": n1 = 0.9 * (VAL(num(2)))
  526.                 CASE "_G2R": n1 = 63.661977237 * (VAL(num(2)))
  527.                 CASE "ABS": n1 = ABS(VAL(num(2)))
  528.                 CASE "SGN": n1 = SGN(VAL(num(2)))
  529.                 CASE "INT": n1 = INT(VAL(num(2)))
  530.                 CASE "_ROUND": n1 = _ROUND(VAL(num(2)))
  531.                 CASE "_CEIL": n1 = _CEIL(VAL(num(2)))
  532.                 CASE "FIX": n1 = FIX(VAL(num(2)))
  533.                 CASE "_SEC": n1 = _SEC(VAL(num(2)))
  534.                 CASE "_CSC": n1 = _CSC(VAL(num(2)))
  535.                 CASE "_COT": n1 = _COT(VAL(num(2)))
  536.             END SELECT
  537.         CASE 20 TO 60 'Math Operators
  538.             SELECT CASE OName(p) 'Depending on our operator..
  539.                 CASE "^": n1 = VAL(num(1)) ^ VAL(num(2))
  540.                 CASE "SQR": n1 = SQR(VAL(num(2)))
  541.                 CASE "ROOT"
  542.                     n1 = VAL(num(1)): n2 = VAL(num(2))
  543.                     IF n2 = 1 THEN EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1))): EXIT FUNCTION
  544.                     IF n1 < 0 AND n2 >= 1 THEN sign = -1: n1 = -n1 ELSE sign = 1
  545.                     n3 = 1## / n2
  546.                     IF n3 <> INT(n3) AND n2 < 1 THEN sign = SGN(n1): n1 = ABS(n1)
  547.                     n1 = sign * (n1 ^ n3)
  548.                 CASE "*": n1 = VAL(num(1)) * VAL(num(2))
  549.                 CASE "/": n1 = VAL(num(1)) / VAL(num(2))
  550.                 CASE "\"
  551.                     IF VAL(num(2)) <> 0 THEN
  552.                         n1 = VAL(num(1)) \ VAL(num(2))
  553.                     ELSE
  554.                         EvaluateNumbers$ = "ERROR - Bad operation (We shouldn't see this)"
  555.                         EXIT FUNCTION
  556.                     END IF
  557.                 CASE "MOD": n1 = VAL(num(1)) MOD VAL(num(2))
  558.                 CASE "+": n1 = VAL(num(1)) + VAL(num(2))
  559.                 CASE "-": n1 = VAL(num(1)) - VAL(num(2))
  560.             END SELECT
  561.         CASE 70 'Relational Operators =, >, <, <>, <=, >=
  562.             SELECT CASE OName(p) 'Depending on our operator..
  563.                 CASE "=": n1 = VAL(num(1)) = VAL(num(2))
  564.                 CASE ">": n1 = VAL(num(1)) > VAL(num(2))
  565.                 CASE "<": n1 = VAL(num(1)) < VAL(num(2))
  566.                 CASE "<>", "><": n1 = VAL(num(1)) <> VAL(num(2))
  567.                 CASE "<=", "=<": n1 = VAL(num(1)) <= VAL(num(2))
  568.                 CASE ">=", "=>": n1 = VAL(num(1)) >= VAL(num(2))
  569.             END SELECT
  570.         CASE ELSE 'a value we haven't processed elsewhere
  571.             SELECT CASE OName(p) 'Depending on our operator..
  572.                 CASE "NOT": n1 = NOT VAL(num(2))
  573.                 CASE "AND": n1 = VAL(num(1)) AND VAL(num(2))
  574.                 CASE "OR": n1 = VAL(num(1)) OR VAL(num(2))
  575.                 CASE "XOR": n1 = VAL(num(1)) XOR VAL(num(2))
  576.                 CASE "EQV": n1 = VAL(num(1)) EQV VAL(num(2))
  577.                 CASE "IMP": n1 = VAL(num(1)) IMP VAL(num(2))
  578.             END SELECT
  579.     END SELECT
  580.  
  581.     EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1)))
  582.  
  583. FUNCTION DWD$ (exp$) 'Deal With Duplicates
  584.     'To deal with duplicate operators in our code.
  585.     'Such as --  becomes a +
  586.     '++ becomes a +
  587.     '+- becomes a -
  588.     '-+ becomes a -
  589.     t$ = exp$
  590.     DO
  591.         bad = 0
  592.         DO
  593.             l = INSTR(t$, "++")
  594.             IF l THEN t$ = LEFT$(t$, l - 1) + "+" + MID$(t$, l + 2): bad = -1
  595.         LOOP UNTIL l = 0
  596.         DO
  597.             l = INSTR(t$, "+-")
  598.             IF l THEN t$ = LEFT$(t$, l - 1) + "-" + MID$(t$, l + 2): bad = -1
  599.         LOOP UNTIL l = 0
  600.         DO
  601.             l = INSTR(t$, "-+")
  602.             IF l THEN t$ = LEFT$(t$, l - 1) + "-" + MID$(t$, l + 2): bad = -1
  603.         LOOP UNTIL l = 0
  604.         DO
  605.             l = INSTR(t$, "--")
  606.             IF l THEN t$ = LEFT$(t$, l - 1) + "+" + MID$(t$, l + 2): bad = -1
  607.         LOOP UNTIL l = 0
  608.     LOOP UNTIL NOT bad
  609.     DWD$ = t$
  610.     VerifyString t$
  611.  
  612. SUB PreParse (e$)
  613.     DIM f AS _FLOAT
  614.     STATIC TypeMod(1 TO 15) AS STRING, ConvertedMod(1 TO 15) AS STRING
  615.     IF TypeMod(1) = "" THEN
  616.         TypeMod(1) = "~`": ConvertedMod(1) = "C_UBI" 'unsigned bit
  617.         TypeMod(2) = "~%%": ConvertedMod(2) = "C_UBY" 'unsigned byte
  618.         TypeMod(3) = "~%&": ConvertedMod(3) = "C_UOF" 'unsigned offset
  619.         TypeMod(4) = "~%": ConvertedMod(4) = "C_UIN" 'unsigned integer
  620.         TypeMod(5) = "~&&": ConvertedMod(5) = "C_UIF" 'unsigned integer64
  621.         TypeMod(6) = "~&": ConvertedMod(6) = "C_ULO" 'unsigned long
  622.         TypeMod(7) = "`": ConvertedMod(7) = "C_BI" 'bit
  623.         TypeMod(8) = "%%": ConvertedMod(8) = "C_BY" 'byte
  624.         TypeMod(9) = "%&": ConvertedMod(9) = "C_OF" 'offset
  625.         TypeMod(10) = "%": ConvertedMod(10) = "C_IN" 'integer
  626.         TypeMod(11) = "&&": ConvertedMod(11) = "C_IF" 'integer64
  627.         TypeMod(12) = "&": ConvertedMod(12) = "C_LO" 'long
  628.         TypeMod(13) = "!": ConvertedMod(13) = "C_SI" 'single
  629.         TypeMod(14) = "##": ConvertedMod(14) = "C_FL" 'float
  630.         TypeMod(15) = "#": ConvertedMod(15) = "C_DO" 'double
  631.     END IF
  632.     t$ = e$
  633.  
  634.     'First strip all spaces
  635.     t$ = ""
  636.     FOR i = 1 TO LEN(e$)
  637.         IF MID$(e$, i, 1) <> " " THEN t$ = t$ + MID$(e$, i, 1)
  638.     NEXT
  639.  
  640.     t$ = UCASE$(t$)
  641.     IF t$ = "" THEN e$ = "ERROR -- NULL string; nothing to evaluate": EXIT SUB
  642.  
  643.     'ERROR CHECK by counting our brackets
  644.     l = 0
  645.     DO
  646.         l = INSTR(l + 1, t$, "("): IF l THEN c = c + 1
  647.     LOOP UNTIL l = 0
  648.     l = 0
  649.     DO
  650.         l = INSTR(l + 1, t$, ")"): IF l THEN c1 = c1 + 1
  651.     LOOP UNTIL l = 0
  652.     IF c <> c1 THEN e$ = "ERROR -- Bad Parenthesis:" + STR$(c) + "( vs" + STR$(c1) + ")": EXIT SUB
  653.  
  654.     'Modify so that NOT will process properly
  655.     l = 0
  656.     DO
  657.         l = INSTR(l + 1, t$, "NOT")
  658.         IF l THEN
  659.             'We need to work magic on the statement so it looks pretty.
  660.             ' 1 + NOT 2 + 1 is actually processed as 1 + (NOT 2 + 1)
  661.             'Look for something not proper
  662.             l1 = INSTR(l + 1, t$, "AND")
  663.             IF l1 = 0 OR (INSTR(l + 1, t$, "OR") > 0 AND INSTR(l + 1, t$, "OR") < l1) THEN l1 = INSTR(l + 1, t$, "OR")
  664.             IF l1 = 0 OR (INSTR(l + 1, t$, "XOR") > 0 AND INSTR(l + 1, t$, "XOR") < l1) THEN l1 = INSTR(l + 1, t$, "XOR")
  665.             IF l1 = 0 OR (INSTR(l + 1, t$, "EQV") > 0 AND INSTR(l + 1, t$, "EQV") < l1) THEN l1 = INSTR(l + 1, t$, "EQV")
  666.             IF l1 = 0 OR (INSTR(l + 1, t$, "IMP") > 0 AND INSTR(l + 1, t$, "IMP") < l1) THEN l1 = INSTR(l + 1, t$, "IMP")
  667.             IF l1 = 0 THEN l1 = LEN(t$) + 1
  668.             t$ = LEFT$(t$, l - 1) + "(" + MID$(t$, l, l1 - l) + ")" + MID$(t$, l + l1 - l)
  669.             l = l + 3
  670.             'PRINT t$
  671.         END IF
  672.     LOOP UNTIL l = 0
  673.  
  674.     'Modify so that % will process properly
  675.  
  676.     FOR j = 1 TO 15
  677.         l = 0
  678.         DO
  679.             l = INSTR(l + 1, t$, TypeMod(j))
  680.             IF l = 0 THEN EXIT DO
  681.             i = 0: l1 = 0: l2 = 0: lo = LEN(TypeMod(j))
  682.             DO
  683.                 IF PL(i) > 10 THEN
  684.                     l2 = _INSTRREV(l, t$, OName$(i))
  685.                     IF l2 > 0 AND l2 > l1 THEN l1 = l2
  686.                 END IF
  687.                 i = i + lo
  688.             LOOP UNTIL i > UBOUND(PL)
  689.             'PRINT "L1:"; l1; "L"; l
  690.             l$ = LEFT$(t$, l1)
  691.             m$ = MID$(t$, l1 + 1, l - l1 - 1)
  692.             r$ = ConvertedMod(j) + MID$(t$, l + lo)
  693.             'PRINT "Y$: "; TypeMod(j)
  694.             'PRINT "L$: "; l$
  695.             'PRINT "M$: "; m$
  696.             'PRINT "R$: "; r$
  697.             t$ = l$ + "(" + m$ + ")" + r$
  698.             'PRINT "T$: "; t$
  699.             l = l + 2 + LEN(TypeMod(j)) 'move forward from the length of the symbol we checked + the new "(" and  ")"
  700.         LOOP
  701.     NEXT
  702.     'PRINT "HERE: "; t$
  703.  
  704.  
  705.     'Check for bad operators before a ( bracket
  706.     l = 0
  707.     DO
  708.         l = INSTR(l + 1, t$, "(")
  709.         IF l AND l > 2 THEN 'Don't check the starting bracket; there's nothing before it.
  710.             good = 0
  711.             'PRINT "BEFORE: "; t$; l
  712.             FOR i = 1 TO UBOUND(OName)
  713.  
  714.                 m$ = MID$(t$, l - LEN(OName(i)), LEN(OName(i)))
  715.                 'IF OName(i) = "C_SI" THEN PRINT "CONVERT TO SINGLE", m$
  716.                 IF m$ = OName(i) THEN
  717.                     IF 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)
  718.                 END IF
  719.             NEXT
  720.             'PRINT t$; l
  721.             IF NOT good THEN e$ = "ERROR - Improper operations before (.": EXIT SUB
  722.             l = l + 1
  723.         END IF
  724.     LOOP UNTIL l = 0
  725.  
  726.     'Check for bad operators after a ) bracket
  727.     l = 0
  728.     DO
  729.         l = INSTR(l + 1, t$, ")")
  730.         IF l AND l < LEN(t$) THEN
  731.             good = 0
  732.             FOR i = 1 TO UBOUND(oname)
  733.                 m$ = MID$(t$, l + 1, LEN(OName(i)))
  734.                 IF m$ = OName(i) THEN
  735.                     IF 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)
  736.                 END IF
  737.             NEXT
  738.             IF MID$(t$, l + 1, 1) = ")" THEN good = -1
  739.             IF NOT good THEN e$ = "ERROR - Improper operations after ).": EXIT SUB
  740.             l = l + 1
  741.         END IF
  742.     LOOP UNTIL l = 0 OR l = LEN(t$) 'last symbol is a bracket
  743.  
  744.     'Turn all &H (hex) numbers into decimal values for the program to process properly
  745.     l = 0
  746.     DO
  747.         l = INSTR(t$, "&H")
  748.         IF l THEN
  749.             E = l + 1: finished = 0
  750.             DO
  751.                 E = E + 1
  752.                 comp$ = MID$(t$, E, 1)
  753.                 SELECT CASE comp$
  754.                     CASE "0" TO "9", "A" TO "F" 'All is good, our next digit is a number, continue to add to the hex$
  755.                     CASE ELSE
  756.                         good = 0
  757.                         FOR i = 1 TO UBOUND(oname)
  758.                             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)
  759.                         NEXT
  760.                         IF NOT good THEN e$ = "ERROR - Improper &H value. (" + comp$ + ")": EXIT SUB
  761.                         E = E - 1
  762.                         finished = -1
  763.                 END SELECT
  764.             LOOP UNTIL finished OR E = LEN(t$)
  765.             t$ = LEFT$(t$, l - 1) + LTRIM$(RTRIM$(STR$(VAL(MID$(t$, l, E - l + 1))))) + MID$(t$, E + 1)
  766.         END IF
  767.     LOOP UNTIL l = 0
  768.  
  769.     'Turn all &B (binary) numbers into decimal values for the program to process properly
  770.     l = 0
  771.     DO
  772.         l = INSTR(t$, "&B")
  773.         IF l THEN
  774.             E = l + 1: finished = 0
  775.             DO
  776.                 E = E + 1
  777.                 comp$ = MID$(t$, E, 1)
  778.                 SELECT CASE comp$
  779.                     CASE "0", "1" 'All is good, our next digit is a number, continue to add to the hex$
  780.                     CASE ELSE
  781.                         good = 0
  782.                         FOR i = 1 TO UBOUND(oname)
  783.                             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)
  784.                         NEXT
  785.                         IF NOT good THEN e$ = "ERROR - Improper &B value. (" + comp$ + ")": EXIT SUB
  786.                         E = E - 1
  787.                         finished = -1
  788.                 END SELECT
  789.             LOOP UNTIL finished OR E = LEN(t$)
  790.             bin$ = MID$(t$, l + 2, E - l - 1)
  791.             FOR i = 1 TO LEN(bin$)
  792.                 IF MID$(bin$, i, 1) = "1" THEN f = f + 2 ^ (LEN(bin$) - i)
  793.             NEXT
  794.             t$ = LEFT$(t$, l - 1) + LTRIM$(RTRIM$(STR$(f))) + MID$(t$, E + 1)
  795.         END IF
  796.     LOOP UNTIL l = 0
  797.  
  798.     'PRINT "ALMOST:"; t$
  799.  
  800.     t$ = N2S(t$)
  801.     'PRINT "ALMOST2:"; t$
  802.     VerifyString t$
  803.  
  804.     e$ = t$
  805.  
  806.  
  807.  
  808. SUB VerifyString (t$)
  809.     'ERROR CHECK for unrecognized operations
  810.     j = 1
  811.     DO
  812.         comp$ = MID$(t$, j, 1)
  813.         SELECT CASE comp$
  814.             CASE "0" TO "9", ".", "(", ")", ",": j = j + 1
  815.             CASE ELSE
  816.                 good = 0
  817.                 FOR i = 1 TO UBOUND(OName)
  818.                     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)
  819.                 NEXT
  820.                 IF NOT good THEN t$ = "ERROR - Bad Operational value. (" + comp$ + ")": EXIT SUB
  821.                 j = j + LEN(OName(i))
  822.         END SELECT
  823.     LOOP UNTIL j > LEN(t$)
  824.  
  825. FUNCTION N2S$ (exp$) 'scientific Notation to String
  826.     t$ = LTRIM$(RTRIM$(exp$))
  827.     IF LEFT$(t$, 1) = "-" THEN sign$ = "-": t$ = MID$(t$, 2)
  828.  
  829.     dp = INSTR(t$, "D+"): dm = INSTR(t$, "D-")
  830.     ep = INSTR(t$, "E+"): em = INSTR(t$, "E-")
  831.     check1 = SGN(dp) + SGN(dm) + SGN(ep) + SGN(em)
  832.     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!
  833.  
  834.     SELECT CASE l 'l now tells us where the SN starts at.
  835.         CASE IS < dp: l = dp
  836.         CASE IS < dm: l = dm
  837.         CASE IS < ep: l = ep
  838.         CASE IS < em: l = em
  839.     END SELECT
  840.  
  841.     l$ = LEFT$(t$, l - 1) 'The left of the SN
  842.     r$ = MID$(t$, l + 1): r&& = VAL(r$) 'The right of the SN, turned into a workable long
  843.  
  844.  
  845.     IF INSTR(l$, ".") THEN 'Location of the decimal, if any
  846.         IF r&& > 0 THEN
  847.             r&& = r&& - LEN(l$) + 2
  848.         ELSE
  849.             r&& = r&& + 1
  850.         END IF
  851.         l$ = LEFT$(l$, 1) + MID$(l$, 3)
  852.     END IF
  853.  
  854.     SELECT CASE r&&
  855.         CASE 0 'what the heck? We solved it already?
  856.             'l$ = l$
  857.         CASE IS < 0
  858.             FOR i = 1 TO -r&&
  859.                 l$ = "0" + l$
  860.             NEXT
  861.             l$ = "0." + l$
  862.         CASE ELSE
  863.             FOR i = 1 TO r&&
  864.                 l$ = l$ + "0"
  865.             NEXT
  866.     END SELECT
  867.  
  868.     N2S$ = sign$ + l$

Any other commands which are missing?  I haven't had a change to look over the whole list of what QB64 offers yet, so I don't know if I'm missing anything or not.
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

FellippeHeitor

  • Guest
Re: Steve's Math Evaluator
« Reply #11 on: January 05, 2020, 10:07:29 pm »
Any other commands which are missing?  I haven't had a change to look over the whole list of what QB64 offers yet, so I don't know if I'm missing anything or not.

Here's from my interpreter, grabbed this list from subs_functions (of course there's more here than math functions):
Code: QB64: [Select]
  1.             SELECT CASE RTRIM$(vars(varIndex).name)
  2.                 CASE "cos"
  3.                     GetVal## = COS(temp##)
  4.                 CASE "val"
  5.                     GetVal## = VAL(temp$)
  6.                 CASE "int"
  7.                     GetVal## = INT(temp##)
  8.                 CASE "asc"
  9.                     GetVal## = ASC(temp$)
  10.                 CASE "sin"
  11.                     GetVal## = SIN(temp##)
  12.                 CASE "len"
  13.                     GetVal## = LEN(temp$)
  14.                 CASE "rnd"
  15.                     GetVal## = RND
  16.                 CASE "timer"
  17.                     GetVal## = TIMER
  18.                 CASE "time$"
  19.                     foundAsText = true
  20.                     textReturn$ = TIME$
  21.                 CASE "date$"
  22.                     foundAsText = true
  23.                     textReturn$ = DATE$
  24.                 CASE "chr$"
  25.                     foundAsText = true
  26.                     textReturn$ = CHR$(temp##)
  27.                 CASE "str$"
  28.                     foundAsText = true
  29.                     textReturn$ = STR$(temp##)
  30.                 CASE "inkey$"
  31.                     foundAsText = true
  32.                     textReturn$ = INKEY$
  33.                 CASE "_width"
  34.                     GetVal## = _WIDTH
  35.                 CASE "_height"
  36.                     GetVal## = _HEIGHT
  37.                 CASE "_mousex"
  38.                     GetVal## = _MOUSEX
  39.                 CASE "_mousey"
  40.                     GetVal## = _MOUSEY
  41.                 CASE "_mousebutton"
  42.                     GetVal## = _MOUSEBUTTON(temp##)
  43.                 CASE "_resize"
  44.                     GetVal## = _RESIZE
  45.                 CASE "_resizewidth"
  46.                     GetVal## = _RESIZEWIDTH
  47.                 CASE "_resizeheight"
  48.                     GetVal## = _RESIZEHEIGHT
  49.                 CASE "_scaledwidth"
  50.                     GetVal## = _SCALEDWIDTH
  51.                 CASE "_scaledheight"
  52.                     GetVal## = _SCALEDHEIGHT
  53.                 CASE "_screenhide"
  54.                     GetVal## = _SCREENHIDE
  55.                 CASE "_console"
  56.                     GetVal## = _CONSOLE
  57.                 CASE "_blink"
  58.                     GetVal## = _BLINK
  59.                 CASE "_fileexists"
  60.                     GetVal## = _FILEEXISTS(temp$)
  61.                 CASE "_direxists"
  62.                     GetVal## = _DIREXISTS(temp$)
  63.                 CASE "_devices"
  64.                     GetVal## = _DEVICES
  65.                 CASE "_device$"
  66.                     foundAsText = true
  67.                     textReturn$ = _DEVICE$
  68.                 CASE "_deviceinput"
  69.                     GetVal## = _DEVICEINPUT
  70.                 CASE "_lastbutton"
  71.                     GetVal## = _LASTBUTTON
  72.                 CASE "_lastaxis"
  73.                     GetVal## = _LASTAXIS
  74.                 CASE "_lastwheel"
  75.                     GetVal## = _LASTWHEEL
  76.                 CASE "_button"
  77.                     GetVal## = _BUTTON
  78.                 CASE "_buttonchange"
  79.                     GetVal## = _BUTTONCHANGE
  80.                 CASE "_axis"
  81.                     GetVal## = _AXIS
  82.                 CASE "_wheel"
  83.                     GetVal## = _WHEEL
  84.                 CASE "_screenx"
  85.                     GetVal## = _SCREENX
  86.                 CASE "_screeny"
  87.                     GetVal## = _SCREENY
  88.                 CASE "_os$"
  89.                     foundAsText = true
  90.                     textReturn$ = _OS$
  91.                 CASE "_title$"
  92.                     foundAsText = true
  93.                     textReturn$ = _TITLE$
  94.                 CASE "_mapunicode"
  95.                     GetVal## = _MAPUNICODE(temp##)
  96.                 CASE "_keydown"
  97.                     GetVal## = _KEYDOWN(temp##)
  98.                 CASE "_keyhit"
  99.                     GetVal## = _KEYHIT
  100.                 CASE "_windowhandle"
  101.                     GetVal## = _WINDOWHANDLE
  102.                 CASE "_screenimage"
  103.                     GetVal## = _SCREENIMAGE
  104.                 CASE "_freetimer"
  105.                     GetVal## = _FREETIMER
  106.                 CASE "_fullscreen"
  107.                     GetVal## = _FULLSCREEN
  108.                 CASE "_smooth"
  109.                     GetVal## = _SMOOTH
  110.                 CASE "_windowhasfocus"
  111.                     GetVal## = _WINDOWHASFOCUS
  112.                 CASE "_clipboard$"
  113.                     foundAsText = true
  114.                     textReturn$ = _CLIPBOARD$
  115.                 CASE "_clipboardimage"
  116.                     GetVal## = _CLIPBOARDIMAGE
  117.                 CASE "_exit"
  118.                     GetVal## = _EXIT
  119.                 CASE "_openhost"
  120.                     GetVal## = _OPENHOST(temp$)
  121.                 CASE "_connected"
  122.                     GetVal## = _CONNECTED(temp##)
  123.                 CASE "_connectionaddress", "_connectionaddress$"
  124.                     foundAsText = true
  125.                     textReturn$ = _CONNECTIONADDRESS$(temp##)
  126.                 CASE "_openconnection"
  127.                     GetVal## = _OPENCONNECTION(temp##)
  128.                 CASE "_openclient"
  129.                     GetVal## = _OPENCLIENT(temp$)
  130.                 CASE "environ$"
  131.                     foundAsText = true
  132.                     textReturn$ = ENVIRON$(temp$)
  133.                 CASE "_errorline"
  134.                     GetVal## = lineThatErrored
  135.                 CASE "_inclerrorline"
  136.                     'GetVal## = _INCLERRORLINE
  137.                 CASE "_acceptfiledrop"
  138.                     GetVal## = _ACCEPTFILEDROP
  139.                 CASE "_totaldroppedfiles"
  140.                     GetVal## = _TOTALDROPPEDFILES
  141.                 CASE "_droppedfile", "_droppedfile$"
  142.                     foundAsText = true
  143.                     textReturn$ = _DROPPEDFILE$
  144.                 CASE "_newimage"
  145.                     'GetVal## = _newimage
  146.                 CASE "_loadimage"
  147.                     GetVal## = _LOADIMAGE(temp$)
  148.                 CASE "_copyimage"
  149.                     GetVal## = _COPYIMAGE(temp##)
  150.                 CASE "_source"
  151.                     GetVal## = _SOURCE
  152.                 CASE "_dest"
  153.                     GetVal## = _DEST
  154.                 CASE "_display"
  155.                     GetVal## = _DISPLAY
  156.                 CASE "_pixelsize"
  157.                     GetVal## = _PIXELSIZE
  158.                 CASE "_clearcolor"
  159.                     GetVal## = _CLEARCOLOR
  160.                 CASE "_blend"
  161.                     GetVal## = _BLEND
  162.                 CASE "_defaultcolor"
  163.                     GetVal## = _DEFAULTCOLOR
  164.                 CASE "_backgroundcolor"
  165.                     GetVal## = _BACKGROUNDCOLOR
  166.                 CASE "_palettecolor"
  167.                     GetVal## = _PALETTECOLOR(temp##)
  168.                 CASE "_loadfont"
  169.                     'GetVal## = _loadfont
  170.                 CASE "_fontwidth"
  171.                     GetVal## = _FONTWIDTH
  172.                 CASE "_fontheight"
  173.                     GetVal## = _FONTHEIGHT
  174.                 CASE "_font"
  175.                     GetVal## = _FONT
  176.                 CASE "_printwidth"
  177.                     GetVal## = _PRINTWIDTH(temp$)
  178.                 CASE "_printmode"
  179.                     GetVal## = _PRINTMODE
  180.                 CASE "_rgba"
  181.                     'GetVal## = _rgba
  182.                 CASE "_rgba32"
  183.                     'GetVal## = _rgba32
  184.                 CASE "_rgb"
  185.                     'GetVal## = _rgb
  186.                 CASE "_rgb32"
  187.                     'GetVal## = _rgb32
  188.                 CASE "_red"
  189.                     'GetVal## = _red
  190.                 CASE "_red32"
  191.                     'GetVal## = _red32
  192.                 CASE "_green"
  193.                     'GetVal## = _green
  194.                 CASE "_green32"
  195.                     'GetVal## = _green32
  196.                 CASE "_blue"
  197.                     'GetVal## = _blue
  198.                 CASE "_blue32"
  199.                     'GetVal## = _blue32
  200.                 CASE "_alpha"
  201.                     'GetVal## = _alpha
  202.                 CASE "_alpha32"
  203.                     'GetVal## = _alpha32
  204.                 CASE "_mouseinput"
  205.                     GetVal## = _MOUSEINPUT
  206.                 CASE "_mousewheel"
  207.                     GetVal## = _MOUSEWHEEL
  208.                 CASE "freefile"
  209.                     GetVal## = FREEFILE
  210.                 CASE "shell"
  211.                     GetVal## = SHELL(temp$)
  212.                 CASE "_shellhide"
  213.                     GetVal## = _SHELLHIDE(temp$)
  214.                 CASE "command$"
  215.                     foundAsText = true
  216.                     textReturn$ = COMMAND$(temp##)
  217.                 CASE "_commandcount"
  218.                     GetVal## = _COMMANDCOUNT
  219.                 CASE "_sndrate"
  220.                     GetVal## = _SNDRATE
  221.                 CASE "_sndopenraw"
  222.                     GetVal## = _SNDOPENRAW
  223.                 CASE "_sndrawlen"
  224.                     GetVal## = _SNDRAWLEN
  225.                 CASE "_sndlen"
  226.                     GetVal## = _SNDLEN(temp##)
  227.                 CASE "_sndpaused"
  228.                     GetVal## = _SNDPAUSED(temp##)
  229.                 CASE "_sndopen"
  230.                     GetVal## = _SNDOPEN(temp$)
  231.                 CASE "_sndgetpos"
  232.                     GetVal## = _SNDGETPOS(temp##)
  233.                 CASE "_sndplaying"
  234.                     GetVal## = _SNDPLAYING(temp##)
  235.                 CASE "_sndcopy"
  236.                     GetVal## = _SNDCOPY(temp##)
  237.                 CASE "seek"
  238.                     GetVal## = SEEK(temp##)
  239.                 CASE "loc"
  240.                     GetVal## = LOC(temp##)
  241.                 CASE "eof"
  242.                     GetVal## = EOF(temp##)
  243.                 CASE "lof"
  244.                     GetVal## = LOF(temp##)
  245.                 CASE "screen"
  246.                     'GetVal## = screen
  247.                 CASE "point"
  248.                     'GetVal## = point
  249.                 CASE "tab"
  250.                     foundAsText = true
  251.                     textReturn$ = TAB(temp##)
  252.                 CASE "spc"
  253.                     foundAsText = true
  254.                     textReturn$ = SPC(temp##)
  255.                 CASE "inp"
  256.                     GetVal## = INP(temp##)
  257.                 CASE "pos"
  258.                     GetVal## = POS(temp##)
  259.                 CASE "sgn"
  260.                     GetVal## = SGN(temp##)
  261.                 CASE "lbound"
  262.                     'GetVal## = lbound
  263.                 CASE "ubound"
  264.                     'GetVal## = ubound
  265.                 CASE "oct$"
  266.                     foundAsText = true
  267.                     textReturn$ = OCT$(temp##)
  268.                 CASE "hex$"
  269.                     foundAsText = true
  270.                     textReturn$ = HEX$(temp##)
  271.                 CASE "exp"
  272.                     GetVal## = EXP(temp##)
  273.                 CASE "fix"
  274.                     GetVal## = FIX(temp##)
  275.                 CASE "cdbl"
  276.                     GetVal## = CDBL(temp##)
  277.                 CASE "csng"
  278.                     GetVal## = CSNG(temp##)
  279.                 CASE "_round"
  280.                     GetVal## = _ROUND(temp##)
  281.                 CASE "cint"
  282.                     GetVal## = CINT(temp##)
  283.                 CASE "clng"
  284.                     GetVal## = CLNG(temp##)
  285.                 CASE "csrlin"
  286.                     GetVal## = CSRLIN
  287.                 CASE "mki$"
  288.                     foundAsText = true
  289.                     textReturn$ = MKI$(temp##)
  290.                 CASE "mkl$"
  291.                     foundAsText = true
  292.                     textReturn$ = MKL$(temp##)
  293.                 CASE "mks$"
  294.                     foundAsText = true
  295.                     textReturn$ = MKS$(temp##)
  296.                 CASE "mkd$"
  297.                     foundAsText = true
  298.                     textReturn$ = MKD$(temp##)
  299.                 CASE "mksmbf$"
  300.                     foundAsText = true
  301.                     textReturn$ = MKSMBF$(temp##)
  302.                 CASE "mkdmbf$"
  303.                     foundAsText = true
  304.                     textReturn$ = MKDMBF$(temp##)
  305.                 CASE "_mk$"
  306.                     foundAsText = true
  307.                     'textReturn$ = _mk$
  308.                 CASE "cvsmbf"
  309.                     GetVal## = CVSMBF(temp$)
  310.                 CASE "cvdmbf"
  311.                     GetVal## = CVDMBF(temp$)
  312.                 CASE "cvi"
  313.                     GetVal## = CVI(temp$)
  314.                 CASE "cvl"
  315.                     GetVal## = CVL(temp$)
  316.                 CASE "cvs"
  317.                     GetVal## = CVS(temp$)
  318.                 CASE "cvd"
  319.                     GetVal## = CVD(temp$)
  320.                 CASE "_cv"
  321.                     'GetVal## = _cv
  322.                 CASE "string$"
  323.                     'foundAsText = true
  324.                     'textReturn$ = string$(temp##)
  325.                 CASE "space$"
  326.                     foundAsText = true
  327.                     textReturn$ = SPACE$(temp##)
  328.                 CASE "instr"
  329.                     'GetVal## = instr
  330.                 CASE "_instrrev"
  331.                     'GetVal## = _instrrev
  332.                 CASE "mid$"
  333.                     'foundAsText = true
  334.                     'textReturn$ = mid$
  335.                 CASE "sqr"
  336.                     GetVal## = SQR(temp##)
  337.                 CASE "tan"
  338.                     GetVal## = TAN(temp##)
  339.                 CASE "atn"
  340.                     GetVal## = ATN(temp##)
  341.                 CASE "log"
  342.                     GetVal## = LOG(temp##)
  343.                 CASE "abs"
  344.                     GetVal## = ABS(temp##)
  345.                 CASE "erl"
  346.                     GetVal## = lineThatErrored
  347.                 CASE "err"
  348.                     GetVal## = ERR
  349.                 CASE "ucase$"
  350.                     foundAsText = true
  351.                     textReturn$ = UCASE$(temp$)
  352.                 CASE "lcase$"
  353.                     foundAsText = true
  354.                     textReturn$ = LCASE$(temp$)
  355.                 CASE "left$"
  356.                     'foundAsText = true
  357.                     'textReturn$ = left$
  358.                 CASE "right$"
  359.                     'foundAsText = true
  360.                     'textReturn$ = right$
  361.                 CASE "ltrim$"
  362.                     foundAsText = true
  363.                     textReturn$ = LTRIM$(temp$)
  364.                 CASE "rtrim$"
  365.                     foundAsText = true
  366.                     textReturn$ = RTRIM$(temp$)
  367.                 CASE "_trim$"
  368.                     foundAsText = true
  369.                     textReturn$ = _TRIM$(temp$)
  370.                 CASE "_cwd$"
  371.                     foundAsText = true
  372.                     textReturn$ = _CWD$
  373.                 CASE "_startdir$"
  374.                     foundAsText = true
  375.                     textReturn$ = _STARTDIR$
  376.                 CASE "_dir$"
  377.                     foundAsText = true
  378.                     textReturn$ = _DIR$(temp$)
  379.                 CASE "_inclerrorfile$"
  380.                     foundAsText = true
  381.                     textReturn$ = _INCLERRORFILE$
  382.                 CASE "_atan2"
  383.                     'GetVal## = _atan2
  384.                 CASE "_hypot"
  385.                     'GetVal## = _hypot
  386.                 CASE "_pi"
  387.                     IF temp$ = "" THEN temp## = 1
  388.                     GetVal## = _PI(temp##)
  389.                 CASE "_desktopheight"
  390.                     GetVal## = _DESKTOPHEIGHT
  391.                 CASE "_desktopwidth"
  392.                     GetVal## = _DESKTOPWIDTH
  393.                 CASE "_screenexists"
  394.                     GetVal## = _SCREENEXISTS
  395.                 CASE "_controlchr"
  396.                     GetVal## = _CONTROLCHR
  397.                 CASE "_stricmp"
  398.                     'GetVal## = _stricmp
  399.                 CASE "_strcmp"
  400.                     'GetVal## = _strcmp
  401.                 CASE "_autodisplay"
  402.                     GetVal## = _AUTODISPLAY
  403.                 CASE "_shr"
  404.                     'GetVal## = _shr
  405.                 CASE "_shl"
  406.                     'GetVal## = _shl
  407.                 CASE "_deflate$"
  408.                     foundAsText = true
  409.                     textReturn$ = _DEFLATE$(temp$)
  410.                 CASE "_inflate$"
  411.                     foundAsText = true
  412.                     textReturn$ = _INFLATE$(temp$)
  413.                 CASE "_readbit"
  414.                     'GetVal## = _readbit
  415.                 CASE "_setbit"
  416.                     'GetVal## = _setbit
  417.                 CASE "_resetbit"
  418.                     'GetVal## = _resetbit
  419.                 CASE "_togglebit"
  420.                     'GetVal## = _togglebit
  421.             END SELECT
« Last Edit: January 05, 2020, 10:08:40 pm by FellippeHeitor »

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Steve's Math Evaluator
« Reply #12 on: January 05, 2020, 10:55:53 pm »
Here's from my interpreter, grabbed this list from subs_functions (of course there's more here than math functions):
Code: QB64: [Select]
  1.             SELECT CASE RTRIM$(vars(varIndex).name)
  2.                 CASE "cos"
  3.                     GetVal## = COS(temp##)
  4.                 CASE "val"
  5.                     GetVal## = VAL(temp$)
  6.                 CASE "int"
  7.                     GetVal## = INT(temp##)
  8.                 CASE "asc"
  9.                     GetVal## = ASC(temp$)
  10.                 CASE "sin"
  11.                     GetVal## = SIN(temp##)
  12.                 CASE "len"
  13.                     GetVal## = LEN(temp$)
  14.                 CASE "rnd"
  15.                     GetVal## = RND
  16.                 CASE "timer"
  17.                     GetVal## = TIMER
  18.                 CASE "time$"
  19.                     foundAsText = true
  20.                     textReturn$ = TIME$
  21.                 CASE "date$"
  22.                     foundAsText = true
  23.                     textReturn$ = DATE$
  24.                 CASE "chr$"
  25.                     foundAsText = true
  26.                     textReturn$ = CHR$(temp##)
  27.                 CASE "str$"
  28.                     foundAsText = true
  29.                     textReturn$ = STR$(temp##)
  30.                 CASE "inkey$"
  31.                     foundAsText = true
  32.                     textReturn$ = INKEY$
  33.                 CASE "_width"
  34.                     GetVal## = _WIDTH
  35.                 CASE "_height"
  36.                     GetVal## = _HEIGHT
  37.                 CASE "_mousex"
  38.                     GetVal## = _MOUSEX
  39.                 CASE "_mousey"
  40.                     GetVal## = _MOUSEY
  41.                 CASE "_mousebutton"
  42.                     GetVal## = _MOUSEBUTTON(temp##)
  43.                 CASE "_resize"
  44.                     GetVal## = _RESIZE
  45.                 CASE "_resizewidth"
  46.                     GetVal## = _RESIZEWIDTH
  47.                 CASE "_resizeheight"
  48.                     GetVal## = _RESIZEHEIGHT
  49.                 CASE "_scaledwidth"
  50.                     GetVal## = _SCALEDWIDTH
  51.                 CASE "_scaledheight"
  52.                     GetVal## = _SCALEDHEIGHT
  53.                 CASE "_screenhide"
  54.                     GetVal## = _SCREENHIDE
  55.                 CASE "_console"
  56.                     GetVal## = _CONSOLE
  57.                 CASE "_blink"
  58.                     GetVal## = _BLINK
  59.                 CASE "_fileexists"
  60.                     GetVal## = _FILEEXISTS(temp$)
  61.                 CASE "_direxists"
  62.                     GetVal## = _DIREXISTS(temp$)
  63.                 CASE "_devices"
  64.                     GetVal## = _DEVICES
  65.                 CASE "_device$"
  66.                     foundAsText = true
  67.                     textReturn$ = _DEVICE$
  68.                 CASE "_deviceinput"
  69.                     GetVal## = _DEVICEINPUT
  70.                 CASE "_lastbutton"
  71.                     GetVal## = _LASTBUTTON
  72.                 CASE "_lastaxis"
  73.                     GetVal## = _LASTAXIS
  74.                 CASE "_lastwheel"
  75.                     GetVal## = _LASTWHEEL
  76.                 CASE "_button"
  77.                     GetVal## = _BUTTON
  78.                 CASE "_buttonchange"
  79.                     GetVal## = _BUTTONCHANGE
  80.                 CASE "_axis"
  81.                     GetVal## = _AXIS
  82.                 CASE "_wheel"
  83.                     GetVal## = _WHEEL
  84.                 CASE "_screenx"
  85.                     GetVal## = _SCREENX
  86.                 CASE "_screeny"
  87.                     GetVal## = _SCREENY
  88.                 CASE "_os$"
  89.                     foundAsText = true
  90.                     textReturn$ = _OS$
  91.                 CASE "_title$"
  92.                     foundAsText = true
  93.                     textReturn$ = _TITLE$
  94.                 CASE "_mapunicode"
  95.                     GetVal## = _MAPUNICODE(temp##)
  96.                 CASE "_keydown"
  97.                     GetVal## = _KEYDOWN(temp##)
  98.                 CASE "_keyhit"
  99.                     GetVal## = _KEYHIT
  100.                 CASE "_windowhandle"
  101.                     GetVal## = _WINDOWHANDLE
  102.                 CASE "_screenimage"
  103.                     GetVal## = _SCREENIMAGE
  104.                 CASE "_freetimer"
  105.                     GetVal## = _FREETIMER
  106.                 CASE "_fullscreen"
  107.                     GetVal## = _FULLSCREEN
  108.                 CASE "_smooth"
  109.                     GetVal## = _SMOOTH
  110.                 CASE "_windowhasfocus"
  111.                     GetVal## = _WINDOWHASFOCUS
  112.                 CASE "_clipboard$"
  113.                     foundAsText = true
  114.                     textReturn$ = _CLIPBOARD$
  115.                 CASE "_clipboardimage"
  116.                     GetVal## = _CLIPBOARDIMAGE
  117.                 CASE "_exit"
  118.                     GetVal## = _EXIT
  119.                 CASE "_openhost"
  120.                     GetVal## = _OPENHOST(temp$)
  121.                 CASE "_connected"
  122.                     GetVal## = _CONNECTED(temp##)
  123.                 CASE "_connectionaddress", "_connectionaddress$"
  124.                     foundAsText = true
  125.                     textReturn$ = _CONNECTIONADDRESS$(temp##)
  126.                 CASE "_openconnection"
  127.                     GetVal## = _OPENCONNECTION(temp##)
  128.                 CASE "_openclient"
  129.                     GetVal## = _OPENCLIENT(temp$)
  130.                 CASE "environ$"
  131.                     foundAsText = true
  132.                     textReturn$ = ENVIRON$(temp$)
  133.                 CASE "_errorline"
  134.                     GetVal## = lineThatErrored
  135.                 CASE "_inclerrorline"
  136.                     'GetVal## = _INCLERRORLINE
  137.                 CASE "_acceptfiledrop"
  138.                     GetVal## = _ACCEPTFILEDROP
  139.                 CASE "_totaldroppedfiles"
  140.                     GetVal## = _TOTALDROPPEDFILES
  141.                 CASE "_droppedfile", "_droppedfile$"
  142.                     foundAsText = true
  143.                     textReturn$ = _DROPPEDFILE$
  144.                 CASE "_newimage"
  145.                     'GetVal## = _newimage
  146.                 CASE "_loadimage"
  147.                     GetVal## = _LOADIMAGE(temp$)
  148.                 CASE "_copyimage"
  149.                     GetVal## = _COPYIMAGE(temp##)
  150.                 CASE "_source"
  151.                     GetVal## = _SOURCE
  152.                 CASE "_dest"
  153.                     GetVal## = _DEST
  154.                 CASE "_display"
  155.                     GetVal## = _DISPLAY
  156.                 CASE "_pixelsize"
  157.                     GetVal## = _PIXELSIZE
  158.                 CASE "_clearcolor"
  159.                     GetVal## = _CLEARCOLOR
  160.                 CASE "_blend"
  161.                     GetVal## = _BLEND
  162.                 CASE "_defaultcolor"
  163.                     GetVal## = _DEFAULTCOLOR
  164.                 CASE "_backgroundcolor"
  165.                     GetVal## = _BACKGROUNDCOLOR
  166.                 CASE "_palettecolor"
  167.                     GetVal## = _PALETTECOLOR(temp##)
  168.                 CASE "_loadfont"
  169.                     'GetVal## = _loadfont
  170.                 CASE "_fontwidth"
  171.                     GetVal## = _FONTWIDTH
  172.                 CASE "_fontheight"
  173.                     GetVal## = _FONTHEIGHT
  174.                 CASE "_font"
  175.                     GetVal## = _FONT
  176.                 CASE "_printwidth"
  177.                     GetVal## = _PRINTWIDTH(temp$)
  178.                 CASE "_printmode"
  179.                     GetVal## = _PRINTMODE
  180.                 CASE "_rgba"
  181.                     'GetVal## = _rgba
  182.                 CASE "_rgba32"
  183.                     'GetVal## = _rgba32
  184.                 CASE "_rgb"
  185.                     'GetVal## = _rgb
  186.                 CASE "_rgb32"
  187.                     'GetVal## = _rgb32
  188.                 CASE "_red"
  189.                     'GetVal## = _red
  190.                 CASE "_red32"
  191.                     'GetVal## = _red32
  192.                 CASE "_green"
  193.                     'GetVal## = _green
  194.                 CASE "_green32"
  195.                     'GetVal## = _green32
  196.                 CASE "_blue"
  197.                     'GetVal## = _blue
  198.                 CASE "_blue32"
  199.                     'GetVal## = _blue32
  200.                 CASE "_alpha"
  201.                     'GetVal## = _alpha
  202.                 CASE "_alpha32"
  203.                     'GetVal## = _alpha32
  204.                 CASE "_mouseinput"
  205.                     GetVal## = _MOUSEINPUT
  206.                 CASE "_mousewheel"
  207.                     GetVal## = _MOUSEWHEEL
  208.                 CASE "freefile"
  209.                     GetVal## = FREEFILE
  210.                 CASE "shell"
  211.                     GetVal## = SHELL(temp$)
  212.                 CASE "_shellhide"
  213.                     GetVal## = _SHELLHIDE(temp$)
  214.                 CASE "command$"
  215.                     foundAsText = true
  216.                     textReturn$ = COMMAND$(temp##)
  217.                 CASE "_commandcount"
  218.                     GetVal## = _COMMANDCOUNT
  219.                 CASE "_sndrate"
  220.                     GetVal## = _SNDRATE
  221.                 CASE "_sndopenraw"
  222.                     GetVal## = _SNDOPENRAW
  223.                 CASE "_sndrawlen"
  224.                     GetVal## = _SNDRAWLEN
  225.                 CASE "_sndlen"
  226.                     GetVal## = _SNDLEN(temp##)
  227.                 CASE "_sndpaused"
  228.                     GetVal## = _SNDPAUSED(temp##)
  229.                 CASE "_sndopen"
  230.                     GetVal## = _SNDOPEN(temp$)
  231.                 CASE "_sndgetpos"
  232.                     GetVal## = _SNDGETPOS(temp##)
  233.                 CASE "_sndplaying"
  234.                     GetVal## = _SNDPLAYING(temp##)
  235.                 CASE "_sndcopy"
  236.                     GetVal## = _SNDCOPY(temp##)
  237.                 CASE "seek"
  238.                     GetVal## = SEEK(temp##)
  239.                 CASE "loc"
  240.                     GetVal## = LOC(temp##)
  241.                 CASE "eof"
  242.                     GetVal## = EOF(temp##)
  243.                 CASE "lof"
  244.                     GetVal## = LOF(temp##)
  245.                 CASE "screen"
  246.                     'GetVal## = screen
  247.                 CASE "point"
  248.                     'GetVal## = point
  249.                 CASE "tab"
  250.                     foundAsText = true
  251.                     textReturn$ = TAB(temp##)
  252.                 CASE "spc"
  253.                     foundAsText = true
  254.                     textReturn$ = SPC(temp##)
  255.                 CASE "inp"
  256.                     GetVal## = INP(temp##)
  257.                 CASE "pos"
  258.                     GetVal## = POS(temp##)
  259.                 CASE "sgn"
  260.                     GetVal## = SGN(temp##)
  261.                 CASE "lbound"
  262.                     'GetVal## = lbound
  263.                 CASE "ubound"
  264.                     'GetVal## = ubound
  265.                 CASE "oct$"
  266.                     foundAsText = true
  267.                     textReturn$ = OCT$(temp##)
  268.                 CASE "hex$"
  269.                     foundAsText = true
  270.                     textReturn$ = HEX$(temp##)
  271.                 CASE "exp"
  272.                     GetVal## = EXP(temp##)
  273.                 CASE "fix"
  274.                     GetVal## = FIX(temp##)
  275.                 CASE "cdbl"
  276.                     GetVal## = CDBL(temp##)
  277.                 CASE "csng"
  278.                     GetVal## = CSNG(temp##)
  279.                 CASE "_round"
  280.                     GetVal## = _ROUND(temp##)
  281.                 CASE "cint"
  282.                     GetVal## = CINT(temp##)
  283.                 CASE "clng"
  284.                     GetVal## = CLNG(temp##)
  285.                 CASE "csrlin"
  286.                     GetVal## = CSRLIN
  287.                 CASE "mki$"
  288.                     foundAsText = true
  289.                     textReturn$ = MKI$(temp##)
  290.                 CASE "mkl$"
  291.                     foundAsText = true
  292.                     textReturn$ = MKL$(temp##)
  293.                 CASE "mks$"
  294.                     foundAsText = true
  295.                     textReturn$ = MKS$(temp##)
  296.                 CASE "mkd$"
  297.                     foundAsText = true
  298.                     textReturn$ = MKD$(temp##)
  299.                 CASE "mksmbf$"
  300.                     foundAsText = true
  301.                     textReturn$ = MKSMBF$(temp##)
  302.                 CASE "mkdmbf$"
  303.                     foundAsText = true
  304.                     textReturn$ = MKDMBF$(temp##)
  305.                 CASE "_mk$"
  306.                     foundAsText = true
  307.                     'textReturn$ = _mk$
  308.                 CASE "cvsmbf"
  309.                     GetVal## = CVSMBF(temp$)
  310.                 CASE "cvdmbf"
  311.                     GetVal## = CVDMBF(temp$)
  312.                 CASE "cvi"
  313.                     GetVal## = CVI(temp$)
  314.                 CASE "cvl"
  315.                     GetVal## = CVL(temp$)
  316.                 CASE "cvs"
  317.                     GetVal## = CVS(temp$)
  318.                 CASE "cvd"
  319.                     GetVal## = CVD(temp$)
  320.                 CASE "_cv"
  321.                     'GetVal## = _cv
  322.                 CASE "string$"
  323.                     'foundAsText = true
  324.                     'textReturn$ = string$(temp##)
  325.                 CASE "space$"
  326.                     foundAsText = true
  327.                     textReturn$ = SPACE$(temp##)
  328.                 CASE "instr"
  329.                     'GetVal## = instr
  330.                 CASE "_instrrev"
  331.                     'GetVal## = _instrrev
  332.                 CASE "mid$"
  333.                     'foundAsText = true
  334.                     'textReturn$ = mid$
  335.                 CASE "sqr"
  336.                     GetVal## = SQR(temp##)
  337.                 CASE "tan"
  338.                     GetVal## = TAN(temp##)
  339.                 CASE "atn"
  340.                     GetVal## = ATN(temp##)
  341.                 CASE "log"
  342.                     GetVal## = LOG(temp##)
  343.                 CASE "abs"
  344.                     GetVal## = ABS(temp##)
  345.                 CASE "erl"
  346.                     GetVal## = lineThatErrored
  347.                 CASE "err"
  348.                     GetVal## = ERR
  349.                 CASE "ucase$"
  350.                     foundAsText = true
  351.                     textReturn$ = UCASE$(temp$)
  352.                 CASE "lcase$"
  353.                     foundAsText = true
  354.                     textReturn$ = LCASE$(temp$)
  355.                 CASE "left$"
  356.                     'foundAsText = true
  357.                     'textReturn$ = left$
  358.                 CASE "right$"
  359.                     'foundAsText = true
  360.                     'textReturn$ = right$
  361.                 CASE "ltrim$"
  362.                     foundAsText = true
  363.                     textReturn$ = LTRIM$(temp$)
  364.                 CASE "rtrim$"
  365.                     foundAsText = true
  366.                     textReturn$ = RTRIM$(temp$)
  367.                 CASE "_trim$"
  368.                     foundAsText = true
  369.                     textReturn$ = _TRIM$(temp$)
  370.                 CASE "_cwd$"
  371.                     foundAsText = true
  372.                     textReturn$ = _CWD$
  373.                 CASE "_startdir$"
  374.                     foundAsText = true
  375.                     textReturn$ = _STARTDIR$
  376.                 CASE "_dir$"
  377.                     foundAsText = true
  378.                     textReturn$ = _DIR$(temp$)
  379.                 CASE "_inclerrorfile$"
  380.                     foundAsText = true
  381.                     textReturn$ = _INCLERRORFILE$
  382.                 CASE "_atan2"
  383.                     'GetVal## = _atan2
  384.                 CASE "_hypot"
  385.                     'GetVal## = _hypot
  386.                 CASE "_pi"
  387.                     IF temp$ = "" THEN temp## = 1
  388.                     GetVal## = _PI(temp##)
  389.                 CASE "_desktopheight"
  390.                     GetVal## = _DESKTOPHEIGHT
  391.                 CASE "_desktopwidth"
  392.                     GetVal## = _DESKTOPWIDTH
  393.                 CASE "_screenexists"
  394.                     GetVal## = _SCREENEXISTS
  395.                 CASE "_controlchr"
  396.                     GetVal## = _CONTROLCHR
  397.                 CASE "_stricmp"
  398.                     'GetVal## = _stricmp
  399.                 CASE "_strcmp"
  400.                     'GetVal## = _strcmp
  401.                 CASE "_autodisplay"
  402.                     GetVal## = _AUTODISPLAY
  403.                 CASE "_shr"
  404.                     'GetVal## = _shr
  405.                 CASE "_shl"
  406.                     'GetVal## = _shl
  407.                 CASE "_deflate$"
  408.                     foundAsText = true
  409.                     textReturn$ = _DEFLATE$(temp$)
  410.                 CASE "_inflate$"
  411.                     foundAsText = true
  412.                     textReturn$ = _INFLATE$(temp$)
  413.                 CASE "_readbit"
  414.                     'GetVal## = _readbit
  415.                 CASE "_setbit"
  416.                     'GetVal## = _setbit
  417.                 CASE "_resetbit"
  418.                     'GetVal## = _resetbit
  419.                 CASE "_togglebit"
  420.                     'GetVal## = _togglebit
  421.             END SELECT

Not a list that's going to do me a whole lot of good.  There's no way we can sort out even half of these for use with CONST.  "_mousey", "_width", "_screenexists"... 

The list from the wiki is just as useful as this one is.  :P

If somebody notices a command missing, which we can get and use, like you noticed _CEIL, just point it out and I'll add it for us. 

Should something semi-constant like _DESKTOPWIDTH be added?  It *can* change, if the user goes in, in the middle of their program operation, and changes desktop settings -- but that doesn't happen very often, and most people don't program for that type of event anyway.  If they do, would they be very likely to try and set it as a CONST, knowing it can change??

Honestly, I don't know if it's something I should add into the math evaluator or not...

I'll leave it up to you guys to decide.  I don't care one way or the other.  I don't think I'd ever set _DESKTOPWIDTH as a constant, knowing it can change, but somebody else out there might want to, just so they can have their program compile with constant values and not variables.
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

FellippeHeitor

  • Guest
Re: Steve's Math Evaluator
« Reply #13 on: January 05, 2020, 11:04:56 pm »
Not a list that's going to do me a whole lot of good.  There's no way we can sort out even half of these for use with CONST.  "_mousey", "_width", "_screenexists"... 

The list from the wiki is just as useful as this one is.  :P

If somebody notices a command missing, which we can get and use, like you noticed _CEIL, just point it out and I'll add it for us. 

Should something semi-constant like _DESKTOPWIDTH be added?  It *can* change, if the user goes in, in the middle of their program operation, and changes desktop settings -- but that doesn't happen very often, and most people don't program for that type of event anyway.  If they do, would they be very likely to try and set it as a CONST, knowing it can change??

Honestly, I don't know if it's something I should add into the math evaluator or not...

I'll leave it up to you guys to decide.  I don't care one way or the other.  I don't think I'd ever set _DESKTOPWIDTH as a constant, knowing it can change, but somebody else out there might want to, just so they can have their program compile with constant values and not variables.

If it's not math, it shouldn't be there. I'm only giving you the list here as it contains all functions, whether math or not, so it's a list you can peek.

On another note, this one more serious:

Below you will find your code from the previous update (when you added _CEIL) with relevant changes for use with $NOPREFIX. The changes I'm adding below are already working in my local copy of the branch I'm using to work on $NOPREFIX, and they don't alter your code's current test state in anything, except that, if you uncomment the line qb64prefix_set = 1 you will end up allowing non-prefixed operators, just like it will happen when $NOPREFIX is used..

If you'd be so kind to continue working on your improvements from this version, it'll make it much easier to inject it back into QB64 once your testing is done.

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

PS: qb64prefix_set is the actual control variable name being used for $NOPREFIX internally, so it's verbatim the way it should be in the final version as well.

PS2: If you use a diff tool the changes should be pretty self-explanatory.
« Last Edit: January 05, 2020, 11:17:16 pm by FellippeHeitor »

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Steve's Math Evaluator
« Reply #14 on: January 06, 2020, 12:02:05 am »
I think I've got the issue with the double/triple/multiple negatives all sorted out properly now.  :)

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. 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.     PreParse t$
  30.  
  31.     IF LEFT$(t$, 5) = "ERROR" THEN Evaluate_Expression$ = t$: EXIT FUNCTION
  32.  
  33.     'Deal with brackets first
  34.     exp$ = "(" + t$ + ")" 'Starting and finishing brackets for our parse routine.
  35.  
  36.     DO
  37.         Eval_E = INSTR(exp$, ")")
  38.         IF Eval_E > 0 THEN
  39.             c = 0
  40.             DO UNTIL Eval_E - c <= 0
  41.                 c = c + 1
  42.                 IF Eval_E THEN
  43.                     IF MID$(exp$, Eval_E - c, 1) = "(" THEN EXIT DO
  44.                 END IF
  45.             LOOP
  46.             s = Eval_E - c + 1
  47.             IF s < 1 THEN Evaluate_Expression$ = "ERROR -- BAD () Count": EXIT SUB
  48.             eval$ = " " + MID$(exp$, s, Eval_E - s) + " " 'pad with a space before and after so the parser can pick up the values properly.
  49.  
  50.             'PRINT "PRE-PARSE: "; eval$
  51.             ParseExpression eval$
  52.             'PRINT "AFTER PARSE: "; eval$
  53.             eval$ = LTRIM$(RTRIM$(eval$))
  54.             IF LEFT$(eval$, 5) = "ERROR" THEN Evaluate_Expression$ = eval$: EXIT SUB
  55.             exp$ = DWD(LEFT$(exp$, s - 2) + eval$ + MID$(exp$, Eval_E + 1))
  56.             'PRINT exp$
  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.     exp$ = DWD(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.                 IF num(1) = "-" THEN
  149.                     num(3) = "N" + EvaluateNumbers(OpOn, num())
  150.                 ELSE
  151.                     num(3) = EvaluateNumbers(OpOn, num())
  152.                 END IF
  153.                 IF MID$(num(3), 1, 1) = "-" THEN MID$(num(3), 1) = "N"
  154.                 'PRINT "*************"
  155.                 'PRINT num(1), OName(OpOn), num(2), num(3), exp$
  156.                 IF LEFT$(num(3), 5) = "ERROR" THEN exp$ = num(3): EXIT SUB
  157.                 exp$ = LTRIM$(N2S(DWD(LEFT$(exp$, s) + RTRIM$(LTRIM$(num(3))) + MID$(exp$, e + 1))))
  158.                 'PRINT exp$
  159.             END IF
  160.             op = 0
  161.         LOOP
  162.     NEXT
  163.  
  164.  
  165.  
  166.  
  167. SUB Set_OrderOfOperations
  168.     'PL sets our priortity level. 1 is highest to 65535 for the lowest.
  169.     'I used a range here so I could add in new priority levels as needed.
  170.     'OName ended up becoming the name of our commands, as I modified things.... Go figure!  LOL!
  171.  
  172.     'Constants get evaluated first, with a Priority Level of 1
  173.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_PI"
  174.     REDIM _PRESERVE PL(i): PL(i) = 10
  175.     '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...
  176.     'I'm putting it here for now, and if anyone knows someplace better for it in our order of operations, let me know.
  177.  
  178.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_UOF" 'convert to unsigned offset
  179.     REDIM _PRESERVE PL(i): PL(i) = 5
  180.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_OF" 'convert to offset
  181.     REDIM _PRESERVE PL(i): PL(i) = 5
  182.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_UBY" 'convert to unsigned byte
  183.     REDIM _PRESERVE PL(i): PL(i) = 5
  184.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_BY" 'convert to byte
  185.     REDIM _PRESERVE PL(i): PL(i) = 5
  186.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_UIN" 'convert to unsigned integer
  187.     REDIM _PRESERVE PL(i): PL(i) = 5
  188.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_IN" 'convert to integer
  189.     REDIM _PRESERVE PL(i): PL(i) = 5
  190.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_UIF" 'convert to unsigned int64
  191.     REDIM _PRESERVE PL(i): PL(i) = 5
  192.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_IF" 'convert to int64
  193.     REDIM _PRESERVE PL(i): PL(i) = 5
  194.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_ULO" 'convert to unsigned long
  195.     REDIM _PRESERVE PL(i): PL(i) = 5
  196.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_LO" 'convert to long
  197.     REDIM _PRESERVE PL(i): PL(i) = 5
  198.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_SI" 'convert to single
  199.     REDIM _PRESERVE PL(i): PL(i) = 5
  200.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_FL" 'convert to float
  201.     REDIM _PRESERVE PL(i): PL(i) = 5
  202.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_DO" 'convert to double
  203.     REDIM _PRESERVE PL(i): PL(i) = 5
  204.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_UBI" 'convert to unsigned bit
  205.     REDIM _PRESERVE PL(i): PL(i) = 5
  206.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_BI" 'convert to bit
  207.     REDIM _PRESERVE PL(i): PL(i) = 5
  208.  
  209.     'Then Functions with PL 10
  210.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_ACOS"
  211.     REDIM _PRESERVE PL(i): PL(i) = 10
  212.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_ASIN"
  213.     REDIM _PRESERVE PL(i): PL(i) = 10
  214.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_ARCSEC"
  215.     REDIM _PRESERVE PL(i): PL(i) = 10
  216.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_ARCCSC"
  217.     REDIM _PRESERVE PL(i): PL(i) = 10
  218.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_ARCCOT"
  219.     REDIM _PRESERVE PL(i): PL(i) = 10
  220.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_SECH"
  221.     REDIM _PRESERVE PL(i): PL(i) = 10
  222.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_CSCH"
  223.     REDIM _PRESERVE PL(i): PL(i) = 10
  224.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_COTH"
  225.     REDIM _PRESERVE PL(i): PL(i) = 10
  226.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "COS"
  227.     REDIM _PRESERVE PL(i): PL(i) = 10
  228.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "SIN"
  229.     REDIM _PRESERVE PL(i): PL(i) = 10
  230.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "TAN"
  231.     REDIM _PRESERVE PL(i): PL(i) = 10
  232.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "LOG"
  233.     REDIM _PRESERVE PL(i): PL(i) = 10
  234.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "EXP"
  235.     REDIM _PRESERVE PL(i): PL(i) = 10
  236.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "ATN"
  237.     REDIM _PRESERVE PL(i): PL(i) = 10
  238.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_D2R"
  239.     REDIM _PRESERVE PL(i): PL(i) = 10
  240.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_D2G"
  241.     REDIM _PRESERVE PL(i): PL(i) = 10
  242.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_R2D"
  243.     REDIM _PRESERVE PL(i): PL(i) = 10
  244.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_R2G"
  245.     REDIM _PRESERVE PL(i): PL(i) = 10
  246.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_G2D"
  247.     REDIM _PRESERVE PL(i): PL(i) = 10
  248.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_G2R"
  249.     REDIM _PRESERVE PL(i): PL(i) = 10
  250.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "ABS"
  251.     REDIM _PRESERVE PL(i): PL(i) = 10
  252.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "SGN"
  253.     REDIM _PRESERVE PL(i): PL(i) = 10
  254.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "INT"
  255.     REDIM _PRESERVE PL(i): PL(i) = 10
  256.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_ROUND"
  257.     REDIM _PRESERVE PL(i): PL(i) = 10
  258.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_CEIL"
  259.     REDIM _PRESERVE PL(i): PL(i) = 10
  260.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "FIX"
  261.     REDIM _PRESERVE PL(i): PL(i) = 10
  262.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_SEC"
  263.     REDIM _PRESERVE PL(i): PL(i) = 10
  264.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_CSC"
  265.     REDIM _PRESERVE PL(i): PL(i) = 10
  266.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_COT"
  267.     REDIM _PRESERVE PL(i): PL(i) = 10
  268.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "ASC"
  269.     REDIM _PRESERVE PL(i): PL(i) = 10
  270.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "CHR$"
  271.     REDIM _PRESERVE PL(i): PL(i) = 10
  272.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_RG" '_RGB32 converted
  273.     REDIM _PRESERVE PL(i): PL(i) = 10
  274.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_RA" '_RGBA32 converted
  275.     REDIM _PRESERVE PL(i): PL(i) = 10
  276.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_RGB"
  277.     REDIM _PRESERVE PL(i): PL(i) = 10
  278.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_RGBA"
  279.     REDIM _PRESERVE PL(i): PL(i) = 10
  280.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_RX" '_RED32 converted
  281.     REDIM _PRESERVE PL(i): PL(i) = 10
  282.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_GR" ' _GREEN32 converted
  283.     REDIM _PRESERVE PL(i): PL(i) = 10
  284.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_BL" '_BLUE32 converted
  285.     REDIM _PRESERVE PL(i): PL(i) = 10
  286.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_AL" '_ALPHA32 converted
  287.     REDIM _PRESERVE PL(i): PL(i) = 10
  288.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_RED"
  289.     REDIM _PRESERVE PL(i): PL(i) = 10
  290.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_GREEN"
  291.     REDIM _PRESERVE PL(i): PL(i) = 10
  292.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_BLUE"
  293.     REDIM _PRESERVE PL(i): PL(i) = 10
  294.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_ALPHA"
  295.     REDIM _PRESERVE PL(i): PL(i) = 10
  296.  
  297.     'Exponents with PL 20
  298.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "^"
  299.     REDIM _PRESERVE PL(i): PL(i) = 20
  300.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "SQR"
  301.     REDIM _PRESERVE PL(i): PL(i) = 20
  302.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "ROOT"
  303.     REDIM _PRESERVE PL(i): PL(i) = 20
  304.     'Multiplication and Division PL 30
  305.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "*"
  306.     REDIM _PRESERVE PL(i): PL(i) = 30
  307.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "/"
  308.     REDIM _PRESERVE PL(i): PL(i) = 30
  309.     'Integer Division PL 40
  310.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "\"
  311.     REDIM _PRESERVE PL(i): PL(i) = 40
  312.     'MOD PL 50
  313.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "MOD"
  314.     REDIM _PRESERVE PL(i): PL(i) = 50
  315.     'Addition and Subtraction PL 60
  316.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "+"
  317.     REDIM _PRESERVE PL(i): PL(i) = 60
  318.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "-"
  319.     REDIM _PRESERVE PL(i): PL(i) = 60
  320.  
  321.     'Relational Operators =, >, <, <>, <=, >=   PL 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) = "><" 'These next three are just reversed symbols as an attempt to help process a common typo
  325.     REDIM _PRESERVE PL(i): PL(i) = 70
  326.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "<="
  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) = "=<" 'I personally can never keep these things straight.  Is it < = or = <...
  331.     REDIM _PRESERVE PL(i): PL(i) = 70
  332.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "=>" 'Who knows, check both!
  333.     REDIM _PRESERVE PL(i): PL(i) = 70
  334.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = ">"
  335.     REDIM _PRESERVE PL(i): PL(i) = 70
  336.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "<"
  337.     REDIM _PRESERVE PL(i): PL(i) = 70
  338.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "="
  339.     REDIM _PRESERVE PL(i): PL(i) = 70
  340.     'Logical Operations PL 80+
  341.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "NOT"
  342.     REDIM _PRESERVE PL(i): PL(i) = 80
  343.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "AND"
  344.     REDIM _PRESERVE PL(i): PL(i) = 90
  345.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "OR"
  346.     REDIM _PRESERVE PL(i): PL(i) = 100
  347.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "XOR"
  348.     REDIM _PRESERVE PL(i): PL(i) = 110
  349.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "EQV"
  350.     REDIM _PRESERVE PL(i): PL(i) = 120
  351.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "IMP"
  352.     REDIM _PRESERVE PL(i): PL(i) = 130
  353.  
  354.  
  355.  
  356. FUNCTION EvaluateNumbers$ (p, num() AS STRING)
  357.     DIM n1 AS _FLOAT, n2 AS _FLOAT, n3 AS _FLOAT
  358.     'PRINT "EN$: "; num(1), num(2), OName(p)
  359.     IF INSTR(num(1), ",") THEN EvaluateNumbers$ = "ERROR - Invalid comma (" + num(1) + ")": EXIT FUNCTION
  360.     IF INSTR(num(2), ",") THEN
  361.         SELECT CASE OName(p) 'only certain commands should pass a comma value
  362.             CASE "C_RG", "C_RA", "_RGB", "_RGBA", "_RED", "_GREEN", "C_BL", "_ALPHA"
  363.             CASE ELSE
  364.                 EvaluateNumbers$ = "ERROR - Invalid comma (" + num(2) + ")": EXIT FUNCTION
  365.         END SELECT
  366.     END IF
  367.  
  368.     SELECT CASE PL(p) 'divide up the work so we want do as much case checking
  369.         CASE 5 'Type conversions
  370.             'Note, these are special cases and work with the number BEFORE the command and not after
  371.             SELECT CASE OName(p) 'Depending on our operator..
  372.                 CASE "C_UOF": n1~%& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~%&)))
  373.                 CASE "C_ULO": n1%& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1%&)))
  374.                 CASE "C_UBY": n1~%% = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~%%)))
  375.                 CASE "C_UIN": n1~% = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~%)))
  376.                 CASE "C_BY": n1%% = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1%%)))
  377.                 CASE "C_IN": n1% = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1%)))
  378.                 CASE "C_UIF": n1~&& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~&&)))
  379.                 CASE "C_OF": n1~& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~&)))
  380.                 CASE "C_IF": n1&& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1&&)))
  381.                 CASE "C_LO": n1& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1&)))
  382.                 CASE "C_UBI": n1~` = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~`)))
  383.                 CASE "C_BI": n1` = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1`)))
  384.                 CASE "C_FL": n1## = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1##)))
  385.                 CASE "C_DO": n1# = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1#)))
  386.                 CASE "C_SI": n1! = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1!)))
  387.             END SELECT
  388.             EXIT FUNCTION
  389.         CASE 10 'functions
  390.             SELECT CASE OName(p) 'Depending on our operator..
  391.                 CASE "_PI"
  392.                     n1 = 3.14159265358979323846264338327950288## 'Future compatable in case something ever stores extra digits for PI
  393.                     IF num(2) <> "" THEN n1 = n1 * VAL(num(2))
  394.                 CASE "_ACOS": n1 = _ACOS(VAL(num(2)))
  395.                 CASE "_ASIN": n1 = _ASIN(VAL(num(2)))
  396.                 CASE "_ARCSEC": n1 = _ARCSEC(VAL(num(2)))
  397.                 CASE "_ARCCSC": n1 = _ARCCSC(VAL(num(2)))
  398.                 CASE "_ARCCOT": n1 = _ARCCOT(VAL(num(2)))
  399.                 CASE "_SECH": n1 = _SECH(VAL(num(2)))
  400.                 CASE "_CSCH": n1 = _CSCH(VAL(num(2)))
  401.                 CASE "_COTH": n1 = _COTH(VAL(num(2)))
  402.                 CASE "C_RG"
  403.                     n$ = num(2)
  404.                     IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null _RGB32": EXIT FUNCTION
  405.                     c1 = INSTR(n$, ",")
  406.                     IF c1 THEN c2 = INSTR(c1 + 1, n$, ",")
  407.                     IF c2 THEN c3 = INSTR(c2 + 1, n$, ",")
  408.                     IF c3 THEN c4 = INSTR(c3 + 1, n$, ",")
  409.                     IF c1 = 0 THEN 'there's no comma in the command to parse.  It's a grayscale value
  410.                         n = VAL(num(2))
  411.                         n1 = _RGB32(n, n, n)
  412.                     ELSEIF c2 = 0 THEN 'there's one comma and not 2.  It's grayscale with alpha.
  413.                         n = VAL(LEFT$(num(2), c1))
  414.                         n2 = VAL(MID$(num(2), c1 + 1))
  415.                         n1 = _RGBA32(n, n, n, n2)
  416.                     ELSEIF c3 = 0 THEN 'there's two commas.  It's _RGB values
  417.                         n = VAL(LEFT$(num(2), c1))
  418.                         n2 = VAL(MID$(num(2), c1 + 1))
  419.                         n3 = VAL(MID$(num(2), c2 + 1))
  420.                         n1 = _RGB32(n, n2, n3)
  421.                     ELSEIF c4 = 0 THEN 'there's three commas.  It's _RGBA values
  422.                         n = VAL(LEFT$(num(2), c1))
  423.                         n2 = VAL(MID$(num(2), c1 + 1))
  424.                         n3 = VAL(MID$(num(2), c2 + 1))
  425.                         n4 = VAL(MID$(num(2), c3 + 1))
  426.                         n1 = _RGBA32(n, n2, n3, n4)
  427.                     ELSE 'we have more than three commas.  I have no idea WTH type of values got passed here!
  428.                         EvaluateNumbers$ = "ERROR - Invalid comma count (" + num(2) + ")": EXIT FUNCTION
  429.                     END IF
  430.                 CASE "C_RA"
  431.                     n$ = num(2)
  432.                     IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null _RGBA32": EXIT FUNCTION
  433.                     c1 = INSTR(n$, ",")
  434.                     IF c1 THEN c2 = INSTR(c1 + 1, n$, ",")
  435.                     IF c2 THEN c3 = INSTR(c2 + 1, n$, ",")
  436.                     IF c3 THEN c4 = INSTR(c3 + 1, n$, ",")
  437.                     IF c3 = 0 OR c4 <> 0 THEN EvaluateNumbers$ = "ERROR - Invalid comma count (" + num(2) + ")": EXIT FUNCTION
  438.                     'we have to have 3 commas; not more, not less.
  439.                     n = VAL(LEFT$(num(2), c1))
  440.                     n2 = VAL(MID$(num(2), c1 + 1))
  441.                     n3 = VAL(MID$(num(2), c2 + 1))
  442.                     n4 = VAL(MID$(num(2), c3 + 1))
  443.                     n1 = _RGBA32(n, n2, n3, n4)
  444.                 CASE "_RGB"
  445.                     n$ = num(2)
  446.                     IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null _RGB": EXIT FUNCTION
  447.                     c1 = INSTR(n$, ",")
  448.                     IF c1 THEN c2 = INSTR(c1 + 1, n$, ",")
  449.                     IF c2 THEN c3 = INSTR(c2 + 1, n$, ",")
  450.                     IF c3 THEN c4 = INSTR(c3 + 1, n$, ",")
  451.                     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
  452.                     'we have to have 3 commas; not more, not less.
  453.                     n = VAL(LEFT$(num(2), c1))
  454.                     n2 = VAL(MID$(num(2), c1 + 1))
  455.                     n3 = VAL(MID$(num(2), c2 + 1))
  456.                     n4 = VAL(MID$(num(2), c3 + 1))
  457.                     SELECT CASE n4
  458.                         CASE 0 TO 2, 7 TO 13, 256, 32 'these are the good screen values
  459.                         CASE ELSE
  460.                             EvaluateNumbers$ = "ERROR - Invalid Screen Mode (" + STR$(n4) + ")": EXIT FUNCTION
  461.                     END SELECT
  462.                     t = _NEWIMAGE(1, 1, n4)
  463.                     n1 = _RGB(n, n2, n3, t)
  464.                     _FREEIMAGE t
  465.                 CASE "_RGBA"
  466.                     n$ = num(2)
  467.                     IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null _RGBA": EXIT FUNCTION
  468.                     c1 = INSTR(n$, ",")
  469.                     IF c1 THEN c2 = INSTR(c1 + 1, n$, ",")
  470.                     IF c2 THEN c3 = INSTR(c2 + 1, n$, ",")
  471.                     IF c3 THEN c4 = INSTR(c3 + 1, n$, ",")
  472.                     IF c4 THEN c5 = INSTR(c4 + 1, n$, ",")
  473.                     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
  474.                     'we have to have 4 commas; not more, not less.
  475.                     n = VAL(LEFT$(num(2), c1))
  476.                     n2 = VAL(MID$(num(2), c1 + 1))
  477.                     n3 = VAL(MID$(num(2), c2 + 1))
  478.                     n4 = VAL(MID$(num(2), c3 + 1))
  479.                     n5 = VAL(MID$(num(2), c4 + 1))
  480.                     SELECT CASE n5
  481.                         CASE 0 TO 2, 7 TO 13, 256, 32 'these are the good screen values
  482.                         CASE ELSE
  483.                             EvaluateNumbers$ = "ERROR - Invalid Screen Mode (" + STR$(n5) + ")": EXIT FUNCTION
  484.                     END SELECT
  485.                     t = _NEWIMAGE(1, 1, n5)
  486.                     n1 = _RGBA(n, n2, n3, n4, t)
  487.                     _FREEIMAGE t
  488.                 CASE "_RED", "_GREEN", "_BLUE", "_ALPHA"
  489.                     n$ = num(2)
  490.                     IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null " + OName(p): EXIT FUNCTION
  491.                     c1 = INSTR(n$, ",")
  492.                     IF c1 = 0 THEN EvaluateNumbers$ = "ERROR - " + OName(p) + " requires 2 parameters for Color, ScreenMode.": EXIT FUNCTION
  493.                     IF c1 THEN c2 = INSTR(c1 + 1, n$, ",")
  494.                     IF c2 THEN EvaluateNumbers$ = "ERROR - " + OName(p) + " requires 2 parameters for Color, ScreenMode.": EXIT FUNCTION
  495.                     n = VAL(LEFT$(num(2), c1))
  496.                     n2 = VAL(MID$(num(2), c1 + 1))
  497.                     SELECT CASE n2
  498.                         CASE 0 TO 2, 7 TO 13, 256, 32 'these are the good screen values
  499.                         CASE ELSE
  500.                             EvaluateNumbers$ = "ERROR - Invalid Screen Mode (" + STR$(n2) + ")": EXIT FUNCTION
  501.                     END SELECT
  502.                     t = _NEWIMAGE(1, 1, n4)
  503.                     SELECT CASE OName(p)
  504.                         CASE "_RED": n1 = _RED(n, t)
  505.                         CASE "_BLUE": n1 = _BLUE(n, t)
  506.                         CASE "_GREEN": n1 = _GREEN(n, t)
  507.                         CASE "_ALPHA": n1 = _ALPHA(n, t)
  508.                     END SELECT
  509.                     _FREEIMAGE t
  510.                 CASE "C_RX", "C_GR", "C_BL", "C_AL"
  511.                     n$ = num(2)
  512.                     IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null " + OName(p): EXIT FUNCTION
  513.                     n = VAL(num(2))
  514.                     SELECT CASE OName(p)
  515.                         CASE "C_RX": n1 = _RED32(n)
  516.                         CASE "C_BL": n1 = _BLUE32(n)
  517.                         CASE "C_GR": n1 = _GREEN32(n)
  518.                         CASE "C_AL": n1 = _ALPHA32(n)
  519.                     END SELECT
  520.                 CASE "COS": n1 = COS(VAL(num(2)))
  521.                 CASE "SIN": n1 = SIN(VAL(num(2)))
  522.                 CASE "TAN": n1 = TAN(VAL(num(2)))
  523.                 CASE "LOG": n1 = LOG(VAL(num(2)))
  524.                 CASE "EXP": n1 = EXP(VAL(num(2)))
  525.                 CASE "ATN": n1 = ATN(VAL(num(2)))
  526.                 CASE "_D2R": n1 = 0.0174532925 * (VAL(num(2)))
  527.                 CASE "_D2G": n1 = 1.1111111111 * (VAL(num(2)))
  528.                 CASE "_R2D": n1 = 57.2957795 * (VAL(num(2)))
  529.                 CASE "_R2G": n1 = 0.015707963 * (VAL(num(2)))
  530.                 CASE "_G2D": n1 = 0.9 * (VAL(num(2)))
  531.                 CASE "_G2R": n1 = 63.661977237 * (VAL(num(2)))
  532.                 CASE "ABS": n1 = ABS(VAL(num(2)))
  533.                 CASE "SGN": n1 = SGN(VAL(num(2)))
  534.                 CASE "INT": n1 = INT(VAL(num(2)))
  535.                 CASE "_ROUND": n1 = _ROUND(VAL(num(2)))
  536.                 CASE "_CEIL": n1 = _CEIL(VAL(num(2)))
  537.                 CASE "FIX": n1 = FIX(VAL(num(2)))
  538.                 CASE "_SEC": n1 = _SEC(VAL(num(2)))
  539.                 CASE "_CSC": n1 = _CSC(VAL(num(2)))
  540.                 CASE "_COT": n1 = _COT(VAL(num(2)))
  541.             END SELECT
  542.         CASE 20 TO 60 'Math Operators
  543.             SELECT CASE OName(p) 'Depending on our operator..
  544.                 CASE "^": n1 = VAL(num(1)) ^ VAL(num(2))
  545.                 CASE "SQR": n1 = SQR(VAL(num(2)))
  546.                 CASE "ROOT"
  547.                     n1 = VAL(num(1)): n2 = VAL(num(2))
  548.                     IF n2 = 1 THEN EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1))): EXIT FUNCTION
  549.                     IF n1 < 0 AND n2 >= 1 THEN sign = -1: n1 = -n1 ELSE sign = 1
  550.                     n3 = 1## / n2
  551.                     IF n3 <> INT(n3) AND n2 < 1 THEN sign = SGN(n1): n1 = ABS(n1)
  552.                     n1 = sign * (n1 ^ n3)
  553.                 CASE "*": n1 = VAL(num(1)) * VAL(num(2))
  554.                 CASE "/": n1 = VAL(num(1)) / VAL(num(2))
  555.                 CASE "\"
  556.                     IF VAL(num(2)) <> 0 THEN
  557.                         n1 = VAL(num(1)) \ VAL(num(2))
  558.                     ELSE
  559.                         EvaluateNumbers$ = "ERROR - Bad operation (We shouldn't see this)"
  560.                         EXIT FUNCTION
  561.                     END IF
  562.                 CASE "MOD": n1 = VAL(num(1)) MOD VAL(num(2))
  563.                 CASE "+": n1 = VAL(num(1)) + VAL(num(2))
  564.                 CASE "-":
  565.                     n1 = VAL(num(1)) - VAL(num(2))
  566.             END SELECT
  567.         CASE 70 'Relational Operators =, >, <, <>, <=, >=
  568.             SELECT CASE OName(p) 'Depending on our operator..
  569.                 CASE "=": n1 = VAL(num(1)) = VAL(num(2))
  570.                 CASE ">": n1 = VAL(num(1)) > VAL(num(2))
  571.                 CASE "<": n1 = VAL(num(1)) < VAL(num(2))
  572.                 CASE "<>", "><": n1 = VAL(num(1)) <> VAL(num(2))
  573.                 CASE "<=", "=<": n1 = VAL(num(1)) <= VAL(num(2))
  574.                 CASE ">=", "=>": n1 = VAL(num(1)) >= VAL(num(2))
  575.             END SELECT
  576.         CASE ELSE 'a value we haven't processed elsewhere
  577.             SELECT CASE OName(p) 'Depending on our operator..
  578.                 CASE "NOT": n1 = NOT VAL(num(2))
  579.                 CASE "AND": n1 = VAL(num(1)) AND VAL(num(2))
  580.                 CASE "OR": n1 = VAL(num(1)) OR VAL(num(2))
  581.                 CASE "XOR": n1 = VAL(num(1)) XOR VAL(num(2))
  582.                 CASE "EQV": n1 = VAL(num(1)) EQV VAL(num(2))
  583.                 CASE "IMP": n1 = VAL(num(1)) IMP VAL(num(2))
  584.             END SELECT
  585.     END SELECT
  586.  
  587.     EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1)))
  588.  
  589. FUNCTION DWD$ (exp$) 'Deal With Duplicates
  590.     'To deal with duplicate operators in our code.
  591.     'Such as --  becomes a +
  592.     '++ becomes a +
  593.     '+- becomes a -
  594.     '-+ becomes a -
  595.     t$ = exp$
  596.     DO
  597.         bad = 0
  598.         DO
  599.             l = INSTR(t$, "++")
  600.             IF l THEN t$ = LEFT$(t$, l - 1) + "+" + MID$(t$, l + 2): bad = -1
  601.         LOOP UNTIL l = 0
  602.         DO
  603.             l = INSTR(t$, "+-")
  604.             IF l THEN t$ = LEFT$(t$, l - 1) + "-" + MID$(t$, l + 2): bad = -1
  605.         LOOP UNTIL l = 0
  606.         DO
  607.             l = INSTR(t$, "-+")
  608.             IF l THEN t$ = LEFT$(t$, l - 1) + "-" + MID$(t$, l + 2): bad = -1
  609.         LOOP UNTIL l = 0
  610.         DO
  611.             l = INSTR(t$, "--")
  612.             IF l THEN t$ = LEFT$(t$, l - 1) + "+" + MID$(t$, l + 2): bad = -1
  613.         LOOP UNTIL l = 0
  614.         'PRINT "FIXING: "; t$
  615.     LOOP UNTIL NOT bad
  616.     DWD$ = t$
  617.  
  618. SUB PreParse (e$)
  619.     DIM f AS _FLOAT
  620.     STATIC TypeMod(1 TO 21) AS STRING, ConvertedMod(1 TO 21) AS STRING
  621.     IF TypeMod(1) = "" THEN
  622.         TypeMod(1) = "~`": ConvertedMod(1) = "C_UBI" 'unsigned bit
  623.         TypeMod(2) = "~%%": ConvertedMod(2) = "C_UBY" 'unsigned byte
  624.         TypeMod(3) = "~%&": ConvertedMod(3) = "C_UOF" 'unsigned offset
  625.         TypeMod(4) = "~%": ConvertedMod(4) = "C_UIN" 'unsigned integer
  626.         TypeMod(5) = "~&&": ConvertedMod(5) = "C_UIF" 'unsigned integer64
  627.         TypeMod(6) = "~&": ConvertedMod(6) = "C_ULO" 'unsigned long
  628.         TypeMod(7) = "`": ConvertedMod(7) = "C_BI" 'bit
  629.         TypeMod(8) = "%%": ConvertedMod(8) = "C_BY" 'byte
  630.         TypeMod(9) = "%&": ConvertedMod(9) = "C_OF" 'offset
  631.         TypeMod(10) = "%": ConvertedMod(10) = "C_IN" 'integer
  632.         TypeMod(11) = "&&": ConvertedMod(11) = "C_IF" 'integer64
  633.         TypeMod(12) = "&": ConvertedMod(12) = "C_LO" 'long
  634.         TypeMod(13) = "!": ConvertedMod(13) = "C_SI" 'single
  635.         TypeMod(14) = "##": ConvertedMod(14) = "C_FL" 'float
  636.         TypeMod(15) = "#": ConvertedMod(15) = "C_DO" 'double
  637.         TypeMod(16) = "_RGB32": ConvertedMod(16) = "C_RG" 'rgb32
  638.         TypeMod(17) = "_RGBA32": ConvertedMod(17) = "C_RA" 'rgba32
  639.         TypeMod(18) = "_RED32": ConvertedMod(18) = "C_RX" 'red32
  640.         TypeMod(19) = "_GREEN32": ConvertedMod(19) = "C_GR" 'green32
  641.         TypeMod(20) = "_BLUE32": ConvertedMod(20) = "C_BL" 'blue32
  642.         TypeMod(21) = "_ALPHA32": ConvertedMod(21) = "C_AL" 'alpha32
  643.     END IF
  644.     t$ = e$
  645.  
  646.     'First strip all spaces
  647.     t$ = ""
  648.     FOR i = 1 TO LEN(e$)
  649.         IF MID$(e$, i, 1) <> " " THEN t$ = t$ + MID$(e$, i, 1)
  650.     NEXT
  651.  
  652.     t$ = UCASE$(t$)
  653.     IF t$ = "" THEN e$ = "ERROR -- NULL string; nothing to evaluate": EXIT SUB
  654.  
  655.     'ERROR CHECK by counting our brackets
  656.     l = 0
  657.     DO
  658.         l = INSTR(l + 1, t$, "("): IF l THEN c = c + 1
  659.     LOOP UNTIL l = 0
  660.     l = 0
  661.     DO
  662.         l = INSTR(l + 1, t$, ")"): IF l THEN c1 = c1 + 1
  663.     LOOP UNTIL l = 0
  664.     IF c <> c1 THEN e$ = "ERROR -- Bad Parenthesis:" + STR$(c) + "( vs" + STR$(c1) + ")": EXIT SUB
  665.  
  666.     'Modify so that NOT will process properly
  667.     l = 0
  668.     DO
  669.         l = INSTR(l + 1, t$, "NOT")
  670.         IF l THEN
  671.             'We need to work magic on the statement so it looks pretty.
  672.             ' 1 + NOT 2 + 1 is actually processed as 1 + (NOT 2 + 1)
  673.             'Look for something not proper
  674.             l1 = INSTR(l + 1, t$, "AND")
  675.             IF l1 = 0 OR (INSTR(l + 1, t$, "OR") > 0 AND INSTR(l + 1, t$, "OR") < l1) THEN l1 = INSTR(l + 1, t$, "OR")
  676.             IF l1 = 0 OR (INSTR(l + 1, t$, "XOR") > 0 AND INSTR(l + 1, t$, "XOR") < l1) THEN l1 = INSTR(l + 1, t$, "XOR")
  677.             IF l1 = 0 OR (INSTR(l + 1, t$, "EQV") > 0 AND INSTR(l + 1, t$, "EQV") < l1) THEN l1 = INSTR(l + 1, t$, "EQV")
  678.             IF l1 = 0 OR (INSTR(l + 1, t$, "IMP") > 0 AND INSTR(l + 1, t$, "IMP") < l1) THEN l1 = INSTR(l + 1, t$, "IMP")
  679.             IF l1 = 0 THEN l1 = LEN(t$) + 1
  680.             t$ = LEFT$(t$, l - 1) + "(" + MID$(t$, l, l1 - l) + ")" + MID$(t$, l + l1 - l)
  681.             l = l + 3
  682.             'PRINT t$
  683.         END IF
  684.     LOOP UNTIL l = 0
  685.  
  686.     'Modify so that % will process properly
  687.  
  688.     FOR j = 1 TO UBOUND(TypeMod)
  689.         l = 0
  690.         DO
  691.             l = INSTR(l + 1, t$, TypeMod(j))
  692.             IF l = 0 THEN EXIT DO
  693.             i = 0: l1 = 0: l2 = 0: lo = LEN(TypeMod(j))
  694.             DO
  695.                 IF PL(i) > 10 THEN
  696.                     l2 = _INSTRREV(l, t$, OName$(i))
  697.                     IF l2 > 0 AND l2 > l1 THEN l1 = l2
  698.                 END IF
  699.                 i = i + lo
  700.             LOOP UNTIL i > UBOUND(PL)
  701.             'PRINT "L1:"; l1; "L"; l
  702.             l$ = LEFT$(t$, l1)
  703.             m$ = MID$(t$, l1 + 1, l - l1 - 1)
  704.             r$ = ConvertedMod(j) + MID$(t$, l + lo)
  705.             'PRINT "Y$: "; TypeMod(j)
  706.             'PRINT "L$: "; l$
  707.             'PRINT "M$: "; m$
  708.             'PRINT "R$: "; r$
  709.             IF j > 15 THEN
  710.                 t$ = l$ + m$ + r$ 'replacement routine for commands which might get confused with others, like _RGB and _RGB32
  711.             ELSE
  712.                 'the first 15 commands need to properly place the parenthesis around the value we want to convert.
  713.                 t$ = l$ + "(" + m$ + ")" + r$
  714.             END IF
  715.             'PRINT "T$: "; t$
  716.             l = l + 2 + LEN(TypeMod(j)) 'move forward from the length of the symbol we checked + the new "(" and  ")"
  717.         LOOP
  718.     NEXT
  719.     'PRINT "HERE: "; t$
  720.  
  721.  
  722.     'Check for bad operators before a ( bracket
  723.     l = 0
  724.     DO
  725.         l = INSTR(l + 1, t$, "(")
  726.         IF l AND l > 2 THEN 'Don't check the starting bracket; there's nothing before it.
  727.             good = 0
  728.             'PRINT "BEFORE: "; t$; l
  729.             FOR i = 1 TO UBOUND(OName)
  730.  
  731.                 m$ = MID$(t$, l - LEN(OName(i)), LEN(OName(i)))
  732.                 'IF OName(i) = "C_SI" THEN PRINT "CONVERT TO SINGLE", m$
  733.                 IF m$ = OName(i) THEN
  734.                     IF 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)
  735.                 END IF
  736.             NEXT
  737.             'PRINT t$; l
  738.             IF NOT good THEN e$ = "ERROR - Improper operations before (.": EXIT SUB
  739.             l = l + 1
  740.         END IF
  741.     LOOP UNTIL l = 0
  742.  
  743.     'Check for bad operators after a ) bracket
  744.     l = 0
  745.     DO
  746.         l = INSTR(l + 1, t$, ")")
  747.         IF l AND l < LEN(t$) THEN
  748.             good = 0
  749.             FOR i = 1 TO UBOUND(oname)
  750.                 m$ = MID$(t$, l + 1, LEN(OName(i)))
  751.                 IF m$ = OName(i) THEN
  752.                     IF 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)
  753.                 END IF
  754.             NEXT
  755.             IF MID$(t$, l + 1, 1) = ")" THEN good = -1
  756.             IF NOT good THEN e$ = "ERROR - Improper operations after ).": EXIT SUB
  757.             l = l + 1
  758.         END IF
  759.     LOOP UNTIL l = 0 OR l = LEN(t$) 'last symbol is a bracket
  760.  
  761.     'Turn all &H (hex) numbers into decimal values for the program to process properly
  762.     l = 0
  763.     DO
  764.         l = INSTR(t$, "&H")
  765.         IF l THEN
  766.             E = l + 1: finished = 0
  767.             DO
  768.                 E = E + 1
  769.                 comp$ = MID$(t$, E, 1)
  770.                 SELECT CASE comp$
  771.                     CASE "0" TO "9", "A" TO "F" 'All is good, our next digit is a number, continue to add to the hex$
  772.                     CASE ELSE
  773.                         good = 0
  774.                         FOR i = 1 TO UBOUND(oname)
  775.                             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)
  776.                         NEXT
  777.                         IF NOT good THEN e$ = "ERROR - Improper &H value. (" + comp$ + ")": EXIT SUB
  778.                         E = E - 1
  779.                         finished = -1
  780.                 END SELECT
  781.             LOOP UNTIL finished OR E = LEN(t$)
  782.             t$ = LEFT$(t$, l - 1) + LTRIM$(RTRIM$(STR$(VAL(MID$(t$, l, E - l + 1))))) + MID$(t$, E + 1)
  783.         END IF
  784.     LOOP UNTIL l = 0
  785.  
  786.     'Turn all &B (binary) numbers into decimal values for the program to process properly
  787.     l = 0
  788.     DO
  789.         l = INSTR(t$, "&B")
  790.         IF l THEN
  791.             E = l + 1: finished = 0
  792.             DO
  793.                 E = E + 1
  794.                 comp$ = MID$(t$, E, 1)
  795.                 SELECT CASE comp$
  796.                     CASE "0", "1" 'All is good, our next digit is a number, continue to add to the hex$
  797.                     CASE ELSE
  798.                         good = 0
  799.                         FOR i = 1 TO UBOUND(oname)
  800.                             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)
  801.                         NEXT
  802.                         IF NOT good THEN e$ = "ERROR - Improper &B value. (" + comp$ + ")": EXIT SUB
  803.                         E = E - 1
  804.                         finished = -1
  805.                 END SELECT
  806.             LOOP UNTIL finished OR E = LEN(t$)
  807.             bin$ = MID$(t$, l + 2, E - l - 1)
  808.             FOR i = 1 TO LEN(bin$)
  809.                 IF MID$(bin$, i, 1) = "1" THEN f = f + 2 ^ (LEN(bin$) - i)
  810.             NEXT
  811.             t$ = LEFT$(t$, l - 1) + LTRIM$(RTRIM$(STR$(f))) + MID$(t$, E + 1)
  812.         END IF
  813.     LOOP UNTIL l = 0
  814.  
  815.     'PRINT "ALMOST:"; t$
  816.  
  817.     t$ = N2S(t$)
  818.     'PRINT "ALMOST2:"; t$
  819.     VerifyString t$
  820.  
  821.     e$ = t$
  822.  
  823.  
  824.  
  825. SUB VerifyString (t$)
  826.     'ERROR CHECK for unrecognized operations
  827.     j = 1
  828.     DO
  829.         comp$ = MID$(t$, j, 1)
  830.         SELECT CASE comp$
  831.             CASE "0" TO "9", ".", "(", ")", ",": j = j + 1
  832.             CASE ELSE
  833.                 good = 0
  834.                 FOR i = 1 TO UBOUND(OName)
  835.                     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)
  836.                 NEXT
  837.                 IF NOT good THEN t$ = "ERROR - Bad Operational value. (" + comp$ + ")": EXIT SUB
  838.                 j = j + LEN(OName(i))
  839.         END SELECT
  840.     LOOP UNTIL j > LEN(t$)
  841.  
  842. FUNCTION N2S$ (exp$) 'scientific Notation to String
  843.     t$ = LTRIM$(RTRIM$(exp$))
  844.     IF LEFT$(t$, 1) = "-" THEN sign$ = "-": t$ = MID$(t$, 2)
  845.  
  846.     dp = INSTR(t$, "D+"): dm = INSTR(t$, "D-")
  847.     ep = INSTR(t$, "E+"): em = INSTR(t$, "E-")
  848.     check1 = SGN(dp) + SGN(dm) + SGN(ep) + SGN(em)
  849.     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!
  850.  
  851.     SELECT CASE l 'l now tells us where the SN starts at.
  852.         CASE IS < dp: l = dp
  853.         CASE IS < dm: l = dm
  854.         CASE IS < ep: l = ep
  855.         CASE IS < em: l = em
  856.     END SELECT
  857.  
  858.     l$ = LEFT$(t$, l - 1) 'The left of the SN
  859.     r$ = MID$(t$, l + 1): r&& = VAL(r$) 'The right of the SN, turned into a workable long
  860.  
  861.  
  862.     IF INSTR(l$, ".") THEN 'Location of the decimal, if any
  863.         IF r&& > 0 THEN
  864.             r&& = r&& - LEN(l$) + 2
  865.         ELSE
  866.             r&& = r&& + 1
  867.         END IF
  868.         l$ = LEFT$(l$, 1) + MID$(l$, 3)
  869.     END IF
  870.  
  871.     SELECT CASE r&&
  872.         CASE 0 'what the heck? We solved it already?
  873.             'l$ = l$
  874.         CASE IS < 0
  875.             FOR i = 1 TO -r&&
  876.                 l$ = "0" + l$
  877.             NEXT
  878.             l$ = "0." + l$
  879.         CASE ELSE
  880.             FOR i = 1 TO r&&
  881.                 l$ = l$ + "0"
  882.             NEXT
  883.     END SELECT
  884.  
  885.     N2S$ = sign$ + l$

Sorry, Fellippe; I was working on making changes and didn't see your post until after I finished.  I'll see about swapping the $NOPREFIX stuff into the code sometime tomorrow -- I'm going to head on out to bed here in just a few moments and doubt I'll do any more coding on anything tonight.  ;)

So let's recap what all has been altered in this so far:

1) multiple negatives have been corrected and sorted out.
2) all the type suffixes are now available for use with the command, to make certain our return values are the type we want them to be.
3) _CEIL has been added.
4) _PI now accepts optional parameters
5) ALL the _RGB, _RGBA, _RED, _GREEN, _BLUE, _ALPHA (and their 32 bit versions) have been added.
6) Program flow has been tweaked a little to make it more responsive, for when called inside QB64 itself over and over and over.
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!