Coalesce (Deforming an isometric pattern)
Adapted work of Clayton Shonkwiler, Colorado State University.
Download original notebookContinuing with the theme of selectively breaking and re-forming a tiling pattern, though this time without any rotation
Module[{uid = CreateUUID[], BasicTileCoords, f, cols, centerpoint, ψ, layering, \[Theta] = 3.14, dt = 0.1, colors}, BasicTileCoords = {{0, -1}, {0, 0}, {Sqrt[3]/2, 1/2}, {Sqrt[3]/2, 0}, {Sqrt[3]/4, -1/4}, {Sqrt[3]/4, -3/4}} // N; cols = ColorData["BlueGreenYellow"] /@ Range[1, 0, -1/4]; f = 3 Piecewise[{ {0, # < 0}, {1/2 - 1/2 Cos[#], 0 <= # < π}, {1, # >= π} }] &; layering = Append[Riffle[Reverse[Range[3]], -Reverse[Range[3]]], 0]; EventHandler[uid, Function[Null, \[Theta] = \[Theta] + dt; If[\[Theta] > 2 Pi || \[Theta] <= 0, dt = -dt]; {dataset, colors} = Flatten[ Table[ { centerpoint = {3 Sqrt[3]/4 i, 3/2 j + (-1)^i*3/8}; ψ = f[\[Theta] - π/(3.0 Sqrt[7]) Norm[centerpoint - {0, 3/8.0}]]; centerpoint + # & /@ (RotationMatrix[2 π t/3.0].(ψ {Sqrt[3]/4.0, -1/4.0} + #) & /@ BasicTileCoords) // N, cols[[t]] }, {j, layering}, {i, layering}, {t, 1, 3} ], 2] // Transpose; ]]; EventFire[uid, True]; Graphics[{ EdgeForm[Directive[JoinForm["Round"], cols[[4]], Thickness[.006]]], Table[ With[{i = i}, {colors[[i]], Polygon[dataset[[i]] // Offload]} ], {i, Length[dataset]} ], AnimationFrameListener[dataset // Offload, "Event" -> uid] }, PlotRange -> {{-5, 5}, {-5 + 3/8, 5 + 3/8}}, ImageSize -> 540, TransitionDuration -> 200] ]
(*VB[*)(FrontEndRef["c287dde6-d564-4b13-8997-90ef53ae430e"])(*,*)(*"1:eJxTTMoPSmNkYGAoZgESHvk5KRCeEJBwK8rPK3HNS3GtSE0uLUlMykkNVgEKJxtZmKekpJrpppiameiaJBka61pYWprrWhqkppkaJ6aaGBukAgCEFxWG"*)(*]VB*)