an "overloaded subroutine" example

[James D Jarvis]

an example of a means to have overloaed subroutines or at least subroutines with a varying range of variables. 
it makes use of a modified version of splitstring that someone else developed that allows the variables to be broken down in the subroutine.

Code: (Select All)

'an example of an overloaded subroutine in QB64

'

'more acurately an example of passing a different range of variables to a sub

'and gettign a different range of results based on those arguments

'

'$Dynamic

Screen _NewImage(500, 240, 256)

Dim Shared klr

Locate 1, 1: Print "A dot      (press Any key) "

overload_example "12"

overload_example "100,100"

Sleep

Locate 1, 1: Print "                            "

Locate 1, 1: Print "Amother dot (press Any key) "

overload_example "50,50,14"

Sleep

Locate 1, 1: Print "                            "

Locate 1, 1: Print "A Filled Box (press Any key)"



overload_example "50,50,100,100,10"

Sleep

Locate 1, 1: Print "                            "

Locate 1, 1: Print "Outlined that box "



overload_example "50,50,100,100"

Sleep

Cls

Locate 1, 1: Print "                            "

Locate 1, 1: Print "The code is an example of passing numerical variables "

overload_example "30,30,110,110,2"

For x = 10 To 40 Step 5

    A$ = _Trim$(Str$(70 - x))

    B$ = _Trim$(Str$(x + 70))

    overload_example A$ + "," + A$ + "," + B$ + "," + B$

Next x



End



' overload_example'

'takesa string with a set of arguments delimited by a comma

'if there is one argument the default color is set

'if there are 2 arguments a pixel is drawn in the deafult color with pset

'if there are 3 arguments a pixel is drawn in a temporary color but the default is not changed

'if there are 4 arguments a Box is drawn  the default color

'if there are 5 arguments a Filled Box is drawn  the temporary color



Sub overload_example (argument$)

    Dim argu$(0)

    SplitString argument$, ",", argu$()

    a_count = UBound(argu$)

    Select Case a_count

        Case 1 'set the defined color for follwoign statements

            klr = Val(argu$(1))

        Case 2 'pset in defined color

            x0 = Val(argu$(1))

            y0 = Val(argu$(2))

            PSet (x0, y0), klr

        Case 3 'pset in temporary color

            x0 = Val(argu$(1))

            y0 = Val(argu$(2))

            tklr = Val(argu$(3))

            PSet (x0, y0), tklr

        Case 4 'draw a box in defined color

            x0 = Val(argu$(1))

            y0 = Val(argu$(2))

            x1 = Val(argu$(3))

            y1 = Val(argu$(4))

            Line (x0, y0)-(x1, y1), klr, B

        Case 5 'draw a filled in temporary color

            x0 = Val(argu$(1))

            y0 = Val(argu$(2))

            x1 = Val(argu$(3))

            y1 = Val(argu$(4))

            tklr = Val(argu$(5))

            Line (x0, y0)-(x1, y1), tklr, BF

    End Select

End Sub

Sub SplitString (inputString$, delimiter$, wordArray$())

    'make sure you have dynamic arrays set up

    wordCount% = 0

    startPos% = 1

    Do

        psn% = InStr(startPos%, inputString$, delimiter$) ' Find the next delimiter

        If psn% = 0 Then

            ' No more delimiters found, this is the last word

            word$ = Mid$(inputString$, startPos%)

            If Len(_Trim$(word$)) > 0 Then ' Check for empty word (e.g., multiple spaces)

                wordCount% = wordCount% + 1

                ReDim _Preserve wordArray$(wordCount%)

                wordArray$(wordCount%) = word$

            End If

            Exit Do ' Exit the loop

        Else

            ' Delimiter found, extract the word

            word$ = Mid$(inputString$, startPos%, psn% - startPos%)

            If Len(_Trim$(word$)) > 0 Then ' Check for empty word (e.g., multiple spaces)

                wordCount% = wordCount% + 1

                ReDim _Preserve wordArray$(wordCount%)

                wordArray$(wordCount%) = word$

            End If

            startPos% = psn% + Len(delimiter$) ' Move the starting position past the delimiter

        End If

    Loop

