#!/usr/bin/perl -w
use warnings;
use strict;
use File::Copy;

### Initialisation

# all global vars
my ($TeXRoot, $FontDir, $SourceDir, $SourceName, $TargetStem, $TargetName);
my ($Vendor, $Collection, $Class, $Encoding);
my (%Font, %Classes);
my ($counter, $map_status, $script_status);

# to be solved more sophisticated:
$Classes{rm}	= "serif";
$Classes{ss}	= "sans";
$Classes{tt}	= "mono";
$Classes{mm}	= "math";
$Classes{hw}	= "handwriting";
$Classes{serif}	= "rm";
$Classes{sans}	= "ss";
$Classes{mono}	= "tt";
$Classes{math}	= "mm";
$Classes{handwriting}	= "hw";

$Encoding = "texnansi"; # use this as source for typescript file

# hardcoded install directory texmf-var!
(!$ENV{TEXMF}) && ($ENV{TEXMF} = "/usr/TeX/texmf"); # default on MacOSX...
$TeXRoot = $ENV{TEXMF}."-var";
$FontDir = $TeXRoot."/fonts";

### Test command line arguments

(@ARGV == 4) or (help());
($SourceDir, $Vendor, $Collection, $Class) = @ARGV;
(-d $SourceDir) or die "'$SourceDir' is no valid directory!";

$Class = lc($Class);
(defined $Classes{$Class}) or die "Font class '$Class' ist not defined!";
(length($Class) == 2) && ($Class = $Classes{$Class}); # expand long class name

print "Font Installing Helper for ConTeXt\tcopyleft 2002 Henning Hraban Ramm\n\n";
print "Installing '$Class' font '$Collection' by '$Vendor' from directory '$SourceDir'...\n\n";


### Copy files

print "Copy font files from $SourceDir to $FontDir...\n";
opendir (DIR, $SourceDir)	or die "Can't open dir $SourceDir: ".$!;
while (my $myfile = readdir(DIR)) {
	if ($myfile =~ m/\.(afm|pfa|pfb)$/i) { # font files
		print "copy ".lc($myfile)."\n";
		copy( "$SourceDir/$myfile", "$FontDir/".lc($myfile) ); # copy lowercase
	} # if datei
} # while
closedir DIR;


### read and fix AFMs (newer Linotype AFMs contain overlong lines that confuse some TeX tools)

chdir($FontDir);
system("chmod 666 *.afm");

opendir (DIR, $FontDir)					or die "Can't open dir $FontDir: ".$!;
while (my $myfile = readdir(DIR)) {
	if ((-f $myfile) && ($myfile =~ m/\.afm$/i)) {
		print $myfile."\n";
		open (FILE, "+<$myfile")	or die "Open: ".$!;
		my @File = <FILE>;
		my ($FontName, $Weight, $Italic) = ($myfile, "", 0);
		foreach (@File) {
			my $s;
			if (length($_) > 250) {
				print "Line has ".length($_)." characters and gets truncated.\n";
				$_ = substr($_, 0, 250)."\n";
			} # if length
			(m/^FontName/)	&& (($s, $FontName) = split /\s/);
			(m/^Weight/)	&& (($s, $Weight) = split /\s/);
			(m/^ItalicAngle/) && (($s, $Italic) = split /\s/);
		} # foreach line
		if (($Italic != 0) || ($Weight =~ m/(Ita|Obl|Cur)/i)){ # normally negative angle for italics
			$Italic = "Italic";
		} else {
			$Italic = "";
		} # Italic
		print "$FontName claims to be $Weight $Italic\n";
		($Weight =~ m/(Rom|Med|Norm|Reg)/i) && ($Weight = "");
		$Font{$FontName} = $Weight.$Italic;
		seek(FILE,0,0)				or die "Seek: ".$!;
		print FILE @File			or die "Print: ".$!;
		truncate(FILE,tell(FILE))	or die "Trunc: ".$!;
		close FILE					or die "Close: ".$!;
	} # if
} # while
closedir DIR;

### call ConTeXt's texfont.pl for three encodings

foreach (qw(texnansi ec 8r)) { # 
	system("perl $TeXRoot/context/perltk/texfont.pl --ve=$Vendor --co=$Collection --fo=$TeXRoot --in --ma --en=$_"); #--show
#	system("perl $TeXRoot/context/perltk/texexec.pl $_-$Vendor-$Collection --mode=compact");
} # foreach encoding


### create typescript

# test sourcefile by texfont.pl
$SourceName = "$Encoding-$Vendor-$Collection.tex";
(!-f $SourceName)	&& (die "Can't find file $SourceName, can't create typescript file!\n");

