This has been done already at Demonstration project. You can download notebook with the source code at the link below, but I also give it here - it is not that big.
Spline Sketchpad, by Yu-Sung Chang
Manipulate[
If[(prevdegree =!= degree) || (prevapprox =!= approx),
degree = If[approx < 20, Min[degree, 2], degree];
ctrlpts =
Table[splineFit[p,
Max[{Floor[(1 - approx/100) Length[p]], degree + 1}],
degree], {p, pts}]; prevdegree = degree; prevapprox = approx];
EventHandler[
Graphics[{
CapForm["Round"], JoinForm["Round"],
If[ctrlpts =!= {},
MapThread[{#1, Opacity[#2], AbsoluteThickness[#3],
BSplineCurve[#4, SplineDegree -> degree]} &, {colorlist,
opacitylist, thicknesslist, ctrlpts}], {}],
If[down && pts =!= {}, {color, Opacity[opacity],
AbsolutePointSize[thickness], Point[Last[pts]]}, {}],
If[pen && pts =!= {},
If[down, Point /@ Most[pts], Point /@ pts], {}]
},
PlotRange -> 1, ImageSize -> 400, AspectRatio -> 1/GoldenRatio,
Frame -> True, FrameTicks -> False],
{"MouseDown" :> (AppendTo[pts, {MousePosition["Graphics"]}];
down = True),
"MouseMoved" :> (If[down,
AppendTo[pts[[count]], MousePosition["Graphics"]]]),
"MouseUp" :> (down = False; count++;
ctrlpts =
Table[splineFit[p,
Max[{Floor[(1 - approx/100) Length[p]], degree + 1}],
degree], {p, pts}]; AppendTo[colorlist, color];
AppendTo[opacitylist, opacity];
AppendTo[thicknesslist, thickness])}
],
(* Pen controls *)
Row[{Control[{color, Blue}],
Control[{{pen, False, "show points"}, {True, False}}]}, Spacer[10]],
{{thickness, 4}, 1, 20, Appearance -> "Labeled", ImageSize -> Medium},
{{opacity, 1}, 0, 1, Appearance -> "Labeled", ImageSize -> Medium},
Delimiter,
(* Spline controls *)
Row[{Control[{{approx, 30, "approximation"}, 0, 100, 1,
ImageSize -> Small}], Spacer[10], Dynamic[approx], "%"}],
Row[{Control[{{degree, 2,
"spline degree"}, (Dynamic[
If[approx < 20, RadioButtonBar[Dynamic[degree], {1, 2}],
RadioButtonBar[Dynamic[degree], {1, 2, 3, 4}]]] &)}],
Control[{{dummy, "", ""},
Button["clear",
colorlist = opacitylist = thicknesslist = pts = ctrlpts = {};
down = False; count = 1, ImageSize -> 50] &}]}],
(* Dummies *)
{{colorlist, {}}, ControlType -> None},
{{thicknesslist, {}}, ControlType -> None},
{{opacitylist, {}}, ControlType -> None},
{{prevapprox, 0}, ControlType -> None},
{{prevdegree, 2}, ControlType -> None},
{{pts, {}}, ControlType -> None},
{{ctrlpts, {}}, ControlType -> None},
{{down, False}, ControlType -> None},
{{count, 1}, ControlType -> None},
AutorunSequencing -> {2, 5},
Initialization :> (
splineFit[pts_, n_, d_] := Module[{uparam, knots, basis},
If[Length[pts] == 1, Return[Join[pts, pts]]];
If[Length[pts] <= d, Return[pts]];
(*uparam=With[{acc=N[Accumulate[Norm/@pts]]},(acc-First[
acc])/(Last[acc]-First[acc])];*)
uparam = N[Range[0, 1, 1/(Length[pts] - 1)]];
knots =
Join[ConstantArray[0, d], Range[0, 1, 1/(n - d)],
ConstantArray[1, d]];
basis =
Table[BSplineBasis[{d, knots}, j - 1, uparam[[i]]], {i,
Length[uparam]}, {j, n}];
LeastSquares[basis, pts]];
)
]
