master 1afa295: Improve velocity calculation in momentum scrolling

[Po Lu]

branch: master
commit 1afa295aed81357fddf9694bfe68ed0e6d159a2d
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>

    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.
---
 lisp/pixel-scroll.el | 74 ++++++++++++++++++++++++++++++++++------------------
 1 file changed, 49 insertions(+), 25 deletions(-)

diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el
index 3c764ff..1c2d956 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))))))))