From 1b2b4ad3d245a8bf6a38d8a2d7a08f367b73df81 Mon Sep 17 00:00:00 2001 From: Your Name Date: Fri, 2 Oct 2026 01:11:55 -0400 Subject: [PATCH 1/4] Unify root timing and persistent lane targets --- docs/time.md | 4 ++ frontend/src/arthur/domain/clip.cljs | 39 ++++++++++++++++--- frontend/src/arthur/domain/span.cljs | 30 ++++++++++++-- frontend/src/arthur/events/project.cljs | 10 +++-- frontend/src/arthur/events/ui.cljs | 12 +++++- frontend/src/arthur/ui/params.cljs | 5 +++ frontend/src/arthur/ui/stage.cljs | 11 ++++-- frontend/src/arthur/ui/timeline.cljs | 32 +++++++++++---- frontend/test/arthur/domain/cadence_test.cljs | 30 ++++++++++++++ frontend/test/arthur/events/lane_test.cljs | 28 +++++++++++-- static/arthur/app.css | 7 ++-- 11 files changed, 175 insertions(+), 33 deletions(-) diff --git a/docs/time.md b/docs/time.md index 643dc17..c0d9205 100644 --- a/docs/time.md +++ b/docs/time.md @@ -4,6 +4,10 @@ Project `:fps` is the playback and export grid. Each symbol has its own native `:fps` and `:frames`; keys, spans, trace choices and corrections stay in that native space. A symbol without an explicit rate inherits the document rate; changing project fps first records that rate so its existing timing stays put. +The untouched symbol in a new document is deliberately different: it has no +authored timing to preserve, so it stays on the project grid and its empty frame +extent is rescaled to keep the same duration. This makes changing fps before +authoring establish the editor's grid instead of preserving the 30fps default. An output frame selects the latest native frame at or before its time: `floor(output-frame * native-fps / output-fps)`. Thus 30fps content in a 12fps diff --git a/frontend/src/arthur/domain/clip.cljs b/frontend/src/arthur/domain/clip.cljs index 5f5f807..d21eef6 100644 --- a/frontend/src/arthur/domain/clip.cljs +++ b/frontend/src/arthur/domain/clip.cljs @@ -71,12 +71,25 @@ (defn fps [clip sid] (or (:fps (symbol clip sid)) (:fps clip))) (defn set-fps - "Change the output grid without rewriting any content's frames." + "Change the output grid without rewriting authored content's frames. + + A new document's empty symbol is the one exception: it has no native rate yet, + so it follows the project grid and its empty extent is rescaled to preserve its + duration. Once a symbol contains anything, changing the project rate records + the old effective rate on it before changing the output grid." [clip rate] - (-> clip - (update :symbols #(into {} (map (fn [[sid sym]] - [sid (assoc sym :fps (fps clip sid))])) %)) - (assoc :fps rate))) + (let [old (:fps clip)] + (-> clip + (update :symbols + #(into {} + (map (fn [[sid sym]] + [sid (cond + (:fps sym) sym + (empty? (:nodes sym)) + (update sym :frames cadence/frames rate old) + :else (assoc sym :fps old))])) + %)) + (assoc :fps rate)))) (defn output-frames [clip sid] (cadence/frames (frames clip sid) (:fps clip) (fps clip sid))) @@ -165,6 +178,18 @@ (first (sort-by (fn [sid] [(- (or (frames clip sid) 0)) (str sid)]) (unplaced clip)))) +(defn set-root-fps + "Set the document/output rate and the root symbol's editing rate together. + + Project FPS is the root timeline's clock. Nested symbols keep their own native + rates and are sampled when placed across that boundary; only the root changes + here. Frame numbers are authored positions, so changing the rate does not + rewrite them or silently move cuts and keys." + [clip rate] + (let [root (opens-on clip)] + (cond-> (assoc clip :fps rate) + root (assoc-in [:symbols root :fps] rate)))) + (def ^:const blank-frames "How long a new document is before anything says otherwise. Four seconds at 30, which is long enough to key something into and short enough to scrub by hand." @@ -188,7 +213,9 @@ {:name "untitled" :fps 30 :width 320 :height 200 - :symbols {:main {:id :main :fps 30 :frames blank-frames :nodes {}}}}) + ;; No native fps yet: an untouched canvas follows the project grid. Imported + ;; and generated symbols carry their own rate explicitly. + :symbols {:main {:id :main :frames blank-frames :nodes {}}}}) (defn- transform-op "Put a symbol's already resolved mark into its instance's parent space. Its diff --git a/frontend/src/arthur/domain/span.cljs b/frontend/src/arthur/domain/span.cljs index 735f2e8..1efa712 100644 --- a/frontend/src/arthur/domain/span.cljs +++ b/frontend/src/arthur/domain/span.cljs @@ -49,6 +49,28 @@ [arthur.domain.node :as node] [arthur.domain.symbol :as symbol])) +(defn- fit-lanes + "Make direct lane children cover `sid`'s authored window. + + A lane has no independently authored extent: it is a view of its parent + symbol's timeline. Keep that invariant at the one commit point that can grow + a symbol, so neither the wrapper nor the lane symbol retains an old parent + length." + [clip sid] + (let [frames (clip/frames clip sid)] + (reduce + (fn [c [id n]] + (let [source (node/source n)] + (if (and (nil? (:parent n)) + (symbol/lane? (clip/symbol c source))) + (-> c + (assoc-in [:symbols sid :nodes id :span] [0 frames]) + (assoc-in [:symbols sid :nodes id :time :at] 0) + (assoc-in [:symbols source :frames] frames)) + c))) + clip + (get-in clip [:symbols sid :nodes])))) + (defn finish "Commit `nodes` as symbol `sid`'s, or refuse. @@ -94,9 +116,11 @@ (and (> needed (:frames sym)) (= :keep extent)) {:refused (str "the edit needs " needed " frames; extend the shot to continue") :required-frames needed} - :else {:clip (cond-> (assoc-in clip [:symbols sid :nodes] nodes) - (> needed (:frames sym)) - (assoc-in [:symbols sid :frames] needed)) + :else {:clip (fit-lanes + (cond-> (assoc-in clip [:symbols sid :nodes] nodes) + (> needed (:frames sym)) + (assoc-in [:symbols sid :frames] needed)) + sid) :selection selection}))) ;; --------------------------------------------------------------------------- diff --git a/frontend/src/arthur/events/project.cljs b/frontend/src/arthur/events/project.cljs index d4ada08..e1089d6 100644 --- a/frontend/src/arthur/events/project.cljs +++ b/frontend/src/arthur/events/project.cljs @@ -113,7 +113,11 @@ loaded (project/load cid #js {:leaves (.-leaves clip-json) :blocks blocks}) - built (:clip loaded)] + ;; Project FPS and the root timeline are one clock. This + ;; also normalizes documents saved by the earlier model, + ;; where changing project FPS left the root on its old + ;; editing grid. + built (clip/set-root-fps (:clip loaded) (:fps (:clip loaded)))] (let [entry (merge (select-keys built [:fps :width :height]) {:label (str (or (.-name clip-json) cid) " (saved)") :cid cid @@ -606,7 +610,7 @@ (if (or (not (#{:fps :width :height} key)) (not (and (integer? value) (pos? value)))) {} - (let [db' (edit/edit db #(if (= key :fps) (clip/set-fps % value) (assoc % key value))) + (let [db' (edit/edit db #(if (= key :fps) (clip/set-root-fps % value) (assoc % key value))) db' (assoc-in db' [:clip key] value) frame (min (dec (pb/frames db')) (js/Math.floor (* (get-in db [:playback :frame]) @@ -636,7 +640,7 @@ (rf/reg-event-db ::symbol-setting (fn [db [_ sid key value]] - (if-not (and (#{:frames :width :height} key) + (if-not (and (#{:frames :fps :width :height} key) (or (nil? value) (and (integer? value) (pos? value)))) db (edit/edit db diff --git a/frontend/src/arthur/events/ui.cljs b/frontend/src/arthur/events/ui.cljs index ceefbb0..f8b0e15 100644 --- a/frontend/src/arthur/events/ui.cljs +++ b/frontend/src/arthur/events/ui.cljs @@ -624,6 +624,12 @@ (let [{document :clip st :store} (store/entry (:clip/current db)) open (get-in db [:ui :open]) frame (editing-frame db document) + ;; A lane is the open symbol's timeline, not an insert that happens to + ;; begin where the playhead was when it was made. Giving that wrapper + ;; the whole open-symbol window makes the row's promise true: it is a + ;; destination at every frame. Ordinary symbols remain clips created at + ;; the playhead. + frame (if lane? 0 frame) into (if (= :top where) (assoc (nest/inside document st open [] frame) :path []) (aimed-symbol document st db frame)) @@ -665,8 +671,10 @@ (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. + ;; A lane is an explicit, persistent top-level track of the open symbol. It + ;; must not become nested merely because the previously created lane is + ;; still aimed, and it spans the open symbol rather than starting at the + ;; current playhead. (create-container db :top true))) ;; --------------------------------------------------------------------------- diff --git a/frontend/src/arthur/ui/params.cljs b/frontend/src/arthur/ui/params.cljs index b01f246..3432be1 100644 --- a/frontend/src/arthur/ui/params.cljs +++ b/frontend/src/arthur/ui/params.cljs @@ -537,6 +537,11 @@ [:div.inspector-form [number-field "length (frames)" (:frames sym) #(rf/dispatch [::project/symbol-setting sid :frames %]) nil busy?] + [number-field "fps" (clip-domain/fps clip sid) + #(rf/dispatch (if (= sid (clip-domain/opens-on clip)) + [::project/project-setting :fps %] + [::project/symbol-setting sid :fps %])) + nil busy?] [number-field "width" (:width sym) #(rf/dispatch [::project/symbol-setting sid :width %]) "project default" busy?] [number-field "height" (:height sym) diff --git a/frontend/src/arthur/ui/stage.cljs b/frontend/src/arthur/ui/stage.cljs index 8c419cf..689339e 100644 --- a/frontend/src/arthur/ui/stage.cljs +++ b/frontend/src/arthur/ui/stage.cljs @@ -137,12 +137,15 @@ (defn- select! "Select the node at row path `path` of the open symbol — the selection a timeline row makes, so the row, the inspector and the stage all show it — or - nothing." + the open symbol itself when `path` is empty. Blank stage is an explicit place, + not merely an absence of a picked shape, so it clears a stale drawing target + as well as the inspector selection." [{:keys [open f] :as ctx} path] (let [{document :clip st :store} (loaded ctx)] - (rf/dispatch [::ui/select (when-let [{:keys [sid id]} (when (seq path) - (nest/placement document st open path f))] - [:node sid id path])]))) + (if-let [{:keys [sid id]} (when (seq path) + (nest/placement document st open path f))] + (rf/dispatch [::ui/select [:node sid id path]]) + (rf/dispatch [::ui/aim nil])))) (defn- begin! "Start dragging `kind` of the node at `path` from stage point `p`." diff --git a/frontend/src/arthur/ui/timeline.cljs b/frontend/src/arthur/ui/timeline.cljs index 8ce0833..a05aac5 100644 --- a/frontend/src/arthur/ui/timeline.cljs +++ b/frontend/src/arthur/ui/timeline.cljs @@ -1051,8 +1051,11 @@ visible (cond-> (vec picture) (seq sounds) (-> (conj {:path [::sounds] :kind :section :label "audio"}) (into sounds))) - ;; Roughly ten labels, on a round number of frames. - step (* 10 (js/Math.ceil (/ frames 100))) + ;; Major marks are whole seconds in the OPEN symbol's clock. On long + ;; timelines use a whole-number multiple of a second to keep roughly + ;; ten labels; never invent an FPS-blind 20/40/60 ruler. + fps (max 1 (or (clip/fps clip open) 1)) + step (* fps (max 1 (js/Math.ceil (/ frames (* fps 10))))) ;; THE OTHER DIRECTION, AND THE ONLY PLACE THIS PANE GOES THERE. The ;; ruler is in the open symbol's frames and the transport counts output ;; frames, so scrubbing names a mark and seeks to the output frame that @@ -1063,9 +1066,19 @@ [:section.pane.time [transport] [:div.tl-body + ;; Blank timeline space means the open symbol. Use the same `aim` + ;; gesture as its breadcrumb so both the visible selection and the + ;; drawing destination return to the root. Child controls stop their + ;; own events; the target check keeps ordinary row/bar clicks local. + {:on-click (fn [^js e] + (when (= (.-target e) (.-currentTarget e)) + (rf/dispatch [::ui/aim nil])))} [:div.tl-labels ;; Empty label space takes a row back out to the top of the open symbol. - {:on-drag-over (fn [^js e] + {:on-click (fn [^js e] + (when (= (.-target e) (.-currentTarget e)) + (rf/dispatch [::ui/aim nil]))) + :on-drag-over (fn [^js e] (when (drag/row) (.preventDefault e) (set! (.. e -dataTransfer -dropEffect) "move"))) @@ -1083,7 +1096,10 @@ [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))) + {:on-click (fn [^js e] + (when (= (.-target e) (.-currentTarget e)) + (rf/dispatch [::ui/aim nil]))) + :on-drag-enter (fn [^js e] (when (drag/accepts?) (.preventDefault e))) :on-drag-over (fn [^js e] (when (drag/accepts?) (.preventDefault e) @@ -1105,10 +1121,10 @@ :on-drop (fn [^js e] (.preventDefault e) (drag/land! (frame-at e frames) nil)) - ;; Five frames as a percentage of the whole span, handed to the - ;; stylesheet so the frame grid can be a repeating background instead - ;; of a div per frame. A 900-frame take is 900 elements nobody needs. - :style {"--tick" (str (* 100 (/ 5 frames)) "%")}} + ;; The rows and ruler share this exact major interval. Keeping a + ;; second, hard-coded five-frame grid here made its lines disagree + ;; with the numbered marks whenever the symbol's FPS changed. + :style {"--tick" (str (* 100 (/ step frames)) "%")}} [:div.tl-ruler {:on-pointer-down (fn [^js e] (rf/dispatch [::pb/seek (seek-to e frames)]) diff --git a/frontend/test/arthur/domain/cadence_test.cljs b/frontend/test/arthur/domain/cadence_test.cljs index 80be494..c32002b 100644 --- a/frontend/test/arthur/domain/cadence_test.cljs +++ b/frontend/test/arthur/domain/cadence_test.cljs @@ -45,6 +45,36 @@ (is (= 3 (clip/first-output-frame doc :main 7))) (is (= [0 60] (:span (first (timeline/rows doc :main #{}))))))) +(deftest changing-fps-before-authoring-moves-the-empty-canvas-to-that-grid + (let [doc (clip/set-fps (clip/blank) 12)] + (is (= 12 (:fps doc))) + (is (nil? (get-in doc [:symbols :main :fps]))) + (is (= 48 (clip/frames doc :main))) + (is (= 48 (clip/output-frames doc :main))) + (is (= 8 (clip/shown-frame doc :main 8))) + (is (= 8 (clip/first-output-frame doc :main 8))))) + +(deftest changing-fps-after-authoring-preserves-the-symbols-native-grid + (let [started (assoc-in (clip/blank) [:symbols :main :nodes :mark] + {:id :mark :kind :rect :z "a"}) + doc (clip/set-fps started 12)] + (is (= 30 (get-in doc [:symbols :main :fps]))) + (is (= 120 (clip/frames doc :main))) + (is (= 48 (clip/output-frames doc :main))))) + +(deftest project-fps-is-the-root-symbols-editing-grid + (let [doc (-> (clip/blank) + (assoc-in [:symbols :main :nodes :child] + {:id :child :kind :instance :z "a" + :source {:symbol :nested}}) + (assoc-in [:symbols :nested] + {:id :nested :fps 30 :frames 90 :nodes {}}) + (clip/set-root-fps 12))] + (is (= 12 (:fps doc)) "the output grid") + (is (= 12 (clip/fps doc :main)) "is also the root editing grid") + (is (= 30 (clip/fps doc :nested)) "while a nested symbol keeps its own grid") + (is (= 120 (clip/frames doc :main)) "frame positions are not rewritten"))) + (deftest crossing-to-the-output-grid-and-back-lands-on-the-frame-it-names ;; `first-output-frame` is the inverse of `shown-frame` as far as a floor has ;; one: seeking to the output frame it names puts the playhead on a frame at or diff --git a/frontend/test/arthur/events/lane_test.cljs b/frontend/test/arthur/events/lane_test.cljs index 8aade43..939ce3c 100644 --- a/frontend/test/arthur/events/lane_test.cljs +++ b/frontend/test/arthur/events/lane_test.cljs @@ -3,6 +3,7 @@ [arthur.domain.clip :as clip] [arthur.domain.history :as history] [arthur.domain.leaf :as leaf] + [arthur.domain.node :as node] [arthur.domain.sequence-test :as fixture] [arthur.domain.span :as span] [arthur.events.ui :as ui] @@ -16,20 +17,41 @@ (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}}) + :ui {:open :main} :playback {:frame 6}}) (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)})))] + {:db db :document saved :instance-id instance-id + :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")] + {lane :symbol lane-db :db document :document instance-id :instance-id} + (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 (= [0 (clip/frames document :main)] + (node/placed-span (get-in document [:symbols :main :nodes instance-id]))) + "a lane exists across the open symbol, independent of the playhead") + (let [longer (assoc-in document [:symbols :main :frames] 300) + fitted (:clip (span/finish longer :main + (get-in longer [:symbols :main :nodes]) + nil :keep)) + lane-id (node/source (get-in fitted [:symbols :main :nodes instance-id]))] + (is (= [0 300] + (node/placed-span (get-in fitted [:symbols :main :nodes instance-id]))) + "the lane follows a later change to its parent's extent") + (is (= 300 (clip/frames fitted lane-id)))) (is (some? (get-in lane-db [:ui :target])) "the new lane is aimed so drawing and pool drops can go into it")))) +(deftest aiming-the-root-clears-selection-and-drawing-target + (let [db {:ui {:selection [:node :main :shape [:lane :shape]] + :target {:sid :main :id :lane :path [:lane]}}} + after (ui/aimed db nil)] + (is (nil? (get-in after [:ui :selection]))) + (is (nil? (get-in after [:ui :target]))))) + (deftest an-explicit-lane-is-one-row-of-clips (let [doc (fixture/document) rows (timeline/rows doc :main #{}) diff --git a/static/arthur/app.css b/static/arthur/app.css index 80a3afa..5a25d4b 100644 --- a/static/arthur/app.css +++ b/static/arthur/app.css @@ -1026,10 +1026,9 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); } min-width: max(340px, calc((100% - var(--label)) * var(--tl-zoom, 1))); position: relative; background: #fff; - /* The frame grid, five frames to a division, as a background rather than as - an element per frame: a 900-frame take is 900 divs nobody needs in the DOM. - `--tick` is five frames as a percentage of the span, set from the component - because only it knows how long the clip is. */ + /* The major frame grid, using the same whole-second interval as the numbered + ruler. It is a background rather than an element per mark; `--tick` is set + by the component because only it knows the open symbol's length and FPS. */ background-image: repeating-linear-gradient(90deg, var(--grid-5) 0 1px, transparent 1px var(--tick, 10%)); From 8f09b7b47f1c735d848235597cb67fa28c20b6f1 Mon Sep 17 00:00:00 2001 From: Your Name Date: Fri, 2 Oct 2026 09:06:28 -0400 Subject: [PATCH 2/4] Unify lane overlap and nested timing --- frontend/src/arthur/domain/nest.cljs | 2 +- frontend/src/arthur/domain/span.cljs | 112 ++++++++++----------- frontend/src/arthur/events/ui.cljs | 14 ++- frontend/src/arthur/ui/timeline.cljs | 63 +++++++----- frontend/test/arthur/domain/nest_test.cljs | 12 +++ frontend/test/arthur/events/lane_test.cljs | 23 +++++ 6 files changed, 140 insertions(+), 86 deletions(-) diff --git a/frontend/src/arthur/domain/nest.cljs b/frontend/src/arthur/domain/nest.cljs index 8558ae8..210cca7 100644 --- a/frontend/src/arthur/domain/nest.cljs +++ b/frontend/src/arthur/domain/nest.cljs @@ -454,7 +454,7 @@ ;; a boundary can be rolled depend on which of them `some` reaches ;; first. `finish` does the same `problems` check and the overlap one ;; too, so this is less code and one fewer invariant to remember. - (span/finish clip (:sid here) moved id :grow-symbol))))) + (span/claim clip (:sid here) moved id :grow-symbol (random-uuid)))))) (defn resize-out "Move the right edge of the node at `path` by `df` frames of `open`. diff --git a/frontend/src/arthur/domain/span.cljs b/frontend/src/arthur/domain/span.cljs index 1efa712..a578c41 100644 --- a/frontend/src/arthur/domain/span.cljs +++ b/frontend/src/arthur/domain/span.cljs @@ -144,6 +144,47 @@ [n which f] (assoc-in n [:span (case which :in 0 :out 1)] (local n f))) +(defn claim + "Commit proposed `nodes`, with `id` claiming its interval in lane mode. + + This is the one difference between editing a lane and a composition. In a + composition it is exactly `finish`. In a lane, immediately before that same + commit, clips covered by the edited one are removed and clips crossing either + edge are trimmed. A clip crossing both edges is split and therefore needs a + caller-supplied `remainder-id`." + [clip sid nodes id extent remainder-id] + (let [n (get nodes id) + lane-child? (and (symbol/lane? (clip/symbol clip sid)) + n (nil? (:parent n)) (node/placed-span n))] + (if-not lane-child? + (finish clip sid nodes id extent) + (let [[a b] (node/placed-span n) + others (remove #(= id (:id %)) (symbol/children nodes)) + spanning (first (filter #(let [[lo hi] (node/placed-span %)] + (and (< lo a) (> hi b))) + others))] + (if (and spanning (or (nil? remainder-id) (contains? nodes remainder-id))) + {:refused "claiming time inside one clip needs a free ID for its remainder"} + (finish + clip sid + (reduce + (fn [ns other] + (let [oid (:id other) + [lo hi] (node/placed-span other)] + (cond + (or (<= hi a) (>= lo b)) ns + (and (< lo a) (> hi b)) + (-> ns + (assoc oid (edged other :out a)) + (assoc remainder-id + (assoc (edged other :in b) :id remainder-id + :z (str "a-" remainder-id)))) + (and (>= lo a) (<= hi b)) (dissoc ns oid) + (< lo a) (assoc ns oid (edged other :out a)) + :else (assoc ns oid (edged other :in b))))) + nodes others) + id extent)))))) + (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 @@ -335,7 +376,7 @@ (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 + later (when (and node ripple?) (filter #(>= (first (node/placed-span %)) old-out) (siblings clip sid nodes id)))] (cond @@ -346,22 +387,10 @@ :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))))) + changed (reduce (fn [ns sibling] + (update-in ns [(:id sibling) :time :at] (fnil + 0) delta)) + resized later)] + (claim clip sid changed id extent nil))))) (defn resize-in "Put clip `id`'s left edge at parent frame `to`. Shrinking leaves a gap; @@ -369,29 +398,14 @@ [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)))] + [old-in hi] (when node (node/placed-span node))] (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))))) + :else (claim clip sid (assoc nodes id (edged node :in to)) id :keep nil)))) (defn roll "Move the shared boundary between adjacent clips `left-id` and `right-id`. @@ -460,17 +474,6 @@ ;; 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. @@ -528,12 +531,8 @@ (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))))))) + (let [placed (update-in n [:time :at] (fnil + 0) (- at lo))] + (claim clip sid (assoc nodes id placed) id extent remainder-id))))) (defn place-symbol "Materialize an instance of `source-id`, then place it into `sid` at `at`. @@ -746,12 +745,11 @@ "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)))))) + (let [c (assoc-in clip [:symbols drawing-id] + {:id drawing-id :name (name drawing-id) + :fps (clip/fps clip sid) :frames 1 :nodes {}}) + nodes (assoc nodes id (held id drawing-id at))] + (claim c sid nodes id extent remainder-id))))) (defn make-unique "Point clip `id` at a private copy of its content, leaving every other diff --git a/frontend/src/arthur/events/ui.cljs b/frontend/src/arthur/events/ui.cljs index f8b0e15..73c1542 100644 --- a/frontend/src/arthur/events/ui.cljs +++ b/frontend/src/arthur/events/ui.cljs @@ -696,9 +696,9 @@ ::drop-clear (fn [db _] (update db :ui dissoc :drop))) -(defn drop-destination - "Which symbol a drop lands in and on which of its frames: `{:clip :sid :at - :path}`, or `{:refused why}`. +(defn drop-destination-at + "Which symbol a drop on `target` lands in and on which of its frames: + `{:clip :sid :at :path}`, 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 @@ -714,12 +714,11 @@ `: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] + [document st open 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) @@ -732,6 +731,11 @@ (not (integer? at)) {:refused "the drop is not on one frame of that symbol"} :else {:clip document :sid sid :at at :path path}))) +(defn drop-destination + "`drop-destination-at` from the symbol currently open in `db`." + [db document st frame target] + (drop-destination-at document st (get-in db [:ui :open]) frame target)) + (defn landed "`db` after a drop that produced `result`, with `uuid` selected." [db {:keys [sid path]} uuid result] diff --git a/frontend/src/arthur/ui/timeline.cljs b/frontend/src/arthur/ui/timeline.cljs index a05aac5..d87b9d6 100644 --- a/frontend/src/arthur/ui/timeline.cljs +++ b/frontend/src/arthur/ui/timeline.cljs @@ -43,9 +43,16 @@ ;; --------------------------------------------------------------------------- ;; the rows +(defn- time->parent + "The inverse of a time map: where one of its output frames sits in its input." + [{:keys [at rate]}] + (if (and (zero? at) (= 1 rate)) + identity + (fn [f] (+ at (/ f rate))))) + (defn- local->parent - "The inverse of a node's time map: where a frame of its OWN time sits in the - symbol it lives in. See `node/time-of`. + "Where a frame of a node's OWN time sits in the symbol it lives in. + See `node/time-of`. Two frame spaces meet at every node and mixing them up is the bug this exists to prevent: a placement `:at 48` whose scale is keyed at 0 has that key on @@ -56,10 +63,7 @@ frame the exposure grid never samples is still authored on that frame, and that is where the row should show it." [n] - (let [{:keys [at rate]} (node/time-of n)] - (if (and (zero? at) (= 1 rate)) - identity - (fn [f] (+ at (/ f rate)))))) + (time->parent (node/time-of n))) (defn- keyed-frames [ch] (some-> (:keys ch) keys sort)) @@ -131,8 +135,8 @@ ;; 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)))) + (if-let [source-time (clip/source-time clip sid n)] + (walk source path depth (comp self (time->parent source-time))) (mapv (fn [row] (-> row (assoc :keys [] :unmapped? true) @@ -244,6 +248,13 @@ self (comp parent-map (local->parent n)) source-sym (when (= :instance (:kind n)) (clip/symbol clip (node/source n))) + ;; `self` maps the instance's local clock. Rows of + ;; the symbol it places use its source clock too, + ;; including the native-FPS ratio. + source-self (if-let [t (and source-sym + (clip/source-time clip sid n))] + (comp self (time->parent t)) + self) lane? (symbol/lane? source-sym) clips (when lane? (symbol/children (:nodes source-sym))) span (mapv parent-map @@ -283,13 +294,13 @@ :label (or (get-in clip [:symbols (node/source child) :name]) (some-> (node/source child) name)) :source (node/source child) - :span (mapv self (node/placed-span child)) + :span (mapv source-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))) + (map (comp source-self (local->parent child))) (distinct)) (vals (node/channels child))) :select [:node (node/source n) (:id child) @@ -302,7 +313,7 @@ ;; The one clip an expanded lane opens. (into (when lane? (if-let [child (first (filter #(under? (conj rpath (:id %))) clips))] - (portal (node/source n) rpath (inc depth) self child) + (portal (node/source n) rpath (inc depth) source-self child) [{:path (conj rpath ::portal) :depth (inc depth) :kind :hint @@ -587,7 +598,6 @@ (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; @@ -597,13 +607,8 @@ :on-click #(when select (rf/dispatch [::ui/aim select])) ;; An instance's row opens the symbol it places, as a tab. :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!))))} + (when of + (rf/dispatch [::pb/open-symbol of])))} ;; 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 @@ -667,7 +672,7 @@ node? [:span.kind (if via (str "· in " via) (str "·" (name node-kind)))]) (when lane? [:button.tl-rename - {:title "rename lane (F2)" + {:title "rename lane" :on-click (fn [^js e] (.stopPropagation e) (begin-rename!))} "✎"]) ;; A face's row is where its own footage is switched on, next to solo @@ -734,10 +739,22 @@ (not= (:select under) (:selection drag))) under) [target-el target] (when (and drag (not shift?)) (lane-under e)) - landing? (some? target) + target-at (when target + (frame-under e frames target-el)) + ;; A cel moved on its OWN lane is a normal slide. + ;; Resolve the row under the pointer before calling + ;; it a transfer: comparing the displayed rows is + ;; not enough when the lane is reached through an + ;; instance. This leaves one slide gesture and one + ;; coordinate conversion; lane overlap trimming is + ;; the domain command's only additional policy. + target-sid (when target + (:sid (ui/drop-destination-at + clip store open target-at target))) + landing? (and target-sid + (not= target-sid (nth (:selection drag) 1))) target-frame (when landing? - (max 0 (- (frame-under e frames target-el) - (:grab drag))))] + (max 0 (- target-at (:grab drag))))] (when (and drag hint) (reset! hint {:x (.-clientX e) :y (.-clientY e) diff --git a/frontend/test/arthur/domain/nest_test.cljs b/frontend/test/arthur/domain/nest_test.cljs index d224a4f..aba75ff 100644 --- a/frontend/test/arthur/domain/nest_test.cljs +++ b/frontend/test/arthur/domain/nest_test.cljs @@ -356,3 +356,15 @@ (is (= [22 23] (node/placed-span (get-in slid [:symbols :lane :nodes :b])))) (is (= 1 (:rate (get-in slid [:symbols :lane :nodes :b :time]))) "and the rest of its map is still there"))) + +(deftest sliding-in-a-lane-claims-overlapped-time + ;; The gesture is `nest/slide` in both display modes. Lane mode contributes + ;; only the placement rule at commit: the moved cel replaces what it covers. + (let [c (on-twos) + r (nest/slide c :lane [:b] -14) + slid (:clip r)] + (is (nil? (:refused r)) (:refused r)) + (is (= [5 6] (node/placed-span (get-in slid [:symbols :lane :nodes :b])))) + (is (nil? (get-in slid [:symbols :lane :nodes :a])) + "a fully covered neighbor is removed") + (is (empty? (clip/problems slid))))) diff --git a/frontend/test/arthur/events/lane_test.cljs b/frontend/test/arthur/events/lane_test.cljs index 939ce3c..a282069 100644 --- a/frontend/test/arthur/events/lane_test.cljs +++ b/frontend/test/arthur/events/lane_test.cljs @@ -63,6 +63,29 @@ [:node :main :insert [:insert]]] (mapv :select (:cels lane)))))) +(deftest a-nested-lane-is-drawn-in-the-open-symbols-frame-rate + (let [child {:id :cel :kind :instance :z "a" :span [0 2] + :time {:at 4 :rate 1} + :source {:symbol :drawing} + :playback {:in 0 :speed 0 :end :stop}} + placed {:id :take :kind :instance :z "a" :span [0 12] + :time {:at 0 :rate 1} + :source {:symbol :lane} + :playback {:in 0 :speed 1 :end :stop}} + doc (-> (clip/blank) + (assoc :fps 12) + (assoc-in [:symbols :main :fps] 12) + (assoc-in [:symbols :main :frames] 12) + (assoc-in [:symbols :main :nodes] {:take placed}) + (assoc-in [:symbols :lane] + {:id :lane :fps 24 :frames 24 :display :lane + :nodes {:cel child}}) + (assoc-in [:symbols :drawing] + {:id :drawing :fps 24 :frames 1 :nodes {}})) + lane (first (filter :lane? (timeline/rows doc :main #{})))] + (is (= [[2 3]] (mapv :span (:cels lane))) + "native frames 4–6 occupy ruler frames 2–3 at twice the frame rate"))) + (deftest an-ordinary-symbol-keeps-a-row-per-node (let [doc (update-in (fixture/document) [:symbols :main] dissoc :display) rows (timeline/rows doc :main #{})] From b41180db0881b269d02850bd47b7d68e0d614695 Mon Sep 17 00:00:00 2001 From: Your Name Date: Fri, 2 Oct 2026 09:08:53 -0400 Subject: [PATCH 3/4] Add project palette assets and overrides --- clips/tests/test_api.py | 13 +++ clips/views.py | 17 ++- frontend/src/arthur/db.cljs | 5 +- frontend/src/arthur/domain/clip.cljs | 50 +++++++-- frontend/src/arthur/domain/leaf.cljs | 10 +- frontend/src/arthur/domain/palette.cljs | 80 ++++++++++++-- frontend/src/arthur/domain/symbol.cljs | 1 + frontend/src/arthur/events/export.cljs | 5 +- frontend/src/arthur/events/project.cljs | 103 +++++++++++++++++- frontend/src/arthur/flow/freeze.cljs | 19 ++-- frontend/src/arthur/subs/render.cljs | 16 +-- frontend/src/arthur/subs/ui.cljs | 28 +++++ frontend/src/arthur/ui/palette.cljs | 81 +++++++++----- frontend/src/arthur/ui/params.cljs | 38 ++++++- frontend/src/arthur/ui/pool.cljs | 58 ++++++++-- .../test/arthur/domain/instance_test.cljs | 30 +++++ static/arthur/app.css | 3 + 17 files changed, 470 insertions(+), 87 deletions(-) diff --git a/clips/tests/test_api.py b/clips/tests/test_api.py index 2d58317..f01e47a 100644 --- a/clips/tests/test_api.py +++ b/clips/tests/test_api.py @@ -416,6 +416,19 @@ class DocumentTests(TestCase): self.assertEqual({str(self.project.id)}, {r["project"] for r in rows}) self.assertEqual({"c1"}, {r["cid"] for r in rows}) + def test_saved_palettes_are_listed_as_assets(self): + leaves = self.leaves() + leaves["clip/c1/palette/night"] = [ + "^ ", "~:id", "~:night", "~:name", "Moonlit", + "~:slots", ["~#list", [["^ ", "~:hex", "#001122"]]], + ] + self.assertEqual(200, self.save(leaves).status_code) + rows = self.client.get("/api/symbols").json()["palettes"] + self.assertEqual( + [("Moonlit", "night", "c1")], + [(r["name"], r["palette"], r["cid"]) for r in rows], + ) + def test_a_document_comes_back_exactly(self): response = self.save() self.assertEqual(200, response.status_code, response.content) diff --git a/clips/views.py b/clips/views.py index 11c785e..4092a0e 100644 --- a/clips/views.py +++ b/clips/views.py @@ -357,6 +357,7 @@ def footage_list(request): _SYMBOL_LEAF = re.compile(r"^clip/([^/]+)/symbol/([^/]+)$") +_PALETTE_LEAF = re.compile(r"^clip/([^/]+)/palette/([^/]+)$") def _transit_fields(value, *keys): @@ -391,7 +392,21 @@ def symbols(request): "frames": fields.get("frames"), }) rows.sort(key=lambda r: (r["project_name"], r["project"], r["name"])) - return JsonResponse({"symbols": rows}) + palettes = [] + for leaf in Leaf.objects.filter(path__contains="/palette/").select_related("project"): + m = _PALETTE_LEAF.match(leaf.path) + if not m: + continue + fields = _transit_fields(leaf.value, "name") + palettes.append({ + "project": str(leaf.project_id), + "project_name": leaf.project.name, + "cid": m.group(1), + "palette": m.group(2), + "name": fields.get("name") or m.group(2).replace("~", "/"), + }) + palettes.sort(key=lambda r: (r["project_name"], r["project"], r["name"])) + return JsonResponse({"symbols": rows, "palettes": palettes}) @require_http_methods(["GET", "PATCH"]) diff --git a/frontend/src/arthur/db.cljs b/frontend/src/arthur/db.cljs index bba47ec..b53f3c8 100644 --- a/frontend/src/arthur/db.cljs +++ b/frontend/src/arthur/db.cljs @@ -82,7 +82,7 @@ ;; Every symbol in every saved project, for the pool's all-assets folder. Rows ;; from `/api/symbols`, nothing loaded: a symbol from elsewhere is fetched when ;; it is dropped. - :assets {:symbols [] :loading? false} + :assets {:symbols [] :palettes [] :loading? false} ;; The document's own identity on the server. `:seq` is the monotonic project ;; version: a client that sees a delta with `seq > local + 1` refetches, which @@ -159,7 +159,8 @@ :ui {:open nil :tabs [] :selection nil - :tone :skin-base + :selections [] + :tone 1 :tool nil :auto-key? false :draft [] diff --git a/frontend/src/arthur/domain/clip.cljs b/frontend/src/arthur/domain/clip.cljs index d21eef6..f313b7b 100644 --- a/frontend/src/arthur/domain/clip.cljs +++ b/frontend/src/arthur/domain/clip.cljs @@ -51,7 +51,8 @@ that loses something on every round trip, which is the one bug a persistence layer must not be able to have. Add the field here and to `leaf/leaves` and `leaf/clip` in the same commit." - #{:name :fps :analysis :subjects :features :groups :width :height :symbols}) + #{:name :fps :analysis :subjects :features :groups :width :height :symbols + :palettes :default-palette}) (defn symbol "One of the clip's symbols, by id." @@ -213,6 +214,8 @@ {:name "untitled" :fps 30 :width 320 :height 200 + :palettes {pal/default-id pal/default-palette} + :default-palette pal/default-id ;; No native fps yet: an untouched canvas follows the project grid. Imported ;; and generated symbols carry their own rate explicitly. :symbols {:main {:id :main :frames blank-frames :nodes {}}}}) @@ -245,15 +248,27 @@ Every instance owns its cursors and buffers. The IResolver queries return native node frames and world matrices for the last rendered output frame." [clip sid store palette opts] - (letfn [(build [sid chain pose-tracks] + (let [context? (and (map? palette) (:palettes palette) (:offsets palette))] + (letfn [(selection-at [owner frame inherited] + (let [selection (:palette owner) + chosen (cond + (nil? selection) nil + (and (map? selection) (contains? selection :animated?)) + (ch/value-at selection frame store) + :else selection)] + (or chosen inherited (:default palette)))) + (build [sid chain pose-tracks] (when (some #{sid} chain) (throw (ex-info "symbol cycle" {:chain (conj chain sid)}))) (let [sym (or (symbol clip sid) (throw (ex-info "an instance names a missing symbol" {:symbol sid}))) + active (volatile! (when context? (:default palette))) nodes (:nodes sym) rank (symbol/draw-rank nodes (symbol/order nodes)) ids (sort-by rank (keys nodes)) - own (symbol/resolver sym store palette + own (symbol/resolver sym store (if context? + #(pal/render-index palette @active %) + palette) (assoc opts :pose-tracks pose-tracks)) ;; Each cel owns its source resolver and mutable buffers. children (into {} @@ -268,7 +283,10 @@ ;; there used to be. Their resolvers still hold the frame ;; before whenever they were not on. entered (volatile! {}) - step (fn [f pre] + step (fn [f pre inherited forced] + (when context? + (vreset! active (or forced + (selection-at sym (js/Math.floor f) inherited)))) (vreset! entered {}) (let [by-id (into {} (map (juxt :node identity)) (own (js/Math.floor f) (js/Math.floor pre)))] @@ -301,14 +319,18 @@ ;; previous frame, and so no gap. (or (:frame (when (number? prior) (placed-frame clip sid n prior))) - (dec frame))))) + (dec frame)) + @active + (when (and context? (:palette n)) + (selection-at n frame nil))))) [])) (when-let [op (get by-id id)] [op])))) ids))))] (reify IFn - (-invoke [_ f] (step f (dec f))) - (-invoke [_ f pre] (step f pre)) + (-invoke [_ f] (step f (dec f) nil nil)) + (-invoke [_ f pre] (step f pre nil nil)) + (-invoke [_ f pre inherited forced] (step f pre inherited forced)) symbol/IResolver (world-of [_ [id & more]] (if more @@ -345,11 +367,13 @@ ;; the WHOLE PICTURE reading 13 instead of 15 — a head going two frames ;; stale, a 67ms hitch at 12fps, to fix one group's mouth. It is per ;; group, so it is seated where groups exist. - (if (pos? f) (cadence/frame (dec f) grid native) -1))) + (if (pos? f) (cadence/frame (dec f) grid native) -1) + (when context? (:default palette)) + nil)) symbol/IResolver (world-of [_ path] (symbol/world-of r path)) (frame-of [_ path] (symbol/frame-of r path)) - (pre-frame-of [_ path] (symbol/pre-frame-of r path)))))) + (pre-frame-of [_ path] (symbol/pre-frame-of r path))))))) (defn center "The middle of everything symbol `sid` draws, over all its frames, in its own @@ -499,6 +523,14 @@ (str "clip has a field with no leaf to save it in: " (pr-str k))) (when-not (map? (:symbols clip)) [":symbols must be a map of id -> symbol"]) + (when (and (contains? clip :palettes) (not (map? (:palettes clip)))) + [":palettes must be a map of id -> palette"]) + (when (and (contains? clip :default-palette) (map? (:palettes clip)) + (not (contains? (:palettes clip) (:default-palette clip)))) + [":default-palette must name a project palette"]) + (for [[id p] (:palettes clip) + :when (or (not= id (:id p)) (not (pal/valid-palette? p)))] + (str "palette " (pr-str id) " is invalid or has a different :id")) (when-not (or (nil? (:fps clip)) (and (number? (:fps clip)) (pos? (:fps clip)))) [(str ":fps is " (pr-str (:fps clip)) " — a rate is a positive number")]) (for [[id sym] (:symbols clip) diff --git a/frontend/src/arthur/domain/leaf.cljs b/frontend/src/arthur/domain/leaf.cljs index 8fe84f1..49f0f7b 100644 --- a/frontend/src/arthur/domain/leaf.cljs +++ b/frontend/src/arthur/domain/leaf.cljs @@ -10,6 +10,8 @@ clip//name a label clip//timing fps clip//stage width, height + clip//palette/ a named indexed palette asset + clip//palette-default the project fallback palette id clip//source the analysis record this came out of clip//subject/ a tracked subject and its params clip//feature/ one feature: area, nodes, params @@ -134,11 +136,13 @@ (some-leaf (at "name") (select-keys clip [:name])) (some-leaf (at "timing") (select-keys clip [:fps])) (some-leaf (at "stage") (select-keys clip [:width :height])) + (some-leaf (at "palette-default") (select-keys clip [:default-palette])) (some-leaf (at "source") (:analysis clip)) (concat (for [[id v] (:subjects clip)] {(at "subject" (segment id)) v}) (for [[id v] (:features clip)] {(at "feature" (segment id)) v}) (for [[id v] (:groups clip)] {(at "group" (segment id)) v}) + (for [[id v] (:palettes clip)] {(at "palette" (segment id)) v}) ;; The symbol's own facts. `:id` is the path segment, so writing it ;; into the value as well would be the one field a rename could ;; disagree with itself about; `clip` puts it back. @@ -190,6 +194,8 @@ "timing" (merge acc v) "stage" (merge acc v) "source" (assoc acc :analysis v) + "palette-default" (merge acc v) + "palette" (assoc-in acc [:palettes (unsegment a)] v) "subject" (assoc-in acc [:subjects (unsegment a)] v) "feature" (assoc-in acc [:features (unsegment a)] v) "group" (assoc-in acc [:groups (unsegment a)] v) @@ -230,8 +236,8 @@ false) (case (count p) ;; The clip's own facts carry no id. - 3 (#{"name" "timing" "stage" "source"} (nth p 2)) - 4 (#{"subject" "feature" "group"} (nth p 2)) + 3 (#{"name" "timing" "stage" "source" "palette-default"} (nth p 2)) + 4 (#{"subject" "feature" "group" "palette"} (nth p 2)) false))))] (vec (concat diff --git a/frontend/src/arthur/domain/palette.cljs b/frontend/src/arthur/domain/palette.cljs index 101496e..d6cdbf4 100644 --- a/frontend/src/arthur/domain/palette.cljs +++ b/frontend/src/arthur/domain/palette.cljs @@ -1,15 +1,12 @@ (ns arthur.domain.palette - "The indexed palette. + "Project palette assets and their render-time index banks. - THE RULE, and it is a rule rather than a default: a part carries a palette - INDEX, never a sampled RGB value. Sampling colour off the footage produces a - pixel-art filter, and it does so irrecoverably — once a shape holds a measured - colour there is no way back to an authored one, because the information that it - was ever a choice is gone. Every `[:style :color]` channel holds one of the - keywords below. + Drawing data stores a dumb LOCAL SLOT NUMBER. A symbol or instance supplies + the palette context. `compile` gives project palettes disjoint ranges in the + raster index space, so differently-paletted subtrees can coexist. The ranges + are derived, never persisted: adding a palette never rewrites drawing data.") - Entries are ordered, and the order IS the index the raster writes. Inserting in - the middle renumbers every stored index, so new tones append.") +(def default-id :arthur/default) (def entries [{:name :bg :hex "#12141c"} @@ -48,3 +45,68 @@ (def rgb "Index -> [r g b], precomputed." (mapv hex->rgb hexes)) + +(def default-palette + {:id default-id :name "Arthur" + :slots (into entries (repeat 7 {:hex "#000000"}))}) + +(defn palettes [clip] + (if (seq (:palettes clip)) (:palettes clip) {default-id default-palette})) + +(defn default-palette-id [clip] + (let [ps (palettes clip)] + (or (:default-palette clip) + (when (contains? ps default-id) default-id) + (first (sort-by str (keys ps)))))) + +(defn- slot-index [p value] + (cond + (and (integer? value) (<= 0 value) (< value (count (:slots p)))) value + ;; Compatibility for existing documents. New drawing data is numeric. + (keyword? value) (first (keep-indexed #(when (= value (:name %2)) %1) (:slots p))) + :else nil)) + +(defn compile + "Compile the project's palette assets into the one ramp used by the raster. + Index 255 remains the conspicuous bad-data sentinel." + [clip] + (let [selection-values (fn [x] + (cond + (nil? x) [] + (and (map? x) (:keys x)) (vals (:keys x)) + (and (map? x) (contains? x :value)) [(:value x)] + :else [x])) + used (into #{(default-palette-id clip)} + (mapcat selection-values) + (concat (map :palette (vals (:symbols clip))) + (for [sym (vals (:symbols clip)) + n (vals (:nodes sym))] + (:palette n)))) + ps (select-keys (palettes clip) used) + ordered (sort-by (comp str key) ps) + offsets (loop [xs ordered at 0 out {}] + (if-let [[id p] (first xs)] + (recur (next xs) (+ at (count (:slots p))) (assoc out id at)) + out)) + total (reduce + (map #(count (:slots (val %))) ordered))] + (when (> total 255) + (throw (ex-info "palettes visible in one render use more than 255 slots" + {:slots total :palettes (count ps)}))) + {:palettes ps + :default (default-palette-id clip) + :offsets offsets + :ramp (vec (mapcat (fn [[_ p]] (map #(hex->rgb (:hex %)) (:slots p))) ordered)) + :bg (get offsets (default-palette-id clip) 0)})) + +(defn render-index + "A local slot (or a legacy tone keyword) in palette `id` -> raster index." + [{:keys [palettes offsets]} id value] + (let [p (get palettes id) + i (and p (slot-index p value))] + (if (some? i) (+ (get offsets id 0) i) 255))) + +(defn valid-palette? [{:keys [id name slots]}] + (and id (string? name) (seq name) (vector? slots) (pos? (count slots)) + (<= (count slots) 255) + (every? #(and (string? (:hex %)) + (boolean (re-matches #"#[0-9a-fA-F]{6}" (:hex %)))) slots))) diff --git a/frontend/src/arthur/domain/symbol.cljs b/frontend/src/arthur/domain/symbol.cljs index d0c1a31..bc52961 100644 --- a/frontend/src/arthur/domain/symbol.cljs +++ b/frontend/src/arthur/domain/symbol.cljs @@ -275,6 +275,7 @@ be impossible to miss and should not take the frame down." [palette k] (cond + (fn? palette) (palette k) (number? k) k (nil? k) 255 :else (get palette k 255))) diff --git a/frontend/src/arthur/events/export.cljs b/frontend/src/arthur/events/export.cljs index 92be1a3..34ac377 100644 --- a/frontend/src/arthur/events/export.cljs +++ b/frontend/src/arthur/events/export.cljs @@ -153,9 +153,8 @@ ;; The same palette and ramp the preview resolves and blits ;; through. Read here rather than in the fx so that the effect ;; takes data and nothing else. - :palette (get {:arthur/default pal/index-of} - (:palette db) pal/index-of) - :ramp (get {:arthur/default pal/rgb} (:palette db) pal/rgb) + :palette (pal/compile (:clip entry)) + :ramp (:ramp (pal/compile (:clip entry))) :zoom zoom :audio-url (:audio entry) :name (stem (:label entry) diff --git a/frontend/src/arthur/events/project.cljs b/frontend/src/arthur/events/project.cljs index e1089d6..1276f2b 100644 --- a/frontend/src/arthur/events/project.cljs +++ b/frontend/src/arthur/events/project.cljs @@ -23,10 +23,12 @@ fx, which is the only thing in this namespace that is not pure." (:require [arthur.db :as db] [arthur.domain.bring :as bring] + [arthur.domain.channel :as ch] [arthur.domain.clip :as clip] [arthur.domain.span :as span] [arthur.domain.leaf :as leaf] [arthur.domain.node :as node] + [arthur.domain.palette :as pal] [arthur.events.edit :as edit] [arthur.audio.mix :as mix] [arthur.demo.stage :as stage] @@ -165,6 +167,34 @@ :host (get-in db [:ui :open]) :frame frame :point point :target target)})) +(rf/reg-event-fx + ::import-palette + (fn [{:keys [db]} [_ {:keys [project cid palette name]}]] + {:db (update db :project merge {:status (str "fetching " name "…")}) + ::import-palette! {:project project :cid cid :palette palette}})) + +(rf/reg-fx + ::import-palette! + (fn [{:keys [project cid palette]}] + (-> (saved-clip! project cid) + (.then (fn [{other :clip}] + (let [source (leaf/unsegment palette) + p (get-in other [:palettes source])] + (if p + (rf/dispatch [::palette-imported p]) + (rf/dispatch [::failed "that palette no longer exists"]))))) + (.catch (fn [error] + (rf/dispatch [::failed (or (ex-message error) (str error))])))))) + +(rf/reg-event-db + ::palette-imported + (fn [db [_ palette]] + (let [id (random-uuid)] + (-> (edit/edit db #(assoc-in % [:palettes id] + (assoc palette :id id :name (str (:name palette) " copy")))) + (assoc-in [:ui :palette] id) + (assoc-in [:project :status] (str "imported " (:name palette))))))) + (rf/reg-event-fx ::imported ;; As drawing: its tracking stays with the analysis that measured it. See @@ -296,7 +326,11 @@ {:project (.-project r) :project-name (.-project_name r) :cid (.-cid r) :symbol (.-symbol r) :name (.-name r) :frames (.-frames r)}) - (array-seq (.-symbols listed)))]))) + (array-seq (.-symbols listed))) + (mapv (fn [^js r] + {:project (.-project r) :project-name (.-project_name r) + :cid (.-cid r) :palette (.-palette r) :name (.-name r)}) + (array-seq (.-palettes listed)))]))) (.catch (fn [error] (rf/dispatch [::failed (or (ex-message error) (str error))])))))) @@ -308,7 +342,8 @@ (rf/reg-event-db ::symbols-listed - (fn [db [_ rows]] (assoc db :assets {:symbols rows :loading? false}))) + (fn [db [_ rows palettes]] + (assoc db :assets {:symbols rows :palettes palettes :loading? false}))) (rf/reg-sub ::assets (fn [db _] (:assets db))) @@ -649,6 +684,70 @@ (update-in c [:symbols sid] dissoc key) (assoc-in c [:symbols sid key] value))))))) +(rf/reg-event-db + ::new-palette + (fn [db _] + (let [id (random-uuid) + p {:id id :name "Untitled palette" + :slots (mapv #(select-keys % [:name :hex]) (:slots pal/default-palette))}] + (-> (edit/edit db #(assoc-in % [:palettes id] p)) + (assoc-in [:ui :palette] id))))) + +(rf/reg-event-db + ::palette-name + (fn [db [_ id value]] + (let [value (str/trim (str value))] + (if (str/blank? value) db + (edit/edit db #(assoc-in % [:palettes id :name] value)))))) + +(rf/reg-event-db + ::palette-color + (fn [db [_ id slot hex]] + (if-not (re-matches #"#[0-9a-fA-F]{6}" (str hex)) + db + (edit/edit db #(assoc-in % [:palettes id :slots slot :hex] (str/lower-case hex)))))) + +(rf/reg-event-db + ::default-palette + (fn [db [_ id]] + (edit/edit db #(if (get-in % [:palettes id]) (assoc % :default-palette id) %)))) + +(rf/reg-event-db + ::symbol-palette + (fn [db [_ sid id frame]] + (edit/edit db #(if id + (let [old (get-in % [:symbols sid :palette])] + (assoc-in % [:symbols sid :palette] + (if (:keys old) + (assoc-in old [:keys frame] id) + (ch/framed id)))) + (update-in % [:symbols sid] dissoc :palette))))) + +(rf/reg-event-db + ::key-symbol-palette + (fn [db [_ sid frame id]] + (edit/edit db + (fn [c] + (let [old (get-in c [:symbols sid :palette]) + base (or (when old (ch/value-at old frame nil)) + (pal/default-palette-id c)) + keyed (if (:keys old) old (ch/keyed {0 base} :hold))] + (assoc-in c [:symbols sid :palette] + (assoc-in keyed [:keys frame] id))))))) + +(rf/reg-event-db + ::instance-palette + (fn [db [_ sid node-id frame id]] + (edit/edit db + (fn [c] + (if-not id + (update-in c [:symbols sid :nodes node-id] dissoc :palette) + (let [old (get-in c [:symbols sid :nodes node-id :palette])] + (assoc-in c [:symbols sid :nodes node-id :palette] + (if (:keys old) + (assoc-in old [:keys frame] id) + (ch/framed id))))))))) + (rf/reg-event-db ::set-channel ;; `frame` is the node's own, as for a drawing key. diff --git a/frontend/src/arthur/flow/freeze.cljs b/frontend/src/arthur/flow/freeze.cljs index 9efccf2..c83efa5 100644 --- a/frontend/src/arthur/flow/freeze.cljs +++ b/frontend/src/arthur/flow/freeze.cljs @@ -38,6 +38,7 @@ [arthur.domain.geom :as geom] [arthur.domain.node :as node] [arthur.domain.pick :as pick] + [arthur.domain.palette :as pal] [arthur.domain.ring :as ring] [arthur.domain.trace :as trace] [arthur.flow.address :as address])) @@ -464,12 +465,12 @@ {:nodes {:mouth {:id :mouth :name "mouth" :kind :poly :parent :head :z "a1" :channels {[:geom :pts] (dense rings 0 (prov :roto/lips-outer)) - [:style :color] (ch/framed :skin-dark)}} + [:style :color] (ch/framed 2)}} :mouth-in {:id :mouth-in :name "mouth interior" :kind :poly :parent :mouth :z "a2" :channels {[:geom :pts] (dense rings 1 (prov :roto/lips-inner)) - [:style :color] (ch/framed :mouth-dark) + [:style :color] (ch/framed 3) [:vis] (visibility params inputs {:by :roto/mouth-aperture :analysis (:id analysis) @@ -523,13 +524,13 @@ {:id id :name (clojure.core/name id) :kind :poly :parent :head :z z :channels {[:geom :pts] (dense eye-block track (provenance :roto/eyelid {:verts eye-verts})) - [:style :color] (ch/framed :skin-dark)}}) + [:style :color] (ch/framed 2)}}) inner-node (fn [id parent z track shut] {:id id :name (clojure.core/name id) :kind :poly :parent parent :z z :channels {[:geom :pts] (dense eye-block track (provenance :roto/eye-opening {:verts eye-verts})) - [:style :color] (ch/framed :eye-white) + [:style :color] (ch/framed 5) [:vis] (keyed-visibility (mapv not shut) (provenance :roto/blink nil))}}) iris-node (fn [id parent track radius] @@ -541,7 +542,7 @@ :generated (provenance :roto/iris-size {:iris-size (:iris-size params)})) - [:style :color] (ch/framed :iris)}}) + [:style :color] (ch/framed 6)}}) pupil-node (fn [id parent] {:id id :name (clojure.core/name id) :kind :rect :parent parent :z "a1" :stencil parent @@ -549,14 +550,14 @@ :generated (provenance :roto/pupil-size {:pupil-size (:pupil-size params)})) - [:style :color] (ch/framed :pupil)}}) + [:style :color] (ch/framed 7)}}) brow-node (fn [id z track] {:id id :name (clojure.core/name id) :kind :poly :parent :head :z z :channels {[:geom :pts] (dense brow-block track (provenance :roto/brow {:verts brow-verts})) [:xform :pos] (dense brow-pos-block track (provenance :roto/brow-raise nil)) - [:style :color] (ch/framed :brow)}})] + [:style :color] (ch/framed 8)}})] {:nodes (merge (when eyes {:eye-r (eye-node :eye-r "a2" 0) @@ -604,7 +605,7 @@ :parent :mouth-in :z "a1" :stencil :mouth-in :channels {[:geom :pts] (dense blk 0 generated) - [:style :color] (ch/framed :teeth) + [:style :color] (ch/framed 4) [:vis] (keyed-visibility shown generated)}}} :store (stored blk)})) @@ -763,6 +764,8 @@ merged (fn [k] (into {} (mapcat (comp k second)) parts)) built {:name name :fps fps :analysis (:analysis params) :width (first stage) :height (second stage) + :palettes {pal/default-id pal/default-palette} + :default-palette pal/default-id :subjects (into {} (map (fn [[id _]] [id {:id id :params {}}])) ordered) :features (merged :features) :groups (merged :groups) :symbols diff --git a/frontend/src/arthur/subs/render.cljs b/frontend/src/arthur/subs/render.cljs index b4df292..ccacf91 100644 --- a/frontend/src/arthur/subs/render.cljs +++ b/frontend/src/arthur/subs/render.cljs @@ -118,21 +118,13 @@ (rf/reg-sub ::palette - (fn [db _] - ;; A NAME resolves to a ramp. One today; when timelines carry a `:palette` - ;; channel this becomes the project's table and the walk carries the ramp in - ;; scope, which is why domain/symbol takes the palette as a parameter rather - ;; than reaching for a global. - (get {:arthur/default pal/index-of} (:palette db) pal/index-of))) + :<- [::clip] + (fn [clip _] (when clip (pal/compile clip)))) (rf/reg-sub ::ramp - (fn [db _] - ;; index -> [r g b]. The other half of the palette: `::palette` says which - ;; INDEX a tone resolves to, this says what that index LOOKS LIKE. Two subs - ;; because two different consumers — evaluation needs the first, the blit - ;; needs the second, and neither wants the other's map. - (get {:arthur/default pal/rgb} (:palette db) pal/rgb))) + :<- [::palette] + (fn [compiled _] (:ramp compiled))) (rf/reg-sub ::store diff --git a/frontend/src/arthur/subs/ui.cljs b/frontend/src/arthur/subs/ui.cljs index 65fd08c..21e7fcd 100644 --- a/frontend/src/arthur/subs/ui.cljs +++ b/frontend/src/arthur/subs/ui.cljs @@ -12,6 +12,17 @@ [re-frame.core :as rf])) (rf/reg-sub ::selection (fn [db _] (get-in db [:ui :selection]))) +(rf/reg-sub + ::selections + (fn [db _] + (let [primary (get-in db [:ui :selection]) + many (vec (get-in db [:ui :selections]))] + ;; Older structural commands replace `:selection` directly. Treat that as + ;; an intentional single selection unless it is still the primary member + ;; of the multi-selection. + (cond (nil? primary) [] + (some #{primary} many) many + :else [primary])))) (rf/reg-sub ::target (fn [db _] (get-in db [:ui :target]))) (rf/reg-sub ::retry (fn [db _] (get-in db [:ui :retry]))) (rf/reg-sub ::tone (fn [db _] (get-in db [:ui :tone]))) @@ -100,6 +111,23 @@ (when-let [pl (nest/placement clip st open (or path [id]) f)] (assoc pl :node n :bounds ((pick/bounds-of clip st (:sid pl) n) (:frame pl)))))))) +(rf/reg-sub + ::selected-placements + :<- [::selections] + :<- [::render/clip] + :<- [::render/clip-id] + :<- [::render/open] + :<- [::render/open-frame] + (fn [[selections clip clip-id open f] _] + (let [st (:store (store/entry clip-id))] + (into [] (keep (fn [[_ _ _ path :as selection]] + (when (and clip (= :node (first selection)) (seq path)) + (when-let [{:keys [sid id] :as pl} (nest/placement clip st open path f)] + (when-let [n (get-in clip [:symbols sid :nodes id])] + (assoc pl :selection selection :path path :node n + :bounds ((pick/bounds-of clip st sid n) (:frame pl)))))))) + selections)))) + (rf/reg-sub ::settled-clip :<- [::render/clip-id] diff --git a/frontend/src/arthur/ui/palette.cljs b/frontend/src/arthur/ui/palette.cljs index 2a333d1..cf12058 100644 --- a/frontend/src/arthur/ui/palette.cljs +++ b/frontend/src/arthur/ui/palette.cljs @@ -2,52 +2,73 @@ "The bar above the stage: the tone a new shape gets, and the tool that makes one. - SIXTEEN SLOTS, and the palette supplies nine of them. The count is the format's - and not the data's — an indexed 320x200 picture in the Animator Pro idiom this - tool inherits has a fixed-size table, and a strip that grew and shrank as tones - were added would make the palette look like a list of colours rather than like - a table with room in it. So the empty slots are drawn, hatched, and refuse the - click. - - Slot 0 is the background, which is why it is shown and not selectable: a - polygon filled with index 0 is invisible against a stage cleared to index 0, so - offering it as a fill is offering a shape that vanishes on creation. + Shapes store only the selected local slot number. Palette identity is supplied + by the symbol tree, and the colour input edits the project palette asset. The footage switch is NOT here. It is a viewing aid rather than something you set before you draw, so it is a section of the inspector — one that is there for whatever the open symbol has faces of, so it still does not come and go with the selection. See `ui/params`." (:require [arthur.domain.palette :as pal] + [arthur.domain.node :as node] [arthur.events.ui :as ui] + [arthur.events.project :as project] + [arthur.subs.render :as render] [arthur.subs.ui :as sub] [arthur.ui.layout :as layout] [re-frame.core :as rf])) -(def ^:const slots 16) +(rf/reg-sub ::chosen (fn [db _] (get-in db [:ui :palette]))) -(defn- swatch [i tone] - (let [{slot-tone :name :keys [hex]} (get pal/entries i) - bg? (zero? i) - pick (and slot-tone (not bg?))] - [:button - {:key i - :class (str "swatch" - (when-not slot-tone " empty") - (when bg? " bg") - (when (and pick (= slot-tone tone)) " on")) - :style (when hex {:background hex}) - :title (if slot-tone (str i " · " (name slot-tone) " " hex) (str i " · empty")) - :disabled (not pick) - :on-click #(rf/dispatch [::ui/set-tone slot-tone])}])) +(defn- swatch [pid i {:keys [name hex]} tone placements] + (let [picker-id (str "palette-picker-" pid "-" i)] + [:div {:key i :class "palette-slot"} + [:button {:class (str "swatch" (when (= i tone) " on")) + :style {:background hex} + :title (str i (when name (str " · " (clojure.core/name name))) + " · " hex " · double-click to edit") + :on-click #(do (rf/dispatch [::ui/set-tone i]) + (let [edits (into [] (keep (fn [{:keys [sid id node frame]}] + (when (contains? (get node/valid-paths (:kind node)) + [:style :color]) + {:sid sid :id id :path [:style :color] + :frame frame :value i}))) + placements)] + (when (seq edits) + (rf/dispatch [::project/set-channels edits])))) + :on-double-click (fn [e] + (.preventDefault e) + (some-> (js/document.getElementById picker-id) (.click)))}] + [:input {:id picker-id :class "palette-picker" :type "color" :value hex + :aria-label (str "edit palette slot " i) + :on-change #(rf/dispatch [::project/palette-color pid i (.. % -target -value)])}]])) (defn bar [] (let [tone @(rf/subscribe [::sub/tone]) + clip @(rf/subscribe [::render/clip]) + chosen @(rf/subscribe [::chosen]) + pid (if (contains? (:palettes clip) chosen) chosen (pal/default-palette-id clip)) + palette (get (pal/palettes clip) pid) + placements @(rf/subscribe [::sub/selected-placements]) + selections @(rf/subscribe [::sub/selections]) tool @(rf/subscribe [::sub/tool]) auto? @(rf/subscribe [::sub/auto-key?]) draft @(rf/subscribe [::sub/draft])] [:div.palette-bar - [:div.swatches (doall (map #(swatch % tone) (range slots)))] - [:span.dim (name tone)] + [:select {:value (str pid) + :title "palette asset" + :on-change (fn [e] + (let [v (.. e -target -value) + id (first (filter #(= v (str %)) (keys (pal/palettes clip))))] + (rf/dispatch [::ui/set-tone 0]) + (rf/dispatch [:arthur.ui.palette/select id])))} + (for [[id p] (sort-by (comp str :name val) (pal/palettes clip))] + ^{:key (str id)} [:option {:value (str id)} (:name p)])] + [:button {:title "new 16-slot palette" :on-click #(rf/dispatch [::project/new-palette])} "+"] + [:div.swatches (doall (map-indexed #(swatch pid %1 %2 tone placements) (:slots palette)))] + [:span.dim (str tone)] + (when (> (count selections) 1) + [:span.dim (str (count selections) " selected")]) [:span {:style {:flex 1}}] [:button.auto-key {:class (when auto? "on") :aria-pressed auto? @@ -62,8 +83,12 @@ [:button {:disabled (< (count draft) 6) :on-click #(rf/dispatch [::ui/finish-polygon])} "finish"] [:button {:on-click #(rf/dispatch [::ui/cancel-polygon])} "cancel"]] - [:button {:on-click #(rf/dispatch [::ui/begin-polygon])} "polygon"]) + [:button {:title "pen tool — click points on the stage" + :on-click #(rf/dispatch [::ui/begin-polygon])} "pen"]) ;; The stage's zoom, at the right end of the bar above the stage: it is a ;; property of the view and not of the document, so it sits in the view's ;; own chrome rather than in the inspector. [layout/zoomer :stage "the stage"]])) + +(rf/reg-event-db :arthur.ui.palette/select + (fn [db [_ id]] (assoc-in db [:ui :palette] id))) diff --git a/frontend/src/arthur/ui/params.cljs b/frontend/src/arthur/ui/params.cljs index 3432be1..3ca75a4 100644 --- a/frontend/src/arthur/ui/params.cljs +++ b/frontend/src/arthur/ui/params.cljs @@ -11,6 +11,7 @@ [arthur.domain.channel :as channel] [arthur.domain.feature :as feature] [arthur.domain.node :as node] + [arthur.domain.palette :as pal] [arthur.domain.paint :as paint] [arthur.domain.params :as params] [arthur.domain.pose :as pose] @@ -201,7 +202,10 @@ (defn- node-section [[sid id n]] (let [[start end] (:span n) - auto-key? @(rf/subscribe [::sub/auto-key?])] + auto-key? @(rf/subscribe [::sub/auto-key?]) + clip @(rf/subscribe [::render/clip]) + local @(rf/subscribe [::sub/selected-local]) + frame (:frame local)] [section (str (name (:kind n)) " · in " (name sid)) [facts "name" (or (:name n) (brief id)) @@ -214,8 +218,18 @@ "span" (when start (str start " … " end)) "at" (when (node/mapped-time? n) (str (get-in n [:time :at] 0)))] (when (:paint? n) [drawing-keys sid id n @(rf/subscribe [::sub/selected-local])]) + (when (= :instance (:kind n)) + [:label.inspector-field "palette override" + [:select {:value (str (or (some-> (:palette n) (channel/value-at frame nil)) "")) + :on-change (fn [e] + (let [v (.. e -target -value) + pid (first (filter #(= v (str %)) (keys (pal/palettes clip))))] + (rf/dispatch [::project/instance-palette sid id frame pid])))} + [:option {:value ""} "inherit"] + (for [[pid p] (sort-by (comp str :name val) (pal/palettes clip))] + ^{:key (str pid)} [:option {:value (str pid)} (:name p)])]]) [:div.row {:style {:margin-top "6px"}} [:span.dim "channels"]] - (let [{:keys [frame]} @(rf/subscribe [::sub/selected-local])] + (let [{:keys [frame]} local] [:dl.facts (doall (for [[path ch] (sort-by (comp str key) (node/channels n))] @@ -527,6 +541,9 @@ (defn- symbol-section [sid] (let [clip @(rf/subscribe [::render/clip]) sym (get-in clip [:symbols sid]) + frame @(rf/subscribe [::render/open-frame]) + palette-value (or (some-> (:palette sym) (channel/value-at frame nil)) + (pal/default-palette-id clip)) busy? (:busy? @(rf/subscribe [::playback/project]))] [section "symbol" [facts @@ -546,6 +563,23 @@ #(rf/dispatch [::project/symbol-setting sid :width %]) "project default" busy?] [number-field "height" (:height sym) #(rf/dispatch [::project/symbol-setting sid :height %]) "project default" busy?] + [:label.inspector-field "palette" + [:select {:value (str palette-value) :disabled busy? + :on-change (fn [e] + (let [v (.. e -target -value) + id (first (filter #(= v (str %)) (keys (pal/palettes clip))))] + (rf/dispatch [::project/symbol-palette sid id frame])))} + [:option {:value ""} "inherit"] + (for [[id p] (sort-by (comp str :name val) (pal/palettes clip))] + ^{:key (str id)} [:option {:value (str id)} (:name p)])]] + [:div.row + [:button {:disabled busy? + :title "hold this palette from this frame" + :on-click #(rf/dispatch [::project/key-symbol-palette sid frame palette-value])} + "◆ key palette"] + [:button {:disabled (or busy? (nil? (:palette sym))) + :on-click #(rf/dispatch [::project/symbol-palette sid nil])} + "inherit"]] (when (or (:width sym) (:height sym)) [:div.row [:button {:disabled busy? :on-click #(do diff --git a/frontend/src/arthur/ui/pool.cljs b/frontend/src/arthur/ui/pool.cljs index ed1828b..aeea14e 100644 --- a/frontend/src/arthur/ui/pool.cljs +++ b/frontend/src/arthur/ui/pool.cljs @@ -45,6 +45,7 @@ footage stay separate records on the server, so dropping the same file twice does not decode it twice." (:require [arthur.domain.clip :as clip] + [arthur.domain.palette :as pal] [arthur.domain.raster :as raster] [arthur.events.footage :as footage] [arthur.events.playback :as pb] @@ -269,6 +270,23 @@ (carrying (str "symbol:" (subs (str sid) 1)) #(drag/symbol! clip-id sid open)))])) +(defn- palette-row [id p default-id chosen rename] + ^{:key (str id)} + [row {:label (:name p) + :sub (str (count (:slots p)) " colors") + :title (str (:name p) " · " (count (:slots p)) " indexed colors") + :thumb [:span.thumb {:style {:display "grid" + :grid-template-columns "repeat(4,1fr)"}} + (for [[i s] (map-indexed vector (take 16 (:slots p)))] + ^{:key i} [:i {:style {:background (:hex s)}}])] + :on? (= id chosen) + :rename (assoc rename :key [:palette id] :value (:name p) + :commit! (fn [value] + ((:begin! rename) nil) + (rf/dispatch [::project/palette-name id value]))) + :on-click #(rf/dispatch [:arthur.ui.palette/select id]) + :on-double-click #(rf/dispatch [::project/default-palette id])}]) + (defn- footage-row [{:keys [id label frames fps video] :as f} chosen rename] ^{:key id} [row (merge {:label label @@ -327,6 +345,13 @@ #(drag/other! {:kind :import :label name :frames frames :project pid :cid cid :symbol symbol})))]) +(defn- import-palette-row [{:keys [project palette name] :as asset}] + ^{:key (str project palette)} + [row {:label name :sub "palette" + :title (str name " — click to copy this palette into the project") + :thumb [picture nil] + :on-click #(rf/dispatch [::project/import-palette asset])}]) + ;; --------------------------------------------------------------------------- ;; sections @@ -375,21 +400,28 @@ Still not `:main` being special. The document says which symbol that is by its structure; rename it, place it inside something else, and the pool follows." - [{:keys [document query searching? media sounds chosen rename main] :as ctx}] + [{:keys [document query searching? media sounds chosen rename main palette-choice] :as ctx}] (let [named? #(hit? query (clip/symbol-name document %)) top (when (and main (named? main)) main) rest (filterv #(and (named? %) (not= main %)) (sort-by str (keys (:symbols document)))) media (filterv #(hit? query (:label %)) media) - sounds (filterv #(hit? query (:label %)) sounds)] + sounds (filterv #(hit? query (:label %)) sounds) + palettes (filterv #(hit? query (:name (val %))) + (sort-by (comp str :name val) (pal/palettes document)))] [sections searching? - (+ (if top 1 0) (count rest) (count media) (count sounds)) + (+ (if top 1 0) (count rest) (count media) (count sounds) (count palettes)) [{:title "project" :searching? searching? :blank "nothing to open yet" :rows (when top [(symbol-row document top ctx)])} {:title "symbols" :searching? searching? :blank "nothing else in the library" :rows (mapv #(symbol-row document % ctx) rest)} + {:title "palettes" :searching? searching? + :blank "no palettes" + :rows (mapv (fn [[id p]] (palette-row id p (:default-palette document) + (or palette-choice (pal/default-palette-id document)) + rename)) palettes)} {:title "media" :searching? searching? :blank "drop a video here" :rows (mapv #(footage-row % chosen rename) media)} @@ -401,21 +433,25 @@ "Everything the server holds. Other projects' symbols stay grouped by project and closed: a server holds many, and a wall of every symbol in every one buries the one you want." - [{:keys [document query searching? rename chosen available all-sounds symbols + [{:keys [document query searching? rename chosen available all-sounds symbols palettes project-id]}] (let [media (filterv #(hit? query (:label %)) available) sounds (filterv #(hit? query (:label %)) all-sounds) others (filterv #(and (not= project-id (:project %)) (hit? query (:name %))) symbols) - grouped (sort-by (comp str second key) (group-by (juxt :project :project-name) others))] + grouped (sort-by (comp str second key) (group-by (juxt :project :project-name) others)) + palettes (filterv #(and (not= project-id (:project %)) (hit? query (:name %))) palettes)] [sections searching? - (+ (count media) (count sounds) (count others)) + (+ (count media) (count sounds) (count others) (count palettes)) [{:title "media" :searching? searching? :blank "nothing uploaded yet" :rows (mapv #(footage-row % chosen rename) media)} {:title "sounds" :searching? searching? :blank "no sounds uploaded yet" :rows (mapv #(sound-row % (:fps document) rename) sounds)} + {:title "palettes" :searching? searching? + :blank "no palettes in other saved projects" + :rows (mapv import-palette-row palettes)} {:title "symbols" :searching? searching? :blank "no other saved projects" :rows (for [[[pid pname] rows] grouped] @@ -437,13 +473,15 @@ one cost of collapsing two folders into two tabs — that a hit could be behind the tab you did not pick — is paid off by a number, counted over the same labels the rows are filtered by." - [{:keys [document query media sounds available all-sounds symbols project-id]}] + [{:keys [document query media sounds available all-sounds symbols palettes project-id]}] (let [n (fn [labels] (count (filter #(hit? query %) labels)))] {:project (+ (n (map #(clip/symbol-name document %) (keys (:symbols document)))) + (n (map :name (vals (pal/palettes document)))) (n (map :label media)) (n (map :label sounds))) :assets (+ (n (map :label available)) (n (map :label all-sounds)) + (n (map :name (remove #(= project-id (:project %)) palettes))) (n (map :name (remove #(= project-id (:project %)) symbols))))})) (defn view [] @@ -465,9 +503,10 @@ palette @(rf/subscribe [::render/palette]) ramp @(rf/subscribe [::render/ramp]) selection @(rf/subscribe [::sub/selection]) + palette-choice @(rf/subscribe [:arthur.ui.palette/chosen]) open @(rf/subscribe [::render/open]) media @(rf/subscribe [::sub/project-footage]) - {:keys [symbols]} @(rf/subscribe [::project/assets]) + {:keys [symbols palettes]} @(rf/subscribe [::project/assets]) {project-id :id} @(rf/subscribe [::playback/project]) ;; The project's videos' sounds first, then its uploaded ones. own-sounds (into (mapv (fn [{:keys [id label frames fps]}] @@ -481,7 +520,8 @@ :ramp ramp :selection selection :open open :media media :sounds own-sounds :chosen chosen :available (vec available) :all-sounds (vec sounds) - :symbols symbols :project-id project-id + :symbols symbols :palettes palettes :project-id project-id + :palette-choice palette-choice :query needle :searching? searching? ;; `clip/opens-on` and not `:main`: the longest symbol nothing ;; else places is the timeline the work happens in, and it is the diff --git a/frontend/test/arthur/domain/instance_test.cljs b/frontend/test/arthur/domain/instance_test.cljs index 80c5a29..d8b0ce3 100644 --- a/frontend/test/arthur/domain/instance_test.cljs +++ b/frontend/test/arthur/domain/instance_test.cljs @@ -288,3 +288,33 @@ (is (= [55 35] (clip/center grown nil :box)) "the symbol's middle moved") (is (= [25 35] (get-in grown [:symbols :main :nodes u :channels [:xform :anchor] :value])) "the instance's did not"))))) + +(deftest palette-context-is-inherited-keyed-and-overridable + (let [palette (fn [id name a b] + {:id id :name name :slots [{:hex a} {:hex b}]}) + mark {:id :mark :kind :rect :z "a1" + :channels {[:geom :size] (ch/framed 2) + [:style :color] (ch/framed 1)}} + instance (fn [id child z] + {:id id :kind :instance :z z :source {:symbol child}}) + document {:fps 30 :width 20 :height 20 + :palettes {:day (palette :day "Day" "#000000" "#112233") + :flash (palette :flash "Flash" "#ffffff" "#aabbcc")} + :default-palette :day + :symbols + {:main {:id :main :frames 4 + :palette (ch/keyed {0 :day 2 :flash} :hold) + :nodes {:inherited (instance :inherited :drawing "a1") + :fixed (assoc (instance :fixed :fixed "a2") + :palette (ch/framed :day))}} + :drawing {:id :drawing :frames 4 :nodes {:mark mark}} + :fixed {:id :fixed :frames 4 :palette (ch/framed :flash) + :nodes {:mark mark}}}} + context (pal/compile document) + resolve (clip/resolver document :main nil context nil) + colors #(mapv :color (resolve %))] + (is (= [1 1] (colors 0)) "both children start in the day bank") + (is (= [3 1] (colors 2)) + "the inheriting child follows the lightning cut; an instance override wins") + (is (= [17 34 51] (nth (:ramp context) 1))) + (is (= [170 187 204] (nth (:ramp context) 3))))) diff --git a/static/arthur/app.css b/static/arthur/app.css index 5a25d4b..b652529 100644 --- a/static/arthur/app.css +++ b/static/arthur/app.css @@ -800,6 +800,9 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); } } .swatches { display: flex; gap: 3px; } +.palette-slot { display: flex; align-items: center; } +.palette-picker { display: none; } +.thumb i { display: block; min-width: 1px; min-height: 1px; } /* Circles. A palette entry is one indivisible tone, not an area of coverage, and a row of dots says that where a row of tiles says "swatch book". */ From dff23d7994f555e66f2922999ddaab2bdf0a860b Mon Sep 17 00:00:00 2001 From: Your Name Date: Fri, 2 Oct 2026 09:09:18 -0400 Subject: [PATCH 4/4] Add multi-object stage selection and transforms --- frontend/src/arthur/domain/gesture.cljs | 72 +++++++-- frontend/src/arthur/domain/pick.cljs | 25 +++ frontend/src/arthur/events/project.cljs | 10 ++ frontend/src/arthur/events/ui.cljs | 56 ++++++- frontend/src/arthur/subs/render.cljs | 10 +- frontend/src/arthur/ui/player.cljs | 3 + frontend/src/arthur/ui/stage.cljs | 146 ++++++++++++++++-- frontend/test/arthur/domain/gesture_test.cljs | 28 ++++ frontend/test/arthur/events/lane_test.cljs | 8 + static/arthur/app.css | 1 + 10 files changed, 315 insertions(+), 44 deletions(-) diff --git a/frontend/src/arthur/domain/gesture.cljs b/frontend/src/arthur/domain/gesture.cljs index 7da71bd..9850dff 100644 --- a/frontend/src/arthur/domain/gesture.cljs +++ b/frontend/src/arthur/domain/gesture.cljs @@ -29,14 +29,19 @@ xy #(let [v (at %)] [(ch/component v 0) (ch/component v 1)])] {:pos (xy :pos) :rot (at :rot) :scale (xy :scale) :anchor (xy :anchor)})) +(defn- measured-channel? [n path] + (let [c (get-in n [:channels path])] + (boolean (or (:dense c) (:generated c))))) + (defn refusal - "Why node `n`'s transform cannot be set by hand, or nil when it can. A - measured transform is regenerated from the footage, and writing a value over - it would throw the measurement away." - [n] - (cond - (node/measured? n) - "its transform is measured — place the instance it is in")) + "Why `kind` cannot transform node `n`, or nil. Measured position and rotation + accept authored correction layers; measured scale cannot yet be decomposed + safely. The one-argument form asks whether any stage gesture is possible." + ([n] (when (node/measured? n) + "its transform is measured — use a correction or place the instance it is in")) + ([n kind] + (when (and (= :scale kind) (measured-channel? n [:xform :scale])) + "its scale is measured — place the instance it is in"))) (defn- through [m [x y]] (let [out (js/Float64Array. 2)] @@ -76,24 +81,57 @@ nil)] {[:xform :scale] (if r (mapv #(* r %) s) (mapv * s (map k a b)))}))) +(def ^:private manual-layer ::manual-transform) + +(defn- plus [a b] + (if (number? a) (+ a b) (mapv + (vec a) (vec b)))) + +(defn- minus [a b] + (if (number? a) (- a b) (mapv - (vec a) (vec b)))) + +(defn- corrected-channel + "Set the effective value of a measured channel without replacing its base." + [channel f target store extent auto-key?] + (let [current (ch/value-at channel f store) + layers (vec (:over channel)) + i (first (keep-indexed #(when (= manual-layer (:id %2)) %1) layers)) + old (when i (ch/value-at (get-in layers [i :values]) f store)) + zero (if (number? target) 0 (vec (repeat (count target) 0))) + value (plus (or old zero) (minus target current)) + values (or (when i (get-in layers [i :values])) (ch/framed zero)) + values ((if auto-key? node/set-keyed-channel node/set-channel) + {:kind :group :channels {[:xform :pos] values}} + [:xform :pos] f value) + values (get-in values [:channels [:xform :pos]]) + layer (ch/layer manual-layer [0 extent] :offset values)] + (assoc channel :over (if i (assoc layers i layer) (conj layers layer))))) + (defn apply-values "Clip with channel values `vs`, `{path value}`, written into node `id` of symbol `sid` on the node's own frame `f`, by the keying rule above. The sixth argument arms auto-key; the five-argument form retains the normal rule." - ([clip sid id f vs] (apply-values clip sid id f vs false)) - ([clip sid id f vs auto-key?] + ([clip sid id f vs] (apply-values clip sid id f vs false nil)) + ([clip sid id f vs auto-key?] (apply-values clip sid id f vs auto-key? nil)) + ([clip sid id f vs auto-key? store] (let [put (if auto-key? node/set-keyed-channel node/set-channel)] (update-in clip [:symbols sid :nodes id] - #(reduce-kv (fn [n path v] (put n path f v)) % vs))))) + #(reduce-kv + (fn [n path v] + (if (measured-channel? n path) + (update-in n [:channels path] corrected-channel f v store + (get-in clip [:symbols sid :frames]) auto-key?) + (put n path f v))) + % vs))))) (defn apply-take "Apply a buffered performance take. `take` is keyed by `[symbol node]`, then local frame, then channel path. It becomes ordinary authored keys in one document edit rather than making the edit pipeline run for every sample." - [clip take] - (reduce-kv - (fn [c [sid id] frames] - (reduce-kv (fn [c f values] - (apply-values c sid id f values true)) - c frames)) - clip take)) + ([clip take] (apply-take clip take nil)) + ([clip take store] + (reduce-kv + (fn [c [sid id] frames] + (reduce-kv (fn [c f values] + (apply-values c sid id f values true store)) + c frames)) + clip take))) diff --git a/frontend/src/arthur/domain/pick.cljs b/frontend/src/arthur/domain/pick.cljs index 74ff3a0..8d0abff 100644 --- a/frontend/src/arthur/domain/pick.cljs +++ b/frontend/src/arthur/domain/pick.cljs @@ -55,6 +55,31 @@ [ops [x y]] (some #(when (on? % x y) (path-of %)) (rseq (vec ops)))) +(defn- op-bounds [{:keys [kind pts n cx cy r size]}] + (case kind + :poly (reduce (fn [b i] + (let [x (aget pts (* 2 i)) y (aget pts (inc (* 2 i)))] + (if b (let [[x0 y0 x1 y1] b] + [(min x0 x) (min y0 y) (max x1 x) (max y1 y)]) + [x y x y]))) nil (range n)) + :disc [(- cx r) (- cy r) (+ cx r) (+ cy r)] + :rect (let [h (/ size 2)] [(- cx h) (- cy h) (+ cx h) (+ cy h)]) + nil)) + +(defn in-rect + "Distinct row paths whose drawn bounds intersect `[x0 y0 x1 y1]`. `depth` + chooses objects at one hierarchy level, just as an ordinary stage click does." + [ops [ax ay bx by] depth] + (let [[rx0 rx1] [(min ax bx) (max ax bx)] + [ry0 ry1] [(min ay by) (max ay by)]] + (->> ops + (keep (fn [op] + (when-let [[x0 y0 x1 y1] (op-bounds op)] + (when (and (<= x0 rx1) (<= rx0 x1) (<= y0 ry1) (<= ry0 y1)) + (let [path (path-of op)] + (subvec path 0 (min (count path) (max 1 depth)))))))) + distinct vec))) + (defn- prefix? [a b] (and (<= (count a) (count b)) (= a (subvec b 0 (count a))))) diff --git a/frontend/src/arthur/events/project.cljs b/frontend/src/arthur/events/project.cljs index 1276f2b..bf63547 100644 --- a/frontend/src/arthur/events/project.cljs +++ b/frontend/src/arthur/events/project.cljs @@ -755,6 +755,16 @@ (let [put (if (get-in db [:ui :auto-key?]) node/set-keyed-channel node/set-channel)] (edit/edit db #(update-in % [:symbols sid :nodes id] put path frame value))))) +(rf/reg-event-db + ::set-channels + ;; One property assignment over a stage selection is one document edit. + (fn [db [_ edits]] + (let [put (if (get-in db [:ui :auto-key?]) node/set-keyed-channel node/set-channel)] + (edit/edit db + #(reduce (fn [c {:keys [sid id path frame value]}] + (update-in c [:symbols sid :nodes id] put path frame value)) + % edits))))) + (rf/reg-event-db ::toggle-key (fn [db [_ sid id path frame]] diff --git a/frontend/src/arthur/events/ui.cljs b/frontend/src/arthur/events/ui.cljs index 73c1542..80a8ac0 100644 --- a/frontend/src/arthur/events/ui.cljs +++ b/frontend/src/arthur/events/ui.cljs @@ -78,6 +78,7 @@ [:clip :symbols sid :nodes id :kind]))] (cond-> (-> db (assoc-in [:ui :selection] selection) + (assoc-in [:ui :selections] (if selection [selection] [])) (update :ui dissoc :points :retry)) (and (= :node kind) (seq path) (not sound?)) (update-in [:ui :expanded] (fnil into #{}) (rest (reductions conj [] (pop path))))))) @@ -103,6 +104,29 @@ (rf/reg-event-db ::select (fn [db [_ selection]] (selected db selection))) +(rf/reg-event-db + ::select-many + ;; `:selection` remains the primary address used by the inspector and timeline; + ;; `:selections` is the ordered set used by the stage and batch commands. + (fn [db [_ selections]] + (let [xs (vec (distinct (keep identity selections)))] + (if-let [primary (peek xs)] + (-> (selected db primary) (assoc-in [:ui :selections] xs)) + (selected db nil))))) + +(rf/reg-event-db + ::toggle-selection + (fn [db [_ selection]] + (let [primary (get-in db [:ui :selection]) + many (vec (get-in db [:ui :selections])) + old (if (some #{primary} many) many (if primary [primary] [])) + xs (if (some #{selection} old) + (vec (remove #{selection} old)) + (conj old selection))] + (if-let [primary (peek xs)] + (-> (selected db primary) (assoc-in [:ui :selections] xs)) + (selected db nil))))) + (rf/reg-event-db ::aim ;; The gestures that name a PLACE in the document rather than a thing on @@ -915,26 +939,44 @@ ::transform ;; The drag let go: one edit, so one undo step and one write to collaborators. (fn [db [_ g]] - (let [auto? (boolean (get-in db [:ui :gesture :auto-key?]))] + (let [auto? (boolean (get-in db [:ui :gesture :auto-key?])) + st (:store (store/entry (:clip/current db)))] (if auto? (let [db (-> db (update-in [:ui :gesture] merge g) (record-auto-frame (get-in db [:playback :frame]))) take (get-in db [:ui :gesture :take])] (cond-> (update db :ui dissoc :gesture) - (seq take) (edit/edit #(gesture/apply-take % take)))) + (seq take) (edit/edit #(gesture/apply-take % take st)))) (let [{:keys [sid id frame values]} g] (cond-> (update db :ui dissoc :gesture) - (seq values) (edit/edit #(gesture/apply-values % sid id frame values false)))))))) + (seq values) (edit/edit #(gesture/apply-values % sid id frame values false st)))))))) + +(rf/reg-event-db + ::transform-many + ;; Every visible member of a stage selection is one edit and therefore one + ;; undo step. Members absent at this playhead are intentionally not in `edits`. + (fn [db [_ edits]] + (let [st (:store (store/entry (:clip/current db)))] + (cond-> (update db :ui dissoc :gesture) + (seq edits) + (edit/edit #(reduce (fn [c {:keys [sid id frame values]}] + (gesture/apply-values c sid id frame values + (boolean (get-in db [:ui :auto-key?])) st)) + % edits)))))) (rf/reg-event-db ::delete-selected (fn [db _] - (let [[kind sid id] (get-in db [:ui :selection])] - (if (= :node kind) + (let [primary (get-in db [:ui :selection]) + many (vec (get-in db [:ui :selections])) + selections (if (some #{primary} many) many (if primary [primary] [])) + nodes (distinct (keep (fn [[kind sid id]] (when (= :node kind) [sid id])) selections))] + (if (seq nodes) (-> db - (edit/edit #(nest/delete-node % sid id)) - (assoc-in [:ui :selection] nil)) + (edit/edit #(reduce (fn [c [sid id]] (nest/delete-node c sid id)) % nodes)) + (assoc-in [:ui :selection] nil) + (assoc-in [:ui :selections] [])) db)))) (rf/reg-event-db diff --git a/frontend/src/arthur/subs/render.cljs b/frontend/src/arthur/subs/render.cljs index ccacf91..94bf24a 100644 --- a/frontend/src/arthur/subs/render.cljs +++ b/frontend/src/arthur/subs/render.cljs @@ -43,20 +43,24 @@ ;; With a timeline bar being slid, the document as it will be when the drag ;; 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))] + (let [{c :clip st :store} (footage/entry id)] (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] + (when-let [{:keys [sid id frame values edits]} gesture] ;; A held stage control owns the touched parameters completely. Make ;; them temporary static channels for the preview, so their existing ;; automation cannot pull against the pointer while the performance ;; recorder samples the live value in the background. Pointer-up ;; removes this preview and commits the buffered take as real keys. - (when c (gesture/apply-values c sid id frame values false))) + (when c + (if (seq edits) + (reduce (fn [out {:keys [sid id frame values]}] + (gesture/apply-values out sid id frame values false st)) c edits) + (gesture/apply-values c sid id frame values false st)))) c)))) (rf/reg-sub diff --git a/frontend/src/arthur/ui/player.cljs b/frontend/src/arthur/ui/player.cljs index 5452f67..a9d752f 100644 --- a/frontend/src/arthur/ui/player.cljs +++ b/frontend/src/arthur/ui/player.cljs @@ -152,6 +152,9 @@ [point] (pick/hit (:ops @state) point)) +(defn in-rect [rect depth] + (pick/in-rect (:ops @state) rect depth)) + (defn paint! "Resolve `f` and put it on the canvas. `ops` are consumed here and only here — the resolver reuses its point buffers between frames, so they have to be diff --git a/frontend/src/arthur/ui/stage.cljs b/frontend/src/arthur/ui/stage.cljs index 689339e..c022429 100644 --- a/frontend/src/arthur/ui/stage.cljs +++ b/frontend/src/arthur/ui/stage.cljs @@ -25,7 +25,8 @@ [arthur.ui.layout :as layout] [arthur.ui.player :as player] [arthur.ui.underlay :as underlay] - [re-frame.core :as rf])) + [re-frame.core :as rf] + [reagent.core :as r])) ;; THE ZOOM IS NOT A CONSTANT ANY MORE — it is `ui/layout`'s, an integer in ;; [1 8], 2 to begin with. It scales the canvas with CSS and never its backing @@ -118,6 +119,7 @@ ;; placement and transform it started from, and where. What it makes of the ;; pointer goes out as `::ui/gesture`, and on the way up as one `::ui/transform`. (defonce ^:private gesture (atom nil)) +(defonce ^:private marquee (r/atom nil)) (defn- loaded "The document and its tier-2 store, read WHEN THE POINTER GOES DOWN. @@ -157,12 +159,62 @@ (reset! gesture {:kind kind :pl pl :path path :open open :v0 v0 :p0 p :n n :a (gesture/angle pl v0 p) :turned 0}))))) +(defn- stage-bounds [{:keys [world bounds]}] + (when (and world bounds) + (let [[x0 y0 x1 y1] bounds + ps (pairs (through world [x0 y0 x1 y0 x1 y1 x0 y1]))] + [(apply min (map first ps)) (apply min (map second ps)) + (apply max (map first ps)) (apply max (map second ps))]))) + +(defn- begin-many! [ctx kind placements p] + (let [{document :clip st :store} (loaded ctx) + members (into [] (keep (fn [{:keys [path]}] + (when-let [{:keys [sid id frame] :as pl} + (nest/placement document st (:open ctx) path (:f ctx))] + (let [n (get-in document [:symbols sid :nodes id])] + {:pl pl :path path :node n + :v0 (gesture/values n frame st)})))) + placements) + why (some #(gesture/refusal (:node %) kind) members) + boxes (keep stage-bounds placements) + box (when (seq boxes) + (reduce (fn [[ax ay bx by] [cx cy dx dy]] + [(min ax cx) (min ay cy) (max bx dx) (max by dy)]) boxes))] + (cond + why (rf/dispatch [::ui/refuse (str "the selection cannot move together: " why)]) + (and (seq members) box) + (reset! gesture {:kind kind :members members :p0 p :box box})))) + +(defn- multi-values [kind {:keys [pl v0]} [cx cy] p0 p] + (case kind + :move (gesture/move pl v0 p0 p) + :scale + (let [d0 (max 1e-6 (js/Math.hypot (- (first p0) cx) (- (second p0) cy))) + k (/ (js/Math.hypot (- (first p) cx) (- (second p) cy)) d0) + [px py] (through (:world pl) (:anchor v0)) + target [(+ cx (* k (- px cx))) (+ cy (* k (- py cy)))] + inv (node/invert (:parent pl))] + (when inv + (let [[a b] (through inv [px py]) [c d] (through inv target)] + {[:xform :pos] (mapv + (:pos v0) [(- c a) (- d b)]) + [:xform :scale] (mapv #(* k %) (:scale v0))}))) + nil)) + (defn- drag! [p ^js event] (let [{:keys [kind pl path open v0 p0 n a turned values]} @gesture shift? (.-shiftKey event) moved? (or values (< 1 (js/Math.hypot (- (first p) (first p0)) (- (second p) (second p0)))))] (when moved? - (if-let [why (gesture/refusal n)] + (if-let [members (:members @gesture)] + (let [[x0 y0 x1 y1] (:box @gesture) + center [(/ (+ x0 x1) 2) (/ (+ y0 y1) 2)] + edits (into [] (keep (fn [{:keys [pl path] :as member}] + (when-let [vs (multi-values kind member center p0 p)] + (assoc (select-keys pl [:sid :id :frame]) + :path path :values vs)))) members)] + (swap! gesture assoc :values edits) + (rf/dispatch [::ui/gesture {:edits edits}])) + (if-let [why (gesture/refusal n kind)] (do (reset! gesture nil) (rf/dispatch [::ui/refuse why])) (let [vs (case kind :move (gesture/move pl v0 p0 p) @@ -180,16 +232,17 @@ (swap! gesture assoc :values vs) (rf/dispatch [::ui/gesture (assoc (select-keys pl [:sid :id :frame]) - :path path :open open :values vs)]))))))) + :path path :open open :values vs)])))))))) (defn- let-go! [commit?] - (when-let [{:keys [pl path open values]} @gesture] + (when-let [{:keys [pl path open values members]} @gesture] (reset! gesture nil) (when values - (rf/dispatch (if commit? - [::ui/transform (assoc (select-keys pl [:sid :id :frame]) - :path path :open open :values values)] - [::ui/gesture nil]))))) + (rf/dispatch (cond + (not commit?) [::ui/gesture nil] + members [::ui/transform-many values] + :else [::ui/transform (assoc (select-keys pl [:sid :id :frame]) + :path path :open open :values values)]))))) (defn- handles "The selected node's box, drawn through its own transform so it turns with @@ -227,6 +280,30 @@ [:path.pivot {:d (str "M " (- px 3) " " py " H " (+ px 3) " M " px " " (- py 3) " V " (+ py 3))}]]))) +(defn- group-handles [ctx placements] + (let [boxes (keep stage-bounds placements)] + (when (seq boxes) + (let [[x0 y0 x1 y1] (reduce (fn [[ax ay bx by] [cx cy dx dy]] + [(min ax cx) (min ay cy) (max bx dx) (max by dy)]) boxes) + grab (fn [kind] + (fn [^js event] + (.stopPropagation event) + (.preventDefault event) + (let [svg (.-ownerSVGElement (.-currentTarget event))] + (.setPointerCapture svg (.-pointerId event)) + (begin-many! ctx kind placements (xy svg event (:w ctx) (:h ctx))))))] + [:g.handles.multi + [:rect.box {:x x0 :y y0 :width (- x1 x0) :height (- y1 y0)}] + (doall (for [[i [x y]] (map-indexed vector [[x0 y0] [x1 y0] [x1 y1] [x0 y1]])] + ^{:key i} [:rect.corner {:x (- x 1.8) :y (- y 1.8) + :width 3.6 :height 3.6 + :on-pointer-down (grab :scale)}]))])))) + +(defn- address-for [{:keys [open f] :as ctx} path] + (let [{document :clip st :store} (loaded ctx)] + (when-let [{:keys [sid id]} (and (seq path) (nest/placement document st open path f))] + [:node sid id path]))) + (defn- aim-box "The TARGET's outline: where a new polygon or symbol would be parented, drawn around the thing that would be its parent. @@ -271,6 +348,9 @@ draft @(rf/subscribe [::sub/draft]) drawing? (= :polygon tool) [_ _ _ selected] @(rf/subscribe [::sub/selection]) + selections @(rf/subscribe [::sub/selections]) + placements @(rf/subscribe [::sub/selected-placements]) + selected-paths (set (keep #(nth % 3 nil) selections)) clip-id @(rf/subscribe [::render/clip-id]) ctx {:clip-id clip-id ;; The open symbol's OWN frame, which is what `nest/placement` @@ -281,7 +361,8 @@ points? @(rf/subscribe [::sub/points]) [sid id geom active editable? frame matrix] (when points? (editing)) pts (when geom (through matrix (channel/value-at geom frame - (:store (store/entry clip-id)))))] + (:store (store/entry clip-id))))) + mark @marquee] [:svg {:class (str "paint-overlay" (when drawing? " drawing")) :width (* zoom w) :height (* zoom h) :view-box (str "0 0 " w " " h) @@ -295,10 +376,22 @@ path (pick/choose selected (player/at p) (or (.-metaKey event) (.-ctrlKey event)))] (.focus svg) - (when (not= path selected) (select! ctx path)) - (when path + (cond + (and (.-shiftKey event) path) + (when-let [address (address-for ctx path)] + (rf/dispatch [::ui/toggle-selection address])) + + path + (when-not (contains? selected-paths path) (select! ctx path)) + + :else + (do (.setPointerCapture svg (.-pointerId event)) + (reset! marquee {:p0 p :p p :more? (.-shiftKey event)}))) + (when (and path (not (.-shiftKey event))) (.setPointerCapture svg (.-pointerId event)) - (begin! ctx :move path p))))) + (if (and (> (count placements) 1) (contains? selected-paths path)) + (begin-many! ctx :move placements p) + (begin! ctx :move path p)))))) :on-double-click (fn [^js event] (when-not drawing? (let [p (xy (.-currentTarget event) event w h) @@ -321,19 +414,38 @@ (rf/dispatch [::paint-events/set-vertex sid node key-frame vertex (through inv (stage-point event w h))]) - (when @gesture - (drag! (xy (.-currentTarget event) event w h) event)))) - :on-pointer-up (fn [_] (reset! dragging nil) (let-go! true)) - :on-pointer-cancel (fn [_] (reset! dragging nil) (let-go! false))} + (let [p (xy (.-currentTarget event) event w h)] + (if @marquee + (swap! marquee assoc :p p) + (when @gesture (drag! p event)))))) + :on-pointer-up (fn [_] + (reset! dragging nil) + (if-let [{:keys [p0 p more?]} @marquee] + (let [depth (or (some-> selected count) 1) + paths (player/in-rect [(first p0) (second p0) + (first p) (second p)] depth) + addresses (into [] (keep #(address-for ctx %)) paths) + old (if more? selections [])] + (reset! marquee nil) + (rf/dispatch [::ui/select-many (into old addresses)])) + (let-go! true))) + :on-pointer-cancel (fn [_] + (reset! dragging nil) (reset! marquee nil) (let-go! false))} [ghost] (when (seq draft) [:polyline {:points (points-text draft) :fill "none" :stroke "#d0ba86" :stroke-width 1}]) + (when mark + (let [[[x0 y0] [x1 y1]] [(:p0 mark) (:p mark)]] + [:rect.marquee {:x (min x0 x1) :y (min y0 y1) + :width (js/Math.abs (- x1 x0)) + :height (js/Math.abs (- y1 y0))}])) ;; DRAWN WHILE DRAWING, unlike the handles. "Where will this polygon land" ;; is the question the outline exists to answer, and the moment it is being ;; asked is mid-draft. (when-not points? [aim-box]) - (when-not (or drawing? points?) [handles ctx]) + (when-not (or drawing? points?) + (if (> (count placements) 1) [group-handles ctx placements] [handles ctx])) (when (and id pts (not drawing?) (not (channel/nothing? pts))) [:g [:polygon {:points (points-text pts) :fill "none" diff --git a/frontend/test/arthur/domain/gesture_test.cljs b/frontend/test/arthur/domain/gesture_test.cljs index c87cd19..f64be4a 100644 --- a/frontend/test/arthur/domain/gesture_test.cljs +++ b/frontend/test/arthur/domain/gesture_test.cljs @@ -274,6 +274,22 @@ (is (string? (gesture/refusal {:channels {[:xform :pos] {:animated? true :dense {:stride 2}}}}))) (is (nil? (gesture/refusal {:channels {[:xform :pos] (ch/keyed {0 [1 1]} :hold)}})))) +(deftest moving-a-measured-part-adds-an-authored-offset + (let [key "measured-position" + st {key {:data (js/Float32Array. #js [1 2 2 3])}} + measured {:animated? true :dense {:store key :offset 0 :stride 2 :frames 2}} + c (-> (clip/blank) + (paint/new-shape :main :brow 0 [0 0 10 0 5 3] :brow) + (assoc-in [:symbols :main :nodes :brow :channels [:xform :pos]] measured)) + once (gesture/apply-values c :main :brow 0 {[:xform :pos] [4 6]} false st) + twice (gesture/apply-values once :main :brow 0 {[:xform :pos] [5 8]} false st) + pos #(get-in % [:symbols :main :nodes :brow :channels [:xform :pos]])] + (is (= (:dense measured) (:dense (pos twice))) "the measured base survives") + (is (= [5 8] (ch/value-at (pos twice) 0 st)) "the brow lands under the pointer") + (is (= [6 9] (ch/value-at (pos twice) 1 st)) + "its measured motion continues underneath the authored offset") + (is (= 1 (count (:over (pos twice)))) "repeated drags update one correction layer"))) + (deftest a-click-selects-the-level-figma-would (let [hit [:a :b :c :shape]] (testing "choose" @@ -297,6 +313,18 @@ (is (= [:dot] (pick/hit ops [52.5 50])) "a few-pixel shape can be missed by a little") (is (nil? (pick/hit ops [30 30]))))) +(deftest a-marquee-selects-visible-objects-at-one-depth + (let [sq (fn [path x0] {:kind :poly :node path :n 4 + :pts (js/Float64Array. + #js [x0 0 (+ x0 10) 0 (+ x0 10) 10 x0 10])}) + ops [(sq [:left :inside] 0) (sq [:right :inside] 20) (sq [:away] 80)]] + (is (= [[:left] [:right]] (pick/in-rect ops [-2 -2 35 12] 1)) + "a fresh marquee chooses objects in the open symbol") + (is (= [[:left :inside] [:right :inside]] (pick/in-rect ops [-2 -2 35 12] 2)) + "an existing deep selection keeps the marquee at that depth") + (is (= [[:left]] (pick/in-rect ops [5 5 6 6] 1)) + "intersection, rather than full containment, makes small objects selectable"))) + (deftest an-instances-box-is-what-its-symbol-draws (let [c (two-down) {:keys [frame]} (nest/placement c nil :main [u v] 16)] diff --git a/frontend/test/arthur/events/lane_test.cljs b/frontend/test/arthur/events/lane_test.cljs index a282069..5c8f4e0 100644 --- a/frontend/test/arthur/events/lane_test.cljs +++ b/frontend/test/arthur/events/lane_test.cljs @@ -182,6 +182,14 @@ (is (empty? (get-in after [:ui :expanded])) "and there are no rows above the top to open"))) +(deftest a-primary-selection-also-starts-the-stage-selection-set + (let [doc (fixture/document) + id (store/install! {:clip doc :store {}} "primary-stage-selection") + address [:node :main :insert [:insert]] + after (ui/selected {:clip/current id :ui {}} address)] + (is (= address (get-in after [:ui :selection]))) + (is (= [address] (get-in after [:ui :selections]))))) + (deftest finishing-a-polygon-opens-no-rows ;; Expansion is the twist triangle's business. Finishing a shape used to open ;; every row down to it, which inside a lane meant tearing its one row into a diff --git a/static/arthur/app.css b/static/arthur/app.css index b652529..c6ab16a 100644 --- a/static/arthur/app.css +++ b/static/arthur/app.css @@ -1380,6 +1380,7 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); } .paint-overlay .handles .knob { fill: #161820; stroke: #fff1be; stroke-width: 0.6; cursor: grab; } .paint-overlay .handles .corner { fill: #fff1be; stroke: #161820; stroke-width: 0.5; cursor: nwse-resize; } .paint-overlay .handles .pivot { stroke: #fff1be; stroke-width: 0.6; pointer-events: none; } +.paint-overlay .marquee { fill: rgba(230, 202, 139, 0.12); stroke: #e6ca8b; stroke-width: 0.6; stroke-dasharray: 2 1; pointer-events: none; } /* The aim outline and its name tag. Solid, no handles, and a tag pinned just outside the bottom-right corner — see `ui/stage/aim-box` for why the box