Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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.

UPDATE Good article on the subject (outlined case): http://www.planetclegg.com/projects/WarpingTextToSplines.html


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

share|improve this question
2  
Related: How can I wrap text around a circle? –  Mr.Wizard Dec 12 '12 at 17:22
3  
Likely necessary for a solution: Generating evenly spaced points on a curve –  Mr.Wizard Dec 12 '12 at 17:26

2 Answers 2

up vote 11 down vote accepted

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 \[Pi] t], Sin[6 \[Pi] t]};
totalarclength = NIntegrate[Sqrt[f'[\[Tau]].f'[\[Tau]]], {\[Tau], 0, 1}];
invarclength = First@NDSolve[{D[$t[s], s] == 1/Sqrt[f'[$t[s]].f'[$t[s]]], $t[0] == 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.

Mathematica graphics

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 \[Pi] t], Sin[6 \[Pi] t]};
totalarclength = NIntegrate[Sqrt[c'[\[Tau]].c'[\[Tau]]], {\[Tau], 0, 1}];
invarclength = First@NDSolve[{D[$t[s], s] == 1/Sqrt[c'[$t[s]].c'[$t[s]]], $t[0] == 0},
$t, {s, 0, totalarclength}];
    NN[t_] := {{0, -1}, {1, 0}}.c'[t]/Sqrt[c'[t].c'[t]];
    maptext[s_, \[CapitalDelta]n_] := With[{t = $t[Mod[s, totalarclength]] /. invarclength}, 
  c[t] + \[CapitalDelta]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 + \[CapitalDelta]N]}],
    PlotRange -> 1.5
  ],
  {{\[CapitalDelta]N, 0.1}, -1, 1},
  {{s0, 6.45}, 0, totalarclength},
  {{fs, 2, "font scale"}, 0.1, 5}
]

Mathematica graphics

share|improve this answer
1  
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

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]],{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]

Curvy Text

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[[1]]]]]&,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]

Better curve text with equidistant characters

I'll leave it as an exercise to calculate proper kerning and getting an even better result.

share|improve this answer
    
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
1  
@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
    
@AlexeyPopkov If you know what to do with the kerning, using text shouldn't be a problem. However you might need to convert to filled curves and do some cleaver integration between characters to figure out the kerning. Independent of which you use to draw the symbols, I don't think you'll be able to select the text without extensive workarounds. Since they are individually positioned pieces of text. –  jVincent Dec 12 '12 at 23:19
1  
@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

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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