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

Merge pull request #1378 from penpot/performance

Browse source 
Performance Improvements
This commit is contained in:
Andrey Antukh 2021-12-01 14:43:43 +01:00 • committed by GitHub
commit 95717c4c32
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
34 changed files with 738 additions and 519 deletions
Download patch file Download diff file Expand all files Collapse all files

7
common/src/app/common/data.cljc
View file

@ -157,7 +157,7 @@
"Return a map without the keys provided "Return a map without the keys provided
in the `keys` parameter." in the `keys` parameter."
[data keys] [data keys]
(when data (when (map? data)
(persistent! (persistent!
(reduce #(dissoc! %1 %2) (transient data) keys)))) (reduce #(dissoc! %1 %2) (transient data) keys))))
@ -252,6 +252,11 @@
#?(:clj (Object.) #?(:clj (Object.)
:cljs (js/Object.))) :cljs (js/Object.)))
(defn getf
"Returns a function to access a map"
[coll]
(partial get coll))
(defn update-in-when (defn update-in-when
[m key-seq f & args] [m key-seq f & args]
(let [found (get-in m key-seq sentinel)] (let [found (get-in m key-seq sentinel)]

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

@ -56,8 +56,7 @@
rotation of each shape. Mainly used for multiple selection." rotation of each shape. Mainly used for multiple selection."
[shapes] [shapes]
(->> shapes (->> shapes
(gtr/transform-shape) (map (comp gpr/points->selrect :points gtr/transform-shape))
(map (comp gpr/points->selrect :points))
(gpr/join-selrects))) (gpr/join-selrects)))
(defn translate-to-frame (defn translate-to-frame
@ -150,6 +149,7 @@
(d/export gpr/points->rect) (d/export gpr/points->rect)
(d/export gpr/center->rect) (d/export gpr/center->rect)
(d/export gpr/join-rects) (d/export gpr/join-rects)
(d/export gpr/contains-selrect?)
(d/export gtr/move) (d/export gtr/move)
(d/export gtr/absolute-move) (d/export gtr/absolute-move)
@ -163,6 +163,7 @@
(d/export gtr/rotation-modifiers) (d/export gtr/rotation-modifiers)
(d/export gtr/merge-modifiers) (d/export gtr/merge-modifiers)
(d/export gtr/transform-shape) (d/export gtr/transform-shape)
(d/export gtr/calc-transformed-parent-rect)
(d/export gtr/calc-child-modifiers) (d/export gtr/calc-child-modifiers)
;; PATHS ;; PATHS

8
common/src/app/common/geom/shapes/rect.cljc
View file

@ -121,3 +121,11 @@
(or (< px x2) (s= px x2)) (or (< px x2) (s= px x2))
(or (> py y1) (s= py y1)) (or (> py y1) (s= py y1))
(or (< py y2) (s= py y2))))) (or (< py y2) (s= py y2)))))
(defn contains-selrect?
"Check if a selrect sr2 is contained inside sr1"
[sr1 sr2]
(and (>= (:x1 sr2) (:x1 sr1))
(<= (:x2 sr2) (:x2 sr1))
(>= (:y1 sr2) (:y1 sr1))
(<= (:y2 sr2) (:y2 sr1))))

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

@ -154,11 +154,12 @@
(defn transform-point-center (defn transform-point-center
"Transform a point around the shape center" "Transform a point around the shape center"
[point center matrix] [point center matrix]
(gpt/transform (when point
point (gpt/transform
(gmt/multiply (gmt/translate-matrix center) point
matrix (gmt/multiply (gmt/translate-matrix center)
(gmt/translate-matrix (gpt/negate center))))) matrix
(gmt/translate-matrix (gpt/negate center))))))
(defn transform-rect (defn transform-rect
"Transform a rectangles and changes its attributes" "Transform a rectangles and changes its attributes"
@ -220,6 +221,7 @@
"Given a new set of points transformed, set up the rectangle so it keeps "Given a new set of points transformed, set up the rectangle so it keeps
its properties. We adjust de x,y,width,height and create a custom transform" its properties. We adjust de x,y,width,height and create a custom transform"
[shape transform round-coords?] [shape transform round-coords?]
;; FIXME: Improve performance
(let [points (-> shape :points (gco/transform-points transform)) (let [points (-> shape :points (gco/transform-points transform))
center (gco/center-points points) center (gco/center-points points)
@ -342,6 +344,9 @@
;; tells if the resize vectors must be applied to text shapes ;; tells if the resize vectors must be applied to text shapes
;; or not. ;; or not.
(defn empty-modifiers? [modifiers]
(empty? (dissoc modifiers :ignore-geometry?)))
(defn resize-modifiers (defn resize-modifiers
[shape attr value] [shape attr value]
(us/assert map? shape) (us/assert map? shape)
@ -385,7 +390,7 @@
{:rotation angle {:rotation angle
:displacement displacement})) :displacement displacement}))
(defn merge-modifiers (defn merge-modifiers*
[objects modifiers] [objects modifiers]
(let [set-modifier (let [set-modifier
@ -395,6 +400,8 @@
(->> modifiers (->> modifiers
(reduce set-modifier objects)))) (reduce set-modifier objects))))
(def merge-modifiers (memoize merge-modifiers*))
(defn- modifiers->transform (defn- modifiers->transform
[center modifiers] [center modifiers]
(let [ds-modifier (:displacement modifiers (gmt/matrix)) (let [ds-modifier (:displacement modifiers (gmt/matrix))
@ -463,7 +470,7 @@
modifiers (dissoc modifiers :displacement)] modifiers (dissoc modifiers :displacement)]
(-> shape (-> shape
(assoc :modifiers modifiers) (assoc :modifiers modifiers)
(cond-> (empty? modifiers) (cond-> (empty-modifiers? modifiers)
(dissoc :modifiers)))) (dissoc :modifiers))))
shape))) shape)))
@ -485,205 +492,234 @@
%))) %)))
shape)) shape))
(defn -transform-shape
[shape {:keys [round-coords?]
:or {round-coords? true}}]
(if (and (contains? shape :modifiers) (empty-modifiers? (:modifiers shape)))
(dissoc shape :modifiers)
(let [shape (apply-displacement shape)
center (gco/center-shape shape)
modifiers (:modifiers shape)]
(if (and (not (empty-modifiers? modifiers)) center)
(let [transform (modifiers->transform center modifiers)]
(-> shape
(set-flip modifiers)
(apply-transform transform round-coords?)
(apply-text-resize modifiers)
(dissoc :modifiers)))
shape))))
(def transform-shape* (memoize -transform-shape))
(defn transform-shape (defn transform-shape
([shape] ([shape]
(transform-shape shape nil)) (transform-shape* shape nil))
([shape options]
(transform-shape* shape options)))
([shape {:keys [round-coords?] (defn calc-transformed-parent-rect
:or {round-coords? true}}] [{:keys [selrect] :as shape} {:keys [displacement resize-transform-inverse resize-vector resize-origin resize-vector-2 resize-origin-2]}]
(let [shape (apply-displacement shape)
center (gco/center-shape shape) (let [resize-transform-inverse (or resize-transform-inverse (gmt/matrix))
modifiers (:modifiers shape)]
(if (and modifiers center) displacement
(let [transform (modifiers->transform center modifiers)] (when (some? displacement)
(-> shape (-> (gpt/point 0 0)
(set-flip modifiers) (gpt/transform displacement)
(apply-transform transform round-coords?) (gpt/transform resize-transform-inverse)
(apply-text-resize modifiers) (gmt/translate-matrix)))
(dissoc :modifiers)))
shape)))) resize-origin
(when (some? resize-origin)
(transform-point-center resize-origin (gco/center-shape shape) resize-transform-inverse))
resize-origin-2
(when (some? resize-origin-2)
(transform-point-center resize-origin-2 (gco/center-shape shape) resize-transform-inverse))]
(if (and (nil? displacement) (nil? resize-origin) (nil? resize-origin-2))
selrect
(cond-> selrect
:always
(gpr/rect->points)
(some? displacement)
(gco/transform-points displacement)
(some? resize-origin)
(gco/transform-points resize-origin (gmt/scale-matrix resize-vector))
(some? resize-origin-2)
(gco/transform-points resize-origin-2 (gmt/scale-matrix resize-vector-2))
:always
(gpr/points->selrect)))))
(defn calc-child-modifiers (defn calc-child-modifiers
"Given the modifiers to apply to the parent, calculate the corresponding "Given the modifiers to apply to the parent, calculate the corresponding
modifiers for the child, depending on the child constraints." modifiers for the child, depending on the child constraints."
[parent child parent-modifiers ignore-constraints] ([parent child parent-modifiers ignore-constraints]
(let [parent-rect (:selrect parent) (let [transformed-parent-rect (calc-transformed-parent-rect parent parent-modifiers )]
child-rect (:selrect child) (calc-child-modifiers parent child parent-modifiers ignore-constraints transformed-parent-rect)))
;; Apply the modifiers to the parent's selrect, to check the difference with ([parent child parent-modifiers ignore-constraints transformed-parent-rect]
;; the original, and calculate child transformations from this. (let [parent-rect (:selrect parent)
;; child-rect (:selrect child)
;; Note that a shape's selrect is always "horizontal" (i.e. without applying
;; the shape transform, that may include some rotation and skew). Thus, to
;; apply the modifiers, we first apply to them the transform-inverse.
parent-displacement (-> (gpt/point 0 0)
(gpt/transform (get parent-modifiers :displacement (gmt/matrix)))
(gpt/transform (:resize-transform-inverse parent-modifiers (gmt/matrix)))
(gmt/translate-matrix))
parent-origin (-> (:resize-origin parent-modifiers)
((d/nilf transform-point-center)
(gco/center-shape parent)
(:resize-transform-inverse parent-modifiers (gmt/matrix))))
parent-origin-2 (-> (:resize-origin-2 parent-modifiers)
((d/nilf transform-point-center)
(gco/center-shape parent)
(:resize-transform-inverse parent-modifiers (gmt/matrix))))
parent-vector (get parent-modifiers :resize-vector (gpt/point 1 1))
parent-vector-2 (get parent-modifiers :resize-vector-2 (gpt/point 1 1))
transformed-parent-rect (-> parent-rect ;; Apply the modifiers to the parent's selrect, to check the difference with
(gpr/rect->points) ;; the original, and calculate child transformations from this.
(gco/transform-points parent-displacement) ;;
(gco/transform-points parent-origin (gmt/scale-matrix parent-vector)) ;; Note that a shape's selrect is always "horizontal" (i.e. without applying
(gco/transform-points parent-origin-2 (gmt/scale-matrix parent-vector-2)) ;; the shape transform, that may include some rotation and skew). Thus, to
(gpr/points->selrect)) ;; apply the modifiers, we first apply to them the transform-inverse.
;; Calculate the modifiers in the horizontal and vertical directions ;; Calculate the modifiers in the horizontal and vertical directions
;; depending on the child constraints. ;; depending on the child constraints.
constraints-h (if-not ignore-constraints constraints-h (if-not ignore-constraints
(get child :constraints-h (spec/default-constraints-h child)) (get child :constraints-h (spec/default-constraints-h child))
:scale) :scale)
constraints-v (if-not ignore-constraints constraints-v (if-not ignore-constraints
(get child :constraints-v (spec/default-constraints-v child)) (get child :constraints-v (spec/default-constraints-v child))
:scale) :scale)
modifiers-h (case constraints-h modifiers-h (case constraints-h
:left :left
(let [delta-left (- (:x1 transformed-parent-rect) (:x1 parent-rect))] (let [delta-left (- (:x1 transformed-parent-rect) (:x1 parent-rect))]
(if-not (mth/almost-zero? delta-left) (if-not (mth/almost-zero? delta-left)
{:displacement (gpt/point delta-left 0)} ;; we convert to matrix below {:displacement (gpt/point delta-left 0)} ;; we convert to matrix below
{})) {}))
:right :right
(let [delta-right (- (:x2 transformed-parent-rect) (:x2 parent-rect))] (let [delta-right (- (:x2 transformed-parent-rect) (:x2 parent-rect))]
(if-not (mth/almost-zero? delta-right) (if-not (mth/almost-zero? delta-right)
{:displacement (gpt/point delta-right 0)} {:displacement (gpt/point delta-right 0)}
{})) {}))
:leftright :leftright
(let [delta-left (- (:x1 transformed-parent-rect) (:x1 parent-rect)) (let [delta-left (- (:x1 transformed-parent-rect) (:x1 parent-rect))
delta-width (- (:width transformed-parent-rect) (:width parent-rect))] delta-width (- (:width transformed-parent-rect) (:width parent-rect))]
(if (or (not (mth/almost-zero? delta-left)) (if (or (not (mth/almost-zero? delta-left))
(not (mth/almost-zero? delta-width))) (not (mth/almost-zero? delta-width)))
{:displacement (gpt/point delta-left 0) {:displacement (gpt/point delta-left 0)
:resize-origin (-> (gpt/point (+ (:x1 child-rect) delta-left) :resize-origin (-> (gpt/point (+ (:x1 child-rect) delta-left)
(:y1 child-rect)) (:y1 child-rect))
(transform-point-center (transform-point-center
(gco/center-rect child-rect) (gco/center-rect child-rect)
(:transform child (gmt/matrix)))) (:transform child (gmt/matrix))))
:resize-vector (gpt/point (/ (+ (:width child-rect) delta-width) :resize-vector (gpt/point (/ (+ (:width child-rect) delta-width)
(:width child-rect)) 1)} (:width child-rect)) 1)}
{})) {}))
:center :center
(let [parent-center (gco/center-rect parent-rect) (let [parent-center (gco/center-rect parent-rect)
transformed-parent-center (gco/center-rect transformed-parent-rect) transformed-parent-center (gco/center-rect transformed-parent-rect)
delta-center (- (:x transformed-parent-center) (:x parent-center))] delta-center (- (:x transformed-parent-center) (:x parent-center))]
(if-not (mth/almost-zero? delta-center) (if-not (mth/almost-zero? delta-center)
{:displacement (gpt/point delta-center 0)} {:displacement (gpt/point delta-center 0)}
{})) {}))
:scale :scale
(cond-> {} (cond-> {}
(and (:resize-vector parent-modifiers) (and (:resize-vector parent-modifiers)
(not (mth/close? (:x (:resize-vector parent-modifiers)) 1))) (not (mth/close? (:x (:resize-vector parent-modifiers)) 1)))
(assoc :resize-origin (:resize-origin parent-modifiers) (assoc :resize-origin (:resize-origin parent-modifiers)
:resize-vector (gpt/point (:x (:resize-vector parent-modifiers)) 1)) :resize-vector (gpt/point (:x (:resize-vector parent-modifiers)) 1))
;; resize-vector-2 is always for vertical modifiers, so no need to ;; resize-vector-2 is always for vertical modifiers, so no need to
;; check it here. ;; check it here.
(:displacement parent-modifiers) (:displacement parent-modifiers)
(assoc :displacement (assoc :displacement
(gpt/point (-> (gpt/point 0 0) (gpt/point (-> (gpt/point 0 0)
(gpt/transform (:displacement parent-modifiers)) (gpt/transform (:displacement parent-modifiers))
(gpt/transform (:resize-transform-inverse parent-modifiers (gmt/matrix))) (gpt/transform (:resize-transform-inverse parent-modifiers (gmt/matrix)))
(:x)) (:x))
0))) 0)))
{}) {})
modifiers-v (case constraints-v modifiers-v (case constraints-v
:top :top
(let [delta-top (- (:y1 transformed-parent-rect) (:y1 parent-rect))] (let [delta-top (- (:y1 transformed-parent-rect) (:y1 parent-rect))]
(if-not (mth/almost-zero? delta-top) (if-not (mth/almost-zero? delta-top)
{:displacement (gpt/point 0 delta-top)} ;; we convert to matrix below {:displacement (gpt/point 0 delta-top)} ;; we convert to matrix below
{})) {}))
:bottom :bottom
(let [delta-bottom (- (:y2 transformed-parent-rect) (:y2 parent-rect))] (let [delta-bottom (- (:y2 transformed-parent-rect) (:y2 parent-rect))]
(if-not (mth/almost-zero? delta-bottom) (if-not (mth/almost-zero? delta-bottom)
{:displacement (gpt/point 0 delta-bottom)} {:displacement (gpt/point 0 delta-bottom)}
{})) {}))
:topbottom :topbottom
(let [delta-top (- (:y1 transformed-parent-rect) (:y1 parent-rect)) (let [delta-top (- (:y1 transformed-parent-rect) (:y1 parent-rect))
delta-height (- (:height transformed-parent-rect) (:height parent-rect))] delta-height (- (:height transformed-parent-rect) (:height parent-rect))]
(if (or (not (mth/almost-zero? delta-top)) (if (or (not (mth/almost-zero? delta-top))
(not (mth/almost-zero? delta-height))) (not (mth/almost-zero? delta-height)))
{:displacement (gpt/point 0 delta-top) {:displacement (gpt/point 0 delta-top)
:resize-origin (-> (gpt/point (:x1 child-rect) :resize-origin (-> (gpt/point (:x1 child-rect)
(+ (:y1 child-rect) delta-top)) (+ (:y1 child-rect) delta-top))
(transform-point-center (transform-point-center
(gco/center-rect child-rect) (gco/center-rect child-rect)
(:transform child (gmt/matrix)))) (:transform child (gmt/matrix))))
:resize-vector (gpt/point 1 (/ (+ (:height child-rect) delta-height) :resize-vector (gpt/point 1 (/ (+ (:height child-rect) delta-height)
(:height child-rect)))} (:height child-rect)))}
{})) {}))
:center :center
(let [parent-center (gco/center-rect parent-rect) (let [parent-center (gco/center-rect parent-rect)
transformed-parent-center (gco/center-rect transformed-parent-rect) transformed-parent-center (gco/center-rect transformed-parent-rect)
delta-center (- (:y transformed-parent-center) (:y parent-center))] delta-center (- (:y transformed-parent-center) (:y parent-center))]
(if-not (mth/almost-zero? delta-center) (if-not (mth/almost-zero? delta-center)
{:displacement (gpt/point 0 delta-center)} {:displacement (gpt/point 0 delta-center)}
{})) {}))
:scale :scale
(cond-> {} (cond-> {}
(and (:resize-vector parent-modifiers) (and (:resize-vector parent-modifiers)
(not (mth/close? (:y (:resize-vector parent-modifiers)) 1))) (not (mth/close? (:y (:resize-vector parent-modifiers)) 1)))
(assoc :resize-origin (:resize-origin parent-modifiers) (assoc :resize-origin (:resize-origin parent-modifiers)
:resize-vector (gpt/point 1 (:y (:resize-vector parent-modifiers)))) :resize-vector (gpt/point 1 (:y (:resize-vector parent-modifiers))))
;; If there is a resize-vector-2, this means that we come from a recursive ;; If there is a resize-vector-2, this means that we come from a recursive
;; call, and the resize-vector has no vertical data, so we may override it. ;; call, and the resize-vector has no vertical data, so we may override it.
(and (:resize-vector-2 parent-modifiers) (and (:resize-vector-2 parent-modifiers)
(not (mth/close? (:y (:resize-vector-2 parent-modifiers)) 1))) (not (mth/close? (:y (:resize-vector-2 parent-modifiers)) 1)))
(assoc :resize-origin (:resize-origin-2 parent-modifiers) (assoc :resize-origin (:resize-origin-2 parent-modifiers)
:resize-vector (gpt/point 1 (:y (:resize-vector-2 parent-modifiers)))) :resize-vector (gpt/point 1 (:y (:resize-vector-2 parent-modifiers))))
(:displacement parent-modifiers) (:displacement parent-modifiers)
(assoc :displacement (assoc :displacement
(gpt/point 0 (-> (gpt/point 0 0) (gpt/point 0 (-> (gpt/point 0 0)
(gpt/transform (:displacement parent-modifiers)) (gpt/transform (:displacement parent-modifiers))
(gpt/transform (:resize-transform-inverse parent-modifiers (gmt/matrix))) (gpt/transform (:resize-transform-inverse parent-modifiers (gmt/matrix)))
(:y))))) (:y)))))
{})] {})]
;; Build final child modifiers. Apply transform again to the result, to get the ;; Build final child modifiers. Apply transform again to the result, to get the
;; real modifiers that need to be applied to the child, including rotation as needed. ;; real modifiers that need to be applied to the child, including rotation as needed.
(cond-> {} (cond-> {}
(or (:displacement modifiers-h) (:displacement modifiers-v)) (or (:displacement modifiers-h) (:displacement modifiers-v))
(assoc :displacement (gmt/translate-matrix (assoc :displacement (gmt/translate-matrix
(-> (gpt/point (get (:displacement modifiers-h) :x 0) (-> (gpt/point (get (:displacement modifiers-h) :x 0)
(get (:displacement modifiers-v) :y 0)) (get (:displacement modifiers-v) :y 0))
(gpt/transform (gpt/transform
(:resize-transform parent-modifiers (gmt/matrix)))))) (:resize-transform parent-modifiers (gmt/matrix))))))
(:resize-vector modifiers-h) (:resize-vector modifiers-h)
(assoc :resize-origin (:resize-origin modifiers-h) (assoc :resize-origin (:resize-origin modifiers-h)
:resize-vector (gpt/point (get (:resize-vector modifiers-h) :x 1) :resize-vector (gpt/point (get (:resize-vector modifiers-h) :x 1)
(get (:resize-vector modifiers-h) :y 1))) (get (:resize-vector modifiers-h) :y 1)))
(:resize-vector modifiers-v) (:resize-vector modifiers-v)
(assoc :resize-origin-2 (:resize-origin modifiers-v) (assoc :resize-origin-2 (:resize-origin modifiers-v)
:resize-vector-2 (gpt/point (get (:resize-vector modifiers-v) :x 1) :resize-vector-2 (gpt/point (get (:resize-vector modifiers-v) :x 1)
(get (:resize-vector modifiers-v) :y 1))) (get (:resize-vector modifiers-v) :y 1)))
(:resize-transform parent-modifiers) (:resize-transform parent-modifiers)
(assoc :resize-transform (:resize-transform parent-modifiers) (assoc :resize-transform (:resize-transform parent-modifiers)
:resize-transform-inverse (:resize-transform-inverse parent-modifiers))))) :resize-transform-inverse (:resize-transform-inverse parent-modifiers))))))
(defn selection-rect (defn selection-rect

1
common/src/app/common/pages.cljc
View file

@ -69,6 +69,7 @@
(d/export helpers/compact-path) (d/export helpers/compact-path)
(d/export helpers/compact-name) (d/export helpers/compact-name)
(d/export helpers/unframed-shape?) (d/export helpers/unframed-shape?)
(d/export helpers/children-seq)
;; Indices ;; Indices
(d/export indices/calculate-z-index) (d/export indices/calculate-z-index)

6
common/src/app/common/pages/changes.cljc
View file

@ -40,7 +40,9 @@
(defmulti process-operation (fn [_ op] (:type op))) (defmulti process-operation (fn [_ op] (:type op)))
(defn process-changes (defn process-changes
([data items] (process-changes data items true)) ([data items]
(process-changes data items true))
([data items verify?] ([data items verify?]
;; When verify? false we spec the schema validation. Currently used to make just ;; When verify? false we spec the schema validation. Currently used to make just
;; 1 validation even if the changes are applied twice ;; 1 validation even if the changes are applied twice
@ -152,6 +154,7 @@
;; reg-objects operation "regenerates" the geometry and selrect of the parent groups ;; reg-objects operation "regenerates" the geometry and selrect of the parent groups
(defmethod process-change :reg-objects (defmethod process-change :reg-objects
[data {:keys [page-id component-id shapes]}] [data {:keys [page-id component-id shapes]}]
;; FIXME: Improve performance
(letfn [(reg-objects [objects] (letfn [(reg-objects [objects]
(reduce #(d/update-when %1 %2 update-group %1) objects (reduce #(d/update-when %1 %2 update-group %1) objects
(sequence (comp (sequence (comp
@ -469,4 +472,3 @@
(ex/raise :type :not-implemented (ex/raise :type :not-implemented
:code :operation-not-implemented :code :operation-not-implemented
:context {:type (:type op)})) :context {:type (:type op)}))

16
common/src/app/common/pages/helpers.cljc
View file

@ -99,7 +99,7 @@
(get-in component [:objects (:id component)])) (get-in component [:objects (:id component)]))
;; Implemented with transient for performance ;; Implemented with transient for performance
(defn get-children (defn get-children*
"Retrieve all children ids recursively for a given object. The "Retrieve all children ids recursively for a given object. The
children's order will be breadth first." children's order will be breadth first."
[id objects] [id objects]
@ -128,6 +128,8 @@
(recur result (pop! pending) next)) (recur result (pop! pending) next))
(persistent! result))))) (persistent! result)))))
(def get-children (memoize get-children*))
(defn get-children-objects (defn get-children-objects
"Retrieve all children objects recursively for a given object" "Retrieve all children objects recursively for a given object"
[id objects] [id objects]
@ -172,9 +174,10 @@
shape shape
(get objects (:frame-id shape)))) (get objects (:frame-id shape))))
(defn clean-loops (defn clean-loops*
"Clean a list of ids from circular references." "Clean a list of ids from circular references."
[objects ids] [objects ids]
(let [parent-selected? (let [parent-selected?
(fn [id] (fn [id]
(let [parents (get-parents id objects)] (let [parents (get-parents id objects)]
@ -188,6 +191,8 @@
(reduce add-element (d/ordered-set) ids))) (reduce add-element (d/ordered-set) ids)))
(def clean-loops (memoize clean-loops*))
(defn calculate-invalid-targets (defn calculate-invalid-targets
[shape-id objects] [shape-id objects]
(let [result #{shape-id} (let [result #{shape-id}
@ -494,3 +499,10 @@
(and (not= (:type shape) :frame) (and (not= (:type shape) :frame)
(= (:frame-id shape) uuid/zero))) (= (:frame-id shape) uuid/zero)))
(defn children-seq
"Creates a sequence of shapes through the objects tree"
[shape objects]
(let [getter (partial get objects)]
(tree-seq #(d/not-empty? (get shape :shapes))
#(->> (get % :shapes) (map getter))
shape)))

26
common/src/app/common/pages/spec.cljc
View file

@ -256,6 +256,25 @@
(s/def :internal.shape/transform ::matrix) (s/def :internal.shape/transform ::matrix)
(s/def :internal.shape/transform-inverse ::matrix) (s/def :internal.shape/transform-inverse ::matrix)
(s/def :internal.shape/opacity ::us/safe-number)
(s/def :internal.shape/blend-mode
#{:normal
:darken
:multiply
:color-burn
:lighten
:screen
:color-dodge
:overlay
:soft-light
:hard-light
:difference
:exclusion
:hue
:saturation
:color
:luminosity})
(s/def ::shape-attrs (s/def ::shape-attrs
(s/keys :opt-un [:internal.shape/selrect (s/keys :opt-un [:internal.shape/selrect
:internal.shape/points :internal.shape/points
@ -307,7 +326,9 @@
::cti/interactions ::cti/interactions
:internal.shape/masked-group? :internal.shape/masked-group?
:internal.shape/shadow :internal.shape/shadow
:internal.shape/blur])) :internal.shape/blur
:internal.shape/opacity
:internal.shape/blend-mode]))
;; shapes-group is handled differently ;; shapes-group is handled differently
@ -317,7 +338,8 @@
:opt-un [::id])) :opt-un [::id]))
(s/def ::shape (s/def ::shape
(s/and ::minimal-shape ::shape-attrs (s/and ::minimal-shape
::shape-attrs
(s/keys :opt-un [::id (s/keys :opt-un [::id
::component-id ::component-id
::component-file ::component-file

21
common/src/app/common/perf.cljc Normal file
View file

@ -0,0 +1,21 @@
(ns app.common.perf
(:require
[app.common.uuid :as uuid]))
(defn timestamp []
#?(:cljs (js/performance.now)
:clj (. System (nanoTime))))
(defonce measures (atom {}))
(defn start
([]
(start (uuid/next)))
([key]
(swap! measures assoc key (timestamp))
key))
(defn measure
[key]
(- (timestamp) (get @measures key)))

8
frontend/resources/styles/main/partials/modal.scss
View file

@ -334,13 +334,15 @@
color: $color-black; color: $color-black;
.file-name-label { .file-name-label {
flex: 1;
white-space: nowrap;
display: flex;
align-items: center; align-items: center;
flex: 1;
height: 2rem; height: 2rem;
margin-left: -0.25rem; margin-left: -0.25rem;
overflow: hidden;
padding-left: 0.25rem; padding-left: 0.25rem;
padding-top: 0.25rem;
text-overflow: ellipsis;
white-space: nowrap;
.icon-library { .icon-library {
width: 14px; width: 14px;

1
frontend/resources/styles/main/partials/sidebar-element-options.scss
View file

@ -8,6 +8,7 @@
display: flex; display: flex;
flex-direction: column; flex-direction: column;
width: 100%; width: 100%;
height: 100%;
.element-icons { .element-icons {
background-color: $color-gray-60; background-color: $color-gray-60;

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

@ -23,6 +23,7 @@
[app.util.i18n :as i18n] [app.util.i18n :as i18n]
[app.util.theme :as theme] [app.util.theme :as theme]
[beicon.core :as rx] [beicon.core :as rx]
[debug]
[potok.core :as ptk] [potok.core :as ptk]
[rumext.alpha :as mf])) [rumext.alpha :as mf]))

2
frontend/src/app/main/data/workspace/libraries_helpers.cljs
View file

@ -506,7 +506,7 @@
(let [typographies (get-assets library-id :typographies state) (let [typographies (get-assets library-id :typographies state)
update-node (fn [node] update-node (fn [node]
(if-let [typography (get typographies (:typography-ref-id node))] (if-let [typography (get typographies (:typography-ref-id node))]
(merge node (d/without-keys typography [:name :id])) (merge node (dissoc typography :name :id))
(dissoc node :typography-ref-id (dissoc node :typography-ref-id
:typography-ref-file)))] :typography-ref-file)))]
(generate-sync-text-shape shape container update-node))) (generate-sync-text-shape shape container update-node)))

54
frontend/src/app/main/data/workspace/selection.cljs
View file

@ -65,27 +65,33 @@
(watch [_ state stream] (watch [_ state stream]
(let [zoom (get-in state [:workspace-local :zoom] 1) (let [zoom (get-in state [:workspace-local :zoom] 1)
stop? (fn [event] (or (dwc/interrupt? event) (ms/mouse-up? event))) stop? (fn [event] (or (dwc/interrupt? event) (ms/mouse-up? event)))
stoper (->> stream (rx/filter stop?))] stoper (->> stream (rx/filter stop?))
calculate-selrect
(fn [data pos]
(if data
(assoc data :stop pos)
{:start pos :stop pos}))
selrect-stream
(->> ms/mouse-position
(rx/scan calculate-selrect nil)
(rx/map data->selrect)
(rx/filter #(or (> (:width %) (/ 10 zoom))
(> (:height %) (/ 10 zoom))))
(rx/take-until stoper))]
(rx/concat (rx/concat
(when-not preserve? (if preserve?
(rx/of (deselect-all))) (rx/empty)
(->> ms/mouse-position (rx/of (deselect-all)))
(rx/scan (fn [data pos]
(if data
(assoc data :stop pos)
{:start pos :stop pos}))
nil)
(rx/map data->selrect)
(rx/filter #(or (> (:width %) (/ 10 zoom))
(> (:height %) (/ 10 zoom))))
(rx/flat-map (rx/merge
(fn [selrect] (->> selrect-stream (rx/map update-selrect))
(rx/of (update-selrect selrect) (->> selrect-stream
(select-shapes-by-current-selrect preserve?)))) (rx/debounce 50)
(rx/map #(select-shapes-by-current-selrect preserve?))))
(rx/take-until stoper)) (rx/of (update-selrect nil))))))))
(rx/of (update-selrect nil))))))))
;; --- Toggle shape's selection status (selected or deselected) ;; --- Toggle shape's selection status (selected or deselected)
@ -221,11 +227,13 @@
selrect (get-in state [:workspace-local :selrect]) selrect (get-in state [:workspace-local :selrect])
blocked? (fn [id] (get-in objects [id :blocked] false))] blocked? (fn [id] (get-in objects [id :blocked] false))]
(when selrect (when selrect
(->> (uw/ask! {:cmd :selection/query (rx/empty)
:page-id page-id (->> (uw/ask-buffered!
:rect selrect {:cmd :selection/query
:include-frames? true :page-id page-id
:full-frame? true}) :rect selrect
:include-frames? true
:full-frame? true})
(rx/map #(cp/clean-loops objects %)) (rx/map #(cp/clean-loops objects %))
(rx/map #(into initial-set (filter (comp not blocked?)) %)) (rx/map #(into initial-set (filter (comp not blocked?)) %))
(rx/map select-shapes))))))) (rx/map select-shapes)))))))

62
frontend/src/app/main/data/workspace/transforms.cljs
View file

@ -107,7 +107,6 @@
;; geometric attributes of the shapes. ;; geometric attributes of the shapes.
(declare set-modifiers-recursive) (declare set-modifiers-recursive)
(declare check-delta)
(declare set-local-displacement) (declare set-local-displacement)
(declare clear-local-transform) (declare clear-local-transform)
@ -195,34 +194,6 @@
(clear-local-transform) (clear-local-transform)
(dwu/commit-undo-transaction)))))) (dwu/commit-undo-transaction))))))
(defn- set-modifiers-recursive
[modif-tree objects shape modifiers root transformed-root ignore-constraints]
(let [children (->> (get shape :shapes [])
(map #(get objects %)))
transformed-shape (gsh/transform-shape (assoc shape :modifiers modifiers))
[root transformed-root ignore-geometry?]
(check-delta shape root transformed-shape transformed-root objects)
modifiers (assoc modifiers :ignore-geometry? ignore-geometry?)
set-child (fn [modif-tree child]
(let [child-modifiers (gsh/calc-child-modifiers shape
child
modifiers
ignore-constraints)]
(set-modifiers-recursive modif-tree
objects
child
child-modifiers
root
transformed-root
ignore-constraints)))]
(reduce set-child
(assoc-in modif-tree [(:id shape) :modifiers] modifiers)
children)))
(defn- check-delta (defn- check-delta
"If the shape is a component instance, check its relative position respect the "If the shape is a component instance, check its relative position respect the
root of the component, and see if it changes after applying a transformation." root of the component, and see if it changes after applying a transformation."
@ -257,6 +228,39 @@
[root transformed-root ignore-geometry?])) [root transformed-root ignore-geometry?]))
(defn- set-modifiers-recursive
[modif-tree objects shape modifiers root transformed-root ignore-constraints]
(let [children (map (d/getf objects) (:shapes shape))
transformed-shape (gsh/transform-shape (assoc shape :modifiers modifiers))
[root transformed-root ignore-geometry?]
(check-delta shape root transformed-shape transformed-root objects)
modifiers (assoc modifiers :ignore-geometry? ignore-geometry?)
transformed-rect (gsh/calc-transformed-parent-rect shape modifiers)
set-child
(fn [modif-tree child]
(let [child-modifiers
(gsh/calc-child-modifiers shape child modifiers ignore-constraints transformed-rect)]
(cond-> modif-tree
(d/not-empty? (d/without-keys child-modifiers [:ignore-geometry?]))
(set-modifiers-recursive objects
child
child-modifiers
root
transformed-root
ignore-constraints))))
modif-tree
(-> modif-tree
(assoc-in [(:id shape) :modifiers] modifiers))]
(reduce set-child modif-tree children)))
(defn- set-local-displacement [point] (defn- set-local-displacement [point]
(ptk/reify ::start-local-displacement (ptk/reify ::start-local-displacement
ptk/UpdateEvent ptk/UpdateEvent

20
frontend/src/app/main/refs.cljs
View file

@ -241,10 +241,11 @@
(fn [state] (fn [state]
(let [objects (wsh/lookup-page-objects state) (let [objects (wsh/lookup-page-objects state)
modifiers (:workspace-modifiers state) modifiers (:workspace-modifiers state)
;; FIXME: Improve performance
objects (cond-> objects objects (cond-> objects
with-modifiers? with-modifiers?
(gsh/merge-modifiers modifiers)) (gsh/merge-modifiers modifiers))
xform (comp (map #(get objects %)) xform (comp (map (d/getf objects))
(remove nil?))] (remove nil?))]
(into [] xform ids)))] (into [] xform ids)))]
(l/derived selector st/state =)))) (l/derived selector st/state =))))
@ -299,19 +300,10 @@
(def selected-shapes-with-children (def selected-shapes-with-children
(letfn [(selector [{:keys [selected objects]}] (letfn [(selector [{:keys [selected objects]}]
(let [children (->> selected (let [xform (comp (remove nil?)
(mapcat #(cp/get-children % objects)) (mapcat #(cp/get-children % objects)))
(filterv (comp not nil?)))] shapes (into selected xform selected)]
(into selected children)))] (mapv (d/getf objects) shapes)))]
(l/derived selector selected-data =)))
(def selected-objects-with-children
(letfn [(selector [{:keys [selected objects]}]
(let [children (->> selected
(mapcat #(cp/get-children % objects))
(filterv (comp not nil?)))
shapes (into selected children)]
(mapv #(get objects %) shapes)))]
(l/derived selector selected-data =))) (l/derived selector selected-data =)))
;; ---- Viewer refs ;; ---- Viewer refs

107
frontend/src/app/main/store.cljs
View file

@ -7,11 +7,7 @@
(ns app.main.store (ns app.main.store
(:require-macros [app.main.store]) (:require-macros [app.main.store])
(:require (:require
[app.common.data :as d]
[app.common.pages :as cp]
[app.util.debug :refer [debug? debug-exclude-events logjs]]
[beicon.core :as rx] [beicon.core :as rx]
[cuerdas.core :as str]
[okulary.core :as l] [okulary.core :as l]
[potok.core :as ptk])) [potok.core :as ptk]))
@ -42,14 +38,6 @@
buffer)) buffer))
(when *assert*
(defonce debug-subscription
(->> stream
(rx/filter ptk/event?)
(rx/filter (fn [s] (and (debug? :events)
(not (debug-exclude-events (ptk/type s))))))
(rx/subs #(println "[stream]: " (ptk/repr-event %))))))
(defn emit! (defn emit!
([] nil) ([] nil)
([event] ([event]
@ -63,99 +51,4 @@
[& events] [& events]
#(apply ptk/emit! state events)) #(apply ptk/emit! state events))
(defn ^:export dump-state []
(logjs "state" @state))
(defn ^:export dump-buffer []
(logjs "state" @last-events))
(defn ^:export get-state [str-path]
(let [path (->> (str/split str-path " ")
(map d/read-string))]
(clj->js (get-in @state path))))
(defn ^:export dump-objects []
(let [page-id (get @state :current-page-id)]
(logjs "state" (get-in @state [:workspace-data :pages-index page-id :objects]))))
(defn ^:export dump-object [name]
(let [page-id (get @state :current-page-id)
objects (get-in @state [:workspace-data :pages-index page-id :objects])
target (or (d/seek (fn [[_ shape]] (= name (:name shape))) objects)
(get objects (uuid name)))]
(->> target
(logjs "state"))))
(defn ^:export dump-tree
([] (dump-tree false false))
([show-ids] (dump-tree show-ids false))
([show-ids show-touched]
(let [page-id (get @state :current-page-id)
objects (get-in @state [:workspace-data :pages-index page-id :objects])
components (get-in @state [:workspace-data :components])
libraries (get @state :workspace-libraries)
root (d/seek #(nil? (:parent-id %)) (vals objects))]
(letfn [(show-shape [shape-id level objects]
(let [shape (get objects shape-id)]
(println (str/pad (str (str/repeat " " level)
(:name shape)
(when (seq (:touched shape)) "*")
(when show-ids (str/format " <%s>" (:id shape))))
{:length 20
:type :right})
(show-component shape objects))
(when show-touched
(when (seq (:touched shape))
(println (str (str/repeat " " level)
" "
(str (:touched shape)))))
(when (:remote-synced? shape)
(println (str (str/repeat " " level)
" (remote-synced)"))))
(when (:shapes shape)
(dorun (for [shape-id (:shapes shape)]
(show-shape shape-id (inc level) objects))))))
(show-component [shape objects]
(if (nil? (:shape-ref shape))
""
(let [root-shape (cp/get-component-shape shape objects)
component-id (when root-shape (:component-id root-shape))
component-file-id (when root-shape (:component-file root-shape))
component-file (when component-file-id (get libraries component-file-id nil))
component (when component-id
(if component-file
(get-in component-file [:data :components component-id])
(get components component-id)))
component-shape (when (and component (:shape-ref shape))
(get-in component [:objects (:shape-ref shape)]))]
(str/format " %s--> %s%s%s"
(cond (:component-root? shape) "#"
(:component-id shape) "@"
:else "-")
(when component-file (str/format "<%s> " (:name component-file)))
(or (:name component-shape) "?")
(if (or (:component-root? shape)
(nil? (:component-id shape))
true)
""
(let [component-id (:component-id shape)
component-file-id (:component-file shape)
component-file (when component-file-id (get libraries component-file-id nil))
component (if component-file
(get-in component-file [:data :components component-id])
(get components component-id))]
(str/format " (%s%s)"
(when component-file (str/format "<%s> " (:name component-file)))
(:name component))))))))]
(println "[Page]")
(show-shape (:id root) 0 objects)
(dorun (for [component (vals components)]
(do
(println)
(println (str/format "[%s]" (:name component)))
(show-shape (:id component) 0 (:objects component)))))))))

2
frontend/src/app/main/ui/shapes/export.cljs
View file

@ -133,7 +133,7 @@
[{:keys [grids]}] [{:keys [grids]}]
[:> "penpot:grids" #js {} [:> "penpot:grids" #js {}
(for [{:keys [type display params]} grids] (for [{:keys [type display params]} grids]
(let [props (->> (d/without-keys params [:color]) (let [props (->> (dissoc params :color)
(prefix-keys) (prefix-keys)
(clj->js))] (clj->js))]
[:> "penpot:grid" [:> "penpot:grid"

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

@ -28,8 +28,8 @@
[app.main.ui.workspace.shapes.path :as path] [app.main.ui.workspace.shapes.path :as path]
[app.main.ui.workspace.shapes.svg-raw :as svg-raw] [app.main.ui.workspace.shapes.svg-raw :as svg-raw]
[app.main.ui.workspace.shapes.text :as text] [app.main.ui.workspace.shapes.text :as text]
[app.util.debug :refer [debug?]]
[app.util.object :as obj] [app.util.object :as obj]
[debug :refer [debug?]]
[okulary.core :as l] [okulary.core :as l]
[rumext.alpha :as mf])) [rumext.alpha :as mf]))

50
frontend/src/app/main/ui/workspace/shapes/frame.cljs
View file

@ -8,12 +8,14 @@
(:require (:require
[app.common.geom.shapes :as gsh] [app.common.geom.shapes :as gsh]
[app.common.pages :as cp] [app.common.pages :as cp]
[app.main.ui.hooks :as hooks]
[app.main.ui.shapes.frame :as frame] [app.main.ui.shapes.frame :as frame]
[app.main.ui.shapes.shape :refer [shape-container]] [app.main.ui.shapes.shape :refer [shape-container]]
[app.main.ui.shapes.text.fontfaces :as ff] [app.main.ui.shapes.text.fontfaces :as ff]
[app.util.object :as obj] [app.util.object :as obj]
[app.util.timers :as ts] [app.util.timers :as ts]
[beicon.core :as rx] [beicon.core :as rx]
[debug :refer [debug?]]
[rumext.alpha :as mf])) [rumext.alpha :as mf]))
(defn check-frame-props (defn check-frame-props
@ -47,24 +49,46 @@
:width (:width shape) :width (:width shape)
:height (:height shape) :height (:height shape)
;; DEBUG ;; DEBUG
;; :style {:filter "sepia(1)"} :style {:filter (when (debug? :thumbnails) "sepia(1)")}}])))
}])))
(mf/defc frame-placeholder
{::mf/wrap-props false}
[props]
(let [{:keys [x y width height fill-color] :as shape} (obj/get props "shape")]
(if (some? (:thumbnail shape))
[:& thumbnail {:shape shape}]
[:rect {:x x :y y :width width :height height :style {:fill (or fill-color "var(--color-white)")}}])))
;; This custom deferred don't defer rendering when ghost rendering is
;; used.
(defn custom-deferred (defn custom-deferred
[component] [component]
(mf/fnc deferred (mf/fnc deferred
{::mf/wrap-props false} {::mf/wrap-props false}
[props] [props]
(let [tmp (mf/useState false) (let [shape (-> (obj/get props "shape")
(select-keys [:x :y :width :height])
(hooks/use-equal-memo))
tmp (mf/useState false)
^boolean render? (aget tmp 0) ^boolean render? (aget tmp 0)
^js set-render (aget tmp 1)] ^js set-render (aget tmp 1)
(mf/use-layout-effect prev-shape-ref (mf/use-ref shape)]
(mf/use-effect
(mf/deps shape)
(fn [] (fn []
(let [sem (ts/schedule-on-idle #(set-render true))] (mf/set-ref-val! prev-shape-ref shape)
#(rx/dispose! sem)))) (set-render false)))
(when render? (mf/create-element component props)))))
(mf/use-effect
(mf/deps render? shape)
(fn []
(when-not render?
(let [sem (ts/schedule-on-idle #(set-render true))]
#(rx/dispose! sem)))))
(if (and render? (= shape (mf/ref-val prev-shape-ref)))
(mf/create-element component props)
(mf/create-element frame-placeholder props)))))
(defn frame-wrapper-factory (defn frame-wrapper-factory
[shape-wrapper] [shape-wrapper]
@ -78,9 +102,11 @@
thumbnail? (unchecked-get props "thumbnail?") thumbnail? (unchecked-get props "thumbnail?")
shape (gsh/transform-shape shape) shape (gsh/transform-shape shape)
children (mapv #(get objects %) (:shapes shape)) children (-> (mapv #(get objects %) (:shapes shape))
(hooks/use-equal-memo))
all-children (cp/get-children-objects (:id shape) objects) all-children (-> (cp/get-children-objects (:id shape) objects)
(hooks/use-equal-memo))
rendered? (mf/use-state false) rendered? (mf/use-state false)

2
frontend/src/app/main/ui/workspace/sidebar/assets.cljs
View file

@ -1172,7 +1172,7 @@
attrs (merge attrs (merge
{:typography-ref-file file-id {:typography-ref-file file-id
:typography-ref-id (:id typography)} :typography-ref-id (:id typography)}
(d/without-keys typography [:id :name]))] (dissoc typography :id :name))]
(run! #(st/emit! (dwt/update-text-attrs {:id % :editor (get-in local [:editors %]) :attrs attrs})) (run! #(st/emit! (dwt/update-text-attrs {:id % :editor (get-in local [:editors %]) :attrs attrs}))
ids))) ids)))

9
frontend/src/app/main/ui/workspace/sidebar/layers.cljs
View file

@ -19,6 +19,7 @@
[app.util.keyboard :as kbd] [app.util.keyboard :as kbd]
[app.util.object :as obj] [app.util.object :as obj]
[app.util.timers :as ts] [app.util.timers :as ts]
[beicon.core :as rx]
[cuerdas.core :as str] [cuerdas.core :as str]
[okulary.core :as l] [okulary.core :as l]
[rumext.alpha :as mf])) [rumext.alpha :as mf]))
@ -205,8 +206,12 @@
(mf/use-effect (mf/use-effect
(mf/deps selected) (mf/deps selected)
(fn [] (fn []
(when (and (= (count selected) 1) selected?) (let [subid
(.scrollIntoView (mf/ref-val dref) #js {:block "nearest", :behavior "smooth"})))) (when (and (= (count selected) 1) selected?)
(ts/schedule-on-idle
#(.scrollIntoView (mf/ref-val dref) #js {:block "nearest", :behavior "smooth"})))]
#(when (some? subid)
(rx/dispose! subid)))))
[:li {:on-context-menu on-context-menu [:li {:on-context-menu on-context-menu
:ref dref :ref dref

2
frontend/src/app/main/ui/workspace/sidebar/options.cljs
View file

@ -92,7 +92,7 @@
page-id (mf/use-ctx ctx/current-page-id) page-id (mf/use-ctx ctx/current-page-id)
file-id (mf/use-ctx ctx/current-file-id) file-id (mf/use-ctx ctx/current-file-id)
shapes (mf/deref refs/selected-objects) shapes (mf/deref refs/selected-objects)
shapes-with-children (mf/deref refs/selected-objects-with-children)] shapes-with-children (mf/deref refs/selected-shapes-with-children)]
[:& options-content {:shapes shapes [:& options-content {:shapes shapes
:selected selected :selected selected
:shapes-with-children shapes-with-children :shapes-with-children shapes-with-children

2
frontend/src/app/main/ui/workspace/sidebar/options/menus/booleans.cljs
View file

@ -18,7 +18,7 @@
(mf/defc booleans-options (mf/defc booleans-options
[] []
(let [selected (mf/deref refs/selected-objects) (let [selected (mf/deref refs/selected-objects)
selected-with-children (mf/deref refs/selected-objects-with-children) selected-with-children (mf/deref refs/selected-shapes-with-children)
has-invalid-shapes? (->> selected-with-children has-invalid-shapes? (->> selected-with-children
(some (comp #{:frame :text} :type))) (some (comp #{:frame :text} :type)))

2
frontend/src/app/main/ui/workspace/sidebar/options/menus/shadow.cljs
View file

@ -78,7 +78,7 @@
update-color update-color
(fn [index] (fn [index]
(fn [color opacity] (fn [color opacity]
(let [color (d/without-keys color [:id :file-id :gradient])] (let [color (dissoc color :id :file-id :gradient)]
(st/emit! (dch/update-shapes (st/emit! (dch/update-shapes
ids ids
#(-> % #(-> %

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

@ -9,6 +9,7 @@
[app.common.attrs :as attrs] [app.common.attrs :as attrs]
[app.common.data :as d] [app.common.data :as d]
[app.common.text :as txt] [app.common.text :as txt]
[app.main.ui.hooks :as hooks]
[app.main.ui.workspace.sidebar.options.menus.blur :refer [blur-attrs blur-menu]] [app.main.ui.workspace.sidebar.options.menus.blur :refer [blur-attrs blur-menu]]
[app.main.ui.workspace.sidebar.options.menus.constraints :refer [constraint-attrs constraints-menu]] [app.main.ui.workspace.sidebar.options.menus.constraints :refer [constraint-attrs constraints-menu]]
[app.main.ui.workspace.sidebar.options.menus.fill :refer [fill-attrs fill-menu]] [app.main.ui.workspace.sidebar.options.menus.fill :refer [fill-attrs fill-menu]]
@ -153,7 +154,7 @@
(defn empty-map [keys] (defn empty-map [keys]
(into {} (map #(hash-map % nil)) keys)) (into {} (map #(hash-map % nil)) keys))
(defn get-attrs (defn get-attrs*
"Given a `type` of options that we want to extract and the shapes to extract them from "Given a `type` of options that we want to extract and the shapes to extract them from
returns a list of tuples [id, values] with the extracted properties for the shapes that returns a list of tuples [id, values] with the extracted properties for the shapes that
applies (some of them ignore some attributes)" applies (some of them ignore some attributes)"
@ -182,28 +183,59 @@
(select-keys txt/default-text-attrs attrs) (select-keys txt/default-text-attrs attrs)
(attrs/get-attrs-multi (txt/node-seq content) attrs))))] (attrs/get-attrs-multi (txt/node-seq content) attrs))))]
:children (let [children (->> (:shapes shape []) (map #(get objects %))) :children (let [children (->> (:shapes shape []) (map #(get objects %)))
[new-ids new-values] (get-attrs children objects attr-type)] [new-ids new-values] (get-attrs* children objects attr-type)]
[(into ids new-ids) (merge-attrs values new-values)]) [(into ids new-ids) (merge-attrs values new-values)])
[])))] [])))]
(reduce extract-attrs [[] []] shapes))) (reduce extract-attrs [[] []] shapes)))
(def get-attrs (memoize get-attrs*))
(defn basic-shape [_ shape]
(cond-> shape
:always
(dissoc :selrect :points :x :y :width :height :transform :transform-inverse :rotation :svg-transform :svg-viewbox :thumbnail)
(= (:type shape) :path)
(dissoc :content)))
(mf/defc options (mf/defc options
{::mf/wrap [#(mf/memo' % (mf/check-props ["shape" "shapes-with-children"]))] {::mf/wrap [#(mf/memo' % (mf/check-props ["shapes" "shapes-with-children"]))]
::mf/wrap-props false} ::mf/wrap-props false}
[props] [props]
(let [shapes (unchecked-get props "shapes") (let [shapes (unchecked-get props "shapes")
shapes-with-children (unchecked-get props "shapes-with-children") shapes-with-children (unchecked-get props "shapes-with-children")
objects (->> shapes-with-children (group-by :id) (d/mapm (fn [_ v] (first v)))) objects (->> shapes-with-children (group-by :id) (d/mapm (fn [_ v] (first v))))
;; Selrect/points only used for measures and it's the one that changes the most. We separate it
;; so we can memoize it
objects-no-measures (->> objects (d/mapm basic-shape))
objects-no-measures (hooks/use-equal-memo objects-no-measures)
type :multiple type :multiple
[measure-ids measure-values] (get-attrs shapes objects :measure) [measure-ids measure-values] (get-attrs shapes objects :measure)
[layer-ids layer-values] (get-attrs shapes objects :layer)
[constraint-ids constraint-values] (get-attrs shapes objects :constraint) [layer-ids layer-values
[fill-ids fill-values] (get-attrs shapes objects :fill) constraint-ids constraint-values
[shadow-ids shadow-values] (get-attrs shapes objects :shadow) fill-ids fill-values
[blur-ids blur-values] (get-attrs shapes objects :blur) shadow-ids shadow-values
[stroke-ids stroke-values] (get-attrs shapes objects :stroke) blur-ids blur-values
[text-ids text-values] (get-attrs shapes objects :text)] stroke-ids stroke-values
text-ids text-values]
(mf/use-memo
(mf/deps objects-no-measures)
(fn []
(into
[]
(mapcat identity)
[(get-attrs shapes objects-no-measures :layer)
(get-attrs shapes objects-no-measures :constraint)
(get-attrs shapes objects-no-measures :fill)
(get-attrs shapes objects-no-measures :shadow)
(get-attrs shapes objects-no-measures :shadow)
(get-attrs shapes objects-no-measures :stroke)
(get-attrs shapes objects-no-measures :text)])))]
[:div.options [:div.options
(when-not (empty? measure-ids) (when-not (empty? measure-ids)

2
frontend/src/app/main/ui/workspace/viewport/hooks.cljs
View file

@ -120,7 +120,7 @@
(->> move-stream (->> move-stream
;; When transforming shapes we stop querying the worker ;; When transforming shapes we stop querying the worker
(rx/filter #(not (some? (mf/ref-val transform-ref)))) (rx/filter #(not (some? (mf/ref-val transform-ref))))
(rx/switch-map query-point)) (rx/merge-map query-point))
(->> move-stream (->> move-stream
;; When transforming shapes we stop querying the worker ;; When transforming shapes we stop querying the worker

2
frontend/src/app/main/ui/workspace/viewport/selection.cljs
View file

@ -15,10 +15,10 @@
[app.main.store :as st] [app.main.store :as st]
[app.main.ui.cursors :as cur] [app.main.ui.cursors :as cur]
[app.main.ui.workspace.shapes.path.editor :refer [path-editor]] [app.main.ui.workspace.shapes.path.editor :refer [path-editor]]
[app.util.debug :refer [debug?]]
[app.util.dom :as dom] [app.util.dom :as dom]
[app.util.object :as obj] [app.util.object :as obj]
[cuerdas.core :as str] [cuerdas.core :as str]
[debug :refer [debug?]]
[rumext.alpha :as mf] [rumext.alpha :as mf]
[rumext.util :refer [map->obj]])) [rumext.util :refer [map->obj]]))

1
frontend/src/app/main/ui/workspace/viewport/widgets.cljs
View file

@ -90,6 +90,7 @@
"translate(" (* zoom x) ", " (* zoom y) ")"))) "translate(" (* zoom x) ", " (* zoom y) ")")))
(mf/defc frame-title (mf/defc frame-title
{::mf/wrap [mf/memo]}
[{:keys [frame modifiers selected? zoom on-frame-enter on-frame-leave on-frame-select]}] [{:keys [frame modifiers selected? zoom on-frame-enter on-frame-leave on-frame-select]}]
(let [{:keys [width x y]} (gsh/transform-shape frame) (let [{:keys [width x y]} (gsh/transform-shape frame)
label-pos (gpt/point x (- y (/ 10 zoom))) label-pos (gpt/point x (- y (/ 10 zoom)))

95
frontend/src/app/util/debug.cljs
View file

@ -1,95 +0,0 @@
(ns app.util.debug
"Debugging utils"
(:require
[app.common.math :as mth]
[app.util.object :as obj]
[app.util.timers :as timers]
[cljs.pprint :refer [pprint]]))
(def debug-options #{:bounding-boxes :group :events :rotation-handler :resize-handler :selection-center :export :import #_:simple-selection})
;; These events are excluded when we activate the :events flag
(def debug-exclude-events
#{:app.main.data.workspace.notifications/handle-pointer-update
:app.main.data.workspace.selection/change-hover-state})
(defonce ^:dynamic *debug* (atom #{#_:events}))
(defn debug-all! [] (reset! *debug* debug-options))
(defn debug-none! [] (reset! *debug* #{}))
(defn debug! [option] (swap! *debug* conj option))
(defn -debug! [option] (swap! *debug* disj option))
(defn ^:export ^boolean debug?
[option]
(if *assert*
(boolean (@*debug* option))
false))
(defn ^:export toggle-debug [name] (let [option (keyword name)]
(if (debug? option)
(-debug! option)
(debug! option))))
(defn ^:export debug-all [] (debug-all!))
(defn ^:export debug-none [] (debug-none!))
(defn ^:export tap
"Transducer function that can execute a side-effect `effect-fn` per input"
[effect-fn]
(fn [rf]
(fn
([] (rf))
([result] (rf result))
([result input]
(effect-fn input)
(rf result input)))))
(defn ^:export logjs
([str] (tap (partial logjs str)))
([str val]
(js/console.log str (clj->js val))
val))
(when (exists? js/window)
(set! (.-dbg ^js js/window) clj->js)
(set! (.-pp ^js js/window) pprint))
(defonce widget-style "
background: black;
bottom: 10px;
color: white;
height: 20px;
padding-left: 8px;
position: absolute;
right: 10px;
width: 40px;
z-index: 99999;
opacity: 0.5;
")
(defn ^:export fps
"Adds a widget to keep track of the average FPS's"
[]
(let [last (volatile! (.now js/performance))
avg (volatile! 0)
node (-> (.createElement js/document "div")
(obj/set! "id" "fps")
(obj/set! "style" widget-style))
body (obj/get js/document "body")
do-thing (fn do-thing []
(timers/raf
(fn []
(let [cur (.now js/performance)
ts (/ 1000 (* (- cur @last)))
val (+ @avg (* (- ts @avg) 0.1))]
(obj/set! node "innerText" (mth/precision val 0))
(vreset! last cur)
(vreset! avg val)
(do-thing)))))]
(.appendChild body node)
(do-thing)))

2
frontend/src/app/util/import/parser.cljs
View file

@ -483,7 +483,7 @@
color {:color (:color attrs) color {:color (:color attrs)
:opacity (-> attrs :opacity d/parse-double)} :opacity (-> attrs :opacity d/parse-double)}
params (-> (d/without-keys attrs [:color :opacity :display :type]) params (-> (dissoc attrs :color :opacity :display :type)
(d/update-when :size d/parse-double) (d/update-when :size d/parse-double)
(d/update-when :item-length d/parse-double) (d/update-when :item-length d/parse-double)
(d/update-when :gutter d/parse-double) (d/update-when :gutter d/parse-double)

10
frontend/src/app/util/worker.cljs
View file

@ -35,6 +35,7 @@
(->> (:stream worker) (->> (:stream worker)
(rx/filter #(= (:reply-to %) sender-id)) (rx/filter #(= (:reply-to %) sender-id))
(take-messages) (take-messages)
(rx/filter (complement :dropped))
(rx/map handle-response))) (rx/map handle-response)))
(rx/empty))))) (rx/empty)))))
@ -91,9 +92,8 @@
worker)) worker))
(defn- handle-response (defn- handle-response
[{:keys [payload error dropped]}] [{:keys [payload error]}]
(when-not dropped (if-let [{:keys [data message]} error]
(if-let [{:keys [data message]} error] (throw (ex-info message data))
(throw (ex-info message data)) payload))
payload)))

90
frontend/src/app/worker/selection.cljs
View file

@ -15,6 +15,8 @@
[clojure.set :as set] [clojure.set :as set]
[okulary.core :as l])) [okulary.core :as l]))
(def ^:const padding-percent 0.10)
(defonce state (l/atom {})) (defonce state (l/atom {}))
(defn index-shape (defn index-shape
@ -37,55 +39,71 @@
:clip-parents clip-parents :clip-parents clip-parents
:parents parents))))) :parents parents)))))
(defn objects-bounds
"Calculates the bounds of the quadtree given a objects map."
[objects]
(-> objects
(dissoc uuid/zero)
vals
gsh/selection-rect))
(defn add-padding-bounds
"Adds a padding to the bounds defined as a percent in the constant `padding-percent`.
For a value of 0.1 will add a 20% width increase (2 x padding)"
[bounds]
(let [width-pad (* (:width bounds) padding-percent)
height-pad (* (:height bounds) padding-percent)]
(-> bounds
(update :x - width-pad)
(update :x1 - width-pad)
(update :x2 + width-pad)
(update :y1 - height-pad)
(update :y2 + height-pad)
(update :width + width-pad width-pad)
(update :height + height-pad height-pad))))
(defn- create-index (defn- create-index
[objects] [objects]
(let [shapes (-> objects (dissoc uuid/zero) (vals)) (let [shapes (-> objects (dissoc uuid/zero) vals)
parents-index (cp/generate-child-all-parents-index objects) parents-index (cp/generate-child-all-parents-index objects)
clip-parents-index (cp/create-clip-index objects parents-index) clip-parents-index (cp/create-clip-index objects parents-index)
bounds #js {:x (int -0.5e7) bounds (-> objects objects-bounds add-padding-bounds)
:y (int -0.5e7)
:width (int 1e7)
:height (int 1e7)}
index (reduce (index-shape objects parents-index clip-parents-index) index (reduce (index-shape objects parents-index clip-parents-index)
(qdt/create bounds) (qdt/create (clj->js bounds))
shapes) shapes)
z-index (cp/calculate-z-index objects)] z-index (cp/calculate-z-index objects)]
{:index index :z-index z-index})) {:index index :z-index z-index :bounds bounds}))
(defn- update-index (defn- update-index
[{index :index z-index :z-index :as data} old-objects new-objects] [{index :index z-index :z-index :as data} old-objects new-objects]
(if (some? data) (let [changes? (fn [id]
(let [changes? (fn [id] (not= (get old-objects id)
(not= (get old-objects id) (get new-objects id)))
(get new-objects id)))
changed-ids (into #{} changed-ids (into #{}
(comp (filter #(not= % uuid/zero)) (comp (filter #(not= % uuid/zero))
(filter changes?) (filter changes?)
(mapcat #(into [%] (cp/get-children % new-objects)))) (mapcat #(into [%] (cp/get-children % new-objects))))
(set/union (set (keys old-objects)) (set/union (set (keys old-objects))
(set (keys new-objects)))) (set (keys new-objects))))
shapes (->> changed-ids (mapv #(get new-objects %)) (filterv (comp not nil?))) shapes (->> changed-ids (mapv #(get new-objects %)) (filterv (comp not nil?)))
parents-index (cp/generate-child-all-parents-index new-objects shapes) parents-index (cp/generate-child-all-parents-index new-objects shapes)
clip-parents-index (cp/create-clip-index new-objects parents-index) clip-parents-index (cp/create-clip-index new-objects parents-index)
new-index (qdt/remove-all index changed-ids) new-index (qdt/remove-all index changed-ids)
index (reduce (index-shape new-objects parents-index clip-parents-index) index (reduce (index-shape new-objects parents-index clip-parents-index)
new-index new-index
shapes) shapes)
z-index (cp/update-z-index z-index changed-ids old-objects new-objects)] z-index (cp/update-z-index z-index changed-ids old-objects new-objects)]
{:index index :z-index z-index}) (assoc data :index index :z-index z-index)))
;; If not previous data. We need to create from scratch
(create-index new-objects)))
(defn- query-index (defn- query-index
[{index :index z-index :z-index} rect frame-id full-frame? include-frames? clip-children? reverse?] [{index :index z-index :z-index} rect frame-id full-frame? include-frames? clip-children? reverse?]
@ -154,7 +172,19 @@
(defmethod impl/handler :selection/update-index (defmethod impl/handler :selection/update-index
[{:keys [page-id old-objects new-objects] :as message}] [{:keys [page-id old-objects new-objects] :as message}]
(swap! state update page-id update-index old-objects new-objects) (let [update-page-index
(fn [index]
(let [old-bounds (:bounds index)
new-bounds (objects-bounds new-objects)]
;; If the new bounds are contained within the old bounds we can
;; update the index.
;; Otherwise we need to re-create it
(if (and (some? index)
(gsh/contains-selrect? old-bounds new-bounds))
(update-index index old-objects new-objects)
(create-index new-objects))))]
(swap! state update page-id update-page-index))
nil) nil)
(defmethod impl/handler :selection/query (defmethod impl/handler :selection/query

211
frontend/src/debug.cljs Normal file
View file

@ -0,0 +1,211 @@
;; 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) UXBOX Labs SL
(ns debug
(:require
[app.common.data :as d]
[app.common.math :as mth]
[app.common.pages :as cp]
[app.main.store :as st]
[app.util.object :as obj]
[app.util.timers :as timers]
[beicon.core :as rx]
[cljs.pprint :refer [pprint]]
[cuerdas.core :as str]
[potok.core :as ptk]))
(def debug-options #{:bounding-boxes :group :events :rotation-handler :resize-handler :selection-center :export :import #_:simple-selection})
;; These events are excluded when we activate the :events flag
(def debug-exclude-events
#{:app.main.data.workspace.notifications/handle-pointer-update
:app.main.data.workspace.selection/change-hover-state})
(defonce ^:dynamic *debug* (atom #{#_:events}))
(defn debug-all! [] (reset! *debug* debug-options))
(defn debug-none! [] (reset! *debug* #{}))
(defn debug! [option] (swap! *debug* conj option))
(defn -debug! [option] (swap! *debug* disj option))
(defn ^:export ^boolean debug?
[option]
(if *assert*
(boolean (@*debug* option))
false))
(defn ^:export toggle-debug [name] (let [option (keyword name)]
(if (debug? option)
(-debug! option)
(debug! option))))
(defn ^:export debug-all [] (debug-all!))
(defn ^:export debug-none [] (debug-none!))
(defn ^:export tap
"Transducer function that can execute a side-effect `effect-fn` per input"
[effect-fn]
(fn [rf]
(fn
([] (rf))
([result] (rf result))
([result input]
(effect-fn input)
(rf result input)))))
(defn ^:export logjs
([str] (tap (partial logjs str)))
([str val]
(js/console.log str (clj->js val))
val))
(when (exists? js/window)
(set! (.-dbg ^js js/window) clj->js)
(set! (.-pp ^js js/window) pprint))
(defonce widget-style "
background: black;
bottom: 10px;
color: white;
height: 20px;
padding-left: 8px;
position: absolute;
right: 10px;
width: 40px;
z-index: 99999;
opacity: 0.5;
")
(defn ^:export fps
"Adds a widget to keep track of the average FPS's"
[]
(let [last (volatile! (.now js/performance))
avg (volatile! 0)
node (-> (.createElement js/document "div")
(obj/set! "id" "fps")
(obj/set! "style" widget-style))
body (obj/get js/document "body")
do-thing (fn do-thing []
(timers/raf
(fn []
(let [cur (.now js/performance)
ts (/ 1000 (* (- cur @last)))
val (+ @avg (* (- ts @avg) 0.1))]
(obj/set! node "innerText" (mth/precision val 0))
(vreset! last cur)
(vreset! avg val)
(do-thing)))))]
(.appendChild body node)
(do-thing)))
(defn ^:export dump-state []
(logjs "state" @st/state))
(defn ^:export dump-buffer []
(logjs "state" @st/last-events))
(defn ^:export get-state [str-path]
(let [path (->> (str/split str-path " ")
(map d/read-string))]
(clj->js (get-in @st/state path))))
(defn ^:export dump-objects []
(let [page-id (get @st/state :current-page-id)]
(logjs "state" (get-in @st/state [:workspace-data :pages-index page-id :objects]))))
(defn ^:export dump-object [name]
(let [page-id (get @st/state :current-page-id)
objects (get-in @st/state [:workspace-data :pages-index page-id :objects])
target (or (d/seek (fn [[_ shape]] (= name (:name shape))) objects)
(get objects (uuid name)))]
(->> target
(logjs "state"))))
(defn ^:export dump-tree
([] (dump-tree false false))
([show-ids] (dump-tree show-ids false))
([show-ids show-touched]
(let [page-id (get @st/state :current-page-id)
objects (get-in @st/state [:workspace-data :pages-index page-id :objects])
components (get-in @st/state [:workspace-data :components])
libraries (get @st/state :workspace-libraries)
root (d/seek #(nil? (:parent-id %)) (vals objects))]
(letfn [(show-shape [shape-id level objects]
(let [shape (get objects shape-id)]
(println (str/pad (str (str/repeat " " level)
(:name shape)
(when (seq (:touched shape)) "*")
(when show-ids (str/format " <%s>" (:id shape))))
{:length 20
:type :right})
(show-component shape objects))
(when show-touched
(when (seq (:touched shape))
(println (str (str/repeat " " level)
" "
(str (:touched shape)))))
(when (:remote-synced? shape)
(println (str (str/repeat " " level)
" (remote-synced)"))))
(when (:shapes shape)
(dorun (for [shape-id (:shapes shape)]
(show-shape shape-id (inc level) objects))))))
(show-component [shape objects]
(if (nil? (:shape-ref shape))
""
(let [root-shape (cp/get-component-shape shape objects)
component-id (when root-shape (:component-id root-shape))
component-file-id (when root-shape (:component-file root-shape))
component-file (when component-file-id (get libraries component-file-id nil))
component (when component-id
(if component-file
(get-in component-file [:data :components component-id])
(get components component-id)))
component-shape (when (and component (:shape-ref shape))
(get-in component [:objects (:shape-ref shape)]))]
(str/format " %s--> %s%s%s"
(cond (:component-root? shape) "#"
(:component-id shape) "@"
:else "-")
(when component-file (str/format "<%s> " (:name component-file)))
(or (:name component-shape) "?")
(if (or (:component-root? shape)
(nil? (:component-id shape))
true)
""
(let [component-id (:component-id shape)
component-file-id (:component-file shape)
component-file (when component-file-id (get libraries component-file-id nil))
component (if component-file
(get-in component-file [:data :components component-id])
(get components component-id))]
(str/format " (%s%s)"
(when component-file (str/format "<%s> " (:name component-file)))
(:name component))))))))]
(println "[Page]")
(show-shape (:id root) 0 objects)
(dorun (for [component (vals components)]
(do
(println)
(println (str/format "[%s]" (:name component)))
(show-shape (:id component) 0 (:objects component)))))))))
(when *assert*
(defonce debug-subscription
(->> st/stream
(rx/filter ptk/event?)
(rx/filter (fn [s] (and (debug? :events)
(not (debug-exclude-events (ptk/type s))))))
(rx/subs #(println "[stream]: " (ptk/repr-event %))))))