How can I standardize the coordinate origin for exported/imported outlines?
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
]
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 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
]
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
: IfTrue
, displays the reference "x" used.AlignLeft
: IfTrue
, 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]
];
Not a answer
If you replace ExportString[style, "PDF"]
by ExportString[Style[style,Black], "PDF"]
, you get :
I don't know why.
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]