What's the most up-to-date OOP framework for PB?

Everything else that doesn't fall into one of the other PB categories.
User avatar
skywalk
Addict
Addict
Posts: 3532
Joined: Wed Dec 23, 2009 10:14 pm
Location: Boston, MA

Re: What's the most up-to-date OOP framework for PB?

Post by skywalk »

luis wrote:
skywalk wrote: What do you mean by?
luis wrote: the simplicity in the implementation is lost here in the application.
I mean: the preparation of the "objects" can be maybe easier, but if you have to pass the object every time you invoke the method the tradeoff is you have redundancy when you are using the objects. Something like V1\getX(V1) is a deal breaker for me. :)
skywalk wrote: Is this a significant performance hit?
Not at all. Only a larger footprint, something that can be avoided with another approach, that's all. Generally the idea is to avoid redundancy when possible (unless it's for integrity reasons).
Don't get me wrong, I like the idea of an Interface, but I find the DataSection VirtualTable inelegant.
I can suffer a small redundancy for clarity of understanding and fewer lines to type.
The nice thing about standards is there are so many to choose from. ~ Andrew Tanenbaum
User avatar
luis
Addict
Addict
Posts: 3706
Joined: Wed Aug 31, 2005 11:09 pm
Location: Italy
Contact:

Re: What's the most up-to-date OOP framework for PB?

Post by luis »

The scary stuff, written once for all (updated to 1.03)

BaseClass.pb

Code: Select all

; BaseClass.pb
; This is the base class (and the associated support macros) shared by all the classes created by myself.
; So it is included in every class definition I make.
; v1.03 by Luis, PB 5.00, 15 Nov 2012

