## polymorphism revisit - 2023

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
dafhi
Posts: 1673
Joined: Jun 04, 2005 9:51

### polymorphism revisit - 2023

huge thanks to fxm

Code: Select all

/' -- polymorphism emulation -- 2023 April 11 revisit - by dafhi

once upon a time i asked if it was possible to call a UDT function,
having the code redirect via pointer.

fxm provided a solution for pre-polymorph version of freebasic.

i'm not sure anymore that this qualifies for polymorphism,
but its functionality is more elegant.

this is probably more polymorphic
https://freebasic.net/forum/viewtopic.php?p=298022#p298022

'/

#define flo(x)      (((x)*2.0-0.5)shr 1) '' replaces (and faster) int - http://www.freebasic.net/forum/viewtopic.php?p=118633

#undef int
#define int         as integer
#define sng         as single

function sw_wave( i sng ) sng
return i - flo(i) - .5
End function

function tr_wave( i sng ) sng
return abs(i - flo(i) - .5) - .25 '' by Stonemonkey
End function

type layer
declare constructor
as function(sng) sng wave
sng     freq = 3 + rnd * 5
end type

constructor layer
if rnd < .5 then
this.wave = @tr_wave
else
this.wave = @sw_wave
end if
end constructor

var w = 800
var h = 600

screenres w,h

dim as layer      a()

var               u = 9
redim             a(u)

for x int = 0 to w-1
var f = x / w
for j int = 0 to u
var aj = a(j)
var y = h/2*( 1 - aj.wave( aj.freq*f ) )
pset ( x, y )
next
next

sleep
Last edited by dafhi on Apr 11, 2023 7:46, edited 1 time in total.
fxm
Moderator
Posts: 12181
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

### Re: polymorphism revisit - 2023

Why not use true polymorphism which is more compact.
An emulation of polymorphism was interesting in FreeBASIC as long as it was not supported (before version 0.90.0).
If "pointer" instances put you off, you can use "reference" instances instead:

Code: Select all

'' replaces int - http://www.freebasic.net/forum/viewtopic.php?p=118633
#define flo(x)      (((x)*2.0-0.5)shr 1)

#undef int
#define int         as integer
#define sng         as single

type myPolyEM extends object
declare abstract function wave( sng ) sng
End Type

type func_sw extends myPolyEM:  declare virtual function wave( sng ) sng
End Type

type func_tr extends myPolyEM:  declare virtual function wave( sng ) sng
End Type

function func_sw.wave( i sng ) sng
return i - flo(i) - .5
End function

function func_tr.wave( i sng ) sng
return abs(i - flo(i) - .5) - .25 '' by Stonemonkey
End function

var w = 800
var h = 600

screenres w,h

dim byref as myPolyEM saw = *New func_sw
dim byref as myPolyEM tri = *New func_tr

for y int = 0 to h-1
for x int = 0 to w-1
var freq = 1
var xpos = freq * x / w
pset (x, h/2*( 1 - saw.wave(xpos) )), 1
pset (x, h/2*( 1 - tri.wave(xpos) )), 2
next
next

sleep
delete @saw
delete @tri
dodicat
Posts: 7993
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: polymorphism revisit - 2023

I think I have found a bug in trying to compact dafhi's code
This shouldn't work:

Code: Select all

'' replaces int - http://www.freebasic.net/forum/viewtopic.php?p=118633
#define flo(x)      (((x)*2.0-0.5)shr 1)

type func_sw extends object
declare  function wave( as single ) as single
End Type

type func_tr extends object
declare  function wave( as single ) as single
End Type

function func_sw.wave( i as single ) as single
return i - flo(i) - .5
End function

function func_tr.wave( i as single ) as single
return abs(i - flo(i) - .5) - .25 '' by Stonemonkey
End function

var w = 800
var h = 600

screenres w,h

for y as integer = 0 to h-1
for x as integer = 0 to w-1
var freq = 1
var xpos = freq * x / w
pset (x, h/2*( 1 - (func_sw).wave(xpos) )), 1
pset (x, h/2*( 1 - (func_tr).wave(xpos) )), 2
next
next

sleep

fxm
Moderator
Posts: 12181
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

### Re: polymorphism revisit - 2023

This works and must work.
dodicat
Posts: 7993
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: polymorphism revisit - 2023

I have had a think about it, the hidden constructor when using extends object allows this.
dafhi
Posts: 1673
Joined: Jun 04, 2005 9:51

### Re: polymorphism revisit - 2023

