v4 - OOP ( I love MACRO )

Share your advanced PureBasic knowledge/code with the community.
User avatar
eddy
Addict
Addict
Posts: 1479
Joined: Mon May 26, 2003 3:07 pm
Location: Nantes

v4 - OOP ( I love MACRO )

Post by eddy »

I love MACRO :D !!

Code: Select all

; ======================================
; NEW MACRO COMMANDS TO SIMPLIFY OOP CODING
; ======================================

;//// COLLECTION OF OBJECT
  
Macro CreateCollection(TYPENAME)
  Global *this#TYPENAME.TYPENAME                 
  Global NewList TYPENAME#List.TYPENAME()
  Declare TYPENAME#Create() 
EndMacro

Macro ForInCollection(TYPENAME)
  ForEach TYPENAME#List()
  *this#TYPENAME = TYPENAME#List()  
EndMacro

Macro EmptyCollection(TYPENAME)
  1 And (CountList(TYPENAME#List())=0)  
EndMacro

;//// OBJECT CREATION

Macro CreateThis(TYPENAME)
  AddElement(TYPENAME#List())+8
  *this#TYPENAME = TYPENAME#List()   
  TYPENAME#Create() 
EndMacro

Macro DeleteThis(TYPENAME)
  DeleteElement(TYPENAME#List())
  *this#TYPENAME = 0  
EndMacro

;//// CURRENT OBJECT

Macro GetThis(TYPENAME)
  *this#TYPENAME
EndMacro

Macro SelectThis(TYPENAME,TYPEINSTANCE)
  ChangeCurrentElement(TYPENAME#List(), TYPEINSTANCE)
  *this#TYPENAME = TYPENAME#List()  
EndMacro

;Macro NextThis(TYPENAME)
;Debug "..........."
;EndMacro
;Macro PreviousThis(TYPENAME)
;Debug "..........."
;EndMacro

;//// READ / WRITE OBJECT PROPERTIES

Macro WithThis(TYPENAME,TYPEINSTANCE = 0)
  If TYPEINSTANCE <> 0 : SelectThis(TYPENAME,TYPEINSTANCE) : EndIf 
  With *this#TYPENAME
EndMacro

; ======================================
; OOP EXAMPLE
; ======================================

Prototype.l PROCTYPE_MOVE(dx=3,dy=2) 
Prototype.l PROCTYPE_BOOM(xlimit)
Structure MISSILE 
  x.l 
  y.l 
  destroyed.b
  move.PROCTYPE_MOVE
  boom.PROCTYPE_BOOM
EndStructure 
CreateCollection(MISSILE)

;// OBJECT PROCEDURE
Procedure MissileMove(dx,dy) 
  WithThis(MISSILE)
    \x+dx
    \y+dy
    Debug "position X: "+Str(\x)
    Debug "position Y: "+Str(\y)
    Debug ""
  EndWith 
EndProcedure 

;// OBJECT PROCEDURE
Procedure MissileBoom(xlimit) 
  WithThis(MISSILE)
    If (\x>xlimit)
      \destroyed=#True  
      Debug "BOOM !! "
    EndIf  
  EndWith 
EndProcedure 

;// OBJECT DEFAULT CONSTRUCTOR 
Procedure MissileCreate() 
  WithThis(MISSILE)
    \x=0
    \y=0
    \move=@MissileMove()
    \boom=@MissileBoom()
    \destroyed=0
  EndWith 
EndProcedure

;// CREATE OBJECT INSTANCE
m1 = CreateThis(MISSILE)
WithThis(MISSILE)
  \x=5
  \y=5
EndWith 

m2 = CreateThis(MISSILE)
WithThis(MISSILE)
  \x=Random(20)
  \y=Random(20)
EndWith

SelectThis(MISSILE,m1)
Debug "missile1 pos X: "+Str( GetThis(MISSILE)\x )

Repeat 
  ForInCollection(MISSILE)
    WithThis(MISSILE)      
      \move(Random(3),Random(3))
      \boom(200)
      If (\destroyed) : DeleteThis(MISSILE) : EndIf
    EndWith 
  Next 
Until EmptyCollection(MISSILE)


Last edited by eddy on Sun Feb 12, 2006 12:54 am, edited 5 times in total.
Imagewin10 x64 5.72 | IDE | PB plugin | Tools | Sprite | JSON | visual tool
Dare2
Moderator
Moderator
Posts: 3321
Joined: Sat Dec 27, 2003 3:55 am
Location: Great Southern Land

Post by Dare2 »

Wow, tight code! :wink:
@}--`--,-- A rose by any other name ..
dontmailme
Enthusiast
Enthusiast
Posts: 537
Joined: Wed Oct 29, 2003 10:35 am

Post by dontmailme »

Best code I never saw! :shock:
Paid up PB User !
User avatar
Joakim Christiansen
Addict
Addict
Posts: 2452
Joined: Wed Dec 22, 2004 4:12 pm
Location: Norway
Contact:

Post by Joakim Christiansen »

Hey, where is the damn code! :cry:
User avatar
eddy
Addict
Addict
Posts: 1479
Joined: Mon May 26, 2003 3:07 pm
Location: Nantes

Post by eddy »

oops fixed !!

Remark : Object deletion does not work correctly perhaps a bug in linkedlist. :?:

Code: Select all

CompilerIf 0
Class MasterClass
  	a.l 
  	b.w 
  	
	Method MasterClass(a,b) 
	  *This\a=a
	  *This\b=b
	EndMethod

	Method Method() 
	  ProcedureReturn  *This\a+*This\b
	EndMethod 
EndClass
obj = New MasterClass() 
Debug obj\Method()

Class SubClass Extends MasterClass
  	c.l 
  	
	Method MasterClass(c=20) 
	  *This\a=c
	  *This\b=c
	  *This\c=c
	EndMethod

	Method Method(txt.s) 	
	  ProcedureReturn  txt.s + Str(*This\a * *This\b + *This\c)
	EndMethod 
EndClass
obj2 = New SubClass()
Debug obj2\Method()
CompilerEndIf 

Prototype PureClassBaseNew(*This) 
Prototype PureClassBaseDispose(*This) 
Structure PureClass
  	BaseNew.PureClassBaseNew
  	BaseDispose.PureClassBaseDispose  	
EndStructure
Procedure PureClassBaseNew(*This)
	ProcedureReturn *This
EndProcedure

;============================================================================

Prototype MasterClassMasterClass(*This) 
Prototype MasterClassMethod(*This) 
Structure MasterClass Extends PureClass  	  		
  	a.l 
  	b.w   	
  	MasterClass.MasterClassMasterClass
  	Method.MasterClassMethod  	  	
EndStructure 

Declare MasterClassBaseNew(*This) 
Declare MasterClassBaseDispose(*This) 
Declare MasterClassMasterClass(*This,a,b) 
Declare MasterClassMethod(*This) 
Procedure MasterClassBaseNew(*This.MasterClass) 
	*This = PureClassBaseNew(*This)
	*This = ReAllocateMemory(*This,SizeOf(MasterClass))	
	
	*This\Method = @MasterClassMethod() 		
	ProcedureReturn *This
EndProcedure 
Procedure MasterClassBaseDispose(*This.MasterClass) 
EndProcedure 
Procedure MasterClassMasterClass(*This.MasterClass,a,b) 
  *This = MasterClassBaseNew(*This)
  	  
  *This\a=a
  *This\b=b
EndProcedure
Procedure MasterClassMethod(*This.MasterClass) 
  ProcedureReturn  *This\a+*This\b
EndProcedure 

MasterClassMasterClass(MasterClassBaseNew(obj.MasterClass),1,2)
Debug obj\Method(obj) 

;============================================================================

Prototype SubClassSubClass(*This,c=20) 
Prototype SubClassMethod(*This)
Structure SubClass Extends MasterClass 	  	
  	c.w   	
  	SubClass.SubClassSubClass 
EndStructure 

Declare SubClassSubClass(*This,c=20) 
Declare SubClassMethod(*This)
Procedure SubClassBaseNew(*This.SubClass) 
	*This = MasterClassBaseNew(*This)
	*This = ReAllocateMemory(*This,SizeOf(SubClass))
	*This\Method = @SubClassMethod() 	
	
	ProcedureReturn *This
EndProcedure 
Procedure SubClassBaseDispose(*This.SubClass) 
EndProcedure 
Procedure SubClassMethod(*This.SubClass) 
  ProcedureReturn  *This\a * *This\b + *This\c
EndProcedure 
Procedure SubClassSubClass(*This.SubClass,c=20) 
  *This = SubClassBaseNew(*This)
  	  
  *This\a=c
  *This\b=c
  *This\c=c
  
  ProcedureReturn *This
EndProcedure 

Define.SubClass  *obj2
*obj2 = SubClassSubClass(SubClassBaseNew(*obj2.SubClass))
Debug *obj2\Method(*obj2) 
Last edited by eddy on Fri Mar 07, 2008 2:42 am, edited 4 times in total.
Imagewin10 x64 5.72 | IDE | PB plugin | Tools | Sprite | JSON | visual tool
User avatar
eddy
Addict
Addict
Posts: 1479
Joined: Mon May 26, 2003 3:07 pm
Location: Nantes

Post by eddy »

If your typename is OBJECT, your constructor will be ObjectCreate.
Here is a tiny example:

Code: Select all

XIncludeFile "MACRO FOR OOP.pb"

; ======================================
; OOP EXAMPLE
; ======================================

Prototype PROCTYPE() 
Structure OBJECT 
  ;// your own parameters
  a.l 
  ;// your own procedures
  proc.PROCTYPE
EndStructure 
CreateCollection(OBJECT)

;// OBJECT PROCEDURE
Procedure ObjectProcedure() 
  WithThis(OBJECT)
  ;// your code
  EndWith 
EndProcedure 

;// OBJECT DEFAULT CONSTRUCTOR 
Procedure ObjectCreate() 
  WithThis(OBJECT)
    \a=0
    \proc=@ObjectProcedure() 
  EndWith 
EndProcedure

;// CREATE OBJECT INSTANCE
*obj.OBJECT = CreateThis(OBJECT)
*obj\a=1000
Last edited by eddy on Sun Feb 12, 2006 1:15 am, edited 3 times in total.
Imagewin10 x64 5.72 | IDE | PB plugin | Tools | Sprite | JSON | visual tool
User avatar
fsw
Addict
Addict
Posts: 1603
Joined: Tue Apr 29, 2003 9:18 pm
Location: North by Northwest

Post by fsw »

Thanks Eddy.
I will study all examples (also the prototype example in the other topic)
:wink:
Post Reply