mkttfdirでTrueTypeフォント用のfonts.dirを作ると、X-TTで実現できるイタリックやボールドまでは作ってくれない。しょうがないのでへたくそなスクリプトで対処。

#!/usr/bin/perl
system("mkttfdir");
push @style, ("medium-r", "bold-r", "medium-i", "bold-i");
@lang = ("iso8859-1", "jisx0201.1976-0", "jisx0208.1983-0", "jisx0212.1990-0");
$size = "-0-0-0-0-c-0";

open(FDIR, "<fonts.dir");
@fdir = <FDIR>;
close(FDIR);

foreach $fdir(@fdir)
{
    if ($fdir =~ /iso8859-1$/)
    {
	@tmp = split(/ /, $fdir);
	$file = shift @tmp;
	$name = join (" ", @tmp);
	@tmp = ();
	if ($file !~ /^bw=/ )
	{
	    push (@output, $fdir);
	    #print $fdir;
	    next;
	}
	@tmp = split(/:/, $file);
	$filename = $tmp[$#tmp];
	
	$name =~ s/^-//;
	@tmp = split(/-/, $name);
	$vender = $tmp[0];
	$fontname = $tmp[1];
	    foreach $lang(@lang)
	    {
		foreach $style(@style)
		{
		    $cap = &getcap;
#		    if ($lang eq 'iso8859-1')
#		    {
#			$cap =~ s/^bw=0.5://;
#			$cap =~ s/-c-/-p-/;
#		    }
		    push @output, sprintf ("%s%s -%s-%s-%s-normal-%s-%s\n",
					   $cap, $filename,
					   $vender, $fontname, $style, 
					   $size, $lang);
		}
	    }
    }
}

$lines = $#output + 1;
open (FDIR,">fonts.dir");
print FDIR "$lines\n";
#print FDIR sort @output;
print FDIR @output;
close(FDIR);
exit;

sub getcap
{
    my @cap;
    my $cap;
    if ($lang eq 'iso8859-1' || $lang eq 'jisx0201.1976-0')
    {
	push @cap, "bw=0.5:";
    }
    if ($style =~ /^bold/)
    {
	push @cap, "ds=y:";
    }
    if ($style =~ /-i$/ )
    {
	push @cap, "ai=0.5:";
    }
    foreach $tmp(@cap)
    {
	$cap = "$cap$tmp";
    }
    $cap =~ s/::/:/g;
    $cap =~ s/^://;
    return ($cap);
}

いちおうこれでイタリックやボールドも作れた……が、mkttfdirに頼り切ってる当たりが情けない。ホントはmkttfdirをhackすべきなんだろうけどなあ。
(@713)