Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
PerlMonks  

Simple Tk Gauge

by zentara (Archbishop)
on Jul 08, 2005 at 20:54 UTC ( #473564=snippet: print w/ replies, xml ) Need Help??

Description: After investigating Tk::Gauge Module Borked? , I tried to see how to tie a variable to a gauge. There is a trick to it, notice how you must declare the package Tk, then include Tk::Trace in it. Then create a main package. Anyways, here is a super simple example to demonstrate it. Just wiggle your mouse. :-)
#!/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;
}

Comment on Simple Tk Gauge
Download Code

Back to Snippets Section

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: snippet [id://473564]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others musing on the Monastery: (4)
As of 2014-09-16 01:48 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite cookbook is:










    Results (155 votes), past polls