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

frontend/src/arthur/events/ui.cljs

@@ -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
+       (let [sym (clip/symbol document source-id)
-               (span/place-symbol (:clip where) st (:sid where)
+             result (span/place-symbol (:clip where) st (:sid where)
-                                  uuid source-id (:at where)
+                                       uuid source-id (:at where)
-                                  {:extent :grow-symbol :point point
+                                       {:extent :grow-symbol :point point
-                                   :remainder-id (random-uuid)}))))))
+                                        :remainder-id (random-uuid)})]
-
+         (landed db where uuid
-(defn- fitted
+                 (cond-> result
-  "Tracing placement `uuid` in symbol `sid` of `document`, sized so its picture
+                   (and (:clip result) (clip/trace? sym))
-  is as tall as `sid`'s stage, and — dropped on the timeline, with no point to
+                   (update :clip fitted (:sid where) uuid sym (some? point)))))))))
-  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]))))))))))
 
 (rf/reg-event-db
  ::drop-tracing

frontend/src/arthur/ui/pool.cljs

@@ -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)}

frontend/test/arthur/domain/tracing_test.cljs

@@ -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