#!/usr/bin/perl
#
# mktcapdir.pl
#
# Copyright: Shoji Matsumoto <shom@vinelinux.org>
# licence  : GPL
# version  : 0.5.4

$ALIASDIR="/usr/share/fonts/alias/TrueType/";
$ALTERSH = "/tmp/alter-$$.sh";

$SCALEALIAS=1;
# $SCALEALIAS=0;

$SLANT=0.21;

$ALIASDIR =~ s!/+$!!g;

%fnames=();

@slts = ("r", "i");
@wgts = ("medium", "bold");

%spcmap = ("prop", "p", "cell", "c", "mono", "m", "pcell", "p");
%wgtmap = ("medium", "m", "bold", "b");

$nofilecheck=0;

if (@ARGV < 2) {
    print "usage: mktcapdir [-v] [-q] [-ft] <Font Directory> "
	."<configfile1> [<configfile2> ..]\n";
    exit 1;
}

$quiet = 0;
$verbose = 0;
$forFt = 0;
while ( $ARGV[0] =~ /^-/ ) {
    if ( $ARGV[0] eq "-v" ) {
	$verbose++;
    } elsif ( $ARGV[0] eq "-q" ) {
	$quiet = 1;
    } elsif ( $ARGV[0] eq "-ft" ) {
	$forFt = 1;
    } else {
	print "unknown option $ARGV[0]\n";
	exit 1;
    }
    shift @ARGV;
}

$DIR = $ARGV[0];
if ($DIR !~ /^\//) {
    $PWD = `pwd`;
    chomp($PWD);
    $DIR = "$PWD/$DIR";
}
$DIR =~ s!/[^/]+/\.\./!!g;
$DIR =~ s!/\.!!g;
$DIR =~ s!//!/!g;
$DIR =~ s!/$!!g;

if ( ! -d $DIR ) {
    die "directory $DIR is not found.\n";
}

shift;

