use strict;
use warnings;
use Tk;
# Verkuerzt den Programmieraufwand:
use Tk::BrowseEntry;

my $mw = MainWindow->new(-title => 'Font-Betrachter');
my $frame = $mw->Frame->pack(-side => 'top');

# Auswahlmenue fuer die Schriftart
my $family = 'Helvetica';
my $be_f = $frame->BrowseEntry(-label   => 'Familie:',
                              -variable  => \$family,
                              -browsecmd => \&apply_font);
$be_f->insert('end', sort $mw->fontFamilies);
$be_f->pack(-fill => 'x', -side => 'left');

# Auswahlmenue fuer die Schriftgroesse
my $size = 14;
my $be_s = $frame->BrowseEntry(-label     => 'Größe:', 
                               -variable  => \$size,
                               -browsecmd => \&apply_font);
$be_s->insert('end', (6 .. 36));
$be_s->pack(-side => 'left');

# Auswahl fuer das Gewicht
my $weight = 'normal';
$frame->Checkbutton(-onvalue  => 'bold', 
                    -offvalue => 'normal',
                    -text     => 'Fett', 
                    -variable => \$weight,
                    -command  => \&apply_font)
        ->pack(-side => 'left');

# Auswahl fuer die Schriftneigung
my $slant = 'roman';
$frame->Checkbutton(-onvalue  => 'italic', 
                    -offvalue => 'roman',
                    -text     => 'Kursiv', 
                    -variable => \$slant,
                    -command  => \&apply_font)
        ->pack(-side => 'left');

# Auswahl fuer Unterstreichung
my $underline = 0;
$frame->Checkbutton(-text     => 'Unterstreichen', 
                    -variable => \$underline,
                    -command  => \&apply_font)
        ->pack(-side => 'left');

# Texteingabe
my $stext = 'Never trust a computer 0123456789';
my $be_t = $mw->Entry(-textvariable => \$stext);
$be_t->pack(-fill => 'x');

&apply_font;

MainLoop;

# Zusammenbauen des Fonts fuer das Eingabefeld
sub apply_font 
  {
  $be_t->configure(-font =>
        [-family => $family,
         -size => $size,
         -weight => $weight,
         -slant => $slant,
         -underline => $underline]);
  }