Troubleshooters.Com Presents


Linux Productivity Magazine

Volume 2 Issue 2, February 2003
Perl Tk, Part 1

Copyright (C) 2003 by Steve Litt. All rights reserved. Materials from guest authors copyrighted by them and licensed for perpetual use to Linux Productivity Magazine. All rights reserved to the copyright holder, except for items specifically marked otherwise (certain free software source code, GNU/GPL, etc.). All material herein provided "As-Is". User assumes all risk and responsibility for any outcome.


See also Troubleshooting Techniques of the Successful Technologist
and Rapid Learning: Secret Weapon of the Successful Technologist
by Steve Litt

[ Troubleshooters.Com | Back Issues | Troubleshooting Professional Magazine ]

 
Where there's a will, there's a way -- Old proverb

CONTENTS

Editor's Desk

By Steve Litt
What do I miss most about Windows? Is it MS Word?

No, MS Word is wonderful, but nothing that can't be replaced by a combination of VimOutliner, LyX and OpenOffice.

Perhaps a web authoring tool? No, I use the same web authoring tool, Mozilla Composer, as I used in Windows (although in Windows it was called Netscape Gold and then Netscape Composer).

Do I miss the Windows user interface? Heck no -- Icewm plus UMENU runs circles around that silly Windows.

I miss Excel, but actually prefer Gnumeric to Excel.

But there's a Windows product I truly, mournfully miss. And you might never have heard of it. In fact, its best rendition was a DOS product. And it did for application development what VimOutliner does for outlining. Its name is Clarion.

Clarion 2.1 was a DOS development environment that, for apps requiring user input, ran circles around anything that came before or since. The development environment produced completely functional prototypes, and believe it or not the result was a professional product. And any stage in development, if you thought of something to be added, you just added it. No backing out to go forward. While designing a screen, if you realized you needed a new column in a table, you could put it in along with its screen field. You could whip out a 6 table app in a couple days, and add user requested features as fast as the the users could think of them.

Later Clarion versions were data centered -- you filled in the entire database and then generated an app. If you wanted to modify a screen field it wasn't as easy as 2.1, and neither was adding a data column and then correctly installing the screen field. Nevertheless, I found Clarion 4.0 almost as productive for me as  2.1, and it was much better than most of their rivals.

Powerbuilder came a not so close second to Clarion 2.1. If it hadn't had the GPF problems (I'm talking circa 1996-98 -- I haven't used it since then), it would have been a reasonable Clarion substitute. It had painters for screens, databases, reports and everything else. VB was nice, but there was the deployment problem, and of course the whole Microsoft interoperability thing. Delphi was nice, but you needed to remember what connected to what, and which properties they all had.

On Linux, I'd kill for something as quick as Delphi, VB or Powerbuilder, let alone Clarion. I took a quick look at QT and a few of the other GUI development environments that come with my Linux distro, and wasn't impressed. There's always Java, but Java's so huge. Well whatever -- I just wrote web apps.

After joining Toastmasters, I needed a computerized clock to time speeches, turning green, then yellow, then red at the right timings. And I wanted it portable so others could use it. And it had to be GUI. I wrote it in Perl with the Tk module.

Is Perl Tk as fast to develop as Clarion? No way. Like most "write once, run everywhere" languages it uses a layout manager rather than drag and drop label, field and button placement. You need to visualize your screen, then design it. And if you need to add a field, you'll be doing some serious shoehorning.

But Clarion is Windows only. I'll tell you how portable Perl Tk is. I developed the speech timer program on my Linux box. I then copied it to my Windows box, downloaded ActiveState Perl, ran the program, and it ran identically, yes, identically, to how it ran on the Linux box. Write once, run everywhere!

I'm sold. OK, I'll need to get some riffs and techniques to speed development, but I think Perl TK just might be the GUI portion of my Clarion replacement.

You can use this Linux Productivity Magazine issue as a Perl Tk tutorial. It's based on my speech timer, and as such gives you a solid Perl Tk foundation.

Actually, my Perl Tk progress is well beyond what you'll read in this mag. I'm 90% complete in creating a generic picklist object, which was one of Clarion's main weapons in the war against lengthy development. In Perl Tk, Part 2, which comes out next month, you'll see this object and hopefully a picklist driven field, Clarion's other killer object. In Part 2 you'll also see examples of SQL linkage, and hopefully generic picklists, fields and forms that you can quickly code to interface with SQL.

Of course, you and I both know that possession of these components doesn't guarantee fast development, at least for those not intimately familiar with the toolset. For that kind of casual speed, you need a development environment that helps build the generic parts of the app. Clarion used a template-driven interface -- perhaps I'll try the same thing next month, or possibly the month after if this becomes a 3 month series (would you all like a third in this series -- email me).

A big Thank You goes out to all the members of Linux Enthusiasts and Professionals (LEAP), and especially Perl Guru Extraordinaire John Simpson, for all their help in researching the capabilities of Perl Tk. You guys rock!

So Part 1 explains the use of Perl Tk, while Part 2 will discuss generic RAD objects and database connectivity. Kick back, relax, and learn how to rapidly create cross platform GUI apps. And remember, if you use Open Source or free software, this is your magazine.
Steve Litt is the author of Samba Unleashed.   Steve can be reached at Steve Litt's email address.

Help Publicize Linux Productivity Magazine

By Steve Litt
Loyal readers, I need your help.

For months I've publicized Linux Productivity Magazine, expanding it from a new magazine to a mainstay read by thousands. There's a limit to what I can do alone, but if you take one minute to help, the possibilities are boundless.

If you like this magazine, please report it to one of the Linux magazines. Tell them the URL, why you like it, and ask them to link to it.

I report it to them, but they don't take it very seriously when an author blows his own horn. When a hundred readers report the magazine, they'll sit up and take notice.

Reporting is simple enough. Just click on one of these links, and report the magazine. It will take less than 5 minutes.

News Mag
 		Submission URL or Email address
 		Comments
Slashdot
 http://slashdot.org/submit.pl
 Just fill in the short form.
LinuxToday
 http://linuxtoday.com/contribute.php3
 Just fill in the short form.
Linux Weekly News
 lwn@lwn.net
 Just tell them the URL, why you like it.
NewsForge
 webmaster@linux.com
 Just tell them the URL, why you like it.
VarLinux
 http://www.varlinux.org/vlox/html/modules/news/submit.php
 Just fill in the short form.
LinuxInsider.Com,
Newsfactor Network
 http://www.newsfactor.com/perl/contact_form.pl?to=contact
 Just tell them the URL, why you like it.
The Linux Knowledge Portal
 webmaster@linux-knowledge-portal.org
 Just tell them the URL, why you like it.
OS News
 http://www.osnews.com/submit.php
 Just tell them the URL, why you like it.
DesktopLinux
 http://www.desktoplinux.com/cgi-bin/news_post.cgi
 Only for LPM issues involving the Linux desktop, not for programming or server issues.

If you really like this magazine, please take 5 minutes to help bring it to a wider audience. Submit it to one of the preceding sites.
Steve Litt is the author of Samba Unleashed.   Steve can be reached at Steve Litt's email address.

Hello World

By Steve Litt
This is a trivially the simple Perl Tk. Try it out now:

#!/usr/bin/perl -w
use strict;
require 5.003;
use Tk;

my $mw = MainWindow->new();

$mw->geometry ( '500x300' ) ;

$mw->Button ( -text => "Hello World" , -command => sub { exit; } )
	->pack();

MainLoop();

Let's examine the preceding. On the fourth line we pull in the Tk module, which comes standard in most modern Perl implementations. Then we instantiate a new window, set the window to 500 x 300 pixels so it's easy to see, and then install a button on that window. The button's text is "Hello World", and its action is to call the Perl exit command, which ends the app. Because the -command property requires a code reference, we use a reference to an anonomous subroutine which does nothing but call the exit command. Finally, we send that button to the pack layout manager with the pack()function. Later we'll explore many arguments that can be placed in that pack() function to put things where we want them to, and we'll also explore use of multiple containers for screen components to quickly affect a pleasing layout.

None of the code described so far would do much good without the MainLoop() call.  The MainLoop() call is what displays the screen. It's kinda/sorta the equivalent of a Windows event loop.

Paste the preceding code into a file, set the file executable, and verify that you can indeed create a Perl Tk window. Once you have it working, continue on to the next article.
Steve Litt is the author of " Troubleshooting Techniques of the Successful Technologist".  Steve can be reached at Steve Litt's email address .

Creating and Configuring a Callback

By Steve Litt
Perl Tk makes GUI apps. A GUI app sits there and spins all day (MainLoop(), the Windows event loop, etc). That means your Perl program must assign Perl subroutines to each event that can happen during the Tk loop, and when Tk sees one of those events, it calls back to the assigned perl subroutine. Callback functions in C are pointers to functions, and in Perl they're references to functions. There are three distinct ways to make a function reference in Perl:

CALLBACK SYNTAX
 		EXAMPLE
Anonymous
 sub{print "\007"}
Reference
 &\soundbell
String syntax
 'soundbell'

Create the following bell.pl:


#!/usr/bin/perl -w
use strict;
require 5.003;
use Tk;

my $mw = MainWindow->new();

$mw->Button ( -text => "Ring Bell" , -command => sub { print "\007"; } ) 
	->pack ( -side => "left" ) ;

$mw->Button ( -text => "Quit" , -command => sub { exit; } ) 
	->pack ( -side => "left" ) ;

MainLoop();

The preceding program produces the following GUI window:

Bell ringer program screen

When you click the "Ring Bell" button, the computer speaker beeps. And when you click the Quit button, the program ends (due to the exit command in the anonomous subroutine reference). Also new in this program are the arguments to the pack() function. As you remember, pack() is a layout manager that puts widgets (buttons, labels, entry areas, etc) in the proper place, but does so independent of the operating system. Two properties often specified in the pack() function are the "side" to put the widget on (top, bottom, left or right), and how to align the widget (center, and directions n, ne, e, se, s, sw, w, nw), within its allotted area.

Now let's substitute a subroutine reference for the anonomous reference, with the added/changed material in bold red:

#!/usr/bin/perl -w
use strict;
require 5.003;
use Tk;

sub soundbell()
	{
	print "\007" ;
	}

my $mw = MainWindow->new();

$mw->Button ( -text => "Ring Bell" , -command => \&soundbell )
	->pack ( -side => "left" ) ;

$mw->Button ( -text => "Quit" , -command => sub { exit ; } )
	->pack ( -side => "left" ) ;

MainLoop();

In the preceding, note that we coded a subroutine called soundbell() and then called it with a subroutine reference. soundbell() is used as a callback function -- the Perl code calls the Tk code, and then the Tk code "calls back" the perl code soundbell().

Sending arguments to a callback

In C, the arguments to a callback are cast in concrete with the declaration of the callback routine. Not so with Perl -- it's much more intuitive. You simply put the function reference, and all the arguments, in an array reference (in other words, surround them with square brackets). The following program, called strings.pl, prints each string argument on the console which originally ran the program. The "Two strings" button prints 2 strings by sending 2 arguments to callback function printstrings(), while the "Three strings" button prints 3 strings by sending 3 arguments. I dare you to do THAT in C:

#!/usr/bin/perl -w
use strict;
require 5.003;
use Tk;

sub printstrings ( @ ) 
	{ 
	print "\n\n";
	foreach my $string ( @_ ) 
		{ 
		print "$string\n";
		} 
	} 

my $mw = MainWindow->new();

