Font Manipulation Methods (Mastering Perl/Tk)

3.5. Font Manipulation Methods

Once you've created a font using fontCreate, you can use the following methods.

$mw->fontCreate('bigfont', -family => 'Arial', -size => 48);

%big = $mw->fontActual('bigfont');
print %big;
# prints:
-size 48 -overstrike 0 -underline 0 
-weight normal -slant roman -family Arial

$size = $mw->fontActual('bigfont', -size);
print $size;
#prints: 
48

if ($mw->fontConfigure('bigfont', -size) < 24) {
  $mw->fontConfigure('bigfont', -size => 48);
}

# same as $mw->fontActual('bigfont');
%bigfont = $mw->fontConfigure('bigfont');

$mw->fontDelete('bigfont');

If you delete a font that is being used, the widgets using it won't change what they display. They display whatever font they were last. If you try to manipulate the font programmatically after it's been deleted, you will get an error.

@families = $mw->fontFamilies;

@definedfonts = $mw->fontNames;

The fontNames method returns a list of object references to Font objects. The list will be empty if there aren't any fonts defined on your system. Keep in mind this list contains only those fonts defined using the fontCreate method.

print $mw->fontMeasure('bigfont', "SHORT"), "\n";
225
print $mw->fontMeasure('bigfont', "MUCH LONGER"), "\n";
480

$ascent = $mw->fontMetrics('bigfont', -ascent);
%metrics = $mw->fontMetrics('bigfont');
print %metrics;

-linespace 72 -descent 14 -ascent 58 -fixed 0

3.5.1. One Last Example

Just for fun we'll look at one last example. This program will display a banner in the selected font that continually rotates the text within it (see Figures Figure 3-4 and Figure 3-5).

Figure 3-4. Banner program showing the font configuration widgets

Figure 3-5. Banner program without font configuration widgets

Here's the code for the banner program:

use Tk;
use strict;

# initial banner text. Entry is not read-only
my $str = "AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz0123456789";

my $mw = MainWindow->new;
my $lframe = $mw->Frame->pack(-fill => 'both', 
  -side => 'left', -expand => 1);
my $lb = $lframe->Scrolled("Listbox", -scrollbars => "e", 
  -height => 3)->pack(-fill => 'both', -expand => 1, -side => 'top');

$lb->insert('end', sort $mw->fontFamilies);

# Button that will pop the config widgets in and out
my $hidebutton = $mw->Button(-text => ">")->pack(-side => 'left', 
  -fill => 'y');
$hidebutton->configure(-command => 
  sub { 
		if ($hidebutton->cget(-text) eq ">") {
		  $lframe->packForget; $hidebutton->configure(-text => "<")
		} else {
		  $lframe->pack(-before => $hidebutton, -fill => 'both',
        -side => 'left', -expand => 1); 
		  $hidebutton->configure(-text => ">");
		}
  }, -font => "courier 8");

my $entry = $mw->Entry(
		-textvariable => \$str,
		-width => 12, 
		-font => "{Comic Sans MS} 72",
		-relief => 'raised',
		-highlightthickness => 0,
		)->pack(-expand => 1, -fill => 'x', -side => 'left');
		
$lb->bind("<Button>", sub { $entry->configure(
   -font => "{". $lb->get($lb->curselection) . "} 72"); });

my $repeat_id = $mw->repeat(300, \&shift_banner);

my $f = $lframe->Frame->pack(-side => 'bottom', -fill => 'y');
my $start_button;
$start_button = $f->Button(-text => "Start", 
  -command => sub { 
    $repeat_id = $mw->repeat(300,\&shift_banner);
    $start_button->configure(-state => 'disabled'); }, 
  -state => 'disabled')->pack(-side => 'left', -padx => 3);
my $stop_button = $f->Button(-text => "Stop", -command => sub {
    $repeat_id->cancel( ); 
    $start_button->configure(-state => 'normal'); }
  )->pack(-side => 'left', -padx => 3);

MainLoop;

# Causes text to be wrapped around in entry
sub shift_banner {
		my $newstr = substr($str, 1) . substr($str, 0, 1);
		$str = $newstr;
}