Actually it was a mistake, thanks for sending it! I was starting to wonder where the blazes it went!
Yes that restriction might be a bit of an issue, however I *suppose* information on the control (not the control itself) could be serialized and sent over a Queue to the process altering the control. I have yet to test this. Be Careful. Jason P. -----Original Message----- From: Emmanuel E [mailto:[EMAIL PROTECTED] Sent: Friday, February 03, 2006 11:51 PM To: Plum, Jason Subject: Re: [perl-win32-gui-users] Multi-Threaded Example I guess you cracked it! This one works great. I was getting those "Free to wrong pool errors" till I moved the thread exit and join code to the Win_Terminate sub. But that resulted in "Scalars leaked". Wonder whether the constraint of "will need to know what type of control that handle relates to." will create problems in trying to create neatly packaged objects. Btw did you not intend to send this to the list? I felt it is good enough to be archived forever! Cheers, Emmanuel ----- Original Message ----- From: "Plum, Jason" <[EMAIL PROTECTED]> To: "Emmanuel E" <[EMAIL PROTECTED]> Sent: Saturday, February 04, 2006 12:48 AM Subject: RE: [perl-win32-gui-users] Multi-Threaded Example AH.. now then... So.. the bug involving the object being in multiple threads does indeed still exist! "Free to wrong Pool XXXXXXXX not XXXXXXXX in %perl%/site/lib/win32/gui.pm" The module itself is not thread safe in relation to objects! BUT! BUT! By using the *HANDLE* to the object, you can call the relative procedure directly! Search for [EMAIL PROTECTED] for alterations. This leaves the obvious requirement that any code that is going to directly alter the state of a control will need to know what type of control that handle relates to. Jason P. -----Original Message----- From: Emmanuel E [mailto:[EMAIL PROTECTED] Sent: Friday, February 03, 2006 1:49 PM To: Plum, Jason; perl-win32-gui-users@lists.sourceforge.net Subject: Re: [perl-win32-gui-users] Multi-Threaded Example 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/
