1#!/usr/local/bin/perl -w 2use strict; 3use Tk; 4use Tk::Font; 5use Tk::widgets qw(BrowseEntry Text Spinbox); 6my %fopt = (-family => 'fixed', -weight => 'medium', 7 -slant => 'roman', -size => 12); 8my $mw = MainWindow->new(); 9my $font = $mw->Font(%fopt); 10my $family = $mw->BrowseEntry(-variable => \$fopt{-family}, 11 -options => [sort $mw->fontFamilies()], 12 -command => [\&SetFont,$font,\%fopt]); 13my $size = $mw->Spinbox(-width => 3, -textvariable => \$fopt{-size}, 14 -from => 6, -to => 72, 15 -command => [\&SetFont,$font,\%fopt]); 16my $weight = $mw->Optionmenu(-width => 3, -variable => \$fopt{-weight}, 17 -options => [qw(medium bold)], 18 -command => [\&SetFont,$font,\%fopt]); 19 20Tk::grid($mw->Label(-text => 'Family:',-justify => 'right'), $family, 21 $mw->Label(-text => 'Size:',-justify => 'right'), $size, 22 $mw->Label(-text => 'Weight:',-justify => 'right'), $weight, 23 -sticky => 'ew', 24 ); 25 26my $text = $mw->Scrolled(Text => -font => $font, -width => 40, -height => 20)->grid(-sticky => 'nsew', -columnspan => 6); 27 28my $l = ''; 29for my $ch (0x20..0x7E,0xa0..0xff) 30 { 31 $l .= chr($ch); 32 if (length($l) == 16) 33 { 34 $text->insert(end => "$l\n"); 35 $l = ''; 36 } 37 } 38 39#$text->insert('end',<<"END"); 40#Example Text - list 41#\x{20ac}40 Only. 42#END 43 44MainLoop; 45 46sub SetFont 47{ 48 my ($font,$fopt) = @_; 49 my @opt = %$fopt; 50 print "@opt\n"; 51 $font->configure(%$fopt); 52 @opt = $font->actual; 53 print "$$font @opt\n"; 54} 55 56