Because I'm not an oop expert, I would like to hear your opinion about the usability of the following code in a big project.
(Since I didn't have time to try this now).
[EDIT] :
- Added the listing of all instance of a class
- FreeAll() for each class : use like Create() : " ClassName::FreeAll() "
Here is the base MODULE, with the generic class Class.
Code: Select all
;{ MODULE Class
CompilerIf Defined(Class, #PB_Module) = #False
DeclareModule Class
Structure ClassInfo
*vTable
ClassName.s
*ClassParent.ClassInfo
function_count.l
Object_Instance.l
List *Object()
EndStructure
Global ClassInfo.ClassInfo
; Function
Interface Function
Free()
GetClassInfo.i()
EndInterface
; Structure Data holder
Structure Struct_DATA
*vTable
*Class.ClassInfo
*adr_reference
EndStructure
; Creator declaration
Macro Init(_obj_)
_obj_ = AllocateMemory(SizeOf(Struct_DATA))
InitializeStructure(_obj_, Struct_DATA)
_obj_\vTable = ClassInfo\vTable
_obj_\Class = @ClassInfo
ClassInfo\Object_Instance + 1
_obj_\adr_reference = AddElement(ClassInfo\Object())
PokeI(_obj_\adr_reference, _obj_)
EndMacro
Macro Destroy(_obj_)
ChangeCurrentElement(ClassInfo\Object(), _obj_\adr_reference)
DeleteElement(ClassInfo\Object())
FreeMemory(_obj_)
ClassInfo\Object_Instance - 1
EndMacro
Macro DQUOTE
"
EndMacro
; Macro for vTable manipulation
Macro Function_INHERIT_FROM_CLASS(_Class_)
ClassInfo\vTable = AllocateMemory(SizeOf(Function))
ClassInfo\ClassName = #PB_Compiler_Module
ClassInfo\ClassParent = _Class_#@ClassInfo
; héritage
CopyMemory(_Class_#ClassInfo\vTable, ClassInfo\vTable, SizeOf(_Class_#Function))
ClassInfo\function_count = SizeOf(_Class_#Function) / SizeOf(Integer)
EndMacro
Macro Function_OVERRIDE(_Function_, _Interface_Function_=) ; Use _Interface_Function_ ( without () ) if the name is different
CompilerIf Class::DQUOTE#_Interface_Function_#Class::DQUOTE = ""
PokeI(ClassInfo\vTable + OffsetOf(Function\_Function_), @_Function_)
CompilerElse
PokeI(ClassInfo\vTable + OffsetOf(Function\_Interface_Function_()), @_Function_)
CompilerEndIf
EndMacro
Macro Function_ADD(_Function_)
PokeI(ClassInfo\vTable + ClassInfo\function_count * SizeOf(Integer), @_Function_)
ClassInfo\function_count + 1
EndMacro
EndDeclareModule
Module Class
ClassInfo\vTable = AllocateMemory(SizeOf(Function))
ClassInfo\ClassName = #PB_Compiler_Module
; Commodity
Procedure.i Get_Class_Info(*obj.Struct_DATA)
ProcedureReturn *obj\Class
EndProcedure
; Destructor
Procedure Free(*obj.Struct_DATA)
Class::Destroy(*obj)
EndProcedure
; Add function in vTable
Function_ADD(Free())
Function_ADD(Get_Class_Info())
EndModule
CompilerEndIf
;}
;{ MODULE CLASS_NAME_HERE : parent = PARENT_CLASS_NAME_HERE (Template)
; IncludeFile "MODULE_Class.pb"
CompilerIf 0 ; TO REMOVE
DeclareModule CLASS_NAME_HERE
Global ClassInfo.Class::ClassInfo
; Function
Interface Function Extends PARENT_CLASS_NAME_HERE::Function
; TO DO : yourNEW_function.l(param1)
EndInterface
; Structure Data holder
Structure Struct_DATA Extends PARENT_CLASS_NAME_HERE::Struct_DATA
; TO DO : champ1.l
EndStructure
; Inheritance of existing functions
Class::Function_INHERIT_FROM_CLASS(PARENT_CLASS_NAME_HERE::)
; Creator declaration
Declare.i Create()
Declare FreeAll()
EndDeclareModule
Module CLASS_NAME_HERE
; Constructor
Procedure.i Create()
Class::Init(*obj.Struct_DATA)
; TO DO : *obj\champ1 = ...
ProcedureReturn *obj
EndProcedure
; Methods
; TO DO : Procedure.l your_new_function(*obj.Struct_DATA, param1, ...)
; Destructor
Procedure Free(*obj.Struct_DATA)
; TO DO : special free procedure if allocated object are in *obj.Struct_DATA
; DO Not DO a ClearStructure(*obj, Struct_DATA)
; or save *obj\adr_reference and re - set it after the clear like :
; *tmp = *obj\adr_reference
; ClearStructure(*obj, Struct_DATA)
; *obj\adr_reference = *tmp
; *obj MUST still be valid here, and *obj\adr_reference must still point on the rigth element in ClassInfo\Object()
; if not, an IMA will be probable, sooner or later.
Class::Destroy(*obj)
EndProcedure
; Destruct ALL
Procedure FreeAll()
While ListSize(ClassInfo\Object())
FirstElement(ClassInfo\Object())
Free(ClassInfo\Object())
Wend
EndProcedure
; Destructor override
Class::Function_OVERRIDE(Free())
; Add function in vTable
; TO DO : Class::Function_ADD(your_new_function())
EndModule
CompilerEndIf ; TO REMOVE
;}
- CLASS_NAME_HERE by your new class name
- PARENT_CLASS_NAME_HERE by you new class parent class ('Class' if no parent)
To try it with an example, name the 1rs code "MODULE_Class.pb" then launch the following :
Or you can just add it at the end of the 1rs code.
Code: Select all
;{ EXAMPLE :
CompilerIf #PB_Compiler_IsMainFile
;{ MODULE Voiture : parent = Class
DeclareModule Voiture
Global ClassInfo.Class::ClassInfo
; Function
Interface Function Extends Class::Function
Avance(Vitesse.d)
GetPuissance.l()
EndInterface
; Structure Data holder
Structure Struct_DATA Extends Class::Struct_DATA
Puissance.i
Couleur.i
x.l
EndStructure
; Inheritance of existing functions
Class::Function_INHERIT_FROM_CLASS(Class::)
; Creator declaration
Declare.i Create()
Declare FreeAll()
EndDeclareModule
Module Voiture
; Constructor
Procedure.i Create()
Class::Init(*obj.Struct_DATA)
*obj\x = 50
*obj\Puissance = 1000
ProcedureReturn *obj
EndProcedure
; Methods
Procedure Avance(*v.Struct_DATA, v.d)
*v\x + v
Debug *v\x
EndProcedure
Procedure.l Get_Puissance(*v.Struct_DATA)
ProcedureReturn *v\Puissance
EndProcedure
; Destructor
Procedure Free_voiture(*obj.Struct_DATA)
Debug "Destructor for Class : Voiture"
Class::Destroy(*obj)
EndProcedure
; Destruct ALL
Procedure FreeAll()
While ListSize(ClassInfo\Object())
FirstElement(ClassInfo\Object())
Free_voiture(ClassInfo\Object())
Wend
EndProcedure
; Destructor override
Class::Function_OVERRIDE(Free_voiture(), Free)
; Add function in vTable
Class::Function_ADD(Avance())
Class::Function_ADD(Get_Puissance())
EndModule
;}
;{ MODULE Peugeot : parent = Voiture
DeclareModule Peugeot
Global ClassInfo.Class::ClassInfo
; Function
Interface Function Extends Voiture::Function
GetName.s()
SetName(Name.s)
EndInterface
; Structure Data holder
Structure Struct_DATA Extends Voiture::Struct_DATA
name.s
EndStructure
; Inheritance of existing functions
Class::Function_INHERIT_FROM_CLASS(Voiture::)
; Creator declaration
Declare.i Create()
Declare FreeAll()
EndDeclareModule
Module Peugeot
; Constructor
Procedure.i Create()
Class::Init(*obj.Struct_DATA)
*obj\x = 50
*obj\Puissance = 2000
ProcedureReturn *obj
EndProcedure
; Methods
Procedure.s Get_Name(*v.Struct_DATA)
ProcedureReturn *v\name
EndProcedure
Procedure.s Set_Name(*v.Struct_DATA, name.s)
*v\name = name
EndProcedure
; Destructor
Procedure Free(*obj.Struct_DATA)
Debug "Destructor for Class : Peugeot"
Class::Destroy(*obj)
EndProcedure
; Destruct ALL
Procedure FreeAll()
While ListSize(ClassInfo\Object())
FirstElement(ClassInfo\Object())
Free(ClassInfo\Object())
Wend
EndProcedure
; Destructor override
Class::Function_OVERRIDE(Free())
; Add function in vTable
Class::Function_ADD(Get_Name())
Class::Function_ADD(Set_Name())
EndModule
;}
;{ Test
Debug "voiture"
Debug " "
*Voiture.Voiture::Function = Voiture::Create()
*Voiture\Avance(1)
Debug *Voiture\GetPuissance()
Debug " "
Debug "Peugeot"
Debug " "
*my_car.Peugeot::Function = Peugeot::Create()
*my_car\Avance(10)
Debug *my_car\GetPuissance()
Debug *my_car\GetName()
Debug ""
Debug "info générale : "
Debug ""
Debug "Class : " + Voiture::ClassInfo\ClassName
Debug "Nb instance : " + Voiture::ClassInfo\Object_Instance
Debug "Class Parent : " + Voiture::ClassInfo\ClassParent\ClassName
Debug ""
Debug "Class : " + Peugeot::ClassInfo\ClassName
Debug "Nb instance : " + Peugeot::ClassInfo\Object_Instance
Debug "Class Parent : " + Peugeot::ClassInfo\ClassParent\ClassName
Debug ""
Debug "info on '*my_car' : "
Debug ""
*class_info.Class::ClassInfo = *my_car\GetClassInfo()
Debug "Class : " + *class_info\ClassName
Debug "Nb instance : " + *class_info\Object_Instance
Debug "Class Parent : " + *class_info\ClassParent\ClassName
Debug ""
Debug ""
Debug "Free existing peugeot"
*my_car\Free()
Debug "NB peugeot = " + Peugeot::ClassInfo\Object_Instance
Debug ""
Debug "some creation : "
*car1.Peugeot::Function = Peugeot::Create()
*car2.Peugeot::Function = Peugeot::Create()
*car3.Peugeot::Function = Peugeot::Create()
*car4.Peugeot::Function = Peugeot::Create()
*car1\SetName("christine")
*car2\SetName("carole")
*car3\SetName("caroline")
*car4\SetName("christelle")
ForEach Peugeot::ClassInfo\Object()
*car.Peugeot::Function = Peugeot::ClassInfo\Object()
Debug *car\GetName()
Next
;}
CompilerEndIf
;}