Rotating squares animation

I made a similar animation once with plusses:

enter image description here

I changed the shape of the plus to a square. Here is the code:

\[CurlyPhi] = Tan[1/3.];
Clear[DrawPlus, MakeScene]
DrawPlus[p : {x_, y_}, \[Theta]_] := Module[{line},
  (*line=Polygon[{{1,1},{3,1},{3,-1},{1,-1},{1,-3},{-1,-3},{-1,-1},{-3,-\
1},{-3,1},{-1,1},{-1,3},{1,3},{1,1}}];*)
  line = Polygon[{{3, 1}, {1, -3}, {-3, -1}, {-1, 3}}];

  line = GeometricTransformation[line, RotationMatrix[\[Theta]]];
  GeometricTransformation[line, TranslationTransform[p]]
  ]
MakeScene[\[Alpha]_] := Module[{p, q, \[Theta] = \[Pi] \[Alpha], gr},
  p = {1., -3.} + 
    Sqrt[10] {Cos[\[Theta] - \[CurlyPhi]], -Sin[\[Theta] - \
\[CurlyPhi]]};
  q = {3., 1.} + 
    Sqrt[10] {Sin[\[Theta] - \[CurlyPhi]], 
      Cos[\[Theta] - \[CurlyPhi]]};
  gr = Flatten[
    Table[DrawPlus[i p + j q, If[EvenQ[i + j], 0, -\[Theta]]], {i, -3,
       3}, {j, -3, 3}], 1];
  (*gr=GeometricTransformation[gr,RotationMatrix[\[Theta]/2]];*)

  Graphics[{EdgeForm[Directive[Thick, Black]], RGBColor[0, 0.5, 1], 
    gr}, PlotRange -> (16 {{-1, 1}, {-1, 1}}), ImageSize -> 300]
  ]
Manipulate[MakeScene[\[Beta]], {\[Beta], 0, 1}]

resulting in: enter image description here

I think you can figure out alternate coloring and rotating the entire scene. To change the extent of the squares change the bounds of the Table function.

Probably it can be simplified because I had another geometry. But you can study the mechanism and either adopt mine or adjust your own.


This almost, but not quite, matches the requested figure.

square = {{0, 0}, {1, 0}, {1, 1}, {0, 1}};
n = 5;
redlattice = Flatten[Table[{x, y}, {y, -n + 1, n}, {x, -n + 1, n}], 1];
greenlattice = Flatten[Table[{x, y}, {y, -n + 1, n - 1}, {x, -n + 1, n - 1}], 1];

Manipulate[
 redsquares = RotationTransform[θ + π/2, #]@square & /@ redlattice;
 temp = RotationTransform[θ + π/2, #]@square & /@ greenlattice;
 greensquares = TranslationTransform[#[[1]] - square[[1]]]@square & /@ temp;
 Graphics[{EdgeForm[Gray], 
   LightRed, Polygon@redsquares,
   LightGreen, Polygon[square], Polygon@greensquares
   }, PlotRange -> {{-2 n - 1, 2 n + 2}, {-2 n - 1, 2 n + 2}}], {θ, 0, π}]

enter image description here


I modified the SHuisman's code a bit. It turned out to be almost a complete match with the required animation.

\[CurlyPhi] = Tan[1/3.];
Clear[DrawPlus, MakeScene]
DrawPlus[p : {x_, y_}, \[Theta]_] := 
 Module[{line}, line = Polygon[{{3, 1}, {1, -3}, {-3, -1}, {-1, 3}}];
  line = GeometricTransformation[line, RotationMatrix[\[Theta]]];
  GeometricTransformation[line, TranslationTransform[p]]]
MakeScene[\[Alpha]_] := 
 Module[{p, q, \[Theta] = \[Pi] \[Alpha], gr}, 
  p = {1., -3.} + 
    Sqrt[10] {Cos[\[Theta] - \[CurlyPhi]], -Sin[\[Theta] - \
\[CurlyPhi]]};
  q = {3., 1.} + 
    Sqrt[10] {Sin[\[Theta] - \[CurlyPhi]], 
      Cos[\[Theta] - \[CurlyPhi]]};
  gr = Flatten[
    Table[{If[OddQ[i + j], LightRed, LightGreen], 
      DrawPlus[i p + j q, If[EvenQ[i + j], 0, -\[Theta]]]}, {i, -3, 
      3}, {j, -3, 3}], 1];
  Graphics[{{EdgeForm[Directive[Thick, Blue, Opacity[.5]]], 
     Rotate[gr, Pi/7]}, {Red, PointSize[.01], 
     Point[{{0, 0}, {2, 2}}]}}, PlotRange -> (30 {{-1, 1}, {-1, 1}}), 
   ImageSize -> 500]]
lst = Table[MakeScene[\[Beta]], {\[Beta], 0, 1, .02}];
ListAnimate[lst]

Figure 1