Postscript: Fit Text to Area

Introduction

Recently I needed to print an arbitrarily long string of text into an specified area using PostScript. The requirement was to wrap the text and shrink the font until the text fit the area. I wasn't able to find any code to do this, so I created my own. I'm completely new to PostScript (logging ~ 20 hours total so far), so there may be better, more succinct ways to accomplish the same thing, but this works in my context anyway.

Limitations

  • Fits text to rectangular areas only
  • Although I do no believe this code will ever result in text overflowing the area, it may be slightly over aggressive in shrinking the text, for example in the case where shrinking the font size causes wrap to happen at a different word causing the text to "pack" better. To shrink only exactly as much as is required you would need to use recursion, which I did not want to get into with PostScript.
  • You are responsible for identifying the points at which your text can be split. My case was too complicated to do in PostScript, but was trivial in C++ which I was using to produce the PostScript.

The Code

Here are the methods I needed to define:

%usage: [ <proc> <scale %> doatfontscale -> -]
/doatfontscale {
     2 dict begin %reserve space for two local variables
     /savedfont currentfont def
     /savedlineheight lineheight def
     /minyreached top def %for our calculations, we always reach the bottom of the box at least
     /maxxreached leftmargin def %for our calculations, we always reach the right edge of the box at least
     dup /lineheight exch lineheight mul def
     /ypos ypos savedlineheight lineheight sub add def
     leftmargin ypos moveto
     currentfont exch scalefont setfont
     exec %execute the procedure
     savedfont setfont
     /lineheight savedlineheight def
     end
} def 

%usage: [ <value1> <value2> min -> <whichever is less> ]
/min {
     2 copy
     gt {exch} if
     pop
} def 

%usage: [ <value1> <value2> max -> <whichever is greater> ]
/max {
    2 copy
    lt {exch} if
    pop
} def

%usage [ <proc> calcreqscale -> <required scale> ]
/calcreqscale {
     %Set initial values
     /reqscale 1 def %assume no scale required until calculation shows differently
     /minyreached top def %for our calculations, we always reach the bottom of the box at least
     /maxxreached leftmargin def %for our calculations, we always reach the right edge of the box at least
     %Run the proc, we assume it will set maxxreached and minyreached
     /showresult false def
     dup exec %make a copy of the proc and run it
     /showresult true def
     %Restore variables and position
     /ypos top def %move ypos back to the top of the word wrap box
     leftmargin top moveto %move position back to the top of the word wrap box
     %Calculate the scale
     /areaused top lineheight add minyreached sub maxxreached leftmargin sub mul def
     /areaavailable top lineheight add bottom sub rightmargin leftmargin sub mul def
     /reqscale reqscale areaavailable sqrt areaused sqrt div min def
     %Handle the special case where there is a long unbroken word
     %In this case, we expect y actual to be higher on the page than y available
     /reqscale reqscale rightmargin leftmargin sub maxxreached leftmargin sub div min def
     %Return the scale
     reqscale
} def 

%usage: [ <right margin> <bottom> initializewordwrapbox -> -  ] Before calling, move to where you want the 'box' to start
/initializewordwrapbox {
    /bottom exch def
    /rightmargin exch def
    /top exch def
    /leftmargin exch def %set to current x pos
    /lineheight 6 def %this is hardcoded, but it makes sense at the font size we're using
    /ypos top def %set to current y pos
    /showresult true def
} def 

%usage: [ - newline -> -  ] Move down one line and back to the left margin
/newline {
    ypos lineheight sub
    /ypos exch def
    leftmargin ypos moveto
    /minyreached minyreached ypos min def
} def 

%usage: [ <string> printinwordwrapbox -> - ]
/printinwordwrapbox {
    dup stringwidth pop currentpoint pop add
    /newx exch def
    newx rightmargin gt {newx leftmargin ne {newline} if } if 
    dup stringwidth pop currentpoint pop add
    /newx exch def
    /maxxreached maxxreached newx max def
    showresult {show} {pop newx currentpoint exch pop moveto} ifelse %show if showresult is true
} def

Usage

%Assuming you have top leftmargin bottom, and rightmargin set...
top leftmargin bottom rightmargin initializewordwrapbox

%Use whichever language you use to generate your PostScript to split your text
%in a way that makes sense for your application.  Spaces should come before
%words, dashes after, for example.
{ [ (This) ( is) ( an) ( array) ( of) ( strings) ] { printinwordwrapbox } forall } calcreqscale doatfontscale

Disclaimer

No warranty express or implied is made for the suitability of this code in any usage.

Unless otherwise stated, the content of this page is licensed under Creative Commons Attribution-ShareAlike 3.0 License