spreadsheet ui

frontend/src/arthur/domain/lane.cljs

@@ -246,6 +246,58 @@
                    nodes members)]
         (finish clip sid nodes (or (when spanning id) lane-id) :keep)))))
 
+(defn sheet-range
+  "Snapshot a rectangle in open-symbol frames. Cel-local clocks and channels
+  survive clipping; gaps are represented by the rectangle's duration."
+  [clip sid lanes [a b]]
+  (let [nodes (get-in clip [:symbols sid :nodes])]
+    (if-not (and (seq lanes) (integer? a) (integer? b) (<= 0 a) (< a b)
+                 (every? #(and (node/lane? (get nodes %))
+                               (= {:at 0 :rate 1} (lane-map nodes %))) lanes))
+      {:refused "range editing requires lanes with the same clock as the sheet"}
+      {:duration (- b a)
+       :columns
+       (mapv (fn [id]
+               (vec (for [n (symbol/lane-cels nodes id)
+                          :let [[lo hi] (node/placed-span n)]
+                          :when (and (< lo b) (> hi a))]
+                      (-> n
+                          (edged :in (max a lo))
+                          (edged :out (min b hi))
+                          (update-in [:time :at] (fnil - 0) a))))) lanes)})))
+
+(defn paste-range
+  "Overwrite a rectangle atomically, including its gaps. IDs are supplied by
+  the caller. Copies share drawings and retain cel-local animation."
+  [clip sid lanes at payload new-id]
+  (let [duration (:duration payload)
+        check (when duration (sheet-range clip sid lanes [at (+ at duration)]))]
+    (cond
+      (:refused payload) payload
+      (not= (count lanes) (count (:columns payload)))
+      {:refused "the copied range does not fit the destination lanes"}
+      (or (nil? duration) (:refused check))
+      (or check {:refused "copy a cel-sheet range first"})
+      (> (+ at duration) (get-in clip [:symbols sid :frames]))
+      {:refused "the copied range extends beyond the shot"}
+      :else
+      (reduce
+       (fn [result [id cels]]
+         (if (:refused result) (reduced result)
+           (let [cleared (blank (:clip result) sid id [at (+ at duration)] {:id (new-id)})]
+             (if (:refused cleared) (reduced cleared)
+               (let [nodes (reduce (fn [nodes n]
+                                     (let [cid (new-id)]
+                                       (assoc nodes cid (-> n
+                                                           (assoc :id cid :parent id :z (str "a-" cid))
+                                                           (update-in [:time :at] + at)))))
+                                   (get-in (:clip cleared) [:symbols sid :nodes]) cels)
+                     result (finish (:clip cleared) sid nodes id :keep)
+                     problems (when (:clip result) (clip/problems (:clip result)))]
+                 (if (seq problems) {:refused (first problems)} result))))))
+       {:clip clip :selection (first lanes)}
+       (map vector lanes (:columns payload))))))
+
 (defn add-lane [clip sid id]
   (if (or (nil? (clip/symbol clip sid)) (get-in clip [:symbols sid :nodes id]))
     {:refused "the symbol is missing or the lane ID is already used"}

frontend/src/arthur/events/ui.cljs

@@ -283,6 +283,27 @@
      {:db (update db :ui dissoc :lane-retry) :dispatch event}
      {})))
 
