$Tk::LabelFmt::VERSION = 1.0;

package Tk::LabelFmt;

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

use strict;

Construct Tk::Widget 'LabelFmt';

sub ClassInit {
    my ($class, $mw) = @_;
    $class->Tk::Label::ClassInit($mw);
#    $class->SUPER::ClassInit($mw);
}
sub Populate {
    my ($w, $args) = @_;
#    $w->SUPER::Populate($args);
    $w->Tk::Label::Populate($args);
    $w->ConfigSpecs(
		    -format =>       [qw/PASSIVE format Format /, "%s"],
		    -undefstring =>  [qw/PASSIVE undefstring UndefString/, "--"],
		    -uds =>          '-undefstring',
		    -textvariable => [qw/PASSIVE textvariable TextVariable/, undef],
		    -formatcmd =>    [qw/CALLBACK formatCmd FormatCmd /, \&FormatCmd],
		    );
}
sub set {
    my ($w, $value) = @_;
    $w->configure(-text => $w->Callback('-formatcmd', $w, $value));
}
# This routine is called whenever the widget is re/configured.
sub Configured {
    use Tie::Watch;
    my ($w,$args,$changed) = @_;
    $w->SUPER::Configured($w, $args, $changed);
    if (exists $changed->{'-textvariable'}) {
	my $vref = $changed->{'-textvariable'};
	my $st = [ sub {
	    my($watch, $new_val) = @_;
	    my $argv = $watch->Args('-store');
	    $argv->[0]->set($new_val);
	    $watch->Store($new_val);
	}, $w];
	$w->{watch} = Tie::Watch->new(-variable => $vref, -store=> $st);
	$w->OnDestroy( [sub {$_[0]->{watch}->Unwatch}, $w] );
	$w->set($$vref); # set the current value too.
    }
    return exists $w->{'Configure'};
}
sub FormatCmd {
    my ($w, $value) = @_;
    return $w->cget('-undefstring') if (!defined $value);
    return sprintf($w->cget('-format'), $value);
}
1;
__END__

=head1 NAME

Tk::LabelFmt - Printf style formated labels.

=head1 SYNOPSIS

S<    >I<$lo> = I<$parent>-E<gt>B<LabelFmt>(I<-option> =E<gt> I<value>, ... );

=head1 DESCRIPTION

This widget is a standard Label that contains an optional format string that
can be set to format its textvariable.
Additionally, a specific string can be supplied to display on
undef, and a callback can be supplied for more complicated formats.

=over 4

=item B<labeloptions>

LabelFmt takes all valid options of Tk::Label;

=item B<-format>

A sprintf style format string used to display the textvariable.

=item B<-undefstring> or B<-uds>

The value to display if textvariable contains 'undef'.

=item B<-formatcmd>

Specifies a callback function to do formatting.  @_ = ($value, -format, -undefstring).

=back

=head1 METHODS

None.

=head1 ADVERTISED WIDGETS

None.

=head1 EXAMPLES

I<$lo> = I<$mw>-E<gt>B<LabelFmt>(-format =E<gt> "0x%08X",
    -undefstring =E<gt> "empty",
    -textvariable =E<gt> \$var
    );


sub todegrees {
    my ($val, $fmt, $udf) = @_;
    return $udf if (!defined $value);
    return sprintf("%10.3f", $val*180/PI);
    };

my $radiansvar;

I<$lo> = I<$mw>-E<gt>B<LabelFmt>(-format =E<gt> "0x%08X",
    -undefstring =E<gt> "empty",
    -textvariable =E<gt> \$radiansvar
    );

$radiansvar = 3.14/3.0;

=head1 AUTHOR

viosca@viosca.com

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

=head1 SEE ALSO

L<Tk::LabelTimer|Tk::LabelTimer>
L<Tk::LabelWgs|Tk::LabelWgs>

=cut