PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Confusion on how to implement virtual tables on structures

https://www.purebasic.fr/english/viewtopic.php?t=85919

Page 1 of 2

Confusion on how to implement virtual tables on structures

Posted: Tue Dec 17, 2024 12:40 am
by Quin
I appologise if this is obvious and/or has been answered other places, but I've tried searching the forum and looking at the DialogManager's code from the IDE, and there's just some small piece that I'm missing. As is usually the case around here, I'm sure that someone will show me a simple fix in like 5 lines of what I'm doing wrong, but sometimes that's what you need I guess :mrgreen:
I'm trying to make a basic system for applets that have a couple basic functions as well as some properties.
Here's what I'm trying:

Code: Select all

EnableExplicit

Interface IApplet
Show()
Destroy()
EndInterface

Structure Applet
*VTable
Name.s
EndStructure

Procedure NewApplet(Name.s, VTable)
Protected *This.Applet
*This = AllocateStructure(Applet)
If *This
*This\VTable = VTable
*This\Name = Name
EndIf
ProcedureReturn *This
EndProcedure

Procedure Test_Show(*This.Applet)
MessageRequester("Show was called on applet", *This\Name)
EndProcedure

Procedure Test_Destroy(*This.Applet)
MessageRequester("Destory was called on", *This\Name)
EndProcedure

Define *Test.Applet = NewApplet("Test", ?VTable)
*Test\Show() ; Doesn't work.


DataSection
VTable:
Data.i @Test_Show(), @Test_Destroy()
EndDataSection
Any help is most certainly appreciated!

Re: Confusion on how to implement virtual tables on structures

Posted: Tue Dec 17, 2024 1:08 am
by idle
define the pointer as IApplet

Code: Select all

Define *Test.iApplet = NewApplet("Test", ?VTable)

Re: Confusion on how to implement virtual tables on structures

Posted: Tue Dec 17, 2024 1:16 am
by Quin
idle wrote: Tue Dec 17, 2024 1:08 am define the pointer as IApplet

Code: Select all

Define *Test.iApplet = NewApplet("Test", ?VTable)
That works, but what if I want to access fields on this variable as well? More specifically I want to maintain a global map of them, with the name being the key and the value being an Applet struct. The reason I didn't just have the name be the key and the VTable be the value is because I plan on having more properties than just this in the future.

Re: Confusion on how to implement virtual tables on structures

Posted: Tue Dec 17, 2024 3:22 am
by idle
you can do it with Extends

Code: Select all

EnableExplicit

Interface IApplet
Show()
Destroy()
EndInterface

Interface ifoo Extends IApplet 
  dofoo(x)
EndInterface   

Interface ibar Extends IApplet 
  dobar(x)
EndInterface 

Structure Applet
*VTable
Name.s
EndStructure 

Structure foo Extends Applet 
  x.i 
EndStructure  

Structure bar Extends Applet 
  x.i 
EndStructure  

Procedure NewApplet(Name.s,type.s)
Protected *This.Applet,VT
Select type  
  Case "foo"   
    *This = AllocateStructure(foo)
     vt = ?VTableFoo 
  Case "bar" 
    *This = AllocateStructure(bar)
     vt = ?VTableBar  
 EndSelect    
  If *This
    *This\Name = Name
    *this\VTable = vt 
    ProcedureReturn *This
  EndIf   
EndProcedure

Procedure Applet_Show(*This.Applet)
MessageRequester("Show was called on applet", *This\Name)
EndProcedure

Procedure Applet_Destroy(*This.Applet)
MessageRequester("Destory was called on", *This\Name)
EndProcedure

Procedure Do_Foo(*this.foo,val) 
   *this\x = val << 1  
   ProcedureReturn *this\x 
EndProcedure 

Procedure Do_Bar(*this.bar,val) 
   *this\x = val >> 1
    ProcedureReturn *this\x 
EndProcedure   

