Author Topic: EVAL Function  (Read 3754 times)

0 Members and 1 Guest are viewing this topic.

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

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
EVAL Function
« on: February 15, 2021, 10:27:23 pm »
For those who just walked in the door to the Shorthand Basic (like and luv'd) Interpreter or SB and SB1, you've got to know about EVAL functions that convert strings of numbers formulas and outputs, if all goes well, a single number that is pretty accurate but let's not expect perfect with floating point maths involved. And if all does not go well helps the user by pointing to their mistake ;) like EVAL doesn't make mistakes.

Here is mine just fixed and retested tonight:
Code: QB64: [Select]
  1. _Title "Eval Remake Fix Not 2021-02-15" ' B+
  2. ' from: EVAL  2018-02-05 5:53 PM
  3. ' Goals do it without Wrd$ functions
  4. ' Do it for both string and math functions
  5.  
  6. ' 2021-02-15  not is broken!!  fixed I think moved to Function list because NO is NOT a Bianary Operation!!!
  7. ' 2021-02-15 it looks like subtract and -number can be differentaited so that - for subtraction does Not
  8. '            have to be wrapped in spaces, oh yeah oh yeah!
  9. '              e$ = "2*-3--4+-0.25" ' returns -2.25 OK  -6 + 4 -.25
  10. ' completely retested all strings below, fixed not by moving it to the Function list,
  11. ' and removing it from the BINARY ops list because NOT is NOT a BINARY FUNCTION THAT REQUIRES TWO ARGUMENTS
  12.  
  13. Const XMAX = 1200
  14. Const YMAX = 720
  15.  
  16. Screen _NewImage(XMAX, YMAX, 32)
  17.  
  18. debug = -1
  19.  
  20. 'evaluate$ and evalW setup
  21. Dim Shared DFlag As _Bit, EvalErr$, GlobalX As _Float, RAD As _Float, DEG As _Float
  22. DFlag = -1
  23. EvalErr$ = ""
  24. GlobalX = 5 'changeable
  25. RAD = _Pi / 180.0
  26. DEG = 180 / _Pi
  27. ReDim Shared fList(1 To 1) As String
  28. Split "int, sin, cos, tan, asin, acos, atan, log, exp, sqr, rad, deg, not", ", ", fList() ' add not function here
  29. ReDim Shared oList(1 To 1) As String
  30. Split "^, %, /, *, -, +, =, <, >, <=, >=, <>, or, and", ", ", oList() ' not is NOT a Binary Op
  31.  
  32. 'main dim
  33. Dim e$, r$
  34. '  tests
  35.  
  36. e$ = "PI" ' ok caps or not
  37. 'e$ = "pi" 'ok
  38. 'e$ = "1 +1"
  39. 'e$ = "-1+1" 'ok
  40. 'e$ = "(5 - 7) * 2" '-4 ok
  41. 'e$ = "(5-7)* 2" '-4 ok
  42. 'e$ = "(-5--7)*2" '4 ok
  43. 'e$ = "2*(-5-7)" ' -24  ok
  44. 'e$ = "(-1--2)+(-3--4)" ' 2 ok 1 + 1
  45. 'e$ = "x*x-2*x-3" ' x = 5 returns 12
  46.  
  47. ' new not tests
  48. 'e$ = "not-1" ' wrong! syntax returns -1  but no error thrown
  49. 'e$ = "not(-1)" ' fixed
  50. 'e$ = "not(-1 or -1)" ' ok fixed
  51. 'e$ = "not(0)" 'yeah good
  52. 'e$ = "not(-8)"
  53. 'e$ = "not (-1)" '  wrong syntax but this works????  because ( and ) can be wrapped in spaces
  54. 'e$ = "not (0)" ' wrong syntax  but works???  it's because of way ( ) can be spaced or not
  55. 'e$ = "-1 not" ' wrong syntax crash bang boom but the line is soooo wrong , no error
  56.  
  57. 'e$ = "-1 or 0" 'OK
  58. 'e$ = "log(0)" 'err
  59. 'e$ = "log(2)"
  60. 'e$ = "exp(.69314718055)" 'inverse above  close enough
  61. 'e$ = "exp(-745) " '-745 no err! -746 err!
  62. 'e$ = "exp(-693) " ' FB -693 limit 1.0812... E-301 bottom limit no error on my system, -708 on another test
  63. 'e$ = "exp( 709) " ' no err , FB 707 limit 8.21840... E+307no error on my system
  64. 'e$ = "sqr(-10)" 'err
  65. 'e$ = "-5 ^ 1.9" 'err good get err message
  66. 'e$ = "2*-3--4+-0.25" ' returns -2.25 OK don't need to isolate - meant for subtraction !!! <<<<<<<<<<<<<<<<<<<<< see fixed 2021-02-15
  67. 'e$ = "1+2*(3+((4*5)+(6*7*8))-9)/10" ' returns 71 OK  OK fixed!
  68. 'e$ = " 1+2*(3-2*(3-2)*((2-4)*5-22/(7+2*(3-1))-1))+1" ' returns 60 OK
  69. '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"
  70. '' 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!!!
  71. 'e$ = "(1.4 + 2^(19%4))/2" ' = 4.7 OK OK
  72. 'e$ = "e^2" ' = 7.3890...
  73. 'e$ = "PI/6" '= .52...
  74. 'e$ = "x ^ (200/400)" ' = 2.23606... when sqr(x) x = 5
  75. 'e$ = "x^2-2*x-15" ' = 0 when x = 5 good!
  76. 'e$ = "e^ 8" ' > 2980.958
  77. 'e$ = " log(2980.958)" ' > 8.000..
  78. 'e$ = "sin(x)^2 + cos(x)^2" ' > ~1
  79. 'e$ = "atan(1)" 'should be 45 degrees if degrees flag on nope, correct in radians  fixed  2021-02-15
  80. 'e$ = "atan(sin(30)/cos(30))" ' > 30 with DFlag = 1   2021-02-15 eeeh no? fixed  2021-02-15
  81. 'e$ = ".3 + 2*10^-8" ' .30000002
  82. 'e$ = "pi/6 < pi" ' -1 of course yeah my first Boolean!
  83. 'e$ = "99 % 11 = 0"
  84. 'e$ = "23 <= 22" ' 0?   of course!
  85. 'e$ = "(99 % 9 = 0) and (not (  (23 < 22) or (5 < 3)  )) " ' (0) and ( not ((0) or (0) ) )  the first part is -1 so 0! 2nd part -1 so ok!
  86.  
  87. 'IMPORTANT NOTE: wrap - sign with spaces if meant for subtraction,   '<<<<<<<<<<<<<<<<< I thought I fixed this??? 2021-02-15
  88. 'if meant to signal neg number leave no space between it and number
  89.  
  90. r$ = Evaluate$(e$)
  91. If EvalErr$ <> "" Then Print "Error: "; EvalErr$ Else Print "Expression = "; r$
  92. Print "Done"
  93.  
  94. 'this preps e$ string for actual evaluation function and makes call to it,
  95. 'checks results for error returns that or string form of result calculation
  96. 'the new goal is to do string functions along side math
  97. Function Evaluate$ (e$)
  98.     Dim b$, c$, subst$, t$
  99.     Dim i As Integer, po As Integer, p As Integer, lb As Integer, ub As Integer ', isolateNeg AS _BIT
  100.     ' isolateNeg = 0
  101.     b$ = "" 'rebuild string with padded spaces
  102.     'this makes sure ( ) + * / % ^ are wrapped with spaces, on your own with - sign
  103.     For i = 1 To Len(e$) 'filter chars and count ()
  104.         c$ = LCase$(Mid$(e$, i, 1))
  105.         If c$ = ")" Then
  106.             po = po - 1: b$ = b$ + " ) "
  107.         ElseIf c$ = "(" Then
  108.             po = po + 1: b$ = b$ + " ( "
  109.         ElseIf InStr("+*/%^", c$) > 0 Then
  110.             b$ = b$ + " " + c$ + " "
  111.         ElseIf c$ = "-" Then
  112.             If Len(b$) > 0 Then
  113.                 If InStr(".0123456789abcdefghijklmnopqrstuvwxyz)", Right$(RTrim$(b$), 1)) > 0 Then
  114.                     b$ = b$ + " " + c$ + " "
  115.                 Else
  116.                     b$ = b$ + " " + c$
  117.                 End If
  118.             Else
  119.                 b$ = b$ + " " + c$
  120.             End If
  121.         ElseIf InStr(" .0123456789abcdefghijklmnopqrstuvwxyz<>=", c$) > 0 Then
  122.             b$ = b$ + c$
  123.         End If
  124.         If po < 0 Then EvalErr$ = "Too many )": Exit Function
  125.     Next
  126.     If po <> 0 Then EvalErr$ = "Unbalanced ()": Exit Function
  127.     ReDim ev(1 To 1) As String
  128.     Split b$, " ", ev()
  129.     For i = LBound(ev) To UBound(ev) 'subst constants
  130.         If ev(i) = "pi" Then
  131.             ev(i) = LTrim$(Str$(_Pi))
  132.         ElseIf ev(i) = "x" Then
  133.             ev(i) = LTrim$(Str$(GlobalX))
  134.         ElseIf ev(i) = "e" Then
  135.             ev(i) = LTrim$(Str$(Exp(1)))
  136.         End If
  137.     Next
  138.     c$ = evalW$(ev())
  139.     If EvalErr$ <> "" Then Evaluate$ = EvalErr$ Else Evaluate$ = c$
  140.  
  141.  
  142. ' the recursive part of EVAL
  143. Function evalW$ (a() As String)
  144.     If EvalErr$ <> "" Then Exit Function
  145.  
  146.     Dim fun$, test$, w$, innerV$, m$, op$
  147.     Dim pop As Integer, lPlace As Integer, i As Integer, rPlace As Integer, wc As Integer
  148.     Dim po As Integer, p As Integer, o As Integer, index As Integer, saveR As Integer
  149.     Dim recurs As Integer
  150.     Dim innerVal As _Float, a As _Float, b As _Float
  151.     If debug Then
  152.         Print "evalW rec'd a() as:"
  153.         For i = LBound(a) To UBound(a)
  154.             Print a(i); ", ";
  155.         Next
  156.         Print: Input "OK enter"; test$: Print
  157.     End If
  158.     pop = find%(a(), "(") 'parenthesis open place
  159.     While pop > 0
  160.         If pop = 1 Then
  161.             fun$ = "": lPlace = 1
  162.         Else
  163.             test$ = a(pop - 1)
  164.             If find%(fList(), test$) > 0 Then
  165.                 fun$ = test$: lPlace = pop - 1
  166.             Else
  167.                 fun$ = "": lPlace = pop
  168.             End If
  169.         End If
  170.         po = 1
  171.         For i = pop + 1 To UBound(a)
  172.             If a(i) = "(" Then po = po + 1
  173.             If a(i) = ")" Then po = po - 1
  174.             If po = 0 Then rPlace = i: Exit For
  175.         Next
  176.         ReDim inner(1 To 1) As String: index = 0: recurs = 0
  177.         For i = (pop + 1) To (rPlace - 1)
  178.             index = index + 1
  179.             ReDim _Preserve inner(1 To index) As String
  180.             inner(index) = a(i)
  181.             If find%(oList(), a(i)) > 0 Then recurs = -1
  182.         Next
  183.         If recurs Then innerV$ = evalW$(inner()) Else innerV$ = a(pop + 1)
  184.         innerVal = Val(innerV$)
  185.  
  186.         Select Case fun$
  187.             Case "": m$ = innerV$
  188.             Case "int": m$ = ls$(Int(innerVal))
  189.             Case "not": If Int(innerVal) = 0 Then m$ = "-1" Else m$ = "0"
  190.             Case "sin": If DFlag Then m$ = ls$(Sin(RAD * innerVal)) Else m$ = ls$(Sin(innerVal))
  191.             Case "cos": If DFlag Then m$ = ls$(Cos(RAD * innerVal)) Else m$ = ls$(Cos(innerVal))
  192.             Case "tan": If DFlag Then m$ = ls$(Tan(RAD * innerVal)) Else m$ = ls$(Tan(innerVal))
  193.             Case "asin": If DFlag Then m$ = ls$(_Asin(RAD * innerVal)) Else m$ = ls$(_Asin(innerVal))
  194.             Case "acos": If DFlag Then m$ = ls$(_Acos(RAD * innerVal)) Else m$ = ls$(_Acos(innerVal))
  195.             Case "atan": If DFlag Then m$ = ls$((DEG * Atn(innerVal))) Else m$ = ls$(Atn(innerVal))
  196.             Case "log"
  197.                 If innerVal > 0 Then
  198.                     m$ = ls$(Log(innerVal))
  199.                 Else
  200.                     EvalErr$ = "LOG only works on numbers > 0.": Exit Function
  201.                 End If
  202.             Case "exp" 'the error limit is inconsistent in JB
  203.                 If -745 <= innerVal And innerVal <= 709 Then 'your system may have different results
  204.                     m$ = ls$(Exp(innerVal))
  205.                 Else
  206.                     'what the heck???? 708 works fine all alone as limit ?????
  207.                     EvalErr$ = "EXP(n) only works for n = -745 to 709.": Exit Function
  208.                 End If
  209.             Case "sqr"
  210.                 If innerVal >= 0 Then
  211.                     m$ = ls$(Sqr(innerVal))
  212.                 Else
  213.                     EvalErr$ = "SQR only works for numbers >= 0.": Exit Function
  214.                 End If
  215.             Case "rad": m$ = ls$(innerVal * RAD)
  216.             Case "deg": m$ = ls$(innerVal * DEG)
  217.             Case Else: EvalErr$ = "Unidentified function " + fun$: Exit Function
  218.         End Select
  219.         If debug Then
  220.             Print "lPlace, rPlace"; lPlace, rPlace
  221.         End If
  222.         arrSubst a(), lPlace, rPlace, m$
  223.         If debug Then
  224.             Print "After arrSubst a() is:"
  225.             For i = LBound(a) To UBound(a)
  226.                 Print a(i); " ";
  227.             Next
  228.             Print: Print
  229.         End If
  230.         pop = find%(a(), "(")
  231.     Wend
  232.  
  233.     'all parenthesis cleared
  234.     'ops$ = "% ^ / * + - = < > <= >= <> and or not" 'all () cleared, now for binary ops (not not binary but is last!)
  235.     For o = 1 To UBound(oList)
  236.         op$ = oList(o)
  237.         p = find%(a(), op$)
  238.         While p > 0
  239.             a = Val(a(p - 1))
  240.             b = Val(a(p + 1))
  241.             If debug Then
  242.                 Print Str$(a) + op$ + Str$(b)
  243.             End If
  244.             Select Case op$
  245.                 Case "%"
  246.                     If b >= 2 Then
  247.                         m$ = ls$(Int(a) Mod Int(b))
  248.                     Else
  249.                         EvalErr$ = "For a Mod b, b value < 2."
  250.                         Exit Function
  251.                     End If
  252.                 Case "^"
  253.                     If Int(b) = b Or a >= 0 Then
  254.                         m$ = ls$(a ^ b)
  255.                     Else
  256.                         EvalErr$ = "For a ^ b, a needs to be >= 0 when b not integer."
  257.                         Exit Function
  258.                     End If
  259.                 Case "/"
  260.                     If b <> 0 Then
  261.                         m$ = ls$(a / b)
  262.                     Else
  263.                         EvalErr$ = "Div by 0"
  264.                         Exit Function
  265.                     End If
  266.                 Case "*": m$ = ls$(a * b)
  267.                 Case "-": m$ = ls$(a - b)
  268.                 Case "+": m$ = ls$(a + b)
  269.                 Case "=": If a = b Then m$ = "-1" Else m$ = "0"
  270.                 Case "<": If a < b Then m$ = "-1" Else m$ = "0"
  271.                 Case ">": If a > b Then m$ = "-1" Else m$ = "0"
  272.                 Case "<=": If a <= b Then m$ = "-1" Else m$ = "0"
  273.                 Case ">=": If a >= b Then m$ = "-1" Else m$ = "0"
  274.                 Case "<>": If a <> b Then m$ = "-1" Else m$ = "0"
  275.                 Case "and": If a <> 0 And b <> 0 Then m$ = "-1" Else m$ = "0"
  276.                 Case "or": If a <> 0 Or b <> 0 Then m$ = "-1" Else m$ = "0"
  277.                     ' This is NOT a Binary Op!!
  278.                     'Case "not": If b = 0 Then m$ = ls$(-1) Else m$ = ls$(0) 'use b as nothing should be left of not
  279.             End Select
  280.             arrSubst a(), p - 1, p + 1, m$
  281.  
  282.             If debug Then
  283.                 Print "a() reloaded after " + op$ + " as:"
  284.                 For i = LBound(a) To UBound(a)
  285.                     Print a(i); ", ";
  286.                 Next
  287.                 Print: Print
  288.             End If
  289.  
  290.             p = find%(a(), op$)
  291.         Wend
  292.     Next
  293.     fun$ = ""
  294.     For i = LBound(a) To UBound(a)
  295.         fun$ = fun$ + " " + a(i)
  296.     Next
  297.     evalW$ = LTrim$(fun$)
  298.  
  299. Sub arrSubst (a() As String, substLow As Long, substHigh As Long, subst As String)
  300.     Dim i As Long, index As Long
  301.     a(substLow) = subst: index = substLow + 1
  302.     For i = substHigh + 1 To UBound(a)
  303.         a(index) = a(i): index = index + 1
  304.     Next
  305.     ReDim _Preserve a(LBound(a) To UBound(a) + substLow - substHigh)
  306.  
  307. 'notes: REDIM the array(0) to be loaded before calling Split '<<<<<<<<<<<<<<<<<<<<<<< IMPORTANT!!!!
  308. Sub Split (mystr As String, delim As String, arr() As String)
  309.     ' bplus modifications of Galleon fix of Bulrush Split reply #13
  310.     ' http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index.php?topic=1612.0
  311.     ' this sub further developed and tested here: \test\Strings\Split test.bas
  312.     ' 2018-09-16 modified for base 1 arrays
  313.     Dim copy As String, p As Long, curpos As Long, arrpos As Long, lc As Long, dpos As Long
  314.     copy = mystr 'make copy since we are messing with mystr
  315.     'special case if delim is space, probably want to remove all excess space
  316.     If delim = " " Then
  317.         copy = RTrim$(LTrim$(copy))
  318.         p = InStr(copy, "  ")
  319.         While p > 0
  320.             copy = Mid$(copy, 1, p - 1) + Mid$(copy, p + 1)
  321.             p = InStr(copy, "  ")
  322.         Wend
  323.     End If
  324.     ReDim arr(1 To 1) 'clear it
  325.     curpos = 1
  326.     arrpos = 1
  327.     lc = Len(copy)
  328.     dpos = InStr(curpos, copy, delim)
  329.     Do Until dpos = 0
  330.         arr(arrpos) = Mid$(copy, curpos, dpos - curpos)
  331.         arrpos = arrpos + 1
  332.         ReDim _Preserve arr(1 To arrpos + 1) As String
  333.         curpos = dpos + Len(delim)
  334.         dpos = InStr(curpos, copy, delim)
  335.     Loop
  336.     arr(arrpos) = Mid$(copy, curpos)
  337.     ReDim _Preserve arr(1 To arrpos) As String
  338.  
  339. 'assume a() is base 1 array so if find comes back as 0 then found nothing
  340. Function find% (a() As String, s$)
  341.     Dim i%
  342.     For i% = LBound(a) To UBound(a)
  343.         If a(i%) = s$ Then find% = i%: Exit Function
  344.     Next
  345.  
  346. 'ltrim a number float
  347.     ls$ = LTrim$(Str$(n))
  348.  


Some languages have a built in Eval function you can use. SmallBASIC did and I was able to build a hundred line Interpreter (Double, Triple, Quadruple, ... parking allowed ie use of : to load up the lines to come in <=100 lines.
This was a challenge at another forum that I managed to impress some people. SmallBASIC is just an Interpreter nothing Runs independent of the SmallBASIC.exe.

But here in the land of QB64 we don't have this marvelous function (we probably could, I think such a function by Steve is being used for Constants calculations as I recall and of course our QB64 need to use something like that too or maybe uses from the language that translates it to something compliable, but I digress...)
I was just curious how that code for a 100 line Interpreter would do with an Eval Function, so I built one and it does just fine! PLUS QB64 compiles programs so my Interpreter I build can stand alone on it's own without QB64.exe to Run in the OS it's compiled for.

Eval functions can be used for many things, because it does formulas on the fly and with better ones you can use variables and plug-in values when needed.

You know when you do an IF X Then line in Basic, that X has to be evaluated down to True Or False values, key to Interpreters ability to decide which route to take in the flow chart of the program.

All those lines on the right side of = have to be evaluated down to a value that get's associated with the variable name on the left of the =.

You can build Interpreters without Eval but it takes several more lines to get a formula with variables boiled down to a single value. And they are not as fun to code nor debug as a Basic and other regular PL's.

PS To use NOT with this Eval Function, use it like a function with parenthesis wrapping the expression you are NOTing.





« Last Edit: February 22, 2021, 05:31:57 pm by bplus »

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: EVAL Function - NOT Boolean evaluation is fixed
« Reply #1 on: February 16, 2021, 12:54:10 am »
I always love seeing how other people come up with EVAL type routines -- and I'm always amazed at how they do a lot of the same things as  mine, in about half the code!  Here's my Evaluate_Expression routine to compare:

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

How you guys can break all your order of operations down into a single string to parse, amazes the BLEEP out of me.  If I'm reading yours right @bplus, you store the order of operations in ops$?  ops$ = "% ^ / * + - = < > <= >= <> and or not" 'all () cleared, now for binary ops (not not binary but is last!)

I've got mine broken down into a whole dang subroutine, with preparsing and everything else going on under the sun to check and sort parenthesis and all, even before that happens...

I always found the math part fairly simple:  result = number(1) operation number(2)  -- such as result = 3 * 4

But processing things in the proper order, is a real PITA!  (At least, it is for me!)
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: EVAL Function - NOT Boolean evaluation is fixed
« Reply #2 on: February 16, 2021, 12:28:33 pm »
Quote
How you guys can break all your order of operations down into a single string to parse, amazes the BLEEP out of me.  If I'm reading yours right @bplus, you store the order of operations in ops$?  ops$ = "% ^ / * + - = < > <= >= <> and or not" 'all () cleared, now for binary ops (not not binary but is last!)

@SMcNeill  yeah, the list is giving the order of ops to do in each level of (). Steve you do alright when it comes to clever coding or getting the job with an elegant set of commands. PRINT USING a most recent example. ;-))