$mw->Button ( -text => "Two strings" , 
	-command => [ \&printstrings , "Hello" , "World" ] ) 
	->pack ( -side => "left" ) ;

$mw->Button ( -text => "Three strings" , 
	-command => [ \&printstrings , "Hello" , "World" , "From me" ] ) 
	->pack ( -side => "left" ) ;

$mw->Button ( -text => "Quit" , -command => sub { exit; } ) 
	->pack ( -side => "left" ) ;

MainLoop();

Here's a little hint for the future. Remembering that in Perl OOP a call to an object method is simply a call to that subroutine, where the first argument is the object itself, you can call a method in the current object by having the first element following the function reference itself be the object reference ($_[0], customarily assigned to a variable called $self). We'll get back to that later.

Summary

Button clicks, and other events, accomplish their tasks via function references, which can be either anonomous (sub {print "\007";}), or actual references to existing functions (\&soundbell). To send arguments to a reference to an existing function, place the function reference and every argument, in order, into an anonymous array reference like this:
-command => [\&printstrings, "Hello", "World"]
Steve Litt is the author of Rapid Learning: Secret Weapon of the Successful Technologist. He can be reached at Steve Litt's email address.

A Better OOP Callback Syntax

By Fergal Daly
Editor's Note


A few days after this magazine came out, Fergal Daly wrote this article pointing out that the callback syntax I had advocated in the Callbacks in an OOP Program would fail if subclassed, and displaying a syntax that would stand up to the rigors of inheritance. I don't have time to revise and re-tech-edit the articles in this magazine, but I recommend you change OOP callbacks to the style described in Fergal's article.


Copyright (c) 2003 by Fergal Daly. This material may be distributed only subject to the terms and conditions set forth in the Open Publication License, version Draft v1.0, 8 June 1999 (Available at http://www.troubleshooters.com/openpub04.txt/ (wordwrapped for readability at http://www.troubleshooters.com/openpub04_wrapped.txt). The latest version is presently available at http://www.opencontent.org/openpub/).

Open Publication License Option A is not elected, so this document may be modified. Option B is not elected, so this material may be published for commercial purposes.


I was delighted to see the article on Perl/Tk, I started using it years ago and although I haven't used it much recently I like to see it getting some publicity. The article was good but there were a couple of things I didn't like.

In "Callbacks in an OOP Program" the author suggests 
-command => [ \&MyScreen::printstrings , $self , "Hello" , "World" , "From me" ]
as a suitable way of doing OO callbacks. This is a very bad idea as it breaks one of the most important rules of OO. You should never assume anything about an objects implementation, including what class the object is in. So although this technique works in the example given, it is going to break in a more gnereal situation. If someone uses the MyScreen class as the base for their own class and writes their own implementation of print_strings (say they want have their computer to read the strings out loud instead of printing them), it it would look like this: 

package MyStringsSpeech;

use MyStrings;

use base qw( MyStrings );

use TextToSpeech; # this module doesn't really exist

# if you really want open source text to speech software have a look for
# Festival. Apparently it's quite good

sub printstrings
{
        my $self = shift;

        foreach my $string (@_)
        {
                TextToSpeech::say($string);
        }
}


This will not work properly, as the new printstrings sub routine will never be called. We must also rewrite the entire new() method to include so that MyStringsSpeech::printstrings() gets called.

Luckily the Perl/Tk people have already thought of this and so by changing the original version to use 
-command => [ 'printstrings', $self, "Hello" , "World" , "From me"],
Perl/Tk notices that we haven't passed in a subroutine reference so it assumes that 'printstrings' is the name of a method and that $self is the object to call this method on. For the full low-down on what you can do with callbacks in Perl/Tk have a look at the Tk::callbacks man page, which should have been installed when you installed Perl/Tk.

You can also put the object before the method name in the callback. I prefer this way as the order is the same as if you were just doing 
$self->printstrings(...).
Neither of these methods depend on knowing the class of the object so for instance you could have something like 

sub new ( $ )
        {
        my $type = shift;
        my $self = { } ;
        bless ( $self , $type ) ;

        my $mw = shift;
        my $counter = shift;

        $self->{'mv'} = $mw;

        $self-> { 'mw' } ->Button ( -text => "Increment by 5" ,
                -command => [ $counter, 'plus', 5 ] )
                ->pack ( -side => "left" ) ;

        $self-> { 'mw' } ->Button ( -text => "Decrement by 2" ,
                -command => [ $counter, 'minus' , 2 ] )
                ->pack ( -side => "left" ) ;

        return ( $self ) ;
        }


This makes no assumptions about the counter object that is passed in except that it has increment() and decrement() methods.

The other part of the article that I had a problem with was the example of how to do a grid using pack, it seemed like a lot stress and hassle and took quite a long time. So why bother when Perl/Tk actually has a grid geometry manager?

Here's the example rewritten to use grid. 

#! /usr/bin/perl -w

require 5.003;
use strict;
use Tk;

my $mw = new MainWindow();
$mw->title ( "Revenue by Year and Quarter" ) ;

$mw->Label ( -text => "Revenue by Year and Quarter ( Millions ) " ) 
        ->pack ( -side => "top" , -anchor => 'center' ) ;

my $fgrid = $mw->Frame()->pack ( -side => 'top' ) ;

my @year_col = (
        $fgrid->Label ( -text => 'Year' ),
        $fgrid->Label ( -text => '2000' ),
        $fgrid->Label ( -text => '2001' ),
        $fgrid->Label ( -text => '2002' ),
        $fgrid->Label ( -text => '2003' ),
);

my @ceo_col = (
        $fgrid->Label ( -text => 'CEO' ),
        $fgrid->Entry ( -width => 14 , -justify => 'left' ),
        $fgrid->Entry ( -width => 14 , -justify => 'left' ),
        $fgrid->Entry ( -width => 14 , -justify => 'left' ),
        $fgrid->Entry ( -width => 14 , -justify => 'left' ),
);
my @fq1_col = (
        $fgrid->Label ( -text => 'Q1' ),
        $fgrid->Entry ( -width => 6 , -justify => 'right' ),
        $fgrid->Entry ( -width => 6 , -justify => 'right' ),
        $fgrid->Entry ( -width => 6 , -justify => 'right' ),
        $fgrid->Entry ( -width => 6 , -justify => 'right' ),
);

my @fq2_col = (
        $fgrid->Label ( -text => 'Q2' ),
        $fgrid->Entry ( -width => 6 , -justify => 'right' ),
        $fgrid->Entry ( -width => 6 , -justify => 'right' ),
        $fgrid->Entry ( -width => 6 , -justify => 'right' ),
        $fgrid->Entry ( -width => 6 , -justify => 'right' ),
);

my @fq3_col = (
        $fgrid->Label ( -text => 'Q3' ),
        $fgrid->Entry ( -width => 6 , -justify => 'right' ),
        $fgrid->Entry ( -width => 6 , -justify => 'right' ),
        $fgrid->Entry ( -width => 6 , -justify => 'right' ),
        $fgrid->Entry ( -width => 6 , -justify => 'right' ),
);

my @fq4_col = (
        $fgrid->Label ( -text => 'Q4' ),
        $fgrid->Entry ( -width => 6 , -justify => 'right' ),
        $fgrid->Entry ( -width => 6 , -justify => 'right' ),
        $fgrid->Entry ( -width => 6 , -justify => 'right' ),
        $fgrid->Entry ( -width => 6 , -justify => 'right' ),
);

my @total_col = (
        $fgrid->Label ( -text => 'Total' ),
        $fgrid->Entry ( -width => 6 , -justify => 'right' ),
        $fgrid->Entry ( -width => 6 , -justify => 'right' ),
        $fgrid->Entry ( -width => 6 , -justify => 'right' ),
        $fgrid->Entry ( -width => 6 , -justify => 'right' ),
);

my @columns = (
        \@year_col,
        \@ceo_col,
        \@fq1_col,
        \@fq2_col,
        \@fq3_col,
        \@fq4_col,
        \@total_col,
);

my $col = 0;
foreach my $column (@columns)
{
        my $row = 0;

        foreach my $entry (@$column)
        {
                $entry->grid(-column => $col, -row => $row, -padx => 4);
                $row++;
        }
        $col++;
}

MainLoop();


Anyone familiar with HTML tables should be comfortable with grid, it can take -rowspan and -colspan arguments just like HTML table cells. For the gory details have a look in the Tk::grid manpage. Happy Tking.

Thanks to Steve Litt for writing the original article.

Fergal Daly has been off exploring the world for a bit but is back in Ireland now and looking for a job again... hint hint... You can find his sparse and unimaginatively titled website at http://www.fergaldaly.com/, and you can email him at fergal@esatclear.ie -- Do you need someone with lots of Unix sysadmin and/or lots of OO software development experience? His CV - http://www.fergaldaly.com/cv.html

Callbacks in an OOP Program

By Steve Litt
IMHO anything but the simplest Perl Tk programs are best done as OOP programs. That's because without OOP, you need to have all sorts of global variables floating around. MainWindows, Buttons, Entrys, Labels, Frames, Repeats, and a host of other "stuff" needs to be used again and again. With OOP, you can encapsulate (to the degree that Perl OOP can do encapsulation :-) that "stuff" with the screens that use it.

The preceding article pretty much told you how to do callbacks in an OOP program. This article actually shows you.

The following code, called oopstrings.pl, is an OOP rewrite of the strings.pl code in the preceding article.


#!/usr/bin/perl -w
use strict;
require 5.003;

package MyScreen;
use Tk;

sub new ( $ ) 
	{ 
	my $type = $_ [ 0 ] ;
	my $self = { } ;
	bless ( $self , $type ) ;

	$self-> { 'mw' } = MainWindow->new();

	$self-> { 'mw' } ->Button ( -text => "Two strings" , 
		-command => [ \&MyScreen::printstrings , $self , "Hello" , "World" ] ) 
		->pack ( -side => "left" ) ;

	$self-> { 'mw' } ->Button ( -text => "Three strings" , 
		-command => [ \&MyScreen::printstrings , $self , "Hello" , "World" , "From me" ] ) 
		->pack ( -side => "left" ) ;
		
	$self-> { 'mw' } ->Button ( -text => "Quit" , -command => sub { exit; } ) 
		->pack ( -side => "left" ) ;

	MainLoop();

	return ( $self ) ;
	} 

sub printstrings ( @ ) 
	{ 
	my $self = shift();

	print "\n\n";
	foreach my $string ( @_ ) 
		{ 
		print "$string\n";
		} 
	} 

package main;

my $app = MyScreen->new();

The preceding code has several points of interest, all colored and bolded. Below is a list of those points of interest and explanations.

Point of Interest
 Explanation
 
use Tk;
 This statement must be inside any package using the  Tk widget set. In an OOP program it's not sufficient to place it at the top of the program.
 
$self->{'mw'}
 The MainWindow must be available throughout the program. We have 3 choices: 1) make it global, 2) pass it everywhere as an argument, or 3) make it a class property. Globals are always bad, and passing as an argument is cumbersome for an object used as frequently as the main window, so the class property technique is probably the best. Considering that in a sizeable program you'll have many objects requiring user interaction, each object can have its own MainWindow and supporting widgets, and these can be encapsulated (to the best of Perl's meager encapsulation ability) in a single source for that MainWindow.
 
MyScreen::
 In Perl, you can reference a class method by prepending the package name with a double colon, and without the object reference, parentheses or arguments.
 
