3pp-mirror/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-06-01 06:31:39 +02:00
Code Issues Projects Releases Packages Wiki Activity

🎉 Add full integration with path data type feature

Browse source
This commit is contained in:
Andrey Antukh 2025-03-28 00:07:45 +01:00
parent f545d7b3ea
commit 1fc0203c38
64 changed files with 2622 additions and 2237 deletions
Download patch file Download diff file Expand all files Collapse all files

6
backend/src/app/binfile/common.clj
View file

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

11
backend/src/app/features/components_v2.clj
View file

@ -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)))))
(path/update-geometry))))
;; When we fount a bool shape with no content,
;; we convert it to a simple rect

35
backend/src/app/features/fdata.clj
View file

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

7
backend/src/app/srepl/main.clj
View file

@ -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}]
(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)))))
(h/process-file! system file-id update-fn opts))))))
(defn process-team-files!
"Apply a function to each file of the specified team."

4
common/src/app/common/features.cljc
View file

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

4
common/src/app/common/files/builder.cljc
View file

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

1
common/src/app/common/files/changes_builder.cljc
View file

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

31
common/src/app/common/files/migrations.cljc
View file

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

4
common/src/app/common/files/shapes_helpers.cljc
View file

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

7
common/src/app/common/geom/point.cljc
View file

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

11
common/src/app/common/geom/shapes.cljc
View file

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

29
common/src/app/common/geom/shapes/bool.cljc
View file

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

6
common/src/app/common/geom/shapes/bounds.cljc
View file

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

6
common/src/app/common/geom/shapes/intersect.cljc
View file

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

36
common/src/app/common/geom/shapes/transforms.cljc
View file

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

4
common/src/app/common/schema.cljc
View file

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

6
common/src/app/common/schema/generators.cljc
View file

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

204
common/src/app/common/svg/path/command.cljc
View file

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

11
common/src/app/common/svg/path/legacy_parser1.cljs
View file

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

11
common/src/app/common/svg/path/legacy_parser2.cljc
View file

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

5
common/src/app/common/svg/shapes_builder.cljc
View file

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

209
common/src/app/common/types/path.cljc Normal file
View file

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

247
common/src/app/common/svg/path/bool.cljc → common/src/app/common/types/path/bool.cljc
View file

@ -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)
(loop [segments (seq content)
result []
last-move nil
last-p 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)))
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)]
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]
(defn- split-ts
[seg-1 seg-2]
(let [cmd-1 (get seg-1 :command)
cmd-2 (get seg-2 :command)]
(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))
(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)))
(and (= :curve-to cmd-1)
(= :line-to cmd-2))
(let [[seg-2' seg-1']
(gsp/line-curve-intersect (gsp/command->line seg-2) (gsp/command->bezier 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
[[] []]))
[[] []])))
(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
content-a
(-> content-a
(close-paths)
(add-previous))
content-b (-> content-b
content-b
(-> content-b
(close-paths)
(cond-> should-reverse? (ups/reverse-content))
(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))
[]))

926
common/src/app/common/geom/shapes/path.cljc → common/src/app/common/types/path/helpers.cljc
View file

File diff suppressed because it is too large Load diff

410
common/src/app/common/types/shape/path.cljc → common/src/app/common/types/path/impl.cljc
View file

@ -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
(deftype PathData [size buffer]
(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 ^: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))))}))

856
common/src/app/common/types/path/segment.cljc Normal file
View file

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

145
common/src/app/common/svg/path/shapes_to_path.cljc → common/src/app/common/types/path/shape_to_path.cljc
View file