Define *foo.ifoo = NewApplet("myfoo","foo")
*foo\Show() 
Debug *foo\dofoo(64)

Define *bar.ibar = NewApplet("myBar","bar")
*bar\Show() 
Debug *bar\dobar(64) 


DataSection
VTableFoo:
Data.i @Applet_Show(), @Applet_Destroy(),@Do_Foo() 
VTableBar: 
Data.i @Applet_Show(), @Applet_Destroy(),@Do_Bar() 
EndDataSection

Re: Confusion on how to implement virtual tables on structures

Posted: Tue Dec 17, 2024 3:44 am
by Quin
Thanks for the reply!
Sorry, I should've been more specific. What I meant was being able to access the name field directly with something like:

Code: Select all

*App\Name
I'm also trying to store all Applet instances in a Map, but am unsuccessful, getting the error that I can't assign a value to a structure :? :? :?

Code: Select all

EnableExplicit

Interface IApplet
Show()
Destroy()
EndInterface

Structure Applet
*VTable
Name.s
EndStructure

Global NewMap Applets.Applet()

Procedure NewApplet(Name.s, VTable)
Protected *This.Applet
*This = AllocateStructure(Applet)
If *This
*This\VTable = VTable
*This\Name = Name
AddMapElement(Applets(), Name)
Applets() = *This
EndIf
ProcedureReturn *This
EndProcedure

Procedure Test_Show(*This.Applet)
MessageRequester("Show was called on applet", *This\Name)
EndProcedure

Procedure Test_Destroy(*This.Applet)
MessageRequester("Destroy was called on", *This\Name)
EndProcedure

Define *Test.IApplet = NewApplet("Test", ?VTable)
*Test\Show()

DataSection
VTable:
Data.i @Test_Show(), @Test_Destroy()
EndDataSection

Re: Confusion on how to implement virtual tables on structures

Posted: Tue Dec 17, 2024 3:50 am
by idle
you can store them as pointer

Code: Select all

EnableExplicit

Interface IApplet
Show()
Destroy()
EndInterface

Structure Applet
*VTable
Name.s
EndStructure

Global NewMap *Applets.Applet()

Procedure NewApplet(Name.s, VTable)
Protected *This.Applet
*This = AllocateStructure(Applet)
If *This
*This\VTable = VTable
*This\Name = Name
AddMapElement(*Applets(), Name)
*Applets() = *This
EndIf
ProcedureReturn *This
EndProcedure

Procedure Test_Show(*This.Applet)
MessageRequester("Show was called on applet", *This\Name)
EndProcedure

Procedure Test_Destroy(*This.Applet)
MessageRequester("Destroy was called on", *This\Name)
EndProcedure

Define *Test.IApplet = NewApplet("Test", ?VTable)
*Test\Show()

DataSection
VTable:
Data.i @Test_Show(), @Test_Destroy()
EndDataSection

Re: Confusion on how to implement virtual tables on structures

Posted: Tue Dec 17, 2024 2:29 pm
by Quin
Thanks, Idle! This has been most helpful.
So I assume there's no way for me to access both properties of the struct and methods at the same time? If so that's not a dealbreaker, if I absolutely need to I can make interface methods to expose them, although it would be nice.
I'm also slightly confused why this works, the map stores *IApplet pointers and I'm allocating a *Applet pointer, why does that not cause issues?
Thanks!

Re: Confusion on how to implement virtual tables on structures

Posted: Tue Dec 17, 2024 8:59 pm
by idle
you can cast the pointer to get the properties

Code: Select all

EnableExplicit

Interface IApplet
Show()
Destroy()
EndInterface

Structure Applet
*VTable
Name.s
EndStructure

Global NewMap *Applets.Applet()

Procedure NewApplet(Name.s, VTable)
Protected *This.Applet
*This = AllocateStructure(Applet)
If *This
*This\VTable = VTable
*This\Name = Name
AddMapElement(*Applets(), Name)
*Applets() = *This
EndIf
ProcedureReturn *This
EndProcedure

