PureBasic Forums - English

Posted: **Thu Feb 11, 2016 7:03 pm**

Hi,

I'm trying to do some "class-style-program" (the one with vtables), where I want to bind a gadget inside a class to a procedure inside that class.

However, I can't get this to work.

I have a workaround that does what I want, but I don't understand why the BindGadgetEvent() does not and I really want to understand/learn/know.

The workaround is OK with a few gadgets (or I could even maintain a List() and run a Foreach()+If to call them - whatever), but I'm afraid that would come with a speed-penalty when there are a lot of gadgets.

In the code, I have commented out the bind-instructions which I believe should be OK.

Assuming the procedure I want to call is the first in the vTable list (by design), then I would like to think that a PeekL on the vTable-address gives me the correct address to the procedure to call, but the BindGadgetEvent() doesn't seem to like that either.

Any views on that ? Any suggestions ?

Ludo

Code: Select all


EnableExplicit

Structure TransporterStruct
vTable.L
x.L
y.L
w.L
h.L
name.S
color.L
igadget.L
image.L
EndStructure

Interface TransporterInterface
TransporterHandleEvents()
TransporterGetGadget()
TransPorterRelease()

EndInterface

Procedure TransporterHandleEvents(*This.TransporterStruct)
Debug EventGadget()
Debug *This\name
EndProcedure

Procedure TransporterGetGadget(*This.TransporterStruct)
ProcedureReturn *This\igadget
EndProcedure

Procedure NewTransporter(gadget,x,y,name.S,color=$FF00FF)

Protected *This.TransporterStruct=AllocateMemory(SizeOf(TransporterStruct))
*This\vTable = ?vTable_TransporterClass

Debug "vTable Locaton "+Str(?vTable_TransporterClass)

