dejavu-fonts/scripts/mescover.pl

   1 #!/usr/bin/perl -w
   2
   3 # $Id$
   4
   5 # MES coverage analyzer
   6 # (c)2005 Stepan Roh (PUBLIC DOMAIN)
   7 # usage: ./mescover.pl mes_spec_file sfd_files+
   8
   9 sub parse_mes_spec_file($);
  10 sub init_mes_glyphs();
  11 sub print_mes_glyphs();
  12 sub parse_sfd_file($);
  13
  14 # map (MES glyph dec => 1)
  15 %mes_glyphs = ();
  16 $mes_collection = 'UNKNOWN';
  17
  18 sub parse_mes_spec_file($) {
  19   my ($mes_file) = @_;
  20
  21   open (F, $mes_file) || die "Unable to open $mes_file : $!\n";
  22   my $plane = '00';
  23   while (<F>) {
  24     if (/^Collection Name:\s+(.*?)\s*$/) {
  25       $mes_collection = $1;
  26     } elsif (/^Plane\s+(\d+)\s*$/) {
  27       $plane = $1;
  28     } elsif (/^([A-F0-9]+)\s+(.*?)\s*$/) {
  29       my $row = $1;
  30       my @cells = split(/\s+/, $2);
  31       foreach $cell (@cells) {
  32         my @range = split(/-/, $cell);
  33         if (@range == 1) {
  34           my $hexenc = $plane.$row.$range[0];
  35           my $decenc = hex($hexenc);
  36           $mes_glyphs{$decenc} = 1;
  37         } else {
  38           my $hexenc_start = $plane.$row.$range[0];
  39           my $decenc_start = hex($hexenc_start);
  40           my $hexenc_end = $plane.$row.$range[1];
  41           my $decenc_end = hex($hexenc_end);
  42           for (my $decenc = $decenc_start; $decenc <= $decenc_end; $decenc++) {
  43             $mes_glyphs{$decenc} = 1;
  44           }
  45         }
  46       }
  47     }
  48   }
  49   close (F);
  50 }
  51
  52 sub init_mes_glyphs() {
  53   foreach $decenc (keys %mes_glyphs) {
  54     $mes_glyphs{$decenc} = 1;
  55   }
  56 }
  57
  58 sub print_mes_glyphs() {
  59   my $cnt = 0;
  60   my $missed = 0;
  61   my $lastenc = -100;
  62   my $in_range = 0;
  63   foreach $decenc (sort keys %mes_glyphs) {
  64     if ($mes_glyphs{$decenc} != 0) {
  65       if ($decenc == $lastenc + 1) {
  66         $lastenc = $decenc;
  67         $in_range = 1;
  68       } else {
  69         if ($in_range) {
  70           printf("-U+%04x", $lastenc);
  71         }
  72         printf(" U+%04x", $decenc);
  73         $in_range = 0;
  74       }
  75       $lastenc = $decenc;
  76       $missed++;
  77     }
  78     $cnt++;
  79   }
  80   if ($in_range) {
  81     printf("-U+%04x", $lastenc);
  82   }
  83   print " [$missed/$cnt]";
  84 }
  85
  86 sub parse_sfd_file($) {
  87   my ($sfd_file) = @_;
  88
  89   open (F, $sfd_file) || die "Unable to open $sfd_file : $!\n";
  90   my $curchar = '';
  91   my $curenc = '';
  92   my $empty = 0;
  93   while (<F>) {
  94     if (/^StartChar:\s*(\S+)\s*$/) {
  95       $curchar = $1;
  96       $curenc = '';
  97       $empty = 0;
  98     } elsif (/^Colour:/) {
  99       # XXX this is quick'n'dirty hack to detect non-empty glyphs
 100       $empty = 1;
 101     } elsif (/^Encoding:\s*\d+\s*(\d+)\s*\d+\s*$/) {
 102       $curenc = $1;
 103     } elsif ($curenc && !$empty && /^EndChar\s*/) {
 104       if (defined $mes_glyphs{$curenc}) {
 105         $mes_glyphs{$curenc} = 0;
 106       }
 107     }
 108   }
 109   close (F);
 110 }
 111
 112 if (@ARGV < 2) {
 113   print STDERR "usage: mes_spec_file sfd_files+\n";
 114   exit 1;
 115 }
 116
 117 $mes_spec_file = shift @ARGV;
 118 parse_mes_spec_file($mes_spec_file);
 119 print "Missing glyphs from collection $mes_collection\n\n";
 120 while (@ARGV) {
 121   $sfd_file = shift @ARGV;
 122   print $sfd_file, ':';
 123   init_mes_glyphs();
 124   parse_sfd_file($sfd_file);
 125   print_mes_glyphs();
 126   print "\n";
 127 }
 128
 129 1;