🚀 go-pugleaf

In article <1991Feb26.045400.439@ncsu.edu>, barefoot@hobbes.catt.ncsu.edu (Heath Roberts) writes:
> Many moons ago I retreived a piece of postscript code from this group
> which would run through the fonts available on a given printer and print
> a sample of each. I have, unfortunately, deleted it to save disk space.

> Does anyone have a copy of this or of some similar program? 

This works on our Imagen X320, running Ultrascript 4.something.
Printing 72 fonts takes about 10 minutes. I didn't write the qsort
part myself. It came in this group a long time ago. Enjoy.

LaRS Haakedal
larsha@ifi.uio.no
--------------------------------------------------------------------------------
%!
/qsortdict 7 dict def
qsortdict begin
   /q-compare 0 def		% user-supplied comparison procedure
   /q-array 1 def		% current sub-array being sorted by qsortsub
   /q-length 2 def		% length of q-array
   /q-left 3 def		% left scan index
   /q-right 4 def		% right scan index
   /q-last 5 def		% partitioning element
   /q-temp 6 def		% temporary array element
end

/qsort
{
   qsortdict begin
   /q-compare exch def
   qsortsub
   end
}
bind def

/qsortsub
{
   /q-array exch def
   /q-length q-array length def
   q-length 1 gt
   {
      /q-left 0 def
      /q-right q-length 1 sub def
      /q-last q-array q-right get def
      {
         {
            q-array q-left get q-last q-compare
            {/q-left q-left 1 add def}
            {exit}
            ifelse
         }
         loop
         {
            q-left q-right eq {exit} if
            q-array q-right get q-last q-compare
            {exit}
            {/q-right q-right 1 sub def}
            ifelse
         }
         loop
         q-left q-right eq {exit} if
         /q-temp q-array q-left get def
         q-array q-left q-array q-right get put
         q-array q-right q-temp put
      }
      loop
      q-array q-length 1 sub q-array q-left get put
      q-array q-left q-last put
      q-array q-left 1 add q-length q-left sub 1 sub getinterval
         q-array 0 q-left getinterval
         qsortsub
      qsortsub
   }
   if
}
bind def


/ph 842 def
/pw 595 def
/marg 36 def
/fh 12 def
/fontnamefont /Helvetica findfont fh scalefont def
/teststring (ABCDEFGHabcdefgh hamburger HAMBURGER) def

/nl { 
/currl currl fh dup .1 mul add sub 
       dup marg gt { def} { pop ph marg sub def showpage } ifelse } def


/rmjshow {dup stringwidth pop pw marg sub exch sub currl moveto show} def

/currl ph marg sub def

mark
FontDirectory {pop} forall ] /fonts exch def

fonts {exch dup length string cvs exch dup length string cvs lt } qsort

fonts
{

  /fname exch def

  marg currl moveto
  fontnamefont setfont
  fname dup length string cvs show
  fname  findfont fh scalefont setfont
  teststring rmjshow 
  nl
} forall

showpage
--------------------------------------------------------------------------------