Procedure Test_Show(*This.Applet)
MessageRequester("Show was called on applet", *This\Name)
EndProcedure

Procedure Test_Destroy(*This.Applet)
MessageRequester("Destroy was called on", *This\Name)
EndProcedure

Define *Test.IApplet = NewApplet("Test", ?VTable)
*Test\Show()

Define *props.Applet = *test 
Debug *props\Name 


DataSection
VTable:
Data.i @Test_Show(), @Test_Destroy()
EndDataSection

Re: Confusion on how to implement virtual tables on structures

Posted: Wed Dec 18, 2024 12:18 pm
by Quin
Very cool, thanks for all your help! My love for PB deepens :|

Re: Confusion on how to implement virtual tables on structures

Posted: Wed Dec 18, 2024 9:18 pm
by mk-soft
This is actually not the right way.
There should be the GetName and SetName methods.

The vTable should not be passed as a parameter, but should be set internally.

Modules are very useful here to create the classes.
Do not create the methods in the DataSetion either, but use the memory for them when creating the class. This means that you can also overwrite methods during inheritance without overwriting the original method.
Multiple inheritance is also possible. However, the base class must always contain the vTable

I have created an example based on your model.
I'm a little behind with the description.

Update Example With Description v1.03
- Added a macro to set methods

Code: Select all

;-TOP OOP-Example by mk-soft, v1.03, 22.12.2024 ;)
; Link: https://www.purebasic.fr/english/viewtopic.php?p=632409#p632409

EnableExplicit

DeclareModule ClassCommon
  
  Structure sMethod
    *Index[0]
  EndStructure
  
  Structure sClass
    ClassName.s       ; Name of class
    Size.i            ; Size of interface in bytes 
    *Methods.sMethod  ; Pointer to method table
  EndStructure
  
  Global NewMap Classes.sClass()
  
  Declare NewClass(ClassName.s, SizeOfInterface, ClassExtends.s = "")
  
  Macro SetMethod(Method)
    *Class\Methods\Index[OffsetOf(iMethods\Method()) / SizeOf(Integer)] = @Method()
  EndMacro
  
EndDeclareModule

Module ClassCommon
    
  Procedure NewClass(ClassName.s, SizeOfInterface, ClassExtends.s = "")
    Protected *Class.sClass, *ClassExtends.sClass
    
    With Classes()
      ; Check class is always exists
      If FindMapElement(Classes(), ClassName)
        Debug "ClassCommon Error: Class always exists: " + ClassName
        ProcedureReturn 0
      EndIf
      
      ; If use extends, check exists extends class
      If ClassExtends
        *ClassExtends = FindMapElement(Classes(), ClassExtends)
        If Not *ClassExtends
          Debug "ClassCommon Error: Extends class not exists: " + ClassExtends
          ProcedureReturn 0
        EndIf
      EndIf
      
      ; Create new class
      *Class = AddMapElement(Classes(), ClassName)
      If *Class
        ; Store class name
        \ClassName = ClassName
        ; Store byte size of method table
        \Size = SizeOfInterface
        ; Allocate memory for method table
        \Methods = AllocateMemory(SizeOfInterface)
        If Not \Methods
          Debug "ClassCommon Error: Out Of Memory:" + ClassName
          DeleteMapElement(Classes())
          ProcedureReturn 0
        EndIf
        ; If use extends, copy extends methods to new method table
        If *ClassExtends
          CopyMemory(*ClassExtends\Methods, *Class\Methods, *ClassExtends\Size)
        EndIf
        ProcedureReturn *Class
      Else
        Debug "ClassCommon Error: Out Of Memory:" + ClassName
        ProcedureReturn 0
      EndIf
    EndWith
    
  EndProcedure
  
EndModule

; ****

;- AppletBase

