📚 Improve metadata description

🐛 Fix parsing text spaces

CHANGES.md

@@ -1,5 +1,20 @@
 # CHANGELOG
 
+## 2.8.0 (Next / Unreleased)
+
+### :rocket: Epics and highlights
+
+### :boom: Breaking changes & Deprecations
+
+### :heart: Community contributions (Thank you!)
+
+### :sparkles: New features
+
+- Optimize profile setup flow for better user experience [Taiga #10028](https://tree.taiga.io/project/penpot/us/10028)
+
+### :bug: Bugs fixed
+
+
 ## 2.7.0 (Unreleased)
 
 ### :rocket: Epics and highlights
@@ -10,13 +25,13 @@
 
 ### :sparkles: New features
 
-
 - Update board presets with a newer devices [Taiga #10610](https://tree.taiga.io/project/penpot/us/10610)
 - Propagate "sharing a prototype" to editors and viewers [Taiga #8853](https://tree.taiga.io/project/penpot/us/8853)
 - Design improvements to the Invitations page with an empty state [Taiga #4554](https://tree.taiga.io/project/penpot/us/4554)
 - Duplicate token sets [Taiga #10694](https://tree.taiga.io/project/penpot/issue/10694)
 - Add set selection in create Token themes flow [Taiga #10746](https://tree.taiga.io/project/penpot/issue/10746)
 - Display indicator on not active sets [Taiga #10668](https://tree.taiga.io/project/penpot/issue/10668)
+- Create `input*` wrapper component, and `label*`, `input-field*` and `hint-message*` components [Taiga #10713](https://tree.taiga.io/project/penpot/us/10713)
 - Fix problem in viewer with the back button [Taiga #10907](https://tree.taiga.io/project/penpot/issue/10907)
 
 ### :bug: Bugs fixed

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

@@ -434,12 +434,12 @@
                           (d/without-nils))))))
 
 (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/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

@@ -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)

common/src/app/common/features.cljc

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

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

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

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

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

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

@@ -8,7 +8,6 @@
   (:require
    [app.common.data :as d]
    [app.common.data.macros :as dm]
-   [app.common.features :as cfeat]
    [app.common.files.changes :as cfc]
    [app.common.files.helpers :as cfh]
    [app.common.geom.matrix :as gmt]
@@ -84,8 +83,7 @@
 
 (defn with-objects
   [changes objects]
-  (let [fdata (binding [cfeat/*current* #{"components/v2"}]
-                (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,7 +660,7 @@
                                  nil               ;; so it does not need resize
 
                                  (= (:type parent) :bool)
-                                 (gsh/update-bool-selrect parent children objects)
+                                 (gsh/update-bool parent children objects)
 
                                  (= (:type parent) :group)
                                  (if (:masked-group parent)

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

@@ -16,7 +16,6 @@
    [app.common.geom.point :as gpt]
    [app.common.geom.rect :as grc]
    [app.common.geom.shapes :as gsh]
-   [app.common.geom.shapes.path :as gsp]
    [app.common.geom.shapes.text :as gsht]
    [app.common.logging :as l]
    [app.common.math :as mth]
@@ -27,6 +26,8 @@
    [app.common.types.component :as ctk]
    [app.common.types.container :as ctn]
    [app.common.types.file :as ctf]
+   [app.common.types.path :as path]
+   [app.common.types.path.segment :as path.segment]
    [app.common.types.shape :as cts]
    [app.common.types.shape.interactions :as ctsi]
    [app.common.types.shape.shadow :as ctss]
@@ -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/point.cljc

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

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

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

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

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

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

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

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

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

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

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

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

common/src/app/common/schema.cljc

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

@@ -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/file.cljc

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

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

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

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

@@ -4,15 +4,42 @@
 ;;
 ;; Copyright (c) KALEIDOS INC
 
-(ns app.common.svg.path.bool
+(ns app.common.types.path.bool
   (:require
+   [app.common.colors :as clr]
    [app.common.data :as d]
    [app.common.geom.point :as gpt]
    [app.common.geom.rect :as grc]
-   [app.common.geom.shapes.path :as gsp]
    [app.common.math :as mth]
-   [app.common.svg.path.command :as upc]
-   [app.common.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/shape.cljc

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

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

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

common/src/app/common/weak_map.cljs

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

common/test/common_tests/geom_shapes_test.cljc

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

common/test/common_tests/runner.cljc

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

common/test/common_tests/types/path_data_test.cljc

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

common/test/common_tests/types/shape_decode_encode_test.cljc

@@ -12,10 +12,10 @@
    [app.common.schema.generators :as sg]
    [app.common.schema.test :as smt]
    [app.common.types.color :refer [schema:color schema:gradient]]
+   [app.common.types.path :as path]
    [app.common.types.plugins :refer [schema:plugin-data]]
    [app.common.types.shape :as tsh]
    [app.common.types.shape.interactions :refer [schema:animation schema:interaction]]
-   [app.common.types.shape.path :refer [schema:path-content]]
    [app.common.types.shape.shadow :refer [schema:shadow]]
    [app.common.uuid :as uuid]
    [clojure.test :as t]))
@@ -112,17 +112,14 @@
          (= interaction interaction-3)))
      {:num 500})))
 
-
 (t/deftest shape-path-content-json-roundtrip
-  (let [encode (sm/encoder schema:path-content (sm/json-transformer))
-        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/_includes/layouts/base.njk

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

docs/contributing-guide/coc/index.njk

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

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

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

docs/contributing-guide/index.njk

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

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

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

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

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

docs/contributing-guide/translations/index.njk

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

docs/index.njk

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

docs/plugins/api.md

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

docs/plugins/beta-changelog.md

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

docs/plugins/create-a-plugin.md

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

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

docs/plugins/examples-templates.md

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

docs/plugins/faq.md

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

docs/plugins/getting-started.md

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

docs/plugins/index.njk

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

docs/technical-guide/configuration.md

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

docs/technical-guide/developer/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/backend.md

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

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

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

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

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

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

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

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

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

docs/technical-guide/developer/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,6 @@
 ---
-title: 3.4. Common Guide
+title: 3.04. Common Guide
+desc: "View Penpot's technical guide: self-hosting, configuration, developer insights, architecture, data model, integration, and troubleshooting."
 ---
 
 # Common guide

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

@@ -1,5 +1,6 @@
 ---
-title: 3.7. Data Guide
+title: 3.08. Data Guide
+desc: Learn about data structures, code organization, file operations, migrations, shape editing, and component syncing. See Penpot's technical guide. Try it free!
 ---
 
 # Data Guide
@@ -29,217 +30,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,6 @@
 ---
-title: 3.2. Data model
+title: 3.02. Data model
+desc: Learn about self-hosting, configuration, developer tools, data models, architecture, and integrations. View Penpot's technical guide. Free to use!
 ---
 
 # Penpot Data Model

docs/technical-guide/developer/devenv.md

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

docs/technical-guide/developer/frontend.md

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

docs/technical-guide/developer/index.md

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

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

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

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

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

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

@@ -1,5 +1,6 @@
 ---
-title: 3.8. Penpot subsystems
+title: 3.09. Penpot subsystems
+desc: Learn about architecture, data models, and subsystems. View Penpot's technical guide for self-hosting, configuration, and development insights. Free!
 ---
 
 # Penpot subsystems
@@ -12,4 +13,3 @@ implemented, over the whole app (backend, frontend or exporter), and points to
 the most relevant source files to look at to start exploring it. When some
 special considerations are needed (performance questions, limits, common
 "gotchas", historic reasons of some decisions, etc.) they are also noted.
-

docs/technical-guide/developer/ui.md

@@ -1,5 +1,6 @@
 ---
-title: 3.9. UI Guide
+title: 3.10. UI Guide
+desc: Learn UI development with React & Rumext, design system implementation, and performance considerations. See Penpot's technical guide. Free to use!
 ---
 
 # UI Guide

docs/technical-guide/getting-started/docker.md

@@ -1,5 +1,6 @@
 ---
 title: 1.3  Install with Docker
+desc: This Penpot technical guide covers self-hosting, Docker installation, configuration, updates, backups, and proxy setup with NGINX and Caddy. Try Penpot!
 ---
 
 <p class="advice">

docs/technical-guide/getting-started/index.md

@@ -1,5 +1,6 @@
 ---
 title: 1. Self-hosting Guide
+desc: Customize your Penpot instance today. Learn how to install with Elestio, Docker, or Kubernetes from the technical guide for self-hosting options.
 ---
 
 # Self-hosting Guide

docs/technical-guide/getting-started/kubernetes.md

@@ -1,5 +1,6 @@
 ---
 title: 1.4 Install with Kubernetes
+desc: Learn how to install and configure Penpot on your Kubernetes cluster using Helm. Our technical guide provides step-by-step instructions for setup.
 ---
 
 # Install with Kubernetes

docs/technical-guide/getting-started/recommended-settings.md

@@ -1,5 +1,6 @@
 ---
 title: 1.1 Recommended storage
+desc: Learn recommended self-hosting settings, Docker & Kubernetes installs, configuration, and troubleshooting tips in Penpot's technical guide.
 ---
 
 # Recommended storage

docs/technical-guide/getting-started/unofficial-options.md

@@ -1,5 +1,6 @@
 ---
 title: 1.5 Unofficial self-host options
+desc: Find guides for Docker, Kubernetes, and more in Penpot's Technical Guide for self-hosting options! Discover unofficial self-host options too.
 ---
 
 # Unofficial self-host options

docs/technical-guide/index.md

@@ -1,5 +1,6 @@
 ---
 title: Technical Guide
+desc: Get self-hosting instructions, integration details, and developer resources. Troubleshoot issues easily. Try Penpot free! See Penpot's technical guide.
 eleventyNavigation:
   key: Technical Guide
   order: 4

docs/technical-guide/integration.md

@@ -1,5 +1,6 @@
 ---
 title: 4. Integration Guide
+desc: Connect Penpot with other apps using webhooks and access tokens! Learn from Penpot's integration guide for seamless workflows. Try Penpot - It's free.
 ---
 
 # Integration Guide

docs/technical-guide/troubleshooting.md

@@ -1,5 +1,6 @@
 ---
 title: 5. Troubleshooting Penpot
+desc: Troubleshoot Penpot like a pro! Our technical guide offers tips and tricks for diagnosing issues, reading logs, and resolving problems. Get started now!
 ---
 
 # Troubleshooting Penpot

docs/user-guide/components/index.njk

@@ -1,10 +1,11 @@
 ---
 title: 11· Components
+desc: Streamline your design workflow with Penpot's Components guide! Learn to create, duplicate, group, and manage reusable components.
 ---
 
 <h1 id="components">Components</h1>
 <p class="main-paragraph">Speed your workflow with the reusable power of components.</p>
-<p>A component is an object or group of objects that can be reused multiple times across files. This can help you maintain consistency across a group of designs.</p> 
+<p>A component is an object or group of objects that can be reused multiple times across files. This can help you maintain consistency across a group of designs.</p>
 
 <p>A component has two parts:</p>
 <ul>
@@ -62,7 +63,7 @@ title: 11· Components
 
 <h2 id="component-group">Group components</h2>
 <h3>Create component groups</h3>
-<p>At the Components section from the Assets library, there are two ways to create groups in a components library.</p> 
+<p>At the Components section from the Assets library, there are two ways to create groups in a components library.</p>
 <ol>
   <li><strong>Using slashes (/):</strong> Select one component and rename it as follows: "FOLDER NAME/COMPONENT NAME". For example, "Buttons/Alert Button".</li>
   <li><strong>Using the "Group" option:</strong> Select one or more components at the Assets library, right click to show the menu and then select "Group".</li>

docs/user-guide/custom-fonts/index.njk

@@ -1,5 +1,6 @@
 ---
 title: 17· Custom fonts
+desc: Penpot's guide on custom fonts! Upload, manage, and use custom fonts in Penpot! Enhance your designs with personalised typography.
 ---
 
 <h1 id="customfonts">Custom fonts</h1>
@@ -13,9 +14,9 @@ title: 17· Custom fonts
 <h3>To upload a local font:</h3>
 <ol>
 <li>Press “Add custom font”.</li>
-<li>Inspect your local files to select one or more fonts that you want to upload. <strong>You can upload fonts with 
+<li>Inspect your local files to select one or more fonts that you want to upload. <strong>You can upload fonts with
 the following formats: TTF, OTF and WOFF</strong>. Only one format will be needed.</li>
-<li>Change the font name if needed. The font name is the name that will be shown in the font list at the workspace. 
+<li>Change the font name if needed. The font name is the name that will be shown in the font list at the workspace.
 It is also what Penpot uses to group fonts in families. You can always edit it later.</li>
 <li>Once ready, press upload. That's it. The font will be available at the font list of this team’s files.</li>
 </ol>

docs/user-guide/exporting/index.njk

@@ -1,5 +1,6 @@
 ---
 title: 07· Exporting objects
+desc: Learn how to export objects in Penpot, the free, open-source design collaboration tool. This guide covers export presets, file formats, and more!
 ---
 
 <h1 id="export">Exporting objects</h1>

docs/user-guide/flexible-layouts/index.njk

@@ -1,5 +1,6 @@
 ---
 title: 08· Flexible Layouts
+desc: Master responsive web design with Penpot's flexible and grid layouts! Learn Flexbox and CSS Grid standards. Explore tutorials, properties, and more.
 ---
 
 <h1 id="layouts">Flexible Layouts</h1>

docs/user-guide/import-export/index.njk

@@ -1,5 +1,6 @@
 ---
 title: 15· Import/export files
+desc: Learn how to import and export files in Penpot, the free, open-source design tool. Discover file formats, backups, sharing, and library management.
 ---
 
 <h1 id="import-export">Import and export files</h1>