Print Page - Overloaded functions and any arguments

Here is a template to show making a function that can take any number of arguments of ANY KIND. Of course, it really only takes _MEM blocks. However, in doing so, you can perform operations on any variable type rather than limiting to a certain number or a certain type. Attached are the header files you will need.

The bas code:

Code: QB64: [Select]

Option _Explicit
_Title "Overloaded Functions - AS ANY"
Screen _NewImage(640, 480, 32)
_ScreenMove _Middle
 
Dim As _MEM test(1 To 17)
 
Dim As Long longtest: longtest = 435
Dim As Single singletest: singletest = 1.2
Dim As _Float floattest: floattest = 4.65
Dim As String * 21 stringtest: stringtest = "This is a string test"
Dim As _Offset offsettest: offsettest = 1234567
'Dim As Long imagetest: imagetest = _LoadImage(".\face no background.png", 32) 'replace with an image that you have
'Dim As Long soundtest: soundtest = _SndOpen(".\Dalshabet With. Bigtone.mp3") 'replace with a song that you have
Dim As String * 13 stringarraytest(1 To 3)
stringarraytest(1) = "Array test 1"
stringarraytest(2) = "Array test 2"
stringarraytest(3) = "Array test 3"
Dim As _Unsigned _Offset unsignedoffsetarraytest(1 To 2)
unsignedoffsetarraytest(1) = 123456789
unsignedoffsetarraytest(2) = 787970792
Dim As _Unsigned _Offset unsignedoffsettest: unsignedoffsettest = 1234523
Dim As _Float floatarraytest(1 To 3)
floatarraytest(1) = 3.56
floatarraytest(2) = 14.7548
floatarraytest(3) = 56.24124
Dim As Double doublearraytest(1 To 3)
doublearraytest(1) = 1.25
doublearraytest(2) = 2.34
doublearraytest(3) = 5.52
Dim As Single singlearraytest(1 To 3)
singlearraytest(1) = 2.12
singlearraytest(2) = 6.87
singlearraytest(3) = 9.65
Dim As _Unsigned _Byte unsignedbytearraytest(1 To 4)
unsignedbytearraytest(1) = 255
unsignedbytearraytest(2) = 124
unsignedbytearraytest(3) = 98
unsignedbytearraytest(4) = 34
'test(1) = _MemImage(imagetest)
test(2) = _Mem(singletest)
test(3) = _Mem(floattest)
test(4) = _Mem(stringtest)
test(5) = _Mem(offsettest)
test(6) = _Mem(longtest)
Dim As Double doubletest: doubletest = 2.578
test(7) = _Mem(doubletest)
'test(7) = _MemSound(soundtest, 1) 'Left channel
'test(8) = _MemSound(soundtest, 2) 'Right channel
test(9) = _Mem(stringarraytest())
test(10) = _Mem(unsignedoffsetarraytest())
test(11) = _Mem(unsignedoffsettest)
test(12) = _Mem(floatarraytest())
test(13) = _Mem(doublearraytest())
test(14) = _Mem(singlearraytest())
test(15) = _Mem(unsignedbytearraytest())
test(16) = _MemNew(4)
_MemPut test(16), test(16).OFFSET, longtest As LONG
test(17) = _MemNew(14)
_MemPut test(17), test(17).OFFSET, "This is a test"
 
Call anyArg(test())
Dim As _Unsigned Integer x
For x = LBound(test) To UBound(test)
    If _MemExists(test(x)) Then
        _MemFree test(x)
    End If
Next
 
Erase test
 
