8
$\begingroup$

There is a widely known trick of converting letters to curves:

TextToOutlines[style_] := 
 ImportString[ExportString[style, "PDF"], "TextMode" -> "Outlines"][[1, 1]]

But it seems to assign the y coordinate without any order that would be obvious to me:

Show[Graphics@TextToOutlines@
    Style["Fubar", FontFamily -> "Helvetica", FontSize -> #] &
    /@ {1, 2, 4, 8},
  Axes -> True]

produces:

enter image description here

I would like to have the typographical baseline (or better median line) of the imported letters identical with the x axis. How could I do that? Is there some extra margin/padding in the import or export? Or something else?

$\endgroup$
  • $\begingroup$ So after doing some digging, it seems to be implemented by ToFileName[{System`ConvertersDump`$MathLinkPath[[1]], "Binaries", $SystemID}, "PDF.exe"] and alas it only takes {"src", "password", "startPage", "endPage", "version", "textAsOutlines"} as options. $\endgroup$ – b3m2a1 Feb 3 '18 at 1:00
6
+100
$\begingroup$

One possible technique is to use a reference letter (e.g., "x") to determine the baseline (and/or midline). I imagine "x" should work for most cases, though definitely not all (see last example below).

This should take care of the "different strings" issues described in the comment of @user6014's answer. I'm not a typography expert by any means, but hopefully I have enough of it right to work for this problem.


Examples

Different texts

exampleTexts = {"bar", "_bar"};

Show[
 Graphics[
    {EdgeForm[{Black, Opacity[0.6]}],
     TextToOutlineShifted[
      #,
      FontFamily -> "Helvetica",
      FontSize -> 10,
      FontColor -> RandomColor[],
      FontOpacity -> 0.6,
      AlignLeft -> True
      ]
     }
    ] & /@ exampleTexts,
 Axes -> True
 ]

Example with different texts

Different font sizes

exampleFontSizes = {1, 2, 4, 8};

Show[
 Graphics[
    {EdgeForm[{Black, Opacity[0.6]}],
     TextToOutlineShifted[
      "Fubar",
      FontFamily -> "Helvetica",
      FontSize -> #,
      FontColor -> RandomColor[],
      FontOpacity -> 0.6,
      AlignLeft -> True
      ]
     }
    ] & /@ exampleFontSizes,
 Axes -> True
 ]

Example with different font sizes

Example where this doesn't work

A quick fix here (depending on the font) would be to try to use a different reference letter.

Show[
 Graphics[
  {EdgeForm[{Black, Opacity[0.6]}],
   TextToOutlineShifted[
    "Fubar",
    FontFamily -> "Zapfino",
    FontSize -> 12,
    FontColor -> RandomColor[],
    FontOpacity -> 0.6,
    AlignLeft -> True,
    ShowReferenceLetters -> True
    ]
   }
  ],
 Axes -> True
 ]

Example where this doesn't work


TextToOutlineShifted

Along with the default options from Style, TextToOutlineShifted also takes:

  • ShiftTo:
    • "Baseline" (default): Aligns the horizontal axis to the bottom of the reference "x"
    • "Midline": Aligns the horizontal axis to the top of the reference "x"
    • "Center": Aligns to the line halfway between the baseline and midline (not sure if this is a thing, or is even useful, but I added it just in case)
  • ShowReferenceLetters: If True, displays the reference "x" used.
  • AlignLeft: If True, aligns the leftmost point of the content text with the vertical axis.

Note here I've defined TextToOutline as follows:

TextToOutline[text_, opts : OptionsPattern[]] := 
  ImportString[
    ExportString[Style[text, FilterRules[{opts}, Options[Style]]], 
     "PDF"], "TextMode" -> "Outlines"][[1, 1]];

...and the code for TextToOutlineShifted:

Options[TextToOutlineShifted] = Join[
   {
    ShiftTo -> "Baseline",
    ShowReferenceLetters -> False,
    AlignLeft -> False
    },
   Options[Style]
   ];

TextToOutlineShifted[text_, opts : OptionsPattern[]] := Module[
   {xref = TextToOutline["x", opts],
    content = TextToOutline[text, opts],
    cbb,
    xrefbb,
    contentbb,
    shift,
    leftshift},

   cbb[letter_] := 
    CoordinateBoundingBox[Flatten[letter[[2, 1, 1, 2]], 1]];
   xrefbb = cbb[xref];
   contentbb = cbb[content];

   shift = -Piecewise[
      {
       {{xrefbb[[1, 1]], xrefbb[[1, 2]]}, 
        OptionValue[ShiftTo] == "Baseline"},
       {{xrefbb[[1, 1]], xrefbb[[2, 2]]}, 
        OptionValue[ShiftTo] == "Midline"},
       {{xrefbb[[1, 1]], Mean@{xrefbb[[1, 2]], xrefbb[[2, 2]]}}, 
        OptionValue[ShiftTo] == "Center"}
       }
      ];

   leftshift = If[
     OptionValue[AlignLeft],
     {-contentbb[[1, 1]] - xrefbb[[1, 1]], 0},
     {0, 0}
     ];

   Translate[
    If[OptionValue[ShowReferenceLetters], {xref, content}, content], 
    shift + leftshift]
   ];

In any case, that's my attempt for the moment. (Feedback is very much welcome, as always.) Hopefully everything is clear, and that it's at least somewhat close to what you have in mind!

New Version: Added ReferenceLetter as an option (for easier tinkering)

Options[TextToOutlineShifted] = Join[
   {
    ShiftTo -> "Baseline",
    ReferenceLetter -> "x",
    ShowReferenceLetters -> False,
    AlignLeft -> False
    },
   Options[Style]
   ];

TextToOutlineShifted[text_, opts : OptionsPattern[]] := Module[
   {referenceLetter = 
     TextToOutline[OptionValue[ReferenceLetter], opts],
    content = TextToOutline[text, opts],
    getBoundingBox,
    referenceLetterBoundingBox,
    contentBoundingBox,
    shift,
    leftShift},

   getBoundingBox[textCurve_] := 
    CoordinateBoundingBox[Flatten[textCurve[[2, 1, 1, 2]], 1]];
   referenceLetterBoundingBox = getBoundingBox[referenceLetter];
   contentBoundingBox = getBoundingBox[content];

   shift = -Piecewise[
        {
         {{#[[1, 1]], #[[1, 2]]}, 
          OptionValue[ShiftTo] == "Baseline"},
         {{#[[1, 1]], #[[2, 2]]}, OptionValue[ShiftTo] == "Midline"},
         {{#[[1, 1]], Mean@{#[[1, 2]], #[[2, 2]]}}, 
          OptionValue[ShiftTo] == "Center"}
         }
        ] &@(referenceLetterBoundingBox);

   leftShift = If[
     OptionValue[AlignLeft],
     {-contentBoundingBox[[1, 1]] - 
       referenceLetterBoundingBox[[1, 1]], 0},
     {0, 0}
     ];

   Translate[
    If[OptionValue[ShowReferenceLetters], {referenceLetter, content}, 
     content], shift + leftShift]
   ];
$\endgroup$
  • $\begingroup$ Thank you, I accept this as a solution, it is very thorough. Interestingly, the reference letter "x" does not produce good output for the second example on my system, but a capital "X" does. $\endgroup$ – user1747134 Feb 7 '18 at 21:56
  • $\begingroup$ Glad it was helpful, thanks for accepting. That is interesting regarding the "x". Could you possibly post a screenshot or something of the result you get? $\endgroup$ – Anne Feb 8 '18 at 1:08
5
$\begingroup$

Not a answer

If you replace ExportString[style, "PDF"] by ExportString[Style[style,Black], "PDF"], you get :

enter image description here

I don't know why.

$\endgroup$
  • $\begingroup$ It almost seems like a bug. Does it not? $\endgroup$ – user1747134 Jan 28 '18 at 12:26
  • $\begingroup$ Not sure at all. It is too early to conclude. $\endgroup$ – andre314 Jan 28 '18 at 12:43
  • $\begingroup$ Anyway, it only "works" until FontSize -> 13. $\endgroup$ – user1747134 Jan 31 '18 at 16:34
  • 1
    $\begingroup$ No more upvote please - That's enough ! $\endgroup$ – andre314 Jan 31 '18 at 18:11
  • 4
    $\begingroup$ @andre One more upvote and you can start a bounty to reset your rep :) $\endgroup$ – anderstood Jan 31 '18 at 22:11
4
$\begingroup$

Here is a method that finds the earliest x value and the mean y value used in creating the characters, and subtracts all content in the graphic by these values to normalize the first character to {0, 0}:

TextToOutlines[style_] := Module[{content, x, y, xadj, yadj},
  content = 
   ImportString[ExportString[style, "PDF"], 
     "TextMode" -> "Outlines"][[1, 1]];
  {x, y} = 
   MinMax /@ 
    Transpose[Cases[content[[2, 1, 1, 2]], {_?NumericQ, _}, 2]];
  xadj = x[[1]]; yadj = Mean@y;
  ReplaceAll[
   content, {x_?NumericQ, y_?NumericQ} :> {x - xadj, y - yadj}]
  ]

Show[Graphics@
    TextToOutlines@
     Style["Fubar", FontColor -> RandomColor[], 
      FontFamily -> "Helvetica", FontSize -> #] & /@ {8, 4, 2, 1}, 
 Axes -> True]

enter image description here

$\endgroup$
  • 1
    $\begingroup$ This does depend on the text, so if I want to run it on two different strings, they may end up not aligned. Example: Show[Graphics@ TextToOutlines@ Style[#, FontColor -> RandomColor[], FontFamily -> "Helvetica", FontSize -> 8] & /@ {"bar", "_bar"}] $\endgroup$ – user1747134 Feb 2 '18 at 9:40

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.