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

Re: Locator-set Bezier curves mapped to 3D surface

• To: mathgroup at smc.vnet.net
• Subject: [mg124891] Re: Locator-set Bezier curves mapped to 3D surface
• From: Chris Young <c1572young at earthlink.net>
• Date: Sat, 11 Feb 2012 06:34:48 -0500 (EST)
• Delivered-to: l-mathgroup@mail-archive0.wolfram.com
• References: <jg8g4l$ua$1@smc.vnet.net>

Fixed up some typos that broke this previously.
Now maps 2D Bezier curves to a 3D surface (hyperbolic paraboloid).

Wish I didn't have to have the
\[ScriptCapitalB] = Partition[P, cLnth];
inside the LocatorPane, but I can't get the curves to be upated by the 
locators otherwise.


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

Chris Young
cy56 at comcast.net


Maps a 2D point upwards to a saddle surface (hyperbolic paraboloid):

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

 Parametric function for 2D Bezier curve on control points P:

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

Hues for the locators:

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

Graphics for the custom colored locators:

locGraphics[k_, n_, locSize_, opac_, offset_] :=
 Graphics[
  {
   Opacity[opac],
   locHue[k, n], Disk[{0, 0}],
   Opacity[1], Black, Circle[{0, 0}],
   Line[{{-1.5, 0}, {1.5, 0}}], Line[{{0, -1.5}, {0, 1.5}}],
   Text[k, {0, 0}, offset]
   },
  ImageSize -> locSize]


The main routine:


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

  nPts,                 (* number of total points *)

  nCurves ,          (* number of Bezier curves *)

  cLnth = 4          (* number of control points for each curve *)
  },

 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}
   };

 nPts = Length[P];

 {
  Dynamic @ LocatorPane[
    Dynamic @ P,

    \[ScriptCapitalB] = Partition[P, cLnth];
    nCurves = Length[\[ScriptCapitalB]];

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

      Graphics[
       Table[{Dotted, locHue[k, cLnth],
         Line[\[ScriptCapitalB][[k]]]}, {k, 4}]],

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

    Appearance ->
     Table[
      Graphics[
       {
        locHue[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},
        Mesh -> False},

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

    PlotRange -> {{-2, 2}, {-2, 2}, {-4, 4}},
    BoxRatios -> {4, 4, 8}
    ]
  }
 ]