[GIF] Release (Flapping triangular grid)

Staff Picks
, , , ,
1

trigrid26t.gif

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 - Pi 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 Pi}]
 ]
6 Likes
[GIF] Compression (Deforming the hex lattice)
2

Sorry that the definition of dots is so gross…

Hahaha! You’re forgiven!

3

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

4

2015-11-02_10-07-11.png

  • 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!

5

Your beautiful animations have once more forced me to delurk. :slight_smile:

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 - Pi 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 Pi}]]
6

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