Page 2 of 2
Re: What's the most up-to-date OOP framework for PB?
Posted: Sat Nov 10, 2012 11:43 pm
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.
Re: What's the most up-to-date OOP framework for PB?
Posted: Sat Nov 10, 2012 11:50 pm
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.
Re: What's the most up-to-date OOP framework for PB?
Posted: Sat Nov 10, 2012 11:54 pm
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.
Re: What's the most up-to-date OOP framework for PB?
Posted: Sun Nov 11, 2012 12:27 am
by BorisTheOld
For a language that doesn't "do" OOP, PB certainly seems to have a lot of it going on.
It's nice to see people pushing the bounds of the language.
Re: What's the most up-to-date OOP framework for PB?
Posted: Sun Nov 11, 2012 12:12 pm
by c4s
@luis
Thank you. Nice example, seems to be easy to follow and understand!