🚀 go-pugleaf

Here's a 'font book' PS file some people cooked up here at MIT Project
Athena.  Warning:  it takes a long time to print, since it will put
every character of every font through the font cache.


%!
 %%%% 
 %%%% 
 %%%% fontbook.PS
 %%%% 
 %%%% Mark W. Eichin <eichin@athena.mit.edu> 1/10/88
 %%%% 
 %%%% Prints a set of all of the encoded fonts in the printer, 32 by 8
 %%%% characters per page, labelled in octal with the name across  the
 %%%% top of the page. Prints a coverpage at the end (see  fontpage.PS
 %%%% for more details.)
 %%%% 
 %%%% The sort routine is from <amgreene@athena.mit.edu>, with a lot of
 %%%% stuff squished in and around the ends.
 %%%% 
 %%%% The page driver is a reengineering of an earlier project  which
 %%%% was not portable between the LaserWriter and LPS-40. This version
 %%%% has the math worked out; note that these two printers dump pages
 %%%% in the opposite order. This file is set for the LPS-40; if you 
 %%%% need the correct page order for the LaserWriter, examine the
 %%%% comments near the end of the file. 
 %%%% 
 %%%% No More Collating! Yaaaay!
 %%%%  

 %%%% STANDARD DEFINITIONS 
/pica { 12 mul } def
/inch { 72 mul } def
/over %%%% a b ==> a b a
{
  1 index
} bind def
/pageside 11 inch def
/pagetop 8.5 inch def


 %%%% Specific local definitions 
/sidelen 9 inch def %%%% the height of the box of chars
/toplen  6 inch def %%%% the width of the box of chars 

/nrowsofboxes 32 1 add def %%%% Number of rows (chars + labels) 
/ncolsofboxes 8 1 add def %%%% Number of columns (chars + labels) 

/xbox toplen ncolsofboxes div def %%%% x dimension of the box 
/ybox sidelen nrowsofboxes div def %%%% y dimension of the box 
/underpad 2 def	%%%% padding under the characters
 
/boxfontsize ybox underpad 2 mul sub def
  %%%% the font size is a bit smaller than the box 

/labtmp (\\00x) def
/labelfont /Times-Roman findfont boxfontsize scalefont def

/mcenter %%%% width-of-box width-of-thing ==> offset-from-left
{
  sub 2 div %%%% a/2 - b/2 == (a-b)/2
} def

/center	%%%% (string) width-of-box ==> (string) offset-from-left
{
  over stringwidth pop %%%%  just leave x of stringwidth
  mcenter %%%% calculate offset 
} def

/octallabel %%%% row-number ==> (string)
{
  dup 8 mod cvi ( ) cvs labtmp exch 2 exch putinterval
  8 div cvi ( ) cvs labtmp exch 1 exch putinterval
  labtmp
} def

/achar ( ) def

/doline { %%%% line-number ==> -
 /linnum exch def
 currentpoint %%%% mark where we are
 toplen 0 rlineto stroke %%%% draw the line 
 linnum 0 ge {
 over over moveto %%%% go back to the side
 labelfont setfont
 linnum octallabel xbox center
   underpad rmoveto 
   show %%%% draw the side label

 dispfont setfont
 moveto
 xbox 0 rmoveto 
 currentpoint
 0 1 7
   {
     linnum 8 mul add cvi achar 0 3 -1 roll put %%%% make a 1-char string 
     achar xbox center underpad rmoveto show 
     moveto
     xbox 0 rmoveto 
     currentpoint
   }
 for
 } if
 pop pop %%%% clear currentpoint 
} def

/docolumn { %%%% column-number ==> -
 /colnum exch def %%%% save column number 
 0 sidelen rlineto %%%% mark vertical line 
 currentpoint stroke %%%% draw it and reference top
 ybox sub moveto %%%% jump back down
 colnum 0 eq { (octal) } 
 { colnum 9 eq { ( ) } { colnum 1 sub cvi ( ) cvs } ifelse }
 ifelse
 xbox center underpad rmoveto show
} def


