Services & ResourcesWolfram ForumsMathGroup Archive

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

Locator-set Bezier curves mapped to 3D surface

• To: mathgroup at smc.vnet.net
• Subject: [mg124673] Locator-set Bezier curves mapped to 3D surface
• From: Chris Young <cy56 at comcast.net>
• Date: Tue, 31 Jan 2012 05:34:25 -0500 (EST)
• Delivered-to: l-mathgroup@mail-archive0.wolfram.com

Went back to John Fultz's example mapping a single Bezier curve set via 
locators and extended it to map multiple curves at once. Works pretty 
fast. I'm still struggling to understand why all these Dynamic wrappers 
are necessary, but at least now I've got something to experiment with.

I wish the ImageSize option wasn't so quirky. I couldn't get it to work 
until I gave it a list of two coordinates; one number for the size gave 
me two differently sized sets of points.

And it still seems to take a lot of work to get PlotStyles to set the 
colors for a list of graphs.

http://home.comcast.net/~cy56/Mma/BezCurvesToSaddlePic.png
http://home.comcast.net/~cy56/Mma/BezCurvesToSaddle.nb

Chris Young
cy56 at comcast.net

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

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

hue[k_, n_] := Hue[Floor[4 (k - 1)/n]/4]

DynamicModule[
 {
  P,                  (*  all the points *)
  \[ScriptCapitalB],       (* indexed variable for sets of Bezier 
control points *)

  nPts,           (* number of total points *)
  cLnths          (* indexed variable for length of each set of control 
points *)
  },
 P = {
   {-2, -2}, {-2, -1}, {-2, 1}, {-2, 2},
   {-1, -2}, {-1, -1}, {-1, 1}, {-1, 2},
   {  1, -2}, {  1, -1}, {  1, 1}, {  1, 2},
   {  2, -2}, {  2, -1}, {  2, 1}, {  2, 2}
   };

 \[ScriptCapitalB][k_] :=
  If[1 <= k <= 4, Take[P, {(k - 1) 3 + k, (k - 1) 3 + k + 3}]];
 nPts = Length[P];
 cLnths[k_] := If[1 <= k <= 4, Length[\[ScriptCapitalB][k]]];

 {
  Dynamic @ LocatorPane[
    Dynamic @ P,

    Dynamic @ Show[
      ParametricPlot @@
       {
        Table[\[HorizontalLine]Bez[\[ScriptCapitalB][k], t], {k,
          4}], {t, 0, 1},
        PlotStyle ->  Table[Directive[Thick, hue[k, n]], {k, 4}]
        },

      Graphics[
       Table[{Dotted, hue[(k - 1) 4 + k, nPts],
         Line[\[ScriptCapitalB][k]]}, {k, 4}]],

      Axes -> True,
      PlotRange -> 2
      ],
    {{-2, -2}, {2, 2}},

    Appearance ->
     Table[
      Graphics[
       {
        hue[k, nPts], Disk[{0, 0}],
        Gray, Circle[{0, 0}],
        Line[{{-1.5, 0}, {1.5, 0}}], Line[{{0, -1.5}, {0, 1.5}}],
        Text[k, {0, 0}, {1, 1}]
        },
       ImageSize -> {18, 18}],
      {k, 1, nPts}]
    ],

  Dynamic @  Show[
    ParametricPlot3D @@@ {
       {\[HorizontalLine]Saddle @ {u, v}, {u, -2, 2}, {v, -2, 2},
        PlotStyle -> Opacity[0.5],
        Mesh -> False},

       {\[HorizontalLine]Saddle /@
         Table[ \[HorizontalLine]Bez[\[ScriptCapitalB][k], t], {k,
           4}], {t, 0, 1},
        PlotStyle -> Table[hue[k, n], {k, 4}]}
       } /.
     Line[P_, opts___] :> Tube[P, 0.05, opts],

    Lighting -> "Neutral",
    PlotRange -> {{-2, 2}, {-2, 2}, {-4, 4}},
    BoxRatios -> {4, 4, 8}
    ]
  }
 ]