Callback functions in freebasic

[patrickw99]

I have been working on learning freebasic for a while now. Right now I am trying to do callbacks in freeBasic. I can use Callback with I interface with the C runtime. I have been having problems with doing them with freebasic functions. here is what I am working on. This is just to test how callbacks work. Once I get this to work I will use it to write some more complicated programs.

Can someone rip this code apart and tell me what stupid mistakes I have been making?

Code: Select all

Declare function test2  ( ByVal tt As String, ByVal   Function ( ByVal As Any ptr)As Integer) As Integer
Declare Sub test1 (byval  ts As String)
Dim text As String
text = "test good"

test2 text @test1 

Sleep
End

Function test2  ( ByVal tt As String, ByVal  Function ( ByVal As Any ptr)As Integer) As Integer
Print "This Is a test"
test1   
Return -1
End Function

Sub test1( ByVal  ts As  String)
	Print ts ; " callback "
End Sub

I get the following errors when I compile.

test.bas(3) error 59: Illegal specification, at parameter 2 (Function) of test2() in 'Declare function test2 ( ByVal tt As String, ByVal Function ( ByVal As Any ptr)As Integer) As Integer'
test.bas(11) error 42: Variable not declared, QCompare in 'QCompare text @test1'
test.bas(16) error 59: Illegal specification, at parameter 2 (Function) of test2() in 'Function test2 ( ByVal tt As String, ByVal Function ( ByVal As Any ptr)As Integer) As Integer'
test.bas(18) error 1: Argument count mismatch in 'test1'
test.bas(23) error 58: Type mismatch, at parameter 1 (ts) of test1() in 'Sub test1( ByVal ts As String)'

[paul doe]

Compare:

Code: Select all

function test1( ByVal ts As any ptr ) as integer
  Print *cast( string ptr, ts )
  
  return( -4 )
End function

Function test2  ( ByVal tt As String, ByVal f as Function ( ByVal As Any ptr ) As Integer ) As Integer
  Print "This Is a test"
  dim as string s => "Testing callback"
  Return f( @s )
End Function

Dim text As String
text = "test good"

? test2( text, @test1 )

Sleep

The callback signatures declared must match what you pass to them! Function pointers are a data type like any other, and if you mix and match them the compiler will barf.

[fxm]

Your first syntax error is a typo:
Declare function test2 ( ByVal tt As String, ByVal Function ( ByVal As Any ptr)As Integer) As Integer
Declare function test2 ( ByVal tt As String, ByVal As Function ( ByVal As Any ptr)As Integer) As Integer
Idem for the first line of function body.

[fxm]

Or this:

Code: Select all

function test1( ByVal ts As any ptr ) as integer
  Print *cast( string ptr, ts )
 
  return( -4 )
End function

Function test2  ( ByVal tt As String, ByVal pf As Any Ptr ) As Integer
  Print "This Is a callback test"
  Return Cptr( function ( ByVal As any ptr ) As integer, pf )( @tt )
End Function

Dim text As String
text = "test good"

? test2( text, @test1 )

Sleep

[dodicat]

Nice simple example
https://developer.mozilla.org/en-US/doc ... k_function
translated

Code: Select all

function greeting(names as string) as long
  print "Hello " + names
  return 0
end function

function processUserInput(callback as any ptr) as long
    dim as string s
    input "Please enter your name. ",s
  cast(function(as string) as integer,callback)(s)
  return 0
end function

processUserInput(@greeting)
sleep
 

[coderJeff]

Another example. My preference is to not use 'any ptr' and casting if there's a choice. If interfacing with someone else's code, have to do whatever is needed. If the function pointer (callback) declaration gets hairy, maybe can use a 'type name as ...' to make it readable.

Code: Select all

type MathFunction as function( byval x as double ) as double

function Linear( byval x as double ) as double
	return x
end function

function Quadratic( byval x as double ) as double
	return x * x
end function

function Sinusoidal( byval x as double ) as double
	return sin(x)
end function

sub PlotF( byval f as MathFunction )
	pset( -15, f(-15) )
	for x as double = -15 to 15 step 0.1
		line -( x, f(x) )
	next
end sub

screen 19
window (-15,-10)-(15,10)

PlotF( @Linear )
PlotF( @Sinusoidal )
PlotF( @Quadratic )

sleep

[fxm]

Both simple and demonstrative.
To be retained as a first example for an eventual documentation page on Callback Procedures.

[dodicat]

Quicksort case independent example.
The callbacks are up or down.

Code: Select all

'==========  quicksort setup ==============
type direction as function(as string, as string,as long) as long

Dim Shared As Ubyte u(255)
#define lwr(s) iif(s<91 andalso s>64,s+32,s)
For n As Long=0 To 255
    u(n)=lwr(n)  'lookup
Next

