♻️ Refactor copy&paste and duplicate shape.

common/uxbox/common/pages.cljc

@@ -209,16 +209,16 @@
                (contains? objects frame-id))
       (let [obj (assoc obj
                    :frame-id frame-id
-                   :parent-id parent-id
                    :id id)]
         (-> data
             (update :objects assoc id obj)
             (update-in [:objects parent-id :shapes]
                        (fn [shapes]
+                         (let [shapes (or shapes [])]
                            (cond
                              (some #{id} shapes) shapes
                              (nil? index) (conj shapes id)
-                           :else (insert-at-index shapes index [id])))))))))
+                             :else (insert-at-index shapes index [id]))))))))))
 
 (defmethod process-change :mod-obj
   [data {:keys [id operations] :as change}]

frontend/src/uxbox/main/data/workspace.cljs

@@ -1036,98 +1036,135 @@
                                    :id id}])))))))
 
 
-;; --- Duplicate Selected
+;; --- Duplicate Shapes
-;; TODO: handle properly naming
 
-(defn duplicate-shapes
+(declare prepare-duplicate-changes)
-  [shapes]
+(declare prepare-duplicate-change)
-  (ptk/reify ::duplicate-shapes
+(declare prepare-duplicate-frame-change)
-    ptk/WatchEvent
+(declare prepare-duplicate-shape-change)
-    (watch [_ state stream]
-      (let [page-id (::page-id state)
-            objects (get-in state [:workspace-data page-id :objects])
-            rchanges (mapv (fn [id]
-                             (let [obj (assoc (get objects id)
-                                              :id (uuid/next))]
-                               {:type :add-obj
-                                :id (:id obj)
-                                :frame-id (:frame-id obj)
-                                :obj obj
-                                :session-id (:session-id state)}))
-                           shapes)
-            uchanges (mapv (fn [rch]
-                             {:type :del-obj
-                              :id (:id rch)
-                              :session-id (:session-id state)})
-                           rchanges)]
-        (rx/of (commit-changes rchanges uchanges {:commit-local? true}))))))
 