$self,
 In Perl, when calling an object method, the object reference is nothing more or less than arg0. In other words, $self->mymethod() is the same as mymethod($self). Due to the placement of the code ref and args in an anonymous array reference, we use the arg0 rather than object reference syntax.
 
my $self = shift();
 Once again, the object reference is arg0, and we certainly wouldn't want to print the object reference (which would print out as a reference number for a hash). So we "consume" arg0 with a shift command, after which arg0 is the first string to be printed. We assign the "consumed" arg0 to $self, because that's what it really is, and if the printstrings() routine were complex enough to call other methods from this object, it would need to call them as $self->myroutine().
 
my $app = MyScreen->new();
 Now that the entire screen is encapsulated in a class, we instantiate that class to create an object. In this simplistic example, simply instantiating the object runs the whole program. In a real world program, the instantiation would probably set up the screen but not run it. The main program would then call various set routines on the object, then call a method to run the screen to collect user data, and then call other class methods to access the collected data. Later in this magazine you'll see such a configuration in the form of the Speech Timer.
Steve Litt is the author of the Universal Troubleshooting Process courseware.   Steve can be reached at Steve Litt's email address.

Various Widgets

By Steve Litt
Previous articles in this magazine have detailed the Button widget, so this article won't spend much more time on Button widgets. The widgets we'll review are:
Widget type
 Use and information
TopLevel
 A window that can appear anywhere on the screen. Most TopLevels have a  parent widget, and if that parent widget is destroyed, so is the TopLevel. But TopLevels can appear anywhere on the computer screen, and can gain and lose focus with mouse clicks and alt+tab switching.
MainWindow
 A MainWindow is simply a TopLevel that is, by definition, the root parent of all other widgets. Therefore, it has no parent.
Label
 A label is simply text appearing on the window, either directly or inside a frame or subframe. Labels are used for headers and prompts. Label text can be changed programatically by linking it to a variable with the -textvariable=>myVariable syntax, or by explicitly changing it with the configure(-text=>'myNewText') syntax. According to documentation I've read, the explicit change is better because it works better with validation.
Entry
 An Entry is a field for text entry by the user. It can be declared active or inactive. It can be linked to a variable similarly to labels, but the linked variable DOES NOT change after the user changes the field. For that reason, the ->get() and ->insert() methods are much better for reading and writing fields.
Frame
 A frame is an area that's guaranteed rectangular. That means anything placed in it will be in a rectangular area. Layout with frames isn't as simple as it might seem, because frames expand according to what you put in them, and contract according to the "pressure" from widgets outside the frame. Often a prompt and its associated field are placed in a single frame to guarantee they line up close to each other.

We'll now write some code to demonstrate several labels, one of which is changed, buttons, and an entry, whose value is read and transferred to one of the labels. It produces the following window:

Many widgets demo window

The way this app works is that whenever you type text into the Name entry field, and then click the Update button, the text you typed appears in the second label to the top, as shown in the preceding screenshot. Here's the code to accomplish the following screen:

#!/usr/bin/perl -w
use strict;
use Tk;

my $mw = new MainWindow();
$mw->title ( "Demo of several widgets" ) ;

$mw->Label ( -text => "Demo of several widgets" )
	->pack ( -side => "top" ) ;

my $namelabel = $mw->Label()
	->pack ( -side => "top" ) ;

$mw->Label ( -text => "Your name:" )
	->pack ( -side => "left" ) ;

my $nent = $mw->Entry ( -width => 18 , -justify => 'left' )
		->pack( -side => 'left' );

my $updbut = $mw->Button ( -text => "Update" )
		->pack( -side => 'bottom' ) ;
$updbut->configure ( -command => [\&entry2label , $nent , $namelabel ] ) ;

my $cancelbut = $mw->Button ( -text => "Cancel" ,
	-command => sub { $mw->destroy() } )
		->pack ( -side => 'bottom' ) ;
MainLoop();


sub entry2label ( $$ )
	{
	my ( $entry , $label ) = @_;
	$label->configure ( -text => $entry->get() ) ;
	}

Let's go over the preceding code line by line:
Code
 Discussion
 
#!/usr/bin/perl -w
use strict;
use Tk;
 This is typical Perl initialization code. The third line makes the Tk module available to the program.
 
my $mw = new MainWindow();
$mw->title ( "Demo of several widgets" ) ;
 Create a new MainWindow (the top level TopLevel (window)), and give it a title for its titlebar. Assign the newly created MainWindow object to $mw for further use.
 
$mw->Label ( -text => "Demo of several widgets" )
	->pack ( -side => "top" ) ;
 At the top of the window, create a label and use that same title as text for this label.
 
my $namelabel = $mw->Label()
	->pack ( -side => "top" ) ;
 Create a label, and assign it to the $namelabel variable. This is the label whose text will be changed when the Update button is clicked.
 
$mw->Label ( -text => "Your name:" )
	->pack ( -side => "left" ) ;

my $nent = $mw->Entry ( -width=>18 , -justify=>'left' )
		->pack ( -side => 'left' ) ;
 The label is the prompt text for the Entry field. Because it's the first widget with -side=>'left', it goes all the way to the left window border. The next widget it the Entry, which is assigned to variable $nent because it will be used later. The text typed into it will be left justified, and the -side=>'left' means it will go as far to the left as possible, but because the prompt is already all the way left, it will be on the prompt's right.
 
my $updbut = $mw->Button ( -text => "Update" )
		->pack ( -side => 'bottom' ) ;
$updbut->configure ( -command => [\&entry2label , $nent , $namelabel] ) ;
 A button is created whose text is "Update". It's bottom packed, so it sinks to the bottom. Next, that same button is configured by giving it a command code reference for callback. Specifically, a reference to entry2label() is given, with arguments $nent (the entry field) and $namelabel (the label to which to write the entered text) passed to entry2label().
 
my $cancelbut = $mw->Button ( -text => "Cancel",
	-command => sub { $mw->destroy() } )
		->pack ( -side => 'bottom' ) ;
 This button calls $mw->destroy() via an anonymous subroutine reference. $mw->destroy() destroys the window, which also ends the app because the app does nothing further after running the screen.Because of the -side=>'bottom', it sinks to the bottom, except it does not sink as far as the previously bottom aligned update button.
 
MainLoop();
 This make the screen appear. It's an event loop.
 
sub entry2label ( $$ )
	{
	my ( $entry , $label ) = @_ ;
	$label->configure ( -text => $entry->get() );
	}
 This is the subroutine that transfers text from the Entry to the Label, both of which were passed to this subroutine. $entry->get() retrieves the text out of the $entry Entry object. Notice that $entry->get() is NOT a reference, but instead a straight call. This is because it's a substitute for a literal (the entry text), not a variable or code to call back.

Using the TopLevel, MainWindow, Label, Entry and Frame widgets, you can create some fairly substantial apps. The next article explains how to lay them out.
Steve Litt is the author of the course on the Universal Troubleshooting Process.  He can be reached at Steve Litt's email address .

Layout

By Steve Litt
The previous articles covered the mechanical trivia of Perl Tk programming. That information can be hard to guess, and hard to dig up from documentation, but once you have it together in one place, it really is trivial.

Less trivial is screen design. Like Java, Perl Tk uses a layout manager. It has several layout managers, but the one we'll review in this article is the pack() layout manager.

Programming environments with layout managers are much more portable, but that portability comes with a coding speed cost. Rather than simply dragging and dropping screen elements like you would in VB, Delphi or Clarion, you must plan the entire screen, splitting it up into frames and subframes in order to provide the proper alignment of screen elements.

In Clarion, when you want to add a field to a crowded screen, you simply drag all the existing screen elements around until you've made room for the new field. Same in VB and Delphi. Ellapsed time, including trial and error -- maybe 5 minutes. Performing the same task in Perl Tk could take an hour, because with each trial in trial and error, you might need to change the parent frame of several (or all) elements just to look at the result and reject it. And with a layout manager, guaranteeing that prompts line up with their respective fields can be daunting. And if your boss is an artiste', you may not have good luck with Perl Tk. With crowded screens, it's almost impossible to micromanage screen element placement for the ultimate aesthetic experience.

The good news, if you don't jam everything but the kitchen sink into the screen, and if you're willing to accept aesthetics that are utilitarian rather than beautiful, with a little practice you can code up Perl Tk screens pretty fast.

We got lucky in the previous article (Various Widgets). The code produced a decent looking screen. With 6 total widgets, only one of which was an entry screen, it's fairly easy to produce a good looking screen. But when you start getting 6 or even 16 entry fields on a screen, the quickie layout used in the preceding article will create a mess. To facilitate good looking layout, we introduce another widget, the Frame. Frame widgets serve two purposes:
  1. To create space between two other widgets
  2. To serve as a guaranteed rectangular container for other widgets, thereby binding those contained widgets together.
Frames are a little trickier than you might imagine, because they grow and shrink depending on their contents, and the pressure from outside widgets sharing the same window.

Frames are only half the story. The other half is the layout manager. A layout manager is an algorithm that places widgets in a "best fit" sort of way, as opposed to the "hard coded" widget locations supported by non-portable development environments. Non-portable products like VB let the user choose exact locations, but such hard coded locations can break down when ported to other operating systems and other graphics engines.

Perl Tk has several layout managers, but the only one we'll discuss is the pack() layout manager, because it's the most common. Implementing this layout manager is as easy as calling the pack()method on every widget placed. The pack() method is called with zero or more key/value pairs for arguments. The key and value are separated by the => operator. Here's an example:
my $myframe = Frame()->pack(-side=>'left', -anchor=>'center', -pady=>20);
Here are the major argument types for pack():

Key
 Possible
values
 Action
-side
 'left', 'right', 'top' or 'bottom'
 pack() tries to "push" the widget to the declared side. Of course, it can't push it past widgets previously declared on the same side.
-anchor
 'center', 'n', 'ne', 'e', 'se', 's', 'sw', 'w', 'nw'
 -side pushes the widget as far to the named side as possible. But once that is done, where will the widget fall in the other dimension. If -side=>'top', will the widget fall on the right, the left, or the center of its container. This is often used to  right justify prompts and left justify entry fields, but it can be used for much more.
-padx
 An integer
 Try to push all widgets on either side of this one away by a distance defined by the value. The larger the value, the more it tries to push those widgets away. This is a way to create spacing between widgets. If you need to create a defined amount of space between two specific widgets, you can create an empty frame with specific -padx. -padx pushes horizontally. If you want to push vertically, use -pady.
-pady
 An integer
 Just like -padx, except it pushes away vertically instead of horizontally.
-ipadx
 An integer
 This is just like -padx, except it pushes internally, instead of externally. In other words, -padx pushes other widgets away from this widget. -ipadx pushes the borders of this widget (usually a frame) away from contained widgets.
-ipady
 An integer
 The vertical equivalent of -padx.

Challenge 1: A vertical series of input fields

It's pretty simple. You have three input fields, whose lengths are 1, 2 and 3 characters. To the left of each, you have prompts "One:", "Two"" and "Three:". All you need to do is lay them out so the prompts are right justified and the fields are left justified.

Your first impulse might be to "just do it":

#!/usr/bin/perl -w
use strict;
require 5.003;
use Tk;

my $mw = new MainWindow();

$mw->Label ( -text => "Just do it" ) 
	->pack ( -side => "top" ) ;

$mw->Label ( -text => 'One:' ) ->pack();
$mw->Entry ( -width => 1 ) ->pack();

$mw->Label ( -text => 'Two:' ) ->pack();
$mw->Entry ( -width => 2 ) ->pack();

