Mini Thread Control

Share your advanced PureBasic knowledge/code with the community.
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Mini Thread Control

Post by mk-soft »

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: Select all

;-TOP

;- Begin Mini Thread Control
;  by mk-soft, Version 1.08, 20.10.2019 - 29.04.2023
;  Link: https://www.purebasic.fr/english/viewtopic.php?t=73231

;  Example Update - 03.06.2023

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

;--- MacOS NapStop

CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
  ; Author : Danilo
  ; Date   : 25.03.2014
  ; Link   : https://www.purebasic.fr/english/viewtopic.php?f=19&t=58828
  ; Info   : NSActivityOptions is a 64bit typedef - use it with quads (.q) !!!
  
  #NSActivityIdleDisplaySleepDisabled             = 1 << 40
  #NSActivityIdleSystemSleepDisabled              = 1 << 20
  #NSActivitySuddenTerminationDisabled            = (1 << 14)
  #NSActivityAutomaticTerminationDisabled         = (1 << 15)
  #NSActivityUserInitiated                        = ($00FFFFFF | #NSActivityIdleSystemSleepDisabled)
  #NSActivityUserInitiatedAllowingIdleSystemSleep = (#NSActivityUserInitiated & ~#NSActivityIdleSystemSleepDisabled)
  #NSActivityBackground                           = $000000FF
  #NSActivityLatencyCritical                      = $FF00000000
  
  Procedure BeginWork(Option.q, Reason.s= "MyReason")
    Protected NSProcessInfo = CocoaMessage(0,0,"NSProcessInfo processInfo")
    If NSProcessInfo
      ProcedureReturn CocoaMessage(0, NSProcessInfo, "beginActivityWithOptions:@", @Option, "reason:$", @Reason)
    EndIf
  EndProcedure
  
  Procedure EndWork(Activity)
    Protected NSProcessInfo = CocoaMessage(0, 0, "NSProcessInfo processInfo")
    If NSProcessInfo
      CocoaMessage(0, NSProcessInfo, "endActivity:", Activity)
    EndIf
  EndProcedure
CompilerEndIf

; ****

;-* Select example *

; Example 1: Multi Threads
; Example 2: RunProgram
; Example 3: Send string from thread to GUI
; Example 4: Call thread recursive like get files
; Example 5: MessageRequester from Thread
; Example 6: AddGadgetItem from thread with GTK thread lock (Linux)

#Example = 1

;-* Example 1: Multi Threads

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: Run programm

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: Send string from thread to GUI

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

;-* Example 4: Call thread recursive like get files

