Learn the Perl/Tk module, Part 3

Advanced widgets

Content series: This content is part # of # in the series: Learn the Perl/Tk module, Part 3 Stay tuned for additional content in this series. This content is part of the series: Learn the Perl/Tk module, Part 3 Stay tuned for additional content in this series.

Introduction

The Perl language is commonly used by IBM® AIX® operating system administrators and developers and can be found on nearly every successful Web site and most AIX systems. Although Perl scripts are powerful, they produce a Web interface that lacks a graphical front end and forces the user to type information instead of using the mouse, which can be an unsatisfying experience for the customer. This problem has been resolved with the introduction of the Tk module in Perl. An administrator or developer can quickly breathe new life into their Perl script with the Tk module and satisfy their customer's desire for an X11 product.

Widgets

As discussed in Part 1 of this series of articles, a widget can be defined as a graphical object that performs a specific function. Any graphical object in the Perl/Tk module can be considered a widget. When you think of a GUI application, the buttons, text, frames, and scrollbars are all widgets. This article, the third part of the article series, discusses such widgets as DirTree, LabEntry, LabFrame, and Table.

DirTree

A major visual component to programming is how to handle searching files and directories. One solution to this dilemma is using the DirTree widget.

Creating a directory listing is simple with the Perl/Tk module:

#!/usr/bin/perl –w #create a directory listing with DirTree use Tk; use strict; use Tk::DirTree; use Cwd; my $mw = MainWindow->new; $mw->geometry("300x400"); $mw->title("DirTree Example"); my $CWD = Cwd::cwd(); my $DIR_TREE = $mw->Scrolled('DirTree', -scrollbars => "osoe", -width => 30, -height => 25, -exportselection => 1, -browsecmd => sub {$CWD = shift}, -command => \&show_cwd)->pack(-fill => "both", -expand => 1); $DIR_TREE->chdir($CWD); my $button_frame = $mw->Frame()->pack(-side => "bottom"); $button_frame->Button(-text => "Ok", -command => \&show_cwd)->pack(-side => "left"); $button_frame->Button(-text => "Exit", -command => sub{exit})->pack(-side => "left"); sub show_cwd { $mw->messageBox(-message => "Directory Selected: $CWD", -type => "ok"); } MainLoop;

Executing this script will generate the GUI application shown in Figures 1 and 2:

Figure 1. An example of the DirTree widget

Figure 2. Displaying the selected directory

Let's break down the script.

To review what was discussed in Part 1 and Part 2 of this series, the first section of the code will be only discussed once, unless anything has changed in the following examples. The first part (/usr/bin/perl) defines the location where the Perl executable resides on the computer and instructs the computer to use this copy of the Perl executable to execute the file multiple_windows_at_once-demo.pl:

#!/usr/bin/perl -w

The second part of this line (-w) is a valuable tool in Perl. It enables warnings when executing the script, informing the end user of any possible errors found.

Comments and text that shouldn't be evaluated at execution are preceded with an octothorp (#):

#create a directory listing with DirTree

In order for a Perl script to use the Tk module, it must be included; hence use Tk . Adding the use strict statement to a Perl script also helps find any possible typos or logic errors:

use Tk; use strict;

To use the DirTree widget, you must include it into the Perl script, because it isn't a general widget in the base Perl modules. The second inclusion is Cwd . Using this, the script can find and store the CWD, or current working directory:

use Tk::DirTree; use Cwd;

To create the primary window of the application, you use MainWindow and assign it to $mw . $mw acts as the parent to all other widgets created (as discussed further in this article):

my $mw = MainWindow->new;

Set the main window size to 300x400, and title the main window DirTree Example:

$mw->geometry("300x400"); $mw->title("DirTree Example");

Find the CWD, and store it in a variable named $CWD :

my $CWD = Cwd::cwd();

Create a scrollable directory tree. The browsecmd option resets $CWD every time the end user selects a directory. If the end user double-clicks or presses Enter on a directory, the command option executes the subroutine show_cmd :

my $DIR_TREE = $mw->Scrolled('DirTree', -scrollbars => "osoe", -width => 30, -height => 25, -exportselection => 1, -browsecmd => sub {$CWD = shift}, -command => \&show_cwd)->pack(-fill => "both", -expand => 1);

Refresh the directory tree showing the user's CWD:

$DIR_TREE->chdir($CWD);

Create a frame, and place two buttons inside it. The first button, labeled "OK," executes the subroutine show_cmd ; the second button exits the script:

my $button_frame = $mw->Frame()->pack(-side => "bottom"); $button_frame->Button(-text => "Ok", -command => \&show_cwd)->pack(-side => "left"); $button_frame->Button(-text => "Exit", -command => sub{exit})->pack(-side => "left");

When the subroutine show_cmd is executed, a messageBox widget is displayed, showing the user his CWD:

sub show_cwd { $mw->messageBox(-message => "Directory Selected: $CWD", -type => "ok"); }

Prior to executing MainLoop , everything in the script is read, defined, and prepared to execute. Then, when MainLoop is called, all functions and data read prior are executed, and the GUI is displayed:

MainLoop;

