Tk ist ursprünglich ein Zusatz zu Tcl zur Erstellung von Grafical User Interfaces (GUI) in Tcl unter X11. Tk fand als eine sehr gelungene Bibliothek für eine graphische Benutzeroberfläche auch sehr weitreichendes Interesse jenseits von Tcl bei anderen Programmiersprachen wie Scheme, Python, Guile und insbesondere Perl.
John Ousterhout hat Tk so speziell für Tcl entwickelt, daß entsprechende Portierungen für andere Skript-Programmiersprachen nicht sehr einfach waren. Malcom Beattie, der den ersten Versuch für Perl startete, übernahm deswegen des Tcl-Interpreter mit.
Später versuchte Nick Ing-Simmons es mehr mit einem generellen Ansatz: Er bereinigte Tk von allen Abhängigkeiten zu Tcl und schuf eine sprach-unabhängige Schnittstelle. Dies nennt sich pTk (portable Tk, auch ptk). Die heutige Perl-Schnittstelle zu Tk basiert auf pTk.
Perl/Tk von Nick Ing-Simons gestattet den Aufruf von Tcl-Funktionen in der Syntax von OOP-Perl. Diese Implementation ist hier Gegenstand.
Eine neuere Implementierung stellt Tkx dar. Tkx ist eine Brücke zwischen Perl und Tcl. Tcl-Befehle werden über ein definiertes Schema in Perl-Code übersetzt. Tkx bringt Vorteile der neuen Tcl-Version mit sich (z.B. native GUI, Styles). Dafür muss sich der Programmierer mit der Dokumentation von Tcl auseinandersetzen.
Unter einem Package versteht man in Perl einen abgeschlossenen Namensraum für Funktionen und Variablen. Durch dieses Konstrukt können in einem Programm Namenskollisionen vermieden werden. Aufrufe innerhalb eines packages können durch Angabe des einfachen Names, Aufrufe aus anderen packages müssen mit ihrem full qualified Namen erfolgen: package::name.
Unter einem Modul versteht man in Perl eine Datei mit der Endung .pm. Sie enthält ein Teilprogramm (vergleichbar mit Units in Pascal oder Includes in C). In Module ausgelagert werden packages. Ein Modul wird im Hauptprogramm aufgerufen durch
use < modulname >Durch diese Anweisung werden alle im Modul stehenden Package-, Funktions- und Variablenanweisungen übernommen, und die Befehle ausgeführt, welche außerhalb von Subroutinen stehen (Initialisierungen). Perl erwartet von der use-Funktion die Rückgabe des Wertes 1, deshalb enden Module mit der Zeile 1;
Module können auch hierarchisch geschachtelt werden in (Sub-)Directories. Die Anweisung use SUBDIR::MODUL sucht in allen Directories die sich im INC-Pfad (@INC-Array) befinden nach einem Subdirectory SUBDIR und dort nach der Datei MODUL.pm .
Perl/Tk ist ein Perl-Modul (Tk.pm), der mit use Tk aufgerufen wird. Durch use wird das Modul beim Kompilieren geladen und die Namen in den Namensraum eingefügt. (Die Anweisung require lädt ebenfalls Module, jedoch zur Laufzeit und importiert keine Namen).
Perl/Tk wird prinzipiell wie jedes andere Modul installiert. Informationen dazu finden sich in sehr ausführlicher Form im Wiki der deutschen Perl-Community: Wie installiere ich ein Modul?
Manchmal gestaltet es sich etwas schwierig, Perl/Tk auf Windows zu installieren. Die Seite Perl/Tk auf Windows installieren zeigt Lösungen auf.
Als schnellen Test, ob Perl/Tk bereits installiert ist, kann folgender Einzelner in der Konsole verwendet werden:
perl -e "use Tk 999;"Wenn Perl/Tk installiert ist, dann erscheint eine Meldung, dass nur die "kleinere" Version (kleiner als Version 999) vorhanden ist:
C:\Windows\System32>perl -e "use Tk 999";
Tk version 999 required--this is only version 804.029 at -e line 1.
BEGIN failed--compilation aborted at -e line 1.Wenn Perl/Tk nicht installiert ist, dann sieht die Meldung wie folgt aus:
C:\Windows\System32>perl -e "use Tk 999";
Can't locate Tk.pm in @INC (@INC contains: C:/Perl/site/lib
C:/Perl/lib .) at -e line 1.
BEGIN failed--compilation aborted at -e line 1.Unter Perl5 ist eine Klasse lediglich ein Package, deren Subroutinen Objekte manipulieren können und damit Methoden im Sinne der OOP sind.
Perl/Tk stellt mit dem Modul Tk.pm Widgets in Form von Objektklassen zur Verfügung. Der Pfeil-Operator für die Dereferenzierung -> bedeutet den Aufruf einer Methode (Subroutine) eines Objekts.
Ein neues Widget wird nach folgendem Schema erzeugt:
$kind = $vater->Widget-Typ([ -option => "wert", ... ] )Die Syntax für die Erzeugung eines neuen Fensters gestaltet sich wie folgt:
$object = MainWindow->newin diesem Fenster können weitere Widgets erzeugt werden durch:
$newobject = $object->widget(options)Die möglichen widgets sind in Kapitel aufgeführt. Die Optionen unterscheiden sich naturgemäss für die verschiedenen widgets und finden sich in der Tabelle im Anhang. Ebenso unterscheiden sich die Methoden, die mit der Syntax:
$object->methode(options)Beispiel:
$object->configure(-background => 'beige');Als erstes Beispiel wird in einem Fenster ein Text ausgegeben und mit einem "Quit"-Button das Fenster wieder geschlosssen.
#!perl
use strict;
use warnings;
use utf8;
use Tk;
# Haupt-Fenster erzeugen. mw = main window
my $mw = MainWindow->new();
# Titel setzen (sichtbar in der Fensterleiste)
$mw->title("Hello");
# Label erzeugen
my $label = $mw->Label(
-text => 'Guten Morgen, sonnige Welt!',
);
# Button erzeugen
my $quit_btn = $mw->Button(
-text => 'Quit',
-command => sub{
exit(0); # normal beenden
},
);
# Label auf der GUI platzieren
$label->pack();
# Button auf der GUI platzieren
$quit_btn->pack();
# Ereignisschleife der GUI starten
$mw->MainLoop();
exit(0);Mit use Tk werden alle zu Tk gehörenden Module importiert einschließlich aller Widgets wie beispielsweise MainWindow. Ferner wird auch der eigene Namensraum mit einigen Namen wie beispielsweise MainLoop geflutet. Per Konvention wird use strict verwendet, um die Disziplinen zu erzwingen, die das Leben in einer modularisierten Welt erleichtern.
$mw ist ein Objekt von dem Typ MainWindow, das mit my nur lokal sichtbar angelegt wird (dies ist insbesondere auch wegen use strict notwendig). Label und Button sind Methoden von $mw, die entsprechende Widgets kreieren.
Die Konstruktions-Parameter von Widgets werden als assoziative Arrays übergeben. Mit der Methode pack wird das jeweilige Objekt an den entsprechenden Geometrie-Manager übergeben.
MainLoop ist die zentrale Schleife, die alle Ereignisse abarbeitet. Die GUI wird dabei angezeigt und Interaktionen eines Nutzers mit der GUI werden verarbeitet.
Im zweiten Beispiel werden die Standardoptionen am Beispiel eines Buttons, sowie das Ausblenden von Widgets gezeigt. Dieses Beispiel enthält alle möglichen Optionen des Widgets Button und (auskommentiert) die Anweisung, die verhindert, dass das entsprechende Window grösser "gezogen" werden kann.
#!perl
use strict;
use warnings;
use utf8;
use Tk;
my $count = 0;
my $mw = MainWindow->new();
$mw->title("Button-Test");
$mw->geometry('+20+20');
# verhindert das 'Größerziehen':
# $mw->resizable('0','0');
my $degscht = "Auch dies ist \n ein Button \n nur grösser!
\n und mit anderem Font";
my $quit_btn = $mw->Button (
-textvariable => \$degscht,
# alternativ statt -textvariable:
# -text => " Press "
# -bitmap=>"question",
-borderwidth => '5',
# statt -borderwidth geht auch:
# -bd => '3',
# ohne Wirkung:
# -highlightthickness => '30',
-highlightcolor => 'SkyBlue',
-activebackground => 'green',
-relief => 'raised',
-width => 20,
-height => 20,
-command => sub{
$mw->destroy();
return 1;
},
-font => "9x15",
-foreground => "red",
-activeforeground => 'white',
-background => "yellow",
-cursor => 'arrow',
-state => "normal"
);
my $quit_btn2 = $mw->Button(
-text => " Quit ",
-command => [sub{&machput}]
);
$quit_btn->pack();
$quit_btn2->pack();
$mw->MainLoop();
exit(0);
sub machput {
$quit_btn2->destroy();
return 1;
} # /machput
Der Aufbau einer grafischen Anwendung wird in diesem Abschnitt an Hand eines kleinen Beispielprogramms dargestellt. Das Programm zeigt es Inhalt eines Verzeichnisses in einer Listbox an.
Die Struktur des Fensters stellt sich in etwa so dar:
Die graphische Benutzeroberfläche einer Anwendung besteht aus einer Vielzahl von Komponenten (den sogenannten Widgets), die hierarchisch organisiert und zusammengebaut werden. Die Herausforderung liegt in der Findung (und Nutzung) geeigneter Abstraktionen zum Zusammenfügen einer Widget-Hierarchie.
Eine Liste mit Widgets, Screenshots und funktionstüchtigem Beispiel-Quellcode findet sich hier: Übersicht der Perl/Tk-Widgets.
| Widget | Beschreibung |
|---|---|
| Button | Schaltflächen |
| Canvas | Zeichenfläche. Erlaubt das erstellen beliebiger Grafiken, Interaktion mit dem Benutzer aber auch die Anzeige von Tk-Widgets. |
| Checkbutton | Eine Box, die angehakt werden kann. Ähnlich der HTML-Checkbox: |
| Entry | Eingabefelder / editierbare einzeiliges Textfelder |
| Frame | Container für andere Frames. Kann z.B. zur Organisation von Widgets in einer komplexen GUI verwendet werden. |
| Label | Zur Anzeige von Text oder als Container für ein Bild. |
| Listbox | Auswählbare Strings mit Scrollbar |
| MainWindow | Das erste Fenster einer jeden Perl/Tk-GUI-Anwendung. Eine spezielle Form des Toplevel-Fensters. |
| Menu | Menüleisten |
| Menubutton | Ein einzelner Menüpunkt |
| Radiobutton | Ähnlich zur HTML-Radiobox: |
| Scale | Schieberegler mit Zahlen |
| Scrollbar | Scrollbalken können fast mit jedem Widget kombiniert werden. |
| Text | Eingabefeld für Text. Mehrzeilig mit Formatierungsmöglichkeit. Ähnlich zu einem Texteditor. |
| Toplevel | Eigenständige Fenster, ähnlich zum MainWindow (wovon es immer nur eines geben kann). |
Das Widget Frame nimmt eine Sonderrolle ein, da es lediglich einen Rahmen zur Verfügung stellt, in den weitere Widgets platziert werden können. Dadurch wird die Gestaltung von Fenstern flexibler und einfacher zu handhaben.
Daneben haben Frames aber auch noch eine Dekorationsfunktion. So wie bei anderen Widgets auch kann durch die Angabe der relief-Option ein unterschiedliches 3-dimensionale Aussehen erzielt werden.
#!perl
use strict;
use warnings;
use utf8;
use Tk;
my $mw = MainWindow->new();
my @relief_styles = ("flat", "raised", "sunken", "ridge", "groove");
foreach my $reliefstyle ( @relief_styles ) {
# Frame um das Label erzeugen
my $frame = $mw->Frame(
-relief => $reliefstyle,
-borderwidth => 5,
);
# Mit 2mm Abstand seitlich und nach
# oben packen
$frame->pack(
-side => "left",
-padx => "2m",
-pady => "2m",
);
# Label erzeugen
$frame->Label(
-text => $reliefstyle
)->pack();
}
$mw->MainLoop();
exit(0);
Der Geometrie-Manager ist für die Anordnung der Widgets innerhalb eines Windows oder Frames zuständig. Verschiedene Teile einer Anwendung können unterschiedliche Geometrie-Manager verwenden. Perl/Tk kennt vier verschiedene Geometrie-Manager:
| Manager | Beschreibung |
|---|---|
| pack | packt ein Widget ans andere, mit Vorgabe der "Himmelsrichtung". Die Positionierung von Widgets erfolgt jeweils innerhalb des übergeordneten Widgets im noch verbliebenen "Hohlraum" (cavity model). |
| grid | teilt Window in ein regelmäßiges Gitter. Die Positionierung erfolgt innerhalb eines Gitters, das innerhalb des übergeordneten Widgets angelegt worden ist. |
| place | platziert Widgets gezielt im Window. Hierbei wird die Position und Größe eines Widgets präzise in Relation zum übergeordneten Widget spezifiziert. |
| form | Verallgemeinerung, die die Fähigkeiten von pack und place miteinander vereinigt. |
| Name | Funktion | Optionen |
|---|---|---|
| pack | Macht das Widget entsprechend den Optionen, auf das die Methode pack angewendet wird. |
-after, -anchor, -before, -expand, -fill, -in, -ipadx, -ipady, -padx, -pady, -side |
Die Methode pack befördert die davor definierten Widgets auf den Bildschirm. Das übergeordnete Widget stellt einen rechteckigen Raum zur Verfügung, der möglicherweise bereits teilweise belegt ist. Die Platzierung erfolgt dann anhand der angegebenen Optionen und mit Rücksicht auf die bereits im Hohlraum platzierten Widgets. Die gewünschte Seite kann dabei angegeben werden: Beispielsweise mit -side => 'top' (Positionierung an der Oberseite des Hohlraumes). Als Regel gilt: das Widget wird so weit in die gewünschte Richtung geschoben, wie es schon vorhandene Widgets zulassen. Wenn die Größe des übergeordneten Widgets nicht fest vorgegeben ist, dann ergibt sie sich implizit aus der Größe der eingefügten Widgets.
Durch den Geometriemanager pack kann zusammen mit dem Widget Frame (siehe Das Widget Frame) so auf einfache Art eine (nahezu) beliebige Windowgestaltung erreicht werden.
Man sieht wie sowohl die Reihenfolge der pack-Anweisungen, als auch die Werte der side-Option sich auf die Aufteilung des Fensters auswirken. Die relief-Option wurde lediglich benutzt um die Label-Positionen besser erkennen zu können.
| Name | Funktion | Optionen |
|---|---|---|
| grid | Macht das Widget auf das die Methode grid angewendet wird sichtbar, und platziert es entsprechend den Optionen. | -, x, ˆ, -column, -row, -columnspan, -rowspan, -sticky, -in, -ipadx, -ipady, -padx, -pady |
#!perl
use strict;
use warnings;
use utf8;
use Tk;
my $mw = MainWindow->new();
$mw->title('grid-test');
my $label1 = $mw->Label(
-text => 'Label 0 - 1,1 ',
-relief => 'sunken',
);
my $label2 = $mw->Label(
-text => 'Label 1 - 2,2 ',
-relief => 'sunken',
);
my $label3 = $mw->Label(
-text => 'Label 2 - 3,3 ',
-relief => 'sunken',
);
my $label4 = $mw->Label(
-text => 'Label 3 --------- 4,1-2 ',
-relief => 'sunken',
);
my $label5 = $mw->Label(
-text => 'Label 4 --------- 5,2-3',
-relief => 'sunken',
);
$label1->grid(-row=>'0', -column=>'0');
$label2->grid(-row=>'1', -column=>'1');
$label3->grid(-row=>'2', -column=>'2');
$label4->grid(-row=>'3', -columnspan=>'2',);
$label5->grid(-row=>'4', -column=>'1', -columnspan=>'2',);
$mw->MainLoop();
exit(0);
#!perl
use strict;
use warnings;
use utf8;
use Tk;
my $mw = MainWindow->new();
$mw->title('grid-test-2');
my $label1 = $mw->Label(-text=>' - Label 0 - ', -relief=>'sunken');
my $label2 = $mw->Label(-text=>' - Label 1 - ', -relief=>'sunken');
my $label3 = $mw->Label(-text=>' - Label 2 - ', -relief=>'sunken');
my $label4 = $mw->Label(-text=>' - Label 3 - ', -relief=>'sunken');
my $label5 = $mw->Label(-text=>' - Label 4 - ', -relief=>'sunken');
$label1->grid($label2, $label3);
$label4->grid('x',$label5);
$mw->MainLoop();
exit(0);
| Name | Funktion | Optionen |
|---|---|---|
| place | Macht das Widget auf das die Methode place angewendet wird sichtbar, und platziert es entsprechend gewählten x- und y-Koordinaten. | -anchor, -bordermode, -height, -in, -relheight, -relwidth, -relx, -rey, -width, -x, -y |
Mit place können die Widgets beliebig innerhalb des Windows gesetzt werden, also auch übereinander. Die Koordinaten können absolut (bezogen auf den Bildschirm) oder relativ (bezogen auf das Elternwidget) angegeben werden.
#!perl
use strict;
use warnings;
use utf8;
use Tk;
my $mw = MainWindow->new();
$mw->title('place-Test');
my $label1 = $mw->Label(-text=>' - Label 0 - ', -relief=>'sunken');
my $label2 = $mw->Label(-text=>' - Label 1 - ', -relief=>'sunken');
my $label3 = $mw->Label(-text=>' - Label 2 - ', -relief=>'sunken');
my $label4 = $mw->Label(-text=>' - Label 3 - ', -relief=>'sunken');
my $label5 = $mw->Label(-text=>' - Label 4 - ', -relief=>'sunken');
$label1->place(-x=>10, -y => 25);
$label2->place(-x=>20, -y => 50);
$label3->place(-x=>30, -y => 75);
$label4->place(-x=>40, -y => 85);
$label5->place(-x=>20, -y => 150);
$mw->MainLoop();
exit(0);
| Option | Parameter | Funktion | Beispiel |
|---|---|---|---|
| -activebackground | <color> | Hintergrund, aktiv | siehe -background |
| -activeforeground | <color> | Vordergrund, aktiv | siehe -background |
| -anchor | n, ne, e, se, s, sw, w, nw, center | Anker, Anbindungsrichtung | -anchor => 'sw' |
| -background | <color> | Hintergrundfarbe nicht aktiv | -background => 'gray50' |
| -bitmap | <bitmap> | Flächenmuster | -bitmap => @bitmap.xbm |
| -borderwidth | <width> c, m, i, p | Randbreite | -borderwidth => '2m' |
| -command | sub{... } oder \&<funcname> oder [ < commandlist > ] | Kommandoaufruf | -command => sub{ machwas(); return 1; } |
| -cursor | arrow, circle ... | Cursorform | -cursor => 'arrow' |
| -disabledforeground | |||
| -image | |||
| -text | |||
| -expand | yes, no | Ausdehnung ja/nein | -expand => 'no' |
| -fill | none, x, y, both | Füllausdehnungsrichtung | -fill => 'both' |
| -font | <Zeichensätze> | Wahl des Zeichensatzes | -font => ''courierb10'' |
| -foreground | <color> | Vordergrundfarbe (Schriftfarbe) | -foreground => 'black' |
| -height | <width> | Höhe eines Widgets | -height => '10m' |
| -highlightbackground | <color> | wenn Mouse auf Widget | siehe -background |
| -highlightcolor | <color> | -highlightcolor => 'beige' | |
| -highlightthickness-takefocus | |||
| -image | <photo> | legt Bild auf Button oder Label | -image => $myphoto |
| -in | $<widget> | Geometrisches Parent | |
| -justify | |||
| -label | <text> | Ausgabe von Text | -label => 'text' |
| -padx | <width> c, m, i, p | Abstand seitlich | -padx => '2m' |
| -pady | <width> c, m, i, p | Abstand oben und unten | -pady => '3m' |
| -pady-wraplength | |||
| -relief | flat, groove, raised, ridge, sunken | Art 3D-Darstellung der Widgets | -relief => 'raised' |
| -side | top, left, bottom, right | Positionierung | -side => 'top' |
| -state | normal, disabled, active | Aktivierbar, gesperrt, aktiv | -state => 'normal' |
| -status | normal, disabled | Editieren oder Readonly | -status => 'normal' |
| -text | <text> | Beschriftung | -text => 'text' |
| -textvariable | <variablenreferenz> | Referenz auf Variable | -textvariable => \$myvar |
| -underline | <offset> | Hotkey-Zeichen als Offset | -underline => 1 |
| -width | <width> | Breite | -width => '30m' |
| -wrap | none, char, word | Zeilenumbruch |
| Platzhalter | Erklärung |
|---|---|
| <color> | ist eine Farbe entweder mit Namen aus /usr/lib/X11/rgb.txt oder in der RGB-Darstellung #rrggbb (rr, gg, bb in Hex) |
| <width> | Maßeinheiten: c = cm, m = mm, i = inch, p = pixel (Default) |
| <bitmap> | entweder $filename oder der Name eines Tk-eigenen Bitmaps: error, gray25, gray50, hourglas, info, questhead, question oder warning. |
| <offset> | Zahl die Offset in einem String anzeigt |
| <Zeichensätze> | eine der unter X11 möglichen Bezeichnungen eines Zeichensatzes (bzw. der entsprechenden Window-Implementierung anderer OS). |
| <text> | Textstring in einfachen oder doppelten (Perl-Variablen werden aufgelöst) Anführungszeichen. |
| <photo> | Photowidget als Wert der -image-Option der beiden Widgets Button und Label. |
Neben einigen spezifischen Methoden, die es nur für einige Widgets gibt, gibt es auch Methoden, die in allen Widgets implementiert sind.
Der größte Teil der Methoden haben Informationscharakter, d.h. sie manipulieren nichts, sondern liefern nur Werte zurück. Eine vollständige Aufstellung ist in der Literatur 1. und 2. zu finden.
| Methode | Widget | Beschreibung | Beispiel |
|---|---|---|---|
| pack | all | Ordnet Widget im Windows an | $widget->pack(options); |
| grid | all | Ordnet Widget im Windows an | $widget->grid(options); |
| place | all | Ordnet Widget im Windows an | $widget->place(options); |
| packForget | all | Widget löschen ohne zu zerstören | $widget->packForget(); |
| gridForget | all | Widget löschen ohne zu zerstören | $widget->gridForget(); |
| placeForget | all | Widget löschen ohne zu zerstören | $widget->placeForget(); |
| configure | all | Änderung der aktuellen Optionen | $widget->configure(-background=>"grey"); |
| destroy | all | Zerstören eines Widgets | $widget->destroy(); |
| bind | all | Verknüpfung Erreignissfolge und Widget | entry->bind(«Return>",\&checkin($textvar)); |
| insert | Text | fügt Zeile ein | $widget->insert('end', 'Die letzte Zeile'); |
| Listbox | |||
| delete | Text | löscht Zeile(n) | $widget->delete(5, 10); |
| Listbox | |||
| select | Text | Auswahl von Zeile(n) | $widget->select(5, 'end'); |
| Listbox | |||
| after | all | Zeitverzögerung | $messag->after(2*1000, sub { exit }); |
| repeat | all | wiederholtes Aufrufen einer Subroutine | $widget = repeat(600, \&wieder); |
Alle Aktionen des Benutzers (Bewegen der Maus, Benutzung der Maustasten oder der Tastatur) führen zu einem Strom einzelner Ereignisse. Aus der Mausposition oder der Fokus-Zugehörigkeit zum Zeitpunkt der Entstehung eines Ereignisses und vorheriger Interessensbekundungen (z.B. durch die Methode bind) ergibt sich eine Menge von Parteien, denen das Ereignis mitzuteilen ist.
Eine "Mitteilung" erfolgt in Perl/Tk durch den Aufruf einer (typischerweise anonymen) Prozedur und (bei Bedarf) einer Reihe von Parametern. Interessant sind die Spezifikationen von Ereignissen, die Möglichkeiten der Interessensbekundungen und die Reihenfolge der Mitteilungen.
Nachfolgendes Beispiel zeigt, wie der Klick auf ein Frame eine Ausgabe auf der Konsole erzeugt:
#!perl
use strict;
use warnings;
use Tk;
my $top = MainWindow->new;
my $frame = $top->Frame(-width => 50, -height => 50,
-bg => 'yellow');
$frame->pack;
$frame->bind('<ButtonPress>',
sub { print "Ouch, that hurts!\n" });
$top->MainLoop;
exit(0);Ereignis-Spezifikationen sehen folgendes allgemeines Schema vor:
<modifier-modifier-type-detail>Zu den Modifiern zählen Control, Shift, Button1 (1. Button der Maus), Alt, Meta und auch Double (für Doppelklicks). Auf die Angabe von Modifiern kann ganz verzichtet werden (dann spielen sie keine Rolle) oder es können ein oder zwei angegeben werden. In letzterem Falle müssen dann beide Modifier gleichzeitig aktiv sein.
Zu den Typen gehören ButtonPress, ButtonRelease, KeyPress, KeyRelease, Enter und Release (neben vielen weiteren).
Beim Detail kann (z.B. bei KeyPress) der Name einer weiteren Taste angegeben werden (oder schlicht der Buchstabe) oder (z.B. bei ButtonPress) die Nummer der Maustaste.
Die Angaben können weitgehend gekürzt werden, solange noch eindeutig ist, was gewünscht wird. Statt <Control-KeyPress-U> ist auch <Control-U> zulässig.
Ereignis-Spezifikationen operieren wie Muster, die eingehende Ereignisse filtern. So trifft beispielsweise <KeyPress> für alle gedrückten Tasten zu. Die Namen der Tasten hängen natürlich von dem lokalen Window-System ab und sind daher nicht in jedem Falle uneingeschränkt portabel (wie auch Tastaturen sehr unterschiedlich aussehen können).
Eine Interessensbekundung für Ereignisse besteht aus einem Kontext und einer Ereignisspezifikation. Mögliche Kontexte sind:
Der Kontext wird als erster Parameter bei bind angegeben. Wenn er fehlt, wird nur ein Bezug zu dem vorgegebenen Widget-Objekt hergestellt. Es kann ein Klassenname (z.B. Tk::Button) angegeben werden, das Widget eines Toplevel-Fensters oder schlicht all.
Wenn für ein Ereignis mehrere Interessensbekundigungen vorliegen, dann werden sie in einer definierten Reihenfolge abgearbeitet. Per Voreinstellung gilt folgende Reihenfolge:
Die Reihenfolge kann (mit bindtags) für jedes Widget verändert (und sogar noch erweitert) werden.
#!perl
use strict;
use warnings;
use utf8;
use Tk;
my $top = MainWindow->new;
my $label = $top->Label(
-text => 'Taste drücken...',
-fg => 'red'
);
$top->bind(
'<KeyPress>',
[
sub {
my ( $self, $keycode ) = @_;
$label->configure(-text => sprintf("keycode: %s\n", $keycode));
},
Ev('k')
]
);
$label->pack;
$label->focus;
$top->MainLoop;
exit(0);
Bei der Methode bind können Ereignis-Bearbeiter in einer Vielzahl von Varianten angegeben werden:
| Ereignisbearbeiter | Beschreibung |
|---|---|
&subname |
Zeiger auf vorhandene Prozedur |
sub{ ... } |
Anonyme Prozedur |
'methodname' |
Methode des zugehörigen Widgets |
[&subname, ...] |
Mit Parameterliste |
[sub{ ... }, ...] |
|
['mnethodname', ...] |
Parameterlisten sind überflüssig, solange nicht Interesse an speziellen Ereignisparametern besteht, die über von Ev erzeugte Callback-Objekte zugänglich sind.
Das folgende Beispiel enthält ein kleines Tool zur Darstellung der in X11 möglichen Farben, mit Testfeldern deren Vorder- und Hintergrund durch Anklicken mit der linken bzw. rechten Maustaste in der Liste gewählt werden können.
#!perl
use strict;
use warnings;
use utf8;
use Tk;
my $fgcolor = 'black';
my $bgcolor = 'white';
my $font = '-misc-fixed-medium-r-normal--13-100-100-100-c-80-iso8859-8';
my $mw = MainWindow->new();
$mw->title("Xcolors");
my $frame = $mw->Frame();
my $text = $frame->Text(
-wrap => 'none',
);
my $yscrollbar = $frame->Scrollbar(
-command => [yview => $text],
);
my $Buttonframe = $mw->Frame();
my $OK_Button = $Buttonframe->Button(
-text => 'Quit',
-background => 'gray50',
-foreground => 'white',
-command => sub{
$mw->destroy;
return 1;
},
);
### Anzeige: Anzahl der Farben
my $labelvar = '';
my $label = $Buttonframe->Label(
-textvariable => \$labelvar,
);
$text->configure(
-yscrollcommand => [set => $yscrollbar],
);
$text->configure (
-font => $font,
);
### Alles packen
$yscrollbar->pack(
-side => 'right',
-fill => 'y',
);
$label->pack(
-fill => 'x',
-side => 'right',
);
$frame->pack(
-expand => 1,
-fill => 'both',
);
$text->pack(
-expand => 1,
-fill => 'both',
-side => 'left'
);
$Buttonframe->pack(
-expand => 1,
-fill => 'both',
-side => 'bottom',
);
$OK_Button->pack(-side => 'left');
### Farben auslesen und Textzeilen einfaerben
# wer die Datei nicht hat (z.B. auf Windows), der
# kann eine Testdatei anlegen, die folgendes beinhaltet (ohne #):
#! $XFree86$
#255 250 250 snow
#255 240 245 LavenderBlush
#106 90 205 SlateBlue
#open(my $fh, '< /usr/lib/X11/rgb.txt') or die 'rgb.txt not found';
open(my $fh, '<rgb.txt') or die 'rgb.txt not found';
my ($tagname,$grauwert, $foreground);
my $i=1;
while( my $row = <$fh> ) {
# Kommentare entfernen
$row =~ s/!.*//;
# Leerzeilen ignorieren
next if $row =~ /^\s*$/;
my ($red, $green, $blue) = split(' ', $row);
my $name = substr($row, 12);
$name =~ s/^\s*//;
chomp( $name );
my $col = sprintf("#%02x%02x%02x", $red, $green, $blue);
### Beschriftungsfarbe weiß fuer dunkle Hintergrundfarben
$grauwert = $red + 3*$green + $blue;
$foreground = 'white';if ($grauwert > 625){$foreground='black'}
$name = substr ($name." ",0,20);
# Text in Text-Widget einfügen (mit \n)
$text->insert("end", "$name $col \n");
### Tag definieren und Farbe dort setzen
$tagname = "zeile$i";
$text->tag("add", $tagname, "$i.0", sprintf("%d.0", $i+1));
$text->tag("configure", $tagname,
-background => $col,
-foreground => $foreground
);
$text->tag(
'bind' => $tagname,
'<Button-1>' => sub{ &doit($name); }
);
$text->tag(
'bind' => $tagname,
'<Button-3>' => sub{ &shiftdoit($name); }
);
### Jede neue Farbe sofort anzeigen
$text->update();
### Anzeige auffrischen
$i++;
$labelvar="There are $i colors in /usr/lib/X11/rgb.txt ";
}
close($fh);
# ------------------------------ Color Frames -----
my $color_frame = $mw->Frame;
$color_frame->pack(-side => 'bottom');
my $probe1 = $color_frame->Text;
$probe1->configure(
-height => '5',
-width => '15',
-state => 'disabled',
-font => $font,
);
$probe1->pack( -side => 'left' );
# -----
my $probe2 = $color_frame->Text;
$probe2->configure (
-height => '5',
-width => '15',
-state => 'disabled',
-font => $font,
);
$probe2->pack( -side => 'left' );
# -----
my $probe3 = $color_frame->Text;
$probe3->configure (
-height => '5',
-width => '15',
-state => 'disabled',
-font => $font,
);
$probe3->pack( -side => 'left' );
# -----
my $probe4 = $color_frame->Text;
$probe4->configure (
-height => '5',
-width => '15',
-state => 'disabled',
-font => $font,
);
$probe4->pack( -side => 'left' );
# -----
my $probe5 = $color_frame->Text;
$probe5->configure (
-height => '5',
-width => '15',
-state => 'disabled',
-font => $font,
);
$probe5->pack( -side => 'left' );
$probe1->bind ('<Button-1>', sub{set_wind('1')});
$probe2->bind ('<Button-1>', sub{set_wind('2')});
$probe3->bind ('<Button-1>', sub{set_wind('3')});
$probe4->bind ('<Button-1>', sub{set_wind('4')});
$probe5->bind ('<Button-1>', sub{set_wind('5')});
# ------------------------------ Radio Button Frame -----
my $radio_frame = $mw->Frame(-relief => 'sunken');
$radio_frame->pack(-side => 'bottom');
my $actw = 1;
my $helpvar = 'Left-button = background'
.' Right-button = foreground';
my $helplabel = $radio_frame->Label(
-textvariable => \$helpvar,
-relief => 'sunken',
);
$helplabel->configure(
-background => 'gray50',
-foreground => 'white'
);
$helplabel->pack(
-side => 'top',
-expand => 1,
-fill=>'x'
);
foreach my $p ('probe1', 'probe2', 'probe3', 'probe4', 'probe5') {
my $r = $radio_frame->Radiobutton(
-text => " $p ",
-variable => \$actw,
-relief => 'flat',
-value => $actw++,
);
$r->pack(
-side => 'left',
-pady => 2,
-anchor => 'w'
);
if( $p eq 'probe1' ){
$r->configure(-state => 'active');
};
}
$actw = 1;
$text->configure(-state => "disabled");
MainLoop;
# --------------------------------------------------------------
sub doit {
$bgcolor = shift;
$bgcolor =~ s|\s*$||;
if ($actw == 1) {
$probe1->configure(-state => 'normal');
$probe1->delete ('1.0','end');
$probe1->insert ('end',"f:$fgcolor\n\n");
$probe1->insert ('end',"b:$bgcolor");
$probe1->configure(
-background => $bgcolor,
-state => 'disabled',
);
}
if ($actw == 2) {
$probe2->configure(-state => 'normal');
$probe2->delete ('1.0','end');
$probe2->insert ('end',"f:$fgcolor\n\n");
$probe2->insert ('end',"b:$bgcolor");
$probe2->configure(
-background => $bgcolor,
-state => 'disabled',
);
}
if ($actw == 3) {
$probe3->configure(-state => 'normal');
$probe3->delete ('1.0','end');
$probe3->insert ('end',"f:$fgcolor\n\n");
$probe3->insert ('end',"b:$bgcolor");
$probe3->configure(
-background => $bgcolor,
-state => 'disabled',
);
}
if ($actw == 4) {
$probe4->configure(-state => 'normal');
$probe4->delete ('1.0','end');
$probe4->insert ('end',"f:$fgcolor\n\n");
$probe4->insert ('end',"b:$bgcolor");
$probe4->configure(
-background => $bgcolor,
-state => 'disabled',
);
}
if ($actw == 5) {
$probe5->configure(-state => 'normal');
$probe5->delete ('1.0','end');
$probe5->insert ('end',"f:$fgcolor\n\n");
$probe5->insert ('end',"b:$bgcolor");
$probe5->configure(
-background => $bgcolor,
-state => 'disabled',
);
}
}
# --------------------------------------------------------------
sub shiftdoit {
$fgcolor = shift;
$fgcolor =~ s|\s*$||;
if ($actw == 1) {
$probe1->configure(-state => 'normal');
$probe1->delete ('1.0','end');
$probe1->insert ('end',"f:$fgcolor\n\n");
$probe1->insert ('end',"b:$bgcolor");
$probe1->configure(
-foreground => $fgcolor,
-state => 'disabled',
);
}
if ($actw == 2) {
$probe2->configure(-state => 'normal');
$probe2->delete ('1.0','end');
$probe2->insert ('end',"f:$fgcolor\n\n");
$probe2->insert ('end',"b:$bgcolor");
$probe2->configure(
-foreground => $fgcolor,
-state => 'disabled',
);
}
if ($actw == 3) {
$probe3->configure(-state => 'normal');
$probe3->delete ('1.0','end');
$probe3->insert ('end',"f:$fgcolor\n\n");
$probe3->insert ('end',"b:$bgcolor");
$probe3->configure(
-foreground => $fgcolor,
-state => 'disabled',
);
}
if ($actw == 4) {
$probe4->configure(-state => 'normal');
$probe4->delete ('1.0','end');
$probe4->insert ('end',"f:$fgcolor\n\n");
$probe4->insert ('end',"b:$bgcolor");
$probe4->configure(
-foreground => $fgcolor,
-state => 'disabled',
);
}
if ($actw == 5) {
$probe5->configure(-state => 'normal');
$probe5->delete ('1.0','end');
$probe5->insert ('end',"f:$fgcolor\n\n");
$probe5->insert ('end',"b:$bgcolor");
$probe5->configure(
-foreground => $fgcolor,
-state => 'disabled',
);
}
}
# --------------------------------------------------------------
sub set_wind {
$actw = $_[0];
}
Diese Einführung basiert auf der Einführung in Perl/Tk von Dr. Rudolf Strub und mit freundlicher Genehmigung von Dr. Andreas F. Borchert auf den Folien des Kurses Objekt-orientierte Datenbankanwendungen.
