noe/arthur
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Group tracing layers in the pool and fit new drops to the stage

Browse source
This commit is contained in:
Olive Vaughn 2026-10-04 00:16:03 -04:00
parent f4dd047642
commit 1ae49a4015
3 changed files with 58 additions and 25 deletions
Download patch file Download diff file Expand all files Collapse all files

50
frontend/src/arthur/events/ui.cljs
View file

@ -1013,6 +1013,24 @@
result)]
(landed db where uuid result))))))
(defn- fitted
"Tracing placement `uuid` in symbol `sid` of `document`, sized so its picture
fits within `sid`'s stage, and — dropped on the timeline, with no point to
land on — middled on that stage rather than wherever the picture's own middle
happens to fall. A 1920px still is otherwise six stages tall.
A DEFAULT, set once, as the anchor is: nothing keeps it fitted afterwards."
[document sid uuid {:keys [width height]} point?]
(let [[w h] (clip/stage document sid)
k (min (/ w width) (/ h height))]
(update-in document [:symbols sid :nodes uuid :channels]
(fn [chs]
(cond-> (assoc chs [:xform :scale] (ch/framed [k k]))
(not point?)
(assoc [:xform :pos]
(ch/framed (mapv - [(/ w 2) (/ h 2)]
(:value (get chs [:xform :anchor]))))))))))
(rf/reg-event-db
::drop-symbol
;; A symbol dropped on a row becomes a naturally playing clip in the symbol that
@ -1028,29 +1046,15 @@
uuid (random-uuid)]
(if (:refused where)
(-> db (update :ui dissoc :drop) (update :project merge {:status (:refused where)}))
(landed db where uuid
(span/place-symbol (:clip where) st (:sid where)
uuid source-id (:at where)
{:extent :grow-symbol :point point
:remainder-id (random-uuid)}))))))
(defn- fitted
"Tracing placement `uuid` in symbol `sid` of `document`, sized so its picture
is as tall as `sid`'s stage, and — dropped on the timeline, with no point to
land on — middled on that stage rather than wherever the picture's own middle
happens to fall. A 1920px still is otherwise six stages tall.
A DEFAULT, set once, as the anchor is: nothing keeps it fitted afterwards."
[document sid uuid {:keys [height]} point?]
(let [[w h] (clip/stage document sid)
k (/ h height)]
(update-in document [:symbols sid :nodes uuid :channels]
(fn [chs]
(cond-> (assoc chs [:xform :scale] (ch/framed [k k]))
(not point?)
(assoc [:xform :pos]
(ch/framed (mapv - [(/ w 2) (/ h 2)]
(:value (get chs [:xform :anchor]))))))))))
(let [sym (clip/symbol document source-id)
result (span/place-symbol (:clip where) st (:sid where)
uuid source-id (:at where)
{:extent :grow-symbol :point point
:remainder-id (random-uuid)})]
(landed db where uuid
(cond-> result
(and (:clip result) (clip/trace? sym))
(update :clip fitted (:sid where) uuid sym (some? point)))))))))
(rf/reg-event-db
::drop-tracing

9
frontend/src/arthur/ui/pool.cljs
View file

@ -448,15 +448,17 @@
transition? #(or (= :palette (:type (clip/symbol document %)))
(contains? transition-ids %))
transitions (filterv #(and (named? %) (transition? %)) symbol-ids)
tracing (filterv #(and (named? %) (clip/trace? (clip/symbol document %)))
symbol-ids)
rest (filterv #(and (named? %) (not= main %)
(not (#{:palette :palette-track}
(not (#{:palette :palette-track :trace}
(:type (clip/symbol document %)))))
symbol-ids)
media (filterv #(hit? query (:label %)) media)
sounds (filterv #(hit? query (:label %)) sounds)
images (filterv #(hit? query (:label %)) images)]
[sections searching?
(+ (if top 1 0) (count rest) (count transitions)
(+ (if top 1 0) (count rest) (count transitions) (count tracing)
(count media) (count sounds) (count images))
[{:title "project" :searching? searching?
:blank "nothing to open yet"
@ -464,6 +466,9 @@
{:title "symbols" :searching? searching?
:blank "nothing else in the library"
:rows (mapv #(symbol-row document % ctx) rest)}
{:title "tracing layers" :searching? searching?
:blank "no tracing layers yet"
:rows (mapv #(symbol-row document % ctx) tracing)}
{:title "palette transitions" :searching? searching?
:blank "no palette transitions"
:rows (mapv #(palette-transition-row document % selection rename) transitions)}

24
frontend/test/arthur/domain/tracing_test.cljs
View file

@ -205,6 +205,30 @@
(is (= 1 (count (filter clip/trace? (vals (:symbols doc2))))))))))
;; ---------------------------------------------------------------------------
(deftest dropping-a-tracing-symbol-fits-only-the-new-placement
(doseq [point [nil [80 60]]]
(let [c (traced nil)
plate (get-in c [:symbols :face-1 :nodes :plate])
sid (node/source plate)
c (assoc-in c [:symbols sid :width] 3000)
id (store/install! {:clip c :store (:store @frozen)} "fit-pool-tracing")]
(reset! rf-db/app-db {:clip/current id :paint/revision 0
:ui {:open :main} :playback {:frame 0}})
(rf/dispatch-sync [::ui/drop-symbol sid 0 point nil])
(let [doc (:clip (store/entry id))
[_ host uuid] (get-in @rf-db/app-db [:ui :selection])
n (get-in doc [:symbols host :nodes uuid])
[w h] (clip/stage doc host)
k (min (/ w 3000) (/ h image-h))]
(is (= [k k] (get-in n [:channels [:xform :scale] :value])))
(is (= (or point [(/ w 2) (/ h 2)])
(mapv + (get-in n [:channels [:xform :pos] :value])
(get-in n [:channels [:xform :anchor] :value]))))
(is (= plate (get-in doc [:symbols :face-1 :nodes :plate]))
"the face's registered tracing placement is unchanged")
(is (= (clip/symbol c sid) (clip/symbol doc sid))
"the shared tracing symbol is unchanged")))))
;; on and off
(deftest switching-one-layer-on-switches-tracing-on