Simplifying code that displays a square rolling inside a circle

Question

The vertex A,B of the square ABCD with side length $\sqrt{2}$ is on the circle with radius $\sqrt{2}$, vertex C,D is inside the circle, roll the square ABCD along the inside of the circle counterclockwise without sliding.
My code is already working, but I believe he can be more concise

Clear["`*"];
p0 = N @ {{-√2/2, -√6/2}, {√2/2, -√6/2}, {√2/2, √2-√6/2}, {-√2/2, √2-√6/2}};
p1[t_] := RotationTransform[t,p0[[1]]][p0];
p2[t_] := RotationTransform[t,p1[π/6][[4]]][p1[π/6]];
p3[t_] := RotationTransform[t,p2[π/6][[3]]][p2[π/6]];
p4[t_] := RotationTransform[t,p3[π/6][[2]]][p3[π/6]];
p5[t_] := RotationTransform[t,p4[π/6][[1]]][p4[π/6]];
p6[t_] := RotationTransform[t,p5[π/6][[4]]][p5[π/6]];

Manipulate[
  Graphics[
    {Circle[{0, 0}, Sqrt[2]], EdgeForm[Black], Opacity[0.1],
     Polygon[
       Which[
         t < π/6, p1[t], 
         t < 2π/6, p2[t-π/6], 
         t < 3π/6, p3[t-2π/6], 
         t < 4π/6, p4[t-3π/6], 
         t < 5π/6, p5[t-4π/6], 
         True, p6[t-5π/6]]]},
    PlotRange -> 2], 
  {t, 0, 6π/6}]

Some attempts, but lacks the rotation process

