#!/usr/local/bin/perl -w# XXX Dumps core!!!use strict;use Tk;use Data::Dumper;use Tk::Font;my $mw = MainWindow->new;my $b = $mw->Button(-text => 'Quit', -command => [destroy => $mw])->pack;print 'Families : ',join(',',$b->fontFamilies),"\n";my $f = $b->cget('-font');my @info = $f->actual;print 'Actual : ',Dumper(\@info);$f = $mw->Font(@info);print Dumper($f);@info = $f->metrics;print 'Metrics : ',Dumper(\@info);print 'Ascent : ',$f->metrics('-ascent'),"\n";@info = $b->fontNames;print 'Names : ',Dumper(\@info);print 'Measure : ',join(',',$f->measure("Hugo")),"\n";my $name;my $size = $f->PostscriptFontName($name);print "$name @ $size\n";$b->configure('-font' => $f);print $f->Pattern,"\n";my @f = $f->configure;print 'FConfigure : ',Dumper(\@f);@f = $f->configure('-family');print 'FConfigure (arg) : ',Dumper(\@f);@f = $b->configure('-font');print 'Configure : ',Dumper($f,\@f);# MainLoop;