CompilerIf #Example = 4
  
  
  EnableExplicit
  
  ; ---- 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_ThreadGetFilesString
    #MyEvent_ThreadGetFilesFinished
    #MyEvent_ThreadGetFilesCancel
  EndEnumeration
  
  Enumeration Gadget
    #List
    #ButtonStart
    #ButtonPauseResume
    #ButtonStop
  EndEnumeration
  
  ; Extends always own data structure with structure from thread control
  Structure udtThreadData Extends udtThreadControl
    ; Data
    cntRecursive.i
    FirstPath.s
    Path.s
    Extension.s
    List Files.s()
  EndStructure
  
  Procedure MyTheadGetFiles(*Data.udtThreadData)
    Protected id, path.s, filename.s, stringdata.s
    
    With *Data
      If \cntRecursive > 0
        path = \Path
      Else
        path = \FirstPath
      EndIf
      
      \cntRecursive + 1
      
      PostEvent(#MyEvent_ThreadGetFilesString, 0, 0, 0, AllocateString("Process: " + path))
      id = ExamineDirectory(#PB_Any, path, "*.*") 
      If id
        While NextDirectoryEntry(id)
          ; 1. Query on thread pause
          If \Pause
            stringdata = "Process: Pause Thread " + \UserID
            PostEvent(#MyEvent_ThreadGetFilesString, 0, 0, 0, AllocateString(stringdata))
            WaitSemaphore(\Signal)
            stringdata = "Process: Resume Thread " + \UserID
            PostEvent(#MyEvent_ThreadGetFilesString, 0, 0, 0, AllocateString(stringdata))
          EndIf
          ; 2. Query on thread cancel
          If \Exit
            Break
          EndIf
          ;TODO Cyle Process
          filename = DirectoryEntryName(id)
          If filename <> "." And filename <> ".."
            If DirectoryEntryType(id) = #PB_DirectoryEntry_File
              If \Extension
                If FindString(\Extension, GetExtensionPart(filename), -1, #PB_String_NoCase)
                  AddElement(\Files())
                  \Files() = path + filename
                EndIf
              Else
                AddElement(\Files())
                \Files() = path + filename
              EndIf  
            Else
              ; Call recursive
              Delay(5) ; Save Processor
              \Path = path + filename + #PS$
              MyTheadGetFiles(*Data) 
            EndIf
          EndIf
        Wend
        FinishDirectory(id)
      EndIf
      
      \cntRecursive - 1
      If \cntRecursive = 0
        If \Exit
          PostEvent(#MyEvent_ThreadGetFilesString, 0, 0, 0, AllocateString("Process: Cancel."))
          PostEvent(#MyEvent_ThreadGetFilesCancel, 0, 0, 0, *Data)
        Else
          PostEvent(#MyEvent_ThreadGetFilesString, 0, 0, 0, AllocateString("Process: Finished."))
          PostEvent(#MyEvent_ThreadGetFilesFinished, 0, 0, 0, *Data)
        EndIf
        \ThreadID = 0
      EndIf
    EndWith
  EndProcedure
  
  Procedure StartGetFiles(*Data.udtThreadData, Path.s, Extension.s = "")
    If Not IsThread(*Data\ThreadID)
      With *Data
        \cntRecursive = 0
        \FirstPath = Path
        \Extension = LCase(Extension)
        ClearList(\Files())
        StartThread(*Data, @MyTheadGetFiles())
      EndWith
      ProcedureReturn #True
    Else
      ProcedureReturn #False
    EndIf
  EndProcedure
  
  Procedure UpdateWindow()
    Protected dx, dy
    dx = WindowWidth(0)
    dy = WindowHeight(0)
    ResizeGadget(#List, 5, 5, dx - 10, dy - 45)
    ResizeGadget(#ButtonStart, 5, dy - 35, 120, 30)
    ResizeGadget(#ButtonPauseResume, 130, dy - 35, 120, 30)
    ResizeGadget(#ButtonStop, 255, dy - 35, 120, 30)
  EndProcedure
  
  ; Create Data always with AllocateStructure  
  Global path.s
  Global *th1.udtThreadData = AllocateStructure(udtThreadData)
  
  Procedure Main()
    Protected dx, dy
    
    #WinStyle = #PB_Window_SystemMenu | #PB_Window_MaximizeGadget | #PB_Window_MinimizeGadget | #PB_Window_SizeGadget
    
    If OpenWindow(0, 50, 50, 600, 400, "Mini Thread Control", #WinStyle)
      dx = WindowWidth(0)
      dy = WindowHeight(0)
      
      ListViewGadget(#List, 5, 5, dx - 10, dy - 45)
      ButtonGadget(#ButtonStart, 5, dy - 35, 120, 30, "Start")
      ButtonGadget(#ButtonPauseResume, 130, dy - 35, 120, 30, "Pause")
      ButtonGadget(#ButtonStop, 255, dy - 35, 120, 30, "Stop")
      
      BindEvent(#PB_Event_SizeWindow, @UpdateWindow(), 0)
      
      Repeat
        Select WaitWindowEvent() 
          Case #PB_Event_CloseWindow
            FreeThread(*th1)
            Break
          Case #PB_Event_Gadget
            Select EventGadget()
              Case #ButtonStart
                If Not IsThread(*th1\ThreadID)
                  path = PathRequester("Select Path", GetHomeDirectory())
                  If path
                    StartGetFiles(*th1, path, "pdf;xml")
                  EndIf
                EndIf
                  
              Case #ButtonPauseResume
                If IsThread(*th1\ThreadID)
                  If Not *th1\Pause
                    ThreadPause(*th1)
                    SetGadgetText(#ButtonPauseResume, "Resume")
                  Else
                    ThreadResume(*th1)
                    SetGadgetText(#ButtonPauseResume, "Pause")
                  EndIf
                EndIf
              Case #ButtonStop
                StopThread(*th1)
                SetGadgetText(#ButtonPauseResume, "Pause")
                
            EndSelect
            
          Case #MyEvent_ThreadGetFilesString
            ; Receive string over event data
            AddGadgetItem(#List, -1, FreeString(EventData()))
            ; Small trick to move last item
            SetGadgetState(#List, CountGadgetItems(#List) - 1)
            SetGadgetState(#List, -1)
            
          Case #MyEvent_ThreadGetFilesFinished
            ForEach *th1\Files()
              Debug *th1\Files()
            Next
            
          Case #MyEvent_ThreadGetFilesCancel
            Debug "Cancel Get files!"
            
        EndSelect
      ForEver
    EndIf
    
  EndProcedure : Main()
  
CompilerEndIf

;-* Example 5: MessageRequester from Thread

CompilerIf #Example = 5
  
  ; ---- 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_ThreadMessageRequester
    #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
    Semaphore.i
  EndStructure
  
  Structure udtMessageRequester
    Semaphore.i
    Result.i
    Title.s
    Text.s
    Flags.i
  EndStructure
  
  Procedure MyThread(*Data.udtThreadData)
    Protected cnt, stringdata.s, message.udtMessageRequester
    
    ; Send string over PostEvent and parameter EventData
    
    With *Data
      stringdata = "Init Thread " + \UserID
      message\Semaphore = CreateSemaphore()
      
      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
        If cnt % 5
          PostEvent(#MyEvent_ThreadSendString, \Window, 0, 0, AllocateString(stringdata))
          Delay(500)
        Else
          message\Title = "Question"
          message\Text = "Continue at Count " + cnt
          message\Flags = #PB_MessageRequester_YesNo
          PostEvent(#MyEvent_ThreadMessageRequester, \Window, 0, 0, @message)
          WaitSemaphore(message\Semaphore)
          If message\Result = #PB_MessageRequester_Yes
             PostEvent(#MyEvent_ThreadSendString, \Window, 0, 0, AllocateString(stringdata))
          Else
            Break
          EndIf
        EndIf
          
      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
      
      ; Relaese resources
      FreeSemaphore(message\Semaphore)
      ; 3. Clear ThreadID 
      \ThreadID = 0
    EndWith
  EndProcedure
  
  ; Create Data always with AllocateStructure  
  Global *th1.udtThreadData = AllocateStructure(udtThreadData)
  Global *thMessage.udtMessageRequester
  
  *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)
          
        Case #MyEvent_ThreadMessageRequester
          *thMessage = EventData()
          If *thMessage
            *thMessage\Result = MessageRequester(*thMessage\Title, *thMessage\Text, *thMessage\Flags)
            SignalSemaphore(*thMessage\Semaphore)
          EndIf
          
      EndSelect
    ForEver
  EndIf
  
CompilerEndIf

;-* Example 6: AddGadgetItem from thread with GTK thread lock (Linux)

CompilerIf #Example = 6
  
  CompilerIf #PB_Compiler_OS <> #PB_OS_Linux
    CompilerError "Only for Linux!"
  CompilerEndIf
  
  Enumeration #PB_Event_FirstCustomValue
    #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 AddLogging(String.s)
    ; get GTK thread lock
    gdk_threads_enter_();
    AddGadgetItem(#List, -1, String)
    ; Small trick to move last item
    SetGadgetState(#List, CountGadgetItems(#List) - 1)
    SetGadgetState(#List, -1)
    ; Make sure all X commands are sent to the X server; not strictly
    ; necessary here, but always a good idea when you do anything
    ; from a thread other than the one where the main loop is running.
    gdk_flush_()
    ; release GTK thread lock
    gdk_threads_leave_()
  EndProcedure
  
  Procedure MyThread(*Data.udtThreadData)
    Protected cnt, stringdata.s
    
    ; Send string over PostEvent and parameter EventData
    
    With *Data
      stringdata = "Init Thread " + \UserID
      AddLogging(stringdata)
      ;TODO
      Delay(500)
      stringdata = "Start Thread " + \UserID
      AddLogging(stringdata)
      ;TODO
      For cnt = 1 To 50
        ; 1. Query on thread pause
        If \Pause
          stringdata = "Pause Thread " + \UserID
          AddLogging(stringdata)
          WaitSemaphore(\Signal)
          stringdata = "Resume Thread " + \UserID
          AddLogging(stringdata)
        EndIf
        ; 2. Query on thread cancel
        If \Exit
          Break
        EndIf
        ;TODO Cyle Process
        stringdata = "Busy Thread " + \UserID + ": Count " + cnt
        AddLogging(stringdata)
        Delay(500)
      Next
      If \Exit
        ;TODO Thread Cancel
        stringdata = "Cancel Thread " + \UserID
        AddLogging(stringdata)
      Else
        ;TODO Thread Finished
        stringdata = "Finished Thread " + \UserID
        AddLogging(stringdata)
      EndIf
      ; 3. Clear ThreadID 
      stringdata = "Exit Thread " + \UserID
      AddLogging(stringdata)
      \ThreadID = 0
    EndWith
  EndProcedure
  
  ; Create Data always with AllocateStructure  
  Global *th1.udtThreadData = AllocateStructure(udtThreadData)
  *th1\UserID = 1
  *th1\Window = 1
  Global *th2.udtThreadData = AllocateStructure(udtThreadData)
  *th2\UserID = 2
  *th2\Window = 1
  
  Procedure Main()
    If OpenWindow(1, 50, 50, 600, 400, "Mini Thread Control", #PB_Window_SystemMenu)
      ListViewGadget(#List, 5, 5, 590, 355)
      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
            If Not IsThread(*th1\ThreadID) And Not IsThread(*th2\ThreadID)
              Break
            Else
              MessageRequester("Info", "Threads running")
            EndIf
            
          Case #PB_Event_Gadget
            Select EventGadget()
              Case #ButtonStart1
                StartThread(*th1, @MyThread())
                StartThread(*th2, @MyThread())
              Case #ButtonPauseResume1
                If IsThread(*th1\ThreadID)
                  If Not *th1\Pause
                    ThreadPause(*th1)
                    SetGadgetText(#ButtonPauseResume1, "Resume")
                  Else
                    ThreadResume(*th1)
                    SetGadgetText(#ButtonPauseResume1, "Pause")
                  EndIf
                  If Not *th2\Pause
                    ThreadPause(*th2)
                  Else
                    ThreadResume(*th2)
                  EndIf
                EndIf
              Case #ButtonStop1
                StopThread(*th1, 0) ; <- No wait because event loop must running
                StopThread(*th2, 0) ; <- No wait because event loop must running
                SetGadgetText(#ButtonPauseResume1, "Pause")
                
            EndSelect
            
        EndSelect
      ForEver
    EndIf
  EndProcedure : Main()
  
CompilerEndIf
Last edited by mk-soft on Mon Jul 24, 2023 10:27 pm, edited 15 times in total.
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
Micoute
User
User
Posts: 24
Joined: Sat Jun 22, 2013 4:06 pm
Location: La Mézière FRANCE

Re: Mini Thread Control

Post by Micoute »

Thank you for sharing.
User avatar
skywalk
Addict
Addict
Posts: 3972
Joined: Wed Dec 23, 2009 10:14 pm
Location: Boston, MA

Re: Mini Thread Control

Post by skywalk »

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
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Mini Thread Control

Post by mk-soft »

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 / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
davido
Addict
Addict
Posts: 1890
Joined: Fri Nov 09, 2012 11:04 pm
Location: Uttoxeter, UK

Re: Mini Thread Control

Post by davido »

@mk-soft,
Thank you for the example. :D
I always have problems controlling Threads. So any help is always welcome.
DE AA EB
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Mini Thread Control

Post by mk-soft »

Update Examples
- Added Example 3: How to send string from thread to GUI (MainScope)

:wink:
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
Kurzer
Enthusiast
Enthusiast
Posts: 664
Joined: Sun Jun 11, 2006 12:07 am
Location: Near Hamburg

Re: Mini Thread Control

Post by Kurzer »

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 6.02 x64, OS: Win 7 Pro x64 & Win 11 x64, Desktopscaling: 125%, CPU: I7 6500, RAM: 16 GB, GPU: Intel Graphics HD 520, User age in 2023: 56y
"Happiness is a pet." | "Never run a changing system!"
User avatar
Andre
PureBasic Team
PureBasic Team
Posts: 2056
Joined: Fri Apr 25, 2003 6:14 pm
Location: Germany (Saxony, Deutscheinsiedel)
Contact:

Re: Mini Thread Control

Post by Andre »

Thank you for this helpful code! :D
Bye,
...André
(PureBasicTeam::Docs & Support - PureArea.net | Order:: PureBasic | PureVisionXP)
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Mini Thread Control

Post by Kwai chang caine »

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
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Mini Thread Control

Post by mk-soft »

Added new Example :wink:

- Example 4: Call thread recursive like get files
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Mini Thread Control

Post by mk-soft »

Add example
- Example 5: MessageRequester from Thread
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Mini Thread Control

Post by mk-soft »

Add example:
- Example 6: AddGadgetItem from thread with GTK thread lock (Linux)
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
Post Reply