Online Documentation Server
 ПОИСК
ods.com.ua Web
 КАТЕГОРИИ
Home
Programming
Net technology
Unixes
Security
RFC, HOWTO
Web technology
Data bases
Other docs

 


 ПОДПИСКА

 О КОПИРАЙТАХ
Вся предоставленная на этом сервере информация собрана нами из разных источников. Если Вам кажется, что публикация каких-то документов нарушает чьи-либо авторские права, сообщите нам об этом.




Chapter 17

GUI Interfaces with Perl/Tk


CONTENTS


This chapter introduces you to using the Perl/Tk package to create graphical user interfaces (GUI) with Perl. After reading and working through the examples in this chapter, you should be able to create interactive user interfaces for your Perl scripts with very short design times.

Introduction to the Perl/Tk Package

The set of Tk modules attempts to tie the Tk widget toolkit with Perl 5. The set is referred to as Perl/Tk, pTk, or even ptk. The idea behind the merging of this set is to get the best features of both languages: Perl has very good text handling, regular expression support, dynamic memory, file and pipe I/O, and object-oriented capabilities for processing data; Tk gives you a quick and easy way to create GUI programs. Perl/Tk is most easily used on a UNIX computer platform running the X Window system. Perl/Tk does not require any of the lexical features of the Tcl scripting language. In other words, you do not have to be an expert at Tcl/Tk, but it will be in your best interest to have worked with the Tcl/Tk toolkit on its own to take the most advantage of the Perl/Tk package.This chapter will not make you a Tk expert. I assume you have a rudimentary working knowledge of Tcl/Tk programming. However, if you have never used Tcl/Tk before, now would be a good time to read the sample code for your Tcl/Tk package on your system. Here is a good starting reference book by the author of Tcl himself, Dr. John K. Ousterhout, professor at the University of California at Berkeley:

Tcl and the Tk Toolkit, John K. Ousterhout, ISBN 0-201-63337-X,
Addison-Wesley Publishing Company, 1994

There is one thing to remember when reading his book: You still have to translate the Tcl/Tk scripts to Perl.

The pTk library is a version of the Tk 4.0 toolkit. The library allows easier external linking and calling by Perl scripts and can be modularized. A number of composite widget extensions to the language have been written using Perl modules. Note that ptk does not necessarily refer to Perl/Tk, but could be taken to mean portable Tk; that is, portable to another language such as Perl, C, LISP, C++, and so on. It just so happens that our present work concentrates on Perl.

About the Authors of the Perl/Tk Package

The Perl/Tk package is still in beta phase and is being written primarily by Nick Ing-Simmons <Nick.Ing-Simmons@tiuk.ti.com> at Texas Instruments in Northampton, England. Mr. Nick was gracious enough to let us use his examples as the basis for the code samples in this chapter. He asked me to remind you that he is no way liable for how you use his package. He also requests that you give him credit for his authorship when you do use it. With regard to liability, he provides the following comments:

License Agreement
IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY FOR DIRECT, INDIRECT, SPECIAL, IncIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE POSSIBILITY OF SUch DAMAGE.
THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, IncLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERchANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENAncE, SUPPORT, UPDATES, ENHAncEMENTS, OR MODIFICATIONS.

TkPerl was originally the name of a Perl 4 package that Mr. Malcolm Beattie, <mbeattie@sable.ox.ac.uk>, at Oxford University used to mesh the Tk toolkit with Perl. He also authored a Tcl module for Perl 5 with a Tcl::Tk module extension. That module allows the use of Tcl within a Perl script. You still must know both languages to get your widgets to work. I do not cover these libraries here.

Tip
The name Tkperl is sometimes applied to the Perl/Tk, pTk, or ptk package.

Caution
Do not attempt to install both perl/Tk and Tcl/Tkperl in the same Perl installation. The names in the respective modules must overlap or something. I had the darnedest time getting some of scripts to work right. Turns out that there is a warning note in the FAQ about this behavior. I could not get both of them to work together in the same Perl installation tree. Bowing to editorial schedules, I blew away all the Tk* directories and installed Tk-b9.01 only. Things improved a bit, but some of the samples do not work at all.

A more extensive comparison of the differences between the Tkperl and the Perl/Tk code is given in the Tcl-perl.pod file that is distributed with the latest Perl/Tk package. The FAQs for Perl/Tk did provide some hints about getting the two packages to work together along with some friendly warnings about it not being very easy to do.

Where Do I Get and Build Perl/Tk?

At the time this book was written, the latest version was Tk-b9.01. You'll need Perl 5.002b1 or later to be able to work with the Tk-b9.01 kit. If you are like me and are skipping chapters while reading a book, don't skip the installation of Perl 5.002. There are some patches to 5.001m, but the 5.002 code will already have these patches in there. You need Perl 5.002, so install it first.

You can get the toolkit from any CPAN site. Here are the sites where I found the latest versions:

ftp://ftp.cis.ufl.edu/pub/perl/CPAN/
ftp://ftp.uoknor.edu/mirrors/CPAN/
ftp://ftp.metronet.com/pub/perl
ftp://ftp.perl.com/CPAN

Several more sites are listed in the FAQ and via the search results in Netscape Navigator. Try to get the package from a site that's geographically nearest you.

Building the Perl/Tk package after you get it is going to take some time and effort on your part. If you get any errors, most of them will be due to the use of out-of-date libraries or the wrong version of Perl, or both. Read the following directions carefully before you begin the installation.

