diff --git a/frontend/src/app/main/ui/hooks.cljs b/frontend/src/app/main/ui/hooks.cljs index 3225932153..5bc113bab9 100644 --- a/frontend/src/app/main/ui/hooks.cljs +++ b/frontend/src/app/main/ui/hooks.cljs @@ -87,6 +87,122 @@ ;; Do not remove commented out lines, they are useful to debug events when ;; things go weird. +;; Native drag and drop swallows wheel events while a drag is in progress, so +;; scrolling a long list mid-drag is done here: when the pointer gets near the +;; top or bottom edge of the scrollable container, it is scrolled on every +;; animation frame, faster the closer the pointer is to the edge. + +(def ^:private auto-scroll-zone-size 56) +(def ^:private auto-scroll-max-speed 18) +(def ^:private auto-scroll-stale-ms 500) + +;; Speeds are given in pixels per frame at 60 Hz and scaled by the real time +;; between frames, so the scroll goes as fast on a 120 Hz screen. +(def ^:private auto-scroll-frame-ms (/ 1000 60)) +(def ^:private auto-scroll-max-frame-ms 100) + +;; State of the current drag: the scroll container, found once when the drag +;; starts, the scroll speed, the pending animation frame and when the pointer +;; was last seen over the list. +(defonce ^:private auto-scroll-state (atom nil)) + +(defn- scrollable-ancestor + [node] + (loop [node (some-> ^js node .-parentElement)] + (when (some? node) + (let [overflow (-> (dom/get-computed-styles node) + (dom/get-property-value "overflow-y"))] + (if (and (or (= overflow "auto") (= overflow "scroll")) + (> (.-scrollHeight ^js node) (.-clientHeight ^js node))) + node + (recur (.-parentElement ^js node))))))) + +(defn- auto-scroll-speed + "Pixels to scroll on each frame given the pointer position, negative + upwards. Zero when the pointer is outside the edge zones. The zones take + at most a quarter of the container each, so the middle half of a short + list never scrolls." + [{:keys [top bottom]} pointer-y] + (let [zone (mth/min auto-scroll-zone-size (/ (- bottom top) 4)) + top-distance (- pointer-y top) + bottom-distance (- bottom pointer-y) + ramp (fn [distance] + (-> (- zone distance) + (/ zone) + (* auto-scroll-max-speed) + (mth/ceil)))] + (cond + (or (neg? top-distance) (neg? bottom-distance)) 0 + (< top-distance zone) (- (ramp top-distance)) + (< bottom-distance zone) (ramp bottom-distance) + :else 0))) + +(defn- stop-auto-scroll! + "Stops the scroll loop, keeping the scroll container for the rest of the + drag." + [] + (some-> (:frame @auto-scroll-state) ts/cancel-af!) + (swap! auto-scroll-state dissoc :frame :last-frame-at :offset)) + +(defn- end-auto-scroll! + [] + (stop-auto-scroll!) + (reset! auto-scroll-state nil)) + +(defn- start-auto-scroll! + "Remembers the scroll container of the dragged `node`. A loop left over + from a previous drag whose end was lost is stopped first." + [node] + (stop-auto-scroll!) + (reset! auto-scroll-state {:element (scrollable-ancestor node)})) + +(defn- auto-scroll-tick + [timestamp] + (let [{:keys [element speed updated-at last-frame-at offset]} @auto-scroll-state] + ;; The stale check stops the loop if the drag ended without us being + ;; notified, for example when a dragend event is lost. + (if (or (nil? element) + (> (- timestamp updated-at) auto-scroll-stale-ms)) + (end-auto-scroll!) + (let [;; Capped so a late frame does not make the list jump. + elapsed (if (some? last-frame-at) + (mth/min (- timestamp last-frame-at) auto-scroll-max-frame-ms) + auto-scroll-frame-ms) + ;; Keep the fraction of a pixel for the next frame, otherwise + ;; slow speeds would be lost on fast screens. + offset (+ (or offset 0) (* speed (/ elapsed auto-scroll-frame-ms))) + step (js/Math.trunc offset)] + (when-not (zero? step) + (dom/scroll-by! element 0 step)) + (swap! auto-scroll-state assoc + :offset (- offset step) + :last-frame-at timestamp + :frame (ts/raf auto-scroll-tick)))))) + +(defn- update-auto-scroll! + "Starts, updates or stops the auto scroll of the container of `node` + depending on how close the pointer is to its edges." + [node pointer-y] + (let [element (:element @auto-scroll-state) + ;; The drag may have started outside this list, or the loop ended + ;; on the stale check: find the container of `node` again. + element (if (dom/child? node element) + element + (scrollable-ancestor node)) + speed (if (some? element) + (auto-scroll-speed (dom/get-bounding-rect element) pointer-y) + 0)] + (swap! auto-scroll-state assoc + :element element + :speed speed + :updated-at (js/performance.now)) + (cond + (zero? speed) + (stop-auto-scroll!) + + (nil? (:frame @auto-scroll-state)) + (swap! auto-scroll-state assoc :frame (ts/raf auto-scroll-tick))))) + (defn use-sortable [& {:keys [data-type data on-drop on-drag on-hold disabled detect-center? draggable?] :or {draggable? true} @@ -123,6 +239,7 @@ (dnd/set-data! event data-type data) (dnd/set-drag-image! event (dnd/invisible-image)) (dnd/set-allowed-effect! event "move") + (start-auto-scroll! (mf/ref-val ref)) (when (fn? on-drag) (on-drag data))))) @@ -148,7 +265,8 @@ (subscribe-to-drag-end) ;; (dnd/trace event data "drag-over") (let [side (dnd/drop-side event detect-center?)] - (swap! state assoc :over side))))) + (swap! state assoc :over side))) + (update-auto-scroll! (mf/ref-val ref) (.-clientY event)))) on-drag-leave (fn [event] @@ -162,6 +280,7 @@ ;; (dnd/trace event data "drop") (let [side (dnd/drop-side event detect-center?) drop-data (dnd/get-data event data-type)] + (end-auto-scroll!) (cleanup) (rx/push! global-drag-end nil) (when (fn? on-drop) @@ -171,6 +290,7 @@ (fn [event] (dom/stop-propagation event) ;; (dnd/trace event data "drag-end") + (end-auto-scroll!) (rx/push! global-drag-end nil) (cleanup)) diff --git a/frontend/test/frontend_tests/runner.cljs b/frontend/test/frontend_tests/runner.cljs index e5d2a3c11a..78743cea8b 100644 --- a/frontend/test/frontend_tests/runner.cljs +++ b/frontend/test/frontend_tests/runner.cljs @@ -136,6 +136,7 @@ [frontend-tests.ui.shape-filters-test] [frontend-tests.ui.shortcuts-labels-test] [frontend-tests.ui.sidebar-scroll-test] + [frontend-tests.ui.sortable-auto-scroll-test] [frontend-tests.ui.stroke-menu-test] [frontend-tests.ui.text-attrs-multiple-test] [frontend-tests.ui.workspace-libraries-test] @@ -296,6 +297,7 @@ 'frontend-tests.ui.shape-filters-test 'frontend-tests.ui.shortcuts-labels-test 'frontend-tests.ui.sidebar-scroll-test + 'frontend-tests.ui.sortable-auto-scroll-test 'frontend-tests.ui.stroke-menu-test 'frontend-tests.ui.text-attrs-multiple-test 'frontend-tests.ui.workspace-libraries-test diff --git a/frontend/test/frontend_tests/ui/sortable_auto_scroll_test.cljs b/frontend/test/frontend_tests/ui/sortable_auto_scroll_test.cljs new file mode 100644 index 0000000000..fb4d8348ac --- /dev/null +++ b/frontend/test/frontend_tests/ui/sortable_auto_scroll_test.cljs @@ -0,0 +1,178 @@ +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. +;; +;; Copyright (c) KALEIDOS SUBSIDIARY SL + +(ns frontend-tests.ui.sortable-auto-scroll-test + (:require + [app.common.math :as mth] + [app.main.ui.hooks :as hooks] + [app.util.timers :as ts] + [cljs.test :as t :include-macros true])) + +(def ^:private auto-scroll-speed @#'hooks/auto-scroll-speed) +(def ^:private auto-scroll-state @#'hooks/auto-scroll-state) +(def ^:private start-auto-scroll! @#'hooks/start-auto-scroll!) +(def ^:private update-auto-scroll! @#'hooks/update-auto-scroll!) +(def ^:private end-auto-scroll! @#'hooks/end-auto-scroll!) + +(t/use-fixtures :each {:before #(reset! auto-scroll-state nil) + :after #(reset! auto-scroll-state nil)}) + +;; A 400px tall list, with the 56px edge zones at [0, 56] and [344, 400]. +(def ^:private rect {:top 0 :bottom 400}) + +(t/deftest auto-scroll-speed-test + (t/testing "does not scroll when the pointer is away from the edges" + (t/is (= 0 (auto-scroll-speed rect 200))) + (t/is (= 0 (auto-scroll-speed rect 56))) + (t/is (= 0 (auto-scroll-speed rect 344)))) + + (t/testing "does not scroll when the pointer is outside the container" + (t/is (= 0 (auto-scroll-speed rect -10))) + (t/is (= 0 (auto-scroll-speed rect 410)))) + + (t/testing "scrolls upwards near the top edge and downwards near the bottom" + (t/is (neg? (auto-scroll-speed rect 10))) + (t/is (pos? (auto-scroll-speed rect 390)))) + + (t/testing "scrolls faster the closer the pointer gets to the edge" + (t/is (< (auto-scroll-speed rect 5) (auto-scroll-speed rect 50) 0)) + (t/is (< 0 (auto-scroll-speed rect 350) (auto-scroll-speed rect 395))))) + +(t/deftest auto-scroll-speed-short-list-test + ;; In a 100px list each zone is capped at 25px, a quarter of the height. + (let [rect {:top 0 :bottom 100}] + (t/testing "the middle half of the list never scrolls" + (t/is (= 0 (auto-scroll-speed rect 25))) + (t/is (= 0 (auto-scroll-speed rect 50))) + (t/is (= 0 (auto-scroll-speed rect 75)))) + + (t/testing "the capped zones still scroll" + (t/is (neg? (auto-scroll-speed rect 10))) + (t/is (pos? (auto-scroll-speed rect 90)))))) + +(defn- scroll-container + "A fake 400px tall scroll container that records the scrolled pixels." + [scrolled] + #js {:contains (fn [_] true) + :getBoundingClientRect (fn [] #js {:top 0 :bottom 400}) + :scrollBy (fn [_ y] (swap! scrolled conj y))}) + +(defn- start-drag! + [element] + (reset! auto-scroll-state {:element element})) + +(t/deftest start-auto-scroll-without-container-test + (start-auto-scroll! #js {:parentElement nil}) + (t/is (= {:element nil} @auto-scroll-state))) + +(t/deftest start-auto-scroll-stops-previous-loop-test + ;; The previous drag ended without a dragend, so its loop is still running. + (let [cancelled (atom [])] + (with-redefs [ts/cancel-af! (fn [frame] (swap! cancelled conj frame))] + (reset! auto-scroll-state {:element #js {} :frame 9}) + (start-auto-scroll! #js {:parentElement nil}) + (t/is (= [9] @cancelled)) + (t/is (= {:element nil} @auto-scroll-state))))) + +(t/deftest update-auto-scroll-starts-one-loop-test + (let [scheduled (atom []) + element (scroll-container (atom []))] + (with-redefs [ts/raf (fn [f] (swap! scheduled conj f) (count @scheduled))] + (start-drag! element) + (update-auto-scroll! #js {} 10) + (update-auto-scroll! #js {} 5) + (update-auto-scroll! #js {} 1) + (t/is (= 1 (count @scheduled)) "dragover events reuse the running loop") + (t/is (= 1 (:frame @auto-scroll-state))) + (t/is (= (auto-scroll-speed rect 1) (:speed @auto-scroll-state)) + "the loop uses the latest pointer position")))) + +(t/deftest update-auto-scroll-away-from-edges-does-not-start-test + (let [scheduled (atom []) + element (scroll-container (atom []))] + (with-redefs [ts/raf (fn [f] (swap! scheduled conj f) 1)] + (start-drag! element) + (update-auto-scroll! #js {} 200) + (t/is (empty? @scheduled))))) + +(t/deftest auto-scroll-tick-scrolls-and-continues-test + (let [scheduled (atom []) + scrolled (atom []) + element (scroll-container scrolled)] + (with-redefs [ts/raf (fn [f] (swap! scheduled conj f) (count @scheduled))] + (start-drag! element) + (update-auto-scroll! #js {} 0) + ((last @scheduled) (js/performance.now)) + (t/is (= [(auto-scroll-speed rect 0)] @scrolled)) + (t/is (= 2 (count @scheduled)) "the next frame is scheduled") + (t/is (= 2 (:frame @auto-scroll-state)))))) + +(t/deftest auto-scroll-stops-when-speed-goes-back-to-zero-test + (let [scheduled (atom []) + cancelled (atom []) + element (scroll-container (atom []))] + (with-redefs [ts/raf (fn [f] (swap! scheduled conj f) 7) + ts/cancel-af! (fn [frame] (swap! cancelled conj frame))] + (start-drag! element) + (update-auto-scroll! #js {} 10) + (update-auto-scroll! #js {} 200) + (t/is (= [7] @cancelled) "the pending frame is cancelled") + (t/is (nil? (:frame @auto-scroll-state))) + (t/is (identical? element (:element @auto-scroll-state)) + "the container is kept for the rest of the drag") + + (update-auto-scroll! #js {} 10) + (t/is (= 2 (count @scheduled)) "it starts again near the edge")))) + +(t/deftest auto-scroll-stops-on-drag-end-test + (let [cancelled (atom []) + element (scroll-container (atom []))] + (with-redefs [ts/raf (fn [_] 3) + ts/cancel-af! (fn [frame] (swap! cancelled conj frame))] + (start-drag! element) + (update-auto-scroll! #js {} 10) + (end-auto-scroll!) + (t/is (= [3] @cancelled)) + (t/is (nil? @auto-scroll-state))))) + +(t/deftest auto-scroll-stale-guard-test + (let [scheduled (atom []) + scrolled (atom []) + element (scroll-container scrolled)] + (with-redefs [ts/raf (fn [f] (swap! scheduled conj f) 1) + ts/cancel-af! (fn [_])] + (start-drag! element) + (update-auto-scroll! #js {} 10) + (let [updated-at (:updated-at @auto-scroll-state)] + ;; No dragover for more than 500ms, as when a dragend is lost. + ((last @scheduled) (+ updated-at 501))) + (t/is (empty? @scrolled) "it does not scroll on a stale frame") + (t/is (= 1 (count @scheduled)) "no further frames are scheduled") + (t/is (nil? @auto-scroll-state))))) + +(defn- scroll-for-two-60hz-frames + "Runs the loop for the time of two 60 Hz frames, at `frames` frames per + 60 Hz frame, and returns the scrolled pixels. The first frame has no + previous one to measure from, so it counts as a full 60 Hz frame." + [frames] + (let [scheduled (atom []) + scrolled (atom []) + frame-ms (/ 1000 60 frames)] + (with-redefs [ts/raf (fn [f] (swap! scheduled conj f) 1)] + (reset! auto-scroll-state nil) + (start-drag! (scroll-container scrolled)) + (update-auto-scroll! #js {} 0) + (let [start (:updated-at @auto-scroll-state)] + (dotimes [i (inc frames)] + ((last @scheduled) (+ start (* i frame-ms)))))) + (reduce + @scrolled))) + +(t/deftest auto-scroll-speed-does-not-depend-on-refresh-rate-test + (let [at-60hz (scroll-for-two-60hz-frames 1) + at-120hz (scroll-for-two-60hz-frames 2)] + (t/is (neg? at-60hz)) + (t/is (<= (mth/abs (- at-120hz at-60hz)) 1) + "a 120 Hz screen scrolls the same distance in the same time")))