SpiderBasic

Posted: **Fri Feb 02, 2024 4:32 am**

Good morning,

I tried to translate a small Purebasic program to Spiderbasic. I had to modify it, because some PB features are not available with SB. For example ?LABEL, which returns the address of the start of a DataSection label. I am providing you with the source of the program I am trying to modify. It is not from me, but from a member of the forum dedicated to PB in French. Here is its code:

Code: Select all

; ************************************************************************************************************************
; AUTHOR    : MicrodevWeb
; PROJECT   : Pb POO
; REQUIERED : PB 5.60
; ************************************************************************************************************************
DeclareModule RECT
  ;=======================================================================================================================
  ;-* PUBLIC INTERFACE
  ; ----------------------------------------------------------------------------------------------------------------------
  Interface _RECT
    Draw()
    Free()
  EndInterface
  ;}----------------------------------------------------------------------------------------------------------------------
  ;=======================================================================================================================
  ;-* PUBLIC PROTOTYPE
  ; ----------------------------------------------------------------------------------------------------------------------
  Declare New(idCanvas,x,y,w,h,color)
  ;}----------------------------------------------------------------------------------------------------------------------
EndDeclareModule

Module RECT
  EnableExplicit
  ;=======================================================================================================================
  ;-* PRIVATE STRUCTURES
  ; ----------------------------------------------------------------------------------------------------------------------
  Structure sRec
    *VPRO
    idCanvas.l
    x.l
    y.l
    w.l
    h.l
    color.l
  EndStructure
  ;}----------------------------------------------------------------------------------------------------------------------
  ;=======================================================================================================================
  ;=======================================================================================================================
  ;-* PRIVATE FUNCTION
  ; ----------------------------------------------------------------------------------------------------------------------
  Procedure Draw(*this.sRec) 
    With *this
      StartVectorDrawing(CanvasVectorOutput(\idCanvas))
      VectorSourceColor(\color)
      AddPathBox(\x,\y,\w,\h)
      FillPath()
      StopVectorDrawing()
    EndWith
  EndProcedure
  
  Procedure Free(*this.sRec) 
    ClearStructure(*this,sRec)
  EndProcedure
  ;}----------------------------------------------------------------------------------------------------------------------
  ;=======================================================================================================================
  ;-* PUBLIC FUNCTION 
  ; ----------------------------------------------------------------------------------------------------------------------
  Procedure New(idCanvas,x,y,w,h,color)
    Protected *Rec.sRec
    *Rec=AllocateMemory(SizeOf(sRec))
    With *Rec
      \idCanvas=idCanvas
      \x=x
      \y=y
      \w=w
      \h=h
      \color=color
      \VPRO=?VPRO
    EndWith
    ProcedureReturn *Rec
  EndProcedure
  ;}----------------------------------------------------------------------------------------------------------------------
  ;=======================================================================================================================
  ;-* DATA SECTION 
  ; ----------------------------------------------------------------------------------------------------------------------
  
  ;}----------------------------------------------------------------------------------------------------------------------
  DataSection 
    VPRO:
    Data.i @Draw() 
    Data.i @Free() 
  EndDataSection
EndModule

Procedure OpenMainForm()
  Protected.RECT::_RECT rec1,rec2,rec3,rec4
  Protected TimeDelay=400
  OpenWindow(0,0,0,800,600,"Teste POO",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  CanvasGadget(0,0,0,800,600)
  rec1=RECT::New(0,0,0,60,60,$FF2FFFAD)
  rec2=RECT::New(0,70,0,60,60,$FF0000FF)
  rec3=RECT::New(0,140,0,60,60,$FFFF0000)
  rec4=RECT::New(0,0,70,60,60,$FFFF00FF)
  rec1\Draw()
  Delay(TimeDelay)
  rec2\Draw()
  Delay(TimeDelay)
  rec3\Draw()
  Delay(TimeDelay)
  rec4\Draw()
  rec1\Free()
  rec2\Free()
  rec3\Free()
  rec4\Free()
EndProcedure

OpenMainForm()

Repeat
  WaitWindowEvent()
Until Event()=#PB_Event_CloseWindow

I then give you the code that I modified:

Code: Select all

; ************************************************************************************************************************
; AUTHOR    : MicrodevWeb modified by JPH
; PROJECT   : Pb POO
; REQUIERED : PB 5.60
; ************************************************************************************************************************
DeclareModule RECT
  ;=======================================================================================================================
  ;-* PUBLIC INTERFACE
  ; ----------------------------------------------------------------------------------------------------------------------
  Interface _RECT
    Draw()
    Free()
  EndInterface
  ;}----------------------------------------------------------------------------------------------------------------------
  ;=======================================================================================================================
  ;-* PUBLIC PROTOTYPE
  ; ----------------------------------------------------------------------------------------------------------------------
  Declare New(idCanvas,x,y,w,h,color)
  ;}----------------------------------------------------------------------------------------------------------------------
EndDeclareModule

Module RECT
  EnableExplicit
  ;=======================================================================================================================
  ;-* PRIVATE STRUCTURES
  ; ----------------------------------------------------------------------------------------------------------------------
  Structure sRec
    *VPRO
    idCanvas.l
    x.l
    y.l
    w.l
    h.l
    color.l
  EndStructure
  ;}----------------------------------------------------------------------------------------------------------------------
  ;=======================================================================================================================
  ;=======================================================================================================================
  ;-* PRIVATE FUNCTION
  ; ----------------------------------------------------------------------------------------------------------------------
  Procedure Draw(*this.sRec) 
    With *this
      StartVectorDrawing(CanvasVectorOutput(\idCanvas))
      VectorSourceColor(\color)
      AddPathBox(\x,\y,\w,\h)
      FillPath()
      StopVectorDrawing()
    EndWith
  EndProcedure
  
  Procedure Free(*this.sRec) 
    ;ClearStructure(*this,sRec); Original
    FreeStructure(*this); Modified by me but doesn't works no more
  EndProcedure
  ;}----------------------------------------------------------------------------------------------------------------------
  ;=======================================================================================================================
  ;-* PUBLIC FUNCTION 
  ; ----------------------------------------------------------------------------------------------------------------------
  Procedure New(idCanvas,x,y,w,h,color)
    Protected *Rec.sRec
    ;*Rec=AllocateMemory(SizeOf(sRec)); Original
    *Rec = AllocateStructure(sRec); Modified by me but doesn't works no more
    Define VPROLabel
    !rect$v_vprolabel = rect$l_vpro; //Inline JavaScript replace ?VPRO from PB source.
    With *Rec
      \idCanvas=idCanvas
      \x=x
      \y=y
      \w=w
      \h=h
      \color=color
      \VPRO = VPROLabel
    EndWith
    ProcedureReturn *Rec
  EndProcedure
  ;}----------------------------------------------------------------------------------------------------------------------
  ;=======================================================================================================================
  ;-* DATA SECTION 
  ; ----------------------------------------------------------------------------------------------------------------------
  
  ;}----------------------------------------------------------------------------------------------------------------------
  DataSection 
    VPRO:
    Data.i @Draw() 
    Data.i @Free() 
  EndDataSection
EndModule

Procedure Close()
  CloseWindow(0)
EndProcedure

Procedure TimerEvents()
  Debug "Timer event: " + EventTimer()
EndProcedure

Procedure OpenMainForm()
  Protected.RECT::_RECT rec1,rec2,rec3,rec4
  Protected TimeDelay=400
  OpenWindow(0,0,0,800,600,"Teste POO",#PB_Window_ScreenCentered | #PB_Window_TitleBar | #PB_Window_SystemMenu)
  CanvasGadget(0,0,0,800,600)
  rec1=RECT::New(0,0,0,60,60,$FF2FFFAD)
  rec2=RECT::New(0,70,0,60,60,$FF0000FF)
  rec3=RECT::New(0,140,0,60,60,$FFFF0000)
  rec4=RECT::New(0,0,70,60,60,$FFFF00FF)
  Debug "rec1,2,3,4"
  
  ;MESSAGE FROM SB FORUM IN FRENCH
  ;Draw() is accessible via the _Rect interface and is part of this interface. Each procedure of the _Rect interface
  ;receives a pointer to the sRec Structure of the Interface object as a parameter of the object that calls the procedure
  ;Interface. The draw parameter was named *this.sRec as a reminder, but it could have been named anything as long as it
  ;was a pointer to the correct Structure (for example, it could have been named *Blue.sRec).
  
  rec1\Draw(); Never pass by here... This is the point of the error, but I don't know why?
  Debug "rec1/Draw()"
  AddWindowTimer(0, 0, TimeDelay)
  rec2\Draw()
  AddWindowTimer(0, 1, TimeDelay)
  rec3\Draw()
  AddWindowTimer(0, 2, TimeDelay)
  rec4\Draw()
  rec1\Free()
  rec2\Free()
  rec3\Free()
  rec4\Free()
  
  BindEvent(#PB_Event_Timer, @TimerEvents())
EndProcedure

;BindEvent(#PB_Event_Timer, @TimerEvents())
BindEvent(#PB_Event_CloseWindow, @Close())

OpenMainForm()

The modification I made consists of replacing ?VPRO with a VPROLabel variable and assigning it the value of the start of the label using Inline Javascript code. I did this:

Code: Select all

Define VPROLabel
!rect$v_vprolabel = rect$l_vpro; //Inline JavaScript replace ?VPRO from PB source.

So! Does anyone know why the Draw() procedure is not executing?

Thanks in advance.

Posted: **Fri Feb 02, 2024 10:34 am**

If you look at your code in the console of your browser, you will see the following:

You call this function:

Code: Select all

v_rec1._vt._Draw(v_rec1);

but the function is called:

Code: Select all

rect$f_draw(p_this)

Posted: **Sat Feb 03, 2024 10:36 am**

Thank you for your answer. I have looked for a way to solve this problem and I'm unable to do this. I don't know Javascript but I have book on it.

So, I'm searching. Have you a solution to fix it, or this is a SB problem (perhaps a bug?).

Thanks.

SpiderBasic

Problem porting PB to SB (DataSection, Label and Procedure)

Problem porting PB to SB (DataSection, Label and Procedure)

Re: Problem porting PB to SB (DataSection, Label and Procedure)

Re: Problem porting PB to SB (DataSection, Label and Procedure)