$Tk::LabelTimer::VERSION = 1.0; package Tk::LabelTimer; use base qw(Tk::LabelFmt); use strict; Construct Tk::Widget 'LabelTimer'; sub ClassInit { my ($class, $mw) = @_; $class->Tk::LabelFmt::ClassInit($mw); } sub Populate { my ($w, $args) = @_; $w->Tk::LabelFmt::Populate($args); $w->ConfigSpecs( -undefstring => [qw/PASSIVE undefstring UndefString/, "--:--:--.--"], -formatcmd => [qw/CALLBACK formatCmd FormatCmd /, \&FormatCmdTimer], ); } sub FormatCmdTimer { my ($w, $val) = @_; return $w->cget('-undefstring') if (!defined $val); my $fmt = $w->cget('-format'); my ($hr, $min, $sec) = (localtime($val))[2,1,0]; my $fsec = $val - int ($val); return sprintf("%02d:%02d:%05.2f", $hr, $min, $sec+$fsec); } sub Configured { Tk::LabelFmt::Configured(@_) } 1; __END__ =head1 NAME Tk::LabelTimer - Print variables in a label in a clock format. =head1 SYNOPSIS S< >I<$lo> = I<$parent>-E<gt>B<LabelTimer>(I<-option> =E<gt> I<value>, ... ); =head1 DESCRIPTION This widget is derived from LabelFmt and contains additional options for formatting time values. The same options that are abailable for LabelFmt are available here. =over 4 =item B<Label options> LabelTimer takes all valid options of Tk::Label; =item B<LabelFmt options> LabelTimer takes all valid options of Tk::LabelFmt; =back =head1 METHODS None. =head1 ADVERTISED WIDGETS None. =head1 EXAMPLES my $timevar = time; I<$lo> = I<$mw>-E<gt>B<LabelTimer>(-textvariable =E<gt> \$timevar); =head1 AUTHOR viosca@imageman.com This program is free software; you can redistribute it andor modify it and/ormodify it under the same terms as Perl itself. =head1 SEE ALSO L<Tk::LabelFmt|Tk::LabelFmt> L<Tk::LabelWgs|Tk::LabelWgs> =cut