Tk::Clock - Clock widget with analog and digital display

Tk-Clock documentation Contained in the Tk-Clock distribution.

Index

Code Index:

NAME

Top

Tk::Clock - Clock widget with analog and digital display

SYNOPSIS

Top

use Tk use Tk::Clock;

$clock = $parent->Clock (?-option => <value> ...?);

$clock->config ( # These reflect the defaults timeZone => "", backDrop => "",

    useAnalog	=> 1,
    handColor	=> "Green4",
    secsColor	=> "Green2",
    tickColor	=> "Yellow4",
    tickFreq	=> 1,
    tickDiff    => 0,
    useSecHand  => 1,
    handCenter	=> 0,
    anaScale	=> 100,
    autoScale	=> 0,
    ana24hour	=> 0,
    countDown   => 0,
    timerValue  => 0,

    useInfo	=> 0,
    infoColor	=> "#cfb53b",
    infoFormat	=> "HH:MM:SS",
    infoFont	=> "fixed 6",

    useDigital	=> 1,
    digiAlign   => "center",
    timeFont	=> "fixed 6",
    timeColor	=> "Red4",
    timeFormat	=> "HH:MM:SS",
    dateFont	=> "fixed 6",
    dateColor	=> "Blue4",
    dateFormat	=> "dd-mm-yy",
    );

DESCRIPTION

Top

This module implements a Canvas-based clock widget for perl-Tk with lots of options to change the appearance.

Both analog and digital clocks are implemented.

METHODS

Top

Clock

This is the constructor. It does accept the standard widget options plus those described in config.

config

Below is a description of the options/attributes currently available. Their default value is in between parenthesis.

useAnalog (1)
useInfo (0)
useDigital (1)

Enable the analog clock (useAnalog) and/or the digital clock (useDigital) in the widget. The analog clock will always be displayed above the digital part

  +----------+
  |    ..    |  \
  |  . \_ .  |   |_ Analog clock
  |  .    .  |   |
  |    ..    |  /
  | 23:59:59 |  --- Digital time
  | 31-12-09 |  --- Digital date
  +----------+

The analog clock displays ticks, hour hand, minutes hand and second hand. The digital part displays two parts, which are configurable. By default these are time and date.

The useInfo enables a text field between the backdrop of the analog clock and its items. You can use this field to display personal data.

autoScale (0)

When set to a true value, the widget will try to re-scale itself to automatically fit the containing widget.

  $clock->config (autoScale => 1);
anaScale (100)

The analog clock can be enlarged or reduced using anaScale for which the default of 100% is about 72x72 pixels.

When using pack for your geometry management, be sure to pass -expand =&gt; 1, -fill =&gt; "both" if you plan to resize with anaScale or enable/disable either analog or digital after the clock was displayed.

  $clock->config (anaScale => 400);
ana24hour (0)

The default for the analog clock it the normal 12 hours display, as most clocks are. This option will show a clock where one round of the hour-hand will cover a full day of 24 hours, noon is at the bottom where the 6 will normally display.

  $clock->config (ana24hour => 1);
useSecHand (1)

This controls weather the seconds-hand is shown.

  $clock->config (useSecHand => 0);
countDown (0)

When countDown is set to a true value, the clock will run backwards. This is a slightly experimental feature, it will not count down to a specific point in time, but will simply reverse the rotation, making the analog clock run counterclockwise.

timerValue (0)

This represents a countdown timer.

When setting timerValue to a number of seconds, the format values Hc, Mc, and Sc will represent the hour, minute and second of the this value. When the time reaches 0, all countdown values are reset to 0.

handColor ("Green4")
secsColor ("Green2")

Set the color of the hands of the analog clock. handColor controls the color for both the hour-hand and the minute-hand. secsColor controls the color for the seconds-hand.

  $clock->config (
      handColor => "#7F0000",
      secsColor => "OrangeRed",
      );
handCenter (0)