$mw->Label ( -text => 'Three:' ) ->pack();
$mw->Entry ( -width => 3 ) ->pack();

MainLoop();

That doesn't work. The preceding produces the following window:
Just do it screen

You could try the following:
#!/usr/bin/perl -w
use strict;
require 5.003;
use Tk;

my $mw = new MainWindow();

$mw->Label ( -text => "Just do it" ) 
	->pack ( -side => "top" ) ;

$mw->Label ( -text => 'One:' ) ->pack ( -side => "left" ) ;
$mw->Entry ( -width => 1 ) ->pack ( -side => "left" ) ;

$mw->Label ( -text => 'Two:' ) ->pack ( -side => "left" ) ;
$mw->Entry ( -width => 2 ) ->pack ( -side => "left" ) ;

$mw->Label ( -text => 'Three:' ) ->pack ( -side => "left" ) ;
$mw->Entry ( -width => 3 ) ->pack ( -side => "left" ) ;

MainLoop();
But all those left alignments produce a completely horizontal screen:
All left alignment screen

By the way, if you placed empty Frames with -padx values before the second and third prompts, this would actually produce a good looking screen. But not a nice vertical ladder like users are accustomed to.

What about aligning the prompts to the top and the fields to the left, as shown in the code below?

#!/usr/bin/perl -w
use strict;
require 5.003;
use Tk;

my $mw = new MainWindow();

$mw->Label ( -text => "Just do it" ) 
	->pack ( -side => "top" ) ;

$mw->Label ( -text => 'One:' ) ->pack ( -side => "top" ) ;
$mw->Entry ( -width => 1 ) ->pack ( -side => "left" ) ;

$mw->Label ( -text => 'Two:' ) ->pack ( -side => "top" ) ;
$mw->Entry ( -width => 2 ) ->pack ( -side => "left" ) ;

$mw->Label ( -text => 'Three:' ) ->pack ( -side => "top" ) ;
$mw->Entry ( -width => 3 ) ->pack ( -side => "left" ) ;

MainLoop();

The preceding code produces the following, truly ugly and useless screen:
Top aligned prompts with left aligned Entry fields

You might think that changing the lefts to rights would improve things, but try it -- it doesn't. You, my friend, are in desperate need of frames. Read on...

You could go through 20 more bogus tries, but the following code is the right way to do this exercise:

#!/usr/bin/perl -w
use strict;
require 5.003;
use Tk;

my $mw = new MainWindow();

$mw->Label ( -text => "Just do it" ) 
	->pack ( -side => "top" ) ;

my $fleft=$mw->Frame()->pack ( -side => 'left' ) ;
my $fright=$mw->Frame()->pack ( -side => 'right' ) ;

$fleft->Label ( -text => 'One:' ) ->pack ( -side => "top" , -anchor => 'e' ) ;
$fright->Entry ( -width => 1 ) ->pack ( -side => "top" , -anchor => 'w' ) ;

$fleft->Label ( -text => 'Two:' ) ->pack ( -side => "top" , -anchor => 'e' ) ;
$fright->Entry ( -width => 2 ) ->pack ( -side => "top" , -anchor => 'w' ) ;

$fleft->Label ( -text => 'Three:' ) ->pack ( -side => "top" , -anchor => 'e' ) ;
$fright->Entry ( -width => 3 ) ->pack ( -side => "top" , -anchor => 'w' ) ;

MainLoop();

We start with the label at the top, but then divide the screen into a left and right frame. The left frame will contain the prompts, and the right frame will contain the Entry widgets. Each widget is -side=>'top' so they stack vertically within their frames. Because we want the prompts right justified, we set them -anchor=>'e'. The Entry widgets must be left justified, so they're configured as -anchor=>'w'. The result is very pleasing, as follows:
Solution: 3 vertical prompt/Entry fields

As a learning exercise, you might want to fool around with this some more. Try removing the -anchor properties, and note that the prompts and the Entry widgets are centered within their frame, producing an ugly screen.

Challenge 2: A grid

The challenge is to do something like the following HTML table, but do it within Perl-Tk:

Revenue by Year and Quarter (Millions)

Year
 CEO
 Q1
 Q2
 Q3
 Q4
 Total
2000
 Grant
 50.50
 50.00
 39.50
 60.00
 200.00
2001
 Fredrickson
 30.50
 29.50
 20.00
 40.00
 120.00
2002
 Sizemore
 20.00
 30.00
 20.25
 29.75
 100.00
2003
 Yu
 25.00
 25.00
 20.00
 40.00
 110.00

The items in gray are Entry widgets, and those not in gray are prompts. You'll notice that the CEO and Total columns are wider than the others. This can be a lineup nightmare. But if you know how to do it, it's quick and easy. I created this screen in about a half hour:

A grid screen

A half hour is more than the 5 minutes it would have taken with VB, but in the overall development time budget, it's quite affordable. And the result is  portable. Anyway, the preceding screen was created with the following code:

#! /usr/bin/perl -w

require 5.003 ;
use strict;
use Tk;

my $mw = new MainWindow();
$mw->title ( "Revenue by Year and Quarter" ) ;

$mw->Label ( -text => "Revenue by Year and Quarter ( Millions ) " ) 
	->pack ( -side => "top" , -anchor => 'center' ) ;

my $fgrid = $mw->Frame()->pack ( -side => 'top' ) ;

my $fyear = $fgrid->Frame()->pack ( -side => 'left' , -padx => 4 ) ;
my $fceo = $fgrid->Frame()->pack ( -side => 'left' , -padx => 4 ) ;
my $fq1 = $fgrid->Frame()->pack ( -side => 'left' , -padx => 4 ) ;
my $fq2 = $fgrid->Frame()->pack ( -side => 'left' , -padx => 4 ) ;
my $fq3 = $fgrid->Frame()->pack ( -side => 'left' , -padx => 4 ) ;
my $fq4 = $fgrid->Frame()->pack ( -side => 'left' , -padx => 4 ) ;
my $ftotal = $fgrid->Frame()->pack ( -side => 'left' , -padx => 4 ) ;

$fyear->Label ( -text => 'Year' ) 
	->pack ( -side => 'top' , -anchor => 'e' ) ;
$fyear->Label ( -text => '2000' ) 
	->pack ( -side => 'top' , -anchor => 'e' ) ;
$fyear->Label ( -text => '2001' ) 
	->pack ( -side => 'top' , -anchor => 'e' ) ;
$fyear->Label ( -text => '2002' ) 
	->pack ( -side => 'top' , -anchor => 'e' ) ;
$fyear->Label ( -text => '2003' ) 
	->pack ( -side => 'top' , -anchor => 'e' ) ;

$fceo->Label ( -text => 'CEO' ) 
	->pack ( -side => 'top' , -anchor => 'w' ) ;
my $ceo2000 = $fceo->Entry ( -width => 14 , -justify => 'left' ) 
	->pack ( -side => 'top' , -anchor => 'w' ) ;
my $ceo2001 = $fceo->Entry ( -width => 14 , -justify => 'left' ) 
	->pack ( -side => 'top' , -anchor => 'w' ) ;
my $ceo2002 = $fceo->Entry ( -width => 14 , -justify => 'left' ) 
	->pack ( -side => 'top' , -anchor => 'w' ) ;
my $ceo2003 = $fceo->Entry ( -width => 14 , -justify => 'left' ) 
	->pack ( -side => 'top' , -anchor => 'w' ) ;

$fq1->Label ( -text => 'Q1' ) 
	->pack ( -side => 'top' , -anchor => 'e' ) ;
my $q12000 = $fq1->Entry ( -width => 6 , -justify => 'right' ) 
	->pack ( -side => 'top' , -anchor => 'e' ) ;
my $q12001 = $fq1->Entry ( -width => 6 , -justify => 'right' ) 
	->pack ( -side => 'top' , -anchor => 'e' ) ;
my $q12002 = $fq1->Entry ( -width => 6 , -justify => 'right' ) 
	->pack ( -side => 'top' , -anchor => 'e' ) ;
my $q12003 = $fq1->Entry ( -width => 6 , -justify => 'right' ) 
	->pack ( -side => 'top' , -anchor => 'e' ) ;


$fq2->Label ( -text => 'Q2' ) 
	->pack ( -side => 'top' , -anchor => 'e' ) ;
my $q22000 = $fq2->Entry ( -width => 6 , -justify => 'right' ) 
	->pack ( -side => 'top' , -anchor => 'e' ) ;
my $q22001 = $fq2->Entry ( -width => 6 , -justify => 'right' ) 
	->pack ( -side => 'top' , -anchor => 'e' ) ;
my $q22002 = $fq2->Entry ( -width => 6 , -justify => 'right' ) 
	->pack ( -side => 'top' , -anchor => 'e' ) ;
my $q22003 = $fq2->Entry ( -width => 6 , -justify => 'right' ) 
	->pack ( -side => 'top' , -anchor => 'e' ) ;

$fq3->Label ( -text => 'Q3' ) 
	->pack ( -side => 'top' , -anchor => 'e' ) ;
my $q32000 = $fq3->Entry ( -width => 6 , -justify => 'right' ) 
	->pack ( -side => 'top' , -anchor => 'e' ) ;
my $q32001 = $fq3->Entry ( -width => 6 , -justify => 'right' ) 
	->pack ( -side => 'top' , -anchor => 'e' ) ;
my $q32002 = $fq3->Entry ( -width => 6 , -justify => 'right' ) 
	->pack ( -side => 'top' , -anchor => 'e' ) ;
my $q32003 = $fq3->Entry ( -width => 6 , -justify => 'right' ) 
	->pack ( -side => 'top' , -anchor => 'e' ) ;


$fq4->Label ( -text => 'Q4' ) 
	->pack ( -side => 'top' , -anchor => 'e' ) ;
my $q42000 = $fq4->Entry ( -width => 6 , -justify => 'right' ) 
	->pack ( -side => 'top' , -anchor => 'e' ) ;
my $q42001 = $fq4->Entry ( -width => 6 , -justify => 'right' ) 
	->pack ( -side => 'top' , -anchor => 'e' ) ;
my $q42002 = $fq4->Entry ( -width => 6 , -justify => 'right' ) 
	->pack ( -side => 'top' , -anchor => 'e' ) ;
my $q42003 = $fq4->Entry ( -width => 6 , -justify => 'right' ) 
	->pack ( -side => 'top' , -anchor => 'e' ) ;


$ftotal->Label ( -text => 'Total' ) 
	->pack ( -side => 'top' , -anchor => 'e' ) ;
my $total2000 = $ftotal->Entry ( -width => 6 , -justify => 'right' ) 
	->pack ( -side => 'top' , -anchor => 'e' ) ;
my $total2001 = $ftotal->Entry ( -width => 6 , -justify => 'right' ) 
	->pack ( -side => 'top' , -anchor => 'e' ) ;
my $total2002 = $ftotal->Entry ( -width => 6 , -justify => 'right' ) 
	->pack ( -side => 'top' , -anchor => 'e' ) ;
my $total2003 = $ftotal->Entry ( -width => 6 , -justify => 'right' ) 
	->pack ( -side => 'top' , -anchor => 'e' ) ;

MainLoop();

The preceding code looks complex, but it's actually pretty simple and easy to do. First we created the main window and its title, and at the top placed a label with a title right on the window itself. Next we created a frame to hold the grid. In this simple example this frame isn't necessary, but in real screens it's likely that grid wouldn't be the only thing on the screen, and you don't want layout inside the grid to affect those other fields. So you make a frame to contain the entire grid.

