Anonymous Monk has asked for the wisdom of the Perl Monks concerning the following question:

I have the following code as an example but can't seem to figure out how to use it in my code. In my code I read 5,000+ folders in a file and then parse them and write the results of those files to another directory file by file. I'd like to use the progress bar included here in the subroutine in my script but I don't know where to put the call backs to track time. In this example below they just use a loop and count down. I can do that but it won't be an accurate representation to track with I'm doing.

#!/usr/bin/perl
# a nearly trivial script to mount /mnt/camera on
# dev/ttyUSB1, create a target dir, and copy pics 
# from camera to dir.
# Note that mount stuff has been excised for brevity.
#---------------------------------------------------------------------
$| = 1;
use strict;
use Tk;
use Tk::Pane;
use Tk::ProgressBar;

my $message = 'Ready';
my $main = MainWindow->new();
$main->configure(-title=>'Camera 2 Disk', -background =>'blue');
$main->geometry('370x200+100+00');
my $label = $main->Label(-text =>"Digital Camera Tool\nCopy Images fro
+m Fuji FinePix to Disk",
            -relief => 'raised',
            -background =>'#42b4b4')
    ->pack(-side=>'top', -fill =>'both');

my $button_frame = $main->Frame(-relief=>'raised')
    ->pack(-side => 'top', -fill => 'x');
my $dump = $button_frame->Button(-text => 'Dump',
             -command => \&get_files)
    ->pack(-side =>'left', -anchor => 'w');

my $status_text = 'Ready';
my $status_label = $button_frame->Label(
            #-textvariable =>\$status_text,
            -relief => 'raised',
            -background =>'grey77')
    ->pack(-side=>'left',-fill=>'both', -expand=>'1');

my $exit = $button_frame->Button(-text => 'Exit', -command => 'exit')
    ->pack(-side =>'right');

my $status = $main->Scrolled('Pane', -scrollbars => 'se', -relief => '
+flat')
    ->pack(-side=>'top', -fill=>'both', -expand=>'y');
#$status->Label(textvariable =>\$message,
            #-relief => 'flat');
    #->pack(-side=>'top', -fill =>'both');

my $percent_done;
my $position = '0';
my $progress = $main->ProgressBar(-troughcolor => 'grey70',
        -width => 20,
        -length => 370,
        -anchor => 'w',
        -from => 0,
        -to => 100,
        -blocks => 0.1,
        -colors => [0, 'blue', 100],
    )->pack(-side=>'left', -fill=>'both');

$progress->value($position);

MainLoop();
#---------------------------------------------------------------------
sub get_files {
my $i;
while ($i <= 10 ) {
    $percent_done = int(($i/10) * 100);
    $progress->value($percent_done);
    $progress->update;
    $i++;
    sleep(1);
    $message = "Loop number $i.";
    }
}

[download]

Replies are listed 'Best First'.
Re: Progress bar in Tk
by beech (Parson) on Feb 10, 2016 at 08:38 UTC

    I'd like to use the progress bar included here in the subroutine in my script but I don't know where to put the call backs to track time. In this example below they just use a loop and count down. I can do that but it won't be an accurate representation to track with I'm doing.

    What does that mean?

    Maybe this helps TK::ProgressBar Color update , to track progress, you simply increment a counter 

    #!/usr/bin/perl --
use strict;
use warnings;
use Tk;
use Tk::ProgressBar;

my $mw = tkinit;

my @files = 1 .. 123;

my $status_var = 0;
my $start_count = 0;
my $finish_count = int @files;
my $end_count = $finish_count - ( $finish_count / 3 );
my $middle_count = int( $finish_count / 3 );
my $resolution = 1;
my $blocks     = 10;

$mw->ProgressBar(
    -borderwidth => 2,
    -relief => 'sunken',
    -width => 20,
    -padx => 2,
    -pady => 2,
    -variable => \$status_var,
    -colors => [
            $start_count => 'green',
            $middle_count => 'yellow' ,
            $end_count => 'red',
    ],
    -resolution => $resolution,
    -blocks => $blocks,
    -anchor => 'w',
    -from => $start_count,
    -to => $finish_count,
)->pack(
    -fill => 'both',
    -expand => 1
);
$mw->Scale(
    -from => $start_count, 
    -to => $finish_count, 
    -variable => \$status_var,
)->pack;
$mw->raise;

for my $file ( @files ){
    some_thing( $file );
    $status_var++;
    $mw->update;
}

$mw->Button(
    -text => 'Go',
    -command => [ \&status_from_zero, \$status_var ],
)->pack;

MainLoop;

sub status_from_zero {
    use Time::HiRes qw( usleep );
    $status_var = 0;
    for( 1 .. 200 ){
        $status_var++;
        usleep( 1000 );
#~         $Tk::widget->parent->update;
        $Tk::event->W->parent->update;
    }
    
}

sub some_thing {
    use Time::HiRes qw( usleep );
    usleep( 1000 );
}
__END__

    [download]
[reply]
[d/l]
Re: Progress bar in Tk
by nikosv (Deacon) on Feb 10, 2016 at 09:14 UTC
    Take a look at https://git.launchpad.net/unrarextractrecover/diff/script/gui.pl?id=b326ba775652a0e320eacb005ee9b2e5fbd95db4

    for a complete application/example that updates the progress bar through a thread queue

    The relevant code is along those lines: 

    while (Tk::MainWindow->Count) {
           if (my $queue_message=$main::worker_to_boss_queue->dequeue_
+nb) {
               my ($message,$no)=@$queue_message;   
                     
                  given ($message) {        
            
                        when ("allfiles") {
                            $gui::percent_done=0;
                            $gui::_progress->configure(-to => $no);
                        }
               
                        when ("update") {
                            $gui::percent_done += 1;
                        }
               
                        when ("end") {
                            $gui::percent_done += 1;
                            enable_buttons();            
                        }
                        
                }
        
           }
        
        DoOneEvent(ALL_EVENTS);
        
        }
}

    [download]
[reply]
[d/l]

Back to Seekers of Perl Wisdom