PureBasic

Code : Tout sélectionner

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

Code : Tout sélectionner

;{----------------------------------------------
; 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