Improve velocity calculation in momentum scrolling

* lisp/pixel-scroll.el
(pixel-scroll-precision-momentum-factor): Remove option.
(pixel-scroll-precision-initial-velocity-factor)
(pixel-scroll-precision-momentum-min-velocity): New user
options.
(pixel-scroll-accumulate-velocity): Clear velocity ring
if sign is different.
(pixel-scroll-calculate-velocity): Use current time.
(pixel-scroll-start-momentum): Use better algorithm.

1 files changed, 49 insertions, 25 deletions

diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el
index 3c764ff65ab..1c2d95613e5 100644
--- a/lisp/pixel-scroll.el
+++ b/lisp/pixel-scroll.el
@@ -121,8 +121,14 @@ This is only effective if supported by your mouse or touchpad."
   :type 'float
   :version "29.1")
 
-(defcustom pixel-scroll-precision-momentum-factor 0.95
-  "Factor by which to reduce scroll velocity on each momentum scroll"
+(defcustom pixel-scroll-precision-momentum-min-velocity 10.0
+  "The minimum scrolled pixels per second before momentum scrolling starts."
+  :group 'mouse
+  :type 'float
+  :version "29.1")
+
+(defcustom pixel-scroll-precision-initial-velocity-factor 0.25
+  "Factor applied to the initial velocity before momentum scrolling begins."
   :group 'mouse
   :type 'float
   :version "29.1")
@@ -524,8 +530,13 @@ It is a vector of the form [ VELOCITY TIME ]."
 (defun pixel-scroll-accumulate-velocity (delta)
   "Accumulate DELTA into the current window's kinetic scroll state."
   (let* ((state (pixel-scroll-kinetic-state))
+         (ring (aref state 0))
          (time (aref state 1)))
-    (when (and time (> (- (float-time) time) 0.5))
+    (when (or (and time (> (- (float-time) time) 0.5))
+              (and (not (ring-empty-p ring))
+                   (not (eq (< delta 0)
+                            (< (cdr (ring-ref ring 0))
+                               0)))))
       (aset state 0 (make-ring 10)))
     (ring-insert (aref state 0)
                  (cons (aset state 1 (float-time))
@@ -538,8 +549,7 @@ It is a vector of the form [ VELOCITY TIME ]."
          (total 0))
     (dolist (tem elts)
       (setq total (+ total (cdr tem))))
-    (/ total (* (- (caar elts)
-                   (caar (last elts)))
+    (/ total (* (- (float-time) (caar elts))
                 100))))
 
 (defun pixel-scroll-start-momentum (event)
@@ -555,26 +565,40 @@ It is a vector of the form [ VELOCITY TIME ]."
           (while-no-input
             (unwind-protect (progn
                               (aset state 0 (pixel-scroll-calculate-velocity state))
-                              (let ((velocity (/ (aref state 0) 3))
-                                    (time-spent 0))
-                                (if (> velocity 0)
-                                    (while (and (> velocity 0.2)
-                                                (<= time-spent pixel-scroll-precision-momentum-seconds))
-                                      (pixel-scroll-precision-scroll-up (ceiling velocity))
-                                      (setq velocity (* velocity pixel-scroll-precision-momentum-factor))
-                                      (redisplay t)
-                                      (sit-for pixel-scroll-precision-momentum-tick)
-                                      (setq time-spent (+ time-spent
-                                                          pixel-scroll-precision-momentum-tick))))
-                                (while (and (< velocity -0.4)
-                                            (<= time-spent
-                                                pixel-scroll-precision-momentum-seconds))
-                                  (pixel-scroll-precision-scroll-down (floor (abs velocity)))
-                                  (setq velocity (* velocity pixel-scroll-precision-momentum-factor))
-                                  (redisplay t)
-                                  (sit-for pixel-scroll-precision-momentum-tick)
-                                  (setq time-spent (+ time-spent
-                                                      pixel-scroll-precision-momentum-tick)))))
+                              (when (> (abs (aref state 0))
+                                       pixel-scroll-precision-momentum-min-velocity)
+                                (let* ((velocity (* (aref state 0)
+                                                    pixel-scroll-precision-initial-velocity-factor))
+                                       (original-velocity velocity)
+                                       (time-spent 0))
+                                  (if (> velocity 0)
+                                      (while (and (> velocity 0)
+                                                  (<= time-spent
+                                                      pixel-scroll-precision-momentum-seconds))
+                                        (when (> (round velocity) 0)
+                                          (pixel-scroll-precision-scroll-up (round velocity)))
+                                        (setq velocity (- velocity
+                                                          (/ original-velocity
+                                                             (/ pixel-scroll-precision-momentum-seconds
+                                                                pixel-scroll-precision-momentum-tick))))
+                                        (redisplay t)
+                                        (sit-for pixel-scroll-precision-momentum-tick)
+                                        (setq time-spent (+ time-spent
+                                                            pixel-scroll-precision-momentum-tick))))
+                                  (while (and (< velocity 0)
+                                              (<= time-spent
+                                                  pixel-scroll-precision-momentum-seconds))
+                                    (when (> (round (abs velocity)) 0)
+                                      (pixel-scroll-precision-scroll-down (round
+                                                                           (abs velocity))))
+                                    (setq velocity (+ velocity
+                                                      (/ (abs original-velocity)
+                                                         (/ pixel-scroll-precision-momentum-seconds
+                                                            pixel-scroll-precision-momentum-tick))))
+                                    (redisplay t)
+                                    (sit-for pixel-scroll-precision-momentum-tick)
+                                    (setq time-spent (+ time-spent
+                                                        pixel-scroll-precision-momentum-tick))))))
               (aset state 0 (make-ring 10))
               (aset state 1 nil))))))))