Sub anyArg (args() As _MEM)
    Dim As _Unsigned Integer x, y
    Dim As _Unsigned _Offset z
    Dim As _Unsigned Long size, elementsize
    For x = LBound(args) To UBound(args)
        If _MemExists(args(x)) Then
            z = 0
            size = Val(Str$(args(x).SIZE))
            elementsize = Val(Str$(args(x).ELEMENTSIZE))
            If _ReadBit(args(x).TYPE, 7) And _ReadBit(args(x).TYPE, 13) = 0 Then '_BYTE, INTEGER, LONG, _INTEGER64
                If _ReadBit(args(x).TYPE, 10) Then
                    If _ReadBit(args(x).TYPE, 16) Then
                        Select Case args(x).ELEMENTSIZE
                            Case 1
                                Dim As _Unsigned _Byte unsignedbytearray(1 To (size / elementsize))
                                For y = LBound(unsignedbytearray) To UBound(unsignedbytearray)
                                    _MemGet args(x), args(x).OFFSET + z, unsignedbytearray(y)
                                    z = z + args(x).ELEMENTSIZE
                                    Print unsignedbytearray(y), "UBYTE ARRAY"
                                Next
                                Exit Select
                            Case 2
                                Dim As _Unsigned Integer unsignedintarray(1 To (size / elementsize))
                                For y = LBound(unsignedintarray) To UBound(unsignedintarray)
                                    _MemGet args(x), args(x).OFFSET + z, unsignedintarray(y)
                                    z = z + args(x).ELEMENTSIZE
                                    Print unsignedintarray(y), "USHORT ARRAY"
                                Next
                                Exit Select
                            Case 4
                                Dim As _Unsigned Long unsignedlongarray(1 To (size / elementsize))
                                For y = LBound(unsignedlongarray) To UBound(unsignedlongarray)
                                    _MemGet args(x), args(x).OFFSET + z, unsignedlongarray(y)
                                    z = z + args(x).ELEMENTSIZE
                                    Print unsignedlongarray(y), "ULONG ARRAY"
                                Next
                                Exit Select
                            Case 8
                                Dim As _Unsigned _Integer64 unsignedint64array(1 To (size / elementsize))
                                For y = LBound(unsignedint64array) To UBound(unsignedint64array)
                                    _MemGet args(x), args(x).OFFSET + z, unsignedint64array(y)
                                    z = z + args(x).ELEMENTSIZE
                                    Print unsignedint64array(y), "UINT64 ARRAY"
                                Next
                                Exit Select
                        End Select
                    Else
                        Select Case args(x).SIZE
                            Case 1
                                Print _MemGet(args(x), args(x).OFFSET, _Unsigned _Byte), "UBYTE"
                                Exit Select
                            Case 2
                                Print _MemGet(args(x), args(x).OFFSET, _Unsigned Integer), "USHORT"
                                Exit Select
                            Case 4
                                Print _MemGet(args(x), args(x).OFFSET, _Unsigned Long), "ULONG"
                                Exit Select
                            Case 8
                                Print _MemGet(args(x), args(x).OFFSET, _Unsigned _Integer64), "UINT64"
                                Exit Select
                        End Select
                    End If
                Else
                    If _ReadBit(args(x).TYPE, 16) Then
                        Select Case args(x).ELEMENTSIZE
                            Case 1
                                Dim As _Byte bytearray(1 To (size / elementsize))
                                For y = LBound(bytearray) To UBound(bytearray)
                                    _MemGet args(x), args(x).OFFSET + z, bytearray(y)
                                    z = z + args(x).ELEMENTSIZE
                                    Print bytearray(y), "BYTE ARRAY"
                                Next
                                Exit Select
                            Case 2
                                Dim As Integer intarray(1 To (size / elementsize))
                                For y = LBound(intarray) To UBound(intarray)
                                    _MemGet args(x), args(x).OFFSET + z, intarray(y)
                                    z = z + args(x).ELEMENTSIZE
                                    Print unsignedintarray(y), "SHORT ARRAY"
                                Next
                                Exit Select
                            Case 4
                                Dim As Long longarray(1 To (size / elementsize))
                                For y = LBound(longarray) To UBound(longarray)
                                    _MemGet args(x), args(x).OFFSET + z, longarray(y)
                                    z = z + args(x).ELEMENTSIZE
                                    Print longarray(y), "LONG ARRAY"
                                Next
                                Exit Select
                            Case 8
                                Dim As _Integer64 int64array(1 To (size / elementsize))
                                For y = LBound(int64array) To UBound(int64array)
                                    _MemGet args(x), args(x).OFFSET + z, int64array(y)
                                    z = z + args(x).ELEMENTSIZE
                                    Print int64array(y), "INT64 ARRAY"
                                Next
                                Exit Select
                        End Select
                    Else
                        Select Case args(x).SIZE
                            Case 1
                                Print _MemGet(args(x), args(x).OFFSET, _Byte), "BYTE"
                                Exit Select
                            Case 2
                                Print _MemGet(args(x), args(x).OFFSET, Integer), "SHORT"
                                Exit Select
                            Case 4
                                Print _MemGet(args(x), args(x).OFFSET, Long), "LONG"
                                Exit Select
                            Case 8
                                Print _MemGet(args(x), args(x).OFFSET, _Integer64), "INT64"
                                Exit Select
                        End Select
                    End If
                End If
            ElseIf _ReadBit(args(x).TYPE, 8) Then 'SINGLE, DOUBLE, FLOAT
                If _ReadBit(args(x).TYPE, 16) Then
                    Select Case args(x).ELEMENTSIZE
                        Case 4
                            Dim As Single singlearray(1 To (size / elementsize))
                            For y = LBound(singlearray) To UBound(singlearray)
                                _MemGet args(x), args(x).OFFSET + z, singlearray(y)
                                z = z + args(x).ELEMENTSIZE
                                Print singlearray(y), "SINGLE ARRAY"
                            Next
                            Exit Select
                        Case 8
                            Dim As Double doublearray(1 To (size / elementsize))
                            For y = LBound(doublearray) To UBound(doublearray)
                                _MemGet args(x), args(x).OFFSET + z, doublearray(y)
                                z = z + args(x).ELEMENTSIZE
                                Print doublearray(y), "DOUBLE ARRAY"
                            Next
                            Exit Select
                        Case 32
                            Dim As _Float floatarray(1 To (size / elementsize))
                            For y = LBound(floatarray) To UBound(floatarray)
                                _MemGet args(x), args(x).OFFSET + z, floatarray(y)
                                z = z + args(x).ELEMENTSIZE / 2
                                Print floatarray(y), "FLOAT ARRAY"
                            Next
                            Exit Select
                    End Select
                Else
                    Select Case args(x).SIZE
                        Case 4
                            Print _MemGet(args(x), args(x).OFFSET, Single), "SINGLE"
                            Exit Select
                        Case 8
                            Print _MemGet(args(x), args(x).OFFSET, Double), "DOUBLE"
                            Exit Select
                        Case 32
                            Print _MemGet(args(x), args(x).OFFSET, _Float), "FLOAT"
                            Exit Select
                    End Select
                End If
            ElseIf _ReadBit(args(x).TYPE, 9) Then 'STRING
                If _ReadBit(args(x).TYPE, 16) Then
                    Dim As String stringarray(1 To (size / elementsize))
                    For y = LBound(stringarray) To UBound(stringarray)
                        stringarray(y) = Space$(args(x).ELEMENTSIZE)
                        _MemGet args(x), (args(x).OFFSET) + (y * args(x).ELEMENTSIZE - args(x).ELEMENTSIZE), stringarray(y)
                        Print stringarray(y), "STRING ARRAY"
                    Next
                Else
                    Dim As String stringtest: stringtest = Space$(args(x).ELEMENTSIZE)
                    _MemGet args(x), args(x).OFFSET, stringtest
                    Print stringtest
                End If
            ElseIf _ReadBit(args(x).TYPE, 13) And _ReadBit(args(x).TYPE, 7) Then '_OFFSET
                If _ReadBit(args(x).TYPE, 10) Then
                    If _ReadBit(args(x).TYPE, 16) Then
                        Dim As _Unsigned _Offset unsignedoffsetarray(1 To (size / elementsize))
                        For y = LBound(unsignedoffsetarray) To UBound(unsignedoffsetarray)
                            _MemGet args(x), args(x).OFFSET + z, unsignedoffsetarray(y)
                            z = z + args(x).ELEMENTSIZE
                            Print unsignedoffsetarray(y), "ULONG_PTR ARRAY"
                        Next
                    Else
                        Print _MemGet(args(x), args(x).OFFSET, _Unsigned _Offset), "ULONG_PTR"
                    End If
                Else
                    If _ReadBit(args(x).TYPE, 16) Then
                        Dim As _Offset offsetarray(1 To (size / elementsize))
                        For y = LBound(offsetarray) To UBound(offsetarray)
                            _MemGet args(x), args(x).OFFSET + z, offsetarray(y)
                            z = z + args(x).ELEMENTSIZE
                            Print unsignedoffsetarray(y), "LONG_PTR ARRAY"
                        Next
                    Else
                        Print _MemGet(args(x), args(x).OFFSET, _Offset), "LONG_PTR"
                    End If
                End If
            ElseIf args(x).TYPE = 0 And args(x).SIZE > 0 Then '_MEMSOUND
                If Not _SndPlaying(args(x).SOUND) Then
                    _SndPlay (args(x).SOUND)
                End If
                Print "SOUND", args(x).SIZE, args(x).ELEMENTSIZE
            ElseIf _ReadBit(args(x).TYPE, 14) Then
                Print args(x).SIZE, "MEM"
                'todo
            End If
            If _ReadBit(args(x).TYPE, 11) Then '_MEMIMAGE
                Screen args(x).IMAGE
            End If
        End If
    Next
