Group changes on token propagation

This commit is contained in:
alonso.torres 2026-04-23 15:55:45 +02:00
parent 35f8e1b084
commit ae9a6f8cea
7 changed files with 191 additions and 81 deletions

View File

@ -76,23 +76,26 @@
(defn generate-update-shapes
[changes ids update-fn objects {:keys [attrs changed-sub-attr ignore-tree ignore-touched with-objects?]}]
(let [changes (reduce
(fn [changes id]
(let [opts {:attrs attrs
:ignore-geometry? (get ignore-tree id)
:ignore-touched ignore-touched
:with-objects? with-objects?}]
(pcb/update-shapes changes [id] update-fn (d/without-nils opts))))
(-> changes
(pcb/with-objects objects))
ids)
grid-ids (->> ids (filter (partial ctl/grid-layout? objects)))
changes (-> changes
(pcb/update-shapes grid-ids ctl/assign-cell-positions {:with-objects? true})
(pcb/reorder-grid-children ids)
(cond->
(not ignore-touched)
(generate-unapply-tokens objects changed-sub-attr)))]
(let [changes
(->> ids
(reduce
(fn [changes id]
(let [opts {:attrs attrs
:ignore-geometry? (get ignore-tree id)
:ignore-touched ignore-touched
:with-objects? with-objects?}]
(pcb/update-shapes changes [id] update-fn (d/without-nils opts))))
(cond-> changes
(some? objects) (pcb/with-objects objects))))
grid-ids
(->> ids (filter (partial ctl/grid-layout? objects)))
changes
(-> changes
(pcb/update-shapes grid-ids ctl/assign-cell-positions {:with-objects? true})
(pcb/reorder-grid-children ids)
(cond-> (not ignore-touched)
(generate-unapply-tokens objects changed-sub-attr)))]
changes))
(defn- generate-update-shape-flags

View File

@ -46,11 +46,98 @@
(cond-> changes add-undo-group? (assoc :undo-group undo-group))))
(defn update-shapes
([ids update-fn] (update-shapes ids update-fn nil))
(defn update-shapes-debounce-start
[]
(ptk/reify ::update-shapes-debounce-start
ptk/UpdateEvent
(update [_ state]
(assoc state ::update-shapes-debounce true))))
(defn update-shapes-debounce-stop
[]
(ptk/reify ::update-shapes-debounce-stop
ptk/UpdateEvent
(update [_ state]
(assoc state ::update-shapes-debounce false))))
(defn update-shapes-debounce-commit
[]
(ptk/reify ::update-shapes-debounce-commit
ptk/WatchEvent
(watch [_ state _]
(->> (get state ::update-shapes-debounce-changes)
(vals)
(map dch/commit-changes)
(rx/from)))))
(defn update-shapes-debounce
([ids update-fn]
(update-shapes-debounce ids update-fn nil))
([ids update-fn
{:keys [reg-objects? save-undo? stack-undo? attrs ignore-tree page-id
ignore-touched undo-group with-objects? changed-sub-attr]
:or {reg-objects? false
save-undo? true
stack-undo? false
ignore-touched false
with-objects? false}
:as props}]
(let [cur-event (js/Symbol)]
(ptk/reify ::update-shapes-debounce
ptk/UpdateEvent
(update [it state]
(if (nil? (::update-shapes-debounce-event state))
(assoc state ::update-shapes-debounce-event cur-event)
(let [page-id (or page-id (get state :current-page-id))
objects (dsh/lookup-page-objects state page-id)]
(update-in
state
[::update-shapes-debounce-changes page-id]
(fn [changes]
(-> (or changes
(-> (pcb/empty-changes it page-id)
(pcb/with-objects objects)
(pcb/set-save-undo? save-undo?)
(pcb/set-stack-undo? stack-undo?)
(cond-> undo-group
(pcb/set-undo-group undo-group))))
(cls/generate-update-shapes
ids
update-fn
nil
{:attrs attrs
:changed-sub-attr changed-sub-attr
:ignore-tree ignore-tree
:ignore-touched ignore-touched
:with-objects? with-objects?})
(cond-> reg-objects? (pcb/resize-parents ids))))))))
ptk/WatchEvent
(watch [_ state stream]
(if (= (::update-shapes-debounce-event state) cur-event)
(let [stopper (->> stream (rx/filter (ptk/type? ::update-shapes-debounce-stop)))]
(rx/concat
(rx/merge
(->> stream
(rx/filter (ptk/type? ::update-shapes-debounce))
(rx/take-until stopper)
(rx/last)
(rx/map #(update-shapes-debounce-commit)))
(rx/of (update-shapes-debounce ids update-fn props)))
(rx/of #(dissoc %
::update-shapes-debounce-changes
::update-shapes-debounce-event))))
(rx/empty)))))))
(defn update-shapes
([ids update-fn]
(update-shapes ids update-fn nil))
([ids update-fn
{:as props
:keys [reg-objects? save-undo? stack-undo? attrs ignore-tree page-id
ignore-touched undo-group with-objects? changed-sub-attr]
:or {reg-objects? false
save-undo? true
stack-undo? false
@ -63,48 +150,52 @@
(ptk/reify ::update-shapes
ptk/WatchEvent
(watch [it state _]
(let [page-id (or page-id (get state :current-page-id))
objects (dsh/lookup-page-objects state page-id)
ids (into [] (filter some?) ids)
xf-update-layout
(comp
(map (d/getf objects))
(filter #(some update-layout-attr? (pcb/changed-attrs % objects update-fn {:attrs attrs :with-objects? with-objects?})))
(map :id))
(if (::update-shapes-debounce state)
(rx/of (update-shapes-debounce ids update-fn props))
update-layout-ids
(->> (into [] xf-update-layout ids)
(not-empty))
(let [page-id (or page-id (get state :current-page-id))
objects (dsh/lookup-page-objects state page-id)
ids (into [] (filter some?) ids)
changes
(-> (pcb/empty-changes it page-id)
(pcb/set-save-undo? save-undo?)
(pcb/set-stack-undo? stack-undo?)
(cls/generate-update-shapes ids
update-fn
objects
{:attrs attrs
:changed-sub-attr changed-sub-attr
:ignore-tree ignore-tree
:ignore-touched ignore-touched
:with-objects? with-objects?})
(cond-> undo-group
(pcb/set-undo-group undo-group)))
xf-update-layout
(comp
(map (d/getf objects))
(filter #(some update-layout-attr? (pcb/changed-attrs % objects update-fn {:attrs attrs :with-objects? with-objects?})))
(map :id))
changes
(add-undo-group changes state)]
update-layout-ids
(->> (into [] xf-update-layout ids)
(not-empty))
(rx/concat
(if (seq (:redo-changes changes))
(let [changes (cond-> changes reg-objects? (pcb/resize-parents ids))]
(rx/of (dch/commit-changes changes)))
(rx/empty))
changes
(-> (pcb/empty-changes it page-id)
(pcb/set-save-undo? save-undo?)
(pcb/set-stack-undo? stack-undo?)
(cls/generate-update-shapes ids
update-fn
objects
{:attrs attrs
:changed-sub-attr changed-sub-attr
:ignore-tree ignore-tree
:ignore-touched ignore-touched
:with-objects? with-objects?})
(cond-> undo-group
(pcb/set-undo-group undo-group)))
;; Update layouts for properties marked
(if update-layout-ids
(rx/of (ptk/data-event :layout/update {:ids update-layout-ids}))
(rx/empty))))))))
changes
(add-undo-group changes state)]
(rx/concat
(if (seq (:redo-changes changes))
(let [changes (cond-> changes reg-objects? (pcb/resize-parents ids))]
(rx/of (dch/commit-changes changes)))
(rx/empty))
;; Update layouts for properties marked
(if update-layout-ids
(rx/of (ptk/data-event :layout/update {:ids update-layout-ids}))
(rx/empty)))))))))
(defn add-shape
([shape]

View File

@ -98,7 +98,8 @@
(udw/trigger-bounding-box-cloaking shape-ids)
(udw/increase-rotation shape-ids value nil
{:page-id page-id
:ignore-touched true})))))))
:ignore-touched true
:no-wasm? true})))))))
(defn update-stroke-width
([value shape-ids attributes] (update-stroke-width value shape-ids attributes nil))
@ -254,7 +255,8 @@
(->> (rx/from shape-ids)
(rx/map #(dwtr/update-position % (zipmap attributes (repeat value))
{:ignore-touched true
:page-id page-id})))))))))
:page-id page-id
:no-wasm? true})))))))))
(defn update-layout-gap
[value shape-ids attributes page-id]
@ -493,8 +495,8 @@
(watch [_ _ _]
(when (number? value)
(rx/of
(when (:width attributes) (dwtr/update-dimensions shape-ids :width value {:ignore-touched true :page-id page-id}))
(when (:height attributes) (dwtr/update-dimensions shape-ids :height value {:ignore-touched true :page-id page-id}))))))))
(when (:width attributes) (dwtr/update-dimensions shape-ids :width value {:ignore-touched true :page-id page-id :no-wasm true}))
(when (:height attributes) (dwtr/update-dimensions shape-ids :height value {:ignore-touched true :page-id page-id :no-wasm true}))))))))
(defn- attributes->actions
[{:keys [value shape-ids attributes page-id]}]

View File

@ -195,9 +195,12 @@
(rx/of (-> (ts/resolve-tokens tokens-tree)
(d/update-vals #(update % :resolved-value ts/tokenscript-symbols->penpot-unit))))
(sd/resolve-tokens tokens-tree))
(rx/mapcat (fn [sd-tokens]
(let [undo-id (js/Symbol)]
(rx/concat
(rx/of (dwu/start-undo-transaction undo-id :timeout false))
(propagate-tokens state sd-tokens)
(rx/of (dwu/commit-undo-transaction undo-id)))))))))))
(rx/mapcat
(fn [sd-tokens]
(let [undo-id (js/Symbol)]
(rx/concat
(rx/of (dwu/start-undo-transaction undo-id :timeout false))
(rx/of (dwsh/update-shapes-debounce-start))
(propagate-tokens state sd-tokens)
(rx/of (dwsh/update-shapes-debounce-stop))
(rx/of (dwu/commit-undo-transaction undo-id)))))))))))

