#!/usr/bin/perl
use warnings;
use strict;
#important to predeclare Tk and include Trace
package Tk;
use Tk::Trace;

package main;
use Tk;
use constant PI => 3.1415926;

my $mw = MainWindow->new;

$mw->fontCreate('medium',
   -family=>'courier',
   -weight=>'bold',
   -size=>int(-14*14/10));

my $c = $mw->Canvas(
              -width => 200,
              -height => 110,
              -bd => 2,
              -relief => 'sunken',
              -background => 'black',
              )->pack;

$c->createLine(100,100,10,100,
          -tags => ['needle'],
          -arrow => 'last',
          -width => 5,
          -fill => 'hotpink',
           );

my $gauge = $c->createArc(
        10,10, 190,190,
        -start => 0,
        -style => 'arc',
        -width => 5,
        -extent => 180,
        -outline => 'skyblue',
        -tags => ['gauge'],
);

my $hub = $c->createArc(
        90,95, 110,115,
        -start => 0,
        -extent => 180,
        -fill => 'lightgreen',
        -tags => ['hub'],
);

my $v = 0;
$mw->traceVariable(\$v, 'w' => [\&update_meter]);

$mw->bind('<Motion>' => sub{ $v += 1 });

$mw->repeat(50,sub{ $v-- });

my $text = $c->createText(
      100,50,
       -text  => $v,
       -font  => 'medium',
       -fill  => 'yellow',
       -anchor => 's',
       -tags => ['text']
 );

$c->raise('needle','text');
$c->raise('hub','needle');

MainLoop;

sub update_meter {
   my($index, $value) = @_;
  if($value <= 0){$value = 0 }
  if($value >= 100){$value = 100}

    my $pos = $value / 100;
    my $x = 100.0 - 90.0 * (cos( $pos * PI ));
    my $y = 100.0 - 90.0 * (sin( $pos * PI ));
    $c->coords('needle', 100,100, $x, $y);
    $c->itemconfigure($text,-text => $value);
return $value;
}
[download]