EventHandler and Refresh rate

Question

Based on the example of the Documentation of MousePosition, Properties and Relations, here is my test code using "MouseDragged" instead of "MouseClicked":

DynamicModule[{list = {}},
 EventHandler[
  Dynamic[
   Framed@Graphics[{Red, Point[list]}, PlotRange -> 2]
   ]
  , {"MouseDragged" :> AppendTo[list, MousePosition["Graphics"]]}
  ]
 ]

Using this, one can drag lines of dots as follows:

The top line was drawn while moving the mouse very slowly, the bottom line was drawn with a faster mouse movement.

I would now like to add even more points in the bottom line, to be able to have an almost full line, even with fast mouse movements. I have checked out Refresh, and UpdateInterval, but that didn't change everything.

So: is it possible to track all pixel movements of the mouse inside a certain region, to be able to plot all points?

As always, thanks for all help!

Answer 1

The following seems to be a little faster, most likely because it avoids AppendTo.

DynamicModule[{list = {}},
  EventHandler[
   Dynamic @ Framed @ Graphics[{Red, list}, PlotRange -> 2], 
   {"MouseDragged" :> 
     (list = Flatten @ {list, Point @ MousePosition["Graphics"]})}]]

However, you might find it more to your liking to use lines rather than points. Doing so will allow for nice, smooth lines to be drawn. Here is one way to modify your code to use lines.

DynamicModule[{new, old, current = {}, previous = {}},
  EventHandler[
    Dynamic @ Framed @ Graphics[{{Red, previous}, {Black, current}}, PlotRange -> 2], 
    {"MouseDragged" :> 
      (current = 
         Flatten @ {current, Line @ {old, new = MousePosition["Graphics"]}}; 
       old = new),
     "MouseDown" :> (old = MousePosition["Graphics"]; current = {}),
     "MouseUp" :> (previous = Flatten@{previous, current})}]]

Answer 2

I'm not sure how to increase the mouse polling rate in Dynamic-things, but I think it has been doing really well on my computer, which is Windows 8.1 with a regular USB mouse.

Here is a simple code to measure the average polling rate of Dynamic:

Module[{mplst = {}, time = 10},
       PrintTemporary[DynamicWrapper["Measuring...",
                     mplst = Join[mplst, {MousePosition[]}]
                     ]];
       Pause[time];
       Length[mplst]/time // N
      ]

which gives near $100\, \mathrm{Hz}$ result.

This is the result mesured by tool based on DirectX:

I think it's fair to say Dynamic does his job pretty well.

I noticed there is saying that "USB polling rate is set at 125hz" by default. So I will not be surprised if using a high-rate mouse get a better result.

Also, you should be aware that the AppendTo might slow down your code when list gets big. Please see section 3 in this post for detail.

Update:

Here is a preciser measurement of, I think, the polling rate of MousePosition itself without the affection of Dynamic.

Put the cursor in the code, keep moving your mouse (but not too fast), meanwhile press Shift + Enter:

mplst = {};
time = AbsoluteTiming[Do[
                         mplst = {mplst, MousePosition[]},
                         {10^4}]][[1]];
mplst = mplst // Flatten // Partition[#, 2] &;
freshrate = 10^4/time

3645.44

It's a HELL of high rate!

But wait... If we take a look into mplst, we'll see many of them are duplicates:

trueTrackPt = mplst // Split // #[[All, 1]] &;
mouseFreshrate = Length[trueTrackPt]/time

124.3093

This is really close to the result from the DirextX tool, which could be considered as the true rate.

For a much faster mouse movement, the freshrate will be greater, but the mouseFreshrate will be less.

So I think the mouse polling rate in Dynamic might be able to be increased within Mathematica (with methods which I haven't found yet), but only with a limited amount. The true bottleneck is still the OS and hardware, to overcome which you'll have to have special drivers and/or a high-rate mouse.

On the other hand, if all you need is smoother trajectory, you can try draw it more slowly, link the sample points with Line or BSplineCurve, even Interpolation them:

Graphics[{Lighter[Blue, .4], Thick, Line[trueTrackPt],
          White, Thin, BSplineCurve[trueTrackPt],
          Red, Point[trueTrackPt]},
         Background -> Black]