End Sub

[bplus]

Here I used "overloading" to create primative math evaluator, set variables and run formulas or functions like a*x^2 + b*x + c the quadratic equation.

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

[RhoSigma]

That's all no overloading, as overloading is the ability to define subs or functions with the same NAME but DIFFERENT arguments or results and the compiler picks the right routine at compile time based on the given arguments.

That's not possible in QB64, as the compiler would immediately complain about duplicate names when you try to use the same sub/function name for more than one routine.

All you guys did, and as also I do in the GuiTools Framework with my TagString API, is to make ONE smart routine which is able to handle a bunch of different arguments given as a delimited string. That works, but that is NO overloading.

[bplus]

It is as close as you're going to get to "Overloading" in QB64 and it is what PL's do to reading and reducing code down from strings of text. We just have to do it manually in QB64.

Notice we both put "Overloading" in quotes.

Dont be Mr Grouch It's a cool programming thing like recursion.

[SMcNeill]

My new way of doing something similar to this is to break down what I need into sub-functions with a .DESCRIPTOR to them.

Such as I write a long arse routine for an expansive box routine.

SUB Box (x, y, wide, tall, caption$, xOffset, yOffset,Kolor, BGkolor... a zillion more parameters.)

Now that's a LOT to keep up with and deal with and many of those params I won't ever need, so I write a dozen sub-subs to call that sub for me.

SUB Box.AutoSize (x, y, caption$)
'this now calculates the width and height of the caption, the width/height of my border needed.  It sets color and background color to the default values.  And then it does:
    BOX (x, y, wide, tall, caption$, XOffset... a zillion more parameters with what it filled in for me.
END SUB

I'll have a half dozen or more BOX commands, but almost like OOP, I design them with .DESCRIPTORS so I only have to pass the parameters to them that I want.  It's not *true* overloading as Rho mentions, as that would generate errors, but it's about as close as we're going to get with optional parameters anytime soon.  Just make the main routine with the bazillion options first and then the sub-wrappers with only the relevant needed parameters with a DOT-NAME.

It's a practice I've started to adopt here lately and it's helping me organize my thoughts and routines quite nicely.  It may be something else which others can learn to adapt to as well, so I just thought I'd share.  Whatever works for you... That's what works.  This is now my way of finding something new that works for me, and so far it's been working really well. 

[James D Jarvis]

That's all no overloading, as overloading is the ability to define subs or functions with the same NAME but DIFFERENT arguments or results and the compiler picks the right routine at compile time based on the given arguments.

That's not possible in QB64, as the compiler would immediately complain about duplicate names when you try to use the same sub/function name for more than one routine.

All you guys did, and as also I do in the GuiTools Framework with my TagString API, is to make ONE smart routine which is able to handle a bunch of different arguments given as a delimited string. That works, but that is NO overloading.

I hear you. What's that called however? Need a better term for it than "ONE smart routine which is able to handle a bunch of different arguments".  I did put it in " "  because I know I'm fibbing a little.

[James D Jarvis]

Here I used "overloading" to create primative math evaluator, set variables and run formulas or functions like a*x^2 + b*x + c the quadratic equation.

Evaluating strings to run my tinybasic in a sub routines to work as a scripting engine for a more complicated project is what led me to what I posted. But I needed a simple example with relatively clean code instead of the insane mess that I have in the main project to share with others.

[mdijkens]

In most cases I'd prefer separate functions/subs with clear (slightly different) names of what they do

[Jack]

operator and function overloading is very convenient/handy especially if you need/want to do math with complex numbers or with your own arbitrary precision arithmetic

[mdijkens]

operator and function overloading is very convenient/handy especially if you need/want to do math with complex numbers or with your own arbitrary precision arithmetic

Absolutely, I love it... but not like this in QB64