It sounds pretty daunting to get it from a string of family and size and compare them to the string you get back from a widget about a font.
One thing I have discovered recently about Tk fonts, is for the most part, you can forget passing the whole font-family string, Tk will happily just take the size. For instance, look at this extremely simple example.
and in case you havn't seen it yet, here is a font viewer for Tk, you probably can decipher all it's complexities, but the above method is probably simpler for controlling font size of a widget.
#!/usr/bin/perl -w
# copied from www.perltk.org/ex/showfonts.pl
# and modified to run as intended.
#--------------------------------------------
# showfonts - show X fonts
#--------------------------------------------
@helpText = (
"",
"This Perl/Tk script permits you to look at X fonts.",
"You can select fonts out of the listbox.",
"",
"Of the buttons at the bottom of the window:",
" Show/Hide Extended - toggles between 7-bit and 8-bit characters",
" Show Full Names/Aliases - toggles between full font names and aliase
+s",
" Filter - brings up a filter dialog for the font names",
""
);
#--------------------------------------------
# Included Library Modules
#--------------------------------------------
use Tk;
#--------------------------------------------
# Global data
#--------------------------------------------
$messageText = "Double-click on a font to look at it.";
$fullFontText = "-foundry-family-weight-slant-width--pixels-points-hre
+s-vres-spacing-average-set";
@normalText =
(
"\040\041\042\043\044\045\046\047\050\051\052\053\054\055\056\057" .
"\060\061\062\063\064\065\066\067\070\071\072\073\074\075\076\077",
"\100\101\102\103\104\105\106\107\110\111\112\113\114\115\116\117" .
"\120\121\122\123\124\125\126\127\130\131\132\133\134\135\136\137",
"\140\141\142\143\144\145\146\147\150\151\152\153\154\155\156\157" .
"\160\161\162\163\164\165\166\167\170\171\172\173\174\175\176",
);
@extendedText =
(
"\200\201\202\203\204\205\206\207\210\211\212\213\214\215\216\217" .
"\220\221\222\223\224\225\226\227\230\231\232\233\234\235\236\237",
"\240\241\242\243\244\245\246\247\250\251\252\253\254\255\256\257" .
"\260\261\262\263\264\265\266\267\270\271\272\273\274\275\276\277",
"\300\301\302\303\304\305\306\307\310\311\312\313\314\315\316\317" .
"\320\321\322\323\324\325\326\327\330\331\332\333\334\335\336\337",
"\340\341\342\343\344\345\346\347\350\351\352\353\354\355\356\357" .
"\360\361\362\363\364\365\366\367\370\371\372\373\374\375\376\377",
);
@sampleText = ( @normalText );
$extended = 0; $extendedButtonText = "Show Extended";
$fullNames = 0; $fullNameButtonText = "Show Full Names";
@wildCards = ( '*', '*', '*', '*', '*', '', '*', '*', '*', '*', '*', '
+*', '*' );
@fontElement = @wildCards;
$filterButtonLabel = "Filter...";
$filter = "";
$applyButtonLabel = 'Apply';
$clearButtonLabel = 'Clear';
$dismissButtonLabel = 'Dismiss';
#--------------------------------------------
# Main
#--------------------------------------------
# If any arguments were given, assume that they're asking for help.
if ($ARGV[0]) {
foreach $line (@helpText) {
print "$line\n";
}
}
# Get the entire list of fonts, removing the carriage return from each
+ name.
$a = "xlsfonts|";
#open FONTS, "xlsfonts|" || die "Couldn't read fonts\n";
open FONTS, $a || die "Couldn't read fonts\n";
@totalFonts = <FONTS>;
close FONTS;
#@totalFonts = grep( chop, );
#get line count
my $count = "0";
open FONTS, $a;
while ( $totalFonts = <FONTS> ) {
$count++;
}
close (FONTS);
my $b = "0";
for ( $b = "0"; $b < $count; $b++) { chop $totalFonts[$b] };
# Start with the subset of aliased fonts (those without an initial '-'
+).
@allFonts = grep( !/^\-/, @totalFonts );
@fonts = @allFonts;
# Pick the first font to start with.
$currentFont = $fonts[0];
# Initialize Tk
$top = MainWindow->new();
# Stick a message at the top.
$message = $top->Label( -text => $messageText, -relief => "raised", -b
+d => 2 );
$message->pack( -fill => 'x' );
# Place the list of fonts next.
$listFrame = $top->Frame( -relief => "flat" );
$listFrame->pack( -fill => 'both', -expand => 'yes' );
$fontListbox = &makeList( $listFrame, fontSelected, 'left', @fonts );
# Put some sample text at the bottom.
$sampleFrame = $top->Frame( -relief => "ridge", -bd => 2 );
$sampleFrame->pack( -side => 'bottom', -fill => 'x' );
&displayText( 0, scalar(@sampleText) );
# Put some option buttons above it
$optionFrame = $top->Frame;
$optionFrame->pack( -side => 'bottom', -fill => 'x' );
&makeButton( $optionFrame, \$extendedButtonText, toggleExtended );
&makeButton( $optionFrame, \$fullNameButtonText, toggleFullNames );
$filterButton = makeButton( $optionFrame, \$filterButtonLabel, filterD
+ialog );
# Placing the above stuff in this order means that the optional explan
+ation
# for the full names will appear between the listbox and the option bu
+ttons.
# Fall into the event loop.
MainLoop();
#--------------------------------------------
# Functions
#--------------------------------------------
sub fontSelected
{
$currentFont = $_[0];
&working;
for ( $i=0; $i < "3"; $i++ )
{
$sample[$i]->configure( -font => $currentFont );
}
&doneWorking;
}
sub toggleExtended
{
if ( $extended )
{
&destroyText( scalar(@normalText), scalar(@sampleText) );
@sampleText = ( @normalText );
$extendedButtonText = "Show Extended";
$extended = 0;
}
else
{
@sampleText = ( @normalText, @extendedText );
$extendedButtonText = "Hide Extended";
$extended = 1;
&displayText( scalar(@normalText), scalar(@sampleText) );
}
}
sub toggleFullNames
{
if ( $fullNames )
{
$fullText->destroy;
@allFonts = grep( !/^\-/, @totalFonts );
$fullNameButtonText = "Show Full Names";
$fullNames = 0;
}
else
{
$fullText = $top->Label( -text => $fullFontText, -relief => "ridge", -
+bd => 2 );
$fullText->pack( -fill => 'x' );
@allFonts = grep( /^\-/, @totalFonts );
$fullNameButtonText = "Show Aliases";
$fullNames = 1;
}
$filter = "";
&filterFonts;
}
sub destroyText
{
my ( $start, $end ) = @_;
for $i ( $start .. $end )
{
$sample[$i]->destroy if ( $sample[$i] );
}
}
sub displayText
{
my ( $start, $end ) = @_;
for $i ( $start .. $end )
{
$sample[$i] = $sampleFrame->Label( -text => $sampleText[$i],
-font => $currentFont );
$sample[$i]->pack( -anchor => 'w' );
}
}
#--------------------------------------------
# Called when the Filter... button is pressed
#--------------------------------------------
sub filterDialog
{
if ( $fullNames ) { &makeFullFilterDialog(); }
else { &makeFilterDialog( $filterButton, \$filter,
filterFonts ); }
}
sub filterFonts
{
# If a search pattern was given, use it to narrow down the list of fon
+ts.
if ( $filter ) { @fonts = grep( /$filter/, @allFonts ); }
else { @fonts = @allFonts; }
# Pick the first font to start with.
$currentFont = $fonts[0];
# Delete the current contents of the listbox and replace it with the n
+ew list.
if ( $fontListbox )
{
$fontListbox->delete( 0, 'end' );
$fontListbox->insert( 'end', @fonts );
}
}
sub makeFullFilterDialog
{
my ( $frame, $message );
my $clearButtonLabel = 'Clear';
my $dismissButtonLabel = 'Dismiss';
# Disable the filter button while the filter dialog is up.
$filterButton->configure( -state => 'disabled' );
# Create the dialog box
$filterDialog = $filterButton->Toplevel( -class => 'Full Name Filter'
+);
$filterDialog->geometry( &getBottomEdge( $filterButton, 1 ) );
# Put the current filter at the top.
$frame = $filterDialog->Frame( -relief => 'sunken', -bd => 3 );
$frame->pack( -fill => 'x' );
for $i ( 0 .. 12 )
{
$frame->Label( -text => '-' )->pack( -side => 'left', -anchor => 'n' )
+;
&addButton( $frame, $i ) if ( $wildCards[$i] );
}
# Put some action buttons in the space at the bottom.
$frame = $filterDialog->Frame( -relief => 'groove', -bd => 5 );
makeButton( $filterDialog, \$clearButtonLabel, clearFonts );
makeButton( $filterDialog, \$dismissButtonLabel, sub {
destroy $filterDialog; $filterButton->configure( -state => 'normal' );
+ });
$filterDialog->wm( 'protocol', 'WM_DELETE_WINDOW', sub {
destroy $filterDialog; $filterButton->configure( -state => 'normal' );
+ });
}
sub addButton
{
my ( $parent, $index ) = @_;
my ( $button, $frame, $label );
my @labels = split( '-', $fullFontText );
$frame = $parent->Frame; $frame->pack( -side => 'left' );
$label = $frame->Label( -text => $labels[$index+1] ); $label->pack;
$button = $frame->Button( -textvariable => \$fontElement[$index],
-command => sub { selectFontElement($index) } );
$button->bind( '' => sub { selectFontElement($index) } );
$button->pack;
$button;
}
sub selectFontElement
{
$elementIndex = $_[0];
my ( @selections ) = ( '*' );
my ( $font );
$fontElement[$elementIndex] = '*';
&adjustFonts;
# Find each unique element in the current font list.
foreach $font ( @fonts )
{
my @elements = split( '-', $font );
my $element = $elements[$elementIndex+1];
if ( $elementIndex == 12 && $elements[$elementIndex+2] ) {
$element .= '-' . $elements[$elementIndex+2];
}
push( @selections, $element ) if ( !grep( /^$element$/, @selections ))
+;
}
@selections = sort( @selections );
# Create the dialog box
my @elements = split( '-', $fullFontText );
my $element = $elements[$elementIndex+1];
$selectDialog = $top->Toplevel( -class => $element );
$selectDialog->geometry( &getBottomEdge( $filterDialog ) );
my $frame = $selectDialog->Frame;
$frame->pack( -fill => 'both', -expand => 'yes' );
$frame->grab;
&makeList( $frame, elementSelected, 'right', @selections );
}
sub elementSelected
{
$fontElement[$elementIndex] = $_[0];
$selectDialog->destroy;
&adjustFonts;
}
sub clearFonts
{
my ( $i );
for $i ( 0 .. 12 ) {
$fontElement[$i] = $wildCards[$i];
}
&adjustFonts
}
sub adjustFonts
{
&working;
$filter = "";
for $element ( @fontElement )
{
$filter .= '\-';
if ( $element eq '*' ) { $filter .= '.*'; }
else { $filter .= $element; }
}
&filterFonts;
&doneWorking;
}
sub getBottomEdge
{
my ( $w, $goUp ) = @_;
my $geom;
while ( $goUp && $w->winfo( 'parent' ) ) {
$w = $w->winfo( 'parent' );
}
$geom = $w->winfo( 'geometry' );
# Split it into its component parts.
my ( $xCoord, $yCoord, $xSize, $ySize ) = parseGeometry( $geom );
my $x = $xCoord;
my $y = $yCoord + $ySize;
# Assemble x and y into a geometry statement (coordinates only, no siz
+e).
$geom = "+$x+$y";
}
sub working
{
$top->configure( -cursor => 'watch' );
$top->update;
if ( $filterDialog )
{
$filterDialog->configure( -cursor => 'watch' );
$filterDialog->update;
}
}
sub doneWorking
{
$top->configure( -cursor => 'left_ptr' );
if ( $filterDialog )
{
$filterDialog->configure( -cursor => 'left_ptr' );
}
}
#--------------------------------------------
# makeList - Create a listbox and associated scrollbar.
#--------------------------------------------
sub makeList
{
my ( $parent, $command, $side, @list ) = @_;
my ( $listbox, $scrollbar );
# Stick a scroll bar on the requested side.
$scrollbar = $parent->Scrollbar();
$scrollbar->pack( -side => $side, -fill => 'y' );
# Create a listbox and tie it to the scrollbar.
# (If the you move the listbox with button2, the scrollbar will also m
+ove.)
$listbox = $parent->Listbox( -setgrid => 'yes',
-yscrollcommand => [ 'set', $scrollbar ] );
$listbox->insert( 'end', @list );
$listbox->pack( -fill => 'both', -expand => 'yes' );
# Change the cursor when button2/3 is depressed to remind people that
# they can move the listbox.
$listbox->bind( '<Button-2>' => sub {
$listbox->configure( -cursor => 'spider' )});
$listbox->bind( '<Button-3>' => sub {
$listbox->configure( -cursor => 'star' )});
# Tie the scrollbar to the listbox
# (If you move the scrollbar, the listbox will also move.)
$scrollbar->configure( -command => [ 'yview', $listbox ] );
# If an element is selected with either the mouse or the keyboard,
# do what needs to be done.
$listbox->bind( '<Return>' => sub {
my $selection = $listbox->get('active');
&$command( $selection );
} );
$listbox->bind( '<Double-Button-1>' => sub {
my $selection = $listbox->get('active');
&$command( $selection );
} );
# Shift input focus to the listbox's components when the mouse touches
+ them.
$listbox->bind( '<1>' => sub { $listbox->focus } );
$scrollbar->bind( '<1>' => sub { $scrollbar->focus } );
$listbox;
}
#--------------------------------------------
# Called when the Filter... button is pressed
#--------------------------------------------
sub makeFilterDialog
{
my ( $frame, $button, $apply, $label );
$fButton = shift;
$filterP = shift;
my $command = shift;
# Disable the filter button while the filter dialog is up.
$fButton->configure( -state => 'disabled' );
# Find the right edge of the parent window.
$geom = getRightEdge( $fButton );
# Create the dialog box
$dialog = $fButton->Toplevel( -class => 'Filter' );
$dialog->geometry( $geom );
$dialog->wm( 'protocol', 'WM_DELETE_WINDOW', sub{ &destroyDialog; } );
# Put the filter text widget at the top.
$frame = $dialog->Frame(); $frame->pack( -fill => 'x');
$label = $frame->Label( -text => "Filter:", -relief => 'flat' );
$label->pack( -side => 'left' );
$filterText = $frame->Entry( -width => 10, -relief => 'sunken', -bd =>
+ 2 );
$filterText->insert( 'end', $$filterP );
$filterText->pack( -side => 'left', -fill => 'x', -expand => 'yes' );
$filterText->bind( '' => sub { $apply->flash;
$$filterP = $filterText->get;
&$command } );
$filterText->focus;
# Put some action buttons in the space at the bottom.
$frame = $dialog->Frame( -relief => 'groove', -bd => 5 );
$frame->pack( -side => 'left', -padx => '1m', -pady => '1m', -expand =
+> 'yes' );
$apply = makeButton( $frame, \$applyButtonLabel,
sub { $$filterP = $filterText->get; &$command } );
makeButton( $dialog, \$clearButtonLabel,
sub { $$filterP = ""; $filterText->delete( 0, 'end' );} );
makeButton( $dialog, \$dismissButtonLabel, destroyDialog );
}
#--------------------------------------------
# Destroy the dialog window and re-enable the filter button.
#--------------------------------------------
sub destroyDialog
{
destroy $dialog;
$fButton->configure( -state => 'normal' );
}
sub getRightEdge
{
my ( $w ) = @_;
my $geom;
# Get the geometry of the eldest parent.
while ( $w )
{
$geom = $w->winfo( 'geometry' );
$w = $w->winfo( 'parent' );
}
# Split it into its component parts.
my ( $xCoord, $yCoord, $xSize, $ySize ) = parseGeometry( $geom );
# Add the x size and coordinate to get the right edge.
my $x = $xCoord + $xSize;
# Find the midpoint of that edge for the y coordinate.
my $y = $yCoord + int($ySize/2);
# Assemble x and y into a geometry statement (coordinates only, no siz
+e).
$geom = "+$x+$y";
}
sub parseGeometry
{
my ( $geom ) = @_;
my ( $size, $xCoord, $yCoord, $xSize, $ySize );
# Split the geometry string into its component parts.
#my ( $size, $xCoord, $yCoord ) = split '\+', $geom ;
#my ( $xSize, $ySize ) = split 'x', $size;
( $size, $xCoord, $yCoord ) = split '\+', $geom ;
( $xSize, $ySize ) = split 'x', $size;
# Return the components.
return ( $xCoord, $yCoord, $xSize, $ySize );
}
sub makeButton
{
my ( $parent, $text, $command ) = @_;
my ( $button );
$button = $parent->Button( -textvariable => $text, -command => sub { &
+$command } );
$button->bind( '' => sub { &$command } );
$button->pack( -side => 'left', -padx => '1m', -pady => '1m', -expand
+=> 'yes' );
$button;
}