DeclareModule AppletBase
  
  Interface iAppletBase
    Show()
    Destroy()
  EndInterface
  
  Structure sAppletBase
    *vTable
  EndStructure
  
  Declare New()
  
EndDeclareModule

Module AppletBase
  
  EnableExplicit
  
  UseModule ClassCommon
  
  ; Static pointer to class
  Global *Class.sClass
  
  ; Macro Interface Helper
  Interface iMethods Extends iAppletBase
  EndInterface
  
  Procedure New()
    Protected *This.sAppletBase
    
    If *Class
      *This = AllocateStructure(sAppletBase)
      If *This
        *This\vTable = *Class\Methods
      EndIf
    EndIf
    ProcedureReturn *This
  EndProcedure
  
  Procedure Show(*This.sAppletBase)
    Debug *Class\ClassName + ": Show was called"
  EndProcedure
  
  Procedure Destroy(*This.sAppletBase)
    Debug *Class\ClassName + ": Destroy was called"
    ; Free all resources here:
    ; - Do not forget to delete fonts, images, files, etc. 
    
    FreeStructure(*This)
  EndProcedure
  
  Procedure InitClass()
    ; Create new class
    *Class = NewClass("AppletBase", SizeOf(iAppletBase))
    If *Class
      With *Class
        ; Poke method address into method table
        ; - OffsetOf get the byte address of interface method
        
        ; Set methods
        SetMethod(Show) ; Macro -> *Class\Methods\Index[OffsetOf(iMethods\Show()) / SizeOf(Integer)] = @Show()
        ; Write direct method address 
        PokeI(\Methods + OffsetOf(iAppletBase\Destroy()), @Destroy())
      EndWith
    Else
      Debug "Error: NewClass AppletBase"
      CallDebugger
    EndIf
  EndProcedure : InitClass()
  
EndModule

; ----

;- Applet

DeclareModule Applet
  
  Interface iApplet Extends AppletBase::iAppletBase
    SetName(Name.s)
    GetName.s()
  EndInterface
  
  Structure sApplet Extends AppletBase::sAppletBase
    Name.s
  EndStructure
  
  Declare New()
  
EndDeclareModule

Module Applet
  
  EnableExplicit
  
  UseModule ClassCommon
  
  ; Static pointer to class
  Global *Class.sClass
  
  ; Macro Interface Helper
  Interface iMethods Extends iApplet
  EndInterface
  
  Procedure New()
    Protected *This.sApplet
    
    If *Class
      *This = AllocateStructure(sApplet)
      If *This
        *This\vTable = *Class\Methods
      EndIf
    EndIf
    ProcedureReturn *This
  EndProcedure
  
  Procedure Destroy(*This.sApplet)
    Debug *Class\ClassName + ": Destroy was called"
    ; Free all resources here:
    ; - Do not forget to delete fonts, images, files, etc. 
    
    FreeStructure(*This)
  EndProcedure
  
  Procedure SetName(*This.sApplet, Name.s)
    Debug *Class\ClassName + ": Set name: " + Name
    *This\Name = Name
  EndProcedure
  
  Procedure.s GetName(*This.sApplet)
    Debug *Class\ClassName + ": Get name: " + *This\Name
    ProcedureReturn *This\Name
  EndProcedure
  
  Procedure InitClass()
    ; Create new class
    *Class = NewClass("Applet", SizeOf(iApplet), "AppletBase")
    If *Class
      With *Class
        ; Overwrite Method Destroy
        SetMethod(Destroy)
        ; *Class\Methods\Index[OffsetOf(iMethods\Destroy()) / SizeOf(Integer)] = @Destroy()
        ; PokeI(\Methods + OffsetOf(iApplet\Destroy()), @Destroy())
        
        ; Set new methods
        SetMethod(SetName)
        SetMethod(GetName)
      EndWith
    Else
      Debug "Error: NewClass Applet"
      CallDebugger
    EndIf
  EndProcedure : InitClass()
  
