I'm trying to simply pop-up a progress bar while some code is being
executed. Is there a good way to run a progress bar in the background
and update it with a counter? This doesn't work, but could be close:
#!/usr/local/bin/perl
use Tk;
use Tk::ProgressBar;
$mw = MainWindow->new;
$mw->geometry('400x300');
$begin = $mw->Frame()->pack(-fill => 'both', -expand =>1);
$progress = $begin->ProgressBar(-anchor => 'w')->pack(-expand => 1);
$child = fork();
if ($child > 0)
{
MainLoop();
}
else
{
for $n (1..100)
{
$progress->value($n);
}
}
Thanks in advance.
mack2ooo
Here, play with this...
R.
use strict;
use warnings;
use Tk;
use Tk::ProgressBar;
use Time::HiRes qw(usleep);
my $max = 100;
my $percent_done;
my $cancel = 0;
my $mw = MainWindow -> new (-title => " Progress bar");
$mw -> withdraw;
$mw -> minsize (qw(300 100));
my $go = $mw -> Button (
-text => "Do something",
-command => \&go,
) -> pack();
my $can = $mw -> Button (
-text => "Cancel",
-command => \&cancel,
) -> pack();
my $clear = $mw -> Button (
-text => "Clear",
-command => sub{$percent_done = 0},
) -> pack();
my $exit = $mw -> Button (
-text => "Exit",
-command => sub{exit},
) -> pack();
my $progress = $mw -> ProgressBar (
-length => 400,
-borderwidth => "3",
-relief => 'sunken',
-from => 0,
-to => $max,
-blocks => 1,
-colors => [0, 'green', ($max * 0.5), 'yellow' , ($max * 0.8),
'red'],
-variable => \$percent_done
)
-> pack ();
$mw -> Popup;
MainLoop();
sub progress {
$progress -> configure (
-from => 0,
-to => $max,
-blocks => 1,
-colors => [0, 'green', ($max * 0.5), 'yellow' , ($max * 0.8),
'red'],
)
}
sub go {
$cancel = 0;
for (1..1234) {
$max = 1234;
progress();
$percent_done = $_;
usleep 1000;
return unless (&update);
}
}
sub update {
$mw -> update;
return if ($cancel);
return (1);
}
sub cancel {
$cancel = 1;
}
>I'm trying to simply pop-up a progress bar while some code is being
>executed. Is there a good way to run a progress bar in the background
>and update it with a counter? This doesn't work, but could be close:
There are tons of ideas on how to do this.
Here is a threaded method, just to give you an idea.
#!/usr/bin/perl
use strict;
use Tk;
use threads qw[ async ];
use threads::shared;
# based on idea by BrowserUk
our $WORKMAX ||= 1_000;
## A shared var to communicate progess between work thread and TK
my $progress : shared = 0;
## For lowest memory consumption require (not use)
## Tk::* after you've started the work thread.
require Tk::ProgressBar;
my $mw = MainWindow->new;
my $tframe = $mw->Frame(-background =>'lightyellow')->pack(-fill =>
'x');
my $pb = $tframe->ProgressBar(
-length =>100,
-width => 10,
-from => 0,
-to =>100,
-colors => [0, 'green', 50, 'yellow' , 80, 'red'],
)
->pack();
my $text = $mw->Scrolled("Text")->pack(-expand=>1, -fill=>'both');
my $button;
$button = $mw->Button(-text => 'Do-It',
-background => 'hotpink',
-command => sub {
$button->configure(-state =>'disabled');
my $thread = threads->new( \&work );
my $repeat;
$repeat = $mw->repeat( 100 => sub {
$text->insert('end',"$progress\n");
$text->see('end');
$pb->value( $progress );
if ($progress == 100){
$repeat->cancel;
lock $progress;
$progress = 0;
$pb->value( $progress );
$thread->join;
$button->configure(-state =>'normal');
}
});
}
)->pack;
MainLoop;
sub work{
for my $item ( 0 .. $WORKMAX ) {
{ lock $progress; $progress = ( $item / $WORKMAX ) * 100; }
select undef, undef, undef, 0.001; ## do stuff that takes time
}
}
__END__
--
I'm not really a human, but I play one on earth.
http://zentara.net/japh.html