Message Boards Message Boards

GROUPS:

[GIF] Release (Flapping triangular grid)

Posted 3 years ago
3397 Views
|
5 Replies
|
6 Total Likes
|

Flapping triangular grid

Release

I 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

Hey, nice! And thanks for pointing me to the existence of AbsoluteThickness, which I wasn't aware of.

Posted 3 years ago

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 π}]]
POSTED BY: J. M.
Answer

enter image description here - 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!

Beautiful and compact! I like that this is not an infinite field, flapping edges give it more dramatic appearance.

Sorry that the definition of dots is so gross...

Hahaha! You're forgiven!

Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract