PureBasic

Forums PureBasic
Nous sommes le Dim 05/Avr/2020 20:47

Heures au format UTC + 1 heure




Poster un nouveau sujet Répondre au sujet  [ 2 messages ] 
Auteur Message
 Sujet du message: Bind of variables
MessagePosté: Lun 17/Fév/2020 14:28 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 29/Juin/2011 14:11
Messages: 1723
Localisation: Belgique
Bonjour,
Voici un petit test de Bing à la Java. Le principe est de binder des variables et de les mettre à jour automatiquement.

Remarque : utilise les thread avec le principe de producteur / consommateur et un buffer de type fifo

Bon actuellement le code n'est pas commenté et pas très propre (c'est juste un teste)

Le but serait de faire par après un module table avec un bind automatique, ainsi que pour d'autre gadget pourquoi pas

Code du main

Code:
XIncludeFile "bind.pbi"
Global myLst.BIND::listProperty = BIND::newListProperty()

Procedure callBack(item.BIND::stringProperty,line,column,action)
  Protected n
  Select action
    Case BIND::#ACTION_ADD
      AddGadgetItem(0,-1,item\getValue())
      SetGadgetItemData(0,CountGadgetItems(0)-1,item)
    Case BIND::#ACTION_SET
      For n = 0 To CountGadgetItems(0)-1
        If GetGadgetItemData(0,n) = item
          SetGadgetItemText(0,n,item\getValue())
        EndIf
      Next
  EndSelect
EndProcedure
myLst\link(@callBack())
Procedure exit()
  End
EndProcedure

Procedure add()
  Protected myItems.BIND::itemProperty
  myItems = myLst\addLine()
  myItems\addItem(BIND::newStringProperty(GetGadgetText(1)))
  SetGadgetText(1,"")
EndProcedure

Procedure edit()
  If GetGadgetState(0) > -1
    Protected item.BIND::stringProperty = GetGadgetItemData(0,GetGadgetState(0))
    item\setValue(GetGadgetText(1))
  EndIf
EndProcedure




