Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
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;
}

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: snippet [id://473564]
help
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others having an uproarious good time at the Monastery: (6)
As of 2017-06-22 18:23 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    How many monitors do you use while coding?















    Results (526 votes). Check out past polls.