🐛 Fix url params on invitation link (#6638)

✨ Make the hash optional on binfile-v3

CHANGES.md

@@ -1,21 +1,25 @@
 # CHANGELOG
 
-## 2.8.0 (Next / Unreleased)
 
-### :rocket: Epics and highlights
-
-### :boom: Breaking changes & Deprecations
-
-### :heart: Community contributions (Thank you!)
-
-### :sparkles: New features
-
-- Optimize profile setup flow for better user experience [Taiga #10028](https://tree.taiga.io/project/penpot/us/10028)
+## 2.7.2 (Unreleased)
 
 ### :bug: Bugs fixed
 
+- Update plugins runtime [Github #6604](https://github.com/penpot/penpot/pull/6604)
+- Backport from develop a minor fix that enables import of files
+  generated by penpot library [Github #6614](https://github.com/penpot/penpot/pull/6614)
+- Fix copy in error message [GitHub #6615](https://github.com/penpot/penpot/pull/6615)
+- Fix url on invitation link [Taiga #11284](https://tree.taiga.io/project/penpot/issue/11284)
 
-## 2.7.0 (Unreleased)
+## 2.7.1
+
+### :bug: Bugs fixed
+
+- Fix incorrect handling of strokes with images on importing files
+- Fix tokens disappearing after manual additions [Taiga #11063](https://tree.taiga.io/project/penpot/issue/11063)
+
+
+## 2.7.0
 
 ### :rocket: Epics and highlights
 
@@ -23,6 +27,8 @@
 
 ### :heart: Community contributions (Thank you!)
 
+- Design improvements to the Invitations page with an empty state [GitHub #2608](https://github.com/penpot/penpot/issues/2608) by [@iprithvitharun](https://github.com/iprithvitharun)
+
 ### :sparkles: New features
 
 - Update board presets with a newer devices [Taiga #10610](https://tree.taiga.io/project/penpot/us/10610)
@@ -31,10 +37,11 @@
 - Duplicate token sets [Taiga #10694](https://tree.taiga.io/project/penpot/issue/10694)
 - Add set selection in create Token themes flow [Taiga #10746](https://tree.taiga.io/project/penpot/issue/10746)
 - Display indicator on not active sets [Taiga #10668](https://tree.taiga.io/project/penpot/issue/10668)
-- Create `input*` wrapper component, and `label*`, `input-field*` and `hint-message*` components [Taiga #10713](https://tree.taiga.io/project/penpot/us/10713)
-- Fix problem in viewer with the back button [Taiga #10907](https://tree.taiga.io/project/penpot/issue/10907)
 
 ### :bug: Bugs fixed
+
+- Fix "at" icon to match all icons on app [Taiga #11136](https://tree.taiga.io/project/penpot/issue/11136)
+- Fix problem in viewer with the back button [Taiga #10907](https://tree.taiga.io/project/penpot/issue/10907)
 - Fix resize bar background on tokens panel [Taiga #10811](https://tree.taiga.io/project/penpot/issue/10811)
 - Fix shortcut for history version panel [Taiga #11006](https://tree.taiga.io/project/penpot/issue/11006)
 - Fix positioning of comment drafts when near the right / bottom edges of viewport [Taiga #10534](https://tree.taiga.io/project/penpot/issue/10534)
@@ -59,8 +66,16 @@
 - Fix Color should preserve color space [Github #69](https://github.com/tokens-studio/penpot/issues/69)
 - Fix cannot rename Design Token Sets when group of same name exists [Taiga Issue #10773](https://tree.taiga.io/project/penpot/issue/10773)
 - Fix problem when duplicating grid layout [Github #6391](https://github.com/penpot/penpot/issues/6391)
+- Fix issue that makes workspace shortcuts stop working [Taiga #11062](https://tree.taiga.io/project/penpot/issue/11062)
+- Fix problem while syncing library colors and typographies [Taiga #11068](https://tree.taiga.io/project/penpot/issue/11068)
+- Fix problem with path edition of shapes [Taiga #9496](https://tree.taiga.io/project/penpot/issue/9496)
+- Fix exception on paste invalid html [Taiga #11047](https://tree.taiga.io/project/penpot/issue/11047)
+- Fix share button being displayed with no permissions [Taiga #11086](https://tree.taiga.io/project/penpot/issue/11086)
+- Fix inline styles in code tab [Taiga Issue #7583](https://tree.taiga.io/project/penpot/issue/7583)
+- Fix exception on returning openapi.json
+- Fix json encoding of TokensLib [Taiga #10994](https://tree.taiga.io/project/penpot/issue/10994)
 
-## 2.6.2 (Unreleased)
+## 2.6.2
 
 ### :bug: Bugs fixed
 

README.md

@@ -34,7 +34,7 @@
 
 <br />
 
-[Penpot video](https://github.com/penpot/penpot/assets/5446186/b8ad0764-585e-4ddc-b098-9b4090d337cc)
+[Penpot video](https://github.com/user-attachments/assets/08b83119-c090-4a74-86ed-7bfbdda9a793)
 
 <br />
 

backend/resources/app/email/request-file-access/en.txt

@@ -13,7 +13,7 @@ This will automatically include {{requested-by|abbreviate:25}} in the team, so t
 
 Click the link below to provide team access:
 
-{{ public-uri }}/#/dashboard/members?team-id{{team-id}}&invite-email={{requested-by-email|urlescape}}
+{{ public-uri }}/#/dashboard/members?team-id={{team-id}}&invite-email={{requested-by-email|urlescape}}
 
 
 

backend/scripts/manage.py

@@ -35,35 +35,40 @@ def get_prepl_conninfo():
 
     return host, port
 
-def send(data):
+def send_eval(expr):
     host, port = get_prepl_conninfo()
-    with socket.create_connection((host, port)) as s:
-        f = s.makefile(mode="rw")
 
-        json.dump(data, f)
-        f.write("\n")
-        f.flush()
+    with socket.socket(socket.AF_INET, socket.SOCK_STREAM) as s:
+        s.connect((host, port))
+        s.send(expr.encode("utf-8"))
+        s.send(b":repl/quit\n\n")
 
-        while True:
-            line = f.readline()
-            result = json.loads(line)
-            tag = result.get("tag", None)
+        with s.makefile() as f:
+            while True:
+                line = f.readline()
+                result = json.loads(line)
+                tag = result.get("tag", None)
+                if tag == "ret":
+                    return result.get("val", None), result.get("exception", None)
+                elif tag == "out":
+                    print(result.get("val"), end="")
+                else:
+                    raise RuntimeError("unexpected response from PREPL")
 
-            if tag == "ret":
-                return result.get("val", None), result.get("err", None)
-            elif tag == "out":
-                print(result.get("val"), end="")
-            else:
-                raise RuntimeError("unexpected response from PREPL")
+def encode(val):
+    return json.dumps(json.dumps(val))
 
-def print_error(error):
-    print("ERR:", error["hint"])
+def print_error(res):
+    for error in res["via"]:
+        print("ERR:", error["message"])
+        break
 
 def run_cmd(params):
     try:
-        res, err = send(params)
-        if err:
-            print_error(err)
+        expr = "(app.srepl.cli/exec {})".format(encode(params))
+        res, failed = send_eval(expr)
+        if failed:
+            print_error(res)
             sys.exit(-1)
 
         return res
@@ -91,7 +96,7 @@ def update_profile(email, fullname, password, is_active):
             "email": email,
             "fullname": fullname,
             "password": password,
-            "isActive": is_active
+            "is_active": is_active
         }
     }
 
@@ -133,7 +138,7 @@ def derive_password(password):
     params = {
         "cmd": "derive-password",
         "params": {
-            "password": password
+            "password": password,
         }
     }
 

backend/src/app/binfile/common.clj

@@ -434,12 +434,12 @@
                           (d/without-nils))))))
 
 (defn encode-file
-  [{:keys [::db/conn] :as cfg} {:keys [id features] :as file}]
-  (let [file (if (contains? features "fdata/objects-map")
+  [{:keys [::db/conn] :as cfg} {:keys [id] :as file}]
+  (let [file (if (contains? (:features file) "fdata/objects-map")
                (feat.fdata/enable-objects-map file)
                file)
 
-        file (if (contains? features "fdata/pointer-map")
+        file (if (contains? (:features file) "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/binfile/v3.clj

@@ -73,7 +73,7 @@
    [:size ::sm/int]
    [:content-type :string]
    [:bucket [::sm/one-of {:format :string} sto/valid-buckets]]
-   [:hash :string]])
+   [:hash {:optional true} :string]])
 
 (def ^:private schema:file-thumbnail
   [:map {:title "FileThumbnail"}
@@ -821,13 +821,14 @@
                       :expected-size (:size object)
                       :found-size (sto/get-size content)))
 
-          (when (not= (:hash object) (sto/get-hash content))
-            (ex/raise :type :validation
-                      :code :inconsistent-penpot-file
-                      :hint "found corrupted storage object: hash does not match"
-                      :path path
-                      :expected-hash (:hash object)
-                      :found-hash (sto/get-hash content)))
+          (when-let [hash (get object :hash)]
+            (when (not= hash (sto/get-hash content))
+              (ex/raise :type :validation
+                        :code :inconsistent-penpot-file
+                        :hint "found corrupted storage object: hash does not match"
+                        :path path
+                        :expected-hash (:hash object)
+                        :found-hash (sto/get-hash content))))
 
           (let [params  (-> object
                             (dissoc :id :size)

backend/src/app/db.clj

@@ -42,8 +42,6 @@
    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,6 +20,7 @@
    [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]
@@ -35,9 +36,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]
@@ -126,10 +127,10 @@
   (sm/lazy-validator ::ctsx/content))
 
 (def valid-path-content?
-  (sm/lazy-validator ::path/segments))
+  (sm/lazy-validator ::ctsp/content))
 
 (def valid-path-segment?
-  (sm/lazy-validator ::path/segment))
+  (sm/lazy-validator ::ctsp/segment))
 
 (def valid-rgb-color-string?
   (sm/lazy-validator ::ctc/rgb-color))
@@ -579,10 +580,12 @@
                       (let [shape (update shape :content fix-path-content)]
                         (if (not (valid-path-content? (:content shape)))
                           shape
-                          (-> shape
-                              (dissoc :bool-content)
-                              (dissoc :bool-type)
-                              (path/update-geometry))))
+                          (let [[points selrect] (gshp/content->points+selrect shape (:content shape))]
+                            (-> shape
+                                (dissoc :bool-content)
+                                (dissoc :bool-type)
+                                (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,10 +9,7 @@
   (: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]
@@ -33,7 +30,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defn enable-objects-map
-  [file & _opts]
+  [file]
   (let [update-page
         (fn [page]
           (if (and (pmap/pointer-map? page)
@@ -139,56 +136,10 @@
 
 (defn enable-pointer-map
   "Enable the fdata/pointer-map feature on the file."
-  [file & _opts]
+  [file]
   (-> 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/http/sse.clj

@@ -9,7 +9,6 @@
   (:refer-clojure :exclude [tap])
   (:require
    [app.common.data :as d]
-   [app.common.exceptions :as ex]
    [app.common.logging :as l]
    [app.common.transit :as t]
    [app.http.errors :as errors]
@@ -54,18 +53,20 @@
      ::yres/status 200
      ::yres/body (yres/stream-body
                   (fn [_ output]
-                    (binding [events/*channel* (sp/chan :buf buf :xf (keep encode))]
-                      (let [listener (events/start-listener
-                                      (partial write! output)
-                                      (partial pu/close! output))]
-                        (try
+                    (let [channel  (sp/chan :buf buf :xf (keep encode))
+                          listener (events/start-listener
+                                    channel
+                                    (partial write! output)
+                                    (partial pu/close! output))]
+                      (try
+                        (binding [events/*channel* channel]
                           (let [result (handler)]
-                            (events/tap :end result))
-                          (catch Throwable cause
-                            (events/tap :error (errors/handle' cause request))
-                            (when-not (ex/instance? java.io.EOFException cause)
-                              (binding [l/*context* (errors/request->context request)]
-                                (l/err :hint "unexpected error on processing sse response" :cause cause))))
-                          (finally
-                            (sp/close! events/*channel*)
-                            (px/await! listener)))))))}))
+                            (events/tap :end result)))
+
+                        (catch Throwable cause
+                          (let [result (errors/handle' cause request)]
+                            (events/tap channel :error result)))
+
+                        (finally
+                          (sp/close! channel)
+                          (px/await! listener))))))}))

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

@@ -92,9 +92,9 @@
      [:string {:max 250}]
      [::sm/one-of {:format "string"} valid-event-types]]]
    [:props
-    [:map-of :keyword :any]]
+    [:map-of :keyword ::sm/any]]
    [:context {:optional true}
-    [:map-of :keyword :any]]])
+    [:map-of :keyword ::sm/any]]])
 
 (def schema:push-audit-events
   [:map {:title "push-audit-events"}

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

@@ -231,7 +231,7 @@
               :hint "email has complaint reports")))
 
 (defn prepare-register
-  [{:keys [::db/pool] :as cfg} {:keys [email accept-newsletter-updates] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [email] :as params}]
 
   (validate-register-attempt! cfg params)
 
@@ -243,8 +243,7 @@
                  :backend "penpot"
                  :iss :prepared-register
                  :profile-id (:id profile)
-                 :exp (dt/in-future {:days 7})
-                 :props {:newsletter-updates (or accept-newsletter-updates false)}}
+                 :exp (dt/in-future {:days 7})}
 
         params (d/without-nils params)
         token  (tokens/generate (::setup/props cfg) params)]

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

@@ -115,7 +115,8 @@
 
     (db/update! pool :project
                 {:modified-at (dt/now)}
-                {:id project-id})
+                {:id project-id}
+                {::db/return-keys false})
 
     result))
 

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

@@ -189,7 +189,7 @@
    [:is-shared ::sm/boolean]
    [:project-id ::sm/uuid]
    [:created-at ::dt/instant]
-   [:data {:optional true} :any]])
+   [:data {:optional true} ::sm/any]])
 
 (def schema:permissions-mixin
   [:map {:title "PermissionsMixin"}
@@ -208,7 +208,7 @@
    [:project-id {:optional true} ::sm/uuid]])
 
 (defn- migrate-file
-  [{:keys [::db/conn] :as cfg} {:keys [id] :as file}]
+  [{:keys [::db/conn] :as cfg} {:keys [id] :as file} {:keys [read-only?]}]
   (binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg id)
             pmap/*tracked* (pmap/create-tracked)]
     (let [;; For avoid unnecesary overhead of creating multiple pointers and
@@ -219,43 +219,45 @@
           file (-> file
                    (update :data feat.fdata/process-pointers deref)
                    (update :data feat.fdata/process-objects (partial into {}))
-                   (fmg/migrate-file))
+                   (fmg/migrate-file))]
 
-          ;; When file is migrated, we break the rule of no perform
-          ;; mutations on get operations and update the file with all
-          ;; migrations applied
-          ;;
-          ;; WARN: he following code will not work on read-only mode,
-          ;; it is a known issue; we keep is not implemented until we
-          ;; really need this.
-          file (if (contains? (:features file) "fdata/objects-map")
-                 (feat.fdata/enable-objects-map file)
-                 file)
-          file (if (contains? (:features file) "fdata/pointer-map")
-                 (feat.fdata/enable-pointer-map file)
-                 file)]
+      (if (or read-only? (db/read-only? conn))
+        file
+        (let [;; When file is migrated, we break the rule of no perform
+              ;; mutations on get operations and update the file with all
+              ;; migrations applied
+              file (if (contains? (:features file) "fdata/objects-map")
+                     (feat.fdata/enable-objects-map file)
+                     file)
+              file (if (contains? (:features file) "fdata/pointer-map")
+                     (feat.fdata/enable-pointer-map file)
+                     file)]
 
-      (db/update! conn :file
-                  {:data (blob/encode (:data file))
-                   :version (:version file)
-                   :features (db/create-array conn "text" (:features file))}
-                  {:id id})
+          (db/update! conn :file
+                      {:data (blob/encode (:data file))
+                       :version (:version file)
+                       :features (db/create-array conn "text" (:features file))}
+                      {:id id}
+                      {::db/return-keys false})
 
-      (when (contains? (:features file) "fdata/pointer-map")
-        (feat.fdata/persist-pointers! cfg id))
+          (when (contains? (:features file) "fdata/pointer-map")
+            (feat.fdata/persist-pointers! cfg id))
 
-      (feat.fmigr/upsert-migrations! conn file)
-      (feat.fmigr/resolve-applied-migrations cfg file))))
+          (feat.fmigr/upsert-migrations! conn file)
+          (feat.fmigr/resolve-applied-migrations cfg file))))))
 
 (defn get-file
   [{:keys [::db/conn ::wrk/executor] :as cfg} id
    & {:keys [project-id
              migrate?
              include-deleted?
-             lock-for-update?]
+             lock-for-update?
+             preload-pointers?]
       :or {include-deleted? false
            lock-for-update? false
-           migrate? true}}]
+           migrate? true
+           preload-pointers? false}
+      :as options}]
 
   (assert (db/connection? conn) "expected cfg with valid connection")
 
@@ -273,10 +275,16 @@
         ;; because it has heavy and synchronous operations for
         ;; decoding file body that are not very friendly with virtual
         ;; threads.
-        file   (px/invoke! executor #(decode-row file))]
+        file   (px/invoke! executor #(decode-row file))
+
+        file   (if (and migrate? (fmg/need-migration? file))
+                 (migrate-file cfg file options)
+                 file)]
+
+    (if preload-pointers?
+      (binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg id)]
+        (update file :data feat.fdata/process-pointers deref))
 
-    (if (and migrate? (fmg/need-migration? file))
-      (migrate-file cfg file)
       file)))
 
 (defn get-minimal-file
@@ -484,7 +492,7 @@
 
   (let [perms (get-permissions conn profile-id file-id share-id)
 
-        file  (get-file cfg file-id)
+        file  (get-file cfg file-id :read-only? true)
 
         proj  (db/get conn :project {:id (:project-id file)})
 
@@ -741,7 +749,9 @@
                              :project-id project-id
                              :file-id id)
 
-        file (get-file cfg id :project-id project-id)]
+        file (get-file cfg id
+                       :project-id project-id
+                       :read-only? true)]
 
     (-> (cfeat/get-team-enabled-features cf/flags team)
         (cfeat/check-client-features! (:features params))

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

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

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

@@ -10,7 +10,6 @@
    [app.common.data.macros :as dm]
    [app.common.features :as cfeat]
    [app.common.files.helpers :as cfh]
-   [app.common.files.migrations :as fmg]
    [app.common.geom.shapes :as gsh]
    [app.common.schema :as sm]
    [app.common.thumbnails :as thc]
@@ -18,7 +17,6 @@
    [app.config :as cf]
    [app.db :as db]
    [app.db.sql :as-alias sql]
-   [app.features.fdata :as feat.fdata]
    [app.loggers.audit :as-alias audit]
    [app.loggers.webhooks :as-alias webhooks]
    [app.media :as media]
@@ -200,14 +198,13 @@
   (db/run! cfg (fn [{:keys [::db/conn] :as cfg}]
                  (files/check-read-permissions! conn profile-id file-id)
 
-                 (let [team     (teams/get-team conn
-                                                :profile-id profile-id
-                                                :file-id file-id)
+                 (let [team (teams/get-team conn
+                                            :profile-id profile-id
+                                            :file-id file-id)
 
-                       file     (binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg file-id)]
-                                  (-> (files/get-file cfg file-id :migrate? false)
-                                      (update :data feat.fdata/process-pointers deref)
-                                      (fmg/migrate-file)))]
+                       file (files/get-file cfg file-id
+                                            :preload-pointers? true
+                                            :read-only? true)]
 
                    (-> (cfeat/get-team-enabled-features cf/flags team)
                        (cfeat/check-file-features! (:features file)))

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

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

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

@@ -80,9 +80,9 @@
 (def ^:private schema:create-font-variant
   [:map {:title "create-font-variant"}
    [:team-id ::sm/uuid]
-   [:data [:map-of :string :any]]
+   [:data [:map-of ::sm/text ::sm/any]]
    [:font-id ::sm/uuid]
-   [:font-family :string]
+   [:font-family ::sm/text]
    [:font-weight [::sm/one-of {:format "number"} valid-weight]]
    [:font-style [::sm/one-of {:format "string"} valid-style]]])
 

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

@@ -76,10 +76,9 @@
   (perms/make-check-fn has-read-permissions?))
 
 (defn decode-row
-  [{:keys [features subscription] :as row}]
+  [{:keys [features] :as row}]
   (cond-> row
-    (some? features) (assoc :features (db/decode-pgarray features #{}))
-    (some? subscription) (assoc :subscription (db/decode-transit-pgobject subscription))))
+    (some? features) (assoc :features (db/decode-pgarray features #{}))))
 
 ;; FIXME: move
 
@@ -127,40 +126,16 @@
     (get-teams conn profile-id)))
 
 (def sql:get-teams-with-permissions
-  "SELECT t.*,
+  "select t.*,
           tp.is_owner,
           tp.is_admin,
           tp.can_edit,
-          (t.id = ?) AS is_default
-     FROM team_profile_rel AS tp
-     JOIN team AS t ON (t.id = tp.team_id)
-    WHERE t.deleted_at IS null
-      AND tp.profile_id = ?
-    ORDER BY tp.created_at ASC")
-
-(def sql:get-teams-with-permissions-and-subscription
-  "SELECT t.*,
-          tp.is_owner,
-          tp.is_admin,
-          tp.can_edit,
-          (t.id = ?) AS is_default,
-
-          jsonb_build_object(
-            '~:type', COALESCE(p.props->'~:subscription'->>'~:type', 'professional'),
-            '~:status', CASE COALESCE(p.props->'~:subscription'->>'~:type', 'professional')
-                          WHEN 'professional' THEN 'active'
-                          ELSE COALESCE(p.props->'~:subscription'->>'~:status', 'incomplete')
-                       END
-          ) AS subscription
-     FROM team_profile_rel AS tp
-     JOIN team AS t ON (t.id = tp.team_id)
-     JOIN team_profile_rel AS tpr
-       ON (tpr.team_id = t.id AND tpr.is_owner IS true)
-     JOIN profile AS p
-       ON (tpr.profile_id = p.id)
-    WHERE t.deleted_at IS null
-      AND tp.profile_id = ?
-    ORDER BY tp.created_at ASC;")
+          (t.id = ?) as is_default
+     from team_profile_rel as tp
+     join team as t on (t.id = tp.team_id)
+    where t.deleted_at is null
+      and tp.profile_id = ?
+    order by tp.created_at asc")
 
 (defn process-permissions
   [team]
@@ -175,21 +150,13 @@
         (dissoc :is-owner :is-admin :can-edit)
         (assoc :permissions permissions))))
 
-(def ^:private
-  xform:process-teams
-  (comp
-   (map decode-row)
-   (map process-permissions)))
-
 (defn get-teams
   [conn profile-id]
-  (let [profile (profile/get-profile conn profile-id)
-        sql     (if (contains? cf/flags :subscriptions)
-                  sql:get-teams-with-permissions-and-subscription
-                  sql:get-teams-with-permissions)]
-
-    (->> (db/exec! conn [sql (:default-team-id profile) profile-id])
-         (into [] xform:process-teams))))
+  (let [profile (profile/get-profile conn profile-id)]
+    (->> (db/exec! conn [sql:get-teams-with-permissions (:default-team-id profile) profile-id])
+         (map decode-row)
+         (map process-permissions)
+         (vec))))
 
 ;; --- Query: Team (by ID)
 

backend/src/app/rpc/doc.clj

@@ -9,6 +9,7 @@
   (:require
    [app.common.data :as d]
    [app.common.exceptions :as ex]
+   [app.common.json :as json]
    [app.common.pprint :as pp]
    [app.common.schema :as sm]
    [app.common.schema.desc-js-like :as smdj]
@@ -19,7 +20,6 @@
    [app.http.sse :as-alias sse]
    [app.loggers.webhooks :as-alias webhooks]
    [app.rpc :as-alias rpc]
-   [app.util.json :as json]
    [app.util.services :as sv]
    [app.util.template :as tmpl]
    [clojure.java.io :as io]
@@ -86,7 +86,7 @@
     (fn [request]
       (let [params  (:query-params request)
             pstyle  (:type params "js")
-            context (assoc context :param-style pstyle)]
+            context (assoc @context :param-style pstyle)]
 
         {::yres/status 200
          ::yres/body (-> (io/resource "app/templates/api-doc.tmpl")
@@ -178,8 +178,7 @@
     (fn [_]
       {::yres/status 200
        ::yres/headers {"content-type" "application/json; charset=utf-8"}
-       ::yres/body (json/encode context)})
-
+       ::yres/body (json/encode @context)})
     (fn [_]
       {::yres/status 404})))
 
@@ -209,7 +208,7 @@
 
 (defmethod ig/init-key ::routes
   [_ {:keys [::rpc/methods] :as cfg}]
-  [(let [context (prepare-doc-context methods)]
+  [(let [context (delay (prepare-doc-context methods))]
      [["/_doc"
        {:handler (doc-handler context)
         :allowed-methods #{:get}}]
@@ -217,7 +216,7 @@
        {:handler (doc-handler context)
         :allowed-methods #{:get}}]])
 
-   (let [context (prepare-openapi-context methods)]
+   (let [context (delay (prepare-openapi-context methods))]
      [["/openapi"
        {:handler (openapi-handler)
         :allowed-methods #{:get}}]

backend/src/app/srepl.clj

@@ -6,17 +6,13 @@
 
 (ns app.srepl
   "Server Repl."
-  (:refer-clojure :exclude [read-line])
   (:require
-   [app.common.exceptions :as ex]
-   [app.common.json :as json]
    [app.common.logging :as l]
    [app.config :as cf]
-   [app.srepl.cli :as cli]
+   [app.srepl.cli]
    [app.srepl.main]
+   [app.util.json :as json]
    [app.util.locks :as locks]
-   [app.util.time :as dt]
-   [clojure.core :as c]
    [clojure.core.server :as ccs]
    [clojure.main :as cm]
    [integrant.core :as ig]))
@@ -32,80 +28,17 @@
    :init repl-init
    :read ccs/repl-read))
 
-(defn- ex->data
-  [cause phase]
-  (let [data (ex-data cause)
-        explain (ex/explain data)]
-    (cond-> {:phase phase
-             :code (get data :code :unknown)
-             :type (get data :type :unknown)
-             :hint (or (get data :hint) (ex-message cause))}
-      (some? explain)
-      (assoc :explain explain))))
-
-(defn read-line
-  []
-  (if-let [line (c/read-line)]
-    (try
-      (l/dbg :hint "decode" :data line)
-      (json/decode line :key-fn json/read-kebab-key)
-      (catch Throwable _cause
-        (l/warn :hint "unable to decode data" :data line)
-        nil))
-    ::eof))
-
 (defn json-repl
   []
-  (let [lock (locks/create)
-        out  *out*
-
-        out-fn
-        (fn [m]
-          (locks/locking lock
-            (binding [*out* out]
-              (l/warn :hint "write" :data m)
-              (println (json/encode m :key-fn json/write-camel-key)))))
-
-        tapfn
-        (fn [val]
-          (out-fn {:tag :tap :val val}))]
-
-    (binding [*out* (PrintWriter-on #(out-fn {:tag :out :val %1}) nil true)
-              *err* (PrintWriter-on #(out-fn {:tag :err :val %1}) nil true)]
-      (try
-        (add-tap tapfn)
-        (loop []
-          (when (try
-                  (let [data   (read-line)
-                        tpoint (dt/tpoint)]
-
-                    (l/dbg :hint "received" :data (if (= data ::eof) "EOF" data))
-
-                    (try
-                      (when-not (= data ::eof)
-                        (when-not (nil? data)
-                          (let [result  (cli/exec data)
-                                elapsed (tpoint)]
-                            (l/warn :hint "result" :data result)
-                            (out-fn {:tag :ret
-                                     :val (if (instance? Throwable result)
-                                            (Throwable->map result)
-                                            result)
-                                     :elapsed (inst-ms elapsed)})))
-                        true)
-                      (catch Throwable cause
-                        (let [elapsed (tpoint)]
-                          (out-fn {:tag :ret
-                                   :err (ex->data cause :eval)
-                                   :elapsed (inst-ms elapsed)})
-                          true))))
-                  (catch Throwable cause
-                    (out-fn {:tag :ret
-                             :err (ex->data cause :read)})
-                    true))
-            (recur)))
-        (finally
-          (remove-tap tapfn))))))
+  (let [out  *out*
+        lock (locks/create)]
+    (ccs/prepl *in*
+               (fn [m]
+                 (binding [*out* out,
+                           *flush-on-newline* true,
+                           *print-readably* true]
+                   (locks/locking lock
+                     (println (json/encode-str m))))))))
 
 ;; --- State initialization
 

backend/src/app/srepl/cli.clj

@@ -9,23 +9,14 @@
   (:require
    [app.auth :as auth]
    [app.common.exceptions :as ex]
-   [app.common.schema :as sm]
    [app.common.uuid :as uuid]
    [app.db :as db]
    [app.rpc.commands.auth :as cmd.auth]
    [app.rpc.commands.profile :as cmd.profile]
-   [app.setup :as-alias setup]
-   [app.tokens :as tokens]
+   [app.util.json :as json]
    [app.util.time :as dt]
    [cuerdas.core :as str]))
 
-(defn coercer
-  [schema & {:as opts}]
-  (let [decode-fn (sm/decoder schema sm/json-transformer)
-        check-fn (sm/check-fn schema opts)]
-    (fn [data]
-      (-> data decode-fn check-fn))))
-
 (defn- get-current-system
   []
   (or (deref (requiring-resolve 'app.main/system))
@@ -33,21 +24,16 @@
 
 (defmulti ^:private exec-command ::cmd)
 
-(defmethod exec-command :default
-  [{:keys [::cmd]}]
-  (ex/raise :type :internal
-            :code :not-implemented
-            :hint (str/ffmt "command '%' not implemented" cmd)))
-
 (defn exec
   "Entry point with external tools integrations that uses PREPL
   interface for interacting with running penpot backend."
   [data]
-  (-> {::cmd (get data :cmd)}
-      (merge (:params data))
-      (exec-command)))
+  (let [data (json/decode data)]
+    (-> {::cmd (keyword (:cmd data "default"))}
+        (merge (:params data))
+        (exec-command))))
 
-(defmethod exec-command "create-profile"
+(defmethod exec-command :create-profile
   [{:keys [fullname email password is-active]
     :or {is-active true}}]
   (some-> (get-current-system)
@@ -63,7 +49,7 @@
                (->> (cmd.auth/create-profile! conn params)
                     (cmd.auth/create-profile-rels! conn)))))))
 
-(defmethod exec-command "update-profile"
+(defmethod exec-command :update-profile
   [{:keys [fullname email password is-active]}]
   (some-> (get-current-system)
           (db/tx-run!
@@ -84,12 +70,7 @@
                                         :deleted-at nil})]
                    (pos? (db/get-update-count res)))))))))
 
-(defmethod exec-command "echo"
-  [params]
-  params)
-
-
-(defmethod exec-command "delete-profile"
+(defmethod exec-command :delete-profile
   [{:keys [email soft]}]
   (when-not email
     (ex/raise :type :assertion
@@ -107,7 +88,7 @@
                                      {:email email}))]
                (pos? (db/get-update-count res)))))))
 
-(defmethod exec-command "search-profile"
+(defmethod exec-command :search-profile
   [{:keys [email]}]
   (when-not email
     (ex/raise :type :assertion
@@ -121,130 +102,12 @@
                             " where email similar to ? order by created_at desc limit 100")]
                (db/exec! conn [sql email]))))))
 
-(defmethod exec-command "derive-password"
+(defmethod exec-command :derive-password
   [{:keys [password]}]
   (auth/derive-password password))
 
-(defmethod exec-command "authenticate"
-  [{:keys [token]}]
-  (when-let [system (get-current-system)]
-    (let [props  (get system ::setup/props)]
-      (tokens/verify props {:token token :iss "authentication"}))))
-
-(def ^:private schema:get-customer
-  [:map [:id ::sm/uuid]])
-
-(def coerce-get-customer-params
-  (coercer schema:get-customer
-           :type :validation
-           :hint "invalid data provided for `get-customer` rpc call"))
-
-(def sql:get-customer-slots
-  "WITH teams AS (
-    SELECT tpr.team_id AS id,
-           tpr.profile_id AS profile_id
-      FROM team_profile_rel AS tpr
-     WHERE tpr.is_owner IS true
-       AND tpr.profile_id = ?
-  ), teams_with_slots AS (
-    SELECT tpr.team_id AS id,
-           count(*) AS total
-      FROM team_profile_rel AS tpr
-     WHERE tpr.team_id IN (SELECT id FROM teams)
-       AND tpr.can_edit IS true
-     GROUP BY 1
-     ORDER BY 2
-  )
-  SELECT max(total) AS total FROM teams_with_slots;")
-
-(defn- get-customer-slots
-  [system profile-id]
-  (let [result (db/exec-one! system [sql:get-customer-slots profile-id])]
-    (:total result)))
-
-(defmethod exec-command "get-customer"
-  [params]
-  (when-let [system (get-current-system)]
-    (let [{:keys [id] :as params} (coerce-get-customer-params params)
-          {:keys [props] :as profile} (cmd.profile/get-profile system id)]
-      {:id (get profile :id)
-       :name (get profile :fullname)
-       :email (get profile :email)
-       :num-editors (get-customer-slots system id)
-       :subscription (get props :subscription)})))
-
-(def ^:private schema:customer-subscription
-  [:map {:title "CustomerSubscription"}
-   [:id ::sm/text]
-   [:customer-id ::sm/text]
-   [:type [:enum
-           "unlimited"
-           "professional"
-           "enterprise"]]
-   [:status [:enum
-             "active"
-             "canceled"
-             "incomplete"
-             "incomplete_expired"
-             "pass_due"
-             "paused"
-             "trialing"
-             "unpaid"]]
-
-   [:billing-period [:enum
-                     "month"
-                     "day"
-                     "week"
-                     "year"]]
-   [:quantity :int]
-   [:description [:maybe ::sm/text]]
-   [:created-at ::sm/timestamp]
-   [:start-date [:maybe ::sm/timestamp]]
-   [:ended-at [:maybe ::sm/timestamp]]
-   [:trial-end [:maybe ::sm/timestamp]]
-   [:trial-start [:maybe ::sm/timestamp]]
-   [:cancel-at [:maybe ::sm/timestamp]]
-   [:canceled-at [:maybe ::sm/timestamp]]
-
-   [:current-period-end ::sm/timestamp]
-   [:current-period-start ::sm/timestamp]
-   [:cancel-at-period-end :boolean]
-
-   [:cancellation-details
-    [:map {:title "CancellationDetails"}
-     [:comment [:maybe ::sm/text]]
-     [:reason [:maybe ::sm/text]]
-     [:feedback [:maybe
-                 [:enum
-                  "customer_service"
-                  "low_quality"
-                  "missing_feature"
-                  "other"
-                  "switched_service"
-                  "too_complex"
-                  "too_expensive"
-                  "unused"]]]]]])
-
-(def ^:private schema:update-customer-subscription
-  [:map
-   [:id ::sm/uuid]
-   [:subscription [:maybe schema:customer-subscription]]])
-
-(def coerce-update-customer-subscription-params
-  (coercer schema:update-customer-subscription
-           :type :validation
-           :hint "invalid data provided for `update-customer-subscription` rpc call"))
-
-(defmethod exec-command "update-customer-subscription"
-  [params]
-  (when-let [system (get-current-system)]
-    (let [{:keys [id subscription]} (coerce-update-customer-subscription-params params)
-          ;; FIXME: locking
-          {:keys [props] :as profile} (cmd.profile/get-profile system id)
-          props (assoc props :subscription subscription)]
-
-      (db/update! system :profile
-                  {:props (db/tjson props)}
-                  {:id id}
-                  {::db/return-keys false})
-      true)))
+(defmethod exec-command :default
+  [{:keys [::cmd]}]
+  (ex/raise :type :internal
+            :code :not-implemented
+            :hint (str/ffmt "command '%' not implemented" (name cmd))))

backend/src/app/srepl/main.clj

@@ -156,10 +156,6 @@
   [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)
@@ -420,12 +416,10 @@
   "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}]
-  (let [file-id (h/parse-uuid file-id)]
-    (db/tx-run! (assoc main/system ::db/rollback rollback?)
-                (fn [system]
-                  (binding [h/*system* system
-                            db/*conn* (db/get-connection system)]
-                    (h/process-file! system file-id update-fn opts))))))
+  (db/tx-run! (assoc main/system ::db/rollback rollback?)
+              (fn [system]
+                (binding [h/*system* system]
+                  (h/process-file! system file-id update-fn opts)))))
 
 (defn process-team-files!
   "Apply a function to each file of the specified team."
@@ -437,8 +431,7 @@
                   (when (string? label)
                     (h/take-team-snapshot! system team-id label))
 
-                  (binding [h/*system* system
-                            db/*conn* (db/get-connection system)]
+                  (binding [h/*system* 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)

backend/src/app/util/events.clj

@@ -10,7 +10,6 @@
   to them. Mainly used in http.sse for progress reporting."
   (:refer-clojure :exclude [tap run!])
   (:require
-   [app.common.data.macros :as dm]
    [app.common.exceptions :as ex]
    [app.common.logging :as l]
    [promesa.exec :as px]
@@ -18,33 +17,30 @@
 
 (def ^:dynamic *channel* nil)
 
-(defn channel
-  []
-  (sp/chan :buf 32))
-
 (defn tap
-  [type data]
-  (when-let [channel *channel*]
-    (sp/put! channel [type data])
-    nil))
+  ([type data]
+   (when-let [channel *channel*]
+     (sp/put! channel [type data])
+     nil))
+  ([channel type data]
+   (when channel
+     (sp/put! channel [type data])
+     nil)))
 
 (defn start-listener
-  [on-event on-close]
-
-  (dm/assert!
-   "expected active events channel"
-   (sp/chan? *channel*))
+  [channel on-event on-close]
+  (assert (sp/chan? channel) "expected active events channel")
 
   (px/thread
     {:virtual true}
     (try
       (loop []
-        (when-let [event (sp/take! *channel*)]
+        (when-let [event (sp/take! channel)]
           (let [result (ex/try! (on-event event))]
             (if (ex/exception? result)
               (do
                 (l/wrn :hint "unexpected exception" :cause result)
-                (sp/close! *channel*))
+                (sp/close! channel))
               (recur)))))
       (finally
         (on-close)))))
@@ -55,7 +51,7 @@
   [f on-event]
 
   (binding [*channel* (sp/chan :buf 32)]
-    (let [listener (start-listener on-event (constantly nil))]
+    (let [listener (start-listener *channel* on-event (constantly nil))]
       (try
         (f)
         (finally

common/deps.edn

@@ -28,7 +28,7 @@
   integrant/integrant {:mvn/version "0.13.1"}
 
   funcool/tubax {:mvn/version "2021.05.20-0"}
-  funcool/cuerdas {:mvn/version "2023.11.09-407"}
+  funcool/cuerdas {:mvn/version "2025.05.26-411"}
   funcool/promesa
   {:git/sha "0c5ed6ad033515a2df4b55addea044f60e9653d0"
    :git/url "https://github.com/funcool/promesa"}

common/src/app/common/features.cljc

@@ -46,7 +46,6 @@
   #{"fdata/objects-map"
     "fdata/pointer-map"
     "fdata/shape-data-type"
-    "fdata/path-data"
     "components/v2"
     "styles/v2"
     "layout/grid"
@@ -59,18 +58,12 @@
 ;; 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
@@ -93,9 +86,8 @@
 ;; without migration applied)
 (def no-migration-features
   (-> #{"layout/grid"
-        "design-tokens/v1"
         "fdata/shape-data-type"
-        "fdata/path-data"}
+        "design-tokens/v1"}
       (into frontend-only-features)
       (into backend-only-features)))
 

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

@@ -272,13 +272,14 @@
 
           :else
           (let [objects (lookup-objects file)
-                bool'   (gsh/update-bool bool children objects)]
+                content (gsh/calc-bool-content bool 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 bool') :ignore-touched true}
+              [{:type :set :attr :content :val content :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

@@ -47,14 +47,14 @@
      [:type [:= :assign]]
      ;; NOTE: the full decoding is happening on the handler because it
      ;; needs a proper context of the current shape and its type
-     [:value [:map-of :keyword :any]]
+     [:value [:map-of :keyword ::sm/any]]
      [:ignore-touched {:optional true} :boolean]
      [:ignore-geometry {:optional true} :boolean]]]
    [:set
     [:map {:title "SetOperation"}
      [:type [:= :set]]
      [:attr :keyword]
-     [:val :any]
+     [:val ::sm/any]
      [:ignore-touched {:optional true} :boolean]
      [:ignore-geometry {:optional true} :boolean]]]
    [:set-touched
@@ -238,9 +238,9 @@
       [:component-id {:optional true} ::sm/uuid]
       [:ignore-touched {:optional true} :boolean]
       [:parent-id ::sm/uuid]
-      [:shapes :any]
+      [:shapes ::sm/any]
       [:index {:optional true} [:maybe :int]]
-      [:after-shape {:optional true} :any]
+      [:after-shape {:optional true} ::sm/any]
       [:component-swap {:optional true} :boolean]]]
 
     [:reorder-children
@@ -250,14 +250,14 @@
       [:component-id {:optional true} ::sm/uuid]
       [:ignore-touched {:optional true} :boolean]
       [:parent-id ::sm/uuid]
-      [:shapes :any]]]
+      [:shapes ::sm/any]]]
 
     [:add-page
      [:map {:title "AddPageChange"}
       [:type [:= :add-page]]
       [:id {:optional true} ::sm/uuid]
       [:name {:optional true} :string]
-      [:page {:optional true} :any]]]
+      [:page {:optional true} ::sm/any]]]
 
     [:mod-page
      [:map {:title "ModPageChange"}
@@ -327,14 +327,14 @@
       [:type [:= :add-component]]
       [:id ::sm/uuid]
       [:name :string]
-      [:shapes {:optional true} [:vector {:gen/max 3} :any]]
+      [:shapes {:optional true} [:vector {:gen/max 3} ::sm/any]]
       [:path {:optional true} :string]]]
 
     [:mod-component
      [:map {:title "ModCompoenentChange"}
       [:type [:= :mod-component]]
       [:id ::sm/uuid]
-      [:shapes {:optional true} [:vector {:gen/max 3} :any]]
+      [:shapes {:optional true} [:vector {:gen/max 3} ::sm/any]]
       [:name {:optional true} :string]
       [:variant-id {:optional true} ::sm/uuid]
       [:variant-properties {:optional true} [:vector ::ctv/variant-property]]]]
@@ -411,7 +411,7 @@
     [:set-tokens-lib
      [:map {:title "SetTokensLib"}
       [:type [:= :set-tokens-lib]]
-      [:tokens-lib :any]]]
+      [:tokens-lib ::sm/any]]]
 
     [:set-token-set
      [:map {:title "SetTokenSetChange"}
@@ -739,7 +739,7 @@
                 group
 
                 (= :bool (:type group))
-                (gsh/update-bool group children objects)
+                (gsh/update-bool-selrect group children objects)
 
                 (:masked-group group)
                 (set-mask-selrect group children)

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

@@ -8,6 +8,7 @@
   (: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]
@@ -24,18 +25,19 @@
 
 ;; Auxiliary functions to help create a set of changes (undo + redo)
 
-(sm/register!
- ^{::sm/type ::changes}
- [:map {:title "changes"}
-  [:redo-changes vector?]
-  [:undo-changes seq?]
-  [:origin {:optional true} any?]
-  [:save-undo? {:optional true} boolean?]
-  [:stack-undo? {:optional true} boolean?]
-  [:undo-group {:optional true} any?]])
+(def schema:changes
+  (sm/register!
+   ^{::sm/type ::changes}
+   [:map {:title "changes"}
+    [:redo-changes vector?]
+    [:undo-changes seq?]
+    [:origin {:optional true} ::sm/any]
+    [:save-undo? {:optional true} boolean?]
+    [:stack-undo? {:optional true} boolean?]
+    [:undo-group {:optional true} ::sm/any]]))
 
 (def check-changes!
-  (sm/check-fn ::changes))
+  (sm/check-fn schema:changes))
 
 (defn empty-changes
   ([origin page-id]
@@ -83,7 +85,8 @@
 
 (defn with-objects
   [changes objects]
-  (let [fdata (ctf/make-file-data (uuid/next) uuid/zero)
+  (let [fdata (binding [cfeat/*current* #{"components/v2"}]
+                (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
@@ -478,12 +481,9 @@
           (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)
-          (update-fn object))]
-
+        new-obj (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)))))
@@ -660,7 +660,7 @@
                                  nil               ;; so it does not need resize
 
                                  (= (:type parent) :bool)
-                                 (gsh/update-bool parent children objects)
+                                 (gsh/update-bool-selrect parent children objects)
 
                                  (= (:type parent) :group)
                                  (if (:masked-group parent)

common/src/app/common/files/helpers.cljc

@@ -626,6 +626,9 @@
               (map? (:fill-image form))
               (update-in [:fill-image :id] lookup-index)
 
+              (map? (:stroke-image form))
+              (update-in [:stroke-image :id] lookup-index)
+
               ;; This covers old shapes and the new :fills.
               (uuid? (:fill-color-ref-file form))
               (update :fill-color-ref-file lookup-index)

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

@@ -16,6 +16,7 @@
    [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]
@@ -26,8 +27,6 @@
    [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]
@@ -99,13 +98,13 @@
                     (if (nil? migrations)
                       (generate-migrations-from-version version)
                       migrations)))
+          (update :features (fnil into #{}) (deref cfeat/*new*))
           ;; NOTE: in some future we can consider to apply
           ;; a migration to the whole database and remove
           ;; this code from this function that executes on
           ;; each file migration operation
           (update :features cfeat/migrate-legacy-features)
-          (migrate)
-          (update :features (fnil into #{}) (deref cfeat/*new*))))))
+          (migrate)))))
 
 (defn migrated?
   [file]
@@ -130,8 +129,8 @@
   [data _]
   (letfn [(migrate-path [shape]
             (if-not (contains? shape :content)
-              (let [content (path.segment/points->content (:segments shape) :close (:close? shape))
-                    selrect (path.segment/content->selrect content)
+              (let [content (gsp/segments->content (:segments shape) (:close? shape))
+                    selrect (gsh/content->selrect content)
                     points  (grc/rect->points selrect)]
                 (-> shape
                     (dissoc :segments)
@@ -202,7 +201,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 (path.segment/content->selrect (:content shape))
+                  (let [selrect (gsh/content->selrect (:content shape))
                         points (grc/rect->points selrect)
                         transform (gmt/matrix)
                         transform-inv (gmt/matrix)]
@@ -1282,8 +1281,8 @@
             (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))))
+        (update :pages-index update-vals update-container)
+        (update :components update-vals update-container))))
 
 (defmethod migrate-data "0003-fix-root-shape"
   [data _]
@@ -1307,23 +1306,6 @@
         (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"
@@ -1381,5 +1363,4 @@
          "0001-remove-tokens-from-groups"
          "0002-normalize-bool-content"
          "0002-clean-shape-interactions"
-         "0003-fix-root-shape"
-         "0003-convert-path-content"]))
+         "0003-fix-root-shape"]))

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

@@ -15,8 +15,6 @@
    [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))
@@ -37,7 +35,6 @@
                       (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
@@ -47,7 +44,6 @@
         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 zero?])
+  (:refer-clojure :exclude [divide min max abs])
   (:require
    #?(:clj [app.common.fressian :as fres])
    #?(:cljs [cljs.core :as c]
@@ -470,13 +470,6 @@
   (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,11 +10,13 @@
    [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]))
 
@@ -164,7 +166,7 @@
 (dm/export gtr/calculate-geometry)
 (dm/export gtr/update-group-selrect)
 (dm/export gtr/update-mask-selrect)
-(dm/export gtr/update-bool)
+(dm/export gtr/update-bool-selrect)
 (dm/export gtr/apply-transform)
 (dm/export gtr/transform-shape)
 (dm/export gtr/transform-selrect)
@@ -178,6 +180,12 @@
 ;; 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?)
@@ -185,6 +193,9 @@
 (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

@@ -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.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.math :as mth]
-   [app.common.types.path :as path]))
+   [app.common.geom.shapes.path :as gsp]
+   [app.common.math :as mth]))
 
 (defn shape-stroke-margin
   [shape stroke-width]
@@ -104,7 +104,7 @@
    (let [strokes (:strokes shape)
 
          open-path?    (and ^boolean (cfh/path-shape? shape)
-                            ^boolean (path/shape-with-open-path? shape))
+                            ^boolean (gsp/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.types.path.segment :as path.segm]))
+   [app.common.math :as mth]))
 
 (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))
-                         (path.segm/path->lines shape))
+                         (gpp/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,10 +12,11 @@
    [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.path :as path]))
+   [app.common.types.modifiers :as ctm]))
 
 #?(:clj (set! *warn-on-reflection* true))
 
@@ -76,11 +77,7 @@
               position-data)
         position-data))))
 
-;; 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
-
+;; FIXME: revist usage of mutability
 (defn move
   "Move the shape relatively to its current
   position applying the provided delta."
@@ -99,7 +96,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 path/move-content mvec)))))
+          (update :content gpa/move-content mvec)))))
 
 ;; --- Absolute Movement
 
@@ -324,7 +321,7 @@
                   (update shape :position-data transform-position-data transform-mtx)
                   shape)
         shape   (if (or (= type :path) (= type :bool))
-                  (update shape :content path/transform-content transform-mtx)
+                  (update shape :content gpa/transform-content transform-mtx)
                   (assoc shape
                          :x (dm/get-prop selrect :x)
                          :y (dm/get-prop selrect :y)
@@ -357,7 +354,7 @@
                           360)
 
             shape    (if (or (= type :path) (= type :bool))
-                       (update shape :content path/transform-content transform-mtx)
+                       (update shape :content gpa/transform-content transform-mtx)
                        (assoc shape
                               :x (dm/get-prop selrect :x)
                               :y (dm/get-prop selrect :y)
@@ -374,14 +371,8 @@
   "Given a new set of points transformed, set up the rectangle so it keeps
   its properties. We adjust de x,y,width,height and create a custom transform"
   [shape transform-mtx]
-  (cond
-    (nil? transform-mtx)
-    shape
-
-    ^boolean (gmt/move? transform-mtx)
+  (if ^boolean (gmt/move? transform-mtx)
     (apply-transform-move shape transform-mtx)
-
-    :else
     (apply-transform-generic shape transform-mtx)))
 
 (defn- update-group-viewbox
@@ -453,13 +444,24 @@
         (assoc :flip-x  (-> mask :flip-x))
         (assoc :flip-y  (-> mask :flip-y)))))
 
-(defn update-bool
+(defn update-bool-selrect
   "Calculates the selrect+points for the boolean shape"
-  [shape _children objects]
+  [shape children objects]
 
-  (let [content (path/calc-bool-content shape objects)
-        shape   (assoc shape :content content)]
-    (path/update-geometry shape)))
+  (let [content
+        (gshb/calc-bool-content shape objects)
+
+        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]
@@ -474,7 +476,7 @@
                   (update-mask-selrect shape children)
 
                   (cfh/bool-shape? shape)
-                  (update-bool shape children objects)
+                  (update-bool-selrect shape children objects)
 
                   (cfh/group-shape? shape)
                   (update-group-selrect shape children)

common/src/app/common/logic/libraries.cljc

@@ -25,7 +25,6 @@
    [app.common.types.file :as ctf]
    [app.common.types.page :as ctp]
    [app.common.types.pages-list :as ctpl]
-   [app.common.types.shape :as cts]
    [app.common.types.shape-tree :as ctst]
    [app.common.types.shape.interactions :as ctsi]
    [app.common.types.shape.layout :as ctl]
@@ -44,12 +43,6 @@
 (def log-shape-ids #{})
 (def log-container-ids #{})
 
-(def updatable-attrs (->> (seq (keys ctk/sync-attrs))
-                           ;; We don't update the flex-child attrs
-                          (remove ctk/swap-keep-attrs)
-                           ;; We don't do automatic update of the `layout-grid-cells` property.
-                          (remove #(= :layout-grid-cells %))))
-
 (defn enabled-shape?
   [id container]
   (or (empty? log-shape-ids)
@@ -438,8 +431,6 @@
                              (not inside-component?)
                              (assoc :component-root true))
 
-         restoring-into-parent (get objects (:parent-id first-shape))
-
          changes           (-> changes
                                (pcb/with-page page)
                                (pcb/with-objects (:objects page))
@@ -450,15 +441,12 @@
                                    changes
                                    (rest moved-shapes))
          changes           (cond-> changes
-                             ;; Transform variant info into name when restoring into a parent that is not a variant-container,
-                             ;; or when restoring into a variant-container that doesn't exists anymore
-                             (and is-variant?
-                                  (or (and parent (not (ctk/is-variant-container? parent)))
-                                      (nil? restoring-into-parent)))
+                             ;; Remove variant info when restoring into a parent that is not a variant-container
+                             (and is-variant? parent (not (ctk/is-variant-container? parent)))
                              (clvp/generate-make-shapes-no-variant [first-shape])
                              ;; Add variant info and rename when restoring into a variant-container
-                             (ctk/is-variant-container? restoring-into-parent)
-                             (clvp/generate-make-shapes-variant [first-shape] restoring-into-parent))]
+                             (ctk/is-variant-container? parent)
+                             (clvp/generate-make-shapes-variant [first-shape] parent))]
      {:changes (pcb/restore-component changes component-id (:id page) minusdelta)
       :shape (first moved-shapes)})))
 
@@ -596,7 +584,7 @@
     (generate-sync-shape-direct changes file libraries container shape-id false)))
 
 (defmethod generate-sync-shape :colors
-  [_ changes library-id _ shape _ libraries _]
+  [_ changes library-id _ shape libraries _]
   (shape-log :debug (:id shape) nil :msg "Sync colors of shape" :shape (:name shape))
 
   ;; Synchronize a shape that uses some colors of the library. The value of the
@@ -607,7 +595,7 @@
                        #(ctc/sync-shape-colors % library-id library-colors))))
 
 (defmethod generate-sync-shape :typographies
-  [_ changes library-id container shape _ libraries _]
+  [_ changes library-id container shape libraries _]
   (shape-log :debug (:id shape) nil :msg "Sync typographies of shape" :shape (:name shape))
 
   ;; Synchronize a shape that uses some typographies of the library. The attributes
@@ -1620,75 +1608,6 @@
                                                      :val dest-tokens
                                                      :ignore-touched true}]}))))))
 
-(defn- generate-update-tokens
-  [changes container dest-shape origin-shape touched omit-touched?]
-  (let [attrs (->> (seq (keys ctk/sync-attrs))
-                   ;; We don't update the flex-child attrs
-                   (remove #(= :layout-grid-cells %)))
-
-        applied-tokens (reduce (fn [applied-tokens attr]
-                                 (let [attr-group (get ctk/sync-attrs attr)
-                                       token-attrs (cto/shape-attr->token-attrs attr)]
-                                   (if (not (and (touched attr-group)
-                                                 omit-touched?))
-                                     (into applied-tokens token-attrs)
-                                     applied-tokens)))
-                               #{}
-                               attrs)]
-    (cond-> changes
-      (seq applied-tokens)
-      (update-tokens container dest-shape origin-shape applied-tokens))))
-
-(defn- add-update-attr-changes
-  [changes dest-shape container roperations uoperations]
-  (let [all-parents (cfh/get-parent-ids (:objects container)
-                                        (:id dest-shape))]
-    (-> changes
-        (update :redo-changes conj (make-change
-                                    container
-                                    {:type :mod-obj
-                                     :id (:id dest-shape)
-                                     :operations roperations}))
-        (update :redo-changes conj (make-change
-                                    container
-                                    {:type :reg-objects
-                                     :shapes all-parents}))
-        (update :undo-changes conj (make-change
-                                    container
-                                    {:type :mod-obj
-                                     :id (:id dest-shape)
-                                     :operations (vec uoperations)}))
-        (update :undo-changes concat [(make-change
-                                       container
-                                       {:type :reg-objects
-                                        :shapes all-parents})]))))
-
-(defn- add-update-attr-operations
-  [attr dest-shape origin-shape roperations uoperations touched]
-  (let [;; position-data is a special case because can be affected by :geometry-group and :content-group
-        ;; so, if the position-data changes but the geometry is touched we need to reset the position-data
-        ;; so it's calculated again
-        reset-pos-data?
-        (and (cfh/text-shape? origin-shape)
-             (= attr :position-data)
-             (not= (get origin-shape attr) (get dest-shape attr))
-             (touched :geometry-group))
-
-        roperation {:type :set
-                    :attr attr
-                    :val (cond
-                           ;; If position data changes and the geometry group is touched
-                           ;; we need to put to nil so we can regenerate it
-                           reset-pos-data? nil
-                           :else (get origin-shape attr))
-                    :ignore-touched true}
-        uoperation {:type :set
-                    :attr attr
-                    :val (get dest-shape attr)
-                    :ignore-touched true}]
-    [(conj roperations roperation)
-     (conj uoperations uoperation)]))
-
 (defn- update-attrs
   "The main function that implements the attribute sync algorithm. Copy
   attributes that have changed in the origin shape to the dest shape.
@@ -1719,68 +1638,97 @@
         origin-shape (reposition-shape origin-shape origin-root dest-root)
         touched      (get dest-shape :touched #{})]
 
-    (loop [attrs updatable-attrs
+    (loop [attrs (->> (seq (keys ctk/sync-attrs))
+                      ;; We don't update the flex-child attrs
+                      (remove ctk/swap-keep-attrs)
+                      ;; We don't do automatic update of the `layout-grid-cells` property.
+                      (remove #(= :layout-grid-cells %)))
+           applied-tokens #{}
            roperations []
            uoperations '()]
 
       (let [attr (first attrs)]
         (if (nil? attr)
-          (cond-> changes
-            (seq roperations)
-            (add-update-attr-changes dest-shape container roperations uoperations)
-            :always
-            (generate-update-tokens container dest-shape origin-shape touched omit-touched?))
+          (if (and (empty? roperations) (empty? applied-tokens))
+            changes
+            (let [all-parents (cfh/get-parent-ids (:objects container)
+                                                  (:id dest-shape))
 
-          (let [attr-group (get ctk/sync-attrs attr)
-                [roperations' uoperations']
-                (if (or (= (get origin-shape attr) (get dest-shape attr))
-                        (and (touched attr-group) omit-touched?))
-                  [roperations uoperations]
-                  (add-update-attr-operations attr dest-shape origin-shape roperations uoperations touched))]
-            (recur (next attrs)
-                   roperations'
-                   uoperations')))))))
+                  ;; Sync tokens of attributes ignored above.
+                  ;; FIXME: this probably may be merged with the other calculation
+                  ;;        of applied tokens, below, and to the calculation only once
+                  ;;        for all sync-attrs.
+                  applied-tokens (reduce (fn [applied-tokens attr]
+                                           (let [attr-group (get ctk/sync-attrs attr)
+                                                 token-attrs (cto/shape-attr->token-attrs attr)]
+                                             (if (not (and (touched attr-group)
+                                                           omit-touched?))
+                                               (into applied-tokens token-attrs)
+                                               applied-tokens)))
+                                         applied-tokens
+                                         ctk/swap-keep-attrs)]
+              (cond-> changes
+                (seq roperations)
+                (-> (update :redo-changes conj (make-change
+                                                container
+                                                {:type :mod-obj
+                                                 :id (:id dest-shape)
+                                                 :operations roperations}))
+                    (update :redo-changes conj (make-change
+                                                container
+                                                {:type :reg-objects
+                                                 :shapes all-parents}))
+                    (update :undo-changes conj (make-change
+                                                container
+                                                {:type :mod-obj
+                                                 :id (:id dest-shape)
+                                                 :operations (vec uoperations)}))
+                    (update :undo-changes concat [(make-change
+                                                   container
+                                                   {:type :reg-objects
+                                                    :shapes all-parents})]))
+                (seq applied-tokens)
+                (update-tokens container dest-shape origin-shape applied-tokens))))
 
-(defn update-attrs-on-switch
-  "Copy attributes that have changed in the origin shape to the dest shape. Used on variants switch"
-  [changes dest-shape origin-shape dest-root origin-root origin-ref-shape container]
-  (let [;; We need to sync only the position relative to the origin of the component.
-        ;; (see update-attrs for a full explanation)
-        origin-shape   (reposition-shape origin-shape origin-root dest-root)
-        touched        (get dest-shape :touched #{})
-        touched-origin (get origin-shape :touched #{})]
+          (let [;; position-data is a special case because can be affected by :geometry-group and :content-group
+                ;; so, if the position-data changes but the geometry is touched we need to reset the position-data
+                ;; so it's calculated again
+                reset-pos-data?
+                (and (cfh/text-shape? origin-shape)
+                     (= attr :position-data)
+                     (not= (get origin-shape attr) (get dest-shape attr))
+                     (touched :geometry-group))
 
-    (loop [attrs       updatable-attrs
-           roperations [{:type :set-touched :touched (:touched origin-shape)}]
-           uoperations (list {:type :set-touched :touched (:touched dest-shape)})]
-      (if-let [attr (first attrs)]
-        (let [attr-group (get ctk/sync-attrs attr)
-              [roperations' uoperations']
-              (if (or
-                             ;; If the attribute is not valid for the destiny, don't copy it
-                   (not (cts/is-allowed-attr? attr (:type dest-shape)))
-                             ;; If the values are already equal, don't copy it
-                   (= (get origin-shape attr) (get dest-shape attr))
-                             ;; If the referenced shape on the original component doesn't have the same value, don't copy it
-                             ;; Exceptions: :points :selrect and :content can be different
-                   (and
-                    (not (contains? #{:points :selrect :content} attr))
-                    (not= (get origin-ref-shape attr) (get dest-shape attr)))
-                             ;; The :content attr cant't be copied to elements of different type
-                   (and (= attr :content) (not= (:type origin-shape) (:type dest-shape)))
-                             ;; If the attr is not touched in the origin shape, don't copy it
-                   (not (touched-origin attr-group)))
-                [roperations uoperations]
-                (add-update-attr-operations attr dest-shape origin-shape roperations uoperations touched))]
-          (recur (next attrs)
-                 roperations'
-                 uoperations'))
-        (cond-> changes
-          (> (count roperations) 1)
-          (add-update-attr-changes dest-shape container roperations uoperations)
+                roperation {:type :set
+                            :attr attr
+                            :val (cond
+                                   ;; If position data changes and the geometry group is touched
+                                   ;; we need to put to nil so we can regenerate it
+                                   reset-pos-data? nil
+                                   :else (get origin-shape attr))
+                            :ignore-touched true}
+                uoperation {:type :set
+                            :attr attr
+                            :val (get dest-shape attr)
+                            :ignore-touched true}
 
-          :always
-          (generate-update-tokens container dest-shape origin-shape touched false))))))
+                attr-group (get ctk/sync-attrs attr)
+
+                token-attrs (cto/shape-attr->token-attrs attr)
+                applied-tokens' (cond-> applied-tokens
+                                  (not (and (touched attr-group)
+                                            omit-touched?))
+                                  (into token-attrs))]
+            (if (or (= (get origin-shape attr) (get dest-shape attr))
+                    (and (touched attr-group) omit-touched?))
+              (recur (next attrs)
+                     applied-tokens'
+                     roperations
+                     uoperations)
+              (recur (next attrs)
+                     applied-tokens'
+                     (conj roperations roperation)
+                     (conj uoperations uoperation)))))))))
 
 (defn- propagate-attrs
   "Helper that puts the origin attributes (attrs) into dest but only if

common/src/app/common/logic/variant_properties.cljc

@@ -112,10 +112,9 @@
   (reduce generate-make-shape-no-variant changes shapes))
 
 
-(defn- create-new-properties-from-variant
+(defn- generate-new-properties-from-variant
   [shape min-props data container-name base-properties]
   (let [component (ctcl/get-component data (:component-id shape) true)
-
         add-name? (not= (:name component) container-name)
         props     (ctv/merge-properties base-properties
                                         (:variant-properties component))
@@ -128,7 +127,7 @@
       (ctv/add-new-prop props (:name component))
       props)))
 
-(defn- create-new-properties-from-non-variant
+(defn- generate-new-properties-from-non-variant
   [shape min-props container-name base-properties]
   (let [;; Remove container name from shape name if present
         shape-name (ctv/remove-prefix (:name shape) container-name)]
@@ -156,14 +155,14 @@
         [cpath cname]  (cfh/parse-path-name (:name variant-container))
         container-name (:name variant-container)
 
-        create-new-properties
+        generate-new-properties
         (fn [shape min-props]
           (if (ctk/is-variant? shape)
-            (create-new-properties-from-variant shape min-props data container-name base-props)
-            (create-new-properties-from-non-variant shape min-props container-name base-props)))
+            (generate-new-properties-from-variant shape min-props data container-name base-props)
+            (generate-new-properties-from-non-variant shape min-props container-name base-props)))
 
         total-props    (reduce (fn [m shape]
-                                 (max m (count (create-new-properties shape num-base-props))))
+                                 (max m (count (generate-new-properties shape num-base-props))))
                                0
                                shapes)
 
@@ -181,21 +180,19 @@
                                                   :name (:name variant-container)))]
     (reduce
      (fn [changes shape]
-       (let [component (ctcl/get-component data (:component-id shape) true)]
-         (if (or (zero? num-base-props)                  ;; do nothing if there are no base props
-                 (and (= variant-id (:variant-id shape)) ;; or we are only moving the shape inside its parent (it is
-                      (not (:deleted component))))       ;; the same parent and the component isn't deleted)
-           changes
-           (let [props               (create-new-properties shape total-props)
-                 variant-name        (ctv/properties-to-name props)]
-             (-> (pcb/update-component changes
-                                       (:component-id shape)
-                                       #(assoc % :variant-id variant-id
-                                               :variant-properties props
-                                               :name cname
-                                               :path cpath)
-                                       {:apply-changes-local-library? true})
-                 (pcb/update-shapes [(:id shape)]
-                                    #(assoc % :variant-name variant-name)))))))
+       (if (or (zero? num-base-props)
+               (= variant-id (:variant-id shape)))
+         changes ;; do nothing more if we aren't changing the parent or there are no base props
+         (let [props               (generate-new-properties shape total-props)
+               variant-name        (ctv/properties-to-name props)]
+           (-> (pcb/update-component changes
+                                     (:component-id shape)
+                                     #(assoc % :variant-id variant-id
+                                             :variant-properties props
+                                             :name cname
+                                             :path cpath)
+                                     {:apply-changes-local-library? true})
+               (pcb/update-shapes [(:id shape)]
+                                  #(assoc % :variant-name variant-name))))))
      changes
-     shapes)))
+     shapes)))

common/src/app/common/logic/variants.cljc

@@ -1,30 +1,12 @@
 (ns app.common.logic.variants
   (:require
    [app.common.files.changes-builder :as pcb]
-   [app.common.files.helpers :as cfh]
    [app.common.files.variant :as cfv]
    [app.common.logic.libraries :as cll]
    [app.common.logic.variant-properties :as clvp]
-   [app.common.types.components-list :as ctcl]
-   [app.common.types.container :as ctn]
-   [app.common.types.file :as ctf]
    [app.common.types.variant :as ctv]))
 
 
-(defn- generate-path
-  [path objects base-id shape]
-  (let [get-type #(case %
-                    :frame :container
-                    :group :container
-                    :rect  :shape
-                    :circle :shape
-                    :bool :shape
-                    :path :shape
-                    %)]
-    (if (= base-id (:id shape))
-      path
-      (generate-path (str path " " (:name shape) (get-type (:type shape))) objects base-id (get objects (:parent-id shape))))))
-
 (defn generate-add-new-variant
   [changes shape variant-id new-component-id new-shape-id prop-num]
   (let [data                (pcb/get-library-data changes)
@@ -46,30 +28,3 @@
     (-> changes
         (clvp/generate-update-property-value new-component-id prop-num value)
         (pcb/change-parent (:parent-id shape) [new-shape] 0))))
-
-(defn generate-keep-touched
-  [changes new-shape original-shape original-shapes page]
-  (let [data         (pcb/get-library-data changes)
-        objects      (pcb/get-objects changes)
-
-        orig-comp    (ctcl/get-component data (:component-id original-shape) true)
-
-        new-path-map (into {}
-                           (map (fn [shape] {(generate-path "" objects (:id new-shape) shape) shape}))
-                           (cfh/get-children-with-self objects (:id new-shape)))
-
-        orig-touched (filter (comp seq :touched) original-shapes)
-        orig-objects (into {} (map (juxt :id identity) original-shapes))
-        container    (ctn/make-container page :page)]
-    (reduce
-     (fn [changes touched-shape]
-       (let [path (generate-path "" orig-objects (:id original-shape) touched-shape)
-             related-shape  (get new-path-map path)
-             orig-ref-shape (ctf/get-ref-shape data orig-comp touched-shape)]
-         (if related-shape
-           (cll/update-attrs-on-switch
-            changes related-shape touched-shape new-shape original-shape orig-ref-shape container)
-           changes)))
-     changes
-     orig-touched)))
-

common/src/app/common/schema.cljc

@@ -9,7 +9,6 @@
   #?(: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]
@@ -215,8 +214,7 @@
 
 (defn lazy-validator
   [s]
-  (let [s   (schema s)
-        vfn (delay (validator s))]
+  (let [vfn (delay (validator s))]
     (fn [v] (@vfn v))))
 
 (defn lazy-explainer
@@ -319,11 +317,14 @@
   ([params]
    (cond
      (map? params)
-     (let [type (get params :type)]
+     (let [mdata (meta params)
+           type  (or (get mdata ::id)
+                     (get mdata ::type)
+                     (get params :type))]
        (assert (qualified-keyword? type) "expected qualified keyword for `type`")
        (let [s (m/-simple-schema params)]
          (swap! sr/registry assoc type s)
-         nil))
+         s))
 
      (vector? params)
      (let [mdata (meta params)
@@ -331,11 +332,12 @@
                      (get mdata ::type))]
        (assert (qualified-keyword? type) "expected qualified keyword to be on metadata")
        (swap! sr/registry assoc type params)
-       nil)
+       params)
 
      (m/into-schema? params)
      (let [type (m/-type params)]
-       (swap! sr/registry assoc type params))
+       (swap! sr/registry assoc type params)
+       params)
 
      :else
      (throw (ex-info "Invalid Arguments" {}))))
@@ -833,8 +835,7 @@
 
           gen  (sg/one-of
                 (sg/small-int :max max :min min)
-                (->> (sg/small-double :max max :min min)
-                     (sg/fmap #(mth/precision % 2))))]
+                (sg/small-double :max max :min min))]
 
       {:pred pred
        :type-properties
@@ -909,22 +910,6 @@
    ::oapi/type "string"
    ::oapi/format "iso"}})
 
-(register!
- {:type ::timestamp
-  :pred inst?
-  :type-properties
-  {:title "inst"
-   :description "Satisfies Inst protocol"
-   :error/message "should be an instant"
-   :gen/gen (->> (sg/small-int)
-                 (sg/fmap (fn [v] (tm/parse-instant v))))
-   :decode/string tm/parse-instant
-   :encode/string inst-ms
-   :decode/json tm/parse-instant
-   :encode/json inst-ms
-   ::oapi/type "string"
-   ::oapi/format "number"}})
-
 (register!
  {:type ::fn
   :pred fn?})
@@ -1060,6 +1045,8 @@
      {:title "agent"
       :description "instance of clojure agent"}}))
 
+(register! ::any (mu/update-properties :any assoc :gen/gen sg/any))
+
 ;; ---- PREDICATES
 
 (def valid-safe-number?

common/src/app/common/schema/desc_js_like.cljc

@@ -7,6 +7,7 @@
 (ns app.common.schema.desc-js-like
   (:require
    [app.common.data :as d]
+   [app.common.schema :as-alias sm]
    [cuerdas.core :as str]
    [malli.core :as m]
    [malli.util :as mu]))
@@ -90,7 +91,7 @@
 (defmethod visit :int [_ schema _ _] (str "integer" (-titled schema) (-min-max-suffix-number schema)))
 (defmethod visit :double [_ schema _ _] (str "double" (-titled schema) (-min-max-suffix-number schema)))
 (defmethod visit :select-keys [_ schema _ options] (describe* (m/deref schema) options))
-(defmethod visit :and [_ s children _] (str (str/join ", and " children) (-titled s)))
+(defmethod visit :and [_ s children _] (str (str/join " && " children) (-titled s)))
 (defmethod visit :enum [_ s children _options] (str "enum" (-titled s) " of " (str/join ", " children)))
 (defmethod visit :maybe [_ _ children _] (str (first children) " nullable"))
 (defmethod visit :tuple [_ _ children _] (str "(" (str/join ", " children) ")"))
@@ -106,7 +107,8 @@
 (defmethod visit :qualified-symbol [_ _ _ _] "qualified symbol")
 (defmethod visit :uuid [_ _ _ _] "uuid")
 (defmethod visit :boolean [_ _ _ _] "boolean")
-(defmethod visit :keyword [_ _ _ _] "keyword")
+(defmethod visit :keyword [_ _ _ _] "string")
+(defmethod visit :fn [_ _ _ _] "FN")
 
 (defmethod visit :vector [_ _ children _]
   (str "[" (last children) "]"))
@@ -123,10 +125,12 @@
 (defmethod visit :repeat [_ schema children _]
   (str "repeat " (-diamond (first children)) (-repeat-suffix schema)))
 
-
 (defmethod visit :set [_ schema children _]
   (str "set[" (first children) "]" (minmax-suffix schema)))
 
+(defmethod visit ::sm/set [_ schema children _]
+  (str "set[" (first children) "]" (minmax-suffix schema)))
+
 (defmethod visit ::m/val [_ schema children _]
   (let [suffix (minmax-suffix schema)]
     (cond-> (first children)
@@ -152,7 +156,6 @@
     (or (:title props)
         "*")))
 
-
 (defmethod visit :map
   [_ schema children {:keys [::level ::max-level] :as options}]
   (let [props   (m/properties schema)
@@ -172,13 +175,11 @@
                                       ": " s)))
                           (str/join ",\n"))
 
-            header   (cond-> (if (zero? level)
-                               (str "type " title)
-                               (str title))
+            header   (cond-> (str "type " title)
                        closed?       (str "!")
                        (some? title) (str " "))]
 
-        (str header "{\n" entries "\n" (pad "}" level))))))
+        (str (pad header level) "{\n" entries "\n" (pad "}\n" level))))))
 
 (defmethod visit :multi
   [_ s children {:keys [::level ::max-level] :as options}]
@@ -205,18 +206,18 @@
 
 (defmethod visit :merge
   [_ schema children _]
-  (let [entries (str/join " , " children)
+  (let [entries (str/join ",\n" children)
         props   (m/properties schema)
         title   (or (some-> (:title props) str/camel str/capital)
                     "<untitled>")]
-    (str "merge object " title " { " entries " }")))
+    (str "merge type " title " { \n" entries "\n}\n")))
 
-(defmethod visit :app.common.schema/one-of
-  [_ _  children _]
+(defmethod visit ::sm/one-of
+  [_ _ children _]
   (let [elems (last children)]
-    (str "OneOf[" (->> elems
-                       (map d/name)
-                       (str/join ",")) "]")))
+    (str "string oneOf (" (->> elems
+                               (map d/name)
+                               (str/join "|")) ")")))
 
 (defmethod visit :schema [_ schema children options]
   (visit ::m/schema schema children options))

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 vector])
+  (:refer-clojure :exclude [set subseq uuid filter map let boolean vector keyword int double])
   #?(:cljs (:require-macros [app.common.schema.generators]))
   (:require
    [app.common.schema.registry :as sr]
@@ -38,10 +38,6 @@
   ([s opts]
    (mg/generator s (assoc opts :registry sr/default-registry))))
 
-(defn filter
-  [pred gen]
-  (tg/such-that pred gen 100))
-
 (defn small-double
   [& {:keys [min max] :or {min -100 max 100}}]
   (tg/double* {:min min, :max max, :infinite? false, :NaN? false}))
@@ -61,7 +57,7 @@
 (defn word-keyword
   []
   (->> (word-string)
-       (tg/fmap keyword)))
+       (tg/fmap c/keyword)))
 
 (defn email
   []
@@ -100,12 +96,11 @@
                           (c/map second))
                          (c/map list bools elements)))))))
 
-(def any tg/any)
-(def boolean tg/boolean)
-
-(defn set
-  [g]
-  (tg/set g))
+(defn map-of
+  ([kg vg]
+   (tg/map kg vg {:min-elements 1 :max-elements 3}))
+  ([kg vg opts]
+   (tg/map kg vg opts)))
 
 (defn elements
   [s]
@@ -119,6 +114,10 @@
   [f g]
   (tg/fmap f g))
 
+(defn filter
+  [pred gen]
+  (tg/such-that pred gen 100))
+
 (defn mcat
   [f g]
   (tg/bind g f))
@@ -130,3 +129,18 @@
 (defn vector
   [& opts]
   (apply tg/vector opts))
+
+(defn set
+  [g]
+  (tg/set g))
+
+;; Static Generators
+
+(def boolean tg/boolean)
+(def text (word-string))
+(def double (small-double))
+(def int (small-int))
+(def keyword (word-keyword))
+
+(def any
+  (tg/one-of [text boolean double int keyword]))

common/src/app/common/schema/openapi.cljc

@@ -97,7 +97,8 @@
 (defmethod visit :enum [_ _ children options] (merge (some-> (m/-infer children) (transform* options)) {:enum children}))
 (defmethod visit :maybe [_ _ children _] {:oneOf (conj children {:type "null"})})
 (defmethod visit :tuple [_ _ children _] {:type "array", :items children, :additionalItems false})
-(defmethod visit :re [_ schema _ options] {:type "string", :pattern (first (m/children schema options))})
+(defmethod visit :re [_ schema _ options]
+  {:type "string", :pattern (str (first (m/children schema options)))})
 (defmethod visit :nil [_ _ _ _] {:type "null"})
 
 (defmethod visit :string [_ schema _ _]

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

@@ -56,8 +56,13 @@
              (str "(pass=TRUE, tests=" (:num-tests params)  ", seed=" (:seed params) ", elapsed=" time "ms)"))))
 
 (defmethod ct/report #?(:clj ::thrunk :cljs [:cljs.test/default ::thrunk])
-  [_]
-  nil)
+  [{:keys [::params] :as m}]
+  (let [smallest (-> params :shrunk :smallest vec)]
+    (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])
   [_]
@@ -71,12 +76,9 @@
   (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/bool.cljc

@@ -4,42 +4,15 @@
 ;;
 ;; Copyright (c) KALEIDOS INC
 
-(ns app.common.types.path.bool
+(ns app.common.svg.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.types.path.helpers :as helpers]
-   [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]))
+   [app.common.svg.path.command :as upc]
+   [app.common.svg.path.subpath :as ups]))
 
 (defn add-previous
   ([content]
@@ -52,92 +25,87 @@
                   (assoc :prev first)
 
                   (some? prev)
-                  (assoc :prev (helpers/segment->point prev))))))))
+                  (assoc :prev (gsp/command->point prev))))))))
 
 (defn close-paths
   "Removes the :close-path commands and replace them for line-to so we can calculate
   the intersections"
   [content]
 
-  (loop [segments   (seq content)
-         result     []
-         last-move  nil
-         last-point nil]
-    (if-let [segment (first segments)]
-      (let [point
-            (helpers/segment->point segment)
+  (loop [head (first content)
+         content (rest content)
+         result []
+         last-move nil
+         last-p nil]
 
-            segment
-            (cond
-              (and (= :close-path (:command segment))
-                   (or (nil? last-point) ;; Ignore consecutive close-paths
-                       (< (gpt/distance last-point last-move) 0.01)))
-              nil
+    (if (nil? head)
+      result
+      (let [head-p (gsp/command->point head)
+            head (cond
+                   (and (= :close-path (:command head))
+                        (or (nil? last-p) ;; Ignore consecutive close-paths
+                            (< (gpt/distance last-p last-move) 0.01)))
+                   nil
 
-              (= :close-path (:command segment))
-              (helpers/make-line-to last-move)
+                   (= :close-path (:command head))
+                   (upc/make-line-to last-move)
 
-              :else
-              segment)]
+                   :else
+                   head)]
 
-        (recur (rest segments)
-               (cond-> result (some? segment) (conj segment))
-               (if (= :move-to (:command segment))
-                 point
+        (recur (first content)
+               (rest content)
+               (cond-> result (some? head) (conj head))
+               (if (= :move-to (:command head))
+                 head-p
                  last-move)
-               point))
-      result)))
+               head-p)))))
 
 (defn- split-command
   [cmd values]
   (case (:command cmd)
-    :line-to  (helpers/split-line-to-ranges (:prev cmd) cmd values)
-    :curve-to (helpers/split-curve-to-ranges (:prev cmd) cmd values)
+    :line-to  (gsp/split-line-to-ranges (:prev cmd) cmd values)
+    :curve-to (gsp/split-curve-to-ranges (:prev cmd) cmd values)
     [cmd]))
 
-(defn- split-ts
-  [seg-1 seg-2]
-  (let [cmd-1 (get seg-1 :command)
-        cmd-2 (get seg-2 :command)]
-    (cond
-      (and (= :line-to cmd-1)
-           (= :line-to cmd-2))
-      (helpers/line-line-intersect (helpers/command->line seg-1)
-                                   (helpers/command->line seg-2))
+(defn split-ts [seg-1 seg-2]
+  (cond
+    (and (= :line-to (:command seg-1))
+         (= :line-to (:command seg-2)))
+    (gsp/line-line-intersect (gsp/command->line seg-1) (gsp/command->line seg-2))
 
-      (and (= :line-to cmd-1)
-           (= :curve-to cmd-2))
-      (helpers/line-curve-intersect (helpers/command->line seg-1)
-                                    (helpers/command->bezier seg-2))
+    (and (= :line-to (:command seg-1))
+         (= :curve-to (:command seg-2)))
+    (gsp/line-curve-intersect (gsp/command->line seg-1) (gsp/command->bezier seg-2))
 
-      (and (= :curve-to cmd-1)
-           (= :line-to cmd-2))
-      (let [[seg-2' seg-1']
-            (helpers/line-curve-intersect (helpers/command->line seg-2)
-                                          (helpers/command->bezier seg-1))]
-        ;; Need to reverse because we send the arguments reversed
-        [seg-1' seg-2'])
+    (and (= :curve-to (:command seg-1))
+         (= :line-to (:command seg-2)))
+    (let [[seg-2' seg-1']
+          (gsp/line-curve-intersect (gsp/command->line seg-2) (gsp/command->bezier seg-1))]
+      ;; Need to reverse because we send the arguments reversed
+      [seg-1' seg-2'])
 
-      (and (= :curve-to cmd-1)
-           (= :curve-to cmd-2))
-      (helpers/curve-curve-intersect (helpers/command->bezier seg-1)
-                                     (helpers/command->bezier seg-2))
+    (and (= :curve-to (:command seg-1))
+         (= :curve-to (:command seg-2)))
+    (gsp/curve-curve-intersect (gsp/command->bezier seg-1) (gsp/command->bezier seg-2))
 
-      :else
-      [[] []])))
+    :else
+    [[] []]))
 
 (defn content-intersect-split
   [content-a content-b sr-a sr-b]
 
-  (let [command->selrect (memoize helpers/command->selrect)]
+  (let [command->selrect (memoize gsp/command->selrect)]
 
-    (letfn [(overlap-segment-selrect? [segment selrect]
+    (letfn [(overlap-segment-selrect?
+              [segment selrect]
               (if (= :move-to (:command segment))
                 false
                 (let [r1 (command->selrect segment)]
                   (grc/overlaps-rects? r1 selrect))))
 
-            (overlap-segments? [seg-1 seg-2]
+            (overlap-segments?
+              [seg-1 seg-2]
               (if (or (= :move-to (:command seg-1))
                       (= :move-to (:command seg-2)))
                 false
@@ -145,14 +113,17 @@
                       r2 (command->selrect seg-2)]
                   (grc/overlaps-rects? r1 r2))))
 
-            (split [seg-1 seg-2]
+            (split
+              [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 [segment content content-sr]
+            (split-segment-on-content
+              [segment content content-sr]
+
               (if (overlap-segment-selrect? segment content-sr)
                 (->> content
                      (filter #(overlap-segments? segment %))
@@ -162,7 +133,8 @@
                       [segment]))
                 [segment]))
 
-            (split-content [content-a content-b sr-b]
+            (split-content
+              [content-a content-b sr-b]
               (into []
                     (mapcat #(split-segment-on-content % content-b sr-b))
                     content-a))]
@@ -179,28 +151,28 @@
   [segment content content-sr content-geom]
 
   (let [point (case (:command segment)
-                :line-to  (-> (helpers/command->line segment)
-                              (helpers/line-values 0.5))
+                :line-to  (-> (gsp/command->line segment)
+                              (gsp/line-values 0.5))
 
-                :curve-to (-> (helpers/command->bezier segment)
-                              (helpers/curve-values 0.5)))]
+                :curve-to (-> (gsp/command->bezier segment)
+                              (gsp/curve-values 0.5)))]
 
     (and (grc/contains-point? content-sr point)
          (or
-          (helpers/is-point-in-geom-data? point content-geom)
-          (helpers/is-point-in-border? point content)))))
+          (gsp/is-point-in-geom-data? point content-geom)
+          (gsp/is-point-in-border? point content)))))
 
 (defn inside-segment?
   [segment content-sr content-geom]
   (let [point (case (:command segment)
-                :line-to  (-> (helpers/command->line segment)
-                              (helpers/line-values 0.5))
+                :line-to  (-> (gsp/command->line segment)
+                              (gsp/line-values 0.5))
 
-                :curve-to (-> (helpers/command->bezier segment)
-                              (helpers/curve-values 0.5)))]
+                :curve-to (-> (gsp/command->bezier segment)
+                              (gsp/curve-values 0.5)))]
 
     (and (grc/contains-point? content-sr point)
-         (helpers/is-point-in-geom-data? point content-geom))))
+         (gsp/is-point-in-geom-data? point content-geom))))
 
 (defn overlap-segment?
   "Finds if the current segment is overlapping against other
@@ -213,8 +185,8 @@
                      (contains? #{:line-to :curve-to} (:command segment)))
 
             (case (:command segment)
-              :line-to (let [[p1 q1] (helpers/command->line segment)
-                             [p2 q2] (helpers/command->line other)]
+              :line-to (let [[p1 q1] (gsp/command->line segment)
+                             [p2 q2] (gsp/command->line other)]
 
                          (when (or (and (< (gpt/distance p1 p2) 0.1)
                                         (< (gpt/distance q1 q2) 0.1))
@@ -222,8 +194,8 @@
                                         (< (gpt/distance q1 p2) 0.1)))
                            [segment other]))
 
-              :curve-to (let [[p1 q1 h11 h21] (helpers/command->bezier segment)
-                              [p2 q2 h12 h22] (helpers/command->bezier other)]
+              :curve-to (let [[p1 q1 h11 h21] (gsp/command->bezier segment)
+                              [p2 q2 h12 h22] (gsp/command->bezier other)]
 
                           (when (or (and (< (gpt/distance p1 p2) 0.1)
                                          (< (gpt/distance q1 q2) 0.1)
@@ -255,11 +227,11 @@
       result
 
       (let [result (if (not= (:prev current) prev)
-                     (conj result (helpers/make-move-to (:prev current)))
+                     (conj result (upc/make-move-to (:prev current)))
                      result)]
         (recur (first content)
                (rest content)
-               (helpers/segment->point current)
+               (gsp/command->point current)
                (conj result (dissoc current :prev)))))))
 
 (defn remove-duplicated-segments
@@ -301,43 +273,20 @@
                  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 (content->geom-data content-a)
-        content-b-geom (content->geom-data content-b)
+  (let [content-a-geom (gsp/content->geom-data content-a)
+        content-b-geom (gsp/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 (content->geom-data content)
+        content-geom (gsp/content->geom-data content)
 
-        content-sr (segment/content->selrect (fix-move-to content))
+        content-sr (gsp/content->selrect (fix-move-to content))
 
         ;; Overlapping segments should be added when they are part of the border
         border-content
@@ -353,8 +302,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 (content->geom-data content-a)
-        content-b-geom (content->geom-data content-b)]
+  (let [content-a-geom (gsp/content->geom-data content-a)
+        content-b-geom (gsp/content->geom-data content-b)]
     (d/concat-vec
      (->> content-a-split (filter #(not (contains-segment? % content-b sr-b content-b-geom))))
 
@@ -366,12 +315,13 @@
 (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 (content->geom-data content-a)
-        content-b-geom (content->geom-data content-b)]
+  (let [content-a-geom (gsp/content->geom-data content-a)
+        content-b-geom (gsp/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))
@@ -381,37 +331,26 @@
 
   (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)
-             (= (subpath/clockwise? content-b)
-                (subpath/clockwise? content-a)))
+        should-reverse? (and (not= :union bool-type)
+                             (= (ups/clockwise? content-b)
+                                (ups/clockwise? content-a)))
 
-        content-a
-        (-> content-a
-            (close-paths)
-            (add-previous))
+        content-a (-> content-a
+                      (close-paths)
+                      (add-previous))
 
-        content-b
-        (-> content-b
-            (close-paths)
-            (cond-> should-reverse? (subpath/reverse-content))
-            (add-previous))
+        content-b (-> content-b
+                      (close-paths)
+                      (cond-> should-reverse? (ups/reverse-content))
+                      (add-previous))
 
-        sr-a
-        (segment/content->selrect content-a)
-
-        sr-b
-        (segment/content->selrect content-b)
+        sr-a (gsp/content->selrect content-a)
+        sr-b (gsp/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-a-split add-previous (filter is-segment?))
-
-        content-b-split
-        (->> content-b-split add-previous (filter is-segment?))
+        [content-a-split content-b-split] (content-intersect-split content-a content-b sr-a sr-b)
+        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
@@ -423,16 +362,14 @@
     (-> content
         remove-duplicated-segments
         fix-move-to
-        subpath/close-subpaths)))
+        ups/close-subpaths)))
 
-(defn calculate-content
-  "Create a bool content from a collection of contents and specified
-  type."
+(defn content-bool
   [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))
-         (vec))
+         (into []))
     []))

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

@@ -0,0 +1,204 @@
+;; 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

@@ -0,0 +1,324 @@
+;; 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,23 +12,15 @@
   (: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.types.path.helpers :as path.helpers]
-   [app.common.types.path.segment :as path.segment]
+   [app.common.svg.path.command :as upc]
    [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  []
@@ -193,7 +185,7 @@
 
 (defn smooth->curve
   [{:keys [params]} pos handler]
-  (let [{c1x :x c1y :y} (path.segment/calculate-opposite-handler pos handler)]
+  (let [{c1x :x c1y :y} (upg/calculate-opposite-handler pos handler)]
     {:c1x c1x
      :c1y c1y
      :c2x (:cx params)
@@ -421,7 +413,7 @@
 
                   (= :smooth-quadratic-bezier-curve-to (:command command))
                   (-> (assoc :command :curve-to)
-                      (update :params merge (quadratic->curve prev-pos (gpt/point params) (path.segment/calculate-opposite-handler prev-pos prev-qc)))))
+                      (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))
@@ -444,13 +436,13 @@
                           (gpt/point (get-in orig-command [:params :cx]) (get-in orig-command [:params :cy]))
 
                           :smooth-quadratic-bezier-curve-to
-                          (path.segment/calculate-opposite-handler prev-pos prev-qc)
+                          (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
-                           (get-point prev-pos command))
+                           (upc/command->point prev-pos command))
 
                 next-start (if (= :move-to (:command command)) next-pos prev-start)]
 

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

@@ -4,34 +4,58 @@
 ;;
 ;; Copyright (c) KALEIDOS INC
 
-(ns app.common.types.path.shape-to-path
+(ns app.common.svg.path.shapes-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.types.path.bool :as bool]
-   [app.common.types.path.helpers :as helpers]
-   [app.common.types.path.impl :as path.impl]
-   [app.common.types.path.segment :as segm]
+   [app.common.geom.shapes.path :as gsp]
+   [app.common.svg.path.bool :as pb]
+   [app.common.svg.path.command :as pc]
    [app.common.types.shape.radius :as ctsr]))
 
-(def ^:const ^:private bezier-circle-c
-  0.551915024494)
+(def ^:const bezier-circle-c 0.551915024494)
 
-(def ^:private dissoc-attrs
+(def dissoc-attrs
   [:x :y :width :height
    :rx :ry :r1 :r2 :r3 :r4
    :metadata])
 
-(defn without-position-attrs
-  [shape]
-  (d/without-keys shape dissoc-attrs))
+(def allowed-transform-types
+  #{:rect
+    :circle
+    :image})
 
-(defn- make-corner-arc
+(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]))
+
+(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
@@ -67,9 +91,9 @@
              :bottom-right (assoc to :x c2x)
              :bottom-left  (assoc to :y c2y))]
 
-    (helpers/make-curve-to to h1 h2)))
+    (pc/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))
@@ -88,13 +112,13 @@
         c1y (+ y (* (/ height 2) (- 1 c)))
         c2y (+ y (* (/ height 2) (+ 1 c)))]
 
-    [(helpers/make-move-to p1)
-     (helpers/make-curve-to p2 (assoc p1 :x c2x) (assoc p2 :y c1y))
-     (helpers/make-curve-to p3 (assoc p2 :y c2y) (assoc p3 :x c2x))
-     (helpers/make-curve-to p4 (assoc p3 :x c1x) (assoc p4 :y c2y))
-     (helpers/make-curve-to p1 (assoc p4 :y c1y) (assoc p1 :x c1x))]))
+    [(pc/make-move-to p1)
+     (pc/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))
+     (pc/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))]))
 
-(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))
 
@@ -111,21 +135,21 @@
          p7 (gpt/point (+ x r4) (+ height y))
          p8 (gpt/point x (+ height y (- r4)))]
      (-> []
-         (conj (helpers/make-move-to p1))
+         (conj (pc/make-move-to p1))
          (cond-> (not= p1 p2)
            (conj (make-corner-arc p1 p2 :top-left r1)))
-         (conj (helpers/make-line-to p3))
+         (conj (pc/make-line-to p3))
          (cond-> (not= p3 p4)
            (conj (make-corner-arc p3 p4 :top-right r2)))
-         (conj (helpers/make-line-to p5))
+         (conj (pc/make-line-to p5))
          (cond-> (not= p5 p6)
            (conj (make-corner-arc p5 p6 :bottom-right r3)))
-         (conj (helpers/make-line-to p7))
+         (conj (pc/make-line-to p7))
          (cond-> (not= p7 p8)
            (conj (make-corner-arc p7 p8 :bottom-left r4)))
-         (conj (helpers/make-line-to p1))))))
+         (conj (pc/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)
@@ -141,10 +165,7 @@
 
 (declare convert-to-path)
 
-;; 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
+(defn fix-first-relative
   "Fix an issue with the simplify commands not changing the first relative"
   [content]
   (let [head (first content)]
@@ -152,19 +173,17 @@
       (and head (:relative head))
       (update 0 assoc :relative false))))
 
-(defn- group-to-path
+(defn group-to-path
   [group objects]
-  (let [xform (comp (map (d/getf objects))
-                    (map #(convert-to-path % objects)))
+  (let [xform (comp (map #(get objects %))
+                    (map #(-> (convert-to-path % objects))))
 
         child-as-paths (into [] xform (:shapes group))
-        head (peek child-as-paths)
-        head-data (select-keys head bool/style-properties)
+        head (last child-as-paths)
+        head-data (select-keys head style-properties)
         content (into []
-                      (comp (filter cfh/path-shape?)
-                            (map :content)
-                            (map vec)
-                            (mapcat fix-first-relative))
+                      (comp (filter #(= :path (:type %)))
+                            (mapcat #(fix-first-relative (:content %))))
                       child-as-paths)]
     (-> group
         (assoc :type :path)
@@ -172,68 +191,54 @@
         (merge head-data)
         (d/without-keys dissoc-attrs))))
 
-(defn- bool-to-path
+(defn bool-to-path
   [shape objects]
 
-  (let [children
-        (->> (:shapes shape)
-             (map (d/getf objects))
-             (map #(convert-to-path % objects)))
-
-        bool-type
-        (:bool-type shape)
-
-        content
-        (bool/calculate-content bool-type (map :content children))]
-
+  (let [children (->> (:shapes shape)
+                      (map #(get objects %))
+                      (map #(convert-to-path % objects)))
+        bool-type (:bool-type shape)
+        content (pb/content-bool bool-type (mapv :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 shape"
-  [shape objects]
-  (assert (map? objects))
-  ;; FIXME: add check-objects-like
-  ;; FIXME: add check-shape ?
+  "Transforms the given shape to a path"
+  ([shape]
+   (convert-to-path shape {}))
+  ([{:keys [type metadata] :as shape} objects]
+   (assert (map? objects))
+   (case type
+     (:group :frame)
+     (group-to-path shape objects)
 
-  (let [type (dm/get-prop shape :type)]
+     :bool
+     (bool-to-path shape objects)
 
-    (case type
-      (:group :frame)
-      (group-to-path shape objects)
+     (:rect :circle :image :text)
+     (let [new-content
+           (case type
+             :circle (circle->path shape)
+             #_:else (rect->path shape))
 
-      :bool
-      (bool-to-path shape objects)
+           ;; Apply the transforms that had the 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)))
 
-      (:rect :circle :image :text)
-      (let [content
-            (if (= type :circle)
-              (circle->path shape)
-              (rect->path shape))
+           new-content (cond-> new-content
+                         (some? transform)
+                         (gsp/transform-content (gmt/transform-in (gco/shape->center shape) transform)))]
 
-            content
-            (path.impl/from-plain content)
+       (-> shape
+           (assoc :type :path)
+           (assoc :content new-content)
+           (cond-> (= :image type)
+             (assoc :fill-image metadata))
+           (d/without-keys dissoc-attrs)))
 
-            ;; Apply the transforms that had the 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)))
+     ;; For the rest return the plain shape
+     shape)))

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

@@ -4,11 +4,11 @@
 ;;
 ;; Copyright (c) KALEIDOS INC
 
-(ns app.common.types.path.subpath
+(ns app.common.svg.path.subpath
   (:require
    [app.common.data :as d]
    [app.common.geom.point :as gpt]
-   [app.common.types.path.helpers :as helpers]))
+   [app.common.svg.path.command :as upc]))
 
 (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 (helpers/segment->point command)]
+   (let [p (upc/command->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))
-                  (helpers/make-line-to (:from subpath))
+                  (upc/make-line-to (:from subpath))
                   command)
-        p (helpers/segment->point command)]
+        p (upc/command->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 [(helpers/make-move-to (:to subpath))]))]
+                      (reduce reverse-commands [(upc/make-move-to (:to subpath))]))]
 
     (make-subpath (:to subpath) (:from subpath) new-data)))
 
@@ -125,9 +125,6 @@
 (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]
@@ -156,17 +153,20 @@
                        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)
-       (into [] xf-mapcat-data)))
+       (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} (helpers/segment->point current)
+        (let [{x1 :x y1 :y :as p} (upc/command->point current)
               last? (nil? (first subpath))
               first-point (if (nil? first-point) p first-point)
-              {x2 :x y2 :y} (if last? first-point (helpers/segment->point (first subpath)))
+              {x2 :x y2 :y} (if last? first-point (upc/command->point (first subpath)))
               signed-area (+ signed-area (- (* x1 y2) (* x2 y1)))]
 
           (recur (first subpath)

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

@@ -22,7 +22,6 @@
    [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]))
@@ -221,9 +220,9 @@
     (let [transform (csvg/parse-transform (:transform attrs))
           content   (cond-> (path/parse (:d attrs))
                       (some? transform)
-                      (path.segm/transform-content transform))
+                      (gsh/transform-content transform))
 
-          selrect    (path.segm/content->selrect content)
+          selrect    (gsh/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/color.cljc

@@ -35,7 +35,7 @@
                        (.. r (toString 16) (padStart 2 "0"))
                        (.. g (toString 16) (padStart 2 "0"))
                        (.. b (toString 16) (padStart 2 "0"))))))
-           sg/any))
+           sg/int))
 
 (defn rgb-color-string?
   [o]

common/src/app/common/types/component.cljc

@@ -287,7 +287,7 @@
 
 (defn get-component-root
   [component]
-  (if (some? (:main-instance-id component))
+  (if (true? (:main-instance-id component))
     (get-in component [:objects (:main-instance-id component)])
     (get-in component [:objects (:id component)])))
 

common/src/app/common/types/container.cljc

@@ -41,7 +41,7 @@
    [:map-of {:gen/max 10} ::sm/uuid :map]]
   [:plugin-data {:optional true} ::ctpg/plugin-data]])
 
-(def check-container!
+(def check-container
   (sm/check-fn ::container))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -74,13 +74,9 @@
 (defn get-shape
   [container shape-id]
 
-  (dm/assert!
-   "expected valid container"
-   (check-container! container))
-
-  (dm/assert!
-   "expected valid uuid for `shape-id`"
-   (uuid? shape-id))
+  (assert (check-container container))
+  (assert (uuid? shape-id)
+          "expected valid uuid for `shape-id`")
 
   (-> container
       (get :objects)

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)
+       (some? page-id)
        (ctpl/add-page page)
 
        :always
-       (update :options assoc :components-v2 true)))))
+       (assoc-in [:options :components-v2] true)))))
 
 (defn make-file
   [{:keys [id project-id name revn is-shared features

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

@@ -1,215 +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.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/impl.cljc

@@ -1,782 +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.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

@@ -1,889 +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.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/shape.cljc

@@ -22,14 +22,13 @@
    [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]
@@ -235,7 +234,7 @@
   [:map {:title "BoolAttrs"}
    [:shapes [:vector {:gen/max 10 :gen/min 1} ::sm/uuid]]
    [:bool-type [::sm/one-of bool-types]]
-   [:content ::path/content]])
+   [:content ::ctsp/content]])
 
 (def ^:private schema:rect-attrs
   [:map {:title "RectAttrs"}])
@@ -260,7 +259,7 @@
 
 (def ^:private schema:path-attrs
   [:map {:title "PathAttrs"}
-   [:content ::path/content]])
+   [:content ::ctsp/content]])
 
 (def ^:private schema:text-attrs
   [:map {:title "TextAttrs"}
@@ -397,50 +396,6 @@
   (or (some :fill-image fills)
       (some :stroke-image strokes)))
 
-;; Valid attributes
-
-(def ^:private allowed-shape-attrs #{:page-id :component-id :component-file :component-root :main-instance
-                                     :remote-synced :shape-ref :touched :blocked :collapsed :locked
-                                     :hidden :masked-group :fills :proportion :proportion-lock :constraints-h
-                                     :constraints-v :fixed-scroll :r1 :r2 :r3 :r4 :opacity :grids :exports
-                                     :strokes :blend-mode :interactions :shadow :blur :grow-type :applied-tokens
-                                     :plugin-data})
-(def ^:private allowed-shape-geom-attrs #{:x :y :width :height})
-(def ^:private allowed-shape-base-attrs #{:id :name :type :selrect :points :transform :transform-inverse :parent-id :frame-id})
-(def ^:private allowed-bool-attrs #{:shapes :bool-type :content})
-(def ^:private allowed-group-attrs #{:shapes})
-(def ^:private allowed-frame-attrs #{:shapes :hide-fill-on-export :show-content :hide-in-viewer})
-(def ^:private allowed-image-attrs #{:metadata})
-(def ^:private allowed-svg-attrs #{:content})
-(def ^:private allowed-path-attrs #{:content})
-(def ^:private allowed-text-attrs #{:content})
-(def ^:private allowed-generic-attrs (set/union allowed-shape-attrs allowed-shape-geom-attrs allowed-shape-base-attrs))
-
-(defn is-allowed-attr?
-  [attr type]
-  (case type
-    :group   (or (contains? allowed-group-attrs attr)
-                 (contains? allowed-generic-attrs attr))
-    :frame   (or (contains? allowed-frame-attrs attr)
-                 (contains? allowed-generic-attrs attr))
-    :bool    (or (contains? allowed-bool-attrs attr)
-                 (contains? allowed-shape-attrs attr)
-                 (contains? allowed-shape-base-attrs attr))
-    :rect    (contains? allowed-generic-attrs attr)
-    :circle  (contains? allowed-generic-attrs attr)
-    :image   (or (contains? allowed-image-attrs attr)
-                 (contains? allowed-generic-attrs attr))
-    :svg-raw (or (contains? allowed-svg-attrs attr)
-                 (contains? allowed-generic-attrs attr))
-    :path    (or (contains? allowed-path-attrs attr)
-                 (contains? allowed-shape-attrs attr)
-                 (contains? allowed-shape-base-attrs attr))
-    :text    (or (contains? allowed-text-attrs attr)
-                 (contains? allowed-generic-attrs attr))))
-
-
-
-
 ;; --- Initialization
 
 (def ^:private minimal-rect-attrs
@@ -570,7 +525,7 @@
 (defn setup-path
   [{:keys [content selrect points] :as shape}]
   (let [selrect (or selrect
-                    (path.segment/content->selrect content)
+                    (gsh/content->selrect content)
                     (grc/make-rect))
         points  (or points  (grc/rect->points selrect))]
     (-> shape

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

@@ -0,0 +1,431 @@
+;; 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/types/shape/text.cljc

@@ -16,54 +16,56 @@
 
 (def node-types #{"root" "paragraph-set" "paragraph"})
 
-(sm/register!
- ^{::sm/type ::content}
- [:map
-  [:type [:= "root"]]
-  [:key {:optional true} :string]
-  [:children
-   {:optional true}
-   [:maybe
-    [:vector {:min 1 :gen/max 2 :gen/min 1}
-     [:map
-      [:type [:= "paragraph-set"]]
-      [:key {:optional true} :string]
-      [:children
-       [:vector {:min 1 :gen/max 2 :gen/min 1}
-        [:map
-         [:type [:= "paragraph"]]
-         [:key {:optional true} :string]
-         [:fills {:optional true}
-          [:maybe
-           [:vector {:gen/max 2} ::shape/fill]]]
-         [:font-family {:optional true} :string]
-         [:font-size {:optional true} :string]
-         [:font-style {:optional true} :string]
-         [:font-weight {:optional true} :string]
-         [:direction {:optional true} :string]
-         [:text-decoration {:optional true} :string]
-         [:text-transform {:optional true} :string]
-         [:typography-ref-id {:optional true} [:maybe ::sm/uuid]]
-         [:typography-ref-file {:optional true} [:maybe ::sm/uuid]]
-         [:children
-          [:vector {:min 1 :gen/max 2 :gen/min 1}
-           [:map
-            [:text :string]
-            [:key {:optional true} :string]
-            [:fills {:optional true}
-             [:maybe
-              [:vector {:gen/max 2} ::shape/fill]]]
-            [:font-family {:optional true} :string]
-            [:font-size {:optional true} :string]
-            [:font-style {:optional true} :string]
-            [:font-weight {:optional true} :string]
-            [:direction {:optional true} :string]
-            [:text-decoration {:optional true} :string]
-            [:text-transform {:optional true} :string]
-            [:typography-ref-id {:optional true} [:maybe ::sm/uuid]]
-            [:typography-ref-file {:optional true} [:maybe ::sm/uuid]]]]]]]]]]]]])
+(def schema:content
+  [:map
+   [:type [:= "root"]]
+   [:key {:optional true} :string]
+   [:children
+    {:optional true}
+    [:maybe
+     [:vector {:min 1 :gen/max 2 :gen/min 1}
+      [:map
+       [:type [:= "paragraph-set"]]
+       [:key {:optional true} :string]
+       [:children
+        [:vector {:min 1 :gen/max 2 :gen/min 1}
+         [:map
+          [:type [:= "paragraph"]]
+          [:key {:optional true} :string]
+          [:fills {:optional true}
+           [:maybe
+            [:vector {:gen/max 2} ::shape/fill]]]
+          [:font-family {:optional true} :string]
+          [:font-size {:optional true} :string]
+          [:font-style {:optional true} :string]
+          [:font-weight {:optional true} :string]
+          [:direction {:optional true} :string]
+          [:text-decoration {:optional true} :string]
+          [:text-transform {:optional true} :string]
+          [:typography-ref-id {:optional true} [:maybe ::sm/uuid]]
+          [:typography-ref-file {:optional true} [:maybe ::sm/uuid]]
+          [:children
+           [:vector {:min 1 :gen/max 2 :gen/min 1}
+            [:map
+             [:text :string]
+             [:key {:optional true} :string]
+             [:fills {:optional true}
+              [:maybe
+               [:vector {:gen/max 2} ::shape/fill]]]
+             [:font-family {:optional true} :string]
+             [:font-size {:optional true} :string]
+             [:font-style {:optional true} :string]
+             [:font-weight {:optional true} :string]
+             [:direction {:optional true} :string]
+             [:text-decoration {:optional true} :string]
+             [:text-transform {:optional true} :string]
+             [:typography-ref-id {:optional true} [:maybe ::sm/uuid]]
+             [:typography-ref-file {:optional true} [:maybe ::sm/uuid]]]]]]]]]]]]])
 
+(sm/register! ::content schema:content)
 
+(def valid-content?
+  (sm/lazy-validator schema:content))
 
 (sm/register!
  ^{::sm/type ::position-data}

common/src/app/common/types/tokens_lib.cljc

@@ -7,6 +7,7 @@
 (ns app.common.types.tokens-lib
   (:require
    #?(:clj [app.common.fressian :as fres])
+   #?(:clj [clojure.data.json :as json])
    [app.common.data :as d]
    [app.common.data.macros :as dm]
    [app.common.files.helpers :as cfh]
@@ -118,7 +119,7 @@
   [:map {:title "Token"}
    [:name cto/token-name-ref]
    [:type [::sm/one-of cto/token-types]]
-   [:value :any]
+   [:value ::sm/any]
    [:description {:optional true} :string]
    [:modified-at {:optional true} ::sm/inst]])
 
@@ -389,7 +390,8 @@
    [:description {:optional true} :string]
    [:modified-at {:optional true} ::sm/inst]
    [:tokens {:optional true
-             :gen/gen (->> (sg/generator [:map-of ::sm/text schema:token])
+             :gen/gen (->> (sg/map-of (sg/generator ::sm/text)
+                                      (sg/generator schema:token))
                            (sg/fmap #(into (d/ordered-map) %)))}
     [:and
      [:map-of {:gen/max 5
@@ -910,6 +912,12 @@ Will return a value that matches this schema:
                                    "themes" (clj->js themes)
                                    "active-themes" (clj->js active-themes)))])
 
+
+  #?@(:clj
+      [json/JSONWriter
+       (-write [this writter options] (json/-write (encode-dtcg this) writter options))])
+
+
   ITokenSets
   (add-set [_ token-set]
     (let [path      (get-token-set-prefixed-path token-set)

common/src/app/common/weak_map.cljs

@@ -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.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,7 +14,6 @@
    [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]))
 
@@ -31,7 +30,7 @@
    (if (= type :path)
      (cts/setup-shape
       (into {:type :path
-             :content (path/content (:content params default-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.path-data-test
+   'common-tests.types.shape-path-data-test
    'common-tests.uuid-test))

common/test/common_tests/types/path_data_test.cljc

@@ -1,380 +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.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,14 +112,17 @@
          (= interaction interaction-3)))
      {:num 500})))
 
+
 (t/deftest shape-path-content-json-roundtrip
-  (let [encode (sm/encoder ::path/content (sm/json-transformer))
-        decode (sm/decoder ::path/content (sm/json-transformer))]
+  (let [encode (sm/encoder schema:path-content (sm/json-transformer))
+        decode (sm/decoder schema:path-content (sm/json-transformer))]
     (smt/check!
-     (smt/for [path-content (sg/generator ::path/content)]
+     (smt/for [path-content (sg/generator schema: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

@@ -0,0 +1,59 @@
+;; 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)))))
+

docs/_includes/layouts/base.njk

@@ -72,7 +72,7 @@
     <div class="pre-footer">
       <a href="https://github.com/penpot/penpot/blob/main/docs/{{ page.inputPath }}">Edit this page on GitHub</a> 
                &nbsp;or ask a&nbsp;
-               <a href="https://github.com/penpot/penpot/issues/new/choose">question</a>.
+               <a href="https://penpot.app/talk-to-us" target="_blank">question</a>.
     </div>
     <footer class="footer">
       <div class="footer-inside">

docs/index.njk

@@ -57,5 +57,5 @@ eleventyNavigation:
 
 <div class="contact-block">
   <h2>Contact us</h2>
-  <p>Write us at <a href="mailto:support@penpot.app" target="_blank">support@penpot.app</a> or join our <a href="https://community.penpot.app/" target="_blank">community</a>.</p>
+  <p>Need help? <a href="https://penpot.app/talk-to-us" target="_blank">Talk to us</a> or join our <a href="https://community.penpot.app/" target="_blank">community</a>.</p>
 </div>

docs/plugins/create-a-plugin.md

@@ -35,11 +35,9 @@ Create your own app with the framework of your choice. See examples for each fra
 
 | Framework | Command                                                     | Version\* |
 | --------- | ----------------------------------------------------------- | --------- |
-| Angular   | ng new plugin-name                                          | 19.2.2    |
-| React     | npm create vite@latest plugin-name -- --template react-ts   | 19.0.0    |
-| Vue       | npm create vue@latest                                       | 3.5.13    |
-| Svelte    | npm create svelte@latest                                    | 5.23.0    |
-
+| Angular   | ng new plugin-name                                          | 18.0.0    |
+| React     | npm create vite@latest plugin-name -- --template react-ts   | 18.2.0    |
+| Vue       | npm create vue@latest                                       | 3.4.21    |
 
 _\*: version we used in the examples._
 

docs/user-guide/design-tokens/index.njk

@@ -285,11 +285,12 @@ title: 10· Design Tokens
 <p>When a token set is selected, the tokens within the selected set are displayed on the panel below.</p>
 
 
-<h3 id="design-tokens-sets-delete">Deleting and Renaming a Token Set</h3>
-<p>Token sets can be renamed or deleted by right-clicking on the token set and:</p>
+<h3 id="design-tokens-sets-edit">Deleting, Duplicating and Renaming a Token Set</h3>
+<p>Right-click a token set to perform these quick actions:</p>
 <ol>
-    <li>Selecting <strong>Rename</strong>, entering a new name, and hitting Enter.</li>
-    <li>Selecting <strong>Delete</strong>.</li>
+    <li><strong>Rename</strong>: Give the set a new name and press Enter.</li>
+    <li><strong>Duplicate</strong>: Make a copy of the set.</li>
+    <li><strong>Delete</strong>: Remove the set permanently.</li>
 </ol>
 <figure>
   <img src="/img/design-tokens/14-tokens-sets-edit.webp" alt="Tokens sets edit" />
@@ -299,10 +300,10 @@ title: 10· Design Tokens
 <p>Once you have created a token set, you can start creating tokens within that token set. To do so, simply select the token set and create a new token.</p>
 <p class="advice">If a token with the same name already exists in another set, a new token can still be created in the current set.</p>
 
-<h3 id="design-tokens-groups">Creating Token Groups</h3>
-<p>You can create a token set group by simply naming your token sets to have a folder path. For example, you can create a <strong><i>Light</i></strong> group with a <strong><i>Global</i></strong> set and a <strong><i>Colors</i></strong> set using: <code class="language-js">Light/Global</code>, <code class="language-js">Light/Colors</code>. </p>
+<h3 id="design-tokens-groups">Creating Token Set Folders</h3>
+<p>To group token sets just use folder-style names. For example, naming your sets <code class="language-js">Light/Global</code> and <code class="language-js">Light/Colors</code> will create a folder called <strong><i>Light</i></strong> with two sets inside it: <strong><i>Global</i></strong> and <strong><i>Colors</i></strong>.</p>
 <figure>
-  <img src="/img/design-tokens/15-tokens-sets-group.webp" alt="Tokens sets group" />
+  <img src="/img/design-tokens/15-tokens-sets-group.webp" alt="Tokens sets folder" />
 </figure>
 
 <h2 id="design-tokens-themes">Token Themes</h2>

frontend/.storybook/preview.js

@@ -18,7 +18,6 @@ const preview = {
   decorators: decorators,
   parameters: {
     controls: {
-      disableSaveFromUI: true,
       matchers: {
         color: /(background|color)$/i,
         date: /Date$/i,

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

@@ -448,7 +448,55 @@
           },
           "~:rotation": 0,
           "~:grow-type": "~:fixed",
-          "~:content": ["~#penpot/path-data","~bAQAAAAAAAAAAAAAAAAAAAAAAAAAAIIxEAIAKRAIAAAAAAAAAAAAAAAAAAAAAAAAAAKCZRAAA5UMDAAAAAKCZRAAA5UMAAKVEAAD2QwDgokQAgAFEAwAAAADAoEQAAAhEAECdRAAAD0QAYJhEAAASRAMAAAAAgJNEAAAVRAAgjEQAgApEACCMRACACkQ="],
+          "~:content": [
+            {
+              "~: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/playwright/ui/pages/OnboardingPage.js

@@ -9,7 +9,7 @@ export class OnboardingPage extends BaseWebSocketPage {
   async fillOnboardingInputsStep1() {
     await this.page.getByText("Personal").click();
     await this.page.getByText("Select option").click();
-    await this.page.getByText("Product Managment").click();
+    await this.page.getByText("Testing before self-hosting").click();
 
     await this.submitButton.click();
   }
@@ -21,8 +21,24 @@ export class OnboardingPage extends BaseWebSocketPage {
   }
 
   async fillOnboardingInputsStep3() {
+    await this.page.getByText("Select option").first().click();
+    await this.page.getByText("Product Managment").click();
+    await this.page.getByText("Select option").first().click();
+    await this.page.getByText("Director").click();
+    await this.page.getByText("Select option").click();
+    await this.page.getByText("11-30").click();
+
+    await this.submitButton.click();
+  }
+
+  async fillOnboardingInputsStep4() {
     await this.page.getByText("Other").click();
     await this.page.getByPlaceholder("Other (specify)").fill("Another");
+    await this.submitButton.click();
+  }
+
+  async fillOnboardingInputsStep5() {
+    await this.page.getByText("Event").click();
   }
 }
 

frontend/playwright/ui/specs/onboarding.spec.js

@@ -27,10 +27,19 @@ test("User can complete the onboarding", async ({ page }) => {
 
   await onboardingPage.fillOnboardingInputsStep2();
   await expect(
-    page.getByRole("heading", { name: "Where would you like to get" }),
+    page.getByRole("heading", { name: "Tell us about your job" }),
   ).toBeVisible();
 
   await onboardingPage.fillOnboardingInputsStep3();
+  await expect(
+    page.getByRole("heading", { name: "Where would you like to get" }),
+  ).toBeVisible();
 
+  await onboardingPage.fillOnboardingInputsStep4();
+  await expect(
+    page.getByRole("heading", { name: "How did you hear about Penpot?" }),
+  ).toBeVisible();
+
+  await onboardingPage.fillOnboardingInputsStep5();
   await expect(page.getByRole("button", { name: "Start" })).toBeEnabled();
 });

frontend/resources/images/icons/at.svg

@@ -1 +1,3 @@
-<svg xmlns="http://www.w3.org/2000/svg" width="14.499" height="14.507" viewBox="700.734 827.762 14.499 14.507"><path d="M707.948 827.762c-.193 0-.386.007-.578.022-2.311.181-4.574 1.452-5.839 3.982-1.686 3.372-.52 6.821 1.835 8.787 2.354 1.966 5.955 2.497 8.974.233a.566.566 0 1 0-.68-.906c-2.611 1.959-5.563 1.478-7.568-.196-2.004-1.675-3.005-4.495-1.546-7.412 1.458-2.917 4.314-3.808 6.856-3.208 2.543.599 4.698 2.672 4.698 5.936v.667c0 .525-.176.847-.435 1.076-.258.23-.624.357-.998.357s-.741-.127-.999-.357c-.258-.229-.435-.551-.435-1.076v-3.334a.567.567 0 0 0-1.133 0v.215a3.215 3.215 0 0 0-2.1-.781 3.241 3.241 0 0 0-3.233 3.233 3.241 3.241 0 0 0 3.233 3.233 3.23 3.23 0 0 0 2.482-1.168c.122.199.267.377.433.525a2.63 2.63 0 0 0 1.752.643c.626 0 1.259-.206 1.751-.643.492-.437.815-1.115.815-1.923V835c0-3.773-2.586-6.336-5.572-7.04a7.405 7.405 0 0 0-1.713-.198ZM708 832.9c1.167 0 2.1.933 2.1 2.1a2.09 2.09 0 0 1-2.1 2.1 2.09 2.09 0 0 1-2.1-2.1c0-1.167.933-2.1 2.1-2.1Z"/></svg>
+<svg xmlns="http://www.w3.org/2000/svg" width="16" height="16" viewBox="0 0 16 16" stroke-linecap="round" stroke-linejoin="round">
+    <path d="M10.667 5.333v3.334a2 2 0 1 0 4 0V8a6.667 6.667 0 1 0-2.614 5.293M10.667 8a2.667 2.667 0 1 1-5.334 0 2.667 2.667 0 0 1 5.334 0Z" />
+</svg>

frontend/resources/plugins-runtime/index.js

@@ -5086,7 +5086,8 @@ class zc extends HTMLElement {
       "allow-modals",
       "allow-popups",
       "allow-popups-to-escape-sandbox",
-      "allow-storage-access-by-user-activation"
+      "allow-storage-access-by-user-activation",
+      "allow-same-origin"
     ), o && l.sandbox.add("allow-downloads"), l.addEventListener("load", () => {
       var d;
       (d = this.shadowRoot) == null || d.dispatchEvent(

frontend/resources/wasm-playground/js/lib.js

@@ -1,132 +0,0 @@
-let Module = null;
-
-let scale = 1;
-let offsetX = 0;
-let offsetY = 0;
-
-let isPanning = false;
-let lastX = 0;
-let lastY = 0;
-
-export function init(moduleInstance) {
-  Module = moduleInstance;
-}
-
-export function assignCanvas(canvas) {
-  const glModule = Module.GL;
-  const context = canvas.getContext("webgl2", {
-    antialias: true,
-    depth: true,
-    alpha: false,
-    stencil: true,
-    preserveDrawingBuffer: true,
-  });
-
-  const handle = glModule.registerContext(context, { majorVersion: 2 });
-  glModule.makeContextCurrent(handle);
-  context.getExtension("WEBGL_debug_renderer_info");
-
-  Module._init(canvas.width, canvas.height);
-  Module._set_render_options(0, 1);
-}
-
-export function hexToU32ARGB(hex, opacity = 1) {
-  const rgb = parseInt(hex.slice(1), 16);
-  const a = Math.floor(opacity * 0xFF);
-  const argb = (a << 24) | rgb;
-  return argb >>> 0;
-}
-
-export function getRandomInt(min, max) {
-  return Math.floor(Math.random() * (max - min)) + min;
-}
-
-export function getRandomColor() {
-  const r = getRandomInt(0, 256).toString(16).padStart(2, '0');
-  const g = getRandomInt(0, 256).toString(16).padStart(2, '0');
-  const b = getRandomInt(0, 256).toString(16).padStart(2, '0');
-  return `#${r}${g}${b}`;
-}
-
-export function getRandomFloat(min, max) {
-  return Math.random() * (max - min) + min;
-}
-
-function getU32(id) {
-  const hex = id.replace(/-/g, "");
-  const buffer = new Uint32Array(4);
-  for (let i = 0; i < 4; i++) {
-    buffer[i] = parseInt(hex.slice(i * 8, (i + 1) * 8), 16);
-  }
-  return buffer;
-}
-
-function heapU32SetUUID(id, heap, offset) {
-  const buffer = getU32(id);
-  heap.set(buffer, offset);
-  return buffer;
-}
-
-function ptr8ToPtr32(ptr8) {
-  return ptr8 >>> 2;
-}
-
-function allocBytes(size) {
-  return Module._alloc_bytes(size);
-}
-
-function getHeapU32() {
-  return Module.HEAPU32;
-}
-
-export function setShapeChildren(shapeIds) {
-  const offset = allocBytes(shapeIds.length * 16);
-  const heap = getHeapU32();
-  let currentOffset = offset;
-  for (const id of shapeIds) {
-    heapU32SetUUID(id, heap, ptr8ToPtr32(currentOffset));
-    currentOffset += 16;
-  }
-  return Module._set_children();
-}
-
-export function useShape(id) {
-  const buffer = getU32(id);
-  Module._use_shape(...buffer);
-}
-
-export function setupInteraction(canvas) {
-  canvas.addEventListener("wheel", (e) => {
-    e.preventDefault();
-    const zoomFactor = e.deltaY < 0 ? 1.1 : 0.9;
-    scale *= zoomFactor;
-    const mouseX = e.offsetX;
-    const mouseY = e.offsetY;
-    offsetX -= (mouseX - offsetX) * (zoomFactor - 1);
-    offsetY -= (mouseY - offsetY) * (zoomFactor - 1);
-    Module._set_view(scale, offsetX, offsetY);
-    Module._render(Date.now());
-  });
-
-  canvas.addEventListener("mousedown", (e) => {
-    isPanning = true;
-    lastX = e.offsetX;
-    lastY = e.offsetY;
-  });
-
-  canvas.addEventListener("mousemove", (e) => {
-    if (isPanning) {
-      const dx = e.offsetX - lastX;
-      const dy = e.offsetY - lastY;
-      offsetX += dx;
-      offsetY += dy;
-      lastX = e.offsetX;
-      lastY = e.offsetY;
-      Module._set_view(scale, offsetX, offsetY);
-      Module._render(Date.now());
-    }
-  });
-
-  canvas.addEventListener("mouseup", () => { isPanning = false; });
-  canvas.addEventListener("mouseout", () => { isPanning = false; });
-}

frontend/resources/wasm-playground/rects.html

@@ -1,69 +0,0 @@
-<!DOCTYPE html>
-<html lang="es">
-<head>
-  <meta charset="UTF-8" />
-  <title>WASM + WebGL2 Canvas</title>
-  <style>
-    body {
-      margin: 0;
-      background: #111;
-      display: flex;
-      justify-content: center;
-      align-items: center;
-      height: 100vh;
-      overflow: hidden;
-    }
-    canvas {
-      width: 100%;
-      height: 100%;
-      position: absolute;
-    }
-  </style>
-</head>
-<body>
-  <canvas id="canvas"></canvas>
-  <script type="module">
-    import initWasmModule from '/js/render_wasm.js';
-    import {
-      init, assignCanvas, hexToU32ARGB, getRandomInt, getRandomColor,
-      getRandomFloat, useShape, setShapeChildren, setupInteraction
-    } from './js/lib.js';
-
-    const canvas = document.getElementById("canvas");
-    canvas.width =  window.innerWidth;
-    canvas.height = window.innerHeight;
-
-    initWasmModule().then(Module => {
-      init(Module);
-      assignCanvas(canvas);
-      Module._set_canvas_background(hexToU32ARGB("#FABADA", 1));
-      Module._set_view(1, 0, 0);
-      setupInteraction(canvas);
-
-      const children = [];
-      for (let i = 0; i < 1000; i++) {
-        const uuid = crypto.randomUUID();
-        children.push(uuid);
-
-        useShape(uuid);
-        Module._set_parent(0, 0, 0, 0);
-        Module._set_shape_type(3);
-        const x1 = getRandomInt(0, canvas.width);
-        const y1 = getRandomInt(0, canvas.height);
-        const width = getRandomInt(20, 100);
-        const height = getRandomInt(20, 100);
-        Module._set_shape_selrect(x1, y1, x1 + width, y1 + height);
-
-        const color = getRandomColor();
-        const argb = hexToU32ARGB(color, getRandomFloat(0.1, 1.0));
-        Module._add_shape_solid_fill(argb);
-      }
-
-      useShape("00000000-0000-0000-0000-000000000000");
-      setShapeChildren(children);
-      Module._render(Date.now());
-    });
-    
-  </script>
-</body>
-</html>

frontend/scripts/_helpers.js

@@ -573,16 +573,3 @@ export async function copyAssets() {
   const end = process.hrtime(start);
   log.info("done: copy assets", `(${ppt(end)})`);
 }
-
-export async function copyWasmPlayground() {
-  const start = process.hrtime();
-  log.info("init: copy wasm playground");
-
-  await syncDirs(
-    "resources/wasm-playground/",
-    "resources/public/wasm-playground/",
-  );
-
-  const end = process.hrtime(start);
-  log.info("done: copy wasm playground", `(${ppt(end)})`);
-}

frontend/scripts/build

@@ -5,6 +5,7 @@
 set -ex
 
 export INCLUDE_STORYBOOK=${BUILD_STORYBOOK:-no};
+export INCLUDE_WASM=${BUILD_WASM:-yes};
 
 export CURRENT_VERSION=$1;
 export BUILD_DATE=$(date -R);
@@ -17,14 +18,18 @@ export TS=$(date +%s);
 export NODE_ENV=production;
 
 corepack enable;
-corepack up || exit 1;
+corepack install || exit 1;
 yarn install || exit 1;
 
 rm -rf resources/public;
 rm -rf target/dist;
 
 yarn run build:app:main --config-merge "{:release-version \"${CURRENT_HASH}-${TS}\"}" $EXTRA_PARAMS || exit 1
-yarn run build:wasm || exit 1;
+
+if [ "$INCLUDE_WASM" = "yes" ];  then
+    yarn run build:wasm || exit 1;
+fi
+
 yarn run build:app:libs || exit 1;
 yarn run build:app:assets || exit 1;
 
@@ -36,7 +41,10 @@ sed -i -re "s/\%version\%/$CURRENT_VERSION/g" ./target/dist/render.html;
 sed -i -re "s/\%version\%/$CURRENT_VERSION/g" ./target/dist/rasterizer.html;
 sed -i -re "s/\%buildDate\%/$BUILD_DATE/g" ./target/dist/index.html;
 sed -i -re "s/\%buildDate\%/$BUILD_DATE/g" ./target/dist/rasterizer.html;
-sed -i "s/version=develop/version=$CURRENT_VERSION/g" ./target/dist/js/render_wasm.js;
+
+if [ "$INCLUDE_WASM" = "yes" ];  then
+    sed -i "s/version=develop/version=$CURRENT_VERSION/g" ./target/dist/js/render_wasm.js;
+fi
 
 if [ "$INCLUDE_STORYBOOK" = "yes" ];  then
     # build storybook

frontend/scripts/build-app-assets.js

@@ -2,7 +2,6 @@ import * as h from "./_helpers.js";
 
 await h.compileStyles();
 await h.copyAssets();
-await h.copyWasmPlayground();
 await h.compileSvgSprites();
 await h.compileTemplates();
 await h.compilePolyfills();

frontend/scripts/watch.js

@@ -44,7 +44,6 @@ async function compileSass(path) {
 await fs.mkdir("./resources/public/css/", { recursive: true });
 await compileSassAll();
 await h.copyAssets();
-await h.copyWasmPlayground();
 await h.compileSvgSprites();
 await h.compileTemplates();
 await h.compilePolyfills();
@@ -89,10 +88,4 @@ h.watch(
   },
 );
 
-log.info("watch: wasm playground (~)");
-h.watch(["resources/wasm-playground"], null, async function (path) {
-  log.info("changed:", path);
-  await h.copyWasmPlayground();
-});
-
 worker.terminate();

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.types.path :as path]))
+   [app.common.svg.path.command :as upc]))
 
 (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 path/apply-content-modifiers modifiers)
+                                  (update shape :content upc/apply-content-modifiers modifiers)
                                   shape)]
                   (assoc result id shape))
                 result))

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

@@ -8,7 +8,7 @@
   (:refer-clojure :exclude [meta reset!])
   (:require
    ["@penpot/mousetrap$default" :as mousetrap]
-   [app.common.data.macros :as dm]
+   [app.common.data :as d]
    [app.common.logging :as log]
    [app.common.schema :as sm]
    [app.config :as cf]
@@ -135,7 +135,7 @@
     [:fn {:optional true} fn?]
     [:tooltip {:optional true} :string]]])
 
-(def check-shortcuts!
+(def ^:private check-shortcuts
   (sm/check-fn schema:shortcuts))
 
 (defn- wrap-cb
@@ -167,23 +167,20 @@
    (mousetrap/reset)
    (bind! shortcuts)))
 
+(def ^:private conj*
+  (fnil conj (d/ordered-map)))
+
 (defn push-shortcuts
   [key shortcuts]
+  (assert (keyword? key) "expected a keyword for `key`")
+  (let [shortcuts (check-shortcuts shortcuts)]
+    (ptk/reify ::push-shortcuts
+      ptk/UpdateEvent
+      (update [_ state]
+        (update state :shortcuts conj* [key shortcuts]))
 
-  (dm/assert!
-   "expected valid parameters"
-   (and (keyword? key)
-        (check-shortcuts! shortcuts)))
-
-  (ptk/reify ::push-shortcuts
-    ptk/UpdateEvent
-    (update [_ state]
-      (-> state
-          (update :shortcuts (fnil conj '()) [key shortcuts])))
-
-    ptk/EffectEvent
-    (effect [_ state _]
-      (let [[_key shortcuts] (peek (:shortcuts state))]
+      ptk/EffectEvent
+      (effect [_ _ _]
         (reset! shortcuts)))))
 
 (defn pop-shortcuts
@@ -192,12 +189,9 @@
     ptk/UpdateEvent
     (update [_ state]
       (update state :shortcuts (fn [shortcuts]
-                                 (let [current-key (first (peek shortcuts))]
-                                   (if (= key current-key)
-                                     (pop shortcuts)
-                                     shortcuts)))))
+                                 (dissoc shortcuts key))))
+
     ptk/EffectEvent
     (effect [_ state _]
-      (let [[key* shortcuts] (peek (:shortcuts state))]
-        (when (not= key key*)
-          (reset! shortcuts))))))
+      (let [[_key shortcuts] (last (:shortcuts state))]
+        (reset! shortcuts)))))

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

@@ -320,11 +320,11 @@
                              (resolve-tokens-with-errors+)
                              (p/then (fn [_] tokens-lib))
                              (p/catch (fn [sd-error]
-                                        (let [reference-errors (reference-errors sd-error)]
-                                          ;; We allow reference errors for the users to resolve in the ui and throw on any other errors
-                                          (if reference-errors
-                                            (p/resolved tokens-lib)
-                                            (throw (wte/error-ex-info :error.import/style-dictionary-unknown-error sd-error sd-error)))))))
+                                        (let [reference-errors (reference-errors sd-error)
+                                              err (if reference-errors
+                                                    (wte/error-ex-info :error.import/style-dictionary-reference-errors reference-errors sd-error)
+                                                    (wte/error-ex-info :error.import/style-dictionary-unknown-error sd-error sd-error))]
+                                          (throw err)))))
                          (catch js/Error e
                            (p/rejected (wte/error-ex-info :error.import/style-dictionary-unknown-error "" e))))))))))
 

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

@@ -34,6 +34,7 @@
    [app.common.types.shape :as cts]
    [app.common.types.shape-tree :as ctst]
    [app.common.types.shape.layout :as ctl]
+   [app.common.types.shape.text :as types.text]
    [app.common.types.typography :as ctt]
    [app.common.uuid :as uuid]
    [app.config :as cf]
@@ -975,29 +976,9 @@
     ptk/WatchEvent
     (watch [_ state _]
       (let [selected (dsh/lookup-selected state)
-            objects  (dsh/lookup-page-objects state)]
+            objects (dsh/lookup-page-objects state)]
 
-        (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.
+        (if (> (count selected) 1)
           (let [shapes-to-select
                 (->> selected
                      (reduce
@@ -1007,7 +988,23 @@
                             (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
   []
@@ -2196,27 +2193,27 @@
   (ptk/reify ::paste-html-text
     ptk/WatchEvent
     (watch [_ state  _]
-      (let [root (dwtxt/create-root-from-html html)
-            content (tc/dom->cljs root)
+      (let [root    (dwtxt/create-root-from-html html)
+            content (tc/dom->cljs root)]
+        (when (types.text/valid-content? content)
+          (let [id     (uuid/next)
+                width (max 8 (min (* 7 (count text)) 700))
+                height 16
+                {:keys [x y]} (calculate-paste-position state)
 
-            id (uuid/next)
-            width (max 8 (min (* 7 (count text)) 700))
-            height 16
-            {:keys [x y]} (calculate-paste-position state)
-
-            shape {:id id
-                   :type :text
-                   :name (txt/generate-shape-name text)
-                   :x x
-                   :y y
-                   :width width
-                   :height height
-                   :grow-type (if (> (count text) 100) :auto-height :auto-width)
-                   :content content}
-            undo-id (js/Symbol)]
-        (rx/of (dwu/start-undo-transaction undo-id)
-               (dwsh/create-and-add-shape :text x y shape)
-               (dwu/commit-undo-transaction undo-id))))))
+                shape {:id id
+                       :type :text
+                       :name (txt/generate-shape-name text)
+                       :x x
+                       :y y
+                       :width width
+                       :height height
+                       :grow-type (if (> (count text) 100) :auto-height :auto-width)
+                       :content content}
+                undo-id (js/Symbol)]
+            (rx/of (dwu/start-undo-transaction undo-id)
+                   (dwsh/create-and-add-shape :text x y shape)
+                   (dwu/commit-undo-transaction undo-id))))))))
 
 (defn- paste-text
   [text]

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

@@ -10,10 +10,9 @@
    [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]
@@ -25,139 +24,130 @@
    [cuerdas.core :as str]
    [potok.v2.core :as ptk]))
 
-(defn- create-bool-shape
-  [id type name shapes objects]
-  (let [shape-id
-        (or id (uuid/next))
+(defn selected-shapes-idx
+  [state]
+  (let [objects (dsh/lookup-page-objects state)]
+    (->> (dsh/lookup-selected state)
+         (cph/clean-loops objects))))
 
-        shapes
-        (mapv #(path/convert-to-path % objects) shapes)
-
-        head
-        (if (= type :difference) (first shapes) (last shapes))
-
-        head
-        (cond-> head
-          (and (contains? head :svg-attrs) (empty? (:fills head)))
-          (assoc :fills bool/default-fills))
-
-        shape
-        {:id shape-id
-         :type :bool
-         :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 shapes objects))]
-
-    [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
-  [type group objects]
-  (let [shapes (->> (:shapes group)
-                    (map #(get objects %))
-                    (mapv #(path/convert-to-path % objects)))
-        head (if (= type :difference) (first shapes) (last shapes))
+(defn create-bool-data
+  [bool-type name shapes objects]
+  (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 bool/default-fills))
-        head-data (select-keys head bool/style-properties)]
+               (assoc :fills stp/default-bool-fills))
+
+        head-data (select-keys head stp/style-properties)
+
+        bool-shape
+        (-> {:id (uuid/next)
+             :type :bool
+             :bool-type bool-type
+             :frame-id (:frame-id head)
+             :parent-id (:parent-id head)
+             :name name
+             :shapes (->> shapes (mapv :id))}
+            (merge head-data)
+            (cts/setup-shape)
+            (gsh/update-bool-selrect shapes objects))]
+
+    [bool-shape (cph/get-position-on-parent objects (:id head))]))
+
+(defn group->bool
+  [group bool-type objects]
+
+  (let [shapes (->> (:shapes group)
+                    (map #(get objects %))
+                    (mapv #(stp/convert-to-path % objects)))
+        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)]
 
     (-> group
         (assoc :type :bool)
-        (assoc :bool-type type)
+        (assoc :bool-type bool-type)
         (merge head-data)
-        (gsh/update-bool shapes objects))))
+        (gsh/update-bool-selrect 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 type]
+  [shape-id bool-type]
   (ptk/reify ::group-to-bool
     ptk/WatchEvent
     (watch [_ state _]
-      (let [objects   (dsh/lookup-page-objects state)
-            update-fn (partial group->bool type)]
+      (let [objects (dsh/lookup-page-objects state)
+            change-to-bool
+            (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] 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)))))
+          (rx/of (dwsh/update-shapes [shape-id] change-to-bool {:reg-objects? true})))))))
 
 (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] bool->group {:with-objects? true :reg-objects? true})))))))
+          (rx/of (dwsh/update-shapes [shape-id] change-to-group {:reg-objects? true})))))))
+
 
 (defn change-bool-type
-  [shape-id type]
+  [shape-id bool-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 type))]
+            (fn [shape] (assoc shape :bool-type bool-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,7 +11,6 @@
    [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]
@@ -66,10 +65,6 @@
                    (-> (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,11 +7,13 @@
 (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]
@@ -24,37 +26,7 @@
    [beicon.v2.core :as rx]
    [potok.v2.core :as ptk]))
 
-(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})))))))))
+(def simplify-tolerance 0.3)
 
 (defn- insert-point
   [point]
@@ -63,16 +35,43 @@
     (update [_ state]
       (update-in state [:workspace-drawing :object]
                  (fn [object]
-                   (let [points  (-> (::points object)
-                                     (conj point))
-                         content (path.segment/points->content points)
-                         selrect (path.segment/content->selrect content)
-                         points' (grc/rect->points selrect)]
+                   (let [segments (-> (:segments object)
+                                      (conj point))
+                         content  (gsp/segments->content segments)
+                         selrect  (gsh/content->selrect content)
+                         points   (grc/rect->points selrect)]
                      (-> object
-                         (assoc ::points points)
+                         (assoc :segments segments)
                          (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
   []
@@ -80,14 +79,13 @@
     ptk/UpdateEvent
     (update [_ state]
       (update-in state [:workspace-drawing :object]
-                 (fn [{:keys [::points] :as shape}]
-                   (let [points   (ups/simplify points simplify-tolerance)
-                         content  (path.segment/points->content points)
-                         selrect  (path.segment/content->selrect content)
+                 (fn [{:keys [segments] :as shape}]
+                   (let [segments (ups/simplify segments simplify-tolerance)
+                         content  (gsp/segments->content segments)
+                         selrect  (gsh/content->selrect content)
                          points   (grc/rect->points selrect)]
-
                      (-> shape
-                         (dissoc ::points)
+                         (dissoc :segments)
                          (assoc :content content)
                          (assoc :selrect selrect)
                          (assoc :points points)
@@ -107,7 +105,7 @@
                                       :initialized? true
                                       :frame-id uuid/zero
                                       :parent-id uuid/zero
-                                      ::points []})]
+                                      :segments []})]
         (rx/concat
          (rx/of #(update % :workspace-drawing assoc :object shape))
          (->> mouse

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

@@ -6,6 +6,7 @@
 
 (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]
@@ -16,10 +17,8 @@
 (declare clear-edition-mode)
 
 (defn start-edition-mode
-  "Mark a shape in edition mode"
   [id]
-  (assert (uuid? id) "expected valid uuid for `id`")
-
+  (dm/assert! (uuid? id))
   (ptk/reify ::start-edition-mode
     ptk/UpdateEvent
     (update [_ state]
@@ -27,7 +26,8 @@
         ;; Can only edit objects that exist
         (if (contains? objects id)
           (-> state
-              (update :workspace-local assoc :edition id)
+              (assoc-in [:workspace-local :selected] #{id})
+              (assoc-in [:workspace-local :edition] id)
               (dissoc :workspace-grid-edition))
           state)))
 
@@ -48,7 +48,7 @@
     ptk/UpdateEvent
     (update [_ state]
       (-> state
-          (update :workspace-local dissoc :edition)
+          (update :workspace-local dissoc :edition :edit-path)
           (update :workspace-drawing dissoc :tool :object :lock)
           (dissoc :workspace-grid-edition)))