summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/trace1.pl
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/trace1.pl')
-rw-r--r--Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/trace1.pl49
1 files changed, 49 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/trace1.pl b/Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/trace1.pl
new file mode 100644
index 00000000000..eba655c7ba0
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/trace1.pl
@@ -0,0 +1,49 @@
+# trace1.pl
+
+use Tk::widgets qw/ Trace /;
+use vars qw/ $TOP /;
+use strict;
+
+sub trace1 {
+
+ my( $demo ) = @_;
+
+ $TOP = $MW->WidgetDemo(
+ -name => $demo,
+ -text => "This demonstration animates an analog display as you move the Scale's slider.",
+ -title => 'Move a meter tied to a variable',
+ -iconname => 'trace1',
+ );
+
+ my $mw = $TOP;
+ my $v; # variable to trace
+
+ my $c = $mw->Canvas(qw/-width 200 -height 110 -bd 2 -relief sunken/)->grid;
+ $c->createLine(qw/ 100 100 10 100 -tag meter -arrow last -width 5/);
+ my $s = $mw->Scale(qw/-orient h -from 0 -to 100 -variable/ => \$v)->grid;
+ $mw->Label(-text => 'Slide Me')->grid;
+
+ # Trace $v when written. The callback is supplied three explicit arguments:
+ # the index if an array or hash, else undef, the proposed new value, and the
+ # trace operation (rwu) for read, write, undef, respectively. Additionally,
+ # we pass the Canvas and Scale widget references.
+
+ $mw->traceVariable(\$v, 'w' => [\&trace1_update_meter, $c, $s]);
+
+} # end trace1
+
+sub trace1_update_meter {
+
+ my( $index, $value, $op, $c, $s ) = @_;
+
+ return if $op eq 'u';
+
+ my($min, $max) = ($s->cget(-from), $s->cget(-to));
+ my $pos = $value / abs($max - $min);
+ my $pi = 3.1415926;
+ my $x = 100.0 - 90.0 * (cos( $pos * $pi ));
+ my $y = 100.0 - 90.0 * (sin( $pos * $pi ));
+ $c->coords(qw/meter 100 100/, $x, $y);
+ return $value;
+
+ } # end trace1_update_meter