EndModule

; ----

;- AppletEx

DeclareModule AppletEx
  
  Interface iAppletEx Extends Applet::iApplet
    SetValue(Value)
    GetValue()
  EndInterface
  
  Structure sAppletEx Extends Applet::sApplet
    Value.i
  EndStructure
  
  Declare New()
  
EndDeclareModule

Module AppletEx
  
  EnableExplicit
  
  UseModule ClassCommon
  
  ; Static pointer to class
  Global *Class.sClass
  
  ; Macro Interface Helper
  Interface iMethods Extends iAppletEx
  EndInterface
  
  Procedure New()
    Protected *This.sAppletEx
    
    If *Class
      *This = AllocateStructure(sAppletEx)
      If *This
        *This\vTable = *Class\Methods
      EndIf
    EndIf
    ProcedureReturn *This
  EndProcedure
  
  Procedure Show(*This.sAppletEx)
    Debug *Class\ClassName + ": Show was called"
  EndProcedure
  
  Procedure Destroy(*This.sAppletEx)
    Debug *Class\ClassName + ": Destroy was called"
    ; Free all resources here:
    ; - Do not forget to delete fonts, images, files, etc. 
    
    FreeStructure(*This)
  EndProcedure
  
  Procedure.s GetName(*This.sAppletEx)
    Debug *Class\ClassName + ": Get name: " + *This\Name + " = " + *This\Value
    ProcedureReturn *This\Name + " = " + *This\Value
  EndProcedure
  
  Procedure SetValue(*This.sAppletEx, Value)
    Debug *Class\ClassName + ": Set value: " + value
    *This\Value = Value
  EndProcedure
  
  Procedure GetValue(*This.sAppletEx)
    Debug *Class\ClassName + ": Get value: " + *This\Value
    ProcedureReturn *This\Value
  EndProcedure
  
  Procedure InitClass()
    
    *Class = NewClass("AppletEx", SizeOf(iAppletEx), "Applet")
    If *Class
      With *Class
        ; Overwrite methods
        SetMethod(Show)
        SetMethod(Destroy)
        SetMethod(GetName)
        ; Set new methods
        SetMethod(SetValue)
        SetMethod(GetValue)
      EndWith
    Else
      Debug "Error: NewClass AppletEx"
      CallDebugger
    EndIf
  EndProcedure : InitClass()
  
EndModule

; ----

;-Test

Define *Obj1.AppletBase::iAppletBase = AppletBase::New()
*Obj1\Show()

Define *Obj2.Applet::iApplet = Applet::New()

*Obj2\Show()
*Obj2\SetName("Hello World")
Debug *Obj2\GetName()

Define *Obj3.AppletEx::iAppletEx = AppletEx::New()
*Obj3\Show()
*Obj3\SetName("Result")
*obj3\SetValue(0815)
Debug *Obj3\GetName()

*Obj3\Destroy() : *Obj3 = 0
*Obj2\Destroy() : *Obj2 = 0
*Obj1\Destroy() : *Obj1 = 0

Re: Confusion on how to implement virtual tables on structures

Posted: Thu Dec 19, 2024 1:50 am
by Quin
Hi mk-soft,
Thanks for your reply! If you don't mind, would you mind explaining this a little bit more? I struggle to just take flat definitions as fact like this and want to know the reasons, know why you do it like this. What's wrong with using DataSections, and passing the VTable directly? I'm actually curious here, you've written an OOP system for PB so I'm sure you know what you're talking about, but I'm just trying to understand the logic :)
Thanks!

Re: Confusion on how to implement virtual tables on structures

Posted: Thu Dec 19, 2024 9:41 am
by mk-soft
There is nothing wrong with working with DataSection as long as you do not need inheritance of methods. This is also the right way.