OpenWindow(0,0,0,800,600,"Teste",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
ListIconGadget(0,0,0,200,600,"Name",200,#PB_ListIcon_AlwaysShowSelection)
StringGadget(1,220,50,150,30,"")
ButtonGadget(2,220,80,100,30,"Add")
ButtonGadget(3,220,120,100,30,"Edit")
BindEvent(#PB_Event_CloseWindow,@exit(),0)
BindGadgetEvent(2,@add())
BindGadgetEvent(3,@edit())

Repeat
  WaitWindowEvent()
ForEver



Code du module

Code:
DeclareModule BIND
  Enumeration
    #ACTION_ADD
    #ACTION_SET
    #ACTION_DELETE
  EndEnumeration
  Interface stringProperty
    getValue.s()
    setValue(values.s)
  EndInterface
  Interface listProperty
    addLine()
    link(callback)
    getItem(line)
  EndInterface
  Interface itemProperty
    addItem(stringProperty)
    getStringProperty(column)
  EndInterface
 
  Declare newStringProperty(value.s = "")
  Declare newListProperty()
EndDeclareModule
Module BIND
  EnableExplicit
  #BUFFER_LEN = 50
 
  Prototype callback(*stringProperty,line,column,action)
 
 
  Structure _stringProperty
    *methods
    value.s
    action.i
    column.i
    line.i
    *parent
  EndStructure
  Structure _fifo
    mutex.i
    items.i
    spaces.i
    Array *buffer._stringProperty(#BUFFER_LEN)
    input.i
    output.i
    *callback.callback
  EndStructure
  Structure _listItems
    *methods
    List *myStringProperty._stringProperty()
    *parent
    line.i
  EndStructure
  Structure _listProperty
    *methods
    List *myList._listItems()
    *myFifo._fifo
    popThr.i
    *callback
  EndStructure
 
  Procedure push(*this._fifo,*item)
    With *this
      WaitSemaphore(\spaces)      ; wait for space into the buffer
      LockMutex(\mutex)           ; mutual exclusion
      \buffer(\input) = *item     ; push into the list
      \input +1                   ; next list position
      ; manage circular list
      If \input >= #BUFFER_LEN    ; uper to buffer length
        \input = 0
      EndIf
      UnlockMutex(\mutex)         ; end of mutual exclusion
      SignalSemaphore(\items)     ; tel data available
    EndWith
  EndProcedure
 
  Procedure pop(*this._fifo)
    With *this
      Protected *returned_value._stringProperty
      Repeat
        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
        \callback(*returned_value,*returned_value\line,*returned_value\column,*returned_value\action)
      ForEver
    EndWith
  EndProcedure
 
 
  Procedure newStringProperty(value.s = "")
    Protected *this._stringProperty = AllocateStructure(_stringProperty)
    With *this
      \methods = ?S_string_pro
      \value = value
      ProcedureReturn *this
    EndWith
  EndProcedure
 
  Procedure newListProperty()
    Protected *this._listProperty = AllocateStructure(_listProperty)
    With *this
      \methods = ?S_list_pro
      \myFifo = AllocateStructure(_fifo)
      ProcedureReturn *this
    EndWith
  EndProcedure
 
  Procedure newListItem()
    Protected *this._listItems = AllocateStructure(_listItems)
    With *this
      \methods = ?S_list_item
      ProcedureReturn *this
    EndWith
  EndProcedure
 
  Procedure list_addLine(*this._listProperty)
    With *this
      AddElement(\myList())
      \myList() = newListItem()
      \myList()\parent = *this
      \myList()\line = ListSize(\myList())
      ProcedureReturn \myList()
    EndWith
  EndProcedure
 
  Procedure addItem(*this._listItems,*stringProperty._stringProperty)
    With *this
      AddElement(\myStringProperty())
      \myStringProperty() = *stringProperty
      *stringProperty\column = ListSize(\myStringProperty())
      *stringProperty\parent = *this
      Define *p._listProperty = \parent
      *stringProperty\line = \line
      *stringProperty\action = #ACTION_ADD
      push(*p\myFifo,*stringProperty)
      ProcedureReturn \myStringProperty()
    EndWith
  EndProcedure
 
  Procedure list_link(*this._listProperty,*method)
    With *this
      If Not \popThr
        \myFifo\mutex = CreateMutex()
        \myFifo\items = CreateSemaphore(0)
        \myFifo\spaces = CreateSemaphore(#BUFFER_LEN)
        \myFifo\callback = *method
        \popThr = CreateThread(@pop(),\myFifo)
      EndIf
    EndWith
  EndProcedure
 
  Procedure.s str_getValue(*this._stringProperty)
    With *this
      ProcedureReturn \value
    EndWith
  EndProcedure
 
  Procedure list_get(*this._listProperty,line)
    With *this
      If SelectElement(\myList(),line - 1)
        ProcedureReturn  \myList()
      EndIf
      ProcedureReturn 0 
    EndWith
  EndProcedure
 
  Procedure item_get(*this._listItems,column)
    With *this
      If SelectElement(\myStringProperty(),column -1)
        ProcedureReturn \myStringProperty()
      EndIf
      ProcedureReturn 0
    EndWith
  EndProcedure
 
  Procedure str_setValue(*this._stringProperty,value.s)
    With *this
      \value = value.s
      Define  *p._listItems = \parent
      Define *pp._listProperty = *p\parent
      \action = #ACTION_SET
      push(*pp\myFifo,*this)
    EndWith
  EndProcedure
 
  DataSection
    S_string_pro:
    Data.i @str_getValue()
    Data.i @str_setValue()
    S_list_pro:
    Data.i @list_addLine()
    Data.i @list_link()
    Data.i @list_get()
    S_list_item:
    Data.i @addItem()
    Data.i @item_get()
  EndDataSection
EndModule

_________________
Windows 10 64 bits PB: 5.70 ; 5.72 LST


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Bind of variables
MessagePosté: Lun 17/Fév/2020 16:38 
Hors ligne
Avatar de l’utilisateur

Inscription: Sam 23/Sep/2006 18:32
Messages: 6689
Localisation: Isere
Comme dab c'est joli 8)
Mais alors, faut se lever de bonne heure pour caser tout ça dans une conversation 8O :oops:
Je ne pense pas que ça me servira un jour, mais en tout cas merci du partage 8)

_________________
ImageLe bonheur est une route...
Pas une destination

PureBasic Forum Officiel - Site PureBasic


Haut
 Profil  
Répondre en citant le message  
Afficher les messages postés depuis:  Trier par  
Poster un nouveau sujet Répondre au sujet  [ 2 messages ] 

Heures au format UTC + 1 heure


Qui est en ligne

Utilisateurs parcourant ce forum: Aucun utilisateur enregistré et 3 invités


Vous ne pouvez pas poster de nouveaux sujets
Vous ne pouvez pas répondre aux sujets
Vous ne pouvez pas éditer vos messages
Vous ne pouvez pas supprimer vos messages

Rechercher:
Aller à:  

 


Powered by phpBB © 2008 phpBB Group | Traduction par: phpBB-fr.com
subSilver+ theme by Canver Software, sponsor Sanal Modifiye