Message Boards Message Boards


Anamorphosis and reflection between a Conical Mirror and a Cylinder

Posted 10 days ago
1 Reply
5 Total Likes


Catoptric or mirror anamorphoses are deformed images that can only be seen undeformed with the help of a mirror. Here, we experiment with a conical mirror surrounded by a vertical cylindrical surface. We want to compute points of a deformed (anamorphic) image on the cylinder's inner surface such that it is perceived by the viewer as an undeformed image when looking down in the cone shaped mirror.

enter image description here

The above drawing shows the anamorphic setup: a conical mirror (radius r=1, height=h), surrounded by a cylindrical surface (radius R>r). The viewpoint V is along the vertical axis of the cylinder (at infinity relative to the size of the cone). A point S (xa,ya,za) on the cylinder's inner surface is reflected by the mirror at Q to the viewer's eye at V. The viewer perceives the point at I (xi,yi,0). The lines VQ and SQ form equal angles with the normal to the sphere at Q.

enter image description here

The above animation demonstrates the relation between the point I traveling along a straight line while its anamorphic map follows a curve on the inner surface of the cylinder. We now write a function that expresses this geometric relationship:

cone2Cylinder[imagePoint : {xi_, yi_}, coneHeight : h_, 
  cylinderRadius : R_] :=
 {(R xi)/Sqrt[xi^2 + yi^2], (R yi)/Sqrt[
  xi^2 + yi^2], 
  h - h Sqrt[
    xi^2 + yi^2] + (-R + Sqrt[xi^2 + yi^2]) Cot[2 ArcTan[1/h]]}

This function maps an image point to an anamorphic point. To test our function, we use again one of the logos generated by the Wolfram Demonstration "Character Rotation Patterns" by Chris Carlson.
Which, after converting to a GraphicsComplex looks like this:

ig = ImageGraphics[sun, 2, Method -> "Exact"];
lines = Normal[ig][[1, -1]] /. FilledCurve -> Identity;
scaledLines = Map[#/948 - .5 &, lines, {6}]
Graphics[{Thick, scaledLines}]

enter image description here

We now compute the point coordinates of the lines in the GraphicsComplex to their anamorphic map {xa,ya,za} using the function cone2Cylinder.

anaLines = Map[anaCone2Cylinder[#, 1.57, 1.15] &, scaledLines, {5}];
Graphics3D[{{Opacity[.2], White, 
   Cylinder[{{0, 0, .3}, {0, 0, 1.2}}, 1.25]}, 
  AbsoluteThickness[3], %}, Boxed -> False]

enter image description here

We then convert the anamorphic 3D drawing to the 2 dimensional developed interior face of the cylinder as {ArcTan[xa,ya} , za}. This GIF illustrates the unfolding of the cylindrical image:

enter image description here

developLineCoordinates = 
  Flatten[Map[{ArcTan @@ Most[#], Last[#]} &, anaLines, {5}][[-1]], 
    1][[All, 1]];
lstPP = Partition[#, 2, 1] & /@ developLineCoordinates;
DeleteCases[#, _?(EuclideanDistance @@ # > 1 &)] & /@ lstPP;
Graphics[{AbsoluteThickness[2], Line /@ %}, FrameTicks -> None, 
 Frame -> True, ImageSize -> 600]
develop = Image[%];

enter image description here

After printing the cylinder development to the right size (52 cm by 14 cm), it is glued around a cardboard cylinder (radius 8 cm). A home made conical mirror (base radius 7 cm, height 12 cm) is put inside the cylinder at the center. The anamorphic image on the cylinder wall is reflected as the undeformed original by the conical mirror. Here is the result: (the center is hidden by a coin resting at the top of the cone since anamorphic maps of points close to the cone center are off at infinite height on the cylinder wall)

enter image description here

Another application of the function is to use one of the many popular curves (".....-like curve" ) that can be extracted using Interpreter

Interpreter["PopularCurve"]["bunny-like curve"];
bugsbunnyPrimitives = 
       Entity["PopularCurve", "BunnyCurve"]["ParametricEquations"][
        t], {t, 0, 30 \[Pi]}]] /. {x_?NumericQ, 
       y_?NumericQ} :> {x - 85, y - 50}/800, _Line, \[Infinity]];

enter image description here

The anamorphic map is created by applying anaCone2Cylinder to the point coordinates:

anaBunny = 
  Map[anaCone2Cylinder[#, 1.755, 1.25] &, bugsbunnyPrimitives, {2}];
  Rotate[{{Opacity[.2], White, 
     Cylinder[{{0, 0, .25}, {0, 0, 1}}, 1.25]}, AbsoluteThickness[3], 
    Red, anaBunny}, \[Phi], {0, 0, 1}], Boxed -> False], {\[Phi], 0, 
  2 \[Pi]}]

enter image description here

This is the developed cylinder:

developRules = {x_?NumericQ, y_?NumericQ, 
    z_?NumericQ} :> {ArcTan[x, y], z};
developed = anaBunny /. developRules;
  Partition[developed[[1]], 2, 1], _?(EuclideanDistance @@ # > 1 &)];
Graphics[{Red, AbsoluteThickness[3], Line /@ %}, FrameTicks -> None, 
 Frame -> True]

enter image description here

And the result, printed, glued inside a cylinder and using the same setup as in the previous example:

enter image description here

enter image description here - Congratulations! This post is now a Staff Pick as distinguished by a badge on your profile! Thank you, keep it coming, and consider contributing your work to the The Notebook Archive!

Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
or Discard

Group Abstract Group Abstract