| Steve Lidie 2005-01-15, 3:57 am |
| zentara <zentara@highstream.net> wrote:
> On Thu, 13 Jan 2005 13:50:06 +0000 (UTC), Steve Lidie
> <lusol@Dragonfly.cc.lehigh.edu> wrote:
>
>
> It may be presumptuous of me to argue with the "teacher",
And why? ;) I'm always willing to learn more ...
> but I have been able to use threads with Tk, with 2 caveats.
OK, re-phrase: Tk is not thread safe. "can't use them" seemed
sufficient for a non-Tk group ;) BTW, we're still not in
comp.lang.perl.tk.
> 1. No passing objects around, only simple text and scalars.
> 2. Threads must be created before Tk is init'ed.
Similar to the fork() caveat that the child cannot touch in any way
parent Tk data structures.
>
> In this example, I start 3 threads before Tk is started, and put them
> to sleep. I control them with shared vars. It look more complicated
> than it actually is, because I add an activity bar, and have 3 worker
> threads, intead of one, with the associated hash complexities. This
> concept can easily be used to start a worker thread to communicate with
> the card. The thread can report back it's findings to Tk thru shared
> variables, and you could manipulate you window accordingly.
Another big reason "we" Tk-ers don't use threads is probably because
over the last decade their implementation has been a moving target,
and bug-prone. fork()/exec()/pipe() are better known and better
tested, etc. It's another idiom to learn, but, I and I'm sure others
would love to see/hear your experiences on the mailing list and
newsgroup.
Then maybe the following code would make more sense. Still the "no
passing objects" rule might be too hard to live with. Can you
explain more?
>
> #!/usr/bin/perl
> use warnings;
> use strict;
> use threads;
> use threads::shared;
> use Tk;
> use Tk::ActivityBar;
> use Tk::Dialog;
>
> my $data = shift || ' '; #sample code to pass to thread
>
> my %shash;
> #share(%shash); #will work only for first level keys
> my %hash;
> my %workers;
> my $numworkers = 3;
>
> foreach my $dthread(1..$numworkers){
> share ($shash{$dthread}{'go'});
> share ($shash{$dthread}{'progress'});
> share ($shash{$dthread}{'timekey'}); #actual instance of the thread
> share ($shash{$dthread}{'frame_open'}); #open or close the frame
> share ($shash{$dthread}{'handle'});
> share ($shash{$dthread}{'data'});
> share ($shash{$dthread}{'pid'});
> share ($shash{$dthread}{'die'});
>
> $shash{$dthread}{'go'} = 0;
> $shash{$dthread}{'progress'} = 0;
> $shash{$dthread}{'timekey'} = 0;
> $shash{$dthread}{'frame_open'} = 0;
> $shash{$dthread}{'handle'} = 0;
> $shash{$dthread}{'data'} = $data;
> $shash{$dthread}{'pid'} = -1;
> $shash{$dthread}{'die'} = 0;
> $hash{$dthread}{'thread'} = threads->new(\&work,$dthread);
> }
>
> my $mw = MainWindow->new(-background => 'gray50');
>
> my $lframe = $mw->Frame( -background => 'gray50',-borderwidth=>10 )
> ->pack(-side =>'left' ,-fill=>'y');
> my $rframe = $mw->Frame( -background => 'gray50',-borderwidth=>10 )
> ->pack(-side =>'right',-fill =>'both' );
>
> my %actives = (); #hash to hold reusable numbered widgets used for
> downloads
> my @ready = (); #array to hold markers indicating activity is needed
> my $activity = $lframe->ActivityBar()->pack(-side => 'top',-anchor =>
> 'n');
>
> #make 3 reusable downloader widget sets-------------------------
> foreach(1..$numworkers){
> push @ready, $_;
> #frames to hold indicator
> $actives{$_}{'frame'} = $rframe->Frame( -background => 'gray50' );
>
> $actives{$_}{'stopbut'} = $actives{$_}{'frame'}->Button(
> -text => "Stop Worker $_",
> -background => 'lightyellow',
> -command => sub { } )->pack( -side => 'left', -padx => 10 );
>
> $actives{$_}{'label1'} = $actives{$_}{'frame'} ->Label(
> -width => 3,
> -background => 'black',
> -foreground => 'lightgreen',
> -textvariable => \$shash{$_}{'progress'},
> )->pack( -side => 'left' );
>
> $actives{$_}{'label2'} = $actives{$_}{'frame'} ->Label(
> -width => 1,
> -text => '%',
> -background => 'black',
> -foreground => 'lightgreen',
> )->pack( -side => 'left' );
>
>
> $actives{$_}{'label3'} = $actives{$_}{'frame'} ->Label(
> -text => '',
> -background => 'black',
> -foreground => 'skyblue',
> )->pack( -side => 'left',-padx =>10 );
>
> }
> #--------------------------------------------------
>
> my $button = $lframe->Button(
> -text => 'Get a worker',
> -background => 'lightgreen',
> -command => sub { &get_a_worker(time) }
> )->pack( -side => 'top', -anchor => 'n', -fill=>'x', -pady =>
> 20 );
>
> my $text = $rframe->Scrolled("Text",
> -scrollbars => 'ose',
> -background => 'black',
> -foreground => 'lightskyblue',
> )->pack(-side =>'top', -anchor =>'n');
>
> my $repeat;
> my $startbut;
> my $repeaton = 0;
> $startbut = $lframe->Button(
> -text => 'Start Test Count',
> -background => 'hotpink',
> -command => sub {
> my $count = 0;
> $startbut->configure( -state => 'disabled' );
> $repeat = $mw->repeat(
> 100,
> sub {
> $count++;
> $text->insert( 'end', "$count\n" );
> $text->see('end');
> }
> );
> $repeaton = 1;
> })->pack( -side => 'top', -fill=>'x', -pady => 20);
>
> my $stoptbut = $lframe->Button(
> -text => 'Stop Count',
> -command => sub {
> $repeat->cancel;
> $repeaton = 0;
> $startbut->configure( -state => 'normal' );
> })->pack( -side => 'top',-anchor => 'n', -fill=>'x', -pady => 20 );
>
> my $exitbut = $lframe->Button(
> -text => 'Exit',
> -command => sub {
>
> foreach my $dthread(keys %hash){
> $shash{$dthread}{'die'} = 1;
> $hash{$dthread}{'thread'}->join
> }
>
> if ($repeaton) { $repeat->cancel }
> #foreach ( keys %downloads ) {
> # #$downloads{$_}{'repeater'}->cancel;
> #}
> # $mw->destroy;
> exit;
> })->pack( -side => 'top',-anchor => 'n', -fill=>'x', -pady => 20
> );
>
>
> #dialog to get file url---------------------
> my $dialog = $mw->Dialog(
> -background => 'lightyellow',
> -title => 'Get File',
> -buttons => [ "OK", "Cancel" ]
> );
>
> my $hostl = $dialog->add(
> 'Label',
> -text => 'Enter File Url',
> -background => 'lightyellow'
> )->pack();
>
> my $hostd = $dialog->add(
> 'Entry',
> -width => 100,
> -textvariable => '',
> -background => 'white'
> )->pack();
>
> $dialog->bind( '<Any-Enter>' => sub { $hostd->Tk::focus } );
>
> my $message = $mw->Dialog(
> -background => 'lightyellow',
> -title => 'ERROR',
> -buttons => [ "OK" ]
> );
>
> my $messagel = $message->add(
> 'Label',
> -text => ' ',
> -background => 'hotpink'
> )->pack();
>
> $mw->repeat(10, sub{
> if(scalar @ready == $numworkers){return}
>
> foreach my $set(1..$numworkers){
> $actives{$set}{'label1'}->
> configure(-text =>\$shash{$set}{'progress'});
>
> if(($shash{$set}{'go'} == 0) and
> ($shash{$set}{'frame_open'} == 1))
> {
> my $timekey = $shash{$set}{'timekey'};
> $workers{ $timekey }{'frame'}->packForget;
> $shash{$set}{'frame_open'} = 0;
> push @ready, $workers{$timekey}{'setnum'};
> if((scalar @ready) == 3)
> { $activity->configure(-value => 0) }
> $workers{$timekey} = ();
> delete $workers{$timekey};
> }
> }
> });
>
> $mw->MainLoop;
> ########################################
###########################
>
> sub get_a_worker {
>
> my $timekey = shift;
>
> $hostd->configure( -textvariable => \$data);
> if ( $dialog->Show() eq 'Cancel' ) { return }
>
> #----------------------------------------------
> #get an available frameset
> my $setnum;
> if($setnum = shift @ready){print "setnum->$setnum\n"}
> else{ print "no setnum available\n"; return}
>
> $workers{$timekey}{'setnum'} = $setnum;
> $shash{$setnum}{'timekey'} = $timekey;
>
> $workers{$timekey}{'frame'} = $actives{$setnum}{'frame'};
> $workers{$timekey}{'frame'}->pack(-side =>'bottom', -fill => 'both' );
>
> $workers{$timekey}{'stopbut'} = $actives{$setnum}{'stopbut'};
> $workers{$timekey}{'stopbut'}->configure(
> -command => sub {
> $workers{$timekey}{'frame'}->packForget;
> $shash{ $workers{$timekey}{'setnum'} }{'go'} = 0;
> $shash{ $workers{$timekey}{'setnum'} }{'frame_open'} = 0;
> push @ready, $workers{$timekey}{'setnum'};
> if((scalar @ready) == $numworkers)
> { $activity->configure(-value => 0) }
> $workers{$timekey} = ();
> delete $workers{$timekey};
> });
>
> $workers{$timekey}{'label1'} = $actives{$setnum}{'label1'};
> $workers{$timekey}{'label1'}->configure(
> -textvariable => \$shash{$setnum}{'progress'},
> );
> $workers{$timekey}{'label2'} = $actives{$setnum}{'label2'};
> $workers{$timekey}{'label3'} = $actives{$setnum}{'label3'};
> $workers{$timekey}{'label3'}->configure(-text => $timekey);
>
> $activity->startActivity();
>
> $shash{$setnum}{'go'} = 1;
> $shash{$setnum}{'frame_open'} = 1;
> #--------end of get_file sub--------------------------
> }
>
> ########################################
##########################
> sub work{
> my $dthread = shift;
> $|++;
> while(1){
> if($shash{$dthread}{'die'} == 1){ goto END };
>
> if ( $shash{$dthread}{'go'} == 1 ){
>
> eval( system( $shash{$dthread}{'data'} ) );
>
> foreach my $num (1..100){
> $shash{$dthread}{'progress'} = $num;
> print "\t" x $dthread,"$dthread->$num\n";
> select(undef,undef,undef, .5);
> if($shash{$dthread}{'go'} == 0){last}
> if($shash{$dthread}{'die'} == 1){ goto END };
> }
>
> $shash{$dthread}{'go'} = 0; #turn off self before returning
> }else
> { sleep 1 }
> }
> END:
> }
> ########################################
##############
> __END__
>
>
>
>
|