Revert "add new configurations"

add new configurations

CHANGES.md

@@ -1,5 +1,50 @@
 # 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
@@ -18,6 +63,7 @@
 - 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
 

backend/scripts/manage.py

@@ -35,40 +35,35 @@ def get_prepl_conninfo():
 
     return host, port
 
-def send_eval(expr):
+def send(data):
     host, port = get_prepl_conninfo()
+    with socket.create_connection((host, port)) as s:
+        f = s.makefile(mode="rw")
 
-    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")
+        json.dump(data, f)
+        f.write("\n")
+        f.flush()
 
-        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")
+        while True:
+            line = f.readline()
+            result = json.loads(line)
+            tag = result.get("tag", None)
 
-def encode(val):
-    return json.dumps(json.dumps(val))
+            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 print_error(res):
-    for error in res["via"]:
-        print("ERR:", error["message"])
-        break
+def print_error(error):
+    print("ERR:", error["hint"])
 
 def run_cmd(params):
     try:
-        expr = "(app.srepl.cli/exec {})".format(encode(params))
-        res, failed = send_eval(expr)
-        if failed:
-            print_error(res)
+        res, err = send(params)
+        if err:
+            print_error(err)
             sys.exit(-1)
 
         return res
@@ -96,7 +91,7 @@ def update_profile(email, fullname, password, is_active):
             "email": email,
             "fullname": fullname,
             "password": password,
-            "is_active": is_active
+            "isActive": is_active
         }
     }
 
@@ -138,7 +133,7 @@ def derive_password(password):
     params = {
         "cmd": "derive-password",
         "params": {
-            "password": password,
+            "password": password
         }
     }
 

backend/src/app/binfile/cleaner.clj

@@ -9,6 +9,7 @@
   for recently imported shapes."
   (:require
    [app.common.data :as d]
+   [app.common.types.shape :as cts]
    [app.common.uuid :as uuid]))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -55,9 +56,52 @@
                    (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-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)))))

backend/src/app/binfile/common.clj

@@ -431,15 +431,21 @@
                           (update :components relink-shapes)
                           (update :media relink-media)
                           (update :colors relink-colors)
