larsha@ifi.uio.no (Lars H}kedal) (03/11/91)
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 --------------------------------------------------------------------------------