🚀 go-pugleaf

Hallo netland,
there were many requests for afm-file generation, so I'll post it via the net.

Here is afm.ps, which should be downloaded with TranScript's
lp-interface. It works on a Apple Laserwriter Plus and let's 
pscatmap build the troff-tables needed. 
Note: you still have to write the font-familys description-file!
-------------------------------------------
: to unbundle set umask and sh this file
trap "rm -f /tmp/bundle$$" 1 2 3 15
exec > /tmp/bundle$$
echo >&2 afm.ps
afm.ps
sed 's/^	//' > afm.ps << 'End of afm.ps'
	%!PS-Adobe-2.0
	%% Title:   afm.ps
	%% Creator: Matthias Frei, University of Bochum, West-Germany
	%%	    e-mail: ...uunet!unido!rubmez!frei
	%% Date:    April 1988
	%%
	%% PostScript Program to create an afm-file for a given Font
	%% (think it works for normal left to right, up down fonts only)
	%%
	%% afmfile is generated on %stdout, 
	%% it can be found in /usr/spool/lp/transcript/laserprinter.log
	%% using TranScript's lp-interface after execution
	%%
	%% The Fontkey has to be on the stack, invoking afm
	%%
	%% EndComments
	%% BeginProcSet
	/afmdict 50 dict def
	afmdict begin
	  
	  /charcount 0 def
	  /showstring 1 string def
	  /str 10 string def
	  /wx 4 string def
	  /name 30 string def
	  /char 1 string def
	
	%% procedure to print line and flush stream
	/nl { = flush } bind def
	
	%% reverse 4 numbers on stack and mult with 1000
	/reverse {
	  1000 mul round cvi /a exch def
	  1000 mul round cvi /b exch def
	  1000 mul round cvi /c exch def
	  1000 mul round cvi /d exch def
	  a b c d
	  } bind def
	
	%% print integer on the stack with leading blank
	/printint {
	  (     ) str cvs pop 
	  str cvs pop str print
	  } bind def
	
	%% afm procedure
	/afm {
	  dup /thefont exch findfont def  %% copy the Fonts Key
	  /FD FontDirectory def		%% get Masterdictionary of fonts
	  /f exch FD exch get def	%% f is the Fonts Dictionary now
	  /fi f /FontInfo get def	%% fi is the Fonts InfoDictionary
	  %% print Header of the afm File
	  (StartFontMetrics 1.0) nl
	  (Comment created by a PostScript-Program from Matthias Frei) print
	  ( @ University of Bochum, W-Germany (frei@uunet%rubmez.UUCP)) nl
	  (FontName ) print f /FontName get nl
	  fi begin %% Make Info current
	  (FullName ) print FullName nl
	  (FamilyName ) print FamilyName nl
	  (Weight ) print Weight nl
	  (ItalicAngle ) print ItalicAngle nl
	  (isFixedPitch ) print isFixedPitch nl
	  (UnderlinePosition -106) nl
	  (UnderlineThickness 73) nl
	  (Version ) print version nl
	  (Notice ) print Notice nl
	  end %% of FontInfo
	  f /FontBBox get 
	  (FontBBox ) print
	  pstack clear
	  thefont 1 scalefont setfont %% fetch the Font
	  (CapHeight ) print newpath 0 0 moveto 
	  (H) true charpath flattenpath pathbbox reverse pop pop pop nl
	  (XHeight ) print newpath 0 0 moveto 
	  (x) true charpath flattenpath pathbbox reverse pop pop pop nl
	  (Ascender ) print newpath 0 0 moveto 
	  (d) true charpath flattenpath pathbbox reverse pop pop pop nl
	  (Descender ) print newpath 0 0 moveto 
	  (p) true charpath flattenpath pathbbox reverse pop nl pop pop
	  newpath 0 0 moveto 
	  (StartCharMetrics) nl
	  /charcount 0 def
	  thefont /Encoding get
	  %% forall characters
	    { /charname exch def
	    charname /.notdef ne %% if defined
	      { 
	      %% first compute and print charwidth
	      /charwidth showstring dup 0 charcount
	      put dup /char exch def stringwidth pop 1000 mul def
	      (C ) print charcount str cvs pop str print (;) print
	      (WX ) print charwidth round cvi wx cvs pop wx print (;) print
	      %% then the CharName
	      (N ) print charname name cvs pop name print (;) print
	      %% next is  the BoundingBox
	      0 0 moveto
	      ( B ) print char true charpath flattenpath pathbbox reverse
	      printint printint printint printint
	      newpath
	      (;) nl
	      (          ) str cvs pop
	      (    ) wx cvs pop
	      ( ) char cvs pop
	      (                  ) name cvs pop
	      flush
	      wait
	      }
	     if
	    /charcount charcount 1 add def
	  } forall
	  (EndCharMetrics) nl
	  (EndFontMetrics) nl
	} bind def 
	%% end of procedure afm
	
	%% for Communicationsprogram (beware of Bufferoverflow)
	/wait {
	  1 1 400 { pop } for
	  } bind def
	
	%% EndProcSet
	%% EndProlog
	%% Test the program with some fonts 
	
	/NewCenturySchlbk-Bold afm
	/NewCenturySchlbk-Roman afm
	/NewCenturySchlbk-Italic afm
	
	/Bookman-Light afm
	/Bookman-LightItalic afm
	/Bookman-Demi afm
	
	/AvantGarde-Book afm
	/AvantGarde-BookOblique afm
	/AvantGarde-Demi afm
	
	end
	%% Trailer
End of afm.ps
wc afm.ps
diff - /tmp/bundle$$ << 'End of wc' >&2
    138    616    3880 afm.ps
End of wc
rm -f /tmp/bundle$$
exit
--------- End of Shell Archiv ----------------

Matthias Frei

--------------------------------------------------------------------
Snail-mail:                    |  E-Mail address:
Center for Microelectronics    |                 UUCP  frei@rubmez.uucp        
University of Bochum           |                (...uunet!unido!rubmez!frei)
4630 Bochum 1, P.O.-Box 102143 |
West Germany                   |