If set to a true value, will display a circular extension in the center of the analog clock that extends the hands as if they have a wider area at their turning point, like many station-type clocks (at least in the Netherlands) have.

  $clock->config (handCenter => 1);
tickColor ("Yellow4")

Controls the color of the ticks in the analog clock.

  $clock->config (tickColor => "White");
tickFreq (1)
tickDiff (0)

tickFreq controls how many ticks are shown in the analog clock.

Meaningful values for tickFreq are 1, 5 and 15 showing all ticks, tick every 5 minutes or the four main ticks only, though any positive integer will do (put a tick on any tickFreq minute).

When setting tickDiff to a true value, the major ticks will use a thicker line than the minor ticks.

  $clock->config (
      tickFreq => 5,
      tickDiff => 1,
      );
timeZone ("")

Set the timezone for the widget. The format should be the format recognized by the system. If unset, the local timezone is used.

  $clock->config (timeZone => "Europe/Amsterdam");
  $clock->config (timeZone => "MET-1METDST");
timeFont ("fixed 6")

Controls the font to be used for the top line in the digital clock. Will accept all fonts that are supported in your version of perl/Tk. This includes both True Type and X11 notation.

  $clock->config (timeFont => "{Liberation Mono} 11");
timeColor ("Red4")

Controls the color of the first line (time) of the digital clock.

  $clock->config (timeColor => "#00ff00");
timeFormat ("HH:MM:SS")

Defines the format of the first line of the digital clock. By default it will display the time in a 24-hour notation.

Legal timeFormat characters are H and HH for 24-hour, h and hh for AM/PM hour, M and MM for minutes, S and SS for seconds, Hc for countdown/timer hour, Mc for countdown/timer minutes, Sc for countdown/timer seconds, A for AM/PM indicator, d and dd for day-of-the month, ddd and dddd for short and long weekday, m, mm, mmm and mmmm for month, y and yy for year, w and ww for week-number and any separators :, -, / or space.

  $clock->config (timeFormat => "hh:MM A");
dateFont ("fixed 6")

Controls the font to be used for the bottom line in the digital clock. Will accept all fonts that are supported in your version of perl/Tk. This includes both True Type and X11 notation.

  $clock->config (dateFont => "-misc-fixed-*-normal--15-*-c-iso8859-1");
dateColor ("Blue4")

Controls the color of the second line (date) of the digital clock.

  $clock->config (dateColor => "Navy");
dateFormat ("dd-mm-yy")

Defines the format of the second line of the digital clock. By default it will display the date in three groups of two digits representing the day of the month, the month, and the last two digits of the year, separated by dashes.

  $clock->config (dateFormat => "ww dd-mm");

The supported format is the same as for timeFormat.

infoFont ("fixed 6")

Controls the font to be used for the info label in the analog clock. Will accept all fonts that are supported in your version of perl/Tk. This includes both True Type and X11 notation.

  $clock->config (infoFont => "{DejaVu Sans Mono} 8");
infoColor ("#cfb53b")

Controls the color of the info label of the analog clock (default is a shade of Gold).

  $clock->config (infoColor => "Yellow");
infoFormat ("HH:MM:SS")

Defines the format of the label inside the analog clock. By default will not be displayed. Just as timeFormat and dateFormat the content is updated every second if enabled.

  $clock->config (infoFormat => "BREITLING");

The supported format is the same as for timeFormat.

digiAlign ("center")

Controls the placement of the text in the digital clock. The only legal values for digiAlign are "left", "center", and "right". Any other value will be interpreted as the default "center".

  $clock->config (digiAlign => "right");
backDrop ("")

By default the background of the clock is controlled by the -background attribute to the constructor, which may default to the default background used in the perl/Tk script.

