From 1a42481575ffae7ebb081daab51cc62a3a418c36 Mon Sep 17 00:00:00 2001 From: Olive Vaughn Date: Tue, 29 Sep 2026 13:32:52 -0400 Subject: [PATCH] An instance pivots about the middle of what its symbol draws MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit place-symbol sets a new instance's anchor to clip/center — the middle of the bounds of everything the symbol draws over all its frames, or the stage's middle for a symbol that draws nothing — and a stage drop puts that middle under the pointer. The anchor is set once and never follows the symbol, as Flash's transformation point and After Effects' anchor point do, so a symbol that grows later moves nothing on screen. The drop preview marks the pivot. Co-Authored-By: Claude Opus 5.5 --- frontend/src/arthur/domain/clip.cljs | 72 +++++++++++++++---- frontend/src/arthur/events/footage.cljs | 19 ++--- frontend/src/arthur/events/ui.cljs | 6 +- frontend/src/arthur/ui/drag.cljs | 55 ++++++-------- frontend/src/arthur/ui/stage.cljs | 43 ++++++----- frontend/src/arthur/ui/timeline.cljs | 2 +- .../test/arthur/domain/instance_test.cljs | 35 +++++++-- 7 files changed, 145 insertions(+), 87 deletions(-) diff --git a/frontend/src/arthur/domain/clip.cljs b/frontend/src/arthur/domain/clip.cljs index 84c2d0e..e6d063f 100644 --- a/frontend/src/arthur/domain/clip.cljs +++ b/frontend/src/arthur/domain/clip.cljs @@ -122,9 +122,48 @@ :subjects {} :features {} :groups {} :symbols {:main {:id :main :frames blank-frames :nodes {}}}}) +(declare resolver) + +(defn center + "The middle of everything symbol `sid` draws, over all its frames, in its own + coordinates. ALL frames rather than the first, so a symbol whose drawing + enters late, or travels, still has its middle where the drawing is. A symbol + that draws nothing gets the STAGE's middle, which is where a drawing made into + it will be, because drawings are made on the stage. + + What this feeds is a DEFAULT: `place-symbol` copies it into a new instance's + anchor and nothing ever updates it, as Flash's transformation point and After + Effects' anchor point are set once and left. A symbol that grows later keeps + its instances' pivots where they were, so nothing on screen moves." + [clip store sid] + (let [resolve (resolver clip store pal/index-of sid) + bounds (fn [[x0 y0 x1 y1 :as b] x y] + (if b [(min x0 x) (min y0 y) (max x1 x) (max y1 y)] [x y x y])) + [x0 y0 x1 y1] + (reduce + (fn [b {:keys [kind pts n cx cy r size]}] + (case kind + :poly (reduce (fn [b i] (bounds b (aget pts (* 2 i)) (aget pts (inc (* 2 i))))) + b (range n)) + :disc (-> b (bounds (- cx r) (- cy r)) (bounds (+ cx r) (+ cy r))) + :rect (let [h (/ size 2)] (-> b (bounds (- cx h) (- cy h)) (bounds (+ cx h) (+ cy h)))) + b)) + nil + (mapcat resolve (range (frames clip sid))))] + (if x0 + [(/ (+ x0 x1) 2) (/ (+ y0 y1) 2)] + [(/ (:width clip) 2) (/ (:height clip) 2)]))) + (defn place-symbol "An instance of symbol `sid`, inside symbol `host`, at `frame` of `host`. + THE ANCHOR IS THE MIDDLE. Every instance pivots about the centre of what it + draws — see `center` — so rotating or scaling one turns it in place rather than + swinging it about a corner. At the identity transform the anchor moves nothing, + so where the drawing lands is `pos` alone: with `point`, a stage pixel, the + middle goes there; without one — a drop on the timeline — the drawing stays + where it was drawn. + THE UUID IS AN ARGUMENT. A placement's identity is the key it has in the node map — it is what `:linked-to`, an export target and a saved leaf all name — so generating one in here would make this function's result depend on when it was @@ -137,25 +176,28 @@ Refused, returning the clip unchanged, when it would make a cycle: a symbol cannot be placed inside itself or inside anything it places." - [clip host sid frame uuid [x y]] + [clip store host sid frame uuid point] (let [target (symbol clip sid) end (frames clip host)] (if (or (nil? target) (nil? end) (nil? frame) (neg? frame) (>= frame end) (contains-symbol? clip sid host)) clip - (update-symbol - clip host assoc-in [:nodes uuid] - {:id uuid - :name (symbol-name clip sid) - :kind :instance - :of sid - :parent nil - ;; Lexicographic draw order, as `domain/paint` does it: a placement made - ;; later sits above one made earlier, and neither has to renumber. - :z (str "z" (js/Date.now) "-" (name sid)) - :span [0 (:frames target)] - :time {:mode :map :at frame :rate 1} - :channels {[:xform :pos] {:animated? false :value [x y]}}})))) + (let [middle (center clip store sid)] + (update-symbol + clip host assoc-in [:nodes uuid] + {:id uuid + :name (symbol-name clip sid) + :kind :instance + :of sid + :parent nil + ;; Lexicographic draw order, as `domain/paint` does it: a placement made + ;; later sits above one made earlier, and neither has to renumber. + :z (str "z" (js/Date.now) "-" (name sid)) + :span [0 (:frames target)] + :time {:mode :map :at frame :rate 1} + :channels {[:xform :pos] {:animated? false + :value (if point (mapv - point middle) [0 0])} + [:xform :anchor] {:animated? false :value middle}}}))))) (defn fresh-id "The first `:symbol-N` the clip does not already hold. Readable because an id @@ -173,7 +215,7 @@ clip (-> clip (assoc-in [:symbols sid] {:id sid :name (name sid) :frames (- end frame) :nodes {}}) - (place-symbol host sid frame uuid [0 0]))))) + (place-symbol nil host sid frame uuid nil))))) (defn- free-id "`wanted`, or the first `wanted-2`, `wanted-3`… `taken?` does not claim. diff --git a/frontend/src/arthur/events/footage.cljs b/frontend/src/arthur/events/footage.cljs index 22f05cf..4e7e531 100644 --- a/frontend/src/arthur/events/footage.cljs +++ b/frontend/src/arthur/events/footage.cljs @@ -392,17 +392,17 @@ ;; ;; Dropping a video asks first. `[:ui :convert]` is the question — which footage, ;; which of its frames, what to call the result — and where the answer will be -;; placed: `:host`, `:frame` and `:pos` are the drop's, captured when it happened +;; placed: `:host`, `:frame` and `:point` are the drop's, captured when it happened ;; so that switching tabs while detection runs does not move where it lands. (rf/reg-event-db ::ask-convert - (fn [db [_ {:keys [frames label] :as footage} frame pos]] + (fn [db [_ {:keys [frames label] :as footage} frame point]] (assoc-in db [:ui :convert] (merge (select-keys footage [:id :label :frames :fps :video]) {:range [0 frames] :name (string/replace (str label) #"\.[^.]*$" "") - :host (get-in db [:ui :open]) :frame frame :pos pos})))) + :host (get-in db [:ui :open]) :frame frame :point point})))) (rf/reg-event-db ::convert-set @@ -425,7 +425,7 @@ (rf/reg-event-fx ::converted - (fn [{:keys [db]} [_ {{:keys [name host frame pos range]} :request footage-id :footage-id} + (fn [{:keys [db]} [_ {{:keys [name host frame point range]} :request footage-id :footage-id} built]] (let [uuid (random-uuid) fps (get-in db [:clip :fps]) @@ -434,11 +434,12 @@ name footage-id range) db (edit/edit-entry db - #(cond-> (-> % - (assoc :clip (clip/place-symbol clip host sid frame uuid pos)) - (update :store merge (:store built))) - tracked? (merge (select-keys built [:footage-id :source-blocks - :source-inputs]))))] + #(let [st (merge (:store %) (:store built))] + (cond-> (assoc % + :store st + :clip (clip/place-symbol clip st host sid frame uuid point)) + tracked? (merge (select-keys built [:footage-id :source-blocks + :source-inputs])))))] {:db (-> db (update :ui dissoc :convert) (assoc-in [:ui :selection] [:node host uuid [uuid]]) diff --git a/frontend/src/arthur/events/ui.cljs b/frontend/src/arthur/events/ui.cljs index 9d2587a..97f1c13 100644 --- a/frontend/src/arthur/events/ui.cljs +++ b/frontend/src/arthur/events/ui.cljs @@ -125,10 +125,12 @@ (rf/reg-event-db ::drop-symbol - (fn [db [_ sid frame pos]] + ;; `point` is the stage pixel it was dropped on, or nil from the timeline. + (fn [db [_ sid frame point]] (let [uuid (random-uuid) host (get-in db [:ui :open])] (-> db (update :ui dissoc :drop) - (edit/edit #(clip/place-symbol % host sid frame uuid pos)) + (edit/edit-entry #(update % :clip clip/place-symbol (:store %) + host sid frame uuid point)) (assoc-in [:ui :selection] [:node host uuid [uuid]]))))) diff --git a/frontend/src/arthur/ui/drag.cljs b/frontend/src/arthur/ui/drag.cljs index 8079fc1..6cd59f6 100644 --- a/frontend/src/arthur/ui/drag.cljs +++ b/frontend/src/arthur/ui/drag.cljs @@ -19,29 +19,16 @@ (defonce carrying (atom nil)) (defn- outline - "Frame 0 of symbol `sid` as plain shapes in its own space, and the centre of - their bounds. Frame 0 because an instance dropped at the playhead starts there." + "Frame 0 of symbol `sid` as plain shapes in its own space, for the stage's + preview. Frame 0 because an instance dropped at the playhead starts there." [document st sid] - (let [shapes (keep (fn [op] - (case (:kind op) - :poly {:kind :poly - :pts (vec (take (* 2 (:n op)) (array-seq (:pts op))))} - :disc (select-keys op [:kind :cx :cy :r]) - :rect (select-keys op [:kind :cx :cy :size]) - nil)) - ((clip/resolver document st pal/index-of sid) 0)) - xys (mapcat (fn [{:keys [kind pts cx cy]}] - (if (= :poly kind) (partition 2 pts) [[cx cy]])) - shapes)] - (if (empty? xys) - {:shapes []} - (let [xs (map first xys) ys (map second xys) - [x0 x1 y0 y1] [(apply min xs) (apply max xs) (apply min ys) (apply max ys)]] - {;; Under a few pixels there is nothing to see — a face symbol is drawn in - ;; units of one image height and scaled up by what places it — so the - ;; preview is the crosshair instead. - :shapes (if (< (max (- x1 x0) (- y1 y0)) 3) [] (vec shapes)) - :center [(/ (+ x0 x1) 2) (/ (+ y0 y1) 2)]})))) + (vec (keep (fn [op] + (case (:kind op) + :poly {:kind :poly :pts (vec (take (* 2 (:n op)) (array-seq (:pts op))))} + :disc (select-keys op [:kind :cx :cy :r]) + :rect (select-keys op [:kind :cx :cy :size]) + nil)) + ((clip/resolver document st pal/index-of sid) 0)))) (defn symbol! "Start carrying symbol `sid` of the loaded document into the open symbol." @@ -53,8 +40,11 @@ ;; A symbol cannot go inside itself or inside ;; anything it places. Refused by not ACCEPTING the ;; drop, so the pointer says so while it hovers. - :refused? (clip/contains-symbol? document sid open)} - (outline document st sid))))) + :refused? (clip/contains-symbol? document sid open) + ;; The same middle `clip/place-symbol` will anchor + ;; on, so the preview is where the drop lands. + :center (clip/center document st sid) + :shapes (outline document st sid)})))) (defn accepts? "Whether a drop target should accept what is being carried." @@ -82,21 +72,20 @@ :label label :frames frames}]))) (defn pos-for - "Where an instance goes so the middle of its first frame is under `point`. A - symbol with nothing drawn has no middle, and its origin goes there instead." + "Where the preview goes so the symbol's middle is under `point` — what + `clip/place-symbol` will do on the drop." [point] - (let [[cx cy] (:center @carrying)] - (if cx (mapv - point [cx cy]) point))) + (mapv - point (or (:center @carrying) [0 0]))) (defn land! - "Drop what is being carried at `frame` of the open symbol, with its instance - at `pos`." - [frame pos] + "Drop what is being carried at `frame` of the open symbol: with its middle on + stage pixel `point`, or, with no point — the timeline — where it was drawn." + [frame point] (when-let [{:keys [kind sid] :as c} (when (accepts?) @carrying)] (case kind - :symbol (rf/dispatch [::ui/drop-symbol sid frame pos]) + :symbol (rf/dispatch [::ui/drop-symbol sid frame point]) ;; Video is asked about before anything happens: which frames, and what ;; the symbol they become is called. - :footage (rf/dispatch [::footage/ask-convert c frame pos]) + :footage (rf/dispatch [::footage/ask-convert c frame point]) nil)) (done!)) diff --git a/frontend/src/arthur/ui/stage.cljs b/frontend/src/arthur/ui/stage.cljs index fc52e97..54c3c94 100644 --- a/frontend/src/arthur/ui/stage.cljs +++ b/frontend/src/arthur/ui/stage.cljs @@ -68,31 +68,30 @@ (defn- ghost "Where a drag out of the pool would land: the outline of its first frame, - dashed, with its middle under the pointer. Drawn from the drag's own outline - rather than by resolving anything, so hovering costs one re-render and no - evaluation." + dashed, and a cross on the middle it will pivot about, which goes under the + pointer. Drawn from the drag's own outline rather than by resolving anything, + so hovering costs one re-render and no evaluation. The cross is always drawn: a + face symbol is a fraction of a pixel until what places it scales it up, and + then it is the only thing to see." [] (let [{:keys [where point]} @(rf/subscribe [::sub/drop]) - {:keys [shapes]} @drag/carrying] + {:keys [shapes center]} @drag/carrying] (when (and (= :stage where) point) - (let [[x y] (drag/pos-for point)] + (let [[x y] (drag/pos-for point) + [cx cy] (or center [0 0])] [:g.ghost {:transform (str "translate(" x "," y ")")} - (if (seq shapes) - (doall - (map-indexed - (fn [i {:keys [kind pts cx cy r size]}] - (case kind - :poly ^{:key i} [:polygon {:points (points-text pts)}] - :disc ^{:key i} [:circle {:cx cx :cy cy :r r}] - :rect ^{:key i} [:rect {:x (- cx (/ size 2)) :y (- cy (/ size 2)) - :width size :height size}] - nil)) - shapes)) - ;; Nothing drawn, or nothing big enough to see: a mark where its - ;; middle will land. - (let [[cx cy] (or (:center @drag/carrying) [0 0])] - [:path {:d (str "M " (- cx 5) " " cy " H " (+ cx 5) - " M " cx " " (- cy 5) " V " (+ cy 5))}]))])))) + (doall + (map-indexed + (fn [i {:keys [kind pts cx cy r size]}] + (case kind + :poly ^{:key i} [:polygon {:points (points-text pts)}] + :disc ^{:key i} [:circle {:cx cx :cy cy :r r}] + :rect ^{:key i} [:rect {:x (- cx (/ size 2)) :y (- cy (/ size 2)) + :width size :height size}] + nil)) + shapes)) + [:path {:d (str "M " (- cx 5) " " cy " H " (+ cx 5) + " M " cx " " (- cy 5) " V " (+ cy 5))}]])))) (defn- overlay [w h] (let [clip @(rf/subscribe [::render/clip]) @@ -162,7 +161,7 @@ (rf/dispatch [::ui/drop-clear]))) :on-drop (fn [^js event] (.preventDefault event) - (drag/land! frame (drag/pos-for (stage-point event w h))))} + (drag/land! frame (stage-point event w h)))} [:canvas.stage {:ref #(player/set-canvas! %) :width w :height h :style {:width (str (* zoom w) "px") diff --git a/frontend/src/arthur/ui/timeline.cljs b/frontend/src/arthur/ui/timeline.cljs index 0a4fe70..e90b1fe 100644 --- a/frontend/src/arthur/ui/timeline.cljs +++ b/frontend/src/arthur/ui/timeline.cljs @@ -270,7 +270,7 @@ ;; space, so what was drawn at a place stays at that place. :on-drop (fn [^js e] (.preventDefault e) - (drag/land! (frame-at e frames) [0 0])) + (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. diff --git a/frontend/test/arthur/domain/instance_test.cljs b/frontend/test/arthur/domain/instance_test.cljs index 7c3914c..533952b 100644 --- a/frontend/test/arthur/domain/instance_test.cljs +++ b/frontend/test/arthur/domain/instance_test.cljs @@ -212,7 +212,7 @@ (assoc-in [:symbols :outer] {:id :outer :frames 200 :nodes {}}) (assoc-in [:symbols :inner] {:id :inner :frames 10 :nodes {}}) (assoc-in [:symbols :loose] {:id :loose :frames 30 :nodes {}}) - (clip/place-symbol :outer :inner 5 (random-uuid) [0 0]))) + (clip/place-symbol nil :outer :inner 5 (random-uuid) nil))) (deftest no-symbol-is-special (let [c (nested)] @@ -228,9 +228,9 @@ (testing "placing is refused when it would make a cycle" (is (clip/contains-symbol? c :outer :inner)) (is (not (clip/contains-symbol? c :inner :outer))) - (is (= c (clip/place-symbol c :inner :outer 0 (random-uuid) [0 0])) + (is (= c (clip/place-symbol c nil :inner :outer 0 (random-uuid) nil)) "outer inside inner, which is inside outer") - (is (= c (clip/place-symbol c :inner :inner 0 (random-uuid) [0 0])) + (is (= c (clip/place-symbol c nil :inner :inner 0 (random-uuid) nil)) "a symbol inside itself")) (testing "and the result is a valid document whose instance saves" (is (empty? (clip/problems c))) @@ -275,7 +275,7 @@ (let [here (nested) there (-> (clip/blank) (assoc-in [:symbols :inner] {:id :inner :frames 4 :nodes {}}) - (clip/place-symbol :main :inner 0 #uuid "00000000-0000-4000-8000-0000000000aa" [0 0])) + (clip/place-symbol nil :main :inner 0 #uuid "00000000-0000-4000-8000-0000000000aa" nil)) {:keys [clip ids]} (clip/adopt here there [:main] {:main :take})] (is (= {:main :take :inner :inner-2} ids) "the root gets the name asked for; a taken id gets the next free one") @@ -290,7 +290,7 @@ :channels {[:audio :gain] (ch/keyed {0 0.0 5 1.0})}} c (-> (clip/blank) (assoc-in [:symbols :talk] {:id :talk :frames 30 :nodes {:v voice}}) - (clip/place-symbol :main :talk 50 #uuid "00000000-0000-4000-8000-0000000000bb" [0 0])) + (clip/place-symbol nil :main :talk 50 #uuid "00000000-0000-4000-8000-0000000000bb" nil)) [t] (clip/audio-tracks c :main)] (is (= [10 40] (:span t)) "the same frames of the source") (is (= [50 80] (node/placed-span t)) "starting where the instance starts") @@ -301,3 +301,28 @@ [t] (clip/audio-tracks c :main)] (is (= [10 22] (:span t))) (is (= [50 62] (node/placed-span t))))))) + +(deftest an-instance-pivots-about-the-middle-of-what-it-draws + (let [square (fn [x y] {:kind :poly :z "a1" :id :sq + :channels {[:geom :pts] (ch/framed [x y (+ x 10) y (+ x 10) (+ y 10) x (+ y 10)]) + [:style :color] (ch/framed :brow)}}) + c (-> (clip/blank) + (assoc-in [:symbols :box] {:id :box :frames 4 :nodes {:sq (assoc (square 20 30) :id :sq)}}) + (assoc-in [:symbols :empty] {:id :empty :frames 4 :nodes {}})) + u #uuid "00000000-0000-4000-8000-0000000000cc" + placed (fn [c sid point] (get-in (clip/place-symbol c nil :main sid 0 u point) + [:symbols :main :nodes u :channels]))] + (is (= [25 35] (clip/center c nil :box)) "the middle of the square") + (is (= [160 100] (clip/center c nil :empty)) "nothing drawn: the stage's middle") + (testing "the anchor is the middle, and it moves nothing at the identity" + (is (= [25 35] (get-in (placed c :box nil) [[:xform :anchor] :value]))) + (is (= [0 0] (get-in (placed c :box nil) [[:xform :pos] :value])) + "dropped on the timeline: where it was drawn")) + (testing "dropped on a stage pixel, its middle goes there" + (is (= [75 65] (get-in (placed c :box [100 100]) [[:xform :pos] :value])))) + (testing "and growing the symbol later does not move an instance's pivot" + (let [c (clip/place-symbol c nil :main :box 0 u nil) + grown (assoc-in c [:symbols :box :nodes :sq2] (assoc (square 80 30) :id :sq2 :z "a2"))] + (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")))))