Skip site navigation (1)Skip section navigation (2)

FreeBSD Manual Pages

  
 
  

home | help
Tk::Trace(3)		     perl/Tk Documentation		  Tk::Trace(3)

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.

Tk804.035			  2013-11-15			  Tk::Trace(3)

NAME | SYNOPSIS | DESCRIPTION | METHODS | EXAMPLES | HISTORY | COPYRIGHT

Want to link to this manual page? Use this URL:
<https://www.freebsd.org/cgi/man.cgi?query=Tk::Trace&sektion=3&manpath=FreeBSD+12.2-RELEASE+and+Ports>

home | help