A few people have asked recently about how to deal with the problem that threads must be started early in Tk programs, and are often running before the Tk gui gets going. Here are 2 methods. One uses a while loop and shared variables, the other Thread::Semaphore and signals.
The while loop one runs well, but it has the drawback of needing to frequently check the status of shared variables. The signals method will break a while loop running, but has the drawback of letting the thread run a bit, until the signal handlers get setup. If you can see a way to prevent the Signals thread from printing 1 or 2 lines before responding to the suspend request, please show us how.
The code is pretty much self documenting, and I purposely left the variables simple
and straight forward to avoid obscurring what is happening.
#!/usr/bin/perl
use warnings;
use strict;
use threads 'exit' => 'threads_only';
use threads::shared;
use IO::Pipe;
use Thread::Semaphore;
# uses a reusable thread concept
# shows 2 ways to control the thread
# 1 -- thru a while loop
# 2 -- thru signals, suspend resume
#create threads before any tk code is called
my $go_control:shared = 0; # controls for while loop method
my $die_control:shared = 0;
# create pipes and threads
my $pipe1 = IO::Pipe->new();
my $thr1 = threads->new(\&execute1, $pipe1);
# Create a semaphore for signaling and pass it to thread 2
my $sema = Thread::Semaphore->new();
my $pipe2 = IO::Pipe->new();
my $thr2 = threads->new(\&execute2, $pipe2, $sema );
# after thread initiation is complete, get Tk going
use Tk;
my $mw = MainWindow->new();
$mw->geometry('800x500');
# catch window close button to clean up threads
$mw->protocol('WM_DELETE_WINDOW' => sub { &clean_exit });
$mw->fontCreate('big',-weight=>'bold', -size=> 14 );
# setup pipes for Tk's fileevent
$pipe1->reader(); # make Tk's end a reader
$pipe2->reader();
# add fileevents( similar to select) on pipes
$mw->fileevent($pipe1 ,'readable', \&write_t1);
$mw->fileevent($pipe2 ,'readable', \&write_t2);
# control button frame
my $topframe = $mw->Frame(-bg => 'brown')->pack(-fill=>'x', -expand=>
+0);
my $control1 = $topframe->Button(-text => 'Start 1',
-font => 'big',
-bg => 'lightyellow',
-command => \&start1
)->pack(-side =>'left',-padx=>20);
my $lab1 = $topframe->Label(-text => 'while loop control',
-font => 'big',
-bg => 'lightyellow',
)->pack(-side =>'left',-padx=>20);
my $control2 = $topframe->Button(-text => 'Start 2',
-font => 'big',
-bg => 'black',
-fg => 'lightyellow',
-command => \&start2
)->pack(-side =>'right', -padx=>20);
my $lab2 = $topframe->Label(-text => 'signal control',
-font => 'big',
-bg => 'black',
-fg => 'lightyellow',
)->pack(-side =>'right',-padx=>20);
# make a frame to lock in the scrolled text
my $frame = $mw->Frame()->pack(-fill=>'both', -expand=> 1);
my $text1 = $frame->Scrolled('Text',
-background=>'white',
-foreground=>'black',
-font => 'big',
-height => 550, # how many lines are shown
-width => 20, # how many characters per line
)->pack(-side=>'left', -fill=>'both', -expand=>1);
$text1-> insert('end', "Thread 1 output\n");
my $text2 = $frame->Scrolled('Text',
-background=>'black',
-foreground=>'white',
-font => 'big',
-height => 550, # how many lines are shown
-width => 20, # how many characters per line
)->pack(-side=>'right',-fill=>'both', -expand=>1);
$text2-> insert('end', "Thread 2 output\n");
# this is delayed, and I don't know a workaround
# so it prints once before suspending
# suspend thread 2
$sema->down();
$thr2->kill('STOP');
MainLoop;
sub clean_exit{
# harvest thread 1
$die_control = 1;
$thr1->join;
print " thread1 joined\n";
# harvest thread 2
# a problem exists in that you need to detect
# if the $sema is down or up, to see if thread 2 is running or su
+spended
# when you want to exit
# The "down_nb" method attempts to decrease the semaphore's count
+
# by the specified number (which must be an integer >= 1), or
# by one if no number is specified.
# If the semaphore's count would drop below zero, this method wil
+l return false,
# and the semaphore's count remains unchanged.
# Otherwise, the semaphore's count is decremented and this method
+ returns true.
# turn on suspended thread if needed .. a bit tricky logic wise
if(! $sema->down_nb() ){ $sema->up(); print " sema up\n"; }
$thr2->kill('KILL');
$thr2->join;
print " thread2 joined\n";
exit;
}
sub start1{
my $text = $control1->cget(-text);
if ($text eq 'Start 1'){
$go_control = 1;
$control1->configure(-text=>'Stop 1');
}else{
$go_control = 0;
$control1->configure(-text=>'Start 1');
}
}
sub write_t1{
my $buf = <$pipe1>;
$text1->insert('end',"$buf");
$text1->see('end');
}
sub execute1{
# thread code
my $pipe = shift;
my $wh = $pipe->writer();
$wh->autoflush(1);
while(1){
if($die_control){ return };
#wait for $go_control
if($go_control){
print $wh time." continuing\n";
if($die_control){ return };
#do your stuff here
while(1){
if($die_control){ return };
last if ! $go_control;
print "1";
print $wh time."\n";
select(undef,undef,undef,.5); # sleep until aw
+akened for next command
}
#done, so turn thread back to sleep
print $wh time." suspending\n";
$go_control = 0;
}else{
select(undef,undef,undef,.25); # sleep until awakened for next
+command
}
}
return;
}
sub start2{
my $text = $control2->cget(-text);
if ($text eq 'Start 2'){
$sema->up();
$thr2->kill('CONT');
$control2->configure(-text=>'Stop 2');
}else{
$sema->down();
$thr2->kill('STOP');
$control2->configure(-text=>'Start 2');
}
}
sub write_t2{
my $buf = <$pipe2>;
$text2->insert('end',"$buf");
$text2->see('end');
}
sub execute2{
my ($pipe,$sema) = @_;
my $wh = $pipe->writer();
$wh->autoflush(1);
my $myobject = threads->self;
my $mytid= $myobject->tid;
#setup signal handlers
$SIG{'KILL'} = sub { print "2 killed\n"; threads->exit; };
# Thread 'suspend/resume' signal handler
$SIG{'STOP'} = sub {
print $wh time.' suspended'."\n";
$sema->down();
}; # Thread suspended
$SIG{'CONT'} = sub {
$sema->up(); # Thread resumes
print $wh time.' continuing'."\n";
};
while(1){
print "2";
print $wh time."\n";
select(undef,undef,undef,.5); # sleep until awakened for next
+ command
}
}