WIP

common/src/app/common/logic/shapes.cljc

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

frontend/src/app/main/data/workspace/shape_layout.cljs

@@ -102,6 +102,7 @@
   (ptk/reify ::update-layout-positions
     ptk/WatchEvent
     (watch [_ state _]
+      (prn "!! update-layout-positions " page-id ids)
       (let [page-id (or page-id (:current-page-id state))
             objects (dsh/lookup-page-objects state page-id)
             ids (->> ids (remove uuid/zero?) (filter #(contains? objects %)))]

frontend/src/app/main/data/workspace/shapes.cljs

@@ -46,11 +46,105 @@
 
     (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-buffer-start
+  []
+  (ptk/reify ::update-shapes-buffer-start
+    ptk/UpdateEvent
+    (update [_ state]
+      (prn "[START] update-shapes")
+      (assoc state ::update-shapes-buffer true))))
+
+(defn update-shapes-buffer-stop
+  []
+  (ptk/reify ::update-shapes-buffer-stop
+    ptk/UpdateEvent
+    (update [_ state]
+      (prn "[STOP] update-shapes")
+      (assoc state ::update-shapes-buffer false))))
+
+(defn update-shapes-buffer-commit
+  []
+  (ptk/reify ::update-shapes-buffer-commit
+    ptk/WatchEvent
+    (watch [_ state _]
+      (prn "[COMMIT] update-shapes")
+      (->> (get state ::update-shapes-buffer-changes)
+           (vals)
+           (map dch/commit-changes)
+           (rx/from)))))
+
+;; Accumulates the update shapes changes into a single commit-changes
+;; The accumulation is marked between the events `start` and `stop` in between
+;; those events all the `update-shapes` will be agregated together with this event.
+;; After a `stop` arrives the `commit` will send the changes at the same time.
+(defn update-shapes-buffer
+  ([ids update-fn]
+   (update-shapes-buffer 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 translation?]
+     :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-buffer
+       ptk/UpdateEvent
+       (update [it state]
+         (if (nil? (::update-shapes-buffer-event state))
+           (assoc state ::update-shapes-buffer-event cur-event)
+
+           (let [page-id (or page-id (get state :current-page-id))
+                 objects   (dsh/lookup-page-objects state page-id)]
+             (-> state
+                 (update-in
+                  [::update-shapes-buffer-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-buffer-event state) cur-event)
+           (let [stopper (->> stream (rx/filter (ptk/type? ::update-shapes-buffer-stop)))]
+             (rx/concat
+              (rx/merge
+               (->> stream
+                    (rx/filter (ptk/type? ::update-shapes-buffer))
+                    (rx/take-until stopper)
+                    (rx/last)
+                    (rx/map update-shapes-buffer-commit))
+               (rx/of (update-shapes-buffer ids update-fn props)))
+
+              (rx/of #(dissoc %
+                              ::update-shapes-buffer-changes
+                              ::update-shapes-buffer-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 translation?]
      :or {reg-objects? false
           save-undo? true
           stack-undo? false
@@ -63,49 +157,53 @@
    (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-buffer state)
+         (rx/of (update-shapes-buffer 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))
-                 (pcb/set-translation? translation?))
+               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))
+                   (pcb/set-translation? translation?))
 
-          ;; 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]

frontend/src/app/main/data/workspace/tokens/application.cljs

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

frontend/src/app/main/data/workspace/tokens/propagation.cljs

@@ -195,9 +195,20 @@
                (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))
+
+                   ;; FIXME: now the tokens propagations is done by accumulating the update-shapes
+                   ;; into a single commit-changes. This is not really the best way, the token application
+                   ;; should be done with a changes_builder and sending only one `commit-changes` instead
+                   ;; of creating lots of `update-shapes`.
+                   (rx/of (dwsh/update-shapes-buffer-start))
+                   (->> (propagate-tokens state sd-tokens)
+                        (rx/catch #(rx/concat
+                                    (rx/of (dwsh/update-shapes-buffer-stop))
+                                    (rx/throw %))))
+                   (rx/of (dwsh/update-shapes-buffer-stop))
+                   (rx/of (dwu/commit-undo-transaction undo-id)))))))))))

frontend/src/app/main/data/workspace/transforms.cljs

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

frontend/src/app/main/data/workspace/wasm_text.cljs

@@ -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]
@@ -70,6 +71,7 @@
   (ptk/reify ::resize-wasm-text
     ptk/WatchEvent
     (watch [_ state _]
+      (prn "??resize-wasm-text")
       (let [objects (dsh/lookup-page-objects state)
             shape   (get objects id)]
         (if (and (some? shape)
@@ -85,6 +87,7 @@
    (ptk/reify ::resize-wasm-text-debounce-commit
      ptk/WatchEvent
      (watch [_ state _]
+       (prn "[COMMIT] resize-wasm-text")
        (let [ids (get state ::resize-wasm-text-debounce-ids)
              objects (dsh/lookup-page-objects state)
 
@@ -141,7 +144,8 @@
        ptk/WatchEvent
        (watch [_ state stream]
          (if (= (::resize-wasm-text-debounce-event state) cur-event)
-           (let [stopper (->> stream (rx/filter (ptk/type? :app.main.data.workspace/finalize)))]
+           (let [_ (prn "[START] resize-wasm-text")
+                 stopper (->> stream (rx/filter (ptk/type? :app.main.data.workspace/finalize)))]
              (rx/concat
               (rx/merge
                (->> stream
@@ -152,7 +156,8 @@
                               (resize-wasm-text-debounce-commit
                                (some-> evt meta :undo-group)
                                (some-> evt meta :undo-id))))
-                    (rx/take-until stopper))
+                    (rx/take-until stopper)
+                    (rx/tap #(prn "[STOP] resize-wasm-text")))
                (rx/of (with-meta
                         (resize-wasm-text-debounce-inner id)
                         {:undo-group undo-group :undo-id undo-id})))
@@ -168,6 +173,7 @@
    (ptk/reify ::resize-wasm-text-debounce
      ptk/WatchEvent
      (watch [_ state _]
+       (prn "?resize-wasm-text-debounce")
        (let [page-id (:current-page-id state)
              objects (dsh/lookup-page-objects state page-id)
              content (dm/get-in objects [id :content])
@@ -180,20 +186,33 @@
                      (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]
+      (prn "!! resize-wasm-text-all")
+      (let [resize-stream
+            (->> (rx/from ids)
+                 (rx/map resize-wasm-text-debounce))]
+        (if (::dwsh/update-shapes-buffer 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-buffer-commit))
+               (rx/take 1)
+               (rx/tap #(prn ">AFTER ::dwsh/update-shapes-buffer-commit"))
+               (rx/mapcat (constantly resize-stream)))
+          resize-stream)))))

frontend/test/frontend_tests/tokens/logic/token_actions_test.cljs

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