Ok !
Comme c'est une question qui revient souvent, je vais légèrement généraliser le principe afin de le rendre plus facile et plus sûr à utiliser. Voici un paquetage qui permettra de ne pas s'embêter avec les problèmes de synchronisation :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
package Tk::ThreadEvents;
 
use strict; use warnings;
use threads;
use Thread::Queue;
use Carp;
 
use base 'Exporter';
our @EXPORT = qw(sendEvent registerHandlers startEventLoop);
# main queue for communication to the Tk thread
my $q = new Thread::Queue;
 
my %handlers;
 
sub sendEvent {
   my ($event_name, @contents) = @_;
   $q->enqueue( $event_name, scalar(@contents), @contents );
}
 
sub registerHandlers {
   %handlers = (%handlers, @_);
}
 
sub startEventLoop {
   my $widget = shift;
   $widget->repeat( 250, \&checkEvents );
}
 
sub checkEvents {
   while( my $event_name = $q->dequeue_nb ) {
      my $num_args = $q->dequeue;
      my @args;
      for( 1..$num_args ) {
	 push @args, $q->dequeue;
      }
      croak "$event_name isn't a registered event !\n"
	unless exists $handlers{$event_name};
      $handlers{$event_name}->(@args);
   }
}
 
1;
__DATA__
Vous le mettez dans un fichier ThreadEvents.pm sous un répertoire Tk dans un répertoire de @INC (Perl/site/lib par exemple, ou "." si vous savez vraiment où cela se trouve), puis vous pouvez l'utiliser comme cela :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
#!/usr/bin/perl
use strict; use warnings;
 
use threads;
use Tk;
use Tk::ThreadEvents;
 
my $mw = Tk::MainWindow->new();
 
my $lab = $mw->Label(-text => 'Hello'); $lab->pack;
my $lab2 = $mw->Label(-text => 'Hello'); $lab2->pack;
my $lab3 = $mw->Label(-text => 'Bye'); $lab3->pack;
 
my ($id1, $i);
$id1 = $mw->repeat(500, 
   sub { $lab->configure(-text => ++$i % 2 ? 'Hello' : '__Hello__') });
 
registerHandlers( hello => sub { $id1->cancel();
				 $lab->configure(-text => $_[0]);
			      },
		  hello2 => sub { $lab2->configure(-text => $_[0]);
				  $lab3->configure(-text => $_[1]);
			       } );
 
my $thr = threads->new( sub { 
			  sleep 8; sendEvent( "hello" => "Bye" );
			  sleep 4; sendEvent( "hello" => "Bye222" );
			} );
$thr->detach;
 
my $thr2 = threads->new( sub { 
			  sleep 12; sendEvent( "hello2" => "Bye", "Hello" );
			  sleep 4; sendEvent( "hello2" => "Bye222", "Hello666" );
			} );
$thr2->detach;
 
startEventLoop($mw);
 
MainLoop();
 
__END__
--
Jedaï