dejavu-fonts/problems.pl

   1 #!/usr/bin/perl -w
   2
   3 # $Id$
   4
   5 # possible problems finder
   6 # (c)2004,2005 Stepan Roh (PUBLIC DOMAIN)
   7 # usage: ./problems.pl [-l <0|1|2|3>] sfd_files+
   8
   9 # detected problems (higher levels contain lower levels):
  10 #   level 0:
  11 #     monospaced font (with Mono in name) without indication in Panose (and vice-versa)
  12 #     glyphs in monospaced face with different width
  13 #     not normalized file (looks for WinInfo, DisplaySize, HStem, VStem, Ref, KernsSLIF, different position than encoding,
  14 #       unordered glyphs or H or M flag)
  15 #     glyphs without width or with negative width
  16 #     duplicate glyphs
  17 #     combining marks with non-zero width in non-monospaced fonts
  18 #     missing point numbers in splines
  19 #   level 1 (default):
  20 #     colorized glyphs with content
  21 #   level 2:
  22 #     different set of mapped content glyphs (first SFD file specified on command line is taken as an etalon)
  23 #   level 3:
  24 #     ligature referencing colorized or missing glyphs
  25 #     ligature in colorized glyph (due to bug in FF <20050502 it causes problems on Mac OS X)
  26 #     ligature in empty glyph
  27
  28 sub process_sfd_file($$);
  29
  30 # glyph name => ( 'dec_enc' => dec_enc, 'hex_enc' => hex_enc )
  31 %glyphs = ();
  32 $glyphs_loaded = 0;
  33 %problems_counter = ();
  34
  35 sub process_sfd_file($$) {
  36   local ($sfd_file, $max_level) = @_;
  37
  38   sub problem($@) {
  39     my ($level, $problem, @args) = @_;
  40
  41     if ($level <= $max_level) {
  42       print $sfd_file, ': [', $level, '] ', $problem, ': ', @args, "\n";
  43       $problems_counter{'['.$level.'] '.$problem}++;
  44     }
  45   }
  46
  47   sub is_combining($) {
  48     my ($dec_enc) = @_;
  49
  50     return (($dec_enc >= 0x0300) && ($dec_enc <= 0x036F))
  51         || (($dec_enc >= 0x1DC0) && ($dec_enc <= 0x1DFF))
  52         || (($dec_enc >= 0x20D0) && ($dec_enc <= 0x20FF))
  53         || (($dec_enc >= 0xFE20) && ($dec_enc <= 0xFE2F));
  54   }
  55
  56   my $curchar = '';
  57   my $hex_enc = '';
  58   my $dec_enc = 0;
  59   my $colorized;
  60   my $flags;
  61   my ($fontname, $panose, $is_mono_name, $is_mono_panose) = ('', '', 0, 0);
  62   my $is_mono = 0;
  63   my $font_width = -1;
  64   my $curwidth = 0;
  65   my $has_ligature = 0;
  66   my $is_empty = 1;
  67   my %content_glyphs = ();
  68   my @ligature_refs = ();
  69   my %all_glyphs = ();
  70   my $prev_enc = -1;
  71   my $in_spline_set = 0;
  72   my $has_splines;
  73   my $has_refs;
  74   open (SFD, $sfd_file) || die "Unable to open $sfd_file : $!\n";
  75   while (<SFD>) {
  76     if (/^StartChar:\s*(\S+)\s*$/) {
  77       $curchar = $1;
  78       $hex_enc = '';
  79       $dec_enc = 0;
  80       $curwidth = -1;
  81       undef $colorized;
  82       undef $flags;
  83       $has_ligature = 0;
  84       @ligature_refs = ();
  85       $is_empty = 1;
  86       $in_spline_set = 0;
  87       $has_splines = 0;
  88       $has_refs = 0;
  89     } elsif (/^Colour:\s*(\S+)\s*/) {
  90       $colorized = $1;
  91     } elsif (/^Flags:\s*(\S+)\s*/) {
  92       $flags = $1;
  93       if ($flags =~ /([MH])/) {
  94         problem (0, 'not normalized: '.$1.' flag', $curchar, ' ', $dec_enc, ($hex_enc ? ' U+'.$hex_enc : ''), ': flags=', $flags);
  95       }
  96     } elsif (/^Encoding:\s*(\d+)\s*((?:-|\d)+)\s*(\d+)\s*$/) {
  97       $dec_enc = $1;
  98       if ($2 > -1) {
  99         $hex_enc = sprintf ('%04x', $2);
 100       }
 101       if ($dec_enc != $3) {
 102         problem (0, 'not normalized: glyph position differs from encoding', $curchar, ' ', $dec_enc, ($hex_enc ? ' U+'.$hex_enc : ''), ': position=', $3);
 103       }
 104       if ($dec_enc <= $prev_enc) {
 105         problem (0, 'not normalized: unordered glyphs', $curchar, ' ', $dec_enc, ($hex_enc ? ' U+'.$hex_enc : ''), ': previous=', $prev_enc);
 106       }
 107       $prev_enc = $dec_enc;
 108     } elsif (/^Width:\s*(\S+)\s*/) {
 109       $curwidth = $1;
 110     } elsif (/^Ligature:\s*\S*\s*\S*\s*\S*\s*(.*?)\s*$/) {
 111       @ligature_refs = split(/\s+/, $1);
 112       $has_ligature = 1;
 113     } elsif (/^Fore\s*$/) {
 114       $is_empty = 0;
 115       $in_spline_set = 1;
 116       problem (2, 'mixed content', $curchar, ' ', $dec_enc, ($hex_enc ? ' U+'.$hex_enc : '')) if ($has_refs);
 117       $has_splines = 1;
 118     } elsif (/^EndSplineSet\s*$/) {
 119       $in_spline_set = 0;
 120     } elsif ($in_spline_set && !/.+,.+,.+$/) {
 121       problem (0, 'point numbers missing', $curchar, ' ', $dec_enc, ($hex_enc ? ' U+'.$hex_enc : ''));
 122     } elsif (/^Ref:/) {
 123       $is_empty = 0;
 124       problem (0, 'not normalized: old-style "Ref"', $curchar, ' ', $dec_enc, ($hex_enc ? ' U+'.$hex_enc : ''));
 125     } elsif (/^Refer:\s*\d+\s*\d+\s*\S\s*(-?\d+(?:\.\d*)?(?:e-?\d+)?)\s*(-?\d+(?:\.\d*)?(?:e-?\d+)?)\s*(-?\d+(?:\.\d*)?(?:e-?\d+)?)\s*(-?\d+(?:\.\d*)?(?:e-?\d+)?)\s*-?\d+(?:\.\d*)?(?:e-?\d+)?\s*-?\d+(?:\.\d*)?(?:e-?\d+)?\s*(\d+)/) {
 126       $is_empty = 0;
 127       if (($5 & 0x2) != 0x2) {
 128         problem (0, 'reference is not rounded to grid', $curchar, ' ', $dec_enc, ($hex_enc ? ' U+'.$hex_enc : ''), ' flags=', $5);
 129       }
 130       if (!(($1 == 1) && ($2 == 0) && ($3 == 0) && ($4 == 1))) {
 131         problem (0, 'transformed reference', $curchar, ' ', $dec_enc, ($hex_enc ? ' U+'.$hex_enc : ''));
 132       }
 133       problem (2, 'mixed content', $curchar, ' ', $dec_enc, ($hex_enc ? ' U+'.$hex_enc : '')) if ($has_splines);
 134       $has_refs = 1;
 135     } elsif (/^DisplaySize:/) {
 136       problem (0, 'not normalized: DisplaySize');
 137     } elsif (/^WinInfo:/) {
 138       problem (0, 'not normalized: WinInfo');
 139     } elsif (/^HStem:/) {
 140       problem (0, 'not normalized: HStem');
 141     } elsif (/^VStem:/) {
 142       problem (0, 'not normalized: VStem');
 143     } elsif (/^KernsSLIF:/) {
 144       problem (0, 'not normalized: KernsSLIF');
 145     } elsif (/^EndChar\s*$/) {
 146       if (!defined $colorized && !$is_empty) {
 147         $content_glyphs{$curchar}{'dec_enc'} = $dec_enc;
 148         $content_glyphs{$curchar}{'hex_enc'} = $hex_enc;
 149         @{$content_glyphs{$curchar}{'ligature'}} = @ligature_refs;
 150         # only mapped glyphs
 151         if ($hex_enc) {
 152           if ($glyphs_loaded) {
 153             if (!exists $glyphs{$curchar}) {
 154               problem (2, 'etalon-free glyph', $curchar, ' ', $dec_enc, ($hex_enc ? ' U+'.$hex_enc : ''));
 155             }
 156           } else {
 157             $glyphs{$curchar}{'dec_enc'} = $dec_enc;
 158             $glyphs{$curchar}{'hex_enc'} = $hex_enc;
 159           }
 160         }
 161       }
 162       if (defined $colorized && !$is_empty) {
 163         problem (1, 'colorized content', $curchar, ' ', $dec_enc, ($hex_enc ? ' U+'.$hex_enc : '') , ': color=', $colorized);
 164       }
 165       if (defined $colorized && defined $flags && ($flags =~ /W/)) {
 166         problem (1, 'colorized content', $curchar, ' ', $dec_enc, ($hex_enc ? ' U+'.$hex_enc : '') , ': color=', $colorized, ', flags=', $flags);
 167       }
 168       if (!$is_mono && defined $colorized && ($curwidth != 2048) && ($curwidth != 0)) {
 169         problem (1, 'colorized content', $curchar, ' ', $dec_enc, ($hex_enc ? ' U+'.$hex_enc : '') , ': color=', $colorized, ', width=', $curwidth);
 170       }
 171       if ($curwidth == -1) {
 172         problem (0, 'glyph w/o width', $curchar, ' ', $dec_enc, ($hex_enc ? ' U+'.$hex_enc : ''));
 173       } elsif ($curwidth < 0) {
 174         problem (0, 'negative width', $curchar, ' ', $dec_enc, ($hex_enc ? ' U+'.$hex_enc : ''), ': width=', $curwidth);
 175       } elsif ($is_mono && defined $flags && ($flags =~ /W/)) {
 176         if ($font_width == -1) {
 177           $font_width = $curwidth;
 178         } elsif ($curwidth != $font_width) {
 179           problem (0, 'incorrect width', $curchar, ' ', $dec_enc, ($hex_enc ? ' U+'.$hex_enc : ''), ': font width=', $font_width, ', glyph width=', $curwidth);
 180         }
 181       } elsif (!$is_mono && is_combining($dec_enc) && ($curwidth != 0) && !$is_empty) {
 182         problem (0, 'combining mark with non-zero width', $curchar, ' ', $dec_enc, ($hex_enc ? ' U+'.$hex_enc : ''), ': width=', $curwidth);
 183       }
 184       if (defined $colorized && $has_ligature) {
 185         problem (3, 'colorized ligature', $curchar, ' ', $dec_enc, ($hex_enc ? ' U+'.$hex_enc : ''), ': color=', $colorized);
 186       }
 187       if ($is_empty && $has_ligature) {
 188         problem (3, 'empty ligature', $curchar, ' ', $dec_enc, ($hex_enc ? ' U+'.$hex_enc : ''));
 189       }
 190       if (exists $all_glyphs{$dec_enc}) {
 191         problem (0, 'duplicate', $curchar, ' ', $dec_enc, ($hex_enc ? ' U+'.$hex_enc : ''));
 192       }
 193       $all_glyphs{$dec_enc} = 1;
 194     } elsif (/^FontName:\s*(.*?)\s*$/) {
 195       $fontname = $1;
 196       $is_mono_name = ($fontname =~ /mono/i);
 197       $is_mono = 1 if ($is_mono_name);
 198     } elsif (/^Panose:\s*(.*?)\s*$/) {
 199       $panose = $1;
 200       $is_mono_panose = ((split(/\s+/, $panose))[3] == 9);
 201       $is_mono = 1 if ($is_mono_panose);
 202     }
 203   }
 204   close (SFD);
 205   if ($is_mono_name != $is_mono_panose) {
 206     problem (0, 'mixed monospace', 'font name=', $fontname, ', panose=', $panose);
 207   }
 208   foreach $glyph (sort { $content_glyphs{$a}{'dec_enc'} <=> $content_glyphs{$b}{'dec_enc'} } keys %content_glyphs) {
 209     my $dec_enc = $content_glyphs{$glyph}{'dec_enc'};
 210     my $hex_enc = $content_glyphs{$glyph}{'hex_enc'};
 211     foreach $liga (@{$content_glyphs{$glyph}{'ligature'}}) {
 212       if (!exists ($content_glyphs{$liga})) {
 213         problem (3, 'ligature references colorized or missing glyph', $glyph, ' ', $dec_enc, ($hex_enc ? ' U+'.$hex_enc : ''), ': ligature ref=', $liga);
 214       }
 215     }
 216   }
 217   if ($glyphs_loaded) {
 218     foreach $glyph (sort { $glyphs{$a}{'dec_enc'} <=> $glyphs{$b}{'dec_enc'} } keys %glyphs) {
 219       my $dec_enc = $glyphs{$glyph}{'dec_enc'};
 220       my $hex_enc = $glyphs{$glyph}{'hex_enc'};
 221       if (!exists $content_glyphs{$glyph}) {
 222         problem (2, 'missing glyph', $glyph, ' ', $dec_enc, ($hex_enc ? ' U+'.$hex_enc : ''));
 223       }
 224     }
 225   }
 226   $glyphs_loaded = 1;
 227 }
 228
 229 if (!@ARGV) {
 230   print STDERR "usage: [-l <0|1|2|3>] sfd_files+\n";
 231   exit 1;
 232 }
 233
 234 $max_level = 1;
 235 if ($ARGV[0] eq '-l') {
 236   shift @ARGV;
 237   $max_level = shift @ARGV;
 238 }
 239 @sfd_files = @ARGV;
 240
 241 foreach $sfd_file (@sfd_files) {
 242   process_sfd_file ($sfd_file, $max_level);
 243 }
 244
 245 foreach $problem (sort keys %problems_counter) {
 246   print $problems_counter{$problem}, ' problems of type "', $problem, '"', "\n";
 247 }
 248
 249 1;