♻️ Reorganize user events (mouse, keyboard, scroll, ...)

frontend/src/uxbox/main/data/workspace.cljs

@@ -9,10 +9,9 @@
    [beicon.core :as rx]
    [cljs.spec.alpha :as s]
    [potok.core :as ptk]
-   [uxbox.config :as cfg]
    [uxbox.common.data :as d]
    [uxbox.common.pages :as cp]
-   [uxbox.main.websockets :as ws]
+   [uxbox.config :as cfg]
    [uxbox.main.constants :as c]
    [uxbox.main.data.icons :as udi]
    [uxbox.main.data.projects :as dp]
@@ -20,6 +19,8 @@
    [uxbox.main.refs :as refs]
    [uxbox.main.repo.core :as rp]
    [uxbox.main.store :as st]
+   [uxbox.main.streams :as ms]
+   [uxbox.main.websockets :as ws]
    [uxbox.main.workers :as uwrk]
    [uxbox.util.data :refer [dissoc-in index-of]]
    [uxbox.util.geom.matrix :as gmt]
@@ -28,8 +29,8 @@
    [uxbox.util.perf :as perf]
    [uxbox.util.router :as rt]
    [uxbox.util.spec :as us]
-   [uxbox.util.transit :as t]
    [uxbox.util.time :as dt]
+   [uxbox.util.transit :as t]
    [uxbox.util.uuid :as uuid]
    [vendor.randomcolor]))
 
@@ -125,6 +126,7 @@
 (declare fetch-users)
 (declare handle-who)
 (declare handle-pointer-update)
+(declare handle-pointer-send)
 (declare handle-page-snapshot)
 (declare shapes-changes-commited)
 
