github/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2026-04-25 19:28:12 +00:00
Code Issues Packages Projects Releases Wiki Activity

Merge pull request #6263 from penpot/niwinz-develop-path-data-optimizations-1

Browse Source 
⚡ Performance optimizations to path related functions
This commit is contained in:
Andrey Antukh 2025-05-06 13:53:56 +02:00 committed by GitHub
commit 6ccb6cafaa
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
86 changed files with 4234 additions and 3673 deletions
Show Stats 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)

2
backend/src/app/db.clj
View File

@ -42,6 +42,8 @@
org.postgresql.util.PGInterval
org.postgresql.util.PGobject))
(def ^:dynamic *conn* nil)
(declare open)
(declare create-pool)

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

53
backend/src/app/features/fdata.clj
View File

@ -9,7 +9,10 @@
(:require
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.files.helpers :as cfh]
[app.common.files.migrations :as fmg]
[app.common.logging :as l]
[app.common.types.path :as path]
[app.db :as db]
[app.db.sql :as-alias sql]
[app.storage :as sto]
@ -30,7 +33,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn enable-objects-map
[file]
[file & _opts]
(let [update-page
(fn [page]
(if (and (pmap/pointer-map? page)
@ -136,10 +139,56 @@
(defn enable-pointer-map
"Enable the fdata/pointer-map feature on the file."
[file]
[file & _opts]
(-> file
(update :data (fn [fdata]
(-> fdata
(update :pages-index d/update-vals pmap/wrap)
(d/update-when :components pmap/wrap))))
(update :features conj "fdata/pointer-map")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; PATH-DATA
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn enable-path-data
"Enable the fdata/path-data feature on the file."
[file & _opts]
(letfn [(update-object [object]
(if (or (cfh/path-shape? object)
(cfh/bool-shape? object))
(update object :content path/content)
object))
(update-container [container]
(d/update-when container :objects d/update-vals update-object))]
(-> file
(update :data (fn [data]
(-> data
(update :pages-index d/update-vals update-container)
(d/update-when :components d/update-vals update-container))))
(update :features conj "fdata/path-data"))))
(defn disable-path-data
[file & _opts]
(letfn [(update-object [object]
(if (or (cfh/path-shape? object)
(cfh/bool-shape? object))
(update object :content vec)
object))
(update-container [container]
(d/update-when container :objects d/update-vals update-object))]
(when-let [conn db/*conn*]
(db/delete! conn :file-migration {:file-id (:id file)
:name "0003-convert-path-content"}))
(-> file
(update :data (fn [data]
(-> data
(update :pages-index d/update-vals update-container)
(d/update-when :components d/update-vals update-container))))
(update :features disj "fdata/path-data")
(update :migrations disj "0003-convert-path-content")
(vary-meta update ::fmg/migrated disj "0003-convert-path-content"))))

21
backend/src/app/rpc/commands/files_create.clj
View File

@ -111,18 +111,21 @@
::quotes/profile-id profile-id
::quotes/project-id project-id})
;; FIXME: IMPORTANT: this code can have race
;; conditions, because we have no locks for updating
;; team so, creating two files concurrently can lead
;; to lost team features updating
;; FIXME: IMPORTANT: this code can have race conditions, because
;; we have no locks for updating team so, creating two files
;; concurrently can lead to lost team features updating
;; When newly computed features does not match exactly with
;; the features defined on team row, we update it
(when (not= features (:features team))
(let [features (db/create-array conn "text" features)]
(when-let [features (-> features
(set/difference (:features team))
(set/difference cfeat/no-team-inheritable-features)
(not-empty))]
(let [features (->> features
(set/union (:features team))
(db/create-array conn "text"))]
(db/update! conn :team
{:features features}
{:id team-id})))
{:id (:id team)}
{::db/return-keys false})))
(-> (create-file cfg params)
(vary-meta assoc ::audit/props {:team-id team-id}))))

15
backend/src/app/rpc/commands/files_update.clj
View File

@ -177,12 +177,19 @@
:stored-revn (:revn file)}))
;; When newly computed features does not match exactly with
;; the features defined on team row, we update it.
(when (not= features (:features team))
(let [features (db/create-array conn "text" features)]
;; the features defined on team row, we update it
(when-let [features (-> features
(set/difference (:features team))
(set/difference cfeat/no-team-inheritable-features)
(not-empty))]
(let [features (->> features
(set/union (:features team))
(db/create-array conn "text"))]
(db/update! conn :team
{:features features}
{:id (:id team)})))
{:id (:id team)}
{::db/return-keys false})))
(mtx/run! metrics {:id :update-file-changes :inc (count changes)})

17
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,12 @@
"Apply a function to the file. Optionally save the changes or not.
The function receives the decoded and migrated file data."
[file-id update-fn & {:keys [rollback?] :or {rollback? true} :as opts}]
(db/tx-run! (assoc main/system ::db/rollback rollback?)
(fn [system]
(binding [h/*system* system]
(h/process-file! system file-id update-fn opts)))))
(let [file-id (h/parse-uuid file-id)]
(db/tx-run! (assoc main/system ::db/rollback rollback?)
(fn [system]
(binding [h/*system* system
db/*conn* (db/get-connection system)]
(h/process-file! system file-id update-fn opts))))))
(defn process-team-files!
"Apply a function to each file of the specified team."
@ -431,7 +437,8 @@
(when (string? label)
(h/take-team-snapshot! system team-id label))
(binding [h/*system* system]
(binding [h/*system* system
db/*conn* (db/get-connection system)]
(->> (feat.comp-v2/get-and-lock-team-files conn team-id)
(reduce (fn [result file-id]
(if (h/process-file! system file-id update-fn opts)

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

5
common/src/app/common/files/builder.cljc
View File

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

2
common/src/app/common/files/changes.cljc
View File

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

15
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]
@ -84,8 +83,7 @@
(defn with-objects
[changes objects]
(let [fdata (binding [cfeat/*current* #{"components/v2"}]
(ctf/make-file-data (uuid/next) uuid/zero))
(let [fdata (ctf/make-file-data (uuid/next) uuid/zero)
fdata (assoc-in fdata [:pages-index uuid/zero :objects] objects)]
(vary-meta changes assoc
::file-data fdata
@ -480,9 +478,12 @@
(let [old-val (get old attr)
new-val (get new attr)]
(not= old-val new-val)))
new-obj (if with-objects?
(update-fn object objects)
(update-fn object))]
new-obj
(if with-objects?
(update-fn object objects)
(update-fn object))]
(when-not (= object new-obj)
(let [attrs (or attrs (d/concat-set (keys object) (keys new-obj)))]
(filter (partial changed? object new-obj) attrs)))))
@ -659,7 +660,7 @@
nil ;; so it does not need resize
(= (:type parent) :bool)
(gsh/update-bool-selrect parent children objects)
(gsh/update-bool parent children objects)
(= (:type parent) :group)
(if (:masked-group parent)

33
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/points->content (:segments shape) :close (:close? shape))
selrect (path.segment/content->selrect content)
points (grc/rect->points selrect)]
(-> shape
(dissoc :segments)
@ -201,7 +202,7 @@
(if (= (:type shape) :path)
(let [{:keys [width height]} (grc/points->rect (:points shape))]
(if (or (mth/almost-zero? width) (mth/almost-zero? height))
(let [selrect (gsh/content->selrect (:content shape))
(let [selrect (path.segment/content->selrect (:content shape))
points (grc/rect->points selrect)
transform (gmt/matrix)
transform-inv (gmt/matrix)]
@ -1281,8 +1282,8 @@
(d/update-when container :objects update-vals update-object))]
(-> data
(update :pages-index update-vals update-container)
(update :components update-vals update-container))))
(update :pages-index d/update-vals update-container)
(d/update-when :components d/update-vals update-container))))
(defmethod migrate-data "0003-fix-root-shape"
[data _]
@ -1306,6 +1307,23 @@
(d/update-when :components d/update-vals update-container)
(d/without-nils))))
(defmethod migrate-data "0003-convert-path-content"
[data _]
(some-> cfeat/*new* (swap! conj "fdata/path-data"))
(letfn [(update-object [object]
(if (or (cfh/bool-shape? object)
(cfh/path-shape? object))
(update object :content path/content)
object))
(update-container [container]
(d/update-when container :objects update-vals update-object))]
(-> data
(update :pages-index d/update-vals update-container)
(d/update-when :components d/update-vals update-container))))
(def available-migrations
(into (d/ordered-set)
["legacy-2"
@ -1363,4 +1381,5 @@
"0001-remove-tokens-from-groups"
"0002-normalize-bool-content"
"0002-clean-shape-interactions"
"0003-fix-root-shape"]))
"0003-fix-root-shape"
"0003-convert-path-content"]))

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?

9
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,13 @@
(and ^boolean (mth/almost-zero? (dm/get-prop p :x))
^boolean (mth/almost-zero? (dm/get-prop p :y))))
(defn zero?
[p]
(let [x (dm/get-prop p :x)
y (dm/get-prop p :y)]
(and ^boolean (== 0 x)
^boolean (== 0 y))))
(defn lerp
"Calculates a linear interpolation between two points given a tvalue"
[p1 p2 t]

13
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]))
@ -166,7 +164,7 @@
(dm/export gtr/calculate-geometry)
(dm/export gtr/update-group-selrect)
(dm/export gtr/update-mask-selrect)
(dm/export gtr/update-bool-selrect)
(dm/export gtr/update-bool)
(dm/export gtr/apply-transform)
(dm/export gtr/transform-shape)
(dm/export gtr/transform-selrect)
@ -180,12 +178,6 @@
;; Constratins
(dm/export gct/calc-child-modifiers)
;; PATHS
;; FIXME: rename
(dm/export gsp/content->selrect)
(dm/export gsp/transform-content)
(dm/export gsp/open-path?)
;; Intersection
(dm/export gsi/overlaps?)
(dm/export gsi/overlaps-path?)
@ -193,9 +185,6 @@
(dm/export gsi/has-point-rect?)
(dm/export gsi/rect-contains-shape?)
;; Bool
(dm/export gsb/calc-bool-content)
;; Constraints
(dm/export gct/default-constraints-h)
(dm/export gct/default-constraints-v)

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)

40
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)
@ -444,24 +447,13 @@
(assoc :flip-x (-> mask :flip-x))
(assoc :flip-y (-> mask :flip-y)))))
(defn update-bool-selrect
(defn update-bool
"Calculates the selrect+points for the boolean shape"
[shape children objects]
[shape _children objects]
(let [content
(gshb/calc-bool-content shape objects)
shape
(assoc shape :content content)
[points selrect]
(gpa/content->points+selrect shape content)]
(if (and (some? selrect) (d/not-empty? points))
(-> shape
(assoc :selrect selrect)
(assoc :points points))
(update-group-selrect shape children))))
(let [content (path/calc-bool-content shape objects)
shape (assoc shape :content content)]
(path/update-geometry shape)))
(defn update-shapes-geometry
[objects ids]
@ -476,7 +468,7 @@
(update-mask-selrect shape children)
(cfh/bool-shape? shape)
(update-bool-selrect shape children objects)
(update-bool shape children objects)
(cfh/group-shape? shape)
(update-group-selrect shape children)

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

14
common/src/app/common/schema/test.cljc
View File

@ -56,13 +56,8 @@
(str "(pass=TRUE, tests=" (:num-tests params) ", seed=" (:seed params) ", elapsed=" time "ms)"))))
(defmethod ct/report #?(:clj ::thrunk :cljs [:cljs.test/default ::thrunk])
[{:keys [::params] :as m}]
(let [smallest (-> params :shrunk :smallest vec)]
(println)
(println "Condition failed with the following params:")
(println "Seed:" (:seed params))
(println)
(pp/pprint smallest)))
[_]
nil)
(defmethod ct/report #?(:clj ::trial :cljs [:cljs.test/default ::trial])
[_]
@ -76,9 +71,12 @@
(let [tvar (get-testing-var)
tsym (get-testing-sym tvar)
res (:result params)]
(println)
(println "---------------------------------------------------------")
(println "Generative test:" (str "'" tsym "'")
(str "(pass=FALSE, tests=" (:num-tests params) ", seed=" (:seed params) ")"))
(pp/pprint (:fail params))
(println "---------------------------------------------------------")
(when (ex/exception? res)
#?(:clj (ex/print-throwable res)

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

324
common/src/app/common/svg/path/legacy_parser1.cljs
View File

@ -1,324 +0,0 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS INC
(ns app.common.svg.path.legacy-parser1
"The first SVG Path parser implementation.
Written in a mix of CLJS and JS code and used in production until
1.19, used mainly for tests."
(:require
[app.common.data :as d]
[app.common.geom.point :as gpt]
[app.common.geom.shapes.path :as upg]
[app.common.svg :as csvg]
[app.common.svg.path.arc-to-bezier :as a2b]
[app.common.svg.path.command :as upc]
[cuerdas.core :as str]))
(def commands-regex #"(?i)[mzlhvcsqta][^mzlhvcsqta]*")
;; Matches numbers for path values allows values like... -.01, 10, +12.22
;; 0 and 1 are special because can refer to flags
(def num-regex #"[+-]?(\d+(\.\d+)?|\.\d+)(e[+-]?\d+)?")
(def flag-regex #"[01]")
(defn extract-params [cmd-str extract-commands]
(loop [result []
extract-idx 0
current {}
remain (-> cmd-str (subs 1) (str/trim))]
(let [[param type] (nth extract-commands extract-idx)
regex (case type
:flag flag-regex
#_:number num-regex)
match (re-find regex remain)]
(if match
(let [value (-> match first csvg/fix-dot-number d/read-string)
remain (str/replace-first remain regex "")
current (assoc current param value)
extract-idx (inc extract-idx)
[result current extract-idx]
(if (>= extract-idx (count extract-commands))
[(conj result current) {} 0]
[result current extract-idx])]
(recur result
extract-idx
current
remain))
(cond-> result
(seq current) (conj current))))))
;; Path specification
;; https://www.w3.org/TR/SVG11/paths.html
(defmulti parse-command (comp str/upper first))
(defmethod parse-command "M" [cmd]
(let [relative (str/starts-with? cmd "m")
param-list (extract-params cmd [[:x :number]
[:y :number]])]
(into [{:command :move-to
:relative relative
:params (first param-list)}]
(for [params (rest param-list)]
{:command :line-to
:relative relative
:params params}))))
(defmethod parse-command "Z" [_]
[{:command :close-path}])
(defmethod parse-command "L" [cmd]
(let [relative (str/starts-with? cmd "l")
param-list (extract-params cmd [[:x :number]
[:y :number]])]
(for [params param-list]
{:command :line-to
:relative relative
:params params})))
(defmethod parse-command "H" [cmd]
(let [relative (str/starts-with? cmd "h")
param-list (extract-params cmd [[:value :number]])]
(for [params param-list]
{:command :line-to-horizontal
:relative relative
:params params})))
(defmethod parse-command "V" [cmd]
(let [relative (str/starts-with? cmd "v")
param-list (extract-params cmd [[:value :number]])]
(for [params param-list]
{:command :line-to-vertical
:relative relative
:params params})))
(defmethod parse-command "C" [cmd]
(let [relative (str/starts-with? cmd "c")
param-list (extract-params cmd [[:c1x :number]
[:c1y :number]
[:c2x :number]
[:c2y :number]
[:x :number]
[:y :number]])]
(for [params param-list]
{:command :curve-to
:relative relative
:params params})))
(defmethod parse-command "S" [cmd]
(let [relative (str/starts-with? cmd "s")
param-list (extract-params cmd [[:cx :number]
[:cy :number]
[:x :number]
[:y :number]])]
(for [params param-list]
{:command :smooth-curve-to
:relative relative
:params params})))
(defmethod parse-command "Q" [cmd]
(let [relative (str/starts-with? cmd "q")
param-list (extract-params cmd [[:cx :number]
[:cy :number]
[:x :number]
[:y :number]])]
(for [params param-list]
{:command :quadratic-bezier-curve-to
:relative relative
:params params})))
(defmethod parse-command "T" [cmd]
(let [relative (str/starts-with? cmd "t")
param-list (extract-params cmd [[:x :number]
[:y :number]])]
(for [params param-list]
{:command :smooth-quadratic-bezier-curve-to
:relative relative
:params params})))
(defmethod parse-command "A" [cmd]
(let [relative (str/starts-with? cmd "a")
param-list (extract-params cmd [[:rx :number]
[:ry :number]
[:x-axis-rotation :number]
[:large-arc-flag :flag]
[:sweep-flag :flag]
[:x :number]
[:y :number]])]
(for [params param-list]
{:command :elliptical-arc
:relative relative
:params params})))
(defn smooth->curve
[{:keys [params]} pos handler]
(let [{c1x :x c1y :y} (upg/calculate-opposite-handler pos handler)]
{:c1x c1x
:c1y c1y
:c2x (:cx params)
:c2y (:cy params)}))
(defn quadratic->curve
[sp ep cp]
(let [cp1 (-> (gpt/to-vec sp cp)
(gpt/scale (/ 2 3))
(gpt/add sp))
cp2 (-> (gpt/to-vec ep cp)
(gpt/scale (/ 2 3))
(gpt/add ep))]
{:c1x (:x cp1)
:c1y (:y cp1)
:c2x (:x cp2)
:c2y (:y cp2)}))
(defn arc->beziers*
[from-x from-y x y large-arc-flag sweep-flag rx ry x-axis-rotation]
(a2b/calculateBeziers from-x from-y x y large-arc-flag sweep-flag rx ry x-axis-rotation))
(defn arc->beziers [from-p command]
(let [to-command
(fn [[_ _ c1x c1y c2x c2y x y]]
{:command :curve-to
:relative (:relative command)
:params {:c1x c1x :c1y c1y
:c2x c2x :c2y c2y
:x x :y y}})
{from-x :x from-y :y} from-p
{:keys [rx ry x-axis-rotation large-arc-flag sweep-flag x y]} (:params command)
result (arc->beziers* from-x from-y x y large-arc-flag sweep-flag rx ry x-axis-rotation)]
(mapv to-command result)))
(defn simplify-commands
"Removes some commands and convert relative to absolute coordinates"
[commands]
(let [simplify-command
;; prev-pos : previous position for the current path. Necessary for relative commands
;; prev-start : previous move-to necessary for Z commands
;; prev-cc : previous command control point for cubic beziers
;; prev-qc : previous command control point for quadratic curves
(fn [[result prev-pos prev-start prev-cc prev-qc] [command _prev]]
(let [command (assoc command :prev-pos prev-pos)
command
(cond-> command
(:relative command)
(-> (assoc :relative false)
(d/update-in-when [:params :c1x] + (:x prev-pos))
(d/update-in-when [:params :c1y] + (:y prev-pos))
(d/update-in-when [:params :c2x] + (:x prev-pos))
(d/update-in-when [:params :c2y] + (:y prev-pos))
(d/update-in-when [:params :cx] + (:x prev-pos))
(d/update-in-when [:params :cy] + (:y prev-pos))
(d/update-in-when [:params :x] + (:x prev-pos))
(d/update-in-when [:params :y] + (:y prev-pos))
(cond->
(= :line-to-horizontal (:command command))
(d/update-in-when [:params :value] + (:x prev-pos))
(= :line-to-vertical (:command command))
(d/update-in-when [:params :value] + (:y prev-pos)))))
params (:params command)
orig-command command
command
(cond-> command
(= :line-to-horizontal (:command command))
(-> (assoc :command :line-to)
(update :params dissoc :value)
(assoc-in [:params :x] (:value params))
(assoc-in [:params :y] (:y prev-pos)))
(= :line-to-vertical (:command command))
(-> (assoc :command :line-to)
(update :params dissoc :value)
(assoc-in [:params :y] (:value params))
(assoc-in [:params :x] (:x prev-pos)))
(= :smooth-curve-to (:command command))
(-> (assoc :command :curve-to)
(update :params dissoc :cx :cy)
(update :params merge (smooth->curve command prev-pos prev-cc)))
(= :quadratic-bezier-curve-to (:command command))
(-> (assoc :command :curve-to)
(update :params dissoc :cx :cy)
(update :params merge (quadratic->curve prev-pos (gpt/point params) (gpt/point (:cx params) (:cy params)))))
(= :smooth-quadratic-bezier-curve-to (:command command))
(-> (assoc :command :curve-to)
(update :params merge (quadratic->curve prev-pos (gpt/point params) (upg/calculate-opposite-handler prev-pos prev-qc)))))
result (if (= :elliptical-arc (:command command))
(into result (arc->beziers prev-pos command))
(conj result command))
next-cc (case (:command orig-command)
:smooth-curve-to
(gpt/point (get-in orig-command [:params :cx]) (get-in orig-command [:params :cy]))
:curve-to
(gpt/point (get-in orig-command [:params :c2x]) (get-in orig-command [:params :c2y]))
(:line-to-horizontal :line-to-vertical)
(gpt/point (get-in command [:params :x]) (get-in command [:params :y]))
(gpt/point (get-in orig-command [:params :x]) (get-in orig-command [:params :y])))
next-qc (case (:command orig-command)
:quadratic-bezier-curve-to
(gpt/point (get-in orig-command [:params :cx]) (get-in orig-command [:params :cy]))
:smooth-quadratic-bezier-curve-to
(upg/calculate-opposite-handler prev-pos prev-qc)
(gpt/point (get-in orig-command [:params :x]) (get-in orig-command [:params :y])))
next-pos (if (= :close-path (:command command))
prev-start
(upc/command->point prev-pos command))
next-start (if (= :move-to (:command command)) next-pos prev-start)]
[result next-pos next-start next-cc next-qc]))
start (first commands)
start (cond-> start
(:relative start)
(assoc :relative false))
start-pos (gpt/point (:params start))]
(->> (map vector (rest commands) commands)
(reduce simplify-command [[start] start-pos start-pos start-pos start-pos])
(first))))
(defn parse [path-str]
(if (empty? path-str)
path-str
(let [clean-path-str
(-> path-str
(str/trim)
;; Change "commas" for spaces
(str/replace #"," " ")
;; Remove all consecutive spaces
(str/replace #"\s+" " "))
commands (re-seq commands-regex clean-path-str)]
(-> (mapcat parse-command commands)
(simplify-commands)))))

20
common/src/app/common/svg/path/legacy_parser2.cljc
View File

@ -12,15 +12,23 @@
(:require
[app.common.data :as d]
[app.common.geom.point :as gpt]
[app.common.geom.shapes.path :as upg]
[app.common.math :as mth]
[app.common.svg :as csvg]
[app.common.svg.path.command :as upc]
[app.common.types.path.helpers :as path.helpers]
[app.common.types.path.segment :as path.segment]
[cuerdas.core :as str]))
(def commands-regex #"(?i)[mzlhvcsqta][^mzlhvcsqta]*")
(def regex #"[+-]?(\d+(\.\d+)?|\.\d+)(e[+-]?\d+)?")
(defn- get-point
"Get a point for a segment"
[prev-pos {:keys [relative params] :as segment}]
(let [{:keys [x y] :or {x (:x prev-pos) y (:y prev-pos)}} params]
(if relative
(-> prev-pos (update :x + x) (update :y + y))
(path.helpers/segment->point segment))))
(defn extract-params
[data pattern]
(loop [result []
@ -185,7 +193,7 @@
(defn smooth->curve
[{:keys [params]} pos handler]
(let [{c1x :x c1y :y} (upg/calculate-opposite-handler pos handler)]
(let [{c1x :x c1y :y} (path.segment/calculate-opposite-handler pos handler)]
{:c1x c1x
:c1y c1y
:c2x (:cx params)
@ -413,7 +421,7 @@
(= :smooth-quadratic-bezier-curve-to (:command command))
(-> (assoc :command :curve-to)
(update :params merge (quadratic->curve prev-pos (gpt/point params) (upg/calculate-opposite-handler prev-pos prev-qc)))))
(update :params merge (quadratic->curve prev-pos (gpt/point params) (path.segment/calculate-opposite-handler prev-pos prev-qc)))))
result (if (= :elliptical-arc (:command command))
(into result (arc->beziers prev-pos command))
@ -436,13 +444,13 @@
(gpt/point (get-in orig-command [:params :cx]) (get-in orig-command [:params :cy]))
:smooth-quadratic-bezier-curve-to
(upg/calculate-opposite-handler prev-pos prev-qc)
(path.segment/calculate-opposite-handler prev-pos prev-qc)
(gpt/point (get-in orig-command [:params :x]) (get-in orig-command [:params :y])))
next-pos (if (= :close-path (:command command))
prev-start
(upc/command->point prev-pos command))
(get-point prev-pos command))
next-start (if (= :move-to (:command command)) next-pos prev-start)]

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)

4
common/src/app/common/types/file.cljc
View File

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

215
common/src/app/common/types/path.cljc Normal file
View File

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

273
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/segment->point prev))))))))
(defn close-paths
"Removes the :close-path commands and replace them for line-to so we can calculate
the intersections"
[content]
(loop [head (first content)
content (rest content)
result []
last-move nil
last-p nil]
(loop [segments (seq content)
result []
last-move nil
last-point nil]
(if-let [segment (first segments)]
(let [point
(helpers/segment->point segment)
(if (nil? head)
result
(let [head-p (gsp/command->point head)
head (cond
(and (= :close-path (:command head))
(or (nil? last-p) ;; Ignore consecutive close-paths
(< (gpt/distance last-p last-move) 0.01)))
nil
segment
(cond
(and (= :close-path (:command segment))
(or (nil? last-point) ;; Ignore consecutive close-paths
(< (gpt/distance last-point last-move) 0.01)))
nil
(= :close-path (:command head))
(upc/make-line-to last-move)
(= :close-path (:command segment))
(helpers/make-line-to last-move)
:else
head)]
:else
segment)]
(recur (first content)
(rest content)
(cond-> result (some? head) (conj head))
(if (= :move-to (:command head))
head-p
(recur (rest segments)
(cond-> result (some? segment) (conj segment))
(if (= :move-to (:command segment))
point
last-move)
head-p)))))
point))
result)))
(defn- split-command
[cmd values]
(case (:command cmd)
:line-to (gsp/split-line-to-ranges (:prev cmd) cmd values)
:curve-to (gsp/split-curve-to-ranges (:prev cmd) cmd values)
:line-to (helpers/split-line-to-ranges (:prev cmd) cmd values)
:curve-to (helpers/split-curve-to-ranges (:prev cmd) cmd values)
[cmd]))
(defn split-ts [seg-1 seg-2]
(cond
(and (= :line-to (:command seg-1))
(= :line-to (:command seg-2)))
(gsp/line-line-intersect (gsp/command->line seg-1) (gsp/command->line seg-2))
(defn- split-ts
[seg-1 seg-2]
(let [cmd-1 (get seg-1 :command)
cmd-2 (get seg-2 :command)]
(cond
(and (= :line-to cmd-1)
(= :line-to cmd-2))
(helpers/line-line-intersect (helpers/command->line seg-1)
(helpers/command->line seg-2))
(and (= :line-to (:command seg-1))
(= :curve-to (:command seg-2)))
(gsp/line-curve-intersect (gsp/command->line seg-1) (gsp/command->bezier seg-2))
(and (= :line-to cmd-1)
(= :curve-to cmd-2))
(helpers/line-curve-intersect (helpers/command->line seg-1)
(helpers/command->bezier seg-2))
(and (= :curve-to (:command seg-1))
(= :line-to (:command seg-2)))
(let [[seg-2' seg-1']
(gsp/line-curve-intersect (gsp/command->line seg-2) (gsp/command->bezier seg-1))]
;; Need to reverse because we send the arguments reversed
[seg-1' seg-2'])
(and (= :curve-to cmd-1)
(= :line-to cmd-2))
(let [[seg-2' seg-1']
(helpers/line-curve-intersect (helpers/command->line seg-2)
(helpers/command->bezier seg-1))]
;; Need to reverse because we send the arguments reversed
[seg-1' seg-2'])
(and (= :curve-to (:command seg-1))
(= :curve-to (:command seg-2)))
(gsp/curve-curve-intersect (gsp/command->bezier seg-1) (gsp/command->bezier seg-2))
(and (= :curve-to cmd-1)
(= :curve-to cmd-2))
(helpers/curve-curve-intersect (helpers/command->bezier seg-1)
(helpers/command->bezier seg-2))
:else
[[] []]))
:else
[[] []])))
(defn content-intersect-split
[content-a content-b sr-a sr-b]
(let [command->selrect (memoize gsp/command->selrect)]
(let [command->selrect (memoize helpers/command->selrect)]
(letfn [(overlap-segment-selrect?
[segment selrect]
(letfn [(overlap-segment-selrect? [segment selrect]
(if (= :move-to (:command segment))
false
(let [r1 (command->selrect segment)]
(grc/overlaps-rects? r1 selrect))))
(overlap-segments?
[seg-1 seg-2]
(overlap-segments? [seg-1 seg-2]
(if (or (= :move-to (:command seg-1))
(= :move-to (:command seg-2)))
false
@ -113,17 +145,14 @@
r2 (command->selrect seg-2)]
(grc/overlaps-rects? r1 r2))))
(split
[seg-1 seg-2]
(split [seg-1 seg-2]
(if (not (overlap-segments? seg-1 seg-2))
[seg-1]
(let [[ts-seg-1 _] (split-ts seg-1 seg-2)]
(-> (split-command seg-1 ts-seg-1)
(add-previous (:prev seg-1))))))
(split-segment-on-content
[segment content content-sr]
(split-segment-on-content [segment content content-sr]
(if (overlap-segment-selrect? segment content-sr)
(->> content
(filter #(overlap-segments? segment %))
@ -133,8 +162,7 @@
[segment]))
[segment]))
(split-content
[content-a content-b sr-b]
(split-content [content-a content-b sr-b]
(into []
(mapcat #(split-segment-on-content % content-b sr-b))
content-a))]
@ -151,28 +179,28 @@
[segment content content-sr content-geom]
(let [point (case (:command segment)
:line-to (-> (gsp/command->line segment)
(gsp/line-values 0.5))
:line-to (-> (helpers/command->line segment)
(helpers/line-values 0.5))
:curve-to (-> (gsp/command->bezier segment)
(gsp/curve-values 0.5)))]
:curve-to (-> (helpers/command->bezier segment)
(helpers/curve-values 0.5)))]
(and (grc/contains-point? content-sr point)
(or
(gsp/is-point-in-geom-data? point content-geom)
(gsp/is-point-in-border? point content)))))
(helpers/is-point-in-geom-data? point content-geom)
(helpers/is-point-in-border? point content)))))
(defn inside-segment?
[segment content-sr content-geom]
(let [point (case (:command segment)
:line-to (-> (gsp/command->line segment)
(gsp/line-values 0.5))
:line-to (-> (helpers/command->line segment)
(helpers/line-values 0.5))
:curve-to (-> (gsp/command->bezier segment)
(gsp/curve-values 0.5)))]
:curve-to (-> (helpers/command->bezier segment)
(helpers/curve-values 0.5)))]
(and (grc/contains-point? content-sr point)
(gsp/is-point-in-geom-data? point content-geom))))
(helpers/is-point-in-geom-data? point content-geom))))
(defn overlap-segment?
"Finds if the current segment is overlapping against other
@ -185,8 +213,8 @@
(contains? #{:line-to :curve-to} (:command segment)))
(case (:command segment)
:line-to (let [[p1 q1] (gsp/command->line segment)
[p2 q2] (gsp/command->line other)]
:line-to (let [[p1 q1] (helpers/command->line segment)
[p2 q2] (helpers/command->line other)]
(when (or (and (< (gpt/distance p1 p2) 0.1)
(< (gpt/distance q1 q2) 0.1))
@ -194,8 +222,8 @@
(< (gpt/distance q1 p2) 0.1)))
[segment other]))
:curve-to (let [[p1 q1 h11 h21] (gsp/command->bezier segment)
[p2 q2 h12 h22] (gsp/command->bezier other)]
:curve-to (let [[p1 q1 h11 h21] (helpers/command->bezier segment)
[p2 q2 h12 h22] (helpers/command->bezier other)]
(when (or (and (< (gpt/distance p1 p2) 0.1)
(< (gpt/distance q1 q2) 0.1)
@ -227,11 +255,11 @@
result
(let [result (if (not= (:prev current) prev)
(conj result (upc/make-move-to (:prev current)))
(conj result (helpers/make-move-to (:prev current)))
result)]
(recur (first content)
(rest content)
(gsp/command->point current)
(helpers/segment->point current)
(conj result (dissoc current :prev)))))))
(defn remove-duplicated-segments
@ -273,20 +301,43 @@
segments
result))))))
(defn close-content
[content]
(into []
(mapcat :data)
(->> content
(subpath/close-subpaths)
(subpath/get-subpaths))))
(defn- content->geom-data
[content]
(->> content
(close-content)
(filter #(not= (= :line-to (:command %))
(= :curve-to (:command %))))
(mapv (fn [segment]
{:command (:command segment)
:segment segment
:geom (if (= :line-to (:command segment))
(helpers/command->line segment)
(helpers/command->bezier segment))
:selrect (helpers/command->selrect segment)}))))
(defn create-union [content-a content-a-split content-b content-b-split sr-a sr-b]
;; Pick all segments in content-a that are not inside content-b
;; Pick all segments in content-b that are not inside content-a
(let [content-a-geom (gsp/content->geom-data content-a)
content-b-geom (gsp/content->geom-data content-b)
(let [content-a-geom (content->geom-data content-a)
content-b-geom (content->geom-data content-b)
content
(concat
(->> content-a-split (filter #(not (contains-segment? % content-b sr-b content-b-geom))))
(->> content-b-split (filter #(not (contains-segment? % content-a sr-a content-a-geom)))))
content-geom (gsp/content->geom-data content)
content-geom (content->geom-data content)
content-sr (gsp/content->selrect (fix-move-to content))
content-sr (segment/content->selrect (fix-move-to content))
;; Overlapping segments should be added when they are part of the border
border-content
@ -302,8 +353,8 @@
;; Pick all segments in content-a that are not inside content-b
;; Pick all segments in content b that are inside content-a
;; removing overlapping
(let [content-a-geom (gsp/content->geom-data content-a)
content-b-geom (gsp/content->geom-data content-b)]
(let [content-a-geom (content->geom-data content-a)
content-b-geom (content->geom-data content-b)]
(d/concat-vec
(->> content-a-split (filter #(not (contains-segment? % content-b sr-b content-b-geom))))
@ -315,13 +366,12 @@
(defn create-intersection [content-a content-a-split content-b content-b-split sr-a sr-b]
;; Pick all segments in content-a that are inside content-b
;; Pick all segments in content-b that are inside content-a
(let [content-a-geom (gsp/content->geom-data content-a)
content-b-geom (gsp/content->geom-data content-b)]
(let [content-a-geom (content->geom-data content-a)
content-b-geom (content->geom-data content-b)]
(d/concat-vec
(->> content-a-split (filter #(contains-segment? % content-b sr-b content-b-geom)))
(->> content-b-split (filter #(contains-segment? % content-a sr-a content-a-geom))))))
(defn create-exclusion [content-a content-b]
;; Pick all segments
(d/concat-vec content-a content-b))
@ -331,26 +381,37 @@
(let [;; We need to reverse the second path when making a difference/intersection/exclude
;; and both shapes are in the same direction
should-reverse? (and (not= :union bool-type)
(= (ups/clockwise? content-b)
(ups/clockwise? content-a)))
should-reverse?
(and (not= :union bool-type)
(= (subpath/clockwise? content-b)
(subpath/clockwise? content-a)))
content-a (-> content-a
(close-paths)
(add-previous))
content-a
(-> content-a
(close-paths)
(add-previous))
content-b (-> content-b
(close-paths)
(cond-> should-reverse? (ups/reverse-content))
(add-previous))
content-b
(-> content-b
(close-paths)
(cond-> should-reverse? (subpath/reverse-content))
(add-previous))
sr-a (gsp/content->selrect content-a)
sr-b (gsp/content->selrect content-b)
sr-a
(segment/content->selrect content-a)
sr-b
(segment/content->selrect content-b)
;; Split content in new segments in the intersection with the other path
[content-a-split content-b-split] (content-intersect-split content-a content-b sr-a sr-b)
content-a-split (->> content-a-split add-previous (filter is-segment?))
content-b-split (->> content-b-split add-previous (filter is-segment?))
[content-a-split content-b-split]
(content-intersect-split content-a content-b sr-a sr-b)
content-a-split
(->> content-a-split add-previous (filter is-segment?))
content-b-split
(->> content-b-split add-previous (filter is-segment?))
content
(case bool-type
@ -362,14 +423,16 @@
(-> content
remove-duplicated-segments
fix-move-to
ups/close-subpaths)))
subpath/close-subpaths)))
(defn content-bool
(defn calculate-content
"Create a bool content from a collection of contents and specified
type."
[bool-type contents]
;; We apply the boolean operation in to each pair and the result to the next
;; element
(if (seq contents)
(->> contents
(reduce (partial content-bool-pair bool-type))
(into []))
(vec))
[]))

1118
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

782
common/src/app/common/types/path/impl.cljc Normal file
View File

@ -0,0 +1,782 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS INC
(ns app.common.types.path.impl
"Contains schemas and data type implementation for PathData binary
and plain formats"
#?(:cljs
(:require-macros [app.common.types.path.impl :refer [read-float read-short write-float write-short]]))
(:refer-clojure :exclude [-lookup -reduce])
(:require
#?(:clj [app.common.fressian :as fres])
#?(:clj [clojure.data.json :as json])
#?(:cljs [app.common.weak-map :as weak-map])
[app.common.data.macros :as dm]
[app.common.schema :as sm]
[app.common.schema.generators :as sg]
[app.common.svg.path :as svg.path]
[app.common.transit :as t]
[app.common.types.path :as-alias path])
(:import
#?(:cljs [goog.string StringBuffer]
:clj [java.nio ByteBuffer ByteOrder])))
#?(:clj (set! *warn-on-reflection* true))
(def ^:const SEGMENT-BYTE-SIZE 28)
(defprotocol IPathData
(-write-to [_ buffer offset] "write the content to the specified buffer")
(-get-byte-size [_] "get byte size"))
(defprotocol ITransformable
(-transform [_ m] "apply a transform")
(-lookup [_ index f])
(-walk [_ f initial])
(-reduce [_ f initial]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; IMPL HELPERS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmacro read-short
[target offset]
(if (:ns &env)
`(.getInt16 ~target ~offset true)
(let [target (with-meta target {:tag 'java.nio.ByteBuffer})]
`(.getShort ~target ~offset))))
(defmacro read-float
[target offset]
(if (:ns &env)
`(.getFloat32 ~target ~offset true)
(let [target (with-meta target {:tag 'java.nio.ByteBuffer})]
`(double (.getFloat ~target ~offset)))))
(defmacro write-float
[target offset value]
(if (:ns &env)
`(.setFloat32 ~target ~offset ~value true)
(let [target (with-meta target {:tag 'java.nio.ByteBuffer})]
`(.putFloat ~target ~offset ~value))))
(defmacro write-short
[target offset value]
(if (:ns &env)
`(.setInt16 ~target ~offset ~value true)
(let [target (with-meta target {:tag 'java.nio.ByteBuffer})]
`(.putShort ~target ~offset ~value))))
(defmacro with-cache
"A helper macro that facilitates cache handling for content
instance, only relevant on CLJS"
[target key & expr]
(if (:ns &env)
(let [cache (gensym "cache-")
target (with-meta target {:tag 'js})]
`(let [~cache (.-cache ~target)
~'result (.get ~cache ~key)]
(if ~'result
(do
~'result)
(let [~'result (do ~@expr)]
(.set ~cache ~key ~'result)
~'result))))
`(do ~@expr)))
(defn- allocate
[n-segments]
#?(:clj (let [buffer (ByteBuffer/allocate (* n-segments SEGMENT-BYTE-SIZE))]
(.order buffer ByteOrder/LITTLE_ENDIAN))
:cljs (new js/ArrayBuffer (* n-segments SEGMENT-BYTE-SIZE))))
(defn- clone-buffer
[buffer]
#?(:clj
(let [src (.array ^ByteBuffer buffer)
len (alength ^bytes src)
dst (byte-array len)]
(System/arraycopy src 0 dst 0 len)
(let [buffer (ByteBuffer/wrap dst)]
(.order buffer ByteOrder/LITTLE_ENDIAN)))
:cljs
(let [src-view (js/Uint32Array. buffer)
dst-buff (js/ArrayBuffer. (.-byteLength buffer))
dst-view (js/Uint32Array. dst-buff)]
(.set dst-view src-view)
dst-buff)))
(defn- impl-transform-segment
"Apply a transformation to a segment located under specified offset"
[buffer offset a b c d e f]
(let [t (read-short buffer offset)]
(case t
(1 2)
(let [x (read-float buffer (+ offset 20))
y (read-float buffer (+ offset 24))
x (+ (* x a) (* y c) e)
y (+ (* x b) (* y d) f)]
(write-float buffer (+ offset 20) x)
(write-float buffer (+ offset 24) y))
3
(let [c1x (read-float buffer (+ offset 4))
c1y (read-float buffer (+ offset 8))
c2x (read-float buffer (+ offset 12))
c2y (read-float buffer (+ offset 16))
x (read-float buffer (+ offset 20))
y (read-float buffer (+ offset 24))
c1x (+ (* c1x a) (* c1y c) e)
c1y (+ (* c1x b) (* c1y d) f)
c2x (+ (* c2x a) (* c2y c) e)
c2y (+ (* c2x b) (* c2y d) f)
x (+ (* x a) (* y c) e)
y (+ (* x b) (* y d) f)]
(write-float buffer (+ offset 4) c1x)
(write-float buffer (+ offset 8) c1y)
(write-float buffer (+ offset 12) c2x)
(write-float buffer (+ offset 16) c2y)
(write-float buffer (+ offset 20) x)
(write-float buffer (+ offset 24) y))
nil)))
(defn- impl-transform
[buffer m size]
(let [a (dm/get-prop m :a)
b (dm/get-prop m :b)
c (dm/get-prop m :c)
d (dm/get-prop m :d)
e (dm/get-prop m :e)
f (dm/get-prop m :f)]
(loop [index 0]
(when (< index size)
(let [offset (* index SEGMENT-BYTE-SIZE)]
(impl-transform-segment buffer offset a b c d e f)
(recur (inc index)))))))
(defn- impl-walk
[buffer f initial size]
(loop [index 0
result (transient initial)]
(if (< index size)
(let [offset (* index SEGMENT-BYTE-SIZE)
type (read-short buffer offset)
c1x (read-float buffer (+ offset 4))
c1y (read-float buffer (+ offset 8))
c2x (read-float buffer (+ offset 12))
c2y (read-float buffer (+ offset 16))
x (read-float buffer (+ offset 20))
y (read-float buffer (+ offset 24))
type (case type
1 :line-to
2 :move-to
3 :curve-to
4 :close-path)
res (f type c1x c1y c2x c2y x y)]
(recur (inc index)
(if (some? res)
(conj! result res)
result)))
(persistent! result))))
(defn impl-reduce
[buffer f initial size]
(loop [index 0
result initial]
(if (< index size)
(let [offset (* index SEGMENT-BYTE-SIZE)
type (read-short buffer offset)
c1x (read-float buffer (+ offset 4))
c1y (read-float buffer (+ offset 8))
c2x (read-float buffer (+ offset 12))
c2y (read-float buffer (+ offset 16))
x (read-float buffer (+ offset 20))
y (read-float buffer (+ offset 24))
type (case type
1 :line-to
2 :move-to
3 :curve-to
4 :close-path)
result (f result index type c1x c1y c2x c2y x y)]
(if (reduced? result)
result
(recur (inc index) result)))
result)))
(defn impl-lookup
[buffer index f]
(let [offset (* index SEGMENT-BYTE-SIZE)
type (read-short buffer offset)
c1x (read-float buffer (+ offset 4))
c1y (read-float buffer (+ offset 8))
c2x (read-float buffer (+ offset 12))
c2y (read-float buffer (+ offset 16))
x (read-float buffer (+ offset 20))
y (read-float buffer (+ offset 24))
type (case type
1 :line-to
2 :move-to
3 :curve-to
4 :close-path)]
#?(:clj (f type c1x c1y c2x c2y x y)
:cljs (^function f type c1x c1y c2x c2y x y))))
(defn- to-string-segment*
[buffer offset type ^StringBuilder builder]
(case (long type)
1 (let [x (read-float buffer (+ offset 20))
y (read-float buffer (+ offset 24))]
(doto builder
(.append "M")
(.append x)
(.append ",")
(.append y)))
2 (let [x (read-float buffer (+ offset 20))
y (read-float buffer (+ offset 24))]
(doto builder
(.append "L")
(.append x)
(.append ",")
(.append y)))
3 (let [c1x (read-float buffer (+ offset 4))
c1y (read-float buffer (+ offset 8))
c2x (read-float buffer (+ offset 12))
c2y (read-float buffer (+ offset 16))
x (read-float buffer (+ offset 20))
y (read-float buffer (+ offset 24))]
(doto builder
(.append "C")
(.append c1x)
(.append ",")
(.append c1y)
(.append ",")
(.append c2x)
(.append ",")
(.append c2y)
(.append ",")
(.append x)
(.append ",")
(.append y)))
4 (doto builder
(.append "Z"))))
(defn- to-string
"Format the path data structure to string"
[buffer size]
(let [builder #?(:clj (java.lang.StringBuilder. (int (* size 4)))
:cljs (StringBuffer.))]
(loop [index 0]
(when (< index size)
(let [offset (* index SEGMENT-BYTE-SIZE)
type (read-short buffer offset)]
(to-string-segment* buffer offset type builder)
(recur (inc index)))))
(.toString builder)))
(defn- read-segment
"Read segment from binary buffer at specified index"
[buffer index]
(let [offset (* index SEGMENT-BYTE-SIZE)
type (read-short buffer offset)]
(case (long type)
1 (let [x (read-float buffer (+ offset 20))
y (read-float buffer (+ offset 24))]
{:command :move-to
:params {:x (double x)
:y (double y)}})
2 (let [x (read-float buffer (+ offset 20))
y (read-float buffer (+ offset 24))]
{:command :line-to
:params {:x (double x)
:y (double y)}})
3 (let [c1x (read-float buffer (+ offset 4))
c1y (read-float buffer (+ offset 8))
c2x (read-float buffer (+ offset 12))
c2y (read-float buffer (+ offset 16))
x (read-float buffer (+ offset 20))
y (read-float buffer (+ offset 24))]
{:command :curve-to
:params {:x (double x)
:y (double y)
:c1x (double c1x)
:c1y (double c1y)
:c2x (double c2x)
:c2y (double c2y)}})
4 {:command :close-path
:params {}})))
(defn- in-range?
[size i]
(and (< i size) (>= i 0)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; TYPE: PATH-DATA
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
#?(:clj
(deftype PathData [size
^ByteBuffer buffer
^:unsynchronized-mutable hash]
Object
(toString [_]
(to-string buffer size))
(equals [_ other]
(if (instance? PathData other)
(.equals ^ByteBuffer buffer (.-buffer ^PathData other))
false))
ITransformable
(-transform [_ m]
(let [buffer (clone-buffer buffer)]
(impl-transform buffer m size)
(PathData. size buffer nil)))
(-walk [_ f initial]
(impl-walk buffer f initial size))
(-reduce [_ f initial]
(impl-reduce buffer f initial size))
(-lookup [_ index f]
(when (and (<= 0 index)
(< index size))
(impl-lookup buffer index f)))
json/JSONWriter
(-write [this writter options]
(json/-write (.toString this) writter options))
clojure.lang.IHashEq
(hasheq [this]
(when-not hash
(set! hash (clojure.lang.Murmur3/hashOrdered (seq this))))
hash)
clojure.lang.Sequential
clojure.lang.Seqable
(seq [_]
(when (pos? size)
((fn next-seq [i]
(when (< i size)
(cons (read-segment buffer i)
(lazy-seq (next-seq (inc i))))))
0)))
clojure.lang.IReduceInit
(reduce [_ f start]
(loop [index 0
result start]
(if (< index size)
(let [result (f result (read-segment buffer index))]
(if (reduced? result)
@result
(recur (inc index) result)))
result)))
clojure.lang.Indexed
(nth [_ i]
(if (in-range? size i)
(read-segment buffer i)
nil))
(nth [_ i default]
(if (in-range? size i)
(read-segment buffer i)
default))
clojure.lang.Counted
(count [_] size)
IPathData
(-get-byte-size [_]
(* size SEGMENT-BYTE-SIZE))
(-write-to [_ _ _]
(throw (RuntimeException. "not implemented"))))
:cljs
#_:clj-kondo/ignore
(deftype PathData [size buffer dview cache ^:mutable __hash]
Object
(toString [_]
(to-string dview size))
IPathData
(-get-byte-size [_]
(.-byteLength buffer))
(-write-to [_ into-buffer offset]
;; NOTE: we still use u8 because until the heap refactor merge
;; we can't guarrantee the alignment of offset on 4 bytes
(assert (instance? js/ArrayBuffer into-buffer))
(let [size (.-byteLength buffer)
mem (js/Uint8Array. into-buffer offset size)]
(.set mem (js/Uint8Array. buffer))))
ITransformable
(-transform [this m]
(let [buffer (clone-buffer buffer)
dview (js/DataView. buffer)]
(impl-transform dview m size)
(PathData. size buffer dview (weak-map/create) nil)))
(-walk [_ f initial]
(impl-walk dview f initial size))
(-reduce [_ f initial]
(impl-reduce dview f initial size))
(-lookup [_ index f]
(when (and (<= 0 index)
(< index size))
(impl-lookup dview index f)))
cljs.core/ISequential
cljs.core/IEquiv
(-equiv [this other]
(if (instance? PathData other)
(let [obuffer (.-buffer other)]
(if (= (.-byteLength obuffer)
(.-byteLength buffer))
(let [cb (js/Uint32Array. buffer)
ob (js/Uint32Array. obuffer)
sz (alength cb)]
(loop [i 0]
(if (< i sz)
(if (= (aget ob i)
(aget cb i))
(recur (inc i))
false)
true)))
false))
false))
cljs.core/IReduce
(-reduce [_ f]
(loop [index 1
result (if (pos? size)
(read-segment dview 0)
nil)]
(if (< index size)
(let [result (f result (read-segment dview index))]
(if (reduced? result)
@result
(recur (inc index) result)))
result)))
(-reduce [_ f start]
(loop [index 0
result start]
(if (< index size)
(let [result (f result (read-segment dview index))]
(if (reduced? result)
@result
(recur (inc index) result)))
result)))
cljs.core/IHash
(-hash [coll]
(caching-hash coll hash-ordered-coll __hash))
cljs.core/ICounted
(-count [_] size)
cljs.core/IIndexed
(-nth [_ i]
(if (in-range? size i)
(read-segment dview i)
nil))
(-nth [_ i default]
(if (in-range? i size)
(read-segment dview i)
default))
cljs.core/ISeqable
(-seq [this]
(when (pos? size)
((fn next-seq [i]
(when (< i size)
(cons (read-segment dview i)
(lazy-seq (next-seq (inc i))))))
0)))
cljs.core/IPrintWithWriter
(-pr-writer [this writer _]
(cljs.core/-write writer (str "#penpot/path-data \"" (.toString this) "\"")))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SCHEMA
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def schema:safe-number
[:schema {:gen/gen (sg/small-int :max 100 :min -100)}
::sm/safe-number])
(def ^:private schema:line-to-segment
[:map
[:command [:= :line-to]]
[:params
[:map
[:x schema:safe-number]
[:y schema:safe-number]]]])
(def ^:private schema:close-path-segment
[:map
[:command [:= :close-path]]])
(def ^:private schema:move-to-segment
[:map
[:command [:= :move-to]]
[:params
[:map
[:x schema:safe-number]
[:y schema:safe-number]]]])
(def ^:private schema:curve-to-segment
[:map
[:command [:= :curve-to]]
[:params
[:map
[:x schema:safe-number]
[:y schema:safe-number]
[:c1x schema:safe-number]
[:c1y schema:safe-number]
[:c2x schema:safe-number]
[:c2y schema:safe-number]]]])
(def ^:private schema:segment
[:multi {:title "PathSegment"
:dispatch :command
:decode/json #(update % :command keyword)}
[:line-to schema:line-to-segment]
[:close-path schema:close-path-segment]
[:move-to schema:move-to-segment]
[:curve-to schema:curve-to-segment]])
(def schema:segments
[:vector {:gen/gen (->> (sg/generator schema:segment)
(sg/vector)
(sg/filter not-empty)
(sg/filter (fn [[e1]]
(= (:command e1) :move-to))))}
schema:segment])
(def schema:content-like
[:sequential schema:segment])
(def check-content-like
(sm/check-fn schema:content-like))
(def check-segment
(sm/check-fn schema:segment))
(def ^:private check-segments
(sm/check-fn schema:segments))
(defn path-data?
[o]
(instance? PathData o))
(declare from-string)
(declare from-plain)
;; Mainly used on backend: features/components_v2.clj
(sm/register! ::path/segment schema:segment)
(sm/register! ::path/segments schema:segments)
(sm/register!
{:type ::path/content
:compile
(fn [_ _ _]
(let [decoder (delay (sm/decoder schema:segments sm/json-transformer))
generator (->> (sg/generator schema:segments)
(sg/filter not-empty)
(sg/fmap from-plain))]
{:pred path-data?
:type-properties
{:gen/gen generator
:encode/json identity
:decode/json (fn [s]
(cond
(string? s)
(from-string s)
(vector? s)
(let [decode-fn (deref decoder)]
(-> (decode-fn s)
(from-plain)))
:else
s))}}))})
(def check-path-content
(sm/check-fn ::path/content))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; CONSTRUCTORS & PREDICATES
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn from-string
[s]
(from-plain (svg.path/parse s)))
(defn from-bytes
[buffer]
#?(:clj
(cond
(instance? ByteBuffer buffer)
(let [size (.capacity ^ByteBuffer buffer)
count (long (/ size SEGMENT-BYTE-SIZE))
buffer (.order ^ByteBuffer buffer ByteOrder/LITTLE_ENDIAN)]
(PathData. count buffer nil))
(bytes? buffer)
(let [size (alength ^bytes buffer)
count (long (/ size SEGMENT-BYTE-SIZE))
buffer (ByteBuffer/wrap buffer)]
(PathData. count
(.order buffer ByteOrder/LITTLE_ENDIAN)
nil))
:else
(throw (java.lang.IllegalArgumentException. "invalid data provided")))
:cljs
(cond
(instance? js/ArrayBuffer buffer)
(let [size (.-byteLength buffer)
count (long (/ size SEGMENT-BYTE-SIZE))]
(PathData. count
buffer
(js/DataView. buffer)
(weak-map/create)
nil))
(instance? js/DataView buffer)
(let [dview buffer
buffer (.-buffer dview)
size (.-byteLength buffer)
count (long (/ size SEGMENT-BYTE-SIZE))]
(PathData. count buffer dview (weak-map/create) nil))
(instance? js/Uint8Array buffer)
(from-bytes (.-buffer buffer))
(instance? js/Int8Array buffer)
(from-bytes (.-buffer buffer))
:else
(throw (js/Error. "invalid data provided")))))
;; FIXME: consider implementing with reduce
;; FIXME: consider ensure fixed precision for avoid doing it on formatting
(defn from-plain
"Create a PathData instance from plain data structures"
[segments]
(assert (check-segments segments))
(let [total (count segments)
#?@(:cljs [buffer' (allocate total)
buffer (new js/DataView buffer')]
:clj [buffer (allocate total)])]
(loop [index 0]
(when (< index total)
(let [segment (nth segments index)
offset (* index SEGMENT-BYTE-SIZE)]
(case (get segment :command)
:move-to
(let [params (get segment :params)
x (float (get params :x))
y (float (get params :y))]
(write-short buffer offset 1)
(write-float buffer (+ offset 20) x)
(write-float buffer (+ offset 24) y))
:line-to
(let [params (get segment :params)
x (float (get params :x))
y (float (get params :y))]
(write-short buffer offset 2)
(write-float buffer (+ offset 20) x)
(write-float buffer (+ offset 24) y))
:curve-to
(let [params (get segment :params)
x (float (get params :x))
y (float (get params :y))
c1x (float (get params :c1x x))
c1y (float (get params :c1y y))
c2x (float (get params :c2x x))
c2y (float (get params :c2y y))]
(write-short buffer offset 3)
(write-float buffer (+ offset 4) c1x)
(write-float buffer (+ offset 8) c1y)
(write-float buffer (+ offset 12) c2x)
(write-float buffer (+ offset 16) c2y)
(write-float buffer (+ offset 20) x)
(write-float buffer (+ offset 24) y))
:close-path
(write-short buffer offset 4))
(recur (inc index)))))
(from-bytes buffer)))
(defn path-data
"Create an instance of PathData, returns itself if it is already
PathData instance"
[data]
(cond
(path-data? data)
data
(nil? data)
(from-plain [])
(sequential? data)
(from-plain data)
:else
(throw (ex-info "unexpected data" {:data data}))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SERIALIZATION
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(t/add-handlers!
{:id "penpot/path-data"
:class PathData
:wfn (fn [^PathData pdata]
(let [buffer (.-buffer pdata)]
#?(:cljs (js/Uint8Array. buffer)
:clj (.array ^ByteBuffer buffer))))
:rfn from-bytes})
#?(:clj
(fres/add-handlers!
{:name "penpot/path-data"
:class PathData
:wfn (fn [n w o]
(fres/write-tag! w n 1)
(let [buffer (.-buffer ^PathData o)
bytes (.array ^ByteBuffer buffer)]
(fres/write-bytes! w bytes)))
:rfn (fn [r]
(let [^bytes bytes (fres/read-object! r)]
(from-bytes bytes)))}))

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

@ -0,0 +1,889 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS INC
(ns app.common.types.path.segment
"A collection of helpers for work with plain segment type"
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.math :as mth]
[app.common.types.path.helpers :as helpers]
[app.common.types.path.impl :as impl]
[clojure.set :as set]))
#?(:clj (set! *warn-on-reflection* true))
(defn update-handler
[command prefix point]
(let [[cox coy] (if (= prefix :c1) [:c1x :c1y] [:c2x :c2y])]
(-> command
(assoc-in [:params cox] (:x point))
(assoc-in [:params coy] (:y point)))))
(defn get-handler [{:keys [params] :as command} prefix]
(let [cx (d/prefix-keyword prefix :x)
cy (d/prefix-keyword prefix :y)]
(when (and command
(contains? params cx)
(contains? params cy))
(gpt/point (get params cx)
(get params cy)))))
(defn get-handlers
"Retrieve a map where for every point will retrieve a list of
the handlers that are associated with that point.
point -> [[index, prefix]]"
[content]
(let [prev-point* (volatile! nil)
vec-conj (fnil conj [])]
(impl/-reduce content
(fn [result index type _ _ _ _ x y]
(let [curr-point (gpt/point x y)
prev-point (deref prev-point*)]
(vreset! prev-point* curr-point)
(if (and prev-point (= :curve-to type))
(-> result
(update prev-point vec-conj [index :c1])
(update curr-point vec-conj [index :c2]))
result)))
{})))
(defn point-indices
[content point]
(->> (d/enumerate content)
(filter (fn [[_ segment]] (= point (helpers/segment->point segment))))
(mapv (fn [[index _]] index))))
(defn handler-indices
"Return an index where the key is the positions and the values the handlers"
[content point]
(->> (d/with-prev content)
(d/enumerate)
(mapcat (fn [[index [cur-segment pre-segment]]]
(if (and (some? pre-segment) (= :curve-to (:command cur-segment)))
(let [cur-pos (helpers/segment->point cur-segment)
pre-pos (helpers/segment->point pre-segment)]
(cond-> []
(= pre-pos point) (conj [index :c1])
(= cur-pos point) (conj [index :c2])))
[])))))
(defn opposite-index
"Calculates the opposite index given a prefix and an index"
[content index prefix]
(let [point (if (= prefix :c2)
(helpers/segment->point (nth content index))
(helpers/segment->point (nth content (dec index))))
point->handlers (get-handlers content)
handlers (->> point
(point->handlers)
(filter (fn [[ci cp]] (and (not= index ci) (not= prefix cp)))))]
(cond
(= (count handlers) 1)
(->> handlers first)
(and (= :c1 prefix) (= (count content) index))
[(dec index) :c2]
:else nil)))
;; FIXME: rename to get-point
(defn get-handler-point
"Given a segment index and prefix, get a handler point"
[content index prefix]
(when (and (some? index)
(some? content))
(impl/-lookup content index
(fn [command c1x c1y c2x c2y x y]
(let [prefix (if (= :curve-to command)
prefix
nil)]
(case prefix
:c1 (gpt/point c1x c1y)
:c2 (gpt/point c2x c2y)
(gpt/point x y)))))))
;; FIXME: revisit this function
(defn handler->node
[content index prefix]
(if (= prefix :c1)
(helpers/segment->point (nth content (dec index)))
(helpers/segment->point (nth content index))))
(defn calculate-opposite-handler
"Given a point and its handler, gives the symmetric handler"
[point handler]
(let [handler-vector (gpt/to-vec point handler)]
(gpt/add point (gpt/negate handler-vector))))
(defn opposite-handler
"Calculates the coordinates of the opposite handler"
[point handler]
(let [phv (gpt/to-vec point handler)]
(gpt/add point (gpt/negate phv))))
(defn get-points
"Returns points for the given segment, faster version of
the `content->points`."
[content]
(impl/with-cache content "get-points"
(impl/-walk content
(fn [type _ _ _ _ x y]
(when (not= type :close-path)
(gpt/point x y)))
[])))
;; FIXME: incorrect API, don't need full shape
(defn path->lines
"Given a path returns a list of lines that approximate the path"
[shape]
(loop [command (first (:content shape))
pending (rest (:content shape))
result []
last-start nil
prev-point nil]
(if-let [{:keys [command params]} command]
(let [point (if (= :close-path command)
last-start
(gpt/point params))
result (case command
:line-to (conj result [prev-point point])
:curve-to (let [h1 (gpt/point (:c1x params) (:c1y params))
h2 (gpt/point (:c2x params) (:c2y params))]
(into result (helpers/curve->lines prev-point point h1 h2)))
:move-to (cond-> result
last-start (conj [prev-point last-start]))
result)
last-start (if (= :move-to command)
point
last-start)]
(recur (first pending)
(rest pending)
result
last-start
point))
(conj result [prev-point last-start]))))
(def ^:const path-closest-point-accuracy 0.01)
;; FIXME: move to helpers?, this function need performance review, it
;; is executed so many times on path edition
(defn- curve-closest-point
[position start end h1 h2]
(let [d (memoize (fn [t] (gpt/distance position (helpers/curve-values start end h1 h2 t))))]
(loop [t1 0.0
t2 1.0]
(if (<= (mth/abs (- t1 t2)) path-closest-point-accuracy)
(-> (helpers/curve-values start end h1 h2 t1)
;; store the segment info
(with-meta {:t t1 :from-p start :to-p end}))
(let [ht (+ t1 (/ (- t2 t1) 2))
ht1 (+ t1 (/ (- t2 t1) 4))
ht2 (+ t1 (/ (* 3 (- t2 t1)) 4))
[t1 t2] (cond
(< (d ht1) (d ht2))
[t1 ht]
(< (d ht2) (d ht1))
[ht t2]
(and (< (d ht) (d t1)) (< (d ht) (d t2)))
[ht1 ht2]
(< (d t1) (d t2))
[t1 ht]
:else
[ht t2])]
(recur (double t1)
(double t2)))))))
(defn- line-closest-point
"Point on line"
[position from-p to-p]
(let [e1 (gpt/to-vec from-p to-p)
e2 (gpt/to-vec from-p position)
len2 (+ (mth/sq (:x e1)) (mth/sq (:y e1)))
t (/ (gpt/dot e1 e2) len2)]
(if (and (>= t 0) (<= t 1) (not (mth/almost-zero? len2)))
(-> (gpt/add from-p (gpt/scale e1 t))
(with-meta {:t t
:from-p from-p
:to-p to-p}))
;; There is no perpendicular projection in the line so the closest
;; point will be one of the extremes
(if (<= (gpt/distance position from-p) (gpt/distance position to-p))
from-p
to-p))))
;; FIXME: incorrect API, complete shape is not necessary here
(defn path-closest-point
"Given a path and a position"
[shape position]
(let [point+distance
(fn [[cur-segment prev-segment]]
(let [from-p (helpers/segment->point prev-segment)
to-p (helpers/segment->point cur-segment)
h1 (gpt/point (get-in cur-segment [:params :c1x])
(get-in cur-segment [:params :c1y]))
h2 (gpt/point (get-in cur-segment [:params :c2x])
(get-in cur-segment [:params :c2y]))
point
(case (:command cur-segment)
:line-to
(line-closest-point position from-p to-p)
:curve-to
(curve-closest-point position from-p to-p h1 h2)
nil)]
(when point
[point (gpt/distance point position)])))
find-min-point
(fn [[min-p min-dist :as acc] [cur-p cur-dist :as cur]]
(if (and (some? acc) (or (not cur) (<= min-dist cur-dist)))
[min-p min-dist]
[cur-p cur-dist]))]
(->> (:content shape)
(d/with-prev)
(map point+distance)
(reduce find-min-point)
(first))))
(defn closest-point
"Given a path and a position"
[content position]
(let [point+distance
(fn [[cur-segment prev-segment]]
(let [from-p (helpers/segment->point prev-segment)
to-p (helpers/segment->point cur-segment)
h1 (gpt/point (get-in cur-segment [:params :c1x])
(get-in cur-segment [:params :c1y]))
h2 (gpt/point (get-in cur-segment [:params :c2x])
(get-in cur-segment [:params :c2y]))
point
(case (:command cur-segment)
:line-to
(line-closest-point position from-p to-p)
:curve-to
(curve-closest-point position from-p to-p h1 h2)
nil)]
(when point
[point (gpt/distance point position)])))
find-min-point
(fn [[min-p min-dist :as acc] [cur-p cur-dist :as cur]]
(if (and (some? acc) (or (not cur) (<= min-dist cur-dist)))
[min-p min-dist]
[cur-p cur-dist]))]
(->> content
(d/with-prev)
(map point+distance)
(reduce find-min-point)
(first))))
(defn- remove-line-curves
"Remove all curves that have both handlers in the same position that the
beginning and end points. This makes them really line-to commands"
[content]
(let [with-prev (d/enumerate (d/with-prev content))
process-command
(fn [content [index [command prev]]]
(let [cur-point (helpers/segment->point command)
pre-point (helpers/segment->point prev)
handler-c1 (get-handler command :c1)
handler-c2 (get-handler command :c2)]
(if (and (= :curve-to (:command command))
(= cur-point handler-c2)
(= pre-point handler-c1))
(assoc content index {:command :line-to
:params (into {} cur-point)})
content)))]
(reduce process-command content with-prev)))
(defn make-corner-point
"Changes the content to make a point a 'corner'"
[content point]
(let [handlers (-> (get-handlers content)
(get point))
change-content
(fn [content [index prefix]]
(let [cx (d/prefix-keyword prefix :x)
cy (d/prefix-keyword prefix :y)]
(-> content
(assoc-in [index :params cx] (:x point))
(assoc-in [index :params cy] (:y point)))))]
(as-> content $
(reduce change-content $ handlers)
(remove-line-curves $))))
(defn- line->curve
[from-p segment]
(let [to-p (helpers/segment->point segment)
v (gpt/to-vec from-p to-p)
d (gpt/distance from-p to-p)
dv1 (-> (gpt/normal-left v)
(gpt/scale (/ d 3)))
h1 (gpt/add from-p dv1)
dv2 (-> (gpt/to-vec to-p h1)
(gpt/unit)
(gpt/scale (/ d 3)))
h2 (gpt/add to-p dv2)]
(-> segment
(assoc :command :curve-to)
(update :params (fn [params]
;; ensure plain map
(-> (into {} params)
(assoc :c1x (:x h1))
(assoc :c1y (:y h1))
(assoc :c2x (:x h2))
(assoc :c2y (:y h2))))))))
;; FIXME: optimize
(defn is-curve?
[content point]
(let [handlers (-> (get-handlers content)
(get point))
handler-points (map #(get-handler-point content (first %) (second %)) handlers)]
(some #(not= point %) handler-points)))
(def ^:private xf:mapcat-points
(comp
(mapcat #(vector (:next-p %) (:prev-p %)))
(remove nil?)))
(defn make-curve-point
"Changes the content to make the point a 'curve'. The handlers will be positioned
in the same vector that results from the previous->next points but with fixed length."
[content point]
(let [indices (point-indices content point)
vectors (map (fn [index]
(let [segment (nth content index)
prev-i (dec index)
prev (when (not (= :move-to (:command segment)))
(get content prev-i))
next-i (inc index)
next (get content next-i)
next (when (not (= :move-to (:command next)))
next)]
{:index index
:prev-i (when (some? prev) prev-i)
:prev-c prev
:prev-p (helpers/segment->point prev)
:next-i (when (some? next) next-i)
:next-c next
:next-p (helpers/segment->point next)
:segment segment}))
indices)
points (into #{} xf:mapcat-points vectors)]
(if (= (count points) 2)
(let [v1 (gpt/to-vec (first points) point)
v2 (gpt/to-vec (first points) (second points))
vp (gpt/project v1 v2)
vh (gpt/subtract v1 vp)
add-curve
(fn [content {:keys [index prev-p next-p next-i]}]
(let [cur-segment (get content index)
next-segment (get content next-i)
;; New handlers for prev-point and next-point
prev-h (when (some? prev-p) (gpt/add prev-p vh))
next-h (when (some? next-p) (gpt/add next-p vh))
;; Correct 1/3 to the point improves the curve
prev-correction (when (some? prev-h) (gpt/scale (gpt/to-vec prev-h point) (/ 1 3)))
next-correction (when (some? next-h) (gpt/scale (gpt/to-vec next-h point) (/ 1 3)))
prev-h (when (some? prev-h) (gpt/add prev-h prev-correction))
next-h (when (some? next-h) (gpt/add next-h next-correction))]
(cond-> content
(and (= :line-to (:command cur-segment)) (some? prev-p))
(update index helpers/update-curve-to prev-p prev-h)
(and (= :line-to (:command next-segment)) (some? next-p))
(update next-i helpers/update-curve-to next-h next-p)
(and (= :curve-to (:command cur-segment)) (some? prev-p))
(update index update-handler :c2 prev-h)
(and (= :curve-to (:command next-segment)) (some? next-p))
(update next-i update-handler :c1 next-h))))]
(reduce add-curve content vectors))
(let [add-curve
(fn [content {:keys [index segment prev-p next-c next-i]}]
(cond-> content
(= :line-to (:command segment))
(update index #(line->curve prev-p %))
(= :curve-to (:command segment))
(update index #(line->curve prev-p %))
(= :line-to (:command next-c))
(update next-i #(line->curve point %))
(= :curve-to (:command next-c))
(update next-i #(line->curve point %))))]
(reduce add-curve content vectors)))))
(defn get-segments-with-points
"Given a content and a set of points return all the segments in the path
that uses the points"
[content points]
(let [point-set (set points)]
(loop [result (transient [])
prev-point nil
start-point nil
index 0
content (seq content)]
(if-let [{:keys [command] :as segment} (first content)]
(let [close-path? (= command :close-path)
move-to? (= command :move-to)
cur-point (if close-path?
start-point
(helpers/segment->point segment))
;; If there is a move-to we don't have a segment
prev-point (if move-to?
nil
prev-point)
;; We update the start point
start-point (if move-to?
cur-point
start-point)
result (cond-> result
(and (some? prev-point)
(contains? point-set prev-point)
(contains? point-set cur-point))
(conj! (-> segment
(assoc :start prev-point)
(assoc :end cur-point)
(assoc :index index))))]
(recur result
cur-point
start-point
(inc index)
(rest content)))
(persistent! result)))))
(defn split-segments
"Given a content creates splits commands between points with new segments"
[content points value]
(let [split-command
(fn [{:keys [command start end index] :as segment}]
(case command
:line-to [index (helpers/split-line-to start segment value)]
:curve-to [index (helpers/split-curve-to start segment value)]
:close-path [index [(helpers/make-line-to (gpt/lerp start end value)) segment]]
nil))
segment-changes
(->> (get-segments-with-points content points)
(into {} (keep split-command)))
process-segments
(fn [[index command]]
(if (contains? segment-changes index)
(get segment-changes index)
[command]))]
(into [] (mapcat process-segments) (d/enumerate content))))
;; FIXME: rename to next-segment
(defn next-node
"Calculates the next-node to be inserted."
[content position prev-point prev-handler]
(let [position (select-keys position [:x :y])
last-command (-> content last :command)
add-line? (and prev-point (not prev-handler) (not= last-command :close-path))
add-curve? (and prev-point prev-handler (not= last-command :close-path))]
(cond
add-line? {:command :line-to
:params position}
add-curve? {:command :curve-to
:params (helpers/make-curve-params position prev-handler)}
:else {:command :move-to
:params position})))
(defn remove-nodes
"Removes from content the points given. Will try to reconstruct the paths
to keep everything consistent"
[content points]
(if (empty? points)
content
(let [content (d/with-prev content)]
(loop [result []
last-handler nil
[cur-segment prev-segment] (first content)
content (rest content)]
(if (nil? cur-segment)
;; The result with be an array of arrays were every entry is a subpath
(->> result
;; remove empty and only 1 node subpaths
(filter #(> (count %) 1))
;; flatten array-of-arrays plain array
(flatten)
(into []))
(let [move? (= :move-to (:command cur-segment))
curve? (= :curve-to (:command cur-segment))
;; When the old command was a move we start a subpath
result (if move? (conj result []) result)
subpath (peek result)
point (helpers/segment->point cur-segment)
old-prev-point (helpers/segment->point prev-segment)
new-prev-point (helpers/segment->point (peek subpath))
remove? (contains? points point)
;; We store the first handler for the first curve to be removed to
;; use it for the first handler of the regenerated path
cur-handler (cond
(and (not last-handler) remove? curve?)
(select-keys (:params cur-segment) [:c1x :c1y])
(not remove?)
nil
:else
last-handler)
cur-segment (cond-> cur-segment
;; If we're starting a subpath and it's not a move make it a move
(and (not move?) (empty? subpath))
(assoc :command :move-to
:params (select-keys (:params cur-segment) [:x :y]))
;; If have a curve the first handler will be relative to the previous
;; point. We change the handler to the new previous point
(and curve? (seq subpath) (not= old-prev-point new-prev-point))
(update :params merge last-handler))
head-idx (dec (count result))
result (cond-> result
(not remove?)
(update head-idx conj cur-segment))]
(recur result
cur-handler
(first content)
(rest content))))))))
(defn join-nodes
"Creates new segments between points that weren't previously"
[content points]
(let [segments-set (into #{}
(map (juxt :start :end))
(get-segments-with-points content points))
create-line-command (fn [point other]
[(helpers/make-move-to point)
(helpers/make-line-to other)])
not-segment? (fn [point other] (and (not (contains? segments-set [point other]))
(not (contains? segments-set [other point]))))
new-content (->> (d/map-perm create-line-command not-segment? points)
(flatten)
(into []))]
(into content new-content)))
(defn separate-nodes
"Removes the segments between the points given"
[content points]
(let [content (d/with-prev content)]
(loop [result []
[cur-segment prev-segment] (first content)
content (rest content)]
(if (nil? cur-segment)
(->> result
(filter #(> (count %) 1))
(flatten)
(into []))
(let [prev-point (helpers/segment->point prev-segment)
cur-point (helpers/segment->point cur-segment)
cur-segment (cond-> cur-segment
(and (contains? points prev-point)
(contains? points cur-point))
(assoc :command :move-to
:params (select-keys (:params cur-segment) [:x :y])))
move? (= :move-to (:command cur-segment))
result (if move? (conj result []) result)
head-idx (dec (count result))
result (-> result
(update head-idx conj cur-segment))]
(recur result
(first content)
(rest content)))))))
(defn- add-to-set
"Given a list of sets adds the value to the target set"
[set-list target value]
(->> set-list
(mapv (fn [it]
(cond-> it
(= it target) (conj value))))))
(defn- join-sets
"Given a list of sets join two sets in the list into a new one"
[set-list target other]
(conj (->> set-list
(filterv #(and (not= % target)
(not= % other))))
(set/union target other)))
;; FIXME: revisit impl of this fn
(defn- group-segments [segments]
(loop [result []
{point-a :start point-b :end :as segment} (first segments)
segments (rest segments)]
(if (nil? segment)
result
(let [set-a (d/seek #(contains? % point-a) result)
set-b (d/seek #(contains? % point-b) result)
result (cond-> result
(and (nil? set-a) (nil? set-b))
(conj #{point-a point-b})
(and (some? set-a) (nil? set-b))
(add-to-set set-a point-b)
(and (nil? set-a) (some? set-b))
(add-to-set set-b point-a)
(and (some? set-a) (some? set-b) (not= set-a set-b))
(join-sets set-a set-b))]
(recur result
(first segments)
(rest segments))))))
(defn- calculate-merge-points [group-segments points]
(let [index-merge-point (fn [group] (vector group (gpt/center-points group)))
index-group (fn [point] (vector point (d/seek #(contains? % point) group-segments)))
group->merge-point (into {} (map index-merge-point) group-segments)
point->group (into {} (map index-group) points)]
(d/mapm #(group->merge-point %2) point->group)))
;; TODO: Improve the replace for curves
(defn- replace-points
"Replaces the points in a path for its merge-point"
[content point->merge-point]
(let [replace-command
(fn [segment]
(let [point (helpers/segment->point segment)]
(if (contains? point->merge-point point)
(let [merge-point (get point->merge-point point)]
(-> segment (update :params assoc :x (:x merge-point) :y (:y merge-point))))
segment)))]
(->> content
(mapv replace-command))))
(defn merge-nodes
"Reduces the contiguous segments in points to a single point"
[content points]
(let [segments (get-segments-with-points content points)]
(if (seq segments)
(let [point->merge-point (-> segments
(group-segments)
(calculate-merge-points points))]
(-> content
(separate-nodes points)
(replace-points point->merge-point)))
content)))
(defn transform-content
"Applies a transformation matrix over content and returns a new
content as PathData instance."
[content transform]
(if (some? transform)
(impl/-transform content transform)
content))
(defn move-content
"Applies a displacement over content and returns a new content as
PathData instance. Implemented in function of `transform-content`."
[content move-vec]
(let [transform (gmt/translate-matrix move-vec)]
(transform-content content transform)))
(defn calculate-extremities
"Calculate extremities for the provided content"
[content]
(loop [points (transient #{})
content (not-empty (vec content))
from-p nil
move-p nil]
(if content
(let [last-p (peek content)
content (if (= :move-to (:command last-p))
(pop content)
content)
segment (get content 0)
to-p (helpers/segment->point segment)]
(if segment
(case (:command segment)
:move-to
(recur (conj! points to-p)
(not-empty (subvec content 1))
to-p
to-p)
:close-path
(recur (conj! points move-p)
(not-empty (subvec content 1))
move-p
move-p)
:line-to
(recur (cond-> points
(and from-p to-p)
(-> (conj! move-p)
(conj! to-p)))
(not-empty (subvec content 1))
to-p
move-p)
:curve-to
(let [c1 (helpers/segment->point segment :c1)
c2 (helpers/segment->point segment :c2)]
(recur (if (and from-p to-p c1 c2)
(reduce conj!
(-> points (conj! from-p) (conj! to-p))
(helpers/calculate-curve-extremities from-p to-p c1 c2))
points)
(not-empty (subvec content 1))
to-p
move-p)))
(persistent! points)))
(persistent! points))))
(defn content->selrect
[content]
(let [extremities (calculate-extremities content)
;; We haven't found any extremes so we turn the commands to points
extremities
(if (empty? extremities)
(->> content (keep helpers/segment->point))
extremities)]
;; If no points are returned we return an empty rect.
(if (d/not-empty? extremities)
(grc/points->rect extremities)
(grc/make-rect))))
(defn content-center
[content]
(-> content
content->selrect
grc/rect->center))
(defn append-segment
[content segment]
(let [content (cond
(impl/path-data? content)
(vec content)
(nil? content)
[]
:else
content)]
(conj content (impl/check-segment segment))))
(defn points->content
"Given a vector of points generate a path content.
Mainly used for generate a path content from user drawing points
using curve drawing tool."
[points & {:keys [close]}]
(let [initial (first points)
point->params
(fn [point]
{:x (dm/get-prop point :x)
:y (dm/get-prop point :y)})]
(loop [points (rest points)
result [{:command :move-to
:params (point->params initial)}]]
(if-let [point (first points)]
(recur (rest points)
(conj result {:command :line-to
:params (point->params point)}))
(let [result (if close
(conj result {:command :close-path})
result)]
(impl/from-plain result))))))

189
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,34 @@
;;
;; Copyright (c) KALEIDOS INC
(ns app.common.svg.path.shapes-to-path
(ns app.common.types.path.shape-to-path
(:require
[app.common.colors :as clr]
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.files.helpers :as cfh]
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.geom.shapes.common :as gco]
[app.common.geom.shapes.corners :as gso]
[app.common.geom.shapes.path :as gsp]
[app.common.svg.path.bool :as pb]
[app.common.svg.path.command :as pc]
[app.common.types.path.bool :as bool]
[app.common.types.path.helpers :as helpers]
[app.common.types.path.impl :as path.impl]
[app.common.types.path.segment :as segm]
[app.common.types.shape.radius :as ctsr]))
(def ^:const bezier-circle-c 0.551915024494)
(def ^:const ^:private bezier-circle-c
0.551915024494)
(def dissoc-attrs
(def ^:private dissoc-attrs
[:x :y :width :height
:rx :ry :r1 :r2 :r3 :r4
:metadata])
(def allowed-transform-types
#{:rect
:circle
:image})
(defn without-position-attrs
[shape]
(d/without-keys shape dissoc-attrs))
(def style-group-properties
[:shadow
:blur])
(def style-properties
(into style-group-properties
[:fill-color
:fill-opacity
:fill-color-gradient
:fill-color-ref-file
:fill-color-ref-id
:fill-image
:fills
:stroke-color
:stroke-color-ref-file
:stroke-color-ref-id
:stroke-opacity
:stroke-style
:stroke-width
:stroke-alignment
:stroke-cap-start
:stroke-cap-end
:strokes]))
(def default-bool-fills [{:fill-color clr/black}])
(defn make-corner-arc
(defn- make-corner-arc
"Creates a curvle corner for border radius"
[from to corner radius]
(let [x (case corner
@ -91,9 +67,9 @@
:bottom-right (assoc to :x c2x)
:bottom-left (assoc to :y c2y))]
(pc/make-curve-to to h1 h2)))
(helpers/make-curve-to to h1 h2)))
(defn circle->path
(defn- circle->path
"Creates the bezier curves to approximate a circle shape"
[{:keys [x y width height]}]
(let [mx (+ x (/ width 2))
@ -112,13 +88,13 @@
c1y (+ y (* (/ height 2) (- 1 c)))
c2y (+ y (* (/ height 2) (+ 1 c)))]
[(pc/make-move-to p1)
(pc/make-curve-to p2 (assoc p1 :x c2x) (assoc p2 :y c1y))
(pc/make-curve-to p3 (assoc p2 :y c2y) (assoc p3 :x c2x))
(pc/make-curve-to p4 (assoc p3 :x c1x) (assoc p4 :y c2y))
(pc/make-curve-to p1 (assoc p4 :y c1y) (assoc p1 :x c1x))]))
[(helpers/make-move-to p1)
(helpers/make-curve-to p2 (assoc p1 :x c2x) (assoc p2 :y c1y))
(helpers/make-curve-to p3 (assoc p2 :y c2y) (assoc p3 :x c2x))
(helpers/make-curve-to p4 (assoc p3 :x c1x) (assoc p4 :y c2y))
(helpers/make-curve-to p1 (assoc p4 :y c1y) (assoc p1 :x c1x))]))
(defn draw-rounded-rect-path
(defn- draw-rounded-rect-path
([x y width height r]
(draw-rounded-rect-path x y width height r r r r))
@ -135,21 +111,21 @@
p7 (gpt/point (+ x r4) (+ height y))
p8 (gpt/point x (+ height y (- r4)))]
(-> []
(conj (pc/make-move-to p1))
(conj (helpers/make-move-to p1))
(cond-> (not= p1 p2)
(conj (make-corner-arc p1 p2 :top-left r1)))
(conj (pc/make-line-to p3))
(conj (helpers/make-line-to p3))
(cond-> (not= p3 p4)
(conj (make-corner-arc p3 p4 :top-right r2)))
(conj (pc/make-line-to p5))
(conj (helpers/make-line-to p5))
(cond-> (not= p5 p6)
(conj (make-corner-arc p5 p6 :bottom-right r3)))
(conj (pc/make-line-to p7))
(conj (helpers/make-line-to p7))
(cond-> (not= p7 p8)
(conj (make-corner-arc p7 p8 :bottom-left r4)))
(conj (pc/make-line-to p1))))))
(conj (helpers/make-line-to p1))))))
(defn rect->path
(defn- rect->path
"Creates a bezier curve that approximates a rounded corner rectangle"
[{:keys [x y width height] :as shape}]
(case (ctsr/radius-mode shape)
@ -165,7 +141,10 @@
(declare convert-to-path)
(defn fix-first-relative
;; FIXME: this looks unnecesary because penpot already normalizes all
;; path content to be absolute. There are no relative segments on
;; penpot.
(defn- fix-first-relative
"Fix an issue with the simplify commands not changing the first relative"
[content]
(let [head (first content)]
@ -173,17 +152,19 @@
(and head (:relative head))
(update 0 assoc :relative false))))
(defn group-to-path
(defn- group-to-path
[group objects]
(let [xform (comp (map #(get objects %))
(map #(-> (convert-to-path % objects))))
(let [xform (comp (map (d/getf objects))
(map #(convert-to-path % objects)))
child-as-paths (into [] xform (:shapes group))
head (last child-as-paths)
head-data (select-keys head style-properties)
head (peek child-as-paths)
head-data (select-keys head bool/style-properties)
content (into []
(comp (filter #(= :path (:type %)))
(mapcat #(fix-first-relative (:content %))))
(comp (filter cfh/path-shape?)
(map :content)
(map vec)
(mapcat fix-first-relative))
child-as-paths)]
(-> group
(assoc :type :path)
@ -191,54 +172,68 @@
(merge head-data)
(d/without-keys dissoc-attrs))))
(defn bool-to-path
(defn- bool-to-path
[shape objects]
(let [children (->> (:shapes shape)
(map #(get objects %))
(map #(convert-to-path % objects)))
bool-type (:bool-type shape)
content (pb/content-bool bool-type (mapv :content children))]
(let [children
(->> (:shapes shape)
(map (d/getf objects))
(map #(convert-to-path % objects)))
bool-type
(:bool-type shape)
content
(bool/calculate-content bool-type (map :content children))]
(-> shape
(assoc :type :path)
(assoc :content content)
(dissoc :bool-type)
(d/without-keys dissoc-attrs))))
(defn convert-to-path
"Transforms the given shape to a path"
([shape]
(convert-to-path shape {}))
([{:keys [type metadata] :as shape} objects]
(assert (map? objects))
(case type
(:group :frame)
(group-to-path shape objects)
"Transforms the given shape to a path shape"
[shape objects]
(assert (map? objects))
;; FIXME: add check-objects-like
;; FIXME: add check-shape ?
:bool
(bool-to-path shape objects)
(let [type (dm/get-prop shape :type)]
(:rect :circle :image :text)
(let [new-content
(case type
:circle (circle->path shape)
#_:else (rect->path shape))
(case type
(:group :frame)
(group-to-path shape objects)
;; Apply the transforms that had the shape
transform
(cond-> (:transform shape (gmt/matrix))
(:flip-x shape) (gmt/scale (gpt/point -1 1))
(:flip-y shape) (gmt/scale (gpt/point 1 -1)))
:bool
(bool-to-path shape objects)
new-content (cond-> new-content
(some? transform)
(gsp/transform-content (gmt/transform-in (gco/shape->center shape) transform)))]
(:rect :circle :image :text)
(let [content
(if (= type :circle)
(circle->path shape)
(rect->path shape))
(-> shape
(assoc :type :path)
(assoc :content new-content)
(cond-> (= :image type)
(assoc :fill-image metadata))
(d/without-keys dissoc-attrs)))
content
(path.impl/from-plain content)
;; For the rest return the plain shape
shape)))
;; Apply the transforms that had the shape
transform
(cond-> (:transform shape (gmt/matrix))
(:flip-x shape) (gmt/scale (gpt/point -1 1))
(:flip-y shape) (gmt/scale (gpt/point 1 -1)))
content
(cond-> content
(some? transform)
(segm/transform-content (gmt/transform-in (gco/shape->center shape) transform)))]
(-> shape
(assoc :type :path)
(assoc :content content)
(cond-> (= :image type)
(assoc :fill-image (get shape :metadata)))
(d/without-keys dissoc-attrs)))
;; For the rest return the plain shape
shape)))

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/segment->point command)]
(make-subpath p p [command])))
([from to data]
{:from from
@ -29,9 +29,9 @@
"Adds a command to the subpath"
[subpath command]
(let [command (if (= :close-path (:command command))
(upc/make-line-to (:from subpath))
(helpers/make-line-to (:from subpath))
command)
p (upc/command->point command)]
p (helpers/segment->point command)]
(-> subpath
(assoc :to p)
(update :data conj command))))
@ -62,7 +62,7 @@
result))
new-data (->> subpath :data d/with-prev reverse
(reduce reverse-commands [(upc/make-move-to (:to subpath))]))]
(reduce reverse-commands [(helpers/make-move-to (:to subpath))]))]
(make-subpath (:to subpath) (:from subpath) new-data)))
@ -125,6 +125,9 @@
(defn is-closed? [subpath]
(pt= (:from subpath) (:to subpath)))
(def ^:private xf-mapcat-data
(mapcat :data))
(defn close-subpaths
"Searches a path for possible subpaths that can create closed loops and merge them"
[content]
@ -153,20 +156,17 @@
new-subpaths)))
result))]
(->> closed-subpaths
(mapcat :data)
(into []))))
(into [] xf-mapcat-data closed-subpaths)))
;; FIXME: revisit this fn impl for perfromance
(defn reverse-content
"Given a content reverse the order of the commands"
[content]
(->> content
(get-subpaths)
(->> (get-subpaths content)
(mapv reverse-subpath)
(reverse)
(mapcat :data)
(into [])))
(into [] xf-mapcat-data)))
;; https://mathworld.wolfram.com/PolygonArea.html
(defn clockwise?
@ -181,10 +181,10 @@
(if (nil? current)
(> signed-area 0)
(let [{x1 :x y1 :y :as p} (upc/command->point current)
(let [{x1 :x y1 :y :as p} (helpers/segment->point current)
last? (nil? (first subpath))
first-point (if (nil? first-point) p first-point)
{x2 :x y2 :y} (if last? first-point (upc/command->point (first subpath)))
{x2 :x y2 :y} (if last? first-point (helpers/segment->point (first subpath)))
signed-area (+ signed-area (- (* x1 y2) (* x2 y1)))]
(recur (first subpath)

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

431
common/src/app/common/types/shape/path.cljc
View File

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

29
common/src/app/common/weak_map.cljs Normal file
View File

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

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

380
common/test/common_tests/types/path_data_test.cljc Normal file
View File

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

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

59
common/test/common_tests/types/shape_path_data_test.cljc
View File

@ -1,59 +0,0 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS INC
(ns common-tests.types.shape-path-data-test
(:require
[app.common.data :as d]
[app.common.math :as mth]
[app.common.pprint :as pp]
[app.common.types.shape.path :as path]
[clojure.test :as t]))
(def sample-content
[{:command :move-to, :params {:x 480.0, :y 839.0}}
{:command :line-to, :params {:x 439.0, :y 802.0}}
{:command :curve-to, :params {:c1x 368.0, :c1y 737.0, :c2x 310.0, :c2y 681.0, :x 264.0, :y 634.0}}
{:command :close-path :params {}}])
(def sample-bytes
[0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 67 -16 0 0 68 81 -64 0
0 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 67 -37 -128 0 68 72 -128 0
0 3 0 0 67 -72 0 0 68 56 64 0 67 -101 0 0 68 42 64 0 67 -124 0 0 68 30 -128 0
0 4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0])
;; This means it implements IReduceInit/IReduce protocols
(t/deftest path-data-to-vector
(let [pdata (path/path-data sample-content)
result (vec pdata)]
(t/is (= 4 (count result)))
(t/is (= (get-in sample-content [0 :command])
(get-in result [0 :command])))
(t/is (= (get-in sample-content [1 :command])
(get-in result [1 :command])))
(t/is (= (get-in sample-content [2 :command])
(get-in result [2 :command])))
(t/is (= (get-in sample-content [3 :command])
(get-in result [3 :command])))
(t/is (= (get-in sample-content [0 :params])
(get-in result [0 :params])))
(t/is (= (get-in sample-content [1 :params])
(get-in result [1 :params])))
(t/is (= (get-in sample-content [2 :params])
(get-in result [2 :params])))
(t/is (= (get-in sample-content [3 :params])
(get-in result [3 :params])))))
(t/deftest path-data-plain-to-binary
(let [pdata (path/path-data sample-content)]
(t/is (= sample-bytes
(vec
#?(:cljs (js/Int8Array. (.-buffer pdata))
:clj (.array (.-buffer pdata))))))
(t/is (= (->> sample-content
(mapv path/map->PathSegment))
(vec pdata)))))

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","~bAQAAAAAAAAAAAAAAAAAAAAAAAAAAIIxEAIAKRAIAAAAAAAAAAAAAAAAAAAAAAAAAAKCZRAAA5UMDAAAAAKCZRAAA5UMAAKVEAAD2QwDgokQAgAFEAwAAAADAoEQAAAhEAECdRAAAD0QAYJhEAAASRAMAAAAAgJNEAAAVRAAgjEQAgApEACCMRACACkQ="],
"~: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))

42
frontend/src/app/main/data/workspace.cljs
View File

@ -975,9 +975,29 @@
ptk/WatchEvent
(watch [_ state _]
(let [selected (dsh/lookup-selected state)
objects (dsh/lookup-page-objects state)]
objects (dsh/lookup-page-objects state)]
(if (> (count selected) 1)
(condp = (count selected)
0 (rx/empty)
1 (let [{:keys [id type] :as shape} (get objects (first selected))]
(case type
:text
(rx/of (dwe/start-edition-mode id))
(:group :bool :frame)
(let [shapes-ids (into (d/ordered-set) (get shape :shapes))]
(rx/of (dws/select-shapes shapes-ids)))
:svg-raw
nil
(rx/of (dwe/start-edition-mode id)
(dwdp/start-path-edit id))))
;; When we have multiple shapes selected, instead of enter
;; on the edition mode, we proceed to select all children of
;; the selected shapes. Because we can't enter on edition
;; mode on multiple shapes and this is a fallback operation.
(let [shapes-to-select
(->> selected
(reduce
@ -987,23 +1007,7 @@
(conj result shape-id)
(into result children))))
(d/ordered-set)))]
(rx/of (dws/select-shapes shapes-to-select)))
(when (d/not-empty? selected)
(let [{:keys [id type shapes]} (get objects (first selected))]
(case type
:text
(rx/of (dwe/start-edition-mode id))
(:group :bool :frame)
(let [shapes-ids (into (d/ordered-set) shapes)]
(rx/of (dws/select-shapes shapes-ids)))
:svg-raw
nil
(rx/of (dwe/start-edition-mode id)
(dwdp/start-path-edit id))))))))))
(rx/of (dws/select-shapes shapes-to-select))))))))
(defn select-parent-layer
[]

192
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]
@ -24,130 +25,139 @@
[cuerdas.core :as str]
[potok.v2.core :as ptk]))
(defn selected-shapes-idx
[state]
(let [objects (dsh/lookup-page-objects state)]
(->> (dsh/lookup-selected state)
(cph/clean-loops objects))))
(defn- create-bool-shape
[id type name shapes objects]
(let [shape-id
(or id (uuid/next))
(defn create-bool-data
[bool-type name shapes objects]
(let [shapes (mapv #(stp/convert-to-path % objects) shapes)
head (if (= bool-type :difference) (first shapes) (last shapes))
head (cond-> head
(and (contains? head :svg-attrs) (empty? (:fills head)))
(assoc :fills stp/default-bool-fills))
shapes
(mapv #(path/convert-to-path % objects) shapes)
head-data (select-keys head stp/style-properties)
head
(if (= type :difference) (first shapes) (last shapes))
bool-shape
(-> {:id (uuid/next)
:type :bool
:bool-type bool-type
:frame-id (:frame-id head)
:parent-id (:parent-id head)
:name name
:shapes (->> shapes (mapv :id))}
(merge head-data)
head
(cond-> head
(and (contains? head :svg-attrs) (empty? (:fills head)))
(assoc :fills bool/default-fills))
shape
{:id shape-id
:type :bool
:bool-type type
:frame-id (:frame-id head)
:parent-id (:parent-id head)
:name name
:shapes (mapv :id shapes)}
shape
(-> shape
(merge (select-keys head bool/style-properties))
(cts/setup-shape)
(gsh/update-bool-selrect shapes objects))]
(gsh/update-bool shapes objects))]
[bool-shape (cph/get-position-on-parent objects (:id head))]))
[shape (cph/get-position-on-parent objects (:id head))]))
(defn create-bool
[type & {:keys [ids force-shape-id]}]
(assert (or (nil? ids) (every? uuid? ids)))
(ptk/reify ::create-bool-union
ptk/WatchEvent
(watch [it state _]
(let [page-id (:current-page-id state)
objects (dsh/lookup-page-objects state page-id)
name
(-> type d/name str/capital)
ids
(->> (or ids (dsh/lookup-selected state))
(cph/clean-loops objects))
xform
(comp
(map (d/getf objects))
(remove cph/frame-shape?)
(remove ctc/is-variant?)
(remove #(ctn/has-any-copy-parent? objects %)))
shapes
(->> (cph/order-by-indexed-shapes objects ids)
(into [] xform)
(not-empty))]
(when shapes
(let [[shape index]
(create-bool-shape force-shape-id type name (reverse shapes) objects)
shape-id
(get shape :id)
changes
(-> (pcb/empty-changes it page-id)
(pcb/with-objects objects)
(pcb/add-object shape {:index (inc index)})
(pcb/update-shapes (map :id shapes) ctl/remove-layout-item-data)
(pcb/change-parent shape-id shapes))]
(rx/of (dch/commit-changes changes)
(dws/select-shapes (d/ordered-set shape-id)))))))))
(defn group->bool
[group bool-type objects]
[type group objects]
(let [shapes (->> (:shapes group)
(map #(get objects %))
(mapv #(stp/convert-to-path % objects)))
head (if (= bool-type :difference) (first shapes) (last shapes))
(mapv #(path/convert-to-path % objects)))
head (if (= type :difference) (first shapes) (last shapes))
head (cond-> head
(and (contains? head :svg-attrs) (empty? (:fills head)))
(assoc :fills stp/default-bool-fills))
head-data (select-keys head stp/style-properties)]
(assoc :fills bool/default-fills))
head-data (select-keys head bool/style-properties)]
(-> group
(assoc :type :bool)
(assoc :bool-type bool-type)
(assoc :bool-type type)
(merge head-data)
(gsh/update-bool-selrect shapes objects))))
(defn bool->group
[shape objects]
(let [children (->> (:shapes shape)
(mapv #(get objects %)))]
(-> shape
(assoc :type :group)
(dissoc :bool-type)
(d/without-keys stp/style-group-properties)
(gsh/update-group-selrect children))))
(defn create-bool
([bool-type]
(create-bool bool-type nil nil))
([bool-type ids {:keys [id-ret]}]
(assert (or (nil? ids) (set? ids)))
(ptk/reify ::create-bool-union
ptk/WatchEvent
(watch [it state _]
(let [page-id (:current-page-id state)
objects (dsh/lookup-page-objects state)
name (-> bool-type d/name str/capital)
ids (->> (or ids (dsh/lookup-selected state))
(cph/clean-loops objects))
ordered-indexes (cph/order-by-indexed-shapes objects ids)
shapes (->> ordered-indexes
(map (d/getf objects))
(remove cph/frame-shape?)
(remove ctc/is-variant?)
(remove #(ctn/has-any-copy-parent? objects %)))]
(when-not (empty? shapes)
(let [[boolean-data index] (create-bool-data bool-type name (reverse shapes) objects)
index (inc index)
shape-id (:id boolean-data)
changes (-> (pcb/empty-changes it page-id)
(pcb/with-objects objects)
(pcb/add-object boolean-data {:index index})
(pcb/update-shapes (map :id shapes) ctl/remove-layout-item-data)
(pcb/change-parent shape-id shapes))]
(when id-ret
(reset! id-ret shape-id))
(rx/of (dch/commit-changes changes)
(dws/select-shapes (d/ordered-set shape-id))))))))))
(gsh/update-bool shapes objects))))
(defn group-to-bool
[shape-id bool-type]
[shape-id type]
(ptk/reify ::group-to-bool
ptk/WatchEvent
(watch [_ state _]
(let [objects (dsh/lookup-page-objects state)
change-to-bool
(fn [shape] (group->bool shape bool-type objects))]
(let [objects (dsh/lookup-page-objects state)
update-fn (partial group->bool type)]
(when-not (ctn/has-any-copy-parent? objects (get objects shape-id))
(rx/of (dwsh/update-shapes [shape-id] change-to-bool {:reg-objects? true})))))))
(rx/of (dwsh/update-shapes [shape-id] update-fn {:with-objects? true :reg-objects? true})))))))
(defn- bool->group
[shape objects]
(-> shape
(assoc :type :group)
(dissoc :bool-type)
(d/without-keys bool/style-group-properties)
(gsh/update-group-selrect
(mapv (d/getf objects)
(:shapes shape)))))
(defn bool-to-group
[shape-id]
(ptk/reify ::bool-to-group
ptk/WatchEvent
(watch [_ state _]
(let [objects (dsh/lookup-page-objects state)
change-to-group
(fn [shape] (bool->group shape objects))]
(let [objects (dsh/lookup-page-objects state)]
(when-not (ctn/has-any-copy-parent? objects (get objects shape-id))
(rx/of (dwsh/update-shapes [shape-id] change-to-group {:reg-objects? true})))))))
(rx/of (dwsh/update-shapes [shape-id] bool->group {:with-objects? true :reg-objects? true})))))))
(defn change-bool-type
[shape-id bool-type]
[shape-id type]
(ptk/reify ::change-bool-type
ptk/WatchEvent
(watch [_ state _]
(let [objects (dsh/lookup-page-objects state)
change-type
(fn [shape] (assoc shape :bool-type bool-type))]
(fn [shape] (assoc shape :bool-type type))]
(when-not (ctn/has-any-copy-parent? objects (get objects shape-id))
(rx/of (dwsh/update-shapes [shape-id] change-type {:reg-objects? true})))))))

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

90
frontend/src/app/main/data/workspace/drawing/curve.cljs
View File

@ -7,13 +7,11 @@
(ns app.main.data.workspace.drawing.curve
(:require
[app.common.data.macros :as dm]
[app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.geom.shapes :as gsh]
[app.common.geom.shapes.flex-layout :as gslf]
[app.common.geom.shapes.grid-layout :as gslg]
[app.common.geom.shapes.path :as gsp]
[app.common.types.container :as ctn]
[app.common.types.path.segment :as path.segment]
[app.common.types.shape :as cts]
[app.common.types.shape-tree :as ctst]
[app.common.types.shape.layout :as ctl]
@ -26,7 +24,37 @@
[beicon.v2.core :as rx]
[potok.v2.core :as ptk]))
(def simplify-tolerance 0.3)
(def ^:const simplify-tolerance 0.3)
(defn- setup-frame
[]
(ptk/reify ::setup-frame
ptk/UpdateEvent
(update [_ state]
(let [objects (dsh/lookup-page-objects state)
content (dm/get-in state [:workspace-drawing :object :content])
position (path.segment/get-handler-point content 0 nil)
frame-id (->> (ctst/top-nested-frame objects position)
(ctn/get-first-not-copy-parent objects) ;; We don't want to change the structure of component copies
:id)
flex-layout? (ctl/flex-layout? objects frame-id)
grid-layout? (ctl/grid-layout? objects frame-id)
drop-index (when flex-layout? (gslf/get-drop-index frame-id objects position))
drop-cell (when grid-layout? (gslg/get-drop-cell frame-id objects position))]
(update-in state [:workspace-drawing :object]
(fn [object]
(-> object
(assoc :frame-id frame-id)
(assoc :parent-id frame-id)
;; FIXME: with-meta twice only one wins
(cond-> (some? drop-index)
(with-meta {:index drop-index}))
(cond-> (some? drop-cell)
(with-meta {:cell drop-cell})))))))))
(defn- insert-point
[point]
@ -35,43 +63,16 @@
(update [_ state]
(update-in state [:workspace-drawing :object]
(fn [object]
(let [segments (-> (:segments object)
(conj point))
content (gsp/segments->content segments)
selrect (gsh/content->selrect content)
points (grc/rect->points selrect)]
(let [points (-> (::points object)
(conj point))
content (path.segment/points->content points)
selrect (path.segment/content->selrect content)
points' (grc/rect->points selrect)]
(-> object
(assoc :segments segments)
(assoc ::points points)
(assoc :content content)
(assoc :selrect selrect)
(assoc :points points))))))))
(defn- setup-frame
[]
(ptk/reify ::setup-frame
ptk/UpdateEvent
(update [_ state]
(let [objects (dsh/lookup-page-objects state)
content (dm/get-in state [:workspace-drawing :object :content] [])
start (dm/get-in content [0 :params] nil)
position (when start (gpt/point start))
frame-id (->> (ctst/top-nested-frame objects position)
(ctn/get-first-not-copy-parent objects) ;; We don't want to change the structure of component copies
:id)
flex-layout? (ctl/flex-layout? objects frame-id)
grid-layout? (ctl/grid-layout? objects frame-id)
drop-index (when flex-layout? (gslf/get-drop-index frame-id objects position))
drop-cell (when grid-layout? (gslg/get-drop-cell frame-id objects position))]
(update-in state [:workspace-drawing :object]
(fn [object]
(-> object
(assoc :frame-id frame-id)
(assoc :parent-id frame-id)
(cond-> (some? drop-index)
(with-meta {:index drop-index}))
(cond-> (some? drop-cell)
(with-meta {:cell drop-cell})))))))))
(assoc :points points'))))))))
(defn finish-drawing
[]
@ -79,13 +80,14 @@
ptk/UpdateEvent
(update [_ state]
(update-in state [:workspace-drawing :object]
(fn [{:keys [segments] :as shape}]
(let [segments (ups/simplify segments simplify-tolerance)
content (gsp/segments->content segments)
selrect (gsh/content->selrect content)
(fn [{:keys [::points] :as shape}]
(let [points (ups/simplify points simplify-tolerance)
content (path.segment/points->content points)
selrect (path.segment/content->selrect content)
points (grc/rect->points selrect)]
(-> shape
(dissoc :segments)
(dissoc ::points)
(assoc :content content)
(assoc :selrect selrect)
(assoc :points points)
@ -105,7 +107,7 @@
:initialized? true
:frame-id uuid/zero
:parent-id uuid/zero
:segments []})]
::points []})]
(rx/concat
(rx/of #(update % :workspace-drawing assoc :object shape))
(->> mouse

8
frontend/src/app/main/data/workspace/edition.cljs
View File

@ -6,7 +6,6 @@
(ns app.main.data.workspace.edition
(:require
[app.common.data.macros :as dm]
[app.main.data.helpers :as dsh]
[app.main.data.workspace.path.common :as dwpc]
[beicon.v2.core :as rx]
@ -17,8 +16,10 @@
(declare clear-edition-mode)
(defn start-edition-mode
"Mark a shape in edition mode"
[id]
(dm/assert! (uuid? id))
(assert (uuid? id) "expected valid uuid for `id`")
(ptk/reify ::start-edition-mode
ptk/UpdateEvent
(update [_ state]
@ -26,8 +27,7 @@
;; Can only edit objects that exist
(if (contains? objects id)
(-> state
(assoc-in [:workspace-local :selected] #{id})
(assoc-in [:workspace-local :edition] id)
(update :workspace-local assoc :edition id)
(dissoc :workspace-grid-edition))
state)))

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.helpers/segment->point (nth content (dec index))))
old-handler (upc/handler->point content index prefix)
old-handler (path.segment/get-handler-point content index prefix)
handler-position (cond-> (gpt/point x y)
shift? (helpers/position-fixed-angle position))
shift? (path.helpers/position-fixed-angle position))
{dx :x dy :y} (if (some? old-handler)
(gpt/add (gpt/to-vec old-handler position)
@ -102,7 +103,7 @@
modifiers (get-in state [:workspace-local :edit-path id :content-modifiers])
content (-> (st/get-path state :content)
(upc/apply-content-modifiers modifiers))
(path/apply-content-modifiers modifiers))
handler (get-in state [:workspace-local :edit-path id :drag-handler])]
(-> state
@ -110,7 +111,7 @@
(update-in [:workspace-local :edit-path id] dissoc :drag-handler)
(update-in [:workspace-local :edit-path id] dissoc :content-modifiers)
(assoc-in [:workspace-local :edit-path id :prev-handler] handler)
(update-in (st/get-path-location state) helpers/update-selrect))))
(update-in (st/get-path-location state) path/update-geometry))))
ptk/WatchEvent
(watch [_ state _]
@ -128,7 +129,7 @@
ptk/WatchEvent
(watch [_ state stream]
(let [content (st/get-path state :content)
handlers (-> (upc/content->handlers content)
handlers (-> (path.segment/get-handlers content)
(get position))
[idx prefix] (when (= (count handlers) 1)
@ -254,7 +255,12 @@
(update [_ state]
(let [objects (dsh/lookup-page-objects state)
content (get-in state [:workspace-drawing :object :content] [])
position (gpt/point (get-in content [0 :params] nil))
;; FIXME: use native operation for retrieve the first position
position (-> (nth content 0)
(get :params)
(gpt/point))
frame-id (->> (ctst/top-nested-frame objects position)
(ctn/get-first-not-copy-parent objects) ;; We don't want to change the structure of component copies
:id)
@ -274,11 +280,10 @@
(ptk/reify ::handle-new-shape-result
ptk/UpdateEvent
(update [_ state]
(let [content (get-in state [:workspace-drawing :object :content] [])]
(let [content (dm/get-in state [:workspace-drawing :object :content])]
(dm/assert!
"expected valid path content"
(check-path-content! content))
(assert (path/check-path-content content)
"expected valid path content instance")
(if (> (count content) 1)
(assoc-in state [:workspace-drawing :object :initialized?] true)
@ -286,8 +291,8 @@
ptk/WatchEvent
(watch [_ state _]
(let [content (get-in state [:workspace-drawing :object :content] [])]
(if (and (seq content) (> (count content) 1))
(when-let [content (dm/get-in state [:workspace-drawing :object :content])]
(if (> (count content) 1)
(rx/of (setup-frame)
(dwdc/handle-finish-drawing)
(dwe/start-edition-mode shape-id)
@ -300,9 +305,8 @@
(ptk/reify ::handle-new-shape
ptk/UpdateEvent
(update [_ state]
(let [shape (cts/setup-shape {:type :path})]
(-> state
(update :workspace-drawing assoc :object shape))))
(let [shape (cts/setup-shape {:type :path :content (path/content nil)})]
(update state :workspace-drawing assoc :object shape)))
ptk/WatchEvent
(watch [_ state stream]
@ -334,12 +338,12 @@
edit-mode (get-in state [:workspace-local :edit-path id :edit-mode])]
(if (= :draw edit-mode)
(rx/concat
(rx/of (dwsh/update-shapes [id] upsp/convert-to-path))
(rx/of (dwsh/update-shapes [id] path/convert-to-path))
(rx/of (handle-drawing id))
(->> stream
(rx/filter (ptk/type? ::common/finish-path))
(rx/take 1)
(rx/merge-map #(rx/of (check-changed-content)))))
(rx/map check-changed-content)))
(rx/empty))))))
(defn check-changed-content []

98
frontend/src/app/main/data/workspace/path/edition.cljs
View File

@ -10,15 +10,13 @@
[app.common.data.macros :as dm]
[app.common.files.helpers :as cfh]
[app.common.geom.point :as gpt]
[app.common.geom.shapes.path :as upg]
[app.common.svg.path.command :as upc]
[app.common.svg.path.shapes-to-path :as upsp]
[app.common.svg.path.subpath :as ups]
[app.common.types.path :as path]
[app.common.types.path.helpers :as path.helpers]
[app.common.types.path.segment :as path.segment]
[app.main.data.changes :as dch]
[app.main.data.helpers :as dsh]
[app.main.data.workspace.edition :as dwe]
[app.main.data.workspace.path.changes :as changes]
[app.main.data.workspace.path.drawing :as drawing]
[app.main.data.workspace.path.helpers :as helpers]
[app.main.data.workspace.path.selection :as selection]
[app.main.data.workspace.path.state :as st]
@ -27,7 +25,6 @@
[app.main.data.workspace.shapes :as dwsh]
[app.main.streams :as ms]
[app.util.mouse :as mse]
[app.util.path.tools :as upt]
[beicon.v2.core :as rx]
[potok.v2.core :as ptk]))
@ -50,18 +47,22 @@
(ptk/reify ::apply-content-modifiers
ptk/WatchEvent
(watch [it state _]
(let [objects (dsh/lookup-page-objects state)
(let [page-id (get state :current-page-id state)
objects (dsh/lookup-page-objects state)
id (st/get-path-id state)
page-id (:current-page-id state)
shape (st/get-path state)
content-modifiers (dm/get-in state [:workspace-local :edit-path id :content-modifiers])
content (:content shape)
new-content (upc/apply-content-modifiers content content-modifiers)
shape
(st/get-path state)
old-points (->> content upg/content->points)
new-points (->> new-content upg/content->points)
content-modifiers
(dm/get-in state [:workspace-local :edit-path id :content-modifiers])
content (get shape :content)
new-content (path/apply-content-modifiers content content-modifiers)
old-points (path.segment/get-points content)
new-points (path.segment/get-points new-content)
point-change (->> (map hash-map old-points new-points) (reduce merge))]
(when (and (some? new-content) (some? shape))
@ -75,8 +76,8 @@
(defn modify-content-point
[content {dx :x dy :y} modifiers point]
(let [point-indices (upc/point-indices content point) ;; [indices]
handler-indices (upc/handler-indices content point) ;; [[index prefix]]
(let [point-indices (path.segment/point-indices content point) ;; [indices]
handler-indices (path.segment/handler-indices content point) ;; [[index prefix]]
modify-point
(fn [modifiers index]
@ -116,7 +117,7 @@
(let [id (st/get-path-id state)
content (st/get-path state :content)
to-point (cond-> to-point
(:shift? to-point) (helpers/position-fixed-angle from-point))
(:shift? to-point) (path.helpers/position-fixed-angle from-point))
delta (gpt/subtract to-point from-point)
@ -144,7 +145,7 @@
selected? (contains? selected-points position)]
(streams/drag-stream
(rx/of
(dwsh/update-shapes [id] upsp/convert-to-path)
(dwsh/update-shapes [id] path/convert-to-path)
(when-not selected? (selection/select-node position shift?))
(drag-selected-points @ms/mouse-position))
(rx/of (selection/select-node position shift?)))))))
@ -163,7 +164,7 @@
start-position (apply min-key #(gpt/distance start-position %) selected-points)
content (st/get-path state :content)
points (upg/content->points content)]
points (path.segment/get-points content)]
(rx/concat
;; This stream checks the consecutive mouse positions to do the dragging
@ -228,7 +229,7 @@
mov-vec (gpt/multiply (get-displacement direction) scale)]
(rx/concat
(rx/of (dwsh/update-shapes [id] upsp/convert-to-path))
(rx/of (dwsh/update-shapes [id] path/convert-to-path))
(rx/merge
(->> move-events
(rx/take-until stopper)
@ -256,22 +257,22 @@
start-delta-y (dm/get-in modifiers [index cy] 0)
content (st/get-path state :content)
points (upg/content->points content)
points (path.segment/get-points content)
point (-> content (get (if (= prefix :c1) (dec index) index)) (upc/command->point))
handler (-> content (get index) (upc/get-handler prefix))
point (-> content (nth (if (= prefix :c1) (dec index) index)) (path.helpers/segment->point))
handler (-> content (nth index) (path.segment/get-handler prefix))
[op-idx op-prefix] (upc/opposite-index content index prefix)
opposite (upc/handler->point content op-idx op-prefix)]
[op-idx op-prefix] (path.segment/opposite-index content index prefix)
opposite (path.segment/get-handler-point content op-idx op-prefix)]
(streams/drag-stream
(rx/concat
(rx/of (dwsh/update-shapes [id] upsp/convert-to-path))
(rx/of (dwsh/update-shapes [id] path/convert-to-path))
(->> (streams/move-handler-stream handler point handler opposite points)
(rx/map
(fn [{:keys [x y alt? shift?]}]
(let [pos (cond-> (gpt/point x y)
shift? (helpers/position-fixed-angle point))]
shift? (path.helpers/position-fixed-angle point))]
(modify-handler
id
index
@ -294,33 +295,34 @@
(ptk/reify ::start-path-edit
ptk/UpdateEvent
(update [_ state]
(let [objects (dsh/lookup-page-objects state)
(let [objects (dsh/lookup-page-objects state)
edit-path (dm/get-in state [:workspace-local :edit-path id])
content (st/get-path state :content)
state (cond-> state
(cfh/path-shape? objects id)
(st/set-content (ups/close-subpaths content)))]
content (st/get-path state :content)
state (cond-> state
(cfh/path-shape? objects id)
(st/set-content (path/close-subpaths content)))]
(cond-> state
(or (not edit-path) (= :draw (:edit-mode edit-path)))
(or (not edit-path)
(= :draw (:edit-mode edit-path)))
(assoc-in [:workspace-local :edit-path id] {:edit-mode :move
:selected #{}
:snap-toggled false})
(and (some? edit-path) (= :move (:edit-mode edit-path)))
(and (some? edit-path)
(= :move (:edit-mode edit-path)))
(assoc-in [:workspace-local :edit-path id :edit-mode] :draw))))
ptk/WatchEvent
(watch [_ state stream]
(let [mode (dm/get-in state [:workspace-local :edit-path id :edit-mode])
stopper (->> stream
(rx/filter #(or
(= (ptk/type %) ::dwe/clear-edition-mode)
(= (ptk/type %) ::start-path-edit))))
interrupt (->> stream (rx/filter #(= % :interrupt)) (rx/take 1))]
(watch [_ _ stream]
(let [stopper (->> stream
(rx/filter #(let [type (ptk/type %)]
(= type ::dwe/clear-edition-mode)
(= type ::start-path-edit))))]
(rx/concat
(rx/of (undo/start-path-undo)
(drawing/change-edit-mode mode))
(->> interrupt
(rx/of (undo/start-path-undo))
(->> stream
(rx/filter #(= % :interrupt))
(rx/take 1)
(rx/map #(stop-path-edit id))
(rx/take-until stopper)))))))
@ -343,7 +345,9 @@
content (st/get-path state :content)]
(-> state
(assoc-in [:workspace-local :edit-path id :old-content] content)
(st/set-content (-> content (upt/split-segments #{from-p to-p} t))))))
(st/set-content (-> content
(path.segment/split-segments #{from-p to-p} t)
(path/content))))))
ptk/WatchEvent
(watch [_ _ _]
@ -355,5 +359,5 @@
ptk/WatchEvent
(watch [_ state _]
(let [id (st/get-path-id state)]
(rx/of (dwsh/update-shapes [id] upsp/convert-to-path)
(rx/of (dwsh/update-shapes [id] path/convert-to-path)
(split-segments event))))))

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/get-handler-point content index prefix)
opposite (path.segment/get-handler-point content op-idx op-prefix)
[ocx ocy] (upc/prefix->coords op-prefix)
[ocx ocy] (path.helpers/prefix->coords op-prefix)
[odx ody] (calculate-opposite-delta node handler opposite match-angle? match-distance? dx dy)
hnv (if (some? handler)

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

5
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,8 @@
ranges-stream
(->> content-stream
(rx/map upg/content->points)
(rx/filter some?)
(rx/map path.segm/get-points)
(rx/map snap/create-ranges))]
(->> ms/mouse-position

52
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)
shape (st/get-path state)
selected-points (get-in state [:workspace-local :edit-path id :selected-points] #{})
points (or points selected-points)]
(let [page-id (get state :current-page-id)
objects (dsh/lookup-page-objects state page-id)
shape (st/get-path state)
id (st/get-path-id state)
selected-points
(dm/get-in state [:workspace-local :edit-path id :selected-points] #{})
points
(or points selected-points)]
(when (and (seq points) (some? shape))
(let [new-content (-> (tool-fn (:content shape) points)
(ups/close-subpaths))
changes (changes/generate-path-changes it objects page-id shape (:content shape) new-content)]
(let [new-content
(-> (tool-fn (:content shape) points)
(path/close-subpaths))
changes
(changes/generate-path-changes it objects page-id shape (:content shape) new-content)]
(rx/concat
(rx/of (dwsh/update-shapes [id] upsp/convert-to-path))
(if (cfh/path-shape? shape)
(rx/empty)
(rx/of (dwsh/update-shapes [id] path/convert-to-path)))
(rx/of (dch/commit-changes changes)
(when (empty? new-content)
(dwe/clear-edition-mode)))))))))))
@ -50,7 +62,7 @@
(process-path-tool
(when point #{point})
(fn [content points]
(reduce upt/make-corner-point content points)))))
(reduce path.segment/make-corner-point content points)))))
(defn make-curve
([]
@ -59,22 +71,22 @@
(process-path-tool
(when point #{point})
(fn [content points]
(reduce upt/make-curve-point content points)))))
(reduce path.segment/make-curve-point content points)))))
(defn add-node []
(process-path-tool (fn [content points] (upt/split-segments content points 0.5))))
(process-path-tool (fn [content points] (path.segment/split-segments content points 0.5))))
(defn remove-node []
(process-path-tool upt/remove-nodes))
(process-path-tool path.segment/remove-nodes))
(defn merge-nodes []
(process-path-tool upt/merge-nodes))
(process-path-tool path.segment/merge-nodes))
(defn join-nodes []
(process-path-tool upt/join-nodes))
(process-path-tool path.segment/join-nodes))
(defn separate-nodes []
(process-path-tool upt/separate-nodes))
(process-path-tool path.segment/separate-nodes))
(defn toggle-snap []
(ptk/reify ::toggle-snap

71
frontend/src/app/main/data/workspace/shapes.cljs
View File

@ -47,40 +47,53 @@
(defn update-shapes
([ids update-fn] (update-shapes ids update-fn nil))
([ids update-fn {:keys [reg-objects? save-undo? stack-undo? attrs ignore-tree page-id ignore-touched undo-group with-objects? changed-sub-attr]
:or {reg-objects? false save-undo? true stack-undo? false ignore-touched false with-objects? false}}]
([ids update-fn
{:keys [reg-objects? save-undo? stack-undo? attrs ignore-tree page-id
ignore-touched undo-group with-objects? changed-sub-attr]
:or {reg-objects? false
save-undo? true
stack-undo? false
ignore-touched false
with-objects? false}}]
(assert (sm/check-coll-of-uuid ids))
(assert (fn? update-fn))
(assert (every? uuid? ids) "expect a coll of uuid for `ids`")
(assert (fn? update-fn) "the `update-fn` should be a valid function")
(ptk/reify ::update-shapes
ptk/WatchEvent
(watch [it state _]
(let [page-id (or page-id (:current-page-id state))
(let [page-id (or page-id (get state :current-page-id))
objects (dsh/lookup-page-objects state page-id)
ids (into [] (filter some?) ids)
xf-update-layout
(comp
(map (d/getf objects))
(filter #(some update-layout-attr? (pcb/changed-attrs % objects update-fn {:attrs attrs :with-objects? with-objects?})))
(map :id))
update-layout-ids
(->> ids
(map (d/getf objects))
(filter #(some update-layout-attr? (pcb/changed-attrs % objects update-fn {:attrs attrs :with-objects? with-objects?})))
(map :id))
(->> (into [] xf-update-layout ids)
(not-empty))
changes (-> (pcb/empty-changes it page-id)
(pcb/set-save-undo? save-undo?)
(pcb/set-stack-undo? stack-undo?)
(cls/generate-update-shapes ids
update-fn
objects
{:attrs attrs
:changed-sub-attr changed-sub-attr
:ignore-tree ignore-tree
:ignore-touched ignore-touched
:with-objects? with-objects?})
(cond-> undo-group
(pcb/set-undo-group undo-group)))
changes
(-> (pcb/empty-changes it page-id)
(pcb/set-save-undo? save-undo?)
(pcb/set-stack-undo? stack-undo?)
(cls/generate-update-shapes ids
update-fn
objects
{:attrs attrs
:changed-sub-attr changed-sub-attr
:ignore-tree ignore-tree
:ignore-touched ignore-touched
:with-objects? with-objects?})
(cond-> undo-group
(pcb/set-undo-group undo-group)))
changes
(add-undo-group changes state)]
changes (add-undo-group changes state)]
(rx/concat
(if (seq (:redo-changes changes))
(let [changes (cond-> changes reg-objects? (pcb/resize-parents ids))]
@ -88,7 +101,7 @@
(rx/empty))
;; Update layouts for properties marked
(if (d/not-empty? update-layout-ids)
(if update-layout-ids
(rx/of (ptk/data-event :layout/update {:ids update-layout-ids}))
(rx/empty))))))))
@ -112,11 +125,13 @@
(pcb/with-objects objects)
(cfsh/prepare-add-shape shape objects))
changes (cond-> changes
(cfh/text-shape? shape)
(pcb/set-undo-group (:id shape)))
changes
(cond-> changes
(cfh/text-shape? shape)
(pcb/set-undo-group (:id shape)))
undo-id (js/Symbol)]
undo-id
(js/Symbol)]
(rx/concat
(rx/of (dwu/start-undo-transaction undo-id)

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

73
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)
(for [[i segment] (d/enumerate content-a-split)]
(let [p1 (:prev segment)
p2 (path.helpers/segment->point segment)
hp (case (:command cmd)
:line-to (-> (gsp/command->line cmd)
(gsp/line-values 0.5))
hp (case (:command segment)
:line-to (-> (path.helpers/command->line segment)
(path.helpers/line-values 0.5))
:curve-to (-> (gsp/command->bezier cmd)
(gsp/curve-values 0.5))
:curve-to (-> (path.helpers/command->bezier segment)
(path.helpers/curve-values 0.5))
nil)]
[:*
(when p1
@ -153,16 +154,16 @@
(when hp
[:circle {:data-i i :key (dm/str "c13-" i) :cx (:x hp) :cy (:y hp) :r radius :fill "orange"}])]))
(for [[i cmd] (d/enumerate content-b-split)]
(let [p1 (:prev cmd)
p2 (gsp/command->point cmd)
(for [[i segment] (d/enumerate content-b-split)]
(let [p1 (:prev segment)
p2 (path.helpers/segment->point segment)
hp (case (:command cmd)
:line-to (-> (gsp/command->line cmd)
(gsp/line-values 0.5))
hp (case (:command segment)
:line-to (-> (path.helpers/command->line segment)
(path.helpers/line-values 0.5))
:curve-to (-> (gsp/command->bezier cmd)
(gsp/curve-values 0.5))
:curve-to (-> (path.helpers/command->bezier segment)
(path.helpers/curve-values 0.5))
nil)]
[:*
(when p1

46
frontend/src/app/main/ui/workspace/shapes/path.cljs
View File

@ -6,34 +6,48 @@
(ns app.main.ui.workspace.shapes.path
(:require
[app.common.svg.path.command :as upc]
[app.main.data.workspace.path.helpers :as helpers]
[app.common.data.macros :as dm]
[app.common.types.path :as types.path]
[app.main.refs :as refs]
[app.main.ui.shapes.path :as path]
[app.main.ui.shapes.shape :refer [shape-container]]
[app.main.ui.workspace.shapes.debug :as wsd]
[app.main.ui.workspace.shapes.path.common :as pc]
[okulary.core :as l]
[rumext.v2 :as mf]))
(defn apply-content-modifiers
(defn- make-content-modifiers-ref
[id]
(l/derived (fn [local]
(dm/get-in local [:edit-path id :content-modifiers]))
refs/workspace-local))
(defn- apply-content-modifiers
[shape content-modifiers]
(let [shape (update shape :content upc/apply-content-modifiers content-modifiers)
[_ new-selrect] (helpers/content->points+selrect shape (:content shape))]
(assoc shape :selrect new-selrect)))
(let [shape (update shape :content types.path/apply-content-modifiers content-modifiers)]
(types.path/update-geometry shape)))
(mf/defc path-wrapper
{::mf/wrap-props false}
[props]
(let [shape (unchecked-get props "shape")
content-modifiers-ref (pc/make-content-modifiers-ref (:id shape))
content-modifiers (mf/deref content-modifiers-ref)
editing-id (mf/deref refs/selected-edition)
editing? (= editing-id (:id shape))
[{:keys [shape]}]
(let [shape-id (dm/get-prop shape :id)
content-modifiers-ref
(mf/with-memo [shape-id]
(make-content-modifiers-ref shape-id))
content-modifiers
(mf/deref content-modifiers-ref)
;; FIXME: this should be provided by react context instead of using refs
editing-id
(mf/deref refs/selected-edition)
editing?
(= editing-id shape-id)
shape
(mf/use-memo
(mf/deps shape content-modifiers)
#(cond-> shape
(mf/with-memo [shape content-modifiers]
(cond-> shape
(some? content-modifiers)
(apply-content-modifiers content-modifiers)))]

43
frontend/src/app/main/ui/workspace/shapes/path/common.cljs
View File

@ -1,43 +0,0 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS INC
(ns app.main.ui.workspace.shapes.path.common
(:require
[app.common.data.macros :as dm]
[app.main.data.workspace.path.state :as pst]
[app.main.refs :as refs]
[app.main.store :as st]
[okulary.core :as l]
[rumext.v2 :as mf]))
(def accent-color "var(--color-accent-tertiary)")
(def secondary-color "var(--color-accent-quaternary)")
(def black-color "var(--app-black)")
(def white-color "var(--app-white)")
(def gray-color "var(--df-secondary)")
(def current-edit-path-ref
(l/derived
(fn [state]
(let [id (pst/get-path-id state)]
(dm/get-in state [:workspace-local :edit-path id])))
st/state))
(defn make-edit-path-ref [id]
(mf/use-memo
(mf/deps id)
(let [selfn #(get-in % [:edit-path id])]
#(l/derived selfn refs/workspace-local))))
(defn content-modifiers-ref
[id]
(l/derived #(get-in % [:edit-path id :content-modifiers]) refs/workspace-local))
(defn make-content-modifiers-ref [id]
(mf/use-memo
(mf/deps id)
#(content-modifiers-ref id)))

491
frontend/src/app/main/ui/workspace/shapes/path/editor.cljs
View File

@ -8,24 +8,24 @@
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.files.helpers :as cfh]
[app.common.geom.point :as gpt]
[app.common.geom.shapes.path :as gsp]
[app.common.svg.path.command :as upc]
[app.common.svg.path.shapes-to-path :as ups]
[app.common.types.path :as path]
[app.common.types.path.helpers :as path.helpers]
[app.common.types.path.segment :as path.segment]
[app.main.data.workspace.path :as drp]
[app.main.refs :as refs]
[app.main.snap :as snap]
[app.main.store :as st]
[app.main.streams :as ms]
[app.main.ui.css-cursors :as cur]
[app.main.ui.hooks :as hooks]
[app.main.ui.workspace.shapes.path.common :as pc]
[app.util.dom :as dom]
[app.util.keyboard :as kbd]
[app.util.path.format :as upf]
[clojure.set :refer [map-invert]]
[goog.events :as events]
[rumext.v2 :as mf])
(:import goog.events.EventType))
[okulary.core :as l]
[rumext.v2 :as mf]))
(def point-radius 5)
(def point-radius-selected 4)
@ -38,16 +38,31 @@
(def path-preview-dasharray 4)
(def path-snap-stroke-width 1)
(mf/defc path-point [{:keys [position zoom edit-mode hover? selected? preview? start-path? last-p? new-point? curve?]}]
(def accent-color "var(--color-accent-tertiary)")
(def secondary-color "var(--color-accent-quaternary)")
(def black-color "var(--app-black)")
(def white-color "var(--app-white)")
(def gray-color "var(--df-secondary)")
(mf/defc path-point*
{::mf/private true}
[{:keys [position zoom edit-mode is-hover is-selected is-preview is-start-path is-last is-new is-curve]}]
(let [{:keys [x y]} position
is-draw (= edit-mode :draw)
is-move (= edit-mode :move)
is-active
(or ^boolean is-selected
^boolean is-hover)
on-enter
(mf/use-callback
(mf/use-fn
(fn [_]
(st/emit! (drp/path-pointer-enter position))))
on-leave
(mf/use-callback
(mf/use-fn
(fn [_]
(st/emit! (drp/path-pointer-leave position))))
@ -56,132 +71,173 @@
(dom/stop-propagation event)
(dom/prevent-default event)
(when (and new-point? (some? (meta position)))
;; FIXME: revisit this, using meta here breaks equality checks
(when (and is-new (some? (meta position)))
(st/emit! (drp/create-node-at-position (meta position))))
(let [shift? (kbd/shift? event)
mod? (kbd/mod? event)]
(let [is-shift (kbd/shift? event)
is-mod (kbd/mod? event)]
(cond
last-p?
is-last
(st/emit! (drp/reset-last-handler))
(and (= edit-mode :move) mod? (not curve?))
(and is-move is-mod (not is-curve))
(st/emit! (drp/make-curve position))
(and (= edit-mode :move) mod? curve?)
(and is-move is-mod is-curve)
(st/emit! (drp/make-corner position))
(= edit-mode :move)
is-move
;; If we're dragging a selected item we don't change the selection
(st/emit! (drp/start-move-path-point position shift?))
(st/emit! (drp/start-move-path-point position is-shift))
(and (= edit-mode :draw) start-path?)
(and is-draw is-start-path)
(st/emit! (drp/start-path-from-point position))
(and (= edit-mode :draw) (not start-path?))
(and is-draw (not is-start-path))
(st/emit! (drp/close-path-drag-start position)))))]
[:g.path-point
[:circle.path-point
{:cx x
:cy y
:r (if (or selected? hover?) (/ point-radius zoom) (/ point-radius-selected zoom))
:r (if ^boolean is-active
(/ point-radius zoom)
(/ point-radius-selected zoom))
:style {:stroke-width (/ point-radius-stroke-width zoom)
:stroke (cond (or selected? hover?) pc/black-color
preview? pc/secondary-color
:else pc/accent-color)
:fill (cond selected? pc/accent-color
:else pc/white-color)}}]
:stroke (cond ^boolean is-active black-color
^boolean is-preview secondary-color
:else accent-color)
:fill (cond is-selected accent-color
:else white-color)}}]
[:circle {:cx x
:cy y
:r (/ point-radius-active-area zoom)
:on-pointer-down on-pointer-down
:on-pointer-enter on-enter
:on-pointer-leave on-leave
:pointer-events (when-not preview? "visible")
:class (cond (= edit-mode :draw) (cur/get-static "pen-node")
(= edit-mode :move) (cur/get-static "pointer-node"))
:pointer-events (when-not ^boolean is-preview "visible")
:class (cond ^boolean is-draw (cur/get-static "pen-node")
^boolean is-move (cur/get-static "pointer-node"))
:style {:stroke-width 0
:fill "none"}}]]))
(mf/defc path-handler [{:keys [index prefix point handler zoom selected? hover? edit-mode snap-angle?]}]
(when (and point handler)
(let [{:keys [x y]} handler
on-enter
(fn [_]
(st/emit! (drp/path-handler-enter index prefix)))
;; FIXME: is-selected prop looks unused
on-leave
(fn [_]
(st/emit! (drp/path-handler-leave index prefix)))
(mf/defc path-handler*
{::mf/private true}
[{:keys [index prefix point handler zoom is-selected is-hover edit-mode snap-angle]}]
(let [x (dm/get-prop handler :x)
y (dm/get-prop handler :y)
is-draw (= edit-mode :draw)
is-move (= edit-mode :move)
on-pointer-down
(fn [event]
(dom/stop-propagation event)
(dom/prevent-default event)
is-active
(or ^boolean is-selected
^boolean is-hover)
(cond
(= edit-mode :move)
(st/emit! (drp/start-move-handler index prefix))))]
on-enter
(mf/use-fn
(mf/deps index prefix)
(fn [_] (st/emit! (drp/path-handler-enter index prefix))))
[:g.handler {:pointer-events (if (= edit-mode :draw) "none" "visible")}
on-leave
(mf/use-fn
(mf/deps index prefix)
(fn [_] (st/emit! (drp/path-handler-leave index prefix))))
on-pointer-down
(mf/use-fn
(mf/deps index prefix is-move)
(fn [event]
(dom/stop-propagation event)
(dom/prevent-default event)
(when ^boolean is-move
(st/emit! (drp/start-move-handler index prefix)))))]
[:g.handler {:pointer-events (if ^boolean is-draw "none" "visible")}
[:line
{:x1 (:x point)
:y1 (:y point)
:x2 x
:y2 y
:style {:stroke (if ^boolean is-hover
black-color
gray-color)
:stroke-width (/ point-radius-stroke-width zoom)}}]
(when ^boolean snap-angle
[:line
{:x1 (:x point)
:y1 (:y point)
:x2 x
:y2 y
:style {:stroke (if hover? pc/black-color pc/gray-color)
:stroke-width (/ point-radius-stroke-width zoom)}}]
:style {:stroke secondary-color
:stroke-width (/ point-radius-stroke-width zoom)}}])
(when snap-angle?
[:line
{:x1 (:x point)
:y1 (:y point)
:x2 x
:y2 y
:style {:stroke pc/secondary-color
:stroke-width (/ point-radius-stroke-width zoom)}}])
[:rect
{:x (- x (/ handler-side 2 zoom))
:y (- y (/ handler-side 2 zoom))
:width (/ handler-side zoom)
:height (/ handler-side zoom)
[:rect
{:x (- x (/ handler-side 2 zoom))
:y (- y (/ handler-side 2 zoom))
:width (/ handler-side zoom)
:height (/ handler-side zoom)
:style {:stroke-width (/ handler-stroke-width zoom)
:stroke (cond ^boolean is-active black-color
:else accent-color)
:fill (cond ^boolean is-selected accent-color
:else white-color)}}]
[:circle {:cx x
:cy y
:r (/ point-radius-active-area zoom)
:on-pointer-down on-pointer-down
:on-pointer-enter on-enter
:on-pointer-leave on-leave
:class (when ^boolean is-move
(cur/get-static "pointer-move"))
:style {:fill "none"
:stroke-width 0}}]]))
:style {:stroke-width (/ handler-stroke-width zoom)
:stroke (cond (or selected? hover?) pc/black-color
:else pc/accent-color)
:fill (cond selected? pc/accent-color
:else pc/white-color)}}]
[:circle {:cx x
:cy y
:r (/ point-radius-active-area zoom)
:on-pointer-down on-pointer-down
:on-pointer-enter on-enter
:on-pointer-leave on-leave
:class (when (= edit-mode :move) (cur/get-static "pointer-move"))
:style {:fill "none"
:stroke-width 0}}]])))
(mf/defc path-preview*
{::mf/private true}
[{:keys [zoom segment from]}]
(mf/defc path-preview [{:keys [zoom command from]}]
[:g.preview {:style {:pointer-events "none"}}
(when (not= :move-to (:command command))
[:path {:style {:fill "none"
:stroke pc/black-color
:stroke-width (/ handler-stroke-width zoom)
:stroke-dasharray (/ path-preview-dasharray zoom)}
:d (upf/format-path [{:command :move-to
:params {:x (:x from)
:y (:y from)}}
command])}])
[:& path-point {:position (:params command)
:preview? true
:zoom zoom}]])
(let [path
(when (not= :move-to (:command segment))
(let [segments [{:command :move-to
:params from}]
segments (conj segments segment)]
(path/content segments)))
(mf/defc path-snap [{:keys [selected points zoom]}]
(let [ranges (mf/use-memo (mf/deps selected points) #(snap/create-ranges points selected))
snap-matches (snap/get-snap-delta-match selected ranges (/ 1 zoom))
matches (concat (second (:x snap-matches)) (second (:y snap-matches)))]
position
(mf/with-memo [segment]
;; FIXME: use a helper from common for this
(gpt/point (:params segment)))]
[:g.preview {:style {:pointer-events "none"}}
(when (some? path)
[:path {:style {:fill "none"
:stroke black-color
:stroke-width (/ handler-stroke-width zoom)
:stroke-dasharray (/ path-preview-dasharray zoom)}
:d (str path)}])
[:> path-point* {:position position
:is-preview true
:zoom zoom}]]))
(mf/defc path-snap*
{::mf/private true}
[{:keys [selected points zoom]}]
(let [ranges
(mf/with-memo [selected points]
(snap/create-ranges points selected))
snap-matches
(snap/get-snap-delta-match selected ranges (/ 1 zoom))
matches
(concat (second (:x snap-matches)) (second (:y snap-matches)))]
[:g.snap-paths
(for [[idx [from to]] (d/enumerate matches)]
@ -190,14 +246,14 @@
:y1 (:y from)
:x2 (:x to)
:y2 (:y to)
:style {:stroke pc/secondary-color
:style {:stroke secondary-color
:stroke-width (/ path-snap-stroke-width zoom)}}])]))
(defn matching-handler? [content node handlers]
(defn- matching-handler? [content node handlers]
(when (= 2 (count handlers))
(let [[[i1 p1] [i2 p2]] handlers
p1 (upc/handler->point content i1 p1)
p2 (upc/handler->point content i2 p2)
p1 (path.segment/get-handler-point content i1 p1)
p2 (path.segment/get-handler-point content i2 p2)
v1 (gpt/to-vec node p1)
v2 (gpt/to-vec node p2)
@ -205,12 +261,19 @@
angle (gpt/angle-with-other v1 v2)]
(<= (- 180 angle) 0.1))))
(mf/defc path-editor
(defn- make-edit-path-ref [id]
(let [get-fn #(dm/get-in % [:edit-path id])]
(l/derived get-fn refs/workspace-local)))
(mf/defc path-editor*
[{:keys [shape zoom]}]
(let [editor-ref (mf/use-ref nil)
edit-path-ref (pc/make-edit-path-ref (:id shape))
hover-point (mf/use-state nil)
(let [shape-id (dm/get-prop shape :id)
edit-path-ref (mf/with-memo [shape-id]
(make-edit-path-ref shape-id))
hover-point (mf/use-state nil)
editor-ref (mf/use-ref nil)
{:keys [edit-mode
drag-handler
@ -224,141 +287,171 @@
hover-handlers
hover-points
snap-toggled]
:as edit-path} (mf/deref edit-path-ref)
:as edit-path}
(mf/deref edit-path-ref)
selected-points (or selected-points #{})
selected-points
(or selected-points #{})
shape (cond-> shape
(not= :path (:type shape))
(ups/convert-to-path {})
shape
(mf/with-memo [shape]
(cond-> shape
(not (cfh/path-shape? shape))
(path/convert-to-path)))
:always
hooks/use-equal-memo)
base-content
(get shape :content)
base-content (:content shape)
base-points (mf/use-memo (mf/deps base-content) #(->> base-content gsp/content->points))
base-points
(mf/with-memo [base-content]
(path/get-points base-content))
content (upc/apply-content-modifiers base-content content-modifiers)
content-points (mf/use-memo (mf/deps content) #(->> content gsp/content->points))
content
(mf/with-memo [base-content content-modifiers]
(path/apply-content-modifiers base-content content-modifiers))
content-points
(mf/with-memo [content]
(path/get-points content))
point->base (->> (map hash-map content-points base-points) (reduce merge))
base->point (map-invert point->base)
points (into #{} content-points)
points
(mf/with-memo [content-points]
(into #{} content-points))
last-p (->> content last upc/command->point)
handlers (upc/content->handlers content)
last-p
(->> content last path.helpers/segment->point)
start-p? (not (some? last-point))
handlers
(mf/with-memo [content]
(path.segment/get-handlers content))
[snap-selected snap-points]
(cond
(some? drag-handler) [#{drag-handler} points]
(some? preview) [#{(upc/command->point preview)} points]
(some? moving-handler) [#{moving-handler} points]
:else
[(->> selected-points (map base->point) (into #{}))
(->> points (remove selected-points) (into #{}))])
is-path-start
(not (some? last-point))
show-snap? (and snap-toggled
(or (some? drag-handler)
(some? preview)
(some? moving-handler)
moving-nodes))
show-snap?
(and ^boolean snap-toggled
(or (some? drag-handler)
(some? preview)
(some? moving-handler)
moving-nodes))]
handle-double-click-outside
(fn [_]
(when (= edit-mode :move)
(st/emit! :interrupt)))]
(mf/use-layout-effect
(mf/deps edit-mode)
(fn []
(let [keys [(events/listen (dom/get-root) EventType.DBLCLICK handle-double-click-outside)]]
#(doseq [key keys]
(events/unlistenByKey key)))))
(mf/with-layout-effect [edit-mode]
(let [key (events/listen (dom/get-root) "dblclick"
#(when (= edit-mode :move)
(st/emit! :interrupt)))]
#(events/unlistenByKey key)))
(hooks/use-stream
ms/mouse-position
(mf/deps shape zoom)
(mf/deps base-content zoom)
(fn [position]
(when-let [point (gsp/path-closest-point shape position)]
(when-let [point (path.segment/closest-point base-content position)]
(reset! hover-point (when (< (gpt/distance position point) (/ 10 zoom)) point)))))
[:g.path-editor {:ref editor-ref}
[:path {:d (upf/format-path content)
[:path {:d (.toString content)
:style {:fill "none"
:stroke pc/accent-color
:stroke accent-color
:strokeWidth (/ 1 zoom)}}]
(when (and preview (not drag-handler))
[:& path-preview {:command preview
:from last-p
:zoom zoom}])
[:> path-preview* {:segment preview
:from last-p
:zoom zoom}])
(when drag-handler
(when (and drag-handler last-p)
[:g.drag-handler {:pointer-events "none"}
[:& path-handler {:point last-p
:handler drag-handler
:edit-mode edit-mode
:zoom zoom}]])
[:> path-handler* {:point last-p
:handler drag-handler
:edit-mode edit-mode
:zoom zoom}]])
(when @hover-point
[:g.hover-point
[:& path-point {:position @hover-point
:edit-mode edit-mode
:new-point? true
:start-path? start-p?
:zoom zoom}]])
[:> path-point* {:position @hover-point
:edit-mode edit-mode
:is-new true
:is-start-path is-path-start
:zoom zoom}]])
(for [[index position] (d/enumerate points)]
(let [show-handler?
(for [position points]
(let [pos-x (dm/get-prop position :x)
pos-y (dm/get-prop position :y)
show-handler?
(fn [[index prefix]]
(let [handler-position (upc/handler->point content index prefix)]
;; FIXME: get-handler-point is executed twice for each
;; render, this can be optimized
(let [handler-position (path.segment/get-handler-point content index prefix)]
(not= position handler-position)))
pos-handlers (get handlers position)
point-selected? (contains? selected-points (get point->base position))
point-hover? (contains? hover-points (get point->base position))
last-p? (= last-point (get point->base position))
position-handlers
(->> (get handlers position)
(filter show-handler?)
(not-empty))
pos-handlers (->> pos-handlers (filter show-handler?))
curve? (boolean (seq pos-handlers))]
point-selected?
(contains? selected-points (get point->base position))
[:g.path-node {:key (dm/str index "-" (:x position) "-" (:y position))}
point-hover?
(contains? hover-points (get point->base position))
is-last
(= last-point (get point->base position))
is-curve
(boolean position-handlers)]
[:g.path-node {:key (dm/str pos-x "-" pos-y)}
[:g.point-handlers {:pointer-events (when (= edit-mode :draw) "none")}
(for [[hindex prefix] pos-handlers]
(let [handler-position (upc/handler->point content hindex prefix)
handler-hover? (contains? hover-handlers [hindex prefix])
moving-handler? (= handler-position moving-handler)
matching-handler? (matching-handler? content position pos-handlers)]
[:& path-handler {:key (dm/str (dm/str index "-" (:x position) "-" (:y position)) "-" hindex "-" (d/name prefix))
:point position
:handler handler-position
:index hindex
:prefix prefix
:zoom zoom
:hover? handler-hover?
:snap-angle? (and moving-handler? matching-handler?)
:edit-mode edit-mode}]))]
[:& path-point {:position position
:zoom zoom
:edit-mode edit-mode
:selected? point-selected?
:hover? point-hover?
:last-p? last-p?
:start-path? start-p?
:curve? curve?}]]))
(for [[hindex prefix] position-handlers]
(let [handler-position (path.segment/get-handler-point content hindex prefix)
handler-hover? (contains? hover-handlers [hindex prefix])
moving-handler? (= handler-position moving-handler)
matching-handler? (matching-handler? content position position-handlers)]
(when prev-handler
(when (and position handler-position)
[:> path-handler*
{:key (dm/str hindex "-" (d/name prefix))
:point position
:handler handler-position
:index hindex
:prefix prefix
:zoom zoom
:is-hover handler-hover?
:snap-angle (and moving-handler? matching-handler?)
:edit-mode edit-mode}])))]
[:> path-point* {:position position
:zoom zoom
:edit-mode edit-mode
:is-selected point-selected?
:is-hover point-hover?
:is-last is-last
:is-start-path is-path-start
:is-curve is-curve}]]))
(when (and prev-handler last-p)
[:g.prev-handler {:pointer-events "none"}
[:& path-handler {:point last-p
:edit-mode edit-mode
:handler prev-handler
:zoom zoom}]])
[:> path-handler*
{:point last-p
:edit-mode edit-mode
:handler prev-handler
:zoom zoom}]])
(when show-snap?
[:g.path-snap {:pointer-events "none"}
[:& path-snap {:selected snap-selected
:points snap-points
:zoom zoom}]])]))
(when ^boolean show-snap?
(let [[snap-selected snap-points]
(cond
(some? drag-handler) [#{drag-handler} points]
(some? preview) [#{(path.helpers/segment->point preview)} points]
(some? moving-handler) [#{moving-handler} points]
:else
[(->> selected-points (map base->point) (into #{}))
(->> points (remove selected-points) (into #{}))])]
[:g.path-snap {:pointer-events "none"}
[:> path-snap* {:selected snap-selected
:points snap-points
:zoom zoom}]]))]))

15
frontend/src/app/main/ui/workspace/sidebar/options/menus/bool.cljs
View File

@ -8,7 +8,8 @@
(:require-macros [app.main.style :as stl])
(:require
[app.common.data :as d]
[app.main.data.workspace :as dw]
[app.main.data.workspace.bool :as dwb]
[app.main.data.workspace.path.shapes-to-path :as dwps]
[app.main.data.workspace.shortcuts :as sc]
[app.main.refs :as refs]
[app.main.store :as st]
@ -43,19 +44,21 @@
(mf/deps selected is-group? is-bool?)
(fn [bool-type]
(let [bool-type (keyword bool-type)]
(cond
(> (count selected) 1)
(st/emit! (dw/create-bool bool-type))
(st/emit! (dwb/create-bool bool-type))
(and (= (count selected) 1) is-group?)
(st/emit! (dw/group-to-bool (:id head) bool-type))
(st/emit! (dwb/group-to-bool (:id head) bool-type))
(and (= (count selected) 1) is-bool?)
(if (= head-bool-type bool-type)
(st/emit! (dw/bool-to-group (:id head)))
(st/emit! (dw/change-bool-type (:id head) bool-type)))))))
(st/emit! (dwb/bool-to-group (:id head)))
(st/emit! (dwb/change-bool-type (:id head) bool-type)))))))
flatten-objects (mf/use-fn #(st/emit! (dw/convert-selected-to-path)))]
flatten-objects
(mf/use-fn #(st/emit! (dwps/convert-selected-to-path)))]
(when (not (and disabled-bool-btns disabled-flatten))
[:div {:class (stl/css :boolean-options)}

1
frontend/src/app/main/ui/workspace/sidebar/options/shapes/bool.cljs
View File

@ -46,6 +46,7 @@
ids (hooks/use-equal-memo ids)
parents-by-ids-ref (mf/use-memo (mf/deps ids) #(refs/parents-by-ids ids))
parents (mf/deref parents-by-ids-ref)]
[:*
[:& layer-menu {:ids ids
:type type

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

52
frontend/src/app/main/ui/workspace/viewport.cljs
View File

@ -24,6 +24,7 @@
[app.main.ui.measurements :as msr]
[app.main.ui.shapes.export :as use]
[app.main.ui.workspace.shapes :as shapes]
[app.main.ui.workspace.shapes.path.editor :refer [path-editor*]]
[app.main.ui.workspace.shapes.text.editor :as editor-v1]
[app.main.ui.workspace.shapes.text.text-edition-outline :refer [text-edition-outline]]
[app.main.ui.workspace.shapes.text.v2-editor :as editor-v2]
@ -116,7 +117,9 @@
objects-modified (mf/with-memo [base-objects text-modifiers modifiers]
(apply-modifiers-to-selected selected base-objects text-modifiers modifiers))
selected-shapes (keep (d/getf objects-modified) selected)
selected-shapes (->> selected
(into [] (keep (d/getf objects-modified)))
(not-empty))
;; STATE
alt? (mf/use-state false)
@ -164,15 +167,18 @@
editing-shape (when edition (get base-objects edition))
create-comment? (= :comments drawing-tool)
drawing-path? (or (and edition (= :draw (get-in edit-path [edition :edit-mode])))
(and (some? drawing-obj) (= :path (:type drawing-obj))))
node-editing? (and edition (= :path (get-in base-objects [edition :type])))
text-editing? (and edition (= :text (get-in base-objects [edition :type])))
edit-path (get edit-path edition)
edit-path-mode (get edit-path :edit-mode)
create-comment? (= :comments drawing-tool)
drawing-path? (or (= edit-path-mode :draw)
(= :path (get drawing-obj :type)))
node-editing? (cfh/path-shape? editing-shape)
text-editing? (cfh/text-shape? editing-shape)
grid-editing? (and edition (ctl/grid-layout? base-objects edition))
mode-inspect? (= options-mode :inspect)
mode-inspect? (= options-mode :inspect)
on-click (actions/on-click hover selected edition drawing-path? drawing-tool space? selrect z?)
on-context-menu (actions/on-context-menu hover hover-ids read-only?)
@ -282,7 +288,12 @@
[:div {:class (stl/css :viewport) :style #js {"--zoom" zoom} :data-testid "viewport"}
(when (:can-edit permissions)
[:& top-bar/top-bar {:layout layout}])
[:> top-bar/top-bar* {:layout layout
:selected selected-shapes
:edit-path edit-path
:drawing drawing
:edition edition
:is-read-only read-only?}])
[:div {:class (stl/css :viewport-overlays)}
;; The behaviour inside a foreign object is a bit different that in plain HTML so we wrap
;; inside a foreign object "dummy" so this awkward behaviour is take into account
@ -428,12 +439,13 @@
:zoom zoom
:modifiers modifiers}])
(when show-selection-handlers?
[:& selection/selection-area
(when (and show-selection-handlers?
selected-shapes)
[:> selection/area*
{:shapes selected-shapes
:zoom zoom
:edition edition
:disable-handlers (or drawing-tool edition @space? @mod?)
:disabled (or drawing-tool edition @space? @mod?)
:on-move-selected on-move-selected
:on-context-menu on-menu-selected}])
@ -501,7 +513,7 @@
:on-frame-select on-frame-select}])
(when show-draw-area?
[:& drawarea/draw-area
[:> drawarea/draw-area*
{:shape drawing-obj
:zoom zoom
:tool drawing-tool}])
@ -603,12 +615,16 @@
(when show-selection-handlers?
[:g.selection-handlers {:clipPath "url(#clip-handlers)"}
[:& selection/selection-handlers
{:selected selected
:shapes selected-shapes
:zoom zoom
:edition edition
:disable-handlers (or drawing-tool edition @space?)}]
(when-not text-editing?
(if editing-shape
[:> path-editor* {:shape editing-shape
:zoom zoom}]
(when selected-shapes
[:> selection/handlers*
{:selected selected
:shapes selected-shapes
:zoom zoom
:disabled (or drawing-tool @space?)}])))
(when show-prototypes?
[:& interactions/interactions

5
frontend/src/app/main/ui/workspace/viewport/actions.cljs
View File

@ -227,8 +227,9 @@
(dw/start-editing-selected))
(some? selected-shape)
(do (reset! hover selected-shape)
(st/emit! (dw/select-shape (:id selected-shape))))
(do
(reset! hover selected-shape)
(st/emit! (dw/select-shape (:id selected-shape))))
(and (not selected-shape) (some? grid-layout-id) (not read-only?))
(st/emit! (dw/start-edition-mode grid-layout-id)))))))))))

38
frontend/src/app/main/ui/workspace/viewport/drawarea.cljs
View File

@ -11,29 +11,13 @@
[app.common.types.shape :as cts]
[app.main.ui.shapes.path :refer [path-shape]]
[app.main.ui.workspace.shapes :as shapes]
[app.main.ui.workspace.shapes.path.editor :refer [path-editor]]
[app.main.ui.workspace.shapes.path.editor :refer [path-editor*]]
[rumext.v2 :as mf]))
(declare generic-draw-area)
(declare path-draw-area)
(mf/defc draw-area
[{:keys [shape zoom tool] :as props}]
;; Prevent rendering something that it's not a shape.
(when (cts/shape? shape)
[:g.draw-area
[:g {:style {:pointer-events "none"}}
[:& shapes/shape-wrapper {:shape shape}]]
(case tool
:path [:& path-editor {:shape shape :zoom zoom}]
:curve [:& path-shape {:shape shape :zoom zoom}]
#_:default [:& generic-draw-area {:shape shape :zoom zoom}])]))
(mf/defc generic-draw-area
(mf/defc generic-draw-area*
{::mf/private true}
[{:keys [shape zoom]}]
(let [{:keys [x y width height]} (:selrect shape)]
(let [{:keys [x y width height]} (get shape :selrect)]
(when (and x y
(not (mth/nan? x))
(not (mth/nan? y)))
@ -45,3 +29,17 @@
:fill "none"
:stroke-width (/ 1 zoom)}}])))
(mf/defc draw-area*
[{:keys [shape zoom tool] :as props}]
;; Prevent rendering something that it's not a shape.
(when (cts/shape? shape)
[:g.draw-area
[:g {:style {:pointer-events "none"}}
[:& shapes/shape-wrapper {:shape shape}]]
(case tool
:path [:> path-editor* props]
:curve [:& path-shape {:shape shape :zoom zoom}]
#_:default [:> generic-draw-area* props])]))

4
frontend/src/app/main/ui/workspace/viewport/outline.cljs
View File

@ -8,7 +8,6 @@
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.exceptions :as ex]
[app.common.files.helpers :as cfh]
[app.common.geom.shapes :as gsh]
[app.common.types.component :as ctk]
@ -17,7 +16,6 @@
[app.main.ui.hooks :as hooks]
[app.main.ui.shapes.attrs :as attrs]
[app.util.object :as obj]
[app.util.path.format :as upf]
[clojure.set :as set]
[rumext.v2 :as mf]))
@ -51,7 +49,7 @@
path-data
(mf/with-memo [path? content]
(when (and ^boolean path? (some? content))
(d/nilv (ex/ignoring (upf/format-path content)) "")))
(.toString content)))
border-attrs
(attrs/get-border-props shape)

34
frontend/src/app/main/ui/workspace/viewport/path_actions.cljs
View File

@ -7,16 +7,14 @@
(ns app.main.ui.workspace.viewport.path-actions
(:require-macros [app.main.style :as stl])
(:require
[app.common.types.path.segment :as path.segm]
[app.main.data.workspace.path :as drp]
[app.main.data.workspace.path.shortcuts :as sc]
[app.main.store :as st]
[app.main.ui.icons :as i]
[app.main.ui.workspace.shapes.path.common :as pc]
[app.util.i18n :as i18n :refer [tr]]
[app.util.path.tools :as upt]
[rumext.v2 :as mf]))
(def ^:private pentool-icon
(i/icon-xref :pentool (stl/css :pentool-icon :pathbar-icon)))
@ -47,9 +45,8 @@
(def ^:private snap-nodes-icon
(i/icon-xref :snap-nodes (stl/css :snap-nodes-icon :pathbar-icon)))
(defn check-enabled [content selected-points]
(let [segments (upt/get-segments content selected-points)
(let [segments (path.segm/get-segments-with-points content selected-points)
num-segments (count segments)
num-points (count selected-points)
points-selected? (seq selected-points)
@ -58,7 +55,7 @@
max-segments (-> num-points
(* (- num-points 1))
(/ 2))
is-curve? (some #(upt/is-curve? content %) selected-points)]
is-curve? (some #(path.segm/is-curve? content %) selected-points)]
{:make-corner (and points-selected? is-curve?)
:make-curve (and points-selected? (not is-curve?))
@ -68,9 +65,10 @@
:join-nodes (and points-selected? (>= num-points 2) (< num-segments max-segments))
:separate-nodes segments-selected?}))
(mf/defc path-actions*
[{:keys [shape edit-path]}]
(let [{:keys [edit-mode selected-points snap-toggled]} edit-path
(mf/defc path-actions [{:keys [shape]}]
(let [{:keys [edit-mode selected-points snap-toggled] :as all} (mf/deref pc/current-edit-path-ref)
content (:content shape)
enabled-buttons
@ -79,66 +77,66 @@
#(check-enabled content selected-points))
on-select-draw-mode
(mf/use-callback
(mf/use-fn
(fn [_]
(st/emit! (drp/change-edit-mode :draw))))
on-select-edit-mode
(mf/use-callback
(mf/use-fn
(fn [_]
(st/emit! (drp/change-edit-mode :move))))
on-add-node
(mf/use-callback
(mf/use-fn
(mf/deps (:add-node enabled-buttons))
(fn [_]
(when (:add-node enabled-buttons)
(st/emit! (drp/add-node)))))
on-remove-node
(mf/use-callback
(mf/use-fn
(mf/deps (:remove-node enabled-buttons))
(fn [_]
(when (:remove-node enabled-buttons)
(st/emit! (drp/remove-node)))))
on-merge-nodes
(mf/use-callback
(mf/use-fn
(mf/deps (:merge-nodes enabled-buttons))
(fn [_]
(when (:merge-nodes enabled-buttons)
(st/emit! (drp/merge-nodes)))))
on-join-nodes
(mf/use-callback
(mf/use-fn
(mf/deps (:join-nodes enabled-buttons))
(fn [_]
(when (:join-nodes enabled-buttons)
(st/emit! (drp/join-nodes)))))
on-separate-nodes
(mf/use-callback
(mf/use-fn
(mf/deps (:separate-nodes enabled-buttons))
(fn [_]
(when (:separate-nodes enabled-buttons)
(st/emit! (drp/separate-nodes)))))
on-make-corner
(mf/use-callback
(mf/use-fn
(mf/deps (:make-corner enabled-buttons))
(fn [_]
(when (:make-corner enabled-buttons)
(st/emit! (drp/make-corner)))))
on-make-curve
(mf/use-callback
(mf/use-fn
(mf/deps (:make-curve enabled-buttons))
(fn [_]
(when (:make-curve enabled-buttons)
(st/emit! (drp/make-curve)))))
on-toggle-snap
(mf/use-callback
(mf/use-fn
(fn [_]
(st/emit! (drp/toggle-snap))))]

107
frontend/src/app/main/ui/workspace/viewport/selection.cljs
View File

@ -20,7 +20,6 @@
[app.main.store :as st]
[app.main.ui.context :as ctx]
[app.main.ui.css-cursors :as cur]
[app.main.ui.workspace.shapes.path.editor :refer [path-editor]]
[app.util.array :as array]
[app.util.debug :as dbg]
[app.util.dom :as dom]
@ -314,9 +313,8 @@
:style {:fill (if (dbg/enabled? :handlers) "yellow" "none")
:stroke-width 0}}]]))
(mf/defc controls-selection
{::mf/wrap-props false}
[{:keys [shape zoom color on-move-selected on-context-menu disable-handlers]}]
(mf/defc controls-selection*
[{:keys [shape zoom color on-move-selected on-context-menu disabled]}]
(let [selrect (dm/get-prop shape :selrect)
transform-type (mf/deref refs/current-transform)
sr-transform (mf/deref refs/workspace-selrect-transform)
@ -330,7 +328,7 @@
(when (and (some? selrect)
(not (or (= transform-type :move)
(= transform-type :rotate))))
[:g.controls {:pointer-events (if ^boolean disable-handlers "none" "visible")}
[:g.controls {:pointer-events (if ^boolean disabled "none" "visible")}
;; Selection rect
[:& selection-rect {:rect selrect
:transform transform
@ -339,9 +337,9 @@
:on-move-selected on-move-selected
:on-context-menu on-context-menu}]])))
(mf/defc controls-handlers
{::mf/wrap-props false}
[{:keys [shape zoom color on-resize on-rotate disable-handlers]}]
(mf/defc controls-handlers*
{::mf/private true}
[{:keys [shape zoom color on-resize on-rotate disabled]}]
(let [transform-type (mf/deref refs/current-transform)
sr-transform (mf/deref refs/workspace-selrect-transform)
@ -370,7 +368,7 @@
(not (or (= transform-type :move)
(= transform-type :rotate))))
[:g.controls {:pointer-events (if ^boolean disable-handlers "none" "visible")}
[:g.controls {:pointer-events (if ^boolean disabled "none" "visible")}
(for [handler (calculate-handlers selrect shape zoom)]
(let [type (obj/get handler "type")
position (obj/get handler "position")
@ -425,9 +423,9 @@
:stroke-opacity 1
:fill "none"}}]]))
(mf/defc multiple-handlers
{::mf/wrap-props false}
[{:keys [shapes selected zoom color disable-handlers]}]
(mf/defc multiple-handlers*
{::mf/private true}
[{:keys [shapes selected zoom color disabled]}]
(let [shape (mf/with-memo [shapes]
(-> shapes
(gsh/shapes->rect)
@ -452,34 +450,34 @@
(dom/stop-propagation event)
(st/emit! (dw/start-rotate shapes)))))]
[:& controls-handlers
[:> controls-handlers*
{:shape shape
:zoom zoom
:color color
:disable-handlers disable-handlers
:disabled disabled
:on-resize on-resize
:on-rotate on-rotate}]))
(mf/defc multiple-selection
{::mf/wrap-props false}
[{:keys [shapes zoom color disable-handlers on-move-selected on-context-menu]}]
(mf/defc multiple-selection*
{::mf/private true}
[{:keys [shapes zoom color disabled on-move-selected on-context-menu]}]
(let [shape (mf/with-memo [shapes]
(-> shapes
(gsh/shapes->rect)
(assoc :type :multiple)
(cts/setup-shape)))]
[:& controls-selection
[:> controls-selection*
{:shape shape
:zoom zoom
:color color
:disable-handlers disable-handlers
:disabled disabled
:on-move-selected on-move-selected
:on-context-menu on-context-menu}]))
(mf/defc single-handlers
{::mf/wrap-props false}
[{:keys [shape zoom color disable-handlers]}]
(mf/defc single-handlers*
{::mf/private true}
[{:keys [shape zoom color disabled]}]
(let [shape-id (dm/get-prop shape :id)
on-resize
@ -501,28 +499,27 @@
(dom/stop-propagation event)
(st/emit! (dw/start-rotate [shape])))))]
[:& controls-handlers
[:> controls-handlers*
{:shape shape
:zoom zoom
:color color
:disable-handlers disable-handlers
:disabled disabled
:on-rotate on-rotate
:on-resize on-resize}]))
(mf/defc single-selection
{::mf/wrap-props false}
[{:keys [shape zoom color disable-handlers on-move-selected on-context-menu]}]
[:& controls-selection
(mf/defc single-selection*
{::mf/private true}
[{:keys [shape zoom color disabled on-move-selected on-context-menu]}]
[:> controls-selection*
{:shape shape
:zoom zoom
:color color
:disable-handlers disable-handlers
:disabled disabled
:on-move-selected on-move-selected
:on-context-menu on-context-menu}])
(mf/defc selection-area
{::mf/wrap-props false}
[{:keys [shapes edition zoom disable-handlers on-move-selected on-context-menu]}]
(mf/defc area*
[{:keys [shapes edition zoom disabled on-move-selected on-context-menu]}]
(let [total (count shapes)
shape (first shapes)
@ -538,15 +535,12 @@
selection-rect-color-normal)]
(cond
(zero? total)
nil
(> total 1)
[:& multiple-selection
[:> multiple-selection*
{:shapes shapes
:zoom zoom
:color color
:disable-handlers disable-handlers
:disabled disabled
:on-move-selected on-move-selected
:on-context-menu on-context-menu}]
@ -561,55 +555,38 @@
nil
:else
[:& single-selection
[:> single-selection*
{:shape shape
:zoom zoom
:color color
:disable-handlers disable-handlers
:disabled disabled
:on-move-selected on-move-selected
:on-context-menu on-context-menu}])))
(mf/defc selection-handlers
{::mf/wrap-props false}
[{:keys [shapes selected edition zoom disable-handlers]}]
(mf/defc handlers*
[{:keys [shapes selected zoom disabled]}]
(let [total (count shapes)
shape (first shapes)
shape-id (dm/get-prop shape :id)
;; Note that we don't use mf/deref to avoid a repaint dependency here
objects (deref refs/workspace-page-objects)
color (if (and (= total 1) ^boolean
color (if (and (= total 1)
^boolean
(or (ctn/in-any-component? objects shape)
(ctk/is-variant-container? shape)))
selection-rect-color-component
selection-rect-color-normal)]
(cond
(zero? total)
nil
(> total 1)
[:& multiple-handlers
(if (> total 1)
[:> multiple-handlers*
{:shapes shapes
:selected selected
:zoom zoom
:color color
:disable-handlers disable-handlers}]
(and (cfh/text-shape? shape)
(= edition shape-id))
nil
(= edition shape-id)
[:& path-editor
{:zoom zoom
:shape shape}]
:else
[:& single-handlers
:disabled disabled}]
[:> single-handlers*
{:shape shape
:zoom zoom
:color color
:disable-handlers disable-handlers}])))
:disabled disabled}])))

60
frontend/src/app/main/ui/workspace/viewport/top_bar.cljs
View File

@ -7,23 +7,22 @@
(ns app.main.ui.workspace.viewport.top-bar
(:require-macros [app.main.style :as stl])
(:require
[app.common.data.macros :as dm]
[app.common.files.helpers :as cfh]
[app.common.types.shape.layout :as ctl]
[app.main.data.workspace :as dw]
[app.main.data.workspace.common :as dwc]
[app.main.refs :as refs]
[app.main.store :as st]
[app.main.ui.context :as ctx]
[app.main.ui.workspace.top-toolbar :refer [top-toolbar]]
[app.main.ui.workspace.viewport.grid-layout-editor :refer [grid-edition-actions]]
[app.main.ui.workspace.viewport.path-actions :refer [path-actions]]
[app.main.ui.workspace.viewport.path-actions :refer [path-actions*]]
[app.util.i18n :as i18n :refer [tr]]
[rumext.v2 :as mf]))
(mf/defc view-only-actions
(mf/defc view-only-actions*
[]
(let [handle-close-view-mode
(mf/use-callback
(mf/use-fn
(fn []
(st/emit! :interrupt
(dw/set-options-mode :design)
@ -38,43 +37,44 @@
:on-click handle-close-view-mode}
(tr "workspace.top-bar.read-only.done")]]]))
(mf/defc top-bar
{::mf/wrap [mf/memo]}
[{:keys [layout]}]
(let [edition (mf/deref refs/selected-edition)
selected (mf/deref refs/selected-objects)
drawing (mf/deref refs/workspace-drawing)
rulers? (mf/deref refs/rulers?)
drawing-obj (:object drawing)
(mf/defc top-bar*
[{:keys [layout drawing is-read-only edition selected edit-path]}]
(let [rulers? (contains? layout :rulers)
hide-ui? (contains? layout :hide-ui)
drawing-obj (get drawing :object)
shape (or drawing-obj (-> selected first))
shape-id (dm/get-prop shape :id)
single? (= (count selected) 1)
editing? (= (:id shape) edition)
draw-path? (and (some? drawing-obj)
(cfh/path-shape? drawing-obj)
(not= :curve (:tool drawing)))
single? (= (count selected) 1)
editing? (= shape-id edition)
workspace-read-only? (mf/use-ctx ctx/workspace-read-only?)
hide-ui? (:hide-ui layout)
draw-path? (and (some? drawing-obj)
(cfh/path-shape? drawing-obj)
(not= :curve (:tool drawing)))
path-edition? (or (and single? editing?
(and (not (cfh/text-shape? shape))
(not (cfh/frame-shape? shape))))
draw-path?)
is-path-edition
(or (and single? editing?
(and (not (cfh/text-shape? shape))
(not (cfh/frame-shape? shape))))
draw-path?)
grid-edition? (and single? editing? (ctl/grid-layout? shape))]
grid-edition?
(and single? editing? (ctl/grid-layout? shape))]
[:*
(when-not hide-ui?
(when-not ^boolean hide-ui?
[:& top-toolbar {:layout layout}])
(cond
workspace-read-only?
[:& view-only-actions]
^boolean
is-read-only
[:> view-only-actions*]
path-edition?
^boolean
is-path-edition
[:div {:class (stl/css-case :viewport-actions-path true :viewport-actions-no-rulers (not rulers?))}
[:& path-actions {:shape shape}]]
[:> path-actions* {:shape shape :edit-path edit-path}]]
grid-edition?
[:& grid-edition-actions {:shape shape}])]))

52
frontend/src/app/main/ui/workspace/viewport_wasm.cljs
View File

@ -23,6 +23,7 @@
[app.main.ui.flex-controls :as mfc]
[app.main.ui.hooks :as ui-hooks]
[app.main.ui.measurements :as msr]
[app.main.ui.workspace.shapes.path.editor :refer [path-editor*]]
[app.main.ui.workspace.shapes.text.editor :as editor-v1]
[app.main.ui.workspace.shapes.text.text-edition-outline :refer [text-edition-outline]]
[app.main.ui.workspace.shapes.text.v2-editor :as editor-v2]
@ -119,8 +120,9 @@
(binding [cts/*wasm-sync* false]
(apply-modifiers-to-selected selected base-objects text-modifiers modifiers)))
selected-shapes (keep (d/getf objects-modified) selected)
selected-shapes (->> selected
(into [] (keep (d/getf objects-modified)))
(not-empty))
;; STATE
alt? (mf/use-state false)
shift? (mf/use-state false)
@ -173,14 +175,18 @@
editing-shape (when edition (get base-objects edition))
edit-path (get edit-path edition)
edit-path-mode (get edit-path :edit-mode)
create-comment? (= :comments drawing-tool)
drawing-path? (or (and edition (= :draw (get-in edit-path [edition :edit-mode])))
(and (some? drawing-obj) (= :path (:type drawing-obj))))
node-editing? (and edition (= :path (get-in base-objects [edition :type])))
text-editing? (and edition (= :text (get-in base-objects [edition :type])))
drawing-path? (or (= edit-path-mode :draw)
(= :path (get drawing-obj :type)))
node-editing? (cfh/path-shape? editing-shape)
text-editing? (cfh/text-shape? editing-shape)
grid-editing? (and edition (ctl/grid-layout? base-objects edition))
mode-inspect? (= options-mode :inspect)
mode-inspect? (= options-mode :inspect)
on-click (actions/on-click hover selected edition drawing-path? drawing-tool space? selrect z?)
on-context-menu (actions/on-context-menu hover hover-ids read-only?)
@ -338,7 +344,12 @@
[:div {:class (stl/css :viewport) :style #js {"--zoom" zoom} :data-testid "viewport"}
(when (:can-edit permissions)
[:& top-bar/top-bar {:layout layout}])
[:> top-bar/top-bar* {:layout layout
:selected selected-shapes
:edit-path edit-path
:drawing drawing
:edition edition
:is-read-only read-only?}])
[:div {:class (stl/css :viewport-overlays)}
(when show-comments?
[:> comments/comments-layer* {:vbox vbox
@ -434,12 +445,13 @@
:zoom zoom
:modifiers modifiers}])
(when show-selection-handlers?
[:& selection/selection-area
(when (and show-selection-handlers?
selected-shapes)
[:> selection/area*
{:shapes selected-shapes
:zoom zoom
:edition edition
:disable-handlers (or drawing-tool edition @space? @mod?)
:disabled (or drawing-tool edition @space? @mod?)
:on-move-selected on-move-selected
:on-context-menu on-menu-selected}])
@ -507,7 +519,7 @@
:on-frame-select on-frame-select}])
(when show-draw-area?
[:& drawarea/draw-area
[:> drawarea/draw-area*
{:shape drawing-obj
:zoom zoom
:tool drawing-tool}])
@ -609,12 +621,16 @@
(when show-selection-handlers?
[:g.selection-handlers {:clipPath "url(#clip-handlers)"}
[:& selection/selection-handlers
{:selected selected
:shapes selected-shapes
:zoom zoom
:edition edition
:disable-handlers (or drawing-tool edition @space?)}]
(when-not text-editing?
(if editing-shape
[:> path-editor* {:shape editing-shape
:zoom zoom}]
(when selected-shapes
[:> selection/handlers*
{:selected selected
:shapes selected-shapes
:zoom zoom
:disabled (or drawing-tool @space?)}])))
(when show-prototypes?
[:& interactions/interactions

8
frontend/src/app/plugins/api.cljs
View File

@ -376,10 +376,10 @@
(u/display-not-valid :createBoolean-shapes shapes)
:else
(let [ids (into #{} (map #(obj/get % "$id")) shapes)
id-ret (atom nil)]
(st/emit! (dwb/create-bool bool-type ids {:id-ret id-ret}))
(shape/shape-proxy plugin-id @id-ret)))))
(let [ids (into #{} (map #(obj/get % "$id")) shapes)
shape-id (uuid/next)]
(st/emit! (dwb/create-bool bool-type :ids ids :force-shape-id shape-id))
(shape/shape-proxy plugin-id shape-id)))))
:generateMarkup
(fn [shapes options]

17
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]
@ -50,7 +51,6 @@
[app.plugins.text :as text]
[app.plugins.utils :as u]
[app.util.object :as obj]
[app.util.path.format :as upf]
[beicon.v2.core :as rx]
[cuerdas.core :as str]))
@ -1018,7 +1018,7 @@
(u/display-not-valid :makeMask (:type shape))
:else
(upf/format-path (:content shape)))))
(.toString (:content shape)))))
;; Text shapes
:getRange
@ -1309,21 +1309,22 @@
(cond-> (or (cfh/path-shape? data) (cfh/bool-shape? data))
(crc/add-properties!
{:name "content"
:get #(-> % u/proxy->shape :content upf/format-path)
:get #(-> % u/proxy->shape :content .toString)
:set
(fn [_ value]
(let [content (->> (path/parse value))]
(let [content (svg.path/parse value)]
(cond
(not (cfh/path-shape? data))
(u/display-not-valid :content-type type)
(not (sm/validate ::ctsp/content content))
;; FIXME: revisit path content validation
(not (sm/validate ::path/content content))
(u/display-not-valid :content value)
(not (r/check-permission plugin-id "content:write"))
(u/display-not-valid :content "Plugin doesn't have 'content:write' permission")
:else
(let [selrect (gsh/content->selrect content)
(let [selrect (path.segm/content->selrect content)
points (grc/rect->points selrect)]
(st/emit! (dwsh/update-shapes [id] (fn [shape] (assoc shape :content content :selrect selrect :points points))))))))}))))))

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

137
frontend/src/app/util/path/format.cljs
View File

@ -1,137 +0,0 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS INC
(ns app.util.path.format
(:require
[app.common.svg.path.command :as upc]
[app.common.svg.path.subpath :refer [pt=]]
[app.util.array :as arr]))
;; TODO: move to common
(def path-precision 3)
(defn- join-params
([a]
(js* "\"\"+~{}"
(.toFixed a path-precision)))
([a b]
(js* "\"\"+~{}+\",\"+~{}"
(.toFixed a path-precision)
(.toFixed b path-precision)))
([a b c]
(js* "\"\"+~{}+\",\"+~{}+\",\"+~{}"
(.toFixed a path-precision)
(.toFixed b path-precision)
(.toFixed c path-precision)))
([a b c d]
(js* "\"\"+~{}+\",\"+~{}+\",\"+~{}+\",\"+~{}"
(.toFixed a path-precision)
(.toFixed b path-precision)
(.toFixed c path-precision)
(.toFixed d path-precision)))
([a b c d e]
(js* "\"\"+~{}+\",\"+~{}+\",\"+~{}+\",\"+~{}+\",\"+~{}"
(.toFixed a path-precision)
(.toFixed b path-precision)
(.toFixed c path-precision)
(.toFixed d path-precision)
(.toFixed e path-precision)))
([a b c d e f]
(js* "\"\"+~{}+\",\"+~{}+\",\"+~{}+\",\"+~{}+\",\"+~{}+\",\"+~{}"
(.toFixed a path-precision)
(.toFixed b path-precision)
(.toFixed c path-precision)
(.toFixed d path-precision)
(.toFixed e path-precision)
(.toFixed f path-precision)))
([a b c d e f g]
(js* "\"\"+~{}+\",\"+~{}+\",\"+~{}+\",\"+~{}+\",\"+~{}+\",\"+~{}+\",\"+~{}"
(.toFixed a path-precision)
(.toFixed b path-precision)
(.toFixed c path-precision)
(.toFixed d path-precision)
(.toFixed e path-precision)
(.toFixed f path-precision)
(.toFixed g path-precision))))
(defn- translate-params
[command {:keys [x y] :as params}]
(case command
(:move-to :line-to :smooth-quadratic-bezier-curve-to)
(join-params x y)
:close-path
""
(:line-to-horizontal :line-to-vertical)
(:value params)
:curve-to
(let [{:keys [c1x c1y c2x c2y]} params]
(join-params (or c1x x) (or c1y y) (or c2x x) (or c2y y) x y))
(:smooth-curve-to :quadratic-bezier-curve-to)
(let [{:keys [cx cy]} params]
(join-params cx cy x y))
:elliptical-arc
(let [{:keys [rx ry x-axis-rotation large-arc-flag sweep-flag]} params]
(join-params rx ry x-axis-rotation large-arc-flag sweep-flag x y))
""))
(defn- translate-command
[cname]
(case cname
:move-to "M"
:close-path "Z"
:line-to "L"
:line-to-horizontal "H"
:line-to-vertical "V"
:curve-to "C"
:smooth-curve-to "S"
:quadratic-bezier-curve-to "Q"
:smooth-quadratic-bezier-curve-to "T"
:elliptical-arc "A"
""))
(defn- command->string
[{:keys [command relative params]}]
(let [cmd (cond-> (translate-command command)
relative (.toLowerCase))
prm (translate-params command params)]
(js* "~{} + ~{}" cmd prm)))
(defn- set-point
[command {:keys [x y]}]
(update command :params assoc :x x :y y))
(defn format-path [content]
(try
(let [result (make-array (count content))]
(reduce (fn [last-move current]
(let [point (upc/command->point current)
current-move? (= :move-to (:command current))
last-move (if current-move? point last-move)]
(if (and (not current-move?) (pt= last-move point))
(arr/conj! result (command->string (set-point current last-move)))
(arr/conj! result (command->string current)))
(when (and (not current-move?) (pt= last-move point))
(arr/conj! result "Z"))
last-move))
nil
content)
(.join ^js result ""))
(catch :default err
(.error js/console err)
nil)))

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

14
render-wasm/src/shapes/paths.rs
View File

@ -14,26 +14,26 @@ pub struct RawPathData {
impl RawPathData {
fn command(&self) -> Result<u16, String> {
let cmd = u16::from_be_bytes(self.data[0..2].try_into().map_err(stringify_slice_err)?);
let cmd = u16::from_le_bytes(self.data[0..2].try_into().map_err(stringify_slice_err)?);
Ok(cmd)
}
fn xy(&self) -> Result<Point, String> {
let x = f32::from_be_bytes(self.data[20..24].try_into().map_err(stringify_slice_err)?);
let y = f32::from_be_bytes(self.data[24..].try_into().map_err(stringify_slice_err)?);
let x = f32::from_le_bytes(self.data[20..24].try_into().map_err(stringify_slice_err)?);
let y = f32::from_le_bytes(self.data[24..].try_into().map_err(stringify_slice_err)?);
Ok((x, y))
}
fn c1(&self) -> Result<Point, String> {
let c1_x = f32::from_be_bytes(self.data[4..8].try_into().map_err(stringify_slice_err)?);
let c1_y = f32::from_be_bytes(self.data[8..12].try_into().map_err(stringify_slice_err)?);
let c1_x = f32::from_le_bytes(self.data[4..8].try_into().map_err(stringify_slice_err)?);
let c1_y = f32::from_le_bytes(self.data[8..12].try_into().map_err(stringify_slice_err)?);
Ok((c1_x, c1_y))
}
fn c2(&self) -> Result<Point, String> {
let c2_x = f32::from_be_bytes(self.data[12..16].try_into().map_err(stringify_slice_err)?);
let c2_y = f32::from_be_bytes(self.data[16..20].try_into().map_err(stringify_slice_err)?);
let c2_x = f32::from_le_bytes(self.data[12..16].try_into().map_err(stringify_slice_err)?);
let c2_y = f32::from_le_bytes(self.data[16..20].try_into().map_err(stringify_slice_err)?);
Ok((c2_x, c2_y))
}