#!/usr/bin/perl
use strict;
use warnings;
use Tk;
use Tk::Pane;
use Tk::DialogBox;
use utf8;

my %max = (width =>  1000, height => 500);

my $mw = MainWindow ->  new();
$mw ->  withdraw;

my @fo = sort ($mw-> fontFamilies);
my $pane = $mw-> Scrolled( 'Pane',
   -height =>  $max{'height'},
   -scrollbars	=>  'ose')->pack;

my ($row, $col) = (0, 0);
my @width = (0,0,0,0);
foreach (@fo){
   my $var = $_;
   my $label = $pane-> Label(
      -font =>  '{Times New Romany}',
      -text =>  "$_",)->grid(
      -row =>  $row, -column => $col++, -sticky => 'nsew');
   my $button = $pane ->  Button(
      -font =>  "{$_}",
      -text =>  "$_ (АБВГДЕЁЖЗ...)",
      -command =>  sub {
	 change("$var")
      },) ->  grid ( -row => $row, -column => $col++, -sticky =>
'nsew',);
   if($col == 2) {
      $width[0] = $label-> reqwidth if($label->reqwidth > $width[0]);
      $width[1] = $button-> reqwidth if($button->reqwidth > $width[1]);
   } elsif ($col == 4) {
      $width[2] = $label-> reqwidth if($label->reqwidth > $width[2]);
      $width[3] = $button-> reqwidth if($button->reqwidth > $width[3]);
      $col = 0;
      $row++
   }
}
$pane-> configure(
   -width =>  (&sum(@width) <= $max{'width'} ? &sum(@width) :
$max{'width'}));
$pane-> update;

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

MainLoop;

sub change {
   my $sample = $mw ->  DialogBox (
      -title =>  'Sample Text',
      -buttons =>  ['OK'],);

   $sample ->  add ('Label',
      -text =>  "This is a sample of text in the \"$_[0]\" font.\n".
      "Съешь еще этих вкусных французских булок!\n".
      "abcdefghijklmnopqrstuvwxyz1234567890\n".
      "ABCDEFGHIJKLMNOPQRSTUVWXYZ!\"\?\$\%\^\&\*\(\)",
      -font => "{$_[0]}",) -> pack();
   $sample ->  Show();
}

sub sum {
   my @values = @_;
   my $sum = 0;
   foreach my $value (@values) { $sum += $value; }
   return $sum;
}