Page 1 of 11

Classes in PureBasic

Posted: Sat Feb 02, 2013 8:44 pm
by NikitaOdnorob98
How about classes in PureBasic? For example:

Code: Select all

Class MyClass
  Const = 5
  Procedure Plus (var1, var2)
    ProcedureReturn var1+var2
  EndProcedure
EndClass
Debug MyClass.Const
Debug MyClass.Plus (5, 2)

Re: Classes in PureBasic

Posted: Sat Feb 02, 2013 8:51 pm
by luis
NOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO !

It's that time of the year again :lol:


For future reference if some new user in the future decide to do a search in the forum before asking for it (all is possible, it can happen):
14.PureBasic is a procedural language with several extensions. Will you ever support “real” OOP, or a more improved / easier method to (optionally) use it?

No. The command set is not OOP and it won't mix well. Either do a procedural or OOP language, but don't try to do both. It will end up like C++ where clean C++ sources are rare. Most are patches of C and C++.
from -> http://www.purearea.net/pb/english/inte ... d_2012.htm

And this is only the latest occurrence mind you. You can find a lot of them if you read the forum.

Re: Classes in PureBasic

Posted: Sat Feb 02, 2013 8:52 pm
by ts-soft
see here: http://www.purebasic.fr/english/viewtop ... 48#p139848
This request is older than purebasic itself :mrgreen:

Re: Classes in PureBasic

Posted: Sat Feb 02, 2013 9:20 pm
by Shield
Watch out rebel heading this way: +1 for this request. :P

Re: Classes in PureBasic

Posted: Sat Feb 02, 2013 9:47 pm
by User_Russian
Good idea to place procedures within the structure.
This will not worry that the names of the procedures/functions can be identical. This is important because in PureBasic, no NameSpace.

Re: Classes in PureBasic

Posted: Sat Feb 02, 2013 9:58 pm
by luis
User_Russian wrote:This is important because in PureBasic, no NameSpace.
Modules are coming ! -> http://www.purebasic.fr/english/viewtop ... 486#p98486

Stay tuned -> http://www.purebasic.fr/english/viewtop ... 00#p294500

Let's hope :mrgreen:

Re: Classes in PureBasic

Posted: Sat Feb 02, 2013 10:10 pm
by ts-soft
After 8 years :?:
But we can wait :wink:
Is better as ugly procedures in structures.

Re: Classes in PureBasic

Posted: Sun Feb 03, 2013 8:20 pm
by BorisTheOld
Dare I say, once again, that PB already has everything one needs to create classes.

We use classes for every aspect of our applications. It's easy to do and creates well structured code.

The future is already here. :)

Here's an example. This class works with others to implement a menu structure in the form of a Tree gadget. It uses standard PB features and is cross-platform.

Code: Select all

;===============================================
;
;  objMenuItem.pbi  :  class interface  :  MenuItem Class
;
;-----------------------------------------------
;
DeclareExternalFunction(MenuItem, Create, typObject) ()
;
Interface objMenuItem
;
;  primary  methods
;
  Func(Destroy, typObject)             ()
  Func(Class, typInt32)                ()
  Getx(exiChildEntryNumber, typInt32)  ()
  Setx(exiChildEntryNumber)            (ByVal(bviChildEntryNumber, typInt32))
;
;  external methods
;
  Subr(Events)                         ()
  Subr(Resize)                         ()
  Subr(Attach)                         ()
  Subr(AttachChild)                    (ByVal(bvoChild, typObject))
  Subr(Detach)                         ()
  Subr(DetachChild)                    (ByVal(bvoChild, typObject))
;
;  external properties:  read/write
;
;
;  external properties:  read only
;
;
;  external properties:  write only
;
  Setx(exsCaption)                     (ByVal(bvsCaption, typString))
  Setx(exoParent)                      (ByVal(bvoParent, typObject))
  Setx(exiMenuLevel)                   (ByVal(bviMenuLevel, typInt32))
  Setx(exoMenuHeading)                 (ByVal(bvoMenuHeading, typObject))
  Setx(expCBAttach)                    (ByVal(bviIndex, typInt32), ByVal(bvpCBAttach, typPointer))
  Setx(expCBDetach)                    (ByVal(bviIndex, typInt32), ByVal(bvpCBDetach, typPointer))
