🐛 Fix share button being displayed with no permissions (#6476)

* 🐛 Fix share button being displayed with no permissions

* ✨ Simplify impl by accessing perms from teams directly

---------

Co-authored-by: Andrey Antukh <niwi@niwi.nz>

CHANGES.md

@@ -1,50 +1,5 @@
 # CHANGELOG
 
-## 2.8.0 (Next / Unreleased)
-
-### :rocket: Epics and highlights
-
-### :boom: Breaking changes & Deprecations
-
-**Breaking changes on penpot library:**
-
-- Change the signature of the `addPage` method: it now accepts an object (as a single argument) where you can pass `id`,
-  `name`, and `background` props (instead of the previous positional arguments)
-- Rename the `file.createRect` method to `file.addRect`
-- Rename the `file.createCircle` method to `file.addCircle`
-- Rename the `file.createPath` method to `file.addPath`
-- Rename the `file.createText` method to `file.addText`
-- Rename `file.startComponent` to `file.addComponent` (to preserve the naming style)
-- Rename `file.createComponentInstance` to `file.addComponentInstance` (to preserve the naming style)
-- Rename `file.lookupShape` to `file.getShape`
-- Rename `file.asMap` to `file.toMap`
-- Remove `file.updateLibraryColor` (use `file.addLibraryColor` if you just need to replace a color)
-- Remove `file.deleteLibraryColor` (this library is intended to build files)
-- Remove `file.updateLibraryTypography` (use `file.addLibraryTypography` if you just need to replace a typography)
-- Remove `file.deleteLibraryTypography` (this library is intended to build files)
-- Remove `file.add/update/deleteLibraryMedia` (they are no longer supported by Penpot and have been replaced by components)
-- Remove `file.deleteObject` (this library is intended to build files)
-- Remove `file.updateObject` (this library is intended to build files)
-- Remove `file.finishComponent` (it is no longer necessary; see below for more details on component creation changes)
-- Change the `file.getCurrentPageId` function to a read-only `file.currentPageId` property
-- Add `file.currentFrameId` read-only property
-- Add `file.lastId` read-only property
-
-There are also relevant semantic changes in how components should be created: this refactor removes
-all notions of the old components (v1). Since v2, the shapes that are part of a component live on a
-page. So, from now on, to create a component, you should first create a frame, then add shapes
-and/or groups to that frame, and then create a component by declaring that frame as the component
-root.
-
-### :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)
-
-### :bug: Bugs fixed
-
-
 ## 2.7.0 (Unreleased)
 
 ### :rocket: Epics and highlights
@@ -63,7 +18,6 @@ root.
 - 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)
 
 ### :bug: Bugs fixed
 
@@ -93,6 +47,10 @@ root.
 - 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)
 
 ## 2.6.2
 

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/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/cleaner.clj

@@ -9,7 +9,6 @@
   for recently imported shapes."
   (:require
    [app.common.data :as d]
-   [app.common.types.shape :as cts]
    [app.common.uuid :as uuid]))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -56,52 +55,9 @@
                    (fn [shadows]
                      (into [] xform shadows)))))
 
-(defn- fix-root-shape
-  "Ensure all root objects are well formed shapes"
-  [shape]
-  (if (= (:id shape) uuid/zero)
-    (-> shape
-        (assoc :parent-id uuid/zero)
-        (assoc :frame-id uuid/zero)
-        ;; We explicitly dissoc them and let the shape-setup
-        ;; to regenerate it with valid values.
-        (dissoc :selrect)
-        (dissoc :points)
-        (cts/setup-shape))
-    shape))
-
-(defn- fix-legacy-flex-dir
-  "This operation is only relevant to old data and it is fixed just
-  for convenience."
-  [shape]
-  (d/update-when shape :layout-flex-dir
-                 (fn [dir]
-                   (case dir
-                     :reverse-row :row-reverse
-                     :reverse-column :column-reverse
-                     dir))))
-
 (defn clean-shape-post-decode
   "A shape procesor that expected to be executed after schema decoding
   process but before validation."
   [shape]
   (-> shape
-      (fix-shape-shadow-color)
-      (fix-root-shape)
-      (fix-legacy-flex-dir)))
-
-(defn- fix-container
-  [container]
-  (-> container
-      ;; Remove possible `nil` keys on objects
-      (d/update-when :objects dissoc nil)
-      (d/update-when :objects d/update-vals clean-shape-post-decode)))
-
-(defn clean-file
-  [file & {:as _opts}]
-  (update file :data
-          (fn [data]
-            (-> data
-                (d/update-when :pages-index d/update-vals fix-container)
-                (d/update-when :components d/update-vals fix-container)
-                (d/without-nils)))))
+      (fix-shape-shadow-color)))

backend/src/app/binfile/common.clj

@@ -431,21 +431,15 @@
                           (update :components relink-shapes)
                           (update :media relink-media)
                           (update :colors relink-colors)
-                          (d/without-nils))))
-
-      ;; NOTE: this is necessary because when we just creating a new
-      ;; file from imported artifact or cloned file there are no
-      ;; migrations registered on the database, so we need to persist
-      ;; all of them, not only the applied
-      (vary-meta dissoc ::fmg/migrated)))
+                          (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

@@ -756,7 +756,14 @@
                    (assoc :name file-name)
                    (assoc :project-id project-id)
                    (dissoc :options)
-                   (bfc/process-file))]
+                   (bfc/process-file)
+
+                   ;; NOTE: this is necessary because when we just
+                   ;; creating a new file from imported artifact,
+                   ;; there are no migrations registered on the
+                   ;; database, so we need to persist all of them, not
+                   ;; only the applied
+                   (vary-meta dissoc ::fmg/migrated))]
 
       (bfm/register-pending-migrations! cfg file)
       (bfc/save-file! cfg file ::db/return-keys false)

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/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/files_create.clj

@@ -55,8 +55,8 @@
                                :features features
                                :ignore-sync-until ignore-sync-until
                                :modified-at modified-at
-                               :deleted-at deleted-at}
-                              {:create-page create-page
+                               :deleted-at deleted-at
+                               :create-page create-page
                                :page-id page-id})
           file (-> (bfc/insert-file! cfg file)
                    (bfc/decode-row))]
@@ -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_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/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/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/tasks/file_gc.clj

