From 26ada035916c84210cb0d7d79878df00b866375e Mon Sep 17 00:00:00 2001 From: Your Name Date: Thu, 1 Oct 2026 14:37:59 -0400 Subject: [PATCH 01/10] Unify cel editing in the timeline --- docs/correction-authoring-plan.md | 2 + docs/lane-handoff.md | 45 ++- docs/lane-model.md | 10 +- frontend/src/arthur/db.cljs | 1 - frontend/src/arthur/domain/lane.cljs | 152 +++++--- frontend/src/arthur/domain/nest.cljs | 87 ++++- frontend/src/arthur/domain/span.cljs | 15 + frontend/src/arthur/domain/symbol.cljs | 5 +- frontend/src/arthur/events/ui.cljs | 145 +++----- frontend/src/arthur/subs/render.cljs | 8 +- frontend/src/arthur/subs/ui.cljs | 1 - frontend/src/arthur/ui/timeline.cljs | 391 ++++----------------- frontend/test/arthur/domain/lane_test.cljs | 71 ++-- frontend/test/arthur/domain/nest_test.cljs | 19 + frontend/test/arthur/domain/span_test.cljs | 5 + frontend/test/arthur/events/lane_test.cljs | 54 +-- frontend/test/browser/lane.mjs | 339 +++++------------- static/arthur/app.css | 106 ++---- 18 files changed, 534 insertions(+), 922 deletions(-) diff --git a/docs/correction-authoring-plan.md b/docs/correction-authoring-plan.md index 5823fc5..9997d81 100644 --- a/docs/correction-authoring-plan.md +++ b/docs/correction-authoring-plan.md @@ -3,6 +3,8 @@ Written against `2f1c9b9` (2026-09-30), following the lane handoff in `7a54bfc`. Implemented on `codex/correction-authoring`; this now records the scope and acceptance criteria of that implementation. +The cel-sheet targeting work described below was removed with the cel-sheet UI +on 2026-10-01; it remains here only as history of that implementation. Read [lane-handoff.md](lane-handoff.md) and the correction section of [lane-model.md](lane-model.md) first. Their ownership and document rules remain the foundation. The choices below settle the first implementation's scope. diff --git a/docs/lane-handoff.md b/docs/lane-handoff.md index 912df41..83f8538 100644 --- a/docs/lane-handoff.md +++ b/docs/lane-handoff.md @@ -1,11 +1,12 @@ # Lane and cel handoff -Status (2026-09-30): the lane model is implemented through its commands, its -first two views, and correction authoring. Cels are ordinary nodes with their -own playback clock; the timeline draws them as one row and the cel sheet draws -frames down and lanes across. Both views issue the same commands. Rotation and -position corrections can be authored as Constant, Ramp, or Return motion on a -lane or cel, survive regeneration, and expose conflicts for removal or retry. +Status (2026-10-01): the timeline is the one timing interface. Cels are ordinary +nodes with their own playback clock and appear as blocks on one row per drawing +lane. Blocks move by mouse; edge drags trim without overlap; Shift-right-edge +drags ripple every later cel; and the center of a shared cut composes the two +edge edits into a rolling edit. Linked audio follows picture moves while its +edges remain independently trimmable. Rotation and position corrections survive +regeneration and expose conflicts for removal or retry. The commits beginning at `3d3c1bb` are the argument for the model and are worth reading before touching what they did — they are the design record, more than @@ -53,8 +54,6 @@ on purpose: the layout names the RULE — children follow one another and may no overlap — and a group carrying it is called a lane. `node/lane?` is where they meet. -The second view is the CEL SHEET, not the exposure sheet. - ## Decisions already made — do not re-litigate These were each argued out and are load-bearing. Changing one is a design @@ -86,23 +85,23 @@ decision, not a cleanup. - **A cel is not a row.** Rows, expansion and selection are editor state. The document has never known about rows and must not learn. +## Current timeline interaction + +- Creating a symbol inside an aimed drawing lane creates a one-frame cel at the + playhead. Drawing a polygon uses the existing cel there or creates the same + one-frame cel when the frame is empty. +- Dragging a cel body moves it. A linked audio node follows a picture move; + moving or trimming the audio itself remains independent. +- Dragging a right edge changes its endpoint. Growth consumes adjacent spans + instead of overlapping them. Shift-drag inserts or removes lane time by moving + every later cel by the same delta. +- At a shared boundary, the left and right hit zones trim one side. The center + is a rolling edit: right-edge resize followed by left-edge resize at one frame. +- Split, trim-in, and trim-out are direct buttons and are disabled without an + editable selected span. Movement is a mouse gesture, not a toolbar command. + ## Next steps, in order -The cel sheet now supports rectangular selection by pointer drag, Shift-click, -and Shift-arrow, plus an editor-local clipboard (Cmd/Ctrl C/X/V). Paste -overwrites the destination rectangle, including copied gaps, and reuses drawing -symbols. Partial cels retain their local clocks, playback and corrections. -Delete clears frames without closing time. Each cut, paste or clear is one -history transaction. The clipboard belongs to the mounted sheet and current -document; it is not a system clipboard interchange format. - -A selected held cel has a bottom-right resize handle. Dragging previews its new -extent and commits one ripple edit on release; Escape cancels. Overflow uses -the existing explicit shot-extension retry. Rectangle edits currently require -lanes on the sheet's clock and paste must fit within the shot and available -columns. Insert-paste, moving rectangles, and repeating multi-cel patterns with -the handle remain future work. - The implemented correction slice and its remaining UI limits are recorded in [Correction authoring](correction-authoring-plan.md). diff --git a/docs/lane-model.md b/docs/lane-model.md index 1593170..a0b3b1b 100644 --- a/docs/lane-model.md +++ b/docs/lane-model.md @@ -1,9 +1,11 @@ # The Lane Model -Revised 2026-09-30. Target design. Cel ownership, source playback, the -content and cel commands, placement anywhere in a lane, overwrite, a one-row cel -strip, a frame-down cel sheet, correction evaluation, and correction authoring -for rotation and position are implemented. Retiming commands are not. +Revised 2026-10-01. Cel ownership, source playback, one-row drawing lanes, +direct clip movement and edge editing, correction evaluation, and correction +authoring for rotation and position are implemented. The former cel-sheet +projection was removed: the timeline is the single timing interface. Sections +below that describe a cel sheet are retained as design history and are superseded +by this revision. Retiming commands are not. See the status note under [Proof obligations](#proof-obligations-and-implementation-order). diff --git a/frontend/src/arthur/db.cljs b/frontend/src/arthur/db.cljs index 8fe4358..bba47ec 100644 --- a/frontend/src/arthur/db.cljs +++ b/frontend/src/arthur/db.cljs @@ -159,7 +159,6 @@ :ui {:open nil :tabs [] :selection nil - :time-view :timeline :tone :skin-base :tool nil :auto-key? false diff --git a/frontend/src/arthur/domain/lane.cljs b/frontend/src/arthur/domain/lane.cljs index 3c5c743..5bcf3f4 100644 --- a/frontend/src/arthur/domain/lane.cljs +++ b/frontend/src/arthur/domain/lane.cljs @@ -63,6 +63,106 @@ nodes later)] (span/finish clip sid nodes id extent))))) +(defn resize-out + "Put cel `id`'s right edge at lane frame `to`. + + Without `ripple?`, growing the cel consumes the starts of the cels it reaches: + wholly covered cels disappear and the last partially covered one is trimmed. + Shrinking leaves a gap. With `ripple?`, every cel beginning at or after the + old edge moves by the same delta, in either direction, so their contents are + preserved. A lane never contains an overlap in either mode." + [clip sid id to {:keys [extent ripple?] :or {extent :keep ripple? false}}] + (let [nodes (get-in clip [:symbols sid :nodes]) + n (get nodes id) + lane (get nodes (:parent n)) + [lo old-out] (when n (node/placed-span n)) + members (when (node/lane? lane) (symbol/lane-cels nodes (:id lane))) + later (when members + (remove #(= id (:id %)) + (filter #(>= (first (node/placed-span %)) old-out) members))) + broken (first (symbol/lane-problems nodes))] + (cond + (not (node/lane? lane)) {:refused "select a cel in a lane"} + broken {:refused broken} + (not (integer? to)) {:refused "a cel edge goes to a whole lane frame"} + (not (< lo to)) {:refused "a drawing must keep at least one frame"} + (= to old-out) {:clip clip :selection id} + :else + (let [delta (- to old-out) + resized (assoc nodes id (span/edged n :out to)) + changed + (if ripple? + (reduce (fn [ns sibling] + (update-in ns [(:id sibling) :time :at] (fnil + 0) delta)) + resized later) + (if (pos? delta) + (reduce + (fn [ns sibling] + (let [[s e] (node/placed-span sibling)] + (cond + (>= s to) ns + (<= e to) (dissoc ns (:id sibling)) + :else (assoc ns (:id sibling) (span/edged sibling :in to))))) + resized later) + resized))] + (span/finish clip sid changed id extent))))) + +(defn resize-in + "Put cel `id`'s left edge at lane frame `to`. Shrinking leaves a gap; + growing left consumes earlier cels symmetrically with `resize-out`." + [clip sid id to] + (let [nodes (get-in clip [:symbols sid :nodes]) + n (get nodes id) + lane (get nodes (:parent n)) + [old-in hi] (when n (node/placed-span n)) + earlier (when (node/lane? lane) + (remove #(= id (:id %)) + (filter #(<= (second (node/placed-span %)) old-in) + (symbol/lane-cels nodes (:id lane))))) + broken (first (symbol/lane-problems nodes))] + (cond + (not (node/lane? lane)) {:refused "select a cel in a lane"} + broken {:refused broken} + (not (integer? to)) {:refused "a cel edge goes to a whole lane frame"} + (not (< to hi)) {:refused "a drawing must keep at least one frame"} + (neg? to) {:refused "a cel cannot begin before the lane"} + (= to old-in) {:clip clip :selection id} + :else + (let [resized (assoc nodes id (span/edged n :in to)) + changed (if (< to old-in) + (reduce + (fn [ns sibling] + (let [[s e] (node/placed-span sibling)] + (cond + (<= e to) ns + (>= s to) (dissoc ns (:id sibling)) + :else (assoc ns (:id sibling) (span/edged sibling :out to))))) + resized earlier) + resized)] + (span/finish clip sid changed id :keep))))) + +(defn roll + "Move the shared boundary between adjacent cels `left-id` and `right-id`. + This is deliberately only the composition of the two ordinary edge edits." + [clip sid left-id right-id to] + (let [nodes (get-in clip [:symbols sid :nodes]) + left (get nodes left-id) + right (get nodes right-id) + lane (get nodes (:parent left)) + [llo lhi] (when left (node/placed-span left)) + [rlo rhi] (when right (node/placed-span right))] + (cond + (or (not (node/lane? lane)) (not= (:parent left) (:parent right))) + {:refused "a rolling edit needs two cels in one lane"} + (not= lhi rlo) {:refused "a rolling edit needs one shared boundary"} + (not (integer? to)) {:refused "a cel edge goes to a whole lane frame"} + (not (< llo to rhi)) {:refused "both drawings must keep at least one frame"} + :else + (let [left-result (resize-out clip sid left-id to {})] + (if (:refused left-result) + left-result + (resize-in (:clip left-result) sid right-id to)))))) + (defn blank "Clear lane frames `[a b)` of lane `lane-id`, leaving a GAP. @@ -104,58 +204,6 @@ nodes members)] (span/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} (symbol/frame-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 - (span/edged :in (max a lo)) - (span/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 (span/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"} diff --git a/frontend/src/arthur/domain/nest.cljs b/frontend/src/arthur/domain/nest.cljs index fb6940f..2363e51 100644 --- a/frontend/src/arthur/domain/nest.cljs +++ b/frontend/src/arthur/domain/nest.cljs @@ -19,8 +19,10 @@ matrix becomes a `:pinv`, Blender's parent-inverse, and the time a new `:at` and `:rate`. Its channels, keys and span are untouched." (:require [arthur.domain.clip :as clip] + [arthur.domain.lane :as lane] [arthur.domain.node :as node] [arthur.domain.palette :as pal] + [arthur.domain.span :as span] [arthur.domain.symbol :as symbol])) (defn- resolved @@ -342,13 +344,84 @@ (nil? (:time here)) {:refused "a looping instance is in the way"} :else (let [chain (map #(get nodes %) (reverse (rest (symbol/lineage nodes id)))) - d (* df (:rate (reduce node/then-time (:time here) (map node/time-of chain))))] - {:clip (clip/update-symbol - clip (:sid here) update-in [:nodes id] - (fn [n] - (if (= :map (get-in n [:time :mode])) - (update-in n [:time :at] (fnil + 0) d) - (assoc n :time {:mode :map :at d :rate 1}))))})))) + d (* df (:rate (reduce node/then-time (:time here) (map node/time-of chain)))) + shift (fn [n] + (if (= :map (get-in n [:time :mode])) + (update-in n [:time :at] (fnil + 0) d) + (assoc n :time {:mode :map :at d :rate 1}))) + moved (assoc nodes id (shift (get nodes id))) + ;; An editorial audio link follows a moved picture. Moving or + ;; trimming the audio itself remains independent. + moved (if (= :audio (:kind (get nodes id))) + moved + (reduce (fn [ns [audio-id n]] + (if (and (= :audio (:kind n)) (= id (:linked-to n))) + (assoc ns audio-id (shift n)) + ns)) + moved nodes)) + ps (symbol/problems (assoc (clip/symbol clip (:sid here)) :nodes moved))] + (if (seq ps) + {:refused (first ps)} + {:clip (assoc-in clip [:symbols (:sid here) :nodes] moved)}))))) + +(defn resize-out + "Move the right edge of the node at `path` by `df` frames of `open`. + Lane cels use the lane's collision/ripple rules; ordinary clips, including + audio, resize independently." + [clip open path df ripple?] + (let [here (down clip open (pop path)) + sid (:sid here) + id (peek path) + nodes (:nodes (clip/symbol clip sid)) + n (get nodes id)] + (cond + (nil? n) {:refused "nothing to resize"} + (nil? (:time here)) {:refused "a looping instance is in the way"} + :else + (let [chain (map #(get nodes %) (reverse (rest (symbol/lineage nodes id)))) + d (* df (:rate (reduce node/then-time (:time here) (map node/time-of chain)))) + to (+ (second (node/placed-span n)) d)] + (if (node/lane? (get nodes (:parent n))) + (lane/resize-out clip sid id to {:ripple? ripple? :extent :grow-symbol}) + (span/resize-out clip sid id to)))))) + +(defn resize-in + "Move a lane cel's left edge by `df` frames of `open`." + [clip open path df] + (let [here (down clip open (pop path)) + sid (:sid here) + id (peek path) + nodes (:nodes (clip/symbol clip sid)) + n (get nodes id)] + (cond + (nil? n) {:refused "nothing to resize"} + (nil? (:time here)) {:refused "a looping instance is in the way"} + (not (node/lane? (get nodes (:parent n)))) + {:refused "only a lane cel has a collision-free left edge"} + :else + (let [chain (map #(get nodes %) (reverse (rest (symbol/lineage nodes id)))) + d (* df (:rate (reduce node/then-time (:time here) (map node/time-of chain)))) + to (+ (first (node/placed-span n)) d)] + (lane/resize-in clip sid id to))))) + +(defn roll + "Move the shared boundary at `right-path` and the adjacent `left-path`." + [clip open left-path right-path df] + (let [here (down clip open (pop right-path)) + sid (:sid here) + left-id (peek left-path) + right-id (peek right-path) + nodes (:nodes (clip/symbol clip sid)) + right (get nodes right-id)] + (cond + (or (not= (pop left-path) (pop right-path)) (nil? right)) + {:refused "a rolling edit needs adjacent clips in one lane"} + (nil? (:time here)) {:refused "a looping instance is in the way"} + :else + (let [chain (map #(get nodes %) (reverse (rest (symbol/lineage nodes right-id)))) + d (* df (:rate (reduce node/then-time (:time here) (map node/time-of chain)))) + to (+ (first (node/placed-span right)) d)] + (lane/roll clip sid left-id right-id to))))) (defn restack "Put the node at row path `from` just in front of the one at `to` when diff --git a/frontend/src/arthur/domain/span.cljs b/frontend/src/arthur/domain/span.cljs index 49bc43a..edcfa8c 100644 --- a/frontend/src/arthur/domain/span.cljs +++ b/frontend/src/arthur/domain/span.cljs @@ -168,6 +168,21 @@ {:refused (str "frame " to " is not inside this; trim narrows it")} :else (finish clip sid (assoc nodes id (edged node edge to)) id :keep)))) +(defn resize-out + "Put one node's right edge at parent frame `to`, allowing it to grow. + + This is for an ordinary timeline clip, including audio. Lane cels use + `lane/resize-out`, because only a lane has neighbours to trim or ripple." + [clip sid id to] + (let [nodes (get-in clip [:symbols sid :nodes]) + {:keys [node refused]} (subject nodes id) + [lo _] (when node (node/placed-span node))] + (cond + refused {:refused refused} + (not (integer? to)) {:refused "an edge goes to a whole frame"} + (not (< lo to)) {:refused "a clip must keep at least one frame"} + :else (finish clip sid (assoc nodes id (edged node :out to)) id :keep)))) + (defn move "Put node `id` at parent frame `to`, leaving its own length, source and corrections alone — and, in a lane, every other cel. diff --git a/frontend/src/arthur/domain/symbol.cljs b/frontend/src/arthur/domain/symbol.cljs index cda5d5d..a46c621 100644 --- a/frontend/src/arthur/domain/symbol.cljs +++ b/frontend/src/arthur/domain/symbol.cljs @@ -129,9 +129,8 @@ "The symbol's lanes, front-most first. SAME ORDER THE TIMELINE DRAWS ITS ROWS IN — `:z` descending, the id breaking - ties so it is stable across runs — because the cel sheet's columns are those - rows stood on end, and \"the first lane\" has to mean the same thing to the view - that shows them and to the command that defaults to one. + ties so it is stable across runs, so \"the first lane\" means the same thing + to the view that shows it and to commands that inspect the lane order. Only this symbol's own: a lane inside a nested instance belongs to that symbol, and aiming a drawing at it is entering it first." diff --git a/frontend/src/arthur/events/ui.cljs b/frontend/src/arthur/events/ui.cljs index 0658e0d..61f929b 100644 --- a/frontend/src/arthur/events/ui.cljs +++ b/frontend/src/arthur/events/ui.cljs @@ -9,8 +9,8 @@ `lane-model.md` forbids in so many words: \"Selection does not secretly change where a new symbol goes.\" - THE TARGET MOVES ONLY WHEN SOMEBODY AIMS IT. A click on a timeline row label, - a cel-sheet column, or a breadcrumb is aiming — each names a place in the + THE TARGET MOVES ONLY WHEN SOMEBODY AIMS IT. A click on a timeline row label + or a breadcrumb is aiming — each names a place in the document and nothing else. A click on the stage, or on a timeline bar, is not: it says look at this. So `::select` never writes the target, and `::aim` always writes both. @@ -72,13 +72,13 @@ (rf/reg-event-db ::aim ;; The gestures that name a PLACE in the document rather than a thing on - ;; screen: a timeline row label, a cel-sheet column, a breadcrumb. + ;; screen: a timeline row label or a breadcrumb. (fn [db [_ selection]] (aimed db selection))) (rf/reg-event-db ::aim-at - ;; Aiming without selecting, for the cel sheet: the lane becomes where drawings - ;; go, and what is SELECTED stays whatever cel the sheet picked in it. + ;; Aiming without selecting: the lane becomes where drawings go while the + ;; inspector selection remains independent. (fn [db [_ selection]] (assoc-in db [:ui :target] (target-of selection)))) (rf/reg-event-db @@ -95,35 +95,6 @@ (= sid (get-in db [:ui :open]))) n))) -(defn aim-a-lane - "`db` with a lane of the open symbol aimed, if one is not aimed already. - - THE CEL SHEET IS A DRAWING-LANE MODE, so being in it with nothing aimed is not - a state it has anything to say in: every cell belongs to a lane and every new - drawing goes in one. A symbol with no lane at all is the one honest exception, - and the view asks for one to be made rather than this inventing it." - [db] - (let [clip (:clip (store/entry (:clip/current db))) - open (get-in db [:ui :open])] - (if (aimed-lane clip db) - db - (if-let [lane (first (symbol/lanes (get-in clip [:symbols open :nodes])))] - (assoc-in db [:ui :target] {:sid open :id (:id lane) :path [(:id lane)]}) - (update db :ui dissoc :target))))) - -(rf/reg-event-db - ::set-time-view - (fn [db [_ view]] - (if (#{:timeline :cel-sheet} view) - (cond-> (assoc-in db [:ui :time-view] view) - (= :cel-sheet view) aim-a-lane) - db))) - -(rf/reg-event-db - ::aim-a-lane - ;; The cel sheet asks for this when what it had aimed has gone — the lane - ;; deleted under it, or the open symbol changed beneath the view. - (fn [db _] (aim-a-lane db))) (defn apply-lane-command "Commit a successful domain command as one history step. A refused command @@ -364,26 +335,6 @@ {: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 @@ -520,22 +471,17 @@ (defn polygon-landing "Choose the document and row path a finished polygon is drawn into. - In the timeline this follows the explicit target. In the cel sheet the aimed - lane wins, regardless of what is selected on the stage: an occupied frame - lands in its cel and a gap first becomes a drawing. Keeping this decision out - of the event handler makes the selection/target boundary a rule we can assert - without driving re-frame." + An aimed drawing lane wins regardless of what is selected on the stage: an + occupied frame lands in its cel and a gap first becomes a one-frame drawing. + With no lane aimed, ordinary target-based drawing is unchanged." [clip st db] - (if (= :cel-sheet (get-in db [:ui :time-view] :timeline)) - (if-let [lane (aimed-lane clip db)] - (assoc (into-the-lane clip st db lane) :lane? true) - {:refused "make a drawing lane to draw in — the cel sheet has none" - :lane? true}) + (if-let [lane (aimed-lane clip db)] + (assoc (into-the-lane clip st db lane) :lane? true) {:clip clip :path (where-new-goes clip db) :lane? false})) (defn beginning-polygon - "Enter polygon mode, first materializing the cel-sheet lane and drawing when - either is missing. In the timeline this is editor state only. + "Enter polygon mode, first materializing a drawing at the playhead when a + drawing lane is aimed and that frame is empty. Creating here, rather than when the polygon is finished, means the drawing is already the current cel while points are being placed. Cancelling the polygon @@ -543,20 +489,7 @@ [db] (let [{clip :clip st :store} (store/entry (:clip/current db)) open (get-in db [:ui :open]) - sheet? (= :cel-sheet (get-in db [:ui :time-view] :timeline)) - no-lanes? (and sheet? - (empty? (symbol/lanes (get-in clip [:symbols open :nodes])))) - lane-id (when no-lanes? (random-uuid)) - lane-result (if no-lanes? - (lane/add-lane clip open lane-id) - {:clip clip}) - aimed-db (if (and no-lanes? (not (:refused lane-result))) - (assoc-in db [:ui :target] - {:sid open :id lane-id :path [lane-id]}) - db) - landing (if-let [why (:refused lane-result)] - {:refused why :lane? true} - (polygon-landing (:clip lane-result) st aimed-db)) + landing (polygon-landing clip st db) source (:clip landing) made? (and source (not (identical? clip source))) db' (cond @@ -564,13 +497,13 @@ (update db :project merge {:status (:refused landing)}) made? - (-> aimed-db + (-> db (edit/transaction (constantly source)) (assoc-in [:ui :selection] [:node open (peek (:path landing)) (:path landing)])) - :else aimed-db)] + :else db)] (if (:refused landing) db' (update db' :ui merge {:tool :polygon :draft []})))) @@ -634,23 +567,38 @@ (rf/reg-event-db ::new-symbol ;; `where` is `:inside` — in whatever the target names — or `:top`, in the open - ;; symbol regardless of it. Two items on one menu rather than a rule nobody can - ;; see: `lane-model.md` asks that "creation controls next to the breadcrumb act - ;; in that explicit location", and the honest way to offer the other location is - ;; to offer it. + ;; symbol regardless of it. A drawing lane is the temporal form of this same + ;; operation: inside it, a new symbol is a one-frame cel at the playhead. (fn [db [_ where]] (let [{clip :clip st :store} (store/entry (:clip/current db)) + drawing-lane (when (= :inside where) (aimed-lane clip db)) + open (get-in db [:ui :open]) + owner (:frame (nest/inside clip st open [] (get-in db [:playback :frame]))) + at (when (and drawing-lane (number? owner)) + (lane/lane-frame clip open (:id drawing-lane) owner)) + drawing-id (clip/fresh-id clip) + cel-id (random-uuid) down (if (= :top where) [] (where-new-goes clip db)) - {host :sid frame :frame} (nest/inside clip st (get-in db [:ui :open]) down + {host :sid frame :frame} (nest/inside clip st open down (get-in db [:playback :frame])) - sid (clip/fresh-id clip) uuid (random-uuid)] - (if-not host + (if drawing-lane + (let [result (if (integer? at) + (lane/overwrite-drawing clip open (:id drawing-lane) cel-id drawing-id at + {:extent :grow-symbol + :remainder-id (random-uuid)}) + {:refused "the playhead is not on one frame of this lane"})] + (if-let [why (:refused result)] + (update db :project merge {:status why}) + (-> db + (edit/transaction (constantly (:clip result))) + (assoc-in [:ui :selection] [:node open cel-id [cel-id]])))) + (if-not host (update db :project merge {:status "what you are adding to is not on screen at this frame"}) (let [made [:node host uuid (conj down uuid)]] (-> db - (edit/transaction #(clip/new-symbol % host sid frame uuid)) + (edit/transaction #(clip/new-symbol % host drawing-id frame uuid)) ;; AIMED AT WHAT IT MADE. A symbol is made to put things in, so the ;; next thing made goes in it; the outline says so before anybody ;; has to find out by drawing. @@ -658,7 +606,7 @@ ;; Open every row down to it, or the new row is inside a closed one ;; and the button looks like it did nothing. (update-in [:ui :expanded] (fnil into #{}) - (rest (reductions conj [] down))))))))) + (rest (reductions conj [] down)))))))))) ;; --------------------------------------------------------------------------- ;; a drop in flight @@ -729,16 +677,23 @@ ::sliding ;; A bar in the middle of a slide, drawn by `::render/clip`; nil path when the ;; drag is abandoned. - (fn [db [_ path df]] + (fn [db [_ path df kind ripple? other]] (if path - (assoc-in db [:ui :sliding] {:path path :df df}) + (assoc-in db [:ui :sliding] {:path path :df df :kind (or kind :slide) + :ripple? (boolean ripple?) :other other}) (update db :ui dissoc :sliding)))) (rf/reg-event-db ::slide - (fn [db [_ path df]] + (fn [db [_ path df kind ripple? other]] (let [db (update db :ui dissoc :sliding) - r (nest/slide (:clip (store/entry (:clip/current db))) (get-in db [:ui :open]) path df)] + clip (:clip (store/entry (:clip/current db))) + open (get-in db [:ui :open]) + r (case kind + :out (nest/resize-out clip open path df ripple?) + :in (nest/resize-in clip open path df) + :roll (nest/roll clip open other path df) + (nest/slide clip open path df))] (cond (zero? df) db (:refused r) (refused db (:refused r)) diff --git a/frontend/src/arthur/subs/render.cljs b/frontend/src/arthur/subs/render.cljs index f6716df..fabeb39 100644 --- a/frontend/src/arthur/subs/render.cljs +++ b/frontend/src/arthur/subs/render.cljs @@ -44,8 +44,12 @@ ;; lets go, so the stage and the rows follow the pointer. Nothing is written ;; until then: one drag is one undo step and one write to collaborators. (let [c (:clip (footage/entry id))] - (or (when-let [{:keys [path df]} sliding] - (:clip (nest/slide c open path df))) + (or (when-let [{:keys [path df kind ripple? other]} sliding] + (:clip (case kind + :out (nest/resize-out c open path df ripple?) + :in (nest/resize-in c open path df) + :roll (nest/roll c open other path df) + (nest/slide c open path df)))) (when-let [{:keys [sid id frame values]} gesture] ;; A held stage control owns the touched parameters completely. Make ;; them temporary static channels for the preview, so their existing diff --git a/frontend/src/arthur/subs/ui.cljs b/frontend/src/arthur/subs/ui.cljs index 4086778..5631061 100644 --- a/frontend/src/arthur/subs/ui.cljs +++ b/frontend/src/arthur/subs/ui.cljs @@ -13,7 +13,6 @@ (rf/reg-sub ::selection (fn [db _] (get-in db [:ui :selection]))) (rf/reg-sub ::target (fn [db _] (get-in db [:ui :target]))) -(rf/reg-sub ::time-view (fn [db _] (get-in db [:ui :time-view] :timeline))) (rf/reg-sub ::lane-retry (fn [db _] (get-in db [:ui :lane-retry]))) (rf/reg-sub ::tone (fn [db _] (get-in db [:ui :tone]))) (rf/reg-sub ::tool (fn [db _] (get-in db [:ui :tool]))) diff --git a/frontend/src/arthur/ui/timeline.cljs b/frontend/src/arthur/ui/timeline.cljs index 79689a2..46c1dcb 100644 --- a/frontend/src/arthur/ui/timeline.cljs +++ b/frontend/src/arthur/ui/timeline.cljs @@ -24,7 +24,6 @@ [arthur.domain.node :as node] [arthur.domain.clip :as clip] [arthur.domain.nest :as nest] - [arthur.domain.lane :as lane] [arthur.domain.span :as span] [arthur.domain.symbol :as symbol] [arthur.domain.trace :as trace] @@ -32,7 +31,6 @@ [arthur.events.ui :as ui] [arthur.footage.store :as store] [arthur.ui.icon :as icon] - [arthur.ui.menu :as menu] [arthur.subs.playback :as playback] [arthur.subs.render :as render] [arthur.subs.ui :as sub] @@ -231,7 +229,6 @@ rate @(rf/subscribe [::playback/rate]) loop? @(rf/subscribe [::playback/loop?]) muted? @(rf/subscribe [::playback/muted?]) - view @(rf/subscribe [::sub/time-view]) frame @(rf/subscribe [::playback/frame]) frames @(rf/subscribe [::render/frames]) {:keys [fps drop]} @player/meter @@ -241,12 +238,7 @@ [_ sid id] selection open @(rf/subscribe [::render/open]) st (:store (store/entry clip-id)) - sheet? (= :cel-sheet view) n (get-in clip [:symbols sid :nodes id]) - lane (if (node/lane? n) n (get-in clip [:symbols sid :nodes (:parent n)])) - lane? (node/lane? lane) - cel? (and lane? (= :instance (:kind n)) (some? (node/source n))) - held? (and cel? (zero? (:speed (node/playback-of n)))) ;; A SPAN IS A SPAN WHEREVER IT SITS. What `span/split`, `trim` and ;; `move` need is one node with a place in time, which a symbol dropped ;; straight into a shot has as surely as a cel does — so these are @@ -265,10 +257,6 @@ host (when (number? owner-frame) (span/host-frame clip sid id owner-frame)) cuttable? (and span? (integer? host) (let [[lo hi] (node/placed-span n)] (< lo host hi))) - movable? (and span? (integer? host)) - at (when (and lane? (number? owner-frame)) - (lane/lane-frame clip sid (:id lane) owner-frame)) - insertable? (and lane? (integer? at)) act (fn [event] #(rf/dispatch event))] [:div.pane-head ;; ----------------------------------------------------------------- time @@ -308,97 +296,18 @@ (doall (for [[r label] [[0.25 "¼×"] [0.5 "½×"] [1.0 "1×"] [2.0 "2×"] [4.0 "4×"]]] ^{:key r} [:option {:value r} label]))]] [:span.sep] - ;; ----------------------------------------------------------------- view - ;; TWO VIEWS OF ONE THING, and you are always in exactly one. Two separate - ;; toggles said neither half of that; joined, with the one in force filled, - ;; the control is the statement. - [:div.seg {:role "radiogroup" :aria-label "time view"} - (doall - (for [[k label title] [[:timeline "timeline" "lanes across, frames left to right"] - [:cel-sheet "cel sheet" "frames down, one column per lane"]]] - ^{:key k} - [:button {:class (when (= k view) "on") :role "radio" - :aria-checked (= k view) :title title - :on-click (act [::ui/set-time-view k])} - label]))] - [:span.sep] - ;; ------------------------------------------------------------- commands - ;; GROUPED BY WHAT THEY NEED, not by which view they were built in. - ;; - ;; `timing` is always here. Split, trim and move are one write to one - ;; node's span or position, and that is a fact every placement has: a - ;; symbol laid out in a shot is cut and trimmed exactly as a cel is, and - ;; the lane gate they used to carry was a leftover from a lane being the - ;; only thing anybody had timed. Judging a cut against the other rows is - ;; also the timeline's whole shape, so hiding them here would have cost - ;; the view the one thing it is best at. - ;; - ;; `drawing` and `hold` are the CEL SHEET's and appear only there. Each one - ;; needs a SEQUENCE — a ripple needs later siblings, a gap needs a row to - ;; be a hole in — and a sequence is what a lane is. Choosing how many - ;; frames a drawing is exposed for is plate-side work; the timeline is the - ;; performance side. - ;; - ;; `new drawing` is NOT here, in either view. Drawing a polygon on an empty - ;; frame of the aimed lane makes the drawing that was missing, so the - ;; button said what the gesture already says. `N` still does it from the - ;; sheet, for the draw-N-draw-N rhythm that wants a key and not a menu. - ;; - ;; `make unique` is NOT here either. It is offered on the location bar, - ;; beside the count of how many places share the drawing — which is the - ;; fact somebody needs before deciding to decouple one, and is why that row - ;; exists at all. `ui/location`. - ;; - ;; `new` is on the location bar for the same kind of reason: creating a - ;; symbol acts at the location the breadcrumb names, not on a cel. - [menu/view - {:label "timing" :title "where this sits and how long it lasts" - :note "select a cel, or anything else placed in time" - :items [{:label "split" :disabled? (not cuttable?) - :sub "cut this in two at the playhead; the picture does not change" - :on-click (act [::ui/split])} - {:label "trim in" :disabled? (not cuttable?) - :sub "start this at the playhead; nothing else moves" - :on-click (act [::ui/trim :in])} - {:label "trim out" :disabled? (not cuttable?) - :sub "end this at the playhead; nothing else moves" - :on-click (act [::ui/trim :out])} - {:label "move here" :disabled? (not movable?) - :sub "put this at the playhead; in a lane, refused if something is there" - :on-click (act [::ui/move])}]}] - (when sheet? - [:<> - [menu/view - {:label "drawing" :title "what the aimed lane exposes" - :note "select a cel in the sheet" - :items [{:label "insert" :disabled? (not insertable?) - :sub "a new drawing at the playhead; later drawings ripple later" - :on-click (act [::ui/insert-drawing])} - {:label "overwrite" :disabled? (not insertable?) - :sub "replace the drawing at the playhead; later drawings stay put" - :on-click (act [::ui/overwrite-drawing])} - {:label "reuse" :disabled? (not cel?) - :sub "expose this same drawing again — one drawing, two cels" - :on-click (act [::ui/reuse-drawing])} - {:label "duplicate" :disabled? (not cel?) - :sub "append a copy of this drawing, to draw the next one over it" - :on-click (act [::ui/duplicate-drawing])} - {:label "blank" :disabled? (not cel?) - :sub "clear this cel's frames, leaving a gap; later drawings stay put" - :on-click (act [::ui/blank-cel])}]}] - ;; THE ONE PAIR THAT STAYS A BUTTON. Deciding how many frames a drawing - ;; is held for is shooting on ones or twos — the most repeated edit in - ;; the list, done by eye, a frame at a time. Two clicks into a menu per - ;; frame would be the one place this consolidation made the tool worse. - [:span.stepper - [:span.stepper-label "hold"] - [:span.group - [:button {:disabled (not held?) :aria-label "hold −" - :title "shorten this cel; ripple later drawings, keeping lane keys fixed" - :on-click (act [::ui/extend-hold -1])} "−"] - [:button {:disabled (not held?) :aria-label "hold +" - :title "extend this cel; ripple later drawings, keeping lane keys fixed" - :on-click (act [::ui/extend-hold 1])} "+"]]]]) + ;; The same direct timing operations apply to any selected span, whether it + ;; is at the root or is a cel inside a drawing lane. + [:div.group.timing-controls {:aria-label "timing"} + [:button {:disabled (not cuttable?) :aria-label "split" + :title "split the selected clip at the playhead" + :on-click (act [::ui/split])} "split"] + [:button {:disabled (not cuttable?) :aria-label "trim in" + :title "move the selected clip's start to the playhead" + :on-click (act [::ui/trim :in])} "in"] + [:button {:disabled (not cuttable?) :aria-label "trim out" + :title "move the selected clip's end to the playhead" + :on-click (act [::ui/trim :out])} "out"]] [:span.spacer] ;; After the spacer, both of them: an offer that appears and a reading that ;; comes and goes must not shove the fixed controls sideways when they do. @@ -542,18 +451,33 @@ :df}`. What it looks like mid-drag is `[:ui :sliding]`, which the clip every row and the stage are drawn from already has in it." [{:keys [path span keys dense? kind node-kind select slides cels]} frames sliding] - (let [{from :path x0 :x width :width} @sliding + (let [active-row (:row @sliding) slide (fn [^js e] + (let [{from :row x0 :x width :width} @sliding] (when (= path from) (let [df (js/Math.round (/ (* frames (- (.-clientX e) x0)) (max 1 width)))] (when (not= df (:df @sliding)) (swap! sliding assoc :df df) - (rf/dispatch [::ui/sliding (or slides path) df]))))) + (rf/dispatch [::ui/sliding (:path @sliding) df + (:kind @sliding) (:ripple? @sliding) + (:other @sliding)])))))) done (fn [commit?] - (when (= path from) - (let [df (:df @sliding)] + (when (= path (:row @sliding)) + (let [{:keys [path df kind ripple? other]} @sliding] (reset! sliding nil) - (rf/dispatch (if commit? [::ui/slide (or slides path) df] [::ui/sliding nil])))))] + (rf/dispatch (if commit? [::ui/slide path df kind ripple? other] + [::ui/sliding nil]))))) + begin! (fn [^js e actual-path gesture-kind actual-select other] + (let [track (.closest (.-currentTarget e) ".tl-track")] + (.stopPropagation e) + (when actual-select (rf/dispatch [::ui/select actual-select])) + (reset! sliding {:row path :path actual-path :kind gesture-kind + :other other + :ripple? (and (= :out gesture-kind) (.-shiftKey e)) + :x (.-clientX e) :df 0 + :width (.-width (.getBoundingClientRect track))}) + (try (.setPointerCapture track (.-pointerId e)) + (catch :default _ nil))))] [:div.tl-track ;; The track, not the bar, holds the pointer while a bar slides, so the drag ;; goes on when the bar has slid off the ruler and is no longer drawn. @@ -566,37 +490,51 @@ (when (< in out) [:div {:class (str "tl-span" (when dense? " dense") (when (= :ghost kind) " ghost") (when (= :audio node-kind) " sound") - (when select " movable") (when (= path from) " sliding")) + (when select " movable") (when (= path active-row) " sliding")) :style {:left (edge% in frames) :width (str (* 100 (/ (- out in) (max 1 frames))) "%")} :on-pointer-down (when select - (fn [^js e] - (let [track (.. e -currentTarget -parentElement)] - (.stopPropagation e) - (rf/dispatch [::ui/select select]) - (reset! sliding {:path path :x (.-clientX e) :df 0 - :width (.-width (.getBoundingClientRect track))}) - ;; As on the ruler: an enhancement that throws on a pointer - ;; the browser has no record of. - (try (.setPointerCapture track (.-pointerId e)) - (catch :default _ nil)))))}])) + #(begin! % (or slides path) :slide select nil))} + (when select + [:span.tl-edge.out {:title "Drag endpoint · Shift-drag ripples later clips" + :on-pointer-down #(begin! % path :out select nil)}])])) (doall - (for [{:keys [id label source span select]} cels - :let [in (max 0 (first span)) out (min frames (second span))] + (for [[i {:keys [id label source span select]}] (map-indexed vector cels) + :let [prev (when (pos? i) (nth cels (dec i))) + joined? (and prev (= (second (:span prev)) (first span))) + in (max 0 (first span)) out (min frames (second span))] :when (< in out)] ^{:key (str id)} [:button.tl-cel {:title (str label " · select cel; double-click to edit shared drawing") :style {:position "absolute" :left (edge% in frames) :width (str (* 100 (/ (- out in) (max 1 frames))) "%") - :top "2px" :bottom "2px" :overflow "hidden" :padding "0 3px"} + :top "2px" :bottom "2px" :overflow "visible" :padding "0 3px"} + :on-pointer-down #(begin! % (nth select 3) :slide select nil) :on-click (fn [e] (.stopPropagation e) (rf/dispatch [::ui/select select]) (rf/dispatch [::pb/seek (js/Math.floor in)])) :on-double-click (fn [e] (.stopPropagation e) (when source (rf/dispatch [::pb/open-symbol source])))} - label])) + [:span.tl-cel-label label] + (if joined? + [:span.tl-junction + {:title "Left: trim left · center: roll cut · right: trim right" + :on-pointer-down + (fn [^js e] + (let [box (.getBoundingClientRect (.-currentTarget e)) + x (/ (- (.-clientX e) (.-left box)) (max 1 (.-width box))) + left-path (nth (:select prev) 3) + right-path (nth select 3)] + (cond + (< x 0.34) (begin! e left-path :out (:select prev) nil) + (> x 0.66) (begin! e right-path :in select nil) + :else (begin! e right-path :roll select left-path))))}] + [:span.tl-edge.in {:title "Drag start" + :on-pointer-down #(begin! % (nth select 3) :in select nil)}]) + [:span.tl-edge.out {:title "Drag endpoint · Shift-drag ripples later clips" + :on-pointer-down #(begin! % (nth select 3) :out select nil)}]])) ;; A dense channel has a value on every frame, so ticking each one is a solid ;; block that says less than the bar behind it already does. (when-not dense? @@ -717,210 +655,5 @@ [:div.tl-empty "nothing in this symbol"]) [:div.tl-playhead {:style {:left (at% frame frames)}}]]]]))) -(defn cel-sheet - "The cel-sheet projection of one symbol: frames down, one column per lane. - It reuses `rows`, so its spans and selection addresses are exactly the ones - the timeline presents rather than a second interpretation of the document." - [clip sid frames] - (mapv (fn [{:keys [path label cels select]}] - {:id (peek path) - :path path - :select select - :label label - :cells (mapv (fn [f] - (let [cel (some (fn [{[in out] :span :as cel}] - (when (and (<= in f) (< f out)) cel)) - cels)] - {:frame f :lane (peek path) :lane-select select :cel cel})) - (range frames))}) - (filter :cels (rows clip sid #{})))) - -(defn- cel-sheet-view [] - (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]) - target @(rf/subscribe [::sub/target]) - columns (cel-sheet clip sid frames) - ;; THE AIMED LANE, and there is always one while this view is up. The - ;; sheet is a drawing-lane mode: every cell belongs to a lane and every - ;; new drawing goes in one, so "nothing aimed" is a state it has nothing - ;; to say in. Enforced HERE rather than in the event that switches view, - ;; because the lane can also go stale under it — deleted, or the open - ;; symbol changed — and this is the only place that notices. - aimed (when (some #(= (:id %) (:id target)) columns) (:id target)) - _ (when (and (nil? aimed) (seq columns)) (rf/dispatch [::ui/aim-a-lane])) - 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)))) - ;; TWO DISPATCHES, BECAUSE THEY ARE TWO FACTS. Clicking a cell AIMS at - ;; the column's lane — that is where the next drawing goes — and SELECTS - ;; whatever is in the cell, which is what the inspector then shows. A - ;; gap selects the lane itself, there being nothing in it to inspect. - 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/aim-at (:select (nth columns c))]) - (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)) ", 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 (= "n" k) (not cmd?) aimed) - ;; THE ONE THING THE DELETED BUTTON DID THAT DRAWING CANNOT SAY. - ;; Drawing on an empty frame makes the drawing there, which covers - ;; every case but one: wanting the NEXT drawing when the playhead is - ;; not yet on an empty frame. `append-drawing` puts it past the end - ;; of the lane and seeks to it, so draw-N-draw-N keeps its rhythm - ;; without a trip to a menu. `lane-model.md` calls this one `N` too. - (.preventDefault e) - (.stopPropagation e) - (rf/dispatch [::ui/append-drawing])) - (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 id]} columns] - ^{:key (str "head-" path)} - ;; A HEAD AIMS AND DOES NOT SELECT. Clicking a column's name says - ;; "drawings go here"; it is not a claim about anything to inspect, - ;; so the inspector keeps whatever cel it was showing. - [:button.cs-head {:class (str (when (= select selection) " selected") - (when (= id aimed) " aimed")) - :title (if (= id aimed) - (str label " · new drawings go here") - (str label " · aim new drawings here")) - :on-click #(rf/dispatch [::ui/aim-at select])} - ;; No name tag here, unlike the stage's outline: the thing the - ;; outline is around IS the name. A tag would repeat it. - label])) - (doall - (for [f (range frames) - item (cons {:frame-label? true} - (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 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 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-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- no-lanes - "What the cel sheet has to say about a symbol with nothing to show frames of. - - AN EMPTY GRID IS NOT AN ANSWER. The sheet is one column per lane, so a symbol - with no lane renders as a frame ruler and nothing beside it — which looks like - the view is broken rather than like the document is empty. The one thing - anybody can do from here is the one thing offered." - [] - [:div.cs-empty - [:p "This symbol has no drawing lanes."] - [:p.dim "The cel sheet shows one column per lane: frames down, drawings across."] - [:button {:on-click #(rf/dispatch [::ui/new-lane])} "make a drawing lane"]]) - (defn view [] - (if (= :cel-sheet @(rf/subscribe [::sub/time-view])) - (let [clip @(rf/subscribe [::render/clip]) - open @(rf/subscribe [::render/open])] - [:section.pane.time - [transport] - (if (seq (symbol/lanes (get-in clip [:symbols open :nodes]))) - [cel-sheet-view] - [no-lanes])]) - [timeline-view])) + [timeline-view]) diff --git a/frontend/test/arthur/domain/lane_test.cljs b/frontend/test/arthur/domain/lane_test.cljs index b8290de..203f38a 100644 --- a/frontend/test/arthur/domain/lane_test.cljs +++ b/frontend/test/arthur/domain/lane_test.cljs @@ -43,36 +43,6 @@ :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)] @@ -122,7 +92,46 @@ (doseq [delta [0 -4 0.5 js/NaN]] (is (:refused (lane/extend-hold doc :main :a delta {})))) (is (:refused (lane/extend-hold doc :main :insert 1 {}))) - (is (:refused (lane/extend-hold doc :main :missing 1 {}))))) + (is (:refused (lane/extend-hold doc :main :missing 1 {}))))) + +(deftest dragging-a-cel-edge-trims-neighbours-or-ripples-them + (let [doc (document) + plain (:clip (lane/resize-out doc :main :a 6 {})) + across (:clip (lane/resize-out doc :main :a 9 {})) + ripple (:clip (lane/resize-out doc :main :a 6 {:ripple? true + :extent :grow-symbol})) + shrink (:clip (lane/resize-out doc :main :a 2 {:ripple? true}))] + (is (= [[0 6] [6 8] [8 12]] + (mapv node/placed-span (symbol/lane-cels (get-in plain [:symbols :main :nodes]) :girl))) + "a normal grow eats the beginning of the adjacent cel") + (is (= [[0 9] [9 12]] + (mapv node/placed-span (symbol/lane-cels (get-in across [:symbols :main :nodes]) :girl))) + "a long grow removes wholly consumed cels and trims the survivor") + (is (= [[0 6] [6 10] [10 14]] + (mapv node/placed-span (symbol/lane-cels (get-in ripple [:symbols :main :nodes]) :girl))) + "shift-grow moves every later cel") + (is (= [[0 2] [2 6] [6 10]] + (mapv node/placed-span (symbol/lane-cels (get-in shrink [:symbols :main :nodes]) :girl))) + "shift-shrink pulls every later cel left") + (is (:refused (lane/resize-out doc :main :a 0 {}))) + (is (:refused (lane/resize-out doc :main :a 2.5 {}))))) + +(deftest the-middle-of-a-cut-rolls-both-edges + (let [doc (document) + rolled (:clip (lane/roll doc :main :a :b 6)) + right-only (:clip (lane/resize-in doc :main :b 6)) + grown-left (:clip (lane/resize-in doc :main :b 2))] + (is (= [[0 6] [6 8] [8 12]] + (mapv node/placed-span (symbol/lane-cels (get-in rolled [:symbols :main :nodes]) :girl))) + "the shared cut moves without moving either clip") + (is (= [[0 4] [6 8] [8 12]] + (mapv node/placed-span (symbol/lane-cels (get-in right-only [:symbols :main :nodes]) :girl))) + "the right side of the junction trims only the right clip") + (is (= [[0 2] [2 8] [8 12]] + (mapv node/placed-span (symbol/lane-cels (get-in grown-left [:symbols :main :nodes]) :girl))) + "growing the right clip left trims the neighbour instead of overlapping") + (is (:refused (lane/roll doc :main :a :b 0))) + (is (:refused (lane/roll doc :main :a :insert 6))))) (deftest a-gap-is-an-uncovered-interval (let [doc (update-in (document) [:symbols :main :nodes] dissoc :b) diff --git a/frontend/test/arthur/domain/nest_test.cljs b/frontend/test/arthur/domain/nest_test.cljs index 0fafeca..52c27d8 100644 --- a/frontend/test/arthur/domain/nest_test.cljs +++ b/frontend/test/arthur/domain/nest_test.cljs @@ -222,6 +222,25 @@ :main [a-uuid :inner] 3)) "but through a loop one frame outside is many inside"))) +(deftest linked-audio-follows-picture-moves-but-keeps-independent-edges + (let [c (-> (clip/blank) + (assoc-in [:symbols :drawing] {:id :drawing :frames 8 :nodes {}}) + (clip/place-symbol nil :main :drawing 2 :picture nil) + (clip/place-sound :main {:sound "voice"} "voice" 8 1 2 :voice) + (assoc-in [:symbols :main :nodes :voice :linked-to] :picture)) + moved (:clip (nest/slide c :main [:picture] 3)) + audio-only (:clip (nest/slide c :main [:voice] 1)) + trimmed (:clip (nest/resize-out c :main [:voice] -2 false))] + (is (= [5 13] (node/placed-span (get-in moved [:symbols :main :nodes :picture])))) + (is (= [5 13] (node/placed-span (get-in moved [:symbols :main :nodes :voice]))) + "moving picture carries its linked audio") + (is (= [2 10] (node/placed-span (get-in audio-only [:symbols :main :nodes :picture])))) + (is (= [3 11] (node/placed-span (get-in audio-only [:symbols :main :nodes :voice]))) + "moving audio itself does not carry picture") + (is (= [2 8] (node/placed-span (get-in trimmed [:symbols :main :nodes :voice]))) + "an audio endpoint trims independently") + (is (= [2 10] (node/placed-span (get-in trimmed [:symbols :main :nodes :picture])))))) + (deftest restacking-is-one-write-to-z (let [shape (fn [z] {:kind :poly :z z :channels {}}) c (-> (clip/blank) diff --git a/frontend/test/arthur/domain/span_test.cljs b/frontend/test/arthur/domain/span_test.cljs index b9c8c32..a585859 100644 --- a/frontend/test/arthur/domain/span_test.cljs +++ b/frontend/test/arthur/domain/span_test.cljs @@ -161,6 +161,11 @@ (is (:refused (span/trim doc :main :b :middle 6))) (is (re-find #"group" (:refused (span/trim doc :main :girl :out 6)))))) +(deftest timeline-edge-resize-allows-an-ordinary-clip-to-grow + (let [after (:clip (span/resize-out (document) :main :badge 11))] + (is (= [2 11] (node/placed-span (get-in after [:symbols :main :nodes :badge])))) + (is (:refused (span/resize-out (document) :main :badge 2))))) + ;; --------------------------------------------------------------------------- ;; move diff --git a/frontend/test/arthur/events/lane_test.cljs b/frontend/test/arthur/events/lane_test.cljs index f751f78..5008a1a 100644 --- a/frontend/test/arthur/events/lane_test.cljs +++ b/frontend/test/arthur/events/lane_test.cljs @@ -22,21 +22,6 @@ (is (= [0 6 12] (:keys lane))) (is (= 1 (count (filter :cels (timeline/rows doc :main #{[:girl]}))))))) -(deftest the-cel-sheet-is-the-same-cels-with-the-axes-turned - (let [doc (fixture/document) - column (first (timeline/cel-sheet doc :main 12)) - cells (:cells column)] - (is (= :girl (:id column))) - (is (= [:node :main :girl [:girl]] (:select column))) - (is (every? #(= (:select column) (:lane-select %)) cells)) - (is (= [:a :b :insert] (mapv #(get-in cells [% :cel :id]) [0 4 8]))) - (is (= [[:node :main :a [:a]] - [:node :main :b [:b]] - [:node :main :insert [:insert]]] - (mapv #(get-in cells [% :cel :select]) [0 4 8]))) - (is (= (mapv :select (:cels (first (filter :cels (timeline/rows doc :main #{}))))) - (mapv #(get-in cells [% :cel :select]) [0 4 8]))))) - (deftest a-nested-selection-converts-the-open-playhead-to-its-owning-symbol (let [doc (assoc-in (fixture/document) [:symbols :outer] {:id :outer :frames 30 @@ -52,7 +37,6 @@ (deftest polygon-landing-follows-the-target-not-the-selection (let [doc (fixture/document) db {:ui {:open :main - :time-view :timeline :selection [:node :main :plate [:plate]] :target {:sid :main :id :insert :path [:insert]}} :playback {:frame 5}} @@ -62,10 +46,9 @@ "looking at another shape does not silently move the creation target") (is (false? (:lane? landing))))) -(deftest cel-sheet-polygon-landing-is-decided-by-the-aimed-lane +(deftest timeline-polygon-landing-is-decided-by-the-aimed-lane (let [doc (fixture/document) base {:ui {:open :main - :time-view :cel-sheet :selection [:node :main :plate [:plate]] :target {:sid :main :id :girl :path [:girl]}} :playback {:frame 5}} @@ -84,22 +67,22 @@ (first (:path gap)))) (is (empty? (clip/problems (:clip gap)))))) -(deftest cel-sheet-polygon-landing-refuses-without-an-aimed-lane +(deftest polygon-landing-without-an-aimed-lane-uses-the-ordinary-target (let [doc (fixture/document) - db {:ui {:open :main :time-view :cel-sheet + db {:ui {:open :main :target {:sid :main :id :plate :path [:plate]}} :playback {:frame 5}} landing (ui/polygon-landing doc {} db)] - (is (re-find #"drawing lane" (:refused landing))) - (is (true? (:lane? landing))) - (is (nil? (:clip landing))))) + (is (= doc (:clip landing))) + (is (= [] (:path landing))) + (is (false? (:lane? landing))))) -(deftest beginning-a-polygon-materializes-a-missing-cel-sheet-drawing +(deftest beginning-a-polygon-materializes-a-missing-timeline-drawing (let [doc (fixture/document) with-gap (:clip (lane/blank doc :main :girl [5 7] {:id :rest})) id (store/install! {:clip with-gap :store {}} "polygon-start-test") db {:clip/current id :paint/revision 0 - :ui {:open :main :time-view :cel-sheet + :ui {:open :main :target {:sid :main :id :girl :path [:girl]}} :playback {:frame 6}} after (ui/beginning-polygon db) @@ -114,28 +97,19 @@ (is (= 6 (get-in saved [:symbols :main :nodes cel-id :time :at]))) (is (empty? (clip/problems saved))))) -(deftest beginning-a-polygon-materializes-a-lane-before-its-drawing +(deftest beginning-a-polygon-does-not-invent-an-unselected-lane (let [doc (clip/blank) id (store/install! {:clip doc :store {}} "polygon-lane-start-test") db {:clip/current id :paint/revision 0 - :ui {:open :main :time-view :cel-sheet} + :ui {:open :main} :playback {:frame 6}} after (ui/beginning-polygon db) saved (:clip (store/entry (:clip/current after))) - lanes (symbol/lanes (get-in saved [:symbols :main :nodes])) - lane-id (:id (first lanes)) - [_ sid cel-id path] (get-in after [:ui :selection])] + lanes (symbol/lanes (get-in saved [:symbols :main :nodes]))] (is (= :polygon (get-in after [:ui :tool]))) - (is (= 1 (count lanes))) - (is (= {:sid :main :id lane-id :path [lane-id]} - (get-in after [:ui :target]))) - (is (= :main sid)) - (is (= [cel-id] path)) - (is (= lane-id (get-in saved [:symbols :main :nodes cel-id :parent]))) - (is (= 6 (get-in saved [:symbols :main :nodes cel-id :time :at]))) - (is (= 1 (count (get-in (store/entry (:clip/current after)) - [:history :done]))) - "the lane and drawing are one start-polygon undo step") + (is (empty? lanes)) + (is (nil? (get-in after [:ui :target]))) + (is (nil? (get-in (store/entry (:clip/current after)) [:history :done]))) (is (empty? (clip/problems saved))))) (deftest sequence-commands-use-isolated-history-transactions diff --git a/frontend/test/browser/lane.mjs b/frontend/test/browser/lane.mjs index 17be6b5..8864df2 100644 --- a/frontend/test/browser/lane.mjs +++ b/frontend/test/browser/lane.mjs @@ -117,265 +117,98 @@ try { // 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') + 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'); - await click('new drawing'); - await click('hold +'); - await click('hold +'); - await click('hold +'); - await click('new drawing'); - let s = await shot(); - assert.deepEqual(instances(s).map(n => [n.time.at, n.span[1]]), [[0, 4], [4, 1]]); - assert.equal(await evaluate('document.querySelectorAll(".tl-cel").length'), 2); - assert.equal(await evaluate('document.querySelectorAll(".tl-label:not(.tl-corner)").length'), 1); - assert.equal(await evaluate(`cljs.core.get_in(cljs.core.deref(re_frame.db.app_db), - cljs.core.vector(cljs.core.keyword('playback'), cljs.core.keyword('frame')))`), 4, - 'new drawing seeks to its cel'); - - // Shorten this test shot to the occupied extent, purely in memory. - await evaluate(`(() => { - const k = cljs.core.keyword, db = cljs.core.deref(re_frame.db.app_db); - arthur.footage.store.edit_clip_BANG_(cljs.core.get(db, k('clip/current')), - clip => cljs.core.assoc_in(clip, cljs.core.vector(k('symbols'), k('main'), k('frames')), 5)); - document.querySelector('.tl-cel').click(); - })()`); - await sleep(200); - const before = await shot(); - await click('hold +'); - s = await shot(); - assert.deepEqual(s.clip, before.clip, 'refused overflow makes no document change'); - assert.equal(s.history.done.length, before.history.done.length); - await click('extend shot and apply'); - s = await shot(); - assert.equal(s.clip.symbols.main.frames, 6); - assert.deepEqual(instances(s).map(n => [n.time.at, n.span[1]]), [[0, 5], [5, 1]]); - assert.equal(s.history.done.length, before.history.done.length + 1); - await evaluate(`document.dispatchEvent(new KeyboardEvent('keydown', {key:'z', ctrlKey:true, bubbles:true}))`); - await sleep(250); - assert.deepEqual((await shot()).clip, before.clip, 'one undo restores cel, ripple, and shot length'); - - // Sharing: one drawing exposed twice, then one cel decoupled. Room is - // made first so these assertions are about content and not about overflow. - await evaluate(`(() => { - const k = cljs.core.keyword, db = cljs.core.deref(re_frame.db.app_db); - arthur.footage.store.edit_clip_BANG_(cljs.core.get(db, k('clip/current')), - clip => cljs.core.assoc_in(clip, cljs.core.vector(k('symbols'), k('main'), k('frames')), 20)); - document.querySelector('.tl-cel').click(); - })()`); - await sleep(200); - const enabled = async label => { - const where = await reveal(label); - const yes = await evaluate(`(() => { - const b = [...document.querySelectorAll('${where}')].find(${named(label)}); - return !!b && !b.disabled; - })()`); - await shut(); - return yes; - }; - assert.equal(await enabled('make unique'), false, 'nothing to decouple from yet'); - await click('reuse'); - s = await shot(); - let cels = instances(s); - assert.equal(cels.length, 3); - assert.equal(cels[2].source.symbol, cels[0].source.symbol, 'reuse exposes the same drawing'); - assert.equal(await evaluate('document.querySelectorAll(".tl-cel").length'), 3); - assert.equal(await evaluate('document.querySelectorAll(".tl-label:not(.tl-corner)").length'), 1, - 'three cels, still one row'); - assert.equal(await enabled('make unique'), true); - await click('make unique'); - s = await shot(); - cels = instances(s); - assert.notEqual(cels[2].source.symbol, cels[0].source.symbol, 'that cel has its own drawing'); - assert.equal(await enabled('make unique'), false, 'and is not shared any more'); - await click('duplicate'); - s = await shot(); - cels = instances(s); - assert.equal(cels.length, 4); - assert.equal(new Set(cels.map(n => n.source.symbol)).size, 4, - 'four cels of four drawings: nothing is shared once every copy is made'); - assert.equal(s.history.done.length, before.history.done.length + 3, 'three more commands, three more steps'); - - // A drawing into the middle of a hold: split, then insert. Both act at the - // playhead, and neither guesses what the other one is for. - const placed = s => instances(s) - .map(n => [n.time.at + n.span[0] / (n.time.rate ?? 1), n.time.at + n.span[1] / (n.time.rate ?? 1)]) - .sort((a, b) => a[0] - b[0]); - assert.deepEqual(placed(s), [[0, 4], [4, 5], [5, 6], [6, 7]]); - await evaluate(`document.querySelector('.tl-cel').click()`); - await sleep(200); - assert.equal(await enabled('split'), false, 'the start of a cel is not inside it'); - await click('+1'); - await click('+1'); - assert.equal(await enabled('split'), true); - await click('split'); - s = await shot(); - assert.deepEqual(placed(s), [[0, 2], [2, 4], [4, 5], [5, 6], [6, 7]], - 'one cel became two, over the frames it had'); - await click('insert'); - s = await shot(); - assert.deepEqual(placed(s), [[0, 2], [2, 3], [3, 5], [5, 6], [6, 7], [7, 8]], - 'the new drawing took frame 2 and everything from there rippled later'); - assert.equal(await evaluate('document.querySelectorAll(".tl-cel").length'), 6); - assert.equal(await evaluate('document.querySelectorAll(".tl-label:not(.tl-corner)").length'), 1, - 'six cels, still one row'); - assert.equal(s.history.done.length, before.history.done.length + 5); - - // Trim, move and blank: three gestures that move nothing but their own - // cel, and a shot whose length does not follow what is in it. - await evaluate(`[...document.querySelectorAll('.tl-cel')][2].click()`); - await sleep(200); - assert.deepEqual(placed(await shot()).slice(2, 4), [[3, 5], [5, 6]]); - await click('+1'); - assert.equal(await enabled('trim out'), true, 'the playhead is inside it'); - await click('trim out'); - s = await shot(); - assert.deepEqual(placed(s), [[0, 2], [2, 3], [3, 4], [5, 6], [6, 7], [7, 8]], - 'it ends at the playhead and every other cel stayed'); - assert.equal(await enabled('move here'), true); - await click('move here'); - s = await shot(); - assert.deepEqual(placed(s), [[0, 2], [2, 3], [4, 5], [5, 6], [6, 7], [7, 8]], - 'and moves to the playhead, into the gap it just made'); - await click('blank'); - s = await shot(); - assert.deepEqual(placed(s), [[0, 2], [2, 3], [5, 6], [6, 7], [7, 8]], - 'blanked: a gap where it was, and nothing closed it'); - assert.equal(s.clip.symbols.main.frames, 20, 'the shot is as long as it was authored'); - assert.equal(s.history.done.length, before.history.done.length + 8); - - // The same cels with the axes turned. Selecting a sheet cell feeds the same - // action strip and therefore the same domain command and undo transaction. - await click('cel sheet'); - assert.equal(await evaluate('document.querySelectorAll(".cs-head:not(.cs-frame)").length'), 1, - 'one lane is one cel-sheet column'); - assert.equal(await evaluate('document.querySelectorAll(".cs-cell").length'), 20, - 'one cell per authored frame'); - await evaluate(`document.querySelector('.cs-cell').click()`); - await sleep(180); - await click('hold +'); - s = await shot(); - assert.deepEqual(placed(s), [[0, 3], [3, 4], [6, 7], [7, 8], [8, 9]], - 'a command selected in the sheet has the timeline command semantics'); - assert.equal(s.history.done.length, before.history.done.length + 9); - - // Correction authoring is reachable from the same selection. The range is - // in this cel's own frames and Apply is one isolated history transaction. - assert(await evaluate(`(() => { - const section = [...document.querySelectorAll('.section')] - .find(s => s.querySelector('h2')?.textContent.trim() === 'corrections'); - const label = [...section.querySelectorAll('label')] - .find(l => l.textContent.trim().startsWith('offset (degrees)')); - const input = label?.querySelector('input'); - if (!input) return false; - const set = Object.getOwnPropertyDescriptor(HTMLInputElement.prototype, 'value').set; - set.call(input, '15'); - input.dispatchEvent(new Event('input', {bubbles: true})); - input.dispatchEvent(new Event('change', {bubbles: true})); - return true; - })()`), 'rotation correction value is editable'); - await sleep(100); - await click('apply correction'); - s = await shot(); - const selectedCel = instances(s).find(n => n.time.at === 0); - const rot = Object.values(selectedCel.channels).find(c => c.over?.length); - assert.equal(rot.over.length, 1); - assert(Math.abs(rot.over[0].values.value - Math.PI / 12) < 1e-9, - 'the inspector converts the authored degree offset to radians'); - assert.equal(s.history.done.length, before.history.done.length + 10); - - // A gap targets its column's lane. This catches the stale-selection bug that - // 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('cel sheet'); - assert.equal(await evaluate('document.querySelectorAll(".cs-head:not(.cs-frame)").length'), 2); - await evaluate(`([...document.querySelectorAll('.cs-cell')].slice(0, 2) - .find(c => c.textContent.trim() !== '—')).click()`); - await sleep(100); - await evaluate(`([...document.querySelectorAll('.cs-cell')].slice(0, 2) - .find(c => c.textContent.trim() === '—')).click()`); - await sleep(100); - await click('overwrite'); - s = await shot(); - assert(Object.values(s.clip.symbols.main.nodes) - .some(n => n.kind === 'instance' && n.parent !== 'girl' && n.time.at === 0), - '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 placed = s => instances(s).map(n => [ + n.time.at + n.span[0] / (n.time.rate ?? 1), + n.time.at + n.span[1] / (n.time.rate ?? 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); + await sleep(180); }; - 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'); + const undo = () => key('z', {modifiers: 2}); + const drag = async (selector, df, {zone = 0.5, shift = false} = {}) => { + const points = await evaluate(`(() => { + const handle = document.querySelector(${JSON.stringify(selector)}); + if (!handle) return null; + const track = handle.closest('.tl-track'); + const h = handle.getBoundingClientRect(); + const t = track.getBoundingClientRect(); + const frames = Number(document.querySelector('.at-frame').textContent.split('/')[1]); + const x = h.left + h.width * ${zone}; + const y = h.top + h.height / 2; + return {x, y, end: x + t.width * ${df} / frames}; + })()`); + assert(points, `drag handle exists: ${selector}`); + const modifiers = shift ? 8 : 0; + await send('Input.dispatchMouseEvent', { + type: 'mousePressed', x: points.x, y: points.y, + button: 'left', buttons: 1, clickCount: 1, modifiers, + }); + await sleep(100); + await send('Input.dispatchMouseEvent', { + type: 'mouseMoved', x: points.end, y: points.y, + button: 'left', buttons: 1, modifiers, + }); + await sleep(100); + await send('Input.dispatchMouseEvent', { + type: 'mouseReleased', x: points.end, y: points.y, + button: 'left', buttons: 0, clickCount: 1, modifiers, + }); + await sleep(250); + }; + + await click('lane'); + assert.equal(await evaluate('[...document.querySelectorAll(".timing-controls > button")].every(b => b.disabled)'), true, + 'timing buttons are disabled when the selected row is a lane, not a symbol clip'); + await click('inside'); + let s = await shot(); + assert.deepEqual(placed(s), [[0, 1]], 'new inside an aimed lane is a one-frame symbol'); + assert.equal(await evaluate(`document.querySelectorAll('.cel-sheet, [aria-label="time view"]').length`), 0, + 'there is one temporal interface'); + assert.equal(await evaluate('document.querySelectorAll(".timing-controls > button").length'), 3, + 'timing operations are direct buttons'); + + await drag('.tl-cel .tl-edge.out', 3); + s = await shot(); + assert.deepEqual(placed(s), [[0, 4]], 'a right edge directly changes the endpoint'); + + for (let i = 0; i < 4; i++) await click('+1'); + await click('inside'); + await drag('.tl-cel:nth-of-type(2) .tl-edge.out', 2); + for (let i = 0; i < 3; i++) await click('+1'); + await click('inside'); + s = await shot(); + assert.deepEqual(placed(s), [[0, 4], [4, 7], [7, 8]]); + + await drag('.tl-cel:nth-of-type(2) .tl-junction', 1, {zone: 0.5}); + assert.deepEqual(placed(await shot()), [[0, 5], [5, 7], [7, 8]], + 'the middle of a junction rolls both edges'); + await undo(); + + await drag('.tl-cel:nth-of-type(2) .tl-junction', 1, {zone: 0.9}); + assert.deepEqual(placed(await shot()), [[0, 4], [5, 7], [7, 8]], + 'the right side trims only the right clip'); + await undo(); + + await drag('.tl-cel:nth-of-type(2) .tl-junction', -1, {zone: 0.1}); + assert.deepEqual(placed(await shot()), [[0, 3], [4, 7], [7, 8]], + 'the left side trims only the left clip'); + await undo(); + + await drag('.tl-cel:nth-of-type(2) .tl-edge.out', 2, {shift: true}); + assert.deepEqual(placed(await shot()), [[0, 4], [4, 9], [9, 10]], + 'Shift-edge ripples every later clip on the lane'); + await undo(); + + await drag('.tl-cel:first-of-type .tl-edge.out', 2); + assert.deepEqual(placed(await shot()), [[0, 6], [6, 7], [7, 8]], + 'ordinary growth trims adjacent spans and never overlaps'); assert.equal(errors.length, 0, JSON.stringify(errors)); - console.log('PASS: lane commands and corrections agree from timeline and cel sheet; no server writes'); + console.log('PASS: one timeline creates, trims, rolls, and ripples drawing-lane symbols'); } finally { if (ws?.readyState === WebSocket.OPEN) { ws.send(JSON.stringify({ id: 999999, method: 'Browser.close' })); diff --git a/static/arthur/app.css b/static/arthur/app.css index 3adc3c1..9799e4b 100644 --- a/static/arthur/app.css +++ b/static/arthur/app.css @@ -228,8 +228,7 @@ input[type="range"] { width: 100%; accent-color: var(--sel); } /* Buttons that are one control: a transport, a stepper, a mode picker. They share their borders, so the group reads as a single object with parts rather than as several things that happen to be adjacent — which is the whole claim - a segmented control makes, and the reason `timeline` and `cel sheet` are one - of these. `.seg` is `.group` with that meaning; they are drawn the same + a segmented control makes. `.seg` is `.group` with that meaning; both are drawn because the difference is what the buttons do, not how they look. The negative margin collapses the doubled border between two buttons into @@ -252,12 +251,6 @@ button.ico > svg { display: block; width: 11px; height: 11px; } /* Play is the one control in the strip you aim at without looking. */ button.ico-play { padding-left: 8px; padding-right: 8px; } -/* `hold −` / `hold +`: one label over two steppers, because the word is shared - and repeating it in both buttons was most of their width. */ -.stepper { display: flex; align-items: center; gap: 4px; } -.stepper-label { color: var(--dim); } -.stepper button { padding: 1px 6px; } - /* A number that changes every frame. Tabular figures stop it twitching, and stop the controls after it being nudged about as the count passes 9 and 99. */ .readout { font-variant-numeric: tabular-nums; } @@ -1003,6 +996,7 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); } } .tl-label.on { background: var(--sel-bg); } +.tl-label.aimed { box-shadow: inset 0 0 0 2px var(--aim); } .tl-label:hover:not(.on) { background: #fff; } .tl-label .name { min-width: 0; overflow: hidden; text-overflow: ellipsis; } .tl-label .kind { color: var(--dim); } @@ -1099,6 +1093,29 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); } /* A node's bar slides it along its symbol's time. */ .tl-span.movable { cursor: ew-resize; touch-action: none; } .tl-span.movable.sliding { border-color: var(--sel); } +.tl-edge { + position: absolute; + top: -1px; + bottom: -1px; + width: 7px; + cursor: e-resize; + touch-action: none; + z-index: 2; +} +.tl-edge.out { right: -3px; } +.tl-edge.in { left: -3px; } +.tl-junction { + position: absolute; + top: -1px; + left: 0; + bottom: -1px; + width: 12px; + transform: translateX(-50%); + cursor: col-resize; + touch-action: none; + z-index: 3; +} +.tl-cel-label { display: block; overflow: hidden; text-overflow: ellipsis; pointer-events: none; } .tl-span.ghost { background: transparent; border: 1px dashed var(--sel); @@ -1143,79 +1160,6 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); } .tl-empty { padding: 9px; color: var(--dim); } -/* The second temporal view. Its cells carry the same selection addresses as - the cel blocks above; only the axes change. */ -.cel-sheet { - flex: 1; - min-height: 0; - overflow: auto; - display: grid; - align-content: start; - background: var(--line); - gap: 1px; -} - -.cs-head, -.cs-frame, -.cs-cell { - min-width: 0; - height: 24px; - border: 0; - border-radius: 0; - padding: 0 6px; - background: #fff; - color: var(--fg); - overflow: hidden; - text-overflow: ellipsis; - white-space: nowrap; -} - -.cs-head { - position: sticky; - top: 0; - z-index: 2; - display: flex; - align-items: center; - background: var(--chrome); - font-weight: 600; - cursor: pointer; -} - -.cs-head.cs-frame { z-index: 3; } -.cs-frame { position: sticky; left: 0; z-index: 1; color: var(--dim); text-align: right; } -.cs-frame.on, .cs-cell.current { box-shadow: inset 3px 0 0 var(--playhead); } -.cs-cell { text-align: left; cursor: pointer; } -.cs-cell:hover { background: var(--sel-bg); } -.cs-cell.selected { background: var(--sel-bg); color: var(--sel); font-weight: 600; } -.cs-head.selected { background: var(--sel-bg); color: var(--sel); } - -/* AIMED COMPOSES WITH SELECTED rather than replacing it: the ring is the aim, - the tint is the selection, and a row that is both wears both. No name tag in - the chrome — the thing the ring is around is already the name. */ -.tl-label.aimed, -.cs-head.aimed { box-shadow: inset 0 0 0 2px var(--aim); } -.cs-head.aimed { color: var(--aim); } - -.cs-empty { - display: grid; - justify-items: center; - align-content: center; - gap: 6px; - padding: 28px 16px; - background: var(--pane); - text-align: center; -} -.cs-empty p { margin: 0; } -.cs-empty .dim { color: var(--dim); font-size: 11px; } -.cs-empty button { margin-top: 4px; } -.cel-sheet { user-select: none; touch-action: none; } -.cs-cell { position: relative; } -.cs-cell:focus-visible { outline: 2px solid var(--sel); outline-offset: -2px; } -.cs-help { padding: 6px 10px; color: var(--dim); font-size: 11px; - white-space: nowrap; overflow: hidden; text-overflow: ellipsis; } -.cs-fill-handle { position: absolute; right: 0; bottom: 0; width: 9px; height: 9px; - background: var(--sel); border: 1px solid white; cursor: ns-resize; z-index: 2; } -.cs-preview { outline: 1px dashed var(--sel); outline-offset: -1px; } /* -------------------------------------------------------------------------- the video -> symbol dialog */ From 5ebe776ce45fd0880bd154b124192ca831ef204b Mon Sep 17 00:00:00 2001 From: Your Name Date: Thu, 1 Oct 2026 15:13:07 -0400 Subject: [PATCH 02/10] A lane is a generic row of symbol clips A lane was a drawing lane: the only thing that could go in one was a one-frame held cel, and every other symbol instance stayed a permanent root row of its own. Those are not two kinds of timing, they are one kind with two creation policies. `lane/place-symbol` drops any library symbol in as a clip that plays naturally at speed one, `lane/adopt` moves an instance that is already in the document into a lane keeping its source, span, playback and corrections, and `append-drawing`/`overwrite-drawing` keep being the policy that makes a new empty symbol a one-frame hold. The child shape they produce is the same. Both new commands claim their interval through `blank` before they write, so the partition rule is unchanged and unduplicated: placing into occupied lane time trims, removes or splits the incumbents, and a lane still never stores an overlap. Real compositing overlap is another lane, where the order is explicit. Creating a symbol with nothing aimed now makes a lane and a clip in it instead of a loose root instance, and a pool drop prefers an explicitly targeted lane, then the selected one, and makes a lane only when there is neither. That is what stops the row-per-symbol growth coming back in through the drop path, and it is why `add-lane` now takes a z in front of the existing root nodes and calls what it makes a "lane" rather than "drawings". The timeline learned the two gestures that a generic lane needs. A clip body dragged over another lane's track previews there as a dashed block and lands through `::adopt-in-lane`; the track is found with `elementsFromPoint` and its selection read back off the element, because a pointer capture does not retarget. A pool drop over an existing lane previews as a dashed clip inside that lane instead of a temporary new row that appears and then vanishes -- which also needed the drag-leave check to be geometric, since inserting the preview changes the element under the pointer and Chromium then reports a leave with no related target. Lanes are renameable from their label, by double-click, F2, or the pencil, through `::rename-node`. `symbol/lane-cels` is `symbol/lane-clips`, and the vocabulary table in the handoff now separates the two words it had merged: a clip is an instance in a lane, and a cel is specifically the one-frame held source that drawing creation makes. Keeping `cel` for the policy is what lets the lane stop being about drawings at all. Co-Authored-By: Claude Opus 5 --- docs/lane-handoff.md | 62 +++-- docs/lane-model.md | 7 +- frontend/src/arthur/domain/lane.cljs | 103 +++++++-- frontend/src/arthur/domain/span.cljs | 4 +- frontend/src/arthur/domain/symbol.cljs | 10 +- frontend/src/arthur/events/ui.cljs | 148 ++++++++---- frontend/src/arthur/ui/drag.cljs | 21 +- frontend/src/arthur/ui/location.cljs | 2 +- frontend/src/arthur/ui/timeline.cljs | 250 ++++++++++++++++----- frontend/test/arthur/domain/lane_test.cljs | 49 +++- frontend/test/browser/lane.mjs | 102 ++++++++- static/arthur/app.css | 6 +- 12 files changed, 590 insertions(+), 174 deletions(-) diff --git a/docs/lane-handoff.md b/docs/lane-handoff.md index 83f8538..21a409a 100644 --- a/docs/lane-handoff.md +++ b/docs/lane-handoff.md @@ -1,12 +1,14 @@ -# Lane and cel handoff +# Lane and symbol-clip handoff -Status (2026-10-01): the timeline is the one timing interface. Cels are ordinary -nodes with their own playback clock and appear as blocks on one row per drawing -lane. Blocks move by mouse; edge drags trim without overlap; Shift-right-edge -drags ripple every later cel; and the center of a shared cut composes the two -edge edits into a rolling edit. Linked audio follows picture moves while its -edges remain independently trimmable. Rotation and position corrections survive -regeneration and expose conflicts for removal or retry. +Status (2026-10-01): the timeline is the one timing interface. A lane is a +generic non-overlapping row of symbol clips; it is not a special drawing type. +Dropping a library symbol makes a naturally playing clip, while creating a new +empty symbol makes a one-frame held clip at the playhead. With no destination +lane, either operation creates one. Existing legacy root symbol rows can be +dragged into a lane. Blocks move by mouse; edge drags claim time by trimming +neighbors; Shift-edge drags ripple every later clip; and the center of a shared +cut composes the two edge edits into a rolling edit. Linked audio follows picture +moves while its edges remain independently trimmable. The commits beginning at `3d3c1bb` are the argument for the model and are worth reading before touching what they did — they are the design record, more than @@ -39,9 +41,10 @@ and do not reintroduce the others. | word | means | | --- | --- | | instance | the `:kind`. The general thing, anywhere in a document | -| cel | an instance in a lane. One drawing, held for some duration | +| clip | an instance in a lane. It can hold one source frame or play a symbol naturally | +| cel | specifically a one-frame source held over a clip's duration; the empty-symbol/drawing creation policy | | lane | a group with `:layout :sequence` | -| drawing | the content a cel names — an ordinary symbol | +| drawing | content authored into a symbol; not a different timeline node type | | placement | ONLY where a node sits: `nest/placement`, and the transform that puts a face on the stage. Never the node itself | `occurrence` and `exposure` are not words for a cel. **`exposure` means something @@ -82,19 +85,29 @@ decision, not a cleanup. - **Refuse rather than guess.** Every command returns `{:clip :selection}` or `{:refused why}`, never a half-applied edit. Where the model needs a choice nobody has made, refusing and saying why is the behaviour, not a placeholder. -- **A cel is not a row.** Rows, expansion and selection are editor state. The +- **A clip is not a row.** Rows, expansion and selection are editor state. The document has never known about rows and must not learn. +- **A lane is generic.** Drawing creation, library placement, and adopting an + existing root instance all produce the same child instance shape. The only + difference is playback policy: a new empty drawing holds source frame zero; + a dropped library symbol plays at speed one. +- **Placement claims time.** Lanes never store overlaps. A new or extended clip + trims, removes, or splits whatever previously owned the claimed interval. + Real compositing overlap uses another lane, where ordering remains explicit. ## Current timeline interaction -- Creating a symbol inside an aimed drawing lane creates a one-frame cel at the - playhead. Drawing a polygon uses the existing cel there or creates the same - one-frame cel when the frame is empty. -- Dragging a cel body moves it. A linked audio node follows a picture move; +- Creating a symbol inside an aimed lane creates a one-frame held clip at the + playhead. With no aimed lane it first creates a lane. Drawing a polygon uses + the existing clip there or creates the same one-frame clip when the frame is + empty. +- Dropping any library symbol into a lane creates a natural-duration playing + clip. Dropping it on unclaimed timeline or stage space first creates a lane. +- Dragging a clip body moves it. A linked audio node follows a picture move; moving or trimming the audio itself remains independent. - Dragging a right edge changes its endpoint. Growth consumes adjacent spans instead of overlapping them. Shift-drag inserts or removes lane time by moving - every later cel by the same delta. + every later clip by the same delta. - At a shared boundary, the left and right hit zones trim one side. The center is a rolling edit: right-edge resize followed by left-edge resize at one frame. - Split, trim-in, and trim-out are direct buttons and are disabled without an @@ -156,9 +169,10 @@ The implemented correction slice and its remaining UI limits are recorded in ## Known gaps and traps -- **Audio lanes do not work.** `symbol/lane-problems` requires `:instance` - children, so an audio node in a lane is rejected outright. `lane-model.md` - says a lane may hold visual OR audio cels and should reject only a mixture. +- **Audio remains outside visual lanes.** `symbol/lane-problems` deliberately + requires symbol instances. Audio is still an independent root node that can + link to picture; making audio itself lane-based would need an explicit lane + capability rather than a mixed child rule. - **`:z` is required on cels and means nothing there.** A lane never has two cels on one frame, so draw order between them cannot matter. `node/problems` requires `:z` on every node uniformly, which is its own kind of simplicity — @@ -172,9 +186,9 @@ The implemented correction slice and its remaining UI limits are recorded in pose selection and plate drawings/tracing, instance-specific picture-rate requests, `pose/put-cut` addressing only `:main`. It predates the lane model and nobody has squared the two. -- **The button row in the timeline pane is a test harness, not a design.** It is - how the commands were made reachable and provable. `lane-model.md` describes - the real cel action strip, the breadcrumb and the location bar; none exist. +- **Slip and retime are still absent.** The timeline action strip now applies + split/trim uniformly to a selected root or lane clip, but source-time slip and + retime still need their own proved semantics before they become controls. - **`shadow-cljs release app` clobbers the dev bundle.** Both builds write `../static/arthur/js`, which Django serves, and the optimized build does not export the `arthur` global — so after a release the browser tests fail with @@ -186,14 +200,14 @@ The implemented correction slice and its remaining UI limits are recorded in From `frontend/`: - npx shadow-cljs compile test && node out/node-tests.js # 437 tests, 5,804 assertions + npx shadow-cljs compile test && node out/node-tests.js # 469 tests, 9,592 assertions npx shadow-cljs compile app # the bundle Django serves npx shadow-cljs release app # then `compile app` again — see above The browser tests need the Django dev server up (`mise exec -- python manage.py runserver 8778` from the repo root) and a compiled dev bundle: - node --experimental-websocket test/browser/lane.mjs # the lane/cel flow + node --experimental-websocket test/browser/lane.mjs # generic symbol-lane flow CHROME=/usr/bin/chromium node --experimental-websocket test/browser/take.mjs `take.mjs` defaults to a macOS Chrome path, hence `CHROME=`. It writes a real diff --git a/docs/lane-model.md b/docs/lane-model.md index a0b3b1b..84da5d9 100644 --- a/docs/lane-model.md +++ b/docs/lane-model.md @@ -1,6 +1,6 @@ # The Lane Model -Revised 2026-10-01. Cel ownership, source playback, one-row drawing lanes, +Revised 2026-10-01. Clip ownership, source playback, one-row generic lanes, direct clip movement and edge editing, correction evaluation, and correction authoring for rotation and position are implemented. The former cel-sheet projection was removed: the timeline is the single timing interface. Sections @@ -147,8 +147,9 @@ cel transform and then the content's own transform. The interval in lane time is derived through `:time`; do not also store parent start/end values. Sequence children require finite intervals and positive placement rates. Ordering and overlap checks use the mapped intervals, not `:z`. -The sequence group may contain visual cels or audio cels; its -capability must reject an incompatible mixture rather than infer it per frame. +The current sequence group contains visual symbol clips. Audio remains an +independent root node (and can be linked to picture); if audio lanes are added, +their capability must be explicit rather than inferred per frame. A source reference is fixed within a cel. The lane changes content when another cel becomes active. This is a deliberate revision of the original diff --git a/frontend/src/arthur/domain/lane.cljs b/frontend/src/arthur/domain/lane.cljs index 5bcf3f4..d42134c 100644 --- a/frontend/src/arthur/domain/lane.cljs +++ b/frontend/src/arthur/domain/lane.cljs @@ -1,11 +1,11 @@ (ns arthur.domain.lane - "The commands that need a SEQUENCE: make a lane, put drawings in it, change - how long they are exposed, empty part of it, and decide which cels share - content. + "The commands that need a SEQUENCE: make a lane, place symbol clips in it, + change how long they are exposed, empty part of it, and decide which held + drawing clips share content. WHAT A LANE IS lives in `arthur.domain.symbol`, beside the other rules about a node map: a group with `:layout :sequence`, whose children are non-overlapping - visual cels. This namespace only changes them. + visual symbol clips. This namespace only changes them. WHAT IS NOT HERE: split, trim and move. Each of those is one write to one node's span or position, which is a fact every node has, so they live in @@ -56,7 +56,7 @@ :else (let [[_ boundary] (node/placed-span n) later (filter #(>= (first (node/placed-span %)) boundary) - (symbol/lane-cels nodes (:id lane))) + (symbol/lane-clips nodes (:id lane))) nodes (assoc-in nodes [id :span 1] (+ (second span) (* rate delta))) nodes (reduce (fn [ns sibling] (update-in ns [(:id sibling) :time :at] (fnil + 0) delta)) @@ -76,7 +76,7 @@ n (get nodes id) lane (get nodes (:parent n)) [lo old-out] (when n (node/placed-span n)) - members (when (node/lane? lane) (symbol/lane-cels nodes (:id lane))) + members (when (node/lane? lane) (symbol/lane-clips nodes (:id lane))) later (when members (remove #(= id (:id %)) (filter #(>= (first (node/placed-span %)) old-out) members))) @@ -118,7 +118,7 @@ earlier (when (node/lane? lane) (remove #(= id (:id %)) (filter #(<= (second (node/placed-span %)) old-in) - (symbol/lane-cels nodes (:id lane))))) + (symbol/lane-clips nodes (:id lane))))) broken (first (symbol/lane-problems nodes))] (cond (not (node/lane? lane)) {:refused "select a cel in a lane"} @@ -178,7 +178,7 @@ [clip sid lane-id [a b] {:keys [id]}] (let [nodes (get-in clip [:symbols sid :nodes]) lane (get nodes lane-id) - members (when (node/lane? lane) (symbol/lane-cels nodes lane-id)) + members (when (node/lane? lane) (symbol/lane-clips nodes lane-id)) spanning (when members (first (filter #(let [[lo hi] (node/placed-span %)] (and (< lo a) (> hi b))) members)))] @@ -205,12 +205,81 @@ (span/finish clip sid nodes (or (when spanning id) lane-id) :keep))))) (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"} - {:clip (assoc-in clip [:symbols sid :nodes id] - {:id id :name "drawings" :kind :group :layout :sequence - :z (str "z-" id)}) - :selection id})) + (let [nodes (get-in clip [:symbols sid :nodes]) + front (last (sort (keep (fn [[_ n]] (when (nil? (:parent n)) (:z n))) nodes)))] + (if (or (nil? (clip/symbol clip sid)) (get nodes id)) + {:refused "the symbol is missing or the lane ID is already used"} + {:clip (assoc-in clip [:symbols sid :nodes id] + {:id id :name "lane" :kind :group :layout :sequence + :z (symbol/z-between front nil)}) + :selection id}))) + +(defn place-symbol + "Place arbitrary symbol `source-id` as a naturally playing clip in a lane. + + The new clip claims its interval: existing clips under that interval are + trimmed, removed, or split by `blank`, so the lane remains a partition rather + than storing an overlap. This is the generic operation behind dropping a + library symbol into a lane; one-frame held drawing creation remains a policy + of `append-drawing`/`overwrite-drawing`, not a different lane type." + [clip store sid lane-id id source-id at + {:keys [extent point remainder-id] :or {extent :keep}}] + (let [nodes (get-in clip [:symbols sid :nodes]) + lane (get nodes lane-id) + seeded (clip/place-symbol clip store sid source-id 0 id point) + n (get-in seeded [:symbols sid :nodes id]) + duration (when n (- (second (node/placed-span n)) + (first (node/placed-span n))))] + (cond + (not (node/lane? lane)) {:refused "select a lane"} + (contains? nodes id) {:refused "the new clip ID is already used"} + (not (and (integer? at) (not (neg? at)))) + {:refused "a position is a nonnegative whole lane frame"} + (nil? (clip/symbol clip source-id)) {:refused "there is no such symbol to place"} + (nil? n) {:refused "a symbol cannot go inside itself"} + (not (pos? duration)) {:refused "the symbol has no frames to place"} + (and remainder-id (contains? nodes remainder-id)) + {:refused "the remainder clip needs a free ID"} + :else + (let [cleared (blank clip sid lane-id [at (+ at duration)] + {:id remainder-id})] + (if (:refused cleared) + cleared + (let [nodes (assoc (get-in (:clip cleared) [:symbols sid :nodes]) id + (-> n + (assoc :parent lane-id) + (assoc-in [:time :at] at)))] + (span/finish (:clip cleared) sid nodes id extent))))))) + +(defn adopt + "Move an existing visual instance into `lane-id` at lane frame `at`. + Its source, span, transforms, corrections, and identity come with it; the + destination interval is claimed with the same overwrite trimming as a pool + drop." + [clip sid lane-id id at {:keys [extent remainder-id] :or {extent :keep}}] + (let [nodes (get-in clip [:symbols sid :nodes]) + lane (get nodes lane-id) + n (get nodes id) + [lo hi] (when n (node/placed-span n)) + duration (when (and lo hi) (- hi lo))] + (cond + (not (node/lane? lane)) {:refused "select a lane"} + (not= :instance (:kind n)) {:refused "only a symbol clip goes in a lane"} + (= lane-id (:parent n)) {:refused "this clip is already in that lane"} + (not (and (integer? at) (not (neg? at)))) + {:refused "a position is a nonnegative whole lane frame"} + (not (pos? duration)) {:refused "the clip has no frames to place"} + (and remainder-id (contains? nodes remainder-id)) + {:refused "the remainder clip needs a free ID"} + :else + (let [cleared (blank clip sid lane-id [at (+ at duration)] {:id remainder-id})] + (if (:refused cleared) + cleared + (let [moved (-> n + (assoc :parent lane-id) + (update-in [:time :at] (fnil + 0) (- at lo))) + nodes (assoc (get-in (:clip cleared) [:symbols sid :nodes]) id moved)] + (span/finish (:clip cleared) sid nodes id extent))))))) ;; --------------------------------------------------------------------------- ;; putting drawings in a lane @@ -239,7 +308,7 @@ "Where lane `lane-id`'s occupied frames stop, in its own time." [nodes lane-id] (apply max 0 (map #(second (node/placed-span %)) - (symbol/lane-cels nodes lane-id)))) + (symbol/lane-clips nodes lane-id)))) (defn- place "Put a held cel of `drawing-id` into `lane-id` at lane frame `at`, and @@ -260,7 +329,7 @@ [lo hi] (node/placed-span n) later (when ripple? (filter #(>= (first (node/placed-span %)) lo) - (symbol/lane-cels nodes lane-id))) + (symbol/lane-clips nodes lane-id))) nodes (reduce (fn [ns sibling] (update-in ns [(:id sibling) :time :at] (fnil + 0) (- hi lo))) (assoc nodes id n) later) @@ -280,7 +349,7 @@ inside (when (number? at) (some (fn [n] (let [[lo hi] (node/placed-span n)] (when (< lo at hi) n))) - (symbol/lane-cels nodes lane-id)))] + (symbol/lane-clips nodes lane-id)))] (cond (not (node/lane? lane)) "select a lane" (contains? nodes id) "the new cel ID is already used" diff --git a/frontend/src/arthur/domain/span.cljs b/frontend/src/arthur/domain/span.cljs index edcfa8c..0027c16 100644 --- a/frontend/src/arthur/domain/span.cljs +++ b/frontend/src/arthur/domain/span.cljs @@ -48,7 +48,7 @@ [clip sid nodes selection extent] (let [sym (clip/symbol clip sid) reach (for [[id n] nodes :when (node/lane? n) - child (symbol/lane-cels nodes id) + child (symbol/lane-clips nodes id) :let [m (symbol/frame-map nodes id) end (second (node/placed-span child))]] (when m (+ (:at m) (/ end (:rate m))))) @@ -126,7 +126,7 @@ THE RIGHT PIECE KEEPS THE ORIGINAL'S `:z`. Two halves of one thing draw at one depth; nothing orders them against each other, because they are never on screen on the same frame. Cels in a lane do not consult `:z` at all — - `symbol/lane-cels` sorts them by where they start. + `symbol/lane-clips` sorts them by where they start. The right piece is the selection, because it is the piece that was made." [clip sid id cut new-id] diff --git a/frontend/src/arthur/domain/symbol.cljs b/frontend/src/arthur/domain/symbol.cljs index a46c621..1e909da 100644 --- a/frontend/src/arthur/domain/symbol.cljs +++ b/frontend/src/arthur/domain/symbol.cljs @@ -90,8 +90,8 @@ [nodes id] (dec (count (lineage nodes id)))) -(defn lane-cels - "The cels of lane `lane`, in the order they are exposed. +(defn lane-clips + "The symbol clips of lane `lane`, in timeline order. Sorted by where they START, not by `:z`: a lane's blocks follow one another in time, and two of them cannot be in the same place for `:z` to decide between. @@ -147,7 +147,7 @@ the parent and stencil references, rather than wherever a command happens to build one. - Cels must be visual, finite and non-overlapping. An accidental overlap + Clips must be visual, finite and non-overlapping. An accidental overlap is refused rather than resolved by draw order: two drawings exposed on one frame of one lane is a document nobody meant to write, and picking a winner would hide it. Empty lanes are valid — a lane is made before it is filled." @@ -165,9 +165,9 @@ intervals (sort-by first (map node/placed-span (filter valid? children)))] (concat (for [n children :when (not (valid? n))] - (str "sequence " id " needs finite visual cels: " (:id n))) + (str "sequence " id " needs finite visual symbol clips: " (:id n))) (when (some (fn [[[_ b] [c _]]] (> b c)) (partition 2 1 intervals)) - [(str "lane " id " has overlapping cels")]))))) + [(str "lane " id " has overlapping clips")]))))) nodes))) (defn order diff --git a/frontend/src/arthur/events/ui.cljs b/frontend/src/arthur/events/ui.cljs index 61f929b..36fc239 100644 --- a/frontend/src/arthur/events/ui.cljs +++ b/frontend/src/arthur/events/ui.cljs @@ -18,7 +18,8 @@ All of it is `assoc-in` under `:ui`. There is no effect in this namespace and there should not be one: an editor's own state is the cheapest thing in the app to change and the most expensive to have two copies of." - (:require [arthur.domain.clip :as clip] + (:require [clojure.string :as str] + [arthur.domain.clip :as clip] [arthur.domain.correction :as correction] [arthur.domain.gesture :as gesture] [arthur.domain.nest :as nest] @@ -32,6 +33,17 @@ [arthur.footage.store :as store] [re-frame.core :as rf])) +(rf/reg-event-db + ::rename-node + (fn [db [_ sid id value]] + (let [document (:clip (store/entry (:clip/current db))) + value (not-empty (str/trim (str value)))] + (if-not (get-in document [:symbols sid :nodes id]) + db + (edit/transaction db #(if value + (assoc-in % [:symbols sid :nodes id :name] value) + (update-in % [:symbols sid :nodes id] dissoc :name))))))) + (defn selected "`db` with `selection` selected, and nothing aimed. @@ -431,14 +443,14 @@ db))) (defn into-the-lane - "Where a polygon drawn in the CEL SHEET goes: the row path of the cel the - aimed lane exposes at the playhead, and the clip that cel is in. `{:clip - :path}`, or `{:refused why}`. + "Where a polygon drawn with a lane aimed goes: the path of the held clip the + lane exposes at the playhead, and the document containing it. `{:clip :path}`, + or `{:refused why}`. - A GAP IS NOT A REFUSAL, IT IS A NEW DRAWING. The sheet is a drawing-lane mode - and the frame under the playhead is where the drawing belongs, so drawing on - an empty frame makes the drawing that was missing — which is the whole reason - there is no `new drawing` button any more: the gesture already says it. + A GAP IS NOT A REFUSAL, IT IS A NEW DRAWING. The frame under the playhead is + where the drawing belongs, so drawing on an empty frame makes the one-frame + held clip that was missing. The gesture already says what the removed drawing + controls used to say. `overwrite-drawing` rather than `append-drawing`, because a gap already has the room. Appending RIPPLES everything after it later by the new cel's @@ -456,7 +468,7 @@ cel (when (integer? at) (some (fn [c] (let [[lo hi] (node/placed-span c)] (when (and (<= lo at) (< at hi)) c))) - (symbol/lane-cels (get-in clip [:symbols open :nodes]) lane-id)))] + (symbol/lane-clips (get-in clip [:symbols open :nodes]) lane-id)))] (cond (not (integer? at)) {:refused "the playhead is not on one frame of this lane"} @@ -471,7 +483,7 @@ (defn polygon-landing "Choose the document and row path a finished polygon is drawn into. - An aimed drawing lane wins regardless of what is selected on the stage: an + An aimed lane wins regardless of what is selected on the stage: an occupied frame lands in its cel and a gap first becomes a one-frame drawing. With no lane aimed, ordinary target-based drawing is unchanged." [clip st db] @@ -481,7 +493,7 @@ (defn beginning-polygon "Enter polygon mode, first materializing a drawing at the playhead when a - drawing lane is aimed and that frame is empty. + lane is aimed and that frame is empty. Creating here, rather than when the polygon is finished, means the drawing is already the current cel while points are being placed. Cancelling the polygon @@ -567,24 +579,24 @@ (rf/reg-event-db ::new-symbol ;; `where` is `:inside` — in whatever the target names — or `:top`, in the open - ;; symbol regardless of it. A drawing lane is the temporal form of this same - ;; operation: inside it, a new symbol is a one-frame cel at the playhead. + ;; symbol regardless of it. A lane is the temporal form of this same operation: + ;; inside it, a new empty symbol is a one-frame held clip at the playhead. (fn [db [_ where]] (let [{clip :clip st :store} (store/entry (:clip/current db)) - drawing-lane (when (= :inside where) (aimed-lane clip db)) + target-lane (when (= :inside where) (aimed-lane clip db)) open (get-in db [:ui :open]) owner (:frame (nest/inside clip st open [] (get-in db [:playback :frame]))) - at (when (and drawing-lane (number? owner)) - (lane/lane-frame clip open (:id drawing-lane) owner)) + at (when (and target-lane (number? owner)) + (lane/lane-frame clip open (:id target-lane) owner)) drawing-id (clip/fresh-id clip) cel-id (random-uuid) down (if (= :top where) [] (where-new-goes clip db)) {host :sid frame :frame} (nest/inside clip st open down (get-in db [:playback :frame])) - uuid (random-uuid)] - (if drawing-lane + lane-id (random-uuid)] + (if target-lane (let [result (if (integer? at) - (lane/overwrite-drawing clip open (:id drawing-lane) cel-id drawing-id at + (lane/overwrite-drawing clip open (:id target-lane) cel-id drawing-id at {:extent :grow-symbol :remainder-id (random-uuid)}) {:refused "the playhead is not on one frame of this lane"})] @@ -594,19 +606,23 @@ (edit/transaction (constantly (:clip result))) (assoc-in [:ui :selection] [:node open cel-id [cel-id]])))) (if-not host - (update db :project merge - {:status "what you are adding to is not on screen at this frame"}) - (let [made [:node host uuid (conj down uuid)]] - (-> db - (edit/transaction #(clip/new-symbol % host drawing-id frame uuid)) - ;; AIMED AT WHAT IT MADE. A symbol is made to put things in, so the - ;; next thing made goes in it; the outline says so before anybody - ;; has to find out by drawing. - (aimed made) - ;; Open every row down to it, or the new row is inside a closed one - ;; and the button looks like it did nothing. - (update-in [:ui :expanded] (fnil into #{}) - (rest (reductions conj [] down)))))))))) + (update db :project merge + {:status "what you are adding to is not on screen at this frame"}) + (let [prepared (lane/add-lane clip host lane-id) + result (if (:refused prepared) prepared + (lane/overwrite-drawing (:clip prepared) host lane-id + cel-id drawing-id frame + {:extent :grow-symbol + :remainder-id (random-uuid)}))] + (if-let [why (:refused result)] + (update db :project merge {:status why}) + (-> db + (edit/transaction (constantly (:clip result))) + (assoc-in [:ui :selection] [:node host cel-id (conj down cel-id)]) + (assoc-in [:ui :target] + {:sid host :id lane-id :path (conj down lane-id)}) + (update-in [:ui :expanded] (fnil into #{}) + (rest (reductions conj [] down))))))))))) ;; --------------------------------------------------------------------------- ;; a drop in flight @@ -629,15 +645,42 @@ (rf/reg-event-db ::drop-symbol - ;; `point` is the stage pixel it was dropped on, or nil from the timeline. - (fn [db [_ sid frame point]] - (let [uuid (random-uuid) - host (get-in db [:ui :open])] - (-> db - (update :ui dissoc :drop) - (edit/edit-entry #(update % :clip clip/place-symbol (:store %) - host sid (* frame (:rate (clip/grid-time (:clip %) host))) uuid point)) - (assoc-in [:ui :selection] [:node host uuid [uuid]]))))) + ;; A symbol dropped on a lane becomes a naturally playing clip in that lane. + ;; With no lane under it, make one: new timeline/stage placement therefore + ;; never invents another permanent row-per-symbol track. + (fn [db [_ source-id frame point target]] + (let [{document :clip st :store} (store/entry (:clip/current db)) + open (get-in db [:ui :open]) + selected (get-in db [:ui :selection]) + [_ selected-sid selected-id] selected + selected-node (get-in document [:symbols selected-sid :nodes selected-id]) + target (or target (when (node/lane? selected-node) selected)) + [_ target-sid target-id target-path] target + target-node (get-in document [:symbols target-sid :nodes target-id]) + existing? (and (= :node (first target)) (node/lane? target-node)) + lane-id (if existing? target-id (random-uuid)) + sid (if existing? target-sid open) + prepared (if existing? {:clip document} + (lane/add-lane document sid lane-id)) + lane-selection [:node sid lane-id (if existing? target-path [lane-id])] + owner-frame (selection-frame (:clip prepared) st open lane-selection frame) + at (when (number? owner-frame) + (lane/lane-frame (:clip prepared) sid lane-id owner-frame)) + uuid (random-uuid) + result (if (integer? at) + (lane/place-symbol (:clip prepared) st sid lane-id uuid source-id at + {:extent :grow-symbol :point point + :remainder-id (random-uuid)}) + {:refused "the drop is not on one frame of this lane"}) + path (conj (vec (butlast (nth lane-selection 3))) uuid)] + (if-let [why (or (:refused prepared) (:refused result))] + (-> db (update :ui dissoc :drop) (update :project merge {:status why})) + (cond-> (-> db + (update :ui dissoc :drop) + (edit/transaction (constantly (:clip result))) + (assoc-in [:ui :selection] [:node sid uuid path])) + (not existing?) + (assoc-in [:ui :target] {:sid sid :id lane-id :path [lane-id]})))))) (rf/reg-event-db ::drop-sound @@ -649,6 +692,29 @@ (edit/edit #(clip/place-sound % host source label length rate (* frame (:rate (clip/grid-time % host))) uuid)) (assoc-in [:ui :selection] [:node host uuid [uuid]]))))) +(rf/reg-event-db + ::adopt-in-lane + (fn [db [_ [_ from-sid id _] [_ lane-sid lane-id lane-path :as lane-selection] + frame]] + (let [{document :clip st :store} (store/entry (:clip/current db)) + open (get-in db [:ui :open]) + owner-frame (selection-frame document st open lane-selection frame) + at (when (number? owner-frame) + (lane/lane-frame document lane-sid lane-id owner-frame)) + result (cond + (not= from-sid lane-sid) + {:refused "a clip and its destination lane must be in the same symbol"} + (not (integer? at)) {:refused "the drop is not on one frame of this lane"} + :else (lane/adopt document lane-sid lane-id id at + {:extent :grow-symbol + :remainder-id (random-uuid)})) + path (conj (vec (butlast lane-path)) id)] + (if-let [why (:refused result)] + (update db :project merge {:status why}) + (-> db + (edit/transaction (constantly (:clip result))) + (assoc-in [:ui :selection] [:node lane-sid id path])))))) + ;; --------------------------------------------------------------------------- ;; moving rows between symbols ;; diff --git a/frontend/src/arthur/ui/drag.cljs b/frontend/src/arthur/ui/drag.cljs index cb4463f..82a174b 100644 --- a/frontend/src/arthur/ui/drag.cljs +++ b/frontend/src/arthur/ui/drag.cljs @@ -57,8 +57,9 @@ (defn row! "Start carrying the timeline row at `path` — a node of kind `node-kind`, to be moved into another symbol or grouped with another node." - [path node-kind] - (reset! carrying {:kind :row :path path :node-kind node-kind})) + [path node-kind selection] + (reset! carrying {:kind :row :path path :node-kind node-kind + :selection selection})) (defn row "The path of the row being carried, or nil when it is not a row." @@ -70,6 +71,9 @@ [] (:node-kind @carrying)) +(defn row-selection [] + (when (= :row (:kind @carrying)) (:selection @carrying))) + (defn other! "Start carrying something that is not yet in the document: `:kind` says what, and the rest is what a preview can show of it before it is fetched." @@ -85,11 +89,13 @@ (defn hover! "Say where the drag would land, for the previews. `point` is nil over the timeline." - [where frame point] + ([where frame point] (hover! where frame point nil)) + ([where frame point target] (when-let [{:keys [kind label frames]} @carrying] (rf/dispatch [::ui/drop-hover {:where where :frame frame :point point :label label :frames frames - :sound? (= :sound kind)}]))) + :target target + :sound? (= :sound kind)}])))) (defn pos-for "Where the preview goes so the symbol's middle is under `point` — what @@ -100,10 +106,11 @@ (defn land! "Drop what is being carried at `frame` of the open symbol: with its middle on stage pixel `point`, or, with no point — the timeline — where it was drawn." - [frame point] + ([frame point] (land! frame point nil)) + ([frame point target] (when-let [{:keys [kind sid] :as c} (when (accepts?) @carrying)] (case kind - :symbol (rf/dispatch [::ui/drop-symbol sid frame point]) + :symbol (rf/dispatch [::ui/drop-symbol sid frame point target]) ;; Video is asked about before anything happens: which frames, and what ;; the symbol they become is called. :footage (rf/dispatch [::footage/ask-convert c frame point]) @@ -111,4 +118,4 @@ ;; Where it is dropped in time; a sound has no place in space. :sound (rf/dispatch [::ui/drop-sound c frame]) nil)) - (done!)) + (done!))) diff --git a/frontend/src/arthur/ui/location.cljs b/frontend/src/arthur/ui/location.cljs index cb29e29..e20da2e 100644 --- a/frontend/src/arthur/ui/location.cljs +++ b/frontend/src/arthur/ui/location.cljs @@ -199,5 +199,5 @@ ", ignoring what is aimed") :on-click #(rf/dispatch [::ui/new-symbol :top])} {:label "lane" - :sub (str "a row of drawings in " (clip/symbol-name clip open)) + :sub (str "a row for symbol clips in " (clip/symbol-name clip open)) :on-click #(rf/dispatch [::ui/new-lane])}]}]])) diff --git a/frontend/src/arthur/ui/timeline.cljs b/frontend/src/arthur/ui/timeline.cljs index 46c1dcb..b7b8a0e 100644 --- a/frontend/src/arthur/ui/timeline.cljs +++ b/frontend/src/arthur/ui/timeline.cljs @@ -135,6 +135,7 @@ :label (node-label id n) :kind :node :node-kind (:kind n) + :lane? (node/lane? n) :of (node/source n) :select [:node sid id rpath] :expandable? true @@ -145,12 +146,11 @@ (distinct)) (vals channels)) :dense? (boolean (some :dense (vals channels)))}] - ;; AN CEL IS NOT A ROW. A lane's drawings are cel - ;; blocks on the lane's own row, so a lane of twelve - ;; cels is one row and not twelve — which is the - ;; vertical growth that made a keyed source look - ;; necessary. The cel is still the thing selected - ;; and addressed; only its presentation is shared. + ;; A CLIP IS NOT A ROW. A lane's symbol clips are + ;; blocks on the lane's own row, so twelve clips are + ;; still one row. The clip remains independently + ;; selectable and addressable; only its presentation + ;; is shared. (if (node/lane? (get-in sym [:nodes (:parent n)])) [] (let [row (cond-> row @@ -163,7 +163,7 @@ :source (node/source child) :span (mapv self (node/placed-span child)) :select [:node sid (:id child) (conj path (:id child))]}) - (symbol/lane-cels (:nodes sym) id))))] + (symbol/lane-clips (:nodes sym) id))))] (if-not open? [row] (-> [row] @@ -221,6 +221,20 @@ x (- (.-clientX event) (.-left box))] (-> (/ (* x frames) (.-width box)) js/Math.floor (max 0) (min (dec frames))))) +(defn- frame-at-element [^js event frames ^js element] + (let [box (.getBoundingClientRect element) + x (- (.-clientX event) (.-left box))] + (-> (/ (* x frames) (.-width box)) js/Math.floor (max 0) (min (dec frames))))) + +(defn- lane-under + "The lane track geometrically under a captured pointer, and its selection." + [^js event] + (some (fn [^js el] + (when-let [track (.closest el ".tl-track")] + (when-let [selection (aget track "arthurLane")] + [track selection]))) + (array-seq (.elementsFromPoint js/document (.-clientX event) (.-clientY event))))) + ;; --------------------------------------------------------------------------- ;; the panes @@ -296,8 +310,8 @@ (doall (for [[r label] [[0.25 "¼×"] [0.5 "½×"] [1.0 "1×"] [2.0 "2×"] [4.0 "4×"]]] ^{:key r} [:option {:value r} label]))]] [:span.sep] - ;; The same direct timing operations apply to any selected span, whether it - ;; is at the root or is a cel inside a drawing lane. + ;; The same direct timing operations apply to any selected symbol clip, + ;; whether it is still a legacy root node or lives in a lane. [:div.group.timing-controls {:aria-label "timing"} [:button {:disabled (not cuttable?) :aria-label "split" :title "split the selected clip at the playhead" @@ -352,14 +366,21 @@ on every render after, which would fight a person scrolling away." (memoize (fn [_selection] (fn [el] (some-> el (.scrollIntoView #js {:block "nearest"})))))) -(defn- label-cell [{:keys [path depth label kind node-kind select expandable? expanded? of via]} - selection target over solo tracing] +(defn- label-cell [{:keys [path depth label kind node-kind lane? select expandable? expanded? of via]} + selection target over solo tracing renaming draft] (let [node? (= :node kind) ;; AIMED IS NOT SELECTED, so it does not wear the selected class. The ;; target is where a new thing would go; the selection is what the ;; inspector is showing. One row is often both and must still say which ;; of the two it is being. aimed? (and node? (= path (:path target))) + editing? (and lane? (= select @renaming)) + begin-rename! (fn [] (reset! draft label) (reset! renaming select)) + commit-rename! (fn [] + (when (= select @renaming) + (reset! renaming nil) + (let [[_ sid id] select] + (rf/dispatch [::ui/rename-node sid id @draft])))) [over-path where] @over] [:div (cond-> {:class (str "tl-label" (when (and select (= select selection)) " on") (when aimed? " aimed") @@ -371,6 +392,7 @@ (if (= :instance node-kind) " drop-into" " drop-group")))) :style {:padding-left (str (+ 4 (* 11 depth)) "px")} :title label + :tab-index (when lane? 0) :ref (when (and select (= select selection)) (reveal selection)) ;; A LABEL AIMS. Clicking a row's name says "I am working ;; here", which is a statement about a place in the document; @@ -379,7 +401,14 @@ ;; the first moves where new drawings and symbols go. :on-click #(when select (rf/dispatch [::ui/aim select])) ;; An instance's row opens the symbol it places, as a tab. - :on-double-click #(when of (rf/dispatch [::pb/open-symbol of]))} + :on-double-click (fn [^js e] + (cond lane? (do (.stopPropagation e) (begin-rename!)) + of (rf/dispatch [::pb/open-symbol of]))) + :on-key-down (when lane? + (fn [^js e] + (when (= "F2" (.-key e)) + (.preventDefault e) + (begin-rename!))))} ;; A node's row can be dragged onto another: onto an instance's, to ;; go inside the symbol it places; onto any other node's, to be ;; grouped with it into a new one; onto an edge of either, to be @@ -390,7 +419,7 @@ (.stopPropagation e) (.setData (.-dataTransfer e) "text/plain" "row") (set! (.. e -dataTransfer -effectAllowed) "move") - (drag/row! path node-kind)) + (drag/row! path node-kind select)) :on-drag-end (fn [_] (reset! over nil) (drag/done!)) :on-drag-enter (fn [^js e] (when (takes? path node-kind) (.preventDefault e))) :on-drag-over (fn [^js e] @@ -419,8 +448,25 @@ (.stopPropagation e) (rf/dispatch [::ui/toggle-row path]))} (when expandable? (if expanded? "▾" "▸"))] - [:span.name label] + (if editing? + [:input.tl-name-input + {:value @draft :auto-focus true :aria-label "lane name" + :on-click #(.stopPropagation %) + :on-double-click #(.stopPropagation %) + :on-change #(reset! draft (.. % -target -value)) + :on-blur commit-rename! + :on-key-down (fn [^js e] + (case (.-key e) + "Enter" (do (.preventDefault e) (commit-rename!)) + "Escape" (do (.preventDefault e) (reset! renaming nil)) + nil))}] + [:span.name label]) (when node? [:span.kind (if via (str "· in " via) (str "·" (name node-kind)))]) + (when lane? + [:button.tl-rename + {:title "rename lane (F2)" + :on-click (fn [^js e] (.stopPropagation e) (begin-rename!))} + "✎"]) ;; A face's row is where its own footage is switched on, next to solo ;; because the two are the same kind of thing: what this row shows, here, ;; now, and nothing the picture keeps. The inspector's footage section does @@ -450,29 +496,51 @@ "`sliding` is the pointer's side of a bar being dragged, `{:path :x :width :df}`. What it looks like mid-drag is `[:ui :sliding]`, which the clip every row and the stage are drawn from already has in it." - [{:keys [path span keys dense? kind node-kind select slides cels]} frames sliding] + [{:keys [path span keys dense? kind node-kind select slides cels lane?]} frames sliding] (let [active-row (:row @sliding) slide (fn [^js e] (let [{from :row x0 :x width :width} @sliding] - (when (= path from) - (let [df (js/Math.round (/ (* frames (- (.-clientX e) x0)) (max 1 width)))] - (when (not= df (:df @sliding)) - (swap! sliding assoc :df df) - (rf/dispatch [::ui/sliding (:path @sliding) df - (:kind @sliding) (:ripple? @sliding) - (:other @sliding)])))))) + (when (= path from) + (let [df (js/Math.round (/ (* frames (- (.-clientX e) x0)) (max 1 width))) + drag (:drag @sliding) + [target-el target] (when drag (lane-under e)) + crossing? (and target (not= target (:source-lane drag))) + target-frame (when crossing? + (max 0 (- (frame-at-element e frames target-el) + (:grab drag))))] + (if crossing? + (do + (swap! sliding assoc :target-lane target :target-frame target-frame) + (rf/dispatch [::ui/sliding nil])) + (do + (swap! sliding dissoc :target-lane :target-frame) + (when (not= df (:df @sliding)) + (swap! sliding assoc :df df) + (rf/dispatch [::ui/sliding (:path @sliding) df + (:kind @sliding) (:ripple? @sliding) + (:other @sliding)])))))))) done (fn [commit?] (when (= path (:row @sliding)) - (let [{:keys [path df kind ripple? other]} @sliding] + (let [{:keys [path df kind ripple? other target-lane target-frame drag]} @sliding] (reset! sliding nil) - (rf/dispatch (if commit? [::ui/slide path df kind ripple? other] - [::ui/sliding nil]))))) - begin! (fn [^js e actual-path gesture-kind actual-select other] + (cond + (and commit? target-lane drag) + (do (rf/dispatch [::ui/sliding nil]) + (rf/dispatch [::ui/adopt-in-lane (:selection drag) + target-lane target-frame])) + commit? (rf/dispatch [::ui/slide path df kind ripple? other]) + :else (rf/dispatch [::ui/sliding nil]))))) + begin! (fn [^js e actual-path gesture-kind actual-select other drag] (let [track (.closest (.-currentTarget e) ".tl-track")] (.stopPropagation e) (when actual-select (rf/dispatch [::ui/select actual-select])) (reset! sliding {:row path :path actual-path :kind gesture-kind :other other + :drag (when drag + (assoc drag + :source-lane select + :grab (- (frame-at-element e frames track) + (:in drag)))) :ripple? (and (= :out gesture-kind) (.-shiftKey e)) :x (.-clientX e) :df 0 :width (.-width (.getBoundingClientRect track))}) @@ -483,7 +551,31 @@ ;; goes on when the bar has slid off the ruler and is no longer drawn. {:on-pointer-move slide :on-pointer-up (fn [e] (slide e) (done true)) - :on-pointer-cancel (fn [_] (done false))} + :on-pointer-cancel (fn [_] (done false)) + :ref (when lane? (fn [el] (when el (aset el "arthurLane" select)))) + :on-drag-enter (fn [^js e] + (when (and lane? (or (drag/accepts?) (drag/row))) + (.preventDefault e) + (.stopPropagation e) + (when (drag/accepts?) + (drag/hover! :timeline (frame-at e frames) nil select)))) + :on-drag-over (fn [^js e] + (when (and lane? (or (drag/accepts?) (drag/row))) + (.preventDefault e) + (.stopPropagation e) + (set! (.. e -dataTransfer -dropEffect) + (if (drag/row) "move" "copy")) + (when (drag/accepts?) + (drag/hover! :timeline (frame-at e frames) nil select)))) + :on-drop (fn [^js e] + (when (and lane? (or (drag/accepts?) (drag/row))) + (.preventDefault e) + (.stopPropagation e) + (if-let [from (drag/row-selection)] + (do (drag/done!) + (rf/dispatch [::ui/adopt-in-lane from select + (frame-at e frames)])) + (drag/land! (frame-at e frames) nil select))))} ;; Clipped to the ruler: an instance longer than the room left in its ;; symbol still plays its own frames from 0, it is just cut off at the end. (when-let [[in out] (when (and span (nil? cels)) [(max 0 (first span)) (min frames (second span))])] @@ -495,46 +587,62 @@ :width (str (* 100 (/ (- out in) (max 1 frames))) "%")} :on-pointer-down (when select - #(begin! % (or slides path) :slide select nil))} + #(begin! % (or slides path) :slide select nil nil))} (when select [:span.tl-edge.out {:title "Drag endpoint · Shift-drag ripples later clips" - :on-pointer-down #(begin! % path :out select nil)}])])) + :on-pointer-down #(begin! % path :out select nil nil)}])])) (doall - (for [[i {:keys [id label source span select]}] (map-indexed vector cels) + (for [[i {:keys [id label source span select ghost?]}] + (map-indexed vector + (cond-> (vec cels) + (= select (:target-lane @sliding)) + (conj {:id ::moving :label (get-in @sliding [:drag :label]) + :span [(:target-frame @sliding) + (+ (:target-frame @sliding) + (get-in @sliding [:drag :duration]))] + :ghost? true}))) :let [prev (when (pos? i) (nth cels (dec i))) - joined? (and prev (= (second (:span prev)) (first span))) + joined? (and (not ghost?) prev (= (second (:span prev)) (first span))) in (max 0 (first span)) out (min frames (second span))] :when (< in out)] ^{:key (str id)} [:button.tl-cel - {:title (str label " · select cel; double-click to edit shared drawing") + {:title (str label " · select clip; double-click to edit its symbol") + :class (when ghost? "ghost") :style {:position "absolute" :left (edge% in frames) :width (str (* 100 (/ (- out in) (max 1 frames))) "%") :top "2px" :bottom "2px" :overflow "visible" :padding "0 3px"} - :on-pointer-down #(begin! % (nth select 3) :slide select nil) - :on-click (fn [e] (.stopPropagation e) - (rf/dispatch [::ui/select select]) - (rf/dispatch [::pb/seek (js/Math.floor in)])) - :on-double-click (fn [e] (.stopPropagation e) - (when source (rf/dispatch [::pb/open-symbol source])))} + :on-pointer-down (when select + #(begin! % (nth select 3) :slide select nil + {:selection select :label label :in in + :duration (- out in)})) + :on-click (when select + (fn [e] (.stopPropagation e) + (rf/dispatch [::ui/select select]) + (rf/dispatch [::pb/seek (js/Math.floor in)]))) + :on-double-click (when select + (fn [e] (.stopPropagation e) + (when source (rf/dispatch [::pb/open-symbol source]))))} [:span.tl-cel-label label] - (if joined? - [:span.tl-junction - {:title "Left: trim left · center: roll cut · right: trim right" - :on-pointer-down - (fn [^js e] - (let [box (.getBoundingClientRect (.-currentTarget e)) - x (/ (- (.-clientX e) (.-left box)) (max 1 (.-width box))) - left-path (nth (:select prev) 3) - right-path (nth select 3)] - (cond - (< x 0.34) (begin! e left-path :out (:select prev) nil) - (> x 0.66) (begin! e right-path :in select nil) - :else (begin! e right-path :roll select left-path))))}] - [:span.tl-edge.in {:title "Drag start" - :on-pointer-down #(begin! % (nth select 3) :in select nil)}]) - [:span.tl-edge.out {:title "Drag endpoint · Shift-drag ripples later clips" - :on-pointer-down #(begin! % (nth select 3) :out select nil)}]])) + (when select + (if joined? + [:span.tl-junction + {:title "Left: trim left · center: roll cut · right: trim right" + :on-pointer-down + (fn [^js e] + (let [box (.getBoundingClientRect (.-currentTarget e)) + x (/ (- (.-clientX e) (.-left box)) (max 1 (.-width box))) + left-path (nth (:select prev) 3) + right-path (nth select 3)] + (cond + (< x 0.34) (begin! e left-path :out (:select prev) nil nil) + (> x 0.66) (begin! e right-path :in select nil nil) + :else (begin! e right-path :roll select left-path nil))))}] + [:span.tl-edge.in {:title "Drag start" + :on-pointer-down #(begin! % (nth select 3) :in select nil nil)}])) + (when select + [:span.tl-edge.out {:title "Drag endpoint · Shift-drag ripples later clips" + :on-pointer-down #(begin! % (nth select 3) :out select nil nil)}])])) ;; A dense channel has a value on every frame, so ticking each one is a solid ;; block that says less than the bar behind it already does. (when-not dense? @@ -547,7 +655,9 @@ ;; The row a carried row is over and which part of it, for the ;; highlight. over (r/atom nil) - sliding (r/atom nil)] + sliding (r/atom nil) + renaming (r/atom nil) + draft (r/atom "")] (let [clip @(rf/subscribe [::render/clip]) frames (max 1 (or @(rf/subscribe [::render/frames]) 1)) frame @(rf/subscribe [::playback/frame]) @@ -565,12 +675,21 @@ ;; Where a drag out of the pool would land, as a row of its own at the ;; top of its section: its own length, starting on the frame it would ;; start on. The stage's drop shows it too, at the playhead. - ghost (when drop + drop-lane (:target drop) + ghost (when (and drop (nil? drop-lane)) {:path [::drop] :depth 0 :kind :ghost :label (str "+ " (:label drop)) :span [(:frame drop) (+ (:frame drop) (or (:frames drop) 1))] :keys []}) - picture (cond->> (rows clip open expanded) + lane-ghost (when (and drop drop-lane (not (:sound? drop))) + {:id ::drop :label (str "+ " (:label drop)) :ghost? true + :span [(:frame drop) (+ (:frame drop) (or (:frames drop) 1))]}) + picture (cond->> (cond->> (rows clip open expanded) + lane-ghost + (mapv (fn [row] + (if (= drop-lane (:select row)) + (update row :cels (fnil conj []) lane-ghost) + row)))) (and ghost (not (:sound? drop))) (cons ghost)) sounds (cond->> (sound-rows clip open expanded) (and ghost (:sound? drop)) (cons ghost)) @@ -601,7 +720,7 @@ (doall (for [row visible] (with-meta (if (= :section (:kind row)) [:div.tl-label.tl-section (:label row)] - [label-cell row selection target over solo tracing]) + [label-cell row selection target over solo tracing renaming draft]) {:key (str (:path row))})))] [:div.tl-tracks {:on-drag-enter (fn [^js e] (when (drag/accepts?) (.preventDefault e))) @@ -610,8 +729,17 @@ (.preventDefault e) (drag/hover! :timeline (frame-at e frames) nil))) :on-drag-leave (fn [^js e] - (when-not (.contains (.-currentTarget e) (.-relatedTarget e)) - (rf/dispatch [::ui/drop-clear]))) + (let [box (.getBoundingClientRect (.-currentTarget e)) + inside? (and (<= (.-left box) (.-clientX e) (.-right box)) + (<= (.-top box) (.-clientY e) (.-bottom box)))] + ;; Adding the inline ghost changes the element below + ;; the pointer and Chromium reports a leave with no + ;; related target. Keep the preview while the pointer + ;; is still geometrically inside the tracks. + (when (and (not inside?) + (not (.contains (.-currentTarget e) + (.-relatedTarget e)))) + (rf/dispatch [::ui/drop-clear])))) ;; In its own coordinates: dropped in time, nowhere in particular in ;; space, so what was drawn at a place stays at that place. :on-drop (fn [^js e] diff --git a/frontend/test/arthur/domain/lane_test.cljs b/frontend/test/arthur/domain/lane_test.cljs index 203f38a..5ee9f0a 100644 --- a/frontend/test/arthur/domain/lane_test.cljs +++ b/frontend/test/arthur/domain/lane_test.cljs @@ -102,16 +102,16 @@ :extent :grow-symbol})) shrink (:clip (lane/resize-out doc :main :a 2 {:ripple? true}))] (is (= [[0 6] [6 8] [8 12]] - (mapv node/placed-span (symbol/lane-cels (get-in plain [:symbols :main :nodes]) :girl))) + (mapv node/placed-span (symbol/lane-clips (get-in plain [:symbols :main :nodes]) :girl))) "a normal grow eats the beginning of the adjacent cel") (is (= [[0 9] [9 12]] - (mapv node/placed-span (symbol/lane-cels (get-in across [:symbols :main :nodes]) :girl))) + (mapv node/placed-span (symbol/lane-clips (get-in across [:symbols :main :nodes]) :girl))) "a long grow removes wholly consumed cels and trims the survivor") (is (= [[0 6] [6 10] [10 14]] - (mapv node/placed-span (symbol/lane-cels (get-in ripple [:symbols :main :nodes]) :girl))) + (mapv node/placed-span (symbol/lane-clips (get-in ripple [:symbols :main :nodes]) :girl))) "shift-grow moves every later cel") (is (= [[0 2] [2 6] [6 10]] - (mapv node/placed-span (symbol/lane-cels (get-in shrink [:symbols :main :nodes]) :girl))) + (mapv node/placed-span (symbol/lane-clips (get-in shrink [:symbols :main :nodes]) :girl))) "shift-shrink pulls every later cel left") (is (:refused (lane/resize-out doc :main :a 0 {}))) (is (:refused (lane/resize-out doc :main :a 2.5 {}))))) @@ -122,13 +122,13 @@ right-only (:clip (lane/resize-in doc :main :b 6)) grown-left (:clip (lane/resize-in doc :main :b 2))] (is (= [[0 6] [6 8] [8 12]] - (mapv node/placed-span (symbol/lane-cels (get-in rolled [:symbols :main :nodes]) :girl))) + (mapv node/placed-span (symbol/lane-clips (get-in rolled [:symbols :main :nodes]) :girl))) "the shared cut moves without moving either clip") (is (= [[0 4] [6 8] [8 12]] - (mapv node/placed-span (symbol/lane-cels (get-in right-only [:symbols :main :nodes]) :girl))) + (mapv node/placed-span (symbol/lane-clips (get-in right-only [:symbols :main :nodes]) :girl))) "the right side of the junction trims only the right clip") (is (= [[0 2] [2 8] [8 12]] - (mapv node/placed-span (symbol/lane-cels (get-in grown-left [:symbols :main :nodes]) :girl))) + (mapv node/placed-span (symbol/lane-clips (get-in grown-left [:symbols :main :nodes]) :girl))) "growing the right clip left trims the neighbour instead of overlapping") (is (:refused (lane/roll doc :main :a :b 0))) (is (:refused (lane/roll doc :main :a :insert 6))))) @@ -223,6 +223,39 @@ (is (= 0 (get-in b [:symbols :main :nodes :b :playback :speed]))) (is (:refused (lane/append-drawing b :main :girl :a :new {}))))) +(deftest arbitrary-symbols-drop-into-the-same-lane-and-claim-their-time + (let [doc (document) + dropped (lane/place-symbol doc nil :main :girl :clip :wave 2 + {:extent :grow-symbol :remainder-id :tail}) + after (:clip dropped) + clips (symbol/lane-clips (get-in after [:symbols :main :nodes]) :girl)] + (is (= :clip (:selection dropped))) + (is (= [[0 2] [2 12]] (mapv node/placed-span clips)) + "the natural ten-frame symbol claims [2,12), trimming/removing incumbents") + (is (= :wave (node/source (second clips)))) + (is (= 1 (:speed (node/playback-of (second clips)))) + "a dropped symbol plays; it is not converted into a drawing hold") + (is (empty? (clip/problems after))))) + +(deftest an-existing-symbol-row-can-be-adopted-by-a-lane + (let [doc (assoc-in (document) [:symbols :main :nodes :badge] + {:id :badge :kind :instance :z "z" + :source {:symbol :wave} :span [0 3] + :time {:at 1 :rate 1} + :playback {:in 2 :speed 1 :end :stop}}) + result (lane/adopt doc :main :girl :badge 5 + {:extent :grow-symbol :remainder-id :tail}) + after (:clip result) + n (get-in after [:symbols :main :nodes :badge])] + (is (= :girl (:parent n))) + (is (= [5 8] (node/placed-span n))) + (is (= {:in 2 :speed 1 :end :stop} (:playback n)) + "adoption changes placement, not source timing") + (is (= [[0 4] [4 5] [5 8] [8 12]] + (mapv node/placed-span + (symbol/lane-clips (get-in after [:symbols :main :nodes]) :girl)))) + (is (empty? (clip/problems after))))) + (deftest fractional-placement-rates-convert-the-hold-delta (let [doc (-> (document) (assoc-in [:symbols :main :nodes :a :time :rate] 2) @@ -557,7 +590,7 @@ ;; drawing must not quietly shorten the film. (let [doc (document) empty-lane (:clip (lane/blank doc :main :girl [0 12] {}))] - (is (empty? (symbol/lane-cels (get-in empty-lane [:symbols :main :nodes]) :girl))) + (is (empty? (symbol/lane-clips (get-in empty-lane [:symbols :main :nodes]) :girl))) (is (= 12 (get-in empty-lane [:symbols :main :frames]))) (is (empty? (clip/problems empty-lane))) ;; Growing is still the caller's word, and only ever grows. diff --git a/frontend/test/browser/lane.mjs b/frontend/test/browser/lane.mjs index 8864df2..c9ba043 100644 --- a/frontend/test/browser/lane.mjs +++ b/frontend/test/browser/lane.mjs @@ -160,13 +160,74 @@ try { }); await sleep(250); }; + const dropPoolSymbol = async frame => { + const points = await evaluate(`(() => { + const source = document.querySelector('.pool-row:not(.main) .pool-item[draggable="true"]'); + const track = document.querySelector('.tl-track'); + if (!source || !track) return null; + source.scrollIntoView({block: 'center'}); + const a = source.getBoundingClientRect(), b = track.getBoundingClientRect(); + const frames = Number(document.querySelector('.at-frame').textContent.split('/')[1]); + return {sx: a.left + a.width / 2, sy: a.top + a.height / 2, + tx: b.left + b.width * (${frame} + 0.25) / frames, + ty: b.top + b.height / 2}; + })()`); + assert(points, 'a library symbol and lane are available to drag'); + await send('Input.dispatchMouseEvent', {type: 'mouseMoved', x: points.sx, y: points.sy}); + await send('Input.dispatchMouseEvent', {type: 'mousePressed', x: points.sx, y: points.sy, + button: 'left', buttons: 1, clickCount: 1}); + await send('Input.dispatchMouseEvent', {type: 'mouseMoved', x: points.sx + 12, y: points.sy, + button: 'left', buttons: 1}); + await sleep(120); + await send('Input.dispatchMouseEvent', {type: 'mouseMoved', x: points.tx, y: points.ty, + button: 'left', buttons: 1}); + await sleep(120); + assert.equal(await evaluate('document.querySelectorAll(".tl-label.ghost").length'), 0, + 'targeting an existing lane does not preview a temporary new row'); + const lanePreview = await evaluate(`(() => { + const db = cljs.core.deref(re_frame.db.app_db), k = cljs.core.keyword; + return {ghosts: document.querySelectorAll('.tl-track .tl-cel.ghost').length, + drop: cljs.core.clj__GT_js(cljs.core.get_in(db, [k('ui'), k('drop')]))}; + })()`); + assert.equal(lanePreview.ghosts, 1, + `the pool drop preview is drawn inside the targeted lane: ${JSON.stringify(lanePreview)}`); + await send('Input.dispatchMouseEvent', {type: 'mouseReleased', x: points.tx, y: points.ty, + button: 'left', buttons: 0, clickCount: 1}); + await sleep(300); + }; + const dragClipBetweenLanes = async frame => { + const points = await evaluate(`(() => { + const tracks = [...document.querySelectorAll('.tl-track')]; + const source = tracks[1]?.querySelector('.tl-cel'); + const target = tracks[0]; + if (!source || !target) return null; + const a = source.getBoundingClientRect(), b = target.getBoundingClientRect(); + const frames = Number(document.querySelector('.at-frame').textContent.split('/')[1]); + return {sx: a.left + a.width / 2, sy: a.top + a.height / 2, + tx: b.left + b.width * (${frame} + 0.25) / frames, + ty: b.top + b.height / 2}; + })()`); + assert(points, 'two lanes and a source clip are available'); + await send('Input.dispatchMouseEvent', {type: 'mousePressed', x: points.sx, y: points.sy, + button: 'left', buttons: 1, clickCount: 1}); + await send('Input.dispatchMouseEvent', {type: 'mouseMoved', x: points.tx, y: points.ty, + button: 'left', buttons: 1}); + await sleep(150); + assert.equal(await evaluate('document.querySelectorAll(".tl-track")[0].querySelectorAll(".tl-cel.ghost").length'), 1, + 'cross-lane movement previews in the destination lane'); + await send('Input.dispatchMouseEvent', {type: 'mouseReleased', x: points.tx, y: points.ty, + button: 'left', buttons: 0, clickCount: 1}); + await sleep(300); + }; - await click('lane'); assert.equal(await evaluate('[...document.querySelectorAll(".timing-controls > button")].every(b => b.disabled)'), true, - 'timing buttons are disabled when the selected row is a lane, not a symbol clip'); + 'timing buttons are disabled without a symbol clip'); await click('inside'); let s = await shot(); - assert.deepEqual(placed(s), [[0, 1]], 'new inside an aimed lane is a one-frame symbol'); + assert.deepEqual(placed(s), [[0, 1]], + 'new at the root automatically makes a lane and a one-frame symbol clip'); + assert.equal(await evaluate('document.querySelectorAll(".tl-label .kind").length'), 1, + 'new temporal content creates a lane row rather than a row per symbol'); assert.equal(await evaluate(`document.querySelectorAll('.cel-sheet, [aria-label="time view"]').length`), 0, 'there is one temporal interface'); assert.equal(await evaluate('document.querySelectorAll(".timing-controls > button").length'), 3, @@ -207,8 +268,41 @@ try { await drag('.tl-cel:first-of-type .tl-edge.out', 2); assert.deepEqual(placed(await shot()), [[0, 6], [6, 7], [7, 8]], 'ordinary growth trims adjacent spans and never overlaps'); + + await dropPoolSymbol(10); + s = await shot(); + assert.deepEqual(placed(s), [[0, 6], [6, 7], [7, 8], [10, 11]], + 'an arbitrary library symbol drops into an existing lane'); + assert.equal(instances(s).at(-1).playback.speed, 1, + 'a dropped symbol plays naturally instead of becoming a held drawing'); + + await evaluate(`re_frame.core.dispatch(cljs.core.vector(cljs.core.keyword('arthur.events.ui/new-lane')))`); + await sleep(180); + s = await shot(); + const renameControls = await evaluate('document.querySelectorAll(".tl-label .tl-rename").length'); + assert.equal(renameControls, 2, + `both lanes expose rename controls: ${JSON.stringify(s.clip.symbols.main.nodes)}`); + await evaluate('document.querySelector(".tl-label .tl-rename").click()'); + await sleep(80); + assert(await evaluate(`(() => { + const input = document.querySelector('.tl-name-input'); + if (!input) return false; + Object.getOwnPropertyDescriptor(HTMLInputElement.prototype, 'value').set.call(input, 'Foreground'); + input.dispatchEvent(new InputEvent('input', {bubbles: true, inputType: 'insertText', data: 'Foreground'})); + input.blur(); return true; + })()`), 'lane rename editor opens'); + await sleep(180); + s = await shot(); + assert(Object.values(s.clip.symbols.main.nodes).some(n => n.layout === 'sequence' && n.name === 'Foreground'), + 'a lane name is editable and persisted in the document'); + + await dragClipBetweenLanes(12); + s = await shot(); + const lanes = Object.values(s.clip.symbols.main.nodes).filter(n => n.layout === 'sequence'); + assert.deepEqual(lanes.map(l => instances(s).filter(n => n.parent === l.id).length).sort(), [1, 3], + 'a clip body can move from one lane to another'); assert.equal(errors.length, 0, JSON.stringify(errors)); - console.log('PASS: one timeline creates, trims, rolls, and ripples drawing-lane symbols'); + console.log('PASS: generic lanes preview, rename, move, place, trim, roll, and ripple clips'); } finally { if (ws?.readyState === WebSocket.OPEN) { ws.send(JSON.stringify({ id: 999999, method: 'Browser.close' })); diff --git a/static/arthur/app.css b/static/arthur/app.css index 9799e4b..e608014 100644 --- a/static/arthur/app.css +++ b/static/arthur/app.css @@ -1000,6 +1000,9 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); } .tl-label:hover:not(.on) { background: #fff; } .tl-label .name { min-width: 0; overflow: hidden; text-overflow: ellipsis; } .tl-label .kind { color: var(--dim); } +.tl-name-input { min-width: 0; flex: 1; font: inherit; } +.tl-rename { margin-left: auto; padding: 0 3px; border: 0; background: none; color: var(--dim); } +.tl-rename:hover { color: var(--fg); } /* A fixed-width cell whether or not there is a triangle in it, so names at the same depth line up down the column. */ @@ -1081,7 +1084,8 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); } } /* The preview row of a drop in flight: its own length, where it would start. */ -.tl-span.ghost, .tl-label.ghost { pointer-events: none; } +.tl-span.ghost, .tl-label.ghost, .tl-cel.ghost { pointer-events: none; } +.tl-cel.ghost { background: transparent; border: 1px dashed var(--sel); color: var(--sel); } /* A row being dragged over another: into an instance, or grouped with a node, by its middle; in front of it or behind it, by its top or bottom edge. */ From 95451798d26f0dd1fee28d7ca7153d71c7ff8db2 Mon Sep 17 00:00:00 2001 From: Your Name Date: Thu, 1 Oct 2026 15:13:18 -0400 Subject: [PATCH 03/10] Nesting is a gesture of its own, not an overlap Now that a lane is generic, the obvious next move is to read a clip dropped on another clip as "put it inside that symbol". It cannot mean that: dropping a clip on occupied lane time already means it claims that time and trims the incumbent. Structural nesting therefore needs an explicit affordance -- a grab handle with `grab`/`grabbing` cursors, distinct from the body's temporal move and the edges' trims -- and its drop must route through `nest/move-node`, which preserves world transform and root timing, rather than through a weaker `:parent` assignment that would make a drawing jump when it is rehoused. The second half of the note is what expansion should be. One permanently expanded row per lane clip is the vertical growth the one-row lane exists to avoid, so an expanded lane shows exactly one portal: the currently selected clip, swapped in place when the selection changes, not following the playhead. The portal header is the structural drop target, sub-expanding it walks the source symbol's lanes through the existing recursive root-time mapping, and collapsed clips carry their instance-level keys as ticks. The cost of inspection stays constant. No lane-as-symbol type and no second ownership edge: the hierarchy is still symbol, lane, clip, source symbol, its nodes. Lane membership owns time; a symbol instance owns composition. Written before the interaction is built, because the capability it protects is easy to lose by accident. Co-Authored-By: Claude Opus 5 --- docs/lane-nesting-notes.md | 116 +++++++++++++++++++++++++++++++++++++ 1 file changed, 116 insertions(+) create mode 100644 docs/lane-nesting-notes.md diff --git a/docs/lane-nesting-notes.md b/docs/lane-nesting-notes.md new file mode 100644 index 0000000..7adee9a --- /dev/null +++ b/docs/lane-nesting-notes.md @@ -0,0 +1,116 @@ +# Lane nesting interaction notes + +Status: design note, 2026-10-01. This records the interaction before more lane +UI is implemented. + +## The capability that must not be lost + +A lane owns temporal placement, but a symbol instance is still a doorway into +another symbol. A drawing accidentally authored at the root must be movable into +an instance in any lane, including another lane, without changing its visible +position or timing. + +That operation already exists as `nest/move-node`. It resolves the source and +destination at the current root frame, transplants the node, and re-expresses +its transform and time under the new parent. The lane UI must expose a target +path for it; it must not replace it with a weaker `:parent` assignment. + +There are therefore two different drag intentions: + +1. **Temporal move:** drag a clip body onto lane space. It remains a clip in a + lane, moves in time, and claims the destination interval by trimming/removing + incumbents. +2. **Structural move:** drag from the clip's grab affordance onto another symbol + instance. The dragged node is transplanted into the target instance's source + symbol with `nest/move-node`, preserving its world transform and root timing. + +These cannot be inferred from overlap alone. Dropping clip A onto time occupied +by clip B already means “A claims that time and trims B.” Structural nesting +therefore needs an explicit grab affordance/mode. Its cursor is `grab` and +`grabbing`; trim edges keep their resize cursors and the ordinary body keeps its +timeline-move behavior. + +Both visible clip blocks and an expanded symbol header are structural drop +targets. This permits moving a root drawing directly into `symbol-3` even when +its lane is collapsed. + +## Compact expansion: one selected-clip portal + +Expanding a lane must not restore row-per-clip vertical growth. Instead, an +expanded lane reveals exactly one clip portal: the currently selected clip in +that lane. + +```text +▾ foreground lane [symbol-1][symbol-2][symbol-3] + ▾ symbol-3 instance/source header and drop target + ▸ body lane nested rows, mapped to the root ruler + ▸ face lane + position nested keyframes mapped to root time +``` + +- Selecting another block in the same lane swaps the portal in place. +- With no selected clip in that lane, expansion shows a compact “select a clip + to inspect” row. It must not follow the playhead during playback; that would + make the timeline restructure itself while playing. +- The portal header represents the selected instance and is the structural drop + target for moving root or sibling content into its source symbol. +- Sub-expanding the portal uses the existing recursive symbol-row walk. Nested + lanes and channels are mapped through the instance clock into the open/root + ruler, as ordinary expanded instances already are. +- The lane's own transform/channel rows remain available separately. They affect + every clip in the lane and are not properties of the selected portal. + +This keeps the cost of inspection constant: an expanded lane adds one selected +symbol branch, not one branch for every temporal clip it contains. + +## Keyframe visibility + +Two levels should be visible without changing editors: + +- The selected clip's instance-level keys (transform, visibility, corrections) + appear as ticks inside that clip block on the lane row. +- Expanding the lane opens the selected clip portal, where source-symbol and + recursively nested keys appear on their own rows, mapped to root time. + +Thus the collapsed lane answers “where does this clip change?” and the expanded +portal answers “which property inside this symbol changes?” The second view is +still the root timeline; entering the symbol is not required merely to see or +edit its keys. + +## Drag targets and feedback + +- Grab onto lane background: move/adopt the instance into that lane. +- Grab onto a symbol clip: structurally transplant into that clip's source + symbol. +- Grab onto the expanded portal header: the same structural transplant, with a + larger and less ambiguous target. +- Grab onto itself or one of its descendants: refuse before drop to prevent a + symbol cycle. +- A structural target receives an inset highlight and the preview stays in that + target. A lane-time target receives the dashed temporal clip preview. +- Successful structural drops expand the target lane and select the moved node + beneath the target portal, so the result is immediately visible. + +## Data model consequence + +No lane-as-symbol type is required. The hierarchy remains: + +```text +symbol -> sequence lane -> instance clip -> source symbol -> its lanes/nodes +``` + +Lane membership owns time partitioning. Symbol instances own composition +nesting. The UI may present the selected instance below its lane, but that is a +derived portal, not another ownership edge and not a duplicated node. + +## Implementation order + +1. Render instance-level key ticks within lane clips. +2. Add selected-clip portal expansion to `timeline/rows` using the existing + recursive walk and root-time mapping. +3. Add the explicit structural grab affordance and clip/portal drop targets. +4. Route structural drops through `nest/move-node`; add browser coverage for a + root drawing moved into a clip in another lane without a visual jump. +5. After the transplant, expand the destination portal and reveal/select the + moved row. + From 2dc5735ded2821c797532301f5c0e8af4616e797 Mon Sep 17 00:00:00 2001 From: Your Name Date: Thu, 1 Oct 2026 16:13:02 -0400 Subject: [PATCH 04/10] The timeline opens the whole document MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Making a lane one row cost the thing a row was for. A clip stopped being a row, so there was no longer any way to open a clip and see what was inside it, and the inside of a drawing — the most ordinary thing in the document — became reachable only by opening it as its own tab. This is that capability back, from the root timeline, down as far as it goes. An expanded lane opens exactly ONE clip: the selected one. Its own keys, then the lanes and nodes of the symbol it places, then theirs, each mapped into this ruler by the recursive walk that was already there. Twelve clips in a lane still cost one row, and inspection costs one branch rather than twelve. Two things that only showed up once it ran. The portal is chosen by the whole LINEAGE of the selection and not by the selected id: selecting a shape inside the clip — or the end of its span — is still working inside that clip, and matching the id alone shut the portal the instant anything under it was touched. And selecting now waits for the pointer to come UP, because selecting on the way down re-drew the timeline before the gesture had said anything: it shut the portal holding the lane being dragged INTO, out from under the pointer. A HELD clip opens too, which the old row walk never did either. `source-time` is nil for a hold, so the walk stopped there and the contents of every drawing were invisible from here. Its rows are shown across the hold — which is when the node is on screen — and marked `:unmapped?`: no keys, and no draggable edges, because a frozen clock gives no frame inside it a place on this ruler. Refusing to place the keys is the honest half; refusing to show the rows was not. Double-clicking a clip opens the symbol it places as a tab, as double-clicking the same symbol in the pool does. That was already written and had never once run: the track captures the pointer for a slide, so the click and double-click that follow are delivered to the track and never to the block. The track now resolves them itself. Fixing the delivery exposed two more: `symbol/lineage` reported a `parent cycle` for any id in a symbol with NO nodes, because a one-element chain is longer than zero nodes — and opening a symbol left the selection pointing into the symbol being left, which the breadcrumb and the inspector then tried to resolve. The editor unmounted. Both are fixed where they were wrong, and the browser test asserts the editor is still standing afterwards. Audio is a clip in a lane like everything else. A dropped sound lands in one and is trimmed and moved by the same commands; a lane holds picture or sound and not both, which is the explicit capability the model asked for rather than a guess per frame. The refusal lives in the commands and not only in validation, because placement claims time: `blank` would have deleted the sound to make room for the picture and left a perfectly valid document behind. What is in a lane of the open symbol is drawn as a lane; what is nested inside a placed symbol is still flattened by `audio-tracks`, so no sound is on two rows. Everything that enters the timeline now enters a lane: a converted take, a symbol brought in from another project, a sound. One rule answers where — `lane-destination` — and every symbol is born with a lane for it to answer with. An unaimed drop fills an EMPTY lane rather than taking an occupied one nobody pointed at, because the alternative is trimming away what was there to make room for what was dropped. Shift during a clip-body drag means the other intention: put this node INSIDE the symbol the clip under the pointer places, through `nest/move-node`, which is what keeps the world transform and the root timing. Overlap cannot say which of the two is meant — dropping on occupied time already means claiming it — so the person says, and a label by the pointer says it back. The label asks `nest/move-refusal`, the same check the command makes, so it cannot promise what the drop would refuse. Today it refuses more than it allows: both clips have to be on screen at one frame, which two clips in one lane never are, and a held destination has no clock to move through at all. `docs/lane-nesting-notes.md` argues that the second refusal is stronger than the facts require and says what would settle it. Co-Authored-By: Claude Opus 5 --- docs/lane-handoff.md | 41 ++- docs/lane-nesting-notes.md | 59 +++- frontend/src/arthur/domain/clip.cljs | 23 +- frontend/src/arthur/domain/lane.cljs | 27 +- frontend/src/arthur/domain/nest.cljs | 48 ++- frontend/src/arthur/domain/symbol.cljs | 31 +- frontend/src/arthur/events/footage.cljs | 66 ++-- frontend/src/arthur/events/playback.cljs | 12 + frontend/src/arthur/events/project.cljs | 41 ++- frontend/src/arthur/events/ui.cljs | 136 +++++--- frontend/src/arthur/ui/drag.cljs | 9 +- frontend/src/arthur/ui/timeline.cljs | 320 +++++++++++++++--- frontend/test/arthur/domain/bring_test.cljs | 3 +- .../test/arthur/domain/instance_test.cljs | 6 +- frontend/test/arthur/domain/lane_test.cljs | 47 +++ frontend/test/arthur/domain/nest_test.cljs | 3 +- frontend/test/arthur/events/lane_test.cljs | 69 +++- frontend/test/browser/lane.mjs | 85 ++++- static/arthur/app.css | 25 ++ 19 files changed, 885 insertions(+), 166 deletions(-) diff --git a/docs/lane-handoff.md b/docs/lane-handoff.md index 21a409a..b164ed0 100644 --- a/docs/lane-handoff.md +++ b/docs/lane-handoff.md @@ -86,15 +86,40 @@ decision, not a cleanup. `{:refused why}`, never a half-applied edit. Where the model needs a choice nobody has made, refusing and saying why is the behaviour, not a placeholder. - **A clip is not a row.** Rows, expansion and selection are editor state. The - document has never known about rows and must not learn. + document has never known about rows and must not learn — which is what let + the row model change three times in one sitting (blocks, then a + selected-clip portal, then sound lanes under the audio heading) without + touching a single document. - **A lane is generic.** Drawing creation, library placement, and adopting an existing root instance all produce the same child instance shape. The only difference is playback policy: a new empty drawing holds source frame zero; a dropped library symbol plays at speed one. +- **Every symbol is born with a lane,** `clip/lane-node`, id `:lane`. A symbol + with none had nowhere to drop a thing, which made the first drop into any + symbol a special case. An unaimed drop fills an EMPTY lane that is already + there and otherwise makes a new one; it never takes an occupied lane nobody + pointed at, because placement claims time and would trim or delete what was + in it. - **Placement claims time.** Lanes never store overlaps. A new or extended clip trims, removes, or splits whatever previously owned the claimed interval. Real compositing overlap uses another lane, where ordering remains explicit. +## The timeline opens the whole document + +Expanding a lane opens exactly one clip — the selected one — and that portal +opens the lanes and nodes of the symbol it places, recursively, mapped into +the open symbol's ruler. The portal follows the LINEAGE of the selection, so +working on something nested keeps the rows that revealed it open. A held clip +opens too, with its rows marked `:unmapped?`: shown across the hold, with no +keys and no draggable edges, because a frozen clock gives its frames no place +on this ruler. `docs/lane-nesting-notes.md` has the reasoning and what is +still missing. + +Double-clicking a clip opens the symbol it places as a tab, the same as +double-clicking that symbol in the pool. Shift while dragging a clip body +turns the temporal move into a structural one — see the nesting notes for why +that is mostly refused today. + ## Current timeline interaction - Creating a symbol inside an aimed lane creates a one-frame held clip at the @@ -169,10 +194,16 @@ The implemented correction slice and its remaining UI limits are recorded in ## Known gaps and traps -- **Audio remains outside visual lanes.** `symbol/lane-problems` deliberately - requires symbol instances. Audio is still an independent root node that can - link to picture; making audio itself lane-based would need an explicit lane - capability rather than a mixed child rule. +- **Audio is a clip in a lane too, and a lane holds one kind.** A sound placed + from the pool lands in a lane and is moved and trimmed by the same commands + as picture. The capability the earlier note asked for is the homogeneity + rule rather than a field: `symbol/lane-problems` refuses a lane holding both + kinds, and `lane/place-symbol` and `lane/adopt` refuse BEFORE claiming time, + because placement claims time and would otherwise have deleted the sound to + make room for the picture and left a valid document behind. Audio nested + inside a placed symbol — a take's own sound — is still shown flattened by + `nest/audio-tracks`; what is in a lane of the open symbol is drawn as a lane + and not flattened twice. - **`:z` is required on cels and means nothing there.** A lane never has two cels on one frame, so draw order between them cannot matter. `node/problems` requires `:z` on every node uniformly, which is its own kind of simplicity — diff --git a/docs/lane-nesting-notes.md b/docs/lane-nesting-notes.md index 7adee9a..73d6ec0 100644 --- a/docs/lane-nesting-notes.md +++ b/docs/lane-nesting-notes.md @@ -105,12 +105,57 @@ derived portal, not another ownership edge and not a duplicated node. ## Implementation order -1. Render instance-level key ticks within lane clips. -2. Add selected-clip portal expansion to `timeline/rows` using the existing - recursive walk and root-time mapping. -3. Add the explicit structural grab affordance and clip/portal drop targets. -4. Route structural drops through `nest/move-node`; add browser coverage for a - root drawing moved into a clip in another lane without a visual jump. +1. ~~Render instance-level key ticks within lane clips.~~ Done: a clip's keys + are on its block, drawn after the blocks so they land on the one they + belong to. +2. ~~Add selected-clip portal expansion to `timeline/rows`.~~ Done, with two + additions the note did not anticipate: + - The portal is chosen by the whole LINEAGE of the selection, not the + selected id. Selecting a shape inside the clip, or the end of its span, + is still working inside that clip, and matching the id alone closed the + portal the moment anything under it was touched. + - A HELD clip opens too. `clip/source-time` is nil for a hold, so the walk + used to stop there and the inside of every drawing was unreachable from + the root timeline. Its rows are now shown across the hold and marked + `:unmapped?`: no keys, and no draggable edges, because no frame inside it + has a place on this ruler. +3. ~~Add the explicit structural affordance.~~ Done as SHIFT on a clip-body + drag rather than a separate grab handle: shift turns a temporal move into a + structural one, the target clip takes an inset highlight, and a label by the + pointer says which of the two is about to happen. +4. Route structural drops through `nest/move-node`. **Wired, and blocked in + the domain.** The gesture asks `nest/move-refusal` on the way past, so the + label says before the drop what the command would say after it. Two + refusals stand in the way of ordinary use: + - *both have to be on screen at this frame.* Inherent, and worth keeping: + the move preserves the world transform and there is no common frame to + preserve it at otherwise. It does mean nesting one clip into another in + the SAME lane can never work — a lane never overlaps itself — so this is + a between-lanes gesture with the playhead somewhere both are showing. + - *a held or looping clip has no clock to move through.* `nest/inside` + returns no `:time` for a hold, and a held one-frame drawing is the most + common thing in a document, so today nesting into one is refused — which + is most of what anybody would try. 5. After the transplant, expand the destination portal and reveal/select the - moved row. + moved row. `::ui/move-node` already selects the moved node and opens the + rows down to it; the portal follows from the lineage rule in 2. + +## The held destination, unresolved + +A held cel shows ONE source frame for its whole span, so there is no +invertible map from the lane's frames to the drawing's and `move-node` +refuses. But the refusal is stronger than the facts require. Inside a frozen +destination only one frame is ever observed, so: + +- the RATE of any map into it is unobservable — every rate shows frame `in`; +- what IS observable is that the moved node should show, at that one frame, + what it shows now at the current root frame. + +That pins a unique sensible answer — rate 1, aligned so the current frame maps +to the shown frame — and nothing else about the mapping can be seen. If that +argument holds, it is a rule rather than a guess, and it is the difference +between structural nesting working for drawings and not working at all. It +needs its own proof: a drawing authored at the root, nested into a held cel in +another lane, sampled before and after to show the same picture, in the style +of `drawn` in `lane_test`. diff --git a/frontend/src/arthur/domain/clip.cljs b/frontend/src/arthur/domain/clip.cljs index e4233a9..eeeafd8 100644 --- a/frontend/src/arthur/domain/clip.cljs +++ b/frontend/src/arthur/domain/clip.cljs @@ -149,11 +149,20 @@ which is long enough to key something into and short enough to scrub by hand." 120) -(defn blank - "A new, empty document: one empty symbol. +(def lane-node + "The lane every symbol is born with. - `:nodes` is empty rather than seeded with a layer, because an empty symbol is - a true statement and a layer nobody asked for is one more thing to delete. + EVERY SYMBOL HAS AT LEAST ONE LANE, because a lane is the only place + temporal content goes and a symbol with none has nowhere to drop a thing — + which made the first drop into any symbol a special case that had to invent + a lane before it could do what the second drop does. An empty lane is a true + statement about a symbol nobody has put anything in yet. The id is a keyword + rather than a uuid because this namespace is pure, and `:lane` reads in a + path; commands that add FURTHER lanes bring their own uuids." + {:id :lane :name "lane" :kind :group :layout :sequence :z "z-lane"}) + +(defn blank + "A new, empty document: one symbol, holding one empty lane. The tracking maps are ABSENT rather than empty, because `leaf/leaves` writes no leaf for an empty one and so cannot bring it back: a blank document that opened @@ -165,7 +174,8 @@ {:name "untitled" :fps 30 :width 320 :height 200 - :symbols {:main {:id :main :fps 30 :frames blank-frames :nodes {}}}}) + :symbols {:main {:id :main :fps 30 :frames blank-frames + :nodes {:lane lane-node}}}}) (defn- transform-op "Put a symbol's already resolved mark into its instance's parent space. Its @@ -410,7 +420,8 @@ (if (or (nil? end) (symbol clip sid) (nil? frame) (neg? frame) (>= frame end)) clip (-> clip - (assoc-in [:symbols sid] {:id sid :name (name sid) :fps (fps clip host) :frames (- end frame) :nodes {}}) + (assoc-in [:symbols sid] {:id sid :name (name sid) :fps (fps clip host) + :frames (- end frame) :nodes {:lane lane-node}}) (place-symbol nil host sid frame uuid nil))))) (defn free-id diff --git a/frontend/src/arthur/domain/lane.cljs b/frontend/src/arthur/domain/lane.cljs index d42134c..9a3366a 100644 --- a/frontend/src/arthur/domain/lane.cljs +++ b/frontend/src/arthur/domain/lane.cljs @@ -214,6 +214,17 @@ :z (symbol/z-between front nil)}) :selection id}))) +(defn- holds-other? + "Whether `lane-id` already holds clips that are not of `kind`. + + A lane holds picture or sound and not both, and the check belongs HERE + rather than only in validation: placement claims time, so a picture dropped + on a lane of sound would not be caught as a mixture — `blank` would have + deleted the sound to make room for it first, and the document would be + valid and the sound gone." + [nodes lane-id kind] + (boolean (some #(not= kind (:kind %)) (symbol/lane-clips nodes lane-id)))) + (defn place-symbol "Place arbitrary symbol `source-id` as a naturally playing clip in a lane. @@ -232,6 +243,8 @@ (first (node/placed-span n))))] (cond (not (node/lane? lane)) {:refused "select a lane"} + (holds-other? nodes lane-id :instance) + {:refused "that lane holds sound; a lane holds picture or sound, not both"} (contains? nodes id) {:refused "the new clip ID is already used"} (not (and (integer? at) (not (neg? at)))) {:refused "a position is a nonnegative whole lane frame"} @@ -252,10 +265,11 @@ (span/finish (:clip cleared) sid nodes id extent))))))) (defn adopt - "Move an existing visual instance into `lane-id` at lane frame `at`. - Its source, span, transforms, corrections, and identity come with it; the - destination interval is claimed with the same overwrite trimming as a pool - drop." + "Move an existing clip — a symbol instance or a sound — into `lane-id` at + lane frame `at`. Its source, span, transforms, corrections, and identity come + with it; the destination interval is claimed with the same overwrite trimming + as a pool drop. What a lane may not do is mix the two kinds, which + `symbol/lane-problems` is the judge of and `finish` enforces." [clip sid lane-id id at {:keys [extent remainder-id] :or {extent :keep}}] (let [nodes (get-in clip [:symbols sid :nodes]) lane (get nodes lane-id) @@ -264,7 +278,10 @@ duration (when (and lo hi) (- hi lo))] (cond (not (node/lane? lane)) {:refused "select a lane"} - (not= :instance (:kind n)) {:refused "only a symbol clip goes in a lane"} + (not (contains? #{:instance :audio} (:kind n))) + {:refused "only a symbol or sound clip goes in a lane"} + (holds-other? nodes lane-id (:kind n)) + {:refused "a lane holds picture or sound, not both"} (= lane-id (:parent n)) {:refused "this clip is already in that lane"} (not (and (integer? at) (not (neg? at)))) {:refused "a position is a nonnegative whole lane frame"} diff --git a/frontend/src/arthur/domain/nest.cljs b/frontend/src/arthur/domain/nest.cljs index 2363e51..7999ce0 100644 --- a/frontend/src/arthur/domain/nest.cljs +++ b/frontend/src/arthur/domain/nest.cljs @@ -273,6 +273,39 @@ (clip/update-symbol target update :nodes (fnil into {}) (map (juxt :id identity)) moved))})))) +(defn move-refusal + "Why `move-node` would refuse to move `from` into `to` at frame `f`, or nil. + + SAID BEFORE THE DROP, not after it. A drag that reparents has to tell the + person what it would do while they can still change their mind, and the only + honest source for that is the check the command itself makes. Hence one + function, asked by the gesture on the way past and by `move-node` on the way + in. + + The one that surprises: BOTH have to be on screen at this frame, because the + move keeps the picture and there is no common frame to keep it at otherwise. + Two clips in one lane never overlap, so nesting one into another there can + never be done — it is a thing to do between lanes, with the playhead + somewhere both of them are showing. + + The deeper refusals — generated parts, a stencil parted from what it clips — + belong to the transplant and are only known when it runs." + [clip store open from to f] + (let [here (inside clip store open (pop from) f) + there (inside clip store open to f) + n (get-in clip [:symbols (:sid here) :nodes (peek from)])] + (cond + (nil? n) "nothing to move" + (or (nil? here) (nil? there)) "both have to be on screen at this frame" + (nil? (:sid there)) "only a symbol can take it" + (not (and (:time here) (:time there))) + "a held or looping clip has no clock to move through" + (nil? (some-> there :matrix node/invert)) "the target is scaled to nothing" + (= (:sid here) (:sid there)) "it is already there" + (and (= :instance (:kind n)) + (some #(clip/contains-symbol? clip % (:sid there)) (node/sources n))) + "a symbol cannot go inside itself"))) + (defn move-node "Move the node at row path `from` — its last id is the node, the rest the instances down to where it lives — into the symbol placed by the instance at @@ -286,16 +319,11 @@ a (:time here) b (:time there) inv (some-> there :matrix node/invert)] - (cond - (nil? (get-in clip [:symbols (:sid here) :nodes (peek from)])) - {:refused "nothing to move"} - (or (nil? here) (nil? there)) {:refused "both have to be on screen at this frame"} - (nil? (:sid there)) {:refused "only a symbol can take it"} - (not (and a b)) {:refused "a looping instance is in the way"} - (nil? inv) {:refused "the target is scaled to nothing"} - :else (transplant clip store (:sid here) (:frame here) (peek from) (:sid there) - (node/mul! (node/mat) inv (:matrix here)) - (node/then-time (node/invert-time b) a))))) + (if-let [why (move-refusal clip store open from to f)] + {:refused why} + (transplant clip store (:sid here) (:frame here) (peek from) (:sid there) + (node/mul! (node/mat) inv (:matrix here)) + (node/then-time (node/invert-time b) a))))) (defn- down "Walk row path `path` down from symbol `sid` by structure alone: `{:sid diff --git a/frontend/src/arthur/domain/symbol.cljs b/frontend/src/arthur/domain/symbol.cljs index 1e909da..bd8783b 100644 --- a/frontend/src/arthur/domain/symbol.cljs +++ b/frontend/src/arthur/domain/symbol.cljs @@ -71,7 +71,13 @@ repeat cannot be longer than the number of nodes, so one step past that is proof of a loop and needs no bookkeeping. Caught rather than hung — a cycle is reachable from one bad `:node/set-parent`, and a hung tab is a far worse - diagnostic than a stack trace naming the nodes." + diagnostic than a stack trace naming the nodes. + + THE PROOF ONLY HOLDS FOR A NODE THIS SYMBOL HAS. An id that is not in `nodes` + contributes a step the count knows nothing about, and its lineage is just + itself; in an EMPTY symbol that one step used to be read as a loop, so asking + where a node of another symbol sits threw `parent cycle` instead of answering + that it sits nowhere." [nodes id] (let [up (fn [i] (when-let [p (:parent (get nodes i))] @@ -81,7 +87,7 @@ {:node i :parent p}))))) chain (into [] (comp (take-while some?) (take (inc (count nodes)))) (iterate up id))] - (when (> (count chain) (count nodes)) + (when (and (contains? nodes id) (> (count chain) (count nodes))) (throw (ex-info "parent cycle in symbol" {:node id :chain chain}))) chain)) @@ -147,10 +153,18 @@ the parent and stencil references, rather than wherever a command happens to build one. - Clips must be visual, finite and non-overlapping. An accidental overlap + Clips must be finite and non-overlapping. An accidental overlap is refused rather than resolved by draw order: two drawings exposed on one frame of one lane is a document nobody meant to write, and picking a winner - would hide it. Empty lanes are valid — a lane is made before it is filled." + would hide it. Empty lanes are valid — a lane is made before it is filled. + + A SOUND IS A CLIP TOO. A lane is the one temporal container, so audio sits in + one on the same terms as picture: its own frames in `:span`, where they land + in `:time`, and no overlap with its neighbours. What a lane may NOT hold is a + mixture, and that is the explicit capability the model wanted rather than a + per-frame guess: all picture or all sound, so what the lane does with the + frame it owns is answered by the lane and not by the clip that happens to be + under the playhead." [nodes] (vec (mapcat @@ -158,14 +172,17 @@ (when (node/lane? lane) (let [children (filter #(= id (:parent %)) (vals nodes)) valid? (fn [n] - (and (= :instance (:kind n)) + (and (contains? #{:instance :audio} (:kind n)) (empty? (node/problems n)) (:span n) (every? node/finite-number? (node/placed-span n)))) - intervals (sort-by first (map node/placed-span (filter valid? children)))] + kept (filter valid? children) + intervals (sort-by first (map node/placed-span kept))] (concat (for [n children :when (not (valid? n))] - (str "sequence " id " needs finite visual symbol clips: " (:id n))) + (str "sequence " id " needs finite symbol or sound clips: " (:id n))) + (when (< 1 (count (into #{} (map :kind) kept))) + [(str "lane " id " holds picture or sound, not both")]) (when (some (fn [[[_ b] [c _]]] (> b c)) (partition 2 1 intervals)) [(str "lane " id " has overlapping clips")]))))) nodes))) diff --git a/frontend/src/arthur/events/footage.cljs b/frontend/src/arthur/events/footage.cljs index 2966576..374b1bb 100644 --- a/frontend/src/arthur/events/footage.cljs +++ b/frontend/src/arthur/events/footage.cljs @@ -6,7 +6,9 @@ address of every block this produces." (:require [arthur.domain.bring :as bring] [arthur.domain.clip :as clip] + [arthur.domain.lane :as lane] [arthur.events.edit :as edit] + [arthur.events.ui :as ui] [arthur.events.playback :as pb] [arthur.flow.detect :as detect] [arthur.flow.ingest :as ingest] @@ -466,12 +468,13 @@ (rf/reg-event-db ::ask-convert - (fn [db [_ {:keys [frames label] :as footage} frame point]] + (fn [db [_ {:keys [frames label] :as footage} frame point target]] (assoc-in db [:ui :convert] (merge (select-keys footage [:id :label :frames :fps :video]) {:range [0 frames] :name (string/replace (str label) #"\.[^.]*$" "") - :host (get-in db [:ui :open]) :frame frame :point point})))) + :host (get-in db [:ui :open]) :frame frame :point point + :target target})))) (rf/reg-event-db ::convert-set @@ -494,28 +497,47 @@ (rf/reg-event-fx ::converted - (fn [{:keys [db]} [_ {{:keys [name host frame point range]} :request footage-id :footage-id} + ;; A TAKE IS A CLIP IN A LANE, like everything else that enters the timeline. + ;; It used to be placed straight into the open symbol as a row of its own, + ;; which was the one way to get temporal content that no lane owned. + (fn [{:keys [db]} [_ {{:keys [name frame point range target]} :request footage-id :footage-id} built]] - (let [uuid (random-uuid) + (let [entry (store/entry (:clip/current db)) + uuid (random-uuid) fps (get-in db [:clip :fps]) {:keys [clip sid tracked?]} - (bring/take (:clip (store/entry (:clip/current db))) (:clip built) - name footage-id range) + (bring/take (:clip entry) (:clip built) name footage-id range) + st (merge (:store entry) (:store built)) imported-frames (clip/output-frames clip sid) source-fps (get-in built [:clip :fps]) - db (edit/edit-entry - db - #(cond-> (bring/placed % clip (:store built) sid host frame uuid point) - tracked? (merge (select-keys built [:footage-id :source-blocks - :source-inputs]))))] - {:db (-> db - (update :ui dissoc :convert) - (assoc-in [:ui :selection] [:node host uuid [uuid]]) - (update :footage merge - {:loading? false - :status (str "made " name " · " imported-frames " frames at " fps " fps" - (when (not= fps source-fps) - (str " · sampled from " source-fps " fps")) - (when-not tracked? - " · as drawings: this project already tracks other footage"))})) - :dispatch [::pb/refresh-clock]}))) + where (ui/lane-destination db clip st frame target :picture) + result (if (:refused where) + where + (lane/place-symbol (:clip where) st (:sid where) (:lane-id where) + uuid sid (:at where) + {:extent :grow-symbol :point point + :remainder-id (random-uuid)}))] + (if-let [why (or (:refused where) (:refused result))] + {:db (-> db + (update :ui dissoc :convert) + (update :footage merge {:loading? false :status why}))} + (let [db (edit/edit-entry + db + #(cond-> (assoc % :clip (:clip result) :store st) + tracked? (merge (select-keys built [:footage-id :source-blocks + :source-inputs]))))] + {:db (-> db + (update :ui dissoc :convert) + (cond-> (:made? where) + (assoc-in [:ui :target] {:sid (:sid where) :id (:lane-id where) + :path [(:lane-id where)]})) + (assoc-in [:ui :selection] + [:node (:sid where) uuid (conj (vec (:path where)) uuid)]) + (update :footage merge + {:loading? false + :status (str "made " name " · " imported-frames " frames at " fps " fps" + (when (not= fps source-fps) + (str " · sampled from " source-fps " fps")) + (when-not tracked? + " · as drawings: this project already tracks other footage"))})) + :dispatch [::pb/refresh-clock]}))))) diff --git a/frontend/src/arthur/events/playback.cljs b/frontend/src/arthur/events/playback.cljs index c79e5e2..ce74ca5 100644 --- a/frontend/src/arthur/events/playback.cljs +++ b/frontend/src/arthur/events/playback.cljs @@ -190,6 +190,18 @@ {:db (-> db (update-in [:ui :tabs] #(if (some #{sid} %) % (conj (vec %) sid))) (assoc-in [:ui :open] sid) + ;; WHAT WAS SELECTED IS NOT IN HERE. A node selection and an + ;; aimed target are paths in the symbol being left, and every + ;; bar that reads one — the breadcrumb, the inspector, where a + ;; new symbol would land — reads it against the open one. So + ;; opening a symbol arrives with nothing selected, which is the + ;; state the root crumb already means. A `[:symbol _]` + ;; selection names a symbol rather than a place inside one and + ;; survives. + (update :ui (fn [ui] + (cond-> (dissoc ui :target) + (= :node (first (:selection ui))) + (dissoc :selection)))) (update-in [:ui :trace :faces] #(trace/showing-for clip sid %)) (assoc-in [:playback :frame] 0) (assoc-in [:playback :playing?] false)) diff --git a/frontend/src/arthur/events/project.cljs b/frontend/src/arthur/events/project.cljs index ab6b630..9bab3fd 100644 --- a/frontend/src/arthur/events/project.cljs +++ b/frontend/src/arthur/events/project.cljs @@ -34,6 +34,8 @@ [arthur.domain.wire :as wire] [arthur.events.footage :as footage] [arthur.events.playback :as pb] + [arthur.events.ui :as ui] + [arthur.domain.lane :as lane] [arthur.footage.store :as store] [arthur.flow.address :as address] [arthur.flow.ingest :as ingest] @@ -153,26 +155,41 @@ ::import ;; A symbol out of another saved project, dropped at `frame` of the open symbol ;; and, from the stage, with its middle on `point`. - (fn [{:keys [db]} [_ carried frame point]] + (fn [{:keys [db]} [_ carried frame point target]] {:db (update db :project merge {:status (str "fetching " (:label carried) "…")}) ::import! (assoc (select-keys carried [:project :cid :symbol :label]) - :host (get-in db [:ui :open]) :frame frame :point point)})) + :host (get-in db [:ui :open]) :frame frame :point point + :target target)})) (rf/reg-event-fx ::imported ;; As drawing: its tracking stays with the analysis that measured it. See ;; `arthur.domain.bring`. - (fn [{:keys [db]} [_ {:keys [symbol host frame point label]} other]] - (let [sid (leaf/unsegment symbol) + (fn [{:keys [db]} [_ {:keys [symbol frame point label target]} other]] + (let [entry (store/entry (:clip/current db)) + sid (leaf/unsegment symbol) uuid (random-uuid) - {:keys [clip ids]} (bring/symbols (:clip (store/entry (:clip/current db))) - (:clip other) [sid] {}) - db (edit/edit-entry db #(bring/placed % clip (:store other) (ids sid) - host frame uuid point))] - {:db (-> db - (assoc-in [:ui :selection] [:node host uuid [uuid]]) - (update :project merge {:status (str "brought in " label)})) - :dispatch [::pb/refresh-clock]}))) + {:keys [clip ids]} (bring/symbols (:clip entry) (:clip other) [sid] {}) + st (merge (:store entry) (:store other)) + ;; A symbol from another project arrives as a clip in a lane, the same + ;; as one from this project's pool. + where (ui/lane-destination db clip st frame target :picture) + result (if (:refused where) + where + (lane/place-symbol (:clip where) st (:sid where) (:lane-id where) + uuid (ids sid) (:at where) + {:extent :grow-symbol :point point + :remainder-id (random-uuid)}))] + (if-let [why (or (:refused where) (:refused result))] + {:db (update db :project merge {:status why})} + {:db (-> (edit/edit-entry db #(assoc % :clip (:clip result) :store st)) + (cond-> (:made? where) + (assoc-in [:ui :target] {:sid (:sid where) :id (:lane-id where) + :path [(:lane-id where)]})) + (assoc-in [:ui :selection] + [:node (:sid where) uuid (conj (vec (:path where)) uuid)]) + (update :project merge {:status (str "brought in " label)})) + :dispatch [::pb/refresh-clock]})))) (defn- clip-payload "One clip of a save. With `base` — the seq the open document last caught up diff --git a/frontend/src/arthur/events/ui.cljs b/frontend/src/arthur/events/ui.cljs index 36fc239..fc44f4e 100644 --- a/frontend/src/arthur/events/ui.cljs +++ b/frontend/src/arthur/events/ui.cljs @@ -108,6 +108,20 @@ n))) +(defn empty-lane + "The id of a lane of `sid` that has nothing in it, or nil. + + EVERY SYMBOL IS BORN WITH A LANE, so the first thing put into one goes + there instead of beside it. An OCCUPIED lane is never chosen this way: + placing claims time, so taking a lane nobody pointed at would trim or delete + what was already in it. That is a fine thing to ask for and not a fine thing + to assume." + [document sid] + (let [nodes (get-in document [:symbols sid :nodes])] + (first (keep (fn [lane] + (when (empty? (symbol/lane-clips nodes (:id lane))) (:id lane))) + (symbol/lanes nodes))))) + (defn apply-lane-command "Commit a successful domain command as one history step. A refused command leaves the document and history untouched; an overflow offers an explicit retry." @@ -608,7 +622,9 @@ (if-not host (update db :project merge {:status "what you are adding to is not on screen at this frame"}) - (let [prepared (lane/add-lane clip host lane-id) + (let [free (empty-lane clip host) + lane-id (or free lane-id) + prepared (if free {:clip clip} (lane/add-lane clip host lane-id)) result (if (:refused prepared) prepared (lane/overwrite-drawing (:clip prepared) host lane-id cel-id drawing-id frame @@ -643,6 +659,60 @@ ::drop-clear (fn [db _] (update db :ui dissoc :drop))) +(defn lane-destination + "Where a drop lands: the lane it was aimed at, the selected one, or a new one. + + EVERYTHING IN THE TIMELINE IS A LANE, so this is the one rule and every drop + asks it — a symbol from the pool, a sound, and a video brought in as a take + alike. It answers `{:clip :sid :lane-id :at :made?}` with the lane already + created in `:clip` when it had to make one, or `{:refused why}`. + + `kind` is what is about to go in, `:picture` or `:sound`: a lane holds one or + the other, so an aimed lane that holds the other kind is not the destination + and a new one is made beside it." + [db document st frame target kind] + (let [open (get-in db [:ui :open]) + selected (get-in db [:ui :selection]) + [_ sel-sid sel-id] selected + holds (fn [[_ sid id]] + (let [nodes (get-in document [:symbols sid :nodes])] + (when (node/lane? (get nodes id)) + (let [kinds (into #{} (map :kind) (symbol/lane-clips nodes id))] + (or (empty? kinds) + (= kinds #{(if (= :sound kind) :audio :instance)})))))) + ;; With nothing aimed, an empty lane that is already there — see + ;; `empty-lane` — and only then a new one. + free (when-let [id (empty-lane document open)] + (when (holds [:node open id]) [:node open id [id]])) + aimed (or (when (and target (holds target)) target) + (when (and (= :node (first selected)) (holds selected)) selected) + free) + [_ aimed-sid aimed-id aimed-path] aimed + sid (if aimed aimed-sid open) + lane-id (if aimed aimed-id (random-uuid)) + prepared (if aimed {:clip document} (lane/add-lane document sid lane-id)) + lane-sel [:node sid lane-id (if aimed aimed-path [lane-id])] + owner (when-not (:refused prepared) + (selection-frame (:clip prepared) st open lane-sel frame)) + at (when (number? owner) + (lane/lane-frame (:clip prepared) sid lane-id owner))] + (cond + (:refused prepared) prepared + (not (integer? at)) {:refused "the drop is not on one frame of this lane"} + :else {:clip (:clip prepared) :sid sid :lane-id lane-id :at at + :path (vec (butlast (nth lane-sel 3))) :made? (nil? aimed)}))) + +(defn landed + "`db` after a drop that produced `result`, with `uuid` selected in `lane`." + [db {:keys [sid lane-id path made?]} uuid result] + (if-let [why (:refused result)] + (-> db (update :ui dissoc :drop) (update :project merge {:status why})) + (cond-> (-> db + (update :ui dissoc :drop) + (edit/transaction (constantly (:clip result))) + (assoc-in [:ui :selection] [:node sid uuid (conj (vec path) uuid)])) + made? (assoc-in [:ui :target] {:sid sid :id lane-id :path [lane-id]})))) + (rf/reg-event-db ::drop-symbol ;; A symbol dropped on a lane becomes a naturally playing clip in that lane. @@ -650,47 +720,35 @@ ;; never invents another permanent row-per-symbol track. (fn [db [_ source-id frame point target]] (let [{document :clip st :store} (store/entry (:clip/current db)) - open (get-in db [:ui :open]) - selected (get-in db [:ui :selection]) - [_ selected-sid selected-id] selected - selected-node (get-in document [:symbols selected-sid :nodes selected-id]) - target (or target (when (node/lane? selected-node) selected)) - [_ target-sid target-id target-path] target - target-node (get-in document [:symbols target-sid :nodes target-id]) - existing? (and (= :node (first target)) (node/lane? target-node)) - lane-id (if existing? target-id (random-uuid)) - sid (if existing? target-sid open) - prepared (if existing? {:clip document} - (lane/add-lane document sid lane-id)) - lane-selection [:node sid lane-id (if existing? target-path [lane-id])] - owner-frame (selection-frame (:clip prepared) st open lane-selection frame) - at (when (number? owner-frame) - (lane/lane-frame (:clip prepared) sid lane-id owner-frame)) - uuid (random-uuid) - result (if (integer? at) - (lane/place-symbol (:clip prepared) st sid lane-id uuid source-id at - {:extent :grow-symbol :point point - :remainder-id (random-uuid)}) - {:refused "the drop is not on one frame of this lane"}) - path (conj (vec (butlast (nth lane-selection 3))) uuid)] - (if-let [why (or (:refused prepared) (:refused result))] - (-> db (update :ui dissoc :drop) (update :project merge {:status why})) - (cond-> (-> db - (update :ui dissoc :drop) - (edit/transaction (constantly (:clip result))) - (assoc-in [:ui :selection] [:node sid uuid path])) - (not existing?) - (assoc-in [:ui :target] {:sid sid :id lane-id :path [lane-id]})))))) + where (lane-destination db document st frame target :picture) + uuid (random-uuid)] + (if (:refused where) + (-> db (update :ui dissoc :drop) (update :project merge {:status (:refused where)})) + (landed db where uuid + (lane/place-symbol (:clip where) st (:sid where) (:lane-id where) + uuid source-id (:at where) + {:extent :grow-symbol :point point + :remainder-id (random-uuid)})))))) (rf/reg-event-db ::drop-sound - (fn [db [_ {:keys [source label length rate]} frame]] - (let [uuid (random-uuid) - host (get-in db [:ui :open])] - (-> db - (update :ui dissoc :drop) - (edit/edit #(clip/place-sound % host source label length rate (* frame (:rate (clip/grid-time % host))) uuid)) - (assoc-in [:ui :selection] [:node host uuid [uuid]]))))) + ;; A SOUND IS A CLIP IN A LANE TOO. It is placed and then adopted rather than + ;; written straight into the lane, so one command owns where a sound's frames + ;; are — `clip/place-sound` — and one owns what claiming lane time means. + (fn [db [_ {:keys [source label length rate]} frame target]] + (let [{document :clip st :store} (store/entry (:clip/current db)) + where (lane-destination db document st frame target :sound) + uuid (random-uuid)] + (if (:refused where) + (-> db (update :ui dissoc :drop) (update :project merge {:status (:refused where)})) + (let [sid (:sid where) + seeded (clip/place-sound (:clip where) sid source label length rate + (* (:at where) + (:rate (clip/grid-time (:clip where) sid))) + uuid)] + (landed db where uuid + (lane/adopt seeded sid (:lane-id where) uuid (:at where) + {:extent :grow-symbol :remainder-id (random-uuid)}))))))) (rf/reg-event-db ::adopt-in-lane diff --git a/frontend/src/arthur/ui/drag.cljs b/frontend/src/arthur/ui/drag.cljs index 82a174b..3161c0f 100644 --- a/frontend/src/arthur/ui/drag.cljs +++ b/frontend/src/arthur/ui/drag.cljs @@ -112,10 +112,11 @@ (case kind :symbol (rf/dispatch [::ui/drop-symbol sid frame point target]) ;; Video is asked about before anything happens: which frames, and what - ;; the symbol they become is called. - :footage (rf/dispatch [::footage/ask-convert c frame point]) - :import (rf/dispatch [::project/import c frame point]) + ;; the symbol they become is called. The lane it was aimed at travels + ;; with the question, so the answer lands where the drop pointed. + :footage (rf/dispatch [::footage/ask-convert c frame point target]) + :import (rf/dispatch [::project/import c frame point target]) ;; Where it is dropped in time; a sound has no place in space. - :sound (rf/dispatch [::ui/drop-sound c frame]) + :sound (rf/dispatch [::ui/drop-sound c frame target]) nil)) (done!))) diff --git a/frontend/src/arthur/ui/timeline.cljs b/frontend/src/arthur/ui/timeline.cljs index b7b8a0e..4e9d114 100644 --- a/frontend/src/arthur/ui/timeline.cljs +++ b/frontend/src/arthur/ui/timeline.cljs @@ -94,9 +94,82 @@ (defn rows "The visible rows of symbol `sid`, outermost first. `expanded` is a set of row - paths." - [clip sid expanded] - (letfn [(walk [sid path depth ->open] + paths, and `chosen` is the selected row's PATH, which is what an expanded + lane opens as its portal. + + AN EXPANDED LANE OPENS ONE CLIP, NOT ALL OF THEM. A lane of twelve clips that + grew twelve branches when it opened is the vertical growth the single-row + lane exists to prevent, so expanding a lane reveals exactly the clip that is + selected in it: its own keys, and — expanded in turn — the lanes and nodes of + the symbol it places, all the way down and all mapped into this ruler. + Selecting another clip swaps the portal in place rather than adding to it, so + the whole document stays editable from the root timeline at constant cost. + See `docs/lane-nesting-notes.md`. + + THE WHOLE LINEAGE CHOOSES THE PORTAL, not the selected node alone. Selecting + something nested — a shape inside the drawing the clip places, or the end of + its span — is still working inside that clip, so the portal that revealed it + must stay open. A lane therefore opens the clip whose path the selection is + under, which for a clip selected directly is the clip itself." + ([clip sid expanded] (rows clip sid expanded nil)) + ([clip sid expanded chosen] + (let [under? (fn [path] + (and chosen + (<= (count path) (count chosen)) + (= path (subvec (vec chosen) 0 (count path)))))] + (letfn [(inside-rows [sid n path depth self span] + ;; The rows of the symbol a clip places, mapped into this ruler. + ;; + ;; A HELD CLIP HAS NO INVERTIBLE CLOCK. `clip/source-time` is nil + ;; for a hold, a loop and an endpoint policy: one source frame is + ;; shown for the whole span, so no frame inside it has a place on + ;; this ruler. That used to mean the contents were not shown at + ;; all, which hid the inside of every drawing — the most ordinary + ;; thing in the document. So the structure is shown and stays + ;; selectable, and what is withheld is only what cannot be known: + ;; the key positions, and the bars that would imply them. Refuse + ;; rather than guess, without refusing the whole subtree. + (when-let [source (and (= :instance (:kind n)) (node/source n))] + (if-let [{:keys [at rate]} (clip/source-time clip sid n)] + (walk source path depth (comp self #(+ at (/ % rate)))) + (mapv (fn [row] + (-> row + (assoc :keys [] :unmapped? true) + (assoc :span (when (= :node (:kind row)) span)))) + (walk source path depth (constantly (first span))))))) + (portal [sid path depth self child] + ;; `self` maps the LANE's frames into the open symbol's; `child` is + ;; the clip selected in that lane, whose own frames are one more + ;; step in. Its row carries the clip's path — the same one its + ;; block in the lane selects with — so expanding here and selecting + ;; there are the same place. + (let [cpath (conj path (:id child)) + open? (contains? expanded cpath) + channels (node/channels child) + cself (comp self (local->parent child)) + cspan (mapv self (node/placed-span child)) + row {:path cpath + :depth depth + :label (node-label (:id child) child) + :kind :node + :node-kind (:kind child) + :of (node/source child) + :portal? true + :select [:node sid (:id child) cpath] + :expandable? true + :expanded? open? + :span cspan + :keys (into [] (comp (mapcat keyed-frames) + (map cself) + (distinct)) + (vals channels)) + :dense? (boolean (some :dense (vals channels)))}] + (if-not open? + [row] + (-> [row] + (into (channel-rows child cpath (inc depth) cself cspan)) + (into (inside-rows sid child cpath (inc depth) cself cspan)))))) + (walk [sid path depth ->open] (let [sym (get-in clip [:symbols sid]) ordered (->> (:nodes sym) ;; Front-most at the top, as a layer list is drawn @@ -153,7 +226,16 @@ ;; is shared. (if (node/lane? (get-in sym [:nodes (:parent n)])) [] - (let [row (cond-> row + (let [clips (when (node/lane? n) + (symbol/lane-clips (:nodes sym) id)) + ;; A lane of sounds is a lane like any other — + ;; same blocks, same edges, same portal — and + ;; is listed under the audio heading because + ;; that is where somebody looks for a sound, + ;; not because it is a different kind of row. + sound-lane? (and (seq clips) + (every? #(= :audio (:kind %)) clips)) + row (cond-> row (node/lane? n) (assoc :cels (mapv (fn [child] @@ -162,27 +244,54 @@ (some-> (node/source child) name)) :source (node/source child) :span (mapv self (node/placed-span child)) + ;; The clip's own keys, on the + ;; block, so a collapsed lane + ;; still says where it changes. + :keys (into [] + (comp (mapcat keyed-frames) + (map (comp self (local->parent child))) + (distinct)) + (vals (node/channels child))) :select [:node sid (:id child) (conj path (:id child))]}) - (symbol/lane-clips (:nodes sym) id))))] - (if-not open? - [row] - (-> [row] - (into (channel-rows n rpath (inc depth) self span)) - (into (when-let [{:keys [at rate]} (and (= :instance (:kind n)) - (clip/source-time clip sid n))] - (when-let [child (node/source n)] - (walk child rpath (inc depth) - (comp self #(+ at (/ % rate))))))))))))) + clips)))] + (cond->> (if-not open? + [row] + (-> [row] + (into (channel-rows n rpath (inc depth) self span)) + ;; The one clip an expanded lane opens. + (into (when (node/lane? n) + (if-let [child (first (filter #(under? (conj path (:id %))) clips))] + (portal sid path (inc depth) self child) + [{:path (conj rpath ::portal) + :depth (inc depth) + :kind :hint + :label (if (seq clips) + "select a clip to inspect" + "empty lane")}]))) + (into (inside-rows sid n rpath (inc depth) self span)))) + sound-lane? (mapv #(assoc % :sound? true))))))) ordered))))] (if (get-in clip [:symbols sid]) (walk sid [] 0 #(/ % (:rate (clip/grid-time clip sid)))) - []))) + []))))) (defn sound-rows "Audio rows use the same flattened intervals as the mixer, including source - in-points, cel speeds, parent timing, and silence beneath visual holds." + in-points, cel speeds, parent timing, and silence beneath visual holds. + + WHAT IS IN A LANE OF THIS SYMBOL IS NOT FLATTENED HERE. A sound in a lane is + a clip somebody placed and can move, trim and open, and `rows` draws it as + one; flattening it as well would show the same sound on two rows, only one of + which could be edited. What remains is what this view is for: audio nested + inside the symbols this one places, mapped into this ruler." [clip sid expanded] (if-not (get-in clip [:symbols sid]) [] + (let [nodes (get-in clip [:symbols sid :nodes]) + in-lane (into #{} (keep (fn [[id n]] + (when (and (= :audio (:kind n)) + (node/lane? (get nodes (:parent n)))) + id))) + nodes)] (vec (mapcat (fn [[path tracks]] @@ -203,7 +312,11 @@ :span (node/placed-span track) :select select}) (range) tracks))) (when open? (channel-rows n path 1 identity span))))) - (sort-by (comp str key) (group-by :path (nest/audio-tracks clip sid))))))) + (sort-by (comp str key) + (group-by :path + (remove #(and (= 1 (count (:path %))) + (contains? in-lane (first (:path %)))) + (nest/audio-tracks clip sid))))))))) ;; --------------------------------------------------------------------------- ;; geometry @@ -235,6 +348,19 @@ [track selection]))) (array-seq (.elementsFromPoint js/document (.-clientX event) (.-clientY event))))) +(defn- clip-under + "What the clip block under the pointer places, or nil where there is none. + + The track holds the pointer while a bar slides, and a captured pointer takes + the CLICK with it: press a clip block and the click and double-click that + follow are delivered to the track, never to the block. So the track resolves + them itself, by asking what is geometrically under the pointer." + [^js event] + (some (fn [^js el] + (when-let [cel (.closest el ".tl-cel")] + (aget cel "arthurCel"))) + (array-seq (.elementsFromPoint js/document (.-clientX event) (.-clientY event))))) + ;; --------------------------------------------------------------------------- ;; the panes @@ -496,24 +622,64 @@ "`sliding` is the pointer's side of a bar being dragged, `{:path :x :width :df}`. What it looks like mid-drag is `[:ui :sliding]`, which the clip every row and the stage are drawn from already has in it." - [{:keys [path span keys dense? kind node-kind select slides cels lane?]} frames sliding] + [{:keys [path span keys dense? kind node-kind select slides cels lane? of unmapped?]} + frames sliding hint {:keys [clip store open frame]}] (let [active-row (:row @sliding) slide (fn [^js e] (let [{from :row x0 :x width :width} @sliding] (when (= path from) (let [df (js/Math.round (/ (* frames (- (.-clientX e) x0)) (max 1 width))) drag (:drag @sliding) - [target-el target] (when drag (lane-under e)) + ;; TWO INTENTIONS, SAID BY A MODIFIER. An ordinary + ;; body drag moves a clip in TIME, within its lane + ;; or into another. Holding shift means something + ;; else entirely: put this node INSIDE the symbol + ;; the clip under the pointer places, keeping where + ;; it looks and when it happens. Overlap cannot say + ;; which is meant — dropping on occupied time + ;; already means claiming it — so the person says. + shift? (.-shiftKey e) + under (when (and drag shift?) (clip-under e)) + ;; Asked of the command itself, so the hint cannot + ;; promise what the drop would refuse. + why (when (and under (not= (:select under) (:selection drag))) + (nest/move-refusal clip store open + (nth (:selection drag) 3) + (nth (:select under) 3) + frame)) + nest (when (and under (nil? why) + (not= (:select under) (:selection drag))) + under) + [target-el target] (when (and drag (not shift?)) (lane-under e)) crossing? (and target (not= target (:source-lane drag))) target-frame (when crossing? (max 0 (- (frame-at-element e frames target-el) (:grab drag))))] - (if crossing? + (when (and drag hint) + (reset! hint + {:x (.-clientX e) :y (.-clientY e) + :nest? (boolean nest) + :no? (boolean why) + :text (cond + nest (str "nest into " (:label nest)) + why (str "can't nest here · " why) + shift? "shift: nest into a clip" + :else "drop to place · shift to nest")})) + (cond + nest (do - (swap! sliding assoc :target-lane target :target-frame target-frame) + (swap! sliding #(-> % (assoc :nest nest) + (dissoc :target-lane :target-frame))) (rf/dispatch [::ui/sliding nil])) + crossing? (do - (swap! sliding dissoc :target-lane :target-frame) + (swap! sliding #(-> % (assoc :target-lane target + :target-frame target-frame) + (dissoc :nest))) + (rf/dispatch [::ui/sliding nil])) + :else + (do + (swap! sliding dissoc :target-lane :target-frame :nest) (when (not= df (:df @sliding)) (swap! sliding assoc :df df) (rf/dispatch [::ui/sliding (:path @sliding) df @@ -521,21 +687,42 @@ (:other @sliding)])))))))) done (fn [commit?] (when (= path (:row @sliding)) - (let [{:keys [path df kind ripple? other target-lane target-frame drag]} @sliding] + (let [{:keys [path df kind ripple? other target-lane target-frame + drag nest on-click]} @sliding] (reset! sliding nil) + (when hint (reset! hint nil)) (cond + (and commit? nest drag) + (do (rf/dispatch [::ui/sliding nil]) + ;; `nest/move-node`, which is what keeps the world + ;; transform and the root timing across the move. + (rf/dispatch [::ui/move-node (nth (:selection drag) 3) + (nth (:select nest) 3)])) (and commit? target-lane drag) (do (rf/dispatch [::ui/sliding nil]) (rf/dispatch [::ui/adopt-in-lane (:selection drag) target-lane target-frame])) - commit? (rf/dispatch [::ui/slide path df kind ripple? other]) + commit? + ;; A press that moved nothing is a click, and a drag + ;; that only moved in time leaves what it moved + ;; selected. The two structural cases above select what + ;; they landed, so neither needs this. + (do (when on-click (rf/dispatch [::ui/select on-click])) + (rf/dispatch [::ui/slide path df kind ripple? other])) :else (rf/dispatch [::ui/sliding nil]))))) begin! (fn [^js e actual-path gesture-kind actual-select other drag] (let [track (.closest (.-currentTarget e) ".tl-track")] (.stopPropagation e) - (when actual-select (rf/dispatch [::ui/select actual-select])) + ;; SELECTING WAITS FOR THE RELEASE. Selecting on the press + ;; changed what the timeline was showing before the gesture + ;; had said anything: an expanded lane follows the + ;; selection, so pressing a clip to drag it somewhere shut + ;; the portal holding the lane being dragged INTO, out from + ;; under the pointer. The press now only starts the + ;; gesture; what it meant is known on release. (reset! sliding {:row path :path actual-path :kind gesture-kind :other other + :on-click actual-select :drag (when drag (assoc drag :source-lane select @@ -552,6 +739,15 @@ {:on-pointer-move slide :on-pointer-up (fn [e] (slide e) (done true)) :on-pointer-cancel (fn [_] (done false)) + ;; THE CLICK ARRIVES HERE, not on the block it started on, because the + ;; track captured the pointer. Opening what was double-clicked is + ;; therefore the track's job: the block under the pointer if there is + ;; one, else this row's own instance. It opens as a tab, which is what + ;; double-clicking the same symbol in the pool does. + :on-double-click (fn [^js e] + (when-let [source (or (:source (clip-under e)) of)] + (.stopPropagation e) + (rf/dispatch [::pb/open-symbol source]))) :ref (when lane? (fn [el] (when el (aset el "arthurLane" select)))) :on-drag-enter (fn [^js e] (when (and lane? (or (drag/accepts?) (drag/row))) @@ -580,15 +776,26 @@ ;; symbol still plays its own frames from 0, it is just cut off at the end. (when-let [[in out] (when (and span (nil? cels)) [(max 0 (first span)) (min frames (second span))])] (when (< in out) + ;; AN UNMAPPED BAR IS NOT DRAGGABLE. Inside a held clip a nested row + ;; is shown across the whole hold because that is when it is on + ;; screen, not because its frames are this ruler's: there is no + ;; mapping to edit through, so the bar selects and does not slide. [:div {:class (str "tl-span" (when dense? " dense") (when (= :ghost kind) " ghost") (when (= :audio node-kind) " sound") - (when select " movable") (when (= path active-row) " sliding")) + (when unmapped? " unmapped") + (when (and select (not unmapped?)) " movable") + (when (= path active-row) " sliding")) + :title (when unmapped? + "inside a held clip · its own frames have no place on this ruler") :style {:left (edge% in frames) :width (str (* 100 (/ (- out in) (max 1 frames))) "%")} + :on-click (when (and select unmapped?) + (fn [^js e] (.stopPropagation e) + (rf/dispatch [::ui/select select]))) :on-pointer-down - (when select + (when (and select (not unmapped?)) #(begin! % (or slides path) :slide select nil nil))} - (when select + (when (and select (not unmapped?)) [:span.tl-edge.out {:title "Drag endpoint · Shift-drag ripples later clips" :on-pointer-down #(begin! % path :out select nil nil)}])])) (doall @@ -607,22 +814,26 @@ :when (< in out)] ^{:key (str id)} [:button.tl-cel - {:title (str label " · select clip; double-click to edit its symbol") - :class (when ghost? "ghost") + {:title (str label " · select clip; double-click to edit its symbol" + " · shift-drag another clip onto it to nest that clip inside") + :class (str (when ghost? "ghost") + (when (and select (= select (get-in @sliding [:nest :select]))) + " nest-target")) :style {:position "absolute" :left (edge% in frames) :width (str (* 100 (/ (- out in) (max 1 frames))) "%") :top "2px" :bottom "2px" :overflow "visible" :padding "0 3px"} + ;; What this block is, for the track to read back: the click that + ;; selects it and the double-click that opens it are both delivered + ;; to the track, which holds the pointer. See `clip-under`. + :ref (when select + (fn [^js el] + (when el (aset el "arthurCel" {:select select :source source + :label label + :in (js/Math.floor in)})))) :on-pointer-down (when select #(begin! % (nth select 3) :slide select nil {:selection select :label label :in in - :duration (- out in)})) - :on-click (when select - (fn [e] (.stopPropagation e) - (rf/dispatch [::ui/select select]) - (rf/dispatch [::pb/seek (js/Math.floor in)]))) - :on-double-click (when select - (fn [e] (.stopPropagation e) - (when source (rf/dispatch [::pb/open-symbol source]))))} + :duration (- out in)}))} [:span.tl-cel-label label] (when select (if joined? @@ -645,22 +856,40 @@ :on-pointer-down #(begin! % (nth select 3) :out select nil nil)}])])) ;; A dense channel has a value on every frame, so ticking each one is a solid ;; block that says less than the bar behind it already does. + ;; The lane's own keys, and those of the clips on it drawn after the + ;; blocks so they land ON the block they belong to: a collapsed lane still + ;; says where the thing in it changes, without opening anything. (when-not dense? (doall - (for [f keys :when (and (<= 0 f) (< f frames))] + (for [f (distinct (concat keys (mapcat :keys cels))) + :when (and (<= 0 f) (< f frames))] ^{:key f} [:div.tl-key {:style {:left (at% f frames)}}])))])) +(defn- cursor-hint + "What the drag in flight would do, beside the pointer. + + ITS OWN COMPONENT, deref'ing its own atom: the pointer moves many times a + second and every row of the timeline reads `sliding`, so putting the pointer + position in there would repaint the whole pane to move a label two pixels." + [hint] + (when-let [{:keys [x y text nest? no?]} @hint] + [:div.tl-hint {:class (str (when nest? "nesting") (when no? "refusing")) + :style {:left (str (+ x 16) "px") :top (str (+ y 18) "px")}} + text])) + (defn- timeline-view [] (r/with-let [scrubbing (r/atom false) ;; The row a carried row is over and which part of it, for the ;; highlight. over (r/atom nil) sliding (r/atom nil) + hint (r/atom nil) renaming (r/atom nil) draft (r/atom "")] (let [clip @(rf/subscribe [::render/clip]) frames (max 1 (or @(rf/subscribe [::render/frames]) 1)) frame @(rf/subscribe [::playback/frame]) + store @(rf/subscribe [::render/store]) selection @(rf/subscribe [::sub/selection]) target @(rf/subscribe [::sub/target]) expanded @(rf/subscribe [::sub/expanded]) @@ -684,15 +913,18 @@ lane-ghost (when (and drop drop-lane (not (:sound? drop))) {:id ::drop :label (str "+ " (:label drop)) :ghost? true :span [(:frame drop) (+ (:frame drop) (or (:frames drop) 1))]}) - picture (cond->> (cond->> (rows clip open expanded) + chosen (when (= :node (first selection)) (nth selection 3)) + picture (cond->> (cond->> (rows clip open expanded chosen) lane-ghost (mapv (fn [row] (if (= drop-lane (:select row)) (update row :cels (fnil conj []) lane-ghost) row)))) (and ghost (not (:sound? drop))) (cons ghost)) - sounds (cond->> (sound-rows clip open expanded) + sounds (cond->> (into (vec (filter :sound? picture)) + (sound-rows clip open expanded)) (and ghost (:sound? drop)) (cons ghost)) + picture (remove :sound? picture) ;; The audio section's heading is a row like the others, so the two ;; columns stay aligned without measuring anything. visible (cond-> (vec picture) @@ -778,10 +1010,12 @@ (doall (for [row visible] (with-meta (if (= :section (:kind row)) [:div.tl-track.tl-section] - [track-cell row frames sliding]) + [track-cell row frames sliding hint + {:clip clip :store store :open open :frame frame}]) {:key (str (:path row))}))) [:div.tl-empty "nothing in this symbol"]) - [:div.tl-playhead {:style {:left (at% frame frames)}}]]]]))) + [:div.tl-playhead {:style {:left (at% frame frames)}}]]] + [cursor-hint hint]]))) (defn view [] [timeline-view]) diff --git a/frontend/test/arthur/domain/bring_test.cljs b/frontend/test/arthur/domain/bring_test.cljs index d0ddbcc..50cb809 100644 --- a/frontend/test/arthur/domain/bring_test.cljs +++ b/frontend/test/arthur/domain/bring_test.cljs @@ -22,6 +22,7 @@ (is (= {:main :take :inner :inner-2} ids) "the root gets the name asked for; a taken id gets the next free one") (is (= 10 (clip/frames clip :inner)) "what was already here is untouched") - (is (= #{:inner-2} (node/sources (first (vals (get-in clip [:symbols :take :nodes]))))) + (is (= #{:inner-2} (node/sources (first (filter #(= :instance (:kind %)) + (vals (get-in clip [:symbols :take :nodes])))))) "and the copy's instance follows its renamed symbol") (is (empty? (clip/problems clip))))) diff --git a/frontend/test/arthur/domain/instance_test.cljs b/frontend/test/arthur/domain/instance_test.cljs index 5f7572e..833d3c5 100644 --- a/frontend/test/arthur/domain/instance_test.cljs +++ b/frontend/test/arthur/domain/instance_test.cljs @@ -241,9 +241,11 @@ made (clip/new-symbol c :outer id 20 u)] (is (= :symbol-1 id)) (is (= :symbol-2 (clip/fresh-id made)) "the next one does not collide") - (is (= {:id :symbol-1 :name "symbol-1" :fps 30 :frames 180 :nodes {}} + (is (= {:id :symbol-1 :name "symbol-1" :fps 30 :frames 180 + :nodes {:lane clip/lane-node}} (clip/symbol made :symbol-1)) - "empty, and as long as the rest of what it was placed in") + "empty but for the lane every symbol is born with, and as long as the + rest of what it was placed in") (is (= {:span [0 180] :time {:mode :map :at 20 :rate 1}} (select-keys (get-in made [:symbols :outer :nodes u]) [:span :time]))) (is (= #{:symbol-1} (node/sources (get-in made [:symbols :outer :nodes u]))) diff --git a/frontend/test/arthur/domain/lane_test.cljs b/frontend/test/arthur/domain/lane_test.cljs index 5ee9f0a..36ecb9a 100644 --- a/frontend/test/arthur/domain/lane_test.cljs +++ b/frontend/test/arthur/domain/lane_test.cljs @@ -601,3 +601,50 @@ (is (= 12 (get-in (:clip (span/trim doc :main :insert :out 9)) [:symbols :main :frames])) "and trimming the last cel leaves the window where it was"))) + +(deftest a-take-placed-in-a-lane-is-still-heard + ;; `bring/take` puts a take's sound INSIDE the symbol it makes, so that + ;; "wherever the symbol is placed it is heard". A lane is one of the places it + ;; can be placed, and must not be the one place that goes silent. + (let [doc (assoc-in (document) [:symbols :take] + {:id :take :frames 10 :fps 24 + :nodes {:pic {:id :pic :kind :instance :z "a" + :source {:symbol :wave} :span [0 10] + :time {:mode :map :at 0 :rate 1} + :playback {:in 0 :speed 1 :end :stop}} + :sound {:id :sound :name "sound" :kind :audio + :parent nil :z "z-sound" + :source {:footage "f1"} :span [0 10] + :time {:mode :map :at 0 :rate 1}}}}) + at-root (clip/place-symbol doc nil :main :take 0 :root nil) + in-lane (:clip (lane/place-symbol doc nil :main :girl :drop :take 0 + {:extent :grow-symbol :remainder-id :tail}))] + (is (= 1 (count (nest/audio-tracks at-root :main))) + "a take placed at the root is heard") + (is (some? in-lane) "the take goes into the lane") + (is (= 1 (count (nest/audio-tracks in-lane :main))) + "and is still heard from inside a lane"))) + +(deftest a-sound-is-a-clip-in-a-lane-like-any-other + ;; Everything in the timeline is a lane, audio included: a sound claims lane + ;; time by the same rule, and what a lane will not do is hold both kinds. + (let [made (lane/add-lane (document) :main :track) + seeded (clip/place-sound (:clip made) :main {:sound "s1"} "voice" 6 1 2 :vo) + result (lane/adopt seeded :main :track :vo 2 {:extent :grow-symbol}) + after (:clip result) + n (get-in after [:symbols :main :nodes :vo])] + (is (nil? (:refused result)) (str (:refused result))) + (is (= :track (:parent n))) + (is (= [2 8] (node/placed-span n))) + (is (empty? (clip/problems after))) + (is (= 1 (count (nest/audio-tracks after :main))) + "a sound in a lane is still heard") + (is (= [:vo] (mapv :id (symbol/lane-clips (get-in after [:symbols :main :nodes]) :track)))) + ;; The one thing a lane refuses: being half picture and half sound, which + ;; is the explicit capability rather than a guess per frame. + (let [mixed (lane/place-symbol after nil :main :track :also :wave 2 + {:extent :grow-symbol :remainder-id :rest})] + (is (:refused mixed)) + (is (re-find #"picture or sound" (str (:refused mixed)))) + (is (= [:vo] (mapv :id (symbol/lane-clips (get-in after [:symbols :main :nodes]) :track))) + "and the sound it would have had to delete to make room is still there")))) diff --git a/frontend/test/arthur/domain/nest_test.cljs b/frontend/test/arthur/domain/nest_test.cljs index 52c27d8..4dd04d9 100644 --- a/frontend/test/arthur/domain/nest_test.cljs +++ b/frontend/test/arthur/domain/nest_test.cljs @@ -170,7 +170,8 @@ inst (get-in grouped [:symbols :main :nodes b-uuid])] (is (nil? (:refused r)) (:refused r)) (is (= #{:tri a-uuid} (set (keys (get-in grouped [:symbols :group-1 :nodes]))))) - (is (= [b-uuid] (keys (get-in grouped [:symbols :main :nodes]))) "one instance where they were") + (is (= [b-uuid] (keys (dissoc (get-in grouped [:symbols :main :nodes]) :lane))) + "one instance where they were") (is (= 4 (get-in inst [:time :at])) "starting where the earliest of them starts") (is (= 56 (clip/frames grouped :group-1)) "and lasting until the last one ends") (is (= (picture c :main fs) (picture grouped :main fs))) diff --git a/frontend/test/arthur/events/lane_test.cljs b/frontend/test/arthur/events/lane_test.cljs index 5008a1a..5f7feda 100644 --- a/frontend/test/arthur/events/lane_test.cljs +++ b/frontend/test/arthur/events/lane_test.cljs @@ -107,7 +107,10 @@ saved (:clip (store/entry (:clip/current after))) lanes (symbol/lanes (get-in saved [:symbols :main :nodes]))] (is (= :polygon (get-in after [:ui :tool]))) - (is (empty? lanes)) + (is (= [:lane] (mapv :id lanes)) + "the lane the symbol was born with, and no second one invented here") + (is (empty? (symbol/lane-clips (get-in saved [:symbols :main :nodes]) :lane)) + "and nothing put in it") (is (nil? (get-in after [:ui :target]))) (is (nil? (get-in (store/entry (:clip/current after)) [:history :done]))) (is (empty? (clip/problems saved))))) @@ -153,3 +156,67 @@ (let [refused (ui/apply-correction-command after {:refused "nope"})] (is (= "nope" (get-in refused [:project :status]))) (is (= 1 (count (get-in (store/entry id) [:history :done]))))))) + +(deftest an-expanded-lane-opens-the-selected-clip-and-everything-under-it + ;; The whole document is editable from the root timeline: a lane opens one + ;; portal — the clip selected in it — and that portal opens the lanes and + ;; nodes of the symbol it places, mapped into this ruler. + (let [doc (fixture/document) + open #{[:girl] [:insert]} + shut (timeline/rows doc :main open [:insert]) + of (fn [rows] (mapv (juxt :label :depth) rows)) + lane-row (first (filter :cels (timeline/rows doc :main open [:insert])))] + (is (= 1 (count (filter :portal? shut))) + "exactly one clip is opened, not one branch per clip in the lane") + (is (= [:insert] (:path (first (filter :portal? shut)))) + "and it is the selected one") + (is (some #{["mark" 2]} (of shut)) + "the clip's own symbol appears under it, at its depth") + (is (= [:node :main :insert [:insert]] + (:select (first (filter :portal? shut)))) + "the portal addresses the same clip its block in the lane does") + (is (= (:keys (second (:cels lane-row))) + (:keys (first (filter #(= [:b] (:path %)) (timeline/rows doc :main open [:b]))))) + "a clip's keys are on its block whether or not its portal is open"))) + +(deftest a-nested-selection-keeps-the-portal-that-revealed-it-open + ;; Clicking a shape inside the clip — or the end of its span — is still + ;; working inside that clip. Matching the selected id alone would close the + ;; portal the moment anything under it was touched. + (let [doc (fixture/document) + open #{[:girl] [:insert]} + deep (timeline/rows doc :main open [:insert :mark]) + none (timeline/rows doc :main open [:plate])] + (is (= [:insert] (:path (first (filter :portal? deep)))) + "a selection under the clip keeps that clip's portal") + (is (empty? (filter :portal? none))) + (is (some #{"select a clip to inspect"} (map :label none)) + "with nothing selected in it, an open lane says what it is waiting for"))) + +(deftest a-held-clip-shows-its-contents-without-inventing-frames-for-them + ;; `clip/source-time` is nil for a hold, so nested keys have no place on this + ;; ruler — but the drawing's own nodes must still be reachable from here. + (let [doc (fixture/document) + rows (timeline/rows doc :main #{[:girl] [:a]} [:a]) + inside (filter :unmapped? rows)] + (is (seq inside) "a held drawing opens") + (is (some #{"mark"} (map :label inside))) + (is (every? (comp empty? :keys) inside) + "no key is placed where the hold cannot say it belongs") + (is (= [[0 4]] (distinct (keep :span (filter #(= :node (:kind %)) inside)))) + "its rows span the hold, which is when it is on screen"))) + +(deftest a-lane-of-sounds-is-drawn-as-a-lane-and-not-flattened-twice + (let [made (lane/add-lane (fixture/document) :main :track) + seeded (clip/place-sound (:clip made) :main {:sound "s1"} "voice" 6 1 2 :vo) + doc (:clip (lane/adopt seeded :main :track :vo 2 {:extent :grow-symbol})) + picture (remove :sound? (timeline/rows doc :main #{} nil)) + sound-lanes (filter :sound? (timeline/rows doc :main #{} nil)) + flattened (timeline/sound-rows doc :main #{})] + (is (= 1 (count sound-lanes)) "the sound's lane is one row, like any lane") + (is (= [:vo] (mapv :id (:cels (first sound-lanes)))) + "with the sound on it as a block that can be moved and trimmed") + (is (empty? (filter #(= [:track] (:path %)) picture)) + "and it is not also listed among the picture rows") + (is (empty? flattened) + "nor flattened into a second, parallel audio row"))) diff --git a/frontend/test/browser/lane.mjs b/frontend/test/browser/lane.mjs index c9ba043..24e3038 100644 --- a/frontend/test/browser/lane.mjs +++ b/frontend/test/browser/lane.mjs @@ -160,6 +160,31 @@ try { }); await sleep(250); }; + const tabs = () => evaluate(`(() => { + const k = cljs.core.keyword, db = cljs.core.deref(re_frame.db.app_db); + return {tabs: cljs.core.clj__GT_js(cljs.core.get_in(db, [k('ui'), k('tabs')])).map(String), + open: String(cljs.core.clj__GT_js(cljs.core.get_in(db, [k('ui'), k('open')])))}; + })()`); + // A real two-press double-click, not `.dispatchEvent`: what broke here was + // where the browser decides to deliver the click, which a synthetic event + // cannot show. + const doubleClick = async selector => { + const p = await evaluate(`(() => { + const el = document.querySelector(${JSON.stringify(selector)}); + if (!el) return null; + const r = el.getBoundingClientRect(); + return {x: r.left + r.width / 2, y: r.top + r.height / 2}; + })()`); + assert(p, `something to double-click: ${selector}`); + for (const clickCount of [1, 2]) { + await send('Input.dispatchMouseEvent', {type: 'mousePressed', x: p.x, y: p.y, + button: 'left', buttons: 1, clickCount}); + await send('Input.dispatchMouseEvent', {type: 'mouseReleased', x: p.x, y: p.y, + button: 'left', buttons: 0, clickCount}); + await sleep(60); + } + await sleep(280); + }; const dropPoolSymbol = async frame => { const points = await evaluate(`(() => { const source = document.querySelector('.pool-row:not(.main) .pool-item[draggable="true"]'); @@ -301,8 +326,66 @@ try { const lanes = Object.values(s.clip.symbols.main.nodes).filter(n => n.layout === 'sequence'); assert.deepEqual(lanes.map(l => instances(s).filter(n => n.parent === l.id).length).sort(), [1, 3], 'a clip body can move from one lane to another'); + + // EXPANDING A LANE OPENS THE SELECTED CLIP. Its own keys, and under it the + // lanes and nodes of the symbol it places, all on this ruler — which is what + // makes the whole document editable from the root timeline. + const rowLabels = () => evaluate( + `[...document.querySelectorAll('.tl-labels > .tl-label')].map(e => e.textContent.trim())`); + const twist = async i => { + assert(await evaluate(`(() => { + const t = document.querySelectorAll('.tl-labels > .tl-label .tl-twist')[${i}]; + if (!t || t.disabled) return false; + t.click(); return true; + })()`), `an expander at row ${i}`); + await sleep(220); + }; + await evaluate(`(() => { document.querySelector('.tl-track .tl-cel').click(); return true })()`); + await sleep(200); + const collapsed = await rowLabels(); + await twist(0); + const opened = await rowLabels(); + assert(opened.length > collapsed.length, 'the lane opens'); + assert.equal(opened.filter(l => l.includes('instance')).length, 1, + `one clip portal, not one branch per clip: ${JSON.stringify(opened)}`); + const portalAt = opened.findIndex(l => l.includes('instance')); + await twist(portalAt); + const deep = await rowLabels(); + assert(deep.length > opened.length, + `the portal opens the symbol the clip places: ${JSON.stringify(deep)}`); + // Selecting something nested must not close the portal that revealed it. + await evaluate(`(() => { + const k = cljs.core.keyword, db = cljs.core.deref(re_frame.db.app_db); + const sel = cljs.core.get_in(db, [k('ui'), k('selection')]); + const path = cljs.core.nth(sel, 3); + re_frame.core.dispatch(cljs.core.vector( + k('arthur.events.ui/select'), + cljs.core.vector(k('node'), cljs.core.nth(sel, 1), cljs.core.nth(sel, 2), + cljs.core.conj(path, k('made-up-child'))))); + return true; + })()`); + await sleep(220); + assert.equal((await rowLabels()).filter(l => l.includes('instance')).length, 1, + 'a selection under the clip keeps its portal open'); + await twist(portalAt); + await twist(0); + + const before = await tabs(); + const tabChips = () => evaluate('document.querySelectorAll(".tabs .tab").length'); + const chipsBefore = await tabChips(); + await doubleClick('.tl-track .tl-cel'); + const after = await tabs(); + assert.equal(after.tabs.length, before.tabs.length + 1, + `double-clicking a clip opens the symbol it places, as the pool row does: ${JSON.stringify(after)}`); + assert(!before.tabs.includes(after.open) && after.tabs.includes(after.open), + `the opened symbol is the one in front: ${JSON.stringify(after)}`); + assert.equal(await tabChips(), chipsBefore + 1, + 'the opened symbol is drawn as one more tab'); + assert.equal(await evaluate('document.querySelectorAll("#app > *").length'), 1, + 'opening from the timeline leaves the editor standing: a stale node selection ' + + 'pointing into the symbol just left used to throw and unmount it'); assert.equal(errors.length, 0, JSON.stringify(errors)); - console.log('PASS: generic lanes preview, rename, move, place, trim, roll, and ripple clips'); + console.log('PASS: generic lanes preview, rename, move, place, open, trim, roll, and ripple clips'); } finally { if (ws?.readyState === WebSocket.OPEN) { ws.send(JSON.stringify({ id: 999999, method: 'Browser.close' })); diff --git a/static/arthur/app.css b/static/arthur/app.css index e608014..05db3d5 100644 --- a/static/arthur/app.css +++ b/static/arthur/app.css @@ -1271,3 +1271,28 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); } letter-spacing: 0.04px; } .paint-overlay:focus { outline: none; } + +/* What a drag in flight would do, beside the pointer: a clip body moves in + time, and with shift it goes inside the clip under the pointer. Said next to + the cursor because that is where the eye already is mid-gesture. */ +.tl-hint { + position: fixed; + z-index: 60; + padding: 2px 6px; + border-radius: 3px; + background: var(--fg); + color: var(--bg); + font-size: 11px; + white-space: nowrap; + pointer-events: none; +} +.tl-hint.nesting { background: var(--sel); color: #fff; } + +/* The clip a shift-drag would nest into. Inset, so it reads as "into this" + rather than as a boundary between rows. */ +.tl-cel.nest-target { outline: 2px solid var(--sel); outline-offset: -2px; } + +/* A row inside a held clip: shown because the node is on screen for the whole + hold, dimmed because its own frames have no place on this ruler. */ +.tl-span.unmapped { opacity: 0.45; cursor: pointer; } +.tl-hint.refusing { background: var(--bad, #b00); color: #fff; } From 10b96761fac881e7f551bb0165cd9f086bbd9558 Mon Sep 17 00:00:00 2001 From: Your Name Date: Thu, 1 Oct 2026 16:16:30 -0400 Subject: [PATCH 05/10] Plan: a lane is a view, not a thing in the document MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The lane model put a second container in the node map — a group with `:layout :sequence`, with its own membership, its own validation and its own fourteen commands — and every part of the editor then had to ask which kind of container it was looking at. The decision recorded here is to delete all of it: a lane becomes a way of DRAWING a symbol whose children are sequential and non-overlapping, the display goes back to a row per symbol, and the word survives only in the timeline and in the drag handling that re-spans a symbol's children while it is drawn that way. The commands are not the part being thrown away. `extend-hold`, `resize-out`, `roll`, `blank` and the rest are what endpoint dragging IS, and their arithmetic is right; what changes is their subject, from "the children of lane L in symbol S" to "the children of symbol S". They belong in `span.cljs`, which already owns re-spanning and `finish`. The plan takes a position on the one question that decides whether this is a simplification or a circle: lane mode is a saved hint on the symbol rather than unsaved view state, because the drag rules follow the mode, and a toggle the document does not record would make one gesture do two different things to it. Nothing outside the timeline may read the hint. It also lists what must not be lost on the way, all of which broke at least once today: a held clip's contents reachable with no keys and no draggable edges, double-click to open surviving the selection it leaves behind, selection waiting for pointer-up, no drop silently deleting what it lands on, and a sound drawn once. Co-Authored-By: Claude Opus 5 --- docs/lane-is-a-view-plan.md | 135 ++++++++++++++++++++++++++++++++++++ 1 file changed, 135 insertions(+) create mode 100644 docs/lane-is-a-view-plan.md diff --git a/docs/lane-is-a-view-plan.md b/docs/lane-is-a-view-plan.md new file mode 100644 index 0000000..5f2f899 --- /dev/null +++ b/docs/lane-is-a-view-plan.md @@ -0,0 +1,135 @@ +# A lane is a view + +Plan, 2026-10-01, written at `2dc5735`. It undoes the lane model as a thing in +the document and keeps what it was for. + +## The decision + +> A lane is a view over a symbol with sequential, non-overlapping children. + +Nothing in the document is a lane. There is no lane type, no lane group, no +`:layout :sequence`, no lane commands and no lane validation. The word +survives in exactly two places: the UI, where a symbol can be DRAWN as a lane, +and the drag handling that re-spans a symbol's children while it is being +drawn that way. + +The display model goes back to a row per symbol. A symbol in lane mode draws +its children as blocks on its own single row; expanded, they are rows like +anything else. Everything else is an ordinary row that expands into what it +places. + +## What a lane was, and what each part becomes + +| was | becomes | +| --- | --- | +| a group node with `:layout :sequence` | nothing — the symbol is the container | +| `node/lane?` | a view question: is this symbol drawn in lane mode | +| `symbol/lane-clips nodes lane-id` | the children of a symbol, sorted by `node/placed-span` | +| `symbol/lane-problems` | gone. Nothing enforces non-overlap; the drag that claims time produces it | +| `lane/lane-frame` | `clip/source-time` — one clock instead of two | +| `domain/lane.cljs` | re-based onto `domain/span.cljs`: re-spanning a symbol's children | +| `clip/lane-node`, the born-with lane | gone; a symbol is born empty again | +| `::ui/new-lane`, `::ui/adopt-in-lane`, lane renaming | gone, gone, and ordinary node renaming | + +`lane.cljs`'s fourteen commands are not deleted — they are what "endpoint drag +overlap handling" means, and they already do the right arithmetic. What +changes is their subject: every one of them currently takes a host symbol AND +a lane id and asks `lane-clips nodes lane-id`; each takes a symbol and asks +for its children. `extend-hold`, `resize-out`, `resize-in`, `roll`, `blank`, +`place-symbol`, `adopt`, `append-drawing`, `reuse-drawing`, +`duplicate-drawing`, `overwrite-drawing`, `make-unique`. `span/finish` is +already the one commit path and stays exactly as it is. + +Put them in `span.cljs`, which already owns "one write to one node's span" and +`finish`. The sequence operations are the same subject — re-spanning children +— and keeping them apart was a consequence of lanes existing. + +## Where lane mode lives + +A symbol is drawn as a lane because somebody said so, not because of what its +children happen to look like at this moment. Deriving it from "the children do +not currently overlap" means a symbol stops being a lane the moment a drag +makes two children overlap, and the rules that were maintaining non-overlap +switch off exactly when they are needed. + +Two options: + +1. **Editor state**, `[:ui :lane-mode #{sid}]`. Purest reading of "a lane is a + view". But the drag rules follow the mode, so an unsaved, per-person toggle + would decide whether dropping a symbol trims its neighbour or composites + over it — the same gesture doing two different things to the document + depending on something the document does not record. +2. **A display hint on the symbol**, e.g. `:display :lane`, saved like any + other field (`clip-keys`, `leaf/leaves`, `leaf/clip` in the same commit). + Still not a type: nothing in evaluation reads it, `symbol/problems` does + not check it, and a symbol with it set behaves identically on the stage. + +Recommended: 2. It is one field, it keeps editing rules reproducible between +people, and it does not make the symbol a different kind of thing. The thing +to hold the line on is that NOTHING outside the timeline and its drag handling +is allowed to read it. + +## Order of work + +Each step compiles, passes `npm test`, and leaves the editor usable. + +1. **Row per symbol.** In `ui/timeline.cljs`, delete `portal`, the `::portal` + hint row, the `under?` lineage predicate and the `chosen` argument; emit a + row for a clip whose parent is a lane instead of skipping it. Keep the + `:cels` blocks for the collapsed row, and keep `inside-rows` — including + its `:unmapped?` branch, which is what makes a held drawing's contents + reachable at all. +2. **Lane mode as a hint.** Add the field, draw a symbol's children as blocks + when it is set and as rows when it is not, and move the lane-row drag + handling onto it. Now both display paths exist and nothing in the domain + has changed yet. +3. **Re-base the commands.** Move `lane.cljs` into `span.cljs`, replacing + `(lane-clips nodes lane-id)` with the symbol's children and dropping the + `lane-id` argument. The tests in `frontend/test/arthur/domain/lane_test.cljs` + are the proof of this step: they should need their fixtures changed and + their assertions kept, and any assertion that has to change is a behaviour + change worth noticing. +4. **Delete the rest.** `node/lane?`, `symbol/lane-clips`, + `symbol/lane-problems`, `clip/lane-node`, `::ui/new-lane`, + `::ui/adopt-in-lane`, the lane branch of `::ui/new-symbol`, lane renaming, + `aimed-lane`, and the `:lane?`/`sound-lane?` row flags. Rename what is left + so the word does not appear outside the timeline. +5. **Audio falls out.** An audio node is already a parent-less child of a + symbol, which is exactly the new shape — so the audio-in-lane rules added + in `2dc5735` (`holds-other?`, the mixed-lane refusal, the `in-lane` filter + in `sound-rows`) delete rather than migrate. A symbol drawn as a lane whose + children are sounds is an audio lane, and that is the whole of it. +6. **Shift-to-reparent stays** as it is: `nest/move-node` and + `nest/move-refusal` never knew about lanes. + +## What must not be lost + +All of this was broken at some point today and is now proved; each has a test +to keep. + +- A held clip's contents are reachable from the root timeline, with no keys + and no draggable edges — `source-time` is nil for a hold, and the walk used + to stop there. +- Double-clicking a clip opens its symbol as a tab, and the editor survives + it: `symbol/lineage` must not report a cycle for an id the symbol does not + hold, and opening a symbol must drop a selection pointing into the one being + left. +- Selection waits for pointer-up, so a press does not re-draw the timeline out + from under the gesture it is starting. +- A drop never silently deletes what it lands on. +- A sound is drawn once, not twice. + +## Open questions + +1. **What happens to a symbol in lane mode whose children overlap anyway** — + through a reparent, a paste, or a document written before the mode existed? + Drawing it as rows is honest and loses the mode silently; drawing + overlapping blocks is a lie. Suggest: draw the blocks, and report it the + way `clip/conflicts` reports a correction nobody has resolved — a decision + waiting for a person, not a `problem`. +2. **Is lane mode a property of the symbol or of the instance placing it?** A + symbol placed twice would be drawn the same way in both places under the + first reading. That is probably right, and worth saying out loud. +3. **Does a lane row's edge drag trim the placing instance's span, or ripple + the children?** Same handle, two commands; the row is now an instance, so + it has a span of its own for the first time. From 6e7827e03fe974d0744c9ed041e2093427b65744 Mon Sep 17 00:00:00 2001 From: Your Name Date: Thu, 1 Oct 2026 16:22:33 -0400 Subject: [PATCH 06/10] Non-overlap is an invariant, not a report MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The plan asked what to draw when a symbol in lane mode holds overlapping children, and offered to report it as a decision waiting for a person. Wrong question: they never overlap. Placement claims time — anything placed, moved or grown over occupied time trims, removes or splits what it lands on — so the operation that could have made an overlap did not, and `span/finish`, which is already the single commit path and already refuses rather than half-applying, is where that is enforced. An overlap is then a bug in a command and not a state to design around. The check stays, named `symbol/overlaps` and used three ways: the commit path refuses one, a property test asserts no command can produce one, and a document that somehow holds one still LOADS and is drawn visibly wrong with the status saying so. Not `problems`, which stops a document loading, and not `conflicts`, which means somebody has a decision to make — a display hint must never be able to keep a document from opening. The one place a person can ask for the impossible is toggling lane mode on over children that already overlap. That refuses and offers to trim them into a sequence, through the `:required-frames` retry the model already uses. Also written down, because it is the pair the modifier exists to separate: a plain body drag is temporal and replaces, trimming extents as needed; shift is structural and goes through `nest/move-node` into the symbol under the pointer, which has to keep working for symbols held in a lane. Co-Authored-By: Claude Opus 5 --- docs/lane-is-a-view-plan.md | 114 ++++++++++++++++++++++++++---------- 1 file changed, 84 insertions(+), 30 deletions(-) diff --git a/docs/lane-is-a-view-plan.md b/docs/lane-is-a-view-plan.md index 5f2f899..72fc9fe 100644 --- a/docs/lane-is-a-view-plan.md +++ b/docs/lane-is-a-view-plan.md @@ -1,7 +1,8 @@ # A lane is a view Plan, 2026-10-01, written at `2dc5735`. It undoes the lane model as a thing in -the document and keeps what it was for. +the document and keeps what it was for. Build on what is there and tear out +half of it. ## The decision @@ -25,7 +26,7 @@ places. | a group node with `:layout :sequence` | nothing — the symbol is the container | | `node/lane?` | a view question: is this symbol drawn in lane mode | | `symbol/lane-clips nodes lane-id` | the children of a symbol, sorted by `node/placed-span` | -| `symbol/lane-problems` | gone. Nothing enforces non-overlap; the drag that claims time produces it | +| `symbol/lane-problems` | `symbol/overlaps`, a diagnostic the write path calls | | `lane/lane-frame` | `clip/source-time` — one clock instead of two | | `domain/lane.cljs` | re-based onto `domain/span.cljs`: re-spanning a symbol's children | | `clip/lane-node`, the born-with lane | gone; a symbol is born empty again | @@ -44,13 +45,66 @@ Put them in `span.cljs`, which already owns "one write to one node's span" and `finish`. The sequence operations are the same subject — re-spanning children — and keeping them apart was a consequence of lanes existing. +## Children in lane mode never overlap + +This is an invariant, not a condition to check for and report. Placement +claims time: anything placed, moved or grown over occupied time TRIMS the +extents it lands on — trimming the incumbent, removing one wholly covered, or +splitting one it lands inside — so the result has no overlap because the +operation that could have made one did not. That is `blank` followed by a +non-rippling placement, which is what `overwrite-drawing` already composes. + +Enforced at the boundary, which already exists: `span/finish` is the single +commit path for every one of these commands, it validates before it returns, +and it refuses rather than half-applying. So `finish` gains the overlap check +for a symbol in lane mode, and no command can commit one. An overlap that +appears anyway is a bug in a command, not a state to design around. + +Keep the check as a named diagnostic — `symbol/overlaps`, taking a symbol and +returning the pairs — used three ways: + +1. `span/finish` refuses when it would commit one. +2. The test suite asserts no command can produce one: a property over the + commands in the style of `drawn` in `lane_test`, which samples rather than + computing expected numbers by hand. +3. A document that somehow arrives holding one still LOADS — a display hint + must never be able to stop a document loading — and the timeline draws it + visibly wrong with the status line saying so. Not `clip/problems`, which + means the document will not load, and not `clip/conflicts`, which means a + person has a decision to make. This is neither: it is a bug report. + +Toggling lane mode ON for a symbol whose children already overlap is the one +place a person can ask for the impossible. Refuse it and say why, with the +`:required-frames` retry pattern offering to trim them into a sequence — the +domain reports what it would need, the UI offers one button. + +Outside lane mode nothing is enforced, because overlapping children are what +compositing IS. An endpoint drag there is an ordinary span edit that may +overlap; the claim-time rule follows the mode. + +## The two drag intentions + +Unchanged from `docs/lane-nesting-notes.md`, and both kept: + +- **Plain drag** of a clip body is temporal: it moves in time, within its + symbol or into another symbol drawn as a lane, and it REPLACES — trimming, + removing and splitting extents as needed so nothing overlaps. +- **Shift-drag** is structural: the dragged node goes INSIDE the symbol the + clip under the pointer places, through `nest/move-node`, which preserves the + world transform and the root timing. This must keep working for symbols + contained in a lane, which is the case it exists for. + +Overlap cannot distinguish them — dropping on occupied time already means +claiming it — so the modifier says which, and the label by the pointer says it +back. `nest/move-refusal` already answers before the drop. + ## Where lane mode lives A symbol is drawn as a lane because somebody said so, not because of what its children happen to look like at this moment. Deriving it from "the children do -not currently overlap" means a symbol stops being a lane the moment a drag -makes two children overlap, and the rules that were maintaining non-overlap -switch off exactly when they are needed. +not currently overlap" means a symbol stops being a lane the moment anything +overlaps, and the rules that maintain non-overlap switch off exactly when they +are needed. Two options: @@ -66,8 +120,8 @@ Two options: Recommended: 2. It is one field, it keeps editing rules reproducible between people, and it does not make the symbol a different kind of thing. The thing -to hold the line on is that NOTHING outside the timeline and its drag handling -is allowed to read it. +to hold the line on is that nothing outside the timeline, and the commit +path's overlap check, is allowed to read it. ## Order of work @@ -79,27 +133,29 @@ Each step compiles, passes `npm test`, and leaves the editor usable. `:cels` blocks for the collapsed row, and keep `inside-rows` — including its `:unmapped?` branch, which is what makes a held drawing's contents reachable at all. -2. **Lane mode as a hint.** Add the field, draw a symbol's children as blocks - when it is set and as rows when it is not, and move the lane-row drag - handling onto it. Now both display paths exist and nothing in the domain - has changed yet. +2. **Lane mode as a hint.** Add the field and the toggle, draw a symbol's + children as blocks when it is set and as rows when it is not, and move the + lane-row drag handling onto it. Both display paths now exist and nothing in + the domain has changed. 3. **Re-base the commands.** Move `lane.cljs` into `span.cljs`, replacing `(lane-clips nodes lane-id)` with the symbol's children and dropping the - `lane-id` argument. The tests in `frontend/test/arthur/domain/lane_test.cljs` - are the proof of this step: they should need their fixtures changed and - their assertions kept, and any assertion that has to change is a behaviour - change worth noticing. -4. **Delete the rest.** `node/lane?`, `symbol/lane-clips`, - `symbol/lane-problems`, `clip/lane-node`, `::ui/new-lane`, - `::ui/adopt-in-lane`, the lane branch of `::ui/new-symbol`, lane renaming, - `aimed-lane`, and the `:lane?`/`sound-lane?` row flags. Rename what is left - so the word does not appear outside the timeline. -5. **Audio falls out.** An audio node is already a parent-less child of a + `lane-id` argument. `frontend/test/arthur/domain/lane_test.cljs` is the + proof: its fixtures should change and its assertions should not, and any + assertion that has to change is a behaviour change worth noticing. +4. **Move the invariant.** `symbol/lane-problems` becomes `symbol/overlaps`, + called by `span/finish` for a symbol in lane mode, plus the property test + that no command can produce an overlap. +5. **Delete the rest.** `node/lane?`, `symbol/lane-clips`, `clip/lane-node`, + `::ui/new-lane`, `::ui/adopt-in-lane`, the lane branch of + `::ui/new-symbol`, lane renaming, `aimed-lane`, and the + `:lane?`/`sound-lane?` row flags. Rename what is left so the word does not + appear outside the timeline. +6. **Audio falls out.** An audio node is already a parent-less child of a symbol, which is exactly the new shape — so the audio-in-lane rules added in `2dc5735` (`holds-other?`, the mixed-lane refusal, the `in-lane` filter in `sound-rows`) delete rather than migrate. A symbol drawn as a lane whose children are sounds is an audio lane, and that is the whole of it. -6. **Shift-to-reparent stays** as it is: `nest/move-node` and +7. **Shift-to-reparent stays** as it is: `nest/move-node` and `nest/move-refusal` never knew about lanes. ## What must not be lost @@ -121,15 +177,13 @@ to keep. ## Open questions -1. **What happens to a symbol in lane mode whose children overlap anyway** — - through a reparent, a paste, or a document written before the mode existed? - Drawing it as rows is honest and loses the mode silently; drawing - overlapping blocks is a lie. Suggest: draw the blocks, and report it the - way `clip/conflicts` reports a correction nobody has resolved — a decision - waiting for a person, not a `problem`. -2. **Is lane mode a property of the symbol or of the instance placing it?** A +1. **Is lane mode a property of the symbol or of the instance placing it?** A symbol placed twice would be drawn the same way in both places under the first reading. That is probably right, and worth saying out loud. -3. **Does a lane row's edge drag trim the placing instance's span, or ripple +2. **Does a lane row's edge drag trim the placing instance's span, or ripple the children?** Same handle, two commands; the row is now an instance, so it has a span of its own for the first time. +3. **The held destination for shift-to-reparent** is still refused — + `nest/inside` has no invertible clock for a hold, which is most of what + anybody would try to nest into. `docs/lane-nesting-notes.md` argues the + refusal is stronger than the facts require and says what would settle it. From d029908f0b7a171ba51f21d255b304554eec1ca9 Mon Sep 17 00:00:00 2001 From: Your Name Date: Thu, 1 Oct 2026 16:31:06 -0400 Subject: [PATCH 07/10] A held cel is a one-frame symbol that loops MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Holding a drawing and looping a one-frame symbol are the same picture, and the second is a case the model already carries, so the first is a special case kept for nothing. Speed 0 goes; a cel becomes a one-frame symbol with `:end :loop` and a span. Looping and span are already properties of the instance and `:frames` already belongs to the symbol, so nothing moves — a mode is deleted. Two spellings of looping collapse to one, `:time :loop?` giving way to `:playback :end :loop`, and `extend-hold` collapses into `resize-out`, since it exists only to refuse anything that is not frozen before editing a span. What it buys is one rule where there were three refusals. `nest/inside` has no invertible clock for a hold, for `:end :hold`, or for a loop, so shift-to-reparent refuses all three — which is most of what anybody would drag onto. Resolving the move with the destination's map at the CURRENT frame covers every one: a loop is affine within the period the frame falls in, a one-frame loop is that rule with a period of one — which lands exactly where the nesting notes argued it should from first principles — and `:end :hold` is affine in the played part and frozen in the tail. The trap is written down beside it, because it would be found the hard way: `audio-tracks` expands a loop into one walk per period, and is saved today only by the `(pos? speed)` guard that a held cel fails. Make every drawing a loop and a drawing held for 120 frames becomes 120 walks emitting any nested sound 120 times. An audibility precheck has to land in the same change. Co-Authored-By: Claude Opus 5 --- docs/lane-is-a-view-plan.md | 85 +++++++++++++++++++++++++++++++++++-- 1 file changed, 81 insertions(+), 4 deletions(-) diff --git a/docs/lane-is-a-view-plan.md b/docs/lane-is-a-view-plan.md index 72fc9fe..7e5ebf4 100644 --- a/docs/lane-is-a-view-plan.md +++ b/docs/lane-is-a-view-plan.md @@ -123,6 +123,82 @@ people, and it does not make the symbol a different kind of thing. The thing to hold the line on is that nothing outside the timeline, and the commit path's overlap check, is allowed to read it. +## Tear out the held cel + +A held cel is a 1-frame symbol shown for many frames. A 1-frame symbol with +`:end :loop`, lengthened, is the same picture by a different route — and the +second route is a case the model already has, so keeping the first one is +keeping a special case for free. + +**What is already true**, so that nothing has to move: `:span` is on the node, +in its own frames; `:time` (`:at`, `:rate`) is on the node; looping is on the +node. The SYMBOL owns only `:frames`, the authored window. So looping and span +are instance properties already, and this change is about deleting a mode, not +relocating a field. + +**What has to be decided and collapsed:** + +- There are two spellings of looping — `:time :loop?` and `:playback :end + :loop` — and both are read, in `node/placed-frame` and in + `nest/audio-tracks`. Keep one. `:playback {:in :speed :end}` already says + what happens at the ends, so `:end :loop` is the one to keep and + `:time :loop?` is the one to delete. +- `:playback :speed 0` stops being produced. Make it illegal in + `node/problems` rather than legal-but-unused, so a frozen clock has exactly + one spelling: a 1-frame loop. +- `lane/extend-hold` exists only because holds were special — it refuses + anything whose speed is not 0 and then edits a span. Once a hold is a loop, + lengthening one IS `resize-out`, and the command collapses into it. +- `cel` survives as the word for the creation policy — a new empty symbol is + one frame — but stops naming a playback mode. + +**What it buys, and this is the point:** one rule for nesting, which settles +the refusal that blocks shift-to-reparent today. `nest/inside` currently has +no `:time` for a hold, for `:end :hold`, or for a loop, and so refuses all +three. The general rule that covers all of them: **resolve the move with the +destination's map at the CURRENT frame — the affine piece the current frame +falls in.** + +- A loop of length L is affine within the period the current frame is in. + Timing is preserved inside that period and repeats after it, which is what + looping means. +- A 1-frame loop — the ex-hold — has a period of length 1, so the map within + it is trivially invertible and lands the moved node on frame 0, aligned to + the current frame. That is exactly the answer `docs/lane-nesting-notes.md` + argues for from first principles, arrived at here as an instance of the + general rule instead of a special case. +- `:end :hold` is affine in the played part and frozen in the tail, which the + same sentence covers. + +**The trap, which must be handled in the same change.** `nest/audio-tracks` +expands a loop into one walk PER PERIOD: + + periods (range (floor (/ (to-local source lo) length)) + (ceil (/ (to-local source hi) length))) + +Today a held cel is skipped entirely — `(pos? speed)` is the guard, and the +comment says a visual freeze does not emit a sustained audio sample. Turn +every drawing into a 1-frame loop and that guard stops firing: a drawing held +for 120 frames becomes 120 recursive walks, and any sound inside it is emitted +120 times. That is both a wrong mix and a performance cliff on the most common +node in the document. Required with this change: a cheap `symbol/audible?` +precheck so a source with no audio anywhere inside it is never period-expanded, +and a cap or a different formulation for the ones that are. + +Also worth knowing before the change: `ui/timeline`'s own docstring already +says a looping instance draws only its first pass. With every drawing a loop, +that sentence now describes every drawing — harmless, since one pass of a +1-frame symbol is the whole of it, but the docstring should stop sounding like +a limitation. + +**Dropping into a 1-frame symbol.** The window is authored and crops what it +holds, so a 10-frame symbol dropped into a 1-frame drawing shows its frame 0 +and nothing else. That is consistent — `:frames` is the shot length and +`:extent :grow-symbol` is the opt-in — but it is probably not what somebody +dragging means. Offer the growth through the `:required-frames` retry the +model already uses: the command reports what it would need, the UI offers one +button. + ## Order of work Each step compiles, passes `npm test`, and leaves the editor usable. @@ -183,7 +259,8 @@ to keep. 2. **Does a lane row's edge drag trim the placing instance's span, or ripple the children?** Same handle, two commands; the row is now an instance, so it has a span of its own for the first time. -3. **The held destination for shift-to-reparent** is still refused — - `nest/inside` has no invertible clock for a hold, which is most of what - anybody would try to nest into. `docs/lane-nesting-notes.md` argues the - refusal is stronger than the facts require and says what would settle it. +3. **Does tearing out the held cel come before or after the lane work?** It + is independent of it — `nest` never knew about lanes — and it is what makes + shift-to-reparent work on the thing people would actually drag onto. Doing + it first means the lane work lands on a model with one playback mode fewer; + doing it after means two changes to `lane_test`'s fixtures instead of one. From fb3899009071612b3a14fa30e4a3fca6511e7fd5 Mon Sep 17 00:00:00 2001 From: Your Name Date: Thu, 1 Oct 2026 16:32:02 -0400 Subject: [PATCH 08/10] Loop is two things, and the one that matters is unreachable MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Loop playback — the transport repeating the open symbol — is editor state and the document has never heard of it. A looping INSTANCE is a node repeating the symbol it places, which is the four-frame tire turning for the hundred and twenty frames it is on screen, and it lives in the document as `:playback {:end :loop}`. Same word, two scopes; named apart here before anything is built on either. The status of the second one is the surprise: it already works and cannot be asked for. `node/placed-frame` does the modulo, `node/problems` already admits `:end :loop`, `audio-tracks` already expands the periods — and no control sets it anywhere in the UI. So the tire is three pieces of work, not one: somewhere to edit an instance's playback, a block that draws its repeats rather than only its first pass as the timeline's own docstring admits it does, and the audio period guard. This also pins down when the held cel can be torn out. Turning every drawing into a one-frame looping instance is only safe once a looping instance can be seen and edited; otherwise every drawing in the document quietly acquires a property with no control on it. Co-Authored-By: Claude Opus 5 --- docs/lane-is-a-view-plan.md | 41 ++++++++++++++++++++++++++++++++++--- 1 file changed, 38 insertions(+), 3 deletions(-) diff --git a/docs/lane-is-a-view-plan.md b/docs/lane-is-a-view-plan.md index 7e5ebf4..cc136d6 100644 --- a/docs/lane-is-a-view-plan.md +++ b/docs/lane-is-a-view-plan.md @@ -123,6 +123,37 @@ people, and it does not make the symbol a different kind of thing. The thing to hold the line on is that nothing outside the timeline, and the commit path's overlap check, is allowed to read it. +## Two things are called loop + +Before any of this, name them apart, in the way the vocabulary table in +`lane-handoff.md` names a cel apart from an exposure. + +- **Loop playback** is the transport repeating the open symbol while it plays. + It is `[:playback :loop?]` in app-db, the ⟳ button in the strip, and it is + EDITOR STATE. The document does not know about it. +- **A looping instance** is a node repeating the symbol it places: a four-frame + tire turning for the hundred and twenty frames the instance is on screen. + It is `:playback {:end :loop}` on the node, and it is in the DOCUMENT. + +The car tire is the second one, and here is its actual status: it already +works in the evaluator and cannot be asked for. `node/placed-frame` does the +modulo, `node/problems` already admits `:end` of `:stop`, `:hold` or `:loop`, +`nest/audio-tracks` already expands a loop into its periods — and nothing in +the UI sets it. It is implemented and unreachable. + +So three things are missing, and they are the work: + +1. **A control.** Where an instance's playback is edited: `:in`, `:speed`, and + what happens at the end. One place, three fields, rather than a loop + checkbox somewhere else. +2. **Drawing the repeats.** `ui/timeline`'s docstring already admits that only + the first pass of a looping instance is drawn, so a tire turning thirty + times shows one turn's keys and then nothing. A looping block should show + its passes — at minimum the period boundaries, so the row says how many + times round it goes. +3. **The audio period guard** below, which a loop needs whether or not holds + become loops. + ## Tear out the held cel A held cel is a 1-frame symbol shown for many frames. A 1-frame symbol with @@ -132,9 +163,13 @@ keeping a special case for free. **What is already true**, so that nothing has to move: `:span` is on the node, in its own frames; `:time` (`:at`, `:rate`) is on the node; looping is on the -node. The SYMBOL owns only `:frames`, the authored window. So looping and span -are instance properties already, and this change is about deleting a mode, not -relocating a field. +node, as `:playback :end`. The SYMBOL owns only `:frames`, the authored +window. So looping and span are instance properties already, and this change +is about deleting a mode, not relocating a field. + +It does mean the two changes are joined at one point: making every drawing a +looping instance is not safe until a looping instance can be seen and edited, +or every drawing in the document acquires a property with no control on it. **What has to be decided and collapsed:** From e459307a4a3cb73ed3936bb93a6f168be25e475a Mon Sep 17 00:00:00 2001 From: Your Name Date: Thu, 1 Oct 2026 19:40:53 -0400 Subject: [PATCH 09/10] Make lanes explicit symbol views --- docs/lane-is-a-view-notes.md | 72 ++ frontend/src/arthur/domain/clip.cljs | 24 +- frontend/src/arthur/domain/lane.cljs | 494 ----------- frontend/src/arthur/domain/leaf.cljs | 2 +- frontend/src/arthur/domain/nest.cljs | 31 +- frontend/src/arthur/domain/node.cljs | 14 +- frontend/src/arthur/domain/span.cljs | 648 ++++++++++++-- frontend/src/arthur/domain/symbol.cljs | 120 ++- frontend/src/arthur/events/footage.cljs | 14 +- frontend/src/arthur/events/project.cljs | 11 +- frontend/src/arthur/events/ui.cljs | 508 +++++------ frontend/src/arthur/subs/ui.cljs | 2 +- frontend/src/arthur/ui/location.cljs | 3 +- frontend/src/arthur/ui/params.cljs | 12 +- frontend/src/arthur/ui/timeline.cljs | 97 ++- .../test/arthur/domain/correction_test.cljs | 32 +- .../test/arthur/domain/instance_test.cljs | 6 +- frontend/test/arthur/domain/lane_test.cljs | 650 -------------- .../test/arthur/domain/sequence_test.cljs | 812 ++++++++++++++++++ frontend/test/arthur/domain/span_test.cljs | 266 ++---- frontend/test/arthur/events/lane_test.cljs | 251 ++---- frontend/test/browser/lane.mjs | 444 +++------- 22 files changed, 2183 insertions(+), 2330 deletions(-) create mode 100644 docs/lane-is-a-view-notes.md delete mode 100644 frontend/src/arthur/domain/lane.cljs delete mode 100644 frontend/test/arthur/domain/lane_test.cljs create mode 100644 frontend/test/arthur/domain/sequence_test.cljs diff --git a/docs/lane-is-a-view-notes.md b/docs/lane-is-a-view-notes.md new file mode 100644 index 0000000..989d02a --- /dev/null +++ b/docs/lane-is-a-view-notes.md @@ -0,0 +1,72 @@ +# Implementation notes — "A lane is a view" + +Running log for `docs/lane-is-a-view-plan.md`. `[ ]` not started, `[~]` in +progress, `[x]` done with `npm test` green. + +Baseline at `fb38990`: 475 tests, 9621 assertions, 0 failures. + +## Order of work + +The plan's seven steps, re-grouped — see *Deviation from the plan's order* below. + +- [x] A. Domain: `symbol/children`, `symbol/lane?`, `symbol/overlaps`, + `lane.cljs` → `span.cljs`, the overlap check in `span/finish` + (plan steps 3, 4, and the domain half of 5) +- [x] B. Events: re-base callers and remove lane-node-specific commands; keep + explicit `::new-lane` and cross-lane adoption (plan step 5) +- [x] C. UI: row per symbol, explicit lane creation, and drag handling + (plan steps 1, 2, and the UI half of 5) +- [x] D. Audio: delete `holds-other?`, the mixed-lane refusal, the `in-lane` + filter in `sound-rows` (plan step 6) +- [x] E. Tests: `domain/sequence_test`, `events/lane_test`, `browser/lane.mjs` +- [x] F. Shift-to-reparent still works, untouched (plan step 7) + +Not in this pass — see *Left for a second pass*: tearing out the held cel, the +instance-playback control, drawing a loop's repeats, the audio period guard. + +## Deviation from the plan's order + +The plan's steps 1 and 2 are display work that keys off "a symbol's children", +and step 3 is what MAKES the cels a symbol's children. Until then a cel's +`:parent` is the lane node, so there is nothing for the display to read: step 2 +cannot draw "a symbol's children as blocks" while the children belong to a +group. So the data model moves first (A) and the display follows (C). The +content of each step is unchanged; only the order is. + +The one thing this gives up is the plan's promise that every step leaves the +editor usable — between A and C the timeline draws the new shape with the old +code. `npm test` is green at each step either way. + +## Decisions taken + +1. **Lane mode is `:display :lane` on the SYMBOL** — plan's recommendation 2, + and open question 1 answered "the symbol, not the instance". A symbol placed + twice is drawn as a lane in both places. Added to `symbol/symbol-keys` and to + `leaf/leaves`' `select-keys` so it saves like `:frames`. +2. **A symbol's children are its parent-less nodes** that have a placed span. + The plan's step 6 settles it: "an audio node is already a parent-less child + of a symbol, which is exactly the new shape". Span-less nodes — a shape on + screen for the whole shot — are not in the sequence and are skipped, which is + also what stops the commands destructuring a nil span. +3. **A symbol holds at most one sequence.** It follows from 1 and 2: the + container is the symbol. Two lanes of picture is now two symbols placed in a + third, which is what compositing already was. +4. **The open symbol gets a row of its own in lane mode**, and only then. The + blocks have to sit on a row and the open symbol had none; expanding it turns + its children into ordinary rows. Not a row always, which would shift every + row in the pane for no gain. +5. **Open question 2** — a lane row's edge drag trims the PLACING INSTANCE's + span, via `span/resize-out`, like the handle on every other row. Rippling + the children is what the cel blocks' own edges already do, and giving one + handle two meanings is what the plan refuses elsewhere. +6. **Open question 3** — the lane work first, the held cel after. The plan says + they are independent, and the held cel is joined to a loop control that does + not exist yet; doing it second costs one more pass over `lane_test`'s + fixtures and risks nothing. +7. **Lane creation stays explicit.** A blank document and `new symbol` create + ordinary symbols. The separate `new → lane` command creates and places a + symbol with `:display :lane`, aims it for immediate drawing or dropping, and + always adds it at the top of the open symbol rather than nesting it in the + previously aimed lane. + +## Notes diff --git a/frontend/src/arthur/domain/clip.cljs b/frontend/src/arthur/domain/clip.cljs index eeeafd8..fee987c 100644 --- a/frontend/src/arthur/domain/clip.cljs +++ b/frontend/src/arthur/domain/clip.cljs @@ -149,20 +149,13 @@ which is long enough to key something into and short enough to scrub by hand." 120) -(def lane-node - "The lane every symbol is born with. - - EVERY SYMBOL HAS AT LEAST ONE LANE, because a lane is the only place - temporal content goes and a symbol with none has nowhere to drop a thing — - which made the first drop into any symbol a special case that had to invent - a lane before it could do what the second drop does. An empty lane is a true - statement about a symbol nobody has put anything in yet. The id is a keyword - rather than a uuid because this namespace is pure, and `:lane` reads in a - path; commands that add FURTHER lanes bring their own uuids." - {:id :lane :name "lane" :kind :group :layout :sequence :z "z-lane"}) - (defn blank - "A new, empty document: one symbol, holding one empty lane. + "A new, empty document: one symbol, and nothing in it. + + A SYMBOL IS BORN EMPTY. It used to be born holding a lane, because a lane was + the only place temporal content could go; now the symbol itself is the + container — see `symbol/children` — so there is nothing to invent and the + first drop into a symbol is the same operation as the second. The tracking maps are ABSENT rather than empty, because `leaf/leaves` writes no leaf for an empty one and so cannot bring it back: a blank document that opened @@ -174,8 +167,7 @@ {:name "untitled" :fps 30 :width 320 :height 200 - :symbols {:main {:id :main :fps 30 :frames blank-frames - :nodes {:lane lane-node}}}}) + :symbols {:main {:id :main :fps 30 :frames blank-frames :nodes {}}}}) (defn- transform-op "Put a symbol's already resolved mark into its instance's parent space. Its @@ -421,7 +413,7 @@ clip (-> clip (assoc-in [:symbols sid] {:id sid :name (name sid) :fps (fps clip host) - :frames (- end frame) :nodes {:lane lane-node}}) + :frames (- end frame) :nodes {}}) (place-symbol nil host sid frame uuid nil))))) (defn free-id diff --git a/frontend/src/arthur/domain/lane.cljs b/frontend/src/arthur/domain/lane.cljs deleted file mode 100644 index 9a3366a..0000000 --- a/frontend/src/arthur/domain/lane.cljs +++ /dev/null @@ -1,494 +0,0 @@ -(ns arthur.domain.lane - "The commands that need a SEQUENCE: make a lane, place symbol clips in it, - change how long they are exposed, empty part of it, and decide which held - drawing clips share content. - - WHAT A LANE IS lives in `arthur.domain.symbol`, beside the other rules about a - node map: a group with `:layout :sequence`, whose children are non-overlapping - visual symbol clips. This namespace only changes them. - - WHAT IS NOT HERE: split, trim and move. Each of those is one write to one - node's span or position, which is a fact every node has, so they live in - `arthur.domain.span` and work on a symbol placed straight into a shot as - readily as on a cel. What stays here is everything that cannot be said about - one node alone — a ripple needs later siblings, a gap needs a row to be a hole - in, and appending needs to know where the row stops. - - EVERY COMMAND IS ONE STEP AND ALL OF IT. Each returns `{:clip :selection}` or - `{:refused reason}` — never a half-applied edit, and never a document that - `clip/problems` would reject. A command that cannot say what the person meant - refuses and says why, rather than picking for them: the overflow policy is a - caller's `:extent`, and decoupling shared content is its own command instead - of something an ordinary edit does silently. - - IDS FOR CELS COME FROM THE CALLER, because a cel's identity is - a uuid and this namespace is pure. Ids for new CONTENT are derived from the - drawing being copied — `clip/free-id` is pure too, and `drawing-a-2` says what - it came from in a way `symbol-7` does not." - (:require [arthur.domain.bring :as bring] - [arthur.domain.clip :as clip] - [arthur.domain.node :as node] - [arthur.domain.span :as span] - [arthur.domain.symbol :as symbol])) - -(defn extend-hold - "Change one held cel's duration by `delta` lane frames and ripple its - later siblings. Lane channels, cel channels and source clocks stay put. - Returns {:clip :selection} or {:refused :required-frames?}; never partially edits." - [clip sid id delta {:keys [extent] :or {extent :keep}}] - (let [nodes (get-in clip [:symbols sid :nodes]) - n (get nodes id) - lane (get nodes (:parent n)) - rate (:rate (node/time-of n)) - span (:span n) - m (when lane (symbol/frame-map nodes (:id lane))) - ;; The LANE's own shape, not the whole symbol's: refusing a cel - ;; edit over some unrelated defect elsewhere in the symbol would be - ;; this command answering for a part of the document it never touches. - broken (first (symbol/lane-problems nodes))] - (cond - (not (node/lane? lane)) {:refused "select a cel in a lane"} - broken {:refused broken} - (not (and (integer? delta) (not (zero? delta)))) {:refused "hold change must be a nonzero whole number of lane frames"} - (not (zero? (:speed (node/playback-of n)))) {:refused "hold length applies to a held drawing"} - (nil? m) {:refused "cel timing through a stepped or looping lane is not supported"} - (<= (+ (second span) (* rate delta)) (first span)) {:refused "a drawing must keep a positive cel"} - :else - (let [[_ boundary] (node/placed-span n) - later (filter #(>= (first (node/placed-span %)) boundary) - (symbol/lane-clips nodes (:id lane))) - nodes (assoc-in nodes [id :span 1] (+ (second span) (* rate delta))) - nodes (reduce (fn [ns sibling] - (update-in ns [(:id sibling) :time :at] (fnil + 0) delta)) - nodes later)] - (span/finish clip sid nodes id extent))))) - -(defn resize-out - "Put cel `id`'s right edge at lane frame `to`. - - Without `ripple?`, growing the cel consumes the starts of the cels it reaches: - wholly covered cels disappear and the last partially covered one is trimmed. - Shrinking leaves a gap. With `ripple?`, every cel beginning at or after the - old edge moves by the same delta, in either direction, so their contents are - preserved. A lane never contains an overlap in either mode." - [clip sid id to {:keys [extent ripple?] :or {extent :keep ripple? false}}] - (let [nodes (get-in clip [:symbols sid :nodes]) - n (get nodes id) - lane (get nodes (:parent n)) - [lo old-out] (when n (node/placed-span n)) - members (when (node/lane? lane) (symbol/lane-clips nodes (:id lane))) - later (when members - (remove #(= id (:id %)) - (filter #(>= (first (node/placed-span %)) old-out) members))) - broken (first (symbol/lane-problems nodes))] - (cond - (not (node/lane? lane)) {:refused "select a cel in a lane"} - broken {:refused broken} - (not (integer? to)) {:refused "a cel edge goes to a whole lane frame"} - (not (< lo to)) {:refused "a drawing must keep at least one frame"} - (= to old-out) {:clip clip :selection id} - :else - (let [delta (- to old-out) - resized (assoc nodes id (span/edged n :out to)) - changed - (if ripple? - (reduce (fn [ns sibling] - (update-in ns [(:id sibling) :time :at] (fnil + 0) delta)) - resized later) - (if (pos? delta) - (reduce - (fn [ns sibling] - (let [[s e] (node/placed-span sibling)] - (cond - (>= s to) ns - (<= e to) (dissoc ns (:id sibling)) - :else (assoc ns (:id sibling) (span/edged sibling :in to))))) - resized later) - resized))] - (span/finish clip sid changed id extent))))) - -(defn resize-in - "Put cel `id`'s left edge at lane frame `to`. Shrinking leaves a gap; - growing left consumes earlier cels symmetrically with `resize-out`." - [clip sid id to] - (let [nodes (get-in clip [:symbols sid :nodes]) - n (get nodes id) - lane (get nodes (:parent n)) - [old-in hi] (when n (node/placed-span n)) - earlier (when (node/lane? lane) - (remove #(= id (:id %)) - (filter #(<= (second (node/placed-span %)) old-in) - (symbol/lane-clips nodes (:id lane))))) - broken (first (symbol/lane-problems nodes))] - (cond - (not (node/lane? lane)) {:refused "select a cel in a lane"} - broken {:refused broken} - (not (integer? to)) {:refused "a cel edge goes to a whole lane frame"} - (not (< to hi)) {:refused "a drawing must keep at least one frame"} - (neg? to) {:refused "a cel cannot begin before the lane"} - (= to old-in) {:clip clip :selection id} - :else - (let [resized (assoc nodes id (span/edged n :in to)) - changed (if (< to old-in) - (reduce - (fn [ns sibling] - (let [[s e] (node/placed-span sibling)] - (cond - (<= e to) ns - (>= s to) (dissoc ns (:id sibling)) - :else (assoc ns (:id sibling) (span/edged sibling :out to))))) - resized earlier) - resized)] - (span/finish clip sid changed id :keep))))) - -(defn roll - "Move the shared boundary between adjacent cels `left-id` and `right-id`. - This is deliberately only the composition of the two ordinary edge edits." - [clip sid left-id right-id to] - (let [nodes (get-in clip [:symbols sid :nodes]) - left (get nodes left-id) - right (get nodes right-id) - lane (get nodes (:parent left)) - [llo lhi] (when left (node/placed-span left)) - [rlo rhi] (when right (node/placed-span right))] - (cond - (or (not (node/lane? lane)) (not= (:parent left) (:parent right))) - {:refused "a rolling edit needs two cels in one lane"} - (not= lhi rlo) {:refused "a rolling edit needs one shared boundary"} - (not (integer? to)) {:refused "a cel edge goes to a whole lane frame"} - (not (< llo to rhi)) {:refused "both drawings must keep at least one frame"} - :else - (let [left-result (resize-out clip sid left-id to {})] - (if (:refused left-result) - left-result - (resize-in (:clip left-result) sid right-id to)))))) - -(defn blank - "Clear lane frames `[a b)` of lane `lane-id`, leaving a GAP. - - A gap is not a drawing. Nothing is invented to cover those frames and nothing - closes the hole — the cels after it stay where they are, because - emptying frames and re-timing a performance are different intentions. - - What it does to each cel it meets is `span/edged`, applied three ways: one wholly - inside is removed, one overlapping an end is trimmed to it, and the one that - spans the whole range is split, which is the only case that needs `id`. Their - drawings stay in the library — a lane does not own its content, and a drawing - whose last cel is gone is still a drawing somebody made." - [clip sid lane-id [a b] {:keys [id]}] - (let [nodes (get-in clip [:symbols sid :nodes]) - lane (get nodes lane-id) - members (when (node/lane? lane) (symbol/lane-clips nodes lane-id)) - spanning (when members - (first (filter #(let [[lo hi] (node/placed-span %)] (and (< lo a) (> hi b))) - members)))] - (cond - (not (node/lane? lane)) {:refused "select a lane"} - (not (and (integer? a) (integer? b) (< a b))) - {:refused "a range to blank is whole lane frames, and not empty"} - (and spanning (or (nil? id) (contains? nodes id))) - {:refused "blanking inside one cel splits it, which needs a free ID for the remainder"} - :else - (let [nodes (reduce - (fn [ns n] - (let [[lo hi] (node/placed-span n)] - (cond - (or (<= hi a) (>= lo b)) ns - (and (< lo a) (> hi b)) - (-> ns - (assoc (:id n) (span/edged n :out a)) - (assoc id (assoc (span/edged n :in b) :id id :z (str "a-" id)))) - (and (>= lo a) (<= hi b)) (dissoc ns (:id n)) - (< lo a) (assoc ns (:id n) (span/edged n :out a)) - :else (assoc ns (:id n) (span/edged n :in b))))) - nodes members)] - (span/finish clip sid nodes (or (when spanning id) lane-id) :keep))))) - -(defn add-lane [clip sid id] - (let [nodes (get-in clip [:symbols sid :nodes]) - front (last (sort (keep (fn [[_ n]] (when (nil? (:parent n)) (:z n))) nodes)))] - (if (or (nil? (clip/symbol clip sid)) (get nodes id)) - {:refused "the symbol is missing or the lane ID is already used"} - {:clip (assoc-in clip [:symbols sid :nodes id] - {:id id :name "lane" :kind :group :layout :sequence - :z (symbol/z-between front nil)}) - :selection id}))) - -(defn- holds-other? - "Whether `lane-id` already holds clips that are not of `kind`. - - A lane holds picture or sound and not both, and the check belongs HERE - rather than only in validation: placement claims time, so a picture dropped - on a lane of sound would not be caught as a mixture — `blank` would have - deleted the sound to make room for it first, and the document would be - valid and the sound gone." - [nodes lane-id kind] - (boolean (some #(not= kind (:kind %)) (symbol/lane-clips nodes lane-id)))) - -(defn place-symbol - "Place arbitrary symbol `source-id` as a naturally playing clip in a lane. - - The new clip claims its interval: existing clips under that interval are - trimmed, removed, or split by `blank`, so the lane remains a partition rather - than storing an overlap. This is the generic operation behind dropping a - library symbol into a lane; one-frame held drawing creation remains a policy - of `append-drawing`/`overwrite-drawing`, not a different lane type." - [clip store sid lane-id id source-id at - {:keys [extent point remainder-id] :or {extent :keep}}] - (let [nodes (get-in clip [:symbols sid :nodes]) - lane (get nodes lane-id) - seeded (clip/place-symbol clip store sid source-id 0 id point) - n (get-in seeded [:symbols sid :nodes id]) - duration (when n (- (second (node/placed-span n)) - (first (node/placed-span n))))] - (cond - (not (node/lane? lane)) {:refused "select a lane"} - (holds-other? nodes lane-id :instance) - {:refused "that lane holds sound; a lane holds picture or sound, not both"} - (contains? nodes id) {:refused "the new clip ID is already used"} - (not (and (integer? at) (not (neg? at)))) - {:refused "a position is a nonnegative whole lane frame"} - (nil? (clip/symbol clip source-id)) {:refused "there is no such symbol to place"} - (nil? n) {:refused "a symbol cannot go inside itself"} - (not (pos? duration)) {:refused "the symbol has no frames to place"} - (and remainder-id (contains? nodes remainder-id)) - {:refused "the remainder clip needs a free ID"} - :else - (let [cleared (blank clip sid lane-id [at (+ at duration)] - {:id remainder-id})] - (if (:refused cleared) - cleared - (let [nodes (assoc (get-in (:clip cleared) [:symbols sid :nodes]) id - (-> n - (assoc :parent lane-id) - (assoc-in [:time :at] at)))] - (span/finish (:clip cleared) sid nodes id extent))))))) - -(defn adopt - "Move an existing clip — a symbol instance or a sound — into `lane-id` at - lane frame `at`. Its source, span, transforms, corrections, and identity come - with it; the destination interval is claimed with the same overwrite trimming - as a pool drop. What a lane may not do is mix the two kinds, which - `symbol/lane-problems` is the judge of and `finish` enforces." - [clip sid lane-id id at {:keys [extent remainder-id] :or {extent :keep}}] - (let [nodes (get-in clip [:symbols sid :nodes]) - lane (get nodes lane-id) - n (get nodes id) - [lo hi] (when n (node/placed-span n)) - duration (when (and lo hi) (- hi lo))] - (cond - (not (node/lane? lane)) {:refused "select a lane"} - (not (contains? #{:instance :audio} (:kind n))) - {:refused "only a symbol or sound clip goes in a lane"} - (holds-other? nodes lane-id (:kind n)) - {:refused "a lane holds picture or sound, not both"} - (= lane-id (:parent n)) {:refused "this clip is already in that lane"} - (not (and (integer? at) (not (neg? at)))) - {:refused "a position is a nonnegative whole lane frame"} - (not (pos? duration)) {:refused "the clip has no frames to place"} - (and remainder-id (contains? nodes remainder-id)) - {:refused "the remainder clip needs a free ID"} - :else - (let [cleared (blank clip sid lane-id [at (+ at duration)] {:id remainder-id})] - (if (:refused cleared) - cleared - (let [moved (-> n - (assoc :parent lane-id) - (update-in [:time :at] (fnil + 0) (- at lo))) - nodes (assoc (get-in (:clip cleared) [:symbols sid :nodes]) id moved)] - (span/finish (:clip cleared) sid nodes id extent))))))) - -;; --------------------------------------------------------------------------- -;; putting drawings in a lane - -(defn- held - "A one-frame held cel of `drawing-id`, starting at lane frame `at`. - - Held rather than playing, and one frame rather than the length of what it - places: a cel's duration is the lane's business — `extend-hold` is how - it changes — and reading it off the content would make placing a ten-frame - animation and holding its first drawing the same gesture." - [id lane-id drawing-id at] - {:id id :kind :instance :parent lane-id :z (str "a-" id) - :span [0 1] :time {:at at :rate 1} - :source {:symbol drawing-id} :playback {:in 0 :speed 0 :end :stop}}) - -(defn lane-frame - "Symbol frame `f` as a frame of lane `lane-id`'s OWN time, or nil through a - stepped or looping lane, where one frame of the symbol is not one frame of the - lane and there is no single answer to give a command." - [clip sid lane-id f] - (when-let [{:keys [at rate]} (symbol/frame-map (get-in clip [:symbols sid :nodes]) lane-id)] - (* rate (- f at)))) - -(defn- lane-end - "Where lane `lane-id`'s occupied frames stop, in its own time." - [nodes lane-id] - (apply max 0 (map #(second (node/placed-span %)) - (symbol/lane-clips nodes lane-id)))) - -(defn- place - "Put a held cel of `drawing-id` into `lane-id` at lane frame `at`, and - RIPPLE: everything starting at or after it moves later by its duration. - - There is one placement function and `:end` is a position like any other, so - appending is not a different operation from inserting — the end is just where - nothing has to move. Overwriting is the other policy and is NOT this: taking - frames away from the cel already there is trimming, which is its own - command and not something placing a drawing should do on the quiet. - - `:frame` in the result is where it landed, in the open symbol's time, for a - caller that wants to look at what it just made." - [clip sid lane-id id drawing-id at extent ripple?] - (let [nodes (get-in clip [:symbols sid :nodes]) - at (if (= :end at) (lane-end nodes lane-id) at) - n (held id lane-id drawing-id at) - [lo hi] (node/placed-span n) - later (when ripple? - (filter #(>= (first (node/placed-span %)) lo) - (symbol/lane-clips nodes lane-id))) - nodes (reduce (fn [ns sibling] - (update-in ns [(:id sibling) :time :at] (fnil + 0) (- hi lo))) - (assoc nodes id n) later) - result (span/finish clip sid nodes id extent) - m (symbol/frame-map nodes lane-id)] - (cond-> result - (:clip result) (assoc :frame (+ (:at m) (/ at (:rate m))))))) - -(defn- placeable - "Why a held cel cannot go into `lane-id` at `at`, or nil." - [clip sid lane-id id at] - (let [nodes (get-in clip [:symbols sid :nodes]) - lane (get nodes lane-id) - ;; INSIDE a cel is not a position for another one. Splitting that - ;; cel is what makes it two, and doing it here would be one command - ;; quietly performing two: the caller asks for `split` and then places. - inside (when (number? at) - (some (fn [n] (let [[lo hi] (node/placed-span n)] - (when (< lo at hi) n))) - (symbol/lane-clips nodes lane-id)))] - (cond - (not (node/lane? lane)) "select a lane" - (contains? nodes id) "the new cel ID is already used" - (not (or (= :end at) (and (integer? at) (not (neg? at))))) - "a position is :end or a whole lane frame" - inside (str "frame " at " is inside a cel; split it first") - (nil? (symbol/frame-map nodes lane-id)) "drawing creation through a stepped or looping lane is not supported" - :else (first (symbol/lane-problems nodes))))) - -(defn append-drawing - "Append fresh empty content and a held cel of it. IDs come from the - caller so a command is deterministic and replayable. - - Fresh content, not a blank range: a lane with no cel over a frame shows - nothing there already, and a drawing nobody has drawn in is a different thing - from a gap." - [clip sid lane-id id drawing-id {:keys [at extent] :or {extent :keep at :end}}] - (if-let [why (or (placeable clip sid lane-id id at) - (when (clip/symbol clip drawing-id) "the new drawing ID is already used"))] - {:refused why} - (place (assoc-in clip [:symbols drawing-id] - {:id drawing-id :name (name drawing-id) :fps (clip/fps clip sid) :frames 1 :nodes {}}) - sid lane-id id drawing-id at extent true))) - -(defn reuse-drawing - "Append a held cel of content the document ALREADY has, so the same - drawing is exposed twice and editing it changes both cels. - - This is the command `make-unique` is the undo of, and the reason they are two - commands: reuse is a decision to share, and sharing is not something to - discover later when an edit turns up somewhere else." - [clip sid lane-id id drawing-id {:keys [at extent] :or {extent :keep at :end}}] - (if-let [why (or (placeable clip sid lane-id id at) - (when-not (clip/symbol clip drawing-id) "there is no such drawing to reuse") - ;; Placing something that contains this symbol would close a - ;; loop, and a lane is no different from any other placement. - (when (clip/contains-symbol? clip drawing-id sid) - "a symbol cannot go inside itself"))] - {:refused why} - (place clip sid lane-id id drawing-id at extent true))) - -(defn- copied - "A copy of symbol `from`, as `{:clip :id}`. - - SHALLOW by default: its own nodes and channels are copied, and its references - to other symbols are kept, so a head built out of reusable eyes still uses - those eyes. `deep?` copies everything it places as well, with new ids - throughout, for a drawing that must share nothing — the distinction the - shallow copy cannot make on its own, and a promise of independence that only - the deep one keeps." - [clip from deep?] - (if deep? - (let [{c :clip ids :ids} (bring/symbols clip clip [from] {})] - {:clip c :id (ids from)}) - (let [id (clip/free-id (:symbols clip) from)] - {:clip (assoc-in clip [:symbols id] (assoc (clip/symbol clip from) :id id)) - :id id}))) - -(defn duplicate-drawing - "Append a held cel of a COPY of what cel `id` places, for when - the drawing on screen is the starting point for the next one. - - The copy is of the content only. The new cel is a plain one-frame hold - rather than a copy of `id`'s own transform or corrections: those belong to - that cel, and carrying them over would make duplicating a drawing quietly - duplicate the treatment of one use of it." - [clip sid id new-id {:keys [at extent deep?] :or {extent :keep at :end}}] - (let [n (get-in clip [:symbols sid :nodes id]) - from (node/source n)] - (if-let [why (or (when-not from "select a cel to duplicate") - (when-not (clip/symbol clip from) "the drawing it places is missing") - (placeable clip sid (:parent n) new-id at))] - {:refused why} - (let [{c :clip copy :id} (copied clip from deep?)] - (place c sid (:parent n) new-id copy at extent true))))) - -(defn overwrite-drawing - "Put a fresh one-frame drawing at lane frame `at`, replacing whatever was - there and leaving every other cel where it was. - - This is `blank` and placement composed in ONE command and therefore one undo - step. `remainder-id` is used only when clearing the frame cuts one cel into - two; ids still come from the caller because this namespace is pure." - [clip sid lane-id id drawing-id at {:keys [extent remainder-id] - :or {extent :keep}}] - (let [nodes (get-in clip [:symbols sid :nodes])] - (if-let [why (cond - (not (and (integer? at) (not (neg? at)))) - "a position is a nonnegative whole lane frame" - (contains? nodes id) "the new cel ID is already used" - (or (= id remainder-id) (contains? nodes remainder-id)) - "the remainder cel needs a free ID different from the new cel" - (clip/symbol clip drawing-id) "the new drawing ID is already used" - (nil? (symbol/frame-map nodes lane-id)) - "drawing creation through a stepped or looping lane is not supported")] - {:refused why} - (let [cleared (blank clip sid lane-id [at (inc at)] {:id remainder-id})] - (if (:refused cleared) - cleared - (place (assoc-in (:clip cleared) [:symbols drawing-id] - {:id drawing-id :name (name drawing-id) :fps (clip/fps clip sid) :frames 1 :nodes {}}) - sid lane-id id drawing-id at extent false)))))) - -(defn make-unique - "Point cel `id` at a private copy of its content, leaving every other - cel of that drawing sharing the original. - - Refused when nothing else uses it: a drawing with one cel is already - unique, and answering with a silent copy would leave a second identical symbol - in the library for no reason a person could see." - [clip sid id {:keys [deep?]}] - (let [n (get-in clip [:symbols sid :nodes id]) - from (node/source n) - elsewhere (for [[osid osym] (:symbols clip) - [oid on] (:nodes osym) - :when (and (= from (node/source on)) (not= [sid id] [osid oid]))] - [osid oid])] - (if-let [why (or (when-not from "select a cel to make unique") - (when-not (clip/symbol clip from) "the drawing it places is missing") - (when (empty? elsewhere) "nothing else uses this drawing"))] - {:refused why} - (let [{c :clip copy :id} (copied clip from deep?) - c (assoc-in c [:symbols sid :nodes id :source :symbol] copy) - ps (clip/problems c)] - (if (seq ps) {:refused (first ps)} {:clip c :selection id}))))) diff --git a/frontend/src/arthur/domain/leaf.cljs b/frontend/src/arthur/domain/leaf.cljs index eb48d3f..8fe84f1 100644 --- a/frontend/src/arthur/domain/leaf.cljs +++ b/frontend/src/arthur/domain/leaf.cljs @@ -144,7 +144,7 @@ ;; disagree with itself about; `clip` puts it back. (for [[sid sym] (:symbols clip)] {(at "symbol" (segment sid)) - (select-keys sym [:name :frames :fps :width :height :palette])}) + (select-keys sym [:name :frames :fps :width :height :palette :display])}) (for [[sid sym] (:symbols clip) [id n] (:nodes sym)] {(at "symbol" (segment sid) "node" (segment id)) diff --git a/frontend/src/arthur/domain/nest.cljs b/frontend/src/arthur/domain/nest.cljs index 7999ce0..9936314 100644 --- a/frontend/src/arthur/domain/nest.cljs +++ b/frontend/src/arthur/domain/nest.cljs @@ -19,7 +19,6 @@ matrix becomes a `:pinv`, Blender's parent-inverse, and the time a new `:at` and `:rate`. Its channels, keys and span are untouched." (:require [arthur.domain.clip :as clip] - [arthur.domain.lane :as lane] [arthur.domain.node :as node] [arthur.domain.palette :as pal] [arthur.domain.span :as span] @@ -73,7 +72,7 @@ inner (:symbol shown) lf (if shown (:frame shown) local)] (if (and m (number? local) - ;; A lane over a gap has no inside to be in. + ;; A clip over a gap has no inside to be in. (or (not inst?) shown) (or (nil? inner) (< -1 lf (clip/frames clip inner)))) {:sid inner :frame (js/Math.floor lf) @@ -284,8 +283,8 @@ The one that surprises: BOTH have to be on screen at this frame, because the move keeps the picture and there is no common frame to keep it at otherwise. - Two clips in one lane never overlap, so nesting one into another there can - never be done — it is a thing to do between lanes, with the playhead + Two clips of one lane never overlap, so nesting one into another there can + never be done — it is a thing to do between symbols, with the playhead somewhere both of them are showing. The deeper refusals — generated parts, a stencil parted from what it clips — @@ -335,8 +334,8 @@ only a move that keeps the PICTURE needs a frame, for the matrix." [clip sid path] (let [;; Structurally, a row leads into a symbol only where it names one: - ;; a cel does, and the lane holding it does not, so the walk - ;; stops at a lane rather than picking the drawing showing now — which + ;; a clip does, and a group holding one does not, so the walk stops at + ;; the group rather than picking the drawing showing now — which ;; would make where a row lives depend on the playhead. only (fn [sid id] (when sid (node/source (get-in clip [:symbols sid :nodes id])))) @@ -394,8 +393,10 @@ (defn resize-out "Move the right edge of the node at `path` by `df` frames of `open`. - Lane cels use the lane's collision/ripple rules; ordinary clips, including - audio, resize independently." + + One command either way: in a symbol drawn as a lane `span/resize-out` claims + the time it grows into, and in a composition it is one write to one span. The + mode says which, and nothing here has to ask." [clip open path df ripple?] (let [here (down clip open (pop path)) sid (:sid here) @@ -409,12 +410,10 @@ (let [chain (map #(get nodes %) (reverse (rest (symbol/lineage nodes id)))) d (* df (:rate (reduce node/then-time (:time here) (map node/time-of chain)))) to (+ (second (node/placed-span n)) d)] - (if (node/lane? (get nodes (:parent n))) - (lane/resize-out clip sid id to {:ripple? ripple? :extent :grow-symbol}) - (span/resize-out clip sid id to)))))) + (span/resize-out clip sid id to {:ripple? ripple? :extent :grow-symbol}))))) (defn resize-in - "Move a lane cel's left edge by `df` frames of `open`." + "Move the left edge of the node at `path` by `df` frames of `open`." [clip open path df] (let [here (down clip open (pop path)) sid (:sid here) @@ -424,13 +423,11 @@ (cond (nil? n) {:refused "nothing to resize"} (nil? (:time here)) {:refused "a looping instance is in the way"} - (not (node/lane? (get nodes (:parent n)))) - {:refused "only a lane cel has a collision-free left edge"} :else (let [chain (map #(get nodes %) (reverse (rest (symbol/lineage nodes id)))) d (* df (:rate (reduce node/then-time (:time here) (map node/time-of chain)))) to (+ (first (node/placed-span n)) d)] - (lane/resize-in clip sid id to))))) + (span/resize-in clip sid id to))))) (defn roll "Move the shared boundary at `right-path` and the adjacent `left-path`." @@ -443,13 +440,13 @@ right (get nodes right-id)] (cond (or (not= (pop left-path) (pop right-path)) (nil? right)) - {:refused "a rolling edit needs adjacent clips in one lane"} + {:refused "a rolling edit needs adjacent clips in one sequence"} (nil? (:time here)) {:refused "a looping instance is in the way"} :else (let [chain (map #(get nodes %) (reverse (rest (symbol/lineage nodes right-id)))) d (* df (:rate (reduce node/then-time (:time here) (map node/time-of chain)))) to (+ (first (node/placed-span right)) d)] - (lane/roll clip sid left-id right-id to))))) + (span/roll clip sid left-id right-id to))))) (defn restack "Put the node at row path `from` just in front of the one at `to` when diff --git a/frontend/src/arthur/domain/node.cljs b/frontend/src/arthur/domain/node.cljs index 1d5a474..3bb5be5 100644 --- a/frontend/src/arthur/domain/node.cljs +++ b/frontend/src/arthur/domain/node.cljs @@ -244,16 +244,6 @@ (when (and (<= 0 frame) (< frame length)) {:symbol sid :frame frame}))))) -(defn lane? - "Is this group a LANE — a succession of cels rather than a composition? - - `:layout :sequence` is the field because it names the RULE: children follow - one another and may not overlap. A group carrying it is called a lane, which - is the one place two words are kept for one thing, and they are kept apart on - purpose — the layout says what the rule is, the noun says what the thing is." - [n] - (and (= :group (:kind n)) (= :sequence (:layout n)))) - (defn finite-number? [v] (and (number? v) (js/Number.isFinite v))) (defn local-frame @@ -415,8 +405,8 @@ (finite-number? speed) (<= 0 speed) (#{:stop :hold :loop} end))))) (conj "playback needs a nonnegative finite :in and :speed, and :end :stop, :hold or :loop") - (and (:layout n) (not (lane? n))) - (conj ":layout :sequence belongs to a group") + (:layout n) + (conj ":layout is not a node field — a lane is how the timeline DRAWS a symbol, not a thing in the document") (and (= k :audio) (not (some (:source n) [:footage :sound]))) (conj "an audio node needs a :source :footage or :sound") (and (some? (get-in n [:time :rate])) diff --git a/frontend/src/arthur/domain/span.cljs b/frontend/src/arthur/domain/span.cljs index 0027c16..bdaf252 100644 --- a/frontend/src/arthur/domain/span.cljs +++ b/frontend/src/arthur/domain/span.cljs @@ -1,28 +1,51 @@ (ns arthur.domain.span - "The commands over ONE node's place in time: split it, trim an edge, move it. + "The commands over a node's place in time: split it, trim an edge, move it — + and, where the symbol holding it is drawn as a lane, re-span its siblings to + make room. A `:span` is in the node's OWN frames and its `:time` says where those land in - its parent, and that is true of EVERY node — which is why these three are not - lane commands, though a lane of cels is where they were first needed. A cel in - a lane, a symbol placed straight into a shot, a shape that exists for part of - one: each is a span in a parent's frame space, and a span in a parent's frame - space is the whole of what these commands touch. They were gated on a lane for - as long as a lane was the only thing anybody had timed. + its parent, and that is true of EVERY node. A clip in a sequence, a symbol + placed straight into a shot, a shape that exists for part of one: each is a + span in a parent's frame space, and a span in a parent's frame space is the + whole of what these commands touch. - THE COORDINATE IS ALWAYS THE PARENT'S. For a cel the parent is its lane, so - `host-frame` reads lane time exactly as the lane commands always did; for a - node sitting straight in the symbol it reads the symbol's own frames. One rule, - so a caller holding a node does not branch on what it sits in. + THE COORDINATE IS ALWAYS THE PARENT'S. `host-frame` reads the frame space the + node is positioned in, whatever that is, so a caller holding a node does not + branch on what it sits in. - A GROUP IS REFUSED. Dividing a group means deciding what becomes of its - children, and nothing in a span says: the right half of a split lane would - reference none of its cels, and a span that narrows past a child hides it - without saying so. `domain/lane` holds the commands for a sequence, which are - the ones that ripple siblings or leave a gap. + A GROUP IS REFUSED where one node is being divided. Dividing a group means + deciding what becomes of its children, and nothing in a span says: a span that + narrows past a child hides it without saying so. - `finish` lives here because every command in this namespace and every one in - `domain/lane` commits through it." - (:require [arthur.domain.clip :as clip] + WHY THE SEQUENCE COMMANDS ARE HERE TOO. They used to be `domain/lane`, gated on + a group with `:layout :sequence`, because a lane was the only thing anybody had + timed. There is no such group any more — the SYMBOL is the container and a lane + is how the timeline draws one, `symbol/lane?` — so their subject is a symbol and + its children, which is the same subject as everything else here: one write to + one node's span, with the siblings re-spanned around it. See + `docs/lane-is-a-view-plan.md`. + + THE CLAIM-TIME RULE FOLLOWS THE MODE. In lane mode, placing, moving or growing + over occupied frames TRIMS what it lands on — trimming the incumbent, removing + one wholly covered, splitting one it lands inside — so the result has no overlap + because the operation that could have made one did not. Outside lane mode + nothing is enforced, because overlapping children are what compositing IS. + + EVERY COMMAND IS ONE STEP AND ALL OF IT. Each returns `{:clip :selection}` or + `{:refused reason}` — never a half-applied edit, and never a document that + `clip/problems` would reject. A command that cannot say what the person meant + refuses and says why, rather than picking for them: the overflow policy is a + caller's `:extent`, and decoupling shared content is its own command instead of + something an ordinary edit does silently. + + IDS COME FROM THE CALLER, because a clip's identity is a uuid and this namespace + is pure. Ids for new CONTENT are derived from the drawing being copied — + `clip/free-id` is pure too, and `drawing-a-2` says what it came from in a way + `symbol-7` does not. + + `finish` lives here because every command in this namespace commits through it." + (:require [arthur.domain.bring :as bring] + [arthur.domain.clip :as clip] [arthur.domain.node :as node] [arthur.domain.symbol :as symbol])) @@ -30,32 +53,43 @@ "Commit `nodes` as symbol `sid`'s, or refuse. THE SHOT LENGTH IS AUTHORED. `:frames` is the symbol's window — how long the - shot IS — and the occupied extent of its lanes is a different fact derived - from the cels. A command may GROW the window when the caller says - `:grow-symbol`, and never shrinks it: emptying the end of a shot leaves a shot - with empty frames at the end, which is a true statement about what somebody - authored. Deriving the window from the extent instead would make deleting the - last drawing silently shorten the film. + shot IS — and where its clips reach is a different fact derived from them. A + command may GROW the window when the caller says `:grow-symbol`, and never + shrinks it: emptying the end of a shot leaves a shot with empty frames at the + end, which is a true statement about what somebody authored. Deriving the window + from the reach instead would make deleting the last drawing silently shorten the + film. So there are two numbers and this function keeps them apart: `needed` is where - the cels reach, `:frames` is what was authored, and the only way the - second follows the first is a caller asking. + the clips reach, `:frames` is what was authored, and the only way the second + follows the first is a caller asking. - Only LANES are measured for reach. A node placed straight in a shot may hang - off the end of it — that is an ordinary thing to author and the window is - what crops it — whereas a lane's cels are a sequence whose length is the - thing being edited." + Only a symbol drawn AS A LANE is measured for reach. A node placed into a + composition may hang off the end of it — that is an ordinary thing to author and + the window is what crops it — whereas a lane's clips are a sequence whose length + is the thing being edited. + + THE OVERLAP INVARIANT IS ENFORCED HERE, and here is the only place it needs to + be: this is the single commit path for every sequence command, it validates + before it returns, and it refuses rather than half-applying. So no command can + commit an overlap in lane mode, and `symbol/overlaps` turning up anything is a + bug in a command rather than a state to design around." [clip sid nodes selection extent] (let [sym (clip/symbol clip sid) - reach (for [[id n] nodes :when (node/lane? n) - child (symbol/lane-clips nodes id) - :let [m (symbol/frame-map nodes id) - end (second (node/placed-span child))]] - (when m (+ (:at m) (/ end (:rate m))))) - needed (js/Math.ceil (apply max 0 (keep identity reach))) - ps (symbol/problems (assoc sym :nodes nodes))] + lane? (symbol/lane? sym) + after (assoc sym :nodes nodes) + needed (if-not lane? + 0 + (js/Math.ceil (apply max 0 (keep #(second (node/placed-span %)) + (symbol/children nodes))))) + ps (symbol/problems after) + clashing (when lane? (symbol/overlaps after))] (cond (seq ps) {:refused (first ps)} + (seq clashing) + {:refused (str "that would put " (pr-str (ffirst clashing)) " and " + (pr-str (second (first clashing))) + " on screen over the same frames of a lane")} (not (#{:keep :grow-symbol} extent)) {:refused "choose an explicit shot-length policy"} (and (> needed (:frames sym)) (= :keep extent)) {:refused (str "the edit needs " needed " frames; extend the shot to continue") @@ -73,7 +107,7 @@ ;; and `:playback` are untouched — which is why trimming the front of a playing ;; insert starts it later in its source instead of resetting it, and why the two ;; halves of a split go on meaning what the one node meant. -;; Trim, split and `lane/blank` are all this one operation, applied differently. +;; Trim, split and `blank` are all this one operation, applied differently. (defn local "Parent frame `f` as one of `n`'s own frames." @@ -89,8 +123,10 @@ (defn host-frame "Symbol frame `f` as a frame of the space node `id` is POSITIONED in — its parent's — which is the frame space every command here takes its coordinate - in. Nil through a stepped or looping ancestor, where one frame of the symbol - is not one frame of the parent and there is no single answer to give." + in. For a clip of a lane that is the symbol's own frames, because the symbol is + the container and the clip has no parent. Nil through a stepped or looping + ancestor, where one frame of the symbol is not one frame of the parent and there + is no single answer to give." [clip sid id f] (let [nodes (get-in clip [:symbols sid :nodes])] (when-let [{:keys [at rate]} (symbol/frame-map nodes (:parent (get nodes id)))] @@ -98,7 +134,7 @@ (defn- subject "The node `id` names, as `{:node n}`, or `{:refused why}` where these commands - have nothing to act on. The one guard all three share." + have nothing to act on. The one guard they share." [nodes id] (let [n (get nodes id)] (cond @@ -109,6 +145,13 @@ {:refused "this is on screen for the whole shot, so it has no edges to cut"} :else {:node n}))) +(defn- siblings + "The other clips of `sid`'s sequence, or nil where `sid` is not drawn as a lane + and so has no sequence to re-span." + [clip sid nodes id] + (when (symbol/lane? (clip/symbol clip sid)) + (remove #(= id (:id %)) (symbol/children nodes)))) + (defn split "Cut node `id` in two at parent frame `cut`. The left piece keeps its identity; the right gets `new-id`. @@ -125,8 +168,8 @@ THE RIGHT PIECE KEEPS THE ORIGINAL'S `:z`. Two halves of one thing draw at one depth; nothing orders them against each other, because they are never on - screen on the same frame. Cels in a lane do not consult `:z` at all — - `symbol/lane-clips` sorts them by where they start. + screen on the same frame. A lane's clips do not consult `:z` at all — + `symbol/children` sorts them by where they start. The right piece is the selection, because it is the piece that was made." [clip sid id cut new-id] @@ -148,10 +191,10 @@ "Move one edge of node `id` to parent frame `to`, without disturbing anything else at all. - TRIM NARROWS. Lengthening a cel is `lane/extend-hold`, which carries a ripple - policy and a shot-length policy because it needs them; letting trim grow as - well would give one gesture two sets of rules and a way to overlap its - neighbour. `edge` is `:in` or `:out`. + TRIM NARROWS. Lengthening is `resize-out`, which carries a ripple policy and a + shot-length policy because it needs them; letting trim grow as well would give + one gesture two sets of rules and a way to overlap its neighbour. `edge` is + `:in` or `:out`. The source clock is untouched, so trimming the front of a playing insert starts it later INTO its animation rather than restarting it — which is the @@ -168,32 +211,18 @@ {:refused (str "frame " to " is not inside this; trim narrows it")} :else (finish clip sid (assoc nodes id (edged node edge to)) id :keep)))) -(defn resize-out - "Put one node's right edge at parent frame `to`, allowing it to grow. - - This is for an ordinary timeline clip, including audio. Lane cels use - `lane/resize-out`, because only a lane has neighbours to trim or ripple." - [clip sid id to] - (let [nodes (get-in clip [:symbols sid :nodes]) - {:keys [node refused]} (subject nodes id) - [lo _] (when node (node/placed-span node))] - (cond - refused {:refused refused} - (not (integer? to)) {:refused "an edge goes to a whole frame"} - (not (< lo to)) {:refused "a clip must keep at least one frame"} - :else (finish clip sid (assoc nodes id (edged node :out to)) id :keep)))) - (defn move "Put node `id` at parent frame `to`, leaving its own length, source and - corrections alone — and, in a lane, every other cel. + corrections alone — and, in a lane, every other clip. One write to `:time :at`. A destination that would overlap a neighbour IN A LANE is refused rather than rippled or overwritten: moving a drawing and re-timing the ones around it are different intentions, and a move that silently pushed the rest would be the second one wearing the first one's name. - Clear the room first — `lane/blank` makes a gap, `trim` shortens a neighbour. - Outside a lane there is no such rule to break: things placed in a composition - are allowed to be on screen together, so the move simply happens." + Clear the room first — `blank` makes a gap, `trim` shortens a neighbour — or + say you meant to claim it, which is `adopt`, what a body drag does. + Outside lane mode there is no such rule to break: things placed in a + composition are allowed to be on screen together, so the move simply happens." [clip sid id to] (let [nodes (get-in clip [:symbols sid :nodes]) {:keys [node refused]} (subject nodes id)] @@ -205,3 +234,488 @@ (if (not= to (first (node/placed-span moved))) {:refused "timing through a stepped or looping parent is not supported"} (finish clip sid (assoc nodes id moved) id :keep)))))) + +;; --------------------------------------------------------------------------- +;; the sequence: one edge edit, with the siblings re-spanned around it + +(defn- trimmed-into-a-sequence + "`nodes` with every clip's right edge pulled back to where the next one starts, + and any clip the next one wholly covers removed. + + THE SAME CLAIM-TIME RULE, APPLIED ALL AT ONCE. Later claims from earlier + everywhere it has to, which is the rule every other command here follows one + edit at a time; doing it as a pass is only what makes the answer to \"make this + a lane\" one undo step." + [nodes] + (reduce + (fn [ns [earlier later]] + (let [[lo hi] (node/placed-span (get ns (:id earlier))) + [next-lo _] (node/placed-span later)] + (cond + (nil? lo) ns + (<= hi next-lo) ns + (<= next-lo lo) (dissoc ns (:id earlier)) + :else (assoc ns (:id earlier) (edged (get ns (:id earlier)) :out next-lo))))) + nodes + (partition 2 1 (symbol/children nodes)))) + +(defn draw-as-lane + "Turn symbol `sid`'s lane mode on or off. `{:clip c}` or `{:refused why}`. + + OFF IS ALWAYS POSSIBLE: a composition has no invariant to break, so dropping + the hint drops the rules with it and nothing in the document moves. + + ON IS THE ONE PLACE A PERSON CAN ASK FOR THE IMPOSSIBLE. Every other command + maintains the sequence; this one asks a symbol whose clips may already be on + screen together to start being one, and there is no answer that does not throw + frames away. So it refuses and says how many clips it would have to trim, + carrying `:required-trim` for the retry the UI offers as one button — the same + shape as `finish`'s `:required-frames`. With `trim?` it does it: later claims + from earlier, which is the rule everything else here already follows." + [clip sid on? {:keys [trim?]}] + (let [sym (clip/symbol clip sid)] + (cond + (nil? sym) {:refused "there is no such symbol"} + (not on?) {:clip (update-in clip [:symbols sid] dissoc :display)} + :else + (let [clashing (symbol/overlaps sym)] + (cond + (empty? clashing) {:clip (assoc-in clip [:symbols sid :display] :lane)} + (not trim?) + {:refused (str "drawing this as a lane means trimming " + (count clashing) " clip" + (when (< 1 (count clashing)) "s") + " that overlap a neighbour") + :required-trim (count clashing)} + :else + (let [nodes (trimmed-into-a-sequence (:nodes sym)) + after (assoc sym :nodes nodes :display :lane)] + (if (seq (symbol/overlaps after)) + {:refused "these clips cannot be trimmed into a sequence"} + {:clip (assoc-in clip [:symbols sid] after)}))))))) + +(defn resize-out + "Put clip `id`'s right edge at parent frame `to`, allowing it to grow. + + IN A LANE this claims time. Without `ripple?`, growing consumes the starts of + the clips it reaches: wholly covered clips disappear and the last partially + covered one is trimmed. Shrinking leaves a gap. With `ripple?`, every clip + beginning at or after the old edge moves by the same delta, in either + direction, so their contents are preserved. Either way there is no overlap, + because the operation that could have made one did not. + + OUTSIDE A LANE it is one write to one span and nothing else moves, because + things placed in a composition are allowed to be on screen together. One + gesture, and the mode says which rule it plays by." + [clip sid id to {:keys [extent ripple?] :or {extent :keep ripple? false}}] + (let [nodes (get-in clip [:symbols sid :nodes]) + {:keys [node refused]} (subject nodes id) + [lo old-out] (when node (node/placed-span node)) + later (when node + (filter #(>= (first (node/placed-span %)) old-out) + (siblings clip sid nodes id)))] + (cond + refused {:refused refused} + (not (integer? to)) {:refused "an edge goes to a whole frame"} + (not (< lo to)) {:refused "a clip must keep at least one frame"} + (= to old-out) {:clip clip :selection id} + :else + (let [delta (- to old-out) + resized (assoc nodes id (edged node :out to)) + changed + (if ripple? + (reduce (fn [ns sibling] + (update-in ns [(:id sibling) :time :at] (fnil + 0) delta)) + resized later) + (if (pos? delta) + (reduce + (fn [ns sibling] + (let [[s e] (node/placed-span sibling)] + (cond + (>= s to) ns + (<= e to) (dissoc ns (:id sibling)) + :else (assoc ns (:id sibling) (edged sibling :in to))))) + resized later) + resized))] + (finish clip sid changed id extent))))) + +(defn resize-in + "Put clip `id`'s left edge at parent frame `to`. Shrinking leaves a gap; + in a lane, growing left consumes earlier clips symmetrically with `resize-out`." + [clip sid id to] + (let [nodes (get-in clip [:symbols sid :nodes]) + {:keys [node refused]} (subject nodes id) + [old-in hi] (when node (node/placed-span node)) + earlier (when node + (filter #(<= (second (node/placed-span %)) old-in) + (siblings clip sid nodes id)))] + (cond + refused {:refused refused} + (not (integer? to)) {:refused "an edge goes to a whole frame"} + (not (< to hi)) {:refused "a clip must keep at least one frame"} + (neg? to) {:refused "a clip cannot begin before the shot"} + (= to old-in) {:clip clip :selection id} + :else + (let [resized (assoc nodes id (edged node :in to)) + changed (if (< to old-in) + (reduce + (fn [ns sibling] + (let [[s e] (node/placed-span sibling)] + (cond + (<= e to) ns + (>= s to) (dissoc ns (:id sibling)) + :else (assoc ns (:id sibling) (edged sibling :out to))))) + resized earlier) + resized)] + (finish clip sid changed id :keep))))) + +(defn roll + "Move the shared boundary between adjacent clips `left-id` and `right-id`. + This is deliberately only the composition of the two ordinary edge edits." + [clip sid left-id right-id to] + (let [nodes (get-in clip [:symbols sid :nodes]) + left (get nodes left-id) + right (get nodes right-id) + [llo lhi] (when left (node/placed-span left)) + [rlo rhi] (when right (node/placed-span right))] + (cond + (not (symbol/lane? (clip/symbol clip sid))) + {:refused "a rolling edit needs a symbol drawn as a lane"} + (not (and llo rlo (nil? (:parent left)) (nil? (:parent right)))) + {:refused "a rolling edit needs two clips of one sequence"} + (not= lhi rlo) {:refused "a rolling edit needs one shared boundary"} + (not (integer? to)) {:refused "a clip edge goes to a whole frame"} + (not (< llo to rhi)) {:refused "both clips must keep at least one frame"} + :else + (let [left-result (resize-out clip sid left-id to {})] + (if (:refused left-result) + left-result + (resize-in (:clip left-result) sid right-id to)))))) + +(defn blank + "Clear frames `[a b)` of symbol `sid`, leaving a GAP. + + A gap is not a drawing. Nothing is invented to cover those frames and nothing + closes the hole — the clips after it stay where they are, because emptying + frames and re-timing a performance are different intentions. + + What it does to each clip it meets is `edged`, applied three ways: one wholly + inside is removed, one overlapping an end is trimmed to it, and the one that + spans the whole range is split, which is the only case that needs `id`. Their + drawings stay in the library — a symbol does not own its content, and a drawing + whose last clip is gone is still a drawing somebody made." + [clip sid [a b] {:keys [id]}] + (let [nodes (get-in clip [:symbols sid :nodes]) + lane? (symbol/lane? (clip/symbol clip sid)) + members (when lane? (symbol/children nodes)) + spanning (when members + (first (filter #(let [[lo hi] (node/placed-span %)] (and (< lo a) (> hi b))) + members)))] + (cond + (not lane?) {:refused "clearing a range of frames needs a symbol drawn as a lane"} + (not (and (integer? a) (integer? b) (< a b))) + {:refused "a range to blank is whole frames, and not empty"} + (and spanning (or (nil? id) (contains? nodes id))) + {:refused "blanking inside one clip splits it, which needs a free ID for the remainder"} + :else + (let [nodes (reduce + (fn [ns n] + (let [[lo hi] (node/placed-span n)] + (cond + (or (<= hi a) (>= lo b)) ns + (and (< lo a) (> hi b)) + (-> ns + (assoc (:id n) (edged n :out a)) + (assoc id (assoc (edged n :in b) :id id :z (str "a-" id)))) + (and (>= lo a) (<= hi b)) (dissoc ns (:id n)) + (< lo a) (assoc ns (:id n) (edged n :out a)) + :else (assoc ns (:id n) (edged n :in b))))) + nodes members)] + ;; NOTHING SENSIBLE IS SELECTED by emptying frames, so nothing is: a + ;; split names its remainder, and otherwise the caller keeps whatever was + ;; selected rather than being handed a clip it did not ask for. + (finish clip sid nodes (when spanning id) :keep))))) + +(defn- cleared + "`clip` with frames `[at (+ at duration))` of `sid` emptied where `sid` is drawn + as a lane, and untouched where it is not: outside lane mode a placement does not + claim time, because being on screen together is what compositing IS. + + `{:clip c}` or `{:refused why}`, so one `if-let` covers both." + [clip sid at duration remainder-id] + (if-not (symbol/lane? (clip/symbol clip sid)) + {:clip clip} + (blank clip sid [at (+ at duration)] {:id remainder-id}))) + +(defn extend-hold + "Change one held clip's duration by `delta` frames and ripple its later + siblings. Keys, source clocks and the clips' own channels stay put. + Returns {:clip :selection} or {:refused :required-frames?}; never partially edits." + [clip sid id delta {:keys [extent] :or {extent :keep}}] + (let [nodes (get-in clip [:symbols sid :nodes]) + n (get nodes id) + rate (:rate (node/time-of n)) + span (:span n)] + (cond + (not (symbol/lane? (clip/symbol clip sid))) + {:refused "a hold is lengthened in a symbol drawn as a lane"} + (nil? (node/placed-span n)) {:refused "select a clip in the lane"} + (some? (:parent n)) {:refused "select a clip of the lane itself"} + (not (and (integer? delta) (not (zero? delta)))) {:refused "hold change must be a nonzero whole number of frames"} + (not (zero? (:speed (node/playback-of n)))) {:refused "hold length applies to a held drawing"} + (<= (+ (second span) (* rate delta)) (first span)) {:refused "a drawing must keep a positive exposure"} + :else + (let [[_ boundary] (node/placed-span n) + later (filter #(>= (first (node/placed-span %)) boundary) + (siblings clip sid nodes id)) + nodes (assoc-in nodes [id :span 1] (+ (second span) (* rate delta))) + nodes (reduce (fn [ns sibling] + (update-in ns [(:id sibling) :time :at] (fnil + 0) delta)) + nodes later)] + (finish clip sid nodes id extent))))) + +(defn place-symbol + "Place arbitrary symbol `source-id` into `sid` as a naturally playing clip at + frame `at`. + + IN A LANE the new clip claims its interval: existing clips under it are + trimmed, removed, or split, so the sequence stays a partition rather than + storing an overlap. Outside one it is simply placed. This is the generic + operation behind dropping a library symbol into the timeline; one-frame held + drawing creation remains a policy of `append-drawing`/`overwrite-drawing`, + not a different kind of container." + [clip store sid id source-id at + {:keys [extent point remainder-id] :or {extent :keep}}] + (let [nodes (get-in clip [:symbols sid :nodes]) + seeded (clip/place-symbol clip store sid source-id 0 id point) + n (get-in seeded [:symbols sid :nodes id]) + duration (when n (- (second (node/placed-span n)) + (first (node/placed-span n))))] + (cond + (contains? nodes id) {:refused "the new clip ID is already used"} + (not (and (integer? at) (not (neg? at)))) + {:refused "a position is a nonnegative whole frame"} + (nil? (clip/symbol clip source-id)) {:refused "there is no such symbol to place"} + (nil? n) {:refused "a symbol cannot go inside itself"} + (not (pos? duration)) {:refused "the symbol has no frames to place"} + (and remainder-id (contains? nodes remainder-id)) + {:refused "the remainder clip needs a free ID"} + :else + (let [room (cleared clip sid at duration remainder-id)] + (if (:refused room) + room + (let [nodes (assoc (get-in (:clip room) [:symbols sid :nodes]) id + (assoc-in n [:time :at] at))] + (finish (:clip room) sid nodes id extent))))))) + +(defn adopt + "Move an existing clip of `sid` to frame `at`, CLAIMING the time it lands on. + + Its source, span, transforms, corrections, and identity come with it; in a lane + the destination interval is claimed with the same trimming as a pool drop. This + is what a body drag does, and it is why `move` and this are two commands: + `move` refuses to disturb a neighbour, and a drag onto occupied time has + already said it means to." + [clip sid id at {:keys [extent remainder-id] :or {extent :keep}}] + (let [nodes (get-in clip [:symbols sid :nodes]) + n (get nodes id) + [lo hi] (when n (node/placed-span n)) + duration (when (and lo hi) (- hi lo))] + (cond + (nil? n) {:refused "select a clip to move"} + (some? (:parent n)) {:refused "only a clip of the symbol itself is placed in its sequence"} + (not (and (integer? at) (not (neg? at)))) + {:refused "a position is a nonnegative whole frame"} + (not (pos? duration)) {:refused "the clip has no frames to place"} + (and remainder-id (contains? nodes remainder-id)) + {:refused "the remainder clip needs a free ID"} + :else + (let [room (cleared (assoc-in clip [:symbols sid :nodes] + (dissoc nodes id)) + sid at duration remainder-id)] + (if (:refused room) + room + (let [moved (update-in n [:time :at] (fnil + 0) (- at lo)) + nodes (assoc (get-in (:clip room) [:symbols sid :nodes]) id moved)] + (finish (:clip room) sid nodes id extent))))))) + +;; --------------------------------------------------------------------------- +;; putting drawings in a sequence + +(defn- held + "A one-frame held clip of `drawing-id`, starting at frame `at`. + + Held rather than playing, and one frame rather than the length of what it + places: a clip's duration is the sequence's business — `extend-hold` and + `resize-out` are how it changes — and reading it off the content would make + placing a ten-frame animation and holding its first drawing the same gesture." + [id drawing-id at] + {:id id :kind :instance :z (str "a-" id) + :span [0 1] :time {:at at :rate 1} + :source {:symbol drawing-id} :playback {:in 0 :speed 0 :end :stop}}) + +(defn- sequence-end + "Where `sid`'s occupied frames stop." + [nodes] + (apply max 0 (map #(second (node/placed-span %)) (symbol/children nodes)))) + +(defn- place + "Put a held clip of `drawing-id` into `sid` at frame `at`, and RIPPLE: + everything starting at or after it moves later by its duration. + + There is one placement function and `:end` is a position like any other, so + appending is not a different operation from inserting — the end is just where + nothing has to move. Overwriting is the other policy and is NOT this: taking + frames away from the clip already there is trimming, which is its own command + and not something placing a drawing should do on the quiet. + + `:frame` in the result is where it landed, in the symbol's own frames, for a + caller that wants to look at what it just made." + [clip sid id drawing-id at extent ripple?] + (let [nodes (get-in clip [:symbols sid :nodes]) + at (if (= :end at) (sequence-end nodes) at) + n (held id drawing-id at) + [lo hi] (node/placed-span n) + ;; RIPPLE FOLLOWS THE MODE. Pushing later siblings is what inserting + ;; into a sequence means; in a composition there is no "later sibling" + ;; to push, because being on screen together is the point. + later (when (and ripple? (symbol/lane? (clip/symbol clip sid))) + (filter #(>= (first (node/placed-span %)) lo) (symbol/children nodes))) + nodes (reduce (fn [ns sibling] + (update-in ns [(:id sibling) :time :at] (fnil + 0) (- hi lo))) + (assoc nodes id n) later) + result (finish clip sid nodes id extent)] + (cond-> result + (:clip result) (assoc :frame at)))) + +(defn- placeable + "Why a held clip cannot go into `sid` at `at`, or nil." + [clip sid id at] + (let [nodes (get-in clip [:symbols sid :nodes]) + ;; INSIDE a clip is not a position for another one, IN A LANE. Splitting + ;; that clip is what makes it two, and doing it here would be one command + ;; quietly performing two: the caller asks for `split` and then places. + ;; In a composition landing inside something is not a collision at all. + inside (when (and (number? at) (symbol/lane? (clip/symbol clip sid))) + (some (fn [n] (let [[lo hi] (node/placed-span n)] + (when (< lo at hi) n))) + (symbol/children nodes)))] + (cond + (contains? nodes id) "the new clip ID is already used" + (not (or (= :end at) (and (integer? at) (not (neg? at))))) + "a position is :end or a whole frame" + inside (str "frame " at " is inside a clip; split it first")))) + +(defn append-drawing + "Append fresh empty content and a held clip of it. IDs come from the + caller so a command is deterministic and replayable. + + Fresh content, not a blank range: a sequence with no clip over a frame shows + nothing there already, and a drawing nobody has drawn in is a different thing + from a gap." + [clip sid id drawing-id {:keys [at extent] :or {extent :keep at :end}}] + (if-let [why (or (placeable clip sid id at) + (when (clip/symbol clip drawing-id) "the new drawing ID is already used"))] + {:refused why} + (place (assoc-in clip [:symbols drawing-id] + {:id drawing-id :name (name drawing-id) :fps (clip/fps clip sid) :frames 1 :nodes {}}) + sid id drawing-id at extent true))) + +(defn reuse-drawing + "Append a held clip of content the document ALREADY has, so the same + drawing is exposed twice and editing it changes both clips. + + This is the command `make-unique` is the undo of, and the reason they are two + commands: reuse is a decision to share, and sharing is not something to + discover later when an edit turns up somewhere else." + [clip sid id drawing-id {:keys [at extent] :or {extent :keep at :end}}] + (if-let [why (or (placeable clip sid id at) + (when-not (clip/symbol clip drawing-id) "there is no such drawing to reuse") + ;; Placing something that contains this symbol would close a + ;; loop, and a sequence is no different from any other placement. + (when (clip/contains-symbol? clip drawing-id sid) + "a symbol cannot go inside itself"))] + {:refused why} + (place clip sid id drawing-id at extent true))) + +(defn- copied + "A copy of symbol `from`, as `{:clip :id}`. + + SHALLOW by default: its own nodes and channels are copied, and its references + to other symbols are kept, so a head built out of reusable eyes still uses + those eyes. `deep?` copies everything it places as well, with new ids + throughout, for a drawing that must share nothing — the distinction the + shallow copy cannot make on its own, and a promise of independence that only + the deep one keeps." + [clip from deep?] + (if deep? + (let [{c :clip ids :ids} (bring/symbols clip clip [from] {})] + {:clip c :id (ids from)}) + (let [id (clip/free-id (:symbols clip) from)] + {:clip (assoc-in clip [:symbols id] (assoc (clip/symbol clip from) :id id)) + :id id}))) + +(defn duplicate-drawing + "Append a held clip of a COPY of what clip `id` places, for when + the drawing on screen is the starting point for the next one. + + The copy is of the content only. The new clip is a plain one-frame hold + rather than a copy of `id`'s own transform or corrections: those belong to + that clip, and carrying them over would make duplicating a drawing quietly + duplicate the treatment of one use of it." + [clip sid id new-id {:keys [at extent deep?] :or {extent :keep at :end}}] + (let [n (get-in clip [:symbols sid :nodes id]) + from (node/source n)] + (if-let [why (or (when-not from "select a clip to duplicate") + (when-not (clip/symbol clip from) "the drawing it places is missing") + (placeable clip sid new-id at))] + {:refused why} + (let [{c :clip copy :id} (copied clip from deep?)] + (place c sid new-id copy at extent true))))) + +(defn overwrite-drawing + "Put a fresh one-frame drawing at frame `at`, replacing whatever was there and + leaving every other clip where it was. + + This is `blank` and placement composed in ONE command and therefore one undo + step. `remainder-id` is used only when clearing the frame cuts one clip into + two; ids still come from the caller because this namespace is pure." + [clip sid id drawing-id at {:keys [extent remainder-id] :or {extent :keep}}] + (let [nodes (get-in clip [:symbols sid :nodes])] + (if-let [why (cond + (not (and (integer? at) (not (neg? at)))) + "a position is a nonnegative whole frame" + (contains? nodes id) "the new clip ID is already used" + (or (= id remainder-id) (contains? nodes remainder-id)) + "the remainder clip needs a free ID different from the new clip" + (clip/symbol clip drawing-id) "the new drawing ID is already used")] + {:refused why} + (let [room (cleared clip sid at 1 remainder-id)] + (if (:refused room) + room + (place (assoc-in (:clip room) [:symbols drawing-id] + {:id drawing-id :name (name drawing-id) :fps (clip/fps clip sid) :frames 1 :nodes {}}) + sid id drawing-id at extent false)))))) + +(defn make-unique + "Point clip `id` at a private copy of its content, leaving every other + clip of that drawing sharing the original. + + Refused when nothing else uses it: a drawing with one clip is already + unique, and answering with a silent copy would leave a second identical symbol + in the library for no reason a person could see." + [clip sid id {:keys [deep?]}] + (let [n (get-in clip [:symbols sid :nodes id]) + from (node/source n) + elsewhere (for [[osid osym] (:symbols clip) + [oid on] (:nodes osym) + :when (and (= from (node/source on)) (not= [sid id] [osid oid]))] + [osid oid])] + (if-let [why (or (when-not from "select a clip to make unique") + (when-not (clip/symbol clip from) "the drawing it places is missing") + (when (empty? elsewhere) "nothing else uses this drawing"))] + {:refused why} + (let [{c :clip copy :id} (copied clip from deep?) + c (assoc-in c [:symbols sid :nodes id :source :symbol] copy) + ps (clip/problems c)] + (if (seq ps) {:refused (first ps)} {:clip c :selection id}))))) diff --git a/frontend/src/arthur/domain/symbol.cljs b/frontend/src/arthur/domain/symbol.cljs index bd8783b..9bf97e1 100644 --- a/frontend/src/arthur/domain/symbol.cljs +++ b/frontend/src/arthur/domain/symbol.cljs @@ -96,16 +96,25 @@ [nodes id] (dec (count (lineage nodes id)))) -(defn lane-clips - "The symbol clips of lane `lane`, in timeline order. +(defn children + "The symbol's own clips — the nodes placed directly in it — in timeline order. - Sorted by where they START, not by `:z`: a lane's blocks follow one another in - time, and two of them cannot be in the same place for `:z` to decide between. - Ties go to the id so the order is the same on every run." - [nodes lane] + THE SYMBOL IS THE CONTAINER. There is no lane node to ask for its members: a + symbol drawn as a lane draws THESE, and the sequence commands re-span THESE. + See `docs/lane-is-a-view-plan.md`. + + Sorted by where they START, not by `:z`: blocks in a sequence follow one + another in time, and two of them cannot be in the same place for `:z` to + decide between. Ties go to the id so the order is the same on every run. + + A NODE WITH NO SPAN IS NOT IN THE SEQUENCE. A shape on screen for the whole + shot has no `[in out)` to follow anything else, so it is not something an edge + edit can trim or ripple, and a command that destructured its nil span would + fail on the most ordinary node there is." + [nodes] (->> (vals nodes) - (filter #(= lane (:parent %))) - (sort-by (juxt #(or (first (node/placed-span %)) 0) #(str (:id %)))) + (filter #(and (nil? (:parent %)) (node/placed-span %))) + (sort-by (juxt #(first (node/placed-span %)) #(str (:id %)))) vec)) (defn frame-map @@ -131,61 +140,47 @@ (<= (or (:expose t) 1) 1)) (recur (:parent n) (conj seen id) (conj chain n))))))) -(defn lanes - "The symbol's lanes, front-most first. +(defn lane? + "Whether symbol `sym` is DRAWN as a lane: its clips as blocks on one row, + following one another in time and claiming it from each other. - SAME ORDER THE TIMELINE DRAWS ITS ROWS IN — `:z` descending, the id breaking - ties so it is stable across runs, so \"the first lane\" means the same thing - to the view that shows it and to commands that inspect the lane order. + A DISPLAY HINT AND NOT A TYPE. Nothing in evaluation reads it, `problems` does + not check it, and a symbol carrying it behaves identically on the stage — it + says how the timeline draws the symbol and, because the editing rules follow + the mode, which rules an edge drag inside it plays by. It is on the symbol + rather than in editor state so that those rules are reproducible between two + people looking at one document, and it is a field rather than something derived + from \"the clips do not currently overlap\" because a symbol must not stop being + a lane the moment something overlaps — that is when the rules are needed. - Only this symbol's own: a lane inside a nested instance belongs to that - symbol, and aiming a drawing at it is entering it first." - [nodes] - (->> (vals nodes) - (filter node/lane?) - (sort-by (fn [n] [(or (:z n) "") (str (:id n))])) - reverse - vec)) + The only things allowed to read it are the timeline and `span/finish`'s + overlap check. See `docs/lane-is-a-view-plan.md`." + [sym] + (= :lane (:display sym))) -(defn lane-problems - "What makes a lane not a lane. A SEQUENCE is the one composition rule the node - map carries — ordinary groups compose freely — so it is checked here, beside - the parent and stencil references, rather than wherever a command happens to - build one. +(defn overlaps + "The pairs of `sym`'s clips that are on screen over the same frames, as + `[[a b] ...]` of ids. Empty for a symbol whose clips form a sequence. - Clips must be finite and non-overlapping. An accidental overlap - is refused rather than resolved by draw order: two drawings exposed on one - frame of one lane is a document nobody meant to write, and picking a winner - would hide it. Empty lanes are valid — a lane is made before it is filled. + A BUG REPORT, NOT A CONDITION TO DESIGN AROUND. In lane mode this cannot + happen: placing claims time, so anything placed, moved or grown over occupied + frames TRIMS what it lands on, and `span/finish` — the one commit path for + every sequence command — refuses rather than committing one. So an overlap that + appears anyway is a defect in a command. - A SOUND IS A CLIP TOO. A lane is the one temporal container, so audio sits in - one on the same terms as picture: its own frames in `:span`, where they land - in `:time`, and no overlap with its neighbours. What a lane may NOT hold is a - mixture, and that is the explicit capability the model wanted rather than a - per-frame guess: all picture or all sound, so what the lane does with the - frame it owns is answered by the lane and not by the clip that happens to be - under the playhead." - [nodes] - (vec - (mapcat - (fn [[id lane]] - (when (node/lane? lane) - (let [children (filter #(= id (:parent %)) (vals nodes)) - valid? (fn [n] - (and (contains? #{:instance :audio} (:kind n)) - (empty? (node/problems n)) - (:span n) - (every? node/finite-number? (node/placed-span n)))) - kept (filter valid? children) - intervals (sort-by first (map node/placed-span kept))] - (concat - (for [n children :when (not (valid? n))] - (str "sequence " id " needs finite symbol or sound clips: " (:id n))) - (when (< 1 (count (into #{} (map :kind) kept))) - [(str "lane " id " holds picture or sound, not both")]) - (when (some (fn [[[_ b] [c _]]] (> b c)) (partition 2 1 intervals)) - [(str "lane " id " has overlapping clips")]))))) - nodes))) + Which is why it is NOT `clip/problems`, which means the document will not load: + a display hint must never be able to stop a document loading, and a document + that somehow arrives holding an overlap still opens and is drawn visibly wrong. + Nor `clip/conflicts`, which means a person has a decision to make. This is + neither." + [sym] + (let [spans (for [n (children (:nodes sym)) + :let [[lo hi] (node/placed-span n)] + :when (and (node/finite-number? lo) (node/finite-number? hi))] + [lo hi (:id n)])] + (vec (for [[[_ b x] [c _ y]] (partition 2 1 (sort-by (juxt first second str) spans)) + :when (> b c)] + [x y])))) (defn order "Node ids in topological order: every node after its parent. @@ -708,8 +703,12 @@ and saved leaves point at, so renaming a symbol must not change it. `:width` and `:height` are the symbol's own stage, and are absent until someone - sets them: a symbol without them uses the clip's — see `clip/stage`." - #{:id :name :frames :fps :width :height :nodes :palette}) + sets them: a symbol without them uses the clip's — see `clip/stage`. + + `:display` is how the TIMELINE draws the symbol — `:lane` for its clips as + blocks on one row — and is saved because two people editing one document must + play by the same editing rules. See `lane?`." + #{:id :name :frames :fps :width :height :nodes :palette :display}) (defn problems "Human-readable reasons this symbol will not evaluate. Empty means it will. @@ -727,7 +726,6 @@ (if-not (map? nodes) [":nodes must be a map of id -> node"] (-> [] - (into (lane-problems nodes)) (into (for [[id n] nodes :when (not= id (:id n))] (str "node under key " (pr-str id) " has :id " (pr-str (:id n))))) diff --git a/frontend/src/arthur/events/footage.cljs b/frontend/src/arthur/events/footage.cljs index 374b1bb..f1d2e39 100644 --- a/frontend/src/arthur/events/footage.cljs +++ b/frontend/src/arthur/events/footage.cljs @@ -6,7 +6,7 @@ address of every block this produces." (:require [arthur.domain.bring :as bring] [arthur.domain.clip :as clip] - [arthur.domain.lane :as lane] + [arthur.domain.span :as span] [arthur.events.edit :as edit] [arthur.events.ui :as ui] [arthur.events.playback :as pb] @@ -497,9 +497,8 @@ (rf/reg-event-fx ::converted - ;; A TAKE IS A CLIP IN A LANE, like everything else that enters the timeline. - ;; It used to be placed straight into the open symbol as a row of its own, - ;; which was the one way to get temporal content that no lane owned. + ;; A TAKE IS A CLIP LIKE ANY OTHER, placed into whichever symbol the drop names + ;; — see `ui/drop-destination` — rather than into a container invented for it. (fn [{:keys [db]} [_ {{:keys [name frame point range target]} :request footage-id :footage-id} built]] (let [entry (store/entry (:clip/current db)) @@ -510,10 +509,10 @@ st (merge (:store entry) (:store built)) imported-frames (clip/output-frames clip sid) source-fps (get-in built [:clip :fps]) - where (ui/lane-destination db clip st frame target :picture) + where (ui/drop-destination db clip st frame target) result (if (:refused where) where - (lane/place-symbol (:clip where) st (:sid where) (:lane-id where) + (span/place-symbol (:clip where) st (:sid where) uuid sid (:at where) {:extent :grow-symbol :point point :remainder-id (random-uuid)}))] @@ -528,9 +527,6 @@ :source-inputs]))))] {:db (-> db (update :ui dissoc :convert) - (cond-> (:made? where) - (assoc-in [:ui :target] {:sid (:sid where) :id (:lane-id where) - :path [(:lane-id where)]})) (assoc-in [:ui :selection] [:node (:sid where) uuid (conj (vec (:path where)) uuid)]) (update :footage merge diff --git a/frontend/src/arthur/events/project.cljs b/frontend/src/arthur/events/project.cljs index 9bab3fd..d4ada08 100644 --- a/frontend/src/arthur/events/project.cljs +++ b/frontend/src/arthur/events/project.cljs @@ -24,6 +24,7 @@ (:require [arthur.db :as db] [arthur.domain.bring :as bring] [arthur.domain.clip :as clip] + [arthur.domain.span :as span] [arthur.domain.leaf :as leaf] [arthur.domain.node :as node] [arthur.events.edit :as edit] @@ -35,7 +36,6 @@ [arthur.events.footage :as footage] [arthur.events.playback :as pb] [arthur.events.ui :as ui] - [arthur.domain.lane :as lane] [arthur.footage.store :as store] [arthur.flow.address :as address] [arthur.flow.ingest :as ingest] @@ -171,21 +171,18 @@ uuid (random-uuid) {:keys [clip ids]} (bring/symbols (:clip entry) (:clip other) [sid] {}) st (merge (:store entry) (:store other)) - ;; A symbol from another project arrives as a clip in a lane, the same + ;; A symbol from another project arrives as an ordinary clip, the same ;; as one from this project's pool. - where (ui/lane-destination db clip st frame target :picture) + where (ui/drop-destination db clip st frame target) result (if (:refused where) where - (lane/place-symbol (:clip where) st (:sid where) (:lane-id where) + (span/place-symbol (:clip where) st (:sid where) uuid (ids sid) (:at where) {:extent :grow-symbol :point point :remainder-id (random-uuid)}))] (if-let [why (or (:refused where) (:refused result))] {:db (update db :project merge {:status why})} {:db (-> (edit/edit-entry db #(assoc % :clip (:clip result) :store st)) - (cond-> (:made? where) - (assoc-in [:ui :target] {:sid (:sid where) :id (:lane-id where) - :path [(:lane-id where)]})) (assoc-in [:ui :selection] [:node (:sid where) uuid (conj (vec (:path where)) uuid)]) (update :project merge {:status (str "brought in " label)})) diff --git a/frontend/src/arthur/events/ui.cljs b/frontend/src/arthur/events/ui.cljs index fc44f4e..357a882 100644 --- a/frontend/src/arthur/events/ui.cljs +++ b/frontend/src/arthur/events/ui.cljs @@ -24,7 +24,6 @@ [arthur.domain.gesture :as gesture] [arthur.domain.nest :as nest] [arthur.domain.node :as node] - [arthur.domain.lane :as lane] [arthur.domain.span :as span] [arthur.domain.symbol :as symbol] [arthur.events.edit :as edit] @@ -56,7 +55,7 @@ [:clip :symbols sid :nodes id :kind]))] (cond-> (-> db (assoc-in [:ui :selection] selection) - (update :ui dissoc :points :lane-retry)) + (update :ui dissoc :points :retry)) (and (= :node kind) path (not sound?)) (update-in [:ui :expanded] (fnil into #{}) (rest (reductions conj [] (pop path))))))) @@ -97,46 +96,26 @@ ::set-tone (fn [db [_ tone]] (assoc-in db [:ui :tone] tone))) -(defn- aimed-lane - "The lane the target names, or nil — including nil for a target aimed at a cel - INSIDE a lane, which is the lane's business and not a lane itself." - [clip db] - (let [{:keys [sid id path]} (get-in db [:ui :target]) - n (when id (get-in clip [:symbols sid :nodes id]))] - (when (and n (node/lane? n) (= 1 (count path)) - (= sid (get-in db [:ui :open]))) - n))) - - -(defn empty-lane - "The id of a lane of `sid` that has nothing in it, or nil. - - EVERY SYMBOL IS BORN WITH A LANE, so the first thing put into one goes - there instead of beside it. An OCCUPIED lane is never chosen this way: - placing claims time, so taking a lane nobody pointed at would trim or delete - what was already in it. That is a fine thing to ask for and not a fine thing - to assume." - [document sid] - (let [nodes (get-in document [:symbols sid :nodes])] - (first (keep (fn [lane] - (when (empty? (symbol/lane-clips nodes (:id lane))) (:id lane))) - (symbol/lanes nodes))))) - -(defn apply-lane-command +(defn apply-command "Commit a successful domain command as one history step. A refused command - leaves the document and history untouched; an overflow offers an explicit retry." + leaves the document and history untouched; an overflow offers an explicit retry. + + A COMMAND NEED NOT NAME A SELECTION. Emptying frames deletes what was selected + and has nothing sensible to put in its place, so a nil `:selection` leaves the + selection alone rather than pointing it at a clip nobody asked for." [db sid result retry] (if-let [why (:refused result)] (-> db (assoc-in [:project :status] why) - (assoc-in [:ui :lane-retry] - (when (:required-frames result) retry))) + (assoc-in [:ui :retry] (when (:required-frames result) retry))) (let [[_ selected-sid _ path] (get-in db [:ui :selection]) prefix (if (and (= sid selected-sid) (seq path)) (pop path) [])] - (-> db - (edit/transaction (constantly (:clip result))) - (assoc-in [:ui :selection] [:node sid (:selection result) (conj prefix (:selection result))]) - (update :ui dissoc :lane-retry))))) + (cond-> (-> db + (edit/transaction (constantly (:clip result))) + (update :ui dissoc :retry)) + (:selection result) + (assoc-in [:ui :selection] + [:node sid (:selection result) (conj prefix (:selection result))]))))) (defn apply-correction-command "Commit one correction command while keeping the complete row address that @@ -170,17 +149,19 @@ db (correction/retry-layer clip sid id path layer-id))))) (rf/reg-event-db - ::new-lane - ;; AND AIMED AT, because the reason to make a lane is to draw in it: `add-lane` - ;; returns the new lane as its selection, and `apply-lane-command` has already - ;; worked out the row path that addresses it. - (fn [db _] + ::draw-as-lane + ;; THE ONE PLACE A PERSON CAN ASK FOR THE IMPOSSIBLE. Everything else maintains + ;; the sequence; this asks a symbol whose clips may already overlap to start + ;; being one. `span/draw-as-lane` refuses and says what it would have to trim, + ;; and `::retry` is the one button that says do it. + (fn [db [_ sid on? trim?]] (let [clip (:clip (store/entry (:clip/current db))) - sid (get-in db [:ui :open]) - after (apply-lane-command db sid (lane/add-lane clip sid (random-uuid)) nil)] - (cond-> after - (not= (get-in after [:ui :selection]) (get-in db [:ui :selection])) - (assoc-in [:ui :target] (target-of (get-in after [:ui :selection]))))))) + result (span/draw-as-lane clip sid on? {:trim? trim?})] + (if-let [why (:refused result)] + (-> db (assoc-in [:project :status] why) + (assoc-in [:ui :retry] (when (:required-trim result) [::draw-as-lane sid on? true]))) + (-> db (edit/transaction (constantly (:clip result))) + (update :ui dissoc :retry)))))) (defn- committed "One appending command, as effects: commit it, and look at what it made. @@ -195,23 +176,17 @@ {:keys [at rate]} (:time (nest/inside clip st (get-in db [:ui :open]) (if (seq path) (pop path) []) (get-in db [:playback :frame])))] - (cond-> {:db (apply-lane-command db sid result retry)} + (cond-> {:db (apply-command db sid result retry)} (and (:clip result) (:frame result) rate) (assoc :dispatch [::playback/seek (+ at (/ (:frame result) rate))])))) -(defn- selected-lane - "The lane a command should act in: the selected lane itself, or the one - holding the selected cel." - [clip sid id] - (let [n (get-in clip [:symbols sid :nodes id])] - (if (node/lane? n) id (:parent n)))) - (defn selection-frame "The playhead as a frame of the symbol that owns `selection`. A timeline selection carries its path from the open symbol. Walking to the - parent of the selected node crosses every enclosing instance clock before a - lane command converts that owning-symbol frame into lane time." + parent of the selected node crosses every enclosing instance clock, and that + is the whole of it: a clip of a lane has no parent, so the symbol's own frames + ARE the sequence's. One clock where there used to be two." [clip st open selection frame] (let [[_ sid _ path] selection] (if (or (= sid open) (not (seq path))) @@ -223,9 +198,8 @@ (fn [{:keys [db]} [_ extent]] (let [clip (:clip (store/entry (:clip/current db))) [_ sid id] (get-in db [:ui :selection]) - result (lane/append-drawing clip sid (selected-lane clip sid id) - (random-uuid) (clip/fresh-id clip) - {:extent (or extent :keep)})] + result (span/append-drawing clip sid (random-uuid) (clip/fresh-id clip) + {:extent (or extent :keep)})] (committed db sid result [::append-drawing :grow-symbol])))) (rf/reg-event-fx @@ -233,9 +207,9 @@ (fn [{:keys [db]} [_ extent]] (let [clip (:clip (store/entry (:clip/current db))) [_ sid id] (get-in db [:ui :selection]) - result (lane/reuse-drawing clip sid (selected-lane clip sid id) (random-uuid) - (node/source (get-in clip [:symbols sid :nodes id])) - {:extent (or extent :keep)})] + result (span/reuse-drawing clip sid (random-uuid) + (node/source (get-in clip [:symbols sid :nodes id])) + {:extent (or extent :keep)})] (committed db sid result [::reuse-drawing :grow-symbol])))) (rf/reg-event-fx @@ -243,27 +217,26 @@ (fn [{:keys [db]} [_ extent deep?]] (let [clip (:clip (store/entry (:clip/current db))) [_ sid id] (get-in db [:ui :selection]) - result (lane/duplicate-drawing clip sid id (random-uuid) - {:extent (or extent :keep) :deep? deep?})] + result (span/duplicate-drawing clip sid id (random-uuid) + {:extent (or extent :keep) :deep? deep?})] (committed db sid result [::duplicate-drawing :grow-symbol deep?])))) (rf/reg-event-fx ::insert-drawing - ;; The playhead is the position: you scrub to where the drawing goes. A lane - ;; that is stepped or retimed off whole frames has no single lane frame for a - ;; symbol frame, and `lane-frame` says so rather than snapping to one. + ;; The playhead is the position: you scrub to where the drawing goes. The + ;; symbol's own frames are the sequence's, so there is nothing to convert — + ;; only an enclosing stepped or looping instance can leave the playhead on no + ;; single frame of it, which `selection-frame` says by answering nil. (fn [{:keys [db]} [_ extent]] (let [{clip :clip st :store} (store/entry (:clip/current db)) selection (get-in db [:ui :selection]) - [_ sid id] selection - lane (selected-lane clip sid id) - owner-frame (selection-frame clip st (get-in db [:ui :open]) selection - (get-in db [:playback :frame])) - at (when (number? owner-frame) (lane/lane-frame clip sid lane owner-frame)) - result (if at - (lane/append-drawing clip sid lane (random-uuid) (clip/fresh-id clip) - {:at at :extent (or extent :keep)}) - {:refused "this lane's frames are not the open symbol's"})] + [_ sid] selection + at (selection-frame clip st (get-in db [:ui :open]) selection + (get-in db [:playback :frame])) + result (if (integer? at) + (span/append-drawing clip sid (random-uuid) (clip/fresh-id clip) + {:at at :extent (or extent :keep)}) + {:refused "the playhead is not on one frame of this symbol"})] (committed db sid result [::insert-drawing :grow-symbol])))) (defn- at-playhead @@ -292,7 +265,7 @@ ::split (fn [db _] (let [{:keys [clip sid id at]} (at-playhead db)] - (apply-lane-command + (apply-command db sid (if at (span/split clip sid id at (random-uuid)) no-frame) nil)))) (rf/reg-event-fx @@ -300,30 +273,28 @@ (fn [{:keys [db]} [_ extent]] (let [{clip :clip st :store} (store/entry (:clip/current db)) selection (get-in db [:ui :selection]) - [_ sid id] selection - lane-id (selected-lane clip sid id) - owner-frame (selection-frame clip st (get-in db [:ui :open]) selection - (get-in db [:playback :frame])) - at (when (number? owner-frame) (lane/lane-frame clip sid lane-id owner-frame)) + [_ sid] selection + at (selection-frame clip st (get-in db [:ui :open]) selection + (get-in db [:playback :frame])) result (if (integer? at) - (lane/overwrite-drawing clip sid lane-id (random-uuid) (clip/fresh-id clip) at + (span/overwrite-drawing clip sid (random-uuid) (clip/fresh-id clip) at {:extent (or extent :keep) :remainder-id (random-uuid)}) - {:refused "this lane's frames are not the open symbol's"})] + {:refused "the playhead is not on one frame of this symbol"})] (committed db sid result [::overwrite-drawing :grow-symbol])))) (rf/reg-event-db ::trim (fn [db [_ edge]] (let [{:keys [clip sid id at]} (at-playhead db)] - (apply-lane-command + (apply-command db sid (if at (span/trim clip sid id edge at) no-frame) nil)))) (rf/reg-event-db ::move (fn [db _] (let [{:keys [clip sid id at]} (at-playhead db)] - (apply-lane-command + (apply-command db sid (if at (span/move clip sid id at) no-frame) nil)))) (rf/reg-event-db @@ -333,10 +304,10 @@ (fn [db _] (let [{:keys [clip sid node]} (at-playhead db) span (node/placed-span node)] - (apply-lane-command + (apply-command db sid (if (and span (every? integer? span)) - (lane/blank clip sid (:parent node) span {}) - {:refused "select a cel that starts and ends on whole lane frames"}) + (span/blank clip sid span {}) + {:refused "select a clip that starts and ends on whole frames"}) nil)))) (rf/reg-event-db @@ -344,21 +315,21 @@ (fn [db [_ deep?]] (let [clip (:clip (store/entry (:clip/current db))) [_ sid id] (get-in db [:ui :selection])] - (apply-lane-command db sid (lane/make-unique clip sid id {:deep? deep?}) nil)))) + (apply-command db sid (span/make-unique clip sid id {:deep? deep?}) nil)))) (rf/reg-event-db ::extend-hold (fn [db [_ delta extent]] (let [clip (:clip (store/entry (:clip/current db))) [_ sid id] (get-in db [:ui :selection]) - result (lane/extend-hold clip sid id delta {:extent (or extent :keep)})] - (apply-lane-command db sid result [::extend-hold delta :grow-symbol])))) + result (span/extend-hold clip sid id delta {:extent (or extent :keep)})] + (apply-command db sid result [::extend-hold delta :grow-symbol])))) (rf/reg-event-fx - ::lane-retry + ::retry (fn [{:keys [db]} _] - (if-let [event (get-in db [:ui :lane-retry])] - {:db (update db :ui dissoc :lane-retry) :dispatch event} + (if-let [event (get-in db [:ui :retry])] + {:db (update db :ui dissoc :retry) :dispatch event} {}))) @@ -436,6 +407,19 @@ (= :instance (get-in clip [:symbols sid :nodes id :kind])) path :else (vec (butlast path))))) +(defn aimed-symbol + "The symbol a command acts in and the path of rows down to it: `{:sid :path}`. + + INSIDE the aimed instance, beside an aimed node of any other kind, the open + symbol when nothing is aimed — which is `where-new-goes`, resolved. There is + no lane to aim at any more: a lane is how a symbol is DRAWN, so what a gesture + names is a symbol, and whether that symbol is drawn as a lane is a separate + question `symbol/lane?` answers." + [clip st db frame] + (let [open (get-in db [:ui :open]) + down (where-new-goes clip db)] + (assoc (nest/inside clip st open down frame) :path down))) + ;; --------------------------------------------------------------------------- ;; drawing a polygon ;; @@ -456,10 +440,10 @@ (update-in db [:ui :draft] into [x y]) db))) -(defn into-the-lane - "Where a polygon drawn with a lane aimed goes: the path of the held clip the - lane exposes at the playhead, and the document containing it. `{:clip :path}`, - or `{:refused why}`. +(defn into-the-sequence + "Where a polygon drawn into a symbol DRAWN AS A LANE goes: the path of the held + clip that symbol exposes at the playhead, and the document containing it. + `{:clip :path}`, or `{:refused why}`. A GAP IS NOT A REFUSAL, IT IS A NEW DRAWING. The frame under the playhead is where the drawing belongs, so drawing on an empty frame makes the one-frame @@ -467,47 +451,46 @@ controls used to say. `overwrite-drawing` rather than `append-drawing`, because a gap already has - the room. Appending RIPPLES everything after it later by the new cel's + the room. Appending RIPPLES everything after it later by the new clip's duration — that is what `insert` means, and it is a different intention. Placed into a gap, overwrite clears nothing and moves nobody. - A CEL'S PATH IS ONE STEP. `[cel]` and not `[lane cel]`: within one symbol the - rows are flat and a cel is not a row at all, which is the same addressing - `rows` hands the timeline and `trail` reads back." - [clip st db lane] - (let [open (get-in db [:ui :open]) - lane-id (:id lane) - owner (:frame (nest/inside clip st open [] (get-in db [:playback :frame]))) - at (when (number? owner) (lane/lane-frame clip open lane-id owner)) - cel (when (integer? at) + THE CLIP'S PATH IS THE SYMBOL'S PATH PLUS ONE STEP, because a clip of a lane + is an ordinary row of the symbol holding it — which is the addressing `rows` + hands the timeline and `trail` reads back." + [clip db {:keys [sid frame path]}] + (let [exposed (when (integer? frame) (some (fn [c] (let [[lo hi] (node/placed-span c)] - (when (and (<= lo at) (< at hi)) c))) - (symbol/lane-clips (get-in clip [:symbols open :nodes]) lane-id)))] + (when (and (<= lo frame) (< frame hi)) c))) + (symbol/children (get-in clip [:symbols sid :nodes]))))] (cond - (not (integer? at)) - {:refused "the playhead is not on one frame of this lane"} - cel {:clip clip :path [(:id cel)]} + (not (integer? frame)) + {:refused "the playhead is not on one frame of this symbol"} + exposed {:clip clip :path (conj (vec path) (:id exposed))} :else (let [cel-id (random-uuid) - made (lane/overwrite-drawing clip open lane-id cel-id (clip/fresh-id clip) at + made (span/overwrite-drawing clip sid cel-id (clip/fresh-id clip) frame {:extent :grow-symbol :remainder-id (random-uuid)})] - (if (:refused made) made {:clip (:clip made) :path [cel-id]}))))) + (if (:refused made) made {:clip (:clip made) :path (conj (vec path) cel-id)}))))) (defn polygon-landing "Choose the document and row path a finished polygon is drawn into. - An aimed lane wins regardless of what is selected on the stage: an - occupied frame lands in its cel and a gap first becomes a one-frame drawing. - With no lane aimed, ordinary target-based drawing is unchanged." + WHERE IT GOES IS A SYMBOL, and what happens there follows how that symbol is + DRAWN: in one drawn as a lane an occupied frame lands in its clip and a gap + first becomes a one-frame drawing, because the sequence is what says which + drawing the playhead is on. In an ordinary composition the polygon goes + straight into the symbol, as it always did." [clip st db] - (if-let [lane (aimed-lane clip db)] - (assoc (into-the-lane clip st db lane) :lane? true) - {:clip clip :path (where-new-goes clip db) :lane? false})) + (let [into (aimed-symbol clip st db (get-in db [:playback :frame]))] + (if (and (:sid into) (symbol/lane? (clip/symbol clip (:sid into)))) + (assoc (into-the-sequence clip db into) :lane? true) + {:clip clip :path (:path into) :lane? false}))) (defn beginning-polygon - "Enter polygon mode, first materializing a drawing at the playhead when a - lane is aimed and that frame is empty. + "Enter polygon mode, first materializing a drawing at the playhead when the + symbol it lands in is drawn as a lane and that frame is empty. Creating here, rather than when the polygon is finished, means the drawing is already the current cel while points are being placed. Cancelling the polygon @@ -558,7 +541,7 @@ (nil? sid) (update db :project merge {:status (if (:lane? landing) - "this lane is not on screen at this frame" + "this sequence is not on screen at this frame" "what you are drawing into is not on screen at this frame")}) ;; `random-uuid` is the one impurity in this namespace, and it is here ;; rather than in `domain/paint` for the reason `clip/place-symbol` spells @@ -588,57 +571,61 @@ (declare record-auto-frame) ;; --------------------------------------------------------------------------- -;; a new symbol +;; a new symbol or lane + +(defn- create-container + "Create and place one empty symbol. Lane creation is explicit: `lane?` marks + the new symbol for linear timeline display; ordinary symbol creation never + does. Both operations place the new symbol through the same span command, so + an explicitly aimed lane still applies its claim-time rule." + [db where lane?] + (let [{document :clip st :store} (store/entry (:clip/current db)) + open (get-in db [:ui :open]) + frame (get-in db [:playback :frame]) + into (if (= :top where) + (assoc (nest/inside document st open [] frame) :path []) + (aimed-symbol document st db frame)) + {host :sid at :frame down :path} into + sid (clip/fresh-id document) + instance-id (random-uuid) + end (clip/frames document host) + result (cond + (nil? host) + {:refused "what you are adding to is not on screen at this frame"} + (not (integer? at)) + {:refused "the playhead is not on one frame of this symbol"} + (or (nil? end) (>= at end)) + {:refused "the playhead is past the end of this symbol"} + :else + (let [new-symbol (cond-> {:id sid :name (name sid) + :fps (clip/fps document host) + :frames (- end at) :nodes {}} + lane? (assoc :display :lane)) + seeded (assoc-in document [:symbols sid] new-symbol)] + (span/place-symbol seeded st host instance-id sid at + {:extent :grow-symbol + :remainder-id (random-uuid)})))] + (if-let [why (:refused result)] + (update db :project merge {:status why}) + (let [selection [:node host instance-id (conj (vec down) instance-id)]] + (cond-> (-> db + (edit/transaction (constantly (:clip result))) + (assoc-in [:ui :selection] selection) + (update-in [:ui :expanded] (fnil into #{}) + (rest (reductions conj [] down)))) + lane? (assoc-in [:ui :target] (target-of selection))))))) (rf/reg-event-db ::new-symbol - ;; `where` is `:inside` — in whatever the target names — or `:top`, in the open - ;; symbol regardless of it. A lane is the temporal form of this same operation: - ;; inside it, a new empty symbol is a one-frame held clip at the playhead. (fn [db [_ where]] - (let [{clip :clip st :store} (store/entry (:clip/current db)) - target-lane (when (= :inside where) (aimed-lane clip db)) - open (get-in db [:ui :open]) - owner (:frame (nest/inside clip st open [] (get-in db [:playback :frame]))) - at (when (and target-lane (number? owner)) - (lane/lane-frame clip open (:id target-lane) owner)) - drawing-id (clip/fresh-id clip) - cel-id (random-uuid) - down (if (= :top where) [] (where-new-goes clip db)) - {host :sid frame :frame} (nest/inside clip st open down - (get-in db [:playback :frame])) - lane-id (random-uuid)] - (if target-lane - (let [result (if (integer? at) - (lane/overwrite-drawing clip open (:id target-lane) cel-id drawing-id at - {:extent :grow-symbol - :remainder-id (random-uuid)}) - {:refused "the playhead is not on one frame of this lane"})] - (if-let [why (:refused result)] - (update db :project merge {:status why}) - (-> db - (edit/transaction (constantly (:clip result))) - (assoc-in [:ui :selection] [:node open cel-id [cel-id]])))) - (if-not host - (update db :project merge - {:status "what you are adding to is not on screen at this frame"}) - (let [free (empty-lane clip host) - lane-id (or free lane-id) - prepared (if free {:clip clip} (lane/add-lane clip host lane-id)) - result (if (:refused prepared) prepared - (lane/overwrite-drawing (:clip prepared) host lane-id - cel-id drawing-id frame - {:extent :grow-symbol - :remainder-id (random-uuid)}))] - (if-let [why (:refused result)] - (update db :project merge {:status why}) - (-> db - (edit/transaction (constantly (:clip result))) - (assoc-in [:ui :selection] [:node host cel-id (conj down cel-id)]) - (assoc-in [:ui :target] - {:sid host :id lane-id :path (conj down lane-id)}) - (update-in [:ui :expanded] (fnil into #{}) - (rest (reductions conj [] down))))))))))) + (create-container db where false))) + +(rf/reg-event-db + ::new-lane + (fn [db _] + ;; A lane is an explicit top-level track of the open symbol. It must not + ;; become nested merely because the previously created lane is still aimed. + (create-container db :top true))) ;; --------------------------------------------------------------------------- ;; a drop in flight @@ -659,85 +646,74 @@ ::drop-clear (fn [db _] (update db :ui dissoc :drop))) -(defn lane-destination - "Where a drop lands: the lane it was aimed at, the selected one, or a new one. +(defn drop-destination + "Which symbol a drop lands in and on which of its frames: `{:clip :sid :at + :path}`, or `{:refused why}`. - EVERYTHING IN THE TIMELINE IS A LANE, so this is the one rule and every drop - asks it — a symbol from the pool, a sound, and a video brought in as a take - alike. It answers `{:clip :sid :lane-id :at :made?}` with the lane already - created in `:clip` when it had to make one, or `{:refused why}`. + ONE RULE AND EVERY DROP ASKS IT — a symbol from the pool, a sound, and a video + brought in as a take alike. The pointer names a ROW, `target`, and a row leads + into a symbol exactly where it names an instance, which is what `nest/inside` + already answers; with nothing under the pointer it is the open symbol. Nothing + is created to receive the drop: the symbol IS the container, so the first drop + into one is the same operation as the second. - `kind` is what is about to go in, `:picture` or `:sound`: a lane holds one or - the other, so an aimed lane that holds the other kind is not the destination - and a new one is made beside it." - [db document st frame target kind] - (let [open (get-in db [:ui :open]) - selected (get-in db [:ui :selection]) - [_ sel-sid sel-id] selected - holds (fn [[_ sid id]] - (let [nodes (get-in document [:symbols sid :nodes])] - (when (node/lane? (get nodes id)) - (let [kinds (into #{} (map :kind) (symbol/lane-clips nodes id))] - (or (empty? kinds) - (= kinds #{(if (= :sound kind) :audio :instance)})))))) - ;; With nothing aimed, an empty lane that is already there — see - ;; `empty-lane` — and only then a new one. - free (when-let [id (empty-lane document open)] - (when (holds [:node open id]) [:node open id [id]])) - aimed (or (when (and target (holds target)) target) - (when (and (= :node (first selected)) (holds selected)) selected) - free) - [_ aimed-sid aimed-id aimed-path] aimed - sid (if aimed aimed-sid open) - lane-id (if aimed aimed-id (random-uuid)) - prepared (if aimed {:clip document} (lane/add-lane document sid lane-id)) - lane-sel [:node sid lane-id (if aimed aimed-path [lane-id])] - owner (when-not (:refused prepared) - (selection-frame (:clip prepared) st open lane-sel frame)) - at (when (number? owner) - (lane/lane-frame (:clip prepared) sid lane-id owner))] + `:clip` is handed back unchanged and is in the result only so the callers that + used to be given a document with a freshly made lane in it go on reading one + thing." + [db document st frame target] + (let [target (if (vector? target) + (let [[_ sid id path] target] + {:sid sid :id id :path path}) + target) + open (get-in db [:ui :open]) + path (cond + (nil? target) [] + (= :instance (get-in document [:symbols (:sid target) + :nodes (:id target) :kind])) + (vec (:path target)) + :else (vec (butlast (:path target)))) + {:keys [sid] at :frame} (nest/inside document st open path frame)] (cond - (:refused prepared) prepared - (not (integer? at)) {:refused "the drop is not on one frame of this lane"} - :else {:clip (:clip prepared) :sid sid :lane-id lane-id :at at - :path (vec (butlast (nth lane-sel 3))) :made? (nil? aimed)}))) + (nil? sid) {:refused "what you are dropping into is not on screen at this frame"} + (not (integer? at)) {:refused "the drop is not on one frame of that symbol"} + :else {:clip document :sid sid :at at :path path}))) (defn landed - "`db` after a drop that produced `result`, with `uuid` selected in `lane`." - [db {:keys [sid lane-id path made?]} uuid result] + "`db` after a drop that produced `result`, with `uuid` selected." + [db {:keys [sid path]} uuid result] (if-let [why (:refused result)] (-> db (update :ui dissoc :drop) (update :project merge {:status why})) - (cond-> (-> db - (update :ui dissoc :drop) - (edit/transaction (constantly (:clip result))) - (assoc-in [:ui :selection] [:node sid uuid (conj (vec path) uuid)])) - made? (assoc-in [:ui :target] {:sid sid :id lane-id :path [lane-id]})))) + (-> db + (update :ui dissoc :drop) + (edit/transaction (constantly (:clip result))) + (assoc-in [:ui :selection] [:node sid uuid (conj (vec path) uuid)])))) (rf/reg-event-db ::drop-symbol - ;; A symbol dropped on a lane becomes a naturally playing clip in that lane. - ;; With no lane under it, make one: new timeline/stage placement therefore - ;; never invents another permanent row-per-symbol track. + ;; A symbol dropped on a row becomes a naturally playing clip in the symbol that + ;; row leads into. Whether it claims the time it lands on is `span/place-symbol`'s + ;; question and it answers it from the destination's display mode, so a drop onto + ;; a lane trims its neighbour and a drop into a composition does not. (fn [db [_ source-id frame point target]] (let [{document :clip st :store} (store/entry (:clip/current db)) - where (lane-destination db document st frame target :picture) + where (drop-destination db document st frame target) uuid (random-uuid)] (if (:refused where) (-> db (update :ui dissoc :drop) (update :project merge {:status (:refused where)})) (landed db where uuid - (lane/place-symbol (:clip where) st (:sid where) (:lane-id where) + (span/place-symbol (:clip where) st (:sid where) uuid source-id (:at where) {:extent :grow-symbol :point point :remainder-id (random-uuid)})))))) (rf/reg-event-db ::drop-sound - ;; A SOUND IS A CLIP IN A LANE TOO. It is placed and then adopted rather than - ;; written straight into the lane, so one command owns where a sound's frames - ;; are — `clip/place-sound` — and one owns what claiming lane time means. + ;; A SOUND IS A CLIP TOO. It is placed and then adopted rather than written + ;; straight in, so one command owns where a sound's frames are — + ;; `clip/place-sound` — and one owns what claiming time means. (fn [db [_ {:keys [source label length rate]} frame target]] (let [{document :clip st :store} (store/entry (:clip/current db)) - where (lane-destination db document st frame target :sound) + where (drop-destination db document st frame target) uuid (random-uuid)] (if (:refused where) (-> db (update :ui dissoc :drop) (update :project merge {:status (:refused where)})) @@ -747,31 +723,41 @@ (:rate (clip/grid-time (:clip where) sid))) uuid)] (landed db where uuid - (lane/adopt seeded sid (:lane-id where) uuid (:at where) + (span/adopt seeded sid uuid (:at where) {:extent :grow-symbol :remainder-id (random-uuid)}))))))) (rf/reg-event-db - ::adopt-in-lane - (fn [db [_ [_ from-sid id _] [_ lane-sid lane-id lane-path :as lane-selection] - frame]] + ::drop-clip + ;; A CLIP BODY DRAGGED ONTO A ROW. Within its own symbol this is `span/adopt`, + ;; which claims the time it lands on — a drop onto occupied frames has already + ;; said it means to. Onto a row leading into ANOTHER symbol it is that, after + ;; `nest/move-node` carries the clip across keeping its world transform; the two + ;; commit as one transaction, so it is still one undo step. + (fn [db [_ [_ from-sid id from-path] target-path frame]] (let [{document :clip st :store} (store/entry (:clip/current db)) open (get-in db [:ui :open]) - owner-frame (selection-frame document st open lane-selection frame) - at (when (number? owner-frame) - (lane/lane-frame document lane-sid lane-id owner-frame)) + into (nest/inside document st open (vec target-path) frame) + crossing? (not= from-sid (:sid into)) + carried (when (and (:sid into) crossing?) + (nest/move-node document st open (vec from-path) (vec target-path) frame)) + doc (if crossing? (:clip carried) document) + landed-id (if crossing? (:id carried) id) result (cond - (not= from-sid lane-sid) - {:refused "a clip and its destination lane must be in the same symbol"} - (not (integer? at)) {:refused "the drop is not on one frame of this lane"} - :else (lane/adopt document lane-sid lane-id id at + (nil? (:sid into)) + {:refused "what you are dropping into is not on screen at this frame"} + (not (integer? (:frame into))) + {:refused "the drop is not on one frame of that symbol"} + (and crossing? (:refused carried)) carried + :else (span/adopt doc (:sid into) landed-id (:frame into) {:extent :grow-symbol - :remainder-id (random-uuid)})) - path (conj (vec (butlast lane-path)) id)] + :remainder-id (random-uuid)}))] (if-let [why (:refused result)] (update db :project merge {:status why}) (-> db (edit/transaction (constantly (:clip result))) - (assoc-in [:ui :selection] [:node lane-sid id path])))))) + (assoc-in [:ui :selection] + [:node (:sid into) landed-id + (conj (vec target-path) landed-id)])))))) ;; --------------------------------------------------------------------------- ;; moving rows between symbols @@ -783,6 +769,48 @@ (defn- refused [db why] (update db :project merge {:status (str "can't: " why)})) +(rf/reg-event-db + ::adopt-in-lane + ;; Plain body-drag is temporal. The destination row names either an instance + ;; of an explicit lane symbol, or the open lane symbol itself. Moving between + ;; two lane symbols transfers the clip before `span/adopt` claims its new time; + ;; Shift-drag remains the separate structural `::move-node` operation below. + (fn [db [_ [_ from-sid id _] [_ target-sid target-id target-path :as target] + frame]] + (let [{document :clip st :store} (store/entry (:clip/current db)) + open (get-in db [:ui :open]) + target-node (get-in document [:symbols target-sid :nodes target-id]) + dest-sid (if target-id (node/source target-node) target-sid) + dest (clip/symbol document dest-sid) + local-frame (if (seq target-path) + (:frame (nest/inside document st open target-path frame)) + (:frame (nest/inside document st open [] frame))) + n (get-in document [:symbols from-sid :nodes id]) + seeded (when (and n dest-sid) + (if (= from-sid dest-sid) + document + (-> document + (update-in [:symbols from-sid :nodes] dissoc id) + (assoc-in [:symbols dest-sid :nodes id] + (dissoc n :parent))))) + result (cond + (nil? n) {:refused "select a clip to move"} + (not (symbol/lane? dest)) {:refused "drop onto an explicit lane"} + (and (not= from-sid dest-sid) + (contains? (get-in document [:symbols dest-sid :nodes]) id)) + {:refused "the destination already has a clip with that ID"} + (not (integer? local-frame)) + {:refused "the drop is not on one frame of this lane"} + :else (span/adopt seeded dest-sid id local-frame + {:extent :grow-symbol + :remainder-id (random-uuid)}))] + (if-let [why (:refused result)] + (refused db why) + (-> db + (edit/transaction (constantly (:clip result))) + (assoc-in [:ui :selection] + [:node dest-sid id (conj (vec target-path) id)])))))) + (rf/reg-event-db ::move-node (fn [db [_ from to]] diff --git a/frontend/src/arthur/subs/ui.cljs b/frontend/src/arthur/subs/ui.cljs index 5631061..38a4c33 100644 --- a/frontend/src/arthur/subs/ui.cljs +++ b/frontend/src/arthur/subs/ui.cljs @@ -13,7 +13,7 @@ (rf/reg-sub ::selection (fn [db _] (get-in db [:ui :selection]))) (rf/reg-sub ::target (fn [db _] (get-in db [:ui :target]))) -(rf/reg-sub ::lane-retry (fn [db _] (get-in db [:ui :lane-retry]))) +(rf/reg-sub ::retry (fn [db _] (get-in db [:ui :retry]))) (rf/reg-sub ::tone (fn [db _] (get-in db [:ui :tone]))) (rf/reg-sub ::tool (fn [db _] (get-in db [:ui :tool]))) (rf/reg-sub ::auto-key? (fn [db _] (boolean (get-in db [:ui :auto-key?])))) diff --git a/frontend/src/arthur/ui/location.cljs b/frontend/src/arthur/ui/location.cljs index e20da2e..9e68fb4 100644 --- a/frontend/src/arthur/ui/location.cljs +++ b/frontend/src/arthur/ui/location.cljs @@ -76,7 +76,8 @@ (map (fn [a] (let [m (get nodes a)] {:kind (:kind m) - :lane? (node/lane? m) + :lane? (and (= :instance (:kind m)) + (symbol/lane? (clip/symbol clip (node/source m)))) :sid in :id a :of (node/source m) :label (crumb-label clip a m) :select [:node in a (conj so-far a)]}))) diff --git a/frontend/src/arthur/ui/params.cljs b/frontend/src/arthur/ui/params.cljs index cc67730..6a58b05 100644 --- a/frontend/src/arthur/ui/params.cljs +++ b/frontend/src/arthur/ui/params.cljs @@ -14,6 +14,7 @@ [arthur.domain.paint :as paint] [arthur.domain.params :as params] [arthur.domain.pose :as pose] + [arthur.domain.symbol :as symbol] [arthur.domain.trace :as trace] [arthur.events.history :as history] [arthur.events.paint :as paint-events] @@ -281,11 +282,10 @@ (defn- correction-section [[sid selected-id selected]] (let [clip @(rf/subscribe [::render/clip]) - parent (get-in clip [:symbols sid :nodes (:parent selected)]) - targets (cond - (node/lane? selected) [selected-id] - (node/lane? parent) [selected-id (:id parent)] - :else [])] + lane-context? (or (symbol/lane? (clip-domain/symbol clip sid)) + (and (= :instance (:kind selected)) + (symbol/lane? (clip-domain/symbol clip (node/source selected))))) + targets (if lane-context? [selected-id] [])] (when (seq targets) (r/with-let [draft (r/atom (correction-initial clip sid selected-id))] (let [target (:target @draft) @@ -303,7 +303,7 @@ (doall (for [[i id] (map-indexed vector targets)] ^{:key (str id)} [:option {:value i} - (str (if (= id selected-id) "selected · " "lane · ") (brief id))]))]] + (str "selected · " (brief id))]))]] [:label.inspector-field "property" [:select {:value (if (= [:xform :rot] (:path @draft)) "rotation" "position") :on-change #(swap! draft assoc :path diff --git a/frontend/src/arthur/ui/timeline.cljs b/frontend/src/arthur/ui/timeline.cljs index 4e9d114..6f1cd20 100644 --- a/frontend/src/arthur/ui/timeline.cljs +++ b/frontend/src/arthur/ui/timeline.cljs @@ -171,6 +171,9 @@ (into (inside-rows sid child cpath (inc depth) cself cspan)))))) (walk [sid path depth ->open] (let [sym (get-in clip [:symbols sid]) + root-lane? (and (empty? path) (symbol/lane? sym)) + root-clips (when root-lane? (symbol/children (:nodes sym))) + root-ids (into #{} (map :id) root-clips) ordered (->> (:nodes sym) ;; Front-most at the top, as a layer list is drawn ;; everywhere. `:z` is the lexicographic draw key; @@ -179,8 +182,49 @@ reverse ;; Sounds are listed below the picture, by ;; `sound-rows`, wherever they are. - (remove #(= :audio (:kind (val %)))))] - (into [] + (remove #(= :audio (:kind (val %)))) + ;; In an open lane symbol, its clips are blocks + ;; on the symbol's own row. Span-less decoration + ;; remains an ordinary row beside it. + (remove #(contains? root-ids (key %)))) + root-row (when root-lane? + (let [open? (contains? expanded [::lane]) + row {:path [::lane] + :depth depth + :label (or (:name sym) (name sid)) + :kind :symbol + :lane? true + :select [:node sid nil []] + :expandable? true + :expanded? open? + :span [0 (:frames sym)] + :keys [] + :cels (mapv (fn [child] + {:id (:id child) + :label (or (get-in clip [:symbols (node/source child) :name]) + (some-> (node/source child) name) + (node-label (:id child) child)) + :source (node/source child) + :span (mapv ->open (node/placed-span child)) + :keys (into [] + (comp (mapcat keyed-frames) + (map (comp ->open (local->parent child))) + (distinct)) + (vals (node/channels child))) + :select [:node sid (:id child) + (conj path (:id child))]}) + root-clips)}] + (cond-> [row] + open? + (into (if-let [child (first (filter #(under? (conj path (:id %))) + root-clips))] + (portal sid path (inc depth) ->open child) + [{:path [::lane ::portal] + :depth (inc depth) :kind :hint + :label (if (seq root-clips) + "select a clip to inspect" + "empty lane")}])))))] + (into (vec root-row) (mapcat (fn [[id n]] (let [rpath (conj path id) @@ -197,6 +241,10 @@ (map #(local->parent (get-in sym [:nodes %])) (reverse ancestors))) self (comp parent-map (local->parent n)) + source-sym (when (= :instance (:kind n)) + (clip/symbol clip (node/source n))) + lane? (symbol/lane? source-sym) + clips (when lane? (symbol/children (:nodes source-sym))) span (mapv parent-map (or (node/placed-span (cond-> n @@ -208,7 +256,7 @@ :label (node-label id n) :kind :node :node-kind (:kind n) - :lane? (node/lane? n) + :lane? lane? :of (node/source n) :select [:node sid id rpath] :expandable? true @@ -219,16 +267,7 @@ (distinct)) (vals channels)) :dense? (boolean (some :dense (vals channels)))}] - ;; A CLIP IS NOT A ROW. A lane's symbol clips are - ;; blocks on the lane's own row, so twelve clips are - ;; still one row. The clip remains independently - ;; selectable and addressable; only its presentation - ;; is shared. - (if (node/lane? (get-in sym [:nodes (:parent n)])) - [] - (let [clips (when (node/lane? n) - (symbol/lane-clips (:nodes sym) id)) - ;; A lane of sounds is a lane like any other — + (let [;; A lane of sounds is a lane like any other — ;; same blocks, same edges, same portal — and ;; is listed under the audio heading because ;; that is where somebody looks for a sound, @@ -236,7 +275,7 @@ sound-lane? (and (seq clips) (every? #(= :audio (:kind %)) clips)) row (cond-> row - (node/lane? n) + lane? (assoc :cels (mapv (fn [child] {:id (:id child) @@ -252,24 +291,26 @@ (map (comp self (local->parent child))) (distinct)) (vals (node/channels child))) - :select [:node sid (:id child) (conj path (:id child))]}) + :select [:node (node/source n) (:id child) + (conj rpath (:id child))]}) clips)))] (cond->> (if-not open? [row] (-> [row] (into (channel-rows n rpath (inc depth) self span)) ;; The one clip an expanded lane opens. - (into (when (node/lane? n) - (if-let [child (first (filter #(under? (conj path (:id %))) clips))] - (portal sid path (inc depth) self child) + (into (when lane? + (if-let [child (first (filter #(under? (conj rpath (:id %))) clips))] + (portal (node/source n) rpath (inc depth) self child) [{:path (conj rpath ::portal) :depth (inc depth) :kind :hint :label (if (seq clips) "select a clip to inspect" "empty lane")}]))) - (into (inside-rows sid n rpath (inc depth) self span)))) - sound-lane? (mapv #(assoc % :sound? true))))))) + (into (when-not lane? + (inside-rows sid n rpath (inc depth) self span))))) + sound-lane? (mapv #(assoc % :sound? true)))))) ordered))))] (if (get-in clip [:symbols sid]) (walk sid [] 0 #(/ % (:rate (clip/grid-time clip sid)))) @@ -279,19 +320,14 @@ "Audio rows use the same flattened intervals as the mixer, including source in-points, cel speeds, parent timing, and silence beneath visual holds. - WHAT IS IN A LANE OF THIS SYMBOL IS NOT FLATTENED HERE. A sound in a lane is + WHAT IS IN A LANE SYMBOL IS NOT FLATTENED HERE. A sound in a lane is a clip somebody placed and can move, trim and open, and `rows` draws it as one; flattening it as well would show the same sound on two rows, only one of which could be edited. What remains is what this view is for: audio nested inside the symbols this one places, mapped into this ruler." [clip sid expanded] (if-not (get-in clip [:symbols sid]) [] - (let [nodes (get-in clip [:symbols sid :nodes]) - in-lane (into #{} (keep (fn [[id n]] - (when (and (= :audio (:kind n)) - (node/lane? (get nodes (:parent n)))) - id))) - nodes)] + (let [lane? (symbol/lane? (clip/symbol clip sid))] (vec (mapcat (fn [[path tracks]] @@ -314,8 +350,7 @@ (when open? (channel-rows n path 1 identity span))))) (sort-by (comp str key) (group-by :path - (remove #(and (= 1 (count (:path %))) - (contains? in-lane (first (:path %)))) + (remove #(and lane? (= 1 (count (:path %)))) (nest/audio-tracks clip sid))))))))) ;; --------------------------------------------------------------------------- @@ -451,9 +486,9 @@ [:span.spacer] ;; After the spacer, both of them: an offer that appears and a reading that ;; comes and goes must not shove the fixed controls sideways when they do. - (when @(rf/subscribe [::sub/lane-retry]) + (when @(rf/subscribe [::sub/retry]) [:button.retry {:title "the command was refused because the shot is too short" - :on-click (act [::ui/lane-retry])} "extend shot and apply"]) + :on-click (act [::ui/retry])} "extend shot and apply"]) ;; Measured in the loop, not derived from the clock — the whole question ;; while profiling is whether the painting keeps up with the clock, and a ;; number computed FROM the clock would answer itself. Shown only while it diff --git a/frontend/test/arthur/domain/correction_test.cljs b/frontend/test/arthur/domain/correction_test.cljs index fdefb3b..c71d470 100644 --- a/frontend/test/arthur/domain/correction_test.cljs +++ b/frontend/test/arthur/domain/correction_test.cljs @@ -4,22 +4,22 @@ [arthur.domain.clip :as clip] [arthur.domain.correction :as correction] [arthur.domain.leaf :as leaf] - [arthur.domain.lane-test :as fixture])) + [arthur.domain.sequence-test :as fixture])) (defn- channel [doc id path] (get-in doc [:symbols :main :nodes id :channels path])) (deftest authors-the-three-motions-as-ordinary-layer-channels (let [doc (fixture/document) - constant (correction/add doc :main :girl [:xform :rot] + constant (correction/add doc :main :a [:xform :rot] {:id :flat :support [2 5] :motion :constant :delta 1}) - ramp (correction/add (:clip constant) :main :girl [:xform :rot] + ramp (correction/add (:clip constant) :main :a [:xform :rot] {:id :ramp :support [6 9] :motion :ramp :start 0 :end 2}) - returned (correction/add (:clip ramp) :main :girl [:xform :rot] + returned (correction/add (:clip ramp) :main :a [:xform :rot] {:id :return :support [9 12] :motion :return :start 0 :peak 3 :peak-frame 10}) - c (channel (:clip returned) :girl [:xform :rot])] - (is (= :girl (:selection returned))) + c (channel (:clip returned) :a [:xform :rot])] + (is (= :a (:selection returned))) (is (= [:flat :ramp :return] (mapv :id (:over c)))) (is (= [0 0 1 1 1 0 0 1 2 0 3 0] (mapv #(ch/value-at c % nil) (range 12)))) @@ -47,19 +47,19 @@ put3 (ch/layer :put3 [0 2] :replace (ch/framed [1 2 3])) add3 (ch/layer :add3 [0 2] :offset (ch/framed [1 1 1])) stacked (assoc base :over [put3 add3]) - doc (assoc-in doc [:symbols :main :nodes :girl :channels [:xform :pos]] stacked)] - (is (:refused (correction/remove-layer doc :main :girl [:xform :pos] :put3)) + doc (assoc-in doc [:symbols :main :nodes :a :channels [:xform :pos]] stacked)] + (is (:refused (correction/remove-layer doc :main :a [:xform :pos] :put3)) "removing the replacement would expose a wrong-shaped base") - (let [conflicted (assoc-in doc [:symbols :main :nodes :girl :channels [:xform :pos] :over 1 :conflict] + (let [conflicted (assoc-in doc [:symbols :main :nodes :a :channels [:xform :pos] :over 1 :conflict] "old topology") - retried (correction/retry-layer conflicted :main :girl [:xform :pos] :add3)] + retried (correction/retry-layer conflicted :main :a [:xform :pos] :add3)] (is (:clip retried)) (is (nil? (get-in (:clip retried) - [:symbols :main :nodes :girl :channels [:xform :pos] :over 1 :conflict])))) + [:symbols :main :nodes :a :channels [:xform :pos] :over 1 :conflict])))) (let [without-replacement (-> doc - (assoc-in [:symbols :main :nodes :girl :channels [:xform :pos] :over] + (assoc-in [:symbols :main :nodes :a :channels [:xform :pos] :over] [(assoc add3 :conflict "old topology")]))] - (is (:refused (correction/retry-layer without-replacement :main :girl + (is (:refused (correction/retry-layer without-replacement :main :a [:xform :pos] :add3)) "retry refuses when the current effective base still has the wrong shape")))) @@ -74,13 +74,13 @@ (deftest corrections-round-trip-with-identity-support-and-order (let [doc (fixture/document) - one (:clip (correction/add doc :main :girl [:xform :rot] + one (:clip (correction/add doc :main :a [:xform :rot] {:id :one :support [0 3] :motion :constant :delta 1})) - two (:clip (correction/add one :main :girl [:xform :rot] + two (:clip (correction/add one :main :a [:xform :rot] {:id :two :support [3 6] :motion :ramp :start 0 :end 2})) back (leaf/clip "u" (leaf/leaves "u" two))] (is (= two back)) (is (= [:one :two] - (mapv :id (get-in back [:symbols :main :nodes :girl + (mapv :id (get-in back [:symbols :main :nodes :a :channels [:xform :rot] :over])))))) diff --git a/frontend/test/arthur/domain/instance_test.cljs b/frontend/test/arthur/domain/instance_test.cljs index 833d3c5..80c5a29 100644 --- a/frontend/test/arthur/domain/instance_test.cljs +++ b/frontend/test/arthur/domain/instance_test.cljs @@ -241,11 +241,9 @@ made (clip/new-symbol c :outer id 20 u)] (is (= :symbol-1 id)) (is (= :symbol-2 (clip/fresh-id made)) "the next one does not collide") - (is (= {:id :symbol-1 :name "symbol-1" :fps 30 :frames 180 - :nodes {:lane clip/lane-node}} + (is (= {:id :symbol-1 :name "symbol-1" :fps 30 :frames 180 :nodes {}} (clip/symbol made :symbol-1)) - "empty but for the lane every symbol is born with, and as long as the - rest of what it was placed in") + "empty, ordinary, and as long as the rest of what it was placed in") (is (= {:span [0 180] :time {:mode :map :at 20 :rate 1}} (select-keys (get-in made [:symbols :outer :nodes u]) [:span :time]))) (is (= #{:symbol-1} (node/sources (get-in made [:symbols :outer :nodes u]))) diff --git a/frontend/test/arthur/domain/lane_test.cljs b/frontend/test/arthur/domain/lane_test.cljs deleted file mode 100644 index 36ecb9a..0000000 --- a/frontend/test/arthur/domain/lane_test.cljs +++ /dev/null @@ -1,650 +0,0 @@ -(ns arthur.domain.lane-test - (:require [cljs.test :refer [deftest is testing]] - [arthur.domain.bring :as bring] - [arthur.domain.channel :as ch] - [arthur.domain.clip :as clip] - [arthur.domain.history :as history] - [arthur.domain.leaf :as leaf] - [arthur.domain.nest :as nest] - [arthur.domain.node :as node] - [arthur.domain.palette :as pal] - [arthur.domain.pick :as pick] - [arthur.domain.lane :as lane] - [arthur.domain.span :as span] - [arthur.domain.symbol :as symbol])) - -(defn drawing [id x frames] - {:id id :frames frames - :nodes {:mark {:id :mark :kind :rect :z "a" - :channels {[:geom :size] (ch/framed 4) - [:xform :pos] (ch/framed [x 0])}}}}) - -(defn cel [id source at duration speed] - {:id id :kind :instance :parent :girl :z (name id) - :source {:symbol source} :playback {:in 0 :speed speed :end :stop} - :time {:at at :rate 1} :span [0 duration]}) - -(defn document [] - (let [a (cel :a :drawing-a 0 4 0) - b (assoc-in (cel :b :drawing-b 4 4 0) - [:channels [:xform :pos]] (ch/keyed {0 [0 0] 1 [2 0]} :hold)) - insert (assoc-in (cel :insert :wave 8 4 1) [:playback :in] 3)] - {:name "cels" :fps 24 :width 320 :height 200 - :symbols - {:main {:id :main :frames 12 - :nodes {:girl {:id :girl :kind :group :layout :sequence :z "b" - :channels {[:xform :pos] (ch/keyed {0 [0 0] 6 [60 0] 12 [0 0]} :linear)}} - :a a :b b :insert insert - :plate {:id :plate :kind :rect :z "a" - :channels {[:geom :size] (ch/framed 10) - [:xform :pos] (ch/keyed {0 [-40 0] 11 [70 0]} :linear)}}}} - :drawing-a (drawing :drawing-a 10 1) - :drawing-b (drawing :drawing-b 20 1) - :wave (assoc-in (drawing :wave 0 10) [:nodes :mark :channels [:xform :pos]] - (ch/keyed {0 [0 0] 9 [900 0]} :linear))}})) - - -(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))) - -(deftest one-lane-mixes-held-drawings-and-playing-content - (let [doc (document) at (sample doc (range 12))] - (is (empty? (clip/problems doc))) - (is (= 40 (get-in at [3 [:a :mark]]))) - (is (= 60 (get-in at [4 [:b :mark]]))) - (is (= 72 (get-in at [5 [:b :mark]]))) - (is (= 340 (get-in at [8 [:insert :mark]]))) - (is (= 610 (get-in at [11 [:insert :mark]]))) - (is (= (zipmap (range 12) (range -40 80 10)) - (into {} (map (fn [[f ops]] [f (js/Math.round (:plate ops))])) at))) - (is (nil? (get-in at [4 [:a :mark]])) "half-open cuts have a single owner"))) - -(deftest cel-ripple-keeps-lane-keys-and-moves-cel-corrections - (let [doc (document) - result (lane/extend-hold doc :main :a 2 {:extent :grow-symbol}) - after (:clip result) - nodes (get-in after [:symbols :main :nodes])] - (is (= :a (:selection result))) - (is (= 14 (get-in after [:symbols :main :frames]))) - (is (= [0 6] (node/placed-span (:a nodes)))) - (is (= [6 10] (node/placed-span (:b nodes)))) - (is (= [10 14] (node/placed-span (:insert nodes)))) - (doseq [id [:girl :a :b :insert :plate]] - (is (= (get-in doc [:symbols :main :nodes id :channels]) (:channels (nodes id)))) - (is (= (get-in doc [:symbols :main :nodes id :playback]) (:playback (nodes id))))) - (let [at (sample after [5 6 7 10])] - (is (= 60 (get-in at [5 [:a :mark]]))) - (is (= 80 (get-in at [6 [:b :mark]]))) - (is (= 72 (get-in at [7 [:b :mark]])) "B's correction follows B") - (is (= 320 (get-in at [10 [:insert :mark]])) "insert starts on source frame 3")) - (is (empty? (clip/problems after))) - (is (= (assoc-in doc [:symbols :main :frames] 14) - (:clip (lane/extend-hold after :main :a -2 {}))) - "shrinking restores content, except the explicitly grown shot"))) - -(deftest overflow-and-invalid-edits-are-atomic - (let [doc (document) - result (lane/extend-hold doc :main :a 2 {})] - (is (:refused result)) - (is (= 14 (:required-frames result))) - (is (not (contains? result :clip))) - (doseq [delta [0 -4 0.5 js/NaN]] - (is (:refused (lane/extend-hold doc :main :a delta {})))) - (is (:refused (lane/extend-hold doc :main :insert 1 {}))) - (is (:refused (lane/extend-hold doc :main :missing 1 {}))))) - -(deftest dragging-a-cel-edge-trims-neighbours-or-ripples-them - (let [doc (document) - plain (:clip (lane/resize-out doc :main :a 6 {})) - across (:clip (lane/resize-out doc :main :a 9 {})) - ripple (:clip (lane/resize-out doc :main :a 6 {:ripple? true - :extent :grow-symbol})) - shrink (:clip (lane/resize-out doc :main :a 2 {:ripple? true}))] - (is (= [[0 6] [6 8] [8 12]] - (mapv node/placed-span (symbol/lane-clips (get-in plain [:symbols :main :nodes]) :girl))) - "a normal grow eats the beginning of the adjacent cel") - (is (= [[0 9] [9 12]] - (mapv node/placed-span (symbol/lane-clips (get-in across [:symbols :main :nodes]) :girl))) - "a long grow removes wholly consumed cels and trims the survivor") - (is (= [[0 6] [6 10] [10 14]] - (mapv node/placed-span (symbol/lane-clips (get-in ripple [:symbols :main :nodes]) :girl))) - "shift-grow moves every later cel") - (is (= [[0 2] [2 6] [6 10]] - (mapv node/placed-span (symbol/lane-clips (get-in shrink [:symbols :main :nodes]) :girl))) - "shift-shrink pulls every later cel left") - (is (:refused (lane/resize-out doc :main :a 0 {}))) - (is (:refused (lane/resize-out doc :main :a 2.5 {}))))) - -(deftest the-middle-of-a-cut-rolls-both-edges - (let [doc (document) - rolled (:clip (lane/roll doc :main :a :b 6)) - right-only (:clip (lane/resize-in doc :main :b 6)) - grown-left (:clip (lane/resize-in doc :main :b 2))] - (is (= [[0 6] [6 8] [8 12]] - (mapv node/placed-span (symbol/lane-clips (get-in rolled [:symbols :main :nodes]) :girl))) - "the shared cut moves without moving either clip") - (is (= [[0 4] [6 8] [8 12]] - (mapv node/placed-span (symbol/lane-clips (get-in right-only [:symbols :main :nodes]) :girl))) - "the right side of the junction trims only the right clip") - (is (= [[0 2] [2 8] [8 12]] - (mapv node/placed-span (symbol/lane-clips (get-in grown-left [:symbols :main :nodes]) :girl))) - "growing the right clip left trims the neighbour instead of overlapping") - (is (:refused (lane/roll doc :main :a :b 0))) - (is (:refused (lane/roll doc :main :a :insert 6))))) - -(deftest a-gap-is-an-uncovered-interval - (let [doc (update-in (document) [:symbols :main :nodes] dissoc :b) - at (sample doc [3 4 7 8])] - (is (= #{:plate} (set (keys (at 4))))) - (is (= #{:plate} (set (keys (at 7))))) - (is (get-in at [8 [:insert :mark]])) - (is (empty? (clip/problems doc))))) - -(deftest validation-rejects-overlap-but-allows-empty-lanes - (is (some #(re-find #"overlap" %) - (clip/problems (assoc-in (document) [:symbols :main :nodes :b :time :at] 3)))) - (is (empty? (clip/problems - (update-in (document) [:symbols :main :nodes] dissoc :a :b :insert)))) - (is (seq (clip/problems - (assoc-in (document) [:symbols :main :nodes :a :span] [0 ##Inf])))) - (is (seq (clip/problems - (assoc-in (document) [:symbols :main :nodes :a :playback :speed] -1)))) - (is (seq (node/problems {:id :old :kind :instance :z "a" - :channels {[:source] (ch/framed {:of :wave :in 0})}})) - "the obsolete format is rejected")) - -(deftest playback-is-independent-of-property-channel-shape - (let [doc (document) - n (get-in doc [:symbols :main :nodes :a]) - keyed (node/toggle-key n [:xform :rot] 0 nil) - unkeyed (node/toggle-key keyed [:xform :rot] 0 nil)] - (doseq [n [n keyed unkeyed]] - (is (= {:symbol :drawing-a :frame 0} (node/placed-frame n 11 1)))) - (let [n (get-in doc [:symbols :main :nodes :insert])] - (is (= {:symbol :wave :frame 5} (node/placed-frame n 2 10))) - (is (nil? (node/placed-frame n 7 10))) - (is (= 9 (:frame (node/placed-frame (assoc-in n [:playback :end] :hold) 9 10)))) - (is (= 2 (:frame (node/placed-frame (assoc-in n [:playback :end] :loop) 9 10))))))) - -(deftest navigation-and-hit-testing-use-the-same-source-time - (let [doc (document) - n (get-in doc [:symbols :main :nodes :insert])] - (is (= 5 (:frame (nest/inside doc nil :main [:insert] 10)))) - (is (= {:at 5 :rate 1} (:time (nest/inside doc nil :main [:insert] 10)))) - (is (= 0 (:frame (nest/inside doc nil :main [:a] 3)))) - (is (nil? (:time (nest/inside doc nil :main [:a] 3)))) - (is (nil? (nest/inside doc nil :main [:a] 4))) - (is (= ((pick/bounds-of doc nil :main n) 2) - ((pick/bounds-of doc nil :main (assoc-in n [:playback :in] 5)) 0))))) - -(deftest seeking-and-source-reuse-do-not-share-cursors - (let [doc (assoc-in (document) [:symbols :main :nodes :b :source :symbol] :drawing-a) - fs [11 0 5 3 8 4 10 1 6 2 9 7] - at (sample doc fs)] - (is (= at (sample doc (reverse fs)))) - (is (= at (sample doc (range 12)))) - (let [edited (assoc-in doc [:symbols :drawing-a :nodes :mark :channels [:xform :pos]] - (ch/framed [99 0]))] - (is (= 99 (get-in (sample edited [0 4]) [0 [:a :mark]]))) - (is (= 139 (get-in (sample edited [0 4]) [4 [:b :mark]])))))) - -(deftest cel-identities-and-playback-round-trip - (let [doc (:clip (lane/extend-hold (document) :main :a 2 {:extent :grow-symbol})) - leaves (leaf/leaves :project doc)] - (is (= doc (leaf/clip :project leaves))) - (is (contains? leaves "clip/project/symbol/main/node/a")) - (is (not (contains? leaves "clip/project/symbol/main/channel/girl/source"))) - (let [{copied :clip ids :ids} - (bring/symbols (assoc-in (clip/blank) [:symbols :drawing-a] (drawing :drawing-a 99 1)) - doc [:main] {})] - (is (= :drawing-a-2 (:drawing-a ids))) - (is (= #{:drawing-a-2 :drawing-b :wave} (clip/places copied (:main ids)))) - (is (empty? (clip/problems copied)))))) - -(deftest one-transaction-undoes-the-ripple-and-shot-extension - (let [doc (document) - after (:clip (lane/extend-hold doc :main :a 2 {:extent :grow-symbol})) - before-leaves (leaf/leaves :p doc) - after-leaves (leaf/leaves :p after) - h (-> nil history/hold (history/record before-leaves after-leaves 0) history/settle) - undo (history/undo h after-leaves) - redo (history/redo (:history undo) (:leaves undo))] - (is (= 1 (count (:done h)))) - (is (= before-leaves (:leaves undo))) - (is (= after-leaves (:leaves redo))))) - -(deftest create-lane-and-append-drawings - (let [doc (:clip (lane/add-lane (clip/blank) :main :girl)) - a (:clip (lane/append-drawing doc :main :girl :a :drawing-a {})) - b (:clip (lane/append-drawing a :main :girl :b :drawing-b {}))] - (is (empty? (clip/problems b))) - (is (= [1 2] (node/placed-span (get-in b [:symbols :main :nodes :b])))) - (is (= 0 (get-in b [:symbols :main :nodes :b :playback :speed]))) - (is (:refused (lane/append-drawing b :main :girl :a :new {}))))) - -(deftest arbitrary-symbols-drop-into-the-same-lane-and-claim-their-time - (let [doc (document) - dropped (lane/place-symbol doc nil :main :girl :clip :wave 2 - {:extent :grow-symbol :remainder-id :tail}) - after (:clip dropped) - clips (symbol/lane-clips (get-in after [:symbols :main :nodes]) :girl)] - (is (= :clip (:selection dropped))) - (is (= [[0 2] [2 12]] (mapv node/placed-span clips)) - "the natural ten-frame symbol claims [2,12), trimming/removing incumbents") - (is (= :wave (node/source (second clips)))) - (is (= 1 (:speed (node/playback-of (second clips)))) - "a dropped symbol plays; it is not converted into a drawing hold") - (is (empty? (clip/problems after))))) - -(deftest an-existing-symbol-row-can-be-adopted-by-a-lane - (let [doc (assoc-in (document) [:symbols :main :nodes :badge] - {:id :badge :kind :instance :z "z" - :source {:symbol :wave} :span [0 3] - :time {:at 1 :rate 1} - :playback {:in 2 :speed 1 :end :stop}}) - result (lane/adopt doc :main :girl :badge 5 - {:extent :grow-symbol :remainder-id :tail}) - after (:clip result) - n (get-in after [:symbols :main :nodes :badge])] - (is (= :girl (:parent n))) - (is (= [5 8] (node/placed-span n))) - (is (= {:in 2 :speed 1 :end :stop} (:playback n)) - "adoption changes placement, not source timing") - (is (= [[0 4] [4 5] [5 8] [8 12]] - (mapv node/placed-span - (symbol/lane-clips (get-in after [:symbols :main :nodes]) :girl)))) - (is (empty? (clip/problems after))))) - -(deftest fractional-placement-rates-convert-the-hold-delta - (let [doc (-> (document) - (assoc-in [:symbols :main :nodes :a :time :rate] 2) - (assoc-in [:symbols :main :nodes :a :span] [0 8])) - after (:clip (lane/extend-hold doc :main :a 2 {:extent :grow-symbol}))] - (is (= [0 12] (get-in after [:symbols :main :nodes :a :span]))) - (is (= [6 10] (node/placed-span (get-in after [:symbols :main :nodes :b])))))) - -(deftest bare-shapes-agree-in-reference-and-playback - (let [sym (drawing :bare 12 1)] - (is (= (symbol/eval-frame sym 0 nil pal/index-of nil) - ((symbol/resolver sym nil pal/index-of nil) 0)) - "omitted style colour must not crash a missing cursor"))) - -(deftest audio-follows-only-the-playing-cel - (let [voice {:id :voice :kind :audio :z "a" :source {:sound "voice"} - :span [0 10] - :channels {[:audio :gain] (ch/keyed {0 0 5 1} :linear)}} - doc (-> (document) - (assoc-in [:symbols :wave :nodes :voice] voice) - (assoc-in [:symbols :drawing-a :nodes :voice] voice)) - [track :as tracks] (nest/audio-tracks doc :main)] - (is (= 1 (count tracks)) "the frozen drawing contributes no audio") - (is (= [8 12] (node/placed-span track))) - (is (= [3 7] (:span track)) "the source in-point trims the audio too") - (is (= {5 0 10 1} (get-in track [:channels [:audio :gain] :keys]))) - (let [moved (:clip (lane/extend-hold doc :main :a 2 {:extent :grow-symbol})) - [track] (nest/audio-tracks moved :main)] - (is (= [10 14] (node/placed-span track))) - (is (= [3 7] (:span track)))) - (let [fast (-> doc - (assoc-in [:symbols :main :nodes :girl :time] {:at 2 :rate 2}) - (assoc-in [:symbols :main :nodes :insert :playback :speed] 2)) - [track] (nest/audio-tracks fast :main)] - (is (= [6 7.75] (node/placed-span track))) - (is (= [3 10] (:span track))) - (is (= 4 (get-in track [:time :rate])))))) - -(deftest a-looped-insert-schedules-distinct-audio-intervals - (let [doc (-> (document) - (assoc-in [:symbols :wave :frames] 4) - (assoc-in [:symbols :wave :nodes :voice] - {:id :voice :kind :audio :z "a" :source {:sound "v"} :span [1 3]}) - (assoc-in [:symbols :main :nodes :insert :playback] - {:in 3 :speed 1 :end :loop}))] - (is (= [[10 12]] (mapv node/placed-span (nest/audio-tracks doc :main)))))) - -(deftest enclosing-retiming-is-respected-when-extending-the-shot - (let [doc (assoc-in (document) [:symbols :main :nodes :girl :time] {:at 8 :rate 2}) - result (lane/extend-hold doc :main :a 2 {})] - (is (= 15 (:required-frames result))) - (is (nil? (:clip result))) - (is (= 15 (get-in (lane/extend-hold doc :main :a 2 {:extent :grow-symbol}) - [:clip :symbols :main :frames]))))) - -(deftest reuse-shares-content-and-make-unique-decouples-one-cel - (let [doc (document) - shared (:clip (lane/reuse-drawing doc :main :girl :c :drawing-a - {:extent :grow-symbol})) - edit (fn [c sym x] - (assoc-in c [:symbols sym :nodes :mark :channels [:xform :pos]] - (ch/framed [x 0])))] - (is (:refused (lane/reuse-drawing doc :main :girl :c :drawing-a {})) - "the shot has to be extended on purpose") - (is (= :drawing-a (node/source (get-in shared [:symbols :main :nodes :c])))) - (is (= [12 13] (node/placed-span (get-in shared [:symbols :main :nodes :c])))) - (is (empty? (clip/problems shared))) - ;; One drawing, two cels: the edit arrives at both. - (let [at (sample (edit shared :drawing-a 99) [0 12])] - (is (= 99 (get-in at [0 [:a :mark]]))) - (is (= 99 (get-in at [12 [:c :mark]])))) - (let [unique (:clip (lane/make-unique shared :main :c {}))] - (is (= :drawing-a-2 (node/source (get-in unique [:symbols :main :nodes :c])))) - (is (= (:nodes (get-in shared [:symbols :drawing-a])) - (:nodes (get-in unique [:symbols :drawing-a-2]))) - "a copy of the same drawing, not an empty one") - (is (= :drawing-a (node/source (get-in unique [:symbols :main :nodes :a]))) - "the other cel keeps the original") - (let [at (sample (edit unique :drawing-a 99) [0 12])] - (is (= 99 (get-in at [0 [:a :mark]]))) - (is (= 10 (get-in at [12 [:c :mark]])) "the cel made unique is untouched")) - (let [at (sample (edit unique :drawing-a-2 99) [0 12])] - (is (= 10 (get-in at [0 [:a :mark]])) "and does not reach back")) - (is (empty? (clip/problems unique)))) - ;; Nothing else places drawing-b, so there is nothing to decouple from. - (is (:refused (lane/make-unique doc :main :b {}))) - (is (:refused (lane/make-unique doc :main :girl {})) - "a lane places nothing itself"))) - -(deftest duplicate-copies-the-drawing-and-not-the-cel - (let [doc (document) - made (:clip (lane/duplicate-drawing doc :main :b :d {:extent :grow-symbol})) - n (get-in made [:symbols :main :nodes :d])] - (is (= :drawing-b-2 (node/source n))) - (is (= (:nodes (get-in doc [:symbols :drawing-b])) - (:nodes (get-in made [:symbols :drawing-b-2])))) - (is (= [12 13] (node/placed-span n))) - (is (= {:in 0 :speed 0 :end :stop} (:playback n))) - (is (nil? (:channels n)) "B's own position correction belongs to B's cel") - (is (= (get-in doc [:symbols :main :nodes :b]) - (get-in made [:symbols :main :nodes :b])) - "the drawing duplicated is left as it was") - (is (empty? (clip/problems made))))) - -(deftest a-shallow-copy-keeps-its-parts-and-a-deep-copy-owns-them - ;; A drawing assembled from another symbol: copying it shallowly must keep - ;; using that part, and only an explicit deep copy may promise independence. - (let [doc (assoc-in (document) [:symbols :drawing-a :nodes :part] - {:id :part :kind :instance :z "b" :span [0 1] - :time {:at 0 :rate 1} :source {:symbol :wave} - :playback {:in 0 :speed 0 :end :stop}}) - copy (fn [opts] (:clip (lane/duplicate-drawing - doc :main :a :d (merge {:extent :grow-symbol} opts)))) - shallow (copy {}) - deep (copy {:deep? true})] - (is (= :wave (node/source (get-in shallow [:symbols :drawing-a-2 :nodes :part])))) - (is (nil? (get-in shallow [:symbols :wave-2]))) - (is (= :wave-2 (node/source (get-in deep [:symbols :drawing-a-2 :nodes :part])))) - (is (= (:nodes (get-in doc [:symbols :wave])) (:nodes (get-in deep [:symbols :wave-2])))) - (is (empty? (clip/problems shallow))) - (is (empty? (clip/problems deep))))) - -(deftest reuse-refuses-what-would-not-be-a-document - (let [doc (document)] - (is (:refused (lane/reuse-drawing doc :main :girl :c :nothing-here {}))) - (is (:refused (lane/reuse-drawing doc :main :girl :c :main {:extent :grow-symbol})) - "a symbol cannot go inside itself") - (is (:refused (lane/reuse-drawing doc :main :girl :a :drawing-a {:extent :grow-symbol})) - "a cel ID in use is not free") - (is (:refused (lane/reuse-drawing doc :main :plate :c :drawing-a {}))) - (is (:refused (lane/duplicate-drawing doc :main :girl :d {}))))) - -(deftest drawing-on-twos-does-not-quantize-the-lane-transform - ;; Cel length IS the drawing cadence, and it is the only thing on twos - ;; here: the lane's transform has its own clock and keeps moving every frame. - ;; Stepping it would be the cel cadence leaking into continuous motion. - (let [cel (fn [id source at] (cel id source at 2 0)) - doc (-> (document) - (update-in [:symbols :main :nodes] dissoc :a :b :insert) - (update-in [:symbols :main :nodes] merge - {:c0 (cel :c0 :drawing-a 0) - :c1 (cel :c1 :drawing-b 2) - :c2 (cel :c2 :drawing-a 4)})) - xs {:c0 10 :c1 20 :c2 10} - at (sample doc (range 6)) - showing (fn [f] (first (dissoc (at f) :plate)))] - (is (empty? (clip/problems doc))) - (is (= [:c0 :c0 :c1 :c1 :c2 :c2] (mapv #(first (key (showing %))) (range 6))) - "the drawing showing changes every second frame") - (is (= [0 10 20 30 40 50] - (mapv (fn [f] (let [[[id _] cx] (showing f)] (- cx (xs id)))) (range 6))) - "and the lane moves on every frame, odd ones included"))) - -(defn- drawn - "What every frame draws, as sorted values, so a picture can be compared - without naming the cels that produced it." - [doc fs] - (let [at (sample doc fs)] - (mapv #(sort (vals (get at %))) fs))) - -(deftest a-drawing-goes-anywhere-in-the-lane-and-ripples-what-follows - (let [doc (document) - keys-of #(get-in % [:symbols :main :nodes :girl :channels [:xform :pos] :keys]) - spans #(mapv (fn [id] (node/placed-span (get-in % [:symbols :main :nodes id]))) - [:a :n :b :insert]) - r (lane/append-drawing doc :main :girl :n :drawing-n - {:at 4 :extent :grow-symbol})] - (is (= [[0 4] [4 5] [5 9] [9 13]] (spans (:clip r)))) - (is (= 13 (get-in r [:clip :symbols :main :frames]))) - (is (= (keys-of doc) (keys-of (:clip r))) "lane keys stay where they were authored") - (is (= :n (:selection r))) - (is (= 4 (:frame r))) - (is (empty? (clip/problems (:clip r)))) - ;; The same command with no room refuses, and says how much it needs. - (is (= 13 (:required-frames (lane/append-drawing doc :main :girl :n :drawing-n {:at 4})))) - ;; At the very front everything moves. - (is (= [[1 5] [0 1] [5 9] [9 13]] - (spans (:clip (lane/append-drawing doc :main :girl :n :drawing-n - {:at 0 :extent :grow-symbol}))))) - ;; Inside a cel is not a position for another one. - (is (re-find #"split it first" - (:refused (lane/append-drawing doc :main :girl :n :drawing-n - {:at 2 :extent :grow-symbol})))) - (is (:refused (lane/append-drawing doc :main :girl :n :drawing-n - {:at -1 :extent :grow-symbol}))) - (is (:refused (lane/append-drawing doc :main :girl :n :drawing-n - {:at ##Inf :extent :grow-symbol}))) - ;; Reuse and duplicate take a position too; it is one placement rule. - (is (= [4 5] (node/placed-span - (get-in (lane/reuse-drawing doc :main :girl :n :drawing-b - {:at 4 :extent :grow-symbol}) - [:clip :symbols :main :nodes :n])))) - (is (= [4 5] (node/placed-span - (get-in (lane/duplicate-drawing doc :main :b :n - {:at 4 :extent :grow-symbol}) - [:clip :symbols :main :nodes :n])))))) - -(deftest split-then-place-puts-a-drawing-inside-a-hold - ;; The two commands the doc asks for, composed: neither one guesses. - (let [doc (document) - cut (:clip (span/split doc :main :a 2 :right)) - r (lane/append-drawing cut :main :girl :n :drawing-n - {:at 2 :extent :grow-symbol}) - after (:clip r)] - (is (= [[0 2] [2 3] [3 5] [5 9] [9 13]] - (mapv #(node/placed-span (get-in after [:symbols :main :nodes %])) - [:a :n :right :b :insert]))) - (is (= (get-in doc [:symbols :main :nodes :girl :channels]) - (get-in after [:symbols :main :nodes :girl :channels])) - "the performance is still timed the way it was authored") - (is (empty? (clip/problems after))))) - -(deftest a-three-frame-correction-crosses-a-drawing-boundary - ;; The lane model's worked example. The correction belongs to the GIRL, so it - ;; applies across whichever drawings are showing under it, and outside its - ;; three frames the animation evaluates exactly as it did before. - (let [doc (document) - fs (range 12) - before (drawn doc fs) - beat (ch/layer :beat [3 6] :offset (ch/framed [30 0])) - c (update-in doc [:symbols :main :nodes :girl :channels [:xform :pos] :over] - (fnil conj []) beat) - after (drawn c fs) - outside [0 1 2 6 7 8 9 10 11]] - (is (empty? (clip/problems c))) - (is (= (mapv before outside) (mapv after outside)) - "outside the support, frame for frame identical") - (let [at (sample c [3 4 5])] - ;; Frame 3 shows drawing A and frames 4 and 5 show drawing B: one - ;; correction, reaching across the cut between them. - (is (= 70 (get-in at [3 [:a :mark]]))) - (is (= 90 (get-in at [4 [:b :mark]]))) - (is (= 102 (get-in at [5 [:b :mark]])) "and B's own correction still applies under it") - (is (= [-10 0 10] (mapv (fn [f] (js/Math.round (get-in at [f :plate]))) [3 4 5])) - "while the background, which is not in the lane, does not move")) - ;; One document change: one step, and it persists in the channel's own leaf. - (let [b (leaf/leaves :p doc) - a (leaf/leaves :p c) - h (-> nil history/hold (history/record b a 0) history/settle)] - (is (= 1 (count (:done h)))) - (is (= b (:leaves (history/undo h a)))) - (is (= c (leaf/clip :p a)) "a correction needs no codec of its own")))) - -(deftest a-correction-on-one-cel-travels-with-it - ;; The other half of ownership: a layer on a cel is in that - ;; cel's own frames, so moving the cel moves the correction and - ;; nothing has to say so. - (let [beat (ch/layer :beat [0 2] :offset (ch/framed [7 0])) - doc (update-in (document) [:symbols :main :nodes :b :channels [:xform :pos] :over] - (fnil conj []) beat) - moved (:clip (lane/extend-hold doc :main :a 2 {:extent :grow-symbol}))] - ;; Stated as the difference from the same document without the correction, - ;; so the claim is about WHERE the layer applies and not about arithmetic. - (let [nudge (fn [with without f] - (- (get-in (sample with [f]) [f [:b :mark]]) - (get-in (sample without [f]) [f [:b :mark]])))] - (is (= [7 7 0 0] (mapv #(nudge doc (document) %) [4 5 6 7])) - "B's first two frames, which are lane frames 4 and 5") - (is (= [7 7 0 0] - (mapv #(nudge moved (:clip (lane/extend-hold (document) :main :a 2 - {:extent :grow-symbol})) - %) - [6 7 8 9])) - "and after A's hold grows, B's first two frames, which are now 6 and 7")) - (is (= (get-in doc [:symbols :main :nodes :b :channels]) - (get-in moved [:symbols :main :nodes :b :channels])) - "the layer itself was not touched by the retiming") - (is (empty? (clip/problems moved))))) - -(defn- spans [clip ids] - (mapv #(node/placed-span (get-in clip [:symbols :main :nodes %])) ids)) - -(deftest blanking-leaves-a-gap-and-does-not-close-it - (let [doc (document) - r (lane/blank doc :main :girl [5 7] {:id :rest}) - after (:clip r)] - ;; B spanned the range, so it became two cels with a hole between them. - (is (= [[0 4] [4 5] [7 8] [8 12]] (spans after [:a :b :rest :insert]))) - (is (= :rest (:selection r))) - (let [at (sample after [4 5 6 7])] - (is (= #{:plate} (set (keys (at 5)))) "nothing is drawn on a blanked frame") - (is (= #{:plate} (set (keys (at 6))))) - (is (get-in at [4 [:b :mark]])) - (is (get-in at [7 [:rest :mark]]))) - (is (= 12 (get-in after [:symbols :main :frames]))) - (is (empty? (clip/problems after))))) - -(deftest blanking-a-whole-cel-removes-it-and-keeps-its-drawing - (let [doc (document) - after (:clip (lane/blank doc :main :girl [4 8] {}))] - (is (nil? (get-in after [:symbols :main :nodes :b]))) - (is (= [[0 4] [8 12]] (spans after [:a :insert])) "and moves nothing") - (is (= (get-in doc [:symbols :drawing-b]) (get-in after [:symbols :drawing-b])) - "a lane does not own its content") - (is (empty? (clip/problems after))))) - -(deftest blanking-a-range-trims-what-it-only-partly-covers - (let [doc (document) - after (:clip (lane/blank doc :main :girl [3 9] {}))] - (is (= [[0 3] [9 12]] (spans after [:a :insert]))) - (is (nil? (get-in after [:symbols :main :nodes :b]))) - (is (= (get-in (sample doc [9]) [9 [:insert :mark]]) - (get-in (sample after [9]) [9 [:insert :mark]])) - "the insert kept its own frames, so frame 9 shows what it showed") - (is (empty? (clip/problems after))))) - -(deftest overwrite-clears-one-frame-and-does-not-ripple-what-follows - (let [r (lane/overwrite-drawing (document) :main :girl :n :drawing-n 5 - {:extent :keep :remainder-id :right}) - after (:clip r) - nodes (get-in after [:symbols :main :nodes])] - (is (= :n (:selection r))) - (is (= [[0 4] [4 5] [5 6] [6 8] [8 12]] - (mapv #(node/placed-span (get nodes %)) [:a :b :n :right :insert]))) - (is (= :drawing-b (node/source (:right nodes)))) - (is (= 12 (get-in after [:symbols :main :frames]))) - (is (empty? (clip/problems after))))) - -(deftest blank-refuses-what-it-cannot-do-in-one-piece - (let [doc (document)] - (is (re-find #"free ID" (:refused (lane/blank doc :main :girl [5 7] {}))) - "splitting a cel needs an ID for the remainder") - (is (:refused (lane/blank doc :main :girl [5 7] {:id :a})) "and a free one") - (is (:refused (lane/blank doc :main :girl [7 5] {}))) - (is (:refused (lane/blank doc :main :girl [5 5] {}))) - (is (:refused (lane/blank doc :main :girl [5 6.5] {}))) - (is (:refused (lane/blank doc :main :plate [0 2] {}))))) - -(deftest the-shot-length-is-authored-and-emptying-a-lane-does-not-shorten-it - ;; The window and the occupied extent are two facts. A shot with nothing in - ;; the last half is a shot somebody authored that long, and deleting the last - ;; drawing must not quietly shorten the film. - (let [doc (document) - empty-lane (:clip (lane/blank doc :main :girl [0 12] {}))] - (is (empty? (symbol/lane-clips (get-in empty-lane [:symbols :main :nodes]) :girl))) - (is (= 12 (get-in empty-lane [:symbols :main :frames]))) - (is (empty? (clip/problems empty-lane))) - ;; Growing is still the caller's word, and only ever grows. - (is (:refused (lane/append-drawing empty-lane :main :girl :n :drawing-n {:at 20}))) - (is (= 21 (get-in (lane/append-drawing empty-lane :main :girl :n :drawing-n - {:at 20 :extent :grow-symbol}) - [:clip :symbols :main :frames]))) - (is (= 12 (get-in (:clip (span/trim doc :main :insert :out 9)) - [:symbols :main :frames])) - "and trimming the last cel leaves the window where it was"))) - -(deftest a-take-placed-in-a-lane-is-still-heard - ;; `bring/take` puts a take's sound INSIDE the symbol it makes, so that - ;; "wherever the symbol is placed it is heard". A lane is one of the places it - ;; can be placed, and must not be the one place that goes silent. - (let [doc (assoc-in (document) [:symbols :take] - {:id :take :frames 10 :fps 24 - :nodes {:pic {:id :pic :kind :instance :z "a" - :source {:symbol :wave} :span [0 10] - :time {:mode :map :at 0 :rate 1} - :playback {:in 0 :speed 1 :end :stop}} - :sound {:id :sound :name "sound" :kind :audio - :parent nil :z "z-sound" - :source {:footage "f1"} :span [0 10] - :time {:mode :map :at 0 :rate 1}}}}) - at-root (clip/place-symbol doc nil :main :take 0 :root nil) - in-lane (:clip (lane/place-symbol doc nil :main :girl :drop :take 0 - {:extent :grow-symbol :remainder-id :tail}))] - (is (= 1 (count (nest/audio-tracks at-root :main))) - "a take placed at the root is heard") - (is (some? in-lane) "the take goes into the lane") - (is (= 1 (count (nest/audio-tracks in-lane :main))) - "and is still heard from inside a lane"))) - -(deftest a-sound-is-a-clip-in-a-lane-like-any-other - ;; Everything in the timeline is a lane, audio included: a sound claims lane - ;; time by the same rule, and what a lane will not do is hold both kinds. - (let [made (lane/add-lane (document) :main :track) - seeded (clip/place-sound (:clip made) :main {:sound "s1"} "voice" 6 1 2 :vo) - result (lane/adopt seeded :main :track :vo 2 {:extent :grow-symbol}) - after (:clip result) - n (get-in after [:symbols :main :nodes :vo])] - (is (nil? (:refused result)) (str (:refused result))) - (is (= :track (:parent n))) - (is (= [2 8] (node/placed-span n))) - (is (empty? (clip/problems after))) - (is (= 1 (count (nest/audio-tracks after :main))) - "a sound in a lane is still heard") - (is (= [:vo] (mapv :id (symbol/lane-clips (get-in after [:symbols :main :nodes]) :track)))) - ;; The one thing a lane refuses: being half picture and half sound, which - ;; is the explicit capability rather than a guess per frame. - (let [mixed (lane/place-symbol after nil :main :track :also :wave 2 - {:extent :grow-symbol :remainder-id :rest})] - (is (:refused mixed)) - (is (re-find #"picture or sound" (str (:refused mixed)))) - (is (= [:vo] (mapv :id (symbol/lane-clips (get-in after [:symbols :main :nodes]) :track))) - "and the sound it would have had to delete to make room is still there")))) diff --git a/frontend/test/arthur/domain/sequence_test.cljs b/frontend/test/arthur/domain/sequence_test.cljs new file mode 100644 index 0000000..bedfc3b --- /dev/null +++ b/frontend/test/arthur/domain/sequence_test.cljs @@ -0,0 +1,812 @@ +(ns arthur.domain.sequence-test + "The commands that need a SEQUENCE, which is now a symbol drawn as a lane and + its own children rather than a group with `:layout :sequence`. Was + `lane_test`; the fixtures changed and the assertions did not, except where + they are called out below as behaviour that changed on purpose." + (:require [cljs.test :refer [deftest is testing]] + [arthur.domain.bring :as bring] + [arthur.domain.channel :as ch] + [arthur.domain.clip :as clip] + [arthur.domain.history :as history] + [arthur.domain.leaf :as leaf] + [arthur.domain.nest :as nest] + [arthur.domain.node :as node] + [arthur.domain.palette :as pal] + [arthur.domain.pick :as pick] + [arthur.domain.span :as span] + [arthur.domain.symbol :as symbol])) + +(defn drawing [id x frames] + {:id id :frames frames + :nodes {:mark {:id :mark :kind :rect :z "a" + :channels {[:geom :size] (ch/framed 4) + [:xform :pos] (ch/framed [x 0])}}}}) + +(defn cel + "A clip of the sequence. PARENTLESS, because the symbol is the container." + [id source at duration speed] + {:id id :kind :instance :z (name id) + :source {:symbol source} :playback {:in 0 :speed speed :end :stop} + :time {:at at :rate 1} :span [0 duration]}) + +(defn document + "`:main`, drawn as a lane, holding three clips and a background shape. + + `:plate` HAS NO SPAN, so it is on screen for the whole shot and is not in the + sequence at all — which is what `symbol/children` skips, and the reason an + ordinary shape sitting in a lane symbol is not something an edge edit can trim." + [] + (let [a (cel :a :drawing-a 0 4 0) + b (assoc-in (cel :b :drawing-b 4 4 0) + [:channels [:xform :pos]] (ch/keyed {0 [0 0] 1 [2 0]} :hold)) + insert (assoc-in (cel :insert :wave 8 4 1) [:playback :in] 3)] + {:name "cels" :fps 24 :width 320 :height 200 + :symbols + {:main {:id :main :frames 12 :display :lane + :nodes {:a a :b b :insert insert + :plate {:id :plate :kind :rect :z "a" + :channels {[:geom :size] (ch/framed 10) + [:xform :pos] (ch/keyed {0 [-40 0] 11 [70 0]} :linear)}}}} + :drawing-a (drawing :drawing-a 10 1) + :drawing-b (drawing :drawing-b 20 1) + :wave (assoc-in (drawing :wave 0 10) [:nodes :mark :channels [:xform :pos]] + (ch/keyed {0 [0 0] 9 [900 0]} :linear))}})) + +(defn shot + "`doc` with `:main` placed in a containing symbol as the instance `:girl`, + carrying the keyed transform the LANE GROUP used to carry, and the plate moved + out to be the background that is not in the sequence. + + THE PLACING INSTANCE IS WHERE THE LANE'S TRANSFORM WENT. A lane was a group + and could be animated; a symbol cannot, so what moves a whole sequence is now + the instance that places it. These are the tests that used to animate `:girl` + the group and now animate `:girl` the instance — the same six keys, and the + same answer frame for frame." + [doc] + (-> doc + (update-in [:symbols :main :nodes] dissoc :plate) + (assoc-in [:symbols :shot] + {:id :shot :frames 12 :fps 24 + :nodes {:girl {:id :girl :kind :instance :z "b" :span [0 12] + :time {:mode :map :at 0 :rate 1} + :source {:symbol :main} + :playback {:in 0 :speed 1 :end :stop} + :channels {[:xform :pos] + (ch/keyed {0 [0 0] 6 [60 0] 12 [0 0]} :linear)}} + :plate (get-in doc [:symbols :main :nodes :plate])}}))) + +(defn sample-in [doc sid fs] + (let [r (clip/resolver doc sid nil pal/index-of nil)] + (into {} (map (fn [f] [f (into {} (map (juxt :node :cx)) (r f))])) fs))) + +(defn sample [doc fs] (sample-in doc :main fs)) + +(deftest one-sequence-mixes-held-drawings-and-playing-content + (let [doc (document) at (sample doc (range 12))] + (is (empty? (clip/problems doc))) + (is (= 10 (get-in at [3 [:a :mark]]))) + (is (= 20 (get-in at [4 [:b :mark]]))) + (is (= 22 (get-in at [5 [:b :mark]]))) + (is (= 300 (get-in at [8 [:insert :mark]]))) + (is (= 600 (get-in at [11 [:insert :mark]]))) + (is (= (zipmap (range 12) (range -40 80 10)) + (into {} (map (fn [[f ops]] [f (js/Math.round (:plate ops))])) at))) + (is (nil? (get-in at [4 [:a :mark]])) "half-open cuts have a single owner"))) + +(deftest the-placing-instance-animates-the-whole-sequence + ;; What `:girl` the lane group used to do, `:girl` the instance does: one + ;; transform over whichever drawing is showing under it, every frame. + (let [doc (shot (document)) at (sample-in doc :shot (range 12))] + (is (empty? (clip/problems doc))) + (is (= 40 (get-in at [3 [:girl :a :mark]]))) + (is (= 60 (get-in at [4 [:girl :b :mark]]))) + (is (= 72 (get-in at [5 [:girl :b :mark]]))) + (is (= 340 (get-in at [8 [:girl :insert :mark]]))) + (is (= 610 (get-in at [11 [:girl :insert :mark]]))) + (is (= (zipmap (range 12) (range -40 80 10)) + (into {} (map (fn [[f ops]] [f (js/Math.round (:plate ops))])) at)) + "and the background, which is not in the sequence, does not move with it"))) + +(deftest cel-ripple-keeps-the-containers-keys-and-moves-cel-corrections + (let [doc (shot (document)) + result (span/extend-hold doc :main :a 2 {:extent :grow-symbol}) + after (:clip result) + nodes (get-in after [:symbols :main :nodes])] + (is (= :a (:selection result))) + (is (= 14 (get-in after [:symbols :main :frames]))) + (is (= [0 6] (node/placed-span (:a nodes)))) + (is (= [6 10] (node/placed-span (:b nodes)))) + (is (= [10 14] (node/placed-span (:insert nodes)))) + (doseq [id [:a :b :insert]] + (is (= (get-in doc [:symbols :main :nodes id :channels]) (:channels (nodes id)))) + (is (= (get-in doc [:symbols :main :nodes id :playback]) (:playback (nodes id))))) + (is (= (get-in doc [:symbols :shot :nodes :girl]) + (get-in after [:symbols :shot :nodes :girl])) + "re-spanning a sequence does not touch what places it") + (let [at (sample-in after :shot [5 6 7 10])] + (is (= 60 (get-in at [5 [:girl :a :mark]]))) + (is (= 80 (get-in at [6 [:girl :b :mark]]))) + (is (= 72 (get-in at [7 [:girl :b :mark]])) "B's correction follows B") + (is (= 320 (get-in at [10 [:girl :insert :mark]])) "insert starts on source frame 3")) + (is (empty? (clip/problems after))) + (is (= (assoc-in doc [:symbols :main :frames] 14) + (:clip (span/extend-hold after :main :a -2 {}))) + "shrinking restores content, except the explicitly grown shot"))) + +(deftest overflow-and-invalid-edits-are-atomic + (let [doc (document) + result (span/extend-hold doc :main :a 2 {})] + (is (:refused result)) + (is (= 14 (:required-frames result))) + (is (not (contains? result :clip))) + (doseq [delta [0 -4 0.5 js/NaN]] + (is (:refused (span/extend-hold doc :main :a delta {})))) + (is (:refused (span/extend-hold doc :main :insert 1 {}))) + (is (:refused (span/extend-hold doc :main :missing 1 {}))) + (is (:refused (span/extend-hold (update-in doc [:symbols :main] dissoc :display) + :main :a 2 {:extent :grow-symbol})) + "lengthening a hold is a sequence edit, so it needs a symbol drawn as one"))) + +(deftest dragging-a-cel-edge-trims-neighbours-or-ripples-them + (let [doc (document) + clips #(mapv node/placed-span (symbol/children (get-in % [:symbols :main :nodes]))) + plain (:clip (span/resize-out doc :main :a 6 {})) + across (:clip (span/resize-out doc :main :a 9 {})) + ripple (:clip (span/resize-out doc :main :a 6 {:ripple? true + :extent :grow-symbol})) + shrink (:clip (span/resize-out doc :main :a 2 {:ripple? true}))] + (is (= [[0 6] [6 8] [8 12]] (clips plain)) + "a normal grow eats the beginning of the adjacent cel") + (is (= [[0 9] [9 12]] (clips across)) + "a long grow removes wholly consumed cels and trims the survivor") + (is (= [[0 6] [6 10] [10 14]] (clips ripple)) + "shift-grow moves every later cel") + (is (= [[0 2] [2 6] [6 10]] (clips shrink)) + "shift-shrink pulls every later cel left") + (is (:refused (span/resize-out doc :main :a 0 {}))) + (is (:refused (span/resize-out doc :main :a 2.5 {}))))) + +(deftest outside-lane-mode-an-edge-edit-disturbs-nothing + ;; The claim-time rule FOLLOWS THE MODE. The same document not drawn as a lane + ;; is a composition, and things in a composition are allowed to be on screen + ;; together — so growing one clip over another simply does that. + (let [doc (update-in (document) [:symbols :main] dissoc :display) + after (:clip (span/resize-out doc :main :a 6 {})) + nodes (get-in after [:symbols :main :nodes])] + (is (= [0 6] (node/placed-span (:a nodes)))) + (is (= [4 8] (node/placed-span (:b nodes))) "the neighbour is left exactly as it was") + (is (= 1 (count (symbol/overlaps (get-in after [:symbols :main]))))) + (is (empty? (clip/problems after)) "and an overlap is not a reason a document will not load"))) + +(deftest the-middle-of-a-cut-rolls-both-edges + (let [doc (document) + clips #(mapv node/placed-span (symbol/children (get-in % [:symbols :main :nodes]))) + rolled (:clip (span/roll doc :main :a :b 6)) + right-only (:clip (span/resize-in doc :main :b 6)) + grown-left (:clip (span/resize-in doc :main :b 2))] + (is (= [[0 6] [6 8] [8 12]] (clips rolled)) + "the shared cut moves without moving either clip") + (is (= [[0 4] [6 8] [8 12]] (clips right-only)) + "the right side of the junction trims only the right clip") + (is (= [[0 2] [2 8] [8 12]] (clips grown-left)) + "growing the right clip left trims the neighbour instead of overlapping") + (is (:refused (span/roll doc :main :a :b 0))) + (is (:refused (span/roll doc :main :a :insert 6))) + (is (:refused (span/roll (update-in doc [:symbols :main] dissoc :display) :main :a :b 6)) + "a roll is a sequence edit"))) + +(deftest a-gap-is-an-uncovered-interval + (let [doc (update-in (document) [:symbols :main :nodes] dissoc :b) + at (sample doc [3 4 7 8])] + (is (= #{:plate} (set (keys (at 4))))) + (is (= #{:plate} (set (keys (at 7))))) + (is (get-in at [8 [:insert :mark]])) + (is (empty? (clip/problems doc))))) + +(deftest an-overlap-is-a-bug-report-and-not-a-reason-not-to-load + ;; It used to be `clip/problems`, which means the document will not load. A + ;; display hint must never be able to do that, so it is its own diagnostic. + (let [clashing (assoc-in (document) [:symbols :main :nodes :b :time :at] 3)] + (is (= [[:a :b]] (symbol/overlaps (get-in clashing [:symbols :main])))) + (is (empty? (clip/problems clashing)) + "and the document still loads, to be drawn visibly wrong") + (is (empty? (symbol/overlaps (get-in (document) [:symbols :main])))) + (is (empty? (clip/problems + (update-in (document) [:symbols :main :nodes] dissoc :a :b :insert))) + "an empty sequence is valid — a shot is authored before it is filled") + (is (seq (clip/problems + (assoc-in (document) [:symbols :main :nodes :a :span] [0 ##Inf])))) + (is (seq (clip/problems + (assoc-in (document) [:symbols :main :nodes :a :playback :speed] -1)))) + (is (seq (clip/problems + (assoc-in (document) [:symbols :main :nodes :a :layout] :sequence))) + ":layout is not a node field any more") + (is (seq (node/problems {:id :old :kind :instance :z "a" + :channels {[:source] (ch/framed {:of :wave :in 0})}})) + "the obsolete format is rejected"))) + +(deftest no-command-can-commit-an-overlap + ;; THE INVARIANT, ASSERTED OVER THE COMMANDS rather than reasoned about: every + ;; one of them commits through `span/finish`, so sampling them is enough. + ;; Sampled, in the style of `drawn`, rather than computing expected spans by + ;; hand — what is being claimed is that no result holds an overlap, whatever + ;; the numbers are. + (let [doc (document) + every-command + (concat + (for [to (range -1 15)] #(span/resize-out % :main :a to {:extent :grow-symbol})) + (for [to (range -1 15)] #(span/resize-out % :main :b to {:ripple? true :extent :grow-symbol})) + (for [to (range -1 15)] #(span/resize-in % :main :b to)) + (for [to (range -1 15)] #(span/roll % :main :a :b to)) + (for [cut (range -1 15)] #(span/split % :main :insert cut :piece)) + (for [to (range -1 15)] #(span/trim % :main :insert :out to)) + (for [to (range -1 15)] #(span/move % :main :insert to)) + (for [d (range -5 6)] #(span/extend-hold % :main :a d {:extent :grow-symbol})) + (for [a (range 0 13) b (range 0 13)] #(span/blank % :main [a b] {:id :rest})) + (for [at (range -1 15)] #(span/append-drawing % :main :n :drawing-n + {:at at :extent :grow-symbol})) + (for [at (range -1 15)] #(span/reuse-drawing % :main :n :drawing-b + {:at at :extent :grow-symbol})) + (for [at (range -1 15)] #(span/duplicate-drawing % :main :b :n + {:at at :extent :grow-symbol})) + (for [at (range -1 15)] #(span/overwrite-drawing % :main :n :drawing-n at + {:extent :grow-symbol + :remainder-id :rest})) + (for [at (range -1 15)] #(span/place-symbol % nil :main :n :wave at + {:extent :grow-symbol + :remainder-id :rest})) + (for [at (range -1 15)] #(span/adopt % :main :b at {:extent :grow-symbol + :remainder-id :rest})) + [#(span/make-unique (:clip (span/reuse-drawing % :main :n :drawing-a + {:extent :grow-symbol})) + :main :n {})]) + results (keep (fn [command] (:clip (command doc))) every-command)] + (is (< 190 (count results)) "the sample is of commands that actually did something") + (doseq [after results] + (is (empty? (symbol/overlaps (get-in after [:symbols :main]))) + (str "a command committed an overlap: " + (pr-str (mapv (juxt :id node/placed-span) + (symbol/children (get-in after [:symbols :main :nodes])))))) + (is (empty? (clip/problems after)))))) + +(deftest turning-lane-mode-on-is-the-one-thing-that-can-be-refused + (let [composed (-> (document) + (update-in [:symbols :main] dissoc :display) + (assoc-in [:symbols :main :nodes :b :time :at] 3)) + refused (span/draw-as-lane composed :main true {}) + trimmed (:clip (span/draw-as-lane composed :main true {:trim? true}))] + (is (:refused refused)) + (is (= 1 (:required-trim refused))) + (is (nil? (:clip refused)) "and nothing moved") + (is (= :lane (get-in trimmed [:symbols :main :display]))) + (is (= [[0 3] [3 7] [8 12]] + (mapv node/placed-span (symbol/children (get-in trimmed [:symbols :main :nodes])))) + "the retry trims later-claims-from-earlier, the rule everything else follows") + (is (empty? (symbol/overlaps (get-in trimmed [:symbols :main])))) + (is (empty? (clip/problems trimmed))) + ;; A clip the next one wholly covers has nothing left to be. + (let [buried (assoc-in composed [:symbols :main :nodes :b :time :at] 0) + after (:clip (span/draw-as-lane buried :main true {:trim? true}))] + (is (nil? (get-in after [:symbols :main :nodes :a]))) + (is (empty? (symbol/overlaps (get-in after [:symbols :main]))))) + ;; Off is always possible, and changes nothing but the hint. + (let [off (:clip (span/draw-as-lane (document) :main false {}))] + (is (nil? (get-in off [:symbols :main :display]))) + (is (= (get-in (document) [:symbols :main :nodes]) + (get-in off [:symbols :main :nodes])))) + (is (:refused (span/draw-as-lane (document) :nothing-here true {}))) + (is (= :lane (get-in (:clip (span/draw-as-lane (document) :main true {})) + [:symbols :main :display])) + "a sequence that is already one turns on with nothing to trim"))) + +(deftest playback-is-independent-of-property-channel-shape + (let [doc (document) + n (get-in doc [:symbols :main :nodes :a]) + keyed (node/toggle-key n [:xform :rot] 0 nil) + unkeyed (node/toggle-key keyed [:xform :rot] 0 nil)] + (doseq [n [n keyed unkeyed]] + (is (= {:symbol :drawing-a :frame 0} (node/placed-frame n 11 1)))) + (let [n (get-in doc [:symbols :main :nodes :insert])] + (is (= {:symbol :wave :frame 5} (node/placed-frame n 2 10))) + (is (nil? (node/placed-frame n 7 10))) + (is (= 9 (:frame (node/placed-frame (assoc-in n [:playback :end] :hold) 9 10)))) + (is (= 2 (:frame (node/placed-frame (assoc-in n [:playback :end] :loop) 9 10))))))) + +(deftest navigation-and-hit-testing-use-the-same-source-time + (let [doc (document) + n (get-in doc [:symbols :main :nodes :insert])] + (is (= 5 (:frame (nest/inside doc nil :main [:insert] 10)))) + (is (= {:at 5 :rate 1} (:time (nest/inside doc nil :main [:insert] 10)))) + (is (= 0 (:frame (nest/inside doc nil :main [:a] 3)))) + (is (nil? (:time (nest/inside doc nil :main [:a] 3)))) + (is (nil? (nest/inside doc nil :main [:a] 4))) + (is (= ((pick/bounds-of doc nil :main n) 2) + ((pick/bounds-of doc nil :main (assoc-in n [:playback :in] 5)) 0))))) + +(deftest seeking-and-source-reuse-do-not-share-cursors + (let [doc (assoc-in (document) [:symbols :main :nodes :b :source :symbol] :drawing-a) + fs [11 0 5 3 8 4 10 1 6 2 9 7] + at (sample doc fs)] + (is (= at (sample doc (reverse fs)))) + (is (= at (sample doc (range 12)))) + (let [edited (assoc-in doc [:symbols :drawing-a :nodes :mark :channels [:xform :pos]] + (ch/framed [99 0]))] + (is (= 99 (get-in (sample edited [0 4]) [0 [:a :mark]]))) + (is (= 99 (get-in (sample edited [0 4]) [4 [:b :mark]])))))) + +(deftest cel-identities-and-playback-round-trip + (let [doc (:clip (span/extend-hold (document) :main :a 2 {:extent :grow-symbol})) + leaves (leaf/leaves :project doc)] + (is (= doc (leaf/clip :project leaves))) + (is (contains? leaves "clip/project/symbol/main/node/a")) + (is (= :lane (get-in (leaf/clip :project leaves) [:symbols :main :display])) + "lane mode is saved like any other field of a symbol") + (let [{copied :clip ids :ids} + (bring/symbols (assoc-in (clip/blank) [:symbols :drawing-a] (drawing :drawing-a 99 1)) + doc [:main] {})] + (is (= :drawing-a-2 (:drawing-a ids))) + (is (= #{:drawing-a-2 :drawing-b :wave} (clip/places copied (:main ids)))) + (is (empty? (clip/problems copied)))))) + +(deftest one-transaction-undoes-the-ripple-and-shot-extension + (let [doc (document) + after (:clip (span/extend-hold doc :main :a 2 {:extent :grow-symbol})) + before-leaves (leaf/leaves :p doc) + after-leaves (leaf/leaves :p after) + h (-> nil history/hold (history/record before-leaves after-leaves 0) history/settle) + undo (history/undo h after-leaves) + redo (history/redo (:history undo) (:leaves undo))] + (is (= 1 (count (:done h)))) + (is (= before-leaves (:leaves undo))) + (is (= after-leaves (:leaves redo))))) + +(deftest a-new-document-is-ordinary-and-a-lane-is-created-explicitly + (let [doc (clip/blank) + lane (:clip (span/draw-as-lane doc :main true {})) + a (:clip (span/append-drawing lane :main :a :drawing-a {})) + b (:clip (span/append-drawing a :main :b :drawing-b {}))] + (is (= {} (get-in doc [:symbols :main :nodes]))) + (is (nil? (get-in doc [:symbols :main :display]))) + (is (= :lane (get-in lane [:symbols :main :display]))) + (is (empty? (clip/problems b))) + (is (= [1 2] (node/placed-span (get-in b [:symbols :main :nodes :b])))) + (is (= 0 (get-in b [:symbols :main :nodes :b :playback :speed]))) + (is (:refused (span/append-drawing b :main :a :new {}))))) + +(deftest arbitrary-symbols-drop-into-the-sequence-and-claim-their-time + (let [doc (document) + dropped (span/place-symbol doc nil :main :clip :wave 2 + {:extent :grow-symbol :remainder-id :tail}) + after (:clip dropped) + clips (symbol/children (get-in after [:symbols :main :nodes]))] + (is (= :clip (:selection dropped))) + (is (= [[0 2] [2 12]] (mapv node/placed-span clips)) + "the natural ten-frame symbol claims [2,12), trimming/removing incumbents") + (is (= :wave (node/source (second clips)))) + (is (= 1 (:speed (node/playback-of (second clips)))) + "a dropped symbol plays; it is not converted into a drawing hold") + (is (empty? (clip/problems after))) + ;; Outside lane mode the same drop claims nothing. + (let [composed (update-in doc [:symbols :main] dissoc :display) + after (:clip (span/place-symbol composed nil :main :clip :wave 2 + {:extent :grow-symbol :remainder-id :tail}))] + (is (= [[0 4] [2 12] [4 8] [8 12]] + (mapv node/placed-span (symbol/children (get-in after [:symbols :main :nodes])))) + "it is simply placed, on screen with what was already there")))) + +(deftest an-existing-clip-can-be-moved-and-claim-where-it-lands + (let [doc (assoc-in (document) [:symbols :main :nodes :badge] + {:id :badge :kind :instance :z "z" + :source {:symbol :wave} :span [0 3] + :time {:at 1 :rate 1} + :playback {:in 2 :speed 1 :end :stop}}) + result (span/adopt doc :main :badge 5 + {:extent :grow-symbol :remainder-id :tail}) + after (:clip result) + n (get-in after [:symbols :main :nodes :badge])] + (is (= [5 8] (node/placed-span n))) + (is (= {:in 2 :speed 1 :end :stop} (:playback n)) + "a move changes placement, not source timing") + (is (= [[0 4] [4 5] [5 8] [8 12]] + (mapv node/placed-span (symbol/children (get-in after [:symbols :main :nodes]))))) + (is (empty? (clip/problems after))) + (is (:refused (span/adopt doc :main :plate 5 {})) "and a shape has no frames to place"))) + +(deftest fractional-placement-rates-convert-the-hold-delta + (let [doc (-> (document) + (assoc-in [:symbols :main :nodes :a :time :rate] 2) + (assoc-in [:symbols :main :nodes :a :span] [0 8])) + after (:clip (span/extend-hold doc :main :a 2 {:extent :grow-symbol}))] + (is (= [0 12] (get-in after [:symbols :main :nodes :a :span]))) + (is (= [6 10] (node/placed-span (get-in after [:symbols :main :nodes :b])))))) + +(deftest bare-shapes-agree-in-reference-and-playback + (let [sym (drawing :bare 12 1)] + (is (= (symbol/eval-frame sym 0 nil pal/index-of nil) + ((symbol/resolver sym nil pal/index-of nil) 0)) + "omitted style colour must not crash a missing cursor"))) + +(deftest audio-follows-only-the-playing-cel + (let [voice {:id :voice :kind :audio :z "a" :source {:sound "voice"} + :span [0 10] + :channels {[:audio :gain] (ch/keyed {0 0 5 1} :linear)}} + doc (-> (document) + (assoc-in [:symbols :wave :nodes :voice] voice) + (assoc-in [:symbols :drawing-a :nodes :voice] voice)) + [track :as tracks] (nest/audio-tracks doc :main)] + (is (= 1 (count tracks)) "the frozen drawing contributes no audio") + (is (= [8 12] (node/placed-span track))) + (is (= [3 7] (:span track)) "the source in-point trims the audio too") + (is (= {5 0 10 1} (get-in track [:channels [:audio :gain] :keys]))) + (let [moved (:clip (span/extend-hold doc :main :a 2 {:extent :grow-symbol})) + [track] (nest/audio-tracks moved :main)] + (is (= [10 14] (node/placed-span track))) + (is (= [3 7] (:span track)))) + ;; The retime that used to be the lane group's is the placing instance's. + (let [fast (-> (shot doc) + (assoc-in [:symbols :shot :nodes :girl :time] {:mode :map :at 2 :rate 2}) + (assoc-in [:symbols :main :nodes :insert :playback :speed] 2)) + [track] (nest/audio-tracks fast :shot)] + (is (= [6 7.75] (node/placed-span track))) + (is (= [3 10] (:span track))) + (is (= 4 (get-in track [:time :rate])))))) + +(deftest a-looped-insert-schedules-distinct-audio-intervals + (let [doc (-> (document) + (assoc-in [:symbols :wave :frames] 4) + (assoc-in [:symbols :wave :nodes :voice] + {:id :voice :kind :audio :z "a" :source {:sound "v"} :span [1 3]}) + (assoc-in [:symbols :main :nodes :insert :playback] + {:in 3 :speed 1 :end :loop}))] + (is (= [[10 12]] (mapv node/placed-span (nest/audio-tracks doc :main)))))) + +(deftest the-shot-a-sequence-needs-is-in-its-own-frames + ;; CHANGED ON PURPOSE. It used to be that an enclosing retime changed how many + ;; frames an edit needed, because the lane was INSIDE the symbol being measured + ;; and its clock sat between them. The symbol is now the container, so its + ;; `:frames` is its own authored window and how fast some instance plays it is + ;; not a fact about it. + (let [doc (shot (document)) + slow (assoc-in doc [:symbols :shot :nodes :girl :time] {:mode :map :at 8 :rate 2})] + (is (= 14 (:required-frames (span/extend-hold slow :main :a 2 {})))) + (is (= 14 (:required-frames (span/extend-hold doc :main :a 2 {})))) + (is (= 14 (get-in (span/extend-hold slow :main :a 2 {:extent :grow-symbol}) + [:clip :symbols :main :frames]))))) + +(deftest reuse-shares-content-and-make-unique-decouples-one-cel + (let [doc (document) + shared (:clip (span/reuse-drawing doc :main :c :drawing-a {:extent :grow-symbol})) + edit (fn [c sym x] + (assoc-in c [:symbols sym :nodes :mark :channels [:xform :pos]] + (ch/framed [x 0])))] + (is (:refused (span/reuse-drawing doc :main :c :drawing-a {})) + "the shot has to be extended on purpose") + (is (= :drawing-a (node/source (get-in shared [:symbols :main :nodes :c])))) + (is (= [12 13] (node/placed-span (get-in shared [:symbols :main :nodes :c])))) + (is (empty? (clip/problems shared))) + ;; One drawing, two cels: the edit arrives at both. + (let [at (sample (edit shared :drawing-a 99) [0 12])] + (is (= 99 (get-in at [0 [:a :mark]]))) + (is (= 99 (get-in at [12 [:c :mark]])))) + (let [unique (:clip (span/make-unique shared :main :c {}))] + (is (= :drawing-a-2 (node/source (get-in unique [:symbols :main :nodes :c])))) + (is (= (:nodes (get-in shared [:symbols :drawing-a])) + (:nodes (get-in unique [:symbols :drawing-a-2]))) + "a copy of the same drawing, not an empty one") + (is (= :drawing-a (node/source (get-in unique [:symbols :main :nodes :a]))) + "the other cel keeps the original") + (let [at (sample (edit unique :drawing-a 99) [0 12])] + (is (= 99 (get-in at [0 [:a :mark]]))) + (is (= 10 (get-in at [12 [:c :mark]])) "the cel made unique is untouched")) + (let [at (sample (edit unique :drawing-a-2 99) [0 12])] + (is (= 10 (get-in at [0 [:a :mark]])) "and does not reach back")) + (is (empty? (clip/problems unique)))) + ;; Nothing else places drawing-b, so there is nothing to decouple from. + (is (:refused (span/make-unique doc :main :b {}))) + (is (:refused (span/make-unique doc :main :plate {})) + "a shape places nothing itself"))) + +(deftest duplicate-copies-the-drawing-and-not-the-cel + (let [doc (document) + made (:clip (span/duplicate-drawing doc :main :b :d {:extent :grow-symbol})) + n (get-in made [:symbols :main :nodes :d])] + (is (= :drawing-b-2 (node/source n))) + (is (= (:nodes (get-in doc [:symbols :drawing-b])) + (:nodes (get-in made [:symbols :drawing-b-2])))) + (is (= [12 13] (node/placed-span n))) + (is (= {:in 0 :speed 0 :end :stop} (:playback n))) + (is (nil? (:channels n)) "B's own position correction belongs to B's cel") + (is (= (get-in doc [:symbols :main :nodes :b]) + (get-in made [:symbols :main :nodes :b])) + "the drawing duplicated is left as it was") + (is (empty? (clip/problems made))))) + +(deftest a-shallow-copy-keeps-its-parts-and-a-deep-copy-owns-them + ;; A drawing assembled from another symbol: copying it shallowly must keep + ;; using that part, and only an explicit deep copy may promise independence. + (let [doc (assoc-in (document) [:symbols :drawing-a :nodes :part] + {:id :part :kind :instance :z "b" :span [0 1] + :time {:at 0 :rate 1} :source {:symbol :wave} + :playback {:in 0 :speed 0 :end :stop}}) + copy (fn [opts] (:clip (span/duplicate-drawing + doc :main :a :d (merge {:extent :grow-symbol} opts)))) + shallow (copy {}) + deep (copy {:deep? true})] + (is (= :wave (node/source (get-in shallow [:symbols :drawing-a-2 :nodes :part])))) + (is (nil? (get-in shallow [:symbols :wave-2]))) + (is (= :wave-2 (node/source (get-in deep [:symbols :drawing-a-2 :nodes :part])))) + (is (= (:nodes (get-in doc [:symbols :wave])) (:nodes (get-in deep [:symbols :wave-2])))) + (is (empty? (clip/problems shallow))) + (is (empty? (clip/problems deep))))) + +(deftest reuse-refuses-what-would-not-be-a-document + (let [doc (document)] + (is (:refused (span/reuse-drawing doc :main :c :nothing-here {}))) + (is (:refused (span/reuse-drawing doc :main :c :main {:extent :grow-symbol})) + "a symbol cannot go inside itself") + (is (:refused (span/reuse-drawing doc :main :a :drawing-a {:extent :grow-symbol})) + "a cel ID in use is not free") + (is (:refused (span/duplicate-drawing doc :main :plate :d {}))))) + +(deftest drawing-on-twos-does-not-quantize-the-containers-transform + ;; Cel length IS the drawing cadence, and it is the only thing on twos here: + ;; the instance placing the sequence has its own clock and keeps moving every + ;; frame. Stepping it would be the cel cadence leaking into continuous motion. + (let [cel (fn [id source at] (cel id source at 2 0)) + doc (-> (shot (document)) + (update-in [:symbols :main :nodes] dissoc :a :b :insert) + (update-in [:symbols :main :nodes] merge + {:c0 (cel :c0 :drawing-a 0) + :c1 (cel :c1 :drawing-b 2) + :c2 (cel :c2 :drawing-a 4)})) + xs {:c0 10 :c1 20 :c2 10} + at (sample-in doc :shot (range 6)) + showing (fn [f] (first (dissoc (at f) :plate)))] + (is (empty? (clip/problems doc))) + (is (= [:c0 :c0 :c1 :c1 :c2 :c2] (mapv #(second (key (showing %))) (range 6))) + "the drawing showing changes every second frame") + (is (= [0 10 20 30 40 50] + (mapv (fn [f] (let [[[_ id _] cx] (showing f)] (- cx (xs id)))) (range 6))) + "and the sequence moves on every frame, odd ones included"))) + +(defn- drawn + "What every frame draws, as sorted values, so a picture can be compared + without naming the cels that produced it." + [doc sid fs] + (let [at (sample-in doc sid fs)] + (mapv #(sort (vals (get at %))) fs))) + +(deftest a-drawing-goes-anywhere-in-the-sequence-and-ripples-what-follows + (let [doc (shot (document)) + keys-of #(get-in % [:symbols :shot :nodes :girl :channels [:xform :pos] :keys]) + spans #(mapv (fn [id] (node/placed-span (get-in % [:symbols :main :nodes id]))) + [:a :n :b :insert]) + r (span/append-drawing doc :main :n :drawing-n {:at 4 :extent :grow-symbol})] + (is (= [[0 4] [4 5] [5 9] [9 13]] (spans (:clip r)))) + (is (= 13 (get-in r [:clip :symbols :main :frames]))) + (is (= (keys-of doc) (keys-of (:clip r))) + "the container's keys stay where they were authored") + (is (= :n (:selection r))) + (is (= 4 (:frame r))) + (is (empty? (clip/problems (:clip r)))) + ;; The same command with no room refuses, and says how much it needs. + (is (= 13 (:required-frames (span/append-drawing doc :main :n :drawing-n {:at 4})))) + ;; At the very front everything moves. + (is (= [[1 5] [0 1] [5 9] [9 13]] + (spans (:clip (span/append-drawing doc :main :n :drawing-n + {:at 0 :extent :grow-symbol}))))) + ;; Inside a cel is not a position for another one. + (is (re-find #"split it first" + (:refused (span/append-drawing doc :main :n :drawing-n + {:at 2 :extent :grow-symbol})))) + (is (:refused (span/append-drawing doc :main :n :drawing-n + {:at -1 :extent :grow-symbol}))) + (is (:refused (span/append-drawing doc :main :n :drawing-n + {:at ##Inf :extent :grow-symbol}))) + ;; Reuse and duplicate take a position too; it is one placement rule. + (is (= [4 5] (node/placed-span + (get-in (span/reuse-drawing doc :main :n :drawing-b + {:at 4 :extent :grow-symbol}) + [:clip :symbols :main :nodes :n])))) + (is (= [4 5] (node/placed-span + (get-in (span/duplicate-drawing doc :main :b :n + {:at 4 :extent :grow-symbol}) + [:clip :symbols :main :nodes :n])))))) + +(deftest split-then-place-puts-a-drawing-inside-a-hold + ;; The two commands the doc asks for, composed: neither one guesses. + (let [doc (shot (document)) + cut (:clip (span/split doc :main :a 2 :right)) + r (span/append-drawing cut :main :n :drawing-n {:at 2 :extent :grow-symbol}) + after (:clip r)] + (is (= [[0 2] [2 3] [3 5] [5 9] [9 13]] + (mapv #(node/placed-span (get-in after [:symbols :main :nodes %])) + [:a :n :right :b :insert]))) + (is (= (get-in doc [:symbols :shot :nodes :girl :channels]) + (get-in after [:symbols :shot :nodes :girl :channels])) + "the performance is still timed the way it was authored") + (is (empty? (clip/problems after))))) + +(deftest a-three-frame-correction-crosses-a-drawing-boundary + ;; The lane model's worked example, with the correction on the INSTANCE that + ;; places the sequence: it applies across whichever drawings are showing under + ;; it, and outside its three frames the animation evaluates exactly as before. + (let [doc (shot (document)) + fs (range 12) + before (drawn doc :shot fs) + beat (ch/layer :beat [3 6] :offset (ch/framed [30 0])) + c (update-in doc [:symbols :shot :nodes :girl :channels [:xform :pos] :over] + (fnil conj []) beat) + after (drawn c :shot fs) + outside [0 1 2 6 7 8 9 10 11]] + (is (empty? (clip/problems c))) + (is (= (mapv before outside) (mapv after outside)) + "outside the support, frame for frame identical") + (let [at (sample-in c :shot [3 4 5])] + ;; Frame 3 shows drawing A and frames 4 and 5 show drawing B: one + ;; correction, reaching across the cut between them. + (is (= 70 (get-in at [3 [:girl :a :mark]]))) + (is (= 90 (get-in at [4 [:girl :b :mark]]))) + (is (= 102 (get-in at [5 [:girl :b :mark]])) + "and B's own correction still applies under it") + (is (= [-10 0 10] (mapv (fn [f] (js/Math.round (get-in at [f :plate]))) [3 4 5])) + "while the background, which is not in the sequence, does not move")) + ;; One document change: one step, and it persists in the channel's own leaf. + (let [b (leaf/leaves :p doc) + a (leaf/leaves :p c) + h (-> nil history/hold (history/record b a 0) history/settle)] + (is (= 1 (count (:done h)))) + (is (= b (:leaves (history/undo h a)))) + (is (= c (leaf/clip :p a)) "a correction needs no codec of its own")))) + +(deftest a-correction-on-one-cel-travels-with-it + ;; The other half of ownership: a layer on a cel is in that cel's own frames, + ;; so moving the cel moves the correction and nothing has to say so. + (let [beat (ch/layer :beat [0 2] :offset (ch/framed [7 0])) + doc (update-in (document) [:symbols :main :nodes :b :channels [:xform :pos] :over] + (fnil conj []) beat) + moved (:clip (span/extend-hold doc :main :a 2 {:extent :grow-symbol}))] + ;; Stated as the difference from the same document without the correction, + ;; so the claim is about WHERE the layer applies and not about arithmetic. + (let [nudge (fn [with without f] + (- (get-in (sample with [f]) [f [:b :mark]]) + (get-in (sample without [f]) [f [:b :mark]])))] + (is (= [7 7 0 0] (mapv #(nudge doc (document) %) [4 5 6 7])) + "B's first two frames, 4 and 5") + (is (= [7 7 0 0] + (mapv #(nudge moved (:clip (span/extend-hold (document) :main :a 2 + {:extent :grow-symbol})) + %) + [6 7 8 9])) + "and after A's hold grows, B's first two frames, which are now 6 and 7")) + (is (= (get-in doc [:symbols :main :nodes :b :channels]) + (get-in moved [:symbols :main :nodes :b :channels])) + "the layer itself was not touched by the retiming") + (is (empty? (clip/problems moved))))) + +(defn- spans [clip ids] + (mapv #(node/placed-span (get-in clip [:symbols :main :nodes %])) ids)) + +(deftest blanking-leaves-a-gap-and-does-not-close-it + (let [doc (document) + r (span/blank doc :main [5 7] {:id :rest}) + after (:clip r)] + ;; B spanned the range, so it became two cels with a hole between them. + (is (= [[0 4] [4 5] [7 8] [8 12]] (spans after [:a :b :rest :insert]))) + (is (= :rest (:selection r))) + (let [at (sample after [4 5 6 7])] + (is (= #{:plate} (set (keys (at 5)))) "nothing is drawn on a blanked frame") + (is (= #{:plate} (set (keys (at 6))))) + (is (get-in at [4 [:b :mark]])) + (is (get-in at [7 [:rest :mark]]))) + (is (= 12 (get-in after [:symbols :main :frames]))) + (is (empty? (clip/problems after))))) + +(deftest blanking-a-whole-cel-removes-it-and-keeps-its-drawing + (let [doc (document) + r (span/blank doc :main [4 8] {}) + after (:clip r)] + (is (nil? (get-in after [:symbols :main :nodes :b]))) + (is (= [[0 4] [8 12]] (spans after [:a :insert])) "and moves nothing") + (is (nil? (:selection r)) + "and names nothing, because emptying frames selects nothing sensible") + (is (= (get-in doc [:symbols :drawing-b]) (get-in after [:symbols :drawing-b])) + "a symbol does not own its content") + (is (empty? (clip/problems after))))) + +(deftest blanking-a-range-trims-what-it-only-partly-covers + (let [doc (document) + after (:clip (span/blank doc :main [3 9] {}))] + (is (= [[0 3] [9 12]] (spans after [:a :insert]))) + (is (nil? (get-in after [:symbols :main :nodes :b]))) + (is (= (get-in (sample doc [9]) [9 [:insert :mark]]) + (get-in (sample after [9]) [9 [:insert :mark]])) + "the insert kept its own frames, so frame 9 shows what it showed") + (is (empty? (clip/problems after))))) + +(deftest overwrite-clears-one-frame-and-does-not-ripple-what-follows + (let [r (span/overwrite-drawing (document) :main :n :drawing-n 5 + {:extent :keep :remainder-id :right}) + after (:clip r) + nodes (get-in after [:symbols :main :nodes])] + (is (= :n (:selection r))) + (is (= [[0 4] [4 5] [5 6] [6 8] [8 12]] + (mapv #(node/placed-span (get nodes %)) [:a :b :n :right :insert]))) + (is (= :drawing-b (node/source (:right nodes)))) + (is (= 12 (get-in after [:symbols :main :frames]))) + (is (empty? (clip/problems after))))) + +(deftest blank-refuses-what-it-cannot-do-in-one-piece + (let [doc (document)] + (is (re-find #"free ID" (:refused (span/blank doc :main [5 7] {}))) + "splitting a cel needs an ID for the remainder") + (is (:refused (span/blank doc :main [5 7] {:id :a})) "and a free one") + (is (:refused (span/blank doc :main [7 5] {}))) + (is (:refused (span/blank doc :main [5 5] {}))) + (is (:refused (span/blank doc :main [5 6.5] {}))) + (is (:refused (span/blank (update-in doc [:symbols :main] dissoc :display) + :main [0 2] {})) + "and a composition has no sequence to leave a hole in"))) + +(deftest the-shot-length-is-authored-and-emptying-it-does-not-shorten-it + ;; The window and the occupied extent are two facts. A shot with nothing in + ;; the last half is a shot somebody authored that long, and deleting the last + ;; drawing must not quietly shorten the film. + (let [doc (document) + emptied (:clip (span/blank doc :main [0 12] {}))] + (is (empty? (symbol/children (get-in emptied [:symbols :main :nodes])))) + (is (= 12 (get-in emptied [:symbols :main :frames]))) + (is (empty? (clip/problems emptied))) + ;; Growing is still the caller's word, and only ever grows. + (is (:refused (span/append-drawing emptied :main :n :drawing-n {:at 20}))) + (is (= 21 (get-in (span/append-drawing emptied :main :n :drawing-n + {:at 20 :extent :grow-symbol}) + [:clip :symbols :main :frames]))) + (is (= 12 (get-in (:clip (span/trim doc :main :insert :out 9)) + [:symbols :main :frames])) + "and trimming the last cel leaves the window where it was"))) + +(deftest a-take-placed-in-a-sequence-is-still-heard + ;; `bring/take` puts a take's sound INSIDE the symbol it makes, so that + ;; "wherever the symbol is placed it is heard". A sequence is one of the places + ;; it can be placed, and must not be the one place that goes silent. + (let [doc (assoc-in (document) [:symbols :take] + {:id :take :frames 10 :fps 24 + :nodes {:pic {:id :pic :kind :instance :z "a" + :source {:symbol :wave} :span [0 10] + :time {:mode :map :at 0 :rate 1} + :playback {:in 0 :speed 1 :end :stop}} + :sound {:id :sound :name "sound" :kind :audio + :parent nil :z "z-sound" + :source {:footage "f1"} :span [0 10] + :time {:mode :map :at 0 :rate 1}}}}) + at-root (clip/place-symbol doc nil :main :take 0 :root nil) + placed (:clip (span/place-symbol doc nil :main :drop :take 0 + {:extent :grow-symbol :remainder-id :tail}))] + (is (= 1 (count (nest/audio-tracks at-root :main))) + "a take placed at the root is heard") + (is (some? placed) "the take goes into the sequence") + (is (= 1 (count (nest/audio-tracks placed :main))) + "and is still heard from inside one"))) + +(deftest a-sound-is-a-clip-of-a-sequence-like-any-other + ;; A sound claims time by the same rule as a picture, and THERE IS NO MIXTURE + ;; RULE ANY MORE: a symbol whose clips are sounds is an audio lane, and that is + ;; the whole of it. The refusal that used to say "picture or sound, not both" + ;; was a property of a lane node, and there is no lane node. + (let [seeded (clip/place-sound (document) :main {:sound "s1"} "voice" 6 1 2 :vo) + result (span/adopt seeded :main :vo 2 {:extent :grow-symbol}) + after (:clip result) + n (get-in after [:symbols :main :nodes :vo])] + (is (nil? (:refused result)) (str (:refused result))) + (is (= [2 8] (node/placed-span n))) + (is (empty? (clip/problems after))) + (is (= 1 (count (nest/audio-tracks after :main))) + "a sound in a sequence is still heard") + (is (contains? (set (map :id (symbol/children (get-in after [:symbols :main :nodes])))) + :vo)) + ;; Picture over sound is picture claiming the frames, like anything else. + (let [mixed (:clip (span/place-symbol after nil :main :also :wave 2 + {:extent :grow-symbol :remainder-id :rest}))] + (is (empty? (symbol/overlaps (get-in mixed [:symbols :main])))) + (is (empty? (clip/problems mixed)))))) diff --git a/frontend/test/arthur/domain/span_test.cljs b/frontend/test/arthur/domain/span_test.cljs index a585859..625a285 100644 --- a/frontend/test/arthur/domain/span_test.cljs +++ b/frontend/test/arthur/domain/span_test.cljs @@ -1,53 +1,22 @@ (ns arthur.domain.span-test - "Split, trim and move, over the two things they have to work on alike: a cel - inside a lane, and a symbol placed straight into a shot. The fixture carries - both on purpose — the commands were lane-gated for as long as a lane was the - only thing anybody had timed, and the point of these tests is that nothing in - them reads a lane." + "Generic span edits in an explicit lane and an ordinary compositing symbol." (:require [cljs.test :refer [deftest is testing]] - [arthur.domain.channel :as ch] [arthur.domain.clip :as clip] - [arthur.domain.lane :as lane] [arthur.domain.node :as node] [arthur.domain.palette :as pal] + [arthur.domain.sequence-test :as fixture] [arthur.domain.span :as span])) -(defn- drawing [id x frames] - {:id id :frames frames - :nodes {:mark {:id :mark :kind :rect :z "a" - :channels {[:geom :size] (ch/framed 4) - [:xform :pos] (ch/framed [x 0])}}}}) +(defn document [] (fixture/document)) -(defn- cel [id source at duration speed] - {:id id :kind :instance :parent :girl :z (name id) - :source {:symbol source} :playback {:in 0 :speed speed :end :stop} - :time {:at at :rate 1} :span [0 duration]}) - -(defn document - "A lane of three cels, and — the part lane_test's fixture has no equivalent of - — `:badge`, an instance of an animated symbol placed straight into `:main` - with a span of its own and no parent at all. Its frames are the SYMBOL's, so - it is the case where the coordinate a command takes is not lane time." - [] - (let [a (cel :a :drawing-a 0 4 0) - b (cel :b :drawing-b 4 4 0) - insert (assoc-in (cel :insert :wave 8 4 1) [:playback :in] 3)] - {:name "spans" :fps 24 :width 320 :height 200 - :symbols - {:main {:id :main :frames 12 - :nodes {:girl {:id :girl :kind :group :layout :sequence :z "b"} - :a a :b b :insert insert - :badge {:id :badge :kind :instance :z "c" - :source {:symbol :wave} - :playback {:in 0 :speed 1 :end :stop} - :time {:at 2 :rate 1} :span [0 8]} - :plate {:id :plate :kind :rect :z "a" - :channels {[:geom :size] (ch/framed 10) - [:xform :pos] (ch/keyed {0 [-40 0] 11 [70 0]} :linear)}}}} - :drawing-a (drawing :drawing-a 10 1) - :drawing-b (drawing :drawing-b 20 1) - :wave (assoc-in (drawing :wave 0 10) [:nodes :mark :channels [:xform :pos]] - (ch/keyed {0 [0 0] 9 [900 0]} :linear))}})) +(defn- ordinary-document [] + (-> (document) + (update-in [:symbols :main] dissoc :display) + (assoc-in [:symbols :main :nodes :badge] + {:id :badge :kind :instance :z "z" + :source {:symbol :wave} + :playback {:in 0 :speed 1 :end :stop} + :time {:at 2 :rate 1} :span [0 8]}))) (defn- sample [doc fs] (let [r (clip/resolver doc :main nil pal/index-of nil)] @@ -57,172 +26,67 @@ (let [at (sample doc fs)] (mapv #(sort (vals (get at %))) fs))) -(defn- spans [clip ids] - (mapv #(node/placed-span (get-in clip [:symbols :main :nodes %])) ids)) +(deftest fixtures-state-the-mode-explicitly + (is (= :lane (get-in (document) [:symbols :main :display]))) + (is (nil? (get-in (ordinary-document) [:symbols :main :display]))) + (is (empty? (clip/problems (document)))) + (is (empty? (clip/problems (ordinary-document))))) -(deftest the-fixture-places-one-thing-outside-the-lane +(deftest splitting-preserves-the-picture-in-both-modes + (doseq [[label doc id cut] [["lane clip" (document) :a 2] + ["ordinary placement" (ordinary-document) :badge 6]]] + (testing label + (let [before (drawn doc (range 12)) + r (span/split doc :main id cut :right) + after (:clip r)] + (is (= :right (:selection r))) + (is (= before (drawn after (range 12)))) + (is (= cut + (second (node/placed-span (get-in after [:symbols :main :nodes id]))) + (first (node/placed-span (get-in after [:symbols :main :nodes :right]))))) + (is (empty? (clip/problems after))))))) + +(deftest split-refuses-an-edge-a-missing-node-and-a-spanless-node (let [doc (document)] - (is (empty? (clip/problems doc))) - (is (nil? (:parent (get-in doc [:symbols :main :nodes :badge]))) - "so a command acting on it has only the symbol's frames to go by") - (is (= [2 10] (node/placed-span (get-in doc [:symbols :main :nodes :badge])))))) - -;; --------------------------------------------------------------------------- -;; split - -(deftest splitting-changes-nothing-that-is-drawn - (let [doc (document) - fs (range 12) - before (drawn doc fs)] - (doseq [[label id cut] [["a held drawing in a lane" :a 2] - ["a playing insert in a lane" :insert 10] - ["a placement with no lane at all" :badge 6]]] - (testing label - (let [r (span/split doc :main id cut :right) - after (:clip r)] - (is (= :right (:selection r))) - (is (= before (drawn after fs)) "the same picture, frame for frame") - (is (= (node/placed-span (get-in doc [:symbols :main :nodes id])) - [(first (node/placed-span (get-in after [:symbols :main :nodes id]))) - (second (node/placed-span (get-in after [:symbols :main :nodes :right])))]) - "the pieces occupy the frames the one node did") - (is (= cut (second (node/placed-span (get-in after [:symbols :main :nodes id]))) - (first (node/placed-span (get-in after [:symbols :main :nodes :right]))))) - (is (= (:time (get-in doc [:symbols :main :nodes id])) - (:time (get-in after [:symbols :main :nodes :right]))) - "one time map, so the right piece's own frames carry on") - (is (= (select-keys (get-in doc [:symbols :main :nodes id]) - [:source :playback :channels :parent :z]) - (select-keys (get-in after [:symbols :main :nodes :right]) - [:source :playback :channels :parent :z])) - "and it keeps its parent and its depth, so it draws where it drew") - (is (= 12 (get-in after [:symbols :main :frames])) "and no shot-length question") - (is (empty? (clip/problems after)))))))) - -(deftest split-refuses-anything-but-one-cut-inside-one-thing - (let [doc (document)] - (doseq [cut [0 4 8 12 -1 2.5 ##NaN nil]] - (is (:refused (span/split doc :main :b cut :right)) (str "cut at " (pr-str cut)))) - (is (:refused (span/split doc :main :a 2 :b)) "the new ID has to be free") + (doseq [cut [0 4 -1 2.5 ##NaN nil]] + (is (:refused (span/split doc :main :a cut :right)))) (is (:refused (span/split doc :main :missing 2 :right))) - (is (re-find #"group" (:refused (span/split doc :main :girl 2 :right))) - "a group is divided by its children, not by its span") - (is (re-find #"whole shot" (:refused (span/split doc :main :plate 2 :right))) - "and a node with no span has no edges to cut"))) + (is (re-find #"whole shot" (:refused (span/split doc :main :plate 2 :right)))))) -;; --------------------------------------------------------------------------- -;; trim +(deftest trimming-only-narrows-the-selected-placement + (doseq [[doc id edge to kept] [[(document) :b :out 6 [4 6]] + [(ordinary-document) :badge :in 5 [5 10]]]] + (let [before (get-in doc [:symbols :main :nodes id]) + r (span/trim doc :main id edge to) + after (:clip r)] + (is (= id (:selection r))) + (is (= kept (node/placed-span (get-in after [:symbols :main :nodes id])))) + (is (= (dissoc before :span) + (dissoc (get-in after [:symbols :main :nodes id]) :span))) + (is (empty? (clip/problems after)))))) -(deftest trimming-narrows-one-thing-and-moves-nothing-else - (let [doc (document)] - (doseq [[label id edge to kept] [["a cel in a lane" :b :out 6 [4 6]] - ["a placement outside one" :badge :out 7 [2 7]] - ["the front of one outside a lane" :badge :in 5 [5 10]]]] - (testing label - (let [r (span/trim doc :main id edge to) - after (:clip r)] - (is (= kept (node/placed-span (get-in after [:symbols :main :nodes id])))) - (is (= id (:selection r))) - (is (= (select-keys (get-in doc [:symbols :main :nodes id]) - [:time :playback :channels :source]) - (select-keys (get-in after [:symbols :main :nodes id]) - [:time :playback :channels :source])) - "only :span changed") - (is (= [[0 4] [8 12]] (spans after [:a :insert])) "and no neighbour moved") - (is (= 12 (get-in after [:symbols :main :frames]))) - (is (empty? (clip/problems after)))))))) - -(deftest trimming-the-front-does-not-restart-what-is-playing - ;; The difference between trimming and slipping, asserted on the node that has - ;; no lane: its own frames are where they were, so the frames that survive - ;; show exactly what they showed. - (let [doc (document) - before (sample doc [6 7]) - after (:clip (span/trim doc :main :badge :in 6))] - (is (= [6 10] (node/placed-span (get-in after [:symbols :main :nodes :badge])))) - (is (= (:playback (get-in doc [:symbols :main :nodes :badge])) - (:playback (get-in after [:symbols :main :nodes :badge])))) - (is (= (get-in before [6 [:badge :mark]]) - (get-in (sample after [6]) [6 [:badge :mark]])) - "the same animation on the frames it kept") - (is (nil? (get-in (sample after [5]) [5 [:badge :mark]])) - "and the frames it gave up show nothing of it"))) - -(deftest trim-refuses-to-lengthen-or-to-land-on-an-edge - (let [doc (document)] - (doseq [[label id edge to] [["at its own start" :b :in 4] - ["at its own end" :b :out 8] - ["past its end" :b :out 9] - ["before its start" :b :in 2] - ["off a whole frame" :b :out 5.5] - ["past the end of one outside a lane" :badge :out 11] - ["before the start of one outside a lane" :badge :in 1]]] - (is (:refused (span/trim doc :main id edge to)) label)) - (is (:refused (span/trim doc :main :b :middle 6))) - (is (re-find #"group" (:refused (span/trim doc :main :girl :out 6)))))) - -(deftest timeline-edge-resize-allows-an-ordinary-clip-to-grow - (let [after (:clip (span/resize-out (document) :main :badge 11))] +(deftest resizing-an-ordinary-placement-may-overlap + (let [doc (ordinary-document) + after (:clip (span/resize-out doc :main :badge 11 {}))] (is (= [2 11] (node/placed-span (get-in after [:symbols :main :nodes :badge])))) - (is (:refused (span/resize-out (document) :main :badge 2))))) + (is (:refused (span/resize-out doc :main :badge 2 {}))))) -;; --------------------------------------------------------------------------- -;; move +(deftest moving-follows-the-symbol-mode + (let [lane (document) + ordinary (ordinary-document)] + (is (:refused (span/move lane :main :insert 6)) "a lane clip cannot overlap B") + (let [after (:clip (span/move ordinary :main :badge 0))] + (is (= [0 8] (node/placed-span (get-in after [:symbols :main :nodes :badge]))) + "an ordinary symbol is free to composite over occupied frames") + (is (empty? (clip/problems after)))))) -(deftest moving-keeps-its-length-and-its-source-origin - (let [doc (update-in (document) [:symbols :main :nodes] dissoc :b) - r (span/move doc :main :insert 4) - after (:clip r)] - (is (= [[0 4] [4 8]] (spans after [:a :insert]))) - (is (= :insert (:selection r))) - (is (= (:playback (get-in doc [:symbols :main :nodes :insert])) - (:playback (get-in after [:symbols :main :nodes :insert])))) - ;; It began on source frame 3 at lane 8; it begins on source frame 3 at lane 4. - (is (= (get-in (sample doc [8]) [8 [:insert :mark]]) - (get-in (sample after [4]) [4 [:insert :mark]]))) +(deftest clearing-room-then-moving-is-explicit-composition + (let [doc (document) + cleared (:clip (span/blank doc :main [4 8] {})) + after (:clip (span/move cleared :main :insert 4))] + (is (= [4 8] (node/placed-span (get-in after [:symbols :main :nodes :insert])))) (is (empty? (clip/problems after))))) -(deftest a-move-outside-a-lane-is-free-to-land-on-an-occupied-frame - ;; The non-overlap rule is the LANE's, and `:badge` is not in one. Things - ;; placed in a composition are allowed to be on screen together, so there is - ;; nothing here for a move to refuse. - (let [doc (document) - r (span/move doc :main :badge 0) - after (:clip r)] - (is (= [0 8] (node/placed-span (get-in after [:symbols :main :nodes :badge])))) - (is (= [[0 4] [4 8] [8 12]] (spans after [:a :b :insert])) - "and the lane beside it did not notice") - (is (= (get-in (sample doc [2]) [2 [:badge :mark]]) - (get-in (sample after [0]) [0 [:badge :mark]])) - "its source origin came with it") - (is (empty? (clip/problems after))))) - -(deftest a-move-onto-an-occupied-frame-of-a-lane-is-refused-rather-than-rippled - (let [doc (document)] - (is (:refused (span/move doc :main :insert 6)) "it would overlap B") - (is (:refused (span/move doc :main :insert 4.5))) - (is (re-find #"group" (:refused (span/move doc :main :girl 2)))) - (is (re-find #"whole shot" (:refused (span/move doc :main :plate 2)))) - ;; Clearing the room first is the composition, and then it goes. - (let [cleared (:clip (lane/blank doc :main :girl [4 8] {}))] - (is (= [[0 4] [4 8]] (spans (:clip (span/move cleared :main :insert 4)) - [:a :insert])))))) - -;; --------------------------------------------------------------------------- -;; the coordinate - -(deftest host-frame-reads-lane-time-for-a-cel-and-symbol-time-for-everything-else - (let [doc (document) - retimed (assoc-in doc [:symbols :main :nodes :girl :time] {:at 4 :rate 2})] - (is (= 6 (span/host-frame doc :main :b 6)) - "an untimed lane reads the symbol's frames as its own") - (is (= 6 (span/host-frame doc :main :badge 6)) - "and so does a node with no parent, always") - (is (= 4 (span/host-frame retimed :main :b 6)) - "through a lane at :at 4 :rate 2, symbol frame 6 is lane frame 4") - (is (= 6 (span/host-frame retimed :main :badge 6)) - "which is the lane's business and not the badge's") - (is (nil? (span/host-frame (assoc-in doc [:symbols :main :nodes :girl :time] - {:loop? true}) - :main :b 6)) - "and a looping parent has no single answer to give"))) +(deftest host-frame-of-a-parentless-clip-is-the-symbol-frame + (is (= 6 (span/host-frame (document) :main :b 6))) + (is (= 6 (span/host-frame (ordinary-document) :main :badge 6)))) diff --git a/frontend/test/arthur/events/lane_test.cljs b/frontend/test/arthur/events/lane_test.cljs index 5f7feda..9d5601a 100644 --- a/frontend/test/arthur/events/lane_test.cljs +++ b/frontend/test/arthur/events/lane_test.cljs @@ -1,28 +1,53 @@ (ns arthur.events.lane-test (:require [cljs.test :refer [deftest is]] - [arthur.domain.lane-test :as fixture] [arthur.domain.clip :as clip] - [arthur.domain.correction :as correction] - [arthur.domain.lane :as lane] - [arthur.events.ui :as ui] [arthur.domain.history :as history] [arthur.domain.leaf :as leaf] - [arthur.domain.symbol :as symbol] + [arthur.domain.sequence-test :as fixture] + [arthur.domain.span :as span] + [arthur.events.ui :as ui] [arthur.footage.store :as store] - [arthur.ui.timeline :as timeline])) + [arthur.ui.timeline :as timeline] + [re-frame.core :as rf] + [re-frame.db :as rf-db])) -(deftest one-row-projects-all-cels-and-keeps-selection-addresses +(deftest symbol-and-lane-creation-are-distinct-explicit-commands + (letfn [(run [event key] + (let [doc (clip/blank) + id (store/install! {:clip doc :store {}} key)] + (reset! rf-db/app-db {:clip/current id :paint/revision 0 + :ui {:open :main} :playback {:frame 0}}) + (rf/dispatch-sync event) + (let [db @rf-db/app-db + saved (:clip (store/entry id)) + [_ _ instance-id] (get-in db [:ui :selection]) + sid (get-in saved [:symbols :main :nodes instance-id :source :symbol])] + {:db db :symbol (clip/symbol saved sid)})))] + (let [{ordinary :symbol} (run [::ui/new-symbol :inside] "explicit-symbol") + {lane :symbol lane-db :db} (run [::ui/new-lane] "explicit-lane")] + (is (nil? (:display ordinary)) "new symbol means ordinary symbol") + (is (= :lane (:display lane)) "only the lane command creates a lane") + (is (some? (get-in lane-db [:ui :target])) + "the new lane is aimed so drawing and pool drops can go into it")))) + +(deftest an-explicit-lane-is-one-row-of-clips (let [doc (fixture/document) rows (timeline/rows doc :main #{}) - lane (first (filter :cels rows))] - (is (= 2 (count rows))) + lane (first (filter :lane? rows))] + (is (= 2 (count rows)) "the lane row plus the span-less plate") (is (= [[0 4] [4 8] [8 12]] (mapv :span (:cels lane)))) - (is (= [[:node :main :a [:a]] [:node :main :b [:b]] [:node :main :insert [:insert]]] - (mapv :select (:cels lane)))) - (is (= [0 6 12] (:keys lane))) - (is (= 1 (count (filter :cels (timeline/rows doc :main #{[:girl]}))))))) + (is (= [[:node :main :a [:a]] + [:node :main :b [:b]] + [:node :main :insert [:insert]]] + (mapv :select (:cels lane)))))) -(deftest a-nested-selection-converts-the-open-playhead-to-its-owning-symbol +(deftest an-ordinary-symbol-keeps-a-row-per-node + (let [doc (update-in (fixture/document) [:symbols :main] dissoc :display) + rows (timeline/rows doc :main #{})] + (is (empty? (filter :lane? rows))) + (is (= #{[:a] [:b] [:insert] [:plate]} (set (map :path rows)))))) + +(deftest a-nested-selection-converts-the-open-playhead-to-its-owner (let [doc (assoc-in (fixture/document) [:symbols :outer] {:id :outer :frames 30 :nodes {:take {:id :take :kind :instance :z "a" @@ -34,189 +59,59 @@ (is (= 12 (ui/selection-frame doc nil :main [:node :main :a [:a]] 12))))) -(deftest polygon-landing-follows-the-target-not-the-selection - (let [doc (fixture/document) - db {:ui {:open :main - :selection [:node :main :plate [:plate]] - :target {:sid :main :id :insert :path [:insert]}} - :playback {:frame 5}} - landing (ui/polygon-landing doc {} db)] - (is (= doc (:clip landing))) - (is (= [:insert] (:path landing)) - "looking at another shape does not silently move the creation target") - (is (false? (:lane? landing))))) +(deftest polygon-landing-obeys-the-destination-symbol-mode + (let [lane (fixture/document) + ordinary (update-in lane [:symbols :main] dissoc :display) + db {:ui {:open :main :target {:sid :main :id :plate :path [:plate]}} + :playback {:frame 5}}] + (is (true? (:lane? (ui/polygon-landing lane {} db)))) + (is (false? (:lane? (ui/polygon-landing ordinary {} db)))))) -(deftest timeline-polygon-landing-is-decided-by-the-aimed-lane - (let [doc (fixture/document) - base {:ui {:open :main - :selection [:node :main :plate [:plate]] - :target {:sid :main :id :girl :path [:girl]}} - :playback {:frame 5}} - occupied (ui/polygon-landing doc {} base) - with-gap (:clip (lane/blank doc :main :girl [5 7] {:id :rest})) - gap (ui/polygon-landing with-gap {} (assoc-in base [:playback :frame] 6))] - (is (= [:b] (:path occupied)) - "the cel on screen wins even while an unrelated stage node is selected") - (is (= doc (:clip occupied)) "an existing cel needs no document edit") - (is (true? (:lane? occupied))) - (is (= 1 (count (:path gap)))) - (is (not (contains? (get-in with-gap [:symbols :main :nodes]) - (first (:path gap)))) - "a gap receives a fresh drawing") - (is (contains? (get-in (:clip gap) [:symbols :main :nodes]) - (first (:path gap)))) - (is (empty? (clip/problems (:clip gap)))))) - -(deftest polygon-landing-without-an-aimed-lane-uses-the-ordinary-target - (let [doc (fixture/document) - db {:ui {:open :main - :target {:sid :main :id :plate :path [:plate]}} - :playback {:frame 5}} - landing (ui/polygon-landing doc {} db)] - (is (= doc (:clip landing))) - (is (= [] (:path landing))) - (is (false? (:lane? landing))))) - -(deftest beginning-a-polygon-materializes-a-missing-timeline-drawing - (let [doc (fixture/document) - with-gap (:clip (lane/blank doc :main :girl [5 7] {:id :rest})) - id (store/install! {:clip with-gap :store {}} "polygon-start-test") - db {:clip/current id :paint/revision 0 - :ui {:open :main - :target {:sid :main :id :girl :path [:girl]}} - :playback {:frame 6}} - after (ui/beginning-polygon db) - saved (:clip (store/entry (:clip/current after))) - [_ sid cel-id path] (get-in after [:ui :selection])] - (is (= :polygon (get-in after [:ui :tool]))) - (is (= [] (get-in after [:ui :draft]))) - (is (= :main sid)) - (is (= [cel-id] path)) - (is (contains? (get-in saved [:symbols :main :nodes]) cel-id) - "the drawing exists before the first draft point is added") - (is (= 6 (get-in saved [:symbols :main :nodes cel-id :time :at]))) - (is (empty? (clip/problems saved))))) - -(deftest beginning-a-polygon-does-not-invent-an-unselected-lane +(deftest beginning-a-polygon-does-not-invent-a-lane (let [doc (clip/blank) - id (store/install! {:clip doc :store {}} "polygon-lane-start-test") + id (store/install! {:clip doc :store {}} "polygon-no-implicit-lane") db {:clip/current id :paint/revision 0 :ui {:open :main} :playback {:frame 6}} after (ui/beginning-polygon db) - saved (:clip (store/entry (:clip/current after))) - lanes (symbol/lanes (get-in saved [:symbols :main :nodes]))] + saved (:clip (store/entry (:clip/current after)))] (is (= :polygon (get-in after [:ui :tool]))) - (is (= [:lane] (mapv :id lanes)) - "the lane the symbol was born with, and no second one invented here") - (is (empty? (symbol/lane-clips (get-in saved [:symbols :main :nodes]) :lane)) - "and nothing put in it") - (is (nil? (get-in after [:ui :target]))) - (is (nil? (get-in (store/entry (:clip/current after)) [:history :done]))) - (is (empty? (clip/problems saved))))) + (is (= {} (get-in saved [:symbols :main :nodes]))) + (is (nil? (get-in saved [:symbols :main :display]))) + (is (nil? (get-in (store/entry (:clip/current after)) [:history :done]))))) (deftest sequence-commands-use-isolated-history-transactions (let [doc (fixture/document) - id (store/install! {:clip doc :store {}} "sequence-test") + id (store/install! {:clip doc :store {}} "sequence-command-test") db {:clip/current id :paint/revision 0 :ui {:open :main :selection [:node :main :a [:a]]}} - refused (ui/apply-lane-command db :main - (lane/extend-hold doc :main :a 1 {}) [:retry])] + refused (ui/apply-command db :main + (span/extend-hold doc :main :a 1 {}) [:retry])] (is (= doc (:clip (store/entry id)))) - (is (nil? (:history (store/entry id)))) - (is (= [:retry] (get-in refused [:ui :lane-retry]))) - (let [r1 (lane/extend-hold doc :main :a 1 {:extent :grow-symbol}) - db1 (ui/apply-lane-command db :main r1 nil) - r2 (lane/extend-hold (:clip r1) :main :a 1 {:extent :grow-symbol}) - db2 (ui/apply-lane-command db1 :main r2 nil) + (is (= [:retry] (get-in refused [:ui :retry]))) + (let [r1 (span/extend-hold doc :main :a 1 {:extent :grow-symbol}) + db1 (ui/apply-command db :main r1 nil) + r2 (span/extend-hold (:clip r1) :main :a 1 {:extent :grow-symbol}) + db2 (ui/apply-command db1 :main r2 nil) h (:history (store/entry id)) undo (history/undo h (leaf/leaves "u" (:clip r2))) undo2 (history/undo (:history undo) (:leaves undo))] - (is (= 2 (count (:done h))) "rapid button presses remain separate commands") + (is (= 2 (count (:done h)))) (is (= (:clip r1) (leaf/clip "u" (:leaves undo)))) (is (= doc (leaf/clip "u" (:leaves undo2)))) (is (= [:node :main :a [:a]] (get-in db2 [:ui :selection])))))) -(deftest a-correction-is-one-step-and-keeps-the-full-selection-address +(deftest an-expanded-lane-opens-the-selected-clip (let [doc (fixture/document) - id (store/install! {:clip doc :store {}} "correction-event-test") - selection [:node :main :a [:outer :a]] - db {:clip/current id :paint/revision 0 - :ui {:open :outer :selection selection}} - result (correction/add doc :main :a [:xform :rot] - {:id :nudge :support [0 3] :motion :return - :start 0 :peak 0.5 :peak-frame 1}) - after (ui/apply-correction-command db result) - entry (store/entry id)] - (is (= selection (get-in after [:ui :selection]))) - (is (= 1 (count (get-in entry [:history :done])))) - (is (= 0.5 (get-in (:clip entry) - [:symbols :main :nodes :a :channels [:xform :rot] - :over 0 :values :keys 1]))) - (let [refused (ui/apply-correction-command after {:refused "nope"})] - (is (= "nope" (get-in refused [:project :status]))) - (is (= 1 (count (get-in (store/entry id) [:history :done]))))))) + rows (timeline/rows doc :main #{[:arthur.ui.timeline/lane] [:insert]} [:insert]) + portal (first (filter :portal? rows))] + (is (= [:insert] (:path portal))) + (is (= [:node :main :insert [:insert]] (:select portal))) + (is (some #{"mark"} (map :label rows))))) -(deftest an-expanded-lane-opens-the-selected-clip-and-everything-under-it - ;; The whole document is editable from the root timeline: a lane opens one - ;; portal — the clip selected in it — and that portal opens the lanes and - ;; nodes of the symbol it places, mapped into this ruler. - (let [doc (fixture/document) - open #{[:girl] [:insert]} - shut (timeline/rows doc :main open [:insert]) - of (fn [rows] (mapv (juxt :label :depth) rows)) - lane-row (first (filter :cels (timeline/rows doc :main open [:insert])))] - (is (= 1 (count (filter :portal? shut))) - "exactly one clip is opened, not one branch per clip in the lane") - (is (= [:insert] (:path (first (filter :portal? shut)))) - "and it is the selected one") - (is (some #{["mark" 2]} (of shut)) - "the clip's own symbol appears under it, at its depth") - (is (= [:node :main :insert [:insert]] - (:select (first (filter :portal? shut)))) - "the portal addresses the same clip its block in the lane does") - (is (= (:keys (second (:cels lane-row))) - (:keys (first (filter #(= [:b] (:path %)) (timeline/rows doc :main open [:b]))))) - "a clip's keys are on its block whether or not its portal is open"))) - -(deftest a-nested-selection-keeps-the-portal-that-revealed-it-open - ;; Clicking a shape inside the clip — or the end of its span — is still - ;; working inside that clip. Matching the selected id alone would close the - ;; portal the moment anything under it was touched. - (let [doc (fixture/document) - open #{[:girl] [:insert]} - deep (timeline/rows doc :main open [:insert :mark]) - none (timeline/rows doc :main open [:plate])] - (is (= [:insert] (:path (first (filter :portal? deep)))) - "a selection under the clip keeps that clip's portal") - (is (empty? (filter :portal? none))) - (is (some #{"select a clip to inspect"} (map :label none)) - "with nothing selected in it, an open lane says what it is waiting for"))) - -(deftest a-held-clip-shows-its-contents-without-inventing-frames-for-them - ;; `clip/source-time` is nil for a hold, so nested keys have no place on this - ;; ruler — but the drawing's own nodes must still be reachable from here. - (let [doc (fixture/document) - rows (timeline/rows doc :main #{[:girl] [:a]} [:a]) - inside (filter :unmapped? rows)] - (is (seq inside) "a held drawing opens") - (is (some #{"mark"} (map :label inside))) - (is (every? (comp empty? :keys) inside) - "no key is placed where the hold cannot say it belongs") - (is (= [[0 4]] (distinct (keep :span (filter #(= :node (:kind %)) inside)))) - "its rows span the hold, which is when it is on screen"))) - -(deftest a-lane-of-sounds-is-drawn-as-a-lane-and-not-flattened-twice - (let [made (lane/add-lane (fixture/document) :main :track) - seeded (clip/place-sound (:clip made) :main {:sound "s1"} "voice" 6 1 2 :vo) - doc (:clip (lane/adopt seeded :main :track :vo 2 {:extent :grow-symbol})) - picture (remove :sound? (timeline/rows doc :main #{} nil)) - sound-lanes (filter :sound? (timeline/rows doc :main #{} nil)) - flattened (timeline/sound-rows doc :main #{})] - (is (= 1 (count sound-lanes)) "the sound's lane is one row, like any lane") - (is (= [:vo] (mapv :id (:cels (first sound-lanes)))) - "with the sound on it as a block that can be moved and trimmed") - (is (empty? (filter #(= [:track] (:path %)) picture)) - "and it is not also listed among the picture rows") - (is (empty? flattened) - "nor flattened into a second, parallel audio row"))) +(deftest a-lane-of-sounds-is-not-flattened-twice + (let [base (:clip (span/draw-as-lane (clip/blank) :main true {})) + doc (clip/place-sound base :main {:sound "s1"} "voice" 6 1 2 :vo) + lane (first (filter :lane? (timeline/rows doc :main #{} nil)))] + (is (= [:vo] (mapv :id (:cels lane)))) + (is (empty? (timeline/sound-rows doc :main #{}))))) diff --git a/frontend/test/browser/lane.mjs b/frontend/test/browser/lane.mjs index 24e3038..10cdf44 100644 --- a/frontend/test/browser/lane.mjs +++ b/frontend/test/browser/lane.mjs @@ -1,5 +1,5 @@ -// Local editor smoke test. Uses the in-memory blank document and disables the -// project route, so it never creates an account, project, or server-side write. +// Browser smoke test for the explicit-lane workflow. It uses the in-memory +// document and disables project routing, so it performs no server-side write. import { spawn } from 'node:child_process'; import { mkdtempSync, rmSync } from 'node:fs'; import { tmpdir } from 'node:os'; @@ -7,7 +7,7 @@ import { join } from 'node:path'; import assert from 'node:assert/strict'; const url = process.env.ARTHUR_URL ?? 'http://localhost:8778/'; -const profile = mkdtempSync(join(tmpdir(), 'arthur-sequence-')); +const profile = mkdtempSync(join(tmpdir(), 'arthur-explicit-lane-')); const port = 9335; const chrome = spawn(process.env.CHROME ?? '/usr/bin/chromium', [ '--headless=new', '--no-sandbox', '--disable-gpu', '--no-first-run', @@ -16,6 +16,7 @@ const chrome = spawn(process.env.CHROME ?? '/usr/bin/chromium', [ ], { stdio: 'ignore' }); const sleep = ms => new Promise(resolve => setTimeout(resolve, ms)); let ws; + try { let target; for (let i = 0; i < 100 && !target; i++) { @@ -23,11 +24,12 @@ try { try { target = (await fetch(`http://127.0.0.1:${port}/json/list`).then(r => r.json())) .find(t => t.type === 'page' && t.url.startsWith(url)); - } catch { /* browser starting */ } + } catch { /* Chromium is still starting. */ } } assert(target, 'browser exposes the editor page'); ws = new WebSocket(target.webSocketDebuggerUrl); await new Promise((resolve, reject) => { ws.onopen = resolve; ws.onerror = reject; }); + let serial = 0; const pending = new Map(); const errors = []; @@ -35,10 +37,10 @@ try { const msg = JSON.parse(data); if (msg.method === 'Runtime.exceptionThrown') errors.push(msg.params.exceptionDetails); if (msg.id && pending.has(msg.id)) { - const { resolve, reject } = pending.get(msg.id); + const waiting = pending.get(msg.id); pending.delete(msg.id); - if (msg.error) reject(new Error(JSON.stringify(msg.error))); - else resolve(msg.result); + if (msg.error) waiting.reject(new Error(JSON.stringify(msg.error))); + else waiting.resolve(msg.result); } }; const send = (method, params = {}) => new Promise((resolve, reject) => { @@ -47,13 +49,16 @@ try { ws.send(JSON.stringify({ id, method, params })); }); const evaluate = async expression => { - const r = await send('Runtime.evaluate', { expression, returnByValue: true, awaitPromise: true }); - if (r.exceptionDetails) throw new Error(JSON.stringify(r.exceptionDetails)); - return r.result.value; + const result = await send('Runtime.evaluate', { + expression, returnByValue: true, awaitPromise: true, + }); + if (result.exceptionDetails) throw new Error(JSON.stringify(result.exceptionDetails)); + return result.result.value; }; + await send('Runtime.enable'); for (let i = 0; i < 100; i++) { - if (await evaluate('typeof arthur !== "undefined" && !!arthur.events?.ui && !!document.querySelector("canvas.stage")')) break; + if (await evaluate('typeof arthur !== "undefined" && !!document.querySelector("canvas.stage")')) break; await sleep(100); } await evaluate(`(() => { @@ -61,342 +66,145 @@ try { cljs.core.swap_BANG_(re_frame.db.app_db, db => cljs.core.assoc(db, k('route'), k('local-test'))); window.laneSnapshot = () => { const db = cljs.core.deref(re_frame.db.app_db); - const entry = arthur.footage.store.entry(cljs.core.get(db, k('clip/current'))); - return cljs.core.clj__GT_js(entry); + return cljs.core.clj__GT_js(arthur.footage.store.entry(cljs.core.get(db, k('clip/current')))); }; return true; })()`); await sleep(250); - // A command is named the same wherever it is drawn, and since the transport - // strip was consolidated it is drawn in one of two places: as a button in the - // strip, or as a row in one of the strip's menus. So the test asks for it by - // name and this finds it — opening each menu in turn to look — rather than the - // test knowing which menu anything ended up in. An icon button is matched on - // 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', '.section']; - const within = (suffix) => bars.map((b) => `${b} ${suffix}`).join(', '); - const named = label => - `(b => b.textContent.trim() === ${JSON.stringify(label)}` + - ` || b.getAttribute('aria-label') === ${JSON.stringify(label)})`; - const shut = async () => { - await evaluate(`(() => { document.querySelectorAll('.menu-scrim').forEach(s => s.click()); return true })()`); - await sleep(120); + + const named = label => `(b => b.getAttribute('aria-label') === ${JSON.stringify(label)}` + + ` || b.textContent.trim() === ${JSON.stringify(label)})`; + const closeMenus = async () => { + await evaluate(`(() => { document.querySelectorAll('.menu-scrim').forEach(x => x.click()); return true })()`); + await sleep(80); }; - // Leaves the control on screen and returns what to select it with. - const reveal = async label => { - await shut(); - if (await evaluate(`![...document.querySelectorAll('${within('button')}')].find(${named(label)})`)) { - const menus = await evaluate( - `[...document.querySelectorAll('${within('.menu-wrap > button')}')].map(b => b.textContent.trim())`); - let found = false; - for (const menu of menus) { - await evaluate(`(() => { [...document.querySelectorAll('${within('.menu-wrap > button')}')] - .find(b => b.textContent.trim() === ${JSON.stringify(menu)}).click(); return true })()`); - await sleep(180); - if (await evaluate(`!![...document.querySelectorAll('.menu-item')].find(${named(label)})`)) { found = true; break; } - await shut(); - } - assert(found, `a control named: ${label}`); - return '.menu-item'; - } - return within('button'); - }; - const click = async label => { - const where = await reveal(label); + const clickNew = async label => { + await closeMenus(); assert(await evaluate(`(() => { - const b = [...document.querySelectorAll('${where}')].find(${named(label)}); - if (!b || b.disabled) return false; - b.click(); return true; - })()`), `enabled control: ${label}`); - await sleep(180); - await shut(); + const menu = document.querySelector('.loc .menu-wrap > button'); + if (!menu) return false; + menu.click(); return true; + })()`), 'new menu exists'); + await sleep(100); + assert(await evaluate(`(() => { + const item = [...document.querySelectorAll('.menu-item')].find(${named(label)}); + if (!item || item.disabled) return false; + item.click(); return true; + })()`), `enabled creation command: ${label}`); + await sleep(220); + await closeMenus(); }; - // 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); - const placed = s => instances(s).map(n => [ - n.time.at + n.span[0] / (n.time.rate ?? 1), - n.time.at + n.span[1] / (n.time.rate ?? 1), - ]); - const key = async (key, extra = {}) => { - await send('Input.dispatchKeyEvent', {type: 'keyDown', key, ...extra}); - await send('Input.dispatchKeyEvent', {type: 'keyUp', key, ...extra}); - await sleep(180); - }; - const undo = () => key('z', {modifiers: 2}); - const drag = async (selector, df, {zone = 0.5, shift = false} = {}) => { - const points = await evaluate(`(() => { - const handle = document.querySelector(${JSON.stringify(selector)}); - if (!handle) return null; - const track = handle.closest('.tl-track'); - const h = handle.getBoundingClientRect(); - const t = track.getBoundingClientRect(); - const frames = Number(document.querySelector('.at-frame').textContent.split('/')[1]); - const x = h.left + h.width * ${zone}; - const y = h.top + h.height / 2; - return {x, y, end: x + t.width * ${df} / frames}; - })()`); - assert(points, `drag handle exists: ${selector}`); - const modifiers = shift ? 8 : 0; - await send('Input.dispatchMouseEvent', { - type: 'mousePressed', x: points.x, y: points.y, - button: 'left', buttons: 1, clickCount: 1, modifiers, - }); - await sleep(100); - await send('Input.dispatchMouseEvent', { - type: 'mouseMoved', x: points.end, y: points.y, - button: 'left', buttons: 1, modifiers, - }); - await sleep(100); - await send('Input.dispatchMouseEvent', { - type: 'mouseReleased', x: points.end, y: points.y, - button: 'left', buttons: 0, clickCount: 1, modifiers, - }); - await sleep(250); - }; - const tabs = () => evaluate(`(() => { - const k = cljs.core.keyword, db = cljs.core.deref(re_frame.db.app_db); - return {tabs: cljs.core.clj__GT_js(cljs.core.get_in(db, [k('ui'), k('tabs')])).map(String), - open: String(cljs.core.clj__GT_js(cljs.core.get_in(db, [k('ui'), k('open')])))}; - })()`); - // A real two-press double-click, not `.dispatchEvent`: what broke here was - // where the browser decides to deliver the click, which a synthetic event - // cannot show. - const doubleClick = async selector => { - const p = await evaluate(`(() => { - const el = document.querySelector(${JSON.stringify(selector)}); - if (!el) return null; - const r = el.getBoundingClientRect(); - return {x: r.left + r.width / 2, y: r.top + r.height / 2}; - })()`); - assert(p, `something to double-click: ${selector}`); - for (const clickCount of [1, 2]) { - await send('Input.dispatchMouseEvent', {type: 'mousePressed', x: p.x, y: p.y, - button: 'left', buttons: 1, clickCount}); - await send('Input.dispatchMouseEvent', {type: 'mouseReleased', x: p.x, y: p.y, - button: 'left', buttons: 0, clickCount}); - await sleep(60); - } - await sleep(280); - }; - const dropPoolSymbol = async frame => { - const points = await evaluate(`(() => { - const source = document.querySelector('.pool-row:not(.main) .pool-item[draggable="true"]'); - const track = document.querySelector('.tl-track'); - if (!source || !track) return null; - source.scrollIntoView({block: 'center'}); - const a = source.getBoundingClientRect(), b = track.getBoundingClientRect(); - const frames = Number(document.querySelector('.at-frame').textContent.split('/')[1]); - return {sx: a.left + a.width / 2, sy: a.top + a.height / 2, - tx: b.left + b.width * (${frame} + 0.25) / frames, - ty: b.top + b.height / 2}; - })()`); - assert(points, 'a library symbol and lane are available to drag'); - await send('Input.dispatchMouseEvent', {type: 'mouseMoved', x: points.sx, y: points.sy}); - await send('Input.dispatchMouseEvent', {type: 'mousePressed', x: points.sx, y: points.sy, - button: 'left', buttons: 1, clickCount: 1}); - await send('Input.dispatchMouseEvent', {type: 'mouseMoved', x: points.sx + 12, y: points.sy, - button: 'left', buttons: 1}); - await sleep(120); - await send('Input.dispatchMouseEvent', {type: 'mouseMoved', x: points.tx, y: points.ty, - button: 'left', buttons: 1}); - await sleep(120); - assert.equal(await evaluate('document.querySelectorAll(".tl-label.ghost").length'), 0, - 'targeting an existing lane does not preview a temporary new row'); - const lanePreview = await evaluate(`(() => { - const db = cljs.core.deref(re_frame.db.app_db), k = cljs.core.keyword; - return {ghosts: document.querySelectorAll('.tl-track .tl-cel.ghost').length, - drop: cljs.core.clj__GT_js(cljs.core.get_in(db, [k('ui'), k('drop')]))}; - })()`); - assert.equal(lanePreview.ghosts, 1, - `the pool drop preview is drawn inside the targeted lane: ${JSON.stringify(lanePreview)}`); - await send('Input.dispatchMouseEvent', {type: 'mouseReleased', x: points.tx, y: points.ty, - button: 'left', buttons: 0, clickCount: 1}); - await sleep(300); - }; - const dragClipBetweenLanes = async frame => { - const points = await evaluate(`(() => { - const tracks = [...document.querySelectorAll('.tl-track')]; - const source = tracks[1]?.querySelector('.tl-cel'); - const target = tracks[0]; - if (!source || !target) return null; - const a = source.getBoundingClientRect(), b = target.getBoundingClientRect(); - const frames = Number(document.querySelector('.at-frame').textContent.split('/')[1]); - return {sx: a.left + a.width / 2, sy: a.top + a.height / 2, - tx: b.left + b.width * (${frame} + 0.25) / frames, - ty: b.top + b.height / 2}; - })()`); - assert(points, 'two lanes and a source clip are available'); - await send('Input.dispatchMouseEvent', {type: 'mousePressed', x: points.sx, y: points.sy, - button: 'left', buttons: 1, clickCount: 1}); - await send('Input.dispatchMouseEvent', {type: 'mouseMoved', x: points.tx, y: points.ty, - button: 'left', buttons: 1}); - await sleep(150); - assert.equal(await evaluate('document.querySelectorAll(".tl-track")[0].querySelectorAll(".tl-cel.ghost").length'), 1, - 'cross-lane movement previews in the destination lane'); - await send('Input.dispatchMouseEvent', {type: 'mouseReleased', x: points.tx, y: points.ty, - button: 'left', buttons: 0, clickCount: 1}); - await sleep(300); - }; + const mainInstances = s => Object.values(s.clip.symbols.main.nodes) + .filter(n => n.kind === 'instance'); + const laneSymbols = s => Object.values(s.clip.symbols).filter(sym => sym.display === 'lane'); - assert.equal(await evaluate('[...document.querySelectorAll(".timing-controls > button")].every(b => b.disabled)'), true, - 'timing buttons are disabled without a symbol clip'); - await click('inside'); + assert.equal((await shot()).clip.symbols.main.display, undefined, + 'a blank document starts as an ordinary symbol'); + + await clickNew('inside'); let s = await shot(); - assert.deepEqual(placed(s), [[0, 1]], - 'new at the root automatically makes a lane and a one-frame symbol clip'); - assert.equal(await evaluate('document.querySelectorAll(".tl-label .kind").length'), 1, - 'new temporal content creates a lane row rather than a row per symbol'); - assert.equal(await evaluate(`document.querySelectorAll('.cel-sheet, [aria-label="time view"]').length`), 0, - 'there is one temporal interface'); - assert.equal(await evaluate('document.querySelectorAll(".timing-controls > button").length'), 3, - 'timing operations are direct buttons'); + let placed = mainInstances(s); + assert.equal(placed.length, 1, 'new symbol places one instance'); + assert.equal(s.clip.symbols[placed[0].source.symbol].display, undefined, + 'new symbol remains ordinary'); + assert.equal(await evaluate('document.querySelectorAll(".tl-track").length'), 1, + 'an ordinary symbol is an ordinary timeline row'); - await drag('.tl-cel .tl-edge.out', 3); + await clickNew('lane'); s = await shot(); - assert.deepEqual(placed(s), [[0, 4]], 'a right edge directly changes the endpoint'); + placed = mainInstances(s); + assert.equal(placed.length, 2, 'explicit lane places a second symbol'); + assert.equal(laneSymbols(s).length, 1, 'only the lane command marks a symbol as a lane'); + assert.equal(await evaluate('[...document.querySelectorAll(".tl-track")].filter(t => t.arthurLane).length'), 1, + 'the explicit lane is drawn as one linear track'); - for (let i = 0; i < 4; i++) await click('+1'); - await click('inside'); - await drag('.tl-cel:nth-of-type(2) .tl-edge.out', 2); - for (let i = 0; i < 3; i++) await click('+1'); - await click('inside'); - s = await shot(); - assert.deepEqual(placed(s), [[0, 4], [4, 7], [7, 8]]); - - await drag('.tl-cel:nth-of-type(2) .tl-junction', 1, {zone: 0.5}); - assert.deepEqual(placed(await shot()), [[0, 5], [5, 7], [7, 8]], - 'the middle of a junction rolls both edges'); - await undo(); - - await drag('.tl-cel:nth-of-type(2) .tl-junction', 1, {zone: 0.9}); - assert.deepEqual(placed(await shot()), [[0, 4], [5, 7], [7, 8]], - 'the right side trims only the right clip'); - await undo(); - - await drag('.tl-cel:nth-of-type(2) .tl-junction', -1, {zone: 0.1}); - assert.deepEqual(placed(await shot()), [[0, 3], [4, 7], [7, 8]], - 'the left side trims only the left clip'); - await undo(); - - await drag('.tl-cel:nth-of-type(2) .tl-edge.out', 2, {shift: true}); - assert.deepEqual(placed(await shot()), [[0, 4], [4, 9], [9, 10]], - 'Shift-edge ripples every later clip on the lane'); - await undo(); - - await drag('.tl-cel:first-of-type .tl-edge.out', 2); - assert.deepEqual(placed(await shot()), [[0, 6], [6, 7], [7, 8]], - 'ordinary growth trims adjacent spans and never overlaps'); - - await dropPoolSymbol(10); - s = await shot(); - assert.deepEqual(placed(s), [[0, 6], [6, 7], [7, 8], [10, 11]], - 'an arbitrary library symbol drops into an existing lane'); - assert.equal(instances(s).at(-1).playback.speed, 1, - 'a dropped symbol plays naturally instead of becoming a held drawing'); - - await evaluate(`re_frame.core.dispatch(cljs.core.vector(cljs.core.keyword('arthur.events.ui/new-lane')))`); - await sleep(180); - s = await shot(); - const renameControls = await evaluate('document.querySelectorAll(".tl-label .tl-rename").length'); - assert.equal(renameControls, 2, - `both lanes expose rename controls: ${JSON.stringify(s.clip.symbols.main.nodes)}`); - await evaluate('document.querySelector(".tl-label .tl-rename").click()'); + assert.equal(await evaluate('document.querySelectorAll(".tl-rename").length'), 1, + 'the lane exposes its rename control'); + await evaluate('document.querySelector(".tl-rename").click()'); await sleep(80); assert(await evaluate(`(() => { const input = document.querySelector('.tl-name-input'); if (!input) return false; - Object.getOwnPropertyDescriptor(HTMLInputElement.prototype, 'value').set.call(input, 'Foreground'); - input.dispatchEvent(new InputEvent('input', {bubbles: true, inputType: 'insertText', data: 'Foreground'})); + Object.getOwnPropertyDescriptor(HTMLInputElement.prototype, 'value') + .set.call(input, 'Foreground'); + input.dispatchEvent(new InputEvent('input', {bubbles: true, inputType: 'insertText'})); input.blur(); return true; })()`), 'lane rename editor opens'); await sleep(180); s = await shot(); - assert(Object.values(s.clip.symbols.main.nodes).some(n => n.layout === 'sequence' && n.name === 'Foreground'), - 'a lane name is editable and persisted in the document'); + assert(mainInstances(s).some(n => n.name === 'Foreground'), 'lane name persists'); - await dragClipBetweenLanes(12); - s = await shot(); - const lanes = Object.values(s.clip.symbols.main.nodes).filter(n => n.layout === 'sequence'); - assert.deepEqual(lanes.map(l => instances(s).filter(n => n.parent === l.id).length).sort(), [1, 3], - 'a clip body can move from one lane to another'); - - // EXPANDING A LANE OPENS THE SELECTED CLIP. Its own keys, and under it the - // lanes and nodes of the symbol it places, all on this ruler — which is what - // makes the whole document editable from the root timeline. - const rowLabels = () => evaluate( - `[...document.querySelectorAll('.tl-labels > .tl-label')].map(e => e.textContent.trim())`); - const twist = async i => { - assert(await evaluate(`(() => { - const t = document.querySelectorAll('.tl-labels > .tl-label .tl-twist')[${i}]; - if (!t || t.disabled) return false; - t.click(); return true; - })()`), `an expander at row ${i}`); - await sleep(220); - }; - await evaluate(`(() => { document.querySelector('.tl-track .tl-cel').click(); return true })()`); - await sleep(200); - const collapsed = await rowLabels(); - await twist(0); - const opened = await rowLabels(); - assert(opened.length > collapsed.length, 'the lane opens'); - assert.equal(opened.filter(l => l.includes('instance')).length, 1, - `one clip portal, not one branch per clip: ${JSON.stringify(opened)}`); - const portalAt = opened.findIndex(l => l.includes('instance')); - await twist(portalAt); - const deep = await rowLabels(); - assert(deep.length > opened.length, - `the portal opens the symbol the clip places: ${JSON.stringify(deep)}`); - // Selecting something nested must not close the portal that revealed it. - await evaluate(`(() => { - const k = cljs.core.keyword, db = cljs.core.deref(re_frame.db.app_db); - const sel = cljs.core.get_in(db, [k('ui'), k('selection')]); - const path = cljs.core.nth(sel, 3); - re_frame.core.dispatch(cljs.core.vector( - k('arthur.events.ui/select'), - cljs.core.vector(k('node'), cljs.core.nth(sel, 1), cljs.core.nth(sel, 2), - cljs.core.conj(path, k('made-up-child'))))); - return true; + // Drag a library symbol into the explicit lane. The row itself is the target; + // no temporary lane is previewed or created. + const drop = await evaluate(`(() => { + const source = document.querySelector('.pool-row:not(.main) .pool-item[draggable="true"]'); + const track = [...document.querySelectorAll('.tl-track')].find(t => t.arthurLane); + if (!source || !track) return null; + source.scrollIntoView({block: 'center'}); + const a = source.getBoundingClientRect(), b = track.getBoundingClientRect(); + return {sx: a.left + a.width / 2, sy: a.top + a.height / 2, + tx: b.left + b.width * .085, ty: b.top + b.height / 2}; })()`); - await sleep(220); - assert.equal((await rowLabels()).filter(l => l.includes('instance')).length, 1, - 'a selection under the clip keeps its portal open'); - await twist(portalAt); - await twist(0); + assert(drop, 'a pool symbol and explicit lane are available'); + await send('Input.dispatchMouseEvent', {type: 'mouseMoved', x: drop.sx, y: drop.sy}); + await send('Input.dispatchMouseEvent', {type: 'mousePressed', x: drop.sx, y: drop.sy, + button: 'left', buttons: 1, clickCount: 1}); + await send('Input.dispatchMouseEvent', {type: 'mouseMoved', x: drop.sx + 12, y: drop.sy, + button: 'left', buttons: 1}); + await sleep(100); + await send('Input.dispatchMouseEvent', {type: 'mouseMoved', x: drop.tx, y: drop.ty, + button: 'left', buttons: 1}); + await sleep(120); + assert.equal(await evaluate('document.querySelectorAll(".tl-label.ghost").length'), 0, + 'pool drop does not preview an invented lane'); + assert.equal(await evaluate('document.querySelectorAll(".tl-cel.ghost").length'), 1, + 'pool drop previews inside the existing lane'); + await send('Input.dispatchMouseEvent', {type: 'mouseReleased', x: drop.tx, y: drop.ty, + button: 'left', buttons: 0, clickCount: 1}); + await sleep(300); + s = await shot(); + assert.equal(Object.keys(laneSymbols(s)[0].nodes).length, 1, + `the dropped clip remains in the explicit lane: ${JSON.stringify(s)}`); + assert.equal(laneSymbols(s).length, 1, 'the drop creates no extra lane'); - const before = await tabs(); - const tabChips = () => evaluate('document.querySelectorAll(".tabs .tab").length'); - const chipsBefore = await tabChips(); - await doubleClick('.tl-track .tl-cel'); - const after = await tabs(); - assert.equal(after.tabs.length, before.tabs.length + 1, - `double-clicking a clip opens the symbol it places, as the pool row does: ${JSON.stringify(after)}`); - assert(!before.tabs.includes(after.open) && after.tabs.includes(after.open), - `the opened symbol is the one in front: ${JSON.stringify(after)}`); - assert.equal(await tabChips(), chipsBefore + 1, - 'the opened symbol is drawn as one more tab'); - assert.equal(await evaluate('document.querySelectorAll("#app > *").length'), 1, - 'opening from the timeline leaves the editor standing: a stale node selection ' + - 'pointing into the symbol just left used to throw and unmount it'); + // A second explicit lane is a sibling in the open symbol even though the + // first remains aimed. Move the clip between their linear tracks. + await clickNew('lane'); + s = await shot(); + assert.equal(laneSymbols(s).length, 2, 'a second explicit command creates a second lane'); + const move = await evaluate(`(() => { + const tracks = [...document.querySelectorAll('.tl-track')].filter(t => t.arthurLane); + const from = tracks.find(t => t.querySelector('.tl-cel')); + const to = tracks.find(t => t !== from); + const cel = from?.querySelector('.tl-cel'); + if (!cel || !to) return null; + const a = cel.getBoundingClientRect(), b = to.getBoundingClientRect(); + return {sx: a.left + a.width / 2, sy: a.top + a.height / 2, + tx: b.left + b.width * .12, ty: b.top + b.height / 2}; + })()`); + assert(move, 'two explicit lanes and a source clip are available'); + await send('Input.dispatchMouseEvent', {type: 'mousePressed', x: move.sx, y: move.sy, + button: 'left', buttons: 1, clickCount: 1}); + await send('Input.dispatchMouseEvent', {type: 'mouseMoved', x: move.tx, y: move.ty, + button: 'left', buttons: 1}); + await sleep(150); + await send('Input.dispatchMouseEvent', {type: 'mouseReleased', x: move.tx, y: move.ty, + button: 'left', buttons: 0, clickCount: 1}); + await sleep(300); + s = await shot(); + assert.deepEqual(laneSymbols(s).map(x => Object.keys(x.nodes).length).sort(), [0, 1], + 'a clip body moves from one explicit lane to the other'); assert.equal(errors.length, 0, JSON.stringify(errors)); - console.log('PASS: generic lanes preview, rename, move, place, open, trim, roll, and ripple clips'); + console.log('PASS: symbols are ordinary; explicit lanes rename, accept drops, and exchange clips'); } finally { - if (ws?.readyState === WebSocket.OPEN) { - ws.send(JSON.stringify({ id: 999999, method: 'Browser.close' })); - await sleep(350); - } - ws?.close(); - chrome.kill(); - await new Promise(resolve => { if (chrome.exitCode !== null || chrome.signalCode !== null) resolve(); else chrome.once('exit', resolve); }); + if (ws?.readyState === WebSocket.OPEN) ws.close(); + chrome.kill('SIGTERM'); + await new Promise(resolve => chrome.once('exit', resolve)); try { rmSync(profile, { recursive: true, force: true, maxRetries: 5, retryDelay: 100 }); } catch (error) { - console.warn(`Temporary browser profile retained at ${profile}: ${error.code}`); + if (error.code !== 'ENOTEMPTY') throw error; } } From 93f5112bb3feabe8fe8d5a8aaf805bcc2ae75191 Mon Sep 17 00:00:00 2001 From: Your Name Date: Thu, 1 Oct 2026 20:09:35 -0400 Subject: [PATCH 10/10] Unify clip placement across symbol modes --- frontend/src/arthur/domain/span.cljs | 98 ++++++++++++------- frontend/src/arthur/domain/symbol.cljs | 16 +-- frontend/src/arthur/events/ui.cljs | 81 +++------------ frontend/src/arthur/ui/timeline.cljs | 11 +-- .../test/arthur/domain/sequence_test.cljs | 47 +++++++++ 5 files changed, 136 insertions(+), 117 deletions(-) diff --git a/frontend/src/arthur/domain/span.cljs b/frontend/src/arthur/domain/span.cljs index bdaf252..735f2e8 100644 --- a/frontend/src/arthur/domain/span.cljs +++ b/frontend/src/arthur/domain/span.cljs @@ -474,9 +474,45 @@ nodes later)] (finish clip sid nodes id extent))))) +(defn place-node + "Place the already-materialized, direct child `n` into symbol `sid` at `at`. + + THIS IS THE PLACEMENT RULE. Materializing a symbol instance, an audio node, or + imported content is deliberately somebody else's job; once it is a node, its + origin no longer matters. The destination alone decides the edit: + + - an ordinary symbol attaches it and permits overlap; + - a lane symbol first clears the interval it claims. + + The caller hands this function a node not currently present in the destination. + Its duration, channels, source clock and identity are preserved; only its + parent-space start changes. Returns the ordinary command result shape." + [clip sid n at {:keys [extent remainder-id] :or {extent :keep}}] + (let [sym (clip/symbol clip sid) + nodes (:nodes sym) + id (:id n) + [lo hi] (when n (node/placed-span n)) + duration (when (and lo hi) (- hi lo))] + (cond + (nil? sym) {:refused "there is no destination symbol"} + (nil? n) {:refused "there is no clip to place"} + (contains? nodes id) {:refused "the destination already uses that clip ID"} + (some? (:parent n)) {:refused "only a direct child can be placed in a symbol"} + (not (and (integer? at) (not (neg? at)))) + {:refused "a position is a nonnegative whole frame"} + (not (pos? duration)) {:refused "the clip has no frames to place"} + (and remainder-id (contains? nodes remainder-id)) + {:refused "the remainder clip needs a free ID"} + :else + (let [room (cleared clip sid at duration remainder-id)] + (if (:refused room) + room + (let [placed (update-in n [:time :at] (fnil + 0) (- at lo)) + nodes (assoc (get-in (:clip room) [:symbols sid :nodes]) id placed)] + (finish (:clip room) sid nodes id extent))))))) + (defn place-symbol - "Place arbitrary symbol `source-id` into `sid` as a naturally playing clip at - frame `at`. + "Materialize an instance of `source-id`, then place it into `sid` at `at`. IN A LANE the new clip claims its interval: existing clips under it are trimmed, removed, or split, so the sequence stays a partition rather than @@ -488,25 +524,13 @@ {:keys [extent point remainder-id] :or {extent :keep}}] (let [nodes (get-in clip [:symbols sid :nodes]) seeded (clip/place-symbol clip store sid source-id 0 id point) - n (get-in seeded [:symbols sid :nodes id]) - duration (when n (- (second (node/placed-span n)) - (first (node/placed-span n))))] + n (get-in seeded [:symbols sid :nodes id])] (cond (contains? nodes id) {:refused "the new clip ID is already used"} - (not (and (integer? at) (not (neg? at)))) - {:refused "a position is a nonnegative whole frame"} (nil? (clip/symbol clip source-id)) {:refused "there is no such symbol to place"} (nil? n) {:refused "a symbol cannot go inside itself"} - (not (pos? duration)) {:refused "the symbol has no frames to place"} - (and remainder-id (contains? nodes remainder-id)) - {:refused "the remainder clip needs a free ID"} :else - (let [room (cleared clip sid at duration remainder-id)] - (if (:refused room) - room - (let [nodes (assoc (get-in (:clip room) [:symbols sid :nodes]) id - (assoc-in n [:time :at] at))] - (finish (:clip room) sid nodes id extent))))))) + (place-node clip sid n at {:extent extent :remainder-id remainder-id})))) (defn adopt "Move an existing clip of `sid` to frame `at`, CLAIMING the time it lands on. @@ -516,28 +540,36 @@ is what a body drag does, and it is why `move` and this are two commands: `move` refuses to disturb a neighbour, and a drag onto occupied time has already said it means to." - [clip sid id at {:keys [extent remainder-id] :or {extent :keep}}] + [clip sid id at opts] (let [nodes (get-in clip [:symbols sid :nodes]) - n (get nodes id) - [lo hi] (when n (node/placed-span n)) - duration (when (and lo hi) (- hi lo))] + n (get nodes id)] (cond (nil? n) {:refused "select a clip to move"} (some? (:parent n)) {:refused "only a clip of the symbol itself is placed in its sequence"} - (not (and (integer? at) (not (neg? at)))) - {:refused "a position is a nonnegative whole frame"} - (not (pos? duration)) {:refused "the clip has no frames to place"} - (and remainder-id (contains? nodes remainder-id)) - {:refused "the remainder clip needs a free ID"} :else - (let [room (cleared (assoc-in clip [:symbols sid :nodes] - (dissoc nodes id)) - sid at duration remainder-id)] - (if (:refused room) - room - (let [moved (update-in n [:time :at] (fnil + 0) (- at lo)) - nodes (assoc (get-in (:clip room) [:symbols sid :nodes]) id moved)] - (finish (:clip room) sid nodes id extent))))))) + (place-node (assoc-in clip [:symbols sid :nodes] (dissoc nodes id)) + sid n at opts)))) + +(defn transfer + "Move direct child `id` from `from-sid` into `to-sid` at `at`. + + Cross-symbol and same-symbol moves are deliberately the same composition: + detach, then `place-node`. The destination's mode—not the gesture, source, or + payload kind—decides whether occupied time is claimed." + [clip from-sid id to-sid at opts] + (let [from-nodes (get-in clip [:symbols from-sid :nodes]) + n (get from-nodes id)] + (cond + (nil? n) {:refused "select a clip to move"} + (some? (:parent n)) {:refused "only a direct child can move between symbols"} + :else + (let [detached (assoc-in clip [:symbols from-sid :nodes] (dissoc from-nodes id)) + result (place-node detached to-sid n at opts)] + (if-let [made (:clip result)] + (if-let [why (first (clip/problems made))] + {:refused why} + result) + result))))) ;; --------------------------------------------------------------------------- ;; putting drawings in a sequence diff --git a/frontend/src/arthur/domain/symbol.cljs b/frontend/src/arthur/domain/symbol.cljs index 9bf97e1..d0c1a31 100644 --- a/frontend/src/arthur/domain/symbol.cljs +++ b/frontend/src/arthur/domain/symbol.cljs @@ -122,10 +122,10 @@ `{:at a :rate r}`, meaning symbol frame `p` is frame `r·(p − a)` of `id`. Identity for `nil`, which is a node sitting directly in the symbol. - THE FRAME SPACE A COMMAND IS GIVEN ITS COORDINATE IN. A cel's parent is its - lane, so a lane command composing this for the lane reads lane time; a node - with no parent reads the symbol's own frames. One rule either way, so a caller - holding a node does not have to ask what it is sitting in. + THE FRAME SPACE A COMMAND IS GIVEN ITS COORDINATE IN. A direct child reads + the symbol's own frames. A node grouped beneath another composes through that + parent chain. One rule either way, so a caller holding a node does not have to + ask what it is sitting in or how the timeline happens to draw the symbol. Refuses floors and loops rather than pretend an affine map preserves them: through either, one frame of the symbol is not one frame of `id` and a command @@ -141,8 +141,8 @@ (recur (:parent n) (conj seen id) (conj chain n))))))) (defn lane? - "Whether symbol `sym` is DRAWN as a lane: its clips as blocks on one row, - following one another in time and claiming it from each other. + "Whether symbol `sym` is EDITED AND DRAWN as a lane: its clips as blocks on + one row, following one another in time and claiming it from each other. A DISPLAY HINT AND NOT A TYPE. Nothing in evaluation reads it, `problems` does not check it, and a symbol carrying it behaves identically on the stage — it @@ -153,8 +153,8 @@ from \"the clips do not currently overlap\" because a symbol must not stop being a lane the moment something overlaps — that is when the rules are needed. - The only things allowed to read it are the timeline and `span/finish`'s - overlap check. See `docs/lane-is-a-view-plan.md`." + Editing and presentation may read it; evaluation may not. See + `docs/lane-is-a-view-plan.md`." [sym] (= :lane (:display sym))) diff --git a/frontend/src/arthur/events/ui.cljs b/frontend/src/arthur/events/ui.cljs index 357a882..14516ce 100644 --- a/frontend/src/arthur/events/ui.cljs +++ b/frontend/src/arthur/events/ui.cljs @@ -728,36 +728,19 @@ (rf/reg-event-db ::drop-clip - ;; A CLIP BODY DRAGGED ONTO A ROW. Within its own symbol this is `span/adopt`, - ;; which claims the time it lands on — a drop onto occupied frames has already - ;; said it means to. Onto a row leading into ANOTHER symbol it is that, after - ;; `nest/move-node` carries the clip across keeping its world transform; the two - ;; commit as one transaction, so it is still one undo step. - (fn [db [_ [_ from-sid id from-path] target-path frame]] + ;; A clip body is already materialized, so its whole drop is: resolve the + ;; destination, then transfer it. `span/transfer` asks the destination whether + ;; it claims time; this event does not know or care whether that is a lane. + (fn [db [_ [_ from-sid id _] target frame]] (let [{document :clip st :store} (store/entry (:clip/current db)) - open (get-in db [:ui :open]) - into (nest/inside document st open (vec target-path) frame) - crossing? (not= from-sid (:sid into)) - carried (when (and (:sid into) crossing?) - (nest/move-node document st open (vec from-path) (vec target-path) frame)) - doc (if crossing? (:clip carried) document) - landed-id (if crossing? (:id carried) id) - result (cond - (nil? (:sid into)) - {:refused "what you are dropping into is not on screen at this frame"} - (not (integer? (:frame into))) - {:refused "the drop is not on one frame of that symbol"} - (and crossing? (:refused carried)) carried - :else (span/adopt doc (:sid into) landed-id (:frame into) - {:extent :grow-symbol - :remainder-id (random-uuid)}))] - (if-let [why (:refused result)] + where (drop-destination db document st frame target) + result (when-not (:refused where) + (span/transfer document from-sid id (:sid where) (:at where) + {:extent :grow-symbol + :remainder-id (random-uuid)}))] + (if-let [why (or (:refused where) (:refused result))] (update db :project merge {:status why}) - (-> db - (edit/transaction (constantly (:clip result))) - (assoc-in [:ui :selection] - [:node (:sid into) landed-id - (conj (vec target-path) landed-id)])))))) + (landed db where id result))))) ;; --------------------------------------------------------------------------- ;; moving rows between symbols @@ -769,48 +752,6 @@ (defn- refused [db why] (update db :project merge {:status (str "can't: " why)})) -(rf/reg-event-db - ::adopt-in-lane - ;; Plain body-drag is temporal. The destination row names either an instance - ;; of an explicit lane symbol, or the open lane symbol itself. Moving between - ;; two lane symbols transfers the clip before `span/adopt` claims its new time; - ;; Shift-drag remains the separate structural `::move-node` operation below. - (fn [db [_ [_ from-sid id _] [_ target-sid target-id target-path :as target] - frame]] - (let [{document :clip st :store} (store/entry (:clip/current db)) - open (get-in db [:ui :open]) - target-node (get-in document [:symbols target-sid :nodes target-id]) - dest-sid (if target-id (node/source target-node) target-sid) - dest (clip/symbol document dest-sid) - local-frame (if (seq target-path) - (:frame (nest/inside document st open target-path frame)) - (:frame (nest/inside document st open [] frame))) - n (get-in document [:symbols from-sid :nodes id]) - seeded (when (and n dest-sid) - (if (= from-sid dest-sid) - document - (-> document - (update-in [:symbols from-sid :nodes] dissoc id) - (assoc-in [:symbols dest-sid :nodes id] - (dissoc n :parent))))) - result (cond - (nil? n) {:refused "select a clip to move"} - (not (symbol/lane? dest)) {:refused "drop onto an explicit lane"} - (and (not= from-sid dest-sid) - (contains? (get-in document [:symbols dest-sid :nodes]) id)) - {:refused "the destination already has a clip with that ID"} - (not (integer? local-frame)) - {:refused "the drop is not on one frame of this lane"} - :else (span/adopt seeded dest-sid id local-frame - {:extent :grow-symbol - :remainder-id (random-uuid)}))] - (if-let [why (:refused result)] - (refused db why) - (-> db - (edit/transaction (constantly (:clip result))) - (assoc-in [:ui :selection] - [:node dest-sid id (conj (vec target-path) id)])))))) - (rf/reg-event-db ::move-node (fn [db [_ from to]] diff --git a/frontend/src/arthur/ui/timeline.cljs b/frontend/src/arthur/ui/timeline.cljs index 6f1cd20..867d8a2 100644 --- a/frontend/src/arthur/ui/timeline.cljs +++ b/frontend/src/arthur/ui/timeline.cljs @@ -686,8 +686,8 @@ (not= (:select under) (:selection drag))) under) [target-el target] (when (and drag (not shift?)) (lane-under e)) - crossing? (and target (not= target (:source-lane drag))) - target-frame (when crossing? + landing? (some? target) + target-frame (when landing? (max 0 (- (frame-at-element e frames target-el) (:grab drag))))] (when (and drag hint) @@ -706,7 +706,7 @@ (swap! sliding #(-> % (assoc :nest nest) (dissoc :target-lane :target-frame))) (rf/dispatch [::ui/sliding nil])) - crossing? + landing? (do (swap! sliding #(-> % (assoc :target-lane target :target-frame target-frame) @@ -735,7 +735,7 @@ (nth (:select nest) 3)])) (and commit? target-lane drag) (do (rf/dispatch [::ui/sliding nil]) - (rf/dispatch [::ui/adopt-in-lane (:selection drag) + (rf/dispatch [::ui/drop-clip (:selection drag) target-lane target-frame])) commit? ;; A press that moved nothing is a click, and a drag @@ -760,7 +760,6 @@ :on-click actual-select :drag (when drag (assoc drag - :source-lane select :grab (- (frame-at-element e frames track) (:in drag)))) :ripple? (and (= :out gesture-kind) (.-shiftKey e)) @@ -804,7 +803,7 @@ (.stopPropagation e) (if-let [from (drag/row-selection)] (do (drag/done!) - (rf/dispatch [::ui/adopt-in-lane from select + (rf/dispatch [::ui/drop-clip from select (frame-at e frames)])) (drag/land! (frame-at e frames) nil select))))} ;; Clipped to the ruler: an instance longer than the room left in its diff --git a/frontend/test/arthur/domain/sequence_test.cljs b/frontend/test/arthur/domain/sequence_test.cljs index bedfc3b..8a9160e 100644 --- a/frontend/test/arthur/domain/sequence_test.cljs +++ b/frontend/test/arthur/domain/sequence_test.cljs @@ -394,6 +394,53 @@ (mapv node/placed-span (symbol/children (get-in after [:symbols :main :nodes])))) "it is simply placed, on screen with what was already there")))) +(deftest repeated-symbol-drops-keep-the-symbols-natural-duration + (let [empty-lane (assoc-in (document) [:symbols :main] + {:id :main :frames 40 :display :lane :nodes {}}) + once (:clip (span/place-symbol empty-lane nil :main :one :wave 0 + {:extent :grow-symbol :remainder-id :r1})) + twice (:clip (span/place-symbol once nil :main :two :wave 10 + {:extent :grow-symbol :remainder-id :r2})) + thrice (:clip (span/place-symbol twice nil :main :three :wave 20 + {:extent :grow-symbol :remainder-id :r3}))] + (is (= [[:one [0 10]] [:two [10 20]] [:three [20 30]]] + (mapv (juxt :id node/placed-span) + (symbol/children (get-in thrice [:symbols :main :nodes])))) + "materializing the same source repeatedly does not collapse later instances") + (is (every? #(= [0 10] (:span %)) + (symbol/children (get-in thrice [:symbols :main :nodes])))) + (let [resolve (clip/resolver thrice :main nil pal/index-of nil)] + (doseq [[id at] [[:one 0] [:two 10] [:three 20]]] + (is (= [0 300 600 900] + (mapv (fn [f] + (let [op (first (filter #(= [id :mark] (:node %)) + (resolve (+ at f))))] + (js/Math.round (:cx op)))) + [0 3 6 9])) + (str id " gets its own complete source clock")))) + (is (empty? (clip/problems thrice))))) + +(deftest transfer-is-one-placement-rule-with-two-destination-modes + (let [doc (document) + moved (:clip (span/transfer doc :main :insert :main 2 + {:extent :grow-symbol :remainder-id :rest})) + clips (symbol/children (get-in moved [:symbols :main :nodes]))] + (is (= [[0 2] [2 6] [6 8]] (mapv node/placed-span clips)) + "moving within a lane claims the landing interval from both neighbours") + (is (= :insert (:id (second clips)))) + (is (empty? (symbol/overlaps (get-in moved [:symbols :main])))) + ;; The identical transfer into an ordinary symbol simply composites. + (let [ordinary (assoc-in doc [:symbols :other] + {:id :other :frames 12 + :nodes {:existing (cel :existing :drawing-a 0 4 0)}}) + free (:clip (span/transfer ordinary :main :b :other 1 + {:extent :grow-symbol :remainder-id :rest}))] + (is (= #{:existing :b} (set (keys (get-in free [:symbols :other :nodes]))))) + (is (= 1 (count (symbol/overlaps (get-in free [:symbols :other])))) + "overlap is ordinary composition outside lane mode") + (is (nil? (get-in free [:symbols :main :nodes :b]))) + (is (empty? (clip/problems free)))))) + (deftest an-existing-clip-can-be-moved-and-claim-where-it-lands (let [doc (assoc-in (document) [:symbols :main :nodes :badge] {:id :badge :kind :instance :z "z"