enhance snapping

- decouple from transform related actions
- each tool provide base points through a multimethod
- support snapping on element creation

Author: sprocketc

.clj-kondo/metosin/malli-types-cljs/config.edn

@@ -10,7 +10,7 @@
    [renderer.handle.db :refer [Handle]]
    [renderer.notification.db :refer [Notification]]
    [renderer.ruler.db :refer [Ruler]]
-   [renderer.snap.db :refer [Snap]]
+   [renderer.snap.db :refer [Snap NearestNeighbor]]
    [renderer.theme.db :refer [Theme]]
    [renderer.timeline.db :refer [Timeline]]
    [renderer.tool.db :refer [Tool State Cursor]]
@@ -40,6 +40,8 @@
    [:pointer-offset {:optional true} Vec2D]
    [:adjusted-pointer-pos {:default [0 0]} Vec2D]
    [:adjusted-pointer-offset {:optional true} Vec2D]
+   [:nearest-neighbor-offset {:optional true} Vec2D]
+   [:nearest-neighbor {:optional true} NearestNeighbor]
    [:drag {:optional true} boolean?]
    [:zoom-sensitivity {:default 0.75} [:and number? pos?]]
    [:event-time {:optional true} number?]

src/renderer/app/db.cljs

@@ -20,5 +20,4 @@
   [:map {:default {} :closed true}
    [:active {:default true} boolean?]
    [:threshold {:default 15} number?]
-   [:nearest-neighbor {:optional true} NearestNeighbor]
    [:options {:default (set snap-options)} SnapOptions]])

src/renderer/snap/db.cljs

@@ -5,12 +5,9 @@
    [malli.core :as m]
    [re-frame.core :as rf]
    [renderer.app.db :refer [App]]
-   [renderer.element.handlers :as element.h]
    [renderer.snap.db :refer [SnapOption NearestNeighbor]]
    [renderer.snap.subs :as-alias snap.s]
-   [renderer.tool.handlers :as tool.h]
-   [renderer.utils.bounds :as bounds]
-   [renderer.utils.element :as element]
+   [renderer.tool.hierarchy :as tool.hierarchy]
    [renderer.utils.math :refer [Vec2D]]))
 
 (m/=> toggle-option [:-> App SnapOption App])
@@ -20,36 +17,14 @@
     (update-in db [:snap :options] disj option)
     (update-in db [:snap :options] conj option)))
 