*This\x=x
*This\y=y
*This\w=100
*This\h=20
*This\color=color
*This\image=CreateImage(#PB_Any,*This\w,*This\h,32,RGBA(120,120,255,255))
*This\name=name
StartDrawing(ImageOutput(*This\image))
Circle(5,5,5,color)
DrawText(30,0,*this\name)
StopDrawing()
*This\igadget=ImageGadget(gadget,*This\x,*This\y,*this\w,*this\h,ImageID(*This\image))

Debug "OBject "+Str(*this)
Debug "vTable "+Str(@*this\vTable)
Debug "vTableAddress "+Str(PeekL(@*this\vTable))

ProcedureReturn *This
EndProcedure

Procedure TransPorterRelease(*This.TransporterStruct)
FreeMemory (*This)
ProcedureReturn #Null
EndProcedure

OpenWindow(0,10,10,230,200,"vtable")

Global *Transport.TransporterInterface=NewTransporter(#PB_Any,10,20,"First ")
Global *Transport1.TransPorterInterface=NewTransporter(#PB_Any,50,100,"Second")

Debug *Transport\TransporterGetGadget()
Debug *Transport1\TransporterGetGadget()

;I want to do a BindGadgetEvent() instead of the if-construct below
;BindGadgetEvent(*Transport\TransporterGetGadget(),@*TransPort\TransporterHandleEvents())
;BindGadgetEvent(*Transport1\TransporterGetGadget(),@*TransPort1\TransporterHandleEvents())

Repeat
   Global MainEvent=WaitWindowEvent(1)
   If MainEvent And EventType()>=0  
      Debug Str(MainEvent)+" "+Str(EventGadget())+" "+Str(EventType())
   
      ; I want to replace this construct with the above BindGadgetEvent()
      If EventGadget()=*Transport\TransporterGetGadget()
         *Transport\TransporterHandleEvents()
      ElseIf EventGadget()=*Transport1\TransporterGetGadget()
         *Transport1\TransporterHandleEvents()
      EndIf

   EndIf      
Until MainEvent=#PB_Event_CloseWindow

*Transport\TransPorterRelease()
*Transport1\TransPorterRelease()

DataSection
   vTable_TransporterClass:
   Data.L @TransporterHandleEvents()
   Data.L @TransporterGetGadget()
   Data.L @TransPorterRelease()
EndDataSection

Posted: **Thu Feb 11, 2016 7:54 pm**

See comments:

Code: Select all

EnableExplicit

Structure TransporterStruct
    vTable.I                                                                             ; CHANGED L to I (for 64-bit compatibility)
    x.L
    y.L
    w.L
    h.L
    name.S
    color.L
    igadget.I                                                                            ; CHANGED L to I
    image.I                                                                              ; CHANGED L to I
EndStructure

Interface TransporterInterface
    TransporterHandleEvents()
    TransporterGetGadget()
    TransPorterRelease()
EndInterface

Procedure TransporterHandleEvents()                                                      ; REMOVED parameter, Event procs can't have params
    Protected *This.TransporterStruct = GetGadgetData( EventGadget() )                   ; ADDED
    Protected Me.TransporterInterface = *This                                            ; ADDED: For calling other Methods, if required
    
    Debug EventGadget()
    
    If *This
        Debug *This\name
    EndIf
EndProcedure

Procedure TransporterGetGadget(*This.TransporterStruct)
    ProcedureReturn *This\igadget
EndProcedure

Procedure NewTransporter(gadget,x,y,name.S,color=$FF00FF)
    
    Protected *This.TransporterStruct=AllocateMemory(SizeOf(TransporterStruct))
    
    InitializeStructure(*This, TransporterStruct)                                        ; ADDED
    
    *This\vTable = ?vTable_TransporterClass
    
    Debug "vTable Locaton "+Str(?vTable_TransporterClass)
    
    *This\x=x
    *This\y=y
    *This\w=100
    *This\h=20
    *This\color=color
    *This\image=CreateImage(#PB_Any,*This\w,*This\h,32,RGBA(120,120,255,255))
    *This\name=name
    
    StartDrawing(ImageOutput(*This\image))
        Circle(5,5,5,color)
        DrawText(30,0,*this\name)
    StopDrawing()
    
    *This\igadget=ImageGadget(gadget,*This\x,*This\y,*this\w,*this\h,ImageID(*This\image))
    
    SetGadgetData(*This\igadget, *This)                                                  ; ADDED: Save *This into Gadget data
    
    Protected Me.TransporterInterface = *This                                            ; ADDED
    BindGadgetEvent(*This\igadget,@Me\TransporterHandleEvents())                         ; ADDED: We can directly connect/bind here
    
    Debug "OBject "+Str(*this)
    Debug "vTable "+Str(@*this\vTable)
    Debug "vTableAddress "+Str(PeekI(@*this\vTable))
    
    ProcedureReturn *This
EndProcedure

Procedure TransPorterRelease(*This.TransporterStruct)
    ClearStructure(*This, TransporterStruct)                                             ; ADDED
    FreeMemory (*This)
    ProcedureReturn #Null
EndProcedure

OpenWindow(0,10,10,230,200,"vtable")

Global *Transport.TransporterInterface=NewTransporter(#PB_Any,10,20,"First ")
Global *Transport1.TransPorterInterface=NewTransporter(#PB_Any,50,100,"Second")

Debug *Transport\TransporterGetGadget()
Debug *Transport1\TransporterGetGadget()

;I want to do a BindGadgetEvent() instead of the if-construct below
;BindGadgetEvent(*Transport\TransporterGetGadget(),@*TransPort\TransporterHandleEvents())
;BindGadgetEvent(*Transport1\TransporterGetGadget(),@*TransPort1\TransporterHandleEvents())

Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow                                 ; CHANGED

*Transport\TransPorterRelease()
*Transport1\TransPorterRelease()

DataSection
    vTable_TransporterClass:
    Data.I @TransporterHandleEvents()                                                    ; CHANGED L to I (3 times)
    Data.I @TransporterGetGadget()
    Data.I @TransPorterRelease()
EndDataSection

Tested with Mac OS X, 64-bit PB.

Posted: **Fri Feb 12, 2016 8:10 am**

Now this is great ! Tested it - works like a breeze.
Deeply appreciated !
Ludo

Posted: **Fri Feb 12, 2016 9:46 am**

By the way, you don't need to use pointer-style (*) when using Interfaces.
The following is fine:

Code: Select all

Transport.TransporterInterface=NewTransporter(#PB_Any,10,20,"First ")
; ...
Transport\TransPorterRelease()

Posted: **Fri Feb 12, 2016 11:54 am**

You should also use FreeImage() in TransPorterRelease()

PureBasic Forums - English

Binding a "class gadget" to a "class procedure"

Binding a "class gadget" to a "class procedure"

Re: Binding a "class gadget" to a "class procedure"

Re: Binding a "class gadget" to a "class procedure"

Re: Binding a "class gadget" to a "class procedure"

Re: Binding a "class gadget" to a "class procedure"