+(rf/reg-event-db
+ ::sheet-paste
+ (fn [db [_ sid lanes at payload]]
+   (let [clip (:clip (store/entry (:clip/current db)))]
+     (apply-lane-command db sid
+                         (lane/paste-range clip sid lanes at payload random-uuid) nil))))
+
+(rf/reg-event-db
+ ::sheet-hold
+ (fn [db [_ sid id end extent]]
+   (let [clip (:clip (store/entry (:clip/current db)))
+         n (get-in clip [:symbols sid :nodes id])
+         at (lane/lane-frame clip sid (:parent n) end)
+         delta (when at (- at (second (node/placed-span n))))]
+     (if (= 0 delta) db
+       (apply-lane-command db sid
+                           (if delta
+                             (lane/extend-hold clip sid id delta {:extent (or extent :keep)})
+                             {:refused "this lane's frames are not the open symbol's"})
+                           [::sheet-hold sid id end :grow-symbol])))))
+
 (rf/reg-event-db
  ::toggle-row
  (fn [db [_ path]]

frontend/src/arthur/ui/timeline.cljs

@@ -696,15 +696,89 @@
         (filter :cels (rows clip sid #{}))))
 
 (defn- cel-sheet-view []
-  (let [clip @(rf/subscribe [::render/clip])
+  (r/with-let [range-state (r/atom nil)
+               clipboard (atom nil)
+               gesture (r/atom nil)]
+   (let [clip @(rf/subscribe [::render/clip])
+        clip-id @(rf/subscribe [::render/clip-id])
         sid @(rf/subscribe [::render/open])
         frames (max 1 (or @(rf/subscribe [::render/frames]) 1))
         frame @(rf/subscribe [::playback/frame])
         selection @(rf/subscribe [::sub/selection])
         columns (cel-sheet clip sid frames)
+        active (when (and (= sid (:sid @range-state))
+                          (= clip-id (:clip-id @range-state))) @range-state)
+        [ac af] (:anchor active)
+        [bc bf] (:focus active)
+        left (when active (min ac bc))
+        right (when active (max ac bc))
+        top (when active (min af bf))
+        bottom (when active (max af bf))
+        lanes (when (and active (< right (count columns)))
+                (mapv :id (subvec columns left (inc right))))
+        choose! (fn [c f extend?]
+                  (reset! range-state {:sid sid :clip-id clip-id
+                                       :anchor (if (and extend? active) (:anchor active) [c f])
+                                       :focus [c f]})
+                  (rf/dispatch [::pb/seek f])
+                  (rf/dispatch [::ui/select (or (get-in columns [c :cells f :cel :select])
+                                               (:select (nth columns c)))]))
+        clear! #(when lanes
+                  (rf/dispatch [::ui/sheet-paste sid lanes top
+                                {:duration (inc (- bottom top))
+                                 :columns (mapv (constantly []) lanes)}]))
         style {:grid-template-columns
-               (str "52px repeat(" (max 1 (count columns)) ", minmax(110px, 1fr))")}]
-    [:div.cel-sheet {:style style}
+               (str "52px repeat(" (max 1 (count columns)) ", 140px)")}]
+    [:div.cel-sheet
+     {:style style :tab-index 0
+      :aria-label "Cel sheet. Drag to select; Shift extends selection. Copy and paste reuse drawings."
+      :on-pointer-move
+      (fn [e]
+        (when @gesture
+          (when-let [cell (some-> (.elementFromPoint js/document (.-clientX e) (.-clientY e))
+                                  (.closest "[data-cs-col]"))]
+            (let [c (js/Number (.getAttribute cell "data-cs-col"))
+                  f (js/Number (.getAttribute cell "data-cs-frame"))]
+              (if (= :hold (:kind @gesture))
+                (swap! gesture assoc :end (inc f))
+                (swap! range-state assoc :focus [c f]))))))
+      :on-pointer-up
+      (fn [_]
+        (when (= :hold (:kind @gesture))
+          (rf/dispatch [::ui/sheet-hold sid (:id @gesture) (:end @gesture)]))
+        (reset! gesture nil))
+      :on-pointer-cancel #(reset! gesture nil)
+      :on-lost-pointer-capture #(reset! gesture nil)
+      :on-key-down
+      (fn [e]
+        (let [k (.toLowerCase (.-key e))
+              cmd? (or (.-metaKey e) (.-ctrlKey e))
+              arrow (get {"arrowup" [0 -1] "arrowdown" [0 1]
+                          "arrowleft" [-1 0] "arrowright" [1 0]} k)]
+          (when (and lanes (or arrow (#{"delete" "backspace" "escape"} k)
+                               (and cmd? (#{"c" "x" "v"} k))))
+            (.preventDefault e)
+            (.stopPropagation e)
+            (cond
+              (= k "escape") (do (reset! gesture nil) (reset! range-state nil))
+              arrow (let [[dc df] arrow]
+                      (choose! (max 0 (min (dec (count columns)) (+ bc dc)))
+                               (max 0 (min (dec frames) (+ bf df))) (.-shiftKey e)))
+              (#{"delete" "backspace"} k) (clear!)
+              (#{"c" "x"} k)
+              (let [payload (lane/sheet-range clip sid lanes [top (inc bottom)])]
+                (if (:refused payload)
+                  (rf/dispatch [::ui/sheet-paste sid lanes top payload])
+                  (do (reset! clipboard {:clip-id clip-id :payload payload})
+                      (when (= k "x") (clear!)))))
+              (= k "v")
+              (let [payload (when (= clip-id (:clip-id @clipboard)) (:payload @clipboard))
+                    targets (mapv :id (take (count (:columns payload)) (drop left columns)))]
+                (rf/dispatch [::ui/sheet-paste sid targets top payload]))))))}
+     [:div.cs-help {:style {:grid-column "1 / -1"}}
+      (if (= :hold (:kind @gesture))
+        (str "Extend hold to frame " (dec (:end @gesture)) " · later cels move with it")
+        "Drag to select · Shift extends · ⌘/Ctrl C/X/V · Delete clears · drag a hold’s corner to resize")]
      [:div.cs-head.cs-frame "frame"]
      (doall (for [{:keys [path label select]} columns]
               ^{:key (str "head-" path)}
@@ -714,22 +788,45 @@
      (doall
       (for [f (range frames)
             item (cons {:frame-label? true}
-                       (map #(get-in % [:cells f]) columns))]
+                       (map-indexed #(assoc (get-in %2 [:cells f]) :column %1) columns))]
         (if (:frame-label? item)
           ^{:key (str "frame-" f)}
           [:button.cs-frame {:class (when (= f frame) "on")
                              :on-click #(rf/dispatch [::pb/seek f])} f]
-          (let [{:keys [id label select]} (:cel item)
-                target (or select (:lane-select item))]
-            ^{:key (str f "-" (:lane item) "-" (or id "gap"))}
+          (let [{:keys [id label select span]} (:cel item)
+                c (:column item)
+                selected? (and lanes (<= left c right) (<= top f bottom))
+                held? (and id (zero? (get-in clip [:symbols sid :nodes id :playback :speed] 1)))
+                handle? (and held? (= select selection) (= (inc f) (second span)))]
+            ^{:key (str f "-" (:lane item))}
             [:button.cs-cell
              {:class (str (when (= f frame) " current")
-                          (when (and select (= select selection)) " selected"))
+                          (when selected? " selected")
+                          (when (and (= c (:column @gesture)) (= :hold (:kind @gesture))
+                                     (<= (:start @gesture) f) (< f (:end @gesture))) " cs-preview"))
+              :data-cs-col c :data-cs-frame f
               :title (if id (str label " · frame " f) (str "gap · frame " f))
-              :on-click (fn []
-                          (rf/dispatch [::pb/seek f])
-                          (rf/dispatch [::ui/select target]))}
-             (or label "—")]))))]))
+              :on-pointer-down
+              (fn [e]
+                (when (= 0 (.-button e))
+                  (.preventDefault e)
+                  (.focus (.-currentTarget e))
+                  (.setPointerCapture (.-currentTarget e) (.-pointerId e))
+                  (choose! c f (.-shiftKey e))
+                  (reset! gesture {:kind :select})))
+              :on-click #(when (zero? (.-detail %)) (choose! c f (.-shiftKey %)))}
+             (or label "—")
+             (when handle?
+               [:span.cs-fill-handle
+                {:title "Drag to resize hold (ripples later cels)"
+                 :on-pointer-down
+                 (fn [e]
+                   (when (= 0 (.-button e))
+                     (.preventDefault e)
+                     (.stopPropagation e)
+                     (.setPointerCapture (.-currentTarget e) (.-pointerId e))
+                     (reset! gesture {:kind :hold :id id :column c
+                                      :start (first span) :end (second span)})))}])]))))])))
 
 (defn view []
   (if (= :cel-sheet @(rf/subscribe [::sub/time-view]))

frontend/test/arthur/domain/lane_test.cljs

@@ -42,6 +42,37 @@
       :wave (assoc-in (drawing :wave 0 10) [:nodes :mark :channels [:xform :pos]]
                       (ch/keyed {0 [0 0] 9 [900 0]} :linear))}}))
 
+(deftest sheet-copy-clips-without-resetting-source-or-local-keys
+  (let [doc (document)
+        payload (lane/sheet-range doc :main [:girl] [9 11])
+        copied (first (first (:columns payload)))
+        result (lane/paste-range doc :main [:girl] 1 payload random-uuid)
+        nodes (get-in (:clip result) [:symbols :main :nodes])
+        pasted (first (filter #(and (= :wave (node/source %))
+                                   (= [1 3] (node/placed-span %))) (vals nodes)))]
+    (is (= 2 (:duration payload)))
+    (is (= [1 3] (:span copied)))
+    (is (= (:playback copied) (:playback pasted)))
+    (is (= [1 3] (:span pasted)))
+    (is (= :wave (node/source pasted)))
+    (is (empty? (clip/problems (:clip result))))
+    (is (= [0 1] (node/placed-span (:a nodes))))
+    (is (some #(= [3 4] (node/placed-span %)) (vals nodes)))))
+
+(deftest sheet-paste-preserves-gaps-and-refuses-overflow-and-incompatible-clocks
+  (let [doc (document)
+        gap (:clip (lane/blank doc :main :girl [1 3] {:id :remainder}))
+        payload (lane/sheet-range gap :main [:girl] [0 4])
+        result (lane/paste-range gap :main [:girl] 4 payload random-uuid)
+        cels (symbol/lane-cels (get-in (:clip result) [:symbols :main :nodes]) :girl)]
+    (is (empty? (clip/problems (:clip result))))
+    (is (not-any? #(let [[a b] (node/placed-span %)] (and (< a 7) (> b 5))) cels))
+    (is (:refused (lane/paste-range doc :main [:girl] 10 payload random-uuid)))
+    (is (:refused (lane/paste-range doc :main [] 0 payload random-uuid)))
+    (is (:refused (lane/sheet-range
+                  (assoc-in doc [:symbols :main :nodes :girl :time] {:rate 2})
+                  :main [:girl] [0 4])))))
+
 (defn sample [doc fs]
   (let [r (clip/resolver doc :main nil pal/index-of nil)]
     (into {} (map (fn [f] [f (into {} (map (juxt :node :cx)) (r f))])) fs)))

frontend/test/browser/lane.mjs

@@ -75,7 +75,7 @@ try {
   // its `aria-label`, which is also what a screen reader is told it is.
   // Two bars carry commands: the location bar says where an edit lands and holds
   // what creates things there, the transport strip holds what acts on a cel.
-  const bars = ['.loc', '.pane.time .pane-head'];
+  const bars = ['.loc', '.pane.time .pane-head', '.section'];
   const within = (suffix) => bars.map((b) => `${b} ${suffix}`).join(', ');
   const named = label =>
     `(b => b.textContent.trim() === ${JSON.stringify(label)}` +
@@ -113,7 +113,10 @@ try {
     await sleep(180);
     await shut();
   };
-  const shot = async () => (await evaluate('laneSnapshot()'));
+  // UUIDs expose a mutable hash cache through clj->js; compare their identity,
+  // not that implementation detail, when asserting exact undo restoration.
+  const shot = async () => JSON.parse(JSON.stringify(await evaluate('laneSnapshot()'),
+    (_key, value) => value?.uuid ?? value));
   const instances = s => Object.values(s.clip.symbols.main.nodes).filter(n => n.kind === 'instance')
     .sort((a, b) => a.time.at - b.time.at);
   await click('lane');
@@ -285,7 +288,7 @@ try {
   // only appears once a sheet has more than one lane.
   await click('timeline');
   assert.equal(await evaluate('document.querySelectorAll(".tl-cel").length'), 5);
-  await click('+ lane');
+  await click('lane');
   await click('cel sheet');
   assert.equal(await evaluate('document.querySelectorAll(".cs-head:not(.cs-frame)").length'), 2);
   await evaluate(`([...document.querySelectorAll('.cs-cell')].slice(0, 2)
@@ -301,6 +304,76 @@ try {
     'clicking a gap selects that column before overwrite');
   assert.equal(s.history.done.length, before.history.done.length + 12,
     'correction, lane creation, and overwrite are separate undo steps');
+  // Real pointer capture and keyboard events exercise the spreadsheet surface.
+  const cellAt = async (c, f) => evaluate(`(() => {
+    const el = document.querySelector('[data-cs-col="${c}"][data-cs-frame="${f}"]');
+    el.scrollIntoView({block: 'center'});
+    const r = el.getBoundingClientRect();
+    return {x: r.x + r.width / 2, y: r.y + r.height / 2};
+  })()`);
+  const mouse = (type, p) => send('Input.dispatchMouseEvent', {
+    type, ...p, button: 'left', buttons: type === 'mouseReleased' ? 0 : 1, clickCount: 1,
+  });
+  const key = async (key, extra = {}) => {
+    await send('Input.dispatchKeyEvent', {type: 'keyDown', key, ...extra});
+    await send('Input.dispatchKeyEvent', {type: 'keyUp', key, ...extra});
+    await sleep(120);
+  };
+  const start = await cellAt(0, 0);
+  await mouse('mousePressed', start);
+  await mouse('mouseMoved', await cellAt(1, 2));
+  await mouse('mouseReleased', await cellAt(1, 2));
+  await sleep(150);
+  assert.equal(await evaluate('document.querySelectorAll(".cs-cell.selected").length'), 6);
+  await key('c', {modifiers: 2});
+  const dest = await cellAt(0, 10);
+  await mouse('mousePressed', dest);
+  await mouse('mouseReleased', dest);
+  await sleep(120);
+  const beforePaste = await shot();
+  await key('v', {modifiers: 2});
+  const pasted = await shot();
+  assert.equal(pasted.history.done.length, beforePaste.history.done.length + 1,
+    'multi-lane paste is one undo step');
+  assert.deepEqual(Object.keys(pasted.clip.symbols), Object.keys(beforePaste.clip.symbols),
+    'copy reuses the drawings');
+  await key('z', {modifiers: 2});
+  assert.deepEqual((await shot()).clip, beforePaste.clip, 'undo restores the entire rectangle');
+  await key('ArrowDown', {modifiers: 8});
+  assert.equal(await evaluate('document.querySelectorAll(".cs-cell.selected").length'), 2);
+  const first = await cellAt(0, 0);
+  await mouse('mousePressed', first);
+  await mouse('mouseReleased', first);
+  await sleep(150);
+  const handle = await evaluate(`(() => {
+    const r = document.querySelector('.cs-fill-handle').getBoundingClientRect();
+    return {x: r.x + r.width / 2, y: r.y + r.height / 2};
+  })()`);
+  const beforeHold = await shot();
+  await mouse('mousePressed', handle);
+  await mouse('mouseMoved', await cellAt(0, 4));
+  await mouse('mouseReleased', await cellAt(0, 4));
+  await sleep(150);
+  const afterHold = await shot();
+  assert.equal(afterHold.history.done.length, beforeHold.history.done.length + 1,
+    'a hold drag commits once');
+  assert.equal(instances(afterHold).filter(n => {
+    const old = instances(beforeHold).find(o => o.id === n.id);
+    return old && n.span[1] !== old.span[1] && n.time.at + n.span[1] === 5;
+  }).length, 1, 'the dragged hold ends at the previewed boundary');
+  await key('z', {modifiers: 2});
+  assert.deepEqual((await shot()).clip, beforeHold.clip);
+  await key('Delete');
+  const cleared = await shot();
+  assert.equal(cleared.history.done.length, beforeHold.history.done.length + 1,
+    'Delete clears selected frames in one step, without the global node-delete handler');
+  assert.equal(cleared.clip.symbols.main.frames, beforeHold.clip.symbols.main.frames);
+  await key('z', {modifiers: 2});
+  assert.deepEqual((await shot()).clip, beforeHold.clip);
+  await key('x', {modifiers: 2});
+  assert.equal((await shot()).history.done.length, beforeHold.history.done.length + 1);
+  await key('z', {modifiers: 2});
+  assert.deepEqual((await shot()).clip, beforeHold.clip, 'cut is independently undoable');
   assert.equal(errors.length, 0, JSON.stringify(errors));
   console.log('PASS: lane commands and corrections agree from timeline and cel sheet; no server writes');
 } finally {