# How to create 2d trajectory by moving mouse over plot

When I move with the mouse over a plot with a given plot range I would like to store the coordinates of the corresponding trajectory in a list and plot it.

I have seen that MousePosition is used to read the current mouse position in the notebook, but I do not how to start.

The following works:

mymouse := Block[{}, pos = MousePosition["Graphics"];
If[pos =!= None, AppendTo[posList, pos]]]
posList = {};
plot = Plot[Sin[x], {x, 0, 4 Pi}]; (* your plot *)

Dynamic[Show[plot, ListLinePlot[posList, PlotStyle -> Red]]]
Dynamic[mymouse]


Edit Maybe this is a bit smoother?

mymouse := Block[{}, pos = MousePosition["Graphics"];
If[pos =!= None, AppendTo[posList, pos];
posList = DeleteDuplicates@posList;]]
(* If[pos =!= None && Not@MemberQ[postList,pos], AppendTo[posList, pos]; *)
posList = {};
plot = Plot[Sin[x], {x, 0, 4 Pi}];(*your plot*)Dynamic[
Show[plot, ListLinePlot[posList, PlotStyle -> Red]]]
Dynamic[mymouse]


And this to avoid the slow AppendTo:

i = 1;
mymouse := Block[{}, pos = MousePosition["Graphics"];
If[pos =!= None, posList[[i]] = pos; i++;]]
posList = ConstantArray[{0, 0}, 1000];
plot = Plot[Sin[x], {x, 0, 4 Pi}];(*your plot*)Dynamic[
Show[plot, ListLinePlot[posList, PlotStyle -> Red]]]
Dynamic[mymouse]

• Thank you, this works good, but somehow my on my computer it is very slow: when I move the mouse I have to wait a while to see the curve. Can you also observe this? Another problem: if the mouse is not moved the code continuously stores the same coordinate. Can the code store only once this coordinates? PS: Nobody will be able exactly to repeat your copyrighted artwork, it is unique ;-)
– lio
Feb 21, 2018 at 9:31
• @lio I edited, is it better? I tried on two PCs and is was OK, not perfect but OK. To improve that, you would need someone more knowledgeable than me... AppendTo is not recommended but I do not see how to avoid that. I added a third possibility just to see if its smoother, but it introduces the point {0, 0}. Feb 22, 2018 at 0:25
• This is excellent for a project I am currently working on; I did not know about MousePosition! Is there an easy way to make this start recording points on the path after a mouseclick, and end after clicking again? Apr 3, 2019 at 4:28
• @Steve I don't have MMA readily available to try it, but I would start by reading reference.wolfram.com/language/ref/EventHandler.html. Apr 3, 2019 at 14:53
ClearAll[addLines]
addLines = DynamicModule[{lc, t = .01, nps = NewPrimitiveStyle /.
Options[$FrontEnd, NewPrimitiveStyle]}, Column[{Row[{Button["add lines", FrontEndExecute[ FrontEndSelect2DTool["DrawFreehand", "Persistent" -> True]], Alignment -> Center], Panel@ColorSetter[Dynamic[lc, (lc = #; SetOptions[$FrontEndSession,
NewPrimitiveStyle -> {nps = nps /. Rule[LineColor, _] :> Rule[LineColor, #]}]) &],
BaselinePosition -> Scaled[1/4]],
Panel@Labeled[LabeledSlider[Dynamic[t, ((t = #; SetOptions[\$FrontEndSession,
NewPrimitiveStyle -> {nps = nps /. Rule[Thickness, _] :>  Rule[Thickness, #]}])) &],
{0, 1/10, 1/100}, ImageMargins -> 0, ContentPadding -> False], "thickness", Left]},
Spacer[1], Alignment -> Center], #}]] &;


Examples:

addLines[Plot[Sin[x], {x, 0, 4 Pi}, ImageSize -> 500]]


addLines[BarChart[Range[10], ImageSize -> 500]]


• Great use of "DrawFreehand"`! However I think your drawing skills lack originality. It's too much copied from Otto Zitko. Feb 23, 2018 at 0:42