/MAIN {	%%%% fontname ==> -
 %%%% save the name of the font we are showing
/fontname exch def
 %%%% open the font and scale it, so we have it around
/dispfont fontname cvn findfont boxfontsize scalefont def 
 %%%% move to the upper corner 
pagetop toplen mcenter 
pageside sidelen mcenter
translate %%%% moves to lower left corner of boxes

0 0 moveto
currentpoint
31 -1 -2
  {
    doline
    moveto 0 ybox rmoveto currentpoint
  } 
for

pop pop
0 0 0 0 moveto

labelfont setfont
0 1 9
  {
    docolumn
    moveto xbox 0 rmoveto currentpoint
  }
for

pop pop	%%%% clear the stack 
fontname toplen center %%%% center the name across the top (name) x-off 
sidelen underpad add %%%% find y 
moveto show
showpage

} def

%!
%  Sort Routine in PostScript (R)
%
%  by Andrew Marc Greene
%  Dec. 1987
% Pieces ripped out to fit into font cataloguer (Mark W. Eichin Jan 1988)
%
%  [PostScript is a trademark of Adobe Systems, Inc.]
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%


% Initialize num, which will contain number of items to sort

/num 0 def

% Get list of items to sort

FontDirectory
           { pop %%%% punt value (font), just keep key (fontname)
             /st 70 string def %%%% alloc space for name 
             /num num 1 add def	%%%% count the fontname 
             st cvs }  %%%% save the fontname on the stack
forall
 %%%% stub test:
% (Times-Bold)
% (Helvetica)
% (Symbol)
% (AvantGarde-DemiOblique)
% /num 4 def 

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% Sort Routines

% Compare top element to current "best"
% If top element is "better," switch them,
% otherwise leave top element on top;
% then roll the stack

/OneComp { /elt exch def
          elt best gt {best /best elt def} {elt} ifelse
          n 1 roll } def

% Go through n items one time, leaving "best" item on bottom
% Then decrement n and, if n>0, recursively call NComp

/NComp { /best exch def
         /n n 1 sub def
         1 1 n {pop OneComp} for
         best n 1 add 1 roll
         n 0 gt {NComp} if } def

% Initialize n to the number of elements to sort (num)
% and begin the sort

/n num def
NComp

% Display the sorted elements
 %%%%  
 %%%%  The first is for LPS40's, the second for LASERWRITERS... 
 %%%%  
 %%%%              ******************* 
      1 1 num {pop dup MAIN num 1 roll} for %%%% build an index page too
 %%%%              ********************
 %%%% 1 1 num {pop num -1 roll dup MAIN} for %%%% build an index page too
 %%%%              ********************
 %%%% 
 %%%% Note that we are just rolling the stack in different directions,
 %%%% so that we print the pages in a different order. The LaserWriter
 %%%% stacks paper face up, the LPS-40 face down (as does the DEC LN03R).
 %%%% 
 

 %%%% still put the header page last... 
gsave
 7 inch 1 inch translate
 90 rotate 1.5 dup scale labelfont setfont
 0 0 moveto
	statusdict begin
 (Fonts for the ) show
 product show
 (named ) show
 32 string printername show
	end
 0 boxfontsize neg moveto
 (postscript:/mit/postscript/fontbook.PS) show
grestore

labelfont setfont
2 inch sidelen 1 inch add translate 0 0 moveto
1 1 num {  (    ) cvs  %%%% (name) (##) 
	   gsave
	     show (: ) show show %%%% ##. name 
	   grestore 
	   0 ybox neg rmoveto %%%% moved down the next line 
	} for
showpage	    


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%  /mit/amgreene/PS/dictshow.ps

%  by Andrew Marc Greene   Dec 1987

%  End of File

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

 
%%%% Local Variables:
%%%% mode: C
%%%% comment-column:0
%%%% comment-start: "%%%% "
%%%% comment-end: " "
%%%% End:


--
John Kohl <jtkohl@ATHENA.MIT.EDU> or <jtkohl@MIT.EDU>
Digital Equipment Corporation/Project Athena
(The above opinions are MINE.  Don't put my words in somebody else's mouth!)