v07i007: PostScript program to generate .afm files

[sources-request at mirror.UUCP]

Submitted by: liam at cs.qmc.ac.uk (William Roberts)
Mod.sources: Volume 7, Issue 7
Archive-name: getmetrics

[  This has seen distribution elsewhere on the net; my fault for the
   delay which led to that.  --r$  ]

This message contains a PostScript program which generates
.afm files from the font descriptions in the LaserWriter +.
These files can then be used with the TranScript software to produce
new font files to allow these fonts to be used with Ditroff.  I suspect
that using them with troff will be about as much fun as pulling your
own teeth out, but you are welcome to try.

William Roberts         ARPA: liam at cs.qmc.ac.uk  (gw: cs.ucl.edu)
Queen Mary College      UUCP: liam at qmc-cs.UUCP
LONDON, UK              Tel:  01-980 4811 ext 3900

#         This is a shar archive.
#         Remove everything above and including the cut line.
#         Then run the rest of the file through sh.
#--------cut--------cut--------cut--------cut--------cut--------
#! /bin/sh
#  shar:  Shell Archiver
#         Run the following with /bin/sh to create:
#             README
#             getmetric
#             afm.awk
#             getafms
# This archive created: Fri Jul 18 11:05:38 BST 1986
echo shar: extracting "README" '('1626 chars')'
if test -f README
then
    echo shar: will not overwrite existing file "README"
else
cat << \SHAR_EOF > README
W.T. Roberts    18/7/86

This shar file contains three components needed to generate the
Adobe Font Metric (.afm) files for the internal fonts in the
LaserWriter or LaserWriter+.  These files can then be used to
make Ditroff device descriptions that can be used by
psroff/psdit to access these fonts from Ditroff.

getmetric       PostScript code that prints afm files to
                the LaserWriter's stdout stream. Edit it to
                select which fonts you want afm files for.

afm.awk         Awk script to extract the afm files from the
                TranScript logfiles (does SYSV have these?)

getafms         Shell script that uses sed to get rid of
                carriage returns in stdin and then puts it
                through afm.awk


On our 4.2 system, the logfile used by the print spooler to record
printer errors on our laserwriter is called "/usr/adm/laser-log"
and the following command gets the afm files:

   lpr -Plaser getmetric; tail -f /usr/adm/laser-log | getafms

The second command reads the end of the logfile and keeps
trying upon reaching the end-of-file; this has the effect that
you watch the file as it grows. The output on the LaserWriter
stdout stream gets put into this file, so getafms can extract
the .afm files. Each such file is created with the standard name
in the current directory.

If someone uses it on a SYSV system (or lookalike), could they
post the appropriately modified instructions for use.

William Roberts         ARPA: liam at cs.qmc.ac.uk  (gw: cs.ucl.edu)
Queen Mary College      UUCP: liam at qmc-cs.UUCP
LONDON, UK              Tel:  01-980 4811 ext 3900
SHAR_EOF
if test 1626 -ne `wc -c < README`
then
    echo shar: error transmitting "README" '('should be 1626 chars')'
else
    echo README
fi
fi
echo shar: extracting "getmetric" '('4195 chars')'
if test -f getmetric
then
    echo shar: will not overwrite existing file "getmetric"
else
cat << \SHAR_EOF > getmetric
%!
% Get the Font Metric Information from an internal font
%
% Written by W.T. Roberts, Queen Mary College, LONDON UK
% (liam at cs.qmc.ac.uk, liam at qmc-cs.UUCP)

statusdict begin 0 setjobtimeout end

/xdef {exch def} def
/sp {( ) print} def
/nl {(\n) print flush} def
/= {dup type (stringtype) ne {buffer cvs} if print} def
/toupper {
   dup dup (a) 0 get ge exch (z) 0 get le and
   {(a) 0 get sub (A) 0 get add} if  % convert to lowercase
} def

/buffer 250 string def
/getmetric {
  /VMsave save def
  dup findfont /fontdict xdef       % grab the font
  dup (AFM FILE ) print = (.afm) print nl
  (StartFontMetrics 1.0) print nl
  (FontName ) print = nl        % record PostScript name
  getFontInfo
  getFontBBox
  recorddefaults                % get the default encoding
  miscHeights
  (StartCharMetrics) print nl
  getEncoding
  (EndCharMetrics) print nl
  (EndFontMetrics) print nl
  VMsave restore
} def

/getFontInfo {
  (Comment Generated from PostScript version ) print version = nl
  (Comment by getmetric.ps (Written by W.T. Roberts, qmc-cs.UUCP))
  print nl
  fontdict /FontInfo get
  {exch buffer cvs dup
   dup 0 get toupper 0 exch put         % convert first letter to UC
   print sp = nl} forall
} def

