Simple OOP (with module, without interface or vtable)

[eddy]

• OOP module to provide some helpers
• Make code simple and readable
• No vtable, No interface
• Using prototype trick : http://www.purebasic.fr/english/viewtopic.php?p=382866
• Using macro trick : http://www.purebasic.fr/english/viewtop ... 12&t=56522
• For PB 5.30+

• Example1 Features:
  • public get/set methods
  • constructor
  • instanciate/free object instance
  Example2 Features:
  • private method used by public method
  • overriden default FreeInstance method
  • static method to count objects
  Example3 Features:
  • class inheritance

Code: Select all

DeclareModule OOP
   Macro _CONCAT(a=, b=) ; helpers used to escape some MACRO variable
      a#b
   EndMacro
   
   Macro _DQUOTE ; helpers used to build MACRO string
      "
   EndMacro
   
   Macro _COLON ; helpers used to construct nested MACRO
      : 
   EndMacro
   
   Macro UseInstanceType(T) ; determine which instance TYPE will be implemented
      Procedure.i DefaultFreeInstance_#T()
         UseInstance(*this.T)
         ClearStructure(*this.T, T)
         ProcedureReturn #Null
      EndProcedure
      UndefineMacro _CONCAT(INSTANCE, _TYPE)
      _COLON#Macro _CONCAT(INSTANCE, _TYPE)_COLON#T#_COLON#EndMacro
   EndMacro
   
   Macro Instanciate(This, ParentType=OOP::OBJECT, InstanciateParent=#Null) ; create NEW instance
      Protected *parent.ParentType=InstanciateParent
      Protected This=AllocateStructure(INSTANCE_TYPE)
      If *parent
         CopyStructure(*parent, This, ParentType)
         This\InstanceParentType$=*parent\InstanceType$
      Else
         This\InstanceParentType$="OBJECT"
      EndIf
      This\InstanceType$=_DQUOTE#INSTANCE_TYPE#_DQUOTE
      This\FreeInstance=@DefaultFreeInstance_#INSTANCE_TYPE()
      This\DefaultFreeInstance=@DefaultFreeInstance_#INSTANCE_TYPE()
   EndMacro
   
   Macro SetInstanceMethod(Method) ; init NEW instance method
      *this\Method=@Method()
   EndMacro
   
   Macro UseInstance(This) ; provide THIS instance to module method
      CompilerIf Not Defined(_CONCAT(*th, is), #PB_Variable)
         Protected This
         CompilerIf #PB_Compiler_Processor=#PB_Processor_x64
            ! MOV [p.p_this], Rbp
         CompilerElse
            ! MOV [p.p_this], Ebp
         CompilerEndIf
      CompilerEndIf
   EndMacro
   
   Prototype.i FreeInstance()
   Structure OBJECT ; instance base TYPE
      InstanceParentType$
      InstanceType$
      FreeInstance.FreeInstance
      DefaultFreeInstance.FreeInstance
   EndStructure
EndDeclareModule
Module OOP : EndModule
Macro FreeInstance(This)
   This=This\OOP::_CONCAT(Free, Instance)()
EndMacro

CompilerIf #PB_Compiler_IsMainFile
   ; ***********************
   ; EXAMPLE 1
   ; ***********************
   DeclareModule USER
      UseModule OOP
      Prototype SetName(name.s)
      Prototype.s GetName()
      
      Structure USER Extends OBJECT
         ;- public methods
         SetName.SetName
         GetName.GetName
         ;- public properties
         Name$
      EndStructure
      ;- constructor
      Declare.i InstanciateUSER()
   EndDeclareModule
   
   Module USER
      UseModule OOP
      UseInstanceType(USER)
      
      Procedure.s GetName()
         UseInstance(*this.USER)
         ProcedureReturn *this\Name$
      EndProcedure
      
      Procedure SetName(name.s)
         UseInstance(*this.USER)
         *this\Name$=name
      EndProcedure
      
      Procedure.i InstanciateUSER()
         Instanciate(*this.USER)
         SetInstanceMethod(GetName)
         SetInstanceMethod(SetName)
         *this\Name$="No name"
         ProcedureReturn *this
      EndProcedure
   EndModule
   
   ;////// create and manipulate user object
   UseModule USER
   Define *user.USER=InstanciateUSER()
   *user\SetName("Toto")
   Debug *user\GetName()
   FreeInstance(*user)
CompilerEndIf

[eddy]

Code: Select all

CompilerIf #PB_Compiler_IsMainFile
   ; ***********************
   ; EXAMPLE 2
   ; ***********************
   
   DeclareModule CAR
      UseModule OOP
      Prototype.s GetModelRef()
      Prototype.f Move(dx, dy)
      
      Structure CAR Extends OBJECT
         ;- public methods
         GetModelRef.GetModelRef
         Move.Move
         ;- public properties
         ModelRef.s
         x.i
         y.i
      EndStructure
      ;- constructor
      Declare.i InstanciateCAR(Owner$)
      ;- static method
      Declare.i CountCars()
   EndDeclareModule
   
   Module CAR
      UseModule OOP
      UseInstanceType(CAR)
      Global CountCars=0
      
      Procedure.i FreeInstance() ;- private method
         UseInstance(*this.CAR)
         Debug "This car will be destroyed: " + *this\ModelRef + ""
         CountCars - 1
         ProcedureReturn *this\DefaultFreeInstance()
      EndProcedure
      
      Procedure.f CalcDistance() ;- private method
         UseInstance(*this.CAR)
         ProcedureReturn Sqr(Pow(*this\x, 2) + Pow(*this\y, 2))
      EndProcedure
      
      Procedure.s GetModelRef()
         UseInstance(*this.CAR)
         ProcedureReturn *this\ModelRef
      EndProcedure
      
      Procedure.f Move(dx, dy)
         UseInstance(*this.CAR)
         *this\x + dx
         *this\y + dy
         ProcedureReturn CalcDistance()
      EndProcedure
      
      Procedure.i InstanciateCAR(ModelRef$)
         Instanciate(*this.CAR)
         SetInstanceMethod(FreeInstance) ;- overriden method (default method was DefaultFreeInstance)
         SetInstanceMethod(GetModelRef)
         SetInstanceMethod(Move)
         With *this
            \ModelRef=ModelRef$
            \x=0
            \y=0
         EndWith
         CountCars + 1
         ProcedureReturn *this
      EndProcedure
      
      Procedure.i CountCars()
         ProcedureReturn CountCars
      EndProcedure
   EndModule
   
   ;////// create and manipulate CAR objects
   UseModule CAR
   Define *first.CAR=InstanciateCAR("Ford")
   Define *second.CAR=InstanciateCAR("Tesla")
   Debug "Instance Pointer=" + #TAB$ + *second
   Debug "Instance Type$=" + #TAB$ + *second\InstanceType$
   Debug "Current ModelRef=" + #TAB$ + *second\GetModelRef()
   Debug "Current Distance=" + #TAB$ + *second\Move(10, 5)
   Debug "Current Location=" + #TAB$ + *second\x + "," + *second\y
   Debug "Count Cars=" + CAR::CountCars()
   FreeInstance(*second)
   Debug "Count Cars=" + CAR::CountCars()
   If *second=#Null : Debug "Second car has been destroyed!" : EndIf
CompilerEndIf

[eddy]

Code: Select all

CompilerIf #PB_Compiler_IsMainFile
   ; ***********************
   ; EXAMPLE 3
   ; ***********************
   DeclareModule ENEMY
      UseModule OOP
      Prototype.s Shoot(projectile.s)
      Prototype.s ShootLaser(Color.s)
      
      ;- PARENT object
      Structure MACHINE Extends OBJECT 
         Shoot.Shoot
         Health.i
         ShotProjectile.s
      EndStructure
      Declare.i InstanciateMACHINE(Health=10)
      
      ;- CHILD object based on PARENT object
      Structure ROBOT Extends MACHINE 
         ShootLaser.ShootLaser
         Speed.i
      EndStructure
      Declare.i InstanciateROBOT(Health, Speed)
   EndDeclareModule
   
   Module ENEMY
      UseModule OOP      
      UseInstanceType(MACHINE)      
      
      Procedure.s Shoot(projectile.s)
         UseInstance(*this.MACHINE)
         *this\ShotProjectile=projectile + " has been shot!"
         ProcedureReturn "Shooting " + projectile + "..."
      EndProcedure      
      
      Procedure.i InstanciateMACHINE(Health=10)
         Instanciate(*this.MACHINE) ;- init instance of PARENT object
         SetInstanceMethod(Shoot)
         *this\Health=Health
         ProcedureReturn *this
      EndProcedure
   
      UseInstanceType(ROBOT)      
      
      Procedure.s ShootLaser(Color.s="Red")
         UseInstance(*this.ROBOT)
         ProcedureReturn *this\Shoot(Color + " Laser")
      EndProcedure
      
      Procedure.i InstanciateROBOT(Health, Speed)
         Instanciate(*this.ROBOT, MACHINE, InstanciateMACHINE(Health)) ;- init instance of CHILD object via Inheritance
         SetInstanceMethod(ShootLaser)
         *this\Speed=Speed
         ProcedureReturn *this
      EndProcedure
   EndModule
   
   ;////// create and manipulate MACHINE and ROBOT objects
   Define *machine.ENEMY::MACHINE=ENEMY::InstanciateMACHINE()
   Debug #LF$ + "This " + *machine\InstanceType$ + " is a kind of " + *machine\InstanceParentType$
   Debug *machine\Health
   Debug *machine\Shoot("MISSILE")
   Debug *machine\ShotProjectile
   FreeInstance(*machine)
   Define *robot.ENEMY::ROBOT=ENEMY::InstanciateROBOT(100, 150)
   Debug #LF$ + "This " + *robot\InstanceType$ + " is a kind of " + *robot\InstanceParentType$
   Debug *robot\Health
   Debug *robot\Speed
   Debug *robot\ShootLaser("GREEN")
   Debug *robot\ShotProjectile
   FreeInstance(*robot)
CompilerEndIf

[Kwai chang caine]

Perhaps a new reason for like OOP a day
Thanks for sharing

[idle]

looks interesting, thanks for sharing.

[eddy]

I'm looking for elegant way to manage type casting

[Lunasole]

Wow, that seems to be perfect & tiny user-solution for some basic OOP like "class modules". Don't know why I didn't seen this thread before (just remember how tried outdated precompilers for PB 4.x).
Hope it will work fine on practice. Thanks for posting anyway

[GPI]

What exactly does this lines:

Code: Select all

       Macro UseInstance(This) ; provide THIS instance to module method
          CompilerIf Not Defined(_CONCAT(*th, is), #PB_Variable)
             Protected This
             CompilerIf #PB_Compiler_Processor=#PB_Processor_x64
                ! MOV [p.p_this], Rbp
             CompilerElse
                ! MOV [p.p_this], Ebp
             CompilerEndIf
          CompilerEndIf
       EndMacro

[NicTheQuick]

I am also quite interested in what that Macro does.

[Lunasole]

Well I had to spend some time trying to understand how all this magic works before using it.
There are some limits if I'm not wrong:
- cannot use static variables inside of class methods : they will be the same for all instances
- cannot define private properties inside class : they will be the same for all instances

So, all properties should be defined in "public" and always are visible. That is a bit unhandy, but in total not a minus, cause it follows from authors system is not complicated and there is no full inheritance of all class code, so no speed lost / memory overhead.

What about *this pointer, that's so damn nice hack . I just got it gets instance-related structure pointer from EBP register [if 32-bit app] on every method call and defines it as protected variable inside method, but how it all works exactly on lower level I didn't get. Maybe someone sitting with assembler can explain.

[Lunasole]

After other tests, just exposed some another limit: passing structure fields as arguments to public methods leads to memory corruption and Purifier's stop message "Overflow in the global data block."

For example, try such code with "Example 2":

Code: Select all

Structure Problem 
	A0.l
	A1.l
	A2.l
	A3.l
	A4.l
	A5.l
	A6.l
	A7.l
EndStructure
Global F.Problem

*second\Move(F\A0, 20)

Very sad, that limit seems to be serious crap unlike previous. If sending regular variables (not structure members) there is no such problem.

[Lunasole]

I spend this day messing with assembler and trying to find a way to get pointer of structure which calls method, but this all seems to be a bullshit.
Sometimes it's pointer comes in EBP/RBP register, in such cases this Simple OOP works fine.
In some other cases I was able to get address this way, it also was fine

Code: Select all

Protected Mark.l ; declared right at procedure beginning
CopyMemory(@Mark - 8, @This, 4)

But in all others PB gives such a shit where that address not even mentioned in stack or registers and this breaks any attempts to make simple OOP such way, of course if you don't know PB inside.
This all makes me tired and angry, cause I was counting on such a simple and nice realization to allow using classes. What a stupidity to waste all such realizations instead of add one of them to language and let it be for those who needs? Not anyone uses PB only to play with assembler and pointers at long winter nighs, damn.
That's all really sad cause I definitely need some very basic classes in my game (else I will drown in all the shit of procedures or ugly pseudo-oop in C style).