%!PS-Adobe-2.0
%%Title: Blue Book Program 19, on page 215
%%Creator: Adobe Systems Incorporated 
%%CreationDate: Fri Dec 29 14:05:03 PST 1989
%%EndComments

/modwidthsdict 8 dict def
/ModifyWidths
  { modwidthsdict begin
    /uniqueid exch def
	/newwidths exch def
	/newfontname exch def
	/basefontname exch def
	/basefontdict basefontname findfont def
	
	/numentries basefontdict maxlength 1 add def
	
	basefontdict /UniqueID known not
	  { /numentries numentries 1 add def } if
	/newfont numentries dict def
	basefontdict
	  { exch dup dup /FID ne exch
	    /FontBBox ne and
		{ exch newfont 3 1 roll put }
		{ pop pop }
	    ifelse
	  } forall
	/newFontBBox basefontdict /FontBBox get
	  aload length array astore def	
		
	newfont /FontBBox newFontBBox put
	newfont /FontName newfontname put
	newfont /Metrics newwidths put
	newfont /UniqueID uniqueid put
	newfontname newfont definefont pop
	end
  } def

/roundwidthsdict 13 dict def

roundwidthsdict /showstring 1 string put

/roundwidths
  { roundwidthsdict begin
    /ptsize exch def
    /resolution exch def
    /fontname exch def
    
    /thefont fontname findfont def
    /newwidths thefont /CharStrings get length
      dict def
    
    /pixelsperem ptsize 72 div resolution mul def
    /unitsperpixel 1000 pixelsperem div def
    gsave
      nulldevice
      thefont 1 scalefont setfont
      /charcount 0 def
      thefont /Encoding get
        { /charname exch def
          charname /.notdef ne
            { /charwidth showstring dup 0 charcount
              put stringwidth pop 1000 mul def
              /multiples charwidth unitsperpixel div
              round cvi def
              /newcharwidth unitsperpixel multiples
              mul def
              newwidths charname newcharwidth put
            } if
          /charcount charcount 1 add def
          } forall
        grestore
        newwidths
        end
      } def
      
      /findresdict 4 dict def
      findresdict begin
      /tempmatrix matrix def
      /epsilon 0.001 def
      end
      /findresolution
      { findresdict begin
        72 0 tempmatrix defaultmatrix dtransform
        /y exch def /x exch def
        x abs epsilon gt y abs epsilon gt and
        { stop }
        
        { x dup mul y dup mul add sqrt }
        ifelse
        
      end
      } def
    
    /showstring
     { (HOHOHOHO oaobocodoeofogohoiojoko) show
       (lomonopoqorosotouovowoxoyoz) show } def
     /res findresolution def
     /uid /Times-Roman findfont dup /UniqueID known
       {/UniqueID get} {pop 0} ifelse def
     /rwid /Times-Roman res 6 roundwidths def
     /Times-Roman /TR6 rwid uid 1 add ModifyWidths
     /Times-Roman findfont 6 scalefont setfont
     130 560 moveto showstring
     /TR6 findfont 6 scalefont setfont
     130 560 6 sub moveto showstring
     /rwid /Times-Roman res 7 roundwidths def
     /Times-Roman /TR7 rwid uid 2 add ModifyWidths
     /Times-Roman findfont 7 scalefont setfont
     130 500 moveto showstring
     /TR7 findfont 7 scalefont setfont
     130 500 7 sub moveto showstring
     /rwid /Times-Roman res 8 roundwidths def
     /Times-Roman /TR8 rwid uid 3 add ModifyWidths
     /Times-Roman findfont 8 scalefont setfont
     130 440 moveto showstring
     /TR8 findfont 8 scalefont setfont
     130 440 8 sub moveto showstring
     showpage
     
% But what does it do?