Author Topic: FBSL - Multithreaded GUI Application (Read 9,709 times)

Gerome · « **on:** March 15, 2006, 11: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

Code

' ==============================================
' 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?...

Cpilot · « **Reply #1 on:** March 16, 2006, 03:11 AM »

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

Gerome · « **Reply #2 on:** March 18, 2006, 02:12 PM »

Hello,

Quote from: Cpilot on March 16, 2006, 03:11 AM

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...

f0dder · « **Reply #3 on:** March 18, 2006, 07: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.

Gerome · « **Reply #4 on:** March 18, 2006, 09:20 PM »

Hi,

Quote from: f0dder on March 18, 2006, 07: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.

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.

f0dder · « **Reply #5 on:** March 18, 2006, 10:49 PM »

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

Gerome · « **Reply #6 on:** March 19, 2006, 12:30 AM »

Hello,

Quote from: f0dder on March 18, 2006, 10:49 PM

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

f0dder · « **Reply #7 on:** March 19, 2006, 12:56 AM »

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

Author Topic: FBSL - Multithreaded GUI Application (Read 9,709 times)

Gerome

FBSL - Multithreaded GUI Application

Cpilot

Re: FBSL - Multithreaded GUI Application

Gerome

Re: FBSL - Multithreaded GUI Application

f0dder

Re: FBSL - Multithreaded GUI Application

Gerome

Re: FBSL - Multithreaded GUI Application

f0dder

Re: FBSL - Multithreaded GUI Application

Gerome

Re: FBSL - Multithreaded GUI Application

f0dder

Re: FBSL - Multithreaded GUI Application