1# trace1.pl
2
3use Tk::widgets qw/  Trace /;
4use vars qw/ $TOP /;
5use strict;
6
7sub trace1 {
8
9    my( $demo ) = @_;
10
11    $TOP = $MW->WidgetDemo(
12        -name             => $demo,
13        -text             => "This demonstration animates an analog display as you move the Scale's slider.",
14        -title            => 'Move a meter tied to a variable',
15        -iconname         => 'trace1',
16    );
17
18    my $mw = $TOP;
19    my $v;			# variable to trace
20
21    my $c = $mw->Canvas(qw/-width 200 -height 110 -bd 2 -relief sunken/)->grid;
22    $c->createLine(qw/ 100 100 10 100  -tag meter -arrow last -width 5/);
23    my $s = $mw->Scale(qw/-orient h -from 0 -to 100 -variable/ => \$v)->grid;
24    $mw->Label(-text => 'Slide Me')->grid;
25
26    # Trace $v when written.  The callback is supplied three explicit arguments:
27    # the index if an array or hash, else undef, the proposed new value, and the
28    # trace operation (rwu) for read, write, undef, respectively. Additionally,
29    # we pass the Canvas and Scale widget references.
30
31    $mw->traceVariable(\$v, 'w' => [\&trace1_update_meter, $c, $s]);
32
33} # end trace1
34
35sub trace1_update_meter {
36
37    my( $index, $value, $op, $c, $s ) = @_;
38
39    return if $op eq 'u';
40
41    my($min, $max) = ($s->cget(-from), $s->cget(-to));
42    my $pos = $value / abs($max - $min);
43    my $pi = 3.1415926;
44    my $x = 100.0 - 90.0 * (cos( $pos * $pi ));
45    my $y = 100.0 - 90.0 * (sin( $pos * $pi ));
46    $c->coords(qw/meter 100 100/, $x, $y);
47    return $value;
48
49 } # end trace1_update_meter
50