use strict;
use warnings;
use Tk;
use Tk::DialogBox;
use Tk::LabEntry;

my $mw = MainWindow -> new(-title => "   Font Selecta!");
$mw -> withdraw;

my @fonts = sort ($mw->fontFamilies);
my $font_size = 12;
my ($row, $col) = (0, 0);

foreach (@fonts){
    my $font = $_;
    my $button = $mw -> Button(
                    -text => "$font",
                    -command => sub {example($font)},
                    ) -> grid (
                    -row => $row,
                    -column => $col++,
                    -sticky => 'nsew',
                    );
    if ($col == 5) {$col = 0; $row++}
}

my $size = $mw -> LabEntry (
                    -label => 'Font Size: ',
                    -textvariable => \$font_size,
                    -labelPack => [qw(-side left -anchor w)],
                    -background => "white",
                    -width => 3,
                    -justify => 'c',
                    ) -> grid (
                    -row => ++$row,
                    -column => 0,
                    );

my $exit = $mw -> Button (
                    -text => 'EXIT',
                    -command => sub {exit()},
                    -background => 'red',
                    -activebackground => 'red',
                    ) -> grid (
                    -row => $row,
                    -column => 2,
                    -sticky => 'nsew',
                    );
$mw -> Popup;

MainLoop;

sub example {
    error() unless ($font_size =~ /^\d\d?$/);
    error() if ($font_size > 60);
    my $font = $_[0];
    my $example = $mw -> DialogBox (
                    -title => "Sample Text in \"$font\" font, size $fo
+nt_size",
                    -buttons => ['OK'],
                    );
    $example -> add ('Label',
                    -text => "The quick brown fox jumps over the lazy 
+dog!\n".
                             "abcdefghijklmnopqrstuvwxyz1234567890-=\n
+".
                             "ABCDEFGHIJKLMNOPQRSTUVWXYZ\!\"\£\$\%\^\&
+\*\(\)_+",
                    -font => "{$font} $font_size",
                    ) -> pack();
    $example -> Show();
}

sub error {
    my $error = $mw -> messageBox (
                    -title => "Invalid font size",
                    -message => "Please enter a number from 0 to 60 fo
+r the font size",
                    -type => 'OK',
                    -icon => 'error',
                    );
    $font_size = 12;
}
[download]