wolfram mathematica - How to make ImageTransformation produce an anamorphic version of image

Question

I'm experimenting with the ImageTransformation function to try to make anamorphic versions of images, but with limited progress so far. I'm aiming for the results you get using the image reflected in a cylindrical mirror, where the image curves around the central mirror for about 270 degrees. The wikipedia article has a couple of neat examples (and I borrowed Holbein's skull from them too).

i = Import["../Desktop/Holbein_Skull.jpg"];

i = ImageResize[i, 120]
f[x_, y_] := {(2 (y - 0.3) Cos [1.5 x]), (2 (y - 0.3) Sin [1.5 x])};
ImageTransformation[i, f[#[[1]], #[[2]]] &, Padding -> White] 

But I can't persuade Mathematica to show me the entire image, or to bend it correctly. The anamorphic image should wrap right round the mirror placed "inside" the centre of the image, but it won't. I found suitable values for constants by putting it inside a manipulate (and turning the resolution down :). I'm using the formula:

x1 = a(y + b) cos(kx)
y1 = a(y + b) sin(kx)

Any help producing a better result would be greatly appreciated!

Answer 1

In ImageTransformation[f,img], the function f is such that a point {x,y} in the resulting image corresponds to f[{x,y}] in img. Since the resulting image is basically the polar transformation of img, f should be the inverse polar transformation, so you could do something like

anamorphic[img_, angle_: 270 Degree] :=
  Module[{dim = ImageDimensions[img], rInner = 1, rOuter},
    rOuter = rInner (1 + angle dim[[2]]/dim[[1]]);
    ImageTransformation[img,
      Function[{pt}, {ArcTan[-#2, #1] & @@ pt, Norm[pt]}],
      DataRange -> {{-angle/2, angle/2}, {rInner, rOuter}},
      PlotRange -> {{-rOuter, rOuter}, {-rOuter, rOuter}},
      Padding -> White
    ]
  ]

The resulting image looks something like

anamorphic[ExampleData[{"TestImage", "Lena"}]]

Note that you can a similar result with ParametricPlot and TextureCoordinateFunction, e.g.

anamorphic2[img_Image, angle_: 270 Degree] := 
  Module[{rInner = 1,rOuter},
    rOuter = rInner (1 + angle #2/#1 & @@ ImageDimensions[img]);
    ParametricPlot[{r Sin[t], -r Cos[t]}, {t, -angle/2, angle/2}, 
      {r, rInner, rOuter}, 
      TextureCoordinateFunction -> ({#3, #4} &),
      PlotStyle -> {Opacity[1], Texture[img]},
      Mesh -> None, Axes -> False,
      BoundaryStyle -> None,
      Frame -> False
    ]
  ]
anamorphic2[ExampleData[{"TestImage", "Lena"}]]

Edit

In answer to Mr.Wizard's question, if you don't have access to ImageTransformation or Texture you could transform the image data by hand by doing something like

anamorph3[img_, angle_: 270 Degree, imgWidth_: 512] :=
 Module[{data, f, matrix, dim, rOuter, rInner = 1.},
  dim = ImageDimensions[img];
  rOuter = rInner (1 + angle #2/#1 & @@ dim);
  data = Table[
      ListInterpolation[#[[All, All, i]], 
        {{rOuter, rInner}, {-angle/2, angle/2}}], {i, 3}] &@ImageData[img];
  f[i_, j_] := If[Abs[j] <= angle/2 && rInner <= i <= rOuter, 
    Through[data[i, j]], {1., 1., 1.}];
  Image@Table[f[Sqrt[i^2 + j^2], ArcTan[i, -j]], 
   {i, -rOuter, rOuter, 2 rOuter/(imgWidth - 1)},
   {j, -rOuter, rOuter, 2 rOuter/(imgWidth - 1)}]]

Note that this assumes that img has three channels. If the image has fewer or more channels, you need to adapt the code.