Rotating squares animation
I made a similar animation once with plusses:
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:
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, π}]
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]