Date: Sat, 15 Nov 1997 23:47:38 -0600 (CST) From: Bruce Albrecht <bruce@zuhause.mn.org> To: "John S. Dyson" <toor@dyson.iquest.net> Cc: chat@FreeBSD.ORG Subject: Re: fonts.scale Message-ID: <199711160547.XAA12979@zuhause.mn.org> In-Reply-To: <199711140536.AAA11206@dyson.iquest.net> References: <199711140536.AAA11206@dyson.iquest.net>
next in thread | previous in thread | raw e-mail | index | archive | help
[-- Attachment #1 --]
I have a bunch of Adobe and Bitstream fonts, and I figured it was too
tedious to generate a fonts.scale for approximately 1000 fonts by
hand, so I wrote the following perl5 script to do it for me. My script
assumes that all the files in a directory are from the same foundry
because I group them by foundry, so if you lump all your favorite type
1 fonts together regardless of where it came from, too bad.
The Corel Mega Gallery is good source of Type 1 fonts, with ~850
fonts from Bitstream, many licensed from ITC, etc., for around $65.
[-- Attachment #2 --]
#!/usr/local/bin/perl
# Bruce Albrecht
# bruce@zuhause.mn.org
# Scan a directory for Type1 fonts and generate a font.scale file
# suitable for X11.
# Specify the foundry (e.g., adobe, bitstream, etc).
# Specify "raw" if "normal" and "regular" weights are not translated
# to "medium".
die "Usage: $0 Foundry [raw]\n" unless @ARGV == 1 || @ARGV == 2;
opendir(DIR, ".");
for $file (readdir(DIR))
{
open(FILE, $file);
$family = $fullname = $weight = $slant = $sWdth =
$adstyl = $spacing = $encoding = "";
read(FILE, $_, -s $file);
next unless /%!PS-AdobeFont/;
tr/[A-Z]/[a-z]/;
$family = $1 if m-/familyname\s+\(([^)]+)-;
$weight = $1 if m-/weight\s+\(([^)]+)-;
$slant = $1 if m-/italicangle\s+(\S+)\s+def-;
$spacing = ($1 =~ /true/i ? "m" : "p") if m-/isfixedpitch\s+(\S+)\s+def-;
$fullname = $1 if m-/fullname\s+\(([^)]+)-;
$encoding = $1 if m-/encoding\s+(\S+)\s+def-;
$weight =~ s/extra /extra/;
$slant = ($slant ? ($fullname =~ /obli/i ? "o" : "i") : "r");
$encoding = ($encoding =~ /standardencoding/ ? "iso8859-1" :
"adobe-fontspecific");
$family =~ s/-/ /g;
$sWdth = "normal";
$sWdth = $1 if $fullname =~ /\b(condensed|extended|compact|compressed|narrow)\b/;
# Fix condensed weight
if ( $weight eq "condensed" )
{
$weight="regular";
$Swdth="condensed";
}
# Ignore expert or oldstyle fonts
next if $fullname =~ /\b(expert|oldstyle)\b/;
$characteristics=join("-", $family, $weight, $slant, $sWdth,$adstyl,
0,0,0,0,$spacing,0,$encoding);
# Ignore font whose characteristics appear to be the same as another.
# The font is not the same, but this simple scan can't tell the difference.
if ( $font{$characteristics} )
{
print STDERR "$file ($fullname) appears to duplicate $font{$characteristics}, ignored.\n";
next;
}
$font{$characteristics}=$file;
push(@list, join("-", "$file ", $ARGV[0], $characteristics));
}
# A lot of Type 1 fonts have "normal" or "regular" weight specified by
# the foundry, but most X fonts use "medium" for the weight. Also,
# the Type 1 fonts that come with X11R6 have a fonts.scale with medium
# weight, even though the font itself specifies normal or regular.
# Translate normal or regular weights to medium unless directed not
# to.
if ( $ARGV[1] ne "raw" )
{
for ( @list )
{
@xchar=split(/-/);
next if $xchar[3] ne "normal" && $xchar[3] ne "regular";
$_=join("-", @xchar[0..2], "medium", @xchar[4..14])
unless $font{join("-", @xchar[1..14])};
}
}
# here's the list:
print join("\n", scalar(@list), @list, "");
__END__
# perldoc should go here.
Want to link to this message? Use this URL: <https://mail-archive.FreeBSD.org/cgi/mid.cgi?199711160547.XAA12979>