%%BeginResource: procset text
%
% See http://www.pjb.com.au/comp/text.html
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%        This Postscript is Copyright (c) 2014, Peter J Billam          %
% Permission is granted  to any individual or institution to use, copy, %
% modify or redistribute this software, so long as it is not resold for %
% profit, and provided this notice is retained.  It is provided "as is" %
% without any express or implied warranty.    http://www.pjb.com.au     %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% Here in text.ps, in JustifyText and LeftJustifyText,
% I could  str false charpath pathbbox  to measure the height below the line
% that the previous string takes, and the height above the line that the
% current string takes, and add those together to get the spacing needed

/warn {  % usage [(i=) i ( ix=) ix] warn
  1 dict begin
    { /x exch def
      x type (integertype) eq { x 10 20 string cvrs print } if
      x type (realtype)    eq { x 10 20 string cvrs print } if
      x type (stringtype)  eq { x print } if
      x type (arraytype)   eq { x == } if
      x type (dicttype)    eq { x == } if
      x type (nulltype)    eq { (null) print } if
    } forall
  end
} bind def

% 20181102  gs seems to respect this setglobal, but gv seems to ignore it :-(
% "Only composite objects occupy VM" p.58 and booleans are NOT composite p.34
% true setglobal  /its_the_last_line (false) def  false setglobal

% /i 42 def  /r 3.1234 def /s (hello) def /a [ (a) (b) (c) ] def
% [(i=) i ( r=) r ( s=) s ( a=) a ] warn

% luser- -droog in ~/News/comp.lang.postscript 20160516
/kcharpath {   % proc string bool  .  -
  10 dict begin
  {bool str proc}{exch def}forall
  str length 0 gt {
    currentpoint   % for later moveto...
    str 0 1 getinterval dup  % first char
      bool charpath
      stringwidth  % for later rmoveto...
    4 2 roll moveto rmoveto
    1  1  str length 1 sub  { /idx exch def
      str idx 1 sub get  % previous char
      str idx get        %   this   char
      proc % which usually begins pop pop to get rid of those 2 chars
      currentpoint   % for later moveto...
      str idx 1 getinterval dup
        bool charpath
        stringwidth  % for later rmoveto...
      4 2 roll moveto rmoveto
    } for
  } if
  end
} bind def

% NAH! for left-to-right, use kshow, with one initial call to paintproc
% For right-to-left, use kshow with a null output
%    gsave nulldevice ... grestore
% to build an array of positions
% then for-loop explicitly end-to-beginning, using getinterval and moveto
% Code-to-char is done by put, eg:    /s ( ) def  s 0 111 put  s show

/kcharbychar {   % kernproc paintproc string bool  kcharbychar
  % The idea is: for each char, call some `paintproc` which can eg
  %   clip  ( usually; but not always, perhaps stroke... ) 
  %   % pathbbox and convert llx lly urx ury to llx lly width height for fill
  %   clippath pathbbox 2 index sub exch 3 index sub exch
  %   then call rectfill or rectgradientfill
  % So kernproc is called _between_ characters (as in kshow) ;
  %   paintproc is called _on_ each character, with its current path set
  % { clip clippath pathbbox 2 index sub exch 3 index sub exch
  %   black white false 0.5 rectgradientfill }
% needs a complete rethink so as also to be able to print right-to-left !
  { text::bool text::str
    text::paintproc text::kernproc }{exch def} forall
  text::str length 0 gt {
    currentpoint
    text::str 0 1 getinterval dup
      text::bool charpath
      gsave text::paintproc grestore
      stringwidth newpath
    4 2 roll moveto rmoveto
    1 1 text::str length 1 sub { /text::idx exch def
      text::str text::idx 1 sub get
      text::str text::idx get
      text::kernproc
      currentpoint
      text::str text::idx 1 getinterval dup
        text::bool charpath
        gsave text::paintproc grestore
        stringwidth newpath
      4 2 roll moveto rmoveto
    } for
  } if
} bind def

/pathbboxwh where { pop } {  % might also be set by colours.ps ...
  /pathbboxwh {
    % returns llx lly width height, for rectfill or rectgradientfill
    pathbbox 2 index sub exch 3 index sub exch
  } bind def
} ifelse

% Postscript Language Tutorial and Cookbook p.165
/vshow {
   5 dict begin
   [ /thestring /lineskip ] { exch def } forall
   thestring {
      /charcode exch def
      /thechar ( ) dup 0 charcode put def
      0 lineskip neg rmoveto
      gsave thechar stringwidth pop 2 div neg 0 rmoveto  thechar show grestore
   } forall
   end
} def
% could also autodetect the character height with
%   thechar false charpath  pathbbox exch pop exch sub exch pop
% but this doesn't seem to work:
% /lineskip thechar false charpath  pathbbox exch pop exch sub exch pop def
% or, could integrate the selectfont into vshow

% Postscript Language Tutorial and Cookbook p.167
/OutsideCircleText {  % usage: str ptsize centreangle radius OutsideCircleText
   circletextdict begin
   [ /radius /centreangle /ptsize /str ] { exch def } forall
   /xradius radius ptsize 3.5 div add def
   gsave
      centreangle str findhalfangle add rotate
      str {
         /charcode exch def
         (?) dup 0 charcode put outsideplacechar
      } forall
   grestore
   end
} def

/InsideCircleText {  % usage: str ptsize centreangle radius InsideCircleText
   circletextdict begin
   [ /radius /centreangle /ptsize /str ] { exch def } forall
   /xradius radius ptsize 3.5 div sub def
   gsave
      centreangle str findhalfangle sub rotate
      str {
         /charcode exch def
         (?) dup 0 charcode put insideplacechar
      } forall
   grestore
   end
} def

/circletextdict 16 dict def
circletextdict begin
   /findhalfangle {
      stringwidth pop 2 div
      2 xradius mul pi mul div 360 mul
   } def
   /outsideplacechar {
      /char exch def
      /halfangle char findhalfangle def
      gsave
         halfangle neg rotate
         xradius 0 translate
         -90 rotate
         char stringwidth pop 2 div neg 0 moveto
         char show
      grestore
      halfangle 2 mul neg rotate
   } def
   /insideplacechar {
      /char exch def
      /halfangle char findhalfangle def
      gsave
         halfangle rotate
         xradius 0 translate
         90 rotate
         char stringwidth pop 2 div neg 0 moveto
         char show
      grestore
      halfangle 2 mul rotate
   } def
   /pi 3.14159256 def
end

% Postscript Language Tutorial and Cookbook p.179
/text_dict 50 dict def   % needed to share its_the_last_line
/wordbreak ( ) def
/BreakIntoLines {   % textstring linewidth proc BreakIntoLines
   % proc will be executed at each end-of-line
   text_dict begin
   [ /proc /br_linewidth /br_textstring ] { exch def } forall
   /breakwidth wordbreak stringwidth pop def
   /curwidth   0 def
   /lastwordbreak 0 def
   /startchar  0 def
   /restoftext br_textstring def
   /its_the_last_line false def
   {   % loop word by word
      restoftext wordbreak search {   % if?
         /nextword exch def pop   % extract the results of the search
         /restoftext exch def
         /wordwidth  nextword stringwidth  pop  def
         curwidth wordwidth add br_linewidth gt {  % if it overflows the line
            br_textstring startchar  lastwordbreak startchar sub  
              getinterval proc
            /startchar lastwordbreak def
            /curwidth wordwidth breakwidth add def
            /its_the_last_line false def
         } {   % else it doesn't overflow
            /curwidth curwidth wordwidth add breakwidth add def
         } ifelse
         /lastwordbreak lastwordbreak nextword length add 1 add def
      } {   % else we couldn't find a wordbreak so test if restoftext overflows
         restoftext stringwidth pop  curwidth add  br_linewidth  gt {
            % it overflows; we proc it up to the space where we are.
            /its_the_last_line false def
            br_textstring startchar  lastwordbreak startchar sub  
              getinterval proc
            /startchar lastwordbreak def
            /curwidth wordwidth breakwidth add def
         } if
         /its_the_last_line true def
         pop exit
      } ifelse
   } loop
   /lastchar br_textstring length def
   br_textstring  startchar  lastchar startchar sub  getinterval  proc
   end
} def

/currentfontBBheight {   % 20200129 multiply BB height by fontmatrix height
  currentfont /FontMatrix get 3 get
  currentfont /FontBBox get dup 3 get exch 1 get sub   mul
} def
% could also roll selectfont into LeftJustifyText, to remember its size

/LeftJustifyText {   % usage: x y textstring linewidth LeftJustifyText
   text_dict begin
   [ /lj_linewidth /lj_textstring /y /xline ] { exch def } forall
   /yline y def
   % invocation of BreakIntoLines starts here:
   lj_textstring lj_linewidth
   {  /linestring exch def
      xline yline moveto
      0 0 linestring ashow
      /yline  yline currentfontBBheight sub  def
   }
   BreakIntoLines
   end
} def

/JustifyText {   % usage: x y textstring linewidth JustifyText
   % is MarkDown possible ?
   text_dict begin
   % invokes BreakIntoLines with a proc that looks at the linestring,
   % measures its stringwidth, subracts that from linewidth,
   % divides the result by the length, then invokes ashow with that ax
   [ /jt_linewidth /jt_textstring /y /xline ] { exch def } forall
   /yline y def
   % invocation of BreakIntoLines starts here:
   jt_textstring jt_linewidth
   { /linestring exch def
     xline yline moveto
     its_the_last_line {  % (Y ) show
        0 0 linestring ashow
     } {   % (N ) show
       /ax jt_linewidth linestring stringwidth pop sub linestring length div def
       ax 0 linestring ashow
     } ifelse
     /yline  yline currentfontBBheight sub  def
   }
   BreakIntoLines
   end
} def

% Postscript Language Tutorial and Cookbook p.203
% /makeoutlinedict 7 dict def
/MakeOutlineFont {
   % usage: basefontname newfontname strokewidth uniqueid MakeOutlineFont
   % strokewidth is specified in the character-coordinate-system (1000 units)
   % makeoutlinedict begin
   10 dict begin
   [ /uniqueid /strokewidth /newfontname /basefontname ] { exch def } forall
   /basefontdict basefontname findfont def
   /numentries   basefontdict maxlength 1 add def
   basefontdict /UniqeID known not { /numentries numentries 1 add def } if
   /outfontdict numentries dict def
   basefontdict {
      exch dup /FID ne {
         exch outfontdict 3 1 roll put
      } {
         pop pop
      } ifelse
   } forall
   outfontdict /FontName    newfontname put
   outfontdict /PaintType   2 put
   outfontdict /StrokeWidth strokewidth put
   outfontdict /UniqeID     uniqueid    put
   newfontname outfontdict definefont pop
   end
} def

% 20181119
/scale_show {   % x y xscale yscale (hello world) scale_show
  10 dict begin
  [ /str /yscale /xscale ] { exch def } forall   % x y are left on the stack
  gsave
  translate  xscale yscale scale  0 0 moveto  str show
  grestore
  end
} def
/rotate_scale_show {   % x y angle xscale yscale (hello) rotate_scale_show
  10 dict begin
  [ /str /yscale /xscale /angle ] { exch def } forall   % x y are on the stack
  gsave
  translate  angle rotate xscale yscale scale  0 0 moveto  str show
  grestore
  end
} def

% 20181122
% ( perhaps useful: a way to _scale_ a sequence of calls to a given width,
%   or the user can just to do it, measure currentpoint, then re-do it ?
%   likewise a give height, probably more useful to the user )
% /str_in_rect {  % str xmargin ymargin fgfunc bgfunc str_in_rect  -> y_top  ?
/str_in_rect {  % str xmargin ymargin fgcolor bgcolor str_in_rect  -> y_top
  % See  http://www.ubu.com/film/sackner_concrete.html  at 06:30
  20 dict begin
  [/bgb /bgg /bgr /fgb /fgg /fgr /ymargin /xmargin /str] {exch def} forall
  currentpoint /cpy exch def /cpx exch def  % remember the currentpoint
  gsave  % measure bbox of the string, including unwanted blanks llx and lly
    % alas, remember charpath will not work with any Type 3 font :-(
    0 0 moveto str true charpath flattenpath pathbbox
    [ /ury /urx /lly /llx ] { exch def } forall
  grestore
  bgr bgg bgb setrgbcolor
  cpx cpy
    xmargin urx add llx sub xmargin add
    ury lly sub ymargin add ymargin add  rectfill
  fgr fgg fgb setrgbcolor
  xmargin llx sub  ymargin lly sub rmoveto str show
  % leave the currentpoint at the lower-right corner !
  cpx llx sub xmargin add urx add xmargin add  cpy  moveto
  ury lly sub ymargin add ymargin add cpy add  % leave y_top on the stack !
  end
} def


% all the following are taken from muscript -p  or muscript.ps
/rightshow where { pop } {  % might also be set by muscript.ps ...
  /rightshow {    % usage: x y font fontsize (string) rightshow
    5 dict begin
      [ /s /fontsize /font /y /x ] { exch def } forall
      gsave font findfont  fontsize scalefont  setfont
      % x s stringwidth pop sub  y   % bad pop!  (woosh-fonts...)
      x s stringwidth 3 1 roll  %  ys x xs
        sub exch   % xfinal ys
        y exch sub
        moveto s show grestore
    end
  } bind def

  /leftshow { % usage: x y font fontsize (string) leftshow
    5 dict begin
      [ /s /fontsize /font /y /x ] { exch def } forall
      gsave font findfont  fontsize scalefont  setfont
      x y moveto s show grestore
    end
  } bind def

  /centreshow { % usage: x y font fontsize (string) centreshow
    3 dict begin
      [ /s /fontsize /font ] { exch def } forall
      gsave moveto font fontsize selectfont
      gsave s false charpath flattenpath pathbbox grestore
      exch 4 -1 roll pop pop s
      stringwidth pop -0.5 mul  % dx/2  bad pop yet woosh-fonts seem to work!
      3 1 roll sub 0.5 mul % dy/2
      rmoveto s show grestore
    end
  } bind def

  /centrexshow {  % usage: x y font fontsize (string) centrexshow
    7 dict begin
      [ /s /fontsize /font /y /x ] { exch def } forall
      gsave font fontsize selectfont
      s stringwidth /s_height exch def /s_width exch def  % 2D! 20160607
      x s_width  0.5 mul sub  y s_height 0.5 mul sub  moveto s show grestore
    end
  } bind def

/centrexyshow {   % x y font fontsize (string) centreshow
  % 20200426
  9 dict begin gsave
    [ /str /fontsize /font /y /x ] { exch def } forall
    x y moveto   font fontsize selectfont
    gsave str false charpath flattenpath pathbbox grestore
    [ /ury /urx /lly /llx ] { exch def } forall
    /dx urx llx sub -0.5 mul def
    /dy ury lly sub -0.5 mul def
    dx dy rmoveto str show
  grestore end
} bind def

  /Times-Roman findfont dup length dict begin
    { 1 index /FID ne { def } { pop pop } ifelse } forall
    /Encoding ISOLatin1Encoding def currentdict
  end /Times-Roman-ISO exch definefont pop
  /Times-Bold findfont dup length dict begin
    { 1 index /FID ne { def } { pop pop } ifelse } forall 
    /Encoding ISOLatin1Encoding def currentdict
  end /Times-Bold-ISO exch definefont pop
  /Times-BoldItalic findfont dup length dict begin
    { 1 index /FID ne { def } { pop pop } ifelse } forall 
    /Encoding ISOLatin1Encoding def currentdict
  end /Times-BoldItalic-ISO exch definefont pop
  /Times-Italic findfont dup length dict begin
    { 1 index /FID ne { def } { pop pop } ifelse } forall 
    /Encoding ISOLatin1Encoding def currentdict
  end /Times-Italic-ISO exch definefont pop

} ifelse

/Helvetica findfont dup length dict begin
  { 1 index /FID ne { def } { pop pop } ifelse } forall
  /Encoding ISOLatin1Encoding def currentdict
end /Helvetica-ISO exch definefont pop
/Helvetica-Bold findfont dup length dict begin
  { 1 index /FID ne { def } { pop pop } ifelse } forall 
  /Encoding ISOLatin1Encoding def currentdict
end /Helvetica-Bold-ISO exch definefont pop
/Helvetica-BoldOblique findfont dup length dict begin
  { 1 index /FID ne { def } { pop pop } ifelse } forall 
  /Encoding ISOLatin1Encoding def currentdict
end /Helvetica-BoldOblique-ISO exch definefont pop
/Helvetica-Oblique findfont dup length dict begin
  { 1 index /FID ne { def } { pop pop } ifelse } forall 
  /Encoding ISOLatin1Encoding def currentdict
end /Helvetica-Oblique-ISO exch definefont pop

%%EndResource