Penpot/penpot
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-03-28 15:41:25 -05:00
Code Issues 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
Show stats 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
in the `keys` parameter."
[data keys]
(when data
(when (map? data)
(persistent!
(reduce #(dissoc! %1 %2) (transient data) keys))))
@ -252,6 +252,11 @@
#?(:clj (Object.)
:cljs (js/Object.)))
(defn getf
"Returns a function to access a map"
[coll]
(partial get coll))
(defn update-in-when
[m key-seq f & args]
(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."
[shapes]
(->> shapes
(gtr/transform-shape)
(map (comp gpr/points->selrect :points))
(map (comp gpr/points->selrect :points gtr/transform-shape))
(gpr/join-selrects)))
(defn translate-to-frame
@ -150,6 +149,7 @@
(d/export gpr/points->rect)
(d/export gpr/center->rect)
(d/export gpr/join-rects)
(d/export gpr/contains-selrect?)
(d/export gtr/move)
(d/export gtr/absolute-move)
@ -163,6 +163,7 @@
(d/export gtr/rotation-modifiers)
(d/export gtr/merge-modifiers)
(d/export gtr/transform-shape)
(d/export gtr/calc-transformed-parent-rect)
(d/export gtr/calc-child-modifiers)
;; PATHS

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

@ -121,3 +121,11 @@
(or (< px x2) (s= px x2))
(or (> py y1) (s= py y1))
(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
"Transform a point around the shape center"
[point center matrix]
(gpt/transform
point
(gmt/multiply (gmt/translate-matrix center)
matrix
(gmt/translate-matrix (gpt/negate center)))))
(when point
(gpt/transform
point
(gmt/multiply (gmt/translate-matrix center)
matrix
(gmt/translate-matrix (gpt/negate center))))))
(defn transform-rect
"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
its properties. We adjust de x,y,width,height and create a custom transform"
[shape transform round-coords?]
;; FIXME: Improve performance
(let [points (-> shape :points (gco/transform-points transform))
center (gco/center-points points)
@ -342,6 +344,9 @@
;; tells if the resize vectors must be applied to text shapes
;; or not.
(defn empty-modifiers? [modifiers]
(empty? (dissoc modifiers :ignore-geometry?)))
(defn resize-modifiers
[shape attr value]
(us/assert map? shape)
@ -385,7 +390,7 @@
{:rotation angle
:displacement displacement}))
(defn merge-modifiers
(defn merge-modifiers*
[objects modifiers]
(let [set-modifier
@ -395,6 +400,8 @@
(->> modifiers
(reduce set-modifier objects))))
(def merge-modifiers (memoize merge-modifiers*))
(defn- modifiers->transform
[center modifiers]
(let [ds-modifier (:displacement modifiers (gmt/matrix))
@ -463,7 +470,7 @@
modifiers (dissoc modifiers :displacement)]
(-> shape
(assoc :modifiers modifiers)
(cond-> (empty? modifiers)
(cond-> (empty-modifiers? modifiers)
(dissoc :modifiers))))
shape)))
@ -485,205 +492,234 @@
%)))
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
([shape]
(transform-shape shape nil))
(transform-shape* shape nil))
([shape options]
(transform-shape* shape options)))
([shape {:keys [round-coords?]
:or {round-coords? true}}]
(let [shape (apply-displacement shape)
center (gco/center-shape shape)
modifiers (:modifiers shape)]
(if (and modifiers center)
(let [transform (modifiers->transform center modifiers)]
(-> shape
(set-flip modifiers)
(apply-transform transform round-coords?)
(apply-text-resize modifiers)
(dissoc :modifiers)))
shape))))
(defn calc-transformed-parent-rect
[{:keys [selrect] :as shape} {:keys [displacement resize-transform-inverse resize-vector resize-origin resize-vector-2 resize-origin-2]}]
(let [resize-transform-inverse (or resize-transform-inverse (gmt/matrix))
displacement
(when (some? displacement)
(-> (gpt/point 0 0)
(gpt/transform displacement)
(gpt/transform resize-transform-inverse)
(gmt/translate-matrix)))
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
"Given the modifiers to apply to the parent, calculate the corresponding
modifiers for the child, depending on the child constraints."
[parent child parent-modifiers ignore-constraints]
(let [parent-rect (:selrect parent)
child-rect (:selrect child)
([parent child parent-modifiers ignore-constraints]
(let [transformed-parent-rect (calc-transformed-parent-rect parent parent-modifiers )]
(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
;; the original, and calculate child transformations from this.
;;
;; 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))
([parent child parent-modifiers ignore-constraints transformed-parent-rect]
(let [parent-rect (:selrect parent)
child-rect (:selrect child)
transformed-parent-rect (-> parent-rect
(gpr/rect->points)
(gco/transform-points parent-displacement)
(gco/transform-points parent-origin (gmt/scale-matrix parent-vector))
(gco/transform-points parent-origin-2 (gmt/scale-matrix parent-vector-2))
(gpr/points->selrect))
;; Apply the modifiers to the parent's selrect, to check the difference with
;; the original, and calculate child transformations from this.
;;
;; 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.
;; Calculate the modifiers in the horizontal and vertical directions
;; depending on the child constraints.
constraints-h (if-not ignore-constraints
(get child :constraints-h (spec/default-constraints-h child))
:scale)
constraints-v (if-not ignore-constraints
(get child :constraints-v (spec/default-constraints-v child))
:scale)
;; Calculate the modifiers in the horizontal and vertical directions
;; depending on the child constraints.
constraints-h (if-not ignore-constraints
(get child :constraints-h (spec/default-constraints-h child))
:scale)
constraints-v (if-not ignore-constraints
(get child :constraints-v (spec/default-constraints-v child))
:scale)
modifiers-h (case constraints-h
:left
(let [delta-left (- (:x1 transformed-parent-rect) (:x1 parent-rect))]
modifiers-h (case constraints-h
:left
(let [delta-left (- (:x1 transformed-parent-rect) (:x1 parent-rect))]
(if-not (mth/almost-zero? delta-left)
{:displacement (gpt/point delta-left 0)} ;; we convert to matrix below
{}))
(if-not (mth/almost-zero? delta-left)
{:displacement (gpt/point delta-left 0)} ;; we convert to matrix below
{}))
:right
(let [delta-right (- (:x2 transformed-parent-rect) (:x2 parent-rect))]
(if-not (mth/almost-zero? delta-right)
{:displacement (gpt/point delta-right 0)}
{}))
:right
(let [delta-right (- (:x2 transformed-parent-rect) (:x2 parent-rect))]
(if-not (mth/almost-zero? delta-right)
{:displacement (gpt/point delta-right 0)}
{}))
:leftright
(let [delta-left (- (:x1 transformed-parent-rect) (:x1 parent-rect))
delta-width (- (:width transformed-parent-rect) (:width parent-rect))]
(if (or (not (mth/almost-zero? delta-left))
(not (mth/almost-zero? delta-width)))
{:displacement (gpt/point delta-left 0)
:resize-origin (-> (gpt/point (+ (:x1 child-rect) delta-left)
(:y1 child-rect))
(transform-point-center
:leftright
(let [delta-left (- (:x1 transformed-parent-rect) (:x1 parent-rect))
delta-width (- (:width transformed-parent-rect) (:width parent-rect))]
(if (or (not (mth/almost-zero? delta-left))
(not (mth/almost-zero? delta-width)))
{:displacement (gpt/point delta-left 0)
:resize-origin (-> (gpt/point (+ (:x1 child-rect) delta-left)
(:y1 child-rect))
(transform-point-center
(gco/center-rect child-rect)
(:transform child (gmt/matrix))))
:resize-vector (gpt/point (/ (+ (:width child-rect) delta-width)
(:width child-rect)) 1)}
{}))
:resize-vector (gpt/point (/ (+ (:width child-rect) delta-width)
(:width child-rect)) 1)}
{}))
:center
(let [parent-center (gco/center-rect parent-rect)
transformed-parent-center (gco/center-rect transformed-parent-rect)
delta-center (- (:x transformed-parent-center) (:x parent-center))]
(if-not (mth/almost-zero? delta-center)
{:displacement (gpt/point delta-center 0)}
{}))
:center
(let [parent-center (gco/center-rect parent-rect)
transformed-parent-center (gco/center-rect transformed-parent-rect)
delta-center (- (:x transformed-parent-center) (:x parent-center))]
(if-not (mth/almost-zero? delta-center)
{:displacement (gpt/point delta-center 0)}
{}))
:scale
(cond-> {}
(and (:resize-vector parent-modifiers)
(not (mth/close? (:x (:resize-vector parent-modifiers)) 1)))
(assoc :resize-origin (:resize-origin parent-modifiers)
:resize-vector (gpt/point (:x (:resize-vector parent-modifiers)) 1))
:scale
(cond-> {}
(and (:resize-vector parent-modifiers)
(not (mth/close? (:x (:resize-vector parent-modifiers)) 1)))
(assoc :resize-origin (:resize-origin parent-modifiers)
:resize-vector (gpt/point (:x (:resize-vector parent-modifiers)) 1))
;; resize-vector-2 is always for vertical modifiers, so no need to
;; check it here.
;; resize-vector-2 is always for vertical modifiers, so no need to
;; check it here.
(:displacement parent-modifiers)
(assoc :displacement
(gpt/point (-> (gpt/point 0 0)
(gpt/transform (:displacement parent-modifiers))
(gpt/transform (:resize-transform-inverse parent-modifiers (gmt/matrix)))
(:x))
0)))
{})
(:displacement parent-modifiers)
(assoc :displacement
(gpt/point (-> (gpt/point 0 0)
(gpt/transform (:displacement parent-modifiers))
(gpt/transform (:resize-transform-inverse parent-modifiers (gmt/matrix)))
(:x))
0)))
{})
modifiers-v (case constraints-v
:top
(let [delta-top (- (:y1 transformed-parent-rect) (:y1 parent-rect))]
(if-not (mth/almost-zero? delta-top)
{:displacement (gpt/point 0 delta-top)} ;; we convert to matrix below
{}))
modifiers-v (case constraints-v
:top
(let [delta-top (- (:y1 transformed-parent-rect) (:y1 parent-rect))]
(if-not (mth/almost-zero? delta-top)
{:displacement (gpt/point 0 delta-top)} ;; we convert to matrix below
{}))
:bottom
(let [delta-bottom (- (:y2 transformed-parent-rect) (:y2 parent-rect))]
(if-not (mth/almost-zero? delta-bottom)
{:displacement (gpt/point 0 delta-bottom)}
{}))
:bottom
(let [delta-bottom (- (:y2 transformed-parent-rect) (:y2 parent-rect))]
(if-not (mth/almost-zero? delta-bottom)
{:displacement (gpt/point 0 delta-bottom)}
{}))
:topbottom
(let [delta-top (- (:y1 transformed-parent-rect) (:y1 parent-rect))
delta-height (- (:height transformed-parent-rect) (:height parent-rect))]
(if (or (not (mth/almost-zero? delta-top))
(not (mth/almost-zero? delta-height)))
{:displacement (gpt/point 0 delta-top)
:resize-origin (-> (gpt/point (:x1 child-rect)
(+ (:y1 child-rect) delta-top))
(transform-point-center
:topbottom
(let [delta-top (- (:y1 transformed-parent-rect) (:y1 parent-rect))
delta-height (- (:height transformed-parent-rect) (:height parent-rect))]
(if (or (not (mth/almost-zero? delta-top))
(not (mth/almost-zero? delta-height)))
{:displacement (gpt/point 0 delta-top)
:resize-origin (-> (gpt/point (:x1 child-rect)
(+ (:y1 child-rect) delta-top))
(transform-point-center
(gco/center-rect child-rect)
(:transform child (gmt/matrix))))
:resize-vector (gpt/point 1 (/ (+ (:height child-rect) delta-height)
(:height child-rect)))}
{}))
:resize-vector (gpt/point 1 (/ (+ (:height child-rect) delta-height)
(:height child-rect)))}
{}))
:center
(let [parent-center (gco/center-rect parent-rect)
transformed-parent-center (gco/center-rect transformed-parent-rect)
delta-center (- (:y transformed-parent-center) (:y parent-center))]
(if-not (mth/almost-zero? delta-center)
{:displacement (gpt/point 0 delta-center)}
{}))
:center
(let [parent-center (gco/center-rect parent-rect)
transformed-parent-center (gco/center-rect transformed-parent-rect)
delta-center (- (:y transformed-parent-center) (:y parent-center))]
(if-not (mth/almost-zero? delta-center)
{:displacement (gpt/point 0 delta-center)}
{}))
:scale
(cond-> {}
(and (:resize-vector parent-modifiers)
(not (mth/close? (:y (:resize-vector parent-modifiers)) 1)))
(assoc :resize-origin (:resize-origin parent-modifiers)
:resize-vector (gpt/point 1 (:y (:resize-vector parent-modifiers))))
:scale
(cond-> {}
(and (:resize-vector parent-modifiers)
(not (mth/close? (:y (:resize-vector parent-modifiers)) 1)))
(assoc :resize-origin (:resize-origin 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
;; call, and the resize-vector has no vertical data, so we may override it.
(and (:resize-vector-2 parent-modifiers)
(not (mth/close? (:y (:resize-vector-2 parent-modifiers)) 1)))
(assoc :resize-origin (:resize-origin-2 parent-modifiers)
:resize-vector (gpt/point 1 (:y (:resize-vector-2 parent-modifiers))))
;; 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.
(and (:resize-vector-2 parent-modifiers)
(not (mth/close? (:y (:resize-vector-2 parent-modifiers)) 1)))
(assoc :resize-origin (:resize-origin-2 parent-modifiers)
:resize-vector (gpt/point 1 (:y (:resize-vector-2 parent-modifiers))))
(:displacement parent-modifiers)
(assoc :displacement
(gpt/point 0 (-> (gpt/point 0 0)
(gpt/transform (:displacement parent-modifiers))
(gpt/transform (:resize-transform-inverse parent-modifiers (gmt/matrix)))
(:y)))))
{})]
(:displacement parent-modifiers)
(assoc :displacement
(gpt/point 0 (-> (gpt/point 0 0)
(gpt/transform (:displacement parent-modifiers))
(gpt/transform (:resize-transform-inverse parent-modifiers (gmt/matrix)))
(:y)))))
{})]
;; 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.
(cond-> {}
(or (:displacement modifiers-h) (:displacement modifiers-v))
(assoc :displacement (gmt/translate-matrix
;; 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.
(cond-> {}
(or (:displacement modifiers-h) (:displacement modifiers-v))
(assoc :displacement (gmt/translate-matrix
(-> (gpt/point (get (:displacement modifiers-h) :x 0)
(get (:displacement modifiers-v) :y 0))
(gpt/transform
(:resize-transform parent-modifiers (gmt/matrix))))))
(:resize-transform parent-modifiers (gmt/matrix))))))
(:resize-vector modifiers-h)
(assoc :resize-origin (:resize-origin modifiers-h)
:resize-vector (gpt/point (get (:resize-vector modifiers-h) :x 1)
(get (:resize-vector modifiers-h) :y 1)))
(:resize-vector modifiers-h)
(assoc :resize-origin (:resize-origin modifiers-h)
:resize-vector (gpt/point (get (:resize-vector modifiers-h) :x 1)
(get (:resize-vector modifiers-h) :y 1)))
(:resize-vector modifiers-v)
(assoc :resize-origin-2 (:resize-origin modifiers-v)
:resize-vector-2 (gpt/point (get (:resize-vector modifiers-v) :x 1)
(get (:resize-vector modifiers-v) :y 1)))
(:resize-vector modifiers-v)
(assoc :resize-origin-2 (:resize-origin modifiers-v)
:resize-vector-2 (gpt/point (get (:resize-vector modifiers-v) :x 1)
(get (:resize-vector modifiers-v) :y 1)))
(:resize-transform parent-modifiers)
(assoc :resize-transform (:resize-transform parent-modifiers)
:resize-transform-inverse (:resize-transform-inverse parent-modifiers)))))
(:resize-transform parent-modifiers)
(assoc :resize-transform (:resize-transform parent-modifiers)
:resize-transform-inverse (:resize-transform-inverse parent-modifiers))))))
(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-name)
(d/export helpers/unframed-shape?)
(d/export helpers/children-seq)
;; Indices
(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)))
(defn process-changes
([data items] (process-changes data items true))
([data items]
(process-changes data items true))
([data items verify?]
;; When verify? false we spec the schema validation. Currently used to make just
;; 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
(defmethod process-change :reg-objects
[data {:keys [page-id component-id shapes]}]
;; FIXME: Improve performance
(letfn [(reg-objects [objects]
(reduce #(d/update-when %1 %2 update-group %1) objects
(sequence (comp
@ -469,4 +472,3 @@
(ex/raise :type :not-implemented
:code :operation-not-implemented
:context {:type (:type op)}))

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

@ -99,7 +99,7 @@
(get-in component [:objects (:id component)]))
;; Implemented with transient for performance
(defn get-children
(defn get-children*
"Retrieve all children ids recursively for a given object. The
children's order will be breadth first."
[id objects]
@ -128,6 +128,8 @@
(recur result (pop! pending) next))
(persistent! result)))))
(def get-children (memoize get-children*))
(defn get-children-objects
"Retrieve all children objects recursively for a given object"
[id objects]
@ -172,9 +174,10 @@
shape
(get objects (:frame-id shape))))
(defn clean-loops
(defn clean-loops*
"Clean a list of ids from circular references."
[objects ids]
(let [parent-selected?
(fn [id]
(let [parents (get-parents id objects)]
@ -188,6 +191,8 @@
(reduce add-element (d/ordered-set) ids)))
(def clean-loops (memoize clean-loops*))
(defn calculate-invalid-targets
[shape-id objects]
(let [result #{shape-id}
@ -494,3 +499,10 @@
(and (not= (:type shape) :frame)
(= (: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-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/keys :opt-un [:internal.shape/selrect
:internal.shape/points
@ -307,7 +326,9 @@
::cti/interactions
:internal.shape/masked-group?
:internal.shape/shadow
:internal.shape/blur]))
:internal.shape/blur
:internal.shape/opacity
:internal.shape/blend-mode]))
;; shapes-group is handled differently
@ -317,7 +338,8 @@
:opt-un [::id]))
(s/def ::shape
(s/and ::minimal-shape ::shape-attrs
(s/and ::minimal-shape
::shape-attrs
(s/keys :opt-un [::id
::component-id
::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;
.file-name-label {
flex: 1;
white-space: nowrap;
display: flex;
align-items: center;
flex: 1;
height: 2rem;
margin-left: -0.25rem;
overflow: hidden;
padding-left: 0.25rem;
padding-top: 0.25rem;
text-overflow: ellipsis;
white-space: nowrap;
.icon-library {
width: 14px;

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

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

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

@ -23,6 +23,7 @@
[app.util.i18n :as i18n]
[app.util.theme :as theme]
[beicon.core :as rx]
[debug]
[potok.core :as ptk]
[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)
update-node (fn [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
:typography-ref-file)))]
(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]
(let [zoom (get-in state [:workspace-local :zoom] 1)
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
(when-not preserve?
(rx/of (deselect-all)))
(->> ms/mouse-position
(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))))
(if preserve?
(rx/empty)
(rx/of (deselect-all)))
(rx/flat-map
(fn [selrect]
(rx/of (update-selrect selrect)
(select-shapes-by-current-selrect preserve?))))
(rx/merge
(->> selrect-stream (rx/map update-selrect))
(->> selrect-stream
(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)
@ -221,11 +227,13 @@
selrect (get-in state [:workspace-local :selrect])
blocked? (fn [id] (get-in objects [id :blocked] false))]
(when selrect
(->> (uw/ask! {:cmd :selection/query
:page-id page-id
:rect selrect
:include-frames? true
:full-frame? true})
(rx/empty)
(->> (uw/ask-buffered!
{:cmd :selection/query
:page-id page-id
:rect selrect
:include-frames? true
:full-frame? true})
(rx/map #(cp/clean-loops objects %))
(rx/map #(into initial-set (filter (comp not blocked?)) %))
(rx/map select-shapes)))))))

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

@ -107,7 +107,6 @@
;; geometric attributes of the shapes.
(declare set-modifiers-recursive)
(declare check-delta)
(declare set-local-displacement)
(declare clear-local-transform)
@ -195,34 +194,6 @@
(clear-local-transform)
(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
"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."
@ -257,6 +228,39 @@
[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]
(ptk/reify ::start-local-displacement
ptk/UpdateEvent

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

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

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

@ -7,11 +7,7 @@
(ns app.main.store
(:require-macros [app.main.store])
(:require
[app.common.data :as d]
[app.common.pages :as cp]
[app.util.debug :refer [debug? debug-exclude-events logjs]]
[beicon.core :as rx]
[cuerdas.core :as str]
[okulary.core :as l]
[potok.core :as ptk]))
@ -42,14 +38,6 @@
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!
([] nil)
([event]
@ -63,99 +51,4 @@
[& 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]}]
[:> "penpot:grids" #js {}
(for [{:keys [type display params]} grids]
(let [props (->> (d/without-keys params [:color])
(let [props (->> (dissoc params :color)
(prefix-keys)
(clj->js))]
[:> "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.svg-raw :as svg-raw]
[app.main.ui.workspace.shapes.text :as text]
[app.util.debug :refer [debug?]]
[app.util.object :as obj]
[debug :refer [debug?]]
[okulary.core :as l]
[rumext.alpha :as mf]))

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

@ -8,12 +8,14 @@
(:require
[app.common.geom.shapes :as gsh]
[app.common.pages :as cp]
[app.main.ui.hooks :as hooks]
[app.main.ui.shapes.frame :as frame]
[app.main.ui.shapes.shape :refer [shape-container]]
[app.main.ui.shapes.text.fontfaces :as ff]
[app.util.object :as obj]
[app.util.timers :as ts]
[beicon.core :as rx]
[debug :refer [debug?]]
[rumext.alpha :as mf]))
(defn check-frame-props
@ -47,24 +49,46 @@
:width (:width shape)
:height (:height shape)
;; 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
[component]
(mf/fnc deferred
{::mf/wrap-props false}
[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)
^js set-render (aget tmp 1)]
(mf/use-layout-effect
^js set-render (aget tmp 1)
prev-shape-ref (mf/use-ref shape)]
(mf/use-effect
(mf/deps shape)
(fn []
(let [sem (ts/schedule-on-idle #(set-render true))]
#(rx/dispose! sem))))
(when render? (mf/create-element component props)))))
(mf/set-ref-val! prev-shape-ref shape)
(set-render false)))
(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
[shape-wrapper]
@ -78,9 +102,11 @@
thumbnail? (unchecked-get props "thumbnail?")
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)

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

@ -1172,7 +1172,7 @@
attrs (merge
{:typography-ref-file file-id
: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}))
ids)))

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

@ -19,6 +19,7 @@
[app.util.keyboard :as kbd]
[app.util.object :as obj]
[app.util.timers :as ts]
[beicon.core :as rx]
[cuerdas.core :as str]
[okulary.core :as l]
[rumext.alpha :as mf]))
@ -205,8 +206,12 @@
(mf/use-effect
(mf/deps selected)
(fn []
(when (and (= (count selected) 1) selected?)
(.scrollIntoView (mf/ref-val dref) #js {:block "nearest", :behavior "smooth"}))))
(let [subid
(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
: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)
file-id (mf/use-ctx ctx/current-file-id)
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
:selected selected
: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
[]
(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
(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
(fn [index]
(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
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.data :as d]
[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.constraints :refer [constraint-attrs constraints-menu]]
[app.main.ui.workspace.sidebar.options.menus.fill :refer [fill-attrs fill-menu]]
@ -153,7 +154,7 @@
(defn empty-map [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
returns a list of tuples [id, values] with the extracted properties for the shapes that
applies (some of them ignore some attributes)"
@ -182,28 +183,59 @@
(select-keys txt/default-text-attrs attrs)
(attrs/get-attrs-multi (txt/node-seq content) attrs))))]
: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)])
[])))]
(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/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}
[props]
(let [shapes (unchecked-get props "shapes")
shapes-with-children (unchecked-get props "shapes-with-children")
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
[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)
[fill-ids fill-values] (get-attrs shapes objects :fill)
[shadow-ids shadow-values] (get-attrs shapes objects :shadow)
[blur-ids blur-values] (get-attrs shapes objects :blur)
[stroke-ids stroke-values] (get-attrs shapes objects :stroke)
[text-ids text-values] (get-attrs shapes objects :text)]
[layer-ids layer-values
constraint-ids constraint-values
fill-ids fill-values
shadow-ids shadow-values
blur-ids blur-values
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
(when-not (empty? measure-ids)

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

@ -120,7 +120,7 @@
(->> move-stream
;; When transforming shapes we stop querying the worker
(rx/filter #(not (some? (mf/ref-val transform-ref))))
(rx/switch-map query-point))
(rx/merge-map query-point))
(->> move-stream
;; 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.ui.cursors :as cur]
[app.main.ui.workspace.shapes.path.editor :refer [path-editor]]
[app.util.debug :refer [debug?]]
[app.util.dom :as dom]
[app.util.object :as obj]
[cuerdas.core :as str]
[debug :refer [debug?]]
[rumext.alpha :as mf]
[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) ")")))
(mf/defc frame-title
{::mf/wrap [mf/memo]}
[{:keys [frame modifiers selected? zoom on-frame-enter on-frame-leave on-frame-select]}]
(let [{:keys [width x y]} (gsh/transform-shape frame)
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)
: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 :item-length 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)
(rx/filter #(= (:reply-to %) sender-id))
(take-messages)
(rx/filter (complement :dropped))
(rx/map handle-response)))
(rx/empty)))))
@ -91,9 +92,8 @@
worker))
(defn- handle-response
[{:keys [payload error dropped]}]
(when-not dropped
(if-let [{:keys [data message]} error]
(throw (ex-info message data))
payload)))
[{:keys [payload error]}]
(if-let [{:keys [data message]} error]
(throw (ex-info message data))
payload))

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

@ -15,6 +15,8 @@
[clojure.set :as set]
[okulary.core :as l]))
(def ^:const padding-percent 0.10)
(defonce state (l/atom {}))
(defn index-shape
@ -37,55 +39,71 @@
:clip-parents clip-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
[objects]
(let [shapes (-> objects (dissoc uuid/zero) (vals))
(let [shapes (-> objects (dissoc uuid/zero) vals)
parents-index (cp/generate-child-all-parents-index objects)
clip-parents-index (cp/create-clip-index objects parents-index)
bounds #js {:x (int -0.5e7)
:y (int -0.5e7)
:width (int 1e7)
:height (int 1e7)}
bounds (-> objects objects-bounds add-padding-bounds)
index (reduce (index-shape objects parents-index clip-parents-index)
(qdt/create bounds)
(qdt/create (clj->js bounds))
shapes)
z-index (cp/calculate-z-index objects)]
{:index index :z-index z-index}))
{:index index :z-index z-index :bounds bounds}))
(defn- update-index
[{index :index z-index :z-index :as data} old-objects new-objects]
(if (some? data)
(let [changes? (fn [id]
(not= (get old-objects id)
(get new-objects id)))
(let [changes? (fn [id]
(not= (get old-objects id)
(get new-objects id)))
changed-ids (into #{}
(comp (filter #(not= % uuid/zero))
(filter changes?)
(mapcat #(into [%] (cp/get-children % new-objects))))
(set/union (set (keys old-objects))
(set (keys new-objects))))
changed-ids (into #{}
(comp (filter #(not= % uuid/zero))
(filter changes?)
(mapcat #(into [%] (cp/get-children % new-objects))))
(set/union (set (keys old-objects))
(set (keys new-objects))))
shapes (->> changed-ids (mapv #(get new-objects %)) (filterv (comp not nil?)))
parents-index (cp/generate-child-all-parents-index new-objects shapes)
clip-parents-index (cp/create-clip-index new-objects parents-index)
shapes (->> changed-ids (mapv #(get new-objects %)) (filterv (comp not nil?)))
parents-index (cp/generate-child-all-parents-index new-objects shapes)
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)
new-index
shapes)
index (reduce (index-shape new-objects parents-index clip-parents-index)
new-index
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})
;; If not previous data. We need to create from scratch
(create-index new-objects)))
(assoc data :index index :z-index z-index)))
(defn- query-index
[{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
[{: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)
(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 %))))))