[GIF] Control Yourself (Deforming the square grid)

Ideas
, ,
1

dance10c.gif

Control Yourself

Just something super simple this time.

DynamicModule[{cols, r, s},
 cols = RGBColor /@ {"#00EAFF", "#F37EF9", "#020438"};
 Manipulate[
  s = Pi/12 Cos[t];
  Graphics[
   {CapForm["Round"], Thickness[.005], Blend[cols[[;; 2]], Haversine[t]],
    Table[{
      r = 2 x + 1/2 + (-1)^y/2 + 5;
      Line[{2 x + 1/2 + (-1)^y/2, y + (-1)^y} + .72 # & /@
        {{0, 0}, {Cos[θ + (-1)^y  s + Pi/4], Sin[θ + (-1)^y  s + Pi/4]}}]},
     {x, -4, 3}, {y, -8, 7}, {θ, 0, 3 Pi/2, 2 Pi/4}]},
   PlotRange -> 7, ImageSize -> 540, Background -> cols[[-1]]],
  {t, 0, 2 Pi}]
 ]
2 Likes
2

It was so nice, I couldn’t help myself:

DynamicModule[{cols = RGBColor /@ {"#00EAFF", "#F37EF9", "#020438"}},
              Manipulate[Graphics[{CapForm["Round"], Thickness[.005], Blend[cols[[;; 2]], Haversine[t]],
                                   Line[Flatten[Table[With[{s = ?/12 Cos[t]},
                                        TranslationTransform[{2 x + 1/2 + (-1)^y/2, y + (-1)^y}][.72{{0, 0},
                                                             {Cos[? + (-1)^y s + ?/4], Sin[? + (-1)^y s + ?/4]}}]],
                                         {x, -4, 3}, {y, -8, 7}, {?, 0, 3 ?/2, 2 ?/4}], 2]]},
                                   Background -> cols[[-1]], ImageSize -> 540, PlotRange -> 7], {t, 0, 2 ?}]]
1 Like
3

Hey, thanks! Yours is definitely better than mine (and makes it clear that my declared-but-never-used r is completely superfluous), but I’m actually surprised how relatively non-responsive the Manipulate is in either case. Seems like it shouldn’t be so computationally intensive.

4

I present a slight variation. Not as concise, but surprisingly fluid:

With[{m = 7, n = 7, r = 6, c1 = RGBColor["#00EAFF"], c2 = RGBColor["#F37EF9"], cb = RGBColor["#020438"]}, 
     Manipulate[Graphics[With[{? = ? Sin[?]/r}, 
                              Table[{Directive[AbsoluteThickness[2], Blend[{c1, c2}, Haversine[r ?]]], 
                                     Line[TranslationTransform[{j, k}] @
                                          {{0, 0}, (Haversine[?] + Haversine[{? + ?/2, ? - ?/2}])/2, {1, 1}/2,
                                           (Haversine[? + ?] + Haversine[{? - ?/2, ? + ?/2}])/2, {1, 1}}], 
                                     Line[TranslationTransform[{j, k}] @
                                          {{0, 1}, (Haversine[{?, ? + ?}] + Haversine[? - ?/2])/2, {1, 1}/2,
                                           (Haversine[{? + ?, ?}] + Haversine[? + ?/2])/2, {1, 0}}]},
                                    {j, 0, m - 1}, {k, 0, n - 1}]], 
                           Background -> cb], {?, 0, 2 ?}]]
1 Like