penpot/frontend/src/app/main/streams.cljs

;; 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 INC

(ns app.main.streams
  "User interaction events and streams."
  (:require
   [app.config :as cfg]
   [app.main.store :as st]
   [app.util.globals :as globals]
   [app.util.keyboard :as kbd]
   [beicon.core :as rx]))

;; --- 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])

(defn mouse-event?
  [v]
  (instance? MouseEvent v))

(defn mouse-down?
  [v]
  (and (mouse-event? v)
       (= :down (:type v))))

(defn mouse-up?
  [v]
  (and (mouse-event? v)
       (= :up (:type v))))

(defn mouse-click?
  [v]
  (and (mouse-event? v)
       (= :click (:type v))))

(defn mouse-double-click?
  [v]
  (and (mouse-event? v)
       (= :double-click (:type v))))

(defrecord PointerEvent [source pt ctrl shift alt meta])

(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))

(defonce mouse-position-meta
  (let [sub (rx/behavior-subject nil)
        ob  (->> st/stream
                 (rx/filter pointer-event?)
                 (rx/map :meta)
                 (rx/dedupe))]
    (rx/subscribe-with ob sub)
    sub))

(defonce mouse-position-mod
  (if (cfg/check-platform? :macos)
    mouse-position-meta
    mouse-position-ctrl))

(defonce mouse-position-shift
  (let [sub (rx/behavior-subject nil)
        ob  (->> st/stream
                 (rx/filter pointer-event?)
                 (rx/map :shift)
                 (rx/dedupe))]
    (rx/subscribe-with ob sub)
    sub))

(defonce mouse-position-alt
  (let [sub (rx/behavior-subject nil)
        ob  (->> st/stream
                 (rx/filter pointer-event?)
                 (rx/map :alt)
                 (rx/dedupe))]
    (rx/subscribe-with ob sub)
    sub))


(defonce window-blur
  (->> (rx/from-event globals/window "blur")
       (rx/share)))

(defonce keyboard-alt
  (let [sub (rx/behavior-subject nil)
        ob  (->> (rx/merge
                  (->> st/stream
                       (rx/filter keyboard-event?)
                       (rx/filter kbd/alt-key?)
                       (rx/map #(= :down (:type %))))
                  ;; Fix a situation caused by using `ctrl+alt` kind of shortcuts,
                  ;; that makes keyboard-alt stream registering the key pressed but
                  ;; on blurring the window (unfocus) the key down is never arrived.
                  (->> window-blur
                       (rx/map (constantly false))))
                 (rx/dedupe))]
    (rx/subscribe-with ob sub)
    sub))

(defonce keyboard-ctrl
  (let [sub (rx/behavior-subject nil)
        ob  (->> (rx/merge
                  (->> st/stream
                       (rx/filter keyboard-event?)
                       (rx/filter kbd/ctrl-key?)
                       (rx/map #(= :down (:type %))))
                  ;; Fix a situation caused by using `ctrl+alt` kind of shortcuts,
                  ;; that makes keyboard-alt stream registering the key pressed but
                  ;; on blurring the window (unfocus) the key down is never arrived.
                  (->> window-blur
                       (rx/map (constantly false))))
                 (rx/dedupe))]
    (rx/subscribe-with ob sub)
    sub))

(defonce keyboard-meta
  (let [sub (rx/behavior-subject nil)
        ob  (->> (rx/merge
                  (->> st/stream
                       (rx/filter keyboard-event?)
                       (rx/filter kbd/meta-key?)
                       (rx/map #(= :down (:type %))))
                  ;; Fix a situation caused by using `ctrl+alt` kind of shortcuts,
                  ;; that makes keyboard-alt stream registering the key pressed but
                  ;; on blurring the window (unfocus) the key down is never arrived.
                  (->> window-blur
                       (rx/map (constantly false))))
                 (rx/dedupe))]
    (rx/subscribe-with ob sub)
    sub))

(defonce keyboard-mod
  (if (cfg/check-platform? :macos)
    keyboard-meta
    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
  (let [sub (rx/behavior-subject nil)
        ob  (->> st/stream
                 (rx/filter keyboard-event?)
                 (rx/filter kbd/space?)
                 (rx/filter (comp not kbd/editing?))
                 (rx/map #(= :down (:type %)))
                 (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/subscribe-with ob sub)
    sub))