#!/usr/bin/perl
## makenewjis.pl (Ver. 1.0.0)
## (C) 2003 Takeshi WATANABE <t-wata@dab.hi-ho.ne.jp>
########################################################################
##
## 約物の基本調整量 (全角単位)
##
$kanjiskip_plus = 0.05;
$kanjiskip_minus = 0.02;
##
## 変形比率 (-j : 字送り方向を拡大縮小、-g : 行送り方向を拡大縮小)
##
$scale = 1.0;
if ($ARGV[0] =~ /^\-([jg])(\d+)$/) {
    $ji = ($1 eq "j") ? 1 : 0;
    $scale = $2 / 1000.;
}
$yokofile = sprintf("ynewjis%s.pl", ($scale == 1.0 ? "" : $ARGV[0]));
$tatefile = sprintf("tnewjis%s.pl", ($scale == 1.0 ? "" : $ARGV[0]));
##
## 文字クラス
##
$kanji = $class = 0;
$char{$S_kakko  = ++$class} = '（';
$char{$E_kakko  = ++$class} = '）';
$char{$S_kagi   = ++$class} = '‘ “ 〔 ［ ｛ 〈 《 「 『 【';
$char{$E_kagi   = ++$class} = '’ ” 〕 ］ ｝ 〉 》 」 』 】';
$char{$cdot     = ++$class} = '・ ： ；';
$char{$comma    = ++$class} = '、 ，';
$char{$period   = ++$class} = '。 ．';
$char{$question = ++$class} = '？ ！';
$char{$dash     = ++$class} = '― … ‥';
$char{$zspc     = ++$class} = '　'; # 全角スペース
##
## 文字組み空き量設定
##   (規則の適応順序は重要なので、不用意に elsif の順は変えないように)
##
sub glue
{
    local($pre, $post) = @_;
    local($skip, $plus, $minus) = (0., $kanjiskip_plus, $kanjiskip_minus);

# 中点の前後
    if ($pre == $cdot || $post == $cdot) {
	if ($pre == $cdot && $post == $cdot) { # JIS X 4051 表2 より(意味なし)
	    $skip = .5;
	    $minus = .5;
	} elsif ($pre == $period) { # JIS X 4051 表2 より(意味なし)
	    $skip = .75;
	    $minus = .25;
	} else {
	    $skip = .25;
	    $plus /= 2.; # 前後に空きが入るので、調整量は半分ずつに
	    $minus = .25;
	}
    }
# 括弧の内側、句読点の前 (絶対空けない)
    elsif ($pre == $S_kakko || $pre == $S_kagi
	   || $post == $E_kakko || $post == $E_kagi
	   || $post == $comma || $post == $period) {
	$plus = 0.;
    }
# 句点の後
    elsif ($pre == $period) {
	$skip = .5;
	$minus = 0.; # 詰めない
    }
# 全角スペースの前後 (TeX ではあまり使わないと思うけど…)
    elsif ($pre == $zspc || $post == $zspc) {
	; # 下の規則に引っかからないように
    }
# 読点の後
    elsif ($pre == $comma) {
	$skip = .5;
	$minus = .25; # 四分アキまで
    }
# カギ括弧類の外側
    elsif ($pre == $E_kagi || $post == $S_kagi) {
	$skip = .5;
	$minus = .3125; # 八分アキまで…じゃなく、もうちょっと多めの空き
    }
# 丸括弧の外側
    elsif ($pre == $E_kakko || $post == $S_kakko) {
	$skip = .5;
	$minus = .5; # ベタまで
    }
# クエスチョンマーク等の前
    elsif ($post == $question) {
	$plus = 0.;
    }
# ダッシュの前後
    elsif ($pre == $dash || $post == $dash) {
	if ($pre == $dash && $post == $dash) {
	    return (); # 分離禁止
	} else {
	    $minus /= 2.; # ダッシュは文字枠一杯あるので詰まりにくく
	}
    }
    return ($skip, $plus, $minus);
}
##
## PLファイルに書き出し
##
open(YOKO, "> $yokofile") || die "cannot open file \'$yokofile\'.\n";
open(TATE, "> $tatefile") || die "cannot open file \'$tatefile\'.\n";
print YOKO "(DIRECTION YOKO)\n";
print TATE "(DIRECTION TATE)\n";
&output("(FAMILY KANJI)\n");
&output("(FACE F MRR)\n");
&output("(CODINGSCHEME TEX KANJI TEXT)\n");
&output("(DESIGNSIZE R 10.0)\n");
&output("(FONTDIMEN\n");
&output("  (SLANT R 0.0)\n");
&output("  (SPACE R 0.0)\n");
&output("  (STRETCH R %f)\n", $kanjiskip_plus);
&output("  (SHRINK R %f)\n", $kanjiskip_minus);
&output("  (XHEIGHT R %f)\n", ($ji ? 1.0 : $scale));
&output("  (QUAD R %f)\n", ($ji ? $scale : 1.0));
&output("  (EXTRASPACE R 0.25)\n");
&output("  (EXTRASTRETCH R 0.125)\n");
&output("  (EXTRASHRINK R 0.0675)\n");
&output("  )\n");
##
for ($i = 1; $i <= $class; $i++) {
    &output("(CHARSINTYPE D %d\n  %s\n  )\n", $i, $char{$i});
}
##
for ($i = 0; $i <= $class; $i++) {
    &output("(TYPE D %d\n", $i);
    if ($i == $kanji || $i == $question || $i == $dash || $i == $zspc) {
	&output("  (CHARWD R %f)\n", ($ji ? $scale : 1.0));
    } else {
	&output("  (CHARWD R %f)\n", ($ji ? $scale : 1.0) * 0.5);
    }
    printf YOKO "  (CHARHT R %f)\n", ($ji ? 1.0 : $scale) * 0.876;
    printf TATE "  (CHARHT R %f)\n", ($ji ? 1.0 : $scale) * 0.5;
    printf YOKO "  (CHARDP R %f)\n", ($ji ? 1.0 : $scale) * 0.124;
    printf TATE "  (CHARDP R %f)\n", ($ji ? 1.0 : $scale) * 0.5;
    &output("  )\n");
}
##
&output("(GLUEKERN\n");
for ($i = 0; $i <= $class; $i++) {
    &output("  (LABEL D %d)\n", $i);
    for ($j = 0; $j <= $class; $j++) {
	next if $i == $kanji && $j == $kanji; # \kanjiskip に任せる
	local(@_) = &glue($i, $j);
	if ($#_ < 0) {
	    &output("  (KRN  D %2d R 0.0)\n", $j);
	} else {
	    if ($ji) {
		@_ = ($_[0] * $scale, $_[1] * $scale, $_[2] * $scale);
	    }
	    &output("  (GLUE D %2d R %8.6f R %8.6f R %8.6f)\n", $j, @_);
	}
    }
    &output("  (STOP)\n");
}
&output("  )\n");
close YOKO;
close TATE;
exit;
##
sub output
{
    printf YOKO @_;
    printf TATE @_;
}
##EOF
