Hi Jason, Cool stuff!
But would there be a way to avoid those select calls to spend some time sleeping? I mean if there were a way to do a select on a thread queue it would be great.
On the other hand why not call Win32::GUI::Dialog() in the main thread and let the child threads update the screen?
I mean move this line to within the child threads: $win->{pbT1}->SetPos($t1_in); and $win->{pbT2}->SetPos($t2_in); ?
If you move the create window code before you create any threads all child threads will inherit the window.
I've made a few modifications to your script -1) Ive disabled the queue, implying shared globals as one way of passing data to and fro from threads. With the queue gone theres nothing to do in the event loop but update the screen using Win32::GUI::Dialog();
2) Ive moved the thread join code into the Window_Terminate sub However I get the following message when the script exits: Scalars leaked: 1 Scalars leaked: 1 Wonder what thats related to? Am attaching the code to avoid syntax errors because of word wraps. Cheers, Emmanuel----- Original Message ----- From: "Plum, Jason" <[EMAIL PROTECTED]>
To: <perl-win32-gui-users@lists.sourceforge.net>
Sent: Friday, February 03, 2006 9:25 PM
Subject: [perl-win32-gui-users] Multi-Threaded Example
Hey All,
I was fiddling with some things yesterday and got around to wondering
how I might manage to take some of my more heavy duty linear processes
run in a thread outside of the thread containing the GUI (as we all know
this causes ugly interface lag).
Below is an example, and as with all things perl, this is not the only
way to do it, nor is it necessarily the best way to do it. Consider it a
proof of concept that functions.
This creates worker threads that put values 0-99 consecutively onto a
Queue whiles the function's 'run' semaphore is positive. It also
contains a run-away limiter to prevent the workers from getting too far
ahead of the main thread, containing the window.
Jason P.
__CODE__
use strict;
use warnings;
use threads;
use threads::shared;
use Thread::Queue;
## Create worker threads and associated variables.
## -- THIS MUST BE DONE, AND ALL THREADS STARTED
## -- BEFORE THE WINDOW IS CREATED.
my $TQ1 = new Thread::Queue;
my $TQ2 = new Thread::Queue;
my $ts1_run : shared = 0;
my $ts2_run : shared = 0;
my $thread1 = threads->new(\&Thread1);
my $thread2 = threads->new(\&Thread2);
use Win32::GUI;
## Hide Perl Window
my $perlW = Win32::GUI::GetPerlWindow();
Win32::GUI::Hide($perlW);
## Create Window
my $win = new Win32::GUI::Window(
-name => 'winMain',
-size => [200,100],
-pos => [200,200],
-caption => 'MutliThread E.g.',
-resizeable => 0,
);
$win->AddButton(
-name => 'btnRun1',
-size => [50,20],
-pos => [4,10],
-text => 'Run 1',
);
$win->AddProgressBar(
-name => 'pbT1',
-size => [120,20],
-pos => [58,10],
-smooth => 1,
);
$win->{pbT1}->SetRange(0,99);
$win->AddButton(
-name => 'btnRun2',
-size => [50,20],
-pos => [4,32],
-text => 'Run 2',
);
$win->AddProgressBar(
-name => 'pbT2',
-size => [120,20],
-pos => [58,32],
-smooth => 1,
);
$win->{pbT2}->SetRange(0,99);
$win->Show();
my $run = 1;
# Home rolled w/ DoEvents.
while($run){
# get inputs.
my $t1_in = $TQ1->dequeue_nb();
if( defined $t1_in ){
$win->{pbT1}->SetPos($t1_in);
#print "Get T1 $t1_in\n";
$ts1_run++;
}
my $t2_in = $TQ2->dequeue_nb();
if( defined $t2_in ){
$win->{pbT2}->SetPos($t2_in);
#print "Get T2 $t2_in\n";
$ts2_run++;
}
$win->DoEvents();
select(undef, undef, undef, 0.01); # take a 1/100s break to not eat
cpu
}
#send kill message to workers
$ts1_run = -1;
$ts2_run = -1;
#join workers.
$thread1->join();
$thread2->join();
#### Boss
sub winMain_Maximize{ 0 };
sub winMain_Minimize{ 0 };
sub winMain_Resize{ 0 };
sub winMain_Terminate{
$run = 0;
$win->Hide();
return -1;
}
sub btnRun1_Click{
if($ts1_run){
$win->{btnRun1}->Text('Run 1');
$ts1_run = 0;
}else{
$win->{btnRun1}->Text('Stop 1');
$ts1_run = 1;
}
}
sub btnRun2_Click{
if($ts2_run){
$win->{btnRun2}->Text('Run 2');
$ts2_run = 0;
}else{
$win->{btnRun2}->Text('Stop 2');
$ts2_run = 1;
}
}
#### Child 1
sub Thread1{
my $ctr = 1;
while( $ts1_run != -1 ){ # die when semaphore says so.
if( $ts1_run == 1 ){ #only create a new value when the semaphore
is Up
$TQ1->enqueue($ctr );
$ctr++;
$ctr = 0 if $ctr > 99;
}
$ts1_run-- if $ts1_run > 0; #semaphore to prevent runaway
select(undef, undef, undef, 0.01);
}
}
#### Child 2
sub Thread2{
my $ctr = 1;
while( $ts2_run != -1 ){ # die when semaphore says so.
if( $ts2_run == 1 ){ #only create a new value when the semaphore
is Up
$TQ2->enqueue($ctr);
$ctr++;
$ctr = 0 if $ctr > 99;
}
$ts2_run-- if $ts2_run > 0; # semaphore to prevent runaway
select(undef, undef, undef, 0.01);
}
}
__CODE__
-------------------------------------------------------
This SF.net email is sponsored by: Splunk Inc. Do you grep through log files
for problems? Stop! Download the new AJAX search engine that makes
searching your log files as easy as surfing the web. DOWNLOAD SPLUNK!
http://sel.as-us.falkag.net/sel?cmd=k&kid3432&bid#0486&dat1642
_______________________________________________
Perl-Win32-GUI-Users mailing list
Perl-Win32-GUI-Users@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/perl-win32-gui-users
http://perl-win32-gui.sourceforge.net/
multithreadguiexample.pl
Description: Binary data
