How to make some text along the Lemniscate curve?
I want to do something like this
for instance :
text = Style["tu sei il mio unico grande amore", 16] lemniscate=ParametricPlot[{Cos[t]/(1 + Sin[t]^2), (Sin[t] Cos[t])/(1 + Sin[t]^2)}, {t, 0, 2 Pi}, Axes -> False] Here's a start:
phrase = "tu sei il mio unico grande amore" lemniscate[ t_] := {Cos[t]/(1 + Sin[t]^2), (Sin[t] Cos[t])/(1 + Sin[t]^2)}; angle[s_] := ArcTan @@ (D[lemniscate[t], t] /. t -> s) tx[str_, {s_, t_}, ff_: "Comic Sans MS", fs_: 16] := Module[{ch = Characters[str]}, Graphics[ MapThread[ Text[Rotate[Style[#1, FontFamily -> ff, fs], angle[#2]], lemniscate[#2]] &, {ch, Range[s, t - 1/Length[ch], (t - s)/Length[ch]]}]]] For example,
Show[ParametricPlot[lemniscate[-t], {t, Pi + 0.1, 2 Pi - 0.1}, RegionFunction -> Function[{x, y, u}, Pi < u < 3 Pi/2 - 0.1 || 3 Pi/2 + 0.1 < u < 2 Pi]], tx[phrase, {-Pi, 0}, "Segoe Script", 20], Axes -> False] 
I leave it to those awake and well and with interest to deal with refinements (arc length for even character spacing, nice fonts, generalization etc).
This is a fast variant. I only took the text in English to simplify my own understanding:
coord[t_] := {Cos[t]/(1 + Sin[t]^2), (Sin[t] Cos[t])/(1 + Sin[t]^2)}; str = "you are my only real love"; lst = Characters[str]; Manipulate[ lstText = Table[Text[Style[lst[[i]], 16, Red], coord[(Length[lst] - i)/n]], {i, 1, Length[lst]}]; Graphics[lstText], {{n, 8}, 5, 40, 1}] looking as follows:
Just play with the slider. Or like this, if you want the line on the background:
Manipulate[ lstText = Table[Text[Style[lst[[i]], 16, Red], coord[(Length[lst] - i)/n]], {i, 1, Length[lst]}]; Show[{ Graphics[lstText], ParametricPlot[{Cos[ t]/(1 + Sin[t]^2), (Sin[t] Cos[t])/(1 + Sin[t]^2)}, {t, (Length[lst] - 0.5)/n, 2 \[Pi] - 0.1}, Axes -> False] }] , {{n, 8}, 5, 40, 1}] giving this:
Have fun!
