1Tk::Trace(3)                 perl/Tk Documentation                Tk::Trace(3)
2
3
4

NAME

6       Tk::Trace - emulate Tcl/Tk trace functions.
7

SYNOPSIS

9        use Tk::Trace
10
11        $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

DESCRIPTION

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
21       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
26       User callbacks are passed these arguments:
27
28        $_[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
33       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
37        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
44       Note that the callback's return value becomes the variable's final
45       value, for either read or write traces.
46
47       For write operations, the variable is updated with its new value before
48       the callback is invoked.
49
50       Multiple read, write and undef callbacks can be attached to a variable,
51       which are invoked in reverse order of creation.
52

METHODS

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
61       %vinfo = $mw->traceVinfo(varRef);
62           Returns a hash detailing the internals of the Trace object, with
63           these keys:
64
65            %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
76           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
81       $mw->traceVdelete(\$v);
82           Stop tracing the variable.
83

EXAMPLES

85        # Trace a Scale's variable and move a meter in unison.
86
87        use Tk;
88        use Tk::widgets qw/Trace/;
89
90        $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
97        $mw->traceVariable( \$v, 'w' => [ \&update_meter, $s ] );
98
99        $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
106        MainLoop;
107
108        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
120        # Predictive text entry.
121
122        use Tk;
123        use Tk::widgets qw/ LabEntry Trace /;
124        use strict;
125
126        my @words =  qw/radio television telephone turntable microphone/;
127
128        my $mw = MainWindow->new;
129
130        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
137        $t->pack( $e, qw/ -side top / );
138
139        $e->focus;
140        $e->traceVariable( \$thing, 'w', [ \&trace_thing, $e, $t ] );
141
142        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
152        MainLoop;
153
154        sub trace_thing {
155
156            my( $index, $value, $op, $e, $t ) = @_;
157
158            return unless $value;
159
160            $t->delete( qw/ 1.0 end / );
161            foreach my $w ( @words ) {
162                if ( $w =~ /^$value/ ) {
163                    $t->insert( 'end', "$w\n" );
164                }
165            }
166
167            return $value;
168
169        } # end trace_thing
170
171        sub ins {
172
173            my( $e, $t, $K ) = @_;
174
175            my( $index ) = $K =~ /^F(\d+)$/;
176
177            $e->delete( 0, 'end' );
178            $e->insert( 'end', $t->get( "$index.0", "$index.0 lineend" ) );
179            $t->delete( qw/ 1.0 end / );
180
181        } # end ins
182

HISTORY

184        Stephen.O.Lidie@Lehigh.EDU, Lehigh University Computing Center, 2000/08/01
185        . Version 1.0, for Tk800.022.
186
187        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
194       This program is free software; you can redistribute it and/or modify it
195       under the same terms as Perl itself.
196
197
198
199Tk804.036                         2022-07-22                      Tk::Trace(3)
Impressum