#!/usr/local/bin/perl
#
# MakeTeXTFM.pl version 1.0, Copyright (C) 1993,94 by Norman Walsh.
# NO WARRANTY.  Distribute freely under the GNU GPL.
#
# This script attempts to make a new TeX TFM file, because one wasn't
# found.  The only argument is the name of the TFM file, such as
# `cmr10.tfm' (*NOT* just `cmr10').
#
# This script was designed with two goals in mind: to support recursive
# subdirectory searching for fonts and to provide support for PK files
# built from both MF fonts and PS fonts.  It also supports the Sauter
# and DC fonts which can be built at any design size.
#
# This script was designed and tested with the following directory structure
# in mind: each typeface is stored in its own directory with appropriate
# subdirectories for font sources, metrics, and glyphs.  The script may not
# work exactly right if you use a different directory structure (the font
# installation, in particular, will probably be incorrect).  However,
# several other versions of MakeTeXPK exist which will handle simpler
# directory structures, so you need not feel compelled to use the one
# described here.
#
# For MF fonts: (... is usually something like /usr/local/lib/tex/fonts)
#
# .../typeface/src          holds the sources
#             /tfm          holds the TFM files
#             /glyphs       root for glyphs
#             /glyphs/mode  holds the PK files for "mode".
#
# For PS fonts: (... is usually something like /usr/local/lib/tex/fonts)
#
# .../typeface/afm          holds the AFM files
#             /tfm          holds the TFM files
#             /vf           holds the VF files
#             /vpl          holds the VPL files
#             /glyphs       root for glyphs
#             /glyphs/pk/999dpi  holds the PK files at 999 dpi created by ps2pk
#             /glpyhs/type1 holds the type1 PFA/PFB sources for the fonts
#
# The TFM files constructed for PostScript fonts are mapped to the Old TeX
# encoding.
#

require "getopts.pl";
$rc = &Getopts ('v');           # Get options from the user...

$VERBOSE = $opt_v || $ENV{"DEBUG_MAKETEXPK"}; # Verbose?

chop($CWD = `pwd`);             # Where are we?
$TEMPDIR = "/tmp/mkPK.$$";      # Where do temp files go?
$MFBASE = "&plain";             # What MF base do we use by default?

# Where are fonts stored?
$TEXFONTS = $ENV{"TEXFONTS"} || ".:/usr/local/lib/fonts//";

# Define modes that should be used for base resolutions...
$DPI_MODES{300}  = "laserwriter";
$DPI_MODES{200}  = "FAX";
$DPI_MODES{360}  = "lqhires";
$DPI_MODES{400}  = "nexthi";
$DPI_MODES{600}  = "QMSmoa";
$DPI_MODES{100}  = "nextscreen";

$DPI_MODES{100}  = "videodisplayi";
$DPI_MODES{110}  = "videodisplayii";
$DPI_MODES{118}  = "videodisplayiii";
$DPI_MODES{120}  = "videodisplayiv";
$DPI_MODES{124}  = "videodisplayv";
$DPI_MODES{130}  = "videodisplayvi";
$DPI_MODES{140}  = "videodisplayvii";
$DPI_MODES{150}  = "videodisplayviii";

$DPI_MODES{72}   = "MacTrueSize";
$DPI_MODES{635}  = "linolo";
$DPI_MODES{1270} = "linohi";
$DPI_MODES{2540} = "linosuper";

# Where are the DC fonts stored and what base names can be used?
$DCR_DIR = '/usr/local/lib/fonts/free/dc/src';
@DCR_GEN = ('dcb','dcbom','dcbx','dcbxsl','dcbxti','dccsc','dcdunh','dcff',
           'dcfi','dcfib','dcitt','dcr','dcsl','dcsltt','dcss','dcssbx',
           'dcssi','dctcsc','dcti','dctt','dcu','dcvtt' );

