Tk-Clock

 view release on metacpan or  search on metacpan

Clock.pm  view on Meta::CPAN

    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;

Clock.pm  view on Meta::CPAN


# 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

Clock.pm  view on Meta::CPAN

		"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 )