diff options
author | Timothy Pearson <kb9vqf@pearsoncomputing.net> | 2013-01-27 01:00:43 -0600 |
---|---|---|
committer | Timothy Pearson <kb9vqf@pearsoncomputing.net> | 2013-01-27 01:00:43 -0600 |
commit | 2c4a290ae270924340991931a9e0ca793f8e9443 (patch) | |
tree | 7aa3b953d70dbdd6a5de525cdd7a5f4319ee1dd5 /knetworkconf/backends/type1inst | |
parent | 567923f30f7c0700cb526f26c20b5577bfe2a802 (diff) | |
download | tdeadmin-2c4a290ae270924340991931a9e0ca793f8e9443.tar.gz tdeadmin-2c4a290ae270924340991931a9e0ca793f8e9443.zip |
Rename a number of libraries and executables to avoid conflicts with KDE4
Diffstat (limited to 'knetworkconf/backends/type1inst')
-rwxr-xr-x | knetworkconf/backends/type1inst | 1387 |
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"; - } -} |