i do like the more compact form

if there was version where i wouldn't have to delete stuff, that would be preferred.
i've run into so many problems with objects created as such

i remember my vision. create an array, having function reference be assigned one of 2 ways
1. randomly, within parameterless constructor

Code: Select all

type layer extends myPolyEM
declare         constructor
sng             freq = 3 + rnd * 5
end type

constructor.layer

#define _
polymorph_hack( fname ) _
Cptr(any ptr ptr, @this)[0] = Cptr(any ptr ptr, @fname() )[0]

if rnd < .5 then
polymorph_hack(func_tr)
else
polymorph_hack(func_sw)
End if

#undef polymorph_hack

end constructor
2. user
fxm
Moderator
Posts: 12181
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

### Re: polymorphism revisit - 2023

dafhi wrote: Apr 09, 2023 22:29 i do like the more compact form

if there was version where i wouldn't have to delete stuff, that would be preferred.
i've run into so many problems with objects created as such

i remember my vision. create an array, having function reference be assigned one of 2 ways
1. randomly, within parameterless constructor
2. user

You can add a pointer wrapper class 'user' (smart pointer with implicit delete):
- calling constructor without parameter => 1. randomly
- calling constructor with parameter => 2. user

Code: Select all

'' replaces int - http://www.freebasic.net/forum/viewtopic.php?p=118633
#define flo(x)      (((x)*2.0-0.5)shr 1)

#undef int
#define int         as integer
#define sng         as single

type myPolyEM extends object
declare abstract function wave( sng ) sng
End Type

type func_sw extends myPolyEM:  declare virtual function wave( sng ) sng
End Type

type func_tr extends myPolyEM:  declare virtual function wave( sng ) sng
End Type

function func_sw.wave( i sng ) sng
return i - flo(i) - .5
End function

function func_tr.wave( i sng ) sng
return abs(i - flo(i) - .5) - .25 '' by Stonemonkey
End function

type user
pt as myPolyEM ptr
declare constructor(p as myPolyEM ptr = 0)
declare destructor()
end type

constructor user(p as myPolyEM ptr)
if p <> 0 Then
this.pt = p
elseif rnd < .5 then
this.pt = New func_tr
else
this.pt = New func_sw
End if
end constructor

destructor user()
delete this.pt
end destructor

operator ->(byref u as user) byref as myPolyEM
return *u.pt
end operator

var w = 800
var h = 600

screenres w,h

dim as user saw = New func_sw
dim as user tri = New func_tr

for y int = 0 to h-1
for x int = 0 to w-1
var freq = 1
var xpos = freq * x / w
pset (x, h/2*( 1 - saw->wave(xpos) )), 1
pset (x, h/2*( 1 - tri->wave(xpos) )), 2
next
next

sleep
In this example, adding virtual destructors in 'myPolyEM'/'func_sw'/'func_tr' is useless because there in no specific member to destroy in 'func_sw'/'func_tr'.
Last edited by fxm on Apr 10, 2023 8:24, edited 3 times in total.
Reason: Improved polymorphism code to support the two ways: randomly or user.
dafhi
Posts: 1673
Joined: Jun 04, 2005 9:51

### Re: polymorphism revisit - 2023

fxm, thank you for your time

i now get " .. non-parameterless.." error on the redim

[edited] .. was: dim as layer

Code: Select all

dim as user  a()

var           u = 9
redim         a(u)

Also, creating instances seems wasteful in this case.
Could .wave() reference a regular function?
fxm
Moderator
Posts: 12181
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

### Re: polymorphism revisit - 2023

REDIM of UDT array requests a true default constructor (not a constructor with default parameter).
My 'user' Type so modified:

Code: Select all

type user
pt as myPolyEM ptr
declare constructor()
declare constructor(p as myPolyEM ptr)
declare destructor()
end type

constructor user()
if rnd < .5 then
this.pt = New func_tr
else
this.pt = New func_sw
End if
end constructor

constructor user(p as myPolyEM ptr)
this.pt = p
end constructor

destructor user()
delete this.pt
end destructor

operator ->(byref u as user) byref as myPolyEM
return *u.pt
end operator

For the rest, a code example would be welcome.
dafhi
Posts: 1673
Joined: Jun 04, 2005 9:51

### Re: polymorphism revisit - 2023

90% of the way there, maybe.

now i get a segfault

Code: Select all

type layer '' renamed user -> layer
sng                 freq = 3 + rnd * 8
as myPolyEM ptr     pt
declare constructor()
declare constructor(p as myPolyEM ptr)
declare destructor()
end type