The backDrop attribute accepts any valid Tk::Photo object, and it will show (part of) the image as a backdrop of the clock

  use Tk;
  use Tk::Clock;
  use Tk::Photo;
  use Tk::PNG;

  my $mainw = MainWindow->new;
  my $backd = $mainw->Photo (
      -file    => "image.png",
      );
  my $clock = $mainw->Clock (
      -relief  => "flat",
      )->pack (-expand => 1, -fill => "both");
  $clock->config (
      backDrop => $backd,
      );
  MainLoop;

The new () constructor will also accept options valid for Canvas widgets, like -background and -relief.

BUGS

Top

If the system load's too high, the clock might skip some seconds.

There's no check if either format will fit in the given space.

TODO

Top

* Using POSIX' strftime () for dateFormat. Current implementation would probably make this very slow. * Full support for multi-line date- and time-formats with auto-resize. * Countdown clock API, incl action when done. * Better docs for the attributes

SEE ALSO

Top

Tk(3), Tk::Canvas(3), Tk::Widget(3), Tk::Derived(3)

AUTHOR

Top

H.Merijn Brand <h.m.brand@xs4all.nl>

Thanks to Larry Wall for inventing perl. Thanks to Nick Ing-Simmons for providing perlTk. Thanks to Achim Bohnet for introducing me to OO (and converting the basics of my clock.pl to Tk::Clock.pm). Thanks to Sriram Srinivasan for understanding OO though his Panther book. Thanks to all CPAN providers for support of different modules to learn from. Thanks to all who have given me feedback and weird ideas.

COPYRIGHT AND LICENSE

Top

Copyright (C) 1999-2011 H.Merijn Brand

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

Tk-Clock documentation Contained in the Tk-Clock distribution. 
#!/pro/bin/perl

package Tk::Clock;

use strict;
use warnings;

our $VERSION = "0.30";

use Carp;

use Tk;
use Tk::Widget;
use Tk::Derived;
use Tk::Canvas;

use vars qw( @ISA );
@ISA = qw/Tk::Derived Tk::Canvas/;

Construct Tk::Widget "Clock";

my $ana_base = 73;	# Size base for 100%

my %def_config = (
    timeZone	=> "",
    backDrop	=> "",

    useAnalog	=> 1,

    handColor	=> "Green4",
    secsColor	=> "Green2",
    tickColor	=> "Yellow4",
    tickFreq	=> 1,
    tickDiff	=> 0,
    useSecHand	=> 1,
    handCenter	=> 0,

    anaScale	=> 100,
    autoScale	=> 0,

    ana24hour	=> 0,
    countDown	=> 0,
    timerValue	=> 0,

    useInfo	=> 0,

    infoColor	=> "#cfb53b",
    infoFormat	=> "HH:MM:SS",
    infoFont	=> "fixed 6",

    useDigital	=> 1,

    digiAlign	=> "center",

    timeFont	=> "fixed 6",
    timeColor	=> "Red4",
    timeFormat	=> "HH:MM:SS",

    dateFont	=> "fixed 6",
    dateColor	=> "Blue4",
    dateFormat	=> "dd-mm-yy",

    fmtd	=> sub {
	sprintf "%02d-%02d-%02d", $_[3], $_[4] + 1, $_[5] + 1900;
	},
    fmtt	=> sub {
	sprintf "%02d:%02d:%02d", @_[2,1,0];
	},
    fmti	=> sub {
	sprintf "%02d:%02d:%02d", @_[2,1,0];
	},

    _anaSize	=> $ana_base,	# Default size (height & width)
    _digSize	=> 26,		# Height
    );

sub _month	# (month, size)
{    #   m    mm    mmm    mmmm
    [[  "1", "01", "Jan", "January"	],
     [  "2", "02", "Feb", "February"	],
     [  "3", "03", "Mar", "March"	],
     [  "4", "04", "Apr", "April"	],
     [  "5", "05", "May", "May"		],
     [  "6", "06", "Jun", "June"	],
     [  "7", "07", "Jul", "July"	],
     [  "8", "08", "Aug", "August"	],
     [  "9", "09", "Sep", "September"	],
     [ "10", "10", "Oct", "October"	],
     [ "11", "11", "Nov", "November"	],
     [ "12", "12", "Dec", "December"	]]->[$_[0]][$_[1]];
    } # _month

