diff --git a/backend/src/app/binfile/common.clj b/backend/src/app/binfile/common.clj index 95fae4dfe0..5d756beece 100644 --- a/backend/src/app/binfile/common.clj +++ b/backend/src/app/binfile/common.clj @@ -434,12 +434,12 @@ (d/without-nils)))))) (defn encode-file - [{:keys [::db/conn] :as cfg} {:keys [id] :as file}] - (let [file (if (contains? (:features file) "fdata/objects-map") + [{:keys [::db/conn] :as cfg} {:keys [id features] :as file}] + (let [file (if (contains? features "fdata/objects-map") (feat.fdata/enable-objects-map file) file) - file (if (contains? (:features file) "fdata/pointer-map") + file (if (contains? features "fdata/pointer-map") (binding [pmap/*tracked* (pmap/create-tracked)] (let [file (feat.fdata/enable-pointer-map file)] (feat.fdata/persist-pointers! cfg id) diff --git a/backend/src/app/db.clj b/backend/src/app/db.clj index bbb5fed434..4a583256ef 100644 --- a/backend/src/app/db.clj +++ b/backend/src/app/db.clj @@ -42,6 +42,8 @@ org.postgresql.util.PGInterval org.postgresql.util.PGobject)) +(def ^:dynamic *conn* nil) + (declare open) (declare create-pool) diff --git a/backend/src/app/features/components_v2.clj b/backend/src/app/features/components_v2.clj index af106b1672..9e142aeb34 100644 --- a/backend/src/app/features/components_v2.clj +++ b/backend/src/app/features/components_v2.clj @@ -20,7 +20,6 @@ [app.common.geom.point :as gpt] [app.common.geom.rect :as grc] [app.common.geom.shapes :as gsh] - [app.common.geom.shapes.path :as gshp] [app.common.logging :as l] [app.common.logic.libraries :as cll] [app.common.math :as mth] @@ -36,9 +35,9 @@ [app.common.types.modifiers :as ctm] [app.common.types.page :as ctp] [app.common.types.pages-list :as ctpl] + [app.common.types.path :as path] [app.common.types.shape :as cts] [app.common.types.shape-tree :as ctst] - [app.common.types.shape.path :as ctsp] [app.common.types.shape.text :as ctsx] [app.common.uuid :as uuid] [app.config :as cf] @@ -127,10 +126,10 @@ (sm/lazy-validator ::ctsx/content)) (def valid-path-content? - (sm/lazy-validator ::ctsp/content)) + (sm/lazy-validator ::path/segments)) (def valid-path-segment? - (sm/lazy-validator ::ctsp/segment)) + (sm/lazy-validator ::path/segment)) (def valid-rgb-color-string? (sm/lazy-validator ::ctc/rgb-color)) @@ -580,12 +579,10 @@ (let [shape (update shape :content fix-path-content)] (if (not (valid-path-content? (:content shape))) shape - (let [[points selrect] (gshp/content->points+selrect shape (:content shape))] - (-> shape - (dissoc :bool-content) - (dissoc :bool-type) - (assoc :points points) - (assoc :selrect selrect))))) + (-> shape + (dissoc :bool-content) + (dissoc :bool-type) + (path/update-geometry)))) ;; When we fount a bool shape with no content, ;; we convert it to a simple rect diff --git a/backend/src/app/features/fdata.clj b/backend/src/app/features/fdata.clj index 1d9a649f3d..17ec7b1ec2 100644 --- a/backend/src/app/features/fdata.clj +++ b/backend/src/app/features/fdata.clj @@ -9,7 +9,10 @@ (:require [app.common.data :as d] [app.common.exceptions :as ex] + [app.common.files.helpers :as cfh] + [app.common.files.migrations :as fmg] [app.common.logging :as l] + [app.common.types.path :as path] [app.db :as db] [app.db.sql :as-alias sql] [app.storage :as sto] @@ -30,7 +33,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn enable-objects-map - [file] + [file & _opts] (let [update-page (fn [page] (if (and (pmap/pointer-map? page) @@ -136,10 +139,56 @@ (defn enable-pointer-map "Enable the fdata/pointer-map feature on the file." - [file] + [file & _opts] (-> file (update :data (fn [fdata] (-> fdata (update :pages-index d/update-vals pmap/wrap) (d/update-when :components pmap/wrap)))) (update :features conj "fdata/pointer-map"))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; PATH-DATA +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defn enable-path-data + "Enable the fdata/path-data feature on the file." + [file & _opts] + (letfn [(update-object [object] + (if (or (cfh/path-shape? object) + (cfh/bool-shape? object)) + (update object :content path/content) + object)) + + (update-container [container] + (d/update-when container :objects d/update-vals update-object))] + + (-> file + (update :data (fn [data] + (-> data + (update :pages-index d/update-vals update-container) + (d/update-when :components d/update-vals update-container)))) + (update :features conj "fdata/path-data")))) + +(defn disable-path-data + [file & _opts] + (letfn [(update-object [object] + (if (or (cfh/path-shape? object) + (cfh/bool-shape? object)) + (update object :content vec) + object)) + + (update-container [container] + (d/update-when container :objects d/update-vals update-object))] + + (when-let [conn db/*conn*] + (db/delete! conn :file-migration {:file-id (:id file) + :name "0003-convert-path-content"})) + (-> file + (update :data (fn [data] + (-> data + (update :pages-index d/update-vals update-container) + (d/update-when :components d/update-vals update-container)))) + (update :features disj "fdata/path-data") + (update :migrations disj "0003-convert-path-content") + (vary-meta update ::fmg/migrated disj "0003-convert-path-content")))) diff --git a/backend/src/app/rpc/commands/files_create.clj b/backend/src/app/rpc/commands/files_create.clj index 0502ff4872..eeafddd0ce 100644 --- a/backend/src/app/rpc/commands/files_create.clj +++ b/backend/src/app/rpc/commands/files_create.clj @@ -111,18 +111,21 @@ ::quotes/profile-id profile-id ::quotes/project-id project-id}) - ;; FIXME: IMPORTANT: this code can have race - ;; conditions, because we have no locks for updating - ;; team so, creating two files concurrently can lead - ;; to lost team features updating + ;; FIXME: IMPORTANT: this code can have race conditions, because + ;; we have no locks for updating team so, creating two files + ;; concurrently can lead to lost team features updating - ;; When newly computed features does not match exactly with - ;; the features defined on team row, we update it - (when (not= features (:features team)) - (let [features (db/create-array conn "text" features)] + (when-let [features (-> features + (set/difference (:features team)) + (set/difference cfeat/no-team-inheritable-features) + (not-empty))] + (let [features (->> features + (set/union (:features team)) + (db/create-array conn "text"))] (db/update! conn :team {:features features} - {:id team-id}))) + {:id (:id team)} + {::db/return-keys false}))) (-> (create-file cfg params) (vary-meta assoc ::audit/props {:team-id team-id})))) diff --git a/backend/src/app/rpc/commands/files_update.clj b/backend/src/app/rpc/commands/files_update.clj index 73b4afd3d8..866e67b1f5 100644 --- a/backend/src/app/rpc/commands/files_update.clj +++ b/backend/src/app/rpc/commands/files_update.clj @@ -177,12 +177,19 @@ :stored-revn (:revn file)})) ;; When newly computed features does not match exactly with - ;; the features defined on team row, we update it. - (when (not= features (:features team)) - (let [features (db/create-array conn "text" features)] + ;; the features defined on team row, we update it + (when-let [features (-> features + (set/difference (:features team)) + (set/difference cfeat/no-team-inheritable-features) + (not-empty))] + (let [features (->> features + (set/union (:features team)) + (db/create-array conn "text"))] (db/update! conn :team {:features features} - {:id (:id team)}))) + {:id (:id team)} + {::db/return-keys false}))) + (mtx/run! metrics {:id :update-file-changes :inc (count changes)}) diff --git a/backend/src/app/srepl/main.clj b/backend/src/app/srepl/main.clj index e55a0bfdc2..da4b45edac 100644 --- a/backend/src/app/srepl/main.clj +++ b/backend/src/app/srepl/main.clj @@ -156,6 +156,10 @@ [file-id & {:as opts}] (process-file! file-id feat.fdata/enable-pointer-map opts)) +(defn enable-path-data-feature-on-file! + [file-id & {:as opts}] + (process-file! file-id feat.fdata/enable-path-data opts)) + (defn enable-storage-features-on-file! [file-id & {:as opts}] (enable-objects-map-feature-on-file! file-id opts) @@ -416,10 +420,12 @@ "Apply a function to the file. Optionally save the changes or not. The function receives the decoded and migrated file data." [file-id update-fn & {:keys [rollback?] :or {rollback? true} :as opts}] - (db/tx-run! (assoc main/system ::db/rollback rollback?) - (fn [system] - (binding [h/*system* system] - (h/process-file! system file-id update-fn opts))))) + (let [file-id (h/parse-uuid file-id)] + (db/tx-run! (assoc main/system ::db/rollback rollback?) + (fn [system] + (binding [h/*system* system + db/*conn* (db/get-connection system)] + (h/process-file! system file-id update-fn opts)))))) (defn process-team-files! "Apply a function to each file of the specified team." @@ -431,7 +437,8 @@ (when (string? label) (h/take-team-snapshot! system team-id label)) - (binding [h/*system* system] + (binding [h/*system* system + db/*conn* (db/get-connection system)] (->> (feat.comp-v2/get-and-lock-team-files conn team-id) (reduce (fn [result file-id] (if (h/process-file! system file-id update-fn opts) diff --git a/common/src/app/common/features.cljc b/common/src/app/common/features.cljc index 8f53a9257e..5665a9b434 100644 --- a/common/src/app/common/features.cljc +++ b/common/src/app/common/features.cljc @@ -46,6 +46,7 @@ #{"fdata/objects-map" "fdata/pointer-map" "fdata/shape-data-type" + "fdata/path-data" "components/v2" "styles/v2" "layout/grid" @@ -58,12 +59,18 @@ ;; A set of features enabled by default (def default-features #{"fdata/shape-data-type" + "fdata/path-data" "styles/v2" "layout/grid" "components/v2" "plugins/runtime" "design-tokens/v1"}) +;; A set of features that should not be propagated to team on creating +;; or modifying a file +(def no-team-inheritable-features + #{"fdata/path-data"}) + ;; A set of features which only affects on frontend and can be enabled ;; and disabled freely by the user any time. This features does not ;; persist on file features field but can be permanently enabled on @@ -86,8 +93,9 @@ ;; without migration applied) (def no-migration-features (-> #{"layout/grid" + "design-tokens/v1" "fdata/shape-data-type" - "design-tokens/v1"} + "fdata/path-data"} (into frontend-only-features) (into backend-only-features))) diff --git a/common/src/app/common/files/builder.cljc b/common/src/app/common/files/builder.cljc index d320e8bc43..b233267107 100644 --- a/common/src/app/common/files/builder.cljc +++ b/common/src/app/common/files/builder.cljc @@ -272,14 +272,13 @@ :else (let [objects (lookup-objects file) - content (gsh/calc-bool-content bool objects) - bool' (gsh/update-bool-selrect bool children objects)] + bool' (gsh/update-bool bool children objects)] (commit-change file {:type :mod-obj :id bool-id :operations - [{:type :set :attr :content :val content :ignore-touched true} + [{:type :set :attr :content :val (:content bool') :ignore-touched true} {:type :set :attr :selrect :val (:selrect bool') :ignore-touched true} {:type :set :attr :points :val (:points bool') :ignore-touched true} {:type :set :attr :x :val (-> bool' :selrect :x) :ignore-touched true} diff --git a/common/src/app/common/files/changes.cljc b/common/src/app/common/files/changes.cljc index 023491a9ca..61b08e6b00 100644 --- a/common/src/app/common/files/changes.cljc +++ b/common/src/app/common/files/changes.cljc @@ -739,7 +739,7 @@ group (= :bool (:type group)) - (gsh/update-bool-selrect group children objects) + (gsh/update-bool group children objects) (:masked-group group) (set-mask-selrect group children) diff --git a/common/src/app/common/files/changes_builder.cljc b/common/src/app/common/files/changes_builder.cljc index 69ef62b13e..9028c04d97 100644 --- a/common/src/app/common/files/changes_builder.cljc +++ b/common/src/app/common/files/changes_builder.cljc @@ -8,7 +8,6 @@ (:require [app.common.data :as d] [app.common.data.macros :as dm] - [app.common.features :as cfeat] [app.common.files.changes :as cfc] [app.common.files.helpers :as cfh] [app.common.geom.matrix :as gmt] @@ -84,8 +83,7 @@ (defn with-objects [changes objects] - (let [fdata (binding [cfeat/*current* #{"components/v2"}] - (ctf/make-file-data (uuid/next) uuid/zero)) + (let [fdata (ctf/make-file-data (uuid/next) uuid/zero) fdata (assoc-in fdata [:pages-index uuid/zero :objects] objects)] (vary-meta changes assoc ::file-data fdata @@ -480,9 +478,12 @@ (let [old-val (get old attr) new-val (get new attr)] (not= old-val new-val))) - new-obj (if with-objects? - (update-fn object objects) - (update-fn object))] + + new-obj + (if with-objects? + (update-fn object objects) + (update-fn object))] + (when-not (= object new-obj) (let [attrs (or attrs (d/concat-set (keys object) (keys new-obj)))] (filter (partial changed? object new-obj) attrs))))) @@ -659,7 +660,7 @@ nil ;; so it does not need resize (= (:type parent) :bool) - (gsh/update-bool-selrect parent children objects) + (gsh/update-bool parent children objects) (= (:type parent) :group) (if (:masked-group parent) diff --git a/common/src/app/common/files/migrations.cljc b/common/src/app/common/files/migrations.cljc index 7bd2342ae7..46e20537c7 100644 --- a/common/src/app/common/files/migrations.cljc +++ b/common/src/app/common/files/migrations.cljc @@ -16,7 +16,6 @@ [app.common.geom.point :as gpt] [app.common.geom.rect :as grc] [app.common.geom.shapes :as gsh] - [app.common.geom.shapes.path :as gsp] [app.common.geom.shapes.text :as gsht] [app.common.logging :as l] [app.common.math :as mth] @@ -27,6 +26,8 @@ [app.common.types.component :as ctk] [app.common.types.container :as ctn] [app.common.types.file :as ctf] + [app.common.types.path :as path] + [app.common.types.path.segment :as path.segment] [app.common.types.shape :as cts] [app.common.types.shape.interactions :as ctsi] [app.common.types.shape.shadow :as ctss] @@ -129,8 +130,8 @@ [data _] (letfn [(migrate-path [shape] (if-not (contains? shape :content) - (let [content (gsp/segments->content (:segments shape) (:close? shape)) - selrect (gsh/content->selrect content) + (let [content (path.segment/points->content (:segments shape) :close (:close? shape)) + selrect (path.segment/content->selrect content) points (grc/rect->points selrect)] (-> shape (dissoc :segments) @@ -201,7 +202,7 @@ (if (= (:type shape) :path) (let [{:keys [width height]} (grc/points->rect (:points shape))] (if (or (mth/almost-zero? width) (mth/almost-zero? height)) - (let [selrect (gsh/content->selrect (:content shape)) + (let [selrect (path.segment/content->selrect (:content shape)) points (grc/rect->points selrect) transform (gmt/matrix) transform-inv (gmt/matrix)] @@ -1281,8 +1282,8 @@ (d/update-when container :objects update-vals update-object))] (-> data - (update :pages-index update-vals update-container) - (update :components update-vals update-container)))) + (update :pages-index d/update-vals update-container) + (d/update-when :components d/update-vals update-container)))) (defmethod migrate-data "0003-fix-root-shape" [data _] @@ -1306,6 +1307,23 @@ (d/update-when :components d/update-vals update-container) (d/without-nils)))) +(defmethod migrate-data "0003-convert-path-content" + [data _] + (some-> cfeat/*new* (swap! conj "fdata/path-data")) + + (letfn [(update-object [object] + (if (or (cfh/bool-shape? object) + (cfh/path-shape? object)) + (update object :content path/content) + object)) + + (update-container [container] + (d/update-when container :objects update-vals update-object))] + + (-> data + (update :pages-index d/update-vals update-container) + (d/update-when :components d/update-vals update-container)))) + (def available-migrations (into (d/ordered-set) ["legacy-2" @@ -1363,4 +1381,5 @@ "0001-remove-tokens-from-groups" "0002-normalize-bool-content" "0002-clean-shape-interactions" - "0003-fix-root-shape"])) + "0003-fix-root-shape" + "0003-convert-path-content"])) diff --git a/common/src/app/common/files/shapes_helpers.cljc b/common/src/app/common/files/shapes_helpers.cljc index e4f265c4c9..fa1ba12bd0 100644 --- a/common/src/app/common/files/shapes_helpers.cljc +++ b/common/src/app/common/files/shapes_helpers.cljc @@ -15,6 +15,8 @@ [app.common.types.shape.layout :as ctl] [app.common.uuid :as uuid])) +;; FIXME: move to logic? + (defn prepare-add-shape [changes shape objects] (let [index (:index (meta shape)) @@ -35,6 +37,7 @@ (pcb/update-shapes [(:parent-id shape)] #(ctl/push-into-cell % [id] row column))) (cond-> (ctl/grid-layout? objects (:parent-id shape)) (pcb/update-shapes [(:parent-id shape)] ctl/assign-cells {:with-objects? true})))] + [shape changes])) (defn prepare-move-shapes-into-frame @@ -44,6 +47,7 @@ to-move (->> shapes (map (d/getf objects)) (not-empty))] + (if to-move (-> changes (cond-> (and remove-layout-data? diff --git a/common/src/app/common/geom/point.cljc b/common/src/app/common/geom/point.cljc index 0883e9cd84..a7cf2d412c 100644 --- a/common/src/app/common/geom/point.cljc +++ b/common/src/app/common/geom/point.cljc @@ -5,7 +5,7 @@ ;; Copyright (c) KALEIDOS INC (ns app.common.geom.point - (:refer-clojure :exclude [divide min max abs]) + (:refer-clojure :exclude [divide min max abs zero?]) (:require #?(:clj [app.common.fressian :as fres]) #?(:cljs [cljs.core :as c] @@ -470,6 +470,13 @@ (and ^boolean (mth/almost-zero? (dm/get-prop p :x)) ^boolean (mth/almost-zero? (dm/get-prop p :y)))) +(defn zero? + [p] + (let [x (dm/get-prop p :x) + y (dm/get-prop p :y)] + (and ^boolean (== 0 x) + ^boolean (== 0 y)))) + (defn lerp "Calculates a linear interpolation between two points given a tvalue" [p1 p2 t] diff --git a/common/src/app/common/geom/shapes.cljc b/common/src/app/common/geom/shapes.cljc index 2f0c29df77..1710302c3c 100644 --- a/common/src/app/common/geom/shapes.cljc +++ b/common/src/app/common/geom/shapes.cljc @@ -10,13 +10,11 @@ [app.common.data.macros :as dm] [app.common.geom.point :as gpt] [app.common.geom.rect :as grc] - [app.common.geom.shapes.bool :as gsb] [app.common.geom.shapes.common :as gco] [app.common.geom.shapes.constraints :as gct] [app.common.geom.shapes.corners :as gsc] [app.common.geom.shapes.fit-frame :as gsff] [app.common.geom.shapes.intersect :as gsi] - [app.common.geom.shapes.path :as gsp] [app.common.geom.shapes.transforms :as gtr] [app.common.math :as mth])) @@ -166,7 +164,7 @@ (dm/export gtr/calculate-geometry) (dm/export gtr/update-group-selrect) (dm/export gtr/update-mask-selrect) -(dm/export gtr/update-bool-selrect) +(dm/export gtr/update-bool) (dm/export gtr/apply-transform) (dm/export gtr/transform-shape) (dm/export gtr/transform-selrect) @@ -180,12 +178,6 @@ ;; Constratins (dm/export gct/calc-child-modifiers) -;; PATHS -;; FIXME: rename -(dm/export gsp/content->selrect) -(dm/export gsp/transform-content) -(dm/export gsp/open-path?) - ;; Intersection (dm/export gsi/overlaps?) (dm/export gsi/overlaps-path?) @@ -193,9 +185,6 @@ (dm/export gsi/has-point-rect?) (dm/export gsi/rect-contains-shape?) -;; Bool -(dm/export gsb/calc-bool-content) - ;; Constraints (dm/export gct/default-constraints-h) (dm/export gct/default-constraints-v) diff --git a/common/src/app/common/geom/shapes/bool.cljc b/common/src/app/common/geom/shapes/bool.cljc deleted file mode 100644 index 48116a88db..0000000000 --- a/common/src/app/common/geom/shapes/bool.cljc +++ /dev/null @@ -1,29 +0,0 @@ -;; This Source Code Form is subject to the terms of the Mozilla Public -;; License, v. 2.0. If a copy of the MPL was not distributed with this -;; file, You can obtain one at http://mozilla.org/MPL/2.0/. -;; -;; Copyright (c) KALEIDOS INC - -(ns app.common.geom.shapes.bool - (:require - [app.common.data :as d] - [app.common.files.helpers :as cpf] - [app.common.svg.path.bool :as pb] - [app.common.svg.path.shapes-to-path :as stp])) - -(defn calc-bool-content - [shape objects] - - (let [extract-content-xf - (comp (map (d/getf objects)) - (filter (comp not :hidden)) - (remove cpf/svg-raw-shape?) - (map #(stp/convert-to-path % objects)) - (map :content)) - - shapes-content - (into [] extract-content-xf (:shapes shape))] - (pb/content-bool (:bool-type shape) shapes-content))) - - - diff --git a/common/src/app/common/geom/shapes/bounds.cljc b/common/src/app/common/geom/shapes/bounds.cljc index 91a2053adc..3117e20adf 100644 --- a/common/src/app/common/geom/shapes/bounds.cljc +++ b/common/src/app/common/geom/shapes/bounds.cljc @@ -10,8 +10,8 @@ [app.common.data.macros :as dm] [app.common.files.helpers :as cfh] [app.common.geom.rect :as grc] - [app.common.geom.shapes.path :as gsp] - [app.common.math :as mth])) + [app.common.math :as mth] + [app.common.types.path :as path])) (defn shape-stroke-margin [shape stroke-width] @@ -104,7 +104,7 @@ (let [strokes (:strokes shape) open-path? (and ^boolean (cfh/path-shape? shape) - ^boolean (gsp/open-path? shape)) + ^boolean (path/shape-with-open-path? shape)) stroke-width (->> strokes diff --git a/common/src/app/common/geom/shapes/intersect.cljc b/common/src/app/common/geom/shapes/intersect.cljc index 6601315ca7..1bf11f87e7 100644 --- a/common/src/app/common/geom/shapes/intersect.cljc +++ b/common/src/app/common/geom/shapes/intersect.cljc @@ -13,9 +13,9 @@ [app.common.geom.point :as gpt] [app.common.geom.rect :as grc] [app.common.geom.shapes.common :as gco] - [app.common.geom.shapes.path :as gpp] [app.common.geom.shapes.text :as gte] - [app.common.math :as mth])) + [app.common.math :as mth] + [app.common.types.path.segment :as path.segm])) (defn orientation "Given three ordered points gives the orientation @@ -186,7 +186,7 @@ rect-lines (points->lines rect-points) path-lines (if simple? (points->lines (:points shape)) - (gpp/path->lines shape)) + (path.segm/path->lines shape)) start-point (-> shape :content (first) :params (gpt/point))] (or (intersects-lines? rect-lines path-lines) diff --git a/common/src/app/common/geom/shapes/transforms.cljc b/common/src/app/common/geom/shapes/transforms.cljc index 50a41e06f3..7af176b2a4 100644 --- a/common/src/app/common/geom/shapes/transforms.cljc +++ b/common/src/app/common/geom/shapes/transforms.cljc @@ -12,11 +12,10 @@ [app.common.geom.matrix :as gmt] [app.common.geom.point :as gpt] [app.common.geom.rect :as grc] - [app.common.geom.shapes.bool :as gshb] [app.common.geom.shapes.common :as gco] - [app.common.geom.shapes.path :as gpa] [app.common.math :as mth] - [app.common.types.modifiers :as ctm])) + [app.common.types.modifiers :as ctm] + [app.common.types.path :as path])) #?(:clj (set! *warn-on-reflection* true)) @@ -77,7 +76,11 @@ position-data) position-data)))) -;; FIXME: revist usage of mutability +;; FIXME: review performance of this; this function is executing too +;; many times, including when the point vector is 0,0. This function +;; can be implemented in function of transform which is already mor +;; performant + (defn move "Move the shape relatively to its current position applying the provided delta." @@ -96,7 +99,7 @@ (d/update-when :y d/safe+ dy) (d/update-when :position-data move-position-data mvec) (cond-> (or (= :bool type) (= :path type)) - (update :content gpa/move-content mvec))))) + (update :content path/move-content mvec))))) ;; --- Absolute Movement @@ -321,7 +324,7 @@ (update shape :position-data transform-position-data transform-mtx) shape) shape (if (or (= type :path) (= type :bool)) - (update shape :content gpa/transform-content transform-mtx) + (update shape :content path/transform-content transform-mtx) (assoc shape :x (dm/get-prop selrect :x) :y (dm/get-prop selrect :y) @@ -354,7 +357,7 @@ 360) shape (if (or (= type :path) (= type :bool)) - (update shape :content gpa/transform-content transform-mtx) + (update shape :content path/transform-content transform-mtx) (assoc shape :x (dm/get-prop selrect :x) :y (dm/get-prop selrect :y) @@ -444,24 +447,13 @@ (assoc :flip-x (-> mask :flip-x)) (assoc :flip-y (-> mask :flip-y))))) -(defn update-bool-selrect +(defn update-bool "Calculates the selrect+points for the boolean shape" - [shape children objects] + [shape _children objects] - (let [content - (gshb/calc-bool-content shape objects) - - shape - (assoc shape :content content) - - [points selrect] - (gpa/content->points+selrect shape content)] - - (if (and (some? selrect) (d/not-empty? points)) - (-> shape - (assoc :selrect selrect) - (assoc :points points)) - (update-group-selrect shape children)))) + (let [content (path/calc-bool-content shape objects) + shape (assoc shape :content content)] + (path/update-geometry shape))) (defn update-shapes-geometry [objects ids] @@ -476,7 +468,7 @@ (update-mask-selrect shape children) (cfh/bool-shape? shape) - (update-bool-selrect shape children objects) + (update-bool shape children objects) (cfh/group-shape? shape) (update-group-selrect shape children) diff --git a/common/src/app/common/schema.cljc b/common/src/app/common/schema.cljc index 50a317cda4..557dc8b3d7 100644 --- a/common/src/app/common/schema.cljc +++ b/common/src/app/common/schema.cljc @@ -9,6 +9,7 @@ #?(:cljs (:require-macros [app.common.schema :refer [ignoring]])) (:require [app.common.data :as d] + [app.common.math :as mth] [app.common.pprint :as pp] [app.common.schema.generators :as sg] [app.common.schema.openapi :as-alias oapi] @@ -832,7 +833,8 @@ gen (sg/one-of (sg/small-int :max max :min min) - (sg/small-double :max max :min min))] + (->> (sg/small-double :max max :min min) + (sg/fmap #(mth/precision % 2))))] {:pred pred :type-properties diff --git a/common/src/app/common/schema/generators.cljc b/common/src/app/common/schema/generators.cljc index 57bc3703f6..01805e8ac6 100644 --- a/common/src/app/common/schema/generators.cljc +++ b/common/src/app/common/schema/generators.cljc @@ -5,7 +5,7 @@ ;; Copyright (c) KALEIDOS INC (ns app.common.schema.generators - (:refer-clojure :exclude [set subseq uuid filter map let boolean]) + (:refer-clojure :exclude [set subseq uuid filter map let boolean vector]) #?(:cljs (:require-macros [app.common.schema.generators])) (:require [app.common.schema.registry :as sr] @@ -126,3 +126,7 @@ (defn tuple [& opts] (apply tg/tuple opts)) + +(defn vector + [& opts] + (apply tg/vector opts)) diff --git a/common/src/app/common/schema/test.cljc b/common/src/app/common/schema/test.cljc index c3b38b0a2b..ae44646fee 100644 --- a/common/src/app/common/schema/test.cljc +++ b/common/src/app/common/schema/test.cljc @@ -56,13 +56,8 @@ (str "(pass=TRUE, tests=" (:num-tests params) ", seed=" (:seed params) ", elapsed=" time "ms)")))) (defmethod ct/report #?(:clj ::thrunk :cljs [:cljs.test/default ::thrunk]) - [{:keys [::params] :as m}] - (let [smallest (-> params :shrunk :smallest vec)] - (println) - (println "Condition failed with the following params:") - (println "Seed:" (:seed params)) - (println) - (pp/pprint smallest))) + [_] + nil) (defmethod ct/report #?(:clj ::trial :cljs [:cljs.test/default ::trial]) [_] @@ -76,9 +71,12 @@ (let [tvar (get-testing-var) tsym (get-testing-sym tvar) res (:result params)] - (println) + + (println "---------------------------------------------------------") (println "Generative test:" (str "'" tsym "'") (str "(pass=FALSE, tests=" (:num-tests params) ", seed=" (:seed params) ")")) + (pp/pprint (:fail params)) + (println "---------------------------------------------------------") (when (ex/exception? res) #?(:clj (ex/print-throwable res) diff --git a/common/src/app/common/svg/path/command.cljc b/common/src/app/common/svg/path/command.cljc deleted file mode 100644 index b048d85243..0000000000 --- a/common/src/app/common/svg/path/command.cljc +++ /dev/null @@ -1,204 +0,0 @@ -;; This Source Code Form is subject to the terms of the Mozilla Public -;; License, v. 2.0. If a copy of the MPL was not distributed with this -;; file, You can obtain one at http://mozilla.org/MPL/2.0/. -;; -;; Copyright (c) KALEIDOS INC - -(ns app.common.svg.path.command - (:require - [app.common.data :as d] - [app.common.geom.point :as gpt])) - -(defn command->point - ([prev-pos {:keys [relative params] :as command}] - (let [{:keys [x y] :or {x (:x prev-pos) y (:y prev-pos)}} params] - (if relative - (-> prev-pos (update :x + x) (update :y + y)) - (command->point command)))) - - ([command] - (when command - (let [{:keys [x y]} (:params command)] - (gpt/point x y))))) - - -(defn make-move-to [to] - {:command :move-to - :relative false - :params {:x (:x to) - :y (:y to)}}) - -(defn make-line-to [to] - {:command :line-to - :relative false - :params {:x (:x to) - :y (:y to)}}) - -(defn make-curve-params - ([point] - (make-curve-params point point point)) - - ([point handler] (make-curve-params point handler point)) - - ([point h1 h2] - {:x (:x point) - :y (:y point) - :c1x (:x h1) - :c1y (:y h1) - :c2x (:x h2) - :c2y (:y h2)})) - -(defn update-curve-to - [command h1 h2] - (let [params {:x (-> command :params :x) - :y (-> command :params :y) - :c1x (:x h1) - :c1y (:y h1) - :c2x (:x h2) - :c2y (:y h2)}] - (-> command - (assoc :command :curve-to) - (assoc :params params)))) - -(defn make-curve-to - [to h1 h2] - {:command :curve-to - :relative false - :params (make-curve-params to h1 h2)}) - -(defn update-handler - [command prefix point] - (let [[cox coy] (if (= prefix :c1) [:c1x :c1y] [:c2x :c2y])] - (-> command - (assoc-in [:params cox] (:x point)) - (assoc-in [:params coy] (:y point))))) - -(defn apply-content-modifiers - "Apply to content a map with point translations" - [content modifiers] - (letfn [(apply-to-index [content [index params]] - (if (contains? content index) - (cond-> content - (and - (or (:c1x params) (:c1y params) (:c2x params) (:c2y params)) - (= :line-to (get-in content [index :command]))) - - (-> (assoc-in [index :command] :curve-to) - (assoc-in [index :params] - (make-curve-params - (get-in content [index :params]) - (get-in content [(dec index) :params])))) - - (:x params) (update-in [index :params :x] + (:x params)) - (:y params) (update-in [index :params :y] + (:y params)) - - (:c1x params) (update-in [index :params :c1x] + (:c1x params)) - (:c1y params) (update-in [index :params :c1y] + (:c1y params)) - - (:c2x params) (update-in [index :params :c2x] + (:c2x params)) - (:c2y params) (update-in [index :params :c2y] + (:c2y params))) - content))] - (let [content (if (vector? content) content (into [] content))] - (reduce apply-to-index content modifiers)))) - -(defn get-handler [{:keys [params] :as command} prefix] - (let [cx (d/prefix-keyword prefix :x) - cy (d/prefix-keyword prefix :y)] - (when (and command - (contains? params cx) - (contains? params cy)) - (gpt/point (get params cx) - (get params cy))))) - -(defn content->handlers - "Retrieve a map where for every point will retrieve a list of - the handlers that are associated with that point. - point -> [[index, prefix]]" - [content] - (->> (d/with-prev content) - (d/enumerate) - (mapcat (fn [[index [cur-cmd pre-cmd]]] - (if (and pre-cmd (= :curve-to (:command cur-cmd))) - (let [cur-pos (command->point cur-cmd) - pre-pos (command->point pre-cmd)] - (-> [[pre-pos [index :c1]] - [cur-pos [index :c2]]])) - []))) - - (group-by first) - (d/mapm #(mapv second %2)))) - -(defn point-indices - [content point] - (->> (d/enumerate content) - (filter (fn [[_ cmd]] (= point (command->point cmd)))) - (mapv (fn [[index _]] index)))) - -(defn handler-indices - "Return an index where the key is the positions and the values the handlers" - [content point] - (->> (d/with-prev content) - (d/enumerate) - (mapcat (fn [[index [cur-cmd pre-cmd]]] - (if (and (some? pre-cmd) (= :curve-to (:command cur-cmd))) - (let [cur-pos (command->point cur-cmd) - pre-pos (command->point pre-cmd)] - (cond-> [] - (= pre-pos point) (conj [index :c1]) - (= cur-pos point) (conj [index :c2]))) - []))))) - -(defn opposite-index - "Calculates the opposite index given a prefix and an index" - [content index prefix] - - (let [point (if (= prefix :c2) - (command->point (nth content index)) - (command->point (nth content (dec index)))) - - point->handlers (content->handlers content) - - handlers (->> point - (point->handlers) - (filter (fn [[ci cp]] (and (not= index ci) (not= prefix cp)))))] - - (cond - (= (count handlers) 1) - (->> handlers first) - - (and (= :c1 prefix) (= (count content) index)) - [(dec index) :c2] - - :else nil))) - - -(defn get-commands - "Returns the commands involving a point with its indices" - [content point] - (->> (d/enumerate content) - (filterv (fn [[_ cmd]] (= (command->point cmd) point))))) - - -(defn prefix->coords [prefix] - (case prefix - :c1 [:c1x :c1y] - :c2 [:c2x :c2y] - nil)) - -(defn handler->point [content index prefix] - (when (and (some? index) - (some? prefix) - (contains? content index)) - (let [[cx cy] (prefix->coords prefix)] - (if (= :curve-to (get-in content [index :command])) - (gpt/point (get-in content [index :params cx]) - (get-in content [index :params cy])) - - (gpt/point (get-in content [index :params :x]) - (get-in content [index :params :y])))))) - -(defn handler->node [content index prefix] - (if (= prefix :c1) - (command->point (get content (dec index))) - (command->point (get content index)))) - diff --git a/common/src/app/common/svg/path/legacy_parser1.cljs b/common/src/app/common/svg/path/legacy_parser1.cljs deleted file mode 100644 index 7f7dc0d813..0000000000 --- a/common/src/app/common/svg/path/legacy_parser1.cljs +++ /dev/null @@ -1,324 +0,0 @@ -;; This Source Code Form is subject to the terms of the Mozilla Public -;; License, v. 2.0. If a copy of the MPL was not distributed with this -;; file, You can obtain one at http://mozilla.org/MPL/2.0/. -;; -;; Copyright (c) KALEIDOS INC - -(ns app.common.svg.path.legacy-parser1 - "The first SVG Path parser implementation. - - Written in a mix of CLJS and JS code and used in production until - 1.19, used mainly for tests." - (:require - [app.common.data :as d] - [app.common.geom.point :as gpt] - [app.common.geom.shapes.path :as upg] - [app.common.svg :as csvg] - [app.common.svg.path.arc-to-bezier :as a2b] - [app.common.svg.path.command :as upc] - [cuerdas.core :as str])) - -(def commands-regex #"(?i)[mzlhvcsqta][^mzlhvcsqta]*") - -;; Matches numbers for path values allows values like... -.01, 10, +12.22 -;; 0 and 1 are special because can refer to flags -(def num-regex #"[+-]?(\d+(\.\d+)?|\.\d+)(e[+-]?\d+)?") - -(def flag-regex #"[01]") - -(defn extract-params [cmd-str extract-commands] - (loop [result [] - extract-idx 0 - current {} - remain (-> cmd-str (subs 1) (str/trim))] - - (let [[param type] (nth extract-commands extract-idx) - regex (case type - :flag flag-regex - #_:number num-regex) - match (re-find regex remain)] - - (if match - (let [value (-> match first csvg/fix-dot-number d/read-string) - remain (str/replace-first remain regex "") - current (assoc current param value) - extract-idx (inc extract-idx) - [result current extract-idx] - (if (>= extract-idx (count extract-commands)) - [(conj result current) {} 0] - [result current extract-idx])] - (recur result - extract-idx - current - remain)) - (cond-> result - (seq current) (conj current)))))) - -;; Path specification -;; https://www.w3.org/TR/SVG11/paths.html -(defmulti parse-command (comp str/upper first)) - -(defmethod parse-command "M" [cmd] - (let [relative (str/starts-with? cmd "m") - param-list (extract-params cmd [[:x :number] - [:y :number]])] - - (into [{:command :move-to - :relative relative - :params (first param-list)}] - - (for [params (rest param-list)] - {:command :line-to - :relative relative - :params params})))) - -(defmethod parse-command "Z" [_] - [{:command :close-path}]) - -(defmethod parse-command "L" [cmd] - (let [relative (str/starts-with? cmd "l") - param-list (extract-params cmd [[:x :number] - [:y :number]])] - (for [params param-list] - {:command :line-to - :relative relative - :params params}))) - -(defmethod parse-command "H" [cmd] - (let [relative (str/starts-with? cmd "h") - param-list (extract-params cmd [[:value :number]])] - (for [params param-list] - {:command :line-to-horizontal - :relative relative - :params params}))) - -(defmethod parse-command "V" [cmd] - (let [relative (str/starts-with? cmd "v") - param-list (extract-params cmd [[:value :number]])] - (for [params param-list] - {:command :line-to-vertical - :relative relative - :params params}))) - -(defmethod parse-command "C" [cmd] - (let [relative (str/starts-with? cmd "c") - param-list (extract-params cmd [[:c1x :number] - [:c1y :number] - [:c2x :number] - [:c2y :number] - [:x :number] - [:y :number]])] - (for [params param-list] - {:command :curve-to - :relative relative - :params params}))) - -(defmethod parse-command "S" [cmd] - (let [relative (str/starts-with? cmd "s") - param-list (extract-params cmd [[:cx :number] - [:cy :number] - [:x :number] - [:y :number]])] - (for [params param-list] - {:command :smooth-curve-to - :relative relative - :params params}))) - -(defmethod parse-command "Q" [cmd] - (let [relative (str/starts-with? cmd "q") - param-list (extract-params cmd [[:cx :number] - [:cy :number] - [:x :number] - [:y :number]])] - (for [params param-list] - {:command :quadratic-bezier-curve-to - :relative relative - :params params}))) - -(defmethod parse-command "T" [cmd] - (let [relative (str/starts-with? cmd "t") - param-list (extract-params cmd [[:x :number] - [:y :number]])] - (for [params param-list] - {:command :smooth-quadratic-bezier-curve-to - :relative relative - :params params}))) - -(defmethod parse-command "A" [cmd] - (let [relative (str/starts-with? cmd "a") - param-list (extract-params cmd [[:rx :number] - [:ry :number] - [:x-axis-rotation :number] - [:large-arc-flag :flag] - [:sweep-flag :flag] - [:x :number] - [:y :number]])] - (for [params param-list] - {:command :elliptical-arc - :relative relative - :params params}))) - -(defn smooth->curve - [{:keys [params]} pos handler] - (let [{c1x :x c1y :y} (upg/calculate-opposite-handler pos handler)] - {:c1x c1x - :c1y c1y - :c2x (:cx params) - :c2y (:cy params)})) - -(defn quadratic->curve - [sp ep cp] - (let [cp1 (-> (gpt/to-vec sp cp) - (gpt/scale (/ 2 3)) - (gpt/add sp)) - - cp2 (-> (gpt/to-vec ep cp) - (gpt/scale (/ 2 3)) - (gpt/add ep))] - - {:c1x (:x cp1) - :c1y (:y cp1) - :c2x (:x cp2) - :c2y (:y cp2)})) - -(defn arc->beziers* - [from-x from-y x y large-arc-flag sweep-flag rx ry x-axis-rotation] - (a2b/calculateBeziers from-x from-y x y large-arc-flag sweep-flag rx ry x-axis-rotation)) - -(defn arc->beziers [from-p command] - (let [to-command - (fn [[_ _ c1x c1y c2x c2y x y]] - {:command :curve-to - :relative (:relative command) - :params {:c1x c1x :c1y c1y - :c2x c2x :c2y c2y - :x x :y y}}) - - {from-x :x from-y :y} from-p - {:keys [rx ry x-axis-rotation large-arc-flag sweep-flag x y]} (:params command) - result (arc->beziers* from-x from-y x y large-arc-flag sweep-flag rx ry x-axis-rotation)] - (mapv to-command result))) - -(defn simplify-commands - "Removes some commands and convert relative to absolute coordinates" - [commands] - (let [simplify-command - ;; prev-pos : previous position for the current path. Necessary for relative commands - ;; prev-start : previous move-to necessary for Z commands - ;; prev-cc : previous command control point for cubic beziers - ;; prev-qc : previous command control point for quadratic curves - (fn [[result prev-pos prev-start prev-cc prev-qc] [command _prev]] - (let [command (assoc command :prev-pos prev-pos) - - command - (cond-> command - (:relative command) - (-> (assoc :relative false) - (d/update-in-when [:params :c1x] + (:x prev-pos)) - (d/update-in-when [:params :c1y] + (:y prev-pos)) - - (d/update-in-when [:params :c2x] + (:x prev-pos)) - (d/update-in-when [:params :c2y] + (:y prev-pos)) - - (d/update-in-when [:params :cx] + (:x prev-pos)) - (d/update-in-when [:params :cy] + (:y prev-pos)) - - (d/update-in-when [:params :x] + (:x prev-pos)) - (d/update-in-when [:params :y] + (:y prev-pos)) - - (cond-> - (= :line-to-horizontal (:command command)) - (d/update-in-when [:params :value] + (:x prev-pos)) - - (= :line-to-vertical (:command command)) - (d/update-in-when [:params :value] + (:y prev-pos))))) - - params (:params command) - orig-command command - - command - (cond-> command - (= :line-to-horizontal (:command command)) - (-> (assoc :command :line-to) - (update :params dissoc :value) - (assoc-in [:params :x] (:value params)) - (assoc-in [:params :y] (:y prev-pos))) - - (= :line-to-vertical (:command command)) - (-> (assoc :command :line-to) - (update :params dissoc :value) - (assoc-in [:params :y] (:value params)) - (assoc-in [:params :x] (:x prev-pos))) - - (= :smooth-curve-to (:command command)) - (-> (assoc :command :curve-to) - (update :params dissoc :cx :cy) - (update :params merge (smooth->curve command prev-pos prev-cc))) - - (= :quadratic-bezier-curve-to (:command command)) - (-> (assoc :command :curve-to) - (update :params dissoc :cx :cy) - (update :params merge (quadratic->curve prev-pos (gpt/point params) (gpt/point (:cx params) (:cy params))))) - - (= :smooth-quadratic-bezier-curve-to (:command command)) - (-> (assoc :command :curve-to) - (update :params merge (quadratic->curve prev-pos (gpt/point params) (upg/calculate-opposite-handler prev-pos prev-qc))))) - - result (if (= :elliptical-arc (:command command)) - (into result (arc->beziers prev-pos command)) - (conj result command)) - - next-cc (case (:command orig-command) - :smooth-curve-to - (gpt/point (get-in orig-command [:params :cx]) (get-in orig-command [:params :cy])) - - :curve-to - (gpt/point (get-in orig-command [:params :c2x]) (get-in orig-command [:params :c2y])) - - (:line-to-horizontal :line-to-vertical) - (gpt/point (get-in command [:params :x]) (get-in command [:params :y])) - - (gpt/point (get-in orig-command [:params :x]) (get-in orig-command [:params :y]))) - - next-qc (case (:command orig-command) - :quadratic-bezier-curve-to - (gpt/point (get-in orig-command [:params :cx]) (get-in orig-command [:params :cy])) - - :smooth-quadratic-bezier-curve-to - (upg/calculate-opposite-handler prev-pos prev-qc) - - (gpt/point (get-in orig-command [:params :x]) (get-in orig-command [:params :y]))) - - next-pos (if (= :close-path (:command command)) - prev-start - (upc/command->point prev-pos command)) - - next-start (if (= :move-to (:command command)) next-pos prev-start)] - - [result next-pos next-start next-cc next-qc])) - - start (first commands) - start (cond-> start - (:relative start) - (assoc :relative false)) - - start-pos (gpt/point (:params start))] - - (->> (map vector (rest commands) commands) - (reduce simplify-command [[start] start-pos start-pos start-pos start-pos]) - (first)))) - -(defn parse [path-str] - (if (empty? path-str) - path-str - (let [clean-path-str - (-> path-str - (str/trim) - ;; Change "commas" for spaces - (str/replace #"," " ") - ;; Remove all consecutive spaces - (str/replace #"\s+" " ")) - commands (re-seq commands-regex clean-path-str)] - (-> (mapcat parse-command commands) - (simplify-commands))))) - diff --git a/common/src/app/common/svg/path/legacy_parser2.cljc b/common/src/app/common/svg/path/legacy_parser2.cljc index cbd7a4999c..936950a27b 100644 --- a/common/src/app/common/svg/path/legacy_parser2.cljc +++ b/common/src/app/common/svg/path/legacy_parser2.cljc @@ -12,15 +12,23 @@ (:require [app.common.data :as d] [app.common.geom.point :as gpt] - [app.common.geom.shapes.path :as upg] [app.common.math :as mth] [app.common.svg :as csvg] - [app.common.svg.path.command :as upc] + [app.common.types.path.helpers :as path.helpers] + [app.common.types.path.segment :as path.segment] [cuerdas.core :as str])) (def commands-regex #"(?i)[mzlhvcsqta][^mzlhvcsqta]*") (def regex #"[+-]?(\d+(\.\d+)?|\.\d+)(e[+-]?\d+)?") +(defn- get-point + "Get a point for a segment" + [prev-pos {:keys [relative params] :as segment}] + (let [{:keys [x y] :or {x (:x prev-pos) y (:y prev-pos)}} params] + (if relative + (-> prev-pos (update :x + x) (update :y + y)) + (path.helpers/segment->point segment)))) + (defn extract-params [data pattern] (loop [result [] @@ -185,7 +193,7 @@ (defn smooth->curve [{:keys [params]} pos handler] - (let [{c1x :x c1y :y} (upg/calculate-opposite-handler pos handler)] + (let [{c1x :x c1y :y} (path.segment/calculate-opposite-handler pos handler)] {:c1x c1x :c1y c1y :c2x (:cx params) @@ -413,7 +421,7 @@ (= :smooth-quadratic-bezier-curve-to (:command command)) (-> (assoc :command :curve-to) - (update :params merge (quadratic->curve prev-pos (gpt/point params) (upg/calculate-opposite-handler prev-pos prev-qc))))) + (update :params merge (quadratic->curve prev-pos (gpt/point params) (path.segment/calculate-opposite-handler prev-pos prev-qc))))) result (if (= :elliptical-arc (:command command)) (into result (arc->beziers prev-pos command)) @@ -436,13 +444,13 @@ (gpt/point (get-in orig-command [:params :cx]) (get-in orig-command [:params :cy])) :smooth-quadratic-bezier-curve-to - (upg/calculate-opposite-handler prev-pos prev-qc) + (path.segment/calculate-opposite-handler prev-pos prev-qc) (gpt/point (get-in orig-command [:params :x]) (get-in orig-command [:params :y]))) next-pos (if (= :close-path (:command command)) prev-start - (upc/command->point prev-pos command)) + (get-point prev-pos command)) next-start (if (= :move-to (:command command)) next-pos prev-start)] diff --git a/common/src/app/common/svg/shapes_builder.cljc b/common/src/app/common/svg/shapes_builder.cljc index 90e0889512..aa0a49548e 100644 --- a/common/src/app/common/svg/shapes_builder.cljc +++ b/common/src/app/common/svg/shapes_builder.cljc @@ -22,6 +22,7 @@ [app.common.schema :as sm :refer [max-safe-int min-safe-int]] [app.common.svg :as csvg] [app.common.svg.path :as path] + [app.common.types.path.segment :as path.segm] [app.common.types.shape :as cts] [app.common.uuid :as uuid] [cuerdas.core :as str])) @@ -220,9 +221,9 @@ (let [transform (csvg/parse-transform (:transform attrs)) content (cond-> (path/parse (:d attrs)) (some? transform) - (gsh/transform-content transform)) + (path.segm/transform-content transform)) - selrect (gsh/content->selrect content) + selrect (path.segm/content->selrect content) points (grc/rect->points selrect) origin (gpt/negate (gpt/point svg-data)) attrs (-> (dissoc attrs :d :transform) diff --git a/common/src/app/common/types/file.cljc b/common/src/app/common/types/file.cljc index dbe637f457..55725bb69f 100644 --- a/common/src/app/common/types/file.cljc +++ b/common/src/app/common/types/file.cljc @@ -127,11 +127,11 @@ (ctp/make-empty-page {:id page-id :name "Page 1"}))] (cond-> (assoc empty-file-data :id file-id) - (some? page-id) + (some? page) (ctpl/add-page page) :always - (assoc-in [:options :components-v2] true))))) + (update :options assoc :components-v2 true))))) (defn make-file [{:keys [id project-id name revn is-shared features diff --git a/common/src/app/common/types/path.cljc b/common/src/app/common/types/path.cljc new file mode 100644 index 0000000000..bdbbd9e39a --- /dev/null +++ b/common/src/app/common/types/path.cljc @@ -0,0 +1,215 @@ +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. +;; +;; Copyright (c) KALEIDOS INC + +(ns app.common.types.path + (:require + [app.common.data :as d] + [app.common.data.macros :as dm] + [app.common.files.helpers :as cpf] + [app.common.geom.matrix :as gmt] + [app.common.geom.point :as gpt] + [app.common.geom.rect :as grc] + [app.common.geom.shapes.common :as gco] + [app.common.types.path.bool :as bool] + [app.common.types.path.helpers :as helpers] + [app.common.types.path.impl :as impl] + [app.common.types.path.segment :as segment] + [app.common.types.path.shape-to-path :as stp] + [app.common.types.path.subpath :as subpath])) + +#?(:clj (set! *warn-on-reflection* true)) + +(defn content? + [o] + (impl/path-data? o)) + +(defn content + "Create path content from plain data or bytes, returns itself if it + is already PathData instance" + [data] + (impl/path-data data)) + +(defn from-bytes + [data] + (impl/from-bytes data)) + +(defn check-path-content + [content] + (impl/check-content-like content)) + +(defn get-byte-size + "Get byte size of a path content" + [content] + (impl/-get-byte-size content)) + +(defn write-to + [content buffer offset] + (impl/-write-to content buffer offset)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; TRANSFORMATIONS +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defn close-subpaths + "Given a content, searches a path for possible subpaths that can + create closed loops and merge them; then return the transformed path + conten as PathData instance" + [content] + (-> (subpath/close-subpaths content) + (impl/from-plain))) + +(defn apply-content-modifiers + "Apply delta modifiers over the path content" + [content modifiers] + (assert (impl/check-content-like content)) + + (letfn [(apply-to-index [content [index params]] + (if (contains? content index) + (cond-> content + (and + (or (:c1x params) (:c1y params) (:c2x params) (:c2y params)) + (= :line-to (get-in content [index :command]))) + + (-> (assoc-in [index :command] :curve-to) + (assoc-in [index :params] + (helpers/make-curve-params + (get-in content [index :params]) + (get-in content [(dec index) :params])))) + + (:x params) (update-in [index :params :x] + (:x params)) + (:y params) (update-in [index :params :y] + (:y params)) + + (:c1x params) (update-in [index :params :c1x] + (:c1x params)) + (:c1y params) (update-in [index :params :c1y] + (:c1y params)) + + (:c2x params) (update-in [index :params :c2x] + (:c2x params)) + (:c2y params) (update-in [index :params :c2y] + (:c2y params))) + content))] + + (impl/path-data + (reduce apply-to-index (vec content) modifiers)))) + +(defn transform-content + "Applies a transformation matrix over content and returns a new + content as PathData instance." + [content transform] + (segment/transform-content content transform)) + +(defn move-content + [content move-vec] + (if (gpt/zero? move-vec) + content + (segment/move-content content move-vec))) + +(defn update-geometry + "Update shape with new geometry calculated from provided content" + ([shape content] + (update-geometry (assoc shape :content content))) + ([shape] + (let [flip-x + (get shape :flip-x) + + flip-y + (get shape :flip-y) + + ;; NOTE: we ensure that content is PathData instance + content + (impl/path-data + (get shape :content)) + + ;; Ensure plain format once + transform + (cond-> (:transform shape (gmt/matrix)) + flip-x (gmt/scale (gpt/point -1 1)) + flip-y (gmt/scale (gpt/point 1 -1))) + + transform-inverse + (cond-> (gmt/matrix) + flip-x (gmt/scale (gpt/point -1 1)) + flip-y (gmt/scale (gpt/point 1 -1)) + :always (gmt/multiply (:transform-inverse shape (gmt/matrix)))) + + center + (or (some-> (dm/get-prop shape :selrect) grc/rect->center) + (segment/content-center content)) + + base-content + (segment/transform-content content (gmt/transform-in center transform-inverse)) + + ;; Calculates the new selrect with points given the old center + points + (-> (segment/content->selrect base-content) + (grc/rect->points) + (gco/transform-points center transform)) + + points-center + (gco/points->center points) + + ;; Points is now the selrect but the center is different so we can create the selrect + ;; through points + selrect + (-> points + (gco/transform-points points-center transform-inverse) + (grc/points->rect))] + + (-> shape + (assoc :content content) + (assoc :points points) + (assoc :selrect selrect))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; PATH SHAPE HELPERS +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defn get-points + "Returns points for the given segment, faster version of + the `content->points`." + [content] + (some-> content segment/get-points)) + +(defn- calc-bool-content* + "Calculate the boolean content from shape and objects. Returns plain + vector of segments" + [shape objects] + (let [extract-content-xf + (comp (map (d/getf objects)) + (remove :hidden) + (remove cpf/svg-raw-shape?) + (map #(stp/convert-to-path % objects)) + (map :content)) + + contents + (sequence extract-content-xf (:shapes shape))] + + (bool/calculate-content (:bool-type shape) contents))) + +(defn calc-bool-content + "Calculate the boolean content from shape and objects. Returns a + packed PathData instance" + [shape objects] + (-> (calc-bool-content* shape objects) + (impl/path-data))) + +(defn shape-with-open-path? + [shape] + (let [svg? (contains? shape :svg-attrs) + ;; No close subpaths for svgs imported + maybe-close (if svg? identity subpath/close-subpaths)] + (and (= :path (:type shape)) + (not (->> shape + :content + (maybe-close) + (subpath/get-subpaths) + (every? subpath/is-closed?)))))) + +(defn convert-to-path + "Transform a shape to a path shape" + ([shape] + (convert-to-path shape {})) + ([shape objects] + (-> (stp/convert-to-path shape objects) + (update :content impl/path-data)))) + diff --git a/common/src/app/common/svg/path/bool.cljc b/common/src/app/common/types/path/bool.cljc similarity index 58% rename from common/src/app/common/svg/path/bool.cljc rename to common/src/app/common/types/path/bool.cljc index 40bb9cc825..3afb3242fc 100644 --- a/common/src/app/common/svg/path/bool.cljc +++ b/common/src/app/common/types/path/bool.cljc @@ -4,15 +4,42 @@ ;; ;; Copyright (c) KALEIDOS INC -(ns app.common.svg.path.bool +(ns app.common.types.path.bool (:require + [app.common.colors :as clr] [app.common.data :as d] [app.common.geom.point :as gpt] [app.common.geom.rect :as grc] - [app.common.geom.shapes.path :as gsp] [app.common.math :as mth] - [app.common.svg.path.command :as upc] - [app.common.svg.path.subpath :as ups])) + [app.common.types.path.helpers :as helpers] + [app.common.types.path.segment :as segment] + [app.common.types.path.subpath :as subpath])) + +(def default-fills + [{:fill-color clr/black}]) + +(def style-group-properties + [:shadow :blur]) + +(def style-properties + (into style-group-properties + [:fill-color + :fill-opacity + :fill-color-gradient + :fill-color-ref-file + :fill-color-ref-id + :fill-image + :fills + :stroke-color + :stroke-color-ref-file + :stroke-color-ref-id + :stroke-opacity + :stroke-style + :stroke-width + :stroke-alignment + :stroke-cap-start + :stroke-cap-end + :strokes])) (defn add-previous ([content] @@ -25,87 +52,92 @@ (assoc :prev first) (some? prev) - (assoc :prev (gsp/command->point prev)))))))) + (assoc :prev (helpers/segment->point prev)))))))) (defn close-paths "Removes the :close-path commands and replace them for line-to so we can calculate the intersections" [content] - (loop [head (first content) - content (rest content) - result [] - last-move nil - last-p nil] + (loop [segments (seq content) + result [] + last-move nil + last-point nil] + (if-let [segment (first segments)] + (let [point + (helpers/segment->point segment) - (if (nil? head) - result - (let [head-p (gsp/command->point head) - head (cond - (and (= :close-path (:command head)) - (or (nil? last-p) ;; Ignore consecutive close-paths - (< (gpt/distance last-p last-move) 0.01))) - nil + segment + (cond + (and (= :close-path (:command segment)) + (or (nil? last-point) ;; Ignore consecutive close-paths + (< (gpt/distance last-point last-move) 0.01))) + nil - (= :close-path (:command head)) - (upc/make-line-to last-move) + (= :close-path (:command segment)) + (helpers/make-line-to last-move) - :else - head)] + :else + segment)] - (recur (first content) - (rest content) - (cond-> result (some? head) (conj head)) - (if (= :move-to (:command head)) - head-p + (recur (rest segments) + (cond-> result (some? segment) (conj segment)) + (if (= :move-to (:command segment)) + point last-move) - head-p))))) + point)) + result))) (defn- split-command [cmd values] (case (:command cmd) - :line-to (gsp/split-line-to-ranges (:prev cmd) cmd values) - :curve-to (gsp/split-curve-to-ranges (:prev cmd) cmd values) + :line-to (helpers/split-line-to-ranges (:prev cmd) cmd values) + :curve-to (helpers/split-curve-to-ranges (:prev cmd) cmd values) [cmd])) -(defn split-ts [seg-1 seg-2] - (cond - (and (= :line-to (:command seg-1)) - (= :line-to (:command seg-2))) - (gsp/line-line-intersect (gsp/command->line seg-1) (gsp/command->line seg-2)) +(defn- split-ts + [seg-1 seg-2] + (let [cmd-1 (get seg-1 :command) + cmd-2 (get seg-2 :command)] + (cond + (and (= :line-to cmd-1) + (= :line-to cmd-2)) + (helpers/line-line-intersect (helpers/command->line seg-1) + (helpers/command->line seg-2)) - (and (= :line-to (:command seg-1)) - (= :curve-to (:command seg-2))) - (gsp/line-curve-intersect (gsp/command->line seg-1) (gsp/command->bezier seg-2)) + (and (= :line-to cmd-1) + (= :curve-to cmd-2)) + (helpers/line-curve-intersect (helpers/command->line seg-1) + (helpers/command->bezier seg-2)) - (and (= :curve-to (:command seg-1)) - (= :line-to (:command seg-2))) - (let [[seg-2' seg-1'] - (gsp/line-curve-intersect (gsp/command->line seg-2) (gsp/command->bezier seg-1))] - ;; Need to reverse because we send the arguments reversed - [seg-1' seg-2']) + (and (= :curve-to cmd-1) + (= :line-to cmd-2)) + (let [[seg-2' seg-1'] + (helpers/line-curve-intersect (helpers/command->line seg-2) + (helpers/command->bezier seg-1))] + ;; Need to reverse because we send the arguments reversed + [seg-1' seg-2']) - (and (= :curve-to (:command seg-1)) - (= :curve-to (:command seg-2))) - (gsp/curve-curve-intersect (gsp/command->bezier seg-1) (gsp/command->bezier seg-2)) + (and (= :curve-to cmd-1) + (= :curve-to cmd-2)) + (helpers/curve-curve-intersect (helpers/command->bezier seg-1) + (helpers/command->bezier seg-2)) - :else - [[] []])) + :else + [[] []]))) (defn content-intersect-split [content-a content-b sr-a sr-b] - (let [command->selrect (memoize gsp/command->selrect)] + (let [command->selrect (memoize helpers/command->selrect)] - (letfn [(overlap-segment-selrect? - [segment selrect] + (letfn [(overlap-segment-selrect? [segment selrect] (if (= :move-to (:command segment)) false (let [r1 (command->selrect segment)] (grc/overlaps-rects? r1 selrect)))) - (overlap-segments? - [seg-1 seg-2] + (overlap-segments? [seg-1 seg-2] (if (or (= :move-to (:command seg-1)) (= :move-to (:command seg-2))) false @@ -113,17 +145,14 @@ r2 (command->selrect seg-2)] (grc/overlaps-rects? r1 r2)))) - (split - [seg-1 seg-2] + (split [seg-1 seg-2] (if (not (overlap-segments? seg-1 seg-2)) [seg-1] (let [[ts-seg-1 _] (split-ts seg-1 seg-2)] (-> (split-command seg-1 ts-seg-1) (add-previous (:prev seg-1)))))) - (split-segment-on-content - [segment content content-sr] - + (split-segment-on-content [segment content content-sr] (if (overlap-segment-selrect? segment content-sr) (->> content (filter #(overlap-segments? segment %)) @@ -133,8 +162,7 @@ [segment])) [segment])) - (split-content - [content-a content-b sr-b] + (split-content [content-a content-b sr-b] (into [] (mapcat #(split-segment-on-content % content-b sr-b)) content-a))] @@ -151,28 +179,28 @@ [segment content content-sr content-geom] (let [point (case (:command segment) - :line-to (-> (gsp/command->line segment) - (gsp/line-values 0.5)) + :line-to (-> (helpers/command->line segment) + (helpers/line-values 0.5)) - :curve-to (-> (gsp/command->bezier segment) - (gsp/curve-values 0.5)))] + :curve-to (-> (helpers/command->bezier segment) + (helpers/curve-values 0.5)))] (and (grc/contains-point? content-sr point) (or - (gsp/is-point-in-geom-data? point content-geom) - (gsp/is-point-in-border? point content))))) + (helpers/is-point-in-geom-data? point content-geom) + (helpers/is-point-in-border? point content))))) (defn inside-segment? [segment content-sr content-geom] (let [point (case (:command segment) - :line-to (-> (gsp/command->line segment) - (gsp/line-values 0.5)) + :line-to (-> (helpers/command->line segment) + (helpers/line-values 0.5)) - :curve-to (-> (gsp/command->bezier segment) - (gsp/curve-values 0.5)))] + :curve-to (-> (helpers/command->bezier segment) + (helpers/curve-values 0.5)))] (and (grc/contains-point? content-sr point) - (gsp/is-point-in-geom-data? point content-geom)))) + (helpers/is-point-in-geom-data? point content-geom)))) (defn overlap-segment? "Finds if the current segment is overlapping against other @@ -185,8 +213,8 @@ (contains? #{:line-to :curve-to} (:command segment))) (case (:command segment) - :line-to (let [[p1 q1] (gsp/command->line segment) - [p2 q2] (gsp/command->line other)] + :line-to (let [[p1 q1] (helpers/command->line segment) + [p2 q2] (helpers/command->line other)] (when (or (and (< (gpt/distance p1 p2) 0.1) (< (gpt/distance q1 q2) 0.1)) @@ -194,8 +222,8 @@ (< (gpt/distance q1 p2) 0.1))) [segment other])) - :curve-to (let [[p1 q1 h11 h21] (gsp/command->bezier segment) - [p2 q2 h12 h22] (gsp/command->bezier other)] + :curve-to (let [[p1 q1 h11 h21] (helpers/command->bezier segment) + [p2 q2 h12 h22] (helpers/command->bezier other)] (when (or (and (< (gpt/distance p1 p2) 0.1) (< (gpt/distance q1 q2) 0.1) @@ -227,11 +255,11 @@ result (let [result (if (not= (:prev current) prev) - (conj result (upc/make-move-to (:prev current))) + (conj result (helpers/make-move-to (:prev current))) result)] (recur (first content) (rest content) - (gsp/command->point current) + (helpers/segment->point current) (conj result (dissoc current :prev))))))) (defn remove-duplicated-segments @@ -273,20 +301,43 @@ segments result)))))) +(defn close-content + [content] + (into [] + (mapcat :data) + (->> content + (subpath/close-subpaths) + (subpath/get-subpaths)))) + +(defn- content->geom-data + [content] + + (->> content + (close-content) + (filter #(not= (= :line-to (:command %)) + (= :curve-to (:command %)))) + (mapv (fn [segment] + {:command (:command segment) + :segment segment + :geom (if (= :line-to (:command segment)) + (helpers/command->line segment) + (helpers/command->bezier segment)) + :selrect (helpers/command->selrect segment)})))) + (defn create-union [content-a content-a-split content-b content-b-split sr-a sr-b] ;; Pick all segments in content-a that are not inside content-b ;; Pick all segments in content-b that are not inside content-a - (let [content-a-geom (gsp/content->geom-data content-a) - content-b-geom (gsp/content->geom-data content-b) + (let [content-a-geom (content->geom-data content-a) + content-b-geom (content->geom-data content-b) content (concat (->> content-a-split (filter #(not (contains-segment? % content-b sr-b content-b-geom)))) (->> content-b-split (filter #(not (contains-segment? % content-a sr-a content-a-geom))))) - content-geom (gsp/content->geom-data content) + content-geom (content->geom-data content) - content-sr (gsp/content->selrect (fix-move-to content)) + content-sr (segment/content->selrect (fix-move-to content)) ;; Overlapping segments should be added when they are part of the border border-content @@ -302,8 +353,8 @@ ;; Pick all segments in content-a that are not inside content-b ;; Pick all segments in content b that are inside content-a ;; removing overlapping - (let [content-a-geom (gsp/content->geom-data content-a) - content-b-geom (gsp/content->geom-data content-b)] + (let [content-a-geom (content->geom-data content-a) + content-b-geom (content->geom-data content-b)] (d/concat-vec (->> content-a-split (filter #(not (contains-segment? % content-b sr-b content-b-geom)))) @@ -315,13 +366,12 @@ (defn create-intersection [content-a content-a-split content-b content-b-split sr-a sr-b] ;; Pick all segments in content-a that are inside content-b ;; Pick all segments in content-b that are inside content-a - (let [content-a-geom (gsp/content->geom-data content-a) - content-b-geom (gsp/content->geom-data content-b)] + (let [content-a-geom (content->geom-data content-a) + content-b-geom (content->geom-data content-b)] (d/concat-vec (->> content-a-split (filter #(contains-segment? % content-b sr-b content-b-geom))) (->> content-b-split (filter #(contains-segment? % content-a sr-a content-a-geom)))))) - (defn create-exclusion [content-a content-b] ;; Pick all segments (d/concat-vec content-a content-b)) @@ -331,26 +381,37 @@ (let [;; We need to reverse the second path when making a difference/intersection/exclude ;; and both shapes are in the same direction - should-reverse? (and (not= :union bool-type) - (= (ups/clockwise? content-b) - (ups/clockwise? content-a))) + should-reverse? + (and (not= :union bool-type) + (= (subpath/clockwise? content-b) + (subpath/clockwise? content-a))) - content-a (-> content-a - (close-paths) - (add-previous)) + content-a + (-> content-a + (close-paths) + (add-previous)) - content-b (-> content-b - (close-paths) - (cond-> should-reverse? (ups/reverse-content)) - (add-previous)) + content-b + (-> content-b + (close-paths) + (cond-> should-reverse? (subpath/reverse-content)) + (add-previous)) - sr-a (gsp/content->selrect content-a) - sr-b (gsp/content->selrect content-b) + sr-a + (segment/content->selrect content-a) + + sr-b + (segment/content->selrect content-b) ;; Split content in new segments in the intersection with the other path - [content-a-split content-b-split] (content-intersect-split content-a content-b sr-a sr-b) - content-a-split (->> content-a-split add-previous (filter is-segment?)) - content-b-split (->> content-b-split add-previous (filter is-segment?)) + [content-a-split content-b-split] + (content-intersect-split content-a content-b sr-a sr-b) + + content-a-split + (->> content-a-split add-previous (filter is-segment?)) + + content-b-split + (->> content-b-split add-previous (filter is-segment?)) content (case bool-type @@ -362,14 +423,16 @@ (-> content remove-duplicated-segments fix-move-to - ups/close-subpaths))) + subpath/close-subpaths))) -(defn content-bool +(defn calculate-content + "Create a bool content from a collection of contents and specified + type." [bool-type contents] ;; We apply the boolean operation in to each pair and the result to the next ;; element (if (seq contents) (->> contents (reduce (partial content-bool-pair bool-type)) - (into [])) + (vec)) [])) diff --git a/common/src/app/common/geom/shapes/path.cljc b/common/src/app/common/types/path/helpers.cljc similarity index 53% rename from common/src/app/common/geom/shapes/path.cljc rename to common/src/app/common/types/path/helpers.cljc index a7e56f3d2a..5ec125a0d4 100644 --- a/common/src/app/common/geom/shapes/path.cljc +++ b/common/src/app/common/types/path/helpers.cljc @@ -4,17 +4,20 @@ ;; ;; Copyright (c) KALEIDOS INC -(ns app.common.geom.shapes.path +(ns app.common.types.path.helpers + "A collection of path internal helpers that does not depend on other + path related namespaces. + + This NS allows separate context-less/dependency-less helpers from + other path related namespaces and make proper domain-specific + namespaces without incurrying on circular depedency cycles." (: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.math :as mth] - [app.common.svg.path.command :as upc] - [app.common.svg.path.subpath :as sp])) + [app.common.math :as mth])) (def ^:const curve-curve-precision 0.1) (def ^:const curve-range-precision 2) @@ -22,39 +25,127 @@ (defn s= [a b] (mth/almost-zero? (- a b))) -(defn calculate-opposite-handler - "Given a point and its handler, gives the symmetric handler" - [point handler] - (let [handler-vector (gpt/to-vec point handler)] - (gpt/add point (gpt/negate handler-vector)))) +(defn make-move-to [to] + {:command :move-to + :relative false + :params {:x (:x to) + :y (:y to)}}) -(defn opposite-handler - "Calculates the coordinates of the opposite handler" - [point handler] - (let [phv (gpt/to-vec point handler)] - (gpt/add point (gpt/negate phv)))) +(defn make-line-to [to] + {:command :line-to + :relative false + :params {:x (:x to) + :y (:y to)}}) -(defn opposite-handler-keep-distance - "Calculates the coordinates of the opposite handler but keeping the old distance" - [point handler old-opposite] - (let [old-distance (gpt/distance point old-opposite) - phv (gpt/to-vec point handler) - phv2 (gpt/multiply - (gpt/unit (gpt/negate phv)) - (gpt/point old-distance))] - (gpt/add point phv2))) +(defn make-curve-params + ([point] + (make-curve-params point point point)) + ([point handler] + (make-curve-params point handler point)) + ([point h1 h2] + {:x (:x point) + :y (:y point) + :c1x (:x h1) + :c1y (:y h1) + :c2x (:x h2) + :c2y (:y h2)})) -(defn content->points - "Returns the points in the given content" - [content] - (letfn [(segment->point [seg] - (let [params (get seg :params) - x (get params :x) - y (get params :y)] - (when (d/num? x y) - (gpt/point x y))))] - (some->> (seq content) - (into [] (keep segment->point))))) +(defn update-curve-to + [command h1 h2] + (let [params {:x (-> command :params :x) + :y (-> command :params :y) + :c1x (:x h1) + :c1y (:y h1) + :c2x (:x h2) + :c2y (:y h2)}] + (-> command + (assoc :command :curve-to) + (assoc :params params)))) + +(defn make-curve-to + [to h1 h2] + {:command :curve-to + :relative false + :params (make-curve-params to h1 h2)}) + +(defn prefix->coords [prefix] + (case prefix + :c1 [:c1x :c1y] + :c2 [:c2x :c2y] + nil)) + +(defn- closest-angle + [angle] + (cond + (or (> angle 337.5) (<= angle 22.5)) 0 + (and (> angle 22.5) (<= angle 67.5)) 45 + (and (> angle 67.5) (<= angle 112.5)) 90 + (and (> angle 112.5) (<= angle 157.5)) 135 + (and (> angle 157.5) (<= angle 202.5)) 180 + (and (> angle 202.5) (<= angle 247.5)) 225 + (and (> angle 247.5) (<= angle 292.5)) 270 + (and (> angle 292.5) (<= angle 337.5)) 315)) + +(defn position-fixed-angle + [point from-point] + (if (and from-point point) + (let [angle (mod (+ 360 (- (gpt/angle point from-point))) 360) + to-angle (closest-angle angle) + distance (gpt/distance point from-point)] + (gpt/angle->point from-point (mth/radians to-angle) distance)) + point)) + +(defn segment->point + ([segment] (segment->point segment :x)) + ([segment coord] + (let [params (get segment :params)] + (case coord + :c1 (gpt/point (get params :c1x) + (get params :c1y)) + :c2 (gpt/point (get params :c2x) + (get params :c2y)) + (gpt/point (get params :x) + (get params :y)))))) + +(defn command->line + ([segment] + (command->line segment (:prev segment))) + ([segment prev] + [prev (segment->point segment)])) + +(defn command->bezier + ([segment] + (command->bezier segment (:prev segment))) + ([segment prev] + [prev + (segment->point segment) + (gpt/point (-> segment :params :c1x) (-> segment :params :c1y)) + (gpt/point (-> segment :params :c2x) (-> segment :params :c2y))])) + +(declare curve-extremities) +(declare curve-values) + +(defn command->selrect + ([command] + (command->selrect command (:prev command))) + + ([command prev-point] + (let [points (case (:command command) + :move-to [(segment->point command)] + + ;; If it's a line we add the beginning point and endpoint + :line-to [prev-point (segment->point command)] + + ;; We return the bezier extremities + :curve-to (into [prev-point (segment->point command)] + (let [curve [prev-point + (segment->point command) + (segment->point command :c1) + (segment->point command :c2)]] + (->> (curve-extremities curve) + (mapv #(curve-values curve %))))) + [])] + (grc/points->rect points)))) (defn line-values [[from-p to-p] t] @@ -101,6 +192,168 @@ (gpt/point (coord-v :x) (coord-v :y))))) +(defn solve-roots* + "Solvers a quadratic or cubic equation given by the parameters a b c d. + + Implemented as reduction algorithm (this helps implemement + derivative algorithms that does not require intermediate results + thanks to transducers." + [result conj a b c d] + (let [sqrt-b2-4ac (mth/sqrt (- (* b b) (* 4 a c)))] + (cond + ;; No solutions + (and ^boolean (mth/almost-zero? d) + ^boolean (mth/almost-zero? a) + ^boolean (mth/almost-zero? b)) + result + + ;; Linear solution + (and ^boolean (mth/almost-zero? d) + ^boolean (mth/almost-zero? a)) + (conj result (/ (- c) b)) + + ;; Quadratic + ^boolean + (mth/almost-zero? d) + (-> result + (conj (/ (+ (- b) sqrt-b2-4ac) + (* 2 a))) + (conj (/ (- (- b) sqrt-b2-4ac) + (* 2 a)))) + + ;; Cubic + :else + (let [a (/ a d) + b (/ b d) + c (/ c d) + + p (/ (- (* 3 b) (* a a)) 3) + q (/ (+ (* 2 a a a) (* -9 a b) (* 27 c)) 27) + + p3 (/ p 3) + q2 (/ q 2) + discriminant (+ (* q2 q2) (* p3 p3 p3))] + + (cond + (< discriminant 0) + (let [mp3 (/ (- p) 3) + mp33 (* mp3 mp3 mp3) + r (mth/sqrt mp33) + t (/ (- q) (* 2 r)) + cosphi (cond (< t -1) -1 + (> t 1) 1 + :else t) + phi (mth/acos cosphi) + crtr (mth/cubicroot r) + t1 (* 2 crtr) + root1 (- (* t1 (mth/cos (/ phi 3))) (/ a 3)) + root2 (- (* t1 (mth/cos (/ (+ phi (* 2 mth/PI)) 3))) (/ a 3)) + root3 (- (* t1 (mth/cos (/ (+ phi (* 4 mth/PI)) 3))) (/ a 3))] + + (-> result + (conj root1) + (conj root2) + (conj root3))) + + ^boolean + (mth/almost-zero? discriminant) + (let [u1 (if (< q2 0) (mth/cubicroot (- q2)) (- (mth/cubicroot q2))) + root1 (- (* 2 u1) (/ a 3)) + root2 (- (- u1) (/ a 3))] + (-> result + (conj root1) + (conj root2))) + + :else + (let [sd (mth/sqrt discriminant) + u1 (mth/cubicroot (- sd q2)) + v1 (mth/cubicroot (+ sd q2)) + root (- u1 v1 (/ a 3))] + (conj result root))))))) + + + + + +;; https://trans4mind.com/personal_development/mathematics/polynomials/cubicAlgebra.htm +(defn- solve-roots + "Solvers a quadratic or cubic equation given by the parameters a b c d" + ([a b c] (solve-roots a b c 0)) + ([a b c d] (solve-roots* [] conj a b c d))) + +;; https://pomax.github.io/bezierinfo/#extremities +(defn curve-extremities + "Calculates the extremities by solving the first derivative for a cubic + bezier and then solving the quadratic formula" + ([[start end h1 h2]] + (curve-extremities start end h1 h2)) + + ([start end h1 h2] + + (let [coords [[(:x start) (:x h1) (:x h2) (:x end)] + [(:y start) (:y h1) (:y h2) (:y end)]] + + coord->tvalue + (fn [[c0 c1 c2 c3]] + (let [a (+ (* -3 c0) (* 9 c1) (* -9 c2) (* 3 c3)) + b (+ (* 6 c0) (* -12 c1) (* 6 c2)) + c (+ (* 3 c1) (* -3 c0))] + + (solve-roots a b c)))] + (->> coords + (mapcat coord->tvalue) + + ;; Only values in the range [0, 1] are valid + (filterv #(and (> % 0.01) (< % 0.99))))))) + +(defn calculate-curve-extremities + "Calculates the extremities by solving the first derivative for a + cubic bezier and then solving the quadratic formula" + [start end h1 h2] + (let [start-x (dm/get-prop start :x) + h1-x (dm/get-prop h1 :x) + h2-x (dm/get-prop h2 :x) + end-x (dm/get-prop end :x) + start-y (dm/get-prop start :y) + h1-y (dm/get-prop h1 :y) + h2-y (dm/get-prop h2 :y) + end-y (dm/get-prop end :y) + + xform + (comp + (filter #(and (> % 0.01) (< % 0.99))) + (map (fn [t] + (let [t2 (* t t) ;; t square + t3 (* t2 t) ;; t cube + start-v (+ (- t3) (* 3 t2) (* -3 t) 1) + h1-v (+ (* 3 t3) (* -6 t2) (* 3 t)) + h2-v (+ (* -3 t3) (* 3 t2)) + end-v t3] + (gpt/point + (+ (* start-x start-v) + (* h1-x h1-v) + (* h2-x h2-v) + (* end-x end-v)) + (+ (* start-y start-v) + (* h1-y h1-v) + (* h2-y h2-v) + (* end-y end-v))))))) + + conj* + (xform conj!) + + process-curve + (fn [result c0 c1 c2 c3] + (let [a (+ (* -3 c0) (* 9 c1) (* -9 c2) (* 3 c3)) + b (+ (* 6 c0) (* -12 c1) (* 6 c2)) + c (+ (* 3 c1) (* -3 c0))] + (solve-roots* result conj* a b c 0)))] + + (-> (transient []) + (process-curve start-x h1-x h2-x end-x) + (process-curve start-y h1-y h2-y end-y) + (persistent!)))) + (defn curve-tangent "Retrieve the tangent vector to the curve in the point `t`" [[start end h1 h2] t] @@ -136,323 +389,7 @@ (< (:y tangent) 0) 1 :else 0))) -(defn curve-split - "Splits a curve into two at the given parametric value `t`. - Calculates the Casteljau's algorithm intermediate points" - ([[start end h1 h2] t] - (curve-split start end h1 h2 t)) - - ([start end h1 h2 t] - (let [p1 (gpt/lerp start h1 t) - p2 (gpt/lerp h1 h2 t) - p3 (gpt/lerp h2 end t) - p4 (gpt/lerp p1 p2 t) - p5 (gpt/lerp p2 p3 t) - sp (gpt/lerp p4 p5 t)] - [[start sp p1 p4] - [sp end p5 p3]]))) - -(defn subcurve-range - "Given a curve returns a new curve between the values t1-t2" - ([[start end h1 h2] [t1 t2]] - (subcurve-range start end h1 h2 t1 t2)) - - ([[start end h1 h2] t1 t2] - (subcurve-range start end h1 h2 t1 t2)) - - ([start end h1 h2 t1 t2] - ;; Make sure that t2 is greater than t1 - (let [[t1 t2] (if (< t1 t2) [t1 t2] [t2 t1]) - t2' (/ (- t2 t1) (- 1 t1)) - [_ curve'] (curve-split start end h1 h2 t1)] - (first (curve-split curve' t2'))))) - - -;; https://trans4mind.com/personal_development/mathematics/polynomials/cubicAlgebra.htm -(defn- solve-roots - "Solvers a quadratic or cubic equation given by the parameters a b c d" - ([a b c] - (solve-roots a b c 0)) - - ([a b c d] - (let [sqrt-b2-4ac (mth/sqrt (- (* b b) (* 4 a c)))] - (cond - ;; No solutions - (and (mth/almost-zero? d) (mth/almost-zero? a) (mth/almost-zero? b)) - [] - - ;; Linear solution - (and (mth/almost-zero? d) (mth/almost-zero? a)) - [(/ (- c) b)] - - ;; Quadratic - (mth/almost-zero? d) - [(/ (+ (- b) sqrt-b2-4ac) - (* 2 a)) - (/ (- (- b) sqrt-b2-4ac) - (* 2 a))] - - ;; Cubic - :else - (let [a (/ a d) - b (/ b d) - c (/ c d) - - p (/ (- (* 3 b) (* a a)) 3) - q (/ (+ (* 2 a a a) (* -9 a b) (* 27 c)) 27) - - p3 (/ p 3) - q2 (/ q 2) - discriminant (+ (* q2 q2) (* p3 p3 p3))] - - (cond - (< discriminant 0) - (let [mp3 (/ (- p) 3) - mp33 (* mp3 mp3 mp3) - r (mth/sqrt mp33) - t (/ (- q) (* 2 r)) - cosphi (cond (< t -1) -1 - (> t 1) 1 - :else t) - phi (mth/acos cosphi) - crtr (mth/cubicroot r) - t1 (* 2 crtr) - root1 (- (* t1 (mth/cos (/ phi 3))) (/ a 3)) - root2 (- (* t1 (mth/cos (/ (+ phi (* 2 mth/PI)) 3))) (/ a 3)) - root3 (- (* t1 (mth/cos (/ (+ phi (* 4 mth/PI)) 3))) (/ a 3))] - - [root1 root2 root3]) - - (mth/almost-zero? discriminant) - (let [u1 (if (< q2 0) (mth/cubicroot (- q2)) (- (mth/cubicroot q2))) - root1 (- (* 2 u1) (/ a 3)) - root2 (- (- u1) (/ a 3))] - [root1 root2]) - - :else - (let [sd (mth/sqrt discriminant) - u1 (mth/cubicroot (- sd q2)) - v1 (mth/cubicroot (+ sd q2)) - root (- u1 v1 (/ a 3))] - [root]))))))) - -;; https://pomax.github.io/bezierinfo/#extremities -(defn curve-extremities - "Calculates the extremities by solving the first derivative for a cubic - bezier and then solving the quadratic formula" - ([[start end h1 h2]] - (curve-extremities start end h1 h2)) - - ([start end h1 h2] - - (let [coords [[(:x start) (:x h1) (:x h2) (:x end)] - [(:y start) (:y h1) (:y h2) (:y end)]] - - coord->tvalue - (fn [[c0 c1 c2 c3]] - (let [a (+ (* -3 c0) (* 9 c1) (* -9 c2) (* 3 c3)) - b (+ (* 6 c0) (* -12 c1) (* 6 c2)) - c (+ (* 3 c1) (* -3 c0))] - - (solve-roots a b c)))] - (->> coords - (mapcat coord->tvalue) - - ;; Only values in the range [0, 1] are valid - (filterv #(and (> % 0.01) (< % 0.99))))))) - -(defn curve-roots - "Uses cardano algorithm to find the roots for a cubic bezier" - ([[start end h1 h2] coord] - (curve-roots start end h1 h2 coord)) - - ([start end h1 h2 coord] - - (let [coords [[(get start coord) (get h1 coord) (get h2 coord) (get end coord)]] - - coord->tvalue - (fn [[pa pb pc pd]] - - (let [a (+ (* 3 pa) (* -6 pb) (* 3 pc)) - b (+ (* -3 pa) (* 3 pb)) - c pa - d (+ (- pa) (* 3 pb) (* -3 pc) pd)] - - (solve-roots a b c d)))] - (->> coords - (mapcat coord->tvalue) - ;; Only values in the range [0, 1] are valid - (filterv #(and (>= % 0) (<= % 1))))))) - -(defn command->point - ([command] - (command->point command nil)) - - ([command coord] - (let [params (:params command) - xkey (case coord - :c1 :c1x - :c2 :c2x - :x) - ykey (case coord - :c1 :c1y - :c2 :c2y - :y) - x (get params xkey) - y (get params ykey)] - (when (and (some? x) (some? y)) - (gpt/point x y))))) - -(defn command->line - ([cmd] - (command->line cmd (:prev cmd))) - ([cmd prev] - [prev (command->point cmd)])) - -(defn command->bezier - ([cmd] - (command->bezier cmd (:prev cmd))) - ([cmd prev] - [prev - (command->point cmd) - (gpt/point (-> cmd :params :c1x) (-> cmd :params :c1y)) - (gpt/point (-> cmd :params :c2x) (-> cmd :params :c2y))])) - -(defn command->selrect - ([command] - (command->selrect command (:prev command))) - - ([command prev-point] - (let [points (case (:command command) - :move-to [(command->point command)] - - ;; If it's a line we add the beginning point and endpoint - :line-to [prev-point (command->point command)] - - ;; We return the bezier extremities - :curve-to (into [prev-point (command->point command)] - (let [curve [prev-point - (command->point command) - (command->point command :c1) - (command->point command :c2)]] - (->> (curve-extremities curve) - (mapv #(curve-values curve %))))) - [])] - (grc/points->rect points)))) - -(defn content->selrect [content] - (let [extremities - (loop [points #{} - from-p nil - move-p nil - content (seq content)] - (if content - (let [last-p (last content) - content (if (= :move-to (:command last-p)) - (butlast content) - content) - command (first content) - to-p (command->point command) - - [from-p move-p command-pts] - (case (:command command) - :move-to [to-p to-p (when to-p [to-p])] - :close-path [move-p move-p (when move-p [move-p])] - :line-to [to-p move-p (when (and from-p to-p) [from-p to-p])] - :curve-to [to-p move-p - (let [c1 (command->point command :c1) - c2 (command->point command :c2) - curve [from-p to-p c1 c2]] - (when (and from-p to-p c1 c2) - (into [from-p to-p] - (->> (curve-extremities curve) - (map #(curve-values curve %))))))] - [to-p move-p []])] - - (recur (apply conj points command-pts) from-p move-p (next content))) - points)) - - ;; We haven't found any extremes so we turn the commands to points - extremities - (if (empty? extremities) - (->> content (keep command->point)) - extremities)] - - ;; If no points are returned we return an empty rect. - (if (d/not-empty? extremities) - (grc/points->rect extremities) - (grc/make-rect)))) - -(defn move-content [content move-vec] - (let [dx (:x move-vec) - dy (:y move-vec) - - set-tr - (fn [params px py] - (cond-> params - (d/num? dx) - (update px + dx) - - (d/num? dy) - (update py + dy))) - - transform-params - (fn [{:keys [x y c1x c1y c2x c2y] :as params}] - (cond-> params - (d/num? x y) (set-tr :x :y) - (d/num? c1x c1y) (set-tr :c1x :c1y) - (d/num? c2x c2y) (set-tr :c2x :c2y))) - - update-command - (fn [command] - (update command :params transform-params))] - - (->> content - (into [] (map update-command))))) - -(defn transform-content - [content transform] - (if (some? transform) - (let [set-tr - (fn [params px py] - (let [tr-point (-> (gpt/point (get params px) (get params py)) - (gpt/transform transform))] - (assoc params - px (:x tr-point) - py (:y tr-point)))) - - transform-params - (fn [{:keys [x c1x c2x] :as params}] - (cond-> params - (some? x) (set-tr :x :y) - (some? c1x) (set-tr :c1x :c1y) - (some? c2x) (set-tr :c2x :c2y)))] - - (into [] - (map #(update % :params transform-params)) - content)) - content)) - -(defn segments->content - ([segments] - (segments->content segments false)) - - ([segments closed?] - (let [initial (first segments) - lines (rest segments)] - - (d/concat-vec - [{:command :move-to - :params (select-keys initial [:x :y])}] - - (->> lines - (map #(hash-map :command :line-to - :params (select-keys % [:x :y])))) - - (when closed? - [{:command :close-path}]))))) - -(defonce num-segments 10) +(def ^:private ^:const num-segments 10) (defn curve->lines "Transform the bezier curve given by the parameters into a series of straight lines @@ -471,127 +408,97 @@ result (recur to result)))))) -(defn path->lines - "Given a path returns a list of lines that approximate the path" - [shape] - (loop [command (first (:content shape)) - pending (rest (:content shape)) - result [] - last-start nil - prev-point nil] +(defn curve-split + "Splits a curve into two at the given parametric value `t`. + Calculates the Casteljau's algorithm intermediate points" + ([[start end h1 h2] t] + (curve-split start end h1 h2 t)) - (if-let [{:keys [command params]} command] - (let [point (if (= :close-path command) - last-start - (gpt/point params)) + ([start end h1 h2 t] + (let [p1 (gpt/lerp start h1 t) + p2 (gpt/lerp h1 h2 t) + p3 (gpt/lerp h2 end t) + p4 (gpt/lerp p1 p2 t) + p5 (gpt/lerp p2 p3 t) + sp (gpt/lerp p4 p5 t)] + [[start sp p1 p4] + [sp end p5 p3]]))) - result (case command - :line-to (conj result [prev-point point]) - :curve-to (let [h1 (gpt/point (:c1x params) (:c1y params)) - h2 (gpt/point (:c2x params) (:c2y params))] - (into result (curve->lines prev-point point h1 h2))) - :move-to (cond-> result - last-start (conj [prev-point last-start])) - result) - last-start (if (= :move-to command) - point - last-start)] - (recur (first pending) - (rest pending) - result - last-start - point)) +(defn split-line-to + "Given a point and a line-to command will create a two new line-to commands + that will split the original line into two given a value between 0-1" + [from-p segment t-val] + (let [to-p (segment->point segment) + sp (gpt/lerp from-p to-p t-val)] + [(make-line-to sp) segment])) - (conj result [prev-point last-start])))) +(defn split-curve-to + "Given the point and a curve-to command will split the curve into two new + curve-to commands given a value between 0-1" + [from-p segment t-val] + (let [params (:params segment) + end (gpt/point (:x params) (:y params)) + h1 (gpt/point (:c1x params) (:c1y params)) + h2 (gpt/point (:c2x params) (:c2y params)) + [[_ to1 h11 h21] + [_ to2 h12 h22]] (curve-split from-p end h1 h2 t-val)] + [(make-curve-to to1 h11 h21) + (make-curve-to to2 h12 h22)])) -(defonce path-closest-point-accuracy 0.01) -(defn curve-closest-point - [position start end h1 h2] - (let [d (memoize (fn [t] (gpt/distance position (curve-values start end h1 h2 t))))] - (loop [t1 0 - t2 1] - (if (<= (mth/abs (- t1 t2)) path-closest-point-accuracy) - (-> (curve-values start end h1 h2 t1) - ;; store the segment info - (with-meta {:t t1 :from-p start :to-p end})) +(defn subcurve-range + "Given a curve returns a new curve between the values t1-t2" + ([[start end h1 h2] [t1 t2]] + (subcurve-range start end h1 h2 t1 t2)) - (let [ht (+ t1 (/ (- t2 t1) 2)) - ht1 (+ t1 (/ (- t2 t1) 4)) - ht2 (+ t1 (/ (* 3 (- t2 t1)) 4)) + ([[start end h1 h2] t1 t2] + (subcurve-range start end h1 h2 t1 t2)) - [t1 t2] (cond - (< (d ht1) (d ht2)) - [t1 ht] + ([start end h1 h2 t1 t2] + ;; Make sure that t2 is greater than t1 + (let [[t1 t2] (if (< t1 t2) [t1 t2] [t2 t1]) + t2' (/ (- t2 t1) (- 1 t1)) + [_ curve'] (curve-split start end h1 h2 t1)] + (first (curve-split curve' t2'))))) - (< (d ht2) (d ht1)) - [ht t2] +(defn split-line-to-ranges + "Splits a line into several lines given the points in `values` + for example (split-line-to-ranges p c [0 0.25 0.5 0.75 1] will split + the line into 4 lines" + [from-p segment values] + (let [values (->> values (filter #(and (> % 0) (< % 1))))] + (if (empty? values) + [segment] + (let [to-p (segment->point segment) + values-set (->> (conj values 1) (into (sorted-set)))] + (->> values-set + (mapv (fn [val] + (-> (gpt/lerp from-p to-p val) + #_(gpt/round 2) + (make-line-to))))))))) - (and (< (d ht) (d t1)) (< (d ht) (d t2))) - [ht1 ht2] +(defn split-curve-to-ranges + "Splits a curve into several curves given the points in `values` + for example (split-curve-to-ranges p c [0 0.25 0.5 0.75 1] will split + the curve into 4 curves that draw the same curve" + [from-p segment values] - (< (d t1) (d t2)) - [t1 ht] + (let [values (->> values (filter #(and (> % 0) (< % 1))))] + (if (empty? values) + [segment] + (let [to-p (segment->point segment) + params (:params segment) + h1 (gpt/point (:c1x params) (:c1y params)) + h2 (gpt/point (:c2x params) (:c2y params)) - :else - [ht t2])] - (recur t1 t2)))))) + values-set (->> (conj values 0 1) (into (sorted-set)))] -(defn line-closest-point - "Point on line" - [position from-p to-p] + (->> (d/with-prev values-set) + (rest) + (mapv + (fn [[t1 t0]] + (let [[_ to-p h1' h2'] (subcurve-range from-p to-p h1 h2 t0 t1)] + (make-curve-to (-> to-p #_(gpt/round 2)) h1' h2'))))))))) - (let [e1 (gpt/to-vec from-p to-p) - e2 (gpt/to-vec from-p position) - - len2 (+ (mth/sq (:x e1)) (mth/sq (:y e1))) - t (/ (gpt/dot e1 e2) len2)] - - (if (and (>= t 0) (<= t 1) (not (mth/almost-zero? len2))) - (-> (gpt/add from-p (gpt/scale e1 t)) - (with-meta {:t t - :from-p from-p - :to-p to-p})) - - ;; There is no perpendicular projection in the line so the closest - ;; point will be one of the extremes - (if (<= (gpt/distance position from-p) (gpt/distance position to-p)) - from-p - to-p)))) - -(defn path-closest-point - "Given a path and a position" - [shape position] - - (let [point+distance - (fn [[cur-cmd prev-cmd]] - (let [from-p (command->point prev-cmd) - to-p (command->point cur-cmd) - h1 (gpt/point (get-in cur-cmd [:params :c1x]) - (get-in cur-cmd [:params :c1y])) - h2 (gpt/point (get-in cur-cmd [:params :c2x]) - (get-in cur-cmd [:params :c2y])) - point - (case (:command cur-cmd) - :line-to - (line-closest-point position from-p to-p) - - :curve-to - (curve-closest-point position from-p to-p h1 h2) - - nil)] - (when point - [point (gpt/distance point position)]))) - - find-min-point (fn [[min-p min-dist :as acc] [cur-p cur-dist :as cur]] - (if (and (some? acc) (or (not cur) (<= min-dist cur-dist))) - [min-p min-dist] - [cur-p cur-dist]))] - - (->> (:content shape) - (d/with-prev) - (map point+distance) - (reduce find-min-point) - (first)))) (defn- get-line-tval [[{x1 :x y1 :y} {x2 :x y2 :y}] {:keys [x y]}] @@ -653,6 +560,30 @@ (check-range 0 1))) +(defn curve-roots + "Uses cardano algorithm to find the roots for a cubic bezier" + ([[start end h1 h2] coord] + (curve-roots start end h1 h2 coord)) + + ([start end h1 h2 coord] + + (let [coords [[(get start coord) (get h1 coord) (get h2 coord) (get end coord)]] + + coord->tvalue + (fn [[pa pb pc pd]] + + (let [a (+ (* 3 pa) (* -6 pb) (* 3 pc)) + b (+ (* -3 pa) (* 3 pb)) + c pa + d (+ (- pa) (* 3 pb) (* -3 pc) pd)] + + (solve-roots a b c d)))] + (->> coords + (mapcat coord->tvalue) + ;; Only values in the range [0, 1] are valid + (filterv #(and (>= % 0) (<= % 1))))))) + + (defn line-line-crossing [[from-p1 to-p1 :as l1] [from-p2 to-p2 :as l2]] @@ -689,6 +620,18 @@ :else nil))) +(defn line-line-intersect + [l1 l2] + + (let [[l1-t l2-t] (line-line-crossing l1 l2)] + (when (and (some? l1-t) (some? l2-t) + (or (> l1-t 0) (s= l1-t 0)) + (or (< l1-t 1) (s= l1-t 1)) + (or (> l2-t 0) (s= l2-t 0)) + (or (< l2-t 1) (s= l2-t 1))) + [[l1-t] [l2-t]]))) + +;; FIXME: check private flag (defn line-curve-crossing [[from-p1 to-p1] [from-p2 to-p2 h1-p2 h2-p2]] @@ -708,50 +651,6 @@ (curve-roots c2' :y))) -(defn ray-line-intersect - [point [a b :as line]] - - ;; If the ray is parallel to the line there will be no crossings - (let [ray-line [point (gpt/point (inc (:x point)) (:y point))] - ;; Rays fail when fall just in a vertex so we move a bit upward - ;; because only want to use this for insideness - a (if (and (some? a) (s= (:y a) (:y point))) (update a :y + 10) a) - b (if (and (some? b) (s= (:y b) (:y point))) (update b :y + 10) b) - [ray-t line-t] (line-line-crossing ray-line [a b])] - - (when (and (some? line-t) (some? ray-t) - (> ray-t 0) - (or (> line-t 0) (s= line-t 0)) - (or (< line-t 1) (s= line-t 1))) - [[(line-values line line-t) - (line-windup line line-t)]]))) - -(defn line-line-intersect - [l1 l2] - - (let [[l1-t l2-t] (line-line-crossing l1 l2)] - (when (and (some? l1-t) (some? l2-t) - (or (> l1-t 0) (s= l1-t 0)) - (or (< l1-t 1) (s= l1-t 1)) - (or (> l2-t 0) (s= l2-t 0)) - (or (< l2-t 1) (s= l2-t 1))) - [[l1-t] [l2-t]]))) - -(defn ray-curve-intersect - [ray-line curve] - - (let [curve-ts (->> (line-curve-crossing ray-line curve) - (filterv #(let [curve-v (curve-values curve %) - curve-tg (curve-tangent curve %) - curve-tg-angle (gpt/angle curve-tg) - ray-t (get-line-tval ray-line curve-v)] - (and (> ray-t 0) - (> (mth/abs (- curve-tg-angle 180)) 0.01) - (> (mth/abs (- curve-tg-angle 0)) 0.01)))))] - (->> curve-ts - (mapv #(vector (curve-values curve %) - (curve-windup curve %)))))) - (defn line-curve-intersect [l1 c2] @@ -773,6 +672,46 @@ [line-ts curve-ts])) +(defn ray-overlaps? + [ray-point {selrect :selrect}] + (and (or (> (:y ray-point) (:y1 selrect)) + (mth/almost-zero? (- (:y ray-point) (:y1 selrect)))) + (or (< (:y ray-point) (:y2 selrect)) + (mth/almost-zero? (- (:y ray-point) (:y2 selrect)))))) + +(defn ray-line-intersect + [point [a b :as line]] + + ;; If the ray is parallel to the line there will be no crossings + (let [ray-line [point (gpt/point (inc (:x point)) (:y point))] + ;; Rays fail when fall just in a vertex so we move a bit upward + ;; because only want to use this for insideness + a (if (and (some? a) (s= (:y a) (:y point))) (update a :y + 10) a) + b (if (and (some? b) (s= (:y b) (:y point))) (update b :y + 10) b) + [ray-t line-t] (line-line-crossing ray-line [a b])] + + (when (and (some? line-t) (some? ray-t) + (> ray-t 0) + (or (> line-t 0) (s= line-t 0)) + (or (< line-t 1) (s= line-t 1))) + [[(line-values line line-t) + (line-windup line line-t)]]))) + +(defn ray-curve-intersect + [ray-line curve] + + (let [curve-ts (->> (line-curve-crossing ray-line curve) + (filterv #(let [curve-v (curve-values curve %) + curve-tg (curve-tangent curve %) + curve-tg-angle (gpt/angle curve-tg) + ray-t (get-line-tval ray-line curve-v)] + (and (> ray-t 0) + (> (mth/abs (- curve-tg-angle 180)) 0.01) + (> (mth/abs (- curve-tg-angle 0)) 0.01)))))] + (->> curve-ts + (mapv #(vector (curve-values curve %) + (curve-windup curve %)))))) + (defn curve-curve-intersect [c1 c2] @@ -827,55 +766,6 @@ (sort-by :d) (process-ts)))) -(defn curve->rect - [[from-p to-p :as curve]] - (let [extremes (->> (curve-extremities curve) - (mapv #(curve-values curve %)))] - (grc/points->rect (into [from-p to-p] extremes)))) - - -(defn is-point-in-border? - [point content] - - (letfn [(inside-border? [cmd] - (case (:command cmd) - :line-to (segment-has-point? point (command->line cmd)) - :curve-to (curve-has-point? point (command->bezier cmd)) - #_:else false))] - - (->> content - (some inside-border?)))) - -(defn close-content - [content] - (into [] - (mapcat :data) - (->> content - (sp/close-subpaths) - (sp/get-subpaths)))) - -(defn ray-overlaps? - [ray-point {selrect :selrect}] - (and (or (> (:y ray-point) (:y1 selrect)) - (mth/almost-zero? (- (:y ray-point) (:y1 selrect)))) - (or (< (:y ray-point) (:y2 selrect)) - (mth/almost-zero? (- (:y ray-point) (:y2 selrect)))))) - -(defn content->geom-data - [content] - - (->> content - (close-content) - (filter #(not= (= :line-to (:command %)) - (= :curve-to (:command %)))) - (mapv (fn [segment] - {:command (:command segment) - :segment segment - :geom (if (= :line-to (:command segment)) - (command->line segment) - (command->bezier segment)) - :selrect (command->selrect segment)})))) - (defn is-point-in-geom-data? [point content-geom] @@ -899,119 +789,15 @@ (reduce +) (not= 0)))) -;; FIXME: this should be on upc/ namespace -(defn split-line-to - "Given a point and a line-to command will create a two new line-to commands - that will split the original line into two given a value between 0-1" - [from-p cmd t-val] - (let [to-p (upc/command->point cmd) - sp (gpt/lerp from-p to-p t-val)] - [(upc/make-line-to sp) cmd])) +(defn is-point-in-border? + [point content] -;; FIXME: this should be on upc/ namespace -(defn split-curve-to - "Given the point and a curve-to command will split the curve into two new - curve-to commands given a value between 0-1" - [from-p cmd t-val] - (let [params (:params cmd) - end (gpt/point (:x params) (:y params)) - h1 (gpt/point (:c1x params) (:c1y params)) - h2 (gpt/point (:c2x params) (:c2y params)) - [[_ to1 h11 h21] - [_ to2 h12 h22]] (curve-split from-p end h1 h2 t-val)] - [(upc/make-curve-to to1 h11 h21) - (upc/make-curve-to to2 h12 h22)])) + (letfn [(inside-border? [segment] + (case (:command segment) + :line-to (segment-has-point? point (command->line segment)) + :curve-to (curve-has-point? point (command->bezier segment)) + #_:else false))] -(defn split-line-to-ranges - "Splits a line into several lines given the points in `values` - for example (split-line-to-ranges p c [0 0.25 0.5 0.75 1] will split - the line into 4 lines" - [from-p cmd values] - (let [values (->> values (filter #(and (> % 0) (< % 1))))] - (if (empty? values) - [cmd] - (let [to-p (upc/command->point cmd) - values-set (->> (conj values 1) (into (sorted-set)))] - (->> values-set - (mapv (fn [val] - (-> (gpt/lerp from-p to-p val) - #_(gpt/round 2) - (upc/make-line-to))))))))) + (some inside-border? content))) -(defn split-curve-to-ranges - "Splits a curve into several curves given the points in `values` - for example (split-curve-to-ranges p c [0 0.25 0.5 0.75 1] will split - the curve into 4 curves that draw the same curve" - [from-p cmd values] - (let [values (->> values (filter #(and (> % 0) (< % 1))))] - (if (empty? values) - [cmd] - (let [to-p (upc/command->point cmd) - params (:params cmd) - h1 (gpt/point (:c1x params) (:c1y params)) - h2 (gpt/point (:c2x params) (:c2y params)) - - values-set (->> (conj values 0 1) (into (sorted-set)))] - - (->> (d/with-prev values-set) - (rest) - (mapv - (fn [[t1 t0]] - (let [[_ to-p h1' h2'] (subcurve-range from-p to-p h1 h2 t0 t1)] - (upc/make-curve-to (-> to-p #_(gpt/round 2)) h1' h2'))))))))) - -(defn content-center - [content] - (-> content - content->selrect - grc/rect->center)) - -(defn content->points+selrect - "Given the content of a shape, calculate its points and selrect" - [shape content] - (let [{:keys [flip-x flip-y]} shape - transform - (cond-> (:transform shape (gmt/matrix)) - flip-x (gmt/scale (gpt/point -1 1)) - flip-y (gmt/scale (gpt/point 1 -1))) - - transform-inverse - (cond-> (gmt/matrix) - flip-x (gmt/scale (gpt/point -1 1)) - flip-y (gmt/scale (gpt/point 1 -1)) - :always (gmt/multiply (:transform-inverse shape (gmt/matrix)))) - - center (or (some-> (dm/get-prop shape :selrect) grc/rect->center) - (content-center content)) - - base-content (transform-content - content - (gmt/transform-in center transform-inverse)) - - ;; Calculates the new selrect with points given the old center - points (-> (content->selrect base-content) - (grc/rect->points) - (gco/transform-points center transform)) - - points-center (gco/points->center points) - - ;; Points is now the selrect but the center is different so we can create the selrect - ;; through points - selrect (-> points - (gco/transform-points points-center transform-inverse) - (grc/points->rect))] - - [points selrect])) - -(defn open-path? - [shape] - (let [svg? (contains? shape :svg-attrs) - ;; No close subpaths for svgs imported - maybe-close (if svg? identity sp/close-subpaths)] - (and (= :path (:type shape)) - (not (->> shape - :content - (maybe-close) - (sp/get-subpaths) - (every? sp/is-closed?)))))) diff --git a/common/src/app/common/types/path/impl.cljc b/common/src/app/common/types/path/impl.cljc new file mode 100644 index 0000000000..ecafa45a7b --- /dev/null +++ b/common/src/app/common/types/path/impl.cljc @@ -0,0 +1,782 @@ +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. +;; +;; Copyright (c) KALEIDOS INC + +(ns app.common.types.path.impl + "Contains schemas and data type implementation for PathData binary + and plain formats" + #?(:cljs + (:require-macros [app.common.types.path.impl :refer [read-float read-short write-float write-short]])) + (:refer-clojure :exclude [-lookup -reduce]) + (:require + #?(:clj [app.common.fressian :as fres]) + #?(:clj [clojure.data.json :as json]) + #?(:cljs [app.common.weak-map :as weak-map]) + [app.common.data.macros :as dm] + [app.common.schema :as sm] + [app.common.schema.generators :as sg] + [app.common.svg.path :as svg.path] + [app.common.transit :as t] + [app.common.types.path :as-alias path]) + (:import + #?(:cljs [goog.string StringBuffer] + :clj [java.nio ByteBuffer ByteOrder]))) + +#?(:clj (set! *warn-on-reflection* true)) + +(def ^:const SEGMENT-BYTE-SIZE 28) + +(defprotocol IPathData + (-write-to [_ buffer offset] "write the content to the specified buffer") + (-get-byte-size [_] "get byte size")) + +(defprotocol ITransformable + (-transform [_ m] "apply a transform") + (-lookup [_ index f]) + (-walk [_ f initial]) + (-reduce [_ f initial])) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; IMPL HELPERS +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defmacro read-short + [target offset] + (if (:ns &env) + `(.getInt16 ~target ~offset true) + (let [target (with-meta target {:tag 'java.nio.ByteBuffer})] + `(.getShort ~target ~offset)))) + +(defmacro read-float + [target offset] + (if (:ns &env) + `(.getFloat32 ~target ~offset true) + (let [target (with-meta target {:tag 'java.nio.ByteBuffer})] + `(double (.getFloat ~target ~offset))))) + +(defmacro write-float + [target offset value] + (if (:ns &env) + `(.setFloat32 ~target ~offset ~value true) + (let [target (with-meta target {:tag 'java.nio.ByteBuffer})] + `(.putFloat ~target ~offset ~value)))) + +(defmacro write-short + [target offset value] + (if (:ns &env) + `(.setInt16 ~target ~offset ~value true) + (let [target (with-meta target {:tag 'java.nio.ByteBuffer})] + `(.putShort ~target ~offset ~value)))) + +(defmacro with-cache + "A helper macro that facilitates cache handling for content + instance, only relevant on CLJS" + [target key & expr] + (if (:ns &env) + (let [cache (gensym "cache-") + target (with-meta target {:tag 'js})] + `(let [~cache (.-cache ~target) + ~'result (.get ~cache ~key)] + (if ~'result + (do + ~'result) + (let [~'result (do ~@expr)] + (.set ~cache ~key ~'result) + ~'result)))) + `(do ~@expr))) + +(defn- allocate + [n-segments] + #?(:clj (let [buffer (ByteBuffer/allocate (* n-segments SEGMENT-BYTE-SIZE))] + (.order buffer ByteOrder/LITTLE_ENDIAN)) + :cljs (new js/ArrayBuffer (* n-segments SEGMENT-BYTE-SIZE)))) + +(defn- clone-buffer + [buffer] + #?(:clj + (let [src (.array ^ByteBuffer buffer) + len (alength ^bytes src) + dst (byte-array len)] + (System/arraycopy src 0 dst 0 len) + (let [buffer (ByteBuffer/wrap dst)] + (.order buffer ByteOrder/LITTLE_ENDIAN))) + :cljs + (let [src-view (js/Uint32Array. buffer) + dst-buff (js/ArrayBuffer. (.-byteLength buffer)) + dst-view (js/Uint32Array. dst-buff)] + (.set dst-view src-view) + dst-buff))) + +(defn- impl-transform-segment + "Apply a transformation to a segment located under specified offset" + [buffer offset a b c d e f] + (let [t (read-short buffer offset)] + (case t + (1 2) + (let [x (read-float buffer (+ offset 20)) + y (read-float buffer (+ offset 24)) + x (+ (* x a) (* y c) e) + y (+ (* x b) (* y d) f)] + (write-float buffer (+ offset 20) x) + (write-float buffer (+ offset 24) y)) + + 3 + (let [c1x (read-float buffer (+ offset 4)) + c1y (read-float buffer (+ offset 8)) + c2x (read-float buffer (+ offset 12)) + c2y (read-float buffer (+ offset 16)) + x (read-float buffer (+ offset 20)) + y (read-float buffer (+ offset 24)) + + c1x (+ (* c1x a) (* c1y c) e) + c1y (+ (* c1x b) (* c1y d) f) + c2x (+ (* c2x a) (* c2y c) e) + c2y (+ (* c2x b) (* c2y d) f) + x (+ (* x a) (* y c) e) + y (+ (* x b) (* y d) f)] + + (write-float buffer (+ offset 4) c1x) + (write-float buffer (+ offset 8) c1y) + (write-float buffer (+ offset 12) c2x) + (write-float buffer (+ offset 16) c2y) + (write-float buffer (+ offset 20) x) + (write-float buffer (+ offset 24) y)) + + nil))) + +(defn- impl-transform + [buffer m size] + (let [a (dm/get-prop m :a) + b (dm/get-prop m :b) + c (dm/get-prop m :c) + d (dm/get-prop m :d) + e (dm/get-prop m :e) + f (dm/get-prop m :f)] + (loop [index 0] + (when (< index size) + (let [offset (* index SEGMENT-BYTE-SIZE)] + (impl-transform-segment buffer offset a b c d e f) + (recur (inc index))))))) + +(defn- impl-walk + [buffer f initial size] + (loop [index 0 + result (transient initial)] + (if (< index size) + (let [offset (* index SEGMENT-BYTE-SIZE) + type (read-short buffer offset) + c1x (read-float buffer (+ offset 4)) + c1y (read-float buffer (+ offset 8)) + c2x (read-float buffer (+ offset 12)) + c2y (read-float buffer (+ offset 16)) + x (read-float buffer (+ offset 20)) + y (read-float buffer (+ offset 24)) + type (case type + 1 :line-to + 2 :move-to + 3 :curve-to + 4 :close-path) + res (f type c1x c1y c2x c2y x y)] + (recur (inc index) + (if (some? res) + (conj! result res) + result))) + (persistent! result)))) + +(defn impl-reduce + [buffer f initial size] + (loop [index 0 + result initial] + (if (< index size) + (let [offset (* index SEGMENT-BYTE-SIZE) + type (read-short buffer offset) + c1x (read-float buffer (+ offset 4)) + c1y (read-float buffer (+ offset 8)) + c2x (read-float buffer (+ offset 12)) + c2y (read-float buffer (+ offset 16)) + x (read-float buffer (+ offset 20)) + y (read-float buffer (+ offset 24)) + type (case type + 1 :line-to + 2 :move-to + 3 :curve-to + 4 :close-path) + result (f result index type c1x c1y c2x c2y x y)] + (if (reduced? result) + result + (recur (inc index) result))) + result))) + +(defn impl-lookup + [buffer index f] + (let [offset (* index SEGMENT-BYTE-SIZE) + type (read-short buffer offset) + c1x (read-float buffer (+ offset 4)) + c1y (read-float buffer (+ offset 8)) + c2x (read-float buffer (+ offset 12)) + c2y (read-float buffer (+ offset 16)) + x (read-float buffer (+ offset 20)) + y (read-float buffer (+ offset 24)) + type (case type + 1 :line-to + 2 :move-to + 3 :curve-to + 4 :close-path)] + #?(:clj (f type c1x c1y c2x c2y x y) + :cljs (^function f type c1x c1y c2x c2y x y)))) + +(defn- to-string-segment* + [buffer offset type ^StringBuilder builder] + (case (long type) + 1 (let [x (read-float buffer (+ offset 20)) + y (read-float buffer (+ offset 24))] + (doto builder + (.append "M") + (.append x) + (.append ",") + (.append y))) + 2 (let [x (read-float buffer (+ offset 20)) + y (read-float buffer (+ offset 24))] + (doto builder + (.append "L") + (.append x) + (.append ",") + (.append y))) + + 3 (let [c1x (read-float buffer (+ offset 4)) + c1y (read-float buffer (+ offset 8)) + c2x (read-float buffer (+ offset 12)) + c2y (read-float buffer (+ offset 16)) + x (read-float buffer (+ offset 20)) + y (read-float buffer (+ offset 24))] + (doto builder + (.append "C") + (.append c1x) + (.append ",") + (.append c1y) + (.append ",") + (.append c2x) + (.append ",") + (.append c2y) + (.append ",") + (.append x) + (.append ",") + (.append y))) + 4 (doto builder + (.append "Z")))) + +(defn- to-string + "Format the path data structure to string" + [buffer size] + (let [builder #?(:clj (java.lang.StringBuilder. (int (* size 4))) + :cljs (StringBuffer.))] + (loop [index 0] + (when (< index size) + (let [offset (* index SEGMENT-BYTE-SIZE) + type (read-short buffer offset)] + (to-string-segment* buffer offset type builder) + (recur (inc index))))) + + (.toString builder))) + +(defn- read-segment + "Read segment from binary buffer at specified index" + [buffer index] + (let [offset (* index SEGMENT-BYTE-SIZE) + type (read-short buffer offset)] + (case (long type) + 1 (let [x (read-float buffer (+ offset 20)) + y (read-float buffer (+ offset 24))] + {:command :move-to + :params {:x (double x) + :y (double y)}}) + + 2 (let [x (read-float buffer (+ offset 20)) + y (read-float buffer (+ offset 24))] + {:command :line-to + :params {:x (double x) + :y (double y)}}) + + 3 (let [c1x (read-float buffer (+ offset 4)) + c1y (read-float buffer (+ offset 8)) + c2x (read-float buffer (+ offset 12)) + c2y (read-float buffer (+ offset 16)) + x (read-float buffer (+ offset 20)) + y (read-float buffer (+ offset 24))] + {:command :curve-to + :params {:x (double x) + :y (double y) + :c1x (double c1x) + :c1y (double c1y) + :c2x (double c2x) + :c2y (double c2y)}}) + + 4 {:command :close-path + :params {}}))) + +(defn- in-range? + [size i] + (and (< i size) (>= i 0))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; TYPE: PATH-DATA +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +#?(:clj + (deftype PathData [size + ^ByteBuffer buffer + ^:unsynchronized-mutable hash] + Object + (toString [_] + (to-string buffer size)) + + (equals [_ other] + (if (instance? PathData other) + (.equals ^ByteBuffer buffer (.-buffer ^PathData other)) + false)) + + ITransformable + (-transform [_ m] + (let [buffer (clone-buffer buffer)] + (impl-transform buffer m size) + (PathData. size buffer nil))) + + (-walk [_ f initial] + (impl-walk buffer f initial size)) + + (-reduce [_ f initial] + (impl-reduce buffer f initial size)) + + (-lookup [_ index f] + (when (and (<= 0 index) + (< index size)) + (impl-lookup buffer index f))) + + json/JSONWriter + (-write [this writter options] + (json/-write (.toString this) writter options)) + + clojure.lang.IHashEq + (hasheq [this] + (when-not hash + (set! hash (clojure.lang.Murmur3/hashOrdered (seq this)))) + hash) + + clojure.lang.Sequential + clojure.lang.Seqable + (seq [_] + (when (pos? size) + ((fn next-seq [i] + (when (< i size) + (cons (read-segment buffer i) + (lazy-seq (next-seq (inc i)))))) + 0))) + + clojure.lang.IReduceInit + (reduce [_ f start] + (loop [index 0 + result start] + (if (< index size) + (let [result (f result (read-segment buffer index))] + (if (reduced? result) + @result + (recur (inc index) result))) + result))) + + clojure.lang.Indexed + (nth [_ i] + (if (in-range? size i) + (read-segment buffer i) + nil)) + + (nth [_ i default] + (if (in-range? size i) + (read-segment buffer i) + default)) + + clojure.lang.Counted + (count [_] size) + + IPathData + (-get-byte-size [_] + (* size SEGMENT-BYTE-SIZE)) + + (-write-to [_ _ _] + (throw (RuntimeException. "not implemented")))) + + :cljs + #_:clj-kondo/ignore + (deftype PathData [size buffer dview cache ^:mutable __hash] + Object + (toString [_] + (to-string dview size)) + + IPathData + (-get-byte-size [_] + (.-byteLength buffer)) + + (-write-to [_ into-buffer offset] + ;; NOTE: we still use u8 because until the heap refactor merge + ;; we can't guarrantee the alignment of offset on 4 bytes + (assert (instance? js/ArrayBuffer into-buffer)) + (let [size (.-byteLength buffer) + mem (js/Uint8Array. into-buffer offset size)] + (.set mem (js/Uint8Array. buffer)))) + + ITransformable + (-transform [this m] + (let [buffer (clone-buffer buffer) + dview (js/DataView. buffer)] + (impl-transform dview m size) + (PathData. size buffer dview (weak-map/create) nil))) + + (-walk [_ f initial] + (impl-walk dview f initial size)) + + (-reduce [_ f initial] + (impl-reduce dview f initial size)) + + (-lookup [_ index f] + (when (and (<= 0 index) + (< index size)) + (impl-lookup dview index f))) + + cljs.core/ISequential + cljs.core/IEquiv + (-equiv [this other] + (if (instance? PathData other) + (let [obuffer (.-buffer other)] + (if (= (.-byteLength obuffer) + (.-byteLength buffer)) + (let [cb (js/Uint32Array. buffer) + ob (js/Uint32Array. obuffer) + sz (alength cb)] + (loop [i 0] + (if (< i sz) + (if (= (aget ob i) + (aget cb i)) + (recur (inc i)) + false) + true))) + false)) + false)) + + cljs.core/IReduce + (-reduce [_ f] + (loop [index 1 + result (if (pos? size) + (read-segment dview 0) + nil)] + (if (< index size) + (let [result (f result (read-segment dview index))] + (if (reduced? result) + @result + (recur (inc index) result))) + result))) + + (-reduce [_ f start] + (loop [index 0 + result start] + (if (< index size) + (let [result (f result (read-segment dview index))] + (if (reduced? result) + @result + (recur (inc index) result))) + result))) + + cljs.core/IHash + (-hash [coll] + (caching-hash coll hash-ordered-coll __hash)) + + cljs.core/ICounted + (-count [_] size) + + cljs.core/IIndexed + (-nth [_ i] + (if (in-range? size i) + (read-segment dview i) + nil)) + + (-nth [_ i default] + (if (in-range? i size) + (read-segment dview i) + default)) + + cljs.core/ISeqable + (-seq [this] + (when (pos? size) + ((fn next-seq [i] + (when (< i size) + (cons (read-segment dview i) + (lazy-seq (next-seq (inc i)))))) + 0))) + + cljs.core/IPrintWithWriter + (-pr-writer [this writer _] + (cljs.core/-write writer (str "#penpot/path-data \"" (.toString this) "\""))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; SCHEMA +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def schema:safe-number + [:schema {:gen/gen (sg/small-int :max 100 :min -100)} + ::sm/safe-number]) + +(def ^:private schema:line-to-segment + [:map + [:command [:= :line-to]] + [:params + [:map + [:x schema:safe-number] + [:y schema:safe-number]]]]) + +(def ^:private schema:close-path-segment + [:map + [:command [:= :close-path]]]) + +(def ^:private schema:move-to-segment + [:map + [:command [:= :move-to]] + [:params + [:map + [:x schema:safe-number] + [:y schema:safe-number]]]]) + +(def ^:private schema:curve-to-segment + [:map + [:command [:= :curve-to]] + [:params + [:map + [:x schema:safe-number] + [:y schema:safe-number] + [:c1x schema:safe-number] + [:c1y schema:safe-number] + [:c2x schema:safe-number] + [:c2y schema:safe-number]]]]) + +(def ^:private schema:segment + [:multi {:title "PathSegment" + :dispatch :command + :decode/json #(update % :command keyword)} + [:line-to schema:line-to-segment] + [:close-path schema:close-path-segment] + [:move-to schema:move-to-segment] + [:curve-to schema:curve-to-segment]]) + +(def schema:segments + [:vector {:gen/gen (->> (sg/generator schema:segment) + (sg/vector) + (sg/filter not-empty) + (sg/filter (fn [[e1]] + (= (:command e1) :move-to))))} + schema:segment]) + +(def schema:content-like + [:sequential schema:segment]) + +(def check-content-like + (sm/check-fn schema:content-like)) + +(def check-segment + (sm/check-fn schema:segment)) + +(def ^:private check-segments + (sm/check-fn schema:segments)) + +(defn path-data? + [o] + (instance? PathData o)) + +(declare from-string) +(declare from-plain) + +;; Mainly used on backend: features/components_v2.clj +(sm/register! ::path/segment schema:segment) +(sm/register! ::path/segments schema:segments) + +(sm/register! + {:type ::path/content + :compile + (fn [_ _ _] + (let [decoder (delay (sm/decoder schema:segments sm/json-transformer)) + generator (->> (sg/generator schema:segments) + (sg/filter not-empty) + (sg/fmap from-plain))] + {:pred path-data? + :type-properties + {:gen/gen generator + :encode/json identity + :decode/json (fn [s] + (cond + (string? s) + (from-string s) + + (vector? s) + (let [decode-fn (deref decoder)] + (-> (decode-fn s) + (from-plain))) + + :else + s))}}))}) + +(def check-path-content + (sm/check-fn ::path/content)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; CONSTRUCTORS & PREDICATES +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defn from-string + [s] + (from-plain (svg.path/parse s))) + +(defn from-bytes + [buffer] + #?(:clj + (cond + (instance? ByteBuffer buffer) + (let [size (.capacity ^ByteBuffer buffer) + count (long (/ size SEGMENT-BYTE-SIZE)) + buffer (.order ^ByteBuffer buffer ByteOrder/LITTLE_ENDIAN)] + (PathData. count buffer nil)) + + (bytes? buffer) + (let [size (alength ^bytes buffer) + count (long (/ size SEGMENT-BYTE-SIZE)) + buffer (ByteBuffer/wrap buffer)] + (PathData. count + (.order buffer ByteOrder/LITTLE_ENDIAN) + nil)) + :else + (throw (java.lang.IllegalArgumentException. "invalid data provided"))) + + :cljs + (cond + (instance? js/ArrayBuffer buffer) + (let [size (.-byteLength buffer) + count (long (/ size SEGMENT-BYTE-SIZE))] + (PathData. count + buffer + (js/DataView. buffer) + (weak-map/create) + nil)) + + (instance? js/DataView buffer) + (let [dview buffer + buffer (.-buffer dview) + size (.-byteLength buffer) + count (long (/ size SEGMENT-BYTE-SIZE))] + (PathData. count buffer dview (weak-map/create) nil)) + + (instance? js/Uint8Array buffer) + (from-bytes (.-buffer buffer)) + + (instance? js/Int8Array buffer) + (from-bytes (.-buffer buffer)) + + :else + (throw (js/Error. "invalid data provided"))))) + +;; FIXME: consider implementing with reduce +;; FIXME: consider ensure fixed precision for avoid doing it on formatting + +(defn from-plain + "Create a PathData instance from plain data structures" + [segments] + (assert (check-segments segments)) + + (let [total (count segments) + #?@(:cljs [buffer' (allocate total) + buffer (new js/DataView buffer')] + :clj [buffer (allocate total)])] + (loop [index 0] + (when (< index total) + (let [segment (nth segments index) + offset (* index SEGMENT-BYTE-SIZE)] + (case (get segment :command) + :move-to + (let [params (get segment :params) + x (float (get params :x)) + y (float (get params :y))] + (write-short buffer offset 1) + (write-float buffer (+ offset 20) x) + (write-float buffer (+ offset 24) y)) + + :line-to + (let [params (get segment :params) + x (float (get params :x)) + y (float (get params :y))] + + (write-short buffer offset 2) + (write-float buffer (+ offset 20) x) + (write-float buffer (+ offset 24) y)) + + :curve-to + (let [params (get segment :params) + x (float (get params :x)) + y (float (get params :y)) + c1x (float (get params :c1x x)) + c1y (float (get params :c1y y)) + c2x (float (get params :c2x x)) + c2y (float (get params :c2y y))] + + (write-short buffer offset 3) + (write-float buffer (+ offset 4) c1x) + (write-float buffer (+ offset 8) c1y) + (write-float buffer (+ offset 12) c2x) + (write-float buffer (+ offset 16) c2y) + (write-float buffer (+ offset 20) x) + (write-float buffer (+ offset 24) y)) + + :close-path + (write-short buffer offset 4)) + (recur (inc index))))) + + (from-bytes buffer))) + +(defn path-data + "Create an instance of PathData, returns itself if it is already + PathData instance" + [data] + (cond + (path-data? data) + data + + (nil? data) + (from-plain []) + + (sequential? data) + (from-plain data) + + :else + (throw (ex-info "unexpected data" {:data data})))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; SERIALIZATION +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(t/add-handlers! + {:id "penpot/path-data" + :class PathData + :wfn (fn [^PathData pdata] + (let [buffer (.-buffer pdata)] + #?(:cljs (js/Uint8Array. buffer) + :clj (.array ^ByteBuffer buffer)))) + :rfn from-bytes}) + +#?(:clj + (fres/add-handlers! + {:name "penpot/path-data" + :class PathData + :wfn (fn [n w o] + (fres/write-tag! w n 1) + (let [buffer (.-buffer ^PathData o) + bytes (.array ^ByteBuffer buffer)] + (fres/write-bytes! w bytes))) + :rfn (fn [r] + (let [^bytes bytes (fres/read-object! r)] + (from-bytes bytes)))})) + diff --git a/common/src/app/common/types/path/segment.cljc b/common/src/app/common/types/path/segment.cljc new file mode 100644 index 0000000000..bf8184f036 --- /dev/null +++ b/common/src/app/common/types/path/segment.cljc @@ -0,0 +1,889 @@ +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. +;; +;; Copyright (c) KALEIDOS INC + +(ns app.common.types.path.segment + "A collection of helpers for work with plain segment type" + (:require + [app.common.data :as d] + [app.common.data.macros :as dm] + [app.common.geom.matrix :as gmt] + [app.common.geom.point :as gpt] + [app.common.geom.rect :as grc] + [app.common.math :as mth] + [app.common.types.path.helpers :as helpers] + [app.common.types.path.impl :as impl] + [clojure.set :as set])) + +#?(:clj (set! *warn-on-reflection* true)) + +(defn update-handler + [command prefix point] + (let [[cox coy] (if (= prefix :c1) [:c1x :c1y] [:c2x :c2y])] + (-> command + (assoc-in [:params cox] (:x point)) + (assoc-in [:params coy] (:y point))))) + +(defn get-handler [{:keys [params] :as command} prefix] + (let [cx (d/prefix-keyword prefix :x) + cy (d/prefix-keyword prefix :y)] + (when (and command + (contains? params cx) + (contains? params cy)) + (gpt/point (get params cx) + (get params cy))))) + +(defn get-handlers + "Retrieve a map where for every point will retrieve a list of + the handlers that are associated with that point. + point -> [[index, prefix]]" + [content] + (let [prev-point* (volatile! nil) + vec-conj (fnil conj [])] + (impl/-reduce content + (fn [result index type _ _ _ _ x y] + (let [curr-point (gpt/point x y) + prev-point (deref prev-point*)] + (vreset! prev-point* curr-point) + (if (and prev-point (= :curve-to type)) + (-> result + (update prev-point vec-conj [index :c1]) + (update curr-point vec-conj [index :c2])) + result))) + {}))) + +(defn point-indices + [content point] + (->> (d/enumerate content) + (filter (fn [[_ segment]] (= point (helpers/segment->point segment)))) + (mapv (fn [[index _]] index)))) + +(defn handler-indices + "Return an index where the key is the positions and the values the handlers" + [content point] + (->> (d/with-prev content) + (d/enumerate) + (mapcat (fn [[index [cur-segment pre-segment]]] + (if (and (some? pre-segment) (= :curve-to (:command cur-segment))) + (let [cur-pos (helpers/segment->point cur-segment) + pre-pos (helpers/segment->point pre-segment)] + (cond-> [] + (= pre-pos point) (conj [index :c1]) + (= cur-pos point) (conj [index :c2]))) + []))))) + +(defn opposite-index + "Calculates the opposite index given a prefix and an index" + [content index prefix] + + (let [point (if (= prefix :c2) + (helpers/segment->point (nth content index)) + (helpers/segment->point (nth content (dec index)))) + + point->handlers (get-handlers content) + + handlers (->> point + (point->handlers) + (filter (fn [[ci cp]] (and (not= index ci) (not= prefix cp)))))] + + (cond + (= (count handlers) 1) + (->> handlers first) + + (and (= :c1 prefix) (= (count content) index)) + [(dec index) :c2] + + :else nil))) + +;; FIXME: rename to get-point +(defn get-handler-point + "Given a segment index and prefix, get a handler point" + [content index prefix] + (when (and (some? index) + (some? content)) + (impl/-lookup content index + (fn [command c1x c1y c2x c2y x y] + (let [prefix (if (= :curve-to command) + prefix + nil)] + (case prefix + :c1 (gpt/point c1x c1y) + :c2 (gpt/point c2x c2y) + (gpt/point x y))))))) + +;; FIXME: revisit this function +(defn handler->node + [content index prefix] + (if (= prefix :c1) + (helpers/segment->point (nth content (dec index))) + (helpers/segment->point (nth content index)))) + +(defn calculate-opposite-handler + "Given a point and its handler, gives the symmetric handler" + [point handler] + (let [handler-vector (gpt/to-vec point handler)] + (gpt/add point (gpt/negate handler-vector)))) + +(defn opposite-handler + "Calculates the coordinates of the opposite handler" + [point handler] + (let [phv (gpt/to-vec point handler)] + (gpt/add point (gpt/negate phv)))) + +(defn get-points + "Returns points for the given segment, faster version of + the `content->points`." + [content] + (impl/with-cache content "get-points" + (impl/-walk content + (fn [type _ _ _ _ x y] + (when (not= type :close-path) + (gpt/point x y))) + []))) + +;; FIXME: incorrect API, don't need full shape +(defn path->lines + "Given a path returns a list of lines that approximate the path" + [shape] + (loop [command (first (:content shape)) + pending (rest (:content shape)) + result [] + last-start nil + prev-point nil] + + (if-let [{:keys [command params]} command] + (let [point (if (= :close-path command) + last-start + (gpt/point params)) + + result (case command + :line-to (conj result [prev-point point]) + :curve-to (let [h1 (gpt/point (:c1x params) (:c1y params)) + h2 (gpt/point (:c2x params) (:c2y params))] + (into result (helpers/curve->lines prev-point point h1 h2))) + :move-to (cond-> result + last-start (conj [prev-point last-start])) + result) + last-start (if (= :move-to command) + point + last-start)] + (recur (first pending) + (rest pending) + result + last-start + point)) + + (conj result [prev-point last-start])))) + +(def ^:const path-closest-point-accuracy 0.01) + +;; FIXME: move to helpers?, this function need performance review, it +;; is executed so many times on path edition +(defn- curve-closest-point + [position start end h1 h2] + (let [d (memoize (fn [t] (gpt/distance position (helpers/curve-values start end h1 h2 t))))] + (loop [t1 0.0 + t2 1.0] + (if (<= (mth/abs (- t1 t2)) path-closest-point-accuracy) + (-> (helpers/curve-values start end h1 h2 t1) + ;; store the segment info + (with-meta {:t t1 :from-p start :to-p end})) + + (let [ht (+ t1 (/ (- t2 t1) 2)) + ht1 (+ t1 (/ (- t2 t1) 4)) + ht2 (+ t1 (/ (* 3 (- t2 t1)) 4)) + + [t1 t2] (cond + (< (d ht1) (d ht2)) + [t1 ht] + + (< (d ht2) (d ht1)) + [ht t2] + + (and (< (d ht) (d t1)) (< (d ht) (d t2))) + [ht1 ht2] + + (< (d t1) (d t2)) + [t1 ht] + + :else + [ht t2])] + (recur (double t1) + (double t2))))))) + +(defn- line-closest-point + "Point on line" + [position from-p to-p] + + (let [e1 (gpt/to-vec from-p to-p) + e2 (gpt/to-vec from-p position) + + len2 (+ (mth/sq (:x e1)) (mth/sq (:y e1))) + t (/ (gpt/dot e1 e2) len2)] + + (if (and (>= t 0) (<= t 1) (not (mth/almost-zero? len2))) + (-> (gpt/add from-p (gpt/scale e1 t)) + (with-meta {:t t + :from-p from-p + :to-p to-p})) + + ;; There is no perpendicular projection in the line so the closest + ;; point will be one of the extremes + (if (<= (gpt/distance position from-p) (gpt/distance position to-p)) + from-p + to-p)))) + +;; FIXME: incorrect API, complete shape is not necessary here +(defn path-closest-point + "Given a path and a position" + [shape position] + + (let [point+distance + (fn [[cur-segment prev-segment]] + (let [from-p (helpers/segment->point prev-segment) + to-p (helpers/segment->point cur-segment) + h1 (gpt/point (get-in cur-segment [:params :c1x]) + (get-in cur-segment [:params :c1y])) + h2 (gpt/point (get-in cur-segment [:params :c2x]) + (get-in cur-segment [:params :c2y])) + point + (case (:command cur-segment) + :line-to + (line-closest-point position from-p to-p) + + :curve-to + (curve-closest-point position from-p to-p h1 h2) + + nil)] + (when point + [point (gpt/distance point position)]))) + + find-min-point + (fn [[min-p min-dist :as acc] [cur-p cur-dist :as cur]] + (if (and (some? acc) (or (not cur) (<= min-dist cur-dist))) + [min-p min-dist] + [cur-p cur-dist]))] + + (->> (:content shape) + (d/with-prev) + (map point+distance) + (reduce find-min-point) + (first)))) + + +(defn closest-point + "Given a path and a position" + [content position] + + (let [point+distance + (fn [[cur-segment prev-segment]] + (let [from-p (helpers/segment->point prev-segment) + to-p (helpers/segment->point cur-segment) + h1 (gpt/point (get-in cur-segment [:params :c1x]) + (get-in cur-segment [:params :c1y])) + h2 (gpt/point (get-in cur-segment [:params :c2x]) + (get-in cur-segment [:params :c2y])) + point + (case (:command cur-segment) + :line-to + (line-closest-point position from-p to-p) + + :curve-to + (curve-closest-point position from-p to-p h1 h2) + + nil)] + (when point + [point (gpt/distance point position)]))) + + find-min-point + (fn [[min-p min-dist :as acc] [cur-p cur-dist :as cur]] + (if (and (some? acc) (or (not cur) (<= min-dist cur-dist))) + [min-p min-dist] + [cur-p cur-dist]))] + + (->> content + (d/with-prev) + (map point+distance) + (reduce find-min-point) + (first)))) + +(defn- remove-line-curves + "Remove all curves that have both handlers in the same position that the + beginning and end points. This makes them really line-to commands" + [content] + (let [with-prev (d/enumerate (d/with-prev content)) + process-command + (fn [content [index [command prev]]] + + (let [cur-point (helpers/segment->point command) + pre-point (helpers/segment->point prev) + handler-c1 (get-handler command :c1) + handler-c2 (get-handler command :c2)] + (if (and (= :curve-to (:command command)) + (= cur-point handler-c2) + (= pre-point handler-c1)) + (assoc content index {:command :line-to + :params (into {} cur-point)}) + content)))] + + (reduce process-command content with-prev))) + +(defn make-corner-point + "Changes the content to make a point a 'corner'" + [content point] + (let [handlers (-> (get-handlers content) + (get point)) + change-content + (fn [content [index prefix]] + (let [cx (d/prefix-keyword prefix :x) + cy (d/prefix-keyword prefix :y)] + (-> content + (assoc-in [index :params cx] (:x point)) + (assoc-in [index :params cy] (:y point)))))] + (as-> content $ + (reduce change-content $ handlers) + (remove-line-curves $)))) + + +(defn- line->curve + [from-p segment] + + (let [to-p (helpers/segment->point segment) + + v (gpt/to-vec from-p to-p) + d (gpt/distance from-p to-p) + + dv1 (-> (gpt/normal-left v) + (gpt/scale (/ d 3))) + + h1 (gpt/add from-p dv1) + + dv2 (-> (gpt/to-vec to-p h1) + (gpt/unit) + (gpt/scale (/ d 3))) + + h2 (gpt/add to-p dv2)] + (-> segment + (assoc :command :curve-to) + (update :params (fn [params] + ;; ensure plain map + (-> (into {} params) + (assoc :c1x (:x h1)) + (assoc :c1y (:y h1)) + (assoc :c2x (:x h2)) + (assoc :c2y (:y h2)))))))) + +;; FIXME: optimize +(defn is-curve? + [content point] + (let [handlers (-> (get-handlers content) + (get point)) + handler-points (map #(get-handler-point content (first %) (second %)) handlers)] + (some #(not= point %) handler-points))) + +(def ^:private xf:mapcat-points + (comp + (mapcat #(vector (:next-p %) (:prev-p %))) + (remove nil?))) + +(defn make-curve-point + "Changes the content to make the point a 'curve'. The handlers will be positioned + in the same vector that results from the previous->next points but with fixed length." + [content point] + + (let [indices (point-indices content point) + vectors (map (fn [index] + (let [segment (nth content index) + prev-i (dec index) + prev (when (not (= :move-to (:command segment))) + (get content prev-i)) + next-i (inc index) + next (get content next-i) + + next (when (not (= :move-to (:command next))) + next)] + {:index index + :prev-i (when (some? prev) prev-i) + :prev-c prev + :prev-p (helpers/segment->point prev) + :next-i (when (some? next) next-i) + :next-c next + :next-p (helpers/segment->point next) + :segment segment})) + indices) + + points (into #{} xf:mapcat-points vectors)] + + (if (= (count points) 2) + (let [v1 (gpt/to-vec (first points) point) + v2 (gpt/to-vec (first points) (second points)) + vp (gpt/project v1 v2) + vh (gpt/subtract v1 vp) + + add-curve + (fn [content {:keys [index prev-p next-p next-i]}] + (let [cur-segment (get content index) + next-segment (get content next-i) + + ;; New handlers for prev-point and next-point + prev-h (when (some? prev-p) (gpt/add prev-p vh)) + next-h (when (some? next-p) (gpt/add next-p vh)) + + ;; Correct 1/3 to the point improves the curve + prev-correction (when (some? prev-h) (gpt/scale (gpt/to-vec prev-h point) (/ 1 3))) + next-correction (when (some? next-h) (gpt/scale (gpt/to-vec next-h point) (/ 1 3))) + + prev-h (when (some? prev-h) (gpt/add prev-h prev-correction)) + next-h (when (some? next-h) (gpt/add next-h next-correction))] + (cond-> content + (and (= :line-to (:command cur-segment)) (some? prev-p)) + (update index helpers/update-curve-to prev-p prev-h) + + (and (= :line-to (:command next-segment)) (some? next-p)) + (update next-i helpers/update-curve-to next-h next-p) + + (and (= :curve-to (:command cur-segment)) (some? prev-p)) + (update index update-handler :c2 prev-h) + + (and (= :curve-to (:command next-segment)) (some? next-p)) + (update next-i update-handler :c1 next-h))))] + + (reduce add-curve content vectors)) + + (let [add-curve + (fn [content {:keys [index segment prev-p next-c next-i]}] + (cond-> content + (= :line-to (:command segment)) + (update index #(line->curve prev-p %)) + + (= :curve-to (:command segment)) + (update index #(line->curve prev-p %)) + + (= :line-to (:command next-c)) + (update next-i #(line->curve point %)) + + (= :curve-to (:command next-c)) + (update next-i #(line->curve point %))))] + (reduce add-curve content vectors))))) + +(defn get-segments-with-points + "Given a content and a set of points return all the segments in the path + that uses the points" + [content points] + (let [point-set (set points)] + (loop [result (transient []) + prev-point nil + start-point nil + index 0 + content (seq content)] + (if-let [{:keys [command] :as segment} (first content)] + (let [close-path? (= command :close-path) + move-to? (= command :move-to) + + cur-point (if close-path? + start-point + (helpers/segment->point segment)) + + ;; If there is a move-to we don't have a segment + prev-point (if move-to? + nil + prev-point) + + ;; We update the start point + start-point (if move-to? + cur-point + start-point) + + result (cond-> result + (and (some? prev-point) + (contains? point-set prev-point) + (contains? point-set cur-point)) + + (conj! (-> segment + (assoc :start prev-point) + (assoc :end cur-point) + (assoc :index index))))] + (recur result + cur-point + start-point + (inc index) + (rest content))) + + (persistent! result))))) + +(defn split-segments + "Given a content creates splits commands between points with new segments" + [content points value] + + (let [split-command + (fn [{:keys [command start end index] :as segment}] + (case command + :line-to [index (helpers/split-line-to start segment value)] + :curve-to [index (helpers/split-curve-to start segment value)] + :close-path [index [(helpers/make-line-to (gpt/lerp start end value)) segment]] + nil)) + + segment-changes + (->> (get-segments-with-points content points) + (into {} (keep split-command))) + + process-segments + (fn [[index command]] + (if (contains? segment-changes index) + (get segment-changes index) + [command]))] + + (into [] (mapcat process-segments) (d/enumerate content)))) + +;; FIXME: rename to next-segment +(defn next-node + "Calculates the next-node to be inserted." + [content position prev-point prev-handler] + (let [position (select-keys position [:x :y]) + last-command (-> content last :command) + add-line? (and prev-point (not prev-handler) (not= last-command :close-path)) + add-curve? (and prev-point prev-handler (not= last-command :close-path))] + (cond + add-line? {:command :line-to + :params position} + add-curve? {:command :curve-to + :params (helpers/make-curve-params position prev-handler)} + :else {:command :move-to + :params position}))) +(defn remove-nodes + "Removes from content the points given. Will try to reconstruct the paths + to keep everything consistent" + [content points] + + (if (empty? points) + content + + (let [content (d/with-prev content)] + + (loop [result [] + last-handler nil + [cur-segment prev-segment] (first content) + content (rest content)] + + (if (nil? cur-segment) + ;; The result with be an array of arrays were every entry is a subpath + (->> result + ;; remove empty and only 1 node subpaths + (filter #(> (count %) 1)) + ;; flatten array-of-arrays plain array + (flatten) + (into [])) + + (let [move? (= :move-to (:command cur-segment)) + curve? (= :curve-to (:command cur-segment)) + + ;; When the old command was a move we start a subpath + result (if move? (conj result []) result) + + subpath (peek result) + + point (helpers/segment->point cur-segment) + + old-prev-point (helpers/segment->point prev-segment) + new-prev-point (helpers/segment->point (peek subpath)) + + remove? (contains? points point) + + + ;; We store the first handler for the first curve to be removed to + ;; use it for the first handler of the regenerated path + cur-handler (cond + (and (not last-handler) remove? curve?) + (select-keys (:params cur-segment) [:c1x :c1y]) + + (not remove?) + nil + + :else + last-handler) + + cur-segment (cond-> cur-segment + ;; If we're starting a subpath and it's not a move make it a move + (and (not move?) (empty? subpath)) + (assoc :command :move-to + :params (select-keys (:params cur-segment) [:x :y])) + + ;; If have a curve the first handler will be relative to the previous + ;; point. We change the handler to the new previous point + (and curve? (seq subpath) (not= old-prev-point new-prev-point)) + (update :params merge last-handler)) + + head-idx (dec (count result)) + + result (cond-> result + (not remove?) + (update head-idx conj cur-segment))] + (recur result + cur-handler + (first content) + (rest content)))))))) + +(defn join-nodes + "Creates new segments between points that weren't previously" + [content points] + + (let [segments-set (into #{} + (map (juxt :start :end)) + (get-segments-with-points content points)) + + create-line-command (fn [point other] + [(helpers/make-move-to point) + (helpers/make-line-to other)]) + + not-segment? (fn [point other] (and (not (contains? segments-set [point other])) + (not (contains? segments-set [other point])))) + + new-content (->> (d/map-perm create-line-command not-segment? points) + (flatten) + (into []))] + + (into content new-content))) + + +(defn separate-nodes + "Removes the segments between the points given" + [content points] + + (let [content (d/with-prev content)] + (loop [result [] + [cur-segment prev-segment] (first content) + content (rest content)] + + (if (nil? cur-segment) + (->> result + (filter #(> (count %) 1)) + (flatten) + (into [])) + + (let [prev-point (helpers/segment->point prev-segment) + cur-point (helpers/segment->point cur-segment) + + cur-segment (cond-> cur-segment + (and (contains? points prev-point) + (contains? points cur-point)) + + (assoc :command :move-to + :params (select-keys (:params cur-segment) [:x :y]))) + + move? (= :move-to (:command cur-segment)) + + result (if move? (conj result []) result) + head-idx (dec (count result)) + + result (-> result + (update head-idx conj cur-segment))] + (recur result + (first content) + (rest content))))))) + + +(defn- add-to-set + "Given a list of sets adds the value to the target set" + [set-list target value] + (->> set-list + (mapv (fn [it] + (cond-> it + (= it target) (conj value)))))) + +(defn- join-sets + "Given a list of sets join two sets in the list into a new one" + [set-list target other] + (conj (->> set-list + (filterv #(and (not= % target) + (not= % other)))) + (set/union target other))) + +;; FIXME: revisit impl of this fn +(defn- group-segments [segments] + (loop [result [] + {point-a :start point-b :end :as segment} (first segments) + segments (rest segments)] + + (if (nil? segment) + result + + (let [set-a (d/seek #(contains? % point-a) result) + set-b (d/seek #(contains? % point-b) result) + + result (cond-> result + (and (nil? set-a) (nil? set-b)) + (conj #{point-a point-b}) + + (and (some? set-a) (nil? set-b)) + (add-to-set set-a point-b) + + (and (nil? set-a) (some? set-b)) + (add-to-set set-b point-a) + + (and (some? set-a) (some? set-b) (not= set-a set-b)) + (join-sets set-a set-b))] + (recur result + (first segments) + (rest segments)))))) + +(defn- calculate-merge-points [group-segments points] + (let [index-merge-point (fn [group] (vector group (gpt/center-points group))) + index-group (fn [point] (vector point (d/seek #(contains? % point) group-segments))) + + group->merge-point (into {} (map index-merge-point) group-segments) + point->group (into {} (map index-group) points)] + (d/mapm #(group->merge-point %2) point->group))) + +;; TODO: Improve the replace for curves +(defn- replace-points + "Replaces the points in a path for its merge-point" + [content point->merge-point] + (let [replace-command + (fn [segment] + (let [point (helpers/segment->point segment)] + (if (contains? point->merge-point point) + (let [merge-point (get point->merge-point point)] + (-> segment (update :params assoc :x (:x merge-point) :y (:y merge-point)))) + segment)))] + (->> content + (mapv replace-command)))) + +(defn merge-nodes + "Reduces the contiguous segments in points to a single point" + [content points] + (let [segments (get-segments-with-points content points)] + (if (seq segments) + (let [point->merge-point (-> segments + (group-segments) + (calculate-merge-points points))] + (-> content + (separate-nodes points) + (replace-points point->merge-point))) + content))) + +(defn transform-content + "Applies a transformation matrix over content and returns a new + content as PathData instance." + [content transform] + (if (some? transform) + (impl/-transform content transform) + content)) + +(defn move-content + "Applies a displacement over content and returns a new content as + PathData instance. Implemented in function of `transform-content`." + [content move-vec] + (let [transform (gmt/translate-matrix move-vec)] + (transform-content content transform))) + +(defn calculate-extremities + "Calculate extremities for the provided content" + [content] + (loop [points (transient #{}) + content (not-empty (vec content)) + from-p nil + move-p nil] + (if content + (let [last-p (peek content) + content (if (= :move-to (:command last-p)) + (pop content) + content) + segment (get content 0) + to-p (helpers/segment->point segment)] + + (if segment + (case (:command segment) + :move-to + (recur (conj! points to-p) + (not-empty (subvec content 1)) + to-p + to-p) + + :close-path + (recur (conj! points move-p) + (not-empty (subvec content 1)) + move-p + move-p) + + :line-to + (recur (cond-> points + (and from-p to-p) + (-> (conj! move-p) + (conj! to-p))) + (not-empty (subvec content 1)) + to-p + move-p) + + :curve-to + (let [c1 (helpers/segment->point segment :c1) + c2 (helpers/segment->point segment :c2)] + (recur (if (and from-p to-p c1 c2) + (reduce conj! + (-> points (conj! from-p) (conj! to-p)) + (helpers/calculate-curve-extremities from-p to-p c1 c2)) + points) + + (not-empty (subvec content 1)) + to-p + move-p))) + (persistent! points))) + (persistent! points)))) + +(defn content->selrect + [content] + (let [extremities (calculate-extremities content) + ;; We haven't found any extremes so we turn the commands to points + extremities + (if (empty? extremities) + (->> content (keep helpers/segment->point)) + extremities)] + + ;; If no points are returned we return an empty rect. + (if (d/not-empty? extremities) + (grc/points->rect extremities) + (grc/make-rect)))) + +(defn content-center + [content] + (-> content + content->selrect + grc/rect->center)) + +(defn append-segment + [content segment] + (let [content (cond + (impl/path-data? content) + (vec content) + + (nil? content) + [] + + :else + content)] + (conj content (impl/check-segment segment)))) + +(defn points->content + "Given a vector of points generate a path content. + + Mainly used for generate a path content from user drawing points + using curve drawing tool." + [points & {:keys [close]}] + (let [initial (first points) + point->params + (fn [point] + {:x (dm/get-prop point :x) + :y (dm/get-prop point :y)})] + (loop [points (rest points) + result [{:command :move-to + :params (point->params initial)}]] + (if-let [point (first points)] + (recur (rest points) + (conj result {:command :line-to + :params (point->params point)})) + + (let [result (if close + (conj result {:command :close-path}) + result)] + (impl/from-plain result)))))) diff --git a/common/src/app/common/svg/path/shapes_to_path.cljc b/common/src/app/common/types/path/shape_to_path.cljc similarity index 55% rename from common/src/app/common/svg/path/shapes_to_path.cljc rename to common/src/app/common/types/path/shape_to_path.cljc index 16ab66529e..fc7a07f859 100644 --- a/common/src/app/common/svg/path/shapes_to_path.cljc +++ b/common/src/app/common/types/path/shape_to_path.cljc @@ -4,58 +4,34 @@ ;; ;; Copyright (c) KALEIDOS INC -(ns app.common.svg.path.shapes-to-path +(ns app.common.types.path.shape-to-path (:require - [app.common.colors :as clr] [app.common.data :as d] + [app.common.data.macros :as dm] + [app.common.files.helpers :as cfh] [app.common.geom.matrix :as gmt] [app.common.geom.point :as gpt] [app.common.geom.shapes.common :as gco] [app.common.geom.shapes.corners :as gso] - [app.common.geom.shapes.path :as gsp] - [app.common.svg.path.bool :as pb] - [app.common.svg.path.command :as pc] + [app.common.types.path.bool :as bool] + [app.common.types.path.helpers :as helpers] + [app.common.types.path.impl :as path.impl] + [app.common.types.path.segment :as segm] [app.common.types.shape.radius :as ctsr])) -(def ^:const bezier-circle-c 0.551915024494) +(def ^:const ^:private bezier-circle-c + 0.551915024494) -(def dissoc-attrs +(def ^:private dissoc-attrs [:x :y :width :height :rx :ry :r1 :r2 :r3 :r4 :metadata]) -(def allowed-transform-types - #{:rect - :circle - :image}) +(defn without-position-attrs + [shape] + (d/without-keys shape dissoc-attrs)) -(def style-group-properties - [:shadow - :blur]) - -(def style-properties - (into style-group-properties - [:fill-color - :fill-opacity - :fill-color-gradient - :fill-color-ref-file - :fill-color-ref-id - :fill-image - :fills - :stroke-color - :stroke-color-ref-file - :stroke-color-ref-id - :stroke-opacity - :stroke-style - :stroke-width - :stroke-alignment - :stroke-cap-start - :stroke-cap-end - :strokes])) - -(def default-bool-fills [{:fill-color clr/black}]) - -(defn make-corner-arc +(defn- make-corner-arc "Creates a curvle corner for border radius" [from to corner radius] (let [x (case corner @@ -91,9 +67,9 @@ :bottom-right (assoc to :x c2x) :bottom-left (assoc to :y c2y))] - (pc/make-curve-to to h1 h2))) + (helpers/make-curve-to to h1 h2))) -(defn circle->path +(defn- circle->path "Creates the bezier curves to approximate a circle shape" [{:keys [x y width height]}] (let [mx (+ x (/ width 2)) @@ -112,13 +88,13 @@ c1y (+ y (* (/ height 2) (- 1 c))) c2y (+ y (* (/ height 2) (+ 1 c)))] - [(pc/make-move-to p1) - (pc/make-curve-to p2 (assoc p1 :x c2x) (assoc p2 :y c1y)) - (pc/make-curve-to p3 (assoc p2 :y c2y) (assoc p3 :x c2x)) - (pc/make-curve-to p4 (assoc p3 :x c1x) (assoc p4 :y c2y)) - (pc/make-curve-to p1 (assoc p4 :y c1y) (assoc p1 :x c1x))])) + [(helpers/make-move-to p1) + (helpers/make-curve-to p2 (assoc p1 :x c2x) (assoc p2 :y c1y)) + (helpers/make-curve-to p3 (assoc p2 :y c2y) (assoc p3 :x c2x)) + (helpers/make-curve-to p4 (assoc p3 :x c1x) (assoc p4 :y c2y)) + (helpers/make-curve-to p1 (assoc p4 :y c1y) (assoc p1 :x c1x))])) -(defn draw-rounded-rect-path +(defn- draw-rounded-rect-path ([x y width height r] (draw-rounded-rect-path x y width height r r r r)) @@ -135,21 +111,21 @@ p7 (gpt/point (+ x r4) (+ height y)) p8 (gpt/point x (+ height y (- r4)))] (-> [] - (conj (pc/make-move-to p1)) + (conj (helpers/make-move-to p1)) (cond-> (not= p1 p2) (conj (make-corner-arc p1 p2 :top-left r1))) - (conj (pc/make-line-to p3)) + (conj (helpers/make-line-to p3)) (cond-> (not= p3 p4) (conj (make-corner-arc p3 p4 :top-right r2))) - (conj (pc/make-line-to p5)) + (conj (helpers/make-line-to p5)) (cond-> (not= p5 p6) (conj (make-corner-arc p5 p6 :bottom-right r3))) - (conj (pc/make-line-to p7)) + (conj (helpers/make-line-to p7)) (cond-> (not= p7 p8) (conj (make-corner-arc p7 p8 :bottom-left r4))) - (conj (pc/make-line-to p1)))))) + (conj (helpers/make-line-to p1)))))) -(defn rect->path +(defn- rect->path "Creates a bezier curve that approximates a rounded corner rectangle" [{:keys [x y width height] :as shape}] (case (ctsr/radius-mode shape) @@ -165,7 +141,10 @@ (declare convert-to-path) -(defn fix-first-relative +;; FIXME: this looks unnecesary because penpot already normalizes all +;; path content to be absolute. There are no relative segments on +;; penpot. +(defn- fix-first-relative "Fix an issue with the simplify commands not changing the first relative" [content] (let [head (first content)] @@ -173,17 +152,19 @@ (and head (:relative head)) (update 0 assoc :relative false)))) -(defn group-to-path +(defn- group-to-path [group objects] - (let [xform (comp (map #(get objects %)) - (map #(-> (convert-to-path % objects)))) + (let [xform (comp (map (d/getf objects)) + (map #(convert-to-path % objects))) child-as-paths (into [] xform (:shapes group)) - head (last child-as-paths) - head-data (select-keys head style-properties) + head (peek child-as-paths) + head-data (select-keys head bool/style-properties) content (into [] - (comp (filter #(= :path (:type %))) - (mapcat #(fix-first-relative (:content %)))) + (comp (filter cfh/path-shape?) + (map :content) + (map vec) + (mapcat fix-first-relative)) child-as-paths)] (-> group (assoc :type :path) @@ -191,54 +172,68 @@ (merge head-data) (d/without-keys dissoc-attrs)))) -(defn bool-to-path +(defn- bool-to-path [shape objects] - (let [children (->> (:shapes shape) - (map #(get objects %)) - (map #(convert-to-path % objects))) - bool-type (:bool-type shape) - content (pb/content-bool bool-type (mapv :content children))] + (let [children + (->> (:shapes shape) + (map (d/getf objects)) + (map #(convert-to-path % objects))) + + bool-type + (:bool-type shape) + + content + (bool/calculate-content bool-type (map :content children))] + (-> shape (assoc :type :path) (assoc :content content) + (dissoc :bool-type) (d/without-keys dissoc-attrs)))) (defn convert-to-path - "Transforms the given shape to a path" - ([shape] - (convert-to-path shape {})) - ([{:keys [type metadata] :as shape} objects] - (assert (map? objects)) - (case type - (:group :frame) - (group-to-path shape objects) + "Transforms the given shape to a path shape" + [shape objects] + (assert (map? objects)) + ;; FIXME: add check-objects-like + ;; FIXME: add check-shape ? - :bool - (bool-to-path shape objects) + (let [type (dm/get-prop shape :type)] - (:rect :circle :image :text) - (let [new-content - (case type - :circle (circle->path shape) - #_:else (rect->path shape)) + (case type + (:group :frame) + (group-to-path shape objects) - ;; Apply the transforms that had the shape - transform - (cond-> (:transform shape (gmt/matrix)) - (:flip-x shape) (gmt/scale (gpt/point -1 1)) - (:flip-y shape) (gmt/scale (gpt/point 1 -1))) + :bool + (bool-to-path shape objects) - new-content (cond-> new-content - (some? transform) - (gsp/transform-content (gmt/transform-in (gco/shape->center shape) transform)))] + (:rect :circle :image :text) + (let [content + (if (= type :circle) + (circle->path shape) + (rect->path shape)) - (-> shape - (assoc :type :path) - (assoc :content new-content) - (cond-> (= :image type) - (assoc :fill-image metadata)) - (d/without-keys dissoc-attrs))) + content + (path.impl/from-plain content) - ;; For the rest return the plain shape - shape))) + ;; Apply the transforms that had the shape + transform + (cond-> (:transform shape (gmt/matrix)) + (:flip-x shape) (gmt/scale (gpt/point -1 1)) + (:flip-y shape) (gmt/scale (gpt/point 1 -1))) + + content + (cond-> content + (some? transform) + (segm/transform-content (gmt/transform-in (gco/shape->center shape) transform)))] + + (-> shape + (assoc :type :path) + (assoc :content content) + (cond-> (= :image type) + (assoc :fill-image (get shape :metadata))) + (d/without-keys dissoc-attrs))) + + ;; For the rest return the plain shape + shape))) diff --git a/common/src/app/common/svg/path/subpath.cljc b/common/src/app/common/types/path/subpath.cljc similarity index 88% rename from common/src/app/common/svg/path/subpath.cljc rename to common/src/app/common/types/path/subpath.cljc index d5117f5f84..b7f13a0aea 100644 --- a/common/src/app/common/svg/path/subpath.cljc +++ b/common/src/app/common/types/path/subpath.cljc @@ -4,11 +4,11 @@ ;; ;; Copyright (c) KALEIDOS INC -(ns app.common.svg.path.subpath +(ns app.common.types.path.subpath (:require [app.common.data :as d] [app.common.geom.point :as gpt] - [app.common.svg.path.command :as upc])) + [app.common.types.path.helpers :as helpers])) (defn pt= "Check if two points are close" @@ -18,7 +18,7 @@ (defn make-subpath "Creates a subpath either from a single command or with all the data" ([command] - (let [p (upc/command->point command)] + (let [p (helpers/segment->point command)] (make-subpath p p [command]))) ([from to data] {:from from @@ -29,9 +29,9 @@ "Adds a command to the subpath" [subpath command] (let [command (if (= :close-path (:command command)) - (upc/make-line-to (:from subpath)) + (helpers/make-line-to (:from subpath)) command) - p (upc/command->point command)] + p (helpers/segment->point command)] (-> subpath (assoc :to p) (update :data conj command)))) @@ -62,7 +62,7 @@ result)) new-data (->> subpath :data d/with-prev reverse - (reduce reverse-commands [(upc/make-move-to (:to subpath))]))] + (reduce reverse-commands [(helpers/make-move-to (:to subpath))]))] (make-subpath (:to subpath) (:from subpath) new-data))) @@ -125,6 +125,9 @@ (defn is-closed? [subpath] (pt= (:from subpath) (:to subpath))) +(def ^:private xf-mapcat-data + (mapcat :data)) + (defn close-subpaths "Searches a path for possible subpaths that can create closed loops and merge them" [content] @@ -153,20 +156,17 @@ new-subpaths))) result))] - (->> closed-subpaths - (mapcat :data) - (into [])))) + (into [] xf-mapcat-data closed-subpaths))) + +;; FIXME: revisit this fn impl for perfromance (defn reverse-content "Given a content reverse the order of the commands" [content] - - (->> content - (get-subpaths) + (->> (get-subpaths content) (mapv reverse-subpath) (reverse) - (mapcat :data) - (into []))) + (into [] xf-mapcat-data))) ;; https://mathworld.wolfram.com/PolygonArea.html (defn clockwise? @@ -181,10 +181,10 @@ (if (nil? current) (> signed-area 0) - (let [{x1 :x y1 :y :as p} (upc/command->point current) + (let [{x1 :x y1 :y :as p} (helpers/segment->point current) last? (nil? (first subpath)) first-point (if (nil? first-point) p first-point) - {x2 :x y2 :y} (if last? first-point (upc/command->point (first subpath))) + {x2 :x y2 :y} (if last? first-point (helpers/segment->point (first subpath))) signed-area (+ signed-area (- (* x1 y2) (* x2 y1)))] (recur (first subpath) diff --git a/common/src/app/common/types/shape.cljc b/common/src/app/common/types/shape.cljc index b7d50a1c16..09938b9bac 100644 --- a/common/src/app/common/types/shape.cljc +++ b/common/src/app/common/types/shape.cljc @@ -22,13 +22,14 @@ [app.common.transit :as t] [app.common.types.color :as ctc] [app.common.types.grid :as ctg] + [app.common.types.path :as path] + [app.common.types.path.segment :as path.segment] [app.common.types.plugins :as ctpg] [app.common.types.shape.attrs :refer [default-color]] [app.common.types.shape.blur :as ctsb] [app.common.types.shape.export :as ctse] [app.common.types.shape.interactions :as ctsi] [app.common.types.shape.layout :as ctsl] - [app.common.types.shape.path :as ctsp] [app.common.types.shape.shadow :as ctss] [app.common.types.shape.text :as ctsx] [app.common.types.token :as cto] @@ -234,7 +235,7 @@ [:map {:title "BoolAttrs"} [:shapes [:vector {:gen/max 10 :gen/min 1} ::sm/uuid]] [:bool-type [::sm/one-of bool-types]] - [:content ::ctsp/content]]) + [:content ::path/content]]) (def ^:private schema:rect-attrs [:map {:title "RectAttrs"}]) @@ -259,7 +260,7 @@ (def ^:private schema:path-attrs [:map {:title "PathAttrs"} - [:content ::ctsp/content]]) + [:content ::path/content]]) (def ^:private schema:text-attrs [:map {:title "TextAttrs"} @@ -525,7 +526,7 @@ (defn setup-path [{:keys [content selrect points] :as shape}] (let [selrect (or selrect - (gsh/content->selrect content) + (path.segment/content->selrect content) (grc/make-rect)) points (or points (grc/rect->points selrect))] (-> shape diff --git a/common/src/app/common/types/shape/path.cljc b/common/src/app/common/types/shape/path.cljc deleted file mode 100644 index 8e102c7e0f..0000000000 --- a/common/src/app/common/types/shape/path.cljc +++ /dev/null @@ -1,431 +0,0 @@ -;; This Source Code Form is subject to the terms of the Mozilla Public -;; License, v. 2.0. If a copy of the MPL was not distributed with this -;; file, You can obtain one at http://mozilla.org/MPL/2.0/. -;; -;; Copyright (c) KALEIDOS INC - -(ns app.common.types.shape.path - (:require - [app.common.schema :as sm]) - (:import - #?(:cljs [goog.string StringBuffer] - :clj [java.nio ByteBuffer]))) - -#?(:clj (set! *warn-on-reflection* true)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; SCHEMA: PLAIN FORMAT -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(def schema:line-to-segment - [:map - [:command [:= :line-to]] - [:params - [:map - [:x ::sm/safe-number] - [:y ::sm/safe-number]]]]) - -(def schema:close-path-segment - [:map - [:command [:= :close-path]]]) - -(def schema:move-to-segment - [:map - [:command [:= :move-to]] - [:params - [:map - [:x ::sm/safe-number] - [:y ::sm/safe-number]]]]) - -(def schema:curve-to-segment - [:map - [:command [:= :curve-to]] - [:params - [:map - [:x ::sm/safe-number] - [:y ::sm/safe-number] - [:c1x ::sm/safe-number] - [:c1y ::sm/safe-number] - [:c2x ::sm/safe-number] - [:c2y ::sm/safe-number]]]]) - -(def schema:path-segment - [:multi {:title "PathSegment" - :dispatch :command - :decode/json #(update % :command keyword)} - [:line-to schema:line-to-segment] - [:close-path schema:close-path-segment] - [:move-to schema:move-to-segment] - [:curve-to schema:curve-to-segment]]) - -(def schema:path-content - [:vector schema:path-segment]) - -(def check-path-content - (sm/check-fn schema:path-content)) - -(sm/register! ::segment schema:path-segment) -(sm/register! ::content schema:path-content) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; TYPE: PATH-DATA -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(def ^:const SEGMENT-BYTE-SIZE 28) - -(defprotocol IPathData - (-write-to [_ buffer offset] "write the content to the specified buffer")) - -(defrecord PathSegment [command params]) - -(defn- get-path-string - "Format the path data structure to string" - [buffer size] - (let [builder #?(:clj (java.lang.StringBuilder. (int (* size 4))) - :cljs (StringBuffer.))] - (loop [index 0] - (when (< index size) - (let [offset (* index SEGMENT-BYTE-SIZE) - type #?(:clj (.getShort ^ByteBuffer buffer offset) - :cljs (.getInt16 buffer offset))] - (case (long type) - 1 (let [x #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 20)) - :cljs (.getFloat32 buffer (+ offset 20))) - y #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 24)) - :cljs (.getFloat32 buffer (+ offset 24)))] - (doto builder - (.append "M") - (.append x) - (.append ",") - (.append y))) - 2 (let [x #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 20)) - :cljs (.getFloat32 buffer (+ offset 20))) - y #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 24)) - :cljs (.getFloat32 buffer (+ offset 24)))] - (doto builder - (.append "L") - (.append x) - (.append ",") - (.append y))) - - 3 (let [c1x #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 4)) - :cljs (.getFloat32 buffer (+ offset 4))) - c1y #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 8)) - :cljs (.getFloat32 buffer (+ offset 8))) - c2x #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 12)) - :cljs (.getFloat32 buffer (+ offset 12))) - c2y #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 16)) - :cljs (.getFloat32 buffer (+ offset 16))) - x #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 20)) - :cljs (.getFloat32 buffer (+ offset 20))) - y #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 24)) - :cljs (.getFloat32 buffer (+ offset 24)))] - (doto builder - (.append "C") - (.append c1x) - (.append ",") - (.append c1y) - (.append ",") - (.append c2x) - (.append ",") - (.append c2y) - (.append ",") - (.append x) - (.append ",") - (.append y))) - 4 (doto builder - (.append "Z"))) - (recur (inc index))))) - - (.toString builder))) - -(defn- read-segment - [buffer index] - (let [offset (* index SEGMENT-BYTE-SIZE) - type #?(:clj (.getShort ^ByteBuffer buffer offset) - :cljs (.getInt16 buffer offset))] - (case (long type) - 1 (let [x #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 20)) - :cljs (.getFloat32 buffer (+ offset 20))) - y #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 24)) - :cljs (.getFloat32 buffer (+ offset 24)))] - (->PathSegment :move-to {:x x :y y})) - - 2 (let [x #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 20)) - :cljs (.getFloat32 buffer (+ offset 20))) - y #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 24)) - :cljs (.getFloat32 buffer (+ offset 24)))] - (->PathSegment :line-to {:x x :y y})) - - 3 (let [c1x #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 4)) - :cljs (.getFloat32 buffer (+ offset 4))) - c1y #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 8)) - :cljs (.getFloat32 buffer (+ offset 8))) - c2x #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 12)) - :cljs (.getFloat32 buffer (+ offset 12))) - c2y #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 16)) - :cljs (.getFloat32 buffer (+ offset 16))) - x #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 20)) - :cljs (.getFloat32 buffer (+ offset 20))) - y #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 24)) - :cljs (.getFloat32 buffer (+ offset 24)))] - - (->PathSegment :curve-to {:x x :y y :c1x c1x :c1y c1y :c2x c2x :c2y c2y})) - - 4 (->PathSegment :close-path {})))) - -(defn- in-range? - [size i] - (and (< i size) (>= i 0))) - -#?(:clj - (deftype PathData [size buffer] - Object - (toString [_] - (get-path-string buffer size)) - - clojure.lang.Sequential - clojure.lang.IPersistentCollection - - (empty [_] - (throw (ex-info "not implemented" {}))) - (equiv [_ other] - (if (instance? PathData other) - (.equals ^ByteBuffer buffer (.-buffer ^PathData other)) - false)) - - (seq [this] - (when (pos? size) - (->> (range size) - (map (fn [i] (nth this i)))))) - - (cons [_ _val] - (throw (ex-info "not implemented" {}))) - - clojure.lang.IReduceInit - (reduce [_ f start] - (loop [index 0 - result start] - (if (< index size) - (let [result (f result (read-segment buffer index))] - (if (reduced? result) - @result - (recur (inc index) result))) - result))) - - clojure.lang.Indexed - (nth [_ i] - (if (in-range? size i) - (read-segment buffer i) - nil)) - - (nth [_ i default] - (if (in-range? size i) - (read-segment buffer i) - default)) - - clojure.lang.Counted - (count [_] size)) - - :cljs - (deftype PathData [size buffer dview] - Object - (toString [_] - (get-path-string dview size)) - - IPathData - (-write-to [_ into-buffer offset] - (assert (instance? js/ArrayBuffer into-buffer) "expected an instance of Uint32Array") - (let [size (.-byteLength buffer) - mem (js/Uint32Array. into-buffer offset size)] - (.set mem (js/Uint32Array. buffer)))) - - cljs.core/ISequential - cljs.core/IEquiv - (-equiv [_ other] - (if (instance? PathData other) - (let [obuffer (.-buffer other) - osize (.-byteLength obuffer) - csize (.-byteLength buffer)] - (if (= osize csize) - (let [cb (js/Uint32Array. buffer) - ob (js/Uint32Array. obuffer)] - (loop [i 0] - (if (< i osize) - (if (= (aget ob i) - (aget cb i)) - (recur (inc i)) - false) - true))) - false)) - false)) - - cljs.core/IReduce - (-reduce [_ f] - (loop [index 1 - result (if (pos? size) - (read-segment dview 0) - nil)] - (if (< index size) - (let [result (f result (read-segment dview index))] - (if (reduced? result) - @result - (recur (inc index) result))) - result))) - - (-reduce [_ f start] - (loop [index 0 - result start] - (if (< index size) - (let [result (f result (read-segment dview index))] - (if (reduced? result) - @result - (recur (inc index) result))) - result))) - - cljs.core/IHash - (-hash [_] - (throw (ex-info "not-implemented" {}))) - - cljs.core/ICounted - (-count [_] size) - - cljs.core/IIndexed - (-nth [_ i] - (if (in-range? size i) - (read-segment dview i) - nil)) - - (-nth [_ i default] - (if (in-range? i size) - (read-segment dview i) - default)) - - cljs.core/ISeqable - (-seq [this] - (when (pos? size) - (->> (range size) - (map (fn [i] (cljs.core/-nth this i)))))))) - -(defn- from-bytes - [buffer] - #?(:clj - (cond - (instance? ByteBuffer buffer) - (let [size (.capacity ^ByteBuffer buffer) - count (long (/ size SEGMENT-BYTE-SIZE))] - (PathData. count buffer)) - - (bytes? buffer) - (let [size (alength ^bytes buffer) - count (long (/ size SEGMENT-BYTE-SIZE))] - (PathData. count - (ByteBuffer/wrap buffer))) - - :else - (throw (java.lang.IllegalArgumentException. "invalid data provided"))) - - :cljs - (cond - (instance? js/ArrayBuffer buffer) - (let [size (.-byteLength buffer) - count (long (/ size SEGMENT-BYTE-SIZE))] - (PathData. count - buffer - (js/DataView. buffer))) - - (instance? js/DataView buffer) - (let [dview buffer - buffer (.-buffer dview) - size (.-byteLength buffer) - count (long (/ size SEGMENT-BYTE-SIZE))] - (PathData. count buffer dview)) - - :else - (throw (js/Error. "invalid data provided"))))) - -;; FIXME: consider implementing with reduce -;; FIXME: consider ensure fixed precision for avoid doing it on formatting - -(defn- from-plain - "Create a PathData instance from plain data structures" - [content] - (assert (check-path-content content)) - - (let [content (vec content) - total (count content) - #?@(:cljs [buffer (new js/ArrayBuffer (* total SEGMENT-BYTE-SIZE)) - dview (new js/DataView buffer)] - :clj [buffer (ByteBuffer/allocate (* total SEGMENT-BYTE-SIZE))])] - (loop [index 0] - (when (< index total) - (let [segment (nth content index) - offset (* index SEGMENT-BYTE-SIZE)] - (case (get segment :command) - :move-to - (let [params (get segment :params) - x (float (get params :x)) - y (float (get params :y))] - #?(:clj (.putShort buffer (int offset) (short 1)) - :cljs (.setInt16 dview offset 1)) - #?(:clj (.putFloat buffer (+ offset 20) x) - :cljs (.setFloat32 dview (+ offset 20) x)) - #?(:clj (.putFloat buffer (+ offset 24) y) - :cljs (.setFloat32 dview (+ offset 24) y))) - - :line-to - (let [params (get segment :params) - x (float (get params :x)) - y (float (get params :y))] - #?(:clj (.putShort buffer (int offset) (short 2)) - :cljs (.setInt16 dview offset 2)) - #?(:clj (.putFloat buffer (+ offset 20) x) - :cljs (.setFloat32 dview (+ offset 20) x)) - #?(:clj (.putFloat buffer (+ offset 24) y) - :cljs (.setFloat32 dview (+ offset 24) y))) - - :curve-to - (let [params (get segment :params) - x (float (get params :x)) - y (float (get params :y)) - c1x (float (get params :c1x x)) - c1y (float (get params :c1y y)) - c2x (float (get params :c2x x)) - c2y (float (get params :c2y y))] - - #?(:clj (.putShort buffer (int offset) (short 3)) - :cljs (.setInt16 dview offset 3)) - #?(:clj (.putFloat buffer (+ offset 4) c1x) - :cljs (.setFloat32 dview (+ offset 4) c1x)) - #?(:clj (.putFloat buffer (+ offset 8) c1y) - :cljs (.setFloat32 dview (+ offset 8) c1y)) - #?(:clj (.putFloat buffer (+ offset 12) c2x) - :cljs (.setFloat32 dview (+ offset 12) c2x)) - #?(:clj (.putFloat buffer (+ offset 16) c2y) - :cljs (.setFloat32 dview (+ offset 16) c2y)) - #?(:clj (.putFloat buffer (+ offset 20) x) - :cljs (.setFloat32 dview (+ offset 20) x)) - #?(:clj (.putFloat buffer (+ offset 24) y) - :cljs (.setFloat32 dview (+ offset 24) y))) - - :close-path - #?(:clj (.putShort buffer (int offset) (short 4)) - :cljs (.setInt16 dview offset 4))) - (recur (inc index))))) - - #?(:cljs (from-bytes dview) - :clj (from-bytes buffer)))) - -(defn path-data - "Create an instance of PathData, returns itself if it is already - PathData instance" - [data] - (cond - (instance? PathData data) - data - - (sequential? data) - (from-plain data) - - :else - (from-bytes data))) diff --git a/common/src/app/common/weak_map.cljs b/common/src/app/common/weak_map.cljs new file mode 100644 index 0000000000..ef204974e1 --- /dev/null +++ b/common/src/app/common/weak_map.cljs @@ -0,0 +1,29 @@ +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. +;; +;; Copyright (c) KALEIDOS INC + +(ns app.common.weak-map + "A value based weak-map implementation (CLJS/JS)") + +(deftype ValueWeakMap [^js/Map data ^js/FinalizationRegistry registry] + Object + (clear [_] + (.clear data)) + (delete [_ key] + (.delete data key)) + (get [_ key] + (if-let [ref (.get data key)] + (.deref ^WeakRef ref) + nil)) + (set [_ key val] + (.set data key (js/WeakRef. val)) + (.register registry val key) + nil)) + +(defn create + [] + (let [data (js/Map.) + registry (js/FinalizationRegistry. #(.delete data %))] + (ValueWeakMap. data registry))) diff --git a/common/test/common_tests/geom_shapes_test.cljc b/common/test/common_tests/geom_shapes_test.cljc index 14ecc3fabe..5656b42f48 100644 --- a/common/test/common_tests/geom_shapes_test.cljc +++ b/common/test/common_tests/geom_shapes_test.cljc @@ -14,6 +14,7 @@ [app.common.geom.shapes.transforms :as gsht] [app.common.math :as mth :refer [close?]] [app.common.types.modifiers :as ctm] + [app.common.types.path :as path] [app.common.types.shape :as cts] [clojure.test :as t])) @@ -30,7 +31,7 @@ (if (= type :path) (cts/setup-shape (into {:type :path - :content (:content params default-path)} + :content (path/content (:content params default-path))} params)) (cts/setup-shape (into {:type type diff --git a/common/test/common_tests/runner.cljc b/common/test/common_tests/runner.cljc index c7e502bd51..09c25061e2 100644 --- a/common/test/common_tests/runner.cljc +++ b/common/test/common_tests/runner.cljc @@ -39,9 +39,9 @@ [common-tests.types.absorb-assets-test] [common-tests.types.components-test] [common-tests.types.modifiers-test] + [common-tests.types.path-data-test] [common-tests.types.shape-decode-encode-test] [common-tests.types.shape-interactions-test] - [common-tests.types.shape-path-data-test] [common-tests.types.tokens-lib-test] [common-tests.uuid-test])) @@ -91,5 +91,5 @@ 'common-tests.types.tokens-lib-test 'common-tests.types.components-test 'common-tests.types.absorb-assets-test - 'common-tests.types.shape-path-data-test + 'common-tests.types.path-data-test 'common-tests.uuid-test)) diff --git a/common/test/common_tests/types/path_data_test.cljc b/common/test/common_tests/types/path_data_test.cljc new file mode 100644 index 0000000000..b283dd9f52 --- /dev/null +++ b/common/test/common_tests/types/path_data_test.cljc @@ -0,0 +1,380 @@ +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. +;; +;; Copyright (c) KALEIDOS INC + +(ns common-tests.types.path-data-test + (:require + #?(:clj [app.common.fressian :as fres]) + [app.common.data :as d] + [app.common.geom.matrix :as gmt] + [app.common.geom.point :as gpt] + [app.common.math :as mth] + [app.common.pprint :as pp] + [app.common.transit :as trans] + [app.common.types.path :as path] + [app.common.types.path.helpers :as path.helpers] + [app.common.types.path.impl :as path.impl] + [app.common.types.path.segment :as path.segment] + [clojure.test :as t])) + +(def sample-content + [{:command :move-to :params {:x 480.0 :y 839.0}} + {:command :line-to :params {:x 439.0 :y 802.0}} + {:command :curve-to :params {:c1x 368.0 :c1y 737.0 :c2x 310.0 :c2y 681.0 :x 264.0 :y 634.0}} + {:command :close-path :params {}}]) + +(def sample-content-large + [{:command :move-to :params {:x 480.0 :y 839.0}} + {:command :line-to :params {:x 439.0 :y 802.0}} + {:command :curve-to :params {:c1x 368.0 :c1y 737.0 :c2x 310.0 :c2y 681.0 :x 264.0 :y 634.0}} + {:command :curve-to :params {:c1x 218.0 :c1y 587.0 :c2x 181.0 :c2y 545.0 :x 154.0 :y 508.0}} + {:command :curve-to :params {:c1x 126.0 :c1y 471.0 :c2x 107.0 :c2y 438.0 :x 96.0 :y 408.0}} + {:command :curve-to :params {:c1x 85.0 :c1y 378.0 :c2x 80.0 :c2y 347.0 :x 80.0 :y 317.0}} + {:command :curve-to :params {:c1x 80.0 :c1y 256.0 :c2x 100.0 :c2y 206.0 :x 140.0 :y 166.0}} + {:command :curve-to :params {:c1x 180.0 :c1y 126.0 :c2x 230.0 :c2y 106.0 :x 290.0 :y 106.0}} + {:command :curve-to :params {:c1x 328.0 :c1y 106.0 :c2x 363.0 :c2y 115.0 :x 395.0 :y 133.0}} + {:command :curve-to :params {:c1x 427.0 :c1y 151.0 :c2x 456.0 :c2y 177.0 :x 480.0 :y 211.0}} + {:command :curve-to :params {:c1x 508.0 :c1y 175.0 :c2x 537.0 :c2y 148.0 :x 569.0 :y 131.0}} + {:command :curve-to :params {:c1x 600.0 :c1y 114.0 :c2x 634.0 :c2y 106.0 :x 670.0 :y 106.0}} + {:command :curve-to :params {:c1x 729.0 :c1y 106.0 :c2x 779.0 :c2y 126.0 :x 819.0 :y 166.0}} + {:command :curve-to :params {:c1x 859.0 :c1y 206.0 :c2x 880.0 :c2y 256.0 :x 880.0 :y 317.0}} + {:command :curve-to :params {:c1x 880.0 :c1y 347.0 :c2x 874.0 :c2y 378.0 :x 863.0 :y 408.0}} + {:command :curve-to :params {:c1x 852.0 :c1y 438.0 :c2x 833.0 :c2y 471.0 :x 806.0 :y 508.0}} + {:command :curve-to :params {:c1x 778.0 :c1y 545.0 :c2x 741.0 :c2y 587.0 :x 695.0 :y 634.0}} + {:command :curve-to :params {:c1x 649.0 :c1y 681.0 :c2x 591.0 :c2y 737.0 :x 521.0 :y 802.0}} + {:command :line-to :params {:x 480.0 :y 839.0}} + {:command :close-path :params {}} + {:command :move-to :params {:x 480.0 :y 760.0}} + {:command :curve-to :params {:c1x 547.0 :c1y 698.0 :c2x 603.0 :c2y 644.0 :x 646.0 :y 600.0}} + {:command :curve-to :params {:c1x 690.0 :c1y 556.0 :c2x 724.0 :c2y 517.0 :x 750.0 :y 484.0}} + {:command :curve-to :params {:c1x 776.0 :c1y 450.0 :c2x 794.0 :c2y 420.0 :x 804.0 :y 394.0}} + {:command :curve-to :params {:c1x 814.0 :c1y 368.0 :c2x 820.0 :c2y 342.0 :x 820.0 :y 317.0}} + {:command :curve-to :params {:c1x 820.0 :c1y 273.0 :c2x 806.0 :c2y 236.0 :x 778.0 :y 2085.0}} + {:command :curve-to :params {:c1x 750.0 :c1y 180.0 :c2x 714.0 :c2y 166.0 :x 670.0 :y 1660.0}} + {:command :curve-to :params {:c1x 635.0 :c1y 166.0 :c2x 604.0 :c2y 176.0 :x 574.0 :y 1975.0}} + {:command :curve-to :params {:c1x 545.0 :c1y 218.0 :c2x 522.0 :c2y 248.0 :x 504.0 :y 2860.0}} + {:command :line-to :params {:x 455.0 :y 286.0}} + {:command :curve-to :params {:c1x 437.0 :c1y 248.0 :c2x 414.0 :c2y 219.0 :x 385.0 :y 198.0}} + {:command :curve-to :params {:c1x 355.0 :c1y 176.0 :c2x 324.0 :c2y 166.0 :x 289.0 :y 166.0}} + {:command :curve-to :params {:c1x 245.0 :c1y 166.0 :c2x 210.0 :c2y 180.0 :x 182.0 :y 208.0}} + {:command :curve-to :params {:c1x 154.0 :c1y 236.0 :c2x 140.0 :c2y 273.0 :x 140.0 :y 317.0}} + {:command :curve-to :params {:c1x 140.0 :c1y 343.0 :c2x 145.0 :c2y 369.0 :x 155.0 :y 395.0}} + {:command :curve-to :params {:c1x 165.0 :c1y 421.0 :c2x 183.0 :c2y 451.0 :x 209.0 :y 485.0}} + {:command :curve-to :params {:c1x 235.0 :c1y 519.0 :c2x 270.0 :c2y 558.0 :x 314.0 :y 602.0}} + {:command :curve-to :params {:c1x 358.0 :c1y 646.0 :c2x 413.0 :c2y 698.0 :x 480.0 :y 760.0}} + {:command :close-path :params {}} + {:command :move-to :params {:x 480.0 :y 463.0}} + {:command :close-path :params {}}]) + +(def sample-bytes + [1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 -16 67 0 -64 81 68 + 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 -128 -37 67 0 -128 72 68 + 3 0 0 0 0 0 -72 67 0 64 56 68 0 0 -101 67 0 64 42 68 0 0 -124 67 0 -128 30 68 + 4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]) + +;; This means it implements IReduceInit/IReduce protocols +(t/deftest path-data-to-vector + (let [pdata (path/content sample-content) + result (vec pdata)] + (t/is (= 4 (count result))) + (t/is (= (get-in sample-content [0 :command]) + (get-in result [0 :command]))) + (t/is (= (get-in sample-content [1 :command]) + (get-in result [1 :command]))) + (t/is (= (get-in sample-content [2 :command]) + (get-in result [2 :command]))) + (t/is (= (get-in sample-content [3 :command]) + (get-in result [3 :command]))) + + (t/is (= (get-in sample-content [0 :params]) + (get-in result [0 :params]))) + (t/is (= (get-in sample-content [1 :params]) + (get-in result [1 :params]))) + (t/is (= (get-in sample-content [2 :params]) + (get-in result [2 :params]))) + (t/is (= (get-in sample-content [3 :params]) + (get-in result [3 :params]))))) + +(t/deftest path-data-plain-to-binary + (let [pdata (path/content sample-content)] + (t/is (= sample-bytes + (vec + #?(:cljs (js/Int8Array. (.-buffer pdata)) + :clj (.array (.-buffer pdata)))))) + (t/is (= sample-content + (vec pdata))))) + +(t/deftest path-data-from-binary + (let [barray #?(:clj (byte-array sample-bytes) + :cljs (js/Int8Array.from sample-bytes)) + content (path/from-bytes barray)] + + (t/is (= (vec content) sample-content)))) + +(t/deftest path-data-transit-roundtrip + (let [pdata (path/content sample-content) + result1 (trans/encode-str pdata) + expected (str "[\"~#penpot/path-data\",\"~bAQAAAAAAAAAAAAA" + "AAAAAAAAAAAAAAPBDAMBRRAIAAAAAAAAAAAAAAAAAAA" + "AAAAAAAIDbQwCASEQDAAAAAAC4QwBAOEQAAJtDAEAqR" + "AAAhEMAgB5EBAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" + "AAAAAA==\"]") + result2 (trans/decode-str result1)] + (t/is (= expected result1)) + (t/is (= pdata result2)))) + +#?(:clj + (t/deftest path-data-fresian + (let [pdata (path/content sample-content) + result1 (fres/encode pdata) + result2 (fres/decode result1)] + (t/is (= pdata result2))))) + +(defn- transform-plain-content + "Apply a transformation to a path content; + + This is a copy of previous impl, that uses plain format to calculate + the new transformed path content" + [content transform] + (let [set-tr + (fn [params px py] + (let [tr-point (-> (gpt/point (get params px) (get params py)) + (gpt/transform transform))] + (assoc params + px (:x tr-point) + py (:y tr-point)))) + + transform-params + (fn [{:keys [x c1x c2x] :as params}] + (cond-> params + (some? x) (set-tr :x :y) + (some? c1x) (set-tr :c1x :c1y) + (some? c2x) (set-tr :c2x :c2y)))] + + (into [] + (map #(update % :params transform-params)) + content))) + +(t/deftest path-transform-1 + (let [matrix (gmt/translate-matrix 10 10) + content (path/content sample-content) + + result1 (path/transform-content content matrix) + result2 (transform-plain-content sample-content matrix) + result3 (transform-plain-content content matrix)] + + (t/is (= (vec result1) result2)) + (t/is (= result2 result3)))) + +(t/deftest path-transform-2 + (let [matrix (gmt/translate-matrix 10 10) + content (path/content sample-content-large) + + result1 (path/transform-content content matrix) + result2 (transform-plain-content sample-content-large matrix) + result3 (transform-plain-content content matrix)] + + (t/is (= (vec result1) result2)) + (t/is (= result2 result3)))) + +(defn- content->points + "Given a content return all points. + + Legacy impl preserved for tests purposes" + [content] + (letfn [(segment->point [seg] + (let [params (get seg :params) + x (get params :x) + y (get params :y)] + (when (d/num? x y) + (gpt/point x y))))] + (some->> (seq content) + (into [] (keep segment->point))))) + +(t/deftest path-get-points + (let [content (path/content sample-content-large) + + result1 (content->points content) + result2 (content->points sample-content-large) + result3 (path.segment/get-points content)] + + (t/is (= result1 result2)) + (t/is (= result2 result3)))) + +(defn calculate-extremities + "Calculate extremities for the provided content. + A legacy implementation used mainly as reference for testing" + [content] + (loop [points #{} + from-p nil + move-p nil + content (seq content)] + (if content + (let [last-p (last content) + content (if (= :move-to (:command last-p)) + (butlast content) + content) + command (first content) + to-p (path.helpers/segment->point command) + + [from-p move-p command-pts] + (case (:command command) + :move-to [to-p to-p (when to-p [to-p])] + :close-path [move-p move-p (when move-p [move-p])] + :line-to [to-p move-p (when (and from-p to-p) [from-p to-p])] + :curve-to [to-p move-p + (let [c1 (path.helpers/segment->point command :c1) + c2 (path.helpers/segment->point command :c2) + curve [from-p to-p c1 c2]] + (when (and from-p to-p c1 c2) + (into [from-p to-p] + (->> (path.helpers/curve-extremities curve) + (map #(path.helpers/curve-values curve %))))))] + [to-p move-p []])] + + (recur (apply conj points command-pts) from-p move-p (next content))) + points))) + +(t/deftest extremities-1 + (let [pdata (path/content sample-content) + result1 (calculate-extremities sample-content) + result2 (calculate-extremities pdata) + result3 (path.segment/calculate-extremities sample-content) + result4 (path.segment/calculate-extremities pdata) + expect #{(gpt/point 480.0 839.0) + (gpt/point 439.0 802.0) + (gpt/point 264.0 634.0)} + n-iter 100000] + + (t/is (= result1 result3)) + (t/is (= result1 expect)) + (t/is (= result2 expect)) + (t/is (= result3 expect)) + (t/is (= result4 expect)))) + +(def sample-content-2 + [{:command :move-to, :params {:x 480.0, :y 839.0}} + {:command :line-to, :params {:x 439.0, :y 802.0}} + {:command :curve-to, :params {:c1x 368.0, :c1y 737.0, :c2x 310.0, :c2y 681.0, :x 4.0, :y 4.0}} + {:command :curve-to, :params {:c1x 3.0, :c1y 7.0, :c2x 30.0, :c2y -68.0, :x 20.0, :y 20.0}} + {:command :close-path :params {}}]) + +(t/deftest extremities-2 + (let [result1 (path.segment/calculate-extremities sample-content-2) + result2 (calculate-extremities sample-content-2)] + (t/is (= result1 result2)))) + +(t/deftest extremities-3 + (let [segments [{:command :move-to, :params {:x -310.5355224609375, :y 452.62115478515625}}] + content (path/content segments) + result1 (calculate-extremities segments) + result2 (path.segment/calculate-extremities segments) + result3 (path.segment/calculate-extremities content) + expect #{}] + (t/is (= result1 expect)) + (t/is (= result1 expect)) + (t/is (= result2 expect)) + (t/is (= result3 expect)))) + +(def sample-content-square + [{:command :move-to, :params {:x 0, :y 0}} + {:command :line-to, :params {:x 10, :y 0}} + {:command :line-to, :params {:x 10, :y 10}} + {:command :line-to, :params {:x 10, :y 0}} + {:command :line-to, :params {:x 0, :y 10}} + {:command :line-to, :params {:x 0, :y 0}} + {:command :close-path :params {}}]) + +(t/deftest points-to-content + (let [initial [(gpt/point 0.0 0.0) + (gpt/point 10.0 10.0) + (gpt/point 10.0 5.0)] + content (path.segment/points->content initial) + segments (vec content)] + (t/is (= 3 (count segments))) + (t/is (= {:command :move-to, :params {:x 0.0, :y 0.0}} (nth segments 0))) + (t/is (= {:command :line-to, :params {:x 10.0, :y 10.0}} (nth segments 1))) + (t/is (= {:command :line-to, :params {:x 10.0, :y 5.0}} (nth segments 2))))) + +(t/deftest get-segments + (let [content (path/content sample-content-square) + points #{(gpt/point 10.0 0.0) + (gpt/point 0.0 0.0)} + result (path.segment/get-segments-with-points content points) + expect [{:command :line-to, + :params {:x 10.0, :y 0.0}, + :start (gpt/point 0.0 0.0) + :end (gpt/point 10.0 0.0) + :index 1} + {:command :close-path, + :params {}, + :start (gpt/point 0.0 0.0) + :end (gpt/point 0.0 0.0) + :index 6}]] + + (t/is (= result expect)))) + +(defn handler->point + "A legacy impl of handler point, used as reference for test" + [content index prefix] + (when (and (some? index) + (some? prefix)) + (when (and (<= 0 index) + (< index (count content))) + (let [segment (nth content index) + params (get segment :params)] + (if (= :curve-to (:command segment)) + (let [[cx cy] (path.helpers/prefix->coords prefix)] + (gpt/point (get params cx) + (get params cy))) + (gpt/point (get params :x) + (get params :y))))))) + +(t/deftest handler-to-point + (let [content (path/content sample-content-2) + result1 (handler->point content 3 :c1) + result2 (handler->point content 1 :c1) + result3 (handler->point content 0 :c1) + + expect1 (gpt/point 3.0 7.0) + expect2 (gpt/point 439.0 802.0) + expect3 (gpt/point 480.0 839.0) + + result4 (path.segment/get-handler-point content 3 :c1) + result5 (path.segment/get-handler-point content 1 :c1) + result6 (path.segment/get-handler-point content 0 :c1)] + + (t/is (= result1 expect1)) + (t/is (= result2 expect2)) + (t/is (= result3 expect3)) + (t/is (= result4 expect1)) + (t/is (= result5 expect2)) + (t/is (= result6 expect3)))) + +(defn get-handlers + "Retrieve a map where for every point will retrieve a list of + the handlers that are associated with that point. + point -> [[index, prefix]]. + + Legacy impl" + [content] + (->> (d/with-prev content) + (d/enumerate) + (mapcat (fn [[index [cur-segment pre-segment]]] + (if (and pre-segment (= :curve-to (:command cur-segment))) + (let [cur-pos (path.helpers/segment->point cur-segment) + pre-pos (path.helpers/segment->point pre-segment)] + (-> [[pre-pos [index :c1]] + [cur-pos [index :c2]]])) + []))) + + (group-by first) + (d/mapm #(mapv second %2)))) + +(t/deftest content-to-handlers + (let [content (path/content sample-content-large) + result1 (get-handlers sample-content-large) + result2 (path.segment/get-handlers content)] + (t/is (= result1 result2)))) diff --git a/common/test/common_tests/types/shape_decode_encode_test.cljc b/common/test/common_tests/types/shape_decode_encode_test.cljc index 49ca275993..c14f03d056 100644 --- a/common/test/common_tests/types/shape_decode_encode_test.cljc +++ b/common/test/common_tests/types/shape_decode_encode_test.cljc @@ -12,10 +12,10 @@ [app.common.schema.generators :as sg] [app.common.schema.test :as smt] [app.common.types.color :refer [schema:color schema:gradient]] + [app.common.types.path :as path] [app.common.types.plugins :refer [schema:plugin-data]] [app.common.types.shape :as tsh] [app.common.types.shape.interactions :refer [schema:animation schema:interaction]] - [app.common.types.shape.path :refer [schema:path-content]] [app.common.types.shape.shadow :refer [schema:shadow]] [app.common.uuid :as uuid] [clojure.test :as t])) @@ -112,17 +112,14 @@ (= interaction interaction-3))) {:num 500}))) - (t/deftest shape-path-content-json-roundtrip - (let [encode (sm/encoder schema:path-content (sm/json-transformer)) - decode (sm/decoder schema:path-content (sm/json-transformer))] + (let [encode (sm/encoder ::path/content (sm/json-transformer)) + decode (sm/decoder ::path/content (sm/json-transformer))] (smt/check! - (smt/for [path-content (sg/generator schema:path-content)] + (smt/for [path-content (sg/generator ::path/content)] (let [path-content-1 (encode path-content) path-content-2 (json-roundtrip path-content-1) path-content-3 (decode path-content-2)] - ;; (app.common.pprint/pprint path-content) - ;; (app.common.pprint/pprint path-content-3) (= path-content path-content-3))) {:num 500}))) diff --git a/common/test/common_tests/types/shape_path_data_test.cljc b/common/test/common_tests/types/shape_path_data_test.cljc deleted file mode 100644 index 79430e883f..0000000000 --- a/common/test/common_tests/types/shape_path_data_test.cljc +++ /dev/null @@ -1,59 +0,0 @@ -;; This Source Code Form is subject to the terms of the Mozilla Public -;; License, v. 2.0. If a copy of the MPL was not distributed with this -;; file, You can obtain one at http://mozilla.org/MPL/2.0/. -;; -;; Copyright (c) KALEIDOS INC - -(ns common-tests.types.shape-path-data-test - (:require - [app.common.data :as d] - [app.common.math :as mth] - [app.common.pprint :as pp] - [app.common.types.shape.path :as path] - [clojure.test :as t])) - -(def sample-content - [{:command :move-to, :params {:x 480.0, :y 839.0}} - {:command :line-to, :params {:x 439.0, :y 802.0}} - {:command :curve-to, :params {:c1x 368.0, :c1y 737.0, :c2x 310.0, :c2y 681.0, :x 264.0, :y 634.0}} - {:command :close-path :params {}}]) - -(def sample-bytes - [0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 67 -16 0 0 68 81 -64 0 - 0 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 67 -37 -128 0 68 72 -128 0 - 0 3 0 0 67 -72 0 0 68 56 64 0 67 -101 0 0 68 42 64 0 67 -124 0 0 68 30 -128 0 - 0 4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]) - -;; This means it implements IReduceInit/IReduce protocols -(t/deftest path-data-to-vector - (let [pdata (path/path-data sample-content) - result (vec pdata)] - (t/is (= 4 (count result))) - (t/is (= (get-in sample-content [0 :command]) - (get-in result [0 :command]))) - (t/is (= (get-in sample-content [1 :command]) - (get-in result [1 :command]))) - (t/is (= (get-in sample-content [2 :command]) - (get-in result [2 :command]))) - (t/is (= (get-in sample-content [3 :command]) - (get-in result [3 :command]))) - - (t/is (= (get-in sample-content [0 :params]) - (get-in result [0 :params]))) - (t/is (= (get-in sample-content [1 :params]) - (get-in result [1 :params]))) - (t/is (= (get-in sample-content [2 :params]) - (get-in result [2 :params]))) - (t/is (= (get-in sample-content [3 :params]) - (get-in result [3 :params]))))) - -(t/deftest path-data-plain-to-binary - (let [pdata (path/path-data sample-content)] - (t/is (= sample-bytes - (vec - #?(:cljs (js/Int8Array. (.-buffer pdata)) - :clj (.array (.-buffer pdata)))))) - (t/is (= (->> sample-content - (mapv path/map->PathSegment)) - (vec pdata))))) - diff --git a/frontend/playwright/data/workspace/get-file-copy-paste-fragment.json b/frontend/playwright/data/workspace/get-file-copy-paste-fragment.json index 8883624339..2cb2ea90a6 100644 --- a/frontend/playwright/data/workspace/get-file-copy-paste-fragment.json +++ b/frontend/playwright/data/workspace/get-file-copy-paste-fragment.json @@ -448,55 +448,7 @@ }, "~:rotation": 0, "~:grow-type": "~:fixed", - "~:content": [ - { - "~:command": "~:move-to", - "~:params": { - "~:x": 1121, - "~:y": 554 - } - }, - { - "~:command": "~:line-to", - "~:params": { - "~:x": 1229, - "~:y": 458 - } - }, - { - "~:command": "~:curve-to", - "~:params": { - "~:x": 1303, - "~:y": 518, - "~:c1x": 1229, - "~:c1y": 458, - "~:c2x": 1320, - "~:c2y": 492 - } - }, - { - "~:command": "~:curve-to", - "~:params": { - "~:x": 1219, - "~:y": 584, - "~:c1x": 1286, - "~:c1y": 544, - "~:c2x": 1258, - "~:c2y": 572 - } - }, - { - "~:command": "~:curve-to", - "~:params": { - "~:x": 1121, - "~:y": 554, - "~:c1x": 1180, - "~:c1y": 596, - "~:c2x": 1121, - "~:c2y": 554 - } - } - ], + "~:content": ["~#penpot/path-data","~bAQAAAAAAAAAAAAAAAAAAAAAAAAAAIIxEAIAKRAIAAAAAAAAAAAAAAAAAAAAAAAAAAKCZRAAA5UMDAAAAAKCZRAAA5UMAAKVEAAD2QwDgokQAgAFEAwAAAADAoEQAAAhEAECdRAAAD0QAYJhEAAASRAMAAAAAgJNEAAAVRAAgjEQAgApEACCMRACACkQ="], "~:name": "Path", "~:width": null, "~:type": "~:path", diff --git a/frontend/src/app/main/data/helpers.cljs b/frontend/src/app/main/data/helpers.cljs index 279e3e0b25..1fd4c1bd92 100644 --- a/frontend/src/app/main/data/helpers.cljs +++ b/frontend/src/app/main/data/helpers.cljs @@ -11,7 +11,7 @@ [app.common.files.helpers :as cfh] [app.common.geom.point :as gpt] [app.common.geom.shapes :as gsh] - [app.common.svg.path.command :as upc])) + [app.common.types.path :as path])) (defn lookup-profile ([state] @@ -157,7 +157,7 @@ shape) modifiers (dm/get-in content-modifiers [id :content-modifiers]) shape (if (some? modifiers) - (update shape :content upc/apply-content-modifiers modifiers) + (update shape :content path/apply-content-modifiers modifiers) shape)] (assoc result id shape)) result)) diff --git a/frontend/src/app/main/data/workspace.cljs b/frontend/src/app/main/data/workspace.cljs index 8817dafd93..d380e7bbea 100644 --- a/frontend/src/app/main/data/workspace.cljs +++ b/frontend/src/app/main/data/workspace.cljs @@ -975,9 +975,29 @@ ptk/WatchEvent (watch [_ state _] (let [selected (dsh/lookup-selected state) - objects (dsh/lookup-page-objects state)] + objects (dsh/lookup-page-objects state)] - (if (> (count selected) 1) + (condp = (count selected) + 0 (rx/empty) + 1 (let [{:keys [id type] :as shape} (get objects (first selected))] + (case type + :text + (rx/of (dwe/start-edition-mode id)) + + (:group :bool :frame) + (let [shapes-ids (into (d/ordered-set) (get shape :shapes))] + (rx/of (dws/select-shapes shapes-ids))) + + :svg-raw + nil + + (rx/of (dwe/start-edition-mode id) + (dwdp/start-path-edit id)))) + + ;; When we have multiple shapes selected, instead of enter + ;; on the edition mode, we proceed to select all children of + ;; the selected shapes. Because we can't enter on edition + ;; mode on multiple shapes and this is a fallback operation. (let [shapes-to-select (->> selected (reduce @@ -987,23 +1007,7 @@ (conj result shape-id) (into result children)))) (d/ordered-set)))] - (rx/of (dws/select-shapes shapes-to-select))) - - (when (d/not-empty? selected) - (let [{:keys [id type shapes]} (get objects (first selected))] - (case type - :text - (rx/of (dwe/start-edition-mode id)) - - (:group :bool :frame) - (let [shapes-ids (into (d/ordered-set) shapes)] - (rx/of (dws/select-shapes shapes-ids))) - - :svg-raw - nil - - (rx/of (dwe/start-edition-mode id) - (dwdp/start-path-edit id)))))))))) + (rx/of (dws/select-shapes shapes-to-select)))))))) (defn select-parent-layer [] diff --git a/frontend/src/app/main/data/workspace/bool.cljs b/frontend/src/app/main/data/workspace/bool.cljs index e5228cc506..858239b75d 100644 --- a/frontend/src/app/main/data/workspace/bool.cljs +++ b/frontend/src/app/main/data/workspace/bool.cljs @@ -10,9 +10,10 @@ [app.common.files.changes-builder :as pcb] [app.common.files.helpers :as cph] [app.common.geom.shapes :as gsh] - [app.common.svg.path.shapes-to-path :as stp] [app.common.types.component :as ctc] [app.common.types.container :as ctn] + [app.common.types.path :as path] + [app.common.types.path.bool :as bool] [app.common.types.shape :as cts] [app.common.types.shape.layout :as ctl] [app.common.uuid :as uuid] @@ -24,130 +25,139 @@ [cuerdas.core :as str] [potok.v2.core :as ptk])) -(defn selected-shapes-idx - [state] - (let [objects (dsh/lookup-page-objects state)] - (->> (dsh/lookup-selected state) - (cph/clean-loops objects)))) +(defn- create-bool-shape + [id type name shapes objects] + (let [shape-id + (or id (uuid/next)) -(defn create-bool-data - [bool-type name shapes objects] - (let [shapes (mapv #(stp/convert-to-path % objects) shapes) - head (if (= bool-type :difference) (first shapes) (last shapes)) - head (cond-> head - (and (contains? head :svg-attrs) (empty? (:fills head))) - (assoc :fills stp/default-bool-fills)) + shapes + (mapv #(path/convert-to-path % objects) shapes) - head-data (select-keys head stp/style-properties) + head + (if (= type :difference) (first shapes) (last shapes)) - bool-shape - (-> {:id (uuid/next) - :type :bool - :bool-type bool-type - :frame-id (:frame-id head) - :parent-id (:parent-id head) - :name name - :shapes (->> shapes (mapv :id))} - (merge head-data) + head + (cond-> head + (and (contains? head :svg-attrs) (empty? (:fills head))) + (assoc :fills bool/default-fills)) + + shape + {:id shape-id + :type :bool + :bool-type type + :frame-id (:frame-id head) + :parent-id (:parent-id head) + :name name + :shapes (mapv :id shapes)} + + shape + (-> shape + (merge (select-keys head bool/style-properties)) (cts/setup-shape) - (gsh/update-bool-selrect shapes objects))] + (gsh/update-bool shapes objects))] - [bool-shape (cph/get-position-on-parent objects (:id head))])) + [shape (cph/get-position-on-parent objects (:id head))])) + +(defn create-bool + [type & {:keys [ids force-shape-id]}] + + (assert (or (nil? ids) (every? uuid? ids))) + + (ptk/reify ::create-bool-union + ptk/WatchEvent + (watch [it state _] + (let [page-id (:current-page-id state) + objects (dsh/lookup-page-objects state page-id) + + name + (-> type d/name str/capital) + + ids + (->> (or ids (dsh/lookup-selected state)) + (cph/clean-loops objects)) + + xform + (comp + (map (d/getf objects)) + (remove cph/frame-shape?) + (remove ctc/is-variant?) + (remove #(ctn/has-any-copy-parent? objects %))) + + shapes + (->> (cph/order-by-indexed-shapes objects ids) + (into [] xform) + (not-empty))] + + (when shapes + (let [[shape index] + (create-bool-shape force-shape-id type name (reverse shapes) objects) + + shape-id + (get shape :id) + + changes + (-> (pcb/empty-changes it page-id) + (pcb/with-objects objects) + (pcb/add-object shape {:index (inc index)}) + (pcb/update-shapes (map :id shapes) ctl/remove-layout-item-data) + (pcb/change-parent shape-id shapes))] + + (rx/of (dch/commit-changes changes) + (dws/select-shapes (d/ordered-set shape-id))))))))) (defn group->bool - [group bool-type objects] - + [type group objects] (let [shapes (->> (:shapes group) (map #(get objects %)) - (mapv #(stp/convert-to-path % objects))) - head (if (= bool-type :difference) (first shapes) (last shapes)) + (mapv #(path/convert-to-path % objects))) + head (if (= type :difference) (first shapes) (last shapes)) head (cond-> head (and (contains? head :svg-attrs) (empty? (:fills head))) - (assoc :fills stp/default-bool-fills)) - head-data (select-keys head stp/style-properties)] + (assoc :fills bool/default-fills)) + head-data (select-keys head bool/style-properties)] (-> group (assoc :type :bool) - (assoc :bool-type bool-type) + (assoc :bool-type type) (merge head-data) - (gsh/update-bool-selrect shapes objects)))) - -(defn bool->group - [shape objects] - - (let [children (->> (:shapes shape) - (mapv #(get objects %)))] - (-> shape - (assoc :type :group) - (dissoc :bool-type) - (d/without-keys stp/style-group-properties) - (gsh/update-group-selrect children)))) - -(defn create-bool - ([bool-type] - (create-bool bool-type nil nil)) - ([bool-type ids {:keys [id-ret]}] - (assert (or (nil? ids) (set? ids))) - (ptk/reify ::create-bool-union - ptk/WatchEvent - (watch [it state _] - (let [page-id (:current-page-id state) - objects (dsh/lookup-page-objects state) - name (-> bool-type d/name str/capital) - ids (->> (or ids (dsh/lookup-selected state)) - (cph/clean-loops objects)) - ordered-indexes (cph/order-by-indexed-shapes objects ids) - shapes (->> ordered-indexes - (map (d/getf objects)) - (remove cph/frame-shape?) - (remove ctc/is-variant?) - (remove #(ctn/has-any-copy-parent? objects %)))] - - (when-not (empty? shapes) - (let [[boolean-data index] (create-bool-data bool-type name (reverse shapes) objects) - index (inc index) - shape-id (:id boolean-data) - changes (-> (pcb/empty-changes it page-id) - (pcb/with-objects objects) - (pcb/add-object boolean-data {:index index}) - (pcb/update-shapes (map :id shapes) ctl/remove-layout-item-data) - (pcb/change-parent shape-id shapes))] - (when id-ret - (reset! id-ret shape-id)) - - (rx/of (dch/commit-changes changes) - (dws/select-shapes (d/ordered-set shape-id)))))))))) + (gsh/update-bool shapes objects)))) (defn group-to-bool - [shape-id bool-type] + [shape-id type] (ptk/reify ::group-to-bool ptk/WatchEvent (watch [_ state _] - (let [objects (dsh/lookup-page-objects state) - change-to-bool - (fn [shape] (group->bool shape bool-type objects))] + (let [objects (dsh/lookup-page-objects state) + update-fn (partial group->bool type)] (when-not (ctn/has-any-copy-parent? objects (get objects shape-id)) - (rx/of (dwsh/update-shapes [shape-id] change-to-bool {:reg-objects? true}))))))) + (rx/of (dwsh/update-shapes [shape-id] update-fn {:with-objects? true :reg-objects? true}))))))) + +(defn- bool->group + [shape objects] + (-> shape + (assoc :type :group) + (dissoc :bool-type) + (d/without-keys bool/style-group-properties) + (gsh/update-group-selrect + (mapv (d/getf objects) + (:shapes shape))))) (defn bool-to-group [shape-id] (ptk/reify ::bool-to-group ptk/WatchEvent (watch [_ state _] - (let [objects (dsh/lookup-page-objects state) - change-to-group - (fn [shape] (bool->group shape objects))] + (let [objects (dsh/lookup-page-objects state)] (when-not (ctn/has-any-copy-parent? objects (get objects shape-id)) - (rx/of (dwsh/update-shapes [shape-id] change-to-group {:reg-objects? true}))))))) - + (rx/of (dwsh/update-shapes [shape-id] bool->group {:with-objects? true :reg-objects? true}))))))) (defn change-bool-type - [shape-id bool-type] + [shape-id type] (ptk/reify ::change-bool-type ptk/WatchEvent (watch [_ state _] (let [objects (dsh/lookup-page-objects state) change-type - (fn [shape] (assoc shape :bool-type bool-type))] + (fn [shape] (assoc shape :bool-type type))] (when-not (ctn/has-any-copy-parent? objects (get objects shape-id)) (rx/of (dwsh/update-shapes [shape-id] change-type {:reg-objects? true}))))))) diff --git a/frontend/src/app/main/data/workspace/drawing/common.cljs b/frontend/src/app/main/data/workspace/drawing/common.cljs index dc565bfdf8..4bf6bb83ec 100644 --- a/frontend/src/app/main/data/workspace/drawing/common.cljs +++ b/frontend/src/app/main/data/workspace/drawing/common.cljs @@ -11,6 +11,7 @@ [app.common.geom.shapes :as gsh] [app.common.math :as mth] [app.common.types.modifiers :as ctm] + [app.common.types.path :as path] [app.common.types.shape :as cts] [app.main.data.helpers :as dsh] [app.main.data.workspace.shapes :as dwsh] @@ -65,6 +66,10 @@ (-> (assoc :height 17 :width 4 :grow-type :auto-width) (cts/setup-shape)) + (or (cfh/path-shape? shape) + (cfh/bool-shape? shape)) + (update :content path/content) + :always (dissoc :initialized? :click-draw?))] diff --git a/frontend/src/app/main/data/workspace/drawing/curve.cljs b/frontend/src/app/main/data/workspace/drawing/curve.cljs index 7a4225096a..e8546ffb22 100644 --- a/frontend/src/app/main/data/workspace/drawing/curve.cljs +++ b/frontend/src/app/main/data/workspace/drawing/curve.cljs @@ -7,13 +7,11 @@ (ns app.main.data.workspace.drawing.curve (:require [app.common.data.macros :as dm] - [app.common.geom.point :as gpt] [app.common.geom.rect :as grc] - [app.common.geom.shapes :as gsh] [app.common.geom.shapes.flex-layout :as gslf] [app.common.geom.shapes.grid-layout :as gslg] - [app.common.geom.shapes.path :as gsp] [app.common.types.container :as ctn] + [app.common.types.path.segment :as path.segment] [app.common.types.shape :as cts] [app.common.types.shape-tree :as ctst] [app.common.types.shape.layout :as ctl] @@ -26,7 +24,37 @@ [beicon.v2.core :as rx] [potok.v2.core :as ptk])) -(def simplify-tolerance 0.3) +(def ^:const simplify-tolerance 0.3) + +(defn- setup-frame + [] + (ptk/reify ::setup-frame + ptk/UpdateEvent + (update [_ state] + (let [objects (dsh/lookup-page-objects state) + content (dm/get-in state [:workspace-drawing :object :content]) + position (path.segment/get-handler-point content 0 nil) + + frame-id (->> (ctst/top-nested-frame objects position) + (ctn/get-first-not-copy-parent objects) ;; We don't want to change the structure of component copies + :id) + + flex-layout? (ctl/flex-layout? objects frame-id) + grid-layout? (ctl/grid-layout? objects frame-id) + + drop-index (when flex-layout? (gslf/get-drop-index frame-id objects position)) + drop-cell (when grid-layout? (gslg/get-drop-cell frame-id objects position))] + + (update-in state [:workspace-drawing :object] + (fn [object] + (-> object + (assoc :frame-id frame-id) + (assoc :parent-id frame-id) + ;; FIXME: with-meta twice only one wins + (cond-> (some? drop-index) + (with-meta {:index drop-index})) + (cond-> (some? drop-cell) + (with-meta {:cell drop-cell}))))))))) (defn- insert-point [point] @@ -35,43 +63,16 @@ (update [_ state] (update-in state [:workspace-drawing :object] (fn [object] - (let [segments (-> (:segments object) - (conj point)) - content (gsp/segments->content segments) - selrect (gsh/content->selrect content) - points (grc/rect->points selrect)] + (let [points (-> (::points object) + (conj point)) + content (path.segment/points->content points) + selrect (path.segment/content->selrect content) + points' (grc/rect->points selrect)] (-> object - (assoc :segments segments) + (assoc ::points points) (assoc :content content) (assoc :selrect selrect) - (assoc :points points)))))))) - -(defn- setup-frame - [] - (ptk/reify ::setup-frame - ptk/UpdateEvent - (update [_ state] - (let [objects (dsh/lookup-page-objects state) - content (dm/get-in state [:workspace-drawing :object :content] []) - start (dm/get-in content [0 :params] nil) - position (when start (gpt/point start)) - frame-id (->> (ctst/top-nested-frame objects position) - (ctn/get-first-not-copy-parent objects) ;; We don't want to change the structure of component copies - :id) - flex-layout? (ctl/flex-layout? objects frame-id) - - grid-layout? (ctl/grid-layout? objects frame-id) - drop-index (when flex-layout? (gslf/get-drop-index frame-id objects position)) - drop-cell (when grid-layout? (gslg/get-drop-cell frame-id objects position))] - (update-in state [:workspace-drawing :object] - (fn [object] - (-> object - (assoc :frame-id frame-id) - (assoc :parent-id frame-id) - (cond-> (some? drop-index) - (with-meta {:index drop-index})) - (cond-> (some? drop-cell) - (with-meta {:cell drop-cell}))))))))) + (assoc :points points')))))))) (defn finish-drawing [] @@ -79,13 +80,14 @@ ptk/UpdateEvent (update [_ state] (update-in state [:workspace-drawing :object] - (fn [{:keys [segments] :as shape}] - (let [segments (ups/simplify segments simplify-tolerance) - content (gsp/segments->content segments) - selrect (gsh/content->selrect content) + (fn [{:keys [::points] :as shape}] + (let [points (ups/simplify points simplify-tolerance) + content (path.segment/points->content points) + selrect (path.segment/content->selrect content) points (grc/rect->points selrect)] + (-> shape - (dissoc :segments) + (dissoc ::points) (assoc :content content) (assoc :selrect selrect) (assoc :points points) @@ -105,7 +107,7 @@ :initialized? true :frame-id uuid/zero :parent-id uuid/zero - :segments []})] + ::points []})] (rx/concat (rx/of #(update % :workspace-drawing assoc :object shape)) (->> mouse diff --git a/frontend/src/app/main/data/workspace/edition.cljs b/frontend/src/app/main/data/workspace/edition.cljs index e4fdf6cce8..b3aec44858 100644 --- a/frontend/src/app/main/data/workspace/edition.cljs +++ b/frontend/src/app/main/data/workspace/edition.cljs @@ -6,7 +6,6 @@ (ns app.main.data.workspace.edition (:require - [app.common.data.macros :as dm] [app.main.data.helpers :as dsh] [app.main.data.workspace.path.common :as dwpc] [beicon.v2.core :as rx] @@ -17,8 +16,10 @@ (declare clear-edition-mode) (defn start-edition-mode + "Mark a shape in edition mode" [id] - (dm/assert! (uuid? id)) + (assert (uuid? id) "expected valid uuid for `id`") + (ptk/reify ::start-edition-mode ptk/UpdateEvent (update [_ state] @@ -26,8 +27,7 @@ ;; Can only edit objects that exist (if (contains? objects id) (-> state - (assoc-in [:workspace-local :selected] #{id}) - (assoc-in [:workspace-local :edition] id) + (update :workspace-local assoc :edition id) (dissoc :workspace-grid-edition)) state))) diff --git a/frontend/src/app/main/data/workspace/modifiers.cljs b/frontend/src/app/main/data/workspace/modifiers.cljs index d8cc7cf220..3a6043888b 100644 --- a/frontend/src/app/main/data/workspace/modifiers.cljs +++ b/frontend/src/app/main/data/workspace/modifiers.cljs @@ -18,6 +18,7 @@ [app.common.types.component :as ctk] [app.common.types.container :as ctn] [app.common.types.modifiers :as ctm] + [app.common.types.path :as path] [app.common.types.shape-tree :as ctst] [app.common.types.shape.attrs :refer [editable-attrs]] [app.common.types.shape.layout :as ctl] @@ -705,6 +706,9 @@ (gsh/transform-shape modifiers) (cond-> (d/not-empty? pos-data) (assoc-position-data pos-data shape)) + (cond-> (or (cfh/path-shape? shape) + (cfh/bool-shape? shape)) + (update :content path/content)) (cond-> text-shape? (update-grow-type shape)))))] diff --git a/frontend/src/app/main/data/workspace/path/changes.cljs b/frontend/src/app/main/data/workspace/path/changes.cljs index 547500698c..44c38d99d5 100644 --- a/frontend/src/app/main/data/workspace/path/changes.cljs +++ b/frontend/src/app/main/data/workspace/path/changes.cljs @@ -6,12 +6,10 @@ (ns app.main.data.workspace.path.changes (:require - [app.common.data.macros :as dm] [app.common.files.changes-builder :as pcb] + [app.common.types.path :as path] [app.main.data.changes :as dch] [app.main.data.helpers :as dsh] - [app.main.data.workspace.path.common :refer [check-path-content!]] - [app.main.data.workspace.path.helpers :as helpers] [app.main.data.workspace.path.state :as st] [beicon.v2.core :as rx] [potok.v2.core :as ptk])) @@ -20,31 +18,25 @@ "Generates changes to update the new content of the shape" [it objects page-id shape old-content new-content] - (dm/assert! - "expected valid path content" - (and (check-path-content! old-content) - (check-path-content! new-content))) + (assert (path/check-path-content old-content)) + (assert (path/check-path-content new-content)) (let [shape-id (:id shape) - [old-points old-selrect] - (helpers/content->points+selrect shape old-content) - - [new-points new-selrect] - (helpers/content->points+selrect shape new-content) - ;; We set the old values so the update-shapes works objects - (-> objects - (update - shape-id - assoc - :content old-content - :selrect old-selrect - :points old-points)) + (update objects shape-id + (fn [shape] + (-> shape + (assoc :content old-content) + (path/update-geometry)))) - changes (-> (pcb/empty-changes it page-id) - (pcb/with-objects objects))] + changes + (-> (pcb/empty-changes it page-id) + (pcb/with-objects objects)) + + new-content + (path/content new-content)] (cond ;; https://tree.taiga.io/project/penpot/issue/2366 @@ -60,10 +52,9 @@ (-> changes (pcb/update-shapes [shape-id] (fn [shape] - (assoc shape - :content new-content - :selrect new-selrect - :points new-points))) + (-> shape + (assoc :content new-content) + (path/update-geometry)))) (pcb/resize-parents [shape-id]))))) (defn save-path-content @@ -88,6 +79,7 @@ id (get-in state [:workspace-local :edition]) old-content (get-in state [:workspace-local :edit-path id :old-content]) shape (st/get-path state)] + (if (and (some? old-content) (some? (:id shape))) (let [changes (generate-path-changes it objects page-id shape old-content (:content shape))] (rx/of (dch/commit-changes changes))) diff --git a/frontend/src/app/main/data/workspace/path/common.cljs b/frontend/src/app/main/data/workspace/path/common.cljs index 483302177f..3bb60ed721 100644 --- a/frontend/src/app/main/data/workspace/path/common.cljs +++ b/frontend/src/app/main/data/workspace/path/common.cljs @@ -6,44 +6,10 @@ (ns app.main.data.workspace.path.common (:require - [app.common.schema :as sm] - [app.common.svg.path.subpath :as ups] + [app.common.types.path :as path] [app.main.data.workspace.path.state :as st] [potok.v2.core :as ptk])) -(def valid-commands - #{:move-to - :line-to - :line-to-horizontal - :line-to-vertical - :curve-to - :smooth-curve-to - :quadratic-bezier-curve-to - :smooth-quadratic-bezier-curve-to - :elliptical-arc - :close-path}) - -;; FIXME: should this schema be defined on common.types ? - -(def ^:private - schema:path-content - [:vector {:title "PathContent"} - [:map {:title "PathContentEntry"} - [:command [::sm/one-of valid-commands]] - ;; FIXME: remove the `?` from prop name - [:relative? {:optional true} :boolean] - [:params {:optional true} - [:map {:title "PathContentEntryParams"} - [:x :double] - [:y :double] - [:c1x {:optional true} :double] - [:c1y {:optional true} :double] - [:c2x {:optional true} :double] - [:c2y {:optional true} :double]]]]]) - -(def check-path-content! - (sm/check-fn schema:path-content)) - (defn init-path [] (ptk/reify ::init-path)) @@ -59,4 +25,4 @@ (let [id (st/get-path-id state)] (-> state (update-in [:workspace-local :edit-path id] clean-edit-state) - (update-in (st/get-path-location state :content) ups/close-subpaths)))))) + (update-in (st/get-path-location state :content) path/close-subpaths)))))) diff --git a/frontend/src/app/main/data/workspace/path/drawing.cljs b/frontend/src/app/main/data/workspace/path/drawing.cljs index be1bbfd2ff..7d9eb3cdb1 100644 --- a/frontend/src/app/main/data/workspace/path/drawing.cljs +++ b/frontend/src/app/main/data/workspace/path/drawing.cljs @@ -9,9 +9,10 @@ [app.common.data.macros :as dm] [app.common.geom.point :as gpt] [app.common.geom.shapes.flex-layout :as gsl] - [app.common.svg.path.command :as upc] - [app.common.svg.path.shapes-to-path :as upsp] [app.common.types.container :as ctn] + [app.common.types.path :as path] + [app.common.types.path.helpers :as path.helpers] + [app.common.types.path.segment :as path.segment] [app.common.types.shape :as cts] [app.common.types.shape-tree :as ctst] [app.common.types.shape.layout :as ctl] @@ -19,7 +20,7 @@ [app.main.data.workspace.drawing.common :as dwdc] [app.main.data.workspace.edition :as dwe] [app.main.data.workspace.path.changes :as changes] - [app.main.data.workspace.path.common :as common :refer [check-path-content!]] + [app.main.data.workspace.path.common :as common] [app.main.data.workspace.path.helpers :as helpers] [app.main.data.workspace.path.state :as st] [app.main.data.workspace.path.streams :as streams] @@ -39,10 +40,10 @@ fix-angle? shift? last-point (get-in state [:workspace-local :edit-path id :last-point]) position (cond-> (gpt/point x y) - fix-angle? (helpers/position-fixed-angle last-point)) + fix-angle? (path.helpers/position-fixed-angle last-point)) shape (st/get-path state) {:keys [last-point prev-handler]} (get-in state [:workspace-local :edit-path id]) - command (helpers/next-node shape position last-point prev-handler)] + command (path.segment/next-node shape position last-point prev-handler)] (assoc-in state [:workspace-local :edit-path id :preview] command))))) (defn add-node @@ -54,7 +55,7 @@ fix-angle? shift? {:keys [last-point prev-handler]} (get-in state [:workspace-local :edit-path id]) position (cond-> (gpt/point x y) - fix-angle? (helpers/position-fixed-angle last-point))] + fix-angle? (path.helpers/position-fixed-angle last-point))] (if-not (= last-point position) (-> state (assoc-in [:workspace-local :edit-path id :last-point] position) @@ -75,12 +76,12 @@ index (or index (count content)) prefix (or prefix :c1) - position (or position (upc/command->point (nth content (dec index)))) + position (or position (path.helpers/segment->point (nth content (dec index)))) - old-handler (upc/handler->point content index prefix) + old-handler (path.segment/get-handler-point content index prefix) handler-position (cond-> (gpt/point x y) - shift? (helpers/position-fixed-angle position)) + shift? (path.helpers/position-fixed-angle position)) {dx :x dy :y} (if (some? old-handler) (gpt/add (gpt/to-vec old-handler position) @@ -102,7 +103,7 @@ modifiers (get-in state [:workspace-local :edit-path id :content-modifiers]) content (-> (st/get-path state :content) - (upc/apply-content-modifiers modifiers)) + (path/apply-content-modifiers modifiers)) handler (get-in state [:workspace-local :edit-path id :drag-handler])] (-> state @@ -110,7 +111,7 @@ (update-in [:workspace-local :edit-path id] dissoc :drag-handler) (update-in [:workspace-local :edit-path id] dissoc :content-modifiers) (assoc-in [:workspace-local :edit-path id :prev-handler] handler) - (update-in (st/get-path-location state) helpers/update-selrect)))) + (update-in (st/get-path-location state) path/update-geometry)))) ptk/WatchEvent (watch [_ state _] @@ -128,7 +129,7 @@ ptk/WatchEvent (watch [_ state stream] (let [content (st/get-path state :content) - handlers (-> (upc/content->handlers content) + handlers (-> (path.segment/get-handlers content) (get position)) [idx prefix] (when (= (count handlers) 1) @@ -254,7 +255,12 @@ (update [_ state] (let [objects (dsh/lookup-page-objects state) content (get-in state [:workspace-drawing :object :content] []) - position (gpt/point (get-in content [0 :params] nil)) + + ;; FIXME: use native operation for retrieve the first position + position (-> (nth content 0) + (get :params) + (gpt/point)) + frame-id (->> (ctst/top-nested-frame objects position) (ctn/get-first-not-copy-parent objects) ;; We don't want to change the structure of component copies :id) @@ -274,11 +280,10 @@ (ptk/reify ::handle-new-shape-result ptk/UpdateEvent (update [_ state] - (let [content (get-in state [:workspace-drawing :object :content] [])] + (let [content (dm/get-in state [:workspace-drawing :object :content])] - (dm/assert! - "expected valid path content" - (check-path-content! content)) + (assert (path/check-path-content content) + "expected valid path content instance") (if (> (count content) 1) (assoc-in state [:workspace-drawing :object :initialized?] true) @@ -286,8 +291,8 @@ ptk/WatchEvent (watch [_ state _] - (let [content (get-in state [:workspace-drawing :object :content] [])] - (if (and (seq content) (> (count content) 1)) + (when-let [content (dm/get-in state [:workspace-drawing :object :content])] + (if (> (count content) 1) (rx/of (setup-frame) (dwdc/handle-finish-drawing) (dwe/start-edition-mode shape-id) @@ -300,9 +305,8 @@ (ptk/reify ::handle-new-shape ptk/UpdateEvent (update [_ state] - (let [shape (cts/setup-shape {:type :path})] - (-> state - (update :workspace-drawing assoc :object shape)))) + (let [shape (cts/setup-shape {:type :path :content (path/content nil)})] + (update state :workspace-drawing assoc :object shape))) ptk/WatchEvent (watch [_ state stream] @@ -334,12 +338,12 @@ edit-mode (get-in state [:workspace-local :edit-path id :edit-mode])] (if (= :draw edit-mode) (rx/concat - (rx/of (dwsh/update-shapes [id] upsp/convert-to-path)) + (rx/of (dwsh/update-shapes [id] path/convert-to-path)) (rx/of (handle-drawing id)) (->> stream (rx/filter (ptk/type? ::common/finish-path)) (rx/take 1) - (rx/merge-map #(rx/of (check-changed-content))))) + (rx/map check-changed-content))) (rx/empty)))))) (defn check-changed-content [] diff --git a/frontend/src/app/main/data/workspace/path/edition.cljs b/frontend/src/app/main/data/workspace/path/edition.cljs index a4cdf6f6d3..8839947701 100644 --- a/frontend/src/app/main/data/workspace/path/edition.cljs +++ b/frontend/src/app/main/data/workspace/path/edition.cljs @@ -10,15 +10,13 @@ [app.common.data.macros :as dm] [app.common.files.helpers :as cfh] [app.common.geom.point :as gpt] - [app.common.geom.shapes.path :as upg] - [app.common.svg.path.command :as upc] - [app.common.svg.path.shapes-to-path :as upsp] - [app.common.svg.path.subpath :as ups] + [app.common.types.path :as path] + [app.common.types.path.helpers :as path.helpers] + [app.common.types.path.segment :as path.segment] [app.main.data.changes :as dch] [app.main.data.helpers :as dsh] [app.main.data.workspace.edition :as dwe] [app.main.data.workspace.path.changes :as changes] - [app.main.data.workspace.path.drawing :as drawing] [app.main.data.workspace.path.helpers :as helpers] [app.main.data.workspace.path.selection :as selection] [app.main.data.workspace.path.state :as st] @@ -27,7 +25,6 @@ [app.main.data.workspace.shapes :as dwsh] [app.main.streams :as ms] [app.util.mouse :as mse] - [app.util.path.tools :as upt] [beicon.v2.core :as rx] [potok.v2.core :as ptk])) @@ -50,18 +47,22 @@ (ptk/reify ::apply-content-modifiers ptk/WatchEvent (watch [it state _] - (let [objects (dsh/lookup-page-objects state) + (let [page-id (get state :current-page-id state) + objects (dsh/lookup-page-objects state) id (st/get-path-id state) - page-id (:current-page-id state) - shape (st/get-path state) - content-modifiers (dm/get-in state [:workspace-local :edit-path id :content-modifiers]) - content (:content shape) - new-content (upc/apply-content-modifiers content content-modifiers) + shape + (st/get-path state) - old-points (->> content upg/content->points) - new-points (->> new-content upg/content->points) + content-modifiers + (dm/get-in state [:workspace-local :edit-path id :content-modifiers]) + + content (get shape :content) + new-content (path/apply-content-modifiers content content-modifiers) + + old-points (path.segment/get-points content) + new-points (path.segment/get-points new-content) point-change (->> (map hash-map old-points new-points) (reduce merge))] (when (and (some? new-content) (some? shape)) @@ -75,8 +76,8 @@ (defn modify-content-point [content {dx :x dy :y} modifiers point] - (let [point-indices (upc/point-indices content point) ;; [indices] - handler-indices (upc/handler-indices content point) ;; [[index prefix]] + (let [point-indices (path.segment/point-indices content point) ;; [indices] + handler-indices (path.segment/handler-indices content point) ;; [[index prefix]] modify-point (fn [modifiers index] @@ -116,7 +117,7 @@ (let [id (st/get-path-id state) content (st/get-path state :content) to-point (cond-> to-point - (:shift? to-point) (helpers/position-fixed-angle from-point)) + (:shift? to-point) (path.helpers/position-fixed-angle from-point)) delta (gpt/subtract to-point from-point) @@ -144,7 +145,7 @@ selected? (contains? selected-points position)] (streams/drag-stream (rx/of - (dwsh/update-shapes [id] upsp/convert-to-path) + (dwsh/update-shapes [id] path/convert-to-path) (when-not selected? (selection/select-node position shift?)) (drag-selected-points @ms/mouse-position)) (rx/of (selection/select-node position shift?))))))) @@ -163,7 +164,7 @@ start-position (apply min-key #(gpt/distance start-position %) selected-points) content (st/get-path state :content) - points (upg/content->points content)] + points (path.segment/get-points content)] (rx/concat ;; This stream checks the consecutive mouse positions to do the dragging @@ -228,7 +229,7 @@ mov-vec (gpt/multiply (get-displacement direction) scale)] (rx/concat - (rx/of (dwsh/update-shapes [id] upsp/convert-to-path)) + (rx/of (dwsh/update-shapes [id] path/convert-to-path)) (rx/merge (->> move-events (rx/take-until stopper) @@ -256,22 +257,22 @@ start-delta-y (dm/get-in modifiers [index cy] 0) content (st/get-path state :content) - points (upg/content->points content) + points (path.segment/get-points content) - point (-> content (get (if (= prefix :c1) (dec index) index)) (upc/command->point)) - handler (-> content (get index) (upc/get-handler prefix)) + point (-> content (nth (if (= prefix :c1) (dec index) index)) (path.helpers/segment->point)) + handler (-> content (nth index) (path.segment/get-handler prefix)) - [op-idx op-prefix] (upc/opposite-index content index prefix) - opposite (upc/handler->point content op-idx op-prefix)] + [op-idx op-prefix] (path.segment/opposite-index content index prefix) + opposite (path.segment/get-handler-point content op-idx op-prefix)] (streams/drag-stream (rx/concat - (rx/of (dwsh/update-shapes [id] upsp/convert-to-path)) + (rx/of (dwsh/update-shapes [id] path/convert-to-path)) (->> (streams/move-handler-stream handler point handler opposite points) (rx/map (fn [{:keys [x y alt? shift?]}] (let [pos (cond-> (gpt/point x y) - shift? (helpers/position-fixed-angle point))] + shift? (path.helpers/position-fixed-angle point))] (modify-handler id index @@ -294,33 +295,34 @@ (ptk/reify ::start-path-edit ptk/UpdateEvent (update [_ state] - (let [objects (dsh/lookup-page-objects state) + (let [objects (dsh/lookup-page-objects state) edit-path (dm/get-in state [:workspace-local :edit-path id]) - content (st/get-path state :content) - state (cond-> state - (cfh/path-shape? objects id) - (st/set-content (ups/close-subpaths content)))] + content (st/get-path state :content) + state (cond-> state + (cfh/path-shape? objects id) + (st/set-content (path/close-subpaths content)))] + (cond-> state - (or (not edit-path) (= :draw (:edit-mode edit-path))) + (or (not edit-path) + (= :draw (:edit-mode edit-path))) (assoc-in [:workspace-local :edit-path id] {:edit-mode :move :selected #{} :snap-toggled false}) - - (and (some? edit-path) (= :move (:edit-mode edit-path))) + (and (some? edit-path) + (= :move (:edit-mode edit-path))) (assoc-in [:workspace-local :edit-path id :edit-mode] :draw)))) ptk/WatchEvent - (watch [_ state stream] - (let [mode (dm/get-in state [:workspace-local :edit-path id :edit-mode]) - stopper (->> stream - (rx/filter #(or - (= (ptk/type %) ::dwe/clear-edition-mode) - (= (ptk/type %) ::start-path-edit)))) - interrupt (->> stream (rx/filter #(= % :interrupt)) (rx/take 1))] + (watch [_ _ stream] + (let [stopper (->> stream + (rx/filter #(let [type (ptk/type %)] + (= type ::dwe/clear-edition-mode) + (= type ::start-path-edit))))] (rx/concat - (rx/of (undo/start-path-undo) - (drawing/change-edit-mode mode)) - (->> interrupt + (rx/of (undo/start-path-undo)) + (->> stream + (rx/filter #(= % :interrupt)) + (rx/take 1) (rx/map #(stop-path-edit id)) (rx/take-until stopper))))))) @@ -343,7 +345,9 @@ content (st/get-path state :content)] (-> state (assoc-in [:workspace-local :edit-path id :old-content] content) - (st/set-content (-> content (upt/split-segments #{from-p to-p} t)))))) + (st/set-content (-> content + (path.segment/split-segments #{from-p to-p} t) + (path/content)))))) ptk/WatchEvent (watch [_ _ _] @@ -355,5 +359,5 @@ ptk/WatchEvent (watch [_ state _] (let [id (st/get-path-id state)] - (rx/of (dwsh/update-shapes [id] upsp/convert-to-path) + (rx/of (dwsh/update-shapes [id] path/convert-to-path) (split-segments event)))))) diff --git a/frontend/src/app/main/data/workspace/path/helpers.cljs b/frontend/src/app/main/data/workspace/path/helpers.cljs index b52ab6e723..6c697a87d3 100644 --- a/frontend/src/app/main/data/workspace/path/helpers.cljs +++ b/frontend/src/app/main/data/workspace/path/helpers.cljs @@ -6,12 +6,11 @@ (ns app.main.data.workspace.path.helpers (:require - [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.svg.path.command :as upc] + [app.common.types.path :as path] + [app.common.types.path.helpers :as path.helpers] + [app.common.types.path.segment :as path.segment] [app.main.data.workspace.path.common :as common] [app.util.mouse :as mse] [potok.v2.core :as ptk])) @@ -28,96 +27,13 @@ (and ^boolean (mse/mouse-event? event) ^boolean (mse/mouse-double-click-event? event))))) -(defn content-center - [content] - (-> content - gsh/content->selrect - grc/rect->center)) - -(defn content->points+selrect - "Given the content of a shape, calculate its points and selrect" - [shape content] - (let [{:keys [flip-x flip-y]} shape - transform - (cond-> (:transform shape (gmt/matrix)) - flip-x (gmt/scale (gpt/point -1 1)) - flip-y (gmt/scale (gpt/point 1 -1))) - - transform-inverse - (cond-> (gmt/matrix) - flip-x (gmt/scale (gpt/point -1 1)) - flip-y (gmt/scale (gpt/point 1 -1)) - :always (gmt/multiply (:transform-inverse shape (gmt/matrix)))) - - center (or (gsh/shape->center shape) - (content-center content)) - - base-content (gsh/transform-content - content - (gmt/transform-in center transform-inverse)) - - ;; Calculates the new selrect with points given the old center - points (-> (gsh/content->selrect base-content) - (grc/rect->points) - (gsh/transform-points center transform)) - - points-center (gsh/points->center points) - - ;; Points is now the selrect but the center is different so we can create the selrect - ;; through points - selrect (-> points - (gsh/transform-points points-center transform-inverse) - (grc/points->rect))] - [points selrect])) - -(defn update-selrect - "Updates the selrect and points for a path" - [shape] - (let [[points selrect] (content->points+selrect shape (:content shape))] - (assoc shape :points points :selrect selrect))) - -(defn closest-angle - [angle] - (cond - (or (> angle 337.5) (<= angle 22.5)) 0 - (and (> angle 22.5) (<= angle 67.5)) 45 - (and (> angle 67.5) (<= angle 112.5)) 90 - (and (> angle 112.5) (<= angle 157.5)) 135 - (and (> angle 157.5) (<= angle 202.5)) 180 - (and (> angle 202.5) (<= angle 247.5)) 225 - (and (> angle 247.5) (<= angle 292.5)) 270 - (and (> angle 292.5) (<= angle 337.5)) 315)) - -(defn position-fixed-angle [point from-point] - (if (and from-point point) - (let [angle (mod (+ 360 (- (gpt/angle point from-point))) 360) - to-angle (closest-angle angle) - distance (gpt/distance point from-point)] - (gpt/angle->point from-point (mth/radians to-angle) distance)) - point)) - -(defn next-node - "Calculates the next-node to be inserted." - [shape position prev-point prev-handler] - (let [position (select-keys position [:x :y]) - last-command (-> shape :content last :command) - add-line? (and prev-point (not prev-handler) (not= last-command :close-path)) - add-curve? (and prev-point prev-handler (not= last-command :close-path))] - (cond - add-line? {:command :line-to - :params position} - add-curve? {:command :curve-to - :params (upc/make-curve-params position prev-handler)} - :else {:command :move-to - :params position}))) - (defn append-node "Creates a new node in the path. Usually used when drawing." [shape position prev-point prev-handler] - (let [command (next-node shape position prev-point prev-handler)] + (let [segment (path.segment/next-node (:content shape) position prev-point prev-handler)] (-> shape - (update :content (fnil conj []) command) - (update-selrect)))) + (update :content path.segment/append-segment segment) + (path/update-geometry)))) (defn angle-points [common p1 p2] (mth/abs @@ -125,7 +41,7 @@ (gpt/to-vec common p1) (gpt/to-vec common p2)))) -(defn calculate-opposite-delta [node handler opposite match-angle? match-distance? dx dy] +(defn- calculate-opposite-delta [node handler opposite match-angle? match-distance? dx dy] (when (and (some? handler) (some? opposite)) (let [;; To match the angle, the angle should be matching (angle between points 180deg) angle-handlers (angle-points node handler opposite) @@ -159,14 +75,14 @@ (defn move-handler-modifiers [content index prefix match-distance? match-angle? dx dy] - (let [[cx cy] (upc/prefix->coords prefix) - [op-idx op-prefix] (upc/opposite-index content index prefix) + (let [[cx cy] (path.helpers/prefix->coords prefix) + [op-idx op-prefix] (path.segment/opposite-index content index prefix) - node (upc/handler->node content index prefix) - handler (upc/handler->point content index prefix) - opposite (upc/handler->point content op-idx op-prefix) + node (path.segment/handler->node content index prefix) + handler (path.segment/get-handler-point content index prefix) + opposite (path.segment/get-handler-point content op-idx op-prefix) - [ocx ocy] (upc/prefix->coords op-prefix) + [ocx ocy] (path.helpers/prefix->coords op-prefix) [odx ody] (calculate-opposite-delta node handler opposite match-angle? match-distance? dx dy) hnv (if (some? handler) diff --git a/frontend/src/app/main/data/workspace/path/shapes_to_path.cljs b/frontend/src/app/main/data/workspace/path/shapes_to_path.cljs index e269305280..9068ad43d5 100644 --- a/frontend/src/app/main/data/workspace/path/shapes_to_path.cljs +++ b/frontend/src/app/main/data/workspace/path/shapes_to_path.cljs @@ -8,8 +8,8 @@ (:require [app.common.files.changes-builder :as pcb] [app.common.files.helpers :as cph] - [app.common.svg.path.shapes-to-path :as upsp] [app.common.types.container :as ctn] + [app.common.types.path :as path] [app.main.data.changes :as dch] [app.main.data.helpers :as dsh] [beicon.v2.core :as rx] @@ -35,7 +35,8 @@ changes (-> (pcb/empty-changes it page-id) (pcb/with-objects objects) - (pcb/update-shapes selected #(upsp/convert-to-path % objects)) + ;; FIXME: use with-objects? true + (pcb/update-shapes selected #(path/convert-to-path % objects)) (pcb/remove-objects children-ids))] (rx/of (dch/commit-changes changes))))))) diff --git a/frontend/src/app/main/data/workspace/path/state.cljs b/frontend/src/app/main/data/workspace/path/state.cljs index 0a6deb1866..efe34a0044 100644 --- a/frontend/src/app/main/data/workspace/path/state.cljs +++ b/frontend/src/app/main/data/workspace/path/state.cljs @@ -8,7 +8,7 @@ (:require [app.common.data.macros :as dm] [app.common.files.helpers :as cph] - [app.common.svg.path.shapes-to-path :as upsp])) + [app.common.types.path.shape-to-path :as stp])) (defn path-editing? "Returns true if we're editing a path or creating a new one." @@ -63,8 +63,7 @@ [state & ks] (let [path-loc (get-path-location state) shape (-> (get-in state path-loc) - ;; Empty map because we know the current shape will not have children - (upsp/convert-to-path {}))] + (stp/convert-to-path {}))] (if (empty? ks) shape (get-in shape ks)))) diff --git a/frontend/src/app/main/data/workspace/path/streams.cljs b/frontend/src/app/main/data/workspace/path/streams.cljs index f860ca586e..4fe8590511 100644 --- a/frontend/src/app/main/data/workspace/path/streams.cljs +++ b/frontend/src/app/main/data/workspace/path/streams.cljs @@ -8,7 +8,7 @@ (:require [app.common.data.macros :as dm] [app.common.geom.point :as gpt] - [app.common.geom.shapes.path :as upg] + [app.common.types.path.segment :as path.segm] [app.main.constants :refer [zoom-half-pixel-precision]] [app.main.data.workspace.path.state :as pst] [app.main.snap :as snap] @@ -170,7 +170,8 @@ ranges-stream (->> content-stream - (rx/map upg/content->points) + (rx/filter some?) + (rx/map path.segm/get-points) (rx/map snap/create-ranges))] (->> ms/mouse-position diff --git a/frontend/src/app/main/data/workspace/path/tools.cljs b/frontend/src/app/main/data/workspace/path/tools.cljs index df495c1b23..7b1977ff89 100644 --- a/frontend/src/app/main/data/workspace/path/tools.cljs +++ b/frontend/src/app/main/data/workspace/path/tools.cljs @@ -6,15 +6,16 @@ (ns app.main.data.workspace.path.tools (:require - [app.common.svg.path.shapes-to-path :as upsp] - [app.common.svg.path.subpath :as ups] + [app.common.data.macros :as dm] + [app.common.files.helpers :as cfh] + [app.common.types.path :as path] + [app.common.types.path.segment :as path.segment] [app.main.data.changes :as dch] [app.main.data.helpers :as dsh] [app.main.data.workspace.edition :as dwe] [app.main.data.workspace.path.changes :as changes] [app.main.data.workspace.path.state :as st] [app.main.data.workspace.shapes :as dwsh] - [app.util.path.tools :as upt] [beicon.v2.core :as rx] [potok.v2.core :as ptk])) @@ -26,19 +27,30 @@ (ptk/reify ::process-path-tool ptk/WatchEvent (watch [it state _] - (let [objects (dsh/lookup-page-objects state) - id (st/get-path-id state) - page-id (:current-page-id state) - shape (st/get-path state) - selected-points (get-in state [:workspace-local :edit-path id :selected-points] #{}) - points (or points selected-points)] + (let [page-id (get state :current-page-id) + objects (dsh/lookup-page-objects state page-id) + + shape (st/get-path state) + id (st/get-path-id state) + + selected-points + (dm/get-in state [:workspace-local :edit-path id :selected-points] #{}) + + points + (or points selected-points)] + (when (and (seq points) (some? shape)) - (let [new-content (-> (tool-fn (:content shape) points) - (ups/close-subpaths)) - changes (changes/generate-path-changes it objects page-id shape (:content shape) new-content)] + (let [new-content + (-> (tool-fn (:content shape) points) + (path/close-subpaths)) + + changes + (changes/generate-path-changes it objects page-id shape (:content shape) new-content)] (rx/concat - (rx/of (dwsh/update-shapes [id] upsp/convert-to-path)) + (if (cfh/path-shape? shape) + (rx/empty) + (rx/of (dwsh/update-shapes [id] path/convert-to-path))) (rx/of (dch/commit-changes changes) (when (empty? new-content) (dwe/clear-edition-mode))))))))))) @@ -50,7 +62,7 @@ (process-path-tool (when point #{point}) (fn [content points] - (reduce upt/make-corner-point content points))))) + (reduce path.segment/make-corner-point content points))))) (defn make-curve ([] @@ -59,22 +71,22 @@ (process-path-tool (when point #{point}) (fn [content points] - (reduce upt/make-curve-point content points))))) + (reduce path.segment/make-curve-point content points))))) (defn add-node [] - (process-path-tool (fn [content points] (upt/split-segments content points 0.5)))) + (process-path-tool (fn [content points] (path.segment/split-segments content points 0.5)))) (defn remove-node [] - (process-path-tool upt/remove-nodes)) + (process-path-tool path.segment/remove-nodes)) (defn merge-nodes [] - (process-path-tool upt/merge-nodes)) + (process-path-tool path.segment/merge-nodes)) (defn join-nodes [] - (process-path-tool upt/join-nodes)) + (process-path-tool path.segment/join-nodes)) (defn separate-nodes [] - (process-path-tool upt/separate-nodes)) + (process-path-tool path.segment/separate-nodes)) (defn toggle-snap [] (ptk/reify ::toggle-snap diff --git a/frontend/src/app/main/data/workspace/shapes.cljs b/frontend/src/app/main/data/workspace/shapes.cljs index d9862564b3..d70a0b30bd 100644 --- a/frontend/src/app/main/data/workspace/shapes.cljs +++ b/frontend/src/app/main/data/workspace/shapes.cljs @@ -47,40 +47,53 @@ (defn update-shapes ([ids update-fn] (update-shapes ids update-fn nil)) - ([ids update-fn {:keys [reg-objects? save-undo? stack-undo? attrs ignore-tree page-id ignore-touched undo-group with-objects? changed-sub-attr] - :or {reg-objects? false save-undo? true stack-undo? false ignore-touched false with-objects? false}}] + ([ids update-fn + {:keys [reg-objects? save-undo? stack-undo? attrs ignore-tree page-id + ignore-touched undo-group with-objects? changed-sub-attr] + :or {reg-objects? false + save-undo? true + stack-undo? false + ignore-touched false + with-objects? false}}] - (assert (sm/check-coll-of-uuid ids)) - (assert (fn? update-fn)) + (assert (every? uuid? ids) "expect a coll of uuid for `ids`") + (assert (fn? update-fn) "the `update-fn` should be a valid function") (ptk/reify ::update-shapes ptk/WatchEvent (watch [it state _] - (let [page-id (or page-id (:current-page-id state)) + (let [page-id (or page-id (get state :current-page-id)) objects (dsh/lookup-page-objects state page-id) ids (into [] (filter some?) ids) + xf-update-layout + (comp + (map (d/getf objects)) + (filter #(some update-layout-attr? (pcb/changed-attrs % objects update-fn {:attrs attrs :with-objects? with-objects?}))) + (map :id)) + update-layout-ids - (->> ids - (map (d/getf objects)) - (filter #(some update-layout-attr? (pcb/changed-attrs % objects update-fn {:attrs attrs :with-objects? with-objects?}))) - (map :id)) + (->> (into [] xf-update-layout ids) + (not-empty)) - changes (-> (pcb/empty-changes it page-id) - (pcb/set-save-undo? save-undo?) - (pcb/set-stack-undo? stack-undo?) - (cls/generate-update-shapes ids - update-fn - objects - {:attrs attrs - :changed-sub-attr changed-sub-attr - :ignore-tree ignore-tree - :ignore-touched ignore-touched - :with-objects? with-objects?}) - (cond-> undo-group - (pcb/set-undo-group undo-group))) + changes + (-> (pcb/empty-changes it page-id) + (pcb/set-save-undo? save-undo?) + (pcb/set-stack-undo? stack-undo?) + (cls/generate-update-shapes ids + update-fn + objects + {:attrs attrs + :changed-sub-attr changed-sub-attr + :ignore-tree ignore-tree + :ignore-touched ignore-touched + :with-objects? with-objects?}) + (cond-> undo-group + (pcb/set-undo-group undo-group))) + + changes + (add-undo-group changes state)] - changes (add-undo-group changes state)] (rx/concat (if (seq (:redo-changes changes)) (let [changes (cond-> changes reg-objects? (pcb/resize-parents ids))] @@ -88,7 +101,7 @@ (rx/empty)) ;; Update layouts for properties marked - (if (d/not-empty? update-layout-ids) + (if update-layout-ids (rx/of (ptk/data-event :layout/update {:ids update-layout-ids})) (rx/empty)))))))) @@ -112,11 +125,13 @@ (pcb/with-objects objects) (cfsh/prepare-add-shape shape objects)) - changes (cond-> changes - (cfh/text-shape? shape) - (pcb/set-undo-group (:id shape))) + changes + (cond-> changes + (cfh/text-shape? shape) + (pcb/set-undo-group (:id shape))) - undo-id (js/Symbol)] + undo-id + (js/Symbol)] (rx/concat (rx/of (dwu/start-undo-transaction undo-id) diff --git a/frontend/src/app/main/features.cljs b/frontend/src/app/main/features.cljs index 23deb766fc..030e293124 100644 --- a/frontend/src/app/main/features.cljs +++ b/frontend/src/app/main/features.cljs @@ -110,4 +110,3 @@ (log/inf :hint "initialized" :enabled (str/join "," features) :runtime (str/join "," (:features-runtime state))))))) - diff --git a/frontend/src/app/main/ui/shapes/bool.cljs b/frontend/src/app/main/ui/shapes/bool.cljs index 87b5b6afb0..7f831a1ddb 100644 --- a/frontend/src/app/main/ui/shapes/bool.cljs +++ b/frontend/src/app/main/ui/shapes/bool.cljs @@ -7,7 +7,8 @@ (ns app.main.ui.shapes.bool (:require [app.common.data.macros :as dm] - [app.common.geom.shapes :as gsh] + [app.common.types.path :as path] + [app.main.ui.hooks :as h] [app.main.ui.shapes.export :as use] [app.main.ui.shapes.path :refer [path-shape]] @@ -30,7 +31,7 @@ content (some? child-objs) - (gsh/calc-bool-content shape child-objs)))) + (path/calc-bool-content shape child-objs)))) shape (mf/with-memo [shape content] (assoc shape :content content))] diff --git a/frontend/src/app/main/ui/shapes/custom_stroke.cljs b/frontend/src/app/main/ui/shapes/custom_stroke.cljs index 7168975b88..1a7ad91d7f 100644 --- a/frontend/src/app/main/ui/shapes/custom_stroke.cljs +++ b/frontend/src/app/main/ui/shapes/custom_stroke.cljs @@ -13,6 +13,7 @@ [app.common.geom.shapes :as gsh] [app.common.geom.shapes.bounds :as gsb] [app.common.geom.shapes.text :as gst] + [app.common.types.path :as path] [app.common.uuid :as uuid] [app.config :as cf] [app.main.ui.context :as muc] @@ -204,7 +205,7 @@ {::mf/wrap-props false} [{:keys [shape stroke render-id index]}] (let [open-path? (and ^boolean (cfh/path-shape? shape) - ^boolean (gsh/open-path? shape)) + ^boolean (path/shape-with-open-path? shape)) gradient (:stroke-color-gradient stroke) alignment (:stroke-alignment stroke :center) width (:stroke-width stroke 0) @@ -397,7 +398,7 @@ has-stroke? (and (> stroke-width 0) (not= stroke-style :none)) closed? (or (not ^boolean (cfh/path-shape? shape)) - (not ^boolean (gsh/open-path? shape))) + (not ^boolean (path/shape-with-open-path? shape))) inner? (= :inner stroke-position) outer? (= :outer stroke-position)] @@ -496,7 +497,7 @@ :style style}) open-path? (and ^boolean (cfh/path-shape? shape) - ^boolean (gsh/open-path? shape))] + ^boolean (path/shape-with-open-path? shape))] (when-not ^boolean (cfh/frame-shape? shape) (when (and (some? shape-blur) (not ^boolean (:hidden shape-blur))) diff --git a/frontend/src/app/main/ui/shapes/path.cljs b/frontend/src/app/main/ui/shapes/path.cljs index f44d430428..e1a21eac89 100644 --- a/frontend/src/app/main/ui/shapes/path.cljs +++ b/frontend/src/app/main/ui/shapes/path.cljs @@ -7,28 +7,35 @@ (ns app.main.ui.shapes.path (:require [app.common.logging :as log] + [app.common.types.path :as path] [app.main.ui.shapes.custom-stroke :refer [shape-custom-strokes]] - [app.util.object :as obj] - [app.util.path.format :as upf] [rumext.v2 :as mf])) +(defn- content->string + [content] + (cond + (nil? content) + "" + + (path/content? content) + (.toString content) + + :else + (let [content (path/content content)] + (.toString content)))) + (mf/defc path-shape - {::mf/wrap-props false} - [props] - (let [shape (unchecked-get props "shape") - content (:content shape) + {::mf/props :obj} + [{:keys [shape]}] + (let [content (get shape :content) pdata (mf/with-memo [content] (try - (upf/format-path content) - (catch :default e + (content->string content) + (catch :default cause (log/error :hint "unexpected error on formatting path" :shape-name (:name shape) :shape-id (:id shape) - :cause e) - ""))) - - props (-> #js {} - (obj/set! "d" pdata))] - + :cause cause) + "")))] [:& shape-custom-strokes {:shape shape} - [:> :path props]])) + [:path {:d pdata}]])) diff --git a/frontend/src/app/main/ui/workspace/shapes/debug.cljs b/frontend/src/app/main/ui/workspace/shapes/debug.cljs index 8844d18bc1..ce981a86a5 100644 --- a/frontend/src/app/main/ui/workspace/shapes/debug.cljs +++ b/frontend/src/app/main/ui/workspace/shapes/debug.cljs @@ -10,12 +10,13 @@ [app.common.data.macros :as dm] [app.common.files.helpers :as cfh] [app.common.geom.shapes :as gsh] - [app.common.geom.shapes.path :as gsp] [app.common.geom.shapes.text :as gst] [app.common.math :as mth] - [app.common.svg.path.bool :as pb] - [app.common.svg.path.shapes-to-path :as stp] - [app.common.svg.path.subpath :as ups] + [app.common.types.path :as path] + [app.common.types.path.bool :as path.bool] + [app.common.types.path.helpers :as path.helpers] + [app.common.types.path.segment :as path.segment] + [app.common.types.path.subpath :as path.subpath] [app.main.refs :as refs] [app.util.color :as uc] [app.util.debug :as dbg] @@ -101,49 +102,49 @@ radius (/ 3 zoom) c1 (-> (get objects (first (:shapes shape))) - (stp/convert-to-path objects)) + (path/convert-to-path objects)) c2 (-> (get objects (second (:shapes shape))) - (stp/convert-to-path objects)) + (path/convert-to-path objects)) content-a (:content c1) content-b (:content c2) bool-type (:bool-type shape) should-reverse? (and (not= :union bool-type) - (= (ups/clockwise? content-b) - (ups/clockwise? content-a))) + (= (path.subpath/clockwise? content-b) + (path.subpath/clockwise? content-a))) content-a (-> (:content c1) - (pb/close-paths) - (pb/add-previous)) + (path.bool/close-paths) + (path.bool/add-previous)) content-b (-> (:content c2) - (pb/close-paths) - (cond-> should-reverse? (ups/reverse-content)) - (pb/add-previous)) + (path.bool/close-paths) + (cond-> should-reverse? (path.subpath/reverse-content)) + (path.bool/add-previous)) - sr-a (gsp/content->selrect content-a) - sr-b (gsp/content->selrect content-b) + sr-a (path.segment/content->selrect content-a) + sr-b (path.segment/content->selrect content-b) - [content-a-split content-b-split] (pb/content-intersect-split content-a content-b sr-a sr-b) + [content-a-split content-b-split] (path.bool/content-intersect-split content-a content-b sr-a sr-b) - ;;content-a-geom (gsp/content->geom-data content-a) - ;;content-b-geom (gsp/content->geom-data content-b) - ;;content-a-split (->> content-a-split #_(filter #(pb/contains-segment? % content-b sr-b content-b-geom))) - ;;content-b-split (->> content-b-split #_(filter #(pb/contains-segment? % content-a sr-a content-a-geom))) + ;;content-a-geom (path.segment/content->geom-data content-a) + ;;content-b-geom (path.segment/content->geom-data content-b) + ;;content-a-split (->> content-a-split #_(filter #(path.bool/contains-segment? % content-b sr-b content-b-geom))) + ;;content-b-split (->> content-b-split #_(filter #(path.bool/contains-segment? % content-a sr-a content-a-geom))) ] [:* - (for [[i cmd] (d/enumerate content-a-split)] - (let [p1 (:prev cmd) - p2 (gsp/command->point cmd) + (for [[i segment] (d/enumerate content-a-split)] + (let [p1 (:prev segment) + p2 (path.helpers/segment->point segment) - hp (case (:command cmd) - :line-to (-> (gsp/command->line cmd) - (gsp/line-values 0.5)) + hp (case (:command segment) + :line-to (-> (path.helpers/command->line segment) + (path.helpers/line-values 0.5)) - :curve-to (-> (gsp/command->bezier cmd) - (gsp/curve-values 0.5)) + :curve-to (-> (path.helpers/command->bezier segment) + (path.helpers/curve-values 0.5)) nil)] [:* (when p1 @@ -153,16 +154,16 @@ (when hp [:circle {:data-i i :key (dm/str "c13-" i) :cx (:x hp) :cy (:y hp) :r radius :fill "orange"}])])) - (for [[i cmd] (d/enumerate content-b-split)] - (let [p1 (:prev cmd) - p2 (gsp/command->point cmd) + (for [[i segment] (d/enumerate content-b-split)] + (let [p1 (:prev segment) + p2 (path.helpers/segment->point segment) - hp (case (:command cmd) - :line-to (-> (gsp/command->line cmd) - (gsp/line-values 0.5)) + hp (case (:command segment) + :line-to (-> (path.helpers/command->line segment) + (path.helpers/line-values 0.5)) - :curve-to (-> (gsp/command->bezier cmd) - (gsp/curve-values 0.5)) + :curve-to (-> (path.helpers/command->bezier segment) + (path.helpers/curve-values 0.5)) nil)] [:* (when p1 diff --git a/frontend/src/app/main/ui/workspace/shapes/path.cljs b/frontend/src/app/main/ui/workspace/shapes/path.cljs index 110238be4b..0f8da115b3 100644 --- a/frontend/src/app/main/ui/workspace/shapes/path.cljs +++ b/frontend/src/app/main/ui/workspace/shapes/path.cljs @@ -6,34 +6,48 @@ (ns app.main.ui.workspace.shapes.path (:require - [app.common.svg.path.command :as upc] - [app.main.data.workspace.path.helpers :as helpers] + [app.common.data.macros :as dm] + [app.common.types.path :as types.path] [app.main.refs :as refs] [app.main.ui.shapes.path :as path] [app.main.ui.shapes.shape :refer [shape-container]] [app.main.ui.workspace.shapes.debug :as wsd] - [app.main.ui.workspace.shapes.path.common :as pc] + [okulary.core :as l] [rumext.v2 :as mf])) -(defn apply-content-modifiers +(defn- make-content-modifiers-ref + [id] + (l/derived (fn [local] + (dm/get-in local [:edit-path id :content-modifiers])) + refs/workspace-local)) + +(defn- apply-content-modifiers [shape content-modifiers] - (let [shape (update shape :content upc/apply-content-modifiers content-modifiers) - [_ new-selrect] (helpers/content->points+selrect shape (:content shape))] - (assoc shape :selrect new-selrect))) + (let [shape (update shape :content types.path/apply-content-modifiers content-modifiers)] + (types.path/update-geometry shape))) (mf/defc path-wrapper {::mf/wrap-props false} - [props] - (let [shape (unchecked-get props "shape") - content-modifiers-ref (pc/make-content-modifiers-ref (:id shape)) - content-modifiers (mf/deref content-modifiers-ref) - editing-id (mf/deref refs/selected-edition) - editing? (= editing-id (:id shape)) + [{:keys [shape]}] + (let [shape-id (dm/get-prop shape :id) + + content-modifiers-ref + (mf/with-memo [shape-id] + (make-content-modifiers-ref shape-id)) + + content-modifiers + (mf/deref content-modifiers-ref) + + ;; FIXME: this should be provided by react context instead of using refs + editing-id + (mf/deref refs/selected-edition) + + editing? + (= editing-id shape-id) shape - (mf/use-memo - (mf/deps shape content-modifiers) - #(cond-> shape + (mf/with-memo [shape content-modifiers] + (cond-> shape (some? content-modifiers) (apply-content-modifiers content-modifiers)))] diff --git a/frontend/src/app/main/ui/workspace/shapes/path/common.cljs b/frontend/src/app/main/ui/workspace/shapes/path/common.cljs deleted file mode 100644 index e6dae1f622..0000000000 --- a/frontend/src/app/main/ui/workspace/shapes/path/common.cljs +++ /dev/null @@ -1,43 +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.main.ui.workspace.shapes.path.common - (:require - [app.common.data.macros :as dm] - [app.main.data.workspace.path.state :as pst] - [app.main.refs :as refs] - [app.main.store :as st] - [okulary.core :as l] - [rumext.v2 :as mf])) - -(def accent-color "var(--color-accent-tertiary)") -(def secondary-color "var(--color-accent-quaternary)") -(def black-color "var(--app-black)") -(def white-color "var(--app-white)") -(def gray-color "var(--df-secondary)") - -(def current-edit-path-ref - (l/derived - (fn [state] - (let [id (pst/get-path-id state)] - (dm/get-in state [:workspace-local :edit-path id]))) - st/state)) - -(defn make-edit-path-ref [id] - (mf/use-memo - (mf/deps id) - (let [selfn #(get-in % [:edit-path id])] - #(l/derived selfn refs/workspace-local)))) - -(defn content-modifiers-ref - [id] - (l/derived #(get-in % [:edit-path id :content-modifiers]) refs/workspace-local)) - -(defn make-content-modifiers-ref [id] - (mf/use-memo - (mf/deps id) - #(content-modifiers-ref id))) - diff --git a/frontend/src/app/main/ui/workspace/shapes/path/editor.cljs b/frontend/src/app/main/ui/workspace/shapes/path/editor.cljs index b6d844db61..1c8e91fcbd 100644 --- a/frontend/src/app/main/ui/workspace/shapes/path/editor.cljs +++ b/frontend/src/app/main/ui/workspace/shapes/path/editor.cljs @@ -8,24 +8,24 @@ (:require [app.common.data :as d] [app.common.data.macros :as dm] + [app.common.files.helpers :as cfh] [app.common.geom.point :as gpt] - [app.common.geom.shapes.path :as gsp] - [app.common.svg.path.command :as upc] - [app.common.svg.path.shapes-to-path :as ups] + [app.common.types.path :as path] + [app.common.types.path.helpers :as path.helpers] + [app.common.types.path.segment :as path.segment] [app.main.data.workspace.path :as drp] + [app.main.refs :as refs] [app.main.snap :as snap] [app.main.store :as st] [app.main.streams :as ms] [app.main.ui.css-cursors :as cur] [app.main.ui.hooks :as hooks] - [app.main.ui.workspace.shapes.path.common :as pc] [app.util.dom :as dom] [app.util.keyboard :as kbd] - [app.util.path.format :as upf] [clojure.set :refer [map-invert]] [goog.events :as events] - [rumext.v2 :as mf]) - (:import goog.events.EventType)) + [okulary.core :as l] + [rumext.v2 :as mf])) (def point-radius 5) (def point-radius-selected 4) @@ -38,16 +38,31 @@ (def path-preview-dasharray 4) (def path-snap-stroke-width 1) -(mf/defc path-point [{:keys [position zoom edit-mode hover? selected? preview? start-path? last-p? new-point? curve?]}] +(def accent-color "var(--color-accent-tertiary)") +(def secondary-color "var(--color-accent-quaternary)") +(def black-color "var(--app-black)") +(def white-color "var(--app-white)") +(def gray-color "var(--df-secondary)") + +(mf/defc path-point* + {::mf/private true} + [{:keys [position zoom edit-mode is-hover is-selected is-preview is-start-path is-last is-new is-curve]}] (let [{:keys [x y]} position + is-draw (= edit-mode :draw) + is-move (= edit-mode :move) + + is-active + (or ^boolean is-selected + ^boolean is-hover) + on-enter - (mf/use-callback + (mf/use-fn (fn [_] (st/emit! (drp/path-pointer-enter position)))) on-leave - (mf/use-callback + (mf/use-fn (fn [_] (st/emit! (drp/path-pointer-leave position)))) @@ -56,132 +71,173 @@ (dom/stop-propagation event) (dom/prevent-default event) - (when (and new-point? (some? (meta position))) + ;; FIXME: revisit this, using meta here breaks equality checks + (when (and is-new (some? (meta position))) (st/emit! (drp/create-node-at-position (meta position)))) - (let [shift? (kbd/shift? event) - mod? (kbd/mod? event)] + (let [is-shift (kbd/shift? event) + is-mod (kbd/mod? event)] (cond - last-p? + is-last (st/emit! (drp/reset-last-handler)) - (and (= edit-mode :move) mod? (not curve?)) + (and is-move is-mod (not is-curve)) (st/emit! (drp/make-curve position)) - (and (= edit-mode :move) mod? curve?) + (and is-move is-mod is-curve) (st/emit! (drp/make-corner position)) - (= edit-mode :move) + is-move ;; If we're dragging a selected item we don't change the selection - (st/emit! (drp/start-move-path-point position shift?)) + (st/emit! (drp/start-move-path-point position is-shift)) - (and (= edit-mode :draw) start-path?) + (and is-draw is-start-path) (st/emit! (drp/start-path-from-point position)) - (and (= edit-mode :draw) (not start-path?)) + (and is-draw (not is-start-path)) (st/emit! (drp/close-path-drag-start position)))))] [:g.path-point [:circle.path-point {:cx x :cy y - :r (if (or selected? hover?) (/ point-radius zoom) (/ point-radius-selected zoom)) + :r (if ^boolean is-active + (/ point-radius zoom) + (/ point-radius-selected zoom)) :style {:stroke-width (/ point-radius-stroke-width zoom) - :stroke (cond (or selected? hover?) pc/black-color - preview? pc/secondary-color - :else pc/accent-color) - :fill (cond selected? pc/accent-color - :else pc/white-color)}}] + :stroke (cond ^boolean is-active black-color + ^boolean is-preview secondary-color + :else accent-color) + :fill (cond is-selected accent-color + :else white-color)}}] [:circle {:cx x :cy y :r (/ point-radius-active-area zoom) :on-pointer-down on-pointer-down :on-pointer-enter on-enter :on-pointer-leave on-leave - :pointer-events (when-not preview? "visible") - :class (cond (= edit-mode :draw) (cur/get-static "pen-node") - (= edit-mode :move) (cur/get-static "pointer-node")) + :pointer-events (when-not ^boolean is-preview "visible") + :class (cond ^boolean is-draw (cur/get-static "pen-node") + ^boolean is-move (cur/get-static "pointer-node")) :style {:stroke-width 0 :fill "none"}}]])) -(mf/defc path-handler [{:keys [index prefix point handler zoom selected? hover? edit-mode snap-angle?]}] - (when (and point handler) - (let [{:keys [x y]} handler - on-enter - (fn [_] - (st/emit! (drp/path-handler-enter index prefix))) +;; FIXME: is-selected prop looks unused - on-leave - (fn [_] - (st/emit! (drp/path-handler-leave index prefix))) +(mf/defc path-handler* + {::mf/private true} + [{:keys [index prefix point handler zoom is-selected is-hover edit-mode snap-angle]}] + (let [x (dm/get-prop handler :x) + y (dm/get-prop handler :y) + is-draw (= edit-mode :draw) + is-move (= edit-mode :move) - on-pointer-down - (fn [event] - (dom/stop-propagation event) - (dom/prevent-default event) + is-active + (or ^boolean is-selected + ^boolean is-hover) - (cond - (= edit-mode :move) - (st/emit! (drp/start-move-handler index prefix))))] + on-enter + (mf/use-fn + (mf/deps index prefix) + (fn [_] (st/emit! (drp/path-handler-enter index prefix)))) - [:g.handler {:pointer-events (if (= edit-mode :draw) "none" "visible")} + on-leave + (mf/use-fn + (mf/deps index prefix) + (fn [_] (st/emit! (drp/path-handler-leave index prefix)))) + + on-pointer-down + (mf/use-fn + (mf/deps index prefix is-move) + (fn [event] + (dom/stop-propagation event) + (dom/prevent-default event) + + (when ^boolean is-move + (st/emit! (drp/start-move-handler index prefix)))))] + + [:g.handler {:pointer-events (if ^boolean is-draw "none" "visible")} + [:line + {:x1 (:x point) + :y1 (:y point) + :x2 x + :y2 y + :style {:stroke (if ^boolean is-hover + black-color + gray-color) + :stroke-width (/ point-radius-stroke-width zoom)}}] + + (when ^boolean snap-angle [:line {:x1 (:x point) :y1 (:y point) :x2 x :y2 y - :style {:stroke (if hover? pc/black-color pc/gray-color) - :stroke-width (/ point-radius-stroke-width zoom)}}] + :style {:stroke secondary-color + :stroke-width (/ point-radius-stroke-width zoom)}}]) - (when snap-angle? - [:line - {:x1 (:x point) - :y1 (:y point) - :x2 x - :y2 y - :style {:stroke pc/secondary-color - :stroke-width (/ point-radius-stroke-width zoom)}}]) + [:rect + {:x (- x (/ handler-side 2 zoom)) + :y (- y (/ handler-side 2 zoom)) + :width (/ handler-side zoom) + :height (/ handler-side zoom) - [:rect - {:x (- x (/ handler-side 2 zoom)) - :y (- y (/ handler-side 2 zoom)) - :width (/ handler-side zoom) - :height (/ handler-side zoom) + :style {:stroke-width (/ handler-stroke-width zoom) + :stroke (cond ^boolean is-active black-color + :else accent-color) + :fill (cond ^boolean is-selected accent-color + :else white-color)}}] + [:circle {:cx x + :cy y + :r (/ point-radius-active-area zoom) + :on-pointer-down on-pointer-down + :on-pointer-enter on-enter + :on-pointer-leave on-leave + :class (when ^boolean is-move + (cur/get-static "pointer-move")) + :style {:fill "none" + :stroke-width 0}}]])) - :style {:stroke-width (/ handler-stroke-width zoom) - :stroke (cond (or selected? hover?) pc/black-color - :else pc/accent-color) - :fill (cond selected? pc/accent-color - :else pc/white-color)}}] - [:circle {:cx x - :cy y - :r (/ point-radius-active-area zoom) - :on-pointer-down on-pointer-down - :on-pointer-enter on-enter - :on-pointer-leave on-leave - :class (when (= edit-mode :move) (cur/get-static "pointer-move")) - :style {:fill "none" - :stroke-width 0}}]]))) +(mf/defc path-preview* + {::mf/private true} + [{:keys [zoom segment from]}] -(mf/defc path-preview [{:keys [zoom command from]}] - [:g.preview {:style {:pointer-events "none"}} - (when (not= :move-to (:command command)) - [:path {:style {:fill "none" - :stroke pc/black-color - :stroke-width (/ handler-stroke-width zoom) - :stroke-dasharray (/ path-preview-dasharray zoom)} - :d (upf/format-path [{:command :move-to - :params {:x (:x from) - :y (:y from)}} - command])}]) - [:& path-point {:position (:params command) - :preview? true - :zoom zoom}]]) + (let [path + (when (not= :move-to (:command segment)) + (let [segments [{:command :move-to + :params from}] + segments (conj segments segment)] + (path/content segments))) -(mf/defc path-snap [{:keys [selected points zoom]}] - (let [ranges (mf/use-memo (mf/deps selected points) #(snap/create-ranges points selected)) - snap-matches (snap/get-snap-delta-match selected ranges (/ 1 zoom)) - matches (concat (second (:x snap-matches)) (second (:y snap-matches)))] + position + (mf/with-memo [segment] + ;; FIXME: use a helper from common for this + (gpt/point (:params segment)))] + + [:g.preview {:style {:pointer-events "none"}} + (when (some? path) + [:path {:style {:fill "none" + :stroke black-color + :stroke-width (/ handler-stroke-width zoom) + :stroke-dasharray (/ path-preview-dasharray zoom)} + :d (str path)}]) + + [:> path-point* {:position position + :is-preview true + :zoom zoom}]])) + +(mf/defc path-snap* + {::mf/private true} + [{:keys [selected points zoom]}] + (let [ranges + (mf/with-memo [selected points] + (snap/create-ranges points selected)) + + snap-matches + (snap/get-snap-delta-match selected ranges (/ 1 zoom)) + + matches + (concat (second (:x snap-matches)) (second (:y snap-matches)))] [:g.snap-paths (for [[idx [from to]] (d/enumerate matches)] @@ -190,14 +246,14 @@ :y1 (:y from) :x2 (:x to) :y2 (:y to) - :style {:stroke pc/secondary-color + :style {:stroke secondary-color :stroke-width (/ path-snap-stroke-width zoom)}}])])) -(defn matching-handler? [content node handlers] +(defn- matching-handler? [content node handlers] (when (= 2 (count handlers)) (let [[[i1 p1] [i2 p2]] handlers - p1 (upc/handler->point content i1 p1) - p2 (upc/handler->point content i2 p2) + p1 (path.segment/get-handler-point content i1 p1) + p2 (path.segment/get-handler-point content i2 p2) v1 (gpt/to-vec node p1) v2 (gpt/to-vec node p2) @@ -205,12 +261,19 @@ angle (gpt/angle-with-other v1 v2)] (<= (- 180 angle) 0.1)))) -(mf/defc path-editor +(defn- make-edit-path-ref [id] + (let [get-fn #(dm/get-in % [:edit-path id])] + (l/derived get-fn refs/workspace-local))) + +(mf/defc path-editor* [{:keys [shape zoom]}] - (let [editor-ref (mf/use-ref nil) - edit-path-ref (pc/make-edit-path-ref (:id shape)) - hover-point (mf/use-state nil) + (let [shape-id (dm/get-prop shape :id) + edit-path-ref (mf/with-memo [shape-id] + (make-edit-path-ref shape-id)) + + hover-point (mf/use-state nil) + editor-ref (mf/use-ref nil) {:keys [edit-mode drag-handler @@ -224,141 +287,171 @@ hover-handlers hover-points snap-toggled] - :as edit-path} (mf/deref edit-path-ref) + :as edit-path} + (mf/deref edit-path-ref) - selected-points (or selected-points #{}) + selected-points + (or selected-points #{}) - shape (cond-> shape - (not= :path (:type shape)) - (ups/convert-to-path {}) + shape + (mf/with-memo [shape] + (cond-> shape + (not (cfh/path-shape? shape)) + (path/convert-to-path))) - :always - hooks/use-equal-memo) + base-content + (get shape :content) - base-content (:content shape) - base-points (mf/use-memo (mf/deps base-content) #(->> base-content gsp/content->points)) + base-points + (mf/with-memo [base-content] + (path/get-points base-content)) - content (upc/apply-content-modifiers base-content content-modifiers) - content-points (mf/use-memo (mf/deps content) #(->> content gsp/content->points)) + content + (mf/with-memo [base-content content-modifiers] + (path/apply-content-modifiers base-content content-modifiers)) + + content-points + (mf/with-memo [content] + (path/get-points content)) point->base (->> (map hash-map content-points base-points) (reduce merge)) base->point (map-invert point->base) - points (into #{} content-points) + points + (mf/with-memo [content-points] + (into #{} content-points)) - last-p (->> content last upc/command->point) - handlers (upc/content->handlers content) + last-p + (->> content last path.helpers/segment->point) - start-p? (not (some? last-point)) + handlers + (mf/with-memo [content] + (path.segment/get-handlers content)) - [snap-selected snap-points] - (cond - (some? drag-handler) [#{drag-handler} points] - (some? preview) [#{(upc/command->point preview)} points] - (some? moving-handler) [#{moving-handler} points] - :else - [(->> selected-points (map base->point) (into #{})) - (->> points (remove selected-points) (into #{}))]) + is-path-start + (not (some? last-point)) - show-snap? (and snap-toggled - (or (some? drag-handler) - (some? preview) - (some? moving-handler) - moving-nodes)) + show-snap? + (and ^boolean snap-toggled + (or (some? drag-handler) + (some? preview) + (some? moving-handler) + moving-nodes))] - handle-double-click-outside - (fn [_] - (when (= edit-mode :move) - (st/emit! :interrupt)))] - - (mf/use-layout-effect - (mf/deps edit-mode) - (fn [] - (let [keys [(events/listen (dom/get-root) EventType.DBLCLICK handle-double-click-outside)]] - #(doseq [key keys] - (events/unlistenByKey key))))) + (mf/with-layout-effect [edit-mode] + (let [key (events/listen (dom/get-root) "dblclick" + #(when (= edit-mode :move) + (st/emit! :interrupt)))] + #(events/unlistenByKey key))) (hooks/use-stream ms/mouse-position - (mf/deps shape zoom) + (mf/deps base-content zoom) (fn [position] - (when-let [point (gsp/path-closest-point shape position)] + (when-let [point (path.segment/closest-point base-content position)] (reset! hover-point (when (< (gpt/distance position point) (/ 10 zoom)) point))))) [:g.path-editor {:ref editor-ref} - [:path {:d (upf/format-path content) + [:path {:d (.toString content) :style {:fill "none" - :stroke pc/accent-color + :stroke accent-color :strokeWidth (/ 1 zoom)}}] (when (and preview (not drag-handler)) - [:& path-preview {:command preview - :from last-p - :zoom zoom}]) + [:> path-preview* {:segment preview + :from last-p + :zoom zoom}]) - (when drag-handler + (when (and drag-handler last-p) [:g.drag-handler {:pointer-events "none"} - [:& path-handler {:point last-p - :handler drag-handler - :edit-mode edit-mode - :zoom zoom}]]) + [:> path-handler* {:point last-p + :handler drag-handler + :edit-mode edit-mode + :zoom zoom}]]) (when @hover-point [:g.hover-point - [:& path-point {:position @hover-point - :edit-mode edit-mode - :new-point? true - :start-path? start-p? - :zoom zoom}]]) + [:> path-point* {:position @hover-point + :edit-mode edit-mode + :is-new true + :is-start-path is-path-start + :zoom zoom}]]) - (for [[index position] (d/enumerate points)] - (let [show-handler? + (for [position points] + (let [pos-x (dm/get-prop position :x) + pos-y (dm/get-prop position :y) + + show-handler? (fn [[index prefix]] - (let [handler-position (upc/handler->point content index prefix)] + ;; FIXME: get-handler-point is executed twice for each + ;; render, this can be optimized + (let [handler-position (path.segment/get-handler-point content index prefix)] (not= position handler-position))) - pos-handlers (get handlers position) - point-selected? (contains? selected-points (get point->base position)) - point-hover? (contains? hover-points (get point->base position)) - last-p? (= last-point (get point->base position)) + position-handlers + (->> (get handlers position) + (filter show-handler?) + (not-empty)) - pos-handlers (->> pos-handlers (filter show-handler?)) - curve? (boolean (seq pos-handlers))] + point-selected? + (contains? selected-points (get point->base position)) - [:g.path-node {:key (dm/str index "-" (:x position) "-" (:y position))} + point-hover? + (contains? hover-points (get point->base position)) + + is-last + (= last-point (get point->base position)) + + is-curve + (boolean position-handlers)] + + [:g.path-node {:key (dm/str pos-x "-" pos-y)} [:g.point-handlers {:pointer-events (when (= edit-mode :draw) "none")} - (for [[hindex prefix] pos-handlers] - (let [handler-position (upc/handler->point content hindex prefix) - handler-hover? (contains? hover-handlers [hindex prefix]) - moving-handler? (= handler-position moving-handler) - matching-handler? (matching-handler? content position pos-handlers)] - [:& path-handler {:key (dm/str (dm/str index "-" (:x position) "-" (:y position)) "-" hindex "-" (d/name prefix)) - :point position - :handler handler-position - :index hindex - :prefix prefix - :zoom zoom - :hover? handler-hover? - :snap-angle? (and moving-handler? matching-handler?) - :edit-mode edit-mode}]))] - [:& path-point {:position position - :zoom zoom - :edit-mode edit-mode - :selected? point-selected? - :hover? point-hover? - :last-p? last-p? - :start-path? start-p? - :curve? curve?}]])) + (for [[hindex prefix] position-handlers] + (let [handler-position (path.segment/get-handler-point content hindex prefix) + handler-hover? (contains? hover-handlers [hindex prefix]) + moving-handler? (= handler-position moving-handler) + matching-handler? (matching-handler? content position position-handlers)] - (when prev-handler + (when (and position handler-position) + [:> path-handler* + {:key (dm/str hindex "-" (d/name prefix)) + :point position + :handler handler-position + :index hindex + :prefix prefix + :zoom zoom + :is-hover handler-hover? + :snap-angle (and moving-handler? matching-handler?) + :edit-mode edit-mode}])))] + + [:> path-point* {:position position + :zoom zoom + :edit-mode edit-mode + :is-selected point-selected? + :is-hover point-hover? + :is-last is-last + :is-start-path is-path-start + :is-curve is-curve}]])) + + (when (and prev-handler last-p) [:g.prev-handler {:pointer-events "none"} - [:& path-handler {:point last-p - :edit-mode edit-mode - :handler prev-handler - :zoom zoom}]]) + [:> path-handler* + {:point last-p + :edit-mode edit-mode + :handler prev-handler + :zoom zoom}]]) - (when show-snap? - [:g.path-snap {:pointer-events "none"} - [:& path-snap {:selected snap-selected - :points snap-points - :zoom zoom}]])])) + (when ^boolean show-snap? + (let [[snap-selected snap-points] + (cond + (some? drag-handler) [#{drag-handler} points] + (some? preview) [#{(path.helpers/segment->point preview)} points] + (some? moving-handler) [#{moving-handler} points] + :else + [(->> selected-points (map base->point) (into #{})) + (->> points (remove selected-points) (into #{}))])] + [:g.path-snap {:pointer-events "none"} + [:> path-snap* {:selected snap-selected + :points snap-points + :zoom zoom}]]))])) diff --git a/frontend/src/app/main/ui/workspace/sidebar/options/menus/bool.cljs b/frontend/src/app/main/ui/workspace/sidebar/options/menus/bool.cljs index c3c2b68dea..f644156d93 100644 --- a/frontend/src/app/main/ui/workspace/sidebar/options/menus/bool.cljs +++ b/frontend/src/app/main/ui/workspace/sidebar/options/menus/bool.cljs @@ -8,7 +8,8 @@ (:require-macros [app.main.style :as stl]) (:require [app.common.data :as d] - [app.main.data.workspace :as dw] + [app.main.data.workspace.bool :as dwb] + [app.main.data.workspace.path.shapes-to-path :as dwps] [app.main.data.workspace.shortcuts :as sc] [app.main.refs :as refs] [app.main.store :as st] @@ -43,19 +44,21 @@ (mf/deps selected is-group? is-bool?) (fn [bool-type] (let [bool-type (keyword bool-type)] + (cond (> (count selected) 1) - (st/emit! (dw/create-bool bool-type)) + (st/emit! (dwb/create-bool bool-type)) (and (= (count selected) 1) is-group?) - (st/emit! (dw/group-to-bool (:id head) bool-type)) + (st/emit! (dwb/group-to-bool (:id head) bool-type)) (and (= (count selected) 1) is-bool?) (if (= head-bool-type bool-type) - (st/emit! (dw/bool-to-group (:id head))) - (st/emit! (dw/change-bool-type (:id head) bool-type))))))) + (st/emit! (dwb/bool-to-group (:id head))) + (st/emit! (dwb/change-bool-type (:id head) bool-type))))))) - flatten-objects (mf/use-fn #(st/emit! (dw/convert-selected-to-path)))] + flatten-objects + (mf/use-fn #(st/emit! (dwps/convert-selected-to-path)))] (when (not (and disabled-bool-btns disabled-flatten)) [:div {:class (stl/css :boolean-options)} diff --git a/frontend/src/app/main/ui/workspace/sidebar/options/shapes/bool.cljs b/frontend/src/app/main/ui/workspace/sidebar/options/shapes/bool.cljs index f789050820..a623f42bad 100644 --- a/frontend/src/app/main/ui/workspace/sidebar/options/shapes/bool.cljs +++ b/frontend/src/app/main/ui/workspace/sidebar/options/shapes/bool.cljs @@ -46,6 +46,7 @@ ids (hooks/use-equal-memo ids) parents-by-ids-ref (mf/use-memo (mf/deps ids) #(refs/parents-by-ids ids)) parents (mf/deref parents-by-ids-ref)] + [:* [:& layer-menu {:ids ids :type type diff --git a/frontend/src/app/main/ui/workspace/sidebar/options/shapes/multiple.cljs b/frontend/src/app/main/ui/workspace/sidebar/options/shapes/multiple.cljs index 52ec895267..11558a667e 100644 --- a/frontend/src/app/main/ui/workspace/sidebar/options/shapes/multiple.cljs +++ b/frontend/src/app/main/ui/workspace/sidebar/options/shapes/multiple.cljs @@ -12,6 +12,7 @@ [app.common.geom.shapes :as gsh] [app.common.text :as txt] [app.common.types.component :as ctk] + [app.common.types.path :as path] [app.common.types.shape.attrs :refer [editable-attrs]] [app.common.types.shape.layout :as ctl] [app.main.refs :as refs] @@ -294,7 +295,7 @@ file-id (unchecked-get props "file-id") shared-libs (unchecked-get props "libraries") - show-caps (some #(and (= :path (:type %)) (gsh/open-path? %)) shapes) + show-caps (some #(and (= :path (:type %)) (path/shape-with-open-path? %)) shapes) ;; Selrect/points only used for measures and it's the one that changes the most. We separate it ;; so we can memoize it diff --git a/frontend/src/app/main/ui/workspace/viewport.cljs b/frontend/src/app/main/ui/workspace/viewport.cljs index 4b5ded8307..0e225599d4 100644 --- a/frontend/src/app/main/ui/workspace/viewport.cljs +++ b/frontend/src/app/main/ui/workspace/viewport.cljs @@ -24,6 +24,7 @@ [app.main.ui.measurements :as msr] [app.main.ui.shapes.export :as use] [app.main.ui.workspace.shapes :as shapes] + [app.main.ui.workspace.shapes.path.editor :refer [path-editor*]] [app.main.ui.workspace.shapes.text.editor :as editor-v1] [app.main.ui.workspace.shapes.text.text-edition-outline :refer [text-edition-outline]] [app.main.ui.workspace.shapes.text.v2-editor :as editor-v2] @@ -116,7 +117,9 @@ objects-modified (mf/with-memo [base-objects text-modifiers modifiers] (apply-modifiers-to-selected selected base-objects text-modifiers modifiers)) - selected-shapes (keep (d/getf objects-modified) selected) + selected-shapes (->> selected + (into [] (keep (d/getf objects-modified))) + (not-empty)) ;; STATE alt? (mf/use-state false) @@ -164,15 +167,18 @@ editing-shape (when edition (get base-objects edition)) - create-comment? (= :comments drawing-tool) - drawing-path? (or (and edition (= :draw (get-in edit-path [edition :edit-mode]))) - (and (some? drawing-obj) (= :path (:type drawing-obj)))) - node-editing? (and edition (= :path (get-in base-objects [edition :type]))) - text-editing? (and edition (= :text (get-in base-objects [edition :type]))) + edit-path (get edit-path edition) + edit-path-mode (get edit-path :edit-mode) + create-comment? (= :comments drawing-tool) + drawing-path? (or (= edit-path-mode :draw) + (= :path (get drawing-obj :type))) + + node-editing? (cfh/path-shape? editing-shape) + text-editing? (cfh/text-shape? editing-shape) grid-editing? (and edition (ctl/grid-layout? base-objects edition)) - mode-inspect? (= options-mode :inspect) + mode-inspect? (= options-mode :inspect) on-click (actions/on-click hover selected edition drawing-path? drawing-tool space? selrect z?) on-context-menu (actions/on-context-menu hover hover-ids read-only?) @@ -282,7 +288,12 @@ [:div {:class (stl/css :viewport) :style #js {"--zoom" zoom} :data-testid "viewport"} (when (:can-edit permissions) - [:& top-bar/top-bar {:layout layout}]) + [:> top-bar/top-bar* {:layout layout + :selected selected-shapes + :edit-path edit-path + :drawing drawing + :edition edition + :is-read-only read-only?}]) [:div {:class (stl/css :viewport-overlays)} ;; The behaviour inside a foreign object is a bit different that in plain HTML so we wrap ;; inside a foreign object "dummy" so this awkward behaviour is take into account @@ -428,12 +439,13 @@ :zoom zoom :modifiers modifiers}]) - (when show-selection-handlers? - [:& selection/selection-area + (when (and show-selection-handlers? + selected-shapes) + [:> selection/area* {:shapes selected-shapes :zoom zoom :edition edition - :disable-handlers (or drawing-tool edition @space? @mod?) + :disabled (or drawing-tool edition @space? @mod?) :on-move-selected on-move-selected :on-context-menu on-menu-selected}]) @@ -501,7 +513,7 @@ :on-frame-select on-frame-select}]) (when show-draw-area? - [:& drawarea/draw-area + [:> drawarea/draw-area* {:shape drawing-obj :zoom zoom :tool drawing-tool}]) @@ -603,12 +615,16 @@ (when show-selection-handlers? [:g.selection-handlers {:clipPath "url(#clip-handlers)"} - [:& selection/selection-handlers - {:selected selected - :shapes selected-shapes - :zoom zoom - :edition edition - :disable-handlers (or drawing-tool edition @space?)}] + (when-not text-editing? + (if editing-shape + [:> path-editor* {:shape editing-shape + :zoom zoom}] + (when selected-shapes + [:> selection/handlers* + {:selected selected + :shapes selected-shapes + :zoom zoom + :disabled (or drawing-tool @space?)}]))) (when show-prototypes? [:& interactions/interactions diff --git a/frontend/src/app/main/ui/workspace/viewport/actions.cljs b/frontend/src/app/main/ui/workspace/viewport/actions.cljs index 42d23a2bff..6ff1e381e4 100644 --- a/frontend/src/app/main/ui/workspace/viewport/actions.cljs +++ b/frontend/src/app/main/ui/workspace/viewport/actions.cljs @@ -227,8 +227,9 @@ (dw/start-editing-selected)) (some? selected-shape) - (do (reset! hover selected-shape) - (st/emit! (dw/select-shape (:id selected-shape)))) + (do + (reset! hover selected-shape) + (st/emit! (dw/select-shape (:id selected-shape)))) (and (not selected-shape) (some? grid-layout-id) (not read-only?)) (st/emit! (dw/start-edition-mode grid-layout-id))))))))))) diff --git a/frontend/src/app/main/ui/workspace/viewport/drawarea.cljs b/frontend/src/app/main/ui/workspace/viewport/drawarea.cljs index 19870dfa64..725d2ec8e6 100644 --- a/frontend/src/app/main/ui/workspace/viewport/drawarea.cljs +++ b/frontend/src/app/main/ui/workspace/viewport/drawarea.cljs @@ -11,29 +11,13 @@ [app.common.types.shape :as cts] [app.main.ui.shapes.path :refer [path-shape]] [app.main.ui.workspace.shapes :as shapes] - [app.main.ui.workspace.shapes.path.editor :refer [path-editor]] + [app.main.ui.workspace.shapes.path.editor :refer [path-editor*]] [rumext.v2 :as mf])) -(declare generic-draw-area) -(declare path-draw-area) - -(mf/defc draw-area - [{:keys [shape zoom tool] :as props}] - - ;; Prevent rendering something that it's not a shape. - (when (cts/shape? shape) - [:g.draw-area - [:g {:style {:pointer-events "none"}} - [:& shapes/shape-wrapper {:shape shape}]] - - (case tool - :path [:& path-editor {:shape shape :zoom zoom}] - :curve [:& path-shape {:shape shape :zoom zoom}] - #_:default [:& generic-draw-area {:shape shape :zoom zoom}])])) - -(mf/defc generic-draw-area +(mf/defc generic-draw-area* + {::mf/private true} [{:keys [shape zoom]}] - (let [{:keys [x y width height]} (:selrect shape)] + (let [{:keys [x y width height]} (get shape :selrect)] (when (and x y (not (mth/nan? x)) (not (mth/nan? y))) @@ -45,3 +29,17 @@ :fill "none" :stroke-width (/ 1 zoom)}}]))) +(mf/defc draw-area* + [{:keys [shape zoom tool] :as props}] + + ;; Prevent rendering something that it's not a shape. + (when (cts/shape? shape) + [:g.draw-area + [:g {:style {:pointer-events "none"}} + [:& shapes/shape-wrapper {:shape shape}]] + + (case tool + :path [:> path-editor* props] + :curve [:& path-shape {:shape shape :zoom zoom}] + #_:default [:> generic-draw-area* props])])) + diff --git a/frontend/src/app/main/ui/workspace/viewport/outline.cljs b/frontend/src/app/main/ui/workspace/viewport/outline.cljs index 0043a3fe82..bbc7931d2d 100644 --- a/frontend/src/app/main/ui/workspace/viewport/outline.cljs +++ b/frontend/src/app/main/ui/workspace/viewport/outline.cljs @@ -8,7 +8,6 @@ (:require [app.common.data :as d] [app.common.data.macros :as dm] - [app.common.exceptions :as ex] [app.common.files.helpers :as cfh] [app.common.geom.shapes :as gsh] [app.common.types.component :as ctk] @@ -17,7 +16,6 @@ [app.main.ui.hooks :as hooks] [app.main.ui.shapes.attrs :as attrs] [app.util.object :as obj] - [app.util.path.format :as upf] [clojure.set :as set] [rumext.v2 :as mf])) @@ -51,7 +49,7 @@ path-data (mf/with-memo [path? content] (when (and ^boolean path? (some? content)) - (d/nilv (ex/ignoring (upf/format-path content)) ""))) + (.toString content))) border-attrs (attrs/get-border-props shape) diff --git a/frontend/src/app/main/ui/workspace/viewport/path_actions.cljs b/frontend/src/app/main/ui/workspace/viewport/path_actions.cljs index f866a364eb..b79a6ff619 100644 --- a/frontend/src/app/main/ui/workspace/viewport/path_actions.cljs +++ b/frontend/src/app/main/ui/workspace/viewport/path_actions.cljs @@ -7,16 +7,14 @@ (ns app.main.ui.workspace.viewport.path-actions (:require-macros [app.main.style :as stl]) (:require + [app.common.types.path.segment :as path.segm] [app.main.data.workspace.path :as drp] [app.main.data.workspace.path.shortcuts :as sc] [app.main.store :as st] [app.main.ui.icons :as i] - [app.main.ui.workspace.shapes.path.common :as pc] [app.util.i18n :as i18n :refer [tr]] - [app.util.path.tools :as upt] [rumext.v2 :as mf])) - (def ^:private pentool-icon (i/icon-xref :pentool (stl/css :pentool-icon :pathbar-icon))) @@ -47,9 +45,8 @@ (def ^:private snap-nodes-icon (i/icon-xref :snap-nodes (stl/css :snap-nodes-icon :pathbar-icon))) - (defn check-enabled [content selected-points] - (let [segments (upt/get-segments content selected-points) + (let [segments (path.segm/get-segments-with-points content selected-points) num-segments (count segments) num-points (count selected-points) points-selected? (seq selected-points) @@ -58,7 +55,7 @@ max-segments (-> num-points (* (- num-points 1)) (/ 2)) - is-curve? (some #(upt/is-curve? content %) selected-points)] + is-curve? (some #(path.segm/is-curve? content %) selected-points)] {:make-corner (and points-selected? is-curve?) :make-curve (and points-selected? (not is-curve?)) @@ -68,9 +65,10 @@ :join-nodes (and points-selected? (>= num-points 2) (< num-segments max-segments)) :separate-nodes segments-selected?})) +(mf/defc path-actions* + [{:keys [shape edit-path]}] + (let [{:keys [edit-mode selected-points snap-toggled]} edit-path -(mf/defc path-actions [{:keys [shape]}] - (let [{:keys [edit-mode selected-points snap-toggled] :as all} (mf/deref pc/current-edit-path-ref) content (:content shape) enabled-buttons @@ -79,66 +77,66 @@ #(check-enabled content selected-points)) on-select-draw-mode - (mf/use-callback + (mf/use-fn (fn [_] (st/emit! (drp/change-edit-mode :draw)))) on-select-edit-mode - (mf/use-callback + (mf/use-fn (fn [_] (st/emit! (drp/change-edit-mode :move)))) on-add-node - (mf/use-callback + (mf/use-fn (mf/deps (:add-node enabled-buttons)) (fn [_] (when (:add-node enabled-buttons) (st/emit! (drp/add-node))))) on-remove-node - (mf/use-callback + (mf/use-fn (mf/deps (:remove-node enabled-buttons)) (fn [_] (when (:remove-node enabled-buttons) (st/emit! (drp/remove-node))))) on-merge-nodes - (mf/use-callback + (mf/use-fn (mf/deps (:merge-nodes enabled-buttons)) (fn [_] (when (:merge-nodes enabled-buttons) (st/emit! (drp/merge-nodes))))) on-join-nodes - (mf/use-callback + (mf/use-fn (mf/deps (:join-nodes enabled-buttons)) (fn [_] (when (:join-nodes enabled-buttons) (st/emit! (drp/join-nodes))))) on-separate-nodes - (mf/use-callback + (mf/use-fn (mf/deps (:separate-nodes enabled-buttons)) (fn [_] (when (:separate-nodes enabled-buttons) (st/emit! (drp/separate-nodes))))) on-make-corner - (mf/use-callback + (mf/use-fn (mf/deps (:make-corner enabled-buttons)) (fn [_] (when (:make-corner enabled-buttons) (st/emit! (drp/make-corner))))) on-make-curve - (mf/use-callback + (mf/use-fn (mf/deps (:make-curve enabled-buttons)) (fn [_] (when (:make-curve enabled-buttons) (st/emit! (drp/make-curve))))) on-toggle-snap - (mf/use-callback + (mf/use-fn (fn [_] (st/emit! (drp/toggle-snap))))] diff --git a/frontend/src/app/main/ui/workspace/viewport/selection.cljs b/frontend/src/app/main/ui/workspace/viewport/selection.cljs index a3b4005f0c..7f6f47d32d 100644 --- a/frontend/src/app/main/ui/workspace/viewport/selection.cljs +++ b/frontend/src/app/main/ui/workspace/viewport/selection.cljs @@ -20,7 +20,6 @@ [app.main.store :as st] [app.main.ui.context :as ctx] [app.main.ui.css-cursors :as cur] - [app.main.ui.workspace.shapes.path.editor :refer [path-editor]] [app.util.array :as array] [app.util.debug :as dbg] [app.util.dom :as dom] @@ -314,9 +313,8 @@ :style {:fill (if (dbg/enabled? :handlers) "yellow" "none") :stroke-width 0}}]])) -(mf/defc controls-selection - {::mf/wrap-props false} - [{:keys [shape zoom color on-move-selected on-context-menu disable-handlers]}] +(mf/defc controls-selection* + [{:keys [shape zoom color on-move-selected on-context-menu disabled]}] (let [selrect (dm/get-prop shape :selrect) transform-type (mf/deref refs/current-transform) sr-transform (mf/deref refs/workspace-selrect-transform) @@ -330,7 +328,7 @@ (when (and (some? selrect) (not (or (= transform-type :move) (= transform-type :rotate)))) - [:g.controls {:pointer-events (if ^boolean disable-handlers "none" "visible")} + [:g.controls {:pointer-events (if ^boolean disabled "none" "visible")} ;; Selection rect [:& selection-rect {:rect selrect :transform transform @@ -339,9 +337,9 @@ :on-move-selected on-move-selected :on-context-menu on-context-menu}]]))) -(mf/defc controls-handlers - {::mf/wrap-props false} - [{:keys [shape zoom color on-resize on-rotate disable-handlers]}] +(mf/defc controls-handlers* + {::mf/private true} + [{:keys [shape zoom color on-resize on-rotate disabled]}] (let [transform-type (mf/deref refs/current-transform) sr-transform (mf/deref refs/workspace-selrect-transform) @@ -370,7 +368,7 @@ (not (or (= transform-type :move) (= transform-type :rotate)))) - [:g.controls {:pointer-events (if ^boolean disable-handlers "none" "visible")} + [:g.controls {:pointer-events (if ^boolean disabled "none" "visible")} (for [handler (calculate-handlers selrect shape zoom)] (let [type (obj/get handler "type") position (obj/get handler "position") @@ -425,9 +423,9 @@ :stroke-opacity 1 :fill "none"}}]])) -(mf/defc multiple-handlers - {::mf/wrap-props false} - [{:keys [shapes selected zoom color disable-handlers]}] +(mf/defc multiple-handlers* + {::mf/private true} + [{:keys [shapes selected zoom color disabled]}] (let [shape (mf/with-memo [shapes] (-> shapes (gsh/shapes->rect) @@ -452,34 +450,34 @@ (dom/stop-propagation event) (st/emit! (dw/start-rotate shapes)))))] - [:& controls-handlers + [:> controls-handlers* {:shape shape :zoom zoom :color color - :disable-handlers disable-handlers + :disabled disabled :on-resize on-resize :on-rotate on-rotate}])) -(mf/defc multiple-selection - {::mf/wrap-props false} - [{:keys [shapes zoom color disable-handlers on-move-selected on-context-menu]}] +(mf/defc multiple-selection* + {::mf/private true} + [{:keys [shapes zoom color disabled on-move-selected on-context-menu]}] (let [shape (mf/with-memo [shapes] (-> shapes (gsh/shapes->rect) (assoc :type :multiple) (cts/setup-shape)))] - [:& controls-selection + [:> controls-selection* {:shape shape :zoom zoom :color color - :disable-handlers disable-handlers + :disabled disabled :on-move-selected on-move-selected :on-context-menu on-context-menu}])) -(mf/defc single-handlers - {::mf/wrap-props false} - [{:keys [shape zoom color disable-handlers]}] +(mf/defc single-handlers* + {::mf/private true} + [{:keys [shape zoom color disabled]}] (let [shape-id (dm/get-prop shape :id) on-resize @@ -501,28 +499,27 @@ (dom/stop-propagation event) (st/emit! (dw/start-rotate [shape])))))] - [:& controls-handlers + [:> controls-handlers* {:shape shape :zoom zoom :color color - :disable-handlers disable-handlers + :disabled disabled :on-rotate on-rotate :on-resize on-resize}])) -(mf/defc single-selection - {::mf/wrap-props false} - [{:keys [shape zoom color disable-handlers on-move-selected on-context-menu]}] - [:& controls-selection +(mf/defc single-selection* + {::mf/private true} + [{:keys [shape zoom color disabled on-move-selected on-context-menu]}] + [:> controls-selection* {:shape shape :zoom zoom :color color - :disable-handlers disable-handlers + :disabled disabled :on-move-selected on-move-selected :on-context-menu on-context-menu}]) -(mf/defc selection-area - {::mf/wrap-props false} - [{:keys [shapes edition zoom disable-handlers on-move-selected on-context-menu]}] +(mf/defc area* + [{:keys [shapes edition zoom disabled on-move-selected on-context-menu]}] (let [total (count shapes) shape (first shapes) @@ -538,15 +535,12 @@ selection-rect-color-normal)] (cond - (zero? total) - nil - (> total 1) - [:& multiple-selection + [:> multiple-selection* {:shapes shapes :zoom zoom :color color - :disable-handlers disable-handlers + :disabled disabled :on-move-selected on-move-selected :on-context-menu on-context-menu}] @@ -561,55 +555,38 @@ nil :else - [:& single-selection + [:> single-selection* {:shape shape :zoom zoom :color color - :disable-handlers disable-handlers + :disabled disabled :on-move-selected on-move-selected :on-context-menu on-context-menu}]))) -(mf/defc selection-handlers - {::mf/wrap-props false} - [{:keys [shapes selected edition zoom disable-handlers]}] +(mf/defc handlers* + [{:keys [shapes selected zoom disabled]}] (let [total (count shapes) - shape (first shapes) - shape-id (dm/get-prop shape :id) ;; Note that we don't use mf/deref to avoid a repaint dependency here objects (deref refs/workspace-page-objects) - color (if (and (= total 1) ^boolean + color (if (and (= total 1) + ^boolean (or (ctn/in-any-component? objects shape) (ctk/is-variant-container? shape))) selection-rect-color-component selection-rect-color-normal)] - (cond - (zero? total) - nil - - (> total 1) - [:& multiple-handlers + (if (> total 1) + [:> multiple-handlers* {:shapes shapes :selected selected :zoom zoom :color color - :disable-handlers disable-handlers}] - - (and (cfh/text-shape? shape) - (= edition shape-id)) - nil - - (= edition shape-id) - [:& path-editor - {:zoom zoom - :shape shape}] - - :else - [:& single-handlers + :disabled disabled}] + [:> single-handlers* {:shape shape :zoom zoom :color color - :disable-handlers disable-handlers}]))) + :disabled disabled}]))) diff --git a/frontend/src/app/main/ui/workspace/viewport/top_bar.cljs b/frontend/src/app/main/ui/workspace/viewport/top_bar.cljs index 6767735dbf..570eaad0b0 100644 --- a/frontend/src/app/main/ui/workspace/viewport/top_bar.cljs +++ b/frontend/src/app/main/ui/workspace/viewport/top_bar.cljs @@ -7,23 +7,22 @@ (ns app.main.ui.workspace.viewport.top-bar (:require-macros [app.main.style :as stl]) (:require + [app.common.data.macros :as dm] [app.common.files.helpers :as cfh] [app.common.types.shape.layout :as ctl] [app.main.data.workspace :as dw] [app.main.data.workspace.common :as dwc] - [app.main.refs :as refs] [app.main.store :as st] - [app.main.ui.context :as ctx] [app.main.ui.workspace.top-toolbar :refer [top-toolbar]] [app.main.ui.workspace.viewport.grid-layout-editor :refer [grid-edition-actions]] - [app.main.ui.workspace.viewport.path-actions :refer [path-actions]] + [app.main.ui.workspace.viewport.path-actions :refer [path-actions*]] [app.util.i18n :as i18n :refer [tr]] [rumext.v2 :as mf])) -(mf/defc view-only-actions +(mf/defc view-only-actions* [] (let [handle-close-view-mode - (mf/use-callback + (mf/use-fn (fn [] (st/emit! :interrupt (dw/set-options-mode :design) @@ -38,43 +37,44 @@ :on-click handle-close-view-mode} (tr "workspace.top-bar.read-only.done")]]])) -(mf/defc top-bar - {::mf/wrap [mf/memo]} - [{:keys [layout]}] - (let [edition (mf/deref refs/selected-edition) - selected (mf/deref refs/selected-objects) - drawing (mf/deref refs/workspace-drawing) - rulers? (mf/deref refs/rulers?) - drawing-obj (:object drawing) +(mf/defc top-bar* + [{:keys [layout drawing is-read-only edition selected edit-path]}] + (let [rulers? (contains? layout :rulers) + hide-ui? (contains? layout :hide-ui) + + drawing-obj (get drawing :object) shape (or drawing-obj (-> selected first)) + shape-id (dm/get-prop shape :id) - single? (= (count selected) 1) - editing? (= (:id shape) edition) - draw-path? (and (some? drawing-obj) - (cfh/path-shape? drawing-obj) - (not= :curve (:tool drawing))) + single? (= (count selected) 1) + editing? (= shape-id edition) - workspace-read-only? (mf/use-ctx ctx/workspace-read-only?) - hide-ui? (:hide-ui layout) + draw-path? (and (some? drawing-obj) + (cfh/path-shape? drawing-obj) + (not= :curve (:tool drawing))) - path-edition? (or (and single? editing? - (and (not (cfh/text-shape? shape)) - (not (cfh/frame-shape? shape)))) - draw-path?) + is-path-edition + (or (and single? editing? + (and (not (cfh/text-shape? shape)) + (not (cfh/frame-shape? shape)))) + draw-path?) - grid-edition? (and single? editing? (ctl/grid-layout? shape))] + grid-edition? + (and single? editing? (ctl/grid-layout? shape))] [:* - (when-not hide-ui? + (when-not ^boolean hide-ui? [:& top-toolbar {:layout layout}]) (cond - workspace-read-only? - [:& view-only-actions] + ^boolean + is-read-only + [:> view-only-actions*] - path-edition? + ^boolean + is-path-edition [:div {:class (stl/css-case :viewport-actions-path true :viewport-actions-no-rulers (not rulers?))} - [:& path-actions {:shape shape}]] + [:> path-actions* {:shape shape :edit-path edit-path}]] grid-edition? [:& grid-edition-actions {:shape shape}])])) diff --git a/frontend/src/app/main/ui/workspace/viewport_wasm.cljs b/frontend/src/app/main/ui/workspace/viewport_wasm.cljs index 5830dcad06..1222000fa3 100644 --- a/frontend/src/app/main/ui/workspace/viewport_wasm.cljs +++ b/frontend/src/app/main/ui/workspace/viewport_wasm.cljs @@ -23,6 +23,7 @@ [app.main.ui.flex-controls :as mfc] [app.main.ui.hooks :as ui-hooks] [app.main.ui.measurements :as msr] + [app.main.ui.workspace.shapes.path.editor :refer [path-editor*]] [app.main.ui.workspace.shapes.text.editor :as editor-v1] [app.main.ui.workspace.shapes.text.text-edition-outline :refer [text-edition-outline]] [app.main.ui.workspace.shapes.text.v2-editor :as editor-v2] @@ -119,8 +120,9 @@ (binding [cts/*wasm-sync* false] (apply-modifiers-to-selected selected base-objects text-modifiers modifiers))) - selected-shapes (keep (d/getf objects-modified) selected) - + selected-shapes (->> selected + (into [] (keep (d/getf objects-modified))) + (not-empty)) ;; STATE alt? (mf/use-state false) shift? (mf/use-state false) @@ -173,14 +175,18 @@ editing-shape (when edition (get base-objects edition)) + edit-path (get edit-path edition) + edit-path-mode (get edit-path :edit-mode) + create-comment? (= :comments drawing-tool) - drawing-path? (or (and edition (= :draw (get-in edit-path [edition :edit-mode]))) - (and (some? drawing-obj) (= :path (:type drawing-obj)))) - node-editing? (and edition (= :path (get-in base-objects [edition :type]))) - text-editing? (and edition (= :text (get-in base-objects [edition :type]))) + drawing-path? (or (= edit-path-mode :draw) + (= :path (get drawing-obj :type))) + + node-editing? (cfh/path-shape? editing-shape) + text-editing? (cfh/text-shape? editing-shape) grid-editing? (and edition (ctl/grid-layout? base-objects edition)) - mode-inspect? (= options-mode :inspect) + mode-inspect? (= options-mode :inspect) on-click (actions/on-click hover selected edition drawing-path? drawing-tool space? selrect z?) on-context-menu (actions/on-context-menu hover hover-ids read-only?) @@ -338,7 +344,12 @@ [:div {:class (stl/css :viewport) :style #js {"--zoom" zoom} :data-testid "viewport"} (when (:can-edit permissions) - [:& top-bar/top-bar {:layout layout}]) + [:> top-bar/top-bar* {:layout layout + :selected selected-shapes + :edit-path edit-path + :drawing drawing + :edition edition + :is-read-only read-only?}]) [:div {:class (stl/css :viewport-overlays)} (when show-comments? [:> comments/comments-layer* {:vbox vbox @@ -434,12 +445,13 @@ :zoom zoom :modifiers modifiers}]) - (when show-selection-handlers? - [:& selection/selection-area + (when (and show-selection-handlers? + selected-shapes) + [:> selection/area* {:shapes selected-shapes :zoom zoom :edition edition - :disable-handlers (or drawing-tool edition @space? @mod?) + :disabled (or drawing-tool edition @space? @mod?) :on-move-selected on-move-selected :on-context-menu on-menu-selected}]) @@ -507,7 +519,7 @@ :on-frame-select on-frame-select}]) (when show-draw-area? - [:& drawarea/draw-area + [:> drawarea/draw-area* {:shape drawing-obj :zoom zoom :tool drawing-tool}]) @@ -609,12 +621,16 @@ (when show-selection-handlers? [:g.selection-handlers {:clipPath "url(#clip-handlers)"} - [:& selection/selection-handlers - {:selected selected - :shapes selected-shapes - :zoom zoom - :edition edition - :disable-handlers (or drawing-tool edition @space?)}] + (when-not text-editing? + (if editing-shape + [:> path-editor* {:shape editing-shape + :zoom zoom}] + (when selected-shapes + [:> selection/handlers* + {:selected selected + :shapes selected-shapes + :zoom zoom + :disabled (or drawing-tool @space?)}]))) (when show-prototypes? [:& interactions/interactions diff --git a/frontend/src/app/plugins/api.cljs b/frontend/src/app/plugins/api.cljs index 9ce731f18b..2e381ce4d6 100644 --- a/frontend/src/app/plugins/api.cljs +++ b/frontend/src/app/plugins/api.cljs @@ -376,10 +376,10 @@ (u/display-not-valid :createBoolean-shapes shapes) :else - (let [ids (into #{} (map #(obj/get % "$id")) shapes) - id-ret (atom nil)] - (st/emit! (dwb/create-bool bool-type ids {:id-ret id-ret})) - (shape/shape-proxy plugin-id @id-ret))))) + (let [ids (into #{} (map #(obj/get % "$id")) shapes) + shape-id (uuid/next)] + (st/emit! (dwb/create-bool bool-type :ids ids :force-shape-id shape-id)) + (shape/shape-proxy plugin-id shape-id))))) :generateMarkup (fn [shapes options] diff --git a/frontend/src/app/plugins/shape.cljs b/frontend/src/app/plugins/shape.cljs index f05981d1d4..682b90b9b2 100644 --- a/frontend/src/app/plugins/shape.cljs +++ b/frontend/src/app/plugins/shape.cljs @@ -15,18 +15,19 @@ [app.common.record :as crc] [app.common.schema :as sm] [app.common.spec :as us] - [app.common.svg.path :as path] + [app.common.svg.path :as svg.path] [app.common.text :as txt] [app.common.types.component :as ctk] [app.common.types.container :as ctn] [app.common.types.file :as ctf] [app.common.types.grid :as ctg] + [app.common.types.path :as path] + [app.common.types.path.segment :as path.segm] [app.common.types.shape :as cts] [app.common.types.shape.blur :as ctsb] [app.common.types.shape.export :as ctse] [app.common.types.shape.interactions :as ctsi] [app.common.types.shape.layout :as ctl] - [app.common.types.shape.path :as ctsp] [app.common.types.shape.radius :as ctsr] [app.common.types.shape.shadow :as ctss] [app.common.uuid :as uuid] @@ -50,7 +51,6 @@ [app.plugins.text :as text] [app.plugins.utils :as u] [app.util.object :as obj] - [app.util.path.format :as upf] [beicon.v2.core :as rx] [cuerdas.core :as str])) @@ -1018,7 +1018,7 @@ (u/display-not-valid :makeMask (:type shape)) :else - (upf/format-path (:content shape))))) + (.toString (:content shape))))) ;; Text shapes :getRange @@ -1309,21 +1309,22 @@ (cond-> (or (cfh/path-shape? data) (cfh/bool-shape? data)) (crc/add-properties! {:name "content" - :get #(-> % u/proxy->shape :content upf/format-path) + :get #(-> % u/proxy->shape :content .toString) :set (fn [_ value] - (let [content (->> (path/parse value))] + (let [content (svg.path/parse value)] (cond (not (cfh/path-shape? data)) (u/display-not-valid :content-type type) - (not (sm/validate ::ctsp/content content)) + ;; FIXME: revisit path content validation + (not (sm/validate ::path/content content)) (u/display-not-valid :content value) (not (r/check-permission plugin-id "content:write")) (u/display-not-valid :content "Plugin doesn't have 'content:write' permission") :else - (let [selrect (gsh/content->selrect content) + (let [selrect (path.segm/content->selrect content) points (grc/rect->points selrect)] (st/emit! (dwsh/update-shapes [id] (fn [shape] (assoc shape :content content :selrect selrect :points points))))))))})))))) diff --git a/frontend/src/app/render_wasm/api.cljs b/frontend/src/app/render_wasm/api.cljs index caff9874e4..7ea9c85b91 100644 --- a/frontend/src/app/render_wasm/api.cljs +++ b/frontend/src/app/render_wasm/api.cljs @@ -10,8 +10,8 @@ ["react-dom/server" :as rds] [app.common.data :as d] [app.common.data.macros :as dm] + [app.common.types.path :as path] [app.common.types.shape.layout :as ctl] - [app.common.types.shape.path :as path] [app.common.uuid :as uuid] [app.config :as cf] [app.main.fonts :as fonts] @@ -309,13 +309,14 @@ (h/call wasm/internal-module "stringToUTF8" str offset size) (h/call wasm/internal-module "_set_shape_path_attrs" (count attrs)))) +;; FIXME: revisit on heap refactor is merged to use u32 instead u8 (defn set-shape-path-content [content] - (let [pdata (path/path-data content) - size (* (count pdata) path/SEGMENT-BYTE-SIZE) + (let [pdata (path/content content) + size (path/get-byte-size content) offset (mem/alloc-bytes size) heap (mem/get-heap-u8)] - (path/-write-to pdata (.-buffer heap) offset) + (path/write-to pdata (.-buffer heap) offset) (h/call wasm/internal-module "_set_shape_path_content"))) (defn set-shape-svg-raw-content diff --git a/frontend/src/app/util/path/format.cljs b/frontend/src/app/util/path/format.cljs deleted file mode 100644 index 5ec19173a6..0000000000 --- a/frontend/src/app/util/path/format.cljs +++ /dev/null @@ -1,137 +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.path.format - (:require - [app.common.svg.path.command :as upc] - [app.common.svg.path.subpath :refer [pt=]] - [app.util.array :as arr])) - -;; TODO: move to common - -(def path-precision 3) - -(defn- join-params - ([a] - (js* "\"\"+~{}" - (.toFixed a path-precision))) - ([a b] - (js* "\"\"+~{}+\",\"+~{}" - (.toFixed a path-precision) - (.toFixed b path-precision))) - ([a b c] - (js* "\"\"+~{}+\",\"+~{}+\",\"+~{}" - (.toFixed a path-precision) - (.toFixed b path-precision) - (.toFixed c path-precision))) - ([a b c d] - (js* "\"\"+~{}+\",\"+~{}+\",\"+~{}+\",\"+~{}" - (.toFixed a path-precision) - (.toFixed b path-precision) - (.toFixed c path-precision) - (.toFixed d path-precision))) - ([a b c d e] - (js* "\"\"+~{}+\",\"+~{}+\",\"+~{}+\",\"+~{}+\",\"+~{}" - (.toFixed a path-precision) - (.toFixed b path-precision) - (.toFixed c path-precision) - (.toFixed d path-precision) - (.toFixed e path-precision))) - ([a b c d e f] - (js* "\"\"+~{}+\",\"+~{}+\",\"+~{}+\",\"+~{}+\",\"+~{}+\",\"+~{}" - (.toFixed a path-precision) - (.toFixed b path-precision) - (.toFixed c path-precision) - (.toFixed d path-precision) - (.toFixed e path-precision) - (.toFixed f path-precision))) - ([a b c d e f g] - (js* "\"\"+~{}+\",\"+~{}+\",\"+~{}+\",\"+~{}+\",\"+~{}+\",\"+~{}+\",\"+~{}" - (.toFixed a path-precision) - (.toFixed b path-precision) - (.toFixed c path-precision) - (.toFixed d path-precision) - (.toFixed e path-precision) - (.toFixed f path-precision) - (.toFixed g path-precision)))) - -(defn- translate-params - [command {:keys [x y] :as params}] - (case command - (:move-to :line-to :smooth-quadratic-bezier-curve-to) - (join-params x y) - - :close-path - "" - - (:line-to-horizontal :line-to-vertical) - (:value params) - - :curve-to - (let [{:keys [c1x c1y c2x c2y]} params] - (join-params (or c1x x) (or c1y y) (or c2x x) (or c2y y) x y)) - - (:smooth-curve-to :quadratic-bezier-curve-to) - (let [{:keys [cx cy]} params] - (join-params cx cy x y)) - - :elliptical-arc - (let [{:keys [rx ry x-axis-rotation large-arc-flag sweep-flag]} params] - (join-params rx ry x-axis-rotation large-arc-flag sweep-flag x y)) - - "")) - -(defn- translate-command - [cname] - (case cname - :move-to "M" - :close-path "Z" - :line-to "L" - :line-to-horizontal "H" - :line-to-vertical "V" - :curve-to "C" - :smooth-curve-to "S" - :quadratic-bezier-curve-to "Q" - :smooth-quadratic-bezier-curve-to "T" - :elliptical-arc "A" - "")) - - -(defn- command->string - [{:keys [command relative params]}] - (let [cmd (cond-> (translate-command command) - relative (.toLowerCase)) - prm (translate-params command params)] - (js* "~{} + ~{}" cmd prm))) - -(defn- set-point - [command {:keys [x y]}] - (update command :params assoc :x x :y y)) - -(defn format-path [content] - (try - (let [result (make-array (count content))] - (reduce (fn [last-move current] - (let [point (upc/command->point current) - current-move? (= :move-to (:command current)) - last-move (if current-move? point last-move)] - - (if (and (not current-move?) (pt= last-move point)) - (arr/conj! result (command->string (set-point current last-move))) - (arr/conj! result (command->string current))) - - (when (and (not current-move?) (pt= last-move point)) - (arr/conj! result "Z")) - - last-move)) - nil - content) - (.join ^js result "")) - - (catch :default err - (.error js/console err) - nil))) - diff --git a/frontend/src/app/util/path/tools.cljs b/frontend/src/app/util/path/tools.cljs deleted file mode 100644 index 11975774ab..0000000000 --- a/frontend/src/app/util/path/tools.cljs +++ /dev/null @@ -1,461 +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.path.tools - (:require - [app.common.data :as d] - [app.common.geom.point :as gpt] - [app.common.geom.shapes.path :as upg] - [app.common.svg.path.command :as upc] - [clojure.set :as set])) - -;; FIXME: move to common, there are nothing tied to frontend - -(defn remove-line-curves - "Remove all curves that have both handlers in the same position that the - beginning and end points. This makes them really line-to commands" - [content] - (let [with-prev (d/enumerate (d/with-prev content)) - process-command - (fn [content [index [command prev]]] - - (let [cur-point (upc/command->point command) - pre-point (upc/command->point prev) - handler-c1 (upc/get-handler command :c1) - handler-c2 (upc/get-handler command :c2)] - (if (and (= :curve-to (:command command)) - (= cur-point handler-c2) - (= pre-point handler-c1)) - (assoc content index {:command :line-to - :params (into {} cur-point)}) - content)))] - - (reduce process-command content with-prev))) - -(defn make-corner-point - "Changes the content to make a point a 'corner'" - [content point] - (let [handlers (-> (upc/content->handlers content) - (get point)) - change-content - (fn [content [index prefix]] - (let [cx (d/prefix-keyword prefix :x) - cy (d/prefix-keyword prefix :y)] - (-> content - (assoc-in [index :params cx] (:x point)) - (assoc-in [index :params cy] (:y point)))))] - (as-> content $ - (reduce change-content $ handlers) - (remove-line-curves $)))) - -(defn line->curve - [from-p cmd] - - (let [to-p (upc/command->point cmd) - - v (gpt/to-vec from-p to-p) - d (gpt/distance from-p to-p) - - dv1 (-> (gpt/normal-left v) - (gpt/scale (/ d 3))) - - h1 (gpt/add from-p dv1) - - dv2 (-> (gpt/to-vec to-p h1) - (gpt/unit) - (gpt/scale (/ d 3))) - - h2 (gpt/add to-p dv2)] - (-> cmd - (assoc :command :curve-to) - (update :params (fn [params] - ;; ensure plain map - (-> (into {} params) - (assoc :c1x (:x h1)) - (assoc :c1y (:y h1)) - (assoc :c2x (:x h2)) - (assoc :c2y (:y h2)))))))) - -(defn is-curve? - [content point] - (let [handlers (-> (upc/content->handlers content) - (get point)) - handler-points (map #(upc/handler->point content (first %) (second %)) handlers)] - (some #(not= point %) handler-points))) - -(def ^:private xf:mapcat-points - (comp - (mapcat #(vector (:next-p %) (:prev-p %))) - (remove nil?))) - -(defn make-curve-point - "Changes the content to make the point a 'curve'. The handlers will be positioned - in the same vector that results from the previous->next points but with fixed length." - [content point] - - (let [indices (upc/point-indices content point) - vectors (map (fn [index] - (let [cmd (nth content index) - prev-i (dec index) - prev (when (not (= :move-to (:command cmd))) - (get content prev-i)) - next-i (inc index) - next (get content next-i) - - next (when (not (= :move-to (:command next))) - next)] - {:index index - :prev-i (when (some? prev) prev-i) - :prev-c prev - :prev-p (upc/command->point prev) - :next-i (when (some? next) next-i) - :next-c next - :next-p (upc/command->point next) - :command cmd})) - indices) - - points (into #{} xf:mapcat-points vectors)] - - (if (= (count points) 2) - (let [v1 (gpt/to-vec (first points) point) - v2 (gpt/to-vec (first points) (second points)) - vp (gpt/project v1 v2) - vh (gpt/subtract v1 vp) - - add-curve - (fn [content {:keys [index prev-p next-p next-i]}] - (let [cur-cmd (get content index) - next-cmd (get content next-i) - - ;; New handlers for prev-point and next-point - prev-h (when (some? prev-p) (gpt/add prev-p vh)) - next-h (when (some? next-p) (gpt/add next-p vh)) - - ;; Correct 1/3 to the point improves the curve - prev-correction (when (some? prev-h) (gpt/scale (gpt/to-vec prev-h point) (/ 1 3))) - next-correction (when (some? next-h) (gpt/scale (gpt/to-vec next-h point) (/ 1 3))) - - prev-h (when (some? prev-h) (gpt/add prev-h prev-correction)) - next-h (when (some? next-h) (gpt/add next-h next-correction))] - (cond-> content - (and (= :line-to (:command cur-cmd)) (some? prev-p)) - (update index upc/update-curve-to prev-p prev-h) - - (and (= :line-to (:command next-cmd)) (some? next-p)) - (update next-i upc/update-curve-to next-h next-p) - - (and (= :curve-to (:command cur-cmd)) (some? prev-p)) - (update index upc/update-handler :c2 prev-h) - - (and (= :curve-to (:command next-cmd)) (some? next-p)) - (update next-i upc/update-handler :c1 next-h))))] - - (reduce add-curve content vectors)) - - (let [add-curve - (fn [content {:keys [index command prev-p next-c next-i]}] - (cond-> content - (= :line-to (:command command)) - (update index #(line->curve prev-p %)) - - (= :curve-to (:command command)) - (update index #(line->curve prev-p %)) - - (= :line-to (:command next-c)) - (update next-i #(line->curve point %)) - - (= :curve-to (:command next-c)) - (update next-i #(line->curve point %))))] - (reduce add-curve content vectors))))) - -(defn get-segments - "Given a content and a set of points return all the segments in the path - that uses the points" - [content points] - (let [point-set (set points)] - - (loop [segments [] - prev-point nil - start-point nil - index 0 - cur-cmd (first content) - content (rest content)] - - (let [command (:command cur-cmd) - close-path? (= command :close-path) - move-to? (= command :move-to) - - ;; Close-path makes a segment from the last point to the initial path point - cur-point (if close-path? - start-point - (upc/command->point cur-cmd)) - - ;; If there is a move-to we don't have a segment - prev-point (if move-to? - nil - prev-point) - - ;; We update the start point - start-point (if move-to? - cur-point - start-point) - - is-segment? (and (some? prev-point) - (contains? point-set prev-point) - (contains? point-set cur-point)) - - segments (cond-> segments - is-segment? - (conj {:start prev-point - :end cur-point - :cmd cur-cmd - :index index}))] - - (if (some? cur-cmd) - (recur segments - cur-point - start-point - (inc index) - (first content) - (rest content)) - - segments))))) - -(defn split-segments - "Given a content creates splits commands between points with new segments" - [content points value] - - (let [split-command - (fn [{:keys [start end cmd index]}] - (case (:command cmd) - :line-to [index (upg/split-line-to start cmd value)] - :curve-to [index (upg/split-curve-to start cmd value)] - :close-path [index [(upc/make-line-to (gpt/lerp start end value)) cmd]] - nil)) - - cmd-changes - (->> (get-segments content points) - (into {} (comp (map split-command) - (filter (comp not nil?))))) - - process-segments - (fn [[index command]] - (if (contains? cmd-changes index) - (get cmd-changes index) - [command]))] - - (into [] (mapcat process-segments) (d/enumerate content)))) - -(defn remove-nodes - "Removes from content the points given. Will try to reconstruct the paths - to keep everything consistent" - [content points] - - (if (empty? points) - content - - (let [content (d/with-prev content)] - - (loop [result [] - last-handler nil - [cur-cmd prev-cmd] (first content) - content (rest content)] - - (if (nil? cur-cmd) - ;; The result with be an array of arrays were every entry is a subpath - (->> result - ;; remove empty and only 1 node subpaths - (filter #(> (count %) 1)) - ;; flatten array-of-arrays plain array - (flatten) - (into [])) - - (let [move? (= :move-to (:command cur-cmd)) - curve? (= :curve-to (:command cur-cmd)) - - ;; When the old command was a move we start a subpath - result (if move? (conj result []) result) - - subpath (peek result) - - point (upc/command->point cur-cmd) - - old-prev-point (upc/command->point prev-cmd) - new-prev-point (upc/command->point (peek subpath)) - - remove? (contains? points point) - - - ;; We store the first handler for the first curve to be removed to - ;; use it for the first handler of the regenerated path - cur-handler (cond - (and (not last-handler) remove? curve?) - (select-keys (:params cur-cmd) [:c1x :c1y]) - - (not remove?) - nil - - :else - last-handler) - - cur-cmd (cond-> cur-cmd - ;; If we're starting a subpath and it's not a move make it a move - (and (not move?) (empty? subpath)) - (assoc :command :move-to - :params (select-keys (:params cur-cmd) [:x :y])) - - ;; If have a curve the first handler will be relative to the previous - ;; point. We change the handler to the new previous point - (and curve? (seq subpath) (not= old-prev-point new-prev-point)) - (update :params merge last-handler)) - - head-idx (dec (count result)) - - result (cond-> result - (not remove?) - (update head-idx conj cur-cmd))] - (recur result - cur-handler - (first content) - (rest content)))))))) - -(defn join-nodes - "Creates new segments between points that weren't previously" - [content points] - - (let [segments-set (into #{} - (map (juxt :start :end)) - (get-segments content points)) - - create-line-command (fn [point other] - [(upc/make-move-to point) - (upc/make-line-to other)]) - - not-segment? (fn [point other] (and (not (contains? segments-set [point other])) - (not (contains? segments-set [other point])))) - - new-content (->> (d/map-perm create-line-command not-segment? points) - (flatten) - (into []))] - - (into content new-content))) - - -(defn separate-nodes - "Removes the segments between the points given" - [content points] - - (let [content (d/with-prev content)] - (loop [result [] - [cur-cmd prev-cmd] (first content) - content (rest content)] - - (if (nil? cur-cmd) - (->> result - (filter #(> (count %) 1)) - (flatten) - (into [])) - - (let [prev-point (upc/command->point prev-cmd) - cur-point (upc/command->point cur-cmd) - - cur-cmd (cond-> cur-cmd - (and (contains? points prev-point) - (contains? points cur-point)) - - (assoc :command :move-to - :params (select-keys (:params cur-cmd) [:x :y]))) - - move? (= :move-to (:command cur-cmd)) - - result (if move? (conj result []) result) - head-idx (dec (count result)) - - result (-> result - (update head-idx conj cur-cmd))] - (recur result - (first content) - (rest content))))))) - - -(defn- add-to-set - "Given a list of sets adds the value to the target set" - [set-list target value] - (->> set-list - (mapv (fn [it] - (cond-> it - (= it target) (conj value)))))) - -(defn- join-sets - "Given a list of sets join two sets in the list into a new one" - [set-list target other] - (conj (->> set-list - (filterv #(and (not= % target) - (not= % other)))) - (set/union target other))) - -(defn group-segments [segments] - (loop [result [] - {point-a :start point-b :end :as segment} (first segments) - segments (rest segments)] - - (if (nil? segment) - result - - (let [set-a (d/seek #(contains? % point-a) result) - set-b (d/seek #(contains? % point-b) result) - - result (cond-> result - (and (nil? set-a) (nil? set-b)) - (conj #{point-a point-b}) - - (and (some? set-a) (nil? set-b)) - (add-to-set set-a point-b) - - (and (nil? set-a) (some? set-b)) - (add-to-set set-b point-a) - - (and (some? set-a) (some? set-b) (not= set-a set-b)) - (join-sets set-a set-b))] - (recur result - (first segments) - (rest segments)))))) - -(defn calculate-merge-points [group-segments points] - (let [index-merge-point (fn [group] (vector group (gpt/center-points group))) - index-group (fn [point] (vector point (d/seek #(contains? % point) group-segments))) - - group->merge-point (into {} (map index-merge-point) group-segments) - point->group (into {} (map index-group) points)] - (d/mapm #(group->merge-point %2) point->group))) - -;; TODO: Improve the replace for curves -(defn replace-points - "Replaces the points in a path for its merge-point" - [content point->merge-point] - (let [replace-command - (fn [cmd] - (let [point (upc/command->point cmd)] - (if (contains? point->merge-point point) - (let [merge-point (get point->merge-point point)] - (-> cmd (update :params assoc :x (:x merge-point) :y (:y merge-point)))) - cmd)))] - (->> content - (mapv replace-command)))) - -(defn merge-nodes - "Reduces the contiguous segments in points to a single point" - [content points] - (let [segments (get-segments content points)] - (if (seq segments) - (let [point->merge-point (-> segments - (group-segments) - (calculate-merge-points points))] - (-> content - (separate-nodes points) - (replace-points point->merge-point))) - content))) - diff --git a/frontend/src/app/worker/import.cljs b/frontend/src/app/worker/import.cljs index f2ea47fabe..f658d97eae 100644 --- a/frontend/src/app/worker/import.cljs +++ b/frontend/src/app/worker/import.cljs @@ -11,13 +11,13 @@ [app.common.exceptions :as ex] [app.common.files.builder :as fb] [app.common.geom.point :as gpt] - [app.common.geom.shapes.path :as gpa] [app.common.json :as json] [app.common.logging :as log] [app.common.media :as cm] [app.common.schema :as sm] [app.common.text :as ct] [app.common.time :as tm] + [app.common.types.path :as path] [app.common.uuid :as uuid] [app.main.repo :as rp] [app.util.http :as http] @@ -330,7 +330,7 @@ (d/update-when :x + (:x frame)) (d/update-when :y + (:y frame)) (cond-> (= :path type) - (update :content gpa/move-content (gpt/point (:x frame) (:y frame))))) + (update :content path/move-content (gpt/point (:x frame) (:y frame))))) data))) diff --git a/render-wasm/src/shapes/paths.rs b/render-wasm/src/shapes/paths.rs index a09ec3c545..6ad5e5075d 100644 --- a/render-wasm/src/shapes/paths.rs +++ b/render-wasm/src/shapes/paths.rs @@ -14,26 +14,26 @@ pub struct RawPathData { impl RawPathData { fn command(&self) -> Result { - let cmd = u16::from_be_bytes(self.data[0..2].try_into().map_err(stringify_slice_err)?); + let cmd = u16::from_le_bytes(self.data[0..2].try_into().map_err(stringify_slice_err)?); Ok(cmd) } fn xy(&self) -> Result { - let x = f32::from_be_bytes(self.data[20..24].try_into().map_err(stringify_slice_err)?); - let y = f32::from_be_bytes(self.data[24..].try_into().map_err(stringify_slice_err)?); + let x = f32::from_le_bytes(self.data[20..24].try_into().map_err(stringify_slice_err)?); + let y = f32::from_le_bytes(self.data[24..].try_into().map_err(stringify_slice_err)?); Ok((x, y)) } fn c1(&self) -> Result { - let c1_x = f32::from_be_bytes(self.data[4..8].try_into().map_err(stringify_slice_err)?); - let c1_y = f32::from_be_bytes(self.data[8..12].try_into().map_err(stringify_slice_err)?); + let c1_x = f32::from_le_bytes(self.data[4..8].try_into().map_err(stringify_slice_err)?); + let c1_y = f32::from_le_bytes(self.data[8..12].try_into().map_err(stringify_slice_err)?); Ok((c1_x, c1_y)) } fn c2(&self) -> Result { - let c2_x = f32::from_be_bytes(self.data[12..16].try_into().map_err(stringify_slice_err)?); - let c2_y = f32::from_be_bytes(self.data[16..20].try_into().map_err(stringify_slice_err)?); + let c2_x = f32::from_le_bytes(self.data[12..16].try_into().map_err(stringify_slice_err)?); + let c2_y = f32::from_le_bytes(self.data[16..20].try_into().map_err(stringify_slice_err)?); Ok((c2_x, c2_y)) }