14.4.1. Tk::Thermometer

my $therm = $mw->Thermometer(
    -label  => 'Reactants Temp',
    -tscale => 'Celsius',
)->pack;
$therm->set(-273);

Figure 14-9. A Frame-based Thermometer widget

The module, Thermometer.pm, begins in the standard fashion by declaring the version, class name, required widgets, and base class, as well as building a constructor.

$Tk::Thermometer::VERSION = '1.0';

package Tk::Thermometer;

use Tk::widgets qw/Radiobutton Scale/;
use base qw/Tk::Frame/;
use strict;

Construct Tk::Widget 'Thermometer';

%PIXMAPS stores the three Radiobutton Pixmap images. These images are created once during class initialization and shared by all Thermometer instances. @TSCALES is an array of supported temperature scales.

my %PIXMAPS;                           # images for the class
my @TSCALES = qw/Kelvin Celsius Fahrenheit/;

    $self->{tscale} = $self->{old_tscale} = $TSCALES[0];

    my @highlightthickness = $scale;

    foreach my $unit (@TSCALES) {
        my $r = $self->Component('Radiobutton' => "radiobutton-$unit",
            -image    => $PIXMAPS{$unit},
            -variable => \$self->{tscale},
            -value    => $unit,
            -command  => [$self => 'tscale', $unit],
        )->pack(-side => 'top');
        push @highlightthickness, $r;
    }

The -highlightthickness option applies to all subwidgets in the array @highlightthickness, which includes the Scale and Radiobuttons. But for this mega-widget, that's the same as saying DESCENDANTS, so we could have saved some code.

Any other mega-widget options default to the Scale.

    $self->ConfigSpecs(
        -background   =>
          [['DESCENDANTS', 'SELF'], 'background', 'Background', 'white'],
        -from         => [$scale, qw/from From 500/],
        -highlightthickness => 
          [[@highlightthickness], qw/highlightThickness HighlightThickness 0/],
        -length       => [$scale, qw/length Length 200/],
        -tscale       => [qw/METHOD tscale Tscale/, $TSCALES[0]],
        -sliderlength => [$scale, qw/sliderLength SliderLength 10/],
        -to           => [$scale, qw/to To 0/],
        -width        => [$scale, qw/width Width 10/],
        'DEFAULT'     => [$scale],
    );
    $self->Delegates('DEFAULT' => $scale);

} # end Populate

When the Thermometer's temperature scale is changed, either programmatically by a configure(-tscale => $new_tscale) call or a Radiobutton click, we must convert the Scale's temperature value to the new units. The Thermometer class has various methods for converting from one temperature scale to another, having names of the form "old_scale2new_scale". All we need do is get the Scale's current temperature value, convert it to the new units, and update the Scale. Notice the use of Subwidget to fetch the advertised Scale widget reference.

tscale is called also on cget requests, so the subroutine both sets and gets the temperature scale.

sub tscale {

    # The temperature scale has changed - update the thermometer's
    # lower bound and reset the current temperature in the new scale.

    my($self, $new_tscale) = @_;

    if ($#_ > 0) {
        my $old_tscale = $self->{old_tscale};
        return if $new_tscale eq $old_tscale;

        my $subr = "${old_tscale}2${new_tscale}";
        $self->{tscale} = $self->{old_tscale} = $new_tscale;
        my $scale = $self->Subwidget('scale');
        $scale->set( $self->$subr( $scale->get ) );
    } else {
        $self->{tscale};    # cget( ) requests here
    }

} # end tscale

# Scale conversion data and subroutines.
#
#   Temperature     Kelvin   Celsius   Fahrenheit
#
#   Absolute Zero        0   -273.16      -459.69
#   Freezing        273.16         0           32
#   Boiling         373.16       100          212

use constant ABSZ_CELSIUS    => -273.16;
use constant ABSZ_FAHRENHEIT => -459.69;
use constant ABSZ_KELVIN     => 0;
use constant FREZ_FAHRENHEIT => 32;
use constant FIVE_NINTHS     => 5.0 / 9.0;
use constant NINE_FIFTHS     => 9.0 / 5.0;

# All conversion subroutines are called with two arguments, the
# mega-widget reference, and the temperature in the old scale.

sub Kelvin2Celsius {
    $_[0]->configure(-to => ABSZ_CELSIUS);
    $_[1] + ABSZ_CELSIUS;
}

sub Kelvin2Fahrenheit {
    $_[0]->configure(-to => ABSZ_FAHRENHEIT);
    NINE_FIFTHS * ( $_[1] + ABSZ_CELSIUS ) + FREZ_FAHRENHEIT;
}

sub Celsius2Kelvin {
    $_[0]->configure(-to => ABSZ_KELVIN);
    $_[1] - ABSZ_CELSIUS;
}

sub Celsius2Fahrenheit {
    $_[0]->configure(-to => ABSZ_FAHRENHEIT);
    NINE_FIFTHS * $_[1] + FREZ_FAHRENHEIT;
}

sub Fahrenheit2Kelvin {
    $_[0]->configure(-to => ABSZ_KELVIN);
    FIVE_NINTHS * ( $_[1] - FREZ_FAHRENHEIT ) - ABSZ_CELSIUS;
}

sub Fahrenheit2Celsius {
    $_[0]->configure(-to => ABSZ_CELSIUS);
    FIVE_NINTHS * ( $_[1] - FREZ_FAHRENHEIT );
}

1;