# Where are the Sauter fonts stored and what base names can be used?
$SAUTER_DIR = '/usr/local/lib/fonts/free/sauter/src';
@SAUTER_GEN = ('cmb','cmbizx','cmbozx','cmbsy','cmbszx','cmbx','cmbxsl',
              'cmbxti', 'cmbz', 'cmbzx', 'cmcsc', 'cmdszc', 'cmdunh',
              'cmex', 'cmff', 'cmfi', 'cmfib', 'cminch', 'cmitt', 'cmmi',
              'cmmib', 'cmr', 'cmrcz', 'cmrisz', 'cmritz', 'cmriz',
              'cmrotz', 'cmroz', 'cmrsz', 'cmrtz', 'cmruz', 'cmrz',
              'cmsl', 'cmsltt', 'cmss', 'cmssbx', 'cmssdc', 'cmssi',
              'cmssq', 'cmssqi', 'cmsy', 'cmtcsc', 'cmtex', 'cmti',
              'cmtt', 'cmu', 'cmvtt', 'czinch', 'czssq', 'czssqi',
              'lasy', 'lasyb');

$SAUTER_ROUNDING{11} = '10.954451';
$SAUTER_ROUNDING{14} = '14.4';
$SAUTER_ROUNDING{17} = '17.28';
$SAUTER_ROUNDING{20} = '20.736';
$SAUTER_ROUNDING{25} = '24.8832';
$SAUTER_ROUNDING{30} = '29.8685984';

open (TTY, ">/dev/tty");
select (TTY); $| = 1; select(STDOUT);

$tfmFile = @ARGV[0];
if (!$tfmFile) {
   print TTY "$0 error: No TFM file specified.\n";
   die "\n";
}

print TTY "\nAttempting to build TFM file: $tfmFile.\n";

# This is the *wierdest* bug I've ever seen.  When this script is called
# by virtex to build a TFM file, the argument (as interpreted by Perl)
# has (at least one) ASCII 16 attached to the end of the argument.  This
# loop removes all control characters from the $tfmFile name string...
$tfmFile =~ /(.)$/;
$char = ord ($1);
while ($char <= 32) {
   $tfmFile = $`;
   $tfmFile =~ /(.)$/;
   $char = ord ($1);
}

# Now we know the name of the TFM file.  Next, get the name of the MF file
# and the base name and size of the MF file.

($mfFile = $tfmFile) =~ s/\.tfm$//;
$mfFile =~ /^(.*[^0-9])(\d+)$/;
$mfBase = $1;
$mfSize = $2;

# Presumably, we got here because the TFM file doesn't exist.  Let's look
# for the MF file or the AFM file...

$tfmSource = &find_fonts($TEXFONTS, ("$mfFile.mf", "$mfFile.afm"));

if ($tfmSource) {
   if ($tfmSource =~ /\.afm$/) {
       print TTY "Building $tfmFile from AFM source.\n";
       &make_and_cd_tempdir();
       &make_from_afm($tfmSource);
   } elsif ($tfmSource =~ /\.mf$/) {
       local($fpath, $fname);
       print TTY "Building $tfmFile from MF source.\n";
       &make_and_cd_tempdir();

       if ($tfmSource =~ /^(.*)\/([^\/]*)$/) {
           $fpath = $1;
           $fname = $2;

           $fpath = $CWD if $fpath eq ".";
           $fpath = "$CWD/.." if $fpath eq "..";
       } else {
           $fpath = "";
           $fname = $tfmSource;
       }

       &make_from_mf($fpath, $fname);
   } else {
       print TTY "$0: Cannot build $tfmFile.\n";
       print TTY " " x length($0), "  Unprepared for $tfmSource.\n";
       die "\n";
   }
} else {
   if (grep(/^$mfBase$/, @DCR_GEN)) {

       print TTY "Building $tfmFile from DC source.\n";

       &make_and_cd_tempdir();

       $MFBASE = "&dxbase";
       open (MFFILE, ">$mfFile.mf");
       print MFFILE "gensize:=$mfSize; generate $mfBase;\n";
       close (MFFILE);

       &make_from_mf("$DCR_DIR","$mfFile.mf");

   } elsif (grep(/^$mfBase$/, @SAUTER_GEN)) {

       print TTY "Building $tfmFile from Sauter source.\n";

       &make_and_cd_tempdir();

       if (defined($SAUTER_ROUNDING{$mfSize})) {
           $designSize = $SAUTER_ROUNDING{$mfSize};
       } else {
           $designSize = $mfSize;
       }

       open (MFFILE, ">$mfFile.mf");
       print MFFILE "design_size := $designSize;\n";
       print MFFILE "input b-$mfBase;\n";
       close (MFFILE);

       &make_from_mf("$SAUTER_DIR","$mfFile.mf");

   } else {
       print TTY "$0: Cannot build $tfmFile.  Can't find source.\n";
       die "\n";
   }
}

&cleanup();

exit 0;

sub run {
   local(@cmd) = @_;
   local($rc);

   open  (SAVEOUT, ">&STDOUT");
   open  (SAVEERR, ">&STDERR");
   close (STDOUT);
   open  (STDOUT, ">&TTY");
   close (STDERR);
   open  (STDERR, ">&TTY");

   # Chdir seems to return a funny exit code.  So do it internally...
   # (this is a hack)
   if (@cmd[0] eq "chdir") {
       $rc = chdir(@cmd[1]);
       $rc = !$rc;
   } else {
       $rc = system(@cmd);
   }

   close (STDOUT);
   open  (STDOUT, ">&SAVEOUT");
   close (SAVEOUT);

   close (STDERR);
   open  (STDERR, ">&SAVEERR");
   close (SAVEERR);

   if ($rc) {
       printf TTY "%s\n", "*" x 72;
       print  TTY "MakeTeXTFM error : system return code: $rc\n";
       print  TTY "MakeTeXTFM failed: @cmd\n";
       printf TTY "%s\n", "*" x 72;
   }

   $rc;
}

sub make_and_cd_tempdir {
   &run ("mkdir", "$TEMPDIR");
   &run ("chdir", "$TEMPDIR");
}

sub cleanup {
   &run ("chdir", "$CWD");
   &run ("rm", "-rf", "$TEMPDIR");
}

sub install_font {
   local($source_path, $font, $subdir) = @_;
   local(@paths) = split(/:|;/,$ENV{"TEXFONTS"});
   local($target) = "";
   local($ptarget);

   if (!$target && $source_path =~ /\/src$/) {
       $ptarget = $source_path;
       $ptarget =~ s/(.*)\/src$/$1/;
       $ptarget .= "/$subdir";
       $target = $ptarget if (-d $ptarget && -w $ptarget);
   }

   if (!$target && $source_path =~ /\/afm$/) {
       $ptarget = $source_path;
       $ptarget =~ s/(.*)\/afm$/$1/;
       $ptarget .= "/$subdir";
       $target = $ptarget if (-d $ptarget && -w $ptarget);
   }

   if (!$target && ($source_path eq $CWD)) {
       $target = $source_path;
   }

   while (!$target && ($ptarget = shift @paths)) {
       $target = $ptarget if ($ptarget ne "." && $ptarget ne ".."
                              && -d $ptarget && -w $ptarget);
   }

   if ($target) {
       print TTY "Installing $font in $target.\n";
       &run ("cp", "$font", "$target/fonttmp.$$");
       &run ("chdir", "$target");
       &run ("mv", "fonttmp.$$", "$font");
       &run ("chmod", "a+r", "$font");
       &run ("chdir", "$TEMPDIR");
       print STDOUT "$target/$font\n";
   } else {
       print TTY "$0: Install failed: no where to put $font.\n";
   }
}

sub make_from_mf {
   local ($source_path, $source_file) = @_;
   local ($mfsource, $mfinputs, $cmd);

   &run ("chdir", "$TEMPDIR");

   if (!$source_file) {
       $mfsource = $source_path;
       ($source_path = $mfsource) =~ s#/[^/]*$##;
       ($source_file = $mfsource) =~ s#^.*/([^/]*)$#$1#;
   }

   $mfinputs = $ENV{"MFINPUTS"};
   $mfinputs =~ s/^:*(.*):*$/$1/ if $mfinputs;
   $ENV{"MFINPUTS"} = ".:$source_path";
   $ENV{"MFINPUTS"} .= ":$mfinputs" if $mfinputs;

   print "MFINPUTS: $ENV{MFINPUTS}\n" if $VERBOSE;

   $cmd = "$MFBASE \\mode:=laserwriter; scrollmode; \\input $source_file";
   print TTY "virmf $cmd\n";

   $saveTERM = $ENV{"TERM"};
   $saveDISPLAY = $ENV{"DISPLAY"};
   delete $ENV{"DISPLAY"};
   $ENV{"TERM"} = "vt100";

   $rc = &run ("virmf", "$cmd");

   $ENV{"DISPLAY"} = $saveDISPLAY;
   $ENV{"TERM"} = $saveTERM;

   &install_font($source_path, $tfmFile, 'tfm');
}

sub make_from_afm {
   local ($afmFile) = @_;
   local ($source_path);

   print TTY "afm2tfm $afmFile -v $mfFile ${mfFile}0\n";
   $rc = &run ("afm2tfm", "$afmFile", "-v", "$mfFile", "${mfFile}0");

   print TTY "vptovf $mfFile.vpl $mfFile.vf $mfFile.tfm\n";
   $rc = &run ("vptovf", "$mfFile.vpl", "$mfFile.vf", "$mfFile.tfm");

   ($source_path = $afmFile) =~ s#/[^/]*$##;
   &install_font($source_path, "$mfFile.tfm", 'tfm');
   &install_font($source_path, "${mfFile}0.tfm", 'tfm');
   &install_font($source_path, "$mfFile.vpl", 'vpl');
   &install_font($source_path, "$mfFile.vf", 'vf');
}

sub find_fonts {
   local($path, @fonts) = @_;
   local(@dirs, $dir, $font);
   local(@matches) = ();
   local(@recursive_matches);

   print "Find fonts on path: $path\n" if $VERBOSE;

   @dirs = split(/:|;/, $path);
   while ($dir = shift @dirs) {
       print "Search: $dir\n" if $VERBOSE;
       if ($dir =~ /\/\//) {
           @recursive_matches = &recursive_search($dir, @fonts);
           push (@matches, @recursive_matches)
               if @recursive_matches;
       } else {
           $dir =~ s/\/*$//;           # remove trailing /, if present
           foreach $font (@fonts) {
               push (@matches, "$dir/$font")
                   if -f "$dir/$font";
           }
       }
   }

   $font = shift @matches;

   if (@matches) {
       print TTY "$0: Found more than one match.\n";
       print TTY " " x length($0), "  Using: $font\n";
   }

   $font;
}

sub recursive_search {
   local($dir, @fonts) = @_;
   local(@matches) = ();
   local(@dirstack, $rootdir, $font, $fontmask);

   $dir =~ /^(.*)\/\/(.*)$/;
   $rootdir = $1;
   $fontmask = $2;

   $rootdir =~ s/\/*$//;               # remove trailing /'s

   # Note: this perl script has to scan them all, the mask is meaningless.
   # Especially since I'm looking for the font *source* not the TFM or
   # PK file...

   $fontmask =~ s/\$MAKETEX_BASE_DPI/$BDPI/g;
   $fontmask =~ s/\$MAKETEX_MAG/$MAG/g;
   $fontmask =~ s/\$MAKETEX_MODE/$MODE/g;

   print "Search root=$rootdir\n" if $VERBOSE;
   print "Search mask=$fontmask (ignored by $0)\n" if $VERBOSE;

   @dirstack = ($rootdir);

   while ($rootdir = shift @dirstack) {
       opendir (SEARCHDIR, "$rootdir");
       while ($dir = scalar(readdir(SEARCHDIR))) {
           if ($dir ne "." && $dir ne ".." && -d "$rootdir/$dir") {
               push(@dirstack, "$rootdir/$dir");
               foreach $font (@fonts) {
                   if (-f "$rootdir/$dir/$font") {
                       print "Matched: $rootdir/$dir/$font\n" if $VERBOSE;
                       push(@matches, "$rootdir/$dir/$font");
                   }
               }
           }
       }
       closedir (SEARCHDIR);
   }

   @matches;
}

You are viewing proxied material from ftp.icm.edu.pl. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.