I also find the inability to place text exactly within a graphic to be unacceptable, especially because many of the Graphics
objects I produce have text within a disk, exactly like in the OP.
So I do something I consider a bit extreme - I convert every letter of the text into a FilledCurve
object. How? By using this bit of code that was given to me by someone else (a bit of manna from heaven). I don't really understand the bit after FrontEndExecute
, but I know it returns a Graphics
. Then I take the filled curves inside that graphics and translate them to the origin, and use a GeometricTransformation
to place it in the right spot.
toFilledCurves[input_] :=
Module[{res, center},
res =
ToExpression@
First@
FrontEndExecute@
FrontEnd`ExportPacket[
Cell[BoxData@ToBoxes[input], "Output", "Graphics",
"GraphicsLabel"], "InputForm", "Outlines" -> True];
res = Cases[res, _FilledCurve, Infinity];
center =
Mean[Flatten[Cases[res, FilledCurve[_, b_] :> b, Infinity], 2]];
res /.
FilledCurve[x_, pts_] :>
FilledCurve[x, TranslationTransform[-center] /@ pts]
];
So this should produce an animation without jitters:
pCurve[center_, scale_] :=
With[{p =
toFilledCurves[
Style["P", White, 36, Italic, FontFamily -> "Times"]]},
GeometricTransformation[p,
TranslationTransform[center]@*ScalingTransform[{scale, scale}]]];
Animate[Graphics[{Circle[], {Disk[{Cos@t, Sin@t}, 0.18], White,
pCurve[{Cos@t, Sin@t}, .008]}}, PlotRange -> 1.5], {t, 0, 2 Pi},
AnimationRate -> .01]
Animate[Graphics[{Circle[], {Disk[{Cos@t, Sin@t}, 0.18]}}, PlotRange -> 1.5], {t, 0, 2 Pi}, AnimationRate -> .01]
and you'll see the disk that that shakes with no text. If you change the animation rate to sayAnimationRate -> .005
you'll see this more clearly. $\endgroup$