Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
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 lurking in the Monastery: (5)
As of 2015-08-05 03:23 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The oldest computer book still on my shelves (or on my digital media) is ...













    Results (76 votes), past polls