Can this effect be achieved with Mathematica?

Here is an approach using some basics of object-oriented programming.

Load the lyrics:

str = "It's been a long, long time\nSince I've memorized your face\nIt's been four hours now\nSince I've wandered through your place\nAnd when I sleep on your couch\nI feel very safe\nAnd when you bring the blankets\nI cover up my face\nI do Love you, I doLove you\nAnd when you play guitar\nI listen to the strings buzz\nThe metal vibrates underneath your fingers\nAnd when you crochet\nI feel mesmerized and proud\nAnd I would say I love you\nbut saying it out loud is hard\nSo I won't say it at all\nAnd I won't stay very long\nBut you are the life I needed all along\nI think of you as my brother\nAlthough that sounds dumb\nWords are futile devices"
lyrics = StringSplit /@ StringSplit[StringDelete[str, ","], "\n"];
{nR, nW} = {Length@lyrics, Length /@ lyrics};

We also need to enter some baseline x-coordinates for each word to make the full text initially readable:

xpos = {{1, 1, 40}, {1, 2, 60}, {1, 3, 70}, {1, 4, 90}, {1, 5, 110}, {2, 1, 45}, {2, 2, 70}, {2, 3, 115}, {2, 4, 135}, {3, 1, 45}, {3, 2, 70}, {3, 3, 90}, {3, 4, 115}, {4, 1, 45}, {4, 2, 65}, {4, 3, 102}, {4, 4, 135}, {4, 5, 160}, {5, 1, 35}, {5, 2, 55}, {5, 3, 65}, {5, 4, 90}, {5, 5, 105}, {5, 6, 125}, {6, 1, 30}, {6, 2, 50}, {6, 3, 70}, {7, 1, 35}, {7, 2, 55}, {7, 3, 75}, {7, 4, 100}, {7, 5, 120}, {8, 1, 30}, {8, 2, 55}, {8, 3, 70}, {8, 4, 85}, {9, 1, 30}, {9, 2, 45}, {9, 3, 70}, {9, 4, 90}, {9, 5, 100}, {9, 6, 130}, {10, 1, 35}, {10, 2, 55}, {10, 3, 75}, {10, 4, 95}, {11, 1, 30}, {11, 2, 60}, {11, 3, 75}, {11, 4, 90}, {11, 5, 120}, {12, 1, 40}, {12, 2, 65}, {12, 3, 100}, {12, 4, 145}, {12, 5, 165}, {13, 1, 40}, {13, 2, 60}, {13, 3, 80}, {14, 1, 30}, {14, 2, 50}, {14, 3, 95}, {14, 4, 110}, {15, 1, 35}, {15, 2, 45}, {15, 3, 70}, {15, 4, 90}, {15, 5, 100}, {15, 6, 120}, {16, 1, 35}, {16, 2, 65}, {16, 3, 75}, {16, 4, 90}, {16, 5, 110}, {16, 6, 125}, {17, 1, 35}, {17, 2, 45}, {17, 3, 70}, {17, 4, 90}, {17, 5, 105}, {17, 6, 125}, {18, 1, 35}, {18, 2, 45}, {18, 3, 70}, {18, 4, 90}, {18, 5, 110}, {19, 1, 35}, {19, 2, 50}, {19, 3, 70}, {19, 4, 90}, {19, 5, 110}, {19, 6, 120}, {19, 7, 150}, {19, 8, 170}, {20, 1, 30}, {20, 2, 55}, {20, 3, 70}, {20, 4, 85}, {20, 5, 100}, {20, 6, 115}, {21, 1, 60}, {21, 2, 80}, {21, 3, 110}, {22, 1, 45}, {22, 2, 65}, {22, 3, 95}};
x0[r_, i_] := Cases[xpos, {r, i, _}][[1, -1]]

Define a class of objects which allows to create word objects (this_ in the function below) characterized by their row r and position in their sentence i:

SetAttributes[Words, HoldFirst];
Words[this_[r_, i_]] := (
this@t = 0.;
this@vel = 0.;
this@x = -150.;
this@y = 395. - 15r;

this@show := (
  this@t += 1;
  this@x += this@vel;
  Which [
    this@t < 25i, this@vel = 0,
    this@x < 20., this@vel = 2,
    this@x < x0[r, i], this@vel = .1 i,
    word[1, 1]@t < 1500, this@vel = this@x/4000,
    True, this@vel = i*this@t /1250 
   ];
  Inset[lyrics[[r, i + 1]], {this@x, this@y}, Left]
  );
)

This class allows each word to have its own coordinates. Coordinate x varies as a function of the word velocity vel. The Which statement enables the velocity of a word to vary throughout the journey. Playing around with the different values in Which can make the animation smoother, faster...

Notice that in the definition of the class, each word starts to accelerate once it reaches its baseline x-position x0[r,i].

Since the first word of each sentence is static, define:

StaticWords = Table[Inset[lyrics[[r, 1]], {20, 395 - 15 r}, Left], {r, nR}];

Create the actual instances of the remaining mobile words:

 Do[Words[word[r, i][r, i]], {r, nR}, {i, nW[[r]] - 1}]

Draw the list of all graphs:

optgph = {Background -> Black, PlotRange -> {{0, 400}, {40, 400}},ImageSize -> 500};

Table[word[r, i]@show, {T, 2000}, {r, nR}, {i, nW[[r]] - 1}];
MapThread[RotateRight, {Table[%[[All, r]], {r, nR}], Table[50 i - 1550, {i, nR}]}];
graph = Graphics[{White, StaticWords, #}, optgph] & /@Table[%[[All, T]], {T, 2000}];

in which RotateRight makes the full text readable from the start and introduces a slight lag between the sentences.

Animate the graph:

Animate[graph[[t]], {t, 1, Length@graph, 1}, AnimationRate -> 400]

enter image description here

Tags:

Text

Animation