Lesson 21

Heavy widgetry

This lesson will discuss the joys of using Tk to develop graphical user interfaces (GUI) in Perl. Tk was originally developed for the scripting language Tcl, but a perl port has been around for many years now, and comes with the ActiveState Windows port of perl. Using Tk is relatively easy, the canonical script being simply:

perl -MTk -e "$mw = MainWindow->new;
     $mw->Button( -text => 'Hello World', -command => sub{exit} )->pack; MainLoop"

However, I have found it very difficult to find documentation on the more esoteric aspects of Tk, and the memory-leaks that await the unwary. We will briefly look at the anatomy of a Tk script in the first part of this lesson, then throw ourselves into something meatier, and how to create composite widgets of your very own.

Before you go leaping into writing a GUI, it is very important to think about what your end product should do. Unlike a normal script, there is usually no clear linear thread of control in a GUI. In a normal script, perl essentially executes a list of commands: open file, read file, munge file, write file, exit. A GUI, on the other hand, will likely have a menubar with commands like Open, Close, Munge, Write and Exit. What should happen if the user selects 'Munge' before 'Open'? Should Munge be disabled until a file has been Opened? How will you keep track of whether your program has opened a valid file? These design decisions should be largely made before you go anywhere near a text editor.

Using Tk generally requires you to consider three things:

Enough waffle. How about a concrete example? First, the basic anatomy of a perl Tk script:

#!/usr/bin/perl
use strict;
use warnings;
use Tk;
# create window
my $mw = MainWindow->new( -title => "Basic Tk script" );
# create menubar
my $menu = $mw->Menu();
my $file_menu = $menu->cascade
    ( -label => 'File' );
$file_menu->command
    ( -label => 'Exit', -command => sub {exit} );
my $help_menu = $menu->cascade
    ( -label => 'Help' );
$help_menu->command
    ( -label => 'Help', -command => sub { print "you'll be lucky" } );
$mw->configure( -menu => $menu );
# create widgets
my $button = $mw->Button
    ( -text => "Press me", -command => \&press );
my $label = $mw->Label
    ( -text => "foo", -borderwidth => 2, -relief => "groove" );
# geometry management
$label->pack
    ( -padx => 10, -pady => 10, -ipadx => 10, -ipady => 10 );
$button->pack
    ( -pady => 10 );
# key bindings
$mw->bind
    ( "<Alt-F4>" => sub { exit } );
# event loop
MainLoop();
# create callbacks
sub press
{
    my $label_message = $label->cget( '-text' );
    print "Pressed while label was in state $label_message\n";
    $label->configure
        ( -text => $label_message eq "foo" ? "bar" : "foo" );
}

