PureBasic Forums - English

Posted: **Thu Feb 20, 2020 11:42 am**

Hi all,

Sometime we need to synchronize some values, for example Java and Javafx use it more time for linked the user interface and datas. I tried to make same thing for our lovely Purebasic.

Important note : this module use some threads with the producer consumer pattern, probably you have to configure your compilator with thread management option checked.

At the moment this module can use long property only, but that will change fast.

Code of above example

Code: Select all


XIncludeFile "properties.pbi"

#MAIN_FORM = 0
#PROPERTY_1 = 0
Enumeration 
  #TRACK
  #TEXT
  #BAR
EndEnumeration

Procedure exit()
  End
EndProcedure

Procedure syncBar(id,type)
  SetGadgetState(#BAR,PROPERTIES::getLongValue(#PROPERTY_1))
EndProcedure

Procedure syncText(id,type)
  SetGadgetText(#TEXT,"VALUE = "+Str(PROPERTIES::getLongValue(#PROPERTY_1)))
EndProcedure


Procedure evTrack()
  PROPERTIES::setLongValue(#PROPERTY_1,GetGadgetState(#TRACK))
EndProcedure

Procedure start()
  PROPERTIES::newProperty(#PROPERTY_1,PROPERTIES::#LONG_PROPERTY)
  OpenWindow(#MAIN_FORM,0,0,400,150,"Test properties",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
  StringGadget(#TEXT,10,10,380,30,"")
  TrackBarGadget(#TRACK,10,50,380,30,0,100)
  ProgressBarGadget(#BAR,10,90,380,30,0,100)
  PROPERTIES::bind(#PROPERTY_1,@syncBar())
  PROPERTIES::bind(#PROPERTY_1,@syncText())
  BindEvent(#PB_Event_CloseWindow,@exit(),#MAIN_FORM)
  BindGadgetEvent(#TRACK,@evTrack())
EndProcedure

start()

Repeat
  WaitWindowEvent()
ForEver

Module code

Code: Select all

;{----------------------------------------------
; PACKAGE NAME  : PROPERTIES
; AUTHOR        : MICRODEVWEB
; DATE          : 2020/02/20
; MAJOR VERSION : 1
; MINOR VERSION : 0
;}----------------------------------------------
DeclareModule PROPERTIES
  Enumeration 
    #LONG_PROPERTY
    #DOUBLE_PROPERTY
    #FLOAT_PROPERTY
    #STRING_PROPERTY
  EndEnumeration
  Declare newProperty(Idproperty,TypeProperty)
  Declare getLongValue(Idproperty)
  Declare setLongValue(Idproperty,value)
  Declare bind(Idproperty,*callback)
EndDeclareModule
Module PROPERTIES
  EnableExplicit
  Prototype callback(property,type)
  #BUFFER_LEN = 10
  
  Structure _fifo
    Array  *buffer(#BUFFER_LEN) 
    input.i
    output.i
    items.i
    spaces.i
    mutex.i
  EndStructure
  Structure _pro
    List *callback()
    type.l
    thread.l
    fifo._fifo
    id.l
  EndStructure
  Structure _long Extends _pro
    value.l
  EndStructure
  Structure _double Extends _pro  
    value.d
  EndStructure
  Structure _float Extends _pro  
    value.f
  EndStructure
  Structure _string Extends _pro  
    value.s
  EndStructure
  
  
  
  Global NewMap myProperties._pro()
  Global mutex = CreateMutex()
  
  Declare pop(*property._pro)
  
  Procedure synchronize(*property._pro)
    Protected call.callback
    Repeat
      call = pop(*property)
      call(*property\id,*property\type)
    ForEver 
  EndProcedure
  
  Procedure push(*property._pro,*callback)
    With *property\fifo
      WaitSemaphore(\spaces)                      ; wait for space into the buffer
      LockMutex(\mutex)                           ; mutual exclusion
      \buffer(\input) = *callback                ; push into the list
      \input +1                                   ; next list position
                                                  ; manage circular list
      If \input >= #BUFFER_LEN                    ; uper to buufer length
        \input = 0 
      EndIf
      UnlockMutex(\mutex)                         ; end of mutual exclusion
      SignalSemaphore(\items)                     ; tel data available
    EndWith
  EndProcedure
  
  Procedure pop(*property._pro)
    With *property\fifo
      Protected *returned_value = 0
      WaitSemaphore(\items)               ; wait for data available
      LockMutex(\mutex)                   ; mutual exclusion
      *returned_value = \buffer(\output)   ; load from the List
      \output +1                          ; next list position
                                          ; manage circular list
      If \output >= #BUFFER_LEN           ; uper to bufer length
        \output = 0 
      EndIf
      UnlockMutex(\mutex)                 ; End of mutual exclusion
      SignalSemaphore(\spaces)            ; tel space available
      ProcedureReturn  *returned_value
    EndWith
  EndProcedure
  
  Procedure newProperty(Idproperty,TypeProperty)
    If Not FindMapElement(myProperties(),Str(Idproperty))
      AddMapElement(myProperties(),Str(Idproperty))
      myProperties()\type = TypeProperty
      myProperties()\id = Idproperty
      myProperties()\fifo\mutex = CreateMutex()
      myProperties()\fifo\items = CreateSemaphore(0)
      myProperties()\fifo\spaces = CreateSemaphore(#BUFFER_LEN)
    EndIf
  EndProcedure
  
  Procedure getLongValue(Idproperty)
    Protected vRet
    If FindMapElement(myProperties(),Str(Idproperty))
      LockMutex(myProperties()\fifo\mutex)
      Define *v._long = myProperties()
      vRet = *v\value 
      UnlockMutex(myProperties()\fifo\mutex)
    EndIf
    ProcedureReturn vRet
  EndProcedure
  
  Procedure setLongValue(Idproperty,value)
    If FindMapElement(myProperties(),Str(Idproperty))
      LockMutex(myProperties()\fifo\mutex)
      Define *v._long = myProperties()
      *v\value = value
      ForEach myProperties()\callback()
        push(myProperties(),myProperties()\callback())
      Next
      UnlockMutex(myProperties()\fifo\mutex)
    EndIf
    
  EndProcedure
  
  Procedure bind(Idproperty,*callback)
    If FindMapElement(myProperties(),Str(Idproperty))
      LockMutex(myProperties()\fifo\mutex)
      AddElement(myProperties()\callback())
      myProperties()\callback() = *callback
      If Not myProperties()\thread
        myProperties()\thread = CreateThread(@synchronize(),@myProperties())
      EndIf
      UnlockMutex(myProperties()\fifo\mutex)
    EndIf
  EndProcedure
  
EndModule

Posted: **Thu Feb 20, 2020 8:01 pm**

Thanks for sharing!

PureBasic Forums - English

[MODULE] properties

[MODULE] properties

Re: [MODULE] properties