while (@ARGV) {

    open (IN, $ARGV[0]) || die "can't open $ARGV[0]\n";
    if ($verbose > 0) {
	print "\nTTFCONF: $ARGV[0]\n";
    }

    if ( -f "$ARGV[0]" . ".alias" ) {
	if ($verbose > 0) {
	    print "\nTTFCONF.ALIAS: $ARGV[0]\n";
	}
	open(AIN, "< $ARGV[0].alias");
	while(<AIN>) {
	    if (/^\#/ || /^$/ ) { next; }
	    s/\t/ /g;
	    ($head, $dummy, $pxl, $spc, $enc, $ent) =
		/^\"?(-[^-]+-[^-]+-[^-]+-[^-]+-[^-]+)-([^-]+)?-(\d+)-\d+-\d+-\d+-(.)-\d+-([^-]+-[^\"-]+)\"?\s+\"?([^\"]+)\"?$/;

	    $res = 75; # 75dpi
	    # $dpt = int( ($pxl+0.49) * 722.7 / $res ) ;
	    $dpt = int( $pxl * 722.7 / $res + 0.5 ) ;
if (0) {
	    if ( $enc =~ /jisx0208/ ) {
		$dw = $dpt;
	    } elsif ( $enc =~ /jisx0201/ ) {
		$dw = int($dpt / 2);
	    } else {
		$dw = int($pxl * 0.75 * 10);
	    }
}
	    $aliaslines .= "\"$head-$dummy-$pxl-$dpt-$res-$res-$spc-$dw-$enc\" \"$ent\"\n";
	}
	close(AIN);
    }

    while(<IN>) {

	if ( /^\#/ || /^\s*$/ ) { next; }
	chomp;
	
	if (/^(outer)?alias\t/) {
	    ($dummy, $alias, $entity, $priority, $spc) = split('\t');

	    if ( $dummy eq "alias" && ! exists($entityexists{$entity}) ) {
		if ( $verbose > 1) {
		    print "ALIAS ENTITY IS NOT FOUND: $entity\n";
		}
		next;
	    }
	    if ( $dummy eq "outeralias") {
		if ( $verbose > 0) {
		    print "ALIAS OUTER: $alias for $entity is not checked.\n";
		}
		
		($fndry, $fmly, $enc) = $entity =~ /^([^-]+)-([^-]+)-(.*)$/;
		
		foreach $slt (@slts) {
		    foreach $wgt (@wgts) {
			$xlfd = "-$fndry-$fmly-$wgt-$slt-normal--"
			    ."0-0-0-0-$spc-0-$enc";
			$outerxlfds{$xlfd} = "outer";
			push(@xlfds, $xlfd);
		    }
		}
	    }

	    if ( exists($entities{$alias})) {
		$entities{$alias} .= ",$priority,$entity";
	    } else {
		$entities{$alias} = "$priority,$entity";
 	    }
	    next;
	    
	}
	
	($fndry, $fmly, $encs, $orgspc) = split('\t');

	if (exists($spcmap{$orgspc})) {
	    $spc = $spcmap{$orgspc};
	} else {
	    die "\"$fndry-$fmly\" spacing \"$orgspc\" is invalid.\n";
	}
	
	foreach $slt (@slts) {
	    foreach $wgt (@wgts) {
		
		$line = <IN>;
		while( $line =~ /^\#/ || $line =~ /^\s*$/ ) {
		    $line = <IN>;
		}
		chomp($line);
		
		($dummy, $fname, $addtcap) = split("\t", $line);
		if ($fname eq "--") { next; }
		
		foreach $enc (split(",", $encs)) {
		    
		    @cap = ();
		    if ($addtcap ne "") {
			push(@cap, $addtcap);
		    }
		    $realfname = $fname;
		    if ($fname =~ /^\((.*)\)$/) {
			$realfname = $1;
			if ($wgt eq "bold")    { push(@cap, "ds=y"); }
			if ($slt eq "i"   )    { push(@cap, "ai=$SLANT"); }
			# if ($orgspc eq "prop") { push(@cap, "fs=p"); }
			if ($orgspc eq "pcell") { push(@cap, "fs=c"); }
		    }

		    if ($nofilecheck != 1 && ! -f "$DIR/$realfname") {

			$fnames{$realfname} = 0;

			if ($verbose > 1) {
			    print "NOT FOUND:$. $DIR/$realfname\n";
			}

		    } else {

			if ($verbose > 1) {
			    print "FOUND:$. $DIR/$realfname\n";
			}

			if ( grep(/^cr=/, @cap) != 0 ) {
			    if ($enc =~ /^(iso8859-1|jisx0201\.)/) {
				push (@cap, "cr=0x20-0xff");
			    } elsif ($enc =~ /^(jisx0208|ksc5601|gb2312)\./) {
				push (@cap, "cr=0x2100-0x7dff");
			    } elsif ($enc =~ /^iso10646-/) {
				push (@cap, "cr=0x0100-0xfffe");
			    }
			}

			$fnames{$realfname} = 1;
			push (@cap, $realfname);

			$xlfd = 
			    "-$fndry-$fmly-$wgt-$slt-normal--0-0-0-0-$spc-0-$enc";
			$tcap = join (":", @cap);
			@allcap = split(":", $tcap);
			if ($forFt == 1) {
			    @face = grep(/^fn=/, @allcap);
			    @gen = grep (/^(ai=|ds=y)/, @allcap);
			    if ( @gen == 0 || 1) {
				$facenum = null;
				($facenum) = $face[0] =~ /^fn=(\d+)$/;
				if ( $facenum ) {
				    $tcap = ":$facenum:$cap[-1]";
				} else {
				    $tcap = "$cap[-1]";
				}
			    } else {
				# dummy entry...
				$tcap = "$cap[-1]";
			    }
			} 

			push (@ret, "$tcap $xlfd");
			push (@xlfds, $xlfd);
			$entityexists{"$fndry-$fmly-$enc"} = 1;
			
			if ( exists $files{$xlfd} || $tcaps{$xlfd}) {
			    print STDERR "WARNING: $xlfd is duplicated\n";
			}
			$files{"$xlfd"} = $realfname;
			$tcaps{"$xlfd"} = $tcap;
		    }
		}
	    }
	}
    }
    close(IN);

    shift;
}

if ($verbose > 1) {
    foreach $alias (keys(%entities)) {
	print "ENTITIES: $alias : $entities{$alias}\n";
    }
}

open(FONTSDIR, "> $DIR/fonts.dir") || die "cannot write to $DIR/fonts.dir";
print FONTSDIR scalar(@ret) . "\n";
print FONTSDIR join("\n", @ret);
print FONTSDIR "\n";
close(FONTSDIR);

open(FONTSDIR, "$DIR/fonts.dir");
open(FONTSSCALE, "> $DIR/fonts.scale") || die "cannot write $DIR/fonts.scale";
while(<FONTSDIR>) { print FONTSSCALE $_; }
close(FONTSSCALE);
close(FONTSDIR);

$allcnt = 0;
$fndcnt = 0;
foreach $fname (keys(%fnames)) {
    $allcnt++;
    if ( $fnames{$fname} == 1 ) {
	$fndcnt++;
    } else {
	push(@notfound, $fname);
    }
}
if ($verbose > 0) {
    print "$fndcnt/$allcnt fonts found.\n";
    if (scalar(@notfound) > 0) {
	print "Not found: " . join(", ", sort(@notfound)) . "\n\n";
    }
}

if ( keys(%entities) == 0 ) { exit 0; }

open(ALTER, "> $ALTERSH") || die "cannot write to $ALTERSH";

print ALTER "#!/bin/sh\n";
foreach $aliasfile (glob("$ALIASDIR/*.ttf")){
    if (readlink($aliasfile) =~ m!^$DIR/[^/]+\.tt[fc]!i) {
	print ALTER "/bin/rm $aliasfile\n";
    }
}

open(FONTSALIAS, "> $DIR/fonts.alias") || die "cannot write to $DIR/fonts.alias";
open(TCAPALIAS, "> $DIR/fonts.alias.tcapdir");
print TCAPALIAS "GENERATED by mktcapdir - used aliases\n\n";

foreach $alias (keys(%entities)) {

    %entitylist = split(',', $entities{$alias});

    ($priority, @discard) = reverse(sort({$a <=> $b} keys(%entitylist)));

    if ($verbose > 0) {
	print "ALIAS: $alias \n";
	print "ALIAS: \tUSED: $priority : $entitylist{$priority}\n";
	foreach $i (@discard) {
	    print "ALIAS: \tDISC: $i : $entitylist{$i}\n";
	}
    }
    print TCAPALIAS "$alias\t$entitylist{$priority}\n";
    
    $entity = $entitylist{$priority};
    
    ($fndry, $fmly, $enc) 
	= $entity =~ /^([^-]+)-([^-]+)-([^-]+-[^-]+)$/;

    if ( $alias =~ /^([^-]+)-([^-]+)-([cmp])-([^-]+-[^-]+)$/ ) {
	$aliashasspc = 1;
	($nfndry, $nfmly, $aspc, $nenc) = ($1, $2, $3, $4);
    } else {
	$aliashasspc = 0;
	($nfndry, $nfmly, $nenc) 
	    = $alias =~ /^([^-]+)-([^-]+)-([^-]+-[^-]+)$/;
    }

    @lists = grep(/^-$fndry-$fmly-.*-$enc$/, @xlfds);
    
    foreach $xlfd (@lists) {

	( $body, $spc, $body2 ) = $xlfd =~ /^-$fndry-$fmly-(.*)-([cmp])-(\d+)-$enc$/;
	if ( $aliashasspc != 1 ) {
	    $aspc = $spc;
	}
	$alfd = "-$nfndry-$nfmly-$body-$aspc-$body2-$nenc";

	if ( ! exists($tcaps{$xlfd}) && ! exists($outerxlfds{$xlfd}) ) {
	    print STDERR "$xlfd is invalid (alias:$alfd)\n";
	    exit 1;
	}

	#print FONTSALIAS "\"$alfd\" \"$xlfd\"\n";
	$basealiasline = "\"$alfd\" \"$xlfd\"\n";

	if ($SCALEALIAS) {

	    $res = 75; # 75dpi
	    
	    #($style, $sizes) = $body =~ /(.*)-(\d+-\d+-\d+-\d+)-\d+/;
	    ($style, $sizes) = $body =~ /(.*)-(\d+-\d+-\d+-\d+)/;
	    foreach $pxl (10,12,14,16,20,24) {
		# $dpt = int( ($pxl+0.49) * 722.7 / $res ) ;
		$dpt = int( $pxl * 722.7 / $res + 0.5) ;
		$dpt2 = 5 * int($dpt / 5);
		# $dpt2 = $dpt;
if (0) {
		if ( $enc =~ /jisx0208/ ) {
		    $dw = $dpt;
		} elsif ( $enc =~ /jisx0201/ || ($ascp == "c")) {
		    $dw = int($dpt / 2);
		} else {
		    $dw = int($pxl * 0.75 * 10);
		}
		print FONTSALIAS 
		    "\"-$nfndry-$nfmly-$style-$pxl-${pxl}0-"
			."$res-$res-$aspc-0-$enc\" "
			    ."\"-$fndry-$fmly-$style-$pxl-$dpt-"
				."$res-$res-$spc-*-$enc\"\n";
} else {
		print FONTSALIAS 
		    "\"-$nfndry-$nfmly-$style-$pxl-$dpt2-"
			."$res-$res-$aspc-0-$enc\" "
			    ."\"-$fndry-$fmly-$style-$pxl-$dpt-"
				."$res-$res-$spc-*-$enc\"\n";
}
	    }
	}

	print FONTSALIAS $basealiasline;
	
	if ( $nfndry eq "alias" ) {
	    
	    ($wgt, $slt) = $body =~ /^(medium|bold)-([ri])-/;
	    $wgt = $wgtmap{$wgt};
	    
	    @tcap = split(":", $tcaps{$xlfd});
	    
	    if ( 0 == grep(/^(ai=|ds=y|ab=y)/, @tcap) 
		 && exists($files{$xlfd})) {
		
		@a = grep(/^fn=/, @tcap);
		$fn = "0";
		if (@a != 0) {
		    $fn = $a[-1];
		    $fn =~ s/^fn=//;
		}

		$line = "";
		$file = "$DIR/$files{$xlfd}";
		$afile = "$ALIASDIR/$nfmly-$wgt$slt-$nenc.tt";
		if ($file =~ /\.ttf$/i) {
		    $afile .= "f";
		} else {
		    $line .= "/bin/ln -sf $file ".$afile."f\n";
		    $afile .= "c:$fn.ttf";
		}
		$line .= "/bin/ln -sf $file $afile\n";
		$line =~ s|\./||g;
		$line =~ s|//|/|g;
		print ALTER $line;

		# %ttnames = ();
		# %psnames = ();
		# %styles = ();
		
		@lines = split("\n", `/usr/bin/ftdumpnames -e EUC-JP $file 2> /dev/null`);
		
		for ($i = 0; $i < @lines; $i++) {

    		    ($dummy, $face, $type, $plat, $dummy, $lang, $name) 
			= split("\t", $lines[$i]);

		    if ($plat eq "Microsoft" 
			&& $lang eq "English - United States" 
			&& "$fn" eq "$face") {
			
			$alfds{"$afile\t$face"} = $alfd;

			if ($type eq "TT") {
			    $ttnames{"$afile\t$face"} = $name;
			}
			if ($type eq "PS") {
			    $psnames{"$afile\t$face"} = $name;
			}
			if ($type eq "ST") {
			    $styles{"$afile\t$face"} = $name;
			}
		    }
		}
	    }
	}
    }
}

print ALTER "rm $ALTERSH\n";
close(ALTER);
print FONTSALIAS $aliaslines;
close(FONTSALIAS);
close(TCAPALIAS);

if (-f "$ALIASDIR/NAMES") {
    system("/bin/grep -v -e '^$ALIASDIR/[^/][^/]*\\.ttf' $ALIASDIR/NAMES "
	   . "> /tmp/NAMES.$$; /bin/mv /tmp/NAMES.$$ $ALIASDIR/NAMES");
}
open(TCAPALIASLIST, ">> $ALIASDIR/NAMES");
foreach $i (sort(keys(%ttnames))) {
    print TCAPALIASLIST "$i\t$ttnames{$i}\t$styles{$i}\t$psnames{$i}\t$alfds{$i}\n";
}
close(TCAPALIASLIST);

if ($verbose > 1) {
    print "-------------- update-alternatives -----------------\n";
    system("cat $ALTERSH");
    print "----------------------------------------------------\n";
}
system("/bin/sh $ALTERSH");
