%! print a list of available fonts
vmstatus /vmmax exch def
/vmused exch def pop
/str 128 string def
/$sort 20 dict def
/SortInit {1 array} def
/compare {gt} def

/Insert {
exch dup 0 get type (nulltype) eq
{exch [ exch 1 array 1 array ] 0 exch put}
{aload pop aload pop 4 2 roll 2 copy compare
{pop 3 -1 roll pop Insert}
{pop exch pop Insert}
ifelse
}ifelse
}def

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

/PostfixWalk{ $sort begin cvx /!bt exch def bbwalk end }def

/FontsSort&Print{
$sort
begin
/tree
SortInit
def
FontDirectory{
pop
str
cvs
dup
0
get
dup
65
lt
exch
90
gt
or
{pop}
{dup
length
string
copy
tree
exch
Insert}
ifelse
}forall
/filenameforall
where
{
pop
/str
100
string
def
(fonts/*)
{
dup
length
dup
/ln
exch
def
string
/ss
exch
def
6
ln
6
sub
getinterval
ss
exch
0
exch
putinterval
ss
ln
6
sub
(/D)
putinterval
tree
ss
Insert
}
str
filenameforall
}
if
tree
{ctext}
PrefixWalk
end
}def
$sort
begin
/bpwalk{
dup
0
get
type/nulltype
eq
{pop}{aload
pop
aload
pop
exch
bpwalk
exch
!bt
bpwalk}
ifelse
}def
/bbwalk{
dup
0
get
type/nulltype
eq
{pop}
{aload
pop
aload
pop
bbwalk
exch
!bt
bbwalk}
ifelse
}def
end
/ctext{
gsave
show
grestore
0
-12
rmoveto
currentpoint
30
lt{
300
gt{showpage
title}{310
696
moveto}ifelse
}{
pop
}ifelse
}def
/title
{
90
720
moveto
/Times-Roman
findfont
18
scalefont
setfont
gsave
(Font Directory)show
grestore
0
-24
rmoveto
/Times-Roman
findfont
12
scalefont
setfont
}def
title
FontsSort&Print
0
-18
rmoveto
(Remaining usable memory:  )show
vmmax
vmused
sub
(                         )cvs
show
(  bytes.)show
showpage
.