Tk-Clock
view release on metacpan or search on metacpan
my $clock = shift;
use integer;
my $data = $clock->privateData;
my $hght = $data->{useAnalog} * $data->{_anaSize} +
$data->{useDigital} * $data->{_digSize} + 1;
my $wdth = _max ($data->{useAnalog} * $data->{_anaSize},
$data->{useDigital} * $data->{_digWdth});
my $dim = "${wdth}x${hght}";
my $geo = $clock->parent->geometry;
my ($pw, $ph) = split m/\D/, $geo; # Cannot use ->cget here
if ($ph > 5 && $clock->parent->isa ("MainWindow")) {
my %pi = $clock->_packinfo;
my $px = _max ($wdth + $pi{"-padx"}, $pw);
my $py = _max ($hght + $pi{"-pady"}, $ph);
$clock->parent->geometry ("${px}x$py");
}
$clock->configure (
-height => $hght,
-width => $wdth);
$dim;
# Callback when auto-resize is called
sub _resize_auto {
my $clock = shift;
my $data = $clock->privateData;
$data->{useAnalog} && $data->{autoScale} == 1 or return;
my $owdth = $data->{useAnalog} * $data->{_anaSize};
my $geo = $clock->geometry;
my ($gw, $gh) = split m/\D/, $geo; # Cannot use ->cget here
$gw < 5 and return; # not packed yet?
$data->{useDigital} and $gh -= $data->{_digSize};
my $nwdth = _min ($gw, $gh - 1);
abs ($nwdth - $owdth) > 5 && $nwdth >= 10 or return;
$data->{_anaSize} = $nwdth - 2;
$clock->_destroyAnalog;
$clock->_createAnalog;
if ($data->{useDigital}) {
# Otherwise the digital either overlaps the analog
"y" => '%d', # 98
"yy" => '%02d', # 98
"yyy" => '%04d', # 1998
"yyyy" => '%04d', # 1998
"w" => '%d', # 28 (week)
"ww" => '%02d', # 28
);
my $fmt = $data->{$attr};
$fmt =~ m{[\%\@\$]} and croak "%, \@ and \$ not allowed in $attr";
my $xfmt = join "|", reverse sort keys %fmt;
my @fmt = split m/\b($xfmt)\b/, $fmt;
my $args = "";
$fmt = "";
my $locale = $data->{useLocale} || "C";
foreach my $f (@fmt) {
if (defined $fmt{$f}) {
$fmt .= $fmt{$f};
if ($f =~ m/^m+$/) {
my $l = length ($f) - 1;
$args .= ", Tk::Clock::_month (q{$locale}, \$m, $l)";
}
( run in 0.852 second using v1.01-cache-2.11-cpan-71847e10f99 )