#!/usr/local/bin/perl -w
use Tk;
use strict;

require Tk::BrowseEntry;

my $mw = MainWindow->new(-title => 'Font Viewer');

my $f = $mw->Frame->pack(-side => 'top');

my $family = 'Courier';

my $be = $f->BrowseEntry(
    -label     => "Family:", 
    -variable  => \$family, 
    -browsecmd => \&apply_font,
)->pack(-fill => 'x', -side => 'left');
$be->insert('end', sort $mw->fontFamilies);

my $size = 24;

my $bentry = $f->BrowseEntry(
    -label     => 'Size',
    -variable  => \$size, 
    -browsecmd => \&apply_font,
)->pack(-side => 'left');
$bentry->insert('end', (3 .. 32));

my $weight = "normal";
$f->Checkbutton(
    -onvalue  => "bold",
    -offvalue => "normal",
    -text     => "Weight",
    -variable => \$weight,
    -command  => \&apply_font,
)->pack(-side => 'left');

my $slant = "roman";
$f->Checkbutton(
    -onvalue => "italic",
    -offvalue => "roman", 
    -text => "Slant",
    -variable => \$slant, 
    -command => \&apply_font,
)->pack(-side => 'left');

my $underline = 0;
$f->Checkbutton(
    -text => "Underline",
    -variable => \$underline,
    -command => \&apply_font,
)->pack(-side => 'left');

my $overstrike = 0; 
$f->Checkbutton(
    -text => "Overstrike",
    -variable => \$overstrike, 
    -command => \&apply_font,
)->pack(-side => 'left');


my $stext = "www.java2s.com";
my $sample = $mw->Entry(-textvariable => \$stext)->pack(-fill => 'x');

&apply_font;

MainLoop;

sub apply_font {
    $sample->configure(-font => 
           [-family => $family,
      -size => $size,
      -weight => $weight,
      -slant => $slant,
      -underline => $underline,
      -overstrike => $overstrike
           ],
    );
}