summaryrefslogtreecommitdiffstats
path: root/knetworkconf/backends/type1inst
diff options
context:
space:
mode:
Diffstat (limited to 'knetworkconf/backends/type1inst')
-rwxr-xr-xknetworkconf/backends/type1inst1387
1 files changed, 1387 insertions, 0 deletions
diff --git a/knetworkconf/backends/type1inst b/knetworkconf/backends/type1inst
new file mode 100755
index 0000000..86d6425
--- /dev/null
+++ b/knetworkconf/backends/type1inst
@@ -0,0 +1,1387 @@
+#!/usr/bin/perl
+#
+# You may need to change the above path.
+#
+#-----------------------------------------------------------------------------
+#
+# Copyright (C) 1996-1998 James Macnicol
+#
+# 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 2, 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 MERCHANTIBILITY
+# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+# for more details.
+#
+#-----------------------------------------------------------------------------
+#
+# type1inst : Generate a "fonts.scale" file for Type 1 fonts in PFB format
+# for use with your favourite X server. Also generate a "Fontmap" for use
+# with ghostscript.
+#
+# cd to the directory you want to install fonts in and invoke this script.
+# Options:
+#
+# -samples Create sample PS files for each font
+# -nox Do not create fonts.scale and fonts.dir for X11
+# -nogs Do not create Fontmap for GhostScript
+# -quiet Don't print anything on the stdout, just to the log
+# (see also next section).
+# -silent Same as -quiet (for backwards compatiblity)
+# -q Same as -quiet
+# -nolog Don't create a log file
+# -version Print version info and quit
+# -v Same as -version
+#
+#
+#
+# THIS IS BETA SOFTWARE! PLEASE READ THE "README" FILE!!!
+#
+# Direct all correspondence regarding this software to
+#
+# J.Macnicol@student.anu.edu.au
+#
+#
+# Good luck!
+#
+#
+# James Macnicol
+#
+#-----------------------------------------------------------------------------
+
+# Version number and date information
+
+# NOTE THAT MY E-MAIL ADDRESS HAS CHANGED (AS OF VERSION 0.6.1) !!!!
+
+$version = "0.6.1";
+$versiondate = "11th February 1998";
+$emailaddress = "james.macnicol\@mailexcite.com";
+$copyright = "Copyright (C) 1996-1998 James Macnicol ($emailaddress)";
+
+#
+# Map identifying strings in /Notice into foundry names. Separate identifier
+# from name with a :. Someone let me know if this is a problem (i.e. foundry
+# has a : in its name which really ought to be there (although I may not
+# believe it) ; we'll change it to ! or something.
+#
+# You probably want to put foundries which license type from others near the
+# top of this list (e.g. Adobe). If the name of the original source of the
+# face is listed lower down then it will be used that instead. It's just that
+# Adobe does have its own faces too, but more often than not they are
+# licensed. Doing it this way will make it work out correctly in either case.
+#
+
+
+@foundries = (
+ "Adobe:adobe",
+ "Allied Corporation:allied",
+ "Publishers' Paradise:paradise",
+ "PUBLISHERS' PARADISE:paradise",
+ "Bigelow & Holmes:b&h",
+ "Bitstream:bitstream",
+ "Corel Corporation:corel",
+ "International Typeface Corporation:itc",
+ "IBM:ibm",
+ "LETRASET:letraset",
+ "Monotype Corporation:monotype",
+ "SoftMaker:softmaker",
+ "URW:urw",
+ "Jonathan Brecher:brecher",
+ "Brendel Informatik:brendel",
+ "A. Carr:carr",
+ "FontBank:fontbank",
+ "Hershey:hershey",
+ "A.S.Meit:meit",
+ "Andrew s. Meit:meit",
+ "S.G. Moye:moye",
+ "S. G. Moye:moye",
+ "D. Rakowski:rakowski",
+ "David Rakowski:rakowski",
+ "Reasonable Solutions:reasonable",
+ "Southern Software:southern",
+ "Title Wave:titlewave",
+ "ZSoft:zsoft",
+ "Digiteyes Multimedia:digiteyes",
+ "MWSoft:mwsoft",
+ "MacroMind:macromind",
+ "Three Islands Press:3ip",
+ "Hank Gillette:gillette",
+ "Doug Miles:miles",
+ "Richard Mitchell:mitchell");
+
+# Note: Hershey is the public Hershey fonts which come with Ghostscript.
+# These cause no end of problems since they look inside like funny PS
+# programs rather than standard fonts. The current version of type1inst will
+# refuse to process such fonts. Older versions (< 0.6) tended to fall over
+# when these were present.
+
+# Note 2 : Some of these are obviously names of people only, not companies.
+# They are generally public domain fonts.
+
+# Note 3 : Publisher's Paradise did not produce a majority of the fonts that
+# contain their name in the /Notice field, rather they distributed them on
+# their BBS. Unfortunately there is no other identifying info in these fonts.
+
+#
+# These are font weights. Some are synonyms, e.g. regular for medium. It
+# has been suggested we map "thin" to "light", however there are some font
+# families which have both "thin" and "light" variants. An example is
+# Linotype's Helvetica Neue. Please let me know if you find a font where
+# assuming "semi", and "demi" to be the same fails.
+#
+
+@weights = (
+ "book:book",
+ "demibold:demibold",
+ "semibold:demibold",
+ "demi:demibold",
+ "semi:demibold",
+ "extrabold:extrabold",
+ "boldface:bold",
+ "bold:bold",
+ "heavyface:heavyface",
+ "heavy:heavy",
+ "ultrablack:ultrablack",
+ "extrablack:extrablack",
+ "ultra:ultra", # it's gonna break some widths...
+ "black:black",
+ "extralight:extralight",
+ "light:light",
+ "thin:thin",
+ "super:super",
+ "thin:thin",
+ "light:light",
+ "semi:demi",
+ "bold:bold",
+ "heavy:heavy",
+ "black:black",
+ "normal:medium",
+ "regular:regular",
+ "roman:regular" # this too might break something...
+ );
+
+#
+# Likewise for slants
+#
+
+@slants = (
+ "italic:i",
+ "roman:r",
+ "regular:r",
+ # "it:i",
+ "cursive:i",
+ "kursiv:i",
+ "oblique:o",
+ "obl:o",
+ "slanted:o",
+ # Cyrillic fonts
+ "upright:r",
+ "inclined:i");
+
+#
+# Style. Wondering if we should put "serif" in here somehow....?
+#
+# I haven't put "ultracondensed" here since I think they're two different
+# things, i.e. Garamond Ultra Condensed is very bold but condensed.
+
+@styles = (
+ "extracondensed:extracondensed",
+ "condensed:condensed",
+ "cond:condensed",
+ "sans:sans",
+ "wide:wide",
+ "cn:condensed",
+ "narrow:narrow",
+ "extracompressed:extracompressed",
+ "compressed:compressed",
+ "extraextended:extraextended",
+ "extended:extended",
+ "expanded:expanded",
+ "normal:normal");
+
+#
+# Additional styles. Refer to the line that puts together $xline.
+#
+
+@addstyles = ("alt:alternate",
+ "beginning:beginning",
+ "display:display",
+ "dfr:dfr",
+ "ending:ending",
+ # "exp" and "ep" seems to be sometimes part of a fonts name,
+ # sometimes part of additional classification. I'm crying... :-(
+ "ep:expert",
+ "exp:expert",
+ "ornaments:ornaments",
+ "osf:oldstylefigures",
+ "outline:outline",
+ "sc:smallcaps",
+ "shaded:shaded",
+ "shadowed:shadowed",
+ "stencil:stencil",
+ "swash:swash",
+ "sw:swash",
+ "one:one",
+ "two:two",
+ "three:three",
+ "four:four",
+ # Some fonts use just "a" to mean a font with alternate
+ # character set.
+ "a:alternate");
+
+#
+# Write a message to the stdout and/or the log file depending on what the
+# user chose.
+#
+
+sub log_msg {
+ ($msg) = @_;
+
+ if (! $silent) {
+ print STDOUT "$msg";
+ }
+ if ($dologfile) {
+ print LOG "$msg";
+ }
+}
+
+sub log_only_msg {
+ ($msg) = @_;
+
+ if ($dologfile) {
+ print LOG "$msg";
+ }
+}
+
+#
+# Die with a bug message
+#
+
+sub die_bug {
+ ($msg) = @_;
+
+ die("BUG: $msg\nIf you have not modified the script in a way which might have\ncaused this error you are encouraged to report it as a bug to\n\n$emailaddress\n\n");
+}
+
+#
+# Print out a string with a given minimum width. This is used to make the
+# Fontmap entries look nice.
+#
+
+sub print_min_width {
+ ($stream, $minwidth, $string) = @_;
+ $_ = $string;
+ $strlength = length($string);
+ # Print the string
+ print $stream $string;
+ # Now pad out the rest of the space if the string is short.
+ if ($strlength < $minwidth) {
+ for ($i = 0; $i < ($minwidth - $strlength); $i = $i + 1) {
+ print $stream " ";
+ }
+ }
+}
+
+#
+# Indicate progress through the directory on the command line
+#
+
+sub print_progress {
+ $totalfonts = $numpffonts + $numgsfonts + $badfonts;
+ if (! $silent) {
+ if (($totalfonts % 10) == 0) {
+ print "[$totalfonts]\n";
+ }
+ }
+}
+
+#
+# Put the processing stuff into a procedure since we want to do the same for
+# .pfb, .pfa and .gsf files (once .pfb's are decompressed).
+#
+# Argument : filename.
+# Returns : X font description, name of font for Fontmap
+#
+
+sub process_font {
+ ($fname) = @_;
+ local($xline);
+
+ # Check to see if this is a ghostscript font
+ if ($fname =~ /\.gsf\s*$/) {
+ $gsfont = 1;
+ } else {
+ $gsfont = 0;
+ }
+
+ # Default is not MultipleMaster
+ $mm = 0;
+
+ open(IN, $fname) || die "cannot open $file for reading";
+ # An unlikely name to check to see we get a fontname out of the file.
+ $fontname = "abcXYZ:!@#";
+ $foundry = "unknown";
+ $notice = "No notice given.";
+ while(<IN>) {
+ if (/\/isFixedPitch\s+(.+)\s+def\s*/) {
+ if ($1 =~ /true/) {
+ $fixedpitch = "m";
+ } else {
+ $fixedpitch = "p";
+ }
+ }
+
+ # I think that we should accept the manufacturers classification.
+ # Try to extract this from FontName only if it's missing.
+ # (It shouldn't. There are other reasons why this won't work, though.)
+ if (/\/FamilyName\s*\((.+)\)\s+readonly\s+def\s*/) {
+ $familyname = $1;
+
+ # Convert to lower case (because case is insignificant).
+ # Spaces are acceptable according to XLFD.
+ $familyname =~ tr/A-Z/a-z/;
+ }
+ # Previous applies to this also... This might make xfontsels list a
+ # a little cluttered, though. Perhaps it would be better to map it
+ # to standard strings like you do. It's named $weight_add because
+ # you already used $weight...
+ if (/\/Weight\s*\((.+)\)\s+readonly\s+def\s*/) {
+ $weight_add = $1;
+
+ # Convert to lower case. Spaces are acceptable according to XLFD?
+ # Remove for consistency (as there would be any left after my
+ # slaughtering).
+ $weight_add =~ tr/A-Z/a-z/;
+ $weight_add =~ s/\s*//g;
+
+ # Remember if it's a MultipleMaster font
+ $mm = 1 if ($weight_add =~ /^all$/);
+ # Strange. This field seems to contain also width sometimes... remove it.
+ $numstyles = @styles;
+ for ($x = 0; $x < $numstyles; $x = $x + 1) {
+ $ident = $styles[$x];
+ @fields = split(/:/, $ident);
+ $numfields = @fields;
+ if ($numfields != 2) {
+ die_bug("The style identification \"$ident\" is bad\n");
+ }
+ # Remove matched word from the font's name
+ $weight_add =~ s/$fields[0]//;
+ }
+ }
+ # FullName might contain useful information in determining
+ # the properties of a font.
+ if (/\/FullName\s*\((.+)\)\s+readonly\s+def\s*/) {
+ $fullname = $1;
+
+ # Convert to lower case
+ $fullname =~ tr/A-Z/a-z/;
+
+ # Some names got extra numerical information at the start.
+ $fullname =~ s/^\d*\s*(.+)/$1/;
+ }
+ # Note : some fonts have a suspect /FontName declaration where there
+ # is no space between /FontName and the name of the font itself....
+ if (/\/FontName\s*[\/\(]([^\)]+)\)?\s+def\s*/) {
+ $fontname = $1;
+
+ # Remove any embedded spaces
+ # (Probably unnecessary. If I remember it right, it can't contain any spaces,
+ # because it's a PostScript identifier/keyword or what's the right term...)
+ $fontname =~ s/\s//g;
+
+ # Save a copy of original full name for later
+ $fontnamecopy = $fontname;
+
+ # Convert to lower case
+ $fontname =~ tr/A-Z/a-z/;
+
+ # There are fonts like Mendoza Roman, Baskerville Book etc, where what
+ # looks like weight is part of the font's name, not it's weight.
+ # Split the name into fontname and fontstyle instead and handle them separate.
+ ($fontname, $fontstyle) = split(/-/, $fontname);
+
+ # Remove -s
+ $fontname =~ s/-//g;
+ $fontstyle =~ s/-//g;
+
+
+ # Check for weight modifiers (medium, bold, demi, light etc.)
+ $weight = "medium";
+ $numweights = @weights;
+ for ($x = 0; $x < $numweights; $x = $x + 1) {
+ $ident = $weights[$x];
+ @fields = split(/:/, $ident);
+ $numfields = @fields;
+ if ($numfields != 2) {
+ die_bug("The weight identification \"$ident\" is bad\n");
+ }
+ if ($fontstyle =~ /$fields[0]/) {
+ $weight = $fields[1];
+ } elsif ($weight_add) {
+ # Try any possible way
+ $weight = $weight_add;
+ }
+ # Remove matched word from the font's name
+ $fontstyle =~ s/$fields[0]//;
+ }
+
+ # Check for slant (italic, roman, oblique)
+ $slant = "r";
+
+ $numslants = @slants;
+ for ($x = 0; $x < $numslants; $x = $x + 1) {
+ $ident = $slants[$x];
+ @fields = split(/:/, $ident);
+ $numfields = @fields;
+ if ($numfields != 2) {
+ die_bug("The slant identification \"$ident\" is bad\n");
+ }
+ if ($fontstyle =~ /$fields[0]/) {
+ $slant = $fields[1];
+ }
+ # Remove matched word from the font's name
+ $fontstyle =~ s/$fields[0]//;
+ }
+
+ # Check for style (condensed, normal, sans, or wide)
+ $style = "normal";
+
+ $numstyles = @styles;
+ for ($x = 0; $x < $numstyles; $x = $x + 1) {
+ $ident = $styles[$x];
+ @fields = split(/:/, $ident);
+ $numfields = @fields;
+ if ($numfields != 2) {
+ die_bug("The style identification \"$ident\" is bad\n");
+ }
+ if ($fontstyle =~ /$fields[0]/) {
+ $style = $fields[1];
+ }
+ # Remove matched word from the font's name
+ $fontstyle =~ s/$fields[0]//;
+ }
+
+ # Check for additional styles (alternate, smallcaps, oldstylefigures etc.)
+ $addstyle = "";
+
+ $numaddstyles = @addstyles;
+ for ($x = 0; $x < $numaddstyles; $x = $x + 1) {
+ $ident = $addstyles[$x];
+ @fields = split(/:/, $ident);
+ $numfields = @fields;
+ if ($numfields != 2) {
+ die_bug("The additional style identification \"$ident\" is bad.\n");
+ }
+ if ($fontstyle =~ /$fields[0]/) {
+ $addstyle = $fields[1];
+ }
+ # Remove matched word from the font's name
+ $fontstyle =~ s/$fields[0]//;
+ }
+ }
+ if (/^\/Encoding\s+(\S+)\s*/) {
+ if ($1 =~ /StandardEncoding/) {
+ $encoding = "iso8859-1";
+ } else {
+ # This needs work
+ $encoding = "adobe-fontspecific";
+ }
+ }
+
+ if (/^\s*\/Notice\s*(.*)$/) {
+ $notice = $1;
+
+ $notice =~ s/readonly def//g;
+
+ $numfoundries = @foundries;
+ for ($x = 0; $x < $numfoundries; $x = $x + 1) {
+ $ident = $foundries[$x];
+ @fields = split(/:/, $ident);
+ $numfields = @fields;
+ if ($numfields != 2) {
+ die_bug("The foundry identification \"$ident\" is bad.\n");
+ }
+ if ($notice =~ /$fields[0]/) {
+ $foundry = $fields[1];
+ }
+ }
+ }
+
+ # MultipleMaster fonts have this field.
+ if (/\/BlendAxisTypes\s+\[([^\]]+)\]\s*def/) {
+ $axis = $1;
+ # Remove axises we don't need
+ $axis =~ s/\/Weight\s+//;
+ $axis =~ s/\/Width\s+//;
+ # Are there still some axises left?
+ if ($axis =~ /\//) {
+ # Remove trailing spaces
+ $axis =~ s/^(.*?)\s*$/$1/;
+ $axis =~ s/\/\S+/0/g;
+ $axis= "[$axis]";
+ }
+ }
+
+ # Break out of loop if we've passed the interesting stuff.
+ # And time to try another way to find out the fontname.
+ if ((! $gsfont) && (/currentfile\s+eexec/)) {
+ &try_another_way();
+ # This is for .pfa and .pfb fonts
+ last;
+ } elsif (($gsfont) && (/currentdict\s+end/)) {
+ &try_another_way();
+ # This is for ghostscript .gsf fonts. Why don't all these have a
+ # currentfile eexec ?
+ last;
+ }
+ }
+ close(IN);
+
+ # I use quite different mechanism to get fontname etc. However it's done,
+ # the results are hard to get right. Should it be a command-line option?
+ # Now I try both ways.
+
+ # familyname, use fontname
+ $familyname = ($anotherway ? $familyname : $fontname);
+
+ # Oh, we are dealing with a MultipleMaster font...
+ if ($mm) {
+ $weight = "0";
+ $style = "0";
+ $addstyle .= $axis;
+ }
+
+ if ($familyname =~ /abcXYZ\:\!\@\#/) {
+ log_only_msg("\n");
+ log_only_msg("$filename : could not determine font name\n");
+ log_only_msg("\n");
+ $badfonts = $badfonts + 1;
+ &print_progress();
+ return;
+ }
+
+ if (($dox) && (! $gsfont) && ($foundry =~ /unknown/)) {
+ $nofoundry = $nofoundry + 1;
+ log_only_msg("\n");
+ log_only_msg("$filename ($fontnamecopy) : foundry not matched\n");
+ log_only_msg(" /Notice said : \"$notice\"\n");
+ log_only_msg("\n");
+ } elsif ($dox) {
+# log_only_msg("$filename ($fontnamecopy) : okay\n");
+ }
+
+ if (($dox) && (! $gsfont)) {
+ # Addstyle is any extra information needed to uniquely identify a variation of a font
+ # in it's family, like "alternate" (ACaslon-AltRegular) or "one" (EuropeanPi-One).
+ # Changed fontname to familyname because it describes that field better, but that's
+ # just my opinion...
+ $xline = "-$foundry-$familyname-$weight-$slant-$style-$addstyle-0-0-0-0-$fixedpitch-0-$encoding";
+ }
+
+ # Update count of each type
+ if ($gsfont) {
+ $numgsfonts = $numgsfonts + 1;
+ } else {
+ $numpffonts = $numpffonts + 1;
+ }
+
+ &print_progress();
+
+ ($xline, $fontnamecopy);
+}
+
+
+#
+# An alternative way to get fontname
+#
+
+sub try_another_way {
+ # Strip familyname from fullname. This seems to work most of time.
+ # Some fontnames have extra numerical information after familyname.
+ # Strip it if it's longer than two numbers.
+ # Otherwise, it's probably part of additional style classification.
+ # In a few cases it IS part of the name, and this algorithm should break.
+ # Sometimes there's a strange string of *'s somewhere. Get rid of it.
+ $fullname =~ s/\*//g;
+ print STDERR "1: ${fullname}:\n" if $debug;
+ if ($fullname =~ s/^$familyname\s*(\d\d+)?\s*(.*)/$2/) {
+ # Wow. It worked. Let's continue and remove excess whitespace.
+ $anotherway = 1;
+ $fullname =~ s/\s+//g;
+
+ # familyname can now stripped of -s
+ $familyname =~ s/-//g; # Or space?
+ print STDERR "2: ${fullname}:\n" if $debug;
+
+ # Check for weight modifiers (medium, bold, demi, light etc.)
+ $weight = "medium";
+ $numweights = @weights;
+ for ($x = 0; $x < $numweights; $x = $x + 1) {
+ $ident = $weights[$x];
+ @fields = split(/:/, $ident);
+ $numfields = @fields;
+ if ($numfields != 2) {
+ die_bug("The weight identification \"$ident\" is bad\n");
+ }
+ if ($fullname =~ /$fields[0]/) {
+ $weight = $fields[1];
+ $weight =~ s/-//g;
+ }
+ # Remove matched word from the font's name
+ $fullname =~ s/$fields[0]//;
+ }
+
+ print STDERR "3: ${fullname}:\n" if $debug;
+
+ # Check for slant (italic, oblique)
+ $slant = "r";
+
+ $numslants = @slants;
+ for ($x = 0; $x < $numslants; $x = $x + 1) {
+ $ident = $slants[$x];
+ @fields = split(/:/, $ident);
+ $numfields = @fields;
+ if ($numfields != 2) {
+ die_bug("The slant identification \"$ident\" is bad\n");
+ }
+ if ($fullname =~ /$fields[0]/) {
+ $slant = $fields[1];
+ $slant =~ s/-//g;
+ }
+ # Remove matched word from the font's name
+ $fullname =~ s/$fields[0]//;
+ }
+ print STDERR "4: ${fullname}:\n" if $debug;
+ # Check for style (normal or sans)
+ $style = "normal";
+
+ $numstyles = @styles;
+ for ($x = 0; $x < $numstyles; $x = $x + 1) {
+ $ident = $styles[$x];
+ @fields = split(/:/, $ident);
+ $numfields = @fields;
+ if ($numfields != 2) {
+ die_bug("The style identification \"$ident\" is bad\n");
+ }
+ if ($fullname =~ /$fields[0]/) {
+ $style = $fields[1];
+ $style =~ s/-//g;
+ }
+ # Remove matched word from the font's name
+ $fullname =~ s/$fields[0]//;
+ }
+
+ # What's left of fullname is probably additional style information.
+ # Some fontnames have some strange numerical information here too.
+ # If it's just one number, it usually refers to some variant of the
+ # fontfamily, otherwise, just get rid of it.
+ $fullname = "" if ($fullname =~ /^\d\d+$/);
+ print STDERR "5: ${fullname}:\n" if $debug;
+ $addstyle = $fullname;
+ $addstyle =~ s/-//g;
+ } else {
+ $anotherway = 0;
+ }
+}
+
+#
+# Makes associative array out of current entries in fonts.scale
+#
+
+sub read_fonts_scale {
+ local($finish, %rv, $line, $filename, $fontname);
+
+ $finish = open(SCALE, "fonts.scale") ? 0 : 1;
+ if ($finish == 1) {
+ %rv;
+ }
+
+ log_only_msg("Reading fonts.scale ....");
+
+ # First line should be an integer saying how many fonts there are.
+ # Discard.
+ $line = <SCALE>;
+ if (! $line =~ /\s*[0-9]+\s*/) {
+ log_only_msg("Warning : first line of fonts.scale is bad\n");
+ }
+
+ while (<SCALE>) {
+ # Very rough pattern
+ if (/\s*(\S+)\s+(.+)\s*/) {
+ chop;
+ $filename = $1;
+ $fontname = $2;
+ if (! -e $filename) {
+ $numxremoved++;
+ log_only_msg("Removed fonts.scale entry \"$_\" since the file did not exist\n");
+ next;
+ }
+ if ($rv{$filename}) {
+ $numxduplicates++;
+ log_only_msg("Warning : fonts.scale already contains a line for file \"$filename\"\n");
+ log_only_msg(" the line \"$_\" has been ignored\n");
+ } else {
+ $rv{$filename} = $fontname;
+ }
+ } else {
+ log_only_msg(" Couldn't understand line : \n");
+ log_only_msg(" \"$_\"\n");
+ }
+ }
+ close(SCALE);
+
+ log_only_msg("Done.\n");
+
+ %rv;
+}
+
+#
+# Write out an associative array into fonts.scale, making a backup copy
+# first.
+#
+
+sub write_fonts_scale {
+ (%fontdata) = @_;
+ local($numentries, $key);
+
+ # First, make backup copy
+ if (-e "fonts.scale") {
+ system ("cp -f fonts.scale fonts.scale.bak");
+ }
+
+ log_only_msg("Writing fonts.scale....\n");
+
+ $numentries = keys(%fontdata);
+ open(SCALE, ">fonts.scale") || die("Can't open fonts.scale!\n");
+ print SCALE "$numentries\n";
+ foreach $key (sort(keys %fontdata)) {
+ print_min_width(SCALE, 12, $key);
+ print SCALE " ";
+ print SCALE "$fontdata{$key}\n";
+ }
+ close(SCALE);
+ system ("chmod 0755 fonts.scale") && log_msg("Coudln't chmod \"fonts.scale\" ... continuing on anyway\n");
+
+ log_only_msg(" Done.\n");
+}
+
+#
+# Read the current Fontmap and return associative array with data.
+#
+
+sub read_fontmap {
+ local(%rv, $finish, $fontname, $filename);
+
+ $finish = open(FONTMAP, "Fontmap") ? 0 : 1;
+ if ($finish) {
+ %rv;
+ }
+
+ log_only_msg("Reading Fontmap ....\n");
+
+ while (<FONTMAP>) {
+ if (/\/+(\S+)\s+\((.*)\)\s+;\s+/) {
+ chop;
+ $fontname = $1;
+ $filename = $2;
+ if (! -e $filename) {
+ $numgsremoved++;
+ log_only_msg("Removed Fontmap entry \"$_\" since the file did not exist\n");
+ next;
+ }
+ if ($rv{$filename}) {
+ # Entry already exists
+ $numgsduplicates++;
+ log_only_msg("Warning : the Fontmap already contains a line for file \"$filename\"\n");
+ log_only_msg(" the line \"$_\" has been ignored\n");
+ } else {
+ $rv{$filename} = $fontname;
+ }
+ } else {
+ $numgsbarf++;
+ log_only_msg("Couldn't understand line :\n");
+ log_only_msg(" $_\n");
+ }
+ }
+
+ close(FONTMAP);
+
+ log_only_msg("Done.\n");
+
+ %rv;
+}
+
+#
+# Write associative array containing font data to Fontmap
+#
+
+sub write_fontmap {
+ (%fontdata) = @_;
+ local($numentries, $key);
+
+ # First, make backup copy
+ if (-e "Fontmap") {
+ system ("cp -f Fontmap Fontmap.bak");
+ }
+
+ log_only_msg("Writing Fontmap....");
+
+ $numentries = keys(%fontdata);
+ open(FONTMAP, ">Fontmap") || die("Couldn't open Fontmap!\n");
+ foreach $key (sort(keys %fontdata)) {
+ print_min_width(FONTMAP, 40, "/$fontdata{$key}");
+ print FONTMAP " ";
+ print FONTMAP "($key)\t;\n";
+ }
+ close(FONTMAP);
+ system ("chmod 0755 Fontmap") && log_msg("Couldn't chmod \"Fontmap\" ... continuing on anyway\n");
+
+ log_only_msg(" Done.\n");
+}
+
+#
+# Add a font (either X or gs) to hash table
+#
+
+sub add_font_to_aarray {
+ ($fname, $text, %aa) = @_;
+
+ if (($text =~ /^\s*$/) || ($fname =~ /^\s*$/)) {
+ # This will occur if the font is a dud (e.g. a Hershey font). We
+ # assume that $badfonts has been incremented and we just return.
+ %aa;
+ }
+
+ if (! $aa{$fname}) {
+ $aa{$fname} = $text;
+ }
+
+ %aa;
+}
+
+#
+# Create sample text using each font
+#
+
+sub font_sample {
+ ($filename, $fontname, $height) = @_;
+ local($text, $alltext, $samplefile);
+
+ if (($filename =~ /^\s*$/) || ($fontname =~ /^s*$/)) {
+ print "font_sample: $filename, $fontname\n";
+ die_bug("Bad argument(s) to font_sample()!\n");
+ }
+
+# Here we create a full page sample for the current font. It contains
+# a large point-size version, a normal sized version, and a small version.
+
+ $text = <<"TEXT";
+%!
+%%EndComments
+/$samplefont findfont
+18 scalefont
+setfont
+newpath
+200 715 moveto
+(File : $filename) show
+200 695 moveto
+(Font Name : $fontname) show
+% t1embed : $filename $fontname
+closepath
+
+/$fontname findfont
+60 scalefont
+setfont
+newpath
+40 640 moveto
+(ABCDE) show
+40 575 moveto
+(FGHIJK) show
+40 510 moveto
+(LMNOP) show
+40 445 moveto
+(QRSTU) show
+40 380 moveto
+(VWXYZ) show
+40 305 moveto
+(abcdefghijklm) show
+40 240 moveto
+(nopqrstuvwxyz) show
+40 175 moveto
+(1234567890) show
+closepath
+
+/$fontname findfont
+12 scalefont
+setfont
+newpath
+50 148 moveto
+(A B C D E F G H I J K L M N O P Q R S T U V W X Y Z) show
+50 132 moveto
+(a b c d e f g h i j k l m n o p q r s t u v w x y z) show
+50 116 moveto
+(1 2 3 4 5 6 7 8 9 0 \! \$ \% \& \\\( \\\) \; \: \< \> ) show
+closepath
+
+/$fontname findfont
+4 scalefont
+setfont
+newpath
+50 99 moveto
+(A B C D E F G H I J K L M N O P Q R S T U V W X Y Z) show
+50 93 moveto
+(a b c d e f g h i j k l m n o p q r s t u v w x y z) show
+50 87 moveto
+(1 2 3 4 5 6 7 8 9 0 \! \$ \% \& \\\( \\\) \; \: \< \> ) show
+closepath
+showpage
+TEXT
+
+ $samplefile = $fontname . ".ps";
+ open(SAMPLE, ">samples/$samplefile") ||
+ die("Couldn't open samples/$samplefile\n");
+ print SAMPLE "$text\n";
+ close(SAMPLE);
+ system("chmod 0755 samples/$samplefile") && log_msg("Couldn't chmod individual sample file \"samples/$samplefile\" ... continuing on anyway\n");
+
+# For the "allfont.ps" files we use a standard font for the font name so
+# that in the case of non-alpha fonts we still can still read the name of
+# the font (eg symbol or dingbats).
+
+ if ($height == 700) {
+ $allsample = "samples/allfont-$allcount.ps";
+ $allcount = $allcount + 1;
+
+ log_only_msg("Creating new sample file \"$allsample\"....");
+ open(ALLSAMPLE, ">$allsample") ||
+ die("Couldn't open $allsample\n");
+ log_only_msg("done\n");
+ print ALLSAMPLE "%!\n";
+ print ALLSAMPLE "%%EndComments\n";
+ }
+
+ $alltext = <<"ALLTEXT";
+
+% t1embed : $filename $fontname
+/$samplefont findfont
+12 scalefont
+setfont
+newpath
+30 $height moveto
+($fontname : ) show
+/$fontname findfont
+20 scalefont
+setfont
+(AbCdEfGhIjKlMnOpQrStUvWxYz 0123456789) show
+closepath
+ALLTEXT
+
+ print ALLSAMPLE "$alltext\n";
+ $height = $height - 32;
+ if ($height < 100) {
+ print ALLSAMPLE "showpage\n";
+ close(ALLSAMPLE);
+ system("chmod 0755 $allsample") && log_msg("Couldn't chmod all sample sheet \"$allsample\" ... continuing on anyway\n");
+ $height = 700;
+ }
+
+ ($height);
+}
+
+#
+# Some users have had problems with perl's file globbing not working. This
+# gets a shell to do it for us. It matches all files with the extension
+# specified in the parameter, i.e. if pat = "foo" then it matches all of
+# *.foo .
+#
+
+sub do_glob {
+ ($pat) = @_;
+ local($raw, @fnames);
+ open(SHELL, "echo *.$pat|") || die("Couldn't open shell in do_glob\n");
+ $raw = <SHELL>;
+ $raw =~ s/\*\.$pat//;
+ @fnames = split(/\s/,$raw);
+ close(SHELL);
+ (@fnames);
+}
+
+# ------------------------------------------------------------------------
+# Start of program proper
+# ------------------------------------------------------------------------
+
+# Process command line arguments
+$workdir = 0;
+$dox = 1;
+$dogs = 1;
+$silent = 0;
+$samples = 0;
+$dologfile = 1;
+@argvcopy = (@ARGV);
+$numargs = @ARGV;
+for ($x = 0; $x < $numargs; $x = $x + 1) {
+ $arg = $ARGV[$x];
+ if ($arg =~ /-nox/) {
+ $dox = 0;
+ } elsif ($arg =~ /-nogs/) {
+ $dogs = 0;
+ } elsif ($arg =~ /-silent/) {
+ $silent = 1;
+ } elsif ($arg =~ /-quiet/) {
+ $silent = 1;
+ } elsif ($arg =~ /-q/) {
+ $silent = 1;
+ } elsif ($arg =~ /-samples/) {
+ $samples = 1;
+ } elsif ($arg =~ /-nolog/) {
+ $dologfile = 0;
+ } elsif ($arg =~ /-d/) {
+ $x++;
+ $workdir = $ARGV[$x];
+ } elsif ($arg =~ /-version/) {
+ die("type1inst version $version ($versiondate)\n$copyright\n");
+ } elsif ($arg =~ /-v/) {
+ die("type1inst version $version ($versiondate)\n$copyright\n");
+ } else {
+ die("Usage: $0 [-silent] [-quiet] [-q] [-nox] [-nogs] [-samples] [-version] [-v]\n");
+ }
+}
+if ((! $dox) && (! $dogs) && (! $samples)) {
+ die("$0: Nothing to do!\n");
+}
+
+if ($workdir) {
+ chdir $workdir || die "Cannot change to \"$workdir\"";
+}
+
+# Open logfile
+if ($dologfile) {
+ open(LOG, ">type1inst.log") || die "Cannot open log file \"type1inst.log\"";
+}
+
+log_only_msg("type1inst Version $version ($versiondate)\n");
+log_only_msg("$copyright\n\n");
+open (DATE, "date|") || die("Couldn't run \"date\"\n");
+$currenttime = <DATE>;
+log_only_msg("Run started at $currenttime\n");
+close(DATE);
+
+# Setup directory for font samples
+if ($samples) {
+ if (! -e "samples") {
+ # Create directory for sample text PS files
+ log_only_msg("Creating directory for samples ...\n");
+ system("mkdir samples");
+ system("chmod 0755 samples") && log_msg("Coudln't chmod \"samples\" directory\n");
+
+ } elsif (-f "samples") {
+ die("$0: remove file \"samples\" or do not use -samples option\n");
+ } else {
+ log_msg("Clearing samples directory\n");
+ system("rm -f samples/*.ps");
+ }
+ $height = 700;
+ $samplefont = "Helvetica";
+ $allcount = 0;
+ $allsample = "samples/allfont-$allcount.ps";
+ log_only_msg("Creating new sample file \"$allsample\"....");
+ open(ALLSAMPLE, ">$allsample") || die("Couldn't open all sample file \"$allsample\"\n");
+ log_only_msg("done\n");
+ print ALLSAMPLE "%!\n";
+ print ALLSAMPLE "%%EndComments\n";
+}
+
+
+# Counts how many fonts we come across
+$numpffonts = 0;
+$numgsfonts = 0;
+$nofoundry = 0;
+$badfonts = 0;
+$numskipped = 0;
+$numxremoved = 0;
+$numgsremoved = 0;
+$numxduplicates = 0;
+$numgsduplicates = 0;
+$numxbarf = 0;
+$numgsbarf = 0;
+
+if (! $silent) {
+ print "type1inst Version $version ($versiondate)\n";
+ print "$copyright\n\n";
+}
+
+$totalfonts = 0;
+foreach $filename (do_glob("pfa")) {
+ $totalfonts++;
+}
+foreach $filename (do_glob("pfb")) {
+ $totalfonts++;
+}
+foreach $filename (do_glob("pfa.gz")) {
+ $totalfonts++;
+}
+foreach $filename (do_glob("pfb.gz")) {
+ $totalfonts++;
+}
+foreach $filename (do_glob("gsf")) {
+ $totalfonts++;
+}
+if (! $silent) {
+ if ($totalfonts == 0) {
+ die("There are no PostScript fonts in this directory\n");
+ } elsif ($totalfonts == 1) {
+ print "There is 1 PostScript font in this directory\n";
+ } else {
+ print "There are a total of $totalfonts PostScript fonts in this directory\n";
+ }
+}
+
+if ($dox) {
+ %fs = &read_fonts_scale();
+}
+if (($dogs) || ($samples)) {
+ %fm = &read_fontmap();
+}
+
+# Process ASCII PS fonts
+foreach $filename (do_glob("pfa")) {
+ if (($dox && (! $fs{$filename})) ||
+ (($dogs || $samples) && (! $fm{$filename}))) {
+ ($x, $gs) = &process_font($filename);
+ if ($dox) {
+ %fs = &add_font_to_aarray($filename, $x, %fs);
+ }
+ if (($dogs) || ($samples)) {
+ %fm = &add_font_to_aarray($filename, $gs, %fm);
+ }
+ } else {
+ $numpffonts = $numpffonts + 1;
+ $numskipped = $numskipped + 1;
+ &print_progress();
+ }
+ if ($samples) {
+ ($height) = &font_sample($filename, $fm{$filename}, $height);
+ }
+}
+
+# Process binary PS fonts
+foreach $filename (do_glob("pfb")) {
+ if (($dox && (! $fs{$filename})) ||
+ (($dogs || $samples) && (! $fm{$filename}))) {
+ system("pfbtops $filename > foo");
+ ($x, $gs) = &process_font("foo");
+ system("rm foo");
+ if ($dox) {
+ %fs = &add_font_to_aarray($filename, $x, %fs);
+ }
+ if ($dogs || $samples) {
+ %fm = &add_font_to_aarray($filename, $gs, %fm);
+ }
+ } else {
+ $numpffonts = $numpffonts + 1;
+ $numskipped = $numskipped + 1;
+ &print_progress();
+ }
+ if ($samples) {
+ ($height) = &font_sample($filename, $fm{$filename}, $height);
+ }
+}
+
+# Process binary PS fonts
+foreach $filename (do_glob("pfa.gz")) {
+ if (($dox && (! $fs{$filename})) ||
+ (($dogs || $samples) && (! $fm{$filename}))) {
+ system("gunzip -c $filename > foo");
+ ($x, $gs) = &process_font("foo");
+ system("rm foo");
+ if ($dox) {
+ %fs = &add_font_to_aarray($filename, $x, %fs);
+ }
+ if ($dogs || $samples) {
+ %fm = &add_font_to_aarray($filename, $gs, %fm);
+ }
+ } else {
+ $numpffonts = $numpffonts + 1;
+ $numskipped = $numskipped + 1;
+ &print_progress();
+ }
+ if ($samples) {
+ ($height) = &font_sample($filename, $fm{$filename}, $height);
+ }
+}
+
+# Process binary PS fonts
+foreach $filename (do_glob("pfb.gz")) {
+ if (($dox && (! $fs{$filename})) ||
+ (($dogs || $samples) && (! $fm{$filename}))) {
+ system("gunzip -c $filename | pfbtops > foo");
+ ($x, $gs) = &process_font("foo");
+ system("rm foo");
+ if ($dox) {
+ %fs = &add_font_to_aarray($filename, $x, %fs);
+ }
+ if ($dogs || $samples) {
+ %fm = &add_font_to_aarray($filename, $gs, %fm);
+ }
+ } else {
+ $numpffonts = $numpffonts + 1;
+ $numskipped = $numskipped + 1;
+ &print_progress();
+ }
+ if ($samples) {
+ ($height) = &font_sample($filename, $fm{$filename}, $height);
+ }
+}
+
+# Process Ghostscript fonts
+if ($dogs || $samples) {
+ foreach $filename (do_glob("gsf")) {
+ if (! $fm{$filename}) {
+ ($x, $gs) = &process_font($filename);
+ %fm = &add_font_to_aarray($filename, $gs, %fm);
+ } else {
+ $numgsfonts = $numgsfonts + 1;
+ $numskipped = $numskipped + 1;
+ &print_progress();
+ }
+ if ($samples) {
+ ($height) = &font_sample($filename, $fm{$filename}, $height);
+ }
+ }
+}
+
+if ($dox) {
+ &write_fonts_scale(%fs);
+ system("mkfontdir"); # Generate fonts.dir
+ system("chmod 0755 fonts.dir") && log_msg("Couldn't chmod \"fonts.dir\" ... continuing on anyway\n");
+}
+if ($dogs) {
+ &write_fontmap(%fm);
+}
+
+# Finish up the all font sample file
+if ($samples) {
+ log_only_msg("Finished font sample files\n");
+ if ($height < 700) {
+ print ALLSAMPLE "showpage\n";
+ close(ALLSAMPLE);
+ system("chmod 0755 $allsample") && log_msg("Couldn't chmod \"$allsample\" ... continuing on anyway\n");
+ }
+}
+
+# Report
+if (! $silent) {
+ $totalfonts = $numpffonts + $numgsfonts + $badfonts;
+
+ # List statistics
+ print "-------------------------------------------------------\n";
+ if ($totalfonts == 0) {
+ print "No fonts were found in this directory\n";
+ } elsif ($totalfonts == 1) {
+ print "1 font was found in this directory\n";
+ } else {
+ print "$totalfonts fonts found\n";
+ }
+ if ($numpffonts == 1) {
+ print "1 was a PostScript font\n";
+ } elsif ($numpffonts > 1) {
+ print "$numpffonts were standard PostScript fonts\n";
+ }
+ if ($numgsfonts == 1) {
+ print "1 was a Ghostscript font\n";
+ } elsif ($numgsfonts > 1) {
+ print "$numgsfonts were Ghostscript fonts\n";
+ }
+ if ($numskipped == 1) {
+ print "\n";
+ print "I skipped one of these fonts because it already had\n";
+ print "an overriding entry in both fonts.scale and/or Fontmap\n";
+ print "(X Windows font or Ghostscript font respectively).\n";
+ } elsif ($numskipped > 1) {
+ print "\n";
+ print "I skipped $numskipped of these fonts because they already\n";
+ print "had overriding entries in both fonts.scale and/or Fontmap\n";
+ print "(X Windows fonts or Ghostscript fonts respectively).\n";
+ }
+
+ # Print error messages
+ $wereerrors = 0;
+ if ($badfonts > 0) {
+ $wereerrors = 1;
+ print "-------------------------------------------------------\n";
+ if ($badfonts == 1) {
+ print "I couldn't extract a font name for 1 font in\n";
+ } else {
+ print "I couldn't extract font names for $ badfonts fonts in\n";
+ }
+ print "this directory. This means the font file had a non-standard\n";
+ print "format which this program doesn't know about or cannot do\n";
+ print "anything with. Check the README file to find out more.\n";
+ }
+ if ($dox) {
+ if ($nofoundry > 0) {
+ $wereerrors = 1;
+ print "-------------------------------------------------------\n";
+ print "For $nofoundry of these I couldn't figure out which foundry\n";
+ print "the font is from. Thus, these fonts will appear under the\n";
+ print "foundry unknown, i.e. X font name -unknown-*.\n";
+ print "Please consult the README file to see what this means.\n";
+ }
+
+ if ($numxremoved > 0) {
+ $wereerrors = 1;
+ print "-------------------------------------------------------\n";
+ if ($numxremoved == 1) {
+ print "While reading the existing fonts.scale file I saw 1 entry\n";
+ } else {
+ print "While reading the existing fonts.scale file I saw $numxremoved entries\n";
+ }
+ print "which mentioned a filename which now does not exist. Most likely\n";
+ print "you removed or renamed the file. I ignored these entries.\n";
+ }
+ if ($numxbarf > 0) {
+ $wereerrors = 1;
+ print "-------------------------------------------------------\n";
+ if ($numxbarf == 1) {
+ print "There was a line in fonts.scale I couldn't understand.\n";
+ } else {
+ print "There were $numxbarf lines in fonts.scale which I couldn't understand\n";
+ }
+ print "These were ignored.\n";
+ }
+ }
+ if ($dogs) {
+ if ($numgsremoved > 0) {
+ $wereerrors = 1;
+ print "-------------------------------------------------------\n";
+ if ($numgsremoved == 1) {
+ print "While reading the existing Fontmap file I saw 1 entry\n";
+ } else {
+ print "While reading the existing Fontmap file I saw $numgsremoved entries\n";
+ }
+ print "which mentioned a filename which now does not exist. Most likely\n";
+ print "you removed or renamed the file. I ignored these entries.\n";
+ }
+ if ($numgsbarf > 0) {
+ $wereerrors = 1;
+ print "-------------------------------------------------------\n";
+ if ($numgsbarf == 1) {
+ print "There was a line in Fontmap I couldn't understand.\n";
+ } else {
+ print "There were $numgsbarf lines in Fontmap which I couldn't understand\n";
+ }
+ print "These were ignored.\n";
+ }
+ }
+
+ if ($wereerrors) {
+ print "-------------------------------------------------------\n";
+ print "\n";
+ print "A log of errors is located in the file \"type1inst.log\"\n";
+ print "\n";
+ }
+}
generated by cgit v1.2.3 (git 2.25.1) at 2024-04-30 18:06:02 +0000