Perl Page #3: Creating Window-Applications using Perl/Tk
Perl Page #3: Creating Window-Applications using Perl/Tk
There's strictly no warranty for the correctness of this text. You use any of the information provided here at your own risk.
"Tk.pm" is a Perl-module. It was written by Nick Ing-Simmons (1958-2006) in about 1995/1999. It is an interface to the widget toolkit "Tk" of the programming-language "Tcl", which was created by John Ousterhout.
With Perl/Tk it is possible to build small to medium-size window-applications.
Compared to other GUI ("Guided User Interface")-toolkits (like "gtk" or "Qt"), Tk is quite small. It is available on Windows, Linux and Mac OS X. So window-applications written in Perl/Tk can be really plattform-independent.
On the other hand, some Tk-applications don't look too beautiful and certain advanced window-elements are not available in the original Tk-module.
Nevertheless you can achieve a lot of GUI-tasks using plain Tk without any extensions (although there are some very interesting extensions available).
Window-applications in general are made up of window-elements like buttons, switches and so on. These window-elements (including the application's main window itself) are called
widgets
This often used term is short for "window gadgets" and just means "some kind of window-element".
Perl comes with a quite detailed documentation of Tk. You can access it by just executing
perldoc Tk
If you want detailed information about a certain widget-class, for example the "Button", you can run
perldoc Tk::Button
This code just creates an empty Perl/Tk-window:
#!/usr/bin/perl use warnings; use strict; use Tk; my $mw = MainWindow->new(); $mw->MainLoop();
What happened here ?
After importing the Tk-module (after telling the system where to find the Perl-executable and switching on "warnings" and "strict"), an instance of a "Tk::MainWinwod"-object is created, that's called "$mw".
After that, the "->MainLoop()"-method of "$mw" was called.
As a result the (empty) main window was displayed and the Tk-main loop was started.
Scripts for window-applications need a different structure than scripts for text-only-applications:
Text-only-applications can be executed line by line.
But window-applications display one or more windows and then wait for events, that come from the user (like mouse-clicks or keyboard-presses) or from somewhere else.
This processing of events, that feels nearly simultaneous to the user, is done by the main loop.
So, the main window is shown and the main loop is started. It waits for events. If an event occurs, the main loop reacts on it.
Usually it calls a function, that is defined inside the program.
For example, lateron we will define an "Exit"-Button. We will create a "Button"-instance and define, that it shall show the text "Exit" on it and that, when it is clicked, it shall call a function, that destroys the main window (when the main window is destroyed, the main loop will stop and the application will end).
So, when this application is started, sooner or later the main loop is started. It waits for the event "Exit-button clicked". If this event occurs, the main loop will call the function defined in connection with the button. As a result the application will end.
In the little example above, we have just created an empty main window. The only thing the main loop can wait for here, is the event "application shall end, because its window's 'close'-button was clicked or 'Alt+F4' (on Windows) or something similar was pressed".
This code displays "Hello" inside the Tk-window.
This is done using the "Tk::Label"-widget:
#!/usr/bin/perl use warnings; use strict; use Tk; my $mw = MainWindow->new(); my $lab1 = $mw->Label(-text => "Hello"); $lab1->pack(); $mw->MainLoop();
The ".pack()"-method is always needed, if you want the window elements to show up. So first you define what your window element (called "widget") shall look like and then you call ".pack()" to show it.
The main loop of the program still has nothing more to wait for than in the first example.
One of the reasons, some people think, Tk is ugly, is, that often the window fonts aren't set properly.
But this can be done for example like this:
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
my $mw = MainWindow->new(-title => "MyWindow");
$mw->optionAdd("*font", "Arial 15 normal");
$mw->geometry("320x240+325+200");
my $lab1 = $mw->Label(-text => "Hello");
$lab1->pack();
$mw->MainLoop();
We also
here. Now we're at a point, where we should move on to writing things in a more object oriented way. So we rewrite the code above like this:
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
package MyWindow {
sub new {
my $classname = shift;
my $self = {};
return bless($self, $classname);
}
sub createWindow {
my $self = shift;
$self->{mw} = MainWindow->new(-title => "MyWindow");
$self->{mw}->optionAdd("*font", "Arial 15 normal");
$self->{mw}->geometry("320x240+325+200");
$self->{lab1} = $self->{mw}->Label(-text => "Hello");
$self->{lab1}->pack();
$self->{mw}->MainLoop();
}
}
my $app = MyWindow->new();
$app->createWindow();
If you don't understand what's going on in this step, you can read my page about object-oriented programming in Perl.
The main loop of the program still hasn't much to wait for.
Now take a look at this small script:
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
package MyWindow {
sub new {
my $classname = shift;
my $self = {};
return bless($self, $classname);
}
sub createWindow {
my $self = shift;
$self->{mw} = MainWindow->new(-title => "MyWindow");
$self->{mw}->optionAdd("*font", "Arial 15 normal");
$self->{mw}->geometry("320x240+325+200");
$self->{lab1} = $self->{mw}->Label(-text => "Please enter something:");
$self->{lab1}->pack();
$self->{entr1} = $self->{mw}->Entry(-background => "white");
$self->{entr1}->pack();
$self->{entr1}->focus();
$self->{btn1} = $self->{mw}->Button(-text => "Ok", -command => sub { $self->btnClick()});
$self->{btn1}->pack();
$self->{btn2} = $self->{mw}->Button(-text => "Exit", -command => sub { $self->{mw}->destroy() });
$self->{btn2}->pack();
$self->{mw}->MainLoop();
}
sub btnClick {
my $self = shift;
$self->{mw}->messageBox(-title => "From entr1", -message => "Entryfield 1 contains: " . $self->{entr1}->get());
}
}
my $app = MyWindow->new();
$app->createWindow();
When the script starts, the "MyWindow"-instance "$app" is created and its "->new()"-function is run. So the Tk-main window "$mw", a label, an entry-field and two buttons are created. Then the main loop of "$mw" is run, so the application waits for events (like mouse-clicks or key-presses). You can enter something in the entry field. Whenever you click on "btn1", the method "->btnClick()" is run.
In "btnClick()" a "messageBox" is created. This is an easy way to create simple message-boxes.
The "->get()"-method of the entry field "entr1" returns the contents of the entry-field as a string. This is then displayed in the messageBox. After this messageBox is closed, the application returns to the main loop of "$mw".
By clicking the second button, the main window "$mw" is closed and the application is ended, because the "destroy"-method of "$mw" has been called.
The part
-command => sub { $self->btnClick() }
in the definition line of "$btn1" needs an explanation. In Perl, you can for example define ordinary arrays, that are named. That is, they have a name like "@array". But you can also define an anonymous array datatype, that is just called "[]". This construction with square brackets is an "anonymous array reference". This datatype can then be assigned to a named reference and be accessed through this reference:
my $aref = [1, 2, 3]; print $aref->[1] . "\n";
(result is "2").
Accordingly, an anonymous function reference can be defined. It looks like this: "sub { ... }". Consider this example:
#!/usr/bin/perl
use warnings;
use strict;
my $ref = sub { my $a = shift; my $b = shift; return $a * $b; };
print &{$ref}(5, 7) . "\n";
(result is "35"). In the "print"-line, the function reference is dereferenced, (using "&{ .. }"). Then the function can be called.
So this is what we have as an argument for "-command => ": An anonymous function reference.
Back to the entry field. It can be cleared with:
$self->{entr1}->delete(0, "end");
New text can be inserted with:
$self->{entr1}->insert(0, "Hello");
This script demonstrates the use of radiobuttons:
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
package MyWindow {
sub new {
my $classname = shift;
my $self = {};
return bless($self, $classname);
}
sub createWindow {
my $self = shift;
$self->{mw} = MainWindow->new(-title => "MyWindow");
$self->{mw}->optionAdd("*font", "Arial 15 normal");
$self->{mw}->geometry("320x240+325+200");
$self->{colour} = "";
$self->{rb1} = $self->{mw}->Radiobutton(-text => "Red", -variable => \$self->{colour}, -value => "Red");
$self->{rb2} = $self->{mw}->Radiobutton(-text => "Yellow", -variable => \$self->{colour}, -value => "Yellow");
$self->{rb3} = $self->{mw}->Radiobutton(-text => "Green", -variable => \$self->{colour}, -value => "Green");
$self->{rb2}->select();
$self->{rb1}->pack();
$self->{rb2}->pack();
$self->{rb3}->pack();
$self->{btn1} = $self->{mw}->Button(-text => "Ok", -command => sub { $self->btnClick()});
$self->{btn1}->pack();
$self->{btn2} = $self->{mw}->Button(-text => "Exit", -command => sub { $self->{mw}->destroy() });
$self->{btn2}->pack();
$self->{mw}->MainLoop();
}
sub btnClick {
my $self = shift;
$self->{mw}->messageBox(-title => "Your selection", -message => "The selected colour is: " . $self->{colour});
}
}
my $app = MyWindow->new();
$app->createWindow();
Radiobuttons are very useful, if the user should make a single choice between several possibilities.
In the script we create three radiobuttons "rb1", "rb2" and "rb3" and sign them with "Red", "Yellow" and "Green" (this could be the selection for a colour of a car for example).
The radiobuttons are connected by sharing the same variable "$self->{colour}". We have to pass a reference to this variable as the "-variable =>" argument. That way, all radiobuttons can access the same variable to set a value.
Passing the "value"-argument, we define, what value should be assigned to the variable "colour", if the radiobutton is selected.
Using the ".select()"-method, we make radiobutton "rb2" the default-selection.
When "btn1" is clicked, the method "btnClick" is run. This value is then displayed in the "messageBox" like in the example above.
This script demonstrates the usage of checkbuttons. They are useful, if several options can be selected, for example you could choose, what you wanted to eat ("soup" and "meat", just "ice" or even nothing at all):
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
=begin remark
icechooser.pl, 03.07.2021.
Originally, this was a Perl/Tk-example
(see "http://www.perltk.de/tk_widgets/howto_tut2_7-checkbutton.html").
In 2008, I translated it to Perl/Tk. From there, I translated it back to Perl/Tk.
=end remark
=cut
package IceChooser {
sub new {
my $classname = shift;
my $self = {};
return bless($self, $classname);
}
sub createWindow {
my $self = shift;
my $i;
$self->{mw} = MainWindow->new(-title => 'Ice-Cream Chooser');
$self->{mw}->optionAdd("*font", "Arial 18 normal");
$self->{mw}->geometry("+250+200");
$self->{f1} = $self->{mw}->Frame();
$self->{f1}->pack(-side => 'top', -expand => 1, -fill => 'both');
# Some checkbuttons in a frame:
$self->{f2} = $self->{f1}->Frame(-borderwidth => 3, -relief => 'groove');
$self->{f2}->pack(-side => 'right', -expand => 1, -fill => 'both');
$self->{f2}->Label(-text => "Extras")->pack();
$self->{cream} = 0;
$self->{wafer} = 0;
$self->{cb1} = $self->{f2}->Checkbutton(-text => "Cream", -variable => \$self->{cream});
$self->{cb1}->pack(-anchor => 'w');
$self->{cb2} = $self->{f2}->Checkbutton(-text => "Extra wafer", -variable => \$self->{wafer});
$self->{cb2}->pack(-anchor => 'w');
# Two groups of radiobuttons in two frames:
$self->{f3} = $self->{f1}->Frame(-borderwidth => 3, -relief => 'groove');
$self->{f3}->pack(-side => 'right', -expand => 1, -fill => 'both');
$self->{f3}->Label(-text =>"Crumbles")->pack();
$self->{crumblesorts} = ["No crumbles",
"Chocolate crumbles",
"Colourful crumbles",
"Cracknel crumbles",
"Flakes of plain chocolate"];
$self->{crumble} = "";
$self->{rb1} = [];
my @c = @{ $self->{crumblesorts} };
my @temp1 = ();
for $i (0 .. $#c) {
push(@temp1, $self->{f3}->Radiobutton(-text => $self->{crumblesorts}[$i],
-variable => \$self->{crumble},
-value => $i));
$self->{rb1} = \@temp1;
$self->{rb1}[$i]->pack(-anchor => 'w');
}
$self->{rb1}[0]->select();
$self->{f4} = $self->{f1}->Frame(-borderwidth => 3, -relief => 'groove');
$self->{f4}->pack(-side => 'right', -expand => 1, -fill => 'both');
$self->{f4}->Label(-text => "Sauces")->pack();
$self->{saucesorts} = ['No sauce',
'Strawberry-sauce',
'Chocolate-sauce',
'Tropico'];
$self->{sauce} = "";
$self->{rb2} = [];
my @s = @{ $self->{saucesorts} };
my @temp2 = ();
for $i (0 .. $#s) {
push(@temp2, $self->{f4}->Radiobutton(-text => $self->{saucesorts}[$i],
-variable => \$self->{sauce},
-value => $i));
$self->{rb2} = \@temp2;
$self->{rb2}[$i]->pack(-anchor => 'w');
}
$self->{rb2}[0]->select();
# A listbox:
$self->{listbox} = $self->{f1}->Listbox(-relief => 'sunken',
-width => -1,
-setgrid => 1,
-selectmode => 'single');
$self->{listbox}->pack(-side => 'right', -expand => 1, -fill => 'both');
my @ballnumbers = ('One ball', 'Two balls', 'Three balls', 'Four balls', 'Five balls');
for my $ball (@ballnumbers) {
$self->{listbox}->insert('end', $ball);
}
$self->{listbox}->selectionSet(2, 2); # Default is "Three balls".
# The Buttons "OK" and "Exit":
$self->{f5} = $self->{mw}->Frame();
$self->{f5}->pack(-side => 'bottom');
$self->{btn1} = $self->{f5}->Button(-text => "Ok", -command => sub { $self->btnClick() });
$self->{btn1}->pack(-side => 'left', -expand => 0, -fill => 'none', -ipadx => 20, -padx => 10, -pady => 10);
$self->{btn2} = $self->{f5}->Button(-text => "Exit", -command => sub { $self->{mw}->destroy() });
$self->{btn2}->pack(-side => 'right', -expand => 0, -fill => 'none', -ipadx => 20, -padx => 10, -pady => 10);
$self->{mw}->MainLoop();
}
sub btnClick {
my $self = shift;
my @yesno = qw(No Yes);
my $msg = "Your selected ice-cream:" . "\n\n";
$msg .= $self->getSelectedListboxElement() . "\n\n";
$msg .= "Cream: " . $yesno[$self->{cream}] . "\n";
$msg .= "Extra wafer: " . $yesno[$self->{wafer}] . "\n";
$msg .= "Crumble: " . $self->{crumblesorts}[$self->{crumble}] . "\n";
$msg .= "Sauce: " . $self->{saucesorts}[$self->{sauce}] . "\n";
$self->{mw}->messageBox(-title => "Your ice-cream", -message => $msg);
}
sub getSelectedListboxElement {
my $self = shift;
# "->get()" with two arguments returns all elements of the listbox:
my @l = $self->{listbox}->get(0, 'end');
# "->curselection()" returns the number of all selected elements as a list.
# As here's always exactly one element selected, we're interested in the
# first element of this list.
my @s = $self->{listbox}->curselection();
return $l[$s[0]];
}
}
my $app = IceChooser->new();
$app->createWindow();
We manage the checkbuttons and other Tk-objects in Perl-lists here.
Again, we need references to variables to store the states of the checkbuttons. They set the variables to "1" for "on" and to "0" for "off". We could define other values with "-onvalue" and "-offvalue"-arguments of the checkbuttons.
At initialisation we need to call ".deselect()" to store "0" in the variables.
When you create a widget, you usually pass the name of its parent widget as the first argument. For example, in
$self->{mw}->Label(-text => "Hello");
"$mw" (for "main window") is the name of the parent-widget.
So there's a hierarchy of widgets. On top of it is the socalled "toplevel"-widget. Usually, the toplevel-widget is the main window.
Widgets can have other parents than the toplevel widget. For example, you can group them in frames, to give your application a more ordered look. To do that, first, you create a frame
my $self->{frame1} = $self->{mw}->Frame();
(Notice, that the frame itself is a widget too, with the main window as its parent-widget).
Then, you put your (other) widgets into the frame, for example:
$lab1 = $self->{frame1}->Label(-text => "Hello");
After that, you use ".pack()" to show it all:
$self->{lab1}->pack();
$self->{frame1}->pack();
The "pack()"-method is used to show widgets inside their parent-widgets (like for example the main window).
The "pack()"-method calls "Pack", one of Tk's geometry-managers.
Tk offers two more geometry-managers called "Grid" and "Place".
"Pack" is the most commonly used one.
It can handle the relative distances between the widgets, even if the size of the application-window is changed.
The "pack()"-method has several arguments to position your widgets where you want them:
First, there's the "-side =>"-argument. It tells Pack where to add the widget in its parent widget.
The values for "side" are:
Then, there are the "-padx" and "-pady"-arguments.
They give a widget some (horizontal, respectively vertical) space in its parent-widget. For example:
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
my $mw = MainWindow->new();
$mw->optionAdd("*font", ,"Arial 15 normal");
$mw->geometry("+250+200");
my $btn1 = $mw->Button(-text => "Hello");
$btn1->pack(-padx => 100, -pady => 80);
$mw->MainLoop();
"-padx" and "-pady" add space outside the original widget in the parent-widget.
If you want to add space inside the original widget (and enlarge it this way), you can use "-ipadx" and "-ipady":
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
my $mw = MainWindow->new();
$mw->optionAdd("*font", ,"Arial 15 normal");
$mw->geometry("+250+200");
my $btn1 = $mw->Button(-text => "Hello");
$btn1->pack(-ipadx => 100, -ipady => 80, -padx => 20, -pady => 20);
$mw->MainLoop();
Usually, there are several widgets. It is of importance, in which order their "pack()"-methods are called in the Perl-script.
Hint: If you want three widgets (for example three buttons) in a horizontal row in a parent-widget (for example a frame), you can use
$widget->pack(-side => 'left');on every widget. Then, the first one is packed left, and the second one is packed left too, that is, right of the first widget, and so on.
More information on "pack()" can be found executing
perldoc Tk::pack
The little examples above worked, but still didn't look too much like a proper window-application.
So let's combine, what was said about the widgets
to a slightly larger example:
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
=begin remark
icechooser.pl, 03.07.2021.
Originally, this was a Perl/Tk-example
(see "http://www.perltk.de/tk_widgets/howto_tut2_7-checkbutton.html").
In 2008, I translated it to Perl/Tk. From there, I translated it back to Perl/Tk.
=end remark
=cut
package IceChooser {
sub new {
my $classname = shift;
my $self = {};
return bless($self, $classname);
}
sub createWindow {
my $self = shift;
my $i;
$self->{mw} = MainWindow->new(-title => 'Ice-Cream Chooser');
$self->{mw}->optionAdd("*font", "Arial 18 normal");
$self->{mw}->geometry("+250+200");
$self->{f1} = $self->{mw}->Frame();
$self->{f1}->pack(-side => 'top', -expand => 1, -fill => 'both');
# Some checkbuttons in a frame:
$self->{f2} = $self->{f1}->Frame(-borderwidth => 3, -relief => 'groove');
$self->{f2}->pack(-side => 'right', -expand => 1, -fill => 'both');
$self->{f2}->Label(-text => "Extras")->pack();
$self->{cream} = 0;
$self->{wafer} = 0;
$self->{cb1} = $self->{f2}->Checkbutton(-text => "Cream", -variable => \$self->{cream});
$self->{cb1}->pack(-anchor => 'w');
$self->{cb2} = $self->{f2}->Checkbutton(-text => "Extra wafer", -variable => \$self->{wafer});
$self->{cb2}->pack(-anchor => 'w');
# Two groups of radiobuttons in two frames:
$self->{f3} = $self->{f1}->Frame(-borderwidth => 3, -relief => 'groove');
$self->{f3}->pack(-side => 'right', -expand => 1, -fill => 'both');
$self->{f3}->Label(-text =>"Crumbles")->pack();
$self->{crumblesorts} = ["No crumbles",
"Chocolate crumbles",
"Colourful crumbles",
"Cracknel crumbles",
"Flakes of plain chocolate"];
$self->{crumble} = "";
$self->{rb1} = [];
my @c = @{ $self->{crumblesorts} };
for $i (0 .. $#c) {
push($self->{rb1}, $self->{f3}->Radiobutton(-text => $self->{crumblesorts}[$i],
-variable => \$self->{crumble},
-value => $i));
$self->{rb1}[$i]->pack(-anchor => 'w');
}
$self->{rb1}[0]->select();
$self->{f4} = $self->{f1}->Frame(-borderwidth => 3, -relief => 'groove');
$self->{f4}->pack(-side => 'right', -expand => 1, -fill => 'both');
$self->{f4}->Label(-text => "Sauces")->pack();
$self->{saucesorts} = ['No sauce',
'Strawberry-sauce',
'Chocolate-sauce',
'Tropico'];
$self->{sauce} = "";
$self->{rb2} = [];
my @s = @{ $self->{saucesorts} };
for $i (0 .. $#s) {
push($self->{rb2}, $self->{f4}->Radiobutton(-text => $self->{saucesorts}[$i],
-variable => \$self->{sauce},
-value => $i));
$self->{rb2}[$i]->pack(-anchor => 'w');
}
$self->{rb2}[0]->select();
# A listbox:
$self->{listbox} = $self->{f1}->Listbox(-relief => 'sunken',
-width => -1,
-setgrid => 1,
-selectmode => 'single');
$self->{listbox}->pack(-side => 'right', -expand => 1, -fill => 'both');
my @ballnumbers = ('One ball', 'Two balls', 'Three balls', 'Four balls', 'Five balls');
for my $ball (@ballnumbers) {
$self->{listbox}->insert('end', $ball);
}
$self->{listbox}->selectionSet(2, 2); # Default is "Three balls".
# The Buttons "OK" and "Exit":
$self->{f5} = $self->{mw}->Frame();
$self->{f5}->pack(-side => 'bottom');
$self->{btn1} = $self->{f5}->Button(-text => "Ok", -command => sub { $self->btnClick() });
$self->{btn1}->pack(-side => 'left', -expand => 0, -fill => 'none', -ipadx => 20, -padx => 10, -pady => 10);
$self->{btn2} = $self->{f5}->Button(-text => "Exit", -command => sub { $self->{mw}->destroy() });
$self->{btn2}->pack(-side => 'right', -expand => 0, -fill => 'none', -ipadx => 20, -padx => 10, -pady => 10);
$self->{mw}->MainLoop();
}
sub btnClick {
my $self = shift;
my @yesno = qw(No Yes);
my $msg = "Your selected ice-cream:" . "\n\n";
$msg .= $self->getSelectedListboxElement() . "\n\n";
$msg .= "Cream: " . $yesno[$self->{cream}] . "\n";
$msg .= "Extra wafer: " . $yesno[$self->{wafer}] . "\n";
$msg .= "Crumble: " . $self->{crumblesorts}[$self->{crumble}] . "\n";
$msg .= "Sauce: " . $self->{saucesorts}[$self->{sauce}] . "\n";
$self->{mw}->messageBox(-title => "Your ice-cream", -message => $msg);
}
sub getSelectedListboxElement {
my $self = shift;
# "->get()" with two arguments returns all elements of the listbox:
my @l = $self->{listbox}->get(0, 'end');
# "->curselection()" returns the number of all selected elements as a list.
# As here's always exactly one element selected, we're interested in the
# first element of this list.
my @s = $self->{listbox}->curselection();
return $l[$s[0]];
}
}
my $app = IceChooser->new();
$app->createWindow();
Already looks a lot better, if you ask me.
We have a "Tk::Listbox"-widget here. That wasn't explained before, but I think you can already see what it does.
When you look at professional window applications like editors or wordprocessors, you'll find, that most of their windows are occupied by a large field, in which text is displayed and can be edited by the user.
Tk offers a widget "Tk::Text" with which such a large text-field can be created.
Basically "Text"-widgets are created like any other Tk-widget. Passing arguments can do the following things:
After the widget is created, you can automatically insert text into it, using its "->insert()"-method.
The first argument for this method is, where to insert the text.
Therefore, two coordinates have to be given in a string, separated by a colon, where "1.0" is the top left corner of the Text-widget.
This string of coordinates is called an "index".
'end' points to the index, where the last character has been inserted into the text-field up to now.
Notice:The coordinates have to be inside the range, where text has already been inserted. Otherwise the text will be inserted at 'end'.
The second argument to "->insert()" is the text, that should be inserted.
When the Text-widget has the focus, a cursor appears, and the user can insert text into the text-field. He can even mark text for cut/copy/paste-operations supported by the operating-system.
The text-field can be cleared using
$tfield->delete("1.0", 'end');
(where "$tfield" is the text-field).
Text can be read from the text-field using "->get()".
Text can also be reformatted at runtime including change of text-fonts, colours and sizes using "tags". It is even said to be possible, to embed images or other Tk-widgets inside a Text-widget. Please see
perldoc Tk::Text
for details. Here's an example-script for some of the possible text-field-operations:
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
package TextFieldWindow {
sub new {
my $classname = shift;
my $self = {};
return bless($self, $classname);
}
sub createWindow {
my $self = shift;
$self->{mw} = MainWindow->new(-title => "TextFieldWindow");
$self->{mw}->optionAdd("*font", "Arial 15 normal");
$self->{mw}->geometry("+250+200");
$self->{mw}->title("Text-Field-Demonstration");
$self->{tfield} = $self->{mw}->Text(-font => "{Courier} 15 {normal}",
-width => 82,
-height => 20,
-background => 'white',
-foreground => 'black');
$self->{tfield}->pack();
$self->{tfield}->insert('end', "Hello from inside the Text-widget.\n\nIf you click on it once, you can edit this text.");
$self->{fr} = $self->{mw}->Frame();
$self->{btn1} = $self->{fr}->Button(-text => "Show contents",
-command => sub { $self->showContents() });
$self->{btn2} = $self->{fr}->Button(-text => "Clear text-field",
-command => sub { $self->clearTextField() });
$self->{btn3} = $self->{fr}->Button(-text => "Exit",
-command => sub { $self->{mw}->destroy() });
$self->{btn1}->pack(-side => 'left', -padx => 20);
$self->{btn3}->pack(-side => 'right', -padx => 20);
$self->{btn2}->pack(-padx => 20);
$self->{fr}->pack(-pady => 10);
$self->{mw}->MainLoop();
}
sub showContents {
my $self = shift;
my $msg = "The text-field contains right now:\n\n";
$msg .= $self->{tfield}->get('1.0', 'end') . "\n";
$self->{mw}->messageBox(-title => 'Text-field-Contents', -message => $msg);
}
sub clearTextField {
my $self = shift;
$self->{tfield}->delete('1.0', 'end');
}
}
my $app = TextFieldWindow->new();
$app->createWindow();
Wouldn't it be nice to have a menubar with headlines like "File", "Edit" and so on, too ?
As far as I know, there isn't a preconfigured template for that in Tk, but there are the widgets "Menu" and "Menubutton".
With these we can create a custom solution in five steps:
Please notice: The "Tk::Menu" offers a feature, to drag a menu away from its application with the mouse and move it around on the screen in its own window. You see this sometimes on Linux, but Windows users aren't used to it, so we switch this feature off doing:
$mainwindow->optionAdd("*tearOff", 'false');
(where "$mainwindow" is the main window.)
Here comes the example-script:
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
package MenuBarWindow {
sub new {
my $classname = shift;
my $self = {};
return bless($self, $classname);
}
sub createWindow {
my $self = shift;
$self->{mw} = MainWindow->new(-title => "MenuBarWindow");
$self->{mw}->optionAdd("*font", "Arial 15 normal");
$self->{mw}->geometry("+158+190");
$self->{mw}->optionAdd("*tearOff", 'false');
$self->{mw}->title("Menubar-Demonstration");
# The menubar-frame:
$self->{mbarframe} = $self->{mw}->Frame(-relief => 'ridge', -bd => 5);
# The menubuttons:
$self->{mb_file} = $self->{mbarframe}->Menubutton(-text => "File");
$self->{mb_edit} = $self->{mbarframe}->Menubutton(-text => "Edit");
$self->{mb_info} = $self->{mbarframe}->Menubutton(-text => "Info");
$self->{mbarframe}->pack(-side => 'top', -fill => 'x');
$self->{mb_file}->pack(-side => 'left');
$self->{mb_edit}->pack(-side => 'left');
$self->{mb_info}->pack(-side => 'right');
# Menues associated with the menubuttons:
# First, the "File"-menu:
$self->{menu_file} = $self->{mb_file}->Menu();
$self->{menu_file}->add("command", -label => "Open", -command => sub {}, -state => "disabled");
$self->{menu_file}->add("command", -label => "Save", -command => sub {}, -state => "disabled");
$self->{menu_file}->add("separator");
$self->{menu_file}->add("command", -label => "Exit", -command => sub { $self->{mw}->destroy() });
$self->{mb_file}->configure(-menu => $self->{menu_file});
# The "Edit"-menu:
$self->{menu_edit} = $self->{mb_edit}->Menu();
$self->{menu_edit}->add("command", -label => "Show contents", -command => sub { $self->showContents() });
$self->{menu_edit}->add("command", -label => "Clear text-field", -command => sub { $self->clearTextField() });
$self->{mb_edit}->configure(-menu => $self->{menu_edit});
# The "Info"-menu:
$self->{menu_info} = $self->{mb_info}->Menu();
$self->{menu_info}->add("command", -label => "Show Info", -command => sub { $self->showInfo() });
$self->{mb_info}->configure(-menu => $self->{menu_info});
# That's all for the menubar. Now comes the text-field again:
$self->{tfield} = $self->{mw}->Text(-font => "{Courier} 15 {normal}",
-width => 82,
-height => 20,
-background => 'white',
-foreground => 'black');
$self->{tfield}->pack();
$self->{tfield}->insert('end', "Hello.\n\nPlease click on the menubar, to see, what you can do here.");
$self->{mw}->MainLoop();
}
sub showInfo {
my $self = shift;
$self->{mw}->messageBox(-title => 'Info', -message => "This is just a little menubar-demonstration,\ncreated on 7-4-2021.\n");
}
sub showContents {
my $self = shift;
my $msg = "The text-field contains right now:\n\n";
$msg .= $self->{tfield}->get('1.0', 'end') . "\n";
$self->{mw}->messageBox(-title => 'Text-field-Contents', -message => $msg);
}
sub clearTextField {
my $self = shift;
$self->{tfield}->delete('1.0', 'end');
}
}
my $app = MenuBarWindow->new();
$app->createWindow();
At the window-bottom of many professional applications there is a statusbar showing short messages about what the program is doing at the moment. Tk doesn't provide a special widget for such a statusbar.
But it is possible to emulate one using a Label-widget with a textvariable in a frame at the bottom of the main window.
Here's an example:
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
package MyWindow {
sub new {
my $classname = shift;
my $self = {};
return bless($self, $classname);
}
sub createWindow {
my $self = shift;
$self->{mw} = Tk::MainWindow->new(-title => "Statusbar-Demonstration");
$self->{mw}->optionAdd("*font", "Arial 15 normal");
$self->{mw}->geometry("+325+200");
$self->{numclicks} = 0;
$self->{btn1} = $self->{mw}->Button(-text => "Press", -command => sub { $self->btnClick() });
$self->{btn1}->pack(-padx => 150, -pady => 50);
$self->{btn2} = $self->{mw}->Button(-text => "Exit", -command => sub { $self->{mw}->destroy() });
$self->{btn2}->pack(-anchor => 'e', -padx => 20, -pady => 20);
$self->{sbartext} = "";
$self->{sbarframe} = $self->{mw}->Frame();
$self->{sbarlabel} = $self->{sbarframe}->Label(-bd => 1,
-relief => 'sunken',
-anchor => 'w',
-textvariable => \$self->{sbartext});
$self->{sbarlabel}->pack(-fill => 'x');
$self->{sbarframe}->pack(-side => 'bottom', -fill => 'x');
$self->{sbartext} = "Waiting.";
$self->{mw}->MainLoop();
}
sub btnClick {
my $self = shift;
$self->{numclicks}++;
$self->{sbartext} = "Button pressed " . $self->{numclicks} . " times.";
}
}
my $app = MyWindow->new();
$app->createWindow();
There's another way of writing this example using a StatusBar-class for the statusbar and using the "->configure()"-method of the Label-widget:
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
package MyWindow {
sub new {
my $classname = shift;
my $self = {};
return bless($self, $classname);
}
sub createWindow {
my $self = shift;
$self->{mw} = Tk::MainWindow->new(-title => "Statusbar-Demonstration");
$self->{mw}->optionAdd("*font", "Arial 15 normal");
$self->{mw}->geometry("+325+200");
$self->{numclicks} = 0;
$self->{btn1} = $self->{mw}->Button(-text => "Press", -command => sub { $self->btnClick() });
$self->{btn1}->pack(-padx => 150, -pady => 50);
$self->{btn2} = $self->{mw}->Button(-text => "Exit", -command => sub { $self->{mw}->destroy() });
$self->{btn2}->pack(-anchor => 'e', -padx => 20, -pady => 20);
$self->{sbartext} = "";
$self->{sbarframe} = $self->{mw}->Frame();
$self->{sbarlabel} = $self->{sbarframe}->Label(-bd => 1,
-relief => 'sunken',
-anchor => 'w',
-textvariable => \$self->{sbartext});
$self->{sbar} = StatusBar->new($self->{mw});
$self->{sbar}->createBar();
$self->{mw}->MainLoop();
}
sub btnClick {
my $self = shift;
$self->{numclicks}++;
$self->{sbar}->set("Button pressed " . $self->{numclicks} . " times.");
}
}
package StatusBar {
sub new {
my $classname = shift;
my $self = {master => shift};
return bless($self, $classname);
}
sub createBar {
my $self = shift;
$self->{frame1} = $self->{master}->Frame();
$self->{label1} = $self->{frame1}->Label(-bd => 1,
-relief => 'sunken',
-anchor => 'w');
$self->{label1}->pack(-fill => 'x');
$self->{frame1}->pack(-side => 'bottom', -fill => 'both');
$self->set("Waiting.");
}
sub set {
my $self = shift;
my $format = shift;
$self->{label1}->configure(-text => $format);
$self->{label1}->idletasks();
}
sub clear {
my $self = shift;
$self->{label1}->configure(-text => "");
$self->{label1}->idletasks();
}
}
my $app = MyWindow->new();
$app->createWindow();
If you want to show more text in for example a Text-widget than can be displayed at once, you can use a "Tk::Scrolled"-widget. It adds one or more scrollbars to a widget, so the user can scroll the content.
Here's an example:
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
my $mw = MainWindow->new(-title => "ScrolledText-Demo'");
$mw->optionAdd("*font", "Arial 15 normal");
$mw->geometry("+250+200");
my $tfield = $mw->Scrolled("Text",
-scrollbars => 'e',
-font => "{Courier} 15 {normal}",
-width => 82,
-height => 20,
-background => 'white',
-foreground => 'black');
$tfield->pack();
my $i;
my $lastnum = 100;
for $i (1 .. $lastnum) {
$tfield->insert('end', $i);
if ($i != $lastnum) {
$tfield->insert('end', "\n");
}
}
my $btn1 = $mw->Button(-text => "Ok",
-command => sub { $mw->destroy() });
$btn1->pack(-side => 'right', -padx => 20, -pady => 10);
$mw->MainLoop();
Simple dialog-windows can be created using "->messageBox()":
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
package MyWindow {
sub new {
my $classname = shift;
my $self = {};
return bless($self, $classname);
}
sub createWindow {
my $self = shift;
$self->{mw} = MainWindow->new(-title => "Example of Simple Dialog");
$self->{mw}->optionAdd("*font", "Arial 15 normal");
$self->{mw}->geometry("+250+200");
$self->{btn1} = $self->{mw}->Button(-text => "Click button to open dialog-window.", -command => sub { $self->btnClick()});
$self->{btn1}->pack();
$self->{btn2} = $self->{mw}->Button(-text => "Exit", -command => sub { $self->{mw}->destroy() });
$self->{btn2}->pack();
$self->{mw}->MainLoop();
}
sub btnClick {
my $self = shift;
my @yesno = qw(Yes No);
my $answer = $self->{mw}->messageBox(-type => "YesNo",
-title => "Your Choice",
-message => 'Please click either "Yes" or "No".');
$self->{mw}->messageBox(-title => $answer, -message => "Your choice was: $answer.");
}
}
my $app = MyWindow->new();
$app->createWindow();
If you need more complex input from the user, for example from one or more entry-fields, "->messageBox()" isn't sufficient any more.
Then you have to create your own dialog-window.
"Tk::Toplevel" provides a second main window-widget.
So it should be easy to create such a window and populate it with an entry-field, a button and so on. But there is a problem:
If you open the Toplevel window (as a second main window), the Perl-script doesn't wait for the user to make his input, but just moves on and returns to the main loop.
So your application gets messed up.
(You don't run into this problem, when you use "->messageBox()", because the code there already takes care of this automatically).
Fortunately, there's a solution for this problem:
When the new Toplevel-window is open, you can make the first window wait, until the new ones closes again, by doing:
$mainwindow->waitWindow($dialogwindow);
Here's an example-script again:
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
package MyWindow {
sub new {
my $classname = shift;
my $self = {};
return bless($self, $classname);
}
sub createWindow {
my $self = shift;
$self->{mw} = MainWindow->new(-title => "Example of Custom Dialog-Window");
$self->{mw}->optionAdd("*font", "Arial 15 normal");
$self->{mw}->geometry("+250+200");
$self->{btn1} = $self->{mw}->Button(-text => "Click button to open dialog-window.", -command => sub { $self->btnClick()});
$self->{btn1}->pack(-padx => 20, -pady => 20);
$self->{btn2} = $self->{mw}->Button(-text => "Exit", -command => sub { $self->{mw}->destroy() });
$self->{btn2}->pack(-pady => 10);
$self->{mw}->MainLoop();
}
sub btnClick {
my $self = shift;
$self->{dialogwindow} = $self->{mw}->Toplevel();
$self->{dialogwindow}->title("Dialog Window");
$self->{dialogwindow}->geometry("+300+250");
$self->{lab1} = $self->{dialogwindow}->Label(-text => "Please enter something:");
$self->{lab1}->pack();
$self->{entr1} = $self->{dialogwindow}->Entry();
$self->{entr1}->pack();
$self->{entr1}->focus();
$self->{btn3} = $self->{dialogwindow}->Button(-text => "Ok",
-command => sub { $self->dialogEnd() });
$self->{btn3}->pack();
# This is the important line: It tells the MainWindow to wait:
$self->{mw}->waitWindow($self->{dialogwindow});
}
sub dialogEnd {
my $self = shift;
my $e = $self->{entr1}->get();
$self->{dialogwindow}->destroy();
$self->{mw}->messageBox(-title => "Input", -message => "You entered:\n\n$e\n");
}
}
my $app = MyWindow->new();
$app->createWindow();
Most widgets, including the main window, support the ".bind()"-method.
With it, you can execute a function, when a given key was pressed and the widget, to which the key was bound, has the focus.
So key-combinations, that should work everywhere in your application, should be bound to the main window-widget.
The name of the key has to be specified as a string. Possible expressions are for example:
<Return> <Control-q>
"->bind()" is called like this (different than widgets):
$self->{mw}->bind("<Control-q>" => sub { ... });
When used without object oriented programming, the ".bind()"-method automatically passes the widget as an argument to the function. So this script shows, which key was pressed:
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
sub print_keysym {
my $widget = shift;
my $e = $widget->XEvent();
my $keysym_text = $e->K();
my $keysym_decimal = $e->N();
print "keysym = $keysym_text\n";
print "numeric = $keysym_decimal\n";
}
my $mw = MainWindow->new(-title => "MyWindow");
$mw->optionAdd("*font", "Arial 15 normal");
$mw->geometry("+250+200");
$mw->bind('<KeyPress>' => \&print_keysym);
MainLoop();
But when using object oriented programming, another argument is passed to the function because of the
my $self = shift;
The widget isn't then passed to the function. But it is still known in the class, therefore it's still available in the function, too:
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
package MyWindow {
sub new {
my $classname = shift;
my $self = {};
return bless($self, $classname);
}
sub createWindow {
my $self = shift;
$self->{mw} = MainWindow->new(-title => "Bind-Example");
$self->{mw}->optionAdd("*font", "Arial 15 normal");
$self->{mw}->geometry("+250+200");
$self->{mw}->bind('' => sub { $self->print_keysym() });
$self->{mw}->bind('' => sub { $self->{mw}->destroy() });
$self->{t} = "Pressed:\nkeysym = none\nnumeric = none\n";
$self->{lab1} = $self->{mw}->Label(-textvariable => \$self->{t});
$self->{lab1}->pack(-padx => 20, -pady => 20);
$self->{btn1} = $self->{mw}->Button(-text => "Exit", -command => sub { $self->{mw}->destroy() });
$self->{btn1}->pack(-padx => 20, -pady => 20);
$self->{mw}->MainLoop();
}
sub print_keysym {
my $self = shift;
my $widget = $self->{mw};
my $e = $widget->XEvent();
my $keysym_text = $e->K();
my $keysym_decimal = $e->N();
$self->{t} = "Pressed:\nkeysym = $keysym_text\nnumeric = $keysym_decimal\n";
}
}
my $app = MyWindow->new();
$app->createWindow();
When the main loop of the Tk-application is run, it expects input from the user like mouse-clicks on buttons or pressing of key-combinations assigned with "->bind()".
But what, if the application shall notice something else, for example a certain amount of time passed by or the change of a variable ?
This can be done with the methods "->after()" and especially "->afterIdle()".
In the following example for "->after()" a second toplevel window is opened and closed in a time interval without any interaction of the user:
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
package MyWindow {
sub new {
my $classname = shift;
my $self = {interval => 3,
task2on => 0,
task1on => 0};
return bless($self, $classname);
}
sub createWindow {
my $self = shift;
$self->{mw} = MainWindow->new(-title => 'Example for the ".after()"-method');
$self->{mw}->optionAdd("*font", "Arial 15 normal");
$self->{mw}->geometry("+250+200");
$self->{lab1} = $self->{mw}->Label(-text => "When you click on \"On\", a second window pops up and closes again every $self->{interval} seconds.\n\nBy clicking on \"Off\", you can stop this again.");
$self->{lab1}->pack(-padx => 20, -pady => 20);
$self->{fr1} = $self->{mw}->Frame();
$self->{fr1}->pack();
$self->{btn1} = $self->{mw}->Button(-text => "On", -command => sub { $self->on()});
$self->{btn1}->pack(-side => 'left', -padx => 10);
$self->{btn2} = $self->{mw}->Button(-text => "Off", -command => sub { $self->off()});
$self->{btn2}->pack(-side => 'right', -padx => 10);
$self->{btn3} = $self->{mw}->Button(-text => "Exit", -command => sub { $self->{mw}->destroy() });
$self->{btn3}->pack(-side => 'right', -padx => 10, -pady => 10);
$self->{mw}->MainLoop();
}
sub on {
my $self = shift;
print "On\n";
if (! $self->{task1on} && ! $self->{task2on}) {
$self->{task1} = $self->{mw}->after($self->{interval} * 1000, sub { $self->openWin() });
$self->{task1on} = 1;
}
}
sub off {
my $self = shift;
if ($self->{task1on}) {
$self->{mw}->afterCancel($self->{task1});
$self->{task1on} = 0;
}
if ($self->{task2on}) {
$self->{secwin}->destroy();
$self->{mw}->afterCancel($self->{task2});
$self->{task2on} = 0;
}
print "Off\n";
}
sub openWin {
my $self = shift;
$self->{secwin} = $self->{mw}->Toplevel();
$self->{secwin}->title("Temporary Window");
$self->{secwin}->geometry("+400+250");
$self->{lab2} = $self->{secwin}->Label(-text => "This is a temporary window.\n\nIt closes and reopens every " . $self->{interval} ." seconds.");
$self->{lab2}->pack(-padx => 20, -pady => 20);
$self->{task1on} = 0;
$self->{task2} = $self->{mw}->after($self->{interval} * 1000, sub { $self->closeWinAndSettask1on() });
$self->{task2on} = 1;
print "Opening window.\n";
}
sub closeWinAndSettask1on {
my $self = shift;
$self->{secwin}->destroy();
$self->{task2on} = 0;
$self->{task1} = $self->{mw}->after($self->{interval} * 1000, sub { $self->openWin() });
$self->{task1on} = 1;
print "Closing window.\n";
}
}
my $app = MyWindow->new();
$app->createWindow();
As you can see, controlling the main loop can get rather complicated. Read
perldoc Tk::after
for further information.
Notice: The result couldn't have been achieved using
sleep(INTERVAL);
because "sleep()" would have frozen the whole application.
But you need the application to keep on running to watch out for mouse-clicks or other events.
The "Tk::Photo"-class makes it quite easy to display an image in the application-window.
Supported image-format is for example "gif".
The "Photo"-object must be connected to another widget like a "Label". This widget can then be packed into another widget like the main window.
Here's an example-script. It needs a gif-image "filename.gif" in the script's directory, respectively you have to adapt the script to the filename of the gif-image to display:
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
my $mw = MainWindow->new(-title => "Displaying a gif-Image");
$mw->optionAdd("*font", "Arial 15 normal");
$mw->geometry("+450+200");
my $img = $mw->Photo(-file => 'filename.gif', -format => 'gif');
my $lab1 = $mw->Label(-image => $img, -relief => 'raised');
$lab1->pack(-padx => 100, -pady => 50, -ipadx => 20, -ipady => 20);
my $btn1 = $mw->Button(-text => "Ok", -command => sub { $mw->destroy() });
$btn1->pack(-pady => 20);
$btn1->focus();
$mw->MainLoop();
Embedding such an image into an existing textfield "$tfield" can be done with:
my $img = $mw->Photo(-file => "yourimage.gif", -format => 'gif);
$tfield->imageCreate("1.0", -image => $myimg)
In a Canvas it would be:
$canvas->createImage(0, 0, -anchor => nw, -image => $myimg);
Instead of reading the image-data from a file, it can also be obtained from an encoded string.
"Tk::Scale" provides graphical push-controls for entering numerical values in a certain range defined by "-from" and "-to"-arguments.
Here's an example-script, that should make clearer, what "Tk::Scale" is about:
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
package MyWindow {
sub new {
my $classname = shift;
my $self = {};
return bless($self, $classname);
}
sub createWindow {
my $self = shift;
$self->{mw} = MainWindow->new(-title => "SumCalculator");
$self->{mw}->optionAdd("*font", "Arial 15 normal");
$self->{mw}->geometry("+250+200");
$self->{fr1} = $self->{mw}->Frame(-relief => 'sunken',
-borderwidth => 10);
$self->{fr1}->pack(-side => 'left', -padx => 10, -pady => 10);
$self->{fr2} = $self->{mw}->Frame(-relief => 'raised',
-borderwidth => 10);
$self->{fr2}->pack(-side => 'left', -padx => 10, -pady => 10);
$self->{fr3} = $self->{mw}->Frame(-relief => 'sunken',
-borderwidth => 10);
$self->{fr3}->pack(-side => 'left', -padx => 10, -pady => 10, -ipadx => 10);
$self->{sum} = 0;
$self->{lab1} = $self->{fr3}->Label(-textvariable => \$self->{sum});
$self->{lab1}->pack();
$self->{btn1} = $self->{fr2}->Button(-text => "Calculate Sum",
-command => sub { $self->result() });
$self->{btn1}->pack(-anchor => 'center');
$self->{btn2} = $self->{mw}->Button(-text => "Exit",
-command => sub { $self->{mw}->destroy() });
$self->{btn2}->pack(-side => 'bottom', -padx => 10, -pady => 10);
$self->{scale1} = $self->{fr1}->Scale(-from => 0,
-to => 100,
-orient => 'horizontal',
-label => "Number 1:");
$self->{scale1}->pack();
$self->{scale2} = $self->{fr1}->Scale(-from => 0,
-to => 100,
-orient => 'horizontal',
-label => "Number 2:");
$self->{scale2}->pack();
$self->{scale3} = $self->{fr1}->Scale(-from => 0,
-to => 100,
-orient => 'horizontal',
-label => "Number 3:");
$self->{scale3}->pack();
$self->{mw}->MainLoop();
}
sub result {
my $self = shift;
$self->{sum} = $self->{scale1}->get() + $self->{scale2}->get() + $self->{scale3}->get();
}
}
my $app = MyWindow->new();
$app->createWindow();
Usually you may prefer the "Tk::Entry"-widget to ask numerical input from the user.
But "Tk::Scale" is a very nice widget, if you want to write an audio-mixer-application for example.
The push-controls can be set up vertically too.
The "Tk::Canvas"-widget makes it possible to draw some graphics in a Tk-window.
Here's a (quite beautiful) example:
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
# Screen resolution:
my $RESX = 1024;
my $RESY = 576;
package SplashWindow {
sub new {
my $classname = shift;
my $self = {};
return bless($self, $classname);
}
sub createWindow {
my $self = shift;
$self->{mw} = MainWindow->new();
$self->{mw}->title("Splash");
$self->{mw}->optionAdd("*font", "Arial 15 normal");
$self->{mw}->geometry("+130+18");
$self->{cv} = $self->{mw}->Canvas(-bg => "white",
-width => $RESX,
-height => $RESY);
$self->{cv}->pack();
$self->drawSplash();
$self->{btn} = $self->{mw}->Button(-text => "Ok",
-command => sub { $self->{mw}->destroy() });
$self->{btn}->bind("<Return>", sub { $self->{mw}->destroy() });
$self->{btn}->bind("<Control-q>", sub { $self->{mw}->destroy() });
$self->{btn}->focus();
$self->{btn}->pack(-side => 'right',
-padx => 10,
-pady => 10);
$self->{mw}->MainLoop();
}
sub drawSplash {
my $self = shift;
my $pi = 3.141592;
my @m = ();
my $i;
for $i (0 .. 1000) {
push(@m, 0);
}
my $n = 141;
my $a = cos($pi / 4.);
my $peak_width = -0.001;
my $peak_height = 90;
my ($x, $x1, $y, $y1, $e, $c, $d, $z);
for $y (1 .. ($n + 1)) {
$e = $a * $y;
$c = $y - $n / 2 - 1;
$c *= $c;
for $x (1 .. ($n + 1)) {
$d = $x - $n / 2 - 1;
$z = $peak_height * exp($peak_width * ($c + $d * $d));
$x1 = $x + $e;
$y1 = $z + $e;
# Skip overlapping points:
if ($y1 >= $m[int($x1)]) {
$m[int($x1)] = $y1;
$self->plot($x1, $y1);
}
}
}
}
sub plot {
my $self = shift;
my $x = shift;
my $y = shift;
my $pointsize = 2;
my $padx = 30;
my $pady = 40;
my $zx_spectrum_x = 256;
my $zx_spectrum_y = 176;
# $x = $x / $zx_spectrum_x * $RESX + $padx;
$x = $x / $zx_spectrum_x * $RESX + $padx;
$y = $RESY - $y / $zx_spectrum_y * $RESY - $pady;
my $i;
for $i (0 .. $pointsize) {
$self->{cv}->createLine($x, $y + $i, $x + $pointsize, $y + $i);
}
}
}
my $app = SplashWindow->new();
$app->createWindow();
When writing a GUI-application in Perl/Tk on Windows, you probably want to start it without a console window showing up on the screen.
This can be done by running the script with a Perl executable "wperl.exe" or "perlw.exe" provided by the Perl distribution on Windows. Strawberry Perl for example, which seems to be a nice Perl distribution, provides an executable "wperl.exe" in its "../perl/bin/"-directory.
Similar to ".pyw"-files for Python scripts without console windows, maybe such Perl scripts could have a special suffix ".plw", which could be linked as an application type to "wperl.exe". But that's my own suggestion.
Unfortunately, Strawberry Perl doesn't come with the Tk module by default at the moment. On my Windows XP-machine I could install Tk from CPAN by executing the command
cpan -f -i -P Tk
in the "../perl/bin"-directory of Strawberry Perl though. Some tests failed, so the installation had to be forced with the "-f -i" options. But then Tk mostly worked (maybe a bit experimental though).
My little series about Perl continues with "Perl Page #4: Programming Patterns".