iso10646(unicode)のBDFフォントから、jisx0208またはjisx0201のBDFフォントを生成するスクリプト

bdfunicode2jis.pl

#!/usr/bin/perl
# make jisx0208 or jisx0201 BDF font file from iso10646(unicode) BDF font file.
use strict;
use warnings;
use Encode;

# from cp932_roundtrip
sub encode_ {
  my $unicode = $_[0];
  if (#(0xe000 <= $unicode && $unicode <= 0xf8ff) || # private use area
      (0xd800 <= $unicode && $unicode <= 0xdbff) || # high surrogate area
      (0xdc00 <= $unicode && $unicode <= 0xdfff)) {   # low surrogate area
    return -1;
  }

  my $inbuf = sprintf("%c%c", ($unicode >> 8) & 0xff, $unicode & 0xff);
  my $outbuf;
  eval {
    my $tmp = decode("UTF-16BE", $inbuf, Encode::FB_CROAK);
    die unless ($inbuf eq "");
    $outbuf = encode("CP932", $tmp, Encode::FB_CROAK);
    die unless ($tmp eq "");
  };
  return -1 if ($@);
  return -1 unless (length($outbuf) == 1 || length($outbuf) == 2);
  my $cp932 = 0;
  foreach my $p (unpack("C*", $outbuf)) {
    $cp932 = ($cp932 << 8) | $p;
  }
  return $cp932;
}

sub sjis2jis($) {
    my $x = $_[0];
    if (256 <= $x) {
	my $c1 = ($x >> 8) & 0xff;
	my $c2 = $x & 0xff;
	# http://examples.oreilly.com/cjkvinfo/perl/codeconv.pl
	$c1 -= 0x40 if $c1 >= 0xe0;
	$c2-- if $c2 >= 0x80;
	my $j1 = ($c1-0x81) * 2 + ($c2>=0x9e ? 1 : 0) + 0x21;
	my $j2 = ($c2 >= 0x9e ? $c2-0x9e : $c2-0x40) + 0x21;
	$x = $j1 * 256 + $j2;
    }
    return($x);
}

my $isank = 0;
my $inheader = 1;
my $chardata = "";
my $charcode;
my %chars;

if ($ARGV[0] eq '-a') { # make ANK(jisx0201) font
    shift(@ARGV);
    $isank = 1;
} # else make jisx0208 font

while(<>) {
    chomp;
    if (/^FONT\s+/i) {
	if ($isank) {
	    s|(\d+)(-iso10646-1)|int($1/2) . '-jisx0201.1976-0';|ie;
	} else {
	    s/iso10646-1/jisx0208.1990-0/i;
	}
    }
    elsif (/^CHARSET_REGISTRY\s+/) {
	if ($isank) {
	    s/iso10646/jisx0201.1976/i;
	} else {
	    s/iso10646/jisx0208.1990/i;
	}
    }
    elsif (/^CHARSET_ENCODING\s+/) {
	s/1/0/;
    }
    elsif (/^FONTBOUNDINGBOX\s+/ || /^AVERAGE_WIDTH\s+/) {
	if ($isank) {
	    s|(\d+)|int($1/2);|e;
	}
    }
    if (/^CHARS\s+/) {
	$inheader = 0;
	next;
    }
    if ($inheader) {
	print "$_\n";
	next;
    }

    if (/^ENCODING\s+(\d+)/) {
	$charcode = sjis2jis(encode_($1));
	$chardata = $chardata . "ENCODING $charcode\n";
	next;
    }
    if (/^ENDCHAR/) {
	if ($charcode > 0) {
	    if ($isank && $charcode <= 255 || !$isank && $charcode > 255) {
		$chardata = $chardata . $_ . "\n";
		$chars{$charcode} = $chardata;
	    }
	}
	$chardata = "";
	next;
    }
    if (!$inheader) {
	$chardata = $chardata . $_ . "\n";
    }
}

print "CHARS ", scalar(keys %chars), "\n";
for my $key (sort {$a <=> $b} keys %chars) {
    print $chars{$key};
}
print "ENDFONT\n";