Next we divide the grid into columns by creating a frame for each column. All the columns are -side=>'left' so they line up from left to right. We also pack them with -padx=>4 so that the columns have a slight separation horizontally.

Each column will have exactly 5 rows. The first row is a header showing labels, while the next 4 contain Entry widgets, except that the leftmost column is all labels. No problem. Each of the 5 column frames is the same height because they each consume all height of the grid frame. Because each is the same height, and that height is divided by 5, the rows line up very well. If you look closely, you'll see that in the left column the labels are a little too low near the top and a little too high near the bottom, but this is a minor inconvienience considering the portability yielded by Tk.

For each column we create a label on top, and then 4 fields. The column headers for numeric fields have -anchor=>'e' to right justify them, while the column headers for non-numeric fields are -anchor=>'w' to left justify them. I considered the year numeric, but you could just as easily consider it text, or you could have centered its header.

Each of the 4 fields is packed -side='top' so they fall in order. They're packed -anchor='e' for numeric fields and 'w' for non numerics. In this case that is not necessary, but some grid layouts feature different length fields within a single column, and in such a case aesthetics would dictate justifying the fields. Each field has a -width property, and all the numeric fields are -justify='right'. That's different from right packing, in that the field justification determines where the entered characters fall within the field, not where the field falls within its container.

Finally, MainLoop() is called.

The preceding might seem difficult, but in fact it's easy. I don't have a lot of experience with Perl Tk and it took me less than 1/2 hour. For someone who uses Perl Tk every day, if that person is productive with Vim, he or she just might be able to match the 5 minutes that task would have taken in VB. Most of the task turned out to be Vim cut and paste, and Vim substitutions (search and replace), combined with occasionally running the program to verify I hadn't done anything strange.

Debugging Frames

On complex screens, frames can become confusing and disorienting. One problem is that you don't know where one frame stops and another ends. This problem can quickly be fixed by temporarily giving each frame a different color. Then, when you look at the screen, each frame's borders are instantly obvious.

Keep in mind, however, that the colors of widgets, even labels, overwrite the color of the frame containing them. So the frame coloring technique works best before widgets are installed. But even afterward, the frame background color will show you any unused portions of frames, which is often just what's needed.

It's often handy to color the background of a frame containing other frames. That will make things much more obvious. So for the grid example, you might turn $fgrid white:
my $fgrid = $mw->Frame(-background=>'#FFFFFF')->pack(-side=>'top');
How do things work when frames collide? Here's a screenshot in which declarations are, in order, top label, then a top frame, then a left frame, then a bottom frame, and then a right frame.

Frame experiment screenshot

All frames are filled with subframes so as to take up their entire side, if allowed. The first one does indeed take up its entire side, the top. The next one takes up all of the left except what already was taken up by the top. The third takes up all of the bottom except what was taken up by the left. The fourth takes up all the right not already claimed by the top and bottom.

It's first come, first serve. Keep that in mind when laying out a screen.

The following is the code that produced the preceding screen: 
#! /usr/bin/perl -w

require 5.003 ;
use strict;
use Tk;

my $mw = new MainWindow();
$mw->geometry ( '640x400' ) ;
$mw->title ( "Frame experiment" ) ;

$mw->Label ( -text => "Frame experiment" ) 
	->pack ( -side => "top" , -anchor => 'center' ) ;

my $f1 = $mw->Frame ( -background => '#FF0000' )
	->pack ( -side => 'top' ) ;
$f1->Frame()->pack ( -padx => 600 , -pady => 60 ) ;

my $f2 = $mw->Frame ( -background => '#00FF00' )
	->pack ( -side => 'left' ) ;
$f2->Frame()->pack ( -padx => 60 , -pady => 600 ) ;

my $f3 = $mw->Frame ( -background => '#0000FF' )
	->pack ( -side => 'bottom' ) ;
$f3->Frame()->pack ( -padx => 600 , -pady => 60 ) ;

my $f4 = $mw->Frame ( -background => '#00FFFF' )
	->pack ( -side => 'right' ) ;
$f4->Frame()->pack ( -padx => 60 , -pady => 600 ) ;

MainLoop();

Starting with the preceding code, try lots of your own experiments until you have a feel for how successively declared frames lay out inside a container.

Is this too much hassle?

If you're coming from a Clarion, Powerbuilder, Delphi or VB environment, the preceding must look hopelessly combersome to you. You're used to simply laying out screens, and if you need to change them, you just drag things around. No worrying about frames, or first come first serve, or insertion of an element causing others to move. Perl Tk must seem like a joke to you.

Just keep in mind that the worst experience you'll have with Perl Tk is your first one. It will continuously get better from there. I'm already seeing where I can imagine a screen layout in my head, and get pretty close my first time by sectioning the available window into frames. And through the marvels of VI cut and paste and search and replace, layout and changes are getting quicker for me all the time.

And speaking of VI, the first time I used it I hated it so much I devised a batch file to download the file from the HP9000, edit it in notepad, and upload it again. As time went on I saw the speed and value in VI, and today VI is my main editor. Same with Perl Tk layout -- if you give it a chance it will become second nature.
Steve Litt is the author of " Troubleshooting Techniques of the Successful Technologist".  Steve can be reached at Steve Litt's email address .

Text, Listbox and Scrollbar Widgets

By Steve Litt
We've discussed the MainWindow, Label, Frame and Entry widgets, which are the mainstays of data entry forms. But occasionally you need to enter word wrapped freeform text, and occasionally you need to manage lists. The Text and ListBox widgets facilitate freeform text and lists respectively.

Because these widgets often manage data that exceeds their screen real estate, they're often fitted with scrollbars -- horizontal, vertical, or both. This is accomplished with the Scrollbar widget, or by the Scrolled method, which produces one or more Scrollbar widgets associated with a Text or Listbox widget.

This article provides a brief overview of the Text, Listbox, Scrollbar and Scrolled widgets. After reading this article you'll be able to create simple data forms with these widgets. However, complete mastery of these widgets would take more documentation than is contained in the entirety of this magazine.

The purpose of this article is to get you up and running with practical applications of these widgets. So armed, you can use Perl Tk documentation and experimentation to attain mastery.

The Text Widget

The Text widget is used for entry and display of multiline data. The Text widget can be constrained as to the number of characters wide, and the number of lines high. If the text exceeds those dimensions, you can navigate through the text with the cursor keys and PgUP, PgDown, Home and End.

You can also specify the type of word wrap to use with your Text widget. Possible types are "word", "char" and "none". Selecting "none" means the only wrap occurs where there is a newline in the text. Selecting "word" specifies that your Text widget wraps the text on word boundaries. Selecting "char" specifies that your text wraps on any character occurring at the maximum width specified for the Text widget.

Like the Entry widget, you can retrieve, insert and delete text:

Functionality
 Method
Retrieving text
 $myTextWidget->get(index1, index2);
Inserting text
 $myTextWidget->insert(index);
Deleting text $myTextWidget->delete(index1, index2);

In the preceding, the index arguments are specially formed strings. You could write a thesis on these indices, but you can get started with just two:
The 'line.char' form specifies the line as a 1 based index, while the char is 0 based, so the front of the field is specified as '1.0'. The 'End' form specifies the end of the data.

The following code is a very simple example of creating and populating a Text widget:

#! /usr/bin/perl -w

require 5.003 ;
use strict;
use Tk;

########################################
# MAKE WINDOW , FRAME , AND TEXT BOX
#
my $title = "Text box";

my $mw = new MainWindow;
$mw->title ( $title ) ;

$mw->Label ( -text => $title )
	->pack ( -side => 'top' , -anchor => 'center' ) ;

my $text = $mw->Text ( -wrap => 'none' ) ;

$text->configure ( -height => 8 , -width => 40 ) ;

########################################
# POPULATE TEXT BOX
#
for ( my $j = 0; $j < 30; $j++ ) 
	{ 
	for ( my $i = 0; $i < 100; $i++ ) 
		{ 
		$text->insert ( 'end' , $j*100+$i ) ;
		$text->insert ( 'end' , " " ) ;
		} 
	$text->insert ( 'end' , "\n" ) unless $j == 29;
	} 

########################################
# SHOW THE WINDOW
#
$text->pack();
$text->yviewMoveto ( 1 ) ;
$text->xviewMoveto ( 1 ) ;
$text->focus();

MainLoop;

