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