Merge pull request #156 from uxbox/183-copy-paste

183 copy paste
This commit is contained in:
Andrey Antukh 2020-04-01 09:58:26 +02:00 committed by GitHub
commit 317895d39d
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23

View file

@ -930,26 +930,33 @@
;; --- Add shape to Workspace ;; --- Add shape to Workspace
(defn impl-retrieve-used-names (defn impl-retrieve-used-names
"Returns a set of already used names by shapes [objects]
in the current workspace page." (into #{} (map :name) (vals objects)))
[state]
(let [page-id (::page-id state) (defn extract-numeric-suffix
objects (get-in state [:workspace-data page-id :objects])] [basename]
(into #{} (map :name) (vals objects)))) (if-let [[match p1 p2] (re-find #"(.*)-([0-9]+)$" basename)]
[p1 (+ 1 (d/parse-integer p2))]
[basename 1]))
(defn impl-generate-unique-name (defn impl-generate-unique-name
"A unique name generator based on the current workspace page." "A unique name generator"
[state basename] [objects basename]
(let [used (impl-retrieve-used-names state)] (let [used (impl-retrieve-used-names objects)
(loop [counter 1] [prefix initial] (extract-numeric-suffix basename)]
(let [candidate (str basename "-" counter)] (loop [counter initial]
(let [candidate (str prefix "-" counter)]
(if (contains? used candidate) (if (contains? used candidate)
(recur (inc counter)) (recur (inc counter))
candidate))))) candidate)))))
(defn impl-assoc-shape (defn impl-assoc-shape
"Add a shape to the current workspace page, inside a given frame.
Give it a name that is unique in the page"
[state {:keys [id frame-id] :as data}] [state {:keys [id frame-id] :as data}]
(let [name (impl-generate-unique-name state (:name data)) (let [page-id (::page-id state)
objects (get-in state [:workspace-data page-id :objects])
name (impl-generate-unique-name objects (:name data))
shape (assoc data :name name) shape (assoc data :name name)
page-id (::page-id state)] page-id (::page-id state)]
(-> state (-> state
@ -965,9 +972,8 @@
:fill-opacity 1}) :fill-opacity 1})
(defn- calculate-frame-overlap (defn- calculate-frame-overlap
[data shape] [objects shape]
(let [objects (:objects data) (let [rshp (geom/shape->rect-shape shape)
rshp (geom/shape->rect-shape shape)
xfmt (comp xfmt (comp
(filter #(= :frame (:type %))) (filter #(= :frame (:type %)))
@ -989,10 +995,10 @@
ptk/UpdateEvent ptk/UpdateEvent
(update [_ state] (update [_ state]
(let [page-id (::page-id state) (let [page-id (::page-id state)
data (get-in state [:workspace-data page-id]) objects (get-in state [:workspace-data page-id :objects])
shape (-> (geom/setup-proportions attrs) shape (-> (geom/setup-proportions attrs)
(assoc :id id)) (assoc :id id))
frame-id (calculate-frame-overlap data shape) frame-id (calculate-frame-overlap objects shape)
shape (merge shape-default-attrs shape {:frame-id frame-id})] shape (merge shape-default-attrs shape {:frame-id frame-id})]
(impl-assoc-shape state shape))) (impl-assoc-shape state shape)))
@ -1516,9 +1522,9 @@
(if (nil? id) (if (nil? id)
[rch uch] [rch uch]
(let [pid (::page-id state) (let [pid (::page-id state)
dta (get-in state [:workspace-data pid]) objects (get-in state [:workspace-data pid :objects])
obj (get-in dta [:objects id]) obj (get objects id)
fid (calculate-frame-overlap dta obj)] fid (calculate-frame-overlap objects obj)]
(if (not= fid (:frame-id obj)) (if (not= fid (:frame-id obj))
(recur (first ids) (recur (first ids)
(rest ids) (rest ids)
@ -2049,48 +2055,83 @@
(rx/ignore))))))) (rx/ignore)))))))
(declare select-pasted-objs)
(defn- paste-impl (defn- paste-impl
[{:keys [selected objects] :as data}] [{:keys [selected objects] :as data}]
(letfn [(prepare-change [id] (letfn [(prepare-changes [state delta]
(let [obj (get objects id)] "Prepare objects to paste: generate new id, give them unique names, move
;; (prn "prepare-change" id obj) to the position of mouse pointer, and find in what frame they fit."
(if (= :frame (:type obj)) (let [page-id (::page-id state)]
(prepare-frame-change obj) (loop [existing-objs (get-in state [:workspace-data page-id :objects])
(prepare-shape-change obj uuid/zero)))) chgs []
id (first selected)
ids (rest selected)]
(if (nil? id)
chgs
(let [result (prepare-change id existing-objs delta)
result (if (vector? result) result [result])]
(recur
(reduce #(assoc %1 (:id %2) (:obj %2)) existing-objs result)
(into chgs result)
(first ids)
(rest ids)))))))
(prepare-shape-change [obj frame-id] (prepare-change [id existing-objs delta]
(let [id (uuid/next)] (let [obj (get objects id)]
(if (= :frame (:type obj))
(prepare-frame-change existing-objs obj delta)
(prepare-shape-change existing-objs obj delta nil))))
(prepare-shape-change [objects obj delta frame-id]
(let [id (uuid/next)
name (impl-generate-unique-name objects (:name obj))
renamed-obj (assoc obj :id id :name name)
moved-obj (geom/move renamed-obj delta)
frame-id (if frame-id
frame-id
(calculate-frame-overlap objects moved-obj))
reframed-obj (assoc moved-obj :frame-id frame-id)]
{:type :add-obj {:type :add-obj
:id id :id id
:frame-id frame-id :frame-id frame-id
:obj (assoc obj :id id :frame-id frame-id)})) :obj reframed-obj}))
(prepare-frame-change [obj] (prepare-frame-change [objects obj delta]
(let [frame-id (uuid/next) (let [frame-id (uuid/next)
frame-name (impl-generate-unique-name objects (:name obj))
sch (->> (map #(get objects %) (:shapes obj)) sch (->> (map #(get objects %) (:shapes obj))
(map #(prepare-shape-change % frame-id))) (map #(prepare-shape-change objects % delta frame-id)))
renamed-frame (-> obj
(assoc :id frame-id)
(assoc :name frame-name)
(assoc :frame-id uuid/zero)
(assoc :shapes (mapv :id sch)))
moved-frame (geom/move renamed-frame delta)
fch {:type :add-obj fch {:type :add-obj
:id frame-id :id frame-id
:frame-id uuid/zero :frame-id uuid/zero
:obj (-> obj :obj moved-frame}]
(assoc :id frame-id)
(assoc :frame-id uuid/zero)
(assoc :shapes (mapv :id sch)))}]
(d/concat [fch] sch)))] (d/concat [fch] sch)))]
(ptk/reify ::paste-impl (ptk/reify ::paste-impl
ptk/WatchEvent ptk/WatchEvent
(watch [_ state stream] (watch [_ state stream]
(let [rchanges (->> (map prepare-change selected) (let [selected-objs (map #(get objects %) selected)
(flatten)) wrapper (geom/selection-rect selected-objs)
orig-pos (gpt/point (:x1 wrapper) (:y1 wrapper))
mouse-pos @ms/mouse-position
delta (gpt/subtract mouse-pos orig-pos)
rchanges (prepare-changes state delta)
uchanges (map (fn [ch] uchanges (map (fn [ch]
{:type :del-obj {:type :del-obj
:id (:id ch)}) :id (:id ch)})
rchanges)] rchanges)]
(cljs.pprint/pprint rchanges)
(rx/of (commit-changes (vec rchanges) (rx/of (commit-changes (vec rchanges)
(vec (reverse uchanges)) (vec (reverse uchanges))
{:commit-local? true}))))))) {:commit-local? true})
(select-pasted-objs rchanges)))))))
(def paste (def paste
(ptk/reify ::paste (ptk/reify ::paste
@ -2105,6 +2146,13 @@
(js/console.error "Clipboard blocked:" err) (js/console.error "Clipboard blocked:" err)
(rx/empty))))))) (rx/empty)))))))
(defn select-pasted-objs
[rchanges]
(ptk/reify ::select-pasted-objs
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:workspace-local :selected]
(into #{} (map #(get-in % [:obj :id])) rchanges)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Page Changes Reactions ;; Page Changes Reactions