The preceding code starts by creating a window, then creating a text field 8 lines high by 40 characters long. Next it populates that text box with 30 lines of 100 numbers. Next it packs the text box (it could have done that before, but this is preparation for scrollbars. Finally, it moves to the very end of the text, sets focus to the text box, and then runs the screen.

The Scrollbar Widget

The preceding is a nice demo, but a real text box would have scrollbars. The following program adds scrollbars to the text box in the preceding code, and places both the text box and the scrollbars in a frame. That's necessary because a real input screen would feature many input fields, and you want to group the scrollbars with the text box on which they operate. So here's the code:

#! /usr/bin/perl -w

require 5.003 ;
use strict;
use Tk;

########################################
# MAKE WINDOW , FRAME , AND TEXT BOX
#
my $title = "Text box with scrollbars";

my $mw = new MainWindow;
$mw->title ( $title ) ;

$mw->Label ( -text => $title )
	->pack ( -side => 'top' , -anchor => 'center' ) ;

my $tf = $mw->Frame();

my $text = $tf->Text ( -wrap => 'none' ) ;
$text->configure ( -height => 8 , -width => 40 ) ;

########################################
# POPULATE TEXT BOX
#
for ( my $j = 0; $j < 30; $j++ ) 
	{ 
	for ( my $i = 0; $i < 100; $i++ ) 
		{ 
		$text->insert ( 'end' , $j*100+$i ) ;
		$text->insert ( 'end' , " " ) ;
		} 
	$text->insert ( 'end' , "\n" ) unless $j == 29;
	} 

########################################
# CREATE AND INTEGRATE SCROLLBARS
#
my $scrollx = $tf->Scrollbar (
	-orient => 'horizontal' ,
	-command => [ 'xview' => $text ]
	) ;

my $scrolly = $tf->Scrollbar (
	-orient => 'vertical' ,
	-command => [ 'yview' => $text ]
	) ;

$text->configure (
	-xscrollcommand => [ 'set' , $scrollx ] ,
	-yscrollcommand => [ 'set' , $scrolly ]
	) ;

########################################
# PACK SCROLLBARS AND TEXT BOX
#
$scrolly->pack ( -side => 'right' , -fill => 'y' ) ;
$scrollx->pack ( -side => 'bottom' , -fill => 'x' ) ;
$text->pack();
$tf->pack();

########################################
# SHOW THE WINDOW
#
$text->yviewMoveto ( 1 ) ;
$text->xviewMoveto ( 1 ) ;
$text->focus();
MainLoop;

The preceding code places a text box inside a frame called $tf. It then populates the box. Now comes the scrollbar magic.

There are two Scrollbar widgets, $scrollx and $scrolly. Let's investigate the code for the horizontal scrollbar:
my $scrollx = $tf->Scrollbar(      # instantiate Scrollbar widget
  -orient=>'horizontal',           # scrollbar is horizontal, not vertical
  -command => ['xview' => $text]   # set the Scrollbar widget's callback
  );
The setting of the callback might look a little complex, but it's the same as the OOP callbacks studied in the Callbacks in an OOP Program article
before.

With one exception. In that article, the first argument was the current object. In the case of the scrollbar, that first argument is the Text widget. What's happening is that the callback is the Text widget's xview() method, which returns a reference to an array containing the amount of vertical text off the text box on the left.

The next line defines the text box's scroll commands in the x and y direction. Basically, they move the scrollbars when the text is scrolled. So the Scrollbar callbacks call methods in the Text widget, and the -xscrollcommand and -yscrollcommand call methods in the Scrollbar widgets. The bottom line is that when one is moved, the other moves.

After all callbacks are defined, the elements must be packed. You notice they were not packed earlier. That's because packing is first come first serve, and you want the scrollbars packed before the Text widget, or the Text widget will go all the way to the end and squeeze out one of the scrollbars. So the scrollbars are packed first, and then the Text widget is packed, and when that happens, it takes up all space not already taken by the scrollbars.

The Scrolled Method

The preceding code was complex and unnecessary because it can be done more simply with the Scrolled method. The Scrolled method automatically associates one or more Scrollbar widgets wit the Text or Listbox widgets, doing the callback configuration for you, thereby resulting in much simpler code. Further simplifying the code is the elimination of the need to carefully control the pack order of the text box and scrollbars. The result is dramatically simpler code, as follows:

#! /usr/bin/perl -w

require 5.003 ;
use strict;
use Tk;

########################################
# MAKE WINDOW , FRAME , TEXT BOX and IMPLICIT SCROLLBARS
#
my $title = "Text box with Scrolled widget";

my $mw = new MainWindow;

$mw->title ( $title ) ;

$mw->Label ( -text => $title )
	->pack ( -side => 'top' , -anchor => 'center' ) ;

my $tf = $mw->Frame()->pack();

my $text = $tf->Scrolled ( 'Text' , -scrollbars => 'se' , -wrap => 'none' ) ;
$text->configure ( -height => 8 , -width => 40 ) ;
$text->pack();

########################################
# POPULATE TEXT BOX
#
for ( my $j = 0; $j < 30; $j++ ) 
	{ 
	for ( my $i = 0; $i < 100; $i++ ) 
		{ 
		$text->insert ( 'end' , $j*100+$i ) ;
		$text->insert ( 'end' , " " ) ;
		} 
	$text->insert ( 'end' , "\n" ) unless $j == 29;
	} 

########################################
# SHOW THE WINDOW
#
$text->focus();
$text->yviewMoveto ( 1 ) ;
$text->xviewMoveto ( 1 ) ;
MainLoop;

The preceding code creates the same window as the hand coded scrollbars, without the need for that hand coding. The entire linkage between Text widget and Scrollbars is contained in the following line:
my $text = $tf->Scrolled('Text', -scrollbars=>'se', -wrap=>'none')->pack();
The Scrolled() method of any container returns an object of the type specified in its first argument. The -scrollbars specifies scrollbar locations, where n, s, e and w stand for directions. In the preceding, 'se' means put the horizontal scrollbar on the bottom (south), and the vertical scrollbar on the right (west). For either scrollbar, you can specify that it doesn't show unless necessary, by placing the letter 'o' before the direction letter of the scrollbar that's shows only when necessary. If both scrollbars are intended to operate that way, place the 'o' before each direction letter.

So unless you have a VERY good reason to do otherwise, always use the Scrolled widget rather than hand crafting Scrollbar widgets.

The Listbox widget

As mentioned in the Editor's Desk article, I miss Clarion 2.1. One of its best features was the Picklist-Form-Picklist paradigm. You'd get a list of records from the database, pick the one to edit, and get a form to edit it (or if you had picked insert, a blank for, or a confirmation form if you chose to delete). Better yet, any form fields that themselves were rows in the database could trigger a picklist, and so on. The result was extremely intuitive and very fast for operators.

Duplicating such behavior requires the ability to populate a picklist, and the ability to act on the user's choice. Data driven picklists should always have vertical scrollbars, because you never know how much data will appear.

Populating a picklist is trivial -- it's populated from an array. You choose an element in the picklist with the mouse, or with the computer's arrow keys. Unfortunately, the default Listbox widget has no -command=> or other user event handling. One way to build a picklist would be a combination of Listbox and OK button, where the user first picks the choice from the Listbox, and then clicks Enter or tabs to Enter and then presses Enter. Unfortunately, users are not forgiving of time consuming and confusing double keystrokes.

So we'll harness the power of Perl Tk to build a picklist with no buttons, that responds either to a doubleclick of a list element, or to pressing the Enter key on that element. And since we're at it, we'll associate the Escape key with terminating the screen. You can see how it's done in the three bind() calls in the following code.

So without further wait, here's the code to send your choice to STDOUT:

#! /usr/bin/perl -w

require 5.003 ;
use strict;
use Tk;

my @globalListContents = ( 'zero' , 'one' , 'two' , 'three' , 'four' ) ;

############################################################
# printPick PRINTS THE USER'S CHOICE
#
sub printPick ( $ ) 
	{ 
	my $list = $_ [ 0 ] ;
	my $ss = $list->curselection();
	print $ss;
	print "   ";
	print $globalListContents [ $ss ] ;
	print "\n";
	} 

############################################################
# MAIN ROUTINE
#
my $title = "Listbox example";

my $mw = new MainWindow;
$mw->title ( $title ) ;

$mw->Label ( -text => $title )
	->pack ( -side => 'top' , -anchor => 'center' ) ;

########################################
# CREATE LISTBOX
#
my $list = $mw->Scrolled ( 'Listbox' , -scrollbars => 'osoe' ) ;
$list->configure ( -height => 8 , -width => 40 ) ;
$list->configure ( -selectmode => "browse" ) ;
$list->pack();

########################################
# POPULATE LISTBOX
#
$list->insert ( 0 , @globalListContents ) ;

########################################
# MAKE SPECIAL EVENT FOR PICKLIST
#
$list->bind ( '<Return>' , [ \&printPick , $list ] ) ;
$list->bind ( '<Double-ButtonPress-1>' , [ \&printPick , $list ] ) ;
$list->bind ( '<Escape>' , sub { $mw->destroy(); } ) ;

########################################
# SHOW THE WINDOW
#
$list->focus();
MainLoop();

The preceding methods can be used to create a generic picklist function. You send an array of list items to the function, which throws up a picklist. When the user selects an item, the zero based subscript is returned, which can then be used with the original data source to look up the proper record. The source code follows:

#! /usr/bin/perl -w
require 5.003 ;
use strict;
use Tk;

############################################################
# PICKLIST SUBROUTINE
#
sub picklist ( $;$$$$ ) 
	{ 
	########################################
	# ACQUIRE ARGUMENTS AND DEFAULT RETURN VALUE
	#
	my ( $listref , $title , $mw , $height , $width ) = @_;
	my @listContents = @ { $listref } ;
	my $return = -999;

	########################################
	# DEFAULT OPTIONAL ARGUMENTS
	#
	unless ( defined ( $height )  ) 
		{ 
		$height = $#listContents;
		if ( $height > 30 ) { $height = 30; } 
		} 

	unless ( defined ( $width )  ) 
		{ 
		$width=1;	
		foreach my $line ( @listContents ) 
			{ 
			chomp ( $line ) ;
			my $temp = length ( $line ) ;
			if ( $temp > $width ) { $width = $temp; } 
			} 
		if ( $width > 90 ) { $width = 90; } 
		} 

	$title = "Pick one" unless defined ( $title ) ;

	########################################
	# SET UP WINDOW
	#
	my $tlw;

	if ( defined ( $mw )  ) 
		{ 
		$tlw = $mw->Toplevel();
		} 
	else
		{ 
		$tlw = MainWindow->new();
		} 
	
	$tlw->title ( $title ) ;

	$tlw->Label ( -text => $title )
		->pack ( -side => 'top' , -anchor => 'center' ) ;

	my $list = $tlw->Scrolled ( 'Listbox' , -scrollbars => 'osoe' );
	$list->configure ( -height => $height , -width => $width ) ;
	$list->configure ( -selectmode => "browse" ) ;
	$list->pack();

	########################################
	# POPULATE LISTBOX
	#
	$list->insert ( 0 , @listContents ) ;
	$list->activate ( 0 ) ;
	$list->selectionSet ( 0 ) ;

	########################################
	# MAKE SPECIAL EVENT FOR PICKLIST
	#
	$list->bind ( '<Return>' , sub { 
		$return = $list->curselection();
		;$tlw->destroy()
		} ) ;

	$list->bind ( '<Double-ButtonPress-1>' , sub { 
		$return = $list->curselection();
		;$tlw->destroy()
		} ) ;

	$list->bind ( '<Escape>' , sub { $tlw->destroy(); } ) ;

	########################################
	# SHOW THE WINDOW
	#
	$list->focus();
	$tlw->grab();
	$tlw->waitWindow();

	########################################
	# RETURN THE CHOICE
	#
	unless ( defined ( $return )  ) { $return = -1; } 
	return ( $return ) ;
	} 


############################################################
# LAUNCHPICKLIST SUBROUTINE TURNS PICKLIST INDEX INTO A STRING FOR DISPLAY
#
sub launchPicklist ( $$$ ) 
	{ 
	my $result = picklist ( $_[ 0 ] , $_[ 1 ] , $_[ 2 ] ) ;
	if ( $result < 0 ) 
		{ 
		return "User declined to choose.";
		} 
	else
		{ 
		return "$result -- $_[ 0 ]->[ $result ] ";
		} 
	} 

############################################################
# MAIN ROUTINE
#
my @list = ( 'zero' , 'one' , 'two' , 'three' , 'four' ) ;
my $title = "Demo of Picklist Function";

my $mw = MainWindow->new();
$mw->title ( $title ) ;

$mw->Label ( -text => $title ) 
	->pack ( -side => 'top' , -anchor => 'center' ) ;

my $labelResult = $mw->Label ( -text => "" ) 
	->pack ( -side => 'top' , -anchor => 'center' ) ;

$mw->Button ( 
	-text => " Cancel " , 
	-command => sub { $mw->destroy(); } 
	) ->pack ( -side => 'right' , -anchor => 'sw' ) ;

$mw->Button ( 
	-text => " OK " , 
	-command => sub { 
		my $text = launchPicklist ( \@list , "Pick One..." , $mw );
		$labelResult->configure ( -text => $text  ) }
		) ->pack ( -side => 'right' , -anchor => 'sw' ) ;

MainLoop();

In the preceding code, $list is a Listbox with scrollbars. We've set bindings for $list so either the Enter key or a doubleclick sends the selection to STDOUT (the screen that originally ran the program), via function printPick(). We've bound the Escape key to exit without printing anything.

Next month's Linux Productivity Magazine, Perl TK, Part 2, will embed these techniques in a generic Picklist object callable from Specially created Entry widgets.
Steve Litt is the author of " Troubleshooting Techniques of the Successful Technologist".  Steve can be reached at Steve Litt's email address .

Timer Basics

By Steve Litt
Before showing you the speech timer app, you need to know a little bit about timing in Perl. Perl uses the Time::HiRes module, which probably comes standard with your Perl distribution. If it didn't, you can either upgrade to Perl 5.8 or better, or you can download Time::HiRes from CPAN (www.cpan.org) and integrate it into your existing Perl. The Time::HiRes module gives you the following functionalities:

Function
 Description
gettimeofday () Returns a 2 element array. Element 0 is the seconds since epoch. Element 1 is the microseconds on the system clock. To assign it to a normal array, do the following:
my @time = gettimeofday();
In a scalar context it returns a printable string of the seconds since epoch, then a decimal point, then the number of microseconds.

However, most of the Time::HiRes functions require neither an array, nor a string, but instead a reference to the array as an argument. You could either assign the return to an array and then put a reference to that array into an argument, or you can use the array reference shorthand to assign the array reference directly to a variable:
my $timeref = [gettimeofday()];
In fact, the preceding is the syntax you'll see used most with the Time::HiRes functions.
usleep ( $useconds ) This sleeps for the number of microseconds in its argument
ualarm ( $useconds [, $interval_useconds ] ) Very similar to settimer()
tv_interval, time () This calculates the interval between the earlier time (the first argument) and the later time (the second argument). Both arguments must be references to arrays of the form discussed in the gettimeofday() discussion earlier in this table.
sleep ( $floating_seconds ) Once you've incorporated Time::HiRes, the sleep() function can take a floating point number. So you can sleep 0.791 or 3.14 seconds.
alarm ( $floating_seconds [, $interval_floating_seconds ] ) Very similar to settimer()
setitimer ( $which, $floating_seconds [, $interval_floating_seconds ] ) Sets one of several predefined timers. On count down to 0, delivers a signal. If the interval is non-zero, after sending the signal the timer re-arms itself with the time designated by the interval, and counts down again...
getitimer ( $which ) Returns the time remaining on the timer, and in the list context, returns both the remaining time and the interval of the timer.

I'm not going to use the timers or alarms.

One way to make a countup timer is the DOS way -- make a loop that checks intervals on every iteration. DOS was a single tasking OS, so it didn't matter if you consumed your CPU timing. Linux is multiuser and multitasking, so burning up CPU cycles just to make a timer is considered rude. Fortunately, Linux has the sleep() function which, without consuming CPU cycles, stops for the proscribed interval.

There are probably a million ways to make an efficient timer, but one way to do it is to determine the sleep time based on how long it will be until the next second boundary. That way, most of the time you have the CPU efficiency of long sleep times, but near the second boundary you get the accuracy of short sleep times:

Let's take a look at this simple countup timer:

#!/usr/bin/perl -w
use strict;
use Time::HiRes qw( usleep sleep gettimeofday tv_interval);

my $wait;
my $prevSecs = -1;
my $starttime=[gettimeofday()];

while($prevSecs < 10)
	{
	print ".";
	my $elapsed = tv_interval($starttime, [gettimeofday()]);
	my $secs = int($elapsed);
	if($secs > $prevSecs)
		{
		print "$secs,   $elapsed\n";
		$prevSecs = $secs;
		}
	my $remainder = $elapsed - $secs;
	if($remainder < 0.95)
		{
		$wait = .96 + $secs - $elapsed;
		}
	else
		{
		$wait = .001;
		}
	sleep($wait);
	}

The preceding code checks the interval since start, and sees how near that interval is to the next second boundary. If it's more than .05 seconds from the boundary, sleep approximately until .04 seconds til the second boundary. If it's less than .05 seconds until a second boundary, sleep .001 second. On my computer, it can't sleep for such a fine interval anyway, but it cuts it as fine as it can.

I print the dots so you can see how many iterations per second. On my computer, it amounts to three iterations per second -- probably one long interval, and two .01 intervals. In other words, it's very CPU efficient. And yet it's still reasonably accurate. On the second second and beyond, it prints roughly 0.015 seconds after the second boundary, plus or minus maybe 0.002.

The preceding code produces (approximately) the following output:

[slitt@mydesk tut]$ ./jj.pl
.0,   0.000173
...1,   1.004986
...2,   2.015077
...3,   3.015486
...4,   4.01499
...5,   5.015004
...6,   6.015087
...7,   7.01507
...8,   8.015033

[slitt@mydesk tut]$

If you want the ultimate accuracy, you could code it so that the sleep() call is not executed close to the second boundary. This can result in very accurate calls, but also consume huge CPU time unless fine tuned for a specific computer. Here's some code to do that:


#!/usr/bin/perl -w
use strict;
use Time::HiRes qw( usleep sleep gettimeofday tv_interval);

my $wait;
my $prevSecs = -1;
my $starttime=[gettimeofday()];

while($prevSecs < 10)
	{
	print ".";
	my $elapsed = tv_interval($starttime, [gettimeofday()]);
	my $secs = int($elapsed);
	if($secs > $prevSecs)
		{
		print "$secs,   $elapsed\n";
		$prevSecs = $secs;
		}
	my $remainder = $elapsed - $secs;
	if($remainder < 0.98)
		{
		$wait = .99 + $secs - $elapsed;
		sleep($wait);
		}
	}

Once again, the preceding code, while accurate to within a ten thousandth of a second on my computer, could consume a whole lot of CPU on a faster computer, and could possibly result in jitter on a slower one. Also remember that without the sleep() command, the printing of the dot is a major factor in the delay, and if that's removed, performance and behavior will change.

Unless you want the ultimate accuracy, the best thing to do is sleep every time.

And the following is a nice piece of code that's reasonably accurate, and peforms only 2 iterations per second:


#!/usr/bin/perl -w
use strict;
use Time::HiRes qw( usleep sleep gettimeofday tv_interval);

my $wait;
my $prevSecs = -1;
my $starttime=[gettimeofday()];

while($prevSecs < 10)
	{
	print ".";
	my $elapsed = tv_interval($starttime, [gettimeofday()]);
	my $secs = int($elapsed);
	if($secs > $prevSecs)
		{
		print "$secs,   $elapsed\n";
		$prevSecs = $secs;
		}
	my $remainder = $elapsed - $secs;
	if($remainder < 0.90)
		{
		$wait = .91 + $secs - $elapsed;
		}
	else
		{
		$wait = 1 + $secs - $elapsed;
		}
	if($wait > 0) {sleep($wait)};
	}

The preceding first sleeps until somewhere around 0.09 seconds before the time second boundary, and then sleeps until what it hopes will be the exact boundary. Because this code would crash if $wait were negative, we don't sleep unless it's positive.

This same technique will be used in the timer, except that instead of being called within a loop, the wait calculations will be called as a callback function by the Perl Tk code.

Steve Litt documented the Universal Troubleshooting Process. Steve can be reached at Steve Litt's email address.

The Speech Timer Program

By Steve Litt
The speech timer program is a count-up timer that changes colors as time milestones are passed. For instance, for a speech that should be between 4 and 6 minutes, you might configure it to turn green at 4 minutes, yellow at 5 minutes, and red at 6 minutes. If you've ever attended a Toastmasters meeting, this should be a familiar concept.

Because the person speaking has other concerns than watching the clock, the window should be huge so the color changes are obvious. It might be used for a rehearsal, or for a real speech (in Toastmasters, for instance). In the rehersal role the speaker would start and stop the timer. In a real speech timing a person assigned to be a timekeeper would start and stop the timer. In either case, it must be easy to do, meaning a big button that changes from start to stop to reset.

It should be very difficult to accidentally reset, because that would lose the final speech time. Resetting should bring up a configuration screen so there's an opportunity to change the timings for the next speech. And of course, the config screen should come up before the first speech so there's an opportunity to set the timings for the first speech. To facilitate timing the same speech over and over again, the program can be called with the green, yellow and red times as arguments on the command line.

On instantiation, the main window is white, indicating a "standby" state, and the configuration window is on top.. In standby states, the large button is marked "Reset". If the user fills in valid config information on the config screen and clicks the config screen's OK button, the main window turns gray, indicating the clock is in the "ready" state. In the "ready" state, the large button is marked "Start".

When the user clicks the Start button, the screen turns black indicating a "running" state. In the "running" state, the large button is marked "Stop". In the running state, a label shows a count-up clock. When the time passes the green time, the screen turns green. Same with yellow and red.

When the user clicks the Stop button, the count-up clock stops, and the large button becomes smaller and its text changes to "Reset", indicating that the clock is now in the "stopped" state. The main window's colors do not change, because the speaker needs to know the color upon stoppage.

When the user clicks the Reset button, the screen turns white indicating the "standby" state, and the system's state and behavior match what it was on initialization. From there the state loop can be run over and over again.

The speech timer program consists of three classes: the SpeechTimer class, the StConfig class, and the COPYING class.

CLASS
 PURPOSE and SUMMARY DISCUSSION
SpeechTimer Run the timing mechanism and display the main screen with start, stop and reset buttons. Also keeps track of stopwatch screen colors. Initially black, it turns green at the specified green time, yellow at the specified yellow time, and red at the specified red time.

The SpeechTimer gets its configuration information, including green, yellow and red timings, from the StConfig object.
StConfig The StConfig object acquires, holds and discloses configuration information -- specifically the color timings. At instantiation, it looks to the program's command line arguments for timing information, and if it finds such info it stores it. Upon instantiation and every time the SpeechTimer is reset, it displays a screen so the user can input or change existing timings. It has validation logic on each timing field.

The StConfig object also holds and discloses timer status information -- specifically, whether the timer is in the READY, RUNNING, FINISHED or STANDBY state. It contains set and get routines for the timer's status. The proper set and get routines are called by the SpeechTimer object as a result of user's activating the SpeechTimer object's buttons. The SpeechTimer object performs its logic based on state information retrieved from the StConfig object using  get routines.

The StConfig screen performs its duties in an interesting way. Upon the user clicking its OK button, and after validating user input, it calls the SpeechTimer's refresh() routine to update the SpeechTimer object's colors, buttons and text. Probably it would have been wiser to simply terminate the screen and return info sufficient for the SpeechTimer object to refresh itself, but when I wrote this code I didn't know enough about modal windows to do that. Now I do, as you'll see in next month's Linux Productivity Magazine.
COPYING This is a very simple object designed to display the GNU General Public License in a read-only, scrolling text box, with an OK button to return to the screen that called it.


The code is about 1150 lines. Don't let it intimidate you. For one thing, almost 350 lines of that is simply the text of the GNU General Public License, which must accompany the program, unmodified, when you change and/or distribute it. Another 130 lines are comments. Another 204 lines are blank lines designed to make the program more readable. So you're really dealing with about 470 lines of actual code.

These 470 lines of code are divided into three classes, each of which are partitioned into a number of methods. Because most of the Perl Tk techniques used in this program were covered earlier in this LPM issue, all you need in order to understand the problem is to understand the design. In those few cases where new techniques are used, they'll be pointed out.

The rest of this article (after the code listing) discusses the design and the few new techniques. I would highly suggest that before you look at the code, you run it. Simply paste from the code listing into an editor, save it, and run it on any Perl equipped machine (even Windows).

The code listing follows. The following code is licensed under the GNU GPL, so you are free to use it, modify it, redistribute it (with or without modifications) as detailed in the GNU General Public License. Here's the code:

#!/usr/bin/perl -w
# Copyright (C) 2003 by Steve Litt, all rights reserved
# Licensed under the GNU General Public License
#   at http://www.gnu.org/licenses/gpl.txt
#   NO WARRANTY: USE AT YOUR OWN RISK
#
# Version 0.10: Alpha
# Docs for Time::HiRes at http://theoryx5.uwinnipeg.ca/CPAN/data/Time-HiRes/HiRes.html

use strict ;

###############################################################################
# The COPYING object shows the software license, including the complete text of
# the GNU GPL in a scrolling text window.
# 
package COPYING ;
use strict ;
use Tk ;

########################################
# Instantiation routine of the COPYING object
#
sub new
	{ 
	my ( $type ) = $_ [ 0 ] ;
	my ( $self ) = { } ;
	$self-> { 'mw' } = 0 ;
	bless ( $self , $type ) ;
	return ( $self ) ;
	} 

########################################
# runScreen displays a screen with a read-only, scrollable text field
# containing the GNU GPL.
#
sub runScreen ( $$ ) 
	{ 
	my ( $self , $mainWindow ) = @_ ;

	my $tw = $mainWindow->Toplevel() ;
	my $title = "Speech Timer End User Agreement, NO WARRANTY!" ;
	$tw->title ( $title ) ;

	my $topFrame = $tw->Frame()->pack ( -side => 'top' , -fill => 'x' ) ;

	my $okFrame = $topFrame->Frame()->pack ( -side => 'left' , -anchor => 'w' ) ;

	$topFrame->Frame()->pack ( -side => 'left' , -padx => 20 ) ;

	my $titleFrame = $topFrame->Frame()->pack ( -side => 'left' ) ;

	$titleFrame->Label ( -text => $title )
		->pack ( -side => 'top' , -anchor => 'center' ) ;

	$titleFrame->Label ( -text => "Copyright (C) 2003 by Steve Litt, all rights reserved" ) 
		->pack ( -side => 'top' , -anchor => 'center' ) ;

	$titleFrame->Label ( -text => "This software covered under the GNU General Public License" ) 
		->pack ( -side => 'top' , -anchor => 'center' ) ;

	$titleFrame->Label ( -text => "GNU GPL available at http://www.gnu.org/licenses/gpl.txt" ) 
		->pack ( -side => 'top' , -anchor => 'center' ) ;
		
	my $text = $tw->Scrolled ( "Text" , 
		-scrollbars => 'osoe' , 
		-height => 100 , -width => 80 , 
		-background => '#FFFFFF' , 
		-wrap => 'none' ) ;
	$text->insert ( 'end' , $self->getLicense() ) ;
	$text->pack ( -side => 'left' , -pady => 20 ) ;
	$text->configure ( -state => 'disabled' ) ;

	my $butOK = $okFrame->Button ( -text => " OK " , 
		-command => sub { $tw->destroy ; } ) 
		->pack ( -side => 'right' , -anchor => 'e' ) ;
	$butOK->focus();

	MainLoop();
	} 

########################################
# getLicense() returns the text of the GNU GPL as one gigantic string.
#
sub getLicense(){return
"                    GNU GENERAL PUBLIC LICENSE
                       Version 2, June 1991

 Copyright (C) 1989, 1991 Free Software Foundation, Inc.
                       59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 Everyone is permitted to copy and distribute verbatim copies
 of this license document, but changing it is not allowed.

                            Preamble

  The licenses for most software are designed to take away your
freedom to share and change it.  By contrast, the GNU General Public
License is intended to guarantee your freedom to share and change free
software--to make sure the software is free for all its users.  This
General Public License applies to most of the Free Software
Foundation\'s software and to any other program whose authors commit to
using it.  (Some other Free Software Foundation software is covered by
the GNU Library General Public License instead.)  You can apply it to
your programs, too.

  When we speak of free software, we are referring to freedom, not
price.  Our General Public Licenses are designed to make sure that you
have the freedom to distribute copies of free software (and charge for
this service if you wish), that you receive source code or can get it
if you want it, that you can change the software or use pieces of it
in new free programs ; and that you know you can do these things.

  To protect your rights, we need to make restrictions that forbid
anyone to deny you these rights or to ask you to surrender the rights.
These restrictions translate to certain responsibilities for you if you
distribute copies of the software, or if you modify it.

  For example, if you distribute copies of such a program, whether
gratis or for a fee, you must give the recipients all the rights that
you have.  You must make sure that they, too, receive or can get the
source code.  And you must show them these terms so they know their
rights.

  We protect your rights with two steps: (1) copyright the software, and
(2) offer you this license which gives you legal permission to copy,
distribute and/or modify the software.

  Also, for each author\'s protection and ours, we want to make certain
that everyone understands that there is no warranty for this free
software.  If the software is modified by someone else and passed on, we
want its recipients to know that what they have is not the original, so
that any problems introduced by others will not reflect on the original
authors\' reputations.

  Finally, any free program is threatened constantly by software
patents.  We wish to avoid the danger that redistributors of a free
program will individually obtain patent licenses, in effect making the
program proprietary.  To prevent this, we have made it clear that any
patent must be licensed for everyone\'s free use or not licensed at all.

  The precise terms and conditions for copying, distribution and
modification follow.

                    GNU GENERAL PUBLIC LICENSE
   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION

  0. This License applies to any program or other work which contains
a notice placed by the copyright holder saying it may be distributed
under the terms of this General Public License.  The \"Program\", below,
refers to any such program or work, and a \"work based on the Program\"
means either the Program or any derivative work under copyright law:
that is to say, a work containing the Program or a portion of it,
either verbatim or with modifications and/or translated into another
language.  (Hereinafter, translation is included without limitation in
the term \"modification\".)  Each licensee is addressed as \"you\".

Activities other than copying, distribution and modification are not
covered by this License ; they are outside its scope.  The act of
running the Program is not restricted, and the output from the Program
is covered only if its contents constitute a work based on the
Program (independent of having been made by running the Program).
Whether that is true depends on what the Program does.

  1. You may copy and distribute verbatim copies of the Program\'s
source code as you receive it, in any medium, provided that you
conspicuously and appropriately publish on each copy an appropriate
copyright notice and disclaimer of warranty ; keep intact all the
notices that refer to this License and to the absence of any warranty ;
and give any other recipients of the Program a copy of this License
along with the Program.

You may charge a fee for the physical act of transferring a copy, and
you may at your option offer warranty protection in exchange for a fee.

  2. You may modify your copy or copies of the Program or any portion
of it, thus forming a work based on the Program, and copy and
distribute such modifications or work under the terms of Section 1
above, provided that you also meet all of these conditions:

    a) You must cause the modified files to carry prominent notices
    stating that you changed the files and the date of any change.

    b) You must cause any work that you distribute or publish, that in
    whole or in part contains or is derived from the Program or any
    part thereof, to be licensed as a whole at no charge to all third
    parties under the terms of this License.

    c) If the modified program normally reads commands interactively
    when run, you must cause it, when started running for such
    interactive use in the most ordinary way, to print or display an
    announcement including an appropriate copyright notice and a
    notice that there is no warranty (or else, saying that you provide
    a warranty) and that users may redistribute the program under
    these conditions, and telling the user how to view a copy of this
    License.  (Exception: if the Program itself is interactive but
    does not normally print such an announcement, your work based on
    the Program is not required to print an announcement.)

