« previous next »
Pages: [1]   Go Down

Author Topic: Just a primitive program to parse arithmetic expressions.  (Read 1183 times)

0 Members and 1 Guest are viewing this topic.

Offline CharlieJV

  • Newbie
  • Posts: 89
Just a primitive program to parse arithmetic expressions.
« on: March 14, 2022, 03:10:07 pm »
The code below (pretty roughly tweaked) based on the BASIC Anywhere Machine version (source code here, run it here).

BASIC Anywhere Machine version based on BBC BASIC version found at rosettacode.org.

Code: QB64: [Select]
  1. dim shared Expr$
  2. ' This program based on https://rosettacode.org/wiki/Arithmetic_evaluation#BBC_BASIC
  3. '
  4. ' FUNCTION DECLARATIONS
  5.     declare function fNast$()
  6.     declare function fNast1$()
  7.     declare function fNastDeux$()
  8.     declare function fNumber$()
  9. ' MAIN PROGRAM
  10.     Expr$ = "1 + 2 * (3 + (4 * 5 + 6 * 7 * 8) - 9) / 10"
  11.     'Expr$ = "(1 + 2) * 3"
  12.     PRINT "Input = " + Expr$
  13.     print "fNast$ = " + fNast$
  14.     'AST$ = fNast$()
  15.     'PRINT "AST =   " +  AST$
  16.     'PRINT "Value = " ;EVAL(AST$)
  17.     END
  18. '
  19. ' FUNCTION DEFINITIONS
  20. function fNast$()
  21. ast$ = ""
  22.     fNast_repeat:
  23.         ast$ = ast$ + fNast1$
  24.         WHILE ASC(Expr$)=32
  25.         print "Expr$ = " + Expr$
  26.             Expr$ = MID$(Expr$,2,len(Expr$)-1)
  27.         wend
  28.         oper$ = LEFT$(Expr$,1)
  29.         IF oper$="+" OR oper$="-" THEN
  30.             ast$ = ast$ + oper$
  31.             Expr$ = MID$(Expr$,2,len(Expr$)-1)
  32.             goto fNast_repeat
  33.         end if
  34.     fNast$ = "(" + ast$ + ")"
  36. function fNast1$()
  37.     ast$ = ""
  38.     fNast1_repeat:
  39.         ast$= ast$ + fNastDeux$
  40.         WHILE ASC(Expr$)=32
  41.             Expr$ = MID$(Expr$,2,len(Expr$)-1)
  42.         wend
  43.         oper$ = LEFT$(Expr$,1)
  44.         IF oper$="*" OR oper$="/" THEN
  45.             ast$ = ast$ + oper$
  46.             Expr$ = MID$(Expr$,2,len(Expr$)-1)
  47.             goto fNast1_repeat
  48.         end if
  49.     fNast1$ = "(" + ast$ + ")"
  51. function fNastDeux$()
  52.     WHILE ASC(Expr$)=32
  53.         Expr$ = MID$(Expr$,2,len(Expr$)-1)
  54.     wend
  55.     IF ASC(Expr$)=40 THEN
  56.         Expr$ = MID$(Expr$, 2, len(Expr$)-1)
  57.         ast$ = fNastDeux$
  58.         Expr$ = MID$(Expr$,2, len(Expr$)-1)
  59.     ELSE
  60.         ast$ = fNumber$
  61.     end if
  62.     fNastDeux$ = ast$
  64. function fNumber$()
  65.     num$ = ""
  66.     fNumber_repeat:
  67.         ch$ = left$(Expr$, 1)
  68.         ' 🚨 wwwBASIC: issues with instr breaking app when the character is a parenthesis
  69.         if ch$ <> "" and instr("0123456789.", ch$) then
  70.             num$ = num$ + ch$
  71.             Expr$ = mid$(Expr$,2,len(Expr$)-1)
  72.             goto fNumber_repeat
  73.         end if
  74.     fNumber$ = num$
  76.  
  77.  
  78.  
