# Create a “perspective animation”

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 dont know how i could "program" it and then animate it.

-
Should it be done in 2D (like FJRA´s solution) or is a native 3D scene an option? –  Yves Klett Mar 5 '12 at 7:10
native 3D would be great I think. As long as I could map what is seen in 2D. That is I will correlate the scene properties with the gaze observed when it is displayed on the screen. –  500 Mar 5 '12 at 17:05

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}]


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).

-
very cool, could the line that converge in the bcd be moving points as well ? That is instead of lines to have points close to one another ? –  500 Mar 3 '12 at 15:28
I edited and added a moving background... that's what you wanted? –  FJRA Mar 3 '12 at 15:36
wow, what a weird feeling, here is a ppt mockup of what i had uin mind, the points coming toward you, not rotating. Thank You very much for your time and attention. : dl.dropbox.com/u/20775208/Sparrow/… –  500 Mar 3 '12 at 17:58
Thank you once agin ! –  500 Mar 4 '12 at 4:09
Cool! I really missed the exhaust port from the end. –  István Zachar Mar 4 '12 at 20:14