view release on metacpan or  search on metacpan

Tk/MonitorBar.pm  view on Meta::CPAN

package Tk::MonitorBar;

use Tk;
use Tk::ProgressBar;
use Carp;
use strict;

use base qw(Tk::Derived Tk::ProgressBar);

Construct Tk::Widget 'MonitorBar';

sub _arrange {
    my $c = shift;

    my $checker = Tk::Exists($c);

    unless ($checker)
    {
       return;
    }
    my $why = $c->{'layout_pending'};

    $c->{'layout_pending'} = 0;

    my $w = $c->Width;
    my $h = $c->Height;
    my $bw = $c->cget('-borderwidth') + $c->cget('-highlightthickness');
    my $x = abs(int($c->{Configure}{'-padx'})) + $bw;
    my $y = abs(int($c->{Configure}{'-pady'})) + $bw;
    my $value = $c->value;
    my $from = $c->{Configure}{'-from'}; 
    my $to   = $c->{Configure}{'-to'};
    my $horz = $c->{Configure}{'-anchor'} =~ /[ew]/i ? 1 : 0;
    my $dir  = $c->{Configure}{'-anchor'} =~ /[nw]/i ? -1 : 1;

    my($minv,$maxv) = $from < $to ? ($from,$to) : ($to,$from);

    if($w == 1 && $h == 1) {
	my $bw = $c->cget('-borderwidth');
	my $defw = 10 + $y*2 + $bw *2;
	my $defl = ($maxv - $minv) + $x*2 + $bw*2;

	$h = $c->{Configure}{'-length'} || $defw;
	$w = $c->{Configure}{'-width'}  || $defl;

	($w,$h) = ($h,$w) unless $horz;
	$c->GeometryRequest($w,$h);
	$c->parent->update;
	$c->update;

	$w = $c->Width;
	$h = $c->Height;
    }

    $w -= $x*2;
    $h -= $y*2;

    my $length = $horz ? $w : $h;
    my $width  = $horz ? $h : $w;
   
    my $blocks = int($c->{Configure}{'-blocks'});
    my $gap    = int($c->{Configure}{'-gap'});

    $blocks = 1 if $blocks < 1;

    my $gwidth = $gap * ( $blocks - 1);
    my $bwidth = ($length - $gwidth) / $blocks;