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

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.