/getFontBBox {
  /fmat fontdict /FontMatrix get def
  fontdict /FontBBox get aload pop          % llx lly trx try
  fmat transform 4 2 roll fmat transform    % TRX TRY LLX LLY
  4 {1000 mul round cvi 4 1 roll} repeat    % convert to 1000 point
  (FontBBox) print
  2 {exch sp = sp =} repeat
  nl
} def

/maketempfont { % encoding vector
  fontdict length dict /testdict xdef
  fontdict
   { 1 index /FID ne {testdict 3 1 roll put}{pop pop} ifelse
   } forall     % copy contents of fontdict
  testdict begin
    /Encoding encoding def
  end     % install the encoding vector
  /TestName testdict definefont 1000 scalefont setfont
} def

/recorddefaults {
  fontdict /CharStrings get
  length 1 sub array /names xdef  % make array to hold the names
  /#name 0 def
  /defaultEncoding 256 dict def
  fontdict begin
   defaultEncoding begin
    0 1 Encoding length 1 sub
    {dup Encoding exch get dup
     /.notdef ne
       {dup recordname exch def}
       {pop pop}
    ifelse % record number
    } for
   end
  end
} def

/recordname {
  userdict begin
    names exch #name exch put
    /#name #name 1 add def
  end
} def

/getEncoding {
  fontdict /CharStrings get
  {pop dup dup
   /.notdef eq exch                     % ignore .notdef
   defaultEncoding exch known or        % and defaultEncoding names
    {pop} {recordname} ifelse
  } forall
  /namecount names length def /first 0 def
  % while (true)
  {namecount 256 le
    {names first namecount getinterval}
    {names first 256 getinterval}
   ifelse
   /encoding xdef maketempfont
   0 1 encoding length 1 sub {getcharmetric} for
   /namecount namecount 256 sub def
   /first first 256 add def
   namecount 0 le {exit} if
  } loop
} def

/miscHeights {
  /encoding fontdict /Encoding get def maketempfont     % make real font
  defaultEncoding begin
    p d x H     % get character codes
  end
  nbbox (CapHeight ) print dup = nl 4p
  nbbox (XHeight ) print dup = nl 4p
  nbbox (Ascender ) print dup = nl 4p
  nbbox (Descender ) print 2 index = nl 4p
} def

/4p {pop pop pop pop} def
/nbbox {char exch 0 exch put charbbox} def
/charbbox {
  newpath 0 0 moveto char true charpath flattenpath pathbbox
  4 {4 1 roll round cvi} repeat
} def

/char ( ) def
/getcharmetric {
  /n xdef       % grab the character code
  char 0 n put  % make a string from it
  /label encoding n get def % record its text name
  (C ) print
  defaultEncoding label known
    {defaultEncoding label get}{-1} ifelse
  = ( ; ) print
  char stringwidth round cvi /ywidth xdef round cvi /xwidth xdef
  ywidth 0 eq
    {(WX ) print xwidth = }
    {(W ) print xwidth = sp ywidth =}
  ifelse
  ( ; N ) print label =
  ( ; B) print
  charbbox 4 2 roll 2 {exch sp = sp =} repeat
  label /f eq { ( ; L i fi ; L l fl) print} if
  ( ;) print nl
} def
%

0 0 moveto
100 100 lineto stroke   % convince the machine it isn't idle!

% FontDirectory {pop getmetric} forall    % get EVERY font metric file
/Times-Roman getmetric

(END OF FONT METRICS) print nl
SHAR_EOF
if test 4195 -ne `wc -c < getmetric`
then
    echo shar: error transmitting "getmetric" '('should be 4195 chars')'
else
    echo getmetric
fi
fi
echo shar: extracting "afm.awk" '('237 chars')'
if test -f afm.awk
then
    echo shar: will not overwrite existing file "afm.awk"
else
cat << \SHAR_EOF > afm.awk
BEGIN   { STARTED = "FALSE"}

$1=="AFM" &&  $2=="FILE" \
        { AFM=$3; STARTED = "TRUE"; next;}

$1=="StartFontMetrics", $1=="EndFontMetrics" \
        { print $0 >AFM }

/END OF FONT METRICS/ && STARTED == "TRUE" \
        { exit }
SHAR_EOF
if test 237 -ne `wc -c < afm.awk`
then
    echo shar: error transmitting "afm.awk" '('should be 237 chars')'
else
    echo afm.awk
fi
fi
echo shar: extracting "getafms" '('35 chars')'
if test -f getafms
then
    echo shar: will not overwrite existing file "getafms"
else
cat << \SHAR_EOF > getafms
sed -e 's/
SHAR_EOF
if test 35 -ne `wc -c < getafms`
then
    echo shar: error transmitting "getafms" '('should be 35 chars')'
else
    echo getafms
fi
fi
#         End of shar archive
exit 0