Whats More Flexible Than An Overloaded Routine?

Code: (Select All)
Option _Explicit

_Title "Eval_Overload test" ' bplus revisit 2023-11-13 qB64pe v3.8

' 2023-11-13 dust off and cleanup this masterpiece



' original notes:

' testing with QB64 X 64 version 1.2 20180228/86  from git b301f92



'Overload test eval.bas B+ 2018-08-25 started

' modify Split for special case of spaces to be used as delimiter for overloaded p$ = parameter string



' note: for ease of coding ~ is used for subtraction sign

' and normal - is reserved to indicate a negative number.



Const WW = 800

Const WH = 600

Screen _NewImage(WW, WH, 32)

_ScreenMove 250, 60



Dim test$(1 To 5), i

test$(1) = "seven=7 eval>seven*10~7" ' < this is 7*10-7 = 63

test$(2) = "A=2 b=3 C=5 x=10 eval>a*X^2+B*x~c" ' 225

test$(3) = "eval>able*x^2+baker*x~charlie able=2 baker=2.99 charlie=5 x=10" ' 224.9

test$(4) = "seven=7" ' error no EVAL>

test$(5) = "eval>able*x^2+baker*x~charlie able=2 charlie=5 x=10" ' error missing baker



For i = 1 To 5

    Print "For: " + Chr$(34) + test$(i) + Chr$(34)

    Eval_Overload test$(i)

    Print "Eval_Overload returned: "; test$(i)

    Print

Next



Sub Eval_Overload (PL As String)

    ' PL comes in as parameters list, goes out like a function's return value

    ' (but in string form of course), so make copy of PL if you think you will need

    ' later. PS This is not overloading so much as it is Parsing the Argument String, PL,

    ' in my opinion making it even more fexible than Overloaded routine.



    ' Note: PL is space delimited like words in a sentence.

    ' The expression to Evaluate must be written to right of Eval> eg, Eval>expression

    ' No spaces! in this "word". For all variables used in the expression create

    ' VariableName=Value "words".



    ' While this EVAL function does not do parenthesis it does do operations

    ' in the following order:  %^/*~+   % is for modulus, ~ is for subtraction.

    '

    ' This Sub requires 2 Functions and a Sub:

    ' 1. Function leftOf$ (source$, of$)

    ' 2. Function rightOf$ (source$, of$)

    ' 1. Sub Split (SplitMeString As String, delim As String, LoadMe() As String)



    Dim pList$(0) ' <<< NOT REDIM???? split did not squawk about trying to redim this???

    Dim As Long i, L, R, found, hit

    Dim As Long found2, j, place, vl, vr

    Dim p$, this$, b$, wd$, op$, lb$, rb$, head$, tail$, M$

    p$ = UCase$(PL)

    Split p$, " ", pList$()

    For i = 0 To UBound(pList$) 'find eval

        If InStr(pList$(i), "EVAL>") Then

            this$ = rightOf$(pList$(i), "EVAL>"): found = 1: Exit For

        End If

    Next

    If found = 0 Or this$ = "" Then

        PL = "ERROR: Did not find eval or what to eval.": Exit Sub

    End If

    b$ = ""

    For i = 1 To Len(this$) 'do substitutions

        wd$ = ""

        hit = 0

        While InStr("ABCDEFGHIJKLMNOPQRSTUVWXYZ", Mid$(this$, i, 1)) And i <= Len(this$)

            hit = 1

            wd$ = wd$ + Mid$(this$, i, 1)

            i = i + 1

        Wend

        If hit Then i = i - 1

        If wd$ <> "" Then

            found2 = 0

            For j = 0 To UBound(pList$) 'find eval

                If leftOf$(pList$(j), "=") = wd$ Then

                    b$ = b$ + rightOf$(pList$(j), "="): found2 = 1: Exit For

                End If

            Next

            If found2 = 0 Then

                PL = "ERROR: Did not find variable, " + Chr$(34) + wd$ + Chr$(34) + ", in paramters list."

                Exit Sub

            End If

        Else

            b$ = b$ + Mid$(this$, i, 1)

        End If

    Next



    For j = 1 To 6

        op$ = Mid$("%^/*~+", j, 1) 'notice the strange sign for minus,

        ' it is to distinguish a neg number from subtraction op

        While InStr(b$, op$)

            place = InStr(b$, op$)

            L = place - 1: R = place + 1: lb$ = "": rb$ = ""

            While InStr("1234567890-.", Mid$(b$, L, 1)) And L >= 1

                lb$ = Mid$(b$, L, 1) + lb$

                L = L - 1

            Wend

            R = place + 1

            While InStr("1234567890-.", Mid$(b$, R, 1)) And R <= Len(b$)

                rb$ = rb$ + Mid$(b$, R, 1)

                R = R + 1

            Wend

            vl = Val(lb$): vr = Val(rb$)

            head$ = Mid$(b$, 1, L): tail$ = Mid$(b$, R)

            Select Case op$

                Case "%": M$ = LTrim$(Str$(Val(lb$) Mod Val(rb$)))

                Case "^": M$ = LTrim$(Str$(Val(lb$) ^ Val(rb$)))

                Case "/": M$ = LTrim$(Str$(Val(lb$) / Val(rb$)))

                Case "*": M$ = LTrim$(Str$(Val(lb$) * Val(rb$)))

                Case "~": M$ = LTrim$(Str$(Val(lb$) - Val(rb$)))

                Case "+": M$ = LTrim$(Str$(Val(lb$) + Val(rb$)))

            End Select

            b$ = head$ + M$ + tail$

        Wend 'while op instr

    Next



    'return PL with the evaluation substituted back into PL

    PL = b$

End Sub



Function leftOf$ (source$, of$)

    Dim As Long posOf

    posOf = InStr(source$, of$)

    If posOf > 0 Then leftOf$ = Mid$(source$, 1, posOf - 1)

End Function



Function rightOf$ (source$, of$)

    Dim As Long posOf

    posOf = InStr(source$, of$)

    If posOf > 0 Then rightOf$ = Mid$(source$, posOf + Len(of$))

End Function



' using updated split

Sub Split (SplitMeString As String, delim As String, LoadMe() As String)

    Dim curpos As Long, arrpos As Long, LD As Long, dpos As Long 'fix use the Lbound the array already has

    curpos = 1: arrpos = LBound(LoadMe): LD = Len(delim)

    dpos = InStr(curpos, SplitMeString, delim)

    Do Until dpos = 0

        LoadMe(arrpos) = Mid$(SplitMeString, curpos, dpos - curpos)

        arrpos = arrpos + 1

        If arrpos > UBound(LoadMe) Then

            ReDim _Preserve LoadMe(LBound(LoadMe) To UBound(LoadMe) + 1000) As String

        End If

        curpos = dpos + LD

        dpos = InStr(curpos, SplitMeString, delim)

    Loop

    LoadMe(arrpos) = Mid$(SplitMeString, curpos)

    ReDim _Preserve LoadMe(LBound(LoadMe) To arrpos) As String 'get the ubound correct

End Sub