Linuxdoc Linux Questions
Click here to ask our community of linux experts!
Custom Search

B. Appendix: fonts.dir to fonts.alias

Thanks to Aristotle Pagaltzis for providing this perl version of a script to convert a fonts.scale file to fonts.dir.


#!/usr/bin/perl -w

# This utility is a direct translation right down to the comments
# from mkfontalias.py written by Roman Sulzhyk to assist people
# in de-uglification of their true type fonts. It creates a
# fonts.alias file from the fonts.dir file found in the directory.

# It supports all of the Python script's features:
#
# - maps the following MS webfonts:
#       Verdana, Tahoma, Impact, Arial Black,
#       Comic Sans MS, Georgia, Trebuchet MS
#
# - cheats by mapping 6, 7 and 8pt to 9pt fonts
#

# (c)2002 Aristotle Pagaltzis, licensed under the GPL
# http://www.gnu.org/copyleft/gpl.html

use strict;

my $infile = "fonts.dir";
my $outfile = "fonts.alias";

my @res = (75, 75);

my %cheat_map = (6 => 9, 7 => 9, 8 => 9);

my @font_sizes = (6..16, 18, 24);

my %font_map = (
        "Arial" => "Arial",
        "Times New Roman" => "Times New Roman",
        "Verdana" => "Verdana",
        "Tahoma" => "Tahoma",
        "Impact" => "Impact",
        "Arial Black" => "Arial Black",
        "Comic Sans MS" => "Comic Sans MS",
        "Georgia" => "Georgia",
        "Trebuchet MS" => "Trebuchet MS",
        "Courier New" => "Courier New"
);

# Read in the fonts.
open(THEFILE, "<", $infile) or die "Cannot read $infile: $! - are you sure you are in the fonts directory?\n";
my @fontdir = splice @{[ <THEFILE> ]}, 1; # Strip the first line
close THEFILE;

# Now, create the output
my @aliases;
foreach (@fontdir) {
        # Get rid of the first entry, but mind that other may have 
        # spaces in them
        my $font = join(" ", splice @{[ split ]}, 1) or die "Cannot parse $infile line: $_\n";

        my @entries = split "-", $font;

        die "Invalid font: $font\n" unless @entries == 15;

        my $mapped_font = $font_map{$entries[2]} or next;
        
        # Create a bunch of aliases, for each size
        for my $size (@font_sizes) {
                # Do the "cheating" - fallback to size if not in the cheat map
                my $real_size = $cheat_map{$size} || $size;

                # Add the entry to the aliases
                push @aliases, join(
                        " ",
                        join("-", @entries[0..6], $real_size, $real_size * 10, @entries[9..14]),
                        join("-", @entries[0..1], $mapped_font, @entries[3..6], $size, $size * 10, @res, @entries[11..14])
                );
        }               
}

# Boast
print "Created ", scalar(@aliases), " aliases\n";

# Backup the existing file
if(-e $outfile) {
        my $bakfile = "$outfile.bak";
        my $errormsg = "Cannot backup $outfile to $bakfile:";
        die "$errormsg file exists\n" if -e $bakfile;
        rename $outfile, $bakfile or die "$errormsg $!\n" 
}

# Ok, write the file
open(THEFILE, ">", $outfile) or die "Cannot open $outfile for writing: $!\n";
print THEFILE map "$_\n", @aliases;
close THEFILE;

print "Wrote ", scalar(@aliases), " aliases to $outfile\n";