dejavu-fonts/sfdnormalize.pl

   1 #!/usr/bin/perl -w
   2
   3 # $Id$
   4
   5 # SFD normalizer (discards GUI information from SFD files)
   6 # (c)2004,2005 Stepan Roh (PUBLIC DOMAIN)
   7 # usage: ./sfdnormalize.pl sfd_file(s)
   8 #  will create files with suffix .norm
   9
  10 # changes done:
  11 #   WinInfo - discarded
  12 #   DisplaySize
  13 #           - discarded
  14 #   Flags   - discarded O (open), H (changed since last hinting - useless for TTF), M (manual hinting - useless for TTF)
  15 #   Refer   - changed S (selected) to N (not selected)
  16 #   Fore, Back, SplineSet, Grid
  17 #           - all points have 4 masked out from flags (selected)
  18 #             and 256 (do not interpolate)
  19 #   HStem, VStem
  20 #           - discarded (those are Type1 stems = PS hints)
  21 #   recalculate number of characters and positional encoding
  22 #   NameList
  23 #           - discarded (temporary)
  24 # changes making it incompatible with FF older than (approx.) 20050728:
  25 #   Ref     - renamed to Refer
  26 #   KernsSLIF
  27 #           - renamed to KernsSLIFO
  28
  29 # !!! Always review changes done by this utility !!!
  30
  31 sub process_sfd_file($);
  32
  33 sub process_sfd_file($) {
  34   my ($sfd_file) = @_;
  35
  36   my $out = $sfd_file . '.norm';
  37
  38   open (SFD, $sfd_file) || die "Unable to open $sfd_file : $!\n";
  39   open (OUT, '>'.$out) || die "Unable to open $out : $!\n";
  40
  41   my $curchar = '';
  42   my %glyphs = ();
  43   my $in_spline_set = 0;
  44   my $max_dec_enc = 0;
  45   my %pos_glyphs_map = ();
  46
  47   while (<SFD>) {
  48     next if (/^(WinInfo|DisplaySize|HStem|VStem|NameList):/);
  49     s,^Ref:,Refer:,;
  50     s,^KernsSLIF:,KernsSLIFO:,;
  51     s,^(Flags:.*?)O(.*)$,$1$2,;
  52     s,^(Flags:.*?)H(.*)$,$1$2,;
  53     s,^(Flags:.*?)M(.*)$,$1$2,;
  54     # remove empty Flags line
  55     next if (/^Flags:\s*$/);
  56     s,^(Refer:.*?)S(.*)$,$1N$2,;
  57     if (/^(Fore|Back|SplineSet|Grid)\s*$/) {
  58       $in_spline_set = 1;
  59     } elsif (/^EndSplineSet\s*$/) {
  60       $in_spline_set = 0;
  61     } elsif ($in_spline_set) {
  62       s/(\s+)(\S+?)(,\S+\s*)$/$1.($2 & ~4 & ~256).$3/e;
  63     }
  64     if (/^BeginChars:/) {
  65       $in_chars = 1;
  66     } elsif (/^EndChars\s*$/) {
  67       $in_chars = 0;
  68       # adding of 1 to max_dec_enc is strange, but works
  69       print OUT "BeginChars: ", $max_dec_enc + 1, " ", scalar (keys %glyphs), "\n";
  70       foreach $glyph (sort { $glyphs{$a}{'dec_enc'} <=> $glyphs{$b}{'dec_enc'} } keys %glyphs) {
  71         print OUT "StartChar: ", $glyphs{$glyph}{'name'}, "\n";
  72         my $dec_enc = $glyphs{$glyph}{'dec_enc'};
  73         my $mapped_enc = $glyphs{$glyph}{'mapped_enc'};
  74         print OUT "Encoding: ", $dec_enc, " ", $mapped_enc, " ", $dec_enc, "\n";
  75         # recalculate references and kerning pairs
  76         foreach $l (@{$glyphs{$glyph}{'lines'}}) {
  77           $l =~ s/^(Refer:\s*)(\S+)/$1.(exists $pos_glyphs_map{$2} ? $pos_glyphs_map{$2} : (warn "Glyph $glyph ($dec_enc) has reference to unknown glyph position $2\n", $2))/e;
  78           if ($l =~ /^KernsSLIFO:\s*(.*)$/) {
  79             my @nums = split(/\s+/, $1);
  80             if ((scalar (@nums) % 4) != 0) {
  81               warn "Kerning definition in glyph $curchar ($dec_enc) is malformed and won't be remapped\n";
  82             } else {
  83               for (my $i = 0; $i < scalar (@nums); $i += 4) {
  84                 my $pos = $nums[$i];
  85                 if (exists $pos_glyphs_map{$pos}) {
  86                   $nums[$i] = $pos_glyphs_map{$pos};
  87                 } else {
  88                   warn "Glyph $glyph ($dec_enc) has kerning reference to unknown glyph position $pos\n";
  89                 }
  90               }
  91             }
  92             $l = "KernsSLIFO: " . join(' ', @nums) . "\n";
  93           }
  94           print OUT $l;
  95         }
  96         print OUT "EndChar\n";
  97         $pos++;
  98       }
  99       print OUT "EndChars\n";
 100     } elsif (/^StartChar:\s*(\S+)\s*$/) {
 101       my $name = $1;
 102       $curchar = $name;
 103       while (exists $glyphs{$curchar}) {
 104         $curchar .= '#';
 105       }
 106       $glyphs{$curchar}{'name'} = $name;
 107     } elsif (/^Encoding:\s*(\d+)\s*((?:-|\d)+)\s*(\d+)\s*$/) {
 108       $dec_enc = $1;
 109       $max_dec_enc = $dec_enc if ($dec_enc > $max_dec_enc);
 110       $mapped_enc = $2;
 111       $pos = $3;
 112       $glyphs{$curchar}{'dec_enc'} = $dec_enc;
 113       $glyphs{$curchar}{'mapped_enc'} = $mapped_enc;
 114       $glyphs{$curchar}{'pos'} = $pos;
 115       if (exists $pos_glyphs_map{$pos}) {
 116         warn "Glyph $curchar ($dec_enc) has duplicate glyph position $pos - won't be remapped - possible output corruption!\n";
 117       } else {
 118         $pos_glyphs_map{$pos} = $dec_enc;
 119       }
 120     } elsif (/^EndChar\s*$/) {
 121       $curchar = '';
 122     } else {
 123       if (!$in_chars) {
 124         print OUT;
 125       } elsif ($curchar eq '') {
 126         warn "Malformed input file $sfd_file?";
 127       } else {
 128         push (@{$glyphs{$curchar}{'lines'}}, $_);
 129       }
 130     }
 131   }
 132
 133   close (SFD);
 134   close (OUT);
 135 }
 136
 137 if (!@ARGV) {
 138   print STDERR "usage: sfd_files+\n";
 139   exit 1;
 140 }
 141
 142 @sfd_files = @ARGV;
 143
 144 foreach $sfd_file (@sfd_files) {
 145   process_sfd_file ($sfd_file);
 146 }
 147
 148 1;