-(defn duplicate-frame
+(defn impl-generate-unique-name2
-  [frame-id]
+  "A unique name generator"
-  (ptk/reify ::duplicate-frame
+  [used basename]
-    ptk/WatchEvent
+  (let [[prefix initial] (extract-numeric-suffix basename)]
-    (watch [_ state stream]
+    (loop [counter initial]
-      (let [page-id (::page-id state)
+      (let [candidate (str prefix "-" counter)]
-            objects (get-in state [:workspace-data page-id :objects])
+        (if (contains? used candidate)
+          (recur (inc counter))
+          candidate)))))
 
-            frame (get objects frame-id)
+(def ^:private change->name #(get-in % [:obj :name]))
-            frame-id (uuid/next)
 
-            rchanges (mapv (fn [id]
+(defn- prepare-duplicate-changes
-                             (let [obj (assoc (get objects id)
+  "Prepare objects to paste: generate new id, give them unique names,
-                                              :id (uuid/next))]
+  move to the position of mouse pointer, and find in what frame they
-                               {:type :add-obj
+  fit."
-                                :id (:id obj)
+  [objects names ids delta]
+  (loop [names names
+         chgs []
+         id   (first ids)
+         ids  (rest ids)]
+    (if (nil? id)
+      chgs
+      (let [result (prepare-duplicate-change objects names id delta)
+            result (if (vector? result) result [result])]
+        (recur
+         (into names (map change->name) result)
+         (into chgs result)
+         (first ids)
+         (rest ids))))))
+
+(defn- prepare-duplicate-change
+  [objects names id delta]
+  (let [obj (get objects id)]
+    (if (= :frame (:type obj))
+      (prepare-duplicate-frame-change objects names obj delta)
+      (prepare-duplicate-shape-change objects names obj delta nil nil))))
+
+(defn- prepare-duplicate-shape-change
+  [objects names obj delta frame-id parent-id]
+  (let [id (uuid/next)
+        name (impl-generate-unique-name2 names (: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))
+
+        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 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
+            :old-id (:id obj)
             :frame-id frame-id
-                                :obj (assoc obj :frame-id frame-id)}))
+            :parent-id parent-id
-                           (:shapes frame))
+            :obj (dissoc reframed-obj :shapes)}]
+          children-changes)))
 
-            uchanges (mapv (fn [rch]
+(defn- prepare-duplicate-frame-change
-                             {:type :del-obj
+  [objects names obj delta]
-                              :id (:id rch)})
+  (let [frame-id (uuid/next)
-                           rchanges)
+        frame-name (impl-generate-unique-name2 names (:name obj))
+        sch (->> (map #(get objects %) (:shapes obj))
+                 (mapcat #(prepare-duplicate-shape-change objects names % delta frame-id frame-id)))
 
-            shapes (mapv :id rchanges)
+        renamed-frame (-> obj
+                          (assoc :id frame-id)
+                          (assoc :name frame-name)
+                          (assoc :frame-id uuid/zero)
+                          (dissoc :shapes))
 
-            rchange {:type :add-obj
+        moved-frame (geom/move renamed-frame delta)
+
+        fch {:type :add-obj
+             :old-id (:id obj)
              :id frame-id
              :frame-id uuid/zero
-                     :obj (assoc frame
+             :obj moved-frame}]
-                                 :id frame-id
-                                 :shapes shapes)
 
-                     :session-id (:session-id state)}
+    (into [fch] sch)))
-
-            uchange {:type :del-obj
-                     :id frame-id
-                     :session-id (:session-id state)}]
-        (rx/of (commit-changes (d/concat [rchange] rchanges)
-                               (d/concat [] uchanges [uchange])
-                               {:commit-local? true}))))))
 
+(declare select-shapes)
 
 (def duplicate-selected
   (ptk/reify ::duplicate-selected
     ptk/WatchEvent
     (watch [_ state stream]
       (let [page-id (::page-id state)
-            objects (get-in state [:workspace-data page-id :objects])
             selected (get-in state [:workspace-local :selected])
-            lookup #(get objects %)
+            objects (get-in state [:workspace-data page-id :objects])
-            shapes (map lookup selected)
+            delta (gpt/point 0 0)
-            shape? #(not= (:type %) :frame)]
+            unames (impl-retrieve-used-names objects)
-        (cond
-          (and (= (count shapes) 1)
-               (= (:type (first shapes)) :frame))
-          (rx/of (duplicate-frame (first selected)))
 
-          (and (pos? (count shapes))
+            rchanges (prepare-duplicate-changes objects unames selected delta)
-               (every? shape? shapes))
+            uchanges (mapv #(array-map :type :del-obj :id (:id %))
-          (rx/of (duplicate-shapes selected))
+                           (reverse rchanges))
 
-          :else
+            selected (->> rchanges
-          (rx/empty))))))
+                          (filter #(selected (:old-id %)))
+                          (map #(get-in % [:obj :id]))
+                          (into #{}))]
 
+        (rx/of (commit-changes rchanges uchanges {:commit-local? true})
+               (select-shapes selected))))))
 
 
 ;; --- Toggle shape's selection status (selected or deselected)
@@ -1144,6 +1181,14 @@
                      (disj selected id)
                      (conj selected id)))))))
 
+(defn select-shapes
+  [ids]
+  (us/verify ::set-of-uuid ids)
+  (ptk/reify ::select-shapes
+    ptk/UpdateEvent
+    (update [_ state]
+      (assoc-in state [:workspace-local :selected] ids))))
+
 (def deselect-all
   "Clear all possible state of drawing, edition
   or any similar action taken by the user."
@@ -2130,18 +2175,17 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (def copy-selected
-  (letfn [(prepare-selected [state selected]
+  (letfn [(prepare-selected [objects selected]
-            (let [data (reduce #(prepare %1 state %2) {} selected)]
+            (let [data (reduce #(prepare %1 objects %2) {} selected)]
               {:type :copied-shapes
-               :data (assoc data :selected selected)}))
+               :selected selected
+               :objects data}))
 
-          (prepare [result state id]
+          (prepare [result objects id]
-            (let [page-id (::page-id state)
+            (let [obj (get objects id)]
-                  objects (get-in state [:workspace-data page-id :objects])
+              (as-> result $$
-                  object  (get objects id)]
+                (assoc $$ id obj)
-              (cond-> (assoc-in result [:objects id] object)
+                (reduce #(prepare %1 objects %2) $$ (:shapes obj)))))
-                (= :frame (:type object))
-                (as-> $ (reduce #(prepare %1 state %2) $ (:shapes object))))))
 
           (on-copy-error [error]
             (js/console.error "Clipboard blocked:" error)
@@ -2150,98 +2194,18 @@
     (ptk/reify ::copy-selected
       ptk/WatchEvent
       (watch [_ state stream]
-        (let [selected (get-in state [:workspace-local :selected])
+        (let [page-id (::page-id state)
-              cdata    (prepare-selected state selected)]
+              objects (get-in state [:workspace-data page-id :objects])
+              selected (get-in state [:workspace-local :selected])
+              cdata    (prepare-selected objects selected)]
           (->> (t/encode cdata)
                (wapi/write-to-clipboard)
                (rx/from)
                (rx/catch on-copy-error)
                (rx/ignore)))))))
 
-
-(declare select-pasted-objs)
-
 (defn- paste-impl
   [{:keys [selected objects] :as data}]
-  (letfn [(prepare-changes [state delta]
-            "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."
-            (let [page-id (::page-id state)]
-              (loop [existing-objs (get-in state [:workspace-data page-id :objects])
-                     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-change [id existing-objs delta]
-            (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))
-
-                  prepare-child
-                  (fn [child-id]
-                    (prepare-shape-change objects (get objects child-id) delta frame-id))
-
-                  children-changes (mapcat prepare-child (:shapes obj))
-                  is-child? (set (:shapes obj))
-                  children-uuids (->> children-changes
-                                      (filter #(and (= :add-obj (:type %)) (is-child? (:old-id %))))
-                                      (map #(:id %)))
-
-                  move-change (when (not (empty? (:shapes obj)))
-                                [{:type :mov-objects
-                                  :parent-id id
-                                  :shapes (vec children-uuids)}])
-
-                  reframed-obj (-> moved-obj
-                                   (assoc  :frame-id frame-id)
-                                   (dissoc :shapes))]
-              (into [{:type :add-obj
-                      :id id
-                      :old-id (:id obj)
-                      :frame-id frame-id
-                      :obj (dissoc reframed-obj :shapes)}]
-                    (concat children-changes move-change))))
-
-          (prepare-frame-change [objects obj delta]
-            (let [frame-id (uuid/next)
-                  frame-name (impl-generate-unique-name objects (:name obj))
-                  sch (->> (map #(get objects %) (:shapes obj))
-                           (mapcat #(prepare-shape-change objects % delta frame-id)))
-                  is-child? (set (:shapes obj))
-                  children-uuids (->> sch
-                                      (filter #(and (= :add-obj (:type %)) (is-child? (:old-id %))))
-                                      (map #(:id %)))
-                  renamed-frame (-> obj
-                                    (assoc :id frame-id)
-                                    (assoc :name frame-name)
-                                    (assoc :frame-id uuid/zero)
-                                    (assoc :shapes (vec children-uuids)))
-                  moved-frame (geom/move renamed-frame delta)
-                  fch {:type :add-obj
-                       :id frame-id
-                       :frame-id uuid/zero
-                       :obj moved-frame}]
-              (into [fch] sch)))]
-
   (ptk/reify ::paste-impl
     ptk/WatchEvent
     (watch [_ state stream]
@@ -2251,15 +2215,20 @@
             mouse-pos @ms/mouse-position
             delta (gpt/subtract mouse-pos orig-pos)
 
-            rchanges (prepare-changes state delta)
+            page-id (::page-id state)
-            uchanges (map (fn [ch]
+            unames (-> (get-in state [:workspace-data page-id :objects])
-                            {:type :del-obj
+                       (impl-retrieve-used-names))
-                             :id (:id ch)})
+
-                          (filter #(= :add-obj (:type %)) rchanges))]
+            rchanges (prepare-duplicate-changes objects unames selected delta)
-        (rx/of (commit-changes (vec rchanges)
+            uchanges (mapv #(array-map :type :del-obj :id (:id %))
-                               (vec (reverse uchanges))
+                           (reverse rchanges))
-                               {:commit-local? true})
+
-               (select-pasted-objs selected rchanges)))))))
+            selected (->> rchanges
+                          (filter #(selected (:old-id %)))
+                          (map #(get-in % [:obj :id]))
+                          (into #{}))]
+        (rx/of (commit-changes rchanges uchanges {:commit-local? true})
+               (select-shapes selected))))))
 
 (def paste
   (ptk/reify ::paste
@@ -2268,23 +2237,12 @@
       (->> (rx/from (wapi/read-from-clipboard))
            (rx/map t/decode)
            (rx/filter #(= :copied-shapes (:type %)))
-           (rx/pr-log "pasting:")
+           (rx/map #(select-keys % [:selected :objects]))
-           (rx/map :data)
            (rx/map paste-impl)
            (rx/catch (fn [err]
                        (js/console.error "Clipboard error:" err)
                        (rx/empty)))))))
 
-(defn select-pasted-objs
-  [selected rchanges]
-  (ptk/reify ::select-pasted-objs
-    ptk/UpdateEvent
-    (update [_ state]
-      (let [new-selected (->> rchanges
-                 (filter #(selected (:old-id %)))
-                 (map #(get-in % [:obj :id]))
-                 (into #{}))]
-        (assoc-in state [:workspace-local :selected] new-selected)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Page Changes Reactions