# [GIF] Release (Flapping triangular grid)

Posted 3 years ago
3379 Views
|
5 Replies
|
6 Total Likes
|
 ReleaseI liked how Inertia turned out, so I decided to make a triangular grid and see about deforming it in some interesting way. I didn't want to do twisting again, but after an hour or so I realized I was essentially re-creating Dave Whyte's dot line wave, so I decided to go in a different direction. Sorry that the definition of dots is so gross... DynamicModule[{cols, dots, xmax = 13, ymax = 13}, cols = GrayLevel /@ {.95, .2}; Manipulate[ dots = Table[(1 - 1/2 Total[ Flatten[Table[(-1)^((i + j + 8)/8) Haversine[ t - π Norm[{x, y} - {i, j}]/15], {i, {-4, 4}}, {j, {-4, 4}}], 1]]) {Sqrt[3] x + (-1)^y Sqrt[3]/4 - Sqrt[3]/4, 3 y/2}, {x, -xmax, xmax}, {y, -ymax, ymax}]; Graphics[{cols[[1]], Thickness[.003], CapForm["Round"], Table[Line[dots[[i]]], {i, 1, Length[dots]}], Table[Line[Transpose[dots][[i]]], {i, 1, Length[Transpose[dots]]}], Table[Line[{dots[[i + 1, j + 1]], dots[[i, j]], dots[[i + 1, j - 1]]}], {i, 1, Length[dots] - 1}, {j, 2, Length[Transpose[dots]], 2}]}, ImageSize -> 540, PlotRange -> 35, Background -> cols[[-1]]], {t, 0., 2 π}] ] 
5 Replies
Sort By:
Posted 3 years ago
 Sorry that the definition of dots is so gross... Hahaha! You're forgiven!
Posted 3 years ago
 Beautiful and compact! I like that this is not an infinite field, flapping edges give it more dramatic appearance.
Posted 3 years ago
 - another post of yours has been selected for the Staff Picks group, congratulations !We are happy to see you at the top of the "Featured Contributor" board. Thank you for your wonderful contributions, and please keep them coming!
 Your beautiful animations have once more forced me to delurk. :)Here's my modest improvement: DynamicModule[{xmax = 13, ymax = 13, cols = GrayLevel /@ {.95, .2}}, Manipulate[Graphics[GraphicsComplex[ Flatten[N[Table[(1 - Sum[(-1)^((i + j + 8)/8) Haversine[t - π Norm[{x, y} - {i, j}]/15], {i, {-4, 4}}, {j, {-4, 4}}]/2) {Sqrt[3](x + (-1)^y/4 - 1/4), 3 y/2}, {x, -xmax, xmax}, {y, -ymax, ymax}]], 1], {Directive[cols[[1]], AbsoluteThickness[0.1], CapForm["Round"]], {Line[#], Line[Transpose[#]]} &[Partition[Range[(2 xmax + 1) (2 ymax + 1)], 2 ymax + 1]], Line[Flatten[Table[{(2 ymax + 1) i + j + 1, (2 ymax + 1) (i - 1) + j, (2 ymax + 1)i + j - 1}, {i, 2 xmax}, {j, 2, 2 ymax, 2}], 1]]}], ImageSize -> 540, PlotRange -> 35, Background -> cols[[-1]]], {t, 0, 2 π}]] 
 Hey, nice! And thanks for pointing me to the existence of AbsoluteThickness, which I wasn't aware of.