Another OOP example with interfaces and macros

[luis]

Hi folks.

Don't know if this approach as been used before (I use the interface like a pointer to allocate the data structure on construction and to deallocate and invalidate the object on distruction).

I prefer to avoid the use of a parser for various reason and I tried to do what I can using the macros.

Would be very nice if PB would permit the undefine of a costant BTW.

For example #PB_CONST = "string"

and then CompilerUndef #PB_CONST or something like that.

This would permit to use them with macros like variables of some sort.

At least that would be my use.

Anyway, back on topic.

If you have comments, criticism or whatever, let me know.

I especially dislike the need to write so many times the prototype of a funcion (interface, declare, vtable, actual procedure) but I guess without a preprocessor it's the only way to go. Or not ?

Code: Select all

XIncludeFile "OBJ_MACROS.PBI"

;********************************************************************
;*
;* CLASS DEFINITION
;*
;********************************************************************

CLASS_DATA (C_DOG)
 
 ; class members 
 
 m_sName.s 
 m_lAge.l
 
CLASS_METHODS (C_DOG)
 
 ; classe methods
 
 Bark (lTimes.l) 
 Sleep ()
 Talk()
 
 ; methods for properties access / setting
  
 GetName.s ()
 SetName (sName.s) 
 
 GetAge.l ()
 SetAge (lAge.l) 
  
CLASS_END (C_DOG)


;********************************************************************
;*
;* VTABLE DEFINITION
;*
;********************************************************************

Declare     C_DOG_Bark      (THIS(C_DOG),   lTimes.l)
Declare     C_DOG_Sleep     (THIS(C_DOG))
Declare     C_DOG_Talk      (THIS(C_DOG))
Declare.s   C_DOG_GetName   (THIS(C_DOG))
Declare     C_DOG_SetName   (THIS(C_DOG),   sName.s)
Declare.l   C_DOG_GetAge    (THIS(C_DOG))
Declare     C_DOG_SetAge    (THIS(C_DOG),   lAge.l)
 

VTABLE (C_DOG)

 Data.l @C_DOG_Bark ()
 Data.l @C_DOG_Sleep ()
 Data.l @C_DOG_Talk ()
 
 Data.l @C_DOG_GetName ()
 Data.l @C_DOG_SetName ()  

 Data.l @C_DOG_GetAge ()
 Data.l @C_DOG_SetAge ()  

VTABLE_END

;********************************************************************
;*
;* CONSTRUCTOR - MUST ALWAYS BE DEFINED EVEN IF EMPTY
;*
;********************************************************************

Procedure C_DOG_C_DOG (THIS(C_DOG))
 Debug "C_DOG constructor called"
EndProcedure

;********************************************************************
;*
;* DESTRUCTOR - MUST ALWAYS BE DEFINED EVEN IF EMPTY
;*
;********************************************************************

Procedure C_DOG_C_DOG_ (THIS(C_DOG)) 
 Debug "C_DOG destructor called"
EndProcedure


;********************************************************************
;*
;* CLASS METHODS
;*
;********************************************************************


Procedure C_DOG_Bark (THIS(C_DOG), lTimes.l)
 
 Protected k.l
 
 For k = 1 To lTimes
    Debug "WOOF !"
 Next

EndProcedure

Procedure C_DOG_Sleep (THIS(C_DOG)) 
 Debug "Ronf, ronf, zzz ..."
EndProcedure

Procedure C_DOG_Talk (THIS(C_DOG)) 
 
 ; this way (encapsulated)
 Debug "My name is : " + C_DOG_GetName (*This) + " and I'm "+ Str(C_DOG_GetAge (*This)) + " years old."
 
 ; or this way (direct)
 ; Debug "My name is : " + *This\m_sName + " and I'm "+ Str(*This\m_lAge) + " years old."
 
EndProcedure
 
Procedure.s C_DOG_GetName (THIS(C_DOG))
 ProcedureReturn *This\m_sName
EndProcedure

Procedure C_DOG_SetName (THIS(C_DOG), sName.s) 
 *This\m_sName = sName       
EndProcedure

Procedure.l C_DOG_GetAge (THIS(C_DOG))
 ProcedureReturn *This\m_lAge
EndProcedure

Procedure C_DOG_SetAge (THIS(C_DOG), lAge.l) 
 *This\m_lAge = lAge       
