It is currently Tue Jun 02, 2020 9:48 pm

All times are UTC + 1 hour




Post new topic Reply to topic  [ 9 posts ] 
Author Message
 Post subject: Mini Thread Control
PostPosted: Sat Jul 20, 2019 12:22 pm 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 2486
Location: Germany
I have already written some examples to work with threads.
Now I have implemented it on as little code as possible to control thread relatively cleanly. :wink:

Update v1.08
Code:
;-TOP

;- Begin Mini Thread Control

;  by mk-soft, Version 1.08, 20.10.2019

CompilerIf Not #PB_Compiler_Thread
  CompilerError "Use Compiler-Option ThreadSafe!"
CompilerEndIf

Structure udtThreadControl
  ThreadID.i
  UserID.i
  Signal.i
  Pause.i
  Exit.i
EndStructure

Procedure StartThread(*Data.udtThreadControl, *Procedure) ; ThreadID
  If Not IsThread(*Data\ThreadID)
    *Data\Exit = #False
    *Data\Pause = #False
    *Data\ThreadID = CreateThread(*Procedure, *Data)
  EndIf
  ProcedureReturn *Data\ThreadID
EndProcedure

Procedure StopThread(*Data.udtThreadControl, Wait = 1000) ; Void
  If IsThread(*Data\ThreadID)
    *Data\Exit = #True
    If *Data\Pause
      *Data\Pause = #False
      SignalSemaphore(*Data\Signal)
    EndIf
    If Wait
      If WaitThread(*Data\ThreadID, Wait) = 0
        KillThread(*Data\ThreadID)
      EndIf
      *Data\ThreadID = 0
      *Data\Pause = #False
      *Data\Exit = #False
      If *Data\Signal
        FreeSemaphore(*Data\Signal)
        *Data\Signal = 0
      EndIf
    EndIf
  EndIf
EndProcedure

