Author Topic: Overloaded functions and any arguments  (Read 487 times)

0 Members and 1 Guest are viewing this topic.

Offline SpriggsySpriggs

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

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:
« Last Edit: April 08, 2021, 04:32:07 PM by SpriggsySpriggs »

Offline SpriggsySpriggs

  • QB64 Developer
  • Forum Resident
  • Posts: 993
  • If you're API and you know it clap your hands
    • My GitHub
Re: Overloaded functions and any arguments
« Reply #1 on: March 28, 2021, 07:59:05 PM »
This is still a work in progress so I will update the original post as often as possible with new changes

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3565
    • Steve’s QB64 Archive Forum
Re: Overloaded functions and any arguments
« Reply #2 on: March 28, 2021, 09:34:26 PM »
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.
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline SpriggsySpriggs

  • QB64 Developer
  • Forum Resident
  • Posts: 993
  • If you're API and you know it clap your hands
    • My GitHub
Re: Overloaded functions and any arguments
« Reply #3 on: March 28, 2021, 09:38:03 PM »
@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.
« Last Edit: March 28, 2021, 09:41:51 PM by SpriggsySpriggs »

Offline SpriggsySpriggs

  • QB64 Developer
  • Forum Resident
  • Posts: 993
  • If you're API and you know it clap your hands
    • My GitHub
Re: Overloaded functions and any arguments
« Reply #4 on: March 28, 2021, 11:03:16 PM »
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.

Offline bplus

  • Forum Resident
  • Posts: 6842
  • b = b + ...
Re: Overloaded functions and any arguments
« Reply #5 on: March 29, 2021, 12:15:28 PM »
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!

Offline SpriggsySpriggs

  • QB64 Developer
  • Forum Resident
  • Posts: 993
  • If you're API and you know it clap your hands
    • My GitHub
Re: Overloaded functions and any arguments
« Reply #6 on: March 29, 2021, 12:20:40 PM »
@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.

Offline bplus

  • Forum Resident
  • Posts: 6842
  • b = b + ...
Re: Overloaded functions and any arguments
« Reply #7 on: March 29, 2021, 12:27:11 PM »
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.

Offline SpriggsySpriggs

  • QB64 Developer
  • Forum Resident
  • Posts: 993
  • If you're API and you know it clap your hands
    • My GitHub
Re: Overloaded functions and any arguments
« Reply #8 on: March 29, 2021, 12:30:36 PM »
@bplus Right. Mine doesn't require any sort of order or number either.

Offline bplus

  • Forum Resident
  • Posts: 6842
  • b = b + ...
Re: Overloaded functions and any arguments
« Reply #9 on: March 29, 2021, 12:33:17 PM »
@bplus Right. Mine doesn't require any sort of order or number either.

And that's why I like it!

Offline SpriggsySpriggs

  • QB64 Developer
  • Forum Resident
  • Posts: 993
  • If you're API and you know it clap your hands
    • My GitHub
Re: Overloaded functions and any arguments
« Reply #10 on: April 07, 2021, 04:57:54 PM »
Updated the original post. The code no longer uses header files as I have figured out a way to get around using them.