LabEntry

Many GUI applications require manual input from the end user. One method of displaying instructions and requesting input uses the Label and Entry widgets (discussed in Part 1 of this series). Another method uses the LabEntry widget. LabEntry combines the Label, Entry, and Frame widgets into one easy-to-use widget:

#!/usr/bin/perl -w use Tk; use Tk::LabEntry; use strict; my $mw = MainWindow->new; $mw->geometry("300x100"); $mw->title("LabEntry Example"); my $name = ""; $mw->LabEntry(-label => "Enter your name: ", -labelPack => [ -side => "left" ], -textvariable => \$name)->pack(); my $button_frame = $mw->Frame()->pack(-side => "bottom"); $button_frame->Button(-text => "Ok", -command => \&show_greeting)->pack(-side => "left"); $button_frame->Button(-text => "Exit", -command => sub{exit})->pack(-side => "left"); sub show_greeting { my $msg = "Who are you?"; if ($name ne "") { $msg = "Nice to meet you $name!"; } $mw->messageBox(-message => "$msg

", -type => "ok"); } MainLoop;

Executing this script generates the GUI application shown in Figures 3 and 4.

Figure 3. An example of the LabEntry widget

Figure 4. Results of the LabEntry widget

Let's break down the script.

Like the previous example with DirTree, the LabEntry widget needs to be included. If you don't include the widget, the Perl script doesn't know how to interrupt or execute LabEntry widgets:

use Tk::LabEntry;

Define a variable named $name , and set its value to NULL, or nothing. After the variable has been defined, create the LabEntry widget with the label Enter your name:, pack the label left of the entry, and assign the value entered to the variable $name :

my $name = ""; $mw->LabEntry(-label => "Enter your name: ", -labelPack => [ -side => "left" ], -textvariable => \$name)->pack();

Create a frame, and include two Button widgets inside it. The first button, labeled "OK," executes the subroutine show_greeting ; the second exits the script:

my $button_frame = $mw->Frame()->pack(-side => "bottom"); $button_frame->Button(-text => "Ok", -command => \&show_greeting)->pack(-side => "left"); $button_frame->Button(-text => "Exit", -command => sub{exit})->pack(-side => "left");

When the OK button is clicked, the subroutine show_greeting is executed. The variable $msg is defined with the value "Who are you?" The variable is defined with this value in case the end user forgets to enter his name in the LabEntry. If the user forgets, the variable $name is still set to NULL. If the user enters a name, the value "Nice to meet you $name!" will be set to $msg , which can be seen in the next line of code. Finally, a messageBox widget is displayed to the user, either greeting him or letting him know the program has no idea who he is:

sub show_greeting { my $msg = "Who are you?"; if ($name ne "") { $msg = "Nice to meet you $name!"; } $mw->messageBox(-message => "$msg

", -type => "ok"); }

LabFrame

The Frame widget has been used throughout this series of articles. Frames are used to organize other widgets, making the application look cleaner and more structured. A handy widget to accompany a frame is the LabFrame. Using the LabFrame widget, you can place labels on or by the frame with little work:

#!/usr/bin/perl -w use Tk; use Tk::LabFrame; use strict; my $mw = MainWindow->new; $mw->geometry("300x200"); $mw->title("LabFrame Example"); my $labeled_frame1 = $mw->LabFrame(-label => "Caption Across Top of Frame", -labelside => "acrosstop")->pack(); my $labeled_frame2 = $mw->LabFrame(-label => "Caption Below Frame", -labelside => "bottom")->pack(-fill => "x"); $labeled_frame1->Label(-text => "Inside Frame #1")->pack(); $labeled_frame2->Label(-text => "Inside Frame #2")->pack(); my $button_frame = $mw->Frame()->pack(-side => "bottom"); $button_frame->Button(-text => "Exit", -command => sub{exit})->pack(); MainLoop;

Executing this script generates the GUI application shown in Figure 5.

Figure 5. An example of the LabFrame widget

Let's break down the script.

The LabFrame widget is no different from the previous widget examples in this article and needs to be included:

use Tk::LabFrame;

Create a frame, and label it Caption Across Top of Frame. To place the caption on the top of the frame as the caption suggests, you must configure the LabFrame widget with the value "acrosstop" for the option labelside :

my $labeled_frame1 = $mw->LabFrame(-label => "Caption Across Top of Frame", -labelside => "acrosstop")->pack();

Create a second LabFrame widget, but instead of running the caption along the top of the frame, place the label Caption Below Frame below the frame with the option labelside set to "bottom":

my $labeled_frame2 = $mw->LabFrame(-label => "Caption Below Frame", -labelside => "bottom")->pack(-fill => "x");

To demonstrate widgets inside a LabFrame, create two Label widgets by their parent LabFrame widgets:

$labeled_frame1->Label(-text => "Inside Frame #1")->pack(); $labeled_frame2->Label(-text => "Inside Frame #2")->pack();

Table

The Table widget is a powerful addition to a Perl script. This widget creates a two-dimensional table of widgets. Instead of showing a long listing of data that isn't organized, you can use a table:

#!/usr/bin/perl -w use Tk; use Tk::Table; use strict; my $mw = MainWindow->new; $mw->geometry("475x125"); $mw->resizable(0,0); $mw->title("Table Example"); my $table_frame = $mw->Frame()->pack(); my $table = $table_frame->Table(-columns => 8, -rows => 4, -fixedrows => 1, -scrollbars => 'oe', -relief => 'raised'); foreach my $col (1 .. 8) { my $tmp_label = $table->Label(-text => "COL " . $col, -width => 8, -relief =>'raised'); $table->put(0, $col, $tmp_label); } foreach my $row (1 .. 8) { foreach my $col (1 .. 8) { my $tmp_label = $table->Label(-text => $row . "," . $col, -padx => 2, -anchor => 'w', -background => 'white', -relief => "groove"); $table->put($row, $col, $tmp_label); } } $table->pack(); my $button_frame = $mw->Frame( -borderwidth => 4 )->pack(); $button_frame->Button(-text => "Exit", -command => sub {exit})->pack(); MainLoop;

Executing this script generates the GUI application shown in Figure 6.

Figure 6. An example of the Table widget

Let's break down the script.

You guessed it! Another new widget must be included, for Perl to know how to handle the Table widget:

use Tk::Table;

In the previous examples, the end user could resize the applications. This script prohibits the user from resizing the window:

$mw->resizable(0,0);

Create a frame to contain the new table. Then, create the Table widget, which displays eight columns and four rows:

my $table_frame = $mw->Frame()->pack(); my $table = $table_frame->Table(-columns => 8, -rows => 4, -fixedrows => 1, -scrollbars => 'oe', -relief => 'raised');

To place data in the table, you use the put operation. Looping through eight times, the text "COL" is added to the number of the column and placed in the first (0th) row of the table:

foreach my $col (1 .. 8) { my $tmp_label = $table->Label(-text => "COL " . $col, -width => 8, -relief =>'raised'); $table->put(0, $col, $tmp_label); }

Now that the header has been created, the coordinates are placed in the respective cell. Again, using the put operation, loop through each row and each column and assign the cell's text. Then, pack the finalized table:

foreach my $row (1 .. 8) { foreach my $col (1 .. 8) { my $tmp_label = $table->Label(-text => $row . "," . $col, -padx => 2, -anchor => 'w', -background => 'white', -relief => "groove"); $table->put($row, $col, $tmp_label); } } $table->pack();

Canvas

The Canvas widget is a useful drawing tool in the Perl/Tk module. Using this widget, a user can draw and manipulate different shapes and objects such as lines, ovals, rectangles, and polygons:

#!/usr/bin/perl -w use Tk; use strict; my $mw = MainWindow->new; $mw->geometry("400x400"); $mw->title("Canvas Example"); my $canvas = $mw->Canvas(-relief => "sunken", -background => "blue"); $canvas->createLine(2, 3, 350, 100, -width => 10, -fill => "black"); $canvas->createLine(120, 220, 450, 200, -fill => "red"); $canvas->createOval(30, 80, 100, 150, -fill => "yellow"); $canvas->createRectangle(50, 20, 100, 50, -fill => "cyan"); $canvas->createArc(40, 40, 200, 200, -fill => "green"); $canvas->createPolygon(350, 120, 190, 160, 250, 120, -fill => "white"); $canvas->pack(); $mw->Button(-text => 'Exit', -command => sub {exit})->pack();; MainLoop;

Executing this script generates the GUI application shown in Figure 7.

Figure 7. An example of the Canvas widget

Let's break down the script.

This code creates the Canvas widget:

my $canvas = $mw->Canvas(-relief => "sunken", -background => "blue");

Create a black line that has a width of 10, and draw it from (2, 3) to (350, 100). When you're working with objects and shapes in a Canvas widget, the first group of numeric values are the coordinates. It's easiest to view an object with the formula <object>(x1, y1, x2, y2, ....) :

$canvas->createLine(2, 3, 350, 100, -width => 10, -fill => "black"); $canvas->createLine(120, 220, 450, 200, -fill => "red");

Create a yellow oval from (30, 80) to (100, 150) on the Canvas widget:

$canvas->createOval(30, 80, 100, 150, -fill => "yellow");

Create a cyan rectangle from (50, 20) to (100, 50) on the Canvas widget:

$canvas->createRectangle(50, 20, 100, 50, -fill => "cyan");

Create a green arc from (40, 40) to (200, 200) on the Canvas widget:

$canvas->createArc(40, 40, 200, 200, -fill => "green");

Create a white polygon from (350, 120) to (190, 160) and (250, 120) on the Canvas widget:

$canvas->createPolygon(350, 120, 190, 160, 250, 120, -fill => "white");

After all the objects have been created, as always, pack the widget:

$canvas->pack();

Conclusion

Introducing Perl with the Perl/Tk module into an AIX environment can benefit the developer, administrator, and customer or end user. What began as a script that may look dull to the customer can be enhanced into a professional-looking GUI application. It may take you a short time to get the hang of the widgets, but once you've mastered them, the results are worth the effort!

Downloadable resources

Related topics