End Sub

A screenshot of it working (everything in the image, with the exception of the variable type descriptions, is contained in 1 array):

And a small clip of it running with the sound from the array:

This is still a work in progress so I will update the original post as often as possible with new changes

Mem Sort does this exact same thing: https://www.qb64.org/forum/index.php?topic=1601.0

Pass it a mem block of any type, and it sorts the content of that block. Integer, Long, Double, Fixed-length string... It works with all those types without any issues.

@SMcNeill Neat. I'm just trying to provide a template that will cover as many scenarios as possible. The array contains an image, a song, other arrays of varying types, etc. I had assumed someone else might have used _MEM to do something similar. The whole goal of this is to be a template that is relatively easy to understand and isn't really doing anything with the values. Just providing the framework and proving that the correct branch was taken for the element in the array.

OK I think it is at a good point for people to take it over, now. I've tried covering all cases and it looks like it works. There is a possibility I've missed something but I think I've given a pretty good start to someone who would want to have an absolutely dynamic function.

Well except for the creepy face, I like this stuff! ;-))

I did similar (maybe) with a single string argument some time ago, into which you can set all sorts of variables and formulas to evaluate or another overloaded string from which to draw whole pictures like DRAW only with more "commands" for drawing boxes and circles.

Yeah and next thing you know you have an Interpreter for a whole program string LOL!

@bplus Yep. Slightly similar, with the exception that these are all just variables and there's no need to parse a string and worry about a string being formatted any particular way. The only case I really wasn't able to cover was the UDT type. Everything else is all good. This is mainly meant to serve as a sample showing someone how they can make a function that fits several scenarios. They'd obviously trim out what they don't need and change the routines within for what they do.

Well in my version, you did have to parse but you don't have to worry about the order of arguments, nor filling out all the blanks on a form like you do generally with QB64 subs and functions.

@bplus Right. Mine doesn't require any sort of order or number either.

Quote from: SpriggsySpriggs on March 29, 2021, 12:30:36 pm

@bplus Right. Mine doesn't require any sort of order or number either.

And that's why I like it!

Updated the original post. The code no longer uses header files as I have figured out a way to get around using them.

QB64.org Forum

Active Forums => Programs => Topic started by: SpriggsySpriggs on March 28, 2021, 07:17:26 pm