constructor layer()
if rnd < .5 then
this.pt = New func_tr
else
this.pt = New func_sw
End if
end constructor

constructor layer(p as myPolyEM ptr)
this.pt = p
end constructor

destructor layer()
delete this.pt
end destructor

operator ->(byref u as layer) byref as myPolyEM
return *u.pt
end operator

var w = 800
var h = 600

screenres w,h

dim as layer  a()

var           u = 9
redim         a(u)

for x int = 0 to w-1
var f = x / w
for j int = 0 to u
var aj = a(j)
var y = h/2*( 1 - aj.pt->wave( aj.freq ) )
pset ( x, y )
next
next
fxm
Moderator
Posts: 12181
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

### Re: polymorphism revisit - 2023

Don't use:

Code: Select all

var aj = a(j)

because an explicit copy-constructor is not defined for 'layer' (the implicit (shallow) copy construction induces crash because of the pointer member: the pointer value being only copied, when 'aj' is destroyed, that also destroys 'a(j)'):

Code: Select all

for x int = 0 to w-1
var f = x / w
for j int = 0 to u
'    var aj = a(j)
'    var y = h/2*( 1 - aj.pt->wave( aj.freq ) )
var y = h/2*( 1 - a(j).pt->wave( a(j).freq ) )
pset ( x, y )
next
next
Good debug suite.

Otherwise, an example of explicit copy-constructor that works:

Code: Select all

constructor layer(l as layer)
this.freq = l.freq
if *l.pt is func_tr then
this.pt = New func_tr
else
this.pt = New func_sw
end if
end constructor

Note: With your code above, defining an overload '->' operator ('operator ->(byref u as layer) byref as myPolyEM') is useless.
dafhi
Posts: 1673
Joined: Jun 04, 2005 9:51

### Re: polymorphism revisit - 2023

very cool. i suspected that var aj = would be an issue but didn't realize it was causing the fault xD

also, i forgot something

Code: Select all

var aj = a(j)
var y = h/2*( 1 - aj.pt->wave( aj.freq * f ) )

still prefer the hack. its clean, except for my segfault

Code: Select all

#define flo(x)      (((x)*2.0-0.5)shr 1) '' replaces (and faster) int - http://www.freebasic.net/forum/viewtopic.php?p=118633

#undef int
#define int         as integer
#define sng         as single

type myPoly extends object
declare constructor
declare virtual function wave( sng ) sng
end type

''
type func_sw extends myPoly:  declare virtual function wave( sng ) sng
End Type

type func_tr extends myPoly:  declare virtual function wave( sng ) sng
End Type

function func_sw.wave( i sng ) sng
return i - flo(i) - .5
End function

function func_tr.wave( i sng ) sng
return abs(i - flo(i) - .5) - .25 '' by Stonemonkey
End function

'' .. myPoly continued ..
function myPoly.wave( i sng ) sng:  return 0 '' default
End Function

constructor.myPoly
#define _
polymorph_hack( fname ) _
Cptr(any ptr ptr, @this)[0] = Cptr(any ptr ptr, @fname() )[0]

if rnd < .5 then
polymorph_hack(func_tr)
else
polymorph_hack(func_sw)
End if

#undef polymorph_hack
end constructor

''
type layer extends myPoly
declare constructor
declare constructor( l as layer )
sng     freq = 3 + rnd * 5
end type

constructor.layer
end constructor

constructor.layer( l as layer )
this = l
end constructor

var w = 800
var h = 600

screenres w,h

dim as layer      a()

var               u = 9
redim             a(u)

for x int = 0 to w-1
var f = x / w
for j int = 0 to u
var aj = a(j)
var y = h/2*( 1 - aj.wave( aj.freq*f ) )
pset ( x, y )
next
next

sleep

if there was a way to reference normal functions, that would be preferred
fxm
Moderator
Posts: 12181
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

### Re: polymorphism revisit - 2023

dafhi wrote: Apr 10, 2023 23:10 still prefer the hack. its clean, except for my segfault

Your above code cannot work because there is an infinite loop in the 'constructor myPoly' body (because '@func_tr()' and '@func_sw()' also call this same constructor).

But you can put the corresponding code in the 'constructor layer' for example.
And if you want also use 'var aj = a(j)', you must also define a proper copy-constructor.
Proposed code:

Code: Select all

#define flo(x)      (((x)*2.0-0.5)shr 1) '' replaces (and faster) int - http://www.freebasic.net/forum/viewtopic.php?p=118633

