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, 0 insertions, 1387 deletions
diff --git a/knetworkconf/backends/type1inst b/knetworkconf/backends/type1inst
deleted file mode 100755
index 86d6425..0000000
--- a/knetworkconf/backends/type1inst
+++ /dev/null
@@ -1,1387 +0,0 @@
-#!/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-06-09 06:01:33 +0000