@@ -10,7 +10,6 @@
   file is eligible to be garbage collected after some period of
   inactivity (the default threshold is 72h)."
   (:require
-   [app.binfile.cleaner :as bfl]
    [app.binfile.common :as bfc]
    [app.common.files.helpers :as cfh]
    [app.common.files.validate :as cfv]
@@ -259,7 +258,6 @@
   (if-let [file (get-file cfg file-id)]
     (let [file (->> file
                     (bfc/decode-file cfg)
-                    (bfl/clean-file)
                     (clean-media! cfg)
                     (clean-fragments! cfg))
           file (assoc file :has-media-trimmed true)]

common/deps.edn

@@ -2,7 +2,7 @@
  {org.clojure/clojure {:mvn/version "1.12.0"}
   org.clojure/data.json {:mvn/version "2.5.1"}
   org.clojure/tools.cli {:mvn/version "1.1.230"}
-  org.clojure/clojurescript {:mvn/version "1.12.38"}
+  org.clojure/clojurescript {:mvn/version "1.11.132"}
   org.clojure/test.check {:mvn/version "1.1.1"}
   org.clojure/data.fressian {:mvn/version "1.1.0"}
 
@@ -59,7 +59,7 @@
  {:dev
   {:extra-deps
    {org.clojure/tools.namespace {:mvn/version "RELEASE"}
-    thheller/shadow-cljs {:mvn/version "3.0.3"}
+    thheller/shadow-cljs {:mvn/version "2.28.20"}
     com.clojure-goes-fast/clj-async-profiler {:mvn/version "RELEASE"}
     com.bhauman/rebel-readline {:mvn/version "RELEASE"}
     criterium/criterium {:mvn/version "RELEASE"}

common/package.json

@@ -17,7 +17,7 @@
   "devDependencies": {
     "concurrently": "^9.0.1",
     "nodemon": "^3.1.7",
-    "shadow-cljs": "3.0.3",
+    "shadow-cljs": "2.28.20",
     "source-map-support": "^0.5.21",
     "ws": "^8.17.0"
   },

common/scripts/repl

@@ -2,20 +2,16 @@
 
 export PENPOT_FLAGS="enable-asserts enable-audit-log $PENPOT_FLAGS"
 
-export JAVA_OPTS="\
-       -Djava.util.logging.manager=org.apache.logging.log4j.jul.LogManager \
-       -Djdk.attach.allowAttachSelf \
-       -Dlog4j2.configurationFile=log4j2-devenv-repl.xml \
-       -Djdk.tracePinnedThreads=full \
-       -XX:+EnableDynamicAgentLoading \
-       -XX:-OmitStackTraceInFastThrow                    \
-       -XX:+UnlockDiagnosticVMOptions \
-       -XX:+DebugNonSafepoints \
-       --sun-misc-unsafe-memory-access=allow \
-       --enable-preview \
-       --enable-native-access=ALL-UNNAMED";
-
-export OPTIONS="-A:dev"
+export OPTIONS="
+       -A:dev \
+       -J-Djava.util.logging.manager=org.apache.logging.log4j.jul.LogManager \
+       -J-Djdk.attach.allowAttachSelf \
+       -J-Dpolyglot.engine.WarnInterpreterOnly=false \
+       -J-XX:+EnableDynamicAgentLoading \
+       -J-XX:-OmitStackTraceInFastThrow \
+       -J-XX:+UnlockDiagnosticVMOptions \
+       -J-XX:+DebugNonSafepoints \
+       -J-Djdk.tracePinnedThreads=full"
 
 export OPTIONS_EVAL="nil"
 # export OPTIONS_EVAL="(set! *warn-on-reflection* true)"

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/changes.cljc

@@ -732,22 +732,20 @@
 
           (update-group [group objects]
             (let [lookup   (d/getf objects)
-                  children (get group :shapes)]
+                  children (->> group :shapes (map lookup))]
               (cond
                 ;; If the group is empty we don't make any changes. Will be removed by a later process
                 (empty? children)
                 group
 
                 (= :bool (:type group))
-                (gsh/update-bool group objects)
+                (gsh/update-bool-selrect group children objects)
 
                 (:masked-group group)
-                (->> (map lookup children)
-                     (set-mask-selrect group))
+                (set-mask-selrect group children)
 
                 :else
-                (->> (map lookup children)
-                     (gsh/update-group-selrect group)))))]
+                (gsh/update-group-selrect group children))))]
 
     (if page-id
       (d/update-in-when data [:pages-index page-id :objects] reg-objects)

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]
@@ -83,7 +84,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 +480,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,13 +659,9 @@
                                  nil               ;; so it does not need resize
 
                                  (= (:type parent) :bool)
-                                 (gsh/update-bool parent objects)
+                                 (gsh/update-bool-selrect parent children objects)
 
                                  (= (:type parent) :group)
-                                 ;; FIXME: this functions should be
-                                 ;; normalized in the same way as
-                                 ;; update-bool in order to make all
-                                 ;; this code consistent
                                  (if (:masked-group parent)
                                    (gsh/update-mask-selrect parent children)
                                    (gsh/update-group-selrect parent children)))]

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/matrix.cljc

@@ -126,20 +126,21 @@
       o)))
 
 (def schema:matrix
-  (sm/register!
-   {:type ::matrix
-    :pred valid-matrix?
-    :type-properties
-    {:title "matrix"
-     :description "Matrix instance"
-     :error/message "expected a valid matrix instance"
-     :gen/gen (matrix-generator)
-     :decode/json decode-matrix
-     :decode/string decode-matrix
-     :encode/json matrix->json
-     :encode/string matrix->str
-     ::oapi/type "string"
-     ::oapi/format "matrix"}}))
+  {:type :map
+   :pred valid-matrix?
+   :type-properties
+   {:title "matrix"
+    :description "Matrix instance"
+    :error/message "expected a valid matrix instance"
+    :gen/gen (matrix-generator)
+    :decode/json decode-matrix
+    :decode/string decode-matrix
+    :encode/json matrix->json
+    :encode/string matrix->str
+    ::oapi/type "string"
+    ::oapi/format "matrix"}})
+
+(sm/register! ::matrix schema:matrix)
 
 ;; FIXME: deprecated
 (s/def ::a ::us/safe-float)

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]
@@ -85,22 +85,24 @@
     (into {} p)
     p))
 
+;; FIXME: make like matrix
 (def schema:point
-  (sm/register!
-   {:type ::point
-    :pred valid-point?
-    :type-properties
-    {:title "point"
-     :description "Point"
-     :error/message "expected a valid point"
-     :gen/gen (->> (sg/tuple (sg/small-int) (sg/small-int))
-                   (sg/fmap #(apply pos->Point %)))
-     ::oapi/type "string"
-     ::oapi/format "point"
-     :decode/json decode-point
-     :decode/string decode-point
-     :encode/json point->json
-     :encode/string point->str}}))
+  {:type ::point
+   :pred valid-point?
+   :type-properties
+   {:title "point"
+    :description "Point"
+    :error/message "expected a valid point"
+    :gen/gen (->> (sg/tuple (sg/small-int) (sg/small-int))
+                  (sg/fmap #(apply pos->Point %)))
+    ::oapi/type "string"
+    ::oapi/format "point"
+    :decode/json decode-point
+    :decode/string decode-point
+    :encode/json point->json
+    :encode/string point->str}})
+
+(sm/register! schema:point)
 
 (defn point-like?
   [{:keys [x y] :as v}]
@@ -468,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,14 +444,25 @@
         (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 objects]
-  (let [content (path/calc-bool-content shape objects)
-        shape   (assoc shape :content content)]
-    (path/update-geometry shape)))
+  [shape children objects]
+
+  (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))))
 
-;; FIXME: revisit
 (defn update-shapes-geometry
   [objects ids]
   (->> ids
@@ -474,7 +476,7 @@
                   (update-mask-selrect shape children)
 
                   (cfh/bool-shape? shape)
-                  (update-bool shape 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,29 +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.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)
@@ -45,26 +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 libraries]
-  (let [objects      (pcb/get-objects changes)
-        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/find-ref-shape nil container libraries 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]
@@ -28,6 +27,10 @@
    [malli.transform :as mt]
    [malli.util :as mu]))
 
+(defprotocol ILazySchema
+  (-validate [_ o])
+  (-explain [_ o]))
+
 (def default-options
   {:registry sr/default-registry})
 
