home/ps/baseline.ps

   1 %
   2 % Stuff used to draw or set text along a baseline specified by parametric equations
   3 % for x and y.
   4 %
   5
   6 /left -1 def
   7 /center 0 def
   8 /right 1 def
   9
  10 /baselinedict 50 dict def
  11
  12 /newbaseline {
  13         baselinedict begin
  14                 /g' exch bind def
  15                 /f' exch bind def
  16                 /g  exch bind def
  17                 /f  exch bind def
  18
  19                 counttomark 2 eq {/hoffset exch def} if
  20                 /res exch def
  21
  22                 /t 0 def
  23                 /s 0 def
  24                 /voffset false def
  25                 cleartomark
  26         end
  27 } bind def
  28
  29 /drawfunnytext {
  30         baselinedict begin
  31                 /t exch def
  32                 /mode exch def
  33                 /str exch def
  34
  35                 mode left eq {
  36                         /leftstring emptystring def
  37                         /rightstring str def
  38                 } if
  39
  40                 mode right eq {
  41                         /leftstring str reversestring def
  42                         /rightstring emptystring def
  43                 } if
  44
  45                 mode center eq {
  46                         str splitstring
  47                         /rightstring exch def
  48                         /leftstring exch reversestring def
  49                 } if
  50
  51                 gsave currentpoint translate leftstring left t baselineshow grestore
  52                 gsave currentpoint translate rightstring right t baselineshow grestore
  53
  54                 /t 0 def
  55                 /s 0 def
  56                 /voffset false def
  57                 cleartomark
  58         end
  59 } bind def
  60
  61 /setfunnytext {
  62         baselinedict begin
  63                 /vpos exch def
  64                 /hpos exch def
  65                 /str  exch def
  66
  67                 voffset vpos ne {
  68                         /voffset vpos def
  69                         /t 0 def
  70                         /s hoffset def
  71                 } if
  72
  73                 gsave
  74                         hoffset voffset translate
  75                         0 0 moveto
  76                         /ds hpos s sub def
  77                         /dt ds t f' dup mul t g' dup mul add sqrt res mul div def
  78                         /s s ds add def
  79                         /t t dt add def
  80                         str right t baselineshow
  81                 grestore
  82         end
  83 } bind def
  84
  85 baselinedict begin
  86
  87 /f  {} bind def
  88 /g  {pop 0} bind def
  89 /f' {pop 1} bind def
  90 /g' {pop 0} bind def
  91
  92 /s 0 def
  93 /t 0 def
  94 /res 72 def
  95
  96 /onecharstring ( ) def
  97 /emptystring () def
  98
  99 /baselineshow {
 100         /t exch def
 101         /mode exch def
 102         /str exch def
 103
 104         gsave
 105                 t f res mul t g res mul translate
 106                 0 0 moveto
 107                 t g' t f' atan rotate
 108                 {
 109                         mode right eq {pop} if
 110                         grestore gsave
 111                         onecharstring 0 3 -1 roll put onecharstring stringwidth pop
 112                         /ds exch mode mul def
 113                         /dt ds t f' dup mul t g' dup mul add sqrt res mul div def
 114                         /t t dt add def
 115                         /s s ds add def
 116                         t f res mul t g res mul translate
 117                         0 0 moveto
 118                         t g' t f' atan rotate
 119                         mode left eq {pop} if
 120                 } str kshow
 121         grestore
 122 } bind def
 123
 124 /reversestring {
 125         /str1 exch def
 126
 127         /str2 str1 length string def
 128         /i 0 def
 129         /n str1 length 1 sub def
 130
 131         {
 132                 str1 n get str2 exch i exch put
 133                 /i i 1 add def
 134                 /n n 1 sub def
 135                 n 0 lt {exit} if
 136         } loop
 137         str2
 138 } bind def
 139
 140 /splitstring {
 141         /str1 exch def
 142
 143         /len str1 stringwidth pop def
 144         /s 0 def
 145         /n 0 def
 146         str1 length {
 147                 str1 n get onecharstring exch 0 exch put
 148                 /s onecharstring stringwidth pop s add def
 149                 s len 2 div ge {exit} if
 150                 /n n 1 add def
 151         } repeat
 152         str1 0 n 1 add getinterval
 153         str1 n str1 length n sub getinterval
 154 } bind def
 155
 156 end