view release on metacpan or  search on metacpan

lib/Tcl/pTk/ProgressBar.pm  view on Meta::CPAN

package Tcl::pTk::ProgressBar;

our ($VERSION) = ('1.11');

use warnings;
use strict;

use Tcl::pTk;
use Tcl::pTk::Canvas;
#use Tk::Trace;
use Carp;

use base qw(Tcl::pTk::Derived Tcl::pTk::Canvas);

Construct Tcl::pTk::Widget 'ProgressBar';

sub ClassInit {
    my ($class,$mw) = @_;

    $class->SUPER::ClassInit($mw);

    $mw->bind($class,'<Configure>', ['_layoutRequest',1]);
}


sub Populate {
    my($c,$args) = @_;

    $c->ConfigSpecs(
	-width    => [PASSIVE => undef, undef, 0],
	'-length' => [PASSIVE => undef, undef, 0],
	-from	  => [PASSIVE => undef, undef, 0],
	-to	  => [PASSIVE => undef, undef, 100],
	-blocks   => [PASSIVE => undef, undef, 10],
	-padx     => [PASSIVE => 'padX', 'Pad', 0],
	-pady     => [PASSIVE => 'padY', 'Pad', 0],
	-gap      => [PASSIVE => undef, undef, 1],
	-colors   => [PASSIVE => undef, undef, undef],
	-relief	  => [SELF => 'relief', 'Relief', 'sunken'],
	-value    => [METHOD  => undef, undef, undef],
	-variable => [METHOD  => undef, undef, undef],
	-anchor   => [METHOD  => 'anchor', 'Anchor', 'w'],
	-resolution
		  => [PASSIVE => undef, undef, 1.0],
	-highlightthickness
		  => [SELF => 'highlightThickness','HighlightThickness',0],
	-troughcolor
		  => [PASSIVE => 'troughColor', 'Background', 'grey55'],
    );
    _layoutRequest($c,1);
    $c->OnDestroy(['Destroyed' => $c]);
}

sub anchor {
    my $c = shift;
    my $var = \$c->{Configure}{'-anchor'};
    my $old = $$var;

    if(@_) {
	my $new = shift;
	croak "bad anchor position \"$new\": must be n, s, w or e"
		unless $new =~ /^[news]$/;
	$$var = $new;
    }

    $old;
}

sub _layoutRequest {
    my $c = shift;
    my $why = shift;
    $c->afterIdle(['_arrange',$c]) unless $c->{'layout_pending'};
    $c->{'layout_pending'} |= $why;