But to me the biggest hurdle to understanding an Eval Function is knowing to do the () levels recursively.

I just spent 14 hours chasing down a missing comma and a don't drop the spaces switch in a split command to finally get the not() function to work in SB1. 14 hours between getting it to work in Eval and getting it to work in SB1. Yikes!!!

But I think I got allot of other potential annoyances on the way. My Debug switched on program is giving pretty detailed picture how SB1 is processing the string, of course the screen output is a mess because of the excess stuff getting printed and clearing.

Marked as best answer by bplus on February 21, 2021, 12:08:58 pm

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: EVAL Function - NOT Boolean evaluation is fixed
« Reply #3 on: February 16, 2021, 11:13:50 pm »
Eval as integrated and updated from SB1 modifications, error message changes so QB64 doesn't throw (as many) useless Subscript Out of Bounds errors but SB1 (Interpreter update)  gives clues where they are coming from.

Code: QB64: [Select]
  1. _TITLE "Eval 2021-02-21 from SB1 v2021-02-21" ' B+
  2. ' from: EVAL  2018-02-05 5:53 PM
  3. ' Goals do it without Wrd$ functions
  4. ' Do it for both string and math functions
  5.  
  6. ' 2021-02-15  not is broken!!  fixed I think moved to Function list because NO is NOT a Bianary Operation!!!
  7. ' 2021-02-15 it looks like subtract and -number can be differentaited so that - for subtraction does Not
  8. '            have to be wrapped in spaces, oh yeah oh yeah!
  9. '              e$ = "2*-3--4+-0.25" ' returns -2.25 OK  -6 + 4 -.25
  10. ' completely retested all strings below, fixed not by moving it to the Function list,
  11. ' and removing it from the BINARY ops list because NOT is NOT a BINARY FUNCTION THAT REQUIRES TWO ARGUMENTS
  12. ' 2021-02-21 want to update Eval as SB1 exposes glaring errors or nuances to refine functionality.
  13.  
  14. ' 2021-02-21 Eval from SB1 same date, err message in EvalW sub
  15. ' this has Split with option and acumulates Err$ =Err$ + Chr$(10) + "New Error:  description""
  16. ' How long does it take to run down the checklist here? 2PM start post at 2:55 PM < Hour
  17. ' slowed up by getting X back in for checking variable substitutions.
  18.  
  19. '
  20. CONST XMAX = 1200
  21. CONST YMAX = 720
  22.  
  23. SCREEN _NEWIMAGE(XMAX, YMAX, 32)
  24.  
  25. debug = -1
  26.  
  27. 'evaluate$ and evalW setup
  28. DIM SHARED DFlag AS _BIT, Err$, X AS _FLOAT, RAD AS _FLOAT, DEG AS _FLOAT
  29. DFlag = -1
  30. Err$ = ""
  31. X = 5 'changeable  '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>  > might want to remove this in app see Evaulate$
  32. RAD = _PI / 180.0
  33. DEG = 180 / _PI
  34. REDIM SHARED fList(1 TO 1) AS STRING
  35. Split "int, sin, cos, tan, asin, acos, atan, log, exp, sqr, rad, deg, not", ", ", fList(), 0 ' add not function here
  36. REDIM SHARED oList(1 TO 1) AS STRING
  37. Split "^, %, /, *, -, +, =, <, >, <=, >=, <>, or, and", ", ", oList(), 0 ' not is NOT a Binary Op
  38.  
  39. 'main dim
  40. DIM e$, r$
  41. '  tests
  42.  
  43. e$ = "PI" ' ok caps or not
  44. e$ = "pi" 'ok
  45. e$ = "1 +1"
  46. e$ = "-1+1" 'ok     checking the infamous minus sign doing double duty of neg number or subtraction
  47. e$ = "(5 - 7) * 2" '-4 ok
  48. e$ = "(5-7)* 2" '-4 ok
  49. e$ = "(-5--7)*2" '4 ok
  50. e$ = "2*(-5-7)" ' -24  ok
  51. e$ = "(-1--2)+(-3--4)" ' 2 ok 1 + 1
  52. e$ = "x*x-2*x-3" ' x = 5 returns 12
  53.  
  54. ' new not tests
  55. e$ = "not-1" ' Wrong! syntax returns -1  but no error thrown
  56. e$ = "not(-1)" ' fixed
  57. e$ = "not(-1 or -1)" ' 0 ok fixed
  58. e$ = "not(0)" ' -1 yeah good
  59. e$ = "not(-8)"
  60. e$ = "not (-1)" '  wrong syntax but this works????  because ( and ) can be wrapped in spaces
  61. e$ = "not (0)" ' wrong syntax  but works???  it's because of way ( ) can be spaced or not
  62. e$ = "-1 not" ' wrong syntax crash bang boom but the line is soooo wrong , no error
  63.  
  64. e$ = "-1 or 0" 'OK
  65. e$ = "log(0)" 'err   new error message shows now 2021-02-21
  66. e$ = "log(2)" 'see next close!!!
  67. e$ = "exp(.69314718055)" 'inverse above  close enough
  68. e$ = "exp(-745) " '-745 no err! -746 err!
  69. e$ = "exp(-693) " ' FB -693 limit 1.0812... E-301 bottom limit no error on my system, -708 on another test
  70. e$ = "exp( 709) " ' no err , FB 707 limit 8.21840... E+307no error on my system
  71. e$ = "sqr(-10)" 'err
  72. e$ = "-5 ^ 1.9" 'err good get err message
  73. e$ = "2*-3--4+-0.25" ' returns -2.25 OK don't need to isolate - meant for subtraction !!! <<<<<<<<<<<<<<<<<<<<< see fixed 2021-02-15
  74. e$ = "1+2*(3+((4*5)+(6*7*8))-9)/10" ' returns 71 OK  OK fixed!
  75. e$ = " 1+2*(3-2*(3-2)*((2-4)*5-22/(7+2*(3-1))-1))+1" ' returns 60 OK
  76. 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"
  77. '' 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!!!
  78. e$ = "(1.4 + 2^(19%4))/2" ' = 4.7 OK OK
  79. e$ = "e^2" ' = 7.3890...
  80. e$ = "PI/6" '= .52...
  81. e$ = "x ^ (200/400)" ' = 2.23606... when sqr(x) x = 5
  82. e$ = "x^2-2*x-15" ' = 0 when x = 5 good!
  83. e$ = "e^ 8" ' > 2980.9594...
  84. e$ = " log(2980.9594)" ' > 8.000..
  85. e$ = "sin(x)^2 + cos(x)^2" ' > ~1
  86. e$ = "atan(1)" 'should be 45 degrees if degrees flag on nope, correct in radians  fixed  2021-02-15
  87. e$ = "atan(sin(30)/cos(30))" ' > 30 with DFlag = 1   2021-02-15 eeeh no? fixed  2021-02-15
  88. e$ = ".3 + 2*10^-8" ' .30000002
  89. e$ = "pi/6 < pi" ' -1 of course yeah my first Boolean!
  90. e$ = "99 % 11 = 0"
  91. e$ = "23 <= 22" ' 0?   of course!
  92. e$ = "(99 % 9 = 0) and (not (  (23 < 22) or (5 < 3)  )) " ' (0) and ( not ((0) or (0) ) )  the first part is -1 so 0! 2nd part -1 so -1 and -1 = -1 ok!
  93.  
  94. ' main after setting e$ ======================================================================  main
  95. r$ = Evaluate$(e$)
  96. IF Err$ <> "" THEN PRINT "Error: "; Err$ ELSE PRINT "Expression = "; r$
  97. PRINT "Done"
  98. ' ============================================================================================ main end
  99.  
  100. 'this preps e$ string for actual evaluation function and makes call to it,
  101. 'checks results for error returns that or string form of result calculation
  102. 'the new goal is to do string functions along side math
  103. FUNCTION Evaluate$ (e$)
  104.     DIM b$, c$, w$
  105.     DIM i AS INTEGER, po AS INTEGER
  106.     ' isolateNeg = 0
  107.     b$ = "" 'rebuild string with padded spaces
  108.     'this makes sure ( ) + * / % ^ are wrapped with spaces, on your own with - sign
  109.     FOR i = 1 TO LEN(e$) 'filter chars and count ()
  110.         c$ = LCASE$(MID$(e$, i, 1))
  111.         IF c$ = ")" THEN
  112.             po = po - 1: b$ = b$ + " ) "
  113.         ELSEIF c$ = "(" THEN
  114.             po = po + 1: b$ = b$ + " ( "
  115.         ELSEIF INSTR("+*/%^", c$) > 0 THEN
  116.             b$ = b$ + " " + c$ + " "
  117.         ELSEIF c$ = "-" THEN
  118.             IF LEN(b$) > 0 THEN
  119.                 IF INSTR(".0123456789abcdefghijklmnopqrstuvwxyz)", RIGHT$(RTRIM$(b$), 1)) > 0 THEN
  120.                     b$ = b$ + " " + c$ + " "
  121.                 ELSE
  122.                     b$ = b$ + " " + c$
  123.                 END IF
  124.             ELSE
  125.                 b$ = b$ + " " + c$
  126.             END IF
  127.         ELSEIF INSTR(" .0123456789abcdefghijklmnopqrstuvwxyz<>=", c$) > 0 THEN
  128.             b$ = b$ + c$
  129.         END IF
  130.         IF po < 0 THEN Err$ = Err$ + CHR$(10) + "Evaluate$ Error: Too many ) ": EXIT FUNCTION
  131.     NEXT
  132.     IF po <> 0 THEN Err$ = Err$ + CHR$(10) + "Evaluate$ Error: Unbalanced () ": EXIT FUNCTION
  133.     REDIM ev(1 TO 1) AS STRING
  134.     Split b$, " ", ev(), -1
  135.     FOR i = LBOUND(ev) TO UBOUND(ev) 'subst constants
  136.         IF ev(i) = "pi" THEN
  137.             ev(i) = LTRIM$(STR$(_PI))
  138.         ELSEIF ev(i) = "e" THEN
  139.             ev(i) = LTRIM$(STR$(EXP(1)))
  140.         ELSEIF ev(i) = "rnd" THEN
  141.             RANDOMIZE TIMER
  142.             ev(i) = LTRIM$(STR$(RND))
  143.         ELSEIF ev(i) = "x" THEN ' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> This plugged back in from SB1 transplant
  144.             ev(i) = _TRIM$(STR$(X))
  145.         END IF
  146.     NEXT
  147.     c$ = evalW$(ev())
  148.     IF Err$ <> "" THEN Evaluate$ = Err$ ELSE Evaluate$ = c$
  149.     IF debug THEN
  150.         PRINT "Evaluate$ is returning:";
  151.         IF Err$ <> "" THEN PRINT "Eval Error: "; Err$ ELSE PRINT " Value *" + c$ + "*"
  152.         INPUT "Enter to continue..."; w$
  153.     END IF
  154.  
  155. ' the recursive part of EVAL
  156. FUNCTION evalW$ (a() AS STRING)
  157.     IF Err$ <> "" THEN EXIT FUNCTION
  158.  
  159.     DIM fun$, test$, innerV$, m$, op$
  160.     DIM pop AS INTEGER, lPlace AS INTEGER, i AS INTEGER, rPlace AS INTEGER
  161.     DIM po AS INTEGER, p AS INTEGER, o AS INTEGER, index AS INTEGER
  162.     DIM recurs AS INTEGER
  163.     DIM innerVal AS _FLOAT, a AS _FLOAT, b AS _FLOAT
  164.     IF debug THEN
  165.         PRINT "evalW rec'd a() as:"
  166.         FOR i = LBOUND(a) TO UBOUND(a)
  167.             PRINT a(i); ", ";
  168.         NEXT
  169.         PRINT: INPUT "OK enter"; test$: PRINT
  170.     END IF
  171.     pop = find%(a(), "(") 'parenthesis open place
  172.     WHILE pop > 0
  173.         IF pop = 1 THEN
  174.             fun$ = "": lPlace = 1
  175.         ELSE
  176.             test$ = a(pop - 1)
  177.             IF find%(fList(), test$) > 0 THEN
  178.                 fun$ = test$: lPlace = pop - 1
  179.             ELSE
  180.                 fun$ = "": lPlace = pop
  181.             END IF
  182.         END IF
  183.         po = 1
  184.         FOR i = pop + 1 TO UBOUND(a)
  185.             IF a(i) = "(" THEN po = po + 1
  186.             IF a(i) = ")" THEN po = po - 1
  187.             IF po = 0 THEN rPlace = i: EXIT FOR
  188.         NEXT
  189.         REDIM inner(1 TO 1) AS STRING: index = 0: recurs = 0
  190.         FOR i = (pop + 1) TO (rPlace - 1)
  191.             index = index + 1
  192.             REDIM _PRESERVE inner(1 TO index) AS STRING
  193.             inner(index) = a(i)
  194.             IF find%(oList(), a(i)) > 0 THEN recurs = -1
  195.         NEXT
  196.         IF recurs THEN innerV$ = evalW$(inner()) ELSE innerV$ = a(pop + 1)
  197.         innerVal = VAL(innerV$)
  198.  
  199.         SELECT CASE fun$
  200.             CASE "": m$ = innerV$
  201.             CASE "int": m$ = ls$(INT(innerVal))
  202.             CASE "not": IF INT(innerVal) = 0 THEN m$ = "-1" ELSE m$ = "0"
  203.             CASE "sin": IF DFlag THEN m$ = ls$(SIN(RAD * innerVal)) ELSE m$ = ls$(SIN(innerVal))
  204.             CASE "cos": IF DFlag THEN m$ = ls$(COS(RAD * innerVal)) ELSE m$ = ls$(COS(innerVal))
  205.             CASE "tan": IF DFlag THEN m$ = ls$(TAN(RAD * innerVal)) ELSE m$ = ls$(TAN(innerVal))
  206.             CASE "asin": IF DFlag THEN m$ = ls$(_ASIN(RAD * innerVal)) ELSE m$ = ls$(_ASIN(innerVal))
  207.             CASE "acos": IF DFlag THEN m$ = ls$(_ACOS(RAD * innerVal)) ELSE m$ = ls$(_ACOS(innerVal))
  208.             CASE "atan": IF DFlag THEN m$ = ls$((DEG * ATN(innerVal))) ELSE m$ = ls$(ATN(innerVal))
  209.             CASE "log"
  210.                 IF innerVal > 0 THEN
  211.                     m$ = ls$(LOG(innerVal))
  212.                 ELSE
  213.                     Err$ = Err$ + CHR$(10) + "EvalW error: LOG only works on numbers > 0.": EXIT FUNCTION
  214.                 END IF
  215.             CASE "exp" 'the error limit is inconsistent in JB
  216.                 IF -745 <= innerVal AND innerVal <= 709 THEN 'your system may have different results
  217.                     m$ = ls$(EXP(innerVal))
  218.                 ELSE
  219.                     'what the heck???? 708 works fine all alone as limit ?????
  220.                     Err$ = Err$ + CHR$(10) + "EvalW error: EXP(n) only works for n = -745 to 709.": EXIT FUNCTION
  221.                 END IF
  222.             CASE "sqr"
  223.                 IF innerVal >= 0 THEN
  224.                     m$ = ls$(SQR(innerVal))
  225.                 ELSE
  226.                     Err$ = Err$ + CHR$(10) + "EvalW error: SQR only works for numbers >= 0.": EXIT FUNCTION
  227.                 END IF
  228.             CASE "rad": m$ = ls$(innerVal * RAD)
  229.             CASE "deg": m$ = ls$(innerVal * DEG)
  230.             CASE ELSE: Err$ = Err$ + CHR$(10) + "EvalW error: Unidentified function " + fun$: EXIT FUNCTION
  231.         END SELECT
  232.         IF debug THEN
  233.             PRINT "lPlace, rPlace"; lPlace, rPlace
  234.         END IF
  235.         arrSubst a(), lPlace, rPlace, m$
  236.         IF debug THEN
  237.             PRINT "After arrSubst a() is:"
  238.             FOR i = LBOUND(a) TO UBOUND(a)
  239.                 PRINT a(i); " ";
  240.             NEXT
  241.             PRINT: PRINT
  242.         END IF
  243.         pop = find%(a(), "(")
  244.     WEND
  245.  
  246.     'all parenthesis cleared
  247.     'ops$ = "% ^ / * + - = < > <= >= <> and or not" 'all () cleared, now for binary ops (not not binary but is last!)
  248.     FOR o = 1 TO UBOUND(oList)
  249.         op$ = oList(o)
  250.         p = find%(a(), op$)
  251.         WHILE p > 0
  252.             ' 2021-02-21 added this error catcher doesn't help much but stops QB64 from throwing it's own
  253.             ' This one might be more helpful in tracking down cause and fixing.
  254.             IF p - 1 >= LBOUND(a) AND p + 1 <= UBOUND(a) THEN
  255.                 a = VAL(a(p - 1))
  256.                 b = VAL(a(p + 1))
  257.                 IF debug THEN
  258.                     PRINT STR$(a) + op$ + STR$(b)
  259.                 END IF
  260.             ELSE ' going to err out$
  261.                 Err$ = Err$ + CHR$(10) + "EvalW error: in binary ops, missing a or b value."
  262.                 EXIT SUB
  263.             END IF
  264.             SELECT CASE op$
  265.                 CASE "%"
  266.                     IF b >= 2 THEN
  267.                         m$ = ls$(INT(a) MOD INT(b))
  268.                     ELSE
  269.                         Err$ = Err$ + CHR$(10) + "EvalW error: For a Mod b, b value < 2."
  270.                         EXIT FUNCTION
  271.                     END IF
  272.                 CASE "^"
  273.                     IF INT(b) = b OR a >= 0 THEN
  274.                         m$ = ls$(a ^ b)
  275.                     ELSE
  276.                         Err$ = Err$ + CHR$(10) + "EvalW error: For a ^ b, a needs to be >= 0 when b not integer."
  277.                         EXIT FUNCTION
  278.                     END IF
  279.                 CASE "/"
  280.                     IF b <> 0 THEN
  281.                         m$ = ls$(a / b)
  282.                     ELSE
  283.                         Err$ = Err$ + CHR$(10) + "EvalW error: Div by 0"
  284.                         EXIT FUNCTION
  285.                     END IF
  286.                 CASE "*": m$ = ls$(a * b)
  287.                 CASE "-": m$ = ls$(a - b)
  288.                 CASE "+": m$ = ls$(a + b)
  289.                 CASE "=": IF a = b THEN m$ = "-1" ELSE m$ = "0"
  290.                 CASE "<": IF a < b THEN m$ = "-1" ELSE m$ = "0"
  291.                 CASE ">": IF a > b THEN m$ = "-1" ELSE m$ = "0"
  292.                 CASE "<=": IF a <= b THEN m$ = "-1" ELSE m$ = "0"
  293.                 CASE ">=": IF a >= b THEN m$ = "-1" ELSE m$ = "0"
  294.                 CASE "<>": IF a <> b THEN m$ = "-1" ELSE m$ = "0"
  295.                 CASE "and": IF a <> 0 AND b <> 0 THEN m$ = "-1" ELSE m$ = "0"
  296.                 CASE "or": IF a <> 0 OR b <> 0 THEN m$ = "-1" ELSE m$ = "0"
  297.                     ' This is NOT a Binary Op!!
  298.                     'Case "not": If b = 0 Then m$ = ls$(-1) Else m$ = ls$(0) 'use b as nothing should be left of not
  299.             END SELECT
  300.             arrSubst a(), p - 1, p + 1, m$
  301.  
  302.             IF debug THEN
  303.                 PRINT "a() reloaded after " + op$ + " as:"
  304.                 FOR i = LBOUND(a) TO UBOUND(a)
  305.                     PRINT a(i); ", ";
  306.                 NEXT
  307.                 PRINT: PRINT
  308.             END IF
  309.  
  310.             p = find%(a(), op$)
  311.         WEND
  312.     NEXT
  313.     fun$ = ""
  314.     FOR i = LBOUND(a) TO UBOUND(a)
  315.         fun$ = fun$ + " " + a(i)
  316.     NEXT
  317.     evalW$ = LTRIM$(fun$)
  318.  
  319. 'notes: Modified Split for Evaluate to share with other purpose apps,
  320. ' ie swith option to trim spaces to 1, mod made 2021 Feb for SB1 Interpreter
  321. SUB Split (Mystr AS STRING, Delim AS STRING, Arr() AS STRING, DropExtraSpacesTF AS LONG)
  322.     ' bplus modifications of Galleon fix of Bulrush Split reply #13
  323.     ' http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index.php?topic=1612.0
  324.     ' this sub further developed and tested here: \test\Strings\Split test.bas
  325.     ' 2018-09-16 modified for base 1 arrays
  326.     DIM copy AS STRING, p AS LONG, curpos AS LONG, arrpos AS LONG, lc AS LONG, dpos AS LONG
  327.     copy = Mystr 'make copy since we are messing with mystr
  328.  
  329.     'special case if delim is space, probably want to remove all excess space
  330.     IF DropExtraSpacesTF THEN
  331.         IF Delim = " " THEN
  332.             copy = _TRIM$(copy) '2021-2-16 change from ltrim and rtrim
  333.             p = INSTR(copy, "  ")
  334.             WHILE p > 0
  335.                 copy = MID$(copy, 1, p - 1) + MID$(copy, p + 1)
  336.                 p = INSTR(copy, "  ")
  337.             WEND
  338.         END IF
  339.     END IF
  340.  
  341.     REDIM Arr(1 TO 1) 'clear it
  342.     curpos = 1
  343.     arrpos = 1
  344.     lc = LEN(copy)
  345.     dpos = INSTR(curpos, copy, Delim)
  346.     DO UNTIL dpos = 0
  347.         Arr(arrpos) = MID$(copy, curpos, dpos - curpos)
  348.         arrpos = arrpos + 1
  349.         REDIM _PRESERVE Arr(1 TO arrpos + 1) AS STRING
  350.         curpos = dpos + LEN(Delim)
  351.         dpos = INSTR(curpos, copy, Delim)
  352.     LOOP
  353.     Arr(arrpos) = MID$(copy, curpos)
  354.     REDIM _PRESERVE Arr(1 TO arrpos) AS STRING
  355.  
  356. 'for eval
  357. SUB arrSubst (a() AS STRING, substLow AS LONG, substHigh AS LONG, subst AS STRING)
  358.     DIM i AS LONG, index AS LONG
  359.     a(substLow) = subst: index = substLow + 1
  360.     FOR i = substHigh + 1 TO UBOUND(a)
  361.         a(index) = a(i): index = index + 1
  362.     NEXT
  363.     REDIM _PRESERVE a(LBOUND(a) TO UBOUND(a) + substLow - substHigh)
  364.  
  365. 'for eval
  366. FUNCTION find% (a() AS STRING, s$)
  367.     DIM i%
  368.     FOR i% = LBOUND(a) TO UBOUND(a)
  369.         IF a(i%) = s$ THEN find% = i%: EXIT FUNCTION
  370.     NEXT
  371.  
  372. 'ltrim a number float  for eval double to string
  373.     ls$ = LTRIM$(STR$(n))
  374.  
  375.  
