Cube Life
The basic idea is simple: I'm rotating the cube around the axis $(1,1,0)$ and stereographically projecting the vertices to the plane. Or rather, I'm thinking of the vertices of this rotating cube as the centers of spherical circles of radius $0.2$, and then stereographically projecting those circles to the plane, resulting in circles of different radii.
This stereographic projection of circles is accomplished using the ProjectedSphericalCircle
function, the (gross) definition of which you can see on the post for Small Changes.
As is so often the case, I'm using the smootheststep function for easing:
smootheststep[t_] := -20 t^7 + 70 t^6 - 84 t^5 + 35 t^4;
Here's the code. The piecewise definition of $\theta$ (for some reason I used Which
rather than Piecewise
) is due to the fact that we need to rotate the cube by slightly different amounts between each of the pauses.
DynamicModule[{poly = "Cube", p, e, rp, ?,
cols = RGBColor /@ {"#008cbc", "#007500", "#e6c700", "#db2f27", "#f7f7f7"}},
p = Normalize /@ PolyhedronData[poly, "VertexCoordinates"];
e = PolyhedronData[poly, "EdgeIndices"];
Manipulate[
Which[
0 <= Mod[t, 4] < 1, ? = smootheststep[t - Floor[t]] ArcCos[1/Sqrt[3]],
1 <= Mod[t, 4] < 2, ? = ArcCos[1/Sqrt[3]] +
smootheststep[t - Floor[t]] (?/2 - ArcCos[1/Sqrt[3]]),
2 <= Mod[t, 4] < 3, ? = ?/2 +
smootheststep[t - Floor[t]] (?/2 - ArcCos[1/Sqrt[3]]),
3 <= Mod[t, 4] < 4, ? = ? -
smootheststep[1 + Floor[t] - t] ArcCos[1/Sqrt[3]]];
rp = p.RotationMatrix[-?, {1, 1, 0}].RotationMatrix[
4.5 ?/12 (Floor[t] + smootheststep[Mod[t, 1]]), {0, 0, 1}];
Graphics[
{Blend[
Append[cols[[;; -2]], cols[[1]]], (Floor[t] + smootheststep[Mod[t, 1]])/16],
ProjectedSphericalCircle[#, .2] & /@ rp},
PlotRange -> 3.52968, ImageSize -> 540, Background -> cols[[-1]]],
{t, 0., 16}]
]