With inheritance, you need a separate method table for each class to overwrite individual methods without changing the original method table.
When creating the new class, a new table is created from which the inherited methods are copied into the new class.
Here you have to know that with inheritance (Extends) the interface (and also structures) is placed in front of the new interface.

When I am at home I will document my example a little better.

Re: Confusion on how to implement virtual tables on structures

Posted: Thu Dec 19, 2024 12:59 pm
by Quin
Ah, I see, so that's more if you want inheritence. Thanks for the explaination, and I look forward to the updated version 8)

Re: Confusion on how to implement virtual tables on structures

Posted: Thu Dec 19, 2024 7:25 pm
by StarBootics
Hello everyone,

The following example show another way to do OOP and Polymorphism but without using Interfaces.

For the Color3f "Class", I have used a Global variable defined inside a Module for the virtual table. For the Material "Class", I have used an Allocated structure for the virtual table.

Code: Select all

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Project name : Polymorphic Materials
; File Name : Polymorphic Materials.pb
; File version: 1.0.0
; Programming : OK
; Programmed by : StarBootics
; Date : December 19th, 2024
; Last Update : December 19th, 2024
; PureBasic code : V6.11 LTS
; Platform : Windows, Linux, MacOS X
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

DeclareModule Color3f
  
  Structure Color3f
    Red.f
    Green.f
    Blue.f
    *vt.Color3fVirtualTable
  EndStructure
  
  Prototype.f Proto_Color3f_Get(*Color.Color3f) 
  Prototype Proto_Color3f_Set(*Color.Color3f, ColorComponent.f)
  Prototype Proto_Color3f_Update(*Color.Color3f, Red.f, Green.f, Blue.f)
  
  Structure Color3fVirtualTable
    
    GetRed.Proto_Color3f_Get
    GetGreen.Proto_Color3f_Get
    GetBlue.Proto_Color3f_Get
    SetRed.Proto_Color3f_Set
    SetGreen.Proto_Color3f_Set
    SetBlue.Proto_Color3f_Set
    Update.Proto_Color3f_Update
  
  EndStructure
  
  Declare Init(*This.Color3f, Red.f = 0.0, Green.f = 0.0, Blue.f = 0.0)
  
EndDeclareModule

Module Color3f
  
  Procedure.f Color3f_GetRed(*This.Color3f)
  
    ProcedureReturn *This\Red
  EndProcedure
  
  Procedure.f Color3f_GetGreen(*This.Color3f)
  
    ProcedureReturn *This\Green
  EndProcedure
  
  Procedure.f Color3f_GetBlue(*This.Color3f)
  
    ProcedureReturn *This\Blue
  EndProcedure
  
  Procedure Color3f_SetRed(*This.Color3f, Red.f)
    
    *This\Red = Red
    
  EndProcedure
  
  Procedure Color3f_SetGreen(*This.Color3f, Green.f)
    
    *This\Green = Green
    
  EndProcedure
  
  Procedure Color3f_SetBlue(*This.Color3f, Blue.f)
    
    *This\Blue = Blue
    
  EndProcedure
  
  Procedure Color3f_Update(*This.Color3f, Red.f, Green.f, Blue.f)
    
    *This\Red = Red
    *This\Green = Green
    *This\Blue = Blue
    
  EndProcedure
  
  Global Color3fVirtualTable.Color3fVirtualTable
  
  Color3fVirtualTable\GetRed = @Color3f_GetRed()
  Color3fVirtualTable\GetGreen = @Color3f_GetGreen()
  Color3fVirtualTable\GetBlue = @Color3f_GetBlue()
  
  Color3fVirtualTable\SetRed = @Color3f_SetRed()
  Color3fVirtualTable\SetGreen = @Color3f_SetGreen()
  Color3fVirtualTable\SetBlue = @Color3f_SetBlue()
  Color3fVirtualTable\Update = @Color3f_Update()
  
  Procedure Init(*This.Color3f, Red.f = 0.0, Green.f = 0.0, Blue.f = 0.0)
    
    *This\vt = @Color3fVirtualTable
    *This\vt\Update(*This, Red, Green, blue)
  
  EndProcedure
  