First, unpack perl/Tk in your home directory. This will be your Tk build directory and will not corrupt any existing Perl 5 tree should something go wrong. Unzip and untar the files in this test directory. Use these commands:

gunzip Tk-b9.01.tar.gz
tar -xvf Tk-b9.01.tar

Next, create the make files. First, change the directory to the Tk/build directory, and then run the following commands to get to the directory, create the Makefiles, and create the package, respectively:

cd Tk-b9.01    
perl Makefile.PL
make
make install          

After you have built the files, check to see if you had any errors.

It's not a good idea to take a coffee break while this builds because some error messages might not be fatal and you may have an incomplete build and not see the error messages fly by. Take note of any missing references to libraries or header files.

If there were any errors due to missing make files or references to some header files, check the cc command in the make files for the directory with the offending error. Chances are that you do not have any inclusions of the pTk subdirectory header files. To help this out, try including the $(Inc) variable in the $ccCMD statement in the GNUmakefile file. You may have to do this for all the subdirectories under the Tk directory. Most of the errors I got during the build process were correctable with this inclusion.

Now, test the demo programs in the ./Tk/demos directory. Not all of the demos worked on my Linux system. The major complaint concerns CreateArgs() in the Toplevel module causing too many recursive calls. You may fare better. Minor tweaking did not remove this error. Major surgery seemed too daunting a task at this stage. Basically, any demo involving dialog boxes did not work. Do not waste your time trying to get these demos to work. Here is the error message that showed this problem:

Deep recursion on subroutine "CreateArgs"
at /usr/lib/perl5/Tk/Toplevel.pm line 16.

Even with this annoying bug, you should be able to install and work with the rest of the
package.

If you use the most current versions of the C++ compiler and make files, circa 1994 or later, and X11R6, you should have no problems. In case of problems, please consult the FAQ, INSTALL, or README files for your specific system.

Tip
Keep in mind that your installation may have Perl in a different place than shown here. Instead of /usr/bin/perl, you may have to use /usr/local/bin/perl.

Documentation for Perl/Tk

The make install execution installs the pod files for you in nroff format. Check the perl5/Tk/ directory for the file UserGuide.pod. This file is editable and readable by humans. pod files have to be interpreted through a reformatting program such as pod2man, pod2html, or pod2latex, all of which should be in your Perl distribution.

The following commands provide you with information in HTML files or in man pages:

pod2man ~khusain/p5/Tk/UserGuide.pod | nroff -man | more
pod2html ~khusain/p5/Tk/UserGuide
perldoc Toplevel.pm

The most visually pleasing of the three methods is the pod2html method:

$ pod2html perl5/Tk/Dial.pm
Creating Dial.pm.html from Dial.pm

The output of this command is as follows (you can use Mosaic or Netscape to view the contents of this file):

<!-- $Id$ -->
<HTML><HEAD>
<CENTER><TITLE>Dial.pm</TITLE>
</HEAD>
<BODY></CENTER><p><hr>

<H1>
<A NAME="Dial.pm_name_0">
NAME</A>
</H1>
Dial - an alternative to the scale widget
<p><p><hr>

<H1>
<A NAME="Dial.pm_synopsis_0">
SYNOPSIS</A>
</H1>

<XMP>
 use Tk::Dial;
 $dial = $top->Dial(-margin =>  20,
                    -radius =>  48,
                    -min    =>   0,
                    -max    => 100,
                    -value  =>   0,
                    -format => '%d');
 margin - blank space to leave around dial
 radius - radius of dial
 min, max - range of possible values
 value  - current value
 format - printf-style format for displaying format

</XMP>
<p>Values shown above are defaults.
<p><p><hr>

<H1>
<A NAME="Dial.pm_description_0">
DESCRIPTION</A>
</H1>
A dial looks like a speedometer: a 3/4 circle with a needle indicating the current value.  Below the graphical dial is an entry that displays the current value, and which can be used to enter a value by hand. <p>The needle is moved by pressing button 1 in the canvas and dragging. The needle will follow the mouse, even if the mouse leaves the canvas, which allows for high precision. Alternatively, the user can enter a value in the entry space and press Return to set the value; the needle will be set accordingly.
<p><p><hr>

<H1>
<A NAME="Dial.pm_to_0">
TO DO</A>
</H1>

<XMP>
 Configure
 Tick marks
 Step size

</XMP>
<p><p><hr>

<H1>
<A NAME="Dial.pm_authors_0">
AUTHORS</A>
</H1>
Roy Johnson, <A HREF="MAILTO:rjohnson@shell.com">rjohnson@shell.com</A>
<p>Based on a similar widget in XV, a program by John Bradley,
<A HREF="MAILTO:bradley@cis.upenn.edu">bradley@cis.upenn.edu</A>
<p><p><hr>

<H1>
<A NAME="Dial.pm_history_0">
HISTORY </A>
</H1>

<XMP>

August 1995: Released for critique by pTk mailing list

</XMP>
<p>
</BODY>
</HTML>

Also in the Tk-b9.01/doc directory are some .ht files which are copyrighted HTML pages of the documentation for the package.

Writing Scripts in Perl/Tk

The idea behind writing the Perl/Tk script using the modules for the package is to make life easier. The scripts have to include the Tk package with the use Tk; statement. You might want to consider using the warning switch (-w) and, if you are paranoid, use the use strict; statement to do extra syntax checking.

Look at the simple "Hello, world" script shown in Listing 17.1.


Listing 17.1. A simple "Hello, world" script.
 1  #!/usr/bin/perl -w
 2  #
 3  # Simple Tk script to create a button that prints "Hello, world".
 4  #
 5  use Tk;
 6  $mw = MainWindow->new;
 7  $hello = $mw->Button(-text => 'Hello, world',
    Â -command => sub {print STDOUT "Hello, world\n"; });
 8  $greet = $mw->Button(-text => 'Greetings',
    Â -command => sub {print STDOUT "Greetings\n"; exit;});
 9  $hello->pack;
10 $greet->pack(-side => "left");
11 MainLoop;

The first line in the file starts Perl with the -w switch for warnings to be issued, if necessary. Line 5 imports the Tk objects into the application. The statement in line 6 creates the main window. The "Hello, world" and Greetings buttons are created in lines 7 and 8. In line 9, the Hello button is added to the main window. In line 10, the Greetings button is pack-ed into the main window on the left side of the Hello button. (I cover pack-ing later throughout this chapter.) Line 11 starts the main user interface loop for this application. The output is shown in Figure 17.1.

Figure 17.1 :Sample "Hello, world" application.

The MainLoop; statement is the main widget event handler loop and is required in all Perl/Tk scripts. This event handler statement is usually near the end of the main procedure after the widgets have been created and are ready to be displayed.

In Listing 17.1, note that the Greet button defines an anonymous function (at line 8) with a call to the exit function. In line 7, the hello world function does not call the exit function.

The objects in this application are added one object at a time in a hierarchical order. This
involves the use of the -> infix dereference operator; for example, the $mw->Button(...) call forces the button to be created with the $mw object as the parent. Almost all objects and parameters in calls to Perl/Tk routines are passed by reference.

Please note the use of the => operator, which is simply a synonym for the comma operator. The program in Listing 17.1 could be rewritten as shown in Listings 17.2 and 17.3.


Listing 17.2. The "Hello, world" application using commas.
 1 #!/usr/bin/perl -w
 2 #
 3 # Using commas instead of =>.
 4 #
 5
 6 use Tk;
 7 $mw = MainWindow->new;
 8 $hello = $mw->Button(-text , 'Hello, world',
   Â-command , sub {print STDOUT "Hello, world\n"; });
 9 $greet = $mw->Button(-text , 'Greetings',
   Â-command , sub {print STDOUT "Greetings\n"; exit;});
10 $hello->pack;
11 $greet->pack(-side , "left");
12 MainLoop;


Listing 17.3. The "Hello, world" application using hashes.
 1 #!/usr/bin/perl -w
 2 #
 3 # Using Hashes instead of dereferencing using ->
 4 #
 5
 6 use Tk;
 7 $mw = MainWindow->new;
 8 my %hello = ('-text' , 'Hello, world',
   Â'-command' , sub {print STDOUT "Hello, world\n"; });
 9 my %greet = ('-text' , 'Greetings',
   Â'-command' , sub {print STDOUT "Greetings\n"; exit;});
10 $mw->Button(%hello)->pack;
11 $mw->Button(%greet)->pack('-side', "left");
12 MainLoop;

As you can see, you have a lot of flexibility in how you write your application. If you need more information on references, please refer to Chapter 3, "References," to see why Listing 17.3 works.

Widgets as Building Blocks

Basically, a widget can be "created" by simply calling the new method of the class name. For example, to create a new window, you use the following statement:

my $main = new MainWindow;
  ... code here to add widgets ...
MainLoop;

This statement sets aside the necessary system memory, and so on for a new MainWindow widget. The MainLoop; call causes it to appear. The object "created" then can be called via the variable $main.

It's a good idea to hang on to each object as it's created in the hierarchy. This way you can refer to the object explicitly should you need to change its parameters. Thus, the return values of most of your calls to create items are assigned to a variable:

$mybutton = $main->Button();

Now you can use $mybutton to refer to this Button object.

Configuring Widgets

Widgets are configurable to show different types of viewing styles. You can provide a number of configuration parameters via calls to the configure() function. Configuration parameters also can be sent in when the widget is created. For example, these two statements are equivalent:

my $button = $main->Button();
$button->configure(-text => 'Hello!');

and

my $button = new $main->Button(-text => 'Hello');

The "Hello, world" application is simple enough to demonstrate the use of Button widgets in Perl/Tk. You do have access to more widgets that you can use to create your own widgets. Check the subdirectories under the Tk-b9.01 tree to see what the widgets are. The Canvas widget is in the Canvas subdirectory.

The following Tk widgets are available under perl/Tk:

Checkbutton Allows all, some, or no selections from multiple selections.
Button It's set to ON or OFF.
Radiobutton One of many selections.
Listbox Allows user to select from a list of items.
Scrollbar For pointer usage.
Entry Text entry widget.
Text Text display widget.
Canvas For drawing on.
Frame For placing other widgets on.
Toplevel For a new independent window.
Menu An area set aside for menu buttons.
Menubutton For a menu button on an area for a menu.

Each of these widgets comes with its own set of configurable parameters. As you work with these widgets you'll become familiar with the parameters associated with them. The best way to know which parameters are configurable is to check the Perl/Tk reference manuals to see what parameters are available for each type of widget.

The MainWindow widget is required for your applications. This widget serves as the main window for your Perl/Tk applications. Several functions exist for use as methods for this MainWindow object. For example, to set the title in the window, use the following command:

$main->title(" A sample window");

I cover some of these methods in the next few sections. Let's first see how we can place widgets on the main window.

Using CheckButton Widgets