-                          (d/without-nils))))))
+                          (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)))
 
 (defn encode-file
-  [{:keys [::db/conn] :as cfg} {:keys [id] :as file}]
-  (let [file (if (contains? (:features file) "fdata/objects-map")
+  [{:keys [::db/conn] :as cfg} {:keys [id features] :as file}]
+  (let [file (if (contains? features "fdata/objects-map")
                (feat.fdata/enable-objects-map file)
                file)
 
-        file (if (contains? (:features file) "fdata/pointer-map")
+        file (if (contains? features "fdata/pointer-map")
                (binding [pmap/*tracked* (pmap/create-tracked)]
                  (let [file (feat.fdata/enable-pointer-map file)]
                    (feat.fdata/persist-pointers! cfg id)

backend/src/app/binfile/v3.clj

@@ -756,14 +756,7 @@
                    (assoc :name file-name)
                    (assoc :project-id project-id)
                    (dissoc :options)
-                   (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))]
+                   (bfc/process-file))]
 
       (bfm/register-pending-migrations! cfg file)
       (bfc/save-file! cfg file ::db/return-keys false)

backend/src/app/db.clj

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

backend/src/app/features/components_v2.clj

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

backend/src/app/features/fdata.clj

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

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

@@ -231,7 +231,7 @@
               :hint "email has complaint reports")))
 
 (defn prepare-register
-  [{:keys [::db/pool] :as cfg} {:keys [email] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [email accept-newsletter-updates] :as params}]
 
   (validate-register-attempt! cfg params)
 
@@ -243,7 +243,8 @@
                  :backend "penpot"
                  :iss :prepared-register
                  :profile-id (:id profile)
-                 :exp (dt/in-future {:days 7})}
+                 :exp (dt/in-future {:days 7})
+                 :props {:newsletter-updates (or accept-newsletter-updates false)}}
 
         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,18 +111,21 @@
                         ::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 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)]
+    (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"))]
         (db/update! conn :team
                     {:features features}
-                    {:id team-id})))
+                    {:id (:id team)}
+                    {::db/return-keys false})))
 
     (-> (create-file cfg params)
         (vary-meta assoc ::audit/props {:team-id team-id}))))

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

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

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

@@ -76,9 +76,10 @@
   (perms/make-check-fn has-read-permissions?))
 
 (defn decode-row
-  [{:keys [features] :as row}]
+  [{:keys [features subscription] :as row}]
   (cond-> row
-    (some? features) (assoc :features (db/decode-pgarray features #{}))))
+    (some? features) (assoc :features (db/decode-pgarray features #{}))
+    (some? subscription) (assoc :subscription (db/decode-transit-pgobject subscription))))
 
 ;; FIXME: move
 
@@ -126,16 +127,40 @@
     (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")
+          (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;")
 
 (defn process-permissions
   [team]
@@ -150,13 +175,21 @@
         (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)]
-    (->> (db/exec! conn [sql:get-teams-with-permissions (:default-team-id profile) profile-id])
-         (map decode-row)
-         (map process-permissions)
-         (vec))))
+  (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))))
 
 ;; --- Query: Team (by ID)
 

backend/src/app/srepl.clj

@@ -6,13 +6,17 @@
 
 (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]
+   [app.srepl.cli :as 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]))
@@ -28,17 +32,80 @@
    :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 [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))))))))
+  (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))))))
 
 ;; --- State initialization
 

backend/src/app/srepl/cli.clj

@@ -9,14 +9,23 @@
   (: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.util.json :as json]
+   [app.setup :as-alias setup]
+   [app.tokens :as tokens]
    [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))
@@ -24,16 +33,21 @@
 
 (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]
-  (let [data (json/decode data)]
-    (-> {::cmd (keyword (:cmd data "default"))}
-        (merge (:params data))
-        (exec-command))))
+  (-> {::cmd (get data :cmd)}
+      (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)
@@ -49,7 +63,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!
@@ -70,7 +84,12 @@
                                         :deleted-at nil})]
                    (pos? (db/get-update-count res)))))))))
 
-(defmethod exec-command :delete-profile
+(defmethod exec-command "echo"
+  [params]
+  params)
+
+
+(defmethod exec-command "delete-profile"
   [{:keys [email soft]}]
   (when-not email
     (ex/raise :type :assertion
@@ -88,7 +107,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
@@ -102,12 +121,130 @@
                             " 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 :default
-  [{:keys [::cmd]}]
-  (ex/raise :type :internal
-            :code :not-implemented
-            :hint (str/ffmt "command '%' not implemented" (name cmd))))
+(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)))

backend/src/app/srepl/main.clj

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

backend/src/app/tasks/file_gc.clj

@@ -10,6 +10,7 @@
   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]
@@ -258,6 +259,7 @@
   (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.11.132"}
+  org.clojure/clojurescript {:mvn/version "1.12.38"}
   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 "2.28.20"}
+    thheller/shadow-cljs {:mvn/version "3.0.3"}
     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": "2.28.20",
+    "shadow-cljs": "3.0.3",
     "source-map-support": "^0.5.21",
     "ws": "^8.17.0"
   },

common/scripts/repl

@@ -2,16 +2,20 @@
 
 export PENPOT_FLAGS="enable-asserts enable-audit-log $PENPOT_FLAGS"
 
-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 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_EVAL="nil"
 # export OPTIONS_EVAL="(set! *warn-on-reflection* true)"

common/src/app/common/features.cljc

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

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

@@ -732,20 +732,22 @@
 
           (update-group [group objects]
             (let [lookup   (d/getf objects)
-                  children (->> group :shapes (map lookup))]
+                  children (get group :shapes)]
               (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-selrect group children objects)
+                (gsh/update-bool group objects)
 
                 (:masked-group group)
-                (set-mask-selrect group children)
+                (->> (map lookup children)
+                     (set-mask-selrect group))
 
                 :else
-                (gsh/update-group-selrect group children))))]
+                (->> (map lookup children)
+                     (gsh/update-group-selrect group)))))]
 
     (if page-id
       (d/update-in-when data [:pages-index page-id :objects] reg-objects)

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

@@ -8,7 +8,6 @@
   (:require
    [app.common.data :as d]
    [app.common.data.macros :as dm]
-   [app.common.features :as cfeat]
    [app.common.files.changes :as cfc]
    [app.common.files.helpers :as cfh]
    [app.common.geom.matrix :as gmt]
@@ -84,8 +83,7 @@
 
 (defn with-objects
   [changes objects]
-  (let [fdata (binding [cfeat/*current* #{"components/v2"}]
-                (ctf/make-file-data (uuid/next) uuid/zero))
+  (let [fdata (ctf/make-file-data (uuid/next) uuid/zero)
         fdata (assoc-in fdata [:pages-index uuid/zero :objects] objects)]
     (vary-meta changes assoc
                ::file-data fdata
@@ -480,9 +478,12 @@
           (let [old-val (get old attr)
                 new-val (get new attr)]
             (not= old-val new-val)))
-        new-obj (if with-objects?
-                  (update-fn object objects)
-                  (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)))))
@@ -659,9 +660,13 @@
                                  nil               ;; so it does not need resize
 
                                  (= (:type parent) :bool)
-                                 (gsh/update-bool-selrect parent children objects)
+                                 (gsh/update-bool parent 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,7 +16,6 @@
    [app.common.geom.point :as gpt]
    [app.common.geom.rect :as grc]
    [app.common.geom.shapes :as gsh]
-   [app.common.geom.shapes.path :as gsp]
    [app.common.geom.shapes.text :as gsht]
    [app.common.logging :as l]
    [app.common.math :as mth]
@@ -27,6 +26,8 @@
    [app.common.types.component :as ctk]
    [app.common.types.container :as ctn]
    [app.common.types.file :as ctf]
+   [app.common.types.path :as path]
+   [app.common.types.path.segment :as path.segment]
    [app.common.types.shape :as cts]
    [app.common.types.shape.interactions :as ctsi]
    [app.common.types.shape.shadow :as ctss]
@@ -98,13 +99,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)))))
+          (migrate)
+          (update :features (fnil into #{}) (deref cfeat/*new*))))))
 
 (defn migrated?
   [file]
@@ -129,8 +130,8 @@
   [data _]
   (letfn [(migrate-path [shape]
             (if-not (contains? shape :content)
-              (let [content (gsp/segments->content (:segments shape) (:close? shape))
-                    selrect (gsh/content->selrect content)
+              (let [content (path.segment/points->content (:segments shape) :close (:close? shape))
+                    selrect (path.segment/content->selrect content)
                     points  (grc/rect->points selrect)]
                 (-> shape
                     (dissoc :segments)
@@ -201,7 +202,7 @@
             (if (= (:type shape) :path)
               (let [{:keys [width height]} (grc/points->rect (:points shape))]
                 (if (or (mth/almost-zero? width) (mth/almost-zero? height))
-                  (let [selrect (gsh/content->selrect (:content shape))
+                  (let [selrect (path.segment/content->selrect (:content shape))
                         points (grc/rect->points selrect)
                         transform (gmt/matrix)
                         transform-inv (gmt/matrix)]
@@ -1281,8 +1282,8 @@
             (d/update-when container :objects update-vals update-object))]
 
     (-> data
-        (update :pages-index update-vals update-container)
-        (update :components update-vals update-container))))
+        (update :pages-index d/update-vals update-container)
+        (d/update-when :components d/update-vals update-container))))
 
 (defmethod migrate-data "0003-fix-root-shape"
   [data _]
@@ -1306,6 +1307,23 @@
         (d/update-when :components d/update-vals update-container)
         (d/without-nils))))
 
+(defmethod migrate-data "0003-convert-path-content"
+  [data _]
+  (some-> cfeat/*new* (swap! conj "fdata/path-data"))
+
+  (letfn [(update-object [object]
+            (if (or (cfh/bool-shape? object)
+                    (cfh/path-shape? object))
+              (update object :content path/content)
+              object))
+
+          (update-container [container]
+            (d/update-when container :objects update-vals update-object))]
+
+    (-> data
+        (update :pages-index d/update-vals update-container)
+        (d/update-when :components d/update-vals update-container))))
+
 (def available-migrations
   (into (d/ordered-set)
         ["legacy-2"
@@ -1363,4 +1381,5 @@
          "0001-remove-tokens-from-groups"
          "0002-normalize-bool-content"
          "0002-clean-shape-interactions"
-         "0003-fix-root-shape"]))
+         "0003-fix-root-shape"
+         "0003-convert-path-content"]))

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

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

common/src/app/common/geom/matrix.cljc

@@ -126,21 +126,20 @@
       o)))
 
 (def schema: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)
+  (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"}}))
 
 ;; 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])
+  (:refer-clojure :exclude [divide min max abs zero?])
   (:require
    #?(:clj [app.common.fressian :as fres])
    #?(:cljs [cljs.core :as c]
@@ -85,24 +85,22 @@
     (into {} p)
     p))
 
-;; FIXME: make like matrix
 (def schema:point
-  {: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)
+  (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}}))
 
 (defn point-like?
   [{:keys [x y] :as v}]
@@ -470,6 +468,13 @@
   (and ^boolean (mth/almost-zero? (dm/get-prop p :x))
        ^boolean (mth/almost-zero? (dm/get-prop p :y))))
 
+(defn zero?
+  [p]
+  (let [x (dm/get-prop p :x)
+        y (dm/get-prop p :y)]
+    (and ^boolean (== 0 x)
+         ^boolean (== 0 y))))
+
 (defn lerp
   "Calculates a linear interpolation between two points given a tvalue"
   [p1 p2 t]

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

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

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

@@ -1,29 +0,0 @@
-;; This Source Code Form is subject to the terms of the Mozilla Public
-;; License, v. 2.0. If a copy of the MPL was not distributed with this
-;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
-;;
-;; Copyright (c) KALEIDOS INC
-
-(ns app.common.geom.shapes.bool
-  (:require
-   [app.common.data :as d]
-   [app.common.files.helpers :as cpf]
-   [app.common.svg.path.bool :as pb]
-   [app.common.svg.path.shapes-to-path :as stp]))
-
-(defn calc-bool-content
-  [shape objects]
-
-  (let [extract-content-xf
-        (comp (map (d/getf objects))
-              (filter (comp not :hidden))
-              (remove cpf/svg-raw-shape?)
-              (map #(stp/convert-to-path % objects))
-              (map :content))
-
-        shapes-content
-        (into [] extract-content-xf (:shapes shape))]
-    (pb/content-bool (:bool-type shape) shapes-content)))
-
-
-

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

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

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

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

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

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

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

@@ -25,6 +25,7 @@
    [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]
@@ -43,6 +44,12 @@
 (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)
@@ -431,6 +438,8 @@
                              (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))
@@ -441,12 +450,15 @@
                                    changes
                                    (rest moved-shapes))
          changes           (cond-> changes
-                             ;; Remove variant info when restoring into a parent that is not a variant-container
-                             (and is-variant? parent (not (ctk/is-variant-container? parent)))
+                             ;; 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)))
                              (clvp/generate-make-shapes-no-variant [first-shape])
                              ;; Add variant info and rename when restoring into a variant-container
-                             (ctk/is-variant-container? parent)
-                             (clvp/generate-make-shapes-variant [first-shape] parent))]
+                             (ctk/is-variant-container? restoring-into-parent)
+                             (clvp/generate-make-shapes-variant [first-shape] restoring-into-parent))]
      {:changes (pcb/restore-component changes component-id (:id page) minusdelta)
       :shape (first moved-shapes)})))
 
@@ -1608,6 +1620,75 @@
                                                      :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.
@@ -1638,97 +1719,68 @@
         origin-shape (reposition-shape origin-shape origin-root dest-root)
         touched      (get dest-shape :touched #{})]
 
-    (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 #{}
+    (loop [attrs updatable-attrs
            roperations []
            uoperations '()]
 
       (let [attr (first attrs)]
         (if (nil? attr)
-          (if (and (empty? roperations) (empty? applied-tokens))
-            changes
-            (let [all-parents (cfh/get-parent-ids (:objects container)
-                                                  (:id dest-shape))
+          (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?))
 
-                  ;; 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))))
+          (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')))))))
 
-          (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))
+(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 #{})]
 
-                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}
+    (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)
 
-                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)))))))))
+          :always
+          (generate-update-tokens container dest-shape origin-shape touched false))))))
 
 (defn- propagate-attrs
   "Helper that puts the origin attributes (attrs) into dest but only if

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

@@ -112,9 +112,10 @@
   (reduce generate-make-shape-no-variant changes shapes))
 
 
-(defn- generate-new-properties-from-variant
+(defn- create-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))
@@ -127,7 +128,7 @@
       (ctv/add-new-prop props (:name component))
       props)))
 
-(defn- generate-new-properties-from-non-variant
+(defn- create-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)]
@@ -155,14 +156,14 @@
         [cpath cname]  (cfh/parse-path-name (:name variant-container))
         container-name (:name variant-container)
 
-        generate-new-properties
+        create-new-properties
         (fn [shape min-props]
           (if (ctk/is-variant? shape)
-            (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)))
+            (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)))
 
         total-props    (reduce (fn [m shape]
-                                 (max m (count (generate-new-properties shape num-base-props))))
+                                 (max m (count (create-new-properties shape num-base-props))))
                                0
                                shapes)
 
@@ -180,19 +181,21 @@
                                                   :name (:name variant-container)))]
     (reduce
      (fn [changes shape]
-       (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))))))
+       (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)))))))
      changes
-     shapes)))
+     shapes)))

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

@@ -1,12 +1,29 @@
 (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)
@@ -28,3 +45,26 @@
     (-> 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,6 +9,7 @@
   #?(:cljs (:require-macros [app.common.schema :refer [ignoring]]))
   (:require
    [app.common.data :as d]
+   [app.common.math :as mth]
    [app.common.pprint :as pp]
    [app.common.schema.generators :as sg]
    [app.common.schema.openapi :as-alias oapi]
@@ -27,10 +28,6 @@
    [malli.transform :as mt]
    [malli.util :as mu]))
 
-(defprotocol ILazySchema
-  (-validate [_ o])
-  (-explain [_ o]))
-
 (def default-options
   {:registry sr/default-registry})
 
@@ -50,10 +47,6 @@
   [s]
   (m/type-properties s))
 
-(defn- lazy-schema?
-  [s]
-  (satisfies? ILazySchema s))
-
 (defn schema
   [s]
   (if (schema? s)
@@ -110,12 +103,16 @@
   (malli.error/error-value exp {:malli.error/mask-valid-values '...}))
 
 (defn optional-keys
-  [schema]
-  (mu/optional-keys schema default-options))
+  ([schema]
+   (mu/optional-keys schema nil default-options))
+  ([schema keys]
+   (mu/optional-keys schema keys default-options)))
 
 (defn required-keys
-  [schema]
-  (mu/required-keys schema default-options))
+  ([schema]
+   (mu/required-keys schema nil default-options))
+  ([schema keys]
+   (mu/required-keys schema keys default-options)))
 
 (defn transformer
   [& transformers]
@@ -228,6 +225,11 @@
   (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]}]
@@ -273,38 +275,36 @@
   ([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 [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)))
+  (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))))
 
 (defn check
   "A helper intended to be used on assertions for validate/check the
-  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)))
+  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)))
 
 (defn type-schema
   [& {:as params}]
@@ -318,11 +318,14 @@
   ([params]
    (cond
      (map? params)
-     (let [type (get params :type)]
+     (let [mdata (meta params)
+           type  (or (get mdata ::id)
+                     (get mdata ::type)
+                     (get params :type))]
        (assert (qualified-keyword? type) "expected qualified keyword for `type`")
        (let [s (m/-simple-schema params)]
          (swap! sr/registry assoc type s)
-         nil))
+         s))
 
      (vector? params)
      (let [mdata (meta params)
@@ -330,83 +333,19 @@
                      (get mdata ::type))]
        (assert (qualified-keyword? type) "expected qualified keyword to be on metadata")
        (swap! sr/registry assoc type params)
-       nil)
+       params)
 
      (m/into-schema? params)
      (let [type (m/-type params)]
-       (swap! sr/registry assoc type params))
+       (swap! sr/registry assoc type params)
+       params)
 
      :else
      (throw (ex-info "Invalid Arguments" {}))))
 
   ([type 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)))))
+   (swap! sr/registry assoc type params)
+   params))
 
 ;; --- BUILTIN SCHEMAS
 
@@ -832,7 +771,8 @@
 
           gen  (sg/one-of
                 (sg/small-int :max max :min min)
-                (sg/small-double :max max :min min))]
+                (->> (sg/small-double :max max :min min)
+                     (sg/fmap #(mth/precision % 2))))]
 
       {:pred pred
        :type-properties
@@ -907,6 +847,22 @@
    ::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])
+  (:refer-clojure :exclude [set subseq uuid filter map let boolean vector])
   #?(:cljs (:require-macros [app.common.schema.generators]))
   (:require
    [app.common.schema.registry :as sr]
@@ -126,3 +126,7 @@
 (defn tuple
   [& opts]
   (apply tg/tuple opts))
+
+(defn vector
+  [& opts]
+  (apply tg/vector opts))

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

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

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

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

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

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

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

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

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

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

common/src/app/common/test_helpers/files.cljc

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

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

@@ -41,17 +41,18 @@
   [o]
   (and (string? o) (some? (re-matches rgb-color-re o))))
 
-(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: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 schema:image-color
   [:map {:title "ImageColor"}
@@ -76,7 +77,7 @@
    [:stops
     [:vector {:min 1 :gen/max 2}
      [:map {:title "GradientStop"}
-      [:color ::rgb-color]
+      [:color schema:rgb-color]
       [:opacity {:optional true} [:maybe ::sm/safe-number]]
       [:offset ::sm/safe-number]]]]])
 
@@ -86,7 +87,7 @@
    [:name {:optional true} :string]
    [:path {:optional true} [:maybe :string]]
    [:value {:optional true} [:maybe :string]]
-   [:color {:optional true} [:maybe ::rgb-color]]
+   [:color {:optional true} [:maybe schema:rgb-color]]
    [:opacity {:optional true} [:maybe ::sm/safe-number]]
    [:modified-at {:optional true} ::sm/inst]
    [:ref-id {:optional true} ::sm/uuid]
@@ -103,12 +104,17 @@
   [:and
    [:map {:title "RecentColor"}
     [:opacity {:optional true} [:maybe ::sm/safe-number]]
-    [:color {:optional true} [:maybe ::rgb-color]]
+    [:color {:optional true} [:maybe schema:rgb-color]]
     [:gradient {:optional true} [:maybe schema:gradient]]
     [:image {:optional true} [:maybe schema:image-color]]]
    [::sm/contains-any {:strict true} [:color :gradient :image]]])
 
-(sm/register! ::rgb-color type:rgb-color)
+;; 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! ::color schema:color)
 (sm/register! ::gradient schema:gradient)
 (sm/register! ::image-color schema:image-color)
@@ -119,10 +125,13 @@
   (sm/lazy-validator schema:color))
 
 (def check-color
-  (sm/check-fn schema:color :hint "expected valid color struct"))
+  (sm/check-fn schema:color :hint "expected valid color"))
+
+(def check-library-color
+  (sm/check-fn schema:library-color :hint "expected valid library color"))
 
 (def check-recent-color
-  (sm/check-fn schema:recent-color))
+  (sm/check-fn schema:recent-color :hint "expected valid recent color"))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; HELPERS

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

@@ -18,19 +18,19 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (def schema: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)
+  (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]))
 
 (def check-component
   (sm/check-fn schema:component))
@@ -287,7 +287,7 @@
 
 (defn get-component-root
   [component]
-  (if (true? (:main-instance-id component))
+  (if (some? (: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]
-  (dm/assert! (map? file))
-  (dm/assert! (contains? valid-container-types type))
-  (dm/assert! (uuid? id))
+  (assert (map? file))
+  (assert (contains? valid-container-types type))
+  (assert (uuid? id))
 
   (-> (if (= type :page)
         (ctpl/get-page file id)
@@ -74,13 +74,9 @@
 (defn get-shape
   [container shape-id]
 
-  (dm/assert!
-   "expected valid container"
-   (check-container! container))
-
-  (dm/assert!
-   "expected valid uuid for `shape-id`"
-   (uuid? shape-id))
+  (assert (check-container container))
+  (assert (uuid? shape-id)
+          "expected valid uuid for `shape-id`")
 
   (-> container
       (get :objects)

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

@@ -83,6 +83,7 @@
   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]
@@ -101,13 +102,15 @@
 (sm/register! ::media schema:media)
 (sm/register! ::colors schema:colors)
 (sm/register! ::typographies schema:typographies)
-
 (sm/register! ::media-object schema:media)
 
-(def check-file-data!
-  (sm/check-fn ::data))
+(def check-file
+  (sm/check-fn schema:file :hint "check error on validating file"))
 
-(def check-media-object!
+(def check-file-data
+  (sm/check-fn schema:data))
+
+(def check-media-object
   (sm/check-fn schema:media))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -127,40 +130,43 @@
                 (ctp/make-empty-page {:id page-id :name "Page 1"}))]
 
      (cond-> (assoc empty-file-data :id file-id)
-       (some? page-id)
+       (some? page)
        (ctpl/add-page page)
 
        :always
-       (assoc-in [:options :components-v2] true)))))
+       (update :options assoc :components-v2 true)))))
 
 (defn make-file
-  [{:keys [id project-id name revn is-shared features
-           ignore-sync-until modified-at deleted-at
-           create-page page-id]
-    :or {is-shared false revn 0 create-page true}}]
+  [{: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}}]
 
   (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     {: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}]
+        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})]
 
-    (d/without-nils file)))
+    (check-file 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,8 +82,7 @@
 (def root uuid/zero)
 
 (def empty-page-data
-  {:options {}
-   :objects {root
+  {:objects {root
              (cts/setup-shape {:id root
                                :type :frame
                                :parent-id root
@@ -91,10 +90,12 @@
                                :name "Root Frame"})}})
 
 (defn make-empty-page
-  [{:keys [id name]}]
+  [{:keys [id name background]}]
   (-> empty-page-data
       (assoc :id (or id (uuid/next)))
-      (assoc :name (or name "Page 1"))))
+      (assoc :name (d/nilv name "Page 1"))
+      (cond-> background
+        (assoc :background background))))
 
 (defn get-frame-flow
   [flows frame-id]

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

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

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

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

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

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

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

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

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

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

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

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

common/src/app/common/types/plugins.cljc

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

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

@@ -22,13 +22,14 @@
    [app.common.transit :as t]
    [app.common.types.color :as ctc]
    [app.common.types.grid :as ctg]
+   [app.common.types.path :as path]
+   [app.common.types.path.segment :as path.segment]
    [app.common.types.plugins :as ctpg]
    [app.common.types.shape.attrs :refer [default-color]]
    [app.common.types.shape.blur :as ctsb]
    [app.common.types.shape.export :as ctse]
    [app.common.types.shape.interactions :as ctsi]
    [app.common.types.shape.layout :as ctsl]
-   [app.common.types.shape.path :as ctsp]
    [app.common.types.shape.shadow :as ctss]
    [app.common.types.shape.text :as ctsx]
    [app.common.types.token :as cto]
@@ -119,35 +120,35 @@
   [:vector {:gen/max 4 :gen/min 4} ::gpt/point])
 
 (def schema: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]])
+  (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]]))
 
-(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 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]]))
 
 (def check-stroke
   (sm/check-fn schema:stroke))
@@ -171,8 +172,7 @@
    [:width ::sm/safe-number]
    [:height ::sm/safe-number]])
 
-;; FIXME: rename to shape-generic-attrs
-(def schema:shape-attrs
+(def schema:shape-generic-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 ::ctsp/content]])
+   [:content ::path/content]])
 
 (def ^:private schema:rect-attrs
   [:map {:title "RectAttrs"}])
@@ -259,7 +259,7 @@
 
 (def ^:private schema:path-attrs
   [:map {:title "PathAttrs"}
-   [:content ::ctsp/content]])
+   [:content ::path/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-attrs)
+                  (sg/let [attrs1 (sg/generator schema:shape-generic-attrs)
                            attrs2 (sg/generator schema:shape-geom-attrs)
                            attrs3 (case type
                                     :text    (sg/generator schema:text-attrs)
@@ -294,94 +294,100 @@
                       (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
-  [: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]]
+  (sm/register!
+   ^{::sm/type ::shape}
+   [:and {:title "Shape"
+          :gen/gen (shape-generator)
+          :decode/json {:leave decode-shape}}
+    [:fn shape?]
+    schema:shape-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-generic-attrs
+  (sm/check-fn schema:shape-generic-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!
+(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"))
 
@@ -396,6 +402,50 @@
   (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
@@ -525,7 +575,7 @@
 (defn setup-path
   [{:keys [content selrect points] :as shape}]
   (let [selrect (or selrect
-                    (gsh/content->selrect content)
+                    (path.segment/content->selrect content)
                     (grc/make-rect))
         points  (or points  (grc/rect->points selrect))]
     (-> shape

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

@@ -168,25 +168,24 @@
 (def item-align-self-types
   #{:start :end :center :stretch})
 
-(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]])
+(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]])
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; SCHEMAS

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

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

common/src/app/common/types/shape_tree.cljc

@@ -16,6 +16,8 @@
    [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
-  [: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]])
+  (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]]))
 
-(sm/register! ::typography schema:typography)
-
-(def check-typography!
+(def check-typography
   (sm/check-fn ::typography))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

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

@@ -23,9 +23,11 @@
 
 (def schema:variant-component
   ;; A component that is part of a variant set.
-  [:map
-   [:variant-id {:optional true} ::sm/uuid]
-   [:variant-properties {:optional true} [:vector schema:variant-property]]])
+  (sm/register!
+   ^{::sm/type ::variant-component}
+   [: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.
@@ -40,7 +42,6 @@
    [: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

@@ -0,0 +1,29 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) KALEIDOS INC
+
+(ns app.common.weak-map
+  "A value based weak-map implementation (CLJS/JS)")
+
+(deftype ValueWeakMap [^js/Map data ^js/FinalizationRegistry registry]
+  Object
+  (clear [_]
+    (.clear data))
+  (delete [_ key]
+    (.delete data key))
+  (get [_ key]
+    (if-let [ref (.get data key)]
+      (.deref ^WeakRef ref)
+      nil))
+  (set [_ key val]
+    (.set data key (js/WeakRef. val))
+    (.register registry val key)
+    nil))
+
+(defn create
+  []
+  (let [data (js/Map.)
+        registry (js/FinalizationRegistry. #(.delete data %))]
+    (ValueWeakMap. data registry)))

common/test/common_tests/geom_shapes_test.cljc

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

common/test/common_tests/runner.cljc

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

common/test/common_tests/types/path_data_test.cljc

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

common/test/common_tests/types/shape_decode_encode_test.cljc

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

common/test/common_tests/types/shape_path_data_test.cljc

@@ -1,59 +0,0 @@
-;; This Source Code Form is subject to the terms of the Mozilla Public
-;; License, v. 2.0. If a copy of the MPL was not distributed with this
-;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
-;;
-;; Copyright (c) KALEIDOS INC
-
-(ns common-tests.types.shape-path-data-test
-  (:require
-   [app.common.data :as d]
-   [app.common.math :as mth]
-   [app.common.pprint :as pp]
-   [app.common.types.shape.path :as path]
-   [clojure.test :as t]))
-
-(def sample-content
-  [{:command :move-to, :params {:x 480.0, :y 839.0}}
-   {:command :line-to, :params {:x 439.0, :y 802.0}}
-   {:command :curve-to, :params {:c1x 368.0, :c1y 737.0, :c2x 310.0, :c2y 681.0, :x 264.0, :y 634.0}}
-   {:command :close-path :params {}}])
-
-(def sample-bytes
-  [0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 67 -16 0 0 68 81 -64 0
-   0 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 67 -37 -128 0 68 72 -128 0
-   0 3 0 0 67 -72 0 0 68 56 64 0 67 -101 0 0 68 42 64 0 67 -124 0 0 68 30 -128 0
-   0 4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0])
-
-;; This means it implements IReduceInit/IReduce protocols
-(t/deftest path-data-to-vector
-  (let [pdata  (path/path-data sample-content)
-        result (vec pdata)]
-    (t/is (= 4 (count result)))
-    (t/is (= (get-in sample-content [0 :command])
-             (get-in result [0 :command])))
-    (t/is (= (get-in sample-content [1 :command])
-             (get-in result [1 :command])))
-    (t/is (= (get-in sample-content [2 :command])
-             (get-in result [2 :command])))
-    (t/is (= (get-in sample-content [3 :command])
-             (get-in result [3 :command])))
-
-    (t/is (= (get-in sample-content [0 :params])
-             (get-in result [0 :params])))
-    (t/is (= (get-in sample-content [1 :params])
-             (get-in result [1 :params])))
-    (t/is (= (get-in sample-content [2 :params])
-             (get-in result [2 :params])))
-    (t/is (= (get-in sample-content [3 :params])
-             (get-in result [3 :params])))))
-
-(t/deftest path-data-plain-to-binary
-  (let [pdata (path/path-data sample-content)]
-    (t/is (= sample-bytes
-             (vec
-              #?(:cljs (js/Int8Array. (.-buffer pdata))
-                 :clj  (.array (.-buffer pdata))))))
-    (t/is (= (->> sample-content
-                  (mapv path/map->PathSegment))
-             (vec pdata)))))
-

docs/plugins/create-a-plugin.md

@@ -34,9 +34,11 @@ Create your own app with the framework of your choice. See examples for each fra
 
 | Framework | Command                                                     | Version\* |
 | --------- | ----------------------------------------------------------- | --------- |
-| 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    |
+| 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    |
+
 
 _\*: version we used in the examples._
 

docs/technical-guide/developer/abstraction-levels.md

@@ -0,0 +1,359 @@
+---
+title: 3.07. Abstraction levels
+---
+
+# Code organization in abstraction levels
+
+Initially, Penpot data model implementation was organized in a different way.
+We are currently in a process of reorganization. The objective is to have data
+manipulation code structured in abstraction layers, with well-defined
+boundaries, and a hierarchical structure (each level may only use same or
+lower levels, but not higher).
+
+![Abstraction levels](/img/abstraction-levels/abstraction-levels.png)
+
+At this moment the namespace structure is already organized as described here,
+but there is much code that does not comply with these rules, and needs to be
+moved or refactored. We expect to be refactoring existing modules incrementally,
+each time we do an important functionality change.
+
+## Basic data
+
+```text
+▾ common/
+  ▾ src/app/common/
+      data.cljc
+      ▾ src/app/data/
+          macros.cljc
+```
+
+A level for generic data structures or operations, that are not specifically part
+of the domain model (e.g. trees, strings, maps, iterators, etc.). Also may belong
+here some functions in <code>app.common.geom/</code> and <code>app.common.files.helpers.cljc</code>.
+
+We need to create a new directory for this and move there all functions in this
+leve.
+
+
+## Abstract data types
+
+```text
+▾ common/
+  ▾ src/app/common/
+    ▾ types/
+        file.cljc
+        page.cljc
+        shape.cljc
+        color.cljc
+        component.cljc
+        tokens_lib.cljc
+        ...
+```
+
+Namespaces here represent a single data entity of the domain model, or a
+fragment of one, as an [Abstract Data Type](https://www.geeksforgeeks.org/abstract-data-types/).
+An ADT is a data component that is defined through a series of properties and
+operations, and that abstracts out the details of how it's implemented and what
+is the internal structure. This allows to simplify the logic of the client
+code, and also to make future changes in the ADT without affecting callers (if
+the abstract interface does not change).
+
+Each structure in this module has:
+
+* A **schema spec** that defines the structure of the type and its values:
+
+     ```clojure
+     (def schema:fill
+       [:map {:title "Fill"}
+        [:fill-color {:optional true} ::ctc/rgb-color]
+        [:fill-opacity {:optional true} ::sm/safe-number]
+        ...)
+
+     (def schema:shape-base-attrs
+       [:map {:title "ShapeMinimalRecord"}
+        [:id ::sm/uuid]
+        [:name :string]
+        [:type [::sm/one-of shape-types]]
+        [:selrect ::grc/rect]
+        [:points schema:points]
+        ...)
+
+      (def schema:token-set-attrs
+        [:map {:title "TokenSet"}
+         [:name :string]
+         [:description {:optional true} :string]
+         [:modified-at {:optional true} ::sm/inst]
+         [:tokens {:optional true} [:and
+                                     [:map-of {:gen/max 5}
+                                              :string
+                                              schema:token]
+                                     [:fn d/ordered-map?]]]])
+     ```
+
+* A **protocol** that define the external interface to be used for this entity.
+
+    (NOTE: this is currently only implemented in some subsystems like Design Tokens
+     and new path handling).
+
+    ```clojure
+    (defprotocol ITokenSet
+      (update-name [_ set-name] "change a token set name while keeping the path")
+      (add-token [_ token] "add a token at the end of the list")
+      (update-token [_ token-name f] "update a token in the list")
+      (delete-token [_ token-name] "delete a token from the list")
+      (get-token [_ token-name] "return token by token-name")
+      (get-tokens [_] "return an ordered sequence of all tokens in the set"))
+    ```
+
+* A **custom data type** that implements this protocol. __Functions here are the only
+  ones allowed to modify the internal structure of the type__.
+
+    Clojure allows us two kinds of custom data types:
+     * [**`deftype`**](https://funcool.github.io/clojurescript-unraveled/#deftype). We'll
+       use it when we want the internal structure to be completely opaque and
+       data accessed through protocol functions. Clojure allows access to the
+       attributes with the <code class="language-clojure">(.-attr)</code>
+       syntax, but we prefer not to use it.
+     * [**`defrecord`**](https://funcool.github.io/clojurescript-unraveled/#defrecord).
+       We'll use it when we want the structure to be exposed as a plain clojure
+       map, and thus allowing to read attributes with <code
+       class="language-clojure">(:attr t)</code>, to use <code
+       class="language-clojure">get</code>, <code
+       class="language-clojure">keys</code>, <code
+       class="language-clojure">vals</code>, etc. Note that this also allows
+       modifying the object with <code class="language-clojure">assoc</code>,
+       <code class="language-clojure">update</code>, etc. But in general we
+       prefer to do all modification via protocol methods, because this way
+       it's easier to track down where the failure is if an invalid structure
+       is detected in a validation check, and add business logic like "update
+       <code class="language-clojure">modified-at</code> whenever any other
+       attribute is changed".
+
+    ```clojure
+    (defrecord TokenSet [name description modified-at tokens]
+      ITokenSet
+      (add-token [_ token]
+        (let [token (check-token token)]
+          (TokenSet. name
+                     description
+                     (dt/now)
+                     (assoc tokens (:name token) token))))
+    ```
+
+
+* **Additional helper functions** the protocol should be made as small and compact
+  as possible. If we need functions for business logic or complex queries that
+  do not need to directly access the internal structure, but can be implemented by
+  only calling the abstract procotol, they should be created as standalone functions.
+  At this level, they must be functions that operate only on instances of the given
+  domain model entity. They must always ensure the internal integrity of the data.
+
+    ```clojure
+    (defn sets-tree-seq
+      "Get tokens sets tree as a flat list"
+      [token-sets]
+      ...)
+
+> IMPORTANT SUMMARY
+>  * Code in this level only knows about one domain model entity.
+>  * All functions ensure the internal integrity of the data.
+>  * For this, the schema is used, and the functions must check parameters
+>    and output values as needed.
+>  * No outside code should get any knowledge of the internal structure, so it
+>    can be changed in the future without breaking cliente code.
+>  * All modifications of the data should be done via protocol methods (even in
+>    <code class="language-clojure">defrecords</code>). This allows a) more
+>    control of the internal data dependencies, b) easier bug tracking of
+>    corrupted data, and c) easier refactoring when the structure is modified.
+
+Currently most of Penpot code does not follow those requirements, but it
+should do in new code or in any refactor.
+
+## File operations
+
+```text
+▾ common/
+  ▾ src/app/common/
+    ▾ files/
+        helpers.cljc
+        shapes_helpers.cljc
+        ...
+```
+
+Functions that modify a file object (or a part of it) in place, returning the
+file object changed. They ensure the referential integrity within the file, or
+between a file and its libraries.
+
+**These functions are used when we need to manipulate objects of different
+domain entities inside a file.**
+
+```clojure
+(defn resolve-component
+  "Retrieve the referenced component, from the local file or from a library"
+  [shape file libraries & {:keys [include-deleted?] :or {include-deleted? False}}]
+  (if (= (:component-file shape) (:id file))
+        (ctkl/get-component (:data file) (:component-id shape) include-deleted?)
+        (get-component libraries
+                      (:component-file shape)
+                      (:component-id shape)
+                      :include-deleted? include-deleted?)))
+
+(defn delete-component
+  "Mark a component as deleted and store the main instance shapes iside it, to
+  be able to be recovered later."
+  [file-data component-id skip-undelete? delta]
+  (let [delta (or delta (gpt/point 0 0))]
+    (if skip-undelete?
+      (ctkl/delete-component file-data component-id)
+      (-> file-data
+          (ctkl/update-component component-id #(load-component-objects file-data % delta))
+          (ctkl/mark-component-deleted component-id)))))
+```
+
+> This module is still needing an important refactor. Mainly to take functions
+> from common.types and move them here.
+
+### File validation and repair
+
+There is a function in <code class="language-clojure">app.common.files.validate</code> that checks a file for
+referential and semantic integrity. It's called automatically when file changes
+are sent to backend, but may be invoked manually whenever it's needed.
+
+## File changes objects
+
+```text
+▾ common/
+  ▾ src/app/common/
+    ▾ files/
+        changes_builder.cljc
+        changes.cljc
+        ...
+```
+
+This layer is how we adopt the [Event sourcing pattern](https://www.geeksforgeeks.org/event-sourcing-pattern/).
+Instead of directly modifying files, we create <code class="language-clojure">changes</code>
+objects, that represent one modification, and that can be serialized, stored,
+send to backend, logged, etc. Then it can be *materialized* by a **processing
+function**, that takes a file and a change, and returns the updated file.
+
+This also allows an important feature: undoing changes.
+
+Processing functions should not contain business logic or algorithms. Just
+adapt the change interface to the operations in **File** or **Abstract Data
+Types** levels.
+
+There exists a <code class="language-clojure">changes-builder</code> module
+with helper functions to conveniently build changes objects, and to
+automatically calculate the reverse undo change.
+
+> IMPORTANT RULES
+>
+> All changes must satisfy two properties:
+> * **[Idempotence](https://en.wikipedia.org/wiki/Idempotence)**. The event
+>   sourcing architecture and multiuser capability may cause that the same
+>   change may be applied more than once to a file. So changes must not, for
+>   example, be like *increment counter* but rather *set counter to value x*.
+> * **Minimal scope**. To reduce conflicts, changes should only modify the
+>   relevant part of the domain entity. This way, if a concurrent change on
+>   the same entity arrives, from another user, and it modifies a different
+>   part of the data, they may ve processed without overriding.
+
+## Business logic
+
+```text
+▾ common/
+  ▾ src/app/common/
+    ▾ logic/
+        shapes.cljc
+        libraries.cljc
+```
+
+At this level there are functions that implement high level user actions, in an
+abstract way (independent of UI). Here may be complex business logic (eg. to
+create a component copy we must clone all shapes, assign new ids, relink
+parents, change the head structure to be a copy and link each shape in the copy
+with the corresponding one in the main).
+
+They don't directly modify files, but generate changes objects, that may be
+executed in frontend or sent to backend.
+
+Those functions may also be composed in even higher level actions. For example
+a "update shape attr" action may use "unapply token" actions when the attribute
+has an applied token.
+
+```clojure
+(defn generate-instantiate-component
+  "Generate changes to create a new instance from a component."
+  ([changes objects file-id component-id position page libraries]
+   (generate-instantiate-component changes objects file-id component-id position page libraries nil nil nil {}))
+  ([changes objects file-id component-id position page libraries old-id parent-id frame-id
+    {:keys [force-frame?]
+     :or {force-frame? false}}]
+   (let [component     (ctf/get-component libraries file-id component-id)
+         library       (get libraries file-id)
+         parent        (when parent-id (get objects parent-id))
+
+         [...]
+
+         [new-shape new-shapes]
+         (ctn/make-component-instance page
+                                      component
+                                      (:data library)
+                                      position
+                                      (cond-> {}
+                                        force-frame?
+                                        (assoc :force-frame-id frame-id)))
+
+         [...]
+
+         changes
+         (reduce #(pcb/add-object %1 %2 {:ignore-touched true})
+                 changes
+                 (rest new-shapes))]
+
+     [new-shape changes])))
+```
+
+## Data events
+
+```text
+▾ frontend/
+  ▾ src/app/main/data/
+    ▾ dashboard/
+    ▾ viewer/
+    ▾ workspace/
+```
+
+This is the intersection of the logic and the presentation in Penpot. Data
+events belong to the presentation interface and they manage the global state of
+the application. But they may also work on loaded files by using **File** or
+**Abstract Data Types** operations to query the data, and by creating and
+commiting **changes** via the **Business logic** generate functions.
+
+**IMPORTANT: data events must not contain business logic theirselves**, or
+directly manipulate data structures. They only may modify or query the global
+state, and delegate all logic to lower level functions.
+
+In current Penpot code, there is some quantity of business logic in data events,
+that should be progressively moved elsewhere as we keep refactoring.
+
+```clojure
+(defn detach-component
+  "Remove all references to components in the shape with the given id,
+  and all its children, at the current page."
+  [id]
+  (dm/assert! (uuid? id))
+  (ptk/reify ::detach-component
+    ptk/WatchEvent
+    (watch [it state _]
+      (let [page-id   (:current-page-id state)
+            file-id   (:current-file-id state)
+
+            fdata     (dsh/lookup-file-data state file-id)
+            libraries (dsh/lookup-libraries state)
+
+            changes   (-> (pcb/empty-changes it)
+                          (cll/generate-detach-component id fdata page-id libraries))]
+
+        (rx/of (dch/commit-changes changes))))))
+```

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

@@ -1,5 +1,5 @@
 ---
-title: 3.1. Architecture
+title: 3.01. Architecture
 ---
 
 # Architecture

docs/technical-guide/developer/backend.md

@@ -1,5 +1,5 @@
 ---
-title: 3.6. Backend Guide
+title: 3.06. Backend Guide
 ---
 
 # Backend guide #

docs/technical-guide/developer/common.md

@@ -1,5 +1,5 @@
 ---
-title: 3.4. Common Guide
+title: 3.04. Common Guide
 ---
 
 # Common guide

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

@@ -1,5 +1,5 @@
 ---
-title: 3.7. Data Guide
+title: 3.08. Data Guide
 ---
 
 # Data Guide
@@ -29,217 +29,6 @@ all of this is important in general.
   Clojure (for example ending it with ? for boolean values), because this may
   cause problems when exporting.
 
-## Code organization in abstraction levels
-
-Initially, Penpot data model implementation was organized in a different way.
-We are currently in a process of reorganization. The objective is to have data
-manipulation code structured in abstraction layers, with well-defined
-boundaries.
-
-At this moment the namespace structure is already organized as described here,
-but there is much code that does not comply with these rules, and needs to be
-moved or refactored. We expect to be refactoring existing modules incrementally,
-each time we do an important functionality change.
-
-### Abstract data types
-
-```text
-▾ common/
-  ▾ src/app/common/
-    ▾ types/
-        file.cljc
-        page.cljc
-        shape.cljc
-        color.cljc
-        component.cljc
-        ...
-```
-
-Namespaces here represent a single data structure, or a fragment of one, as an
-abstract data type. Each structure has:
-
-* A **schema spec** that defines the structure of the type and its values:
-
-     ```clojure
-     (sm/define! ::fill
-       [:map {:title "Fill"}
-        [:fill-color {:optional true} ::ctc/rgb-color]
-        [:fill-opacity {:optional true} ::sm/safe-number]
-        ...)
-
-     (sm/define! ::shape-attrs
-       [:map {:title "ShapeAttrs"}
-        [:name {:optional true} :string]
-        [:selrect {:optional true} ::grc/rect]
-        [:points {:optional true} ::points]
-        [:blocked {:optional true} :boolean]
-        [:fills {:optional true}
-         [:vector {:gen/max 2} ::fill]]
-        ...)
-     ```
-
-* **Helper functions** to create, query and manipulate the structure. Helpers
-    at this level only are allowed to see the internal attributes of a type.
- Updaters receive an object of the type, and return a new object modified,
-    also ensuring the internal integrity of the data after the change.
-
-    ```clojure
-    (defn setup-shape
-     "A function that initializes the geometric data of the shape. The props must
-     contain at least :x :y :width :height."
-     [{:keys [type] :as props}]
-     ...)
-
-    (defn has-direction?
-    [interaction]
-      (#{:slide :push} (-> interaction :animation :animation-type)))
-
-    (defn set-direction
-    [interaction direction]
-      (dm/assert!
-       "expected valid interaction map"
-       (check-interaction! interaction))
-      (dm/assert!
-       "expected valid direction"
-       (contains? direction-types direction))
-      (dm/assert!
-       "expected compatible interaction map"
-       (has-direction? interaction))
-      (update interaction :animation assoc :direction direction))
-    ```
-
-> IMPORTANT: we should always use helper functions to access and modify these data
-> structures. Avoid direct attribute read or using functions like <code class="language-clojure">assoc</code> or
-> <code class="language-clojure">update</code>, even if the information is contained in a single attribute. This way
-> it will be much simpler to add validation checks or to modify the internal
-> representation of a type, and will be easier to search for places in the code
-> where this data item is used.
->
-> Currently much of Penpot code does not follow this requirement, but it
-should do in new code or in any refactor.
-
-### File operations
-
-```text
-▾ common/
-  ▾ src/app/common/
-    ▾ files/
-        helpers.cljc
-        shapes_helpers.cljc
-        ...
-```
-
-Functions that modify a file object (or a part of it) in place, returning the
-file object changed. They ensure the referential integrity within the file, or
-between a file and its libraries.
-
-```clojure
-(defn resolve-component
-  "Retrieve the referenced component, from the local file or from a library"
-  [shape file libraries & {:keys [include-deleted?] :or {include-deleted? False}}]
-  (if (= (:component-file shape) (:id file))
-        (ctkl/get-component (:data file) (:component-id shape) include-deleted?)
-        (get-component libraries
-                      (:component-file shape)
-                      (:component-id shape)
-                      :include-deleted? include-deleted?)))
-
-(defn delete-component
-"Mark a component as deleted and store the main instance shapes inside it, to
-be able to be recovered later."
-[file-data component-id skip-undelete? Main-instance]
-(let [components-v2 (dm/get-in file-data [:options :components-v2])]
-  (if (or (not components-v2) skip-undelete?)
-        (ctkl/delete-component file-data component-id)
-        (let [set-main-instance ;; If there is a saved main-instance, restore it.
-               #(if main-instance
-                  (assoc-in % [:objects (:main-instance-id %)] main-instance)
-                  %)]
-        (-> file-data
-           (ctkl/update-component component-id load-component-objects)
-           (ctkl/update-component component-id set-main-instance)
-           (ctkl/mark-component-deleted component-id))))))
-```
-
-> This module is still needing an important refactor. Mainly to take functions
-> from common.types and move them here.
-
-#### File validation and repair
-
-There is a function in <code class="language-clojure">app.common.files.validate</code> that checks a file for
-referential and semantic integrity. It's called automatically when file changes
-are sent to backend, but may be invoked manually whenever it's needed.
-
-### File changes objects
-
-```text
-▾ common/
-  ▾ src/app/common/
-    ▾ files/
-        changes_builder.cljc
-        changes.cljc
-        ...
-```
-
-Wrap the update functions in file operations module into <code class="language-clojure">changes</code> objects, that
-may be serialized, stored, sent to backend and executed to actually modify a file
-object. They should not contain business logic or algorithms. Only adapt the
-interface to the file operations or types.
-
-```clojure
-(sm/define! ::changes
-  [:map {:title "changes"}
-   [:redo-changes vector?]
-   [:undo-changes seq?]
-   [:origin {:optional true} any?]
-   [:save-undo? {:optional true} boolean?]
-   [:stack-undo? {:optional true} boolean?]
-   [:undo-group {:optional true} any?]])
-
-(defmethod process-change :add-component
-  [file-data params]
-  (ctkl/add-component file-data params))
-```
-
-### Business logic
-
-```text
-▾ common/
-  ▾ src/app/common/
-    ▾ logic/
-        shapes.cljc
-        libraries.cljc
-```
-
-Functions that implement semantic user actions, in an abstract way (independent
-of UI). They don't directly modify files, but generate changes objects, that
-may be executed in frontend or sent to backend.
-
-```clojure
-(defn generate-instantiate-component
-"Generate changes to create a new instance from a component."
-[changes objects file-id component-id position page libraries old-id parent-id
-  frame-id {:keys [force-frame?] :or {force-frame? False}}]
- (let [component        (ctf/get-component libraries file-id component-id)
-        parent          (when parent-id (get objects parent-id))
-        library         (get libraries file-id)
-        components-v2 (dm/get-in library [:data :options :components-v2])
-        [new-shape new-shapes]º
-        (ctn/make-component-instance page
-                                        Component
-                                        (:data library)
-                                        Position
-                                        Components-v2
-                                        (cond-> {}
-                                   force-frame? (assoc :force-frame-id frame-id)))
-        changes (cond-> (pcb/add-object changes first-shape {:ignore-touched true})
-                 (some? old-id) (pcb/amend-last-change #(assoc % :old-id old-id)))
-        changes (reduce #(pcb/add-object %1 %2 {:ignore-touched true})
-                       changes
-                       (rest new-shapes))]
-[new-shape changes]))
-```
-
 ## Data migrations
 
 ```text

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

@@ -1,5 +1,5 @@
 ---
-title: 3.2. Data model
+title: 3.02. Data model
 ---
 
 # Penpot Data Model

docs/technical-guide/developer/devenv.md

@@ -1,5 +1,5 @@
 ---
-title: 3.3. Dev environment
+title: 3.03. Dev environment
 ---
 
 # Development environment

docs/technical-guide/developer/frontend.md

@@ -1,5 +1,5 @@
 ---
-title: 3.5. Frontend Guide
+title: 3.05. Frontend Guide
 ---
 
 # Frontend Guide

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

@@ -1,5 +1,5 @@
 ---
-title: 3.8. Penpot subsystems
+title: 3.09. Penpot subsystems
 ---
 
 # Penpot subsystems

docs/technical-guide/developer/ui.md

@@ -1,5 +1,5 @@
 ---
-title: 3.9. UI Guide
+title: 3.10. UI Guide
 ---
 
 # UI Guide

frontend/.storybook/preview.js

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

frontend/deps.edn

@@ -42,7 +42,7 @@
   :dev
   {:extra-paths ["dev"]
    :extra-deps
-   {thheller/shadow-cljs {:mvn/version "2.28.18"}
+   {thheller/shadow-cljs {:mvn/version "3.0.3"}
     com.bhauman/rebel-readline {:mvn/version "RELEASE"}
     org.clojure/tools.namespace {:mvn/version "RELEASE"}
     criterium/criterium {:mvn/version "RELEASE"}

frontend/package.json

@@ -25,6 +25,7 @@
     "build:app:libs": "node ./scripts/build-libs.js",
     "build:app:main": "clojure -M:dev:shadow-cljs release main worker",
     "build:app": "yarn run clear:shadow-cache && yarn run build:app:main && yarn run build:app:libs",
+    "build:library": "yarn run clear:shadow-cache && clojure -M:dev:shadow-cljs release library",
     "e2e:server": "node ./scripts/e2e-server.js",
     "fmt:clj": "cljfmt fix --parallel=true src/ test/",
     "fmt:clj:check": "cljfmt check --parallel=false src/ test/",
@@ -44,6 +45,7 @@
     "watch:app:main": "clojure -M:dev:shadow-cljs watch main worker storybook",
     "clear:shadow-cache": "rm -rf .shadow-cljs",
     "watch:app": "yarn run clear:shadow-cache && concurrently \"yarn run watch:app:main\" \"yarn run watch:app:libs\"",
+    "watch:library": "yarn run clear:shadow-cache && clojure -M:dev:shadow-cljs watch library",
     "watch": "yarn run watch:app:assets",
     "watch:storybook": "concurrently \"storybook dev -p 6006 --no-open\" \"yarn run watch:storybook:assets\"",
     "watch:storybook:assets": "node ./scripts/watch-storybook.js"
@@ -89,7 +91,7 @@
     "rimraf": "^6.0.1",
     "sass": "^1.83.4",
     "sass-embedded": "^1.83.4",
-    "shadow-cljs": "2.28.20",
+    "shadow-cljs": "3.0.3",
     "storybook": "^8.5.2",
     "svg-sprite": "^2.0.4",
     "typescript": "^5.7.3",

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

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

frontend/playwright/ui/pages/OnboardingPage.js

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

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

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

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

@@ -409,7 +409,7 @@ test.describe("Tokens: Tokens Tab", () => {
     // Clearing the input field should pick hex
     await valueField.fill("");
     await expect(
-      tokensUpdateCreateModal.getByText("Resolved value: -"),
+      tokensUpdateCreateModal.getByText("Token value cannot be empty"),
     ).toBeVisible();
     await valueSaturationSelector.click({ position: { x: 50, y: 50 } });
     await expect(valueField).toHaveValue(/^#[A-Fa-f\d]+$/);

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

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

frontend/resources/wasm-playground/rects.html

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

frontend/scripts/_helpers.js

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

frontend/scripts/build-app-assets.js

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

frontend/scripts/watch.js

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

frontend/shadow-cljs.edn

@@ -149,13 +149,16 @@
    {:test {:init-fn frontend-tests.runner/init
            :prepend-js ";if (typeof globalThis.navigator?.userAgent === 'undefined') { globalThis.navigator = {userAgent: ''}; };"}}}
 
-  :lib-penpot
+  :library
   {:target :esm
-   :output-dir "resources/public/libs"
+   :runtime :custom
+   :output-dir "target/library"
+   :devtools {:autoload false}
 
    :modules
-   {:penpot {:exports {:renderPage app.libs.render/render-page-export
-                       :createFile app.libs.file-builder/create-file-export}}}
+   {:penpot
+    {:exports {BuilderError lib.file-builder/BuilderError
+               createFile lib.file-builder/create-file}}}
 
    :compiler-options
    {:output-feature-set :es2020
@@ -165,6 +168,8 @@
    :release
    {:compiler-options
     {:fn-invoke-direct true
+     :optimizations #shadow/env ["PENPOT_BUILD_OPTIMIZATIONS" :as :keyword :default :advanced]
+     :pretty-print false
      :source-map true
      :elide-asserts true
      :anon-fn-naming-policy :off

frontend/src/app/libs/file_builder.cljs

@@ -1,281 +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.libs.file-builder
-  (:require
-   [app.common.data :as d]
-   [app.common.features :as cfeat]
-   [app.common.files.builder :as fb]
-   [app.common.media :as cm]
-   [app.common.types.components-list :as ctkl]
-   [app.common.uuid :as uuid]
-   [app.util.json :as json]
-   [app.util.webapi :as wapi]
-   [app.util.zip :as uz]
-   [app.worker.export :as e]
-   [beicon.v2.core :as rx]
-   [cuerdas.core :as str]
-   [promesa.core :as p]))
-
-(defn parse-data [data]
-  (as-> data $
-    (js->clj $ :keywordize-keys true)
-    ;; Transforms camelCase to kebab-case
-    (d/deep-mapm
-     (fn [[key value]]
-       (let [value (if (= (type value) js/Symbol)
-                     (keyword (js/Symbol.keyFor value))
-                     value)
-             key (-> key d/name str/kebab keyword)]
-         [key value])) $)))
-
-(defn data-uri->blob
-  [data-uri]
-  (let [[mtype b64-data] (str/split data-uri ";base64,")
-        mtype   (subs mtype (inc (str/index-of mtype ":")))
-        decoded (.atob js/window b64-data)
-        size    (.-length ^js decoded)
-        content (js/Uint8Array. size)]
-
-    (doseq [i (range 0 size)]
-      (aset content i (.charCodeAt decoded i)))
-
-    (wapi/create-blob content mtype)))
-
-(defn parse-library-media
-  [[file-id media]]
-  (rx/merge
-   (let [markup
-         (->> (vals media)
-              (reduce e/collect-media {})
-              (json/encode))]
-     (rx/of (vector (str file-id "/media.json") markup)))
-
-   (->> (rx/from (vals media))
-        (rx/map #(assoc % :file-id file-id))
-        (rx/merge-map
-         (fn [media]
-           (let [file-path (str/concat file-id "/media/" (:id media) (cm/mtype->extension (:mtype media)))
-                 blob (data-uri->blob (:uri media))]
-             (rx/of (vector file-path blob))))))))
-
-(defn export-file
-  [file]
-  (let [file (assoc file
-                    :name (:name file)
-                    :file-name (:name file)
-                    :is-shared false)
-
-        files-stream (->> (rx/of {(:id file) file})
-                          (rx/share))
-
-        manifest-stream
-        (->> files-stream
-             (rx/map #(e/create-manifest (uuid/next) (:id file) :all % cfeat/default-features))
-             (rx/map (fn [a]
-                       (vector "manifest.json" a))))
-
-        render-stream
-        (->> files-stream
-             (rx/merge-map vals)
-             (rx/merge-map e/process-pages)
-             (rx/observe-on :async)
-             (rx/merge-map e/get-page-data)
-             (rx/share))
-
-        colors-stream
-        (->> files-stream
-             (rx/merge-map vals)
-             (rx/map #(vector (:id %) (get-in % [:data :colors])))
-             (rx/filter #(d/not-empty? (second %)))
-             (rx/map e/parse-library-color))
-
-        typographies-stream
-        (->> files-stream
-             (rx/merge-map vals)
-             (rx/map #(vector (:id %) (get-in % [:data :typographies])))
-             (rx/filter #(d/not-empty? (second %)))
-             (rx/map e/parse-library-typographies))
-
-        media-stream
-        (->> files-stream
-             (rx/merge-map vals)
-             (rx/map #(vector (:id %) (get-in % [:data :media])))
-             (rx/filter #(d/not-empty? (second %)))
-             (rx/merge-map parse-library-media))
-
-        components-stream
-        (->> files-stream
-             (rx/merge-map vals)
-             (rx/filter #(d/not-empty? (ctkl/components-seq (:data %))))
-             (rx/merge-map e/parse-library-components))
-
-        pages-stream
-        (->> render-stream
-             (rx/map e/collect-page))]
-
-    (rx/merge
-     (->> render-stream
-          (rx/map #(hash-map
-                    :type :progress
-                    :file (:id file)
-                    :data (str "Render " (:file-name %) " - " (:name %)))))
-
-     (->> (rx/merge
-           manifest-stream
-           pages-stream
-           components-stream
-           media-stream
-           colors-stream
-           typographies-stream)
-          (rx/reduce conj [])
-          (rx/with-latest-from files-stream)
-          (rx/merge-map (fn [[data _]]
-                          (->> (uz/compress-files data)
-                               (rx/map #(vector file %)))))))))
-
-(deftype File [^:mutable file]
-  Object
-
-  (addPage [_ name]
-    (set! file (fb/add-page file {:name name}))
-    (str (:current-page-id file)))
-
-  (addPage [_ name options]
-    (set! file (fb/add-page file {:name name :options (parse-data options)}))
-    (str (:current-page-id file)))
-
-  (closePage [_]
-    (set! file (fb/close-page file)))
-
-  (addArtboard [_ data]
-    (set! file (fb/add-artboard file (parse-data data)))
-    (str (:last-id file)))
-
-  (closeArtboard [_]
-    (set! file (fb/close-artboard file)))
-
-  (addGroup [_ data]
-    (set! file (fb/add-group file (parse-data data)))
-    (str (:last-id file)))
-
-  (closeGroup [_]
-    (set! file (fb/close-group file)))
-
-  (addBool [_ data]
-    (set! file (fb/add-bool file (parse-data data)))
-    (str (:last-id file)))
-
-  (closeBool [_]
-    (set! file (fb/close-bool file)))
-
-  (createRect [_ data]
-    (set! file (fb/create-rect file (parse-data data)))
-    (str (:last-id file)))
-
-  (createCircle [_ data]
-    (set! file (fb/create-circle file (parse-data data)))
-    (str (:last-id file)))
-
-  (createPath [_ data]
-    (set! file (fb/create-path file (parse-data data)))
-    (str (:last-id file)))
-
-  (createText [_ data]
-    (set! file (fb/create-text file (parse-data data)))
-    (str (:last-id file)))
-
-  (createImage [_ data]
-    (set! file (fb/create-image file (parse-data data)))
-    (str (:last-id file)))
-
-  (createSVG [_ data]
-    (set! file (fb/create-svg-raw file (parse-data data)))
-    (str (:last-id file)))
-
-  (closeSVG [_]
-    (set! file (fb/close-svg-raw file)))
-
-  (addLibraryColor [_ data]
-    (set! file (fb/add-library-color file (parse-data data)))
-    (str (:last-id file)))
-
-  (updateLibraryColor [_ data]
-    (set! file (fb/update-library-color file (parse-data data)))
-    (str (:last-id file)))
-
-  (deleteLibraryColor [_ data]
-    (set! file (fb/delete-library-color file (parse-data data)))
-    (str (:last-id file)))
-
-  (addLibraryMedia [_ data]
-    (set! file (fb/add-library-media file (parse-data data)))
-    (str (:last-id file)))
-
-  (deleteLibraryMedia [_ data]
-    (set! file (fb/delete-library-media file (parse-data data)))
-    (str (:last-id file)))
-
-  (addLibraryTypography [_ data]
-    (set! file (fb/add-library-typography file (parse-data data)))
-    (str (:last-id file)))
-
-  (deleteLibraryTypography [_ data]
-    (set! file (fb/delete-library-typography file (parse-data data)))
-    (str (:last-id file)))
-
-  (startComponent [_ data]
-    (set! file (fb/start-component file (parse-data data)))
-    (str (:current-component-id file)))
-
-  (finishComponent [_]
-    (set! file (fb/finish-component file)))
-
-  (createComponentInstance [_ data]
-    (set! file (fb/create-component-instance file (parse-data data)))
-    (str (:last-id file)))
-
-  (lookupShape [_ shape-id]
-    (clj->js (fb/lookup-shape file (uuid/parse shape-id))))
-
-  (updateObject [_ id new-obj]
-    (let [old-obj (fb/lookup-shape file (uuid/parse id))
-          new-obj (d/deep-merge old-obj (parse-data new-obj))]
-      (set! file (fb/update-object file old-obj new-obj))))
-
-  (deleteObject [_ id]
-    (set! file (fb/delete-object file (uuid/parse id))))
-
-  (getId [_]
-    (:id file))
-
-  (getCurrentPageId [_]
-    (:current-page-id file))
-
-  (asMap [_]
-    (clj->js file))
-
-  (newId [_]
-    (uuid/next))
-
-  (export [_]
-    (p/create
-     (fn [resolve reject]
-       (->> (export-file file)
-            (rx/filter #(not= (:type %) :progress))
-            (rx/take 1)
-            (rx/subs!
-             (fn [value]
-               (let [[_ export-blob] value]
-                 (resolve export-blob)))
-             reject))))))
-
-(defn create-file-export [^string name]
-  (binding [cfeat/*current* cfeat/default-features]
-    (File. (fb/create-file name))))
-
-(defn exports []
-  #js {:createFile    create-file-export})

frontend/src/app/libs/render.cljs

@@ -1,28 +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.libs.render
-  (:require
-   [app.common.uuid :as uuid]
-   [app.main.render :as r]
-   [beicon.v2.core :as rx]
-   [promesa.core :as p]))
-
-(defn render-page-export
-  [file ^string page-id]
-
-  ;; Better to expose the api as a promise to be consumed from JS
-  (let [page-id (uuid/parse page-id)
-        file-data (.-file file)
-        data (get-in file-data [:data :pages-index page-id])]
-    (p/create
-     (fn [resolve reject]
-       (->> (r/render-page data)
-            (rx/take 1)
-            (rx/subs! resolve reject))))))
-
-(defn exports []
-  #js {:renderPage render-page-export})

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

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

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

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

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

@@ -771,17 +771,16 @@
 
 ;; --- Update Shape Attrs
 
+;; FIXME: rename to update-shape-generic-attrs because on the end we
+;; only allow here to update generic attrs
 (defn update-shape
   [id attrs]
-  (dm/assert!
-   "expected valid parameters"
-   (and (cts/check-shape-attrs! attrs)
-        (uuid? id)))
-
-  (ptk/reify ::update-shape
-    ptk/WatchEvent
-    (watch [_ _ _]
-      (rx/of (dwsh/update-shapes [id] #(merge % attrs))))))
+  (assert (uuid? id) "expected valid uuid for `id`")
+  (let [attrs (cts/check-shape-generic-attrs attrs)]
+    (ptk/reify ::update-shape
+      ptk/WatchEvent
+      (watch [_ _ _]
+        (rx/of (dwsh/update-shapes [id] #(merge % attrs)))))))
 
 (defn start-rename-shape
   "Start shape renaming process"
@@ -832,10 +831,6 @@
 
 (defn update-selected-shapes
   [attrs]
-  (dm/assert!
-   "expected valid shape attrs"
-   (cts/check-shape-attrs! attrs))
-
   (ptk/reify ::update-selected-shapes
     ptk/WatchEvent
     (watch [_ state _]
@@ -975,9 +970,29 @@
     ptk/WatchEvent
     (watch [_ state _]
       (let [selected (dsh/lookup-selected state)
-            objects (dsh/lookup-page-objects state)]
+            objects  (dsh/lookup-page-objects state)]
 
-        (if (> (count selected) 1)
+        (condp = (count selected)
+          0 (rx/empty)
+          1 (let [{:keys [id type] :as shape} (get objects (first selected))]
+              (case type
+                :text
+                (rx/of (dwe/start-edition-mode id))
+
+                (:group :bool :frame)
+                (let [shapes-ids (into (d/ordered-set) (get shape :shapes))]
+                  (rx/of (dws/select-shapes shapes-ids)))
+
+                :svg-raw
+                nil
+
+                (rx/of (dwe/start-edition-mode id)
+                       (dwdp/start-path-edit id))))
+
+          ;; When we have multiple shapes selected, instead of enter
+          ;; on the edition mode, we proceed to select all children of
+          ;; the selected shapes. Because we can't enter on edition
+          ;; mode on multiple shapes and this is a fallback operation.
           (let [shapes-to-select
                 (->> selected
                      (reduce
@@ -987,23 +1002,7 @@
                             (conj result shape-id)
                             (into result children))))
                       (d/ordered-set)))]
-            (rx/of (dws/select-shapes shapes-to-select)))
-
-          (when (d/not-empty? selected)
-            (let [{:keys [id type shapes]} (get objects (first selected))]
-              (case type
-                :text
-                (rx/of (dwe/start-edition-mode id))
-
-                (:group :bool :frame)
-                (let [shapes-ids (into (d/ordered-set) shapes)]
-                  (rx/of (dws/select-shapes shapes-ids)))
-
-                :svg-raw
-                nil
-
-                (rx/of (dwe/start-edition-mode id)
-                       (dwdp/start-path-edit id))))))))))
+            (rx/of (dws/select-shapes shapes-to-select))))))))
 
 (defn select-parent-layer
   []

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

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

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

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