diff --git a/backend/src/app/binfile/common.clj b/backend/src/app/binfile/common.clj index 95fae4dfe..5d756beec 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/features/components_v2.clj b/backend/src/app/features/components_v2.clj index af106b167..9e142aeb3 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 1d9a649f3..992d76af9 100644 --- a/backend/src/app/features/fdata.clj +++ b/backend/src/app/features/fdata.clj @@ -9,7 +9,9 @@ (:require [app.common.data :as d] [app.common.exceptions :as ex] + [app.common.files.helpers :as cfh] [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 +32,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn enable-objects-map - [file] + [file & _opts] (let [update-page (fn [page] (if (and (pmap/pointer-map? page) @@ -136,10 +138,39 @@ (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] + ;; NOTE: if we found a pointer and it is not modified, we + ;; skip updating objects for not creating additional + ;; pointers + (if (and (pmap/pointer-map? container) + (not (pmap/modified? 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")))) diff --git a/backend/src/app/srepl/main.clj b/backend/src/app/srepl/main.clj index e55a0bfdc..4b00767ee 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,11 @@ "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] + (h/process-file! system file-id update-fn opts)))))) (defn process-team-files! "Apply a function to each file of the specified team." diff --git a/common/src/app/common/features.cljc b/common/src/app/common/features.cljc index 8f53a9257..11177f56c 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" @@ -86,8 +87,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 d320e8bc4..071fd31d9 100644 --- a/common/src/app/common/files/builder.cljc +++ b/common/src/app/common/files/builder.cljc @@ -21,6 +21,7 @@ [app.common.types.file :as ctf] [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.uuid :as uuid] [cuerdas.core :as str])) @@ -272,7 +273,8 @@ :else (let [objects (lookup-objects file) - content (gsh/calc-bool-content bool objects) + ;; FIXME: this makes a duplicate operation + content (path/calc-bool-content bool objects) bool' (gsh/update-bool-selrect bool children objects)] (commit-change file diff --git a/common/src/app/common/files/changes_builder.cljc b/common/src/app/common/files/changes_builder.cljc index 7c78e9339..e1df708d6 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] diff --git a/common/src/app/common/files/migrations.cljc b/common/src/app/common/files/migrations.cljc index 7bd2342ae..68f6eb232 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/segments->content (:segments shape) (: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,21 @@ (d/update-when :components d/update-vals update-container) (d/without-nils)))) +(defmethod migrate-data "0003-convert-path-content" + [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 +1379,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 e4f265c4c..fa1ba12bd 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 0883e9cd8..88d9442c8 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,11 @@ (and ^boolean (mth/almost-zero? (dm/get-prop p :x)) ^boolean (mth/almost-zero? (dm/get-prop p :y)))) +(defn zero? + [p] + (and ^boolean (= 0 (dm/get-prop p :x)) + ^boolean (= 0 (dm/get-prop p :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 2f0c29df7..d03583cfd 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])) @@ -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 48116a88d..000000000 --- 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 91a2053ad..3117e20ad 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 6601315ca..1bf11f87e 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 50a41e06f..24f579a5b 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) @@ -446,22 +449,11 @@ (defn update-bool-selrect "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] diff --git a/common/src/app/common/schema.cljc b/common/src/app/common/schema.cljc index 50a317cda..557dc8b3d 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 57bc3703f..01805e8ac 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/svg/path/command.cljc b/common/src/app/common/svg/path/command.cljc deleted file mode 100644 index b048d8524..000000000 --- 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 index 7f7dc0d81..12beb8887 100644 --- a/common/src/app/common/svg/path/legacy_parser1.cljs +++ b/common/src/app/common/svg/path/legacy_parser1.cljs @@ -12,10 +12,9 @@ (: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] + [app.common.types.path.segment :as path.segm] [cuerdas.core :as str])) (def commands-regex #"(?i)[mzlhvcsqta][^mzlhvcsqta]*") @@ -160,7 +159,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.segm/calculate-opposite-handler pos handler)] {:c1x c1x :c1y c1y :c2x (:cx params) @@ -262,7 +261,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.segm/calculate-opposite-handler prev-pos prev-qc))))) result (if (= :elliptical-arc (:command command)) (into result (arc->beziers prev-pos command)) @@ -285,13 +284,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.segm/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)) + (path.segm/get-point prev-pos command)) next-start (if (= :move-to (:command command)) next-pos prev-start)] diff --git a/common/src/app/common/svg/path/legacy_parser2.cljc b/common/src/app/common/svg/path/legacy_parser2.cljc index cbd7a4999..6a80c0d61 100644 --- a/common/src/app/common/svg/path/legacy_parser2.cljc +++ b/common/src/app/common/svg/path/legacy_parser2.cljc @@ -12,10 +12,9 @@ (: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.segment :as path.segm] [cuerdas.core :as str])) (def commands-regex #"(?i)[mzlhvcsqta][^mzlhvcsqta]*") @@ -185,7 +184,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.segm/calculate-opposite-handler pos handler)] {:c1x c1x :c1y c1y :c2x (:cx params) @@ -413,7 +412,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.segm/calculate-opposite-handler prev-pos prev-qc))))) result (if (= :elliptical-arc (:command command)) (into result (arc->beziers prev-pos command)) @@ -436,13 +435,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.segm/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)) + (path.segm/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 90e088951..aa0a49548 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/path.cljc b/common/src/app/common/types/path.cljc new file mode 100644 index 000000000..44584b012 --- /dev/null +++ b/common/src/app/common/types/path.cljc @@ -0,0 +1,209 @@ +;; 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- 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 40bb9cc82..624246c54 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/command->point prev)))))))) (defn close-paths "Removes the :close-path commands and replace them for line-to so we can calculate the intersections" [content] - (loop [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/command->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/command->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 62% rename from common/src/app/common/geom/shapes/path.cljc rename to common/src/app/common/types/path/helpers.cljc index a7e56f3d2..bba145fae 100644 --- a/common/src/app/common/geom/shapes/path.cljc +++ b/common/src/app/common/types/path/helpers.cljc @@ -4,17 +4,19 @@ ;; ;; 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 +24,135 @@ (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)) + +;; FIXME: looks very similar to get-point +(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))])) + +(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 [(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 line-values [[from-p to-p] t] @@ -101,73 +199,6 @@ (gpt/point (coord-v :x) (coord-v :y))))) -(defn curve-tangent - "Retrieve the tangent vector to the curve in the point `t`" - [[start end h1 h2] t] - - (let [coords [[(:x start) (:x h1) (:x h2) (:x end)] - [(:y start) (:y h1) (:y h2) (:y end)]] - - solve-derivative - (fn [[c0 c1 c2 c3]] - ;; Solve B'(t) given t to retrieve the value for the - ;; first derivative - (let [t2 (* t t)] - (+ (* c0 (+ (* -3 t2) (* 6 t) -3)) - (* c1 (+ (* 9 t2) (* -12 t) 3)) - (* c2 (+ (* -9 t2) (* 6 t))) - (* c3 (* 3 t2))))) - - [x y] (->> coords (mapv solve-derivative)) - - ;; normalize value - d (mth/hypot x y)] - - (if (mth/almost-zero? d) - (gpt/point 0 0) - (gpt/point (/ x d) (/ y d))))) - -(defn curve-windup - [curve t] - - (let [tangent (curve-tangent curve t)] - (cond - (> (:y tangent) 0) -1 - (< (: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" @@ -261,198 +292,42 @@ ;; 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)) +(defn curve-tangent + "Retrieve the tangent vector to the curve in the point `t`" + [[start end h1 h2] t] - ([start end h1 h2 coord] + (let [coords [[(:x start) (:x h1) (:x h2) (:x end)] + [(:y start) (:y h1) (:y h2) (:y end)]] - (let [coords [[(get start coord) (get h1 coord) (get h2 coord) (get end coord)]] + solve-derivative + (fn [[c0 c1 c2 c3]] + ;; Solve B'(t) given t to retrieve the value for the + ;; first derivative + (let [t2 (* t t)] + (+ (* c0 (+ (* -3 t2) (* 6 t) -3)) + (* c1 (+ (* 9 t2) (* -12 t) 3)) + (* c2 (+ (* -9 t2) (* 6 t))) + (* c3 (* 3 t2))))) - coord->tvalue - (fn [[pa pb pc pd]] + [x y] (->> coords (mapv solve-derivative)) - (let [a (+ (* 3 pa) (* -6 pb) (* 3 pc)) - b (+ (* -3 pa) (* 3 pb)) - c pa - d (+ (- pa) (* 3 pb) (* -3 pc) pd)] + ;; normalize value + d (mth/hypot x y)] - (solve-roots a b c d)))] - (->> coords - (mapcat coord->tvalue) - ;; Only values in the range [0, 1] are valid - (filterv #(and (>= % 0) (<= % 1))))))) + (if (mth/almost-zero? d) + (gpt/point 0 0) + (gpt/point (/ x d) (/ y d))))) -(defn command->point - ([command] - (command->point command nil)) +(defn curve-windup + [curve t] - ([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))))) + (let [tangent (curve-tangent curve t)] + (cond + (> (:y tangent) 0) -1 + (< (:y tangent) 0) 1 + :else 0))) -(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 +346,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 cmd t-val] + (let [to-p (command->point cmd) + sp (gpt/lerp from-p to-p t-val)] + [(make-line-to sp) cmd])) - (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 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)] + [(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 cmd values] + (let [values (->> values (filter #(and (> % 0) (< % 1))))] + (if (empty? values) + [cmd] + (let [to-p (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) + (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 cmd values] - (< (d t1) (d t2)) - [t1 ht] + (let [values (->> values (filter #(and (> % 0) (< % 1))))] + (if (empty? values) + [cmd] + (let [to-p (command->point cmd) + params (:params cmd) + 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 +498,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 +558,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 +589,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 +610,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 +704,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 +727,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? [cmd] + (case (:command cmd) + :line-to (segment-has-point? point (command->line cmd)) + :curve-to (curve-has-point? point (command->bezier cmd)) + #_: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/shape/path.cljc b/common/src/app/common/types/path/impl.cljc similarity index 58% rename from common/src/app/common/types/shape/path.cljc rename to common/src/app/common/types/path/impl.cljc index fde14fa66..3c52d21f1 100644 --- a/common/src/app/common/types/shape/path.cljc +++ b/common/src/app/common/types/path/impl.cljc @@ -4,84 +4,99 @@ ;; ;; Copyright (c) KALEIDOS INC -(ns app.common.types.shape.path +(ns app.common.types.path.impl + "Contains schemas and data type implementation for PathData binary + and plain formats" (:require #?(:clj [app.common.fressian :as fres]) + #?(:clj [clojure.data.json :as json]) + [app.common.data.macros :as dm] [app.common.schema :as sm] - [app.common.transit :as t]) + [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]))) #?(:clj (set! *warn-on-reflection* true)) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; SCHEMA: PLAIN FORMAT -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(def ^:const SEGMENT-BYTE-SIZE 28) -(def schema:line-to-segment - [:map - [:command [:= :line-to]] - [:params - [:map - [:x ::sm/safe-number] - [:y ::sm/safe-number]]]]) +(defprotocol IPathData + (-write-to [_ buffer offset] "write the content to the specified buffer") + (-get-byte-size [_] "get byte size")) -(def schema:close-path-segment - [:map - [:command [:= :close-path]]]) +(defprotocol ITransformable + (-transform [_ m] "apply a transform")) -(def schema:move-to-segment - [:map - [:command [:= :move-to]] - [:params - [:map - [:x ::sm/safe-number] - [:y ::sm/safe-number]]]]) +(defn- transform! + "Apply a transformation to a segment located under specified offset" + [buffer offset m] + (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) + t #?(:clj (.getShort ^ByteBuffer buffer offset) + :cljs (.getInt16 buffer offset))] -(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]]]]) + (case t + (1 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))) + x (+ (* x a) (* y c) e) + y (+ (* x b) (* y d) f)] + #?(:clj (.putFloat ^ByteBuffer buffer (+ offset 20) x) + :cljs (.setFloat32 buffer (+ offset 20) x)) + #?(:clj (.putFloat ^ByteBuffer buffer (+ offset 24) y) + :cljs (.setFloat32 buffer (+ offset 24) y))) -(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]]) + 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))) -(def schema:path-content - [:vector schema:path-segment]) + 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)] -(def check-path-content - (sm/check-fn schema:path-content)) + #?(:clj (.putFloat ^ByteBuffer buffer (+ offset 4) c1x) + :cljs (.setFloat32 buffer (+ offset 4) c1x)) + #?(:clj (.putFloat ^ByteBuffer buffer (+ offset 8) c1y) + :cljs (.setFloat32 buffer (+ offset 8) c1y)) + #?(:clj (.putFloat ^ByteBuffer buffer (+ offset 12) c2x) + :cljs (.setFloat32 buffer (+ offset 12) c2x)) + #?(:clj (.putFloat ^ByteBuffer buffer (+ offset 16) c2y) + :cljs (.setFloat32 buffer (+ offset 16) c2y)) + #?(:clj (.putFloat ^ByteBuffer buffer (+ offset 20) x) + :cljs (.setFloat32 buffer (+ offset 20) x)) + #?(:clj (.putFloat ^ByteBuffer buffer (+ offset 24) y) + :cljs (.setFloat32 buffer (+ offset 24) y))) -(sm/register! ::segment schema:path-segment) -(sm/register! ::content schema:path-content) + nil))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; TYPE: PATH-DATA ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(def ^:const SEGMENT-BYTE-SIZE 28) - -(defprotocol IPathData - (-write-to [_ buffer offset] "write the content to the specified buffer") - (-bytes [_] "get path data as byte array")) - -(defrecord PathSegment [command params]) - -(defn- get-path-string +(defn- to-string "Format the path data structure to string" [buffer size] (let [builder #?(:clj (java.lang.StringBuilder. (int (* size 4))) @@ -143,6 +158,7 @@ (.toString builder))) (defn- read-segment + "Read segment from binary buffer at specified index" [buffer index] (let [offset (* index SEGMENT-BYTE-SIZE) type #?(:clj (.getShort ^ByteBuffer buffer offset) @@ -152,13 +168,15 @@ :cljs (.getFloat32 buffer (+ offset 20))) y #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 24)) :cljs (.getFloat32 buffer (+ offset 24)))] - (->PathSegment :move-to {:x x :y y})) + {:command :move-to + :params {: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})) + {:command :line-to + :params {:x x :y y}}) 3 (let [c1x #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 4)) :cljs (.getFloat32 buffer (+ offset 4))) @@ -172,38 +190,71 @@ :cljs (.getFloat32 buffer (+ offset 20))) y #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 24)) :cljs (.getFloat32 buffer (+ offset 24)))] + {:command :curve-to + :params {:x x :y y :c1x c1x :c1y c1y :c2x c2x :c2y c2y}}) - (->PathSegment :curve-to {:x x :y y :c1x c1x :c1y c1y :c2x c2x :c2y c2y})) - - 4 (->PathSegment :close-path {})))) + 4 {:command :close-path + :params {}}))) (defn- in-range? [size i] (and (< i size) (>= i 0))) +(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) + (ByteBuffer/wrap dst)) + :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))) + #?(:clj - (deftype PathData [size buffer] + (deftype PathData [size buffer ^:unsynchronized-mutable hash] Object (toString [_] - (get-path-string buffer size)) + (to-string buffer size)) - clojure.lang.Sequential - clojure.lang.IPersistentCollection - - (empty [_] - (throw (ex-info "not implemented" {}))) - (equiv [_ other] + (equals [_ 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)))))) + ITransformable + (-transform [_ m] + (let [buffer (clone-buffer buffer)] + (loop [index 0] + (when (< index size) + (let [offset (* index SEGMENT-BYTE-SIZE)] + (transform! buffer offset m) + (recur (inc index))))) + (PathData. size buffer nil))) - (cons [_ _val] - (throw (ex-info "not implemented" {}))) + 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] @@ -230,33 +281,47 @@ clojure.lang.Counted (count [_] size) - IPathData - (-write-to [_ _ _] - (throw (RuntimeException. "not implemented"))) + (-get-byte-size [_] + (* size SEGMENT-BYTE-SIZE)) - (-bytes [_] - (.array ^ByteBuffer buffer))) + (-write-to [_ _ _] + (throw (RuntimeException. "not implemented")))) :cljs - (deftype PathData [size buffer dview] + #_:clj-kondo/ignore + (deftype PathData [size buffer dview ^:mutable __hash] Object (toString [_] - (get-path-string dview size)) + (to-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)))) + (-get-byte-size [_] + (.-byteLength buffer)) - (-bytes [_] - (js/Uint8Array. 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)] + (loop [index 0] + + (when (< index size) + (let [offset (* index SEGMENT-BYTE-SIZE)] + (transform! dview offset m) + (recur (inc index))))) + (PathData. size buffer dview nil))) cljs.core/ISequential cljs.core/IEquiv - (-equiv [_ other] + (-equiv [this other] (if (instance? PathData other) (let [obuffer (.-buffer other)] (if (= (.-byteLength obuffer) @@ -298,8 +363,8 @@ result))) cljs.core/IHash - (-hash [_] - (throw (ex-info "not-implemented" {}))) + (-hash [coll] + (caching-hash coll hash-ordered-coll __hash)) cljs.core/ICounted (-count [_] size) @@ -319,22 +384,136 @@ (-seq [this] (when (pos? size) (->> (range size) - (map (fn [i] (cljs.core/-nth this i)))))))) + (map (fn [i] (cljs.core/-nth this i)))))) -(defn- from-bytes + 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)) + +(sm/register! ::path/segment schema:segment) +(sm/register! ::path/segments schema:segments) + +(defn path-data? + [o] + (instance? PathData o)) + +(declare from-string) +(declare from-plain) + +(sm/register! + {:type ::path/content + :pred path-data? + :type-properties + {:gen/gen (->> (sg/generator schema:segments) + (sg/filter not-empty) + (sg/fmap #(from-plain %))) + :encode/json identity + :decode/json (fn [s] + (cond + (string? s) + (from-string s) + + (vector? s) + (from-plain s) + + :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))] - (PathData. count buffer)) + (PathData. count buffer nil)) (bytes? buffer) (let [size (alength ^bytes buffer) count (long (/ size SEGMENT-BYTE-SIZE))] (PathData. count - (ByteBuffer/wrap buffer))) + (ByteBuffer/wrap buffer) + nil)) :else (throw (java.lang.IllegalArgumentException. "invalid data provided"))) @@ -346,37 +525,40 @@ count (long (/ size SEGMENT-BYTE-SIZE))] (PathData. count buffer - (js/DataView. buffer))) + (js/DataView. buffer) + nil)) (instance? js/DataView buffer) (let [dview buffer buffer (.-buffer dview) size (.-byteLength buffer) count (long (/ size SEGMENT-BYTE-SIZE))] - (PathData. count buffer dview)) + (PathData. count buffer dview 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 +(defn from-plain "Create a PathData instance from plain data structures" - [content] - (assert (check-path-content content)) + [segments] + (assert (check-segments segments)) - (let [content (vec content) - total (count content) + (let [total (count segments) #?@(: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) + (let [segment (nth segments index) offset (* index SEGMENT-BYTE-SIZE)] (case (get segment :command) :move-to @@ -438,21 +620,30 @@ PathData instance" [data] (cond - (instance? PathData data) + (path-data? data) data + (nil? data) + (from-plain []) + (sequential? data) (from-plain data) :else - (from-bytes data))) + (throw (ex-info "unexpected data" {:data data})))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; SERIALIZATION +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (t/add-handlers! {:id "penpot/path-data" :class PathData :wfn (fn [^PathData pdata] - (-bytes pdata)) - :rfn path-data}) + (let [buffer (.-buffer pdata)] + #?(:cljs (js/Uint8Array. buffer) + :clj (.array ^ByteBuffer buffer)))) + :rfn from-bytes}) #?(:clj (fres/add-handlers! @@ -465,4 +656,5 @@ (fres/write-bytes! w bytes))) :rfn (fn [r] (let [^bytes bytes (fres/read-object! r)] - (path-data (ByteBuffer/wrap bytes))))})) + (from-bytes (ByteBuffer/wrap 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 000000000..5f3198ed9 --- /dev/null +++ b/common/src/app/common/types/path/segment.cljc @@ -0,0 +1,856 @@ +;; 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.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 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)) + (get-point segment)))) + + ([segment] + (when segment + (let [{:keys [x y]} (:params segment)] + (gpt/point x y))))) + +(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))))) + +;; FIXME: rename segments->handlers +(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 (get-point cur-cmd) + pre-pos (get-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 (get-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 (get-point cur-cmd) + pre-pos (get-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) + (get-point (nth content index)) + (get-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]] (= (get-point cmd) point))))) + +;; FIXME: candidate to be optimized with native data type operation +(defn handler->point + [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] (helpers/prefix->coords prefix)] + (gpt/point (get params cx) + (get params cy))) + (gpt/point (get params :x) + (get params :y))))))) + +;; FIXME: revisit this function +(defn handler->node + [content index prefix] + (if (= prefix :c1) + (get-point (nth content (dec index))) + (get-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)))) + +;; FIXME: revisit, this function is executed many times per render on +;; path editor it is easy to be implemented in function of PathData +;; type in a more efficient way + +(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 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}]))))) + +;; 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-cmd prev-cmd]] + (let [from-p (helpers/command->point prev-cmd) + to-p (helpers/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- 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 (get-point command) + pre-point (get-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 (-> (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 segment] + + (let [to-p (get-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)))))))) + +(defn is-curve? + [content point] + (let [handlers (-> (content->handlers content) + (get point)) + handler-points (map #(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 (get-point prev) + :next-i (when (some? next) next-i) + :next-c next + :next-p (get-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))))) + +;; FIXME: revisit the impl of this function +(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 + (get-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 (helpers/split-line-to start cmd value)] + :curve-to [index (helpers/split-curve-to start cmd value)] + :close-path [index [(helpers/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)))) + +;; 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-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 (get-point cur-cmd) + + old-prev-point (get-point prev-cmd) + new-prev-point (get-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] + [(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-cmd prev-cmd] (first content) + content (rest content)] + + (if (nil? cur-cmd) + (->> result + (filter #(> (count %) 1)) + (flatten) + (into [])) + + (let [prev-point (get-point prev-cmd) + cur-point (get-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 (get-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))) + +(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))) + +;; FIXME: add optimizations +(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 (helpers/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 (helpers/command->point command :c1) + c2 (helpers/command->point command :c2) + curve [from-p to-p c1 c2]] + (when (and from-p to-p c1 c2) + (into [from-p to-p] + (->> (helpers/curve-extremities curve) + (map #(helpers/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 helpers/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 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)))) 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 16ab66529..860ac55a6 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,33 @@ ;; ;; 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.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 +66,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 +87,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 +110,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 +140,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 +151,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 +171,65 @@ (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))) + ;; 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))) - ;; For the rest return the plain shape - shape))) + 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 d5117f5f8..49a779105 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/command->point command)] (make-subpath p p [command]))) ([from to data] {:from from @@ -29,9 +29,9 @@ "Adds a command to the subpath" [subpath command] (let [command (if (= :close-path (:command command)) - (upc/make-line-to (:from subpath)) + (helpers/make-line-to (:from subpath)) command) - p (upc/command->point command)] + p (helpers/command->point command)] (-> subpath (assoc :to p) (update :data conj command)))) @@ -62,7 +62,7 @@ result)) new-data (->> subpath :data d/with-prev reverse - (reduce reverse-commands [(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/command->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/command->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 b7d50a1c1..09938b9ba 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/test/common_tests/geom_shapes_test.cljc b/common/test/common_tests/geom_shapes_test.cljc index 14ecc3fab..5656b42f4 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 c7e502bd5..09c25061e 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 000000000..386e4de9b --- /dev/null +++ b/common/test/common_tests/types/path_data_test.cljc @@ -0,0 +1,179 @@ +;; 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] + [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 :y 839}} + {:command :line-to :params {:x 439 :y 802}} + {:command :curve-to :params {:c1x 368 :c1y 737 :c2x 310 :c2y 681 :x 264 :y 634}} + {:command :curve-to :params {:c1x 218 :c1y 587 :c2x 181 :c2y 545 :x 154 :y 508}} + {:command :curve-to :params {:c1x 126 :c1y 471 :c2x 107 :c2y 438 :x 96 :y 408}} + {:command :curve-to :params {:c1x 85 :c1y 378 :c2x 80 :c2y 347 :x 80 :y 317}} + {:command :curve-to :params {:c1x 80 :c1y 256 :c2x 100 :c2y 206 :x 140 :y 166}} + {:command :curve-to :params {:c1x 180 :c1y 126 :c2x 230 :c2y 106 :x 290 :y 106}} + {:command :curve-to :params {:c1x 328 :c1y 106 :c2x 363 :c2y 115 :x 395 :y 133}} + {:command :curve-to :params {:c1x 427 :c1y 151 :c2x 456 :c2y 177 :x 480 :y 211}} + {:command :curve-to :params {:c1x 508 :c1y 175 :c2x 537 :c2y 148 :x 569 :y 131}} + {:command :curve-to :params {:c1x 600 :c1y 114 :c2x 634 :c2y 106 :x 670 :y 106}} + {:command :curve-to :params {:c1x 729 :c1y 106 :c2x 779 :c2y 126 :x 819 :y 166}} + {:command :curve-to :params {:c1x 859 :c1y 206 :c2x 880 :c2y 256 :x 880 :y 317}} + {:command :curve-to :params {:c1x 880 :c1y 347 :c2x 874 :c2y 378 :x 863 :y 408}} + {:command :curve-to :params {:c1x 852 :c1y 438 :c2x 833 :c2y 471 :x 806 :y 508}} + {:command :curve-to :params {:c1x 778 :c1y 545 :c2x 741 :c2y 587 :x 695 :y 634}} + {:command :curve-to :params {:c1x 649 :c1y 681 :c2x 591 :c2y 737 :x 521 :y 802}} + {:command :line-to :params {:x 480 :y 839}} + {:command :close-path :params {}} + {:command :move-to :params {:x 480.0 :y 760.0}} + {:command :curve-to :params {:c1x 547 :c1y 698 :c2x 603 :c2y 644 :x 646 :y 600}} + {:command :curve-to :params {:c1x 690 :c1y 556 :c2x 724 :c2y 517 :x 750 :y 484}} + {:command :curve-to :params {:c1x 776 :c1y 450 :c2x 794 :c2y 420 :x 804 :y 394}} + {:command :curve-to :params {:c1x 814 :c1y 368 :c2x 820 :c2y 342 :x 820 :y 317}} + {:command :curve-to :params {:c1x 820 :c1y 273 :c2x 806 :c2y 236 :x 778 :y 2085}} + {:command :curve-to :params {:c1x 750 :c1y 180 :c2x 714 :c2y 166 :x 670 :y 1660}} + {:command :curve-to :params {:c1x 635 :c1y 166 :c2x 604 :c2y 176 :x 574 :y 1975}} + {:command :curve-to :params {:c1x 545 :c1y 218 :c2x 522 :c2y 248 :x 504 :y 2860}} + {:command :line-to :params {:x 455 :y 286}} + {:command :curve-to :params {:c1x 437 :c1y 248 :c2x 414 :c2y 219 :x 385 :y 198}} + {:command :curve-to :params {:c1x 355 :c1y 176 :c2x 324 :c2y 166 :x 289 :y 166}} + {:command :curve-to :params {:c1x 245 :c1y 166 :c2x 210 :c2y 180 :x 182 :y 208}} + {:command :curve-to :params {:c1x 154 :c1y 236 :c2x 140 :c2y 273 :x 140 :y 317}} + {:command :curve-to :params {:c1x 140 :c1y 343 :c2x 145 :c2y 369 :x 155 :y 395}} + {:command :curve-to :params {:c1x 165 :c1y 421 :c2x 183 :c2y 451 :x 209 :y 485}} + {:command :curve-to :params {:c1x 235 :c1y 519 :c2x 270 :c2y 558 :x 314 :y 602}} + {:command :curve-to :params {:c1x 358 :c1y 646 :c2x 413 :c2y 698 :x 480 :y 760}} + {:command :close-path :params {}} + {:command :move-to :params {:x 480 :y 463}} + {: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/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\",\"~bAAEAAAAAAAAAAAAAAAAAAAAAAA" + "BD8AAARFHAAAACAAAAAAAAAAAAAAAAAAAAAAAAQ9uAAERIgAAAAwAA" + "Q7gAAEQ4QABDmwAARCpAAEOEAABEHoAAAAQAAAAAAAAAAAAAAAAAAA" + "AAAAAAAAAAAAAAAA==\"]") + 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)))) + + + 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 49ca27599..c14f03d05 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 9e87202ce..000000000 --- a/common/test/common_tests/types/shape_path_data_test.cljc +++ /dev/null @@ -1,77 +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 - #?(:clj [app.common.fressian :as fres]) - [app.common.data :as d] - [app.common.math :as mth] - [app.common.pprint :as pp] - [app.common.transit :as trans] - [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))))) - -(t/deftest path-data-transit-roundtrip - (let [pdata (path/path-data sample-content) - result1 (trans/encode-str pdata) - expected "[\"~#penpot/path-data\",\"~bAAEAAAAAAAAAAAAAAAAAAAAAAABD8AAARFHAAAACAAAAAAAAAAAAAAAAAAAAAAAAQ9uAAERIgAAAAwAAQ7gAAEQ4QABDmwAARCpAAEOEAABEHoAAAAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA==\"]" - result2 (trans/decode-str result1)] - - (t/is (= expected result1)) - (t/is (= pdata result2)))) - -#?(:clj - (t/deftest path-data-fresian - (let [pdata (path/path-data sample-content) - result1 (fres/encode pdata) - result2 (fres/decode result1)] - (t/is (= pdata result2))))) - 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 888362433..e16eba344 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","~bAAEAAAAAAAAAAAAAAAAAAAAAAABEjCAARAqAAAACAAAAAAAAAAAAAAAAAAAAAAAARJmgAEPlAAAAAwAARJmgAEPlAABEpQAAQ/YAAESi4ABEAYAAAAMAAESgwABECAAARJ1AAEQPAABEmGAARBIAAAADAABEk4AARBUAAESMIABECoAARIwgAEQKgAA="], "~: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 279e3e0b2..1fd4c1bd9 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/bool.cljs b/frontend/src/app/main/data/workspace/bool.cljs index 7e6b8eec9..f5b9c5330 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] @@ -30,7 +31,7 @@ (or id (uuid/next)) shapes - (mapv #(stp/convert-to-path % objects) shapes) + (mapv #(path/convert-to-path % objects) shapes) head (if (= type :difference) (first shapes) (last shapes)) @@ -38,7 +39,7 @@ head (cond-> head (and (contains? head :svg-attrs) (empty? (:fills head))) - (assoc :fills stp/default-bool-fills)) + (assoc :fills bool/default-fills)) shape {:id shape-id @@ -51,7 +52,7 @@ shape (-> shape - (merge (select-keys head stp/style-properties)) + (merge (select-keys head bool/style-properties)) (cts/setup-shape) (gsh/update-bool-selrect shapes objects))] @@ -108,12 +109,12 @@ [type group objects] (let [shapes (->> (:shapes group) (map #(get objects %)) - (mapv #(stp/convert-to-path % objects))) + (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) @@ -136,7 +137,7 @@ (-> shape (assoc :type :group) (dissoc :bool-type) - (d/without-keys stp/style-group-properties) + (d/without-keys bool/style-group-properties) (gsh/update-group-selrect (mapv (d/getf objects) (:shapes shape))))) diff --git a/frontend/src/app/main/data/workspace/drawing/common.cljs b/frontend/src/app/main/data/workspace/drawing/common.cljs index dc565bfdf..4bf6bb83e 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 7a4225096..198fba454 100644 --- a/frontend/src/app/main/data/workspace/drawing/curve.cljs +++ b/frontend/src/app/main/data/workspace/drawing/curve.cljs @@ -9,11 +9,10 @@ [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.segm] [app.common.types.shape :as cts] [app.common.types.shape-tree :as ctst] [app.common.types.shape.layout :as ctl] @@ -37,8 +36,8 @@ (fn [object] (let [segments (-> (:segments object) (conj point)) - content (gsp/segments->content segments) - selrect (gsh/content->selrect content) + content (path.segm/segments->content segments) + selrect (path.segm/content->selrect content) points (grc/rect->points selrect)] (-> object (assoc :segments segments) @@ -81,8 +80,8 @@ (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) + content (path.segm/segments->content segments) + selrect (path.segm/content->selrect content) points (grc/rect->points selrect)] (-> shape (dissoc :segments) diff --git a/frontend/src/app/main/data/workspace/modifiers.cljs b/frontend/src/app/main/data/workspace/modifiers.cljs index d8cc7cf22..3a6043888 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 547500698..44c38d99d 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 483302177..3bb60ed72 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 be1bbfd2f..a2f328403 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.segment/get-point (nth content (dec index)))) - old-handler (upc/handler->point content index prefix) + old-handler (path.segment/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/content->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 a4cdf6f6d..5b8f3f3bc 100644 --- a/frontend/src/app/main/data/workspace/path/edition.cljs +++ b/frontend/src/app/main/data/workspace/path/edition.cljs @@ -10,10 +10,9 @@ [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] @@ -27,7 +26,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])) @@ -58,10 +56,10 @@ 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) + new-content (path/apply-content-modifiers content content-modifiers) - old-points (->> content upg/content->points) - new-points (->> new-content upg/content->points) + old-points (->> content path.segment/content->points) + new-points (->> new-content path.segment/content->points) point-change (->> (map hash-map old-points new-points) (reduce merge))] (when (and (some? new-content) (some? shape)) @@ -75,8 +73,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 +114,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 +142,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 +161,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/content->points content)] (rx/concat ;; This stream checks the consecutive mouse positions to do the dragging @@ -228,7 +226,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 +254,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/content->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.segment/get-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/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,19 +292,22 @@ (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 @@ -343,7 +344,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 +358,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 b52ab6e72..a9b3d933c 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/handler->point content index prefix) + opposite (path.segment/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 e26930528..9068ad43d 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 0a6deb186..efe34a004 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 f860ca586..3c0f1d33f 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,7 @@ ranges-stream (->> content-stream - (rx/map upg/content->points) + (rx/map path.segm/content->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 df495c1b2..7b1977ff8 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 d9862564b..d70a0b30b 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 23deb766f..030e29312 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 87b5b6afb..7f831a1dd 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 7168975b8..1a7ad91d7 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 f44d43042..e1a21eac8 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 8844d18bc..cbcde63b5 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) + p2 (path.helpers/command->point cmd) hp (case (:command cmd) - :line-to (-> (gsp/command->line cmd) - (gsp/line-values 0.5)) + :line-to (-> (path.helpers/command->line cmd) + (path.helpers/line-values 0.5)) - :curve-to (-> (gsp/command->bezier cmd) - (gsp/curve-values 0.5)) + :curve-to (-> (path.helpers/command->bezier cmd) + (path.helpers/curve-values 0.5)) nil)] [:* (when p1 @@ -155,14 +156,14 @@ (for [[i cmd] (d/enumerate content-b-split)] (let [p1 (:prev cmd) - p2 (gsp/command->point cmd) + p2 (path.helpers/command->point cmd) hp (case (:command cmd) - :line-to (-> (gsp/command->line cmd) - (gsp/line-values 0.5)) + :line-to (-> (path.helpers/command->line cmd) + (path.helpers/line-values 0.5)) - :curve-to (-> (gsp/command->bezier cmd) - (gsp/curve-values 0.5)) + :curve-to (-> (path.helpers/command->bezier cmd) + (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 110238be4..caa5a2e2f 100644 --- a/frontend/src/app/main/ui/workspace/shapes/path.cljs +++ b/frontend/src/app/main/ui/workspace/shapes/path.cljs @@ -6,8 +6,8 @@ (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]] @@ -15,25 +15,31 @@ [app.main.ui.workspace.shapes.path.common :as pc] [rumext.v2 :as mf])) -(defn apply-content-modifiers +(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 + (pc/make-content-modifiers-ref shape-id) + + content-modifiers + (mf/deref content-modifiers-ref) + + 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/editor.cljs b/frontend/src/app/main/ui/workspace/shapes/path/editor.cljs index b6d844db6..3814c7f44 100644 --- a/frontend/src/app/main/ui/workspace/shapes/path/editor.cljs +++ b/frontend/src/app/main/ui/workspace/shapes/path/editor.cljs @@ -9,9 +9,8 @@ [app.common.data :as d] [app.common.data.macros :as dm] [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.segment :as path.segment] [app.main.data.workspace.path :as drp] [app.main.snap :as snap] [app.main.store :as st] @@ -196,8 +195,8 @@ (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/handler->point content i1 p1) + p2 (path.segment/handler->point content i2 p2) v1 (gpt/to-vec node p1) v2 (gpt/to-vec node p2) @@ -227,34 +226,36 @@ :as edit-path} (mf/deref edit-path-ref) selected-points (or selected-points #{}) + shape (hooks/use-equal-memo shape) - shape (cond-> shape - (not= :path (:type shape)) - (ups/convert-to-path {}) + base-content + (get shape :content) - :always - hooks/use-equal-memo) + base-points + (mf/with-memo [base-content] + (path.segment/content->points base-content)) - base-content (:content shape) - base-points (mf/use-memo (mf/deps base-content) #(->> base-content gsp/content->points)) + content + (path/apply-content-modifiers base-content content-modifiers) - content (upc/apply-content-modifiers base-content content-modifiers) - content-points (mf/use-memo (mf/deps content) #(->> content gsp/content->points)) + content-points + (mf/with-memo [content] + (path.segment/content->points content)) point->base (->> (map hash-map content-points base-points) (reduce merge)) base->point (map-invert point->base) points (into #{} content-points) - last-p (->> content last upc/command->point) - handlers (upc/content->handlers content) + last-p (->> content last path.segment/get-point) + handlers (path.segment/content->handlers content) start-p? (not (some? last-point)) [snap-selected snap-points] (cond (some? drag-handler) [#{drag-handler} points] - (some? preview) [#{(upc/command->point preview)} points] + (some? preview) [#{(path.segment/get-point preview)} points] (some? moving-handler) [#{moving-handler} points] :else [(->> selected-points (map base->point) (into #{})) @@ -282,7 +283,7 @@ ms/mouse-position (mf/deps shape zoom) (fn [position] - (when-let [point (gsp/path-closest-point shape position)] + (when-let [point (path.segment/path-closest-point shape position)] (reset! hover-point (when (< (gpt/distance position point) (/ 10 zoom)) point))))) [:g.path-editor {:ref editor-ref} @@ -313,7 +314,7 @@ (for [[index position] (d/enumerate points)] (let [show-handler? (fn [[index prefix]] - (let [handler-position (upc/handler->point content index prefix)] + (let [handler-position (path.segment/handler->point content index prefix)] (not= position handler-position))) pos-handlers (get handlers position) @@ -327,7 +328,7 @@ [:g.path-node {:key (dm/str index "-" (:x position) "-" (:y position))} [:g.point-handlers {:pointer-events (when (= edit-mode :draw) "none")} (for [[hindex prefix] pos-handlers] - (let [handler-position (upc/handler->point content hindex prefix) + (let [handler-position (path.segment/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)] 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 52ec89526..11558a667 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/path_actions.cljs b/frontend/src/app/main/ui/workspace/viewport/path_actions.cljs index f866a364e..5e18c9a83 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,15 @@ (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))) @@ -49,7 +48,7 @@ (defn check-enabled [content selected-points] - (let [segments (upt/get-segments content selected-points) + (let [segments (path.segm/get-segments content selected-points) num-segments (count segments) num-points (count selected-points) points-selected? (seq selected-points) @@ -58,7 +57,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?)) diff --git a/frontend/src/app/plugins/shape.cljs b/frontend/src/app/plugins/shape.cljs index f05981d1d..23808214d 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] @@ -1312,18 +1313,19 @@ :get #(-> % u/proxy->shape :content upf/format-path) :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 caff9874e..7ea9c85b9 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 index 5ec19173a..958ac1837 100644 --- a/frontend/src/app/util/path/format.cljs +++ b/frontend/src/app/util/path/format.cljs @@ -5,12 +5,19 @@ ;; Copyright (c) KALEIDOS INC (ns app.util.path.format + "Legacy path data formater, replaced by + app.common.types.path.PathData type. + + WARNING: Pending to be removed from codebase once completly unused" (:require - [app.common.svg.path.command :as upc] - [app.common.svg.path.subpath :refer [pt=]] + [app.common.geom.point :as gpt] + [app.common.types.path.segment :as path.segm] [app.util.array :as arr])) -;; TODO: move to common +(defn pt= + "Check if two points are close" + [p1 p2] + (< (gpt/distance p1 p2) 0.1)) (def path-precision 3) @@ -115,7 +122,7 @@ (try (let [result (make-array (count content))] (reduce (fn [last-move current] - (let [point (upc/command->point current) + (let [point (path.segm/get-point current) current-move? (= :move-to (:command current)) last-move (if current-move? point last-move)] diff --git a/frontend/src/app/util/path/tools.cljs b/frontend/src/app/util/path/tools.cljs deleted file mode 100644 index 11975774a..000000000 --- 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 f2ea47fab..f658d97ea 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)))