[perl-win32-gui-users] Multi-Threaded Example

[Plum, Jason]

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__