Skip to main content

Coalesce (Deforming an isometric pattern)

Adapted work of Clayton Shonkwiler, Colorado State University.

Continuing with the theme of selectively breaking and re-forming a tiling pattern, though this time without any rotation

Download original notebook
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*)