OOP with MODULE Class & Template

graph100 · Post by **graph100** » Wed Aug 06, 2014 3:12 pm

Following a topic by microdevweb on the french forum, I tried to code some oop framework with the new MODULE thing.

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

;}

To make other classes, simply copy the MODULE template, then replace all
- 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

;}

LuckyLuke · Post by **LuckyLuke** » Thu Aug 07, 2014 11:13 am

Very cool !

Possible to add an option to clear/free all instances ?

I'll certainly will start using this module.

graph100 · Post by **graph100** » Thu Aug 07, 2014 3:40 pm

That would require to list all new instances in an internal list, maybe in 'ClassInfo'.

My experience of oop is not so good so I can tell if existing oop language can do this already.
But I imagine that it's not the point, and if the feature is practical, it's good to have

PureBasic Forums - English

OOP with MODULE Class & Template

OOP with MODULE Class & Template

Re: OOP with MODULE Class & Template

Re: OOP with MODULE Class & Template