1Tk::Trace(3) perl/Tk Documentation Tk::Trace(3)
2
6 Tk::Trace - emulate Tcl/Tk trace functions.
7
9 use Tk::Trace
10 $mw->traceVariable(\$v, 'wru' => [\&update_meter, $scale]);
12 %vinfo = $mw->traceVinfo(\$v);
13 print "Trace info :\n ", join("\n ", @{$vinfo{-legible}}), "\n";
14 $mw->traceVdelete(\$v);
15
17 This class module emulates the Tcl/Tk trace family of commands by
18 binding subroutines of your devising to Perl variables using simple
19 Tie::Watch features.
20 Callback format is patterned after the Perl/Tk scheme: supply either a
22 code reference, or, supply an array reference and pass the callback
23 code reference in the first element of the array, followed by callback
24 arguments.
25 User callbacks are passed these arguments:
27 $_[0] = undef for a scalar, index/key for array/hash
29 $_[1] = variable's current (read), new (write), final (undef) value
30 $_[2] = operation (r, w, or u)
31 $_[3 .. $#_] = optional user callback arguments
32 As a Trace user, you have an important responsibility when writing your
34 callback, since you control the final value assigned to the variable.
35 A typical callback might look like:
36 sub callback {
38 my($index, $value, $op, @args) = @_;
39 return if $op eq 'u';
40 # .... code which uses $value ...
41 return $value; # variable's final value
42 }
43 Note that the callback's return value becomes the variable's final
45 value, for either read or write traces.
46 For write operations, the variable is updated with its new value before
48 the callback is invoked.
49 Multiple read, write and undef callbacks can be attached to a variable,
51 which are invoked in reverse order of creation.
52
54 $mw->traceVariable(varRef, op => callback);
55 varRef is a reference to the scalar, array or hash variable you
56 wish to trace. op is the trace operation, and can be any
57 combination of r for read, w for write, and u for undef. callback
58 is a standard Perl/Tk callback, and is invoked, depending upon the
59 value of op, whenever the variable is read, written, or destroyed.
60 %vinfo = $mw->traceVinfo(varRef);
62 Returns a hash detailing the internals of the Trace object, with
63 these keys:
64 %vinfo = (
66 -variable => varRef
67 -debug => '0'
68 -shadow => '1'
69 -value => 'HELLO SCALAR'
70 -destroy => callback
71 -fetch => callback
72 -store => callback
73 -legible => above data formatted as a list of string, for printing
74 );
75 For array and hash Trace objects, the -value key is replaced with a
77 -ptr key which is a reference to the parallel array or hash.
78 Additionally, for an array or hash, there are key/value pairs for
79 all the variable specific callbacks.
80 $mw->traceVdelete(\$v);
82 Stop tracing the variable.
83
85 # Trace a Scale's variable and move a meter in unison.
86 use Tk;
88 use Tk::widgets qw/Trace/;
89 $pi = 3.1415926;
91 $mw = MainWindow->new;
92 $c = $mw->Canvas( qw/-width 200 -height 110 -bd 2 -relief sunken/ )->grid;
93 $c->createLine( qw/100 100 10 100 -tag meter -arrow last -width 5/ );
94 $s = $mw->Scale( qw/-orient h -from 0 -to 100 -variable/ => \$v )->grid;
95 $mw->Label( -text => 'Slide Me for 5 Seconds' )->grid;
96 $mw->traceVariable( \$v, 'w' => [ \&update_meter, $s ] );
98 $mw->after( 5000 => sub {
100 print "Untrace time ...\n";
101 %vinfo = $s->traceVinfo( \$v );
102 print "Watch info :\n ", join("\n ", @{$vinfo{-legible}}), "\n";
103 $c->traceVdelete( \$v );
104 });
105 MainLoop;
107 sub update_meter {
109 my( $index, $value, $op, @args ) = @_;
110 return if $op eq 'u';
111 $min = $s->cget( -from );
112 $max = $s->cget( -to );
113 $pos = $value / abs( $max - $min );
114 $x = 100.0 - 90.0 * ( cos( $pos * $pi ) );
115 $y = 100.0 - 90.0 * ( sin( $pos * $pi ) );
116 $c->coords( qw/meter 100 100/, $x, $y );
117 return $value;
118 }
119 # Predictive text entry.
121 use Tk;
123 use Tk::widgets qw/ LabEntry Trace /;
124 use strict;
125 my @words = qw/radio television telephone turntable microphone/;
127 my $mw = MainWindow->new;
129 my $e = $mw->LabEntry(
131 qw/ -label Thing -width 40 /,
132 -labelPack => [ qw/ -side left / ],
133 -textvariable => \my $thing,
134 );
135 my $t = $mw->Text( qw/ -height 10 -width 50 / );;
136 $t->pack( $e, qw/ -side top / );
138 $e->focus;
140 $e->traceVariable( \$thing, 'w', [ \&trace_thing, $e, $t ] );
141 foreach my $k ( 1 .. 12 ) {
143 $e->bind( "<F${k}>" => [ \&ins, $t, Ev('K') ] );
144 }
145 $e->bind( '<Return>' =>
146 sub {
147 print "$thing\n";
148 $_[0]->delete( 0, 'end' );
149 }
150 );
151 MainLoop;
153 sub trace_thing {
155 my( $index, $value, $op, $e, $t ) = @_;
157 return unless $value;
159 $t->delete( qw/ 1.0 end / );
161 foreach my $w ( @words ) {
162 if ( $w =~ /^$value/ ) {
163 $t->insert( 'end', "$w\n" );
164 }
165 }
166 return $value;
168 } # end trace_thing
170 sub ins {
172 my( $e, $t, $K ) = @_;
174 my( $index ) = $K =~ /^F(\d+)$/;
176 $e->delete( 0, 'end' );
178 $e->insert( 'end', $t->get( "$index.0", "$index.0 lineend" ) );
179 $t->delete( qw/ 1.0 end / );
180 } # end ins
182
184 Stephen.O.Lidie@Lehigh.EDU, Lehigh University Computing Center, 2000/08/01
185 . Version 1.0, for Tk800.022.
186 sol0@Lehigh.EDU, Lehigh University Computing Center, 2003/09/22
188 . Version 1.1, for Tk804.025, add support for multiple traces of the same
189 type on the same variable.
190
192 Copyright (C) 2000 - 2003 Stephen O. Lidie. All rights reserved.
193 This program is free software; you can redistribute it and/or modify it
195 under the same terms as Perl itself.
196Tk804.036 2021-07-23 Tk::Trace(3)