#!/usr/bin/perl -w
######################################################################
# font.pl
######################################################################
# Perl Power! - Michael Schilli 1998
######################################################################

use Tk;
use strict;

my $top = MainWindow->new();

my $frame = $top->Frame();
my $text  = $frame->Text(-wrap => 'none', 
                         -font => '*helvetica-bold-r-*12*');

my $labelvar = "";
my $label = $top->Label(-textvariable => \$labelvar);

my $yscrollbar = $frame->Scrollbar(-command => 
                                   [yview => $text]);
my $xscrollbar = $top->Scrollbar(-orient => 'horizontal', 
                                 -command => [xview => $text]);

$text->configure(-yscrollcommand => [set => $yscrollbar]);
$text->configure(-xscrollcommand => [set => $xscrollbar]);

### Alles packen
$yscrollbar->pack(-side => 'right', -fill => 'y');
$xscrollbar->pack(-side => 'bottom', -fill => 'x');
$label->pack(-expand => 'yes', -fill => 'x', 
             -side => 'bottom');

$frame->pack(-expand => 'yes', -fill => 'both');
$text->pack(-expand => 'yes', -fill => 'both', 
            -side => 'left');

open(FONTS, "xlsfonts |") || die "xlsfonts: not found";
my $i=1;
while(<FONTS>) {
    next unless /--12/;        # only fonts of size 12
    chop(my $font = $_);
    $text->insert("end", $_);  # insert text in text widget
                               # (including newline \n)

                               # define tag and
                               # set font there
    $text->tag("add", $i, "$i.0", sprintf("%d.0", $i+1));
    $text->tag("configure", $i, -font => $font);
    $text->update();
    $i++;
    $labelvar="Fonts: $i";
}
close(FONTS);

MainLoop;