wip: Add rxjs-spy library to monitor RX streams

This issue is started to happening because of an unrelated change
on frame-shape react component where shapes are looked up directly
on objects having in supposition that objects will be exists but on
viewer there are two objects: fixed and not-fixed, and in some cases
objects map can be empty or don't contain the object.

For solve the issue, we just filter not existing objects before
progragate the children down to the inner react components, avoiding
the exception when an object appears as `nil`.

.circleci/config.yml

@@ -34,7 +34,7 @@ jobs:
           working_directory: "./frontend"
           command: |
             yarn install
-            yarn run lint-scss
+            yarn run lint:scss
 
       - run:
           name: common lint

.clj-kondo/config.edn

@@ -16,7 +16,9 @@
   {app.common.data.macros/export hooks.export/export
    potok.core/reify hooks.export/potok-reify
    app.util.services/defmethod hooks.export/service-defmethod
+   app.common.record/defrecord hooks.export/penpot-defrecord
    app.db/with-atomic hooks.export/penpot-with-atomic
+   rumext.v2/fnc hooks.export/rumext-fnc
    }}
 
  :output

.clj-kondo/hooks/export.clj

@@ -41,18 +41,35 @@
 
 (defn penpot-with-atomic
   [{:keys [node]}]
-  (let [[_ params & other] (:children node)
+  (let [[params & body] (rest (:children node))]
+    (if (api/vector-node? params)
+      (let [[sym val opts] (:children params)]
+        (when-not (and sym val)
+          (throw (ex-info "No sym and val provided" {})))
+        {:node (api/list-node
+                (list*
+                 (api/token-node 'let)
+                 (api/vector-node [sym val])
+                 opts
+                 body))})
 
-        result (if (api/vector-node? params)
-                 (api/list-node
-                  (into [(api/token-node (symbol "clojure.core" "with-open")) params] other))
-                 (api/list-node
-                  (into [(api/token-node (symbol "clojure.core" "with-open"))
-                         (api/vector-node [params params])]
-                        other)))
+      {:node (api/list-node
+              (into [(api/token-node 'let)
+                     (api/vector-node [params params])]
+                    body))})))
+
+(defn rumext-fnc
+  [{:keys [node]}]
+  (let [[cname mdata params & body] (rest (:children node))
+        [params body] (if (api/vector-node? mdata)
+                        [mdata (cons params body)]
+                        [params body])]
+    (let [result (api/list-node
+                  (into [(api/token-node 'fn)
+                         params]
+                        (cons mdata body)))]
+      {:node result})))
 
-        ]
-    {:node result}))
 
 (defn penpot-defrecord
   [{:keys [:node]}]

.gitignore

@@ -2,6 +2,7 @@
 *.jar
 *.orig
 *.penpot
+*.css.json
 .calva
 .clj-kondo
 .cpcache

CHANGES.md

@@ -1,5 +1,43 @@
 # CHANGELOG
 
+## 1.20.0
+
+### :boom: Breaking changes & Deprecations
+
+### :sparkles: New features
+
+- Select through stroke only rectangle [Taiga #5484](https://tree.taiga.io/project/penpot/issue/5484)
+
+### :bug: Bugs fixed
+
+### :arrow_up: Deps updates
+
+### :heart: Community contributions by (Thank you!)
+
+## 1.19.4
+
+### :sparkles: New features
+
+- Improve selected colors [Taiga #5805]( https://tree.taiga.io/project/penpot/us/5805)
+
+### :bug: Bugs fixed
+
+- Fix problem with z-index field in non-absolute items
+
+## 1.19.3
+
+### :sparkles: New features
+
+- Remember last color mode in colorpicker [Taiga #5508](https://tree.taiga.io/project/penpot/issue/5508)
+- Improve layers multiselection behaviour [Github #5741](https://github.com/penpot/penpot/issues/5741)
+- Remember last active team across logouts / sessions [Github #3325](https://github.com/penpot/penpot/issues/3325)
+
+### :bug: Bugs fixed
+
+- List view is discarded on tab change on Workspace Assets Sidebar tab [Github #3547](https://github.com/penpot/penpot/issues/3547)
+- Fix message popup remains open when exiting workspace with browser back button [Taiga #5747](https://tree.taiga.io/project/penpot/issue/5747)
+- When editing text if font is changed, the proportions of the rendered shape are wrong [Taiga #5786](https://tree.taiga.io/project/penpot/issue/5786)
+
 ## 1.19.2
 
 ### :sparkles: New features
@@ -41,6 +79,8 @@
 - Add support for local caching of google fonts (this avoids exposing the final user IP to
   goolge and reduces the amount of request sent to google)
 - Set smooth/instant autoscroll depending on distance [GitHub #3377](https://github.com/penpot/penpot/issues/3377)
+- New component icon [Taiga #5290](https://tree.taiga.io/project/penpot/us/5290)
+- Show a confirmation dialog when an user tries to publish an empty library [Taiga #5294](https://tree.taiga.io/project/penpot/us/5294)
 
 ### :bug: Bugs fixed
 
@@ -102,6 +142,7 @@
 - Fix create typography with section closed [Taiga #5574](https://tree.taiga.io/project/penpot/issue/5574)
 - Fix exports menu on viewer mode [Taiga #5568](https://tree.taiga.io/project/penpot/issue/5568)
 - Fix create empty comments [Taiga #5536](https://tree.taiga.io/project/penpot/issue/5536)
+- Fix text changes not propagated to copy [Taiga #5364](https://tree.taiga.io/project/penpot/issue/5364)
 - Fix position of text cursor is a bit too high in Invitations section [Taiga #5511](https://tree.taiga.io/project/penpot/issue/5511)
 - Fix undo when updating several texts [Taiga #5197](https://tree.taiga.io/project/penpot/issue/5197)
 - Fix assets right click button for multiple selection [Taiga #5545](https://tree.taiga.io/project/penpot/issue/5545)

README.md

@@ -26,7 +26,7 @@
 
 ![feature-readme](https://user-images.githubusercontent.com/1045247/189871786-0b44f7cf-3a0a-4445-a87b-9919ec398bf7.gif)
 
-**:tada: [Important Notice!] :tada:** Our very first **Penpot Fest** is happening on June 28-30, Barcelona (Spain). **Secure yourself a ticket** to know everything about the present and future of Penpot and be part of the conversation! See details on the amazing venue and speakers lineup at [penpotfest.org](https://penpotfest.org)! :zap:
+🎇 **Penpot Fest exceeded all expectations - it was a complete success!** 🎇 Penpot Fest is our first Design event that brought designers and developers from the Open Source communities and beyond. Watch the replay of the talks on our [Youtube channel](https://www.youtube.com/playlist?list=PLgcCPfOv5v56-fghJo2dHNBqL9zlDTslh) or [Peertube channel](https://peertube.kaleidos.net/w/p/1tWgyJTt8sKbWwCEcBimZW)
 
 Penpot is the first **Open Source** design and prototyping platform meant for cross-domain teams. Non dependent on operating systems, Penpot is web based and works with open standards (SVG). Penpot invites designers all over the world to fall in love with open source while getting developers excited about the design process in return.
 

backend/deps.edn

@@ -4,9 +4,7 @@
  :deps
  {penpot/common {:local/root "../common"}
   org.clojure/clojure {:mvn/version "1.11.1"}
-  org.clojure/core.async {:mvn/version "1.6.673"}
-
-  com.github.luben/zstd-jni {:mvn/version "1.5.5-4"}
+  com.github.luben/zstd-jni {:mvn/version "1.5.5-5"}
 
   io.prometheus/simpleclient {:mvn/version "0.16.0"}
   io.prometheus/simpleclient_hotspot {:mvn/version "0.16.0"}
@@ -17,7 +15,7 @@
 
   io.prometheus/simpleclient_httpserver {:mvn/version "0.16.0"}
 
-  io.lettuce/lettuce-core {:mvn/version "6.2.4.RELEASE"}
+  io.lettuce/lettuce-core {:mvn/version "6.2.6.RELEASE"}
   java-http-clj/java-http-clj {:mvn/version "0.4.3"}
 
   funcool/yetti
@@ -38,7 +36,7 @@
   buddy/buddy-hashers {:mvn/version "2.0.167"}
   buddy/buddy-sign {:mvn/version "3.5.351"}
 
-  com.github.ben-manes.caffeine/caffeine {:mvn/version "3.1.6"}
+  com.github.ben-manes.caffeine/caffeine {:mvn/version "3.1.8"}
 
   org.jsoup/jsoup {:mvn/version "1.16.1"}
   org.im4java/im4java
@@ -56,7 +54,7 @@
 
   ;; Pretty Print specs
   pretty-spec/pretty-spec {:mvn/version "0.1.4"}
-  software.amazon.awssdk/s3 {:mvn/version "2.20.96"}
+  software.amazon.awssdk/s3 {:mvn/version "2.20.138"}
   }
 
  :paths ["src" "resources" "target/classes"]
@@ -73,7 +71,7 @@
 
   :build
   {:extra-deps
-   {io.github.clojure/tools.build {:git/tag "v0.9.3" :git/sha "e537cd1"}}
+   {io.github.clojure/tools.build {:git/tag "v0.9.5" :git/sha "24f2894"}}
    :ns-default build}
 
   :test

backend/dev/user.clj

@@ -19,10 +19,11 @@
    [app.common.schema.generators :as sg]
    [app.common.spec :as us]
    [app.common.transit :as t]
+   [app.common.types.file :as ctf]
    [app.common.uuid :as uuid]
    [app.config :as cfg]
    [app.main :as main]
-   [app.srepl.helpers]
+   [app.srepl.helpers :as srepl.helpers]
    [app.srepl.main :as srepl]
    [app.util.blob :as blob]
    [app.util.json :as json]
@@ -48,7 +49,8 @@
    [malli.generator :as mg]
    [malli.registry :as mr]
    [malli.transform :as mt]
-   [malli.util :as mu]))
+   [malli.util :as mu]
+   [promesa.exec :as px]))
 
 (repl/disable-reload! (find-ns 'integrant.core))
 (set! *warn-on-reflection* true)
@@ -176,4 +178,3 @@
         [:map
          [:type [:= :b]]
          [:b :int]]]]]]]])
-

backend/resources/app/templates/api-doc.css

@@ -156,7 +156,7 @@ h4 {
 }
 
 .rpc-row-info > .module {
-  width: 120px;
+  width: 150px;
   font-weight: bold;
   border-right: 1px dotted #777;
   text-align: right;

backend/resources/log4j2-devenv.xml

@@ -22,8 +22,8 @@
     <Logger name="org.postgresql" level="error" />
 
     <Logger name="app.rpc.commands.binfile" level="debug" />
-    <Logger name="app.storage.tmp" level="debug" />
-    <Logger name="app.worker" level="info" />
+    <Logger name="app.storage.tmp" level="info" />
+    <Logger name="app.worker" level="trace" />
     <Logger name="app.msgbus" level="info" />
     <Logger name="app.http.websocket" level="info" />
     <Logger name="app.util.websocket" level="info" />
@@ -31,6 +31,7 @@
     <Logger name="app.rpc.rlimit" level="info" />
     <Logger name="app.rpc.climit" level="info" />
     <Logger name="app.rpc.mutations.files" level="info" />
+    <Logger name="app.common.files.migrations" level="debug" />
 
     <Logger name="app.loggers" level="debug" additivity="false">
       <AppenderRef ref="main" level="debug" />

backend/scripts/repl

@@ -41,7 +41,7 @@ export PENPOT_FLAGS="\
 # Initialize MINIO config
 mc alias set penpot-s3/ http://minio:9000 minioadmin minioadmin
 mc admin user add penpot-s3 penpot-devenv penpot-devenv
-mc admin policy set penpot-s3 readwrite user=penpot-devenv
+mc admin policy attach penpot-s3 readwrite --user=penpot-devenv
 mc mb penpot-s3/penpot -p
 
 export AWS_ACCESS_KEY_ID=penpot-devenv

backend/src/app/auth.clj

@@ -8,14 +8,13 @@
   (:require
    [app.config :as cf]
    [buddy.hashers :as hashers]
-   [cuerdas.core :as str]
-   [promesa.exec :as px]))
+   [cuerdas.core :as str]))
 
 (def default-params
   {:alg :argon2id
-   :memory (* 32768 2) ;; 64 MiB
-   :iterations 7
-   :parallelism (px/get-available-processors)})
+   :memory 32768 ;; 32 MiB
+   :iterations 3
+   :parallelism 2})
 
 (defn derive-password
   [password]

backend/src/app/db.clj

@@ -145,6 +145,10 @@
   [v]
   (instance? javax.sql.DataSource v))
 
+(defn connection?
+  [conn]
+  (instance? Connection conn))
+
 (s/def ::conn some?)
 (s/def ::nilable-pool (s/nilable ::pool))
 (s/def ::pool pool?)
@@ -230,46 +234,59 @@
   [pool]
   (jdbc/get-connection pool))
 
+(defn- resolve-connectable
+  [o]
+  (if (connection? o)
+    o
+    (if (pool? o)
+      o
+      (or (::conn o) (::pool o)))))
+
+
 (def ^:private default-opts
   {:builder-fn sql/as-kebab-maps})
 
 (defn exec!
   ([ds sv]
-   (jdbc/execute! ds sv default-opts))
+   (-> (resolve-connectable ds)
+       (jdbc/execute! sv default-opts)))
   ([ds sv opts]
-   (jdbc/execute! ds sv (merge default-opts opts))))
+   (-> (resolve-connectable ds)
+       (jdbc/execute! sv (merge default-opts opts)))))
 
 (defn exec-one!
   ([ds sv]
-   (jdbc/execute-one! ds sv default-opts))
+   (-> (resolve-connectable ds)
+       (jdbc/execute-one! sv default-opts)))
   ([ds sv opts]
-   (jdbc/execute-one! ds sv
-                      (-> (merge default-opts opts)
-                          (assoc :return-keys (::return-keys? opts false))))))
+   (-> (resolve-connectable ds)
+       (jdbc/execute-one! sv
+                          (-> (merge default-opts opts)
+                              (assoc :return-keys (::return-keys? opts false)))))))
 
 (defn insert!
   [ds table params & {:as opts}]
-  (exec-one! ds
-             (sql/insert table params opts)
-             (merge {::return-keys? true} opts)))
+  (-> (resolve-connectable ds)
+      (exec-one! (sql/insert table params opts)
+                 (merge {::return-keys? true} opts))))
 
 (defn insert-multi!
   [ds table cols rows & {:as opts}]
-  (exec! ds
-         (sql/insert-multi table cols rows opts)
-         (merge {::return-keys? true} opts)))
+  (-> (resolve-connectable ds)
+      (exec! (sql/insert-multi table cols rows opts)
+             (merge {::return-keys? true} opts))))
 
 (defn update!
   [ds table params where & {:as opts}]
-  (exec-one! ds
-             (sql/update table params where opts)
-             (merge {::return-keys? true} opts)))
+  (-> (resolve-connectable ds)
+      (exec-one! (sql/update table params where opts)
+                 (merge {::return-keys? true} opts))))
 
 (defn delete!
   [ds table params & {:as opts}]
-  (exec-one! ds
-             (sql/delete table params opts)
-             (merge {::return-keys? true} opts)))
+  (-> (resolve-connectable ds)
+      (exec-one! (sql/delete table params opts)
+                 (merge {::return-keys? true} opts))))
 
 (defn is-row-deleted?
   [{:keys [deleted-at]}]
@@ -301,7 +318,8 @@
 
 (defn plan
   [ds sql]
-  (jdbc/plan ds sql sql/default-opts))
+  (-> (resolve-connectable ds)
+      (jdbc/plan sql sql/default-opts)))
 
 (defn get-by-id
   [ds table id & {:as opts}]
@@ -371,10 +389,6 @@
   [data]
   (org.postgresql.util.PGInterval. ^String data))
 
-(defn connection?
-  [conn]
-  (instance? Connection conn))
-
 (defn savepoint
   ([^Connection conn]
    (.setSavepoint conn))

backend/src/app/http/debug.clj

@@ -111,15 +111,18 @@
 
         (contains? params :clone)
         (let [profile    (profile/get-profile pool profile-id)
-              project-id (:default-project-id profile)
-              data       (blob/decode data)]
-          (create-file pool {:id (uuid/next)
-                             :name (str "Cloned file: " filename)
-                             :project-id project-id
-                             :profile-id profile-id
-                             :data data})
-          {::yrs/status 201
-           ::yrs/body "OK CREATED"})
+              project-id (:default-project-id profile)]
+
+          (db/run! pool (fn [{:keys [::db/conn]}]
+                          (create-file conn {:id file-id
+                                             :name (str "Cloned file: " filename)
+                                             :project-id project-id
+                                             :profile-id profile-id})
+                          (db/update! conn :file
+                                      {:data data}
+                                      {:id file-id})
+                          {::yrs/status 201
+                           ::yrs/body "OK CREATED"})))
 
         :else
         (prepare-response (blob/decode data))))))
@@ -133,31 +136,34 @@
   [{:keys [::db/pool]} {:keys [::session/profile-id params] :as request}]
   (let [profile    (profile/get-profile pool profile-id)
         project-id (:default-project-id profile)
-        data       (some-> params :file :path io/read-as-bytes blob/decode)]
+        data       (some-> params :file :path io/read-as-bytes)]
 
     (if (and data project-id)
-      (let [fname      (str "Imported file *: " (dt/now))
-            overwrite? (contains? params :overwrite?)
-            file-id    (or (and overwrite? (ex/ignoring (-> params :file :filename parse-uuid)))
-                           (uuid/next))]
+      (let [fname     (str "Imported file *: " (dt/now))
+            reuse-id? (contains? params :reuseid)
+            file-id   (or (and reuse-id? (ex/ignoring (-> params :file :filename parse-uuid)))
+                          (uuid/next))]
 
-        (if (and overwrite? file-id
+        (if (and reuse-id? file-id
                  (is-file-exists? pool file-id))
           (do
             (db/update! pool :file
-                        {:data (blob/encode data)}
+                        {:data data
+                         :deleted-at nil}
                         {:id file-id})
             {::yrs/status 200
              ::yrs/body "OK UPDATED"})
 
-          (do
-            (create-file pool {:id file-id
-                               :name fname
-                               :project-id project-id
-                               :profile-id profile-id
-                               :data data})
-            {::yrs/status 201
-             ::yrs/body "OK CREATED"})))
+          (db/run! pool (fn [{:keys [::db/conn]}]
+                          (create-file conn {:id file-id
+                                             :name fname
+                                             :project-id project-id
+                                             :profile-id profile-id})
+                          (db/update! conn :file
+                                      {:data data}
+                                      {:id file-id})
+                          {::yrs/status 201
+                           ::yrs/body "OK CREATED"}))))
 
       {::yrs/status 500
        ::yrs/body "ERROR"})))

backend/src/app/migrations.clj

@@ -324,6 +324,9 @@
    {:name "0104-mod-file-thumbnail-table"
     :fn (mg/resource "app/migrations/sql/0104-mod-file-thumbnail-table.sql")}
 
+   {:name "0105-mod-file-change-table"
+    :fn (mg/resource "app/migrations/sql/0105-mod-file-change-table.sql")}
+
    {:name "0105-mod-server-error-report-table"
     :fn (mg/resource "app/migrations/sql/0105-mod-server-error-report-table.sql")}
 

backend/src/app/migrations/sql/0105-mod-file-change-table.sql

@@ -0,0 +1,9 @@
+ALTER TABLE file_change
+  ADD COLUMN label text NULL;
+
+ALTER TABLE file_change
+  ALTER COLUMN label SET STORAGE external;
+
+CREATE INDEX file_change__label__idx
+    ON file_change (file_id, label)
+ WHERE label is not null;

backend/src/app/rpc.clj

@@ -214,6 +214,7 @@
           'app.rpc.commands.files-share
           'app.rpc.commands.files-temp
           'app.rpc.commands.files-update
+          'app.rpc.commands.files-snapshot
           'app.rpc.commands.files-thumbnails
           'app.rpc.commands.ldap
           'app.rpc.commands.management

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

@@ -11,10 +11,11 @@
    [app.common.data.macros :as dm]
    [app.common.exceptions :as ex]
    [app.common.files.features :as ffeat]
+   [app.common.files.migrations :as pmg]
    [app.common.fressian :as fres]
    [app.common.logging :as l]
-   [app.common.pages.migrations :as pmg]
    [app.common.spec :as us]
+   [app.common.types.file :as ctf]
    [app.common.uuid :as uuid]
    [app.config :as cf]
    [app.db :as db]
@@ -382,11 +383,10 @@
 
 ;; --- GENERAL PURPOSE DYNAMIC VARS
 
-(def ^:dynamic *state*)
-(def ^:dynamic *options*)
+(def ^:dynamic *state* nil)
+(def ^:dynamic *options* nil)
 
 ;; --- EXPORT WRITER
-
 (defn- embed-file-assets
   [data cfg file-id]
   (letfn [(walk-map-form [form state]
@@ -498,13 +498,17 @@
               :hint "unable to retrieve files for export")))
 
 (defmethod write-section :v1/files
-  [{:keys [::output ::embed-assets?] :as cfg}]
+  [{:keys [::output ::embed-assets? ::include-libraries?] :as cfg}]
 
   ;; Initialize SIDS with empty vector
   (vswap! *state* assoc :sids [])
 
   (doseq [file-id (-> *state* deref :files)]
-    (let [file  (cond-> (get-file cfg file-id)
+    (let [detach? (and (not embed-assets?) (not include-libraries?))
+          file  (cond-> (get-file cfg file-id)
+                  detach?
+                  (-> (ctf/detach-external-references file-id)
+                   (dissoc :libraries))
                   embed-assets?
                   (update :data embed-file-assets cfg file-id))
 
@@ -655,20 +659,24 @@
                   :hint "the penpot file seems corrupt, found unexpected uuid (file-id)"))
 
       ;; Update index using with media
-      (l/debug :hint "update index with media" ::l/sync? true)
+      (l/dbg :hint "update index with media" ::l/sync? true)
       (vswap! *state* update :index update-index (map :id media'))
 
       ;; Store file media for later insertion
-      (l/debug :hint "update media references" ::l/sync? true)
+      (l/dbg :hint "update media references" ::l/sync? true)
       (vswap! *state* update :media into (map #(update % :id lookup-index)) media')
 
-      (l/debug :hint "processing file" :file-id file-id ::features features ::l/sync? true)
-
       (binding [ffeat/*current* features
                 ffeat/*wrap-with-objects-map-fn* (if (features "storage/objects-map") omap/wrap identity)
                 ffeat/*wrap-with-pointer-map-fn* (if (features "storage/pointer-map") pmap/wrap identity)
                 pmap/*tracked* (atom {})]
 
+        (l/dbg :hint "processing file"
+               :id file-id
+               :features features
+               :version (-> file :data :version)
+               ::l/sync? true)
+
         (let [file-id' (lookup-index file-id)
               data     (-> (:data file)
                            (assoc :id file-id')
@@ -773,7 +781,7 @@
 (defn- lookup-index
   [id]
   (let [val (get-in @*state* [:index id])]
-    (l/debug :fn "lookup-index" :id id :val val ::l/sync? true)
+    (l/trc :fn "lookup-index" :id id :val val ::l/sync? true)
     (when (and (not (::ignore-index-errors? *options*)) (not val))
       (ex/raise :type :validation
                 :code :incomplete-index
@@ -786,7 +794,7 @@
          index index]
     (if-let [id (first items)]
       (let [new-id (if (::overwrite? *options*) id (uuid/next))]
-        (l/debug :fn "update-index" :id id :new-id new-id ::l/sync? true)
+        (l/trc :fn "update-index" :id id :new-id new-id ::l/sync? true)
         (recur (rest items)
                (assoc index id new-id)))
       index)))

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

@@ -9,8 +9,8 @@
    [app.common.data :as d]
    [app.common.data.macros :as dm]
    [app.common.exceptions :as ex]
+   [app.common.files.migrations :as pmg]
    [app.common.pages.helpers :as cph]
-   [app.common.pages.migrations :as pmg]
    [app.common.schema :as sm]
    [app.common.schema.desc-js-like :as-alias smdj]
    [app.common.schema.generators :as sg]
@@ -46,11 +46,14 @@
 (def supported-features
   #{"storage/objects-map"
     "storage/pointer-map"
+    "internal/shape-record"
+    "internal/geom-record"
     "components/v2"})
 
 (defn get-default-features
   []
-  (cond-> #{}
+  (cond-> #{"internal/shape-record"
+            "internal/geom-record"}
     (contains? cf/flags :fdata-storage-pointer-map)
     (conj "storage/pointer-map")
 
@@ -299,17 +302,17 @@
 
 ;; --- COMMAND QUERY: get-file (by id)
 
-(sm/def! ::features
+(def schema:features
   [:schema
    {:title "FileFeatures"
     ::smdj/inline true
     :gen/gen (sg/subseq supported-features)}
    ::sm/set-of-strings])
 
-(sm/def! ::file
+(def schema:file
   [:map {:title "File"}
    [:id ::sm/uuid]
-   [:features ::features]
+   [:features schema:features]
    [:has-media-trimmed :boolean]
    [:comment-thread-seqn {:min 0} :int]
    [:name :string]
@@ -320,18 +323,18 @@
    [:created-at ::dt/instant]
    [:data {:optional true} :any]])
 
-(sm/def! ::permissions-mixin
+(def schema:permissions-mixin
   [:map {:title "PermissionsMixin"}
    [:permissions ::perms/permissions]])
 
-(sm/def! ::file-with-permissions
+(def schema:file-with-permissions
   [:merge {:title "FileWithPermissions"}
-   ::file
-   ::permissions-mixin])
+   schema:file
+   schema:permissions-mixin])
 
-(sm/def! ::get-file
+(def schema:get-file
   [:map {:title "get-file"}
-   [:features {:optional true} ::features]
+   [:features {:optional true} schema:features]
    [:id ::sm/uuid]
    [:project-id {:optional true} ::sm/uuid]])
 
@@ -380,8 +383,8 @@
   {::doc/added "1.17"
    ::cond/get-object #(get-minimal-file %1 (:id %2))
    ::cond/key-fn get-file-etag
-   ::sm/params ::get-file
-   ::sm/result ::file-with-permissions}
+   ::sm/params schema:get-file
+   ::sm/result schema:file-with-permissions}
   [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id features project-id] :as params}]
   (db/with-atomic [conn pool]
     (let [perms (get-permissions conn profile-id id)]
@@ -393,14 +396,14 @@
 
 ;; --- COMMAND QUERY: get-file-fragment (by id)
 
-(sm/def! ::file-fragment
+(def schema:file-fragment
   [:map {:title "FileFragment"}
    [:id ::sm/uuid]
    [:file-id ::sm/uuid]
    [:created-at ::dt/instant]
    [:content any?]])
 
-(sm/def! ::get-file-fragment
+(def schema:get-file-fragment
   [:map {:title "get-file-fragment"}
    [:file-id ::sm/uuid]
    [:fragment-id ::sm/uuid]
@@ -414,8 +417,8 @@
 (sv/defmethod ::get-file-fragment
   "Retrieve a file by its ID. Only authenticated users."
   {::doc/added "1.17"
-   ::sm/params ::get-file-fragment
-   ::sm/result ::file-fragment}
+   ::sm/params schema:get-file-fragment
+   ::sm/result schema:file-fragment}
   [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id fragment-id share-id] }]
   (dm/with-open [conn (db/open pool)]
     (let [perms (get-permissions conn profile-id file-id share-id)]
@@ -450,12 +453,18 @@
                      (assoc :thumbnail-uri (resolve-public-uri media-id)))
                  (dissoc row :media-id))))))
 
+(def schema:get-project-files
+  [:map {:title "get-project-files"}
+   [:project-id ::sm/uuid]])
+
+(def schema:files
+  [:vector schema:file])
+
 (sv/defmethod ::get-project-files
   "Get all files for the specified project."
   {::doc/added "1.17"
-   ::sm/params [:map {:title "get-project-files"}
-                [:project-id ::sm/uuid]]
-   ::sm/result [:vector ::file]}
+   ::sm/params schema:get-project-files
+   ::sm/result schema:files}
   [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id project-id]}]
   (dm/with-open [conn (db/open pool)]
     (projects/check-read-permissions! conn profile-id project-id)
@@ -466,11 +475,14 @@
 
 (declare get-has-file-libraries)
 
+(def schema:has-file-libraries
+  [:map {:title "has-file-libraries"}
+   [:file-id ::sm/uuid]])
+
 (sv/defmethod ::has-file-libraries
   "Checks if the file has libraries. Returns a boolean"
   {::doc/added "1.15.1"
-   ::sm/params [:map {:title "has-file-libraries"}
-                [:file-id ::sm/uuid]]
+   ::sm/params schema:has-file-libraries
    ::sm/result :boolean}
   [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id]}]
   (dm/with-open [conn (db/open pool)]
@@ -526,13 +538,13 @@
       (uuid? object-id)
       (prune-objects object-id))))
 
-(sm/def! ::get-page
+(def schema:get-page
   [:map {:title "GetPage"}
    [:file-id ::sm/uuid]
    [:page-id {:optional true} ::sm/uuid]
    [:share-id {:optional true} ::sm/uuid]
    [:object-id {:optional true} ::sm/uuid]
-   [:features {:optional true} ::features]])
+   [:features {:optional true} schema:features]])
 
 (sv/defmethod ::get-page
   "Retrieves the page data from file and returns it. If no page-id is
@@ -545,7 +557,7 @@
 
   Mainly used for rendering purposes."
   {::doc/added "1.17"
-   ::sm/params ::get-page}
+   ::sm/params schema:get-page}
   [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id share-id] :as params}]
   (dm/with-open [conn (db/open pool)]
     (let [perms (get-permissions conn profile-id file-id share-id)]
@@ -737,6 +749,23 @@
     (teams/check-read-permissions! conn profile-id team-id)
     (get-team-recent-files conn team-id)))
 
+
+;; --- COMMAND QUERY: get-file-summary
+
+(sv/defmethod ::get-file-summary
+  "Retrieve a file summary by its ID. Only authenticated users."
+  {::doc/added "1.20"
+   ::sm/params schema:get-file}
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id features project-id] :as params}]
+  (db/with-atomic [conn pool]
+    (check-read-permissions! conn profile-id id)
+    (let [file (get-file conn id features project-id)]
+      {:name             (:name file)
+       :components-count (count (ctkl/components-seq (:data file)))
+       :graphics-count   (count (get-in file [:data :media] []))
+       :colors-count     (count (get-in file [:data :colors] []))
+       :typography-count (count (get-in file [:data :typographies] []))})))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; MUTATION COMMANDS
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -786,11 +815,11 @@
 
 ;; --- MUTATION COMMAND: set-file-shared
 
-(defn unlink-files
-  [conn {:keys [id] :as params}]
+(defn- unlink-files!
+  [conn {:keys [id]}]
   (db/delete! conn :file-library-rel {:library-file-id id}))
 
-(defn set-file-shared
+(defn- set-file-shared!
   [conn {:keys [id is-shared] :as params}]
   (db/update! conn :file
               {:is-shared is-shared}
@@ -801,49 +830,50 @@
      FROM file_library_rel AS flr
     INNER JOIN file AS f ON (f.id = flr.file_id)
     WHERE flr.library_file_id = ?
+      AND (f.deleted_at IS NULL OR f.deleted_at > now())
     ORDER BY f.created_at ASC;")
 
-(defn absorb-library
+(defn- absorb-library!
   "Find all files using a shared library, and absorb all library assets
   into the file local libraries"
-  [conn {:keys [id] :as params}]
-  (let [library (db/get-by-id conn :file id)]
-    (when (:is-shared library)
-      (let [ldata (binding [pmap/*load-fn* (partial load-pointer conn id)]
-                    (-> library decode-row load-all-pointers! pmg/migrate-file :data))
-            rows  (db/exec! conn [sql:get-referenced-files id])]
-        (doseq [file-id (map :id rows)]
-          (binding [pmap/*load-fn* (partial load-pointer conn file-id)
-                    pmap/*tracked* (atom {})]
-            (let [file (-> (db/get-by-id conn :file file-id
-                                         ::db/check-deleted? false
-                                         ::db/remove-deleted? false)
-                           (decode-row)
-                           (load-all-pointers!)
-                           (pmg/migrate-file))
-                  data (ctf/absorb-assets (:data file) ldata)]
-              (db/update! conn :file
-                          {:revn (inc (:revn file))
-                           :data (blob/encode data)
-                           :modified-at (dt/now)}
-                          {:id file-id})
-              (persist-pointers! conn file-id))))))))
+  [conn {:keys [id] :as library}]
+  (let [ldata (binding [pmap/*load-fn* (partial load-pointer conn id)]
+                (-> library decode-row (process-pointers deref) pmg/migrate-file :data))
+        rows  (db/exec! conn [sql:get-referenced-files id])]
+    (doseq [file-id (map :id rows)]
+      (binding [pmap/*load-fn* (partial load-pointer conn file-id)
+                pmap/*tracked* (atom {})]
+        (let [file (-> (db/get-by-id conn :file file-id
+                                     ::db/check-deleted? false
+                                     ::db/remove-deleted? false)
+                       (decode-row)
+                       (load-all-pointers!)
+                       (pmg/migrate-file))
+              data (ctf/absorb-assets (:data file) ldata)]
+          (db/update! conn :file
+                      {:revn (inc (:revn file))
+                       :data (blob/encode data)
+                       :modified-at (dt/now)}
+                      {:id file-id})
+          (persist-pointers! conn file-id))))))
 
-(s/def ::set-file-shared
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::id ::is-shared]))
+(def ^:private schema:set-file-shared
+  [:map {:title "set-file-shared"}
+   [:id ::sm/uuid]
+   [:is-shared :boolean]])
 
 (sv/defmethod ::set-file-shared
   {::doc/added "1.17"
-   ::webhooks/event? true}
+   ::webhooks/event? true
+   ::sm/params schema:set-file-shared}
   [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id is-shared] :as params}]
   (db/with-atomic [conn pool]
     (check-edition-permissions! conn profile-id id)
-    (when-not is-shared
-      (absorb-library conn params)
-      (unlink-files conn params))
+    (let [file (set-file-shared! conn params)]
+      (when-not is-shared
+        (absorb-library! conn file)
+        (unlink-files! conn file))
 
-    (let [file (set-file-shared conn params)]
       (rph/with-meta
         (select-keys file [:id :name :is-shared])
         {::audit/props {:name (:name file)
@@ -852,24 +882,26 @@
 
 ;; --- MUTATION COMMAND: delete-file
 
-(defn mark-file-deleted
-  [conn {:keys [id] :as params}]
+(defn- mark-file-deleted!
+  [conn {:keys [id]}]
   (db/update! conn :file
               {:deleted-at (dt/now)}
               {:id id}))
 
-(s/def ::delete-file
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::id]))
+(def ^:private schema:delete-file
+  [:map {:title "delete-file"}
+   [:id ::sm/uuid]])
 
 (sv/defmethod ::delete-file
   {::doc/added "1.17"
-   ::webhooks/event? true}
+   ::webhooks/event? true
+   ::sm/params schema:delete-file}
   [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id] :as params}]
   (db/with-atomic [conn pool]
     (check-edition-permissions! conn profile-id id)
-    (absorb-library conn params)
-    (let [file (mark-file-deleted conn params)]
+    (let [file (mark-file-deleted! conn params)]
+      (when (:is-shared file)
+        (absorb-library! conn file))
 
       (rph/with-meta (rph/wrap)
         {::audit/props {:project-id (:project-id file)

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

@@ -0,0 +1,135 @@
+;; 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.rpc.commands.files-snapshot
+  (:require
+   [app.common.exceptions :as ex]
+   [app.common.logging :as l]
+   [app.common.schema :as sm]
+   [app.common.uuid :as uuid]
+   [app.config :as cf]
+   [app.db :as db]
+   [app.main :as-alias main]
+   [app.media :as media]
+   [app.rpc :as-alias rpc]
+   [app.rpc.commands.profile :as profile]
+   [app.rpc.doc :as-alias doc]
+   [app.storage :as sto]
+   [app.util.services :as sv]
+   [app.util.time :as dt]))
+
+(defn check-authorized!
+  [{:keys [::db/pool]} profile-id]
+  (when-not (or (= "devenv" (cf/get :host))
+                (let [profile (ex/ignoring (profile/get-profile pool profile-id))
+                      admins  (or (cf/get :admins) #{})]
+                  (contains? admins (:email profile))))
+    (ex/raise :type :authentication
+              :code :authentication-required
+              :hint "only admins allowed")))
+
+(defn get-file-snapshots
+  [{:keys [::db/conn]} {:keys [file-id limit start-at]
+                        :or {limit Long/MAX_VALUE}}]
+  (let [query    (str "select id, label, revn, created_at "
+                      "  from file_change "
+                      " where file_id = ? "
+                      "   and created_at < ? "
+                      "   and data is not null "
+                      " order by created_at desc "
+                      " limit ?")
+        start-at (or start-at (dt/now))
+        limit    (min limit 20)]
+
+    (->> (db/exec! conn [query file-id start-at limit])
+         (mapv (fn [row]
+                 (update row :created-at dt/format-instant :rfc1123))))))
+
+(def ^:private schema:get-file-snapshots
+  [:map [:file-id ::sm/uuid]])
+
+(sv/defmethod ::get-file-snapshots
+  {::doc/added "1.20"
+   ::doc/skip true
+   ::sm/params schema:get-file-snapshots}
+  [cfg {:keys [::rpc/profile-id] :as params}]
+  (check-authorized! cfg profile-id)
+  (db/run! cfg #(get-file-snapshots % params)))
+
+(defn restore-file-snapshot!
+  [{:keys [::db/conn ::sto/storage] :as cfg} {:keys [file-id id]}]
+  (let [storage  (media/configure-assets-storage storage conn)
+        params   {:id id :file-id file-id}
+        options  {:columns [:id :data :revn]}
+        snapshot (db/get* conn :file-change params options)]
+
+    (when (and (some? snapshot)
+               (some? (:data snapshot)))
+
+      (l/debug :hint "snapshot found"
+               :snapshot-id (:id snapshot)
+               :file-id file-id)
+
+      (db/update! conn :file
+                    {:data (:data snapshot)}
+                    {:id file-id})
+
+      ;; clean object thumbnails
+      (let [sql (str "delete from file_object_thumbnail "
+                     " where file_id=? returning media_id")
+            res (db/exec! conn [sql file-id])]
+
+        (doseq [media-id (into #{} (keep :media-id) res)]
+          (sto/del-object! storage media-id)))
+
+      ;; clean object thumbnails
+      (let [sql (str "delete from file_thumbnail "
+                     " where file_id=? returning media_id")
+            res (db/exec! conn [sql file-id])]
+        (doseq [media-id (into #{} (keep :media-id) res)]
+          (sto/del-object! storage media-id)))
+
+      {:id (:id snapshot)})))
+
+(def ^:private schema:restore-file-snapshot
+  [:map
+   [:file-id ::sm/uuid]
+   [:id ::sm/uuid]])
+
+(sv/defmethod ::restore-file-snapshot
+  {::doc/added "1.20"
+   ::doc/skip true
+   ::sm/params schema:restore-file-snapshot}
+  [cfg {:keys [::rpc/profile-id] :as params}]
+  (check-authorized! cfg profile-id)
+  (db/tx-run! cfg #(restore-file-snapshot! % params)))
+
+(defn take-file-snapshot!
+  [{:keys [::db/conn]} {:keys [file-id label]}]
+  (when-let [file (db/get* conn :file {:id file-id})]
+    (let [id    (uuid/next)
+          label (or label (str "Snapshot at " (dt/format-instant (dt/now) :rfc1123)))]
+      (l/debug :hint "persisting file snapshot" :file-id file-id :label label)
+      (db/insert! conn :file-change
+                  {:id id
+                   :revn (:revn file)
+                   :data (:data file)
+                   :features (:features file)
+                   :file-id (:id file)
+                   :label label})
+      {:id id})))
+
+(def ^:private schema:take-file-snapshot
+  [:map [:file-id ::sm/uuid]])
+
+(sv/defmethod ::take-file-snapshot
+  {::doc/added "1.20"
+   ::doc/skip true
+   ::sm/params schema:take-file-snapshot}
+  [cfg {:keys [::rpc/profile-id] :as params}]
+  (check-authorized! cfg profile-id)
+  (db/tx-run! cfg #(take-file-snapshot! % params)))
+

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

@@ -144,8 +144,8 @@
                  (run! pmap/load!))
 
             ;; Then proceed to find the frame set for thumbnail
-
-            (d/seek :use-for-thumbnail?
+            (d/seek #(or (:use-for-thumbnail %)
+                         (:use-for-thumbnail? %)) ; NOTE: backward comp (remove on v1.21)
                     (for [page  (-> data :pages-index vals)
                           frame (-> page :objects ctt/get-frames)]
                       (assoc frame :page-id (:id page)))))
@@ -164,18 +164,18 @@
                    frames  (filter cph/frame-shape? (vals objects))]
 
               (if-let [frame  (-> frames first)]
-                (let [frame-id (:id frame)
+                (let [frame-id  (:id frame)
                       object-id (str page-id frame-id)
-                      frame (if-let [thumb (get thumbnails object-id)]
-                              (assoc frame :thumbnail thumb :shapes [])
-                              (dissoc frame :thumbnail))
+                      frame     (if-let [thumb (get thumbnails object-id)]
+                                  (assoc frame :thumbnail thumb :shapes [])
+                                  (dissoc frame :thumbnail))
 
                       children-ids
                       (cph/get-children-ids objects frame-id)
 
                       bounds
                       (when (:show-content frame)
-                        (gsh/selection-rect (concat [frame] (->> children-ids (map (d/getf objects))))))
+                        (gsh/shapes->rect (cons frame (map (d/getf objects) children-ids))))
 
                       frame
                       (cond-> frame
@@ -217,19 +217,24 @@
           :always
           (update :objects assoc-thumbnails page-id thumbs))))))
 
+(def ^:private schema:get-file-data-for-thumbnail
+  [:map {:title "get-file-data-for-thumbnail"}
+   [:file-id ::sm/uuid]
+   [:features {:optional true} files/schema:features]])
+
+(def ^:private schema:partial-file
+  [:map {:title "PartialFile"}
+   [:id ::sm/uuid]
+   [:revn {:min 0} :int]
+   [:page :any]])
+
 (sv/defmethod ::get-file-data-for-thumbnail
   "Retrieves the data for generate the thumbnail of the file. Used
   mainly for render thumbnails on dashboard."
-
   {::doc/added "1.17"
    ::doc/module :files
-   ::sm/params [:map {:title "get-file-data-for-thumbnail"}
-                [:file-id ::sm/uuid]
-                [:features {:optional true} ::files/features]]
-   ::sm/result [:map {:title "PartialFile"}
-                [:id ::sm/uuid]
-                [:revn {:min 0} :int]
-                [:page :any]]}
+   ::sm/params schema:get-file-data-for-thumbnail
+   ::sm/result schema:partial-file}
   [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id features] :as props}]
   (dm/with-open [conn (db/open pool)]
     (files/check-read-permissions! conn profile-id file-id)

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

@@ -8,13 +8,12 @@
   (:require
    [app.common.exceptions :as ex]
    [app.common.files.features :as ffeat]
+   [app.common.files.migrations :as pmg]
    [app.common.logging :as l]
    [app.common.pages :as cp]
    [app.common.pages.changes :as cpc]
-   [app.common.pages.migrations :as pmg]
    [app.common.schema :as sm]
    [app.common.schema.generators :as smg]
-   [app.common.spec :as us]
    [app.common.types.file :as ctf]
    [app.common.uuid :as uuid]
    [app.config :as cf]
@@ -32,37 +31,7 @@
    [app.util.objects-map :as omap]
    [app.util.pointer-map :as pmap]
    [app.util.services :as sv]
-   [app.util.time :as dt]
-   [clojure.spec.alpha :as s]))
-
-;; --- SPECS
-
-(s/def ::changes
-  (s/coll-of map? :kind vector?))
-
-(s/def ::hint-origin ::us/keyword)
-(s/def ::hint-events
-  (s/every ::us/keyword :kind vector?))
-
-(s/def ::change-with-metadata
-  (s/keys :req-un [::changes]
-          :opt-un [::hint-origin
-                   ::hint-events]))
-
-(s/def ::changes-with-metadata
-  (s/every ::change-with-metadata :kind vector?))
-
-(s/def ::session-id ::us/uuid)
-(s/def ::revn ::us/integer)
-(s/def ::update-file
-  (s/and
-   (s/keys :req [::rpc/profile-id]
-           :req-un [::files/id ::session-id ::revn]
-           :opt-un [::changes ::changes-with-metadata ::features])
-   (fn [o]
-     (or (contains? o :changes)
-         (contains? o :changes-with-metadata)))))
-
+   [app.util.time :as dt]))
 
 ;; --- SCHEMA
 
@@ -155,6 +124,7 @@
 (declare send-notifications!)
 (declare update-file)
 (declare update-file*)
+(declare update-file-data)
 (declare take-snapshot?)
 
 ;; If features are specified from params and the final feature
@@ -177,6 +147,7 @@
   (db/with-atomic [conn pool]
     (files/check-edition-permissions! conn profile-id id)
     (db/xact-lock! conn id)
+
     (let [cfg    (assoc cfg ::db/conn conn)
           params (assoc params :profile-id profile-id)
           tpoint (dt/tpoint)]
@@ -238,26 +209,6 @@
                         :project-id (:project-id file)
                         :team-id    (:team-id file)}))))))
 
-(defn- update-file-data
-  [file changes]
-  (-> file
-      (update :revn inc)
-      (update :data (fn [data]
-                      (cond-> data
-                        :always
-                        (-> (blob/decode)
-                            (assoc :id (:id file))
-                            (pmg/migrate-data))
-
-                        (and (contains? ffeat/*current* "components/v2")
-                             (not (contains? ffeat/*previous* "components/v2")))
-                        (ctf/migrate-to-components-v2)
-
-                        :always
-                        (-> (cp/process-changes changes)
-                            (blob/encode)))))))
-
-
 (defn- update-file*
   [{:keys [::db/conn] :as cfg} {:keys [profile-id file changes session-id ::created-at] :as params}]
   (let [;; Process the file data in the CLIMIT context; scheduling it
@@ -297,6 +248,25 @@
       ;; Retrieve and return lagged data
       (get-lagged-changes conn params))))
 
+(defn- update-file-data
+  [file changes]
+  (-> file
+      (update :revn inc)
+      (update :data (fn [data]
+                      (cond-> data
+                        :always
+                        (-> (blob/decode)
+                            (assoc :id (:id file))
+                            (pmg/migrate-data))
+
+                        (and (contains? ffeat/*current* "components/v2")
+                             (not (contains? ffeat/*previous* "components/v2")))
+                        (ctf/migrate-to-components-v2)
+
+                        :always
+                        (-> (cp/process-changes changes)
+                            (blob/encode)))))))
+
 (defn- take-snapshot?
   "Defines the rule when file `data` snapshot should be saved."
   [{:keys [revn modified-at] :as file}]

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

@@ -9,7 +9,7 @@
   (:require
    [app.common.data :as d]
    [app.common.exceptions :as ex]
-   [app.common.pages.migrations :as pmg]
+   [app.common.files.migrations :as pmg]
    [app.common.schema :as sm]
    [app.common.spec :as us]
    [app.common.uuid :as uuid]

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

@@ -83,7 +83,7 @@
   [:map {:title "get-view-only-bundle"}
    [:file-id ::sm/uuid]
    [:share-id {:optional true} ::sm/uuid]
-   [:features {:optional true} ::files/features]])
+   [:features {:optional true} files/schema:features]])
 
 (sv/defmethod ::get-view-only-bundle
   {::rpc/auth false

backend/src/app/srepl/fixes.clj

@@ -7,9 +7,35 @@
 (ns app.srepl.fixes
   "A collection of adhoc fixes scripts."
   (:require
+   [app.common.data :as d]
+   [app.common.files.validate :as cfv]
+   [app.common.geom.shapes :as gsh]
    [app.common.logging :as l]
+   [app.common.pages.helpers :as cph]
+   [app.common.pprint :refer [pprint]]
+   [app.common.types.component :as ctk]
+   [app.common.types.container :as ctn]
+   [app.common.types.file :as ctf]
    [app.common.uuid :as uuid]
-   [app.srepl.helpers :as h]))
+   [app.db :as db]
+   [app.rpc.commands.files :as files]
+   [app.srepl.helpers :as h]
+   [app.util.blob :as blob]))
+
+(defn validate-file
+  [file]
+  (let [libs (->> (files/get-file-libraries app.srepl.helpers/*conn* (:id file))
+                  (cons file)
+                  (map #(files/get-file app.srepl.helpers/*conn* (:id %) (:features file)))
+                  (d/index-by :id))
+
+        update-page (fn [page]
+                      (let [errors (cfv/validate-shape uuid/zero file page libs)]
+                        (when (seq errors)
+                          (println "******Errors in file " (:id file) " page " (:id page))
+                          (pprint errors {:level 3}))))]
+
+    (update file :data h/update-pages update-page)))
 
 (defn repair-orphaned-shapes
   "There are some shapes whose parent has been deleted. This function
@@ -72,4 +98,303 @@
 
    ([file state]
     (rename-layout-attrs file)
-    (update state :total (fnil inc 0))))
+    (update state :total (fnil inc 0))))
+
+(defn fix-components-shaperefs
+  ([file]
+   (if-not (contains? (:features file) "components/v2")
+     (do
+       (println "   This file is not v2")
+       file)
+     (let [libs (->> (files/get-file-libraries app.srepl.helpers/*conn* (:id file))
+                     (cons file)
+                     (map #(files/get-file app.srepl.helpers/*conn* (:id %) (:features file)))
+                     (d/index-by :id))
+
+           fix-copy-item
+           (fn fix-copy-item [allow-head shapes-copy shapes-base copy-id base-id]
+             (let [copy (first (filter #(= (:id %) copy-id) shapes-copy))
+                  ;; do nothing if it is a copy inside of a copy. It will be treated later
+                   stop? (and (not allow-head) (ctk/instance-head? copy))
+                   base (first (filter #(= (:id %) base-id) shapes-base))
+                   fci (partial fix-copy-item false shapes-copy shapes-base)
+
+                   updates (if (and
+                                (not stop?)
+                                (not= (:shape-ref copy) base-id))
+                             [[(:id copy) base-id]]
+                             [])
+
+                   child-updates (if (and
+                                      (not stop?)
+                                      ;; If the base has the same number of childrens than the copy, we asume
+                                      ;; that the shaperefs can be fixed ad pointed in the same order
+                                      (= (count (:shapes copy)) (count (:shapes base))))
+                                   (apply concat (map fci (:shapes copy) (:shapes base)))
+                                   [])]
+               (concat updates child-updates)))
+
+           fix-copy
+           (fn [objects updates copy]
+             (let [component        (ctf/find-component libs (:component-id copy) {:include-deleted? true})
+                   component-file   (get libs (:component-file copy))
+                   component-shapes (ctf/get-component-shapes (:data component-file) component)
+                   copy-shapes      (cph/get-children-with-self objects (:id copy))
+
+                   copy-updates (fix-copy-item true copy-shapes component-shapes (:id copy) (:main-instance-id component))]
+               (concat updates copy-updates)))
+
+           update-page
+           (fn [page]
+             (let [objects      (:objects page)
+                   fc           (partial fix-copy objects)
+                   copies       (->> objects
+                                     vals
+                                     (filter #(and (ctk/instance-head? %) (not (ctk/main-instance? %)))))
+                   updates      (reduce fc [] copies)
+                   updated-page (reduce (fn [p [id shape-ref]]
+                                          (assoc-in p [:objects id :shape-ref] shape-ref))
+                                        page
+                                        updates)]
+               (println "Page " (:name page) " - Fixing " (count updates))
+               updated-page))]
+
+       (println "Updating " (:name file) (:id file))
+       (-> file
+           (update :data h/update-pages update-page)
+           (assoc ::updated true)))))
+
+  ([file save?]
+   (let [file (-> file
+                  (update :data blob/decode)
+                  (fix-components-shaperefs))]
+     (when (and save? (::updated file))
+       (let [data     (blob/encode (:data file))]
+         (db/update! h/*conn* :file
+                     {:data data
+                      ;; :revn (:revn file)
+                      }
+                     {:id (:id file)})
+
+         (files/persist-pointers! h/*conn* (:id file)))))))
+
+(defn fix-component-root
+  ([file]
+   (let [update-shape (fn [page shape]
+                        (let [parent (get (:objects page) (:parent-id shape))]
+                          (if (and parent
+                                   (:component-root shape)
+                                   (:shape-ref parent))
+                            (do
+                              (println "   Shape " (:name shape) (:id shape))
+                              (dissoc shape :component-root))
+                            shape)))
+
+         update-page (fn [page]
+                       (println "Page " (:name page))
+                       (h/update-shapes page (partial update-shape page)))]
+
+     (println "Updating " (:name file) (:id file))
+     (update file :data h/update-pages update-page)))
+
+  ([file save?]
+   (let [file (-> file
+                  (update :data blob/decode)
+                  (fix-component-root))]
+     (when save?
+       (let [data     (blob/encode (:data file))]
+         (db/update! h/*conn* :file
+                     {:data data
+                      ;; :revn (:revn file)
+                      }
+                     {:id (:id file)})
+
+         (files/persist-pointers! h/*conn* (:id file)))))))
+
+(defn update-near-components
+  ([file]
+   (println "Updating " (:name file) (:id file))
+   (if-not (contains? (:features file) "components/v2")
+     (do
+       (println "   This file is not v2")
+       file)
+     (let [libs (->> (files/get-file-libraries h/*conn* (:id file))
+                     (cons file)
+                     (map #(files/get-file h/*conn* (:id %) (:features file)))
+                     (d/index-by :id))
+
+           update-shape
+           (fn [page shape]
+             (if-not (:shape-ref shape)
+               shape
+               (do
+                 ;; Uncomment println's to debug
+                 ;; (println "  -> Shape " (:name shape) (:id shape) " shape-ref " (:shape-ref shape))
+                 (let [root-shape (ctn/get-copy-root (:objects page) shape)]
+                   (if root-shape
+                     (let [component (ctf/get-component libs (:component-file root-shape) (:component-id root-shape) {:include-deleted? true})
+                           component-file (get libs (:component-file root-shape))
+                           component-shapes (ctf/get-component-shapes (:data component-file) component)
+                           ref-shape (d/seek #(= (:id %) (:shape-ref shape)) component-shapes)]
+                       (if-not (and component component-file component-shapes)
+                         (do
+                           ;; (println "  -> Shape " (:name shape) (:id shape) " shape-ref " (:shape-ref shape))
+                           ;; (when-not component (println "     (component not found)"))
+                           ;; (when-not component-file (println "     (component-file not found)"))
+                           ;; (when-not component-shapes (println "     (component-shapes not found)"))
+                           shape)
+                         (if ref-shape
+                           shape  ; This means that the copy is not nested, or this script already was run
+                           (let [near-shape (d/seek #(= (:shape-ref %) (:shape-ref shape)) component-shapes)]
+                             (if near-shape
+                               (do
+                                 (println "  -> Shape " (:name shape) (:id shape) " shape-ref " (:shape-ref shape))
+                                 (println "     new ref-shape " (:id near-shape))
+                                 (assoc shape :shape-ref (:id near-shape)))
+                               (do
+                                 ;; We assume in this case that this is a fostered sub instance, so we do nothing
+                                 ;; (println "  -> Shape " (:name shape) (:id shape) " shape-ref " (:shape-ref shape))
+                                 ;; (println  (near-shape not found)")
+                                 shape))))))
+                     (do
+                       ;; (println "  -> Shape " (:name shape) (:id shape) " shape-ref " (:shape-ref shape))
+                       ;; (println "     (root shape not found)")
+                       shape))))))
+
+           update-page
+           (fn [page]
+             (println "Page " (:name page))
+             (h/update-shapes page (partial update-shape page)))]
+
+       (-> file
+           (update :data h/update-pages update-page)
+           (assoc ::updated true)))))
+
+  ([file save?]
+   (let [file (-> file
+                  (update :data blob/decode)
+                  (update-near-components))]
+     (when (and save? (::updated file))
+       (let [data     (blob/encode (:data file))]
+         (db/update! h/*conn* :file
+                     {:data data
+                      ;; :revn (:revn file)
+                      }
+                     {:id (:id file)})
+
+         (files/persist-pointers! h/*conn* (:id file)))))))
+
+(defn fix-main-shape-name
+  ([file]
+   (println "Updating " (:name file) (:id file))
+   (if-not (contains? (:features file) "components/v2")
+     (do
+       (println "   This file is not v2")
+       file)
+     (let [libs (->> (files/get-file-libraries h/*conn* (:id file))
+                     (cons file)
+                     (map #(files/get-file h/*conn* (:id %) (:features file)))
+                     (d/index-by :id))
+
+           update-shape
+           (fn [shape]
+             (if-not (ctk/instance-head? shape)
+               shape
+               (let [component (ctf/get-component libs (:component-file shape) (:component-id shape) {:include-deleted? true})
+                     [_path name] (cph/parse-path-name (:name shape))
+                     full-name (cph/clean-path (str (:path component) "/" (:name component)))]
+                 (if (= name (:name component))
+                   (assoc shape :name full-name)
+                   shape))))
+
+
+           update-page
+           (fn [page]
+             (println "Page " (:name page))
+             (h/update-shapes page update-shape))]
+
+       (-> file
+           (update :data h/update-pages update-page)
+           (assoc ::updated true)))))
+
+  ([file save?]
+   (let [file (-> file
+                  (update :data blob/decode)
+                  (fix-main-shape-name))]
+     (when (and save? (::updated file))
+       (let [data     (blob/encode (:data file))]
+         (db/update! h/*conn* :file
+                     {:data data
+                      ;; :revn (:revn file)
+                      }
+                     {:id (:id file)})
+
+         (files/persist-pointers! h/*conn* (:id file)))))))
+
+(defn fix-touched
+  "For all copies, compare all synced attributes with the main, and set the touched attribute if needed."
+  ([file]
+   (let [libraries (->> (files/get-file-libraries app.srepl.helpers/*conn* (:id file))
+                        (map #(files/get-file app.srepl.helpers/*conn* (:id %) (:features file)))
+                        (d/index-by :id))
+
+         update-shape (fn [page shape]
+                        (if (ctk/in-component-copy? shape)
+                          (let [ref-shape (ctf/find-ref-shape file
+                                                              (:objects page)
+                                                              libraries
+                                                              shape
+                                                              :include-deleted? true)
+                                fix-touched-attr
+                                (fn [shape [attr group]]
+                                  (if (nil? ref-shape)
+                                    shape
+                                    (let [equal?
+                                          (if (= group :geometry-group)
+                                            (if (#{:width :height} attr)
+                                              (gsh/close-attrs? attr (get shape attr) (get ref-shape attr) 1)
+                                              true)
+                                            (gsh/close-attrs? attr (get shape attr) (get ref-shape attr)))]
+                                      (when (and (not equal?) (not (cph/touched-group? shape group)))
+                                        (println " -> set touched " (:name shape) (:id shape) attr group))
+                                      (cond-> shape
+                                        (and (not equal?) (not (cph/touched-group? shape group)))
+                                        (update :touched cph/set-touched-group group)))))
+                                
+                                fix-touched-children
+                                (fn [shape]
+                                  (let [matches? (fn [[child-id ref-child-id]]
+                                                   (let [child (ctn/get-shape page child-id)]
+                                                     (= (:shape-ref child) ref-child-id)))
+                                        equal? (every? matches? (d/zip (:shapes shape) (:shapes ref-shape)))]
+                                      (when (and (not equal?) (not (cph/touched-group? shape :shapes)))
+                                        (println " -> set touched " (:name shape) (:id shape) :shapes :shapes-group))
+                                      (cond-> shape
+                                        (and (not equal?) (not (cph/touched-group? shape :shapes-group)))
+                                        (update :touched cph/set-touched-group :shapes-group))))]
+
+                            (as-> shape $
+                              (reduce fix-touched-attr $ ctk/sync-attrs)
+                              (fix-touched-children $)))
+
+                          shape))
+
+         update-page (fn [page]
+                       (println "Page " (:name page))
+                       (h/update-shapes page (partial update-shape page)))]
+
+     (println "Updating " (:name file) (:id file))
+     (update file :data h/update-pages update-page)))
+
+  ([file save?]
+   (let [file (-> file
+                  (update :data blob/decode)
+                  (fix-touched))]
+     (when save?
+       (let [data     (blob/encode (:data file))]
+         (db/update! h/*conn* :file
+                     {:data data
+                      :revn (inc (:revn file))}
+                     {:id (:id file)})
+
+         (files/persist-pointers! h/*conn* (:id file)))))))

backend/src/app/srepl/helpers.clj

@@ -6,15 +6,16 @@
 
 (ns app.srepl.helpers
   "A  main namespace for server repl."
+  (:refer-clojure :exclude [parse-uuid])
   #_:clj-kondo/ignore
   (:require
    [app.auth :refer [derive-password]]
    [app.common.data :as d]
    [app.common.exceptions :as ex]
    [app.common.files.features :as ffeat]
+   [app.common.files.migrations :as pmg]
    [app.common.logging :as l]
    [app.common.pages :as cp]
-   [app.common.pages.migrations :as pmg]
    [app.common.pprint :refer [pprint]]
    [app.common.spec :as us]
    [app.common.uuid :as uuid]
@@ -31,9 +32,32 @@
    [clojure.stacktrace :as strace]
    [clojure.walk :as walk]
    [cuerdas.core :as str]
-   [expound.alpha :as expound]))
+   [expound.alpha :as expound]
+   [promesa.core :as p]
+   [promesa.exec :as px]
+   [promesa.exec.csp :as sp]))
 
-(def ^:dynamic *conn*)
+(def ^:dynamic *conn* nil)
+
+(defn println!
+  [& params]
+  (locking println
+    (apply println params)))
+
+(defn parse-uuid
+  [v]
+  (if (uuid? v)
+    v
+    (d/parse-uuid v)))
+
+(defn resolve-connectable
+  [o]
+  (if (db/connection? o)
+    o
+    (if (db/pool? o)
+      o
+      (or (::db/conn o)
+          (::db/pool o)))))
 
 (defn reset-password!
   "Reset a password to a specific one for a concrete user or all users
@@ -100,7 +124,7 @@
           (dissoc file :data))))))
 
 (def ^:private sql:retrieve-files-chunk
-  "SELECT id, name, created_at, data FROM file
+  "SELECT id, name, features, created_at, revn, data FROM file
     WHERE created_at < ? AND deleted_at is NULL
     ORDER BY created_at desc LIMIT ?")
 
@@ -110,7 +134,7 @@
 
   The `on-file` parameter should be a function that receives the file
   and the previous state and returns the new state."
-  [system & {:keys [chunk-size max-items start-at on-file on-error on-end]
+  [system & {:keys [chunk-size max-items start-at on-file on-error on-end on-init]
              :or {chunk-size 10 max-items Long/MAX_VALUE}}]
   (letfn [(get-chunk [conn cursor]
             (let [rows (db/exec! conn [sql:retrieve-files-chunk cursor chunk-size])]
@@ -122,26 +146,111 @@
                               :kf first
                               :initk (or start-at (dt/now)))
                  (take max-items)
-                 (map #(update % :data blob/decode))))
+                 (map #(-> %
+                           (update :data blob/decode)
+                           (update :features db/decode-pgarray #{})))))
 
-          (on-error* [file cause]
+          (on-error* [cause file]
             (println "unexpected exception happened on processing file: " (:id file))
             (strace/print-stack-trace cause))]
 
-    (db/with-atomic [conn (:app.db/pool system)]
-      (loop [state {}
-             files (get-candidates conn)]
-        (if-let [file (first files)]
-          (let [state' (try
-                         (on-file file state)
-                         (catch Throwable cause
-                           (let [on-error (or on-error on-error*)]
-                             (on-error file cause))))]
-            (recur (or state' state) (rest files)))
+    (when (fn? on-init) (on-init))
 
-          (if (fn? on-end)
-            (on-end state)
-            state))))))
+    (db/with-atomic [conn (:app.db/pool system)]
+      (doseq [file (get-candidates conn)]
+        (binding [*conn* conn
+                  pmap/*tracked* (atom {})
+                  pmap/*load-fn* (partial files/load-pointer conn (:id file))
+                  ffeat/*wrap-with-pointer-map-fn*
+                  (if (contains? (:features file) "storage/pointer-map") pmap/wrap identity)
+                  ffeat/*wrap-with-objects-map-fn*
+                  (if (contains? (:features file) "storage/objects-map") omap/wrap identity)]
+          (try
+            (on-file file)
+            (catch Throwable cause
+              ((or on-error on-error*) cause file))))))
+
+    (when (fn? on-end) (on-end))))
+
+(defn process-files!
+  "Apply a function to all files in the database, reading them in
+  batches."
+
+  [{:keys [::db/pool] :as system} & {:keys [chunk-size
+                                            max-items
+                                            workers
+                                            start-at
+                                            on-file
+                                            on-error
+                                            on-end
+                                            on-init]
+                                     :or {chunk-size 10
+                                          max-items Long/MAX_VALUE
+                                          workers 1}}]
+
+  (letfn [(get-chunk [conn cursor]
+            (let [rows (db/exec! conn [sql:retrieve-files-chunk cursor chunk-size])]
+              [(some->> rows peek :created-at)
+               (map #(update % :features db/decode-pgarray #{}) rows)]))
+
+          (get-candidates [conn]
+            (->> (d/iteration (partial get-chunk conn)
+                              :vf second
+                              :kf first
+                              :initk (or start-at (dt/now)))
+                 (take max-items)))
+
+          (on-error* [cause file]
+            (println! "unexpected exception happened on processing file: " (:id file))
+            (strace/print-stack-trace cause))
+
+          (process-file [conn file]
+            (try
+              (binding [*conn* conn
+                        pmap/*tracked* (atom {})
+                        pmap/*load-fn* (partial files/load-pointer conn (:id file))
+                        ffeat/*wrap-with-pointer-map-fn*
+                        (if (contains? (:features file) "storage/pointer-map") pmap/wrap identity)
+                        ffeat/*wrap-with-objects-map-fn*
+                        (if (contains? (:features file) "storage/objectd-map") omap/wrap identity)]
+                (on-file file))
+              (catch Throwable cause
+                ((or on-error on-error*) cause file))))
+
+          (run-worker [in index]
+            (db/with-atomic [conn pool]
+              (loop [i 0]
+                (when-let [file (sp/take! in)]
+                  (println! "=> worker: index:" index "| loop:" i "| file:" (:id file) "|" (px/get-name))
+                  (process-file conn file)
+                  (recur (inc i))))))
+
+          (run-producer [input]
+            (db/with-atomic [conn pool]
+              (doseq [file (get-candidates conn)]
+                (println! "=> producer:" (:id file) "|" (px/get-name))
+                (sp/put! input file))
+              (sp/close! input)))
+
+          (start-worker [input index]
+            (px/thread
+              {:name (str "penpot/srepl/worker/" index)}
+              (run-worker input index)))
+          ]
+
+    (when (fn? on-init) (on-init))
+
+    (let [input    (sp/chan :buf chunk-size)
+          producer (px/thread
+                     {:name "penpot/srepl/producer"}
+                     (run-producer input))
+          threads  (->> (range workers)
+                        (map (partial start-worker input))
+                        (cons producer)
+                        (doall))]
+
+      (run! p/await! threads)
+      (when (fn? on-end) (on-end)))))
 
 (defn update-pages
   "Apply a function to all pages of one file. The function receives a page and returns an updated page."

backend/src/app/srepl/main.clj

@@ -19,14 +19,16 @@
    [app.msgbus :as mbus]
    [app.rpc.commands.auth :as auth]
    [app.rpc.commands.profile :as profile]
+   [app.rpc.commands.files-snapshot :as fsnap]
    [app.srepl.fixes :as f]
    [app.srepl.helpers :as h]
+   [app.storage :as sto]
    [app.util.blob :as blob]
    [app.util.objects-map :as omap]
    [app.util.pointer-map :as pmap]
    [app.util.time :as dt]
    [app.worker :as wrk]
-   [clojure.pprint :refer [pprint]]
+   [clojure.pprint :refer [pprint print-table]]
    [cuerdas.core :as str]))
 
 (defn print-available-tasks
@@ -106,7 +108,6 @@
         (db/delete! conn :http-session {:profile-id (:id profile)})
         :blocked))))
 
-
 (defn enable-objects-map-feature-on-file!
   [system & {:keys [save? id]}]
   (letfn [(update-file [{:keys [features] :as file}]
@@ -169,6 +170,35 @@
   (alter-var-root var (fn [f]
                         (or (::original (meta f)) f))))
 
+(defn take-file-snapshot!
+  "An internal helper that persist the file snapshot using non-gc
+  collectable file-changes entry."
+  [system & {:keys [file-id label]}]
+  (let [file-id (h/parse-uuid file-id)]
+    (db/tx-run! system
+                (fn [cfg]
+                  (fsnap/take-file-snapshot! cfg {:file-id file-id :label label})))))
+
+(defn restore-file-snapshot!
+  [system & {:keys [file-id id]}]
+  (db/tx-run! system
+              (fn [cfg]
+                (let [file-id (h/parse-uuid file-id)
+                      id      (h/parse-uuid id)]
+
+                  (if (and (uuid? id) (uuid? file-id))
+                    (fsnap/restore-file-snapshot! cfg {:id id :file-id file-id})
+                    (println "=> invalid parameters"))))))
+
+
+(defn list-file-snapshots!
+  [system & {:keys [file-id limit]}]
+  (db/tx-run! system (fn [system]
+                       (let [params {:file-id (h/parse-uuid file-id)
+                                     :limit limit}]
+                         (->> (fsnap/get-file-snapshots system (d/without-nils params))
+                              (print-table [:id :revn :created-at :label]))))))
+
 (defn notify!
   [{:keys [::mbus/msgbus ::db/pool]} & {:keys [dest code message level]
                                         :or {code :generic level :info}

backend/src/app/storage.clj

@@ -251,53 +251,59 @@
 
 (defmethod ig/init-key ::gc-deleted-task
   [_ {:keys [::db/pool ::storage ::min-age]}]
-  (letfn [(retrieve-deleted-objects-chunk [conn min-age cursor]
-            (let [min-age (db/interval min-age)
-                  rows    (db/exec! conn [sql:retrieve-deleted-objects-chunk min-age cursor])]
-              [(some-> rows peek :created-at)
+  (letfn [(get-to-delete-chunk [cursor]
+            (let [sql  (str "select s.* "
+                            "  from storage_object as s "
+                            " where s.deleted_at is not null "
+                            "   and s.deleted_at < ? "
+                            " order by s.deleted_at desc "
+                            " limit 25")
+                  rows (db/exec! pool [sql cursor])]
+              [(some-> rows peek :deleted-at)
                (some->> (seq rows) (d/group-by #(-> % :backend keyword) :id #{}) seq)]))
 
-          (retrieve-deleted-objects [conn min-age]
-            (d/iteration (partial retrieve-deleted-objects-chunk conn min-age)
-                         :initk (dt/now)
+          (get-to-delete-chunks [min-age]
+            (d/iteration get-to-delete-chunk
+                         :initk (dt/minus (dt/now) min-age)
                          :vf second
                          :kf first))
 
-          (delete-in-bulk [backend-id ids]
-            (let [backend (impl/resolve-backend storage backend-id)]
+          (delete-in-bulk! [backend-id ids]
+            (try
+              (db/with-atomic [conn pool]
+                (let [sql   "delete from storage_object where id = ANY(?)"
+                      ids'  (db/create-array conn "uuid" ids)
 
-              (doseq [id ids]
-                (l/debug :hint "gc-deleted: permanently delete storage object" :backend backend-id :id id))
+                      total (-> (db/exec-one! conn [sql ids'])
+                                (db/get-update-count))]
 
-              (impl/del-objects-in-bulk backend ids)))]
+                  (-> (impl/resolve-backend storage backend-id)
+                      (impl/del-objects-in-bulk ids))
+
+                  (doseq [id ids]
+                    (l/dbg :hint "gc-deleted: permanently delete storage object" :backend backend-id :id id))
+
+                  total))
+
+              (catch Throwable cause
+                (l/err :hint "gc-deleted: unexpected error on bulk deletion"
+                       :ids (vec ids)
+                       :cause cause)
+                0)))]
 
     (fn [params]
-      (let [min-age (or (:min-age params) min-age)]
-        (db/with-atomic [conn pool]
-          (loop [total  0
-                 groups (retrieve-deleted-objects conn min-age)]
-            (if-let [[backend-id ids] (first groups)]
-              (do
-                (delete-in-bulk backend-id ids)
-                (recur (+ total (count ids))
-                       (rest groups)))
-              (do
-                (l/info :hint "gc-deleted: task finished" :min-age (dt/format-duration min-age) :total total)
-                {:deleted total}))))))))
-
-(def sql:retrieve-deleted-objects-chunk
-  "with items_part as (
-     select s.id
-       from storage_object as s
-      where s.deleted_at is not null
-        and s.deleted_at < (now() - ?::interval)
-        and s.created_at < ?
-      order by s.created_at desc
-      limit 25
-   )
-   delete from storage_object
-    where id in (select id from items_part)
-   returning *;")
+      (let [min-age (or (some-> params :min-age dt/duration) min-age)]
+        (loop [total  0
+               chunks (get-to-delete-chunks min-age)]
+          (if-let [[backend-id ids] (first chunks)]
+            (let [deleted (delete-in-bulk! backend-id ids)]
+              (recur (+ total deleted)
+                     (rest chunks)))
+            (do
+              (l/inf :hint "gc-deleted: task finished"
+                     :min-age (dt/format-duration min-age)
+                     :total total)
+              {:deleted total})))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Garbage Collection: Analyze touched objects

backend/src/app/tasks/file_gc.clj

@@ -11,8 +11,8 @@
   inactivity (the default threshold is 72h)."
   (:require
    [app.common.data :as d]
+   [app.common.files.migrations :as pmg]
    [app.common.logging :as l]
-   [app.common.pages.migrations :as pmg]
    [app.common.types.components-list :as ctkl]
    [app.common.types.file :as ctf]
    [app.common.types.shape-tree :as ctt]

backend/src/app/tasks/file_xlog_gc.clj

@@ -17,7 +17,8 @@
 (def ^:private
   sql:delete-files-xlog
   "delete from file_change
-    where created_at < now() - ?::interval")
+    where created_at < now() - ?::interval
+      and label is NULL")
 
 (defmethod ig/pre-init-spec ::handler [_]
   (s/keys :req [::db/pool]))

backend/src/app/util/async.clj

@@ -1,113 +0,0 @@
-;; This Source Code Form is subject to the terms of the Mozilla Public
-;; License, v. 2.0. If a copy of the MPL was not distributed with this
-;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
-;;
-;; Copyright (c) KALEIDOS INC
-
-(ns app.util.async
-  (:require
-   [app.common.exceptions :as ex]
-   [clojure.core.async :as a]
-   [clojure.core.async.impl.protocols :as ap]
-   [clojure.spec.alpha :as s])
-  (:import
-   java.util.concurrent.Executor
-   java.util.concurrent.RejectedExecutionException))
-
-(s/def ::executor #(instance? Executor %))
-(s/def ::channel #(satisfies? ap/Channel %))
-
-(defonce processors
-  (delay (.availableProcessors (Runtime/getRuntime))))
-
-(defmacro go-try
-  [& body]
-  `(a/go
-     (try
-       ~@body
-       (catch Exception e# e#))))
-
-(defmacro thread
-  [& body]
-  `(a/thread
-     (try
-       ~@body
-       (catch Exception e#
-         e#))))
-
-(defmacro <?
-  [ch]
-  `(let [r# (a/<! ~ch)]
-     (if (instance? Exception r#)
-       (throw r#)
-       r#)))
-
-(defmacro with-closing
-  [ch & body]
-  `(try
-     ~@body
-     (finally
-       (some-> ~ch a/close!))))
-
-(defn thread-call
-  [^Executor executor f]
-  (let [ch (a/chan 1)
-        f' (fn []
-             (try
-               (let [ret (ex/try* f identity)]
-                 (when (some? ret) (a/>!! ch ret)))
-               (finally
-                 (a/close! ch))))]
-    (try
-      (.execute executor f')
-      (catch RejectedExecutionException _cause
-        (a/close! ch)))
-
-    ch))
-
-(defmacro with-thread
-  [executor & body]
-  (if (= executor ::default)
-    `(a/thread-call (^:once fn* [] (try ~@body (catch Exception e# e#))))
-    `(thread-call ~executor (^:once fn* [] ~@body))))
-
-(defn batch
-  [in {:keys [max-batch-size
-              max-batch-age
-              buffer-size
-              init]
-       :or {max-batch-size 200
-            max-batch-age (* 30 1000)
-            buffer-size 128
-            init #{}}
-       :as opts}]
-  (let [out (a/chan buffer-size)]
-    (a/go-loop [tch (a/timeout max-batch-age) buf init]
-      (let [[val port] (a/alts! [tch in])]
-        (cond
-          (identical? port tch)
-          (if (empty? buf)
-            (recur (a/timeout max-batch-age) buf)
-            (do
-              (a/>! out [:timeout buf])
-              (recur (a/timeout max-batch-age) init)))
-
-          (nil? val)
-          (if (empty? buf)
-            (a/close! out)
-            (do
-              (a/offer! out [:timeout buf])
-              (a/close! out)))
-
-          (identical? port in)
-          (let [buf (conj buf val)]
-            (if (>= (count buf) max-batch-size)
-              (do
-                (a/>! out [:size buf])
-                (recur (a/timeout max-batch-age) init))
-              (recur tch buf))))))
-    out))
-
-(defn thread-sleep
-  [ms]
-  (Thread/sleep (long ms)))

backend/src/app/worker.clj

@@ -87,10 +87,10 @@
 
 (defmethod ig/init-key ::registry
   [_ {:keys [::mtx/metrics ::tasks]}]
-  (l/info :hint "registry initialized" :tasks (count tasks))
+  (l/inf :hint "registry initialized" :tasks (count tasks))
   (reduce-kv (fn [registry k v]
                (let [tname (name k)]
-                 (l/trace :hint "register task" :name tname)
+                 (l/trc :hint "register task" :name tname)
                  (assoc registry tname (wrap-task-handler metrics tname v))))
              {}
              tasks))
@@ -141,18 +141,18 @@
 
     (px/thread
       {:name "penpot/executors-monitor" :virtual true}
-      (l/info :hint "monitor: started" :name name)
+      (l/inf :hint "monitor: started" :name name)
       (try
         (loop [steals 0]
           (when-not (px/shutdown? executor)
             (px/sleep interval)
             (recur (long (monitor! executor steals)))))
         (catch InterruptedException _cause
-          (l/debug :hint "monitor: interrupted" :name name))
+          (l/trc :hint "monitor: interrupted" :name name))
         (catch Throwable cause
-          (l/error :hint "monitor: unexpected error" :name name :cause cause))
+          (l/err :hint "monitor: unexpected error" :name name :cause cause))
         (finally
-          (l/info :hint "monitor: terminated" :name name))))))
+          (l/inf :hint "monitor: terminated" :name name))))))
 
 (defmethod ig/halt-key! ::monitor
   [_ thread]
@@ -207,10 +207,10 @@
                        (db/create-array conn "uuid" ids)]]
 
               (db/exec-one! conn sql)
-              (l/debug :hist "dispatcher: queue tasks"
-                       :queue queue
-                       :tasks (count ids)
-                       :queued res)))
+              (l/trc :hist "dispatcher: queue tasks"
+                     :queue queue
+                     :tasks (count ids)
+                     :queued res)))
 
           (run-batch! [rconn]
             (try
@@ -225,35 +225,35 @@
                 (cond
                   (rds/exception? cause)
                   (do
-                    (l/warn :hint "dispatcher: redis exception (will retry in an instant)" :cause cause)
+                    (l/wrn :hint "dispatcher: redis exception (will retry in an instant)" :cause cause)
                     (px/sleep (::rds/timeout rconn)))
 
                   (db/sql-exception? cause)
                   (do
-                    (l/warn :hint "dispatcher: database exception (will retry in an instant)" :cause cause)
+                    (l/wrn :hint "dispatcher: database exception (will retry in an instant)" :cause cause)
                     (px/sleep (::rds/timeout rconn)))
 
                   :else
                   (do
-                    (l/error :hint "dispatcher: unhandled exception (will retry in an instant)" :cause cause)
+                    (l/err :hint "dispatcher: unhandled exception (will retry in an instant)" :cause cause)
                     (px/sleep (::rds/timeout rconn)))))))
 
           (dispatcher []
-            (l/info :hint "dispatcher: started")
+            (l/inf :hint "dispatcher: started")
             (try
               (dm/with-open [rconn (rds/connect redis)]
                 (loop []
                   (run-batch! rconn)
                   (recur)))
               (catch InterruptedException _
-                (l/trace :hint "dispatcher: interrupted"))
+                (l/trc :hint "dispatcher: interrupted"))
               (catch Throwable cause
-                (l/error :hint "dispatcher: unexpected exception" :cause cause))
+                (l/err :hint "dispatcher: unexpected exception" :cause cause))
               (finally
-                (l/info :hint "dispatcher: terminated"))))]
+                (l/inf :hint "dispatcher: terminated"))))]
 
     (if (db/read-only? pool)
-      (l/warn :hint "dispatcher: not started (db is read-only)")
+      (l/wrn :hint "dispatcher: not started (db is read-only)")
       (px/fn->thread dispatcher :name "penpot/worker/dispatcher" :virtual true))))
 
 (defmethod ig/halt-key! ::dispatcher
@@ -286,7 +286,7 @@
   (let [queue (d/name queue)
         cfg   (assoc cfg ::queue queue)]
     (if (db/read-only? pool)
-      (l/warn :hint "worker: not started (db is read-only)" :queue queue :parallelism parallelism)
+      (l/wrn :hint "worker: not started (db is read-only)" :queue queue :parallelism parallelism)
       (doall
        (->> (range parallelism)
             (map #(assoc cfg ::worker-id %))
@@ -300,7 +300,7 @@
   [{:keys [::rds/redis ::worker-id ::queue] :as cfg}]
   (px/thread
     {:name (format "penpot/worker/runner:%s" worker-id)}
-    (l/info :hint "worker: started" :worker-id worker-id :queue queue)
+    (l/inf :hint "worker: started" :worker-id worker-id :queue queue)
     (try
       (dm/with-open [rconn (rds/connect redis)]
         (let [tenant (cf/get :tenant "main")
@@ -320,14 +320,14 @@
                  :worker-id worker-id
                  :queue queue))
       (catch Throwable cause
-        (l/error :hint "worker: unexpected exception"
-                 :worker-id worker-id
-                 :queue queue
-                 :cause cause))
+        (l/err :hint "worker: unexpected exception"
+               :worker-id worker-id
+               :queue queue
+               :cause cause))
       (finally
-        (l/info :hint "worker: terminated"
-                :worker-id worker-id
-                :queue queue)))))
+        (l/inf :hint "worker: terminated"
+               :worker-id worker-id
+               :queue queue)))))
 
 (defn- run-worker-loop!
   [{:keys [::db/pool ::rds/rconn ::timeout ::queue ::registry ::worker-id]}]
@@ -368,19 +368,19 @@
               (let [task-id (t/decode payload)]
                 (if (uuid? task-id)
                   task-id
-                  (l/error :hint "worker: received unexpected payload (uuid expected)"
-                           :payload task-id)))
+                  (l/err :hint "worker: received unexpected payload (uuid expected)"
+                         :payload task-id)))
               (catch Throwable cause
-                (l/error :hint "worker: unable to decode payload"
-                         :payload payload
-                         :length (alength payload)
-                         :cause cause))))
+                (l/err :hint "worker: unable to decode payload"
+                       :payload payload
+                       :length (alength payload)
+                       :cause cause))))
 
           (handle-task [{:keys [name] :as task}]
             (let [task-fn (get registry name)]
               (if task-fn
                 (task-fn task)
-                (l/warn :hint "no task handler found" :name name))
+                (l/wrn :hint "no task handler found" :name name))
               {:status :completed :task task}))
 
           (handle-task-exception [cause task]
@@ -395,9 +395,9 @@
                   (= ::noop (:strategy edata))
                   (assoc :inc-by 0))
                 (do
-                  (l/error :hint "worker: unhandled exception on task"
-                           ::l/context (get-error-context cause task)
-                           :cause cause)
+                  (l/err :hint "worker: unhandled exception on task"
+                         ::l/context (get-error-context cause task)
+                         :cause cause)
                   (if (>= (:retry-num task) (:max-retries task))
                     {:status :failed :task task :error cause}
                     {:status :retry :task task :error cause})))))
@@ -414,31 +414,31 @@
                 (if (or (db/connection-error? task)
                         (db/serialization-error? task))
                   (do
-                    (l/warn :hint "worker: connection error on retrieving task from database (retrying in some instants)"
-                            :worker-id worker-id
-                            :cause task)
+                    (l/wrn :hint "worker: connection error on retrieving task from database (retrying in some instants)"
+                           :worker-id worker-id
+                           :cause task)
                     (px/sleep (::rds/timeout rconn))
                     (recur (get-task task-id)))
                   (do
-                    (l/error :hint "worker: unhandled exception on retrieving task from database (retrying in some instants)"
-                             :worker-id worker-id
-                             :cause task)
+                    (l/err :hint "worker: unhandled exception on retrieving task from database (retrying in some instants)"
+                           :worker-id worker-id
+                           :cause task)
                     (px/sleep (::rds/timeout rconn))
                     (recur (get-task task-id))))
 
                 (nil? task)
-                (l/warn :hint "worker: no task found on the database"
-                        :worker-id worker-id
-                        :task-id task-id)
+                (l/wrn :hint "worker: no task found on the database"
+                       :worker-id worker-id
+                       :task-id task-id)
 
                 :else
                 (try
-                  (l/debug :hint "worker: executing task"
-                           :name (:name task)
-                           :id (:id task)
-                           :queue queue
-                           :worker-id worker-id
-                           :retry (:retry-num task))
+                  (l/trc :hint "executing task"
+                         :name (:name task)
+                         :id (str (:id task))
+                         :queue queue
+                         :worker-id worker-id
+                         :retry (:retry-num task))
                   (handle-task task)
                   (catch InterruptedException cause
                     (throw cause))
@@ -459,13 +459,13 @@
                 (if (or (db/connection-error? cause)
                         (db/serialization-error? cause))
                   (do
-                    (l/warn :hint "worker: database exeption on processing task result (retrying in some instants)"
-                            :cause cause)
+                    (l/wrn :hint "worker: database exeption on processing task result (retrying in some instants)"
+                           :cause cause)
                     (px/sleep (::rds/timeout rconn))
                     (recur result))
                   (do
-                    (l/error :hint "worker: unhandled exception on processing task result (retrying in some instants)"
-                             :cause cause)
+                    (l/err :hint "worker: unhandled exception on processing task result (retrying in some instants)"
+                           :cause cause)
                     (px/sleep (::rds/timeout rconn))
                     (recur result))))))]
 
@@ -481,12 +481,12 @@
       (catch Exception cause
         (if (rds/timeout-exception? cause)
           (do
-            (l/error :hint "worker: redis pop operation timeout, consider increasing redis timeout (will retry in some instants)"
-                     :timeout timeout
-                     :cause cause)
+            (l/err :hint "worker: redis pop operation timeout, consider increasing redis timeout (will retry in some instants)"
+                   :timeout timeout
+                   :cause cause)
             (px/sleep timeout))
 
-          (l/error :hint "worker: unhandled exception" :cause cause))))))
+          (l/err :hint "worker: unhandled exception" :cause cause))))))
 
 (defn- get-error-context
   [_ item]
@@ -517,7 +517,7 @@
 (defmethod ig/init-key ::cron
   [_ {:keys [::entries ::registry ::db/pool] :as cfg}]
   (if (db/read-only? pool)
-    (l/warn :hint "cron: not started (db is read-only)")
+    (l/wrn :hint "cron: not started (db is read-only)")
     (let [running (atom #{})
           entries (->> entries
                        (filter some?)
@@ -540,22 +540,22 @@
 
           cfg     (assoc cfg ::entries entries ::running running)]
 
-        (l/info :hint "cron: started" :tasks (count entries))
-        (synchronize-cron-entries! cfg)
+      (l/inf :hint "cron: started" :tasks (count entries))
+      (synchronize-cron-entries! cfg)
 
-        (->> (filter some? entries)
-             (run! (partial schedule-cron-task cfg)))
+      (->> (filter some? entries)
+           (run! (partial schedule-cron-task cfg)))
 
-        (reify
-          clojure.lang.IDeref
-          (deref [_] @running)
+      (reify
+        clojure.lang.IDeref
+        (deref [_] @running)
 
-          java.lang.AutoCloseable
-          (close [_]
-            (l/info :hint "cron: terminated")
-            (doseq [item @running]
-              (when-not (.isDone ^Future item)
-                (.cancel ^Future item true))))))))
+        java.lang.AutoCloseable
+        (close [_]
+          (l/inf :hint "cron: terminated")
+          (doseq [item @running]
+            (when-not (.isDone ^Future item)
+              (.cancel ^Future item true))))))))
 
 (defmethod ig/halt-key! ::cron
   [_ instance]
@@ -571,7 +571,7 @@
   [{:keys [::db/pool ::entries]}]
   (db/with-atomic [conn pool]
     (doseq [{:keys [id cron]} entries]
-      (l/trace :hint "register cron task" :id id :cron (str cron))
+      (l/trc :hint "register cron task" :id id :cron (str cron))
       (db/exec-one! conn [sql:upsert-cron-task id (str cron) (str cron)]))))
 
 (defn- lock-scheduled-task!
@@ -589,7 +589,7 @@
         (db/exec-one! conn ["SET statement_timeout=0;"])
         (db/exec-one! conn ["SET idle_in_transaction_session_timeout=0;"])
         (when (lock-scheduled-task! conn id)
-          (l/trace :hint "cron: execute task" :task-id id)
+          (l/dbg :hint "cron: execute task" :task-id id)
           ((:fn task) task))
         (db/rollback! conn))
 
@@ -598,9 +598,9 @@
 
       (catch Throwable cause
         (binding [l/*context* (get-error-context cause task)]
-          (l/error :hint "cron: unhandled exception on running task"
-                   :task-id id
-                   :cause cause)))
+          (l/err :hint "cron: unhandled exception on running task"
+                 :task-id id
+                 :cause cause)))
       (finally
         (when-not (px/interrupted? :current)
           (schedule-cron-task cfg task))))))
@@ -610,12 +610,16 @@
   (s/assert dt/cron? cron)
   (let [now  (dt/now)
         next (dt/next-valid-instant-from cron now)]
-    (inst-ms (dt/diff now next))))
+    (dt/diff now next)))
 
 (defn- schedule-cron-task
-  [{:keys [::running] :as cfg} {:keys [cron] :as task}]
-  (let [ft (px/schedule! (ms-until-valid cron)
-                         (partial execute-cron-task cfg task))]
+  [{:keys [::running] :as cfg} {:keys [cron id] :as task}]
+  (let [ts (ms-until-valid cron)
+        ft (px/schedule! ts (partial execute-cron-task cfg task))]
+
+    (l/dbg :hint "cron: schedule task" :task-id id
+           :ts (dt/format-duration ts)
+           :at (dt/format-instant (dt/in-future ts)))
     (swap! running #(into #{ft} (filter p/pending?) %))))
 
 
@@ -678,13 +682,13 @@
                     (-> (db/exec-one! conn [sql:remove-not-started-tasks task queue label])
                         :next.jdbc/update-count))]
 
-    (l/debug :hint "submit task"
-             :name task
-             :queue queue
-             :label label
-             :dedupe (boolean dedupe)
-             :deleted (or deleted 0)
-             :in (dt/format-duration duration))
+    (l/trc :hint "submit task"
+           :name task
+           :queue queue
+           :label label
+           :dedupe (boolean dedupe)
+           :deleted (or deleted 0)
+           :in (dt/format-duration duration))
 
     (db/exec-one! conn [sql:insert-new-task id task props queue
                         label priority max-retries interval])

backend/test/backend_tests/helpers.clj

@@ -246,7 +246,7 @@
 (defn mark-file-deleted*
   ([params] (mark-file-deleted* *pool* params))
   ([conn {:keys [id] :as params}]
-   (#'files/mark-file-deleted conn {:id id})))
+   (#'files/mark-file-deleted! conn {:id id})))
 
 (defn create-team*
   ([i params] (create-team* *pool* i params))

backend/test/backend_tests/rpc_file_test.clj

@@ -7,6 +7,7 @@
 (ns backend-tests.rpc-file-test
   (:require
    [app.common.uuid :as uuid]
+   [app.common.types.shape :as cts]
    [app.db :as db]
    [app.db.sql :as sql]
    [app.http :as http]
@@ -187,11 +188,12 @@
          :parent-id uuid/zero
          :frame-id uuid/zero
          :components-v2 true
-         :obj {:id shape-id
-               :name "image"
-               :frame-id uuid/zero
-               :parent-id uuid/zero
-               :type :rect}}])
+         :obj (cts/setup-shape
+               {:id shape-id
+                :name "image"
+                :frame-id uuid/zero
+                :parent-id uuid/zero
+                :type :rect})}])
 
       ;; Check the number of fragments
       (let [rows (th/db-query :file-data-fragment {:file-id (:id file)})]
@@ -282,12 +284,13 @@
          :parent-id uuid/zero
          :frame-id uuid/zero
          :components-v2 true
-         :obj {:id shid
-               :name "image"
-               :frame-id uuid/zero
-               :parent-id uuid/zero
-               :type :image
-               :metadata {:id (:id fmo1) :width 200 :height 200 :mtype "image/jpeg"}}}])
+         :obj (cts/setup-shape
+               {:id shid
+                :name "image"
+                :frame-id uuid/zero
+                :parent-id uuid/zero
+                :type :image
+                :metadata {:id (:id fmo1) :width 100 :height 100 :mtype "image/jpeg"}})}])
 
       ;; Check that reference storage objects on filemediaobjects
       ;; are the same because of deduplication feature.
@@ -547,38 +550,42 @@
         shape2-id (uuid/next)
 
         changes   [{:type :add-obj
-                   :page-id page-id
-                   :id frame1-id
-                   :parent-id uuid/zero
-                   :frame-id uuid/zero
-                   :obj {:id frame1-id
-                         :use-for-thumbnail? true
-                         :name "test-frame1"
-                         :type :frame}}
-                  {:type :add-obj
-                   :page-id page-id
-                   :id shape1-id
-                   :parent-id frame1-id
-                   :frame-id frame1-id
-                   :obj {:id shape1-id
-                         :name "test-shape1"
-                         :type :rect}}
-                  {:type :add-obj
-                   :page-id page-id
-                   :id frame2-id
-                   :parent-id uuid/zero
-                   :frame-id uuid/zero
-                   :obj {:id frame2-id
-                         :name "test-frame2"
-                         :type :frame}}
-                  {:type :add-obj
-                   :page-id page-id
-                   :id shape2-id
-                   :parent-id frame2-id
-                   :frame-id frame2-id
-                   :obj {:id shape2-id
-                         :name "test-shape2"
-                         :type :rect}}]]
+                    :page-id page-id
+                    :id frame1-id
+                    :parent-id uuid/zero
+                    :frame-id uuid/zero
+                    :obj (cts/setup-shape
+                          {:id frame1-id
+                           :use-for-thumbnail? true
+                           :name "test-frame1"
+                           :type :frame})}
+                    {:type :add-obj
+                     :page-id page-id
+                     :id shape1-id
+                     :parent-id frame1-id
+                     :frame-id frame1-id
+                     :obj (cts/setup-shape
+                           {:id shape1-id
+                          :name "test-shape1"
+                            :type :rect})}
+                   {:type :add-obj
+                    :page-id page-id
+                    :id frame2-id
+                    :parent-id uuid/zero
+                    :frame-id uuid/zero
+                    :obj (cts/setup-shape
+                          {:id frame2-id
+                           :name "test-frame2"
+                           :type :frame})}
+                   {:type :add-obj
+                    :page-id page-id
+                    :id shape2-id
+                    :parent-id frame2-id
+                    :frame-id frame2-id
+                    :obj (cts/setup-shape
+                          {:id shape2-id
+                           :name "test-shape2"
+                           :type :rect})}]]
     ;; Update the file
     (th/update-file* {:file-id (:id file)
                       :profile-id (:id prof)

backend/test/backend_tests/rpc_file_thumbnails_test.clj

@@ -7,6 +7,7 @@
 (ns backend-tests.rpc-file-thumbnails-test
   (:require
    [app.common.uuid :as uuid]
+   [app.common.types.shape :as cts]
    [app.config :as cf]
    [app.db :as db]
    [app.rpc :as-alias rpc]
@@ -46,11 +47,12 @@
                    :parent-id uuid/zero
                    :frame-id uuid/zero
                    :components-v2 true
-                   :obj {:id shid
-                         :name "Artboard"
-                         :frame-id uuid/zero
-                         :parent-id uuid/zero
-                         :type :frame}}])
+                   :obj (cts/setup-shape
+                         {:id shid
+                          :name "Artboard"
+                          :frame-id uuid/zero
+                          :parent-id uuid/zero
+                          :type :frame})}])
 
         data1   {::th/type :create-file-object-thumbnail
                  ::rpc/profile-id (:id profile)

backend/test/backend_tests/storage_test.clj

@@ -100,6 +100,7 @@
                     (configure-storage-backend))
         content1 (sto/content "content1")
         content2 (sto/content "content2")
+        content3 (sto/content "content3")
         object1  (sto/put-object! storage {::sto/content content1
                                            ::sto/expired-at (dt/now)
                                            :content-type "text/plain"
@@ -107,16 +108,20 @@
         object2  (sto/put-object! storage {::sto/content content2
                                            ::sto/expired-at (dt/in-past {:hours 2})
                                            :content-type "text/plain"
+                                           })
+        object3  (sto/put-object! storage {::sto/content content3
+                                           ::sto/expired-at (dt/in-past {:hours 1})
+                                           :content-type "text/plain"
                                            })]
 
+
     (th/sleep 200)
 
-    (let [task (:app.storage/gc-deleted-task th/*system*)
-          res  (task {})]
+    (let [res (th/run-task! :storage-gc-deleted {})]
       (t/is (= 1 (:deleted res))))
 
     (let [res (db/exec-one! th/*pool* ["select count(*) from storage_object;"])]
-      (t/is (= 1 (:count res))))))
+      (t/is (= 2 (:count res))))))
 
 (t/deftest test-touched-gc-task-1
   (let [storage (-> (:app.storage/storage th/*system*)

common/deps.edn

@@ -15,7 +15,7 @@
   org.slf4j/slf4j-api {:mvn/version "2.0.7"}
   pl.tkowalcz.tjahzi/log4j2-appender {:mvn/version "0.9.30"}
 
-  selmer/selmer {:mvn/version "1.12.58"}
+  selmer/selmer {:mvn/version "1.12.59"}
   criterium/criterium {:mvn/version "0.4.6"}
 
   metosin/jsonista {:mvn/version "0.3.7"}
@@ -27,7 +27,7 @@
   java-http-clj/java-http-clj {:mvn/version "0.4.3"}
 
   funcool/cuerdas {:mvn/version "2022.06.16-403"}
-  funcool/promesa {:mvn/version "11.0.671"}
+  funcool/promesa {:mvn/version "11.0.678"}
   funcool/datoteka {:mvn/version "3.0.66"
                     :exclusions [funcool/promesa]}
 
@@ -48,7 +48,7 @@
  {:dev
   {:extra-deps
    {org.clojure/tools.namespace {:mvn/version "RELEASE"}
-    thheller/shadow-cljs {:mvn/version "2.20.16"}
+    thheller/shadow-cljs {:mvn/version "2.25.3"}
     com.bhauman/rebel-readline {:mvn/version "RELEASE"}
     criterium/criterium {:mvn/version "RELEASE"}
     mockery/mockery {:mvn/version "RELEASE"}}
@@ -56,7 +56,7 @@
 
   :build
   {:extra-deps
-   {io.github.clojure/tools.build {:git/tag "v0.9.3" :git/sha "e537cd1"}}
+   {io.github.clojure/tools.build {:git/tag "v0.9.5" :git/sha "24f2894"}}
    :ns-default build}
 
   :test

common/dev/user.clj

@@ -6,13 +6,18 @@
 
 (ns user
   (:require
+   [app.common.schema :as sm]
+   [app.common.schema.desc-js-like :as smdj]
+   [app.common.schema.desc-native :as smdn]
+   [app.common.schema.generators :as sg]
+   [app.common.pprint :as pp]
    [clojure.java.io :as io]
    [clojure.pprint :refer [pprint print-table]]
    [clojure.repl :refer :all]
    [clojure.spec.alpha :as s]
    [clojure.spec.gen.alpha :as sgen]
    [clojure.test :as test]
-   [clojure.test.check.generators :as gen]
+   [clojure.test.check.generators :as tgen]
    [clojure.tools.namespace.repl :as repl]
    [clojure.walk :refer [macroexpand-all]]
    [criterium.core  :as crit]))

common/package.json

@@ -4,17 +4,17 @@
   "main": "index.js",
   "license": "MPL-2.0",
   "dependencies": {
-    "luxon": "^3.3.0"
+    "luxon": "^3.4.2"
   },
   "scripts": {
-    "compile-and-watch-test": "clojure -M:dev:shadow-cljs watch test",
-    "compile-test": "clojure -M:dev:shadow-cljs compile test --config-merge '{:autorun false}'",
-    "run-test": "node target/test.js",
-    "test": "yarn run compile-test && yarn run run-test"
+    "test:watch": "clojure -M:dev:shadow-cljs watch test",
+    "test:compile": "clojure -M:dev:shadow-cljs compile test --config-merge '{:autorun false}'",
+    "test:run": "node target/test.js",
+    "test": "yarn run test:compile && yarn run test:run"
   },
   "devDependencies": {
-    "shadow-cljs": "2.20.16",
+    "shadow-cljs": "2.25.3",
     "source-map-support": "^0.5.21",
-    "ws": "^8.11.0"
+    "ws": "^8.13.0"
   }
 }

common/src/app/common/attrs.cljc

@@ -6,7 +6,7 @@
 
 (ns app.common.attrs
   (:require
-    [app.common.geom.shapes.transforms :as gtr]
+    [app.common.geom.shapes :as gsh]
     [app.common.math :as mth]))
 
 (defn- get-attr
@@ -24,7 +24,8 @@
         value
         (if-let [points (:points obj)]
           (if (not= points :multiple)
-            (let [rect (gtr/selection-rect [obj])]
+            ;; FIXME: consider using gsh/shape->rect ??
+            (let [rect (gsh/shapes->rect [obj])]
               (if (= attr :ox) (:x rect) (:y rect)))
             :multiple)
           (get obj attr ::unset)))

common/src/app/common/colors.cljc

@@ -21,3 +21,9 @@
 (def primary "#31EFB8")
 (def danger "#E65244")
 (def warning "#FC8802")
+
+;; new-css-system colors
+(def new-primary "#91fadb")
+(def new-danger "#ff4986")
+(def new-warning "#ff9b49")
+(def canvas-background "#1d1f20")

common/src/app/common/data.cljc

@@ -9,7 +9,7 @@
   data resources."
   (:refer-clojure :exclude [read-string hash-map merge name update-vals
                             parse-double group-by iteration concat mapcat
-                            parse-uuid])
+                            parse-uuid max min])
   #?(:cljs
      (:require-macros [app.common.data]))
 
@@ -18,6 +18,7 @@
       :clj [clojure.edn :as r])
    #?(:cljs [cljs.core :as c]
       :clj [clojure.core :as c])
+   #?(:cljs [goog.array :as garray])
    [app.common.math :as mth]
    [clojure.set :as set]
    [cuerdas.core :as str]
@@ -145,10 +146,6 @@
      (transient-concat c1 more)
      (transient-concat [] (cons c1 more)))))
 
-(defn preconj
-  [coll elem]
-  (into [elem] coll))
-
 (defn enumerate
   ([items] (enumerate items 0))
   ([items start]
@@ -236,12 +233,9 @@
   "Return a map without the keys provided
   in the `keys` parameter."
   [data keys]
-  (persistent!
-   (reduce dissoc!
-           (if (editable-collection? data)
-             (transient data)
-             (transient {}))
-           keys)))
+  (if (editable-collection? data)
+    (persistent! (reduce dissoc! (transient data) keys))
+    (reduce dissoc data keys)))
 
 (defn remove-at-index
   "Takes a vector and returns a vector with an element in the
@@ -590,23 +584,47 @@
   ([a]
    (mth/finite? a))
   ([a b]
-   (and (mth/finite? a)
-        (mth/finite? b)))
+   (and ^boolean (mth/finite? a)
+        ^boolean (mth/finite? b)))
   ([a b c]
-   (and (mth/finite? a)
-        (mth/finite? b)
-        (mth/finite? c)))
+   (and ^boolean (mth/finite? a)
+        ^boolean (mth/finite? b)
+        ^boolean (mth/finite? c)))
   ([a b c d]
-   (and (mth/finite? a)
-        (mth/finite? b)
-        (mth/finite? c)
-        (mth/finite? d)))
+   (and ^boolean (mth/finite? a)
+        ^boolean (mth/finite? b)
+        ^boolean (mth/finite? c)
+        ^boolean (mth/finite? d)))
   ([a b c d & others]
-   (and (mth/finite? a)
-        (mth/finite? b)
-        (mth/finite? c)
-        (mth/finite? d)
-        (every? mth/finite? others))))
+   (and ^boolean (mth/finite? a)
+        ^boolean (mth/finite? b)
+        ^boolean (mth/finite? c)
+        ^boolean (mth/finite? d)
+        ^boolean (every? mth/finite? others))))
+
+(defn safe+
+  [a b]
+  (if (mth/finite? a) (+ a b) a))
+
+(defn max
+  ([a] a)
+  ([a b] (mth/max a b))
+  ([a b c] (mth/max a b c))
+  ([a b c d] (mth/max a b c d))
+  ([a b c d e] (mth/max a b c d e))
+  ([a b c d e f] (mth/max a b c d e f))
+  ([a b c d e f & other]
+   (reduce max (mth/max a b c d e f) other)))
+
+(defn min
+  ([a] a)
+  ([a b] (mth/min a b))
+  ([a b c] (mth/min a b c))
+  ([a b c d] (mth/min a b c d))
+  ([a b c d e] (mth/min a b c d e))
+  ([a b c d e f] (mth/min a b c d e f))
+  ([a b c d e f & other]
+   (reduce min (mth/min a b c d e f) other)))
 
 (defn check-num
   "Function that checks if a number is nil or nan. Will return 0 when not
@@ -759,6 +777,18 @@
         (toString 16)
         (padStart 2 "0"))))
 
+(defn unstable-sort
+  ([items]
+   (unstable-sort compare items))
+  ([comp-fn items]
+   #?(:cljs
+      (let [items (to-array items)]
+        (garray/sort items comp-fn)
+        (seq items))
+      :clj
+      (sort comp-fn items))))
+
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; String Functions
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

common/src/app/common/data/macros.cljc

@@ -7,7 +7,7 @@
 #_:clj-kondo/ignore
 (ns app.common.data.macros
   "Data retrieval & manipulation specific macros."
-  (:refer-clojure :exclude [get-in select-keys str with-open])
+  (:refer-clojure :exclude [get-in select-keys str with-open min max])
   #?(:cljs (:require-macros [app.common.data.macros]))
   (:require
    #?(:clj [clojure.core :as c]
@@ -120,13 +120,10 @@
   "A macro based, optimized variant of `get` that access the property
   directly on CLJS, on CLJ works as get."
   [obj prop]
-  ;; `(do
-  ;;    (when-not (record? ~obj)
-  ;;      (js/console.trace (pr-str ~obj)))
-  ;;    (c/get ~obj ~prop)))
   (if (:ns &env)
     (list (symbol ".") (with-meta obj {:tag 'js}) (symbol (str "-" (c/name prop))))
-    `(c/get ~obj ~prop)))
+    (list `c/get obj prop)))
+
 
 (def ^:dynamic *assert-context* nil)
 
@@ -154,7 +151,7 @@
 
 (defmacro verify!
   ([expr]
-   `(assert! nil ~expr))
+   `(verify! nil ~expr))
   ([hint expr]
    (let [hint (cond
                 (vector? hint)

common/src/app/common/exceptions.cljc

@@ -32,11 +32,6 @@
   [& params]
   `(throw (error ~@params)))
 
-;; FIXME deprecate
-(defn try*
-  [f on-error]
-  (try (f) (catch #?(:clj Throwable :cljs :default) e (on-error e))))
-
 ;; http://clj-me.cgrand.net/2013/09/11/macros-closures-and-unexpected-object-retention/
 ;; Explains the use of ^:once metadata
 

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

@@ -4,14 +4,13 @@
 ;;
 ;; Copyright (c) KALEIDOS INC
 
-(ns app.common.file-builder
-  "A version parsing helper."
+(ns app.common.files.builder
   (:require
    [app.common.data :as d]
    [app.common.data.macros :as dm]
    [app.common.exceptions :as ex]
-   [app.common.geom.matrix :as gmt]
    [app.common.geom.point :as gpt]
+   [app.common.geom.rect :as grc]
    [app.common.geom.shapes :as gsh]
    [app.common.pages.changes :as ch]
    [app.common.pprint :as pp]
@@ -25,9 +24,9 @@
    [app.common.uuid :as uuid]
    [cuerdas.core :as str]))
 
-(def root-frame uuid/zero)
-(def conjv (fnil conj []))
-(def conjs (fnil conj #{}))
+(def ^:private root-id uuid/zero)
+(def ^:private conjv (fnil conj []))
+(def ^:private conjs (fnil conj #{}))
 
 (defn- commit-change
   ([file change]
@@ -38,35 +37,33 @@
                  :or   {add-container? false
                         fail-on-spec? false}}]
    (let [component-id (:current-component-id file)
-         change (cond-> change
-                  (and add-container? (some? component-id))
-                  (cond->
-                   :always
-                    (assoc :component-id component-id)
+         change       (cond-> change
+                        (and add-container? (some? component-id))
+                        (-> (assoc :component-id component-id)
+                            (cond-> (some? (:current-frame-id file))
+                              (assoc :frame-id (:current-frame-id file))))
 
-                    (some? (:current-frame-id file))
-                    (assoc :frame-id (:current-frame-id file)))
+                        (and add-container? (nil? component-id))
+                        (assoc :page-id  (:current-page-id file)
+                               :frame-id (:current-frame-id file)))
+         valid? (ch/valid-change? change)]
 
-                  (and add-container? (nil? component-id))
-                  (assoc :page-id  (:current-page-id file)
-                         :frame-id (:current-frame-id file)))]
+     (when-not valid?
+       (let [explain (sm/explain ::ch/change change)]
+         (pp/pprint (sm/humanize-data explain))
+         (when fail-on-spec?
+           (ex/raise :type :assertion
+                     :code :data-validation
+                     :hint "invalid change"
+                     ::sm/explain explain))))
 
-     (when fail-on-spec?
-       (dm/verify! (ch/change? change)))
+     (cond-> file
+       valid?
+       (-> (update :changes conjv change)
+           (update :data ch/process-changes [change] false))
 
-     (let [valid? (ch/change? change)]
-       (when-not valid?
-         (pp/pprint change {:level 100})
-         (sm/pretty-explain ::ch/change change))
-
-
-       (cond-> file
-         valid?
-         (-> (update :changes conjv change)
-             (update :data ch/process-changes [change] false))
-
-         (not valid?)
-         (update :errors conjv change))))))
+       (not valid?)
+       (update :errors conjv change)))))
 
 (defn- lookup-objects
   ([file]
@@ -91,50 +88,6 @@
 
     (commit-change file change {:add-container? true :fail-on-spec? fail-on-spec?})))
 
-(defn setup-rect-selrect [{:keys [x y width height transform] :as obj}]
-  (when-not (d/num? x y width height)
-    (ex/raise :type :assertion
-              :code :invalid-condition
-              :hint "Coords not valid for object"))
-
-  (let [rect      (gsh/make-rect x y width height)
-        center    (gsh/center-rect rect)
-        selrect   (gsh/rect->selrect rect)
-
-        points (-> (gsh/rect->points rect)
-                   (gsh/transform-points center transform))]
-
-    (-> obj
-        (assoc :selrect selrect)
-        (assoc :points points))))
-
-(defn- setup-path-selrect
-  [{:keys [content center transform transform-inverse] :as obj}]
-
-  (when (or (empty? content) (nil? center))
-    (ex/raise :type :assertion
-              :code :invalid-condition
-              :hint "Path not valid"))
-
-  (let [transform (gmt/transform-in center transform)
-        transform-inverse (gmt/transform-in center transform-inverse)
-
-        content' (gsh/transform-content content transform-inverse)
-        selrect  (gsh/content->selrect content')
-        points   (-> (gsh/rect->points selrect)
-                     (gsh/transform-points transform))]
-
-    (-> obj
-        (dissoc :center)
-        (assoc :selrect selrect)
-        (assoc :points points))))
-
-(defn- setup-selrect
-  [obj]
-  (if (= (:type obj) :path)
-    (setup-path-selrect obj)
-    (setup-rect-selrect obj)))
-
 (defn- generate-name
   [type data]
   (if (= type :svg-raw)
@@ -203,10 +156,10 @@
         (assoc :current-page-id page-id)
 
         ;; Current frame-id
-        (assoc :current-frame-id root-frame)
+        (assoc :current-frame-id root-id)
 
         ;; Current parent stack we'll be nesting
-        (assoc :parent-stack [root-frame])
+        (assoc :parent-stack [root-id])
 
         ;; Last object id added
         (assoc :last-id nil))))
@@ -220,11 +173,8 @@
       (clear-names)))
 
 (defn add-artboard [file data]
-  (let [obj (-> (cts/make-minimal-shape :frame)
-                (merge data)
-                (check-name file :frame)
-                (setup-selrect)
-                (d/without-nils))]
+  (let [obj (-> (cts/setup-shape (assoc data :type :frame))
+                (check-name file :frame))]
     (-> file
         (commit-shape obj)
         (assoc :current-frame-id (:id obj))
@@ -237,19 +187,15 @@
         parent (lookup-shape file parent-id)
         current-frame-id (or (:frame-id parent)
                              (when (nil? (:current-component-id file))
-                               root-frame))]
+                               root-id))]
     (-> file
         (assoc :current-frame-id current-frame-id)
         (update :parent-stack pop))))
 
 (defn add-group [file data]
   (let [frame-id (:current-frame-id file)
-        selrect cts/empty-selrect
-        name (:name data)
-        obj (-> (cts/make-minimal-group frame-id selrect name)
-                (merge data)
-                (check-name file :group)
-                (d/without-nils))]
+        obj      (-> (cts/setup-shape (assoc data :type :group :frame-id frame-id))
+                     (check-name file :group))]
     (-> file
         (commit-shape obj)
         (assoc :last-id (:id obj))
@@ -271,7 +217,7 @@
             :id group-id}
            {:add-container? true})
 
-          (:masked-group? group)
+          (:masked-group group)
           (let [mask (first children)]
             (commit-change
              file
@@ -309,15 +255,8 @@
 
 (defn add-bool [file data]
   (let [frame-id (:current-frame-id file)
-        name (:name data)
-        obj (-> {:id (uuid/next)
-                 :type :bool
-                 :name name
-                 :shapes []
-                 :frame-id frame-id}
-                (merge data)
-                (check-name file :bool)
-                (d/without-nils))]
+        obj      (-> (cts/setup-shape (assoc data :type :bool :frame-id frame-id))
+                     (check-name file :bool))]
     (-> file
         (commit-shape obj)
         (assoc :last-id (:id obj))
@@ -362,11 +301,8 @@
         (update :parent-stack pop))))
 
 (defn create-shape [file type data]
-  (let [obj (-> (cts/make-minimal-shape type)
-                (merge data)
-                (check-name file :type)
-                (setup-selrect)
-                (d/without-nils))]
+  (let [obj (-> (cts/setup-shape (assoc data :type type))
+                (check-name file :type))]
     (-> file
         (commit-shape obj)
         (assoc :last-id (:id obj))
@@ -558,23 +494,33 @@
          {:type :del-media
           :id id}))))
 
+
 (defn start-component
   ([file data] (start-component file data :group))
   ([file data root-type]
-   (let [selrect (or (gsh/make-selrect (:x data) (:y data) (:width data) (:height data))
-                     cts/empty-selrect)
+   ;; FIXME: data probably can be a shape instance, then we can use gsh/shape->rect
+   (let [selrect (or (grc/make-rect (:x data) (:y data) (:width data) (:height data))
+                     grc/empty-rect)
          name               (:name data)
          path               (:path data)
          main-instance-id   (:main-instance-id data)
          main-instance-page (:main-instance-page data)
-         obj (-> (cts/make-shape root-type selrect data)
-                 (dissoc :path
-                         :main-instance-id
-                         :main-instance-page
-                         :main-instance-x
-                         :main-instance-y)
-                 (check-name file root-type)
-                 (d/without-nils))]
+         attrs (-> data
+                   (assoc :type root-type)
+                   (assoc :x (:x selrect))
+                   (assoc :y (:y selrect))
+                   (assoc :width (:width selrect))
+                   (assoc :height (:height selrect))
+                   (assoc :selrect selrect)
+                   (dissoc :path)
+                   (dissoc :main-instance-id)
+                   (dissoc :main-instance-page)
+                   (dissoc :main-instance-x)
+                   (dissoc :main-instance-y))
+
+         obj   (-> (cts/setup-shape attrs)
+                   (check-name file root-type))]
+
      (-> file
          (commit-change
           {:type :add-component
@@ -606,7 +552,7 @@
             :id component-id
             :skip-undelete? true})
 
-          (:masked-group? component)
+          (:masked-group component)
           (let [mask (first children)]
             (commit-change
              file
@@ -662,7 +608,7 @@
                                      (gpt/point main-instance-x
                                                 main-instance-y)
                                      true
-                                     {:main-instance? true
+                                     {:main-instance true
                                       :force-id main-instance-id})]
     (as-> file $
       (reduce #(commit-change %1
@@ -705,7 +651,7 @@
                                      (gpt/point x
                                                 y)
                                      components-v2
-                                     #_{:main-instance? true
+                                     #_{:main-instance true
                                         :force-id main-instance-id})]
 
     (as-> file $
@@ -736,8 +682,8 @@
 (defn update-object
   [file old-obj new-obj]
   (let [page-id (:current-page-id file)
-        new-obj (setup-selrect new-obj)
-        attrs (d/concat-set (keys old-obj) (keys new-obj))
+        new-obj (cts/setup-shape new-obj)
+        attrs   (d/concat-set (keys old-obj) (keys new-obj))
         generate-operation
         (fn [changes attr]
           (let [old-val (get old-obj attr)

common/src/app/common/files/defaults.cljc

@@ -0,0 +1,9 @@
+;; 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.files.defaults)
+
+(def version 31)

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

@@ -0,0 +1,46 @@
+;; 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.files.helpers
+  (:require
+   [app.common.data :as d]
+   [app.common.data.macros :as dm]
+   [app.common.schema :as sm]))
+
+(defn get-used-names
+  "Return a set with the all unique names used in the
+  elements (any entity thas has a :name)"
+  [elements]
+  (let [elements (if (map? elements)
+                   (vals elements)
+                   elements)]
+    (into #{} (keep :name) elements)))
+
+(defn- extract-numeric-suffix
+  [basename]
+  (if-let [[_ p1 p2] (re-find #"(.*) ([0-9]+)$" basename)]
+    [p1 (+ 1 (d/parse-integer p2))]
+    [basename 1]))
+
+(defn generate-unique-name
+  "A unique name generator"
+  [used basename]
+  (dm/assert!
+   "expected a set of strings"
+   (sm/set-of-strings? used))
+
+  (dm/assert!
+   "expected a string for `basename`."
+   (string? basename))
+
+  (if-not (contains? used basename)
+    basename
+    (let [[prefix initial] (extract-numeric-suffix basename)]
+      (loop [counter initial]
+        (let [candidate (str prefix " " counter)]
+          (if (contains? used candidate)
+            (recur (inc counter))
+            candidate))))))

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

@@ -4,36 +4,36 @@
 ;;
 ;; Copyright (c) KALEIDOS INC
 
-(ns app.common.pages.migrations
+(ns app.common.files.migrations
   (:require
    [app.common.data :as d]
    [app.common.data.macros :as dm]
+   [app.common.files.defaults :refer [version]]
    [app.common.geom.matrix :as gmt]
+   [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 log]
+   [app.common.logging :as l]
    [app.common.math :as mth]
-   [app.common.pages :as cp]
+   [app.common.pages.changes :as cpc]
    [app.common.pages.helpers :as cph]
    [app.common.text :as txt]
    [app.common.types.shape :as cts]
    [app.common.uuid :as uuid]
    [cuerdas.core :as str]))
 
-;; TODO: revisit this and rename to file-migrations
+#?(:cljs (l/set-level! :info))
 
 (defmulti migrate :version)
 
-(log/set-level! :info)
-
 (defn migrate-data
-  ([data] (migrate-data data cp/file-version))
+  ([data] (migrate-data data version))
   ([data to-version]
    (if (= (:version data) to-version)
      data
      (let [migrate-fn #(do
-                         (log/trace :hint "migrate file" :id (:id %) :version-from %2 :version-to (inc %2))
+                         (l/dbg :hint "migrate file" :id (:id %) :version-from %2 :version-to (inc %2))
                          (migrate (assoc %1 :version (inc %2))))]
        (reduce migrate-fn data (range (:version data 0) to-version))))))
 
@@ -76,7 +76,7 @@
             (if-not (contains? shape :content)
               (let [content (gsp/segments->content (:segments shape) (:close? shape))
                     selrect (gsh/content->selrect content)
-                    points  (gsh/rect->points selrect)]
+                    points  (grc/rect->points selrect)]
                 (-> shape
                     (dissoc :segments)
                     (dissoc :close?)
@@ -89,17 +89,17 @@
           (fix-frames-selrects [frame]
             (if (= (:id frame) uuid/zero)
               frame
-              (let [frame-rect (select-keys frame [:x :y :width :height])]
+              (let [selrect (gsh/shape->rect frame)]
                 (-> frame
-                    (assoc :selrect (gsh/rect->selrect frame-rect))
-                    (assoc :points (gsh/rect->points frame-rect))))))
+                    (assoc :selrect selrect)
+                    (assoc :points (grc/rect->points selrect))))))
 
           (fix-empty-points [shape]
             (let [shape (cond-> shape
-                          (empty? (:selrect shape)) (cts/setup-rect-selrect))]
+                          (empty? (:selrect shape)) (cts/setup-rect))]
               (cond-> shape
                 (empty? (:points shape))
-                (assoc :points (gsh/rect->points (:selrect shape))))))
+                (assoc :points (grc/rect->points (:selrect shape))))))
 
           (update-object [object]
             (cond-> object
@@ -143,10 +143,10 @@
   ;; Fixes issues with selrect/points for shapes with width/height = 0 (line-like paths)"
   (letfn [(fix-line-paths [shape]
             (if (= (:type shape) :path)
-              (let [{:keys [width height]} (gsh/points->rect (:points shape))]
+              (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))
-                        points (gsh/rect->points selrect)
+                        points (grc/rect->points selrect)
                         transform (gmt/matrix)
                         transform-inv (gmt/matrix)]
                     (assoc shape
@@ -244,7 +244,7 @@
     (loop [data data]
       (let [changes (mapcat calculate-changes (:pages-index data))]
         (if (seq changes)
-          (recur (cp/process-changes data changes))
+          (recur (cpc/process-changes data changes))
           data)))))
 
 (defmethod migrate 10
@@ -438,7 +438,67 @@
         (update :pages-index update-vals update-container)
         (update :components update-vals update-container))))
 
-(defmethod migrate 21
+(defmethod migrate 25
+  [data]
+  (letfn [(update-object [object]
+            (-> object
+                (d/update-when :selrect grc/make-rect)
+                (cts/map->Shape)))
+          (update-container [container]
+            (d/update-when container :objects update-vals update-object))]
+    (-> data
+        (update :pages-index update-vals update-container)
+        (update :components update-vals update-container))))
+
+(defmethod migrate 26
+  [data]
+  (letfn [(update-object [object]
+            (cond-> object
+              (nil? (:transform object))
+              (assoc :transform (gmt/matrix))
+
+              (nil? (:transform-inverse object))
+              (assoc :transform-inverse (gmt/matrix))))
+
+          (update-container [container]
+            (d/update-when container :objects update-vals update-object))]
+
+    (-> data
+        (update :pages-index update-vals update-container)
+        (update :components update-vals update-container))))
+
+(defmethod migrate 27
+  [data]
+  (letfn [(update-object [object]
+            (cond-> object
+              (contains? object :main-instance?)
+              (-> (assoc :main-instance (:main-instance? object))
+                  (dissoc :main-instance?))
+
+              (contains? object :component-root?)
+              (-> (assoc :component-root (:component-root? object))
+                  (dissoc :component-root?))
+
+              (contains? object :remote-synced?)
+              (-> (assoc :remote-synced (:remote-synced? object))
+                  (dissoc :remote-synced?))
+
+              (contains? object :masked-group?)
+              (-> (assoc :masked-group (:masked-group? object))
+                  (dissoc :masked-group?))
+
+              (contains? object :saved-component-root?)
+              (-> (assoc :saved-component-root (:saved-component-root? object))
+                  (dissoc :saved-component-root?))))
+
+          (update-container [container]
+            (d/update-when container :objects update-vals update-object))]
+
+    (-> data
+        (update :pages-index update-vals update-container)
+        (update :components update-vals update-container))))
+
+(defmethod migrate 28
   [data]
   (letfn [(update-object [objects object]
             (let [frame-id (:frame-id object)
@@ -450,11 +510,11 @@
                       ;; If we cannot find any we let the frame-id as it was before
                       frame-id)]
               (when (not= frame-id calculated-frame-id)
-                (log/info :hint "Fix wrong frame-id"
-                          :shape (:name object)
-                          :id (:id object)
-                          :current (dm/get-in objects [frame-id :name])
-                          :calculated (get-in objects [calculated-frame-id :name])))
+                (l/trc :hint "Fix wrong frame-id"
+                       :shape (:name object)
+                       :id (:id object)
+                       :current (dm/get-in objects [frame-id :name])
+                       :calculated (get-in objects [calculated-frame-id :name])))
               (assoc object :frame-id calculated-frame-id)))
 
           (update-container [container]
@@ -467,7 +527,7 @@
 ;; TODO: pending to do a migration for delete already not used fill
 ;; and stroke props. This should be done for >1.14.x version.
 
-(defmethod migrate 22
+(defmethod migrate 29
   [data]
   (letfn [(valid-ref? [ref]
             (or (uuid? ref)
@@ -501,3 +561,33 @@
     (-> data
         (update :pages-index update-vals update-container)
         (update :components update-vals update-container))))
+
+(defmethod migrate 30
+  [data]
+  (letfn [(update-object [object]
+            (if (and (cph/frame-shape? object)
+                     (not (:shapes object)))
+              (assoc object :shapes [])
+              object))
+
+          (update-container [container]
+            (update container :objects update-vals update-object))]
+
+    (-> data
+        (update :pages-index update-vals update-container)
+        (update :components update-vals update-container))))
+
+(defmethod migrate 31
+  [data]
+  (letfn [(update-object [object]
+            (cond-> object
+              (contains? object :use-for-thumbnail?)
+              (-> (assoc :use-for-thumbnail (:use-for-thumbnail? object))
+                  (dissoc :use-for-thumbnail?))))
+
+          (update-container [container]
+            (d/update-when container :objects update-vals update-object))]
+
+    (-> data
+        (update :pages-index update-vals update-container)
+        (update :components update-vals update-container))))

common/src/app/common/files/repair.cljc

@@ -0,0 +1,374 @@
+;; 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.files.repair
+  (:require
+   [app.common.data :as d]
+   [app.common.logging :as log]
+   [app.common.pages.changes-builder :as pcb]
+   [app.common.pages.helpers :as cph]
+   [app.common.types.component :as ctk]
+   [app.common.types.components-list :as ctkl]
+   [app.common.types.container :as ctn]
+   [app.common.types.file :as ctf]
+   [app.common.types.pages-list :as ctpl]
+   [app.common.uuid :as uuid]))
+
+(log/set-level! :debug)
+
+(defmulti repair-error
+  (fn [code _error _file-data _libraries] code))
+
+(defmethod repair-error :parent-not-found
+  [_ {:keys [shape page-id] :as error} file-data _]
+  (let [repair-shape
+        (fn [shape]
+          ; Set parent to root frame.
+          (log/debug :hint "  -> Set to " :parent-id uuid/zero)
+          (assoc shape :parent-id uuid/zero))]
+
+    (log/info :hint "Repairing shape :parent-not-found" :id (:id shape) :name (:name shape) :page-id page-id)
+    (-> (pcb/empty-changes nil page-id)
+        (pcb/with-file-data file-data)
+        (pcb/update-shapes [(:id shape)] repair-shape))))
+
+(defmethod repair-error :child-not-in-parent
+  [_ {:keys [shape page-id] :as error} file-data _]
+  (let [repair-shape
+        (fn [parent-shape]
+          ; Add shape to parent's children list
+          (log/debug :hint "  -> Add children to" :parent-id (:id parent-shape))
+          (update parent-shape :shapes conj (:id shape)))]
+ 
+    (log/info :hint "Repairing shape :child-not-in-parent" :id (:id shape) :name (:name shape) :page-id page-id)
+    (-> (pcb/empty-changes nil page-id)
+        (pcb/with-file-data file-data)
+        (pcb/update-shapes [(:parent-id shape)] repair-shape))))
+
+(defmethod repair-error :child-not-found
+  [_ {:keys [shape page-id args] :as error} file-data _]
+  (let [repair-shape
+        (fn [parent-shape]
+          ; Remove child shape from children list
+          (log/debug :hint "  -> Remove child " :child-id (:child-id args))
+          (update parent-shape :shapes d/removev #(= % (:child-id args))))]
+ 
+    (log/info :hint "Repairing shape :child-not-found" :id (:id shape) :name (:name shape) :page-id page-id)
+    (-> (pcb/empty-changes nil page-id)
+        (pcb/with-file-data file-data)
+        (pcb/update-shapes [(:id shape)] repair-shape))))
+
+(defmethod repair-error :frame-not-found
+  [_ {:keys [shape page-id] :as error} file-data _]
+  (let [repair-shape
+        (fn [shape]
+          ; Locate the first frame in parents and set frame-id to it.
+          (let [page     (ctpl/get-page file-data page-id)
+                frame    (cph/get-frame (:objects page) (:parent-id shape))
+                frame-id (or (:id frame) uuid/zero)]
+            (log/debug :hint "  -> Set to " :frame-id frame-id)
+            (assoc shape :frame-id frame-id)))]
+ 
+    (log/info :hint "Repairing shape :frame-not-found" :id (:id shape) :name (:name shape) :page-id page-id)
+    (-> (pcb/empty-changes nil page-id)
+        (pcb/with-file-data file-data)
+        (pcb/update-shapes [(:id shape)] repair-shape))))
+
+(defmethod repair-error :invalid-frame
+  [_ {:keys [shape page-id] :as error} file-data _]
+  (let [repair-shape
+        (fn [shape]
+          ; Locate the first frame in parents and set frame-id to it.
+          (let [page     (ctpl/get-page file-data page-id)
+                frame    (cph/get-frame (:objects page) (:parent-id shape))
+                frame-id (or (:id frame) uuid/zero)]
+            (log/debug :hint "  -> Set to " :frame-id frame-id)
+            (assoc shape :frame-id frame-id)))]
+ 
+    (log/info :hint "Repairing shape :invalid-frame" :id (:id shape) :name (:name shape) :page-id page-id)
+    (-> (pcb/empty-changes nil page-id)
+        (pcb/with-file-data file-data)
+        (pcb/update-shapes [(:id shape)] repair-shape))))
+
+(defmethod repair-error :component-not-main
+  [_ {:keys [shape page-id] :as error} file-data _]
+  (let [repair-shape
+        (fn [shape]
+          ; Set the :shape as main instance root
+          (log/debug :hint "  -> Set :main-instance")
+          (assoc shape :main-instance true))]
+ 
+    (log/info :hint "Repairing shape :component-not-main" :id (:id shape) :name (:name shape) :page-id page-id)
+    (-> (pcb/empty-changes nil page-id)
+        (pcb/with-file-data file-data)
+        (pcb/update-shapes [(:id shape)] repair-shape))))
+
+(defmethod repair-error :component-main-external
+  [_ {:keys [shape page-id] :as error} file-data _]
+  (let [repair-shape
+        (fn [shape]
+          ; There is no solution that may recover it with confidence
+          (log/warn :hint "  -> CANNOT REPAIR THIS AUTOMATICALLY.")
+          shape)]
+ 
+    (log/info :hint "Repairing shape :component-main-external" :id (:id shape) :name (:name shape) :page-id page-id)
+    (-> (pcb/empty-changes nil page-id)
+        (pcb/with-file-data file-data)
+        (pcb/update-shapes [(:id shape)] repair-shape))))
+
+(defmethod repair-error :component-not-found
+  [_ {:keys [shape page-id] :as error} file-data _]
+  (let [page      (ctpl/get-page file-data page-id)
+        shape-ids (cph/get-children-ids-with-self (:objects page) (:id shape))
+
+        repair-shape
+        (fn [shape]
+          ;; ; Detach the shape and convert it to non instance.
+          ;; (log/debug :hint "  -> Detach shape" :shape-id (:id shape))
+          ;; (ctk/detach-shape shape))]
+          ; There is no solution that may recover it with confidence
+          (log/warn :hint "  -> CANNOT REPAIR THIS AUTOMATICALLY.")
+          shape)]
+
+    (log/info :hint "Repairing shape :component-not-found" :id (:id shape) :name (:name shape) :page-id page-id)
+    (-> (pcb/empty-changes nil page-id)
+        (pcb/with-file-data file-data)
+        (pcb/update-shapes shape-ids repair-shape))))
+
+(defmethod repair-error :invalid-main-instance-id
+  [_ {:keys [shape page-id] :as error} file-data _]
+  (let [repair-component
+        (fn [component]
+          ; Assign main instance in the component to current shape
+          (log/debug :hint "  -> Assign main-instance-id" :component-id (:id component))
+          (assoc component :main-instance-id (:id shape)))]
+    (log/info :hint "Repairing shape :invalid-main-instance-id" :id (:id shape) :name (:name shape) :page-id page-id)
+    (-> (pcb/empty-changes nil page-id)
+        (pcb/with-library-data file-data)
+        (pcb/update-component [(:component-id shape)] repair-component))))
+
+(defmethod repair-error :invalid-main-instance-page
+  [_ {:keys [shape page-id] :as error} file-data _]
+  (let [repair-component
+        (fn [component]
+          ; Assign main instance in the component to current shape
+          (log/debug :hint "  -> Assign main-instance-page" :component-id (:id component))
+          (assoc component :main-instance-page page-id))]
+    (log/info :hint "Repairing shape :invalid-main-instance-page" :id (:id shape) :name (:name shape) :page-id page-id)
+    (-> (pcb/empty-changes nil page-id)
+        (pcb/with-library-data file-data)
+        (pcb/update-component [(:component-id shape)] repair-component))))
+
+(defmethod repair-error :invalid-main-instance
+  [_ {:keys [shape page-id] :as error} file-data _]
+  (let [repair-shape
+        (fn [shape]
+          ; There is no solution that may recover it with confidence
+          (log/warn :hint "  -> CANNOT REPAIR THIS AUTOMATICALLY.")
+          shape)]
+ 
+    (log/info :hint "Repairing shape :invalid-main-instance" :id (:id shape) :name (:name shape) :page-id page-id)
+    (-> (pcb/empty-changes nil page-id)
+        (pcb/with-file-data file-data)
+        (pcb/update-shapes [(:id shape)] repair-shape))))
+
+(defmethod repair-error :component-main
+  [_ {:keys [shape page-id] :as error} file-data _]
+  (let [repair-shape
+        (fn [shape]
+          ; Unset the :shape as main instance root
+          (log/debug :hint "  -> Unset :main-instance")
+          (dissoc shape :main-instance))]
+ 
+    (log/info :hint "Repairing shape :component-main" :id (:id shape) :name (:name shape) :page-id page-id)
+    (-> (pcb/empty-changes nil page-id)
+        (pcb/with-file-data file-data)
+        (pcb/update-shapes [(:id shape)] repair-shape))))
+
+(defmethod repair-error :should-be-component-root
+  [_ {:keys [shape page-id] :as error} file-data _]
+  (let [repair-shape
+        (fn [shape]
+          ; Convert the shape in a top copy root.
+          (log/debug :hint "  -> Set :component-root")
+          (assoc shape :component-root true))]
+ 
+    (log/info :hint "Repairing shape :should-be-component-root" :id (:id shape) :name (:name shape) :page-id page-id)
+    (-> (pcb/empty-changes nil page-id)
+        (pcb/with-file-data file-data)
+        (pcb/update-shapes [(:id shape)] repair-shape))))
+
+(defmethod repair-error :should-not-be-component-root
+  [_ {:keys [shape page-id] :as error} file-data _]
+  (let [repair-shape
+        (fn [shape]
+          ; Convert the shape in a nested copy root.
+          (log/debug :hint "  -> Unset :component-root")
+          (dissoc shape :component-root))]
+ 
+    (log/info :hint "Repairing shape :should-not-be-component-root" :id (:id shape) :name (:name shape) :page-id page-id)
+    (-> (pcb/empty-changes nil page-id)
+        (pcb/with-file-data file-data)
+        (pcb/update-shapes [(:id shape)] repair-shape))))
+
+(defmethod repair-error :ref-shape-not-found
+  [_ {:keys [shape page-id] :as error} file-data libraries]
+  (let [matching-shape (let [page           (ctpl/get-page file-data page-id)
+                             root-shape     (ctn/get-component-shape (:objects page) shape)
+                             component-file (if (= (:component-file root-shape) (:id file-data))
+                                              file-data
+                                              (-> (get libraries (:component-file root-shape)) :data))
+                             component      (when component-file
+                                              (ctkl/get-component (:data component-file) (:component-id root-shape) true))
+                             shapes         (ctf/get-component-shapes file-data component)]
+                         (d/seek #(= (:shape-ref %) (:shape-ref shape)) shapes))
+
+        reassign-shape
+        (fn [shape]
+          (log/debug :hint "  -> Reassign shape-ref to" :shape-ref (:id matching-shape))
+          (assoc shape :shape-ref (:id matching-shape)))
+
+        detach-shape
+        (fn [shape]
+          (log/debug :hint "  -> Detach shape" :shape-id (:id shape))
+          (ctk/detach-shape shape))]
+
+    ; If the shape still refers to the remote component, try to find the corresponding near one
+    ; and link to it. If not, detach the shape.
+    (log/info :hint "Repairing shape :ref-shape-not-found" :id (:id shape) :name (:name shape) :page-id page-id)
+    (if (some? matching-shape)
+      (-> (pcb/empty-changes nil page-id)
+          (pcb/with-file-data file-data)
+          (pcb/update-shapes [(:id shape)] reassign-shape))
+      (let [page      (ctpl/get-page file-data page-id)
+            shape-ids (cph/get-children-ids-with-self (:objects page) (:id shape))]
+        (-> (pcb/empty-changes nil page-id)
+            (pcb/with-file-data file-data)
+            (pcb/update-shapes shape-ids detach-shape))))))
+        
+(defmethod repair-error :shape-ref-in-main
+  [_ {:keys [shape page-id] :as error} file-data _]
+  (let [repair-shape
+        (fn [shape]
+          ; Remove shape-ref
+          (log/debug :hint "  -> Unset :shape-ref")
+          (dissoc shape :shape-ref))]
+ 
+    (log/info :hint "Repairing shape :shape-ref-in-main" :id (:id shape) :name (:name shape) :page-id page-id)
+    (-> (pcb/empty-changes nil page-id)
+        (pcb/with-file-data file-data)
+        (pcb/update-shapes [(:id shape)] repair-shape))))
+
+(defmethod repair-error :root-main-not-allowed
+  [_ {:keys [shape page-id] :as error} file-data _]
+  (let [repair-shape
+        (fn [shape]
+          ; Convert the shape in a nested main head.
+          (log/debug :hint "  -> Unset :component-root")
+          (dissoc shape :component-root))]
+ 
+    (log/info :hint "Repairing shape :root-main-not-allowed" :id (:id shape) :name (:name shape) :page-id page-id)
+    (-> (pcb/empty-changes nil page-id)
+        (pcb/with-file-data file-data)
+        (pcb/update-shapes [(:id shape)] repair-shape))))
+
+(defmethod repair-error :nested-main-not-allowed
+  [_ {:keys [shape page-id] :as error} file-data _]
+  (let [repair-shape
+        (fn [shape]
+          ; Convert the shape in a top main head.
+          (log/debug :hint "  -> Set :component-root")
+          (assoc shape :component-root true))]
+ 
+    (log/info :hint "Repairing shape :nested-main-not-allowed" :id (:id shape) :name (:name shape) :page-id page-id)
+    (-> (pcb/empty-changes nil page-id)
+        (pcb/with-file-data file-data)
+        (pcb/update-shapes [(:id shape)] repair-shape))))
+
+(defmethod repair-error :root-copy-not-allowed
+  [_ {:keys [shape page-id] :as error} file-data _]
+  (let [repair-shape
+        (fn [shape]
+          ; Convert the shape in a nested copy head.
+          (log/debug :hint "  -> Unset :component-root")
+          (dissoc shape :component-root))]
+ 
+    (log/info :hint "Repairing shape :root-copy-not-allowed" :id (:id shape) :name (:name shape) :page-id page-id)
+    (-> (pcb/empty-changes nil page-id)
+        (pcb/with-file-data file-data)
+        (pcb/update-shapes [(:id shape)] repair-shape))))
+
+(defmethod repair-error :nested-copy-not-allowed
+  [_ {:keys [shape page-id] :as error} file-data _]
+  (let [repair-shape
+        (fn [shape]
+          ; Convert the shape in a top copy root.
+          (log/debug :hint "  -> Set :component-root")
+          (assoc shape :component-root true))]
+ 
+    (log/info :hint "Repairing shape :nested-copy-not-allowed" :id (:id shape) :name (:name shape) :page-id page-id)
+    (-> (pcb/empty-changes nil page-id)
+        (pcb/with-file-data file-data)
+        (pcb/update-shapes [(:id shape)] repair-shape))))
+
+(defmethod repair-error :not-head-main-not-allowed
+  [_ {:keys [shape page-id] :as error} file-data _]
+  (let [repair-shape
+        (fn [shape]
+          ;; ; Detach the shape and convert it to non instance.
+          ;; (log/debug :hint "  -> Detach shape" :shape-id (:id shape))
+          ;; (ctk/detach-shape shape))]
+          ; There is no solution that may recover it with confidence
+          (log/warn :hint "  -> CANNOT REPAIR THIS AUTOMATICALLY.")
+          shape)]
+ 
+    (log/info :hint "Repairing shape :not-head-main-not-allowed" :id (:id shape) :name (:name shape) :page-id page-id)
+    (-> (pcb/empty-changes nil page-id)
+        (pcb/with-file-data file-data)
+        (pcb/update-shapes [(:id shape)] repair-shape))))
+
+(defmethod repair-error :not-head-copy-not-allowed
+  [_ {:keys [shape page-id] :as error} file-data _]
+  (let [repair-shape
+        (fn [shape]
+          ; Detach the shape and convert it to non instance.
+          (log/debug :hint "  -> Detach shape" :shape-id (:id shape))
+          (ctk/detach-shape shape))]
+ 
+    (log/info :hint "Repairing shape :not-head-copy-not-allowed" :id (:id shape) :name (:name shape) :page-id page-id)
+    (-> (pcb/empty-changes nil page-id)
+        (pcb/with-file-data file-data)
+        (pcb/update-shapes [(:id shape)] repair-shape))))
+
+(defmethod repair-error :not-component-not-allowed
+  [_ {:keys [shape page-id] :as error} file-data _]
+  (let [repair-shape
+        (fn [shape]
+          ; There is no solution that may recover it with confidence
+          (log/warn :hint "  -> CANNOT REPAIR THIS AUTOMATICALLY.")
+          shape)]
+ 
+    (log/info :hint "Repairing shape :not-component-not-allowed" :id (:id shape) :name (:name shape) :page-id page-id)
+    (-> (pcb/empty-changes nil page-id)
+        (pcb/with-file-data file-data)
+        (pcb/update-shapes [(:id shape)] repair-shape))))
+
+(defmethod repair-error :default
+  [_ error file _]
+  (log/error :hint "Unknown error code, don't know how to repair" :code (:code error))
+  file)
+
+(defn repair-file
+  [file-data libraries errors]
+  (log/info :hint "Repairing file" :id (:id file-data) :error-count (count errors))
+  (reduce (fn [changes error]
+            (pcb/concat-changes changes
+                                (repair-error (:code error)
+                                              error
+                                              file-data
+                                              libraries)))
+          (pcb/empty-changes nil)
+          errors))

common/src/app/common/files/validate.cljc

@@ -0,0 +1,383 @@
+;; 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.files.validate
+  (:require
+   [app.common.data.macros :as dm]
+   [app.common.exceptions :as ex]
+   [app.common.pages.helpers :as cph]
+   [app.common.schema :as sm]
+   [app.common.types.component :as ctk]
+   [app.common.types.container :as ctn]
+   [app.common.types.file :as ctf]
+   [app.common.types.pages-list :as ctpl]
+   [app.common.types.shape-tree :as ctst]
+   [app.common.uuid :as uuid]
+   [cuerdas.core :as str]))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; SCHEMA
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(def error-codes
+  #{:parent-not-found
+    :child-not-in-parent
+    :child-not-found
+    :frame-not-found
+    :invalid-frame
+    :component-not-main
+    :component-main-external
+    :component-not-found
+    :invalid-main-instance-id
+    :invalid-main-instance-page
+    :invalid-main-instance
+    :component-main
+    :should-be-component-root
+    :should-not-be-component-root
+    :ref-shape-not-found
+    :shape-ref-in-main
+    :root-main-not-allowed
+    :nested-main-not-allowed
+    :root-copy-not-allowed
+    :nested-copy-not-allowed
+    :not-head-main-not-allowed
+    :not-head-copy-not-allowed
+    :not-component-not-allowed})
+
+(def validation-error
+  [:map {:title "ValidationError"}
+   [:code {:optional false} [::sm/one-of error-codes]]
+   [:hint {:optional false} :string]
+   [:shape {:optional true} :map] ; Cannot validate a shape because here it may be broken
+   [:file-id ::sm/uuid]
+   [:page-id ::sm/uuid]])
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; ERROR HANDLING
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(def ^:dynamic *errors* nil)
+(def ^:dynamic *throw-on-error* false)
+
+(defn- report-error
+  [code msg shape file page & args]
+  (when (some? *errors*)
+    (if (true? *throw-on-error*)
+      (ex/raise {:type :validation
+                 :code code
+                 :hint msg
+                 :args args
+                 ::explain (str/format "file %s\npage %s\nshape %s"
+                                       (:id file)
+                                       (:id page)
+                                       (:id shape))})
+      (vswap! *errors* conj {:code code
+                             :hint msg
+                             :shape shape
+                             :file-id (:id file)
+                             :page-id (:id page)
+                             :args args}))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; VALIDATION FUNCTIONS
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(declare validate-shape)
+
+(defn validate-parent-children
+  "Validate parent and children exists, and the link is bidirectional."
+  [shape file page]
+  (let [parent (ctst/get-shape page (:parent-id shape))]
+    (if (nil? parent)
+      (report-error :parent-not-found
+                    (str/format "Parent %s not found" (:parent-id shape))
+                    shape file page)
+      (do
+        (when-not (cph/root? shape)
+          (when-not (some #{(:id shape)} (:shapes parent))
+            (report-error :child-not-in-parent
+                          (str/format "Shape %s not in parent's children list" (:id shape))
+                          shape file page)))
+
+        (doseq [child-id (:shapes shape)]
+          (when (nil? (ctst/get-shape page child-id))
+            (report-error :child-not-found
+                          (str/format "Child %s not found" child-id)
+                          shape file page
+                          :child-id child-id)))))))
+
+(defn validate-frame
+  "Validate that the frame-id shape exists and is indeed a frame."
+  [shape file page]
+  (let [frame (ctst/get-shape page (:frame-id shape))]
+    (if (nil? frame)
+      (report-error :frame-not-found
+                    (str/format "Frame %s not found" (:frame-id shape))
+                    shape file page)
+      (when (not= (:type frame) :frame)
+        (report-error :invalid-frame
+                      (str/format "Frame %s is not actually a frame" (:frame-id shape))
+                      shape file page)))))
+
+(defn validate-component-main-head
+  "Validate shape is a main instance head, component exists and its main-instance points to this shape."
+  [shape file page libraries]
+  (when (nil? (:main-instance shape))
+    (report-error :component-not-main
+                  (str/format "Shape expected to be main instance")
+                  shape file page))
+  (when-not (= (:component-file shape) (:id file))
+    (report-error :component-main-external
+                  (str/format "Main instance should refer to a component in the same file")
+                  shape file page))
+  (let [component (ctf/resolve-component shape file libraries {:include-deleted? true})]
+    (if (nil? component)
+      (report-error :component-not-found
+                    (str/format "Component %s not found in file" (:component-id shape) (:component-file shape))
+                    shape file page)
+      (do
+        (when-not (= (:main-instance-id component) (:id shape))
+          (report-error :invalid-main-instance-id
+                        (str/format "Main instance id of component %s is not valid" (:component-id shape))
+                        shape file page))
+        (when-not (= (:main-instance-page component) (:id page))
+          (report-error :invalid-main-instance-page
+                        (str/format "Main instance page of component %s is not valid" (:component-id shape))
+                        shape file page))))))
+
+(defn validate-component-not-main-head
+  "Validate shape is a not-main instance head, component exists and its main-instance does not point to this shape."
+  [shape file page libraries]
+  (when (some? (:main-instance shape))
+    (report-error :component-not-main
+                  (str/format "Shape not expected to be main instance")
+                  shape file page))
+  (let [component (ctf/resolve-component shape file libraries {:include-deleted? true})]
+    (if (nil? component)
+      (report-error :component-not-found
+                    (str/format "Component %s not found in file" (:component-id shape) (:component-file shape))
+                    shape file page)
+      (do
+        (when (and (= (:main-instance-id component) (:id shape))
+                   (= (:main-instance-page component) (:id page)))
+          (report-error :invalid-main-instance
+                        (str/format "Main instance of component %s should not be this shape" (:id component))
+                        shape file page))))))
+
+(defn validate-component-not-main-not-head
+  "Validate that this shape is not main instance and not head."
+  [shape file page]
+  (when (some? (:main-instance shape))
+    (report-error :component-main
+                  (str/format "Shape not expected to be main instance")
+                  shape file page))
+  (when (or (some? (:component-id shape))
+            (some? (:component-file shape)))
+    (report-error :component-main
+                  (str/format "Shape not expected to be component head")
+                  shape file page)))
+
+(defn validate-component-root
+  "Validate that this shape is an instance root."
+  [shape file page]
+  (when (nil? (:component-root shape))
+    (report-error :should-be-component-root
+                  (str/format "Shape should be component root")
+                  shape file page)))
+
+(defn validate-component-not-root
+  "Validate that this shape is not an instance root."
+  [shape file page]
+  (when (some? (:component-root shape))
+    (report-error :should-not-be-component-root
+                  (str/format "Shape should not be component root")
+                  shape file page)))
+
+(defn validate-component-ref
+  "Validate that the referenced shape exists in the near component."
+  [shape file page libraries]
+  (let [ref-shape (ctf/find-ref-shape file page libraries shape :include-deleted? true)]
+    (when (nil? ref-shape)
+      (report-error :ref-shape-not-found
+                    (str/format "Referenced shape %s not found in near component" (:shape-ref shape))
+                    shape file page))))
+
+(defn validate-component-not-ref
+  "Validate that this shape does not reference other one."
+  [shape file page]
+  (when (some? (:shape-ref shape))
+    (report-error :shape-ref-in-main
+                  (str/format "Shape inside main instance should not have shape-ref")
+                  shape file page)))
+
+(defn validate-shape-main-root-top
+  "Root shape of a top main instance
+     :main-instance
+     :component-id
+     :component-file
+     :component-root"
+  [shape file page libraries]
+  (validate-component-main-head shape file page libraries)
+  (validate-component-root shape file page)
+  (validate-component-not-ref shape file page)
+  (doseq [child-id (:shapes shape)]
+    (validate-shape child-id file page libraries :context :main-top :clear-errors? false)))
+
+(defn validate-shape-main-root-nested
+  "Root shape of a nested main instance
+     :main-instance
+     :component-id
+     :component-file"
+  [shape file page libraries]
+  (validate-component-main-head shape file page libraries)
+  (validate-component-not-root shape file page)
+  (validate-component-not-ref shape file page)
+  (doseq [child-id (:shapes shape)]
+    (validate-shape child-id file page libraries :context :main-nested :clear-errors? false)))
+
+(defn validate-shape-copy-root-top
+  "Root shape of a top copy instance
+     :component-id
+     :component-file
+     :component-root
+     :shape-ref"
+  [shape file page libraries]
+  (validate-component-not-main-head shape file page libraries)
+  (validate-component-root shape file page)
+  (validate-component-ref shape file page libraries)
+  (doseq [child-id (:shapes shape)]
+    (validate-shape child-id file page libraries :context :copy-top :clear-errors? false)))
+
+(defn validate-shape-copy-root-nested
+  "Root shape of a nested copy instance
+     :component-id
+     :component-file
+     :shape-ref"
+  [shape file page libraries]
+  (validate-component-not-main-head shape file page libraries)
+  (validate-component-not-root shape file page)
+  (validate-component-ref shape file page libraries)
+  (doseq [child-id (:shapes shape)]
+    (validate-shape child-id file page libraries :context :copy-nested :clear-errors? false)))
+
+(defn validate-shape-main-not-root
+  "Not-root shape of a main instance
+     (not any attribute)"
+  [shape file page libraries]
+  (validate-component-not-main-not-head shape file page)
+  (validate-component-not-root shape file page)
+  (validate-component-not-ref shape file page)
+  (doseq [child-id (:shapes shape)]
+    (validate-shape child-id file page libraries :context :main-any :clear-errors? false)))
+
+(defn validate-shape-copy-not-root
+  "Not-root shape of a copy instance
+     :shape-ref"
+  [shape file page libraries]
+  (validate-component-not-main-not-head shape file page)
+  (validate-component-not-root shape file page)
+  (validate-component-ref shape file page libraries)
+  (doseq [child-id (:shapes shape)]
+    (validate-shape child-id file page libraries :context :copy-any :clear-errors? false)))
+
+(defn validate-shape-not-component
+  "Shape is not in a component or is a fostered children
+     (not any attribute)"
+  [shape file page libraries]
+  (validate-component-not-main-not-head shape file page)
+  (validate-component-not-root shape file page)
+  (validate-component-not-ref shape file page)
+  (doseq [child-id (:shapes shape)]
+    (validate-shape child-id file page libraries :context :not-component :clear-errors? false)))
+
+(defn validate-shape
+  "Validate referential integrity and semantic coherence of a shape and all its children.
+
+   The context is the situation of the parent in respect to components:
+     :not-component
+     :main-top
+     :main-nested
+     :copy-top
+     :copy-nested
+     :main-any
+     :copy-any"
+  [shape-id file page libraries & {:keys [context throw?]
+                                   :or {context :not-component
+                                        throw? false}}]
+  (binding [*throw-on-error* throw?
+            *errors* (or *errors* (volatile! []))]
+    (let [shape (ctst/get-shape page shape-id)]
+
+                                        ; If this happens it's a bug in this validate functions
+      (dm/verify! (str/format "Shape %s not found" shape-id) (some? shape))
+
+      (validate-parent-children shape file page)
+      (validate-frame shape file page)
+
+    (validate-parent-children shape file page)
+    (validate-frame shape file page)
+
+    (if (ctk/instance-head? shape)
+      
+      (if (ctk/instance-root? shape)
+
+        (if (ctk/main-instance? shape)
+          (if (not= context :not-component)
+            (report-error :root-main-not-allowed
+                          (str/format "Root main component not allowed inside other component")
+                          shape file page)
+            (validate-shape-main-root-top shape file page libraries))
+
+          (if (not= context :not-component)
+            (report-error :root-main-not-allowed
+                          (str/format "Root main component not allowed inside other component")
+                          shape file page)
+            (validate-shape-copy-root-top shape file page libraries)))
+
+        (if (ctk/main-instance? shape)
+          (if (= context :not-component)
+            (report-error :nested-main-not-allowed
+                          (str/format "Nested main component only allowed inside other component")
+                          shape file page)
+            (validate-shape-main-root-nested shape file page libraries))
+
+          (if (= context :not-component)
+            (report-error :nested-main-not-allowed
+                          (str/format "Nested main component only allowed inside other component")
+                          shape file page)
+            (validate-shape-copy-root-nested shape file page libraries))))
+
+      (if (ctk/in-component-copy? shape)
+        (if-not (#{:copy-top :copy-nested :copy-any} context)
+          (report-error :not-head-copy-not-allowed
+                        (str/format "Non-root copy only allowed inside a copy")
+                        shape file page)
+          (validate-shape-copy-not-root shape file page libraries))
+
+        (if (ctn/inside-component-main? (:objects page) shape)
+          (if-not (#{:main-top :main-nested :main-any} context)
+            (report-error :not-head-main-not-allowed
+                          (str/format "Non-root main only allowed inside a main component")
+                          shape file page)
+            (validate-shape-main-not-root shape file page libraries))
+
+          (if (#{:main-top :main-nested :main-any} context)
+            (report-error :not-component-not-allowed
+                          (str/format "Not compoments are not allowed inside a main")
+                          shape file page)
+            (validate-shape-not-component shape file page libraries)))))
+
+          (deref *errors*))))
+
+(defn validate-file
+  "Validate referencial integrity and semantic coherence of all contents of a file."
+  [file libraries & {:keys [throw?] :or {throw? false}}]
+  (binding [*throw-on-error* throw?
+            *errors* (volatile! [])]
+    (->> (ctpl/pages-seq (:data file))
+         (run! #(validate-shape uuid/zero file % libraries :throw? throw?)))
+
+    (deref *errors*)))

common/src/app/common/fressian.clj

@@ -7,12 +7,8 @@
 (ns app.common.fressian
   (:require
    [app.common.data :as d]
-   [app.common.geom.matrix :as gmt]
-   [app.common.geom.point :as gpt]
    [clojure.data.fressian :as fres])
   (:import
-   app.common.geom.matrix.Matrix
-   app.common.geom.point.Point
    clojure.lang.Ratio
    java.io.ByteArrayInputStream
    java.io.ByteArrayOutputStream
@@ -297,39 +293,3 @@
   [data]
   (with-open [^ByteArrayInputStream input (ByteArrayInputStream. ^bytes data)]
     (-> input reader read!)))
-
-;; --- ADDITIONAL
-
-(add-handlers!
- {:name "penpot/point"
-  :class app.common.geom.point.Point
-  :wfn (fn [n w ^Point o]
-         (write-tag! w n 1)
-         (write-list! w (List/of (.-x o) (.-y o))))
-  :rfn (fn [^Reader rdr]
-         (let [^List x (read-object! rdr)]
-           (Point. (.get x 0) (.get x 1))))}
-
- {:name "penpot/matrix"
-  :class app.common.geom.matrix.Matrix
-  :wfn (fn [^String n ^Writer w o]
-         (write-tag! w n 1)
-         (write-list! w (List/of (.-a ^Matrix o)
-                                 (.-b ^Matrix o)
-                                 (.-c ^Matrix o)
-                                 (.-d ^Matrix o)
-                                 (.-e ^Matrix o)
-                                 (.-f ^Matrix o))))
-  :rfn (fn [^Reader rdr]
-         (let [^List x (read-object! rdr)]
-           (Matrix. (.get x 0) (.get x 1) (.get x 2) (.get x 3) (.get x 4) (.get x 5))))})
-
-
-;; Backward compatibility for 1.19 with v1.20;
-
-(add-handlers!
- {:name "penpot/geom/rect"
-  :rfn read-map-like}
- {:name "penpot/shape"
-  :rfn read-map-like})
-

common/src/app/common/geom/align.cljc

@@ -6,6 +6,8 @@
 
 (ns app.common.geom.align
   (:require
+   [app.common.geom.point :as gpt]
+   [app.common.geom.rect :as grc]
    [app.common.geom.shapes :as gsh]
    [app.common.pages.helpers :refer [get-children]]))
 
@@ -30,10 +32,10 @@
   the shape with the given rectangle. If the shape is a group,
   move also all of its recursive children."
   [shape rect axis objects]
-  (let [wrapper-rect (gsh/selection-rect [shape])
-        align-pos (calc-align-pos wrapper-rect rect axis)
-        delta {:x (- (:x align-pos) (:x wrapper-rect))
-               :y (- (:y align-pos) (:y wrapper-rect))}]
+  (let [wrapper-rect (gsh/shapes->rect [shape])
+        align-pos    (calc-align-pos wrapper-rect rect axis)
+        delta        (gpt/point (- (:x align-pos) (:x wrapper-rect))
+                                (- (:y align-pos) (:y wrapper-rect)))]
     (recursive-move shape delta objects)))
 
 (defn calc-align-pos
@@ -78,11 +80,11 @@
         other-coord (if (= axis :horizontal) :y :x)
         size (if (= axis :horizontal) :width :height)
         ; The rectangle that wraps the whole selection
-        wrapper-rect (gsh/selection-rect shapes)
+        wrapper-rect (gsh/shapes->rect shapes)
         ; Sort shapes by the center point in the given axis
-        sorted-shapes (sort-by #(coord (gsh/center-shape %)) shapes)
+        sorted-shapes (sort-by #(coord (gsh/shape->center %)) shapes)
         ; Each shape wrapped in its own rectangle
-        wrapped-shapes (map #(gsh/selection-rect [%]) sorted-shapes)
+        wrapped-shapes (map #(gsh/shapes->rect [%]) sorted-shapes)
         ; The total space between shapes
         space (reduce - (size wrapper-rect) (map size wrapped-shapes))
         unit-space (/ space (- (count wrapped-shapes) 1))
@@ -111,28 +113,32 @@
 (defn adjust-to-viewport
   ([viewport srect] (adjust-to-viewport viewport srect nil))
   ([viewport srect {:keys [padding] :or {padding 0}}]
-   (let [gprop (/ (:width viewport) (:height viewport))
-         srect (-> srect
-                   (update :x #(- % padding))
-                   (update :y #(- % padding))
-                   (update :width #(+ % padding padding))
-                   (update :height #(+ % padding padding)))
-         width (:width srect)
+   (let [gprop  (/ (:width viewport)
+                   (:height viewport))
+         srect  (-> srect
+                    (update :x #(- % padding))
+                    (update :y #(- % padding))
+                    (update :width #(+ % padding padding))
+                    (update :height #(+ % padding padding)))
+         width  (:width srect)
          height (:height srect)
-         lprop (/ width height)]
+         lprop  (/ width height)]
      (cond
-      (> gprop lprop)
-      (let [width'  (* (/ width lprop) gprop)
-            padding (/ (- width' width) 2)]
-        (-> srect
-            (update :x #(- % padding))
-            (assoc :width width')))
+       (> gprop lprop)
+       (let [width'  (* (/ width lprop) gprop)
+             padding (/ (- width' width) 2)]
+         (-> srect
+             (update :x #(- % padding))
+             (assoc :width width')
+             (grc/update-rect :position)))
 
-      (< gprop lprop)
-      (let [height' (/ (* height lprop) gprop)
-            padding (/ (- height' height) 2)]
-        (-> srect
-            (update :y #(- % padding))
-            (assoc :height height')))
+       (< gprop lprop)
+       (let [height' (/ (* height lprop) gprop)
+             padding (/ (- height' height) 2)]
+         (-> srect
+             (update :y #(- % padding))
+             (assoc :height height')
+             (grc/update-rect :position)))
 
-      :else srect))))
+       :else
+       (grc/update-rect srect :position)))))

common/src/app/common/geom/grid.cljc

@@ -4,7 +4,7 @@
 ;;
 ;; Copyright (c) KALEIDOS INC
 
-(ns app.util.geom.grid
+(ns app.common.geom.grid
   (:require
    [app.common.data :as d]
    [app.common.geom.point :as gpt]

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

@@ -8,34 +8,41 @@
   (:require
    #?(:cljs [cljs.pprint :as pp]
       :clj  [clojure.pprint :as pp])
+   #?(:clj [app.common.fressian :as fres])
    [app.common.data :as d]
    [app.common.data.macros :as dm]
    [app.common.geom.point :as gpt]
    [app.common.math :as mth]
+   [app.common.record :as cr]
    [app.common.schema :as sm]
    [app.common.schema.generators :as sg]
    [app.common.schema.openapi :as-alias oapi]
    [app.common.spec :as us]
-   [clojure.spec.alpha :as s]))
+   [app.common.transit :as t]
+   [clojure.spec.alpha :as s])
+  #?(:clj
+     (:import
+      java.util.List)))
+
 
 (def precision 6)
 
 ;; --- Matrix Impl
-(defrecord Matrix [^double a
-                   ^double b
-                   ^double c
-                   ^double d
-                   ^double e
-                   ^double f]
+(cr/defrecord Matrix [^double a
+                      ^double b
+                      ^double c
+                      ^double d
+                      ^double e
+                      ^double f]
   Object
-  (toString [_]
+  (toString [this]
     (dm/fmt "matrix(%, %, %, %, %, %)"
-      (mth/to-fixed a precision)
-      (mth/to-fixed b precision)
-      (mth/to-fixed c precision)
-      (mth/to-fixed d precision)
-      (mth/to-fixed e precision)
-      (mth/to-fixed f precision))))
+            (mth/to-fixed (.-a this) precision)
+            (mth/to-fixed (.-b this) precision)
+            (mth/to-fixed (.-c this) precision)
+            (mth/to-fixed (.-d this) precision)
+            (mth/to-fixed (.-e this) precision)
+            (mth/to-fixed (.-f this) precision))))
 
 (defn matrix?
   "Return true if `v` is Matrix instance."
@@ -45,9 +52,9 @@
 (defn matrix
   "Create a new matrix instance."
   ([]
-   (Matrix. 1 0 0 1 0 0))
+   (pos->Matrix 1 0 0 1 0 0))
   ([a b c d e f]
-   (Matrix. a b c d e f)))
+   (pos->Matrix a b c d e f)))
 
 (def number-regex #"[+-]?\d*(\.\d+)?(e[+-]?\d+)?")
 
@@ -94,7 +101,7 @@
                               (sg/small-double)
                               (sg/small-double)
                               (sg/small-double) )
-                    (sg/fmap #(apply ->Matrix %)))
+                    (sg/fmap #(apply pos->Matrix %)))
       ::oapi/type "string"
       ::oapi/format "matrix"
       ::oapi/decode decode
@@ -114,24 +121,54 @@
 (s/def ::matrix
   (s/and ::matrix-attrs matrix?))
 
-
 (defn close?
   [^Matrix m1 ^Matrix m2]
-  (and (mth/close? (.-a m1) (.-a m2))
-       (mth/close? (.-b m1) (.-b m2))
-       (mth/close? (.-c m1) (.-c m2))
-       (mth/close? (.-d m1) (.-d m2))
-       (mth/close? (.-e m1) (.-e m2))
-       (mth/close? (.-f m1) (.-f m2))))
+  (and ^boolean (mth/close? (.-a m1) (.-a m2))
+       ^boolean (mth/close? (.-b m1) (.-b m2))
+       ^boolean (mth/close? (.-c m1) (.-c m2))
+       ^boolean (mth/close? (.-d m1) (.-d m2))
+       ^boolean (mth/close? (.-e m1) (.-e m2))
+       ^boolean (mth/close? (.-f m1) (.-f m2))))
 
 (defn unit? [^Matrix m1]
-  (and (some? m1)
-       (mth/close? (.-a m1) 1)
-       (mth/close? (.-b m1) 0)
-       (mth/close? (.-c m1) 0)
-       (mth/close? (.-d m1) 1)
-       (mth/close? (.-e m1) 0)
-       (mth/close? (.-f m1) 0)))
+  (and ^boolean (some? m1)
+       ^boolean (mth/close? (.-a m1) 1)
+       ^boolean (mth/close? (.-b m1) 0)
+       ^boolean (mth/close? (.-c m1) 0)
+       ^boolean (mth/close? (.-d m1) 1)
+       ^boolean (mth/close? (.-e m1) 0)
+       ^boolean (mth/close? (.-f m1) 0)))
+
+(defn multiply!
+  [^Matrix m1 ^Matrix m2]
+  (let [m1a (.-a m1)
+        m1b (.-b m1)
+        m1c (.-c m1)
+        m1d (.-d m1)
+        m1e (.-e m1)
+        m1f (.-f m1)
+        m2a (.-a m2)
+        m2b (.-b m2)
+        m2c (.-c m2)
+        m2d (.-d m2)
+        m2e (.-e m2)
+        m2f (.-f m2)]
+    #?@(:cljs
+        [(set! (.-a m1) (+ (* m1a m2a) (* m1c m2b)))
+         (set! (.-b m1) (+ (* m1b m2a) (* m1d m2b)))
+         (set! (.-c m1) (+ (* m1a m2c) (* m1c m2d)))
+         (set! (.-d m1) (+ (* m1b m2c) (* m1d m2d)))
+         (set! (.-e m1) (+ (* m1a m2e) (* m1c m2f) m1e))
+         (set! (.-f m1) (+ (* m1b m2e) (* m1d m2f) m1f))
+         m1]
+        :clj
+        [(pos->Matrix
+          (+ (* m1a m2a) (* m1c m2b))
+          (+ (* m1b m2a) (* m1d m2b))
+          (+ (* m1a m2c) (* m1c m2d))
+          (+ (* m1b m2c) (* m1d m2d))
+          (+ (* m1a m2e) (* m1c m2f) m1e)
+          (+ (* m1b m2e) (* m1d m2f) m1f))])))
 
 (defn multiply
   ([^Matrix m1 ^Matrix m2]
@@ -156,7 +193,7 @@
            m2e (.-e m2)
            m2f (.-f m2)]
 
-       (Matrix.
+       (pos->Matrix
         (+ (* m1a m2a) (* m1c m2b))
         (+ (* m1b m2a) (* m1d m2b))
         (+ (* m1a m2c) (* m1c m2d))
@@ -165,51 +202,28 @@
         (+ (* m1b m2e) (* m1d m2f) m1f)))))
 
   ([m1 m2 & others]
-   (reduce multiply (multiply m1 m2) others)))
-
-(defn multiply!
-  [^Matrix m1 ^Matrix m2]
-  (let [m1a (.-a m1)
-        m1b (.-b m1)
-        m1c (.-c m1)
-        m1d (.-d m1)
-        m1e (.-e m1)
-        m1f (.-f m1)
-        m2a (.-a m2)
-        m2b (.-b m2)
-        m2c (.-c m2)
-        m2d (.-d m2)
-        m2e (.-e m2)
-        m2f (.-f m2)]
-    #?@(:cljs [(set! (.-a m1) (+ (* m1a m2a) (* m1c m2b)))
-               (set! (.-b m1) (+ (* m1b m2a) (* m1d m2b)))
-               (set! (.-c m1) (+ (* m1a m2c) (* m1c m2d)))
-               (set! (.-d m1) (+ (* m1b m2c) (* m1d m2d)))
-               (set! (.-e m1) (+ (* m1a m2e) (* m1c m2f) m1e))
-               (set! (.-f m1) (+ (* m1b m2e) (* m1d m2f) m1f))
-               m1]
-        :clj  [(Matrix.
-                (+ (* m1a m2a) (* m1c m2b))
-                (+ (* m1b m2a) (* m1d m2b))
-                (+ (* m1a m2c) (* m1c m2d))
-                (+ (* m1b m2c) (* m1d m2d))
-                (+ (* m1a m2e) (* m1c m2f) m1e)
-                (+ (* m1b m2e) (* m1d m2f) m1f))])))
+   (reduce multiply! (multiply m1 m2) others)))
 
 (defn add-translate
   "Given two TRANSLATE matrixes (only e and f have significative
   values), combine them. Quicker than multiplying them, for this
   precise case."
-  ([{m1e :e m1f :f} {m2e :e m2f :f}]
-   (Matrix. 1 0 0 1 (+ m1e m2e) (+ m1f m2f)))
+  ([^Matrix m1 ^Matrix m2]
+   (let [m1e (dm/get-prop m1 :e)
+         m1f (dm/get-prop m1 :f)
+         m2e (dm/get-prop m2 :e)
+         m2f (dm/get-prop m2 :f)]
+     (pos->Matrix 1 0 0 1 (+ m1e m2e) (+ m1f m2f))))
 
   ([m1 m2 & others]
    (reduce add-translate (add-translate m1 m2) others)))
 
+;; FIXME: optimize?
+
 (defn substract
   [{m1a :a m1b :b m1c :c m1d :d m1e :e m1f :f}
    {m2a :a m2b :b m2c :c m2d :d m2e :e m2f :f}]
-  (Matrix.
+  (pos->Matrix
    (- m1a m2a) (- m1b m2b) (- m1c m2c)
    (- m1d m2d) (- m1e m2e) (- m1f m2f)))
 
@@ -221,13 +235,24 @@
 
 (defn translate-matrix
   ([pt]
-   (assert (gpt/point? pt))
-   (Matrix. 1 0 0 1
-            (dm/get-prop pt :x)
-            (dm/get-prop pt :y)))
+   (dm/assert! (gpt/point? pt))
+   (pos->Matrix 1 0 0 1
+                (dm/get-prop pt :x)
+                (dm/get-prop pt :y)))
 
   ([x y]
-   (Matrix. 1 0 0 1 x y)))
+   (pos->Matrix 1 0 0 1 x y)))
+
+
+(defn translate-matrix-neg
+  ([pt]
+   (dm/assert! (gpt/point? pt))
+   (pos->Matrix 1 0 0 1
+            (- (dm/get-prop pt :x))
+            (- (dm/get-prop pt :y))))
+
+  ([x y]
+   (pos->Matrix 1 0 0 1 (- x) (- y))))
 
 (defn scale-matrix
   ([pt center]
@@ -235,10 +260,10 @@
          sy (dm/get-prop pt :y)
          cx (dm/get-prop center :x)
          cy (dm/get-prop center :y)]
-     (Matrix. sx 0 0 sy (- cx (* cx sx)) (- cy (* cy sy)))))
+     (pos->Matrix sx 0 0 sy (- cx (* cx sx)) (- cy (* cy sy)))))
   ([pt]
-   (assert (gpt/point? pt))
-   (Matrix. (dm/get-prop pt :x) 0 0 (dm/get-prop pt :y) 0 0)))
+   (dm/assert! (gpt/point? pt))
+   (pos->Matrix (dm/get-prop pt :x) 0 0 (dm/get-prop pt :y) 0 0)))
 
 (defn rotate-matrix
   ([angle point]
@@ -252,15 +277,15 @@
          ns (- s)
          tx (+ (* c nx) (* ns ny) cx)
          ty (+ (* s nx) (*  c ny) cy)]
-     (Matrix. c s ns c tx ty)))
+     (pos->Matrix c s ns c tx ty)))
   ([angle]
    (let [a (mth/radians angle)]
-     (Matrix. (mth/cos a)
-              (mth/sin a)
-              (- (mth/sin a))
-              (mth/cos a)
-              0
-              0))))
+     (pos->Matrix (mth/cos a)
+                  (mth/sin a)
+                  (- (mth/sin a))
+                  (mth/cos a)
+                  0
+                  0))))
 
 (defn skew-matrix
   ([angle-x angle-y point]
@@ -270,7 +295,7 @@
   ([angle-x angle-y]
    (let [m1 (mth/tan (mth/radians angle-x))
          m2 (mth/tan (mth/radians angle-y))]
-     (Matrix. 1 m2 m1 1 0 0))))
+     (pos->Matrix 1 m2 m1 1 0 0))))
 
 (defn rotate
   "Apply rotation transformation to the matrix."
@@ -331,6 +356,7 @@
         (translate (gpt/negate pt)))
     mtx))
 
+;; FIXME: performance
 (defn determinant
   "Determinant for the affinity transform"
   [{:keys [a b c d _ _]}]
@@ -340,14 +366,14 @@
   "Gets the inverse of the affinity transform `mtx`"
   [{:keys [a b c d e f] :as mtx}]
   (let [det (determinant mtx)]
-    (when-not (mth/almost-zero? det)
+    (when-not ^boolean (mth/almost-zero? det)
       (let [a' (/  d det)
             b' (/ (- b) det)
             c' (/ (- c) det)
             d' (/  a det)
             e' (/ (- (* c f) (* d e)) det)
             f' (/ (- (* b e) (* a f)) det)]
-        (Matrix. a' b' c' d' e' f')))))
+        (pos->Matrix a' b' c' d' e' f')))))
 
 (defn round
   [mtx]
@@ -371,8 +397,41 @@
     point))
 
 (defn move?
-  [{:keys [a b c d _ _]}]
-  (and (mth/almost-zero? (- a 1))
-       (mth/almost-zero? b)
-       (mth/almost-zero? c)
-       (mth/almost-zero? (- d 1))))
+  [m]
+  (and ^boolean (mth/almost-zero? (- (dm/get-prop m :a) 1))
+       ^boolean (mth/almost-zero? (dm/get-prop m :b))
+       ^boolean (mth/almost-zero? (dm/get-prop m :c))
+       ^boolean (mth/almost-zero? (- (dm/get-prop m :d) 1))))
+
+#?(:clj
+   (fres/add-handlers!
+    {:name "penpot/matrix"
+     :class Matrix
+     :wfn (fn [n w o]
+            (fres/write-tag! w n 1)
+            (fres/write-list! w (List/of (.-a ^Matrix o)
+                                         (.-b ^Matrix o)
+                                         (.-c ^Matrix o)
+                                         (.-d ^Matrix o)
+                                         (.-e ^Matrix o)
+                                         (.-f ^Matrix o))))
+     :rfn (fn [rdr]
+            (let [^List x (fres/read-object! rdr)]
+              (pos->Matrix (.get x 0)
+                           (.get x 1)
+                           (.get x 2)
+                           (.get x 3)
+                           (.get x 4)
+                           (.get x 5))))}))
+
+(t/add-handlers!
+ {:id "matrix"
+  :class Matrix
+  :wfn #(into {} %)
+  :rfn (fn [m]
+         (pos->Matrix (get m :a)
+                      (get m :b)
+                      (get m :c)
+                      (get m :d)
+                      (get m :e)
+                      (get m :f)))})

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

@@ -11,20 +11,26 @@
       :clj  [clojure.pprint :as pp])
    #?(:cljs [cljs.core :as c]
       :clj [clojure.core :as c])
+   #?(:clj [app.common.fressian :as fres])
    [app.common.data :as d]
    [app.common.data.macros :as dm]
    [app.common.exceptions :as ex]
    [app.common.math :as mth]
+   [app.common.record :as cr]
    [app.common.schema :as sm]
    [app.common.schema.generators :as sg]
    [app.common.schema.openapi :as-alias oapi]
    [app.common.spec :as us]
+   [app.common.transit :as t]
    [clojure.spec.alpha :as s]
-   [cuerdas.core :as str]))
+   [cuerdas.core :as str])
+  #?(:clj
+     (:import
+      java.util.List)))
 
 ;; --- Point Impl
 
-(defrecord Point [x y])
+(cr/defrecord Point [x y])
 
 (defn s
   [pt]
@@ -57,7 +63,7 @@
               (map->Point p)
               (if (string? p)
                 (let [[x y] (->> (str/split p #",") (mapv parse-double))]
-                  (Point. x y))
+                  (pos->Point x y))
                 p)))
 
           (encode [p]
@@ -71,7 +77,7 @@
       :description "Point"
       :error/message "expected a valid point"
       :gen/gen (->> (sg/tuple (sg/small-int) (sg/small-int))
-                    (sg/fmap #(apply ->Point %)))
+                    (sg/fmap #(apply pos->Point %)))
       ::oapi/type "string"
       ::oapi/format "point"
       ::oapi/decode decode
@@ -85,7 +91,7 @@
 
 (defn point
   "Create a Point instance."
-  ([] (Point. 0 0))
+  ([] (pos->Point 0 0))
   ([v]
    (cond
      (point? v)
@@ -95,12 +101,12 @@
      (point v v)
 
      (point-like? v)
-     (Point. (:x v) (:y v))
+     (pos->Point (:x v) (:y v))
 
      :else
      (ex/raise :hint "invalid arguments (on pointer constructor)" :value v)))
   ([x y]
-   (Point. x y)))
+   (pos->Point x y)))
 
 (defn close?
   [p1 p2]
@@ -119,25 +125,29 @@
   "Returns the addition of the supplied value to both
   coordinates of the point as a new point."
   [p1 p2]
-  (assert (and (point? p1)
-               (point? p2))
-          "arguments should be pointer instance")
-  (Point. (+ (dm/get-prop p1 :x)
-             (dm/get-prop p2 :x))
-          (+ (dm/get-prop p1 :y)
-             (dm/get-prop p2 :y))))
+  (dm/assert!
+   "arguments should be point instance"
+   (and (point? p1)
+        (point? p2)))
+
+  (pos->Point (+ (dm/get-prop p1 :x)
+                 (dm/get-prop p2 :x))
+              (+ (dm/get-prop p1 :y)
+                 (dm/get-prop p2 :y))))
 
 (defn subtract
   "Returns the subtraction of the supplied value to both
   coordinates of the point as a new point."
   [p1 p2]
-  (assert (and (point? p1)
-               (point? p2))
-          "arguments should be pointer instance")
-  (Point. (- (dm/get-prop p1 :x)
-             (dm/get-prop p2 :x))
-          (- (dm/get-prop p1 :y)
-             (dm/get-prop p2 :y))))
+  (dm/assert!
+   "arguments should be pointer instance"
+   (and (point? p1)
+        (point? p2)))
+
+  (pos->Point (- (dm/get-prop p1 :x)
+                 (dm/get-prop p2 :x))
+              (- (dm/get-prop p1 :y)
+                 (dm/get-prop p2 :y))))
 
 (defn multiply
   "Returns the subtraction of the supplied value to both
@@ -146,20 +156,20 @@
   (assert (and (point? p1)
                (point? p2))
           "arguments should be pointer instance")
-  (Point. (* (dm/get-prop p1 :x)
-             (dm/get-prop p2 :x))
-          (* (dm/get-prop p1 :y)
-             (dm/get-prop p2 :y))))
+  (pos->Point (* (dm/get-prop p1 :x)
+                 (dm/get-prop p2 :x))
+              (* (dm/get-prop p1 :y)
+                 (dm/get-prop p2 :y))))
 
 (defn divide
   [p1 p2]
   (assert (and (point? p1)
                (point? p2))
           "arguments should be pointer instance")
-  (Point. (/ (dm/get-prop p1 :x)
-             (dm/get-prop p2 :x))
-          (/ (dm/get-prop p1 :y)
-             (dm/get-prop p2 :y))))
+  (pos->Point (/ (dm/get-prop p1 :x)
+                 (dm/get-prop p2 :x))
+              (/ (dm/get-prop p1 :y)
+                 (dm/get-prop p2 :y))))
 
 (defn min
   ([] nil)
@@ -168,10 +178,10 @@
    (cond
      (nil? p1) p2
      (nil? p2) p1
-     :else (Point. (c/min (dm/get-prop p1 :x)
-                          (dm/get-prop p2 :x))
-                   (c/min (dm/get-prop p1 :y)
-                          (dm/get-prop p2 :y))))))
+     :else (pos->Point (c/min (dm/get-prop p1 :x)
+                              (dm/get-prop p2 :x))
+                       (c/min (dm/get-prop p1 :y)
+                              (dm/get-prop p2 :y))))))
 (defn max
   ([] nil)
   ([p1] p1)
@@ -179,21 +189,21 @@
    (cond
      (nil? p1) p2
      (nil? p2) p1
-     :else (Point. (c/max (dm/get-prop p1 :x)
-                          (dm/get-prop p2 :x))
-                   (c/max (dm/get-prop p1 :y)
-                          (dm/get-prop p2 :y))))))
+     :else (pos->Point (c/max (dm/get-prop p1 :x)
+                              (dm/get-prop p2 :x))
+                       (c/max (dm/get-prop p1 :y)
+                              (dm/get-prop p2 :y))))))
 (defn inverse
   [pt]
   (assert (point? pt) "point instance expected")
-  (Point. (/ 1.0 (dm/get-prop pt :x))
-          (/ 1.0 (dm/get-prop pt :y))))
+  (pos->Point (/ 1.0 (dm/get-prop pt :x))
+              (/ 1.0 (dm/get-prop pt :y))))
 
 (defn negate
   [pt]
   (assert (point? pt) "point instance expected")
-  (Point. (- (dm/get-prop pt :x))
-          (- (dm/get-prop pt :y))))
+  (pos->Point (- (dm/get-prop pt :x))
+              (- (dm/get-prop pt :y))))
 
 (defn distance
   "Calculate the distance between two points."
@@ -217,8 +227,8 @@
               (dm/get-prop p2 :x))
         dy (- (dm/get-prop p1 :y)
               (dm/get-prop p2 :y))]
-    (Point. (mth/abs dx)
-            (mth/abs dy))))
+    (pos->Point (mth/abs dx)
+                (mth/abs dy))))
 
 (defn length
   [pt]
@@ -285,8 +295,8 @@
   (assert (number? angle) "expected number")
   (let [len   (length p)
         angle (mth/radians angle)]
-    (Point. (* (mth/cos angle) len)
-            (* (mth/sin angle) len))))
+    (pos->Point (* (mth/cos angle) len)
+                (* (mth/sin angle) len))))
 
 (defn quadrant
   "Return the quadrant of the angle of the point."
@@ -306,22 +316,21 @@
   ([pt decimals]
    (assert (point? pt) "expected point instance")
    (assert (number? decimals) "expected number instance")
-   (Point. (mth/precision (dm/get-prop pt :x) decimals)
-           (mth/precision (dm/get-prop pt :y) decimals))))
+   (pos->Point (mth/precision (dm/get-prop pt :x) decimals)
+               (mth/precision (dm/get-prop pt :y) decimals))))
 
 (defn round-step
   "Round the coordinates to the closest half-point"
   [pt step]
   (assert (point? pt) "expected point instance")
-  (Point. (mth/round (dm/get-prop pt :x) step)
-          (mth/round (dm/get-prop pt :y) step)))
+  (pos->Point (mth/round (dm/get-prop pt :x) step)
+              (mth/round (dm/get-prop pt :y) step)))
 
 (defn transform
   "Transform a point applying a matrix transformation."
   [p m]
   (when (point? p)
-    (if (nil? m)
-      p
+    (if (some? m)
       (let [x (dm/get-prop p :x)
             y (dm/get-prop p :y)
             a (dm/get-prop m :a)
@@ -330,18 +339,51 @@
             d (dm/get-prop m :d)
             e (dm/get-prop m :e)
             f (dm/get-prop m :f)]
-        (Point. (+ (* x a) (* y c) e)
-                (+ (* x b) (* y d) f))))))
+        (pos->Point (+ (* x a) (* y c) e)
+                    (+ (* x b) (* y d) f)))
+      p)))
 
 
+(defn transform!
+  [p m]
+
+  (dm/assert!
+   "expected valid rect and matrix instances"
+   (and (some? p) (some? m)))
+
+  (let [x (dm/get-prop p :x)
+        y (dm/get-prop p :y)
+        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)]
+    #?(:clj
+       (pos->Point (+ (* x a) (* y c) e)
+                   (+ (* x b) (* y d) f))
+       :cljs
+       (do
+         (set! (.-x p) (+ (* x a) (* y c) e))
+         (set! (.-y p) (+ (* x b) (* y d) f))
+         p))))
+
+(defn matrix->point
+  "Returns a result of transform an identity point with the provided
+  matrix instance"
+  [m]
+  (let [e (dm/get-prop m :e)
+        f (dm/get-prop m :f)]
+    (pos->Point e f)))
+
 ;; Vector functions
 (defn to-vec [p1 p2]
   (subtract p2 p1))
 
 (defn scale
   [p scalar]
-  (Point. (* (dm/get-prop p :x) scalar)
-          (* (dm/get-prop p :y) scalar)))
+  (pos->Point (* (dm/get-prop p :x) scalar)
+              (* (dm/get-prop p :y) scalar)))
 
 (defn dot
   [p1 p2]
@@ -354,14 +396,14 @@
   [p1]
   (let [p-length (length p1)]
     (if (mth/almost-zero? p-length)
-      (Point. 0 0)
-      (Point. (/ (dm/get-prop p1 :x) p-length)
-              (/ (dm/get-prop p1 :y) p-length)))))
+      (pos->Point 0 0)
+      (pos->Point (/ (dm/get-prop p1 :x) p-length)
+                  (/ (dm/get-prop p1 :y) p-length)))))
 
 (defn perpendicular
   [pt]
-  (Point. (- (dm/get-prop pt :y))
-          (dm/get-prop pt :x)))
+  (pos->Point (- (dm/get-prop pt :y))
+              (dm/get-prop pt :x)))
 
 (defn project
   "V1 perpendicular projection on vector V2"
@@ -412,7 +454,7 @@
   [p1 p2 t]
   (let [x (mth/lerp (dm/get-prop p1 :x) (dm/get-prop p2 :x) t)
         y (mth/lerp (dm/get-prop p1 :y) (dm/get-prop p2 :y) t)]
-    (Point. x y)))
+    (pos->Point x y)))
 
 (defn rotate
   "Rotates the point around center with an angle"
@@ -434,7 +476,7 @@
         y     (+ (* sa (- px cx))
                  (* ca (- py cy))
                  cy)]
-    (Point. x y)))
+    (pos->Point x y)))
 
 (defn scale-from
   "Moves a point in the vector that creates with center with a scale
@@ -450,10 +492,10 @@
   [p]
   (let [x (dm/get-prop p :x)
         y (dm/get-prop p :y)]
-    (Point. (if (mth/almost-zero? x) 0.001 x)
-            (if (mth/almost-zero? y) 0.001 y))))
-
+    (pos->Point (if (mth/almost-zero? x) 0.001 x)
+                (if (mth/almost-zero? y) 0.001 y))))
 
+;; FIXME: perfromance
 (defn abs
   [point]
   (-> point
@@ -464,3 +506,19 @@
 
 (defmethod pp/simple-dispatch Point [obj] (pr obj))
 
+#?(:clj
+   (fres/add-handlers!
+    {:name "penpot/point"
+     :class Point
+     :wfn (fn [n w ^Point o]
+            (fres/write-tag! w n 1)
+            (fres/write-list! w (List/of (.-x o) (.-y o))))
+     :rfn (fn [rdr]
+            (let [^List x (fres/read-object! rdr)]
+              (pos->Point (.get x 0) (.get x 1))))}))
+
+(t/add-handlers!
+ {:id "point"
+  :class Point
+  :wfn #(into {} %)
+  :rfn map->Point})

common/src/app/common/geom/rect.cljc

@@ -0,0 +1,353 @@
+;; 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.rect
+  (:require
+   #?(:clj [app.common.fressian :as fres])
+   [app.common.data :as d]
+   [app.common.data.macros :as dm]
+   [app.common.geom.point :as gpt]
+   [app.common.math :as mth]
+   [app.common.record :as rc]
+   [app.common.transit :as t]))
+
+(rc/defrecord Rect [x y width height x1 y1 x2 y2])
+
+(defn rect?
+  [o]
+  (instance? Rect o))
+
+#?(:clj
+   (fres/add-handlers!
+    {:name "penpot/geom/rect"
+     :class Rect
+     :wfn fres/write-map-like
+     :rfn (comp map->Rect fres/read-map-like)}))
+
+(t/add-handlers!
+ {:id "rect"
+  :class Rect
+  :wfn #(into {} %)
+  :rfn map->Rect})
+
+(defn make-rect
+  ([] (make-rect 0 0 0.01 0.01))
+  ([data]
+   (if (rect? data)
+     data
+     (let [{:keys [x y width height]} data]
+       (make-rect (d/nilv x 0)
+                  (d/nilv y 0)
+                  (d/nilv width 0.01)
+                  (d/nilv height 0.01)))))
+
+  ([p1 p2]
+   (dm/assert!
+    "expected `p1` and `p2` to be points"
+    (and (gpt/point? p1)
+         (gpt/point? p2)))
+
+   (let [xp1 (dm/get-prop p1 :x)
+         yp1 (dm/get-prop p1 :y)
+         xp2 (dm/get-prop p2 :x)
+         yp2 (dm/get-prop p2 :y)
+         x1  (mth/min xp1 xp2)
+         y1  (mth/min yp1 yp2)
+         x2  (mth/max xp1 xp2)
+         y2  (mth/max yp1 yp2)]
+     (make-rect x1 y1 (- x2 x1) (- y2 y1))))
+
+  ([x y width height]
+   (when (d/num? x y width height)
+     (let [w (mth/max width 0.01)
+           h (mth/max height 0.01)]
+       (pos->Rect x y w h x y (+ x w) (+ y h))))))
+
+(def empty-rect
+  (make-rect 0 0 0.01 0.01))
+
+(defn update-rect
+  [rect type]
+  (case type
+    :size
+    (let [x (dm/get-prop rect :x)
+          y (dm/get-prop rect :y)
+          w (dm/get-prop rect :width)
+          h (dm/get-prop rect :height)]
+      (assoc rect
+             :x2 (+ x w)
+             :y2 (+ y h)))
+
+    :corners
+    (let [x1 (dm/get-prop rect :x1)
+          y1 (dm/get-prop rect :y1)
+          x2 (dm/get-prop rect :x2)
+          y2 (dm/get-prop rect :y2)]
+      (assoc rect
+             :x (mth/min x1 x2)
+             :y (mth/min y1 y2)
+             :width (mth/abs (- x2 x1))
+             :height (mth/abs (- y2 y1))))
+
+    :position
+    (let [x (dm/get-prop rect :x)
+          y (dm/get-prop rect :y)
+          w (dm/get-prop rect :width)
+          h (dm/get-prop rect :height)]
+      (assoc rect
+             :x1 x
+             :y1 y
+             :x2 (+ x w)
+             :y2 (+ y h)))))
+
+(defn update-rect!
+  [rect type]
+  (case type
+    (:size :position)
+    (let [x (dm/get-prop rect :x)
+          y (dm/get-prop rect :y)
+          w (dm/get-prop rect :width)
+          h (dm/get-prop rect :height)]
+      (rc/assoc! rect
+                 :x1 x
+                 :y1 y
+                 :x2 (+ x w)
+                 :y2 (+ y h)))
+
+    :corners
+    (let [x1 (dm/get-prop rect :x1)
+          y1 (dm/get-prop rect :y1)
+          x2 (dm/get-prop rect :x2)
+          y2 (dm/get-prop rect :y2)]
+      (rc/assoc! rect
+                 :x (mth/min x1 x2)
+                 :y (mth/min y1 y2)
+                 :width (mth/abs (- x2 x1))
+                 :height (mth/abs (- y2 y1))))))
+
+(defn close-rect?
+  [rect1 rect2]
+
+  (dm/assert!
+   "expected two rects"
+   (and (rect? rect1)
+        (rect? rect2)))
+
+  (and ^boolean (mth/close? (dm/get-prop rect1 :x)
+                            (dm/get-prop rect2 :x))
+       ^boolean (mth/close? (dm/get-prop rect1 :y)
+                            (dm/get-prop rect2 :y))
+       ^boolean (mth/close? (dm/get-prop rect1 :width)
+                            (dm/get-prop rect2 :width))
+       ^boolean (mth/close? (dm/get-prop rect1 :height)
+                            (dm/get-prop rect2 :height))))
+
+(defn rect->points
+  [rect]
+  (dm/assert!
+   "expected rect instance"
+   (rect? rect))
+
+  (let [x (dm/get-prop rect :x)
+        y (dm/get-prop rect :y)
+        w (dm/get-prop rect :width)
+        h (dm/get-prop rect :height)]
+    (when (d/num? x y)
+      (let [w (mth/max w 0.01)
+            h (mth/max h 0.01)]
+        [(gpt/point x y)
+         (gpt/point (+ x w) y)
+         (gpt/point (+ x w) (+ y h))
+         (gpt/point x (+ y h))]))))
+
+(defn rect->point
+  "Extract the position part of the rect"
+  [rect]
+  (gpt/point (dm/get-prop rect :x)
+             (dm/get-prop rect :y)))
+
+(defn rect->center
+  [rect]
+  (dm/assert! (rect? rect))
+  (let [x (dm/get-prop rect :x)
+        y (dm/get-prop rect :y)
+        w (dm/get-prop rect :width)
+        h (dm/get-prop rect :height)]
+    (when (d/num? x y w h)
+      (gpt/point (+ x (/ w 2.0))
+                 (+ y (/ h 2.0))))))
+
+(defn rect->lines
+  [rect]
+  (dm/assert! (rect? rect))
+
+  (let [x (dm/get-prop rect :x)
+        y (dm/get-prop rect :y)
+        w (dm/get-prop rect :width)
+        h (dm/get-prop rect :height)]
+    (when (d/num? x y)
+      (let [w (mth/max w 0.01)
+            h (mth/max h 0.01)]
+        [[(gpt/point x y) (gpt/point (+ x w) y)]
+         [(gpt/point (+ x w) y) (gpt/point (+ x w) (+ y h))]
+         [(gpt/point (+ x w) (+ y h)) (gpt/point x (+ y h))]
+         [(gpt/point x (+ y h)) (gpt/point x y)]]))))
+
+(defn points->rect
+  [points]
+  (when-let [points (seq points)]
+    (loop [minx ##Inf
+           miny ##Inf
+           maxx ##-Inf
+           maxy ##-Inf
+           pts  points]
+      (if-let [pt (first pts)]
+        (let [x (dm/get-prop pt :x)
+              y (dm/get-prop pt :y)]
+          (recur (mth/min minx x)
+                 (mth/min miny y)
+                 (mth/max maxx x)
+                 (mth/max maxy y)
+                 (rest pts)))
+        (when (d/num? minx miny maxx maxy)
+          (make-rect minx miny (- maxx minx) (- maxy miny)))))))
+
+;; FIXME: measure performance
+(defn bounds->rect
+  [[pa pb pc pd]]
+  (let [ax   (dm/get-prop pa :x)
+        ay   (dm/get-prop pa :y)
+        bx   (dm/get-prop pb :x)
+        by   (dm/get-prop pb :y)
+        cx   (dm/get-prop pc :x)
+        cy   (dm/get-prop pc :y)
+        dx   (dm/get-prop pd :x)
+        dy   (dm/get-prop pd :y)
+        minx (mth/min ax bx cx dx)
+        miny (mth/min ay by cy dy)
+        maxx (mth/max ax bx cx dx)
+        maxy (mth/max ay by cy dy)]
+    (when (d/num? minx miny maxx maxy)
+      (make-rect minx miny (- maxx minx) (- maxy miny)))))
+
+(def ^:private xf-keep-x (keep #(dm/get-prop % :x)))
+(def ^:private xf-keep-y (keep #(dm/get-prop % :y)))
+(def ^:private xf-keep-x2 (keep #(dm/get-prop % :x2)))
+(def ^:private xf-keep-y2 (keep #(dm/get-prop % :y2)))
+
+(defn squared-points
+  [points]
+  (when (d/not-empty? points)
+    (let [minx (transduce xf-keep-x d/min ##Inf points)
+          miny (transduce xf-keep-y d/min ##Inf points)
+          maxx (transduce xf-keep-x2 d/max ##-Inf points)
+          maxy (transduce xf-keep-y2 d/max ##-Inf points)]
+      (when (d/num? minx miny maxx maxy)
+        [(gpt/point minx miny)
+         (gpt/point maxx miny)
+         (gpt/point maxx maxy)
+         (gpt/point minx maxy)]))))
+
+(defn join-rects [rects]
+  (when (seq rects)
+    (let [minx (transduce xf-keep-x d/min ##Inf rects)
+          miny (transduce xf-keep-y d/min ##Inf rects)
+          maxx (transduce xf-keep-x2 d/max ##-Inf rects)
+          maxy (transduce xf-keep-y2 d/max ##-Inf rects)]
+      (when (d/num? minx miny maxx maxy)
+        (make-rect minx miny (- maxx minx) (- maxy miny))))))
+
+(defn center->rect
+  [point w h]
+  (when (some? point)
+    (let [x (dm/get-prop point :x)
+          y (dm/get-prop point :y)]
+      (when (d/num? x y w h)
+        (make-rect (- x (/ w 2))
+                   (- y (/ h 2))
+                   w
+                   h)))))
+
+(defn s=
+  [a b]
+  (mth/almost-zero? (- a b)))
+
+(defn overlaps-rects?
+  "Check for two rects to overlap. Rects won't overlap only if
+   one of them is fully to the left or the top"
+  [rect-a rect-b]
+  (let [x1a (dm/get-prop rect-a :x)
+        y1a (dm/get-prop rect-a :y)
+        x2a (+ x1a (dm/get-prop rect-a :width))
+        y2a (+ y1a (dm/get-prop rect-a :height))
+
+        x1b (dm/get-prop rect-b :x)
+        y1b (dm/get-prop rect-b :y)
+        x2b (+ x1b (dm/get-prop rect-b :width))
+        y2b (+ y1b (dm/get-prop rect-b :height))]
+
+    (and (or (> x2a x1b)  (s= x2a x1b))
+         (or (>= x2b x1a) (s= x2b x1a))
+         (or (<= y1b y2a) (s= y1b y2a))
+         (or (<= y1a y2b) (s= y1a y2b)))))
+
+(defn contains-point?
+  [rect point]
+  (assert (gpt/point? point))
+  (let [x1 (:x rect)
+        y1 (:y rect)
+        x2 (+ (:x rect) (:width rect))
+        y2 (+ (:y rect) (:height rect))
+
+        px (:x point)
+        py (:y point)]
+
+    (and (or (> px x1) (s= px x1))
+         (or (< px x2) (s= px x2))
+         (or (> py y1) (s= py y1))
+         (or (< py y2) (s= py y2)))))
+
+(defn contains-rect?
+  "Check if a rect srb is contained inside sra"
+  [sra srb]
+  (let [ax1 (dm/get-prop sra :x1)
+        ax2 (dm/get-prop sra :x2)
+        ay1 (dm/get-prop sra :y1)
+        ay2 (dm/get-prop sra :y2)
+        bx1 (dm/get-prop srb :x1)
+        bx2 (dm/get-prop srb :x2)
+        by1 (dm/get-prop srb :y1)
+        by2 (dm/get-prop srb :y2)]
+    (and (>= bx1 ax1)
+         (<= bx2 ax2)
+         (>= by1 ay1)
+         (<= by2 ay2))))
+
+(defn corners->rect
+  ([p1 p2]
+   (corners->rect (:x p1) (:y p1) (:x p2) (:y p2)))
+  ([xp1 yp1 xp2 yp2]
+   (make-rect (mth/min xp1 xp2)
+              (mth/min yp1 yp2)
+              (abs (- xp1 xp2))
+              (abs (- yp1 yp2)))))
+
+(defn clip-rect
+  [selrect bounds]
+  (when (rect? selrect)
+    (dm/assert! (rect? bounds))
+    (let [x1  (dm/get-prop selrect :x1)
+          y1  (dm/get-prop selrect :y1)
+          x2  (dm/get-prop selrect :x2)
+          y2  (dm/get-prop selrect :y2)
+          bx1 (dm/get-prop bounds :x1)
+          by1 (dm/get-prop bounds :y1)
+          bx2 (dm/get-prop bounds :x2)
+          by2 (dm/get-prop bounds :y2)]
+      (corners->rect (mth/max bx1 x1)
+                     (mth/max by1 y1)
+                     (mth/min bx2 x2)
+                     (mth/min by2 y2)))))

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

@@ -9,6 +9,7 @@
    [app.common.data :as d]
    [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]
@@ -16,28 +17,30 @@
    [app.common.geom.shapes.intersect :as gsi]
    [app.common.geom.shapes.modifiers :as gsm]
    [app.common.geom.shapes.path :as gsp]
-   [app.common.geom.shapes.rect :as gpr]
-   [app.common.geom.shapes.text :as gst]
    [app.common.geom.shapes.transforms :as gtr]
    [app.common.math :as mth]))
 
 ;; --- Outer Rect
 
-(defn selection-rect
-  "Returns a rect that contains all the shapes and is aware of the
-  rotation of each shape. Mainly used for multiple selection."
-  [shapes]
-  (->> shapes
-       (map (comp gpr/points->selrect :points))
-       (gpr/join-selrects)))
-
 (defn translate-to-frame
-  [shape {:keys [x y]}]
-  (gtr/move shape (gpt/negate (gpt/point x y)))  )
+  [shape frame]
+  (->> (gpt/point (- (dm/get-prop frame :x))
+                  (- (dm/get-prop frame :y)))
+       (gtr/move shape)))
 
 (defn translate-from-frame
-  [shape {:keys [x y]}]
-  (gtr/move shape (gpt/point x y))  )
+  [shape frame]
+  (gtr/move shape (gpt/point (dm/get-prop frame :x)
+                             (dm/get-prop frame :y))))
+
+(defn shape->rect
+  [shape]
+  (let [x (dm/get-prop shape :x)
+        y (dm/get-prop shape :y)
+        w (dm/get-prop shape :width)
+        h (dm/get-prop shape :height)]
+    (when (d/num? x y w h)
+      (grc/make-rect x y w h))))
 
 ;; --- Helpers
 
@@ -45,7 +48,7 @@
   "Returns a rect that wraps the shape after all transformations applied."
   [shape]
   ;; TODO: perhaps we need to store this calculation in a shape attribute
-  (gpr/points->rect (:points shape)))
+  (grc/points->rect (:points shape)))
 
 (defn left-bound
   "Returns the lowest x coord of the shape BEFORE applying transformations."
@@ -82,21 +85,38 @@
          (update :width (comp inc inc))
          (update :height (comp inc inc))))))
 
-(defn selrect->areas [bounds selrect]
-  (let [{bound-x1 :x1 bound-x2 :x2 bound-y1 :y1 bound-y2 :y2} bounds
-        {sr-x1 :x1 sr-x2 :x2 sr-y1 :y1 sr-y2 :y2} selrect]
-    {:left (gpr/corners->selrect bound-x1 sr-y1 sr-x1 sr-y2)
-     :top    (gpr/corners->selrect sr-x1 bound-y1 sr-x2 sr-y1)
-     :right  (gpr/corners->selrect sr-x2 sr-y1 bound-x2 sr-y2)
-     :bottom (gpr/corners->selrect sr-x1 sr-y2 sr-x2 bound-y2)}))
+(defn get-areas
+  [bounds selrect]
+  (let [bound-x1 (dm/get-prop bounds :x1)
+        bound-x2 (dm/get-prop bounds :x2)
+        bound-y1 (dm/get-prop bounds :y1)
+        bound-y2 (dm/get-prop bounds :y2)
+        sr-x1    (dm/get-prop selrect :x1)
+        sr-x2    (dm/get-prop selrect :x2)
+        sr-y1    (dm/get-prop selrect :y1)
+        sr-y2    (dm/get-prop selrect :y2)]
+    {:left   (grc/corners->rect bound-x1 sr-y1 sr-x1 sr-y2)
+     :top    (grc/corners->rect sr-x1 bound-y1 sr-x2 sr-y1)
+     :right  (grc/corners->rect sr-x2 sr-y1 bound-x2 sr-y2)
+     :bottom (grc/corners->rect sr-x1 sr-y2 sr-x2 bound-y2)}))
 
-(defn distance-selrect [selrect other]
-  (let [{:keys [x1 y1]} other
-        {:keys [x2 y2]} selrect]
+(defn distance-selrect
+  [selrect other]
+
+  (dm/assert!
+   (and (grc/rect? selrect)
+        (grc/rect? other)))
+
+  (let [x1 (dm/get-prop other :x1)
+        y1 (dm/get-prop other :y1)
+        x2 (dm/get-prop selrect :x2)
+        y2 (dm/get-prop selrect :y2)]
     (gpt/point (- x1 x2) (- y1 y2))))
 
 (defn distance-shapes [shape other]
-  (distance-selrect (:selrect shape) (:selrect other)))
+  (distance-selrect
+   (dm/get-prop shape :selrect)
+   (dm/get-prop other :selrect)))
 
 (defn close-attrs?
   "Compares two shapes attributes to see if they are equal or almost
@@ -131,28 +151,12 @@
        (= val1 val2)))))
 
 ;; EXPORTS
-(dm/export gco/center-shape)
-(dm/export gco/center-selrect)
-(dm/export gco/center-rect)
-(dm/export gco/center-points)
+(dm/export gco/shape->center)
+(dm/export gco/shapes->rect)
+(dm/export gco/points->center)
 (dm/export gco/transform-points)
 (dm/export gco/shape->points)
 
-(dm/export gpr/make-rect)
-(dm/export gpr/make-selrect)
-(dm/export gpr/rect->selrect)
-(dm/export gpr/rect->points)
-(dm/export gpr/points->selrect)
-(dm/export gpr/points->rect)
-(dm/export gpr/center->rect)
-(dm/export gpr/center->selrect)
-(dm/export gpr/join-rects)
-(dm/export gpr/join-selrects)
-(dm/export gpr/contains-selrect?)
-(dm/export gpr/contains-point?)
-(dm/export gpr/close-selrect?)
-(dm/export gpr/clip-selrect)
-
 (dm/export gtr/move)
 (dm/export gtr/absolute-move)
 (dm/export gtr/transform-matrix)
@@ -169,17 +173,21 @@
 (dm/export gtr/transform-bounds)
 (dm/export gtr/move-position-data)
 (dm/export gtr/apply-objects-modifiers)
+(dm/export gtr/apply-children-modifiers)
+(dm/export gtr/update-shapes-geometry)
 
 ;; 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?)
 (dm/export gsi/has-point?)
 (dm/export gsi/has-point-rect?)
 (dm/export gsi/rect-contains-shape?)
@@ -197,6 +205,3 @@
 
 ;; Modifiers
 (dm/export gsm/set-objects-modifiers)
-
-;; Text
-(dm/export gst/position-data-selrect)

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

@@ -7,32 +7,29 @@
 (ns app.common.geom.shapes.bounds
   (:require
    [app.common.data :as d]
-   [app.common.geom.shapes.rect :as gsr]
+   [app.common.data.macros :as dm]
+   [app.common.geom.rect :as grc]
    [app.common.math :as mth]
    [app.common.pages.helpers :as cph]))
 
 (defn shape-stroke-margin
   [shape stroke-width]
-  (if (= (:type shape) :path)
+  (if (cph/path-shape? shape)
     ;; TODO: Calculate with the stroke offset (not implemented yet
     (mth/sqrt (* 2 stroke-width stroke-width))
     (- (mth/sqrt (* 2 stroke-width stroke-width)) stroke-width)))
 
-(defn blur-filters [type value]
-  (->> [value]
-       (remove :hidden)
-       (filter #(= (:type %) type))
-       (map #(hash-map :id (str "filter_" (:id %))
-                       :type (:type %)
-                       :params %))))
-
-(defn shadow-filters [type filters]
-  (->> filters
-       (remove :hidden)
-       (filter #(= (:style %) type))
-       (map #(hash-map :id (str "filter_" (:id %))
-                       :type (:style %)
-                       :params %))))
+(defn- apply-filters
+  [type filters]
+  (sequence
+   (comp
+    (remove :hidden)
+    (filter #(= (:style %) type))
+    (map (fn [item]
+           {:id (dm/str "filter_" (:id item))
+            :type type
+            :params item})))
+   filters))
 
 (defn shape->filters
   [shape]
@@ -41,93 +38,112 @@
 
    ;; Background blur won't work in current SVG specification
    ;; We can revisit this in the future
-   #_(->> shape :blur   (blur-filters   :background-blur))
+   #_(->> shape :blur (into []) (blur-filters :background-blur))
 
-   (->> shape :shadow (shadow-filters :drop-shadow))
+   (->> shape :shadow (apply-filters :drop-shadow))
    [{:id "shape" :type :blend-filters}]
-   (->> shape :shadow (shadow-filters :inner-shadow))
-   (->> shape :blur   (blur-filters   :layer-blur))))
+   (->> shape :shadow (apply-filters :inner-shadow))
+   (->> shape :blur   (into []) (apply-filters :layer-blur))))
 
-(defn calculate-filter-bounds [{:keys [x y width height]} filter-entry]
-  (let [{:keys [offset-x offset-y blur spread] :or {offset-x 0 offset-y 0 blur 0 spread 0}} (:params filter-entry)
-        filter-x (min x (+ x offset-x (- spread) (- blur) -5))
-        filter-y (min y (+ y offset-y (- spread) (- blur) -5))
-        filter-width (+ width (mth/abs offset-x) (* spread 2) (* blur 2) 10)
-        filter-height (+ height (mth/abs offset-y) (* spread 2) (* blur 2) 10)]
-    (gsr/make-selrect filter-x filter-y filter-width filter-height)))
+(defn- calculate-filter-bounds
+  [selrect filter-entry]
+  (let [x (dm/get-prop selrect :x)
+        y (dm/get-prop selrect :y)
+        w (dm/get-prop selrect :width)
+        h (dm/get-prop selrect :height)
+
+        {:keys [offset-x offset-y blur spread]
+         :or {offset-x 0 offset-y 0 blur 0 spread 0}}
+        (:params filter-entry)
+
+        filter-x (mth/min x (+ x offset-x (- spread) (- blur) -5))
+        filter-y (mth/min y (+ y offset-y (- spread) (- blur) -5))
+        filter-w (+ w (mth/abs offset-x) (* spread 2) (* blur 2) 10)
+        filter-h (+ h (mth/abs offset-y) (* spread 2) (* blur 2) 10)]
+    (grc/make-rect filter-x filter-y filter-w filter-h)))
 
 (defn get-rect-filter-bounds
   [selrect filters blur-value]
-  (let [filter-bounds (->> filters
-                           (filter #(= :drop-shadow (:type %)))
-                           (map (partial calculate-filter-bounds selrect))
-                           (concat [selrect])
-                           (gsr/join-selrects))
-        delta-blur (* blur-value 2)
-
-        result
-        (-> filter-bounds
-            (update :x - delta-blur)
-            (update :y - delta-blur)
-            (update :x1 - delta-blur)
-            (update :y1 - delta-blur)
-            (update :x2 + delta-blur)
-            (update :y2 + delta-blur)
-            (update :width + (* delta-blur 2))
-            (update :height + (* delta-blur 2)))]
-
-    result))
+  (let [bounds-xf  (comp
+                    (filter #(= :drop-shadow (:type %)))
+                    (map (partial calculate-filter-bounds selrect)))
+        delta-blur (* blur-value 2)]
+    (-> (into [selrect] bounds-xf filters)
+        (grc/join-rects)
+        (update :x - delta-blur)
+        (update :y - delta-blur)
+        (update :x1 - delta-blur)
+        (update :y1 - delta-blur)
+        (update :x2 + delta-blur)
+        (update :y2 + delta-blur)
+        (update :width + (* delta-blur 2))
+        (update :height + (* delta-blur 2)))))
 
 (defn get-shape-filter-bounds
-  ([shape]
-   (let [svg-root? (and (= :svg-raw (:type shape)) (not= :svg (get-in shape [:content :tag])))]
-     (if svg-root?
-       (:selrect shape)
-
-       (let [filters (shape->filters shape)
-             blur-value (or (-> shape :blur :value) 0)]
-         (get-rect-filter-bounds (-> shape :points gsr/points->selrect) filters blur-value))))))
+  [shape]
+  (if (and (cph/svg-raw-shape? shape)
+           (not= :svg (dm/get-in shape [:content :tag])))
+    (dm/get-prop shape :selrect)
+    (let [filters    (shape->filters shape)
+          blur-value (or (-> shape :blur :value) 0)
+          srect      (-> (dm/get-prop shape :points)
+                         (grc/points->rect))]
+      (get-rect-filter-bounds srect filters blur-value))))
 
 (defn calculate-padding
   ([shape]
    (calculate-padding shape false))
-
   ([shape ignore-margin?]
-   (let [stroke-width (apply max 0 (map #(case (:stroke-alignment % :center)
-                                           :center (/ (:stroke-width % 0) 2)
-                                           :outer (:stroke-width % 0)
-                                           0) (:strokes shape)))
+   (let [strokes (:strokes shape)
 
-         margin (if ignore-margin?
-                  0
-                  (apply max 0 (map #(shape-stroke-margin % stroke-width) (:strokes shape))))
+         stroke-width
+         (->> strokes
+              (map #(case (get % :stroke-alignment :center)
+                      :center (/ (:stroke-width % 0) 2)
+                      :outer  (:stroke-width % 0)
+                      0))
+              (reduce d/max 0))
 
-         shadow-width (apply max 0 (map #(case (:style % :drop-shadow)
-                                           :drop-shadow (+ (mth/abs (:offset-x %)) (* (:spread %) 2) (* (:blur %) 2) 10)
-                                           0) (:shadow shape)))
+         margin
+         (if ignore-margin?
+           0
+           (->> strokes
+                (map #(shape-stroke-margin % stroke-width))
+                (reduce d/max 0)))
 
-         shadow-height (apply max 0 (map #(case (:style % :drop-shadow)
-                                            :drop-shadow (+ (mth/abs (:offset-y %)) (* (:spread %) 2) (* (:blur %) 2) 10)
-                                            0) (:shadow shape)))]
+         shadow-width
+         (->> (:shadow shape)
+              (map #(case (:style % :drop-shadow)
+                      :drop-shadow (+ (mth/abs (:offset-x %)) (* (:spread %) 2) (* (:blur %) 2) 10)
+                      0))
+              (reduce d/max 0))
+
+         shadow-height
+         (->> (:shadow shape)
+              (map #(case (:style % :drop-shadow)
+                      :drop-shadow (+ (mth/abs (:offset-y %)) (* (:spread %) 2) (* (:blur %) 2) 10)
+                      0))
+              (reduce d/max 0))]
 
      {:horizontal (+ stroke-width margin shadow-width)
       :vertical (+ stroke-width margin shadow-height)})))
 
 (defn- add-padding
   [bounds padding]
-  (-> bounds
-      (update :x - (:horizontal padding))
-      (update :x1 - (:horizontal padding))
-      (update :x2 + (:horizontal padding))
-      (update :y - (:vertical padding))
-      (update :y1 - (:vertical padding))
-      (update :y2 + (:vertical padding))
-      (update :width + (* 2 (:horizontal padding)))
-      (update :height + (* 2 (:vertical padding)))))
+  (let [h-padding (:horizontal padding)
+        v-padding (:vertical padding)]
+    (-> bounds
+        (update :x - h-padding)
+        (update :x1 - h-padding)
+        (update :x2 + h-padding)
+        (update :y - v-padding)
+        (update :y1 - v-padding)
+        (update :y2 + v-padding)
+        (update :width + (* 2 h-padding))
+        (update :height + (* 2 v-padding)))))
 
 (defn get-object-bounds
   [objects shape]
-
   (let [calculate-base-bounds
         (fn [shape]
           (-> (get-shape-filter-bounds shape)
@@ -138,7 +154,7 @@
           (empty? (:shapes shape))
           [(calculate-base-bounds shape)]
 
-          (:masked-group? shape)
+          (:masked-group shape)
           [(calculate-base-bounds shape)]
 
           (and (cph/frame-shape? shape) (not (:show-content shape)))
@@ -154,17 +170,15 @@
                       (:show-content shape))
 
                   (or (not (cph/group-shape? shape))
-                      (not (:masked-group? shape)))))
-
+                      (not (:masked-group shape)))))
            (:id shape)
-
            (fn [result child]
              (conj result (calculate-base-bounds child)))
 
            [(calculate-base-bounds shape)]))
 
         children-bounds
-        (cond->> (gsr/join-selrects bounds)
+        (cond->> (grc/join-rects bounds)
           (not (cph/frame-shape? shape)) (or (:children-bounds shape)))
 
         filters (shape->filters shape)

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

@@ -7,83 +7,86 @@
 (ns app.common.geom.shapes.common
   (: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.shapes.rect :as gpr]
-   [app.common.math :as mth]))
+   [app.common.geom.rect :as grc]
+   [app.common.math :as mth]
+   [app.common.record :as cr]))
 
-(defn center-rect
-  [{:keys [x y width height]}]
-  (when (d/num? x y width height)
-    (gpt/point (+ x (/ width 2.0))
-               (+ y (/ height 2.0)))))
+(def ^:private xf-keep-x (keep #(dm/get-prop % :x)))
+(def ^:private xf-keep-y (keep #(dm/get-prop % :y)))
 
-(defn center-selrect
-  "Calculate the center of the selrect."
-  [selrect]
-  (center-rect selrect))
+(defn shapes->rect
+  "Returns a rect that contains all the shapes and is aware of the
+  rotation of each shape. Mainly used for multiple selection."
+  [shapes]
+  (->> shapes
+       (keep (fn [shape]
+               (-> (dm/get-prop shape :points)
+                   (grc/points->rect))))
+       (grc/join-rects)))
 
-(defn center-points [points]
-  (let [ptx  (into [] (keep :x) points)
-        pty  (into [] (keep :y) points)
-        minx (reduce min ##Inf ptx)
-        miny (reduce min ##Inf pty)
-        maxx (reduce max ##-Inf ptx)
-        maxy (reduce max ##-Inf pty)]
+(defn points->center
+  [points]
+  (let [ptx  (into [] xf-keep-x points)
+        pty  (into [] xf-keep-y points)
+        minx (reduce d/min ##Inf ptx)
+        miny (reduce d/min ##Inf pty)
+        maxx (reduce d/max ##-Inf ptx)
+        maxy (reduce d/max ##-Inf pty)]
     (gpt/point (/ (+ minx maxx) 2.0)
                (/ (+ miny maxy) 2.0))))
 
-(defn center-bounds [[a b c d]]
-  (let [xa (:x a)
-        ya (:y a)
-        xb (:x b)
-        yb (:y b)
-        xc (:x c)
-        yc (:y c)
-        xd (:x d)
-        yd (:y d)
-        minx (min xa xb xc xd)
-        miny (min ya yb yc yd)
-        maxx (max xa xb xc xd)
-        maxy (max ya yb yc yd)]
-    (gpt/point (/ (+ minx maxx) 2.0)
-               (/ (+ miny maxy) 2.0))))
-
-(defn center-shape
+(defn shape->center
   "Calculate the center of the shape."
   [shape]
-  (center-rect (:selrect shape)))
+  (grc/rect->center (dm/get-prop shape :selrect)))
 
 (defn transform-points
   ([points matrix]
    (transform-points points nil matrix))
 
   ([points center matrix]
-   (if (and (d/not-empty? points) (gmt/matrix? matrix))
-     (let [prev (if center (gmt/translate-matrix center) (gmt/matrix))
-           post (if center (gmt/translate-matrix (gpt/negate center)) (gmt/matrix))
-
-           tr-point (fn [point]
-                      (gpt/transform point (gmt/multiply prev matrix post)))]
-       (mapv tr-point points))
+   (if (and ^boolean (gmt/matrix? matrix)
+            ^boolean (seq points))
+     (let [prev (if (some? center) (gmt/translate-matrix center) (cr/clone gmt/base))
+           post (if (some? center) (gmt/translate-matrix-neg center) gmt/base)
+           mtx  (-> prev
+                    (gmt/multiply! matrix)
+                    (gmt/multiply! post))]
+       (mapv #(gpt/transform % mtx) points))
      points)))
 
 (defn transform-selrect
-  [{:keys [x1 y1 x2 y2] :as sr} matrix]
-  (let [[c1 c2] (transform-points [(gpt/point x1 y1) (gpt/point x2 y2)] matrix)]
-    (gpr/corners->selrect c1 c2)))
+  [selrect matrix]
+
+  (dm/assert!
+   "expected valid rect and matrix instances"
+   (and (grc/rect? selrect)
+        (gmt/matrix? matrix)))
+
+  (let [x1 (dm/get-prop selrect :x1)
+        y1 (dm/get-prop selrect :y1)
+        x2 (dm/get-prop selrect :x2)
+        y2 (dm/get-prop selrect :y2)
+        p1 (gpt/point x1 y1)
+        p2 (gpt/point x2 y2)
+        c1 (gpt/transform! p1 matrix)
+        c2 (gpt/transform! p2 matrix)]
+    (grc/corners->rect c1 c2)))
 
 (defn invalid-geometry?
   [{:keys [points selrect]}]
 
-  (or (mth/nan? (:x selrect))
-      (mth/nan? (:y selrect))
-      (mth/nan? (:width selrect))
-      (mth/nan? (:height selrect))
-      (some (fn [p]
-              (or (mth/nan? (:x p))
-                  (mth/nan? (:y p))))
-            points)))
+  (or ^boolean (mth/nan? (:x selrect))
+      ^boolean (mth/nan? (:y selrect))
+      ^boolean (mth/nan? (:width selrect))
+      ^boolean (mth/nan? (:height selrect))
+      ^boolean (some (fn [p]
+                       (or ^boolean (mth/nan? (:x p))
+                           ^boolean (mth/nan? (:y p))))
+                     points)))
 
 (defn shape->points
   [{:keys [transform points]}]

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

@@ -6,7 +6,9 @@
 
 (ns app.common.geom.shapes.constraints
   (:require
+   [app.common.geom.matrix :as gmt]
    [app.common.geom.point :as gpt]
+   [app.common.geom.shapes.common :as gco]
    [app.common.geom.shapes.intersect :as gsi]
    [app.common.geom.shapes.points :as gpo]
    [app.common.geom.shapes.transforms :as gtr]
@@ -204,19 +206,22 @@
         disp-start   (displacement start-before start-after before-side-vector after-side-vector)
 
         ;; We get the current axis side and grow it on both side by the end+start displacements
-        before-vec   (side-vector axis child-points-after)
-        after-vec    (side-vector-resize axis child-points-after disp-start disp-end)
+        before-vec        (side-vector axis child-points-after)
+        after-vec         (side-vector-resize axis child-points-after disp-start disp-end)
 
         ;; after-vec will contain the side length of the grown side
         ;; we scale the shape by the diference and translate it by the start
         ;; displacement (so its left+top position is constant)
-        scale        (/ (gpt/length after-vec) (max 0.01 (gpt/length before-vec)))
+        scale             (/ (gpt/length after-vec) (mth/max 0.01 (gpt/length before-vec)))
 
-        resize-origin (gpo/origin child-points-after)
+        resize-origin     (gpo/origin child-points-after)
 
-        [_ transform transform-inverse] (gtr/calculate-geometry parent-points-after)
+        center            (gco/points->center parent-points-after)
+        selrect           (gtr/calculate-selrect parent-points-after center)
+        transform         (gtr/calculate-transform parent-points-after center selrect)
+        transform-inverse (when (some? transform) (gmt/inverse transform))
+        resize-vector     (get-scale axis scale)]
 
-        resize-vector (get-scale axis scale)]
     (-> (ctm/empty)
         (ctm/resize resize-vector resize-origin transform transform-inverse)
         (ctm/move disp-start))))
@@ -276,10 +281,13 @@
 
         resize-vector (gpt/point scale-x scale-y)
         resize-origin (gpo/origin transformed-child-bounds)
-        [_ transform transform-inverse] (gtr/calculate-geometry transformed-parent-bounds)]
 
-    (-> modifiers
-        (ctm/resize resize-vector resize-origin transform transform-inverse))))
+        center            (gco/points->center transformed-child-bounds)
+        selrect           (gtr/calculate-selrect transformed-child-bounds center)
+        transform         (gtr/calculate-transform transformed-child-bounds center selrect)
+        transform-inverse (when (some? transform) (gmt/inverse transform))]
+
+    (ctm/resize modifiers resize-vector resize-origin transform transform-inverse)))
 
 (defn calc-child-modifiers
   [parent child modifiers ignore-constraints child-bounds parent-bounds transformed-parent-bounds]

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

@@ -9,10 +9,10 @@
    [app.common.data :as d]
    [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.geom.shapes.flex-layout.lines :as fli]
    [app.common.geom.shapes.points :as gpo]
-   [app.common.geom.shapes.rect :as gsr]
    [app.common.geom.shapes.transforms :as gtr]
    [app.common.pages.helpers :as cph]
    [app.common.types.modifiers :as ctm]
@@ -59,16 +59,16 @@
 
     (if row?
       (let [half-point-width (+ (- box-x x) (/ box-width 2))]
-        [(gsr/make-rect x y width height)
-         (-> (gsr/make-rect x y half-point-width height)
+        [(grc/make-rect x y width height)
+         (-> (grc/make-rect x y half-point-width height)
              (assoc :index (if reverse? (inc index) index)))
-         (-> (gsr/make-rect (+ x half-point-width) y (- width half-point-width) height)
+         (-> (grc/make-rect (+ x half-point-width) y (- width half-point-width) height)
              (assoc :index (if reverse? index (inc index))))])
       (let [half-point-height (+ (- box-y y) (/ box-height 2))]
-        [(gsr/make-rect x y width height)
-         (-> (gsr/make-rect x y width half-point-height)
+        [(grc/make-rect x y width height)
+         (-> (grc/make-rect x y width half-point-height)
              (assoc :index (if reverse? (inc index) index)))
-         (-> (gsr/make-rect x (+ y half-point-height) width (- height half-point-height))
+         (-> (grc/make-rect x (+ y half-point-height) width (- height half-point-height))
              (assoc :index (if reverse? index (inc index))))]))))
 
 (defn drop-line-area
@@ -83,7 +83,7 @@
         v-center? (and col? (ctl/v-center? frame))
         v-end?    (and row? (ctl/v-end? frame))
 
-        center (gco/center-shape frame)
+        center (gco/shape->center frame)
         start-p (gmt/transform-point-center start-p center transform-inverse)
 
         line-width
@@ -136,7 +136,7 @@
 
                  :else
                  (+ line-height (- box-y prev-y) (/ layout-gap-row 2)))]
-    (gsr/make-rect x y width height)))
+    (grc/make-rect x y width height)))
 
 (defn layout-drop-areas
   "Retrieve the layout drop areas to move shapes inside layouts"
@@ -190,7 +190,7 @@
           (-> (ctm/empty)
               (ctm/resize (gpt/point (if flip-x -1.0 1.0)
                                      (if flip-y -1.0 1.0))
-                          (gco/center-shape shape)
+                          (gco/shape->center shape)
                           transform
                           transform-inverse))]
       [(gtr/transform-shape shape modifiers) modifiers])
@@ -212,6 +212,6 @@
   [frame-id objects position]
   (let [frame       (get objects frame-id)
         drop-areas  (get-drop-areas frame objects)
-        position    (gmt/transform-point-center position (gco/center-shape frame) (:transform-inverse frame))
-        area        (d/seek #(gsr/contains-point? % position) drop-areas)]
+        position    (gmt/transform-point-center position (gco/shape->center frame) (:transform-inverse frame))
+        area        (d/seek #(grc/contains-point? % position) drop-areas)]
     (:index area)))

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

@@ -15,9 +15,8 @@
 (def conjv (fnil conj []))
 
 (defn layout-bounds
-  [{:keys [layout-padding] :as shape} shape-bounds]
-  (let [;; Add padding to the bounds
-        {pad-top :p1 pad-right :p2 pad-bottom :p3 pad-left :p4} layout-padding]
+  [parent shape-bounds]
+  (let [[pad-top pad-right pad-bottom pad-left] (ctl/paddings parent)]
     (gpo/pad-points shape-bounds pad-top pad-right pad-bottom pad-left)))
 
 (defn init-layout-lines

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

@@ -63,8 +63,7 @@
       {:height target-height
        :modifiers (ctm/resize-modifiers (gpt/point 1 fill-scale) child-origin transform transform-inverse)})))
 
-(defn layout-child-modifiers
-  "Calculates the modifiers for the layout"
+(defn fill-modifiers
   [parent parent-bounds child child-bounds layout-line]
   (let [child-origin (gpo/origin child-bounds)
         child-width  (gpo/width-points child-bounds)
@@ -83,15 +82,27 @@
           (calc-fill-height-data parent transform transform-inverse child child-origin child-height layout-line))
 
         child-width (or (:width fill-width) child-width)
-        child-height (or (:height fill-height) child-height)
+        child-height (or (:height fill-height) child-height)]
+
+    [child-width
+     child-height
+     (-> (ctm/empty)
+         (cond-> fill-width (ctm/add-modifiers (:modifiers fill-width)))
+         (cond-> fill-height (ctm/add-modifiers (:modifiers fill-height))))]))
+
+(defn layout-child-modifiers
+  "Calculates the modifiers for the layout"
+  [parent parent-bounds child child-bounds layout-line]
+  (let [child-origin (gpo/origin child-bounds)
+
+        [child-width child-height fill-modifiers]
+        (fill-modifiers parent parent-bounds child child-bounds layout-line)
 
         [corner-p layout-line] (fpo/get-child-position parent child child-width child-height layout-line)
-
         move-vec (gpt/to-vec child-origin corner-p)
 
         modifiers
         (-> (ctm/empty)
-            (cond-> fill-width (ctm/add-modifiers (:modifiers fill-width)))
-            (cond-> fill-height (ctm/add-modifiers (:modifiers fill-height)))
+            (ctm/add-modifiers fill-modifiers)
             (ctm/move move-vec))]
     [modifiers layout-line]))

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

@@ -7,13 +7,15 @@
 (ns app.common.geom.shapes.grid-layout
   (:require
    [app.common.data.macros :as dm]
+   [app.common.geom.shapes.grid-layout.bounds :as glpb]
    [app.common.geom.shapes.grid-layout.layout-data :as glld]
    [app.common.geom.shapes.grid-layout.positions :as glp]))
 
 (dm/export glld/calc-layout-data)
 (dm/export glld/get-cell-data)
 (dm/export glp/child-modifiers)
-
-(defn get-drop-index
-  [frame objects _position]
-  (dec (count (get-in objects [frame :shapes]))))
+(dm/export glp/get-position-grid-coord)
+(dm/export glp/get-drop-cell)
+(dm/export glp/cell-bounds)
+(dm/export glpb/layout-content-points)
+(dm/export glpb/layout-content-bounds)

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

@@ -0,0 +1,95 @@
+;; 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
+
+;; Based on the code in:
+;; https://en.wikibooks.org/wiki/Algorithm_Implementation/Geometry/Rectangle_difference
+(ns app.common.geom.shapes.grid-layout.areas
+  (:refer-clojure :exclude [contains?]))
+
+(defn area->cell-props [[column row column-span row-span]]
+  {:row row
+   :column column
+   :row-span row-span
+   :column-span column-span})
+
+(defn make-area
+  ([{:keys [column row column-span row-span]}]
+   (make-area column row column-span row-span))
+  ([x y width height]
+   [x y width height]))
+
+(defn contains?
+  [[a-x a-y a-width a-height :as a]
+   [b-x b-y b-width b-height :as b]]
+  (and (>= b-x a-x)
+       (>= b-y a-y)
+       (<= (+ b-x b-width) (+ a-x a-width))
+       (<= (+ b-y b-height) (+ a-y a-height))))
+
+(defn intersects?
+  [[a-x a-y a-width a-height ]
+   [b-x b-y b-width b-height]]
+  (not (or (<= (+ b-x b-width) a-x)
+           (<= (+ b-y b-height) a-y)
+           (>= b-x (+ a-x a-width))
+           (>= b-y (+ a-y a-height)))))
+
+(defn top-rect
+  [[a-x a-y a-width _]
+   [_ b-y _ _]]
+  (let [height (- b-y a-y)]
+    (when (> height 0)
+      (make-area a-x a-y a-width height))))
+
+(defn bottom-rect
+  [[a-x a-y a-width a-height]
+   [_ b-y _ b-height]]
+
+  (let [y (+ b-y b-height)
+        height (- a-height (- y a-y))]
+    (when (and (> height 0) (< y (+ a-y a-height)))
+      (make-area a-x y a-width height))))
+
+(defn left-rect
+  [[a-x a-y _ a-height]
+   [b-x b-y _ b-height]]
+
+  (let [rb-y (+ b-y b-height)
+        ra-y (+ a-y a-height)
+        y1 (max a-y b-y)
+        y2 (min ra-y rb-y)
+        height (- y2 y1)
+        width (- b-x a-x)]
+    (when (and (> width 0) (> height 0))
+      (make-area a-x y1 width height))))
+
+(defn right-rect
+  [[a-x a-y a-width a-height]
+   [b-x b-y b-width b-height]]
+
+  (let [rb-y (+ b-y b-height)
+        ra-y (+ a-y a-height)
+        y1 (max a-y b-y)
+        y2 (min ra-y rb-y)
+        height (- y2 y1)
+        rb-x (+ b-x b-width)
+        width (- a-width (- rb-x a-x))
+        ]
+    (when (and (> width 0) (> height 0))
+      (make-area rb-x y1 width height)))
+  )
+
+(defn difference
+  [area-a area-b]
+  (if (or (nil? area-b)
+          (not (intersects? area-a area-b))
+          (contains? area-b area-a))
+    []
+
+    (into []
+          (keep #(% area-a area-b))
+          [top-rect left-rect right-rect bottom-rect])))
+ 

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

@@ -0,0 +1,53 @@
+;; 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.grid-layout.bounds
+  (:require
+   [app.common.data :as d]
+   [app.common.geom.point :as gpt]
+   [app.common.geom.shapes.grid-layout.layout-data :as ld]
+   [app.common.geom.shapes.points :as gpo]))
+
+(defn layout-content-points
+  [bounds parent children]
+  (let [parent-id (:id parent)
+        parent-bounds @(get bounds parent-id)
+
+        hv #(gpo/start-hv parent-bounds %)
+        vv #(gpo/start-vv parent-bounds %)
+
+        children (->> children
+                      (map #(vector @(get bounds (:id %)) %)))
+
+        {:keys [row-tracks column-tracks]} (ld/calc-layout-data parent children parent-bounds)]
+    (d/concat-vec
+     (->> row-tracks
+          (mapcat #(vector (:start-p %)
+                           (gpt/add (:start-p %) (vv (:size %))))))
+     (->> column-tracks
+          (mapcat #(vector (:start-p %)
+                           (gpt/add (:start-p %) (hv (:size %)))))))))
+
+(defn layout-content-bounds
+  [bounds {:keys [layout-padding] :as parent} children]
+
+  (let [parent-id (:id parent)
+        parent-bounds @(get bounds parent-id)
+        
+        {pad-top :p1 pad-right :p2 pad-bottom :p3 pad-left :p4} layout-padding
+        pad-top    (or pad-top 0)
+        pad-right  (or pad-right 0)
+        pad-bottom (or pad-bottom 0)
+        pad-left   (or pad-left 0)
+        
+        layout-points (layout-content-points bounds parent children)]
+
+    (if (d/not-empty? layout-points)
+      (-> layout-points
+          (gpo/merge-parent-coords-bounds parent-bounds)
+          (gpo/pad-points (- pad-top) (- pad-right) (- pad-bottom) (- pad-left)))
+      ;; Cannot create some bounds from the children so we return the parent's
+      parent-bounds)))

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

@@ -4,137 +4,583 @@
 ;;
 ;; Copyright (c) KALEIDOS INC
 
+;;   Each track has specified minimum and maximum sizing functions (which may be the same)
+;;   - Fixed
+;;   - Percent
+;;   - Auto
+;;   - Flex
+;;
+;;   Min functions:
+;;   - Fixed: value
+;;   - Percent: value to pixels
+;;   - Auto: auto
+;;   - Flex: auto
+;;
+;;   Max functions:
+;;   - Fixed: value
+;;   - Percent: value to pixels
+;;   - Auto: max-content
+;;   - Flex: flex
+
+;; Algorithm
+;; - Initialize tracks:
+;;   * base = size or 0
+;;   * max = size or INF
+;;
+;; - Resolve intrinsic sizing
+;;   1. Shim baseline-aligned items so their intrinsic size contributions reflect their baseline alignment
+;;
+;;   2. Size tracks to fit non-spanning items
+;;   base-size = max (children min contribution) floored 0
+;;
+;;   3. Increase sizes to accommodate spanning items crossing content-sized tracks
+;;
+;;   4. Increase sizes to accommodate spanning items crossing flexible tracks:
+;;
+;;   5. If any track still has an infinite growth limit set its growth limit to its base size.
+
+;;   - Distribute extra space accross spaned tracks
+;; - Maximize tracks
+;;
+;; - Expand flexible tracks
+;;   - Find `fr` size
+;;
+;; - Stretch auto tracks
+
 (ns app.common.geom.shapes.grid-layout.layout-data
   (:require
+   [app.common.data :as d]
    [app.common.geom.point :as gpt]
-   [app.common.geom.shapes.points :as gpo]))
+   [app.common.geom.shapes.points :as gpo]
+   [app.common.math :as mth]
+   [app.common.types.shape.layout :as ctl]))
 
-#_(defn set-sample-data
-  [parent children]
+(defn layout-bounds
+  [parent shape-bounds]
+  (let [[pad-top pad-right pad-bottom pad-left] (ctl/paddings parent)]
+    (gpo/pad-points shape-bounds pad-top pad-right pad-bottom pad-left)))
 
-  (let [parent (assoc parent
-                      :layout-grid-columns
-                      [{:type :percent :value 25}
-                       {:type :percent :value 25}
-                       {:type :fixed :value 100}
-                       ;;{:type :auto}
-                       ;;{:type :flex :value 1}
-                       ]
+(defn child-min-width
+  [child bounds]
+  (+ (if (ctl/fill-width? child)
+       (ctl/child-min-width child)
+       (gpo/width-points bounds))
+     (ctl/child-width-margin child)))
 
-                      :layout-grid-rows
-                      [{:type :percent :value 50}
-                       {:type :percent :value 50}
-                       ;;{:type :fixed :value 100}
-                       ;;{:type :auto}
-                       ;;{:type :flex :value 1}
-                       ])
+(defn child-min-height
+  [child bounds]
+  (+ (if (ctl/fill-height? child)
+       (ctl/child-min-height child)
+       (gpo/height-points bounds))
+     (ctl/child-height-margin child)))
 
-        num-rows (count (:layout-grid-rows parent))
-        num-columns (count (:layout-grid-columns parent))
+(defn calculate-initial-track-size
+  [total-value {:keys [type value] :as track}]
 
-        layout-grid-cells
-        (into
-         {}
-         (for [[row-idx _row] (d/enumerate (:layout-grid-rows parent))
-               [col-idx _col] (d/enumerate (:layout-grid-columns parent))]
-           (let [[_bounds shape] (nth children (+ (* row-idx num-columns) col-idx) nil)
-                 cell-data {:id (uuid/next)
-                            :row (inc row-idx)
-                            :column (inc col-idx)
-                            :row-span 1
-                            :col-span 1
-                            :shapes (when shape [(:id shape)])}]
-             [(:id cell-data) cell-data])))
+  (let [[size max-size]
+        (case type
+          :percent
+          (let [value (/ (* total-value value) 100) ]
+            [value value])
 
-        parent (assoc parent :layout-grid-cells layout-grid-cells)]
+          :fixed
+          [value value]
 
-    [parent children]))
+          ;; flex, auto
+          [0.01 ##Inf])]
+    (assoc track :size size :max-size max-size)))
 
-(defn calculate-initial-track-values
-  [{:keys [type value]} total-value]
+(defn set-auto-base-size
+  [track-list children shape-cells type]
 
-  (case type
-    :percent
-    (let [value (/ (* total-value value) 100) ]
-      value)
+  (let [[prop prop-span size-fn]
+        (if (= type :column)
+           [:column :column-span child-min-width]
+           [:row :row-span child-min-height])]
 
-    :fixed
-    value
+    (reduce (fn [tracks [child-bounds child-shape]]
+              (let [cell (get shape-cells (:id child-shape))
+                    idx (dec (get cell prop))
+                    track (get tracks idx)]
+                (cond-> tracks
+                  (and (= (get cell prop-span) 1)
+                       (contains? #{:flex :auto} (:type track)))
+                  (update-in [idx :size] max (size-fn child-shape child-bounds)))))
+            track-list
+            children)))
 
-    :auto
-    0
-    ))
+(defn tracks-total-size
+  [track-list]
+  (let [calc-tracks-total-size
+        (fn [acc {:keys [size]}]
+          (+ acc size))]
+    (->> track-list (reduce calc-tracks-total-size 0))))
+
+(defn tracks-total-frs
+  [track-list]
+  (let [calc-tracks-total-frs
+        (fn [acc {:keys [type value]}]
+          (let [value (max 1 value)]
+            (cond-> acc
+              (= type :flex)
+              (+ value))))]
+    (->> track-list (reduce calc-tracks-total-frs 0))))
+
+(defn tracks-total-autos
+  [track-list]
+  (let [calc-tracks-total-autos
+        (fn [acc {:keys [type]}]
+          (cond-> acc (= type :auto) (inc)))]
+    (->> track-list (reduce calc-tracks-total-autos 0))))
+
+
+(defn set-fr-value
+  "Tries to assign the fr value distributing the excess between the free spaces"
+  [track-list fr-value auto?]
+
+  (let [flex? #(= :flex (:type (second %)))
+
+        ;; Fixes the assignments so they respect the min size constraint
+        ;; returns pending with the necessary space to allocate and free-frs
+        ;; are the addition of the fr tracks with free space
+        assign-fn
+        (fn [[assign-fr pending free-frs] [idx t]]
+          (let [fr (:value t)
+                current (get assign-fr idx (* fr-value fr))
+                full? (<=  current (:size t))
+                cur-pending (if full? (- (:size t) current) 0)]
+            [(assoc assign-fr idx (if full? (:size t) current))
+             (+ pending cur-pending)
+             (cond-> free-frs (not full?) (+ fr))]))
+
+        ;; Sets the assigned-fr map removing the pending/free-frs
+        change-fn
+        (fn [delta]
+          (fn [assign-fr [idx t]]
+            (let [fr (:value t)
+                  current (get assign-fr idx)
+                  full? (<=  current (:size t))]
+              (cond-> assign-fr
+                (not full?)
+                (update idx - (* delta fr))))))
+
+        assign-fr
+        (loop [assign-fr {}]
+          (let [[assign-fr pending free-frs]
+                (->> (d/enumerate track-list)
+                     (filter flex?)
+                     (reduce assign-fn [assign-fr 0 0]))]
+
+            ;; When auto, we don't need to remove the excess
+            (if (or auto?
+                    (= free-frs 0)
+                    (mth/almost-zero? pending))
+              assign-fr
+
+              (let [delta (/ pending free-frs)
+                    assign-fr
+                    (->> (d/enumerate track-list)
+                         (filter flex?)
+                         (reduce (change-fn delta) assign-fr))]
+
+                (recur assign-fr)))))
+
+        ;; Apply assign-fr to the track-list
+        track-list
+        (reduce
+         (fn [track-list [idx assignment] ]
+           (-> track-list
+               (update-in [idx :size] max assignment)))
+         track-list
+         assign-fr)]
+
+    track-list))
+
+(defn add-auto-size
+  [track-list add-size]
+  (->> track-list
+       (mapv (fn [{:keys [type size max-size] :as track}]
+               (cond-> track
+                 (= :auto type)
+                 (assoc :size (min (+ size add-size) max-size)))))))
+
+(defn has-flex-track?
+  [type track-list cell]
+  (let [[prop prop-span]
+        (if (= type :column)
+          [:column :column-span]
+          [:row :row-span])
+        from-idx (dec (get cell prop))
+        to-idx (+ (dec (get cell prop)) (get cell prop-span))
+        tracks (subvec track-list from-idx to-idx)]
+    (some? (->> tracks (d/seek #(= :flex (:type %)))))))
+
+(defn size-to-allocate
+  [type parent [child-bounds child] cell]
+  (let [[row-gap column-gap] (ctl/gaps parent)
+        [sfn gap prop-span]
+        (if (= type :column)
+          [child-min-width column-gap :column-span]
+          [child-min-height row-gap :row-span])
+        span (get cell prop-span)]
+    (- (sfn child child-bounds) (* gap (dec span)))))
+
+(defn allocate-auto-tracks
+  [allocations indexed-tracks to-allocate]
+  (if (empty? indexed-tracks)
+    allocations
+    (let [[idx track] (first indexed-tracks)
+          old-allocated (get allocations idx 0.01)
+          auto-track? (= :auto (:type track))
+
+          allocated (if auto-track?
+                      (max old-allocated
+                           (/ to-allocate (count indexed-tracks))
+                           (:size track))
+                      (:size track))]
+      (recur (cond-> allocations
+               auto-track?
+               (assoc idx allocated))
+             (rest indexed-tracks)
+             (- to-allocate allocated)))))
+
+(defn allocate-flex-tracks
+  [allocations indexed-tracks to-allocate fr-value]
+  (if (empty? indexed-tracks)
+    allocations
+    (let [[idx track] (first indexed-tracks)
+          old-allocated (get allocations idx 0.01)
+
+          auto-track? (= :auto (:type track))
+          flex-track? (= :flex (:type track))
+
+          fr (if flex-track? (:value track) 0)
+
+          target-allocation (* fr-value fr)
+
+          allocated (if (or auto-track? flex-track?)
+                      (max target-allocation
+                           old-allocated
+                           (:size track))
+                      (:size track))]
+      (recur (cond-> allocations (or flex-track? auto-track?)
+                     (assoc idx allocated))
+             (rest indexed-tracks)
+             (- to-allocate allocated)
+             fr-value))))
+
+(defn set-auto-multi-span
+  [parent track-list children-map shape-cells type]
+
+  (let [[prop prop-span]
+        (if (= type :column)
+          [:column :column-span]
+          [:row :row-span])
+
+        ;; First calculate allocation without applying so we can modify them on the following tracks
+        allocated
+        (->> shape-cells
+             (vals)
+             (filter #(> (get % prop-span) 1))
+             (remove #(has-flex-track? type track-list %))
+             (sort-by prop-span -)
+             (reduce
+              (fn [allocated cell]
+                (let [shape-id (first (:shapes cell))
+
+                      from-idx (dec (get cell prop))
+                      to-idx (+ (dec (get cell prop)) (get cell prop-span))
+
+                      indexed-tracks (subvec (d/enumerate track-list) from-idx to-idx)
+                      to-allocate (size-to-allocate type parent (get children-map shape-id) cell)
+
+                      ;; Remove the size and the tracks that are not allocated
+                      [to-allocate indexed-tracks]
+                      (->> indexed-tracks
+                           (reduce (fn find-auto-allocations
+                                     [[to-allocate result] [_ track :as idx-track]]
+                                     (if (= :auto (:type track))
+                                       ;; If auto, we don't change allocate and add the track
+                                       [to-allocate (conj result idx-track)]
+                                       ;; If fixed, we remove from allocate and don't add the track
+                                       [(- to-allocate (:size track)) result]))
+                                   [to-allocate []]))]
+                  (allocate-auto-tracks allocated indexed-tracks (max to-allocate 0))))
+              {}))
+
+        ;; Apply the allocations to the tracks
+        track-list
+        (into []
+              (map-indexed #(update %2 :size max (get allocated %1)))
+              track-list)]
+    track-list))
+
+(defn set-flex-multi-span
+  [parent track-list children-map shape-cells type]
+
+  (let [[prop prop-span]
+        (if (= type :column)
+          [:column :column-span]
+          [:row :row-span])
+
+        ;; First calculate allocation without applying so we can modify them on the following tracks
+        allocate-fr-tracks
+        (->> shape-cells
+             (vals)
+             (filter #(> (get % prop-span) 1))
+             (filter #(has-flex-track? type track-list %))
+             (sort-by prop-span -)
+             (reduce
+              (fn [alloc cell]
+                (let [shape-id (first (:shapes cell))
+                      from-idx (dec (get cell prop))
+                      to-idx (+ (dec (get cell prop)) (get cell prop-span))
+                      indexed-tracks (subvec (d/enumerate track-list) from-idx to-idx)
+
+                      to-allocate (size-to-allocate type parent (get children-map shape-id) cell)
+
+                      ;; Remove the size and the tracks that are not allocated
+                      [to-allocate total-frs indexed-tracks]
+                      (->> indexed-tracks
+                           (reduce (fn find-lex-allocations
+                                     [[to-allocate total-fr result] [_ track :as idx-track]]
+                                     (if (= :flex (:type track))
+                                       ;; If flex, we don't change allocate and add the track
+                                       [to-allocate (+ total-fr (:value track)) (conj result idx-track)]
+
+                                       ;; If fixed or auto, we remove from allocate and don't add the track
+                                       [(- to-allocate (:size track)) total-fr result]))
+                                   [to-allocate 0 []]))
+
+                      to-allocate (max to-allocate 0)
+                      fr-value (/ to-allocate total-frs)]
+                  (allocate-flex-tracks alloc indexed-tracks to-allocate fr-value)))
+              {}))
+
+        ;; Apply the allocations to the tracks
+        track-list
+        (into []
+              (map-indexed #(update %2 :size max (get allocate-fr-tracks %1)))
+              track-list)]
+    track-list))
+
+(defn min-fr-value
+  [tracks]
+  (loop [tracks (seq tracks)
+         min-fr 0.01]
+    (if (empty? tracks)
+      min-fr
+      (let [{:keys [size type value]} (first tracks)
+            min-fr (if (= type :flex) (max min-fr (/ size value)) min-fr)]
+        (recur (rest tracks) min-fr)))))
 
 (defn calc-layout-data
-  [parent _children transformed-parent-bounds]
+  [parent children transformed-parent-bounds]
 
-  (let [height (gpo/height-points transformed-parent-bounds)
-        width  (gpo/width-points transformed-parent-bounds)
+  (let [hv     #(gpo/start-hv transformed-parent-bounds %)
+        vv     #(gpo/start-vv transformed-parent-bounds %)
 
-        ;; Initialize tracks
-        column-tracks
-        (->> (:layout-grid-columns parent)
-             (map (fn [track]
-                    (let [initial (calculate-initial-track-values track width)]
-                      (assoc track :value initial)))))
+        layout-bounds (layout-bounds parent transformed-parent-bounds)
 
-        row-tracks
-        (->> (:layout-grid-rows parent)
-             (map (fn [track]
-                    (let [initial (calculate-initial-track-values track height)]
-                      (assoc track :value initial)))))
+        bound-height (gpo/height-points layout-bounds)
+        bound-width  (gpo/width-points layout-bounds)
+        bound-corner (gpo/origin layout-bounds)
 
-        ;; Go through cells to adjust auto sizes
+        [row-gap column-gap] (ctl/gaps parent)
+        auto-height? (ctl/auto-height? parent)
+        auto-width? (ctl/auto-width? parent)
 
+        {:keys [layout-grid-columns layout-grid-rows layout-grid-cells]} parent
+        num-columns (count layout-grid-columns)
+        num-rows (count layout-grid-rows)
 
-        ;; Once auto sizes have been calculated we get calculate the `fr` with the remainining size and adjust the size
-
-
-        ;; Adjust final distances
-
-        acc-track-distance
-        (fn [[result next-distance] data]
-          (let [result (conj result (assoc data :distance next-distance))
-                next-distance (+ next-distance (:value data))]
-            [result next-distance]))
-
-        column-tracks
-        (->> column-tracks
-             (reduce acc-track-distance [[] 0])
-             first)
-
-        row-tracks
-        (->> row-tracks
-             (reduce acc-track-distance [[] 0])
-             first)
+        column-total-gap  (* column-gap (dec num-columns))
+        row-total-gap     (* row-gap (dec num-rows))
 
+        ;; Map shape->cell
         shape-cells
         (into {}
               (mapcat (fn [[_ cell]]
-                        (->> (:shapes cell)
-                             (map #(vector % cell)))))
-              (:layout-grid-cells parent))
-        ]
+                        (->> (:shapes cell) (map #(vector % cell)))))
+              layout-grid-cells)
 
-    {:row-tracks row-tracks
+        children (->> children (remove #(ctl/layout-absolute? (second %))))
+        children-map
+        (into {}
+              (map #(vector (:id (second %)) %))
+              children)
+
+        ;; Initialize tracks
+        column-tracks
+        (->> layout-grid-columns
+             (mapv (partial calculate-initial-track-size bound-width)))
+
+        row-tracks
+        (->> layout-grid-rows
+             (mapv (partial calculate-initial-track-size bound-height)))
+
+        ;; Go through cells to adjust auto sizes for span=1. Base is the max of its children
+        column-tracks (set-auto-base-size column-tracks children shape-cells :column)
+        row-tracks    (set-auto-base-size row-tracks children shape-cells :row)
+
+        ;; Adjust multi-spaned cells with no flex columns
+        column-tracks (set-auto-multi-span parent column-tracks children-map shape-cells :column)
+        row-tracks (set-auto-multi-span parent row-tracks children-map shape-cells :row)
+
+        ;; Calculate the `fr` unit and adjust the size
+        column-total-size-nofr (tracks-total-size (->> column-tracks (remove #(= :flex (:type %)))))
+        row-total-size-nofr    (tracks-total-size (->> row-tracks (remove #(= :flex (:type %)))))
+
+        column-frs        (tracks-total-frs column-tracks)
+        row-frs           (tracks-total-frs row-tracks)
+
+        ;; Assign minimum size to the multi-span flex tracks. We do this after calculating
+        ;; the fr size because will affect only the minimum. The maximum will be set by the
+        ;; fracion
+        column-tracks (set-flex-multi-span parent column-tracks children-map shape-cells :column)
+        row-tracks (set-flex-multi-span parent row-tracks children-map shape-cells :row)
+
+        ;; Once auto sizes have been calculated we get calculate the `fr` unit with the remainining size and adjust the size
+        free-column-space (max 0 (- bound-width (+ column-total-size-nofr column-total-gap)))
+        free-row-space    (max 0 (- bound-height (+ row-total-size-nofr row-total-gap)))
+
+        ;; Get the minimum values for fr's
+        min-column-fr     (min-fr-value column-tracks)
+        min-row-fr        (min-fr-value row-tracks)
+
+        column-fr         (if auto-width? min-column-fr (mth/finite (/ free-column-space column-frs) 0))
+        row-fr            (if auto-height? min-row-fr (mth/finite (/ free-row-space row-frs) 0))
+
+        column-tracks     (set-fr-value column-tracks column-fr auto-width?)
+        row-tracks        (set-fr-value row-tracks row-fr auto-height?)
+
+        ;; Distribute free space between `auto` tracks
+        column-total-size (tracks-total-size column-tracks)
+        row-total-size    (tracks-total-size row-tracks)
+
+        free-column-space (max 0 (if auto-width? 0 (- bound-width (+ column-total-size column-total-gap))))
+        free-row-space    (max 0 (if auto-height? 0 (- bound-height (+ row-total-size row-total-gap))))
+        column-autos      (tracks-total-autos column-tracks)
+        row-autos         (tracks-total-autos row-tracks)
+
+        column-add-auto   (/ free-column-space column-autos)
+        row-add-auto      (/ free-row-space row-autos)
+
+        column-tracks (cond-> column-tracks
+                        (= :stretch (:layout-justify-content parent))
+                        (add-auto-size column-add-auto))
+
+        row-tracks    (cond-> row-tracks
+                        (= :stretch (:layout-align-content parent))
+                        (add-auto-size row-add-auto))
+
+        column-total-size (tracks-total-size column-tracks)
+        row-total-size    (tracks-total-size row-tracks)
+
+        num-columns (count column-tracks)
+        column-gap
+        (case (:layout-justify-content parent)
+          auto-width?
+          column-gap
+
+          :space-evenly
+          (max column-gap (/ (- bound-width column-total-size) (inc num-columns)))
+
+          :space-around
+          (max column-gap (/ (- bound-width column-total-size) num-columns))
+
+          :space-between
+          (max column-gap (if (= num-columns 1) column-gap (/ (- bound-width column-total-size) (dec num-columns))))
+
+          column-gap)
+
+        num-rows (count row-tracks)
+        row-gap
+        (case (:layout-align-content parent)
+          auto-height?
+          row-gap
+
+          :space-evenly
+          (max row-gap (/ (- bound-height row-total-size) (inc num-rows)))
+
+          :space-around
+          (max row-gap (/ (- bound-height row-total-size) num-rows))
+
+          :space-between
+          (max row-gap (if (= num-rows 1) row-gap (/ (- bound-height row-total-size) (dec num-rows))))
+
+          row-gap)
+
+        start-p
+        (cond-> bound-corner
+          (and (not auto-width?) (= :end (:layout-justify-content parent)))
+          (gpt/add (hv (- bound-width (+ column-total-size column-total-gap))))
+
+          (and (not auto-width?) (= :center (:layout-justify-content parent)))
+          (gpt/add (hv (/ (- bound-width (+ column-total-size column-total-gap)) 2)))
+
+          (and (not auto-height?) (= :end (:layout-align-content parent)))
+          (gpt/add (vv (- bound-height (+ row-total-size row-total-gap))))
+
+          (and (not auto-height?) (= :center (:layout-align-content parent)))
+          (gpt/add (vv (/ (- bound-height (+ row-total-size row-total-gap)) 2)))
+
+          (and (not auto-width?) (= :space-around (:layout-justify-content parent)))
+          (gpt/add (hv (/ column-gap 2)))
+
+          (and (not auto-width?) (= :space-evenly (:layout-justify-content parent)))
+          (gpt/add (hv column-gap))
+
+          (and (not auto-height?) (= :space-around (:layout-align-content parent)))
+          (gpt/add (vv (/ row-gap 2)))
+
+          (and (not auto-height?) (= :space-evenly (:layout-align-content parent)))
+          (gpt/add (vv row-gap)))
+
+        column-tracks
+        (->> column-tracks
+             (reduce (fn [[tracks start-p] {:keys [size] :as track}]
+                       [(conj tracks (assoc track :start-p start-p))
+                        (gpt/add start-p (hv (+ size column-gap)))])
+                     [[] start-p])
+             (first))
+
+        row-tracks
+        (->> row-tracks
+             (reduce (fn [[tracks start-p] {:keys [size] :as track}]
+                       [(conj tracks (assoc track :start-p start-p))
+                        (gpt/add start-p (vv (+ size row-gap)))])
+                     [[] start-p])
+             (first))]
+
+    {:origin start-p
+     :layout-bounds layout-bounds
+     :row-tracks row-tracks
      :column-tracks column-tracks
-     :shape-cells shape-cells}))
+     :shape-cells shape-cells
+     :column-gap column-gap
+     :row-gap row-gap
+
+     ;; Convenient informaton for visualization
+     :column-total-size column-total-size
+     :column-total-gap column-total-gap
+     :row-total-size row-total-size
+     :row-total-gap row-total-gap}))
 
 (defn get-cell-data
-  [{:keys [row-tracks column-tracks shape-cells]} transformed-parent-bounds [_child-bounds child]]
-
-  (let [origin (gpo/origin transformed-parent-bounds)
-        hv     #(gpo/start-hv transformed-parent-bounds %)
-        vv     #(gpo/start-vv transformed-parent-bounds %)
-
-        grid-cell (get shape-cells (:id child))]
+  [{:keys [origin row-tracks column-tracks shape-cells]} _transformed-parent-bounds [_ child]]
 
+  (let [grid-cell (get shape-cells (:id child))]
     (when (some? grid-cell)
       (let [column (nth column-tracks (dec (:column grid-cell)) nil)
             row (nth row-tracks (dec (:row grid-cell)) nil)
 
-            start-p (-> origin
-                        (gpt/add (hv (:distance column)))
-                        (gpt/add (vv (:distance row))))]
+            column-start-p (:start-p column)
+            row-start-p (:start-p row)
+
+            start-p (gpt/add origin
+                             (gpt/add
+                              (gpt/to-vec origin column-start-p)
+                              (gpt/to-vec origin row-start-p)))]
 
         (assoc grid-cell :start-p  start-p)))))

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

@@ -6,11 +6,250 @@
 
 (ns app.common.geom.shapes.grid-layout.positions
   (:require
+   [app.common.data :as d]
+   [app.common.data.macros :as dm]
    [app.common.geom.point :as gpt]
+   [app.common.geom.shapes.grid-layout.layout-data :as ld]
    [app.common.geom.shapes.points :as gpo]
-   [app.common.types.modifiers :as ctm]))
+   [app.common.geom.shapes.transforms :as gtr]
+   [app.common.math :as mth]
+   [app.common.pages.helpers :as cph]
+   [app.common.types.modifiers :as ctm]
+   [app.common.types.shape.layout :as ctl]))
+
+(defn cell-bounds
+  "Retrieves the points that define the bounds for given cell"
+  [{:keys [origin row-tracks column-tracks layout-bounds column-gap row-gap] :as layout-data} {:keys [row column row-span column-span] :as cell}]
+
+  (let [hv     #(gpo/start-hv layout-bounds %)
+        vv     #(gpo/start-vv layout-bounds %)
+
+        span-column-tracks (subvec column-tracks (dec column) (+ (dec column) column-span))
+        span-row-tracks (subvec row-tracks (dec row) (+ (dec row) row-span))
+
+        p1
+        (gpt/add
+         origin
+         (gpt/add
+          (gpt/to-vec origin (dm/get-in span-column-tracks [0 :start-p]))
+          (gpt/to-vec origin (dm/get-in span-row-tracks [0 :start-p]))))
+
+        p2
+        (as-> p1  $
+          (reduce (fn [p track] (gpt/add p (hv (:size track)))) $ span-column-tracks)
+          (gpt/add $ (hv (* column-gap (dec (count span-column-tracks))))))
+
+        p3
+        (as-> p2  $
+          (reduce (fn [p track] (gpt/add p (vv (:size track)))) $ span-row-tracks)
+          (gpt/add $ (vv (* row-gap (dec (count span-row-tracks))))))
+
+        p4
+        (as-> p1  $
+          (reduce (fn [p track] (gpt/add p (vv (:size track)))) $ span-row-tracks)
+          (gpt/add $ (vv (* row-gap (dec (count span-row-tracks))))))]
+
+    [p1 p2 p3 p4]))
+
+(defn calc-fill-width-data
+  "Calculates the size and modifiers for the width of an auto-fill child"
+  [_parent
+   transform
+   transform-inverse
+   child
+   child-origin child-width
+   cell-bounds]
+
+  (let [target-width (max (- (gpo/width-points cell-bounds) (ctl/child-width-margin child)) 0.01)
+        max-width (max (ctl/child-max-width child) 0.01)
+        target-width (mth/clamp target-width (ctl/child-min-width child) max-width)
+        fill-scale (/ target-width child-width)]
+    {:width target-width
+     :modifiers (ctm/resize-modifiers (gpt/point fill-scale 1) child-origin transform transform-inverse)}))
+
+(defn calc-fill-height-data
+  "Calculates the size and modifiers for the height of an auto-fill child"
+  [_parent
+   transform transform-inverse
+   child
+   child-origin child-height
+   cell-bounds]
+  (let [target-height (max (- (gpo/height-points cell-bounds) (ctl/child-height-margin child)) 0.01)
+        max-height (max (ctl/child-max-height child) 0.01)
+        target-height (mth/clamp target-height (ctl/child-min-height child) max-height)
+        fill-scale (/ target-height child-height)]
+    {:height target-height
+     :modifiers (ctm/resize-modifiers (gpt/point 1 fill-scale) child-origin transform transform-inverse)}))
+
+(defn fill-modifiers
+  [parent parent-bounds child child-bounds layout-data cell-data]
+  (let [child-origin (gpo/origin child-bounds)
+        child-width  (gpo/width-points child-bounds)
+        child-height (gpo/height-points child-bounds)
+
+        cell-bounds (cell-bounds layout-data cell-data)
+
+        [_ transform transform-inverse]
+        (when (or (ctl/fill-width? child) (ctl/fill-height? child))
+          (gtr/calculate-geometry @parent-bounds))
+
+        fill-width
+        (when (ctl/fill-width? child)
+          (calc-fill-width-data parent transform transform-inverse child child-origin child-width cell-bounds))
+
+        fill-height
+        (when (ctl/fill-height? child)
+          (calc-fill-height-data parent transform transform-inverse child child-origin child-height cell-bounds))
+
+        child-width (or (:width fill-width) child-width)
+        child-height (or (:height fill-height) child-height)]
+
+    [child-width
+     child-height
+     (-> (ctm/empty)
+         (cond-> fill-width (ctm/add-modifiers (:modifiers fill-width)))
+         (cond-> fill-height (ctm/add-modifiers (:modifiers fill-height))))]))
+
+(defn child-position-delta
+  [parent child child-bounds child-width child-height layout-data cell-data]
+  (let [cell-bounds (cell-bounds layout-data cell-data)
+        child-origin (gpo/origin child-bounds)
+
+        align (:layout-align-items parent)
+        justify (:layout-justify-items parent)
+        align-self (:align-self cell-data)
+        justify-self (:justify-self cell-data)
+
+        align-self (when (and align-self (not= align-self :auto)) align-self)
+        justify-self (when (and justify-self (not= justify-self :auto)) justify-self)
+
+        align (or align-self align)
+        justify (or justify-self justify)
+
+        origin-h (gpo/project-point cell-bounds :h child-origin)
+        origin-v (gpo/project-point cell-bounds :v child-origin)
+        hv     (partial gpo/start-hv cell-bounds)
+        vv     (partial gpo/start-vv cell-bounds)
+
+        [top-m right-m bottom-m left-m] (ctl/child-margins child)
+
+        ;; Adjust alignment/justify
+        [from-h to-h]
+        (case justify
+          :end
+          [(gpt/add origin-h (hv child-width))
+           (gpt/subtract (nth cell-bounds 1) (hv right-m))]
+
+          :center
+          [(gpt/add origin-h (hv (/ child-width 2)))
+           (gpo/project-point cell-bounds :h (gpo/center cell-bounds))]
+
+          [origin-h
+           (gpt/add (first cell-bounds) (hv left-m))])
+
+        [from-v to-v]
+        (case align
+          :end
+          [(gpt/add origin-v (vv child-height))
+           (gpt/subtract (nth cell-bounds 3) (vv bottom-m))]
+
+          :center
+          [(gpt/add origin-v (vv (/ child-height 2)))
+           (gpo/project-point cell-bounds :v (gpo/center cell-bounds))]
+
+          [origin-v
+           (gpt/add (first cell-bounds) (vv top-m))])]
+
+    (-> (gpt/point)
+        (gpt/add (gpt/to-vec from-h to-h))
+        (gpt/add (gpt/to-vec from-v to-v)))))
 
 (defn child-modifiers
-  [_parent _transformed-parent-bounds _child child-bounds cell-data]
-  (ctm/move-modifiers
-   (gpt/subtract (:start-p cell-data) (gpo/origin child-bounds))))
+  [parent parent-bounds child child-bounds layout-data cell-data]
+
+  (let [[child-width child-height fill-modifiers]
+        (fill-modifiers parent parent-bounds child child-bounds layout-data cell-data)
+
+        position-delta (child-position-delta parent child child-bounds child-width child-height layout-data cell-data)]
+
+    (cond-> (ctm/empty)
+      (not (ctl/layout-absolute? child))
+      (-> (ctm/add-modifiers fill-modifiers)
+          (ctm/move position-delta)))))
+
+
+(defn line-value
+  [[{px :x py :y} {vx :x vy :y}] {:keys [x y]}]
+  (let [a vy
+        b (- vx)
+        c (+ (* (- vy) px) (* vx py))]
+    (+ (* a x) (* b y) c)))
+
+(defn is-inside-lines?
+  [line-1 line-2 pos]
+  (< (* (line-value line-1 pos) (line-value line-2 pos)) 0))
+
+(defn get-position-grid-coord
+  [{:keys [layout-bounds row-tracks column-tracks]} position]
+
+  (let [hv #(gpo/start-hv layout-bounds %)
+        vv #(gpo/start-vv layout-bounds %)
+
+        make-is-inside-track
+        (fn [type]
+          (let [[vfn ofn] (if (= type :column) [vv hv] [hv vv])]
+            (fn is-inside-track? [{:keys [start-p size] :as track}]
+              (let [unit-v    (vfn 1)
+                    end-p     (gpt/add start-p (ofn size))]
+                (is-inside-lines? [start-p unit-v] [end-p unit-v]  position)))))
+
+        make-min-distance-track
+        (fn [type]
+          (let [[vfn ofn] (if (= type :column) [vv hv] [hv vv])]
+            (fn [[selected selected-dist] [cur-idx {:keys [start-p size] :as track}]]
+              (let [unit-v    (vfn 1)
+                    end-p     (gpt/add start-p (ofn size))
+                    dist-1    (mth/abs (line-value [start-p unit-v] position))
+                    dist-2    (mth/abs (line-value [end-p unit-v] position))]
+
+                (if (or (< dist-1 selected-dist) (< dist-2 selected-dist))
+                  [[cur-idx track] (min dist-1 dist-2)]
+                  [selected selected-dist])))))
+
+        ;; Check if it's inside a track
+        [col-idx column]
+        (->> (d/enumerate column-tracks)
+             (d/seek (comp (make-is-inside-track :column) second)))
+
+        [row-idx row]
+        (->> (d/enumerate row-tracks)
+             (d/seek (comp (make-is-inside-track :row) second)))
+
+        ;; If not inside we find the closest start/end line
+        [col-idx column]
+        (if (some? column)
+          [col-idx column]
+          (->> (d/enumerate column-tracks)
+               (reduce (make-min-distance-track :column) [[nil nil] ##Inf])
+               (first)))
+
+        [row-idx row]
+        (if (some? row)
+          [row-idx row]
+          (->> (d/enumerate row-tracks)
+               (reduce (make-min-distance-track :row) [[nil nil] ##Inf])
+               (first)))]
+
+    (when (and (some? column) (some? row))
+      [(inc row-idx) (inc col-idx)])))
+
+(defn get-drop-cell
+  [frame-id objects position]
+
+  (let [frame       (get objects frame-id)
+        children    (->> (cph/get-immediate-children objects (:id frame))
+                         (remove :hidden)
+                         (map #(vector (gpo/parent-coords-bounds (:points %) (:points frame)) %)))
+        layout-data (ld/calc-layout-data frame children (:points frame))]
+
+    (get-position-grid-coord layout-data position)))

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

@@ -7,13 +7,15 @@
 (ns app.common.geom.shapes.intersect
   (: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.geom.shapes.common :as gco]
    [app.common.geom.shapes.path :as gpp]
-   [app.common.geom.shapes.rect :as gpr]
    [app.common.geom.shapes.text :as gte]
-   [app.common.math :as mth]))
+   [app.common.math :as mth]
+   [app.common.pages.helpers :as cph]))
 
 (defn orientation
   "Given three ordered points gives the orientation
@@ -32,10 +34,10 @@
 (defn on-segment?
   "Given three colinear points p, q, r checks if q lies on segment pr"
   [{qx :x qy :y} {px :x py :y} {rx :x ry :y}]
-  (and (<= qx (max px rx))
-       (>= qx (min px rx))
-       (<= qy (max py ry))
-       (>= qy (min py ry))))
+  (and (<= qx (mth/max px rx))
+       (>= qx (mth/min px rx))
+       (<= qy (mth/max py ry))
+       (>= qy (mth/min py ry))))
 
 ;; Based on solution described here
 ;; https://www.geeksforgeeks.org/check-if-two-given-line-segments-intersect/
@@ -53,16 +55,16 @@
      (and (not= o1 o2) (not= o3 o4))
 
      ;; p1, q1 and p2 colinear and p2 lies on p1q1
-     (and (= o1 :coplanar) (on-segment? p2 p1 q1))
+     (and (= o1 :coplanar) ^boolean (on-segment? p2 p1 q1))
 
      ;; p1, q1 and q2 colinear and q2 lies on p1q1
-     (and (= o2 :coplanar) (on-segment? q2 p1 q1))
+     (and (= o2 :coplanar) ^boolean (on-segment? q2 p1 q1))
 
      ;; p2, q2 and p1 colinear and p1 lies on p2q2
-     (and (= o3 :coplanar) (on-segment? p1 p2 q2))
+     (and (= o3 :coplanar) ^boolean (on-segment? p1 p2 q2))
 
      ;; p2, q2 and p1 colinear and q1 lies on p2q2
-     (and (= o4 :coplanar) (on-segment? q1 p2 q2)))))
+     (and (= o4 :coplanar) ^boolean (on-segment? q1 p2 q2)))))
 
 (defn points->lines
   "Given a set of points for a polygon will return
@@ -71,12 +73,10 @@
    (points->lines points true))
 
   ([points closed?]
-   (map vector
-        points
-        (-> (rest points)
-            (vec)
-            (cond-> closed?
-              (conj (first points)))))))
+   (map vector points
+        (cond-> (rest points)
+          (true? closed?)
+          (concat (list (first points)))))))
 
 (defn intersects-lines?
   "Checks if two sets of lines intersect in any point"
@@ -116,7 +116,7 @@
   ;; Cast a ray from the point in any direction and count the intersections
   ;; if it's odd the point is inside the polygon
   (->> lines
-       (filter #(intersect-ray? p %))
+       (filterv #(intersect-ray? p %))
        (count)
        (odd?)))
 
@@ -163,7 +163,7 @@
   "Checks if the given rect intersects with the selrect"
   [rect points]
 
-  (let [rect-points  (gpr/rect->points rect)
+  (let [rect-points  (grc/rect->points rect)
         rect-lines   (points->lines rect-points)
         points-lines (points->lines points)]
 
@@ -173,7 +173,7 @@
 
 (defn overlaps-path?
   "Checks if the given rect overlaps with the path in any point"
-  [shape rect]
+  [shape rect include-content?]
 
   (when (d/not-empty? (:content shape))
     (let [ ;; If paths are too complex the intersection is too expensive
@@ -182,16 +182,18 @@
           ;; TODO: Look for ways to optimize this operation
           simple? (> (count (:content shape)) 100)
 
-          rect-points  (gpr/rect->points rect)
+          rect-points  (grc/rect->points rect)
           rect-lines   (points->lines rect-points)
           path-lines   (if simple?
                          (points->lines (:points shape))
                          (gpp/path->lines shape))
           start-point (-> shape :content (first) :params (gpt/point))]
 
-      (or (is-point-inside-nonzero? (first rect-points) path-lines)
-          (is-point-inside-nonzero? start-point rect-lines)
-          (intersects-lines? rect-lines path-lines)))))
+      (or (intersects-lines? rect-lines path-lines)
+        (if include-content?
+          (or (is-point-inside-nonzero? (first rect-points) path-lines)
+            (is-point-inside-nonzero? start-point rect-lines))
+          false)))))
 
 (defn is-point-inside-ellipse?
   "checks if a point is inside an ellipse"
@@ -268,7 +270,7 @@
   "Checks if the given rect overlaps with an ellipse"
   [shape rect]
 
-  (let [rect-points  (gpr/rect->points rect)
+  (let [rect-points  (grc/rect->points rect)
         rect-lines   (points->lines rect-points)
         {:keys [x y width height]} shape
 
@@ -289,7 +291,7 @@
   [{:keys [position-data] :as shape} rect]
 
   (if (and (some? position-data) (d/not-empty? position-data))
-    (let [center    (gco/center-shape shape)
+    (let [center (gco/shape->center shape)
 
           transform-rect
           (fn [rect-points]
@@ -297,7 +299,7 @@
 
       (->> position-data
            (map (comp transform-rect
-                      gpr/rect->points
+                      grc/rect->points
                       gte/position-data->rect))
            (some #(overlaps-rect-points? rect %))))
     (overlaps-rect-points? rect (:points shape))))
@@ -305,43 +307,59 @@
 (defn overlaps?
   "General case to check for overlapping between shapes and a rectangle"
   [shape rect]
-  (let [stroke-width (/ (or (:stroke-width shape) 0) 2)
-        rect (-> rect
-                 (update :x - stroke-width)
-                 (update :y - stroke-width)
-                 (update :width + (* 2 stroke-width))
-                 (update :height + (* 2 stroke-width)))]
+  (let [swidth (/ (or (:stroke-width shape) 0) 2)
+        rect   (-> rect
+                   (update :x - swidth)
+                   (update :y - swidth)
+                   (update :width + (* 2 swidth))
+                   (update :height + (* 2 swidth)))]
     (or (not shape)
-        (let [path? (= :path (:type shape))
-              circle? (= :circle (:type shape))
-              text? (= :text (:type shape))]
-          (cond
-            path?
-            (and (overlaps-rect-points? rect (:points shape))
-                 (overlaps-path? shape rect))
+        (cond
+          (cph/path-shape? shape)
+          (and (overlaps-rect-points? rect (:points shape))
+               (overlaps-path? shape rect true))
 
-            circle?
-            (and (overlaps-rect-points? rect (:points shape))
-                 (overlaps-ellipse? shape rect))
+          (cph/circle-shape? shape)
+          (and (overlaps-rect-points? rect (:points shape))
+               (overlaps-ellipse? shape rect))
 
-            text?
-            (overlaps-text? shape rect)
+          (cph/text-shape? shape)
+          (overlaps-text? shape rect)
 
-            :else
-            (overlaps-rect-points? rect (:points shape)))))))
+          :else
+          (overlaps-rect-points? rect (:points shape))))))
 
 (defn has-point-rect?
   [rect point]
-  (let [lines (gpr/rect->lines rect)]
+  (let [lines (grc/rect->lines rect)]
     (is-point-inside-evenodd? point lines)))
 
-(defn has-point?
-  "Check if the shape contains a point"
+(defn slow-has-point?
   [shape point]
-  (let [lines (points->lines (:points shape))]
-    ;; TODO: Will only work for simple shapes
+  (let [lines (points->lines (dm/get-prop shape :points))]
     (is-point-inside-evenodd? point lines)))
 
+(defn fast-has-point?
+  [shape point]
+  (let [x1 (dm/get-prop shape :x)
+        y1 (dm/get-prop shape :y)
+        x2 (+ x1 (dm/get-prop shape :width))
+        y2 (+ y1 (dm/get-prop shape :height))
+        px (dm/get-prop point :x)
+        py (dm/get-prop point :y)]
+    (and (>= px x1)
+         (<= px x2)
+         (>= py y1)
+         (<= py y2))))
+
+(defn has-point?
+  [shape point]
+  (if (or ^boolean (cph/path-shape? shape)
+          ^boolean (cph/bool-shape? shape)
+          ^boolean (cph/circle-shape? shape))
+    (slow-has-point? shape point)
+    (fast-has-point? shape point)))
+
 (defn rect-contains-shape?
   [rect shape]
   (->> shape

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

@@ -29,7 +29,7 @@
 ;;                           [(get-in objects [k :name]) v]))
 ;;                    modif-tree))))
 
-(defn children-sequence
+(defn- get-children-seq
   "Given an id returns a sequence of its children"
   [id objects]
 
@@ -39,61 +39,63 @@
         id)
        (map #(get objects %))))
 
-(defn resolve-tree-sequence
+(defn- resolve-tree
   "Given the ids that have changed search for layout roots to recalculate"
   [ids objects]
   (dm/assert! (or (nil? ids) (set? ids)))
 
-  (let [get-tree-root
-        (fn ;; Finds the tree root for the current id
-          [id]
-
+  (let [;; Finds the tree root for the current id
+        get-tree-root
+        (fn [id]
           (loop [current id
                  result  id]
-            (let [shape (get objects current)
-                  parent (get objects (:parent-id shape))]
-              (cond
-                (or (not shape) (= uuid/zero current))
+            (let [shape (get objects current)]
+              (if (or (not ^boolean shape) (= uuid/zero current))
                 result
+                (let [parent-id (dm/get-prop shape :parent-id)
+                      parent    (get objects parent-id)]
+                  (cond
+                    ;; Frame found, but not layout we return the last layout found (or the id)
+                    (and ^boolean (cph/frame-shape? parent)
+                         (not ^boolean (ctl/any-layout? parent)))
+                    result
 
-                ;; Frame found, but not layout we return the last layout found (or the id)
-                (and (= :frame (:type parent))
-                     (not (ctl/any-layout? parent)))
-                result
+                    ;; Layout found. We continue upward but we mark this layout
+                    (ctl/any-layout? parent)
+                    (recur parent-id parent-id)
 
-                ;; Layout found. We continue upward but we mark this layout
-                (ctl/any-layout? parent)
-                (recur (:id parent) (:id parent))
+                    ;; If group or boolean or other type of group we continue with the last result
+                    :else
+                    (recur parent-id result)))))))
 
-                ;; If group or boolean or other type of group we continue with the last result
-                :else
-                (recur (:id parent) result)))))
-
-        is-child? #(cph/is-child? objects %1 %2)
-
-        calculate-common-roots
-        (fn ;; Given some roots retrieves the minimum number of tree roots
-          [result id]
+        ;; Given some roots retrieves the minimum number of tree roots
+        search-common-roots
+        (fn [result id]
           (if (= id uuid/zero)
             result
             (let [root (get-tree-root id)
 
                   ;; Remove the children from the current root
                   result
-                  (if (cph/has-children? objects root)
-                    (into #{} (remove #(is-child? root %)) result)
+                  (if ^boolean (cph/has-children? objects root)
+                    (into #{} (remove (partial cph/is-child? objects root)) result)
                     result)
 
-                  root-parents (cph/get-parent-ids objects root)
-                  contains-parent? (some #(contains? result %) root-parents)]
-              (cond-> result
-                (not contains-parent?)
-                (conj root)))))
+                  contains-parent?
+                  (->> (cph/get-parent-ids objects root)
+                       (some (partial contains? result)))]
 
-        roots (->> ids (reduce calculate-common-roots #{}))]
-    (concat
-     (when (contains? ids uuid/zero) [(get objects uuid/zero)])
-     (mapcat #(children-sequence % objects) roots))))
+              (if (not contains-parent?)
+                (conj result root)
+                result))))
+
+        result
+        (->> (reduce search-common-roots #{} ids)
+             (mapcat #(get-children-seq % objects)))]
+
+    (if (contains? ids uuid/zero)
+      (cons (get objects uuid/zero) result)
+      result)))
 
 (defn- set-children-modifiers
   "Propagates the modifiers from a parent too its children applying constraints if necesary"
@@ -204,8 +206,11 @@
             [(-> (get-group-bounds objects bounds modif-tree child)
                  (gpo/parent-coords-bounds @transformed-parent-bounds))
              child])
-          (set-child-modifiers [modif-tree cell-data [child-bounds child]]
-            (let [modifiers (gcgl/child-modifiers parent transformed-parent-bounds child child-bounds cell-data)
+
+          (set-child-modifiers [modif-tree grid-data cell-data [child-bounds child]]
+            (let [modifiers
+                  (gcgl/child-modifiers parent transformed-parent-bounds child child-bounds grid-data cell-data)
+
                   modif-tree
                   (cond-> modif-tree
                     (d/not-empty? modifiers)
@@ -217,13 +222,13 @@
                             (map apply-modifiers))
           grid-data    (gcgl/calc-layout-data parent children @transformed-parent-bounds)]
       (loop [modif-tree modif-tree
-             child (first children)
+             bound+child (first children)
              pending (rest children)]
-        (if (some? child)
-          (let [cell-data (gcgl/get-cell-data grid-data @transformed-parent-bounds child)
+        (if (some? bound+child)
+          (let [cell-data (gcgl/get-cell-data grid-data @transformed-parent-bounds bound+child)
                 modif-tree (cond-> modif-tree
                              (some? cell-data)
-                             (set-child-modifiers cell-data child))]
+                             (set-child-modifiers grid-data cell-data bound+child))]
             (recur modif-tree (first pending) (rest pending)))
           modif-tree)))))
 
@@ -253,7 +258,12 @@
 
         content-bounds
         (when (and (d/not-empty? children) (or (ctl/auto-height? parent) (ctl/auto-width? parent)))
-          (gcfl/layout-content-bounds bounds parent children))
+          (cond
+            (ctl/flex-layout? parent)
+            (gcfl/layout-content-bounds bounds parent children)
+
+            (ctl/grid-layout? parent)
+            (gcgl/layout-content-bounds bounds parent children)))
 
         auto-width (when content-bounds (gpo/width-points content-bounds))
         auto-height (when content-bounds (gpo/height-points content-bounds))]
@@ -297,13 +307,13 @@
         transformed-parent-bounds (delay (gtr/transform-bounds @(get bounds parent-id) modifiers))
 
         children-modifiers
-        (if flex-layout?
+        (if (or flex-layout? grid-layout?)
           (->> (:shapes parent)
                (filter #(ctl/layout-absolute? objects %)))
           (:shapes parent))
 
         children-layout
-        (when flex-layout?
+        (when (or flex-layout? grid-layout?)
           (->> (:shapes parent)
                (remove #(ctl/layout-absolute? objects %))))]
 
@@ -363,7 +373,7 @@
 (defn reflow-layout
   [objects old-modif-tree bounds ignore-constraints id]
 
-  (let [tree-seq (children-sequence id objects)
+  (let [tree-seq (get-children-seq id objects)
 
         [modif-tree _]
         (reduce
@@ -408,7 +418,7 @@
 
                 (let [resize-modif-tree {current {:modifiers auto-resize-modifiers}}
 
-                      tree-seq (children-sequence current objects)
+                      tree-seq (get-children-seq current objects)
 
                       [resize-modif-tree _]
                       (reduce
@@ -421,7 +431,7 @@
 
                       to-reflow
                       (cond-> to-reflow
-                        (and (ctl/flex-layout-descent? objects parent-base)
+                        (and (ctl/any-layout-descent? objects parent-base)
                              (not= uuid/zero (:frame-id parent-base)))
                         (conj (:frame-id parent-base)))]
                   (recur modif-tree
@@ -432,7 +442,7 @@
 
         ;; Step-2: After resizing we still need to reflow the layout parents that are not auto-width/height
 
-        tree-seq (resolve-tree-sequence to-reflow objects)
+        tree-seq (resolve-tree to-reflow objects)
 
         [reflow-modif-tree _]
         (reduce
@@ -468,7 +478,7 @@
                   (some? old-modif-tree)
                   (transform-bounds objects old-modif-tree))
 
-         shapes-tree (resolve-tree-sequence (-> modif-tree keys set) objects)
+         shapes-tree (resolve-tree (-> modif-tree keys set) objects)
 
          ;; Calculate the input transformation and constraints
          modif-tree (reduce #(propagate-modifiers-constraints objects bounds ignore-constraints %1 %2) modif-tree shapes-tree)

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

@@ -9,8 +9,8 @@
    [app.common.data :as d]
    [app.common.geom.matrix :as gmt]
    [app.common.geom.point :as gpt]
-   [app.common.geom.shapes.common :as gsc]
-   [app.common.geom.shapes.rect :as gpr]
+   [app.common.geom.rect :as grc]
+   [app.common.geom.shapes.common :as gco]
    [app.common.math :as mth]
    [app.common.path.commands :as upc]
    [app.common.path.subpaths :as sp]))
@@ -46,11 +46,14 @@
 (defn content->points
   "Returns the points in the given content"
   [content]
-  (->> content
-       (map #(when (-> % :params :x)
-               (gpt/point (-> % :params :x) (-> % :params :y))))
-       (remove nil?)
-       (into [])))
+  (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)))))
 
 (defn line-values
   [[from-p to-p] t]
@@ -334,7 +337,7 @@
                                     (->> (curve-extremities curve)
                                          (mapv #(curve-values curve %)))))
                   [])]
-     (gpr/points->selrect points))))
+     (grc/points->rect points))))
 
 (defn content->selrect [content]
   (let [calc-extremities
@@ -360,7 +363,7 @@
         extremities (mapcat calc-extremities
                             content
                             (concat [nil] content))]
-    (gpr/points->selrect extremities)))
+    (grc/points->rect extremities)))
 
 (defn move-content [content move-vec]
   (let [dx (:x move-vec)
@@ -591,7 +594,7 @@
   (let [[from-p to-p :as curve] (subcurve-range curve from-t to-t)
         extremes (->> (curve-extremities curve)
                       (mapv #(curve-values curve %)))]
-    (gpr/points->rect (into [from-p to-p] extremes))))
+    (grc/points->rect (into [from-p to-p] extremes))))
 
 (defn line-has-point?
   "Using the line equation we put the x value and check if matches with
@@ -623,7 +626,7 @@
   [point curve]
   (letfn [(check-range [from-t to-t]
             (let [r (curve-range->rect curve from-t to-t)]
-              (when (gpr/contains-point? r point)
+              (when (grc/contains-point? r point)
                 (if (s= from-t to-t)
                   (< (gpt/distance (curve-values curve from-t) point) 0.1)
 
@@ -760,7 +763,7 @@
             (let [r1 (curve-range->rect c1 c1-from c1-to)
                   r2 (curve-range->rect c2 c2-from c2-to)]
 
-              (when (gpr/overlaps-rects? r1 r2)
+              (when (grc/overlaps-rects? r1 r2)
                 (let [p1 (curve-values c1 c1-from)
                       p2 (curve-values c2 c2-from)]
 
@@ -811,7 +814,7 @@
   [[from-p to-p :as curve]]
   (let [extremes (->> (curve-extremities curve)
                       (mapv #(curve-values curve %)))]
-    (gpr/points->rect (into [from-p to-p] extremes))))
+    (grc/points->rect (into [from-p to-p] extremes))))
 
 
 (defn is-point-in-border?
@@ -943,7 +946,7 @@
   [content]
   (-> content
       content->selrect
-      gsc/center-selrect))
+      grc/rect->center))
 
 (defn content->points+selrect
   "Given the content of a shape, calculate its points and selrect"
@@ -960,7 +963,7 @@
           flip-y (gmt/scale (gpt/point 1 -1))
           :always (gmt/multiply (:transform-inverse shape (gmt/matrix))))
 
-        center (or (gsc/center-shape shape)
+        center (or (gco/shape->center shape)
                    (content-center content))
 
         base-content (transform-content
@@ -969,16 +972,16 @@
 
         ;; Calculates the new selrect with points given the old center
         points (-> (content->selrect base-content)
-                   (gpr/rect->points)
-                   (gsc/transform-points center transform))
+                   (grc/rect->points)
+                   (gco/transform-points center transform))
 
-        points-center (gsc/center-points points)
+        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
-                    (gsc/transform-points points-center transform-inverse)
-                    (gpr/points->selrect))]
+                    (gco/transform-points points-center transform-inverse)
+                    (grc/points->rect))]
     [points selrect]))
 
 (defn open-path?

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

@@ -8,10 +8,11 @@
   (: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.geom.shapes.common :as gco]
    [app.common.geom.shapes.points :as gpo]
-   [app.common.geom.shapes.rect :as gpr]
    [app.common.geom.shapes.transforms :as gtr]
    [app.common.math :as mth]
    [app.common.pages.helpers :as cph]
@@ -19,28 +20,32 @@
 
 (defn size-pixel-precision
   [modifiers shape points precision]
-  (let [origin        (gpo/origin points)
-        curr-width    (gpo/width-points points)
-        curr-height   (gpo/height-points points)
+  (let [origin            (gpo/origin points)
+        curr-width        (gpo/width-points points)
+        curr-height       (gpo/height-points points)
 
-        [_ transform transform-inverse] (gtr/calculate-geometry points)
+        center            (gco/points->center points)
+        selrect           (gtr/calculate-selrect points center)
 
-        path?            (cph/path-shape? shape)
-        vertical-line?   (and path? (<= curr-width 0.01))
-        horizontal-line? (and path? (<= curr-height 0.01))
+        transform         (gtr/calculate-transform points center selrect)
+        transform-inverse (when (some? transform) (gmt/inverse transform))
 
-        target-width  (if vertical-line? curr-width (max 1 (mth/round curr-width precision)))
-        target-height (if horizontal-line? curr-height (max 1 (mth/round curr-height precision)))
+        path?             (cph/path-shape? shape)
+        vertical-line?    (and path? (<= curr-width 0.01))
+        horizontal-line?  (and path? (<= curr-height 0.01))
 
-        ratio-width  (/ target-width curr-width)
-        ratio-height (/ target-height curr-height)
-        scalev       (gpt/point ratio-width ratio-height)]
-    (-> modifiers
-        (ctm/resize scalev origin transform transform-inverse {:precise? true}))))
+        target-width      (if vertical-line? curr-width (mth/max 1 (mth/round curr-width precision)))
+        target-height     (if horizontal-line? curr-height (mth/max 1 (mth/round curr-height precision)))
+
+        ratio-width       (/ target-width curr-width)
+        ratio-height      (/ target-height curr-height)
+        scalev            (gpt/point ratio-width ratio-height)]
+
+    (ctm/resize modifiers scalev origin transform transform-inverse {:precise? true})))
 
 (defn position-pixel-precision
   [modifiers _ points precision ignore-axis]
-  (let [bounds        (gpr/bounds->rect points)
+  (let [bounds        (grc/bounds->rect points)
         corner        (gpt/point bounds)
         target-corner
         (cond-> corner

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

@@ -8,9 +8,7 @@
   (:require
    [app.common.data :as d]
    [app.common.geom.point :as gpt]
-   [app.common.geom.shapes.common :as gco]
    [app.common.geom.shapes.intersect :as gsi]
-   [app.common.geom.shapes.rect :as gre]
    [app.common.math :as mth]))
 
 (defn origin
@@ -55,11 +53,13 @@
 
 (defn width-points
   [[p0 p1 _ _]]
-  (max 0.01 (gpt/length (gpt/to-vec p0 p1))))
+  (when (and (some? p0) (some? p1))
+    (max 0.01 (gpt/length (gpt/to-vec p0 p1)))))
 
 (defn height-points
   [[p0 _ _ p3]]
-  (max 0.01 (gpt/length (gpt/to-vec p0 p3))))
+  (when (and (some? p0) (some? p3))
+    (max 0.01 (gpt/length (gpt/to-vec p0 p3)))))
 
 (defn pad-points
   [[p0 p1 p2 p3 :as points] pad-top pad-right pad-bottom pad-left]
@@ -78,7 +78,7 @@
   "Given a point and a line returns the parametric t the cross point with the line going through the other axis projected"
   [point [start end] other-axis-vec]
 
-  (let [line-vec    (gpt/to-vec start end)
+  (let [line-vec (gpt/to-vec start end)
         pr-point (gsi/line-line-intersect point (gpt/add point other-axis-vec) start end)]
     (cond
       (not (mth/almost-zero? (:x line-vec)))
@@ -91,9 +91,17 @@
       :else
       0)))
 
+(defn project-point
+  "Project the point into the given axis: `:h` or `:v` means horizontal or vertical axis"
+  [[p0 p1 _ p3 :as bounds] axis point]
+  (let [[other-vec start end]
+        (if (= axis :h)
+          [(gpt/to-vec p0 p3) p0 p1]
+          [(gpt/to-vec p0 p1) p0 p3])]
+    (gsi/line-line-intersect point (gpt/add point other-vec) start end)))
+
 (defn parent-coords-bounds
   [child-bounds [p1 p2 _ p4 :as parent-bounds]]
-
   (if (empty? child-bounds)
     parent-bounds
 
@@ -110,10 +118,10 @@
           (fn [[th-min th-max tv-min tv-max] current-point]
             (let [cth (project-t current-point rh vv)
                   ctv (project-t current-point rv hv)]
-              [(min th-min cth)
-               (max th-max cth)
-               (min tv-min ctv)
-               (max tv-max ctv)]))
+              [(mth/min th-min cth)
+               (mth/max th-max cth)
+               (mth/min tv-min ctv)
+               (mth/max tv-max ctv)]))
 
           [th-min th-max tv-min tv-max]
           (->> child-bounds
@@ -141,14 +149,17 @@
   [bounds parent-bounds]
   (parent-coords-bounds (flatten bounds) parent-bounds))
 
-(defn points->selrect
-  [points]
-  (let [width (width-points points)
-        height (height-points points)
-        center (gco/center-points points)]
-    (gre/center->selrect center width height)))
-
 (defn move
   [bounds vector]
   (->> bounds
        (map #(gpt/add % vector))))
+
+(defn center
+  [bounds]
+  (let [width (width-points bounds)
+        height (height-points bounds)
+        half-h (start-hv bounds (/ width 2))
+        half-v (start-vv bounds (/ height 2))]
+    (-> (origin bounds)
+        (gpt/add half-h)
+        (gpt/add half-v))))

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

@@ -4,221 +4,4 @@
 ;;
 ;; Copyright (c) KALEIDOS INC
 
-(ns app.common.geom.shapes.rect
-  (:require
-   [app.common.data :as d]
-   [app.common.data.macros :as dm]
-   [app.common.geom.point :as gpt]
-   [app.common.math :as mth]))
-
-(defn make-rect
-  ([p1 p2]
-   (let [xp1 (:x p1)
-         yp1 (:y p1)
-         xp2 (:x p2)
-         yp2 (:y p2)
-         x1 (min xp1 xp2)
-         y1 (min yp1 yp2)
-         x2 (max xp1 xp2)
-         y2 (max yp1 yp2)]
-     (make-rect x1 y1 (- x2 x1) (- y2 y1))))
-
-  ([x y width height]
-   (when (d/num? x y width height)
-     (let [width (max width 0.01)
-           height (max height 0.01)]
-       {:x x
-        :y y
-        :width width
-        :height height}))))
-
-(defn make-selrect
-  [x y width height]
-  (when (d/num? x y width height)
-    (let [width (max width 0.01)
-          height (max height 0.01)]
-      {:x x
-       :y y
-       :x1 x
-       :y1 y
-       :x2 (+ x width)
-       :y2 (+ y height)
-       :width width
-       :height height})))
-
-(defn close-rect?
-  [rect1 rect2]
-  (and (mth/close? (:x rect1) (:x rect2))
-       (mth/close? (:y rect1) (:y rect2))
-       (mth/close? (:width rect1) (:width rect2))
-       (mth/close? (:height rect1) (:height rect2))))
-
-(defn close-selrect?
-  [selrect1 selrect2]
-  (and (mth/close? (:x selrect1) (:x selrect2))
-       (mth/close? (:y selrect1) (:y selrect2))
-       (mth/close? (:x1 selrect1) (:x1 selrect2))
-       (mth/close? (:y1 selrect1) (:y1 selrect2))
-       (mth/close? (:x2 selrect1) (:x2 selrect2))
-       (mth/close? (:y2 selrect1) (:y2 selrect2))
-       (mth/close? (:width selrect1) (:width selrect2))
-       (mth/close? (:height selrect1) (:height selrect2))))
-
-(defn rect->points [{:keys [x y width height]}]
-  (when (d/num? x y)
-    (let [width  (max width 0.01)
-          height (max height 0.01)]
-      [(gpt/point x y)
-       (gpt/point (+ x width) y)
-       (gpt/point (+ x width) (+ y height))
-       (gpt/point x (+ y height))])))
-
-(defn rect->lines [{:keys [x y width height]}]
-  (when (d/num? x y)
-    (let [width (max width 0.01)
-          height (max height 0.01)]
-      [[(gpt/point x y) (gpt/point (+ x width) y)]
-       [(gpt/point (+ x width) y) (gpt/point (+ x width) (+ y height))]
-       [(gpt/point (+ x width) (+ y height)) (gpt/point x (+ y height))]
-       [(gpt/point x (+ y height)) (gpt/point x y)]])))
-
-(defn points->rect
-  [points]
-  (when-let [points (seq points)]
-    (loop [minx ##Inf
-           miny ##Inf
-           maxx ##-Inf
-           maxy ##-Inf
-           pts  points]
-      (if-let [pt (first pts)]
-        (let [x (dm/get-prop pt :x)
-              y (dm/get-prop pt :y)]
-          (recur (min minx x)
-                 (min miny y)
-                 (max maxx x)
-                 (max maxy y)
-                 (rest pts)))
-        (when (d/num? minx miny maxx maxy)
-          (make-rect minx miny (- maxx minx) (- maxy miny)))))))
-
-(defn bounds->rect
-  [[{ax :x ay :y} {bx :x by :y} {cx :x cy :y} {dx :x dy :y}]]
-  (let [minx (min ax bx cx dx)
-        miny (min ay by cy dy)
-        maxx (max ax bx cx dx)
-        maxy (max ay by cy dy)]
-    (when (d/num? minx miny maxx maxy)
-      (make-rect minx miny (- maxx minx) (- maxy miny)))))
-
-(defn squared-points
-  [points]
-  (when (d/not-empty? points)
-    (let [minx (transduce (keep :x) min ##Inf points)
-          miny (transduce (keep :y) min ##Inf points)
-          maxx (transduce (keep :x) max ##-Inf points)
-          maxy (transduce (keep :y) max ##-Inf points)]
-      (when (d/num? minx miny maxx maxy)
-        [(gpt/point minx miny)
-         (gpt/point maxx miny)
-         (gpt/point maxx maxy)
-         (gpt/point minx maxy)]))))
-
-(defn points->selrect [points]
-  (when-let [rect (points->rect points)]
-    (let [{:keys [x y width height]} rect]
-      (make-selrect x y width height))))
-
-(defn rect->selrect [rect]
-  (-> rect rect->points points->selrect))
-
-(defn join-rects [rects]
-  (when (d/not-empty? rects)
-    (let [minx (transduce (keep :x) min ##Inf rects)
-          miny (transduce (keep :y) min ##Inf rects)
-          maxx (transduce (keep #(when (and (:x %) (:width %)) (+ (:x %) (:width %))))  max ##-Inf rects)
-          maxy (transduce (keep #(when (and (:y %) (:height %))(+ (:y %) (:height %)))) max ##-Inf rects)]
-      (when (d/num? minx miny maxx maxy)
-        (make-rect minx miny (- maxx minx) (- maxy miny))))))
-
-(defn join-selrects [selrects]
-  (when (d/not-empty? selrects)
-    (let [minx (transduce (keep :x1) min ##Inf selrects)
-          miny (transduce (keep :y1) min ##Inf selrects)
-          maxx (transduce (keep :x2) max ##-Inf selrects)
-          maxy (transduce (keep :y2) max ##-Inf selrects)]
-      (when (d/num? minx miny maxx maxy)
-        (make-selrect minx miny (- maxx minx) (- maxy miny))))))
-
-(defn center->rect [{:keys [x y]} width height]
-  (when (d/num? x y width height)
-    (make-rect (- x (/ width 2))
-               (- y (/ height 2))
-               width
-               height)))
-
-(defn center->selrect [{:keys [x y]} width height]
-  (when (d/num? x y width height)
-    (make-selrect (- x (/ width 2))
-                  (- y (/ height 2))
-                  width
-                  height)))
-
-(defn s=
-  [a b]
-  (mth/almost-zero? (- a b)))
-
-(defn overlaps-rects?
-  "Check for two rects to overlap. Rects won't overlap only if
-   one of them is fully to the left or the top"
-  [rect-a rect-b]
-
-  (let [x1a (:x rect-a)
-        y1a (:y rect-a)
-        x2a (+ (:x rect-a) (:width rect-a))
-        y2a (+ (:y rect-a) (:height rect-a))
-
-        x1b (:x rect-b)
-        y1b (:y rect-b)
-        x2b (+ (:x rect-b) (:width rect-b))
-        y2b (+ (:y rect-b) (:height rect-b))]
-
-    (and (or (> x2a x1b)  (s= x2a x1b))
-         (or (>= x2b x1a) (s= x2b x1a))
-         (or (<= y1b y2a) (s= y1b y2a))
-         (or (<= y1a y2b) (s= y1a y2b)))))
-
-(defn contains-point?
-  [rect point]
-  (assert (gpt/point? point))
-  (let [x1 (:x rect)
-        y1 (:y rect)
-        x2 (+ (:x rect) (:width rect))
-        y2 (+ (:y rect) (:height rect))
-
-        px (:x point)
-        py (:y point)]
-
-    (and (or (> px x1) (s= px x1))
-         (or (< px x2) (s= px x2))
-         (or (> py y1) (s= py y1))
-         (or (< py y2) (s= py y2)))))
-
-(defn contains-selrect?
-  "Check if a selrect sr2 is contained inside sr1"
-  [sr1 sr2]
-  (and (>= (:x1 sr2) (:x1 sr1))
-       (<= (:x2 sr2) (:x2 sr1))
-       (>= (:y1 sr2) (:y1 sr1))
-       (<= (:y2 sr2) (:y2 sr1))))
-
-(defn corners->selrect
-  ([p1 p2]
-   (corners->selrect (:x p1) (:y p1) (:x p2) (:y p2)))
-  ([xp1 yp1 xp2 yp2]
-   (make-selrect (min xp1 xp2) (min yp1 yp2) (abs (- xp1 xp2)) (abs (- yp1 yp2)))))
-
-(defn clip-selrect
-  [{:keys [x1 y1 x2 y2] :as sr} clip-rect]
-  (when (some? sr)
-    (let [{bx1 :x1 by1 :y1 bx2 :x2 by2 :y2 :as sr2} (rect->selrect clip-rect)]
-      (corners->selrect (max bx1 x1) (max by1 y1) (min bx2 x2) (min by2 y2)))))
+(ns app.common.geom.shapes.rect)

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

@@ -6,41 +6,36 @@
 
 (ns app.common.geom.shapes.text
   (:require
+   [app.common.data.macros :as dm]
+   [app.common.geom.rect :as grc]
    [app.common.geom.shapes.common :as gco]
-   [app.common.geom.shapes.rect :as gpr]
    [app.common.geom.shapes.transforms :as gtr]))
 
 (defn position-data->rect
   [{:keys [x y width height]}]
-  {:x x
-   :y (- y height)
-   :width width
-   :height height})
+  (grc/make-rect x (- y height) width height))
 
-(defn position-data-selrect
+(defn shape->rect
   [shape]
-  (let [points    (->> shape
-                       :position-data
-                       (mapcat (comp gpr/rect->points position-data->rect)))]
-    (if (empty? points)
-      (:selrect shape)
-      (-> points (gpr/points->selrect)))))
+  (let [points (->> (:position-data shape)
+                    (mapcat (comp grc/rect->points position-data->rect)))]
+    (if (seq points)
+      (grc/points->rect points)
+      (dm/get-prop shape :selrect))))
 
-(defn position-data-bounding-box
+(defn shape->bounds
   [shape]
-  (let [points    (->> shape
-                       :position-data
-                       (mapcat (comp gpr/rect->points position-data->rect)))
-        transform (gtr/transform-matrix shape)]
+  (let [points (->> (:position-data shape)
+                    (mapcat (comp grc/rect->points position-data->rect)))]
     (-> points
-        (gco/transform-points transform)
-        (gpr/points->selrect ))))
+        (gco/transform-points (gtr/transform-matrix shape))
+        (grc/points->rect))))
 
 (defn overlaps-position-data?
   "Checks if the given position data is inside the shape"
   [{:keys [points]} position-data]
-  (let [bounding-box (gpr/points->selrect points)
+  (let [bounding-box (grc/points->rect points)
         fix-rect #(assoc % :y (- (:y %) (:height %)))]
     (->> position-data
-         (some #(gpr/overlaps-rects? bounding-box (fix-rect %)))
+         (some #(grc/overlaps-rects? bounding-box (fix-rect %)))
          (boolean))))

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

@@ -5,96 +5,114 @@
 ;; Copyright (c) KALEIDOS INC
 
 (ns app.common.geom.shapes.transforms
-  #?(:clj (:import (org.la4j Matrix LinearAlgebra))
-     :cljs (:import goog.math.Matrix))
   (:require
-   #?(:clj [app.common.exceptions :as ex])
    [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.geom.shapes.bool :as gshb]
    [app.common.geom.shapes.common :as gco]
    [app.common.geom.shapes.path :as gpa]
-   [app.common.geom.shapes.rect :as gpr]
    [app.common.math :as mth]
    [app.common.pages.helpers :as cph]
-   [app.common.types.modifiers :as ctm]
-   [app.common.uuid :as uuid]))
+   [app.common.record :as cr]
+   [app.common.types.modifiers :as ctm]))
 
 #?(:clj (set! *warn-on-reflection* true))
 
+(defn- valid-point?
+  [o]
+  (and ^boolean (gpt/point? o)
+       ^boolean (d/num? (dm/get-prop o :x)
+                        (dm/get-prop o :y))))
+
 ;; --- Relative Movement
 
-(defn- move-selrect [{:keys [x y x1 y1 x2 y2 width height] :as selrect} {dx :x dy :y :as pt}]
-  (if (and (some? selrect) (some? pt) (d/num? dx dy))
-    {:x      (if (d/num? x)  (+ dx x)  x)
-     :y      (if (d/num? y)  (+ dy y)  y)
-     :x1     (if (d/num? x1) (+ dx x1) x1)
-     :y1     (if (d/num? y1) (+ dy y1) y1)
-     :x2     (if (d/num? x2) (+ dx x2) x2)
-     :y2     (if (d/num? y2) (+ dy y2) y2)
-     :width  width
-     :height height}
+(defn- move-selrect
+  [selrect pt]
+  (if (and ^boolean (some? selrect)
+           ^boolean (valid-point? pt))
+    (let [x  (dm/get-prop selrect :x)
+          y  (dm/get-prop selrect :y)
+          w  (dm/get-prop selrect :width)
+          h  (dm/get-prop selrect :height)
+          dx (dm/get-prop pt :x)
+          dy (dm/get-prop pt :y)]
+
+      (grc/make-rect
+       (if ^boolean (d/num? x) (+ dx x)  x)
+       (if ^boolean (d/num? y)  (+ dy y)  y)
+       w
+       h))
     selrect))
 
-(defn- move-points [points move-vec]
-  (cond->> points
-    (d/num? (:x move-vec) (:y move-vec))
-    (mapv #(gpt/add % move-vec))))
+(defn- move-points
+  [points move-vec]
+  (if (valid-point? move-vec)
+    (mapv #(gpt/add % move-vec) points)
+    points))
 
+;; FIXME: deprecated
 (defn move-position-data
-  ([position-data {:keys [x y]}]
-   (move-position-data position-data x y))
-
-  ([position-data dx dy]
-   (when (some? position-data)
-     (cond->> position-data
-       (d/num? dx dy)
-       (mapv #(-> %
+  [position-data delta]
+  (when (some? position-data)
+    (let [dx (dm/get-prop delta :x)
+          dy (dm/get-prop delta :y)]
+      (if (d/num? dx dy)
+        (mapv #(-> %
                   (update :x + dx)
-                  (update :y + dy)))))))
+                  (update :y + dy))
+              position-data)
+        position-data))))
 
+(defn transform-position-data
+  [position-data transform]
+  (when (some? position-data)
+    (let [dx (dm/get-prop transform :e)
+          dy (dm/get-prop transform :f)]
+      (if (d/num? dx dy)
+        (mapv #(-> %
+                   (update :x + dx)
+                   (update :y + dy))
+              position-data)
+        position-data))))
+
+;; FIXME: revist usage of mutability
 (defn move
   "Move the shape relatively to its current
   position applying the provided delta."
-  [{:keys [type] :as shape} {dx :x dy :y}]
-  (let [dx       (d/check-num dx 0)
-        dy       (d/check-num dy 0)
-        move-vec (gpt/point dx dy)]
+  [shape point]
+  (let [type (dm/get-prop shape :type)
+        dx   (dm/get-prop point :x)
+        dy   (dm/get-prop point :y)
+        dx   (d/check-num dx 0)
+        dy   (d/check-num dy 0)
+        mvec (gpt/point dx dy)]
 
     (-> shape
-        (update :selrect move-selrect move-vec)
-        (update :points move-points move-vec)
-        (d/update-when :x + dx)
-        (d/update-when :y + dy)
-        (d/update-when :position-data move-position-data dx dy)
-        (cond-> (= :bool type) (update :bool-content gpa/move-content move-vec))
-        (cond-> (= :path type) (update :content gpa/move-content move-vec)))))
+        (update :selrect move-selrect mvec)
+        (update :points move-points mvec)
+        (d/update-when :x d/safe+ dx)
+        (d/update-when :y d/safe+ dy)
+        (d/update-when :position-data move-position-data mvec)
+        (cond-> (= :bool type) (update :bool-content gpa/move-content mvec))
+        (cond-> (= :path type) (update :content gpa/move-content mvec)))))
 
 ;; --- Absolute Movement
 
 (defn absolute-move
   "Move the shape to the exactly specified position."
-  [shape {:keys [x y]}]
-  (let [dx (- (d/check-num x) (-> shape :selrect :x))
-        dy (- (d/check-num y) (-> shape :selrect :y))]
-    (move shape (gpt/point dx dy))))
-
-; ---- Geometric operations
-
-(defn- calculate-height
-  "Calculates the height of a parallelogram given by the points"
-  [[p1 _ _ p4]]
-
-  (-> (gpt/to-vec p4 p1)
-      (gpt/length)))
-
-(defn- calculate-width
-  "Calculates the width of a parallelogram given by the points"
-  [[p1 p2 _ _]]
-  (-> (gpt/to-vec p1 p2)
-      (gpt/length)))
+  [shape pos]
+  (when shape
+    (let [x  (dm/get-prop pos :x)
+          y  (dm/get-prop pos :y)
+          sr (dm/get-prop shape :selrect)
+          px (dm/get-prop sr :x)
+          py (dm/get-prop sr :y)
+          dx (- (d/check-num x) px)
+          dy (- (d/check-num y) py)]
+      (move shape (gpt/point dx dy)))))
 
 ;; --- Transformation matrix operations
 
@@ -105,7 +123,7 @@
    (transform-matrix shape nil))
 
   ([shape params]
-   (transform-matrix shape params (or (gco/center-shape shape) (gpt/point 0 0))))
+   (transform-matrix shape params (or (gco/shape->center shape) (gpt/point 0 0))))
 
   ([{:keys [flip-x flip-y transform] :as shape} {:keys [no-flip]} shape-center]
    (-> (gmt/matrix)
@@ -134,9 +152,10 @@
      (dm/str (transform-matrix shape params))
      "")))
 
+;; FIXME: performance
 (defn inverse-transform-matrix
   ([shape]
-   (let [shape-center (or (gco/center-shape shape)
+   (let [shape-center (or (gco/shape->center shape)
                           (gpt/point 0 0))]
      (inverse-transform-matrix shape shape-center)))
   ([{:keys [flip-x flip-y] :as shape} center]
@@ -148,217 +167,212 @@
        (gmt/multiply (:transform-inverse shape (gmt/matrix)))
        (gmt/translate (gpt/negate center)))))
 
+;; FIXME: move to geom rect?
 (defn transform-rect
   "Transform a rectangles and changes its attributes"
   [rect matrix]
 
-  (let [points (-> (gpr/rect->points rect)
+  (let [points (-> (grc/rect->points rect)
                    (gco/transform-points matrix))]
-    (gpr/points->rect points)))
+    (grc/points->rect points)))
 
 (defn transform-points-matrix
-  "Calculate the transform matrix to convert from the selrect to the points bounds
-    TargetM = SourceM * Transform ==> Transform = TargetM * inv(SourceM)"
-  [{:keys [x1 y1 x2 y2]} [d1 d2 _ d4]]
+  [selrect [d1 d2 _ d4]]
   ;; If the coordinates are very close to zero (but not zero) the rounding can mess with the
   ;; transforms. So we round to zero the values
-  (let [x1  (mth/round-to-zero x1)
-        y1  (mth/round-to-zero y1)
-        x2  (mth/round-to-zero x2)
-        y2  (mth/round-to-zero y2)
-        d1x (mth/round-to-zero (:x d1))
-        d1y (mth/round-to-zero (:y d1))
-        d2x (mth/round-to-zero (:x d2))
-        d2y (mth/round-to-zero (:y d2))
-        d4x (mth/round-to-zero (:x d4))
-        d4y (mth/round-to-zero (:y d4))]
-    #?(:clj
-       ;; NOTE: the source matrix may not be invertible we can't
-       ;; calculate the transform, so on exception we return `nil`
-       (ex/ignoring
-        (let [target-points-matrix
-              (->> (list d1x d2x d4x
-                         d1y d2y d4y
-                         1     1   1)
-                   (into-array Double/TYPE)
-                   (Matrix/from1DArray 3 3))
+  (let [x1  (mth/round-to-zero (dm/get-prop selrect :x1))
+        y1  (mth/round-to-zero (dm/get-prop selrect :y1))
+        x2  (mth/round-to-zero (dm/get-prop selrect :x2))
+        y2  (mth/round-to-zero (dm/get-prop selrect :y2))
 
-              source-points-matrix
-              (->> (list x1 x2 x1
-                         y1 y1 y2
-                         1  1  1)
-                   (into-array Double/TYPE)
-                   (Matrix/from1DArray 3 3))
+        det (+ (- (* (- y1 y2) x1)
+                  (* (- y1 y2) x2))
+               (* (- y1 y1) x1))]
 
-              ;; May throw an exception if the matrix is not invertible
-              source-points-matrix-inv
-              (.. source-points-matrix
-                  (withInverter LinearAlgebra/GAUSS_JORDAN)
-                  (inverse))
+    (when-not (zero? det)
+      (let [ma0 (mth/round-to-zero (dm/get-prop d1 :x))
+            ma1 (mth/round-to-zero (dm/get-prop d2 :x))
+            ma2 (mth/round-to-zero (dm/get-prop d4 :x))
+            ma3 (mth/round-to-zero (dm/get-prop d1 :y))
+            ma4 (mth/round-to-zero (dm/get-prop d2 :y))
+            ma5 (mth/round-to-zero (dm/get-prop d4 :y))
 
-              transform-jvm
-              (.. target-points-matrix
-                  (multiply source-points-matrix-inv))]
+            mb0 (/ (- y1 y2) det)
+            mb1 (/ (- x1 x2) det)
+            mb2 (/ (- (* x2 y2) (* x1 y1)) det)
+            mb3 (/ (- y2 y1) det)
+            mb4 (/ (- x1 x1) det)
+            mb5 (/ (- (* x1 y1) (* x1 y2)) det)
+            mb6 (/ (- y1 y1) det)
+            mb7 (/ (- x2 x1) det)
+            mb8 (/ (- (* x1 y1) (* x2 y1)) det)]
 
-          (gmt/matrix (.get transform-jvm 0 0)
-                      (.get transform-jvm 1 0)
-                      (.get transform-jvm 0 1)
-                      (.get transform-jvm 1 1)
-                      (.get transform-jvm 0 2)
-                      (.get transform-jvm 1 2))))
+      (gmt/matrix (+ (* ma0 mb0)
+                     (* ma1 mb3)
+                     (* ma2 mb6))
+                  (+ (* ma3 mb0)
+                     (* ma4 mb3)
+                     (* ma5 mb6))
+                  (+ (* ma0 mb1)
+                     (* ma1 mb4)
+                     (* ma2 mb7))
+                  (+ (* ma3 mb1)
+                     (* ma4 mb4)
+                     (* ma5 mb7))
+                  (+ (* ma0 mb2)
+                     (* ma1 mb5)
+                     (* ma2 mb8))
+                  (+ (* ma3 mb2)
+                     (* ma4 mb5)
+                     (* ma5 mb8)))))))
 
-       :cljs
-       (let [target-points-matrix
-             (Matrix. #js [#js [d1x d2x d4x]
-                           #js [d1y d2y d4y]
-                           #js [  1   1   1]])
+(defn calculate-selrect
+  [points center]
 
-             source-points-matrix
-             (Matrix. #js [#js [x1 x2 x1]
-                           #js [y1 y1 y2]
-                           #js [ 1  1  1]])
+  (let [p1     (nth points 0)
+        p2     (nth points 1)
+        p4     (nth points 3)
 
-             ;; returns nil if not invertible
-             source-points-matrix-inv (.getInverse source-points-matrix)
+        width  (mth/hypot
+                (- (dm/get-prop p2 :x)
+                   (dm/get-prop p1 :x))
+                (- (dm/get-prop p2 :y)
+                   (dm/get-prop p1 :y)))
 
-             ;; TargetM = SourceM * Transform ==> Transform = TargetM * inv(SourceM)
-             transform-js
-             (when source-points-matrix-inv
-               (.multiply target-points-matrix source-points-matrix-inv))]
+        height (mth/hypot
+                (- (dm/get-prop p1 :x)
+                   (dm/get-prop p4 :x))
+                (- (dm/get-prop p1 :y)
+                   (dm/get-prop p4 :y)))]
 
-         (when transform-js
-           (gmt/matrix (.getValueAt transform-js 0 0)
-                       (.getValueAt transform-js 1 0)
-                       (.getValueAt transform-js 0 1)
-                       (.getValueAt transform-js 1 1)
-                       (.getValueAt transform-js 0 2)
-                       (.getValueAt transform-js 1 2)))))))
+    (grc/center->rect center width height)))
 
-(defn calculate-geometry
-  [points]
-  (let [width  (calculate-width points)
-        height (calculate-height points)
-        center (gco/center-points points)
-        sr     (gpr/center->selrect center width height)
-
-        points-transform-mtx (transform-points-matrix sr points)
+(defn calculate-transform
+  [points center selrect]
+  (let [transform (transform-points-matrix selrect points)
 
         ;; Calculate the transform by move the transformation to the center
         transform
-        (when points-transform-mtx
-          (gmt/multiply
-           (gmt/translate-matrix (gpt/negate center))
-           points-transform-mtx
-           (gmt/translate-matrix center)))
+        (when (some? transform)
+          (-> (gmt/translate-matrix-neg center)
+              (gmt/multiply! transform)
+              (gmt/multiply! (gmt/translate-matrix center))))]
 
-        transform-inverse (when transform (gmt/inverse transform))
+    ;; There is a rounding error when the matrix returned have float point values
+    ;; when the matrix is unit we return a "pure" matrix so we don't accumulate
+    ;; rounding problems
+    (when ^boolean (gmt/matrix? transform)
+      (if ^boolean (gmt/unit? transform)
+        gmt/base
+        transform))))
 
-        ;; There is a rounding error when the matrix returned have float point values
-        ;; when the matrix is unit we return a "pure" matrix so we don't accumulate
-        ;; rounding problems
-        [transform transform-inverse]
-        (if (gmt/unit? transform)
-          [(gmt/matrix) (gmt/matrix)]
-          [transform transform-inverse])]
+(defn calculate-geometry
+  [points]
+  (let [center     (gco/points->center points)
+        selrect    (calculate-selrect points center)
+        transform  (calculate-transform points center selrect)]
+    [selrect transform (when (some? transform) (gmt/inverse transform))]))
 
-    [sr transform transform-inverse]))
-
-(defn- adjust-shape-flips
+(defn- adjust-shape-flips!
   "After some tranformations the flip-x/flip-y flags can change we need
   to check this before adjusting the selrect"
   [shape points]
+  (let [points' (dm/get-prop shape :points)
+        p0'     (nth points' 0)
+        p0      (nth points 0)
 
-  (let [points' (:points shape)
+        ;; FIXME: unroll and remove point allocation here
+        xv1     (gpt/to-vec p0' (nth points' 1))
+        xv2     (gpt/to-vec p0  (nth points 1))
+        dot-x   (gpt/dot xv1 xv2)
 
-        xv1 (gpt/to-vec (nth points' 0) (nth points' 1))
-        xv2 (gpt/to-vec (nth points 0) (nth points 1))
-        dot-x (gpt/dot xv1 xv2)
-
-        yv1 (gpt/to-vec (nth points' 0) (nth points' 3))
-        yv2 (gpt/to-vec (nth points 0) (nth points 3))
-        dot-y (gpt/dot yv1 yv2)]
+        yv1     (gpt/to-vec p0' (nth points' 3))
+        yv2     (gpt/to-vec p0  (nth points 3))
+        dot-y   (gpt/dot yv1 yv2)]
 
     (cond-> shape
       (neg? dot-x)
-      (-> (update :flip-x not)
-          (update :rotation -))
+      (-> (cr/update! :flip-x not)
+          (cr/update! :rotation -))
 
       (neg? dot-y)
-      (-> (update :flip-y not)
-          (update :rotation -)))))
+      (-> (cr/update! :flip-y not)
+          (cr/update! :rotation -)))))
 
 (defn- apply-transform-move
   "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]
-  (let [bool?   (= (:type shape) :bool)
-        path?   (= (:type shape) :path)
-        text?   (= (:type shape) :text)
-        {dx :x dy :y} (gpt/transform (gpt/point) transform-mtx)
-        points  (gco/transform-points (:points shape) transform-mtx)
-        selrect (gco/transform-selrect (:selrect shape) transform-mtx)]
+  (let [type    (dm/get-prop shape :type)
+        points  (gco/transform-points  (dm/get-prop shape :points) transform-mtx)
+        selrect (gco/transform-selrect (dm/get-prop shape :selrect) transform-mtx)
+
+        ;; NOTE: ensure we start with a fresh copy of shape for mutabilty
+        shape   (cr/clone shape)
+
+        shape   (if (= type :bool)
+                  (update shape :bool-content gpa/transform-content transform-mtx)
+                  shape)
+        shape   (if (= type :text)
+                  (update shape :position-data transform-position-data transform-mtx)
+                  shape)
+        shape   (if (= type :path)
+                  (update shape :content gpa/transform-content transform-mtx)
+                  (cr/assoc! shape
+                             :x (dm/get-prop selrect :x)
+                             :y (dm/get-prop selrect :y)
+                             :width (dm/get-prop selrect :width)
+                             :height (dm/get-prop selrect :height)))]
     (-> shape
-        (cond-> bool?
-          (update :bool-content gpa/transform-content transform-mtx))
-        (cond-> path?
-          (update :content gpa/transform-content transform-mtx))
-        (cond-> text?
-          (update :position-data move-position-data dx dy))
-        (cond-> (not path?)
-          (assoc :x (:x selrect)
-                 :y (:y selrect)
-                 :width (:width selrect)
-                 :height (:height selrect)))
-        (assoc :selrect selrect)
-        (assoc :points points))))
+        (cr/assoc! :selrect selrect)
+        (cr/assoc! :points points))))
+
 
 (defn- apply-transform-generic
   "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]
+  (let [points    (-> (dm/get-prop shape :points)
+                      (gco/transform-points transform-mtx))
 
-  (let [points'  (gco/shape->points shape)
-        points   (gco/transform-points points' transform-mtx)
-        shape    (-> shape (adjust-shape-flips points))
-        bool?    (= (:type shape) :bool)
-        path?    (= (:type shape) :path)
+        ;; NOTE: ensure we have a fresh shallow copy of shape
+        shape     (cr/clone shape)
+        shape     (adjust-shape-flips! shape points)
 
-        [selrect transform transform-inverse] (calculate-geometry points)
+        center    (gco/points->center points)
+        selrect   (calculate-selrect points center)
+        transform (calculate-transform points center selrect)
+        inverse   (when (some? transform) (gmt/inverse transform))]
 
-        base-rotation  (or (:rotation shape) 0)
-        modif-rotation (or (get-in shape [:modifiers :rotation]) 0)
-        rotation       (mod (+ base-rotation modif-rotation) 360)]
-
-    (if-not (and transform transform-inverse)
-      ;; When we cannot calculate the transformation we leave the shape as it was
+    (if-not (and (some? inverse) (some? transform))
       shape
-      (-> shape
-          (cond-> bool?
-            (update :bool-content gpa/transform-content transform-mtx))
-          (cond-> path?
-            (update :content gpa/transform-content transform-mtx))
-          (cond-> (not path?)
-            (assoc :x (:x selrect)
-                   :y (:y selrect)
-                   :width (:width selrect)
-                   :height (:height selrect)))
-          (cond-> transform
-            (-> (assoc :transform transform)
-                (assoc :transform-inverse transform-inverse)))
-          (cond-> (not transform)
-            (dissoc :transform :transform-inverse))
-          (cond-> (some? selrect)
-            (assoc :selrect selrect))
+      (let [type     (dm/get-prop shape :type)
+            rotation (mod (+ (d/nilv (:rotation shape) 0)
+                             (d/nilv (dm/get-in shape [:modifiers :rotation]) 0))
+                          360)
+            shape    (if (= type :bool)
+                       (update shape :bool-content gpa/transform-content transform-mtx)
+                       shape)
 
-          (cond-> (d/not-empty? points)
-            (assoc :points points))
-          (assoc :rotation rotation)))))
+            shape    (if (= type :path)
+                       (update shape :content gpa/transform-content transform-mtx)
+                       (cr/assoc! shape
+                                  :x (dm/get-prop selrect :x)
+                                  :y (dm/get-prop selrect :y)
+                                  :width (dm/get-prop selrect :width)
+                                  :height (dm/get-prop selrect :height)))]
+        (-> shape
+            (cr/assoc! :transform transform)
+            (cr/assoc! :transform-inverse inverse)
+            (cr/assoc! :selrect selrect)
+            (cr/assoc! :points points)
+            (cr/assoc! :rotation rotation))))))
 
 (defn- apply-transform
   "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 (gmt/move? transform-mtx)
+  (if ^boolean (gmt/move? transform-mtx)
     (apply-transform-move shape transform-mtx)
     (apply-transform-generic shape transform-mtx)))
 
@@ -385,7 +399,7 @@
   (let [;; Points for every shape inside the group
         points (->> children (mapcat :points))
 
-        shape-center (gco/center-points points)
+        shape-center (gco/points->center points)
 
         ;; Fixed problem with empty groups. Should not happen (but it does)
         points (if (empty? points) (:points group) points)
@@ -393,13 +407,14 @@
         ;; Invert to get the points minus the transforms applied to the group
         base-points (gco/transform-points points shape-center (:transform-inverse group (gmt/matrix)))
 
+        ;; FIXME: looks redundant operation points -> rect -> points
         ;; Defines the new selection rect with its transformations
-        new-points (-> (gpr/points->selrect base-points)
-                       (gpr/rect->points)
+        new-points (-> (grc/points->rect base-points)
+                       (grc/rect->points)
                        (gco/transform-points shape-center (:transform group (gmt/matrix))))
 
         ;; Calculate the new selrect
-        new-selrect (gpr/points->selrect base-points)]
+        new-selrect (grc/points->rect base-points)]
 
     ;; Updates the shape and the applytransform-rect will update the other properties
     (-> group
@@ -440,6 +455,29 @@
           (assoc :points points))
       (update-group-selrect shape children))))
 
+(defn update-shapes-geometry
+  [objects ids]
+  (->> ids
+       (reduce
+        (fn [objects id]
+          (let [shape (get objects id)
+                children (cph/get-immediate-children objects id)
+                shape
+                (cond
+                  (cph/mask-shape? shape)
+                  (update-mask-selrect shape children)
+
+                  (cph/bool-shape? shape)
+                  (update-bool-selrect shape children objects)
+
+                  (cph/group-shape? shape)
+                  (update-group-selrect shape children)
+
+                  :else
+                  shape)]
+            (assoc objects id shape)))
+        objects)))
+
 (defn transform-shape
   ([shape]
    (let [modifiers (:modifiers shape)]
@@ -448,21 +486,16 @@
          (transform-shape modifiers))))
 
   ([shape modifiers]
-   (letfn [(apply-modifiers
-             [shape modifiers]
-             (if (ctm/empty? modifiers)
-               shape
-               (let [transform (ctm/modifiers->transform modifiers)]
-                 (cond-> shape
-                   (and (some? transform) (not= uuid/zero (:id shape))) ;; Never transform the root frame
-                   (apply-transform transform)
+   (if (and (some? modifiers) (not (ctm/empty? modifiers)))
+     (let [transform (ctm/modifiers->transform modifiers)]
+       (cond-> shape
+         (and (some? transform)
+              (not (cph/root? shape)))
+         (apply-transform transform)
 
-                   (ctm/has-structure? modifiers)
-                   (ctm/apply-structure-modifiers modifiers)))))]
-
-     (cond-> shape
-       (and (some? modifiers) (not (ctm/empty? modifiers)))
-       (apply-modifiers modifiers)))))
+         (ctm/has-structure? modifiers)
+         (ctm/apply-structure-modifiers modifiers)))
+     shape)))
 
 (defn apply-objects-modifiers
   ([objects modifiers]
@@ -492,24 +525,16 @@
 (defn transform-selrect
   [selrect modifiers]
   (-> selrect
-      (gpr/rect->points)
+      (grc/rect->points)
       (transform-bounds modifiers)
-      (gpr/points->selrect)))
+      (grc/points->rect)))
 
 (defn transform-selrect-matrix
   [selrect mtx]
   (-> selrect
-      (gpr/rect->points)
+      (grc/rect->points)
       (gco/transform-points mtx)
-      (gpr/points->selrect)))
-
-(defn selection-rect
-  "Returns a rect that contains all the shapes and is aware of the
-  rotation of each shape. Mainly used for multiple selection."
-  [shapes]
-  (->> shapes
-       (map (comp gpr/points->selrect :points transform-shape))
-       (gpr/join-selrects)))
+      (grc/points->rect)))
 
 (declare apply-group-modifiers)
 

common/src/app/common/geom/snap.cljc

@@ -0,0 +1,61 @@
+;; 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.snap
+  (:require
+   [app.common.data.macros :as dm]
+   [app.common.geom.point :as gpt]
+   [app.common.geom.rect :as grc]
+   [app.common.geom.shapes :as gsh]
+   [app.common.pages.helpers :as cph]
+   [app.common.types.shape-tree :as ctst]))
+
+(defn rect->snap-points
+  [rect]
+  (let [x (dm/get-prop rect :x)
+        y (dm/get-prop rect :y)
+        w (dm/get-prop rect :width)
+        h (dm/get-prop rect :height)]
+    #{(gpt/point x y)
+      (gpt/point (+ x w) y)
+      (gpt/point (+ x w) (+ y h))
+      (gpt/point x (+ y h))
+      (grc/rect->center rect)}))
+
+(defn- frame->snap-points
+  [frame]
+  (let [points (dm/get-prop frame :points)
+        rect   (grc/points->rect points)
+        x      (dm/get-prop rect :x)
+        y      (dm/get-prop rect :y)
+        w      (dm/get-prop rect :width)
+        h      (dm/get-prop rect :height)]
+    (into (rect->snap-points rect)
+          #{(gpt/point (+ x (/ w 2)) y)
+            (gpt/point (+ x w) (+ y (/ h 2)))
+            (gpt/point (+ x (/ w 2)) (+ y h))
+            (gpt/point x (+ y (/ h 2)))})))
+
+(defn shape->snap-points
+  [shape]
+  (if ^boolean (cph/frame-shape? shape)
+    (frame->snap-points shape)
+    (->> (dm/get-prop shape :points)
+         (into #{(gsh/shape->center shape)}))))
+
+(defn guide->snap-points
+  [guide frame]
+  (cond
+    (and (some? frame)
+         (not ^boolean (ctst/rotated-frame? frame))
+         (not ^boolean (cph/is-direct-child-of-root? frame)))
+    #{}
+
+    (= :x (:axis guide))
+    #{(gpt/point (:position guide) 0)}
+
+    :else
+    #{(gpt/point 0 (:position guide))}))

common/src/app/common/math.cljc

@@ -6,9 +6,24 @@
 
 (ns app.common.math
   "A collection of math utils."
-  (:refer-clojure :exclude [abs])
+  (:refer-clojure :exclude [abs min max])
   #?(:cljs
-     (:require [goog.math :as math])))
+     (:require-macros [app.common.math :refer [min max]]))
+  (:require
+   #?(:cljs [goog.math :as math])
+   [clojure.core :as c]))
+
+(defmacro min
+  [& params]
+  (if (:ns &env)
+    `(js/Math.min ~@params)
+    `(c/min ~@params)))
+
+(defmacro max
+  [& params]
+  (if (:ns &env)
+    `(js/Math.max ~@params)
+    `(c/max ~@params)))
 
 (def PI
   #?(:cljs (.-PI js/Math)
@@ -177,7 +192,7 @@
 (defn round-to-zero
   "Given a number if it's close enough to zero round to the zero to avoid precision problems"
   [num]
-  (if (almost-zero? num)
+  (if (< (abs num) 1e-4)
     0
     num))
 
@@ -198,10 +213,12 @@
 
 (defn max-abs
   [a b]
-  (max (abs a) (abs b)))
+  (max (abs a)
+       (abs b)))
 
 (defn sign
   "Get the sign (+1 / -1) for the number"
   [n]
   (if (neg? n) -1 1))
 
+

common/src/app/common/pages.cljc

@@ -9,34 +9,11 @@
   (:require
    [app.common.data.macros :as dm]
    [app.common.pages.changes :as changes]
-   [app.common.pages.common :as common]
-   [app.common.pages.focus :as focus]
-   [app.common.pages.indices :as indices]
-   [app.common.types.file :as ctf]))
-
-;; Common
-(dm/export common/root)
-(dm/export common/file-version)
-(dm/export common/default-color)
-(dm/export common/component-sync-attrs)
-(dm/export common/retrieve-used-names)
-(dm/export common/generate-unique-name)
-
-;; Focus
-(dm/export focus/focus-objects)
-(dm/export focus/filter-not-focus)
-(dm/export focus/is-in-focus?)
+   [app.common.pages.indices :as indices]))
 
 ;; Indices
-#_(dm/export indices/calculate-z-index)
-#_(dm/export indices/update-z-index)
 (dm/export indices/generate-child-all-parents-index)
-(dm/export indices/generate-child-parent-index)
 (dm/export indices/create-clip-index)
 
 ;; Process changes
 (dm/export changes/process-changes)
-
-;; Initialization
-(dm/export ctf/make-file-data)
-(dm/export ctf/empty-file-data)

common/src/app/common/pages/changes.cljc

@@ -12,7 +12,6 @@
    [app.common.exceptions :as ex]
    [app.common.geom.shapes :as gsh]
    [app.common.math :as mth]
-   [app.common.pages.common :refer [component-sync-attrs]]
    [app.common.pages.helpers :as cph]
    [app.common.schema :as sm]
    [app.common.schema.desc-native :as smd]
@@ -20,6 +19,7 @@
    [app.common.types.colors-list :as ctcl]
    [app.common.types.component :as ctk]
    [app.common.types.components-list :as ctkl]
+   [app.common.types.component :as ctk]
    [app.common.types.container :as ctn]
    [app.common.types.file :as ctf]
    [app.common.types.page :as ctp]
@@ -50,7 +50,7 @@
    [:set-remote-synced
     [:map {:title "SetRemoteSyncedOperation"}
      [:type [:= :set-remote-synced]]
-     [:remote-synced? [:maybe :boolean]]]]])
+     [:remote-synced {:optional true} [:maybe :boolean]]]]])
 
 (sm/def! ::change
   [:schema
@@ -68,15 +68,14 @@
      [:map {:title "AddObjChange"}
       [:type [:= :add-obj]]
       [:id ::sm/uuid]
-      [:obj [:map-of {:gen/max 10} :keyword :any]]
+      [:obj :map]
       [:page-id {:optional true} ::sm/uuid]
       [:component-id {:optional true} ::sm/uuid]
-      [:frame-id {:optional true} ::sm/uuid]
-      [:parent-id {:optional true} ::sm/uuid]
+      [:frame-id ::sm/uuid]
+      [:parent-id {:optional true} [:maybe ::sm/uuid]]
       [:index {:optional true} [:maybe :int]]
       [:ignore-touched {:optional true} :boolean]]]
 
-
     [:mod-obj
      [:map {:title "ModObjChange"}
       [:type [:= :mod-obj]]
@@ -97,6 +96,7 @@
      [:map {:title "FixObjChange"}
       [:type [:= :fix-obj]]
       [:id ::sm/uuid]
+      [:fix {:optional true} :keyword]
       [:page-id {:optional true} ::sm/uuid]
       [:component-id {:optional true} ::sm/uuid]]]
 
@@ -108,9 +108,18 @@
       [:ignore-touched {:optional true} :boolean]
       [:parent-id ::sm/uuid]
       [:shapes :any]
-      [:index {:optional true} :int]
+      [:index {:optional true} [:maybe :int]]
       [:after-shape {:optional true} :any]]]
 
+    [:reorder-children
+     [:map {:title "ReorderChildrenChange"}
+      [:type [:= :reorder-children]]
+      [:page-id {:optional true} ::sm/uuid]
+      [:component-id {:optional true} ::sm/uuid]
+      [:ignore-touched {:optional true} :boolean]
+      [:parent-id ::sm/uuid]
+      [:shapes :any]]]
+
     [:add-page
      [:map {:title "AddPageChange"}
       [:type [:= :add-page]]
@@ -226,10 +235,10 @@
 (sm/def! ::changes
   [:sequential {:gen/max 2} ::change])
 
-(def change?
+(def valid-change?
   (sm/pred-fn ::change))
 
-(def changes?
+(def valid-changes?
   (sm/pred-fn [:sequential ::change]))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -256,7 +265,8 @@
               ;; If object has changed or is new verify is correct
               (when (and (some? shape-new)
                          (not= shape-old shape-new))
-                (dm/verify! (cts/shape? shape-new)))))]
+                (dm/verify! (and (cts/shape? shape-new)
+                                 (cts/valid-shape? shape-new))))))]
 
     (->> (into #{} (map :page-id) items)
          (mapcat (fn [page-id]
@@ -281,7 +291,7 @@
    ;; When verify? false we spec the schema validation. Currently used to make just
    ;; 1 validation even if the changes are applied twice
    (when verify?
-     (dm/verify! (changes? items)))
+     (dm/verify! (valid-changes? items)))
 
    (let [result (reduce #(or (process-change %1 %2) %1) data items)]
      ;; Validate result shapes (only on the backend)
@@ -340,6 +350,51 @@
         (d/update-in-when $ [:components component-id :objects] update-fn))
       (check-modify-component $))))
 
+(defmethod process-change :reorder-children
+  [data {:keys [parent-id shapes page-id component-id]}]
+  (let [changed? (atom false)
+
+        update-fn
+        (fn [objects]
+          (let [old-shapes (dm/get-in objects [parent-id :shapes])
+
+                id->idx
+                (update-vals
+                 (->> shapes
+                      d/enumerate
+                      (group-by second))
+                 (comp first first))
+
+                new-shapes
+                (into [] (sort-by #(d/nilv (id->idx %) -1) < old-shapes))]
+
+            (reset! changed? (not= old-shapes new-shapes))
+
+            (cond-> objects
+              @changed?
+              (assoc-in [parent-id :shapes] new-shapes))))
+
+        check-modify-component
+        (fn [data]
+          (if @changed?
+            ;; When a shape is modified, if it belongs to a main component instance,
+            ;; the component needs to be marked as modified.
+            (let [objects (if page-id
+                            (-> data :pages-index (get page-id) :objects)
+                            (-> data :components (get component-id) :objects))
+                  shape (get objects parent-id)
+                  component-root (ctn/get-component-shape objects shape {:allow-main? true})]
+              (if (and (some? component-root) (ctk/main-instance? component-root))
+                (ctkl/set-component-modified data (:component-id component-root))
+                data))
+            data))]
+
+    (as-> data $
+      (if page-id
+        (d/update-in-when $ [:pages-index page-id :objects] update-fn)
+        (d/update-in-when $ [:components component-id :objects] update-fn))
+      (check-modify-component $))))
+
 (defmethod process-change :del-obj
   [data {:keys [page-id component-id id ignore-touched]}]
   (if page-id
@@ -347,10 +402,16 @@
     (d/update-in-when data [:components component-id] ctst/delete-shape id ignore-touched)))
 
 (defmethod process-change :fix-obj
-  [data {:keys [page-id component-id] :as params}]
-  (if page-id
-    (d/update-in-when data [:pages-index page-id] ctst/fix-shape-children params)
-    (d/update-in-when data [:components component-id] ctst/fix-shape-children params)))
+  [data {:keys [page-id component-id id] :as params}]
+  (letfn [(fix-container [container]
+            (case (:fix params :broken-children)
+              :broken-children (ctst/fix-broken-children container id)
+              (ex/raise :type :internal
+                        :code :fix-not-implemented
+                        :fix (:fix params))))]
+    (if page-id
+      (d/update-in-when data [:pages-index page-id] fix-container)
+      (d/update-in-when data [:components component-id] fix-container))))
 
 ;; FIXME: remove, seems like this method is already unused
 ;; reg-objects operation "regenerates" the geometry and selrect of the parent groups
@@ -391,7 +452,7 @@
                 (= :bool (:type group))
                 (gsh/update-bool-selrect group children objects)
 
-                (:masked-group? group)
+                (:masked-group group)
                 (set-mask-selrect group children)
 
                 :else
@@ -435,7 +496,7 @@
                      (#{:group :frame} (:type parent))
                      (not ignore-touched))
                 (-> (update :touched cph/set-touched-group :shapes-group)
-                    (dissoc :remote-synced?)))))
+                    (dissoc :remote-synced)))))
 
           (remove-from-old-parent [old-objects objects shape-id]
             (let [prev-parent-id (dm/get-in old-objects [shape-id :parent-id])]
@@ -454,7 +515,7 @@
                       (d/update-in-when [pid :shapes] d/vec-without-nils)
                       (cond-> component? (d/update-when pid #(-> %
                                                                  (update :touched cph/set-touched-group :shapes-group)
-                                                                 (dissoc :remote-synced?)))))))))
+                                                                 (dissoc :remote-synced)))))))))
           (update-parent-id [objects id]
             (-> objects
                 (d/update-when id assoc :parent-id parent-id)))
@@ -600,14 +661,13 @@
 (defmethod process-operation :set
   [on-changed shape op]
   (let [attr            (:attr op)
-        group           (get component-sync-attrs attr)
+        group           (get ctk/sync-attrs attr)
         val             (:val op)
         shape-val       (get shape attr)
-        ignore          (:ignore-touched op)
-        ignore-geometry (:ignore-geometry op)
+        ignore          (or (:ignore-touched op) (= attr :position-data)) ;; position-data is a derived attribute and
+        ignore-geometry (:ignore-geometry op)                             ;; never triggers touched by itself
         is-geometry?    (and (or (= group :geometry-group)
-                                 (and (= group :content-group) (= (:type shape) :path))
-                                 (= attr :position-data))
+                                 (and (= group :content-group) (= (:type shape) :path)))
                              (not (#{:width :height} attr))) ;; :content in paths are also considered geometric
                         ;; TODO: the check of :width and :height probably may be removed
                         ;;       after the check added in data/workspace/modifiers/check-delta
@@ -636,7 +696,7 @@
       (and in-copy? group (not ignore) (not equal?)
            (not (and ignore-geometry is-geometry?)))
       (-> (update :touched cph/set-touched-group group)
-          (dissoc :remote-synced?))
+          (dissoc :remote-synced))
 
       (nil? val)
       (dissoc attr)
@@ -654,11 +714,11 @@
 
 (defmethod process-operation :set-remote-synced
   [_ shape op]
-  (let [remote-synced? (:remote-synced? op)
+  (let [remote-synced (:remote-synced op)
         in-copy? (ctk/in-component-copy? shape)]
-    (if (or (not in-copy?) (not remote-synced?))
-      (dissoc shape :remote-synced?)
-      (assoc shape :remote-synced? true))))
+    (if (or (not in-copy?) (not remote-synced))
+      (dissoc shape :remote-synced)
+      (assoc shape :remote-synced true))))
 
 (defmethod process-operation :default
   [_ _ op]
@@ -686,19 +746,18 @@
                        ; We need to trigger a sync if the shape has changed any
                        ; attribute that participates in components synchronization.
                        (and (= (:type operation) :set)
-                            (component-sync-attrs (:attr operation))))
+                            (get ctk/sync-attrs (:attr operation))))
           any-sync? (some need-sync? operations)]
       (when any-sync?
-        (let [xform (comp (filter :main-instance?) ; Select shapes that are main component instances
+        (let [xform (comp (filter :main-instance) ; Select shapes that are main component instances
                           (map :component-id))]
           (into #{} xform shape-and-parents))))))
 
 (defmethod components-changed :mov-objects
   [file-data {:keys [page-id _component-id parent-id shapes] :as change}]
   (when page-id
-    (let [page (ctpl/get-page file-data page-id)
-
-          xform (comp (filter :main-instance?)
+    (let [page  (ctpl/get-page file-data page-id)
+          xform (comp (filter :main-instance)
                       (map :component-id))
 
           check-shape
@@ -717,7 +776,7 @@
     (let [page (ctpl/get-page file-data page-id)
           shape-and-parents (map (partial ctn/get-shape page)
                                  (cons id (cph/get-parent-ids (:objects page) id)))
-          xform (comp (filter :main-instance?)
+          xform (comp (filter :main-instance)
                       (map :component-id))]
       (into #{} xform shape-and-parents))))
 

common/src/app/common/pages/changes_builder.cljc

@@ -11,16 +11,31 @@
    [app.common.files.features :as ffeat]
    [app.common.geom.matrix :as gmt]
    [app.common.geom.point :as gpt]
+   [app.common.geom.rect :as grc]
    [app.common.geom.shapes :as gsh]
    [app.common.math :as mth]
    [app.common.pages :as cp]
    [app.common.pages.helpers :as cph]
+   [app.common.schema :as sm]
    [app.common.types.component :as ctk]
    [app.common.types.file :as ctf]
+   [app.common.types.shape.layout :as ctl]
    [app.common.uuid :as uuid]))
 
 ;; Auxiliary functions to help create a set of changes (undo + redo)
 
+(def schema:changes
+  [:map
+   [:redo-changes vector?]
+   [:undo-changes seq?]
+   [:origin {:optional true} any?]
+   [:save-undo? {:optional true} boolean?]
+   [:stack-undo? {:optional true} boolean?]
+   [:undo-group {:optional true} any?]])
+
+(def valid-changes?
+  (sm/pred-fn schema:changes))
+
 (defn empty-changes
   ([origin page-id]
    (let [changes (empty-changes origin)]
@@ -29,7 +44,7 @@
 
   ([origin]
    {:redo-changes []
-    :undo-changes []
+    :undo-changes '()
     :origin origin}))
 
 (defn set-save-undo?
@@ -67,6 +82,15 @@
                ::file-data fdata
                ::applied-changes-count 0)))
 
+(defn with-file-data
+  [changes fdata]
+  (let [page-id (::page-id (meta changes))
+        fdata (assoc-in fdata [:pages-index uuid/zero]
+                        (get-in fdata [:pages-index page-id]))]
+    (vary-meta changes assoc
+               ::file-data fdata
+               ::applied-changes-count 0)))
+
 (defn with-library-data
   [changes data]
   (vary-meta changes assoc
@@ -85,34 +109,45 @@
 
 (defn concat-changes
   [changes1 changes2]
-  {:redo-changes (d/concat-vec (:redo-changes changes1) (:redo-changes changes2))
-   :undo-changes (d/concat-vec (:undo-changes changes1) (:undo-changes changes2))
+  {:redo-changes (d/concat-vec (:redo-changes changes1)
+                               (:redo-changes changes2))
+   :undo-changes (concat (:undo-changes changes1)
+                         (:undo-changes changes2))
    :origin (:origin changes1)
    :undo-group (:undo-group changes1)
    :tags (:tags changes1)})
 
 ; TODO: remove this when not needed
-(defn- assert-page-id
+(defn- assert-page-id!
   [changes]
-  (assert (contains? (meta changes) ::page-id) "Give a page-id or call (with-page) before using this function"))
+  (dm/assert!
+   "Give a page-id or call (with-page) before using this function"
+   (contains? (meta changes) ::page-id)))
 
-(defn- assert-container-id
+(defn- assert-container-id!
   [changes]
-  (assert (or (contains? (meta changes) ::page-id)
-              (contains? (meta changes) ::component-id))
-          "Give a page-id or call (with-container) before using this function"))
+  (dm/assert!
+   "Give a page-id or call (with-container) before using this function"
+   (or (contains? (meta changes) ::page-id)
+       (contains? (meta changes) ::component-id))))
 
-(defn- assert-page
+(defn- assert-page!
   [changes]
-  (assert (contains? (meta changes) ::page) "Call (with-page) before using this function"))
+  (dm/assert!
+   "Call (with-page) before using this function"
+   (contains? (meta changes) ::page)))
 
-(defn- assert-objects
+(defn- assert-objects!
   [changes]
-  (assert (contains? (meta changes) ::file-data) "Call (with-objects) before using this function"))
+  (dm/assert!
+   "Call (with-objects) before using this function"
+   (contains? (meta changes) ::file-data)))
 
-(defn- assert-library
+(defn- assert-library!
   [changes]
-  (assert (contains? (meta changes) ::library-data) "Call (with-library-data) before using this function"))
+  (dm/assert!
+   "Call (with-library-data) before using this function"
+   (contains? (meta changes) ::library-data)))
 
 (defn- lookup-objects
   [changes]
@@ -121,6 +156,10 @@
 
 (defn- apply-changes-local
   [changes]
+  (dm/assert!
+   "expected valid changes"
+   (valid-changes? changes))
+
   (if-let [file-data (::file-data (meta changes))]
     (let [index         (::applied-changes-count (meta changes))
           redo-changes  (:redo-changes changes)
@@ -141,40 +180,40 @@
   [changes id name]
   (-> changes
       (update :redo-changes conj {:type :add-page :id id :name name})
-      (update :undo-changes d/preconj {:type :del-page :id id})
+      (update :undo-changes conj {:type :del-page :id id})
       (apply-changes-local)))
 
 (defn add-page
   [changes id page]
   (-> changes
       (update :redo-changes conj {:type :add-page :id id :page page})
-      (update :undo-changes d/preconj {:type :del-page :id id})
+      (update :undo-changes conj {:type :del-page :id id})
       (apply-changes-local)))
 
 (defn mod-page
   [changes page new-name]
   (-> changes
       (update :redo-changes conj {:type :mod-page :id (:id page) :name new-name})
-      (update :undo-changes d/preconj {:type :mod-page :id (:id page) :name (:name page)})
+      (update :undo-changes conj {:type :mod-page :id (:id page) :name (:name page)})
       (apply-changes-local)))
 
 (defn del-page
   [changes page]
   (-> changes
       (update :redo-changes conj {:type :del-page :id (:id page)})
-      (update :undo-changes d/preconj {:type :add-page :id (:id page) :page page})
+      (update :undo-changes conj {:type :add-page :id (:id page) :page page})
       (apply-changes-local)))
 
 (defn move-page
   [changes page-id index prev-index]
   (-> changes
       (update :redo-changes conj {:type :mov-page :id page-id :index index})
-      (update :undo-changes d/preconj {:type :mov-page :id page-id :index prev-index})
+      (update :undo-changes conj {:type :mov-page :id page-id :index prev-index})
       (apply-changes-local)))
 
 (defn set-page-option
   [changes option-key option-val]
-  (assert-page changes)
+  (assert-page! changes)
   (let [page-id (::page-id (meta changes))
         page (::page (meta changes))
         old-val (get-in page [:options option-key])]
@@ -184,7 +223,7 @@
                                     :page-id page-id
                                     :option option-key
                                     :value option-val})
-        (update :undo-changes d/preconj {:type :set-option
+        (update :undo-changes conj {:type :set-option
                                          :page-id page-id
                                          :option option-key
                                          :value old-val})
@@ -192,7 +231,7 @@
 
 (defn update-page-option
   [changes option-key update-fn & args]
-  (assert-page changes)
+  (assert-page! changes)
   (let [page-id (::page-id (meta changes))
         page (::page (meta changes))
         old-val (get-in page [:options option-key])
@@ -203,7 +242,7 @@
                                     :page-id page-id
                                     :option option-key
                                     :value new-val})
-        (update :undo-changes d/preconj {:type :set-option
+        (update :undo-changes conj {:type :set-option
                                          :page-id page-id
                                          :option option-key
                                          :value old-val})
@@ -216,8 +255,11 @@
    (add-object changes obj nil))
 
   ([changes obj {:keys [index ignore-touched] :or {index ::undefined ignore-touched false}}]
-   (assert-page-id changes)
-   (assert-objects changes)
+
+   ;; FIXME: add shape validation
+
+   (assert-page-id! changes)
+   (assert-objects! changes)
    (let [obj (cond-> obj
                (not= index ::undefined)
                (assoc ::index index))
@@ -233,7 +275,7 @@
           :frame-id       (:frame-id obj)
           :index          (::index obj)
           :ignore-touched ignore-touched
-          :obj            (dissoc obj ::index :parent-id)}
+          :obj            (dissoc obj ::index)}
 
          del-change
          {:type :del-obj
@@ -251,8 +293,8 @@
          (update :redo-changes conj add-change)
          (cond->
            (and (ctk/in-component-copy? parent) (not ignore-touched))
-           (update :undo-changes d/preconj restore-touched-change))
-         (update :undo-changes d/preconj del-change)
+           (update :undo-changes conj restore-touched-change))
+         (update :undo-changes conj del-change)
          (apply-changes-local)))))
 
 (defn add-objects
@@ -269,8 +311,8 @@
    (change-parent changes parent-id shapes nil))
 
   ([changes parent-id shapes index]
-   (assert-page-id changes)
-   (assert-objects changes)
+   (assert-page-id! changes)
+   (assert-objects! changes)
    (let [objects (lookup-objects changes)
          parent  (get objects parent-id)
 
@@ -284,16 +326,15 @@
            (assoc :index index))
 
          mk-undo-change
-         (fn [change-set shape]
+         (fn [undo-changes shape]
            (let [prev-sibling (cph/get-prev-sibling objects (:id shape))]
-           (d/preconj
-             change-set
-             {:type :mov-objects
-              :page-id (::page-id (meta changes))
-              :parent-id (:parent-id shape)
-              :shapes [(:id shape)]
-              :after-shape prev-sibling
-              :index 0}))) ; index is used in case there is no after-shape (moving bottom shapes)
+           (conj undo-changes
+                 {:type :mov-objects
+                  :page-id (::page-id (meta changes))
+                  :parent-id (:parent-id shape)
+                  :shapes [(:id shape)]
+                  :after-shape prev-sibling
+                  :index 0}))) ; index is used in case there is no after-shape (moving bottom shapes)
 
          restore-touched-change
          {:type :mod-obj
@@ -306,7 +347,7 @@
          (update :redo-changes conj set-parent-change)
          (cond->
            (ctk/in-component-copy? parent)
-           (update :undo-changes d/preconj restore-touched-change))
+           (update :undo-changes conj restore-touched-change))
          (update :undo-changes #(reduce mk-undo-change % shapes))
          (apply-changes-local)))))
 
@@ -331,24 +372,37 @@
 
   ([changes ids update-fn {:keys [attrs ignore-geometry? ignore-touched]
                            :or {ignore-geometry? false ignore-touched false}}]
-   (assert-container-id changes)
-   (assert-objects changes)
+   (assert-container-id! changes)
+   (assert-objects! changes)
    (let [page-id      (::page-id (meta changes))
          component-id (::component-id (meta changes))
-         objects (lookup-objects changes)
+         objects      (lookup-objects changes)
 
-         generate-operation
-         (fn [operations attr old new ignore-geometry?]
-           (let [old-val (get old attr)
-                 new-val (get new attr)]
-             (if (= old-val new-val)
-               operations
-               (-> operations
-                   (update :rops conj {:type :set :attr attr :val new-val
-                                       :ignore-geometry ignore-geometry?
-                                       :ignore-touched ignore-touched})
-                   (update :uops d/preconj {:type :set :attr attr :val old-val
-                                            :ignore-touched true})))))
+         generate-operations
+         (fn [attrs old new]
+           (loop [rops  []
+                  uops  '()
+                  attrs (seq attrs)]
+             (if-let [attr (first attrs)]
+               (let [old-val (get old attr)
+                     new-val (get new attr)
+                     changed? (not= old-val new-val)
+
+                     rops
+                     (cond-> rops
+                       changed?
+                       (conj  {:type :set :attr attr :val new-val
+                               :ignore-geometry ignore-geometry?
+                               :ignore-touched ignore-touched}))
+
+                     uops
+                     (cond-> uops
+                       changed?
+                       (conj  {:type :set :attr attr :val old-val
+                               :ignore-touched true}))]
+
+                 (recur rops uops (rest attrs)))
+               [rops uops])))
 
          update-shape
          (fn [changes id]
@@ -356,41 +410,35 @@
                  new-obj (update-fn old-obj)]
              (if (= old-obj new-obj)
                changes
-               (let [attrs (or attrs (d/concat-set (keys old-obj) (keys new-obj)))
+               (let [[rops uops] (-> (or attrs (d/concat-set (keys old-obj) (keys new-obj)))
+                                     (generate-operations old-obj new-obj))
 
-                     {rops :rops uops :uops}
-                     (reduce #(generate-operation %1 %2 old-obj new-obj ignore-geometry?)
-                             {:rops [] :uops []}
-                             attrs)
+                     uops        (cond-> uops
+                                   (seq uops)
+                                   (conj {:type :set-touched :touched (:touched old-obj)}))
 
-                     uops (cond-> uops
-                            (seq uops)
-                            (d/preconj {:type :set-touched :touched (:touched old-obj)}))
+                     change      (cond-> {:type :mod-obj :id id}
+                                   (some? page-id)
+                                   (assoc :page-id page-id)
 
-                     change (cond-> {:type :mod-obj
-                                     :id id}
-
-                              (some? page-id)
-                              (assoc :page-id page-id)
-
-                              (some? component-id)
-                              (assoc :component-id component-id))]
+                                   (some? component-id)
+                                   (assoc :component-id component-id))]
 
                  (cond-> changes
                    (seq rops)
                    (update :redo-changes conj (assoc change :operations rops))
 
                    (seq uops)
-                   (update :undo-changes d/preconj (assoc change :operations uops)))))))]
+                   (update :undo-changes conj (assoc change :operations (vec uops))))))))]
 
-             (-> (reduce update-shape changes ids)
-                 (apply-changes-local)))))
+     (-> (reduce update-shape changes ids)
+         (apply-changes-local)))))
 
 (defn remove-objects
   ([changes ids] (remove-objects changes ids nil))
   ([changes ids {:keys [ignore-touched] :or {ignore-touched false}}]
-   (assert-page-id changes)
-   (assert-objects changes)
+   (assert-page-id! changes)
+   (assert-objects! changes)
    (let [page-id (::page-id (meta changes))
          objects (lookup-objects changes)
 
@@ -405,7 +453,7 @@
          add-undo-change-shape
          (fn [change-set id]
            (let [shape (get objects id)]
-             (d/preconj
+             (conj
               change-set
               {:type :add-obj
                :id id
@@ -421,7 +469,7 @@
          (fn [change-set id]
            (let [shape (get objects id)
                  prev-sibling (cph/get-prev-sibling objects (:id shape))]
-             (d/preconj
+             (conj
               change-set
               {:type :mov-objects
                :page-id page-id
@@ -440,8 +488,8 @@
 
 (defn resize-parents
   [changes ids]
-  (assert-page-id changes)
-  (assert-objects changes)
+  (assert-page-id! changes)
+  (assert-objects! changes)
   (let [page-id (::page-id (meta changes))
 
         objects (lookup-objects changes)
@@ -468,7 +516,7 @@
                           (every? #(apply gpt/close? %) (d/zip old-val new-val))
 
                           (= attr :selrect)
-                          (gsh/close-selrect? old-val new-val)
+                          (grc/close-rect? old-val new-val)
 
                           :else
                           (= old-val new-val))]
@@ -476,7 +524,7 @@
               operations
               (-> operations
                   (update :rops conj {:type :set :attr attr :val new-val :ignore-touched true})
-                  (update :uops d/preconj {:type :set :attr attr :val old-val :ignore-touched true})))))
+                  (update :uops conj {:type :set :attr attr :val old-val :ignore-touched true})))))
 
         resize-parent
         (fn [changes parent]
@@ -490,7 +538,7 @@
                                  (gsh/update-bool-selrect parent children objects)
 
                                  (= (:type parent) :group)
-                                 (if (:masked-group? parent)
+                                 (if (:masked-group parent)
                                    (gsh/update-mask-selrect parent children)
                                    (gsh/update-group-selrect parent children)))]
             (if resized-parent
@@ -506,7 +554,7 @@
                 (if (seq rops)
                   (-> changes
                       (update :redo-changes conj (assoc change :operations rops))
-                      (update :undo-changes d/preconj (assoc change :operations uops))
+                      (update :undo-changes conj (assoc change :operations uops))
                       (apply-changes-local))
                   changes))
               changes)))]
@@ -525,89 +573,89 @@
   [changes color]
   (-> changes
       (update :redo-changes conj {:type :add-color :color color})
-      (update :undo-changes d/preconj {:type :del-color :id (:id color)})
+      (update :undo-changes conj {:type :del-color :id (:id color)})
       (apply-changes-local)))
 
 (defn update-color
   [changes color]
-  (assert-library changes)
+  (assert-library! changes)
   (let [library-data (::library-data (meta changes))
         prev-color (get-in library-data [:colors (:id color)])]
     (-> changes
         (update :redo-changes conj {:type :mod-color :color color})
-        (update :undo-changes d/preconj {:type :mod-color :color prev-color})
+        (update :undo-changes conj {:type :mod-color :color prev-color})
         (apply-changes-local))))
 
 (defn delete-color
   [changes color-id]
-  (assert-library changes)
+  (assert-library! changes)
   (let [library-data (::library-data (meta changes))
         prev-color (get-in library-data [:colors color-id])]
     (-> changes
         (update :redo-changes conj {:type :del-color :id color-id})
-        (update :undo-changes d/preconj {:type :add-color :color prev-color})
+        (update :undo-changes conj {:type :add-color :color prev-color})
         (apply-changes-local))))
 
 (defn add-media
   [changes object]
   (-> changes
       (update :redo-changes conj {:type :add-media :object object})
-      (update :undo-changes d/preconj {:type :del-media :id (:id object)})
+      (update :undo-changes conj {:type :del-media :id (:id object)})
       (apply-changes-local)))
 
 (defn update-media
   [changes object]
-  (assert-library changes)
+  (assert-library! changes)
   (let [library-data (::library-data (meta changes))
         prev-object (get-in library-data [:media (:id object)])]
     (-> changes
         (update :redo-changes conj {:type :mod-media :object object})
-        (update :undo-changes d/preconj {:type :mod-media :object prev-object})
+        (update :undo-changes conj {:type :mod-media :object prev-object})
         (apply-changes-local))))
 
 (defn delete-media
   [changes id]
-  (assert-library changes)
+  (assert-library! changes)
   (let [library-data (::library-data (meta changes))
         prev-object (get-in library-data [:media id])]
     (-> changes
         (update :redo-changes conj {:type :del-media :id id})
-        (update :undo-changes d/preconj {:type :add-media :object prev-object})
+        (update :undo-changes conj {:type :add-media :object prev-object})
         (apply-changes-local))))
 
 (defn add-typography
   [changes typography]
   (-> changes
       (update :redo-changes conj {:type :add-typography :typography typography})
-      (update :undo-changes d/preconj {:type :del-typography :id (:id typography)})
+      (update :undo-changes conj {:type :del-typography :id (:id typography)})
       (apply-changes-local)))
 
 (defn update-typography
   [changes typography]
-  (assert-library changes)
+  (assert-library! changes)
   (let [library-data (::library-data (meta changes))
         prev-typography (get-in library-data [:typographies (:id typography)])]
     (-> changes
         (update :redo-changes conj {:type :mod-typography :typography typography})
-        (update :undo-changes d/preconj {:type :mod-typography :typography prev-typography})
+        (update :undo-changes conj {:type :mod-typography :typography prev-typography})
         (apply-changes-local))))
 
 (defn delete-typography
   [changes typography-id]
-  (assert-library changes)
+  (assert-library! changes)
   (let [library-data (::library-data (meta changes))
         prev-typography (get-in library-data [:typographies typography-id])]
     (-> changes
         (update :redo-changes conj {:type :del-typography :id typography-id})
-        (update :undo-changes d/preconj {:type :add-typography :typography prev-typography})
+        (update :undo-changes conj {:type :add-typography :typography prev-typography})
         (apply-changes-local))))
 
 (defn add-component
   ([changes id path name new-shapes updated-shapes main-instance-id main-instance-page]
    (add-component changes id path name new-shapes updated-shapes main-instance-id main-instance-page nil))
   ([changes id path name new-shapes updated-shapes main-instance-id main-instance-page annotation]
-  (assert-page-id changes)
-  (assert-objects changes)
+  (assert-page-id! changes)
+  (assert-objects! changes)
   (let [page-id (::page-id (meta changes))
         objects (lookup-objects changes)
         lookupf (d/getf objects)
@@ -623,11 +671,11 @@
                                    :attr :component-file
                                    :val (:component-file shape)}
                                   {:type :set
-                                   :attr :component-root?
-                                   :val (:component-root? shape)}
+                                   :attr :component-root
+                                   :val (:component-root shape)}
                                   {:type :set
-                                   :attr :main-instance?
-                                   :val (:main-instance? shape)}
+                                   :attr :main-instance
+                                   :val (:main-instance shape)}
                                   {:type :set
                                    :attr :shape-ref
                                    :val (:shape-ref shape)}
@@ -651,7 +699,7 @@
         (update :undo-changes
                 (fn [undo-changes]
                   (-> undo-changes
-                      (d/preconj {:type :del-component
+                      (conj {:type :del-component
                                   :id id
                                   :skip-undelete? true})
                       (into (comp (map :id)
@@ -662,7 +710,7 @@
 
 (defn update-component
   [changes id update-fn]
-  (assert-library changes)
+  (assert-library! changes)
   (let [library-data   (::library-data (meta changes))
         prev-component (get-in library-data [:components id])
         new-component  (update-fn prev-component)]
@@ -672,35 +720,39 @@
                                       :id id
                                       :name (:name new-component)
                                       :path (:path new-component)
+                                      :main-instance-id (:main-instance-id new-component)
+                                      :main-instance-page (:main-instance-page new-component)
                                       :annotation (:annotation new-component)
                                       :objects (:objects new-component)}) ;; this won't exist in components-v2
-          (update :undo-changes d/preconj {:type :mod-component
-                                           :id id
-                                           :name (:name prev-component)
-                                           :path (:path prev-component)
-                                           :annotation (:annotation prev-component)
-                                           :objects (:objects prev-component)}))
+          (update :undo-changes conj {:type :mod-component
+                                      :id id
+                                      :name (:name prev-component)
+                                      :path (:path prev-component)
+                                      :main-instance-id (:main-instance-id prev-component)
+                                      :main-instance-page (:main-instance-page prev-component)
+                                      :annotation (:annotation prev-component)
+                                      :objects (:objects prev-component)}))
       changes)))
 
 (defn delete-component
   [changes id]
-  (assert-library changes)
+  (assert-library! changes)
   (-> changes
       (update :redo-changes conj {:type :del-component
                                   :id id})
-      (update :undo-changes d/preconj {:type :restore-component
+      (update :undo-changes conj {:type :restore-component
                                         :id id})))
 
 (defn restore-component
   ([changes id]
    (restore-component changes id nil))
   ([changes id page-id]
-   (assert-library changes)
+   (assert-library! changes)
    (-> changes
        (update :redo-changes conj {:type :restore-component
                                    :id id
                                    :page-id page-id})
-       (update :undo-changes d/preconj {:type :del-component
+       (update :undo-changes conj {:type :del-component
                                         :id id}))))
 
 (defn ignore-remote
@@ -712,3 +764,42 @@
     (-> changes
         (update :redo-changes add-ignore-remote)
         (update :undo-changes add-ignore-remote))))
+
+(defn reorder-grid-children
+  [changes ids]
+  (assert-page-id! changes)
+  (assert-objects! changes)
+
+  (let [page-id (::page-id (meta changes))
+        objects (lookup-objects changes)
+
+        reorder-grid
+        (fn [changes grid]
+          (let [old-shapes (:shapes grid)
+                grid       (ctl/reorder-grid-children grid)
+                new-shapes (->> (:shapes grid)
+                                (filterv #(contains? objects %)))
+
+                redo-change
+                {:type :reorder-children
+                 :parent-id (:id grid)
+                 :page-id page-id
+                 :shapes new-shapes}
+
+                undo-change
+                {:type :reorder-children
+                 :parent-id (:id grid)
+                 :page-id page-id
+                 :shapes old-shapes}]
+            (-> changes
+                (update :redo-changes conj redo-change)
+                (update :undo-changes conj undo-change)
+                (apply-changes-local))))
+
+        changes
+        (->> ids
+             (map (d/getf objects))
+             (filter ctl/grid-layout?)
+             (reduce reorder-grid changes))]
+
+    changes))

common/src/app/common/pages/helpers.cljc

@@ -22,67 +22,92 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defn root?
-  [{:keys [id type]}]
-  (and (= type :frame) (= id uuid/zero)))
+  [shape]
+  (and (= (dm/get-prop shape :type) :frame)
+       (= (dm/get-prop shape :id) uuid/zero)))
+
+(defn is-direct-child-of-root?
+  ([objects id]
+   (is-direct-child-of-root? (get objects id)))
+  ([shape]
+   (and (some? shape) (= (dm/get-prop shape :frame-id) uuid/zero))))
 
 (defn root-frame?
   ([objects id]
    (root-frame? (get objects id)))
-  ([{:keys [frame-id type]}]
-   (and (= type :frame)
-        (= frame-id uuid/zero))))
+  ([shape]
+   (and (some? shape)
+        (= (dm/get-prop shape :type) :frame)
+        (= (dm/get-prop shape :frame-id) uuid/zero))))
 
 (defn frame-shape?
   ([objects id]
    (frame-shape? (get objects id)))
-  ([{:keys [type]}]
-   (= type :frame)))
+  ([shape]
+   (and (some? shape)
+        (= :frame (dm/get-prop shape :type)))))
 
 (defn group-shape?
   ([objects id]
    (group-shape? (get objects id)))
-  ([{:keys [type]}]
-   (= type :group)))
+  ([shape]
+   (and (some? shape)
+        (= :group (dm/get-prop shape :type)))))
 
 (defn mask-shape?
-  [{:keys [type masked-group?]}]
-  (and (= type :group) masked-group?))
+  ([shape]
+   (and ^boolean (group-shape? shape)
+        ^boolean (:masked-group shape)))
+  ([objects id]
+   (mask-shape? (get objects id))))
 
 (defn bool-shape?
-  [{:keys [type]}]
-  (= type :bool))
+  [shape]
+  (and (some? shape)
+       (= :bool (dm/get-prop shape :type))))
 
 (defn group-like-shape?
-  [{:keys [type]}]
-  (or (= :group type) (= :bool type)))
+  [shape]
+  (or ^boolean (group-shape? shape)
+      ^boolean (bool-shape? shape)))
 
 (defn text-shape?
-  [{:keys [type]}]
-  (= type :text))
+  [shape]
+  (and (some? shape)
+       (= :text (dm/get-prop shape :type))))
 
 (defn rect-shape?
+  [shape]
+  (and (some? shape)
+       (= :rect (dm/get-prop shape :type))))
+
+(defn circle-shape?
   [{:keys [type]}]
-  (= type :rect))
+  (= type :circle))
 
 (defn image-shape?
-  [{:keys [type]}]
-  (= type :image))
+  [shape]
+  (and (some? shape)
+       (= :image (dm/get-prop shape :type))))
 
 (defn svg-raw-shape?
-  [{:keys [type]}]
-  (= type :svg-raw))
+  [shape]
+  (and (some? shape)
+       (= :svg-raw (dm/get-prop shape :type))))
 
 (defn path-shape?
   ([objects id]
    (path-shape? (get objects id)))
-  ([{:keys [type]}]
-   (= type :path)))
+  ([shape]
+   (and (some? shape)
+        (= :path (dm/get-prop shape :type)))))
 
 (defn unframed-shape?
   "Checks if it's a non-frame shape in the top level."
   [shape]
-  (and (not (frame-shape? shape))
-       (= (:frame-id shape) uuid/zero)))
+  (and (some? shape)
+       (not (frame-shape? shape))
+       (= (dm/get-prop shape :frame-id) uuid/zero)))
 
 (defn has-children?
   ([objects id]
@@ -90,10 +115,11 @@
   ([shape]
    (d/not-empty? (:shapes shape))))
 
+;; ---- ACCESSORS
+
 (defn get-children-ids
   [objects id]
-  (letfn [(get-children-ids-rec
-            [id processed]
+  (letfn [(get-children-ids-rec [id processed]
             (when (not (contains? processed id))
               (when-let [shapes (-> (get objects id) :shapes (some-> vec))]
                 (into shapes (mapcat #(get-children-ids-rec % (conj processed id))) shapes))))]
@@ -112,23 +138,34 @@
   (mapv (d/getf objects) (get-children-ids-with-self objects id)))
 
 (defn get-parent
-  "Retrieve the id of the parent for the shape-id (if exists)"
+  "Retrieve the parent for the shape-id (if exists)"
   [objects id]
-  (let [lookup (d/getf objects)]
-    (-> id lookup :parent-id lookup)))
+  (when-let [shape (get objects id)]
+    (get objects (dm/get-prop shape :parent-id))))
 
 (defn get-parent-id
   "Retrieve the id of the parent for the shape-id (if exists)"
   [objects id]
-  (-> objects (get id) :parent-id))
+  (when-let [shape (get objects id)]
+    (dm/get-prop shape :parent-id)))
 
 (defn get-parent-ids
+  "Returns a vector of parents of the specified shape."
+  [objects shape-id]
+  (loop [result []
+         id shape-id]
+    (let [parent-id (get-parent-id objects id)]
+      (if (and (some? parent-id) (not= parent-id id))
+        (recur (conj result parent-id) parent-id)
+        result))))
+
+(defn get-parents
   "Returns a vector of parents of the specified shape."
   [objects shape-id]
   (loop [result [] id shape-id]
     (let [parent-id (dm/get-in objects [id :parent-id])]
       (if (and (some? parent-id) (not= parent-id id))
-        (recur (conj result parent-id) parent-id)
+        (recur (conj result (get objects parent-id)) parent-id)
         result))))
 
 (defn get-parents-with-self
@@ -139,12 +176,12 @@
 (defn hidden-parent?
   "Checks the parent for the hidden property"
   [objects shape-id]
-  (let [parent-id (dm/get-in objects [shape-id :parent-id])]
-    (cond
-      (or (nil? parent-id) (nil? shape-id) (= shape-id uuid/zero) (= parent-id uuid/zero)) false
-      (dm/get-in objects [parent-id :hidden]) true
-      :else
-      (recur objects parent-id))))
+  (let [parent-id (get-parent-id objects shape-id)]
+    (if (or (nil? parent-id) (nil? shape-id) (= shape-id uuid/zero) (= parent-id uuid/zero))
+      false
+      (if ^boolean (dm/get-in objects [parent-id :hidden])
+        true
+        (recur objects parent-id)))))
 
 (defn get-parent-ids-with-index
   "Returns a tuple with the list of parents and a map with the position within each parent"
@@ -152,10 +189,10 @@
   (loop [parent-list []
          parent-indices {}
          current shape-id]
-    (let [parent-id (dm/get-in objects [current :parent-id])
-          parent (get objects parent-id)]
+    (let [parent-id (get-parent-id objects current)
+          parent    (get objects parent-id)]
       (if (and (some? parent) (not= parent-id current))
-        (let [parent-list (conj parent-list parent-id)
+        (let [parent-list    (conj parent-list parent-id)
               parent-indices (assoc parent-indices parent-id (d/index-of (:shapes parent) current))]
           (recur parent-list parent-indices parent-id))
         [parent-list parent-indices]))))
@@ -163,7 +200,7 @@
 (defn get-siblings-ids
   [objects id]
   (let [parent (get-parent objects id)]
-    (into [] (->> (:shapes parent) (remove #(= % id))))))
+    (into [] (remove #(= % id)) (:shapes parent))))
 
 (defn get-frame
   "Get the frame that contains the shape. If the shape is already a
@@ -175,7 +212,7 @@
      (map? shape-or-id)
      (if (frame-shape? shape-or-id)
        shape-or-id
-       (get objects (:frame-id shape-or-id)))
+       (get objects (dm/get-prop shape-or-id :frame-id)))
 
      (= uuid/zero shape-or-id)
      (get objects uuid/zero)
@@ -430,6 +467,12 @@
   [path-vec]
   (str/join " / " path-vec))
 
+(defn clean-path
+  "Remove empty items from the path."
+  [path]
+  (->> (split-path path)
+       (join-path)))
+
 (defn parse-path-name
   "Parse a string in the form 'group / subgroup / name'.
   Retrieve the path and the name in separated values, normalizing spaces."
@@ -448,25 +491,37 @@
       path)
     name))
 
+(defn merge-path-item-with-dot
+  "Put the item at the end of the path."
+  [path name]
+  (if-not (empty? path)
+    (if-not (empty? name)
+      (str path "\u00A0\u2022\u00A0" name)
+      path)
+    name))
+
 (defn compact-path
   "Separate last item of the path, and truncate the others if too long:
     'one'                          ->  ['' 'one' false]
     'one / two / three'            ->  ['one / two' 'three' false]
     'one / two / three / four'     ->  ['one / two / ...' 'four' true]
     'one-item-but-very-long / two' ->  ['...' 'two' true] "
-  [path max-length]
+  [path max-length dot?]
   (let [path-split (split-path path)
-        last-item  (last path-split)]
+        last-item  (last path-split)
+        merge-path (if dot?
+                     merge-path-item-with-dot
+                     merge-path-item)]
     (loop [other-items (seq (butlast path-split))
            other-path  ""]
       (if-let [item (first other-items)]
         (let [full-path (-> other-path
-                            (merge-path-item item)
-                            (merge-path-item last-item))]
+                            (merge-path item)
+                            (merge-path last-item))]
           (if (> (count full-path) max-length)
-            [(merge-path-item other-path "...") last-item true]
+            [(merge-path other-path "...") last-item true]
             (recur (next other-items)
-                   (merge-path-item other-path item))))
+                   (merge-path other-path item))))
         [other-path last-item false]))))
 
 (defn compact-name
@@ -489,8 +544,9 @@
   ;; Implemented with transients for performance. 30~50% better
   (letfn [(process-shape [objects [id shape]]
             (let [frame-id (if (= :frame (:type shape)) id (:frame-id shape))
-                  cur (-> (or (get objects frame-id) (transient {}))
-                          (assoc! id shape))]
+                  cur      (-> (or (get objects frame-id)
+                                   (transient {}))
+                               (assoc! id shape))]
               (assoc! objects frame-id cur)))]
     (update-vals
      (->> objects

common/src/app/common/pages/indices.cljc

@@ -9,13 +9,6 @@
    [app.common.pages.helpers :as cph]
    [app.common.uuid :as uuid]))
 
-(defn generate-child-parent-index
-  [objects]
-  (reduce-kv
-   (fn [index id obj]
-     (assoc index id (:parent-id obj)))
-   {} objects))
-
 (defn generate-child-all-parents-index
   "Creates an index where the key is the shape id and the value is a set
   with all the parents"
@@ -42,7 +35,7 @@
                          (not= uuid/zero (:id shape)))
                     (conj shape)
 
-                    (:masked-group? shape)
+                    (:masked-group shape)
                     (conj (get objects (->> shape :shapes first)))
 
                     (= :bool (:type shape))

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

@@ -8,8 +8,8 @@
   (:require
    [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.geom.shapes.rect :as gpr]
    [app.common.path.commands :as upc]
    [app.common.path.subpaths :as ups]))
 
@@ -101,7 +101,7 @@
               (if (= :move-to (:command segment))
                 false
                 (let [r1 (command->selrect segment)]
-                  (gpr/overlaps-rects? r1 selrect))))
+                  (grc/overlaps-rects? r1 selrect))))
 
             (overlap-segments?
               [seg-1 seg-2]
@@ -110,7 +110,7 @@
                 false
                 (let [r1 (command->selrect seg-1)
                       r2 (command->selrect seg-2)]
-                  (gpr/overlaps-rects? r1 r2))))
+                  (grc/overlaps-rects? r1 r2))))
 
             (split
               [seg-1 seg-2]
@@ -156,7 +156,7 @@
                 :curve-to (-> (gsp/command->bezier segment)
                               (gsp/curve-values 0.5)))]
 
-    (and (gpr/contains-point? content-sr point)
+    (and (grc/contains-point? content-sr point)
          (or
           (gsp/is-point-in-geom-data? point content-geom)
           (gsp/is-point-in-border? point content)))))
@@ -170,7 +170,7 @@
                 :curve-to (-> (gsp/command->bezier segment)
                               (gsp/curve-values 0.5)))]
 
-    (and (gpr/contains-point? content-sr point)
+    (and (grc/contains-point? content-sr point)
          (gsp/is-point-in-geom-data? point content-geom))))
 
 (defn overlap-segment?

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

@@ -10,7 +10,7 @@
    [app.common.data :as d]
    [app.common.geom.matrix :as gmt]
    [app.common.geom.point :as gpt]
-   [app.common.geom.shapes.common :as gsc]
+   [app.common.geom.shapes.common :as gco]
    [app.common.geom.shapes.corners :as gso]
    [app.common.geom.shapes.path :as gsp]
    [app.common.path.bool :as pb]
@@ -231,7 +231,7 @@
 
            new-content (cond-> new-content
                          (some? transform)
-                         (gsp/transform-content (gmt/transform-in (gsc/center-shape shape) transform)))]
+                         (gsp/transform-content (gmt/transform-in (gco/shape->center shape) transform)))]
 
        (-> shape
            (assoc :type :path)

common/src/app/common/record.cljc

@@ -0,0 +1,451 @@
+;; 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.record
+  "A collection of helpers and macros for defien a penpot customized record types."
+  (:refer-clojure :exclude [defrecord assoc! clone])
+  #?(:cljs (:require-macros [app.common.record]))
+  #?(:clj
+     (:import java.util.Map$Entry)))
+
+#_:clj-kondo/ignore
+(defmacro caching-hash
+  [coll hash-fn hash-key]
+  `(let [h# ~hash-key]
+     (if-not (nil? h#)
+       h#
+       (let [h# (~hash-fn ~coll)]
+         (set! ~hash-key h#)
+         h#))))
+
+#?(:clj
+   (defn- property-symbol
+     [sym]
+     (symbol (str "-" (name sym)))))
+
+#?(:clj
+   (defn- generate-field-access
+     [this-sym val-sym fields]
+     (map (fn [field]
+            (cond
+              (nil? field) nil
+              (identical? field val-sym) val-sym
+              :else `(. ~this-sym ~(property-symbol field))))
+          fields)))
+
+
+(defprotocol ICustomRecordEquiv
+  (-equiv-with-exceptions [_ other exceptions]))
+
+#?(:clj
+   (defn emit-impl-js
+     [tagname base-fields]
+     (let [fields   (conj base-fields '$meta '$extmap (with-meta '$hash {:mutable true}))
+           key-sym  (gensym "key-")
+           val-sym  (gensym "val-")
+           othr-sym (with-meta 'other {:tag tagname})
+           this-sym (with-meta 'this {:tag tagname})]
+       ['cljs.core/IRecord
+        'cljs.core/ICloneable
+        `(~'-clone [~this-sym]
+          (new ~tagname ~@(generate-field-access this-sym val-sym fields)))
+
+        'cljs.core/IHash
+        `(~'-hash [~this-sym]
+          (caching-hash ~this-sym
+                        (fn [coll#]
+                          (bit-xor
+                           ~(hash (str tagname))
+                           (cljs.core/hash-unordered-coll coll#)))
+                        (. ~this-sym ~'-$hash)))
+
+        'cljs.core/IEquiv
+        `(~'-equiv [~this-sym ~othr-sym]
+          (or (identical? ~this-sym ~othr-sym)
+              (and (some? ~othr-sym)
+                   (identical? (.-constructor ~this-sym)
+                               (.-constructor ~othr-sym))
+                   ~@(map (fn [field]
+                            `(= (.. ~this-sym ~(property-symbol field))
+                                (.. ~(with-meta othr-sym {:tag tagname}) ~(property-symbol field))))
+                          base-fields)
+
+                   (= (. ~this-sym ~'-$extmap)
+                      (. ~(with-meta othr-sym {:tag tagname}) ~'-$extmap)))))
+
+        `ICustomRecordEquiv
+        `(~'-equiv-with-exceptions [~this-sym ~othr-sym ~'exceptions]
+          (or (identical? ~this-sym ~othr-sym)
+              (and (some? ~othr-sym)
+                   (identical? (.-constructor ~this-sym)
+                               (.-constructor ~othr-sym))
+                   (and ~@(->> base-fields
+                               (map (fn [field]
+                                      `(= (.. ~this-sym ~(property-symbol field))
+                                          (.. ~(with-meta othr-sym {:tag tagname}) ~(property-symbol field))))))
+                        (== (count (. ~this-sym ~'-$extmap))
+                            (count (. ~othr-sym ~'-$extmap))))
+
+                   (reduce-kv (fn [~'_ ~'k ~'v]
+                                (if (contains? ~'exceptions ~'k)
+                                  true
+                                  (if (= (get (. ~this-sym ~'-$extmap) ~'k ::not-exists) ~'v)
+                                    true
+                                    (reduced false))))
+                              true
+                              (. ~othr-sym ~'-$extmap)))))
+
+
+        'cljs.core/IMeta
+        `(~'-meta [~this-sym] (. ~this-sym ~'-$meta))
+
+        'cljs.core/IWithMeta
+        `(~'-with-meta [~this-sym ~val-sym]
+          (new ~tagname ~@(->> (replace {'$meta val-sym} fields)
+                               (generate-field-access this-sym val-sym))))
+
+        'cljs.core/ILookup
+        `(~'-lookup [~this-sym k#]
+           (cljs.core/-lookup ~this-sym k# nil))
+
+        `(~'-lookup [~this-sym ~key-sym else#]
+           (case ~key-sym
+             ~@(mapcat (fn [f] [(keyword f) `(. ~this-sym ~(property-symbol f))])
+                       base-fields)
+             (cljs.core/get (. ~this-sym ~'-$extmap) ~key-sym else#)))
+
+        'cljs.core/ICounted
+        `(~'-count [~this-sym]
+          (+ ~(count base-fields) (count (. ~this-sym ~'-$extmap))))
+
+        'cljs.core/ICollection
+        `(~'-conj [~this-sym ~val-sym]
+          (if (vector? ~val-sym)
+            (cljs.core/-assoc ~this-sym (cljs.core/-nth ~val-sym 0) (cljs.core/-nth ~val-sym 1))
+            (reduce cljs.core/-conj ~this-sym ~val-sym)))
+
+        'cljs.core/IAssociative
+        `(~'-contains-key? [~this-sym ~key-sym]
+          ~(if (seq base-fields)
+             `(case ~key-sym
+                (~@(map keyword base-fields)) true
+                (contains? (. ~this-sym ~'-$extmap) ~key-sym))
+             `(contains? (. ~this-sym ~'-$extmap) ~key-sym)))
+
+        `(~'-assoc [~this-sym ~key-sym ~val-sym]
+          (case ~key-sym
+            ~@(mapcat (fn [fld]
+                        [(keyword fld) `(new ~tagname ~@(->> (replace {fld val-sym '$hash nil} fields)
+                                                             (generate-field-access this-sym val-sym)))])
+                      base-fields)
+            (new ~tagname ~@(->> (remove #{'$extmap '$hash} fields)
+                                 (generate-field-access this-sym val-sym))
+                 (assoc (. ~this-sym ~'-$extmap) ~key-sym ~val-sym) nil)))
+
+        'cljs.core/ITransientAssociative
+        `(~'-assoc! [~this-sym ~key-sym ~val-sym]
+          (let [key# (if (keyword? ~key-sym)
+                       (.-fqn ~(with-meta key-sym {:tag `cljs.core/Keyword}))
+                       ~key-sym)]
+            (case ~key-sym
+              ~@(mapcat
+                 (fn [f]
+                   [(keyword f) `(set! (. ~this-sym ~(property-symbol f)) ~val-sym)])
+                 base-fields)
+
+              (set! (. ~this-sym ~'-$extmap) (cljs.core/assoc (. ~this-sym ~'-$extmap) ~key-sym ~val-sym)))
+
+            ~this-sym))
+
+        'cljs.core/IMap
+        `(~'-dissoc [~this-sym ~key-sym]
+          (case ~key-sym
+            (~@(map keyword base-fields))
+            (cljs.core/-assoc ~this-sym ~key-sym nil)
+
+            (let [extmap1# (. ~this-sym ~'-$extmap)
+                  extmap2# (dissoc extmap1# ~key-sym)]
+              (if (identical? extmap1# extmap2#)
+                ~this-sym
+                (new ~tagname ~@(->> (remove #{'$extmap '$hash} fields)
+                                     (generate-field-access this-sym val-sym))
+                     (not-empty extmap2#)
+                     nil)))))
+
+        'cljs.core/ISeqable
+        `(~'-seq [~this-sym]
+          (seq (concat [~@(map (fn [f]
+                                 `(cljs.core/MapEntry.
+                                   ~(keyword f)
+                                   (. ~this-sym ~(property-symbol f))
+                                   nil))
+                               base-fields)]
+                       (. ~this-sym ~'-$extmap))))
+
+        'cljs.core/IIterable
+        `(~'-iterator [~this-sym]
+          (cljs.core/RecordIter. 0 ~this-sym ~(count base-fields)
+                                 [~@(map keyword base-fields)]
+                                 (if (. ~this-sym ~'-$extmap)
+                                   (cljs.core/-iterator (. ~this-sym ~'-$extmap))
+                                   (cljs.core/nil-iter))))
+
+        'cljs.core/IKVReduce
+        `(~'-kv-reduce [~this-sym f# init#]
+          (reduce (fn [ret# [~key-sym v#]] (f# ret# ~key-sym v#)) init# ~this-sym))])))
+
+#?(:clj
+   (defn emit-impl-jvm
+     [tagname base-fields]
+     (let [fields   (conj base-fields '$meta '$extmap (with-meta '$hash {:unsynchronized-mutable true}))
+           key-sym  'key
+           val-sym  'val
+           this-sym (with-meta 'this {:tag tagname})]
+
+       ['clojure.lang.IRecord
+        'clojure.lang.IPersistentMap
+        `(~'equiv [~this-sym ~val-sym]
+          (and (some? ~val-sym)
+               (instance? ~tagname ~val-sym)
+               ~@(map (fn [field]
+                        `(= (.. ~this-sym ~(property-symbol field))
+                            (.. ~(with-meta val-sym {:tag tagname}) ~(property-symbol field))))
+                      base-fields)
+               (= (. ~this-sym ~'-$extmap)
+                  (. ~(with-meta val-sym {:tag tagname}) ~'-$extmap))))
+
+        `(~'entryAt [~this-sym ~key-sym]
+          (let [v# (.valAt ~this-sym ~key-sym ::not-found)]
+            (when (not= v# ::not-found)
+              (clojure.lang.MapEntry. ~key-sym v#))))
+
+        `(~'valAt [~this-sym ~key-sym]
+          (.valAt ~this-sym ~key-sym nil))
+
+        `(~'valAt [~this-sym ~key-sym ~'not-found]
+          (case ~key-sym
+            ~@(mapcat (fn [f] [(keyword f) `(. ~this-sym ~(property-symbol f))]) base-fields)
+            (clojure.core/get (. ~this-sym ~'-$extmap) ~key-sym ~'not-found)))
+
+        `(~'count [~this-sym]
+          (+ ~(count base-fields) (count (. ~this-sym ~'-$extmap))))
+
+
+        `(~'empty [~this-sym]
+          (new ~tagname ~@(->> (remove #{'$extmap '$hash} fields)
+                               (generate-field-access this-sym nil))
+               nil nil))
+
+        `(~'cons [~this-sym ~val-sym]
+          (if (instance? java.util.Map$Entry ~val-sym)
+            (let [^Map$Entry e# ~val-sym]
+              (.assoc ~this-sym (.getKey e#) (.getValue e#)))
+            (if (instance? clojure.lang.IPersistentVector ~val-sym)
+              (if (= 2 (count ~val-sym))
+                (.assoc ~this-sym (nth ~val-sym 0) (nth ~val-sym 1))
+                (throw (IllegalArgumentException.
+                        "Vector arg to map conj must be a pair")))
+              (reduce (fn [^clojure.lang.IPersistentMap m#
+                           ^java.util.Map$Entry e#]
+                        (.assoc m# (.getKey e#) (.getValue e#)))
+                      ~this-sym
+                      ~val-sym))))
+
+        `(~'assoc [~this-sym ~key-sym ~val-sym]
+          (case ~key-sym
+            ~@(mapcat (fn [fld]
+                        [(keyword fld) `(new ~tagname ~@(->> (replace {fld val-sym '$hash nil} fields)
+                                                             (generate-field-access this-sym val-sym)))])
+                      base-fields)
+            (new ~tagname ~@(->> (remove #{'$extmap '$hash} fields)
+                                 (generate-field-access this-sym val-sym))
+                 (assoc (. ~this-sym ~'-$extmap) ~key-sym ~val-sym)
+                 nil)))
+
+        `(~'without [~this-sym ~key-sym]
+          (case ~key-sym
+            (~@(map keyword base-fields))
+            (.assoc ~this-sym ~key-sym nil)
+
+            (if-let [extmap1# (. ~this-sym ~'-$extmap)]
+              (let [extmap2# (.without ^clojure.lang.IPersistentMap extmap1# ~key-sym)]
+                (if (identical? extmap1# extmap2#)
+                  ~this-sym
+                  (new ~tagname ~@(->> (remove #{'$extmap '$hash} fields)
+                                       (generate-field-access this-sym val-sym))
+                       (not-empty extmap2#)
+                       nil)))
+              ~this-sym)))
+
+        `(~'seq [~this-sym]
+          (seq (concat [~@(map (fn [f]
+                                 `(clojure.lang.MapEntry/create
+                                   ~(keyword f)
+                                   (. ~this-sym ~(property-symbol f))))
+                               base-fields)]
+                       (. ~this-sym ~'-$extmap))))
+
+        `(~'iterator [~this-sym]
+          (clojure.lang.SeqIterator. (.seq ~this-sym)))
+
+        'clojure.lang.IFn
+        `(~'invoke [~this-sym ~key-sym]
+          (.valAt ~this-sym ~key-sym))
+
+        `(~'invoke [~this-sym ~key-sym ~'not-found]
+          (.valAt ~this-sym ~key-sym ~'not-found))
+
+        'java.util.Map
+        `(~'size [~this-sym]
+          (clojure.core/count ~this-sym))
+
+        `(~'containsKey [~this-sym ~key-sym]
+          ~(if (seq base-fields)
+             `(case ~key-sym
+                (~@(map keyword base-fields)) true
+                (contains? (. ~this-sym ~'-$extmap) ~key-sym))
+             `(contains? (. ~this-sym ~'-$extmap) ~key-sym)))
+
+        `(~'isEmpty [~this-sym]
+          (zero? (count ~this-sym)))
+
+        `(~'keySet [~this-sym]
+          (throw (UnsupportedOperationException. "not implemented")))
+
+        `(~'entrySet [~this-sym]
+          (throw (UnsupportedOperationException. "not implemented")))
+
+        `(~'get [~this-sym ~key-sym]
+          (.valAt ~this-sym ~key-sym))
+
+        `(~'containsValue [~this-sym ~val-sym]
+          (throw (UnsupportedOperationException. "not implemented")))
+
+        `(~'values [~this-sym]
+          (map val (.seq ~this-sym)))
+
+        'java.lang.Object
+        `(~'equals [~this-sym other#]
+          (.equiv ~this-sym other#))
+
+        `(~'hashCode [~this-sym]
+          (clojure.lang.APersistentMap/mapHash ~this-sym))
+
+        'clojure.lang.IHashEq
+        `(~'hasheq [~this-sym]
+          (clojure.core/hash-unordered-coll ~this-sym))
+
+        'clojure.lang.IObj
+        `(~'meta [~this-sym]
+          (. ~this-sym ~'-$meta))
+
+        `(~'withMeta [~this-sym ~val-sym]
+          (new ~tagname ~@(->> (replace {'$meta val-sym} fields)
+                               (generate-field-access this-sym val-sym))))
+        ])))
+
+(defmacro defrecord
+  [rsym fields & impls]
+  (let [param   (gensym "param-")
+        ks      (map keyword fields)
+        fields' (mapv #(with-meta % nil) fields)
+        nsname  (if (:ns &env)
+                  (-> &env :ns :name)
+                  (str *ns*))
+        ident   (str "#" nsname "." (name rsym))]
+
+    `(do
+       (deftype ~rsym ~(into fields ['$meta '$extmap '$hash])
+         ~@(if (:ns &env)
+             (emit-impl-js rsym fields')
+             (emit-impl-jvm rsym fields'))
+         ~@impls
+
+         ~@(when (:ns &env)
+             ['cljs.core/IPrintWithWriter
+              `(~'-pr-writer [~'this writer# opts#]
+                (let [pr-pair# (fn [keyval#]
+                                 (cljs.core/pr-sequential-writer writer# (~'js* "cljs.core.pr_writer")
+                                                                 "" " " "" opts# keyval#))]
+                  (cljs.core/pr-sequential-writer
+                   writer# pr-pair# ~(str ident "{") ", " "}" opts#
+                   (concat [~@(for [f fields']
+                                `(vector ~(keyword f) (. ~'this ~(property-symbol f))))]
+                           (. ~'this ~'-$extmap)))))]))
+
+       ~@(when-not (:ns &env)
+           [`(defmethod print-method ~rsym [o# ^java.io.Writer w#]
+               (.write w# ~(str "#" nsname "." (name rsym)))
+               (print-method (into {} o#) w#))])
+
+       (defn ~(with-meta (symbol (str "pos->" rsym))
+                (assoc (meta rsym) :factory :positional))
+         [~@fields']
+         (new ~rsym ~@(conj fields nil nil nil)))
+
+       (defn ~(with-meta (symbol (str 'map-> rsym))
+                (assoc (meta rsym) :factory :map))
+         [~param]
+         (let [exclude# #{~@ks}
+               extmap#  (reduce-kv (fn [acc# k# v#]
+                                     (if (contains? exclude# k#)
+                                       acc#
+                                       (assoc acc# k# v#)))
+                                   {}
+                                   ~param)]
+           (new ~rsym
+                ~@(for [k ks]
+                    `(get ~param ~k))
+                nil
+                (not-empty extmap#)
+                nil)))
+       ~rsym)))
+
+(defmacro clone
+  [ssym]
+  (if (:ns &env)
+    `(cljs.core/clone ~ssym)
+    ssym))
+
+(defmacro assoc!
+  "A record specific update operation"
+  [ssym & pairs]
+  (if (:ns &env)
+    (let [pairs (partition-all 2 pairs)]
+      `(-> ~ssym
+           ~@(map (fn [[ks vs]]
+                    `(cljs.core/-assoc! ~ks ~vs))
+                  pairs)))
+    `(assoc ~ssym ~@pairs)))
+
+(defmacro update!
+  "A record specific update operation"
+  [ssym ksym f & params]
+  (if (:ns &env)
+    (let [ssym (with-meta ssym {:tag 'js})]
+      `(cljs.core/assoc! ~ssym ~ksym (~f (. ~ssym ~(property-symbol ksym)) ~@params)))
+    `(update ~ssym ~ksym ~f ~@params)))
+
+(defmacro define-properties!
+  [rsym & properties]
+  (let [rsym (with-meta rsym {:tag 'js})]
+    `(do
+       ~@(for [params properties
+               :let [pname  (get params :name)
+                     get-fn (get params :get)
+                     set-fn (get params :set)]]
+           `(.defineProperty js/Object
+                             (.-prototype ~rsym)
+                             ~pname
+                             (cljs.core/js-obj
+                              "enumerable" true
+                              "configurable" true
+                              ~@(concat
+                                 (when get-fn
+                                   ["get" get-fn])
+                                 (when set-fn
+                                   ["set" set-fn]))))))))
+

common/src/app/common/schema.cljc

@@ -316,6 +316,22 @@
                     (let [v (if (string? v) (str/split v #"[\s,]+") v)]
                       (into #{} non-empty-strings-xf v)))}})
 
+(def! ::set-of-keywords
+  {:type ::set-of-keywords
+   :pred #(and (set? %) (every? keyword? %))
+   :type-properties
+   {:title "set[string]"
+    :description "Set of Strings"
+    :error/message "should be a set of strings"
+    :gen/gen (-> :keyword sg/generator sg/set)
+    ::oapi/type "array"
+    ::oapi/format "set"
+    ::oapi/items {:type "string" :format "keyword"}
+    ::oapi/unique-items true
+    ::oapi/decode (fn [v]
+                    (let [v (if (string? v) (str/split v #"[\s,]+") v)]
+                      (into #{} (comp non-empty-strings-xf (map keyword)) v)))}})
+
 (def! ::set-of-emails
   {:type ::set-of-emails
    :pred #(and (set? %) (every? string? %))

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

@@ -5,12 +5,13 @@
 ;; Copyright (c) KALEIDOS INC
 
 (ns app.common.schema.generators
-  (:refer-clojure :exclude [set subseq uuid for])
+  (:refer-clojure :exclude [set subseq uuid for filter map])
   #?(:cljs (:require-macros [app.common.schema.generators]))
   (:require
    [app.common.schema.registry :as sr]
    [app.common.uri :as u]
    [app.common.uuid :as uuid]
+   [clojure.core :as c]
    [clojure.test.check :as tc]
    [clojure.test.check.generators :as tg]
    [clojure.test.check.properties :as tp]
@@ -38,7 +39,7 @@
 
 (defn check!
   [p & {:keys [num] :or {num 20} :as options}]
-  (tc/quick-check num p (assoc options :reporter-fn default-reporter-fn)))
+  (tc/quick-check num p (assoc options :reporter-fn default-reporter-fn :max-size 50)))
 
 (defn sample
   ([g]
@@ -58,6 +59,10 @@
   ([s opts]
    (mg/generator s (assoc opts :registry sr/default-registry))))
 
+(defn filter
+  [pred gen]
+  (tg/such-that pred gen 100))
+
 (defn small-double
   [& {:keys [min max] :or {min -100 max 100}}]
   (tg/double* {:min min, :max max, :infinite? false, :NaN? false}))
@@ -82,7 +87,6 @@
              ext    (tg/elements ["net" "com" "org" "app" "io"])]
     (u/uri (str scheme "://" domain "." ext))))
 
-;; FIXME: revisit
 (defn uuid
   []
   (->> tg/small-integer
@@ -100,9 +104,9 @@
         (tg/fmap (fn [bools]
                      (into dest
                            (comp
-                            (filter first)
-                            (map second))
-                           (map list bools elements)))))))
+                            (c/filter first)
+                            (c/map second))
+                           (c/map list bools elements)))))))
 
 (defn set
   [g]

common/src/app/common/svg.cljc

@@ -0,0 +1,16 @@
+;; 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
+  #?(:cljs
+     (:require
+      ["./svg_optimizer.js" :as svgo])))
+
+#?(:cljs
+   (defn optimize
+     ([input] (optimize input nil))
+     ([input options]
+      (svgo/optimize input (clj->js options)))))

common/src/app/common/text.cljc

@@ -8,6 +8,7 @@
   (:require
    [app.common.colors :as clr]
    [app.common.data :as d]
+   [app.common.data.macros :as dm]
    [app.common.transit :as t]
    [clojure.walk :as walk]
    [cuerdas.core :as str]))
@@ -29,6 +30,8 @@
    :fills [{:fill-color clr/black
             :fill-opacity 1}]})
 
+(def text-attrs (keys default-text-attrs))
+
 (def typography-fields
   [:font-id
    :font-family
@@ -252,3 +255,50 @@
 
     {:blocks (reduce #(conj %1 (build-block %2)) [] (node-seq #(= (:type %) "paragraph") root))
      :entityMap {}}))
+
+(defn content->text+styles
+  "Given a root node of a text content extracts the texts with its associated styles"
+  [node]
+  (letfn
+      [(rec-style-text-map [acc node style]
+         (let [node-style (merge style (select-keys node text-attrs))
+               head (or (-> acc first) [{} ""])
+               [head-style head-text] head
+
+               new-acc
+               (cond
+                 (:children node)
+                 (reduce #(rec-style-text-map %1 %2 node-style) acc (:children node))
+
+                 (not= head-style node-style)
+                 (cons [node-style (:text node "")] acc)
+
+                 :else
+                 (cons [node-style (dm/str head-text "" (:text node))] (rest acc)))
+
+               ;; We add an end-of-line when finish a paragraph
+               new-acc
+               (if (= (:type node) "paragraph")
+                 (let [[hs ht] (first new-acc)]
+                   (cons [hs (dm/str ht "\n")] (rest new-acc)))
+                 new-acc)]
+           new-acc))]
+
+    (-> (rec-style-text-map [] node {})
+        reverse)))
+
+(defn index-content
+  "Adds a property `$id` that identifies the current node inside"
+  ([content]
+   (index-content content nil 0))
+  ([node path index]
+   (let [cur-path (if path (dm/str path "-") (dm/str ""))
+         cur-path (dm/str cur-path (d/name (:type node :text)) "-" index)]
+     (-> node
+         (assoc :$id cur-path)
+         (update :children
+                 (fn [children]
+                   (->> children
+                        (d/enumerate)
+                        (mapv (fn [[idx node]]
+                                (index-content node cur-path idx))))))))))

common/src/app/common/transit.cljc

@@ -7,8 +7,6 @@
 (ns app.common.transit
   (:require
    [app.common.data :as d]
-   [app.common.geom.matrix :as gmt]
-   [app.common.geom.point :as gpt]
    [app.common.uri :as uri]
    [cognitect.transit :as t]
    [lambdaisland.uri :as luri]
@@ -18,8 +16,6 @@
    #?(:cljs ["luxon" :as lxn]))
   #?(:clj
      (:import
-      app.common.geom.matrix.Matrix
-      app.common.geom.point.Point
       java.io.ByteArrayInputStream
       java.io.ByteArrayOutputStream
       java.io.File
@@ -122,23 +118,6 @@
     {:id "u"
      :rfn parse-uuid})
 
- {:id "point"
-  :class #?(:clj Point :cljs gpt/Point)
-  :wfn #(into {} %)
-  :rfn gpt/map->Point}
-
- {:id "matrix"
-  :class #?(:clj Matrix :cljs gmt/Matrix)
-  :wfn #(into {} %)
-  :rfn #?(:cljs gmt/map->Matrix
-          :clj  (fn [{:keys [a b c d e f]}]
-                  (gmt/matrix (double a)
-                              (double b)
-                              (double c)
-                              (double d)
-                              (double e)
-                              (double f))))}
-
  {:id "ordered-set"
   :class #?(:clj LinkedSet :cljs lks/LinkedSet)
   :wfn vec

common/src/app/common/types/colors_list.cljc

@@ -51,4 +51,6 @@
   (->> (ctc/get-all-colors shape)
        (keep #(get-ref-color (:data library) %))
        (remove #(< (:modified-at %) since-date))  ;; Note that :modified-at may be nil
-       (map #(vector (:id shape) (:id %) :color))))
+       (map (fn [color] {:shape-id (:id shape)
+                         :asset-id (:id color)
+                         :asset-type :color}))))

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

@@ -6,10 +6,98 @@
 
 (ns app.common.types.component)
 
+;; Attributes that may be synced in components, and the group they belong to.
+;; When one attribute is modified in a shape inside a component, the corresponding
+;; group is marked as :touched. Then, if the shape is synced with the remote shape
+;; in the main component, none of the attributes of the same group is changed.
+
+(def sync-attrs
+  {:name                    :name-group
+   :fills                   :fill-group
+   :hide-fill-on-export     :fill-group
+   :content                 :content-group
+   :position-data           :content-group
+   :hidden                  :visibility-group
+   :blocked                 :modifiable-group
+   :grow-type               :text-font-group
+   :font-family             :text-font-group
+   :font-size               :text-font-group
+   :font-style              :text-font-group
+   :font-weight             :text-font-group
+   :letter-spacing          :text-display-group
+   :line-height             :text-display-group
+   :text-align              :text-display-group
+   :strokes                 :stroke-group
+
+   ;; DEPRECATED: FIXME: this attrs are deprecated for a long time but
+   ;; we still have tests that uses this attribute for synchronization
+   :stroke-width            :stroke-group
+   :fill-color              :fill-group
+   :fill-opacity            :fill-group
+
+   :rx                      :radius-group
+   :ry                      :radius-group
+   :r1                      :radius-group
+   :r2                      :radius-group
+   :r3                      :radius-group
+   :r4                      :radius-group
+   :type                    :geometry-group
+   :selrect                 :geometry-group
+   :points                  :geometry-group
+   :locked                  :geometry-group
+   :proportion              :geometry-group
+   :proportion-lock         :geometry-group
+   :x                       :geometry-group
+   :y                       :geometry-group
+   :width                   :geometry-group
+   :height                  :geometry-group
+   :rotation                :geometry-group
+   :transform               :geometry-group
+   :transform-inverse       :geometry-group
+   :opacity                 :layer-effects-group
+   :blend-mode              :layer-effects-group
+   :shadow                  :shadow-group
+   :blur                    :blur-group
+   :masked-group            :mask-group
+   :constraints-h           :constraints-group
+   :constraints-v           :constraints-group
+   :fixed-scroll            :constraints-group
+   :exports                 :exports-group
+   :grids                   :grids-group
+
+   :layout                  :layout-container
+   :layout-align-content    :layout-container
+   :layout-align-items      :layout-container
+   :layout-flex-dir         :layout-container
+   :layout-gap              :layout-container
+   :layout-gap-type         :layout-container
+   :layout-justify-content  :layout-container
+   :layout-justify-items    :layout-container
+   :layout-wrap-type        :layout-container
+   :layout-padding-type     :layout-container
+   :layout-padding          :layout-container
+   :layout-h-orientation    :layout-container
+   :layout-v-orientation    :layout-container
+   :layout-grid-dir         :layout-container
+   :layout-grid-rows        :layout-container
+   :layout-grid-columns     :layout-container
+   :layout-grid-cells       :layout-container
+
+   :layout-item-margin      :layout-item
+   :layout-item-margin-type :layout-item
+   :layout-item-h-sizing    :layout-item
+   :layout-item-v-sizing    :layout-item
+   :layout-item-max-h       :layout-item
+   :layout-item-min-h       :layout-item
+   :layout-item-max-w       :layout-item
+   :layout-item-min-w       :layout-item
+   :layout-item-align-self  :layout-item})
+
+
 (defn instance-root?
   "Check if this shape is the head of a top instance."
   [shape]
-  (some? (:component-root? shape)))
+  (some? (:component-root shape)))
 
 (defn instance-head?
   "Check if this shape is the head of a top instance or a subinstance."
@@ -36,9 +124,10 @@
            (= (:shape-ref shape-inst) (:shape-ref shape-main)))))
 
 (defn main-instance?
-  "Check if this shape is the root of the main instance of some component."
+  "Check if this shape is the root of the main instance of some
+  component."
   [shape]
-  (some? (:main-instance? shape)))
+  (some? (:main-instance shape)))
 
 (defn in-component-copy?
   "Check if the shape is inside a component non-main instance."
@@ -63,7 +152,7 @@
   (if (some? (:main-instance-id component))
     (get-in component [:objects (:main-instance-id component)])
     (get-in component [:objects (:id component)])))
- 
+
 (defn uses-library-components?
   "Check if the shape uses any component in the given library."
   [shape library-id]
@@ -76,7 +165,8 @@
   (dissoc shape
           :component-id
           :component-file
-          :component-root?
-          :remote-synced?
+          :component-root
+          :main-instance
+          :remote-synced
           :shape-ref
           :touched))

common/src/app/common/types/components_list.cljc

@@ -13,9 +13,12 @@
    [app.common.types.component :as ctk]))
 
 (defn components
-  [file-data]
-  (d/removem (fn [[_ component]] (:deleted component))
-             (:components file-data)))
+  ([file-data] (components file-data nil))
+  ([file-data {:keys [include-deleted?] :or {include-deleted? false}}]
+   (if include-deleted?
+     (:components file-data)
+     (d/removem (fn [[_ component]] (:deleted component))
+                (:components file-data)))))
 
 (defn components-seq
   [file-data]
@@ -44,7 +47,7 @@
                        (wrap-object-fn)))))))
 
 (defn mod-component
-  [file-data {:keys [id name path objects annotation]}]
+  [file-data {:keys [id name path main-instance-id main-instance-page objects annotation]}]
   (let [wrap-objects-fn feat/*wrap-with-objects-map-fn*]
     (d/update-in-when file-data [:components id]
                       (fn [component]
@@ -56,6 +59,12 @@
                             (some? path)
                             (assoc :path path)
 
+                            (some? main-instance-id)
+                            (assoc :main-instance-id main-instance-id)
+
+                            (some? main-instance-page)
+                            (assoc :main-instance-page main-instance-page)
+
                             (some? objects)
                             (assoc :objects objects)
 
@@ -113,7 +122,9 @@
     (let [component (get-component (:data library) (:component-id shape))]
       (if (< (:modified-at component) since-date)  ;; Note that :modified-at may be nil
         []
-        [[(:id shape) (:component-id shape) :component]]))
+        [{:shape-id (:id shape)
+          :asset-id (:component-id shape)
+          :asset-type :component}]))
     []))
 
 (defn get-component-annotation

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

@@ -7,9 +7,10 @@
 (ns app.common.types.container
   (:require
    [app.common.data.macros :as dm]
+   [app.common.files.helpers :as cfh]
    [app.common.geom.point :as gpt]
    [app.common.geom.shapes :as gsh]
-   [app.common.pages.common :as common]
+   [app.common.pages.helpers :as cph]
    [app.common.schema :as sm]
    [app.common.types.component :as ctk]
    [app.common.types.components-list :as ctkl]
@@ -93,41 +94,88 @@
   (map #(get-shape container %) (:shapes shape)))
 
 (defn get-component-shape
-  "Get the parent shape linked to a component for this shape, if any"
+  "Get the parent top shape linked to a component for this shape, if any"
   ([objects shape] (get-component-shape objects shape nil))
   ([objects shape {:keys [allow-main?] :or {allow-main? false} :as options}]
    (cond
      (nil? shape)
      nil
 
-     (= uuid/zero (:id shape))
-     nil
-
-     (and (not (ctk/in-component-copy? shape)) (not allow-main?))
+     (cph/root? shape)
      nil
 
      (ctk/instance-root? shape)
      shape
 
+     (and (not (ctk/in-component-copy? shape)) (not allow-main?))
+     nil
+
      :else
      (get-component-shape objects (get objects (:parent-id shape)) options))))
 
-(defn in-component-main?
-  "Check if the shape is inside a component non-main instance.
+(defn get-head-shape
+  "Get the parent top or nested shape linked to a component for this shape, if any"
+  ([objects shape] (get-head-shape objects shape nil))
+  ([objects shape {:keys [allow-main?] :or {allow-main? false} :as options}]
+   (cond
+     (nil? shape)
+     nil
 
-   Note that we must iterate on the parents because non-root shapes in
-   a main component have not any discriminating attribute."
+     (cph/root? shape)
+     nil
+
+     (ctk/instance-head? shape)
+     shape
+
+     (and (not (ctk/in-component-copy? shape)) (not allow-main?))
+     nil
+
+     :else
+     (get-head-shape objects (get objects (:parent-id shape)) options))))
+
+(defn get-instance-root
+  "Get the parent shape at the top of the component instance (main or copy)."
   [objects shape]
-  (let [component-shape (get-component-shape objects shape {:allow-main? true})]
-    (:main-instance? component-shape)))
+  (cond
+    (nil? shape)
+    nil
+
+    (cph/root? shape)
+    nil
+
+    (ctk/instance-root? shape)
+    shape
+
+    :else
+    (get-instance-root objects (get objects (:parent-id shape)))))
+
+(defn get-copy-root
+  "Get the top shape of the copy."
+  [objects shape]
+  (when (:shape-ref shape)
+    (let [parent (cph/get-parent objects (:id shape))]
+      (or (get-copy-root objects parent) shape))))
+
+(defn inside-component-main?
+  "Check if the shape is a component main instance or is inside one."
+  [objects shape]
+  (cond
+    (or (nil? shape) (cph/root? shape))
+    false
+    (ctk/main-instance? shape)
+    true
+    (ctk/instance-head? shape)
+    false
+    :else
+    (inside-component-main? objects (get objects (:parent-id shape)))))
 
 (defn in-any-component?
   "Check if the shape is part of any component (main or copy), wether it's
    head or not."
   [objects shape]
   (or (ctk/in-component-copy? shape)
-      (ctk/main-instance? shape)
-      (in-component-main? objects shape)))
+      (ctk/instance-head? shape)
+      (inside-component-main? objects shape)))
 
 (defn make-component-shape
   "Clone the shape and all children. Generate new ids and detach
@@ -146,7 +194,7 @@
 
                            (cond-> new-shape
                              true
-                             (dissoc :component-root?)
+                             (dissoc :component-root)
 
                              (nil? (:parent-id new-shape))
                              (dissoc :component-id
@@ -165,13 +213,13 @@
                                   (nil? (:parent-id new-shape))
                                   (assoc :component-id (:id new-shape)
                                          :component-file file-id
-                                         :component-root? true)
+                                         :component-root true)
 
                                   (and (nil? (:parent-id new-shape)) components-v2)
-                                  (assoc :main-instance? true)
+                                  (assoc :main-instance true)
 
                                   (some? (:parent-id new-shape))
-                                  (dissoc :component-root?)))
+                                  (dissoc :component-root)))
 
         [new-root-shape new-shapes updated-shapes]
         (ctst/clone-object shape nil objects update-new-shape update-original-shape)
@@ -186,9 +234,10 @@
 (defn make-component-instance
   "Generate a new instance of the component inside the given container.
 
-  Clone the shapes of the component, generating new names and ids, and linking
-  each new shape to the corresponding one of the component. Place the new instance
-  coordinates in the given position."
+  Clone the shapes of the component, generating new names and ids, and
+  linking each new shape to the corresponding one of the
+  component. Place the new instance coordinates in the given
+  position."
   ([container component library-data position components-v2]
    (make-component-instance container component library-data position components-v2 {}))
 
@@ -197,22 +246,25 @@
      :or {main-instance? false force-id nil force-frame-id nil keep-ids? false}}]
    (let [component-page  (when components-v2
                            (ctpl/get-page library-data (:main-instance-page component)))
+
          component-shape (if components-v2
                            (-> (get-shape component-page (:main-instance-id component))
                                (assoc :parent-id nil)
                                (assoc :frame-id uuid/zero))
                            (get-shape component (:id component)))
 
+
          orig-pos        (gpt/point (:x component-shape) (:y component-shape))
          delta           (gpt/subtract position orig-pos)
 
          objects         (:objects container)
-         unames          (volatile! (common/retrieve-used-names objects))
+         unames          (volatile! (cfh/get-used-names objects))
 
          frame-id        (or force-frame-id
-                             (ctst/frame-id-by-position objects
-                                                        (gpt/add orig-pos delta)
-                                                        {:skip-components? true}))
+                             (ctst/get-frame-id-by-position objects
+                                                            (gpt/add orig-pos delta)
+                                                            {:skip-components? true
+                                                             :bottom-frames? true}))
          frame-ids-map   (volatile! {})
 
          update-new-shape
@@ -231,25 +283,27 @@
                    (dissoc :touched))
 
                main-instance?
-               (assoc :main-instance? true)
+               (assoc :main-instance true)
 
                (not main-instance?)
-               (dissoc :main-instance?)
+               (dissoc :main-instance)
 
-               (and (not main-instance?) (nil? (:shape-ref original-shape)))
+               (and (not main-instance?)
+                    (or components-v2                        ; In v1, shape-ref points to the remote instance
+                        (nil? (:shape-ref original-shape)))) ; in v2, shape-ref points to the near instance
                (assoc :shape-ref (:id original-shape))
 
                (nil? (:parent-id original-shape))
                (assoc :component-id (:id component)
                       :component-file (:id library-data)
-                      :component-root? true
+                      :component-root true
                       :name new-name)
 
                (and (nil? (:parent-id original-shape)) main-instance? components-v2)
-               (assoc :main-instance? true)
+               (assoc :main-instance true)
 
                (some? (:parent-id original-shape))
-               (dissoc :component-root?))))
+               (dissoc :component-root))))
 
          [new-shape new-shapes _]
          (ctst/clone-object component-shape
@@ -271,3 +325,16 @@
      [(remap-frame-id new-shape)
       (map remap-frame-id new-shapes)])))
 
+(defn get-top-instance
+  "The case of having an instance that contains another instances.
+  The topmost one, that is not part of other instance, is the Top instance"
+  [objects shape current-top]
+  (let [current-top (if (and
+                         (not (ctk/main-instance? shape))
+                         (ctk/instance-head? shape))
+                      shape current-top)
+        parent-id   (:parent-id shape)
+        parent      (get objects parent-id)]
+    (if (= parent-id uuid/zero)
+      current-top
+      (get-top-instance objects parent current-top))))

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

@@ -8,12 +8,14 @@
   (:require
    [app.common.data :as d]
    [app.common.data.macros :as dm]
+   [app.common.files.defaults :refer [version]]
    [app.common.files.features :as ffeat]
    [app.common.geom.point :as gpt]
    [app.common.geom.shapes :as gsh]
-   [app.common.pages.common :refer [file-version]]
+   [app.common.logging :as l]
    [app.common.pages.helpers :as cph]
    [app.common.schema :as sm]
+   [app.common.text :as ct]
    [app.common.types.color :as ctc]
    [app.common.types.colors-list :as ctcl]
    [app.common.types.component :as ctk]
@@ -68,7 +70,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (def empty-file-data
-  {:version file-version
+  {:version version
    :pages []
    :pages-index {}})
 
@@ -79,9 +81,8 @@
   ([file-id page-id]
    (let [page (when (some? page-id)
                 (ctp/make-empty-page page-id "Page 1"))]
-     (cond-> (-> empty-file-data
-                 (assoc :id file-id))
 
+     (cond-> (assoc empty-file-data :id file-id)
        (some? page-id)
        (ctpl/add-page page)
 
@@ -113,13 +114,22 @@
 
 ;; Asset helpers
 
+(defn find-component
+  "Retrieve a component from libraries, iterating over all of them."
+  [libraries component-id & {:keys [include-deleted?] :or {include-deleted? false}}]
+  (some #(ctkl/get-component (:data %) component-id include-deleted?) (vals libraries)))
+
 (defn get-component
-  "Retrieve a component from libraries, if no library-id is provided, we
-  iterate over all libraries and find the component on it."
-  ([libraries component-id]
-   (some #(ctkl/get-component (:data %) component-id) (vals libraries)))
-  ([libraries library-id component-id]
-   (ctkl/get-component (dm/get-in libraries [library-id :data]) component-id)))
+  "Retrieve a component from a library."
+  [libraries library-id component-id & {:keys [include-deleted?] :or {include-deleted? false}}]
+  (ctkl/get-component (dm/get-in libraries [library-id :data]) component-id include-deleted?))
+
+(defn resolve-component
+  "Retrieve the referenced component, from the local file or from a library"
+  [shape file libraries & params]
+  (if (= (:component-file shape) (:id file))
+    (ctkl/get-component (:data file) (:component-id shape) params)
+    (get-component libraries (:component-file shape) (:component-id shape) params)))
 
 (defn get-component-library
   "Retrieve the library the component belongs to."
@@ -161,17 +171,53 @@
       (dm/get-in component [:objects shape-id]))))
 
 (defn get-ref-shape
-  "Retrieve the shape in the component that is referenced by the
-  instance shape."
+  "Retrieve the shape in the component that is referenced by the instance shape."
   [file-data component shape]
   (when (:shape-ref shape)
     (get-component-shape file-data component (:shape-ref shape))))
 
+(defn find-ref-shape
+  "Locate the near component in the local file or libraries, and retrieve the shape
+   referenced by the instance shape."
+  [file page libraries shape & {:keys [include-deleted?] :or {include-deleted? false}}]
+  (let [root-shape     (ctn/get-component-shape (:objects page) shape)
+        component-file (if (= (:component-file root-shape) (:id file))
+                         file
+                         (get libraries (:component-file root-shape)))
+        component      (when component-file
+                         (ctkl/get-component (:data component-file) (:component-id root-shape) include-deleted?))
+        ref-shape (when component
+                    (get-ref-shape (:data component-file) component shape))]
+
+    (if (some? ref-shape)  ; There is a case when we have a nested orphan copy. In this case there is no near
+      ref-shape            ; component for this copy, so shape-ref points to the remote main.
+      (let [head-shape     (ctn/get-head-shape (:objects page) shape)
+            head-file (if (= (:component-file head-shape) (:id file))
+                        file
+                        (get libraries (:component-file head-shape)))
+            head-component      (when (some? head-file)
+                                  (ctkl/get-component (:data head-file) (:component-id head-shape) include-deleted?))]
+        (when (some? head-component)
+          (get-ref-shape (:data head-file) head-component shape))))))
+
+(defn find-remote-shape
+  "Recursively go back by the :shape-ref of the shape until find the correct shape of the original component"
+  [container libraries shape]
+  (let [top-instance        (ctn/get-top-instance (:objects container) shape nil)
+        component-file      (get-in libraries [(:component-file top-instance) :data])
+        component           (ctkl/get-component component-file (:component-id top-instance) true)
+        remote-shape        (get-ref-shape component-file component shape)
+        component-container (get-component-container component-file component)]
+    (if (nil? remote-shape)
+      shape
+      (find-remote-shape component-container libraries remote-shape))))
+
 (defn get-component-shapes
   "Retrieve all shapes of the component"
   [file-data component]
   (let [components-v2 (dm/get-in file-data [:options :components-v2])]
-    (if components-v2
+    (if (and components-v2
+             (not (:deleted component))) ;; the deleted components have its children in the :objects property
       (let [instance-page (get-component-page file-data component)]
         (cph/get-children-with-self (:objects instance-page) (:main-instance-id component)))
       (vals (:objects component)))))
@@ -190,7 +236,7 @@
   "Add an :objects property to the component, with only the shapes that belong to it"
   [file-data component]
   (let [components-v2 (dm/get-in file-data [:options :components-v2])]
-    (if (and components-v2 component (nil? (:objects component))) ;; This operation may be called twice, e.g. in an idempotent change
+    (if (and components-v2 component (empty? (:objects component))) ;; This operation may be called twice, e.g. in an idempotent change
       (let [component-page (get-component-page file-data component)
             page-objects   (:objects component-page)
             objects        (->> (cons (:main-instance-id component)
@@ -291,14 +337,15 @@
    been modified after the given date."
   [file-data library since-date]
   (letfn [(used-assets-shape [shape]
-             (concat
-              (ctkl/used-components-changed-since shape library since-date)
-              (ctcl/used-colors-changed-since shape library since-date)
-              (ctyl/used-typographies-changed-since shape library since-date)))
+            (concat
+             (ctkl/used-components-changed-since shape library since-date)
+             (ctcl/used-colors-changed-since shape library since-date)
+             (ctyl/used-typographies-changed-since shape library since-date)))
 
           (used-assets-container [container]
-           (->> (mapcat used-assets-shape (ctn/shapes-seq container))
-                (map #(cons (:id container) %))))]
+            (->> (ctn/shapes-seq container)
+                 (mapcat used-assets-shape)
+                 (map #(assoc % :container-id (:id container)))))]
 
     (mapcat used-assets-container (containers-seq file-data))))
 
@@ -347,7 +394,7 @@
                                                      file-data
                                                      position
                                                      false
-                                                     {:main-instance? true
+                                                     {:main-instance true
                                                       :force-frame-id uuid/zero
                                                       :keep-ids? true})
                         add-shapes
@@ -430,7 +477,8 @@
                                              library-data
                                              position
                                              (dm/get-in file-data [:options :components-v2])
-                                             {:main-instance? true})
+                                             {:main-instance? true
+                                              :keep-ids? true})
 
                 main-instance-shapes
                 (map #(cond-> %
@@ -568,108 +616,311 @@
       (d/not-empty? used-typographies)
       (absorb-typographies used-typographies))))
 
-
 ;; Debug helpers
 
+(declare dump-shape-component-info)
+
+(defn dump-shape
+  "Display a summary of a shape and its relationships, and recursively of all children."
+  [shape-id level objects file libraries {:keys [show-ids show-touched] :as flags}]
+  (let [shape (get objects shape-id)]
+    (println (str/pad (str (str/repeat "  " level)
+                           (when (:main-instance shape) "{")
+                           (:name shape)
+                           (when (:main-instance shape) "}")
+                           (when (seq (:touched shape)) "*")
+                           (when show-ids (str/format " %s" (:id shape))))
+                      {:length 20
+                       :type :right})
+             (dump-shape-component-info shape objects file libraries flags))
+    (when show-touched
+      (when (seq (:touched shape))
+        (println (str (str/repeat "  " level)
+                      "    "
+                      (str (:touched shape)))))
+      (when (:remote-synced shape)
+        (println (str (str/repeat "  " level)
+                      "    (remote-synced)"))))
+    (when (:shapes shape)
+      (dorun (for [shape-id (:shapes shape)]
+               (dump-shape shape-id
+                           (inc level)
+                           objects
+                           file
+                           libraries
+                           flags))))))
+
+(defn dump-shape-component-info
+  "If the shape is inside a component, display the information of the relationship."
+  [shape objects file libraries {:keys [show-ids]}]
+  (if (nil? (:shape-ref shape))
+    (if (:component-root shape)
+      (str " #" (when show-ids (str/format " [Component %s]" (:component-id shape))))
+      "")
+    (let [root-shape        (ctn/get-component-shape objects shape)
+          component-file-id (when root-shape (:component-file root-shape))
+          component-file    (when component-file-id (get libraries component-file-id nil))
+          component-shape (find-ref-shape file
+                                          {:objects objects}
+                                          libraries
+                                          shape
+                                          :include-deleted? true)]
+
+      (str/format " %s--> %s%s%s%s%s"
+                  (cond (:component-root shape) "#"
+                        (:component-id shape) "@"
+                        :else "-")
+
+                  (when component-file (str/format "<%s> " (:name component-file)))
+
+                  (or (:name component-shape)
+                      (str/format "?%s"
+                                  (when show-ids
+                                    (str " " (:shape-ref shape)))))
+
+                  (when (and show-ids component-shape)
+                    (str/format " %s" (:id component-shape)))
+
+                  (if (or (:component-root shape)
+                          (nil? (:component-id shape))
+                          true)
+                    ""
+                    (let [component-id      (:component-id shape)
+                          component-file-id (:component-file shape)
+                          component-file    (when component-file-id (get libraries component-file-id nil))
+                          component         (if component-file
+                                              (ctkl/get-component (:data component-file) component-id true)
+                                              (ctkl/get-component (:data file) component-id true))]
+                      (str/format " (%s%s)"
+                                  (when component-file (str/format "<%s> " (:name component-file)))
+                                  (:name component))))
+
+                  (when (and show-ids (:component-id shape))
+                    (str/format " [Component %s]" (:component-id shape)))))))
+
+(defn dump-component
+  "Display a summary of a component and the links to the main instance.
+   If the component contains an :objects, display also all shapes inside."
+  [component file libraries {:keys [show-ids show-modified] :as flags}]
+  (println (str/format "[%sComponent: %s]%s%s"
+                       (when (:deleted component) "DELETED ")
+                       (:name component)
+                       (when show-ids (str " " (:id component)))
+                       (when show-modified (str " " (:modified-at component)))))
+  (when (:main-instance-page component)
+    (let [page (get-component-page (:data file) component)
+          root (get-component-root (:data file) component)]
+      (if-not show-ids
+        (println (str "  --> [" (:name page) "] " (:name root)))
+        (do
+          (println (str "  " (:name page) (str/format " %s" (:id page))))
+          (println (str "  " (:name root) (str/format " %s" (:id root))))))))
+
+  (when (and (:main-instance-page component)
+             (seq (:objects component)))
+    (println))
+
+  (when (seq (:objects component))
+    (let [root (ctk/get-component-root component)]
+      (dump-shape (:id root)
+                  1
+                  (:objects component)
+                  file
+                  libraries
+                  flags))))
+
+(defn dump-page
+  "Display a summary of a page, and of all shapes inside."
+  [page file libraries {:keys [show-ids root-id] :as flags
+                        :or {root-id uuid/zero}}]
+  (let [objects (:objects page)
+        root    (get objects root-id)]
+    (println (str/format "[Page: %s]%s"
+                         (:name page)
+                         (when show-ids (str " " (:id page)))))
+    (dump-shape (:id root)
+                1
+                objects
+                file
+                libraries
+                flags)))
+
+(defn dump-library
+  "Display a summary of a library, and of all components inside."
+  [library file libraries {:keys [show-ids only include-deleted?] :as flags}]
+  (let [lib-components (ctkl/components (:data library) {:include-deleted? include-deleted?})]
+    (println)
+    (println (str/format "========= %s%s"
+                         (if (= (:id library) (:id file))
+                           "Local library"
+                           (str/format "Library %s" (:name library)))
+                         (when show-ids
+                           (str/format " %s" (:id library)))))
+
+    (if (seq lib-components)
+      (dorun (for [component (vals lib-components)]
+               (when (or (nil? only) (only (:id component)))
+                 (do
+                   (println)
+                   (dump-component component
+                                   library
+                                   libraries
+                                   flags)))))
+      (do
+        (println)
+        (println "(no components)")))))
+
 (defn dump-tree
-  ([file-data page-id libraries]
-   (dump-tree file-data page-id libraries false false false))
+  "Display all shapes in the given page, and also all components of the local
+   library and all linked libraries."
+  [file page-id libraries flags]
+  (let [page (ctpl/get-page (:data file) page-id)]
 
-  ([file-data page-id libraries show-ids]
-   (dump-tree file-data page-id libraries show-ids false false))
+    (dump-page page file libraries flags)
 
-  ([file-data page-id libraries show-ids show-touched]
-   (dump-tree file-data page-id libraries show-ids show-touched false))
+    (dump-library file
+                  file
+                  libraries
+                  flags)
 
-  ([file-data page-id libraries show-ids show-touched show-modified]
-   (let [page       (ctpl/get-page file-data page-id)
-         objects    (:objects page)
-         components (ctkl/components file-data)
-         root       (d/seek #(nil? (:parent-id %)) (vals objects))]
+    (dorun (for [library (vals libraries)]
+             (dump-library library
+                           file
+                           libraries
+                           flags)))
+    (println)))
 
-     (letfn [(show-shape [shape-id level objects]
-               (let [shape (get objects shape-id)]
-                 (println (str/pad (str (str/repeat "  " level)
-                                        (when (:main-instance? shape) "{")
-                                        (:name shape)
-                                        (when (:main-instance? shape) "}")
-                                        (when (seq (:touched shape)) "*")
-                                        (when show-ids (str/format " <%s>" (:id shape))))
-                                   {:length 20
-                                    :type :right})
-                          (show-component-info shape objects))
-                 (when show-touched
-                   (when (seq (:touched shape))
-                     (println (str (str/repeat "  " level)
-                                   "    "
-                                   (str (:touched shape)))))
-                   (when (:remote-synced? shape)
-                     (println (str (str/repeat "  " level)
-                                   "    (remote-synced)"))))
-                 (when (:shapes shape)
-                   (dorun (for [shape-id (:shapes shape)]
-                            (show-shape shape-id (inc level) objects))))))
+(defn dump-subtree
+  "Display all shapes in the context of the given shape, and also the components
+   used by any of the shape or children."
+  [file page-id shape-id libraries flags]
+  (let [libraries* (assoc libraries (:id file) file)]
+    (letfn [(add-component
+              [libs-to-show library-id component-id]
+              ;; libs-to-show is a structure like {<lib1-id> #{<comp1-id> <comp2-id>}
+              ;;                                   <lib2-id> #{<comp3-id>}
+              (let [component-ids (conj (get libs-to-show library-id #{})
+                                        component-id)]
+                (assoc libs-to-show library-id component-ids)))
 
-             (show-component-info [shape objects]
-               (if (nil? (:shape-ref shape))
-                 (if (:component-root? shape) " #" "")
-                 (let [root-shape        (ctn/get-component-shape objects shape)
-                       component-id      (when root-shape (:component-id root-shape))
-                       component-file-id (when root-shape (:component-file root-shape))
-                       component-file    (when component-file-id (get libraries component-file-id nil))
-                       component         (when component-id
-                                           (if component-file
-                                             (ctkl/get-component (:data component-file) component-id)
-                                             (get components component-id)))
-                       component-shape   (when component
-                                           (if component-file
-                                             (get-ref-shape (:data component-file) component shape)
-                                             (get-ref-shape file-data component shape)))]
+            (find-used-components
+              [page root]
+              (let [children (cph/get-children-with-self (:objects page) (:id root))]
+                (reduce (fn [libs-to-show shape]
+                          (if (ctk/instance-head? shape)
+                            (add-component libs-to-show (:component-file shape) (:component-id shape))
+                            libs-to-show))
+                        {}
+                        children)))
 
-                   (str/format " %s--> %s%s%s"
-                               (cond (:component-root? shape) "#"
-                                     (:component-id shape) "@"
-                                     :else "-")
+            (find-used-components-cumulative
+              [libs-to-show page root]
+              (let [sublibs-to-show (find-used-components page root)]
+                (reduce (fn [libs-to-show [library-id components]]
+                          (reduce (fn [libs-to-show component-id]
+                                    (let [library   (get libraries* library-id)
+                                          component (get-component libraries* library-id component-id {:include-deleted? true})
+                                          ;; page      (get-component-page (:data library) component)
+                                          root      (when component
+                                                      (get-component-root (:data library) component))]
+                                      (if (nil? component)
+                                        (do
+                                          (println (str/format "(Cannot find component %s in library %s)"
+                                                               component-id library-id))
+                                          libs-to-show)
+                                        (if (get-in libs-to-show [library-id (:id root)])
+                                          libs-to-show
+                                          (-> libs-to-show
+                                              (add-component library-id component-id)
+                                              ;; (find-used-components-cumulative page root)
+                                              )))))
+                                  libs-to-show
+                                  components))
+                        libs-to-show
+                        sublibs-to-show)))]
 
-                               (when component-file (str/format "<%s> " (:name component-file)))
+      (let [page (ctpl/get-page (:data file) page-id)
+            shape (ctst/get-shape page shape-id)
+            root (or (ctn/get-instance-root (:objects page) shape)
+                     shape) ; If not in a component, start by the shape itself
 
-                               (or (:name component-shape) "?")
+            libs-to-show (find-used-components-cumulative {} page root)]
 
-                               (if (or (:component-root? shape)
-                                       (nil? (:component-id shape))
-                                       true)
-                                 ""
-                                 (let [component-id      (:component-id shape)
-                                       component-file-id (:component-file shape)
-                                       component-file    (when component-file-id (get libraries component-file-id nil))
-                                       component         (if component-file
-                                                           (ctkl/get-component (:data component-file) component-id)
-                                                           (get components component-id))]
-                                   (str/format " (%s%s)"
-                                               (when component-file (str/format "<%s> " (:name component-file)))
-                                               (:name component))))))))
+        (if (nil? root)
+          (println (str "Cannot find shape " shape-id))
+          (do
+            (dump-page page file libraries (assoc flags :root-id (:id root)))
+            (dorun (for [[library-id component-ids] libs-to-show]
+                     (let [library (get libraries* library-id)]
+                       (dump-library library
+                                     file
+                                     libraries
+                                     (assoc flags
+                                            :only component-ids
+                                            :include-deleted? true))
+                       (dorun (for [component-id component-ids]
+                                (let [library   (get libraries* library-id)
+                                      component (get-component libraries* library-id component-id {:include-deleted? true})
+                                      page      (get-component-page (:data library) component)
+                                      root      (get-component-root (:data library) component)]
+                                  (when-not (:deleted component)
+                                    (println)
+                                    (dump-page page file libraries* (assoc flags :root-id (:id root))))))))))))))))
 
-             (show-component-instance [component]
-               (let [page (get-component-page file-data component)
-                     root (get-component-root file-data component)]
-                 (if-not show-ids
-                   (println (str "  [" (:name page) "] / " (:name root)))
-                   (do
-                     (println (str "  " (:name page) (str/format " <%s>" (:id page))))
-                     (println (str "  " (:name root) (str/format " <%s>" (:id root))))))))]
+;; Export
 
-       (println (str "[Page: " (:name page) "]"))
-       (show-shape (:id root) 0 objects)
+(defn- get-component-ref-file
+  [objects shape]
 
-       (dorun (for [component (vals components)]
-                (do
-                  (println)
-                  (println (str/format "[%s]%s%s"
-                                       (:name component)
-                                       (when show-ids (str " " (:id component)))
-                                       (when show-modified (str " " (:modified-at component)))))
-                  (when (:objects component)
-                    (show-shape (:id component) 0 (:objects component)))
-                  (when (:main-instance-page component)
-                    (show-component-instance component)))))))))
+  (cond
+    (contains? shape :component-file)
+    (get shape :component-file)
 
+    (contains? shape :shape-ref)
+    (recur objects (get objects (:parent-id shape)))
+
+    :else
+    nil))
+
+(defn detach-external-references
+  [file file-id]
+  (let [detach-text
+        (fn [content]
+          (->> content
+               (ct/transform-nodes
+                #(cond-> %
+                   (not= file-id (:fill-color-ref-file %))
+                   (dissoc :fill-color-ref-id :fill-color-ref-file)
+
+                   (not= file-id (:typography-ref-file %))
+                   (dissoc :typography-ref-id :typography-ref-file)))))
+
+        detach-shape
+        (fn [objects shape]
+          (l/debug :hint "detach-shape"
+                   :file-id file-id
+                   :component-ref-file (get-component-ref-file objects shape)
+                   ::l/sync? true)
+          (cond-> shape
+            (not= file-id (:fill-color-ref-file shape))
+            (dissoc :fill-color-ref-id :fill-color-ref-file)
+
+            (not= file-id (:stroke-color-ref-file shape))
+            (dissoc :stroke-color-ref-id :stroke-color-ref-file)
+
+            (not= file-id (get-component-ref-file objects shape))
+            (dissoc :component-id :component-file :shape-ref :component-root)
+
+            (= :text (:type shape))
+            (update :content detach-text)))
+
+        detach-objects
+        (fn [objects]
+          (update-vals objects #(detach-shape objects %)))
+
+        detach-pages
+        (fn [pages-index]
+          (update-vals pages-index #(update % :objects detach-objects)))]
+
+    (-> file
+        (update-in [:data :pages-index] detach-pages))))

common/src/app/common/types/modifiers.cljc

@@ -19,8 +19,7 @@
    [app.common.pages.helpers :as cph]
    [app.common.text :as txt]
    [app.common.types.shape.layout :as ctl]
-   #?(:cljs [cljs.core :as c]
-      :clj [clojure.core :as c])))
+   [clojure.core :as c]))
 
 ;; --- Modifiers
 
@@ -106,18 +105,17 @@
   [property value]
   (StructureOperation. :change-property property value nil))
 
-
 ;; Private aux functions
 
 (defn- move-vec?
   [vector]
-  (or (not (mth/almost-zero? (dm/get-prop vector :x)))
-      (not (mth/almost-zero? (dm/get-prop vector :y)))))
+  (or (not ^boolean (mth/almost-zero? (dm/get-prop vector :x)))
+      (not ^boolean (mth/almost-zero? (dm/get-prop vector :y)))))
 
 (defn- resize-vec?
   [vector]
-  (or (not (mth/almost-zero? (- (dm/get-prop vector :x) 1)))
-      (not (mth/almost-zero? (- (dm/get-prop vector :y) 1)))))
+  (or (not ^boolean (mth/almost-zero? (- (dm/get-prop vector :x) 1)))
+      (not ^boolean (mth/almost-zero? (- (dm/get-prop vector :y) 1)))))
 
 (defn- mergeable-move?
   [op1 op2]
@@ -128,22 +126,24 @@
 (defn- mergeable-resize?
   [op1 op2]
   (let [type-op1          (dm/get-prop op1 :type)
-        transform-op1     (or (dm/get-prop op1 :transform) (gmt/matrix))
-        transform-inv-op1 (or (dm/get-prop op1 :transform-inverse) (gmt/matrix))
+        transform-op1     (d/nilv (dm/get-prop op1 :transform) gmt/base)
+        transform-inv-op1 (d/nilv (dm/get-prop op1 :transform-inverse) gmt/base)
         origin-op1        (dm/get-prop op1 :origin)
 
         type-op2          (dm/get-prop op2 :type)
-        transform-op2     (or (dm/get-prop op2 :transform) (gmt/matrix))
-        transform-inv-op2 (or (dm/get-prop op2 :transform-inverse) (gmt/matrix))
+        transform-op2     (d/nilv (dm/get-prop op2 :transform) gmt/base)
+        transform-inv-op2 (d/nilv (dm/get-prop op2 :transform-inverse) gmt/base)
         origin-op2        (dm/get-prop op2 :origin)]
-    (and (= :resize type-op1) (= :resize type-op2)
+
+    (and (= :resize type-op1)
+         (= :resize type-op2)
 
          ;; Same origin
-         (gpt/close? origin-op1 origin-op2)
+         ^boolean (gpt/close? origin-op1 origin-op2)
 
          ;; Same transforms
-         (gmt/close? transform-op1 transform-op2)
-         (gmt/close? transform-inv-op1 transform-inv-op2))))
+         ^boolean (gmt/close? transform-op1 transform-op2)
+         ^boolean (gmt/close? transform-inv-op1 transform-inv-op2))))
 
 (defn- merge-move
   [op1 op2]
@@ -155,14 +155,15 @@
 (defn- merge-resize
   [op1 op2]
   (let [op1-vector (dm/get-prop op1 :vector)
-        op1-x (dm/get-prop op1-vector :x)
-        op1-y (dm/get-prop op1-vector :y)
+        op1-x      (dm/get-prop op1-vector :x)
+        op1-y      (dm/get-prop op1-vector :y)
 
         op2-vector (dm/get-prop op2 :vector)
-        op2-x (dm/get-prop op2-vector :x)
-        op2-y (dm/get-prop op2-vector :y)
+        op2-x      (dm/get-prop op2-vector :x)
+        op2-y      (dm/get-prop op2-vector :y)
 
-        vector (gpt/point (* op1-x op2-x) (* op1-y op2-y))]
+        vector     (gpt/point (* op1-x op2-x)
+                              (* op1-y op2-y))]
     (assoc op1 :vector vector)))
 
 (defn- maybe-add-move
@@ -198,10 +199,7 @@
   [vector]
   (let [x (dm/get-prop vector :x)
         y (dm/get-prop vector :y)]
-    (and (some? x)
-         (some? y)
-         (not (mth/nan? x))
-         (not (mth/nan? y)))))
+    (d/num? x y)))
 
 ;; Public builder API
 
@@ -245,8 +243,11 @@
    (move modifiers (gpt/point x y)))
 
   ([modifiers vector]
-   (assert (valid-vector? vector) (dm/str "Invalid move vector: " (:x vector) "," (:y vector)))
-   (let [modifiers (or modifiers (empty))
+   (dm/assert!
+    ["Invalid move vector: %1,%2" (:x vector) (:y vector)]
+    (valid-vector? vector))
+
+   (let [modifiers (or ^boolean modifiers (empty))
          order     (inc (dm/get-prop modifiers :last-order))
          modifiers (assoc modifiers :last-order order)]
      (cond-> modifiers
@@ -256,7 +257,7 @@
 (defn resize
   ([modifiers vector origin]
    (assert (valid-vector? vector) (dm/str "Invalid resize vector: " (:x vector) "," (:y vector)))
-   (let [modifiers (or modifiers (empty))
+   (let [modifiers (or ^boolean modifiers (empty))
          order     (inc (dm/get-prop modifiers :last-order))
          modifiers (assoc modifiers :last-order order)]
      (cond-> modifiers
@@ -412,7 +413,7 @@
 
 (defn rotation-modifiers
   [shape center angle]
-  (let [shape-center (gco/center-shape shape)
+  (let [shape-center (gco/shape->center shape)
         ;; Translation caused by the rotation
         move-vec
         (gpt/transform
@@ -502,7 +503,7 @@
 
         shape-transform (:transform shape)
         shape-transform-inv (:transform-inverse shape)
-        shape-center (gco/center-shape shape)
+        shape-center (gco/shape->center shape)
         {sr-width :width sr-height :height} (:selrect shape)
 
         origin (cond-> (gpt/point (:selrect shape))
@@ -594,7 +595,72 @@
 
 ;; Main transformation functions
 
+(defn transform-move!
+  "Transforms a matrix by the translation modifier"
+  [matrix modifier]
+  (-> (dm/get-prop modifier :vector)
+          (gmt/translate-matrix)
+          (gmt/multiply! matrix)))
+
+
+(defn transform-resize!
+  "Transforms a matrix by the resize modifier"
+  [matrix modifier]
+  (let [tf     (dm/get-prop modifier :transform)
+        tfi    (dm/get-prop modifier :transform-inverse)
+        vector (dm/get-prop modifier :vector)
+        origin (dm/get-prop modifier :origin)
+        origin (if ^boolean (some? tfi)
+                 (gpt/transform origin tfi)
+                 origin)]
+
+    (gmt/multiply!
+     (-> (gmt/matrix)
+         (cond-> ^boolean (some? tf)
+           (gmt/multiply! tf))
+         (gmt/translate! origin)
+         (gmt/scale! vector)
+         (gmt/translate! (gpt/negate origin))
+         (cond-> ^boolean (some? tfi)
+           (gmt/multiply! tfi)))
+     matrix)))
+
+(defn transform-rotate!
+  "Transforms a matrix by the rotation modifier"
+  [matrix modifier]
+  (let [center   (dm/get-prop modifier :center)
+        rotation (dm/get-prop modifier :rotation)]
+    (gmt/multiply!
+     (-> (gmt/matrix)
+         (gmt/translate! center)
+         (gmt/multiply! (gmt/rotate-matrix rotation))
+         (gmt/translate! (gpt/negate center)))
+     matrix)))
+
+(defn transform!
+  "Returns a matrix transformed by the modifier"
+  [matrix modifier]
+  (let [type (dm/get-prop modifier :type)]
+    (case type
+      :move (transform-move! matrix modifier)
+      :resize (transform-resize! matrix modifier)
+      :rotation (transform-rotate! matrix modifier))))
+
+(defn modifiers->transform1
+  "A multiplatform version of modifiers->transform."
+  [modifiers]
+  (reduce transform! (gmt/matrix) modifiers))
+
 (defn modifiers->transform
+  "Given a set of modifiers returns its transformation matrix"
+  [modifiers]
+  (let [modifiers (concat (dm/get-prop modifiers :geometry-parent)
+                          (dm/get-prop modifiers :geometry-child))
+        modifiers (sort-by #(dm/get-prop % :order) modifiers)
+        ]
+    (modifiers->transform1 modifiers)))
+
+(defn modifiers->transform-old
   "Given a set of modifiers returns its transformation matrix"
   [modifiers]
   (let [modifiers (->> (concat (dm/get-prop modifiers :geometry-parent)

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

@@ -66,9 +66,11 @@
 (def empty-page-data
   {:options {}
    :objects {root
-             {:id root
-              :type :frame
-              :name "Root Frame"}}})
+             (cts/setup-shape {:id root
+                               :type :frame
+                               :parent-id root
+                               :frame-id root
+                               :name "Root Frame"})}})
 
 (defn make-empty-page
   [id name]

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

@@ -6,30 +6,50 @@
 
 (ns app.common.types.shape
   (:require
+   #?(:clj [app.common.fressian :as fres])
    [app.common.colors :as clr]
    [app.common.data :as d]
-   [app.common.exceptions :as ex]
    [app.common.geom.matrix :as gmt]
    [app.common.geom.point :as gpt]
+   [app.common.geom.proportions :as gpr]
+   [app.common.geom.rect :as grc]
    [app.common.geom.shapes :as gsh]
-   [app.common.pages.common :refer [default-color]]
+   [app.common.record :as cr]
    [app.common.schema :as sm]
+   [app.common.schema.generators :as sg]
+   [app.common.transit :as t]
    [app.common.types.color :as ctc]
    [app.common.types.grid :as ctg]
+   [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]
-   ;; FIXME: missing spec -> schema
-   #_[app.common.types.shape.layout :as ctsl]
+   [app.common.types.shape.layout :as ctsl]
    [app.common.types.shape.shadow :as ctss]
    [app.common.types.shape.text :as ctsx]
    [app.common.uuid :as uuid]
    [clojure.set :as set]))
 
+(cr/defrecord Shape [id name type x y width height rotation selrect points transform transform-inverse parent-id frame-id])
+
+(defn shape?
+  [o]
+  (instance? Shape o))
+
 (def stroke-caps-line #{:round :square})
 (def stroke-caps-marker #{:line-arrow :triangle-arrow :square-marker :circle-marker :diamond-marker})
 (def stroke-caps (set/union stroke-caps-line stroke-caps-marker))
 
+(def shape-types
+  #{:frame
+    :group
+    :bool
+    :rect
+    :path
+    :circle
+    :svg-raw
+    :image})
+
 (def blend-modes
   #{:normal
     :darken
@@ -58,18 +78,26 @@
   #{"left" "right" "center" "justify"})
 
 (sm/def! ::selrect
-  [:map {:title "Selrect"}
-   [:x ::sm/safe-number]
-   [:y ::sm/safe-number]
-   [:x1 ::sm/safe-number]
-   [:x2 ::sm/safe-number]
-   [:y1 ::sm/safe-number]
-   [:y2 ::sm/safe-number]
-   [:width ::sm/safe-number]
-   [:height ::sm/safe-number]])
+  [:and
+   {:title "Selrect"
+    :gen/gen (->> (sg/tuple (sg/small-double)
+                            (sg/small-double)
+                            (sg/small-double)
+                            (sg/small-double))
+                  (sg/fmap #(apply grc/make-rect %)))}
+   [:fn grc/rect?]
+   [:map
+    [:x ::sm/safe-number]
+    [:y ::sm/safe-number]
+    [:x1 ::sm/safe-number]
+    [:x2 ::sm/safe-number]
+    [:y1 ::sm/safe-number]
+    [:y2 ::sm/safe-number]
+    [:width ::sm/safe-number]
+    [:height ::sm/safe-number]]])
 
 (sm/def! ::points
-  [:vector {:gen/max 5} ::gpt/point])
+  [:vector {:gen/max 4 :gen/min 4} ::gpt/point])
 
 (sm/def! ::fill
   [:map {:title "Fill"}
@@ -96,12 +124,30 @@
     [::sm/one-of stroke-caps]]
    [:stroke-color-gradient {:optional true} ::ctc/gradient]])
 
+(sm/def! ::minimal-shape-attrs
+  [:map {:title "ShapeMinimalRecord"}
+   [:id {:optional false} ::sm/uuid]
+   [:name {:optional false} :string]
+   [:type {:optional false} [::sm/one-of shape-types]]
+   [:x {:optional false} [:maybe ::sm/safe-number]]
+   [:y {:optional false} [:maybe ::sm/safe-number]]
+   [:width {:optional false} [:maybe ::sm/safe-number]]
+   [:height {:optional false} [:maybe ::sm/safe-number]]
+   [:selrect {:optional false} ::selrect]
+   [:points {:optional false} ::points]
+   [:transform {:optional false} ::gmt/matrix]
+   [:transform-inverse {:optional false} ::gmt/matrix]
+   [:parent-id {:optional false} ::sm/uuid]
+   [:frame-id {:optional false} ::sm/uuid]])
+
 (sm/def! ::shape-attrs
   [:map {:title "ShapeAttrs"}
    [:name {:optional true} :string]
    [:component-id {:optional true}  ::sm/uuid]
    [:component-file {:optional true} ::sm/uuid]
    [:component-root {:optional true} :boolean]
+   [:main-instance {:optional true} :boolean]
+   [:remote-synced {:optional true} :boolean]
    [:shape-ref {:optional true} ::sm/uuid]
    [:selrect {:optional true} ::selrect]
    [:points {:optional true} ::points]
@@ -109,7 +155,7 @@
    [:collapsed {:optional true} :boolean]
    [:locked {:optional true} :boolean]
    [:hidden {:optional true} :boolean]
-   [:masked-group? {:optional true} :boolean]
+   [:masked-group {:optional true} :boolean]
    [:fills {:optional true}
     [:vector {:gen/max 2} ::fill]]
    [:hide-fill-on-export {:optional true} :boolean]
@@ -126,10 +172,10 @@
    [:r2 {:optional true} ::sm/safe-number]
    [:r3 {:optional true} ::sm/safe-number]
    [:r4 {:optional true} ::sm/safe-number]
-   [:x {:optional true} ::sm/safe-number]
-   [:y {:optional true} ::sm/safe-number]
-   [:width {:optional true} ::sm/safe-number]
-   [:height {:optional true} ::sm/safe-number]
+   [:x {:optional true} [:maybe ::sm/safe-number]]
+   [:y {:optional true} [:maybe ::sm/safe-number]]
+   [:width {:optional true} [:maybe ::sm/safe-number]]
+   [:height {:optional true} [:maybe ::sm/safe-number]]
    [:opacity {:optional true} ::sm/safe-number]
    [:grids {:optional true}
     [:vector {:gen/max 2} ::ctg/grid]]
@@ -149,21 +195,18 @@
     [::sm/one-of #{:auto-width :auto-height :fixed}]]
    ])
 
-(def shape-attrs?
+(def valid-shape-attrs?
   (sm/pred-fn ::shape-attrs))
 
 (sm/def! ::group-attrs
   [:map {:title "GroupAttrs"}
    [:type [:= :group]]
-   [:id ::sm/uuid]
    [:shapes {:optional true} [:maybe [:vector {:gen/max 10 :gen/min 1} ::sm/uuid]]]])
 
 (sm/def! ::frame-attrs
   [:map {:title "FrameAttrs"}
    [:type [:= :frame]]
-   [:id ::sm/uuid]
-   [:shapes {:optional true} [:vector {:gen/max 10 :gen/min 1} ::sm/uuid]]
-   [:file-thumbnail {:optional true} :boolean]
+   [:shapes [:vector {:gen/max 10 :gen/min 1} ::sm/uuid]]
    [:hide-fill-on-export {:optional true} :boolean]
    [:show-content {:optional true} :boolean]
    [:hide-in-viewer {:optional true} :boolean]])
@@ -171,7 +214,6 @@
 (sm/def! ::bool-attrs
   [:map {:title "BoolAttrs"}
    [:type [:= :bool]]
-   [:id ::sm/uuid]
    [:shapes {:optional true} [:maybe [:vector {:gen/max 10 :gen/min 1} ::sm/uuid]]]
 
    ;; FIXME: improve this schema
@@ -189,23 +231,19 @@
 
 (sm/def! ::rect-attrs
   [:map {:title "RectAttrs"}
-   [:type [:= :rect]]
-   [:id ::sm/uuid]])
+   [:type [:= :rect]]])
 
 (sm/def! ::circle-attrs
   [:map {:title "CircleAttrs"}
-   [:type [:= :circle]]
-   [:id ::sm/uuid]])
+   [:type [:= :circle]]])
 
 (sm/def! ::svg-raw-attrs
   [:map {:title "SvgRawAttrs"}
-   [:type [:= :svg-raw]]
-   [:id ::sm/uuid]])
+   [:type [:= :svg-raw]]])
 
 (sm/def! ::image-attrs
   [:map {:title "ImageAttrs"}
    [:type [:= :image]]
-   [:id ::sm/uuid]
    [:metadata
     [:map
      [:width :int]
@@ -216,7 +254,6 @@
 (sm/def! ::path-attrs
   [:map {:title "PathAttrs"}
    [:type [:= :path]]
-   [:id ::sm/uuid]
    [:x {:optional true} [:maybe ::sm/safe-number]]
    [:y {:optional true} [:maybe ::sm/safe-number]]
    [:width {:optional true} [:maybe ::sm/safe-number]]
@@ -230,210 +267,241 @@
 
 (sm/def! ::text-attrs
   [:map {:title "TextAttrs"}
-   [:id ::sm/uuid]
    [:type [:= :text]]
    [:content {:optional true} [:maybe ::ctsx/content]]])
 
-(sm/def! ::shape
+(sm/def! ::shape-map
   [:multi {:dispatch :type :title "Shape"}
    [:group
     [:merge {:title "GroupShape"}
      ::shape-attrs
-     ::group-attrs]]
+     ::minimal-shape-attrs
+     ::group-attrs
+     ::ctsl/layout-child-attrs]]
 
    [:frame
     [:merge {:title "FrameShape"}
-     ::shape-attrs
-     ::frame-attrs]]
+     ::minimal-shape-attrs
+     ::frame-attrs
+     ::ctsl/layout-attrs
+     ::ctsl/layout-child-attrs]]
 
    [:bool
     [:merge {:title "BoolShape"}
      ::shape-attrs
-     ::bool-attrs]]
+     ::minimal-shape-attrs
+     ::bool-attrs
+     ::ctsl/layout-child-attrs]]
 
    [:rect
     [:merge {:title "RectShape"}
      ::shape-attrs
-     ::rect-attrs]]
+     ::minimal-shape-attrs
+     ::rect-attrs
+     ::ctsl/layout-child-attrs]]
 
    [:circle
     [:merge {:title "CircleShape"}
      ::shape-attrs
-     ::circle-attrs]]
+     ::minimal-shape-attrs
+     ::circle-attrs
+     ::ctsl/layout-child-attrs]]
 
    [:image
     [:merge {:title "ImageShape"}
      ::shape-attrs
-     ::image-attrs]]
+     ::minimal-shape-attrs
+     ::image-attrs
+     ::ctsl/layout-child-attrs]]
 
    [:svg-raw
     [:merge {:title "SvgRawShape"}
      ::shape-attrs
-     ::svg-raw-attrs]]
+     ::minimal-shape-attrs
+     ::svg-raw-attrs
+     ::ctsl/layout-child-attrs]]
 
    [:path
     [:merge {:title "PathShape"}
      ::shape-attrs
-     ::path-attrs]]
+     ::minimal-shape-attrs
+     ::path-attrs
+     ::ctsl/layout-child-attrs]]
 
    [:text
     [:merge {:title "TextShape"}
      ::shape-attrs
-     ::text-attrs]]
-   ])
+     ::minimal-shape-attrs
+     ::text-attrs
+     ::ctsl/layout-child-attrs]]])
 
-(def shape?
+(sm/def! ::shape
+  [:and
+   {:title "Shape"
+    :gen/gen (->> (sg/generator ::shape-map)
+                  (sg/fmap map->Shape))}
+   ::shape-map
+   [:fn shape?]])
+
+(def valid-shape?
   (sm/pred-fn ::shape))
 
 ;; --- Initialization
 
-(def default-shape-attrs
-  {})
+(def ^:private minimal-rect-attrs
+  {:type :rect
+   :name "Rectangle"
+   :fills [{:fill-color default-color
+            :fill-opacity 1}]
+   :strokes []
+   :rx 0
+   :ry 0})
 
-(def default-frame-attrs
+(def ^:private minimal-image-attrs
+  {:type :image
+   :rx 0
+   :ry 0
+   :fills []
+   :strokes []})
+
+(def ^:private minimal-frame-attrs
   {:frame-id uuid/zero
    :fills [{:fill-color clr/white
             :fill-opacity 1}]
+   :name "Board"
    :strokes []
    :shapes []
    :hide-fill-on-export false})
 
-(def ^:private minimal-shapes
-  [{:type :rect
-    :name "Rectangle"
-    :fills [{:fill-color default-color
-             :fill-opacity 1}]
-    :strokes []
-    :rx 0
-    :ry 0}
+(def ^:private minimal-circle-attrs
+  {:type :circle
+   :name "Ellipse"
+   :fills [{:fill-color default-color
+            :fill-opacity 1}]
+   :strokes []})
 
-   {:type :image
-    :rx 0
-    :ry 0
-    :fills []
-    :strokes []}
+(def ^:private minimal-group-attrs
+  {:type :group
+   :name "Group"
+   :shapes []})
 
-   {:type :circle
-    :name "Ellipse"
-    :fills [{:fill-color default-color
-             :fill-opacity 1}]
-    :strokes []}
+(def ^:private minimal-bool-attrs
+  {:type :bool
+   :name "Bool"
+   :shapes []})
 
-   {:type :path
-    :name "Path"
-    :fills []
-    :strokes [{:stroke-style :solid
-               :stroke-alignment :center
-               :stroke-width 2
-               :stroke-color clr/black
-               :stroke-opacity 1}]}
+(def ^:private minimal-text-attrs
+  {:type :text
+   :name "Text"})
 
-   {:type :frame
-    :name "Board"
-    :fills [{:fill-color clr/white
-             :fill-opacity 1}]
-    :strokes []
-    :rx 0
-    :ry 0}
+(def ^:private minimal-path-attrs
+  {:type :path
+   :name "Path"
+   :fills []
+   :strokes [{:stroke-style :solid
+              :stroke-alignment :center
+              :stroke-width 2
+              :stroke-color clr/black
+              :stroke-opacity 1}]})
 
-   {:type :text
-    :name "Text"
-    :content nil}
+(def ^:private minimal-svg-raw-attrs
+  {:type :svg-raw
+   :fills []
+   :strokes []})
 
-   {:type :svg-raw}])
+(def ^:private minimal-multiple-attrs
+  {:type :multiple})
 
-(def empty-selrect
-  {:x  0    :y  0
-   :x1 0    :y1 0
-   :x2 0.01    :y2 0.01
-   :width 0.01 :height 0.01})
-
-(defn make-minimal-shape
+(defn- get-minimal-shape
   [type]
-  (let [type (cond (= type :curve) :path
-                   :else type)
-        shape (d/seek #(= type (:type %)) minimal-shapes)]
-    (when-not shape
-      (ex/raise :type :assertion
-                :code :shape-type-not-implemented
-                :context {:type type}))
+  (case type
+    :rect minimal-rect-attrs
+    :image minimal-image-attrs
+    :circle minimal-circle-attrs
+    :path minimal-path-attrs
+    :frame minimal-frame-attrs
+    :bool minimal-bool-attrs
+    :group minimal-group-attrs
+    :text minimal-text-attrs
+    :svg-raw minimal-svg-raw-attrs
+    ;; NOTE: used for create ephimeral shapes for multiple selection
+    :multiple minimal-multiple-attrs))
+
+(defn- make-minimal-shape
+  [type]
+  (let [type  (if (= type :curve) :path type)
+        attrs (get-minimal-shape type)]
+
+    (cond-> attrs
+      (not= :path type)
+      (-> (assoc :x 0)
+          (assoc :y 0)
+          (assoc :width 0.01)
+          (assoc :height 0.01))
 
-    (cond-> shape
       :always
-      (assoc :id (uuid/next))
+      (assoc :id (uuid/next)
+             :frame-id uuid/zero
+             :parent-id uuid/zero
+             :rotation 0)
 
-      (not= :path (:type shape))
-      (assoc :x 0
-             :y 0
-             :width 0.01
-             :height 0.01
-             :selrect {:x 0
-                       :y 0
-                       :x1 0
-                       :y1 0
-                       :x2 0.01
-                       :y2 0.01
-                       :width 0.01
-                       :height 0.01}))))
+      :always
+      (map->Shape))))
 
-(defn make-minimal-group
-  [frame-id rect group-name]
-  {:id (uuid/next)
-   :type :group
-   :name group-name
-   :shapes []
-   :frame-id frame-id
-   :x (:x rect)
-   :y (:y rect)
-   :width (:width rect)
-   :height (:height rect)})
-
-(defn setup-rect-selrect
+(defn setup-rect
   "Initializes the selrect and points for a shape."
-  [shape]
-  (let [selrect (gsh/rect->selrect shape)
-        points  (gsh/rect->points shape)
-        points  (cond-> points
-                  (:transform shape)
-                  (gsh/transform-points (gsh/center-points points) (:transform shape)))]
+  [{:keys [selrect points] :as shape}]
+  (let [selrect (or selrect (gsh/shape->rect shape))
+        points  (or points  (grc/rect->points selrect))]
     (-> shape
-        (assoc :selrect selrect
-               :points points))))
+        (assoc :selrect selrect)
+        (assoc :points points))))
 
-(defn- setup-rect
-  "A specialized function for setup rect-like shapes."
-  [shape {:keys [x y width height]}]
-  (-> shape
-      (assoc :x x :y y :width width :height height)
-      (setup-rect-selrect)))
+(defn setup-path
+  [{:keys [content selrect points] :as shape}]
+  (let [selrect (or selrect
+                    (gsh/content->selrect content)
+                    (grc/make-rect))
+        points  (or points  (grc/rect->points selrect))]
+    (-> shape
+        (assoc :selrect selrect)
+        (assoc :points points))))
 
 (defn- setup-image
-  [shape props]
-  (let [metadata (or (:metadata shape) (:metadata props))]
-    (-> (setup-rect shape props)
-        (assoc
-          :metadata metadata
-          :proportion (/ (:width metadata)
-                         (:height metadata))
-          :proportion-lock true))))
+  [{:keys [metadata] :as shape}]
+  (-> shape
+      (assoc :proportion (/ (:width metadata)
+                            (:height metadata)))
+      (assoc :proportion-lock true)))
 
 (defn setup-shape
   "A function that initializes the geometric data of
   the shape. The props must have :x :y :width :height."
-  ([props]
-   (setup-shape {:type :rect} props))
+  [{:keys [type] :as props}]
+  (let [shape (make-minimal-shape type)
+        shape (merge shape (d/without-nils props))
+        shape (case (:type shape)
+                :path  (setup-path shape)
+                :image (-> shape setup-rect setup-image)
+                (setup-rect shape))]
+    (-> shape
+        (cond-> (nil? (:transform shape))
+          (assoc :transform (gmt/matrix)))
+        (cond-> (nil? (:transform-inverse shape))
+          (assoc :transform-inverse (gmt/matrix)))
+        (gpr/setup-proportions))))
 
-  ([shape props]
-   (case (:type shape)
-     :image (setup-image shape props)
-     (setup-rect shape props))))
+;; --- SHAPE SERIALIZATION
 
-(defn make-shape
-  "Make a non group shape, ready to use."
-  [type geom-props attrs]
-  (-> (if-not (= type :group)
-        (make-minimal-shape type)
-        (make-minimal-group uuid/zero geom-props (:name attrs)))
-      (setup-shape geom-props)
-      (merge attrs)))
+(t/add-handlers!
+ {:id "shape"
+  :class Shape
+  :wfn #(into {} %)
+  :rfn map->Shape})
 
+#?(:clj
+   (fres/add-handlers!
+    {:name "penpot/shape"
+     :class Shape
+     :wfn fres/write-map-like
+     :rfn (comp map->Shape fres/read-map-like)}))