# Movable text on a curve

Having an arbitrary curve defined as InterpolatingFunction, what is the best way to place a text on this curve? The text generally has two rows, for example: "This is\na text on a curve", the curve must go between the rows. I am interested both in character-based (preserving characters as selectable textual elements) and outlined solution (the text is first converted to outlines, then a transformation is applied to the resulting curves). It would be perfect to have a possibility to move the text along the curve interactively.

For the search engine: this is also known as "text on a path."

Here's another way...Text[] has a direction argument, so ArcTan is not necessary.

txt1 = "Now we can follow" // Characters;
txt2 = "an arbitrary path" // Characters;
f[t_] := {Cos[2 π t], Sin[6 π t]};
totalarclength = NIntegrate[Sqrt[f'[τ].f'[τ]], {τ, 0, 1}];
invarclength = First@NDSolve[{D[$t[s], s] == 1/Sqrt[f'[$t[s]].f'[$t[s]]],$t == 0},
$t, {s, 0, totalarclength}]; ds = 0.12; fs = Scaled[0.08]; Manipulate[ Show[ ParametricPlot[f[t], {t, 0, 1}], Graphics[{ Table[Text[Style[txt1[[n]], "Text", FontSize -> fs], f[$t[Mod[s0 + n ds, totalarclength]] /. invarclength],
{0, -1.1},
f'[$t[Mod[s0 + n ds, totalarclength]] /. invarclength]], {n, Length[txt1]}], Table[Text[Style[txt2[[n]], "Text", FontSize -> fs], f[$t[Mod[s0 + n ds, totalarclength]] /. invarclength],
{0, 1.1},
f'[$t[Mod[s0 + n ds, totalarclength]] /. invarclength]], {n, Length[txt2]}]}], PlotRangePadding -> Scaled[0.09] ], {s0, 0, totalarclength} ]  Computing the arclength can help space the characters out. As far as I know, Mathematica does not provide access to character widths, so that equal spacing is probably as good as one can do easily. As someone has remarked, tight curvatures pose a problem. Addendum One of Alexey Popkov's comments suggested the following modification, with help from the FilledCurve doc page. The glyphs are distorted by the curvature, and tight curvatures cause inversion. txtbase = ImportString[ExportString["some movable text", "PDF"], "PDF"]; txt = First@First@txtbase; xRange = -Subtract @@ First[PlotRange /. First@AbsoluteOptions[txtbase, PlotRange]]; c[t_] := {Cos[2 π t], Sin[6 π t]}; totalarclength = NIntegrate[Sqrt[c'[τ].c'[τ]], {τ, 0, 1}]; invarclength = First@NDSolve[{D[$t[s], s] == 1/Sqrt[c'[$t[s]].c'[$t[s]]], $t == 0},$t, {s, 0, totalarclength}];
NN[t_] := {{0, -1}, {1, 0}}.c'[t]/Sqrt[c'[t].c'[t]];
maptext[s_, Δn_] := With[{t = $t[Mod[s, totalarclength]] /. invarclength}, c[t] + Δn NN[t]]; Manipulate[ Show[ ParametricPlot[c[t], {t, 0, 1}], Graphics[ Dynamic@{txt /. {x_Real, y_Real} :> maptext[-fs x/xRange + s0, -fs y/xRange + ΔN]}], PlotRange -> 1.5 ], {{ΔN, 0.1}, -1, 1}, {{s0, 6.45}, 0, totalarclength}, {{fs, 2, "font scale"}, 0.1, 5} ] • can I ask why use $t for your function within NDSolve? – tkott Dec 13 '12 at 17:30
• At first, to distinguish t as a function of arc length from the parameter t. In the end, it didn't matter. – Michael E2 Dec 14 '12 at 1:35
• A tribute - thanks @MichaelE2 ! – Vitaliy Kaurov Dec 29 '15 at 11:58
• @VitaliyKaurov Thanks! I'm honored. One update in my thinking: The trouble that the use of Abs in Normalize sometimes causes in symbolic manipulation does not really apply here. One could use the definition NN[t_] := Normalize@Cross[c'[t]] instead, since it is evaluated only numerically; or even NN = Compile[t, #] &@ Block[{Abs = Sqrt[#^2] &}, Normalize@Cross[c'[t]]], which will be faster but would have to be reevaluated if c changed. – Michael E2 Dec 29 '15 at 16:40
• @VitaliyKaurov I posted a more efficient version in reply to your Community post. – Michael E2 Dec 29 '15 at 18:09

This is just a quick sketching out of an answer (rescales galore!)

 textOnCurve[text_, f_, n_, p_: 0.01] :=
Text[Rotate[text, ArcTan @@ (f[Rescale[n + p, {0, 1}, {p, 1 - p}]] -
f[Rescale[n - p, {0, 1}, {p, 1 - p}]])], f[n]]

textCurve[string_, f_, stylef_: (# &), range_: {0, 1}] :=
With[{chars = Characters@string},
MapIndexed[textOnCurve[stylef@#1, f, Rescale[#2[],{1, Length@chars}, range]] &, chars]]


Which can then be used like:

pts = {{0, 0}, {1, 1}, {2, -1}, {3, 0}};
LocatorPane[Dynamic[pts],
Dynamic@(
f = BezierFunction[pts];
Show[Graphics[{Point[pts], Line[pts],
textCurve["Some text here", f, Style[#, 20] &, {0.2, 0.6}]
}, Axes -> True]
, ParametricPlot[f[t], {t, 0, 1}]])
, LocatorAutoCreate -> True] Update

This can be improved by adding proper positioning by fixing the lower midpoint in the rotation and position. Also using Szabolcs very nice equidistant spacings. However as I have stated in comments kerning is going to be trouble unless it's really taken seriusly into consideration.

 textOnCurve[text_,f_,n_,p_: 0.01]:=
With[{angle=ArcTan@@Subtract@@(f/@Rescale[{n+p,n-p},{0,1},{p,1-p}])},
Rotate[Text[text,f[n],{0,-1}],angle,f[n]]
]

equidistantTextCurve[string_,f_,stylef_: (#&),range_: {0,1}]:=
Module[{chars,distance},
chars=Characters@string;
distance=functionEquidistant[f,Length@chars,range];
MapIndexed[textOnCurve[stylef@#1,f,distance[[#2[]]]]&,chars]
]

LocatorPane[Dynamic[pts],
Dynamic@(f = BezierFunction[pts];
Show[Graphics[{Point[pts], Line[pts],
equidistantTextCurve["Mathematica.StackExchange.Com", f,
Style[#, 18] &, {0.15, 0.8}]
}, Frame -> True, PlotRange -> 2],
ParametricPlot[f[t], {t, 0, 1}]]), LocatorAutoCreate -> True] I'll leave it as an exercise to calculate proper kerning and getting an even better result.

• Great start, but spacing doesn't seem right, both in your image and here: i.stack.imgur.com/HoOK4.png – Mr.Wizard Dec 12 '12 at 19:25
• @Mr.Wizard Kerning, the bane of all. Though in seriousness, it might not even be enough to find equidistant spacings unless you are dealing with monospaced fonts, and even if the normal kerning of the font could be accurately captured, it might not look good when curvature is taken into account. – jVincent Dec 12 '12 at 20:10
• @jVincent This is why I need also outlined solution where the text is presented as FilledCurves. – Alexey Popkov Dec 12 '12 at 21:37
• @jVincent I do not know what to do with the kerning. Mathematica currently cannot work with it. But the standard technique ImportString[ExportString["some text","PDF"],"PDF"] allows to convert glyphs to FilledCurves preserving kernings. – Alexey Popkov Dec 13 '12 at 0:07
• This is nice stuff.But I do not see definition of functionEquidistant . Also code in your update is not runable on its own. Could please make it self-sufficient? – Vitaliy Kaurov Dec 27 '15 at 14:25