CompilerIf Defined(BaseClass, #PB_Structure) = #False

; SHARED INFO COMMON TO ALL INSTANCES OF THIS CLASS
  
 Structure SharedClass
  NumberOfIstances.i ; the current number of instances
  ClassName$ ; the name of the class 
 EndStructure

; BASE CLASS DEFINITION

 Structure BaseClass
  *vtable ; virtual table pointer 
  *shared.SharedClass ; shared data pointer  
 EndStructure

; BASE OBJECT DEFINITION

Interface BaseObject
 GetClassName$() ; get the name of the class 
EndInterface

 ; VIRTUAL TABLE START

 Macro VTABLE_START (YOUR_CLASS_NAME)
  DataSection
  vtable_#YOUR_CLASS_NAME#: 
  Data.i @YOUR_CLASS_NAME#_GetClassName()
 EndMacro

 ; VIRTUAL TABLE END

 Macro VTABLE_END
  EndDataSection
 EndMacro

 ; DOUBLE QUOTE
 Macro CLASS_DQUOTE
  "
 EndMacro

 Macro CLASS_SUPPORT_CODE (YOUR_CLASS_NAME) 
  Define *YOUR_CLASS_NAME#_Shared.SharedClass  
  
  ;// GENERATE DEFAULT CONSTRUCTOR -> [YOUR_CLASS_NAME]_AllocateMemory()
  
  Procedure YOUR_CLASS_NAME#_AllocateMemory()    
    Shared *YOUR_CLASS_NAME#_Shared.SharedClass  
    Protected *this.YOUR_CLASS_NAME#Class = AllocateMemory(SizeOf(YOUR_CLASS_NAME#Class))
    
    If *this
        ; Allocate the shared data, if needed ...        
        If *YOUR_CLASS_NAME#_Shared = 0 ; this is the first instance
            *YOUR_CLASS_NAME#_Shared = AllocateMemory(SizeOf(SharedClass))
        EndIf
    
        ; set vtable
        *this\vtable = ?vtable_#YOUR_CLASS_NAME

        ; set the class name
        *this\shared = *YOUR_CLASS_NAME#_Shared
        *this\shared\ClassName$ = CLASS_DQUOTE#YOUR_CLASS_NAME#CLASS_DQUOTE        
                        
        ; instances counter + 1
        *this\shared\NumberOfIstances + 1                 
    EndIf    
    ProcedureReturn *this
  EndProcedure
    
  
  ;// GENERATE STATIC PROCEDURE -> [YOUR_CLASS_NAME]_Instances()
  
  Procedure.i YOUR_CLASS_NAME#_Instances() 
    Shared *YOUR_CLASS_NAME#_Shared.SharedClass
    
    If *YOUR_CLASS_NAME#_Shared 
        ProcedureReturn *YOUR_CLASS_NAME#_Shared\NumberOfIstances
    EndIf
    
    ProcedureReturn 0
  EndProcedure
  
  
  ;// GENERATE DEFAULT DESTRUCTOR -> [YOUR_CLASS_NAME]_FreeMemory(*this)
  
  Procedure YOUR_CLASS_NAME#_FreeMemory(*this.YOUR_CLASS_NAME#Class)
    Shared *YOUR_CLASS_NAME#_Shared.SharedClass
    
    If *this        
        ; instances counter - 1
        *this\shared\NumberOfIstances - 1
  
        ; no instances left      
        If *this\shared\NumberOfIstances = 0
            FreeMemory(*YOUR_CLASS_NAME#_Shared) : *YOUR_CLASS_NAME#_Shared = 0
        EndIf
        
        ClearStructure(*this, YOUR_CLASS_NAME#Class)
        
        FreeMemory(*this)
    EndIf    
  EndProcedure

  
  ;// GENERATE DEFAULT METHOD -> [YOUR_CLASS_NAME]_GetClassName(*this)
  
  Procedure.s YOUR_CLASS_NAME#_GetClassName(*this.YOUR_CLASS_NAME#Class)
    ProcedureReturn *this\shared\ClassName$    
  EndProcedure
  
 EndMacro

CompilerEndIf

The template I fill in when starting a new class, Template.pb

Code: Select all

EnableExplicit

; Include the base class shared by all objects

XIncludeFile "BaseClass.pb"

;********************************************************************
;- CONSTANTS
;********************************************************************

;********************************************************************
;- CLASS STRUCTURE
;********************************************************************

; Always extend it from BaseClass

Structure [YOUR_CLASS_NAME]Class Extends BaseClass 
 ; TODO
EndStructure

;********************************************************************
;- GENERATE SUPPORT CODE
;********************************************************************

CLASS_SUPPORT_CODE ([YOUR_CLASS_NAME])

;********************************************************************
;- OBJECT CREATION
;********************************************************************

Procedure.i New_[YOUR_CLASS_NAME]()
 Protected *this.[YOUR_CLASS_NAME]Class
 
 ; If the class must be a singleton we have to put the check in here: 
 
 ; If [YOUR_CLASS_NAME]_Count() = 1
 ;   ProcedureReturn 0 ; only one instance
 ; EndIf 
  
 ; Must invoke *at least* [YOUR_CLASS_NAME]_AllocateMemory()  
 
 *this = [YOUR_CLASS_NAME]_AllocateMemory()
 
 ; And then it must initialize the class instance ...
 
 If *this    
    ; TODO    
 EndIf 
 
 ProcedureReturn *this
EndProcedure

;********************************************************************
;- PUBLIC METHODS
;********************************************************************

Procedure [YOUR_CLASS_NAME]_Destroy (*this.[YOUR_CLASS_NAME]Class)
 ; The allocated class data, if any, must be freed here  
 ; example: Freememory (*this\ptr)
 
 ; At the end, it must invoke *at least* [YOUR_CLASS_NAME]_FreeMemory() 
 ; It will invoke automatically a ClearStructure() followed by a FreeMemory() on the class structure.
 
 [YOUR_CLASS_NAME]_FreeMemory (*this)
EndProcedure


;********************************************************************
;- CLASS INTERFACE
;********************************************************************

; Use [YOUR_CLASS_NAME] for the interface name, and always extend from BaseObject

Interface [YOUR_CLASS_NAME] Extends BaseObject
 Destroy()
 ; TODO
EndInterface

;********************************************************************
;- VIRTUAL TABLE 
;********************************************************************

; The list order MUST match the one used for the interface 

VTABLE_START ([YOUR_CLASS_NAME])
 Data.i @[YOUR_CLASS_NAME]_Destroy()
 ; TODO
VTABLE_END

When I create a class I load up template.pb, find/replace all [YOUR_CLASS_NAME] with the name of my new class, for example Triangle and save the file under the new name TriangleClass.pb.

Then I start to write the code for it, an example is in the next post.
Last edited by luis on Fri Nov 30, 2012 3:23 pm, edited 3 times in total.
User avatar
luis
Addict
Addict
Posts: 3706
Joined: Wed Aug 31, 2005 11:09 pm
Location: Italy
Contact:

Re: What's the most up-to-date OOP framework for PB?

Post by luis »

Implementation of a simple class, Triangle.

Code: Select all

EnableExplicit

; Include the base class shared by all objects

XIncludeFile "BaseClass.pb"

;********************************************************************
;- CONSTANTS
;********************************************************************

;********************************************************************
;- CLASS STRUCTURE
;********************************************************************

; Always extend it from BaseClass

Structure TriangleClass Extends BaseClass 
 SideA.f
 SideB.f
 SideC.f
EndStructure

;********************************************************************
;- GENERATE SUPPORT CODE
;********************************************************************

CLASS_SUPPORT_CODE (Triangle)

;********************************************************************
;- OBJECT CREATION
;********************************************************************

Procedure.i New_Triangle(a.f = 1.0, b.f = 1.0, c.f = 1.0)
 Protected *this.TriangleClass
 
 ; If the class must be a singleton we have to put the check in here: 
 
 ; If Triangle_Count() = 1
 ;   ProcedureReturn 0 ; only one instance
 ; EndIf 
  
 ; Must invoke *at least* Triangle_AllocateMemory()  
 
 *this = Triangle_AllocateMemory()
 
 ; And then it must initialize the class instance ...
 
 If *this    
    *this\SideA = a
    *this\SideB = b
    *this\SideC = c
 EndIf 
 
 ProcedureReturn *this
EndProcedure

;********************************************************************
;- PUBLIC METHODS
;********************************************************************

Procedure Triangle_Destroy (*this.TriangleClass)
 ; The allocated class data, if any, must be freed here  
 ; example: Freememory (*this\ptr)
 
 ; At the end, it must invoke *at least* [YOUR_CLASS_NAME]_FreeMemory() 
 ; It will invoke automatically a ClearStructure() followed by a FreeMemory() on the class structure.

 Triangle_FreeMemory (*this)
EndProcedure

Procedure.f Triangle_CalcPerimeter (*this.TriangleClass)
 ProcedureReturn *this\SideA + *this\SideB + *this\SideC
EndProcedure

Procedure.f Triangle_CalcArea (*this.TriangleClass)
 Protected fHalfPerim.f = Triangle_CalcPerimeter(*this) / 2.0
 ProcedureReturn Sqr(fHalfPerim * (fHalfPerim - *this\SideA) * (fHalfPerim - *this\SideB) * (fHalfPerim - *this\SideC))  
EndProcedure

Procedure Triangle_Dump (*this.TriangleClass)
 Debug "A = " + StrF(*this\SideA, 2)
 Debug "B = " + StrF(*this\SideB, 2)
 Debug "C = " + StrF(*this\SideC, 2)
EndProcedure

;********************************************************************
;- CLASS INTERFACE
;********************************************************************

; Use Triangle for the interface name, and always extend from BaseObject

Interface Triangle Extends BaseObject
 Destroy()
 CalcPerimeter.f()
 CalcArea.f()
 Dump()
EndInterface

;********************************************************************
;- VIRTUAL TABLE 
;********************************************************************

; The list order MUST match the one used for the interface 

VTABLE_START (Triangle)
 Data.i @Triangle_Destroy()
 Data.i @Triangle_CalcPerimeter()
 Data.i @Triangle_CalcArea()
 Data.i @Triangle_Dump()
VTABLE_END

Usage example:

Code: Select all

EnableExplicit

IncludeFile "TriangleClass.pb" 

Define T1.Triangle = New_Triangle (1.0, 2.5, 3.0)
Define T2.Triangle = New_Triangle () ; defaults

Define *Unknown.BaseObject ; predefined object always available 


If T1 And T2
    T1\Dump()    
    Debug "Perimeter T1 = " + T1\CalcPerimeter()
    Debug "Area T1 = " + T1\CalcArea()
    Debug ""
           
    T2\Dump()
    Debug "Perimeter T2 = " + T2\CalcPerimeter()
    Debug "Area T2 = " + T2\CalcArea()
    Debug ""
    
    ; You automagically have a GetClassName$() method 
    ; Can be useful when dealing with pointers to unknown objects    
        
    *Unknown = T1 ; I don't know what type of object T1 is, *Unknown is a BaseObject and fit EVERY possible object
    
    Debug "Unkwnown type is " + *Unknown\GetClassName$() ; with this I can discover what it is
    Debug "" 

    ; And you automagically have a static procedure [YOUR_CLASS_NAME]_Instances()
    ; Could be useful for debugging.
    
    Debug "Instances = " + Triangle_Instances() ; 2 instances
    Debug ""
    
    Debug "Destroy T2"
    T2\Destroy()
        
    Debug "Instances = " + Triangle_Instances() ; 1 
    Debug "" 
        
    Debug "Destroy T1"
    T1\Destroy()
    
    Debug "Instances = " + Triangle_Instances() ; 0 
    Debug "" 
EndIf

That's all.
Last edited by luis on Sat Mar 30, 2013 9:21 pm, edited 3 times in total.
BorisTheOld
Enthusiast
Enthusiast
Posts: 542
Joined: Tue Apr 24, 2012 5:08 pm
Location: Ontario, Canada

Re: What's the most up-to-date OOP framework for PB?

Post by BorisTheOld »

For a language that doesn't "do" OOP, PB certainly seems to have a lot of it going on. :mrgreen:

It's nice to see people pushing the bounds of the language.
For ten years Caesar ruled with an iron hand, then with a wooden foot, and finally with a piece of string.
~ Spike Milligan
c4s
Addict
Addict
Posts: 1981
Joined: Thu Nov 01, 2007 5:37 pm
Location: Germany

Re: What's the most up-to-date OOP framework for PB?

Post by c4s »

@luis
Thank you. Nice example, seems to be easy to follow and understand!
If any of you native English speakers have any suggestions for the above text, please let me know (via PM). Thanks!
Post Reply