7

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.

enter image description here

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.

500
  • 5,569
  • 6
  • 27
  • 49
  • Should it be done in 2D (like FJRA´s solution) or is a native 3D scene an option? – Yves Klett Mar 05 '12 at 07: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 05 '12 at 17:05

1 Answers1

10

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

enter image description here

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

FJRA
  • 3,972
  • 22
  • 31
  • 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 03 '12 at 15:28
  • I edited and added a moving background... that's what you wanted? – FJRA Mar 03 '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. : http://dl.dropbox.com/u/20775208/Sparrow/5a72ffb28ab8546d3ba0dec24d1dd2db/Screen%20Shot%202012-03-03%20at%2012.55.52%20PM.png – 500 Mar 03 '12 at 17:58
  • Cool! I really missed the exhaust port from the end. – István Zachar Mar 04 '12 at 20:14