EndProcedure
 


;********************************************************************
;*
;* USAGE EXAMPLE
;*
;********************************************************************


Global k.l, sName.s, lAge.l

Global Dim oDog.C_DOG(4)


Restore lbl_dogs

For k = 0 To 4
    NEW (oDog(k), C_DOG) ; if allocation fail, the object will be #Null
    
    If oDog(k) ; test for object validity

        Read sName
        Read lAge
        
        oDog(k)\SetName(sName)
        oDog(k)\SetAge (lAge)
    
        oDog(k)\Sleep()
        oDog(k)\Bark(k)
        oDog(k)\Talk()                
    EndIf
    
    Debug ""
    
Next

For k = 0 To 4
    DELETE (oDog(k), C_DOG) ; deallocate object, calling destructor before
Next

DataSection : lbl_dogs:

Data.s "Oliver" : Data.l 2
Data.s "Gustav" : Data.l 4
Data.s "Minou"  : Data.l 1
Data.s "Fuffi"  : Data.l 5
Data.s "Poldo"  : Data.l 8

An this is the include

Code: Select all

;**********************************************************************
;*
;* MACROS FOR SIMPLE CLASS AND OBJECTS IMPLEMENTATION IN PUREBASIC 4.02
;*
;**********************************************************************

Macro THIS (class_name)
 *This.t#class_name
EndMacro

Macro CLASS_DATA (class_name)
 Structure t#class_name : Virtual.l 
EndMacro 

Macro CLASS_METHODS (class_name)
 EndStructure

 Interface class_name
  class_name#()
  class_name#_()

EndMacro

Macro CLASS_END (class_name)
  EndInterface

 Declare class_name#_#class_name (*This.t#class_name)
 Declare class_name#_#class_name#_ (*This.t#class_name)
EndMacro

Macro VTABLE (class_name)
 Global *internal_t#class_name.t#class_name
 
 DataSection : class_name#_Virtual :
 
  Data.l @class_name#_#class_name#()
  Data.l @class_name#_#class_name#_()   
EndMacro
 
Macro VTABLE_END
  EndDataSection   
EndMacro
 
Macro NEW (oName, class_name)
 *internal_t#class_name = AllocateMemory(SizeOf(t#class_name))
 If *internal_t#class_name
    *internal_t#class_name\Virtual = ?class_name#_Virtual
    oName = *internal_t#class_name 
    oName\class_name#()    
 EndIf
EndMacro

Macro DELETE (oName, class_name)
 oName\class_name#_()    
 *internal_t#class_name = oName
 FreeMemory(*internal_t#class_name)
 oName = #Null
EndMacro

[dell_jockey]

If you have comments, criticism or whatever, let me know.

Using this method you indeed end up with objects, ie. methods bound to instantiated data or v.v., whatever your perpective is. Encapsulation like this is a very good thing, but it's only part of OOP. How would you implement inheritance, polymorphism, object persistence and the like?

I especially dislike the need to write so many times the prototype of a funcion (interface, declare, vtable, actual procedure) but I guess without a preprocessor it's the only way to go. Or not ?

The other way around would be to write a pre-processor that generates the code by feeding it a high level description of what you want.

just my 0.02 €.

[luis]

Using this method you indeed end up with objects, ie. methods bound to instantiated data or v.v., whatever your perpective is. Encapsulation like this is a very good thing, but it's only part of OOP. How would you implement inheritance, polymorphism, object persistence and the like?

Well, in PB I'm not looking for the full OOP paradigm. Only simple objects like the one I defined. Association of data and methods in one entity. No more. It would be nice to have this natively, but it's not an option, so we must do what we can by ourself

Inheritance can be implemented, I imagine, using the EXTEND keyword, but I'm not interested in it. Not on PB. Anyway I'm not so fond on OOP beside what exposed above, but that's me.

I especially dislike the need to write so many times the prototype of a funcion

...

a preprocessor it's the only way to go. Or not ?

The other way around would be to write a pre-processor that generates the code by feeding it a high level description of what you want.

So it seem. One of the reasons I dislike the use of a pre-processor for this, is the fact every message error from the compiler is then referred to another source, with its own line numbering.

This can be solved with other compilers using specific directives, I'm not sure if that can be done in PB.