Create a "perspective animation"

Question

Inspired by How can this confetti code be improved to include shadows and gravity?

I would like to create my new experiment/stimuli using Mathematica. The idea is to study how people move their eyes in a dynamic scene.

To do so I need to build some animations (1 minute long to start) where we feel like going forward in a perspective grid like the one below.

I will need to make some object appear/disappear/change within that scene. The grid itself could just be made out of point, and i will add some geometric colored shapes.

While I know how to draw perspective I don`t know how i could "program" it and then animate it.

Answer 1

It could be something like this?

outersquare = {{-1, -.8}, {1, .8}};

innersquare = outersquare/10. + {-.1, 0};

corners[sq_] := {sq[[1]], {sq[[1, 1]], sq[[2, 2]]}, 
   sq[[2]], {sq[[2, 1]], sq[[1, 2]]}};

lines[sq_] := Partition[corners[sq], 2, 1, 1];

pointOfSquare[sq_, side_, i_, n_] := 
  With[{line = lines[sq][[side]]}, 
   line[[1]] + (n - i)/n (line[[2]] - line[[1]])];

alllines := 
  With[{n = 20}, 
   Flatten@Table[
     Line[{pointOfSquare[innersquare, side, i, n], 
       pointOfSquare[outersquare, side, i, n]}], {side, 4}, {i, 0, 
      n}]];

rectangle[i_, n_] := 
  With[{factor = Log[i]/Log[n]}, 
   Rectangle @@ (factor innersquare + (1 - factor) outersquare)];

Animate[Graphics[{Red, alllines, EdgeForm[Red], FaceForm[Transparent],
    Table[rectangle[i, 10], {i, 1 + ministep, 10, 1}]}], {ministep, 
  .99, 0, -.01}]

EDIT: Adding "moving background":

alllines2[shift_] := 
  With[{n = 20}, 
   Flatten@Table[
     Line[{pointOfSquare[innersquare, side, i, n], 
       pointOfSquare[outersquare, side, i, n]}], {side, 4}, {i, shift,
       n, 1}]];

Animate[Graphics[{Red, alllines2[ministep], EdgeForm[Red], 
   FaceForm[Transparent], 
   Table[rectangle[i, 10], {i, 1 + ministep, 10, 
     1}]}], {ministep, .99, 0, -.01}]

EDIT2: Adding moving points (if you want to take out the red lines, get rid of alllines).

pointInLine[linepoints_, i_, shift_, n_] := 
 If[i + shift < n, 
  With[{factor = Log[i + shift]/Log[n]}, 
   Point[linepoints[[1, 
       1]] + (1 - factor) (linepoints[[1, 2]] - 
        linepoints[[1, 1]])]], {}]

allPoints[linesperside_, shift_, n_] := 
  With[{lines = 
     Flatten@Table[
       Line[{pointOfSquare[innersquare, side, i, linesperside], 
         pointOfSquare[outersquare, side, i, linesperside]}], {side, 
        4}, {i, 0, linesperside}]},
   Flatten[
    Table[pointInLine[line, i, shift, n], {line, lines}, {i, n}]]];

Animate[Graphics[{Red, alllines, Blue, PointSize[Medium], 
   allPoints[4, ministep, 10], EdgeForm[Red], FaceForm[Transparent], 
   Table[rectangle[i, 10], {i, 1 + ministep, 10, 
     1}]}], {ministep, .99, 0, -.01}]

In conclusion, I use as "move" factor Log[i+shift]/Log[n], so for each frame, the change from the previous one is that shift value (between 0 and 1).