#!/pro/bin/perl5.005

# X Font Util

use Tk;
use IO::Handle;

InitFU ();
SetList (@FontSel);

MainLoop;

### ###########################################################################

sub to_background
{
    my $pid = fork;
    if ($pid < 0) {
	print STDERR "Unable to run in the background, cannot fork: $!\n";
	exit $?;
	}
    $pid && exit 0;
    } # to_background

sub InitFU
{
    ($fndry, $fmly, $wght, $slant, $sWdth, $adstyl, $pxlsz, $ptSz,
     $resx, $resy, $spc, $avgWdth, $rgstry, $encdng) = ( 1 .. 14 );

    STDERR->autoflush (1);
    STDOUT->autoflush (1);

    print STDERR "Getting font list ...";
    foreach (`xlsfonts`) {
	chomp;
	next if exists $font{$_};
	my @font = split m/-/;
	$font{$_} = [ @font ];
	@font == 15 or next;
	foreach my $i ( 1 .. 14 ) {	# For the selection
	    $sel[$i]{$font[$i]}++;
	    }
	}
    print STDERR "\n";
    to_background ();

    @font = sort keys %font;
    $NumFonts = @font;

    $top = MainWindow->new (
	-cursor => "top_left_arrow",
	-name   => "XFontUtil");
    $top->title ("X Font Util");
    $top->bind ("<Key>q" => sub {$top->destroy});

    my $f = $top->Frame (
	-relief => "sunken")->pack (
	    -fill => "both",
	    -side => "left");
    $f->Button (
	-text    => "Quit",
	-width   => 4,
	-relief  => "raised",
	-command => sub { exit 0; })->pack (
	    -side => "bottom");
    $f->Button (
	-text    => "XFD",
	-width   => 4,
	-relief  => "raised",
	-command => sub { fork || exec "xfd -fn '$font' 2>/dev/null"; })->pack (
	    -side => "bottom");
    $defsize = 15;
    $f->Entry (
	-textvariable => \$defsize,
	-width        => 4,
	-relief       => "sunken")->pack (
	    -side => "bottom");

    my $f = $top->Frame (
	-relief => "flat")->pack (
	    -fill => "both",
	    -side => "top");
    $f->Label (
	-text       => "-fndry-fmly-wght-slant-sWdth-adstyl-pxlsz-ptSz".
		      "-resx-resy-spc-avgWdth-rgstry-encdng",
	-foreground => "Green4",
	-anchor     => "w",
	-relief     => "flat")->pack (
	    -fill => "both",
	    -side => "left");
    $f->Label (
	-textvariable => \$NumFonts,
	-foreground   => "Red4",
	-anchor       => "e",
	-relief       => "flat")->pack (
	    -side => "right",
	    -fill => "both");

    @FontSel = (undef) x 15;
    $FontSel[$resx]	= "75";
    $FontSel[$resy]	= "75";
    $FontSel[$rgstry]	= "iso8859";
    $FontSel[$encdng]	= "1";
    my $f = $top->Frame (
	-relief => "flat")->pack (
	    -fill => "both",
	    -side => "top");
    $SelFonts = sub {
	SetList (@FontSel);
	};

    foreach my $i ( 1 .. 14) {
	my $b = $f->BrowseEntry (
	    -width              => 5,
	    -borderwidth        => 0,
	    -highlightthickness => 0,
	    -listwidth          => 40,
	    -variable           => \$FontSel[$i],
	    -browsecmd          => $SelFonts)->pack (
		-anchor => "w",
		-side   => "left");
	$b->insert ("end", undef);
	foreach my $s (sort keys %{$sel[$i]}) {
	    $b->insert ("end", $s);
	    }
	}

    $example = $top->Canvas (
	-height => 60,
	-width  => 1000)->pack (
	    -side => "bottom",
	    -fill => "both");
    $example->createText (500, 30,
	-text    => "The quick brown fox jumps over the lazy dog 0123456789",
	-tags    => "example",
	-fill    => "Blue4",
	-anchor  => "center",
	-justify => "center");
    $font = $example->itemcget ("example", -font);
#   $example = $top->Label (
#	-text       => "The quick brown fox jumps over the lazy dog 0123456789",
#	-foreground => "Blue4",
#	-anchor     => "center",
#	-height     => 4,
#	-relief     => "sunken")->pack (
#	    -fill => "x",
#	    -side => "bottom");
#   $font = $example->cget (-font); 

    $top->Label (
	-textvariable => \$font,
	-relief       => "sunken")->pack (
	    -fill => "both",
	    -side => "bottom");
    $FontList = $top->Scrolled ("Listbox",
	-scrollbars         => "e",
	-highlightthickness => 0,
	-height             => 10)->pack (
	    -fill => "both",
	    -side => "bottom");
    $FontList->bind ("<1>" => sub {
	$font = $FontList->get ("active");
	my $dis_font = $font;
	if ($font{$font}->[$pxlsz] == 0) {
	    my @f = @{$font{$font}};
	    $f[$pxlsz] = $defsize;
	    $dis_font = join "-", @f;
	    }
	#$example->configure (-font => $dis_font);
	$example->itemconfigure ("example", -font => $dis_font);
	});
    } # InitFU

sub SetList
{
    my @filter = @_;

    $FontList->delete (0, "end");
    $NumFonts = 0;
    font: foreach my $font (@font) {
	my $fa = $font{$font};
	foreach my $fi ( 0 .. $#filter ) {
	    defined $filter[$fi] or  next;
	    $filter[$fi] eq ""   and next;
	    $fa->[$fi] eq $filter[$fi] or next font;
	    }
	$FontList->insert ("end", $font);
	$NumFonts++;
	}
    } # SetList