%!PS-Adobe
% print_glyphs.ps
% Copyright (C) Thomas Merz 1994-2002
%
% This PostScript program prints all glyphs in a font along
% with their names in alphabetical ordering.
% It requires a PostScript Level 2 or PostScript 3 interpreter.
% It also works with Acrobat Distiller.
%
% Usage:
% - The font must either be resident in the printer, or be
%   downloaded ahead of this program (as a single job).
%   Alternatively, the font can be configure in Distiller.
% - At the end of this file, enter a line with the font name, e.g.:
%   /Times-Roman ShowGlyphs
%   (Omit the percent character, but leave the leading slash '/')


/$sort 20 dict def

/Insert { % node string ==> -
    exch dup 0 get type (nulltype) eq { % ifelse
        exch [ exch 1 array 1 array ] 0 exch put
    }{ % else
        aload pop aload pop 4 2 roll 2 copy gt { % ifelse
            pop 3 -1 roll pop Insert
        }{ %else
            pop exch pop Insert
        } ifelse
    } ifelse
} def

/PrefixWalk {
    $sort begin
	cvx /!bt exch def bpwalk 
    end
} def

$sort begin
/bpwalk {
    dup 0 get type /nulltype eq { pop }{ % ifelse
	aload pop aload pop exch bpwalk exch !bt bpwalk
    } ifelse
} bind def
    
end % $sort

/DictSort {	% dict ==> array
    dup length array /a exch def
    $sort begin
    /tree 1 array def
    { pop 50 string cvs tree exch Insert } forall
    /ndx 0 def
    tree { a ndx 3 -1 roll put /ndx ndx 1 add def } PrefixWalk
    a
} bind def

/ShowGlyphs {		             % font name ==> -
    /buffer 100 string def
    /FontName 100 string def
    /fs 20 def		             % font size
    /ts 7 def		             % font size of caption
    /ls fs 1.75 mul def	         % line spacing

    dup FontName cvs pop
    findfont fs scalefont /F exch def

    clippath pathbbox
    20 sub /top exch def
    20 sub /right exch def
    20 add /bottom exch def
    40 add /left exch def

    /textfont /Helvetica-Narrow findfont ts scalefont def
    /x left def
    /y top fs sub def

    /Helvetica-Bold findfont fs scalefont setfont
    x y moveto
    /y y ls sub def 

    % Check the interpreter's language level...
    /languagelevel where { pop languagelevel }{ 1 } ifelse

    % ...and quit if Level 1
    2 lt {
	(Error: this program doesn't work on PostScript Level 1 printers!)show
	showpage
	stop
} if

    FontName show		% print font name

    % Try to find the dictionary with the character names
    F /CharStrings known {
	    F /CharStrings get
    }{
	(: Couldn't find character names (CharStrings dictionary)!) show
	showpage
	quit
    } ifelse

    DictSort				% sort the character names

    { % forall
	/GlyphName exch def		% remember the character name

	x y moveto F setfont	% the actual character...
	GlyphName cvn glyphshow

	x y ts 2 mul sub moveto	% ...and its glyph name
	textfont setfont GlyphName buffer cvs show

	/x x fs 2 mul add def
	x right gt { /x left def /y y fs 2 mul sub def } if 
	y bottom lt {
	    /y top fs sub def /x left def
	    showpage
	    x y moveto
	    /y y ls sub def 
	    /Helvetica-Bold findfont fs scalefont setfont
	    FontName show		% print font name
	} if
    } forall
    y top ls sub ne x left ne or { showpage } if

} bind def

% Example:
%/Times-Roman ShowGlyphs