♻️ Redone the snap calculation and added guides

frontend/src/app/main/data/workspace/guides.cljs

@@ -22,16 +22,9 @@
     ptk/WatchEvent
     (watch [it state _]
       (let [page-id (:current-page-id state)
-            guides (-> state wsh/lookup-page-options (:guides []))
-            guides-ids? (into #{} (map :id) guides)
+            guides (-> state wsh/lookup-page-options (:guides {}))
 
-            new-guides
-            (if (guides-ids? (:id guide))
-              ;; Update existing guide
-              (mapv (make-update-guide guide) guides)
-
-              ;; Add new guide
-              (conj guides guide))
+            new-guides (assoc guides (:id guide) guide)
             
             rch [{:type :set-option
                   :page-id page-id
@@ -52,8 +45,8 @@
     ptk/WatchEvent
     (watch [it state _]
       (let [page-id (:current-page-id state)
-            guides (-> state wsh/lookup-page-options (:guides []))
-            new-guides (filterv #(not= (:id %) (:id guide)) guides)
+            guides (-> state wsh/lookup-page-options (:guides {}))
+            new-guides (dissoc guides (:id guide))
             
             rch [{:type :set-option
                   :page-id page-id

frontend/src/app/main/snap.cljs

@@ -19,7 +19,7 @@
    [beicon.core :as rx]
    [clojure.set :as set]))
 
-(def ^:const snap-accuracy 5)
+(def ^:const snap-accuracy 10)
 (def ^:const snap-path-accuracy 10)
 (def ^:const snap-distance-accuracy 10)
 
@@ -27,12 +27,12 @@
   [remove-id?]
   (fn [query-result]
     (->> query-result
-         (map (fn [[value data]] [value (remove (comp remove-id? second) data)]))
+         (map (fn [[value data]] [value (remove (comp remove-id? :id) data)]))
          (filter (fn [[_ data]] (seq data))))))
 
 (defn- flatten-to-points
   [query-result]
-  (mapcat (fn [[_ data]] (map (fn [[point _]] point) data)) query-result))
+  (mapcat (fn [[_ data]] (map :pt data)) query-result))
 
 (defn- calculate-distance [query-result point coord]
   (->> query-result
@@ -62,7 +62,7 @@
     (->> (uw/ask! {:cmd :snaps/range-query
                    :page-id page-id
                    :frame-id frame-id
-                   :coord coord
+                   :axis coord
                    :ranges [[(- value 0.5) (+ value 0.5)]]})
          (rx/first)
          (rx/map (remove-from-snap-points filter-shapes))
@@ -78,7 +78,7 @@
     (->> (uw/ask! {:cmd :snaps/range-query
                    :page-id page-id
                    :frame-id frame-id
-                   :coord coord
+                   :axis coord
                    :ranges ranges})
          (rx/first)
          (rx/map (remove-from-snap-points filter-shapes))

frontend/src/app/main/ui/workspace/viewport/guides.cljs

@@ -396,7 +396,8 @@
   [{:keys [zoom vbox hover-frame]}]
 
   (let [page (mf/deref refs/workspace-page)
-        guides (->> (get-in page [:options :guides] [])
+        guides (->> (get-in page [:options :guides] {})
+                    (vals)
                     (filter (guide-inside-vbox? vbox)))
 
         hover-frame-ref (mf/use-ref nil)

frontend/src/app/util/geom/snap_points.cljs

@@ -28,3 +28,12 @@
     (case (:type shape)
       :frame (-> shape :selrect frame-snap-points)
       (into #{(gsh/center-shape shape)} (:points shape)))))
+
+(defn guide-snap-points
+  [guide]
+
+  ;; TODO: The line will be displayed from the position to the axis. Maybe
+  ;; revisit this
+  (if (= :x (:axis guide))
+    #{(gpt/point (:position guide) 0)}
+    #{(gpt/point 0 (:position guide))}))

frontend/src/app/util/snap_data.cljs

@@ -0,0 +1,244 @@
+;; 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) UXBOX Labs SL
+
+(ns app.util.snap-data
+  "Data structure that holds and retrieves the data to make the snaps. Internaly
+   is implemented with a balanced binary tree that queries by range.
+   https://en.wikipedia.org/wiki/Range_tree"
+  (:require
+   [app.common.data :as d]
+   [app.common.pages :as cp]
+   [app.common.pages.diff :as diff]
+   [app.common.uuid :as uuid]
+   [app.util.geom.grid :as gg]
+   [app.util.geom.snap-points :as snap]
+   [app.util.range-tree :as rt]))
+
+(def snap-attrs [:frame-id :x :y :width :height :hidden :selrect :grids])
+
+;; PRIVATE FUNCTIONS
+
+(defn make-insert-tree-data
+  [shape-data axis]
+  (fn [tree]
+    (let [tree (or tree (rt/make-tree))]
+      (as-> tree $
+        (reduce (fn [tree data]
+                  (rt/insert tree (get-in data [:pt axis]) data))
+                $ shape-data)))))
+
+(defn make-delete-tree-data
+  [shape-data axis]
+  (fn [tree]
+    (let [tree (or tree (rt/make-tree))]
+      (as-> tree $
+        (reduce (fn [tree data]
+                  (rt/remove tree (get-in data [:pt axis]) data))
+                $ shape-data)))))
+
+(defn add-root-frame
+  [page-data]
+  (let [frame-id uuid/zero]
+
+    (-> page-data
+        (assoc-in [frame-id :x] (rt/make-tree))
+        (assoc-in [frame-id :y] (rt/make-tree)))))
+
+(defn add-frame
+  [page-data frame]
+  (let [frame-id (:id frame)
+        parent-id (:parent-id frame)
+        frame-data (->> (snap/shape-snap-points frame)
+                        (map #(hash-map :type :shape
+                                        :id frame-id
+                                        :pt %)))
+
+        grid-x-data (->> (gg/grid-snap-points frame :x)
+                         (map #(hash-map :type :grid-x
+                                         :id frame-id
+                                         :pt %)))
+
+        grid-y-data (->> (gg/grid-snap-points frame :y)
+                         (map #(hash-map :type :grid-y
+                                         :id frame-id
+                                         :pt %)))]
+
+    (-> page-data
+        ;; Update root frame information
+        (assoc-in [uuid/zero :objects-data frame-id] frame-data)
+        (update-in [parent-id :x] (make-insert-tree-data frame-data :x))
+        (update-in [parent-id :y] (make-insert-tree-data frame-data :y))
+
+        ;; Update frame information
+        (assoc-in  [frame-id :objects-data frame-id] (d/concat-vec frame-data grid-x-data grid-y-data))
+        (update-in [frame-id :x] #(or % (rt/make-tree)))
+        (update-in [frame-id :y] #(or % (rt/make-tree)))
+        (update-in [frame-id :x] (make-insert-tree-data (d/concat-vec frame-data grid-x-data) :x))
+        (update-in [frame-id :y] (make-insert-tree-data (d/concat-vec frame-data grid-y-data) :y)))))
+
+(defn add-shape
+  [page-data shape]
+  (let [frame-id    (:frame-id shape)
+        snap-points (snap/shape-snap-points shape)
+        shape-data  (->> snap-points
+                         (mapv #(hash-map
+                                 :type :shape
+                                 :id (:id shape)
+                                 :pt %)))]
+    (-> page-data
+        (assoc-in [frame-id :objects-data (:id shape)] shape-data)
+        (update-in [frame-id :x] (make-insert-tree-data shape-data :x))
+        (update-in [frame-id :y] (make-insert-tree-data shape-data :y)))))
+
+
+(defn add-guide
+  [page-data guide]
+
+  (let [guide-data (->> (snap/guide-snap-points guide)
+                        (mapv #(hash-map
+                                :type :guide
+                                :id (:id guide)
+                                :pt %)))]
+
+    (if-let [frame-id (:frame-id guide)]
+      ;; Guide inside frame, we add the information only on that frame
+      (-> page-data
+          (assoc-in [frame-id :objects-data (:id guide)] guide-data)
+          (update-in [frame-id (:axis guide)] (make-insert-tree-data guide-data (:axis guide))))
+
+      ;; Guide outside the frame. We add the information in the global guides data
+      (-> page-data
+          (assoc-in [:guides :objects-data (:id guide)] [guide-data])
+          (update-in [:guides (:axis guide)] (make-insert-tree-data guide-data (:axis guide)))))))
+
+(defn remove-frame
+  [page-data frame]
+  (let [frame-id (:id frame)
+        root-data (get-in page-data [uuid/zero :objects-data frame-id])]
+    (-> page-data
+        (d/dissoc-in [uuid/zero :objects-data frame-id])
+        (update-in [uuid/zero :x] (make-delete-tree-data root-data :x))
+        (update-in [uuid/zero :y] (make-delete-tree-data root-data :y))
+        (dissoc frame-id))))
+
+(defn remove-shape
+  [page-data shape]
+
+  (let [frame-id (:frame-id shape)
+        shape-data (get-in page-data [frame-id :objects-data (:id shape)])]
+    (-> page-data
+        (d/dissoc-in [frame-id :objects-data (:id shape)])
+        (update-in [frame-id :x] (make-delete-tree-data shape-data :x))
+        (update-in [frame-id :y] (make-delete-tree-data shape-data :y)))))
+
+(defn remove-guide
+  [page-data guide]
+  (if-let [frame-id (:frame-id guide)]
+    (let [guide-data (get-in page-data [frame-id :objects-data (:id guide)])]
+      (-> page-data
+          (d/dissoc-in [frame-id :objects-data (:id guide)])
+          (update-in [frame-id (:axis guide)] (make-delete-tree-data guide-data (:axis guide)))))
+
+    ;; Guide outside the frame. We add the information in the global guides data
+    (let [guide-data (get-in page-data [:guides :objects-data (:id guide)])]
+      (-> page-data
+          (d/dissoc-in [:guides :objects-data (:id guide)])
+          (update-in [:guides (:axis guide)] (make-delete-tree-data guide-data (:axis guide)))))))
+
+(defn update-frame
+  [page-data [_ new-frame]]
+  (let [frame-id (:id new-frame)
+        root-data (get-in page-data [uuid/zero :objects-data frame-id])
+        frame-data (get-in page-data [frame-id :objects-data frame-id])]
+    (-> page-data
+        (update-in [uuid/zero :x] (make-delete-tree-data root-data :x))
+        (update-in [uuid/zero :y] (make-delete-tree-data root-data :y))
+        (update-in [frame-id :x]  (make-delete-tree-data frame-data :x))
+        (update-in [frame-id :y]  (make-delete-tree-data frame-data :y))
+        (add-frame new-frame))))
+
+(defn update-shape
+  [page-data [old-shape new-shape]]
+  (-> page-data
+      (remove-shape old-shape)
+      (add-shape new-shape)))
+
+(defn update-guide
+  [page-data [old-guide new-guide]]
+  (-> page-data
+      (remove-guide old-guide)
+      (add-guide new-guide)))
+
+;; PUBLIC API
+(defn make-snap-data
+  "Creates an empty snap index"
+  []
+  {})
+
+(defn add-page
+  "Adds page information"
+  [snap-data {:keys [objects options] :as page}]
+
+  (let [frames     (cp/select-frames objects)
+        shapes     (cp/select-objects #(not= :frame (:type %)) page)
+        guides     (vals (:guides options))
+
+        page-data
+        (as-> {} $
+          (add-root-frame $)
+          (reduce add-frame $ frames)
+          (reduce add-shape $ shapes)
+          (reduce add-guide $ guides))]
+    (assoc snap-data (:id page) page-data)))
+
+(defn update-page
+  "Updates a previously inserted page with new data"
+  [snap-data old-page page]
+
+  (if (contains? snap-data (:id page))
+    ;; Update page
+    (update snap-data (:id page)
+            (fn [page-data]
+              (let [{:keys [change-frame-shapes
+                            change-frame-guides
+                            removed-frames
+                            removed-shapes
+                            removed-guides
+                            updated-frames
+                            updated-shapes
+                            updated-guides
+                            new-frames
+                            new-shapes
+                            new-guides]}
+                    (diff/calculate-page-diff old-page page snap-attrs)]
+
+                (as-> page-data $
+                  (reduce update-shape   $ change-frame-shapes)
+                  (reduce remove-frame   $ removed-frames)
+                  (reduce remove-shape   $ removed-shapes)
+                  (reduce update-frame   $ updated-frames)
+                  (reduce update-shape   $ updated-shapes)
+                  (reduce add-frame      $ new-frames)
+                  (reduce add-shape      $ new-shapes)
+                  (reduce update-guide   $ change-frame-guides)
+                  (reduce remove-guide   $ removed-guides)
+                  (reduce update-guide   $ updated-guides)
+                  (reduce add-guide      $ new-guides)))))
+    
+    ;; Page doesn't exist, we create a new entry
+    (add-page snap-data page)))
+
+(defn query
+  [snap-data page-id frame-id axis [from to]]
+
+  (d/concat-vec
+   (-> snap-data
+       (get-in [page-id frame-id axis])
+       (rt/range-query from to))
+
+   (-> snap-data
+       (get-in [page-id :guides axis])
+       (rt/range-query from to))))

frontend/src/app/worker/impl.cljs

@@ -40,14 +40,13 @@
 (defmethod handler :update-page-indices
   [{:keys [page-id changes] :as message}]
 
-  (let [old-objects (get-in @state [:pages-index page-id :objects])]
+  (let [old-page (get-in @state [:pages-index page-id])]
     (swap! state ch/process-changes changes false)
 
-    (let [new-objects (get-in @state [:pages-index page-id :objects])
+    (let [new-page (get-in @state [:pages-index page-id])
           message (assoc message
-                         :objects new-objects
-                         :new-objects new-objects
-                         :old-objects old-objects)]
+                         :old-page old-page
+                         :new-page new-page)]
       (handler (-> message
                    (assoc :cmd :selection/update-index)))
       (handler (-> message

frontend/src/app/worker/selection.cljs

@@ -170,8 +170,10 @@
     nil))
 
 (defmethod impl/handler :selection/update-index
-  [{:keys [page-id old-objects new-objects] :as message}]
-  (let [update-page-index
+  [{:keys [page-id old-page new-page] :as message}]
+  (let [old-objects (:objects old-page)
+        new-objects (:objects new-page)
+        update-page-index
         (fn [index]
           (let [old-bounds (:bounds index)
                 new-bounds (objects-bounds new-objects)]

frontend/src/app/worker/snaps.cljs

@@ -6,179 +6,31 @@
 
 (ns app.worker.snaps
   (:require
-   [app.common.data :as d]
-   [app.common.uuid :as uuid]
-   [app.util.geom.grid :as gg]
-   [app.util.geom.snap-points :as snap]
-   [app.util.range-tree :as rt]
+   [app.util.snap-data :as sd]
    [app.worker.impl :as impl]
-   [clojure.set :as set]
    [okulary.core :as l]))
 
 (defonce state (l/atom {}))
 
-(defn process-shape [frame-id coord]
-  (fn [shape]
-    (let [points (when-not (:hidden shape) (snap/shape-snap-points shape))
-          shape-data (->> points (mapv #(vector % (:id shape))))]
-      (if (= (:id shape) frame-id)
-        (into shape-data
-
-              ;; The grid points are only added by the "root" of the coord-dat
-              (->> (gg/grid-snap-points shape coord)
-                   (map #(vector % :layout))))
-        shape-data))))
-
-(defn- add-coord-data
-  "Initializes the range tree given the shapes"
-  [data frame-id shapes coord]
-  (letfn [(into-tree [tree [point _ :as data]]
-            (rt/insert tree (coord point) data))]
-    (->> shapes
-         (mapcat (process-shape frame-id coord))
-         (reduce into-tree (or data (rt/make-tree))))))
-
-(defn remove-coord-data
-  [data frame-id shapes coord]
-  (letfn [(remove-tree [tree [point _ :as data]]
-            (rt/remove tree (coord point) data))]
-    (->> shapes
-         (mapcat (process-shape frame-id coord))
-         (reduce remove-tree (or data (rt/make-tree))))))
-
-(defn aggregate-data
-  ([objects]
-   (aggregate-data objects (keys objects)))
-
-  ([objects ids]
-   (->> ids
-        (filter #(contains? objects %))
-        (map #(get objects %))
-        (filter :frame-id)
-        (group-by :frame-id)
-        ;; Adds the frame
-        (d/mapm #(conj %2 (get objects %1))))))
-
-(defn- initialize-snap-data
-  "Initialize the snap information with the current workspace information"
-  [objects]
-  (let [shapes-data (aggregate-data objects)
-
-        create-index
-        (fn [frame-id shapes]
-          {:x (-> (rt/make-tree) (add-coord-data frame-id shapes :x))
-           :y (-> (rt/make-tree) (add-coord-data frame-id shapes :y))})]
-    (d/mapm create-index shapes-data)))
-
-;; Attributes that will change the values of their snap
-(def snap-attrs [:x :y :width :height :hidden :selrect :grids])
-
-(defn- update-snap-data
-  [snap-data old-objects new-objects]
-
-  (let [changed? (fn [id]
-                   (let [oldv (get old-objects id)
-                         newv (get new-objects id)]
-                     ;; Check first without select-keys because is faster if they are
-                     ;; the same reference
-                     (and (not= oldv newv)
-                          (not= (select-keys oldv snap-attrs)
-                                (select-keys newv snap-attrs)))))
-
-        is-deleted-frame? #(and (not= uuid/zero %)
-                                (contains? old-objects %)
-                                (not (contains? new-objects %))
-                                (= :frame (get-in old-objects [% :type])))
-        is-new-frame? #(and (not= uuid/zero %)
-                            (contains? new-objects %)
-                            (not (contains? old-objects %))
-                            (= :frame (get-in new-objects [% :type])))
-
-        changed-ids (into #{}
-                          (filter changed?)
-                          (set/union (set (keys old-objects))
-                                     (set (keys new-objects))))
-
-        to-delete (aggregate-data old-objects changed-ids)
-        to-add    (aggregate-data new-objects changed-ids)
-
-        frames-to-delete (->> changed-ids (filter is-deleted-frame?))
-        frames-to-add (->> changed-ids (filter is-new-frame?))
-
-        delete-data
-        (fn [snap-data [frame-id shapes]]
-          (-> snap-data
-              (update-in [frame-id :x] remove-coord-data frame-id shapes :x)
-              (update-in [frame-id :y] remove-coord-data frame-id shapes :y)))
-
-        add-data
-        (fn [snap-data [frame-id shapes]]
-          (-> snap-data
-              (update-in [frame-id :x] add-coord-data frame-id shapes :x)
-              (update-in [frame-id :y] add-coord-data frame-id shapes :y)))
-
-        delete-frames
-        (fn [snap-data frame-id]
-          (dissoc snap-data frame-id))
-
-        add-frames
-        (fn [snap-data frame-id]
-          (assoc snap-data frame-id {:x (rt/make-tree)
-                                     :y (rt/make-tree)}))]
-
-    (as-> snap-data $
-      (reduce delete-data $ to-delete)
-      (reduce add-frames $ frames-to-add)
-      (reduce add-data $ to-add)
-      (reduce delete-frames $ frames-to-delete))))
-
-;; (defn- log-state
-;;   "Helper function to print a friendly version of the snap tree. Debugging purposes"
-;;   []
-;;   (let [process-frame-data #(d/mapm rt/as-map %)
-;;         process-page-data  #(d/mapm process-frame-data %)]
-;;     (js/console.log "STATE" (clj->js (d/mapm process-page-data @state)))))
-
-(defn- index-page [state page-id objects]
-  (let [snap-data (initialize-snap-data objects)]
-    (assoc state page-id snap-data)))
-
-(defn- update-page [state page-id old-objects new-objects]
-  (let [snap-data (get state page-id)
-        snap-data (update-snap-data snap-data old-objects new-objects)]
-    (assoc state page-id snap-data)))
-
 ;; Public API
 (defmethod impl/handler :snaps/initialize-index
   [{:keys [data] :as message}]
-  ;; Create the index
-  (letfn [(process-page [state page]
-            (let [id      (:id page)
-                  objects (:objects page)]
-              (index-page state id objects)))]
-    (swap! state #(reduce process-page % (vals (:pages-index data))))
-    ;; (log-state)
-    ;; Return nil so the worker will not answer anything back
-    nil))
+
+  (let [pages (vals (:pages-index data))]
+    (reset! state (reduce sd/add-page (sd/make-snap-data) pages)))
+
+  nil)
 
 (defmethod impl/handler :snaps/update-index
-  [{:keys [page-id old-objects new-objects] :as message}]
-  (swap! state update-page page-id old-objects new-objects)
-
-  ;; Uncomment this to regenerate the index everytime
-  #_(swap! state index-page page-id new-objects)
-  ;; (log-state)
+  [{:keys [old-page new-page] :as message}]
+  (swap! state sd/update-page old-page new-page)
   nil)
 
 (defmethod impl/handler :snaps/range-query
-  [{:keys [page-id frame-id coord ranges] :as message}]
-  (letfn [(calculate-range [[from to]]
-            (-> @state
-                (get-in [page-id frame-id coord])
-                (rt/range-query from to)))]
-    (->> ranges
-         (mapcat calculate-range)
-         set ;; unique
-         (into []))))
+  [{:keys [page-id frame-id axis ranges] :as message}]
+  (->> ranges
+       (mapcat #(sd/query @state page-id frame-id axis %))
+       (set) ;; unique
+       (into [])))