Services & ResourcesWolfram ForumsMathGroup Archive

[Date Index] [Thread Index] [Author Index]

Bezier curves mapped from 2D to 3D surface

• To: mathgroup at smc.vnet.net
• Subject: [mg124648] Bezier curves mapped from 2D to 3D surface
• From: Chris Young <cy56 at comcast.net>
• Date: Sat, 28 Jan 2012 06:36:10 -0500 (EST)
• Delivered-to: l-mathgroup@mail-archive0.wolfram.com

The following is an attempt to have a set of Bezier curves, on the 
left, mapped to a saddle surface, on the right.

The 2D plot works OK alone, but has become terribly slow in conjunction 
with the 3D plot.

I've been able to do this with one Bezier curve, i.e., mapping up to a 
saddle surface. My hope was that I could map the parametric 2D 
functions the way I did the single curve, but things are obviously not 
working out.

Worse than that, everything is terribly slow, despite my best attempts 
to copy John Fultz's advice, which worked fine in the simple 1-curve 
case.

Chris Young
cy56 at comcast.net


http://home.comcast.net/~cy56/Mma/ButterflyOntoSaddle.nb
http://home.comcast.net/~cy56/Mma/ButterflyOntoSaddlePic.png

Any help appreciated.



\[HorizontalLine]Bez[P_, t_] :=
 Module[
  {n = Length[P] - 1},
  \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(i = 0\), \(n\)]\(P[[
     i + 1]]\ \ BernsteinBasis[n, i, t]\)\)
  ]


vFnc[a_, b_, c_, k_] := Piecewise[
   {{a + (b - a)/0.5 k, k < 0.5},
    {b, k == 0.5},
    {b - (c - b)/(1 - 0.5) 0.5 + (c - b)/(1 - 0.5) k ,
     0.5 < k <= 1}}];


\[HorizontalLine]Saddle = (f \[Function] {f[[1]], f[[2]],
     f[[1]] * f[[2]]});


DynamicModule[
 {
  \[ScriptCapitalP],            (*
  the points for each Bézier curve *)
  \[ScriptCapitalC],            \
 (* the parametric functions for the Bézier curves *)

  PM,           (* the points for the morphing Bézier curves *)

  CM,           (*
  the parametric functions for the morphing Bézier curves *)

  curveStyle,
  wing, butterfly, butterflyPlot
  },

   (* s is the number of curves *)

 curveStyle[a_, b_, c_, s_, th_] :=  Table[
   {Directive[AbsoluteThickness[th], Hue[vFnc[a, b, c, k]]]},
   {k, 0, 1, 1/s}];
 wing[n_, t_, s_] := Table[CM[n][k, t], {k, 0, 1, 1/s}];
 butterfly[t_, s_] := Join[wing[1, t, s], wing[2, t, s]];

 butterflyPlot[a_, b_, c_, s_, th_] :=
  ParametricPlot[
   Evaluate @ butterfly[t, s - 1],     {t, 0, 1},
   PlotStyle -> curveStyle[a, b, c, 2 s - 1, th]
   ];

 Dynamic @ Manipulate[
   \[ScriptCapitalP][1] = Take[P, {1, 5}];
   \[ScriptCapitalP][2] = Take[P, {6, 10}];
   \[ScriptCapitalP][3] = Take[P, {11, 15}];

   \[ScriptCapitalC][1][
     t_] := \[HorizontalLine]Bez[\[ScriptCapitalP][1],
     t]; \[ScriptCapitalC][2][
     t_] := \[HorizontalLine]Bez[\[ScriptCapitalP][2],
     t]; \[ScriptCapitalC][3][
     t_] := \[HorizontalLine]Bez[\[ScriptCapitalP][3], t];

   PM[1][n_] := (1 - n) \[ScriptCapitalP][1] +
     n \[ScriptCapitalP][2];
   PM[2][n_] := (1 - n) \[ScriptCapitalP][2] +
     n \[ScriptCapitalP][3];
   CM[1][n_, t_] := \[HorizontalLine]Bez[PM[1][n], t];
   CM[2][n_, t_] := \[HorizontalLine]Bez[PM[2][n], t];

   Grid[
    {
     {
      LocatorPane[
       Dynamic @ P,

       Dynamic @ Show[
         butterflyPlot[a, b, c, nCurves, thick],
         Graphics @ {Gray, Dashed, Line[\[ScriptCapitalP][1]],
           Line[\[ScriptCapitalP][2]], Line[\[ScriptCapitalP][3]]},
         PlotRange -> 2,
         Axes -> True,
         ImageSize -> 4* 72
         ],
       {{-2, -2}, {2, 2}, {.25, .25}}
       ],

      Dynamic @
       Show[
        ParametricPlot3D[
         \[HorizontalLine]Saddle @ {u, v}, {u, -2, 2}, {v, -2, 2},
         PlotStyle -> Opacity[opac],
         Mesh -> False
         ],
        ParametricPlot3D[
          \[HorizontalLine]Saddle @  butterfly[t, nCurves], {t, 0, 1}
          ] /.
         Line[pts_, rest___] :> Tube[pts, 0.05, rest],
        PlotRange -> 2,
        ImageSize -> 4* 72
        ]
      }
     }
    ],
   {{P,
     {
      {-1, -2}, {-1, -1}, {-1, 0}, {-1, 1}, {-1, 2},
      {  0, -2}, {   0, -1}, {   0, 0}, {  0, 1}, {   0, 2},
      {  1, -2}, {   1, -1}, {  1, 0}, {   1, 1}, {  1, 2}
      }
     }, None},

   {{nCurves, 5}, 1, 20, 1},        (*
   one less than the number of "morphing" curves *)
   {{thick, 12},
    1, 30, 1},
   (* start, end, and middle hues *)
   {{a, 0.1},  0, 1},
   {{b, 0.5}, 0, 1},
   {{c, 0.1}, 0, 1},

   {{opac, 0.75}, 0, 1}
   ]
 ]