#!/usr/bin/perl
## makezenvf.pl (Ver. 1.0.0)
## (C) 2003 Takeshi WATANABE <t-wata@dab.hi-ho.ne.jp>
########################################################################
## 以下、hscale の方は出来るだけ 5% 刻みに。
##
## 全体に縮小する文字 (%fscale に比率をセット)
##
$fscale{'@'} = .9;
$fscale{'#'} = $fscale{'+'} = .8;
$fscale{'<'} = $fscale{'>'} = $fscale{"`"} = .75;
$fscale{','} = $fscale{'.'} = $fscale{':'} = $fscale{';'} = .7;
$fscale{'*'} = .45;
$fscale{'~'} = .4;
##
## 横方向にだけ縮小する文字 (%hscale に比率をセット)
##
$hscale{'0'} = $hscale{'1'} = $hscale{'2'} = $hscale{'3'} = $hscale{'4'} = .95;
$hscale{'5'} = $hscale{'6'} = $hscale{'7'} = $hscale{'8'} = $hscale{'9'} = .95;
$hscale{'-'} = .9;
$hscale{'"'} = .8;
$hscale{'_'} = .5;
##
## 縦横異なる比率で縮小する文字  (縦は fscale、横は fscale × hscale になる)
##
$fscale{'('} = $fscale{')'} = .92;
$hscale{'('} = $hscale{')'} = .95;
#
$fscale{'?'} = .95;
$hscale{'?'} = .9;
#
$fscale{"'"} = .8;
$hscale{"'"} = .8;
#
$fscale{'='} = $fscale{'['} = $fscale{']'} = .95;
$hscale{'='} = $hscale{'['} = $hscale{']'} = .85;
#
$fscale{'!'} = .95;
$hscale{'!'} = .75;
#
$fscale{'/'} = .86;
$hscale{'/'} = .6;
##
## 括弧類の内側を少し詰める
##
$kakkotsume = .02;
##
## 上下に位置をずらす文字 (%rise に比率をセット)
##
$rise{'-'} = -.13;
$rise{'_'} = .05;
$rise{'"'} = .1;
$rise{"'"} = .15;
$rise{'~'} = .25;
$rise{'*'} = .3;
########################################################################
##
## フォントを定義
##
@fntsize = (1.0); # フォントサイズ
@fntxtnd = (1.0); # ExtendFont のパラメータ
for ($i = 0x21; $i <= 0x7e; $i++) {
    $ch = pack("C", $i);
    $fscale{$ch} = 1.0 unless $fscale{$ch};
    $hscale{$ch} = 1.0 unless $hscale{$ch};
    for ($j = 0; $j <= $#fntsize; $j++) {
	if ($fscale{$ch} == $fntsize[$j] && $hscale{$ch} == $fntxtnd[$j]) {
	    $fontid{$ch} = $j;
	    last;
	}
    }
    if ($j > $#fntsize) { # 新しいフォント定義が必要
	push(@fntsize, $fscale{$ch});
	push(@fntxtnd, $hscale{$ch});
	$fontid{$ch} = $#fntsize;
    }
}
$zw = 1 * (1<<20); # 全角幅
##
## メイン・ルーチン
##
if ($#ARGV < 0) {
    &readpl(STDIN);
    &writevf("ryumin-l");
}
for $file (@ARGV) {
    if ($file =~ /^R-(.*)\.pl$/) {
	$fname = $1;
    } else {
	print STDERR "ERROR: $_: file name should be 'R-*.pl' ... skipped!\n";
	next;
    }
    open(IN, $file) || die "ERROR: cannot open '$file'.\n";
    &readpl(IN);
    close IN;
    &writevf($fname);
}
exit;
##
## PL ファイルから文字幅情報を読む
##
sub readpl
{
    local($file) = @_;
    local($ch, $_);
    undef @width;
    $extend = 1.0;
    while (<$file>) {
	if (/\(QUAD\s*R\s*([\+\-]?\d*\.?\d*)/) {
	    $extend = $1;
	} elsif (/\(CHARACTER\s*C\s*(.)/) {
	    $ch = unpack("C", $1);
	} elsif (/\(CHARACTER\s*O\s*(\d+)/) {
	    $ch = oct($1);
	} elsif (/\(CHARACTER\s*D\s*(\d+)/) {
	    $ch = $1;
	} elsif (/\(CHARWD\s*R\s*([\+\-]?\d*\.?\d*)/) {
	    $width[$ch] = $1;
	}
    }
}
##
## VF ファイルを書き出し
##
sub writevf
{
    local($fname) = @_;
    local($vfname) = $fname;
    local($i, $code, $_);
#
    open(OUT, sprintf("> R-%s.vf", $fname))
	|| die sprintf("ERROR: cannot open 'R-%s.vf'.\n", $fname);
    &putnum(247, 1); # PRE
    &putnum(202, 1); # ID
    &putnum(0, 1); # comment size
    &putnum(0, 4); # TFM check sum
    &putnum(10*(1<<20), 4); # TFM design size
    $vfname =~ s/^J\d+\-//;
    for ($i = 0; $i <= $#fntsize; $i++) {
	local($vfont);
	$vfont = sprintf("H%s-%s", &permil($fntxtnd[$i] * $extend), $vfname);
	&putnum(243, 1); # FNT_DEF1
	&putnum($i, 1); # Font ID
	&putnum(0, 4); # TFM check sum
	&putnum($zw * $fntsize[$i], 4); # font design size (scaled)
	&putnum(10*(1<<20), 4); # font design size
	&putnum(0, 1); # directory length
	&putnum(length($vfont), 1); # fontname length
	print OUT $vfont; # directory + fontname
    }
#
    for ($code = 0x21; $code <= 0x7e; $code++) {
	local($hskip, $vskip);
	local($ch) = pack("C", $code);
	local($fw) = $zw * $fscale{$ch} * $hscale{$ch} * $extend;
	local($w) = &round($width[$code] * (1<<20));
	if ($ch =~ /^[\"\'\)\,\.\]\}]$/) { # 終わり括弧類
	    $hskip = -($fw * $kakkotsume);
	} elsif ($ch =~ /[\(\[\{]$/) { # 始め括弧類
	    $hskip = -($fw * (1. - $kakkotsume) - $w);
	} else {
	    $hskip = -($fw - $w) / 2;
	}
	if ($ch =~ /^[\,\.\:\;]$/) { # ベースライン揃え
	    $vskip = -$rise{$ch} * (1<<20);
	} else { # センター揃え
	    $vskip = -($rise{$ch} + .376 * (1. - $fscale{$ch})) * (1<<20);
	}
#
	local($command) = "";
	if ($hskip) {
	    local($_) = &dimtostr($hskip);
	    $command .= pack("C", 142+length($_)); # RIGHT
	    $command .= $_;
	}
	if ($vskip) {
	    local($_) = &dimtostr($vskip);
	    $command .= pack("C", 156+length($_)); # DOWN
	    $command .= $_;
	}
	if ($fontid{$ch}) {
	    $command .= pack("C", 171+$fontid{$ch}); # FNTNUM
	}
	$command .= pack("C", 129); # SET2
	$command .= &zenkaku($ch);
#
	if (length($command) < 242) {
	    &putnum(length($command), 1); # length
	    &putnum($code, 1); # char code
	    &putnum($w, 3); # char width
	} else {
	    &putnum(242, 1); # LONG_CHAR
	    &putnum(length($command), 4); # length
	    &putnum($code, 4); # char code
	    &putnum($w, 4); # char width
	}
	print OUT $command;
    }
    $_ = tell(OUT);
    for ($i = 0 ; $i < 4 - ($_ % 4); $i++) {
	&putnum(248, 1); # POST
    }
    close OUT;
}
##
sub round
{
    local($_) = @_;
    # 計算誤差を防ぐため、0.5 より微妙に上で四捨五入する
    $_ >= 0 ? int($_ + .50000001) : -int(-$_ + .50000001);
}
##
sub zenkaku
{
    local($ch) = @_;
    local($_) = "*ItpsuGJKv\\\$>%?" . ("\0" x 10) . "\'(cad)w"
	. ("\0" x 26) . "NoO02." . ("\0" x 26) . "PCQA";
    if ($ch =~ /^[0-9A-Za-z]$/) {
	$vch = "#" . $ch;
    } else {
	$vch = "!" . substr($_, ord($ch) - 0x21, 1);
    }
    $vch;
}
##
sub putnum
{
    local($num, $byte) = @_;
    local($i, $_);
    for ($i = 0; $i < $byte; $i++) {
	$_ = pack("C", $num & 0xff) . $_;
	$num >>= 8;
    }
    print OUT;
}
##
sub dimtostr
{
    local($dim) = @_;
    local($str);
    while (1) {
	local($_) = $dim & 0xff;
	$str = pack("C", $_) . $str;
	$dim >>= 8;
	if ($_ <= 127) {
	    last if $dim == 0;
	} else {
	    last if $dim == 0xff || $dim == 0xffff || $dim == 0xffffff;
	}
    }
    $str;
}
##
sub permil
{
    local($_) = @_;
    # 計算誤差を防ぐため、0.5 より微妙に上で四捨五入する
    $_ = sprintf("%d", int($_ * 1000 + .50000001));
    if ($_ eq "1000") {
	$_ = "";
    }
    $_;
}
##EOF
