
This one is pretty simple: take two circles of radius 1/2 rolling inside a unit circle and track a point on each circle's perimeter. The points turn out to follow straight lines, and the challenge is to make this seem both surprising and obvious (and also to fit it all under 3 MB). Not sure if I succeeded, but that was the idea, anyway.
Here's the code:
smoothstep[x_] := 3 x^2 - 2 x^3;
With[{a = 1, b = 1/2, cols = RGBColor /@ {"#303841", "#f3f6f6"}},
Manipulate[
Graphics[{
Thickness[.0075], cols[[1]],
Opacity[
Which[t < 8 ?, 1, 8 ? <= t < 12 ?,
1 - smoothstep[(t - 8 ?)/(4 ?)],
12 ? <= t < 14 ?, 0, 14 ? <= t <= 18 ?,
smoothstep[(t - 14 ?)/(4 ?)]]],
Table[
Circle[(a - b) {Cos[t + ? i], Sin[t + ? i]}, b], {i, 0, 1}],
Opacity[
Which[t < 6 ?, 0, 6 ? <= t < 8 ?,
smoothstep[(t - 6 ?)/(2 ?)], 8 ? <= t < 14 ?, 1,
14 ? <= t <= 18 ?,
1 - smoothstep[(t - 14 ?)/(4 ?)]]],
Thickness[.01],
Line[
Table[(a - b) {Cos[s], Sin[s]} + b {Cos[-(a - b)/b s], Sin[-(a - b)/b s]}, {s, t - 3 ?/4, t, ?/100}],
VertexColors ->
Table[Blend[{Directive[cols[[2]], Opacity[0]], cols[[1]]}, s], {s, 0, 1, 1/75}]],
Line[
Table[(a - b) {Cos[s + ?], Sin[s + ?]} + b {Cos[-(a - b)/b s], Sin[-(a - b)/b s]}, {s, t - 3 ?/4, t, ?/100}],
VertexColors ->
Table[Blend[{Directive[cols[[2]], Opacity[0]], cols[[1]]}, s], {s, 0, 1, 1/75}]],
Opacity[1], cols[[1]], Thickness[.0075], Circle[],
PointSize[.03],
Table[
Point[(a - b) {Cos[t + i ?], Sin[t + i ?]} + b {Cos[-(a - b)/b t], Sin[-(a - b)/b t]}], {i, 0, 1}]},
Background -> cols[[-1]], PlotRange -> Sqrt[2], ImageSize -> 540],
{t, 0, 18 ?}]
]