# Animating moving surface of torus

I would like to try to recreate something similar to Paolo Čerić's torus animation:

I have isolated the moving surface torus section form this Wolfram Demonstration by Kevin Sonnanburg:

t = s; s = .001; θ = 0; Manipulate[
Show[{ParametricPlot3D[{Cos[u] (3 + Cos[t]), Sin[u] (3 + Cos[t]),
Sin[t]}, {u, Cos[θ] s - .5 + a,
Cos[θ] s + .5 + a}, {t, Sin[θ] s - .5 + b,
Sin[θ] s + .5 + b}, PlotPoints -> 4, PlotStyle -> Red,
PerformanceGoal -> "Quality", PlotPoints -> 6, Axes -> None,
Boxed -> False, Mesh -> None, PlotRange -> 4],
ParametricPlot3D[{Cos[
a + v Cos[θ]] (3 + Cos[b + v Sin[θ]]),
Sin[a + v Cos[θ]] (3 + Cos[b + v Sin[θ]]),
Sin[b + v Sin[θ]]}, {v, 0, s}, PlotPoints -> 20]},
PlotRange -> 4, ImageSize -> {200, 200}, ViewAngle -> π/10],
{{a, π, "shift X"}, 0, 6 π},
{{b, π, "shift Y"}, 0, 6 π},
AutorunSequencing -> {2, 3, 4}, SaveDefinitions -> True]


and have tried to apply a texture to the section, and extend it over the whole torus, but haven't made as much progress as I'd hoped.

-
Perhaps you can get something out of this, it looks OK but it's way too slow. – C. E. Apr 6 '14 at 1:21
This is great - why not post this as an answer? – martin Apr 6 '14 at 9:11
I will do that if I (1) get time to create an animation that has the same speed/distances as the original and (2) Manage to make the code prettier and/or faster without making it the same as Kuba uses. I don't really like my current code, but thought I should make it available somehow. :) – C. E. Apr 6 '14 at 21:55

Let's get a black torus:

torus = First@ParametricPlot3D[{Cos[u] (3 + Cos[t]), Sin[u] (3 + Cos[t]), Sin[t]},
{u, 0, 2 Pi}, {t, 0, 2 Pi},
PlotStyle -> Black, Mesh -> None, PlotPoints -> 10]


and now, this is a way to go:

DynamicModule[{d1 = 0, d2 = 0},
Column[{
Graphics3D[{
torus,
Red, Dynamic[Riffle[
Point /@ Array[
{Cos[#] (3. + 1.01 Cos[#2]), Sin[#] (3. + 1.01 Cos[#2]), Sin[#2]} &,
{65, 15},
{{0 + d2/10, 2. Pi + d2/10}, {0. + d2, 2 Pi + d2}}]
, {Yellow, Pink, LightBlue}
]]
}
, ImageSize -> 500, Background -> Black, Boxed -> False]
,

Slider[Dynamic@d2, {0, 2. Pi, .01}]
}]]


Not perfect but I don't have time now for more efficient approach :/.

p.s. Array works this way on V9. Use Table/Range for older versions.

-
Amazing - how you can whip up something like that in 5 minutes ... I'll probably never know! :) – martin Apr 5 '14 at 18:47
@martin Thank you ;) I've added 1.01 for the tube radius so the points will not hide below black torus surface anymore :) – Kuba Apr 5 '14 at 19:15
Just nitpicking - how would you get the 'lights' to run diagonally? – martin Apr 5 '14 at 22:21
@martin you can flatten the array and riffle such way that each row starts from next color, then it will look like they are not vertical. – Kuba Apr 5 '14 at 22:56