✨ Adds point to curves tool

common/app/common/geom/point.cljc

@@ -253,7 +253,16 @@
   (and (mth/almost-zero? x)
        (mth/almost-zero? y)))
 
+(defn line-val
+  "Given a line with two points p1-p2 and a 'percent'. Returns the point in the vector
+  generated by these two points. For example: for p1=(0,0) p2=(1,1) and v=0.25 will return
+  the point (0.25, 0.25)"
+  [p1 p2 v]
+  (let [v (-> (to-vec p1 p2)
+              (scale v))]
+    (add p1 v)))
 
 ;; --- Debug
 
 (defmethod pp/simple-dispatch Point [obj] (pr obj))
+

common/app/common/geom/shapes/path.cljc

@@ -41,6 +41,20 @@
 
     (gpt/point (coord-v :x) (coord-v :y))))
 
+(defn curve-split
+  "Splits a curve into two at the given parametric value `t`.
+  Calculates the Casteljau's algorithm intermediate points"
+  [start end h1 h2 t]
+
+  (let [p1 (gpt/line-val start h1 t)
+        p2 (gpt/line-val h1 h2 t)
+        p3 (gpt/line-val h2 end t)
+        p4 (gpt/line-val p1 p2 t)
+        p5 (gpt/line-val p2 p3 t)
+        sp (gpt/line-val p4 p5 t)]
+    [[start sp  p1 p4]
+     [sp    end p5 p3]]))
+
 ;; https://pomax.github.io/bezierinfo/#extremities
 (defn curve-extremities
   "Given a cubic bezier cube finds its roots in t. This are the extremities

frontend/src/app/main/data/workspace/path/tools.cljs

@@ -14,6 +14,7 @@
    [app.main.data.workspace.path.common :as common]
    [app.main.data.workspace.path.state :as st]
    [app.util.geom.path :as ugp]
+   [app.common.geom.point :as gpt]
    [beicon.core :as rx]
    [potok.core :as ptk]))
 
@@ -41,8 +42,40 @@
             [rch uch] (changes/generate-path-changes page-id shape (:content shape) new-content)]
         (rx/of (dwc/commit-changes rch uch {:commit-local? true}))))))
 
+(defn split-segments [[start end cmd]]
+  (case (:command cmd)
+    :line-to [cmd (ugp/split-line-to start cmd 0.5)]
+    :curve-to [cmd (ugp/split-curve-to start cmd 0.5)]
+    :close-path [cmd [(ugp/make-line-to (gpt/line-val start end 0.5))
+                      cmd]]
+    nil))
+
 (defn add-node []
-  (ptk/reify ::add-node))
+  (ptk/reify ::add-node
+    ptk/WatchEvent
+    (watch [_ state stream]
+
+      (let [id (st/get-path-id state)
+            page-id (:current-page-id state)
+            shape (get-in state (st/get-path state))
+            selected-points (get-in state [:workspace-local :edit-path id :selected-points] #{})
+            content (:content shape)
+
+
+            cmd-changes (->> (ugp/get-segments content selected-points)
+                             (into {}
+                                   (comp (map split-segments)
+                                         (filter (comp not nil?)))))
+
+            process-segments (fn [command]
+                               (if (contains? cmd-changes command)
+                                 (get cmd-changes command)
+                                 [command]))
+
+            new-content (into [] (mapcat process-segments) content)
+
+            [rch uch] (changes/generate-path-changes page-id shape (:content shape) new-content)]
+        (rx/of (dwc/commit-changes rch uch {:commit-local? true}))))))
 
 (defn remove-node []
   (ptk/reify ::remove-node))

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

@@ -8,6 +8,7 @@
   (:require
    [app.common.data :as d]
    [app.common.geom.point :as gpt]
+   [app.common.geom.shapes.path :as gshp]
    [app.util.a2c :refer [a2c]]
    [app.util.geom.path-impl-simplify :as impl-simplify]
    [app.util.svg :as usvg]
@@ -64,6 +65,11 @@
         (cond-> result
           (not (empty? current)) (conj current))))))
 
+(defn command->point [command]
+  (when-not (nil? command)
+    (let [{{:keys [x y]} :params} command]
+      (gpt/point x y))))
+
 (defn command->param-list [command]
   (let [params (:params command)]
     (case (:command command)
@@ -387,6 +393,12 @@
        (mapv command->string)
        (str/join "")))
 
+(defn make-line-to [to]
+  {:command :line-to
+   :relative false
+   :params {:x (:x to)
+            :y (:y to)}})
+
 (defn make-curve-params
   ([point]
    (make-curve-params point point point))
@@ -401,6 +413,26 @@
     :c2x (:x h2)
     :c2y (:y h2)}))
 
+(defn make-curve-to [to h1 h2]
+  {:command :curve-to
+   :relative false
+   :params (make-curve-params to h1 h2)})
+
+(defn split-line-to [from-p cmd val]
+  (let [to-p (command->point cmd)
+        sp (gpt/line-val from-p to-p val)]
+    [(make-line-to sp) cmd]))
+
+(defn split-curve-to [from-p cmd val]
+  (let [params (:params cmd)
+        end (gpt/point (:x params) (:y params))
+        h1 (gpt/point (:c1x params) (:c1y params))
+        h2 (gpt/point (:c2x params) (:c2y params))
+        [[_ to1 h11 h21]
+         [_ to2 h12 h22]] (gshp/curve-split from-p end h1 h2 val)]
+    [(make-curve-to to1 h11 h21)
+     (make-curve-to to2 h12 h22)]))
+
 (defn opposite-handler
   "Calculates the coordinates of the opposite handler"
   [point handler]
@@ -441,11 +473,6 @@
     (let [content (if (vector? content) content (into [] content))]
       (reduce apply-to-index content modifiers))))
 
-(defn command->point [command]
-  (when-not (nil? command)
-    (let [{{:keys [x y]} :params} command]
-      (gpt/point x y))))
-
 (defn content->points [content]
   (->> content
        (map #(when (-> % :params :x) (gpt/point (-> % :params :x) (-> % :params :y))))
@@ -638,7 +665,7 @@
 
             segments (cond-> segments
                        is-segment?
-                       (conj [prev-point cur-point]))]
+                       (conj [prev-point cur-point cur-cmd]))]
 
         (if (some? cur-cmd)
           (recur segments