Tag Archives: postscript

Postscript Template Strings

I’m quite proud of this, even though the program I was writing it for ended up staying a shell script.

% realloc a string
/growstring {  % () -> ()
  dup length 2 mul string dup 0 4 3 roll putinterval
} bind def

% Just a simple template engine.
%
% Anything between curly braces is PS code which returns a
% single object that will be converted to string via cvs.
%
% The embedded code has full access to the environment and
% may invoke the template procedure recursively.
%
% To embed a literal brace, embed a literal string: { ({) }
%
/template {  % (txt { - -> any } txt) -> ()
  10 dict begin /src exch def
    /rv 256 string def
    /rvidx 0 def
    /template-append {
      /o exch def
      { /o load rv rvidx rv length rvidx sub getinterval
        { cvs } stopped
        { /rv rv growstring def }
        { length rvidx add /rvidx exch def exit } ifelse
      } loop
    } //bind def
    {
      % find { or end, appending text
      src ({) search {
        template-append pop
        % search excludes '{', we need it for token
        length 1 add /n exch def
        src dup length n sub n getinterval /src exch def
      } { template-append exit } ifelse

      % (src) is now ({code}...)
      % eval the code and append any resulting objects
      src token {
        exch /src exch def
        % a closure to restore our hidden local scope
        [ exch /exec cvx currentdict /begin cvx ] cvx
        end exec template-append
      } if
    } loop
    rv 0 rvidx getinterval
  end
} bind def

% tests
/bar (ggg) def
(foo) template ==
(foo{bar} foo) template ==
({bar}foo) template ==
(foo{bar}) template ==
(foo{({)}{bar}) template ==
/rvidx (uuu) def
(foo{rvidx}foo) template ==
55 44 33 (foo{1 index}foo) template == pop pop pop
(sss{ ({rvidx}) template }www) template ==

Postscript Underline

  • Supports all show operators, including custom procedures.
  • Can draw a single underline rect across multiple show operations (and will be correct, if the currentfont remains the same).
  • Supports any and all font matrix munging.
  • Supports underlines of a different color from the text.
  • The second calling variant draws underlines underneath the text.
  • Uses font’s underline definitions if available, commonly used defaults (i.e., the values found in most fonts) if not.

Exercise for the reader: have it simply draw the rect and leave it in the currentpath for the caller to have fun with: clip, stroke, whatever.

TODO: Vertical fonts. Do thy have underlines? (I guess it would be “sidelines.”)

%!
% Public Domain 2014 by the other anonymous
%
% startX startY underline -
% {show} underline -
%
% (startX,startY) is the point where the text was started. The underline
% will follow the text to the currentpoint.
%
% The {show} variant draws the underline underneath the text. This allows
% the underline to be a different color than the text (the underline color
% will be the current color and {show} may change the text color).
% To draw the underline underneath the text, we have to exec the {show}
% procedure twice. We clip it into nothing so that it is only drawn once.
%
% NOTE: Since we exec {show} multiple times, it is NOT allowed to modify
% anything besides the graphics state.
/$underline 10 dict def
/underline {
  $underline begin
    dup xcheck {
      gsave
        currentpoint /y0 exch def /x0 exch def
        0 0 0 0 rectclip x0 y0 moveto
        end dup exec $underline begin
        currentpoint /y1 exch def /x1 exch def
      grestore
    } {
      /y0 exch def /x0 exch def
      currentpoint /y1 exch def /x1 exch def
      [ x1 y1 /moveto cvx ] cvx
    } ifelse

    /mtx currentfont /FontMatrix get def
    /info currentfont /FontInfo get def
    0 info /UnderlineThickness 2 copy known { get } { pop pop 50 } ifelse
    0 info /UnderlinePosition 2 copy known { get } { pop pop -100 } ifelse
      mtx transform /uy exch def /ux exch def
      mtx dtransform /uh exch def /uw exch def

    x0 ux add        y0 uy add        moveto
    x0 ux add uw sub y0 uy add uh sub lineto
    x1 ux add uw sub y1 uy add uh sub lineto
    x1 ux add        y1 uy add        lineto
    closepath fill
    x0 y0 moveto
  end exec
} bind def

% Test:
/Times-Roman 100 selectfont
50 300 moveto { (abcdefghi) show } underline
1 0 1 setrgbcolor
50 200 moveto { 0 setgray 1 1 (jklmnopqr) ashow } underline
/Times-Roman [ 100 5 5 100 -40 -30 ] selectfont
50 100 moveto { (sjtuvwxyz) show } underline
showpage