フォントの暗黒度を比較してみる

darkdawn.pl

use strict;
use utf8;
use Data::Dump 'dump';
my $progname = "darkdawn";
#
# List the name of the fonts to be inspected.
# (Use font family names; '/B' means bold version.)
@ARGV = split(m/\n/, <<'END') if (!@ARGV);
GT2000-01
MigMix 1M/B
MigMix 1M
MigMix 2M/B
MigMix 2M
M+ 1c thin
M+ 1c light
M+ 1c regular
M+ 1c medium
M+ 1c bold
M+ 1c heavy
M+ 1c black
Bitstream Cyberbit
HanaMinA
MoboGothic
MoboGothic/B
MogaGothic
MogaGothic/B
MogaMincho
MogaMincho/B
MotoyaLCedar
MotoyaLMaru
WadaLabChuMaruGo20044
WadaLabMaruGo20044
M+ 2c thin
M+ 2c light
M+ 2c regular
M+ 2c medium
M+ 2c bold
M+ 2c heavy
M+ 2c black
TGothic-GT01
TMincho-GT01
TakaoGothic
TakaoMincho
Migu 1M/B
Migu 1M
Migu 2M/B
Migu 2M
Rounded M+ 1c thin
Rounded M+ 1c light
Rounded M+ 1c regular
Rounded M+ 1c medium
Rounded M+ 1c bold
Rounded M+ 1c heavy
Rounded M+ 1c black
Rounded M+ 2c thin
Rounded M+ 2c light
Rounded M+ 2c regular
Rounded M+ 2c medium
Rounded M+ 2c bold
Rounded M+ 2c heavy
Rounded M+ 2c black
Sazanami Gothic
Sazanami Mincho
VL Gothic
HGGothicE
HGGothicM
HGGyoshotai
HGKyokashotai
HGMinchoB
HGMinchoE
HGSoeiKakupoptai
HGSoeiPresenceEB
HGSoeiKakugothicUB
HGSeikaishotaiPRO
HGMaruGothicMPRO
IPAGothic
IPAMincho
MS Gothic
MS Mincho
END
my $norm_font = "IPAMincho"; # font used as norm
my $text = "疎ましい朝が来た。絶望の朝だ。";
use constant { DPI => 1200, ADJUST => 0.0 };
#
my $tempbase = "__$progname$$";
my $logfile = "$progname-log.txt";
my $outfile = "$progname-result.txt";
my $xetex = "xetex";
my $imagemagick = "imagemagick";
my ($norm_meas, $norm_dark);

sub dark_index {
  my ($meas, $dark) = @_;
  my $rm = ($meas - $norm_meas) / $norm_meas * ADJUST + 1;
  my $di = int($dark / ($norm_dark * $rm**2) * 100 + 0.5);
  return $di;
}

sub main {
  open(my $h_out, ">", $outfile)
    or die "Cannot open '$outfile'";
  ($norm_meas, $norm_dark) = tex_process($norm_font);
  foreach my $font (@ARGV) {
    info("---------------- $font");
    my ($meas, $dark, $s) = ($font eq $norm_font) ?
      ($norm_meas, $norm_dark, '*') :
      (tex_process($font), '');
    my $di = dark_index($meas, $dark);
    info("$font -> $di ($meas,$dark)");
    print $h_out ("$font:$di:($meas,$dark$s)\n");
  }
  close($h_out);
}

sub tex_process {
  my ($fontname) = @_;
  my ($meas, $dark, @ldata);
  local ($/, $_);
  my $dpi = DPI;
  eval {
    open(my $htex, '>:utf8', "$tempbase.tex")
      or error("cannot open for output", "$tempbase.tex");
    print $htex (<<"TEX");
\\font\\fTest="$fontname"\\relax \\fTest
\\nopagenumbers
$text
\\bye
TEX
    close($htex);
    system("xetex $tempbase.tex");
    (-s "$tempbase.pdf") or die;
    system("convert -compress None -depth 8 -density $dpi" .
           " $tempbase.pdf -trim $tempbase.pgm");
    (-s "$tempbase.pgm") or die;
    undef $/;
    open(my $hpgm, "<", "$tempbase.pgm") or die;
    my $pgm = <$hpgm> or die;
    close($hpgm);
    my ($h, $x, $y, $d, @pxl) = split(m/\s+/, $pgm);
    ($h eq 'P2' && $x > 0 && $y > 0 && $d == 255) or die;
    $meas = $y; $dark = 0;
    foreach (@pxl) {
      $dark += ($d - $_);
    }
    open(my $hlog, "<", "$tempbase.log") or die;
    while (<$hlog>) {
      if (m/^DATA>>(.*)/) {
        push(@ldata, $1);
      }
    }
    close($hlog);
  };
  my $error = $@;
  unlink(glob("$tempbase.???"));
  if ($error) {
    error("Failure in TeX process");
  }
  return ($meas, $dark, @ldata)
}

sub info {
  print STDERR (join(": ", $progname, @_), "\n");
}
sub alert {
  info("warning", @_);
}
sub error {
  info(@_);
  exit(-1);
}

main();
# EOF