summaryrefslogtreecommitdiff
path: root/support/genfam/genfam
diff options
context:
space:
mode:
authorNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
committerNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
commite0c6872cf40896c7be36b11dcc744620f10adf1d (patch)
tree60335e10d2f4354b0674ec22d7b53f0f8abee672 /support/genfam/genfam
Initial commit
Diffstat (limited to 'support/genfam/genfam')
-rw-r--r--support/genfam/genfam621
1 files changed, 621 insertions, 0 deletions
diff --git a/support/genfam/genfam b/support/genfam/genfam
new file mode 100644
index 0000000000..81693d0c58
--- /dev/null
+++ b/support/genfam/genfam
@@ -0,0 +1,621 @@
+#! /usr/local/bin/perl
+# $Id: genfam,v 1.7 1991/07/16 12:50:09 tex Exp tex $
+#------------------------------------------------------------
+# (c) 1991 by Joachim Schrod <schrod@iti.informatik.th-darmstadt.de>.
+#
+# genfam device family
+#
+# creates a font set for device as specified in Table/<family>.
+# This file has the following line structure:
+#
+# <family table> :-
+# preambel with arbitrary text
+# <header>
+# <font sets>
+#
+# <header> :-
+# '::HEADER::' new_line+
+# <directory>
+# [ <command> ]
+# [ { <environment variables> } ]
+# <directory> :- 'DIR' not_white_space+ new_line+
+# <command> :- 'COMMAND' rest_of_line new_line+
+# <environment variables> :- env_var_name not_white_space+ new_line+
+#
+# <font sets> :-
+# '::FONTS::' new_line+
+# { <font set> }
+# <font set> :- <magnification> file_pattern {new line}+
+# <magnification> :- <mag step> | real_number
+# <mag step> :- 's'real_number
+#
+# Comments start with `%' and end with the last character on the line.
+# Unlike in TeX the new_line does NOT belong to the comment.
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 1, or (at your option)
+# any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+#
+# $Log: genfam,v $
+# Revision 1.7 1991/07/16 12:50:09 tex
+# New TFM really stored in tfm/, if different from old one.
+# Output (stdout and stderr) to nohup.out is unbuffered.
+#
+# Revision 1.6 1991/04/12 15:25:01 tex
+# Don't look up TFM file in directory "." (it would be found anyhow).
+# Create tfm directory for new TFM files in base directory.
+# Search this tfm directory first so that warnings for different
+# TFM files will only be given once in a run.
+#
+# Revision 1.5 1991/04/08 13:22:36 tex
+# included copyright notice for distribution.
+#
+# Revision 1.4 1991/02/08 20:32:29 tex
+# New TFM file that cannot be found is saved in subdirectory tfm.
+#
+# Revision 1.3 1991/02/08 20:10:06 tex
+# Directory with font sources is always included in MFINPUTS path.
+# On differences in dpi values our own value is used for the directory
+# name.
+# The TFM file is search in the TEXFONTS path and is compared to if
+# a file is found. If the new TFM differs it is not deleted.
+#
+# Revision 1.2 1991/02/08 12:41:14 tex
+# perl is now in /usr/local/bin instead of /software/bin.
+# Include dpi in separator of LOG files to distinguish different fonts.
+# $#errors is -1 when no errors were found.
+# $real_dpi must be computed with round() instead of trunc().
+# Check differences between MF dpi values and own computed values.
+#
+# Revision 1.1 91/02/01 19:33:42 schrod
+# Initial revision
+#
+# name: table_line
+# pre: TABLE is open
+# ret: next non-empty line of TABLE, comments are deleted
+# leading and trailing white space is discarded
+# empty line if eof
+
+sub table_line
+{
+ if ( eof(TABLE) ) {
+ return "";
+ }
+ while ( <TABLE> ) {
+ chop; # throw away new_line
+ s/%.*$//o; # discard comments
+ s/^\s*(.*)\s*$/$1/o; # discard leading and trailing white space
+ if ( $_ eq "" ) { # skip blank lines
+ next;
+ }
+ return $_; # We've found a non-empty line!
+ }
+ return ""; # end of file reached.
+}
+
+
+# name: info()
+# pre: TABLE is open and at beginning
+# ret: (dir, command)
+# dir is family directory
+# command is MF command for create_font()
+# post: set env vars if necessary
+# ::FONTS:: is already read
+# err: exits if family directory is not given or does not exist
+
+sub info
+{
+ local ($line); # next non-empty line
+ local ($key, $value); # (key, value) pair from table header
+
+ while ( ($line=&table_line()) ne "::HEADER::" && $line ne "" ) {}
+ if ( $line eq "" ) {
+ print "! There is no header in $table.";
+ exit 2;
+ }
+
+ $line = &table_line();
+ ($key, $value) = split(/\s+/o, $line);
+ if ( $key eq "DIR" ) {
+ $dir = $value;
+ if ( ! -d $dir ) {
+ print "! Directory $dir does not exist.";
+ exit 2;
+ }
+ if ( $ENV{"MFINPUTS"} ne "" ) {
+ $ENV{"MFINPUTS"} .= ":$dir";
+ } else {
+ $ENV{"MFINPUTS"} .= "$dir";
+ }
+ } else {
+ print "! Source directory must be specified in $table.";
+ exit 2;
+ }
+
+ $line = &table_line();
+ ($key, $value) = split(/\s+/o, $line, 2);
+ if ( $key eq "COMMAND" ) {
+ $command = $value;
+ $line = &table_line();
+ } else {
+ $command = "mf";
+ }
+
+ while ( $line ne "::FONTS::" && $line ne "" ) {
+ ($key, $value) = split(/\s+/o, $line);
+ if ( $key eq "MFINPUTS" ) {
+ $value .= ":$dir";
+ }
+ $ENV{$key} = $value;
+ $line = &table_line();
+ }
+}
+
+
+# name: resolution(MF_command, mode_def)
+# pre: MF is callable with MF_command
+# mode_def exists with the used base
+# ret: resolution in dpi
+
+sub resolution
+{
+ local ($command, $mode_def) = @_;
+ local (@log, $out_markup, $dpi);
+
+ # First build a MF call:
+ # MF shall not ask the (non-existent) user if an error has occured,
+ # it shall switch to the mode definition,
+ # and shall output the respective resolution.
+ # stdin is /dev/null
+ # -- this will cause an emergency stop if all else fails.
+ $command .= " '\\scrollmode;".
+ "mode=$mode_def;$mode_def"."_;".
+ "show pixels_per_inch;end;' ".
+ "</dev/null";
+
+ # Then we execute this call and catch the output in @log.
+ # If the command failed we did not have any output.
+ @log = `$command`;
+ if ( $#log == -1 ) {
+ print "! I've had problems in calling METAFONT.";
+ exit 2;
+ }
+
+ # We look for a line with a show output (starting with `>>')
+ # in the MF output. The respective
+ # line is stored in $out_markup. If no such line is found, $out_markup
+ # is "! Error message", simulating a MF error in this way.
+ $out_markup = "! Error message";
+ foreach ( @log ) {
+ $line_no += 1;
+ if ( /^>>/o ) {
+ $out_markup = $_;
+ last;
+ }
+ }
+
+ # We split the found line. Then $out_mark is hopefully ">>", otherwise
+ # it's an error.
+ ($out_markup, $dpi) = split(/\s+/, $out_markup);
+ if ( $out_markup eq "!" || grep(/^!/, @log) > 0 ) {
+ print "! There was an error while calling METAFONT.";
+ print " Perhaps the device is no valid mode definition?";
+ print " Let's have a look at the MF output:";
+ print "-" x 70;
+ print @log;
+ unlink "mfput.log";
+ exit 2;
+ }
+
+ # Of course the output should be a real number.
+ if ( $dpi !~ /\d+(\.\d*)?/o ) {
+ print "! METAFONT did not tell me a resolution for this device.";
+ print " I'm stymied. Perhaps you should take a look at the MF output:";
+ print "-" x 70;
+ print @log;
+ unlink "mfput.log";
+ exit 2;
+ }
+
+ # MF produced mfput.log and mfput.tfm, we will delete them before returning.
+ unlink <mfput.*>;
+ return($dpi);
+}
+
+
+# name: create_dir(dir)
+# pre: ---
+# post: directory dir exists
+
+sub create_dir
+{
+ local ($dir) = @_;
+ if ( -e $dir ) {
+ if ( -d _ ) {
+ return;
+ }
+ print "! File $dir exists but is no directory.";
+ do finish();
+ }
+ mkdir($dir, 0777) || die "$0: mkdir $dir: $!.\n";
+}
+
+
+# name: base_dir(mode_def)
+# pre: ---
+# ret: full path name of base directory (i.e. new current directory)
+# post: base directory for mode_def is created if necessary
+# is now current directory
+
+sub base_dir
+{
+ local ($mode_def) = @_;
+ do create_dir($mode_def);
+ chdir($mode_def);
+ chop( $mode_def=`pwd` );
+ return $mode_def;
+}
+
+
+# name: lookup(file, path)
+# pre: $file is a name of a regular file
+# @path is an array with directory names
+# ret: full path name of $file if found in one directory
+# "" if not found
+
+sub lookup
+{
+ local ($file, @path) = @_;
+ local ($dir);
+
+ foreach $dir ( @path ) {
+ next if $dir eq "";
+ if ( -f "$dir/$file" ) {
+ return "$dir/$file";
+ }
+ }
+ return "";
+}
+
+
+# name: create_font(mag, file)
+# pre: mag holds the mag string for MF call
+# file is a MF program and is found by $MFINPUTS
+# $command holds the MF call
+# $device holds the mode definition
+# $real_dpi is the dpi value we have computed
+# LOGerror is open for writing
+# LOGwarning is open for writing
+# post: PK file is created in subdir dpi<dpi>/.
+# LOG file is analyzed,
+# errors are appended to LOGerror,
+# warnings are appended to LOGwarning,
+# whole LOG is appended to LOGall.
+# no GF file exists.
+# @font_count[0..1] is incremented;
+
+sub create_font
+{
+ local ($mag, $file) = @_;
+ local (@log, @errors, $error, $dpi);
+ local ($font) = split(/\./, $file);
+ local ($font_msg) = $font." at ".$real_dpi." dpi";
+ local ($separator)= "=" x 20." ".$font_msg." "."=" x (58-length($font_msg));
+
+ $font_count[0] += 1; # we try the next font
+ @log = `$command '\\scrollmode; mode=$device; mag=$mag; input $file`;
+
+ {
+ @errors = grep(/^!/, @log);
+ if ( ($error=$#errors) == -1 ) {
+ last;
+ }
+
+ @errors = grep(!/^! Strange path/, @errors);
+ if ( $#errors != $error ) {
+ print LOGwarning $separator;
+ print LOGwarning $error-$#errors, " strange paths have occured.";
+ }
+ if ( $#errors == -1 ) {
+ last;
+ }
+
+ print LOGerror $separator;
+ $error = 0;
+ foreach ( @log ) {
+ if ( $error ) {
+ chop; print LOGerror $_;
+ if ( $error == 2 ) {
+ $error = 0;
+ } elsif ( /^l.\d+/o ) {
+ $error = 2;
+ }
+ } elsif ( /^!/o && ! /^! Strange/o ) {
+ chop; print LOGerror $_;
+ $error = 1;
+ }
+ }
+ }
+
+ system "echo '$separator' >>LOGall";
+ system "cat $font.log >>LOGall";
+
+ $dpi = $log[$#log - 1];
+ if ( $dpi !~ /^Output/o ) {
+ print LOGerror "!" x 20, " No output!";
+ return;
+ }
+
+ ($dpi) = ( $dpi =~ /$font\.(\d+)gf/ );
+ if ( $dpi != $real_dpi ) {
+ print "! Dpi-differences between MF ($dpi dpi) and me ($real_dpi dpi).";
+ }
+ system "gftopk", "$font.${dpi}gf", "dpi$real_dpi/$font"
+ || print LOGerror "!" x 20," Problems with gftopk on $font.${dpi}gf";
+
+ $old_tfm = &lookup("$font.tfm", @tfm_path);
+ if ( $old_tfm eq "" ) {
+ print "! New TFM file: tfm/$font.tfm";
+ rename("$font.tfm", "tfm/$font.tfm");
+ } elsif ( system("cmp", "-s", "$font.tfm", $old_tfm) ) {
+ print "! Different TFMs for type $font, new one stored in tfm/.";
+ rename("$font.tfm", "tfm/$font.tfm");
+ }
+
+ unlink( grep(!/\.mf/, <$font.*>) );
+
+ $font_count[1] += 1; # well, we succeeded
+}
+
+
+# name: create_mag(mag, pattern)
+# pre: mag is the magnification of the font set
+# $dpi is the base resolution of the device
+# $cwd is the current directory, i.e., the base directory
+# $dir is the directory where the MF programs reside
+# pattern are files in $dir which shall be created in mag
+# create_font(file) with file from {pattern} is callable
+# post: for all files create_font() is called
+
+sub create_mag
+{
+ local ($mag, $pattern) = @_;
+ local (@files, $file, $MF_mag, $real_dpi);
+
+ chdir $dir; @files = <${pattern}>; chdir $cwd;
+ if ( $#files == -1 ) {
+ return;
+ }
+
+ $MF_mag = $mag;
+ if ( $MF_mag =~ s/^s(\d+(\.\d*)?)/$1/o ) {
+ $real_dpi = 1.2 ** $MF_mag;
+ $MF_mag = "magstep(".$MF_mag.")";
+ } else {
+ $real_dpi = $MF_mag;
+ }
+ if ( $real_dpi == 0 ) {
+ print "! Hmm, the magnification $mag is not valid.";
+ return;
+ }
+
+ $real_dpi = int( $real_dpi * $dpi + 0.5 ); # round does not exist...
+ do create_dir("dpi".$real_dpi);
+
+ foreach $file ( @files ) {
+ do create_font($MF_mag, $file);
+ }
+}
+
+
+# name: finish()
+# pre: $init_phase is set
+# post: no return
+
+sub finish
+{
+ local ($log_msg);
+
+
+ if ( $init_phase ) {
+ exit 2;
+ }
+
+
+ # We are finished and tell now how long we have run.
+
+ $log_msg = "=" x 79;
+ print LOGerror $log_msg;
+ print LOGwarning $log_msg;
+ print LOGall $log_msg;
+
+ ($user, $system, $cuser, $csystem) = times;
+ $total = sprintf("%.2f", $user + $system + $cuser + $csystem);
+ $user = sprintf("%.2f", $user);
+ $system = sprintf("%.2f", $system);
+ $cuser = sprintf("%.2f", $cuser);
+ $csystem = sprintf("%.2f", $csystem);
+ chop( $time = &ctime(time) );
+
+ $log_msg = <<EOT
+
+Well, now it's $time.
+
+I've started MF $font_count[0] times and created $font_count[1] fonts.
+All in all, we have needed (u:$user, s:$system) seconds to control the run,
+MF and associated programs needed (u:$cuser, s:$csystem) seconds,
+in total that makes $total seconds.
+ Howdy!
+EOT
+ ;
+ print LOGerror $log_msg;
+ print LOGwarning $log_msg;
+ print LOGall $log_msg;
+
+
+ # Send the starter a mail that we are finished
+ open(STDOUT, "| /bin/mail $name");
+ print <<EOT
+Hello,
+
+You have started a $0 script for the creation of the $family fonts
+for device $device. This script is finished.
+
+It's error messages are in $cwd/nohup.out.
+You should take a look at LOG* in the same directory (especially at LOGerror).
+
+ Virtually, your MF management
+EOT
+ ;
+ close(STDOUT);
+
+ exit 0;
+}
+
+
+# extract basename from $0
+# supply new_line at end of line
+# and load needed library functions
+
+ $0 =~ s:^.*/([^/]+):$1:o;
+ $\ = "\n";
+ require "ctime.pl";
+
+
+# show that we have not done real work up to now
+
+ $init_phase = 1;
+
+
+# who is the person which wants to make new fonts?
+
+ if ( ! defined $ENV{"LOGNAME"} ) {
+ if ( defined $ENV{"USER"} ) {
+ $ENV{"LOGNAME"} = $ENV{"USER"};
+ } else {
+ print "Oops, you do not have a logname!";
+ local ($\) = ""; # just for the following print
+ while {
+ print "Who are you? ";
+ ($name=<STDIN>) eq "";
+ } {}
+ $ENV{"LOGNAME"} = $name;
+ }
+ }
+ $name = $ENV{"LOGNAME"};
+
+
+
+# check arguments
+
+ if ( $#ARGV != 1 ) {
+ print "usage: ",$0," device family";
+ exit 1;
+ }
+
+# give them names
+
+ ($device, $family) = @ARGV;
+
+# open table file
+
+ $table = "Table/".$family;
+ if ( ! -f $table || ! -r _ ) {
+ print "! Cannot read $table.";
+ exit 2;
+ }
+ open(TABLE,"<".$table);
+
+# read table header, compute base resolution and generate base directory
+
+ do info();
+ $dpi = &resolution($command, $device);
+ $cwd = &base_dir($device);
+
+# Now we are in the base directory.
+
+
+# Set up a search path for TFM files. Use the environment variable
+# $TEXFONTS, and as a default /usr/tex/fonts/tfm and tfm. This search
+# path is used to detect if created TFM files exist already, and if
+# they match the existing ones.
+# We supply a subdirectory tfm; there must be a place where new TFM
+# files may be stored.
+# But: The directory `.' must not be part of the search path. In this
+# directory a matching TFM file will always be found: the created one...
+
+ do create_dir("tfm");
+ @tfm_path = split(/:/, $ENV{"TEXFONTS"});
+ @tfm_path = grep( ! /^\.$/, @tfm_path); # delete entry "."
+ unshift(@tfm_path, "tfm"); # new versions should be found first
+ push(@tfm_path, "/usr/tex/fonts/tfm");
+
+
+
+
+# All initializations are done, MF ran already, and we may now assume that
+# the rest is computer's work. So we fork of a process, disconnect it from
+# our main process and start the whole stuff ::::
+
+ print <<EOT
+
+OK, I fork myself and get METAFONT running. This will need a while.
+You will find my error messages in $device/nohup.out.
+EOT
+ ;
+
+ if ( fork != 0 ) { # parent:
+ sleep 2; # wait for child process to establish SIG handler
+ exit 0;
+ }
+
+ $init_phase = 0; # start real work
+
+ $SIG{'HUP'} = "IGNORE"; # child: disconnect from parent
+ open(STDIN, "</dev/null");
+ open(STDOUT, ">nohup.out"); open(STDERR, ">&STDOUT");
+ $| = 1; # print unbuffered
+
+
+
+# Create files LOGerror and LOGwarning because they will be written
+# by this script.
+# But delete LOGall as this will be written by cat. This deletion is not
+# done by unlink because this file may be linked to somewhere else due to
+# space reasons. So we use an open and a close. But before we write a
+# header to the LOG files so that the reader will know what we have done.
+
+ $log_msg = "Started creation of family $family on ".&ctime(time).
+ "Skript activated by $name\n"; # two NL's !!
+
+ open(LOGerror, ">LOGerror");
+ open(LOGwarning, ">LOGwarning");
+ open(LOGall, ">LOGall");
+ print LOGerror $log_msg;
+ print LOGwarning $log_msg;
+ print LOGall $log_msg;
+ close(LOGall);
+
+
+# Read each font set from TABLE, split it, setup mag specification
+# string for MF, and call create_mag().
+
+ @font_count = (0, 0);
+ while ( ($_ = &table_line()) ne "" ) {
+ ($mag, $pattern) = split;
+ do create_mag($mag, $pattern);
+ }
+
+
+# cleanup
+
+ do finish();