#!/usr/local/bin/perl
#
# MakeTeXPK.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 PK font, because one wasn't
# found.  Parameters are:
#
# name dpi bdpi [[[magnification] mode] subdir]
#
# `name'   is the name of the font, such as `cmr10' (*NOT* cmr10.mf).
# `dpi'    is the resolution the font is needed at.
# `bdpi'   is the base resolution, useful for figuring out the mode to
#          make the font in.
# `magnification' is a string to pass to MF as the magnification.
# `mode'   if supplied, is the mode to use.
#
# 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
#

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

$USE_MODE_IN_DEST = 1;          # Does the destination directory name include
                               # the name of the mode?

$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';

# Get the command line arguments...
($NAME, $DPI, $BDPI, $MAG, $MODE, $FORCEDEST, $EXTRA) = @ARGV;

open (TTY, ">/dev/tty");              # Open the TTY (so we can print messages
select (TTY); $| = 1; select(STDOUT); # even if STDERR and STDOUT are both
                                     # redirected)

if ($VERBOSE) {
   print TTY "$0: font name: $NAME\n";
   print TTY "$0: dpi: $DPI\n";
   print TTY "$0: base dpi: $BDPI\n";
   print TTY "$0: magnification: $MAG\n" if $MAG;
   print TTY "$0: mode: $MODE\n" if $MODE;
   print TTY "$0: force destination directory: $FORCEDEST\n" if $FORCEDEST;
   print TTY "$0: extra: $EXTRA\n" if $EXTRA;
}

# Make sure we got enough arguments, but not too many...
die "$0: Invalid arguments.\n" if ($BDPI eq "" || $EXTRA ne "");

# Calculate the magnification from the requested resolutions if no
# magnification string was provided.
if (!$MAG) {
   $MAG = "$DPI/$BDPI";
   print TTY "$0: magnification: $MAG\n" if $VERBOSE;
}

# Calculate the mode if the mode was not given.  Die if we don't know
# what mode to use for the requested base resolution.
if ($MODE eq "") {
   $MODE = $DPI_MODES{$BDPI};
   die "$0: No mode for ${BDPI}dpi base resolution.\n" if $MODE eq "";
   print TTY "$0: mode: $MODE\n" if $VERBOSE;
}

########################################################################

# Really start the work...
print TTY "Attempting to build PK file for: $NAME at ${DPI}dpi.\n";

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

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

#   ... it's more complicated than that...

# If the font is from a PFA/B file, it may have the name "rxxx" or
# "xxx0" because virtual fonts extract glyphs from the "raw" font.
# We need to find the PFA/B file and install the font with the right name.
# I'm not sure what the best solution would really be, but this will work.
# Luckily, it gets installed with the right name 'cause we already
# figured that out...
#
# A better solution on Unix machines might be to make "xxx0.pfa" or
# "rxxx.pfa" a symbolic link to "xxx.pfa".  But that won't work for other
# architectures...

$t1source = "";
$t1source = $1 if $mfFile =~ /^r(.*)$/;
$t1source = $1 if $mfFile =~ /^(.*)0$/ && ($t1source eq "");

if ($t1source) {
   $fontSource = &find_fonts($TEXFONTS,
                             ("$mfFile.mf", "$mfFile.pfa", "$mfFile.pfb",
                              "$t1source.pfa", "$t1source.pfb"));
} else {
   $fontSource = &find_fonts($TEXFONTS,
                             ("$mfFile.mf", "$mfFile.pfa", "$mfFile.pfb"));
}

if ($fontSource) {
   if ($fontSource =~ /\.pfa$/ || $fontSource =~ /\.pfb$/) {
       print TTY "Building PK file from PostScript source.\n";
       &make_and_cd_tempdir();
       &make_from_ps($fontSource);
   } elsif ($fontSource =~ /\.mf$/) {
       local($fpath, $fname);
       print TTY "Building PK file from MF source.\n";
       &make_and_cd_tempdir();

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

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

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

       print TTY "Building PK file 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 PK file 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 PK file.  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 "$0 error : system return code: $rc\n";
       print  TTY "$0 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, $mode) = @_;
   local($pkdirs, @paths, $ptarget);
   local($target) = "";

   if ($VERBOSE) {
       print "Install: source_path: $source_path\n";
       print "Install: font       : $font\n";
       print "Install: subdir     : $subdir\n";
       print "Install: mode       : $mode\n";
   }

   $pkdirs = $ENV{"TEXPKS"} || $ENV{"PKFONTS"} || "";
   @paths = split(/:|;/,$pkdirs);

   # Need to find an installable target for the PK files.  Try
   # ../glyphs/$subdir and ../$subdir then give up and use the best $pkdirs
   # path...

   if (!$target) {
       ($ptarget = $source_path) =~ s#/[^/]*$##;
       $target = "$ptarget/glyphs/$subdir"
           if -d "$ptarget/glyphs/$subdir"
               || (-d "$ptarget/glyphs"
                   && -w "$ptarget/glyphs"
                   && ! -f "$ptarget/glyphs/$subdir");
   }

   if (!$target) {
       ($ptarget = $source_path) =~ s#/[^/]*$##;
       $target = "$ptarget/$subdir"
           if -d "$ptarget/$subdir"
               || (-d $ptarget && -w $ptarget && ! -f "$ptarget/$subdir");

       # what a minute, suppose we just made a font in the current
       # directory...let's put the PK file there too...
       if (! -d "$target" && ($source_path eq $CWD)) {
           $target = $source_path;
           $USE_MODE_IN_DEST = 0;
       }
   }

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

   if ($target) {
       if (! -d $target) {
           &run ("mkdir", "$target");
           &run ("chmod", "777", "$target");
       }

       if ($USE_MODE_IN_DEST) {
           $target .= "/$mode";
           if (! -d $target) {
               &run ("mkdir", "$target");
               &run ("chmod", "777", "$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);
   local ($gfname, $pkname, $realdpi, $testdpi);
   local ($cmpath);

   print "source_path: $source_path\n" if $VERBOSE;
   print "source_file: $source_file\n" if $VERBOSE;

   &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;

   $cmpath = "/usr/local/lib/fonts/free/cm/src";
   if (-d $cmpath && $ENV{"MFINPUTS"} !~ /$cmpath/) {
       $ENV{"MFINPUTS"} .= ":$cmpath";
   }

   $cmd = "$MFBASE \\mode:=$MODE; mag:=$MAG; 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;

   $realdpi = $DPI;
   $gfname = "./$mfFile.${realdpi}gf";

   for ($testdpi = $realdpi-2; $testdpi < $realdpi+3; $testdpi++) {
       $gfname = "./$mfFile.${testdpi}gf", $realdpi = $testdpi
           if ! -f $gfname && -f "./$mfFile.${testdpi}gf";
   }

   $gfname = "./$mfFile.${realdpi}gf";
   $pkname = "./$mfFile.${realdpi}pk";

   $rc = &run ("gftopk", "$gfname", "$pkname");

   &install_font($source_path, "$mfFile.${realdpi}pk", 'pk', "$MODE");
}

sub make_from_ps {
   local ($source_path, $source_file) = @_;
   local ($pssource, @cmd);
   local ($basename, $afmFile, $afmtest, $part);

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

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

   # Need to find the AFM file...
   $afmFile = "";
   ($basename = $source_file) =~ s/\.pf[ab]$//;
   # First, look in ../afm:
   ($afmtest = $source_path) =~ s#/[^/]*$##;
   $afmtest .= "/afm/$basename.afm";
   $afmFile = $afmtest if -r $afmtest;

   # Then, look in ../../afm:
   ($afmtest = $source_path) =~ s#/[^/]*$##;
   $afmtest =~ s#/[^/]*$##;
   $afmtest .= "/afm/$basename.afm";
   $afmFile = $afmtest if !$afmFile && -r $afmtest;

   die "$0: Cannot find AFM file for $source_file.\n" if !$afmFile;

   @cmd = ('ps2pk', "-a$afmFile", "-X$DPI",
           "$source_path/$source_file", "./$mfFile.${DPI}pk");

   foreach $part (@cmd) {
       print TTY "$part ";
   }
   print TTY "\n";

   $rc = &run (@cmd);

   &install_font($source_path, "$mfFile.${DPI}pk", 'pk', "${DPI}dpi");
}

sub find_fonts {
# This subroutine searches for font sources.  It looks in all the directories
# in the path specified.  Recursive searches are preformed on directories
# that end in //, !, or !!.  The emTeX directive "!", which should search
# only one level deep, is treated exactly like "!!".
#
   local($path, @fonts) = @_;
   local(@dirs, $dir, $font);
   local(@matches) = ();
   local(@recursive_matches);

   $path =~ s/!!/\/\//g;
   $path =~ s/!/\/\//g;
   $path =~ s/\\/\//g;

   print TTY "CWD: ", `pwd` if $VERBOSE;
   print TTY "Find: @fonts\n" if $VERBOSE;
   print TTY "Path: $path\n" if $VERBOSE;

   @dirs = split(/:|;/, $path);
   while (@dirs) {
       $dir = shift @dirs;
       next if !$dir;

       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 TTY "Search root=$rootdir\n" if $VERBOSE;
   print TTY "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 TTY "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.