Tk::ProgressBar

[mack2ooo]

Hi all,

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

[Richard S Beckett]

"mack2ooo" <andrew.ma...@duke.edu> wrote

> Hi all,
>
> 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?

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;
}

[zentara]

On 1 Nov 2004 13:38:07 -0800, andrew.ma...@duke.edu (mack2ooo)
wrote:

>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