How to obtain an animated prism using Mathematica?

Question

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:

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

Answer 1

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[1]@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]

Answer 2

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

Answer 3

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[3]/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]), 3/20},
                                          {-6 Sqrt[3]/25, 7/25},
                                          {-3/2, (12 Sqrt[3] - 5)/250},
                                          {-3/2, (17 Sqrt[3] - 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[3]}]