How to properly project a Graphics object consisting of line primitives

Question

My problem starts from attempts at depicting overlapping lines of different thickness, i.e.

ClearAll[line1, line2, overlapping1, overlapping2, ov1Flat, ov2Flat]
line1 = Graphics[{Thickness[0.003], Blue, Line[{{0, 0}, {4, 1}}]}];
line2 = Graphics[{Thickness[0.03], Red, Line[{{0, 0}, {4, 1}}]}];
overlapping1 = Show[{line2, line1}];

I am often annotating parts of a plot with lines of varying thickness and my preferred method of projecting 2D plots onto 3D is by, well, projecting:

ov1Flat = Show[{ContourPlot[Sin[y x], {x, -4, 4}, {y, -4, 4}], overlapping1}];
Graphics3D@(N@First@ov1Flat /. {x_?AtomQ, y_?AtomQ} -> {x, y, 2.})

This works really well for projecting Graphics objects comprised of polygons onto a plane but I am not happy with the behaviour of Line as a 3D object: lines of various thicknesses get turned into ugly cylinders and their overlap doesn't show too well. I know I can use Texture to do the same thing but I would like to avoid it. I'd need to adjust the position of a rasterized image which I'd need to rasterize to an acceptable quality etc - in short, I find it dirtier.

So I am looking for a failsafe rule that maps lines onto polygons that I can apply to a Graphics object before projecting it and turning it into a truly flat Graphics3D object.

In trying making a rule for lines consisting of two points, I got the following:

overlapping2 = 
  overlapping1 /. {pre1___, Thickness[a_], mid___, Line[c_], 
     post___} :> {pre1, mid, 
     Polygon[
      Transpose@(Transpose@c + 
          4 a (RotationMatrix[π/2].Normalize[
              Flatten@Differences@c]))~Join~
       Transpose@(Transpose@Reverse@c - 
          4 a (RotationMatrix[π/2].Normalize[
              Flatten@Differences@c]))]
     , post};
Show[overlapping2]

which probably has a million ways to break, is inefficient etc, but at least works for the toy example of a line consisting of a start and end point.

This replicates the line quite well and once projected is still "flat" with the overlaps showing much better:

Show[Graphics3D@(N@
     First@Graphics@overlapping2 /. {x_?AtomQ, y_?AtomQ} -> {x, y, 
      2.}), Lighting -> "Neutral"]

but it doesn't like getting combined with other objects:

ov2Flat=Show[{ContourPlot[Sin[y x], {x, -4, 4}, {y, -4, 4}], overlapping2}];
Graphics3D@(N@First@ov2Flat /. {x_?AtomQ, y_?AtomQ} -> {x, y, 2.})

.

So my question in its most general form would be:

Is there a transformation rule that one can apply to a Graphics object so that the said object can be projected to a truly flat Graphics3D object (and look good)?

I know that for Text this would probably be impossible so something that has the right behaviour for Line and Point primitives would be great. And a "no" answer that would mean I have to use Texture is also OK but as I said, I want this to be a last resort.

----EDIT----

