Hello,
JFYI, here is a Multithreaded GUI Application that shows FBSL capacities at managing threads...
You can use the Online compiler to see the result onto your machine
' ==============================================
' Derived from: SpiralGraph 2.0 by Scott Frick
' ==============================================
'#################################################################################
' COMPILER OPTIONS
'#################################################################################
#Option Explicit
'#################################################################################
' PROTOTYPES
'#################################################################################
#DllDeclare Kernel32("CreateSemaphore", "ReleaseSemaphore", "WaitForSingleObject")
#DllDeclare User32("InvalidateRect", "GetDC")
#DllDeclare Gdi32("SetPixelV")
'#################################################################################
' CONSTANTS
'#################################################################################
Const mt = 10 'Max thread count
Const time2draw = 100 'Max time a thread draws its spiral
Const INFINITE = -1
'#################################################################################
' INITIALIZED DATA
'#################################################################################
Dim %tc = 1 'Initial thread count
Dim %hSpiral = CreateSemaphore(NULL, mt, mt, NULL) 'Create semaphore object used to control the amount of threads
Dim x: Alloc(x, 8 * mt) 'Equation variables, used for drawing spirals
Dim y: Alloc(y, 8 * mt)
Dim a: Alloc(a, 8 * mt)
Dim b: Alloc(b, 8 * mt)
Dim h: Alloc(h, 8 * mt)
Dim t: Alloc(t, 8 * mt)
Dim kol: Alloc(kol, 4 * mt)
Dim toggle: Alloc(toggle, 4 * mt)
Dim #speed = 0.51 'Initial speed setting
Dim %MainMenu = CreateMenu() 'That's not a true menu, just a quick help note
Dim %Max_X = 800, %Max_Y = 600 'Window size, used to calculate spiral size and placement
Dim %PauseSpiral = TRUE 'Pause flag
'#################################################################################
' BEGIN CODE SECTION
'#################################################################################
Fbsl_SetText(ME, "Multi Graph")
Resize(ME, 0, 0, 800, 600) 'Size the form
InsertMenu(MainMenu, 1, MF_STRING, 2, _
"*SPEED* = (+ or - or Mouse Wheel) *ERASE* = (SpaceBar or Left Click) *PAUSE* = (0 or Right Click) *THREAD COUNT* = (1 to 9)")
SetMenu(ME, MainMenu)
SetTimer(ME, 1, 4000) 'Timer to change the spirals' settings every 4 secs
SetTimer(ME, 2, time2draw / tc) 'Timer to set the draw time for each thread
Fbsl_SetFormColor(ME, 0) 'Make the form black
Center(ME)
Show(ME)
ReleaseSemaphore(hSpiral, mt, NULL) 'Release semaphore to initilize
Randomize 'Make sure the spirals are different each time the app starts
ChangeSpiral(tc) 'Modify the variables giving the spirals a random look
'===========================
' Main events loop
'===========================
Begin Events
Dim %i
Select Case CBMSG
Case WM_MOUSEWHEEL
'===========================
' Adjust the drawing speed
'===========================
Select Case CBWPARAM
Case 7864320
'================
' Wheel forward
'================
IncreaseSpeed()
Case - 7864320
'================
' Wheel back
'================
DecreaseSpeed()
End Select
Case WM_KEYDOWN
If CBWPARAM > 48 And CBWPARAM < 58 Then
'======================
' Choose the number of threads
'======================
InvalidateRect(ME, NULL, TRUE)
tc = CBWPARAM - 48
SetTimer(ME, 2, time2draw / tc)
ChangeSpiral(tc)
Else If CBWPARAM = 48 Then
'======================
' 0 pauses the drawing process
'======================
PauseSpiral = Not PauseSpiral
Else If CBWPARAM = 32 Then
'======================
' Space bar clears the form
'======================
InvalidateRect(ME, NULL, TRUE)
ChangeSpiral(tc)
Else If CBWPARAM = 107 Or CBWPARAM = 187 Then
'======================
' Plus key (white and gray)
'======================
IncreaseSpeed()
Else If CBWPARAM = 109 Or CBWPARAM = 189 Then
'======================
' Minus key (white and gray)
'======================
DecreaseSpeed()
End If: End If: End If: End If: End If
Case WM_LBUTTONDOWN
'===========================
' Clear the form
'===========================
InvalidateRect(ME, NULL, TRUE)
ChangeSpiral(tc)
Case WM_RBUTTONDOWN
'===========================
' Pause the drawing process
'===========================
PauseSpiral = Not PauseSpiral
Case WM_PAINT
For i = 1 To tc
'======================
' Wait till semafore is released
'======================
WaitForSingleObject(hSpiral, INFINITE)
'======================
' Launch a new thread
'======================
Fbsl_ThreadResume(Fbsl_Thread(AddressOf CalcSpiral))
Next
Case WM_TIMER
'===========================
' Change or draw a spiral
'===========================
If PauseSpiral Then
Select Case CBWPARAM
Case 1
'===========
' Timer #1
'===========
ChangeSpiral(tc)
Case 2
'===========
' Timer #2
'===========
WaitForSingleObject(hSpiral, INFINITE)
Fbsl_ThreadResume(Fbsl_Thread(AddressOf CalcSpiral))
End Select
End If
Case WM_SIZE
'===========================
' Adjust the variables
'===========================
Max_X = LoWord(CBLPARAM)
Max_Y = HiWord(CBLPARAM)
Case WM_CLOSE
'===========================
' Clean up and terminate
'===========================
KillTimer(ME, 1)
KillTimer(ME, 2)
ExitProgram(0)
End Select
End Events
'===========================
' Increase the speed smoothly
'===========================
Sub IncreaseSpeed()
If speed < 15 And speed > 5 Then
speed = speed + 0.5
SetTimer(ME, 1, 1000)
Else If speed <= 5 And speed > 1 Then
speed = speed + 0.1
SetTimer(ME, 1, 2000)
Else If speed <= 1 And speed > 0.5 Then
speed = speed + 0.05
SetTimer(ME, 1, 4000)
Else If speed <= 0.5 Then
speed = speed + 0.025
End If: End If: End If: End If
End Sub
'===========================
' Decrease the speed smoothly
'===========================
Sub DecreaseSpeed()
If speed > 2 Then
speed = speed - 0.5
Else If speed > 1 And speed <= 2 Then
speed = speed - 0.1
SetTimer(ME, 1, 3000)
Else If speed > 0.5 And speed <= 1 Then
speed = speed - 0.1
SetTimer(ME, 1, 4000)
Else If speed > 0.1 And speed <= 0.5 Then
speed = speed - 0.05
SetTimer(ME, 1, 8000)
End If: End If: End If: End If
End Sub
'===========================
' Change the pattern and color
'===========================
Sub ChangeSpiral(ndx)
Dim %k, %kval, %red, %green, %blue, #xval = Max_X / 400 + 0.2
Dim %LocalToggle = -1
For k = 0 To ndx - 1
kval = k << 3
red = Rnd() * 255
blue = Rnd() * 255
green = Rnd() * 255
SetMem(kol, Rgb(red, green, blue), kval >> 1)
SetMem(a, Rnd() * 65 + 3 * k, kval)
SetMem(b, Rnd() * 45 + 3 * k, kval)
SetMem(h, Rnd() * 35 + 3 * k, kval)
SetMem(a, GetMem(a, kval, #8) * xval, kval)
SetMem(b, GetMem(b, kval, #8) * xval, kval)
SetMem(h, GetMem(h, kval, #8) * xval, kval)
SetMem(t, Rnd() * 5 * k + 25, kval)
SetMem(toggle, LocalToggle, kval >> 1)
LocalToggle = -LocalToggle
Next
End Sub
'===========================
' Calculate and draw part of a spiral
'===========================
Sub CalcSpiral()
Static %counter = 1
Dim %i, %j, %hdc
Dim #aval, #bval, #hval, #tval, #sum, #div
If counter < tc - 1 Then
Incr(counter)
Else
counter = 0
End If
j = counter << 3
aval = GetMem(a, j, #8)
bval = GetMem(b, j, #8)
hval = GetMem(h, j, #8)
sum = aval + bval
div = sum / bval
'===============================
' 1 loop = 1 pixel
'===============================
For i = 1 To 400
SetMem(t, GetMem(t, j, #8) + 0.01132 * speed, j)
tval = GetMem(t, j, #8)
If GetMem(toggle, j >> 1, 4) = 1 Then
SetMem(x, (sum * Cos(tval)) - (hval * (Cos(div * tval))) + (Max_X >> 1), j)
Else
SetMem(x, (sum * Cos(tval)) + (hval * (Cos(div * tval))) + (Max_X >> 1), j)
End If
SetMem(y, (sum * Sin(tval)) - (hval * (Sin(div * tval))) + (Max_Y >> 1), j)
hdc = GetDC(ME)
SetPixelV(hdc, %GetMem(x, j, #8), %GetMem(y, j, #8), GetMem(kol, j >> 1, 4))
ReleaseDC(ME, hdc)
Next
'===============================
' Release semafore to allow a new thread in
'===============================
ReleaseSemaphore(hSpiral, 1, NULL)
End Sub
'#################################################################################
' END PROGRAM CODE
'#################################################################################
I just bet my trousers that Ahk is not capable of this?...
Show Posts