sub _wday	# (wday, size)
{
    [[ "Sun", "Sunday"		],
     [ "Mon", "Monday"		],
     [ "Tue", "Tuesday"		],
     [ "Wed", "Wednesday"	],
     [ "Thu", "Thursday"	],
     [ "Fri", "Friday"		],
     [ "Sat", "Saturday"	]]->[$_[0]][$_[1]];
    } # _wday

sub _min
{
    $_[0] <= $_[1] ? $_[0] : $_[1];
    } # _min

sub _max
{
    $_[0] >= $_[1] ? $_[0] : $_[1];
    } # _max

# Transparent packInfo for pack/grid/place/form
sub _packinfo
{
    my $clock = shift;

    my %pi = map { ("-$_" => 0) } qw( padx pady ipadx ipady );
    if (my $pm = $clock->manager) {
	   if ($pm eq "pack") {
	    %pi = $clock->packInfo;
	    }
	elsif ($pm eq "grid") {
	    %pi = $clock->gridInfo;
	    }
	elsif ($pm eq "form") {
	    %pi = $clock->formInfo;
	    # padx pady padleft padright padtop padbottom
	    $pi{"-ipadx"} = int (((delete $pi{"-padleft"}) + (delete $pi{"-padright"} )) / 2);
	    $pi{"-ipady"} = int (((delete $pi{"-padtop"} ) + (delete $pi{"-padbottom"})) / 2);
	    }
	elsif ($pm eq "place") {
	    # No action, place has no padding
	    }
	else {
	    # No action, unknown geometry manager
	    }
	}
    %pi;
    } # _packinfo

sub _resize
{
    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} * 72);
    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;
    } # _resize

# 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?
    my %pi = $clock->_packinfo;
    my ($px, $py) = ($pi{"-padx"}, $pi{"-pady"});
    $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
	# or there is a gap
	$clock->_destroyDigital;
	$clock->_createDigital;
	}
    $clock->_resize;
    } # _resize_auto

sub _createDigital
{
    my $clock = shift;

    my $data = $clock->privateData;
    my $wdth = _max ($data->{useAnalog}  * $data->{_anaSize},
		     $data->{useDigital} * 72);
    my ($pad, $anchor) = (5, "s");
    my ($x, $y) = ($wdth / 2, $data->{useAnalog} * $data->{_anaSize});
    if    ($data->{digiAlign} eq "left") {
	($anchor, $x) = ("sw", $pad);
	}
    elsif ($data->{digiAlign} eq "right") {
	($anchor, $x) = ("se", $wdth - $pad);
	}
    $clock->createText ($x, $y + $data->{_digSize},
	-anchor	=> $anchor,
	-width  => ($wdth - 2 * $pad),
	-font   => $data->{dateFont},
	-fill   => $data->{dateColor},
	-text   => $data->{dateFormat},
	-tags   => "date");
    $clock->createText ($x, $y + 13,
	-anchor	=> $anchor,
	-width  => ($wdth - 2 * $pad),
	-font   => $data->{timeFont},
	-fill   => $data->{timeColor},
	-text   => $data->{timeFormat},
	-tags   => "time");
#   $data->{Clock_h} = -1;
#   $data->{Clock_m} = -1;
#   $data->{Clock_s} = -1;
    $clock->_resize;
    } # _createDigital

sub _destroyDigital
{
    my $clock = shift;

    $clock->delete ("date");
    $clock->delete ("time");
    } # _destroyDigital

