%%STARTSHELL%%
#@(#)showfont 2.1 90/07/18
# Shell script to dump postscript fonts with widths into a pretty table
# usage: showfont <fontname>
# emits postscript to display the font called <fontname> along with
# interesting font metrics.  If a file exists called <fontname>,
# the file is merged with the postscript, and a second argument is
# used for the font name.
#
#	Cell format:
# octal    decimal    hex
# height   CHARACTER
# widthps
# lbear    catwidth   rbear
#
# widthps is suitable for the widths/widthps/entries (unitwidth 10, res 720)
# cat width is same scale as CAT: (unitwidth 6, res 432)
# the Character is displayed at 18 point.

copies=1
if [ $# = 0 ]
then
    echo "usage: showfont <fontname>" >&2
    exit 1
fi
(
cat << !END!
%! PS-Adobe 1.0
%%Title: showfont -- displays the font metrics in a pretty one page table
%%Creator: Ken Marchant & Chris Lewis
%%CreationDate: March 1989
%%Pages: atend
%%
/SAVEOBJ save def
!END!

if [ -r "$1" ]
then
    cat $1
    shift
fi
font=$1
case $font in
    /*)
	font=`echo $font | sed -e 's/^.//'`
	;;
esac
cat << !ENDTHING!

(START showfont display $font `date`\n) print
flush
/FONTname ($font) def

%%  Setup functions used and etc...

/rowmove {
    /I exch def
    I 16 mod 30 mul 72 add
    680 I 16 idiv 30 mul sub
    moveto
} def

/widths 259 array def
/widthps 259 array def
/heights 259 array def
/lbear 259 array def
/rbear 259 array def
/tmp 1 string def
.5 setlinewidth

/Helvetica findfont 9 scalefont setfont

%% Draw the grid around the cells
%% and add the hex labels to the outside of the box

0 1 16
{
    /i exch def
    /j i 30 mul def
    %% vertical lines
    j 62 add dup 220 moveto
    700 lineto
    stroke

    %% horizontal lines
    j 220 add dup 62 exch moveto
    542 exch lineto
    stroke

    i 16 ge { clear exit } if

    %% hex across the top
    j 77 add dup 705 moveto
    i 16 (   ) cvrs show

    %% hex along the sides
    50 670 j sub 12 add moveto
    i 16 (   ) cvrs show
}
for

%	scale width in points at 18pts to width in 1/720'nds at 10 point.
/myscaleps {
    720 mul 72 div 10 mul 18 div round cvi
} def


%	scale width in points at 18 pts, to width in 1/432'nds at 6 point.
/myscale {
    2 mul
    % 10 mul round cvi 10 div
    round cvi
} def

/irmove {
    CY add exch
    CX add exch moveto
} def

%% Print out the headings in the font to be displayed and Times-Roman

/Times-Roman findfont 18 scalefont setfont
295 FONTname stringwidth pop .5 mul sub 750 moveto FONTname show

FONTname findfont 18 scalefont setfont
295 FONTname stringwidth pop .5 mul sub 730 moveto FONTname show

%% loop thru all the charcters and display in 18 point
%% insert the character widths into the widths array
0 1 258
{
    newpath
    /i exch def
    i rowmove
    i 255 gt {
	i 256 eq { /tmp (ff) def } if
	i 257 eq { /tmp (ffi) def } if
	i 258 eq { /tmp (ffl) def } if
    } {
	/tmp 1 string def
		 tmp 0 i put
    } ifelse
    tmp show

    widths i tmp stringwidth pop dup /width exch def
    myscale put

    widthps i tmp stringwidth pop myscaleps put

    %	Set current point again.
    i rowmove
    /curx currentpoint pop def

    % retrieve bounding box info.
    tmp false charpath flattenpath pathbbox
    /ury exch def
    /urx exch def
    /lly exch def
    /llx exch def

    % calc left bearing as leftx - curx

    lbear i llx curx sub myscale put

    % calc height as upper y - lower y

    heights i ury lly sub myscale put

    % calc right bearing as width - upper x

    rbear i width urx curx sub sub myscale put

}
for

%%display the widths in the widths array

/Helvetica-Narrow findfont 5 scalefont setfont

0 1 258
{
    /i exch def

    i rowmove

    currentpoint /CY exch def /CX exch def

    2 -8 irmove
    widths i get (       ) cvs show

    -9 8 irmove
    heights i get (       ) cvs show

    -9 0 irmove
    widthps i get (       ) cvs show

    -9 -8 irmove
    lbear i get (       ) cvs show

    12 -8 irmove
    rbear i get (       ) cvs show

    -9 15 irmove
    i 8 (   ) cvrs show

    1 15 irmove
    i 10 (   ) cvrs show

    12 15 irmove
    i 16 (   ) cvrs show
}
for

FONTname findfont 18 scalefont setfont
72 144 moveto (This is a test of this font.) show
72 124 moveto (ABCDEFGHIJKLMNOPQRSTUVWXYZ) show
72 104 moveto (abcdefghijklmnopqrstuvwxyz) show
72 84 moveto (0123456789!@#\$\\%^&*\\(\\)_+=) show
72 64 moveto ({}[]\\\\|;:'",.<>?/&~\`) show

showpage
(END showfont display $font `date`\n) print
flush
SAVEOBJ restore
%%Pages: 1
!ENDTHING!
echo "\004\c"
)