With[{p0=N@{{-√2/2,-√6/2},{√2/2,-√6/2},{√2/2,√2-√6/2},{-√2/2,√2-√6/2}}},
  Manipulate[With[{pts=Fold[RotationTransform[π/6,#[[-Mod[#2,4,1]]]]@#&,p0,Range[0,i]]},
    Graphics[{Circle[{0,0},Sqrt[2]],{EdgeForm[Black],Opacity[0.1],Polygon@pts}},
      PlotRange->2]],{i,0,5}]]

Do you have a better way?

Tips that may be useful
Which[t < π/6, t, t < (2 π)/6, t - π/6, t < (3 π)/6, t - (2 π)/6, t < (4 π)/6, t - (3 π)/6, t < (5 π)/6, t - (4 π)/6, True, t - (5 π)/6] == Mod[t, Pi/6]

Answer 1

EDIT 1. Fixed kernel crashing. The problem was WhenEvent choking, because it was continually checking whether the current pivot (which lies exactly on the bounding circle) goes outside the bounding circle.

EDIT 2. Here is a port to GNU Octave: https://github.com/yawnoc/tumbling-polygon

---

System of ODEs in the complex plane

For a completely different take, observe that rigid rotation of the $n$th vertex $z_n$ around a pivot $p$ can be expressed as the differential equation

$$\frac{\mathrm{d}z_n}{\mathrm{d}t} = \mathrm{i} \,(z_n - p),$$

where $\mathrm{i} = \sqrt{-1}$, and we have scaled out the angular velocity. This is because the instantaneous velocity is (1) at right angles to the displacement vector $z_n - p$, and (2) proportional to the distance $|z_n - p|$. (Remember multiplication by $\mathrm{i}$ effects a 90-degree rotation.) If the vertex $z_n$ happens to coincide with the pivot location $p$, this nicely reduces to $\mathrm{d}z_n / \mathrm{d}t = 0$.

So we solve a system of such ODEs in $(z_1, z_2, z_3, z_4, p)$, where we handle the collision with the bounding circle $|z| = \sqrt{2}$ using WhenEvent; if $|z_n| > \sqrt{2}$, we set $p$ to $z_n$.

ClearAll["Global`*"];

vertexInitialPositions = Complex @@@ N @ {
  {-Sqrt[2]/2, -Sqrt[6]/2},
  {Sqrt[2]/2, -Sqrt[6]/2},
  {Sqrt[2]/2, Sqrt[2] - Sqrt[6]/2},
  {-Sqrt[2]/2, Sqrt[2] - Sqrt[6]/2},
  Nothing
};
vertexCount = Length[vertexInitialPositions];

vertexRotationEquations =
  Table[z[i]'[t] == I (z[i][t] - p[t]), {i, vertexCount}];

pivotFixtureEquation = p'[t] == 0;

vertexInitialConditions =
  Table[z[i][0] == vertexInitialPositions[[i]], {i, vertexCount}];

pivotInitialCondition = p[0] == First[vertexInitialPositions];

boundingRadius = Sqrt[2];
collisionHandling =
  Table[
    whenEventDummy[
      (* If this vertex isn't pivot AND goes outside bounding circle *)
      z[i][t] != p[t] && Abs @ z[i][t] > boundingRadius,
      (* Set the pivot to this vertex *)
      p[t] -> z[i][t]
    ]
    , {i, vertexCount}
  ] /. {whenEventDummy -> WhenEvent};
dependentVariables = Table[z[i], {i, vertexCount}] // Append[p];

tMax = Pi;
trajectories =
  NDSolveValue[
    Flatten @ {
      vertexRotationEquations, pivotFixtureEquation,
      vertexInitialConditions, pivotInitialCondition,
      collisionHandling
    },
    dependentVariables,
    {t, 0, tMax}
  ];

vertexRealTrajectories[t_] :=
  Most[trajectories][t] // Through // ReIm // Evaluate;

Manipulate[
  Show[
    Graphics @ Circle[{0, 0}, boundingRadius],
    Graphics @ Polygon @ vertexRealTrajectories[tCurrent],
    If[tCurrent == 0, {},
      ParametricPlot[
        vertexRealTrajectories[t]
        , {t, 0, tCurrent}
      ]
    ]
    , ImageSize -> 240
  ]
  , {tCurrent, 0, tMax}
]

The nice thing about this method is that it generalises to any polygon. Also the initial pivot need not start on the bounding circle (and in fact need not be any of the vertices).

Answer 2

At first we need to rotate the first edge around the first point.We use NMinimize to find such minimal angle.

We ordering the points of polygon by clockwise,and rotate it by anticlockwise,so here we use RotateLeft to change the order of points.

pts = {{1, 0}, {-0.2, -0.1}, {-0.1, 0.6}, {0.2, 0.8}, {Cos[1], 
    Sin[1]}};
rotaAngle[p_, center_] := 
  Module[{θ}, 
   First@NMinimize[{θ, 
      Norm@RotationTransform[θ, center][p] == 1, θ > 
       0}, {θ}]];
f[pts_] := Module[{θ, center},
   θ = rotaAngle[pts[[2]], pts[[1]]];
   center = pts[[1]];
   RotateLeft[RotationTransform[θ, center] /@ pts, 1]];
polygon = NestList[f, pts, 20];
Manipulate[
 Graphics[{Circle[], FaceForm[], EdgeForm[Red], 
   Polygon[polygon[[n]]]}], {n, 1, 20, 1}]

Here just a temporary workaround,I need time to find the way to rotate the polygon Independently.

Edit

Test another convex region.

reg = ImplicitRegion[x^2/4 + y^2/3 <=  1 , {x, y}];
pts = {{2, 0}, {1, -0.2}, {1, 0.3}, {1.3, 0.6}, {1.5, 0.5}};
rotaAngle[pts_] := 
  Module[{θ}, 
   First@NMaximize[{θ, 
      AllTrue[RotationTransform[θ, First[pts]] /@ Rest[pts], 
       Element[#, reg] &], π > θ > 0}, {θ}, 
     Method -> Automatic]];
f[pts_] := Module[{θ, center}, θ = rotaAngle[pts];
   center = pts[[1]];
   RotateLeft[RotationTransform[θ, center] /@ pts, 1]];
polygon = NestList[f, pts, 20];
regionplot = 
  RegionPlot[reg, Frame -> False, PlotStyle -> {Cyan, Opacity[0.2]}, 
   BoundaryStyle -> Green, AspectRatio -> Automatic];
Manipulate[
 Show[regionplot, 
  Graphics[{FaceForm[], EdgeForm[Red], Polygon[polygon[[n]]]}]], {n, 
  1, 20, 1}]

Answer 3

A start at a better way:

Graphics[
 GeometricTransformation[Rectangle[],
  RotationTransform[30 Degree, {0, 0}]]]