Using Fonts Dynamically (Mastering Perl/Tk)

3.4. Using Fonts Dynamically

Let's look at a program that creates fonts dynamically. This code will display each selected font in a window much the way Microsoft Windows does when you look at the Font control panel. To display the font in its different sizes, we simply use the ROText widget so the text is read-only (see Chapter 8, "The Text, TextUndo,and ROText Widgets" for further information on ROText widgets). The font changes are applied in the show_font sub using tags.

use Tk;
require Tk::TList;
require Tk::ROText;
use strict;

my $mw = MainWindow->new(-title => "Fonts");
$mw->minsize(700,400);
my $tl = $mw->Scrolled("TList", -font => ['Arial', '12'], -command => \&show_font)->
pack(-fill => 'both', -expand => 1);

# using a tlist, we have to insert each item individually
foreach (sort $mw->fontFamilies)
{
		$tl->insert('end', -itemtype => 'text', -text => $_);
}

MainLoop;

# called when user double clicks on a font name in the tlist.
sub show_font
{
		my ($index) = @_;
		my $name = $tl->entrycget($index, -text);
		my $top = $mw->Toplevel(-title => $name);
		my $text = $top->Scrolled("ROText", -wrap => 'none')
      ->pack(-expand => 1, -fill => 'both');
		
		$text->tagConfigure('number', -font => ['courier', '12']);

    # since we don't know what font they picked, we dynamically
    # create a tag w/that font formatting
		$text->tagConfigure('abc', -font => [$name, '18']);
		$text->insert('end', "abcdefghijklmnopqrstuvwxyz\
nABCDEFGHIJKLMNOPQRSTUVWXYZ\n1234567890.;,;(*!?')\n\n", 'abc');
		
		foreach (qw/12 18 24 36 48 60 72/)
		{
			$text->tagConfigure("$name$_", -font => [$name, $_]);
			$text->insert('end', "$_ ", 'number');
 			$text->insert('end', 
 "The quick brown fox jumps over the lazy dog. 1234567890\n", "$name$_");
		}
}

Figure 3-2 and Figure 3-3 show the resulting windows.

Figure 3-2. MainWindow in our control panel-like Font viewer

Figure 3-3. An individual font (Courier) viewed in a Toplevel widget