@ -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,25 +171,35 @@
(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 %))
(let [children
(->> (:shapes shape)
(map (d/getf objects))
(map #(convert-to-path % objects)))
bool-type (:bool-type shape)
content (pb/content-bool bool-type (mapv :content children))]
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]
"Transforms the given shape to a path shape"
[shape objects]
(assert (map? objects))
;; FIXME: add check-objects-like
;; FIXME: add check-shape ?
(let [type (dm/get-prop shape :type)]
(case type
(:group :frame)
(group-to-path shape objects)
@ -218,10 +208,10 @@
(bool-to-path shape objects)
(:rect :circle :image :text)
(let [new-content
(case type
:circle (circle->path shape)
#_:else (rect->path shape))
(let [content
(if (= type :circle)
(circle->path shape)
(rect->path shape))
;; Apply the transforms that had the shape
transform
@ -229,15 +219,16 @@
(:flip-x shape) (gmt/scale (gpt/point -1 1))
(:flip-y shape) (gmt/scale (gpt/point 1 -1)))
new-content (cond-> new-content
content
(cond-> content
(some? transform)
(gsp/transform-content (gmt/transform-in (gco/shape->center shape) transform)))]
(segm/transform-content (gmt/transform-in (gco/shape->center shape) transform)))]
(-> shape
(assoc :type :path)
(assoc :content new-content)
(assoc :content content)
(cond-> (= :image type)
(assoc :fill-image metadata))
(assoc :fill-image (get shape :metadata)))
(d/without-keys dissoc-attrs)))
;; For the rest return the plain shape

32
common/src/app/common/svg/path/subpath.cljc → common/src/app/common/types/path/subpath.cljc
View file

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

9
common/src/app/common/types/shape.cljc
View file

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

3
common/test/common_tests/geom_shapes_test.cljc
View file

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

4
common/test/common_tests/runner.cljc
View file

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

179
common/test/common_tests/types/path_data_test.cljc Normal file
View file

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

11
common/test/common_tests/types/shape_decode_encode_test.cljc
View file

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

77
common/test/common_tests/types/shape_path_data_test.cljc
View file

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

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

@ -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",

4
frontend/src/app/main/data/helpers.cljs
View file

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

17
frontend/src/app/main/data/workspace/bool.cljs
View file

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

5
frontend/src/app/main/data/workspace/drawing/common.cljs
View file

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

11
frontend/src/app/main/data/workspace/drawing/curve.cljs
View file

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

4
frontend/src/app/main/data/workspace/modifiers.cljs
View file

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

44
frontend/src/app/main/data/workspace/path/changes.cljs
View file

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

38
frontend/src/app/main/data/workspace/path/common.cljs
View file

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

52
frontend/src/app/main/data/workspace/path/drawing.cljs
View file

@ -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 []

55
frontend/src/app/main/data/workspace/path/edition.cljs
View file

@ -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
@ -299,14 +297,17 @@
content (st/get-path state :content)
state (cond-> state
(cfh/path-shape? objects id)
(st/set-content (ups/close-subpaths content)))]
(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))))))

110
frontend/src/app/main/data/workspace/path/helpers.cljs
View file

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

5
frontend/src/app/main/data/workspace/path/shapes_to_path.cljs
View file

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

5
frontend/src/app/main/data/workspace/path/state.cljs
View file

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

4
frontend/src/app/main/data/workspace/path/streams.cljs
View file

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

50
frontend/src/app/main/data/workspace/path/tools.cljs
View file

@ -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)
(let [page-id (get state :current-page-id)
objects (dsh/lookup-page-objects state page-id)
shape (st/get-path state)
selected-points (get-in state [:workspace-local :edit-path id :selected-points] #{})
points (or points selected-points)]
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

39
frontend/src/app/main/data/workspace/shapes.cljs
View file

@ -47,26 +47,37 @@
(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)
update-layout-ids
(->> 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))
changes (-> (pcb/empty-changes it page-id)
update-layout-ids
(->> (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
@ -80,7 +91,9 @@
(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
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)

1
frontend/src/app/main/features.cljs
View file

@ -110,4 +110,3 @@
(log/inf :hint "initialized"
:enabled (str/join "," features)
:runtime (str/join "," (:features-runtime state)))))))

5
frontend/src/app/main/ui/shapes/bool.cljs
View file

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

7
frontend/src/app/main/ui/shapes/custom_stroke.cljs
View file

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

37
frontend/src/app/main/ui/shapes/path.cljs
View file

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

61
frontend/src/app/main/ui/workspace/shapes/debug.cljs
View file

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

36
frontend/src/app/main/ui/workspace/shapes/path.cljs
View file

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

41
frontend/src/app/main/ui/workspace/shapes/path/editor.cljs
View file

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

3
frontend/src/app/main/ui/workspace/sidebar/options/shapes/multiple.cljs
View file

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

7
frontend/src/app/main/ui/workspace/viewport/path_actions.cljs
View file

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

12
frontend/src/app/plugins/shape.cljs
View file

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

9
frontend/src/app/render_wasm/api.cljs
View file

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

15
frontend/src/app/util/path/format.cljs
View file

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

461
frontend/src/app/util/path/tools.cljs
View file

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

4
frontend/src/app/worker/import.cljs
View file

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