
Locatorset Bezier curves mapped to 3D surface
Posted:
Jan 31, 2012 5:35 AM


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@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} ] } ]

