PureBasic Forums - English

Code: Select all

Macro DefineClass(name)  
  Structure name
   *vt 
EndMacro 

Macro ClassInterface(name)
 EndStructure 
 Interface i#name
   free()
 EndMacro    

Macro SetMethod(address)
  PokeI(*this\vt+MethodOffset,address)
  MethodOffset+SizeOf(Integer)
EndMacro
 
Macro New(Class,Interfaces)
  Procedure New_#Class#() 
    Protected MethodOffset, *this.class 
    *this = AllocateMemory(SizeOf(class))
    *this\vt = AllocateMemory(SizeOf(Interfaces))
    InitializeStructure(*this,class)
EndMacro 

Macro EndClassInterface(name)
  EndInterface
EndMacro 

Macro Methods(name)
  Procedure name#_Free(*this.name) 
  If *this 
    FreeMemory(*this\vt)
    ClearStructure(*this,name)
    FreeMemory(*this)
  EndIf 
 EndProcedure
  
 new(name,i#name) 
 SetMethod(@name#_Free())
 
EndMacro   

Macro EndDefineClass(name)
  ProcedureReturn *this
 EndProcedure 
EndMacro 

;-Test the class macros    
;1) DefineClass(ClassName)
;2) Add Structure fields eg a.i, list alist.i()
;3) ClassInterface(ClassName)
;4) Define the interface methods 
;5) EndClassInterface(ClassName)
;6) Define the class procedures 
;7) Methods(ClassName)
;8) SetMethod(@Of_Each_Method_In_The_Same_Order_As_The_Interface())
;9) EndDefineClass(ClassName)

DefineClass(Test)      
  x.i   ;structure fields
  
  ClassInterface(Test)               
    Plus(*that.Test)         ;interface member    
    Minus(*that.Test)
    Set(x.i)
    Get()
  EndClassInterface(Test) 
  
  Procedure Test_Set(*this.Test,x.i)   ;do the procedures 
    *this\x = x
  EndProcedure 
  
  Procedure Test_Get(*this.Test)
    ProcedureReturn *this\x
  EndProcedure   
  
  Procedure Test_Plus(*this.test,*that.test)
  *this\x + *that\x
  EndProcedure

  Procedure Test_Minus(*this.test,*that.test)
  *this\x - *that\x
  EndProcedure
  
  Methods(Test)   ;define the methods                 
  
  SetMethod(@Test_Plus())   ;set the function pointers in the vtable
  SetMethod(@Test_Minus()) 
  SetMethod(@Test_Set())   
  SetMethod(@Test_Get()) 
  
EndDefineClass(Test) ;end the class        
  

*a.iTest = New_Test() 
*b.iTest = New_Test() 

*a\Set(2)
*b\set(2) 

*a\plus(*b)
Debug *a\get() 

*a\minus(*b) 
Debug *a\get() 

*a\free()
*b\free()