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 copyrighted by the Free
Software Foundation, write to the Free Software Foundation ; we sometimes
make exceptions for this.  Our decision will be guided by the two goals
of preserving the free status of all derivatives of our free software and
of promoting the sharing and reuse of software generally.

                            NO WARRANTY

  11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW.  EXCEPT WHEN
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
PROVIDE THE PROGRAM \"AS IS\" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE RISK AS
TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU.  SHOULD THE
PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
REPAIR OR CORRECTION.

  12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGES.

                     END OF TERMS AND CONDITIONS

            How to Apply These Terms to Your New Programs

  If you develop a new program, and you want it to be of the greatest
possible use to the public, the best way to achieve this is to make it
free software which everyone can redistribute and change under these terms.

  To do so, attach the following notices to the program.  It is safest
to attach them to the start of each source file to most effectively
convey the exclusion of warranty ; and each file should have at least
the \"copyright\" line and a pointer to where the full notice is found.

    
    Copyright (C)   

    This program is free software ; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation ; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY ; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program ; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA


Also add information on how to contact you by electronic and paper mail.

If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:

    Gnomovision version 69, Copyright (C) year name of author
    Gnomovision comes with ABSOLUTELY NO WARRANTY ; for details type `show w\'.
    This is free software, and you are welcome to redistribute it
    under certain conditions ; type `show c\' for details.

The hypothetical commands `show w\' and `show c\' should show the appropriate
parts of the General Public License.  Of course, the commands you use may
be called something other than `show w\' and `show c\' ; they could even be
mouse-clicks or menu items--whatever suits your program.

