Flap
I was trying to recreate the Cairo pentagonal tiling and for whatever reason I ended up building it out of two-pentagon pieces connected along the short edge. That visually suggested some sort of butterfly, which naturally led me to making the "butterflies" flap their wings, and here we are.
Here's the code:
DynamicModule[{t = ?/6., s, cols},
cols = RGBColor /@ {"#FF2E63", "#08D9D6", "#252A34"};
Manipulate[
Graphics[{FaceForm[None], EdgeForm[Thickness[.005]],
Table[s = ?/3. Haversine[
Clip[2 r - 2 ? (x + 7)/14, {0, 2 ?}]]; {EdgeForm[
Blend[cols[[;; 2]], 3 s/?]],
Polygon[FoldList[
Plus, {Sqrt[3]
x Cos[t] - (2 Sqrt[3] y +
Sqrt[3] HeavisideTheta[(-1)^x]) Sin[t],
Cos[t] (2 Sqrt[3] y + Sqrt[3] HeavisideTheta[(-1)^x]) +
Sqrt[3] x Sin[t]},
Table[{Cos[t] Cos[?] - i Cos[i s] Sin[t] Sin[?],
Cos[?] Sin[t] +
i Cos[i s] Cos[t] Sin[?]}, {?,
Accumulate[{?/3, ?/2, ?/3, ?/
2}]}]]]}, {x, -7, 7}, {y, -4, 3}, {i, {-1, 1}}],
Table[s = ?/3. Haversine[
Clip[2 r - 2 ? (x + 7)/14, {0, 2 ?}]]; {EdgeForm[
Blend[cols[[;; 2]], 3 s/?]],
Polygon[FoldList[
Plus, {Cos[
t] (1/2 (1 - 3 Sqrt[3]) + 2 Sqrt[3] y +
Sqrt[3] HeavisideTheta[(-1)^x]) - (1/2 (-1 + Sqrt[3]) +
Sqrt[3] x) Sin[t], (1/2 (-1 + Sqrt[3]) + Sqrt[3] x) Cos[
t] + (1/2 (1 - 3 Sqrt[3]) + 2 Sqrt[3] y +
Sqrt[3] HeavisideTheta[(-1)^x]) Sin[t]},
Table[{-Cos[?] Sin[t] +
i Cos[i s] Cos[t] Sin[?],
Cos[t] Cos[?] +
i Cos[i s] Sin[t] Sin[?]}, {?,
Accumulate[{?/3, ?/2, ?/3, ?/
2}]}]]]}, {x, -8, 8}, {y, -3, 4}, {i, {-1, 1}}]},
PlotRange -> 10, ImageSize -> 540, Background -> cols[[3]]], {r, 0,
2 ?}]]
Now, that code is rather inscrutable-looking, in part because it cut down computation time to expand out various multiplications by RotationMatrix[t]
; here's the original code, which is somewhat easier to read but slower:
DynamicModule[{t = ?/6., s, cols},
cols = RGBColor /@ {"#FF2E63", "#08D9D6", "#252A34"};
Manipulate[
Graphics[{FaceForm[None], EdgeForm[Thickness[.005]],
Table[s = ?/3. Haversine[
Clip[2 r - 2 ? (x + 7)/14, {0, 2 ?}]]; {EdgeForm[
Blend[cols[[;; 2]], 3 s/?]],
Polygon[FoldList[Plus,
RotationMatrix[t].{Sqrt[3] x,
2 Sqrt[3] y + Sqrt[3] HeavisideTheta[(-1)^x]},
Table[RotationMatrix[t].{Cos[?],
i Cos[i s] Sin[ ?]}, {?,
Accumulate[{?/3, ?/2, ?/3, ?/
2}]}]]]}, {x, -7, 7}, {y, -4, 3}, {i, {-1, 1}}],
Table[s = ?/3. Haversine[
Clip[2 r - 2 ? (x + 7)/14, {0, 2 ?}]]; {EdgeForm[
Blend[cols[[;; 2]], 3 s/?]],
Polygon[FoldList[Plus,
RotationMatrix[
t].{2 Sqrt[3] y +
Sqrt[3] HeavisideTheta[(-1)^x] - (3 Sqrt[3] - 1)/2,
Sqrt[3] x + (Sqrt[3] - 1)/2},
Table[RotationMatrix[t].{ i Cos[i s] Sin[ ?],
Cos[?]}, {?,
Accumulate[{?/3, ?/2, ?/3, ?/
2}]}]]]}, {x, -8, 8}, {y, -3, 4}, {i, {-1, 1}}]},
PlotRange -> 10, ImageSize -> 540, Background -> cols[[3]]], {r, 0,
2 ?}]]