-(m/=> base-points [:-> App [:vector Vec2D]])
-(defn base-points
-  [db]
-  (let [elements (vals (element.h/entities db))
-        selected (filter :selected elements)
-        selected-visible (filter :visible selected)
-        options (-> db :snap :options)]
-    (when (-> db :snap :active)
-      (cond
-        (and (contains? #{:translate :clone} (:state db)) (seq selected))
-        (reduce (fn [points el] (into points (element/snapping-points el options)))
-                (if (seq (rest selected))
-                  (bounds/->snapping-points (element.h/bounds db) options)
-                  [])
-                selected-visible)
-
-        (contains? #{:edit :scale} (:state db))
-        [(mat/add [(-> db :clicked-element :x) (-> db :clicked-element :y)]
-                  (tool.h/pointer-delta db))]
-
-        :else
-        [(:adjusted-pointer-pos db)]))))
-
 (m/=> find-nearest-neighbors [:-> App [:sequential NearestNeighbor]])
 (defn find-nearest-neighbors
   [db]
   (let [tree @(rf/subscribe [::snap.s/in-viewport-tree])] ; FIXME: Subscription in event.
     (map #(let [nearest-neighbor (kdtree/nearest-neighbor tree %)]
             (when nearest-neighbor
-              (assoc nearest-neighbor :base-point %))) (base-points db))))
+              (assoc nearest-neighbor :base-point %)))
+         (tool.hierarchy/snapping-bases db))))
 
 (m/=> find-nearest-neighbor [:-> App [:maybe NearestNeighbor]])
 (defn find-nearest-neighbor
@@ -74,25 +49,20 @@
   (let [nearest-neighbor (find-nearest-neighbor db)]
     (cond-> db
       :always
-      (update :snap dissoc :nearest-neighbor)
+      (dissoc :nearest-neighbor)
 
       (and (-> db :snap :active) nearest-neighbor)
-      (assoc-in [:snap :nearest-neighbor] nearest-neighbor))))
-
-(m/=> nearest-neighbor [:-> App [:maybe NearestNeighbor]])
-(defn nearest-neighbor
-  [db]
-  (get-in db [:snap :nearest-neighbor]))
+      (assoc :nearest-neighbor nearest-neighbor))))
 
 (m/=> nearest-delta [:-> App Vec2D])
 (defn nearest-delta
   [db]
-  (let [{:keys [point base-point]} (nearest-neighbor db)]
+  (let [{:keys [point base-point]} (:nearest-neighbor db)]
     (mat/sub point base-point)))
 
 (defn snap-with
   [db f & more]
   (let [db (update-nearest-neighbor db)]
-    (if (nearest-neighbor db)
+    (if (:nearest-neighbor db)
       (apply f db (nearest-delta db) more)
       db)))

src/renderer/snap/handlers.cljs

@@ -22,7 +22,6 @@
 
 (rf/reg-sub
  ::nearest-neighbor
- :<- [::snap]
  :-> :nearest-neighbor)
 
 (rf/reg-sub

src/renderer/snap/subs.cljs

@@ -8,6 +8,7 @@
    [renderer.element.handlers :as element.h]
    [renderer.frame.handlers :as frame.h]
    [renderer.history.handlers :as history.h]
+   [renderer.snap.handlers :as snap.h]
    [renderer.tool.db :refer [Tool State Cursor]]
    [renderer.tool.effects :as-alias fx]
    [renderer.tool.hierarchy :as hierarchy]
@@ -83,7 +84,7 @@
 (m/=> pointer-handler [:-> App PointerEvent number? App])
 (defn pointer-handler
   [db e now]
-  (let [{:keys [pointer-offset tool dom-rect drag primary-tool drag-threshold]} db
+  (let [{:keys [pointer-offset tool dom-rect drag primary-tool drag-threshold nearest-neighbor]} db
         {:keys [button buttons pointer-pos]} e
         adjusted-pointer-pos (frame.h/adjust-pointer-pos db pointer-pos)]
     (case (:type e)
@@ -103,6 +104,7 @@
                 (hierarchy/drag e))
               db)
             (hierarchy/pointer-move db e))
+          (snap.h/update-nearest-neighbor)
           (assoc :pointer-pos pointer-pos
                  :adjusted-pointer-pos adjusted-pointer-pos))
 
@@ -114,7 +116,8 @@
 
         (not= buttons :right)
         (assoc :pointer-offset pointer-pos
-               :adjusted-pointer-offset adjusted-pointer-pos)
+               :adjusted-pointer-offset adjusted-pointer-pos
+               :nearest-neighbor-offset (:point nearest-neighbor))
 
         :always
         (hierarchy/pointer-down e))

src/renderer/tool/handlers.cljs

@@ -9,6 +9,7 @@
 (defmulti drag-end (fn [db _e] (:tool db)))
 (defmulti key-up (fn [db _e] (:tool db)))
 (defmulti key-down (fn [db _e] (:tool db)))
+(defmulti snapping-bases (fn [db _e] (:tool db)))
 (defmulti activate :tool)
 (defmulti deactivate :tool)
 (defmulti properties "Returns the properties of the tool." keyword)
@@ -28,6 +29,7 @@
 (defmethod activate :default [db] (assoc db :cursor "default"))
 (defmethod deactivate :default [db] (assoc db :cursor "default"))
 (defmethod properties :default [])
+(defmethod snapping-bases :default [])
 (defmethod help :default [_tool _state] "")
 
 

src/renderer/tool/hierarchy.cljs

@@ -1,5 +1,6 @@
 (ns renderer.tool.impl.base.edit
   (:require
+   [clojure.core.matrix :as mat]
    [renderer.element.handlers :as element.h]
    [renderer.element.hierarchy :as element.hierarchy]
    [renderer.history.handlers :as history.h]
@@ -77,3 +78,9 @@
       (h/set-state :idle)
       (dissoc :clicked-element)
       (h/explain "Edit")))
+
+(defmethod hierarchy/snapping-bases :edit
+  [db]
+  (when (contains? #{:edit :scale} (:state db))
+    [(mat/add [(-> db :clicked-element :x) (-> db :clicked-element :y)]
+              (mat/sub (:adjusted-pointer-pos db) (:adjusted-pointer-offset db)))]))

src/renderer/tool/impl/base/edit.cljs

@@ -315,3 +315,21 @@
       (h/set-state :idle)
       (element.h/clear-hovered)
       (dissoc :clicked-element :pivot-point)))
+
+(defmethod hierarchy/snapping-bases :transform
+  [db]
+  (let [elements (vals (element.h/entities db))
+        selected (filter :selected elements)
+        selected-visible (filter :visible selected)
+        options (-> db :snap :options)]
+    (cond
+      (and (contains? #{:translate :clone} (:state db)) (seq selected))
+      (reduce (fn [points el] (into points (element/snapping-points el options)))
+              (if (seq (rest selected))
+                (bounds/->snapping-points (element.h/bounds db) options)
+                [])
+              selected-visible)
+
+      (= (:state db) :scale)
+      [(mat/add [(-> db :clicked-element :x) (-> db :clicked-element :y)]
+                (mat/sub (:adjusted-pointer-pos db) (:adjusted-pointer-offset db)))])))

src/renderer/tool/impl/base/transform.cljs

@@ -14,8 +14,8 @@
 
 (defmethod hierarchy/drag :circle
   [db]
-  (let [offset (:adjusted-pointer-offset db)
-        position (:adjusted-pointer-pos db)
+  (let [offset (or (:nearest-neighbor-offset db) (:adjusted-pointer-offset db))
+        position (or (:point (:nearest-neighbor db)) (:adjusted-pointer-pos db))
         [x y] offset
         radius (mat/distance position offset)
         attrs {:cx x

src/renderer/tool/impl/element/circle.cljs

@@ -37,3 +37,7 @@
       (h/activate :transform)
       (h/set-state :idle)
       (h/explain (str "Create " (name (:tag (h/temp db)))))))
+
+(defmethod hierarchy/snapping-bases ::hierarchy/element
+  [db]
+  [(:adjusted-pointer-pos db)])

src/renderer/tool/impl/element/core.cljs

@@ -13,8 +13,8 @@
 
 (defn create-line
   [db]
-  (let [[offset-x offset-y] (:adjusted-pointer-offset db)
-        [x y] (:adjusted-pointer-pos db)
+  (let [[offset-x offset-y] (or (:nearest-neighbor-offset db) (:adjusted-pointer-offset db))
+        [x y] (or (:point (:nearest-neighbor db)) (:adjusted-pointer-pos db))
         attrs {:x1 offset-x
                :y1 offset-y
                :x2 x
@@ -26,7 +26,7 @@
 
 (defn update-line-end
   [db]
-  (let [[x y] (:adjusted-pointer-pos db)
+  (let [[x y] (or (:point (:nearest-neighbor db)) (:adjusted-pointer-pos db))
         temp (-> (h/temp db)
                  (assoc-in [:attrs :x2] x)
                  (assoc-in [:attrs :y2] y))]
@@ -35,7 +35,8 @@
 (defmethod tool.hierarchy/pointer-move :line
   [db]
   (cond-> db
-    (h/temp db) (update-line-end)))
+    (h/temp db)
+    (update-line-end)))
 
 (defmethod tool.hierarchy/pointer-up :line
   [db _e]

src/renderer/tool/impl/element/line.cljs

@@ -36,11 +36,12 @@
 
 (defmethod hierarchy/pointer-up ::hierarchy/polyshape
   [db]
-  (if (h/temp db)
-    (add-point db (:adjusted-pointer-pos db))
-    (-> db
-        (h/set-state :create)
-        (create-polyline (:adjusted-pointer-pos db)))))
+  (let [point (or (:point (:nearest-neighbor db)) (:adjusted-pointer-pos db))]
+    (if (h/temp db)
+      (add-point db point)
+      (-> db
+          (h/set-state :create)
+          (create-polyline point)))))
 
 (defmethod hierarchy/drag-end ::hierarchy/polyshape
   [db]
@@ -52,14 +53,15 @@
 
 (defmethod hierarchy/pointer-move ::hierarchy/polyshape
   [db]
-  (if-let [points (get-in db (points-path db))]
-    (let [point-vector (attr/points->vec points)]
-      (assoc-in db
-                (points-path db)
-                (str/join " " (concat (apply concat (if (second point-vector)
-                                                      (drop-last point-vector)
-                                                      point-vector))
-                                      (:adjusted-pointer-pos db))))) db))
+  (let [point (or (:point (:nearest-neighbor db)) (:adjusted-pointer-pos db))]
+    (if-let [points (get-in db (points-path db))]
+      (let [point-vector (attr/points->vec points)]
+        (assoc-in db
+                  (points-path db)
+                  (str/join " " (concat (apply concat (if (second point-vector)
+                                                        (drop-last point-vector)
+                                                        point-vector))
+                                        point)))) db)))
 
 (defmethod hierarchy/double-click ::hierarchy/polyshape
   [db _e]

src/renderer/tool/impl/element/polyshape.cljs

@@ -19,17 +19,15 @@
 
 (defmethod hierarchy/drag :rect
   [db e]
-  (let [[offset-x offset-y] (:adjusted-pointer-offset db)
-        [x y] (:adjusted-pointer-pos db)
-        lock-ratio (pointer/ctrl? e)
+  (let [[offset-x offset-y] (or (:nearest-neighbor-offset db) (:adjusted-pointer-offset db))
+        [x y] (or (:point (:nearest-neighbor db)) (:adjusted-pointer-pos db))
         width (abs (- x offset-x))
-        height (abs (- y offset-y))
-        attrs {:x (min x offset-x)
-               :y (min y offset-y)
-               :width (if lock-ratio (min width height) width)
-               :height (if lock-ratio (min width height) height)
-               :fill (document.h/attr db :fill)
-               :stroke (document.h/attr db :stroke)}]
+        height (abs (- y offset-y))]
     (h/set-temp db {:type :element
                     :tag :rect
-                    :attrs attrs})))
+                    :attrs {:x (min x offset-x)
+                            :y (min y offset-y)
+                            :width (if (pointer/ctrl? e) (min width height) width)
+                            :height (if (pointer/ctrl? e) (min width height) height)
+                            :fill (document.h/attr db :fill)
+                            :stroke (document.h/attr db :stroke)}})))

src/renderer/tool/impl/element/rect.cljs

@@ -22,15 +22,17 @@
   [db]
   (h/dissoc-temp db))
 
-(defmethod hierarchy/drag-end :measure
-  [db] db)
+(defmethod hierarchy/drag-end :measure [db] db)
+
+(defmethod hierarchy/snapping-bases :measure
+  [db]
+  [(:adjusted-pointer-pos db)])
 
 (defmethod hierarchy/drag :measure
   [db]
-  (let [{:keys [adjusted-pointer-offset adjusted-pointer-pos]} db
-        [offset-x offset-y] adjusted-pointer-offset
-        [x y] adjusted-pointer-pos
-        [adjacent opposite] (mat/sub adjusted-pointer-offset adjusted-pointer-pos)
+  (let [[offset-x offset-y] (or (:nearest-neighbor-offset db) (:adjusted-pointer-offset db))
+        [x y] (or (:point (:nearest-neighbor db)) (:adjusted-pointer-pos db))
+        [adjacent opposite] (mat/sub [offset-x offset-y] [x y])
         hypotenuse (Math/hypot adjacent opposite)]
     (h/set-temp db {:type :element
                     :tag :measure