Page 1 of 6

V4 - OOP

Posted: Fri Feb 10, 2006 11:15 pm
by fsw
Code updated For 5.20+

Remember the old coding style doing oop in pb?

Forget it!

Doing OOP stuff in PB V4 is easier than ever.

If you read the readme.html file you will find this example:

Code: Select all

; Labels/address in datasection ;

Interface MyObject
   DoThis()
   DoThat()
EndInterface

Procedure This(*Self)
   MessageRequester("MyObject", "This")
EndProcedure

Procedure That(*Self)
   MessageRequester("MyObject", "That")
EndProcedure

m.MyObject = ?VTable

m\DoThis()
m\DoThat()


DataSection
   VTable:
      Data.l ?Procedures
   Procedures:
      Data.l @This(), @That()
EndDataSection

Which stores the address of Procedures and Labels in DataSection.
How easy is that?

Now that the Methods (Procedures) are stored in an really nice way, the only thing missing are the Properties (Variables) of a class.

The following shows one way using a List:

Code: Select all

;oop example by fsw
;extends the Fantaisie Software "Labels/address in datasection"
;example with Properties - now we have Methods and Properties


;~~~~~~~~~~~~~~~~~~~~
;Start MyObject class
;~~~~~~~~~~~~~~~~~~~~

;define Methods
Interface MyObject
   StoreThis(par.l)
   GetThat()
   ;add more Methods if needed
EndInterface

;define Properties
Structure MyObject_Properties
   VTable.l ;this is needed to store the address of the Methods vtable
   ValueOfThat.l ;start with the properties
   ;add more properties if needed
EndStructure

;this method/procedure can have a different name than in the interface
;the only thing that is important is the position in the vtable
Procedure This(*Self.MyObject_Properties, par.l)
   *Self\ValueOfThat = par
   MessageRequester("MyObject", "This: " + Str(par))
EndProcedure

;this method/procedure can have a different name than in the interface
;the only thing that is important is the position in the vtable
Procedure That(*Self.MyObject_Properties)
   MessageRequester("MyObject", "That: " + Str(*Self\ValueOfThat))
EndProcedure


;Create a class list
;this way there can be more than one object of a class
Global NewList MyObject_List.MyObject_Properties()

Procedure CreateThisClass()
   AddElement(MyObject_List())
   MyObject_List()\VTable = ?Procedures
   ProcedureReturn MyObject_List()
EndProcedure

;- start main:
m.MyObject = CreateThisClass()

m\StoreThis(347)
m\GetThat()


End

DataSection
   Procedures:
      Data.l @This(), @That()
EndDataSection
Isn't this sweet?

Thanks Fred.

Posted: Fri Feb 10, 2006 11:23 pm
by Fred
You're welcome ;). Nice example BTW.

Posted: Sat Feb 11, 2006 1:08 am
by Straker
nice. 8)

Posted: Sat Feb 11, 2006 2:47 am
by eddy
EASIER WAY :)

Code: Select all

Prototype PROCTYPE(a,b)

Structure OBJECT 
  a.l
  b.w
  proc.PROCTYPE 
EndStructure

Procedure MyObjectProcedure(a,b)
  Debug "TEST a+b ="+Str(a+b)
EndProcedure 

MyObject.OBJECT
MyObject\proc = @MyObjectProcedure() 

MyObject\proc(1,2)

Posted: Sat Feb 11, 2006 2:53 am
by Dare2
Neat (both examples).



Conundrum:
Why is it so easy to see when you look at someone's code - but so hard to do when you try it yourself?

Posted: Sat Feb 11, 2006 3:27 am
by eddy
my example is not a true OOP

Posted: Sat Feb 11, 2006 4:26 am
by eddy
version 1

Code: Select all

;// declare procedures 
Interface OBJECT
  proc(txt.s)
  proc2(txt.s)
EndInterface 

Structure OBJECT_PROPERTIES  
  ;// procedures
  vtable.l
  proc.l
  proc2.l
  ;// parameters
  name.s
  a.l
  b.l
EndStructure
Global NewList obj.OBJECT_PROPERTIES () 

Declare ObjectExists(*self.OBJECT_PROPERTIES)

Procedure MyObjectProcedure(*self.OBJECT_PROPERTIES ,txt.s)      
  ObjectExists(*self)
  Debug *self\name+": ADD = "+Str(*self\a + *self\b)
EndProcedure 

Procedure MyObjectProcedure2(*self.OBJECT_PROPERTIES ,txt.s)
  ObjectExists(*self)
  Debug *self\name+": SUBSTRACT = "+Str(*self\a - *self\b)
EndProcedure 

Procedure CreateObject(name.s)
  AddElement(obj()) 
  
  ;// procedures
  obj()\vtable=obj()+OffsetOf(OBJECT_PROPERTIES\proc)
  obj()\proc  = @MyObjectProcedure()
  obj()\proc2 = @MyObjectProcedure2()  
  
  ;// parameters  
  obj()\name=name
  obj()\a=Random(100)
  obj()\b=Random(10)
  
  ProcedureReturn obj()
EndProcedure

Procedure DeleteObject(*self.OBJECT_PROPERTIES)
  ObjectExists(*self)
  Debug "DESTROY "+Chr('"')+*self\name+Chr('"')
  DeleteElement(obj())
  ProcedureReturn 0
EndProcedure 

Procedure ObjectExists(*self.OBJECT_PROPERTIES)
  ForEach obj()
    If obj()=*self
      ProcedureReturn  
    EndIf 
  Next 
  MessageRequester("Error","Invalid Object Handle !!")
  End 
EndProcedure 

