dejavu-fonts/scripts/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   my %all_names = ();
  75   open (SFD, $sfd_file) || die "Unable to open $sfd_file : $!\n";
  76   while (<SFD>) {
  77     if (/^StartChar:\s*(\S+)\s*$/) {
  78       $curchar = $1;
  79       if (exists($all_names{$curchar})) {
  80         problem (0, 'duplicate glyph name', $1);
  81       }
  82       $all_names{$curchar} = 1;
  83       $hex_enc = '';
  84       $dec_enc = 0;
  85       $curwidth = -1;
  86       undef $colorized;
  87       undef $flags;
  88       $has_ligature = 0;
  89       @ligature_refs = ();
  90       $is_empty = 1;
  91       $in_spline_set = 0;
  92       $has_splines = 0;
  93       $has_refs = 0;
  94     } elsif (/^Colour:\s*(\S+)\s*/) {
  95       $colorized = $1;
  96     } elsif (/^Flags:\s*(\S+)\s*/) {
  97       $flags = $1;
  98       if ($flags =~ /([MH])/) {
  99         problem (0, 'not normalized: '.$1.' flag', $curchar, ' ', $dec_enc, ($hex_enc ? ' U+'.$hex_enc : ''), ': flags=', $flags);
 100       }
 101     } elsif (/^Encoding:\s*(\d+)\s*((?:-|\d)+)\s*(\d+)\s*$/) {
 102       $dec_enc = $1;
 103       if ($2 > -1) {
 104         $hex_enc = sprintf ('%04x', $2);
 105       }
 106       if ($dec_enc != $3) {
 107         problem (0, 'not normalized: glyph position differs from encoding', $curchar, ' ', $dec_enc, ($hex_enc ? ' U+'.$hex_enc : ''), ': position=', $3);
 108       }
 109       if ($dec_enc <= $prev_enc) {
 110         problem (0, 'not normalized: unordered glyphs', $curchar, ' ', $dec_enc, ($hex_enc ? ' U+'.$hex_enc : ''), ': previous=', $prev_enc);
 111       }
 112       $prev_enc = $dec_enc;
 113     } elsif (/^Width:\s*(\S+)\s*/) {
 114       $curwidth = $1;
 115     } elsif (/^Ligature:\s*\S*\s*\S*\s*\S*\s*(.*?)\s*$/) {
 116       @ligature_refs = split(/\s+/, $1);
 117       $has_ligature = 1;
 118     } elsif (/^SplineSet\s*$/) {
 119       $is_empty = 0;
 120       $in_spline_set = 1;
 121       problem (0, 'mixed content', $curchar, ' ', $dec_enc, ($hex_enc ? ' U+'.$hex_enc : '')) if ($has_refs);
 122       $has_splines = 1;
 123     } elsif (/^EndSplineSet\s*$/) {
 124       $in_spline_set = 0;
 125     } elsif ($in_spline_set && !/.+,.+,.+$/) {
 126       problem (0, 'point numbers missing', $curchar, ' ', $dec_enc, ($hex_enc ? ' U+'.$hex_enc : ''));
 127     } elsif (/^Ref:/) {
 128       $is_empty = 0;
 129       problem (0, 'not normalized: old-style "Ref"', $curchar, ' ', $dec_enc, ($hex_enc ? ' U+'.$hex_enc : ''));
 130     } 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+)/) {
 131       $is_empty = 0;
 132       if (($5 & 0x2) != 0x2) {
 133         problem (0, 'reference is not rounded to grid', $curchar, ' ', $dec_enc, ($hex_enc ? ' U+'.$hex_enc : ''), ' flags=', $5);
 134       }
 135       if (!(($1 == 1) && ($2 == 0) && ($3 == 0) && ($4 == 1))) {
 136         problem (0, 'transformed reference', $curchar, ' ', $dec_enc, ($hex_enc ? ' U+'.$hex_enc : ''));
 137       }
 138       problem (0, 'mixed content', $curchar, ' ', $dec_enc, ($hex_enc ? ' U+'.$hex_enc : '')) if ($has_splines);
 139       $has_refs = 1;
 140     } elsif (/^DisplaySize:/) {
 141       problem (0, 'not normalized: DisplaySize');
 142     } elsif (/^WinInfo:/) {
 143       problem (0, 'not normalized: WinInfo');
 144     } elsif (/^HStem:/) {
 145       problem (0, 'not normalized: HStem');
 146     } elsif (/^VStem:/) {
 147       problem (0, 'not normalized: VStem');
 148     } elsif (/^KernsSLIF:/) {
 149       problem (0, 'not normalized: KernsSLIF');
 150     } elsif (/^EndChar\s*$/) {
 151       if (!defined $colorized && !$is_empty) {
 152         $content_glyphs{$curchar}{'dec_enc'} = $dec_enc;
 153         $content_glyphs{$curchar}{'hex_enc'} = $hex_enc;
 154         @{$content_glyphs{$curchar}{'ligature'}} = @ligature_refs;
 155         # only mapped glyphs
 156         if ($hex_enc) {
 157           if ($glyphs_loaded) {
 158             if (!exists $glyphs{$curchar}) {
 159               problem (2, 'etalon-free glyph', $curchar, ' ', $dec_enc, ($hex_enc ? ' U+'.$hex_enc : ''));
 160             }
 161           } else {
 162             $glyphs{$curchar}{'dec_enc'} = $dec_enc;
 163             $glyphs{$curchar}{'hex_enc'} = $hex_enc;
 164           }
 165         }
 166       }
 167       if (defined $colorized && !$is_empty) {
 168         problem (1, 'colorized content', $curchar, ' ', $dec_enc, ($hex_enc ? ' U+'.$hex_enc : '') , ': color=', $colorized);
 169       }
 170       if (defined $colorized && defined $flags && ($flags =~ /W/)) {
 171         problem (1, 'colorized content', $curchar, ' ', $dec_enc, ($hex_enc ? ' U+'.$hex_enc : '') , ': color=', $colorized, ', flags=', $flags);
 172       }
 173       if (!$is_mono && defined $colorized && ($curwidth != 2048) && ($curwidth != 0)) {
 174         problem (1, 'colorized content', $curchar, ' ', $dec_enc, ($hex_enc ? ' U+'.$hex_enc : '') , ': color=', $colorized, ', width=', $curwidth);
 175       }
 176       if ($curwidth == -1) {
 177         problem (0, 'glyph w/o width', $curchar, ' ', $dec_enc, ($hex_enc ? ' U+'.$hex_enc : ''));
 178       } elsif ($curwidth < 0) {
 179         problem (0, 'negative width', $curchar, ' ', $dec_enc, ($hex_enc ? ' U+'.$hex_enc : ''), ': width=', $curwidth);
 180       } elsif ($is_mono && defined $flags && ($flags =~ /W/)) {
 181         if ($font_width == -1) {
 182           $font_width = $curwidth;
 183         } elsif ($curwidth != $font_width) {
 184           problem (0, 'incorrect width', $curchar, ' ', $dec_enc, ($hex_enc ? ' U+'.$hex_enc : ''), ': font width=', $font_width, ', glyph width=', $curwidth);
 185         }
 186       } elsif (!$is_mono && is_combining($dec_enc) && ($curwidth != 0) && !$is_empty) {
 187         problem (0, 'combining mark with non-zero width', $curchar, ' ', $dec_enc, ($hex_enc ? ' U+'.$hex_enc : ''), ': width=', $curwidth);
 188       }
 189       if (defined $colorized && $has_ligature) {
 190         problem (3, 'colorized ligature', $curchar, ' ', $dec_enc, ($hex_enc ? ' U+'.$hex_enc : ''), ': color=', $colorized);
 191       }
 192       if ($is_empty && $has_ligature) {
 193         problem (3, 'empty ligature', $curchar, ' ', $dec_enc, ($hex_enc ? ' U+'.$hex_enc : ''));
 194       }
 195       if (exists $all_glyphs{$dec_enc}) {
 196         problem (0, 'duplicate', $curchar, ' ', $dec_enc, ($hex_enc ? ' U+'.$hex_enc : ''));
 197       }
 198       $all_glyphs{$dec_enc} = 1;
 199     } elsif (/^FontName:\s*(.*?)\s*$/) {
 200       $fontname = $1;
 201       $is_mono_name = ($fontname =~ /mono/i);
 202       $is_mono = 1 if ($is_mono_name);
 203     } elsif (/^Panose:\s*(.*?)\s*$/) {
 204       $panose = $1;
 205       $is_mono_panose = ((split(/\s+/, $panose))[3] == 9);
 206       $is_mono = 1 if ($is_mono_panose);
 207     }
 208   }
 209   close (SFD);
 210   if ($is_mono_name != $is_mono_panose) {
 211     problem (0, 'mixed monospace', 'font name=', $fontname, ', panose=', $panose);
 212   }
 213   foreach $glyph (sort { $content_glyphs{$a}{'dec_enc'} <=> $content_glyphs{$b}{'dec_enc'} } keys %content_glyphs) {
 214     my $dec_enc = $content_glyphs{$glyph}{'dec_enc'};
 215     my $hex_enc = $content_glyphs{$glyph}{'hex_enc'};
 216     foreach $liga (@{$content_glyphs{$glyph}{'ligature'}}) {
 217       if (!exists ($content_glyphs{$liga})) {
 218         problem (3, 'ligature references colorized or missing glyph', $glyph, ' ', $dec_enc, ($hex_enc ? ' U+'.$hex_enc : ''), ': ligature ref=', $liga);
 219       }
 220     }
 221   }
 222   if ($glyphs_loaded) {
 223     foreach $glyph (sort { $glyphs{$a}{'dec_enc'} <=> $glyphs{$b}{'dec_enc'} } keys %glyphs) {
 224       my $dec_enc = $glyphs{$glyph}{'dec_enc'};
 225       my $hex_enc = $glyphs{$glyph}{'hex_enc'};
 226       if (!exists $content_glyphs{$glyph}) {
 227         problem (2, 'missing glyph', $glyph, ' ', $dec_enc, ($hex_enc ? ' U+'.$hex_enc : ''));
 228       }
 229     }
 230   }
 231   $glyphs_loaded = 1;
 232 }
 233
 234 if (!@ARGV) {
 235   print STDERR "usage: [-l <0|1|2|3>] sfd_files+\n";
 236   exit 1;
 237 }
 238
 239 $max_level = 1;
 240 if ($ARGV[0] eq '-l') {
 241   shift @ARGV;
 242   $max_level = shift @ARGV;
 243 }
 244 @sfd_files = @ARGV;
 245
 246 foreach $sfd_file (@sfd_files) {
 247   process_sfd_file ($sfd_file, $max_level);
 248 }
 249
 250 foreach $problem (sort keys %problems_counter) {
 251   print $problems_counter{$problem}, ' problems of type "', $problem, '"', "\n";
 252 }
 253
 254 1;