Using check buttons is relatively easy. See Listing 17.4. The output is shown in Figure 17.2. The three buttons are shown side-by-side in the same window. If the parameters specifying the sides on the left are removed, the buttons appear as shown in Figure 17.3. You get this output by uncommenting the lines that create the buttons in Listing 17.4.

Figure 17.2 :Using Check buttons.

Figure 17.3 :Using check buttons without packing.


Listing 17.4. Using check buttons.
 1 #!/usr/bin/perl
 2
 3 use Tk;
 4
 5         #
 6         # Using Checkbuttons.
 7         #
 8
 9 my $main = new MainWindow;
10
11 $main->Checkbutton(-text => 'One'  )->pack;
12 $main->Checkbutton(-text => 'Two'  )->pack;
13 $main->Checkbutton(-text => 'Three' )->pack;
14
15 #
16 # Uncomment these lines to get the buttons to be side by side.
17 #
18 # $main->Checkbutton(-text => 'One')->pack(-side => 'left');
19 # $main->Checkbutton(-text => 'Two')->pack(-side => 'left');
20 # $main->Checkbutton(-text => 'Three ')->pack(-side => 'left');
21
22 MainLoop;

Using RadioButton Widgets

Radio buttons let you select one of many options, whereas check buttons allow you to select as many as possible. When using check buttons, you can press more than one button at a time. With radio buttons, you are showing several alternatives to an option. The value of the option is only one of several presented.

You have to specify the variable option on each radio button. The value of the -variable option is the escaped global Perl variable that will be assigned the value. All related radio buttons have to be assigned the same variable. Pressing each radio button causes the value of the variable to be set. Thus, each radio button has to set the value of the variable, too, with the -value configuration parameter. See Listing 17.5 for a sample script. The output is shown in Figure 17.4.

Figure 17.4 :Using radio buttons in Perl/TK scripts.


Listing 17.5. Using radio buttons.
 1  #!/usr/bin/perl
 2
 3  use Tk;
 4              #
 5              # Using RadioButtons.
 6              #
 7  my $main = new MainWindow;
 8  $main->title("Select Delicacy");
 9  #
10 # Declare the global variable
11 #
12 $animal = 'anything';
13 $main->Radiobutton(-text => 'Yak', -variable => \$animal,
14             -value => "Yak",
15             -command => sub {print "$animal \n"; } ,
16 )->pack(-side => 'left');
17 $main->Radiobutton(-text => 'Camel', -variable => \$animal,
18             -value => "Camel",
19             -command => sub {print "$animal \n"; } ,
20 )->pack(-side => 'left');
21 $main->Radiobutton(-text => 'Llama', -variable => \$animal,
22             -value => "Llama",
23             -command => sub {print "$animal \n"; }
24             )->pack(-side => 'left');
25 MainLoop;

Let's examine the new lines of code in Listing 17.5 in detail. Line 8 sets the title of the application window to Select Delicacy. Line 12 declares and sets the value of the global variable $animal to anything.

Lines 13 through 16 specify the first Radiobutton with the title Yak. The variable whose value will be set when this button is pressed is specified in the -variable parameter value. Note the escaped dollar sign for the name of the variable $animal. The -command configuration parameter specifies the anonymous subroutine to call when the button is pressed. The subroutine simply prints the value of the variable. You can add your code here.

In lines 17 through 20 and lines 21 through 24, two more radio buttons are specified that set the values of $animal to 'Camel' and 'Llama', respectively.

Calling Subroutines When a Button Is Pressed

You can add subroutines to call when a button is pressed. The examples in Listing 17.1 and 17.5 are two examples of this. You may specify the -command option in the call to create and pack the button (in Listing 17.5, this was done with lines 15, 19, and 23):

-command => sub {print "$animal \n"; } ,

You can refer to a subroutine by using the escaped ampersand with the name of the subroutine. Any parameters that have to be passed to the subroutine have to be specified with the -command parameters as one list. For example, consider the following function which creates a button with a caption of Stats, and calls the subroutine do_print when the button is pressed:

$main->Button(-text => 'Stats',
              -command => [ \&do_print , $inputfile, $outputfile ]
             )->pack;

Note the backslash in front of \&do_print. This causes Perl to generate a reference to sub do_print rather than call it. The input variables, $inputfile and $outputfile, are passed by reference not by value, into the do_print subroutine.

Arranging the Layout of Widgets

Widgets are laid out on a window using the -pack, -padding, -fill, -expand, and -anchor options of a widget. Windows also use a program called a geometry manager in Tk.

A geometry manager controls the arrangement of widgets in a window. The most common geometry manager used in pTk is pack. You have seen the use of the -pack function to place buttons on a window in earlier sections of this chapter. The pack function is also known informally as the "packer." You can invoke pack at the time of widget creation via calls like

$widget->pack;

where widget can be any of the Perl/Tk widget primitives. The pack function is often used in conjunction with the Frame container widget to arrange your widgets much like a hierarchically arranged set of window panes. See Listing 17.6 and Figure 17.5.

Figure 17.5 :The output from Listing 17.6.


Listing 17.6. Packing using frames.
 1 #!/usr/bin/perl
 2 use Tk;
 3
 4 $main = MainWindow->new;
 5
 6     my $row1 = $main->Frame;
 7     $row1->pack(-side => 'top');
 8     my $row2 = $main->Frame;
 9     $row2->pack(-side => 'bottom');
10     $row1->Label(-text => 'Left',
       Â-relief => 'sunken' )->pack(-side => 'left');
11     $row1->Label(-text => 'Right',
       Â-relief => 'sunken' )->pack(-side => 'right');
