Tracing Perl/Tk Variables

This is something of an oddball topic for this Anatomy lesson, but it introduces background information we'll use later. Plus, it lets us do some neat things.

The Perl way to trace (or set watchpoints upon) a variable is by using the built-in tie function or the CPAN module Tie::Watch. Tcl has three commands associated with variable tracing: trace variable, trace vdelete, and trace vinfo. We'll examine sample code that uses three similar Perl subroutines, then briefly illustrate how our new Trace module is implemented.

First we need to define three new commands, the analogs of the Tcl/Tk Trace commands. They are traceVariable (start tracing a variable), traceVinfo (show trace information), and traceVdelete (stop tracing a variable). Using these commands, we can write a program that animates an analog dial via a Scale widget (see Figure 15-5).

Figure 15-5. Animating a meter

The dial is actually a fat Canvas line item with an arrow on one end. The Scale goes from 0 to 100, with the dial pointing straight up when it reads 50. The Scale's value is updated in the variable $v.

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/ => \my $v)->grid; $mw->Label(-text => 'Slide Me for > 5 Seconds')->grid;

The idea is to define a callback that's invoked whenever the Scale's variable $v changes value. The callback then redraws the dial appropriately. traceVariable expects three arguments: a reference to the traced variable; a letter from the set rwu that selects read, write, or undef (destroy) operations; and a standard Perl/Tk callback.

Here we call update_meter whenever $v is written.

$mw->traceVariable(\$v, 'w' => [\&update_meter, $c, $s]);

This code demonstrates the other Trace commands. After five seconds, we display trace information, then delete the trace. Once the trace is cleared, the dial stops moving. (This explains why the Scale's value does not correspond to the dial position in Figure 15-5.)

$mw->after(5000 => sub {
 print "Untrace time ...\n"; my %vinfo = $s->traceVinfo(\$v);
print "Watch info :\n ", join("\n ", @{$vinfo{-legible}}), "\n"; $c->traceVdelete(\$v);
}
); MainLoop;

Here's the output from traceVinfo. It shows the variable being traced, two internal flags, the variable's value, and the three callbacks associated with the u (undef), r (read), and w (write) operations. Trace supplies default callbacks for any that we don't provide.

Untrace time ... Watch info : variable : SCALAR(0x82a5178) debug : '0' shadow : '1' value : '56' destroy : ARRAY(0x82fd14c) fetch : ARRAY(0x82fd224) store : ARRAY(0x82fd110)

update_meter, as with any Trace callback, is invoked with three automatically provided 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

In our case, the fourth and fifth arguments are the Canvas and Scale widget references, respectively.

A Trace callback is responsible for returning the traced variable's new value, so you can choose to keep the proper value or change it. Our callback just needs to peek at the value to adjust the dial, so it keeps the value unchanged. The callback first checks the operation code and returns if the variable is being destroyed. Otherwise, it computes the dial's new position and redraws it.

sub update_meter {
 my($index, $value, $op, @args) = @_;
return if $op eq 'u'; my($c, $s) = @args[0,1]; # Canvas and Scale widgets my($min, $max) = ($s->cget(-from), $s->cget(-to)); my $pos = $value / abs($max - $min); 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;
}

The Trace module is not a mega-widget. It's a plain old Exporter module, and a tad complicated at that. For the complete listing, see Appendix C, "Complete Program Listings". Trace is a wrapper around Tie::Watch, giving us a super-simple interface, at the expense of some loss of functionality. Let's see what Tie::Watch gives us, since we'll be using it in the future.

Tie::Watch

Tie::Watch is an object-oriented interface to Perl's built-in tie function, which lets us define a variable's implementation. The implementation is carried out using subroutines of our own devising that are invoked as the variable is operated upon. For a Perl scalar, there are only three operations: fetch, store, and destroy. Here's how to watch a scalar:

$watch = Tie::Watch->new( -variable => \$v, -fetch => [\&fetch, 'arg1', 'arg2', ..., 'argn'], -store => \&store, -destroy => sub {print "Final value=$v.\n"}, }

The only required argument is -variable. We can provide behavior for any or all of the operations, or none at all. fetch and store callbacks look like this:

sub fetch{ my($self) = @_; $self->Fetch;
};
 sub store {
 my($self, $new_val) = @_; $self->Store($new_val);
};

These callbacks return the variable's new value by calling the underlying tie method. If you really want to confuse someone, make the traced variable read-only with this store callback:

sub store {
 my($self, $new_val) = @_; $self->Store($self->Fetch);
};

Tie::Watch can also watch arrays and hashes, but watching scalars is sufficient for our current needs.