6
$\begingroup$

This question already has an answer here:

How to make some text along the Lemniscate curve?

I want to do something like this

enter image description here

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]
$\endgroup$

marked as duplicate by Anton Antonov, m_goldberg, MarcoB, Feyre, Michael E2 plotting Sep 7 '16 at 23:37

This question has been asked before and already has an answer. If those answers do not fully address your question, please ask a new question.

  • 8
    $\begingroup$ Maybe this and this? $\endgroup$ – corey979 Sep 7 '16 at 9:05
16
$\begingroup$

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]

enter image description here

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).

$\endgroup$
  • $\begingroup$ Very nice -- this solution adheres very well to the image provide in the question. $\endgroup$ – Anton Antonov Sep 7 '16 at 13:10
  • $\begingroup$ @ubpdqn very nice, thanks $\endgroup$ – vito Sep 7 '16 at 13:44
  • $\begingroup$ PlotStyle -> {Black, Thickness[0.008]} $\endgroup$ – vito Sep 7 '16 at 15:00
4
$\begingroup$

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:

enter image description here

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:

enter image description here

Have fun!

$\endgroup$

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