Overloaded functions and any arguments

[SpriggsySpriggs]

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]

1. Option _Explicit
2. _Title "Overloaded Functions - AS ANY"
3. Screen _NewImage(640, 480, 32)
4. _ScreenMove _Middle
5.  
6. Dim As _MEM test(1 To 17)
7.  
8. Dim As Long longtest: longtest = 435
9. Dim As Single singletest: singletest = 1.2
10. Dim As _Float floattest: floattest = 4.65
11. Dim As String * 21 stringtest: stringtest = "This is a string test"
12. Dim As _Offset offsettest: offsettest = 1234567
13. 'Dim As Long imagetest: imagetest = _LoadImage(".\face no background.png", 32) 'replace with an image that you have
14. 'Dim As Long soundtest: soundtest = _SndOpen(".\Dalshabet With. Bigtone.mp3") 'replace with a song that you have
15. Dim As String * 13 stringarraytest(1 To 3)
16. stringarraytest(1) = "Array test 1"
17. stringarraytest(2) = "Array test 2"
18. stringarraytest(3) = "Array test 3"
19. Dim As _Unsigned _Offset unsignedoffsetarraytest(1 To 2)
20. unsignedoffsetarraytest(1) = 123456789
21. unsignedoffsetarraytest(2) = 787970792
22. Dim As _Unsigned _Offset unsignedoffsettest: unsignedoffsettest = 1234523
23. Dim As _Float floatarraytest(1 To 3)
24. floatarraytest(1) = 3.56
25. floatarraytest(2) = 14.7548
26. floatarraytest(3) = 56.24124
27. Dim As Double doublearraytest(1 To 3)
28. doublearraytest(1) = 1.25
29. doublearraytest(2) = 2.34
30. doublearraytest(3) = 5.52
31. Dim As Single singlearraytest(1 To 3)
32. singlearraytest(1) = 2.12
33. singlearraytest(2) = 6.87
34. singlearraytest(3) = 9.65
35. Dim As _Unsigned _Byte unsignedbytearraytest(1 To 4)
36. unsignedbytearraytest(1) = 255
37. unsignedbytearraytest(2) = 124
38. unsignedbytearraytest(3) = 98
39. unsignedbytearraytest(4) = 34
40. 'test(1) = _MemImage(imagetest)
41. test(2) = _Mem(singletest)
42. test(3) = _Mem(floattest)
43. test(4) = _Mem(stringtest)
44. test(5) = _Mem(offsettest)
45. test(6) = _Mem(longtest)
46. Dim As Double doubletest: doubletest = 2.578
47. test(7) = _Mem(doubletest)
48. 'test(7) = _MemSound(soundtest, 1) 'Left channel
49. 'test(8) = _MemSound(soundtest, 2) 'Right channel
50. test(9) = _Mem(stringarraytest())
51. test(10) = _Mem(unsignedoffsetarraytest())
52. test(11) = _Mem(unsignedoffsettest)
53. test(12) = _Mem(floatarraytest())
54. test(13) = _Mem(doublearraytest())
55. test(14) = _Mem(singlearraytest())
56. test(15) = _Mem(unsignedbytearraytest())
57. test(16) = _MemNew(4)
58. _MemPut test(16), test(16).OFFSET, longtest As LONG
59. test(17) = _MemNew(14)
60. _MemPut test(17), test(17).OFFSET, "This is a test"
61.  
62. Call anyArg(test())
63. Dim As _Unsigned Integer x
64. For x = LBound(test) To UBound(test)
65.     If _MemExists(test(x)) Then
66.         _MemFree test(x)
67.     End If
68. Next
69.  
70. Erase test
71.  
72. Sub anyArg (args() As _MEM)
73.     Dim As _Unsigned Integer x, y
74.     Dim As _Unsigned _Offset z
75.     Dim As _Unsigned Long size, elementsize
76.     For x = LBound(args) To UBound(args)
77.         If _MemExists(args(x)) Then
78.             z = 0
79.             size = Val(Str$(args(x).SIZE))
80.             elementsize = Val(Str$(args(x).ELEMENTSIZE))
81.             If _ReadBit(args(x).TYPE, 7) And _ReadBit(args(x).TYPE, 13) = 0 Then '_BYTE, INTEGER, LONG, _INTEGER64
82.                 If _ReadBit(args(x).TYPE, 10) Then
83.                     If _ReadBit(args(x).TYPE, 16) Then
84.                         Select Case args(x).ELEMENTSIZE
85.                             Case 1
86.                                 Dim As _Unsigned _Byte unsignedbytearray(1 To (size / elementsize))
87.                                 For y = LBound(unsignedbytearray) To UBound(unsignedbytearray)
88.                                     _MemGet args(x), args(x).OFFSET + z, unsignedbytearray(y)
89.                                     z = z + args(x).ELEMENTSIZE
90.                                     Print unsignedbytearray(y), "UBYTE ARRAY"
91.                                 Next
92.                                 Exit Select
93.                             Case 2
94.                                 Dim As _Unsigned Integer unsignedintarray(1 To (size / elementsize))
95.                                 For y = LBound(unsignedintarray) To UBound(unsignedintarray)
96.                                     _MemGet args(x), args(x).OFFSET + z, unsignedintarray(y)
97.                                     z = z + args(x).ELEMENTSIZE
98.                                     Print unsignedintarray(y), "USHORT ARRAY"
99.                                 Next
100.                                 Exit Select
101.                             Case 4
102.                                 Dim As _Unsigned Long unsignedlongarray(1 To (size / elementsize))
103.                                 For y = LBound(unsignedlongarray) To UBound(unsignedlongarray)
104.                                     _MemGet args(x), args(x).OFFSET + z, unsignedlongarray(y)
105.                                     z = z + args(x).ELEMENTSIZE
106.                                     Print unsignedlongarray(y), "ULONG ARRAY"
107.                                 Next
108.                                 Exit Select
109.                             Case 8
110.                                 Dim As _Unsigned _Integer64 unsignedint64array(1 To (size / elementsize))
111.                                 For y = LBound(unsignedint64array) To UBound(unsignedint64array)
112.                                     _MemGet args(x), args(x).OFFSET + z, unsignedint64array(y)
113.                                     z = z + args(x).ELEMENTSIZE
114.                                     Print unsignedint64array(y), "UINT64 ARRAY"
115.                                 Next
116.                                 Exit Select
117.                         End Select
118.                     Else
119.                         Select Case args(x).SIZE
120.                             Case 1
121.                                 Print _MemGet(args(x), args(x).OFFSET, _Unsigned _Byte), "UBYTE"
122.                                 Exit Select
123.                             Case 2
124.                                 Print _MemGet(args(x), args(x).OFFSET, _Unsigned Integer), "USHORT"
125.                                 Exit Select
126.                             Case 4
127.                                 Print _MemGet(args(x), args(x).OFFSET, _Unsigned Long), "ULONG"
128.                                 Exit Select
129.                             Case 8
130.                                 Print _MemGet(args(x), args(x).OFFSET, _Unsigned _Integer64), "UINT64"
131.                                 Exit Select
132.                         End Select
133.                     End If
134.                 Else
135.                     If _ReadBit(args(x).TYPE, 16) Then
136.                         Select Case args(x).ELEMENTSIZE
137.                             Case 1
138.                                 Dim As _Byte bytearray(1 To (size / elementsize))
139.                                 For y = LBound(bytearray) To UBound(bytearray)
140.                                     _MemGet args(x), args(x).OFFSET + z, bytearray(y)
141.                                     z = z + args(x).ELEMENTSIZE
142.                                     Print bytearray(y), "BYTE ARRAY"
143.                                 Next
144.                                 Exit Select
145.                             Case 2
146.                                 Dim As Integer intarray(1 To (size / elementsize))
147.                                 For y = LBound(intarray) To UBound(intarray)
148.                                     _MemGet args(x), args(x).OFFSET + z, intarray(y)
149.                                     z = z + args(x).ELEMENTSIZE
150.                                     Print unsignedintarray(y), "SHORT ARRAY"
151.                                 Next
152.                                 Exit Select
153.                             Case 4
154.                                 Dim As Long longarray(1 To (size / elementsize))
155.                                 For y = LBound(longarray) To UBound(longarray)
156.                                     _MemGet args(x), args(x).OFFSET + z, longarray(y)
157.                                     z = z + args(x).ELEMENTSIZE
158.                                     Print longarray(y), "LONG ARRAY"
159.                                 Next
160.                                 Exit Select
161.                             Case 8
162.                                 Dim As _Integer64 int64array(1 To (size / elementsize))
163.                                 For y = LBound(int64array) To UBound(int64array)
164.                                     _MemGet args(x), args(x).OFFSET + z, int64array(y)
165.                                     z = z + args(x).ELEMENTSIZE
166.                                     Print int64array(y), "INT64 ARRAY"
167.                                 Next
168.                                 Exit Select
169.                         End Select
170.                     Else
171.                         Select Case args(x).SIZE
172.                             Case 1
173.                                 Print _MemGet(args(x), args(x).OFFSET, _Byte), "BYTE"
174.                                 Exit Select
175.                             Case 2
176.                                 Print _MemGet(args(x), args(x).OFFSET, Integer), "SHORT"
177.                                 Exit Select
178.                             Case 4
179.                                 Print _MemGet(args(x), args(x).OFFSET, Long), "LONG"
180.                                 Exit Select
181.                             Case 8
182.                                 Print _MemGet(args(x), args(x).OFFSET, _Integer64), "INT64"
183.                                 Exit Select
184.                         End Select
185.                     End If
186.                 End If
187.             ElseIf _ReadBit(args(x).TYPE, 8) Then 'SINGLE, DOUBLE, FLOAT
188.                 If _ReadBit(args(x).TYPE, 16) Then
189.                     Select Case args(x).ELEMENTSIZE
190.                         Case 4
191.                             Dim As Single singlearray(1 To (size / elementsize))
192.                             For y = LBound(singlearray) To UBound(singlearray)
193.                                 _MemGet args(x), args(x).OFFSET + z, singlearray(y)
194.                                 z = z + args(x).ELEMENTSIZE
195.                                 Print singlearray(y), "SINGLE ARRAY"
196.                             Next
197.                             Exit Select
198.                         Case 8
199.                             Dim As Double doublearray(1 To (size / elementsize))
200.                             For y = LBound(doublearray) To UBound(doublearray)
201.                                 _MemGet args(x), args(x).OFFSET + z, doublearray(y)
202.                                 z = z + args(x).ELEMENTSIZE
203.                                 Print doublearray(y), "DOUBLE ARRAY"
204.                             Next
205.                             Exit Select
206.                         Case 32
207.                             Dim As _Float floatarray(1 To (size / elementsize))
208.                             For y = LBound(floatarray) To UBound(floatarray)
209.                                 _MemGet args(x), args(x).OFFSET + z, floatarray(y)
210.                                 z = z + args(x).ELEMENTSIZE / 2
211.                                 Print floatarray(y), "FLOAT ARRAY"
212.                             Next
213.                             Exit Select
214.                     End Select
215.                 Else
216.                     Select Case args(x).SIZE
217.                         Case 4
218.                             Print _MemGet(args(x), args(x).OFFSET, Single), "SINGLE"
219.                             Exit Select
220.                         Case 8
221.                             Print _MemGet(args(x), args(x).OFFSET, Double), "DOUBLE"
222.                             Exit Select
223.                         Case 32
224.                             Print _MemGet(args(x), args(x).OFFSET, _Float), "FLOAT"
225.                             Exit Select
226.                     End Select
227.                 End If
228.             ElseIf _ReadBit(args(x).TYPE, 9) Then 'STRING
229.                 If _ReadBit(args(x).TYPE, 16) Then
230.                     Dim As String stringarray(1 To (size / elementsize))
231.                     For y = LBound(stringarray) To UBound(stringarray)
232.                         stringarray(y) = Space$(args(x).ELEMENTSIZE)
233.                         _MemGet args(x), (args(x).OFFSET) + (y * args(x).ELEMENTSIZE - args(x).ELEMENTSIZE), stringarray(y)
234.                         Print stringarray(y), "STRING ARRAY"
235.                     Next
236.                 Else
237.                     Dim As String stringtest: stringtest = Space$(args(x).ELEMENTSIZE)
238.                     _MemGet args(x), args(x).OFFSET, stringtest
239.                     Print stringtest
240.                 End If
241.             ElseIf _ReadBit(args(x).TYPE, 13) And _ReadBit(args(x).TYPE, 7) Then '_OFFSET
242.                 If _ReadBit(args(x).TYPE, 10) Then
243.                     If _ReadBit(args(x).TYPE, 16) Then
244.                         Dim As _Unsigned _Offset unsignedoffsetarray(1 To (size / elementsize))
245.                         For y = LBound(unsignedoffsetarray) To UBound(unsignedoffsetarray)
246.                             _MemGet args(x), args(x).OFFSET + z, unsignedoffsetarray(y)
247.                             z = z + args(x).ELEMENTSIZE
248.                             Print unsignedoffsetarray(y), "ULONG_PTR ARRAY"
249.                         Next
250.                     Else
251.                         Print _MemGet(args(x), args(x).OFFSET, _Unsigned _Offset), "ULONG_PTR"
252.                     End If
253.                 Else
254.                     If _ReadBit(args(x).TYPE, 16) Then
255.                         Dim As _Offset offsetarray(1 To (size / elementsize))
256.                         For y = LBound(offsetarray) To UBound(offsetarray)
257.                             _MemGet args(x), args(x).OFFSET + z, offsetarray(y)
258.                             z = z + args(x).ELEMENTSIZE
259.                             Print unsignedoffsetarray(y), "LONG_PTR ARRAY"
260.                         Next
261.                     Else
262.                         Print _MemGet(args(x), args(x).OFFSET, _Offset), "LONG_PTR"
263.                     End If
264.                 End If
265.             ElseIf args(x).TYPE = 0 And args(x).SIZE > 0 Then '_MEMSOUND
266.                 If Not _SndPlaying(args(x).SOUND) Then
267.                     _SndPlay (args(x).SOUND)
268.                 End If
269.                 Print "SOUND", args(x).SIZE, args(x).ELEMENTSIZE
270.             ElseIf _ReadBit(args(x).TYPE, 14) Then
271.                 Print args(x).SIZE, "MEM"
272.                 'todo
273.             End If
274.             If _ReadBit(args(x).TYPE, 11) Then '_MEMIMAGE
275.                 Screen args(x).IMAGE
276.             End If
277.         End If
278.     Next
279. 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:

[SpriggsySpriggs]

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

[SMcNeill]

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.

[SpriggsySpriggs]

@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.

[SpriggsySpriggs]

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.

[bplus]

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!

[SpriggsySpriggs]

@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.

[bplus]

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.

[SpriggsySpriggs]

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

[bplus]

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

And that's why I like it!

[SpriggsySpriggs]

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