« previous next »
Pages: [1]   Go Down

Author Topic: Math Evaluator by SMcNeill  (Read 8448 times)

0 Members and 1 Guest are viewing this topic.

Offline The Librarian

  • Moderator
  • Newbie
  • Posts: 39
    • View Profile
Math Evaluator by SMcNeill
« on: March 21, 2020, 11:28:52 pm »
Math Evaluator

Author: @SMcNeill
Source: QB64.org Forum
URL: https://www.qb64.org/forum/index.php?topic=1555.0
Version: Jan 07, 2020
Tags: [qb64], [interpreter]

Description:
Here's my little math evaluation routine, which everybody's been using for ages, even if they don't know they have!  :D

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.

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

MathEval.png
* MathEvaluator.bas (Filesize: 37.66 KB, Downloads: 351)
« Last Edit: March 21, 2020, 11:29:56 pm by The Librarian »
Logged
Pages: [1]   Go Up
« previous next »