penpot/frontend/src/app/main/data/workspace/path/selection.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.data.workspace.path.selection
  (:require
   [app.common.data.macros :as dm]
   [app.common.geom.point :as gpt]
   [app.common.geom.rect :as grc]
   [app.common.geom.shapes :as gsh]
   [app.main.data.workspace.common :as dwc]
   [app.main.data.workspace.path.state :as st]
   [app.main.streams :as ms]
   [app.util.mouse :as mse]
   [beicon.v2.core :as rx]
   [potok.v2.core :as ptk]))

(defn path-pointer-enter [position]
  (ptk/reify ::path-pointer-enter
    ptk/UpdateEvent
    (update [_ state]
      (let [id (st/get-path-id state)]
        (update-in state [:workspace-local :edit-path id :hover-points] (fnil conj #{}) position)))))

(defn path-pointer-leave [position]
  (ptk/reify ::path-pointer-leave
    ptk/UpdateEvent
    (update [_ state]
      (let [id (st/get-path-id state)]
        (update-in state [:workspace-local :edit-path id :hover-points] disj position)))))

(defn path-handler-enter [index prefix]
  (ptk/reify ::path-handler-enter
    ptk/UpdateEvent
    (update [_ state]
      (let [id (st/get-path-id state)]
        (update-in state [:workspace-local :edit-path id :hover-handlers] (fnil conj #{}) [index prefix])))))

(defn path-handler-leave [index prefix]
  (ptk/reify ::path-handler-leave
    ptk/UpdateEvent
    (update [_ state]
      (let [id (st/get-path-id state)]
        (update-in state [:workspace-local :edit-path id :hover-handlers] disj [index prefix])))))

(defn select-node-area
  [shift?]
  (ptk/reify ::select-node-area
    ptk/UpdateEvent
    (update [_ state]
      (let [selrect         (dm/get-in state [:workspace-local :selrect])
            id              (dm/get-in state [:workspace-local :edition])
            content         (st/get-path state :content)

            selected-point? (if (some? selrect)
                              (partial gsh/has-point-rect? selrect)
                              (constantly false))

            selected-points (dm/get-in state [:workspace-local :edit-path id :selected-points])
            selected-points (or selected-points #{})

            xform           (comp (filter #(not (= (:command %) :close-path)))
                                  (map (comp gpt/point :params))
                                  (filter selected-point?))
            positions       (into (if shift? selected-points #{}) xform content)]

        (cond-> state
          (some? id)
          (assoc-in [:workspace-local :edit-path id :selected-points] positions))))))

(defn select-node [position shift?]
  (ptk/reify ::select-node
    ptk/UpdateEvent
    (update [_ state]
      (let [id (get-in state [:workspace-local :edition])
            selected-points (or (get-in state [:workspace-local :edit-path id :selected-points]) #{})
            selected-points (cond
                              (and shift? (contains? selected-points position))
                              (disj selected-points position)

                              shift?
                              (conj selected-points position)

                              :else
                              #{position})]
        (cond-> state
          (some? id)
          (assoc-in [:workspace-local :edit-path id :selected-points] selected-points))))))

(defn deselect-all []
  (ptk/reify ::deselect-all
    ptk/UpdateEvent
    (update [_ state]
      (let [id (st/get-path-id state)]
        (-> state
            (assoc-in [:workspace-local :edit-path id :selected-points] #{}))))))

(defn update-area-selection
  [rect]
  (ptk/reify ::update-area-selection
    ptk/UpdateEvent
    (update [_ state]
      (assoc-in state [:workspace-local :selrect] rect))))

(defn clear-area-selection
  []
  (ptk/reify ::clear-area-selection
    ptk/UpdateEvent
    (update [_ state]
      (update state :workspace-local dissoc :selrect))))

(defn handle-area-selection
  [shift?]
  (letfn [(valid-rect? [zoom {width :width height :height}]
            (or (> width (/ 10 zoom)) (> height (/ 10 zoom))))]

    (ptk/reify ::handle-area-selection
      ptk/WatchEvent
      (watch [_ state stream]
        (let [zoom   (get-in state [:workspace-local :zoom] 1)
              stopper (rx/merge
                       (->> stream
                            (rx/filter mse/mouse-event?)
                            (rx/filter mse/mouse-up-event?))
                       (->> stream
                            (rx/filter dwc/interrupt?)))

              from-p @ms/mouse-position]
          (rx/concat
           (->> ms/mouse-position
                (rx/map #(grc/points->rect [from-p %]))
                (rx/filter (partial valid-rect? zoom))
                (rx/map update-area-selection)
                (rx/take-until stopper))

           (rx/of (select-node-area shift?)
                  (clear-area-selection))))))))

(defn update-selection
  [point-change]
  (ptk/reify ::update-selection
    ptk/UpdateEvent
    (update [_ state]
      (let [id (st/get-path-id state)
            selected-points (get-in state [:workspace-local :edit-path id :selected-points] #{})
            selected-points (into #{} (map point-change) selected-points)]
        (-> state
            (assoc-in [:workspace-local :edit-path id :selected-points] selected-points))))))