@@ -47,6 +50,10 @@
   [s]
   (m/type-properties s))
 
+(defn- lazy-schema?
+  [s]
+  (satisfies? ILazySchema s))
+
 (defn schema
   [s]
   (if (schema? s)
@@ -103,16 +110,12 @@
   (malli.error/error-value exp {:malli.error/mask-valid-values '...}))
 
 (defn optional-keys
-  ([schema]
-   (mu/optional-keys schema nil default-options))
-  ([schema keys]
-   (mu/optional-keys schema keys default-options)))
+  [schema]
+  (mu/optional-keys schema default-options))
 
 (defn required-keys
-  ([schema]
-   (mu/required-keys schema nil default-options))
-  ([schema keys]
-   (mu/required-keys schema keys default-options)))
+  [schema]
+  (mu/required-keys schema default-options))
 
 (defn transformer
   [& transformers]
@@ -211,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
@@ -225,11 +227,6 @@
   (let [vfn (delay (decoder (if (delay? s) (deref s) s) transformer))]
     (fn [v] (@vfn v))))
 
-(defn decode-fn
-  [s transformer]
-  (let [vfn (delay (decoder (if (delay? s) (deref s) s) transformer))]
-    (fn [v] (@vfn v))))
-
 (defn humanize-explain
   "Returns a string representation of the explain data structure"
   [{:keys [errors value]} & {:keys [length level]}]
@@ -275,36 +272,38 @@
   ([s] (lookup sr/default-registry s))
   ([registry s] (schema (mr/schema registry s))))
 
+(defn- fast-check
+  "A fast path for checking process, assumes the ILazySchema protocol
+  implemented on the provided `s` schema. Sould not be used directly."
+  [s type code hint value]
+  (when-not ^boolean (-validate s value)
+    (let [explain (-explain s value)]
+      (throw (ex-info hint {:type type
+                            :code code
+                            :hint hint
+                            ::explain explain}))))
+  value)
+
+(declare ^:private lazy-schema)
+
 (defn check-fn
   "Create a predefined check function"
   [s & {:keys [hint type code]}]
-  (let [s          (schema s)
-        validator* (delay (m/validator s))
-        explainer* (delay (m/explainer s))
-        hint       (or ^boolean hint "check error")
-        type       (or ^boolean type :assertion)
-        code       (or ^boolean code :data-validation)]
-
-    (fn [value]
-      (let [validate-fn @validator*]
-        (when-not ^boolean (validate-fn value)
-          (let [explain-fn @explainer*
-                explain    (explain-fn value)]
-            (throw (ex-info hint {:type type
-                                  :code code
-                                  :hint hint
-                                  ::explain explain}))))
-        value))))
+  (let [schema (if (lazy-schema? s) s (lazy-schema s))
+        hint   (or ^boolean hint "check error")
+        type   (or ^boolean type :assertion)
+        code   (or ^boolean code :data-validation)]
+    (partial fast-check schema type code hint)))
 
 (defn check
   "A helper intended to be used on assertions for validate/check the
-  schema over provided data. Raises an assertion exception.
-
-  Use only on non-performance sensitive code, because it creates the
-  check-fn instance all the time it is invoked."
-  [s value & {:as opts}]
-  (let [check-fn (check-fn s opts)]
-    (check-fn value)))
+  schema over provided data. Raises an assertion exception."
+  [s value & {:keys [hint type code]}]
+  (let [s      (if (lazy-schema? s) s (lazy-schema s))
+        hint   (or ^boolean hint "check error")
+        type   (or ^boolean type :assertion)
+        code   (or ^boolean code :data-validation)]
+    (fast-check s type code hint value)))
 
 (defn type-schema
   [& {:as params}]
@@ -318,14 +317,11 @@
   ([params]
    (cond
      (map? params)
-     (let [mdata (meta params)
-           type  (or (get mdata ::id)
-                     (get mdata ::type)
-                     (get params :type))]
+     (let [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)
-         s))
+         nil))
 
      (vector? params)
      (let [mdata (meta params)
@@ -333,19 +329,83 @@
                      (get mdata ::type))]
        (assert (qualified-keyword? type) "expected qualified keyword to be on metadata")
        (swap! sr/registry assoc type params)
-       params)
+       nil)
 
      (m/into-schema? params)
      (let [type (m/-type params)]
-       (swap! sr/registry assoc type params)
-       params)
+       (swap! sr/registry assoc type params))
 
      :else
      (throw (ex-info "Invalid Arguments" {}))))
 
   ([type params]
-   (swap! sr/registry assoc type params)
-   params))
+   (let [s (if (map? params)
+             (cond
+               (= :set (:type params))
+               (m/-collection-schema params)
+
+               (= :vector (:type params))
+               (m/-collection-schema params)
+
+               :else
+               (m/-simple-schema params))
+             params)]
+
+     (swap! sr/registry assoc type s)
+     nil)))
+
+(defn- lazy-schema
+  "Create ans instance of ILazySchema"
+  [s]
+  (let [schema      (schema s)
+        validator   (delay (m/validator schema))
+        explainer   (delay (m/explainer schema))]
+
+    (reify
+      m/AST
+      (-to-ast [_ options] (m/-to-ast schema options))
+
+      m/EntrySchema
+      (-entries [_] (m/-entries schema))
+      (-entry-parser [_] (m/-entry-parser schema))
+
+      m/Cached
+      (-cache [_] (m/-cache schema))
+
+      m/LensSchema
+      (-keep [_] (m/-keep schema))
+      (-get [_ key default] (m/-get schema key default))
+      (-set [_ key value] (m/-set schema key value))
+
+      m/Schema
+      (-validator [_]
+        (m/-validator schema))
+      (-explainer [_ path]
+        (m/-explainer schema path))
+      (-parser [_]
+        (m/-parser schema))
+      (-unparser [_]
+        (m/-unparser schema))
+      (-transformer [_ transformer method options]
+        (m/-transformer schema transformer method options))
+      (-walk [_ walker path options]
+        (m/-walk schema walker path options))
+      (-properties [_]
+        (m/-properties schema))
+      (-options [_]
+        (m/-options schema))
+      (-children [_]
+        (m/-children schema))
+      (-parent [_]
+        (m/-parent schema))
+      (-form [_]
+        (m/-form schema))
+
+      ILazySchema
+      (-validate [_ o]
+        (@validator o))
+      (-explain [_ o]
+        (@explainer o)))))
 
 ;; --- BUILTIN SCHEMAS
 
