How to make this Möbius Torus animation?

I came across a beautiful animation of a Möbius torus, and I'm hoping someone can help me make this animation in code: What I've tried:

I made the basic shape but can't get the right colors, lighting & reflections, and rotation to work yet:

makeShape[vl_List, c1_Integer, c2_Integer] := Block[
{l = vl,  l1 = RotateLeft /@ vl, mesh},
mesh = {l, l1, RotateLeft[l1], RotateLeft[l]};
If[c1 == 1, mesh = Map[Drop[#, -1] &, mesh, {1}] ];
If[c2 == 1, mesh = Map[Drop[#, -1] &, mesh, {2}] ];
Polygon /@ Transpose[ Map[Flatten[#, 1] &, mesh] ]
];
data = Table[{Cos[u], Sin[u], 0} +
0.5 Cos[v] { Cos[u/2] Cos[u], Cos[u/2] Sin[u], Sin[u/2]} + .5 Sin[
v] { -Sin[u/2] Cos[u], -Sin[u/2] Sin[u], Cos[u/2]}, {u, 0.,
2 Pi, 2 Pi/15}, {v, 0, 2 Pi, 2 Pi/6}];
Graphics3D[{GoochShading[], makeShape[data, 1, 1]}, Boxed -> False,
ImageSize -> {550, 400}, SphericalRegion -> True,
Lighting -> "Accent",
Background -> RGBColor @@ {{0.1333, 0.1137, 0.5333, 1.}}] References:

I've found these related resources:

• What have you tried? Mar 19 '20 at 18:37
• I will add that, I’m stuck figuring out how to upload the animation right now:( Mar 19 '20 at 18:39
• It's not a torus thingy, its technical name is a Moebius thingy. Mar 19 '20 at 19:19
• This is not a 3D object. It is a sequence of 16 identical hexagons arranged in a circle. The corresponding vertices of the neighbouring hexagons are joined to form a "face". The hexagons are then rotated in unison about their individual centres to create the animation. The tricky bit is working out the z-ordering of the faces to draw it correctly. The colouring is also somewhat artistic. It doesn't have any consistency for the specular flashes. Mar 20 '20 at 2:41
• You can get rotation by putting the thing in a Manipulate and adding a phase to both Sin[v] as Sin[v+p] and Cos[v] as Cos[v+p], and varying the p from 0 to 2pi Jun 26 '20 at 16:10

Update: I have managed to fix the distortion of the polygons, so now only the glow is missing

Update 2: I have added a hacky "glow" to the polygons by adding partially transparent polygons slightly above the white polygons to give them some kind of "volumetric glow"

Update 3: I have tweaked the lighting settings a bit to give the image a bit more depth

Here is my attempt (code below): (* the color function to be used by the animation *)
colorfunc = Blend[{
{0, RGBColor[2/17, 8/51, 26/51]},
{0.9, RGBColor[7/51, 176/255, 188/255]},
{1, RGBColor[1, 1, 1]}
}, #] &;
BarLegend[{colorfunc, {0, 1}}, LegendLayout -> "Row"]

(* for each polygon, generate a random function moving between 0 and 1 over the interval from 0 to 2π *)
Clear@colors;
colors[i_, j_] := colors[i, j] = (
SeedRandom[ToString[{i, j}]];(* make outcome predictable *)
Interpolation[ReplacePart[#, {-1, 2} -> #[[1, 2]]] &@Table[{x, RandomReal[]}, {x, Subdivide[0, 2 π, 8]}], PeriodicInterpolation -> True]
)

(* precompute the rotation matrices for improved performance *)
rx = Evaluate@RotationMatrix[#, {1, 0, 0}] &
ry = Evaluate@RotationMatrix[#, {0, 1, 0}] &
rz = Evaluate@RotationMatrix[#, {0, 0, 1}] &
(* {{1, 0, 0}, {0, Cos[#1], -Sin[#1]}, {0, Sin[#1], Cos[#1]}} & *)
(* {{Cos[#1], 0, Sin[#1]}, {0, 1, 0}, {-Sin[#1], 0, Cos[#1]}} & *)
(* {{Cos[#1], -Sin[#1], 0}, {Sin[#1], Cos[#1], 0}, {0, 0, 1}} & *)

Manipulate[
With[{pt = Mod[If[#2 == m + 1, l, 0] + # - 1, n] + Mod[If[# == n + 1, k, 0] + #2 - 1, m] n + 1 &},
Graphics3D[
Dynamic@GraphicsComplex[

Catenate@Catenate@Table[(*generate the points*)
rz[2 π (i + l j/m)/n].(
{1, 0, 0} + rx[u].({1, 1, 1/Cos[u]} ry[2 π (j/m + (k/m (i + l j/m))/n) + t].{s r, 0, 0})
),
{s, Subdivide[1, 1.2, 6]},(*add scaled versions of the polygon for the glow effect*)
{j, m},
{i, n}
],
{
EdgeForm@{Thick, Black},
Table[With[{i = i, j = j},
Catenate@Table[
If[s == 0 || # > 0.9,
{(*if the brigthness is >0.9, enable the volumetric glow by showing the scaled polygons*)
If[s > 0,
Splice@{EdgeForm@None, Opacity[5 (1 - s/8) (# - 0.9)]},
{}
],
Polygon[(*specify the polygons using the points above*)
{pt[i, j], pt[i + 1, j], pt[i + 1, j + 1], pt[i, j + 1]} + s n m,
BaseStyle -> {colorfunc[#], Glow@GrayLevel[#^10]}
]
}, {}] &@colors[i, j][t],
{s, 0, 6}
]
],
{j, m}, {i, n}
]
}
],
ViewPoint -> ({0.3, 0, 1}; {0, 0, ∞}),
ViewVertical -> {0, 1, 1},
Boxed -> False,
SphericalRegion -> True,
Background -> Darker@RGBColor[2/51, 8/51, 26/51],
PlotRange -> 2,
Lighting -> {{"Point", White, {-1.6, 1.6, 1}}, {"Point", White, {-1.6, 1.6, 1}}, {"Ambient", GrayLevel@0.3}}
]
],
{{n, 16}, 3, 20, 1},(*twist-offset along the big circle*)
{{m, 6}, 3, 10, 1},(*twist-offset along the small circle*)
{{k, 6}, -10, 10, 1},(*animation time*)
{{l, 0}, -3, 3, 1},(*tilt of the small circles*)
{{t, π/4}, 0, 2 π, AnimationRate -> 0.1, Appearance -> "Open"},(*z-rotation offset for the inner edge of the torus*)
{{u, -π/4}, -π/4, π/4},(*z-rotation offset for the outer edge of the torus*)
{{r, 0.4}, 0.1, 0.9},(*radius of the small circle*)
ControlPlacement -> Left
]
• Wheres the shininess? Jul 10 '21 at 21:57
• @user5601 As I have noted in the answer, I am not sure whether this can really be done in Mathematica Jul 10 '21 at 22:53
• @user5601 Ok, I think I have managed to get some kind of glow effect, see the updated answer Jul 10 '21 at 23:17