Logged

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
Re: Just a primitive program to parse arithmetic expressions.
« Reply #1 on: March 18, 2022, 08:59:31 pm »
Guess I will show you how it's done :)
Code: QB64: [Select]
  1. _Title "Eval by bplus translated from FB 2018-02-05"
  2. ' from: EVAL  2 bplus.bas for FB (B+=MGA) 2017-07-04
  3. 'based on successful: evalW 2.txt for JB [B+=MGA] 2017-03-11 repost with edits
  4. ' EVAL 1 - Just Basic Eval code translated and = > < >= <= <> binary's added
  5. 'EVAL  2 - add And and Or, Not
  6.  
  7. Const XMAX = 1200
  8. Const YMAX = 720
  9.  
  10. Screen _NewImage(XMAX, YMAX, 32)
  13.  
  14. Common Shared DFlag, EvalErr$, GlobalX, RAD, DEG
  15.  
  16. EvalErr$ = ""
  17. DFlag = 1
  18. GlobalX = 5 'changeable
  19. RAD = _Pi / 180.0
  20. DEG = 180 / _Pi
  21. 'debug
  22. 'PRINT RAD, DEG, DFlag, GlobalX
  23.  
  24. '  tests
  25. e$ = "log(0)" 'err
  26. e$ = "exp(-745) " 'no err! -746 err!
  27. 'e$ = "exp(-693) " ' FB -693 limit 1.0812... E-301 bottom limit no error on my system, -708 on another test
  28. e$ = "exp( 709) " ' no err , FB 707 limit 8.21840... E+307no error on my system
  29. e$ = "sqr(-10)" 'err
  30. e$ = "-5 ^ 1.9" 'err
  31. e$ = "2*-3 - -4+-0.25" ' returns -2.25 OK but must  isolate - meant for subtraction OK
  32.  
  33. e$ = "1 + 2 * (3 + (4 * 5 + 6 * 7 * 8) - 9) / 10" ' returns 71 OK  OK fixed!
  34.  
  35. 'e$ = " 1 + 2*(3 - 2*(3 - 2)*((2 - 4)*5 - 22/(7 + 2*(3 - 1)) - 1)) + 1" ' returns 60 OK
  36. 'e$ = "1+1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+1/15)/14)/13)/12)/11)/10)/9)/8)/7)/6)/5)/4)/3)/2"
  37. ' returns euler's 2.718 281 828 458 994 464 285 469 58 OK for as far as it goes 2.718 281 828 458 995 last digit off by 1  OK!!!
  38. 'e$ = "(1.4 + 2^(19%4))/2" ' > 4.7 OK OK
  39. 'e$ = "e^2" ' > 7.3890...
  40. 'e$ = "PI/6" ' > .52...
  41. 'e$ = "x ^ (200/400)" ' > 2.23606 when sqr(x) x = 5
  42. 'e$ = "x^2 - 2*x - 15" ' > 0 when x = 5 good!
  43. 'e$ = "e^ 8" ' > 2980.958
  44. 'e$ = " log(2980.958)" ' > 8.000..
  45. 'e$ = "sin(x)^2 + cos(x)^2" ' > 1
  46. 'e$ = "atan(sin(30)/cos(30))" ' > 30 with DFlag = 1
  47. 'e$ = ".3 + 2*10^-8"
  48. 'e$ = "pi/6 < pi" 'yeah my first Boolean!
  49. 'e$ = "99 % 11 = 0"
  50. 'e$ = "23 <= 22"
  51. 'e$ = "(99 % 9 = 0) and (not 23 < 22 or 5 < 3)"
  52.  
  53. 'IMPORTANT NOTE: wrap - sign with spaces if meant for subtraction,
  54. 'if meant to signal neg number leave no space between it and number
  55.  
  57. R = Evaluate(e$)
  58. If EvalErr$ <> "" Then Print "Error: "; EvalErr$ Else Print "Expression = "; R
  59. Print "Done"
  61.  
  62. 'this preps e$ string for actual evaluation function and makes call to it,
  63. 'checks results for error returns that or number if no error.
  64. Function Evaluate (e$)
  65.     'Dim As String c, b, subst
  66.     'Dim As Integer i, po, p
  67.     b$ = "" 'rebuild string with padded spaces
  68.     'this makes sure ( ) + * / % ^ are wrapped with spaces, on your own with - sign
  69.     For i = 1 To Len(e$) 'filter chars and count ()
  70.         c$ = LCase$(Mid$(e$, i, 1))
  71.         If c$ = ")" Then
  72.             po = po - 1: b$ = b$ + " ) "
  73.         ElseIf c$ = "(" Then
  74.             po = po + 1: b$ = b$ + " ( "
  75.         ElseIf InStr("+*/%^", c$) > 0 Then
  76.             b$ = b$ + " " + c$ + " "
  77.         ElseIf InStr(" -.0123456789abcdefghijklmnopqrstuvwxyz<>=", c$) > 0 Then
  78.             b$ = b$ + c$
  79.         End If
  80.         If po < 0 Then EvalErr$ = "Too many )": Exit Function
  81.     Next
  82.     If po <> 0 Then EvalErr$ = "Unbalanced ()": Exit Function
  83.     e$ = wPrep(b$)
  84.     For i = 1 To 3
  85.         p = wIn(e$, Wrd$("x e pi", i))
  86.         While p > 0
  87.             Select Case i
  88.                 Case 1: subst$ = LTrim$(Str$(GlobalX)) ': PRINT "subst "; subst$, GlobalX
  89.                 Case 2: subst$ = LTrim$(Str$(Exp(1)))
  90.                 Case 3: subst$ = LTrim$(Str$(_Pi))
  91.             End Select
  92.             e$ = wSubst$(e$, p, p, subst$)
  93.             p = wIn(e$, Wrd("x e pi", i))
  94.         Wend
  95.     Next
  96.     Evaluate = evalW(e$)
  98.  
  99. ' the recursive part of EVAL
  100. Function evalW (s$)
  101.     Dim pop As Integer, lPlace As Integer, i As Integer, rPlace As Integer, wc As Integer
  102.     Dim po As Integer, funPlace As Integer, recurs As Integer, p As Integer, o As Integer
  103.     'Dim As String fun, w, test, inner, ops, op, middle
  104.     'Dim As Double a, b, innerV, m
  105.  
  106.     Print "EvalW gets: "; s$ 'debug or fun$ to watch recursive calls in reverse
  107.     pop = wIn(s$, "(") 'parenthesis open place
  108.     While pop > 0
  109.         If pop = 1 Then
  110.             fun$ = "": lPlace = 1
  111.         Else
  112.             test$ = Wrd$(s$, pop - 1)
  113.             funPlace = wIn("sin cos tan atan log exp sqr rad deg", test$) 'no asin or acos in QB64
  114.             If funPlace > 0 Then
  115.                 fun$ = test$: lPlace = pop - 1
  116.             Else
  117.                 fun$ = "": lPlace = pop
  118.             End If
  119.         End If
  120.         wc = wCnt(s$): po = 1
  121.         For i = pop + 1 To wc
  122.             If Wrd$(s$, i) = "(" Then po = po + 1
  123.             If Wrd$(s$, i) = ")" Then po = po - 1
  124.             If po = 0 Then rPlace = i: Exit For
  125.         Next
  126.         inner$ = ""
  127.         For i = (pop + 1) To (rPlace - 1)
  128.             w$ = Wrd$(s$, i)
  129.             inner$ = inner$ + w$ + " "
  130.             If wIn("( and or = < > <= >= <> + - * / % ^", w$) > 0 Then recurs = 1
  131.         Next
  132.         If recurs Then innerV = evalW(inner$) Else innerV = Val(inner$)
  133.         Select Case fun$
  134.             Case "": m = innerV
  135.             Case "sin": If DFlag Then m = Sin(RAD * innerV) Else m = Sin(innerV)
  136.             Case "cos": If DFlag Then m = Cos(RAD * innerV) Else m = Cos(innerV)
  137.             Case "tan": If DFlag Then m = Tan(RAD * innerV) Else m = Tan(innerV)
  138.                 'CASE "asin": IF DFlag THEN m = DEG * (Asin(innerV)) ELSE m = Asin(innerV)
  139.                 ' CASE "acos": IF DFlag THEN m = DEG * (acos(innerV)) ELSE m = acos(innerV)
  140.             Case "atan": If DFlag Then m = DEG * (Atn(innerV)) Else m = Atn(innerV)
  141.             Case "log"
  142.                 If innerV > 0 Then
  143.                     m = Log(innerV)
  144.                 Else
  145.                     EvalErr$ = "LOG only works on numbers > 0.": Exit Function
  146.                 End If
  147.             Case "exp" 'the error limit is inconsistent in JB
  148.                 If -745 <= innerV And innerV <= 709 Then 'your system may have different results
  149.                     m = Exp(innerV)
  150.                 Else
  151.                     'what the heck???? 708 works fine all alone as limit ?????
  152.                     EvalErr$ = "EXP(n) only works for n = -745 to 709.": Exit Function
  153.                 End If
  154.             Case "sqr"
  155.                 If innerV >= 0 Then
  156.                     m = Sqr(innerV)
  157.                 Else
  158.                     EvalErr$ = "SQR only works for numbers >= 0.": Exit Function
  159.                 End If
  160.             Case "rad": m = innerV * RAD
  161.             Case "deg": m = innerV * DEG
  162.             Case Else: EvalErr$ = "Unidentified function " + fun$: Exit Function
  163.         End Select
  164.         s$ = wSubst(s$, lPlace, rPlace, LTrim$(Str$(m)))
  165.         pop = wIn(s$, "(")
  166.     Wend
  167.  
  168.     ops$ = "% ^ / * - + = < > <= >= <> and or not" 'all () cleared, now for binary ops (not not binary but is last!)
  169.     For o = 1 To 15
  170.         op$ = Wrd$(ops$, o)
  171.         p = wIn(s$, op$)
  172.         While p > 0
  173.             a = Val(Wrd$(s$, p - 1))
  174.             b = Val(Wrd$(s$, p + 1))
  175.             Select Case op$
  176.                 Case "%"
  177.                     If b >= 2 Then
  178.                         middle$ = LTrim$(Str$(Int(a) Mod Int(b)))
  179.                     Else
  180.                         EvalErr$ = "For a Mod b, b value < 2."
  181.                         Exit Function
  182.                     End If
  183.                 Case "^"
  184.                     If Int(b) = b Or a >= 0 Then
  185.                         middle$ = LTrim$(Str$(a ^ b))
  186.                     Else
  187.                         EvalErr$ = "For a ^ b, a needs to be >= 0 when b not integer."
  188.                         Exit Function
  189.                     End If
  190.                 Case "/"
  191.                     If b <> 0 Then
  192.                         middle$ = LTrim$(Str$(a / b))
  193.                     Else
  194.                         EvalErr$ = "Div by 0"
  195.                         Exit Function
  196.                     End If
  197.                 Case "*": middle$ = LTrim$(Str$(a * b))
  198.                 Case "-": middle$ = LTrim$(Str$(a - b))
  199.                 Case "+": middle$ = LTrim$(Str$(a + b))
  200.                 Case "=": If a = b Then middle$ = "1" Else middle$ = "0"
  201.                 Case "<": If a < b Then middle$ = "1" Else middle$ = "0"
  202.                 Case ">": If a > b Then middle$ = "1" Else middle$ = "0"
  203.                 Case "<=": If a <= b Then middle$ = "1" Else middle$ = "0"
  204.                 Case ">=": If a >= b Then middle$ = "1" Else middle$ = "0"
  205.                 Case "<>": If a <> b Then middle$ = "1" Else middle$ = "0"
  206.                 Case "and": If a <> 0 And b <> 0 Then middle$ = "1" Else middle$ = "0"
  207.                 Case "or": If a <> 0 Or b <> 0 Then middle$ = "1" Else middle$ = "0"
  208.                 Case "not": If b = 0 Then middle$ = "1" Else middle$ = "0" 'use b as nothing should be left of not
  209.             End Select
  210.             s$ = wSubst$(s$, p - 1, p + 1, middle$)
  211.             'PRINT s$
  212.             p = wIn(s$, op$)
  213.         Wend
  214.     Next
  215.     evalW = Val(s$)
  216.     'PRINT evalW
  218.  
  219. 'return trimmed  source string s with one space between each word
  220. Function wPrep$ (ss$)
  221.  
  222.     s$ = LTrim$(RTrim$(ss$))
  223.     If Len(s$) = 0 Then wPrep$ = "": Exit Function
  224.     'remove all double or more spaces
  225.     p = InStr(s$, "  ")
  226.     While p > 0
  227.         s$ = Mid$(s$, 1, p) + Mid$(s$, p + 2, Len(s$) - p - 1)
  228.         p = InStr(s$, "  ")
  229.     Wend
  230.     wPrep$ = s$
  232.  
  233. ' This duplicates JB word(string, wordNumber) base 1, space as default delimiter
  234. ' by returning the Nth word of source string s
  235. ' this function assumes s has been through wPrep
  236. Function Wrd$ (ss$, wNumber)
  237.     's$ = wPrep(ss$)
  238.     s$ = ss$ 'don't change ss$
  239.     If Len(s$) = 0 Then Wrd$ = "": Exit Function
  240.     w$ = "": c = 1
  241.     For i = 1 To Len(s$)
  242.         If Mid$(s$, i, 1) = " " Then
  243.             If c = wNumber Then Wrd$ = w$: Exit Function
  244.             w$ = "": c = c + 1
  245.         Else
  246.             w$ = w$ + Mid$(s$, i, 1)
  247.         End If
  248.     Next
  249.     If c <> wNumber Then Wrd$ = " " Else Wrd$ = w$
  251.  
  252. 'This function counts the words in source string s
  253. 'this function assumes s has been thru wPrep
  254. Function wCnt (s$)
  255.     Dim c As Integer, p As Integer, ip As Integer
  256.     's = wPrep(s)
  257.     If Len(s$) = 0 Then wCnt = 0: Exit Function
  258.     c = 1: p = 1: ip = InStr(p, s$, " ")
  259.     While ip
  260.         c = c + 1: p = ip + 1: ip = InStr(p, s$, " ")
  261.     Wend
  262.     wCnt = c
  264.  
  265. 'Where is word In source s, 0 = Not In source
  266. 'this function assumes s has been thru wPrep
  267. Function wIn (s$, wd$)
  268.     Dim wc As Integer, i As Integer
  269.     wc = wCnt(s$): wIn = 0
  270.     For i = 1 To wc
  271.         If Wrd$(s$, i) = wd$ Then wIn = i: Exit Function
  272.     Next
  274.  
  275. ' substitute string in s to replace section first to last words inclusive
  276. 'this function assumes s has been thru wPrep
  277. Function wSubst$ (s$, first, last, subst$)
  278.     Dim wc As Integer, i As Integer, subF As Integer
  279.     wc = wCnt(s$): b$ = ""
  280.     For i = 1 To wc
  281.         If first <= i And i <= last Then 'do this only once!
  282.             If subF = 0 Then b$ = b$ + subst$ + " ": subF = 1
  283.         Else
  284.             b$ = b$ + Wrd$(s$, i) + " "
  285.         End If
  286.     Next
  287.     wSubst$ = LTrim$(RTrim$(b$))
  289.  
  290.  
  291.  