View File

@ -373,7 +373,7 @@
"Change size of shapes, from the sidebar options form
(will ignore pixel snap)"
([ids attr value] (update-dimensions ids attr value nil))
([ids attr value options]
([ids attr value {:keys [no-wasm?] :as options}]
(assert (number? value))
(assert (every? uuid? ids)
"expected valid coll of uuids")
@ -408,7 +408,7 @@
modif-tree (dwm/build-modif-tree ids objects get-modifier)]
(if (features/active-feature? state "render-wasm/v1")
(if (and (features/active-feature? state "render-wasm/v1") (not no-wasm?))
(rx/of (dwm/apply-wasm-modifiers modif-tree (assoc options :ignore-snap-pixel true)))
(let [modif-tree (gm/set-objects-modifiers modif-tree objects)]
@ -532,11 +532,11 @@
"Rotate shapes a fixed angle, from a keyboard action."
([ids rotation]
(increase-rotation ids rotation nil))
([ids rotation {:keys [center delta?] :as params} & {:as options}]
([ids rotation {:keys [center delta?] :as params} & {:keys [no-wasm?] :as options}]
(ptk/reify ::increase-rotation
ptk/WatchEvent
(watch [_ state _]
(if (features/active-feature? state "render-wasm/v1")
(if (and (features/active-feature? state "render-wasm/v1") (not no-wasm?))
(let [objects (dsh/lookup-page-objects state)
get-modifier
@ -558,6 +558,7 @@
(rx/concat
(rx/of (dwm/set-delta-rotation-modifiers rotation shapes (assoc params :page-id page-id)))
(rx/of (dwm/apply-modifiers options)))))))))
;; -- Move ----------------------------------------------------------
(declare start-move)
@ -1028,7 +1029,7 @@
The position is a map that can have a partial position (it means it
can receive {:x 10}."
([id position] (update-position id position nil))
([id position options]
([id position {:keys [no-wasm?] :as options}]
(assert (uuid? id) "expected a valid uuid for `id`")
(assert (map? position) "expected a valid map for `position`")
@ -1048,7 +1049,7 @@
delta (calculate-delta position bbox frame)
modifiers (dwm/create-modif-tree [id] (ctm/move-modifiers delta))]
(if (features/active-feature? state "render-wasm/v1")
(if (and (features/active-feature? state "render-wasm/v1") (not no-wasm?))
(rx/of (dwm/apply-wasm-modifiers modifiers
{:ignore-constraints false
:ignore-touched (:ignore-touched options)

View File

@ -17,6 +17,7 @@
[app.common.types.modifiers :as ctm]
[app.main.data.helpers :as dsh]
[app.main.data.workspace.modifiers :as dwm]
[app.main.data.workspace.shapes :as dwsh]
[app.main.data.workspace.undo :as dwu]
[app.render-wasm.api :as wasm.api]
[app.render-wasm.api.fonts :as wasm.fonts]
@ -180,20 +181,31 @@
(let [font-data (wasm.fonts/make-font-data font)]
(wasm.fonts/font-stored? font-data (:emoji? font-data))))))]
(if (not fonts-loaded?)
(->> (rx/of (resize-wasm-text-debounce id opts))
(rx/delay 20))
(if fonts-loaded?
(let [pass-opts (when (or (some? undo-group) (some? undo-id))
(cond-> {}
(some? undo-group) (assoc :undo-group undo-group)
(some? undo-id) (assoc :undo-id undo-id)))]
(rx/of (resize-wasm-text-debounce-inner id pass-opts)))))))))
(rx/of (resize-wasm-text-debounce-inner id pass-opts)))
;; Fonts not loaded; retry after 20 msecs
(->> (rx/of (resize-wasm-text-debounce id opts))
(rx/delay 20))))))))
(defn resize-wasm-text-all
"Resize all text shapes (auto-width/auto-height) from a collection of ids."
[ids]
(ptk/reify ::resize-wasm-text-all
ptk/WatchEvent
(watch [_ _ _]
(->> (rx/from ids)
(rx/map resize-wasm-text-debounce)))))
(watch [_ state stream]
(let [resize-stream
(->> (rx/from ids)
(rx/map resize-wasm-text-debounce))]
(if (::dwsh/update-shapes-debounce state)
;; If we're in the middle of a token propagation we wait until is finished to
;; recalculate the text sizes
(->> stream
(rx/filter (ptk/type? ::dwsh/update-shapes-debounce-commit))
(rx/take 1)
(rx/mapcat (constantly resize-stream)))
resize-stream)))))

View File

@ -443,9 +443,7 @@
rect-1' (cths/get-shape file' :rect-1)]
(t/is (some? (:applied-tokens rect-1')))
(t/is (= (:rotation (:applied-tokens rect-1')) (:name token-target')))
(t/is (= (:rotation rect-1') 120))
(t/testing "WASM mocks were exercised"
(t/is (pos? (thw/call-count :propagate-modifiers)))))))))))
(t/is (= (:rotation rect-1') 120)))))))))
(t/deftest test-apply-stroke-width
(t/testing "applies stroke-width token and updates the shapes with stroke"