Merge branch 'develop' into refactor-ui-integration

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

@@ -82,8 +82,8 @@
   "A marker protocol for mark events that alters the
   page and is subject to perform a backend synchronization.")
 
-(defprotocol IPageOps
-  (-ops [_] "Get a list of ops for the event."))
+(defprotocol IPagePersistentOps
+  (-persistent-ops [o] "Get a list of ops for the event."))
 
 (defn page-update?
   [o]

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

@@ -10,6 +10,8 @@
    [cljs.spec.alpha :as s]
    [potok.core :as ptk]
    [uxbox.config :as cfg]
+   [uxbox.common.data :as d]
+   [uxbox.common.pages :as cp]
    [uxbox.main.constants :as c]
    [uxbox.main.data.icons :as udi]
    [uxbox.main.data.pages :as udp]
@@ -33,6 +35,8 @@
 (def clear-ruler nil)
 (def start-ruler nil)
 
+(declare shapes-overlaps?)
+
 ;; --- Specs
 
 (s/def ::id ::us/uuid)
@@ -196,6 +200,21 @@
                :workspace-data data
                :workspace-page page)))))
 
+;; --- Toggle layout flag
+
+(defn toggle-layout-flag
+  [flag]
+  (s/assert keyword? flag)
+  (ptk/reify ::toggle-layout-flag
+    ptk/UpdateEvent
+    (update [_ state]
+      (update state :workspace-layout
+              (fn [flags]
+                (if (contains? flags flag)
+                  (disj flags flag)
+                  (conj flags flag)))))))
+
+
 ;; --- Workspace Flags
 
 (defn activate-flag
@@ -234,18 +253,6 @@
   [txt]
   ::todo)
 
-(defn toggle-layout-flag
-  [flag]
-  (s/assert keyword? flag)
-  (ptk/reify ::toggle-layout-flag
-    ptk/UpdateEvent
-    (update [_ state]
-      (update state :workspace-layout
-              (fn [flags]
-                (if (contains? flags flag)
-                  (disj flags flag)
-                  (conj flags flag)))))))
-
 ;; --- Workspace Ruler
 
 (defrecord ActivateRuler []
@@ -450,17 +457,24 @@
         (update-in $ [:workspace-data :shapes] conj id))
       (assoc-in $ [:workspace-data :shapes-by-id id] shape))))
 
+(declare commit-shapes-changes)
+(declare recalculate-shape-canvas-relation)
+
 (defn add-shape
   [data]
-  (ptk/reify ::add-shape
-    udp/IPageDataUpdate
-    ptk/UpdateEvent
-    (update [_ state]
-      ;; TODO: revisit the `setup-proportions` seems unnecesary
-      (let [page-id (get-in state [:workspace-local :id])
-            shape (assoc (geom/setup-proportions data)
-                         :id (uuid/random))]
-        (impl-assoc-shape state shape)))))
+  (let [id (uuid/random)]
+    (ptk/reify ::add-shape
+      ptk/UpdateEvent
+      (update [_ state]
+        (let [shape (-> (geom/setup-proportions data)
+                        (assoc :id id))
+              shape (recalculate-shape-canvas-relation state shape)]
+          (impl-assoc-shape state shape)))
+
+      ptk/WatchEvent
+      (watch [_ state stream]
+        (let [shape (get-in state [:workspace-data :shapes-by-id id])]
+          (rx/of (commit-shapes-changes [[:add-shape id shape]])))))))
 
 ;; --- Duplicate Selected
 
@@ -471,47 +485,14 @@
 
 (def duplicate-selected
   (ptk/reify ::duplicate-selected
-    udp/IPageDataUpdate
-    ptk/UpdateEvent
-    (update [_ state]
+    ptk/WatchEvent
+    (watch [_ state stream]
       (let [selected  (get-in state [:workspace-local :selected])
             duplicate (partial impl-duplicate-shape state)
             shapes    (map duplicate selected)]
-        (reduce impl-assoc-shape state shapes)))))
-
-;; --- Delete shape to Workspace
-
-(defn impl-dissoc-shape
-  "Given a shape, removes it from the state."
-  [state {:keys [id type] :as shape}]
-  (as-> state $$
-    (if (= :canvas type)
-      (update-in $$ [:workspace-data :canvas]
-                 (fn [items] (vec (remove #(= % id) items))))
-      (update-in $$ [:workspace-data :shapes]
-                 (fn [items] (vec (remove #(= % id) items)))))
-    (update-in $$ [:workspace-data :shapes-by-id] dissoc id)))
-
-(defn delete-shape
-  [id]
-  (s/assert ::us/uuid id)
-  (ptk/reify ::delete-shape
-    udp/IPageDataUpdate
-    ptk/UpdateEvent
-    (update [_ state]
-      (let [shape (get-in state [:workspace-data :shapes-by-id id])]
-        (impl-dissoc-shape state shape)))))
-
-(defn delete-many-shapes
-  [ids]
-  (s/assert ::us/set ids)
-  (ptk/reify ::delete-many-shapes
-    udp/IPageDataUpdate
-    ptk/UpdateEvent
-    (update [_ state]
-      (reduce impl-dissoc-shape state
-              (map #(get-in state [:workspace-data :shapes-by-id %]) ids)))))
-
+        (rx/merge
+         (rx/from-coll (map (fn [s] #(impl-assoc-shape % s)) shapes))
+         (rx/of (commit-shapes-changes (mapv #(vector :add-shape (:id %) %) shapes))))))))
 
 ;; --- Toggle shape's selection status (selected or deselected)
 
@@ -593,12 +574,30 @@
 (defn update-shape-attrs
   [id attrs]
   (s/assert ::us/uuid id)
-  (s/assert ::attributes attrs)
   (let [atts (s/conform ::attributes attrs)]
     (ptk/reify ::update-shape-attrs
       ptk/UpdateEvent
       (update [_ state]
-        (update-in state [:workspace-data :shapes-by-id id] merge attrs)))))
+        (if (map? attrs)
+          (update-in state [:workspace-data :shapes-by-id id] merge attrs)
+          state)))))
+
+(defn update-shape
+  [id & attrs]
+  (let [attrs' (->> (apply hash-map attrs)
+                    (s/conform ::attributes))]
+    (ptk/reify ::update-shape
+      udp/IPagePersistentOps
+      (-persistent-ops [_]
+        (->> (partition-all 2 attrs)
+             (mapv (fn [[key val]] [:mod-shape id key val]))))
+
+      ptk/UpdateEvent
+      (update [_ state]
+        (cond-> state
+          (not= attrs' ::s/invalid)
+          (update-in [:workspace-data :shapes-by-id id] merge attrs'))))))
+
 
 ;; --- Update Selected Shapes attrs
 
@@ -615,8 +614,9 @@
 
 ;; --- Move Selected
 
-;; Event used for apply displacement transformation
-;; to the selected shapes throught the keyboard shortcuts.
+(declare initial-selection-align)
+(declare apply-temporal-displacement-in-bulk)
+(declare materialize-temporal-modifier-in-bulk)
 
 (defn- get-displacement
   "Retrieve the correct displacement delta point for the
@@ -639,13 +639,13 @@
      :fast (gpt/point (if align? (* 3 gx) 10)
                       (if align? (* 3 gy) 10))}))
 
-(declare initial-selection-align)
-(declare materialize-current-modifier-in-bulk)
-(declare apply-temporal-displacement-in-bulk)
 
 (s/def ::direction #{:up :down :right :left})
 (s/def ::speed #{:std :fast})
 
+;; Event used for apply displacement transformation
+;; to the selected shapes throught the keyboard shortcuts.
+
 (defn move-selected
   [direction speed]
   (s/assert ::direction direction)
@@ -662,7 +662,7 @@
         (rx/concat
          (when align? (rx/of (initial-selection-align selected)))
          (rx/of (apply-temporal-displacement-in-bulk selected displacement))
-         (rx/of (materialize-current-modifier-in-bulk selected)))))))
+         (rx/of (materialize-temporal-modifier-in-bulk selected)))))))
 
 ;; --- Update Shape Position
 
@@ -679,13 +679,30 @@
 
 ;; --- Delete Selected
 
+(defn impl-dissoc-shape
+  "Given a shape, removes it from the state."
+  [state {:keys [id type] :as shape}]
+  (as-> state $$
+    (if (= :canvas type)
+      (update-in $$ [:workspace-data :canvas]
+                 (fn [items] (vec (remove #(= % id) items))))
+      (update-in $$ [:workspace-data :shapes]
+                 (fn [items] (vec (remove #(= % id) items)))))
+    (update-in $$ [:workspace-data :shapes-by-id] dissoc id)))
+
 (def delete-selected
   "Deselect all and remove all selected shapes."
   (ptk/reify ::delete-selected
+    ptk/UpdateEvent
+    (update [_ state]
+      (let [selected (get-in state [:workspace-local :selected])]
+        (reduce impl-dissoc-shape state
+                (map #(get-in state [:workspace-data :shapes-by-id %]) selected))))
+
     ptk/WatchEvent
     (watch [_ state stream]
       (let [selected (get-in state [:workspace-local :selected])]
-        (rx/of (delete-many-shapes selected))))))
+        (rx/of (commit-shapes-changes (mapv #(vector :del-shape %) selected)))))))
 
 ;; --- Rename Shape
 
@@ -695,24 +712,30 @@
   (ptk/reify ::rename-shape
     ptk/UpdateEvent
     (update [_ state]
-      (assoc-in state [:shapes id :name] name))))
+      (assoc-in state [:shapes id :name] name))
 
-;; --- Change Shape Order (D&D Ordering)
-
-(defn change-shape-order
-  [{:keys [id index] :as params}]
-  {:pre [(uuid? id) (number? index)]}
-  (ptk/reify ::change-shape-order
-    ptk/UpdateEvent
-    (update [_ state]
-      (let [shapes (get-in state [:workspace-data :shapes])
-            shapes (into [] (remove #(= % id)) shapes)
-            [before after] (split-at index shapes)
-            shapes (vec (concat before [id] after))]
-        (assoc-in state [:workspace-data :shapes] shapes)))))
+    ptk/WatchEvent
+    (watch [_ state stream]
+      (rx/of (commit-shapes-changes [[:mod-shape id [:mod :name name]]])))))
 
 ;; --- Shape Vertical Ordering
 
+(declare impl-order-shape)
+
+(defn order-selected-shapes
+  [loc]
+  (s/assert ::direction loc)
+  (ptk/reify ::move-selected-layer
+    udp/IPageDataUpdate
+    ptk/UpdateEvent
+    (update [_ state]
+      (let [id (first (get-in state [:workspace-local :selected]))
+            type (get-in state [:workspace-data :shapes-by-id id :type])]
+        ;; NOTE: multiple selection ordering not supported
+        (if (and id (not= type :canvas))
+          (impl-order-shape state id loc)
+          state)))))
+
 (defn impl-order-shape
   [state sid opt]
   (let [shapes (get-in state [:workspace-data :shapes])
@@ -727,19 +750,19 @@
                                       (split-at index))]
                    (into [] (concat fst [sid] snd)))))))
 
-(defn order-selected-shapes
-  [loc]
-  (s/assert ::direction loc)
-  (ptk/reify ::move-selected-layer
-    udp/IPageDataUpdate
+;; --- Change Shape Order (D&D Ordering)
+
+(defn change-shape-order
+  [{:keys [id index] :as params}]
+  {:pre [(uuid? id) (number? index)]}
+  (ptk/reify ::change-shape-order
     ptk/UpdateEvent
     (update [_ state]
-      (let [id (first (get-in state [:workspace-local :selected]))
-            type (get-in state [:workspace-data :shapes-by-id id :type])]
-        ;; NOTE: multiple selection ordering not supported
-        (if (and id (not= type :canvas))
-          (impl-order-shape state id loc)
-          state)))))
+      (let [shapes (get-in state [:workspace-data :shapes])
+            shapes (into [] (remove #(= % id)) shapes)
+            [before after] (split-at index shapes)
+            shapes (vec (concat before [id] after))]
+        (assoc-in state [:workspace-data :shapes] shapes)))))
 
 ;; --- Change Canvas Order (D&D Ordering)
 
@@ -776,6 +799,15 @@
 
 ;; --- Temportal displacement for Shape / Selection
 
+(defn assoc-temporal-modifier-in-bulk
+  [ids xfmt]
+  (s/assert ::set-of-uuid ids)
+  (s/assert gmt/matrix? xfmt)
+  (ptk/reify ::assoc-temporal-modifier-in-bulk
+    ptk/UpdateEvent
+    (update [_ state]
+      (reduce #(assoc-in %1 [:workspace-data :shapes-by-id %2 :modifier-mtx] xfmt) state ids))))
+
 (defn apply-temporal-displacement-in-bulk
   "Apply the same displacement delta to all shapes identified by the
   set if ids."
@@ -787,39 +819,91 @@
                   xfmt (gmt/translate prev delta)]
               (assoc-in state [:workspace-data :shapes-by-id id :modifier-mtx] xfmt)))]
     (ptk/reify ::apply-temporal-displacement-in-bulk
-      ;; udp/IPageOps
-      ;; (-ops [_]
-      ;;   (mapv #(vec :udp/shape id :move delta) ids))
-
       ptk/UpdateEvent
       (update [_ state]
         (reduce process-shape state ids)))))
 
-;; --- Modifiers
+(defn- recalculate-shape-canvas-relation
+  [state shape]
+  (let [xfmt (comp (map #(get-in state [:workspace-data :shapes-by-id %]))
+                   (map geom/shape->rect-shape)
+                   (filter #(geom/overlaps? % shape))
+                   (map :id))
 
-(defn assoc-temporal-modifier-in-bulk
-  [ids xfmt]
-  (s/assert ::set-of-uuid ids)
-  (s/assert gmt/matrix? xfmt)
-  (ptk/reify ::assoc-temporal-modifier-in-bulk
+        id (->> (get-in state [:workspace-data :canvas])
+                (into [] xfmt)
+                (first))]
+    (assoc shape :canvas id)))
+
+(defn materialize-temporal-modifier-in-bulk
+  [ids]
+  (letfn [(process-shape [state id]
+            (let [shape (get-in state [:workspace-data :shapes-by-id id])
+                  xfmt (or (:modifier-mtx shape) (gmt/matrix))
+                  shape-old (dissoc shape :modifier-mtx)
+                  shape-new (geom/transform shape-old xfmt)
+                  shape-new (recalculate-shape-canvas-relation state shape-new)
+                  diff (d/diff-maps shape-old shape-new)]
+              (-> state
+                  (assoc-in [:workspace-data :shapes-by-id id] shape-new)
+                  (update ::tmp-changes (fnil conj []) (into [:mod-shape id] diff)))))]
+
+    (ptk/reify ::materialize-temporal-modifier-in-bulk
+      ptk/UpdateEvent
+      (update [_ state]
+        (reduce process-shape state ids))
+
+      ptk/WatchEvent
+      (watch [_ state stream]
+        (let [changes (::tmp-changes state)]
+          (rx/of (commit-shapes-changes changes)
+                 #(dissoc state ::tmp-changes)))))))
+
+(declare shapes-changes-commited)
+
+(defn commit-shapes-changes
+  [operations]
+  (s/assert ::cp/operations operations)
+  (ptk/reify ::commit-shapes-changes
+    ;; Commits the just performed changes to root pages-data
     ptk/UpdateEvent
     (update [_ state]
-      (reduce #(assoc-in %1 [:workspace-data :shapes-by-id %2 :modifier-mtx] xfmt) state ids))))
+      (let [pid (get-in state [:workspace-local :page-id])
+            data (get-in state [:pages-data pid])]
+        (update-in state [:pages-data pid] cp/process-ops operations)))
 
-(defn materialize-current-modifier-in-bulk
-  [ids]
-  (s/assert ::us/set ids)
-  (letfn [(process-shape [state id]
-            (let [xfmt (get-in state [:workspace-data :shapes-by-id id :modifier-mtx])]
-              (if (gmt/matrix? xfmt)
-                (-> state
-                    (update-in [:workspace-data :shapes-by-id id] geom/transform xfmt)
-                    (update-in [:workspace-data :shapes-by-id id] dissoc :modifier-mtx))
-                state)))]
-    (ptk/reify ::materialize-current-modifier-in-bulk
-      ptk/UpdateEvent
-      (update [_ state]
-        (reduce process-shape state ids)))))
+    ptk/WatchEvent
+    (watch [_ state stream]
+      (let [page (:workspace-page state)
+            params {:id (:id page)
+                    :version (:version page)
+                    :operations operations}]
+        (prn "commit-shapes-changes" params)
+        (->> (rp/mutation :update-project-page params)
+             ;; (rx/tap #(prn "foobar" %))
+             (rx/map shapes-changes-commited))))
+
+    ;; ptk/EffectEvent
+    ;; (effect [_ state stream]
+    ;;   (let [data {:shapes []
+    ;;               :shapes-by-id {}}]
+    ;;     (prn "commit-shapes-changes$effect" (cp/process-ops data operations))))
+    ))
+
+(s/def ::shapes-changes-commited
+  (s/keys :req-un [::id ::version ::cp/operations]))
+
+(defn shapes-changes-commited
+  [{:keys [id version operations] :as params}]
+  (s/assert ::shapes-changes-commited params)
+  (ptk/reify ::shapes-changes-commited
+    ptk/UpdateEvent
+    (update [_ state]
+      (-> state
+          (assoc-in [:workspace-page :version] version)
+          (assoc-in [:pages id :version] version)
+          (update-in [:pages-data id] cp/process-ops operations)
+          (update :workspace-data cp/process-ops operations)))))
 
 ;; --- Start shape "edition mode"
 
@@ -1226,3 +1310,10 @@
 ;;                (rx/ignore)
 ;;                (rx/take-until stoper)))))))
 
+(defn shapes-overlaps?
+  [canvas shape]
+  (let [shape1 (geom/shape->rect-shape canvas)
+        shape2 (geom/shape->rect-shape shape)]
+    (geom/overlaps? shape1 shape2)))
+
+

frontend/src/uxbox/main/ui/shapes/common.cljs

@@ -39,7 +39,7 @@
          (->> (uws/mouse-position-deltas position)
               (rx/map #(dw/apply-temporal-displacement-in-bulk selected %))
               (rx/take-until stoper))
-         (rx/of (dw/materialize-current-modifier-in-bulk selected)
+         (rx/of (dw/materialize-temporal-modifier-in-bulk selected)
                 ::dw/page-data-update))))))
 
 (defn on-mouse-down

frontend/src/uxbox/main/ui/workspace/selection.cljs

@@ -72,7 +72,7 @@
                 (rx/map normalize-proportion-lock)
                 (rx/mapcat (partial resize shape))
                 (rx/take-until stoper))
-           (rx/of (dw/materialize-current-modifier-in-bulk ids)
+           (rx/of (dw/materialize-temporal-modifier-in-bulk ids)
                   ::dw/page-data-update)))))))
 
 ;; --- Controls (Component)

frontend/src/uxbox/main/ui/workspace/shortcuts.cljs

@@ -22,20 +22,21 @@
 ;; --- Shortcuts
 
 (defonce +shortcuts+
-  {:shift+g #(st/emit! (dw/toggle-flag :grid))
-   :ctrl+shift+m #(st/emit! (dw/toggle-flag :sitemap))
-   :ctrl+shift+f #(st/emit! (dw/toggle-flag :drawtools))
-   :ctrl+shift+i #(st/emit! (dw/toggle-flag :icons))
-   :ctrl+shift+l #(st/emit! (dw/toggle-flag :layers))
+  {
+   ;; :shift+g #(st/emit! (dw/toggle-flag :grid))
+   :ctrl+shift+m #(st/emit! (dw/toggle-layout-flag :sitemap))
+   :ctrl+shift+f #(st/emit! (dw/toggle-layout-flag :drawtools))
+   :ctrl+shift+i #(st/emit! (dw/toggle-layout-flag :icons))
+   :ctrl+shift+l #(st/emit! (dw/toggle-layout-flag :layers))
    :ctrl+0 #(st/emit! (dw/reset-zoom))
-   :ctrl+r #(st/emit! (dw/toggle-flag :ruler))
+   ;; :ctrl+r #(st/emit! (dw/toggle-flag :ruler))
    :ctrl+d #(st/emit! dw/duplicate-selected)
-   :ctrl+c #(st/emit! (dw/copy-to-clipboard))
-   :ctrl+v #(st/emit! (dw/paste-from-clipboard))
-   :ctrl+shift+v #(dl/open! :clipboard)
-   :ctrl+z #(st/emit! du/undo)
-   :ctrl+shift+z #(st/emit! du/redo)
-   :ctrl+y #(st/emit! du/redo)
+   ;; :ctrl+c #(st/emit! (dw/copy-to-clipboard))
+   ;; :ctrl+v #(st/emit! (dw/paste-from-clipboard))
+   ;; :ctrl+shift+v #(dl/open! :clipboard)
+   ;; :ctrl+z #(st/emit! du/undo)
+   ;; :ctrl+shift+z #(st/emit! du/redo)
+   ;; :ctrl+y #(st/emit! du/redo)
    :ctrl+b #(st/emit! (dw/select-for-drawing :rect))
    :ctrl+e #(st/emit! (dw/select-for-drawing :circle))
    :ctrl+t #(st/emit! (dw/select-for-drawing :text))

frontend/src/uxbox/main/ui/workspace/streams.cljs

@@ -94,7 +94,6 @@
     (rx/subscribe-with ob sub)
     sub))
 
-
 (defn mouse-position-deltas
   [current]
   (->> (rx/concat (rx/of current)