« Last Edit: February 21, 2021, 02:51:46 pm by bplus »

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: EVAL Function - NOT Boolean evaluation is fixed
« Reply #4 on: February 22, 2021, 02:24:10 pm »
Now can we get String functions into this? No probably NOT.

That hypothesis made, let me or someone else defeat it!

String functions have to be handled first with all the spaces and other parsing delimiters that they may contain.

Only want to forbid one char ; semi-colon from strings for arguments delimiter, this is after some:
var $= argsList$

var = no spaces inside when trimmed

space $= space is first parser to variable Name on left argList$ on right containing its future assigned value
 this would distinguish from command for numeric space = space for var = evaluate$(this expression on the right)

argList$ split by ; is 2nd parsing into a(1 to n) arg strings$

eh maybe too simple to split by ; except works great in SB1 Interpreter. But if want to have functions inside functions parsing by anything is going to split it up wrongly, so the argList$ is going to have to be analysed like evaluate 2nd part does by searching for deepest level () doing that and working up until no () left. Only not parenthesis since numeric evaluate uses that, maybe [ ] or {}'s...

Could do it like Python with no endings first in left is last processed, first processed is farthest right 
FILO First in, Last Out
that would be like a stack too.

var $= funN(... ; (funN-1(... ; ( funN-2(... ; ...;  fun1(literal or var)

I swear we are on the edge of magic with the task of demystifying it.



« Last Edit: February 22, 2021, 02:37:49 pm by bplus »

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: EVAL Function
« Reply #5 on: March 02, 2021, 03:09:34 pm »
what do you think qm.

should we shake things up a bit by changing all symbols that require two hands to type to one-handed ones.
ok to use more than a single letter, i see, because ops list has 'and' and 'not'.

can it be done qm.

Yes but the problem is going to be variable names conflicting with operator names. Using symbols prevents such accidental name / value substitutions.

Solution options?

+ Force variable declarations by starting all of them with a v for variable, in fact this may be a way to allow spaces in variable names? Start with v end with z, sounds like more typing not less.

+ Force dot or / before operators so they are recognized as such. Nope. No way!

v starts a one word variable name a space ends it. Actually that might help process a code line.

Nah I am not messing with the right side of =.

« Last Edit: March 02, 2021, 03:49:31 pm by bplus »

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: EVAL Function
« Reply #6 on: March 03, 2021, 10:24:53 am »
Quote
Yes but the problem is going to be variable names conflicting with operator names. Using symbols prevents such accidental name / value substitutions.

Maybe not, depends what level the subst's take place, usually way before eval is called so its all numbers and some function names. The function names all end with (   Open Patrenthesis or op for short or one handed typists.

a for add
s for subtract
m for mult
d for divide
r for modlulus AKA Remainder
p for power

1 a 1 = 2
2 m 12 = 24
-3 d -4 = .75
17 r 5 = 2
I can do it so a cinch for computer.

Yes for SB3 after SB2 super Eval working.

Still conflict with variables one letter long so short hand goal conflicts with one handed typing goal.

« Last Edit: March 03, 2021, 10:52:34 am by bplus »