home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _a46abdeb3171a9a8b130d620db1a89ee < prev    next >
Encoding:
Text File  |  2004-06-01  |  1.5 KB  |  50 lines
  1. # trace1.pl
  2.  
  3. use Tk::widgets qw/  Trace /;
  4. use vars qw/ $TOP /;
  5. use strict;
  6.  
  7. sub 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.  
  35. sub 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.