#undef int
#define int         as integer
#define sng         as single

type myPoly extends object
declare virtual function wave( sng ) sng
end type

''
type func_sw extends myPoly:  declare virtual function wave( sng ) sng
End Type

type func_tr extends myPoly:  declare virtual function wave( sng ) sng
End Type

function func_sw.wave( i sng ) sng
return i - flo(i) - .5
End function

function func_tr.wave( i sng ) sng
return abs(i - flo(i) - .5) - .25 '' by Stonemonkey
End function

'' .. myPoly continued ..
function myPoly.wave( i sng ) sng:  return 0 '' default
End Function

''
type layer extends myPoly
declare constructor()
declare constructor(mp as myPoly)
declare constructor(l as layer)
sng     freq = 3 + rnd * 5
end type

constructor layer()
#define _
polymorph_hack( fname ) _
Cptr(any ptr ptr, @this)[0] = Cptr(any ptr ptr, @fname() )[0]

if rnd < .5 then
polymorph_hack(func_tr)
else
polymorph_hack(func_sw)
End if

#undef polymorph_hack
end constructor

constructor layer(mp as myPoly)
Cptr(any ptr ptr, @this)[0] = Cptr(any ptr ptr, @mp )[0]
end constructor

constructor layer(l as layer)
this.freq = l.freq
Cptr(any ptr ptr, @this)[0] = Cptr(any ptr ptr, @l )[0]
end constructor

var w = 800
var h = 600

screenres w,h

dim as layer      a()

var               u = 9
redim             a(u)

for x int = 0 to w-1
var f = x / w
for j int = 0 to u
var aj = a(j)
var y = h/2*( 1 - aj.wave( aj.freq*f ) )
pset ( x, y )
next
next

sleep
Last edited by fxm on Apr 11, 2023 8:21, edited 1 time in total.
fxm
Moderator
Posts: 12181
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

### Re: polymorphism revisit - 2023

dafhi wrote: Apr 10, 2023 23:10 if there was a way to reference normal functions, that would be preferred

Simply for example (with a function pointer member):

Code: Select all

#define flo(x)      (((x)*2.0-0.5)shr 1) '' replaces (and faster) int - http://www.freebasic.net/forum/viewtopic.php?p=118633

#undef int
#define int         as integer
#define sng         as single

function sw_wave( i sng ) sng
return i - flo(i) - .5
End function

function tr_wave( i sng ) sng
return abs(i - flo(i) - .5) - .25 '' by Stonemonkey
End function

type layer
declare constructor()
declare constructor(p as function(sng) sng)
as function(sng) sng wave
sng     freq = 3 + rnd * 5
end type

constructor layer()
if rnd < .5 then
this.wave = @tr_wave
else
this.wave = @sw_wave
end if
end constructor

constructor layer(p as function(sng) sng)
this.wave = p
end constructor

var w = 800
var h = 600

screenres w,h

dim as layer      a()

var               u = 9
redim             a(u)

for x int = 0 to w-1
var f = x / w
for j int = 0 to u
var aj = a(j)
var y = h/2*( 1 - aj.wave( aj.freq*f ) )
pset ( x, y )
next
next

sleep
Last edited by fxm on Apr 11, 2023 8:14, edited 1 time in total.
dodicat
Posts: 7993
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: polymorphism revisit - 2023

Polymorphism has gone I note.
Maybe just back to basics.

Code: Select all

#define flo(x)      (((x)*2.0-0.5)shr 1) '' replaces (and faster) int - http://www.freebasic.net/forum/viewtopic.php?p=118633

Function sw_wave( i As Single ) As Single
Return i - flo(i) - .5
End Function

Function tr_wave( i As Single ) As Single
Return Abs(i - flo(i) - .5) - .25 '' by Stonemonkey
End Function

Function other(i As Single) As Single
return sin(tr_wave(i)*sw_wave(i))
End Function

Dim As Function(As Single) As Single a(1 To 3)={@sw_wave,@tr_wave,@other}
Var w = 800
Var h = 600

Screenres w,h

var k=0

For y As Single = 0 To h-1 Step (1/4)
For x As Single = 0 To w-1 Step (1/4)
Var freq = 7
Var xpos = freq * x / w
k+=1
Var aj = a(k)
Pset (x, h/2*( 1 - aj(xpos) )), k+4
if k=3 then k=0
Next
Next
Sleep

I have seen similar before coder jeff + fxm I think