;
EndInterface
;
;===============================================
;  end of  :  objMenuItem.pbi
;===============================================

Code: Select all

;===============================================
;
;  clsMenuItem.pbi  :  class methods  :  MenuItem Class
;
;===============================================
;
;  Properties
;
Structure strMenuItem
;
;  primary  properties
;
  FieldPointer(prpVirtualTable)                                                ; 16393 : pointer to the class virtual table
  Field(priClassReferenceNumber, typInt32)                                     ; 16447 : the entity number for the class (module, program, package, etc)
  Field(exiChildEntryNumber, typInt32)                                         ; 16484 : entry number of the object in the parent child array (1 based)
;
;  private dvsam control blocks
;
;
;  private file records
;
;
;  private file objects
;
;
;  private properties
;
  Field(priGadgetNumber, typInt32)                                             ; 16402 : assigned by pb using #pb_any
;
;  external properties:  read/write
;
;
;  external properties:  read only
;
;
;  external properties:  write only
;
  Field(exsCaption, typString)                                                 ; 15328 : caption text
  Field(exoParent, objGeneric)                                                 ; 16086 : reference to an object's parent
  Field(exiMenuLevel, typInt32)                                                ; 16136 : menu level:  0=heading, 1=topic
  Field(exoMenuHeading, objMenuItem)                                           ; 16144 : object reference to the associated menu heading
  FieldCallBack(expCBAttach)                                                   ; 16479 : callback ptr:  attach a program object to a panel
  FieldCallBack(expCBDetach)                                                   ; 16480 : callback ptr:  detach a program object from a panel
;
EndStructure
;
;===============================================
;
;  Private Declares
;
DeclarePrivateSubroutine(MenuItem, Constructor)        (ByVal(Me, strMenuItem))
DeclarePrivateSubroutine(MenuItem, Destructor) (ByVal(Me, strMenuItem))
DeclarePrivateSubroutine(MenuItem, LeftClickEvent)     (ByVal(Me, strMenuItem))
DeclarePrivateSubroutine(MenuItem, LeftDoubleClickEvent)       (ByVal(Me, strMenuItem))
DeclarePrivateSubroutine(MenuItem, RightClickEvent)    (ByVal(Me, strMenuItem))
DeclarePrivateSubroutine(MenuItem, RightDoubleClickEvent)      (ByVal(Me, strMenuItem))
DeclarePrivateSubroutine(MenuItem, ChangeEvent)        (ByVal(Me, strMenuItem))
DeclarePrivateSubroutine(MenuItem, DragStartEvent)     (ByVal(Me, strMenuItem))
;
;===============================================
;
;  Primary Methods
;
;-----------------------------------------------
;
ExternalFunction(MenuItem, Create, typObject) ()
;
;  Create                              create a class instance
;
  Local(Me, strMenuItem)

  Me = AllocateMemory(SizeOf(strMenuItem))
  If IsObject(Me)
    InitializeStructure(Me, strMenuItem)
    Me\prpVirtualTable = LabelPtr(MenuItem, VirtualTable)
    ClassCall(MenuItem, Constructor) (Me)
  EndIf
  ProcedureReturn Me
EndFunction
;
;-----------------------------------------------
;
ExternalFunction(MenuItem, Destroy, typObject) (ByVal(Me, strMenuItem))
;
;  Destroy                             destroy a class instance
;
  If IsObject(Me)
    ClassCall(MenuItem, Destructor) (Me)
    ClearStructure(Me, strMenuItem)
    FreeMemory(Me)
  EndIf
  ProcedureReturn Nothing
EndFunction
;
;-----------------------------------------------
;
ExternalFunction(MenuItem, Class, typInt32) (ByVal(Me, strMenuItem))
;
;  Class                               return the class reference number
;
  ProcedureReturn Me\priClassReferenceNumber
