Putting Two MainWindows to Work (Mastering Perl/Tk)

11.7. Putting Two MainWindows to Work

Here's a trickier dual-display program that has been slightly obfuscated by removing comments and disguising subroutine names. Before we discuss it, try to figure out what it does. To orient yourself, realize that variables beginning with "l" mean "local," and those beginning with "r" mean "remote." You have 60 seconds. Okay, GO!

my $lmw = MainWindow->new;
my $rmw = MainWindow->new(-screen => $ARGV[0] ||= $ENV{DISPLAY});
my($le, $lt) = &create_widgets($lmw);
my($re, $rt) = &create_widgets($rmw);
&config_widgets($le, $lt, $re, $rt);
&config_widgets($re, $rt, $le, $lt); $rmw->bell;
MainLoop;

sub create_widgets {
    my $screen = shift;
    my $e = $screen->Entry->pack(qw/-fill x -expand 1/);
    $e->focus;
    my $t = $screen->Text(qw/-height 10/)->pack;
    ($e, $t);
}

sub config_widgets {
    my($le, $lt, $re, $rt) = @_;
    $le->bind('<Return>' => [sub {
        my($le, $lt, $re, $rt) = @_;
        $rt->tagConfigure(qw/blue -underline 1/);
        my $input = $le->get . "\n";
        $le->delete(0, 'end');
        $lt->insert('end' => $input);
        $rt->insert('end' => $input, 'blue');
    }, $lt, $re, $rt]);
}

...5, 4, 3, 2, 1...time's up. Obviously, the key to understanding this program is the binding that config_widgets creates. (See Chapter 15, "Anatomy of the MainLoop" for more about bindings.)

Suppose Gromit is sitting in front of his Win32 computer and it happens to run an X server. In another part of the house, Wallace, an ever cheerful and willing-to-chat chap, runs our mystery program on his Linux box and specifies Gromit's display on the command line.

Figure 11-3 and Figure 11-4 show what might transpire and confirm that the mystery program is a Tk phone-clone.

Figure 11-4. Gromit replying to a phone call from Wallace

There are several items worthy of note in the following code. First, here's the code:

 1  #!/usr/local/bin/perl -w
 2  #
 3  # tkphone - Phone another X Display and have a line-mode conversation.
 4  #
 5  # Usage: see POD for details.
 6  
 7  use Tk;
 8  use subs qw/beep phone pconfig/;
 9  use strict;
10  
11  $ENV{DISPLAY} ||= ':0'; $ARGV[0] ||= $ENV{DISPLAY};
12  
13  my $title = "$ENV{DISPLAY}   phoning   $ARGV[0]";
14  my $lmw = MainWindow->new(-title => $title);
15  my $rmw = MainWindow->new(-title => $title, -screen => $ARGV[0]);
16  
17  my($le, $lt) = phone $lmw;
18  my($re, $rt) = phone $rmw;
19  pconfig $le, $lt, $re, $rt;
20  pconfig $re, $rt, $le, $lt; $rmw->bell;
21  
22  MainLoop;
23  
24  sub phone {
25  
26      # Create the menubar and the phone Text Entry/display area.
27  
28      my($screen) = @_;
29  
30      my $menubar = $screen->Menu;
31      $screen->configure(-menu => $menubar); 
32      my $file = $menubar->cascade(-label => '~File');
33      $file->command(-label => "Close", -command => [$screen => 'destroy']);
34      $file->command(-label => "Exit",  -command => \&exit);
35  
36     my $e = $screen->Entry->pack(qw/-fill x -expand 1/);
37      $e->focus;
38      my $t = $screen->Text(qw/-height 10/)->pack;
39      ($e, $t);
40    
41  }
42  
43  sub pconfig {
44  
45      # Configure local callbacks to talk to the remote party.
46  
47      my($le, $lt, $re, $rt) = @_;
48  
49      $le->bind('<Return>' => [sub {
50          my($le, $lt, $re, $rt) = @_;
51          $rt->tagConfigure(qw/blue -underline 1/);
52          my $input = $le->get . "\n";
53          $le->delete(0, 'end');
54          $lt->insert('end' => $input);
55          $rt->insert('end' => $input, 'blue');
56      },  $lt, $re, $rt]);
57  
58  }
59  __END__
60  
61  =head1 NAME
62  
63  tkphone - Phone another X Display and have a line-mode conversation.
64  
65  =head1 SYNOPSIS
66  
67  B<tkphone> [I<display>]
68  
69  =head1 DESCRIPTION
70  
71  This program opens two MainWindows and arranges callbacks so they can
72  talk to each other.  It expects a single command line argument, the
73  remote
74  DISPLAY
75  specification
76  (defaults to :0 so you can phone yourself).
77  
78  =head1 COPYRIGHT
79  
80  Copyright (C) 1999 - 2000 ACME Rocket Supply, Inc. All rights reserved.
81    
82  This program is free software; you can redistribute it and/or modify it under
83  the same terms as Perl itself.
84  
85  =cut

On Win32, $ENV{DISPLAY} is undefined, so line 11 initializes it to quiet -w.

Lines 30 through 34 create a File menubutton with Close and Exit menu items. Examine them closely; destroying a MainWindow is not always sufficient to terminate the program, because Tk's MainLoop only ends when all MainWindows are destroyed (see Chapter 15, "Anatomy of the MainLoop"). So, we provide Exit to really exit the application and Close, which destroys the local MainWindow, but only exits if the other MainWindow is already gone.

Lines 36 through 39 create and return an Entry widget for typing text and a Text widget that displays a transcript of the conversation between the phoner and phonee.

Lines 49 through 56 create the crucial <Return> binding that makes the application work.

Lines 51 through 55 get the data from the local Entry widget and insert it in the local and remote Text widgets, underlining the remote text. (The underline tag name is "blue", because it originally colored the remote text in blue, but colors won't show up well in this book. The Perl virtue of laziness took control, and the tag definition was changed rather than all occurrences of the tag name!) Which widgets are local and which are remote is relative to the particular MainWindow we are in front of. The fact that the binding works from either point of view is due to symmetry. Seek out symmetrical situations; they often simplify code.

Finally, lines 60 through 85 are the program's documentation, in the form of Plain Old Documentation (POD). We'll include POD examples throughout the book. Check out the perlpod and perldoc documentation for detailed information. On Unix, typing perldoc tkphone produces an output similar to Figure 11-5.

Figure 11-5. How perldoc might render tkphone's POD