V4 - OOP

fsw · Post by **fsw** » Fri Feb 10, 2006 11:15 pm

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.

Post by **Fred** » Fri Feb 10, 2006 11:23 pm

You're welcome

. Nice example BTW.

Straker · Post by **Straker** » Sat Feb 11, 2006 1:08 am

nice.

eddy · Post by **eddy** » Sat Feb 11, 2006 2:47 am

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)

Post by **Dare2** » Sat Feb 11, 2006 2:53 am

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?

eddy · Post by **eddy** » Sat Feb 11, 2006 3:27 am

my example is not a true OOP

eddy · Post by **eddy** » Sat Feb 11, 2006 4:26 am

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=")

Psychophanta · Post by **Psychophanta** » Sat Feb 11, 2006 1:16 pm

Thank you for that idea, fsw

Seems Fred wants to implement OOP secretly

Kale · Post by **Kale** » Sat Feb 11, 2006 3:06 pm

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!

fsw · Post by **fsw** » Sun Feb 12, 2006 12:50 am

Psychophanta wrote:Seems Fred wants to implement OOP secretly

Yeah, my first thought when I read Fred's interview that he doesn't plan to incorporate oop into Pure: "

"

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.

The fun is back

Psychophanta · Post by **Psychophanta** » Sun Feb 12, 2006 9:52 am

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.

fsw · Post by **fsw** » Mon Feb 13, 2006 7:52 pm

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.

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).

blueznl · Post by **blueznl** » Mon Feb 13, 2006 7:55 pm

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...

eddy · Post by **eddy** » Wed Feb 15, 2006 8:17 pm

Prototype returns a function pointer in this case.

Code: Select all

MyObjectB\proc2("a-b=")

Kale · Post by **Kale** » Thu Feb 16, 2006 10:09 am

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!

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.