MyObjectA.OBJECT=CreateObject("A")
MyObjectA\proc("a+b=")
MyObjectA\proc2("a-b=")

MyObjectB.OBJECT=CreateObject("B")
MyObjectB\proc("a+b=")
MyObjectB\proc2("a-b=")
DeleteObject(MyObjectB)
version 2

Code: Select all

;// declare procedures 
Interface OBJECT
  proc(txt.s)
  proc2(txt.s)
EndInterface 

Structure OBJECT_PROPERTIES  
  ;// procedures
  vtable.l
  proc.l
  proc2.l
  ;// parameters
  name.s
  a.l
  b.l
EndStructure
Global NewList obj.OBJECT_PROPERTIES () 

Procedure MyObjectProcedure(*self.OBJECT_PROPERTIES ,txt.s)      
  Debug *self\name+": ADD = "+Str(*self\a + *self\b)
EndProcedure 

Procedure MyObjectProcedure2(*self.OBJECT_PROPERTIES ,txt.s)
  Debug *self\name+": SUBSTRACT = "+Str(*self\a - *self\b)
EndProcedure 

Procedure CreateObject(name.s)
  AddElement(obj()) 
  
  ;// procedures
  obj()\vtable=obj()+OffsetOf(OBJECT_PROPERTIES\proc)
  obj()\proc  = @MyObjectProcedure()
  obj()\proc2 = @MyObjectProcedure2()  
  
  ;// parameters  
  obj()\name=name
  obj()\a=Random(100)
  obj()\b=Random(10)
  
  ProcedureReturn obj()
EndProcedure

Procedure DeleteObject(*self.OBJECT_PROPERTIES)
  ForEach obj() 
    If obj()=*self               
        Debug "DESTROY "+Chr('"')+*self\name+Chr('"')
        obj()\vtable=0 ;<-- MAKE OBJECT INVALID  
        DeleteElement(obj())       
        ProcedureReturn 0 
    EndIf 
  Next 
  
  MessageRequester("Error","Invalid Object Handle !!") 
  End   
EndProcedure 

MyObjectA.OBJECT=CreateObject("A")
MyObjectA\proc("a+b=")
MyObjectA\proc2("a-b=")

MyObjectB.OBJECT=CreateObject("B")
MyObjectB\proc("a+b=")
MyObjectB\proc2("a-b=")
DeleteObject(MyObjectB)

MyObjectB\proc("a+b=") ;<-- OBJECT HAS BEEN DELETED
MyObjectB\proc2("a-b=")

Posted: Sat Feb 11, 2006 1:16 pm
by Psychophanta
Thank you for that idea, fsw :)
Seems Fred wants to implement OOP secretly ;)

Posted: Sat Feb 11, 2006 3:06 pm
by Kale
eddy wrote:EASIER WAY :)

Code: Select all

Prototype PROCTYPE(a,b)

Structure OBJECT 
  a.l
  b.w
  proc.PROCTYPE 
EndStructure

Procedure MyObjectProcedure(a,b)
  Debug "TEST a+b ="+Str(a+b)
EndProcedure 

MyObject.OBJECT
MyObject\proc = @MyObjectProcedure() 

MyObject\proc(1,2)
Great example!!! This is much more powerful than it looks! :D

Posted: Sun Feb 12, 2006 12:50 am
by fsw
Psychophanta wrote:Seems Fred wants to implement OOP secretly ;)
:D
Yeah, my first thought when I read Fred's interview that he doesn't plan to incorporate oop into Pure: " :cry: :x :evil: "

But now it seems that Pure doesn't need to.
No big overhead like in former pb versions and it's so easy now.
This makes any proprocessor somewhat obsolete.
8)
The fun is back :o

Posted: Sun Feb 12, 2006 9:52 am
by Psychophanta
Fsw and Eddy, some quick tutorial with small snippets for PB4 OOP would be welcome.
Perhaps in this forum as a sticky thread or at PureWiki. :D

Posted: Mon Feb 13, 2006 7:52 pm
by fsw
Psychophanta wrote:Fsw and Eddy, some quick tutorial with small snippets for PB4 OOP would be welcome.
Perhaps in this forum as a sticky thread or at PureWiki. :D
I'm certainly the wrong person for doing that for several reasons, but the main one is that I'm not using all oop techniques - I don't like some of them, because they take the simplicity away and overcomplicate things a lot.

Like to keep it simple, so my coding style is more a mixture of procedural and oop - the best of both worlds (IMHO).

Posted: Mon Feb 13, 2006 7:55 pm
by blueznl
don't look at me, i don't do oop, because my mind simply doesn't grasp it... must be some minor braindamage :-)

i'd *love* to understand it though...

Posted: Wed Feb 15, 2006 8:17 pm
by eddy
Prototype returns a function pointer in this case. :?:

Code: Select all

MyObjectB\proc2("a-b=")

Posted: Thu Feb 16, 2006 10:09 am
by Kale
Kale wrote:
eddy wrote:EASIER WAY :)

Code: Select all

Prototype PROCTYPE(a,b)

Structure OBJECT 
  a.l
  b.w
  proc.PROCTYPE 
EndStructure

Procedure MyObjectProcedure(a,b)
  Debug "TEST a+b ="+Str(a+b)
EndProcedure 

MyObject.OBJECT
MyObject\proc = @MyObjectProcedure() 

MyObject\proc(1,2)
Great example!!! This is much more powerful than it looks! :D
I've changed my mind on this one now, it's quite limited. I can't see a way to refer to 'Self' within an object created like this. Which is sad because this looked a lot cleaner than normal interfaces.

Oh well back to normal interfaces. :?