V4 - OOP

[fsw]

...This is how I program in PureBasic from the beginning. You can withdraw the *SELF and read the EBP register (thanks to hallodri, who told me), but no one knows if this is a bug, or if this will last to the final release.

Are you suggesting that EBP will always be used to store the OBJ reference?

But for using this trick regularly, we would need Fred's confirmation, because this technique is not possible with every compiler.
GNU compiler use always the next free register, so you never know which one is the valid one.

Well Fred should know...

[hellhound66]

Removed.

[Joakim Christiansen]

How about something like this?

Code: Select all

#RAD = 0.0175

;- Player class
Macro NewPlayer(Object)
  Object.Player
  ;Only if it's not in a list \/
  Object\X = 320
  Object\Y = 240
EndMacro

Structure Player
  Color.l
  X.f
  Y.f
  Direction.l
EndStructure

Procedure Player_SetColor(*Object.Player,Value)
  *Object\Color = Value
EndProcedure
Procedure Player_GetColor(*Object.Player)
  ProcedureReturn *Object\Color
EndProcedure

Procedure Player_Input(*Object.Player)
  If KeyboardPushed(#PB_Key_Up)
    *Object\X + Cos((*Object\Direction)*#RAD) * 2
    *Object\Y + Sin((*Object\Direction)*#RAD) * 2
  ElseIf KeyboardPushed(#PB_Key_Down)
    *Object\X - Cos((*Object\Direction)*#RAD) * 2
    *Object\Y - Sin((*Object\Direction)*#RAD) * 2
  EndIf
  If KeyboardPushed(#PB_Key_Left)
    *Object\Direction - 4
  ElseIf KeyboardPushed(#PB_Key_Right)
    *Object\Direction + 4
  EndIf
EndProcedure
Procedure Player_Draw(*Object.Player)
  Circle(*Object\X,*Object\Y,5,*Object\Color)
  LineXY(*Object\X,*Object\Y,*Object\X+Cos((*Object\Direction)*#RAD) * 10,*Object\Y+Sin((*Object\Direction)*#RAD) * 10,#White)
EndProcedure
;_

InitKeyboard(): InitSprite()
OpenScreen(640,480,32,"PB4 OOP Test")

;NewList NewPlayer(Player1)() ;Create a list, and then you must use Player1()
NewPlayer(Player1)
Player_SetColor(Player1,#Red)

Repeat
  ExamineKeyboard()
  Player_Input(Player1)
  
  FlipBuffers()
  ClearScreen(#Black)
  StartDrawing(ScreenOutput())
    Player_Draw(Player1)
  StopDrawing()
Until KeyboardPushed(#PB_Key_Escape)

[hellhound66]

Removed.

[utopiomania]

Isn't this just trying to fake OO using a procedural language? Comparing these efforts with MS C# for example, this seems
a bit hopeless.

If I need OO, I'd rather fire up C# and hack away rather than this, or do I miss something?

[hellhound66]

Removed.

[fsw]

Isn't this just trying to fake OO using a procedural language?

C++ was born that way...

What do you mean by fake? My first example wasn't a fake.

With the principle I showed there are methods, properties and inheritance is easy to do.
Sure there is more to oop than these 3 things, but it's a start.

Comparing these efforts with MS C# for example, this seems
a bit hopeless.

As example, in C#:

Code: Select all

//initialize
this.button1 = new System.Windows.Forms.Button();
//set properties
this.button1.Location = new System.Drawing.Point(37, 39);
this.button1.Size = new System.Drawing.Size(148, 88);
this.button1.Text = "button1";
this.button1.Click += new System.EventHandler(this.button1_Click);

in PureB V4 (my oop system) for the ones that like more the wx style:

Code: Select all

;- initialize and set properties
button1.Gadget = Button("button1", 37, 39, 148, 88, @button1_Click())

or (still my oop system):

Code: Select all

;- initialize
button1.Gadget = Button()
;- set properties
button1\Caption("button1")
button1\Size(37, 39, 148, 88)
button1\OnClick(@button1_Click())

or (still my oop system):

Code: Select all

;- initialize
button1.Gadget = Button()
;- set properties
With button1
  \Caption("button1")
  \Size(37, 39, 148, 88)
  \OnClick(@button1_Click())
EndWith

or (still my oop system) for the ones that like more the RapidQ style:

Code: Select all

;- initialize
button1.Gadget = Button()
;- set properties
With button1
  \Caption("button1")
  \Left(37)
  \Top(39)
  \Width(148)
  \Height(88)
  \OnClick(@button1_Click())
EndWith

All different styles are possible with one include file.

But still a lot of work to do...

[fsw]

Still fiddling around with this stuff.

Managed to get this code to work:

Code: Select all

;create application instance
NewApplication TheApp.GUI()

;create Window
NewWindow MainWindow.Form("OOP Window")
With MainWindow
  \OnClickRight(@WindowProc())
  \Cursor(#IDC_CROSS)
  \Keyboard(#PB_Shortcut_F1, @F1Proc())
EndWith

NewGadget myButton.Button("test 1", 10, 100, 200, 50)
myButton\OnClick(@ButtonProc1())

NewGadget anotherButton.Button("test 2", 10, 200, 200, 50, @ButtonProc2())

;this keeps the app running
TheApp\Run("Quit", "Exit?")
End

and thanks to macros and compilerifs it works great.

Created NewApplication, NewWindow and NewGadget because users are already used to NewList...


But how to minimize the size of the exe

There are some compilerifs to get faked procedures (because they needed to be declared) to get the size somewhat down (empty window = 15kB) but the virtual table and the interface still contain all methods.
Also the Gadget code is not compiled if no Gadget is used etc.

A window with 2 buttons (inclusive their procedures) and a right click menue on the window is over 30kB.
(and there are still more methods to be put in - so many ideas...)

How can the size be reduced dramatically?

Has somebody tried to get several interfaces/vtables to work fine

Any suggestion welcome.
Thanks

BTW: here a list about the window SET/GET methods that are already implemented:

• Handle
  Title
  Hide
  Disable
  State
  Focus
  Destroy (or Close - didn't decide yet)
  Color
  Image
  
  Size
  Left
  Top
  Right
  Bottom
  Width
  Height
  
  Mouse
  MouseX
  MouseY
  Keyboard
  Cursor
  
  ExStyle
  Style
  
  OnMove
  OnFocus
  OnClose
  OnPaint
  OnReSize
  
  OnClick
  OnClickRight
  
  OnMouseMove
  OnMouseDown
  OnMouseDownLeft
  OnMouseDownMiddle
  OnMouseDownRight
  OnMouseUp
  OnMouseUpLeft
  OnMouseUpMiddle
  OnMouseUpRight
  OnMouseWheel
  OnMouseWheelDown
  OnMouseWheelUp

more to come...

Please don't hesitate to comment or to introduce your method idea

Take care

[freak]

> But how to minimize the size of the exe Question

Well, this is a common problem with OOP. Things tend to get big really fast.
Thats because you provide all the functionality without knowing what will
really be used. Thats a price you have to pay.

For bigger projects this is not really a problem though, as more and more
of the functionality gets used and as the general codesize grows, a few
unused but linked functinons do not really hurt anymore.

If you count every byte in the executable though, you will not have much fun with this concept

[theNerd]

This has been an interesting topic (I just read the whole thing for the first time today.) I personally like OOP a lot. I would be very happy if Fred just implemented very simple class support. This would not take away from the basic philosophy of PureBasic but would allow for some nice flexibility. However, perhaps Fred just feels that if he adds even basic class support it will open a whole can of worms and all of a sudden everyone will want to add polymorphism, inherentence, etc., in the end making PureBasic a totally different language. If that's the case then I understand his reluctance to do so.

[fsw]

> But how to minimize the size of the exe Question

Well, this is a common problem with OOP. Things tend to get big really fast.
Thats because you provide all the functionality without knowing what will
really be used. Thats a price you have to pay.

Yep, but the coding itself (when the classes are done) is so much easier.

Suppose that's why HotBasic has the oop lib build inside the compiler (to decide on compile time which methods are used and which not...)

For bigger projects this is not really a problem though, as more and more
of the functionality gets used and as the general codesize grows, a few
unused but linked functinons do not really hurt anymore.

That's also true.

If you count every byte in the executable though, you will not have much fun with this concept

Well I'm not really a byte counter, but don't want to give up that easy

The PB community has so many skilled developers, maybe somebody has an idea

[fsw]

Maybe SubSystems

Having different groups of methods:
SubSystem 1: commands that are used 100% of the time
SubSystem 2: commands that are used 100% and 80% of the time
SubSystem 3: commands that are used 100%, 80% and 60% of the time
SubSystem 4: commands that are used 100%, 80%, 60% and 40% of the time
SubSystem 5: commands that are used 100%, 80%, 60%, 40% and 20% of the time

But for this solution TailbiteV4 is needed...

Why is the pb compiler not able to create libs?
Would be nice to choose under "Compiler Options" Executable Format:

• Windows
  Console
  Shared DLL
  Resident
  PB Library
  OBJ File (sweet)

[Dare2]

Why is the pb compiler not able to create libs?
Would be nice to choose under "Compiler Options" ..

Agreed!

Would make it a much more saleable product as well.

[dell_jockey]

> But how to minimize the size of the exe Question

Well, this is a common problem with OOP. Things tend to get big really fast.
Thats because you provide all the functionality without knowing what will
really be used. Thats a price you have to pay.

not neccesarily. Check out the technical papers on http://smarteiffel.loria.fr
Especially the papers on 'Type Inference for Late Binding' and 'Efficient Dynamic Dispatch without Virtual Tables' are relevant in this context.

I do agree though with your assertion that exe size is mainly an issue for smaller applications.

[Psychophanta]

What about this way?:

Code: Select all

Macro EnableClass(ClassName)
  Global NewList ClassName#.c#ClassName#()
EndMacro
Macro DisableClass(ClassName)
  ;Flush ClassName#.c#ClassName#()  ; <- Pity PB doesn't allow to flush a previously created variable :-|
EndMacro
Macro New_Obj(Object,ClassName)
  AddElement(ClassName#())
  ClassName#()\VTable=?c#ClassName#_VT
  Object#.i#ClassName#=@ClassName#()
EndMacro
Macro Free_Obj(Object,ClassName)
  If ClassName#()=Object
    DeleteElement(ClassName#())
  Else
    PokeL(?c#ClassName#_VT+SizeOf(i#ClassName#),@ClassName#())
    ChangeCurrentElement(ClassName#(),Object#)
    DeleteElement(ClassName#())
    ChangeCurrentElement(ClassName#(),PeekL(?c#ClassName#_VT+SizeOf(i#ClassName#)))
  EndIf
  ;Flush Object  ; <- Pity PB doesn't allow to flush a previously created variable :-|
EndMacro
;_____________________________


;****************************** Create Class PBSC (by remi meier):
; http://www.purebasic.fr/english/viewtopic.php?t=22116
Enumeration
  #PBSC_Identifier
  #PBSC_Number
  #PBSC_String
  #PBSC_Comment
  #PBSC_NewLine
  #PBSC_Other
EndEnumeration
Interface iPBSC
  SetFile.l(FileName.s)
  ResetFilePos()
  IsNextToken.l()
  GetNextToken.s()
  GetCurrentLineNb.l()
  GetCurrentType.l()
  CloseFile()
EndInterface
Structure cPBSC
  *VTable
  FileID.l
  Format.l
  CurrentLine.l
  CurrentType.l
  LastToken.s
  PreLastToken.s
  PrePreLastToken.s
EndStructure
Procedure _PBSC_SetLastToken(*this.cPBSC,s.s)
  ;Static PreLastToken.s = #LF$
  If *this\PreLastToken = "" : *this\PreLastToken=#LF$:EndIf
  *this\PrePreLastToken = *this\PreLastToken
  *this\PreLastToken = *this\LastToken
  *this\LastToken = s
EndProcedure
Procedure.l PBSC_SetFile(*this.cPBSC, FileName.s)
  If IsFile(*this\FileID)
    CloseFile(*this\FileID)
  EndIf
  *this\FileID = ReadFile(#PB_Any, FileName)
  If Not IsFile(*this\FileID)
    ProcedureReturn #False
  EndIf
  _PBSC_SetLastToken(*this, #LF$)
  *this\Format = ReadStringFormat(*this\FileID)
  Select *this\Format
    Case #PB_Ascii, #PB_UTF8, #PB_Unicode
      *this\CurrentLine = 1
      ProcedureReturn #True
    Default
      CloseFile(*this\FileID)
      ProcedureReturn #False
  EndSelect
EndProcedure
Procedure PBSC_ResetFilePos(*this.cPBSC)
  If IsFile(*this\FileID)
    FileSeek(*this\FileID,0)
    *this\CurrentLine = 1 
    _PBSC_SetLastToken(*this, #LF$)
  EndIf
EndProcedure
Procedure.l PBSC_IsNextToken(*this.cPBSC)
  If IsFile(*this\FileID) And Eof(*this\FileID) = #False
    ProcedureReturn #True
  Else
    ProcedureReturn #False
  EndIf
EndProcedure
Procedure.s _PBSC_Trim(*this.cPBSC, s.s)
  Protected *p.CHARACTER, *n.CHARACTER
  *p = @s
  While (*p\c = ' ' Or *p\c = 9) And *p\c
    *p + SizeOf(CHARACTER)
  Wend
  ; *p zeigt auf Start des Textes
  ; suche Ende
  *n = *p
  While *n\c
    *n + SizeOf(CHARACTER)
  Wend
  *n - SizeOf(CHARACTER)
  While (*n\c = ' ' Or *n\c = 9) And *n > *p
    *n - SizeOf(CHARACTER)
  Wend
  ProcedureReturn PeekS(*p, (*n + SizeOf(CHARACTER) - *p)/SizeOf(CHARACTER))
EndProcedure
Procedure.l _PBSC_GetIdentifier(*this.cPBSC, s.s)
  Protected z.l, Len.l, ToLen.l = 0, Const.l = 0, PseudoType.l = 0, Temp.s
  Protected LastToken.s
  If *this\LastToken = "." And (PeekC(@s) = 'p' Or PeekC(@s) = 'P') And PeekC(@s+SizeOf(CHARACTER)) = '-'
    PseudoType = 1
    ToLen = 2
  EndIf
  If PseudoType = 0
    If PeekC(@s) = '#'
      Select PeekC(@*this\LastToken)
        Case '_', 'a' To 'z', 'A' To 'Z', '#'
          Temp = LCase(*this\LastToken)
          Select Temp
            Case "to", "procedurereturn", "select", "case", "if", "elseif", "compilerselect"
              Const = 1 : ToLen = 1
            Case "compilercase", "compilerif", "compilerelseif", "break", "while", "until"
              Const = 1 : ToLen = 1
            Case "debug", "end"
              Const = 1 : ToLen = 1
            Default
              ProcedureReturn 0
          EndSelect
        Case '*'
          If PeekC(@*this\LastToken) = '*' And Len(*this\LastToken) > 1
            ProcedureReturn 0
          Else
            Const = 1
            ToLen = 1
          EndIf
        Default
          Const = 1
          ToLen = 1
      EndSelect
    ElseIf PeekC(@s) = '*'
      For z = 1 To 2
        If z = 1 : LastToken = *this\LastToken
        ElseIf z = 2 : LastToken = *this\PrePreLastToken
        EndIf
        Select PeekC(@LastToken)
          Case '_', 'a' To 'z', 'A' To 'Z', '#'
            Temp = LCase(LastToken)
            Select Temp
              Case "protected", "define", "global", "shared", "static"
                Const = 1
                ToLen = 1
                Break
            EndSelect
          Case '*'
            If PeekC(@LastToken) = '*' And Len(LastToken) > 1
            Else
              Const = 1
              ToLen = 1
              Break
            EndIf
          Default
            Const = 1
            ToLen = 1
            Break
        EndSelect
      Next
      If Const <> 1
        ProcedureReturn 0
      EndIf
    EndIf
    If Const
      z = 1
      While (PeekC(@s+z*SizeOf(CHARACTER)) = ' ' Or PeekC(@s+z*SizeOf(CHARACTER)) = 9)
        Const + 1
        z + 1
        ToLen + 1
      Wend
    EndIf
    Select PeekC(@s + Const*SizeOf(CHARACTER))
      Case '_', 'a' To 'z', 'A' To 'Z'
        ToLen + 1
      Default
        ProcedureReturn 0
    EndSelect
  EndIf
  Len = Len(s)
  For z = 2+Const+PseudoType To Len
    Select Asc(Mid(s, z, 1))
      Case '_', 'a' To 'z', 'A' To 'Z', '0' To '9', '$'
        ToLen + 1
      Default
        *this\CurrentType = #PBSC_Identifier
        ProcedureReturn ToLen
    EndSelect
  Next
  *this\CurrentType = #PBSC_Identifier
  ProcedureReturn ToLen
EndProcedure
Procedure.l _PBSC_GetString(*this.cPBSC, s.s)
  Protected z.l, Len.l, ToLen.l = 0, SearchString.l
  If PeekC(@s) = '"'
    SearchString = #True
    ToLen = 1
  ElseIf PeekC(@s) = Asc("'")
    SearchString = #False
    ToLen = 1
  Else
    ProcedureReturn 0
  EndIf
  Len = Len(s)
  For z = 2 To Len
    If SearchString
      Select Asc(Mid(s, z, 1))
        Case '"'
          *this\CurrentType = #PBSC_String
          ProcedureReturn ToLen + 1
        Default
          ToLen + 1
      EndSelect
    Else
      Select Asc(Mid(s, z, 1))
        Case Asc("'")
          *this\CurrentType = #PBSC_Number
          ProcedureReturn ToLen + 1
        Default
          ToLen + 1
      EndSelect
    EndIf
  Next
  *this\CurrentType = #PBSC_String
  ProcedureReturn ToLen
EndProcedure
Procedure.l _PBSC_GetNumber(*this.cPBSC, s.s) 
  Protected z.l, Len.l, ToLen.l = 0, Digit.l = #False, Hex.l = #False, Spec.l = 0
  If PeekC(@s) = '$'
    Hex = #True
    ToLen = 1
    Spec = 1
  ElseIf PeekC(@s) = '%'
    ToLen = 1
    Spec = 1
  EndIf
  Len = Len(s)
  For z = (1+Spec) To Len
    If Hex
      Select Asc(Mid(s, z, 1))
        Case '0' To '9', 'a' To 'f', 'A' To 'F'
          ToLen + 1
          Digit = #True
        Default
          If Digit
            *this\CurrentType = #PBSC_Number
            ProcedureReturn ToLen
          Else
            ProcedureReturn 0
          EndIf
      EndSelect
    Else
      Select Asc(Mid(s, z, 1))
        Case '0' To '9', '.', 'e'
          If Digit = #False And (Asc(Mid(s, z, 1)) = '.' Or Asc(Mid(s, z, 1)) = 'e')
            ProcedureReturn 0
          EndIf
          ToLen + 1
          Digit = #True
        Case '+', '-'
          If Digit
            If Asc(Mid(s, z-1, 1)) = 'e'
              ToLen + 1
            Else
              *this\CurrentType = #PBSC_Number
              ProcedureReturn ToLen
            EndIf
          Else
            ProcedureReturn 0
          EndIf
        Default
          If Digit
            *this\CurrentType = #PBSC_Number
            ProcedureReturn ToLen
          Else
            ProcedureReturn 0
          EndIf
      EndSelect
    EndIf
  Next
  *this\CurrentType = #PBSC_Number
  ProcedureReturn ToLen
EndProcedure
Procedure.l _PBSC_GetDOperator(*this.cPBSC, s.s)
  Select PeekC(@s)
    Case '<', '>'
      Select PeekC(@s+SizeOf(CHARACTER))
        Case '>', '<', '='
          *this\CurrentType = #PBSC_Other
          ProcedureReturn 2
      EndSelect
  EndSelect
  ProcedureReturn 0
EndProcedure
Procedure.l _PBSC_FindToken(*this.cPBSC, s.s)
  ; ok: Kommentare als Ganzes
  ; ok: Strings als Ganzes (auch mit ' umklammerte)
  ; ok: Bezeichner als Ganzes (auch #KONST, String$, *Ptr)
  ; ok: Pseudotypen als Ganzes
  ; ok: Zahlen: 2001, $5461, %454
  ; ok: Doppeloperatoren
  Static RetVal.l = 0
  If PeekC(@s) = ';'
    _PBSC_SetLastToken(*this, s)
    *this\CurrentType = #PBSC_Comment
    ProcedureReturn Len(s)
  EndIf
  RetVal = _PBSC_GetIdentifier(*this, s)
  If RetVal
    _PBSC_SetLastToken(*this, Left(s, RetVal))
    ProcedureReturn RetVal
  EndIf
  RetVal = _PBSC_GetString(*this, s)
  If RetVal
    _PBSC_SetLastToken(*this, Left(s, RetVal))
    ProcedureReturn RetVal
  EndIf
  RetVal = _PBSC_GetNumber(*this, s)
  If RetVal
    _PBSC_SetLastToken(*this, Left(s, RetVal))
    ProcedureReturn RetVal
  EndIf
  RetVal = _PBSC_GetDOperator(*this, s)
  If RetVal
    _PBSC_SetLastToken(*this, Left(s, RetVal))
    ProcedureReturn RetVal
  EndIf
  _PBSC_SetLastToken(*this, Mid(s, 1, 1))
  *this\CurrentType = #PBSC_Other
  ProcedureReturn 1
EndProcedure
Procedure.s PBSC_GetNextToken(*this.cPBSC)
  Protected s0.s, s.s, Token.s, Len.l, StartPos.l
  Static NextIsNewLine.l = #False
  If IsFile(*this\FileID) And Eof(*this\FileID) = #False
    If NextIsNewLine
      NextIsNewLine = #False
      *this\CurrentLine + 1
      *this\CurrentType = #PBSC_NewLine
      _PBSC_SetLastToken(*this, #LF$)
      ProcedureReturn #LF$
    EndIf
    StartPos = Loc(*this\FileID)
    s0 = ReadString(*this\FileID, *this\Format)
    s = _PBSC_Trim(*this, s0)
    If s = ""
      *this\CurrentLine + 1
      *this\CurrentType = #PBSC_NewLine
      _PBSC_SetLastToken(*this, #LF$)
      ProcedureReturn #LF$
    EndIf
    Len = _PBSC_FindToken(*this.cPBSC, s)
    Token = Left(s, Len)
    If Len = Len(s)
      NextIsNewLine = #True
    Else
      FileSeek(*this\FileID, StartPos + FindString(s0, Token, 1) + Len(Token) - 1)
    EndIf
    ProcedureReturn Token
  Else
    ProcedureReturn ""
  EndIf
EndProcedure
Procedure.l PBSC_GetCurrentLineNb(*this.cPBSC)
  ProcedureReturn *this\CurrentLine
EndProcedure
Procedure.l PBSC_GetCurrentType(*this.cPBSC)
  ProcedureReturn *this\CurrentType
EndProcedure
Procedure PBSC_CloseFile(*this.cPBSC)
  If IsFile(*this\FileID)
    CloseFile(*this\FileID)
  EndIf
EndProcedure
DataSection
cPBSC_VT:
Data.l @PBSC_SetFile(), @PBSC_ResetFilePos(), @PBSC_IsNextToken(), @PBSC_GetNextToken()
Data.l @PBSC_GetCurrentLineNb(), @PBSC_GetCurrentType(), @PBSC_CloseFile()
Data.l 0
EndDataSection
EnableClass(PBSC) ; <- Create and define PBSC() Class (set ready a class to add objects of it).
;******************************* End Create Class PBSC


;________________________Example of use:
New_Obj(test,PBSC)
New_Obj(test2,PBSC)
New_Obj(test3,PBSC)
New_Obj(test4,PBSC)
New_Obj(test5,PBSC)
If test4\SetFile("test.pb")
  While test4\IsNextToken()
    Debug test4\GetNextToken()
  Wend
  test4\CloseFile()
EndIf

The class is made by Remi meier at:
http://www.purebasic.fr/english/viewtopic.php?t=22116