diff --git a/frontend/src/arthur/domain/clip.cljs b/frontend/src/arthur/domain/clip.cljs index e6d063f..ac7eefe 100644 --- a/frontend/src/arthur/domain/clip.cljs +++ b/frontend/src/arthur/domain/clip.cljs @@ -338,20 +338,54 @@ (audio-tracks clip (:of inst))))) (filter #(= :instance (:kind %)) (vals (:nodes sym))))))) -(defn frame-inside - "Carry frame `f` of symbol `sid` down through the nodes named by `path`, one - per level, the way a timeline row's path names them. Returns `[symbol frame]`: - the symbol the last node places, and the frame it is showing. +(defn inside + "Carry frame `f` of symbol `sid` down through the instances named by `path`, + one per level, the way a timeline row's path names them. Returns + `{:sid :frame :matrix}`: the symbol the last one places, the frame it is showing + there, and the matrix from its coordinates to `sid`'s — or nil when one of the + instances is not on screen at that frame, where there is no inside to be in. - Each step applies the node's own time map and its ancestors' in that symbol, - outermost first, which is the order `symbol/eval-frame` composes them in." - [clip sid path f] - (reduce (fn [[sid f] id] - (let [nodes (:nodes (symbol clip sid)) - f (reduce #(node/local-frame (get nodes %2) %1) - f (rseq (symbol/lineage nodes id)))] - [(:of (get nodes id)) (js/Math.floor f)])) - [sid f] path)) + Walked by RESOLVING each level, so the frame and the matrix are the ones the + stage draws with, time maps, parents and exposure included, rather than a + second account of them that could disagree." + [clip store sid path f] + (reduce (fn [{:keys [sid frame matrix]} id] + (let [r (symbol/resolver (symbol clip sid) store pal/index-of nil + {:source-fps (:fps clip)}) + _ (r frame) + m (symbol/world-of r id) + local (symbol/frame-of r id) + inner (get-in clip [:symbols sid :nodes id :of])] + (if (and m (number? local) inner (< -1 local (frames clip inner))) + {:sid inner :frame (js/Math.floor local) + :matrix (node/mul! (node/mat) matrix m)} + (reduced nil)))) + {:sid sid :frame f :matrix (node/mat)} + path)) + +(defn- invert + "The inverse of a 2x3 affine, or nil when it has none — an instance scaled to + nothing has no inside to draw into." + [^js m] + (let [[a b c d e f] (array-seq m) + det (- (* a d) (* b c))] + (when-not (zero? det) + (js/Float64Array. #js [(/ d det) (/ (- b) det) (/ (- c) det) (/ a det) + (/ (- (* c f) (* d e)) det) (/ (- (* b e) (* a f)) det)])))) + +(defn drawn-inside + "Flat points drawn on symbol `sid`'s stage at frame `f`, re-expressed inside the + symbol `path` leads to, so a shape added there lands exactly where it was drawn. + `{:sid :frame :pts}`, or nil where `inside` finds nothing to be inside." + [clip store sid path f pts] + (when-let [{:keys [matrix] :as at} (inside clip store sid path f)] + (when-let [inv (invert matrix)] + (let [out (js/Float64Array. 2)] + (assoc (select-keys at [:sid :frame]) + :pts (into [] (mapcat (fn [[x y]] + (node/apply-pt! out 0 inv x y) + [(aget out 0) (aget out 1)])) + (partition 2 pts))))))) (defn- transform-op "Put a symbol's already resolved mark into its instance's parent space." diff --git a/frontend/src/arthur/events/paint.cljs b/frontend/src/arthur/events/paint.cljs index b9fefd2..eaac934 100644 --- a/frontend/src/arthur/events/paint.cljs +++ b/frontend/src/arthur/events/paint.cljs @@ -7,8 +7,10 @@ (rf/reg-event-db ::new-shape - (fn [db [_ sid id points color]] - (edit/edit db #(paint/new-shape % sid id (get-in db [:playback :frame]) points color)))) + ;; `frame` is the symbol's own: a shape drawn into an instance starts on the + ;; frame that instance is showing, not the transport's. + (fn [db [_ sid id frame points color]] + (edit/edit db #(paint/new-shape % sid id frame points color)))) (rf/reg-event-db ::add-key diff --git a/frontend/src/arthur/events/ui.cljs b/frontend/src/arthur/events/ui.cljs index 97f1c13..bad7fe1 100644 --- a/frontend/src/arthur/events/ui.cljs +++ b/frontend/src/arthur/events/ui.cljs @@ -24,54 +24,6 @@ (fn [db [_ path]] (update-in db [:ui :expanded] #(if (contains? % path) (disj % path) (conj % path))))) -;; --------------------------------------------------------------------------- -;; drawing a polygon -;; -;; Three events and a vector of numbers. The draft is in app-db rather than in a -;; ratom because the stage draws it, the palette colours it and the params pane -;; reports its vertex count — and because a half-drawn shape surviving a hot -;; reload is worth more than the handful of dispatches it costs. Clicks are rare; -;; this is not the drag path. - -(rf/reg-event-db - ::begin-polygon - (fn [db _] (update db :ui merge {:tool :polygon :draft [] :selection nil}))) - -(rf/reg-event-db - ::cancel-polygon - (fn [db _] (update db :ui merge {:tool nil :draft []}))) - -(rf/reg-event-db - ::add-draft-point - (fn [db [_ x y]] - (if (= :polygon (get-in db [:ui :tool])) - (update-in db [:ui :draft] into [x y]) - db))) - -(rf/reg-event-fx - ::finish-polygon - (fn [{:keys [db]} _] - (let [draft (get-in db [:ui :draft])] - (if (< (count draft) 6) - {} - ;; `random-uuid` is the one impurity in this namespace, and it is here - ;; rather than in `domain/paint` for the reason `clip/place-symbol` spells - ;; out: a node's id is its identity in the saved document, so the pure - ;; layer must be handed one rather than invent one. If replaying the event - ;; log ever has to reproduce a document exactly, this becomes a cofx. - (let [id (keyword (str "paint-" (random-uuid))) - sid (get-in db [:ui :open])] - {:db (update db :ui merge {:tool nil :draft [] :selection [:node sid id]}) - :dispatch [::paint/new-shape sid id draft (get-in db [:ui :tone])]}))))) - -(rf/reg-event-db - ::set-knob - (fn [db [_ scope id knob value]] - (assoc-in db [:ui :knobs [scope id knob]] value))) - -;; --------------------------------------------------------------------------- -;; a new symbol - (defn- where-new-goes "The row path, from the open symbol down, of the symbol a new thing goes into: INSIDE the selected instance, or BESIDE any other selected node, or at the top @@ -88,21 +40,86 @@ (= :instance (get-in clip [:symbols sid :nodes id :kind])) path :else (pop path)))) +;; --------------------------------------------------------------------------- +;; drawing a polygon +;; +;; Three events and a vector of numbers. The draft is in app-db rather than in a +;; ratom because the stage draws it, the palette colours it and the params pane +;; reports its vertex count — and because a half-drawn shape surviving a hot +;; reload is worth more than the handful of dispatches it costs. Clicks are rare; +;; this is not the drag path. + +(rf/reg-event-db + ::begin-polygon + ;; The selection is KEPT: a selected instance is where the new shape will go. + (fn [db _] (update db :ui merge {:tool :polygon :draft []}))) + +(rf/reg-event-db + ::cancel-polygon + (fn [db _] (update db :ui merge {:tool nil :draft []}))) + +(rf/reg-event-db + ::add-draft-point + (fn [db [_ x y]] + (if (= :polygon (get-in db [:ui :tool])) + (update-in db [:ui :draft] into [x y]) + db))) + +(rf/reg-event-fx + ::finish-polygon + (fn [{:keys [db]} _] + (let [draft (get-in db [:ui :draft]) + open (get-in db [:ui :open]) + {clip :clip st :store} (store/entry (:clip/current db)) + down (where-new-goes clip db) + ;; Drawn on the stage, stored where it goes: inside the selected + ;; instance, re-expressed in that symbol's coordinates and frame so it + ;; lands exactly where it was drawn. + {:keys [sid frame pts]} (clip/drawn-inside clip st open down + (get-in db [:playback :frame]) draft)] + (cond + (< (count draft) 6) {} + (nil? sid) {:db (update db :project merge + {:status "the selected instance is not on screen at this frame"})} + ;; `random-uuid` is the one impurity in this namespace, and it is here + ;; rather than in `domain/paint` for the reason `clip/place-symbol` spells + ;; out: a node's id is its identity in the saved document, so the pure + ;; layer must be handed one rather than invent one. If replaying the event + ;; log ever has to reproduce a document exactly, this becomes a cofx. + :else + (let [id (keyword (str "paint-" (random-uuid)))] + {:db (-> db + (update :ui merge {:tool nil :draft [] + :selection [:node sid id (conj down id)]}) + (update-in [:ui :expanded] into (rest (reductions conj [] down)))) + :dispatch [::paint/new-shape sid id frame pts (get-in db [:ui :tone])]}))))) + +(rf/reg-event-db + ::set-knob + (fn [db [_ scope id knob value]] + (assoc-in db [:ui :knobs [scope id knob]] value))) + +;; --------------------------------------------------------------------------- +;; a new symbol + (rf/reg-event-db ::new-symbol (fn [db _] - (let [clip (:clip (store/entry (:clip/current db))) + (let [{clip :clip st :store} (store/entry (:clip/current db)) down (where-new-goes clip db) - [host frame] (clip/frame-inside clip (get-in db [:ui :open]) down - (get-in db [:playback :frame])) + {host :sid frame :frame} (clip/inside clip st (get-in db [:ui :open]) down + (get-in db [:playback :frame])) sid (clip/fresh-id clip) uuid (random-uuid)] - (-> db - (edit/edit #(clip/new-symbol % host sid frame uuid)) - (assoc-in [:ui :selection] [:node host uuid (conj down uuid)]) - ;; Open every row down to it, or the new row is inside a closed one and - ;; the button looks like it did nothing. - (update-in [:ui :expanded] into (rest (reductions conj [] down))))))) + (if-not host + (update db :project merge + {:status "the selected instance is not on screen at this frame"}) + (-> db + (edit/edit #(clip/new-symbol % host sid frame uuid)) + (assoc-in [:ui :selection] [:node host uuid (conj down uuid)]) + ;; Open every row down to it, or the new row is inside a closed one + ;; and the button looks like it did nothing. + (update-in [:ui :expanded] into (rest (reductions conj [] down)))))))) ;; --------------------------------------------------------------------------- ;; a drop in flight diff --git a/frontend/test/arthur/domain/instance_test.cljs b/frontend/test/arthur/domain/instance_test.cljs index 533952b..c9179ea 100644 --- a/frontend/test/arthur/domain/instance_test.cljs +++ b/frontend/test/arthur/domain/instance_test.cljs @@ -5,6 +5,7 @@ [arthur.domain.clip :as clip] [arthur.domain.leaf :as leaf] [arthur.domain.node :as node] + [arthur.domain.paint :as paint] [arthur.domain.pose :as pose] [arthur.domain.palette :as pal] [arthur.domain.symbol :as symbol])) @@ -266,10 +267,34 @@ (deftest a-frame-is-carried-down-through-the-instances-a-row-path-names (let [c (nested) - [id] (keys (get-in c [:symbols :outer :nodes]))] - (is (= [:outer 12] (clip/frame-inside c :outer [] 12))) - (is (= [:inner 7] (clip/frame-inside c :outer [id] 12)) - "the instance starts at 5, so frame 12 outside is frame 7 inside"))) + [id] (keys (get-in c [:symbols :outer :nodes])) + at #(select-keys (clip/inside c nil :outer %1 %2) [:sid :frame])] + (is (= {:sid :outer :frame 12} (at [] 12))) + (is (= {:sid :inner :frame 7} (at [id] 12)) + "the instance starts at 5, so frame 12 outside is frame 7 inside") + (is (nil? (clip/inside c nil :outer [id] 2)) + "and before it starts there is no inside to be in"))) + +(deftest a-shape-drawn-into-an-instance-lands-where-it-was-drawn + (let [u #uuid "00000000-0000-4000-8000-0000000000dd" + c (-> (clip/blank) + (assoc-in [:symbols :box] {:id :box :frames 30 :nodes {}}) + (clip/place-symbol nil :main :box 10 u nil) + ;; moved, turned and doubled, so nothing lines up by accident + (update-in [:symbols :main :nodes u :channels] merge + {[:xform :pos] (ch/framed [40 20]) + [:xform :rot] (ch/framed (/ js/Math.PI 2)) + [:xform :scale] (ch/framed [2 2])})) + drawn [100 50 140 50 120 90] + {:keys [sid frame pts]} (clip/drawn-inside c nil :main [u] 16 drawn) + c (paint/new-shape c sid :shape frame pts :brow) + [op] (filter #(= [u :shape] (:node %)) + ((clip/resolver c nil pal/index-of :main) 16))] + (is (= :box sid)) + (is (= 6 frame) "frame 16 of main is frame 6 of an instance placed at 10") + (is (every? #(< (js/Math.abs %) 1e-9) + (map - drawn (take 6 (array-seq (:pts op))))) + "resolved back out through the instance, it is exactly what was drawn"))) (deftest adopting-symbols-renames-what-collides (let [here (nested)