@@ -771,8 +831,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
@@ -847,22 +906,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?})

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])
   #?(:cljs (:require-macros [app.common.schema.generators]))
   (:require
    [app.common.schema.registry :as sr]
@@ -126,7 +126,3 @@
 (defn tuple
   [& opts]
   (apply tg/tuple opts))
-
-(defn vector
-  [& opts]
-  (apply tg/vector opts))

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/test_helpers/files.cljc

@@ -23,32 +23,28 @@
 
 (defn sample-file
   [label & {:keys [page-label name view-only?] :as params}]
-  (let [params
-        (cond-> params
-          label
-          (assoc :id (thi/new-id! label))
+  (binding [ffeat/*current* #{"components/v2"}]
+    (let [params (cond-> params
+                   label
+                   (assoc :id (thi/new-id! label))
 
-          (nil? name)
-          (assoc :name "Test file")
+                   page-label
+                   (assoc :page-id (thi/new-id! page-label))
 
-          :always
-          (assoc :features ffeat/default-features))
+                   (nil? name)
+                   (assoc :name "Test file"))
 
-        opts
-        (cond-> {}
-          page-label
-          (assoc :page-id (thi/new-id! page-label)))
+          file (-> (ctf/make-file (dissoc params :page-label))
+                   (assoc :features #{"components/v2"})
+                   (assoc :permissions {:can-edit (not (true? view-only?))}))
 
-        file (-> (ctf/make-file params opts)
-                 (assoc :permissions {:can-edit (not (true? view-only?))}))
+          page (-> file
+                   :data
+                   (ctpl/pages-seq)
+                   (first))]
 
-        page (-> file
-                 :data
-                 (ctpl/pages-seq)
-                 (first))]
-
-    (with-meta file
-      {:current-page-id (:id page)})))
+      (with-meta file
+        {:current-page-id (:id page)}))))
 
 (defn validate-file!
   ([file] (validate-file! file {}))

common/src/app/common/types/color.cljc

@@ -41,18 +41,17 @@
   [o]
   (and (string? o) (some? (re-matches rgb-color-re o))))
 
-(def schema:rgb-color
-  (sm/register!
-   {:type ::rgb-color
-    :pred rgb-color-string?
-    :type-properties
-    {:title "rgb-color"
-     :description "RGB Color String"
-     :error/message "expected a valid RGB color"
-     :error/code "errors.invalid-rgb-color"
-     :gen/gen (generate-rgb-color)
-     ::oapi/type "integer"
-     ::oapi/format "int64"}}))
+(def ^:private type:rgb-color
+  {:type :string
+   :pred rgb-color-string?
+   :type-properties
+   {:title "rgb-color"
+    :description "RGB Color String"
+    :error/message "expected a valid RGB color"
+    :error/code "errors.invalid-rgb-color"
+    :gen/gen (generate-rgb-color)
+    ::oapi/type "integer"
+    ::oapi/format "int64"}})
 
 (def schema:image-color
   [:map {:title "ImageColor"}
@@ -77,7 +76,7 @@
    [:stops
     [:vector {:min 1 :gen/max 2}
      [:map {:title "GradientStop"}
-      [:color schema:rgb-color]
+      [:color ::rgb-color]
       [:opacity {:optional true} [:maybe ::sm/safe-number]]
       [:offset ::sm/safe-number]]]]])
 
@@ -87,7 +86,7 @@
    [:name {:optional true} :string]
    [:path {:optional true} [:maybe :string]]
    [:value {:optional true} [:maybe :string]]
-   [:color {:optional true} [:maybe schema:rgb-color]]
+   [:color {:optional true} [:maybe ::rgb-color]]
    [:opacity {:optional true} [:maybe ::sm/safe-number]]
    [:modified-at {:optional true} ::sm/inst]
    [:ref-id {:optional true} ::sm/uuid]
@@ -104,17 +103,12 @@
   [:and
    [:map {:title "RecentColor"}
     [:opacity {:optional true} [:maybe ::sm/safe-number]]
-    [:color {:optional true} [:maybe schema:rgb-color]]
+    [:color {:optional true} [:maybe ::rgb-color]]
     [:gradient {:optional true} [:maybe schema:gradient]]
     [:image {:optional true} [:maybe schema:image-color]]]
    [::sm/contains-any {:strict true} [:color :gradient :image]]])
 
-;; Same as color but with :id prop required
-(def schema:library-color
-  [:and
-   (sm/required-keys schema:color-attrs [:id])
-   [::sm/contains-any {:strict true} [:color :gradient :image]]])
-
+(sm/register! ::rgb-color type:rgb-color)
 (sm/register! ::color schema:color)
 (sm/register! ::gradient schema:gradient)
 (sm/register! ::image-color schema:image-color)
@@ -125,13 +119,10 @@
   (sm/lazy-validator schema:color))
 
 (def check-color
-  (sm/check-fn schema:color :hint "expected valid color"))
-
-(def check-library-color
-  (sm/check-fn schema:library-color :hint "expected valid library color"))
+  (sm/check-fn schema:color :hint "expected valid color struct"))
 
 (def check-recent-color
-  (sm/check-fn schema:recent-color :hint "expected valid recent color"))
+  (sm/check-fn schema:recent-color))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; HELPERS

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

@@ -18,19 +18,19 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (def schema:component
-  (sm/register!
-   ^{::sm/type ::component}
-   [:merge
-    [:map
-     [:id ::sm/uuid]
-     [:name :string]
-     [:path {:optional true} [:maybe :string]]
-     [:modified-at {:optional true} ::sm/inst]
-     [:objects {:gen/max 10 :optional true} ctp/schema:objects]
-     [:main-instance-id ::sm/uuid]
-     [:main-instance-page ::sm/uuid]
-     [:plugin-data {:optional true} ctpg/schema:plugin-data]]
-    ctv/schema:variant-component]))
+  [:merge
+   [:map
+    [:id ::sm/uuid]
+    [:name :string]
+    [:path {:optional true} [:maybe :string]]
+    [:modified-at {:optional true} ::sm/inst]
+    [:objects {:gen/max 10 :optional true} ::ctp/objects]
+    [:main-instance-id ::sm/uuid]
+    [:main-instance-page ::sm/uuid]
+    [:plugin-data {:optional true} ::ctpg/plugin-data]]
+   ::ctv/variant-component])
+
+(sm/register! ::component schema:component)
 
 (def check-component
   (sm/check-fn schema:component))
@@ -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))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -62,9 +62,9 @@
 
 (defn get-container
   [file type id]
-  (assert (map? file))
-  (assert (contains? valid-container-types type))
-  (assert (uuid? id))
+  (dm/assert! (map? file))
+  (dm/assert! (contains? valid-container-types type))
+  (dm/assert! (uuid? id))
 
   (-> (if (= type :page)
         (ctpl/get-page file id)
@@ -74,9 +74,13 @@
 (defn get-shape
   [container shape-id]
 
-  (assert (check-container container))
-  (assert (uuid? shape-id)
-          "expected valid uuid for `shape-id`")
+  (dm/assert!
+   "expected valid container"
+   (check-container! container))
+
+  (dm/assert!
+   "expected valid uuid for `shape-id`"
+   (uuid? shape-id))
 
   (-> container
       (get :objects)

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

@@ -83,7 +83,6 @@
   because sometimes we want to validate file without the data."
   [:map {:title "file"}
    [:id ::sm/uuid]
-   [:name :string]
    [:revn {:optional true} :int]
    [:vern {:optional true} :int]
    [:created-at {:optional true} ::sm/inst]
@@ -102,15 +101,13 @@
 (sm/register! ::media schema:media)
 (sm/register! ::colors schema:colors)
 (sm/register! ::typographies schema:typographies)
+
 (sm/register! ::media-object schema:media)
 
-(def check-file
-  (sm/check-fn schema:file :hint "check error on validating file"))
+(def check-file-data!
+  (sm/check-fn ::data))
 
-(def check-file-data
-  (sm/check-fn schema:data))
-
-(def check-media-object
+(def check-media-object!
   (sm/check-fn schema:media))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -130,43 +127,40 @@
                 (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 migrations
-           ignore-sync-until modified-at deleted-at]
-    :or {is-shared false revn 0}}
-
-   & {:keys [create-page page-id]
-      :or {create-page true}}]
+  [{:keys [id project-id name revn is-shared features
+           ignore-sync-until modified-at deleted-at
+           create-page page-id]
+    :or {is-shared false revn 0 create-page true}}]
 
   (let [id       (or id (uuid/next))
+
         data     (if create-page
                    (if page-id
                      (make-file-data id page-id)
                      (make-file-data id))
                    (make-file-data id nil))
 
-        file     (d/without-nils
-                  {:id id
-                   :project-id project-id
-                   :name name
-                   :revn revn
-                   :vern 0
-                   :is-shared is-shared
-                   :version version
-                   :data data
-                   :features features
-                   :migrations migrations
-                   :ignore-sync-until ignore-sync-until
-                   :modified-at modified-at
-                   :deleted-at deleted-at})]
+        file     {:id id
+                  :project-id project-id
+                  :name name
+                  :revn revn
+                  :vern 0
+                  :is-shared is-shared
+                  :version version
+                  :data data
+                  :features features
+                  :ignore-sync-until ignore-sync-until
+                  :modified-at modified-at
+                  :deleted-at deleted-at}]
 
-    (check-file file)))
+    (d/without-nils file)))
 
 ;; Helpers
 

common/src/app/common/types/page.cljc

@@ -70,7 +70,7 @@
 (def valid-guide?
   (sm/lazy-validator schema:guide))
 
-(def check-page
+(def check-page!
   (sm/check-fn schema:page))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -82,7 +82,8 @@
 (def root uuid/zero)
 
 (def empty-page-data
-  {:objects {root
+  {:options {}
+   :objects {root
              (cts/setup-shape {:id root
                                :type :frame
                                :parent-id root
@@ -90,12 +91,10 @@
                                :name "Root Frame"})}})
 
 (defn make-empty-page
-  [{:keys [id name background]}]
+  [{:keys [id name]}]
   (-> empty-page-data
       (assoc :id (or id (uuid/next)))
-      (assoc :name (d/nilv name "Page 1"))
-      (cond-> background
-        (assoc :background background))))
+      (assoc :name (or name "Page 1"))))
 
 (defn get-frame-flow
   [flows frame-id]

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/plugins.cljc

@@ -22,13 +22,14 @@
    :keyword])
 
 (def schema:plugin-data
-  (sm/register!
-   ^{::sm/type ::plugin-data}
+  [:map-of {:gen/max 5}
+   schema:keyword
    [:map-of {:gen/max 5}
-    schema:keyword
-    [:map-of {:gen/max 5}
-     schema:string
-     schema:string]]))
+    schema:string
+    schema:string]])
+
+(sm/register! ::plugin-data schema:plugin-data)
+
 
 (def ^:private schema:registry-entry
   [:map

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]
@@ -120,35 +119,35 @@
   [:vector {:gen/max 4 :gen/min 4} ::gpt/point])
 
 (def schema:fill
-  (sm/register!
-   ^{::sm/type ::fill}
-   [:map {:title "Fill"}
-    [:fill-color {:optional true} ::ctc/rgb-color]
-    [:fill-opacity {:optional true} ::sm/safe-number]
-    [:fill-color-gradient {:optional true} [:maybe ::ctc/gradient]]
-    [:fill-color-ref-file {:optional true} [:maybe ::sm/uuid]]
-    [:fill-color-ref-id {:optional true} [:maybe ::sm/uuid]]
-    [:fill-image {:optional true} ::ctc/image-color]]))
+  [:map {:title "Fill"}
+   [:fill-color {:optional true} ::ctc/rgb-color]
+   [:fill-opacity {:optional true} ::sm/safe-number]
+   [:fill-color-gradient {:optional true} [:maybe ::ctc/gradient]]
+   [:fill-color-ref-file {:optional true} [:maybe ::sm/uuid]]
+   [:fill-color-ref-id {:optional true} [:maybe ::sm/uuid]]
+   [:fill-image {:optional true} ::ctc/image-color]])
 
-(def schema:stroke
-  (sm/register!
-   ^{::sm/type ::stroke}
-   [:map {:title "Stroke"}
-    [:stroke-color {:optional true} :string]
-    [:stroke-color-ref-file {:optional true} ::sm/uuid]
-    [:stroke-color-ref-id {:optional true} ::sm/uuid]
-    [:stroke-opacity {:optional true} ::sm/safe-number]
-    [:stroke-style {:optional true}
-     [::sm/one-of #{:solid :dotted :dashed :mixed :none :svg}]]
-    [:stroke-width {:optional true} ::sm/safe-number]
-    [:stroke-alignment {:optional true}
-     [::sm/one-of #{:center :inner :outer}]]
-    [:stroke-cap-start {:optional true}
-     [::sm/one-of stroke-caps]]
-    [:stroke-cap-end {:optional true}
-     [::sm/one-of stroke-caps]]
-    [:stroke-color-gradient {:optional true} ::ctc/gradient]
-    [:stroke-image {:optional true} ::ctc/image-color]]))
+(sm/register! ::fill schema:fill)
+
+(def ^:private schema:stroke
+  [:map {:title "Stroke"}
+   [:stroke-color {:optional true} :string]
+   [:stroke-color-ref-file {:optional true} ::sm/uuid]
+   [:stroke-color-ref-id {:optional true} ::sm/uuid]
+   [:stroke-opacity {:optional true} ::sm/safe-number]
+   [:stroke-style {:optional true}
+    [::sm/one-of #{:solid :dotted :dashed :mixed :none :svg}]]
+   [:stroke-width {:optional true} ::sm/safe-number]
+   [:stroke-alignment {:optional true}
+    [::sm/one-of #{:center :inner :outer}]]
+   [:stroke-cap-start {:optional true}
+    [::sm/one-of stroke-caps]]
+   [:stroke-cap-end {:optional true}
+    [::sm/one-of stroke-caps]]
+   [:stroke-color-gradient {:optional true} ::ctc/gradient]
+   [:stroke-image {:optional true} ::ctc/image-color]])
+
+(sm/register! ::stroke schema:stroke)
 
 (def check-stroke
   (sm/check-fn schema:stroke))
@@ -172,7 +171,8 @@
    [:width ::sm/safe-number]
    [:height ::sm/safe-number]])
 
-(def schema:shape-generic-attrs
+;; FIXME: rename to shape-generic-attrs
+(def schema:shape-attrs
   [:map {:title "ShapeAttrs"}
    [:page-id {:optional true} ::sm/uuid]
    [:component-id {:optional true}  ::sm/uuid]
@@ -234,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"}])
@@ -259,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"}
@@ -276,7 +276,7 @@
   []
   (->> (sg/generator schema:shape-base-attrs)
        (sg/mcat (fn [{:keys [type] :as shape}]
-                  (sg/let [attrs1 (sg/generator schema:shape-generic-attrs)
+                  (sg/let [attrs1 (sg/generator schema:shape-attrs)
                            attrs2 (sg/generator schema:shape-geom-attrs)
                            attrs3 (case type
                                     :text    (sg/generator schema:text-attrs)
@@ -294,100 +294,94 @@
                       (merge attrs1 shape attrs2 attrs3)))))
        (sg/fmap create-shape)))
 
-(def schema:shape-attrs
-  [:multi {:dispatch :type
-           :decode/json (fn [shape]
-                          (update shape :type keyword))
-           :title "Shape"}
-   [:group
-    [:merge {:title "GroupShape"}
-     ctsl/schema:layout-attrs
-     schema:group-attrs
-     schema:shape-generic-attrs
-     schema:shape-geom-attrs
-     schema:shape-base-attrs]]
-
-   [:frame
-    [:merge {:title "FrameShape"}
-     ctsl/schema:layout-attrs
-     ::ctsl/layout-attrs
-     schema:frame-attrs
-     schema:shape-generic-attrs
-     schema:shape-geom-attrs
-     schema:shape-base-attrs
-     ::ctv/variant-shape
-     ::ctv/variant-container]]
-
-   [:bool
-    [:merge {:title "BoolShape"}
-     ctsl/schema:layout-attrs
-     schema:bool-attrs
-     schema:shape-generic-attrs
-     schema:shape-base-attrs]]
-
-   [:rect
-    [:merge {:title "RectShape"}
-     ctsl/schema:layout-attrs
-     schema:rect-attrs
-     schema:shape-generic-attrs
-     schema:shape-geom-attrs
-     schema:shape-base-attrs]]
-
-   [:circle
-    [:merge {:title "CircleShape"}
-     ctsl/schema:layout-attrs
-     schema:circle-attrs
-     schema:shape-generic-attrs
-     schema:shape-geom-attrs
-     schema:shape-base-attrs]]
-
-   [:image
-    [:merge {:title "ImageShape"}
-     ctsl/schema:layout-attrs
-     schema:image-attrs
-     schema:shape-generic-attrs
-     schema:shape-geom-attrs
-     schema:shape-base-attrs]]
-
-   [:svg-raw
-    [:merge {:title "SvgRawShape"}
-     ctsl/schema:layout-attrs
-     schema:svg-raw-attrs
-     schema:shape-generic-attrs
-     schema:shape-geom-attrs
-     schema:shape-base-attrs]]
-
-   [:path
-    [:merge {:title "PathShape"}
-     ctsl/schema:layout-attrs
-     schema:path-attrs
-     schema:shape-generic-attrs
-     schema:shape-base-attrs]]
-
-   [:text
-    [:merge {:title "TextShape"}
-     ctsl/schema:layout-attrs
-     schema:text-attrs
-     schema:shape-generic-attrs
-     schema:shape-geom-attrs
-     schema:shape-base-attrs]]])
-
 (def schema:shape
-  (sm/register!
-   ^{::sm/type ::shape}
-   [:and {:title "Shape"
-          :gen/gen (shape-generator)
-          :decode/json {:leave decode-shape}}
-    [:fn shape?]
-    schema:shape-attrs]))
+  [:and {:title "Shape"
+         :gen/gen (shape-generator)
+         :decode/json {:leave decode-shape}}
+   [:fn shape?]
+   [:multi {:dispatch :type
+            :decode/json (fn [shape]
+                           (update shape :type keyword))
+            :title "Shape"}
+    [:group
+     [:merge {:title "GroupShape"}
+      ::ctsl/layout-child-attrs
+      schema:group-attrs
+      schema:shape-attrs
+      schema:shape-geom-attrs
+      schema:shape-base-attrs]]
 
-(def check-shape-generic-attrs
-  (sm/check-fn schema:shape-generic-attrs))
+    [:frame
+     [:merge {:title "FrameShape"}
+      ::ctsl/layout-child-attrs
+      ::ctsl/layout-attrs
+      schema:frame-attrs
+      schema:shape-attrs
+      schema:shape-geom-attrs
+      schema:shape-base-attrs
+      ::ctv/variant-shape
+      ::ctv/variant-container]]
 
-(def check-shape-attrs
+    [:bool
+     [:merge {:title "BoolShape"}
+      ::ctsl/layout-child-attrs
+      schema:bool-attrs
+      schema:shape-attrs
+      schema:shape-base-attrs]]
+
+    [:rect
+     [:merge {:title "RectShape"}
+      ::ctsl/layout-child-attrs
+      schema:rect-attrs
+      schema:shape-attrs
+      schema:shape-geom-attrs
+      schema:shape-base-attrs]]
+
+    [:circle
+     [:merge {:title "CircleShape"}
+      ::ctsl/layout-child-attrs
+      schema:circle-attrs
+      schema:shape-attrs
+      schema:shape-geom-attrs
+      schema:shape-base-attrs]]
+
+    [:image
+     [:merge {:title "ImageShape"}
+      ::ctsl/layout-child-attrs
+      schema:image-attrs
+      schema:shape-attrs
+      schema:shape-geom-attrs
+      schema:shape-base-attrs]]
+
+    [:svg-raw
+     [:merge {:title "SvgRawShape"}
+      ::ctsl/layout-child-attrs
+      schema:svg-raw-attrs
+      schema:shape-attrs
+      schema:shape-geom-attrs
+      schema:shape-base-attrs]]
+
+    [:path
+     [:merge {:title "PathShape"}
+      ::ctsl/layout-child-attrs
+      schema:path-attrs
+      schema:shape-attrs
+      schema:shape-base-attrs]]
+
+    [:text
+     [:merge {:title "TextShape"}
+      ::ctsl/layout-child-attrs
+      schema:text-attrs
+      schema:shape-attrs
+      schema:shape-geom-attrs
+      schema:shape-base-attrs]]]])
+
+(sm/register! ::shape schema:shape)
+
+(def check-shape-attrs!
   (sm/check-fn schema:shape-attrs))
 
-(def check-shape
+(def check-shape!
   (sm/check-fn schema:shape
                :hint "expected valid shape"))
 
@@ -402,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
@@ -575,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/layout.cljc

@@ -168,24 +168,25 @@
 (def item-align-self-types
   #{:start :end :center :stretch})
 
-(def schema:layout-attrs
-  [:map {:title "LayoutChildAttrs"}
-   [:layout-item-margin-type {:optional true} [::sm/one-of item-margin-types]]
-   [:layout-item-margin {:optional true}
-    [:map
-     [:m1 {:optional true} ::sm/safe-number]
-     [:m2 {:optional true} ::sm/safe-number]
-     [:m3 {:optional true} ::sm/safe-number]
-     [:m4 {:optional true} ::sm/safe-number]]]
-   [:layout-item-max-h {:optional true} ::sm/safe-number]
-   [:layout-item-min-h {:optional true} ::sm/safe-number]
-   [:layout-item-max-w {:optional true} ::sm/safe-number]
-   [:layout-item-min-w {:optional true} ::sm/safe-number]
-   [:layout-item-h-sizing {:optional true} [::sm/one-of item-h-sizing-types]]
-   [:layout-item-v-sizing {:optional true} [::sm/one-of item-v-sizing-types]]
-   [:layout-item-align-self {:optional true} [::sm/one-of item-align-self-types]]
-   [:layout-item-absolute {:optional true} :boolean]
-   [:layout-item-z-index {:optional true} ::sm/safe-number]])
+(sm/register!
+ ^{::sm/type ::layout-child-attrs}
+ [:map {:title "LayoutChildAttrs"}
+  [:layout-item-margin-type {:optional true} [::sm/one-of item-margin-types]]
+  [:layout-item-margin {:optional true}
+   [:map
+    [:m1 {:optional true} ::sm/safe-number]
+    [:m2 {:optional true} ::sm/safe-number]
+    [:m3 {:optional true} ::sm/safe-number]
+    [:m4 {:optional true} ::sm/safe-number]]]
+  [:layout-item-max-h {:optional true} ::sm/safe-number]
+  [:layout-item-min-h {:optional true} ::sm/safe-number]
+  [:layout-item-max-w {:optional true} ::sm/safe-number]
+  [:layout-item-min-w {:optional true} ::sm/safe-number]
+  [:layout-item-h-sizing {:optional true} [::sm/one-of item-h-sizing-types]]
+  [:layout-item-v-sizing {:optional true} [::sm/one-of item-v-sizing-types]]
+  [:layout-item-align-self {:optional true} [::sm/one-of item-align-self-types]]
+  [:layout-item-absolute {:optional true} :boolean]
+  [:layout-item-z-index {:optional true} ::sm/safe-number]])
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; SCHEMAS

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/shape_tree.cljc

@@ -16,8 +16,6 @@
    [app.common.types.shape.layout :as ctl]
    [app.common.uuid :as uuid]))
 
-
-;; FIXME: the order of arguments seems arbitrary, container should be a first artgument
 (defn add-shape
   "Insert a shape in the tree, at the given index below the given parent or frame.
   Update the parent as needed."

common/src/app/common/types/typography.cljc

@@ -17,25 +17,25 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (def schema:typography
-  (sm/register!
-   ^{::sm/type ::typography}
-   [:map {:title "Typography"}
-    [:id ::sm/uuid]
-    [:name :string]
-    [:font-id :string]
-    [:font-family :string]
-    [:font-variant-id :string]
-    [:font-size :string]
-    [:font-weight :string]
-    [:font-style :string]
-    [:line-height :string]
-    [:letter-spacing :string]
-    [:text-transform :string]
-    [:modified-at {:optional true} ::sm/inst]
-    [:path {:optional true} [:maybe :string]]
-    [:plugin-data {:optional true} ::ctpg/plugin-data]]))
+  [:map {:title "Typography"}
+   [:id ::sm/uuid]
+   [:name :string]
+   [:font-id :string]
+   [:font-family :string]
+   [:font-variant-id :string]
+   [:font-size :string]
+   [:font-weight :string]
+   [:font-style :string]
+   [:line-height :string]
+   [:letter-spacing :string]
+   [:text-transform :string]
+   [:modified-at {:optional true} ::sm/inst]
+   [:path {:optional true} [:maybe :string]]
+   [:plugin-data {:optional true} ::ctpg/plugin-data]])
 
-(def check-typography
+(sm/register! ::typography schema:typography)
+
+(def check-typography!
   (sm/check-fn ::typography))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

common/src/app/common/types/variant.cljc

@@ -23,11 +23,9 @@
 
 (def schema:variant-component
   ;; A component that is part of a variant set.
-  (sm/register!
-   ^{::sm/type ::variant-component}
-   [:map
-    [:variant-id {:optional true} ::sm/uuid]
-    [:variant-properties {:optional true} [:vector schema:variant-property]]]))
+  [:map
+   [:variant-id {:optional true} ::sm/uuid]
+   [:variant-properties {:optional true} [:vector schema:variant-property]]])
 
 (def schema:variant-shape
   ;; The root shape of the main instance of a variant component.
@@ -42,6 +40,7 @@
    [:is-variant-container {:optional true} :boolean]])
 
 (sm/register! ::variant-property schema:variant-property)
+(sm/register! ::variant-component schema:variant-component)
 (sm/register! ::variant-shape schema:variant-shape)
 (sm/register! ::variant-container schema:variant-container)
 

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

@@ -3,7 +3,6 @@
   <head>
     <meta charset="utf-8">
     <meta name="viewport" content="width=device-width, initial-scale=1.0">
-    <meta name="description" content="{{ description or metadata.description }}">
     <link rel="stylesheet" href="{{ '/css/index.css' | url }}">
     <link rel="stylesheet" href="{{ '/css/prism.css' | url }}">
     <link rel="shortcut icon" href="/img/favicon.png">
@@ -15,7 +14,7 @@
     <link href="https://fonts.googleapis.com/css2?family=Work+Sans:ital,wght@0,100;0,200;0,300;0,400;0,500;0,600;0,700;0,800;0,900;1,100;1,200;1,300;1,400;1,500;1,600;1,700;1,800;1,900&display=swap" rel="stylesheet">
     {% metagen
         title=title or metadata.title,
-        desc=desc or metadata.desc,
+        desc=desc or metadata.desc or description or metadata.description,
         url="https://help.penpot.app" + page.url,
         img="https://help.penpot.app/img/th-help-center.jpg",
         img_alt=alt,

docs/contributing-guide/coc/index.njk

@@ -1,5 +1,6 @@
 ---
 title: 04· Code of Conduct
+desc: Learn about contributing to the Penpot project! This page outlines the Code of Conduct, reporting bugs, translations, core code contributions, & more.
 ---
 
 <h1 id="coc">Code of conduct</h1>

docs/contributing-guide/code-contributions/index.njk

@@ -1,5 +1,6 @@
 ---
 title: 03· Core code contributions
+desc: Learn how to contribute to Penpot's open-source design collaboration platform. Find guidelines for bug reporting, code contributions & more.
 ---
 
 <h1 id="code-contributions">Core code contributions</h1>

docs/contributing-guide/index.njk

@@ -1,5 +1,6 @@
 ---
 title: Contributing
+desc: Learn how to contribute to Penpot, the open-source design collaboration platform! Find guides on bug reporting, translations, code contributions, and more.
 eleventyNavigation:
   key: Contributing
   order: 3

docs/contributing-guide/libraries-templates/index.njk

@@ -1,5 +1,6 @@
 ---
 title: 05· Libraries & Templates
+desc: Contribute to Penpot's libraries & templates! Learn how to share your files and access resources. Try Penpot - It's free!
 ---
 
 <h1 id="libraries">Libraries & templates</h1>

docs/contributing-guide/reporting-bugs/index.njk

@@ -1,5 +1,6 @@
 ---
 title: 01· Reporting bugs
+desc: Learn how to contribute to Penpot, the open-source design and prototyping platform! Find guidelines for reporting bugs, translations, & code contributions.
 ---
 
 <h1 id="reporting-bugs">Reporting bugs</h1>

docs/contributing-guide/translations/index.njk

@@ -1,5 +1,6 @@
 ---
 title: 02· Translations
+desc: Contribute to Penpot! Learn how to translate Penpot into your language using Weblate. Add new translations, languages, or edit existing ones today.
 ---
 
 <h1 id="translations">Translations</h1>

docs/index.njk

@@ -1,5 +1,6 @@
 ---
 title: Help center
+desc: Find user guides, technical documentation, plugin info, FAQs, and contributing guidelines in Penpot's help center. Join the open-source community!
 layout: layouts/home.njk
 twitter: "@penpotapp"
 image: img/placeholder.png

docs/plugins/api.md

@@ -1,6 +1,7 @@
 ---
 layout: layouts/plugins.njk
 title: 4. API
+desc: Create, deploy, and use the Penpot plugin API with our comprehensive documentation. Get started today and expand Penpot's capabilities.
 ---
 
 # Penpot plugins API

docs/plugins/beta-changelog.md

@@ -1,5 +1,7 @@
 ---
 layout: layouts/plugins-no-sidebar.njk
+title: Beta changelog
+desc: See the Penpot plugin API changelog for version 1.0! Find breaking changes, deprecations, new features, and updated documentation. Try Penpot for free.
 ---
 
 # Beta changelog

docs/plugins/create-a-plugin.md

@@ -1,6 +1,7 @@
 ---
 layout: layouts/plugins.njk
 title: 2. Create a Plugin
+desc: Dive into Penpot plugin development! This guide covers creating plugins from scratch or using templates, libraries, API communication, & deployment.
 ---
 
 # Create a Plugin
@@ -34,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/plugins/deployment.md

@@ -1,6 +1,7 @@
 ---
 layout: layouts/plugins.njk
 title: 3. Deployment
+desc: Deploy your free Penpot plugins! Learn about Netlify, Cloudflare, Surge & Penpot submission in this guide. Build and share your creations.
 ---
 
 # Deployment

docs/plugins/examples-templates.md

@@ -1,6 +1,7 @@
 ---
 layout: layouts/plugins.njk
 title: 5. Examples and templates
+desc: Learn to create shapes, text, layouts, components, themes, and interactive prototypes. Start building now! See Penpot plugins with examples & templates!
 ---
 
 # Examples and templates
@@ -117,7 +118,6 @@ Just a friendly reminder that it's important to have the <b>comment permissions<
 
 <a target="_blank" href="https://github.com/penpot/penpot-plugins-samples/tree/main/create-comments">Comments example</a>
 
-
 ## 5.2. Templates
 
 As we mentioned in the <a target="_blank" href="/plugins/create-a-plugin/">Create a plugin</a> section, we've got two great options for you to get started with your plugin.

docs/plugins/faq.md

@@ -1,6 +1,7 @@
 ---
 layout: layouts/plugins.njk
 title: 6. FAQ
+desc: Find answers to common questions about plugin development, from choosing the right Node version to creating components. See Penpot plugins!
 ---
 
 # FAQ

docs/plugins/getting-started.md

@@ -1,6 +1,7 @@
 ---
 layout: layouts/plugins.njk
 title: 1. Getting started
+desc: Dive into Penpot plugins! Extend Penpot's functionality by automating tasks and adding new features using JavaScript, HTML, & CSS. Get started now!
 ---
 
 # Getting started

docs/plugins/index.njk

@@ -1,6 +1,7 @@
 ---
 layout: layouts/plugins-home.njk
 title: Plugins
+desc: "Get started with Penpot Plugins: Installation, development, and deployment. Access API documentation, examples, templates, and FAQs."
 eleventyNavigation:
   key: Plugins
   order: 5

docs/technical-guide/configuration.md

@@ -1,5 +1,6 @@
 ---
 title: 2. Penpot Configuration
+desc: Learn about self-hosting, configuration via environment variables, and authentication providers. Try Penpot - It's free! See Penpot's technical guide.
 ---
 
 # Penpot Configuration

docs/technical-guide/developer/architecture/backend.md

@@ -1,5 +1,6 @@
 ---
 title: Backend app
+desc: Dive into self-hosting, configuration, developer insights (architecture, data model), integration, and troubleshooting. See Penpot's Technical Guide.
 ---
 
 # Backend app

docs/technical-guide/developer/architecture/common.md

@@ -1,5 +1,6 @@
 ---
 title: Common code
+desc: Learn about architecture, data models, and development environments. See Penpot's technical guide for developers. Dive into common code.
 ---
 
 # Common code

docs/technical-guide/developer/architecture/exporter.md

@@ -1,5 +1,6 @@
 ---
 title: Exporter app
+desc: Learn about self-hosting, configuration, architecture (backend, frontend), data model, and development environment. See Penpot's technical guide.
 ---
 
 # Exporter app

docs/technical-guide/developer/architecture/frontend.md

@@ -1,5 +1,6 @@
 ---
 title: Frontend app
+desc: Dive into the UI, data namespaces, ClojureScript, React, and worker app functionalities. View Penpot's frontend app architecture. Free to try!
 ---
 
 ### Frontend app

docs/technical-guide/developer/architecture/index.md

@@ -1,5 +1,6 @@
 ---
 title: 3.01. Architecture
+desc: Dive into architecture, backend, frontend, data models, and development environments. Contribute and self-host for free! See Penpot's technical guide.
 ---
 
 # Architecture

docs/technical-guide/developer/common.md

@@ -1,5 +1,6 @@
 ---
 title: 3.04. Common Guide
+desc: "View Penpot's technical guide: self-hosting, configuration, developer insights, architecture, data model, integration, and troubleshooting."
 ---
 
 # Common guide

docs/technical-guide/developer/data-guide.md

@@ -1,5 +1,6 @@
 ---
 title: 3.08. Data Guide
+desc: Learn about data structures, code organization, file operations, migrations, shape editing, and component syncing. See Penpot's technical guide. Try it free!
 ---
 
 # Data Guide

docs/technical-guide/developer/data-model/index.md

@@ -1,5 +1,6 @@
 ---
 title: 3.02. Data model
+desc: Learn about self-hosting, configuration, developer tools, data models, architecture, and integrations. View Penpot's technical guide. Free to use!
 ---
 
 # Penpot Data Model

docs/technical-guide/developer/devenv.md

@@ -1,5 +1,6 @@
 ---
 title: 3.03. Dev environment
+desc: Dive into Penpot's development environment. Learn about self-hosting, configuration, developer tools, architecture, and more. See the Penpot Technical Guide!
 ---
 
 # Development environment
@@ -95,7 +96,7 @@ npx shadow-cljs cljs-repl main
 ### Storybook
 
 The storybook local server is started on tmux **window 2** and will listen
-for changes in the styles, components or stories defined in the folders 
+for changes in the styles, components or stories defined in the folders
 under the design system namespace: `app.main.ui.ds`.
 
 You can open the broser on http://localhost:6006/ to see it.

docs/technical-guide/developer/frontend.md

@@ -1,5 +1,6 @@
 ---
 title: 3.05. Frontend Guide
+desc: "See Penpot's technical guide: self-hosting, configuration, developer insights (architecture, data model), frontend, backend, and integrations & more!"
 ---
 
 # Frontend Guide

docs/technical-guide/developer/index.md

@@ -1,5 +1,6 @@
 ---
 title: 3. Developer Guide
+desc: Dive into architecture, data models, and more. Start building today! See Penpot's technical guide for self-hosting, configuration, and developer insights.
 ---
 
 # Developer Guide

docs/technical-guide/developer/subsystems/assets-storage.md

@@ -1,5 +1,6 @@
 ---
 title: Assets storage
+desc: Learn about assets storage, API, object buckets, sharing, and garbage collection. See Penpot's technical guide for developers. Try Penpot - It's free.
 ---
 
 # Assets storage

docs/technical-guide/developer/subsystems/authentication.md

@@ -1,5 +1,6 @@
 ---
 title: Authentication
+desc: Dive into Penpot today! Learn about self-hosting, configuration, developer insights, authentication, and more. View Penpot's technical guide. Try it free.
 ---
 
 # User authentication