This notebook contains additional material to the Mathematica GuideBooks  (Springer-Verlag, New York, 2004) http://www.MathematicaGuideBooks.org . It uses the stylesheet of the Mathematica GuideBooks, which is embedded.

Graphics Volume, Chapter 2

Make an animation of two interlocking rotating Möbius bands having a pattern mapped onto them.

moebiusXY[{u_, ω_}, φ0_] = (* rotate segment around z-axis *)
{{Cos[ω], Sin[ω], 0}, {-Sin[ω], Cos[ω], 0}, {0, 0, 1}}.
({1, 0, 0} + (* rotate line segment *)
 {{Cos[ω/2], 0, Sin[ω/2]}, {0, 1, 0}, {-Sin[ω/2], 0, Cos[ω/2]}}.
 (u {Cos[φ0], 0, Sin[φ0]}));
 
moebiusXZ[{u_, ω_}, φ0_, ϑ_, δx_] = (* rotate band around z-axis *)
          {{Cos[ϑ], Sin[ϑ], 0}, {-Sin[ϑ], Cos[ϑ], 0}, {0, 0, 1}}.
          ({δx, 0, 0} + {#1, #3, #2}& @@ moebiusXY[{u, ω}, φ0]);

A continuous pattern on the Möbius band must be antisymmetric with respect to the variable ω around ω=π. Here we define two such functions depending on the parameter τ that are random linear combinations of trigonometric terms.

SeedRandom[1];
{randomPatternXY[τ_][u_, ω_], randomPatternXZ[τ_][u_, ω_]} = 
Table[Sum[Random[Real, {-1, 1}] Cos[k 2Pi τ + 2 Pi Random[]]*
                 Cos[(i + 1/2) ω] Sin[j u/L],
          {i, 0, 3}, {j, 0, 2}, {k, 0, 2}], {2}];

Here is the resulting animation. We rotate the initial segments of the bands and the second band, and change the pattern as we rotate.

frame[φ0_] := 
Block[{L = 1/2}, Show[(* the band in the x,y-plane *)
ParametricPlot3D[#, {u, -L, L}, {ω, 0, 2Pi},
               PlotPoints -> {90, 240}, DisplayFunction -> Identity]& /@
     {(* the band in the x,y-plane *)
      Append[moebiusXY[{u, ω}, φ0], (* the pattern *)
             {EdgeForm[], SurfaceColor[Hue[#], Hue[#], 2.6]& @ 
                          randomPatternXY[φ0/Pi][u, ω]}],
      (* the perpendicular band *)
      Append[moebiusXZ[{u, ω}, φ0, 2φ0, 1], (* the pattern *)
               {EdgeForm[], SurfaceColor[Hue[#], Hue[#], 2.6]& @ 
               randomPatternXZ[φ0/Pi][u, ω]}]},
           PlotRange -> {5/2 {-1, 1}, 5/2 {-1, 1}, 3/2 {-1, 1}}, 
           Axes -> False,  DisplayFunction -> $DisplayFunction, 
           Boxed -> False]]

Show[GraphicsArray[
      Block[{$DisplayFunction = Identity},
            frame /@ {0, Pi/4, Pi/2}], GraphicsSpacing -> 0]]

Do[frame[φ0], {φ0, 0, Pi, Pi/60}]