The Perl Journal September 2003
One of the most useful Perl modules available on CPAN is Nick Ing-Simmons's Tk.pm. Also known as Perl/Tk, this is a port of Tcl/Tk with a Perl object-oriented front-end API. It is used to create graphical user interfaces, and contains a wide variety of widgets that should be sufficient to build the most sophisticated and professional looking GUIs.
Yet, there are times when you would like to add an extra touch to your application to make it stand out among the crowd. While a great number of user-contributed "mega-widgets" exist as modules on CPAN, almost all of them are built by combining native widgets together. While very convenient, this does not add visual uniqueness to an application. Of course, you can always interface directly with the underlying graphic display library via writing a C extension. In fact, a number of such modules exist, but the obvious limitations are the need to understand the low-level Tk API (which requires quite a bit of C experience, due to the API's extensive use of pointers and structures), and the need for users to compile the module before installation.
In this article, I will discuss a way to create visually unique-looking Tk widgets in pure Perl by using the Canvas widget. I do not claim ownership of this idea. In fact, it was suggested to me in an e-mail exchange on the pTk mailing list by Slaven Rezic. Also, I know of at least one Tk module, Tk::ProgressBar, that uses this technique, and that comes standard with the Perl/Tk distribution.
The Canvas widget is the most powerful and most versatile of all Tk widgets. In addition to being able to draw primitives like lines, ovals, arcs, polygons, and text, the Canvas can contain embedded images and even other Tk widgets. It also has built-in mechanisms to handle grouping, overlap detection, z-ordering, translation, and scaling. This makes it a powerful tool for the creation of custom-looking widgets. Graham Barr used a Canvas to create his Tk::ProgressBar widget, which graphically shows the current value of a certain variable as it advances from a specified minimum to a specified maximum.
One unfortunate property of the Canvas widget is that, due to the inherent window-management mechanism, embedded widgets always obscure other primitives irrespective of the z-order. While this doesn't pose any problems for most applications, it would be nice if embedded widgets could respect their z-order. Being able to draw on Button and Entry widgets would definitely constitute a deviation from the traditional ways of GUI building, but would open up new pathways for people with fertile imagination.
Upon pointing this out to the Perl/Tk mailing list, Slaven Rezic suggested not using embedded Tk widgets at all, but rather using the Canvas primitives to "draw" the widgets to be embedded. This gave me the idea to create Tk::FunkyButton (which is a Perl/Tk widget written in pure Perl and based on the Canvas widget) that defines various nonstandard looking buttons, such as circular and cross shaped. Moreover, we can create special-effects buttons that are not just static. Tk::FunkyButton includes two such buttons: a vanishing button, in which the text slowly and repeatedly vanishes and reappears, and a rotating button, in which the text loops around the button (see Figure 1).
The first step in creating a Perl/Tk mega widget is to define its base widgets and call the Construct() method. I will quickly outline the steps to a mega-widget creation. More detailed information can be found in Mastering Perl/Tk by Walsh & Lidie (O'Reilly & Associates, ISBN 1-56592-716-8).
package Tk::FunkyButton; use strict; use Carp; use vars qw/$VERSION/; $VERSION = 0.1; use Tk::widgets qw/Canvas/; use base qw/Tk::Derived Tk::Canvas/; Construct Tk::Widget 'FunkyButton'; 1;
Because this widget is derived from a Canvas, we use Tk::Derived and Tk::Canvas as base objects. The Construct() method is defined in Tk/Widget.pm, and defines a method in the Tk namespace with the name FunkyButton. This lets us create instances of our FunkyButtons like so:
$parent->FunkyButton($args);
The lonely "1;" is there to satisfy Perl's requirement that all modules return a true value. Now, we define a lexical hash that maps the possible shapes our FunkyButtons can have to the respective subroutines that will do the actual drawing:
use vars qw/%shapeToFunc/;
%shapeToFunc = (
cross => \&_drawCross,
circle => \&_drawCircle,
rotary => \&_drawRotary,
vanishing => \&_drawVanishing,
);
Next is to define the ClassInit() method:
sub ClassInit {
my $class = shift;
$class->SUPER::ClassInit(@_);
}
This method gets called only once before the first FunkyButton instance is created. All it does in this case is to call the ClassInit() method defined somewhere in the class hierarchy of our widget, but we can use it to make class-wide adjustments. Since we don't do anything but call SUPER::ClassInit(), we can omit this method, and Perl's inheritance mechanism will take care of that for us.
When a new FunkyButton widget is to be created, the Populate() method gets called. This is the main place where your widget springs into existence, and this is where we will inspect the arguments to FunkyButton and call the proper function to draw it. It starts like this:
sub Populate {
my ($self, $args) = @_;
my $shape = delete $args->{-shape} || 'cross';
unless (exists $shapeToFunc{$shape}) {
croak "-shape must be one of: ", join(", ", keys %shapeToFunc)," ..";
return undef;
}
my $text = delete $args->{-text} || '';
my $cmd = delete $args->{-command} || sub {};
my $relf = delete $args->{-relief} || 'raised';
my $bw = delete $args->{-borderwidth} || 2;
my $bg;
if (exists $args->{-bg}) {
$bg = delete $args->{-bg};
} elsif (exists $args->{-background}) {
$bg = delete $args->{-background};
} else {
$bg = Tk::NORMAL_BG;
}
# now specify canvas-specific options.
$args->{-background} = $self->parent->cget('-background');
$args->{-borderwidth} = 0;
$args->{-relief} = 'flat';
$self->SUPER::Populate($args);
The two arguments of Populate are a reference to the created widget, and a reference to the arguments hash that the user passed. Since FunkyButton is based on a Canvas, our reference is a reference to a Canvas widget that has been blessed into our Tk::FunkyButton package. The first thing to do is to extract the information needed from the arguments. As a rule of thumb, try to give default values to each argument and croak() if the user supplies something you don't understand. Once all the info is extracted, we call the Populate() method that is defined in the superclass of our widget; in this case, the Populate() of Tk::Canvas will be called. This is necessary to make sure that all the features of Tk::Canvas get defined for us. Be sure to pass the arguments hash reference, after some editing perhaps, to SUPER::Populate().
The next bit of code uses the shape option specified by the user to call the correct function to draw the button with the specified options:
$self->{MY_BUTTON} = $shapeToFunc{$shape}->($self, $text, $relf, $cmd,
$bw, $bg, $spd);
The rest of the Populate() method deals with informing the window manager with our FunkyButton's desired dimensions and with setting up the bindings for our button so that it responds to mouse events. I will not show this code here—it can be found in Tk::FunkyButton.pm and should be straightforward.
The %shapeToFunc hash maps the type of button to be drawn to the actual subroutine that draws the button. Currently, there are four types of buttons available: cross-shaped, circular, rotary, and vanishing. All of the subroutines that draw these buttons have the same general steps:
1. Compute the size of the button. This is simply done by drawing the text of the button at (0, 0) and then using the Canvas::bbox() method to determine its bounding box. This area is multiplied by a factor, which was determined by trial and error, to get the final size of the button.
2. Draw the outline of the button. To help draw the 3D outline of the button, I defined two subroutines: _draw3DHorizontalBevel and _draw3DVerticalBevel. Those subroutines are based on Tk's actual C code that draws the buttons (and are even named similarly), and are used to draw a single horizontal or vertical 3D edge. The arguments to these subroutines are the starting (x, y) location of the edge to be drawn, the edge's width and height, its relief, whether the edge is "in the shadow," the miter setting, and any tags that we want to give to that edge. In a normal button, the top and left edges are almost white in color while the right and bottom edges are dark grey. This gives the illusion of a 3D button with some sort of illumination coming from the top left. The shadow option specifies what kind of edge we're drawing, and hence its color. The color is also determined by the relief of the button. The miter setting defines the corner where a light and a dark edge meet is drawn. In case of the cross-shaped button, for example, we have to draw 12 edges, six of which are "in the light" and six "in the shadow."
3. Draw the background of the button. Step 3 draws the background of the button with the color specified by the user (or the default system color if nothing is specified). The background is used to respond to the mouse events.
4. Center the text. Now that the button is drawn, all we have to do is move the text that we drew in step 1 to the center of the button.
I will not include the code for the _draw* methods here, but the code should be self explanatory, especially with the aforementioned four steps in mind. Note that at this point, Tk::FunkyButton does not support images, but this can very easily be incorporated into the module.
The cross-shaped and circular buttons are the result of the four steps defined earlier. But the vanishing and rotating buttons deserve a closer look since they involve some special effects.
As stated earlier, the text for this button vanishes slowly and reappears repeatedly, as if pulsating. The speed of this pulse can be specified using the -speed option, which can take a value of fast, normal (the default), or slow. This value is used to look up a corresponding time delay (100 ms for fast, 500 ms for normal, and 1000 ms for slow).
The subroutine to draw a vanishing button first follows the mentioned four steps to draw a regular-looking button with the text centered. In order to achieve the pulsating effect, all we have to do at each time step is to make the text fade a little bit more. Once the text disappears completely, we have to make it reappear slowly. This can be achieved by using stipples. A stipple is a bitmap that is used as a pattern when drawing an object. It acts like a mask to hide certain parts of the object. All we have to do to achieve our fading effect is to define a suitable number of stipples that progressively show less and less of the object. Luckily, Perl/Tk comes with a few bitmaps that prove sufficient for our purposes. Those are:
my @stipples = ('', qw/gray75 gray50 gray25 transparent/);
Now, we use Tk's repeat() mechanism to run a callback at even intervals:
my $i = 0;
my $inc = 1;
$self->repeat($delay => sub {
$i += $inc;
$inc = -1 if $i == $#stipples;
$inc = 1 if $i == 0;
$self->itemconfigure(TEXT => -stipple => $stipples[$i]);
});
Initially, we draw the text without a stipple. Then, at each time step, we advance through the @stipples array to get the next stipple and use that to draw the text. We have to make sure that once we reach the end of the array, we start going in reverse order. This is done via the $i and $inc variables, which keep track of where we are in the array, and in what direction we're moving, respectively.
The text of the rotary button simply scrolls around the button repeatedly. Again, the speed of this rotation is controlled via the -speed option. To achieve the desired effect, we use the Canvas::move() method to translate the text horizontally to the left. Once the text disappears completely, we simply move it such that its left-most point coincides with the button's right edge and continue with the translation. The code is again very simple:
my @orig = $self->coords('TEXT');
$self->repeat($delay => sub {
$self->move(TEXT => -3, 0);
my @box = $self->bbox('TEXT');
if ($box[2] < 0) {
$self->coords(TEXT => $w + 0.5 * ($box[2] - $box[0]),
$orig[1]);
}
});
Here, we used the fact that our text is tagged with the TEXT string so that we can identify it. To check if the text has completely scrolled off to the left of the button, all we have to do is see whether the right-most x-coordinate ($box[2]) of the text is positive or not. If not, we move it just past the right edge of the button.
You can grab a copy of Tk::FunkyButton from your local CPAN mirror at http://search.cpan.org/author/aqumsieh/. The latest version as of the date of writing of this article is 0.01. You can install it using the traditional method:
perl Makefile.PL make make test make install
Alternatively, since it's all in pure Perl, you can unpack it in any place where Perl will find it.
Tk's Canvas widget is a very powerful widget that can be used to create nontraditional looking widgets. The built-in drawing primitives of Tk::Canvas, along with its support for querying, moving, and modifying those primitives make it an ideal canvas (pun intended) for creating unique-looking and dynamic widgets. There is much more potential to be exploited. Any questions regarding the Tk::FunkyButton and/or suggestions to improve it are very welcome.
TPJ