#!/usr/bin/perl
## makeroman.pl (Ver. 1.0.0)
## (C) 2003 Takeshi WATANABE <t-wata@dab.hi-ho.ne.jp>
########################################################################
##
## フォント名を入力
##
$_ = &getline("font name> ");
$plname = sprintf("R-%s.pl", $_);
if (-f $plname) {
    die "\nERROR: $plname already exist!\n\n";
} elsif (! open(FILE, "> $plname")) {
    die "\nERROR: cannot open $plname\n\n";
}
print "\nPL file name is $plname\n\n";
##
## セリフかサンセリフかを入力
##
while (1) {
    $_ = &getline("0: serif, 1: sans-serif > ");
    last if /^[01]$/;
    print "\nERROR: input 0 or 1.\n\n";    
}
$serif = $_ ? 0 : 1;
##
## カーニング量を入力
##
while (1) {
    $_ = &getline("kerning size (ratio to %s)> ", $serif ? "cmr10" : "cmss10");
    last if /^\d+\.?\d*$/ || /^\.\d+$/;
    print "\nERROR: input a decimal number.\n\n";
}
$kernpar = $_ / 1633.;
##
## 仮想活字幅を入力
##
while (1) {
    print "\n";
    for ($i = 0x21; $i <= 0x7e; $i++) {
	if ($width{$i} eq "") {
	    $_ = &getline("%3d - ? ", $i);
	} else {
	    $_ = &getline("%3d - ? [%d] ", $i, $width{$i});
	    next if /^$/;
	}
	if (/^\/$/) {
	    print "\nInput again.\n\n";
	    $i-- if $i > 0x21;
	    redo;
	} elsif (/\D/ || $_ <= 0 || $_ >= 2000) {
	    print "\nERROR: width may be wrong.  Input again.\n\n";
	    redo;
	}
	$width{$i} = $_;
    }
    $_ = &getline("\nOK? (y/n)> ");
    last if /^y/i;
}
##
## PL ファイルを書き出し
##
print FILE "(FAMILY JAPANESE-ROMAN)\n";
print FILE "(FACE F MRR)\n";
print FILE "(DESIGNSIZE R 10.0)\n";
print FILE "(CODINGSCHEME ASCII)\n";
print FILE "(SEVENBITSAFEFLAG TRUE)\n";
print FILE "(FONTDIMEN\n";
print FILE "  (SLANT R 0.0)\n";
print FILE "  (SPACE R 0.333333)\n";
print FILE "  (STRETCH R 0.166667)\n";
print FILE "  (SHRINK R 0.083333)\n";
print FILE "  (XHEIGHT R 0.5)\n";
print FILE "  (QUAD R 1.0)\n";
print FILE "  (EXTRASPACE R 0.111111)\n";
print FILE "  )\n";
##
@kern = $serif ? &kern_serif : &kern_sans;
print FILE "(LIGTABLE\n";
for (@kern) {
    if (/^L(\d+)$/) {
	printf FILE "  (LABEL %s)\n", &label($1);
    } elsif (/^K(\d+)([\+\-]\d+)$/) {
	printf FILE "  (KRN %s R %9.6f)\n", &label($1), $2 * $kernpar;
    } elsif ($_ eq "S") {
	printf FILE "  (STOP)\n";
    }
}
print FILE "  )\n";
##
for ($i = 0x21; $i <= 0x7e; $i++) {
    printf FILE "(CHARACTER %s\n", &label($i);
    printf FILE "  (CHARWD R %5.3f)\n", $width{$i} / 1000.;
    printf FILE "  (CHARHT R 0.876)\n";
    printf FILE "  (CHARDP R 0.124)\n";
    printf FILE "  )\n";
}
close FILE;
exit;
##
sub getline
{
    printf @_;
    $_ = <STDIN>;
    s/\s*//g;
    $_;
}
##
sub label
{
    local($_) = @_;
    local($c) = pack("C", $_);
    if ($c =~ /^[0-9A-Za-z]$/) {
	sprintf("C %s", $c);
    } else {
	sprintf("O %o", $_);
    }
}
##
sub kern_serif
{
    (
     "L065", "K067-054", "K071-054", "K079-064",
     "K081-064", "K084-157", "K085-064", "K086-200", "K087-163",
     "K089-153", "S", "L068", "K065-054", "K086-054", "K087-047",
     "K089-064", "S", "L070", "K065-148", "K097-058", "K111-058", "S",
     "L075", "K079-047", "S", "L076", "K084-143", "K086-172",
     "K087-148", "K089-149", "S", "L079", "K065-051", "K086-061",
     "K087-051", "K088-054", "K089-061", "S", "L080", "K044-157",
     "K046-157", "K065-143", "K097-033", "S", "L082", "K079-054",
     "K084-115", "K085-054", "K086-154", "K087-128", "K089-120", "S",
     "L084", "K065-144", "K097-133", "K101-125", "K111-133",
     "K114-088", "K117-100", "K121-077", "S", "L086", "K065-200",
     "K071-033", "K079-054", "K097-157", "K101-157", "K111-169",
     "K117-129", "S", "L087", "K065-189", "K079-027", "K097-133",
     "K101-133", "K111-133", "K117-105", "S", "L089", "K065-163",
     "K097-149", "K101-149", "K111-156", "K117-157", "S", "L097",
     "K118-038", "K119-033", "S", "L098", "K118-033", "S", "L102",
     "K039+107", "S", "L104", "K121-019", "S", "L107", "K101-027",
     "K111-027", "S", "L110", "K118-054", "K121-033", "S", "L111",
     "K118-033", "K119-043", "L112", "K121-027", "S", "L118",
     "K097-061", "K101-033", "K111-038", "S", "L119", "K097-027",
     "K111-027", "S", "L121", "K044-120", "K046-120", "S"
     );
}
sub kern_sans
{
    (
     "L065", "K067-047", "K071-047", "K079-047",
     "K081-047", "K084-163", "K085-061", "K086-144", "K087-122",
     "K089-149", "S", "L068", "K065-054", "K086-072", "K087-054",
     "K089-082", "S", "L070", "K065-133", "K097-061", "K101-047",
     "K111-047", "K114-058", "S", "L075", "K079-061", "S", "L076",
     "K084-156", "K086-181", "K087-144", "K089-176", "S", "L079",
     "K065-038", "K086-061", "K087-047", "K088-067", "K089-072", "S",
     "L080", "K044-200", "K046-200", "K065-163", "K097-054",
     "K101-061", "K111-061", "S", "L084", "K065-163", "K097-163",
     "K101-163", "K111-163", "K114-163", "K117-163", "K121-163", "S",
     "L086", "K065-133", "K071-054", "K079-054", "K097-072",
     "K101-077", "K111-077", "K117-072", "S", "L087", "K065-105",
     "K079-038", "K097-054", "K101-047", "K111-047", "K117-047", "S",
     "L089", "K065-156", "K097-176", "K101-176", "K111-176",
     "K117-156", "S", "L097", "K119-038", "K121-047", "S", "L098",
     "K121-038", "S", "L102", "K039+096", "S", "L111", "K119-033",
     "K120-047", "L112", "K121-047", "S", "L119", "K097-033",
     "K101-027", "K111-027", "S", "L121", "K044-149", "K046-149",
     "K097-038", "L107", "K101-038", "K111-038", "S",
     );
}
##EOF
