Skip site navigation (1)Skip section navigation (2)
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
--Multipart_Sat_Nov_15_23:47:38_1997-1
Content-Type: text/plain; charset=US-ASCII

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.


--Multipart_Sat_Nov_15_23:47:38_1997-1
Content-Type: application/octet-stream
Content-Disposition: attachment; filename="make_fonts.scale"
Content-Transfer-Encoding: 7bit

#!/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.

--Multipart_Sat_Nov_15_23:47:38_1997-1--



Want to link to this message? Use this URL: <https://mail-archive.FreeBSD.org/cgi/mid.cgi?199711160547.XAA12979>