# How to obtain an animated prism using Mathematica?

Is it possible to create a GIF animation like the one shown below, using Mathematica? UPDATE

I have mainly two puzzles:

1. How do I obtain the rendered trigonometric curves (unnecessarily animated);- So I want to know what kind of Mathematica commands can create a "3D rendered tube" like curves per the parametric equations? -- I mean curves that look like the ones in the picture below:  1. How do I make sure these curves are smoothly continuous even after being refracted; I also need some clues in representing the equations of the curves (in parametric form or other forms), before and after being refracted; In order to handle the refraction smoothly and continuously, I think parametric equation forms of the curves are necessary since some of the curves may have only implicit form.

For example: This photo was found from the Internet; I need such clues to create similar GIF animations using Mathematica;

Before creating similar GIF animations, I need to solve the two puzzles; I think there is no other obstacle for me to create it;

Update$^{(2)}$

I am not simply requesting code, answers resolve the two questions mentioned and illustrated with photos above will be accepted. I hope this can be made clearer.

However, there is no reason that I refuse answers with codes which can create similar GIF photos.

Now there is already acceptable answer. I will try to work on it.

• Yes, this is possible. Which of Mathematica plotting commands cause you trouble? Sep 10 '14 at 10:10
• Are these curves by 3D plots or other command? I just have no idea of it. Do you have an answer to it? I am eager to learn it Sep 10 '14 at 10:18
• I will update my question. Sep 10 '14 at 10:31
• have you tried something, or did you just find a picture and want someone to write code for you to recreate it? There is no dark side in the moon, really. Matter of fact, it's all dark. Sep 10 '14 at 12:08
• Usually we discourage "GimmeTehCodez" questions. See the meta post here. There are exceptions but they should be rare.
– Jens
Sep 10 '14 at 17:05

Here is an example of a function drawn along a parametric path:

 points = {{0, 0}, {1, 1}, {1.8, 1.8}, {2, 2}, {3, 3/2}, {4, 1}};
path = BSplineFunction[points];
ipath = Interpolation[
Transpose@({Prepend[Accumulate[Norm /@ Differences@#], 0], #} &@
Table[path@x, {x, 0, 1, .01}])];
plen = ipath[[1, 1, 2]];
d2 = Derivative@ipath;
Show[{ParametricPlot[path@x, {x, 0, 1}],
ParametricPlot[ipath@x - (1 + (x/plen)^2) Sin[40 x + 10 x^2]
{1, -1} Normalize[Reverse@d2@x]/10, {x, 0, plen}],
ListPlot[points, Joined -> True, PlotStyle -> Dashed]},
PlotRange -> All] Note the trick here is to get the parametric representation in terms of the path length.

3D version:

Show[Graphics3D@
Tube@Table[
Append[ipath@x - (1 + (x/plen)^2) Sin[
20 x + 5 x^2] {1, -1} Normalize[Reverse@d2@x]/10 , 0],
{x, 0, plen, .01}], Boxed -> False] You could try something like this

Animate[
Graphics[{
Black, Rectangle[{0, 0}, {120, 100}],
EdgeForm[{Thick, GrayLevel[0.6]}], GrayLevel[0.3],
Triangle[{{110, 10}, {10, 10}, {60, 90}}],
EdgeForm[None], GrayLevel[0.8],
Polygon[{{0, 30}, {0, 35}, {35, 50}, {31, 43}}], Inset[
Plot[.0025 t Sin[c .25 t], {t, 0, 100}, Axes -> False,
PlotRange -> {{0, 100}, {-1.5, 1.5}}]
, {64, 45}]
}]
, {c, 12, 8}] • Thank you! this is very useful. Let's neglect the refraction index difference when using Snell's law. Only from KnotData related commands I saw 3D tube like curve redenring, e.g.: Graphics3D[{Orange, Specularity[White, 70], KnotData[{8, 3}, "ImageData"]}, Boxed -> False, ViewPoint -> {0, 0.1, 5}] Sep 10 '14 at 12:54
• @LCFactorization check the edit. Is it the rendering effect for the sin curves you asking for?
– Phab
Sep 10 '14 at 13:09
• I have posted 3D curve examples to illustrate my request; additionally, did you notice how the original GIF sin curves handle refractions? this is another question of mine. When the curve intersects the edge of medium, the transmission direction changes but the curves are kept as smoothly continuous. Sep 10 '14 at 13:13
• In order to handle the refraction smoothly and continuously, I think parametric equation form of the curves is necessary since some of them might have only implicit form. Sep 10 '14 at 13:20

I'll leave the animation to somebody else:

refWave[{x1_, y1_}, {m1_, m2_}, h_, d_, f_, x_] := {x,
y1 + (x - x1) (m1 + (m2 - m1) With[{t = Clip[Rescale[x - x1, {-h, h}], {0, 1}]},
t^2 (3 - 2 t)])} +
d Sin[2 π f x] Normalize[{-Piecewise[{{m1, x - x1 < -h}, {m2, h < x - x1}},
(m1 + m2)/2 + (m2 - m1) (x - x1)
(3/2 - ((x - x1)/h)^2)/h], 1}]

ParametricPlot[Table[refWave[With[{u = 1/2 + t/10}, {-Sqrt/2 (u - 1), (3 u - 1)/2}],
{1/10 + t/20, 1/3 - 3 t/2}, 1/20, 1/50, 8/(5/4 - t), x],
{t, 7/10, 1/10, -1/10}] // Evaluate, {x, -1/2, 3/2},
AspectRatio -> Automatic, Axes -> None, Background -> Black,
Epilog -> {White, Polygon[{{-17/(20 Sqrt), 3/20},
{-6 Sqrt/25, 7/25},
{-3/2, (12 Sqrt - 5)/250},
{-3/2, (17 Sqrt - 45)/300}}]},
PlotRange -> {{-3/2, 3/2}, {-3/4, 5/4}},
PlotStyle -> (RGBColor /@ {"#9400D3", "#4B0082", "#0000FF",
"#00FF00", "#FFFF00", "#FF7F00", "#FF0000"}),
Prolog -> {Directive[FaceForm[GrayLevel[1/10]],
EdgeForm[Directive[Gray, Thick]]], RegularPolygon}] 