Procedure FreeThread(*Data.udtThreadControl, Stop = #True, Wait = 1000) ; True or False
  If IsThread(*Data\ThreadID)
    If Stop
      StopThread(*Data, Wait)
      FreeStructure(*Data)
      ProcedureReturn #True
    Else
      ProcedureReturn #False
    EndIf
  Else
    If *Data\Signal
      FreeSemaphore(*Data\Signal)
    EndIf
    FreeStructure(*Data)
    ProcedureReturn #True
  EndIf
EndProcedure

Procedure ThreadPause(*Data.udtThreadControl) ; Void
  If IsThread(*Data\ThreadID)
    If Not *Data\Signal
      *Data\Signal = CreateSemaphore()
    EndIf
    If Not *Data\Pause
      *Data\Pause = #True
    EndIf
  EndIf
EndProcedure

Procedure ThreadResume(*Data.udtThreadControl) ; Void
  If IsThread(*Data\ThreadID)
    If *Data\Pause
      *Data\Pause = #False
      SignalSemaphore(*Data\Signal)
    EndIf
  EndIf
EndProcedure

;- End Mini Thread Control

; ****

; Example 1: Multi Threads
; Example 2: RunProgram
; Example 3: Send string from thread to GUI

#Example = 3

;- Example 1

CompilerIf #Example = 1
 
  Enumeration #PB_Event_FirstCustomValue
    #MyEvent_ThreadFinished
  EndEnumeration
 
  Enumeration Gadget
    #ButtonStart1
    #ButtonStart2
    #ButtonPauseResume1
    #ButtonPauseResume2
    #ButtonStop1
    #ButtonStop2
  EndEnumeration
 
  Structure udtFileData
    Name.s
    Result.s
  EndStructure
 
  ; Extends always own data structure with structure from thread control
  Structure udtThreadData Extends udtThreadControl
    ; Data
    Window.i
    Event.i
    List Files.udtFileData()
  EndStructure
 
  Procedure MyThread(*Data.udtThreadData)
    Protected c
   
    With *Data
      Debug "Init Thread " + \UserID
      ;TODO
      Delay(500)
      Debug "Start Thread " + \UserID
      ;TODO
      ForEach \Files()
        ; 1. Query on thread pause
        If \Pause
          Debug "Pause Thread " + \UserID
          WaitSemaphore(\Signal)
          Debug "Resume Thread " + \UserID
        EndIf
        ; 2. Query on thread cancel
        If \Exit
          Break
        EndIf
        ;TODO
        Debug "Busy Thread " + \UserID + ": File " + \Files()\Name
        Delay(500)
        \Files()\Result = "Ready."
      Next
      If \Exit
        ;TODO Thread Cancel
        Debug "Cancel Thread " + \UserID
      Else
        ;TODO Thread Finished
        Debug "Shutdown Thread " + \UserID
        PostEvent(\Event, \Window, 0, 0, *Data) ; <- EventData = Pointer to ThreadData
      EndIf
      Debug "Exit Thread " + \UserID
      ; 3. Clear ThreadID
      \ThreadID = 0
    EndWith
  EndProcedure
 
  ; Create Data always with AllocateStructure 
  Global *th1.udtThreadData = AllocateStructure(udtThreadData)
  *th1\UserID = 1
  *th1\Window = 1
  *th1\Event = #MyEvent_ThreadFinished
  For i = 10 To 30
    AddElement(*th1\Files())
    *th1\Files()\Name = "Data_" + i
  Next
 
  Global *th2.udtThreadData = AllocateStructure(udtThreadData)
  *th2\UserID = 2
  *th2\Window = 1
  *th2\Event = #MyEvent_ThreadFinished
  For i = 31 To 60
    AddElement(*th2\Files())
    *th2\Files()\Name = "Data_" + i
  Next
 
  ; Output Data
  Procedure Output(*Data.udtThreadData)
    Debug "Thread Finished UserID " + *Data\UserID
    MessageRequester("Thread Message", "Thread Finished UserID " + *Data\UserID)
    ForEach *Data\Files()
      Debug *Data\Files()\Name + " - Result " + *Data\Files()\Result
    Next
  EndProcedure
 
  If OpenWindow(1, 0, 0, 222, 250, "Mini Thread Control", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    ButtonGadget(#ButtonStart1, 10, 10, 200, 30, "Start 1")
    ButtonGadget(#ButtonStart2, 10, 50, 200, 30, "Start 2")
    ButtonGadget(#ButtonPauseResume1, 10, 90, 200, 30, "Pause 1")
    ButtonGadget(#ButtonPauseResume2, 10, 130, 200, 30, "Pause 2")
    ButtonGadget(#ButtonStop1, 10, 170, 200, 30, "Stop 1")
    ButtonGadget(#ButtonStop2, 10, 210, 200, 30, "Stop 2")
    Repeat
      Select WaitWindowEvent()
        Case #PB_Event_CloseWindow
          FreeThread(*th1)
          FreeThread(*th2)
          Break
        Case #PB_Event_Gadget
          Select EventGadget()
            Case #ButtonStart1
              StartThread(*th1, @MyThread())
            Case #ButtonStart2
              StartThread(*th2, @MyThread())
            Case #ButtonPauseResume1
              If IsThread(*th1\ThreadID)
                If Not *th1\Pause
                  ThreadPause(*th1)
                  SetGadgetText(#ButtonPauseResume1, "Resume 1")
                Else
                  ThreadResume(*th1)
                  SetGadgetText(#ButtonPauseResume1, "Pause 1")
                EndIf
              EndIf
            Case #ButtonPauseResume2
              If IsThread(*th2\ThreadID)
                If Not *th2\Pause
                  ThreadPause(*th2)
                  SetGadgetText(#ButtonPauseResume2, "Resume 2")
                Else
                  ThreadResume(*th2)
                  SetGadgetText(#ButtonPauseResume2, "Pause 2")
                EndIf
              EndIf
            Case #ButtonStop1
              StopThread(*th1)
              SetGadgetText(#ButtonPauseResume1, "Pause 1")
            Case #ButtonStop2
              StopThread(*th2)
              SetGadgetText(#ButtonPauseResume2, "Pause 2")
          EndSelect
         
        Case #MyEvent_ThreadFinished
          Output(EventData())
         
      EndSelect
    ForEver
  EndIf
 
CompilerEndIf

;- Example 2

CompilerIf #Example = 2
 
  Enumeration #PB_Event_FirstCustomValue
    #MyEvent_ThreadFinished
  EndEnumeration
 
  Enumeration Gadget
    #ButtonStart1
    #ButtonPauseResume1
    #ButtonStop1
  EndEnumeration
 
  ; Extends always own data structure with structure from thread control
  Structure udtThreadData Extends udtThreadControl
    ; Data
    Window.i
    Event.i
    Output.s
  EndStructure
 
  Procedure MyThread(*Data.udtThreadData)
    Protected Compiler, Output.s
   
    With *Data
      Debug "Init Thread " + \UserID
      ;- Begin Thread init
      url.s = "Item1"+#LF$+"Item2"+#LF$
      ;Compiler = RunProgram(#PB_Compiler_Home+"./php", "-r 'echo rawurlencode(" + url + ").PHP_EOL;'", "", #PB_Program_Open | #PB_Program_Read)
      Compiler = RunProgram(#PB_Compiler_Home+"/Compilers/pbcompiler", "-h", "", #PB_Program_Open | #PB_Program_Read)
      Output = ""
      ;- End Thread init
      Debug "Start Thread " + \UserID
      ;- Begin Thread loop
      If Compiler
        While ProgramRunning(Compiler)
          ; 1. Query on thread pause
          If \Pause
            Debug "Pause Thread " + \UserID
            WaitSemaphore(\Signal)
            Debug "Resume Thread " + \UserID
          EndIf
          ; 2. Query on thread cancel
          If \Exit
            Break
          EndIf
          ; Input
          If AvailableProgramOutput(Compiler)
            Output + ReadProgramString(Compiler) + Chr(13)
          Else
            Delay(10)
          EndIf
        Wend
        Output + Chr(13) + Chr(13)
        Output + "Exitcode: " + Str(ProgramExitCode(Compiler))
        CloseProgram(Compiler) ; Close the connection to the program
      Else
        Output = "Error - Programm konnte nicht gestartet werden!"
      EndIf
      ;- End Thread lopp
      If \Exit
        ;- TODO Thread Cancel
        Debug "Cancel Thread " + \UserID
        \Output = "Error - Thread vom user abgebrochen!"
      Else
        ;- TODO Thread Finished
        Debug "Shutdown Thread " + \UserID
        \Output = Output
        PostEvent(\Event, \Window, 0, 0, *Data) ; <- EventData = Pointer to ThreadData
      EndIf
      Debug "Exit Thread " + \UserID
      ; 3. Clear ThreadID
      \ThreadID = 0
    EndWith
  EndProcedure
 
  ; Create Data always with AllocateStructure 
  Global *th1.udtThreadData = AllocateStructure(udtThreadData)
  *th1\UserID = 1
  *th1\Window = 1
  *th1\Event = #MyEvent_ThreadFinished
 
  ; Output Data
  Procedure Output(*Data.udtThreadData)
    Debug "Thread Finished UserID " + *Data\UserID
    MessageRequester("Thread Message", "Thread Finished " + #LF$ + #LF$ + *Data\Output)
  EndProcedure
 
  If OpenWindow(1, 0, 0, 222, 250, "Mini Thread Control", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    ButtonGadget(#ButtonStart1, 10, 10, 200, 30, "Start 1")
    ButtonGadget(#ButtonPauseResume1, 10, 90, 200, 30, "Pause 1")
    ButtonGadget(#ButtonStop1, 10, 170, 200, 30, "Stop 1")
    Repeat
      Select WaitWindowEvent()
        Case #PB_Event_CloseWindow
          FreeThread(*th1)
          Break
        Case #PB_Event_Gadget
          Select EventGadget()
            Case #ButtonStart1
              StartThread(*th1, @MyThread())
            Case #ButtonPauseResume1
              If IsThread(*th1\ThreadID)
                If Not *th1\Pause
                  ThreadPause(*th1)
                  SetGadgetText(#ButtonPauseResume1, "Resume 1")
                Else
                  ThreadResume(*th1)
                  SetGadgetText(#ButtonPauseResume1, "Pause 1")
                EndIf
              EndIf
            Case #ButtonStop1
              StopThread(*th1)
              SetGadgetText(#ButtonPauseResume1, "Pause 1")
          EndSelect
         
        Case #MyEvent_ThreadFinished
          Output(EventData())
         
      EndSelect
    ForEver
  EndIf
 
CompilerEndIf

;- Example 3

CompilerIf #Example = 3
 
  ; ---- String Helper ----
 
  Procedure AllocateString(String.s) ; Result = Pointer
    Protected *mem.string = AllocateStructure(String)
    If *mem
      *mem\s = String
    EndIf
    ProcedureReturn *mem
  EndProcedure
 
  Procedure.s FreeString(*mem.string) ; Result String
    Protected r1.s
    If *mem
      r1 = *mem\s
      FreeStructure(*mem)
    EndIf
    ProcedureReturn r1
  EndProcedure
 
  ; ----
 
 
  Enumeration #PB_Event_FirstCustomValue
    #MyEvent_ThreadSendString
    #MyEvent_ThreadFinished
  EndEnumeration
 
  Enumeration Gadget
    #List
    #ButtonStart1
    #ButtonPauseResume1
    #ButtonStop1
  EndEnumeration
 
 
  ; Extends always own data structure with structure from thread control
  Structure udtThreadData Extends udtThreadControl
    ; Data
    Window.i
    Event.i
  EndStructure
 
  Procedure MyThread(*Data.udtThreadData)
    Protected cnt, stringdata.s
   
    ; Send string over PostEvent and parameter EventData
       
    With *Data
      stringdata = "Init Thread " + \UserID
      PostEvent(#MyEvent_ThreadSendString, \Window, 0, 0, AllocateString(stringdata))
      ;TODO
      Delay(500)
      stringdata = "Start Thread " + \UserID
      PostEvent(#MyEvent_ThreadSendString, \Window, 0, 0, AllocateString(stringdata))
      ;TODO
      For cnt = 1 To 50
        ; 1. Query on thread pause
        If \Pause
          stringdata = "Pause Thread " + \UserID
          PostEvent(#MyEvent_ThreadSendString, \Window, 0, 0, AllocateString(stringdata))
          WaitSemaphore(\Signal)
          stringdata = "Resume Thread " + \UserID
          PostEvent(#MyEvent_ThreadSendString, \Window, 0, 0, AllocateString(stringdata))
        EndIf
        ; 2. Query on thread cancel
        If \Exit
          Break
        EndIf
        ;TODO Cyle Process
        stringdata = "Busy Thread " + \UserID + ": Count " + cnt
        PostEvent(#MyEvent_ThreadSendString, \Window, 0, 0, AllocateString(stringdata))
        Delay(500)
      Next
      If \Exit
        ;TODO Thread Cancel
        stringdata = "Cancel Thread " + \UserID
        PostEvent(#MyEvent_ThreadSendString, \Window, 0, 0, AllocateString(stringdata))
      Else
        ;TODO Thread Finished
        stringdata = "Finished Thread " + \UserID
        PostEvent(#MyEvent_ThreadSendString, \Window, 0, 0, AllocateString(stringdata))
      EndIf
      ; 3. Clear ThreadID
      \ThreadID = 0
    EndWith
  EndProcedure
 
  ; Create Data always with AllocateStructure 
  Global *th1.udtThreadData = AllocateStructure(udtThreadData)
  *th1\UserID = 1
  *th1\Window = 1
 
  If OpenWindow(1, 50, 50, 600, 400, "Mini Thread Control", #PB_Window_SystemMenu)
    ListViewGadget(#List, 5, 5, 590, 360)
    ButtonGadget(#ButtonStart1, 5, 365, 120, 30, "Start")
    ButtonGadget(#ButtonPauseResume1, 130, 365, 120, 30, "Pause")
    ButtonGadget(#ButtonStop1, 255, 365, 120, 30, "Stop")
    Repeat
      Select WaitWindowEvent()
        Case #PB_Event_CloseWindow
          FreeThread(*th1)
          Break
        Case #PB_Event_Gadget
          Select EventGadget()
            Case #ButtonStart1
              StartThread(*th1, @MyThread())
            Case #ButtonPauseResume1
              If IsThread(*th1\ThreadID)
                If Not *th1\Pause
                  ThreadPause(*th1)
                  SetGadgetText(#ButtonPauseResume1, "Resume")
                Else
                  ThreadResume(*th1)
                  SetGadgetText(#ButtonPauseResume1, "Pause")
                EndIf
              EndIf
            Case #ButtonStop1
              StopThread(*th1)
              SetGadgetText(#ButtonPauseResume1, "Pause")
             
          EndSelect
         
        Case #MyEvent_ThreadSendString
          ; Receive string over event data
          AddGadgetItem(#List, -1, FreeString(EventData()))
          ; Small trick to move last item
          SetGadgetState(#List, CountGadgetItems(#List) - 1)
          SetGadgetState(#List, -1)
         
      EndSelect
    ForEver
  EndIf
 
CompilerEndIf


_________________
My Projects ThreadToGUI / OOP-BaseClass / OOP-BaseClassDispatch / EventDesigner V3
PB v3.30 / v5.70 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace


Last edited by mk-soft on Tue Mar 03, 2020 8:21 pm, edited 4 times in total.

Top
 Profile  
Reply with quote  
 Post subject: Re: Mini Thread Control
PostPosted: Sat Jul 20, 2019 1:14 pm 
Offline
User
User

Joined: Sat Jun 22, 2013 4:06 pm
Posts: 20
Location: Coutances FRANCE
Thank you for sharing.


Top
 Profile  
Reply with quote  
 Post subject: Re: Mini Thread Control
PostPosted: Sat Jul 20, 2019 4:38 pm 
Offline
Addict
Addict
User avatar

Joined: Wed Dec 23, 2009 10:14 pm
Posts: 3274
Location: Boston, MA
Thanks for the concepts.
I always refer to you and infratec for threading examples. 8)
The key is NEVER use PauseThread() or ResumeThread().
I had difficult timing errors with the built-in commands and your approach was more stable.
There are some issues when debugging a threaded app, where the main event loop never yields to the thread or the thread signal was lost. I have not been able to reproduce it in a predictable manner. But, the code works great in release mode.

_________________
The nice thing about standards is there are so many to choose from. ~ Andrew Tanenbaum


Top
 Profile  
Reply with quote  
 Post subject: Re: Mini Thread Control
PostPosted: Sun Jul 21, 2019 9:33 am 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 2486
Location: Germany
skywalk wrote:
...
The key is NEVER use PauseThread() or ResumeThread().
...

That's right.
If you then work with mutex and semaphore, you will very quickly establish a deadlock.
Some Purebasic libraries also use various mutex internally with Option ThreadSafe. This can also lead to deadlock in this case.

P.S.
If you do not want to use AllocateStructure, you only need to adapt the FreeThread function.

_________________
My Projects ThreadToGUI / OOP-BaseClass / OOP-BaseClassDispatch / EventDesigner V3
PB v3.30 / v5.70 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace


Top
 Profile  
Reply with quote  
 Post subject: Re: Mini Thread Control
PostPosted: Sun Jul 21, 2019 11:22 am 
Offline
Addict
Addict

Joined: Fri Nov 09, 2012 11:04 pm
Posts: 1760
Location: Uttoxeter, UK
@mk-soft,
Thank you for the example. :D
I always have problems controlling Threads. So any help is always welcome.

_________________
DE AA EB


Top
 Profile  
Reply with quote  
 Post subject: Re: Mini Thread Control
PostPosted: Tue Mar 03, 2020 8:16 pm 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 2486
Location: Germany
Update Examples
- Added Example 3: How to send string from thread to GUI (MainScope)

:wink:

_________________
My Projects ThreadToGUI / OOP-BaseClass / OOP-BaseClassDispatch / EventDesigner V3
PB v3.30 / v5.70 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace


Top
 Profile  
Reply with quote  
 Post subject: Re: Mini Thread Control
PostPosted: Tue Mar 03, 2020 8:39 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sun Jun 11, 2006 12:07 am
Posts: 558
Location: Near Hamburg | Massive deflectable. Does anyone have any experience with microdosing of psylocybine?
Interesting to read that threads are obviously little monsters and not easy to control.

I gave up a custom control project at the time because I couldn't debug the IMAs when using a thread. Thereby I learned to hate threads ;-)

If I have time left, I will definitely take a look at your code, mk-soft. I think very much of your high quality contributions here in the forum.

It's a pity that there are so many really good codes from different areas, but you have to find them all in the forum or from private webspace and adapt them to your needs. It would be great if there was an official source userlibrary (maintained or at least released by Fred) from which you could get / download standardized extension packages for PB. Or even as an IDE function to download these packages and integrate them into the PB installation so that they are seamlessly usable (e.g. as new gadgets, commands or modules).

_________________
PB 5.71 x64, OS: Windows 7 Pro x64, Desktopscaling: 125%, CPU: I7 6500, RAM: 16 GB, GPU: Intel Graphics HD 520, User age: 52y
"Happiness is a pet." | "Never run a changing system!"


Top
 Profile  
Reply with quote  
 Post subject: Re: Mini Thread Control
PostPosted: Wed Mar 04, 2020 1:01 am 
Offline
PureBasic Team
PureBasic Team
User avatar

Joined: Fri Apr 25, 2003 6:14 pm
Posts: 1837
Location: Germany (Saxony, Deutscheinsiedel)
Thank you for this helpful code! :D

_________________
Bye,
...André
(PureBasicTeam::Docs & Support - PureArea.net | Order:: PureBasic | PureVisionXP)


Top
 Profile  
Reply with quote  
 Post subject: Re: Mini Thread Control
PostPosted: Wed Mar 04, 2020 2:35 pm 
Offline
Addict
Addict
User avatar

Joined: Sun Nov 05, 2006 11:42 pm
Posts: 4684
Location: Lyon - France
Using thread for me, is also relaxing than make a picnic in amazonia jungle :oops:
So thanks for sharing this usefull code 8)

_________________
ImageThe happiness is a road...
Not a destination


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 9 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 25 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye