mirror of
https://github.com/penpot/penpot.git
synced 2025-03-12 15:51:37 -05:00
391 lines
13 KiB
Clojure
391 lines
13 KiB
Clojure
;; 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/.
|
|
;;
|
|
;; This Source Code Form is "Incompatible With Secondary Licenses", as
|
|
;; defined by the Mozilla Public License, v. 2.0.
|
|
;;
|
|
;; Copyright (c) 2020 UXBOX Labs SL
|
|
|
|
(ns app.main.data.workspace.selection
|
|
(:require
|
|
[beicon.core :as rx]
|
|
[cljs.spec.alpha :as s]
|
|
[potok.core :as ptk]
|
|
[linked.set :as lks]
|
|
[app.common.data :as d]
|
|
[app.common.geom.point :as gpt]
|
|
[app.common.geom.shapes :as geom]
|
|
[app.common.math :as mth]
|
|
[app.common.pages :as cp]
|
|
[app.common.pages-helpers :as cph]
|
|
[app.common.spec :as us]
|
|
[app.common.uuid :as uuid]
|
|
[app.main.data.workspace.common :as dwc]
|
|
[app.main.data.modal :as md]
|
|
[app.main.streams :as ms]
|
|
[app.main.worker :as uw]))
|
|
|
|
(s/def ::set-of-uuid
|
|
(s/every uuid? :kind set?))
|
|
|
|
(s/def ::ordered-set-of-uuid
|
|
(s/every uuid? :kind d/ordered-set?))
|
|
|
|
(s/def ::set-of-string
|
|
(s/every string? :kind set?))
|
|
|
|
;; --- Selection Rect
|
|
|
|
(declare select-shapes-by-current-selrect)
|
|
(declare deselect-all)
|
|
|
|
(defn update-selrect
|
|
[selrect]
|
|
(ptk/reify ::update-selrect
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(assoc-in state [:workspace-local :selrect] selrect))))
|
|
|
|
(def handle-selection
|
|
(letfn [(data->selrect [data]
|
|
(let [start (:start data)
|
|
stop (:stop data)
|
|
start-x (min (:x start) (:x stop))
|
|
start-y (min (:y start) (:y stop))
|
|
end-x (max (:x start) (:x stop))
|
|
end-y (max (:y start) (:y stop))]
|
|
{:type :rect
|
|
:x start-x
|
|
:y start-y
|
|
:width (mth/abs (- end-x start-x))
|
|
:height (mth/abs (- end-y start-y))}))]
|
|
(ptk/reify ::handle-selection
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
(let [stoper (rx/filter #(or (dwc/interrupt? %)
|
|
(ms/mouse-up? %))
|
|
stream)]
|
|
(rx/concat
|
|
(rx/of (deselect-all))
|
|
(->> ms/mouse-position
|
|
(rx/scan (fn [data pos]
|
|
(if data
|
|
(assoc data :stop pos)
|
|
{:start pos :stop pos}))
|
|
nil)
|
|
(rx/map data->selrect)
|
|
(rx/filter #(or (> (:width %) 10)
|
|
(> (:height %) 10)))
|
|
(rx/map update-selrect)
|
|
(rx/take-until stoper))
|
|
(rx/of select-shapes-by-current-selrect)))))))
|
|
|
|
;; --- Toggle shape's selection status (selected or deselected)
|
|
|
|
(defn select-shape
|
|
([id] (select-shape id false))
|
|
([id toggle?]
|
|
(us/verify ::us/uuid id)
|
|
(ptk/reify ::select-shape
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(update-in state [:workspace-local :selected]
|
|
(fn [selected]
|
|
(if-not toggle?
|
|
(conj selected id)
|
|
(if (contains? selected id)
|
|
(disj selected id)
|
|
(conj selected id))))))
|
|
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
(let [page-id (:current-page-id state)
|
|
objects (dwc/lookup-page-objects state page-id)]
|
|
(rx/of (dwc/expand-all-parents [id] objects)))))))
|
|
|
|
(defn select-shapes
|
|
[ids]
|
|
(us/verify ::ordered-set-of-uuid ids)
|
|
(ptk/reify ::select-shapes
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(assoc-in state [:workspace-local :selected] ids))
|
|
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
(let [page-id (:current-page-id state)
|
|
objects (dwc/lookup-page-objects state page-id)]
|
|
(rx/of (dwc/expand-all-parents ids objects))))))
|
|
|
|
(defn deselect-all
|
|
"Clear all possible state of drawing, edition
|
|
or any similar action taken by the user.
|
|
When `check-modal` the method will check if a modal is opened
|
|
and not deselect if it's true"
|
|
([] (deselect-all false))
|
|
|
|
([check-modal]
|
|
(ptk/reify ::deselect-all
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
|
|
;; Only deselect if there is no modal openned
|
|
(cond-> state
|
|
(or (not check-modal)
|
|
(not (::md/modal state)))
|
|
(update :workspace-local
|
|
#(-> %
|
|
(assoc :selected (d/ordered-set))
|
|
(dissoc :selected-frame))))))))
|
|
|
|
;; --- Select Shapes (By selrect)
|
|
|
|
(def select-shapes-by-current-selrect
|
|
(ptk/reify ::select-shapes-by-current-selrect
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
(let [page-id (:current-page-id state)
|
|
selrect (get-in state [:workspace-local :selrect])
|
|
is-not-blocked (fn [shape-id] (not (get-in state [:workspace-data
|
|
:pages-index page-id
|
|
:objects shape-id
|
|
:blocked] false)))]
|
|
(rx/merge
|
|
(rx/of (update-selrect nil))
|
|
(when selrect
|
|
(->> (uw/ask! {:cmd :selection/query
|
|
:page-id page-id
|
|
:rect selrect})
|
|
(rx/map #(into lks/empty-linked-set (filter is-not-blocked) %))
|
|
(rx/map select-shapes))))))))
|
|
|
|
(defn select-inside-group
|
|
[group-id position]
|
|
(ptk/reify ::select-inside-group
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
(let [page-id (:current-page-id state)
|
|
objects (dwc/lookup-page-objects state page-id)
|
|
group (get objects group-id)
|
|
children (map #(get objects %) (:shapes group))
|
|
|
|
;; We need to reverse the children because if two children
|
|
;; overlap we want to select the one that's over (and it's
|
|
;; in the later vector position
|
|
selected (->> children
|
|
reverse
|
|
(d/seek #(geom/has-point? % position)))]
|
|
(when selected
|
|
(rx/of (deselect-all) (select-shape (:id selected))))))))
|
|
|
|
|
|
;; --- Group shapes
|
|
|
|
(defn shapes-for-grouping
|
|
[objects selected]
|
|
(->> selected
|
|
(map #(get objects %))
|
|
(filter #(not= :frame (:type %)))
|
|
(map #(assoc % ::index (cph/position-on-parent (:id %) objects)))
|
|
(sort-by ::index)))
|
|
|
|
(defn- make-group
|
|
[shapes prefix keep-name]
|
|
(let [selrect (geom/selection-rect shapes)
|
|
frame-id (-> shapes first :frame-id)
|
|
parent-id (-> shapes first :parent-id)
|
|
group-name (if (and keep-name
|
|
(= (count shapes) 1)
|
|
(= (:type (first shapes)) :group))
|
|
(:name (first shapes))
|
|
(name (gensym prefix)))]
|
|
(-> (cp/make-minimal-group frame-id selrect group-name)
|
|
(geom/setup selrect)
|
|
(assoc :shapes (map :id shapes)))))
|
|
|
|
(defn prepare-create-group
|
|
[page-id shapes prefix keep-name]
|
|
(let [group (make-group shapes prefix keep-name)
|
|
rchanges [{:type :add-obj
|
|
:id (:id group)
|
|
:page-id page-id
|
|
:frame-id (:frame-id (first shapes))
|
|
:parent-id (:parent-id (first shapes))
|
|
:obj group
|
|
:index (::index (first shapes))}
|
|
{:type :mov-objects
|
|
:page-id page-id
|
|
:parent-id (:id group)
|
|
:shapes (map :id shapes)}]
|
|
|
|
uchanges (conj
|
|
(map (fn [obj] {:type :mov-objects
|
|
:page-id page-id
|
|
:parent-id (:parent-id obj)
|
|
:index (::index obj)
|
|
:shapes [(:id obj)]})
|
|
shapes)
|
|
{:type :del-obj
|
|
:id (:id group)
|
|
:page-id page-id})]
|
|
[group rchanges uchanges]))
|
|
|
|
(defn prepare-remove-group
|
|
[page-id group objects]
|
|
(let [shapes (:shapes group)
|
|
parent-id (cph/get-parent (:id group) objects)
|
|
parent (get objects parent-id)
|
|
index-in-parent (->> (:shapes parent)
|
|
(map-indexed vector)
|
|
(filter #(#{(:id group)} (second %)))
|
|
(ffirst))
|
|
rchanges [{:type :mov-objects
|
|
:page-id page-id
|
|
:parent-id parent-id
|
|
:shapes shapes
|
|
:index index-in-parent}
|
|
{:type :del-obj
|
|
:page-id page-id
|
|
:id (:id group)}]
|
|
uchanges [{:type :add-obj
|
|
:page-id page-id
|
|
:id (:id group)
|
|
:frame-id (:frame-id group)
|
|
:obj (assoc group :shapes [])}
|
|
{:type :mov-objects
|
|
:page-id page-id
|
|
:parent-id (:id group)
|
|
:shapes shapes}
|
|
{:type :mov-objects
|
|
:page-id page-id
|
|
:parent-id parent-id
|
|
:shapes [(:id group)]
|
|
:index index-in-parent}]]
|
|
[rchanges uchanges]))
|
|
|
|
|
|
;; --- Duplicate Shapes
|
|
(declare prepare-duplicate-change)
|
|
(declare prepare-duplicate-frame-change)
|
|
(declare prepare-duplicate-shape-change)
|
|
|
|
(def ^:private change->name #(get-in % [:obj :name]))
|
|
|
|
(defn prepare-duplicate-changes
|
|
"Prepare objects to paste: generate new id, give them unique names,
|
|
move to the position of mouse pointer, and find in what frame they
|
|
fit."
|
|
[objects page-id names ids delta]
|
|
(loop [names names
|
|
ids (seq ids)
|
|
chgs []]
|
|
(if ids
|
|
(let [id (first ids)
|
|
result (prepare-duplicate-change objects page-id names id delta)
|
|
result (if (vector? result) result [result])]
|
|
(recur
|
|
(into names (map change->name) result)
|
|
(next ids)
|
|
(into chgs result)))
|
|
chgs)))
|
|
|
|
(defn- prepare-duplicate-change
|
|
[objects page-id names id delta]
|
|
(let [obj (get objects id)]
|
|
(if (= :frame (:type obj))
|
|
(prepare-duplicate-frame-change objects page-id names obj delta)
|
|
(prepare-duplicate-shape-change objects page-id names obj delta (:frame-id obj) (:parent-id obj)))))
|
|
|
|
(defn- prepare-duplicate-shape-change
|
|
[objects page-id names obj delta frame-id parent-id]
|
|
(let [id (uuid/next)
|
|
name (dwc/generate-unique-name names (:name obj))
|
|
renamed-obj (assoc obj :id id :name name)
|
|
moved-obj (geom/move renamed-obj delta)
|
|
frames (cph/select-frames objects)
|
|
parent-id (or parent-id frame-id)
|
|
|
|
children-changes
|
|
(loop [names names
|
|
result []
|
|
cid (first (:shapes obj))
|
|
cids (rest (:shapes obj))]
|
|
(if (nil? cid)
|
|
result
|
|
(let [obj (get objects cid)
|
|
changes (prepare-duplicate-shape-change objects page-id names obj delta frame-id id)]
|
|
(recur
|
|
(into names (map change->name changes))
|
|
(into result changes)
|
|
(first cids)
|
|
(rest cids)))))
|
|
|
|
reframed-obj (-> moved-obj
|
|
(assoc :frame-id frame-id)
|
|
(dissoc :shapes))]
|
|
(into [{:type :add-obj
|
|
:id id
|
|
:page-id page-id
|
|
:old-id (:id obj)
|
|
:frame-id frame-id
|
|
:parent-id parent-id
|
|
:obj (dissoc reframed-obj :shapes)}]
|
|
children-changes)))
|
|
|
|
(defn- prepare-duplicate-frame-change
|
|
[objects page-id names obj delta]
|
|
(let [frame-id (uuid/next)
|
|
frame-name (dwc/generate-unique-name names (:name obj))
|
|
sch (->> (map #(get objects %) (:shapes obj))
|
|
(mapcat #(prepare-duplicate-shape-change objects page-id names % delta frame-id frame-id)))
|
|
|
|
frame (-> obj
|
|
(assoc :id frame-id)
|
|
(assoc :name frame-name)
|
|
(assoc :frame-id uuid/zero)
|
|
(dissoc :shapes)
|
|
(geom/move delta))
|
|
|
|
fch {:type :add-obj
|
|
:old-id (:id obj)
|
|
:page-id page-id
|
|
:id frame-id
|
|
:frame-id uuid/zero
|
|
:obj frame}]
|
|
|
|
(into [fch] sch)))
|
|
|
|
(def duplicate-selected
|
|
(ptk/reify ::duplicate-selected
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
(let [page-id (:current-page-id state)
|
|
objects (dwc/lookup-page-objects state page-id)
|
|
|
|
selected (get-in state [:workspace-local :selected])
|
|
delta (gpt/point 0 0)
|
|
unames (dwc/retrieve-used-names objects)
|
|
|
|
rchanges (prepare-duplicate-changes objects page-id unames selected delta)
|
|
uchanges (mapv #(array-map :type :del-obj :page-id page-id :id (:id %))
|
|
(reverse rchanges))
|
|
|
|
selected (->> rchanges
|
|
(filter #(selected (:old-id %)))
|
|
(map #(get-in % [:obj :id]))
|
|
(into (d/ordered-set)))]
|
|
|
|
(rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true})
|
|
(select-shapes selected))))))
|
|
|
|
(defn change-hover-state
|
|
[id value]
|
|
(letfn [(update-hover [items]
|
|
(if value
|
|
(conj items id)
|
|
(disj items id)))]
|
|
(ptk/reify ::change-hover-state
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(update-in state [:workspace-local :hover] (fnil update-hover #{}))))))
|