Rotating an image along a Möbius strip?

Question

I am trying to make a GIF which will be a rotating Möbius strip, with some text printed along its (one!) side. I am trying to (obviously) do this in Mathematica.

After some diligent searching and a previous question I asked, I realize it is almost impossible to get text to behave well when it comes to opacity, rotations, etc. So instead I decided to make a rectangular image of the text, and then import it into Mathematica. But I'm getting stuck on putting all the pieces together.

Do I want to use this image as a texture on the Möbius strip (which I'm getting from a ParametricPlot3D)? Or is there some other way to "wrap" this image exactly once around the Möbius strip?

Also, would it be better to use an Animate to rotate the image - keeping the Möbius strip fixed - or is it better to simply rotate the whole thing? (I mean "better" as in "easier to do / better-looking").

I would actually prefer to eventually figure all this out on my own, but maybe some hints as to how I might proceed would be awesome.

EDIT: After Heike's helpful comment, I've come up with the following:

text = Style["Hello!", 200];
ParametricPlot3D[{4 Cos[a] + r Cos[a] Cos[a/2], 
4 Sin[a] + r Sin[a] Cos[a/2], r Sin[a/2]}, {a, 0, 2 Pi},
{r, -(3/2), 3/2}, Boxed -> False, Axes -> False, 
Mesh -> False, PlotStyle -> {Directive[Texture[text]], Opacity[.5]}, 
TextureCoordinateFunction -> ({#4, #5} &)]

This of course doesn't rotate. But perhaps something can be done with ViewVector or this esoteric TextureCoordinateFunction? I don't know, because my Mathematica is having a very hard time drawing this correctly.

Answer 1

Here's my contribution. I know you asked for hints only, but I couldn't resist

text = Style["This is some text on a Möbius strip", 
   FontFamily -> "Helvetica", FontSize -> 35];
img = ImageData@Image[Rasterize[text, Background -> None, ImageSize -> 1000]];

Manipulate[
 ParametricPlot3D[{4 Cos[a] + r Cos[a] Cos[a/2], 
   4 Sin[a] + r Sin[a] Cos[a/2], r Sin[a/2]}, {a, 0, 
   4 \[Pi]}, {r, -(3/2), 3/2}, Boxed -> False, Axes -> False, 
  Mesh -> False,
  PlotPoints -> {100, 2},
  PlotStyle -> {EdgeForm[], FaceForm[Directive[Texture[img]], None]}, 
  TextureCoordinateFunction -> ({#4 - t, #5} &),
  PerformanceGoal -> "Quality"
  ], {t, 0, 1}]

The trick to getting a transparent background is to use ImageData[Image[Rasterize[pic, Background -> None]]] for the texture.

Note that I'm using FaceForm[Texture[...], None] to plot the text on one side only. By letting a run from 0 to 4 Pi you traverse around the strip twice, once along the front and once along the back (insofar that you can speak of front and back in the case of a Möbius strip).

Answer 2

Here's a starting point:

tex = Rasterize[
  Style["Going round and round and round the Möbius strip!   ", Bold, 
   Large, FontFamily -> "Times"]]

{w, h} = ImageDimensions[tex]

tex1 = ImageTake[tex, All, Quotient[w, 2]]

tex2 = ImageTake[tex, All, Quotient[w, 2] - w]

frames = Table[
   Rasterize@
    ParametricPlot3D[{Cos[u], Sin[u], 0} + 
      r {Cos[u] Cos[u/2], Sin[u] Cos[u/2], Sin[u/2]}, {u, 0 + a, 
      2 Pi + a}, {r, -.2, .2}, 
     PlotStyle -> 
      FaceForm[Texture[tex1], Texture[ImageReflect[tex2, Top -> Bottom]]], 
     Mesh -> False, Boxed -> False, Axes -> False],
   {a, 4Pi, Pi/30, -Pi/30}
   ];

ListAnimate[frames]

Unfortunately rendering the double sided textures is extremely slow on my machine.

Answer 3

Here is a completely different approach. I explain it in detail, but give only a hack as reference implementation. With the function ImportString and ExportString it is easily possible to convert a text into its outline. Examples for this can be found in the documentation to FilledCurve. Now the bad thing is, that FilledCurve only works in 2d; the good thing is we get lists of points representing the way to draw the letters of the text.

The only thing you have to do is to transform these points in a way that they lie on your Moebius-strip. This of course is easy when you rescale the coordinates of the points so that the x-values range from 0 to 2Pi. The y-values need to be rescaled so that they are in a range $[-r,r]$ where r can be chosen like you want.

What you then have to do is to transform all FilledCurve objects into some 3D graphics primitive and convert all points of the filled curve by the mapping

$$\{x,y\}\to \{\cos (x),\sin (x),0\}+y \left\{\cos (x) \cos \left(\frac{x}{2}\right),\sin (x) \cos \left(\frac{x}{2}\right),\sin \left(\frac{x}{2}\right)\right\}$$

All this can be done by a few lines to extract the min/max values of all points for the rescaling and basically one long line where you just ReplaceAll occurrences of FilledCurve and pack it into a Graphics3D.

With[{text = First[First[ImportString[ExportString[       
       Style["Ah, gravity, thou art a heartless bitch -", Italic, 
        FontSize -> 24, FontFamily -> "Helvetica"], "PDF"], "PDF", 
      "TextMode" -> "Outlines"]]]},

   Block[{allx, ally, meany, minmax}, 
     {allx, ally} = Transpose[Cases[text, {_Real, _Real}, Infinity]]; 
     minmax = {Min[allx], Max[allx]}; 
     meany = ((Max[#1] - Min[#1])/2. & )[Rescale[ally, minmax, {0, 2*Pi}]]; 
     Graphics3D[text /. FilledCurve[_, pts_] :> 
       With[{scaledPts = Rescale[pts, minmax, {0, 2*Pi}]}, 
        {ColorData["FruitPunchColors", scaledPts[[1, 1, 1]]/(2.*Pi)], 
         Tube[scaledPts /. {x_Real, y_Real} :> {Cos[x], Sin[x], 0} +  
           2*(y - meany)*{Cos[x]*Cos[x/2], Sin[x]*Cos[x/2], 
             Sin[x/2]}]}
      ], Boxed -> False, Background -> LightGray]
   ]
]

Update and it is of course possible to create an animation from that. For this you create a Table of graphics where you change the rotation angle $\varphi$ in every frame. On the right hand side of the mapping you replace every appearance of $x$ with $x+\varphi$

Answer 4

This is really an illustrated comment, because it only builds on Heike's elegant approach to show what a true Möbius strip looks like:

Look at the left side: when the text finally wraps around to the beginning, it must have its orientation reversed. That's what makes the Möbius strip non-orientable (and so interesting).

To achieve this effect, I needed a trick, because Mathematica "knows" that every surface has two sides, which is not the case here. I therefore printed the text string on the surface and then printed its reversal along the "back" of the surface. Ideally the match between the original string and its reversal is one-for-one: if a pixel has a given color seen from one direction, then when seen from the back it must have exactly the same color.

To play with this, use Heike's solution but replace initialization of img by this:

img = ImageData@(i = Image[Rasterize[text, ImageSize -> 500]]);
img = MapThread[Join[#1, #2] &, {img, Reverse[img]}, 1];

(The image is resized to 500 to make the text fit on a single line.)

EDIT If you would like a semi-transparent view, which can be illuminating, add Opacity[0.5] to the PlotStyle directive.

Answer 5

I recently rediscovered the CurvesGraphics6 package, which provides an easy way to write text on a surface.

After loading the CurvesGraphics6 package, you can evaluate the following to create the Möbius strip:

PlotCurveOnSurface3D[
  {{Cos[u], Sin[u], 0} + r {Cos[u] Cos[u/2], Sin[u] Cos[u/2], Sin[u/2]}, 
   {u, 0, 2 Pi}, {r, -.2, .2}}, 
  {Text["one two three four five six seven eight. "]}]

The text is double-sided by default, so you'll see what you would get with a transparent Möbius strip.