🚀 go-pugleaf

Haivng managed to have reliable performance from the font server (having
the X server deal with .pcf files, and the font server with outlines), I
have gotten a laod of Type1 fonts from freeware archives, and had the
problem to write fonts.scale entries for them. I started doing this
manually, but then I switched to writing a Perl script to do this; it is
appended (use is very simple; just "pfb2scale *.pf[ab] > fonts.scale").

The fonts.scale entires it generates are often correct; the problem is
that the font attributes in the Type1 files are quite inaccurate, and
there is little normalization of those attributes. I have added some
rules that try to normalize font names and entries, and they are based
on associative tables at the beginning of the source. You can tune them
to your heart's contents. I have still found that a bit of hand revision
is needed. It is also opportune to visually inspect the fonts; some of
the font names and description are wildly ridiculous (I could not make
much sense of a font to that claimed to be 'extrabold' and 'thin'). In
some cases I have made probably inappropriate choices; for example I
don't really know if I should put 'small caps' as a weight, a width, or
a style attribute.

It would very helpful if any typeface classification expert volunteers
to provide a list and description of common, normalized typeface
attributes for the weight, width, style, registry, encoding parts of an
XLFD spec.

Well, now for the script:


------------------------pfb2scale--------------------------------------
#!/usr/local/bin/perl

$debug = 0;

%weights	= (
  'thin',	'light',
  'light',	'light',
  'regular',	'medium',
  'black',	'medium',
  'normal',	'medium',
  'demi',	'demibold',
  'semibold',	'demibold',
  'heavy',	'bold',
  'extrabold',	'extrabold',
);

%slants		= (
  'roman',	'r',
  'italic',	'i',
  'oblique',	'o',
);

%varieties	= (
  'condensed',	'narrow',
  'smallcaps',	'small caps',
);

%serifs		= (
  'helvetica',	'sans',
  'avantgarde',	'sans',
  'futura',	'sans',
  'quadrata',	'sans',
);

ARG: for $pfx (@ARGV) {

  undef $family;
  undef $fullname;

  $weight	= 'medium';
  $slant	= 'r';
  $variety	= 'normal';
  $serif	= '';
  $pitch	= 'p';
  $encoding	= 'free-fontspecific';

  # Read the first block of the .pf? file;
  # whether ascii or binary it contains the
  # strings that define the font properties.

  {
    local($block);

    unless ($pfx != "-" || open (PFX,"<$pfx")) {
      warn "$file: $!\n";
      next ARG;
    }
    unless (sysread(PFX,$block,3000,8) > 0) {
      warn "$file: $!\n";
      close(PFX);
      next ARG;
    }
    close(PFX);

    # Split the block into lines, and examine each
    # one of them; whether ascii or binary this will
    # do the split.

    for $_ (split(/[\001-\037]/,$block)) {

      # Extract some fields

      if (/FamilyName/)	{ $family	= $1 if /\(([^)]*)\)/; }
      if (/FullName/)	{ $fullname	= $1 if /\(([^)]*)\)/; }
      if (/Weight/)	{ $weight	= $1 if /\(([^)]*)\)/; }

      # Set some flags base don the value of some fields

      $slant	= 'i' if /ItalicAngle\s+-?[1-9][0-9]*\s+def/;
      $pitch	= 'p' if /isFixedPitch\s+true\s+def/;
      $encoding	= 'iso8859-1' if /Encoding\s+StandardEncoding\s+def/;

    }
  }

  print STDERR "family is $family and fullname is $fullname\n"	if $debug;

  # Lowercase the fields we have just extracted

  $family	=~ tr/-_A-Z/  a-z/	if defined $family;
  $fullname	=~ tr/-_A-Z/  a-z/	if defined $fullname;
  $weight	=~ tr/-_A-Z/  a-z/;

  # if FamilyName is undefined, use FullName if present,
  # else we don't know how to call the font.

  if (!defined $family) {
    if (!defined $fullname) {
      warn "unidentified family for $pfx\n";
      next ARG;
    }

    ($family)	= split(/\s/,$fullname);
  }

  # Normalize weight

  $weight	= $weights{$weight}	|| $weight;

  print STDERR "weight is $weight and variety is $variety\n"	if $debug;

  # look at fullname and family and try to see if we can deduce
  # something about the font's properties. Also
  # delete from the font name any property name,
  # whether normalized or not, to normalize the
  # family name further.

  print STDERR "family is $family and fullname is $fullname\n"	if $debug;

  WEIGHT: for $change (keys(%weights)) {
    print STDERR "  key of weights is $change\n"		if $debug;
    if ("$family-$fullname" =~ /$change/) {
      $weight		= $weights{$change};
      $family		=~ s/$change//;
      last WEIGHT;
    }
  }

  SLANT: for $change (keys(%slants)) {
    print STDERR "  key of slants is $change\n"			if $debug;
    if ("$family-$fullname" =~ /$change/) {
      $slant		= $slants{$change};
      $family		=~ s/$change//;
      last SLANT;
    }
  }

  VARIETY: for $change (keys(%varieties)) {
    print STDERR "  key of varieties is $change\n"		if $debug;
    if ("$family-$fullname" =~ /$change/) {
      $variety		= $varieties{$change};
      $family		=~ s/$change//;
      last VARIETY;
    }
  }

  SERIF: for $change (keys(%serifs)) {
    print STDERR "  key of serifs is $change\n"			if $debug;
    if ("$family-$fullname" =~ /$change/) {
      $serif		= $serifs{$change};
      last SERIF;
    }
  }

  $family =~ s/\s\s+/ /g;
  $family =~ s/\s+$//;

  print "$pfx\t\t-free-$family-$weight-$slant-$variety-$serif-0-0-0-0-$pitch-0-$encoding\n";
}

exit 0;
--
Piercarlo Grandi, Dept of CS, PC/UW@Aberystwyth <pcg@aber.ac.uk>
  E l'italiano cantava, cantava. E le sue disperate invocazioni giunsero
  alle orecchie del suo divino protettore, il dio della barzelletta