These requirements apply to the modified work as a whole.  If
identifiable sections of that work are not derived from the Program,
and can be reasonably considered independent and separate works in
themselves, then this License, and its terms, do not apply to those
sections when you distribute them as separate works.  But when you
distribute the same sections as part of a whole which is a work based
on the Program, the distribution of the whole must be on the terms of
this License, whose permissions for other licensees extend to the
entire whole, and thus to each and every part regardless of who wrote it.

Thus, it is not the intent of this section to claim rights or contest
your rights to work written entirely by you ; rather, the intent is to
exercise the right to control the distribution of derivative or
collective works based on the Program.

In addition, mere aggregation of another work not based on the Program
with the Program (or with a work based on the Program) on a volume of
a storage or distribution medium does not bring the other work under
the scope of this License.

  3. You may copy and distribute the Program (or a work based on it,
under Section 2) in object code or executable form under the terms of
Sections 1 and 2 above provided that you also do one of the following:

    a) Accompany it with the complete corresponding machine-readable
    source code, which must be distributed under the terms of Sections
    1 and 2 above on a medium customarily used for software interchange ; or,

    b) Accompany it with a written offer, valid for at least three
    years, to give any third party, for a charge no more than your
    cost of physically performing source distribution, a complete
    machine-readable copy of the corresponding source code, to be
    distributed under the terms of Sections 1 and 2 above on a medium
    customarily used for software interchange ; or,

    c) Accompany it with the information you received as to the offer
    to distribute corresponding source code.  (This alternative is
    allowed only for noncommercial distribution and only if you
    received the program in object code or executable form with such
    an offer, in accord with Subsection b above.)