EndModule

DeclareModule Material
  
  Enumeration
    #TYPE_INVALID
    #TYPE_LAMBERTIAN
    #TYPE_METAL
  EndEnumeration
  
  Structure Lambertian
    Albedo.Color3f::Color3f
  EndStructure 
  
  Structure Metal Extends Lambertian
    Roughness.f
  EndStructure 
  
  Structure Material
    
    Type.i
    
    StructureUnion
      Lambertian.Lambertian
      Metal.Metal
    EndStructureUnion
    
    *vt.MaterialVirtualTable
    
  EndStructure
  
  Prototype.i Proto_Material_GetType(*This.Material)
  Prototype.i Proto_Material_GetInstance(*This.Material)
  Prototype Proto_Material_Wipeout(*This.Material)
  Prototype Proto_Material_DebugInstance(*This.Material)
  
  Structure MaterialVirtualTable
    GetType.Proto_Material_GetType
    GetInstance.Proto_Material_GetInstance
    Wipeout.Proto_Material_Wipeout
    DebugInstance.Proto_Material_DebugInstance
  EndStructure
  
  Declare Init_Lambertian(*This.Material, *Albedo.Color3f::Color3f)
  Declare Init_Metal(*This.Material, *Albedo.Color3f::Color3f, Roughness.f)
  
EndDeclareModule

