summaryrefslogtreecommitdiff
path: root/Build/source/texk/xdvik/t1mapper
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2006-01-17 21:41:51 +0000
committerKarl Berry <karl@freefriends.org>2006-01-17 21:41:51 +0000
commit487ca4806cc046076293cf6cc5fbba0db282bac7 (patch)
tree847b412ab5158dd7bdd7ed7e5a4cc3fbca94be32 /Build/source/texk/xdvik/t1mapper
parenta3d3111bfe26b8e5f5bc6049dfb2a4ca2edc7881 (diff)
texk 1
git-svn-id: svn://tug.org/texlive/trunk@1485 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Build/source/texk/xdvik/t1mapper')
-rwxr-xr-xBuild/source/texk/xdvik/t1mapper433
1 files changed, 433 insertions, 0 deletions
diff --git a/Build/source/texk/xdvik/t1mapper b/Build/source/texk/xdvik/t1mapper
new file mode 100755
index 00000000000..7562e090131
--- /dev/null
+++ b/Build/source/texk/xdvik/t1mapper
@@ -0,0 +1,433 @@
+#!/usr/bin/perl -w
+#
+# This program maps full PS font names to abreviated TeX style names
+# and puts font files or links to font files in a file hierarchy
+# suitable for texk.
+#
+# Mapping example: Times-Roman.{gsf,pfa,pfb} becomes ptmr.{pfa,pfb}
+#
+
+use File::Path;
+
+# These are the fontname map files to read
+
+# This is for the fontname distribution in teTeX 0.4:
+# @fonts=qw(adobe apple bitstrea dtc linotype monotype skey1250 skey1555
+# softkey urw);
+
+# This is for fontname 2.2, get it from ftp.tug.org:/tex/fontname-2.2
+# The linotype map in teTeX 1.0 is terebly corrupted. Removed from the list.
+
+@fonts=qw(adobe apple bitstrea dtc monotype softkey-1250
+ softkey-1555 urw wolfram yandy);
+
+$logname="t1mapper.log";
+
+# How much to read from font files to figure out the font name
+$fontdatalen=1024*10;
+
+# use $TMPDIR if set by user
+if (defined($ENV{TMPDIR})) {
+ $tempdir=$ENV{TMPDIR};
+}
+else {
+ $tempdir="/tmp";
+}
+
+# HERE BE DRAGONS
+
+usage() if $#ARGV==0;
+
+# By default copy files
+$method=1;
+
+while ($_=shift(@ARGV)) {
+ /^-cp$/ && do { $method=1; next; };
+ /^-ln$/ && do { $method=2; next; };
+ /^-lns$/ && do { $method=3; next; };
+ /^-lnlns$/ && do { $method=4; next; };
+ /^-lncp$/ && do { $method=5; next; };
+ /^-gs$/ && do {
+ $gsmap = shift(@ARGV) or usage();
+ $gsdir = shift(@ARGV) or usage();
+ next;
+ };
+ unshift(@ARGV,$_);
+ last;
+}
+
+$texdir = shift(@ARGV) or usage();
+
+if (! -d $texdir) {
+ print "Making directory $texdir\n";
+ mkpath($texdir) or die "Could not make directory: $texdir: $!\n";
+}
+
+if (!open(LOG,">$logname")) {
+ $logname="$tempdir/$logname";
+ open(LOG,">$logname") ||
+ die "Could not open file $logname for writing: $!\n";
+}
+
+# What major mode of operation?
+
+# Establish fonts based on ghostscript map?
+if ($gsmap) {
+ process_gsfonts();
+ print "Log in $logname\n";
+ exit 0;
+}
+
+# Ok, loop examine fonts to figure out the font name and copy/link to $texdir
+
+process_fontname_maps();
+process_fonts();
+print "Log in $logname\n";
+
+exit 0;
+
+# ############################### MOVE_FONT ################################
+
+sub move_font {
+ # Move font to destination directory, according to specified $method
+ my($from)=shift;
+ my($to)=shift;
+ my($relok)=shift;
+
+ my($other); # Same font, other format
+ my($type); # Other type
+
+ die "I need absolute paths please\n"
+ if !$relok && substr($from,0,1) ne '/';
+
+ logmsg("$from -> $to\n");
+
+ # Remove the old font to replace with this
+ unlink($to) if -f $to;
+
+ # Also remove the old font in the other format:
+ $other=$to;
+ $type='.pfb' if substr($to,-4) eq '.pfa';
+ $type='.pfa' if !$type && substr($to,-4) eq '.pfb';
+ substr($other,-4)=$type;
+
+ unlink($other) if -f $other;
+
+ if ($method==1) {
+ # cp
+ system "cp $from $to 2>/dev/null" and # Shell exit value
+ warn "Copying $from to $to failed\n";
+ } elsif ($method==2) {
+ # ln
+ link($from,$to) or
+ die "Linking of $to to $from failed: $!\n";
+ } elsif ($method==3) {
+ # lns
+ symlink($from,$to) or
+ die "Symlinking $to to $from failed: $!\n";
+ } elsif ($method==4) {
+ # lnlns
+ link($from,$to) ||
+ symlink($from,$to) ||
+ die "Both linking and symlinking $to to $from failed: $!\n";
+ } elsif ($method==5) {
+ # lncp. Let cp give the error-message
+ link($from,$to) || system "cp $from $to";
+ } else {
+ die "Internal error: Unknown font copy/link method\n";
+ }
+}
+
+# ############################# PROCESS_FONTS ##############################
+
+sub process_fonts {
+ # Loop over ARGV, examine each (font?) file to see if it is a
+ # type1 font, binary or text format, and figure out it's name
+ my($type,$font);
+
+ foreach $filename (@ARGV) {
+ ($type,$font)=examine_font($filename);
+
+ next if !defined($font);
+
+ if (!exists($file{$font})) {
+ logmsg("TeX name of $font ($filename) unknown\n");
+ next;
+ }
+
+ $file=$file{$font};
+ move_font($filename,"$texdir/$file$type",0);
+ }
+}
+
+# ############################## EXAMINE_FONT ##############################
+
+sub examine_font {
+ # Examine font to determine name and type
+ #
+ # The method for finding the font name is based on an awk script
+ # written years ago by Kjetil T. Homme and me (mostly him).
+ #
+ my($filename)=shift;
+ my($type);
+
+ my($size)=-s $filename;
+
+ if ($size==0) {
+ logmsg("Zero size file skipped: $filename\n");
+ return (undef,undef);
+ }
+
+ if (!open(FONT,"< $filename")) {
+ logmsg("Unable to open $filename for reading: $!\n");
+ return (undef,undef);
+ }
+
+ sysread FONT, $fontdata, $fontdatalen, 0;
+
+ # Determine type based on magic number
+ $type='.pfa' if substr($fontdata,0,16) eq '%!PS-AdobeFont-1';
+ $type='.pfa' if !$type && substr($fontdata,0,13) eq '%!FontType1-1';
+ $type='.pfb' if !$type && substr($fontdata,6,16) eq '%!PS-AdobeFont-1';
+
+ if (!$type) {
+ # This is where we end up if the file does not match the magic
+ # numbers. The file is most probably not a type1 file.
+
+ if ((index($fontdata,'%!PS-AdobeFont-1')==-1) &&
+ (index($fontdata,'%!FontType1-1')==-1)) {
+ # If the string '%!PS-AdobeFont-1.0' or '%!FontType1-1.0'
+ # does not appear at all this is NOT a type1 font of any
+ # kind.
+ logmsg("$filename is not a type1 file\n");
+ return (undef,undef);
+ }
+
+ logmsg("Odd magic in $filename\n");
+
+ # Try to determine type based on filename extention
+ $type='.pfa' if substr($filename,-4) eq '.pfa';
+ $type='.pfb' if !$type && substr($filename,-4) eq '.pfb';
+
+ if (!$type) {
+ # No extention? Fall back to perls -T (text) test operator.
+ $type='.pfb';
+ $type='.pfa' if -T $filename;
+ }
+ }
+
+ # The font type has now been determined. I wonder what the font's
+ # name is.
+
+ # What we look for is lines like this:
+ #
+ # %!PS-AdobeFont-1.0: URWGothicL-Demi 001.005
+ #
+ # or this:
+ #
+ # /FontName /URWGothicL-Demi def
+
+ $fontname='';
+
+ if ($fontdata =~ m~/FontName /([\S]+) def~) {
+ # The /FontName line is the most reliable source
+ $fontname = $1;
+ } elsif ($fontdata =~ m/%\!PS-AdobeFont-1.0: ([\S]+)/) {
+ # The magic line is not always fully formed and can only be
+ # used as fallback --- in case the /FontName entry is not in
+ # the file. True, this would be a rather dubious font.
+ $fontname = $1;
+ } elsif ($fontdata =~ m/%\!FontType1-1.0: ([\S]+)/) {
+ # The magic line is not always fully (or correctly) formed and
+ # can only be used as fallback --- in case the /FontName entry
+ # is not in the file. True, this would be a rather dubious
+ # font (actually, a lot of type1 versions of tex fonts fall
+ # into this category).
+ $fontname = $1;
+ }
+
+ return ($type,$fontname);
+}
+
+# ######################### PROCESS_FONTNAME_MAPS ##########################
+
+sub process_fontname_maps {
+ # Read the fontname maps
+
+ while ($foundry=shift(@fonts)) {
+ $map=findfile($foundry.".map");
+ next unless $map;
+ print "Reading (fontname/$foundry) $map\n";
+ open(FILE,"<$map") || die "Could not open $map: $!\n";
+ while (<FILE>) {
+ chomp;
+ s/@.*//;
+ next if $_ eq '';
+ ($file,$font,undef)=split(/\s+/,$_,3);
+ # Remove known encoding codes:
+ $file =~ s/(8a|8r|8t)$//;
+ # 8a = StandardEncoding 8a.enc
+ # 8r = TeXBase1Encoding 8r.enc
+ # 8t = CorkEncoding cork.enc
+ # Any filenames with numbers left are 'unknown encodings'
+ if ($file =~ /\d/) {
+ # print "Unknown encoding: $file - $font\n";
+ next;
+ }
+ $file{$font}=$file;
+ }
+ close(FILE);
+ }
+}
+
+# ########################### PROCESS_GSFONTS #############################
+
+sub read_gsmap {
+ # Read gs map file to obtain Font-Name -> filename mappings, and
+ # aliases so we can use GS' Times-Roman replacement as Times-Roman
+ # ourselves. Not everyone has oodles of type1 fonts on disk.
+
+ my($gsmap)=shift;
+
+ open(FILE,"<$gsmap") or die "Could not open $gsmap: $!\n";
+
+ print "Reading (gsmap) $gsmap\n";
+
+ %gsalias=();
+ %gsfile=();
+
+ while (<FILE>) {
+ chomp;
+ s/%.*//;
+ s/\s+$//;
+ next if $_ eq '';
+
+ ($font,$file,undef)=split(/\s+/,$_,3);
+
+ $font =~ s~^/~~;
+
+ if (!exists($file{$font})) {
+ logmsg("TeX name of $font unknown\n");
+ next;
+ }
+
+ if ($file =~ m~\((.*)\)~) {
+ $file = $1;
+ $gsfile{$font}=$file;
+ } else {
+ $file =~ s~^/~~;
+ # The aliases(sp?) cannot be resolved until the whole file is
+ # read
+ $gsalias{$font}=$file;
+ }
+
+ }
+
+ close(FILE);
+}
+
+
+sub process_gsfonts {
+ # Do the Work based on a ghostscript map file.
+
+ process_fontname_maps();
+ read_gsmap($gsmap);
+
+ chdir($gsdir) or die "Could not chdir to $gsdir: $!\n";
+
+ print "Moving fonts\n";
+
+ foreach $font (keys %gsfile) {
+ $gsfile=$gsfile{$font};
+ # GSF files are not propper t1 fonts I understand, so ignore them
+ next if $gsfile =~ /\.gsf$/;
+ $file=$file{$font};
+ $type='';
+
+ if (-f $gsfile) {
+
+ # Crude font type guessing. First based on existing extention:
+ $type='pfa' if substr($gsfile,-4) eq '.pfa';
+ $type='pfb' if !$type && substr($gsfile,-4) eq '.pfb';
+
+ # If existing extention fails use perls -T (text) test
+ if (!$type) {
+ # print "Fallback typing: $gsfile\n";
+ $type='pfb';
+ $type='pfa' if -T $gsfile;
+ }
+
+ # Use for alias resolving
+ $texname{$font}="$file.$type";
+
+ if (substr($gsfile,0,1) eq '/') {
+ move_font("$gsfile","$texdir/".$texname{$font},0);
+ } else {
+ move_font("$gsdir/$gsfile","$texdir/".$texname{$font},0);
+ }
+
+ } else {
+ logmsg("$file not found\n");
+ }
+ }
+
+ chdir($texdir) or die "Could not chdir to $texdir\n";
+
+ foreach $font (keys %gsalias) {
+ $alias = $gsalias{$font};
+ $falias = $texname{$alias};
+ next unless $falias;
+
+ $type='pfa' if substr($gsfile,-4) eq '.pfa';
+ $type='pfb' if !$type && substr($gsfile,-4) eq '.pfb';
+
+ $file=$file{$font};
+
+ # Symlink the aliases
+ logmsg("$falias -> $file.$type\n");
+ $method=3;
+ move_font($falias,"$file.$type",1);
+ }
+}
+
+
+# ############################ JUNK PROCEDURES ###########################
+
+sub findfile {
+ # Find file, use kpsewhich to access texmf database and search rules
+
+ my($file)=shift;
+ $fileloc=`kpsewhich $file`;
+
+ # Check errors
+ return undef if ($? != 0);
+ chomp($fileloc);
+ return undef if $fileloc eq '';
+
+ # It worked
+ return $fileloc;
+}
+
+sub usage {
+ # Abuse the user
+ print
+"Usage: t1mapper [-cp|-ln|-lns|-lnlns|-lncp] \\
+ -gs /path/to/gs/Fontmap /path/to/gs/fonts \\
+ /path/to/target/tex/directory
+
+ t1mapper [-cp|-ln|-lns|-lnlns|-lncp] \\
+ /path/to/target/tex/directory \\
+ <font-file-list>
+
+See t1mapper(1) for more documentation
+
+";
+ exit 1;
+}
+
+sub logmsg {
+ my($string)=shift;
+
+ print STDERR "$string";
+ print LOG "$string";
+}