Hopefully you read my last column which discussed Perl/Tk fundamentals, and you're now at least a seasoned Tk novice. Assuming so, let's move right along and examine the Perl/Tk implementation of The Mouse Odometer, named modo.
modo has got to be one of the most pointless programs ever written, but hey, it illustrates numerous Perl/Tk features so it does have some value. I first saw similar code for the MacIntosh, written by Sean P. Nolan, that simply tracked a machine's cursor. Currently I have logged well over 51 kilometers on my cursor, while my mouse has careened around its pad some 14 kilometers. modo as described here runs with Perl 5.002 and Tk-b11, available from a friendly CPAN site near you.
Most of this column is not about modo and how it works, but rather the Perl/Tk features it uses. This time we'll learn how to schedule asynchronous timer events, look more closely at window manager commands, menus, menubuttons and the ColorEditor, and create and explain in detail an object oriented Perl/Tk composite widget, the Odometer. Like a car's odometer, we want our mouse odometer to record the physical distance traveled by the mouse, not the number of pixels. In a car, you want to know how many miles you've traveled, not the number of tire-lengths; after all, those vary from car to car. In the X window system you can use the xdpyinfo command to find out the number of millimeters-per-pixel of your display, and that, multiplied by a pixel count, gives the distance in millimeters. Unfortunately, pixels aren't always square, so there are actually two numbers to worry about: millimeters_x/pixels_x and millimeters_y/pixels_y. Once we know those numbers, we can figure out the distance D given the number of pixels traversed in the X and Y directions, which we'll call dX and dY:
D = sqrt((dX * (mmX/pixelsX)) ** 2 +
(dY * (mmY/pixelsY)) ** 2);
How can we figure out dX and dY? Well, Tk provides the command pointerxy(), which returns a two-element list: the cursor's absolute X and Y coordinates. (In deference to Einstein, who taught us that nothing is absolute, we'll say "relative to the root window of your display.") So if we call pointerxy() twice, we can subtract the results, yielding our dX and dY. Then we can just apply the above formula. (Which is thankfully just the Pythagorean Theorem, since we're dealing with a non-curved two-space. Otherwise we might need Albert's ten-dimensional tensors!)
The major components are a row of menubuttons (often called a menubar), two sets of odometers (one for the cursor and one for the pointer), and a status line showing the distance units and cursor coordinates. Here is modo's main loop, with a tiny amount of code dealing with pointing device distance removed for clarity:
sub modo {
# Track the cursor forever, periodically updating the
# odometer file.
my($x, $y) = $MW->pointerxy;
$W_MISC_TEXT = sprintf("U=%-3s (%4d,%4d)",
$modo_UNITS_HUMAN, $x, $y);
my($dx, $dy) = (abs($x - $LAST_X), abs($y - $LAST_Y));
($LAST_X, $LAST_Y) = ($x, $y);
my($dxmm,$dymm) = ($dx*$MM_PIXEL_X, $dy*$MM_PIXEL_Y);
my $d = sqrt( ($dxmm * $dxmm) +
($dymm * $dymm) );
$W_CODO->add($d,$modo_UNITS) if $d > 0;
if ($AUTOSAVE_COUNT-- <= 0) {
$AUTOSAVE_COUNT = $AUTOSAVE_TICKS;
eval {save_modo};
}
$MW->after($MILLISECOND_DELAY, \&modo);
}
Upon startup, modo() is called once, and exactly once. The subroutine performs several tasks:
There are many aspects to designing and writing a robust application, and one of them is to give the user adequate real-time feedback so they know things are "working". Since modo takes some time to startup, we'll open a new toplevel window that displays its current initialization state, along these lines:
$QUIT_COMMAND = sub {save_modo; exit};
$MW = MainWindow->new($OPT{'display'});
$MW->withdraw;
$MW->title($OPT{'title'});
$MW->iconname('modo');
$MW->iconbitmap("\@$LIBDIR/icon.xbm");
$MW->minsize(50, 50);
$MW->protocol('WM_DELETE_WINDOW' => $QUIT_COMMAND);
unless ($OPT{'iconic'}) {
# Realize a transient toplevel to display modo's
# initialization status.
$STATUS = $MW->Toplevel;
$STATUS->positionfrom('user');
$STATUS->geometry('+100+100');
$STATUS->title('Initializing modo');
$STATUS_B = $STATUS->Label(-bitmap =>
"\@$LIBDIR/icon.xbm")->pack;
$STATUS_L = $STATUS->Label( -text => 'Main Window ...',
-width => 25, )->pack;
$MW->idletasks;
}
update_status 'Global Stuff';
Hmm, what is that dangling anonymous subroutine doing there at the top? Well, it simply defines what needs to be done when terminating modo. There are at least two ways to exit: either by selecting Quit or by having the window manager close the main window, so it makes sense to define a subroutine. Thus, $QUIT_COMMAND is initialized with a code reference which can then be used whenever necessary.
As always, we first open the main window on some display - the new() method accepts an optional parameter specifying the particular display desired. (Be aware that modo uses a special hash, named %OPT, indexed by argument name, that holds argument values, either default or extracted from the command line.) Next there is a series of main window method calls known as window manager commands, because they are used to interact with the window manager.
We withdraw() the main window to unmap it from the display so only the (soon to be created) status window is visible. The title() method draws text at the top of the decorative border provided by the window manager, and the two "icon" methods obviously specify a name and X bitmap for the application's icon. minsize() restricts the user from resizing the window smaller than 50 pixels in either dimension (there is also a related maxsize() method). Finally, note the idiom for registering a callback with the window manger to terminate an application: simply associate a standard Perl/Tk callback with the WM_DELETE_WINDOW protocol.
Assuming the user didn't fire up modo iconified, we next create the toplevel status widget. The methods positionfrom() and geometry() are suggestions to the window manager on where to place the new toplevel. Some window managers, fvwm for instance, normally require you to explicitly place toplevel windows; positionfrom('user') overrides this behavior. Finally two label widgets are packed in the toplevel, the first containing modo's X bitmap and the second containing the current initialization state. Since the X server tries to buffer events to improve performance, idletasks() is used to flush idle callbacks and hence keep the display responsive. (We'll see more of event management in the next column.) Here's a snapshot of the status window:
Lastly note the first call to subroutine update_status(), which simply uses configure to change the text in the status window via $STATUS_L; there are numerous calls to this subroutine sprinkled throughout modo's initialization code. Doing this keeps users happy.
Another key aspect in user-friendly GUI design is providing a reasonably consistent "look and feel." Whether an application is written for X, Windows, or the Mac, you find, and indeed expect, a row of menubuttons (the menubar) at the top of the program's main window. And the leftmost button is a File menubutton which at least allows you to exit the application. So to be conformant, modo too has a File menubutton, which we'll examine now.
A menubutton is a subclass of a button, meaning that it shares, or inherits, many of a button's characteristics. The big difference is that pushing a button executes a callback whereas pushing a menubutton posts a menu. A menu is simply a rectangular widget that contains one or more menu items that when pressed, might execute a callback, set a Perl variable, or invoke yet another menu (called cascading). Pressing the File menubutton posts this menu:
The File menu itself is composed of simple button-like objects bound to callbacks. More precisely, we call these command menu items because they execute a command (callback) when pressed. Other types of menu items include cascade, checkbutton, radiobutton and separator.
The File menu has three thin lines: separator menu items, whose sole purpose is to visually separate logically distinct portions of the menu.
The File menu also has a tear-off, which is the dashed line above Abort. Pressing a tear-off reparents the menu and puts it under control of the window manager. Thus, it gets its own decorative border, can be moved, iconifed, closed, and so on. By default all Perl/Tk menus have a tear-off.
Here are some other facts you need to know about menus:
In case that was all as clear as mud, maybe some code will clarify matters. Let's create the application's menubar using a frame,$mb, and pack our menubuttons in a row, from left to right:
# File menu.
my $mbf=$mb->Menubutton(-text => 'File',-underline => 0... );
$mbf->pack(qw(-side left));
$mbf->command(-label => 'Abort', -underline => 0,
-command => \&exit);
$mbf->separator;
my $close_command = [$MW => 'iconify'];
$mbf->command(-label => 'Close', -underline => 0,
-command => $close_command,
-accelerator => 'Ctrl-w');
$MW->bind('<Control-Key-w>' => $close_command);
When Perl/Tk finishes building the Abort menu item we know that a menu widget has been generated with a tear-off (index 0) and one command menu item (index 1, name "Abort"). (An often asked question is: "How do I make a menu without a tear-off?" The answer is you must explicitly create a menu with -tearoff => 0, configure() the menubutton with -menu => $your_menu, and then proceed normally.)
The Close menu item (index 2, name "Close") has an associated keyboard accelerator. However, this just adds more text to the menu item label; you still have to create the key binding. Since the close code is needed in two places, just create a code reference and use that.
Another common menu item is the cascade, illustrated below:
Pressing the Prefs menubutton from the menubar displays the leftmost menu, containing a cascade and command menu item. Pressing the Odometers cascade displays the cascade's menu, containing three radiobutton menu items. (Of course, the cascade menu could contain another cascade, which could have another cascade, which ..., well, you get the picture.) Cascades are handled pretty much like menus without a tear-off, in that you create a menu widget manually and then configure() the cascade to point to it, like this:
# Prefs menu.
my $mbp = $mb->Menubutton(-text => 'Prefs', ... );
$mbp->pack(qw(-side left));
my $odometers = 'Odometers';
$mbp->cascade(-label => $odometers, -underline => 0);
$mbp->separator;
$mbp->command(-label => 'Color Editor', -underline => 0,
-state => $COLOR_STATE, ...);
So far, only -state might be unfamiliar. Many widgets have this option, which can have one of three possible values: normal, active or disabled. Widgets start in the normal state, and when the cursor passes over them they become active. If you place a widget in the disabled state, it is dimmed and becomes unresponsive to button presses and other bindings. We'll see how $COLOR_STATE is initialized shortly.
my $mbpm = $mbp->cget(-menu);
my $mbpmo = $mbpm->Menu;
$mbp->entryconfigure($odometers, -menu => $mbpmo);
$mbpmo->radiobutton(-label => 'Cursor',
-variable => \$OPT{'odometer'},
-value => 'cursor');
$mbpmo->radiobutton(-label => 'Pointer',
-variable => \$OPT{'odometer'},
-value => 'pointer');
$mbpmo->radiobutton(-label => 'Both',
-variable => \$OPT{'odometer'},
-value => 'both');
Pay attention please: the Odometers cascade menu must be a child of the menu containing the Odometer cascade itself (here, the Prefs menu), hence the cget() call to fetch the menu reference. Note that entryconfigure() is to menus as configure() is to other widgets, except you need to tell it which menu entry needs attention (which is analogous to itemconfigure() for canvas items). Notice also that the menu entry is referenced by name rather than index.
Finally, three radiobutton menu items are added to the cascade menu. Just like ordinary radiobutton widgets, they allow you to select a single item from a list, and store its value in a variable. The actual value stored in the common variable depends on which radiobutton was pressed. (These widgets got their name because using them is similar to tuning an old fashioned car radio: selecting a station by pushing one button deselects all the other buttons by popping them out.)
If you'd like to see a complicated cascade created from a Perl list-of-list-of-list data structure, take a gander at the modo source code responsible for generating the Units cascades; that'll fry your eyes.
Speaking of eyes, they come in various colors. Speaking of colors, let's add some, and incorporate ColorEditor into the application. ColorEditor lets you select a color attribute, say foreground, edit a color swatch and then apply the final color by calling a special ColorEditor subroutine (the colorizer) which descends through the application's widgets and configures each in turn.
A ColorEditor widget is created in the standard manner:
$COLOR_STATE = $MW->depth > 1 ? 'normal' : 'disabled';
if ($COLOR_STATE eq 'normal') {
$CREF = $MW->ColorEditor(-title => 'modo');
}
But there's no need for one if your display can't support it, so first check the pixel depth of the display using the window information command depth(). For monochrome displays we don't even bother creating the ColorEditor, and the menu item to invoke it, which we just discussed, is dimmed.
Once the ColorEditor is created and initialized, you can use it like a Dialog - just invoke its Show() method. The most important thing to remember about the ColorEditor is that it maintains a list of widgets to colorize: every widget in the application present when the ColorEditor was created. Sometimes this is good, sometimes bad, and in modo's case it's bad. Bad because when $CREF is created some of the applicable widgets aren't there yet, and there are some that are present that shouldn't be colorized in the first place. Of course, there are methods to deal with this, so as the last step of initialization:
$CREF->configure(-widgets => [$MW, $MW->Descendants]);
$CREF->delete_widgets(
[$CREF, # ColorEditor...
$CREF->Descendants, # and all its descendant widgets
$W_CODO->Descendants, # Odometer descendants because
$W_PODO->Descendants, # the class handles configuration
]); # changes
The first line ensures that the main window, $MW, and all of its descendants in the widget hierarchy are part of the color list. The second line then removes particular widgets that should not be colorized. As a rule of thumb, leave the ColorEditor alone in case you really mess things up, like setting the foreground and background to the same color! And the two composite odometers are excluded for the simple reason that the foreground and background colors of digits to the right of the "units" point are reversed, just like real odometers. How we deal with this is somewhat subtle, as you'll see in the next section.
And at last it's time to discuss Perl/Tk composites featuring, of course, the odometer widget. The OO tables have turned and now you become an implementer rather than a mere user! An odometer widget "ISA" frame, that is, it's a subclass of a frame widget: odometer objects are simply "mega-widgets" composed of standard Tk widgets packed inside a frame (we'll see what "ISA" is all about shortly). There are other kinds of extended widgets: a dialog widget ISA a toplevel, while an axis widget is derived from, or "kind of", a canvas. A common attribute of all these extended widgets is that they behave just like standard Tk widgets, basically because Nick took great pains to ensure they do!
Since an odometer is contained in a frame you can create an instance and pack it inside your application just like, say, a button. Let's create a default odometer, add one millimeter to it, and see what we have:
$MW->Odometer->add(1, 1)->pack;
(Notice how methods such as add() and pack() can be strung together, as long as they return an object reference for the next method to operate on.) The odometer is composed of six widgets: the odometer label, left and right labels indicating total distance, a trip reset button, and left and right labels indicating trip distance. Two labels are used for total and trip distances so that foreground and background colors can be reversed on either side of the "units" point. When modo creates its odometers it supplies some arguments in the Perl/Tk "key => value" style, including -odometerlabel, a keyword unique to class Odometer:
$W_CODO = $w->Odometer(
-odometerlabel => 'Cursor',
-font => $OPT{'fontname'},
-foreground => $OPT{'foreground'},
-background => $OPT{'background'},
-cursor => $CURSOR
);
In order to see the primary features of a frame-like composite I need to gut Odometer.pm, which later I'll reconstruct piece by piece:
package Tk::Odometer;
require 5.002;
use English;
use Tk::Frame;
@Tk::Odometer::ISA = qw(Tk::Frame);
Tk::Widget->Construct('Odometer');
sub Populate {
my($cw, $args) = @ARG;
$cw->SUPER::Populate($args);
# Create and pack frame subwidgets here.
$cw->ConfigSpecs( ... );
return $cw;
} # end Populate, Odometer constructor
1;
What we have here is the definition of a new Perl/Tk widget class named "Tk::Odometer", having these salient features:
Tk::Odometer::Populate() is called with two arguments. $cw is a reference to the partially completed composite widget and $args is a reference to the argument hash (i.e. the keyword/value pairs from the widget creation command). By convention $args is immediately passed to SUPER::Populate(), where, sometimes, behind-the-scenes bookkeeping like modifying configuration specifications is performed.
Now, in standard Perl/Tk fashion, we create and arrange the component widgets of the composite, using $cw as their parent (the list @PACK holds common pack attributes):
# Odometer label.
my $l = $cw->Label->pack(@PACK);
# Odometer total distance, left and right labels.
$cw->make_odo('total')->pack(@PACK);
# Odometer trip reset button. It's placed inside a container
# frame so there is a background to color, since trying to
# configure the composite containing frame results in nasty
# recursion problems. The button is anchored southwest so it
# stays "attached to" the trip odometer.
my $rbf = $cw->Frame(-relief => 'flat')->pack(@PACK);
my $rb = $rbf->Button(
-height => 2,
-width => 5,
-bitmap => 'gray50',
-relief => 'flat',
-command => [$cw => 'reset_trip'],
-highlightthickness => 0
)->pack(-anchor => 'sw', -expand => 1);
# Odometer trip distance, left and right labels.
$cw->make_odo('trip')->pack(@PACK);
# Maintain instance variables in the composite widget hash.
# Instance variables hold data particular to one instance of
# an Odometer object.
#
# reset = widget reference to trip reset button for bind()
# total_mm = total distance in millimeters
# total_left = total distance left label for add()
# total_right = total distance right label for add()
# total_right_label = widget reference for colorizing
# (ditto for trip_mm, trip_left, trip_right, and
# trip_right label.)
$cw->{'reset'} = $rb;
$cw->{'total_mm'} = 0;
($cw->{'total_left'}, $cw->{'total_right'}) = ($Z, $Z);
$cw->reset_trip;
Once again there are several items worthy of note:
I hinted at this, but one job Populate() should not do, generally, is directly configure() its components; instead it makes a call to onfigSpecs() to specify configuration options and default values. Then, when Populate() returns, Perl/Tk auto-configures the composite, supplying ConfigSpec values or perhaps values from the X options database:
# Now establish configuration specs
# so that the composite behaves like a
# standard Perl/Tk widget. Each
# entry is a list of 4 items describing the
# option: how to process a configure
# request, its name in the resource
# database, its class name, and its default
# value.
#
# The Tk::Configure->new() specification renames
# -odometerlabel to -text, which is what Labels want,
# because -odometerlabel IS a Label.
#
# The DESCENDANTS specification applies configure()
# recursively to all descendant widgets.
#
# The METHOD specification invokes a method by the same name
# as the option (without the dash), e.g.:
#
# $cw->background($bg);
#
# Normally you don't need configurators just for
# background and foreground attributes, but an Odometer is
# special since the colors are reversed for the right half
# of the odometers.
#
# The -cursor specification says to configure only the
# indicated list of widgets (in this case there is but one,
# $rb, the trip reset button.)
$cw->ConfigSpecs(
-odometerlabel => [[Tk::Configure->new($l => '-text')],
'odometerlabel','odometerLabel','Odometer'],
-font => ['DESCENDANTS','font','Font','fixed'],
-background => ['METHOD','background','Background','#d9d9d9'],
-foreground => ['METHOD','foreground','Foreground','black'],
-cursor => [[$rb],'cursor','Cursor',['left_ptr']]
);
return $cw;
There's still more work left, however. So far, we've created a class constructor, but no methods to manipulate the objects it creates. So let's look at a few, starting with the simplest, $W_CODO->get_total_distance(). modo uses this method to save its state information):
sub get_total_distance {shift->{'total_mm'}}
This method just returns the value from an odometer's total_mm instance variable. The shift idiom is a shortcut for Perl's builtin shift() function, returning the odometer reference. Here bind() is overridden by providing a version specific to our class:
sub bind {
# Override bind() to select trip reset button,
# the only sensible widget.
# Build an argument list to bind() so that the call
# behaves normally.
my($odo, $event, $code) = @ARG;
my @args = ();
push @args, $event if defined $event;
push @args, $code if defined $code;
$odo->{'reset'}->bind(@args);
return $odo;
}
Finally here is add(), which displays the millimeter count (modulus 100,000) in the user's units. The only thing new is the use of BackTrace(), the Perl/Tk way of including traceback information:
sub add {
my($odo, $d, $u) = @ARG;
$odo->BackTrace('Usage: $odo->add($distance, $units)') if @ARG != 3;
$odo->{'total_mm'} += $d;
$odo->{'trip_mm' } += $d;
my($n1, $f1, $n2, $f2, $s);
$n1 = $odo->{'total_mm'} * $u;
$f1 = $n1 - int($n1);
$n2 = $odo->{'trip_mm' } * $u;
$f2 = $n2 - int($n2);
$s = sprintf("%011.5f%011.5f", ($n1 % 100000) + $f1,
($n2 % 100000) + $f2);
$odo->{'total_left'} = substr($s, 0, 5);
$odo->{'total_right'} = substr($s, 6, 5);
$odo->{'trip_left'} = substr($s, 11, 5);
$odo->{'trip_right'} = substr($s, 17, 5);
return $odo;
}
The Odometer class has several private methods too. Unlike C++, in Perl a private method is only private because the class implementor doesn't document it. Be polite and only use documented public methods. Here, I need to show you three private methods to complete the ColorEditor discussion.
Now, Populate() used ConfigSpecs() for foreground and background configure() options. ConfigSpecs() is a method, so when either of these odometer attributes are configured, one of the following subroutines is called with two parameters: an odometer widget reference and a color value.
# Odometer background/foreground color subroutines.
sub background {
shift->bf(shift, '-foreground', '-background')
}
sub foreground {
shift->bf(shift, '-background', '-foreground')
}
These immediately call the following subroutine, bf(). Remembering that an odometer's component widgets have been removed from ColorEditor's color list, it's up to the class to colorize them. So bf() simply walks the composite widget hierarchy, configuring each component in turn, but flopping foreground for background (or vice-versa) upon encountering any right-side label:
sub bf { # Reverse background/foreground colors on
# right odometer labels.
my($odo, $color, $bf1, $bf2) = @ARG;
my $total_right = $odo->{'total_right_label'};
my $trip_right = $odo->{'trip_right_label'};
$odo->Walk(
sub { my($widget) = @ARG;
if ($widget == $total_right or
$widget == $trip_right) {
$widget->configure($bf1 => $color);
} else {
$widget->configure($bf2 => $color);
}
}
);
}
So, we're finished implementing, right? Wrong. Gee, all the code's there, it's tested and it works... what could be missing? How about user documentation! The Perl Way is to include a "pod" (plain old documentation) in your class module. Check out Odometer.pm for a barebones pod.
__END__