Re: TK::ProgressBar Color update

[zentara]

Hi again, while hacking on this problem, I noticed 1 peculiarity, the color changes work as you would expect, IF you resize the $mw after hitting the buttons. As an example of this behavior, I rewrote the script above to use a timer (instead of a hackish select delay) and just used configure on the -colors.

If you run this script, and hit Stop, the bar will turn red only after you just SLIGHTLY resize the window. The same occurs after a second START, the bar returns to original colors after a slight resize of the window.

I tried update, packPropagate, idletasks, etc. to stimulate the update, but no luck.

Does anyone know how to trigger the progressbar's deep update without a window resize? I suppose as a hack, the Start and Stop buttons could include some code to do a 1-pixel resize of the $mw. :-)

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

our $percent_done = 0;
our $stopped = 0;

my $mw = new MainWindow;

$mw->geometry('200x100+100+100');

my $progress = $mw->ProgressBar(
  -width => 40,
  -height => 20,
  -from => 0,
  -to => 100,
  -blocks => 50,
  -colors => [0, 'blue',30,'yellow',70,'orange'],
  -variable => \$percent_done
)->pack(-expand=>1, -fill=>'x');

my $buttonF = $mw->Frame->pack;

my $timer;

my $startB = $buttonF->Button(
  -text => 'start',
  -command => sub {
        $stopped = 0;
        $percent_done = 0;
      
      #restore original colors 
$progress->configure('-colors',[0, 'blue',30,'yellow',70,'orange'] );
               
               $mw->idletasks; # these commands
               $mw->update;    # don't seem to work
                               #but a window resize does
        $timer = $mw->repeat(50,
          sub{
              $percent_done++;
              $progress->update;
           
               if ($stopped) {
      #set red colors
     $progress->configure('-colors', [0, 'red',30,'red',70,'red'] );
               
               $mw->idletasks; # these commands
               $mw->update;    # don't seem to work
                               #but a window resize does
               
               
                $timer->cancel;
               }
             })        
     }
)->pack(-side => 'left');

my $stopB = $buttonF->Button(
  -text => "stop",
  -command => sub { $stopped = 1; }
 )->pack(-side => 'left');

MainLoop;

[kcott]

Does anyone know how to trigger the progressbar's deep update without a window resize?

Short answer: yes :-)

Longer answer:

I now think I see what Ohad's problem is. I originally thought the progress bar wasn't changing as the variable was being updated.

With reference to your earlier "... you might want to build your own on a Tk::Canvas.", Tk::ProgressBar is already a derived widget based on Tk::Canvas.

The -colors option is configured as PASSIVE. It's not intended to be changed after creation of the widget. However, it can be done by accessing the private method _layoutRequest().

WARNING! Accessing private methods is bad!
The code maintainer may change it, or even remove it, at any time.
Use the following code entirely at your own risk!

OK, that's my arse covered :-) Here's the solution:

#!perl

use strict;
use warnings;

use Tk;
use Tk::Button;
use Tk::ProgressBar;

my $mw = MainWindow->new();

my $progress;
my $toggle = 0;
my @colours = (
    [ 0 => q{#ff0000}, 30 => q{#00ff00}, 60 => q{#0000ff} ],
    [ 0 => q{#ffff00}, 30 => q{#00ffff}, 60 => q{#ff00ff} ],
);

my $pb = $mw->ProgressBar(
    -width => 20,
    -length => 200,
    -colors => $colours[$toggle],
    -variable => \$progress,
)->pack();

$mw->Button(-text => q{Jump WITH Change},
    -command => sub {
        $progress ||= 0;
        $progress = ($progress + 10) % 110;
        $toggle ^= 1;
        $pb->configure(-colors => $colours[$toggle]);
        Tk::ProgressBar::_layoutRequest($pb, 1);
    }
)->pack();

$mw->Button(-text => q{Jump NO Change},
    -command => sub {
        $progress ||= 0;
        $progress = ($progress + 10) % 110;
        $toggle ^= 1;
        $pb->configure(-colors => $colours[$toggle]);
    }
)->pack();

$mw->Button(-text => q{Exit}, -command => sub { exit })->pack();

MainLoop;

Tested successfully under Windows and Cygwin.

[zentara]

Thanks for this excellent lesson! I was trying to go the route of eventGenerate('configure'), to trigger the update, but was running into errors.

 
Tk::ProgressBar::_layoutRequest($pb, 1);

[Ohad]

Thanks!!

For your time and effort, the layoutRequest works!!