131 lines
3.2 KiB
PostScript
131 lines
3.2 KiB
PostScript
|
%!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
|