sub _where
{
    my ($clock, $tick, $len, $anaSize) = @_;      # ticks 0 .. 59
    my ($x, $y, $angle);

    $clock->privateData->{countDown} and $tick = (60 - $tick) % 60;
    my $h = ($anaSize + 1) / 2;
    $angle = $tick * .104720;
    $x = $len  * sin ($angle) * $anaSize / 73;
    $y = $len  * cos ($angle) * $anaSize / 73;
    ($h - $x / 4, $h + $y / 4, $h + $x, $h - $y);
    } # _where

sub _createAnalog
{
    my $clock = shift;

    my $data = $clock->privateData;

    ref $data->{backDrop} eq "Tk::Photo" and
	$clock->createImage (0, 0,
	    -anchor => "nw",
	    -image  => $data->{backDrop},
	    -tags   => "back",
	    );

    my $h = ($data->{_anaSize} + 1) / 2 - 1;

    if ($data->{useInfo}) {
	$clock->createText ($h, int (1.3 * $h),
	    -anchor => "n",
	    -width  => int (1.2 * $h),
	    -font   => $data->{infoFont},
	    -fill   => $data->{infoColor},
	    -text   => $data->{infoFormat},
	    -tags   => "info");
	}

    my $f = $data->{tickFreq} * 2;
    foreach my $dtick (0 .. 119) {
	$dtick % $f and next;
	my $l = $dtick % 30 == 0 ? $h / 5 :
		$dtick % 10 == 0 ? $h / 8 :
				   $h / 16;
	my $angle = ($dtick / 2) * .104720;
	my $x = sin $angle;
	my $y = cos $angle;
	$clock->createLine (
	    ($h - $l) * $x + $h + 1, ($h - $l) * $y + $h + 1,
	     $h       * $x + $h + 1,  $h       * $y + $h + 1,
	    -tags  => "tick",
	    -arrow => "none",
	    -fill  => $data->{tickColor},
	    -width => $data->{tickDiff} && $dtick % 10 == 0 ? 4.0 : 1.0,
	    );
	}
    $data->{Clock_h} = -1;
    $data->{Clock_m} = -1;
    $data->{Clock_s} = -1;

    $clock->createLine (
	$clock->_where (0, 22, $data->{_anaSize}),
	    -tags  => "hour",
	    -arrow => "none",
	    -fill  => $data->{handColor},
	    -width => $data->{_anaSize} / ($data->{handCenter} ? 35 : 26),
	    );
    if ($data->{handCenter}) {
	my $cntr = $data->{_anaSize} /  2;
	my $diam = $data->{_anaSize} / 30;
	$clock->createOval (($cntr - $diam) x 2, ($cntr + $diam) x 2,
	    -tags  => "hour",
	    -fill  => $data->{handColor},
	    -width => 0.
	    );
	}
    $clock->createLine (
	$clock->_where (0, 30, $data->{_anaSize}),
	    -tags  => "min",
	    -arrow => "none",
	    -fill  => $data->{handColor},
	    -width => $data->{_anaSize} / ($data->{handCenter} ? 60 : 30),
	    );
    if ($data->{useSecHand}) {
	$clock->createLine (
	    $clock->_where (0, 34, $data->{_anaSize}),
		-tags  => "sec",
		-arrow => "none",
		-fill  => $data->{secsColor},
		-width => 0.8);
	if ($data->{handCenter}) {
	    my $cntr = $data->{_anaSize} /  2;
	    my $diam = $data->{_anaSize} / 35;
	    $clock->createOval (($cntr - $diam) x 2, ($cntr + $diam) x 2,
		-tags  => "sec",
		-fill  => $data->{secsColor},
		-width => 0.
		);
	    }
	}

    $clock->_resize;
    } # _createAnalog

