Tk::Trace(3pm)
NAME
Tk::Trace - emulate Tcl/Tk trace functions.
SYNOPSIS
use Tk::Trace
$mw->traceVariable(\$v, 'wru' => [\&update_meter, $scale]);
%vinfo = $mw->traceVinfo(\$v);
print "Trace info :\n ", join("\n ", @{$vinfo{-legible}}), "\n";
$mw->traceVdelete(\$v);
DESCRIPTION
This class module emulates the Tcl/Tk trace family of commands by
binding subroutines of your devising to Perl variables using simple
Tie::Watch features.
Callback format is patterned after the Perl/Tk scheme: supply either a
code reference, or, supply an array reference and pass the callback
code reference in the first element of the array, followed by callback
arguments.
- User callbacks are passed these arguments:
- $_[0] = undef for a scalar, index/key for array/hash
$_[1] = variable's current (read), new (write), final (undef) value $_[2] = operation (r, w, or u)
$_[3 .. $#_] = optional user callback arguments - As a Trace user, you have an important responsibility when writing your
callback, since you control the final value assigned to the variable.
A typical callback might look like:
sub callback {my($index, $value, $op, @args) = @_;
return if $op eq 'u';
# .... code which uses $value ...
return $value; # variable's final value- }
- Note that the callback's return value becomes the variable's final
value, for either read or write traces. - For write operations, the variable is updated with its new value before the callback is invoked.
- Multiple read, write and undef callbacks can be attached to a variable, which are invoked in reverse order of creation.
METHODS
- $mw->traceVariable(varRef, op => callback);
- varRef is a reference to the scalar, array or hash variable you
wish to trace. op is the trace operation, and can be any
combination of r for read, w for write, and u for undef. callback is a standard Perl/Tk callback, and is invoked, depending upon the value of op, whenever the variable is read, written, or destroyed. - %vinfo = $mw->traceVinfo(varRef);
- Returns a hash detailing the internals of the Trace object, with
these keys:
%vinfo = (-variable => varRef
-debug => '0'
-shadow => '1'
-value => 'HELLO SCALAR'
-destroy => callback
-fetch => callback
-store => callback
-legible => above data formatted as a list of string, for printing); - For array and hash Trace objects, the -value key is replaced with a
-ptr key which is a reference to the parallel array or hash.
Additionally, for an array or hash, there are key/value pairs for
all the variable specific callbacks. - $mw->traceVdelete(\$v);
- Stop tracing the variable.
EXAMPLES
# Trace a Scale's variable and move a meter in unison.
use Tk;
use Tk::widgets qw/Trace/;
$pi = 3.1415926;
$mw = MainWindow->new;
$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/ );
$s = $mw->Scale( qw/-orient h -from 0 -to 100 -variable/ => \$v )->grid;
$mw->Label( -text => 'Slide Me for 5 Seconds' )->grid;
$mw->traceVariable( \$v, 'w' => [ \&update_meter, $s ] );
- $mw->after( 5000 => sub {
- print "Untrace time ...\n";
%vinfo = $s->traceVinfo( \$v );
print "Watch info :\n ", join("\n ", @{$vinfo{-legible}}), "\n";
$c->traceVdelete( \$v ); - });
- MainLoop;
- sub update_meter {
- my( $index, $value, $op, @args ) = @_;
return if $op eq 'u';
$min = $s->cget( -from );
$max = $s->cget( -to );
$pos = $value / abs( $max - $min );
$x = 100.0 - 90.0 * ( cos( $pos * $pi ) );
$y = 100.0 - 90.0 * ( sin( $pos * $pi ) );
$c->coords( qw/meter 100 100/, $x, $y );
return $value; - }
- # Predictive text entry.
- use Tk;
use Tk::widgets qw/ LabEntry Trace /;
use strict; - my @words = qw/radio television telephone turntable microphone/;
- my $mw = MainWindow->new;
- my $e = $mw->LabEntry(
- qw/ -label Thing -width 40 /,
-labelPack => [ qw/ -side left / ],
-textvariable => \my $thing, - );
my $t = $mw->Text( qw/ -height 10 -width 50 / );; - $t->pack( $e, qw/ -side top / );
- $e->focus;
$e->traceVariable( \$thing, 'w', [ \&trace_thing, $e, $t ] ); - foreach my $k ( 1 .. 12 ) {
- $e->bind( "<F${k}>" => [ \&ins, $t, Ev('K') ] );
- }
$e->bind( '<Return>' => - sub {
print "$thing\n";
$_[0]->delete( 0, 'end' ); - }
- );
- MainLoop;
- sub trace_thing {
my( $index, $value, $op, $e, $t ) = @_;- return unless $value;
- $t->delete( qw/ 1.0 end / );
foreach my $w ( @words ) {if ( $w =~ /^$value/ ) {$t->insert( 'end', "$w\n" );} - }
- return $value;
- } # end trace_thing
- sub ins {
my( $e, $t, $K ) = @_;- my( $index ) = $K =~ /^F(\d+)$/;
- $e->delete( 0, 'end' );
$e->insert( 'end', $t->get( "$index.0", "$index.0 lineend" ) );
$t->delete( qw/ 1.0 end / ); - } # end ins
HISTORY
Stephen.O.Lidie@Lehigh.EDU, Lehigh University Computing Center, 2000/08/01
. Version 1.0, for Tk800.022.
- sol0@Lehigh.EDU, Lehigh University Computing Center, 2003/09/22
. Version 1.1, for Tk804.025, add support for multiple traces of the same - type on the same variable.
COPYRIGHT
Copyright (C) 2000 - 2003 Stephen O. Lidie. All rights reserved.
- This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.