A new look at the mathematics of conical anamorphism opens up the possibility of creating anamorphic images using mirrors with shapes other than a circular cone. By utilizing a pyramidal mirror, for example, one can explore new and unique anamorphic effects.

This is a section TBC through the axis TO of a generalized cone. The two generating lines TB and TC serve as mirror surfaces. When an observer stands at point E, he will observe the anamorphic point A as its reflection R in the base BC. A geometric formula can be derived to describe the transformation from point R to its anamorphic image A, or vice versa. This transformation is in fact a twofold rescaling of the polar radius r of the point R. The angle alpha is the opening half-angle of the cone section.

Rescale[Rescale[r, {1, 0}, {0, 1}], {0, 1}, {1, 1 + Sec[2 alpha]}]

Based on this observation, we can write a function to transform the polar radius of a reflected point R into the polar radius of its conical anamorphic image A:

toConicalAnamorphRadius[ri_, alpha_] := 
 Rescale[ri, {1, 0}, {1, 1 + Sec[2 alpha]}]
Rasterize[FullSimplify[toConicalAnamorphRadius[ri, alpha]]]

In Mathematica, it is possible to group this twofold rescaling as a single rescaling:

Rescale[Rescale[r, {1, 0}, {0, 1}], {0, 1}, {1, 1 + Sec[2*alpha]}] == 
   Rescale[r, {1, 0}, {1, 1 + Sec[2*alpha]}] // Simplify // Rasterize

Since we intend to deal with images that cannot be easily represented using polar coordinates, we need to convert the function toConicalAnamorphRadius to Cartesian coordinates:

toConicalAnamorphXY[{xi_, yi_}, alpha_] := 
 Module[{ri, \[Theta]i, ra, \[Theta]a}, {ri, \[Theta]i} = 
   ToPolarCoordinates[{xi, yi}]; 
  FromPolarCoordinates[{toConicalAnamorphRadius[ri, 
     alpha], \[Theta]i}]]
Simplify[toConicalAnamorphXY[{xi, yi}, alpha]] // Rasterize

This is a compiled version:

toConicalAnamorphXYcf = 
 Compile[{{pos, _Real, 1}}, 
  Module[{xi, yi, alpha = 35.2344 °}, {xi, yi} = 
    pos; (1 - (-1 + Sqrt[xi^2 + yi^2]) Sec[2 alpha])/
     Sqrt[xi^2 + yi^2] {xi, yi}]]

This is the function squareRadius to compute the polar radius of a square . The function toConicalAnamorphSQRcf is adapted from toConicalAnamorphXYcf by replacing the polar radius of a circle (1) by the polar radius of a square (using squareRadius):

squareRadius[t_, r_] := r Sec[1/2 ArcTan[Tan[2 t]]]/Sqrt[2]
toConicalAnamorphSQRcf = 
  Compile[{{pos, _Real, 1}}, 
   Module[{xi, yi, alpha = 35.2344 °}, {xi, yi} = pos; 
    squareRadius[
      ArcTan[xi, yi], (1 - (-1 + Sqrt[xi^2 + yi^2]) Sec[2 alpha]) /
      Sqrt[xi^2 + yi^2]] {xi, yi}]];

To test our new function, we will use a geometric figure consisting of 12 lines connecting a set of points. We will apply the function toConicalAnamorphSQRcf to the coordinates of these points to convert the figure to its surrounding anamorphic image:

sun = ImageResize[Binarize@ ImageCrop[%], 950];
lines = Map[#/500 - .95 &, 
   Normal[ImageGraphics[sun, 2, Method -> "Exact"]][[1, -1]] /. 
    FilledCurve -> Identity, {6}];
GraphicsRow[
 Graphics[{AbsoluteThickness[3], 
     Map[#, lines[[-1]], {4}], {AbsoluteThickness[1], lines, Dashed, 
      Circle[]}}] & /@ {toConicalAnamorphXYcf, 
   toConicalAnamorphSQRcf}]

The left image is the reflection in a conical mirror, the right one in a pyramidal mirror. The dotted outlines above are a top views of the circular- and pyramidal mirrors. The surrounding thick image will be reflected in it as the thin image in the center.

More interesting images and videos can be created starting from a collection of rotating polygons. Since the reflected straight lines will be converted to curves by the anamorphic transformation, simply using the vertices of the polygons is insufficient. Instead, we need a set of interpolated points along the edges of the polygon. The function polygonPoints gets m coordinates of points along a regular n-gon with circumradius r centered at {x0,y0} and rotated over theta0 around its center. This code creates a video showing 4 reflections of an anamorphic image as a rotating set of triangles inside a pyramidal mirror. The different images are generated using different eccentricities for the rotation of the set of triangles.

