Text along a lemniscate curve
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!