Logged

Offline CharlieJV

  • Newbie
  • Posts: 89
Re: Just a primitive program to parse arithmetic expressions.
« Reply #2 on: March 19, 2022, 11:50:44 am »
Quote from: bplus on March 18, 2022, 08:59:31 pm
Guess I will show you how it's done :)
(snip!)

That's quite fantastic.
Logged

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • Steve’s QB64 Archive Forum
Re: Just a primitive program to parse arithmetic expressions.
« Reply #3 on: March 19, 2022, 12:07:23 pm »
Quote from: bplus on March 18, 2022, 08:59:31 pm
Guess I will show you how it's done :)
Code: QB64: [Select]
  1. _Title "Eval by bplus translated from FB 2018-02-05"
  2. ' from: EVAL  2 bplus.bas for FB (B+=MGA) 2017-07-04
  3. 'based on successful: evalW 2.txt for JB [B+=MGA] 2017-03-11 repost with edits
  4. ' EVAL 1 - Just Basic Eval code translated and = > < >= <= <> binary's added
  5. 'EVAL  2 - add And and Or, Not
  6.  
  7. Const XMAX = 1200
  8. Const YMAX = 720
  9.  
  10. Screen _NewImage(XMAX, YMAX, 32)
  13.  
  14. Common Shared DFlag, EvalErr$, GlobalX, RAD, DEG
  15.  
  16. EvalErr$ = ""
  17. DFlag = 1
  18. GlobalX = 5 'changeable
  19. RAD = _Pi / 180.0
  20. DEG = 180 / _Pi
  21. 'debug
  22. 'PRINT RAD, DEG, DFlag, GlobalX
  23.  
  24. '  tests
  25. e$ = "log(0)" 'err
  26. e$ = "exp(-745) " 'no err! -746 err!
  27. 'e$ = "exp(-693) " ' FB -693 limit 1.0812... E-301 bottom limit no error on my system, -708 on another test
  28. e$ = "exp( 709) " ' no err , FB 707 limit 8.21840... E+307no error on my system
  29. e$ = "sqr(-10)" 'err
  30. e$ = "-5 ^ 1.9" 'err
  31. e$ = "2*-3 - -4+-0.25" ' returns -2.25 OK but must  isolate - meant for subtraction OK
  32.  
  33. e$ = "1 + 2 * (3 + (4 * 5 + 6 * 7 * 8) - 9) / 10" ' returns 71 OK  OK fixed!
  34.  
  35. 'e$ = " 1 + 2*(3 - 2*(3 - 2)*((2 - 4)*5 - 22/(7 + 2*(3 - 1)) - 1)) + 1" ' returns 60 OK
  36. 'e$ = "1+1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+1/15)/14)/13)/12)/11)/10)/9)/8)/7)/6)/5)/4)/3)/2"
  37. ' returns euler's 2.718 281 828 458 994 464 285 469 58 OK for as far as it goes 2.718 281 828 458 995 last digit off by 1  OK!!!
  38. 'e$ = "(1.4 + 2^(19%4))/2" ' > 4.7 OK OK
  39. 'e$ = "e^2" ' > 7.3890...
  40. 'e$ = "PI/6" ' > .52...
  41. 'e$ = "x ^ (200/400)" ' > 2.23606 when sqr(x) x = 5
  42. 'e$ = "x^2 - 2*x - 15" ' > 0 when x = 5 good!
  43. 'e$ = "e^ 8" ' > 2980.958
  44. 'e$ = " log(2980.958)" ' > 8.000..
  45. 'e$ = "sin(x)^2 + cos(x)^2" ' > 1
  46. 'e$ = "atan(sin(30)/cos(30))" ' > 30 with DFlag = 1
  47. 'e$ = ".3 + 2*10^-8"
  48. 'e$ = "pi/6 < pi" 'yeah my first Boolean!
  49. 'e$ = "99 % 11 = 0"
  50. 'e$ = "23 <= 22"
  51. 'e$ = "(99 % 9 = 0) and (not 23 < 22 or 5 < 3)"
  52.  
  53. 'IMPORTANT NOTE: wrap - sign with spaces if meant for subtraction,
  54. 'if meant to signal neg number leave no space between it and number
  55.  
  57. R = Evaluate(e$)
  58. If EvalErr$ <> "" Then Print "Error: "; EvalErr$ Else Print "Expression = "; R
  59. Print "Done"
  61.  
  62. 'this preps e$ string for actual evaluation function and makes call to it,
  63. 'checks results for error returns that or number if no error.
  64. Function Evaluate (e$)
  65.     'Dim As String c, b, subst
  66.     'Dim As Integer i, po, p
  67.     b$ = "" 'rebuild string with padded spaces
  68.     'this makes sure ( ) + * / % ^ are wrapped with spaces, on your own with - sign
  69.     For i = 1 To Len(e$) 'filter chars and count ()
  70.         c$ = LCase$(Mid$(e$, i, 1))
  71.         If c$ = ")" Then
  72.             po = po - 1: b$ = b$ + " ) "
  73.         ElseIf c$ = "(" Then
  74.             po = po + 1: b$ = b$ + " ( "
  75.         ElseIf InStr("+*/%^", c$) > 0 Then
  76.             b$ = b$ + " " + c$ + " "
  77.         ElseIf InStr(" -.0123456789abcdefghijklmnopqrstuvwxyz<>=", c$) > 0 Then
  78.             b$ = b$ + c$
  79.         End If
  80.         If po < 0 Then EvalErr$ = "Too many )": Exit Function
  81.     Next
  82.     If po <> 0 Then EvalErr$ = "Unbalanced ()": Exit Function
  83.     e$ = wPrep(b$)
  84.     For i = 1 To 3
  85.         p = wIn(e$, Wrd$("x e pi", i))
  86.         While p > 0
  87.             Select Case i
  88.                 Case 1: subst$ = LTrim$(Str$(GlobalX)) ': PRINT "subst "; subst$, GlobalX
  89.                 Case 2: subst$ = LTrim$(Str$(Exp(1)))
  90.                 Case 3: subst$ = LTrim$(Str$(_Pi))
  91.             End Select
  92.             e$ = wSubst$(e$, p, p, subst$)
  93.             p = wIn(e$, Wrd("x e pi", i))
  94.         Wend
  95.     Next
  96.     Evaluate = evalW(e$)
  98.  
  99. ' the recursive part of EVAL
  100. Function evalW (s$)
  101.     Dim pop As Integer, lPlace As Integer, i As Integer, rPlace As Integer, wc As Integer
  102.     Dim po As Integer, funPlace As Integer, recurs As Integer, p As Integer, o As Integer
  103.     'Dim As String fun, w, test, inner, ops, op, middle
  104.     'Dim As Double a, b, innerV, m
  105.  
  106.     Print "EvalW gets: "; s$ 'debug or fun$ to watch recursive calls in reverse
  107.     pop = wIn(s$, "(") 'parenthesis open place
  108.     While pop > 0
  109.         If pop = 1 Then
  110.             fun$ = "": lPlace = 1
  111.         Else
  112.             test$ = Wrd$(s$, pop - 1)
  113.             funPlace = wIn("sin cos tan atan log exp sqr rad deg", test$) 'no asin or acos in QB64
  114.             If funPlace > 0 Then
  115.                 fun$ = test$: lPlace = pop - 1
  116.             Else
  117.                 fun$ = "": lPlace = pop
  118.             End If
  119.         End If
  120.         wc = wCnt(s$): po = 1
  121.         For i = pop + 1 To wc
  122.             If Wrd$(s$, i) = "(" Then po = po + 1
  123.             If Wrd$(s$, i) = ")" Then po = po - 1
  124.             If po = 0 Then rPlace = i: Exit For
  125.         Next
  126.         inner$ = ""
  127.         For i = (pop + 1) To (rPlace - 1)
  128.             w$ = Wrd$(s$, i)
  129.             inner$ = inner$ + w$ + " "
  130.             If wIn("( and or = < > <= >= <> + - * / % ^", w$) > 0 Then recurs = 1
  131.         Next
  132.         If recurs Then innerV = evalW(inner$) Else innerV = Val(inner$)
  133.         Select Case fun$
  134.             Case "": m = innerV
  135.             Case "sin": If DFlag Then m = Sin(RAD * innerV) Else m = Sin(innerV)
  136.             Case "cos": If DFlag Then m = Cos(RAD * innerV) Else m = Cos(innerV)
  137.             Case "tan": If DFlag Then m = Tan(RAD * innerV) Else m = Tan(innerV)
  138.                 'CASE "asin": IF DFlag THEN m = DEG * (Asin(innerV)) ELSE m = Asin(innerV)
  139.                 ' CASE "acos": IF DFlag THEN m = DEG * (acos(innerV)) ELSE m = acos(innerV)
  140.             Case "atan": If DFlag Then m = DEG * (Atn(innerV)) Else m = Atn(innerV)
  141.             Case "log"
  142.                 If innerV > 0 Then
  143.                     m = Log(innerV)
  144.                 Else
  145.                     EvalErr$ = "LOG only works on numbers > 0.": Exit Function
  146.                 End If
  147.             Case "exp" 'the error limit is inconsistent in JB
  148.                 If -745 <= innerV And innerV <= 709 Then 'your system may have different results
  149.                     m = Exp(innerV)
  150.                 Else
  151.                     'what the heck???? 708 works fine all alone as limit ?????
  152.                     EvalErr$ = "EXP(n) only works for n = -745 to 709.": Exit Function
  153.                 End If
  154.             Case "sqr"
  155.                 If innerV >= 0 Then
  156.                     m = Sqr(innerV)
  157.                 Else
  158.                     EvalErr$ = "SQR only works for numbers >= 0.": Exit Function
  159.                 End If
  160.             Case "rad": m = innerV * RAD
  161.             Case "deg": m = innerV * DEG
  162.             Case Else: EvalErr$ = "Unidentified function " + fun$: Exit Function
  163.         End Select
  164.         s$ = wSubst(s$, lPlace, rPlace, LTrim$(Str$(m)))
  165.         pop = wIn(s$, "(")
  166.     Wend
  167.  
  168.     ops$ = "% ^ / * - + = < > <= >= <> and or not" 'all () cleared, now for binary ops (not not binary but is last!)
  169.     For o = 1 To 15
  170.         op$ = Wrd$(ops$, o)
  171.         p = wIn(s$, op$)
  172.         While p > 0
  173.             a = Val(Wrd$(s$, p - 1))
  174.             b = Val(Wrd$(s$, p + 1))
  175.             Select Case op$
  176.                 Case "%"
  177.                     If b >= 2 Then
  178.                         middle$ = LTrim$(Str$(Int(a) Mod Int(b)))
  179.                     Else
  180.                         EvalErr$ = "For a Mod b, b value < 2."
  181.                         Exit Function
  182.                     End If
  183.                 Case "^"
  184.                     If Int(b) = b Or a >= 0 Then
  185.                         middle$ = LTrim$(Str$(a ^ b))
  186.                     Else
  187.                         EvalErr$ = "For a ^ b, a needs to be >= 0 when b not integer."
  188.                         Exit Function
  189.                     End If
  190.                 Case "/"
  191.                     If b <> 0 Then
  192.                         middle$ = LTrim$(Str$(a / b))
  193.                     Else
  194.                         EvalErr$ = "Div by 0"
  195.                         Exit Function
  196.                     End If
  197.                 Case "*": middle$ = LTrim$(Str$(a * b))
  198.                 Case "-": middle$ = LTrim$(Str$(a - b))
  199.                 Case "+": middle$ = LTrim$(Str$(a + b))
  200.                 Case "=": If a = b Then middle$ = "1" Else middle$ = "0"
  201.                 Case "<": If a < b Then middle$ = "1" Else middle$ = "0"
  202.                 Case ">": If a > b Then middle$ = "1" Else middle$ = "0"
  203.                 Case "<=": If a <= b Then middle$ = "1" Else middle$ = "0"
  204.                 Case ">=": If a >= b Then middle$ = "1" Else middle$ = "0"
  205.                 Case "<>": If a <> b Then middle$ = "1" Else middle$ = "0"
  206.                 Case "and": If a <> 0 And b <> 0 Then middle$ = "1" Else middle$ = "0"
  207.                 Case "or": If a <> 0 Or b <> 0 Then middle$ = "1" Else middle$ = "0"
  208.                 Case "not": If b = 0 Then middle$ = "1" Else middle$ = "0" 'use b as nothing should be left of not
  209.             End Select
  210.             s$ = wSubst$(s$, p - 1, p + 1, middle$)
  211.             'PRINT s$
  212.             p = wIn(s$, op$)
  213.         Wend
  214.     Next
  215.     evalW = Val(s$)
  216.     'PRINT evalW
  218.  
  219. 'return trimmed  source string s with one space between each word
  220. Function wPrep$ (ss$)
  221.  
  222.     s$ = LTrim$(RTrim$(ss$))
  223.     If Len(s$) = 0 Then wPrep$ = "": Exit Function
  224.     'remove all double or more spaces
  225.     p = InStr(s$, "  ")
  226.     While p > 0
  227.         s$ = Mid$(s$, 1, p) + Mid$(s$, p + 2, Len(s$) - p - 1)
  228.         p = InStr(s$, "  ")
  229.     Wend
  230.     wPrep$ = s$
  232.  
  233. ' This duplicates JB word(string, wordNumber) base 1, space as default delimiter
  234. ' by returning the Nth word of source string s
  235. ' this function assumes s has been through wPrep
  236. Function Wrd$ (ss$, wNumber)
  237.     's$ = wPrep(ss$)
  238.     s$ = ss$ 'don't change ss$
  239.     If Len(s$) = 0 Then Wrd$ = "": Exit Function
  240.     w$ = "": c = 1
  241.     For i = 1 To Len(s$)
  242.         If Mid$(s$, i, 1) = " " Then
  243.             If c = wNumber Then Wrd$ = w$: Exit Function
  244.             w$ = "": c = c + 1
  245.         Else
  246.             w$ = w$ + Mid$(s$, i, 1)
  247.         End If
  248.     Next
  249.     If c <> wNumber Then Wrd$ = " " Else Wrd$ = w$
  251.  
  252. 'This function counts the words in source string s
  253. 'this function assumes s has been thru wPrep
  254. Function wCnt (s$)
  255.     Dim c As Integer, p As Integer, ip As Integer
  256.     's = wPrep(s)
  257.     If Len(s$) = 0 Then wCnt = 0: Exit Function
  258.     c = 1: p = 1: ip = InStr(p, s$, " ")
  259.     While ip
  260.         c = c + 1: p = ip + 1: ip = InStr(p, s$, " ")
  261.     Wend
  262.     wCnt = c
  264.  
  265. 'Where is word In source s, 0 = Not In source
  266. 'this function assumes s has been thru wPrep
  267. Function wIn (s$, wd$)
  268.     Dim wc As Integer, i As Integer
  269.     wc = wCnt(s$): wIn = 0
  270.     For i = 1 To wc
  271.         If Wrd$(s$, i) = wd$ Then wIn = i: Exit Function
  272.     Next
  274.  
  275. ' substitute string in s to replace section first to last words inclusive
  276. 'this function assumes s has been thru wPrep
  277. Function wSubst$ (s$, first, last, subst$)
  278.     Dim wc As Integer, i As Integer, subF As Integer
  279.     wc = wCnt(s$): b$ = ""
  280.     For i = 1 To wc
  281.         If first <= i And i <= last Then 'do this only once!
  282.             If subF = 0 Then b$ = b$ + subst$ + " ": subF = 1
  283.         Else
  284.             b$ = b$ + Wrd$(s$, i) + " "
  285.         End If
  286.     Next
  287.     wSubst$ = LTrim$(RTrim$(b$))
  289.  
  290.  
  291.  

I've got one of these floating around somewhere also!  :P

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

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • Steve’s QB64 Archive Forum
Re: Just a primitive program to parse arithmetic expressions.
« Reply #4 on: March 19, 2022, 12:16:36 pm »
If you notice with the above, all you get is the answer to your formula, but if you remove some of the remarked out PRINT statements, you can follow the process as it calculates everything out step by step for us, such as below:

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

 
math process at work.png
Logged
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!
Pages: [1]   Go Up
« previous next »