Module Material
  
  Procedure.i Material_GetType(*This.Material)
  
    ProcedureReturn *This\Type
  EndProcedure
  
  Procedure.i Material_GetInstance(*This.Material)
    
    If *This\Type = #TYPE_LAMBERTIAN
      ProcedureReturn *This\Lambertian
    ElseIf *This\Type = #TYPE_METAL
      ProcedureReturn *This\Metal
    EndIf
    
    ProcedureReturn #Null
  EndProcedure
  
  Procedure Material_Wipeout(*This.Material)
    
    If *This\vt <> #Null
      FreeStructure(*This\vt)
      *This\vt = #Null
    EndIf
    
  EndProcedure
  
  Procedure Material_Lambertian_DebugInstance(*This.Material)
    
    Debug "I'm a Lambertian Material debugged the easy way!"
    Debug "Red = " + StrF(*This\Lambertian\Albedo\vt\GetRed(*This\Lambertian\Albedo), 3)
    Debug "Green = " + StrF(*This\Lambertian\Albedo\vt\GetGreen(*This\Lambertian\Albedo), 3)
    Debug "Blue = " + StrF(*This\Lambertian\Albedo\vt\GetBlue(*This\Lambertian\Albedo), 3)
    
  EndProcedure
  
  Procedure Material_Metal_DebugInstance(*This.Material)
    
    Debug "I'm a Metal Material debugged the easy way!"
    Debug "Red = " + StrF(*This\Metal\Albedo\vt\GetRed(*This\Metal\Albedo), 3)
    Debug "Green = " + StrF(*This\Metal\Albedo\vt\GetGreen(*This\Metal\Albedo), 3)
    Debug "Blue = " + StrF(*This\Metal\Albedo\vt\GetBlue(*This\Metal\Albedo), 3)
    Debug "Roughness = " + StrF(*This\Metal\Roughness, 3)
    
  EndProcedure
  
  Procedure Init(*This.Material, Type.i)
    
    *This\Type = Type
    *This\vt = AllocateStructure(MaterialVirtualTable)
    *This\vt\GetType = @Material_GetType()
    *This\vt\GetInstance = @Material_GetInstance()
    *This\vt\Wipeout = @Material_Wipeout()
    
  EndProcedure
  
  Procedure Init_Lambertian(*This.Material, *Albedo.Color3f::Color3f)
    
    Init(*This, #TYPE_LAMBERTIAN)
    *This\vt\DebugInstance = @Material_Lambertian_DebugInstance()
    
    Color3f::Init(*This\Lambertian\Albedo)
    
    *This\Lambertian\Albedo\vt\SetRed(*This\Lambertian\Albedo, *Albedo\vt\GetRed(*Albedo))
    *This\Lambertian\Albedo\vt\SetGreen(*This\Lambertian\Albedo, *Albedo\vt\GetGreen(*Albedo))
    *This\Lambertian\Albedo\vt\SetBlue(*This\Lambertian\Albedo, *Albedo\vt\GetBlue(*Albedo))
    
  EndProcedure
  
  Procedure Init_Metal(*This.Material, *Albedo.Color3f::Color3f, Roughness.f)
    
    Init(*This, #TYPE_METAL)
    *This\vt\DebugInstance = @Material_Metal_DebugInstance()
    
    Color3f::Init(*This\Metal\Albedo)
    
    *This\Metal\Albedo\vt\SetRed(*This\Metal\Albedo, *Albedo\vt\GetRed(*Albedo))
    *This\Metal\Albedo\vt\SetGreen(*This\Metal\Albedo, *Albedo\vt\GetGreen(*Albedo))
    *This\Metal\Albedo\vt\SetBlue(*This\Metal\Albedo, *Albedo\vt\GetBlue(*Albedo))
    *This\Metal\Roughness = Roughness
    
  EndProcedure
  
EndModule

CompilerIf #PB_Compiler_IsMainFile
  
  NewList Materials.Material::Material()
  
  AlbedoA.Color3f::Color3f
  AlbedoB.Color3f::Color3f
  
  Color3f::Init(AlbedoA, 1.0, 0.5, 0.5)
  Color3f::Init(AlbedoB, 0.25, 0.25, 0.75)
  
  AddElement(Materials())
  Material::Init_Lambertian(Materials(), AlbedoA)
  
  AddElement(Materials())
  Material::Init_Metal(Materials(), AlbedoB, 0.85)
  
  ForEach Materials()
    
    Select Materials()\vt\GetType(Materials())
        
      Case Material::#TYPE_LAMBERTIAN
        *Lambertian.Material::Lambertian = Materials()\vt\GetInstance(Materials())
        Debug "I'm a Lambertian material debugged the hard way!"
        Debug StrF(*Lambertian\Albedo\vt\GetRed(*Lambertian\Albedo), 3)
        Debug StrF(*Lambertian\Albedo\vt\GetGreen(*Lambertian\Albedo), 3)
        Debug StrF(*Lambertian\Albedo\vt\GetBlue(*Lambertian\Albedo), 3)
        
      Case Material::#TYPE_METAL
        *Metal.Material::Metal = Materials()\vt\GetInstance(Materials())
        Debug "I'm a Metal material debugged the hard way!"
        Debug StrF(*Metal\Albedo\vt\GetRed(*Metal\Albedo), 3)
        Debug StrF(*Metal\Albedo\vt\GetGreen(*Metal\Albedo), 3)
        Debug StrF(*Metal\Albedo\vt\GetBlue(*Metal\Albedo), 3)
        Debug StrF(*Metal\Roughness, 3)
        
    EndSelect 
    
    Debug ""
    
  Next
  
  Debug ""
  
  ForEach Materials()
    Materials()\vt\DebugInstance(Materials())
    Debug ""
    Materials()\vt\Wipeout(Materials())
  Next
  
CompilerEndIf

; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< END OF FILE <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<
Beat regards
StarBootics

Re: Confusion on how to implement virtual tables on structures

Posted: Thu Dec 19, 2024 7:50 pm
by mk-soft
Ok:
Update Example with Description

For complex OOP programming via macros see signature OOP-BaseClass
All times are UTC+01:00
Page 1 of 2

Powered by phpBB® Forum Software © phpBB Limited