sub _destroyAnalog
{
    my $clock = shift;

    $clock->delete ($_) for qw( back info tick hour min sec );
    } # _destroyAnalog

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

    my $data = $clock->privateData;
    %$data = %def_config;
    $data->{Clock_h} = -1;
    $data->{Clock_m} = -1;
    $data->{Clock_s} = -1;
    $data->{_time_}  = -1;

    if (ref $args eq "HASH") {
	foreach my $arg (keys %$args) {
	    (my $attr = $arg) =~ s/^-//;
	    exists $data->{$attr} and $data->{$attr} = delete $args->{$arg};
	    }
	}

    $clock->SUPER::Populate ($args);

    $clock->ConfigSpecs (
        -width              => [ qw(SELF width              Width              72    ) ],
        -height             => [ qw(SELF height             Height             100   ) ],
        -relief             => [ qw(SELF relief             Relief             raised) ],
        -borderwidth        => [ qw(SELF borderWidth        BorderWidth        1     ) ],
        -highlightthickness => [ qw(SELF highlightThickness HighlightThickness 0     ) ],
        -takefocus          => [ qw(SELF takefocus          Takefocus          0     ) ],
        );

    $data->{useAnalog}  and $clock->_createAnalog;
    $data->{useDigital} and $clock->_createDigital;
    $clock->_resize;

    $clock->repeat (995, ["_run" => $clock]);
    } # Populate

