Add performance oriented refactor for keyboard streams

This commit is contained in:
Andrey Antukh 2023-11-28 10:40:24 +01:00
parent 9bb2c79ef8
commit b6ef21e121
5 changed files with 135 additions and 129 deletions

View file

@ -33,6 +33,7 @@
[app.main.snap :as snap] [app.main.snap :as snap]
[app.main.streams :as ms] [app.main.streams :as ms]
[app.util.dom :as dom] [app.util.dom :as dom]
[app.util.keyboard :as kbd]
[beicon.core :as rx] [beicon.core :as rx]
[potok.core :as ptk])) [potok.core :as ptk]))
@ -673,7 +674,8 @@
(rx/switch-map #(rx/merge (rx/switch-map #(rx/merge
(rx/timer 1000) (rx/timer 1000)
(->> stream (->> stream
(rx/filter ms/key-up?) (rx/filter kbd/keyboard-event?)
(rx/filter kbd/key-up-event?)
(rx/delay 250)))) (rx/delay 250))))
(rx/take 1)) (rx/take 1))

View file

@ -15,23 +15,9 @@
;; --- User Events ;; --- User Events
(defrecord KeyboardEvent [type key shift ctrl alt meta editing event])
(defn keyboard-event?
[v]
(instance? KeyboardEvent v))
(defn key-up?
[v]
(and (keyboard-event? v)
(= :up (:type v))))
(defn key-down?
[v]
(and (keyboard-event? v)
(= :down (:type v))))
(defrecord MouseEvent [type ctrl shift alt meta]) (defrecord MouseEvent [type ctrl shift alt meta])
(defrecord PointerEvent [source pt ctrl shift alt meta])
(defrecord ScrollEvent [point])
(defn mouse-event? (defn mouse-event?
[v] [v]
@ -57,21 +43,17 @@
(and (mouse-event? v) (and (mouse-event? v)
(= :double-click (:type v)))) (= :double-click (:type v))))
(defrecord PointerEvent [source pt ctrl shift alt meta])
(defn pointer-event? (defn pointer-event?
[v] [v]
(instance? PointerEvent v)) (instance? PointerEvent v))
(defrecord ScrollEvent [point])
(defn scroll-event? (defn scroll-event?
[v] [v]
(instance? ScrollEvent v)) (instance? ScrollEvent v))
(defn interaction-event? (defn interaction-event?
[event] [event]
(or (keyboard-event? event) (or (kbd/keyboard-event? event)
(mouse-event? event))) (mouse-event? event)))
;; --- Derived streams ;; --- Derived streams
@ -126,55 +108,54 @@
(rx/subscribe-with ob sub) (rx/subscribe-with ob sub)
sub)) sub))
(defonce ^:private window-blur
(defonce window-blur
(->> (rx/from-event globals/window "blur") (->> (rx/from-event globals/window "blur")
(rx/map (constantly false))
(rx/share)))
(defonce keyboard
(->> st/stream
(rx/filter kbd/keyboard-event?)
(rx/share))) (rx/share)))
(defonce keyboard-alt (defonce keyboard-alt
(let [sub (rx/behavior-subject nil) (let [sub (rx/behavior-subject nil)
ob (->> (rx/merge ob (->> keyboard
(->> st/stream (rx/filter kbd/alt-key?)
(rx/filter keyboard-event?) (rx/map kbd/key-down-event?)
(rx/filter kbd/alt-key?) ;; Fix a situation caused by using `ctrl+alt` kind of
(rx/map #(= :down (:type %)))) ;; shortcuts, that makes keyboard-alt stream
;; Fix a situation caused by using `ctrl+alt` kind of shortcuts, ;; registering the key pressed but on blurring the
;; that makes keyboard-alt stream registering the key pressed but ;; window (unfocus) the key down is never arrived.
;; on blurring the window (unfocus) the key down is never arrived. (rx/merge window-blur)
(->> window-blur
(rx/map (constantly false))))
(rx/dedupe))] (rx/dedupe))]
(rx/subscribe-with ob sub) (rx/subscribe-with ob sub)
sub)) sub))
(defonce keyboard-ctrl (defonce keyboard-ctrl
(let [sub (rx/behavior-subject nil) (let [sub (rx/behavior-subject nil)
ob (->> (rx/merge ob (->> keyboard
(->> st/stream (rx/filter kbd/ctrl-key?)
(rx/filter keyboard-event?) (rx/map kbd/key-down-event?)
(rx/filter kbd/ctrl-key?) ;; Fix a situation caused by using `ctrl+alt` kind of
(rx/map #(= :down (:type %)))) ;; shortcuts, that makes keyboard-alt stream
;; Fix a situation caused by using `ctrl+alt` kind of shortcuts, ;; registering the key pressed but on blurring the
;; that makes keyboard-alt stream registering the key pressed but ;; window (unfocus) the key down is never arrived.
;; on blurring the window (unfocus) the key down is never arrived. (rx/merge window-blur)
(->> window-blur
(rx/map (constantly false))))
(rx/dedupe))] (rx/dedupe))]
(rx/subscribe-with ob sub) (rx/subscribe-with ob sub)
sub)) sub))
(defonce keyboard-meta (defonce keyboard-meta
(let [sub (rx/behavior-subject nil) (let [sub (rx/behavior-subject nil)
ob (->> (rx/merge ob (->> keyboard
(->> st/stream (rx/filter kbd/meta-key?)
(rx/filter keyboard-event?) (rx/map kbd/key-down-event?)
(rx/filter kbd/meta-key?) ;; Fix a situation caused by using `ctrl+alt` kind of
(rx/map #(= :down (:type %)))) ;; shortcuts, that makes keyboard-alt stream
;; Fix a situation caused by using `ctrl+alt` kind of shortcuts, ;; registering the key pressed but on blurring the
;; that makes keyboard-alt stream registering the key pressed but ;; window (unfocus) the key down is never arrived.
;; on blurring the window (unfocus) the key down is never arrived. (rx/merge window-blur)
(->> window-blur
(rx/map (constantly false))))
(rx/dedupe))] (rx/dedupe))]
(rx/subscribe-with ob sub) (rx/subscribe-with ob sub)
sub)) sub))
@ -184,57 +165,12 @@
keyboard-meta keyboard-meta
keyboard-ctrl)) keyboard-ctrl))
(defonce keyboard-minus-or-underscore
(let [sub (rx/behavior-subject nil)
ob (->> st/stream
(rx/filter keyboard-event?)
(rx/filter key-down?)
(rx/filter #(kbd/mod? (:event %)))
(rx/filter #(or (kbd/minus? %) (kbd/underscore? %)))
(rx/dedupe))]
(rx/subscribe-with ob sub)
sub))
(defonce keyboard-=-or-+
(let [sub (rx/behavior-subject nil)
ob (->> st/stream
(rx/filter keyboard-event?)
(rx/filter key-down?)
(rx/filter #(kbd/mod? (:event %)))
(rx/filter #(or (kbd/equals? %) (kbd/plus? %)))
(rx/dedupe))]
(rx/subscribe-with ob sub)
sub))
(defonce keyboard-space (defonce keyboard-space
(let [sub (rx/behavior-subject nil) (let [sub (rx/behavior-subject nil)
ob (->> st/stream ob (->> keyboard
(rx/filter keyboard-event?)
(rx/filter kbd/space?) (rx/filter kbd/space?)
(rx/filter (comp not kbd/editing?)) (rx/filter (complement kbd/editing-event?))
(rx/map #(= :down (:type %))) (rx/map kbd/key-down-event?)
(rx/dedupe))]
(rx/subscribe-with ob sub)
sub))
(defonce keyboard-z
(let [sub (rx/behavior-subject nil)
ob (->> st/stream
(rx/filter keyboard-event?)
(rx/filter kbd/z?)
(rx/filter (comp not kbd/editing?))
(rx/map #(= :down (:type %)))
(rx/dedupe))]
(rx/subscribe-with ob sub)
sub))
(defonce keyboard-shift
(let [sub (rx/behavior-subject nil)
ob (->> st/stream
(rx/filter keyboard-event?)
(rx/filter kbd/shift-key?)
(rx/filter (comp not kbd/editing?))
(rx/map #(= :down (:type %)))
(rx/dedupe))] (rx/dedupe))]
(rx/subscribe-with ob sub) (rx/subscribe-with ob sub)
sub)) sub))

View file

@ -314,29 +314,33 @@
shift? (kbd/shift? event) shift? (kbd/shift? event)
alt? (kbd/alt? event) alt? (kbd/alt? event)
meta? (kbd/meta? event) meta? (kbd/meta? event)
mod? (kbd/mod? event)
target (dom/get-target event) target (dom/get-target event)
editing? (or (some? (.closest ^js target ".public-DraftEditor-content")) editing? (or (some? (.closest ^js target ".public-DraftEditor-content"))
(= "rich-text" (obj/get target "className")) (= "rich-text" (obj/get target "className"))
(= "INPUT" (obj/get target "tagName")) (= "INPUT" (obj/get target "tagName"))
(= "TEXTAREA" (obj/get target "tagName")))] (= "TEXTAREA" (obj/get target "tagName")))]
(when-not (.-repeat bevent) (when-not (.-repeat bevent)
(st/emit! (ms/->KeyboardEvent :down key shift? ctrl? alt? meta? editing? event))))))) (st/emit! (kbd/->KeyboardEvent :down key shift? ctrl? alt? meta? mod? editing? event)))))))
(defn on-key-up [] (defn on-key-up []
(mf/use-callback (mf/use-callback
(fn [event] (fn [event]
(let [key (.-key event) (let [key (.-key event)
ctrl? (kbd/ctrl? event) ctrl? (kbd/ctrl? event)
shift? (kbd/shift? event) shift? (kbd/shift? event)
alt? (kbd/alt? event) alt? (kbd/alt? event)
meta? (kbd/meta? event) meta? (kbd/meta? event)
mod? (kbd/mod? event)
target (dom/get-target event) target (dom/get-target event)
editing? (or (some? (.closest ^js target ".public-DraftEditor-content")) editing? (or (some? (.closest ^js target ".public-DraftEditor-content"))
(= "rich-text" (obj/get target "className")) (= "rich-text" (obj/get target "className"))
(= "INPUT" (obj/get target "tagName")) (= "INPUT" (obj/get target "tagName"))
(= "TEXTAREA" (obj/get target "tagName")))] (= "TEXTAREA" (obj/get target "tagName")))]
(st/emit! (ms/->KeyboardEvent :up key shift? ctrl? alt? meta? editing? event)))))) (st/emit! (kbd/->KeyboardEvent :up key shift? ctrl? alt? meta? mod? editing? event))))))
(defn on-pointer-move [move-stream] (defn on-pointer-move [move-stream]
(let [last-position (mf/use-var nil)] (let [last-position (mf/use-var nil)]

View file

@ -31,6 +31,7 @@
[app.util.debug :as dbg] [app.util.debug :as dbg]
[app.util.dom :as dom] [app.util.dom :as dom]
[app.util.globals :as globals] [app.util.globals :as globals]
[app.util.keyboard :as kbd]
[beicon.core :as rx] [beicon.core :as rx]
[goog.events :as events] [goog.events :as events]
[rumext.v2 :as mf]) [rumext.v2 :as mf])
@ -99,20 +100,57 @@
(when (not= @cursor new-cursor) (when (not= @cursor new-cursor)
(reset! cursor new-cursor)))))) (reset! cursor new-cursor))))))
(defn setup-keyboard [alt? mod? space? z? shift?] (defn setup-keyboard
(hooks/use-stream ms/keyboard-alt #(reset! alt? %)) [alt* mod* space* z* shift*]
(hooks/use-stream ms/keyboard-mod #(do (let [kbd-zoom-s
(reset! mod? %) (mf/with-memo []
(when-not % (reset! z? false)))) ;; In mac after command+z there is no event for the release of the z key (->> ms/keyboard
(hooks/use-stream ms/keyboard-space #(reset! space? %)) (rx/filter kbd/key-down-event?)
(hooks/use-stream ms/keyboard-=-or-+ #(do (rx/filter kbd/mod-event?)
(dom/prevent-default (:event %)) (rx/filter (fn [kevent]
(st/emit! (dw/increase-zoom)))) (or ^boolean (kbd/minus? kevent)
(hooks/use-stream ms/keyboard-minus-or-underscore #(do ^boolean (kbd/underscore? kevent)
(dom/prevent-default (:event %)) ^boolean (kbd/equals? kevent)
(st/emit! (dw/decrease-zoom)))) ^boolean (kbd/plus? kevent))))
(hooks/use-stream ms/keyboard-z #(reset! z? %)) (rx/dedupe)))
(hooks/use-stream ms/keyboard-shift #(reset! shift? %)))
kbd-shift-s
(mf/with-memo []
(->> ms/keyboard
(rx/filter kbd/shift-key?)
(rx/filter (complement kbd/editing-event?))
(rx/map kbd/key-down-event?)
(rx/dedupe)))
kbd-z-s
(mf/with-memo []
(->> ms/keyboard
(rx/filter kbd/z?)
(rx/filter (complement kbd/editing-event?))
(rx/map kbd/key-down-event?)
(rx/dedupe)))]
(hooks/use-stream ms/keyboard-alt (partial reset! alt*))
(hooks/use-stream ms/keyboard-space (partial reset! space*))
(hooks/use-stream kbd-z-s (partial reset! z*))
(hooks/use-stream kbd-shift-s (partial reset! shift*))
(hooks/use-stream ms/keyboard-mod
(fn [value]
(reset! mod* value)
;; In mac after command+z there is no event
;; for the release of the z key
(when-not ^boolean value
(reset! z* false))))
(hooks/use-stream kbd-zoom-s
(fn [kevent]
(dom/prevent-default kevent)
(st/emit!
(if (or ^boolean (kbd/minus? kevent)
^boolean (kbd/underscore? kevent))
(dw/decrease-zoom)
(dw/increase-zoom)))))))
(defn group-empty-space? (defn group-empty-space?
"Given a group `group-id` check if `hover-ids` contains any of its children. If it doesn't means "Given a group `group-id` check if `hover-ids` contains any of its children. If it doesn't means

View file

@ -9,15 +9,44 @@
[app.config :as cfg] [app.config :as cfg]
[cuerdas.core :as str])) [cuerdas.core :as str]))
(defrecord KeyboardEvent [type key shift ctrl alt meta mod editing native-event]
Object
(preventDefault [_]
(.preventDefault native-event))
(stopPropagation [_]
(.stopPropagation native-event)))
(defn keyboard-event?
[o]
(instance? KeyboardEvent o))
(defn key-up-event?
[^KeyboardEvent event]
(= :up (.-type event)))
(defn key-down-event?
[^KeyboardEvent event]
(= :down (.-type event)))
(defn mod-event?
[^KeyboardEvent event]
(true? (.-mod event)))
(defn editing-event?
[^KeyboardEvent event]
(true? (.-editing event)))
(defn is-key? (defn is-key?
[^string key] [^string key]
(fn [^js e] (fn [^KeyboardEvent e]
(= (.-key e) key))) (= (.-key e) key)))
(defn is-key-ignore-case? (defn is-key-ignore-case?
[^string key] [^string key]
(fn [^js e] (let [key (str/upper key)]
(= (str/upper (.-key e)) (str/upper key)))) (fn [^KeyboardEvent e]
(= (str/upper (.-key e)) key))))
(defn ^boolean alt? (defn ^boolean alt?
[^js event] [^js event]
@ -62,6 +91,3 @@
(def home? (is-key? "Home")) (def home? (is-key? "Home"))
(def tab? (is-key? "Tab")) (def tab? (is-key? "Tab"))
(defn editing? [e]
(.-editing ^js e))