12     $row2->Label(-text => 'Left 2',
       Â-relief => 'ridge' )->pack(-side => 'left');
13     $row2->Label(-text => 'Right 2',
       Â-relief => 'ridge' )->pack(-side => 'right');
14     MainLoop;

In Listing 17.6, we used two frames: one on the top and the other on the bottom. These frames are called $row1 and $row2 and are created in lines 6 through 9. Then lines 10 and 11 create the two labels in $row1, and in lines 12 and 13, two more labels are created on the second frame. In this fashion we have packed labels on frames, and the frames are then packed onto the main window. You can think of this as building a Mayan temple of sorts with widgets being placed one on top of the other.

Note that pack itself is given parameters in this example. The default behavior of pack is to have -side => 'top', that is, align everything using the top edge. You can override this behavior by specifying a different packing style such as "left", "right", or "bottom".

The Tk* distribution has a file called popup that uses the -anchor option to configure the layout of the Radiobutton widgets. The output of this demo is shown in Figure 17.6. Run the following program to get the listing with line numbers for reference.

Figure 17.6 :Using the -anchor widget option.

$ nl popup | more

There is also the -anchor configuration option for widgets. There are introductions to the nine possible -anchor values, eight corresponding to the points on a compass and the ninth as the center position. The nine possible values are set around line 22 with list:

foreach $r ([qw(nw n ne)],[qw(w c e)],[qw(sw s se)])

In the beginning of the file, we create a small popup window to show when a button is clicked. Rather than create this window every time, a button is created but is not shown immediately. Around lines 13 through 17, the subroutine Show shows this window and requests it to be invisible after one second.

In the subroutine Anchor, a master frame is created (see line 21) with a ridge around it. Then three frames are placed on it, each with three buttons showing the anchor positions (see lines 25 through 29). The positions and the labels for the buttons are shown in line 22.

When setting lots of uneven widgets on the same frame, you can make their borders the same size by using -fill => 'style'. The style can be none | x | y | both. See the modified version of the radio button application and contrast the code in Listing 17.7 with the code in Listing 17.4. The output is shown in Figure 17.7, which you can compare with Figure 17.3 to see how the buttons with their borders are now shown and resized.

Figure 17.7 :Using the -fill option.


Listing 17.7. Using the -fill option.
 1 #!/usr/bin/perl
 2
 3 use Tk;
 4
 5 #
 6 # Using Checkbuttons and the -fill option.
 7 #
 8
 9 my $main = new MainWindow;
10 $main->title("fill");
11
12 $main->Checkbutton(-text => 'One',
13       -relief => 'ridge',
14       -command => sub {print "One \n"; } )->pack(-fill => 'x');
15 $main->Checkbutton(-text => 'Two',
16       -relief => 'sunken',
17       -command => sub {print "Two \n"; } )->pack(-fill => 'x');
18 $main->Checkbutton(-text => 'Three',
19       -relief => 'groove',
20       -command => sub {print "Three \n"; } )->pack(-fill => 'x');
20
21 MainLoop;

When laying out your widgets, look at their behavior with multiple resize operations. The -expand option of either pack or the widget itself can be used to set whether the widget expands or shrinks with its parent. Add the statement for packing the buttons in Listing 17.8; the buttons will shrink or expand as the main window is resized.


Listing 17.8. Using the Expand button.
1 $main->Checkbutton(-text => 'One',
2        -relief => 'ridge',
3        -command => sub {print "One \n"; } )->pack(-fill => 'x', -expand => '1');
4 $main->Checkbutton(-text => 'Two',
5        -relief => 'sunken',
6        -command => sub {print "Two \n"; } )->pack(-fill => 'x', -expand => '1');
7 $main->Checkbutton(-text => 'Three',
8        -relief => 'groove',
9        -command => sub {print "Three \n"; } )->pack(-fill => 'x', -expand => '1');

The output of this change to Listing 17.7 is shown in Figure 17.8. Remember to make this change to all the pack calls for the buttons.

Figure 17.8 :Using the -expend option.

Using the Listbox and Scrollbar Widgets

Now that you know how to place items on a frame widget, let's see how you create a list of scrollable items. For this exercise, you'll use the Listbox and Scrollbar widgets. The output we are trying to get is shown in Figure 17.9. The code to get this output is shown in Listing 17.9.

Figure 17.9 :Using the Listbox and Scrollbar widgers.


Listing 17.9. Using the Listbox and Scrollbar widgets.
 1 #!/usr/bin/perl
 2 use Tk;
 3
 4 my $main = new MainWindow;
 5 #
 6 # Provide another title ...
 7 #
 8 $main->Label(-relief => raised,
 9         -text => "Tax Confusion" )->pack(-side => 'top', -fill => 'x');
10 $main->title("Test Listbox");
11 $w_list = $main->Listbox(-relief => 'raised',
12                          -setgrid => 'yes');
13 #
14 # Create a list of words of wisdom
15 #
16 my @items = qw( Passive activity income
              does not include the following:
17            Income for an activity
              that is not a passive activity - IRS Form 8583);
18 foreach (@items) {
19            $w_list->insert("end", $_);
20 }
21 #
22 # Create the scrollbar
23 #
24 $w_scroll = $main->Scrollbar(-command => ['yview', $w_list]
25            )->pack(-side => 'right', -fill => 'y');
26 #
27 # Now tie the scrollbar to  listbox.
28 #
29 $w_list->configure( -yscrollcommand => ['set', $w_scroll]);
30 #
31 # show the listbox.
32 #
33 $w_list->pack(-fill => 'y');
34 MainLoop;

