Merge pull request #6263 from penpot/niwinz-develop-path-data-optimizations-1

⚡ Performance optimizations to path related functions

backend/src/app/binfile/common.clj

@@ -434,12 +434,12 @@
                           (d/without-nils))))))
 
 (defn encode-file
-  [{:keys [::db/conn] :as cfg} {:keys [id] :as file}]
+  [{:keys [::db/conn] :as cfg} {:keys [id features] :as file}]
-  (let [file (if (contains? (:features file) "fdata/objects-map")
+  (let [file (if (contains? features "fdata/objects-map")
                (feat.fdata/enable-objects-map file)
                file)
 
-        file (if (contains? (:features file) "fdata/pointer-map")
+        file (if (contains? features "fdata/pointer-map")
                (binding [pmap/*tracked* (pmap/create-tracked)]
                  (let [file (feat.fdata/enable-pointer-map file)]
                    (feat.fdata/persist-pointers! cfg id)

backend/src/app/db.clj

@@ -42,6 +42,8 @@
    org.postgresql.util.PGInterval
    org.postgresql.util.PGobject))
 
+(def ^:dynamic *conn* nil)
+
 (declare open)
 (declare create-pool)
 

backend/src/app/features/components_v2.clj

@@ -20,7 +20,6 @@
    [app.common.geom.point :as gpt]
    [app.common.geom.rect :as grc]
    [app.common.geom.shapes :as gsh]
-   [app.common.geom.shapes.path :as gshp]
    [app.common.logging :as l]
    [app.common.logic.libraries :as cll]
    [app.common.math :as mth]
@@ -36,9 +35,9 @@
    [app.common.types.modifiers :as ctm]
    [app.common.types.page :as ctp]
    [app.common.types.pages-list :as ctpl]
+   [app.common.types.path :as path]
    [app.common.types.shape :as cts]
    [app.common.types.shape-tree :as ctst]
-   [app.common.types.shape.path :as ctsp]
    [app.common.types.shape.text :as ctsx]
    [app.common.uuid :as uuid]
    [app.config :as cf]
@@ -127,10 +126,10 @@
   (sm/lazy-validator ::ctsx/content))
 
 (def valid-path-content?
-  (sm/lazy-validator ::ctsp/content))
+  (sm/lazy-validator ::path/segments))
 
 (def valid-path-segment?
-  (sm/lazy-validator ::ctsp/segment))
+  (sm/lazy-validator ::path/segment))
 
 (def valid-rgb-color-string?
   (sm/lazy-validator ::ctc/rgb-color))
@@ -580,12 +579,10 @@
                       (let [shape (update shape :content fix-path-content)]
                         (if (not (valid-path-content? (:content shape)))
                           shape
-                          (let [[points selrect] (gshp/content->points+selrect shape (:content shape))]
+                          (-> shape
-                            (-> shape
+                              (dissoc :bool-content)
-                                (dissoc :bool-content)
+                              (dissoc :bool-type)
-                                (dissoc :bool-type)
+                              (path/update-geometry))))
-                                (assoc :points points)
-                                (assoc :selrect selrect)))))
 
                       ;; When we fount a bool shape with no content,
                       ;; we convert it to a simple rect

backend/src/app/features/fdata.clj

@@ -9,7 +9,10 @@
   (:require
    [app.common.data :as d]
    [app.common.exceptions :as ex]
+   [app.common.files.helpers :as cfh]
+   [app.common.files.migrations :as fmg]
    [app.common.logging :as l]
+   [app.common.types.path :as path]
    [app.db :as db]
    [app.db.sql :as-alias sql]
    [app.storage :as sto]
@@ -30,7 +33,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defn enable-objects-map
-  [file]
+  [file & _opts]
   (let [update-page
         (fn [page]
           (if (and (pmap/pointer-map? page)
@@ -136,10 +139,56 @@
 
 (defn enable-pointer-map
   "Enable the fdata/pointer-map feature on the file."
-  [file]
+  [file & _opts]
   (-> file
       (update :data (fn [fdata]
                       (-> fdata
                           (update :pages-index d/update-vals pmap/wrap)
                           (d/update-when :components pmap/wrap))))
       (update :features conj "fdata/pointer-map")))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; PATH-DATA
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn enable-path-data
+  "Enable the fdata/path-data feature on the file."
+  [file & _opts]
+  (letfn [(update-object [object]
+            (if (or (cfh/path-shape? object)
+                    (cfh/bool-shape? object))
+              (update object :content path/content)
+              object))
+
+          (update-container [container]
+            (d/update-when container :objects d/update-vals update-object))]
+
+    (-> file
+        (update :data (fn [data]
+                        (-> data
+                            (update :pages-index d/update-vals update-container)
+                            (d/update-when :components d/update-vals update-container))))
+        (update :features conj "fdata/path-data"))))
+
+(defn disable-path-data
+  [file & _opts]
+  (letfn [(update-object [object]
+            (if (or (cfh/path-shape? object)
+                    (cfh/bool-shape? object))
+              (update object :content vec)
+              object))
+
+          (update-container [container]
+            (d/update-when container :objects d/update-vals update-object))]
+
+    (when-let [conn db/*conn*]
+      (db/delete! conn :file-migration {:file-id (:id file)
+                                        :name "0003-convert-path-content"}))
+    (-> file
+        (update :data (fn [data]
+                        (-> data
+                            (update :pages-index d/update-vals update-container)
+                            (d/update-when :components d/update-vals update-container))))
+        (update :features disj "fdata/path-data")
+        (update :migrations disj "0003-convert-path-content")
+        (vary-meta update ::fmg/migrated disj "0003-convert-path-content"))))

backend/src/app/rpc/commands/files_create.clj

@@ -111,18 +111,21 @@
                         ::quotes/profile-id profile-id
                         ::quotes/project-id project-id})
 
-    ;; FIXME: IMPORTANT: this code can have race
+    ;; FIXME: IMPORTANT: this code can have race conditions, because
-    ;; conditions, because we have no locks for updating
+    ;; we have no locks for updating team so, creating two files
-    ;; team so, creating two files concurrently can lead
+    ;; concurrently can lead to lost team features updating
-    ;; to lost team features updating
 
-    ;; When newly computed features does not match exactly with
+    (when-let [features (-> features
-    ;; the features defined on team row, we update it
+                            (set/difference (:features team))
-    (when (not= features (:features team))
+                            (set/difference cfeat/no-team-inheritable-features)
-      (let [features (db/create-array conn "text" features)]
+                            (not-empty))]
+      (let [features (->> features
+                          (set/union (:features team))
+                          (db/create-array conn "text"))]
         (db/update! conn :team
                     {:features features}
-                    {:id team-id})))
+                    {:id (:id team)}
+                    {::db/return-keys false})))
 
     (-> (create-file cfg params)
         (vary-meta assoc ::audit/props {:team-id team-id}))))

backend/src/app/rpc/commands/files_update.clj

@@ -177,12 +177,19 @@
                                             :stored-revn (:revn file)}))
 
                       ;; When newly computed features does not match exactly with
-                      ;; the features defined on team row, we update it.
+                      ;; the features defined on team row, we update it
-                      (when (not= features (:features team))
+                      (when-let [features (-> features
-                        (let [features (db/create-array conn "text" features)]
+                                              (set/difference (:features team))
+                                              (set/difference cfeat/no-team-inheritable-features)
+                                              (not-empty))]
+                        (let [features (->> features
+                                            (set/union (:features team))
+                                            (db/create-array conn "text"))]
                           (db/update! conn :team
                                       {:features features}
-                                      {:id (:id team)})))
+                                      {:id (:id team)}
+                                      {::db/return-keys false})))
+
 
                       (mtx/run! metrics {:id :update-file-changes :inc (count changes)})
 

backend/src/app/srepl/main.clj

@@ -156,6 +156,10 @@
   [file-id & {:as opts}]
   (process-file! file-id feat.fdata/enable-pointer-map opts))
 
+(defn enable-path-data-feature-on-file!
+  [file-id & {:as opts}]
+  (process-file! file-id feat.fdata/enable-path-data opts))
+
 (defn enable-storage-features-on-file!
   [file-id & {:as opts}]
   (enable-objects-map-feature-on-file! file-id opts)
@@ -416,10 +420,12 @@
   "Apply a function to the file. Optionally save the changes or not.
   The function receives the decoded and migrated file data."
   [file-id update-fn & {:keys [rollback?] :or {rollback? true} :as opts}]
-  (db/tx-run! (assoc main/system ::db/rollback rollback?)
+  (let [file-id (h/parse-uuid file-id)]
-              (fn [system]
+    (db/tx-run! (assoc main/system ::db/rollback rollback?)
-                (binding [h/*system* system]
+                (fn [system]
-                  (h/process-file! system file-id update-fn opts)))))
+                  (binding [h/*system* system
+                            db/*conn* (db/get-connection system)]
+                    (h/process-file! system file-id update-fn opts))))))
 
 (defn process-team-files!
   "Apply a function to each file of the specified team."
@@ -431,7 +437,8 @@
                   (when (string? label)
                     (h/take-team-snapshot! system team-id label))
 
-                  (binding [h/*system* system]
+                  (binding [h/*system* system
+                            db/*conn* (db/get-connection system)]
                     (->> (feat.comp-v2/get-and-lock-team-files conn team-id)
                          (reduce (fn [result file-id]
                                    (if (h/process-file! system file-id update-fn opts)

common/src/app/common/features.cljc

@@ -46,6 +46,7 @@
   #{"fdata/objects-map"
     "fdata/pointer-map"
     "fdata/shape-data-type"
+    "fdata/path-data"
     "components/v2"
     "styles/v2"
     "layout/grid"
@@ -58,12 +59,18 @@
 ;; A set of features enabled by default
 (def default-features
   #{"fdata/shape-data-type"
+    "fdata/path-data"
     "styles/v2"
     "layout/grid"
     "components/v2"
     "plugins/runtime"
     "design-tokens/v1"})
 
+;; A set of features that should not be propagated to team on creating
+;; or modifying a file
+(def no-team-inheritable-features
+  #{"fdata/path-data"})
+
 ;; A set of features which only affects on frontend and can be enabled
 ;; and disabled freely by the user any time. This features does not
 ;; persist on file features field but can be permanently enabled on
@@ -86,8 +93,9 @@
 ;; without migration applied)
 (def no-migration-features
   (-> #{"layout/grid"
+        "design-tokens/v1"
         "fdata/shape-data-type"
-        "design-tokens/v1"}
+        "fdata/path-data"}
       (into frontend-only-features)
       (into backend-only-features)))
 

common/src/app/common/files/builder.cljc

@@ -272,14 +272,13 @@
 
           :else
           (let [objects (lookup-objects file)
-                content (gsh/calc-bool-content bool objects)
+                bool'   (gsh/update-bool bool children objects)]
-                bool'   (gsh/update-bool-selrect bool children objects)]
             (commit-change
              file
              {:type :mod-obj
               :id bool-id
               :operations
-              [{:type :set :attr :content :val content :ignore-touched true}
+              [{:type :set :attr :content :val (:content bool') :ignore-touched true}
                {:type :set :attr :selrect :val (:selrect bool') :ignore-touched true}
                {:type :set :attr :points  :val (:points bool') :ignore-touched true}
                {:type :set :attr :x       :val (-> bool' :selrect :x) :ignore-touched true}

common/src/app/common/files/changes.cljc

@@ -739,7 +739,7 @@
                 group
 
                 (= :bool (:type group))
-                (gsh/update-bool-selrect group children objects)
+                (gsh/update-bool group children objects)
 
                 (:masked-group group)
                 (set-mask-selrect group children)

common/src/app/common/files/changes_builder.cljc

@@ -8,7 +8,6 @@
   (:require
    [app.common.data :as d]
    [app.common.data.macros :as dm]
-   [app.common.features :as cfeat]
    [app.common.files.changes :as cfc]
    [app.common.files.helpers :as cfh]
    [app.common.geom.matrix :as gmt]
@@ -84,8 +83,7 @@
 
 (defn with-objects
   [changes objects]
-  (let [fdata (binding [cfeat/*current* #{"components/v2"}]
+  (let [fdata (ctf/make-file-data (uuid/next) uuid/zero)
-                (ctf/make-file-data (uuid/next) uuid/zero))
         fdata (assoc-in fdata [:pages-index uuid/zero :objects] objects)]
     (vary-meta changes assoc
                ::file-data fdata
@@ -480,9 +478,12 @@
           (let [old-val (get old attr)
                 new-val (get new attr)]
             (not= old-val new-val)))
-        new-obj (if with-objects?
+
-                  (update-fn object objects)
+        new-obj
-                  (update-fn object))]
+        (if with-objects?
+          (update-fn object objects)
+          (update-fn object))]
+
     (when-not (= object new-obj)
       (let [attrs (or attrs (d/concat-set (keys object) (keys new-obj)))]
         (filter (partial changed? object new-obj) attrs)))))
@@ -659,7 +660,7 @@
                                  nil               ;; so it does not need resize
 
                                  (= (:type parent) :bool)
-                                 (gsh/update-bool-selrect parent children objects)
+                                 (gsh/update-bool parent children objects)
 
                                  (= (:type parent) :group)
                                  (if (:masked-group parent)

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

@@ -16,7 +16,6 @@
    [app.common.geom.point :as gpt]
    [app.common.geom.rect :as grc]
    [app.common.geom.shapes :as gsh]
-   [app.common.geom.shapes.path :as gsp]
    [app.common.geom.shapes.text :as gsht]
    [app.common.logging :as l]
    [app.common.math :as mth]
@@ -27,6 +26,8 @@
    [app.common.types.component :as ctk]
    [app.common.types.container :as ctn]
    [app.common.types.file :as ctf]
+   [app.common.types.path :as path]
+   [app.common.types.path.segment :as path.segment]
    [app.common.types.shape :as cts]
    [app.common.types.shape.interactions :as ctsi]
    [app.common.types.shape.shadow :as ctss]
@@ -129,8 +130,8 @@
   [data _]
   (letfn [(migrate-path [shape]
             (if-not (contains? shape :content)
-              (let [content (gsp/segments->content (:segments shape) (:close? shape))
+              (let [content (path.segment/points->content (:segments shape) :close (:close? shape))
-                    selrect (gsh/content->selrect content)
+                    selrect (path.segment/content->selrect content)
                     points  (grc/rect->points selrect)]
                 (-> shape
                     (dissoc :segments)
@@ -201,7 +202,7 @@
             (if (= (:type shape) :path)
               (let [{:keys [width height]} (grc/points->rect (:points shape))]
                 (if (or (mth/almost-zero? width) (mth/almost-zero? height))
-                  (let [selrect (gsh/content->selrect (:content shape))
+                  (let [selrect (path.segment/content->selrect (:content shape))
                         points (grc/rect->points selrect)
                         transform (gmt/matrix)
                         transform-inv (gmt/matrix)]
@@ -1281,8 +1282,8 @@
             (d/update-when container :objects update-vals update-object))]
 
     (-> data
-        (update :pages-index update-vals update-container)
+        (update :pages-index d/update-vals update-container)
-        (update :components update-vals update-container))))
+        (d/update-when :components d/update-vals update-container))))
 
 (defmethod migrate-data "0003-fix-root-shape"
   [data _]
@@ -1306,6 +1307,23 @@
         (d/update-when :components d/update-vals update-container)
         (d/without-nils))))
 
+(defmethod migrate-data "0003-convert-path-content"
+  [data _]
+  (some-> cfeat/*new* (swap! conj "fdata/path-data"))
+
+  (letfn [(update-object [object]
+            (if (or (cfh/bool-shape? object)
+                    (cfh/path-shape? object))
+              (update object :content path/content)
+              object))
+
+          (update-container [container]
+            (d/update-when container :objects update-vals update-object))]
+
+    (-> data
+        (update :pages-index d/update-vals update-container)
+        (d/update-when :components d/update-vals update-container))))
+
 (def available-migrations
   (into (d/ordered-set)
         ["legacy-2"
@@ -1363,4 +1381,5 @@
          "0001-remove-tokens-from-groups"
          "0002-normalize-bool-content"
          "0002-clean-shape-interactions"
-         "0003-fix-root-shape"]))
+         "0003-fix-root-shape"
+         "0003-convert-path-content"]))

common/src/app/common/files/shapes_helpers.cljc

@@ -15,6 +15,8 @@
    [app.common.types.shape.layout :as ctl]
    [app.common.uuid :as uuid]))
 
+;; FIXME: move to logic?
+
 (defn prepare-add-shape
   [changes shape objects]
   (let [index   (:index (meta shape))
@@ -35,6 +37,7 @@
                       (pcb/update-shapes [(:parent-id shape)] #(ctl/push-into-cell % [id] row column)))
                     (cond-> (ctl/grid-layout? objects (:parent-id shape))
                       (pcb/update-shapes [(:parent-id shape)] ctl/assign-cells {:with-objects? true})))]
+
     [shape changes]))
 
 (defn prepare-move-shapes-into-frame
@@ -44,6 +47,7 @@
         to-move    (->> shapes
                         (map (d/getf objects))
                         (not-empty))]
+
     (if to-move
       (-> changes
           (cond-> (and remove-layout-data?

common/src/app/common/geom/point.cljc

@@ -5,7 +5,7 @@
 ;; Copyright (c) KALEIDOS INC
 
 (ns app.common.geom.point
-  (:refer-clojure :exclude [divide min max abs])
+  (:refer-clojure :exclude [divide min max abs zero?])
   (:require
    #?(:clj [app.common.fressian :as fres])
    #?(:cljs [cljs.core :as c]
@@ -470,6 +470,13 @@
   (and ^boolean (mth/almost-zero? (dm/get-prop p :x))
        ^boolean (mth/almost-zero? (dm/get-prop p :y))))
 
+(defn zero?
+  [p]
+  (let [x (dm/get-prop p :x)
+        y (dm/get-prop p :y)]
+    (and ^boolean (== 0 x)
+         ^boolean (== 0 y))))
+
 (defn lerp
   "Calculates a linear interpolation between two points given a tvalue"
   [p1 p2 t]

common/src/app/common/geom/shapes.cljc

@@ -10,13 +10,11 @@
    [app.common.data.macros :as dm]
    [app.common.geom.point :as gpt]
    [app.common.geom.rect :as grc]
-   [app.common.geom.shapes.bool :as gsb]
    [app.common.geom.shapes.common :as gco]
    [app.common.geom.shapes.constraints :as gct]
    [app.common.geom.shapes.corners :as gsc]
    [app.common.geom.shapes.fit-frame :as gsff]
    [app.common.geom.shapes.intersect :as gsi]
-   [app.common.geom.shapes.path :as gsp]
    [app.common.geom.shapes.transforms :as gtr]
    [app.common.math :as mth]))
 
@@ -166,7 +164,7 @@
 (dm/export gtr/calculate-geometry)
 (dm/export gtr/update-group-selrect)
 (dm/export gtr/update-mask-selrect)
-(dm/export gtr/update-bool-selrect)
+(dm/export gtr/update-bool)
 (dm/export gtr/apply-transform)
 (dm/export gtr/transform-shape)
 (dm/export gtr/transform-selrect)
@@ -180,12 +178,6 @@
 ;; Constratins
 (dm/export gct/calc-child-modifiers)
 
-;; PATHS
-;; FIXME: rename
-(dm/export gsp/content->selrect)
-(dm/export gsp/transform-content)
-(dm/export gsp/open-path?)
-
 ;; Intersection
 (dm/export gsi/overlaps?)
 (dm/export gsi/overlaps-path?)
@@ -193,9 +185,6 @@
 (dm/export gsi/has-point-rect?)
 (dm/export gsi/rect-contains-shape?)
 
-;; Bool
-(dm/export gsb/calc-bool-content)
-
 ;; Constraints
 (dm/export gct/default-constraints-h)
 (dm/export gct/default-constraints-v)

common/src/app/common/geom/shapes/bool.cljc

@@ -1,29 +0,0 @@
-;; 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) KALEIDOS INC
-
-(ns app.common.geom.shapes.bool
-  (:require
-   [app.common.data :as d]
-   [app.common.files.helpers :as cpf]
-   [app.common.svg.path.bool :as pb]
-   [app.common.svg.path.shapes-to-path :as stp]))
-
-(defn calc-bool-content
-  [shape objects]
-
-  (let [extract-content-xf
-        (comp (map (d/getf objects))
-              (filter (comp not :hidden))
-              (remove cpf/svg-raw-shape?)
-              (map #(stp/convert-to-path % objects))
-              (map :content))
-
-        shapes-content
-        (into [] extract-content-xf (:shapes shape))]
-    (pb/content-bool (:bool-type shape) shapes-content)))
-
-
-

common/src/app/common/geom/shapes/bounds.cljc

@@ -10,8 +10,8 @@
    [app.common.data.macros :as dm]
    [app.common.files.helpers :as cfh]
    [app.common.geom.rect :as grc]
-   [app.common.geom.shapes.path :as gsp]
+   [app.common.math :as mth]
-   [app.common.math :as mth]))
+   [app.common.types.path :as path]))
 
 (defn shape-stroke-margin
   [shape stroke-width]
@@ -104,7 +104,7 @@
    (let [strokes (:strokes shape)
 
          open-path?    (and ^boolean (cfh/path-shape? shape)
-                            ^boolean (gsp/open-path? shape))
+                            ^boolean (path/shape-with-open-path? shape))
 
          stroke-width
          (->> strokes

common/src/app/common/geom/shapes/intersect.cljc

@@ -13,9 +13,9 @@
    [app.common.geom.point :as gpt]
    [app.common.geom.rect :as grc]
    [app.common.geom.shapes.common :as gco]
-   [app.common.geom.shapes.path :as gpp]
    [app.common.geom.shapes.text :as gte]
-   [app.common.math :as mth]))
+   [app.common.math :as mth]
+   [app.common.types.path.segment :as path.segm]))
 
 (defn orientation
   "Given three ordered points gives the orientation
@@ -186,7 +186,7 @@
           rect-lines   (points->lines rect-points)
           path-lines   (if simple?
                          (points->lines (:points shape))
-                         (gpp/path->lines shape))
+                         (path.segm/path->lines shape))
           start-point (-> shape :content (first) :params (gpt/point))]
 
       (or (intersects-lines? rect-lines path-lines)

common/src/app/common/geom/shapes/transforms.cljc

@@ -12,11 +12,10 @@
    [app.common.geom.matrix :as gmt]
    [app.common.geom.point :as gpt]
    [app.common.geom.rect :as grc]
-   [app.common.geom.shapes.bool :as gshb]
    [app.common.geom.shapes.common :as gco]
-   [app.common.geom.shapes.path :as gpa]
    [app.common.math :as mth]
-   [app.common.types.modifiers :as ctm]))
+   [app.common.types.modifiers :as ctm]
+   [app.common.types.path :as path]))
 
 #?(:clj (set! *warn-on-reflection* true))
 
@@ -77,7 +76,11 @@
               position-data)
         position-data))))
 
-;; FIXME: revist usage of mutability
+;; FIXME: review performance of this; this function is executing too
+;; many times, including when the point vector is 0,0. This function
+;; can be implemented in function of transform which is already mor
+;; performant
+
 (defn move
   "Move the shape relatively to its current
   position applying the provided delta."
@@ -96,7 +99,7 @@
         (d/update-when :y d/safe+ dy)
         (d/update-when :position-data move-position-data mvec)
         (cond-> (or (= :bool type) (= :path type))
-          (update :content gpa/move-content mvec)))))
+          (update :content path/move-content mvec)))))
 
 ;; --- Absolute Movement
 
@@ -321,7 +324,7 @@
                   (update shape :position-data transform-position-data transform-mtx)
                   shape)
         shape   (if (or (= type :path) (= type :bool))
-                  (update shape :content gpa/transform-content transform-mtx)
+                  (update shape :content path/transform-content transform-mtx)
                   (assoc shape
                          :x (dm/get-prop selrect :x)
                          :y (dm/get-prop selrect :y)
@@ -354,7 +357,7 @@
                           360)
 
             shape    (if (or (= type :path) (= type :bool))
-                       (update shape :content gpa/transform-content transform-mtx)
+                       (update shape :content path/transform-content transform-mtx)
                        (assoc shape
                               :x (dm/get-prop selrect :x)
                               :y (dm/get-prop selrect :y)
@@ -444,24 +447,13 @@
         (assoc :flip-x  (-> mask :flip-x))
         (assoc :flip-y  (-> mask :flip-y)))))
 
-(defn update-bool-selrect
+(defn update-bool
   "Calculates the selrect+points for the boolean shape"
-  [shape children objects]
+  [shape _children objects]
 
-  (let [content
+  (let [content (path/calc-bool-content shape objects)
-        (gshb/calc-bool-content shape objects)
+        shape   (assoc shape :content content)]
-
+    (path/update-geometry shape)))
-        shape
-        (assoc shape :content content)
-
-        [points selrect]
-        (gpa/content->points+selrect shape content)]
-
-    (if (and (some? selrect) (d/not-empty? points))
-      (-> shape
-          (assoc :selrect selrect)
-          (assoc :points points))
-      (update-group-selrect shape children))))
 
 (defn update-shapes-geometry
   [objects ids]
@@ -476,7 +468,7 @@
                   (update-mask-selrect shape children)
 
                   (cfh/bool-shape? shape)
-                  (update-bool-selrect shape children objects)
+                  (update-bool shape children objects)
 
                   (cfh/group-shape? shape)
                   (update-group-selrect shape children)

common/src/app/common/schema.cljc

@@ -9,6 +9,7 @@
   #?(:cljs (:require-macros [app.common.schema :refer [ignoring]]))
   (:require
    [app.common.data :as d]
+   [app.common.math :as mth]
    [app.common.pprint :as pp]
    [app.common.schema.generators :as sg]
    [app.common.schema.openapi :as-alias oapi]
@@ -832,7 +833,8 @@
 
           gen  (sg/one-of
                 (sg/small-int :max max :min min)
-                (sg/small-double :max max :min min))]
+                (->> (sg/small-double :max max :min min)
+                     (sg/fmap #(mth/precision % 2))))]
 
       {:pred pred
        :type-properties

common/src/app/common/schema/generators.cljc

@@ -5,7 +5,7 @@
 ;; Copyright (c) KALEIDOS INC
 
 (ns app.common.schema.generators
-  (:refer-clojure :exclude [set subseq uuid filter map let boolean])
+  (:refer-clojure :exclude [set subseq uuid filter map let boolean vector])
   #?(:cljs (:require-macros [app.common.schema.generators]))
   (:require
    [app.common.schema.registry :as sr]
@@ -126,3 +126,7 @@
 (defn tuple
   [& opts]
   (apply tg/tuple opts))
+
+(defn vector
+  [& opts]
+  (apply tg/vector opts))

common/src/app/common/schema/test.cljc

@@ -56,13 +56,8 @@
              (str "(pass=TRUE, tests=" (:num-tests params)  ", seed=" (:seed params) ", elapsed=" time "ms)"))))
 
 (defmethod ct/report #?(:clj ::thrunk :cljs [:cljs.test/default ::thrunk])
-  [{:keys [::params] :as m}]
+  [_]
-  (let [smallest (-> params :shrunk :smallest vec)]
+  nil)
-    (println)
-    (println "Condition failed with the following params:")
-    (println "Seed:" (:seed params))
-    (println)
-    (pp/pprint smallest)))
 
 (defmethod ct/report #?(:clj ::trial :cljs [:cljs.test/default ::trial])
   [_]
@@ -76,9 +71,12 @@
   (let [tvar (get-testing-var)
         tsym (get-testing-sym tvar)
         res  (:result params)]
-    (println)
+
+    (println "---------------------------------------------------------")
     (println "Generative test:" (str "'" tsym "'")
              (str "(pass=FALSE, tests=" (:num-tests params)  ", seed=" (:seed params)  ")"))
+    (pp/pprint (:fail params))
+    (println "---------------------------------------------------------")
 
     (when (ex/exception? res)
       #?(:clj (ex/print-throwable res)

common/src/app/common/svg/path/command.cljc

@@ -1,204 +0,0 @@
-;; 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) KALEIDOS INC
-
-(ns app.common.svg.path.command
-  (:require
-   [app.common.data :as d]
-   [app.common.geom.point :as gpt]))
-
-(defn command->point
-  ([prev-pos {:keys [relative params] :as command}]
-   (let [{:keys [x y] :or {x (:x prev-pos) y (:y prev-pos)}} params]
-     (if relative
-       (-> prev-pos (update :x + x) (update :y + y))
-       (command->point command))))
-
-  ([command]
-   (when command
-     (let [{:keys [x y]} (:params command)]
-       (gpt/point x y)))))
-
-
-(defn make-move-to [to]
-  {:command :move-to
-   :relative false
-   :params {:x (:x to)
-            :y (:y to)}})
-
-(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))
-
-  ([point handler] (make-curve-params point handler point))
-
-  ([point h1 h2]
-   {:x (:x point)
-    :y (:y point)
-    :c1x (:x h1)
-    :c1y (:y h1)
-    :c2x (:x h2)
-    :c2y (:y h2)}))
-
-(defn update-curve-to
-  [command h1 h2]
-  (let [params {:x (-> command :params :x)
-                :y (-> command :params :y)
-                :c1x (:x h1)
-                :c1y (:y h1)
-                :c2x (:x h2)
-                :c2y (:y h2)}]
-    (-> command
-        (assoc :command :curve-to)
-        (assoc :params params))))
-
-(defn make-curve-to
-  [to h1 h2]
-  {:command :curve-to
-   :relative false
-   :params (make-curve-params to h1 h2)})
-
-(defn update-handler
-  [command prefix point]
-  (let [[cox coy] (if (= prefix :c1) [:c1x :c1y] [:c2x :c2y])]
-    (-> command
-        (assoc-in [:params cox] (:x point))
-        (assoc-in [:params coy] (:y point)))))
-
-(defn apply-content-modifiers
-  "Apply to content a map with point translations"
-  [content modifiers]
-  (letfn [(apply-to-index [content [index params]]
-            (if (contains? content index)
-              (cond-> content
-                (and
-                 (or (:c1x params) (:c1y params) (:c2x params) (:c2y params))
-                 (= :line-to (get-in content [index :command])))
-
-                (-> (assoc-in [index :command] :curve-to)
-                    (assoc-in [index :params]
-                              (make-curve-params
-                               (get-in content [index :params])
-                               (get-in content [(dec index) :params]))))
-
-                (:x params) (update-in [index :params :x] + (:x params))
-                (:y params) (update-in [index :params :y] + (:y params))
-
-                (:c1x params) (update-in [index :params :c1x] + (:c1x params))
-                (:c1y params) (update-in [index :params :c1y] + (:c1y params))
-
-                (:c2x params) (update-in [index :params :c2x] + (:c2x params))
-                (:c2y params) (update-in [index :params :c2y] + (:c2y params)))
-              content))]
-    (let [content (if (vector? content) content (into [] content))]
-      (reduce apply-to-index content modifiers))))
-
-(defn get-handler [{:keys [params] :as command} prefix]
-  (let [cx (d/prefix-keyword prefix :x)
-        cy (d/prefix-keyword prefix :y)]
-    (when (and command
-               (contains? params cx)
-               (contains? params cy))
-      (gpt/point (get params cx)
-                 (get params cy)))))
-
-(defn content->handlers
-  "Retrieve a map where for every point will retrieve a list of
-  the handlers that are associated with that point.
-  point -> [[index, prefix]]"
-  [content]
-  (->> (d/with-prev content)
-       (d/enumerate)
-       (mapcat (fn [[index [cur-cmd pre-cmd]]]
-                 (if (and pre-cmd (= :curve-to (:command cur-cmd)))
-                   (let [cur-pos (command->point cur-cmd)
-                         pre-pos (command->point pre-cmd)]
-                     (-> [[pre-pos [index :c1]]
-                          [cur-pos [index :c2]]]))
-                   [])))
-
-       (group-by first)
-       (d/mapm #(mapv second %2))))
-
-(defn point-indices
-  [content point]
-  (->> (d/enumerate content)
-       (filter (fn [[_ cmd]] (= point (command->point cmd))))
-       (mapv (fn [[index _]] index))))
-
-(defn handler-indices
-  "Return an index where the key is the positions and the values the handlers"
-  [content point]
-  (->> (d/with-prev content)
-       (d/enumerate)
-       (mapcat (fn [[index [cur-cmd pre-cmd]]]
-                 (if (and (some? pre-cmd) (= :curve-to (:command cur-cmd)))
-                   (let [cur-pos (command->point cur-cmd)
-                         pre-pos (command->point pre-cmd)]
-                     (cond-> []
-                       (= pre-pos point) (conj [index :c1])
-                       (= cur-pos point) (conj [index :c2])))
-                   [])))))
-
-(defn opposite-index
-  "Calculates the opposite index given a prefix and an index"
-  [content index prefix]
-
-  (let [point (if (= prefix :c2)
-                (command->point (nth content index))
-                (command->point (nth content (dec index))))
-
-        point->handlers (content->handlers content)
-
-        handlers (->> point
-                      (point->handlers)
-                      (filter (fn [[ci cp]] (and (not= index ci) (not= prefix cp)))))]
-
-    (cond
-      (= (count handlers) 1)
-      (->> handlers first)
-
-      (and (= :c1 prefix) (= (count content) index))
-      [(dec index) :c2]
-
-      :else nil)))
-
-
-(defn get-commands
-  "Returns the commands involving a point with its indices"
-  [content point]
-  (->> (d/enumerate content)
-       (filterv (fn [[_ cmd]] (= (command->point cmd) point)))))
-
-
-(defn prefix->coords [prefix]
-  (case prefix
-    :c1 [:c1x :c1y]
-    :c2 [:c2x :c2y]
-    nil))
-
-(defn handler->point [content index prefix]
-  (when (and (some? index)
-             (some? prefix)
-             (contains? content index))
-    (let [[cx cy] (prefix->coords prefix)]
-      (if (= :curve-to (get-in content [index :command]))
-        (gpt/point (get-in content [index :params cx])
-                   (get-in content [index :params cy]))
-
-        (gpt/point (get-in content [index :params :x])
-                   (get-in content [index :params :y]))))))
-
-(defn handler->node [content index prefix]
-  (if (= prefix :c1)
-    (command->point (get content (dec index)))
-    (command->point (get content index))))
-

common/src/app/common/svg/path/legacy_parser1.cljs

@@ -1,324 +0,0 @@
-;; 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) KALEIDOS INC
-
-(ns app.common.svg.path.legacy-parser1
-  "The first SVG Path parser implementation.
-
-  Written in a mix of CLJS and JS code and used in production until
-  1.19, used mainly for tests."
-  (:require
-   [app.common.data :as d]
-   [app.common.geom.point :as gpt]
-   [app.common.geom.shapes.path :as upg]
-   [app.common.svg :as csvg]
-   [app.common.svg.path.arc-to-bezier :as a2b]
-   [app.common.svg.path.command :as upc]
-   [cuerdas.core :as str]))
-
-(def commands-regex #"(?i)[mzlhvcsqta][^mzlhvcsqta]*")
-
-;; Matches numbers for path values allows values like... -.01, 10, +12.22
-;; 0 and 1 are special because can refer to flags
-(def num-regex #"[+-]?(\d+(\.\d+)?|\.\d+)(e[+-]?\d+)?")
-
-(def flag-regex #"[01]")
-
-(defn extract-params [cmd-str extract-commands]
-  (loop [result []
-         extract-idx 0
-         current {}
-         remain (-> cmd-str (subs 1) (str/trim))]
-
-    (let [[param type] (nth extract-commands extract-idx)
-          regex (case type
-                  :flag     flag-regex
-                  #_:number num-regex)
-          match (re-find regex remain)]
-
-      (if match
-        (let [value (-> match first csvg/fix-dot-number d/read-string)
-              remain (str/replace-first remain regex "")
-              current (assoc current param value)
-              extract-idx (inc extract-idx)
-              [result current extract-idx]
-              (if (>=  extract-idx (count extract-commands))
-                [(conj result current) {} 0]
-                [result current extract-idx])]
-          (recur result
-                 extract-idx
-                 current
-                 remain))
-        (cond-> result
-          (seq current) (conj current))))))
-
-;; Path specification
-;; https://www.w3.org/TR/SVG11/paths.html
-(defmulti parse-command (comp str/upper first))
-
-(defmethod parse-command "M" [cmd]
-  (let [relative (str/starts-with? cmd "m")
-        param-list (extract-params cmd [[:x :number]
-                                        [:y :number]])]
-
-    (into [{:command :move-to
-            :relative relative
-            :params (first param-list)}]
-
-          (for [params (rest param-list)]
-            {:command :line-to
-             :relative relative
-             :params params}))))
-
-(defmethod parse-command "Z" [_]
-  [{:command :close-path}])
-
-(defmethod parse-command "L" [cmd]
-  (let [relative (str/starts-with? cmd "l")
-        param-list (extract-params cmd [[:x :number]
-                                        [:y :number]])]
-    (for [params param-list]
-      {:command :line-to
-       :relative relative
-       :params params})))
-
-(defmethod parse-command "H" [cmd]
-  (let [relative (str/starts-with? cmd "h")
-        param-list (extract-params cmd [[:value :number]])]
-    (for [params param-list]
-      {:command :line-to-horizontal
-       :relative relative
-       :params params})))
-
-(defmethod parse-command "V" [cmd]
-  (let [relative (str/starts-with? cmd "v")
-        param-list (extract-params cmd [[:value :number]])]
-    (for [params param-list]
-      {:command :line-to-vertical
-       :relative relative
-       :params params})))
-
-(defmethod parse-command "C" [cmd]
-  (let [relative (str/starts-with? cmd "c")
-        param-list (extract-params cmd [[:c1x :number]
-                                        [:c1y :number]
-                                        [:c2x :number]
-                                        [:c2y :number]
-                                        [:x   :number]
-                                        [:y   :number]])]
-    (for [params param-list]
-      {:command :curve-to
-       :relative relative
-       :params params})))
-
-(defmethod parse-command "S" [cmd]
-  (let [relative (str/starts-with? cmd "s")
-        param-list (extract-params cmd [[:cx :number]
-                                        [:cy :number]
-                                        [:x  :number]
-                                        [:y  :number]])]
-    (for [params param-list]
-      {:command :smooth-curve-to
-       :relative relative
-       :params params})))
-
-(defmethod parse-command "Q" [cmd]
-  (let [relative (str/starts-with? cmd "q")
-        param-list (extract-params cmd [[:cx :number]
-                                        [:cy :number]
-                                        [:x   :number]
-                                        [:y   :number]])]
-    (for [params param-list]
-      {:command :quadratic-bezier-curve-to
-       :relative relative
-       :params params})))
-
-(defmethod parse-command "T" [cmd]
-  (let [relative (str/starts-with? cmd "t")
-        param-list (extract-params cmd [[:x :number]
-                                        [:y :number]])]
-    (for [params param-list]
-      {:command :smooth-quadratic-bezier-curve-to
-       :relative relative
-       :params params})))
-
-(defmethod parse-command "A" [cmd]
-  (let [relative (str/starts-with? cmd "a")
-        param-list (extract-params cmd [[:rx :number]
-                                        [:ry :number]
-                                        [:x-axis-rotation :number]
-                                        [:large-arc-flag :flag]
-                                        [:sweep-flag :flag]
-                                        [:x :number]
-                                        [:y :number]])]
-    (for [params param-list]
-      {:command :elliptical-arc
-       :relative relative
-       :params params})))
-
-(defn smooth->curve
-  [{:keys [params]} pos handler]
-  (let [{c1x :x c1y :y} (upg/calculate-opposite-handler pos handler)]
-    {:c1x c1x
-     :c1y c1y
-     :c2x (:cx params)
-     :c2y (:cy params)}))
-
-(defn quadratic->curve
-  [sp ep cp]
-  (let [cp1 (-> (gpt/to-vec sp cp)
-                (gpt/scale (/ 2 3))
-                (gpt/add sp))
-
-        cp2 (-> (gpt/to-vec ep cp)
-                (gpt/scale (/ 2 3))
-                (gpt/add ep))]
-
-    {:c1x (:x cp1)
-     :c1y (:y cp1)
-     :c2x (:x cp2)
-     :c2y (:y cp2)}))
-
-(defn arc->beziers*
-  [from-x from-y x y large-arc-flag sweep-flag rx ry x-axis-rotation]
-  (a2b/calculateBeziers from-x from-y x y large-arc-flag sweep-flag rx ry x-axis-rotation))
-
-(defn arc->beziers [from-p command]
-  (let [to-command
-        (fn [[_ _ c1x c1y c2x c2y x y]]
-          {:command :curve-to
-           :relative (:relative command)
-           :params {:c1x c1x :c1y c1y
-                    :c2x c2x :c2y c2y
-                    :x   x   :y   y}})
-
-        {from-x :x from-y :y} from-p
-        {:keys [rx ry x-axis-rotation large-arc-flag sweep-flag x y]} (:params command)
-        result (arc->beziers* from-x from-y x y large-arc-flag sweep-flag rx ry x-axis-rotation)]
-    (mapv to-command result)))
-
-(defn simplify-commands
-  "Removes some commands and convert relative to absolute coordinates"
-  [commands]
-  (let [simplify-command
-        ;; prev-pos   : previous position for the current path. Necessary for relative commands
-        ;; prev-start : previous move-to necessary for Z commands
-        ;; prev-cc    : previous command control point for cubic beziers
-        ;; prev-qc    : previous command control point for quadratic curves
-        (fn [[result prev-pos prev-start prev-cc prev-qc] [command _prev]]
-          (let [command (assoc command :prev-pos prev-pos)
-
-                command
-                (cond-> command
-                  (:relative command)
-                  (-> (assoc :relative false)
-                      (d/update-in-when [:params :c1x] + (:x prev-pos))
-                      (d/update-in-when [:params :c1y] + (:y prev-pos))
-
-                      (d/update-in-when [:params :c2x] + (:x prev-pos))
-                      (d/update-in-when [:params :c2y] + (:y prev-pos))
-
-                      (d/update-in-when [:params :cx] + (:x prev-pos))
-                      (d/update-in-when [:params :cy] + (:y prev-pos))
-
-                      (d/update-in-when [:params :x] + (:x prev-pos))
-                      (d/update-in-when [:params :y] + (:y prev-pos))
-
-                      (cond->
-                       (= :line-to-horizontal (:command command))
-                        (d/update-in-when [:params :value] + (:x prev-pos))
-
-                        (= :line-to-vertical (:command command))
-                        (d/update-in-when [:params :value] + (:y prev-pos)))))
-
-                params (:params command)
-                orig-command command
-
-                command
-                (cond-> command
-                  (= :line-to-horizontal (:command command))
-                  (-> (assoc :command :line-to)
-                      (update :params dissoc :value)
-                      (assoc-in [:params :x] (:value params))
-                      (assoc-in [:params :y] (:y prev-pos)))
-
-                  (= :line-to-vertical (:command command))
-                  (-> (assoc :command :line-to)
-                      (update :params dissoc :value)
-                      (assoc-in [:params :y] (:value params))
-                      (assoc-in [:params :x] (:x prev-pos)))
-
-                  (= :smooth-curve-to (:command command))
-                  (-> (assoc :command :curve-to)
-                      (update :params dissoc :cx :cy)
-                      (update :params merge (smooth->curve command prev-pos prev-cc)))
-
-                  (= :quadratic-bezier-curve-to (:command command))
-                  (-> (assoc :command :curve-to)
-                      (update :params dissoc :cx :cy)
-                      (update :params merge (quadratic->curve prev-pos (gpt/point params) (gpt/point (:cx params) (:cy params)))))
-
-                  (= :smooth-quadratic-bezier-curve-to (:command command))
-                  (-> (assoc :command :curve-to)
-                      (update :params merge (quadratic->curve prev-pos (gpt/point params) (upg/calculate-opposite-handler prev-pos prev-qc)))))
-
-                result (if (= :elliptical-arc (:command command))
-                         (into result (arc->beziers prev-pos command))
-                         (conj result command))
-
-                next-cc (case (:command orig-command)
-                          :smooth-curve-to
-                          (gpt/point (get-in orig-command [:params :cx]) (get-in orig-command [:params :cy]))
-
-                          :curve-to
-                          (gpt/point (get-in orig-command [:params :c2x]) (get-in orig-command [:params :c2y]))
-
-                          (:line-to-horizontal :line-to-vertical)
-                          (gpt/point (get-in command [:params :x]) (get-in command [:params :y]))
-
-                          (gpt/point (get-in orig-command [:params :x]) (get-in orig-command [:params :y])))
-
-                next-qc (case (:command orig-command)
-                          :quadratic-bezier-curve-to
-                          (gpt/point (get-in orig-command [:params :cx]) (get-in orig-command [:params :cy]))
-
-                          :smooth-quadratic-bezier-curve-to
-                          (upg/calculate-opposite-handler prev-pos prev-qc)
-
-                          (gpt/point (get-in orig-command [:params :x]) (get-in orig-command [:params :y])))
-
-                next-pos (if (= :close-path (:command command))
-                           prev-start
-                           (upc/command->point prev-pos command))
-
-                next-start (if (= :move-to (:command command)) next-pos prev-start)]
-
-            [result next-pos next-start next-cc next-qc]))
-
-        start (first commands)
-        start (cond-> start
-                (:relative start)
-                (assoc :relative false))
-
-        start-pos (gpt/point (:params start))]
-
-    (->> (map vector (rest commands) commands)
-         (reduce simplify-command [[start] start-pos start-pos start-pos start-pos])
-         (first))))
-
-(defn parse [path-str]
-  (if (empty? path-str)
-    path-str
-    (let [clean-path-str
-          (-> path-str
-              (str/trim)
-              ;; Change "commas" for spaces
-              (str/replace #"," " ")
-              ;; Remove all consecutive spaces
-              (str/replace #"\s+" " "))
-          commands (re-seq commands-regex clean-path-str)]
-      (-> (mapcat parse-command commands)
-          (simplify-commands)))))
-

common/src/app/common/svg/path/legacy_parser2.cljc

@@ -12,15 +12,23 @@
   (:require
    [app.common.data :as d]
    [app.common.geom.point :as gpt]
-   [app.common.geom.shapes.path :as upg]
    [app.common.math :as mth]
    [app.common.svg :as csvg]
-   [app.common.svg.path.command :as upc]
+   [app.common.types.path.helpers :as path.helpers]
+   [app.common.types.path.segment :as path.segment]
    [cuerdas.core :as str]))
 
 (def commands-regex #"(?i)[mzlhvcsqta][^mzlhvcsqta]*")
 (def regex #"[+-]?(\d+(\.\d+)?|\.\d+)(e[+-]?\d+)?")
 
+(defn- get-point
+  "Get a point for a segment"
+  [prev-pos {:keys [relative params] :as segment}]
+  (let [{:keys [x y] :or {x (:x prev-pos) y (:y prev-pos)}} params]
+    (if relative
+      (-> prev-pos (update :x + x) (update :y + y))
+      (path.helpers/segment->point segment))))
+
 (defn extract-params
   [data pattern]
   (loop [result  []
@@ -185,7 +193,7 @@
 
 (defn smooth->curve
   [{:keys [params]} pos handler]
-  (let [{c1x :x c1y :y} (upg/calculate-opposite-handler pos handler)]
+  (let [{c1x :x c1y :y} (path.segment/calculate-opposite-handler pos handler)]
     {:c1x c1x
      :c1y c1y
      :c2x (:cx params)
@@ -413,7 +421,7 @@
 
                   (= :smooth-quadratic-bezier-curve-to (:command command))
                   (-> (assoc :command :curve-to)
-                      (update :params merge (quadratic->curve prev-pos (gpt/point params) (upg/calculate-opposite-handler prev-pos prev-qc)))))
+                      (update :params merge (quadratic->curve prev-pos (gpt/point params) (path.segment/calculate-opposite-handler prev-pos prev-qc)))))
 
                 result (if (= :elliptical-arc (:command command))
                          (into result (arc->beziers prev-pos command))
@@ -436,13 +444,13 @@
                           (gpt/point (get-in orig-command [:params :cx]) (get-in orig-command [:params :cy]))
 
                           :smooth-quadratic-bezier-curve-to
-                          (upg/calculate-opposite-handler prev-pos prev-qc)
+                          (path.segment/calculate-opposite-handler prev-pos prev-qc)
 
                           (gpt/point (get-in orig-command [:params :x]) (get-in orig-command [:params :y])))
 
                 next-pos (if (= :close-path (:command command))
                            prev-start
-                           (upc/command->point prev-pos command))
+                           (get-point prev-pos command))
 
                 next-start (if (= :move-to (:command command)) next-pos prev-start)]
 

common/src/app/common/svg/shapes_builder.cljc

@@ -22,6 +22,7 @@
    [app.common.schema :as sm :refer [max-safe-int min-safe-int]]
    [app.common.svg :as csvg]
    [app.common.svg.path :as path]
+   [app.common.types.path.segment :as path.segm]
    [app.common.types.shape :as cts]
    [app.common.uuid :as uuid]
    [cuerdas.core :as str]))
@@ -220,9 +221,9 @@
     (let [transform (csvg/parse-transform (:transform attrs))
           content   (cond-> (path/parse (:d attrs))
                       (some? transform)
-                      (gsh/transform-content transform))
+                      (path.segm/transform-content transform))
 
-          selrect    (gsh/content->selrect content)
+          selrect    (path.segm/content->selrect content)
           points     (grc/rect->points selrect)
           origin     (gpt/negate (gpt/point svg-data))
           attrs      (-> (dissoc attrs :d :transform)

common/src/app/common/types/file.cljc

@@ -127,11 +127,11 @@
                 (ctp/make-empty-page {:id page-id :name "Page 1"}))]
 
      (cond-> (assoc empty-file-data :id file-id)
-       (some? page-id)
+       (some? page)
        (ctpl/add-page page)
 
        :always
-       (assoc-in [:options :components-v2] true)))))
+       (update :options assoc :components-v2 true)))))
 
 (defn make-file
   [{:keys [id project-id name revn is-shared features

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

@@ -0,0 +1,215 @@
+;; 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) KALEIDOS INC
+
+(ns app.common.types.path
+  (:require
+   [app.common.data :as d]
+   [app.common.data.macros :as dm]
+   [app.common.files.helpers :as cpf]
+   [app.common.geom.matrix :as gmt]
+   [app.common.geom.point :as gpt]
+   [app.common.geom.rect :as grc]
+   [app.common.geom.shapes.common :as gco]
+   [app.common.types.path.bool :as bool]
+   [app.common.types.path.helpers :as helpers]
+   [app.common.types.path.impl :as impl]
+   [app.common.types.path.segment :as segment]
+   [app.common.types.path.shape-to-path :as stp]
+   [app.common.types.path.subpath :as subpath]))
+
+#?(:clj (set! *warn-on-reflection* true))
+
+(defn content?
+  [o]
+  (impl/path-data? o))
+
+(defn content
+  "Create path content from plain data or bytes, returns itself if it
+  is already PathData instance"
+  [data]
+  (impl/path-data data))
+
+(defn from-bytes
+  [data]
+  (impl/from-bytes data))
+
+(defn check-path-content
+  [content]
+  (impl/check-content-like content))
+
+(defn get-byte-size
+  "Get byte size of a path content"
+  [content]
+  (impl/-get-byte-size content))
+
+(defn write-to
+  [content buffer offset]
+  (impl/-write-to content buffer offset))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; TRANSFORMATIONS
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn close-subpaths
+  "Given a content, searches a path for possible subpaths that can
+  create closed loops and merge them; then return the transformed path
+  conten as PathData instance"
+  [content]
+  (-> (subpath/close-subpaths content)
+      (impl/from-plain)))
+
+(defn apply-content-modifiers
+  "Apply delta modifiers over the path content"
+  [content modifiers]
+  (assert (impl/check-content-like content))
+
+  (letfn [(apply-to-index [content [index params]]
+            (if (contains? content index)
+              (cond-> content
+                (and
+                 (or (:c1x params) (:c1y params) (:c2x params) (:c2y params))
+                 (= :line-to (get-in content [index :command])))
+
+                (-> (assoc-in [index :command] :curve-to)
+                    (assoc-in [index :params]
+                              (helpers/make-curve-params
+                               (get-in content [index :params])
+                               (get-in content [(dec index) :params]))))
+
+                (:x params) (update-in [index :params :x] + (:x params))
+                (:y params) (update-in [index :params :y] + (:y params))
+
+                (:c1x params) (update-in [index :params :c1x] + (:c1x params))
+                (:c1y params) (update-in [index :params :c1y] + (:c1y params))
+
+                (:c2x params) (update-in [index :params :c2x] + (:c2x params))
+                (:c2y params) (update-in [index :params :c2y] + (:c2y params)))
+              content))]
+
+    (impl/path-data
+     (reduce apply-to-index (vec content) modifiers))))
+
+(defn transform-content
+  "Applies a transformation matrix over content and returns a new
+  content as PathData instance."
+  [content transform]
+  (segment/transform-content content transform))
+
+(defn move-content
+  [content move-vec]
+  (if (gpt/zero? move-vec)
+    content
+    (segment/move-content content move-vec)))
+
+(defn update-geometry
+  "Update shape with new geometry calculated from provided content"
+  ([shape content]
+   (update-geometry (assoc shape :content content)))
+  ([shape]
+   (let [flip-x
+         (get shape :flip-x)
+
+         flip-y
+         (get shape :flip-y)
+
+         ;; NOTE: we ensure that content is PathData instance
+         content
+         (impl/path-data
+          (get shape :content))
+
+         ;; Ensure plain format once
+         transform
+         (cond-> (:transform shape (gmt/matrix))
+           flip-x (gmt/scale (gpt/point -1 1))
+           flip-y (gmt/scale (gpt/point 1 -1)))
+
+         transform-inverse
+         (cond-> (gmt/matrix)
+           flip-x (gmt/scale (gpt/point -1 1))
+           flip-y (gmt/scale (gpt/point 1 -1))
+           :always (gmt/multiply (:transform-inverse shape (gmt/matrix))))
+
+         center
+         (or (some-> (dm/get-prop shape :selrect) grc/rect->center)
+             (segment/content-center content))
+
+         base-content
+         (segment/transform-content content (gmt/transform-in center transform-inverse))
+
+         ;; Calculates the new selrect with points given the old center
+         points
+         (-> (segment/content->selrect base-content)
+             (grc/rect->points)
+             (gco/transform-points center transform))
+
+         points-center
+         (gco/points->center points)
+
+         ;; Points is now the selrect but the center is different so we can create the selrect
+         ;; through points
+         selrect
+         (-> points
+             (gco/transform-points points-center transform-inverse)
+             (grc/points->rect))]
+
+     (-> shape
+         (assoc :content content)
+         (assoc :points points)
+         (assoc :selrect selrect)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; PATH SHAPE HELPERS
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn get-points
+  "Returns points for the given segment, faster version of
+  the `content->points`."
+  [content]
+  (some-> content segment/get-points))
+
+(defn- calc-bool-content*
+  "Calculate the boolean content from shape and objects. Returns plain
+  vector of segments"
+  [shape objects]
+  (let [extract-content-xf
+        (comp (map (d/getf objects))
+              (remove :hidden)
+              (remove cpf/svg-raw-shape?)
+              (map #(stp/convert-to-path % objects))
+              (map :content))
+
+        contents
+        (sequence extract-content-xf (:shapes shape))]
+
+    (bool/calculate-content (:bool-type shape) contents)))
+
+(defn calc-bool-content
+  "Calculate the boolean content from shape and objects. Returns a
+  packed PathData instance"
+  [shape objects]
+  (-> (calc-bool-content* shape objects)
+      (impl/path-data)))
+
+(defn shape-with-open-path?
+  [shape]
+  (let [svg? (contains? shape :svg-attrs)
+        ;; No close subpaths for svgs imported
+        maybe-close (if svg? identity subpath/close-subpaths)]
+    (and (= :path (:type shape))
+         (not (->> shape
+                   :content
+                   (maybe-close)
+                   (subpath/get-subpaths)
+                   (every? subpath/is-closed?))))))
+
+(defn convert-to-path
+  "Transform a shape to a path shape"
+  ([shape]
+   (convert-to-path shape {}))
+  ([shape objects]
+   (-> (stp/convert-to-path shape objects)
+       (update :content impl/path-data))))
+

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

@@ -4,15 +4,42 @@
 ;;
 ;; Copyright (c) KALEIDOS INC
 
-(ns app.common.svg.path.bool
+(ns app.common.types.path.bool
   (:require
+   [app.common.colors :as clr]
    [app.common.data :as d]
    [app.common.geom.point :as gpt]
    [app.common.geom.rect :as grc]
-   [app.common.geom.shapes.path :as gsp]
    [app.common.math :as mth]
-   [app.common.svg.path.command :as upc]
+   [app.common.types.path.helpers :as helpers]
-   [app.common.svg.path.subpath :as ups]))
+   [app.common.types.path.segment :as segment]
+   [app.common.types.path.subpath :as subpath]))
+
+(def default-fills
+  [{:fill-color clr/black}])
+
+(def style-group-properties
+  [:shadow :blur])
+
+(def style-properties
+  (into style-group-properties
+        [:fill-color
+         :fill-opacity
+         :fill-color-gradient
+         :fill-color-ref-file
+         :fill-color-ref-id
+         :fill-image
+         :fills
+         :stroke-color
+         :stroke-color-ref-file
+         :stroke-color-ref-id
+         :stroke-opacity
+         :stroke-style
+         :stroke-width
+         :stroke-alignment
+         :stroke-cap-start
+         :stroke-cap-end
+         :strokes]))
 
 (defn add-previous
   ([content]
@@ -25,87 +52,92 @@
                   (assoc :prev first)
 
                   (some? prev)
-                  (assoc :prev (gsp/command->point prev))))))))
+                  (assoc :prev (helpers/segment->point prev))))))))
 
 (defn close-paths
   "Removes the :close-path commands and replace them for line-to so we can calculate
   the intersections"
   [content]
 
-  (loop [head (first content)
+  (loop [segments   (seq content)
-         content (rest content)
+         result     []
-         result []
+         last-move  nil
-         last-move nil
+         last-point nil]
-         last-p nil]
+    (if-let [segment (first segments)]
+      (let [point
+            (helpers/segment->point segment)
 
-    (if (nil? head)
+            segment
-      result
+            (cond
-      (let [head-p (gsp/command->point head)
+              (and (= :close-path (:command segment))
-            head (cond
+                   (or (nil? last-point) ;; Ignore consecutive close-paths
-                   (and (= :close-path (:command head))
+                       (< (gpt/distance last-point last-move) 0.01)))
-                        (or (nil? last-p) ;; Ignore consecutive close-paths
+              nil
-                            (< (gpt/distance last-p last-move) 0.01)))
-                   nil
 
-                   (= :close-path (:command head))
+              (= :close-path (:command segment))
-                   (upc/make-line-to last-move)
+              (helpers/make-line-to last-move)
 
-                   :else
+              :else
-                   head)]
+              segment)]
 
-        (recur (first content)
+        (recur (rest segments)
-               (rest content)
+               (cond-> result (some? segment) (conj segment))
-               (cond-> result (some? head) (conj head))
+               (if (= :move-to (:command segment))
-               (if (= :move-to (:command head))
+                 point
-                 head-p
                  last-move)
-               head-p)))))
+               point))
+      result)))
 
 (defn- split-command
   [cmd values]
   (case (:command cmd)
-    :line-to  (gsp/split-line-to-ranges (:prev cmd) cmd values)
+    :line-to  (helpers/split-line-to-ranges (:prev cmd) cmd values)
-    :curve-to (gsp/split-curve-to-ranges (:prev cmd) cmd values)
+    :curve-to (helpers/split-curve-to-ranges (:prev cmd) cmd values)
     [cmd]))
 
-(defn split-ts [seg-1 seg-2]
+(defn- split-ts
-  (cond
+  [seg-1 seg-2]
-    (and (= :line-to (:command seg-1))
+  (let [cmd-1 (get seg-1 :command)
-         (= :line-to (:command seg-2)))
+        cmd-2 (get seg-2 :command)]
-    (gsp/line-line-intersect (gsp/command->line seg-1) (gsp/command->line seg-2))
+    (cond
+      (and (= :line-to cmd-1)
+           (= :line-to cmd-2))
+      (helpers/line-line-intersect (helpers/command->line seg-1)
+                                   (helpers/command->line seg-2))
 
-    (and (= :line-to (:command seg-1))
+      (and (= :line-to cmd-1)
-         (= :curve-to (:command seg-2)))
+           (= :curve-to cmd-2))
-    (gsp/line-curve-intersect (gsp/command->line seg-1) (gsp/command->bezier seg-2))
+      (helpers/line-curve-intersect (helpers/command->line seg-1)
+                                    (helpers/command->bezier seg-2))
 
-    (and (= :curve-to (:command seg-1))
+      (and (= :curve-to cmd-1)
-         (= :line-to (:command seg-2)))
+           (= :line-to cmd-2))
-    (let [[seg-2' seg-1']
+      (let [[seg-2' seg-1']
-          (gsp/line-curve-intersect (gsp/command->line seg-2) (gsp/command->bezier seg-1))]
+            (helpers/line-curve-intersect (helpers/command->line seg-2)
-      ;; Need to reverse because we send the arguments reversed
+                                          (helpers/command->bezier seg-1))]
-      [seg-1' seg-2'])
+        ;; Need to reverse because we send the arguments reversed
+        [seg-1' seg-2'])
 
-    (and (= :curve-to (:command seg-1))
+      (and (= :curve-to cmd-1)
-         (= :curve-to (:command seg-2)))
+           (= :curve-to cmd-2))
-    (gsp/curve-curve-intersect (gsp/command->bezier seg-1) (gsp/command->bezier seg-2))
+      (helpers/curve-curve-intersect (helpers/command->bezier seg-1)
+                                     (helpers/command->bezier seg-2))
 
-    :else
+      :else
-    [[] []]))
+      [[] []])))
 
 (defn content-intersect-split
   [content-a content-b sr-a sr-b]
 
-  (let [command->selrect (memoize gsp/command->selrect)]
+  (let [command->selrect (memoize helpers/command->selrect)]
 
-    (letfn [(overlap-segment-selrect?
+    (letfn [(overlap-segment-selrect? [segment selrect]
-              [segment selrect]
               (if (= :move-to (:command segment))
                 false
                 (let [r1 (command->selrect segment)]
                   (grc/overlaps-rects? r1 selrect))))
 
-            (overlap-segments?
+            (overlap-segments? [seg-1 seg-2]
-              [seg-1 seg-2]
               (if (or (= :move-to (:command seg-1))
                       (= :move-to (:command seg-2)))
                 false
@@ -113,17 +145,14 @@
                       r2 (command->selrect seg-2)]
                   (grc/overlaps-rects? r1 r2))))
 
-            (split
+            (split [seg-1 seg-2]
-              [seg-1 seg-2]
               (if (not (overlap-segments? seg-1 seg-2))
                 [seg-1]
                 (let [[ts-seg-1 _] (split-ts seg-1 seg-2)]
                   (-> (split-command seg-1 ts-seg-1)
                       (add-previous (:prev seg-1))))))
 
-            (split-segment-on-content
+            (split-segment-on-content [segment content content-sr]
-              [segment content content-sr]
-
               (if (overlap-segment-selrect? segment content-sr)
                 (->> content
                      (filter #(overlap-segments? segment %))
@@ -133,8 +162,7 @@
                       [segment]))
                 [segment]))
 
-            (split-content
+            (split-content [content-a content-b sr-b]
-              [content-a content-b sr-b]
               (into []
                     (mapcat #(split-segment-on-content % content-b sr-b))
                     content-a))]
@@ -151,28 +179,28 @@
   [segment content content-sr content-geom]
 
   (let [point (case (:command segment)
-                :line-to  (-> (gsp/command->line segment)
+                :line-to  (-> (helpers/command->line segment)
-                              (gsp/line-values 0.5))
+                              (helpers/line-values 0.5))
 
-                :curve-to (-> (gsp/command->bezier segment)
+                :curve-to (-> (helpers/command->bezier segment)
-                              (gsp/curve-values 0.5)))]
+                              (helpers/curve-values 0.5)))]
 
     (and (grc/contains-point? content-sr point)
          (or
-          (gsp/is-point-in-geom-data? point content-geom)
+          (helpers/is-point-in-geom-data? point content-geom)
-          (gsp/is-point-in-border? point content)))))
+          (helpers/is-point-in-border? point content)))))
 
 (defn inside-segment?
   [segment content-sr content-geom]
   (let [point (case (:command segment)
-                :line-to  (-> (gsp/command->line segment)
+                :line-to  (-> (helpers/command->line segment)
-                              (gsp/line-values 0.5))
+                              (helpers/line-values 0.5))
 
-                :curve-to (-> (gsp/command->bezier segment)
+                :curve-to (-> (helpers/command->bezier segment)
-                              (gsp/curve-values 0.5)))]
+                              (helpers/curve-values 0.5)))]
 
     (and (grc/contains-point? content-sr point)
-         (gsp/is-point-in-geom-data? point content-geom))))
+         (helpers/is-point-in-geom-data? point content-geom))))
 
 (defn overlap-segment?
   "Finds if the current segment is overlapping against other
@@ -185,8 +213,8 @@
                      (contains? #{:line-to :curve-to} (:command segment)))
 
             (case (:command segment)
-              :line-to (let [[p1 q1] (gsp/command->line segment)
+              :line-to (let [[p1 q1] (helpers/command->line segment)
-                             [p2 q2] (gsp/command->line other)]
+                             [p2 q2] (helpers/command->line other)]
 
                          (when (or (and (< (gpt/distance p1 p2) 0.1)
                                         (< (gpt/distance q1 q2) 0.1))
@@ -194,8 +222,8 @@
                                         (< (gpt/distance q1 p2) 0.1)))
                            [segment other]))
 
-              :curve-to (let [[p1 q1 h11 h21] (gsp/command->bezier segment)
+              :curve-to (let [[p1 q1 h11 h21] (helpers/command->bezier segment)
-                              [p2 q2 h12 h22] (gsp/command->bezier other)]
+                              [p2 q2 h12 h22] (helpers/command->bezier other)]
 
                           (when (or (and (< (gpt/distance p1 p2) 0.1)
                                          (< (gpt/distance q1 q2) 0.1)
@@ -227,11 +255,11 @@
       result
 
       (let [result (if (not= (:prev current) prev)
-                     (conj result (upc/make-move-to (:prev current)))
+                     (conj result (helpers/make-move-to (:prev current)))
                      result)]
         (recur (first content)
                (rest content)
-               (gsp/command->point current)
+               (helpers/segment->point current)
                (conj result (dissoc current :prev)))))))
 
 (defn remove-duplicated-segments
@@ -273,20 +301,43 @@
                  segments
                  result))))))
 
+(defn close-content
+  [content]
+  (into []
+        (mapcat :data)
+        (->> content
+             (subpath/close-subpaths)
+             (subpath/get-subpaths))))
+
+(defn- content->geom-data
+  [content]
+
+  (->> content
+       (close-content)
+       (filter #(not= (= :line-to (:command %))
+                      (= :curve-to (:command %))))
+       (mapv (fn [segment]
+               {:command (:command segment)
+                :segment segment
+                :geom (if (= :line-to (:command segment))
+                        (helpers/command->line segment)
+                        (helpers/command->bezier segment))
+                :selrect (helpers/command->selrect segment)}))))
+
 (defn create-union [content-a content-a-split content-b content-b-split sr-a sr-b]
   ;; Pick all segments in content-a that are not inside content-b
   ;; Pick all segments in content-b that are not inside content-a
-  (let [content-a-geom (gsp/content->geom-data content-a)
+  (let [content-a-geom (content->geom-data content-a)
-        content-b-geom (gsp/content->geom-data content-b)
+        content-b-geom (content->geom-data content-b)
 
         content
         (concat
          (->> content-a-split (filter #(not (contains-segment? % content-b sr-b content-b-geom))))
          (->> content-b-split (filter #(not (contains-segment? % content-a sr-a content-a-geom)))))
 
-        content-geom (gsp/content->geom-data content)
+        content-geom (content->geom-data content)
 
-        content-sr (gsp/content->selrect (fix-move-to content))
+        content-sr (segment/content->selrect (fix-move-to content))
 
         ;; Overlapping segments should be added when they are part of the border
         border-content
@@ -302,8 +353,8 @@
   ;; Pick all segments in content-a that are not inside content-b
   ;; Pick all segments in content b that are inside content-a
   ;;  removing overlapping
-  (let [content-a-geom (gsp/content->geom-data content-a)
+  (let [content-a-geom (content->geom-data content-a)
-        content-b-geom (gsp/content->geom-data content-b)]
+        content-b-geom (content->geom-data content-b)]
     (d/concat-vec
      (->> content-a-split (filter #(not (contains-segment? % content-b sr-b content-b-geom))))
 
@@ -315,13 +366,12 @@
 (defn create-intersection [content-a content-a-split content-b content-b-split sr-a sr-b]
   ;; Pick all segments in content-a that are inside content-b
   ;; Pick all segments in content-b that are inside content-a
-  (let [content-a-geom (gsp/content->geom-data content-a)
+  (let [content-a-geom (content->geom-data content-a)
-        content-b-geom (gsp/content->geom-data content-b)]
+        content-b-geom (content->geom-data content-b)]
     (d/concat-vec
      (->> content-a-split (filter #(contains-segment? % content-b sr-b content-b-geom)))
      (->> content-b-split (filter #(contains-segment? % content-a sr-a content-a-geom))))))
 
-
 (defn create-exclusion [content-a content-b]
   ;; Pick all segments
   (d/concat-vec content-a content-b))
@@ -331,26 +381,37 @@
 
   (let [;; We need to reverse the second path when making a difference/intersection/exclude
         ;; and both shapes are in the same direction
-        should-reverse? (and (not= :union bool-type)
+        should-reverse?
-                             (= (ups/clockwise? content-b)
+        (and (not= :union bool-type)
-                                (ups/clockwise? content-a)))
+             (= (subpath/clockwise? content-b)
+                (subpath/clockwise? content-a)))
 
-        content-a (-> content-a
+        content-a
-                      (close-paths)
+        (-> content-a
-                      (add-previous))
+            (close-paths)
+            (add-previous))
 
-        content-b (-> content-b
+        content-b
-                      (close-paths)
+        (-> content-b
-                      (cond-> should-reverse? (ups/reverse-content))
+            (close-paths)
-                      (add-previous))
+            (cond-> should-reverse? (subpath/reverse-content))
+            (add-previous))
 
-        sr-a (gsp/content->selrect content-a)
+        sr-a
-        sr-b (gsp/content->selrect content-b)
+        (segment/content->selrect content-a)
+
+        sr-b
+        (segment/content->selrect content-b)
 
         ;; Split content in new segments in the intersection with the other path
-        [content-a-split content-b-split] (content-intersect-split content-a content-b sr-a sr-b)
+        [content-a-split content-b-split]
-        content-a-split (->> content-a-split add-previous (filter is-segment?))
+        (content-intersect-split content-a content-b sr-a sr-b)
-        content-b-split (->> content-b-split add-previous (filter is-segment?))
+
+        content-a-split
+        (->> content-a-split add-previous (filter is-segment?))
+
+        content-b-split
+        (->> content-b-split add-previous (filter is-segment?))
 
         content
         (case bool-type
@@ -362,14 +423,16 @@
     (-> content
         remove-duplicated-segments
         fix-move-to
-        ups/close-subpaths)))
+        subpath/close-subpaths)))
 
-(defn content-bool
+(defn calculate-content
+  "Create a bool content from a collection of contents and specified
+  type."
   [bool-type contents]
   ;; We apply the boolean operation in to each pair and the result to the next
   ;; element
   (if (seq contents)
     (->> contents
          (reduce (partial content-bool-pair bool-type))
-         (into []))
+         (vec))
     []))

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

@@ -0,0 +1,782 @@
+;; 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) KALEIDOS INC
+
+(ns app.common.types.path.impl
+  "Contains schemas and data type implementation for PathData binary
+  and plain formats"
+  #?(:cljs
+     (:require-macros [app.common.types.path.impl :refer [read-float read-short write-float write-short]]))
+  (:refer-clojure :exclude [-lookup -reduce])
+  (:require
+   #?(:clj [app.common.fressian :as fres])
+   #?(:clj [clojure.data.json :as json])
+   #?(:cljs [app.common.weak-map :as weak-map])
+   [app.common.data.macros :as dm]
+   [app.common.schema :as sm]
+   [app.common.schema.generators :as sg]
+   [app.common.svg.path :as svg.path]
+   [app.common.transit :as t]
+   [app.common.types.path :as-alias path])
+  (:import
+   #?(:cljs [goog.string StringBuffer]
+      :clj  [java.nio ByteBuffer ByteOrder])))
+
+#?(:clj (set! *warn-on-reflection* true))
+
+(def ^:const SEGMENT-BYTE-SIZE 28)
+
+(defprotocol IPathData
+  (-write-to [_ buffer offset] "write the content to the specified buffer")
+  (-get-byte-size [_] "get byte size"))
+
+(defprotocol ITransformable
+  (-transform [_ m] "apply a transform")
+  (-lookup [_ index f])
+  (-walk [_ f initial])
+  (-reduce [_ f initial]))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; IMPL HELPERS
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defmacro read-short
+  [target offset]
+  (if (:ns &env)
+    `(.getInt16 ~target ~offset true)
+    (let [target (with-meta target {:tag 'java.nio.ByteBuffer})]
+      `(.getShort ~target ~offset))))
+
+(defmacro read-float
+  [target offset]
+  (if (:ns &env)
+    `(.getFloat32 ~target ~offset true)
+    (let [target (with-meta target {:tag 'java.nio.ByteBuffer})]
+      `(double (.getFloat ~target ~offset)))))
+
+(defmacro write-float
+  [target offset value]
+  (if (:ns &env)
+    `(.setFloat32 ~target ~offset ~value true)
+    (let [target (with-meta target {:tag 'java.nio.ByteBuffer})]
+      `(.putFloat ~target ~offset ~value))))
+
+(defmacro write-short
+  [target offset value]
+  (if (:ns &env)
+    `(.setInt16 ~target ~offset ~value true)
+    (let [target (with-meta target {:tag 'java.nio.ByteBuffer})]
+      `(.putShort ~target ~offset ~value))))
+
+(defmacro with-cache
+  "A helper macro that facilitates cache handling for content
+  instance, only relevant on CLJS"
+  [target key & expr]
+  (if (:ns &env)
+    (let [cache (gensym "cache-")
+          target (with-meta target {:tag 'js})]
+      `(let [~cache (.-cache ~target)
+             ~'result (.get ~cache ~key)]
+         (if ~'result
+           (do
+             ~'result)
+           (let [~'result (do ~@expr)]
+             (.set ~cache ~key ~'result)
+             ~'result))))
+    `(do ~@expr)))
+
+(defn- allocate
+  [n-segments]
+  #?(:clj (let [buffer (ByteBuffer/allocate (* n-segments SEGMENT-BYTE-SIZE))]
+            (.order buffer ByteOrder/LITTLE_ENDIAN))
+     :cljs (new js/ArrayBuffer (* n-segments SEGMENT-BYTE-SIZE))))
+
+(defn- clone-buffer
+  [buffer]
+  #?(:clj
+     (let [src (.array ^ByteBuffer buffer)
+           len (alength ^bytes src)
+           dst (byte-array len)]
+       (System/arraycopy src 0 dst 0 len)
+       (let [buffer (ByteBuffer/wrap dst)]
+         (.order buffer ByteOrder/LITTLE_ENDIAN)))
+     :cljs
+     (let [src-view (js/Uint32Array. buffer)
+           dst-buff (js/ArrayBuffer. (.-byteLength buffer))
+           dst-view (js/Uint32Array. dst-buff)]
+       (.set dst-view src-view)
+       dst-buff)))
+
+(defn- impl-transform-segment
+  "Apply a transformation to a segment located under specified offset"
+  [buffer offset a b c d e f]
+  (let [t (read-short buffer offset)]
+    (case t
+      (1 2)
+      (let [x (read-float buffer (+ offset 20))
+            y (read-float buffer (+ offset 24))
+            x (+ (* x a) (* y c) e)
+            y (+ (* x b) (* y d) f)]
+        (write-float buffer (+ offset 20) x)
+        (write-float buffer (+ offset 24) y))
+
+      3
+      (let [c1x (read-float buffer (+ offset 4))
+            c1y (read-float buffer (+ offset 8))
+            c2x (read-float buffer (+ offset 12))
+            c2y (read-float buffer (+ offset 16))
+            x   (read-float buffer (+ offset 20))
+            y   (read-float buffer (+ offset 24))
+
+            c1x (+ (* c1x a) (* c1y c) e)
+            c1y (+ (* c1x b) (* c1y d) f)
+            c2x (+ (* c2x a) (* c2y c) e)
+            c2y (+ (* c2x b) (* c2y d) f)
+            x   (+ (* x a) (* y c) e)
+            y   (+ (* x b) (* y d) f)]
+
+        (write-float buffer (+ offset 4) c1x)
+        (write-float buffer (+ offset 8) c1y)
+        (write-float buffer (+ offset 12) c2x)
+        (write-float buffer (+ offset 16) c2y)
+        (write-float buffer (+ offset 20) x)
+        (write-float buffer (+ offset 24) y))
+
+      nil)))
+
+(defn- impl-transform
+  [buffer m size]
+  (let [a (dm/get-prop m :a)
+        b (dm/get-prop m :b)
+        c (dm/get-prop m :c)
+        d (dm/get-prop m :d)
+        e (dm/get-prop m :e)
+        f (dm/get-prop m :f)]
+    (loop [index 0]
+      (when (< index size)
+        (let [offset (* index SEGMENT-BYTE-SIZE)]
+          (impl-transform-segment buffer offset a b c d e f)
+          (recur (inc index)))))))
+
+(defn- impl-walk
+  [buffer f initial size]
+  (loop [index 0
+         result (transient initial)]
+    (if (< index size)
+      (let [offset (* index SEGMENT-BYTE-SIZE)
+            type   (read-short buffer offset)
+            c1x    (read-float buffer (+ offset 4))
+            c1y    (read-float buffer (+ offset 8))
+            c2x    (read-float buffer (+ offset 12))
+            c2y    (read-float buffer (+ offset 16))
+            x      (read-float buffer (+ offset 20))
+            y      (read-float buffer (+ offset 24))
+            type   (case type
+                     1 :line-to
+                     2 :move-to
+                     3 :curve-to
+                     4 :close-path)
+            res    (f type c1x c1y c2x c2y x y)]
+        (recur (inc index)
+               (if (some? res)
+                 (conj! result res)
+                 result)))
+      (persistent! result))))
+
+(defn impl-reduce
+  [buffer f initial size]
+  (loop [index 0
+         result initial]
+    (if (< index size)
+      (let [offset (* index SEGMENT-BYTE-SIZE)
+            type   (read-short buffer offset)
+            c1x    (read-float buffer (+ offset 4))
+            c1y    (read-float buffer (+ offset 8))
+            c2x    (read-float buffer (+ offset 12))
+            c2y    (read-float buffer (+ offset 16))
+            x      (read-float buffer (+ offset 20))
+            y      (read-float buffer (+ offset 24))
+            type   (case type
+                     1 :line-to
+                     2 :move-to
+                     3 :curve-to
+                     4 :close-path)
+            result (f result index type c1x c1y c2x c2y x y)]
+        (if (reduced? result)
+          result
+          (recur (inc index) result)))
+      result)))
+
+(defn impl-lookup
+  [buffer index f]
+  (let [offset (* index SEGMENT-BYTE-SIZE)
+        type   (read-short buffer offset)
+        c1x    (read-float buffer (+ offset 4))
+        c1y    (read-float buffer (+ offset 8))
+        c2x    (read-float buffer (+ offset 12))
+        c2y    (read-float buffer (+ offset 16))
+        x      (read-float buffer (+ offset 20))
+        y      (read-float buffer (+ offset 24))
+        type   (case type
+                 1 :line-to
+                 2 :move-to
+                 3 :curve-to
+                 4 :close-path)]
+    #?(:clj (f type c1x c1y c2x c2y x y)
+       :cljs (^function f type c1x c1y c2x c2y x y))))
+
+(defn- to-string-segment*
+  [buffer offset type ^StringBuilder builder]
+  (case (long type)
+    1 (let [x (read-float buffer (+ offset 20))
+            y (read-float buffer (+ offset 24))]
+        (doto builder
+          (.append "M")
+          (.append x)
+          (.append ",")
+          (.append y)))
+    2 (let [x (read-float buffer (+ offset 20))
+            y (read-float buffer (+ offset 24))]
+        (doto builder
+          (.append "L")
+          (.append x)
+          (.append ",")
+          (.append y)))
+
+    3 (let [c1x (read-float buffer (+ offset 4))
+            c1y (read-float buffer (+ offset 8))
+            c2x (read-float buffer (+ offset 12))
+            c2y (read-float buffer (+ offset 16))
+            x   (read-float buffer (+ offset 20))
+            y   (read-float buffer (+ offset 24))]
+        (doto builder
+          (.append "C")
+          (.append c1x)
+          (.append ",")
+          (.append c1y)
+          (.append ",")
+          (.append c2x)
+          (.append ",")
+          (.append c2y)
+          (.append ",")
+          (.append x)
+          (.append ",")
+          (.append y)))
+    4 (doto builder
+        (.append "Z"))))
+
+(defn- to-string
+  "Format the path data structure to string"
+  [buffer size]
+  (let [builder #?(:clj (java.lang.StringBuilder. (int (* size 4)))
+                   :cljs (StringBuffer.))]
+    (loop [index 0]
+      (when (< index size)
+        (let [offset (* index SEGMENT-BYTE-SIZE)
+              type   (read-short buffer offset)]
+          (to-string-segment* buffer offset type builder)
+          (recur (inc index)))))
+
+    (.toString builder)))
+
+(defn- read-segment
+  "Read segment from binary buffer at specified index"
+  [buffer index]
+  (let [offset (* index SEGMENT-BYTE-SIZE)
+        type   (read-short buffer offset)]
+    (case (long type)
+      1 (let [x (read-float buffer (+ offset 20))
+              y (read-float buffer (+ offset 24))]
+          {:command :move-to
+           :params {:x (double x)
+                    :y (double y)}})
+
+      2 (let [x (read-float buffer (+ offset 20))
+              y (read-float buffer (+ offset 24))]
+          {:command :line-to
+           :params {:x (double x)
+                    :y (double y)}})
+
+      3 (let [c1x (read-float buffer (+ offset 4))
+              c1y (read-float buffer (+ offset 8))
+              c2x (read-float buffer (+ offset 12))
+              c2y (read-float buffer (+ offset 16))
+              x   (read-float buffer (+ offset 20))
+              y   (read-float buffer (+ offset 24))]
+          {:command :curve-to
+           :params {:x (double x)
+                    :y (double y)
+                    :c1x (double c1x)
+                    :c1y (double c1y)
+                    :c2x (double c2x)
+                    :c2y (double c2y)}})
+
+      4 {:command :close-path
+         :params {}})))
+
+(defn- in-range?
+  [size i]
+  (and (< i size) (>= i 0)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; TYPE: PATH-DATA
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+#?(:clj
+   (deftype PathData [size
+                      ^ByteBuffer buffer
+                      ^:unsynchronized-mutable hash]
+     Object
+     (toString [_]
+       (to-string buffer size))
+
+     (equals [_ other]
+       (if (instance? PathData other)
+         (.equals ^ByteBuffer buffer (.-buffer ^PathData other))
+         false))
+
+     ITransformable
+     (-transform [_ m]
+       (let [buffer (clone-buffer buffer)]
+         (impl-transform buffer m size)
+         (PathData. size buffer nil)))
+
+     (-walk [_ f initial]
+       (impl-walk buffer f initial size))
+
+     (-reduce [_ f initial]
+       (impl-reduce buffer f initial size))
+
+     (-lookup [_ index f]
+       (when (and (<= 0 index)
+                  (< index size))
+         (impl-lookup buffer index f)))
+
+     json/JSONWriter
+     (-write [this writter options]
+       (json/-write (.toString this) writter options))
+
+     clojure.lang.IHashEq
+     (hasheq [this]
+       (when-not hash
+         (set! hash (clojure.lang.Murmur3/hashOrdered (seq this))))
+       hash)
+
+     clojure.lang.Sequential
+     clojure.lang.Seqable
+     (seq [_]
+       (when (pos? size)
+         ((fn next-seq [i]
+            (when (< i size)
+              (cons (read-segment buffer i)
+                    (lazy-seq (next-seq (inc i))))))
+          0)))
+
+     clojure.lang.IReduceInit
+     (reduce [_ f start]
+       (loop [index  0
+              result start]
+         (if (< index size)
+           (let [result (f result (read-segment buffer index))]
+             (if (reduced? result)
+               @result
+               (recur (inc index) result)))
+           result)))
+
+     clojure.lang.Indexed
+     (nth [_ i]
+       (if (in-range? size i)
+         (read-segment buffer i)
+         nil))
+
+     (nth [_ i default]
+       (if (in-range? size i)
+         (read-segment buffer i)
+         default))
+
+     clojure.lang.Counted
+     (count [_] size)
+
+     IPathData
+     (-get-byte-size [_]
+       (* size SEGMENT-BYTE-SIZE))
+
+     (-write-to [_ _ _]
+       (throw (RuntimeException. "not implemented"))))
+
+   :cljs
+   #_:clj-kondo/ignore
+   (deftype PathData [size buffer dview cache ^:mutable __hash]
+     Object
+     (toString [_]
+       (to-string dview size))
+
+     IPathData
+     (-get-byte-size [_]
+       (.-byteLength buffer))
+
+     (-write-to [_ into-buffer offset]
+       ;; NOTE: we still use u8 because until the heap refactor merge
+       ;; we can't guarrantee the alignment of offset on 4 bytes
+       (assert (instance? js/ArrayBuffer into-buffer))
+       (let [size (.-byteLength buffer)
+             mem  (js/Uint8Array. into-buffer offset size)]
+         (.set mem (js/Uint8Array. buffer))))
+
+     ITransformable
+     (-transform [this m]
+       (let [buffer (clone-buffer buffer)
+             dview  (js/DataView. buffer)]
+         (impl-transform dview m size)
+         (PathData. size buffer dview (weak-map/create) nil)))
+
+     (-walk [_ f initial]
+       (impl-walk dview f initial size))
+
+     (-reduce [_ f initial]
+       (impl-reduce dview f initial size))
+
+     (-lookup [_ index f]
+       (when (and (<= 0 index)
+                  (< index size))
+         (impl-lookup dview index f)))
+
+     cljs.core/ISequential
+     cljs.core/IEquiv
+     (-equiv [this other]
+       (if (instance? PathData other)
+         (let [obuffer (.-buffer other)]
+           (if (= (.-byteLength obuffer)
+                  (.-byteLength buffer))
+             (let [cb (js/Uint32Array. buffer)
+                   ob (js/Uint32Array. obuffer)
+                   sz (alength cb)]
+               (loop [i 0]
+                 (if (< i sz)
+                   (if (= (aget ob i)
+                          (aget cb i))
+                     (recur (inc i))
+                     false)
+                   true)))
+             false))
+         false))
+
+     cljs.core/IReduce
+     (-reduce [_ f]
+       (loop [index  1
+              result (if (pos? size)
+                       (read-segment dview 0)
+                       nil)]
+         (if (< index size)
+           (let [result (f result (read-segment dview index))]
+             (if (reduced? result)
+               @result
+               (recur (inc index) result)))
+           result)))
+
+     (-reduce [_ f start]
+       (loop [index  0
+              result start]
+         (if (< index size)
+           (let [result (f result (read-segment dview index))]
+             (if (reduced? result)
+               @result
+               (recur (inc index) result)))
+           result)))
+
+     cljs.core/IHash
+     (-hash [coll]
+       (caching-hash coll hash-ordered-coll __hash))
+
+     cljs.core/ICounted
+     (-count [_] size)
+
+     cljs.core/IIndexed
+     (-nth [_ i]
+       (if (in-range? size i)
+         (read-segment dview i)
+         nil))
+
+     (-nth [_ i default]
+       (if (in-range? i size)
+         (read-segment dview i)
+         default))
+
+     cljs.core/ISeqable
+     (-seq [this]
+       (when (pos? size)
+         ((fn next-seq [i]
+            (when (< i size)
+              (cons (read-segment dview i)
+                    (lazy-seq (next-seq (inc i))))))
+          0)))
+
+     cljs.core/IPrintWithWriter
+     (-pr-writer [this writer _]
+       (cljs.core/-write writer (str "#penpot/path-data \"" (.toString this) "\"")))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; SCHEMA
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(def schema:safe-number
+  [:schema {:gen/gen (sg/small-int :max 100 :min -100)}
+   ::sm/safe-number])
+
+(def ^:private schema:line-to-segment
+  [:map
+   [:command [:= :line-to]]
+   [:params
+    [:map
+     [:x schema:safe-number]
+     [:y schema:safe-number]]]])
+
+(def ^:private schema:close-path-segment
+  [:map
+   [:command [:= :close-path]]])
+
+(def ^:private schema:move-to-segment
+  [:map
+   [:command [:= :move-to]]
+   [:params
+    [:map
+     [:x schema:safe-number]
+     [:y schema:safe-number]]]])
+
+(def ^:private schema:curve-to-segment
+  [:map
+   [:command [:= :curve-to]]
+   [:params
+    [:map
+     [:x schema:safe-number]
+     [:y schema:safe-number]
+     [:c1x schema:safe-number]
+     [:c1y schema:safe-number]
+     [:c2x schema:safe-number]
+     [:c2y schema:safe-number]]]])
+
+(def ^:private schema:segment
+  [:multi {:title "PathSegment"
+           :dispatch :command
+           :decode/json #(update % :command keyword)}
+   [:line-to schema:line-to-segment]
+   [:close-path schema:close-path-segment]
+   [:move-to schema:move-to-segment]
+   [:curve-to schema:curve-to-segment]])
+
+(def schema:segments
+  [:vector {:gen/gen (->> (sg/generator schema:segment)
+                          (sg/vector)
+                          (sg/filter not-empty)
+                          (sg/filter (fn [[e1]]
+                                       (= (:command e1) :move-to))))}
+   schema:segment])
+
+(def schema:content-like
+  [:sequential schema:segment])
+
+(def check-content-like
+  (sm/check-fn schema:content-like))
+
+(def check-segment
+  (sm/check-fn schema:segment))
+
+(def ^:private check-segments
+  (sm/check-fn schema:segments))
+
+(defn path-data?
+  [o]
+  (instance? PathData o))
+
+(declare from-string)
+(declare from-plain)
+
+;; Mainly used on backend: features/components_v2.clj
+(sm/register! ::path/segment schema:segment)
+(sm/register! ::path/segments schema:segments)
+
+(sm/register!
+ {:type ::path/content
+  :compile
+  (fn [_ _ _]
+    (let [decoder   (delay (sm/decoder schema:segments sm/json-transformer))
+          generator (->> (sg/generator schema:segments)
+                         (sg/filter not-empty)
+                         (sg/fmap from-plain))]
+      {:pred path-data?
+       :type-properties
+       {:gen/gen generator
+        :encode/json identity
+        :decode/json (fn [s]
+                       (cond
+                         (string? s)
+                         (from-string s)
+
+                         (vector? s)
+                         (let [decode-fn (deref decoder)]
+                           (-> (decode-fn s)
+                               (from-plain)))
+
+                         :else
+                         s))}}))})
+
+(def check-path-content
+  (sm/check-fn ::path/content))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; CONSTRUCTORS & PREDICATES
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn from-string
+  [s]
+  (from-plain (svg.path/parse s)))
+
+(defn from-bytes
+  [buffer]
+  #?(:clj
+     (cond
+       (instance? ByteBuffer buffer)
+       (let [size   (.capacity ^ByteBuffer buffer)
+             count  (long (/ size SEGMENT-BYTE-SIZE))
+             buffer (.order ^ByteBuffer buffer ByteOrder/LITTLE_ENDIAN)]
+         (PathData. count buffer nil))
+
+       (bytes? buffer)
+       (let [size   (alength ^bytes buffer)
+             count  (long (/ size SEGMENT-BYTE-SIZE))
+             buffer (ByteBuffer/wrap buffer)]
+         (PathData. count
+                    (.order buffer ByteOrder/LITTLE_ENDIAN)
+                    nil))
+       :else
+       (throw (java.lang.IllegalArgumentException. "invalid data provided")))
+
+     :cljs
+     (cond
+       (instance? js/ArrayBuffer buffer)
+       (let [size  (.-byteLength buffer)
+             count (long (/ size SEGMENT-BYTE-SIZE))]
+         (PathData. count
+                    buffer
+                    (js/DataView. buffer)
+                    (weak-map/create)
+                    nil))
+
+       (instance? js/DataView buffer)
+       (let [dview  buffer
+             buffer (.-buffer dview)
+             size  (.-byteLength buffer)
+             count (long (/ size SEGMENT-BYTE-SIZE))]
+         (PathData. count buffer dview (weak-map/create) nil))
+
+       (instance? js/Uint8Array buffer)
+       (from-bytes (.-buffer buffer))
+
+       (instance? js/Int8Array buffer)
+       (from-bytes (.-buffer buffer))
+
+       :else
+       (throw (js/Error. "invalid data provided")))))
+
+;; FIXME: consider implementing with reduce
+;; FIXME: consider ensure fixed precision for avoid doing it on formatting
+
+(defn from-plain
+  "Create a PathData instance from plain data structures"
+  [segments]
+  (assert (check-segments segments))
+
+  (let [total    (count segments)
+        #?@(:cljs [buffer' (allocate total)
+                   buffer  (new js/DataView buffer')]
+            :clj  [buffer  (allocate total)])]
+    (loop [index 0]
+      (when (< index total)
+        (let [segment (nth segments index)
+              offset  (* index SEGMENT-BYTE-SIZE)]
+          (case (get segment :command)
+            :move-to
+            (let [params (get segment :params)
+                  x      (float (get params :x))
+                  y      (float (get params :y))]
+              (write-short buffer offset 1)
+              (write-float buffer (+ offset 20) x)
+              (write-float buffer (+ offset 24) y))
+
+            :line-to
+            (let [params (get segment :params)
+                  x      (float (get params :x))
+                  y      (float (get params :y))]
+
+              (write-short buffer offset 2)
+              (write-float buffer (+ offset 20) x)
+              (write-float buffer (+ offset 24) y))
+
+            :curve-to
+            (let [params (get segment :params)
+                  x      (float (get params :x))
+                  y      (float (get params :y))
+                  c1x    (float (get params :c1x x))
+                  c1y    (float (get params :c1y y))
+                  c2x    (float (get params :c2x x))
+                  c2y    (float (get params :c2y y))]
+
+              (write-short buffer offset 3)
+              (write-float buffer (+ offset 4)  c1x)
+              (write-float buffer (+ offset 8)  c1y)
+              (write-float buffer (+ offset 12) c2x)
+              (write-float buffer (+ offset 16) c2y)
+              (write-float buffer (+ offset 20) x)
+              (write-float buffer (+ offset 24) y))
+
+            :close-path
+            (write-short buffer offset 4))
+          (recur (inc index)))))
+
+    (from-bytes buffer)))
+
+(defn path-data
+  "Create an instance of PathData, returns itself if it is already
+  PathData instance"
+  [data]
+  (cond
+    (path-data? data)
+    data
+
+    (nil? data)
+    (from-plain [])
+
+    (sequential? data)
+    (from-plain data)
+
+    :else
+    (throw (ex-info "unexpected data" {:data data}))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; SERIALIZATION
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(t/add-handlers!
+ {:id "penpot/path-data"
+  :class PathData
+  :wfn (fn [^PathData pdata]
+         (let [buffer (.-buffer pdata)]
+           #?(:cljs (js/Uint8Array. buffer)
+              :clj  (.array ^ByteBuffer buffer))))
+  :rfn from-bytes})
+
+#?(:clj
+   (fres/add-handlers!
+    {:name "penpot/path-data"
+     :class PathData
+     :wfn (fn [n w o]
+            (fres/write-tag! w n 1)
+            (let [buffer (.-buffer ^PathData o)
+                  bytes  (.array ^ByteBuffer buffer)]
+              (fres/write-bytes! w bytes)))
+     :rfn (fn [r]
+            (let [^bytes bytes (fres/read-object! r)]
+              (from-bytes bytes)))}))
+

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

@@ -0,0 +1,889 @@
+;; 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) KALEIDOS INC
+
+(ns app.common.types.path.segment
+  "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]
+   [app.common.math :as mth]
+   [app.common.types.path.helpers :as helpers]
+   [app.common.types.path.impl :as impl]
+   [clojure.set :as set]))
+
+#?(:clj (set! *warn-on-reflection* true))
+
+(defn update-handler
+  [command prefix point]
+  (let [[cox coy] (if (= prefix :c1) [:c1x :c1y] [:c2x :c2y])]
+    (-> command
+        (assoc-in [:params cox] (:x point))
+        (assoc-in [:params coy] (:y point)))))
+
+(defn get-handler [{:keys [params] :as command} prefix]
+  (let [cx (d/prefix-keyword prefix :x)
+        cy (d/prefix-keyword prefix :y)]
+    (when (and command
+               (contains? params cx)
+               (contains? params cy))
+      (gpt/point (get params cx)
+                 (get params cy)))))
+
+(defn get-handlers
+  "Retrieve a map where for every point will retrieve a list of
+  the handlers that are associated with that point.
+  point -> [[index, prefix]]"
+  [content]
+  (let [prev-point* (volatile! nil)
+        vec-conj    (fnil conj [])]
+    (impl/-reduce content
+                  (fn [result index type _ _ _ _ x y]
+                    (let [curr-point (gpt/point x y)
+                          prev-point (deref prev-point*)]
+                      (vreset! prev-point* curr-point)
+                      (if (and prev-point (= :curve-to type))
+                        (-> result
+                            (update prev-point vec-conj [index :c1])
+                            (update curr-point vec-conj [index :c2]))
+                        result)))
+                  {})))
+
+(defn point-indices
+  [content point]
+  (->> (d/enumerate content)
+       (filter (fn [[_ segment]] (= point (helpers/segment->point segment))))
+       (mapv (fn [[index _]] index))))
+
+(defn handler-indices
+  "Return an index where the key is the positions and the values the handlers"
+  [content point]
+  (->> (d/with-prev content)
+       (d/enumerate)
+       (mapcat (fn [[index [cur-segment pre-segment]]]
+                 (if (and (some? pre-segment) (= :curve-to (:command cur-segment)))
+                   (let [cur-pos (helpers/segment->point cur-segment)
+                         pre-pos (helpers/segment->point pre-segment)]
+                     (cond-> []
+                       (= pre-pos point) (conj [index :c1])
+                       (= cur-pos point) (conj [index :c2])))
+                   [])))))
+
+(defn opposite-index
+  "Calculates the opposite index given a prefix and an index"
+  [content index prefix]
+
+  (let [point (if (= prefix :c2)
+                (helpers/segment->point (nth content index))
+                (helpers/segment->point (nth content (dec index))))
+
+        point->handlers (get-handlers content)
+
+        handlers (->> point
+                      (point->handlers)
+                      (filter (fn [[ci cp]] (and (not= index ci) (not= prefix cp)))))]
+
+    (cond
+      (= (count handlers) 1)
+      (->> handlers first)
+
+      (and (= :c1 prefix) (= (count content) index))
+      [(dec index) :c2]
+
+      :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? content))
+    (impl/-lookup content index
+                  (fn [command c1x c1y c2x c2y x y]
+                    (let [prefix (if (= :curve-to command)
+                                   prefix
+                                   nil)]
+                      (case prefix
+                        :c1 (gpt/point c1x c1y)
+                        :c2 (gpt/point c2x c2y)
+                        (gpt/point x y)))))))
+
+;; FIXME: revisit this function
+(defn handler->node
+  [content index prefix]
+  (if (= prefix :c1)
+    (helpers/segment->point (nth content (dec index)))
+    (helpers/segment->point (nth content index))))
+
+(defn calculate-opposite-handler
+  "Given a point and its handler, gives the symmetric handler"
+  [point handler]
+  (let [handler-vector (gpt/to-vec point handler)]
+    (gpt/add point (gpt/negate handler-vector))))
+
+(defn opposite-handler
+  "Calculates the coordinates of the opposite handler"
+  [point handler]
+  (let [phv (gpt/to-vec point handler)]
+    (gpt/add point (gpt/negate phv))))
+
+(defn get-points
+  "Returns points for the given segment, faster version of
+  the `content->points`."
+  [content]
+  (impl/with-cache content "get-points"
+    (impl/-walk content
+                (fn [type _ _ _ _ x y]
+                  (when (not= type :close-path)
+                    (gpt/point x y)))
+                [])))
+
+;; FIXME: incorrect API, don't need full shape
+(defn path->lines
+  "Given a path returns a list of lines that approximate the path"
+  [shape]
+  (loop [command (first (:content shape))
+         pending (rest (:content shape))
+         result []
+         last-start nil
+         prev-point nil]
+
+    (if-let [{:keys [command params]} command]
+      (let [point (if (= :close-path command)
+                    last-start
+                    (gpt/point params))
+
+            result (case command
+                     :line-to  (conj result [prev-point point])
+                     :curve-to (let [h1 (gpt/point (:c1x params) (:c1y params))
+                                     h2 (gpt/point (:c2x params) (:c2y params))]
+                                 (into result (helpers/curve->lines prev-point point h1 h2)))
+                     :move-to  (cond-> result
+                                 last-start (conj [prev-point last-start]))
+                     result)
+            last-start (if (= :move-to command)
+                         point
+                         last-start)]
+        (recur (first pending)
+               (rest pending)
+               result
+               last-start
+               point))
+
+      (conj result [prev-point last-start]))))
+
+(def ^:const path-closest-point-accuracy 0.01)
+
+;; FIXME: move to helpers?, this function need performance review, it
+;; is executed so many times on path edition
+(defn- curve-closest-point
+  [position start end h1 h2]
+  (let [d (memoize (fn [t] (gpt/distance position (helpers/curve-values start end h1 h2 t))))]
+    (loop [t1 0.0
+           t2 1.0]
+      (if (<= (mth/abs (- t1 t2)) path-closest-point-accuracy)
+        (-> (helpers/curve-values start end h1 h2 t1)
+            ;; store the segment info
+            (with-meta {:t t1 :from-p start :to-p end}))
+
+        (let [ht  (+ t1 (/ (- t2 t1) 2))
+              ht1 (+ t1 (/ (- t2 t1) 4))
+              ht2 (+ t1 (/ (* 3 (- t2 t1)) 4))
+
+              [t1 t2] (cond
+                        (< (d ht1) (d ht2))
+                        [t1 ht]
+
+                        (< (d ht2) (d ht1))
+                        [ht t2]
+
+                        (and (< (d ht) (d t1)) (< (d ht) (d t2)))
+                        [ht1 ht2]
+
+                        (< (d t1) (d t2))
+                        [t1 ht]
+
+                        :else
+                        [ht t2])]
+          (recur (double t1)
+                 (double t2)))))))
+
+(defn- line-closest-point
+  "Point on line"
+  [position from-p to-p]
+
+  (let [e1 (gpt/to-vec from-p to-p)
+        e2 (gpt/to-vec from-p position)
+
+        len2 (+ (mth/sq (:x e1)) (mth/sq (:y e1)))
+        t (/ (gpt/dot e1 e2) len2)]
+
+    (if (and (>= t 0) (<= t 1) (not (mth/almost-zero? len2)))
+      (-> (gpt/add from-p (gpt/scale e1 t))
+          (with-meta {:t t
+                      :from-p from-p
+                      :to-p to-p}))
+
+      ;; There is no perpendicular projection in the line so the closest
+      ;; point will be one of the extremes
+      (if (<= (gpt/distance position from-p) (gpt/distance position to-p))
+        from-p
+        to-p))))
+
+;; FIXME: incorrect API, complete shape is not necessary here
+(defn path-closest-point
+  "Given a path and a position"
+  [shape position]
+
+  (let [point+distance
+        (fn [[cur-segment prev-segment]]
+          (let [from-p (helpers/segment->point prev-segment)
+                to-p   (helpers/segment->point cur-segment)
+                h1 (gpt/point (get-in cur-segment [:params :c1x])
+                              (get-in cur-segment [:params :c1y]))
+                h2 (gpt/point (get-in cur-segment [:params :c2x])
+                              (get-in cur-segment [:params :c2y]))
+                point
+                (case (:command cur-segment)
+                  :line-to
+                  (line-closest-point position from-p to-p)
+
+                  :curve-to
+                  (curve-closest-point position from-p to-p h1 h2)
+
+                  nil)]
+            (when point
+              [point (gpt/distance point position)])))
+
+        find-min-point
+        (fn [[min-p min-dist :as acc] [cur-p cur-dist :as cur]]
+          (if (and (some? acc) (or (not cur) (<= min-dist cur-dist)))
+            [min-p min-dist]
+            [cur-p cur-dist]))]
+
+    (->> (:content shape)
+         (d/with-prev)
+         (map point+distance)
+         (reduce find-min-point)
+         (first))))
+
+
+(defn closest-point
+  "Given a path and a position"
+  [content position]
+
+  (let [point+distance
+        (fn [[cur-segment prev-segment]]
+          (let [from-p (helpers/segment->point prev-segment)
+                to-p   (helpers/segment->point cur-segment)
+                h1 (gpt/point (get-in cur-segment [:params :c1x])
+                              (get-in cur-segment [:params :c1y]))
+                h2 (gpt/point (get-in cur-segment [:params :c2x])
+                              (get-in cur-segment [:params :c2y]))
+                point
+                (case (:command cur-segment)
+                  :line-to
+                  (line-closest-point position from-p to-p)
+
+                  :curve-to
+                  (curve-closest-point position from-p to-p h1 h2)
+
+                  nil)]
+            (when point
+              [point (gpt/distance point position)])))
+
+        find-min-point
+        (fn [[min-p min-dist :as acc] [cur-p cur-dist :as cur]]
+          (if (and (some? acc) (or (not cur) (<= min-dist cur-dist)))
+            [min-p min-dist]
+            [cur-p cur-dist]))]
+
+    (->> content
+         (d/with-prev)
+         (map point+distance)
+         (reduce find-min-point)
+         (first))))
+
+(defn- remove-line-curves
+  "Remove all curves that have both handlers in the same position that the
+  beginning and end points. This makes them really line-to commands"
+  [content]
+  (let [with-prev (d/enumerate (d/with-prev content))
+        process-command
+        (fn [content [index [command prev]]]
+
+          (let [cur-point (helpers/segment->point command)
+                pre-point (helpers/segment->point prev)
+                handler-c1 (get-handler command :c1)
+                handler-c2 (get-handler command :c2)]
+            (if (and (= :curve-to (:command command))
+                     (= cur-point handler-c2)
+                     (= pre-point handler-c1))
+              (assoc content index {:command :line-to
+                                    :params (into {} cur-point)})
+              content)))]
+
+    (reduce process-command content with-prev)))
+
+(defn make-corner-point
+  "Changes the content to make a point a 'corner'"
+  [content point]
+  (let [handlers (-> (get-handlers content)
+                     (get point))
+        change-content
+        (fn [content [index prefix]]
+          (let [cx (d/prefix-keyword prefix :x)
+                cy (d/prefix-keyword prefix :y)]
+            (-> content
+                (assoc-in [index :params cx] (:x point))
+                (assoc-in [index :params cy] (:y point)))))]
+    (as-> content $
+      (reduce change-content $ handlers)
+      (remove-line-curves $))))
+
+
+(defn- line->curve
+  [from-p segment]
+
+  (let [to-p (helpers/segment->point segment)
+
+        v (gpt/to-vec from-p to-p)
+        d (gpt/distance from-p to-p)
+
+        dv1 (-> (gpt/normal-left v)
+                (gpt/scale (/ d 3)))
+
+        h1 (gpt/add from-p dv1)
+
+        dv2 (-> (gpt/to-vec to-p h1)
+                (gpt/unit)
+                (gpt/scale (/ d 3)))
+
+        h2 (gpt/add to-p dv2)]
+    (-> segment
+        (assoc :command :curve-to)
+        (update :params (fn [params]
+                          ;; ensure plain map
+                          (-> (into {} params)
+                              (assoc :c1x (:x h1))
+                              (assoc :c1y (:y h1))
+                              (assoc :c2x (:x h2))
+                              (assoc :c2y (:y h2))))))))
+
+;; FIXME: optimize
+(defn is-curve?
+  [content point]
+  (let [handlers (-> (get-handlers content)
+                     (get point))
+        handler-points (map #(get-handler-point content (first %) (second %)) handlers)]
+    (some #(not= point %) handler-points)))
+
+(def ^:private xf:mapcat-points
+  (comp
+   (mapcat #(vector (:next-p %) (:prev-p %)))
+   (remove nil?)))
+
+(defn make-curve-point
+  "Changes the content to make the point a 'curve'. The handlers will be positioned
+  in the same vector that results from the previous->next points but with fixed length."
+  [content point]
+
+  (let [indices (point-indices content point)
+        vectors (map (fn [index]
+                       (let [segment (nth content index)
+                             prev-i (dec index)
+                             prev (when (not (= :move-to (:command segment)))
+                                    (get content prev-i))
+                             next-i (inc index)
+                             next (get content next-i)
+
+                             next (when (not (= :move-to (:command next)))
+                                    next)]
+                         {:index index
+                          :prev-i (when (some? prev) prev-i)
+                          :prev-c prev
+                          :prev-p (helpers/segment->point prev)
+                          :next-i (when (some? next) next-i)
+                          :next-c next
+                          :next-p (helpers/segment->point next)
+                          :segment segment}))
+                     indices)
+
+        points (into #{} xf:mapcat-points vectors)]
+
+    (if (= (count points) 2)
+      (let [v1 (gpt/to-vec (first points) point)
+            v2 (gpt/to-vec (first points) (second points))
+            vp (gpt/project v1 v2)
+            vh (gpt/subtract v1 vp)
+
+            add-curve
+            (fn [content {:keys [index prev-p next-p next-i]}]
+              (let [cur-segment (get content index)
+                    next-segment (get content next-i)
+
+                    ;; New handlers for prev-point and next-point
+                    prev-h (when (some? prev-p) (gpt/add prev-p vh))
+                    next-h (when (some? next-p) (gpt/add next-p vh))
+
+                    ;; Correct 1/3 to the point improves the curve
+                    prev-correction (when (some? prev-h) (gpt/scale (gpt/to-vec prev-h point) (/ 1 3)))
+                    next-correction (when (some? next-h) (gpt/scale (gpt/to-vec next-h point) (/ 1 3)))
+
+                    prev-h (when (some? prev-h) (gpt/add prev-h prev-correction))
+                    next-h (when (some? next-h) (gpt/add next-h next-correction))]
+                (cond-> content
+                  (and (= :line-to (:command cur-segment)) (some? prev-p))
+                  (update index helpers/update-curve-to prev-p prev-h)
+
+                  (and (= :line-to (:command next-segment)) (some? next-p))
+                  (update next-i helpers/update-curve-to next-h next-p)
+
+                  (and (= :curve-to (:command cur-segment)) (some? prev-p))
+                  (update index update-handler :c2 prev-h)
+
+                  (and (= :curve-to (:command next-segment)) (some? next-p))
+                  (update next-i update-handler :c1 next-h))))]
+
+        (reduce add-curve content vectors))
+
+      (let [add-curve
+            (fn [content {:keys [index segment prev-p next-c next-i]}]
+              (cond-> content
+                (= :line-to (:command segment))
+                (update index #(line->curve prev-p %))
+
+                (= :curve-to (:command segment))
+                (update index #(line->curve prev-p %))
+
+                (= :line-to (:command next-c))
+                (update next-i #(line->curve point %))
+
+                (= :curve-to (:command next-c))
+                (update next-i #(line->curve point %))))]
+        (reduce add-curve content vectors)))))
+
+(defn get-segments-with-points
+  "Given a content and a set of points return all the segments in the path
+  that uses the points"
+  [content points]
+  (let [point-set (set points)]
+    (loop [result      (transient [])
+           prev-point  nil
+           start-point nil
+           index       0
+           content     (seq content)]
+      (if-let [{:keys [command] :as segment} (first content)]
+        (let [close-path? (= command :close-path)
+              move-to?    (= command :move-to)
+
+              cur-point   (if close-path?
+                            start-point
+                            (helpers/segment->point segment))
+
+              ;; If there is a move-to we don't have a segment
+              prev-point  (if move-to?
+                            nil
+                            prev-point)
+
+              ;; We update the start point
+              start-point  (if move-to?
+                             cur-point
+                             start-point)
+
+              result      (cond-> result
+                            (and (some? prev-point)
+                                 (contains? point-set prev-point)
+                                 (contains? point-set cur-point))
+
+                            (conj! (-> segment
+                                       (assoc :start prev-point)
+                                       (assoc :end cur-point)
+                                       (assoc :index index))))]
+          (recur result
+                 cur-point
+                 start-point
+                 (inc index)
+                 (rest content)))
+
+        (persistent! result)))))
+
+(defn split-segments
+  "Given a content creates splits commands between points with new segments"
+  [content points value]
+
+  (let [split-command
+        (fn [{:keys [command start end index] :as segment}]
+          (case command
+            :line-to [index (helpers/split-line-to start segment value)]
+            :curve-to [index (helpers/split-curve-to start segment value)]
+            :close-path [index [(helpers/make-line-to (gpt/lerp start end value)) segment]]
+            nil))
+
+        segment-changes
+        (->> (get-segments-with-points content points)
+             (into {} (keep split-command)))
+
+        process-segments
+        (fn [[index command]]
+          (if (contains? segment-changes index)
+            (get segment-changes index)
+            [command]))]
+
+    (into [] (mapcat process-segments) (d/enumerate content))))
+
+;; FIXME: rename to next-segment
+(defn next-node
+  "Calculates the next-node to be inserted."
+  [content position prev-point prev-handler]
+  (let [position     (select-keys position [:x :y])
+        last-command (-> content last :command)
+        add-line?    (and prev-point (not prev-handler) (not= last-command :close-path))
+        add-curve?   (and prev-point prev-handler (not= last-command :close-path))]
+    (cond
+      add-line?   {:command :line-to
+                   :params position}
+      add-curve?  {:command :curve-to
+                   :params (helpers/make-curve-params position prev-handler)}
+      :else       {:command :move-to
+                   :params position})))
+(defn remove-nodes
+  "Removes from content the points given. Will try to reconstruct the paths
+  to keep everything consistent"
+  [content points]
+
+  (if (empty? points)
+    content
+
+    (let [content (d/with-prev content)]
+
+      (loop [result []
+             last-handler nil
+             [cur-segment prev-segment] (first content)
+             content (rest content)]
+
+        (if (nil? cur-segment)
+          ;; The result with be an array of arrays were every entry is a subpath
+          (->> result
+               ;; remove empty and only 1 node subpaths
+               (filter #(> (count %) 1))
+               ;; flatten array-of-arrays plain array
+               (flatten)
+               (into []))
+
+          (let [move? (= :move-to (:command cur-segment))
+                curve? (= :curve-to (:command cur-segment))
+
+                ;; When the old command was a move we start a subpath
+                result (if move? (conj result []) result)
+
+                subpath (peek result)
+
+                point (helpers/segment->point cur-segment)
+
+                old-prev-point (helpers/segment->point prev-segment)
+                new-prev-point (helpers/segment->point (peek subpath))
+
+                remove? (contains? points point)
+
+
+                ;; We store the first handler for the first curve to be removed to
+                ;; use it for the first handler of the regenerated path
+                cur-handler (cond
+                              (and (not last-handler) remove? curve?)
+                              (select-keys (:params cur-segment) [:c1x :c1y])
+
+                              (not remove?)
+                              nil
+
+                              :else
+                              last-handler)
+
+                cur-segment (cond-> cur-segment
+                              ;; If we're starting a subpath and it's not a move make it a move
+                              (and (not move?) (empty? subpath))
+                              (assoc :command :move-to
+                                     :params (select-keys (:params cur-segment) [:x :y]))
+
+                              ;; If have a curve the first handler will be relative to the previous
+                              ;; point. We change the handler to the new previous point
+                              (and curve? (seq subpath) (not= old-prev-point new-prev-point))
+                              (update :params merge last-handler))
+
+                head-idx (dec (count result))
+
+                result (cond-> result
+                         (not remove?)
+                         (update head-idx conj cur-segment))]
+            (recur result
+                   cur-handler
+                   (first content)
+                   (rest content))))))))
+
+(defn join-nodes
+  "Creates new segments between points that weren't previously"
+  [content points]
+
+  (let [segments-set (into #{}
+                           (map (juxt :start :end))
+                           (get-segments-with-points content points))
+
+        create-line-command (fn [point other]
+                              [(helpers/make-move-to point)
+                               (helpers/make-line-to other)])
+
+        not-segment? (fn [point other] (and (not (contains? segments-set [point other]))
+                                            (not (contains? segments-set [other point]))))
+
+        new-content (->> (d/map-perm create-line-command not-segment? points)
+                         (flatten)
+                         (into []))]
+
+    (into content new-content)))
+
+
+(defn separate-nodes
+  "Removes the segments between the points given"
+  [content points]
+
+  (let [content (d/with-prev content)]
+    (loop [result []
+           [cur-segment prev-segment] (first content)
+           content (rest content)]
+
+      (if (nil? cur-segment)
+        (->> result
+             (filter #(> (count %) 1))
+             (flatten)
+             (into []))
+
+        (let [prev-point (helpers/segment->point prev-segment)
+              cur-point (helpers/segment->point cur-segment)
+
+              cur-segment (cond-> cur-segment
+                            (and (contains? points prev-point)
+                                 (contains? points cur-point))
+
+                            (assoc :command :move-to
+                                   :params (select-keys (:params cur-segment) [:x :y])))
+
+              move? (= :move-to (:command cur-segment))
+
+              result (if move? (conj result []) result)
+              head-idx (dec (count result))
+
+              result (-> result
+                         (update head-idx conj cur-segment))]
+          (recur result
+                 (first content)
+                 (rest content)))))))
+
+
+(defn- add-to-set
+  "Given a list of sets adds the value to the target set"
+  [set-list target value]
+  (->> set-list
+       (mapv (fn [it]
+               (cond-> it
+                 (= it target) (conj value))))))
+
+(defn- join-sets
+  "Given a list of sets join two sets in the list into a new one"
+  [set-list target other]
+  (conj (->> set-list
+             (filterv #(and (not= % target)
+                            (not= % other))))
+        (set/union target other)))
+
+;; FIXME: revisit impl of this fn
+(defn- group-segments [segments]
+  (loop [result []
+         {point-a :start point-b :end :as segment} (first segments)
+         segments (rest segments)]
+
+    (if (nil? segment)
+      result
+
+      (let [set-a (d/seek #(contains? % point-a) result)
+            set-b (d/seek #(contains? % point-b) result)
+
+            result (cond-> result
+                     (and (nil? set-a) (nil? set-b))
+                     (conj #{point-a point-b})
+
+                     (and (some? set-a) (nil? set-b))
+                     (add-to-set set-a point-b)
+
+                     (and (nil? set-a) (some? set-b))
+                     (add-to-set set-b point-a)
+
+                     (and (some? set-a) (some? set-b) (not= set-a set-b))
+                     (join-sets set-a set-b))]
+        (recur result
+               (first segments)
+               (rest segments))))))
+
+(defn- calculate-merge-points [group-segments points]
+  (let [index-merge-point (fn [group] (vector group (gpt/center-points group)))
+        index-group (fn [point] (vector point (d/seek #(contains? % point) group-segments)))
+
+        group->merge-point (into {} (map index-merge-point) group-segments)
+        point->group (into {} (map index-group) points)]
+    (d/mapm #(group->merge-point %2) point->group)))
+
+;; TODO: Improve the replace for curves
+(defn- replace-points
+  "Replaces the points in a path for its merge-point"
+  [content point->merge-point]
+  (let [replace-command
+        (fn [segment]
+          (let [point (helpers/segment->point segment)]
+            (if (contains? point->merge-point point)
+              (let [merge-point (get point->merge-point point)]
+                (-> segment (update :params assoc :x (:x merge-point) :y (:y merge-point))))
+              segment)))]
+    (->> content
+         (mapv replace-command))))
+
+(defn merge-nodes
+  "Reduces the contiguous segments in points to a single point"
+  [content points]
+  (let [segments (get-segments-with-points content points)]
+    (if (seq segments)
+      (let [point->merge-point (-> segments
+                                   (group-segments)
+                                   (calculate-merge-points points))]
+        (-> content
+            (separate-nodes points)
+            (replace-points point->merge-point)))
+      content)))
+
+(defn transform-content
+  "Applies a transformation matrix over content and returns a new
+  content as PathData instance."
+  [content transform]
+  (if (some? transform)
+    (impl/-transform content transform)
+    content))
+
+(defn move-content
+  "Applies a displacement over content and returns a new content as
+  PathData instance. Implemented in function of `transform-content`."
+  [content move-vec]
+  (let [transform (gmt/translate-matrix move-vec)]
+    (transform-content content transform)))
+
+(defn calculate-extremities
+  "Calculate extremities for the provided content"
+  [content]
+  (loop [points  (transient #{})
+         content (not-empty (vec content))
+         from-p  nil
+         move-p  nil]
+    (if content
+      (let [last-p  (peek content)
+            content (if (= :move-to (:command last-p))
+                      (pop content)
+                      content)
+            segment (get content 0)
+            to-p    (helpers/segment->point segment)]
+
+        (if segment
+          (case (:command segment)
+            :move-to
+            (recur (conj! points to-p)
+                   (not-empty (subvec content 1))
+                   to-p
+                   to-p)
+
+            :close-path
+            (recur (conj! points move-p)
+                   (not-empty (subvec content 1))
+                   move-p
+                   move-p)
+
+            :line-to
+            (recur (cond-> points
+                     (and from-p to-p)
+                     (-> (conj! move-p)
+                         (conj! to-p)))
+                   (not-empty (subvec content 1))
+                   to-p
+                   move-p)
+
+            :curve-to
+            (let [c1 (helpers/segment->point segment :c1)
+                  c2 (helpers/segment->point segment :c2)]
+              (recur (if (and from-p to-p c1 c2)
+                       (reduce conj!
+                               (-> points (conj! from-p) (conj! to-p))
+                               (helpers/calculate-curve-extremities from-p to-p c1 c2))
+                       points)
+
+                     (not-empty (subvec content 1))
+                     to-p
+                     move-p)))
+          (persistent! points)))
+      (persistent! points))))
+
+(defn content->selrect
+  [content]
+  (let [extremities (calculate-extremities content)
+        ;; We haven't found any extremes so we turn the commands to points
+        extremities
+        (if (empty? extremities)
+          (->> content (keep helpers/segment->point))
+          extremities)]
+
+    ;; If no points are returned we return an empty rect.
+    (if (d/not-empty? extremities)
+      (grc/points->rect extremities)
+      (grc/make-rect))))
+
+(defn content-center
+  [content]
+  (-> content
+      content->selrect
+      grc/rect->center))
+
+(defn append-segment
+  [content segment]
+  (let [content (cond
+                  (impl/path-data? content)
+                  (vec content)
+
+                  (nil? content)
+                  []
+
+                  :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/src/app/common/types/path/shape_to_path.cljc

@@ -4,58 +4,34 @@
 ;;
 ;; Copyright (c) KALEIDOS INC
 
-(ns app.common.svg.path.shapes-to-path
+(ns app.common.types.path.shape-to-path
   (:require
-   [app.common.colors :as clr]
    [app.common.data :as d]
+   [app.common.data.macros :as dm]
+   [app.common.files.helpers :as cfh]
    [app.common.geom.matrix :as gmt]
    [app.common.geom.point :as gpt]
    [app.common.geom.shapes.common :as gco]
    [app.common.geom.shapes.corners :as gso]
-   [app.common.geom.shapes.path :as gsp]
+   [app.common.types.path.bool :as bool]
-   [app.common.svg.path.bool :as pb]
+   [app.common.types.path.helpers :as helpers]
-   [app.common.svg.path.command :as pc]
+   [app.common.types.path.impl :as path.impl]
+   [app.common.types.path.segment :as segm]
    [app.common.types.shape.radius :as ctsr]))
 
-(def ^:const bezier-circle-c 0.551915024494)
+(def ^:const ^:private bezier-circle-c
+  0.551915024494)
 
-(def dissoc-attrs
+(def ^:private dissoc-attrs
   [:x :y :width :height
    :rx :ry :r1 :r2 :r3 :r4
    :metadata])
 
-(def allowed-transform-types
+(defn without-position-attrs
-  #{:rect
+  [shape]
-    :circle
+  (d/without-keys shape dissoc-attrs))
-    :image})
 
-(def style-group-properties
+(defn- make-corner-arc
-  [:shadow
-   :blur])
-
-(def style-properties
-  (into style-group-properties
-        [:fill-color
-         :fill-opacity
-         :fill-color-gradient
-         :fill-color-ref-file
-         :fill-color-ref-id
-         :fill-image
-         :fills
-         :stroke-color
-         :stroke-color-ref-file
-         :stroke-color-ref-id
-         :stroke-opacity
-         :stroke-style
-         :stroke-width
-         :stroke-alignment
-         :stroke-cap-start
-         :stroke-cap-end
-         :strokes]))
-
-(def default-bool-fills [{:fill-color clr/black}])
-
-(defn make-corner-arc
   "Creates a curvle corner for border radius"
   [from to corner radius]
   (let [x (case corner
@@ -91,9 +67,9 @@
              :bottom-right (assoc to :x c2x)
              :bottom-left  (assoc to :y c2y))]
 
-    (pc/make-curve-to to h1 h2)))
+    (helpers/make-curve-to to h1 h2)))
 
-(defn circle->path
+(defn- circle->path
   "Creates the bezier curves to approximate a circle shape"
   [{:keys [x y width height]}]
   (let [mx (+ x (/ width 2))
@@ -112,13 +88,13 @@
         c1y (+ y (* (/ height 2) (- 1 c)))
         c2y (+ y (* (/ height 2) (+ 1 c)))]
 
-    [(pc/make-move-to p1)
+    [(helpers/make-move-to p1)
-     (pc/make-curve-to p2 (assoc p1 :x c2x) (assoc p2 :y c1y))
+     (helpers/make-curve-to p2 (assoc p1 :x c2x) (assoc p2 :y c1y))
-     (pc/make-curve-to p3 (assoc p2 :y c2y) (assoc p3 :x c2x))
+     (helpers/make-curve-to p3 (assoc p2 :y c2y) (assoc p3 :x c2x))
-     (pc/make-curve-to p4 (assoc p3 :x c1x) (assoc p4 :y c2y))
+     (helpers/make-curve-to p4 (assoc p3 :x c1x) (assoc p4 :y c2y))
-     (pc/make-curve-to p1 (assoc p4 :y c1y) (assoc p1 :x c1x))]))
+     (helpers/make-curve-to p1 (assoc p4 :y c1y) (assoc p1 :x c1x))]))
 
-(defn draw-rounded-rect-path
+(defn- draw-rounded-rect-path
   ([x y width height r]
    (draw-rounded-rect-path x y width height r r r r))
 
@@ -135,21 +111,21 @@
          p7 (gpt/point (+ x r4) (+ height y))
          p8 (gpt/point x (+ height y (- r4)))]
      (-> []
-         (conj (pc/make-move-to p1))
+         (conj (helpers/make-move-to p1))
          (cond-> (not= p1 p2)
            (conj (make-corner-arc p1 p2 :top-left r1)))
-         (conj (pc/make-line-to p3))
+         (conj (helpers/make-line-to p3))
          (cond-> (not= p3 p4)
            (conj (make-corner-arc p3 p4 :top-right r2)))
-         (conj (pc/make-line-to p5))
+         (conj (helpers/make-line-to p5))
          (cond-> (not= p5 p6)
            (conj (make-corner-arc p5 p6 :bottom-right r3)))
-         (conj (pc/make-line-to p7))
+         (conj (helpers/make-line-to p7))
          (cond-> (not= p7 p8)
            (conj (make-corner-arc p7 p8 :bottom-left r4)))
-         (conj (pc/make-line-to p1))))))
+         (conj (helpers/make-line-to p1))))))
 
-(defn rect->path
+(defn- rect->path
   "Creates a bezier curve that approximates a rounded corner rectangle"
   [{:keys [x y width height] :as shape}]
   (case (ctsr/radius-mode shape)
@@ -165,7 +141,10 @@
 
 (declare convert-to-path)
 
-(defn fix-first-relative
+;; FIXME: this looks unnecesary because penpot already normalizes all
+;; path content to be absolute. There are no relative segments on
+;; penpot.
+(defn- fix-first-relative
   "Fix an issue with the simplify commands not changing the first relative"
   [content]
   (let [head (first content)]
@@ -173,17 +152,19 @@
       (and head (:relative head))
       (update 0 assoc :relative false))))
 
-(defn group-to-path
+(defn- group-to-path
   [group objects]
-  (let [xform (comp (map #(get objects %))
+  (let [xform (comp (map (d/getf objects))
-                    (map #(-> (convert-to-path % objects))))
+                    (map #(convert-to-path % objects)))
 
         child-as-paths (into [] xform (:shapes group))
-        head (last child-as-paths)
+        head (peek child-as-paths)
-        head-data (select-keys head style-properties)
+        head-data (select-keys head bool/style-properties)
         content (into []
-                      (comp (filter #(= :path (:type %)))
+                      (comp (filter cfh/path-shape?)
-                            (mapcat #(fix-first-relative (:content %))))
+                            (map :content)
+                            (map vec)
+                            (mapcat fix-first-relative))
                       child-as-paths)]
     (-> group
         (assoc :type :path)
@@ -191,54 +172,68 @@
         (merge head-data)
         (d/without-keys dissoc-attrs))))
 
-(defn bool-to-path
+(defn- bool-to-path
   [shape objects]
 
-  (let [children (->> (:shapes shape)
+  (let [children
-                      (map #(get objects %))
+        (->> (:shapes shape)
-                      (map #(convert-to-path % objects)))
+             (map (d/getf objects))
-        bool-type (:bool-type shape)
+             (map #(convert-to-path % objects)))
-        content (pb/content-bool bool-type (mapv :content children))]
+
+        bool-type
+        (:bool-type shape)
+
+        content
+        (bool/calculate-content bool-type (map :content children))]
+
     (-> shape
         (assoc :type :path)
         (assoc :content content)
+        (dissoc :bool-type)
         (d/without-keys dissoc-attrs))))
 
 (defn convert-to-path
-  "Transforms the given shape to a path"
+  "Transforms the given shape to a path shape"
-  ([shape]
+  [shape objects]
-   (convert-to-path shape {}))
+  (assert (map? objects))
-  ([{:keys [type metadata] :as shape} objects]
+  ;; FIXME: add check-objects-like
-   (assert (map? objects))
+  ;; FIXME: add check-shape ?
-   (case type
-     (:group :frame)
-     (group-to-path shape objects)
 
-     :bool
+  (let [type (dm/get-prop shape :type)]
-     (bool-to-path shape objects)
 
-     (:rect :circle :image :text)
+    (case type
-     (let [new-content
+      (:group :frame)
-           (case type
+      (group-to-path shape objects)
-             :circle (circle->path shape)
-             #_:else (rect->path shape))
 
-           ;; Apply the transforms that had the shape
+      :bool
-           transform
+      (bool-to-path shape objects)
-           (cond-> (:transform shape (gmt/matrix))
-             (:flip-x shape) (gmt/scale (gpt/point -1 1))
-             (:flip-y shape) (gmt/scale (gpt/point 1 -1)))
 
-           new-content (cond-> new-content
+      (:rect :circle :image :text)
-                         (some? transform)
+      (let [content
-                         (gsp/transform-content (gmt/transform-in (gco/shape->center shape) transform)))]
+            (if (= type :circle)
+              (circle->path shape)
+              (rect->path shape))
 
-       (-> shape
+            content
-           (assoc :type :path)
+            (path.impl/from-plain content)
-           (assoc :content new-content)
-           (cond-> (= :image type)
-             (assoc :fill-image metadata))
-           (d/without-keys dissoc-attrs)))
 
-     ;; For the rest return the plain shape
+            ;; Apply the transforms that had the shape
-     shape)))
+            transform
+            (cond-> (:transform shape (gmt/matrix))
+              (:flip-x shape) (gmt/scale (gpt/point -1 1))
+              (:flip-y shape) (gmt/scale (gpt/point 1 -1)))
+
+            content
+            (cond-> content
+              (some? transform)
+              (segm/transform-content (gmt/transform-in (gco/shape->center shape) transform)))]
+
+        (-> shape
+            (assoc :type :path)
+            (assoc :content content)
+            (cond-> (= :image type)
+              (assoc :fill-image (get shape :metadata)))
+            (d/without-keys dissoc-attrs)))
+
+      ;; For the rest return the plain shape
+      shape)))

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

@@ -4,11 +4,11 @@
 ;;
 ;; Copyright (c) KALEIDOS INC
 
-(ns app.common.svg.path.subpath
+(ns app.common.types.path.subpath
   (:require
    [app.common.data :as d]
    [app.common.geom.point :as gpt]
-   [app.common.svg.path.command :as upc]))
+   [app.common.types.path.helpers :as helpers]))
 
 (defn pt=
   "Check if two points are close"
@@ -18,7 +18,7 @@
 (defn make-subpath
   "Creates a subpath either from a single command or with all the data"
   ([command]
-   (let [p (upc/command->point command)]
+   (let [p (helpers/segment->point command)]
      (make-subpath p p [command])))
   ([from to data]
    {:from from
@@ -29,9 +29,9 @@
   "Adds a command to the subpath"
   [subpath command]
   (let [command (if (= :close-path (:command command))
-                  (upc/make-line-to (:from subpath))
+                  (helpers/make-line-to (:from subpath))
                   command)
-        p (upc/command->point command)]
+        p (helpers/segment->point command)]
     (-> subpath
         (assoc :to p)
         (update :data conj command))))
@@ -62,7 +62,7 @@
             result))
 
         new-data (->> subpath :data d/with-prev reverse
-                      (reduce reverse-commands [(upc/make-move-to (:to subpath))]))]
+                      (reduce reverse-commands [(helpers/make-move-to (:to subpath))]))]
 
     (make-subpath (:to subpath) (:from subpath) new-data)))
 
@@ -125,6 +125,9 @@
 (defn is-closed? [subpath]
   (pt= (:from subpath) (:to subpath)))
 
+(def ^:private xf-mapcat-data
+  (mapcat :data))
+
 (defn close-subpaths
   "Searches a path for possible subpaths that can create closed loops and merge them"
   [content]
@@ -153,20 +156,17 @@
                        new-subpaths)))
             result))]
 
-    (->> closed-subpaths
-         (mapcat :data)
-         (into []))))
 
+    (into [] xf-mapcat-data closed-subpaths)))
+
+;; FIXME: revisit this fn impl for perfromance
 (defn reverse-content
   "Given a content reverse the order of the commands"
   [content]
-
+  (->> (get-subpaths content)
-  (->> content
-       (get-subpaths)
        (mapv reverse-subpath)
        (reverse)
-       (mapcat :data)
+       (into [] xf-mapcat-data)))
-       (into [])))
 
 ;; https://mathworld.wolfram.com/PolygonArea.html
 (defn clockwise?
@@ -181,10 +181,10 @@
       (if (nil? current)
         (> signed-area 0)
 
-        (let [{x1 :x y1 :y :as p} (upc/command->point current)
+        (let [{x1 :x y1 :y :as p} (helpers/segment->point current)
               last? (nil? (first subpath))
               first-point (if (nil? first-point) p first-point)
-              {x2 :x y2 :y} (if last? first-point (upc/command->point (first subpath)))
+              {x2 :x y2 :y} (if last? first-point (helpers/segment->point (first subpath)))
               signed-area (+ signed-area (- (* x1 y2) (* x2 y1)))]
 
           (recur (first subpath)

common/src/app/common/types/shape.cljc

@@ -22,13 +22,14 @@
    [app.common.transit :as t]
    [app.common.types.color :as ctc]
    [app.common.types.grid :as ctg]
+   [app.common.types.path :as path]
+   [app.common.types.path.segment :as path.segment]
    [app.common.types.plugins :as ctpg]
    [app.common.types.shape.attrs :refer [default-color]]
    [app.common.types.shape.blur :as ctsb]
    [app.common.types.shape.export :as ctse]
    [app.common.types.shape.interactions :as ctsi]
    [app.common.types.shape.layout :as ctsl]
-   [app.common.types.shape.path :as ctsp]
    [app.common.types.shape.shadow :as ctss]
    [app.common.types.shape.text :as ctsx]
    [app.common.types.token :as cto]
@@ -234,7 +235,7 @@
   [:map {:title "BoolAttrs"}
    [:shapes [:vector {:gen/max 10 :gen/min 1} ::sm/uuid]]
    [:bool-type [::sm/one-of bool-types]]
-   [:content ::ctsp/content]])
+   [:content ::path/content]])
 
 (def ^:private schema:rect-attrs
   [:map {:title "RectAttrs"}])
@@ -259,7 +260,7 @@
 
 (def ^:private schema:path-attrs
   [:map {:title "PathAttrs"}
-   [:content ::ctsp/content]])
+   [:content ::path/content]])
 
 (def ^:private schema:text-attrs
   [:map {:title "TextAttrs"}
@@ -525,7 +526,7 @@
 (defn setup-path
   [{:keys [content selrect points] :as shape}]
   (let [selrect (or selrect
-                    (gsh/content->selrect content)
+                    (path.segment/content->selrect content)
                     (grc/make-rect))
         points  (or points  (grc/rect->points selrect))]
     (-> shape

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

@@ -1,431 +0,0 @@
-;; 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) KALEIDOS INC
-
-(ns app.common.types.shape.path
-  (:require
-   [app.common.schema :as sm])
-  (:import
-   #?(:cljs [goog.string StringBuffer]
-      :clj  [java.nio ByteBuffer])))
-
-#?(:clj (set! *warn-on-reflection* true))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; SCHEMA: PLAIN FORMAT
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(def schema:line-to-segment
-  [:map
-   [:command [:= :line-to]]
-   [:params
-    [:map
-     [:x ::sm/safe-number]
-     [:y ::sm/safe-number]]]])
-
-(def schema:close-path-segment
-  [:map
-   [:command [:= :close-path]]])
-
-(def schema:move-to-segment
-  [:map
-   [:command [:= :move-to]]
-   [:params
-    [:map
-     [:x ::sm/safe-number]
-     [:y ::sm/safe-number]]]])
-
-(def schema:curve-to-segment
-  [:map
-   [:command [:= :curve-to]]
-   [:params
-    [:map
-     [:x ::sm/safe-number]
-     [:y ::sm/safe-number]
-     [:c1x ::sm/safe-number]
-     [:c1y ::sm/safe-number]
-     [:c2x ::sm/safe-number]
-     [:c2y ::sm/safe-number]]]])
-
-(def schema:path-segment
-  [:multi {:title "PathSegment"
-           :dispatch :command
-           :decode/json #(update % :command keyword)}
-   [:line-to schema:line-to-segment]
-   [:close-path schema:close-path-segment]
-   [:move-to schema:move-to-segment]
-   [:curve-to schema:curve-to-segment]])
-
-(def schema:path-content
-  [:vector schema:path-segment])
-
-(def check-path-content
-  (sm/check-fn schema:path-content))
-
-(sm/register! ::segment schema:path-segment)
-(sm/register! ::content schema:path-content)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; TYPE: PATH-DATA
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(def ^:const SEGMENT-BYTE-SIZE 28)
-
-(defprotocol IPathData
-  (-write-to [_ buffer offset] "write the content to the specified buffer"))
-
-(defrecord PathSegment [command params])
-
-(defn- get-path-string
-  "Format the path data structure to string"
-  [buffer size]
-  (let [builder #?(:clj (java.lang.StringBuilder. (int (* size 4)))
-                   :cljs (StringBuffer.))]
-    (loop [index 0]
-      (when (< index size)
-        (let [offset (* index SEGMENT-BYTE-SIZE)
-              type   #?(:clj  (.getShort ^ByteBuffer buffer offset)
-                        :cljs (.getInt16 buffer offset))]
-          (case (long type)
-            1 (let [x #?(:clj  (.getFloat ^ByteBuffer buffer (+ offset 20))
-                         :cljs (.getFloat32 buffer (+ offset 20)))
-                    y #?(:clj  (.getFloat ^ByteBuffer buffer (+ offset 24))
-                         :cljs (.getFloat32 buffer (+ offset 24)))]
-                (doto builder
-                  (.append "M")
-                  (.append x)
-                  (.append ",")
-                  (.append y)))
-            2 (let [x #?(:clj  (.getFloat ^ByteBuffer buffer (+ offset 20))
-                         :cljs (.getFloat32 buffer (+ offset 20)))
-                    y #?(:clj  (.getFloat ^ByteBuffer buffer (+ offset 24))
-                         :cljs (.getFloat32 buffer (+ offset 24)))]
-                (doto builder
-                  (.append "L")
-                  (.append x)
-                  (.append ",")
-                  (.append y)))
-
-            3 (let [c1x #?(:clj  (.getFloat ^ByteBuffer buffer (+ offset 4))
-                           :cljs (.getFloat32 buffer (+ offset 4)))
-                    c1y #?(:clj  (.getFloat ^ByteBuffer buffer (+ offset 8))
-                           :cljs (.getFloat32 buffer (+ offset 8)))
-                    c2x #?(:clj  (.getFloat ^ByteBuffer buffer (+ offset 12))
-                           :cljs (.getFloat32 buffer (+ offset 12)))
-                    c2y #?(:clj  (.getFloat ^ByteBuffer buffer (+ offset 16))
-                           :cljs (.getFloat32 buffer (+ offset 16)))
-                    x   #?(:clj  (.getFloat ^ByteBuffer buffer (+ offset 20))
-                           :cljs (.getFloat32 buffer (+ offset 20)))
-                    y   #?(:clj  (.getFloat ^ByteBuffer buffer (+ offset 24))
-                           :cljs (.getFloat32 buffer (+ offset 24)))]
-                (doto builder
-                  (.append "C")
-                  (.append c1x)
-                  (.append ",")
-                  (.append c1y)
-                  (.append ",")
-                  (.append c2x)
-                  (.append ",")
-                  (.append c2y)
-                  (.append ",")
-                  (.append x)
-                  (.append ",")
-                  (.append y)))
-            4 (doto builder
-                (.append "Z")))
-          (recur (inc index)))))
-
-    (.toString builder)))
-
-(defn- read-segment
-  [buffer index]
-  (let [offset (* index SEGMENT-BYTE-SIZE)
-        type   #?(:clj  (.getShort ^ByteBuffer buffer offset)
-                  :cljs (.getInt16 buffer offset))]
-    (case (long type)
-      1 (let [x #?(:clj  (.getFloat ^ByteBuffer buffer (+ offset 20))
-                   :cljs (.getFloat32 buffer (+ offset 20)))
-              y #?(:clj  (.getFloat ^ByteBuffer buffer (+ offset 24))
-                   :cljs (.getFloat32 buffer (+ offset 24)))]
-          (->PathSegment :move-to {:x x :y y}))
-
-      2 (let [x #?(:clj  (.getFloat ^ByteBuffer buffer (+ offset 20))
-                   :cljs (.getFloat32 buffer (+ offset 20)))
-              y #?(:clj  (.getFloat ^ByteBuffer buffer (+ offset 24))
-                   :cljs (.getFloat32 buffer (+ offset 24)))]
-          (->PathSegment :line-to {:x x :y y}))
-
-      3 (let [c1x #?(:clj  (.getFloat ^ByteBuffer buffer (+ offset 4))
-                     :cljs (.getFloat32 buffer (+ offset 4)))
-              c1y #?(:clj  (.getFloat ^ByteBuffer buffer (+ offset 8))
-                     :cljs (.getFloat32 buffer (+ offset 8)))
-              c2x #?(:clj  (.getFloat ^ByteBuffer buffer (+ offset 12))
-                     :cljs (.getFloat32 buffer (+ offset 12)))
-              c2y #?(:clj  (.getFloat ^ByteBuffer buffer (+ offset 16))
-                     :cljs (.getFloat32 buffer (+ offset 16)))
-              x   #?(:clj  (.getFloat ^ByteBuffer buffer (+ offset 20))
-                     :cljs (.getFloat32 buffer (+ offset 20)))
-              y   #?(:clj  (.getFloat ^ByteBuffer buffer (+ offset 24))
-                     :cljs (.getFloat32 buffer (+ offset 24)))]
-
-          (->PathSegment :curve-to {:x x :y y :c1x c1x :c1y c1y :c2x c2x :c2y c2y}))
-
-      4 (->PathSegment :close-path {}))))
-
-(defn- in-range?
-  [size i]
-  (and (< i size) (>= i 0)))
-
-#?(:clj
-   (deftype PathData [size buffer]
-     Object
-     (toString [_]
-       (get-path-string buffer size))
-
-     clojure.lang.Sequential
-     clojure.lang.IPersistentCollection
-
-     (empty [_]
-       (throw (ex-info "not implemented" {})))
-     (equiv [_ other]
-       (if (instance? PathData other)
-         (.equals ^ByteBuffer buffer (.-buffer ^PathData other))
-         false))
-
-     (seq [this]
-       (when (pos? size)
-         (->> (range size)
-              (map (fn [i] (nth this i))))))
-
-     (cons [_ _val]
-       (throw (ex-info "not implemented" {})))
-
-     clojure.lang.IReduceInit
-     (reduce [_ f start]
-       (loop [index  0
-              result start]
-         (if (< index size)
-           (let [result (f result (read-segment buffer index))]
-             (if (reduced? result)
-               @result
-               (recur (inc index) result)))
-           result)))
-
-     clojure.lang.Indexed
-     (nth [_ i]
-       (if (in-range? size i)
-         (read-segment buffer i)
-         nil))
-
-     (nth [_ i default]
-       (if (in-range? size i)
-         (read-segment buffer i)
-         default))
-
-     clojure.lang.Counted
-     (count [_] size))
-
-   :cljs
-   (deftype PathData [size buffer dview]
-     Object
-     (toString [_]
-       (get-path-string dview size))
-
-     IPathData
-     (-write-to [_ into-buffer offset]
-       (assert (instance? js/ArrayBuffer into-buffer) "expected an instance of Uint32Array")
-       (let [size (.-byteLength buffer)
-             mem  (js/Uint32Array. into-buffer offset size)]
-         (.set mem (js/Uint32Array. buffer))))
-
-     cljs.core/ISequential
-     cljs.core/IEquiv
-     (-equiv [_ other]
-       (if (instance? PathData other)
-         (let [obuffer (.-buffer other)
-               osize   (.-byteLength obuffer)
-               csize   (.-byteLength buffer)]
-           (if (= osize csize)
-             (let [cb (js/Uint32Array. buffer)
-                   ob (js/Uint32Array. obuffer)]
-               (loop [i 0]
-                 (if (< i osize)
-                   (if (= (aget ob i)
-                          (aget cb i))
-                     (recur (inc i))
-                     false)
-                   true)))
-             false))
-         false))
-
-     cljs.core/IReduce
-     (-reduce [_ f]
-       (loop [index  1
-              result (if (pos? size)
-                       (read-segment dview 0)
-                       nil)]
-         (if (< index size)
-           (let [result (f result (read-segment dview index))]
-             (if (reduced? result)
-               @result
-               (recur (inc index) result)))
-           result)))
-
-     (-reduce [_ f start]
-       (loop [index  0
-              result start]
-         (if (< index size)
-           (let [result (f result (read-segment dview index))]
-             (if (reduced? result)
-               @result
-               (recur (inc index) result)))
-           result)))
-
-     cljs.core/IHash
-     (-hash [_]
-       (throw (ex-info "not-implemented" {})))
-
-     cljs.core/ICounted
-     (-count [_] size)
-
-     cljs.core/IIndexed
-     (-nth [_ i]
-       (if (in-range? size i)
-         (read-segment dview i)
-         nil))
-
-     (-nth [_ i default]
-       (if (in-range? i size)
-         (read-segment dview i)
-         default))
-
-     cljs.core/ISeqable
-     (-seq [this]
-       (when (pos? size)
-         (->> (range size)
-              (map (fn [i] (cljs.core/-nth this i))))))))
-
-(defn- from-bytes
-  [buffer]
-  #?(:clj
-     (cond
-       (instance? ByteBuffer buffer)
-       (let [size  (.capacity ^ByteBuffer buffer)
-             count (long (/ size SEGMENT-BYTE-SIZE))]
-         (PathData. count buffer))
-
-       (bytes? buffer)
-       (let [size  (alength ^bytes buffer)
-             count (long (/ size SEGMENT-BYTE-SIZE))]
-         (PathData. count
-                    (ByteBuffer/wrap buffer)))
-
-       :else
-       (throw (java.lang.IllegalArgumentException. "invalid data provided")))
-
-     :cljs
-     (cond
-       (instance? js/ArrayBuffer buffer)
-       (let [size  (.-byteLength buffer)
-             count (long (/ size SEGMENT-BYTE-SIZE))]
-         (PathData. count
-                    buffer
-                    (js/DataView. buffer)))
-
-       (instance? js/DataView buffer)
-       (let [dview  buffer
-             buffer (.-buffer dview)
-             size  (.-byteLength buffer)
-             count (long (/ size SEGMENT-BYTE-SIZE))]
-         (PathData. count buffer dview))
-
-       :else
-       (throw (js/Error. "invalid data provided")))))
-
-;; FIXME: consider implementing with reduce
-;; FIXME: consider ensure fixed precision for avoid doing it on formatting
-
-(defn- from-plain
-  "Create a PathData instance from plain data structures"
-  [content]
-  (assert (check-path-content content))
-
-  (let [content (vec content)
-        total   (count content)
-        #?@(:cljs [buffer (new js/ArrayBuffer (* total SEGMENT-BYTE-SIZE))
-                   dview  (new js/DataView buffer)]
-            :clj  [buffer (ByteBuffer/allocate (* total SEGMENT-BYTE-SIZE))])]
-    (loop [index 0]
-      (when (< index total)
-        (let [segment (nth content index)
-              offset  (* index SEGMENT-BYTE-SIZE)]
-          (case (get segment :command)
-            :move-to
-            (let [params (get segment :params)
-                  x      (float (get params :x))
-                  y      (float (get params :y))]
-              #?(:clj  (.putShort buffer (int offset) (short 1))
-                 :cljs (.setInt16 dview offset 1))
-              #?(:clj  (.putFloat buffer (+ offset 20) x)
-                 :cljs (.setFloat32 dview (+ offset 20) x))
-              #?(:clj  (.putFloat buffer (+ offset 24) y)
-                 :cljs (.setFloat32 dview (+ offset 24) y)))
-
-            :line-to
-            (let [params (get segment :params)
-                  x      (float (get params :x))
-                  y      (float (get params :y))]
-              #?(:clj  (.putShort buffer (int offset) (short 2))
-                 :cljs (.setInt16 dview offset 2))
-              #?(:clj  (.putFloat buffer (+ offset 20) x)
-                 :cljs (.setFloat32 dview (+ offset 20) x))
-              #?(:clj  (.putFloat buffer (+ offset 24) y)
-                 :cljs (.setFloat32 dview (+ offset 24) y)))
-
-            :curve-to
-            (let [params (get segment :params)
-                  x      (float (get params :x))
-                  y      (float (get params :y))
-                  c1x    (float (get params :c1x x))
-                  c1y    (float (get params :c1y y))
-                  c2x    (float (get params :c2x x))
-                  c2y    (float (get params :c2y y))]
-
-              #?(:clj  (.putShort buffer (int offset) (short 3))
-                 :cljs (.setInt16 dview offset 3))
-              #?(:clj  (.putFloat buffer (+ offset 4) c1x)
-                 :cljs (.setFloat32 dview (+ offset 4) c1x))
-              #?(:clj  (.putFloat buffer (+ offset 8) c1y)
-                 :cljs (.setFloat32 dview (+ offset 8) c1y))
-              #?(:clj  (.putFloat buffer (+ offset 12) c2x)
-                 :cljs (.setFloat32 dview (+ offset 12) c2x))
-              #?(:clj  (.putFloat buffer (+ offset 16) c2y)
-                 :cljs (.setFloat32 dview (+ offset 16) c2y))
-              #?(:clj  (.putFloat buffer (+ offset 20) x)
-                 :cljs (.setFloat32 dview (+ offset 20) x))
-              #?(:clj  (.putFloat buffer (+ offset 24) y)
-                 :cljs (.setFloat32 dview (+ offset 24) y)))
-
-            :close-path
-            #?(:clj  (.putShort buffer (int offset) (short 4))
-               :cljs (.setInt16 dview offset 4)))
-          (recur (inc index)))))
-
-    #?(:cljs (from-bytes dview)
-       :clj  (from-bytes buffer))))
-
-(defn path-data
-  "Create an instance of PathData, returns itself if it is already
-  PathData instance"
-  [data]
-  (cond
-    (instance? PathData data)
-    data
-
-    (sequential? data)
-    (from-plain data)
-
-    :else
-    (from-bytes data)))

common/src/app/common/weak_map.cljs

@@ -0,0 +1,29 @@
+;; 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) KALEIDOS INC
+
+(ns app.common.weak-map
+  "A value based weak-map implementation (CLJS/JS)")
+
+(deftype ValueWeakMap [^js/Map data ^js/FinalizationRegistry registry]
+  Object
+  (clear [_]
+    (.clear data))
+  (delete [_ key]
+    (.delete data key))
+  (get [_ key]
+    (if-let [ref (.get data key)]
+      (.deref ^WeakRef ref)
+      nil))
+  (set [_ key val]
+    (.set data key (js/WeakRef. val))
+    (.register registry val key)
+    nil))
+
+(defn create
+  []
+  (let [data (js/Map.)
+        registry (js/FinalizationRegistry. #(.delete data %))]
+    (ValueWeakMap. data registry)))

common/test/common_tests/geom_shapes_test.cljc

@@ -14,6 +14,7 @@
    [app.common.geom.shapes.transforms :as gsht]
    [app.common.math :as mth :refer [close?]]
    [app.common.types.modifiers :as ctm]
+   [app.common.types.path :as path]
    [app.common.types.shape :as cts]
    [clojure.test :as t]))
 
@@ -30,7 +31,7 @@
    (if (= type :path)
      (cts/setup-shape
       (into {:type :path
-             :content (:content params default-path)}
+             :content (path/content (:content params default-path))}
             params))
      (cts/setup-shape
       (into {:type type

common/test/common_tests/runner.cljc

@@ -39,9 +39,9 @@
    [common-tests.types.absorb-assets-test]
    [common-tests.types.components-test]
    [common-tests.types.modifiers-test]
+   [common-tests.types.path-data-test]
    [common-tests.types.shape-decode-encode-test]
    [common-tests.types.shape-interactions-test]
-   [common-tests.types.shape-path-data-test]
    [common-tests.types.tokens-lib-test]
    [common-tests.uuid-test]))
 
@@ -91,5 +91,5 @@
    'common-tests.types.tokens-lib-test
    'common-tests.types.components-test
    'common-tests.types.absorb-assets-test
-   'common-tests.types.shape-path-data-test
+   'common-tests.types.path-data-test
    'common-tests.uuid-test))

common/test/common_tests/types/path_data_test.cljc

@@ -0,0 +1,380 @@
+;; 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) KALEIDOS INC
+
+(ns common-tests.types.path-data-test
+  (:require
+   #?(:clj [app.common.fressian :as fres])
+   [app.common.data :as d]
+   [app.common.geom.matrix :as gmt]
+   [app.common.geom.point :as gpt]
+   [app.common.math :as mth]
+   [app.common.pprint :as pp]
+   [app.common.transit :as trans]
+   [app.common.types.path :as path]
+   [app.common.types.path.helpers :as path.helpers]
+   [app.common.types.path.impl :as path.impl]
+   [app.common.types.path.segment :as path.segment]
+   [clojure.test :as t]))
+
+(def sample-content
+  [{:command :move-to :params {:x 480.0 :y 839.0}}
+   {:command :line-to :params {:x 439.0 :y 802.0}}
+   {:command :curve-to :params {:c1x 368.0 :c1y 737.0 :c2x 310.0 :c2y 681.0 :x 264.0 :y 634.0}}
+   {:command :close-path :params {}}])
+
+(def sample-content-large
+  [{:command :move-to :params {:x 480.0 :y 839.0}}
+   {:command :line-to :params {:x 439.0 :y 802.0}}
+   {:command :curve-to :params {:c1x 368.0 :c1y 737.0 :c2x 310.0 :c2y 681.0 :x 264.0 :y 634.0}}
+   {:command :curve-to :params {:c1x 218.0 :c1y 587.0 :c2x 181.0 :c2y 545.0 :x 154.0 :y 508.0}}
+   {:command :curve-to :params {:c1x 126.0 :c1y 471.0 :c2x 107.0 :c2y 438.0 :x 96.0  :y 408.0}}
+   {:command :curve-to :params {:c1x 85.0  :c1y 378.0 :c2x 80.0  :c2y 347.0 :x 80.0  :y 317.0}}
+   {:command :curve-to :params {:c1x 80.0  :c1y 256.0 :c2x 100.0 :c2y 206.0 :x 140.0 :y 166.0}}
+   {:command :curve-to :params {:c1x 180.0 :c1y 126.0 :c2x 230.0 :c2y 106.0 :x 290.0 :y 106.0}}
+   {:command :curve-to :params {:c1x 328.0 :c1y 106.0 :c2x 363.0 :c2y 115.0 :x 395.0 :y 133.0}}
+   {:command :curve-to :params {:c1x 427.0 :c1y 151.0 :c2x 456.0 :c2y 177.0 :x 480.0 :y 211.0}}
+   {:command :curve-to :params {:c1x 508.0 :c1y 175.0 :c2x 537.0 :c2y 148.0 :x 569.0 :y 131.0}}
+   {:command :curve-to :params {:c1x 600.0 :c1y 114.0 :c2x 634.0 :c2y 106.0 :x 670.0 :y 106.0}}
+   {:command :curve-to :params {:c1x 729.0 :c1y 106.0 :c2x 779.0 :c2y 126.0 :x 819.0 :y 166.0}}
+   {:command :curve-to :params {:c1x 859.0 :c1y 206.0 :c2x 880.0 :c2y 256.0 :x 880.0 :y 317.0}}
+   {:command :curve-to :params {:c1x 880.0 :c1y 347.0 :c2x 874.0 :c2y 378.0 :x 863.0 :y 408.0}}
+   {:command :curve-to :params {:c1x 852.0 :c1y 438.0 :c2x 833.0 :c2y 471.0 :x 806.0 :y 508.0}}
+   {:command :curve-to :params {:c1x 778.0 :c1y 545.0 :c2x 741.0 :c2y 587.0 :x 695.0 :y 634.0}}
+   {:command :curve-to :params {:c1x 649.0 :c1y 681.0 :c2x 591.0 :c2y 737.0 :x 521.0 :y 802.0}}
+   {:command :line-to :params {:x 480.0 :y 839.0}}
+   {:command :close-path :params {}}
+   {:command :move-to :params {:x 480.0 :y 760.0}}
+   {:command :curve-to :params {:c1x 547.0 :c1y 698.0 :c2x 603.0 :c2y 644.0 :x 646.0 :y 600.0}}
+   {:command :curve-to :params {:c1x 690.0 :c1y 556.0 :c2x 724.0 :c2y 517.0 :x 750.0 :y 484.0}}
+   {:command :curve-to :params {:c1x 776.0 :c1y 450.0 :c2x 794.0 :c2y 420.0 :x 804.0 :y 394.0}}
+   {:command :curve-to :params {:c1x 814.0 :c1y 368.0 :c2x 820.0 :c2y 342.0 :x 820.0 :y 317.0}}
+   {:command :curve-to :params {:c1x 820.0 :c1y 273.0 :c2x 806.0 :c2y 236.0 :x 778.0 :y 2085.0}}
+   {:command :curve-to :params {:c1x 750.0 :c1y 180.0 :c2x 714.0 :c2y 166.0 :x 670.0 :y 1660.0}}
+   {:command :curve-to :params {:c1x 635.0 :c1y 166.0 :c2x 604.0 :c2y 176.0 :x 574.0 :y 1975.0}}
+   {:command :curve-to :params {:c1x 545.0 :c1y 218.0 :c2x 522.0 :c2y 248.0 :x 504.0 :y 2860.0}}
+   {:command :line-to :params {:x 455.0 :y 286.0}}
+   {:command :curve-to :params {:c1x 437.0 :c1y 248.0 :c2x 414.0 :c2y 219.0 :x 385.0 :y 198.0}}
+   {:command :curve-to :params {:c1x 355.0 :c1y 176.0 :c2x 324.0 :c2y 166.0 :x 289.0 :y 166.0}}
+   {:command :curve-to :params {:c1x 245.0 :c1y 166.0 :c2x 210.0 :c2y 180.0 :x 182.0 :y 208.0}}
+   {:command :curve-to :params {:c1x 154.0 :c1y 236.0 :c2x 140.0 :c2y 273.0 :x 140.0 :y 317.0}}
+   {:command :curve-to :params {:c1x 140.0 :c1y 343.0 :c2x 145.0 :c2y 369.0 :x 155.0 :y 395.0}}
+   {:command :curve-to :params {:c1x 165.0 :c1y 421.0 :c2x 183.0 :c2y 451.0 :x 209.0 :y 485.0}}
+   {:command :curve-to :params {:c1x 235.0 :c1y 519.0 :c2x 270.0 :c2y 558.0 :x 314.0 :y 602.0}}
+   {:command :curve-to :params {:c1x 358.0 :c1y 646.0 :c2x 413.0 :c2y 698.0 :x 480.0 :y 760.0}}
+   {:command :close-path :params {}}
+   {:command :move-to :params {:x 480.0 :y 463.0}}
+   {:command :close-path :params {}}])
+
+(def sample-bytes
+  [1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 -16 67 0 -64 81 68
+   2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 -128 -37 67 0 -128 72 68
+   3 0 0 0 0 0 -72 67 0 64 56 68 0 0 -101 67 0 64 42 68 0 0 -124 67 0 -128 30 68
+   4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0])
+
+;; This means it implements IReduceInit/IReduce protocols
+(t/deftest path-data-to-vector
+  (let [pdata  (path/content sample-content)
+        result (vec pdata)]
+    (t/is (= 4 (count result)))
+    (t/is (= (get-in sample-content [0 :command])
+             (get-in result [0 :command])))
+    (t/is (= (get-in sample-content [1 :command])
+             (get-in result [1 :command])))
+    (t/is (= (get-in sample-content [2 :command])
+             (get-in result [2 :command])))
+    (t/is (= (get-in sample-content [3 :command])
+             (get-in result [3 :command])))
+
+    (t/is (= (get-in sample-content [0 :params])
+             (get-in result [0 :params])))
+    (t/is (= (get-in sample-content [1 :params])
+             (get-in result [1 :params])))
+    (t/is (= (get-in sample-content [2 :params])
+             (get-in result [2 :params])))
+    (t/is (= (get-in sample-content [3 :params])
+             (get-in result [3 :params])))))
+
+(t/deftest path-data-plain-to-binary
+  (let [pdata (path/content sample-content)]
+    (t/is (= sample-bytes
+             (vec
+              #?(:cljs (js/Int8Array. (.-buffer pdata))
+                 :clj  (.array (.-buffer pdata))))))
+    (t/is (= sample-content
+             (vec pdata)))))
+
+(t/deftest path-data-from-binary
+  (let [barray #?(:clj (byte-array sample-bytes)
+                  :cljs (js/Int8Array.from sample-bytes))
+        content (path/from-bytes barray)]
+
+    (t/is (= (vec content) sample-content))))
+
+(t/deftest path-data-transit-roundtrip
+  (let [pdata    (path/content sample-content)
+        result1  (trans/encode-str pdata)
+        expected (str "[\"~#penpot/path-data\",\"~bAQAAAAAAAAAAAAA"
+                      "AAAAAAAAAAAAAAPBDAMBRRAIAAAAAAAAAAAAAAAAAAA"
+                      "AAAAAAAIDbQwCASEQDAAAAAAC4QwBAOEQAAJtDAEAqR"
+                      "AAAhEMAgB5EBAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"
+                      "AAAAAA==\"]")
+        result2  (trans/decode-str result1)]
+    (t/is (= expected result1))
+    (t/is (= pdata result2))))
+
+#?(:clj
+   (t/deftest path-data-fresian
+     (let [pdata (path/content sample-content)
+           result1 (fres/encode pdata)
+           result2 (fres/decode result1)]
+       (t/is (= pdata result2)))))
+
+(defn- transform-plain-content
+  "Apply a transformation to a path content;
+
+  This is a copy of previous impl, that uses plain format to calculate
+  the new transformed path content"
+  [content transform]
+  (let [set-tr
+        (fn [params px py]
+          (let [tr-point (-> (gpt/point (get params px) (get params py))
+                             (gpt/transform transform))]
+            (assoc params
+                   px (:x tr-point)
+                   py (:y tr-point))))
+
+        transform-params
+        (fn [{:keys [x c1x c2x] :as params}]
+          (cond-> params
+            (some? x)   (set-tr :x :y)
+            (some? c1x) (set-tr :c1x :c1y)
+            (some? c2x) (set-tr :c2x :c2y)))]
+
+    (into []
+          (map #(update % :params transform-params))
+          content)))
+
+(t/deftest path-transform-1
+  (let [matrix  (gmt/translate-matrix 10 10)
+        content (path/content sample-content)
+
+        result1 (path/transform-content content matrix)
+        result2 (transform-plain-content sample-content matrix)
+        result3 (transform-plain-content content matrix)]
+
+    (t/is (= (vec result1) result2))
+    (t/is (= result2 result3))))
+
+(t/deftest path-transform-2
+  (let [matrix  (gmt/translate-matrix 10 10)
+        content (path/content sample-content-large)
+
+        result1 (path/transform-content content matrix)
+        result2 (transform-plain-content sample-content-large matrix)
+        result3 (transform-plain-content content matrix)]
+
+    (t/is (= (vec result1) result2))
+    (t/is (= result2 result3))))
+
+(defn- content->points
+  "Given a content return all points.
+
+  Legacy impl preserved for tests purposes"
+  [content]
+  (letfn [(segment->point [seg]
+            (let [params (get seg :params)
+                  x      (get params :x)
+                  y      (get params :y)]
+              (when (d/num? x y)
+                (gpt/point x y))))]
+    (some->> (seq content)
+             (into [] (keep segment->point)))))
+
+(t/deftest path-get-points
+  (let [content (path/content sample-content-large)
+
+        result1 (content->points content)
+        result2 (content->points sample-content-large)
+        result3 (path.segment/get-points content)]
+
+    (t/is (= result1 result2))
+    (t/is (= result2 result3))))
+
+(defn calculate-extremities
+  "Calculate extremities for the provided content.
+  A legacy implementation used mainly as reference for testing"
+  [content]
+  (loop [points #{}
+         from-p nil
+         move-p nil
+         content (seq content)]
+    (if content
+      (let [last-p (last content)
+            content (if (= :move-to (:command last-p))
+                      (butlast content)
+                      content)
+            command (first content)
+            to-p    (path.helpers/segment->point command)
+
+            [from-p move-p command-pts]
+            (case (:command command)
+              :move-to    [to-p   to-p   (when to-p [to-p])]
+              :close-path [move-p move-p (when move-p [move-p])]
+              :line-to    [to-p   move-p (when (and from-p to-p) [from-p to-p])]
+              :curve-to   [to-p   move-p
+                           (let [c1 (path.helpers/segment->point command :c1)
+                                 c2 (path.helpers/segment->point command :c2)
+                                 curve [from-p to-p c1 c2]]
+                             (when (and from-p to-p c1 c2)
+                               (into [from-p to-p]
+                                     (->> (path.helpers/curve-extremities curve)
+                                          (map #(path.helpers/curve-values curve %))))))]
+              [to-p move-p []])]
+
+        (recur (apply conj points command-pts) from-p move-p (next content)))
+      points)))
+
+(t/deftest extremities-1
+  (let [pdata   (path/content sample-content)
+        result1 (calculate-extremities sample-content)
+        result2 (calculate-extremities pdata)
+        result3 (path.segment/calculate-extremities sample-content)
+        result4 (path.segment/calculate-extremities pdata)
+        expect  #{(gpt/point 480.0 839.0)
+                  (gpt/point 439.0 802.0)
+                  (gpt/point 264.0 634.0)}
+        n-iter  100000]
+
+    (t/is (= result1 result3))
+    (t/is (= result1 expect))
+    (t/is (= result2 expect))
+    (t/is (= result3 expect))
+    (t/is (= result4 expect))))
+
+(def sample-content-2
+  [{:command :move-to, :params {:x 480.0, :y 839.0}}
+   {:command :line-to, :params {:x 439.0, :y 802.0}}
+   {:command :curve-to, :params {:c1x 368.0, :c1y 737.0, :c2x 310.0, :c2y 681.0, :x 4.0, :y 4.0}}
+   {:command :curve-to, :params {:c1x 3.0, :c1y 7.0, :c2x 30.0, :c2y -68.0, :x 20.0, :y 20.0}}
+   {:command :close-path :params {}}])
+
+(t/deftest extremities-2
+  (let [result1 (path.segment/calculate-extremities sample-content-2)
+        result2 (calculate-extremities sample-content-2)]
+    (t/is (= result1 result2))))
+
+(t/deftest extremities-3
+  (let [segments [{:command :move-to, :params {:x -310.5355224609375, :y 452.62115478515625}}]
+        content  (path/content segments)
+        result1  (calculate-extremities segments)
+        result2  (path.segment/calculate-extremities segments)
+        result3  (path.segment/calculate-extremities content)
+        expect   #{}]
+    (t/is (= result1 expect))
+    (t/is (= result1 expect))
+    (t/is (= result2 expect))
+    (t/is (= result3 expect))))
+
+(def sample-content-square
+  [{:command :move-to, :params {:x 0, :y 0}}
+   {:command :line-to, :params {:x 10, :y 0}}
+   {:command :line-to, :params {:x 10, :y 10}}
+   {:command :line-to, :params {:x 10, :y 0}}
+   {:command :line-to, :params {:x 0, :y 10}}
+   {: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)
+                  (gpt/point 0.0 0.0)}
+        result  (path.segment/get-segments-with-points content points)
+        expect  [{:command :line-to,
+                  :params {:x 10.0, :y 0.0},
+                  :start (gpt/point 0.0 0.0)
+                  :end (gpt/point 10.0 0.0)
+                  :index 1}
+                 {:command :close-path,
+                  :params {},
+                  :start (gpt/point 0.0 0.0)
+                  :end (gpt/point 0.0 0.0)
+                  :index 6}]]
+
+    (t/is (= result expect))))
+
+(defn handler->point
+  "A legacy impl of handler point, used as reference for test"
+  [content index prefix]
+  (when (and (some? index)
+             (some? prefix))
+    (when (and (<= 0 index)
+               (< index (count content)))
+      (let [segment (nth content index)
+            params  (get segment :params)]
+        (if (= :curve-to (:command segment))
+          (let [[cx cy] (path.helpers/prefix->coords prefix)]
+            (gpt/point (get params cx)
+                       (get params cy)))
+          (gpt/point (get params :x)
+                     (get params :y)))))))
+
+(t/deftest handler-to-point
+  (let [content (path/content sample-content-2)
+        result1 (handler->point content 3 :c1)
+        result2 (handler->point content 1 :c1)
+        result3 (handler->point content 0 :c1)
+
+        expect1 (gpt/point 3.0 7.0)
+        expect2 (gpt/point 439.0 802.0)
+        expect3 (gpt/point 480.0 839.0)
+
+        result4 (path.segment/get-handler-point content 3 :c1)
+        result5 (path.segment/get-handler-point content 1 :c1)
+        result6 (path.segment/get-handler-point content 0 :c1)]
+
+    (t/is (= result1 expect1))
+    (t/is (= result2 expect2))
+    (t/is (= result3 expect3))
+    (t/is (= result4 expect1))
+    (t/is (= result5 expect2))
+    (t/is (= result6 expect3))))
+
+(defn get-handlers
+  "Retrieve a map where for every point will retrieve a list of
+  the handlers that are associated with that point.
+  point -> [[index, prefix]].
+
+  Legacy impl"
+  [content]
+  (->> (d/with-prev content)
+       (d/enumerate)
+       (mapcat (fn [[index [cur-segment pre-segment]]]
+                 (if (and pre-segment (= :curve-to (:command cur-segment)))
+                   (let [cur-pos (path.helpers/segment->point cur-segment)
+                         pre-pos (path.helpers/segment->point pre-segment)]
+                     (-> [[pre-pos [index :c1]]
+                          [cur-pos [index :c2]]]))
+                   [])))
+
+       (group-by first)
+       (d/mapm #(mapv second %2))))
+
+(t/deftest content-to-handlers
+  (let [content (path/content sample-content-large)
+        result1 (get-handlers sample-content-large)
+        result2 (path.segment/get-handlers content)]
+    (t/is (= result1 result2))))

common/test/common_tests/types/shape_decode_encode_test.cljc

@@ -12,10 +12,10 @@
    [app.common.schema.generators :as sg]
    [app.common.schema.test :as smt]
    [app.common.types.color :refer [schema:color schema:gradient]]
+   [app.common.types.path :as path]
    [app.common.types.plugins :refer [schema:plugin-data]]
    [app.common.types.shape :as tsh]
    [app.common.types.shape.interactions :refer [schema:animation schema:interaction]]
-   [app.common.types.shape.path :refer [schema:path-content]]
    [app.common.types.shape.shadow :refer [schema:shadow]]
    [app.common.uuid :as uuid]
    [clojure.test :as t]))
@@ -112,17 +112,14 @@
          (= interaction interaction-3)))
      {:num 500})))
 
-
 (t/deftest shape-path-content-json-roundtrip
-  (let [encode (sm/encoder schema:path-content (sm/json-transformer))
+  (let [encode (sm/encoder ::path/content (sm/json-transformer))
-        decode (sm/decoder schema:path-content (sm/json-transformer))]
+        decode (sm/decoder ::path/content (sm/json-transformer))]
     (smt/check!
-     (smt/for [path-content (sg/generator schema:path-content)]
+     (smt/for [path-content (sg/generator ::path/content)]
        (let [path-content-1 (encode path-content)
              path-content-2 (json-roundtrip path-content-1)
              path-content-3 (decode path-content-2)]
-         ;; (app.common.pprint/pprint path-content)
-         ;; (app.common.pprint/pprint path-content-3)
          (= path-content path-content-3)))
      {:num 500})))
 

common/test/common_tests/types/shape_path_data_test.cljc

@@ -1,59 +0,0 @@
-;; 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) KALEIDOS INC
-
-(ns common-tests.types.shape-path-data-test
-  (:require
-   [app.common.data :as d]
-   [app.common.math :as mth]
-   [app.common.pprint :as pp]
-   [app.common.types.shape.path :as path]
-   [clojure.test :as t]))
-
-(def sample-content
-  [{:command :move-to, :params {:x 480.0, :y 839.0}}
-   {:command :line-to, :params {:x 439.0, :y 802.0}}
-   {:command :curve-to, :params {:c1x 368.0, :c1y 737.0, :c2x 310.0, :c2y 681.0, :x 264.0, :y 634.0}}
-   {:command :close-path :params {}}])
-
-(def sample-bytes
-  [0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 67 -16 0 0 68 81 -64 0
-   0 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 67 -37 -128 0 68 72 -128 0
-   0 3 0 0 67 -72 0 0 68 56 64 0 67 -101 0 0 68 42 64 0 67 -124 0 0 68 30 -128 0
-   0 4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0])
-
-;; This means it implements IReduceInit/IReduce protocols
-(t/deftest path-data-to-vector
-  (let [pdata  (path/path-data sample-content)
-        result (vec pdata)]
-    (t/is (= 4 (count result)))
-    (t/is (= (get-in sample-content [0 :command])
-             (get-in result [0 :command])))
-    (t/is (= (get-in sample-content [1 :command])
-             (get-in result [1 :command])))
-    (t/is (= (get-in sample-content [2 :command])
-             (get-in result [2 :command])))
-    (t/is (= (get-in sample-content [3 :command])
-             (get-in result [3 :command])))
-
-    (t/is (= (get-in sample-content [0 :params])
-             (get-in result [0 :params])))
-    (t/is (= (get-in sample-content [1 :params])
-             (get-in result [1 :params])))
-    (t/is (= (get-in sample-content [2 :params])
-             (get-in result [2 :params])))
-    (t/is (= (get-in sample-content [3 :params])
-             (get-in result [3 :params])))))
-
-(t/deftest path-data-plain-to-binary
-  (let [pdata (path/path-data sample-content)]
-    (t/is (= sample-bytes
-             (vec
-              #?(:cljs (js/Int8Array. (.-buffer pdata))
-                 :clj  (.array (.-buffer pdata))))))
-    (t/is (= (->> sample-content
-                  (mapv path/map->PathSegment))
-             (vec pdata)))))
-

frontend/playwright/data/workspace/get-file-copy-paste-fragment.json

@@ -448,55 +448,7 @@
           },
           "~:rotation": 0,
           "~:grow-type": "~:fixed",
-          "~:content": [
+          "~:content": ["~#penpot/path-data","~bAQAAAAAAAAAAAAAAAAAAAAAAAAAAIIxEAIAKRAIAAAAAAAAAAAAAAAAAAAAAAAAAAKCZRAAA5UMDAAAAAKCZRAAA5UMAAKVEAAD2QwDgokQAgAFEAwAAAADAoEQAAAhEAECdRAAAD0QAYJhEAAASRAMAAAAAgJNEAAAVRAAgjEQAgApEACCMRACACkQ="],
-            {
-              "~:command": "~:move-to",
-              "~:params": {
-                "~:x": 1121,
-                "~:y": 554
-              }
-            },
-            {
-              "~:command": "~:line-to",
-              "~:params": {
-                "~:x": 1229,
-                "~:y": 458
-              }
-            },
-            {
-              "~:command": "~:curve-to",
-              "~:params": {
-                "~:x": 1303,
-                "~:y": 518,
-                "~:c1x": 1229,
-                "~:c1y": 458,
-                "~:c2x": 1320,
-                "~:c2y": 492
-              }
-            },
-            {
-              "~:command": "~:curve-to",
-              "~:params": {
-                "~:x": 1219,
-                "~:y": 584,
-                "~:c1x": 1286,
-                "~:c1y": 544,
-                "~:c2x": 1258,
-                "~:c2y": 572
-              }
-            },
-            {
-              "~:command": "~:curve-to",
-              "~:params": {
-                "~:x": 1121,
-                "~:y": 554,
-                "~:c1x": 1180,
-                "~:c1y": 596,
-                "~:c2x": 1121,
-                "~:c2y": 554
-              }
-            }
-          ],
           "~:name": "Path",
           "~:width": null,
           "~:type": "~:path",

frontend/src/app/main/data/helpers.cljs

@@ -11,7 +11,7 @@
    [app.common.files.helpers :as cfh]
    [app.common.geom.point :as gpt]
    [app.common.geom.shapes :as gsh]
-   [app.common.svg.path.command :as upc]))
+   [app.common.types.path :as path]))
 
 (defn lookup-profile
   ([state]
@@ -157,7 +157,7 @@
                                   shape)
                       modifiers (dm/get-in content-modifiers [id :content-modifiers])
                       shape     (if (some? modifiers)
-                                  (update shape :content upc/apply-content-modifiers modifiers)
+                                  (update shape :content path/apply-content-modifiers modifiers)
                                   shape)]
                   (assoc result id shape))
                 result))

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

@@ -975,9 +975,29 @@
     ptk/WatchEvent
     (watch [_ state _]
       (let [selected (dsh/lookup-selected state)
-            objects (dsh/lookup-page-objects state)]
+            objects  (dsh/lookup-page-objects state)]
 
-        (if (> (count selected) 1)
+        (condp = (count selected)
+          0 (rx/empty)
+          1 (let [{:keys [id type] :as shape} (get objects (first selected))]
+              (case type
+                :text
+                (rx/of (dwe/start-edition-mode id))
+
+                (:group :bool :frame)
+                (let [shapes-ids (into (d/ordered-set) (get shape :shapes))]
+                  (rx/of (dws/select-shapes shapes-ids)))
+
+                :svg-raw
+                nil
+
+                (rx/of (dwe/start-edition-mode id)
+                       (dwdp/start-path-edit id))))
+
+          ;; When we have multiple shapes selected, instead of enter
+          ;; on the edition mode, we proceed to select all children of
+          ;; the selected shapes. Because we can't enter on edition
+          ;; mode on multiple shapes and this is a fallback operation.
           (let [shapes-to-select
                 (->> selected
                      (reduce
@@ -987,23 +1007,7 @@
                             (conj result shape-id)
                             (into result children))))
                       (d/ordered-set)))]
-            (rx/of (dws/select-shapes shapes-to-select)))
+            (rx/of (dws/select-shapes shapes-to-select))))))))
-
-          (when (d/not-empty? selected)
-            (let [{:keys [id type shapes]} (get objects (first selected))]
-              (case type
-                :text
-                (rx/of (dwe/start-edition-mode id))
-
-                (:group :bool :frame)
-                (let [shapes-ids (into (d/ordered-set) shapes)]
-                  (rx/of (dws/select-shapes shapes-ids)))
-
-                :svg-raw
-                nil
-
-                (rx/of (dwe/start-edition-mode id)
-                       (dwdp/start-path-edit id))))))))))
 
 (defn select-parent-layer
   []

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

@@ -10,9 +10,10 @@
    [app.common.files.changes-builder :as pcb]
    [app.common.files.helpers :as cph]
    [app.common.geom.shapes :as gsh]
-   [app.common.svg.path.shapes-to-path :as stp]
    [app.common.types.component :as ctc]
    [app.common.types.container :as ctn]
+   [app.common.types.path :as path]
+   [app.common.types.path.bool :as bool]
    [app.common.types.shape :as cts]
    [app.common.types.shape.layout :as ctl]
    [app.common.uuid :as uuid]
@@ -24,130 +25,139 @@
    [cuerdas.core :as str]
    [potok.v2.core :as ptk]))
 
-(defn selected-shapes-idx
+(defn- create-bool-shape
-  [state]
+  [id type name shapes objects]
-  (let [objects (dsh/lookup-page-objects state)]
+  (let [shape-id
-    (->> (dsh/lookup-selected state)
+        (or id (uuid/next))
-         (cph/clean-loops objects))))
 
-(defn create-bool-data
+        shapes
-  [bool-type name shapes objects]
+        (mapv #(path/convert-to-path % objects) shapes)
-  (let [shapes (mapv #(stp/convert-to-path % objects) shapes)
-        head (if (= bool-type :difference) (first shapes) (last shapes))
-        head (cond-> head
-               (and (contains? head :svg-attrs) (empty? (:fills head)))
-               (assoc :fills stp/default-bool-fills))
 
-        head-data (select-keys head stp/style-properties)
+        head
+        (if (= type :difference) (first shapes) (last shapes))
 
-        bool-shape
+        head
-        (-> {:id (uuid/next)
+        (cond-> head
-             :type :bool
+          (and (contains? head :svg-attrs) (empty? (:fills head)))
-             :bool-type bool-type
+          (assoc :fills bool/default-fills))
-             :frame-id (:frame-id head)
+
-             :parent-id (:parent-id head)
+        shape
-             :name name
+        {:id shape-id
-             :shapes (->> shapes (mapv :id))}
+         :type :bool
-            (merge head-data)
+         :bool-type type
+         :frame-id (:frame-id head)
+         :parent-id (:parent-id head)
+         :name name
+         :shapes (mapv :id shapes)}
+
+        shape
+        (-> shape
+            (merge (select-keys head bool/style-properties))
             (cts/setup-shape)
-            (gsh/update-bool-selrect shapes objects))]
+            (gsh/update-bool shapes objects))]
 
-    [bool-shape (cph/get-position-on-parent objects (:id head))]))
+    [shape (cph/get-position-on-parent objects (:id head))]))
+
+(defn create-bool
+  [type & {:keys [ids force-shape-id]}]
+
+  (assert (or (nil? ids) (every? uuid? ids)))
+
+  (ptk/reify ::create-bool-union
+    ptk/WatchEvent
+    (watch [it state _]
+      (let [page-id (:current-page-id state)
+            objects (dsh/lookup-page-objects state page-id)
+
+            name
+            (-> type d/name str/capital)
+
+            ids
+            (->> (or ids (dsh/lookup-selected state))
+                 (cph/clean-loops objects))
+
+            xform
+            (comp
+             (map (d/getf objects))
+             (remove cph/frame-shape?)
+             (remove ctc/is-variant?)
+             (remove #(ctn/has-any-copy-parent? objects %)))
+
+            shapes
+            (->> (cph/order-by-indexed-shapes objects ids)
+                 (into [] xform)
+                 (not-empty))]
+
+        (when shapes
+          (let [[shape index]
+                (create-bool-shape force-shape-id type name (reverse shapes) objects)
+
+                shape-id
+                (get shape :id)
+
+                changes
+                (-> (pcb/empty-changes it page-id)
+                    (pcb/with-objects objects)
+                    (pcb/add-object shape {:index (inc index)})
+                    (pcb/update-shapes (map :id shapes) ctl/remove-layout-item-data)
+                    (pcb/change-parent shape-id shapes))]
+
+            (rx/of (dch/commit-changes changes)
+                   (dws/select-shapes (d/ordered-set shape-id)))))))))
 
 (defn group->bool
-  [group bool-type objects]
+  [type group objects]
-
   (let [shapes (->> (:shapes group)
                     (map #(get objects %))
-                    (mapv #(stp/convert-to-path % objects)))
+                    (mapv #(path/convert-to-path % objects)))
-        head (if (= bool-type :difference) (first shapes) (last shapes))
+        head (if (= type :difference) (first shapes) (last shapes))
         head (cond-> head
                (and (contains? head :svg-attrs) (empty? (:fills head)))
-               (assoc :fills stp/default-bool-fills))
+               (assoc :fills bool/default-fills))
-        head-data (select-keys head stp/style-properties)]
+        head-data (select-keys head bool/style-properties)]
 
     (-> group
         (assoc :type :bool)
-        (assoc :bool-type bool-type)
+        (assoc :bool-type type)
         (merge head-data)
-        (gsh/update-bool-selrect shapes objects))))
+        (gsh/update-bool shapes objects))))
-
-(defn bool->group
-  [shape objects]
-
-  (let [children (->> (:shapes shape)
-                      (mapv #(get objects %)))]
-    (-> shape
-        (assoc :type :group)
-        (dissoc :bool-type)
-        (d/without-keys stp/style-group-properties)
-        (gsh/update-group-selrect children))))
-
-(defn create-bool
-  ([bool-type]
-   (create-bool bool-type nil nil))
-  ([bool-type ids {:keys [id-ret]}]
-   (assert (or (nil? ids) (set? ids)))
-   (ptk/reify ::create-bool-union
-     ptk/WatchEvent
-     (watch [it state _]
-       (let [page-id (:current-page-id state)
-             objects (dsh/lookup-page-objects state)
-             name (-> bool-type d/name str/capital)
-             ids  (->> (or ids (dsh/lookup-selected state))
-                       (cph/clean-loops objects))
-             ordered-indexes (cph/order-by-indexed-shapes objects ids)
-             shapes (->> ordered-indexes
-                         (map (d/getf objects))
-                         (remove cph/frame-shape?)
-                         (remove ctc/is-variant?)
-                         (remove #(ctn/has-any-copy-parent? objects %)))]
-
-         (when-not (empty? shapes)
-           (let [[boolean-data index] (create-bool-data bool-type name (reverse shapes) objects)
-                 index (inc index)
-                 shape-id (:id boolean-data)
-                 changes (-> (pcb/empty-changes it page-id)
-                             (pcb/with-objects objects)
-                             (pcb/add-object boolean-data {:index index})
-                             (pcb/update-shapes (map :id shapes) ctl/remove-layout-item-data)
-                             (pcb/change-parent shape-id shapes))]
-             (when id-ret
-               (reset! id-ret shape-id))
-
-             (rx/of (dch/commit-changes changes)
-                    (dws/select-shapes (d/ordered-set shape-id))))))))))
 
 (defn group-to-bool
-  [shape-id bool-type]
+  [shape-id type]
   (ptk/reify ::group-to-bool
     ptk/WatchEvent
     (watch [_ state _]
-      (let [objects (dsh/lookup-page-objects state)
+      (let [objects   (dsh/lookup-page-objects state)
-            change-to-bool
+            update-fn (partial group->bool type)]
-            (fn [shape] (group->bool shape bool-type objects))]
         (when-not (ctn/has-any-copy-parent? objects (get objects shape-id))
-          (rx/of (dwsh/update-shapes [shape-id] change-to-bool {:reg-objects? true})))))))
+          (rx/of (dwsh/update-shapes [shape-id] update-fn {:with-objects? true :reg-objects? true})))))))
+
+(defn- bool->group
+  [shape objects]
+  (-> shape
+      (assoc :type :group)
+      (dissoc :bool-type)
+      (d/without-keys bool/style-group-properties)
+      (gsh/update-group-selrect
+       (mapv (d/getf objects)
+             (:shapes shape)))))
 
 (defn bool-to-group
   [shape-id]
   (ptk/reify ::bool-to-group
     ptk/WatchEvent
     (watch [_ state _]
-      (let [objects (dsh/lookup-page-objects state)
+      (let [objects (dsh/lookup-page-objects state)]
-            change-to-group
-            (fn [shape] (bool->group shape objects))]
         (when-not (ctn/has-any-copy-parent? objects (get objects shape-id))
-          (rx/of (dwsh/update-shapes [shape-id] change-to-group {:reg-objects? true})))))))
+          (rx/of (dwsh/update-shapes [shape-id] bool->group {:with-objects? true :reg-objects? true})))))))
-
 
 (defn change-bool-type
-  [shape-id bool-type]
+  [shape-id type]
   (ptk/reify ::change-bool-type
     ptk/WatchEvent
     (watch [_ state _]
       (let [objects (dsh/lookup-page-objects state)
             change-type
-            (fn [shape] (assoc shape :bool-type bool-type))]
+            (fn [shape] (assoc shape :bool-type type))]
         (when-not (ctn/has-any-copy-parent? objects (get objects shape-id))
           (rx/of (dwsh/update-shapes [shape-id] change-type {:reg-objects? true})))))))

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

@@ -11,6 +11,7 @@
    [app.common.geom.shapes :as gsh]
    [app.common.math :as mth]
    [app.common.types.modifiers :as ctm]
+   [app.common.types.path :as path]
    [app.common.types.shape :as cts]
    [app.main.data.helpers :as dsh]
    [app.main.data.workspace.shapes :as dwsh]
@@ -65,6 +66,10 @@
                    (-> (assoc :height 17 :width 4 :grow-type :auto-width)
                        (cts/setup-shape))
 
+                   (or (cfh/path-shape? shape)
+                       (cfh/bool-shape? shape))
+                   (update :content path/content)
+
                    :always
                    (dissoc :initialized? :click-draw?))]
 

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

@@ -7,13 +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 :as gsh]
    [app.common.geom.shapes.flex-layout :as gslf]
    [app.common.geom.shapes.grid-layout :as gslg]
-   [app.common.geom.shapes.path :as gsp]
    [app.common.types.container :as ctn]
+   [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]
@@ -26,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]
@@ -35,43 +63,16 @@
     (update [_ state]
       (update-in state [:workspace-drawing :object]
                  (fn [object]
-                   (let [segments (-> (:segments object)
+                   (let [points  (-> (::points object)
-                                      (conj point))
+                                     (conj point))
-                         content  (gsp/segments->content segments)
+                         content (path.segment/points->content points)
-                         selrect  (gsh/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
   []
@@ -79,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  (gsp/segments->content segments)
+                         content  (path.segment/points->content points)
-                         selrect  (gsh/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)
@@ -105,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

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

@@ -6,7 +6,6 @@
 
 (ns app.main.data.workspace.edition
   (:require
-   [app.common.data.macros :as dm]
    [app.main.data.helpers :as dsh]
    [app.main.data.workspace.path.common :as dwpc]
    [beicon.v2.core :as rx]
@@ -17,8 +16,10 @@
 (declare clear-edition-mode)
 
 (defn start-edition-mode
+  "Mark a shape in edition mode"
   [id]
-  (dm/assert! (uuid? id))
+  (assert (uuid? id) "expected valid uuid for `id`")
+
   (ptk/reify ::start-edition-mode
     ptk/UpdateEvent
     (update [_ state]
@@ -26,8 +27,7 @@
         ;; Can only edit objects that exist
         (if (contains? objects id)
           (-> state
-              (assoc-in [:workspace-local :selected] #{id})
+              (update :workspace-local assoc :edition id)
-              (assoc-in [:workspace-local :edition] id)
               (dissoc :workspace-grid-edition))
           state)))
 

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

@@ -18,6 +18,7 @@
    [app.common.types.component :as ctk]
    [app.common.types.container :as ctn]
    [app.common.types.modifiers :as ctm]
+   [app.common.types.path :as path]
    [app.common.types.shape-tree :as ctst]
    [app.common.types.shape.attrs :refer [editable-attrs]]
    [app.common.types.shape.layout :as ctl]
@@ -705,6 +706,9 @@
                     (gsh/transform-shape modifiers)
                     (cond-> (d/not-empty? pos-data)
                       (assoc-position-data pos-data shape))
+                    (cond-> (or (cfh/path-shape? shape)
+                                (cfh/bool-shape? shape))
+                      (update :content path/content))
                     (cond-> text-shape?
                       (update-grow-type shape)))))]
 

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

@@ -6,12 +6,10 @@
 
 (ns app.main.data.workspace.path.changes
   (:require
-   [app.common.data.macros :as dm]
    [app.common.files.changes-builder :as pcb]
+   [app.common.types.path :as path]
    [app.main.data.changes :as dch]
    [app.main.data.helpers :as dsh]
-   [app.main.data.workspace.path.common :refer [check-path-content!]]
-   [app.main.data.workspace.path.helpers :as helpers]
    [app.main.data.workspace.path.state :as st]
    [beicon.v2.core :as rx]
    [potok.v2.core :as ptk]))
@@ -20,31 +18,25 @@
   "Generates changes to update the new content of the shape"
   [it objects page-id shape old-content new-content]
 
-  (dm/assert!
+  (assert (path/check-path-content old-content))
-   "expected valid path content"
+  (assert (path/check-path-content new-content))
-   (and (check-path-content! old-content)
-        (check-path-content! new-content)))
 
   (let [shape-id (:id shape)
 
-        [old-points old-selrect]
-        (helpers/content->points+selrect shape old-content)
-
-        [new-points new-selrect]
-        (helpers/content->points+selrect shape new-content)
-
         ;; We set the old values so the update-shapes works
         objects
-        (-> objects
+        (update objects shape-id
-            (update
+                (fn [shape]
-             shape-id
+                  (-> shape
-             assoc
+                      (assoc :content old-content)
-             :content old-content
+                      (path/update-geometry))))
-             :selrect old-selrect
-             :points old-points))
 
-        changes (-> (pcb/empty-changes it page-id)
+        changes
-                    (pcb/with-objects objects))]
+        (-> (pcb/empty-changes it page-id)
+            (pcb/with-objects objects))
+
+        new-content
+        (path/content new-content)]
 
     (cond
       ;; https://tree.taiga.io/project/penpot/issue/2366
@@ -60,10 +52,9 @@
       (-> changes
           (pcb/update-shapes [shape-id]
                              (fn [shape]
-                               (assoc shape
+                               (-> shape
-                                      :content new-content
+                                   (assoc :content new-content)
-                                      :selrect new-selrect
+                                   (path/update-geometry))))
-                                      :points new-points)))
           (pcb/resize-parents [shape-id])))))
 
 (defn save-path-content
@@ -88,6 +79,7 @@
              id          (get-in state [:workspace-local :edition])
              old-content (get-in state [:workspace-local :edit-path id :old-content])
              shape       (st/get-path state)]
+
          (if (and (some? old-content) (some? (:id shape)))
            (let [changes (generate-path-changes it objects page-id shape old-content (:content shape))]
              (rx/of (dch/commit-changes changes)))

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

@@ -6,44 +6,10 @@
 
 (ns app.main.data.workspace.path.common
   (:require
-   [app.common.schema :as sm]
+   [app.common.types.path :as path]
-   [app.common.svg.path.subpath :as ups]
    [app.main.data.workspace.path.state :as st]
    [potok.v2.core :as ptk]))
 
-(def valid-commands
-  #{:move-to
-    :line-to
-    :line-to-horizontal
-    :line-to-vertical
-    :curve-to
-    :smooth-curve-to
-    :quadratic-bezier-curve-to
-    :smooth-quadratic-bezier-curve-to
-    :elliptical-arc
-    :close-path})
-
-;; FIXME: should this schema be defined on common.types ?
-
-(def ^:private
-  schema:path-content
-  [:vector {:title "PathContent"}
-   [:map {:title "PathContentEntry"}
-    [:command [::sm/one-of valid-commands]]
-    ;; FIXME: remove the `?` from prop name
-    [:relative? {:optional true} :boolean]
-    [:params {:optional true}
-     [:map {:title "PathContentEntryParams"}
-      [:x :double]
-      [:y :double]
-      [:c1x {:optional true} :double]
-      [:c1y {:optional true} :double]
-      [:c2x {:optional true} :double]
-      [:c2y {:optional true} :double]]]]])
-
-(def check-path-content!
-  (sm/check-fn schema:path-content))
-
 (defn init-path []
   (ptk/reify ::init-path))
 
@@ -59,4 +25,4 @@
       (let [id (st/get-path-id state)]
         (-> state
             (update-in [:workspace-local :edit-path id] clean-edit-state)
-            (update-in (st/get-path-location state :content) ups/close-subpaths))))))
+            (update-in (st/get-path-location state :content) path/close-subpaths))))))

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

@@ -9,9 +9,10 @@
    [app.common.data.macros :as dm]
    [app.common.geom.point :as gpt]
    [app.common.geom.shapes.flex-layout :as gsl]
-   [app.common.svg.path.command :as upc]
-   [app.common.svg.path.shapes-to-path :as upsp]
    [app.common.types.container :as ctn]
+   [app.common.types.path :as path]
+   [app.common.types.path.helpers :as path.helpers]
+   [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]
@@ -19,7 +20,7 @@
    [app.main.data.workspace.drawing.common :as dwdc]
    [app.main.data.workspace.edition :as dwe]
    [app.main.data.workspace.path.changes :as changes]
-   [app.main.data.workspace.path.common :as common :refer [check-path-content!]]
+   [app.main.data.workspace.path.common :as common]
    [app.main.data.workspace.path.helpers :as helpers]
    [app.main.data.workspace.path.state :as st]
    [app.main.data.workspace.path.streams :as streams]
@@ -39,10 +40,10 @@
             fix-angle? shift?
             last-point (get-in state [:workspace-local :edit-path id :last-point])
             position (cond-> (gpt/point x y)
-                       fix-angle? (helpers/position-fixed-angle last-point))
+                       fix-angle? (path.helpers/position-fixed-angle last-point))
             shape (st/get-path state)
             {:keys [last-point prev-handler]} (get-in state [:workspace-local :edit-path id])
-            command (helpers/next-node shape position last-point prev-handler)]
+            command (path.segment/next-node shape position last-point prev-handler)]
         (assoc-in state [:workspace-local :edit-path id :preview] command)))))
 
 (defn add-node
@@ -54,7 +55,7 @@
             fix-angle? shift?
             {:keys [last-point prev-handler]} (get-in state [:workspace-local :edit-path id])
             position (cond-> (gpt/point x y)
-                       fix-angle? (helpers/position-fixed-angle last-point))]
+                       fix-angle? (path.helpers/position-fixed-angle last-point))]
         (if-not (= last-point position)
           (-> state
               (assoc-in  [:workspace-local :edit-path id :last-point] position)
@@ -75,12 +76,12 @@
 
              index (or index (count content))
              prefix (or prefix :c1)
-             position (or position (upc/command->point (nth content (dec index))))
+             position (or position (path.helpers/segment->point (nth content (dec index))))
 
-             old-handler (upc/handler->point content index prefix)
+             old-handler (path.segment/get-handler-point content index prefix)
 
              handler-position (cond-> (gpt/point x y)
-                                shift? (helpers/position-fixed-angle position))
+                                shift? (path.helpers/position-fixed-angle position))
 
              {dx :x dy :y} (if (some? old-handler)
                              (gpt/add (gpt/to-vec old-handler position)
@@ -102,7 +103,7 @@
 
             modifiers (get-in state [:workspace-local :edit-path id :content-modifiers])
             content (-> (st/get-path state :content)
-                        (upc/apply-content-modifiers modifiers))
+                        (path/apply-content-modifiers modifiers))
 
             handler (get-in state [:workspace-local :edit-path id :drag-handler])]
         (-> state
@@ -110,7 +111,7 @@
             (update-in [:workspace-local :edit-path id] dissoc :drag-handler)
             (update-in [:workspace-local :edit-path id] dissoc :content-modifiers)
             (assoc-in  [:workspace-local :edit-path id :prev-handler] handler)
-            (update-in (st/get-path-location state) helpers/update-selrect))))
+            (update-in (st/get-path-location state) path/update-geometry))))
 
     ptk/WatchEvent
     (watch [_ state _]
@@ -128,7 +129,7 @@
     ptk/WatchEvent
     (watch [_ state stream]
       (let [content  (st/get-path state :content)
-            handlers (-> (upc/content->handlers content)
+            handlers (-> (path.segment/get-handlers content)
                          (get position))
 
             [idx prefix] (when (= (count handlers) 1)
@@ -254,7 +255,12 @@
     (update [_ state]
       (let [objects      (dsh/lookup-page-objects state)
             content      (get-in state [:workspace-drawing :object :content] [])
-            position     (gpt/point (get-in content [0 :params] nil))
+
+            ;; FIXME: use native operation for retrieve the first position
+            position     (-> (nth content 0)
+                             (get :params)
+                             (gpt/point))
+
             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)
@@ -274,11 +280,10 @@
   (ptk/reify ::handle-new-shape-result
     ptk/UpdateEvent
     (update [_ state]
-      (let [content (get-in state [:workspace-drawing :object :content] [])]
+      (let [content (dm/get-in state [:workspace-drawing :object :content])]
 
-        (dm/assert!
+        (assert (path/check-path-content content)
-         "expected valid path content"
+                "expected valid path content instance")
-         (check-path-content! content))
 
         (if (> (count content) 1)
           (assoc-in state [:workspace-drawing :object :initialized?] true)
@@ -286,8 +291,8 @@
 
     ptk/WatchEvent
     (watch [_ state _]
-      (let [content (get-in state [:workspace-drawing :object :content] [])]
+      (when-let [content (dm/get-in state [:workspace-drawing :object :content])]
-        (if (and (seq content) (> (count content) 1))
+        (if (> (count content) 1)
           (rx/of (setup-frame)
                  (dwdc/handle-finish-drawing)
                  (dwe/start-edition-mode shape-id)
@@ -300,9 +305,8 @@
   (ptk/reify ::handle-new-shape
     ptk/UpdateEvent
     (update [_ state]
-      (let [shape (cts/setup-shape {:type :path})]
+      (let [shape (cts/setup-shape {:type :path :content (path/content nil)})]
-        (-> state
+        (update state :workspace-drawing assoc :object shape)))
-            (update :workspace-drawing assoc :object shape))))
 
     ptk/WatchEvent
     (watch [_ state stream]
@@ -334,12 +338,12 @@
             edit-mode (get-in state [:workspace-local :edit-path id :edit-mode])]
         (if (= :draw edit-mode)
           (rx/concat
-           (rx/of (dwsh/update-shapes [id] upsp/convert-to-path))
+           (rx/of (dwsh/update-shapes [id] path/convert-to-path))
            (rx/of (handle-drawing id))
            (->> stream
                 (rx/filter (ptk/type? ::common/finish-path))
                 (rx/take 1)
-                (rx/merge-map #(rx/of (check-changed-content)))))
+                (rx/map check-changed-content)))
           (rx/empty))))))
 
 (defn check-changed-content []

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

@@ -10,15 +10,13 @@
    [app.common.data.macros :as dm]
    [app.common.files.helpers :as cfh]
    [app.common.geom.point :as gpt]
-   [app.common.geom.shapes.path :as upg]
+   [app.common.types.path :as path]
-   [app.common.svg.path.command :as upc]
+   [app.common.types.path.helpers :as path.helpers]
-   [app.common.svg.path.shapes-to-path :as upsp]
+   [app.common.types.path.segment :as path.segment]
-   [app.common.svg.path.subpath :as ups]
    [app.main.data.changes :as dch]
    [app.main.data.helpers :as dsh]
    [app.main.data.workspace.edition :as dwe]
    [app.main.data.workspace.path.changes :as changes]
-   [app.main.data.workspace.path.drawing :as drawing]
    [app.main.data.workspace.path.helpers :as helpers]
    [app.main.data.workspace.path.selection :as selection]
    [app.main.data.workspace.path.state :as st]
@@ -27,7 +25,6 @@
    [app.main.data.workspace.shapes :as dwsh]
    [app.main.streams :as ms]
    [app.util.mouse :as mse]
-   [app.util.path.tools :as upt]
    [beicon.v2.core :as rx]
    [potok.v2.core :as ptk]))
 
@@ -50,18 +47,22 @@
   (ptk/reify ::apply-content-modifiers
     ptk/WatchEvent
     (watch [it state _]
-      (let [objects (dsh/lookup-page-objects state)
+      (let [page-id (get state :current-page-id state)
+            objects (dsh/lookup-page-objects state)
 
             id (st/get-path-id state)
-            page-id (:current-page-id state)
-            shape (st/get-path state)
-            content-modifiers (dm/get-in state [:workspace-local :edit-path id :content-modifiers])
 
-            content (:content shape)
+            shape
-            new-content (upc/apply-content-modifiers content content-modifiers)
+            (st/get-path state)
 
-            old-points (->> content upg/content->points)
+            content-modifiers
-            new-points (->> new-content upg/content->points)
+            (dm/get-in state [:workspace-local :edit-path id :content-modifiers])
+
+            content      (get shape :content)
+            new-content  (path/apply-content-modifiers content content-modifiers)
+
+            old-points   (path.segment/get-points content)
+            new-points   (path.segment/get-points new-content)
             point-change (->> (map hash-map old-points new-points) (reduce merge))]
 
         (when (and (some? new-content) (some? shape))
@@ -75,8 +76,8 @@
 
 (defn modify-content-point
   [content {dx :x dy :y} modifiers point]
-  (let [point-indices (upc/point-indices content point) ;; [indices]
+  (let [point-indices (path.segment/point-indices content point) ;; [indices]
-        handler-indices (upc/handler-indices content point) ;; [[index prefix]]
+        handler-indices (path.segment/handler-indices content point) ;; [[index prefix]]
 
         modify-point
         (fn [modifiers index]
@@ -116,7 +117,7 @@
       (let [id (st/get-path-id state)
             content (st/get-path state :content)
             to-point (cond-> to-point
-                       (:shift? to-point) (helpers/position-fixed-angle from-point))
+                       (:shift? to-point) (path.helpers/position-fixed-angle from-point))
 
             delta (gpt/subtract to-point from-point)
 
@@ -144,7 +145,7 @@
             selected? (contains? selected-points position)]
         (streams/drag-stream
          (rx/of
-          (dwsh/update-shapes [id] upsp/convert-to-path)
+          (dwsh/update-shapes [id] path/convert-to-path)
           (when-not selected? (selection/select-node position shift?))
           (drag-selected-points @ms/mouse-position))
          (rx/of (selection/select-node position shift?)))))))
@@ -163,7 +164,7 @@
             start-position (apply min-key #(gpt/distance start-position %) selected-points)
 
             content (st/get-path state :content)
-            points (upg/content->points content)]
+            points  (path.segment/get-points content)]
 
         (rx/concat
          ;; This stream checks the consecutive mouse positions to do the dragging
@@ -228,7 +229,7 @@
                   mov-vec (gpt/multiply (get-displacement direction) scale)]
 
               (rx/concat
-               (rx/of (dwsh/update-shapes [id] upsp/convert-to-path))
+               (rx/of (dwsh/update-shapes [id] path/convert-to-path))
                (rx/merge
                 (->> move-events
                      (rx/take-until stopper)
@@ -256,22 +257,22 @@
             start-delta-y (dm/get-in modifiers [index cy] 0)
 
             content (st/get-path state :content)
-            points (upg/content->points content)
+            points  (path.segment/get-points content)
 
-            point (-> content (get (if (= prefix :c1) (dec index) index)) (upc/command->point))
+            point (-> content (nth (if (= prefix :c1) (dec index) index)) (path.helpers/segment->point))
-            handler (-> content (get index) (upc/get-handler prefix))
+            handler (-> content (nth index) (path.segment/get-handler prefix))
 
-            [op-idx op-prefix] (upc/opposite-index content index prefix)
+            [op-idx op-prefix] (path.segment/opposite-index content index prefix)
-            opposite (upc/handler->point content op-idx op-prefix)]
+            opposite (path.segment/get-handler-point content op-idx op-prefix)]
 
         (streams/drag-stream
          (rx/concat
-          (rx/of (dwsh/update-shapes [id] upsp/convert-to-path))
+          (rx/of (dwsh/update-shapes [id] path/convert-to-path))
           (->> (streams/move-handler-stream handler point handler opposite points)
                (rx/map
                 (fn [{:keys [x y alt? shift?]}]
                   (let [pos (cond-> (gpt/point x y)
-                              shift? (helpers/position-fixed-angle point))]
+                              shift? (path.helpers/position-fixed-angle point))]
                     (modify-handler
                      id
                      index
@@ -294,33 +295,34 @@
   (ptk/reify ::start-path-edit
     ptk/UpdateEvent
     (update [_ state]
-      (let [objects (dsh/lookup-page-objects state)
+      (let [objects   (dsh/lookup-page-objects state)
             edit-path (dm/get-in state [:workspace-local :edit-path id])
-            content (st/get-path state :content)
+            content   (st/get-path state :content)
-            state (cond-> state
+            state     (cond-> state
-                    (cfh/path-shape? objects id)
+                        (cfh/path-shape? objects id)
-                    (st/set-content (ups/close-subpaths content)))]
+                        (st/set-content (path/close-subpaths content)))]
+
         (cond-> state
-          (or (not edit-path) (= :draw (:edit-mode edit-path)))
+          (or (not edit-path)
+              (= :draw (:edit-mode edit-path)))
           (assoc-in [:workspace-local :edit-path id] {:edit-mode :move
                                                       :selected #{}
                                                       :snap-toggled false})
-
+          (and (some? edit-path)
-          (and (some? edit-path) (= :move (:edit-mode edit-path)))
+               (= :move (:edit-mode edit-path)))
           (assoc-in [:workspace-local :edit-path id :edit-mode] :draw))))
 
     ptk/WatchEvent
-    (watch [_ state stream]
+    (watch [_ _ stream]
-      (let [mode (dm/get-in state [:workspace-local :edit-path id :edit-mode])
+      (let [stopper (->> stream
-            stopper (->> stream
+                         (rx/filter #(let [type (ptk/type %)]
-                         (rx/filter #(or
+                                       (= type ::dwe/clear-edition-mode)
-                                      (= (ptk/type %) ::dwe/clear-edition-mode)
+                                       (= type ::start-path-edit))))]
-                                      (= (ptk/type %) ::start-path-edit))))
-            interrupt (->> stream (rx/filter #(= % :interrupt)) (rx/take 1))]
         (rx/concat
-         (rx/of (undo/start-path-undo)
+         (rx/of (undo/start-path-undo))
-                (drawing/change-edit-mode mode))
+         (->> stream
-         (->> interrupt
+              (rx/filter #(= % :interrupt))
+              (rx/take 1)
               (rx/map #(stop-path-edit id))
               (rx/take-until stopper)))))))
 
@@ -343,7 +345,9 @@
             content (st/get-path state :content)]
         (-> state
             (assoc-in [:workspace-local :edit-path id :old-content] content)
-            (st/set-content (-> content (upt/split-segments #{from-p to-p} t))))))
+            (st/set-content (-> content
+                                (path.segment/split-segments #{from-p to-p} t)
+                                (path/content))))))
 
     ptk/WatchEvent
     (watch [_ _ _]
@@ -355,5 +359,5 @@
     ptk/WatchEvent
     (watch [_ state _]
       (let [id (st/get-path-id state)]
-        (rx/of (dwsh/update-shapes [id] upsp/convert-to-path)
+        (rx/of (dwsh/update-shapes [id] path/convert-to-path)
                (split-segments event))))))

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

@@ -6,12 +6,11 @@
 
 (ns app.main.data.workspace.path.helpers
   (:require
-   [app.common.geom.matrix :as gmt]
    [app.common.geom.point :as gpt]
-   [app.common.geom.rect :as grc]
-   [app.common.geom.shapes :as gsh]
    [app.common.math :as mth]
-   [app.common.svg.path.command :as upc]
+   [app.common.types.path :as path]
+   [app.common.types.path.helpers :as path.helpers]
+   [app.common.types.path.segment :as path.segment]
    [app.main.data.workspace.path.common :as common]
    [app.util.mouse :as mse]
    [potok.v2.core :as ptk]))
@@ -28,96 +27,13 @@
         (and ^boolean (mse/mouse-event? event)
              ^boolean (mse/mouse-double-click-event? event)))))
 
-(defn content-center
-  [content]
-  (-> content
-      gsh/content->selrect
-      grc/rect->center))
-
-(defn content->points+selrect
-  "Given the content of a shape, calculate its points and selrect"
-  [shape content]
-  (let [{:keys [flip-x flip-y]} shape
-        transform
-        (cond-> (:transform shape (gmt/matrix))
-          flip-x (gmt/scale (gpt/point -1 1))
-          flip-y (gmt/scale (gpt/point 1 -1)))
-
-        transform-inverse
-        (cond-> (gmt/matrix)
-          flip-x (gmt/scale (gpt/point -1 1))
-          flip-y (gmt/scale (gpt/point 1 -1))
-          :always (gmt/multiply (:transform-inverse shape (gmt/matrix))))
-
-        center (or (gsh/shape->center shape)
-                   (content-center content))
-
-        base-content (gsh/transform-content
-                      content
-                      (gmt/transform-in center transform-inverse))
-
-        ;; Calculates the new selrect with points given the old center
-        points (-> (gsh/content->selrect base-content)
-                   (grc/rect->points)
-                   (gsh/transform-points center transform))
-
-        points-center (gsh/points->center points)
-
-        ;; Points is now the selrect but the center is different so we can create the selrect
-        ;; through points
-        selrect (-> points
-                    (gsh/transform-points points-center transform-inverse)
-                    (grc/points->rect))]
-    [points selrect]))
-
-(defn update-selrect
-  "Updates the selrect and points for a path"
-  [shape]
-  (let [[points selrect] (content->points+selrect shape (:content shape))]
-    (assoc shape :points points :selrect selrect)))
-
-(defn closest-angle
-  [angle]
-  (cond
-    (or  (> angle 337.5)  (<= angle 22.5))  0
-    (and (> angle 22.5)   (<= angle 67.5))  45
-    (and (> angle 67.5)   (<= angle 112.5)) 90
-    (and (> angle 112.5)	(<= angle 157.5)) 135
-    (and (> angle 157.5)	(<= angle 202.5)) 180
-    (and (> angle 202.5)	(<= angle 247.5)) 225
-    (and (> angle 247.5)	(<= angle 292.5)) 270
-    (and (> angle 292.5)	(<= angle 337.5)) 315))
-
-(defn position-fixed-angle [point from-point]
-  (if (and from-point point)
-    (let [angle (mod (+ 360 (- (gpt/angle point from-point))) 360)
-          to-angle (closest-angle angle)
-          distance (gpt/distance point from-point)]
-      (gpt/angle->point from-point (mth/radians to-angle) distance))
-    point))
-
-(defn next-node
-  "Calculates the next-node to be inserted."
-  [shape position prev-point prev-handler]
-  (let [position (select-keys position [:x :y])
-        last-command (-> shape :content last :command)
-        add-line?   (and prev-point (not prev-handler) (not= last-command :close-path))
-        add-curve?  (and prev-point prev-handler (not= last-command :close-path))]
-    (cond
-      add-line?   {:command :line-to
-                   :params position}
-      add-curve?  {:command :curve-to
-                   :params (upc/make-curve-params position prev-handler)}
-      :else       {:command :move-to
-                   :params position})))
-
 (defn append-node
   "Creates a new node in the path. Usually used when drawing."
   [shape position prev-point prev-handler]
-  (let [command (next-node shape position prev-point prev-handler)]
+  (let [segment (path.segment/next-node (:content shape) position prev-point prev-handler)]
     (-> shape
-        (update :content (fnil conj []) command)
+        (update :content path.segment/append-segment segment)
-        (update-selrect))))
+        (path/update-geometry))))
 
 (defn angle-points [common p1 p2]
   (mth/abs
@@ -125,7 +41,7 @@
     (gpt/to-vec common p1)
     (gpt/to-vec common p2))))
 
-(defn calculate-opposite-delta [node handler opposite match-angle? match-distance? dx dy]
+(defn- calculate-opposite-delta [node handler opposite match-angle? match-distance? dx dy]
   (when (and (some? handler) (some? opposite))
     (let [;; To match the angle, the angle should be matching (angle between points 180deg)
           angle-handlers (angle-points node handler opposite)
@@ -159,14 +75,14 @@
 (defn move-handler-modifiers
   [content index prefix match-distance? match-angle? dx dy]
 
-  (let [[cx cy] (upc/prefix->coords prefix)
+  (let [[cx cy] (path.helpers/prefix->coords prefix)
-        [op-idx op-prefix] (upc/opposite-index content index prefix)
+        [op-idx op-prefix] (path.segment/opposite-index content index prefix)
 
-        node (upc/handler->node content index prefix)
+        node (path.segment/handler->node content index prefix)
-        handler (upc/handler->point content index prefix)
+        handler (path.segment/get-handler-point content index prefix)
-        opposite (upc/handler->point content op-idx op-prefix)
+        opposite (path.segment/get-handler-point content op-idx op-prefix)
 
-        [ocx ocy] (upc/prefix->coords op-prefix)
+        [ocx ocy] (path.helpers/prefix->coords op-prefix)
         [odx ody] (calculate-opposite-delta node handler opposite match-angle? match-distance? dx dy)
 
         hnv (if (some? handler)

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

@@ -8,8 +8,8 @@
   (:require
    [app.common.files.changes-builder :as pcb]
    [app.common.files.helpers :as cph]
-   [app.common.svg.path.shapes-to-path :as upsp]
    [app.common.types.container :as ctn]
+   [app.common.types.path :as path]
    [app.main.data.changes :as dch]
    [app.main.data.helpers :as dsh]
    [beicon.v2.core :as rx]
@@ -35,7 +35,8 @@
              changes
              (-> (pcb/empty-changes it page-id)
                  (pcb/with-objects objects)
-                 (pcb/update-shapes selected #(upsp/convert-to-path % objects))
+                 ;; FIXME: use with-objects? true
+                 (pcb/update-shapes selected #(path/convert-to-path % objects))
                  (pcb/remove-objects children-ids))]
 
          (rx/of (dch/commit-changes changes)))))))

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

@@ -8,7 +8,7 @@
   (:require
    [app.common.data.macros :as dm]
    [app.common.files.helpers :as cph]
-   [app.common.svg.path.shapes-to-path :as upsp]))
+   [app.common.types.path.shape-to-path :as stp]))
 
 (defn path-editing?
   "Returns true if we're editing a path or creating a new one."
@@ -63,8 +63,7 @@
   [state & ks]
   (let [path-loc (get-path-location state)
         shape    (-> (get-in state path-loc)
-                     ;; Empty map because we know the current shape will not have children
+                     (stp/convert-to-path {}))]
-                     (upsp/convert-to-path {}))]
     (if (empty? ks)
       shape
       (get-in shape ks))))

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

@@ -8,7 +8,7 @@
   (:require
    [app.common.data.macros :as dm]
    [app.common.geom.point :as gpt]
-   [app.common.geom.shapes.path :as upg]
+   [app.common.types.path.segment :as path.segm]
    [app.main.constants :refer [zoom-half-pixel-precision]]
    [app.main.data.workspace.path.state :as pst]
    [app.main.snap :as snap]
@@ -170,7 +170,8 @@
 
         ranges-stream
         (->> content-stream
-             (rx/map upg/content->points)
+             (rx/filter some?)
+             (rx/map path.segm/get-points)
              (rx/map snap/create-ranges))]
 
     (->> ms/mouse-position

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

@@ -6,15 +6,16 @@
 
 (ns app.main.data.workspace.path.tools
   (:require
-   [app.common.svg.path.shapes-to-path :as upsp]
+   [app.common.data.macros :as dm]
-   [app.common.svg.path.subpath :as ups]
+   [app.common.files.helpers :as cfh]
+   [app.common.types.path :as path]
+   [app.common.types.path.segment :as path.segment]
    [app.main.data.changes :as dch]
    [app.main.data.helpers :as dsh]
    [app.main.data.workspace.edition :as dwe]
    [app.main.data.workspace.path.changes :as changes]
    [app.main.data.workspace.path.state :as st]
    [app.main.data.workspace.shapes :as dwsh]
-   [app.util.path.tools :as upt]
    [beicon.v2.core :as rx]
    [potok.v2.core :as ptk]))
 
@@ -26,19 +27,30 @@
    (ptk/reify ::process-path-tool
      ptk/WatchEvent
      (watch [it state _]
-       (let [objects (dsh/lookup-page-objects state)
+       (let [page-id (get state :current-page-id)
-             id (st/get-path-id state)
+             objects (dsh/lookup-page-objects state page-id)
-             page-id (:current-page-id state)
+
-             shape (st/get-path state)
+             shape   (st/get-path state)
-             selected-points (get-in state [:workspace-local :edit-path id :selected-points] #{})
+             id      (st/get-path-id state)
-             points (or points selected-points)]
+
+             selected-points
+             (dm/get-in state [:workspace-local :edit-path id :selected-points] #{})
+
+             points
+             (or points selected-points)]
+
          (when (and (seq points) (some? shape))
-           (let [new-content (-> (tool-fn (:content shape) points)
+           (let [new-content
-                                 (ups/close-subpaths))
+                 (-> (tool-fn (:content shape) points)
-                 changes (changes/generate-path-changes it objects page-id shape (:content shape) new-content)]
+                     (path/close-subpaths))
+
+                 changes
+                 (changes/generate-path-changes it objects page-id shape (:content shape) new-content)]
 
              (rx/concat
-              (rx/of (dwsh/update-shapes [id] upsp/convert-to-path))
+              (if (cfh/path-shape? shape)
+                (rx/empty)
+                (rx/of (dwsh/update-shapes [id] path/convert-to-path)))
               (rx/of (dch/commit-changes changes)
                      (when (empty? new-content)
                        (dwe/clear-edition-mode)))))))))))
@@ -50,7 +62,7 @@
    (process-path-tool
     (when point #{point})
     (fn [content points]
-      (reduce upt/make-corner-point content points)))))
+      (reduce path.segment/make-corner-point content points)))))
 
 (defn make-curve
   ([]
@@ -59,22 +71,22 @@
    (process-path-tool
     (when point #{point})
     (fn [content points]
-      (reduce upt/make-curve-point content points)))))
+      (reduce path.segment/make-curve-point content points)))))
 
 (defn add-node []
-  (process-path-tool (fn [content points] (upt/split-segments content points 0.5))))
+  (process-path-tool (fn [content points] (path.segment/split-segments content points 0.5))))
 
 (defn remove-node []
-  (process-path-tool upt/remove-nodes))
+  (process-path-tool path.segment/remove-nodes))
 
 (defn merge-nodes []
-  (process-path-tool upt/merge-nodes))
+  (process-path-tool path.segment/merge-nodes))
 
 (defn join-nodes []
-  (process-path-tool upt/join-nodes))
+  (process-path-tool path.segment/join-nodes))
 
 (defn separate-nodes []
-  (process-path-tool upt/separate-nodes))
+  (process-path-tool path.segment/separate-nodes))
 
 (defn toggle-snap []
   (ptk/reify ::toggle-snap

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

@@ -47,40 +47,53 @@
 
 (defn update-shapes
   ([ids update-fn] (update-shapes ids update-fn nil))
-  ([ids update-fn {:keys [reg-objects? save-undo? stack-undo? attrs ignore-tree page-id ignore-touched undo-group with-objects? changed-sub-attr]
+  ([ids update-fn
-                   :or {reg-objects? false save-undo? true stack-undo? false ignore-touched false with-objects? false}}]
+    {:keys [reg-objects? save-undo? stack-undo? attrs ignore-tree page-id
+            ignore-touched undo-group with-objects? changed-sub-attr]
+     :or {reg-objects? false
+          save-undo? true
+          stack-undo? false
+          ignore-touched false
+          with-objects? false}}]
 
-   (assert (sm/check-coll-of-uuid ids))
+   (assert (every? uuid? ids) "expect a coll of uuid for `ids`")
-   (assert (fn? update-fn))
+   (assert (fn? update-fn) "the `update-fn` should be a valid function")
 
    (ptk/reify ::update-shapes
      ptk/WatchEvent
      (watch [it state _]
-       (let [page-id   (or page-id (:current-page-id state))
+       (let [page-id   (or page-id (get state :current-page-id))
              objects   (dsh/lookup-page-objects state page-id)
              ids       (into [] (filter some?) ids)
 
+             xf-update-layout
+             (comp
+              (map (d/getf objects))
+              (filter #(some update-layout-attr? (pcb/changed-attrs % objects update-fn {:attrs attrs :with-objects? with-objects?})))
+              (map :id))
+
              update-layout-ids
-             (->> ids
+             (->> (into [] xf-update-layout ids)
-                  (map (d/getf objects))
+                  (not-empty))
-                  (filter #(some update-layout-attr? (pcb/changed-attrs % objects update-fn {:attrs attrs :with-objects? with-objects?})))
-                  (map :id))
 
-             changes (-> (pcb/empty-changes it page-id)
+             changes
-                         (pcb/set-save-undo? save-undo?)
+             (-> (pcb/empty-changes it page-id)
-                         (pcb/set-stack-undo? stack-undo?)
+                 (pcb/set-save-undo? save-undo?)
-                         (cls/generate-update-shapes ids
+                 (pcb/set-stack-undo? stack-undo?)
-                                                     update-fn
+                 (cls/generate-update-shapes ids
-                                                     objects
+                                             update-fn
-                                                     {:attrs attrs
+                                             objects
-                                                      :changed-sub-attr changed-sub-attr
+                                             {:attrs attrs
-                                                      :ignore-tree ignore-tree
+                                              :changed-sub-attr changed-sub-attr
-                                                      :ignore-touched ignore-touched
+                                              :ignore-tree ignore-tree
-                                                      :with-objects? with-objects?})
+                                              :ignore-touched ignore-touched
-                         (cond-> undo-group
+                                              :with-objects? with-objects?})
-                           (pcb/set-undo-group undo-group)))
+                 (cond-> undo-group
+                   (pcb/set-undo-group undo-group)))
+
+             changes
+             (add-undo-group changes state)]
 
-             changes (add-undo-group changes state)]
          (rx/concat
           (if (seq (:redo-changes changes))
             (let [changes (cond-> changes reg-objects? (pcb/resize-parents ids))]
@@ -88,7 +101,7 @@
             (rx/empty))
 
           ;; Update layouts for properties marked
-          (if (d/not-empty? update-layout-ids)
+          (if update-layout-ids
             (rx/of (ptk/data-event :layout/update {:ids update-layout-ids}))
             (rx/empty))))))))
 
@@ -112,11 +125,13 @@
                  (pcb/with-objects objects)
                  (cfsh/prepare-add-shape shape objects))
 
-             changes (cond-> changes
+             changes
-                       (cfh/text-shape? shape)
+             (cond-> changes
-                       (pcb/set-undo-group (:id shape)))
+               (cfh/text-shape? shape)
+               (pcb/set-undo-group (:id shape)))
 
-             undo-id (js/Symbol)]
+             undo-id
+             (js/Symbol)]
 
          (rx/concat
           (rx/of (dwu/start-undo-transaction undo-id)

frontend/src/app/main/features.cljs

@@ -110,4 +110,3 @@
         (log/inf :hint "initialized"
                  :enabled (str/join "," features)
                  :runtime (str/join "," (:features-runtime state)))))))
-

frontend/src/app/main/ui/shapes/bool.cljs

@@ -7,7 +7,8 @@
 (ns app.main.ui.shapes.bool
   (:require
    [app.common.data.macros :as dm]
-   [app.common.geom.shapes :as gsh]
+   [app.common.types.path :as path]
+
    [app.main.ui.hooks :as h]
    [app.main.ui.shapes.export :as use]
    [app.main.ui.shapes.path :refer [path-shape]]
@@ -30,7 +31,7 @@
                           content
 
                           (some? child-objs)
-                          (gsh/calc-bool-content shape child-objs))))
+                          (path/calc-bool-content shape child-objs))))
 
           shape     (mf/with-memo [shape content]
                       (assoc shape :content content))]

frontend/src/app/main/ui/shapes/custom_stroke.cljs

@@ -13,6 +13,7 @@
    [app.common.geom.shapes :as gsh]
    [app.common.geom.shapes.bounds :as gsb]
    [app.common.geom.shapes.text :as gst]
+   [app.common.types.path :as path]
    [app.common.uuid :as uuid]
    [app.config :as cf]
    [app.main.ui.context :as muc]
@@ -204,7 +205,7 @@
   {::mf/wrap-props false}
   [{:keys [shape stroke render-id index]}]
   (let [open-path?    (and ^boolean (cfh/path-shape? shape)
-                           ^boolean (gsh/open-path? shape))
+                           ^boolean (path/shape-with-open-path? shape))
         gradient      (:stroke-color-gradient stroke)
         alignment     (:stroke-alignment stroke :center)
         width         (:stroke-width stroke 0)
@@ -397,7 +398,7 @@
         has-stroke?     (and (> stroke-width 0)
                              (not= stroke-style :none))
         closed?         (or (not ^boolean (cfh/path-shape? shape))
-                            (not ^boolean (gsh/open-path? shape)))
+                            (not ^boolean (path/shape-with-open-path? shape)))
         inner?          (= :inner stroke-position)
         outer?          (= :outer stroke-position)]
 
@@ -496,7 +497,7 @@
                                        :style style})
 
         open-path?    (and ^boolean (cfh/path-shape? shape)
-                           ^boolean (gsh/open-path? shape))]
+                           ^boolean (path/shape-with-open-path? shape))]
     (when-not ^boolean (cfh/frame-shape? shape)
       (when (and (some? shape-blur)
                  (not ^boolean (:hidden shape-blur)))

frontend/src/app/main/ui/shapes/path.cljs

@@ -7,28 +7,35 @@
 (ns app.main.ui.shapes.path
   (:require
    [app.common.logging :as log]
+   [app.common.types.path :as path]
    [app.main.ui.shapes.custom-stroke :refer [shape-custom-strokes]]
-   [app.util.object :as obj]
-   [app.util.path.format :as upf]
    [rumext.v2 :as mf]))
 
+(defn- content->string
+  [content]
+  (cond
+    (nil? content)
+    ""
+
+    (path/content? content)
+    (.toString content)
+
+    :else
+    (let [content (path/content content)]
+      (.toString content))))
+
 (mf/defc path-shape
-  {::mf/wrap-props false}
+  {::mf/props :obj}
-  [props]
+  [{:keys [shape]}]
-  (let [shape   (unchecked-get props "shape")
+  (let [content (get shape :content)
-        content (:content shape)
         pdata   (mf/with-memo [content]
                   (try
-                    (upf/format-path content)
+                    (content->string content)
-                    (catch :default e
+                    (catch :default cause
                       (log/error :hint "unexpected error on formatting path"
                                  :shape-name (:name shape)
                                  :shape-id (:id shape)
-                                 :cause e)
+                                 :cause cause)
-                      "")))
+                      "")))]
-
-        props   (-> #js {}
-                    (obj/set! "d" pdata))]
-
     [:& shape-custom-strokes {:shape shape}
-     [:> :path props]]))
+     [:path {:d pdata}]]))

frontend/src/app/main/ui/workspace/shapes/debug.cljs

@@ -10,12 +10,13 @@
    [app.common.data.macros :as dm]
    [app.common.files.helpers :as cfh]
    [app.common.geom.shapes :as gsh]
-   [app.common.geom.shapes.path :as gsp]
    [app.common.geom.shapes.text :as gst]
    [app.common.math :as mth]
-   [app.common.svg.path.bool :as pb]
+   [app.common.types.path :as path]
-   [app.common.svg.path.shapes-to-path :as stp]
+   [app.common.types.path.bool :as path.bool]
-   [app.common.svg.path.subpath :as ups]
+   [app.common.types.path.helpers :as path.helpers]
+   [app.common.types.path.segment :as path.segment]
+   [app.common.types.path.subpath :as path.subpath]
    [app.main.refs :as refs]
    [app.util.color :as uc]
    [app.util.debug :as dbg]
@@ -101,49 +102,49 @@
         radius (/ 3 zoom)
 
         c1 (-> (get objects (first (:shapes shape)))
-               (stp/convert-to-path objects))
+               (path/convert-to-path objects))
         c2 (-> (get objects (second (:shapes shape)))
-               (stp/convert-to-path objects))
+               (path/convert-to-path objects))
 
         content-a (:content c1)
         content-b (:content c2)
 
         bool-type (:bool-type shape)
         should-reverse? (and (not= :union bool-type)
-                             (= (ups/clockwise? content-b)
+                             (= (path.subpath/clockwise? content-b)
-                                (ups/clockwise? content-a)))
+                                (path.subpath/clockwise? content-a)))
 
         content-a (-> (:content c1)
-                      (pb/close-paths)
+                      (path.bool/close-paths)
-                      (pb/add-previous))
+                      (path.bool/add-previous))
 
         content-b (-> (:content c2)
-                      (pb/close-paths)
+                      (path.bool/close-paths)
-                      (cond-> should-reverse? (ups/reverse-content))
+                      (cond-> should-reverse? (path.subpath/reverse-content))
-                      (pb/add-previous))
+                      (path.bool/add-previous))
 
 
-        sr-a (gsp/content->selrect content-a)
+        sr-a (path.segment/content->selrect content-a)
-        sr-b (gsp/content->selrect content-b)
+        sr-b (path.segment/content->selrect content-b)
 
-        [content-a-split content-b-split] (pb/content-intersect-split content-a content-b sr-a sr-b)
+        [content-a-split content-b-split] (path.bool/content-intersect-split content-a content-b sr-a sr-b)
 
-        ;;content-a-geom (gsp/content->geom-data content-a)
+        ;;content-a-geom (path.segment/content->geom-data content-a)
-        ;;content-b-geom (gsp/content->geom-data content-b)
+        ;;content-b-geom (path.segment/content->geom-data content-b)
-        ;;content-a-split (->> content-a-split #_(filter #(pb/contains-segment? % content-b sr-b content-b-geom)))
+        ;;content-a-split (->> content-a-split #_(filter #(path.bool/contains-segment? % content-b sr-b content-b-geom)))
-        ;;content-b-split (->> content-b-split #_(filter #(pb/contains-segment? % content-a sr-a content-a-geom)))
+        ;;content-b-split (->> content-b-split #_(filter #(path.bool/contains-segment? % content-a sr-a content-a-geom)))
         ]
     [:*
-     (for [[i cmd] (d/enumerate content-a-split)]
+     (for [[i segment] (d/enumerate content-a-split)]
-       (let [p1 (:prev cmd)
+       (let [p1 (:prev segment)
-             p2 (gsp/command->point cmd)
+             p2 (path.helpers/segment->point segment)
 
-             hp (case (:command cmd)
+             hp (case (:command segment)
-                  :line-to  (-> (gsp/command->line cmd)
+                  :line-to  (-> (path.helpers/command->line segment)
-                                (gsp/line-values 0.5))
+                                (path.helpers/line-values 0.5))
 
-                  :curve-to (-> (gsp/command->bezier cmd)
+                  :curve-to (-> (path.helpers/command->bezier segment)
-                                (gsp/curve-values 0.5))
+                                (path.helpers/curve-values 0.5))
                   nil)]
          [:*
           (when p1
@@ -153,16 +154,16 @@
           (when hp
             [:circle {:data-i i :key (dm/str "c13-" i) :cx (:x hp) :cy (:y hp) :r radius :fill "orange"}])]))
 
-     (for [[i cmd] (d/enumerate content-b-split)]
+     (for [[i segment] (d/enumerate content-b-split)]
-       (let [p1 (:prev cmd)
+       (let [p1 (:prev segment)
-             p2 (gsp/command->point cmd)
+             p2 (path.helpers/segment->point segment)
 
-             hp (case (:command cmd)
+             hp (case (:command segment)
-                  :line-to  (-> (gsp/command->line cmd)
+                  :line-to  (-> (path.helpers/command->line segment)
-                                (gsp/line-values 0.5))
+                                (path.helpers/line-values 0.5))
 
-                  :curve-to (-> (gsp/command->bezier cmd)
+                  :curve-to (-> (path.helpers/command->bezier segment)
-                                (gsp/curve-values 0.5))
+                                (path.helpers/curve-values 0.5))
                   nil)]
          [:*
           (when p1

frontend/src/app/main/ui/workspace/shapes/path.cljs

@@ -6,34 +6,48 @@
 
 (ns app.main.ui.workspace.shapes.path
   (:require
-   [app.common.svg.path.command :as upc]
+   [app.common.data.macros :as dm]
-   [app.main.data.workspace.path.helpers :as helpers]
+   [app.common.types.path :as types.path]
    [app.main.refs :as refs]
    [app.main.ui.shapes.path :as path]
    [app.main.ui.shapes.shape :refer [shape-container]]
    [app.main.ui.workspace.shapes.debug :as wsd]
-   [app.main.ui.workspace.shapes.path.common :as pc]
+   [okulary.core :as l]
    [rumext.v2 :as mf]))
 
-(defn apply-content-modifiers
+(defn- make-content-modifiers-ref
+  [id]
+  (l/derived (fn [local]
+               (dm/get-in local [:edit-path id :content-modifiers]))
+             refs/workspace-local))
+
+(defn- apply-content-modifiers
   [shape content-modifiers]
-  (let [shape (update shape :content upc/apply-content-modifiers content-modifiers)
+  (let [shape (update shape :content types.path/apply-content-modifiers content-modifiers)]
-        [_ new-selrect] (helpers/content->points+selrect shape (:content shape))]
+    (types.path/update-geometry shape)))
-    (assoc shape :selrect new-selrect)))
 
 (mf/defc path-wrapper
   {::mf/wrap-props false}
-  [props]
+  [{:keys [shape]}]
-  (let [shape (unchecked-get props "shape")
+  (let [shape-id (dm/get-prop shape :id)
-        content-modifiers-ref (pc/make-content-modifiers-ref (:id shape))
+
-        content-modifiers (mf/deref content-modifiers-ref)
+        content-modifiers-ref
-        editing-id (mf/deref refs/selected-edition)
+        (mf/with-memo [shape-id]
-        editing? (= editing-id (:id shape))
+          (make-content-modifiers-ref shape-id))
+
+        content-modifiers
+        (mf/deref content-modifiers-ref)
+
+        ;; FIXME: this should be provided by react context instead of using refs
+        editing-id
+        (mf/deref refs/selected-edition)
+
+        editing?
+        (= editing-id shape-id)
 
         shape
-        (mf/use-memo
+        (mf/with-memo [shape content-modifiers]
-         (mf/deps shape content-modifiers)
+          (cond-> shape
-         #(cond-> shape
             (some? content-modifiers)
             (apply-content-modifiers content-modifiers)))]
 

frontend/src/app/main/ui/workspace/shapes/path/common.cljs

@@ -1,43 +0,0 @@
-;; 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) KALEIDOS INC
-
-(ns app.main.ui.workspace.shapes.path.common
-  (:require
-   [app.common.data.macros :as dm]
-   [app.main.data.workspace.path.state :as pst]
-   [app.main.refs :as refs]
-   [app.main.store :as st]
-   [okulary.core :as l]
-   [rumext.v2 :as mf]))
-
-(def accent-color "var(--color-accent-tertiary)")
-(def secondary-color "var(--color-accent-quaternary)")
-(def black-color "var(--app-black)")
-(def white-color "var(--app-white)")
-(def gray-color "var(--df-secondary)")
-
-(def current-edit-path-ref
-  (l/derived
-   (fn [state]
-     (let [id (pst/get-path-id state)]
-       (dm/get-in state [:workspace-local :edit-path id])))
-   st/state))
-
-(defn make-edit-path-ref [id]
-  (mf/use-memo
-   (mf/deps id)
-   (let [selfn #(get-in % [:edit-path id])]
-     #(l/derived selfn refs/workspace-local))))
-
-(defn content-modifiers-ref
-  [id]
-  (l/derived #(get-in % [:edit-path id :content-modifiers]) refs/workspace-local))
-
-(defn make-content-modifiers-ref [id]
-  (mf/use-memo
-   (mf/deps id)
-   #(content-modifiers-ref id)))
-

frontend/src/app/main/ui/workspace/shapes/path/editor.cljs

@@ -8,24 +8,24 @@
   (:require
    [app.common.data :as d]
    [app.common.data.macros :as dm]
+   [app.common.files.helpers :as cfh]
    [app.common.geom.point :as gpt]
-   [app.common.geom.shapes.path :as gsp]
+   [app.common.types.path :as path]
-   [app.common.svg.path.command :as upc]
+   [app.common.types.path.helpers :as path.helpers]
-   [app.common.svg.path.shapes-to-path :as ups]
+   [app.common.types.path.segment :as path.segment]
    [app.main.data.workspace.path :as drp]
+   [app.main.refs :as refs]
    [app.main.snap :as snap]
    [app.main.store :as st]
    [app.main.streams :as ms]
    [app.main.ui.css-cursors :as cur]
    [app.main.ui.hooks :as hooks]
-   [app.main.ui.workspace.shapes.path.common :as pc]
    [app.util.dom :as dom]
    [app.util.keyboard :as kbd]
-   [app.util.path.format :as upf]
    [clojure.set :refer [map-invert]]
    [goog.events :as events]
-   [rumext.v2 :as mf])
+   [okulary.core :as l]
-  (:import goog.events.EventType))
+   [rumext.v2 :as mf]))
 
 (def point-radius 5)
 (def point-radius-selected 4)
@@ -38,16 +38,31 @@
 (def path-preview-dasharray 4)
 (def path-snap-stroke-width 1)
 
-(mf/defc path-point [{:keys [position zoom edit-mode hover? selected? preview? start-path? last-p? new-point? curve?]}]
+(def accent-color "var(--color-accent-tertiary)")
+(def secondary-color "var(--color-accent-quaternary)")
+(def black-color "var(--app-black)")
+(def white-color "var(--app-white)")
+(def gray-color "var(--df-secondary)")
+
+(mf/defc path-point*
+  {::mf/private true}
+  [{:keys [position zoom edit-mode is-hover is-selected is-preview is-start-path is-last is-new is-curve]}]
   (let [{:keys [x y]} position
 
+        is-draw (= edit-mode :draw)
+        is-move (= edit-mode :move)
+
+        is-active
+        (or ^boolean is-selected
+            ^boolean is-hover)
+
         on-enter
-        (mf/use-callback
+        (mf/use-fn
          (fn [_]
            (st/emit! (drp/path-pointer-enter position))))
 
         on-leave
-        (mf/use-callback
+        (mf/use-fn
          (fn [_]
            (st/emit! (drp/path-pointer-leave position))))
 
@@ -56,132 +71,173 @@
           (dom/stop-propagation event)
           (dom/prevent-default event)
 
-          (when (and new-point? (some? (meta position)))
+          ;; FIXME: revisit this, using meta here breaks equality checks
+          (when (and is-new (some? (meta position)))
             (st/emit! (drp/create-node-at-position (meta position))))
 
-          (let [shift? (kbd/shift? event)
+          (let [is-shift (kbd/shift? event)
-                mod?   (kbd/mod? event)]
+                is-mod   (kbd/mod? event)]
             (cond
-              last-p?
+              is-last
               (st/emit! (drp/reset-last-handler))
 
-              (and (= edit-mode :move) mod? (not curve?))
+              (and is-move is-mod (not is-curve))
               (st/emit! (drp/make-curve position))
 
-              (and (= edit-mode :move) mod? curve?)
+              (and is-move is-mod is-curve)
               (st/emit! (drp/make-corner position))
 
-              (= edit-mode :move)
+              is-move
               ;; If we're dragging a selected item we don't change the selection
-              (st/emit! (drp/start-move-path-point position shift?))
+              (st/emit! (drp/start-move-path-point position is-shift))
 
-              (and (= edit-mode :draw) start-path?)
+              (and is-draw is-start-path)
               (st/emit! (drp/start-path-from-point position))
 
-              (and (= edit-mode :draw) (not start-path?))
+              (and is-draw (not is-start-path))
               (st/emit! (drp/close-path-drag-start position)))))]
 
     [:g.path-point
      [:circle.path-point
       {:cx x
        :cy y
-       :r (if (or selected? hover?) (/ point-radius zoom) (/ point-radius-selected zoom))
+       :r (if ^boolean is-active
+            (/ point-radius zoom)
+            (/ point-radius-selected zoom))
        :style {:stroke-width (/ point-radius-stroke-width zoom)
-               :stroke (cond (or selected? hover?) pc/black-color
+               :stroke (cond ^boolean is-active black-color
-                             preview? pc/secondary-color
+                             ^boolean is-preview secondary-color
-                             :else pc/accent-color)
+                             :else accent-color)
-               :fill (cond selected? pc/accent-color
+               :fill (cond is-selected accent-color
-                           :else pc/white-color)}}]
+                           :else white-color)}}]
      [:circle {:cx x
                :cy y
                :r (/ point-radius-active-area zoom)
                :on-pointer-down on-pointer-down
                :on-pointer-enter on-enter
                :on-pointer-leave on-leave
-               :pointer-events (when-not preview? "visible")
+               :pointer-events (when-not ^boolean is-preview "visible")
-               :class (cond (= edit-mode :draw) (cur/get-static "pen-node")
+               :class (cond ^boolean is-draw (cur/get-static "pen-node")
-                            (= edit-mode :move) (cur/get-static "pointer-node"))
+                            ^boolean is-move (cur/get-static "pointer-node"))
                :style {:stroke-width 0
                        :fill "none"}}]]))
 
-(mf/defc path-handler [{:keys [index prefix point handler zoom selected? hover? edit-mode snap-angle?]}]
+;; FIXME: is-selected prop looks unused
-  (when (and point handler)
-    (let [{:keys [x y]} handler
-          on-enter
-          (fn [_]
-            (st/emit! (drp/path-handler-enter index prefix)))
 
-          on-leave
+(mf/defc path-handler*
-          (fn [_]
+  {::mf/private true}
-            (st/emit! (drp/path-handler-leave index prefix)))
+  [{:keys [index prefix point handler zoom is-selected is-hover edit-mode snap-angle]}]
+  (let [x       (dm/get-prop handler :x)
+        y       (dm/get-prop handler :y)
+        is-draw (= edit-mode :draw)
+        is-move (= edit-mode :move)
 
-          on-pointer-down
+        is-active
-          (fn [event]
+        (or ^boolean is-selected
-            (dom/stop-propagation event)
+            ^boolean is-hover)
-            (dom/prevent-default event)
 
-            (cond
+        on-enter
-              (= edit-mode :move)
+        (mf/use-fn
-              (st/emit! (drp/start-move-handler index prefix))))]
+         (mf/deps index prefix)
+         (fn [_] (st/emit! (drp/path-handler-enter index prefix))))
 
-      [:g.handler {:pointer-events (if (= edit-mode :draw) "none" "visible")}
+        on-leave
+        (mf/use-fn
+         (mf/deps index prefix)
+         (fn [_] (st/emit! (drp/path-handler-leave index prefix))))
+
+        on-pointer-down
+        (mf/use-fn
+         (mf/deps index prefix is-move)
+         (fn [event]
+           (dom/stop-propagation event)
+           (dom/prevent-default event)
+
+           (when ^boolean is-move
+             (st/emit! (drp/start-move-handler index prefix)))))]
+
+    [:g.handler {:pointer-events (if ^boolean is-draw "none" "visible")}
+     [:line
+      {:x1 (:x point)
+       :y1 (:y point)
+       :x2 x
+       :y2 y
+       :style {:stroke (if ^boolean is-hover
+                         black-color
+                         gray-color)
+               :stroke-width (/ point-radius-stroke-width zoom)}}]
+
+     (when ^boolean snap-angle
        [:line
         {:x1 (:x point)
          :y1 (:y point)
          :x2 x
          :y2 y
-         :style {:stroke (if hover? pc/black-color pc/gray-color)
+         :style {:stroke secondary-color
-                 :stroke-width (/ point-radius-stroke-width zoom)}}]
+                 :stroke-width (/ point-radius-stroke-width zoom)}}])
 
-       (when snap-angle?
+     [:rect
-         [:line
+      {:x (- x (/ handler-side 2 zoom))
-          {:x1 (:x point)
+       :y (- y (/ handler-side 2 zoom))
-           :y1 (:y point)
+       :width (/ handler-side zoom)
-           :x2 x
+       :height (/ handler-side zoom)
-           :y2 y
-           :style {:stroke pc/secondary-color
-                   :stroke-width (/ point-radius-stroke-width zoom)}}])
 
-       [:rect
+       :style {:stroke-width (/ handler-stroke-width zoom)
-        {:x (- x (/ handler-side 2 zoom))
+               :stroke (cond ^boolean is-active black-color
-         :y (- y (/ handler-side 2 zoom))
+                             :else accent-color)
-         :width (/ handler-side zoom)
+               :fill (cond ^boolean is-selected accent-color
-         :height (/ handler-side zoom)
+                           :else white-color)}}]
+     [:circle {:cx x
+               :cy y
+               :r (/ point-radius-active-area zoom)
+               :on-pointer-down on-pointer-down
+               :on-pointer-enter on-enter
+               :on-pointer-leave on-leave
+               :class (when ^boolean is-move
+                        (cur/get-static "pointer-move"))
+               :style {:fill "none"
+                       :stroke-width 0}}]]))
 
-         :style {:stroke-width (/ handler-stroke-width zoom)
+(mf/defc path-preview*
-                 :stroke (cond (or selected? hover?) pc/black-color
+  {::mf/private true}
-                               :else pc/accent-color)
+  [{:keys [zoom segment from]}]
-                 :fill (cond selected? pc/accent-color
-                             :else pc/white-color)}}]
-       [:circle {:cx x
-                 :cy y
-                 :r (/ point-radius-active-area zoom)
-                 :on-pointer-down on-pointer-down
-                 :on-pointer-enter on-enter
-                 :on-pointer-leave on-leave
-                 :class (when (= edit-mode :move) (cur/get-static "pointer-move"))
-                 :style {:fill "none"
-                         :stroke-width 0}}]])))
 
-(mf/defc path-preview [{:keys [zoom command from]}]
+  (let [path
-  [:g.preview {:style {:pointer-events "none"}}
+        (when (not= :move-to (:command segment))
-   (when (not= :move-to (:command command))
+          (let [segments [{:command :move-to
-     [:path {:style {:fill "none"
+                           :params from}]
-                     :stroke pc/black-color
+                segments (conj segments segment)]
-                     :stroke-width (/ handler-stroke-width zoom)
+            (path/content segments)))
-                     :stroke-dasharray (/ path-preview-dasharray zoom)}
-             :d (upf/format-path [{:command :move-to
-                                   :params {:x (:x from)
-                                            :y (:y from)}}
-                                  command])}])
-   [:& path-point {:position (:params command)
-                   :preview? true
-                   :zoom zoom}]])
 
-(mf/defc path-snap [{:keys [selected points zoom]}]
+        position
-  (let [ranges       (mf/use-memo (mf/deps selected points) #(snap/create-ranges points selected))
+        (mf/with-memo [segment]
-        snap-matches (snap/get-snap-delta-match selected ranges (/ 1 zoom))
+          ;; FIXME: use a helper from common for this
-        matches      (concat (second (:x snap-matches)) (second (:y snap-matches)))]
+          (gpt/point (:params segment)))]
+
+    [:g.preview {:style {:pointer-events "none"}}
+     (when (some? path)
+       [:path {:style {:fill "none"
+                       :stroke black-color
+                       :stroke-width (/ handler-stroke-width zoom)
+                       :stroke-dasharray (/ path-preview-dasharray zoom)}
+               :d (str path)}])
+
+     [:> path-point* {:position position
+                      :is-preview true
+                      :zoom zoom}]]))
+
+(mf/defc path-snap*
+  {::mf/private true}
+  [{:keys [selected points zoom]}]
+  (let [ranges
+        (mf/with-memo [selected points]
+          (snap/create-ranges points selected))
+
+        snap-matches
+        (snap/get-snap-delta-match selected ranges (/ 1 zoom))
+
+        matches
+        (concat (second (:x snap-matches)) (second (:y snap-matches)))]
 
     [:g.snap-paths
      (for [[idx [from to]] (d/enumerate matches)]
@@ -190,14 +246,14 @@
                :y1 (:y from)
                :x2 (:x to)
                :y2 (:y to)
-               :style {:stroke pc/secondary-color
+               :style {:stroke secondary-color
                        :stroke-width (/ path-snap-stroke-width zoom)}}])]))
 
-(defn matching-handler? [content node handlers]
+(defn- matching-handler? [content node handlers]
   (when (= 2 (count handlers))
     (let [[[i1 p1] [i2 p2]] handlers
-          p1 (upc/handler->point content i1 p1)
+          p1 (path.segment/get-handler-point content i1 p1)
-          p2 (upc/handler->point content i2 p2)
+          p2 (path.segment/get-handler-point content i2 p2)
 
           v1 (gpt/to-vec node p1)
           v2 (gpt/to-vec node p2)
@@ -205,12 +261,19 @@
           angle (gpt/angle-with-other v1 v2)]
       (<= (- 180 angle) 0.1))))
 
-(mf/defc path-editor
+(defn- make-edit-path-ref [id]
+  (let [get-fn #(dm/get-in % [:edit-path id])]
+    (l/derived get-fn refs/workspace-local)))
+
+(mf/defc path-editor*
   [{:keys [shape zoom]}]
 
-  (let [editor-ref (mf/use-ref nil)
+  (let [shape-id      (dm/get-prop shape :id)
-        edit-path-ref (pc/make-edit-path-ref (:id shape))
+        edit-path-ref (mf/with-memo [shape-id]
-        hover-point (mf/use-state nil)
+                        (make-edit-path-ref shape-id))
+
+        hover-point   (mf/use-state nil)
+        editor-ref    (mf/use-ref nil)
 
         {:keys [edit-mode
                 drag-handler
@@ -224,141 +287,171 @@
                 hover-handlers
                 hover-points
                 snap-toggled]
-         :as edit-path} (mf/deref edit-path-ref)
+         :as edit-path}
+        (mf/deref edit-path-ref)
 
-        selected-points (or selected-points #{})
+        selected-points
+        (or selected-points #{})
 
-        shape (cond-> shape
+        shape
-                (not= :path (:type shape))
+        (mf/with-memo [shape]
-                (ups/convert-to-path {})
+          (cond-> shape
+            (not (cfh/path-shape? shape))
+            (path/convert-to-path)))
 
-                :always
+        base-content
-                hooks/use-equal-memo)
+        (get shape :content)
 
-        base-content (:content shape)
+        base-points
-        base-points (mf/use-memo (mf/deps base-content) #(->> base-content gsp/content->points))
+        (mf/with-memo [base-content]
+          (path/get-points base-content))
 
-        content (upc/apply-content-modifiers base-content content-modifiers)
+        content
-        content-points (mf/use-memo (mf/deps content) #(->> content gsp/content->points))
+        (mf/with-memo [base-content content-modifiers]
+          (path/apply-content-modifiers base-content content-modifiers))
+
+        content-points
+        (mf/with-memo [content]
+          (path/get-points content))
 
         point->base (->> (map hash-map content-points base-points) (reduce merge))
         base->point (map-invert point->base)
 
-        points (into #{} content-points)
+        points
+        (mf/with-memo [content-points]
+          (into #{} content-points))
 
-        last-p (->> content last upc/command->point)
+        last-p
-        handlers (upc/content->handlers content)
+        (->> content last path.helpers/segment->point)
 
-        start-p? (not (some? last-point))
+        handlers
+        (mf/with-memo [content]
+          (path.segment/get-handlers content))
 
-        [snap-selected snap-points]
+        is-path-start
-        (cond
+        (not (some? last-point))
-          (some? drag-handler) [#{drag-handler} points]
-          (some? preview) [#{(upc/command->point preview)} points]
-          (some? moving-handler) [#{moving-handler} points]
-          :else
-          [(->> selected-points (map base->point) (into #{}))
-           (->> points (remove selected-points) (into #{}))])
 
-        show-snap? (and snap-toggled
+        show-snap?
-                        (or (some? drag-handler)
+        (and ^boolean snap-toggled
-                            (some? preview)
+             (or (some? drag-handler)
-                            (some? moving-handler)
+                 (some? preview)
-                            moving-nodes))
+                 (some? moving-handler)
+                 moving-nodes))]
 
-        handle-double-click-outside
+    (mf/with-layout-effect [edit-mode]
-        (fn [_]
+      (let [key (events/listen (dom/get-root) "dblclick"
-          (when (= edit-mode :move)
+                               #(when (= edit-mode :move)
-            (st/emit! :interrupt)))]
+                                  (st/emit! :interrupt)))]
-
+        #(events/unlistenByKey key)))
-    (mf/use-layout-effect
-     (mf/deps edit-mode)
-     (fn []
-       (let [keys [(events/listen (dom/get-root) EventType.DBLCLICK handle-double-click-outside)]]
-         #(doseq [key keys]
-            (events/unlistenByKey key)))))
 
     (hooks/use-stream
      ms/mouse-position
-     (mf/deps shape zoom)
+     (mf/deps base-content zoom)
      (fn [position]
-       (when-let [point (gsp/path-closest-point shape position)]
+       (when-let [point (path.segment/closest-point base-content position)]
          (reset! hover-point (when (< (gpt/distance position point) (/ 10 zoom)) point)))))
 
     [:g.path-editor {:ref editor-ref}
-     [:path {:d (upf/format-path content)
+     [:path {:d (.toString content)
              :style {:fill "none"
-                     :stroke pc/accent-color
+                     :stroke accent-color
                      :strokeWidth (/ 1 zoom)}}]
      (when (and preview (not drag-handler))
-       [:& path-preview {:command preview
+       [:> path-preview* {:segment preview
-                         :from last-p
+                          :from last-p
-                         :zoom zoom}])
+                          :zoom zoom}])
 
-     (when drag-handler
+     (when (and drag-handler last-p)
        [:g.drag-handler {:pointer-events "none"}
-        [:& path-handler {:point last-p
+        [:> path-handler* {:point last-p
-                          :handler drag-handler
+                           :handler drag-handler
-                          :edit-mode edit-mode
+                           :edit-mode edit-mode
-                          :zoom zoom}]])
+                           :zoom zoom}]])
 
      (when @hover-point
        [:g.hover-point
-        [:& path-point {:position @hover-point
+        [:> path-point* {:position @hover-point
-                        :edit-mode edit-mode
+                         :edit-mode edit-mode
-                        :new-point? true
+                         :is-new true
-                        :start-path? start-p?
+                         :is-start-path is-path-start
-                        :zoom zoom}]])
+                         :zoom zoom}]])
 
-     (for [[index position] (d/enumerate points)]
+     (for [position points]
-       (let [show-handler?
+       (let [pos-x (dm/get-prop position :x)
+             pos-y (dm/get-prop position :y)
+
+             show-handler?
              (fn [[index prefix]]
-               (let [handler-position (upc/handler->point content index prefix)]
+               ;; FIXME: get-handler-point is executed twice for each
+               ;; render, this can be optimized
+               (let [handler-position (path.segment/get-handler-point content index prefix)]
                  (not= position handler-position)))
 
-             pos-handlers (get handlers position)
+             position-handlers
-             point-selected? (contains? selected-points (get point->base position))
+             (->> (get handlers position)
-             point-hover? (contains? hover-points (get point->base position))
+                  (filter show-handler?)
-             last-p? (= last-point (get point->base position))
+                  (not-empty))
 
-             pos-handlers (->> pos-handlers (filter show-handler?))
+             point-selected?
-             curve? (boolean (seq pos-handlers))]
+             (contains? selected-points (get point->base position))
 
-         [:g.path-node {:key (dm/str index "-" (:x position) "-" (:y position))}
+             point-hover?
+             (contains? hover-points (get point->base position))
+
+             is-last
+             (= last-point (get point->base position))
+
+             is-curve
+             (boolean position-handlers)]
+
+         [:g.path-node {:key (dm/str pos-x "-" pos-y)}
           [:g.point-handlers {:pointer-events (when (= edit-mode :draw) "none")}
-           (for [[hindex prefix] pos-handlers]
+           (for [[hindex prefix] position-handlers]
-             (let [handler-position (upc/handler->point content hindex prefix)
+             (let [handler-position  (path.segment/get-handler-point content hindex prefix)
-                   handler-hover? (contains? hover-handlers [hindex prefix])
+                   handler-hover?    (contains? hover-handlers [hindex prefix])
-                   moving-handler? (= handler-position moving-handler)
+                   moving-handler?   (= handler-position moving-handler)
-                   matching-handler? (matching-handler? content position pos-handlers)]
+                   matching-handler? (matching-handler? content position position-handlers)]
-               [:& path-handler {:key (dm/str (dm/str index "-" (:x position) "-" (:y position)) "-" hindex "-" (d/name prefix))
-                                 :point position
-                                 :handler handler-position
-                                 :index hindex
-                                 :prefix prefix
-                                 :zoom zoom
-                                 :hover? handler-hover?
-                                 :snap-angle? (and moving-handler? matching-handler?)
-                                 :edit-mode edit-mode}]))]
-          [:& path-point {:position position
-                          :zoom zoom
-                          :edit-mode edit-mode
-                          :selected? point-selected?
-                          :hover? point-hover?
-                          :last-p? last-p?
-                          :start-path? start-p?
-                          :curve? curve?}]]))
 
-     (when prev-handler
+               (when (and position handler-position)
+                 [:> path-handler*
+                  {:key (dm/str hindex "-" (d/name prefix))
+                   :point position
+                   :handler handler-position
+                   :index hindex
+                   :prefix prefix
+                   :zoom zoom
+                   :is-hover handler-hover?
+                   :snap-angle (and moving-handler? matching-handler?)
+                   :edit-mode edit-mode}])))]
+
+          [:> path-point* {:position position
+                           :zoom zoom
+                           :edit-mode edit-mode
+                           :is-selected point-selected?
+                           :is-hover point-hover?
+                           :is-last is-last
+                           :is-start-path is-path-start
+                           :is-curve is-curve}]]))
+
+     (when (and prev-handler last-p)
        [:g.prev-handler {:pointer-events "none"}
-        [:& path-handler {:point last-p
+        [:> path-handler*
-                          :edit-mode edit-mode
+         {:point last-p
-                          :handler prev-handler
+          :edit-mode edit-mode
-                          :zoom zoom}]])
+          :handler prev-handler
+          :zoom zoom}]])
 
-     (when show-snap?
+     (when ^boolean show-snap?
-       [:g.path-snap {:pointer-events "none"}
+       (let [[snap-selected snap-points]
-        [:& path-snap {:selected snap-selected
+             (cond
-                       :points snap-points
+               (some? drag-handler) [#{drag-handler} points]
-                       :zoom zoom}]])]))
+               (some? preview) [#{(path.helpers/segment->point preview)} points]
+               (some? moving-handler) [#{moving-handler} points]
+               :else
+               [(->> selected-points (map base->point) (into #{}))
+                (->> points (remove selected-points) (into #{}))])]
+         [:g.path-snap {:pointer-events "none"}
+          [:> path-snap* {:selected snap-selected
+                          :points snap-points
+                          :zoom zoom}]]))]))
 

frontend/src/app/main/ui/workspace/sidebar/options/menus/bool.cljs

@@ -8,7 +8,8 @@
   (:require-macros [app.main.style :as stl])
   (:require
    [app.common.data :as d]
-   [app.main.data.workspace :as dw]
+   [app.main.data.workspace.bool :as dwb]
+   [app.main.data.workspace.path.shapes-to-path :as dwps]
    [app.main.data.workspace.shortcuts :as sc]
    [app.main.refs :as refs]
    [app.main.store :as st]
@@ -43,19 +44,21 @@
          (mf/deps  selected is-group?  is-bool?)
          (fn [bool-type]
            (let [bool-type (keyword bool-type)]
+
              (cond
                (> (count selected) 1)
-               (st/emit! (dw/create-bool bool-type))
+               (st/emit! (dwb/create-bool bool-type))
 
                (and (= (count selected) 1) is-group?)
-               (st/emit! (dw/group-to-bool (:id head) bool-type))
+               (st/emit! (dwb/group-to-bool (:id head) bool-type))
 
                (and (= (count selected) 1) is-bool?)
                (if (= head-bool-type bool-type)
-                 (st/emit! (dw/bool-to-group (:id head)))
+                 (st/emit! (dwb/bool-to-group (:id head)))
-                 (st/emit! (dw/change-bool-type (:id head) bool-type)))))))
+                 (st/emit! (dwb/change-bool-type (:id head) bool-type)))))))
 
-        flatten-objects (mf/use-fn  #(st/emit! (dw/convert-selected-to-path)))]
+        flatten-objects
+        (mf/use-fn  #(st/emit! (dwps/convert-selected-to-path)))]
 
     (when (not (and disabled-bool-btns disabled-flatten))
       [:div {:class (stl/css :boolean-options)}

frontend/src/app/main/ui/workspace/sidebar/options/shapes/bool.cljs

@@ -46,6 +46,7 @@
         ids (hooks/use-equal-memo ids)
         parents-by-ids-ref (mf/use-memo (mf/deps ids) #(refs/parents-by-ids ids))
         parents (mf/deref parents-by-ids-ref)]
+
     [:*
      [:& layer-menu {:ids ids
                      :type type

frontend/src/app/main/ui/workspace/sidebar/options/shapes/multiple.cljs

@@ -12,6 +12,7 @@
    [app.common.geom.shapes :as gsh]
    [app.common.text :as txt]
    [app.common.types.component :as ctk]
+   [app.common.types.path :as path]
    [app.common.types.shape.attrs :refer [editable-attrs]]
    [app.common.types.shape.layout :as ctl]
    [app.main.refs :as refs]
@@ -294,7 +295,7 @@
         file-id (unchecked-get props "file-id")
         shared-libs (unchecked-get props "libraries")
 
-        show-caps (some #(and (= :path (:type %)) (gsh/open-path? %)) shapes)
+        show-caps (some #(and (= :path (:type %)) (path/shape-with-open-path? %)) shapes)
 
         ;; Selrect/points only used for measures and it's the one that changes the most. We separate it
         ;; so we can memoize it

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

@@ -24,6 +24,7 @@
    [app.main.ui.measurements :as msr]
    [app.main.ui.shapes.export :as use]
    [app.main.ui.workspace.shapes :as shapes]
+   [app.main.ui.workspace.shapes.path.editor :refer [path-editor*]]
    [app.main.ui.workspace.shapes.text.editor :as editor-v1]
    [app.main.ui.workspace.shapes.text.text-edition-outline :refer [text-edition-outline]]
    [app.main.ui.workspace.shapes.text.v2-editor :as editor-v2]
@@ -116,7 +117,9 @@
         objects-modified  (mf/with-memo [base-objects text-modifiers modifiers]
                             (apply-modifiers-to-selected selected base-objects text-modifiers modifiers))
 
-        selected-shapes   (keep (d/getf objects-modified) selected)
+        selected-shapes   (->> selected
+                               (into [] (keep (d/getf objects-modified)))
+                               (not-empty))
 
         ;; STATE
         alt?              (mf/use-state false)
@@ -164,15 +167,18 @@
 
         editing-shape     (when edition (get base-objects edition))
 
-        create-comment?   (= :comments drawing-tool)
+        edit-path         (get edit-path edition)
-        drawing-path?     (or (and edition (= :draw (get-in edit-path [edition :edit-mode])))
+        edit-path-mode    (get edit-path :edit-mode)
-                              (and (some? drawing-obj) (= :path (:type drawing-obj))))
-        node-editing?     (and edition (= :path (get-in base-objects [edition :type])))
-        text-editing?     (and edition (= :text (get-in base-objects [edition :type])))
 
+        create-comment?   (= :comments drawing-tool)
+        drawing-path?     (or (= edit-path-mode :draw)
+                              (= :path (get drawing-obj :type)))
+
+        node-editing?     (cfh/path-shape? editing-shape)
+        text-editing?     (cfh/text-shape? editing-shape)
         grid-editing?     (and edition (ctl/grid-layout? base-objects edition))
 
-        mode-inspect?       (= options-mode :inspect)
+        mode-inspect?     (= options-mode :inspect)
 
         on-click          (actions/on-click hover selected edition drawing-path? drawing-tool space? selrect z?)
         on-context-menu   (actions/on-context-menu hover hover-ids read-only?)
@@ -282,7 +288,12 @@
 
     [:div {:class (stl/css :viewport) :style #js {"--zoom" zoom} :data-testid "viewport"}
      (when (:can-edit permissions)
-       [:& top-bar/top-bar {:layout layout}])
+       [:> top-bar/top-bar* {:layout layout
+                             :selected selected-shapes
+                             :edit-path edit-path
+                             :drawing drawing
+                             :edition edition
+                             :is-read-only read-only?}])
      [:div {:class (stl/css :viewport-overlays)}
       ;; The behaviour inside a foreign object is a bit different that in plain HTML so we wrap
       ;; inside a foreign object "dummy" so this awkward behaviour is take into account
@@ -428,12 +439,13 @@
            :zoom zoom
            :modifiers modifiers}])
 
-       (when show-selection-handlers?
+       (when (and show-selection-handlers?
-         [:& selection/selection-area
+                  selected-shapes)
+         [:> selection/area*
           {:shapes selected-shapes
            :zoom zoom
            :edition edition
-           :disable-handlers (or drawing-tool edition @space? @mod?)
+           :disabled (or drawing-tool edition @space? @mod?)
            :on-move-selected on-move-selected
            :on-context-menu on-menu-selected}])
 
@@ -501,7 +513,7 @@
            :on-frame-select on-frame-select}])
 
        (when show-draw-area?
-         [:& drawarea/draw-area
+         [:> drawarea/draw-area*
           {:shape drawing-obj
            :zoom zoom
            :tool drawing-tool}])
@@ -603,12 +615,16 @@
 
        (when show-selection-handlers?
          [:g.selection-handlers {:clipPath "url(#clip-handlers)"}
-          [:& selection/selection-handlers
+          (when-not text-editing?
-           {:selected selected
+            (if editing-shape
-            :shapes selected-shapes
+              [:> path-editor* {:shape editing-shape
-            :zoom zoom
+                                :zoom zoom}]
-            :edition edition
+              (when selected-shapes
-            :disable-handlers (or drawing-tool edition @space?)}]
+                [:> selection/handlers*
+                 {:selected selected
+                  :shapes selected-shapes
+                  :zoom zoom
+                  :disabled (or drawing-tool @space?)}])))
 
           (when show-prototypes?
             [:& interactions/interactions

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

@@ -227,8 +227,9 @@
                           (dw/start-editing-selected))
 
                 (some? selected-shape)
-                (do (reset! hover selected-shape)
+                (do
-                    (st/emit! (dw/select-shape (:id selected-shape))))
+                  (reset! hover selected-shape)
+                  (st/emit! (dw/select-shape (:id selected-shape))))
 
                 (and (not selected-shape) (some? grid-layout-id) (not read-only?))
                 (st/emit! (dw/start-edition-mode grid-layout-id)))))))))))

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

@@ -11,29 +11,13 @@
    [app.common.types.shape :as cts]
    [app.main.ui.shapes.path :refer [path-shape]]
    [app.main.ui.workspace.shapes :as shapes]
-   [app.main.ui.workspace.shapes.path.editor :refer [path-editor]]
+   [app.main.ui.workspace.shapes.path.editor :refer [path-editor*]]
    [rumext.v2 :as mf]))
 
-(declare generic-draw-area)
+(mf/defc generic-draw-area*
-(declare path-draw-area)
+  {::mf/private true}
-
-(mf/defc draw-area
-  [{:keys [shape zoom tool] :as props}]
-
-  ;; Prevent rendering something that it's not a shape.
-  (when (cts/shape? shape)
-    [:g.draw-area
-     [:g {:style {:pointer-events "none"}}
-      [:& shapes/shape-wrapper {:shape shape}]]
-
-     (case tool
-       :path      [:& path-editor {:shape shape :zoom zoom}]
-       :curve     [:& path-shape {:shape shape :zoom zoom}]
-       #_:default [:& generic-draw-area {:shape shape :zoom zoom}])]))
-
-(mf/defc generic-draw-area
   [{:keys [shape zoom]}]
-  (let [{:keys [x y width height]} (:selrect shape)]
+  (let [{:keys [x y width height]} (get shape :selrect)]
     (when (and x y
                (not (mth/nan? x))
                (not (mth/nan? y)))
@@ -45,3 +29,17 @@
                            :fill "none"
                            :stroke-width (/ 1 zoom)}}])))
 
+(mf/defc draw-area*
+  [{:keys [shape zoom tool] :as props}]
+
+  ;; Prevent rendering something that it's not a shape.
+  (when (cts/shape? shape)
+    [:g.draw-area
+     [:g {:style {:pointer-events "none"}}
+      [:& shapes/shape-wrapper {:shape shape}]]
+
+     (case tool
+       :path      [:> path-editor* props]
+       :curve     [:& path-shape {:shape shape :zoom zoom}]
+       #_:default [:> generic-draw-area* props])]))
+

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

@@ -8,7 +8,6 @@
   (:require
    [app.common.data :as d]
    [app.common.data.macros :as dm]
-   [app.common.exceptions :as ex]
    [app.common.files.helpers :as cfh]
    [app.common.geom.shapes :as gsh]
    [app.common.types.component :as ctk]
@@ -17,7 +16,6 @@
    [app.main.ui.hooks :as hooks]
    [app.main.ui.shapes.attrs :as attrs]
    [app.util.object :as obj]
-   [app.util.path.format :as upf]
    [clojure.set :as set]
    [rumext.v2 :as mf]))
 
@@ -51,7 +49,7 @@
         path-data
         (mf/with-memo [path? content]
           (when (and ^boolean path? (some? content))
-            (d/nilv (ex/ignoring (upf/format-path content)) "")))
+            (.toString content)))
 
         border-attrs
         (attrs/get-border-props shape)

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

@@ -7,16 +7,14 @@
 (ns app.main.ui.workspace.viewport.path-actions
   (:require-macros [app.main.style :as stl])
   (:require
+   [app.common.types.path.segment :as path.segm]
    [app.main.data.workspace.path :as drp]
    [app.main.data.workspace.path.shortcuts :as sc]
    [app.main.store :as st]
    [app.main.ui.icons :as i]
-   [app.main.ui.workspace.shapes.path.common :as pc]
    [app.util.i18n :as i18n :refer [tr]]
-   [app.util.path.tools :as upt]
    [rumext.v2 :as mf]))
 
-
 (def ^:private pentool-icon
   (i/icon-xref :pentool (stl/css :pentool-icon :pathbar-icon)))
 
@@ -47,9 +45,8 @@
 (def ^:private snap-nodes-icon
   (i/icon-xref :snap-nodes (stl/css :snap-nodes-icon :pathbar-icon)))
 
-
 (defn check-enabled [content selected-points]
-  (let [segments (upt/get-segments content selected-points)
+  (let [segments (path.segm/get-segments-with-points content selected-points)
         num-segments (count segments)
         num-points (count selected-points)
         points-selected? (seq selected-points)
@@ -58,7 +55,7 @@
         max-segments (-> num-points
                          (* (- num-points 1))
                          (/ 2))
-        is-curve? (some #(upt/is-curve? content %) selected-points)]
+        is-curve? (some #(path.segm/is-curve? content %) selected-points)]
 
     {:make-corner (and points-selected? is-curve?)
      :make-curve (and points-selected? (not is-curve?))
@@ -68,9 +65,10 @@
      :join-nodes (and points-selected? (>= num-points 2) (< num-segments max-segments))
      :separate-nodes segments-selected?}))
 
+(mf/defc path-actions*
+  [{:keys [shape edit-path]}]
+  (let [{:keys [edit-mode selected-points snap-toggled]} edit-path
 
-(mf/defc path-actions [{:keys [shape]}]
-  (let [{:keys [edit-mode selected-points snap-toggled] :as all} (mf/deref pc/current-edit-path-ref)
         content (:content shape)
 
         enabled-buttons
@@ -79,66 +77,66 @@
          #(check-enabled content selected-points))
 
         on-select-draw-mode
-        (mf/use-callback
+        (mf/use-fn
          (fn [_]
            (st/emit! (drp/change-edit-mode :draw))))
 
         on-select-edit-mode
-        (mf/use-callback
+        (mf/use-fn
          (fn [_]
            (st/emit! (drp/change-edit-mode :move))))
 
         on-add-node
-        (mf/use-callback
+        (mf/use-fn
          (mf/deps (:add-node enabled-buttons))
          (fn [_]
            (when (:add-node enabled-buttons)
              (st/emit! (drp/add-node)))))
 
         on-remove-node
-        (mf/use-callback
+        (mf/use-fn
          (mf/deps (:remove-node enabled-buttons))
          (fn [_]
            (when (:remove-node enabled-buttons)
              (st/emit! (drp/remove-node)))))
 
         on-merge-nodes
-        (mf/use-callback
+        (mf/use-fn
          (mf/deps (:merge-nodes enabled-buttons))
          (fn [_]
            (when (:merge-nodes enabled-buttons)
              (st/emit! (drp/merge-nodes)))))
 
         on-join-nodes
-        (mf/use-callback
+        (mf/use-fn
          (mf/deps (:join-nodes enabled-buttons))
          (fn [_]
            (when (:join-nodes enabled-buttons)
              (st/emit! (drp/join-nodes)))))
 
         on-separate-nodes
-        (mf/use-callback
+        (mf/use-fn
          (mf/deps (:separate-nodes enabled-buttons))
          (fn [_]
            (when (:separate-nodes enabled-buttons)
              (st/emit! (drp/separate-nodes)))))
 
         on-make-corner
-        (mf/use-callback
+        (mf/use-fn
          (mf/deps (:make-corner enabled-buttons))
          (fn [_]
            (when (:make-corner enabled-buttons)
              (st/emit! (drp/make-corner)))))
 
         on-make-curve
-        (mf/use-callback
+        (mf/use-fn
          (mf/deps (:make-curve enabled-buttons))
          (fn [_]
            (when (:make-curve enabled-buttons)
              (st/emit! (drp/make-curve)))))
 
         on-toggle-snap
-        (mf/use-callback
+        (mf/use-fn
          (fn [_]
            (st/emit! (drp/toggle-snap))))]
 

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

@@ -20,7 +20,6 @@
    [app.main.store :as st]
    [app.main.ui.context :as ctx]
    [app.main.ui.css-cursors :as cur]
-   [app.main.ui.workspace.shapes.path.editor :refer [path-editor]]
    [app.util.array :as array]
    [app.util.debug :as dbg]
    [app.util.dom :as dom]
@@ -314,9 +313,8 @@
              :style {:fill (if (dbg/enabled? :handlers) "yellow" "none")
                      :stroke-width 0}}]]))
 
-(mf/defc controls-selection
+(mf/defc controls-selection*
-  {::mf/wrap-props false}
+  [{:keys [shape zoom color on-move-selected on-context-menu disabled]}]
-  [{:keys [shape zoom color on-move-selected on-context-menu disable-handlers]}]
   (let [selrect        (dm/get-prop shape :selrect)
         transform-type (mf/deref refs/current-transform)
         sr-transform   (mf/deref refs/workspace-selrect-transform)
@@ -330,7 +328,7 @@
     (when (and (some? selrect)
                (not (or (= transform-type :move)
                         (= transform-type :rotate))))
-      [:g.controls {:pointer-events (if ^boolean disable-handlers "none" "visible")}
+      [:g.controls {:pointer-events (if ^boolean disabled "none" "visible")}
        ;; Selection rect
        [:& selection-rect {:rect selrect
                            :transform transform
@@ -339,9 +337,9 @@
                            :on-move-selected on-move-selected
                            :on-context-menu on-context-menu}]])))
 
-(mf/defc controls-handlers
+(mf/defc controls-handlers*
-  {::mf/wrap-props false}
+  {::mf/private true}
-  [{:keys [shape zoom color on-resize on-rotate disable-handlers]}]
+  [{:keys [shape zoom color on-resize on-rotate disabled]}]
   (let [transform-type (mf/deref refs/current-transform)
         sr-transform  (mf/deref refs/workspace-selrect-transform)
 
@@ -370,7 +368,7 @@
                (not (or (= transform-type :move)
                         (= transform-type :rotate))))
 
-      [:g.controls {:pointer-events (if ^boolean disable-handlers "none" "visible")}
+      [:g.controls {:pointer-events (if ^boolean disabled "none" "visible")}
        (for [handler (calculate-handlers selrect shape zoom)]
          (let [type     (obj/get handler "type")
                position (obj/get handler "position")
@@ -425,9 +423,9 @@
                           :stroke-opacity 1
                           :fill "none"}}]]))
 
-(mf/defc multiple-handlers
+(mf/defc multiple-handlers*
-  {::mf/wrap-props false}
+  {::mf/private true}
-  [{:keys [shapes selected zoom color disable-handlers]}]
+  [{:keys [shapes selected zoom color disabled]}]
   (let [shape (mf/with-memo [shapes]
                 (-> shapes
                     (gsh/shapes->rect)
@@ -452,34 +450,34 @@
              (dom/stop-propagation event)
              (st/emit! (dw/start-rotate shapes)))))]
 
-    [:& controls-handlers
+    [:> controls-handlers*
      {:shape shape
       :zoom zoom
       :color color
-      :disable-handlers disable-handlers
+      :disabled disabled
       :on-resize on-resize
       :on-rotate on-rotate}]))
 
-(mf/defc multiple-selection
+(mf/defc multiple-selection*
-  {::mf/wrap-props false}
+  {::mf/private true}
-  [{:keys [shapes zoom color disable-handlers on-move-selected on-context-menu]}]
+  [{:keys [shapes zoom color disabled on-move-selected on-context-menu]}]
   (let [shape (mf/with-memo [shapes]
                 (-> shapes
                     (gsh/shapes->rect)
                     (assoc :type :multiple)
                     (cts/setup-shape)))]
 
-    [:& controls-selection
+    [:> controls-selection*
      {:shape shape
       :zoom zoom
       :color color
-      :disable-handlers disable-handlers
+      :disabled disabled
       :on-move-selected on-move-selected
       :on-context-menu on-context-menu}]))
 
-(mf/defc single-handlers
+(mf/defc single-handlers*
-  {::mf/wrap-props false}
+  {::mf/private true}
-  [{:keys [shape zoom color disable-handlers]}]
+  [{:keys [shape zoom color disabled]}]
   (let [shape-id (dm/get-prop shape :id)
 
         on-resize
@@ -501,28 +499,27 @@
              (dom/stop-propagation event)
              (st/emit! (dw/start-rotate [shape])))))]
 
-    [:& controls-handlers
+    [:> controls-handlers*
      {:shape shape
       :zoom zoom
       :color color
-      :disable-handlers disable-handlers
+      :disabled disabled
       :on-rotate on-rotate
       :on-resize on-resize}]))
 
-(mf/defc single-selection
+(mf/defc single-selection*
-  {::mf/wrap-props false}
+  {::mf/private true}
-  [{:keys [shape zoom color disable-handlers on-move-selected on-context-menu]}]
+  [{:keys [shape zoom color disabled on-move-selected on-context-menu]}]
-  [:& controls-selection
+  [:> controls-selection*
    {:shape shape
     :zoom zoom
     :color color
-    :disable-handlers disable-handlers
+    :disabled disabled
     :on-move-selected on-move-selected
     :on-context-menu on-context-menu}])
 
-(mf/defc selection-area
+(mf/defc area*
-  {::mf/wrap-props false}
+  [{:keys [shapes edition zoom disabled on-move-selected on-context-menu]}]
-  [{:keys [shapes edition zoom disable-handlers on-move-selected on-context-menu]}]
   (let [total    (count shapes)
 
         shape    (first shapes)
@@ -538,15 +535,12 @@
                   selection-rect-color-normal)]
 
     (cond
-      (zero? total)
-      nil
-
       (> total 1)
-      [:& multiple-selection
+      [:> multiple-selection*
        {:shapes shapes
         :zoom zoom
         :color color
-        :disable-handlers disable-handlers
+        :disabled disabled
         :on-move-selected on-move-selected
         :on-context-menu on-context-menu}]
 
@@ -561,55 +555,38 @@
       nil
 
       :else
-      [:& single-selection
+      [:> single-selection*
        {:shape shape
         :zoom zoom
         :color color
-        :disable-handlers disable-handlers
+        :disabled disabled
         :on-move-selected on-move-selected
         :on-context-menu on-context-menu}])))
 
-(mf/defc selection-handlers
+(mf/defc handlers*
-  {::mf/wrap-props false}
+  [{:keys [shapes selected zoom disabled]}]
-  [{:keys [shapes selected edition zoom disable-handlers]}]
   (let [total    (count shapes)
-
         shape    (first shapes)
-        shape-id (dm/get-prop shape :id)
 
         ;; Note that we don't use mf/deref to avoid a repaint dependency here
         objects (deref refs/workspace-page-objects)
 
-        color   (if (and (= total 1) ^boolean
+        color   (if (and (= total 1)
+                         ^boolean
                          (or (ctn/in-any-component? objects shape)
                              (ctk/is-variant-container? shape)))
                   selection-rect-color-component
                   selection-rect-color-normal)]
 
-    (cond
+    (if (> total 1)
-      (zero? total)
+      [:> multiple-handlers*
-      nil
-
-      (> total 1)
-      [:& multiple-handlers
        {:shapes shapes
         :selected selected
         :zoom zoom
         :color color
-        :disable-handlers disable-handlers}]
+        :disabled disabled}]
-
+      [:> single-handlers*
-      (and (cfh/text-shape? shape)
-           (= edition shape-id))
-      nil
-
-      (= edition shape-id)
-      [:& path-editor
-       {:zoom zoom
-        :shape shape}]
-
-      :else
-      [:& single-handlers
        {:shape shape
         :zoom zoom
         :color color
-        :disable-handlers disable-handlers}])))
+        :disabled disabled}])))

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

@@ -7,23 +7,22 @@
 (ns app.main.ui.workspace.viewport.top-bar
   (:require-macros [app.main.style :as stl])
   (:require
+   [app.common.data.macros :as dm]
    [app.common.files.helpers :as cfh]
    [app.common.types.shape.layout :as ctl]
    [app.main.data.workspace :as dw]
    [app.main.data.workspace.common :as dwc]
-   [app.main.refs :as refs]
    [app.main.store :as st]
-   [app.main.ui.context :as ctx]
    [app.main.ui.workspace.top-toolbar :refer [top-toolbar]]
    [app.main.ui.workspace.viewport.grid-layout-editor :refer [grid-edition-actions]]
-   [app.main.ui.workspace.viewport.path-actions :refer [path-actions]]
+   [app.main.ui.workspace.viewport.path-actions :refer [path-actions*]]
    [app.util.i18n :as i18n :refer [tr]]
    [rumext.v2 :as mf]))
 
-(mf/defc view-only-actions
+(mf/defc view-only-actions*
   []
   (let [handle-close-view-mode
-        (mf/use-callback
+        (mf/use-fn
          (fn []
            (st/emit! :interrupt
                      (dw/set-options-mode :design)
@@ -38,43 +37,44 @@
                 :on-click handle-close-view-mode}
        (tr "workspace.top-bar.read-only.done")]]]))
 
-(mf/defc top-bar
+(mf/defc top-bar*
-  {::mf/wrap [mf/memo]}
+  [{:keys [layout drawing is-read-only edition selected edit-path]}]
-  [{:keys [layout]}]
+  (let [rulers?     (contains? layout :rulers)
-  (let [edition     (mf/deref refs/selected-edition)
+        hide-ui?    (contains? layout :hide-ui)
-        selected    (mf/deref refs/selected-objects)
+
-        drawing     (mf/deref refs/workspace-drawing)
+        drawing-obj (get drawing :object)
-        rulers?     (mf/deref refs/rulers?)
-        drawing-obj (:object drawing)
         shape       (or drawing-obj (-> selected first))
+        shape-id    (dm/get-prop shape :id)
 
-        single? (= (count selected) 1)
+        single?     (= (count selected) 1)
-        editing? (= (:id shape) edition)
+        editing?    (= shape-id edition)
-        draw-path? (and (some? drawing-obj)
-                        (cfh/path-shape? drawing-obj)
-                        (not= :curve (:tool drawing)))
 
-        workspace-read-only? (mf/use-ctx ctx/workspace-read-only?)
+        draw-path?  (and (some? drawing-obj)
-        hide-ui?       (:hide-ui layout)
+                         (cfh/path-shape? drawing-obj)
+                         (not= :curve (:tool drawing)))
 
-        path-edition? (or (and single? editing?
+        is-path-edition
-                               (and (not (cfh/text-shape? shape))
+        (or (and single? editing?
-                                    (not (cfh/frame-shape? shape))))
+                 (and (not (cfh/text-shape? shape))
-                          draw-path?)
+                      (not (cfh/frame-shape? shape))))
+            draw-path?)
 
-        grid-edition? (and single? editing? (ctl/grid-layout? shape))]
+        grid-edition?
+        (and single? editing? (ctl/grid-layout? shape))]
 
     [:*
-     (when-not hide-ui?
+     (when-not ^boolean hide-ui?
        [:& top-toolbar {:layout layout}])
 
      (cond
-       workspace-read-only?
+       ^boolean
-       [:& view-only-actions]
+       is-read-only
+       [:> view-only-actions*]
 
-       path-edition?
+       ^boolean
+       is-path-edition
        [:div {:class (stl/css-case :viewport-actions-path true :viewport-actions-no-rulers (not rulers?))}
-        [:& path-actions {:shape shape}]]
+        [:> path-actions* {:shape shape :edit-path edit-path}]]
 
        grid-edition?
        [:& grid-edition-actions {:shape shape}])]))

frontend/src/app/main/ui/workspace/viewport_wasm.cljs

@@ -23,6 +23,7 @@
    [app.main.ui.flex-controls :as mfc]
    [app.main.ui.hooks :as ui-hooks]
    [app.main.ui.measurements :as msr]
+   [app.main.ui.workspace.shapes.path.editor :refer [path-editor*]]
    [app.main.ui.workspace.shapes.text.editor :as editor-v1]
    [app.main.ui.workspace.shapes.text.text-edition-outline :refer [text-edition-outline]]
    [app.main.ui.workspace.shapes.text.v2-editor :as editor-v2]
@@ -119,8 +120,9 @@
                             (binding [cts/*wasm-sync* false]
                               (apply-modifiers-to-selected selected base-objects text-modifiers modifiers)))
 
-        selected-shapes   (keep (d/getf objects-modified) selected)
+        selected-shapes   (->> selected
-
+                               (into [] (keep (d/getf objects-modified)))
+                               (not-empty))
         ;; STATE
         alt?              (mf/use-state false)
         shift?            (mf/use-state false)
@@ -173,14 +175,18 @@
 
         editing-shape     (when edition (get base-objects edition))
 
+        edit-path         (get edit-path edition)
+        edit-path-mode    (get edit-path :edit-mode)
+
         create-comment?   (= :comments drawing-tool)
-        drawing-path?     (or (and edition (= :draw (get-in edit-path [edition :edit-mode])))
+        drawing-path?     (or (= edit-path-mode :draw)
-                              (and (some? drawing-obj) (= :path (:type drawing-obj))))
+                              (= :path (get drawing-obj :type)))
-        node-editing?     (and edition (= :path (get-in base-objects [edition :type])))
+
-        text-editing?     (and edition (= :text (get-in base-objects [edition :type])))
+        node-editing?     (cfh/path-shape? editing-shape)
+        text-editing?     (cfh/text-shape? editing-shape)
         grid-editing?     (and edition (ctl/grid-layout? base-objects edition))
 
-        mode-inspect?       (= options-mode :inspect)
+        mode-inspect?     (= options-mode :inspect)
 
         on-click          (actions/on-click hover selected edition drawing-path? drawing-tool space? selrect z?)
         on-context-menu   (actions/on-context-menu hover hover-ids read-only?)
@@ -338,7 +344,12 @@
 
     [:div {:class (stl/css :viewport) :style #js {"--zoom" zoom} :data-testid "viewport"}
      (when (:can-edit permissions)
-       [:& top-bar/top-bar {:layout layout}])
+       [:> top-bar/top-bar* {:layout layout
+                             :selected selected-shapes
+                             :edit-path edit-path
+                             :drawing drawing
+                             :edition edition
+                             :is-read-only read-only?}])
      [:div {:class (stl/css :viewport-overlays)}
       (when show-comments?
         [:> comments/comments-layer* {:vbox vbox
@@ -434,12 +445,13 @@
            :zoom zoom
            :modifiers modifiers}])
 
-       (when show-selection-handlers?
+       (when (and show-selection-handlers?
-         [:& selection/selection-area
+                  selected-shapes)
+         [:> selection/area*
           {:shapes selected-shapes
            :zoom zoom
            :edition edition
-           :disable-handlers (or drawing-tool edition @space? @mod?)
+           :disabled (or drawing-tool edition @space? @mod?)
            :on-move-selected on-move-selected
            :on-context-menu on-menu-selected}])
 
@@ -507,7 +519,7 @@
            :on-frame-select on-frame-select}])
 
        (when show-draw-area?
-         [:& drawarea/draw-area
+         [:> drawarea/draw-area*
           {:shape drawing-obj
            :zoom zoom
            :tool drawing-tool}])
@@ -609,12 +621,16 @@
 
        (when show-selection-handlers?
          [:g.selection-handlers {:clipPath "url(#clip-handlers)"}
-          [:& selection/selection-handlers
+          (when-not text-editing?
-           {:selected selected
+            (if editing-shape
-            :shapes selected-shapes
+              [:> path-editor* {:shape editing-shape
-            :zoom zoom
+                                :zoom zoom}]
-            :edition edition
+              (when selected-shapes
-            :disable-handlers (or drawing-tool edition @space?)}]
+                [:> selection/handlers*
+                 {:selected selected
+                  :shapes selected-shapes
+                  :zoom zoom
+                  :disabled (or drawing-tool @space?)}])))
 
           (when show-prototypes?
             [:& interactions/interactions

frontend/src/app/plugins/api.cljs

@@ -376,10 +376,10 @@
           (u/display-not-valid :createBoolean-shapes shapes)
 
           :else
-          (let [ids (into #{} (map #(obj/get % "$id")) shapes)
+          (let [ids      (into #{} (map #(obj/get % "$id")) shapes)
-                id-ret (atom nil)]
+                shape-id (uuid/next)]
-            (st/emit! (dwb/create-bool bool-type ids {:id-ret id-ret}))
+            (st/emit! (dwb/create-bool bool-type :ids ids :force-shape-id shape-id))
-            (shape/shape-proxy plugin-id @id-ret)))))
+            (shape/shape-proxy plugin-id shape-id)))))
 
     :generateMarkup
     (fn [shapes options]

frontend/src/app/plugins/shape.cljs

@@ -15,18 +15,19 @@
    [app.common.record :as crc]
    [app.common.schema :as sm]
    [app.common.spec :as us]
-   [app.common.svg.path :as path]
+   [app.common.svg.path :as svg.path]
    [app.common.text :as txt]
    [app.common.types.component :as ctk]
    [app.common.types.container :as ctn]
    [app.common.types.file :as ctf]
    [app.common.types.grid :as ctg]
+   [app.common.types.path :as path]
+   [app.common.types.path.segment :as path.segm]
    [app.common.types.shape :as cts]
    [app.common.types.shape.blur :as ctsb]
    [app.common.types.shape.export :as ctse]
    [app.common.types.shape.interactions :as ctsi]
    [app.common.types.shape.layout :as ctl]
-   [app.common.types.shape.path :as ctsp]
    [app.common.types.shape.radius :as ctsr]
    [app.common.types.shape.shadow :as ctss]
    [app.common.uuid :as uuid]
@@ -50,7 +51,6 @@
    [app.plugins.text :as text]
    [app.plugins.utils :as u]
    [app.util.object :as obj]
-   [app.util.path.format :as upf]
    [beicon.v2.core :as rx]
    [cuerdas.core :as str]))
 
@@ -1018,7 +1018,7 @@
                  (u/display-not-valid :makeMask (:type shape))
 
                  :else
-                 (upf/format-path (:content shape)))))
+                 (.toString (:content shape)))))
 
            ;; Text shapes
            :getRange
@@ -1309,21 +1309,22 @@
          (cond-> (or (cfh/path-shape? data) (cfh/bool-shape? data))
            (crc/add-properties!
             {:name "content"
-             :get #(-> % u/proxy->shape :content upf/format-path)
+             :get #(-> % u/proxy->shape :content .toString)
              :set
              (fn [_ value]
-               (let [content (->> (path/parse value))]
+               (let [content (svg.path/parse value)]
                  (cond
                    (not (cfh/path-shape? data))
                    (u/display-not-valid :content-type type)
 
-                   (not (sm/validate ::ctsp/content content))
+                   ;; FIXME: revisit path content validation
+                   (not (sm/validate ::path/content content))
                    (u/display-not-valid :content value)
 
                    (not (r/check-permission plugin-id "content:write"))
                    (u/display-not-valid :content "Plugin doesn't have 'content:write' permission")
 
                    :else
-                   (let [selrect  (gsh/content->selrect content)
+                   (let [selrect  (path.segm/content->selrect content)
                          points   (grc/rect->points selrect)]
                      (st/emit! (dwsh/update-shapes [id] (fn [shape] (assoc shape :content content :selrect selrect :points points))))))))}))))))

frontend/src/app/render_wasm/api.cljs

@@ -10,8 +10,8 @@
    ["react-dom/server" :as rds]
    [app.common.data :as d]
    [app.common.data.macros :as dm]
+   [app.common.types.path :as path]
    [app.common.types.shape.layout :as ctl]
-   [app.common.types.shape.path :as path]
    [app.common.uuid :as uuid]
    [app.config :as cf]
    [app.main.fonts :as fonts]
@@ -309,13 +309,14 @@
     (h/call wasm/internal-module "stringToUTF8" str offset size)
     (h/call wasm/internal-module "_set_shape_path_attrs" (count attrs))))
 
+;; FIXME: revisit on heap refactor is merged to use u32 instead u8
 (defn set-shape-path-content
   [content]
-  (let [pdata  (path/path-data content)
+  (let [pdata  (path/content content)
-        size   (* (count pdata) path/SEGMENT-BYTE-SIZE)
+        size   (path/get-byte-size content)
         offset (mem/alloc-bytes size)
         heap   (mem/get-heap-u8)]
-    (path/-write-to pdata (.-buffer heap) offset)
+    (path/write-to pdata (.-buffer heap) offset)
     (h/call wasm/internal-module "_set_shape_path_content")))
 
 (defn set-shape-svg-raw-content

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

@@ -1,137 +0,0 @@
-;; 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) KALEIDOS INC
-
-(ns app.util.path.format
-  (:require
-   [app.common.svg.path.command :as upc]
-   [app.common.svg.path.subpath :refer [pt=]]
-   [app.util.array :as arr]))
-
-;; TODO: move to common
-
-(def path-precision 3)
-
-(defn- join-params
-  ([a]
-   (js* "\"\"+~{}"
-        (.toFixed a path-precision)))
-  ([a b]
-   (js* "\"\"+~{}+\",\"+~{}"
-        (.toFixed a path-precision)
-        (.toFixed b path-precision)))
-  ([a b c]
-   (js* "\"\"+~{}+\",\"+~{}+\",\"+~{}"
-        (.toFixed a path-precision)
-        (.toFixed b path-precision)
-        (.toFixed c path-precision)))
-  ([a b c d]
-   (js* "\"\"+~{}+\",\"+~{}+\",\"+~{}+\",\"+~{}"
-        (.toFixed a path-precision)
-        (.toFixed b path-precision)
-        (.toFixed c path-precision)
-        (.toFixed d path-precision)))
-  ([a b c d e]
-   (js* "\"\"+~{}+\",\"+~{}+\",\"+~{}+\",\"+~{}+\",\"+~{}"
-        (.toFixed a path-precision)
-        (.toFixed b path-precision)
-        (.toFixed c path-precision)
-        (.toFixed d path-precision)
-        (.toFixed e path-precision)))
-  ([a b c d e f]
-   (js* "\"\"+~{}+\",\"+~{}+\",\"+~{}+\",\"+~{}+\",\"+~{}+\",\"+~{}"
-        (.toFixed a path-precision)
-        (.toFixed b path-precision)
-        (.toFixed c path-precision)
-        (.toFixed d path-precision)
-        (.toFixed e path-precision)
-        (.toFixed f path-precision)))
-  ([a b c d e f g]
-   (js* "\"\"+~{}+\",\"+~{}+\",\"+~{}+\",\"+~{}+\",\"+~{}+\",\"+~{}+\",\"+~{}"
-        (.toFixed a path-precision)
-        (.toFixed b path-precision)
-        (.toFixed c path-precision)
-        (.toFixed d path-precision)
-        (.toFixed e path-precision)
-        (.toFixed f path-precision)
-        (.toFixed g path-precision))))
-
-(defn- translate-params
-  [command {:keys [x y] :as params}]
-  (case command
-    (:move-to :line-to :smooth-quadratic-bezier-curve-to)
-    (join-params x y)
-
-    :close-path
-    ""
-
-    (:line-to-horizontal :line-to-vertical)
-    (:value params)
-
-    :curve-to
-    (let [{:keys [c1x c1y c2x c2y]} params]
-      (join-params (or c1x x) (or c1y y) (or c2x x) (or c2y y) x y))
-
-    (:smooth-curve-to :quadratic-bezier-curve-to)
-    (let [{:keys [cx cy]} params]
-      (join-params cx cy x y))
-
-    :elliptical-arc
-    (let [{:keys [rx ry x-axis-rotation large-arc-flag sweep-flag]} params]
-      (join-params rx ry x-axis-rotation large-arc-flag sweep-flag x y))
-
-    ""))
-
-(defn- translate-command
-  [cname]
-  (case cname
-    :move-to "M"
-    :close-path "Z"
-    :line-to "L"
-    :line-to-horizontal "H"
-    :line-to-vertical "V"
-    :curve-to "C"
-    :smooth-curve-to "S"
-    :quadratic-bezier-curve-to "Q"
-    :smooth-quadratic-bezier-curve-to "T"
-    :elliptical-arc "A"
-    ""))
-
-
-(defn- command->string
-  [{:keys [command relative params]}]
-  (let [cmd (cond-> (translate-command command)
-              relative (.toLowerCase))
-        prm (translate-params command params)]
-    (js* "~{} + ~{}" cmd prm)))
-
-(defn- set-point
-  [command {:keys [x y]}]
-  (update command :params assoc :x x :y y))
-
-(defn format-path [content]
-  (try
-    (let [result (make-array (count content))]
-      (reduce (fn [last-move current]
-                (let [point         (upc/command->point current)
-                      current-move? (= :move-to (:command current))
-                      last-move     (if current-move? point last-move)]
-
-                  (if (and (not current-move?) (pt= last-move point))
-                    (arr/conj! result (command->string (set-point current last-move)))
-                    (arr/conj! result (command->string current)))
-
-                  (when (and (not current-move?) (pt= last-move point))
-                    (arr/conj! result "Z"))
-
-                  last-move))
-              nil
-              content)
-      (.join ^js result ""))
-
-    (catch :default err
-      (.error js/console err)
-      nil)))
-

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

@@ -1,461 +0,0 @@
-;; 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) KALEIDOS INC
-
-(ns app.util.path.tools
-  (:require
-   [app.common.data :as d]
-   [app.common.geom.point :as gpt]
-   [app.common.geom.shapes.path :as upg]
-   [app.common.svg.path.command :as upc]
-   [clojure.set :as set]))
-
-;; FIXME: move to common, there are nothing tied to frontend
-
-(defn remove-line-curves
-  "Remove all curves that have both handlers in the same position that the
-  beginning and end points. This makes them really line-to commands"
-  [content]
-  (let [with-prev (d/enumerate (d/with-prev content))
-        process-command
-        (fn [content [index [command prev]]]
-
-          (let [cur-point (upc/command->point command)
-                pre-point (upc/command->point prev)
-                handler-c1 (upc/get-handler command :c1)
-                handler-c2 (upc/get-handler command :c2)]
-            (if (and (= :curve-to (:command command))
-                     (= cur-point handler-c2)
-                     (= pre-point handler-c1))
-              (assoc content index {:command :line-to
-                                    :params (into {} cur-point)})
-              content)))]
-
-    (reduce process-command content with-prev)))
-
-(defn make-corner-point
-  "Changes the content to make a point a 'corner'"
-  [content point]
-  (let [handlers (-> (upc/content->handlers content)
-                     (get point))
-        change-content
-        (fn [content [index prefix]]
-          (let [cx (d/prefix-keyword prefix :x)
-                cy (d/prefix-keyword prefix :y)]
-            (-> content
-                (assoc-in [index :params cx] (:x point))
-                (assoc-in [index :params cy] (:y point)))))]
-    (as-> content $
-      (reduce change-content $ handlers)
-      (remove-line-curves $))))
-
-(defn line->curve
-  [from-p cmd]
-
-  (let [to-p (upc/command->point cmd)
-
-        v (gpt/to-vec from-p to-p)
-        d (gpt/distance from-p to-p)
-
-        dv1 (-> (gpt/normal-left v)
-                (gpt/scale (/ d 3)))
-
-        h1 (gpt/add from-p dv1)
-
-        dv2 (-> (gpt/to-vec to-p h1)
-                (gpt/unit)
-                (gpt/scale (/ d 3)))
-
-        h2 (gpt/add to-p dv2)]
-    (-> cmd
-        (assoc :command :curve-to)
-        (update :params (fn [params]
-                          ;; ensure plain map
-                          (-> (into {} params)
-                              (assoc :c1x (:x h1))
-                              (assoc :c1y (:y h1))
-                              (assoc :c2x (:x h2))
-                              (assoc :c2y (:y h2))))))))
-
-(defn is-curve?
-  [content point]
-  (let [handlers (-> (upc/content->handlers content)
-                     (get point))
-        handler-points (map #(upc/handler->point content (first %) (second %)) handlers)]
-    (some #(not= point %) handler-points)))
-
-(def ^:private xf:mapcat-points
-  (comp
-   (mapcat #(vector (:next-p %) (:prev-p %)))
-   (remove nil?)))
-
-(defn make-curve-point
-  "Changes the content to make the point a 'curve'. The handlers will be positioned
-  in the same vector that results from the previous->next points but with fixed length."
-  [content point]
-
-  (let [indices (upc/point-indices content point)
-        vectors (map (fn [index]
-                       (let [cmd (nth content index)
-                             prev-i (dec index)
-                             prev (when (not (= :move-to (:command cmd)))
-                                    (get content prev-i))
-                             next-i (inc index)
-                             next (get content next-i)
-
-                             next (when (not (= :move-to (:command next)))
-                                    next)]
-                         {:index index
-                          :prev-i (when (some? prev) prev-i)
-                          :prev-c prev
-                          :prev-p (upc/command->point prev)
-                          :next-i (when (some? next) next-i)
-                          :next-c next
-                          :next-p (upc/command->point next)
-                          :command cmd}))
-                     indices)
-
-        points (into #{} xf:mapcat-points vectors)]
-
-    (if (= (count points) 2)
-      (let [v1 (gpt/to-vec (first points) point)
-            v2 (gpt/to-vec (first points) (second points))
-            vp (gpt/project v1 v2)
-            vh (gpt/subtract v1 vp)
-
-            add-curve
-            (fn [content {:keys [index prev-p next-p next-i]}]
-              (let [cur-cmd (get content index)
-                    next-cmd (get content next-i)
-
-                    ;; New handlers for prev-point and next-point
-                    prev-h (when (some? prev-p) (gpt/add prev-p vh))
-                    next-h (when (some? next-p) (gpt/add next-p vh))
-
-                    ;; Correct 1/3 to the point improves the curve
-                    prev-correction (when (some? prev-h) (gpt/scale (gpt/to-vec prev-h point) (/ 1 3)))
-                    next-correction (when (some? next-h) (gpt/scale (gpt/to-vec next-h point) (/ 1 3)))
-
-                    prev-h (when (some? prev-h) (gpt/add prev-h prev-correction))
-                    next-h (when (some? next-h) (gpt/add next-h next-correction))]
-                (cond-> content
-                  (and (= :line-to (:command cur-cmd)) (some? prev-p))
-                  (update index upc/update-curve-to prev-p prev-h)
-
-                  (and (= :line-to (:command next-cmd)) (some? next-p))
-                  (update next-i upc/update-curve-to next-h next-p)
-
-                  (and (= :curve-to (:command cur-cmd)) (some? prev-p))
-                  (update index upc/update-handler :c2 prev-h)
-
-                  (and (= :curve-to (:command next-cmd)) (some? next-p))
-                  (update next-i upc/update-handler :c1 next-h))))]
-
-        (reduce add-curve content vectors))
-
-      (let [add-curve
-            (fn [content {:keys [index command prev-p next-c next-i]}]
-              (cond-> content
-                (= :line-to (:command command))
-                (update index #(line->curve prev-p %))
-
-                (= :curve-to (:command command))
-                (update index #(line->curve prev-p %))
-
-                (= :line-to (:command next-c))
-                (update next-i #(line->curve point %))
-
-                (= :curve-to (:command next-c))
-                (update next-i #(line->curve point %))))]
-        (reduce add-curve content vectors)))))
-
-(defn get-segments
-  "Given a content and a set of points return all the segments in the path
-  that uses the points"
-  [content points]
-  (let [point-set (set points)]
-
-    (loop [segments    []
-           prev-point  nil
-           start-point nil
-           index       0
-           cur-cmd     (first content)
-           content     (rest content)]
-
-      (let [command     (:command cur-cmd)
-            close-path? (= command :close-path)
-            move-to?    (= command :move-to)
-
-            ;; Close-path makes a segment from the last point to the initial path point
-            cur-point (if close-path?
-                        start-point
-                        (upc/command->point cur-cmd))
-
-            ;; If there is a move-to we don't have a segment
-            prev-point (if move-to?
-                         nil
-                         prev-point)
-
-            ;; We update the start point
-            start-point (if move-to?
-                          cur-point
-                          start-point)
-
-            is-segment? (and (some? prev-point)
-                             (contains? point-set prev-point)
-                             (contains? point-set cur-point))
-
-            segments (cond-> segments
-                       is-segment?
-                       (conj {:start prev-point
-                              :end cur-point
-                              :cmd cur-cmd
-                              :index index}))]
-
-        (if (some? cur-cmd)
-          (recur segments
-                 cur-point
-                 start-point
-                 (inc index)
-                 (first content)
-                 (rest content))
-
-          segments)))))
-
-(defn split-segments
-  "Given a content creates splits commands between points with new segments"
-  [content points value]
-
-  (let [split-command
-        (fn [{:keys [start end cmd index]}]
-          (case (:command cmd)
-            :line-to [index (upg/split-line-to start cmd value)]
-            :curve-to [index (upg/split-curve-to start cmd value)]
-            :close-path [index [(upc/make-line-to (gpt/lerp start end value)) cmd]]
-            nil))
-
-        cmd-changes
-        (->> (get-segments content points)
-             (into {} (comp (map split-command)
-                            (filter (comp not nil?)))))
-
-        process-segments
-        (fn [[index command]]
-          (if (contains? cmd-changes index)
-            (get cmd-changes index)
-            [command]))]
-
-    (into [] (mapcat process-segments) (d/enumerate content))))
-
-(defn remove-nodes
-  "Removes from content the points given. Will try to reconstruct the paths
-  to keep everything consistent"
-  [content points]
-
-  (if (empty? points)
-    content
-
-    (let [content (d/with-prev content)]
-
-      (loop [result []
-             last-handler nil
-             [cur-cmd prev-cmd] (first content)
-             content (rest content)]
-
-        (if (nil? cur-cmd)
-          ;; The result with be an array of arrays were every entry is a subpath
-          (->> result
-               ;; remove empty and only 1 node subpaths
-               (filter #(> (count %) 1))
-               ;; flatten array-of-arrays plain array
-               (flatten)
-               (into []))
-
-          (let [move? (= :move-to (:command cur-cmd))
-                curve? (= :curve-to (:command cur-cmd))
-
-                ;; When the old command was a move we start a subpath
-                result (if move? (conj result []) result)
-
-                subpath (peek result)
-
-                point (upc/command->point cur-cmd)
-
-                old-prev-point (upc/command->point prev-cmd)
-                new-prev-point (upc/command->point (peek subpath))
-
-                remove? (contains? points point)
-
-
-                ;; We store the first handler for the first curve to be removed to
-                ;; use it for the first handler of the regenerated path
-                cur-handler (cond
-                              (and (not last-handler) remove? curve?)
-                              (select-keys (:params cur-cmd) [:c1x :c1y])
-
-                              (not remove?)
-                              nil
-
-                              :else
-                              last-handler)
-
-                cur-cmd (cond-> cur-cmd
-                          ;; If we're starting a subpath and it's not a move make it a move
-                          (and (not move?) (empty? subpath))
-                          (assoc :command :move-to
-                                 :params (select-keys (:params cur-cmd) [:x :y]))
-
-                          ;; If have a curve the first handler will be relative to the previous
-                          ;; point. We change the handler to the new previous point
-                          (and curve? (seq subpath) (not= old-prev-point new-prev-point))
-                          (update :params merge last-handler))
-
-                head-idx (dec (count result))
-
-                result (cond-> result
-                         (not remove?)
-                         (update head-idx conj cur-cmd))]
-            (recur result
-                   cur-handler
-                   (first content)
-                   (rest content))))))))
-
-(defn join-nodes
-  "Creates new segments between points that weren't previously"
-  [content points]
-
-  (let [segments-set (into #{}
-                           (map (juxt :start :end))
-                           (get-segments content points))
-
-        create-line-command (fn [point other]
-                              [(upc/make-move-to point)
-                               (upc/make-line-to other)])
-
-        not-segment? (fn [point other] (and (not (contains? segments-set [point other]))
-                                            (not (contains? segments-set [other point]))))
-
-        new-content (->> (d/map-perm create-line-command not-segment? points)
-                         (flatten)
-                         (into []))]
-
-    (into content new-content)))
-
-
-(defn separate-nodes
-  "Removes the segments between the points given"
-  [content points]
-
-  (let [content (d/with-prev content)]
-    (loop [result []
-           [cur-cmd prev-cmd] (first content)
-           content (rest content)]
-
-      (if (nil? cur-cmd)
-        (->> result
-             (filter #(> (count %) 1))
-             (flatten)
-             (into []))
-
-        (let [prev-point (upc/command->point prev-cmd)
-              cur-point (upc/command->point cur-cmd)
-
-              cur-cmd (cond-> cur-cmd
-                        (and (contains? points prev-point)
-                             (contains? points cur-point))
-
-                        (assoc :command :move-to
-                               :params (select-keys (:params cur-cmd) [:x :y])))
-
-              move? (= :move-to (:command cur-cmd))
-
-              result (if move? (conj result []) result)
-              head-idx (dec (count result))
-
-              result (-> result
-                         (update head-idx conj cur-cmd))]
-          (recur result
-                 (first content)
-                 (rest content)))))))
-
-
-(defn- add-to-set
-  "Given a list of sets adds the value to the target set"
-  [set-list target value]
-  (->> set-list
-       (mapv (fn [it]
-               (cond-> it
-                 (= it target) (conj value))))))
-
-(defn- join-sets
-  "Given a list of sets join two sets in the list into a new one"
-  [set-list target other]
-  (conj (->> set-list
-             (filterv #(and (not= % target)
-                            (not= % other))))
-        (set/union target other)))
-
-(defn group-segments [segments]
-  (loop [result []
-         {point-a :start point-b :end :as segment} (first segments)
-         segments (rest segments)]
-
-    (if (nil? segment)
-      result
-
-      (let [set-a (d/seek #(contains? % point-a) result)
-            set-b (d/seek #(contains? % point-b) result)
-
-            result (cond-> result
-                     (and (nil? set-a) (nil? set-b))
-                     (conj #{point-a point-b})
-
-                     (and (some? set-a) (nil? set-b))
-                     (add-to-set set-a point-b)
-
-                     (and (nil? set-a) (some? set-b))
-                     (add-to-set set-b point-a)
-
-                     (and (some? set-a) (some? set-b) (not= set-a set-b))
-                     (join-sets set-a set-b))]
-        (recur result
-               (first segments)
-               (rest segments))))))
-
-(defn calculate-merge-points [group-segments points]
-  (let [index-merge-point (fn [group] (vector group (gpt/center-points group)))
-        index-group (fn [point] (vector point (d/seek #(contains? % point) group-segments)))
-
-        group->merge-point (into {} (map index-merge-point) group-segments)
-        point->group (into {} (map index-group) points)]
-    (d/mapm #(group->merge-point %2) point->group)))
-
-;; TODO: Improve the replace for curves
-(defn replace-points
-  "Replaces the points in a path for its merge-point"
-  [content point->merge-point]
-  (let [replace-command
-        (fn [cmd]
-          (let [point (upc/command->point cmd)]
-            (if (contains? point->merge-point point)
-              (let [merge-point (get point->merge-point point)]
-                (-> cmd (update :params assoc :x (:x merge-point) :y (:y merge-point))))
-              cmd)))]
-    (->> content
-         (mapv replace-command))))
-
-(defn merge-nodes
-  "Reduces the contiguous segments in points to a single point"
-  [content points]
-  (let [segments (get-segments content points)]
-    (if (seq segments)
-      (let [point->merge-point (-> segments
-                                   (group-segments)
-                                   (calculate-merge-points points))]
-        (-> content
-            (separate-nodes points)
-            (replace-points point->merge-point)))
-      content)))
-

frontend/src/app/worker/import.cljs

@@ -11,13 +11,13 @@
    [app.common.exceptions :as ex]
    [app.common.files.builder :as fb]
    [app.common.geom.point :as gpt]
-   [app.common.geom.shapes.path :as gpa]
    [app.common.json :as json]
    [app.common.logging :as log]
    [app.common.media :as cm]
    [app.common.schema :as sm]
    [app.common.text :as ct]
    [app.common.time :as tm]
+   [app.common.types.path :as path]
    [app.common.uuid :as uuid]
    [app.main.repo :as rp]
    [app.util.http :as http]
@@ -330,7 +330,7 @@
           (d/update-when :x + (:x frame))
           (d/update-when :y + (:y frame))
           (cond-> (= :path type)
-            (update :content gpa/move-content (gpt/point (:x frame) (:y frame)))))
+            (update :content path/move-content (gpt/point (:x frame) (:y frame)))))
 
       data)))
 

render-wasm/src/shapes/paths.rs

@@ -14,26 +14,26 @@ pub struct RawPathData {
 
 impl RawPathData {
     fn command(&self) -> Result<u16, String> {
-        let cmd = u16::from_be_bytes(self.data[0..2].try_into().map_err(stringify_slice_err)?);
+        let cmd = u16::from_le_bytes(self.data[0..2].try_into().map_err(stringify_slice_err)?);
         Ok(cmd)
     }
 
     fn xy(&self) -> Result<Point, String> {
-        let x = f32::from_be_bytes(self.data[20..24].try_into().map_err(stringify_slice_err)?);
+        let x = f32::from_le_bytes(self.data[20..24].try_into().map_err(stringify_slice_err)?);
-        let y = f32::from_be_bytes(self.data[24..].try_into().map_err(stringify_slice_err)?);
+        let y = f32::from_le_bytes(self.data[24..].try_into().map_err(stringify_slice_err)?);
         Ok((x, y))
     }
 
     fn c1(&self) -> Result<Point, String> {
-        let c1_x = f32::from_be_bytes(self.data[4..8].try_into().map_err(stringify_slice_err)?);
+        let c1_x = f32::from_le_bytes(self.data[4..8].try_into().map_err(stringify_slice_err)?);
-        let c1_y = f32::from_be_bytes(self.data[8..12].try_into().map_err(stringify_slice_err)?);
+        let c1_y = f32::from_le_bytes(self.data[8..12].try_into().map_err(stringify_slice_err)?);
 
         Ok((c1_x, c1_y))
     }
 
     fn c2(&self) -> Result<Point, String> {
-        let c2_x = f32::from_be_bytes(self.data[12..16].try_into().map_err(stringify_slice_err)?);
+        let c2_x = f32::from_le_bytes(self.data[12..16].try_into().map_err(stringify_slice_err)?);
-        let c2_y = f32::from_be_bytes(self.data[16..20].try_into().map_err(stringify_slice_err)?);
+        let c2_y = f32::from_le_bytes(self.data[16..20].try_into().map_err(stringify_slice_err)?);
 
         Ok((c2_x, c2_y))
     }