The source code for a work means the preferred form of the work for
making modifications to it.  For an executable work, complete source
code means all the source code for all modules it contains, plus any
associated interface definition files, plus the scripts used to
control compilation and installation of the executable.  However, as a
special exception, the source code distributed need not include
anything that is normally distributed (in either source or binary
form) with the major components (compiler, kernel, and so on) of the
operating system on which the executable runs, unless that component
itself accompanies the executable.

If distribution of executable or object code is made by offering
access to copy from a designated place, then offering equivalent
access to copy the source code from the same place counts as
distribution of the source code, even though third parties are not
compelled to copy the source along with the object code.

  4. You may not copy, modify, sublicense, or distribute the Program
except as expressly provided under this License.  Any attempt
otherwise to copy, modify, sublicense or distribute the Program is
void, and will automatically terminate your rights under this License.
However, parties who have received copies, or rights, from you under
this License will not have their licenses terminated so long as such
parties remain in full compliance.

  5. You are not required to accept this License, since you have not
signed it.  However, nothing else grants you permission to modify or
distribute the Program or its derivative works.  These actions are
prohibited by law if you do not accept this License.  Therefore, by
modifying or distributing the Program (or any work based on the
Program), you indicate your acceptance of this License to do so, and
all its terms and conditions for copying, distributing or modifying
the Program or works based on it.

  6. Each time you redistribute the Program (or any work based on the
Program), the recipient automatically receives a license from the
original licensor to copy, distribute or modify the Program subject to
these terms and conditions.  You may not impose any further
restrictions on the recipients\' exercise of the rights granted herein.
You are not responsible for enforcing compliance by third parties to
this License.

  7. If, as a consequence of a court judgment or allegation of patent
infringement or for any other reason (not limited to patent issues),
conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License.  If you cannot
distribute so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you
may not distribute the Program at all.  For example, if a patent
license would not permit royalty-free redistribution of the Program by
all those who receive copies directly or indirectly through you, then
the only way you could satisfy both it and this License would be to
refrain entirely from distribution of the Program.

If any portion of this section is held invalid or unenforceable under
any particular circumstance, the balance of the section is intended to
apply and the section as a whole is intended to apply in other
circumstances.

It is not the purpose of this section to induce you to infringe any
patents or other property right claims or to contest validity of any
such claims ; this section has the sole purpose of protecting the
integrity of the free software distribution system, which is
implemented by public license practices.  Many people have made
generous contributions to the wide range of software distributed
through that system in reliance on consistent application of that
system ; it is up to the author/donor to decide if he or she is willing
to distribute software through any other system and a licensee cannot
impose that choice.

This section is intended to make thoroughly clear what is believed to
be a consequence of the rest of this License.

  8. If the distribution and/or use of the Program is restricted in
certain countries either by patents or by copyrighted interfaces, the
original copyright holder who places the Program under this License
may add an explicit geographical distribution limitation excluding
those countries, so that distribution is permitted only in or among
countries not thus excluded.  In such case, this License incorporates
the limitation as if written in the body of this License.

  9. The Free Software Foundation may publish revised and/or new versions
of the General Public License from time to time.  Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.

Each version is given a distinguishing version number.  If the Program
specifies a version number of this License which applies to it and \"any
later version\", you have the option of following the terms and conditions
either of that version or of any later version published by the Free
Software Foundation.  If the Program does not specify a version number of
this License, you may choose any version ever published by the Free Software
Foundation.

  10. If you wish to incorporate parts of the Program into other free
programs whose distribution conditions are different, write to the author
to ask for permission.  For software which is cop