Scrollbars are commonly used to update the items shown in Listbox, Canvas, or Text widgets when the slider of the scrollbar is moved by the user. In Listing 17.9 (line 24), the scrollbar is created with the yview option. For a horizontal scrollbar, use the xview option. In line 29, the listbox is tied to the scrollbar to perform the scrolling action in the y direction.

Note also how the label, Listbox, and Scrollbar are packed in the window. Had the -fill option not been used, the widgets would not be shown in the entire height or width of the window.

To allow more than one listbox to contain a "selection" (or at least a highlighted item), specify this configuration option:

-exportselection => 0

Using Text Widgets

The Text widget is simply a widget that enables user entry. The default way to create a Text widget is shown here:

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

my $mw = MainWindow->new();
$txt = $mw->Text(-width => '80', -height => '100') -> pack;
MainLoop;

Note that the default size of a Text widget is very big for most screens. You might want to limit the size with the -height and -width options to set the same size. The values are given in the number of characters, not the number of pixels.

Using the code in the Scrollbar and Listbox examples, you can attach scrollbars to create fairly sophisticated editors very quickly using Perl/Tk.

Specifying Fonts for Text and Other Widgets

To specify the font configuration option of your widget, use the -font option. See the following example:

my $mw = MainWindow->new();
$txt = $mw->Text(-width => '40', -height => '20', -font => 'fixed') -> pack;

The 'fixed' value is the name of the font. You can check your fonts.alias file for more font names to use or look at the output from the xlsfont command.

Text Entry Widgets

You want to call the get() function on the return value of the widget itself. Here is how it may be used in a simplified version of Example 1.1 from the Tk::UserGuide, where a Button is set up to call a sub where the call to get lies. Check the POD file, UserGuide.pod, in the distribution for more information. The output is shown in Figure 17.10.

Figure 17.10 :Using the Text Entry widget.


Listing 17.10. Using the Text Entry widget.
 1 #!/usr/bin/perl -w
 2
 3     use Tk;
 4
 5     my $mw = MainWindow -> new();
 6     my $entry = $mw -> Entry();
 7     $entry -> pack;
 8
 9     $txt = $mw->Text(-width => '10', -height => '10')->pack;
10
11     $mw->Button(-text => 'Dino',
12                   -command => sub{Echo($entry, $txt)}
13                   )->pack;
14     MainLoop;
15
16     sub Echo {
17         my ($widget, $txt) = @_;
18
19             #
20             # Show the values of the Text Entry widget
21             #
22         my $entered = $widget -> get(); # Get the input
23         print "The string \"$entered\" was entered.\n";
24
25             #
26             # Show the values of the Text widget
27             #
28         my $text = $txt ->Contents(); # Get the input
29         print "The Text \"$text\" was entered.\n";
30     }

For collecting passwords, set the value of the -show option to zero:

(-show => 0);

Handling the Keyboard with Key Bindings

Using the pointer interface is not the only way to collect input in your Perl/Tk programs. There are many default key bindings built into the widgets of Perl/Tk. Making proper use of them often involves setting up the right callback. Read the documentation in BindTable.pod in the Tk package for more detailed help with this subject.

The way to bind a key to a widget is to use

$widget -> bind('<keyname>' => action);

where $widget is the object to which the keys are bound. For global bindings you have to bind to <All>. For specific bindings you need to bind to each widget.

Use the following script on each .pm file for which you want to find key bindings:

#!/usr/bin/perl
while (<>) {
            print if s/.*(<[^>]*>).*/$1/g;
}

When run on the Listbox.pm file, this script reveals a lot of key bindings. Some modules even show <HANDLE> and <ARGV>, so you have to know what to ignore. Also, bound keys are inherited, so listing one module's bindings may not be complete if any properties are inherited from other sources. The output from the Listbox.pm file is as follows:

<1>
<B1-Motion>
<ButtonRelease-1>
<Shift-1>
<Control-1>
<B1-Leave>
<B1-Enter>
<Up>
<Shift-Up>
<Down>
<Shift-Down>
<Control-Home>
<Shift-Control-Home>
<Control-End>
<Shift-Control-End>
<space>
<Select>
<Control-Shift-space>
<Shift-Select>
<Escape>
<Control-slash>
<Control-backslash>
<2>
<B2-Motion>

Note the <1> and <2> in the output.

Tip
Do not use the %k symbols for Tcl/Tk in Perl scripts. The %k symbols will be misinterpreted as nonexistent Perl hashes.

Listing 17.11 illustrates how to read the button and key bindings from Xevents.


Listing 17.11. A sample key bindings display program.
 1 #!/usr/bin/perl -w
 2 use Tk;
 3
 4     $mw = MainWindow->new();
 5     $frame = $mw->Frame( -height => '6c', -width => '6c',
 6                           -background => 'black');
 7     $frame->pack;  # show the frame
 8     $mw->bind( '<Any-KeyPress>' => \&echo);  # for all keys
 9     $mw->bind( '<ButtonPress>' => \&echoPress);  # for all keys
