Tk::RotatingGauge - a rotating gauge for tk

    use Tk::RotatingGauge;

    my $g = $parent->RotatingGauge( @options );
    $g->value(10.5);

  Jerome Quelin

# 
# This file is part of Tk-RotatingGauge
# 
# This software is copyright (c) 2007 by Jerome Quelin.
# 
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
# 
use 5.008;
use warnings;
use strict;

package Tk::RotatingGauge;
our $VERSION = '1.100140';
# ABSTRACT: a rotating gauge for tk

use POSIX qw{ floor };
use Tk;
use Tk::Canvas;

use base qw{ Tk::Derived Tk::Canvas };
Construct Tk::Widget 'RotatingGauge';


# -- builders & initializers



#
# Populate - Tk internals
#
sub Populate {
    my( $self, $args ) = @_;

    # create the parent widget, specify our options.
    $self->SUPER::Populate( $args );
    $self->ConfigSpecs(
        -box       => [ 'PASSIVE', undef, undef, 'black'  ],
        -from      => [ 'PASSIVE', undef, undef, 0        ],
        -indicator => [ 'PASSIVE', undef, undef, 'red'    ],
        -labels    => [ 'PASSIVE', undef, undef, undef    ],
        -orient    => [ 'PASSIVE', undef, undef, 'horiz'  ],
        -policy    => [ 'PASSIVE', undef, undef, 'rotate' ],
        -to        => [ 'PASSIVE', undef, undef, 100      ],
        -visible   => [ 'PASSIVE', undef, undef, 20       ],
        -value     => [ 'METHOD',  undef, undef, undef    ],
    );

    # store the initial value for after initialization.
    my $val = exists $args->{-value} ? delete $args->{-value} : 50 ;
    $self->{Configure}{-value} = $val;

    # let's wait for canvas to be created before initializing the
    # various canvas items that will compose the gauge.
    $self->afterIdle( sub { $self->_draw_items } );
}


# -- public methods


sub value {
    my ($self, $value) = @_;

    my $is_strict = $self->{Configure}{-policy} eq 'strict';
    my $from   = $self->{Configure}{-from};
    my $to     = $self->{Configure}{-to};

    # check out-of-bounds.
    my $frac = $value - int($value);
    $value = $is_strict ? $from : $value % ($to-$from) + $frac
        if $value < $from;
    $value = $is_strict ? $to : $value % ($to-$from) + $frac
        if $value >= $to;

    # move the canvas items around.
    my $v = $self->{Configure}{-value};
    my $d = ($v - $value) * $self->{Configure}{-step};
    my @delta = $self->{Configure}{-is_horiz} ? ($d, 0) : (0, $d);
    $self->move( 'grid', @delta );
    $self->{Configure}{-value} = $value;
}


# -- private methods

#
# $gauge->_draw_items;
#
# Initialization of the various items that will compose the gauge.
#
sub _draw_items {
    my ($self) = @_;

    # get & compute some values...
    my $w = $self->{Configure}{-width};
    my $h = $self->{Configure}{-height};
    my $is_horiz = ( 'vertical' !~ /$self->{Configure}{-orient}/ );
    $self->{Configure}{-is_horiz} = $is_horiz;

    my $labels  = $self->{Configure}{-labels};
    my $from    = $self->{Configure}{-from};
    my $to      = $self->{Configure}{-to};
    my $visible = $self->{Configure}{-visible};
    my $step    = ($is_horiz ? $w : $h) / $visible;

    $self->{Configure}{-step}  = $step;


    # create the central line showing the value.
    if ( $self->{Configure}{-indicator} ne 'none' ) {
        my @coords = $is_horiz ? ($w/2 , 0, $w/2 ,$h) : (0, $h/2, $w, $h/2);
        $self->createLine( @coords, -fill=>$self->{Configure}{-indicator}, -width=>2);
    }

    # create the top / bottom lines if needed.
    if ( $self->{Configure}{-box} ne 'none' ) {
        my @coords;
        @coords = $is_horiz ? (1, 1, $w, 1) : (1, 1, 1, $h);
        $self->createLine( @coords, -fill=>$self->{Configure}{-box} );
        @coords = $is_horiz ? (1, $h, $w, $h) : ($w, 1, $w, $h);
        $self->createLine( @coords, -fill=>$self->{Configure}{-box} );
    }

    # draw ticks $from .. $to.
    foreach my $i ( $from .. $to-1 ) {
        my @coords;
        my $x    = $i * $step;
        my $text = defined $labels ?  $labels->[$i] : $i;
        @coords = $is_horiz ? ($x, 0, $x, $h) : (0, $x, $w, $x);
        $self->createLine( @coords, -tags=>'grid' );
        @coords = $is_horiz ? ($x+$step/2, $h/2) : ($w/2, $x+$step/2);
        $self->createText( @coords, -text=>$text, -tags=>'grid' );
    }
    # draw $visible ticks before $from and after $to.
    foreach my $i ( 0 .. $visible ) {
        my @coords;
        # before $from
        my $x    = -($i+1-$from) * $step;
        my $text = defined $labels ? $labels->[$to-1-$i] : $to-1-$i;
        @coords = $is_horiz ? ($x, 0, $x, $h) : (0, $x, $w, $x);
        $self->createLine( @coords, -tags=>'grid' );
        @coords = $is_horiz ? ($x+$step/2, $h/2) : ($w/2, $x+$step/2);
        $self->createText( @coords, -text=>$text, -tags=>'grid' );
        # after $to
        $x    = ($to+$i) * $step;
        $text = defined $labels ? $labels->[$from+$i] : $from+$i;
        @coords = $is_horiz ? ($x, 0, $x, $h) : (0, $x, $w, $x);
        $self->createLine( @coords, -tags=>'grid' );
        @coords = $is_horiz ? ($x+$step/2, $h/2) : ($w/2, $x+$step/2);
        $self->createText( @coords, -text=>$text, -tags=>'grid' );
    }


    # move the gauge to its initial value.
    my $v = $self->{Configure}{-value};
    my $d = ($visible/2-$v) * $step;
    my @delta = $is_horiz ? ($d,0) : (0,$d);
    $self->move( 'grid', @delta );
}


1;

__END__