ThreadCreate

[Löwenherz]

hello all, I am just looking for a better ThreadCreate example, thanks

Code: Select all

' ThreadCall and ThreadCreate example
' I am looking for a better ThreadCreate example
'
'----------- example 1 threadCall -------------- //

Sub thread(id As String, tlock As Any Ptr, anzahl as Integer = 7) 
  For i As Integer = 1 To anzahl
    MutexLock tlock
    Print "loop "; id; " is running with number "; i
    MutexUnlock tlock
    Sleep 1
  Next
End Sub

Dim tlock As Any Ptr = MutexCreate()
Dim a As Any Ptr = ThreadCall thread("F", tlock)
Dim b As Any Ptr = ThreadCall thread("B", tlock, 9) 
ThreadWait a
ThreadWait b
MutexDestroy tlock
Print "done !"
Sleep

'----------- example 2 threadCreate -------------- //
' -- looking for another example ---- //

Sub Wife ( ByVal laughing As Any Ptr) ' what about 'laughing' using threadCreate ???
	
End Sub

Var threadA = ThreadCreate( @Wife )

Do	
Loop Until MultiKey(1) 'esc
Print "ok"
sleep

[fxm]

Small example proving multi-threading capacity:
(in a non multi-threading code, we cannot do anything else while waiting for the "Line Input" instruction to return)

Code: Select all

Sub thread(Byval p As Any Ptr)
    Do
        Static As String t
        Draw String (0, 16), t, 0
        t = Time
        Draw String (0, 16), t
        Do
            If *Cast(String Ptr, p) = "quit" Then Exit Sub
            Sleep 100, 1
        Loop Until Time <> t  ' to limit flickering
    Loop
End Sub

Dim As String s
Dim As Any Ptr pThread

Screen 12
Print "Time is updated by thread even while 'Line Input' is waiting for characters:"
Locate 4, 1
Print "Enter any character line to test, or 'quit' to finish:"
pThread = Threadcreate(@thread, @s)
Do
    Locate 5, 1
    Print Space(Len(s));
    Locate 5, 1
    Line Input s
Loop Until s = "quit"
ThreadWait(pThread)

[fxm]

Improved version of the above in order to additionally remove all flickering by using double buffering:
(screen locking and page flipping are not usable here)

Code: Select all

Sub thread(Byval p As Any Ptr)
    Screenset 1, 0 ' to avoid flickering by double buffering
    Do
        Static As String t
        Draw String (0, 16), t, 0
        t = Time
        Draw String (0, 16), t
        Screencopy ' to avoid flickering by double buffering
        Sleep 15, 1 ' to screen copy each 15 ms
    Loop Until *Cast(String Ptr, p) = "quit"
End Sub

Dim As String s
Dim As Any Ptr pThread

Screen 12, , 2  ' to avoid flickering by double buffering
Screenset 1, 0  ' to avoid flickering by double buffering
Print "Time is updated by thread even while 'Line Input' is waiting for characters:"
Locate 4, 1
Print "Enter any character line to test, or 'quit' to finish:"
pThread = Threadcreate(@thread, @s)
Do
    Locate 5, 1
    Print Space(Len(s));
    Locate 5, 1
    Line Input s
Loop Until s = "quit"
ThreadWait(pThread)

[Löwenherz]

Hello fxm and thanks for your both examples. I have learned Something again. Do you are using threads often in freebasic?

Regards Löwenherz

[fxm]

Do you are using threads often in freebasic?

Not often, but just for fun.