sub config
{
    my $clock = shift;

    ref $clock or croak "Bad method call";
    @_ or return;

    my $conf;
    if (ref $_[0] eq "HASH") {
	$conf = shift;
	}
    elsif (scalar @_ % 2 == 0) {
	my %conf = @_;
	$conf = \%conf;
	}
    else {
	croak "Bad hash";
	}

    my $data = $clock->privateData;
    my $autoScale;
    foreach my $conf_spec (keys %$conf) {
	(my $attr = $conf_spec) =~ s/^-//;
	defined $def_config{$attr} && defined $data->{$attr} or next;
	my $old = $data->{$attr};
	$data->{$attr} = $conf->{$conf_spec};
	if    ($attr eq "tickColor") {
	    $clock->itemconfigure ("tick", -fill => $data->{tickColor});
	    }
	elsif ($attr eq "handColor") {
	    $clock->itemconfigure ("hour", -fill => $data->{handColor});
	    $clock->itemconfigure ("min",  -fill => $data->{handColor});
	    }
	elsif ($attr eq "secsColor") {
	    $clock->itemconfigure ("sec",  -fill => $data->{secsColor});
	    }
	elsif ($attr eq "dateColor") {
	    $clock->itemconfigure ("date", -fill => $data->{dateColor});
	    }
	elsif ($attr eq "dateFont") {
	    $clock->itemconfigure ("date", -font => $data->{dateFont});
	    }
	elsif ($attr eq "timeColor") {
	    $clock->itemconfigure ("time", -fill => $data->{timeColor});
	    }
	elsif ($attr eq "timeFont") {
	    $clock->itemconfigure ("time", -font => $data->{timeFont});
	    }
	elsif ($attr eq "dateFormat" || $attr eq "timeFormat" || $attr eq "infoFormat") {
	    my %fmt = (
		"S"	=> '%d',	# 45
		"SS"	=> '%02d',	# 45
		"Sc"	=> '%02d',	# 45	countdown
		"M"	=> '%d',	# 7
		"MM"	=> '%02d',	# 07
		"Mc"	=> '%02d',	# 07	countdown
		"H"	=> '%d',	# 6
		"HH"	=> '%02d',	# 06
		"Hc"	=> '%02d',	# 06	countdown
		"h"	=> '%d',	# 6	AM/PM
		"hh"	=> '%02d',	# 06	AM/PM
		"A"	=> '%s',	# PM
		"d"	=> '%d',	# 6
		"dd"	=> '%02d',	# 06
		"ddd"	=> '%3s',	# Mon
		"dddd"	=> '%s',	# Monday
		"m"	=> '%d',	# 7
		"mm"	=> '%02d',	# 07
		"mmm"	=> '%3s',	# Jul
		"mmmm"	=> '%s',	# July
		"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 = "";
	    foreach my $f (@fmt) {
		if (defined $fmt{$f}) {
		    $fmt .= $fmt{$f};
		    if ($f =~ m/^m+$/) {
			my $l = length ($f) - 1;
			$args .= ", Tk::Clock::_month (\$m, $l)";
			}
		    elsif ($f =~ m/^ddd+$/) {
			my $l = length ($f) - 3;
			$args .= ", Tk::Clock::_wday (\$wd, $l)";
			}
		    else {
			$args .= ', $' . substr ($f, 0, 1);
			$f =~ m/^[HMS]c/ and $args .= "c";
			$f =~ m/^y+$/    and
			    $args .= length ($f) < 3 ? " % 100" : " + 1900";
			}
		    }
		else {
		    $fmt .= $f;
		    }
		}
	    $data->{Clock_h} = -1;	# force update;
	    $data->{"fmt".substr $attr, 0, 1} = eval join "\n" =>
		 q[ sub							],
		 q[ {							],
		 q[     my ($S,  $M,  $H, $d, $m, $y, $wd, $yd, $dst,	],
		 q[ 	    $Sc, $Mc, $Hc) = @_;			],
		 q[     my $w = $yd / 7 + 1;				],
		 q[     my $h = $H % 12;				],
		 q[     my $A = $H > 11 ? "PM" : "AM";			],
		qq[     sprintf qq!$fmt!$args;				],
		 q[     }						];
	    }
	elsif ($attr eq "timerValue") {
	    $data->{timerStart} = $data->{timerValue} ? time : undef;
	    }
	elsif ($attr eq "tickFreq") {
#	    $data->{tickFreq} < 1 ||
#	    $data->{tickFreq} != int $data->{tickFreq} and
#		$data->{tickFreq} = $old;
	    unless ($data->{tickFreq} == $old) {
		$clock->_destroyAnalog;
		$clock->_createAnalog;
		}
	    }
	elsif ($attr eq "autoScale") {
	    $autoScale = !!$data->{autoScale};
	    }
	elsif ($attr eq "anaScale") {
	    if ($data->{anaScale} eq "auto" or $data->{anaScale} <= 0) {
		$data->{autoScale} = 1;
		$data->{anaScale} = $clock
		    ? int (100 * $clock->cget (-height) / $ana_base) || 100
		    : 100;
		$data->{_anaSize} = int ($ana_base * $data->{anaScale} / 100.);
		}
	    else {
		defined $autoScale or $autoScale = 0;
		my $new_size = int ($ana_base * $data->{anaScale} / 100.);
		unless ($new_size == $data->{_anaSize}) {
		    $data->{_anaSize} = $new_size;
		    $clock->_destroyAnalog;
		    $clock->_createAnalog;
		    if (exists $conf->{anaScale} && $data->{useDigital}) {
			# Otherwise the digital either overlaps the analog
			# or there is a gap
			$clock->_destroyDigital;
			$clock->_createDigital;
			}
		    $clock->after (5, ["_run" => $clock]);
		    }
		}
	    }
	elsif ($attr eq "backDrop" && $data->{useAnalog}) {
	    $clock->delete ("back");
	    if (ref $data->{backDrop} eq "Tk::Photo") {
		$clock->createImage (0, 0,
		    -anchor => "nw",
		    -image  => $data->{backDrop},
		    -tags   => "back",
		    );
		$clock->lower ("back", ($clock->find ("withtag", "tick"))[0]);
		}
	    }
	elsif ($attr eq "useAnalog") {
	    if    ($old == 1 && !$data->{useAnalog}) {
		$clock->_destroyAnalog;
		$clock->_destroyDigital;
		$data->{useDigital} and $clock->_createDigital;
		}
	    elsif ($old == 0 &&  $data->{useAnalog}) {
		$clock->_destroyDigital;
		$clock->_createAnalog;
		$data->{useDigital} and $clock->_createDigital;
		}
	    $clock->after (5, ["_run" => $clock]);
	    }
	elsif ($attr eq "useInfo") {
	    if ($old ^ $data->{useInfo} && $data->{useAnalog}) {
		$clock->_destroyAnalog;
		$clock->_destroyDigital;
		$clock->_createAnalog;
		$data->{useDigital} and $clock->_createDigital;
		}
	    $clock->after (5, ["_run" => $clock]);
	    }
	elsif ($attr eq "useDigital") {
	    if    ($old == 1 && !$data->{useDigital}) {
		$clock->_destroyDigital;
		}
	    elsif ($old == 0 &&  $data->{useDigital}) {
		$clock->_createDigital;
		}
	    $clock->after (5, ["_run" => $clock]);
	    }
	elsif ($attr eq "digiAlign") {
	    if ($data->{useDigital} && $old ne $data->{digiAlign}) {
		$clock->_destroyDigital;
		$clock->_createDigital;
		$clock->after (5, ["_run" => $clock]);
		}
	    }
	}
    if (defined $autoScale) {
	$data->{autoScale} = $autoScale;
	if ($autoScale) {
	    $clock->Tk::bind         ("Tk::Clock","<<ResizeRequest>>", \&_resize_auto);
	    $clock->parent->Tk::bind (            "<<ResizeRequest>>", \&_resize_auto);
	    $clock->_resize_auto;
	    }
	else {
	    $clock->Tk::bind         ("Tk::Clock","<<ResizeRequest>>", sub {});
	    $clock->parent->Tk::bind (            "<<ResizeRequest>>", sub {});
	    }
	}
    $clock->_resize;
    $clock;
    } # config

sub _run
{
    my $clock = shift;

    my $data = $clock->privateData;

    $data->{timeZone} and local $ENV{TZ} = $data->{timeZone};
    my $t = time;
    $t == $data->{_time_} and return;	# Same time, no update
    $data->{_time_} = $t;
    my @t = localtime $t;

    my ($Sc, $Mc, $Hc) = (0, 0, 0);
    if ($data->{timerValue}) {
	use integer;

	defined $data->{timerStart} or $data->{timerStart} = $t;
	my $tv = $data->{timerValue} - ($t - $data->{timerStart});
	if ($tv < 0) {
	    $data->{timerValue} = 0;
	    $data->{timerStart} = undef;
	    }
	else {
	    $Sc = $tv % 60;
	    $tv /= 60;
	    $Mc = $tv % 60;
	    $tv /= 60;
	    $Hc = $tv;
	    }
	}
    push @t, $Sc, $Mc, $Hc;

    unless ($t[2] == $data->{Clock_h}) {
	$data->{Clock_h} = $t[2];
	$data->{useDigital} and
	    $clock->itemconfigure ("date", -text => &{$data->{fmtd}} (@t));
	}

    unless ($t[1] == $data->{Clock_m}) {
        $data->{Clock_m} = $t[1];
	if ($data->{useAnalog}) {
	    my ($h24, $m24) = $data->{ana24hour} ? (24, 2.5)  : (12, 5);
	    $clock->coords ("hour",
		$clock->_where (($data->{Clock_h} % $h24) * $m24 + $t[1] / $h24, 22, $data->{_anaSize}));

	    $clock->coords ("min",
		$clock->_where ($data->{Clock_m}, 30, $data->{_anaSize}));
	    }
	}

    $data->{Clock_s} = $t[0];
    if ($data->{useAnalog}) {
	$data->{useSecHand} and
	    $clock->coords ("sec",
		$clock->_where ($data->{Clock_s}, 34, $data->{_anaSize}));
	$data->{useInfo} and
	    $clock->itemconfigure ("info", -text => &{$data->{fmti}} (@t));
	}
    $data->{useDigital} and
	$clock->itemconfigure ("time", -text => &{$data->{fmtt}} (@t));

    $data->{autoScale} and $clock->_resize_auto;
    } # _run

1;

__END__