EndFunction
;
;-----------------------------------------------
;
;  exiChildEntryNumber                 16484 : entry number of the object in the parent child array (1 based)
;
ExternalGet(MenuItem, exiChildEntryNumber, typInt32)   (ByVal(Me, strMenuItem))
  ProcedureReturn Me\exiChildEntryNumber
EndGet
;
ExternalSet(MenuItem, exiChildEntryNumber)     (ByVal(Me, strMenuItem), ByVal(bviChildEntryNumber, typInt32))
  Me\exiChildEntryNumber = bviChildEntryNumber
EndSet
;
;===============================================
;
;  External Methods
;
;-----------------------------------------------
;
ExternalSubroutine(MenuItem, Events)   (ByVal(Me, strMenuItem))
;
;  Events                              process gadget events
;
;
  Local(iEventType, typInt32)

  iEventType = EventType()
  
  Select iEventType

    Case #PB_EventType_LeftClick                                               ; left click on an item, or a checkbox was checked/unchecked
      ClassCall(MenuItem, LeftClickEvent) (Me)

    Case #PB_EventType_LeftDoubleClick
      ClassCall(MenuItem, LeftDoubleClickEvent) (Me)

    Case #PB_EventType_RightClick
      ClassCall(MenuItem, RightClickEvent) (Me)

    Case #PB_EventType_RightDoubleClick
      ClassCall(MenuItem, RightDoubleClickEvent) (Me)

    Case #PB_EventType_Change                                                  ; the current item is selected
      ClassCall(MenuItem, ChangeEvent) (Me)

    Case #PB_EventType_DragStart                                               ; the user tried to start a Drag & Drop operation.
      ClassCall(MenuItem, DragStartEvent) (Me)

  EndSelect

EndSubroutine
;
;-----------------------------------------------
;
ExternalSubroutine(MenuItem, Resize)   (ByVal(Me, strMenuItem))
;
;  Resize                              process a window resize event
;
;
EndSubroutine
;
;-----------------------------------------------
;
ExternalSubroutine(MenuItem, Attach)   (ByVal(Me, strMenuItem))
;
;  Attach                              attach this object to the application
;
;
  Local(oGenericMenu, objMenu)                                                 ; 16108 : generic reference to a menu object
  Local(iItemFlags, typInt32)                                                  ; 16477 : composite option flags used when creating a pb gadget item
  Local(iItemIndex, typInt32)                                                  ; 16478 : gadget item index (zero based)

  ObjectCall(Me\exoParent, AttachChild) (Me)                                   ; link this object to its parent

  iItemIndex = Me\exiChildEntryNumber - 1                                      ; calculate the menu item index

  oGenericMenu = Me\exoParent                                                  ; point to the parent menu object

  Me\priGadgetNumber = Get(oGenericMenu, exiGadgetNumber)                      ; get the menu gadget number

  iItemFlags = Me\exiMenuLevel                                                 ; pick up menu item level

  If iItemFlags = #iMENU_LEVEL_QUIT                                            ; if quit specified then treat as topic
    iItemFlags = #iMENU_LEVEL_TOPIC
  EndIf

  AddGadgetItem(Me\priGadgetNumber, iItemIndex, Me\exsCaption, 0, iItemFlags)

  SetGadgetItemData(Me\priGadgetNumber, iItemIndex, Me)                        ; link this object to its gadget item

EndSubroutine
;
;-----------------------------------------------
;
ExternalSubroutine(MenuItem, AttachChild)      (ByVal(Me, strMenuItem), ByRef(broChild, objGeneric))
;
;  AttachChild                         attach a child object
;
;  broChild                            16448 : reference to a child object
;
EndSubroutine
;
;-----------------------------------------------
;
ExternalSubroutine(MenuItem, Detach)   (ByVal(Me, strMenuItem))
;
;  Detach                              detach this object from the application
;
;
EndSubroutine
;
;-----------------------------------------------
;
ExternalSubroutine(MenuItem, DetachChild)      (ByVal(Me, strMenuItem), ByRef(broChild, objGeneric))
;
;  DetachChild                         detach a child object
;
;  broChild                            16448 : reference to a child object
;
EndSubroutine
;
;===============================================
;
;  Property Methods
;
;-----------------------------------------------
;
;  external properties:  read/write
;
;-----------------------------------------------
;
;  external properties:  read only
;
;-----------------------------------------------
;
;  external properties:  write only
;
;--------
;
ExternalSet(MenuItem, exsCaption)      (ByVal(Me, strMenuItem), ByVal(bvsCaption, typString))
  Me\exsCaption = bvsCaption