# create new output file name
$TargetStem = "type-$Vendor-$Collection";
$TargetName = $TargetStem.".tex";
$counter = 0;
while (-f $TargetName) { # create unique output name (add running number)
	$counter++;
	$TargetName = $TargetStem."-".$counter.".tex";
} # while

open (SOURCE, $SourceName) or die "Can't open source file $SourceName: $!";

open (TARGET, ">".$TargetName) or die "Can't make file $TargetName: $!";
print TARGET <<"ENDHEADER";
\%
\% Typescript for $Class family $Vendor $Collection
\% written by $0 (copyleft Henning Hraban Ramm)
\%
\% Check the $Class --> $Collection mapping! Weights from the AFM are often wrong!
\% You should also adapt the last typescript to make a nice family.
\%
\% Write in your TeX file something like:
\% \\usetypescriptfile\t[$TargetStem]
\% \\usetypescript\t[my][$Vendor-$Collection]
\% \\setupbodyfont\t[$Vendor-$Collection, $Classes{$Class}, 12pt]
\% \\setupbodyfontenvironment\t[default]\t[em=italic]
\% ($0 supports no slanted fonts, but they are default in ConTeXt)


ENDHEADER

while (my $line = <SOURCE>) {
	
	$line =~ s/$Encoding/\\defaultencoding/gi;
	$line =~ s/\[/\t[/g;	# tab in front of each left square brace
	$line = "\t".$line;
	
	if (($line =~ m/\\loadmapfile/i) && (!$map_status)) {
		$map_status = 1;
		print TARGET "\% load mapfile\n";
		print TARGET "\\starttypescript\t[map]\t[\\defaultencoding]\n";
		print TARGET $line;
		print TARGET "\\stoptypescript\n\n";
	} # if loadmapmapfile
	
	if (($line =~ m/\\definefontsynonym/i) && (!$script_status)) {
		$script_status = 1;
		print TARGET "\% $Class $Vendor $Collection\n";
		print TARGET "\\starttypescript\t[$Class]\t[$Collection]\t[\\defaultencoding]\n";
	} # if 
		
	if ($script_status) {
		if ($line =~ m/\\stoptyping/i) {
			$script_status = 0;
			print TARGET "\\stoptypescript\n\n";
		} else {
			print TARGET $line;
		} # if else
	} # if definefontsynonym
	
} # while SOURCE

print TARGET "\% $Class $Collection\n";
print TARGET "\\starttypescript\t[$Class]\t[$Collection]\t[name]\n";
foreach (sort keys %Font) {
	my $pseudofont = ucfirst($Class).$Font{$_};
	print TARGET "\t\\definefontsynonym\t[$pseudofont]\t[$_]\n";
} # foreach font
print TARGET "\\stoptypescript\n\n";

print TARGET "\% sample family definition\n";
print TARGET "\\starttypescript\t[my]\t[$Vendor-$Collection]\n";

foreach (qw(serif sans mono)) {
	if (m/$Class/i) {
		TypeFaceLine($_, $Collection);
	} else {
		TypeFaceLine($_, "default");
	} # if else
} # foreach
($Class =~ m/hand/) && (TypeFaceLine("handwriting", $Collection));
TypeFaceLine("math", "default");

print TARGET "\\stoptypescript\n\n";

close TARGET;
close SOURCE;

### end of typescript

system("perl $TeXRoot/context/perltk/texutil.pl --purge"); # cleanup temp files
system("mktexlsr"); # rebuild lsR database

system("rm *.afm");
system("rm *.pfb");
#system("rm *.pfa");
# move("*.pdf", "$TeXRoot/tex/context/sample/");
move("*.tex", "$TeXRoot/tex/context/sample/");

############# THE END ###################

###
sub TypeFaceLine {
###
	my ($class, $name) = @_;
	my $short = $Classes{$class};
	print TARGET "\t\\definetypeface\t[$Vendor-$Collection]\t";
	print TARGET "[$short]\t[$class]\t[$name]\t";
	print TARGET "[default]\t[encoding=\\defaultencoding]\n";
} # sub TypeFaceLine;


###
sub help {
###
	print <<"ENDHELP";

$0 -- copyleft 2002 Henning Hraban Ramm, hraban\@fiee.net
font installing helper for ConTeXt

Parameter: Sourcedir Vendor Collection Class
Example:   ./palat   adobe  palatino   serif

Copies *.afm, *.pfa, *.pfb lowercase from ./palat to texmf-var,
fixes overlong AFM lines, installs fonts with ConTeXt's texfont.pl
for encodings texnansi, ec and 8r,
writes a typescript file "type-adobe-palatino.tex".
Class may be serif, sans or mono

For more help about ConTeXt and fonts see mtexfont.pdf (www.pragma-ade.com)

ENDHELP
	exit();
} # sub help