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

Represent tracing media as symbols and add pool thumbnails

Browse source
This commit is contained in:
Olive Vaughn 2026-10-04 00:02:12 -04:00
parent 551d572347
commit 17e1b4f403
49 changed files with 1777 additions and 864 deletions
Download patch file Download diff file Expand all files Collapse all files

14
frontend/test/arthur/domain/node_test.cljs
View file

@ -116,6 +116,20 @@
(is (= [0 0 0 3 3 3] (mapv #(node/expose % 3) (range 6))))
(is (= 4 (node/expose 5 2)) "frame 5 at exposure 2 reads frame 4, not 6"))
(deftest a-hold-floors-onto-authored-frames
;; Exposure on frames somebody chose rather than on a grid: the last hold at or
;; before the frame, and before the first one the first.
(is (= [0 1 2 3] (mapv #(node/hold % []) (range 4))) "no holds is no floor")
(is (= [12 12 12 12 30 30] (mapv #(node/hold % [12 30]) [0 11 12 29 30 99])))
(is (= [0 0 12 12 30] (mapv #(node/hold % [0 12 30]) [0 11 12 29 30])))
(testing "after exposure, before the lead"
(is (= 13 (node/local-frame {:time {:holds [4 12] :expose 2 :offset 1}} 13))
"13 exposes to 12, holds at 12, and the lead adds 1"))
(testing "refused unless increasing"
(is (seq (node/problems {:id :n :kind :group :z "a" :time {:holds [3 1]}})))
(is (seq (node/problems {:id :n :kind :group :z "a" :time {:holds '(1 3)}})))
(is (empty? (node/problems {:id :n :kind :group :z "a" :time {:holds [1 3]}})))))
(deftest exposure-comes-before-offset-and-the-order-is-visible
;; THE INVARIANT: flooring onto a grid and shifting against the clock do not
;; commute. Shift first and the floor discards it on most frames, so the lead

14
frontend/test/arthur/domain/symbol_test.cljs
View file

@ -167,6 +167,20 @@
x-at #(first (first (pts-of (first (symbol/eval-frame s % nil pal/index-of nil)))))]
(is (= [0 0 0 0 4 4 4 4 8 8 8 8] (mapv x-at (range 12)))))))
(deftest holds-are-inherited-like-exposure
(let [walk (ch/keyed (into {} (map (fn [f] [f [f 0]])) (range 12)) :hold)
s (assoc (sc {:id :g :kind :group :z "a1" :time {:holds [2 7]}
:channels {[:xform :pos] walk}}
(poly :p :g "a1" [0 0 1 0 1 1] :skin-base))
:frames 12)
x-at #(first (first (pts-of (first (symbol/eval-frame s % nil pal/index-of nil)))))]
(is (= [2 2 2 2 2 2 2 7 7 7 7 7] (mapv x-at (range 12)))
"the group reads its held frame, before the first hold included")
(testing "and the playback path agrees"
(let [spec (ops/specified s nil) fast (ops/resolved s nil)]
(doseq [[label fs] (ops/orders 12) f fs]
(is (= (spec f) (fast f)) (str label " at frame " f)))))))
(deftest offset-is-per-node-which-is-the-entire-point-of-mouth-lead
;; Lead applies to performance nodes and NOT to the plate. If it were a clip
;; property the mouth would drag the whole head forward with it.

139
frontend/test/arthur/domain/trace_test.cljs
View file

@ -1,139 +0,0 @@
(ns arthur.domain.trace-test
(:require [cljs.test :refer [deftest is]]
[arthur.demo.take :as take]
[arthur.domain.clip :as clip]
[arthur.domain.leaf :as leaf]
[arthur.domain.nest :as nest]
[arthur.domain.node :as node]
[arthur.domain.palette :as pal]
[arthur.domain.symbol :as symbol]
[arthur.domain.trace :as trace]
[arthur.flow.freeze :as freeze]))
(def ^:private frozen (delay (freeze/head-mode {} @take/frozen)))
(def ^:private store (delay (:store @take/frozen)))
(defn- traced
"The synthetic take with face-1's trace set to `t`."
[t]
(assoc-in @frozen [:symbols :face-1 :nodes :head :trace] t))
(defn- head [c] (get-in c [:symbols :face-1 :nodes :head]))
(defn- near? [a b]
(every? #(< (js/Math.abs %) 1e-9) (map - a b)))
(deftest the-origin-picks-the-measured-frame-a-head-reads
(let [at (fn [t fs] (map #(trace/held-frame (trace/prepare t) %) fs))]
(is (nil? (trace/prepare {:frames [4 9] :origin :continuous})))
(is (nil? (trace/prepare nil)))
(is (= [0 0 0] (at {:frames [4 9] :origin :start} [0 5 50])))
(is (= [4 4 4 4 9 9] (at {:frames [4 9] :origin :keys} [0 3 4 8 9 50]))
"a jump at each key, and before the first the first")
(is (= [0 0] (at {:frames [] :origin :keys} [0 30])))))
(deftest every-origin-is-a-valid-document-that-saves
(doseq [origin trace/origins
:let [c (traced {:frames [0 12 40] :origin origin})]]
(is (empty? (clip/problems c)) (str origin ": " (pr-str (clip/problems c))))
(is (= c (leaf/clip "t" (leaf/leaves "t" c))) (str origin " round-trips"))))
(deftest a-trace-the-take-cannot-hold-will-not-save
(doseq [t [{:frames [0] :origin :sideways} {:frames [9 3] :origin :keys}
{:frames [9999] :origin :keys}]]
(is (seq (clip/problems (traced t))) (pr-str t))))
(deftest the-photo-holds-each-trace-frame-until-the-next
(let [t {:frames [5 20]}]
(is (= [5 5 5 5 20 20] (map #(trace/photo-frame t %) [0 4 5 19 20 90]))))
(is (= 33 (trace/photo-frame {:frames []} 33)) "no keys: every frame is its own")
(is (= [3 7] (:frames (trace/toggle-frame {:frames [7]} 3))))
(is (= [] (:frames (trace/toggle-frame {:frames [7]} 7)))))
(defn- photo-at
"The photo matrix of face-1 alone at frame `f`, the still being 1000px tall."
[c f]
(let [r (symbol/resolver (clip/symbol c :face-1) @store pal/index-of nil)
h (head c)]
(r f)
(vec (array-seq (trace/photo-matrix (symbol/world-of r :head) h @store
(trace/photo-frame (trace/of h) f) 1000)))))
(defn- filmed
"Where a photo sitting exactly where it was filmed must land: the face's OWN
placement, over image height, and nothing else.
`:place` carries the source-to-stage mapping now, above `:head` — so a face
opened in its own tab draws at the size it is on the stage, and its photo has
to come with it. That is the whole reason the mapping belongs to the face: the
head still cancels out, which is what these assertions are about, but it
cancels against a placement rather than against nothing."
[c f]
(let [r (symbol/resolver (clip/symbol c :face-1) @store pal/index-of nil)]
(r f)
(vec (array-seq (node/mul! (node/mat) (symbol/world-of r :place)
(js/Float64Array. #js [0.001 0 0 0.001 0 0]))))))
(deftest the-photo-registers-to-the-face-it-was-filmed-with
(let [a (traced {:frames [] :origin :continuous})
b (traced {:frames [12] :origin :keys})
d (traced {:frames [12] :origin :continuous})]
(is (near? (filmed a 30) (photo-at a 30))
"a head showing the photo's own frame cancels out")
(is (near? (filmed b 30) (photo-at b 30))
"held at the trace frame, face and photo both stand still")
(is (not (near? (filmed d 30) (photo-at d 30)))
"a continuous head carries the held photo along with it")))
(defn- wrapped
"Face-1's take placed, moved, inside a symbol :wrap."
[]
(assoc-in @frozen [:symbols :wrap]
{:id :wrap :frames 200
:nodes {:m {:id :m :kind :instance :z "a0"
:source {:symbol :main}
:channels {[:xform :pos] {:animated? false :value [30 -10]}}}}}))
(deftest a-face-switched-on-shows-wherever-it-is-placed
(let [c (wrapped)]
(is (= [{:path [:m :face-1] :in :main :face :face-1}] (trace/shown c :wrap #{:face-1}))
"a face inside a take inside a symbol, at the row path it is at")
(is (= [] (trace/shown c :wrap #{})) "and nothing when it is switched off")
(is (= [{:path [:face-1] :in :main :face :face-1}] (trace/shown c :main #{:face-1}))
"the same switch, one symbol down")
(is (= [{:path [] :in :face-1 :face :face-1}] (trace/shown c :face-1 #{:face-1}))
"the face open in its own tab is at no path at all — it IS the stage")
(is (= [] (trace/shown c :wrap #{:main}))
"a symbol that is not a face has no footage of its own to show")))
(deftest the-faces-that-can-be-traced-are-listed-once-each
(is (= [:face-1] (trace/traceable-faces (wrapped) :wrap)))
(is (= [:face-1] (trace/traceable-faces @frozen :main)) "the take it was frozen into")
(is (= [:face-1] (trace/traceable-faces @frozen :face-1)) "itself, open to draw over"))
(deftest a-face-opened-to-be-drawn-over-starts-with-its-footage-showing
(let [c (wrapped)]
(is (= #{:face-1} (trace/showing-for c :face-1 #{})) "the face's own tab")
(is (= #{} (trace/showing-for c :main #{}))
"and not the take it is placed in, which is the picture itself")
(is (= #{:face-1} (trace/showing-for c :main #{:face-1}))
"one already switched on stays on wherever you go")))
(deftest a-take-lists-the-faces-in-it
(is (= [{:path [:face-1] :in :main :face :face-1}] (trace/faces @frozen :main)))
(is (= [{:path [:m :face-1] :in :main :face :face-1}] (trace/faces (wrapped) :wrap)))
(is (= [] (trace/faces @frozen :face-1))))
(deftest the-resolver-says-where-a-nested-head-went-on-its-last-frame
;; The same answer as `nest/placement`, which walks and resolves the path all
;; over again — the resolver has it already, from drawing the frame.
(let [c (wrapped)
r (clip/resolver c :wrap @store pal/index-of nil)
path [:m :face-1 :head]]
(doseq [f [0 17 60]]
(r f)
(let [pl (nest/placement c @store :wrap path f)]
(is (near? (array-seq (:world pl)) (array-seq (symbol/world-of r path))) (str f))
(is (= (:frame pl) (js/Math.floor (symbol/frame-of r path))) (str f))))
(r 500)
(is (nil? (symbol/world-of r path)) "not on the frame, not anywhere")))

220
frontend/test/arthur/domain/tracing_test.cljs Normal file
View file

@ -0,0 +1,220 @@
(ns arthur.domain.tracing-test
"Tracing symbols: footage or a still to draw over, placed like any symbol and
never part of the picture — and a face's footage as one of them, under its head."
(:require [cljs.test :refer [deftest is testing]]
[arthur.demo.take :as take]
[arthur.domain.clip :as clip]
[arthur.domain.creation :as creation]
[arthur.domain.leaf :as leaf]
[arthur.domain.nest :as nest]
[arthur.domain.node :as node]
[arthur.domain.palette :as pal]
[arthur.domain.pick :as pick]
[arthur.domain.symbol :as symbol]
[arthur.events.ui :as ui]
[arthur.footage.store :as store]
[arthur.flow.freeze :as freeze]
[re-frame.core :as rf]
[re-frame.db :as rf-db]))
(def ^:private image-h 1000)
(def ^:private frozen
"The synthetic take frozen as though it had come from footage 1000px tall."
(delay (freeze/clip (assoc take/params :footage {:id "f00" :range [0 take/frames]
:width 1500 :height image-h})
{:face-1 @take/measured})))
(defn- traced
"The take with face-1's trace keys and origin set."
[t]
(freeze/head-mode {:trace t} @frozen))
(defn- near? [a b]
(every? #(< (js/Math.abs %) 1e-3) (map - a b)))
(defn- resolver [c sid opts]
(clip/resolver c sid (:store @frozen) pal/index-of opts))
(defn- traces-at [r f]
(filterv #(= :trace (:kind %)) (r f)))
;; ---------------------------------------------------------------------------
;; the document
(deftest a-freeze-from-footage-makes-a-tracing-symbol-and-places-it-under-the-head
(let [c (traced nil)
plate (get-in c [:symbols :face-1 :nodes :plate])]
(is (clip/trace? (clip/symbol c :footage)))
(is (= {:footage "f00" :range [0 take/frames]} (:media (clip/symbol c :footage))))
(is (= :head (:parent plate)) "the footage rides the head")
(is (= :footage (node/source plate)))
(is (node/measured? plate) "and is registered by the measurement, not by hand")
(is (empty? (clip/problems c)) (pr-str (clip/problems c)))
(is (= c (leaf/clip "t" (leaf/leaves "t" c))) "it saves and comes back")))
(deftest the-origin-writes-the-heads-reads-and-the-keys-the-plates-holds
(is (nil? (get-in (traced {:origin :continuous :frames [12]}) [:symbols :face-1 :nodes :head :reads])))
(is (= {:holds-of :plate} (get-in (traced {:origin :keys :frames [12]}) [:symbols :face-1 :nodes :head :reads])))
(is (= {:holds [0]} (get-in (traced {:origin :start}) [:symbols :face-1 :nodes :head :reads])))
(is (= [12 40] (get-in (traced {:origin :continuous :frames [12 40]})
[:symbols :face-1 :nodes :plate :time :holds]))
"the keys are the footage's whatever the head does"))
(deftest a-tracing-symbol-that-does-not-say-what-it-shows-will-not-load
(doseq [[why sym] [["nodes" {:nodes {:x {:id :x :kind :group :z "a"}}}]
["no media" {:media {}}]
["both" {:media {:footage "f" :image "i" :range [0 10]}}]
["short range" {:media {:footage "f" :range [0 9]}}]
["no size" {:width nil}]]]
(let [c (update-in (traced nil) [:symbols :footage] merge sym)]
(is (seq (clip/problems c)) why))))
(deftest reads-must-name-a-node-that-can-be-followed
(doseq [reads [{:holds-of :nowhere} {:holds-of :head} {:holds [3 1]}
{:holds [0] :holds-of :plate}]]
(is (seq (clip/problems (assoc-in (traced nil) [:symbols :face-1 :nodes :head :reads] reads)))
(pr-str reads))))
;; ---------------------------------------------------------------------------
;; registration
(defn- plate-at
"Face-1's footage op at frame `f`, its world matrix as a vector."
[c f]
(let [[op] (traces-at (resolver c :face-1 {:tracing? true}) f)]
(vec (array-seq (:m op)))))
(defn- filmed
"Where footage sitting exactly where it was filmed lands: the face's own
placement, over image height, and nothing else."
[c f]
(let [r (resolver c :face-1 nil)]
(r f)
(vec (array-seq (node/mul! (node/mat) (symbol/world-of r [:place])
(js/Float64Array. #js [(/ 1 image-h) 0 0 (/ 1 image-h) 0 0]))))))
(deftest the-footage-registers-to-the-face-it-was-filmed-with
(let [free (traced {:origin :continuous})
keyed (traced {:origin :keys :frames [12]})
ride (traced {:origin :continuous :frames [12]})
start (traced {:origin :start})]
(is (near? (filmed free 30) (plate-at free 30))
"a head reading the footage's own frame cancels out")
(is (near? (filmed keyed 30) (plate-at keyed 30))
"held at the key, face and footage both stand still where it was filmed")
(is (not (near? (filmed ride 30) (plate-at ride 30)))
"a continuous head carries the held footage along with it")
(is (= 12 (:frame (first (traces-at (resolver ride :face-1 {:tracing? true}) 30))))
"showing the held frame")
(is (not (near? (filmed start 60) (plate-at start 60)))
"footage under a head held at its start is stabilised, not where it was filmed")))
;; ---------------------------------------------------------------------------
;; never in the picture
(deftest only-the-stage-asks-for-tracing
(let [c (traced nil)]
(doseq [f [0 30 100]]
(is (empty? (traces-at (resolver c :main nil) f)) "an export, a centre, a thumbnail")
(is (= 1 (count (traces-at (resolver c :main {:tracing? true}) f))) "the stage"))))
(deftest a-trace-op-comes-up-through-every-instance-above-it
(let [c (assoc-in (traced nil) [:symbols :wrap]
{:id :wrap :frames 200
:nodes {:m {:id :m :kind :instance :z "a0" :source {:symbol :main}
:channels {[:xform :pos] {:animated? false :value [30 -10]}}}}})
inner (first (traces-at (resolver c :main {:tracing? true}) 20))
outer (first (traces-at (resolver c :wrap {:tracing? true}) 20))
moved (fn [m] (let [v (vec (array-seq m))] (-> v (update 4 + 30) (update 5 - 10))))]
(is (= [:m :face-1 :plate] (:node outer)) "named by its row path, as anything drawn is")
(is (= [:face-1 :plate] (:layer outer)) "and switched by where it is, not where it is placed")
(is (near? (moved (:m inner)) (vec (array-seq (:m outer)))))))
;; ---------------------------------------------------------------------------
;; a tracing layer placed by hand
(def ^:private still
{:id :still :name "ref" :type :trace :media {:image "abc"}
:frames 1 :fps 30 :width 400 :height 200 :nodes {}})
(defn- with-still []
(-> (clip/blank)
(assoc-in [:symbols :still] still)
(clip/place-symbol {} :main :still 0 :layer [160 100])
(update-in [:symbols :main :nodes :layer] assoc
:playback {:in 0 :speed 0 :end :hold} :span [0 120])))
(deftest a-still-is-placed-about-its-middle-and-shows-on-every-frame
(let [c (with-still)
r (clip/resolver c :main {} pal/index-of {:tracing? true})]
(is (empty? (clip/problems c)) (pr-str (clip/problems c)))
(is (= [200 100] (clip/center c {} :still)) "a tracing symbol's middle is its pixels'")
(doseq [f [0 50 119]]
(let [[op] (traces-at r f)]
(is (= 0 (:frame op)))
(is (= [-40 0] (vec (take 2 (drop 4 (array-seq (:m op))))))
(str "its middle on the drop point, frame " f))))))
(deftest nothing-is-created-inside-a-tracing-layer
(let [c (with-still)]
(is (= :main (:sid (creation/target c {} :main [:node :main :layer [:layer]] 10)))
"selecting a tracing layer creates beside it, as selecting a shape does")
(is (= "a tracing layer is a picture to draw over — nothing goes inside it"
(:refused (ui/drop-destination-at c {} :main 10 [:node :main :layer [:layer]]))))))
(deftest a-click-picks-what-is-drawn-before-a-reference
(let [trace {:kind :trace :node :layer :size [100 100]
:m (js/Float64Array. #js [0 1 -1 0 50 0])}
shape {:kind :rect :node :dot :cx 10 :cy 10 :size 4}]
(is (= [:dot] (pick/hit [shape trace] [10 10])) "drawn wins, though the photo is on top")
(is (= [:layer] (pick/hit [shape trace] [20 50])) "a reference where nothing is drawn")
(is (nil? (pick/hit [shape trace] [60 50])) "outside the turned image is outside it")))
(deftest a-held-layer-is-keyed-on-its-own-unfloored-frames
(let [c (assoc-in (traced {:origin :keys :frames [12]}) [:symbols :face-1 :nodes :plate :time :holds] [12])
t (nest/own-time c (:store @frozen) :face-1 [:plate] 30)]
(is (= 30 (* (:rate t) (- 30 (:at t)))) "frame 30 is 30, though it shows 12")))
(deftest a-dropped-still-lasts-the-rest-of-the-symbol-fits-it-and-is-reused
(let [id (store/install! {:clip (clip/blank) :store {}} "drop-tracing")
sym {:name "sheet" :type :trace :media {:image "abc"}
:width 400 :height 800 :nodes {}}
drop! (fn []
(rf/dispatch-sync [::ui/drop-tracing sym 30 nil nil])
(let [doc (:clip (store/entry id))
[_ _ uuid] (get-in @rf-db/app-db [:ui :selection])]
[doc (get-in doc [:symbols :main :nodes uuid])]))]
(reset! rf-db/app-db {:clip/current id :paint/revision 0
:ui {:open :main} :playback {:frame 30}})
(let [[doc n] (drop!)
sid (node/source n)
[w h] (clip/stage doc :main)
k (/ h 800)]
(is (empty? (clip/problems doc)) (pr-str (clip/problems doc)))
(is (clip/trace? (clip/symbol doc sid)))
(is (= (- (clip/frames doc :main) 30) (clip/frames doc sid))
"as long as what is left of the symbol it landed in")
(is (= [30 (clip/frames doc :main)] (node/placed-span n)))
(is (= [k k] (get-in n [:channels [:xform :scale] :value])) "as tall as the stage")
(is (= [(/ w 2) (/ h 2)] (mapv + (get-in n [:channels [:xform :pos] :value])
(get-in n [:channels [:xform :anchor] :value])))
"dropped on the timeline, it is middled on the stage")
(let [[doc2 n2] (drop!)]
(is (= sid (node/source n2)) "the same picture is the same symbol")
(is (= 1 (count (filter clip/trace? (vals (:symbols doc2))))))))))
;; ---------------------------------------------------------------------------
;; on and off
(deftest switching-one-layer-on-switches-tracing-on
(reset! rf-db/app-db {:ui {:tracing {:on? false :opacity 0.5 :hidden #{[:face-1 :plate]}}}})
(rf/dispatch-sync [::ui/show-trace [:face-1 :plate] true])
(is (= {:on? true :opacity 0.5 :hidden #{}} (get-in @rf-db/app-db [:ui :tracing])))
(testing "and switching one off leaves the rest alone"
(rf/dispatch-sync [::ui/show-trace [:face-1 :plate] false])
(is (= {:on? true :opacity 0.5 :hidden #{[:face-1 :plate]}} (get-in @rf-db/app-db [:ui :tracing]))))
(testing "from nothing"
(reset! rf-db/app-db {:ui {:tracing {:on? true}}})
(rf/dispatch-sync [::ui/show-trace [:s :n] false])
(is (= #{[:s :n]} (get-in @rf-db/app-db [:ui :tracing :hidden])))))

5
frontend/test/arthur/flow/freeze_test.cljs
View file

@ -249,8 +249,9 @@
path [[:xform :pos] [:xform :rot] [:xform :scale]]]
(is (= :dense (ch/describe (of c path))))
(is (= (of free path) (of c path)) "a trace does not copy measurements"))
(is (nil? (get-in (nodes free) [:head :trace])))
(is (= {:frames [12] :origin :keys} (get-in (nodes one) [:head :trace])))
(is (nil? (get-in (nodes free) [:head :reads])))
(is (= {:holds [12]} (get-in (nodes one) [:head :reads]))
"with no footage to follow, the head holds at the keys itself")
(is (= keyed (leaf/clip "head" (leaf/leaves "head" keyed)))
"the trace survives the document round trip")))

2
frontend/test/arthur/flow/multi_face_test.cljs
View file

@ -77,7 +77,7 @@
(channel after :face-2 :iris-r [:xform :pos])))
(is (= (channel before :face-2 :iris-l [:xform :pos])
(channel after :face-2 :iris-l [:xform :pos])))
(is (= {:origin :keys :frames [12]} (get-in anchored [:symbols :face-2 :nodes :head :trace])))
(is (= {:holds [12]} (get-in anchored [:symbols :face-2 :nodes :head :reads])))
(is (empty? (clip/problems anchored)))))
(deftest the-second-subject-regenerates-inside-a-composed-stage