This script demonstrates the use of the eight main things you'll find in a Tk script: main windows, menubars, widgets, geometry management, bindings, callbacks, configures and event loops.

  1. The first thing to understand is the creation of a main window. In Tk, this is accomplished using the MainWindow->new() method. You'll notice that configurable options like the window title are conventionally passed to Tk methods with switch-style hashes ( -foo => bar ).
  2. Most windows want a menubar of some sort. This is created using the Menu method, which creates a widget object of class Menu. A widget is simply any 'bit' of a GUI: a button, menu, select-box, etc. Since we wish this menu to be a child element of our main window, we simply call Menu as a method of the MainWindow class: $mw-&gtMenu(). This may be at odds with what you have usually done to instantiate objects (calling new or similar), but this is how you group objects together in Tk, to allow them to be manipulated as one: for example, when the main window is destroyed it ensures all the child widgets inside it get destroyed too. After adding some cascading submenus, we add the menubar to the main window using the configure method (which we'll explain more in a minute).
  3. There are many Tk widgets. This script demonstrates the use of two others, the Button and the Label. All widgets have a generic set of attributes that can be set, such as -borderwidth and -relief, which modify how they are displayed. In addition, some widgets define configuration options that can be used to set widget-specific things like -width and -height, for Buttons and Labels. To see which widgets are available, consult perldoc Tk. The most commonly used ones are probably:
    • Button. Buttons.
    • Label. Simple text.
    • Entry. Like a web form input text field.
    • Text. Mini word processor.
    • Radiobutton. Radio buttons, as beloved of web forms.
    • Checkbutton. Checkboxes.
    • Frame. Simple boxes, just there to hold widgets in neatly delimited groups.
    • Toplevel. Subordinate main windows.
    • getOpenFile getSaveFile Dialog. Pop-up open, save and dialogue boxes.
    • Canvas. Generic drawing/graphing tool.
    • Photo. Images (be very careful using this one, it is prone to cause memory leaks if you don't know what you're doing, and often even if you do!).
    • Menu. Menubars.
    • Scale. Sliders.
    • Scrollbar. Scrollbars: many widgets also support the -scrollbars => "nw" configuration for adding scrollbars to the top (n) and right (w) of a widget.
  4. When we create child widgets they only exist in potentia until we add them to our window with a geometry manager. There are three of these in Tk: pack, grid and place. The first of these packs widgets into a parent widget in much the same was as a web browser packs things in the the absence of a stylesheet: things get put in approximately the place you expect, from left to right, and top to bottom as they wrap. The pad the widget with space, we can configure -padx (horizontal padding outside the widget), -ipady (vertical padding within the widget: for the button, this ensures the button is larger than the text inside), etc. grid allows you more precision over where things get put. Imagine the window as a grid, and: 
    $widget->grid( -column => 1, -row => 2, -columnspan => 2 );
    ensures the widget ends up in grid columns 2-4, grid row 3 (it's zero-based, like arrays). I mostly use grid for my geometry management; this is probably a hangover from using tables to arrange things in webpages.
  5. Keyboard bindings (and mouse bindings) allow you to bind certain key presses, and patterns of mouse clicks to events. Most windows users expect Alt-F4 to close the application, so this is exactly what we provide here. Creating these bindings is as simple as calling the bind method on the appropriate widget, with a sequence to bind and a callback (I'll explain what this is in a minute). The names of the bindings are mostly quite explanatory (perldoc Tk::bind if they are not): <Alt-F4>, <Control-P>, <Button-2> (right mouse button), <Double-Button-1> (double click left mouse button), etc. Bear in mind when creating keyboard binding that (at least under Windows), most users will expect the following key bindings not to violate the principle of least surprise...
    • Ctrl-C, X, V Copy, Cut, Paste
    • Ctrl-O, N, S, P Open, New, Save, Print
    • Ctrl-B, U, I Bold, Underline, Italic
    • Ctrl-A Select all
    • Ctrl-Z Undo
    • Ctrl-F Find
    • Ctrl-F4 Close
    • Alt-F4 Exit
    • Alt-F File menu
    • F1 Help
    • F2 Rename
    • F5 Refresh
    And bear in mind these are likely to be impossible to change
    • Windows-R Run
    • Alt-Space Alt-N Minimise
    • Alt-tab Switch windows
    • Ctrl-Alt-Delete Interrupt
  6. So far we have explored only the static bits of a GUI: the widgets, and their placement. However, the whole point of a GUI is that it responds when you press buttons, click on menus and press Alt-F4. The way we do this is to create callbacks. We have seen several examples of creating callbacks in the script above: 
    $mw->bind
    ( "<Alt-F4>" => sub { exit } );
$file_menu->command
    ( -label => 'Exit', -command => sub {exit} );
my $button = $mw->Button
    ( -text => "Press me", -command => \&press );
    These don't look like they have much in common, but all of them set up a callback. The first one does it using bind. The second argument to bind is always a callback, which, as you can see, is simply a coderef: either an anonymous sub { exit }, or a reference to a named subroutine \&press. The second two demonstrate the use of the -command option, which will also take a reference to a subroutine, and set up the appropriate call back. The upshot is that when you press Alt-F4, or select "Exit" on the menubar, the application will exit, and when you click on the button, it will invoke the press subroutine.
  7. So what does this press subroutine do? It does three things: the first is to get the value of a widget using the cget (configuration-get) method. All widgets support this method, which will return the value of whatever is requested: here we ask for the current value of the button's -text option. The next thing the subroutine does is interact with the shell that spawned it: printing things to the console window is quite useful for debugging purposes. If you want to run your GUI without an accompanying black box, you can invoke it with wperl rather than perl. The final thing the subroutine does is use the configure method: this is the write version of read-only cget. Again, this is supported by all widgets, and can be used to change the default values of options that were set when the widget was created. This one simply swaps the text in the Label widget.
  8. Finally, once we have set up our window, it is time to run the user interface. Nothing will actually happen until we call MainLoop, which is essentially an infinite loop while ( 1 ) { process tk events }, which is termed an event loop. The event loop basically sits there, responding to key presses and mouse movements, and calling the appropriate callbacks.

That's largely all there is to a basic Tk application: you simply create the widgets, geometry them into place, set up bindings to callbacks, and kick off the event loop. So let's see this in action in a slightly more interesting fashion.

The cradle of civilisation

I have a difficult time remembering all the political machinations that have occurred in Mesopotamia since 5000 BC. You may have the same problem (if you too have no life). We shall create an aide-mémoire that displays the history in a pretty and comprehensible fashion:

#!/usr/bin/perl
use strict;
use warnings;
use Tk;
my $mw = MainWindow->new( -title => "Mesopotamia" );
my $map = $mw->Photo
    ( -file => 'map.bmp', -height => 220, width => 300 );
my $map_label = $mw->Label
    ( -image => $map, -relief => "groove", -borderwidth => 2 )
        ->grid( -row => 0, -column => 0, 
                      -pady => 20, -padx => 20 );
my $scale = $mw->Scale
    ( -from => -5000, -to => 2010, -orient => "horiz",
      -length => 300, -resolution => 10 )
        ->grid( -row => 1, -column => 0 );
my $frame = $mw->Frame
    ( -relief => "groove", -borderwidth => 2 )
        ->grid( -row => 2, -column => 0, -pady => 20 );
my $label = $frame->Label
    ( -wraplength => 200, -width => 50, -height => 5 )
        ->pack();

First we create a Photo, which we will use to display a map later. Tk natively supports bitmaps and gifs, but if you want to display jpegs, you;ll need to install Tk::JPEG. Then we set up a few widgets: a Label, into which we stick our map image using the -image options: all widgets support the -image and -text options, which can be used to give widgets some character. We also set up a Scale to represent the passing of history (at a resolution of one decade), and a Framed Label to store some historical data. Although we can only use one geometry manager to arrange widgets within another widget (we only use grid to arrange the widgets in the main window), we are free to use a more convenient one to e.g. pack widgets in the Frame.

my %data;
my @ordered;
while ( <DATA> )
{
    next unless /\w/;
    my ( $date, $description ) = / (\S*) \s*:\s* (.*) /x;
    unshift @ordered, $date;
    my $abs_date = abs $date;
    $description = $abs_date .
        ( $date < 0 ? " BC $description" : " AD $description" );
    $data{ $date } = $description;
}

This bit simply reads some data in from the DATA filehandle and dumps it into a hash.

$mw->bind( "<Alt-F4>" => sub { Tk::exit } );
$mw->repeat( 250 => \&update );
MainLoop();

Here I do my superstitious thing: always have a keyboard shortcut way out! We also use the repeat function to set up a callback that will be executed and rescheduled every 250 milliseconds. Tk allows you to schedule several sorts of event: perldoc Tk::after for details. This code ensures the text in the Frame is updated regularly as the slider is moved up and down.

sub update
{
    my $date = $scale->get();
    my $chosen;
    for ( @ordered )
    {
        $chosen = $_;
        last if $_ <= $date;
    }
    $label->configure( -text => $data{$chosen} );
}

Here we obtain the scaled value and use it to configure the text in the Frame. The last bit is our data (note that the original has unbroken lines, here it is broken up to prevent overspill):

__DATA__
-5000 : The Sumerians found Uruk, Ur, and other city states in southern 
        Mesopotamia.
-2330 : The Akkadians, under Sargon I, found the Akkadian Empire.
-2218 : The Gutians, under the 3rd dynasty of Ur are final flowering of Sumeria.
-2000 : The Elamites destroy the city of Ur.
-1800 : The Babylonians, under Hammurabi, found the city of Babylon, 
        as the Amorites gain control of Assur.
-1595 : The Hittites raid Babylon from their power base in Anatolia, crippling 
        the empire.
-1580 : The Kassites rule Babylon.
-1580 : The Mittanites rule Assur, having been set up by Hurrians from the 
        Caucasus.
-1350 : The Assyrians defeat the Mittanites in Assur, and begin empire-building,
        with a capital at Nineveh.
-1225 : The Assyrians conquer Babylon briefly, and soon after Aramaean tribes 
        from Syria and Chaldean tribes overrun Babylonia.
-910  : Assyria expands again.
-612  : An alliance of Medes and Chaldeans cause Assyria to collapse.
-612  : Medes take the hill country, leaving Mesopotamia to the Chaldeans 
        (Neo-Babylonians) under Nebuchadnezzar II.
-539  : Chaldeans and Medes defeated by Cyrus the Great of Persia, who captures 
        Babylon.
-539  : Mesopotamia divided into the now Aramaic-speaking satrapies of Babylon 
        and Assur.
-311  : Alexander the Great conquers Asia Minor.
-323  : Macedonian empire disintegrates on Alexander's death.
-312  : Seleucus I enters Babylon, and Mesopotamia is incorporated into the 
        Seleucid empire.
-250  : The Arsacid rulers of Parthia take Mesopotamia.
226   : Sassanids from Persia extend their empire from the Euphrates to modern 
        Afghanistan.
230   : Conflict with the Roman province of Syria, later to become part of the 
        Byzantine empire (after 395).
635   : Arabs under the Umayyad caliphate in Damascus take Mesopotamia.
750   : Construction of Baghdad as the new capital of a Muslim empire under the
        Abbasid caliphs with imported Turkish slaves.
1258  : Mongols sack Baghdad.
1410  : Mesopotamia attacked by Bedouins and Mongols.
1500  : Ottoman Turks and Safavid Persian rulers vie for control of Mesopotamia.
1910  : British troops take the area, Iraq mandated to Great Britain and Syria 
        to France.
1932  : Iraq independent.
2003  : Iraq invaded by United States of America.

Here is a screenshot of the products of this code. I ran this up in about an hour, and most of that was unearthing the data: as you can see, Tk makes creating GUIs as easy as the rest of Perl. Grab the Mesopotamia script and Mesopotamia bitmap if you want them.

Mesopotamia screenshot.

Widgets-a-plenty

So that's how to write Tk scripts. However, sometimes you'll notice that a bunch of widgets you are using look like they ought to be somehow amalgamated into one, so you could handle them as a single unit. Say you want to create an Entry widget that has an associated Label. What you want to do is create a 'composite widget'. In this case, the widget you are looking for has already been created, and it's called the LabEntry widget. It happens to be the smallest composite widget supplied with Tk, and appears here in more-or-less the form you'll find it in your library:

package Tk::LabEntry;
use Tk::Frame;
use Tk::Label;
use Tk::Entry;
our @ISA = qw( Tk::Frame );
Tk::Widget->Construct( 'LabEntry' );
sub Populate
{
    my( $cw, $args ) = @_;
    $cw->SUPER::Populate( $args );
    my $e = $cw->Entry();
    $e->pack( '-expand' => 1, '-fill' => 'both' );
    $cw->Advertise( 'entry' => $e );
    $cw->ConfigSpecs( DEFAULT => [ $e ] );
    $cw->Delegates( DEFAULT => $e );
}
1;

The package name is, as usual, wherever you want to keep the module in your library, and we obviously have to use (or require) any widgets we want to include in our composite. Most people chose to make their composites from a Frame containing other subwidgets, and therefore it is sensible to make the composite widget a subclass of Tk::Frame by putting this in @ISA. That way, any calls to methods such as label and scrollbars that you don't define yourself will be redirected to the parent Frame.

The Construct method from Tk::Widget takes the name you want people to call your widget when they create one. This means that if you create a composite called Bio::Simulation::Photosynthesis people can create it using $parent->PS(); if you add Tk::Widget->Construct( 'PS' ); here.

Unlike most object-oriented modules, you'll notice a lack of a new constructor. Composite widgets inherit their constructor from a base class, all you need to do is provide a Populate method. The purpose of this method is to create the widgets inside your composite, pack them in, and then set up a number of attributes that Tk will use when you call methods like cget and configure. Populate is always called with two options: the first is a reference to the composite widget (here, $cw), the second a hashref of configuration options (here, $arg). It is generally wise to call the Populate method of the parent class using SUPER::Populate($args) at some point, to initialise any callbacks that the parent widget requires. You can then do the boring bit (creating widgets and packing them in).

Finally, we need to tell Tk what to do when users call configure, and other standard utility methods like cget and Subwidget. That's what these things do:

    $cw->Advertise( 'entry' => $e );
    $cw->ConfigSpecs( DEFAULT => [ $e ] );
    $cw->Delegates( DEFAULT => $e );

Advertise tells Tk what to do with requests for subwidgets. The LabEntry composite allows you to get direct access to its Entry widget using:

my $lab_entry = $mw->LabEntry();
my $entry_widget_inside = $lab_entry->Subwidget( 'entry' )

Delegates tells Tk which method to call when someone invokes:

$lab_entry->insert( "blah" );

If the LabEntry widget doesn't define its own insert method, then it clearly wants to tell one of its subwidgets to do the inserting for it. You can either tell it exactly which method to delegate to which subwidget:

$cw->Delegates( 'insert' => $e );

And/or set up a default, as this class does: everything gets delegated to the Entry widget. Finally, the ConfigSpecs method tells Tk what to do when configure and cget are called. In this LabEntry case, a simple default is set up, again delegating all calls to the Entry subwidget. ConfigSpecs takes a hash of options: the keys are the names of -options that can be configured and the values are arrayrefs showing how they should be handled. To set up a default, you merely need to call:

$cw->ConfigSpecs( DEFAULT => [ $e ] );

with an arrayref containing only the object that will get/set the configurable options. For something a little more complex, here is a section from the module I wrote to simulate phototaxis: ConfigSpecs is told to call the population method when someone does something like $taxis_widget->cget( "-population" ), the width method for $taxis_widget->configure( -width => 20 ), and to fallback to a Canvas subwidget otherwise. The first element in the arrayref indicates what you want to do: call a METHOD (the most general solution), invoke a CALLBACK, PASSIVE-ly store the data somewhere, etc. The remaining three are the name of the option in the widget's database, its class, and its default value. Don't worry too much about these three: see perldoc Tk::ConfigSpecs if you do want to worry.

$taxis->ConfigSpecs
(
    -population => [ 'METHOD', 'population', 'Population', undef ],
    -width => [ 'METHOD', 'width', 'Width', undef ],
    DEFAULT => [ $canvas ],
);
sub population
{
    my ( $taxis, $population ) = @_;
    if ( defined $population )
    {
        $taxis->{ population } = abs $population;
            # we never know how stupid people can be
        $taxis->_draw_arena();
    }
    if ( wantarray )
    {
        my $canvas = $taxis->Subwidget( 'canvas' );
        my ( $left, $right ) = ( 0, 0 );
        for my $i ( 1 .. $taxis->{ population } )
        {
           ${ $taxis->{ critters } }[ $i ]{ pos }[ 0 ]
                <= $canvas->cget( -width ) / 2 ?
                    $left++ :
                        $right++;
        }
        return $left, $right;
    }
    else
    {
        return $taxis->{ population };
    }
}
sub width
{
    my ( $taxis, $width ) = @_;
    if ( $width )
    {
        $taxis->{ width } = $width;
        $taxis->_draw_arena();
    }
    $taxis->{ width };
}

The methods that we call must obviously be able to get and/or set the relevant attributes, and configure any subwidgets appropriately.

There are several other aspects to creating a composite widget: perldoc Tk::mega if you come across something you think you should be able to do, but don't yet know how.

Tk gotchas

Tk can be a bit ropy at times. This is the only place in Perl that if you find something going wrong and you're convinced you're doing it right, then it may well be Tk's fault rather than yours! The following are some troubles I have had: