Buffer auto-key performance takes in memory

frontend/src/arthur/domain/gesture.cljs

@@ -85,3 +85,15 @@
    (let [put (if auto-key? node/set-keyed-channel node/set-channel)]
      (update-in clip [:symbols sid :nodes id]
                 #(reduce-kv (fn [n path v] (put n path f v)) % vs)))))
+
+(defn apply-take
+  "Apply a buffered performance take. `take` is keyed by `[symbol node]`, then
+  local frame, then channel path. It becomes ordinary authored keys in one
+  document edit rather than making the edit pipeline run for every sample."
+  [clip take]
+  (reduce-kv
+   (fn [c [sid id] frames]
+     (reduce-kv (fn [c f values]
+                  (apply-values c sid id f values true))
+                c frames))
+   clip take))

frontend/src/arthur/events/ui.cljs

@@ -21,7 +21,6 @@
   (:require [arthur.domain.clip :as clip]
             [arthur.domain.correction :as correction]
             [arthur.domain.gesture :as gesture]
-            [arthur.domain.history :as history]
             [arthur.domain.nest :as nest]
             [arthur.domain.node :as node]
             [arthur.domain.lane :as lane]
@@ -761,44 +760,41 @@
  ::gesture
  ;; A transform in the middle of a drag on the stage, `{:sid :id :frame
  ;; :values}`, drawn by `::render/clip` as `::sliding` is; nil when abandoned.
- ;; Auto-key records once per PLAYBACK FRAME, not once per pointer event. Pointer
+ ;; Auto-key SAMPLES once per playback frame but does not EDIT once per frame.
- ;; events can arrive far faster than the document's fps and writing all of them
+ ;; Samples stay in the gesture's in-memory `:take`; pointer events only replace
- ;; makes a drag needlessly expensive. `record-gesture` below is also dispatched
+ ;; the current frame's sample. Pointer-up commits the complete take once.
- ;; by playback/tick, so a held pointer records frames even while it is still.
  (fn [db [_ g]]
    (let [active (get-in db [:ui :gesture])
          auto?  (if active (:auto-key? active) (boolean (get-in db [:ui :auto-key?])))]
      (if g
        (let [g  (merge active g {:auto-key? auto?})
-             db (cond-> db
+             db (assoc-in db [:ui :gesture] g)]
-                  (and auto? (nil? active)) (edit/history history/hold)
-                  true (assoc-in [:ui :gesture] g))]
          ;; Materialize the current frame immediately. More pointer moves in the
          ;; same frame only replace the preview; pointer-up forces its last value.
          (if auto?
-           (record-auto-frame db (get-in db [:playback :frame]) false)
+           (record-auto-frame db (get-in db [:playback :frame]))
            db))
-       (cond-> (update db :ui dissoc :gesture)
+       (update db :ui dissoc :gesture)))))
-         (:auto-key? active) (edit/history history/settle))))))
 
 (defn record-auto-frame
-  "Write the active gesture once at outer playback frame `f`. `force?` replaces
+  "Buffer the active gesture at outer playback frame `f`, mapped to the node's
-  the value already sampled for that frame, used for the final pointer value."
+  local frame. Repeated pointer events replace that frame's sample cheaply."
-  [db f force?]
+  [db f]
-  (let [{:keys [auto-key? recorded-frame open path values] :as g}
+  (let [{:keys [auto-key? open path values] :as g}
         (get-in db [:ui :gesture])]
-    (if (and auto-key? (seq values) (or force? (not= f recorded-frame)))
+    (if (and auto-key? (seq values))
       (let [{document :clip st :store} (store/entry (:clip/current db))]
         (if-let [{:keys [sid id frame]} (nest/placement document st open path f)]
-          (-> db
+          (assoc-in db [:ui :gesture]
-              (edit/edit #(gesture/apply-values % sid id frame values true))
+                    (-> g
-              (assoc-in [:ui :gesture] (assoc g :recorded-frame f)))
+                        (assoc :sid sid :id id :frame frame)
+                        (assoc-in [:take [sid id] frame] values)))
           db))
       db)))
 
 (rf/reg-event-db
  ::record-gesture
- (fn [db [_ f]] (record-auto-frame db f false)))
+ (fn [db [_ f]] (record-auto-frame db f)))
 
 (rf/reg-event-db
  ::transform
@@ -806,11 +802,12 @@
  (fn [db [_ g]]
    (let [auto? (boolean (get-in db [:ui :gesture :auto-key?]))]
      (if auto?
-       (-> db
+       (let [db   (-> db
                       (update-in [:ui :gesture] merge g)
-           (record-auto-frame (get-in db [:playback :frame]) true)
+                      (record-auto-frame (get-in db [:playback :frame])))
-           (update :ui dissoc :gesture)
+             take (get-in db [:ui :gesture :take])]
-           (edit/history history/settle))
+         (cond-> (update db :ui dissoc :gesture)
+           (seq take) (edit/edit #(gesture/apply-take % take))))
        (let [{:keys [sid id frame values]} g]
          (cond-> (update db :ui dissoc :gesture)
            (seq values) (edit/edit #(gesture/apply-values % sid id frame values false))))))))

frontend/test/arthur/domain/gesture_test.cljs

@@ -51,6 +51,19 @@
                  (drawn moved [u v :shape]))
           (str "moving " path " by (7, -4) on the stage moves the shape by (7, -4)")))))
 
+(deftest a-buffered-performance-take-becomes-one-set-of-authored-keys
+  (let [c   (paint/new-shape (clip/blank) :main :shape 0 [0 0 10 0 5 10] :brow)
+        out (gesture/apply-take
+             c {[:main :shape]
+                {3 {[:xform :pos] [10 20] [:xform :rot] 0.25}
+                 4 {[:xform :pos] [12 22] [:xform :rot] 0.5}}})]
+    (is (= {3 [10 20], 4 [12 22]}
+           (get-in out [:symbols :main :nodes :shape :channels [:xform :pos] :keys])))
+    (is (= {3 0.25, 4 0.5}
+           (get-in out [:symbols :main :nodes :shape :channels [:xform :rot] :keys])))
+    (is (= :linear
+           (get-in out [:symbols :main :nodes :shape :channels [:xform :pos] :interp])))))
+
 (deftest turning-keeps-the-pivot-where-it-is
   (let [c    (two-down)
         path [u v :shape]