1 Perl + Tk = perl/Tk
Tk ist ursprünglich ein Zusatz zu Tcl zur Erstellung von Grafical User Interfaces (GUI) in Tcl unter X11.Es gibt zwei unterschiedliche Implementationen von Tk in Perl.
- Tkperl von Malcolm Beattie. Es gestattet die Einbindung von Tcl-Code in Perl-Scripts.
-
perl/Tk von Nick Ing-Simons (auch ptk oder pTk) gestattet den Aufruf von Tcl-Funktionen in der Syntax von OOP-Perl. Diese Implementation ist hier Gegenstand. Es wird häufig ebenfalls Tkperl genannt.
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
ausserhalb 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).
2 Installation von Perl/Tk
Von
http://sunsite.cnlab-switch.ch/ftp/mirror/CPAN/modules/by-authors/Nick_Ing-Simmons/
holt man sich
Tk800.023.tar.gz
gunzip Tk800.023.tar.gz tar -xvf Tk800.023.tar cd Tk800.023 perl Makefile.PL make make install
Nähere Hinweise in Literatur *.
3 OOP
Unter Perl5 ist eine Klasse lediglich eine 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 dem Schema:
$kind = $vater - > Widget-Typ([ -option= > wert, ... ] )
erzeugt.
Syntax für die Erzeugung eines Fensters auf der Root-Fläche:
$object = MainWindow - > new
in 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)
z.B.: $object - > configure(-background= > 'beige');
4 Erste Beispiele
Als erstes Beispiel wird in einem Fenster ein Text ausgegeben und mit einem "´Quit"´-Button das Fenster wieder geschlosssen.
#!/usr/bin/perl -w
use Tk;
$top = MainWindow -> new();
$top -> title("Hello");
my $out = $top -> Label(-text => "´Guten Morgen, sonnige Welt!"´);
my $Quit_Button = $top -> Button ( -text => "´Quit"´,
-command => sub{exit 0});
$out -> pack();
$Quit_Button -> pack();
MainLoop;
Im zweiten Beispiel werden die Standardoptionen am Beipiel 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.
#!/usr/bin/perl -w
use Tk;
my $count = 0;
my $top = MainWindow->new();
# $top -> resizable ('0','0'); # verhindert das 'Groesserziehen'
$top -> title ("Button-Test");
$top -> geometry ('+20+20');
my $degscht = " Auch dies ist \n ein Button \n nur groesser!
\n und mit anderem Font";
my $Quit_Button = $top-> Button (
# -text => " Press " # statt -textvariable
-textvariable => \$degscht,
# -bitmap=>"question",
-borderwidth=> '5',
# -bd => '3', # statt -borderwidth
# -highlightthickness => '30', # ohne Wirkung
-highlightcolor => 'SkyBlue',
-activebackground => 'green',
-relief => 'raised',
-width=>'20',
-height=>'20',
-command => sub{$top->destroy},
-font => "9x15",
-foreground => "red",
-activeforeground => 'white',
-background => "yellow",
-cursor => 'arrow',
-state => "normal");
my $Quit_Button2 = $top-> Button ( -text => " Quit ",
-command => [sub{&machput}]);
$Quit_Button -> pack();
$Quit_Button2 -> pack();
MainLoop;
sub machput {$Quit_Button2->destroy}
5 Übersicht über die Widgets
| Button | Create and manipulate button widgets |
| Canvas | Create and manipulate canvas widgets (graphics) |
| Checkbutton | Create and manipulate checkbutton widgets |
| Entry | Create and manipulate entry widgets |
| Frame | Create and manipulate frame widgets |
| Label | Create and manipulate label widgets |
| Listbox | Create and manipulate listbox widgets |
| MainWindow | Create the first window, a special form of Toplevel |
| Menu | Create and manipulate menu widgets |
| Menubutton | Create and manipulate menubutton widgets |
| Radiobutton | Create and manipulate radiobutton widgets |
| Scale | Create and manipulate scale widgets |
| Scrollbar | Create and manipulate scrollbar widgets |
| Text | Create and manipulate text widgets |
| Toplevel | Create and manipulate toplevel widgets |
5.1 Das Widget frame
Das Widget frame nimmt eine Sonderrolle ein, da es lediglich einen
Rahmen zur Verfügung stellt,in den weitere Widgets plaziert werden können.
Dadurch wird die Gestaltung von Windows 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.
#!/usr/bin/perl -w
use Tk;
my $top = MainWindow->new();
foreach $reliefstyle ("flat", "raised", "sunken",
"ridge", "groove") {
# Frame um das Label erzeugen
$frame = $top->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();
}
MainLoop;
6 Die Geometrie-Manager
Der Geometrie-Manager sind für die Anordnung der Widgets innerhalb eines Windows oder Frames zuständig. Perl/Tk kennt drei verschiedene Windows-Manager:
- pack - packt ein Widget ans andere, mit Vorgabe der ''Himmelsrichtung''
- grid - teilt Window in ein regelmässiges Gitter
- place - platziert Widgets gezielt im Window
6.1 Die Methode pack
| Name | Funktion | Optionen |
| pack | Macht das Widget auf das die Methode pack angewendet wird sichtbar, entsprechend den Optionen | -after, -anchor, -before, -expand, -fill, -in, -ipadx, -ipady, -padx, -pady, -side |
Die Methode pack befördert die davor definierten Widgets auf den Bildschirm. Die Plazierung erfolgt anhand der angegebenen Optionen und mit Rücksicht auf die bereits platzierten Widgets. Als regel gilt: das Widget wird so weit in die gewünschte Richtung geschoben, wie es schon vorhandene Widgets zulassen. Zusammen mit dem Widget frame (siehe 5.1 kann so auf einfache Art eine (nahezu) beliebige Windowgestaltung erreicht werden.
#!/usr/drwho/local/bin/perl -w use Tk; my $top = MainWindow -> new(); my $label1 = $top -> Label (-text=>'Label 1 - top ',-relief=>'sunken'); my $label2 = $top -> Label (-text=>'Label 2 - left ',-relief=>'sunken'); my $label3 = $top -> Label (-text=>'Label 3 - top ',-relief=>'sunken'); my $label4 = $top -> Label (-text=>'Label 4 - left ',-relief=>'sunken'); my $label5 = $top -> Label (-text=>'Label 5 - right',-relief=>'sunken'); $label1 -> pack(-side=>'top'); $label2 -> pack(-side=>'left'); $label3 -> pack(-side=>'top'); $label4 -> pack(-side=>'left'); $label5 -> pack(-side=>'right'); MainLoop;
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.
6.2 Die Methode grid
| Name | Funktion | Optionen |
| grid | Macht das Widget auf das die Methode grid angewendet wird sichtbar, und plaziert es entsprechend den Optionen. | -, x, Ù, -column, -row, -columnspan, -rowspan, -sticky, -in, -ipadx, -ipady, -padx, -pady |
#!/usr/sepp/bin/perl -w
use Tk;
my $top = MainWindow -> new();
$top -> title('grid-test');
my $label1 = $top -> Label (-text=>'Label 0 - 1,1 ',-relief=>'sunken');
my $label2 = $top -> Label (-text=>'Label 1 - 2,2 ',-relief=>'sunken');
my $label3 = $top -> Label (-text=>'Label 2 - 3,3 ',-relief=>'sunken');
my $label4 = $top -> Label (-text=>'Label 3 --------- 4,1-2 ',-relief=>'sunken');
my $label5 = $top -> 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',);
MainLoop;
#!/usr/sepp/bin/perl -w
use Tk;
my $top = MainWindow -> new();
$top -> title('grid-test-2');
my $label1 = $top -> Label (-text=>' - Label 0 - ', -relief=>'sunken');
my $label2 = $top -> Label (-text=>' - Label 1 - ', -relief=>'sunken');
my $label3 = $top -> Label (-text=>' - Label 2 - ', -relief=>'sunken');
my $label4 = $top -> Label (-text=>' - Label 3 - ', -relief=>'sunken');
my $label5 = $top -> Label (-text=>' - Label 4 - ', -relief=>'sunken');
$label1 -> grid($label2, $label3);
$label4 -> grid('x',$label5);
MainLoop;
6.3 Die Methode place
| Name | Funktion | Optionen |
| place | Macht das Widget auf das die Methode place angewendet wird sichtbar, und plaziert 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.
#!/usr/sepp/bin/perl -w
use Tk;
my $top = MainWindow -> new();
$top -> title('grid-test-2');
my $label1 = $top -> Label (-text=>' - Label 0 - ', -relief=>'sunken');
my $label2 = $top -> Label (-text=>' - Label 1 - ', -relief=>'sunken');
my $label3 = $top -> Label (-text=>' - Label 2 - ', -relief=>'sunken');
my $label4 = $top -> Label (-text=>' - Label 3 - ', -relief=>'sunken');
my $label5 = $top -> 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);
MainLoop;
7 Die wichtigsten Optionen
| 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} |
| -cursor | arrow, circle ... | Kursorform | -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 |
- < color > :
- ist eine Farbe entweder mit Namen aus /usr/lib/X11/rgb.txt oder in der RGB-Dartsellung #rrggbb (rr, gg, bb in Hex)
- < width > :
- Masseinheiten: 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-Variable werden aufgelöst) Anführungszeichen.
- < photo > :
- Photowidget als Wert der -image-Option der beiden Widgets Button und Label.
8 Methoden
Neben einigen spezifischen Methoden, die es nur für einige Widgets gibt, gibt es dauch Methoden, die in allen Widgets implementiert sind. sind.
Der grösste Teil der Methoden haben Informationscharakter, d.h. sie manipulieren nichts, sondern liefern nur Werte zurück. Eine volständige Aufstellung ist in der Literatur 1. bis 3. zu finden
| 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 loeschen ohne zu zerstören | $widget->packForget(); |
| gridForget | all | Widget loeschen ohne zu zerstören | $widget->gridForget(); |
| placeForget | all | Widget loeschen 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); |
9 Weitere Beispiele
Weitere Beispiele finden sich im Verzeichnis
/usr/drwho/local/pack/perl-5.004/lib/site_perl/Tk/demos/prog
Mit perl widget
erscheint ein MenueFenster, in dem man Demos für alle Widgets aufrufen kann.
( auf tardis: /usr/pack/perl-solaris260-5.6.1-ds/bin/widget )
Das folgende Beispiel enthält ein kleines Tool zur Darstellung der in X11 möglichen Farben, mit Testfeldern deren Vorder- und Hintergund durch anklicken mit der linken bzw. rechten Maustaste in der Liste gewählt werden können.
#!/usr/bin/perl -w
use Tk;
use strict;
my($r, $p);
my $fgcolor = 'black';
my $bgcolor = 'white';
my $top = MainWindow->new();
$top -> title ("Xcolors");
my $frame = $top->Frame();
my $text = $frame->Text(-wrap => 'none');
my $yscrollbar = $frame->Scrollbar(-command => [yview => $text]);
my $Buttonframe = $top -> Frame();
my $OK_Button = $Buttonframe->Button (-text => "Quit",
-background => 'gray50',
-foreground => 'white',
-command => [sub{$top->destroy}]);
### Anzeige: Anzahl der Farben
my $labelvar = "";
my $label = $Buttonframe->Label(-textvariable => \$labelvar);
$text->configure(-yscrollcommand => [set => $yscrollbar]);
$text-> configure (-font => '-misc-fixed-medium-r-normal--13-100-100-100-c-80-iso8859-8' );
### Alles packen
$yscrollbar->pack(-side => 'right', -fill => 'y');
$label->pack(-fill => 'x', -side => 'right');
$frame->pack(-expand => 'yes', -fill => 'both');
$text->pack(-expand => 'yes', -fill => 'both', -side => 'left');
$Buttonframe->pack(-expand => 'yes', -fill => 'both', -side => 'bottom');
$OK_Button->pack (-side => 'left');
### Farben auslesen und Textzeilen einfaerben
open(COLORS, "< /usr/lib/X11/rgb.txt") ||
die "rgb.txt not found";
my ($tagname,$grauwert, $foreground);
my $i=1;
while(<COLORS>) {
s/!.*//; # Kommentare entfernen
next if /^\s*$/; # Leerzeilen ignorieren
my ($red, $green, $blue) = split(' ', $_);
my $name = substr ($_,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->insert("end", "$name $col \n"); # Text in Text-Widget
# einfügen (mit \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(COLORS);
# ------------------------------ Color Frames -----
my $color_frame = $top -> Frame;
$color_frame -> pack (-side => 'bottom');
my $probe1 = $color_frame -> Text;
$probe1 -> configure (
-height => '5',
-width => '15',
-state => 'disabled',
-font => '-misc-fixed-medium-r-normal--13-100-100-100-c-80-iso8859-8',
);
$probe1 -> pack (qw(-side left ));
# -----
my $probe2 = $color_frame -> Text;
$probe2 -> configure (
-height => '5',
-width => '15',
-state => 'disabled',
-font => '-misc-fixed-medium-r-normal--13-100-100-100-c-80-iso8859-8',
);
$probe2 -> pack (qw(-side left ));
# -----
my $probe3 = $color_frame -> Text;
$probe3 -> configure (
-height => '5',
-width => '15',
-state => 'disabled',
-font => '-misc-fixed-medium-r-normal--13-100-100-100-c-80-iso8859-8',
);
$probe3 -> pack (qw(-side left ));
# -----
my $probe4 = $color_frame -> Text;
$probe4 -> configure (
-height => '5',
-width => '15',
-state => 'disabled',
-font => '-misc-fixed-medium-r-normal--13-100-100-100-c-80-iso8859-8',
);
$probe4 -> pack (qw(-side left ));
# -----
my $probe5 = $color_frame -> Text;
$probe5 -> configure (
-height => '5',
-width => '15',
-state => 'disabled',
-font => '-misc-fixed-medium-r-normal--13-100-100-100-c-80-iso8859-8',
);
$probe5 -> pack (qw(-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 = $top -> 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 => 'x', -fill=>'x');
foreach $p ('probe1', 'probe2', 'probe3', 'probe4', 'probe5') {
$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]; }
File translated from TEX by TTH, version 2.60.
On 26 Jun 2001, 10:25.