#!/usr/bin/perl
use strict;
use warnings;
use Tk;
use Tk::BrowseEntry;

my $fontname = 'Times';
my $fontsize = 200;

my $top = MainWindow->new;
my $cframe = $top->Frame->pack(-anchor => 'w');
my $label = $top->Label(
    -text => 'This is a label',
    -font => "{$fontname} $fontsize",
)->pack;

my $sizelabel = $cframe->Label(
    -text => $fontsize
)->grid(-row => 1, -column => 3, -padx => 2);

my $fontlist = $cframe->BrowseEntry(
    -label     => 'Font',
    -browsecmd => sub{ fontconfig($label, $fontname, $fontsize) },
    -variable  => \$fontname,
)->grid(-row => 1, -column => 1, -padx => 8);

$fontlist->insert ('end', sort $top->fontFamilies);

my $smaller = $cframe->Button(
    -text    => 'Smaller',
    -command => sub{
	                    $fontsize--;
                        fontconfig($label, $fontname, $fontsize);
                        $sizelabel->configure(-text => $fontsize);
                    },
)->grid(-row => 1, -column => 2, -padx => 2);

my $bigger = $cframe->Button(
    -text    => 'Bigger',
    -command => sub{
						$fontsize++;
						fontconfig($label, $fontname, $fontsize);
						$sizelabel->configure(-text => $fontsize);
					},
)->grid(-row => 1, -column => 4, -padx => 2);

$top->bind('<Up>' => sub{$bigger->invoke});
$top->bind('<Down>' => sub{$smaller->invoke});
$top->focus;

MainLoop;

sub fontconfig{
    my ($widget, $fontname, $fontsize) = @_;
    $widget->configure(-font => "{$fontname} $fontsize");
}

__END__