✨ Add minor improvements to curve drawing internal impl

common/src/app/common/files/migrations.cljc

@@ -130,7 +130,7 @@
   [data _]
   (letfn [(migrate-path [shape]
             (if-not (contains? shape :content)
-              (let [content (path.segment/segments->content (:segments shape) (:close? shape))
+              (let [content (path.segment/points->content (:segments shape) :close (:close? shape))
                     selrect (path.segment/content->selrect content)
                     points  (grc/rect->points selrect)]
                 (-> shape

common/src/app/common/types/path/segment.cljc

@@ -8,6 +8,7 @@
   "A collection of helpers for work with plain segment type"
   (:require
    [app.common.data :as d]
+   [app.common.data.macros :as dm]
    [app.common.geom.matrix :as gmt]
    [app.common.geom.point :as gpt]
    [app.common.geom.rect :as grc]
@@ -96,11 +97,12 @@
 
       :else nil)))
 
+;; FIXME: rename to get-point
 (defn get-handler-point
   "Given a segment index and prefix, get a handler point"
   [content index prefix]
   (when (and (some? index)
-             (some? prefix))
+             (some? content))
     (impl/-lookup content index
                   (fn [command c1x c1y c2x c2y x y]
                     (let [prefix (if (= :curve-to command)
@@ -141,25 +143,6 @@
                     (gpt/point x y)))
                 [])))
 
-(defn segments->content
-  ([segments]
-   (segments->content segments false))
-
-  ([segments closed?]
-   (let [initial (first segments)
-         lines (rest segments)]
-
-     (d/concat-vec
-      [{:command :move-to
-        :params (select-keys initial [:x :y])}]
-
-      (->> lines
-           (map #(hash-map :command :line-to
-                           :params (select-keys % [:x :y]))))
-
-      (when closed?
-        [{:command :close-path}])))))
-
 ;; FIXME: incorrect API, don't need full shape
 (defn path->lines
   "Given a path returns a list of lines that approximate the path"
@@ -880,3 +863,27 @@
                   :else
                   content)]
     (conj content (impl/check-segment segment))))
+
+(defn points->content
+  "Given a vector of points generate a path content.
+
+  Mainly used for generate a path content from user drawing points
+  using curve drawing tool."
+  [points & {:keys [close]}]
+  (let [initial (first points)
+        point->params
+        (fn [point]
+          {:x (dm/get-prop point :x)
+           :y (dm/get-prop point :y)})]
+    (loop [points (rest points)
+           result [{:command :move-to
+                    :params (point->params initial)}]]
+      (if-let [point (first points)]
+        (recur (rest points)
+               (conj result {:command :line-to
+                             :params (point->params point)}))
+
+        (let [result (if close
+                       (conj result {:command :close-path})
+                       result)]
+          (impl/from-plain result))))))

common/test/common_tests/types/path_data_test.cljc

@@ -286,6 +286,17 @@
    {:command :line-to, :params {:x 0, :y 0}}
    {:command :close-path :params {}}])
 
+(t/deftest points-to-content
+  (let [initial  [(gpt/point 0.0 0.0)
+                  (gpt/point 10.0 10.0)
+                  (gpt/point 10.0 5.0)]
+        content  (path.segment/points->content initial)
+        segments (vec content)]
+    (t/is (= 3 (count segments)))
+    (t/is (= {:command :move-to, :params {:x 0.0, :y 0.0}} (nth segments 0)))
+    (t/is (= {:command :line-to, :params {:x 10.0, :y 10.0}} (nth segments 1)))
+    (t/is (= {:command :line-to, :params {:x 10.0, :y 5.0}} (nth segments 2)))))
+
 (t/deftest get-segments
   (let [content (path/content sample-content-square)
         points  #{(gpt/point 10.0 0.0)

frontend/src/app/main/data/workspace/drawing/curve.cljs

@@ -7,12 +7,11 @@
 (ns app.main.data.workspace.drawing.curve
   (:require
    [app.common.data.macros :as dm]
-   [app.common.geom.point :as gpt]
    [app.common.geom.rect :as grc]
    [app.common.geom.shapes.flex-layout :as gslf]
    [app.common.geom.shapes.grid-layout :as gslg]
    [app.common.types.container :as ctn]
-   [app.common.types.path.segment :as path.segm]
+   [app.common.types.path.segment :as path.segment]
    [app.common.types.shape :as cts]
    [app.common.types.shape-tree :as ctst]
    [app.common.types.shape.layout :as ctl]
@@ -25,7 +24,37 @@
    [beicon.v2.core :as rx]
    [potok.v2.core :as ptk]))
 
-(def simplify-tolerance 0.3)
+(def ^:const simplify-tolerance 0.3)
+
+(defn- setup-frame
+  []
+  (ptk/reify ::setup-frame
+    ptk/UpdateEvent
+    (update [_ state]
+      (let [objects      (dsh/lookup-page-objects state)
+            content      (dm/get-in state [:workspace-drawing :object :content])
+            position     (path.segment/get-handler-point content 0 nil)
+
+            frame-id     (->> (ctst/top-nested-frame objects position)
+                              (ctn/get-first-not-copy-parent objects) ;; We don't want to change the structure of component copies
+                              :id)
+
+            flex-layout? (ctl/flex-layout? objects frame-id)
+            grid-layout? (ctl/grid-layout? objects frame-id)
+
+            drop-index   (when flex-layout? (gslf/get-drop-index frame-id objects position))
+            drop-cell    (when grid-layout? (gslg/get-drop-cell frame-id objects position))]
+
+        (update-in state [:workspace-drawing :object]
+                   (fn [object]
+                     (-> object
+                         (assoc :frame-id frame-id)
+                         (assoc :parent-id frame-id)
+                         ;; FIXME: with-meta twice only one wins
+                         (cond-> (some? drop-index)
+                           (with-meta {:index drop-index}))
+                         (cond-> (some? drop-cell)
+                           (with-meta {:cell drop-cell})))))))))
 
 (defn- insert-point
   [point]
@@ -34,43 +63,16 @@
     (update [_ state]
       (update-in state [:workspace-drawing :object]
                  (fn [object]
-                   (let [segments (-> (:segments object)
+                   (let [points  (-> (::points object)
                                      (conj point))
-                         content  (path.segm/segments->content segments)
+                         content (path.segment/points->content points)
-                         selrect  (path.segm/content->selrect content)
+                         selrect (path.segment/content->selrect content)
-                         points   (grc/rect->points selrect)]
+                         points' (grc/rect->points selrect)]
                      (-> object
-                         (assoc :segments segments)
+                         (assoc ::points points)
                          (assoc :content content)
                          (assoc :selrect selrect)
-                         (assoc :points points))))))))
+                         (assoc :points points'))))))))
-
-(defn- setup-frame
-  []
-  (ptk/reify ::setup-frame
-    ptk/UpdateEvent
-    (update [_ state]
-      (let [objects      (dsh/lookup-page-objects state)
-            content      (dm/get-in state [:workspace-drawing :object :content] [])
-            start        (dm/get-in content [0 :params] nil)
-            position     (when start (gpt/point start))
-            frame-id     (->> (ctst/top-nested-frame objects position)
-                              (ctn/get-first-not-copy-parent objects) ;; We don't want to change the structure of component copies
-                              :id)
-            flex-layout? (ctl/flex-layout? objects frame-id)
-
-            grid-layout? (ctl/grid-layout? objects frame-id)
-            drop-index   (when flex-layout? (gslf/get-drop-index frame-id objects position))
-            drop-cell    (when grid-layout? (gslg/get-drop-cell frame-id objects position))]
-        (update-in state [:workspace-drawing :object]
-                   (fn [object]
-                     (-> object
-                         (assoc :frame-id frame-id)
-                         (assoc :parent-id frame-id)
-                         (cond-> (some? drop-index)
-                           (with-meta {:index drop-index}))
-                         (cond-> (some? drop-cell)
-                           (with-meta {:cell drop-cell})))))))))
 
 (defn finish-drawing
   []
@@ -78,13 +80,14 @@
     ptk/UpdateEvent
     (update [_ state]
       (update-in state [:workspace-drawing :object]
-                 (fn [{:keys [segments] :as shape}]
+                 (fn [{:keys [::points] :as shape}]
-                   (let [segments (ups/simplify segments simplify-tolerance)
+                   (let [points   (ups/simplify points simplify-tolerance)
-                         content  (path.segm/segments->content segments)
+                         content  (path.segment/points->content points)
-                         selrect  (path.segm/content->selrect content)
+                         selrect  (path.segment/content->selrect content)
                          points   (grc/rect->points selrect)]
+
                      (-> shape
-                         (dissoc :segments)
+                         (dissoc ::points)
                          (assoc :content content)
                          (assoc :selrect selrect)
                          (assoc :points points)
@@ -104,7 +107,7 @@
                                       :initialized? true
                                       :frame-id uuid/zero
                                       :parent-id uuid/zero
-                                      :segments []})]
+                                      ::points []})]
         (rx/concat
          (rx/of #(update % :workspace-drawing assoc :object shape))
          (->> mouse