polymorphism revisit - 2023

[dafhi]

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

[fxm]

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]

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]

This works and must work.

[dodicat]

I have had a think about it, the hidden constructor when using extends object allows this.

[dafhi]

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

[edit]

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]

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

[edit]

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

[dafhi]

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]

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]

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]

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.


[edit]
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]

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]

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

[fxm]

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

[dodicat]

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
Was it threading perhaps?
I forget.