From 3499db16e5ff4694c599f959e2502f00fd3d8902 Mon Sep 17 00:00:00 2001
From: "James N. V. Cash" <james.nvc@gmail.com>
Date: Thu, 18 Feb 2016 11:31:13 -0500
Subject: [PATCH] WIP: work on normalizing scroll distances between browsers

---
 src/chat/client/views/helpers/events.cljs | 59 +++++++++++++++++++++++
 src/chat/client/views/pages/inbox.cljs    | 10 +---
 2 files changed, 61 insertions(+), 8 deletions(-)
 create mode 100644 src/chat/client/views/helpers/events.cljs

diff --git a/src/chat/client/views/helpers/events.cljs b/src/chat/client/views/helpers/events.cljs
new file mode 100644
index 000000000..81591fb00
--- /dev/null
+++ b/src/chat/client/views/helpers/events.cljs
@@ -0,0 +1,59 @@
+(ns chat.client.views.helpers.events
+  (:require [om.core :as om]))
+
+(def PIXEL-STEP 10)
+(def LINE-HEIGHT 40)
+(def PAGE-HEIGHT 800)
+
+(defn signum [x] (if (>= x 0) 1 -1))
+
+(defn normalize-scroll
+  [event]
+  (let [sY (condp (fn [field obj] (aget obj field)) event
+             "detail" :>> identity
+             "wheelDelta" :>> #(/ (- %) 120)
+             "wheelDeltaY" :>> #(/ (- %) 120)
+             0)
+        sX (if-let [wdx (.-wheelDeltaX event)]
+             (/ (- wdx) 120)
+             0)
+        [sX sY] (if (and (some? (.-axis event))
+                      (= (.-axis event) (.-HORIZONTAL_AXIS event)))
+                  [sY 0]
+                  [sX sY])
+        pX (if-let [dx (.-deltaX event)]
+             dx
+             (* sX PIXEL-STEP))
+        pY (if-let [dy (.-deltaY event)]
+             dy
+             (* sY PIXEL-STEP))
+        [pX pY] (if (and (some? (.-deltaMode event))
+                      (= 1 (.-deltaMode event)))
+                  [(* pX LINE-HEIGHT) (* pY LINE-HEIGHT)]
+                  [(* pX PAGE-HEIGHT) (* pY PAGE-HEIGHT)])
+        sX (if (and (not= 0 pX) (zero? sX))
+             (signum pX)
+             sX)
+        sY (if (and (not= 0 pY) (zero? sY))
+             (signum pY)
+             sY)]
+    {:spinX sX
+     :spinY sY
+     :pixelX pX
+     :pixelY pY}))
+
+(defn scroll-threads-handler
+  [owner]
+  (fn [e]
+    (let [target-classes (.. e -target -classList)
+          this-elt (om/get-node owner "threads-div")
+          scroll (normalize-scroll e)]
+      (println "scroll" scroll)
+      ; TODO: check if threads-div needs to scroll?
+      (when (and (or (.contains target-classes "thread")
+                     (.contains target-classes "threads"))
+              (= 0 (:pixelX scroll)))
+        (set! (.-scrollLeft this-elt)
+              (- (.-scrollLeft this-elt)
+                 (:pixelY (normalize-scroll e))))))))
+
diff --git a/src/chat/client/views/pages/inbox.cljs b/src/chat/client/views/pages/inbox.cljs
index 1b1cb0dae..3ece776a4 100644
--- a/src/chat/client/views/pages/inbox.cljs
+++ b/src/chat/client/views/pages/inbox.cljs
@@ -2,6 +2,7 @@
   (:require [om.core :as om]
             [om.dom :as dom]
             [chat.client.store :as store]
+            [chat.client.views.helpers.events :refer [scroll-threads-handler]]
             [chat.client.views.threads :refer [thread-view new-thread-view]]))
 
 (defn inbox-page-view [data owner]
@@ -12,14 +13,7 @@
         (dom/div #js {:className "title"} "Inbox")
         (apply dom/div #js {:className "threads"
                             :ref "threads-div"
-                            :onWheel (fn [e]
-                                       (let [target-classes (.. e -target -classList)
-                                             this-elt (om/get-node owner "threads-div")]
-                                         ; TODO: check if threads-div needs to scroll?
-                                         (when (and (or (.contains target-classes "thread")
-                                                        (.contains target-classes "threads"))
-                                                 (= 0 (.-deltaX e) (.-deltaZ e)))
-                                           (set! (.-scrollLeft this-elt) (- (.-scrollLeft this-elt) (.-deltaY e))))))}
+                            :onWheel (scroll-threads-handler owner)}
           (concat
             [(new-thread-view {})]
             (map (fn [t] (om/build thread-view t {:key :id}))