Update v1.05
Code: Select all
;-TOP
; Comment : Module Threadcontrol
; Author : mk-soft
; Version : v1.05
; Create : 22.05.2016
; Update : 27.07.2017
; OS : All
; ***************************************************************************************
; Thread Callback Results
;
; Procedure cbRunning(*data)
; - Result 0 : Running
; - Result 1 : Stopped
; - Result 2 : Exiting
;
; Procedure cbStart(*data)
; - Result 0 : Stopped
; - Result 1 : Running
;
; Procedure cbStop(*data)
; - Result 0 : Running
; - Result 1 : Stopped
;
; Procedure cbContinue(*data)
; - Result 0 : Stopped
; - Result 1 : Running
;
; Procedure cbExit(*data)
; - Result 0 : Old State
; - Result 1 : Exiting
; ***************************************************************************************
DeclareModule ThreadControl
Enumeration
#thInit
#thStartup
#thRunning
#thStopping
#thStopped
#thContinuing
#thShutdown
#thFinished
#thWait
EndEnumeration
Declare thCreate(*data, *cbRunning, *cbStart = 0, *cbStop = 0, *cbContinue = 0, *cbExit = 0)
Declare thStart(*thread)
Declare thStop(*thread)
Declare thContinue(*thread)
Declare thExit(*thread)
Declare thKill(*thread)
Declare thRelease(*thread)
Declare thState(*thread)
EndDeclareModule
Module ThreadControl
EnableExplicit
; -----------------------------------------------------------------------------------
Enumeration
#thCmdNothing
#thCmdStart
#thCmdStop
#thCmdContinue
#thCmdExit
EndEnumeration
; -----------------------------------------------------------------------------------
Prototype Invoke(*data)
Structure udtThread
; Header
handle.i
signal.i
cmd.i
state.i
; Userdata
*data
; Callback
cbRunning.Invoke
cbStart.Invoke
cbStop.Invoke
cbContinue.Invoke
cbExit.Invoke
EndStructure
; -----------------------------------------------------------------------------------
Declare thWork(*thread.udtThread)
; -----------------------------------------------------------------------------------
Procedure thCreate(*data, *cbRunning, *cbStart = 0, *cbStop = 0, *cbContinue = 0, *cbExit = 0)
Protected *thread.udtThread
*thread = AllocateStructure(udtThread)
If Not *thread
ProcedureReturn 0
EndIf
With *thread
; Init Header
\handle = 0
\signal = CreateSemaphore()
\cmd = #thCmdNothing
\state = #thWait
; Init Data
\data = *data
; Init Callback
\cbRunning = *cbRunning
\cbStart = *cbStart
\cbStop = *cbStop
\cbContinue = *cbContinue
\cbExit = *cbExit
EndWith
ProcedureReturn *thread
EndProcedure
; -----------------------------------------------------------------------------------
Procedure thStart(*thread.udtThread)
If Not *thread : ProcedureReturn 0 : EndIf
With *thread
If \state => #thFinished
\state = #thInit
\handle = CreateThread(@thWork(), *thread)
If \handle
\cmd = #thCmdStart
Else
\state = #thWait
EndIf
EndIf
EndWith
EndProcedure
; -----------------------------------------------------------------------------------
Procedure thStop(*thread.udtThread)
If Not *thread : ProcedureReturn 0 : EndIf
With *thread
If \state = #thRunning
\cmd = #thCmdStop
EndIf
EndWith
EndProcedure
; -----------------------------------------------------------------------------------
Procedure thContinue(*thread.udtThread)
If Not *thread : ProcedureReturn 0 : EndIf
With *thread
If \state = #thStopped
\cmd = #thCmdContinue
SignalSemaphore(\signal)
EndIf
EndWith
EndProcedure
; -----------------------------------------------------------------------------------
Procedure thExit(*thread.udtThread)
If Not *thread : ProcedureReturn 0 : EndIf
With *thread
If \state < #thShutdown
\cmd = #thCmdExit
If \state = #thStopped
SignalSemaphore(\signal)
EndIf
EndIf
EndWith
EndProcedure
; -----------------------------------------------------------------------------------
Procedure thKill(*thread.udtThread)
If Not *thread : ProcedureReturn 0 : EndIf
With *thread
\state = #thShutdown
If IsThread(\handle)
KillThread(\handle)
EndIf
\handle = 0
\state = #thFinished
EndWith
EndProcedure
; -----------------------------------------------------------------------------------
Procedure thRelease(*thread.udtThread)
If Not *thread : ProcedureReturn 0 : EndIf
With *thread
If \state => #thFinished
FreeSemaphore(\signal)
FreeStructure(*thread)
ProcedureReturn 0
Else
ProcedureReturn *thread
EndIf
EndWith
EndProcedure
; -----------------------------------------------------------------------------------
Procedure thState(*thread.udtThread)
If *thread
ProcedureReturn *thread\state
Else
ProcedureReturn 0
EndIf
EndProcedure
; -----------------------------------------------------------------------------------
Procedure thWork(*thread.udtThread)
Protected old_state
With *thread
Repeat
; Go Sleeping
If \state = #thStopped
WaitSemaphore(\signal)
EndIf
; Check Command
Select \cmd
Case #thCmdStart
\cmd = #thCmdNothing
If \state = #thInit
\state = #thStartup
; Code Startup
If \cbStart
If \cbStart(\data)
\state = #thRunning
Else
\state = #thStopped
EndIf
Else
\state = #thRunning
EndIf
; ...
EndIf
Case #thCmdStop
\cmd = #thCmdNothing
If \state = #thRunning
\state = #thStopping
; Code Stopping
If \cbStop
If \cbStop(\data)
\state = #thStopped
Else
\state = #thRunning
EndIf
Else
\state = #thStopped
EndIf
; ...
EndIf
Case #thCmdContinue
\cmd = #thCmdNothing
If \state = #thStopped
\state = #thContinuing
; Code Continue
If \cbContinue
If \cbContinue(\data)
\state = #thRunning
Else
\state = #thStopped
EndIf
Else
\state = #thRunning
EndIf
; ...
EndIf
Case #thCmdExit
\cmd = #thCmdNothing
If \state < #thShutdown
old_state = \state
\state = #thShutdown
; Code Exit
If \cbExit
If \cbExit(\data)
Break
Else
\state = old_state
EndIf
Else
Break
EndIf
; ...
EndIf
EndSelect
; Cycle Code
If \state = #thRunning
If \cbRunning
Select \cbRunning(\data)
Case 1
\state = #thStopped
Case 2
Break
EndSelect
Else
Delay(100)
EndIf
EndIf
ForEver
; Exit
\handle = 0
\state = #thFinished
EndWith
EndProcedure
EndModule
; ***************************************************************************************
CompilerIf #PB_Compiler_IsMainFile
Structure udtData
counter.i
EndStructure
Global MyData.udtData
UseModule ThreadControl
; -----------------------------------------------------------------------------------
Procedure doMain(*data.udtData)
With *data
\counter + 1
Debug \counter
Delay(1000)
If \counter % 10 = 0
ProcedureReturn 1
ElseIf \counter % 25 = 0
ProcedureReturn 2
Else
ProcedureReturn 0
EndIf
EndWith
EndProcedure
; -----------------------------------------------------------------------------------
Procedure doStart(*data.udtData)
Debug "Thread Start..."
With *data
\counter = 0
Delay(1000)
EndWith
ProcedureReturn 1
EndProcedure
; -----------------------------------------------------------------------------------
Procedure doStop(*data.udtData)
Debug "Thread Stopping..."
With *data
Delay(1000)
EndWith
ProcedureReturn 1
EndProcedure
; -----------------------------------------------------------------------------------
Procedure doContinue(*data.udtData)
Debug "Thread Continue..."
With *data
Delay(1000)
EndWith
ProcedureReturn 1
EndProcedure
; -----------------------------------------------------------------------------------
Procedure doExit(*data.udtData)
Debug "Thread Shutdown..."
With *data
Delay(1000)
EndWith
ProcedureReturn 1
EndProcedure
; -----------------------------------------------------------------------------------
Procedure.s GetStateStr(state)
Protected result.s
Select state
Case #thInit : Result = "Thread Init"
Case #thStartup : Result = "Thread Starting"
Case #thRunning : Result = "Thread Running"
Case #thStopping : Result = "Thread Stopping"
Case #thStopped : Result = "Thread Stopped"
Case #thContinuing : Result = "Thread Resume"
Case #thShutdown : Result = "Thread Shutdown"
Case #thFinished : Result = "Thread Finished"
Case #thWait : Result = "Thread Wait for first start"
Default
EndSelect
ProcedureReturn result
EndProcedure
; -----------------------------------------------------------------------------------
Procedure Main()
Protected *thread1
Protected start, ende, cont, timer
*thread1 = thCreate(@MyData, @doMain(), @doStart(), @doStop(), @doContinue(), @doExit())
;*thread1 = thCreate(@MyData, @doMain())
If OpenWindow(0, #PB_Any, #PB_Any, 400, 150, "Thread-Test", #PB_Window_SystemMenu)
CreateStatusBar(0, WindowID(0))
AddStatusBarField(#PB_Ignore)
ButtonGadget(0, 10, 10, 80, 25, "Start")
ButtonGadget(1, 100, 10, 80, 25, "Stop")
ButtonGadget(2, 190, 10, 80, 25, "Cont")
ButtonGadget(3, 280, 10, 80, 25, "Exit")
AddWindowTimer(0, 1, 100)
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
Break
Case #PB_Event_Gadget
Select EventGadget()
Case 0
thStart(*thread1)
Case 1
thStop(*thread1)
Case 2
thContinue(*thread1)
Case 3
thExit(*thread1)
EndSelect
Case #PB_Event_Timer
StatusBarText(0, 0, GetStateStr(thState(*thread1)))
EndSelect
ForEver
EndIf
EndProcedure : Main()
CompilerEndIf