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

0 Members and 1 Guest are viewing this topic.

Offline The Librarian

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

« Last Edit: March 21, 2020, 11:29:56 PM by The Librarian »