Windows 7 のメイリオを改造版に置き換える — バックスラッシュをバックスラッシュとして表示するために

メイリオでバックスラッシュが円記号で表示されるバグを修正する Perl スクリプトをでっち上げた。メイリオ 6.02 用。

手順:

1. UniteTTC で元の meiryo.ttc と meiryob.ttc を TTF ファイルにばらす。
2. Perl の実行環境を用意する。Font::TTF モジュールをインストールする。
3. 各 TTF ファイルを下記スクリプトで一つづつ処理する。スクリプト起動時に二つのコマンドライン引数を与えること。一つ目は処理する TTF ファイル名、二つ目は処理した結果の TTF ファイルを保存するファイル名。処理にはそれなりのメモリと時間を要する (筆者の環境では約 170 MB、60 秒)。
4. 得られた TTF ファイルを UniteTTC で TTC ファイルに纏める。
5. Windows のフォントディレクトリ (C:\Windows\Fonts) に入れる。ファイル名は元の meiryo.ttc, meiryob.ttc とは別にしておくこと。
6. レジストリエディタで \HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts を開き、以下の項目のファイル名を新しいファイル名に書き換える。
   • Meiryo & Meiryo Italic & Meiryo UI & Meiryo UI Italic (TrueType)
   • Meiryo Bold & Meiryo Bold Italic & Meiryo UI Bold & Meiryo UI Bold Italic (TrueType)
   • メイリオ & メイリオ イタリック & Meiryo UI & Meiryo UI Italic (TrueType)
   • メイリオ ボールド & メイリオ ボールド イタリック & Meiryo UI Bold & Meiryo UI Bold Italic (TrueType)
7. Windows を再起動。(ログインしなおすだけでもいい?)

筆者は TrueType の仕様に疎く、Perl プログラミングにも慣れていない。識者による意見・添削を歓迎する。

#!/usr/bin/perl

use strict;
use warnings;
use Font::TTF::Font;

my $verbose = 0;
if ($ARGV[0] eq "-v") {
    $verbose = 1;
    shift
}

my $backslash = ord('\\');

my $f = Font::TTF::Font->open($ARGV[0]) or die "Can't read $ARGV[0]";

my $cmap = $f->{'cmap'};
$cmap->read;
print "cmap = $cmap\n" if $verbose;
my $glyphid = $cmap->ms_lookup($backslash);
print "backslash glyphid = $glyphid\n" if $verbose;
while (my ($key, $value) = each(%$cmap)) {
    print "cmap{$key} = $value\n" if $verbose;
}
my $tables = $cmap->{'Tables'};
print "  Tables = $tables\n" if $verbose;
foreach my $x (0..$#$tables) {
    my $table = $tables->[$x];
    print "    Tables[$x] = $table\n" if $verbose;
    while (my ($key, $value) = each(%$table)) {
        print "      Tables[$x]{$key} = $value\n" if $verbose;
    }

    my $val = $table->{'val'};
    while (my ($key, $value) = each(%$val)) {
        print "        val{$key} = $value\n" if $verbose;
    }
    if ($val->{$backslash} == 20682) {
        print "===== Changing cmap{Tables}[$x]{val}{$backslash} from 20682 to 99 =====\n";
        $val->{$backslash} = 99;
        #$val->dirty;
    } elsif ($val->{$backslash} == 20683) {
        print "===== Changing cmap{Tables}[$x]{val}{$backslash} from 20683 to 419 =====\n";
        $val->{$backslash} = 419;
        #$val->dirty;
    }
}

my $gsub = $f->{'GSUB'};
$gsub->read;
print "gsub = $gsub\n" if $verbose;
while (my ($key, $value) = each(%$gsub)) {
    print "GSUB{$key} = $value\n" if $verbose;
}
my $lookup = $gsub->{'LOOKUP'};
print "  LOOKUP = $lookup\n" if $verbose;
foreach my $x (0..$#$lookup) {
    my $l = $lookup->[$x];
    print "    LOOKUP[$x] = $l\n" if $verbose;
    while (my ($key, $value) = each(%$l)) {
        print "      LOOKUP[$x]{$key} = $value\n" if $verbose;
    }

    my $sub = $l->{'SUB'};
    foreach my $y (0..$#$sub) {
        my $s = $sub->[$y];
        print "        SUB[$y] = $s\n" if $verbose;
        while (my ($key, $value) = each(%$s)) {
            print "          SUB[$y]{$key} = $value\n" if $verbose;
        }

        my $coverage = $s->{'COVERAGE'};
        while (my ($key, $value) = each(%$coverage)) {
            print "            COVERAGE{$key} = $value\n" if $verbose;
        }
        my $val = $coverage->{'val'};
        while (my ($key, $value) = each(%$val)) {
            print "              val{$key} = $value\n" if $verbose;
            if ($key == 20682 || $key == 20683) {
                print "===== Removing GSUB{LOOKUP}[$x]{SUB}[$y]{COVERAGE}{val}{$key} = $value =====\n";
                delete $val->{$key};
                #$gsub->dirty;
            }
        }

        my $rules = $s->{'RULES'};
        foreach my $z (0..$#$rules) {
            my $r = $rules->[$z];
            print "            RULES[$z] = $r\n" if $verbose;
            foreach my $w (0..$#$r) {
                my $rr = $r->[$w];
                print "              RULES[$z][$w] = $rr\n" if $verbose;
                while (my ($key, $value) = each(%$rr)) {
                    print "                RULES[$z][$w]{$key} = $value\n"
                        if $verbose;
                }

                my $action = $rr->{'ACTION'};
                foreach my $v (0..$#$action) {
                    my $a = $action->[$v];
                    print "                  ACTION[$v] = $a\n" if $verbose;
                }
            }
        }
    }
}
if (exists $ARGV[1]) {
    $f->dirty;
    $f->update;
    $f->out($ARGV[1]) and print "Wrote new font file to $ARGV[1]\n";
}
print "Done!\n";
$f->release;