10     $mw->bind( '<ButtonRelease>' => \&echoRel);  # for all keys
11
12     MainLoop();
13
14     sub echoRel {
15      print "Button Release \n";
16         my($btnc) = @_;
17         my $e = $btnc->XEvent;
18         my( $x, $y ) = ( $e->x, $e->y, $e->K, $e->W, $e->A );
19         print "  x coor  = $x\n";
20         print "  y coor  = $y\n";
21     }
22     sub echoPress {
23      print "Button Press \n";
24         my($btnc) = @_;
25         my $e = $btnc->XEvent;
26         my( $x, $y ) = ( $e->x, $e->y, $e->K, $e->W, $e->A );
27         print "  x coor  = $x\n";
28         print "  y coor  = $y\n";
29     }
30
31     sub echo {
32      print "Any Key Press \n";
33         my($keyc) = @_;
34         my $e = $keyc->XEvent;
35         my( $x, $y, $W, $K, $A ) = ( $e->x, $e->y, $e->K, $e->W, $e->A );
36
37         print "  x coor  = $x\n";
38         print "  y coor  = $y\n";
39         print "  KeyCode = $W\n";
40         print "  ASCII   = $A\n";
41         print "  Window  = $K\n";
42     }

Displaying a Bitmap

To display .xbm bitmaps on your widgets, use the -bitmap configuration option. Typically, -bitmap options are used with Label, Frame, Button, and other types of widgets. Canvas widgets have to be treated differently. See the section on "The Canvas Widget" later in this chapter. To specify a bitmap, use the -bitmap option as follows:

$main->Button(-bitmap => 'hourglass')->pack;

The names of the bitmaps built into Tk are gray50, hourglass, info, question, questhead, and warning. In order to use some of the bitmaps outside the package, you need to specify a full pathname like this:

$main->Label(-bitmap => "\@$tk_library/demos/cartoons")->pack;

You have to use the escape (\@) with the directory specification. If you wanted to specify a file called mailbox.xbm in the directory where you were running the script, then either of the following two commands should work:

$main->Label(-bitmap => '@mailbox.xbm')->pack;
$main->Label(-bitmap => "\@mailbox.xbm")->pack;

If no explicit pathname is given, the directory is assumed to exist in the current working
directory. To specify a full pathname, try this command:

$main->Label(-bitmap => "\@/dirty/pix/filth.xbm")->pack;

Displaying Images with Photo

The Photo method in main lets you place GIF images on a button or label. The type supported by Photo is called 'imggif'. See Listing 17.12 and Figure 17.11 for how to use this feature.

Figure 17.11 :Using images in labels.


Listing 17.12. Using images in labels.
 1 #!/usr/bin/perl -w
 2 use Tk;
 3
 4     my $main = new MainWindow;
 5
 6     $main ->Label(-text => 'Demo')->pack;
 7     $main -> Photo('imggif', -file => "lbl.gif");
 8
 9     my $labelImage = $main->Label('-image' => 'imggif')->pack;
10
11     $main->Button(-text => 'close',
12                   -command => sub{destroy $main}
13                   )->pack(-side => 'left');
14
15     $main->Button(-text => 'exit',
16                   -command => [sub{exit}]
17                   )->pack(-side => 'right');
18     MainLoop;
19 :

The following formats and file extensions are supported: X11 bitmaps (.xbm), X pixmaps (.xpm), and the graphics interchange format (.gif). There are several demos in the Tk package and on CPAN sites.

Menus

The Perl/Tk package gives excellent support for menus. The demo program that comes with the package itself is a great example. I wish I knew the author of this program because I have not found a neater menu usage demonstration elsewhere. Run nl on it to get line numbers and a listing for yourself. The program is not listed here. Check the Tk-b9.01/demos/tom file.

This program demonstrates the following items with sample code referred to by line numbers:

  • How to set up menu frames to put items on (line 13)
  • How to add menu buttons to the frame (line 34)
  • How to attach callbacks to menu items (line 39)
  • How to bind keys to menu items (lines 59-65)
  • How to add check buttons (line 79)
  • How to add radio buttons (line 84)
  • How to add color bars (line 135)

To get tear-off menus, use the -tearoff option with a value of 0 in the configuration option of the menu:

my $mb = $parent->Menubutton(...);    # The button
my $menu = $mb->Menu(-tearoff => 0);  # Create a non-tearoff menu
$mb->configure(-menu => $menu);       # Tell button to use it.

You can use the demo program as the basis for your applications using menus. The basic concepts are easy to pick up once you see the syntax in operation.

The Canvas Widget

The Canvas widget is the most configurable and versatile of the widgets. You use the Canvas widget to draw on. To get the size of a Canvas widget after it has been resized, use the $canvas ->Width; and $canvas->Height; calls to get the width and height, respectively. To get the default size of the canvas when it was created, use the $canvas->cget(-width); and $canvas->cget(-height); calls.

If you want your Canvas to be able to grow to arbitrarily large sizes, be sure to specify the -expand and -fill options when you ->pack the Canvas.

Unlike other Tk widgets, the Canvas widget does not take the -bitmap configuration option. One of the ways to place things (including bitmaps) onto a Canvas is to call create() on it. Let's see how a Canvas handles bitmaps differently from the configurable widgets. First, assume that you wanted to specify the 'hourglass' built-in bitmap in Listing 17.13.


Listing 17.13. Using a bitmap.
1 #!/usr/bin/perl
2 use Tk;
3 my $mw = MainWindow->new();
4 my $cv = $mw->Canvas();
5 my $bm = $cv->create('bitmap',10,10, -bitmap=>'hourglass');
6 $cv->pack;
7 $mw->MainLoop

To erase an item like a bitmap, call delete() on it. Assuming your Canvas tag is $cv and your bitmap is stored in $bm, then the call would be this:

$cv->delete($bm);

This is, of course, useful in a callback. For example, to configure a Button to do your deletion for you, you could use something like this:

$mw->Button(-text   => 'Erase',
            -command=>sub{$cv->delete($bm})->pack;

A Canvas widget also can be used as a geometry manager, because you have to specify a position for all the items on the Canvas widget. The x=10 and y=10 parameters in the sample specify the screen pixel location from the upper-left of the canvas. Other possible units are shown in Table 17.1.

Table 17.1. Units for the placement of bitmaps on a canvas.

Tag
Unit
Sample
none
pixels25,50
m
millimeters10m,10m
c
centimeters4c,2c
p
points (1/72 of an inch) 36p,72p

Just as for the other widget types, there is a two-step process of first getting a Photo handle on the file of interest. See Listing 17.14. Make sure you have a GIF file in your current directory and change the listing to use the name of that file, or else all you'll see is a blank screen.


Listing 17.14. Using Photo and Canvas together.
 1 #!/usr/bin/perl -w
 2 use Tk;
 3 my $main = new MainWindow;
 4 my $canvar = $main ->Canvas;
 5
 6 $main->Photo('imggif', -file => "myface.gif");
 7 $canvar->create(qw(image 15c 15c), '-image' => 'imggif');
 8
 9 $canvas->pack;
10 MainLoop;

The following types of images can be used in $canvar->create calls:

arc For sections of a circle
bitmap For X11 bitmap files/built-ins
image For Photo image types (gif, xpm, and so on)
line For lines
oval Includes circles
polygon May be a closed polygon with the -filled option
text Similar to Text widget primitive
window Allows embedding of other widgets

Miscellaneous Topics

The following sections are miscellaneous topics about using Perl/Tk that are gleaned from FAQs, news messages, and .pod files. Each topic could not fit in sequence in the chapter but has enough information in it to merit its inclusion.

References with Subroutines

Everything in Tk-land is a reference. Always pass variables by reference. Callbacks are closures; therefore, if you do not pass by reference, then the value of the variables in the subroutine will be the value when defined, not when called.

Changing the Cursor

To change the cursor for an application, you have to use the -cursor option with four values. Here are these values:

  • The pathname to the bitmap with @ prepended to indicate it isn't a built-in name (using findInc to locate the file relative to the Tk install location)
  • The pathname to the mask bitmap (no @ required)
  • The foreground color
  • The background color

The Tk/demos/color_editor uses the following sequence to get the cursor:

#!/usr/local/bin/perl -w
use Tk;
my $mw = MainWindow->new;
$mw->configure(-cursor => ['@' .
                  Tk->findInc('demos/images/cursor.xbm'),
                  Tk->findInc('demos/images/cursor.mask'),
                  'red', 'green']);
MainLoop;

Debugging Your Perl/Tk Scripts

Unfortunately, you are stuck with the use of the -w switch and use strict; statements since they provide informative error messages. A debugger is available at ftp://ftp.perl.com/pub/perl/ext/TK/Tkperldb-a1.tar.gz; however, at the time of this writing, I could not get it to work. Perhaps in some time this debugger will be functional.

See chapter 30, "Using the Perl Debugger."

More Than One Input File Handle

As with Perl's select() system call, you can monitor more than one task with Perl/Tk. For example, if you have a GUI monitor program that manages input from a variety of sources for display, you can use the fileevent() function call. Basically, a parent process creates several child processes, each with its own pipe. Process-specific information flows through a one-way pipe from each child to the parent.

To achieve this, set up the following statement in the parent loop for each pipe:

$main->fileevent(FILEHANDLE,$status,\&subroutine);

This causes pTk to monitor the FILEHANDLE and call 'subroutine' when an event happens on that handle. In this case, FILEHANDLE is the handle to the socket or pipe you are waiting on. The value of status could be readable, writable, or exception. The \&subroutine is a reference to a Perl subroutine to call when the select() call is invoked.

Eliminating and Hiding Windows

If you are trying to eliminate a TopLevel or a MainWindow, try this:

$main -> destroy;

If you would rather not use destroy, then try this:

$main->withdraw;   # remove
$main->deiconify;  # put back

If $w is a subwindow (subwidget), then

$w->packForget; # remove - if packed
$w->pack(... with options if any ...);  # put back

You can also call the following function to make a window invisible:

$widget->UnmapWindow;

Creating More Than One Independent Window

You can create more than one window to do your user interface for you. The following example creates two separate windows, both of which are empty. You can add widgets to each window by using the $mw and $top1 widgets. See Listing 17.15.


Listing 17.15. More than one independent window.
 1 #!/usr/bin/perl
 2
 3 use Tk;
 4 use Tk::Toplevel;
 5
 6 $mw = MainWindow->new;
 7
 8 my $top1 = $mw->Toplevel;
 9
10 MainLoop;

When running this script, be careful to note which window pops up first. The first window up gets the focus in its widget. To make a Toplevel window active, call grab. Try this call after creating the widgets to grab the focus for your window:

$top1->grab(grab_option);

Summary

This chapter has been a whirlwind tour of the Perl/Tk package. Hopefully, this chapter provided you with enough information to write your own GUI scripts or to get you started at the least. The package really deserves more than one chapter-I am sure that I have not even covered some of the basic functionality. Given the information in this chapter, you should know where to look. Finally, check out the man pages that came with the package, the newsgroups, and the CPAN sites for more up-to-date information. Good luck.


Previous chapter Chapter contents Contents Next chapter




With any suggestions or questions please feel free to contact us
бампер для iphone 5 розовый Bumpers Pink.