You should also get your employer (if you work as a programmer) or your
school, if any, to sign a \"copyright disclaimer\" for the program, if
necessary.  Here is a sample ; alter the names:

  Yoyodyne, Inc., hereby disclaims all copyright interest in the program
  `Gnomovision\' (which makes passes at compilers) written by James Hacker.

  , 1 April 1989
  Ty Coon, President of Vice

This General Public License does not permit incorporating your program into
proprietary programs.  If your program is a subroutine library, you may
consider it more useful to permit linking proprietary applications with the
library.  If this is what you want to do, use the GNU Library General
Public License instead of this License.
" ;
}

###############################################################################
# The StConfig object acquires, stores and delivers all configuration
# information for this program. At the current time, the only configuration
# information are the green, yellow and red timings. The StConfig object
# acquires timings from the command line (if they are there), and then via a
# Perl Tk screen enables the user to edit the timings. Stored configuration
# information is accessed via get routines.
#
# Because this program is a state machine, states must be stored. The status
# (READY, RUNNING, FINISHED, STOPPED, STANDBY) is stored in the StConfig
# object. However, other states, such as coloration, are stored in the
# SpeechTimer itself.
#
package StConfig ;
use strict ;
use Tk ;
use Tk::DialogBox ;

########################################
# Instantiation routine for StConfig object
#
sub new ( $ ) 
	{ 
	my ( $type ) = $_ [ 0 ] ;
	my ( $self ) = { } ;
	$self-> { 'timer' } = $_ [ 1 ] ;

	$self-> { 'greensecs' } = 0 ;
	$self-> { 'yellowsecs' } = 270 ;
	$self-> { 'redsecs' } = 3960 ;
	$self-> { 'beeponcolorchange' } = 0 ;
	$self-> { 'confwindow' } = 0 ;
	$self-> { 'timerstatus' } = 'FINISHED' ;
	$self-> { 'errmsg' } = '' ;
	$self-> { 'okerrmsg' } = '' ;
	$self-> { 'copying' } = COPYING->new() ;

	bless ( $self , $type ) ;
		
	if ( defined ( $ARGV [ 0 ] ) ) 
		{ 
		$self-> { 'greensecs' } = $self->hhmmss2secs ( $ARGV [ 0 ] ) ;
		} 
	else
		{ 
		$self-> { 'greensecs' } = 0 ;
		} 

	if ( defined ( $ARGV [ 1 ] ) ) 
		{ 
		$self-> { 'yellowsecs' } = $self->hhmmss2secs ( $ARGV [ 1 ] ) ;
		} 
	else
		{ 
		$self-> { 'yellowsecs' } = 0 ;
		} 

	if ( defined ( $ARGV [ 2 ] ) ) 
		{ 
		$self-> { 'redsecs' } = $self->hhmmss2secs ( $ARGV [ 2 ] ) ;
		} 
	else
		{ 
		$self-> { 'redsecs' } = 0 ;
		} 

	return ( $self ) ;
	} 

########################################
# Get and set routines for timer status
#
sub setStatusRunning(){ $_ [ 0 ] -> { 'timerstatus' } = 'Running' ; } 
sub setStatusFinished(){ $_ [ 0 ] -> { 'timerstatus' } = 'FINISHED' ; } 
sub setStatusReady(){ $_ [ 0 ] -> { 'timerstatus' } = 'READY' ; } 
sub setStatusStandby(){ $_ [ 0 ] -> { 'timerstatus' } = 'STANDBY' ; } 

sub getStatus(){ return ( $_ [ 0 ] -> { 'timerstatus' } ) ; } 

sub isStatusRunning(){ return ( $_ [ 0 ] ->getStatus()eq 'Running' ) ; } 
sub isStatusReady(){ return ( $_ [ 0 ] ->getStatus()eq 'READY' ) ; } 
sub isStatusFinished(){ return ( $_ [ 0 ] ->getStatus()eq 'FINISHED' ) ; } 
sub isStatusStandby(){ return ( $_ [ 0 ] ->getStatus()eq 'STANDBY' ) ; } 

########################################
# Get and set routines for color timings
#
sub setGreenSecs ( $$ ) { $_ [ 0 ] -> { 'greensecs' } = $_ [ 1 ] ; } 
sub setYellowSecs ( $$ ) { $_ [ 0 ] -> { 'yellowsecs' } = $_ [ 1 ] ; } 
sub setRedSecs ( $$ ) { $_ [ 0 ] -> { 'redsecs' } = $_ [ 1 ] ; } 

sub getGreenSecs ( $ ) { return ( $_ [ 0 ] -> { 'greensecs' } ) ; } 
sub getYellowSecs ( $ ) { return ( $_ [ 0 ] -> { 'yellowsecs' } ) ; } 
sub getRedSecs ( $ ) { return ( $_ [ 0 ] -> { 'redsecs' } ) ; } 

sub getGreenHhmmss ( $ )
	{
	return ( $_ [ 0 ] ->secs2hhmmss ( $_ [ 0 ] ->getGreenSecs() ) ) ;
	} 

sub getYellowHhmmss ( $ )
	{
	return ( $_ [ 0 ] ->secs2hhmmss ( $_ [ 0 ] ->getYellowSecs() ) ) ;
	} 

sub getRedHhmmss ( $ )
	{
	return ( $_ [ 0 ] ->secs2hhmmss ( $_ [ 0 ] ->getRedSecs() ) ) ;
	} 

########################################
# get and set routines for beep on color change
#
sub setBeepOnColorChange ( $$ )
	{
	$_ [ 0 ] -> { 'beeponcolorchange' } = $_ [ 1 ] ;
	} 

sub getBeepOnColorChange ( $ )
	{
	return ( $_ [ 0 ] -> { 'beeponcolorchange' } ) ;
	} 

########################################
# Event routines
#
sub on_exit ( $ ) { exit ; } 

sub on_cancel ( $ ) 
	{ 
	my $self = $_ [ 0 ] ;
	$self->setStatusStandby() ;
	$self-> { 'timer' } ->refresh() ;
	$self-> { 'confwindow' } ->destroy() ;
	} 

sub on_ok ( $ ) 
	{ 
	my ( $self , $gent , $yent , $rent ) = @_ ;
	my $g = $gent->get() ;
	my $y = $yent->get() ;
	my $r = $rent->get() ;

	$self-> { 'okerrmsg' } = '' ;

	return unless $self->validateTime ( $gent , $g , "unused" ) ;
	return unless $self->validateTime ( $yent , $y , "unused" ) ;
	return unless $self->validateTime ( $rent , $r , "unused" ) ;

	$self->setStatusStandby() ;
	$self-> { 'timer' } ->refresh() ;

	my $status = 'CALCULATING' ;


	my $gSecs = $self->hhmmss2secs ( $g ) ;
	my $ySecs = $self->hhmmss2secs ( $y ) ;
	my $rSecs = $self->hhmmss2secs ( $r ) ;

	$status = 'READY' ; 
	$status = 'STANDBY' unless defined ( $gSecs ) ;
	$status = 'STANDBY' unless defined ( $ySecs ) ;
	$status = 'STANDBY' unless defined ( $rSecs ) ;

	if ( $status eq 'READY' ) 
		{ 
		$status = 'STANDBY' ;
		if ( $rSecs <= $ySecs ) 
			{ 
			$self-> { 'okerrmsg' } = 'TIMES MUST BE 0 < GREEN < YELLOW < RED' ;
			print "\007" ;
			$yent->focus() ;
			} 
		elsif ( $ySecs <= $gSecs ) 
			{ 
			$self-> { 'okerrmsg' } = 'TIMES MUST BE 0 < GREEN < YELLOW < RED' ;
			print "\007" ;
			$gent->focus() ;
			} 
		elsif ( $gSecs <= $0 ) 
			{ 
			$self-> { 'okerrmsg' } = 'TIMES MUST BE 0 < GREEN < YELLOW < RED' ;
			print "\007" ;
			$gent->focus() ;
			} 
		else
			{ 
			$status = 'READY' ;
			} 
			
		} 

	if ( $status eq 'READY' ) 
		{ 
		$self->setGreenSecs ( $gSecs ) ;
		$self->setYellowSecs ( $ySecs ) ;
		$self->setRedSecs ( $rSecs ) ;
		$self->setStatusReady() ;
		$self-> { 'timer' } ->refresh() ;
		$self-> { 'confwindow' } ->destroy() ;
		} 
	} 

########################################
# acquire() throws up the screen and acquires user input for timings
#
sub acquire ( $ ) 
	{ 
	my $self = $_ [ 0 ] ;

	my $win = $self-> { 'confwindow' } ;
	if ( Exists $self-> { 'confwindow' } ) 
		{ 
                $win->destroy() ;
		} 

	$win = $self-> { 'timer' } -> { 'mainwindow' } ->Toplevel() ;
	$win->title ( "Set timings here" ) ;
	$win->focusmodel ( 'active' ) ;
	$win->geometry ( '800x600' ) ;

	$self-> { 'confwindow' } = $win ;
	
	my $frm = $win->Frame()->pack ( -side => 'left' , -anchor => 'w' ) ;

	my $frameErrMsg = $frm-> Frame ( -background => '#FF0000' )
		->pack ( -side => "top" , -anchor => "w" , -padx => 0 , -pady => 0 ) ;

	$frameErrMsg->Label ( -textvariable => \$self-> { 'errmsg' } ) 
		->pack ( -side => "left" , -pady => 10 ) ;

	my $frameOKErrMsg = $frm-> Frame ( -background => '#FF0000' )
		->pack ( -side => "top" , -anchor => "w" , -padx => 0 , -pady => 0 ) ; 
		
	$frameOKErrMsg->Label ( -textvariable => \$self-> { 'okerrmsg' } ) 
		->pack ( -side => "left" , -pady => 10 ) ;

	my $frameHeading = $frm-> Frame()
		->pack ( -side => "top" , -anchor => "w" , -padx => 4 , -pady => 10) ; 

	$frameHeading->Label ( -text => 'ENTER TIMINGS FOR THE SPEECH' ) 
		->pack ( -side => 'top' ) ;

	my $frameColors = $frm-> Frame()
		->pack ( -side => "top" , -padx => 4 , -pady => 10 , -anchor => 'w') ;

	my $fcLeft = $frameColors-> Frame()
		->pack ( -side => "left" , -anchor => 'e' ) ;

	my $fcRight = $frameColors-> Frame()
		->pack ( -side => "right" , -anchor => 'w' ) ;
	
	my $fclg = $fcLeft-> Frame ( -background => '#00FF00' ) 
		->pack ( -side => "top" , -anchor => 'w' ) ;
		
	my $fcly = $fcLeft-> Frame ( -background => '#FFFF00' ) 
		->pack ( -side => "top" , -anchor => 'w' ) ;

	my $fclr = $fcLeft-> Frame ( -background => '#FF0000' ) 
		->pack ( -side => "top" , -anchor => 'w' ) ;

	$fclg->Label ( -text => '  Green (h:mm:ss) ' )
		->pack ( -side => 'left' ) ;

	$fcly->Label ( -text => ' Yellow (h:mm:ss) ' )
		->pack ( -side => 'left' ) ;

	$fclr->Label ( -text => '    Red (h:mm:ss) ' )
		->pack ( -side => 'left' ) ;

	my $fcrg = $fcRight-> Frame ( -background => '#00FF00' ) 
		->pack ( -side => "top" , -anchor => 'e' ) ;

	my $fcry = $fcRight-> Frame ( -background => '#FFFF00' ) 
		->pack ( -side => "top" , -anchor => 'e' ) ;

	my $fcrr = $fcRight-> Frame ( -background => '#FF0000' ) 
		->pack ( -side => "top" , -anchor => 'e' ) ;

	my $gent = $fcrg
		->Entry ( -width => 9 , -justify => 'right' , -validate => 'focus' ) 
		->pack ( -side => 'left' ) ;

	$gent->configure ( -validatecommand => sub
		{
		return ( $self->validateTime ( $gent , $_ [ 0 ] , $_ [ 2 ])) ;
		}
	) ;
			

	my $yent = $fcry ->Entry ( -width => 9 , -justify => 'right' , -validate => 'focus')
		->pack ( -side => 'left' ) ;

	$yent->configure ( -validatecommand => sub
		{
		return ( $self->validateTime ( $yent , $_ [ 0 ] , $_ [ 2 ] ) ) ;
		}
	) ;

	my $rent = $fcrr
		->Entry ( -width => 9 , -justify => 'right' , -validate => 'focus' ) 
		->pack ( -side => 'left' ) ;

	$rent->configure ( -validatecommand => sub
		{
		return ( $self->validateTime ( $rent , $_ [ 0 ] , $_ [ 2 ] ) ) ;
		}
	) ;


	my $frameButtons = $frm-> Frame()
		->pack ( -side => "bottom" , -anchor => "w" , -padx => 10 , -pady => 10 ) ;

	my $buttonOk = $frameButtons->Button ( -text => " \n     OK     \n " , 
		-command => [ \&on_ok , $self , $gent , $yent , $rent ] ) 
		->pack ( -side => 'top' ) ;
		
	my $buttonCancel = $frameButtons->Button ( -text => ' Cancel ' , 
		-command => [ \&on_cancel , $self ] ) 
		->pack ( -side => 'top' , -pady => 30 ) ;

	my $buttonExit = $frameButtons->Button ( -text => 'Exit program' , 
		-command => [ \&on_exit , $self ] ) 
		->pack ( -side => 'top' ) ;

	my $buttonGPL = $frameButtons->Button ( -text => 'View software license' );
	$buttonGPL->configure( -command => sub
		{
		$self-> { 'copying' } ->runScreen ( $self-> { 'timer' } -> { 'mainwindow' } )
		}
	);
	$buttonGPL->pack ( -side => 'top' , -pady => 30 ) ;

	$gent->insert ( 0 , $self->getGreenHhmmss() ) ;
	$yent->insert ( 0 , $self->getYellowHhmmss() ) ;
	$rent->insert ( 0 , $self->getRedHhmmss() ) ;

	$gent->focus() ;
	MainLoop() ;
	} 

########################################
# validateTime is the time validation routine for the three time fields on the
# StConfig screen.  It does both validation and correction. This routine is
# called when a field loses focus due to tab key or clicking of another field.
# It is also called for EVERY field upon clicking or pressing Enter on the OK
# button.
#
# The validity of the field is determined by the 3 regular expressions.  Upon
# detection of an invalid entry, the error message label text is displayed, the
# computer beeps, and the offending field is given focus, and 1 is returned
# instead of 0. The return code could, but in this case is not, be used to
# trigger a routine named in the field's -invalidatecommand property.
#
# Passed to this routine are $self, the Entry widget being evaluated, the new
# text just typed in, and the original text. Note that in this program, we do
# not use the original text, nor is it accurate. If you later decide to modify
# this source to set a bad field back to the original, you will need to
# manually preserve the original field contents and send them to
# validateTime().
#
sub validateTime($$$$)
	{
	my $self = shift ;
	my $entry = shift ;
	my $proposed = shift ;
	my $org = shift ;

	$self-> { 'errmsg' } = '' ;
	my $return = 0 ;

	if($proposed =~ m/^\s*\d{1,3}:\d\d:\d\d$/) {$return=1 ;}
	if($proposed =~ m/^\s*\d{1,5}:\d\d$/) {$return=1 ;}
	if($proposed =~ m/^\s*\d{1,6}\d$/) {$return=1 ;}

	if ( !$return ) 
		{ 
		print "\007" ;
		$self-> { 'errmsg' } = "TIMES MUST BE H:MM:SS , M:SS , OR SS!" ;
		$entry->focus() ;
		} 

	return ( $return ) ;
	} 

########################################
# Routines to convert time
#
sub hhmmss2secs ( $$ ) 
	{ 
	my ( @times ) = split ( /:/ , $_[ 1 ] ) ;
	my $accum = 0 ;
	my $time ;
	foreach $time ( @times ) 
		{ 
		$accum *=60 ;
		$accum += int ( $time ) ;
		} 
	return ( $accum ) ;
	} 

sub secs2hhmmss ( $$ ) 
	{ 
	my $self 	= shift;
	my $accum 	= shift;

	my $s = $accum % 60 ;
	$accum -= $s ;
	$accum /=60 ;
	
	my $m = $accum % 60 ;
	$accum -= $m ;
	$accum /=60 ;

	my $return = 'INIT' ;

	if ( $accum > 0 ) 
		{ 
		$return = sprintf ( "%d:%02d:%02d" , $accum , $m , $s ) ;
		} 
	else
		{ 
		$return = sprintf ( "%d:%02d" , $m , $s ) ;
		} 

	return ( $return ) ;
	} 


###############################################################################
# The SpeechTimer object does the actual work of timing. It contains a StConfig
# object to acquire and store program information (green, yellow and red
# timings, and state information).
#
# This program is a state machine. You cannot start the timer until you have
# acquired timing information from the user. You cannot stop the timer until
# you have started it. You cannot acquire information or exit the program until
# you have stopped the timer, in order to prevent accidental termination of
# timing.
#
# Due to this program's usage, it is ESSENTIAL that the green, yellow and red
# screen colors be visible at a distance, so the screen is big, and buttons are
# kept to a minumum.
#
package SpeechTimer ;
use strict ;
use Tk ;
use Time::HiRes qw ( usleep sleep gettimeofday tv_interval ) ;

########################################
# Instantiation routine for SpeechTimer object
#
sub new ( $ ) 
	{ 
	my ( $type ) = $_ [ 0 ] ;
	my ( $self ) = { } ;
	$self-> { 'starttime' } = [ gettimeofday()] ;
	$self-> { 'lastsecs' } = -1 ;
	$self-> { 'color' } = 'BLACK' ;
	$self-> { 'prevcolor' } = 'WHITE' ;
	$self-> { 'statelabel' } = 'INIT' ;
	$self-> { 'timetext' } = '000000000' ;
	$self-> { 'mainwindow' } = 0 ;
	$self-> { 'bigbutton' } = 0 ;
	$self-> { 'repeater' } = 0 ;
	$self-> { 'mainframe' } = 0 ;

	bless ( $self , $type ) ;

	$self->setupScreen() ;
	$self-> { 'stconfig' } = StConfig->new ( $self ) ;
	$self-> { 'timelabel' } ->after ( 30 , [ \&SpeechTimer::on_reset , $self ] ) ;
	$self->runScreen() ;

	return ( $self ) ;
	} 

########################################
# Routines to change color during timing
#
sub setColor ( $$ ) { $_ [ 0 ] -> { 'color' } = $_ [ 1 ] ; } 
sub getColor ( $ ) { return ( $_ [ 0 ] -> { 'color' } ) ; } 
sub setPrevColor ( $$ ) { $_ [ 0 ] -> { 'prevcolor' } = $_ [ 1 ] ; } 
sub getPrevColor ( $ ) { return ( $_ [ 0 ] -> { 'prevcolor' } ) ; } 

sub showColor ( $ ) 
	{ 
	$_ [ 0 ] -> { 'mainwindow' } ->configure ( -background => $_ [ 0 ] ->getColor() ) ; 
	} 

sub checkAndSetColor ( $$ ) 
	{ 
	my $self	= shift ; 
	my $secs	= shift ;

	if ( $secs < $self-> { 'stconfig' } ->getGreenSecs() ) 
		{ 
		$self->setColor ( '#000000' ) ;
		} 
	elsif ( $secs < $self-> { 'stconfig' } ->getYellowSecs() ) 
		{ 
		$self->setColor ( '#00FF00' ) ;
		} 
	elsif ( $secs < $self-> { 'stconfig' } ->getRedSecs() ) 
		{ 
		$self->setColor ( '#FFFF00' ) ;
		} 
	else
		{ 
		$self->setColor ( '#FF0000' ) ;
		} 
	} 

########################################
# getStartTime retrieves the time the SpeechTimer's Start button was pressed.
#
sub getStartTime ( $ ) { return ( $_ [ 0 ] -> { 'starttime' } ) ; } 

########################################
# setupScreen() sets up the SpeechTimer object's screen. It does not run that
# screen -- runScreen() does that.
#
sub setupScreen()
	{ 
	my $self = $_ [ 0 ] ;
	$self-> { 'mainwindow' } = new MainWindow() ;

	$self-> { 'mainframe' } = $self-> { 'mainwindow' } ->Frame()->pack ( -side => 'top' , -anchor => 'center' ) ;

#	$self-> { 'mainwindow' } ->geometry ( '600x440' ) ; # Smallest window on practical computers
	$self-> { 'mainwindow' } ->geometry ( '1600x1200' ) ; # Largest window on practical computers

	$self-> { 'mainwindow' } ->title ( "Speech Timer Program" ) ;

	my $frameTitle = $self-> { 'mainwindow' } ->Frame()
		->pack ( -side => 'top' , -anchor => 'w' ) ;

	$frameTitle->Label ( -text => "Speech Timer" ) 
		->pack ( -side => "left" , -pady => 10 ) ;

	$self-> { 'mainwindow' } ->Frame()->pack ( -side => 'top' , -pady => 2 ) ;

	my $frameState = $self-> { 'mainwindow' } ->Frame()
		->pack ( -side => 'top' , -anchor => 'w' ) ;

	$self-> { 'statelabel' } = $frameState->Label ( -text => 'INIT' ) 
		-> pack ( -side => "left" ) ;

	$self-> { 'mainwindow' } ->Frame()->pack ( -side => "top" , -pady => 2 ) ;

	my $frameTime = $self-> { 'mainwindow' } ->Frame()
		->pack ( -side => 'top' , -anchor => 'w' ) ;

	$self-> { 'timelabel' } = $frameTime->Label
		(
		-textvariable => \$self-> { 'timetext' } ,
		-font => [ "Helvetica" , "120" , "bold" ]
		) ; 

	$self-> { 'timelabel' }	->pack ( -side => "left" , -ipady => 0 ) ;

	$self-> { 'quitbutton' } = $self-> { 'mainwindow' } ->Button
		(
		-text => "Exit program" ,
		-command => [ \&SpeechTimer::on_quit , $self ]
		) ;

	$self-> { 'quitbutton' } ->pack ( -side => 'bottom' ) ;

	$self-> { 'mainwindow' } ->Frame()->pack ( -side => "bottom" , -pady => 6 ) ;

	$self-> { 'mainwindow' } ->Frame()->pack ( -side => 'top' , -pady => 4 ) ;

	my $frameBigButton = $self-> { 'mainwindow' } ->Frame()
		->pack ( -side => 'top' , -anchor => 'w' ) ;

	$self-> { 'bigbutton' } = $frameBigButton->Button()
		->pack ( -side => "left" , -anchor => 'center' ) ;
	} 


########################################
# runScreen() runs the main screen.
#
sub runScreen()
	{ 
	MainLoop() ;
	} 

########################################
# Event routines for the SpeechTimer main screen
#
sub on_quit()
	{ 
	my $self = $_ [ 0 ] ;
	return unless ( $self-> { 'stconfig' } ->isStatusReady()or $self-> { 'stconfig' } ->isStatusStandby() ) ;
	$self-> { 'mainwindow' } ->destroy() ;
	} 

sub on_reset()
	{ 
	my $self = $_ [ 0 ] ;
	$self-> { 'stconfig' } ->setStatusStandby() ;
	$self->refresh() ;
	$self-> { 'stconfig' } ->acquire() ;
	$self-> { 'timetext' } = '0' ;
	print "\007" ;
	} 

sub on_start()
	{ 
	my $self = $_ [ 0 ] ;
	$self-> { 'starttime' } = [ gettimeofday ] ;
	$self-> { 'lastsecs' } = -1 ;
	$self-> { 'repeater' } = $self-> { 'timelabel' } ->after ( 1 , [ \&SpeechTimer::check_again , $self ] ) ;
	$self-> { 'stconfig' } ->setStatusRunning() ;
	$self->refresh() ;
	print "\007" ;
	} 

sub on_stop()
	{ 
	my $self = $_ [ 0 ] ;
	$self-> { 'repeater' } ->cancel() ;
	$self-> { 'stconfig' } ->setStatusFinished() ;
	$self->refresh() ;
	print "\007" ;
	} 

sub on_doublereset
	{ 
	my $self = $_ [ 0 ] ;
	$self->on_reset() ;
#	$self-> { 'bigbutton' } ->configure ( -text => "disabled until time screen is completed" ) ; 
	} 

########################################
# The refresh() subroutine is called to refresh the main window's colors,
# buttons and text, based on the status returned from the StConfig object. Note
# that refresh() is called internally by the SpeechTimer object, and also from
# the StConfig object in order to refresh the main window based on user
# interaction with the StConfig screen.
#
sub refresh()
	{ 
	my $self = $_ [ 0 ] ;
	my $cfg = $self-> { 'stconfig' } ;
	my $stateText = $cfg->getStatus() ;
	$self-> { 'statelabel' } ->configure ( -text => $stateText ) ;
	if ( $cfg->isStatusReady() ) 
		{ 
		$self-> { 'mainwindow' } ->configure ( -background => "#CCCCCC" ) ;
		$self-> { 'bigbutton' } ->configure ( -text => " \n\n\n            Start            \n\n\n " ) ; 
		$self-> { 'bigbutton' } ->configure ( -command => [ \&SpeechTimer::on_start , $self ] ) ;
		$self-> { 'bigbutton' } ->focus() ;
		$self-> { 'quitbutton' } ->configure ( -text => "Exit program" ) ; 
		} 
	elsif ( $cfg->isStatusRunning() ) 
		{ 
		$self-> { 'bigbutton' } ->configure ( -text => " \n\n\n            Stop             \n\n\n " ) ; 
		$self-> { 'bigbutton' } ->configure ( -command => [ \&SpeechTimer::on_stop , $self ] ) ;
		$self-> { 'bigbutton' } ->focus() ;
		$self-> { 'quitbutton' } ->configure ( -text => "exit disabled until after stop and reset" ) ; 
		} 
	elsif ( $cfg->isStatusFinished() ) 
		{ 
		$self-> { 'bigbutton' } ->configure ( -text => "Reset" ) ; 
		$self-> { 'bigbutton' } ->configure ( -command => [ \&SpeechTimer::on_reset , $self ] ) ;
		$self-> { 'quitbutton' } ->configure ( -text => "exit disabled until after reset" ) ; 
		$self-> { 'timelabel' } ->focus() ;
		} 
	elsif ( $cfg->isStatusStandby() ) 
		{ 
		$self-> { 'mainwindow' } ->configure ( -background => "#FFFFFF" ) ;
		$self-> { 'bigbutton' } ->configure ( -text => " Reset timer timings " ) ; 
		$self-> { 'bigbutton' } ->configure ( -command => [ \&SpeechTimer::on_doublereset , $self ] ) ;
		$self-> { 'bigbutton' } ->focus() ;
		$self-> { 'quitbutton' } ->configure ( -text => "Exit program" ) ; 
		} 
	} 

########################################
# The check_again() subroutine is the timer mechanism of this program.  It
# checks the remaining milliseconds before the next second boundary, and sleeps
# accordingly, with smaller sleep intervals close to the second boundary.  When
# a sleep interval passes a second boundary, it updates the time printout, and
# if a color milestone has been attained it runs code to change the screen
# color.
#
sub check_again()
	{ 
	my $self 	= shift;

	my $elapsed = tv_interval ( $self-> { 'starttime' } , [ gettimeofday ] ) ;
	my $secs = int ( $elapsed ) ;

	if ( $secs > $self-> { 'lastsecs' } ) 
		{ 
		$self->checkAndSetColor ( $secs ) ;
		if ( $self->getColor() ne $self->getPrevColor() ) 
			{ 
			$self->setPrevColor ( $self->getColor() ) ;
			} 
		$self->showColor() ;
		$self-> { 'timetext' } = $self-> { 'stconfig' } -> secs2hhmmss ( $secs ) ;
		$self-> { 'lastsecs' } ++ ;
		} 

	my $wait=0.1 ;
	my $over = $elapsed - $secs ;

	if ( $over < 0.9 ) 
		{ 
		$wait = .91 + $secs - $elapsed ;
		$wait = 0.91 - $over ;
		} 
	else
		{ 
		$wait = 1.0 - $over ;
		} 

	$wait *= 1000 ; # after()takes milliseconds

	$self-> { 'repeater' } = $self-> { 'timelabel' } ->after ( $wait , [ \&SpeechTimer::check_again , $self ] ) ;
	} 

###############################################################################
# The main routine simply instantiates a SpeechTimer object.
#
package main ;

my $timer = SpeechTimer->new() ;

High Level Design

As mentioned, this program is comprised of three objects: SpeechTimer, StConfig, and COPYING. These three object are linked using "has-a" relationships. Specifically, the StConfig class contains and instantiates an instance of the COPYING class. Likewise, the SpeechTimer class contains and instantiates an instance of the StConfig class.

The COPYING class does not communicate with other classes. It simply displays the GNU General Public License and terminates when its OK button is clicked. Its screen is displayed when the user clicks the "View software license" button on the StConfig object's screen.

The SpeechTimer and its contained StConfig objects communicate with each other. Most of the communication is initiated by the SpeechTimer object via calls to various StConfig set and get routines. However, when the user clicks the OK button on the StConfig screen, the StConfig object calls the SpeechTimer's refresh() method. The StConfig object's new() method takes one argument (besides $self), and that argument is the SpeechTimer object. That argument is stored in the StConfig object's {'timer'} property. So the OK button's event routine calls $self->{'timer'}->refresh().

The COPYING Object

This is a trivial object that shows a window with an OK button and a read-only (-state=>'disabled')Text widget, containing the GNU GPL. The OK button simply destroys the window. The most impressive facet of this object is the 350 line getLicense() method, which returns the entire GNU GPL as a single string.

The StConfig Object

The StConfig object has two jobs:
  1. Acquire, store and disclose config info, which in this version is limited to timings for green, yellow and red.
  2. Store and disclose status information. Status states are READY, RUNNING, FINISHED, and STANDBY.
Notice that other states, such as screen color, are NOT stored in this object. Perhaps that was a bad design decision, but that's how it's designed.

Config info is first acquired from the command line arguments during instantiation (the new()method). The program can take arguments for green time, yellow time and red time, in that order. These values are stored.

The acquire() method puts up a data entry screen with the green, yellow and red timings, in order that the user can change these values. This method also validates for well formed timings, and also verifies that 0 < green < yellow < red timings. The acquire()method is called in two situations:
  1. 30 milliseconds after SpeechTimer object instantiation
  2. When the user clicks the reset button on the SpeechTimer screen
#1 is accomplished by setting an after()event on a label on the SpeechTimer window. I did it this way so that the StConfig screen would rise to the top, because at the time I wrote this I didn't know enough about modal windows and focus to do it in another way.

It's important to understand that except in one instance, the StConfig object does not manipulate the status state (READY, RUNNING, FINISHED or STANDBY), but merely stores whatever it's given through its set routines. The one exception is that if the StConfig user input screen passes validation, status is changed to READY, whereas if validation fails, it's set to STANDBY. Status state information is disclosed by various get methods.

The StConfig OK button has a callback named on_ok(), which is interesting. All the screen's fields are passed to this routine, which then validates each field for correctly formed times, and then converts them to integer seconds. It then verifies that 0<green<yellow<red. If validation problems are encountered, the problem field receives focus and a label on the screen shows an error message. If there are no validation problems, the user-input times are stored, the screen is destroyed, the self->{'timer'}->refresh() method is called, and the control is returned to the SpeechTimer screen.

Validation

Validation on an Entry widget is accomplished with the -validate, -validatecommand and -invalidcommand properties. Unfortunately, validation documentation is often incomplete or unclear, and validation is complex due to its extreme configurability. The -validate property determines what when validation is performed, and can be set to one of the following values:
  1. none
  2. focusout
  3. focusin
  4. focus
  5. key
  6. all

none specifies no validation will be done on the Entry widget. The other 5 all specify validation.

focusout specifies that validation be done when the entry loses focus. This is an excellent choice because it checks what the user entered.

focusin specifies validation be done on entry to the field. I don't see this as particularly useful because it doesn't check the user input, and typically the initial contents of the field are OK.

focus specifies validation both on entry and on exit from the field. That's an excellent choice if you trust neither the user input nor the initial contents of the field.

key specifies that validation be done on each keystroke (or more accurately, on each change to the field -- you could cut or paste in the field). This is much more complex than focus type validation, because you must keep track of the added or deleted material, and where the cursor was at the time of that addition or deletion. I believe in most cases this is overkill, although it might be handy in certain numeric fields. Keystroke validation is beyond the scope of this magazine.

all specifies a combination of focusout, focusin, and key. If you can correctly use all, you're a better programmer than I am.

The actual validation is performed by a validation callback routine specified as the value of the -validatecommand Entry widget configuration option. Upon whatever event is specified by -validate, the Entry widget calls that callback with the following arguments:

Please remember, the preceding arguments are determined by Perl Tk -- you don't influence them. Also, according to documentation I've read, you don't want to use validation on an Entry widget having a -textvariable. Instead, use the widget's insert() and delete() methods to change its value.

WARNING

In the work I've done (focusout), the "original contents" argument did not in fact contain the original contents, but instead contained a copy of the latest contents. If you need the original contents, perhaps to set the field back to the original value, you must save that value separately, and use an anonymous subroutine as a "bridge" to your validation routine.

The calling widget expects the validation routine named in its -validatecommand property to return 0 on error, or 1 on valid data. If it returns 0, then the widget calls the callback named in its -invalidcommand property. That callback is passed the exact same arguments as the callback named in the -validatecommand property. The idea is that -validatecommand evaluates the validity of the field, and -invalidcommand does the damage control. However, it's sometimes easier to let the -validatecommand do both detection and correction of errors.

Let's discuss bridge routines. The validation for a particular field might require data from another field, or another data source entirely. With only the 5 previously described arguments being passed, how does your validation routine get other information? You need a bridge routine. Note the following bridge routine from the speech timer code (StConfig::acquire()):

$gent->configure ( -validatecommand => sub
		{
		return ( $self->validateTime ( $gent , $_ [ 0 ] , $_ [ 2 ])) ;
		}
	) ;


sub validateTime($$$$)
	{
	my $self = shift ;
	my $entry = shift ;
	my $proposed = shift ;
	my $org = shift ;
	# ...
	}
In the preceding code (which appears in the Speech Timer code), our validation routine is an anonymous subroutine reference whose only job is to call the real validation routine, s$self->validateTime() with the correct arguments, namely, the current object ($self), the Entry widget being validated, the new text, and the original text (which in this case doesn't work and was not used, and could be eliminated). If the validation routine had needed other information, such as the content of other Entry widgets, I would have passed them to validateTime() in the argument list.

The SpeechTimer Object

The SpeechTimer object is constructed to perform the intended task, namely, timing speeches both for practice and in events such as Toastmasters meetings. It needs to time the speech, and at predetermined times turn the screen green, then yellow, and finally red. The speaker knows that when the light turns green, he's spoken "long enough". When it turns red, he's spoken "too long" and must wrap up within a few seconds. Within the period that the screen is green or yellow, the speaker is within timing limits.

Timing a speech is a responsibility. Do it wrong in a Toastmasters meeting, and the speaker loses feedback and a chance to be voted "best speaker" for the night. Do it wrong at a speech contest and dreams can be shattered. The program must be engineered to minimize the chance of error.

I could have had different buttons marked "start", "stop" and "reset", just like on a stopwatch. But that gives the person doing the timing a chance to click the wrong button, thereby getting an incorrect time. So instead I created a single button that is labeled "Start" when the program is ready to time, "Stop" when the timer is running, and "Reset" when the timer was stopped at the conclusion of a speech. Resetting the timer also implies displaying the configuration screen, because different speeches have different required lengths.

To accomplish the change in button text and function, you need a state machine. As mentioned before, the StConfig object holds the status state, and the SpeechTimer object contains the state machine logic, which is pretty simple. Look at the SpeechTimer event routines -- the ones beginning with "on_", and the state machine logic will be clear.

Notice also that the event routines don't directly change screen elements. Instead they set the StConfig object's status, and then call SpeechTimer::refresh() to translate that status into widget text, color and callback information. That way the StConfig object can also change the SpeechTimer's user interface.

The actual timing of the timer is accomplished by the check_again() method. As discussed in the Timer Basics article, this method simply uses the after() method to delay a certain amount. That certain amount is the time required to bring the timer to within a small amount of the next second border. When the timer finally crosses a second border, break logic is performed, the time on the screen is changed, and if a color time boundary has been crossed, the screen color is changed.

It's important to remember that the check_again() method does not implement a loop. Instead, it yields control to Tk, telling Tk to call it again at the proper time. By repeatedly yielding control for a specified time, check_again() is called repeatedly, as if surrounded by a while()loop.

Note the size of the time display. It's important that the speaker see not only the screen color, but also the elapsed time. The text is made bigger using the following syntax:
-font => [ "Helvetica" , "120" , "bold" ]
A widget's -font property is a reference to a 3 element array. The first element is the font family, the second is the point size, and the third is a modifier like bold or italic.

Summary

Whew! Think this is a long enough article? Just remember, the Speech Timer program is comprised of only three objects, one of which is trivial (the COPYING object). The StConfig object acquires, holds and discloses configuration information, which with this first version is only the timings for green, yellow and red. Additionally, the StConfig object holds and discloses the status state: READY, RUNNING, FINISHED or STANDBY. The StConfig object creates a screen to acquire user configuration preferences in its acquire() method.

The SpeechTimer object provides all timing and display of time and color, as well as providing a button for the user to click in order to start, stop or reset the timer.

These three objects are comprised of widgets and algorithms discussed previously in this magazine. It's not rocket science.
Steve Litt is the author of Rapid Learning: Secret Weapon of the Successful Technologist . He can be reached at Steve Litt's email address.

Special Article: I'm Still a Mandrake Man

By Steve Litt
It seems like a lifetime ago. Judge Jackson had busted up Microsoft, Linux IPO money was everywhere, and Chris Young was the one and only president LEAP (Linux Enthusiasts and Professionals) had ever had. It was late 1999 -- a different world.

Chris and I stood outside the public library after a LEAP Executive meeting discussion desktop distros. Chris recommended that for desktop computing purposes I try Corel, after I expressed dissatisfaction with Red Hat as a desktop distro. Keep in mind that all my "real work" was still done on Win98 -- I was just exploring for a desktop that could eventually replace Win98.

Jump ahead to April 2000. The boom economy was starting to unravel, though by today's standards the streets were still paved with gold. I had bought a dual Celeron 300A, which I promptly cranked up to 450 and added 512 MB of ram. This machine was intended to be a Linux machine to take over all work from my Win98 machine. But things weren't working out.

Specifically, Corel Linux just didn't cut it. In a thousand ways, Corel Linux was more effort than it was worth. I had tried Debian also, and the Debian that existed back then was out of the question. Red Hat didn't have the right apps. I asked Chris what to do, and he said "why don't you try Mandrake".

I won't say it was love at first sight, but Mandrake was the first distro I could envision as a desktop Linux box. It had the best assortment of desktop apps, including the LyX and Dia that a particularly helpful LEAP veteran had recommended for my book writing. I installed Mandrake on my dual Celeron 300A (cranked up to 450), and every once in a while I'd experiment with the box, hoping someday to make it my own.

Move ahead to March, 2001. The economy was bad, though not as bad as it is today. After 2 terms in office, Chris Young was succeeded by Phil Barnett. And I moved my business to the Mandrake dual Celeron, with the Win98 box stuck in a corner and accessed via VNC. I used Mandrake every day, but at times it was a love-hate relationship.

I love Mandrake for its superb hardware detection, and especially for its inclusive set of apps for the desktop. I hated it for its quirks. One version had all sorts of messed up symlinks requiring special attention for what should have been nobrainer compiles. Another version had a horrid CUPS bug that prevented printing of documents with .eps graphics. Several versions had even grainier fonts than the typical Linux distro.

And installing Mandrake can be like pulling teeth. It's not hard with perfect hardware like my dual Celeron 300A (cranked up to 450). With an Abit BP6 mobo, 512 MB of high quality RAM from Linktronics in LA, and no on-board peripherals, this was the ultimately stable hardware. Every Mandrake version installed perfectly on my dual Celeron.

But my 333 Celeron on a cheapo Chaintek mobo wasn't so lucky. It took several tries, and finally I succeeded only by performing a least common denominator install, and then using rpmdrake to install most of the rest. And with my ECS K7SEM Duron 1200+ (that's really a Duron 850 which ECS bus cranked up to yield 892), on-board video, on-board sound, and on-board network, installing was worse -- 6 failed installs before finally succeeding with a trivial install. I spent over a day getting any install to work, and several hours after that rpmdraking on the stuff I didn't install.

Because of that experience, a couple months ago I considered going to Red Hat. An "everything" Red Hat install went on the Chaintek first try. What a pleasant change. But then, as I tried to use the new box, I remembered why I like Mandrake. LyX was missing in action. My beloved IceWM was a noshow. A lot of software I take for granted wasn't on the Red Hat install CDs. Sure, I could have downloaded it, but I have better things to do than install LyX, and try to fathom which xforms goes with which tetex goes with which LyX.

Suddenly I saw Mandrake in a new light. It's a desktop in a box (or a desktop in a download). And all those Drake tools are wonderful. Once you understand how to configure Mandrake, it's wonderful. After my Red Hat experience, sticking with Mandrake as a desktop distro was a nobrainer.

Then, about a month later, MandrakeSoft declared bankruptcy.

Where's All this Going?

Where's all this going? What's the point?

The point is to highlight how differently problems such as bankruptcy are handled in the world of free software.

Imagine if the vendor of proprietary software you depend on goes bankrupt. What would be your first action? You know darned well what you'd do -- you'd find alternate software with a strong vendor, and desert the bankrupt vendor like a rat leaving a sinking ship. And who could blame you? As the vendor goes down, a fly by night company operating out of a post office box could buy their source code, and you're forever stuck with your current version, bugs and all.

What a difference Open Source makes. One of 3 things will happen:
  1. MandrakeSoft will survive and thrive
  2. MandrakeSoft will die and others will take over the Mandrake OPEN SOURCE code base, as the GPL license allows them to do.
  3. Mandrake itself will become unmaintained and die.
In case 1, sticking with Mandrake gives me the best product. In case 2, it probably gives me the best product. And in case 3, because there are so many Linux "vendors", transitioning won't be too painful.

I'm sticking with Mandrake. They've given me a great product since 2000, and I'm betting they'll continue to. Writing this, I realize the last time I actually purchased a Mandrake distro was Mandy 7.2. That's going to change. When 9.1 comes out, I'll buy it. If Windows Professional is worth $198 or whatever, then Mandrake is worth $500. So $22.50 every couple versions (or $69.00 for the PowerPack Edition) is dirt cheap. Yeah, I could download it again, but now my friends at MandrakeSoft need money, so I'll help out. I bet there are a million just like me. MandrakeSoft just might pull this out of their hat.

If you like the Troubleshooters.Com content authored since March 2001, thank Mandrake. If you've corresponded with me via email, thank Mandrake. Not a day goes by when I don't use Mandrake, and it's overwhelmingly a great experience. If you've never used Mandrake, try it now. You can't take it for granted that you can try it next year. And why not pay for it. If the worst happens, those fresh from the factory Mandrake CD's will have bragging value at your LUG, and just maybe antique value. Of course, I think MandrakeSoft will pull through, but if they don't it won't leave their users in the lurch. Open Source is a built in source escrow.

If March 2001 was different from late 1999, imagine how different today is from March 2001. The economy has tanked, and if you're in technology you're either looking for a job, or clutching desperately to the job you have. Linux vendors used to give 500 distros for a show, and today you're lucky if they give you more than brochures. In March 2001 Microsoft was careful not to give the impression of antitrust, and today they're back up to their old nasty tricks, and trying for world domination via .net and "digital rights management", which can be used to lock you into Microsoft. Even world politics are completely different from those innocent days of March 2001.

Yes, it seems like everything's changed since March 2001. Has anything remained the same? I can name one thing for sure:

I'm still a Mandrake Man.
Steve Litt is the author of the course on the Universal Troubleshooting Process.  He can be reached at Steve Litt's email address .

Life After Windows: The Clarion Ideal Lives On

Life After Windows is a regular Linux Productivity Magazine column, by Steve Litt, bringing you observations and tips subsequent to Troubleshooters.Com's Windows to Linux conversion.
By Steve Litt
In my youth I used Clarion 2.0 and 2.1 to repeatedly create 5 table apps in a day, and then streamline and enhance those apps as needed. With the demise of DOS, I stopped using Clarion, except for one very nice experience using Clarion for Windows 4.0.

I just called SoftVelocity, the current owner of Clarion. SoftVelocity is owned by an ex-Topspeed employee, and populated partially by ex-Topspeed employees, so there's a continuity. I just talked to the sales department, and they said that the idea of Clarion for Linux has been discussed. It may or may not happen. The sales department had a record of my early 1990's Clarion 2.0 purchase and my 1998 Clarion 4.0 purchase, and offered me an upgrade.

Can you imagine Microsoft doing that, without even asking for the original box and license?

This is all a way of saying that if it's ported to Linux, Clarion might become my first commercial app.

But here in 2003, there's no Clarion for Linux, so I'm doing my best to make one. I've almost completed the picklist object. Building a container object associating that picklist with a SQL statement isn't rocket science. I also need a specialized Entry widget that can get its value by instantiating a Picklist object. Using those two objects, I can create a toolset that creates the same easy to use apps created by Clarion 2.1.

From there it's a matter of making development more rapid. Following in Clarion's footsteps, I'll use templates. One way "screen builder" templates at first, and maybe later 2 way templates like Clarion 2.1 had.

Licensing is an issue. The ActiveState Community License precludes distribution of ActivePerl to other companies. A developer could always download ActivePerl at the customer site, but when dealing with small business customers, you can't count on broadband, or even a modem. Even while I'm in communication with ActiveState trying to find a way that hired gun programmers can install ActivePerl off a CD rather than downloading, I'm researching other Perl for Windows distributions. And of course there's always Cygwin.

But from what I hear, Cygwin also has a licensing issue. It's full GPL, not LGPL, so there's some question about whether you can deploy a proprietary Perl app on top of Perl running with Cygwin. I'd imagine you can, because you can certainly deploy proprietary apps on Perl on a GNU GPL Linux operating system. I'm not saying you necessarily want to deploy proprietary apps, but it's nice to have that choice.

When it comes to writing apps for small business, perhaps making your apps GPL would be an advantage. When the businessman tries to throw a non-disclosure in your face, you can respond that the GNU GPL prohibits your signing it, and in fact you will share the app with others, just like the low price he's paying is the result of code cloned from others. After all, what you're really charging for is configuration -- bolting together tools, snippets and sections to make the desired product. Make sure the businessman knows that same GPL gives him the right to have ANYONE work on his system -- no vendor lockin. And the GPL status means the code is known to programmers far and wide.

And if your apps are GPL, perhaps you don't need my Perl Tk toolset at all. Borland's Kylix, Open edition, is GPL for making GPL apps. It runs on Linux, but creates Delphi code capable of running on Windows. I'm not really sure how Kylix would produce a Windows executable, or whether you'd need to purchase a copy of Delphi, but it's an interesting idea.

I have a dream. I dream of the day when independent programmers will make their living giving small business the custom programs they so desparately need, but until now couldn't afford. I dream of the one day app. You've seen my dream in the April, May and September 1998 Troubleshooting Professional Magazines. You heard me voice that dream in an article called "The Lesson of the Artist" in the Linux Log column of the August 1999 Troubleshooting Professional. I dream of a free software Clarion equivalent. And we just might be a step closer.
Steve Litt is the author of the course on the Universal Troubleshooting Process.  He can be reached at Steve Litt's email address .

Letters to the Editor

All letters become the property of the publisher (Steve Litt), and may be edited for clarity or brevity. We especially welcome additions, clarifications, corrections or flames from vendors whose products have been reviewed in this magazine. We reserve the right to not publish letters we deem in bad taste (bad language, obscenity, hate, lewd, violence, etc.).
Submit letters to the editor to Steve Litt's email address, and be sure the subject reads "Letter to the Editor". We regret that we cannot return your letter, so please make a copy of it for future reference.

How to Submit an Article

We anticipate two to five articles per issue, with issues coming out monthly. We look for articles that pertain to the Linux or Open Source. This can be done as an essay, with humor, with a case study, or some other literary device. A Troubleshooting poem would be nice. Submissions may mention a specific product, but must be useful without the purchase of that product. Content must greatly overpower advertising. Submissions should be between 250 and 2000 words long.

Any article submitted to Linux Productivity Magazine must be licensed with the Open Publication License, which you can view at http://opencontent.org/openpub/. At your option you may elect the option to prohibit substantive modifications. However, in order to publish your article in Linux Productivity Magazine, you must decline the option to prohibit commercial use, because Linux Productivity Magazine is a commercial publication.

Obviously, you must be the copyright holder and must be legally able to so license the article. We do not currently pay for articles.

Troubleshooters.Com reserves the right to edit any submission for clarity or brevity, within the scope of the Open Publication License. If you elect to prohibit substantive modifications, we may elect to place editors notes outside of your material, or reject the submission, or send it back for modification. Any published article will include a two sentence description of the author, a hypertext link to his or her email, and a phone number if desired. Upon request, we will include a hypertext link, at the end of the magazine issue, to the author's website, providing that website meets the Troubleshooters.Com criteria for links and that the author's website first links to Troubleshooters.Com. Authors: please understand we can't place hyperlinks inside articles. If we did, only the first article would be read, and we can't place every article first.

Submissions should be emailed to Steve Litt's email address, with subject line Article Submission. The first paragraph of your message should read as follows (unless other arrangements are previously made in writing):

Copyright (c) 2001 by <your name>. 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 | is not] elected, so this document [may | may not] be modified. Option B is not elected, so this material may be published for commercial purposes.

After that paragraph, write the title, text of the article, and a two sentence description of the author.

Why not Draft v1.0, 8 June 1999 OR LATER

The Open Publication License recommends using the word "or later" to describe the version of the license. That is unacceptable for Troubleshooting Professional Magazine because we do not know the provisions of that newer version, so it makes no sense to commit to it. We all hope later versions will be better, but there's always a chance that leadership will change. We cannot take the chance that the disclaimer of warranty will be dropped in a later version.
 
 

Trademarks

All trademarks are the property of their respective owners. Troubleshooters.Com(R) is a registered trademark of Steve Litt.

URLs Mentioned in this Issue