@@ -144,33 +146,25 @@
     (watch [_ state stream]
       (let [wsession (get-in state [:ws file-id])
             stoper (rx/filter #(= ::finalize-ws %) stream)]
-        (->> (ws/-stream wsession)
+        (->> (rx/merge
-             (rx/filter #(= :message (:type %)))
+              (->> (ws/-stream wsession)
-             (rx/map (comp t/decode :payload))
+                   (rx/filter #(= :message (:type %)))
-             (rx/filter #(s/valid? ::message %))
+                   (rx/map (comp t/decode :payload))
-             (rx/map (fn [{:keys [type] :as msg}]
+                   (rx/filter #(s/valid? ::message %))
-                       (case type
+                   (rx/map (fn [{:keys [type] :as msg}]
-                         :who (handle-who msg)
+                             (case type
-                         :pointer-update (handle-pointer-update msg)
+                               :who (handle-who msg)
-                         :page-snapshot (handle-page-snapshot msg)
+                               :pointer-update (handle-pointer-update msg)
-                         ::unknown)))
+                               :page-snapshot (handle-page-snapshot msg)
+                               ::unknown))))
+
+              (->> stream
+                   (rx/filter ms/pointer-event?)
+                   (rx/sample 150)
+                   (rx/map #(handle-pointer-send file-id (:pt %)))))
+
              (rx/take-until stoper))))))
 
-
-;;    #_(->> stream
-;;         ;; TODO: this need to be rethinked
-;;         (rx/filter uxbox.main.ui.workspace.streams/pointer-event?)
-;;         (rx/sample 150)
-;;         (rx/tap (fn [{:keys [pt] :as event}]
-;;                   (let [msg {:type :pointer-update
-;;                              :page-id page-id
-;;                              :x (:x pt)
-;;                              :y (:y pt)}]
-;;                     (ws/-send (get-in state [:ws file-id]) (t/encode msg)))))
-;;         (rx/ignore)
-;;         (rx/take-until (rx/filter #(= ::finalize %) stream))))))))
-
-
 ;; --- Finalize Websocket
 
 (defn finalize-ws
@@ -215,6 +209,19 @@
                  :x x
                  :y y}))))
 
+(defn handle-pointer-send
+  [file-id point]
+  (ptk/reify ::handle-pointer-update
+    ptk/EffectEvent
+    (effect [_ state stream]
+      (let [ws (get-in state [:ws file-id])
+            pid (get-in state [:workspace-page :id])
+            msg {:type :pointer-update
+                 :page-id pid
+                 :x (:x point)
+                 :y (:y point)}]
+        (ws/-send ws (t/encode msg))))))
+
 (defn handle-page-snapshot
   [{:keys [user-id page-id version operations] :as msg}]
   (ptk/reify ::handle-page-snapshot

frontend/src/uxbox/main/streams.cljs

@@ -0,0 +1,96 @@
+;; 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) 2019 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.main.streams
+  "User interaction events and streams."
+  (:require
+   [beicon.core :as rx]
+   [uxbox.main.store :as st]
+   [uxbox.main.refs :as refs]
+   [uxbox.main.workers :as uwrk]
+   [uxbox.util.geom.point :as gpt]))
+
+;; --- User Events
+
+(defrecord KeyboardEvent [type key shift ctrl])
+
+(defn keyboard-event?
+  [v]
+  (instance? KeyboardEvent v))
+
+(defrecord MouseEvent [type ctrl shift])
+
+(defn mouse-event?
+  [v]
+  (instance? MouseEvent v))
+
+(defn mouse-up?
+  [v]
+  (and (mouse-event? v)
+       (= :up (:type v))))
+
+(defn mouse-click?
+  [v]
+  (and (mouse-event? v)
+       (= :click (:type v))))
+
+(defrecord PointerEvent [source pt ctrl shift])
+
+(defn pointer-event?
+  [v]
+  (instance? PointerEvent v))
+
+(defrecord ScrollEvent [point])
+
+(defn scroll-event?
+  [v]
+  (instance? ScrollEvent v))
+
+(defn interaction-event?
+  [event]
+  (or (keyboard-event? event)
+      (mouse-event? event)))
+
+;; --- Derived streams
+
+(defonce mouse-position
+  (let [sub (rx/behavior-subject nil)
+        ob  (->> st/stream
+                 (rx/filter pointer-event?)
+                 (rx/filter #(= :viewport (:source %)))
+                 (rx/map :pt))]
+    (rx/subscribe-with ob sub)
+    sub))
+
+(defonce mouse-position-ctrl
+  (let [sub (rx/behavior-subject nil)
+        ob  (->> st/stream
+                 (rx/filter pointer-event?)
+                 (rx/map :ctrl)
+                 (rx/dedupe))]
+    (rx/subscribe-with ob sub)
+    sub))
+
+(defn mouse-position-deltas
+  [current]
+  (->> (rx/concat (rx/of current)
+                  (rx/sample 10 mouse-position))
+       (rx/map #(gpt/divide % @refs/selected-zoom))
+       (rx/mapcat (fn [point]
+                    (if @refs/selected-alignment
+                      (uwrk/align-point point)
+                      (rx/of point))))
+       (rx/buffer 2 1)
+       (rx/map (fn [[old new]]
+                 (gpt/subtract new old)))))
+
+(defonce viewport-scroll
+  (let [sub (rx/behavior-subject nil)
+        sob (->> (rx/filter scroll-event? st/stream)
+                 (rx/map :point))]
+    (rx/subscribe-with sob sub)
+    sub))
+

frontend/src/uxbox/main/ui/shapes/common.cljs

@@ -17,7 +17,7 @@
    [uxbox.main.refs :as refs]
    [uxbox.main.store :as st]
    [uxbox.main.ui.keyboard :as kbd]
-   [uxbox.main.ui.workspace.streams :as uws]
+   [uxbox.main.streams :as uws]
    [uxbox.main.workers :as uwrk]
    [uxbox.util.geom.matrix :as gmt]
    [uxbox.util.geom.point :as gpt]

frontend/src/uxbox/main/ui/workspace.cljs

@@ -101,11 +101,11 @@
           (st/emit! (dw/initialize file-id page-id))
           #(st/emit! (dw/finalize file-id page-id)))})
 
-  ;; (mf/use-effect
+  (mf/use-effect
-  ;;  {:deps (mf/deps file-id)
+   {:deps (mf/deps file-id)
-  ;;   :fn (fn []
+    :fn (fn []
-  ;;         (st/emit! (dw/initialize-ws file-id))
+          (st/emit! (dw/initialize-ws file-id))
-  ;;         #(st/emit! (dw/finalize-ws file-id)))})
+          #(st/emit! (dw/finalize-ws file-id)))})
 
   ;; (mf/use-effect
   ;;  {:deps (mf/deps file-id page-id)

frontend/src/uxbox/main/ui/workspace/viewport.cljs

@@ -17,10 +17,10 @@
    [uxbox.main.geom :as geom]
    [uxbox.main.refs :as refs]
    [uxbox.main.store :as st]
+   [uxbox.main.streams :as ms]
    [uxbox.main.ui.keyboard :as kbd]
    [uxbox.main.ui.workspace.grid :refer [grid]]
    [uxbox.main.ui.workspace.ruler :refer [ruler]]
-   [uxbox.main.ui.workspace.streams :as uws]
    [uxbox.main.ui.workspace.drawarea :refer [start-drawing]]
 
    [uxbox.main.ui.shapes :refer [shape-wrapper]]
@@ -37,7 +37,7 @@
 
 (mf/defc coordinates
   [{:keys [zoom] :as props}]
-  (let [coords (some-> (use-rxsub uws/mouse-position)
+  (let [coords (some-> (use-rxsub ms/mouse-position)
                        (gpt/divide zoom)
                        (gpt/round 0))]
     [:ul.coordinates
@@ -102,10 +102,10 @@
     (ptk/reify ::handle-selrect
       ptk/WatchEvent
       (watch [_ state stream]
-        (let [stoper (rx/filter #(or (dw/interrupt? %) (uws/mouse-up? %)) stream)]
+        (let [stoper (rx/filter #(or (dw/interrupt? %) (ms/mouse-up? %)) stream)]
           (rx/concat
            (rx/of dw/deselect-all)
-           (->> uws/mouse-position
+           (->> ms/mouse-position
                 (rx/map (fn [pos] #(update-state % pos)))
                 (rx/take-until stoper))
            (rx/of dw/select-shapes-by-current-selrect
@@ -134,9 +134,9 @@
       ptk/EffectEvent
       (effect [_ state stream]
         (let [stoper (rx/filter #(= ::finish-positioning %) stream)
-              reference @uws/mouse-position
+              reference @ms/mouse-position
               dom (dom/get-element "workspace-viewport")]
-          (-> (rx/take-until stoper uws/mouse-position)
+          (-> (rx/take-until stoper ms/mouse-position)
               (rx/subscribe #(on-point dom reference %))))))))
 
 ;; --- Viewport
@@ -172,7 +172,7 @@
                     shift? (kbd/shift? event)
                     opts {:shift? shift?
                           :ctrl? ctrl?}]
-                (st/emit! (uws/mouse-event :down ctrl? shift?)))
+                (st/emit! (ms/->MouseEvent :down ctrl? shift?)))
               (when (not edition)
                 (if drawing-tool
                   (st/emit! (start-drawing drawing-tool))
@@ -185,7 +185,7 @@
                     shift? (kbd/shift? event)
                     opts {:shift? shift?
                           :ctrl? ctrl?}]
-                (st/emit! (uws/mouse-event :context-menu ctrl? shift?))))
+                (st/emit! (ms/->MouseEvent :context-menu ctrl? shift?))))
 
             (on-mouse-up [event]
               (dom/stop-propagation event)
@@ -193,7 +193,7 @@
                     shift? (kbd/shift? event)
                     opts {:shift? shift?
                           :ctrl? ctrl?}]
-                (st/emit! (uws/mouse-event :up ctrl? shift?))))
+                (st/emit! (ms/->MouseEvent :up ctrl? shift?))))
 
             (on-click [event]
               (dom/stop-propagation event)
@@ -201,7 +201,7 @@
                     shift? (kbd/shift? event)
                     opts {:shift? shift?
                           :ctrl? ctrl?}]
-                (st/emit! (uws/mouse-event :click ctrl? shift?))))
+                (st/emit! (ms/->MouseEvent :click ctrl? shift?))))
 
             (on-double-click [event]
               (dom/stop-propagation event)
@@ -209,7 +209,7 @@
                     shift? (kbd/shift? event)
                     opts {:shift? shift?
                           :ctrl? ctrl?}]
-                (st/emit! (uws/mouse-event :double-click ctrl? shift?))))
+                (st/emit! (ms/->MouseEvent :double-click ctrl? shift?))))
 
             (translate-point-to-viewport [pt]
               (let [viewport (mf/ref-node viewport-ref)
@@ -227,7 +227,7 @@
                           :shift? shift?
                           :ctrl? ctrl?}]
                 (when-not (.-repeat bevent)
-                  (st/emit! (uws/keyboard-event :down key ctrl? shift?))
+                  (st/emit! (ms/->KeyboardEvent :down key ctrl? shift?))
                   (when (kbd/space? event)
                     (st/emit! handle-viewport-positioning)
                     #_(st/emit! (dw/start-viewport-positioning))))))
@@ -241,13 +241,13 @@
                           :ctrl? ctrl?}]
                 (when (kbd/space? event)
                   (st/emit! ::finish-positioning #_(dw/stop-viewport-positioning)))
-                (st/emit! (uws/keyboard-event :up key ctrl? shift?))))
+                (st/emit! (ms/->KeyboardEvent :up key ctrl? shift?))))
 
             (on-mouse-move [event]
               (let [pt (gpt/point (.-clientX event)
                                   (.-clientY event))
                     pt (translate-point-to-viewport pt)]
-                (st/emit! (uws/->PointerEvent :viewport pt
+                (st/emit! (ms/->PointerEvent :viewport pt
                                               (kbd/ctrl? event)
                                               (kbd/shift? event)))))
 

frontend/src/uxbox/main/user_events.cljs

@@ -1,97 +0,0 @@
-;; 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) 2015-2017 Andrey Antukh <niwi@niwi.nz>
-
-(ns uxbox.main.user-events
-  "Workspace user (keyboard, mouse and pointer) events."
-  (:require [beicon.core :as rx]
-            [potok.core :as ptk]
-            [uxbox.util.geom.point :as gpt]))
-
-;; --- Keyboard Event
-
-(defrecord KeyboardEvent [type key shift ctrl])
-
-(defn keyboard-event
-  [type key ctrl shift]
-  {:pre [(keyword? type)
-         (integer? key)
-         (boolean? ctrl)
-         (boolean? shift)]}
-  (KeyboardEvent. type key ctrl shift))
-
-(defn keyboard-event?
-  [v]
-  (instance? KeyboardEvent v))
-
-;; --- Mouse Event
-
-(defrecord MouseEvent [type ctrl shift])
-
-(defn mouse-event
-  [type ctrl shift]
-  {:pre [(keyword? type)
-         (boolean? ctrl)
-         (boolean? shift)]}
-  (MouseEvent. type ctrl shift))
-
-(defn mouse-event?
-  [v]
-  (instance? MouseEvent v))
-
-(defn mouse-up?
-  [v]
-  (and (mouse-event? v)
-       (= :up (:type v))))
-
-(defn mouse-click?
-  [v]
-  (and (mouse-event? v)
-       (= :click (:type v))))
-
-;; --- Pointer Event
-
-(defrecord PointerEvent [window
-                         viewport
-                         canvas
-                         ctrl
-                         shift]
-  ptk/UpdateEvent
-  (update [it state]
-    (assoc-in state [:workspace :pointer] it)))
-
-(defn pointer-event
-  [window viewport canvas ctrl shift]
-  {:pre [(gpt/point? window)
-         (gpt/point? viewport)
-         (or (gpt/point? canvas)
-             (nil? canvas))
-         (boolean? ctrl)
-         (boolean? shift)]}
-  (PointerEvent. window
-                 viewport
-                 canvas
-                 ctrl
-                 shift))
-
-(defn pointer-event?
-  [v]
-  (instance? PointerEvent v))
-
-;; --- Scroll Event
-
-(defrecord ScrollEvent [point]
-  ptk/UpdateEvent
-  (update [_ state]
-    (assoc-in state [:workspace :scroll] point)))
-
-(defn scroll-event
-  [pt]
-  {:pre [(gpt/point? pt)]}
-  (ScrollEvent. pt))
-
-(defn scroll-event?
-  [v]
-  (instance? ScrollEvent v))