Function up(a As String,b As String,Lenb As Long)   As Long
    var lena=Cast(Integer Ptr,@a)[1]'=Len(a)
    For n As Long =0 To Iif(lena<lenb,lena,lenb)-1
        If u(a[n]) < u(b[n]) Then  Return -1
        If u(a[n]) > u(b[n]) Then  Return 0
    Next
    Return 0
End Function

Function down(a As String,b As String,lenb As Long)  As Long
    var lena=Cast(Integer Ptr,@a)[1]'=Len(a)
    For n As Long  =0 To Iif(lena<lenb,lena,lenb)-1
        If u(a[n]) > u(b[n]) Then Return -1
        If u(a[n]) < u(b[n]) Then Return 0
    Next
    Return 0
End Function

sub QuickSort(l as string ptr,r as string ptr,d as direction)
  if (r - l <= 1) then return
  var p=l+1,i=p
  var lenl= Cast(Integer Ptr,l)[1] '=len(*l)
  while (p <= r)
      if d(*p,*l,lenl) then swap *p,*i:i+=1
    p+=1
  wend
  p=i-1:swap *l,*p
  QuickSort(l,p,d)
  QuickSort(i,r,d)
end sub
'======================================

  Sub create(L() As String)
    #define range(f,l) Int(Rnd*(((l)+1)-(f))+(f))
    #define q range(97,122)-Iif(Rnd>.5,32,0)
    Randomize 1
    For n As Long=Lbound(L) To Ubound(L)
        Dim As String g1=Chr(q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q)
        Dim As String g2=Chr(q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q)
        Dim As String g3=Chr(q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q)
        L(n)=Left(g1+g2+g3,60+Rnd*30)
    Next
End Sub

Sub show(L() As String)
    For n As Long=Lbound(L) To 10
        Print L(n)
    Next
    For n As Long=1 To 4
        Print "..."
    Next
    For n As Long=Ubound(L)-10 To Ubound(L)
        Print L(n)
    Next
End Sub

Dim As Double t1,t2
Dim As Long limit=1000000
Dim As String L(1 To limit)
Print "Creating string array of mixed cases"
create(L())
print "Size of string array ";limit
print "Array ="
show(L())
print "Press a key to sort . . ."
sleep
Print "Commence sort "
print
t1=Timer
QuickSort(@L(Lbound(L)),@L(Ubound(L)),@up)
t2=Timer
show(L())
Print t2-t1;"  Seconds quicksort"
Sleep



 

[fxm]

Another example. My preference is to not use 'any ptr' and casting if there's a choice. If interfacing with someone else's code, have to do whatever is needed. If the function pointer (callback) declaration gets hairy, maybe can use a 'type name as ...' to make it readable.

Code: Select all

type MathFunction as function( byval x as double ) as double

function Linear( byval x as double ) as double
	return x
end function

function Quadratic( byval x as double ) as double
	return x * x
end function

function Sinusoidal( byval x as double ) as double
	return sin(x)
end function

sub PlotF( byval f as MathFunction )
	pset( -15, f(-15) )
	for x as double = -15 to 15 step 0.1
		line -( x, f(x) )
	next
end sub

screen 19
window (-15,-10)-(15,10)

PlotF( @Linear )
PlotF( @Sinusoidal )
PlotF( @Quadratic )

sleep

The above example of user explicit callback (of functions) can be easily transposed by using subtype polymorphism which implements under the hood a kind of inheritance implicit callback (of virtual derived functions) thanks to a vtable (virtual table) addressed by a vptr (virtual pointer) depending of the object type passed:

Code: Select all

Type MathFunction Extends Object
    Declare Abstract Function f( ByVal x As Double ) As Double
End type

Type Linear Extends MathFunction
    Declare Virtual Function f( ByVal x As Double ) As Double Override
End Type
Function Linear.f( ByVal x As Double ) As Double
    Return x
End Function

Type Quadratic Extends MathFunction
    Declare Virtual Function f( ByVal x As Double ) As Double Override
End Type
Function Quadratic.f( ByVal x As Double ) As Double
    Return x * x
End Function

Type Sinusoidal Extends MathFunction
    Declare Virtual Function f( ByVal x As Double ) As Double Override
End Type
Function Sinusoidal.f( ByVal x As Double ) As Double
    Return Sin(x)
End Function

Sub PlotF( ByRef mf As MathFunction )
    PSet( -15, mf.f(-15) )
    For x As Double = -15 To 15 Step 0.1
        Line -( x, mf.f(x) )
    Next
End Sub

Screen 19
Window (-15,-10)-(15,10)

PlotF( Linear )      '' by using constructor call shortcut to get temporary 'linear' object
PlotF( Sinusoidal )  '' by using constructor call shortcut to get temporary 'Sinusoidal' object
PlotF( Quadratic )   '' by using constructor call shortcut to get temporary 'Quadratic' object

Sleep