polygonPoints[center : {x0_, y0_}, t0_, r_, n_, m_ : 500] := 
 Table[center + 
   r Cos[Pi/n] Sec[(2 ArcTan[Cot[(1/2) n (t - t0)]])/n] {Cos[t], 
     Sin[t]}, {t, 0, 2 Pi, Pi/m}]
colors = {RGBColor[0.965, 0.3285, 0.0785], 
   RGBColor[0.266, 0.516, 0.9576], RGBColor[0.207, 0.652, 0.324], 
   RGBColor[0.988, 0.73, 0.0195]};
GraphicsRow[
 Map[Module[{imPts, anaPts}, 
    imPts = Table[
      polygonPoints[#[[1]], #[[3]] + d, #[[2]], 3, 2000], {d, Pi/2, 
       2 Pi, Pi/2}];
    anaPts = Map[toConicalAnamorphSQRcf[#] &, imPts, {2}];
    Graphics[{{Gray, RegularPolygon[{0, 0}, {4., \[Pi]/4}, 4]}, 
      MapThread[{EdgeForm[Black], FaceForm[#2], 
         Polygon[#1]} &, {anaPts, colors}],
      {Opacity[.1], EdgeForm[Black], 
       RegularPolygon[{Sqrt[2.], Pi/4}, 4]},
      MapThread[{EdgeForm[Black], FaceForm[#2], 
         Polygon[#1]} &, {imPts, colors}]}, 
     ImageSize -> 250]] &, {{{-0.26`, 
     0.2`}, .608, .26}, {{0.001`, -0.425`}, .608, .26}, {{-0.05`, \
-0.31`}, .622, 1.5}, {{0.36`, -0.12`}, .652, .21}}]]

This GraphicsRow shows the effect of the number of vertices of the polygon. This gives an idea of the endless variations that can be created:

With[{offset = .335, t0 = .0001, m = 15000, r = .3335, 
   phi = 0.00},(*Parallel*)
  ParallelTable[Module[{imPts, anaPts, center}, center = {0, 0};
    imPts = 
     Map[polygonPoints[AngleVector[center, {offset, phi + #}], t0, r, 
        n, m] &, Range[Pi/2, 2 Pi, Pi/2]];
    anaPts = Map[toConicalAnamorphSQRcf, imPts, {2}];
    Graphics[{{Opacity[.25], EdgeForm[Black], 
       RegularPolygon[{4, Pi/4}, 4]}, 
      MapThread[{EdgeForm[Black], FaceForm[#2], 
         Polygon[#1]} &, {anaPts, colors}], {Opacity[.25], 
       EdgeForm[Black], RegularPolygon[{Sqrt[2.], Pi/4}, 4]}, 
      MapThread[{EdgeForm[Black], FaceForm[#2], 
         Polygon[#1]} &, {imPts, colors}]}]], {n, {3, 4, 100}}]];
GraphicsRow[
 MapThread[
  Graphics[#1[[1]], 
    PlotLabel -> Style["n= " <> ToString[#2], Bold, 14]] &, {%, {3, 4,
     100}}]]

Creating a real-world version of the reflection in a generalized conical mirror would require the use of 3D printing technology. However, it is possible to compute both the reflected and anamorphic images that would be generated and produce some unique visual effects.

With[{n = 100, offset = .335, t0 = .2, m = 5000, r = .3335, 
  phi = 0.00},
 AnimationVideo[Module[{imPts, anaPts},
   imPts = 
    Map[polygonPoints[AngleVector[center, {offset, phi + #}], t0, r, 
       n, m] &, Range[Pi/2, 2 Pi, Pi/2]];
   anaPts = Map[toConicalAnamorphSQRcf, imPts, {2}];
   Graphics[{{Opacity[.25], EdgeForm[Black], 
      RegularPolygon[{4, Pi/4}, 4]}, 
     MapThread[{EdgeForm[Black], FaceForm[#2], 
        Polygon[#1]} &, {anaPts, colors}], {Opacity[.25], 
      EdgeForm[Black], RegularPolygon[{Sqrt[2.], Pi/4}, 4]}, 
     MapThread[{EdgeForm[Black], FaceForm[#2], Polygon[#1]} &, {imPts,
        colors}]}]], {center, 
   CirclePoints[{0, 0}, {.35, 2.001}, 40]}]]