EndSet
;
;--------
;
ExternalSet(MenuItem, exoParent)       (ByVal(Me, strMenuItem), ByVal(bvoParent, typObject))
  Me\exoParent = bvoParent
EndSet
;
;--------
;
ExternalSet(MenuItem, exiMenuLevel)    (ByVal(Me, strMenuItem), ByVal(bviMenuLevel, typInt32))
  Me\exiMenuLevel = bviMenuLevel
EndSet
;
;--------
;
ExternalSet(MenuItem, exoMenuHeading)  (ByVal(Me, strMenuItem), ByVal(bvoMenuHeading, typObject))
  Me\exoMenuHeading = bvoMenuHeading
EndSet
;
;--------
;
ExternalSet(MenuItem, expCBAttach)     (ByVal(Me, strMenuItem), ByVal(bviIndex, typInt32), ByVal(bvpCBAttach, typPointer))
  Me\expCBAttach(bviIndex) = bvpCBAttach
EndSet
;
;--------
;
ExternalSet(MenuItem, expCBDetach)     (ByVal(Me, strMenuItem), ByVal(bviIndex, typInt32), ByVal(bvpCBDetach, typPointer))
  Me\expCBDetach(bviIndex) = bvpCBDetach
EndSet
;
;===============================================
;
;  Private Methods
;
;-----------------------------------------------
;
PrivateSubroutine(MenuItem, Constructor)       (ByVal(Me, strMenuItem))
;
;  Constructor                         class constructor
;
;
;
;  auto generated code
;

  Me\priClassReferenceNumber = #iCLASS_MOD_MENUITEM                            ; MenuItem Class

;
;  manual code
;
EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(MenuItem, Destructor)        (ByVal(Me, strMenuItem))
;
;  Destructor                          class destructor
;
;
;
;  manual code
;
;
;  auto generated code
;

EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(MenuItem, LeftClickEvent)    (ByVal(Me, strMenuItem))
;
;  LeftClickEvent                      an item or checkbox has been left clicked
;
;
  Local(iItemIndex, typInt32)                                                  ; 16478 : gadget item index (zero based)
  Local(iItemState, typInt32)                                                  ; 16482 : gadget item state

  iItemIndex = Me\exiChildEntryNumber - 1                                      ; calculate the menu item index

  Select Me\exiMenuLevel

    Case #iMENU_LEVEL_HEADING

      iItemState = GetGadgetItemState(Me\priGadgetNumber, iItemIndex)

      If iItemState & #PB_Tree_Expanded
        SetGadgetItemState(Me\priGadgetNumber, iItemIndex, #PB_Tree_Collapsed)
      Else
        SetGadgetItemState(Me\priGadgetNumber, iItemIndex, #PB_Tree_Expanded)
      EndIf

    Case #iMENU_LEVEL_TOPIC

      SetGadgetItemColor(Me\priGadgetNumber, iItemIndex, #PB_Gadget_FrontColor, RGB(255, 0, 0))        ; set caption to red

      CallBack(Me\expCBAttach)                                                 ; attach the program task

    Case #iMENU_LEVEL_QUIT

      Set(gloApp, exlQuitApplication, True)                                    ; terminate the application

  EndSelect

  SetGadgetState(Me\priGadgetNumber, -1)                                       ; remove select state from all menu items
  
EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(MenuItem, LeftDoubleClickEvent)      (ByVal(Me, strMenuItem))
;
;  LeftDoubleClickEvent                an item has been left double clicked
;
;

  SetGadgetState(Me\priGadgetNumber, -1)                                       ; remove select state from all menu items

EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(MenuItem, RightClickEvent)   (ByVal(Me, strMenuItem))
;
;  RightClickEvent                     an item has been right clicked
;
;
  Local(iItemIndex, typInt32)                                                  ; 16478 : gadget item index (zero based)

  iItemIndex = Me\exiChildEntryNumber - 1                                      ; calculate the menu item index

  Select Me\exiMenuLevel

    Case #iMENU_LEVEL_HEADING

    Case #iMENU_LEVEL_TOPIC

      SetGadgetItemColor(Me\priGadgetNumber, iItemIndex, #PB_Gadget_FrontColor, RGB(0, 0, 0))  ; set caption to black

      CallBack(Me\expCBDetach)                                                 ; detach the program task

    Case #iMENU_LEVEL_QUIT

  EndSelect

  SetGadgetState(Me\priGadgetNumber, -1)                                       ; remove select state from all menu items

EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(MenuItem, RightDoubleClickEvent)     (ByVal(Me, strMenuItem))
;
;  RightDoubleClickEvent               an item has been right double clicked
;
;

  SetGadgetState(Me\priGadgetNumber, -1)                                       ; remove select state from all menu items

EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(MenuItem, ChangeEvent)       (ByVal(Me, strMenuItem))
;
;  ChangeEvent                         an item has been selected
;
;
EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(MenuItem, DragStartEvent)    (ByVal(Me, strMenuItem))
;
;  DragStartEvent                      a user drag operation has started
;
;
EndSubroutine
;
;===============================================
;
;  Virtual Table
;
DataSection
  Label(MenuItem, VirtualTable)
;
;  primary  methods
;
  InterfaceFunc(MenuItem, Destroy)
  InterfaceFunc(MenuItem, Class)
  InterfaceGetx(MenuItem, exiChildEntryNumber)
  InterfaceSetx(MenuItem, exiChildEntryNumber)
;
;  external methods
;
  InterfaceSubr(MenuItem, Events)
  InterfaceSubr(MenuItem, Resize)
  InterfaceSubr(MenuItem, Attach)
  InterfaceSubr(MenuItem, AttachChild)
  InterfaceSubr(MenuItem, Detach)
  InterfaceSubr(MenuItem, DetachChild)
;
;  external properties:  read/write
;
;
;  external properties:  read only
;
;
;  external properties:  write only
;
  InterfaceSetx(MenuItem, exsCaption)
  InterfaceSetx(MenuItem, exoParent)
  InterfaceSetx(MenuItem, exiMenuLevel)
  InterfaceSetx(MenuItem, exoMenuHeading)
  InterfaceSetx(MenuItem, expCBAttach)
  InterfaceSetx(MenuItem, expCBDetach)
;
EndDataSection
;
;===============================================
;  end of  :  clsMenuItem.pbi
;===============================================

Re: Classes in PureBasic

Posted: Sun Feb 03, 2013 8:45 pm
by skywalk
Hi Boris,
I agree with you, but your postings do nothing to affirm your "classy" statements.
They might as well be written in another language if they don't compile. :?:

Re: Classes in PureBasic

Posted: Sun Feb 03, 2013 9:10 pm
by idle
There are numerous ways to make classes the stand method is to use interface and a datasection
while it adds a little overhead to your coding it's not really a big deal to implement

Code: Select all

EnableExplicit

Structure Foo 
   *vt                         ;pointer to virtual table as first entry 
   intFoo.i
EndStructure 

;public menthods 
Procedure Foo_SetFoo(*this.foo,value.i)  ;first parameter is the *this pointer 
   *this\intFoo = value 
EndProcedure 

Procedure Foo_GetFoo(*this.foo) 
   ProcedureReturn *this\intFoo 
 EndProcedure   
 
 ;destructor 
 Procedure Foo_Free(*this.foo)
    FreeMemory(*this)
 EndProcedure 
 
 Interface IFoo    ;create interface hides the *this pointer 
    Get()
    Set(value.i) 
    Free() 
 EndInterface 
 
 DataSection : vtFoo :    ;create virtual table   
    Data.i @Foo_GetFoo()
    Data.i @Foo_SetFoo()
    Data.i @Foo_Free() 
  EndDataSection   
  
  ;contructor 
 Procedure New_Foo() 
    Protected *this.foo 
    *this = AllocateMemory(SizeOf(foo))
    If *this 
       *this\vt = ?vtFoo 
       ProcedureReturn *this
    EndIf 
 EndProcedure 
 
 
 ;user declares inteface 
 
 Global *myfoo.ifoo = New_Foo() 
 
 If *myfoo 
    *myfoo\Set(123) 
    Debug *myfoo\Get() 
    *myfoo\Free() 
 EndIf 
 
    

Re: Classes in PureBasic

Posted: Sun Feb 03, 2013 11:01 pm
by Danilo
idle wrote:There are numerous ways to make classes the stand method is to use interface and a datasection
while it adds a little overhead to your coding it's not really a big deal to implement

Code: Select all

EnableExplicit

Structure Foo 
   *vt                         ;pointer to virtual table as first entry 
   intFoo.i
EndStructure 

;public menthods 
Procedure Foo_SetFoo(*this.foo,value.i)  ;first parameter is the *this pointer 
   *this\intFoo = value 
EndProcedure 

Procedure Foo_GetFoo(*this.foo) 
   ProcedureReturn *this\intFoo 
 EndProcedure   
 
 ;destructor 
 Procedure Foo_Free(*this.foo)
    FreeMemory(*this)
 EndProcedure 
 
 Interface IFoo    ;create interface hides the *this pointer 
    Get()
    Set(value.i) 
    Free() 
 EndInterface 
 
 DataSection : vtFoo :    ;create virtual table   
    Data.i @Foo_GetFoo()
    Data.i @Foo_SetFoo()
    Data.i @Foo_Free() 
  EndDataSection   
  
  ;contructor 
 Procedure New_Foo() 
    Protected *this.foo 
    *this = AllocateMemory(SizeOf(foo))
    If *this 
       *this\vt = ?vtFoo 
       ProcedureReturn *this
    EndIf 
 EndProcedure 
 
 
 ;user declares inteface 
 
 Global *myfoo.ifoo = New_Foo() 
 
 If *myfoo 
    *myfoo\Set(123) 
    Debug *myfoo\Get() 
    *myfoo\Free() 
 EndIf 
 
    
Even C++ is simpler and cleaner. :lol:

Code: Select all

#include <iostream>

class Foo {
    int intFoo;
public:
    int Get() {
        return intFoo;
    }
    void Set(int value) {
        intFoo = value;
    }
};

int main(int argc, char *argv[]) {
    Foo myfoo;
    myfoo.Set(123);
    std::cout << myfoo.Get();
    return 0;
}

Re: Classes in PureBasic

Posted: Sun Feb 03, 2013 11:15 pm
by Fred
PureBasic won't be object oriented, period.

Re: Classes in PureBasic

Posted: Sun Feb 03, 2013 11:28 pm
by luis
Danilo wrote: Even C++ is simpler and cleaner. :lol:
A language supporting OOP natively can boast a simpler and cleaner syntax then using interfaces and explicit virtual tables in PB ?

I suspected as much.

Re: Classes in PureBasic

Posted: Mon Feb 04, 2013 2:11 am
by Neil
BorisTheOld wrote:Dare I say, once again, that PB already has everything one needs to create classes.

We use classes for every aspect of our applications. It's easy to do and creates well structured code.

The future is already here. :)

Here's an example. This class works with others to implement a menu structure in the form of a Tree gadget. It uses standard PB features and is cross-platform.
Hi Boris,

I must say your posts are always very interesting (even if sometimes a bit wordy !!)

1. Could you recommend a good generic book on programming with classes - or do you just have to understand a language that uses classes and then implement this in PB?

2. What type of application are you actually writing ?? Do you have a web page with examples ??

Thanks,

Re: Classes in PureBasic

Posted: Mon Feb 04, 2013 3:54 am
by PMV
Fred wrote:PureBasic won't be object oriented, period.
It is more interesting how many years we still have
until the module-concept. :wink: :mrgreen:


@Neil
Before using a paradigm like OOP (and classes), you
should always learn how it works and what it is for. :)

MFG PMV