topbanner_forum
  *

avatar image

Welcome, Guest. Please login or register.
Did you miss your activation email?

Login with username, password and session length
  • Thursday March 28, 2024, 4:48 pm
  • Proudly celebrating 15+ years online.
  • Donate now to become a lifetime supporting member of the site and get a non-expiring license key for all of our programs.
  • donate

Author Topic: FBSL - Multithreaded GUI Application  (Read 6897 times)

Gerome

  • Charter Honorary Member
  • Joined in 2006
  • ***
  • Posts: 154
    • View Profile
    • Get my Freestyle Basic Script Language + compiler!
    • Donate to Member
FBSL - Multithreaded GUI Application
« on: March 15, 2006, 05:49 PM »
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?... :)
Yours,
(¯`·._.·[Gerome GUILLEMIN]·._.·´¯)
http://www.fbsl.net [FBSL Author]
http://gedd123.free.fr/FBSLv3.zip [FBSL Help file]
(¯`·._.·[If you need help... just ask]·._.·´¯)
« Last Edit: March 15, 2006, 06:01 PM by Gerome »

Cpilot

  • Charter Honorary Member
  • Joined in 2006
  • ***
  • Posts: 293
    • View Profile
    • Bite Notes
    • Read more about this member.
    • Donate to Member
Re: FBSL - Multithreaded GUI Application
« Reply #1 on: March 15, 2006, 09:11 PM »
Really nice effect actually. Could be used to create a nice screensaver.

Gerome

  • Charter Honorary Member
  • Joined in 2006
  • ***
  • Posts: 154
    • View Profile
    • Get my Freestyle Basic Script Language + compiler!
    • Donate to Member
Re: FBSL - Multithreaded GUI Application
« Reply #2 on: March 18, 2006, 08:12 AM »
Hello,

Really nice effect actually. Could be used to create a nice screensaver.

Simply try to do the same sample using VB : impossible since VB is not capable of multithreading...
Yours,
(¯`·._.·[Gerome GUILLEMIN]·._.·´¯)
http://www.fbsl.net [FBSL Author]
http://gedd123.free.fr/FBSLv3.zip [FBSL Help file]
(¯`·._.·[If you need help... just ask]·._.·´¯)

f0dder

  • Charter Honorary Member
  • Joined in 2005
  • ***
  • Posts: 9,153
  • [Well, THAT escalated quickly!]
    • View Profile
    • f0dder's place
    • Read more about this member.
    • Donate to Member
Re: FBSL - Multithreaded GUI Application
« Reply #3 on: March 18, 2006, 01:35 PM »
You *can* do multi-threading in VB, although it is a bit hacky. You can't access global variables without going through a lot of tricky hoops, and there's a bunch of language features you can't use from secondary threads. But it *is* possible :)

That's for v5 and v6 btw, dunno about vb.net - but I assume they've fixed threading issues there.
- carpe noctem

Gerome

  • Charter Honorary Member
  • Joined in 2006
  • ***
  • Posts: 154
    • View Profile
    • Get my Freestyle Basic Script Language + compiler!
    • Donate to Member
Re: FBSL - Multithreaded GUI Application
« Reply #4 on: March 18, 2006, 03:20 PM »
Hi,

You *can* do multi-threading in VB, although it is a bit hacky. You can't access global variables without going through a lot of tricky hoops, and there's a bunch of language features you can't use from secondary threads. But it *is* possible :)

That's for v5 and v6 btw, dunno about vb.net - but I assume they've fixed threading issues there.

In VBnet it's possible becasue vbnet is no more VB, but the net platform supports multithreading and it works same way as we've done MT support into Fbsl.
Yours,
(¯`·._.·[Gerome GUILLEMIN]·._.·´¯)
http://www.fbsl.net [FBSL Author]
http://gedd123.free.fr/FBSLv3.zip [FBSL Help file]
(¯`·._.·[If you need help... just ask]·._.·´¯)

f0dder

  • Charter Honorary Member
  • Joined in 2005
  • ***
  • Posts: 9,153
  • [Well, THAT escalated quickly!]
    • View Profile
    • f0dder's place
    • Read more about this member.
    • Donate to Member
Re: FBSL - Multithreaded GUI Application
« Reply #5 on: March 18, 2006, 04:49 PM »
Again: it's possible in pre-dotnet VB code, although it's hacky :)
- carpe noctem

Gerome

  • Charter Honorary Member
  • Joined in 2006
  • ***
  • Posts: 154
    • View Profile
    • Get my Freestyle Basic Script Language + compiler!
    • Donate to Member
Re: FBSL - Multithreaded GUI Application
« Reply #6 on: March 18, 2006, 06:30 PM »
Hello,

Again: it's possible in pre-dotnet VB code, although it's hacky :)

Hacky means and sounds unstable.
I prefer stable and 100% realiable materials and softwares ;)
Yours,
(¯`·._.·[Gerome GUILLEMIN]·._.·´¯)
http://www.fbsl.net [FBSL Author]
http://gedd123.free.fr/FBSLv3.zip [FBSL Help file]
(¯`·._.·[If you need help... just ask]·._.·´¯)

f0dder

  • Charter Honorary Member
  • Joined in 2005
  • ***
  • Posts: 9,153
  • [Well, THAT escalated quickly!]
    • View Profile
    • f0dder's place
    • Read more about this member.
    • Donate to Member
Re: FBSL - Multithreaded GUI Application
« Reply #7 on: March 18, 2006, 06:56 PM »
Well, it's bound to one version of VB (or well, the v6 safe code should work on both v5 and v6), and it is STABLE for those versions. The "hacky" part means it has to do some pretty interesting stuff to make things works, largely because VB objects are COM objects. Pretty interesting if you like lowlevel code, but waste of time to do yourself when working with a language like VB :P
- carpe noctem