The reason I want to do the projection is so that I combine two and three dimensional plots. I am stuck with the toy example I made up (which isn't very well suited for this) but it should give an idea:

Show[{Plot3D[8 + Sin[y x], {x, -4, 4}, {y, -4, 4}, 
   MeshFunctions -> {(0.25 #1 - #2) &}, Mesh -> {{0}}, 
   MeshStyle -> {Blue, Thick}, PlotPoints -> 80],
  Graphics3D@(N@
      First@ov2Flat /. {x_?AtomQ, y_?AtomQ} -> {x, y, 2.})}, 
 PlotRange -> All, BoxRatios -> {Automatic, Automatic, 6}]

----EDIT 2----

Ok, so the only way out seems to be offsetting each polygonised Line a little with respect to the overlapping line and all these lines with respect to the projected plane. I think @belisarius's rule based on the line colour is the simplest one to do that (especially if there's a lot of lines to go through) so I'm going with that.

Answer 1

Just a quick fix:

s = Graphics3D@(N@First@ContourPlot[Sin[y x], {x, -4, 4}, {y, -4, 4}] /. 
                                          {x_? AtomQ, y_?AtomQ} -> {x, y, 3});
new = Graphics3D[(N@First@overlapping2 /. {x_?AtomQ, y_?AtomQ} -> {x, y, 3.1}), 
                                       PlotRange -> {{-4, 4}, {-4, 4}, {2, 4}}];

Show[{new, s, new}]

Edit

If you chose your line colors (or any other line directive) to be unique, you may do the same without projecting separately:

Graphics3D@(N@
     First@ov2Flat /. {x_?AtomQ, y_?AtomQ} -> {x, y, 2.}) /. 
     {RGBColor[1., 0., 0.], Polygon[l_ ]} :> 
                      {RGBColor[1., 0., 0.], Polygon[Plus[#, {0, 0, .1}] & /@ l]}

Answer 2

Projection approach

One way to get the lines to show up nicely is to wrap them in Tube and then project these tubes down onto the plane. To do projections in a more general setting, I had written a function project as an answer to "How to make a drop-shadow for Graphics3D objects", which however needed some fixes for this answer.

So although the function project is overkill for this problem, I'll list it here and show how it can be applied:

Options[project] = {"ObjectCenter" -> {0, 0, 0}, "DarkShadow" -> True};

project[x_, direction_, normal_, OptionsPattern[]] := Module[
  {d, n, darkShadow, center},
  darkShadow = OptionValue["DarkShadow"];
  center = OptionValue["ObjectCenter"];
  d = Normalize[direction];
  n = Normalize[normal];
  x /. Graphics3D[gr_, opts___] :> Graphics3D[
     {
      If[darkShadow, Black],
      GeometricTransformation[
       If[darkShadow,
        gr /. {
          Glow[_] -> Glow[],

          r_?(MemberQ[{RGBColor, Hue, CMYKColor, GrayLevel}, 
               Head[#]] &) -> Black
          },
        gr
        ],
       Composition[
        TranslationTransform[direction + center],
        Quiet[Check[RotationTransform[{d, n}], Identity],
         {RotationMatrix::degen, RotationTransform::spln}
         ],
        ScalingTransform[10^-3, d],
        Quiet@Check[
          ScalingTransform[1./(n.d), n - (n.d) d],
          Identity
          ],
        TranslationTransform[-center]
        ]
       ]
      },
     opts
     ]
  ]

Here are your definitions of the lines, and my way of translating them to 3D:

line1 = Graphics[{Thickness[0.003], Blue, Line[{{0, 0}, {4, 1}}]}];
line2 = Graphics[{Thickness[0.03], Red, Line[{{0, 0}, {4, 1}}]}];

line1new = 
  Graphics3D[N[First@line1] /. {x_?AtomQ, y_?AtomQ} -> {x, y, 2.}] /. 
   Line[x__] -> {CapForm["Butt"], Tube[Line[x], .02]};

line2new = 
  Graphics3D[N[First@line2] /. {x_?AtomQ, y_?AtomQ} -> {x, y, 1.}] /. 
   Line[x__] -> {CapForm["Butt"], Tube[Line[x], .1]};

overlapping1 = Show[{line2new, line1new}]

So the lines first of all are offset vertically. This is done so that the next step, the projection, will layer the thin blue line on top of the red one (which is closer to the bottom plane).

Now I create the planar plot as you did - but separately. Then I combine it with the projection result:

cpl3d = Graphics3D[N@First@cpl /. {x_?AtomQ, y_?AtomQ} -> {x, y, 0}];

Show[
 project[
  overlapping1, {0, 0, -1}, {0, 0, 1},
  "DarkShadow" -> False, "ObjectCenter" -> {0, 0, 1}],
 cpl3d
 ]

The result seems to have no visual problems.

To explain how project works: the first argument is the Graphics3D (in this case overlapping1 corresponding to the two tubular lines). The second argument is the direction in which I want the shadow of this object to be projected. The third argument normal is the surface normal of the surface onto which we imagine projecting the object. The amount by which the object is translated is given by the length of the vector direction.

The projection involves a "flattening step" in which the center of mass of the object is moved into a plane including the origin, and in that step we lose the information where the object was originally. The translation by direction is applied starting from the origin.

That's fine if the center of the object was originally near the origin anyway, but in our overlapping1 object the center is somewhere higher up. I actually want the lowest of the lines to end up on the plane at z = 0, but the red line as at z = 1. To make this come out right, I have to provide the information that the original position of the object should be taken as z = 1, so that after the "flattening step" this original position is first restored before applying the translation in the projection direction {0, 0, -1}.

The original position is provided as an option "ObjectCenter". Another option is "DarkShadow" which by default is True, making shadows appear black or gray. In our case we want colored shadows, so I set this option to False.

I'll also have to update this code in the earlier answer linked above, because there I didn't catch an error that appears when projecting straight along the surface normal (since for such cases the function project is actually overkill, as I mentioned)... However, with this function you can then also project lines (or rather Tubes) onto arbitrary oblique surfaces, if desired.

Edit 2: Texture approach

The ultimate goal seems to involve further 3D manipulations, which may lead to unacceptably large files and sluggish response due to high polygon count (not just with my method above - it depends mainly on the number of polygons in the ContourPlot, which is usually rather large).

So I would suggest instead to go with the alternative approach that was already alluded to in the question: make the 2D graphics into a textured polygon. As it happens, I also had previously written a function for that.

It's called label3D and takes a any arbitrary input as its first argument, converts it into an Image and then puts it as a texture onto a rectangular Polygon whose dimensions are given by the arguments pos, xVec, tiltAngle in the code below. Here, pos is the location of the bottom left corner of the flattened polygon in 3D space. xVec is a vector pointing in the direction along which the baseline of the image should be oriented. The length of this vector is taken as the width of the polygon in 3D space. tiltAngle is the angle (in radians) by which the label is rotated around its baseline.

label3D[s_, pos_, xVec_, tiltAngle_, opts : OptionsPattern[]] := 
  Module[{ra, width, height, r}, 
   ra = Rasterize[
     Style[HoldForm[s], FilterRules[{opts}, Options[Style]], 
      Magnification -> 10], 
     Evaluate@
      Apply[Sequence, FilterRules[{opts}, Options[Rasterize]]], 
     "Image"];
   {width, height} = ImageDimensions[ra];
   r = SetAlphaChannel[ra, 
     With[{color = 
        Apply[List, 
         ColorConvert[
          "TransparentColor" /. {opts} /. {"TransparentColor" -> 
             Apply[RGBColor, ImageData[ra][[2, 2]]]}, "RGB"]]}, 
      Binarize[ra, (Norm[# - color] > .005) &]]];
   Translate[(* //to make lefthand corner pos*)
    Rotate[(*   //around z axis*)
     Rotate[(* //around y axis*)
      Rotate[(* //tilt around x axis*)
       Scale[(*//to make width equal|
        xVec|*){EdgeForm[FrameStyle /. {opts} /. FrameStyle -> None], 
         Texture[ImageData@r],(* //
         Texture fills polygon initially in the xz plane*)
         Polygon[{{0, 0, 0}, {width, 0, 0}, {width, 0, height}, {0, 0,
             height}}, 
          VertexTextureCoordinates -> {{0, 0}, {1, 0}, {1, 1}, {0, 
             1}}]}, Norm[xVec]/width, {0, 0, 0}], 
       tiltAngle, {1, 0, 0}],(* //x rotation*)
      Arg[Chop@N[Norm[xVec[[1 ;; 2]] + I xVec[[3]]]]], {0, -1, 
       0}],(* //y rotation*)
     Arg[Chop@N[xVec[[1]] + I xVec[[2]]]], {0, 0, 1}],(* //z rotation*)
    pos]];

The function recognizes the additional options Magnification (and also ImageSize) to determine the resolution of the rasterized image.

But in this application I chose to instead specify a fixed ImageSize for the original 2D plot, to make sure the line thicknesses are correct relative to the image size.

Here is the application to your problem. The 2D plot is made without tick marks and with no PlotRangePadding so that it fits snugly into the polygon of dimension $8\times 8$ in the 3D plot.

Although the rasterization step may take a second or two, the result is a smaller 3D graphics object that can be rotated more smoothly:

ClearAll[line1, line2, overlapping1, ov1Flat]
line1 = Graphics[{Thickness[0.003], Blue, Line[{{0, 0}, {4, 1}}]}];
line2 = Graphics[{Thickness[0.03], Red, Line[{{0, 0}, {4, 1}}]}];
overlapping1 = Show[{line2, line1}];

ov1Flat = 
  Show[{ContourPlot[Sin[y x], {x, -4, 4}, {y, -4, 4}], overlapping1}, 
   ImageSize -> 360, PlotRangePadding -> 0, FrameTicks -> None];

g = Graphics3D[
   label3D[ov1Flat, {-4, -4, 0}, {8, 0, 0}, -Pi/2]];

Show[
 {
  Plot3D[8 + Sin[y x], {x, -4, 4}, {y, -4, 4}, 
   MeshFunctions -> {(0.25 #1 - #2) &}, Mesh -> {{0}}, 
   MeshStyle -> {Blue, Thick}, PlotPoints -> 80],
  g
  },
 PlotRange -> All, BoxRatios -> {Automatic, Automatic, 6}]

Answer 3

Here is my try at it. I apologize for using the Presentations Application (and John Browne's GrassmannAlgebra package also) but it makes it easy for me. First I used GrassmannAlgebra to obtain an expression for the perpendicular lines to a given line with start and end points. (I suppose it's basic geometry but I need a computer!)

RectangleLine[start_, end_, width_] :=
 Module[{x0, x1, y0, y1, p1, p2, p3, p4, halfperpendicular},
  {x0, y0} = start;
  {x1, y1} = end;
  halfperpendicular = {(width (y0 - y1))/(
    2 Sqrt[(x0 - x1)^2 + (y0 - y1)^2]), (width (-x0 + x1))/(
    2 Sqrt[(x0 - x1)^2 + (y0 - y1)^2])};
  p1 = start - halfperpendicular;
  p2 = start + halfperpendicular;
  p3 = end + halfperpendicular;
  p4 = end - halfperpendicular;
  Polygon[{p1, p2, p3, p4}]
  ]

Here is an example of a thick and thin line.

<< Presentations`

Draw2D[
 {{EdgeForm[Black], FaceForm[Red], 
   RectangleLine[{0, 0}, {4, -4}, 0.2]},
  {EdgeForm[Black], FaceForm[Black], 
   RectangleLine[{0, 0}, {4, -4}, 0.03]}},
 Frame -> True,
 ImageSize -> 250]

The following draws the lines on top of a contour plot. I save the contour primitives and line primitives separately. One of the problems that you may have is contrast between the lines and the contour plot. I used pastel colors for the contour plot so the lines will better stand out.

Draw2D[
 {contourDraw =
   ContourDraw[Sin[y x], {x, -4, 4}, {y, -4, 4}, Contours -> 5, 
    ColorFunction -> ColorData["Pastel"]],
  plotLines = {{EdgeForm[Black], FaceForm[Red], 
     RectangleLine[-{4, 1}, {4, 1}, 0.4]},
    {EdgeForm[Black], FaceForm[Black], 
     RectangleLine[-{4, 1}, {4, 1}, 0.03]}}},
 Frame -> True,
 ImageSize -> 250]

Finally, here is the 3D plot. NeutralLighting generates a set of Lighting options often similar to Lighting -> "Neutral", but with much more control. We can control the amount of light that comes from the directional lights and the amount that comes from ambient light. For the curved surface we want more directional light to give shading to the surface. For the contour plot and lines we want more ambient light. One of the very nice features of Mathematica graphics is that one can intersperse lighting options with graphics primitives and that is what I have done here. Another feature I used here was fewer PlotPoints and increased MaxRecursion. This is generally more efficient. Notice that I did raise the lines above the surface. You just have to do it.

Draw3DItems[
 {NeutralLighting[0, 0.6, 0.2],
  Draw3D[8 + Sin[y x], {x, -4, 4}, {y, -4, 4}, 
   MeshFunctions -> {(0.25 #1 - #2) &}, Mesh -> {{0}}, 
   MeshStyle -> {Blue, Thick}, PlotPoints -> 20, MaxRecursion -> 3, 
   PlotStyle -> Orange],
  NeutralLighting[0, 0.3, 0.6],
  contourDraw // RaiseTo3D[0 &],
  plotLines // RaiseTo3D[0.1 &]},
 NiceRotation,
 Axes -> True,
 AxesLabel -> {"x", "y", "z"},
 ImageSize -> 300]

I don't know enough about your final objective but there are many ways to present information. Often multiple images are clearer than cramming too much into a single image.