Port step 6: detect real footage with local MediaPipe

frontend/src/arthur/core.cljs

@@ -4,6 +4,7 @@
   port-plan step 3: the hand-written scene plays at 30fps against audio, scrubs,
   and runs at ½× and ¼×."
   (:require [arthur.db :as db]
+            [arthur.events.footage]
             [arthur.events.playback]
             [arthur.subs.playback]
             [arthur.subs.render]

frontend/src/arthur/db.cljs

@@ -23,7 +23,7 @@
   because there is one clip per scene today. Copying them by hand into this table
   is how one of them comes to disagree with the scene it describes."
   [label scene store]
-  (merge {:label label :scene scene :store store}
+  (merge {:label label :scene scene :store store :audio "/audio.wav"}
          (select-keys scene [:fps :frames :width :height])))
 
 (def scenes
@@ -50,7 +50,9 @@
    ;; footage's. That is what deleting `makeXform` buys — the framing became a
    ;; transform on a node, so nothing downstream of the freeze knows the frame
    ;; size — and it is why ui/player no longer hardcodes 320x200.
-   :clip    (select-keys (:take scenes) [:fps :frames :width :height])
+   :clip    (select-keys (:take scenes) [:fps :frames :width :height :audio])
+
+   :footage {:id nil :label nil :loading? false :status nil}
 
    ;; --- transport ---
    ;;

frontend/src/arthur/demo/take.cljs

@@ -1,8 +1,8 @@
 (ns arthur.demo.take
   "The synthetic take: the whole vertical slice, with no video file in it.
 
-  This is port-plan step 5's deliverable and it is the first thing in the tree
-  that runs every stage in order —
+  This is port-plan step 5's deliverable. `flow/take` now composes the shared
+  measurement path for both this generator and real footage —
 
       synth  ──▶  measure/anchor  ──▶  condition/anchor
                         │                     │
@@ -26,10 +26,8 @@
   written two ways. That is the claim \"stabilisation is a channel, not a mode\"
   made checkable by eye: switching between them is a document edit, tier 1, and
   not one byte of tier 2 differs."
-  (:require [arthur.flow.condition :as condition]
-            [arthur.flow.freeze :as freeze]
-            [arthur.flow.measure.anchor :as anchor]
-            [arthur.flow.measure.mouth :as mouth]
+  (:require [arthur.flow.freeze :as freeze]
+            [arthur.flow.take :as take]
             [arthur.synth :as synth]))
 
 (def frames 229)
@@ -51,14 +49,6 @@
   ;; anchor-test exercises 0.5625 and this does not.
   1)
 
-(def ^:private knobs
-  "The prototype's own defaults, from index.html, so the first thing anyone sees
-  is the thing it was tuned to look like."
-  {:anchor-avg   2       ; smoothWin
-   :contour-avg  1       ; contourSmooth
-   :verts        8       ; vertices
-   :aperture-cut 0.12})  ; apertureThresh 120/1000
-
 (def analysis
   "Stage 2's output, synthesised. A seeded generator, so a wrong pose is
   reproducible rather than something that happened once."
@@ -66,26 +56,13 @@
 
 (def measured
   "Stages 3 and 4, in the order the stage split requires."
-  (delay
-    (let [dense    @analysis
-          fitted   (anchor/fit {:aspect aspect} {:dense dense})
-          anchored (condition/anchor knobs fitted)
-          rings    (mouth/measure {:aspect aspect}
-                                  {:dense dense :transforms (:transforms anchored)})]
-      (assoc anchored
-             :outer (condition/contours knobs (:outer rings))
-             :inner (condition/contours knobs (:inner rings))
-             ;; NOT smoothed. The aperture is the inner ring's own height read off
-             ;; as a scalar, and `contour avg` is a spatial-correspondence
-             ;; smoother over a ring; running it over a scalar would be a second,
-             ;; undocumented low-pass on a signal that then decides visibility.
-             :aperture (:aperture rings)))))
+  (delay (take/measure (assoc take/knobs :aspect aspect) {:dense @analysis})))
 
 (def params
   "What the freeze was handed. Public because it is the honest way to re-freeze at
   other settings — a test that built its own copy would be asserting about a clip
   nobody looks at."
-  (merge knobs
+  (merge take/knobs
          {:name   "take"
           :fps    fps
           :stage  stage

frontend/src/arthur/events/footage.cljs

@@ -0,0 +1,114 @@
+(ns arthur.events.footage
+  "Load and freeze extracted footage once, outside the playback loop."
+  (:require [arthur.events.playback :as pb]
+            [arthur.flow.detect :as detect]
+            [arthur.flow.ingest :as ingest]
+            [arthur.flow.take :as take]
+            [arthur.footage.store :as store]
+            [re-frame.core :as rf]))
+
+(defn- detect-frames! [manifest model]
+  (let [canvas  (.createElement js/document "canvas")
+        ctx     (.getContext canvas "2d")
+        raw     (atom [])
+        dims    (atom nil)
+        total   (:frames manifest)
+        load-id (.now js/Date)]
+    (js/Promise.
+     (fn [resolve reject]
+       (letfn [(next-frame [i]
+                 (if (= i total)
+                   (try
+                     (resolve (assoc (detect/fill-gaps @raw) :dimensions @dims))
+                     (catch :default error (reject error)))
+                   (-> (ingest/image! (ingest/frame-url manifest i load-id))
+                       (.then
+                        (fn [image]
+                          (let [wh [(.-naturalWidth image) (.-naturalHeight image)]]
+                            (when (and @dims (not= @dims wh))
+                              (throw (ex-info (str "frame " (inc i) " has different dimensions")
+                                              {:expected @dims :actual wh})))
+                            (reset! dims wh)
+                            (set! (.-width canvas) (first wh))
+                            (set! (.-height canvas) (second wh))
+                            (.drawImage ctx image 0 0)
+                            (swap! raw conj (detect/detect! model canvas))
+                            (when (or (zero? i) (zero? (mod (inc i) 4)) (= (inc i) total))
+                              (rf/dispatch [::progress (str "detecting " (inc i) "/" total)]))
+                            ;; Let the status and the transport paint between sync
+                            ;; MediaPipe calls, and release each decoded PNG.
+                            (js/setTimeout #(next-frame (inc i)) 0))))
+                       (.catch reject))))]
+         (next-frame 0))))))
+
+(defn- build-clip [manifest {:keys [dense detected dimensions missing first-real]}]
+  (let [[w h] dimensions
+        params (merge take/knobs
+                      {:name "footage" :fps (:fps manifest) :aspect (/ w h)
+                       :stage [320 200] :expose 2 :head :as-filmed
+                       :analysis (str "mediapipe:1.0.1/" (:source manifest))})
+        frozen (take/build params {:dense dense :detected detected})
+        scene (:scene frozen)]
+    (assoc (select-keys scene [:fps :frames :width :height])
+           :scene scene :store (:store frozen)
+           ;; Re-extraction often overwrites audio.wav under the same name. A new
+           ;; URL makes the element fetch the new sound when this clip is loaded.
+           :audio (str (ingest/audio-url manifest) "?v=" (.now js/Date))
+           :label (or (:source manifest) "footage")
+           :summary (str (:frames manifest) " frames · " w "×" h " · "
+                         (:fps manifest) " fps"
+                         (when (pos? missing)
+                           (str " · " missing " without a face"
+                                (when (pos? first-real)
+                                  (str " (first found on " (inc first-real) ")"))))))))
+
+(rf/reg-fx
+ ::begin!
+ (fn [_]
+   (-> (ingest/manifest!)
+       (.then (fn [manifest]
+                (rf/dispatch [::progress "loading MediaPipe…"])
+                (-> (detect/landmarker!)
+                    (.then (fn [model]
+                             (rf/dispatch [::progress "loading frames…"])
+                             (-> (detect-frames! manifest model)
+                                 (.then (fn [track] (build-clip manifest track)))))))))
+       (.then (fn [entry]
+                (let [id (store/install! entry)]
+                  (rf/dispatch [::loaded id (:summary entry)]))))
+       (.catch (fn [error]
+                 (js/console.error error)
+                 (rf/dispatch [::failed (or (.-message error) (str error))]))))))
+
+(rf/reg-event-fx
+ ::load
+ (fn [{:keys [db]} _]
+   (if (get-in db [:footage :loading?])
+     {}
+     {:db (assoc db :footage (assoc (:footage db) :loading? true
+                                   :status "reading manifest.json…"))
+      ::pb/pause! nil
+      ::begin! nil})))
+
+(rf/reg-event-db
+ ::progress
+ (fn [db [_ message]] (assoc-in db [:footage :status] message)))
+
+(rf/reg-event-db
+ ::failed
+ (fn [db [_ message]]
+   (assoc db :footage (assoc (:footage db)
+                            :loading? false :status (str "load failed: " message)))))
+
+(rf/reg-event-fx
+ ::loaded
+ (fn [{:keys [db]} [_ id summary]]
+   (let [clip (store/entry id)]
+     {:db (-> db
+              (assoc :scene/current id
+                     :clip (select-keys clip [:fps :frames :width :height :audio])
+                     :footage {:id id :label (:label clip)
+                               :loading? false :status summary})
+              (assoc-in [:playback :frame] 0)
+              (assoc-in [:playback :playing?] false))
+      ::pb/pause! nil})))

frontend/src/arthur/events/playback.cljs

@@ -11,7 +11,7 @@
   a small app-db. If global interceptors are added later they are added to a
   chain these events are excluded from, not to `reg-global-interceptor`."
   (:require [arthur.clock :as clock]
-            [arthur.db :as db]
+            [arthur.footage.store :as footage]
             [re-frame.core :as rf]))
 
 (defn- fps [db] (get-in db [:clip :fps]))
@@ -92,12 +92,14 @@
    ;; Changing the clip changes the resolver, the frame count and the rate all
    ;; at once, so the playhead goes home rather than being left pointing at a
    ;; frame the new clip may not have.
-   (let [{:keys [fps frames] :as clip} (get db/scenes id)]
+   (let [{:keys [fps frames] :as clip} (footage/entry id)]
      {:db (-> db
               (assoc :scene/current id)
               ;; The stage travels with the clip: two clips may be different
               ;; sizes, and the raster the loop paints into is the clip's, not
               ;; the app's.
-              (assoc :clip (select-keys clip [:fps :frames :width :height]))
-              (assoc-in [:playback :frame] 0))
+              (assoc :clip (select-keys clip [:fps :frames :width :height :audio]))
+              (assoc-in [:playback :frame] 0)
+              (assoc-in [:playback :playing?] false))
+      ::pause! nil
       ::seek! [fps frames 0]})))

frontend/src/arthur/flow/detect.cljs

@@ -0,0 +1,58 @@
+(ns arthur.flow.detect
+  "The only MediaPipe boundary. Landmarks leave here as ordinary CLJS values.")
+
+(defonce ^:private instance (atom nil))
+(defonce ^:private pending (atom nil))
+
+(defn landmarker!
+  "Initialize once, using the vendored wasm and the local model. CPU also works
+  in browsers where a GPU delegate initializes but fails on its first frame."
+  []
+  (if-let [model @instance]
+    (js/Promise.resolve model)
+    (or @pending
+        (if-let [vision (aget js/window "Vision")]
+          (let [resolver (aget vision "FilesetResolver")
+                landmarker (aget vision "FaceLandmarker")
+                ready (-> (.call (aget resolver "forVisionTasks") resolver "/mediapipe/wasm")
+                        (.then (fn [fileset]
+                                 (.call (aget landmarker "createFromOptions")
+                                        landmarker fileset
+                                        #js {:baseOptions
+                                             #js {:modelAssetPath "/mediapipe/face_landmarker.task"
+                                                  :delegate "CPU"}
+                                             :runningMode "IMAGE"
+                                             :numFaces 1})))
+                        (.then (fn [model]
+                                 (reset! instance model)
+                                 model))
+                        (.catch (fn [e]
+                                  (reset! pending nil)
+                                  (throw e))))]
+            (reset! pending ready)
+            ready)
+          (js/Promise.reject (js/Error. "local MediaPipe script did not load"))))))
+
+(defn detect!
+  "Detect one already-drawn canvas frame. nil means no face was detected."
+  [model canvas]
+  (when-let [face (aget (aget (.call (aget model "detect") model canvas)
+                              "faceLandmarks") 0)]
+    (mapv (fn [p] {:x (.-x p) :y (.-y p) :z (.-z p)}) face)))
+
+(defn fill-gaps
+  "Keep the detection mask while supplying real poses for measurement. A leading
+  gap uses the first observed face; later gaps hold the previous observed pose.
+  Freeze uses the mask to mark those frames absent in the channel blocks."
+  [raw]
+  (let [first-real (first (keep-indexed (fn [i frame] (when frame i)) raw))]
+    (when-not first-real
+      (throw (ex-info "no face found in any frame — check framing and light" {})))
+    {:dense (loop [i 0 last-face (nth raw first-real) out []]
+              (if (= i (count raw))
+                out
+                (let [face (or (nth raw i) last-face)]
+                  (recur (inc i) face (conj out face)))))
+     :detected (mapv some? raw)
+     :missing (count (remove some? raw))
+     :first-real first-real}))

frontend/src/arthur/flow/ingest.cljs

@@ -0,0 +1,44 @@
+(ns arthur.flow.ingest
+  "Read a pre-extracted take. The manifest owns timing and the exact frame count."
+  (:require [clojure.string :as str]))
+
+(defn- valid-manifest [m]
+  (let [fps (js/Number (:fps m))
+        frames (js/Number (:frames m))]
+    (when-not (and (js/Number.isFinite fps) (pos? fps)
+                   (js/Number.isInteger frames) (<= 1 frames 900)
+                   (string? (:dir m)) (seq (:dir m))
+                   (string? (:audio m)) (seq (:audio m)))
+      (throw (ex-info "manifest.json needs fps, frames (1–900), dir and audio" {:manifest m})))
+    (assoc m :fps fps :frames frames)))
+
+(defn manifest!
+  []
+  (-> (js/fetch "/manifest.json" #js {:cache "no-store"})
+      (.then (fn [response]
+               (when-not (.-ok response)
+                 (throw (ex-info "manifest.json was not found; run extract.sh first"
+                                 {:status (.-status response)})))
+               (.json response)))
+      (.then (fn [json] (valid-manifest (js->clj json :keywordize-keys true))))))
+
+(defn- asset-url [path]
+  ;; Manifest paths are relative to the extraction root, served at / in dev.
+  (str "/" (str/replace path #"^/+" "")))
+
+(defn audio-url [manifest]
+  (asset-url (:audio manifest)))
+
+(defn frame-url [manifest i load-id]
+  (str (asset-url (str (str/replace (:dir manifest) #"/+$" "")
+                       "/" (.padStart (str (inc i)) 4 "0") ".png"))
+       "?v=" load-id))
+
+(defn image! [src]
+  (js/Promise.
+   (fn [resolve reject]
+     (let [image (js/Image.)]
+       (set! (.-onload image) #(resolve image))
+       (set! (.-onerror image) #(reject (ex-info (str "frame did not load: " src)
+                                                {:src src})))
+       (set! (.-src image) src)))))

frontend/src/arthur/flow/take.cljs

@@ -0,0 +1,26 @@
+(ns arthur.flow.take
+  "The shared landmark-to-channel path for synthetic and detected takes."
+  (:require [arthur.flow.condition :as condition]
+            [arthur.flow.freeze :as freeze]
+            [arthur.flow.measure.anchor :as anchor]
+            [arthur.flow.measure.mouth :as mouth]))
+
+(def knobs
+  {:anchor-avg 2 :contour-avg 1 :verts 8 :aperture-cut 0.12})
+
+(defn measure
+  "Condition the anchor before measuring rings through it."
+  [{:keys [aspect] :as params} {:keys [dense detected]}]
+  (let [fitted   (anchor/fit {:aspect aspect} {:dense dense})
+        anchored (condition/anchor params fitted)
+        rings    (mouth/measure {:aspect aspect}
+                                {:dense dense :transforms (:transforms anchored)})]
+    (assoc anchored
+           :outer (condition/contours params (:outer rings))
+           :inner (condition/contours params (:inner rings))
+           :aperture (:aperture rings)
+           :detected detected)))
+
+(defn build
+  [params inputs]
+  (freeze/clip params (measure params inputs)))

frontend/src/arthur/footage/store.cljs

@@ -0,0 +1,16 @@
+(ns arthur.footage.store
+  "Loaded clip artifacts live outside app-db. The db keeps only their id."
+  (:require [arthur.db :as db]))
+
+(defonce ^:private loaded (atom nil))
+(defonce ^:private serial (atom 0))
+
+(defn install! [entry]
+  (let [id (keyword "footage" (str (swap! serial inc)))]
+    (reset! loaded (assoc entry :id id))
+    id))
+
+(defn entry [id]
+  (if (= id (:id @loaded))
+    @loaded
+    (get db/scenes id)))

frontend/src/arthur/subs/playback.cljs

@@ -16,3 +16,5 @@
 ;; take their size from the document rather than from a constant.
 (rf/reg-sub ::width    (fn [db _] (get-in db [:clip :width])))
 (rf/reg-sub ::height   (fn [db _] (get-in db [:clip :height])))
+(rf/reg-sub ::audio    (fn [db _] (get-in db [:clip :audio])))
+(rf/reg-sub ::footage  (fn [db _] (:footage db)))

frontend/src/arthur/subs/render.cljs

@@ -7,14 +7,14 @@
   CLOSURE that produces geometry at a frame. So a scene edit costs one
   recomputation here and a frame costs a lookup and a blit — and, crucially, the
   playhead is not an input, so moving it cannot invalidate this."
-  (:require [arthur.db :as db]
-            [arthur.domain.palette :as pal]
+  (:require [arthur.domain.palette :as pal]
             [arthur.domain.scene :as scene]
+            [arthur.footage.store :as footage]
             [re-frame.core :as rf]))
 
 (rf/reg-sub ::scene-id (fn [db _] (:scene/current db)))
 
-(rf/reg-sub ::scene (fn [db _] (get-in db/scenes [(:scene/current db) :scene])))
+(rf/reg-sub ::scene (fn [db _] (:scene (footage/entry (:scene/current db)))))
 
 (rf/reg-sub
  ::exposure
@@ -49,7 +49,7 @@
    ;; Tier 2, behind a handle, and never in app-db itself — what is in the db is
    ;; the id of the clip whose blocks these are. The hand-written demo has none;
    ;; the swarm is entirely dense.
-   (get-in db/scenes [(:scene/current db) :store])))
+   (:store (footage/entry (:scene/current db)))))
 
 (rf/reg-sub
  ::resolver

frontend/src/arthur/ui/shell.cljs

@@ -7,6 +7,7 @@
   why scrubbing at speed does not re-render the page."
   (:require [arthur.clock :as clock]
             [arthur.db :as db]
+            [arthur.events.footage :as footage]
             [arthur.events.playback :as pb]
             [arthur.subs.playback :as sub]
             [arthur.subs.render :as render]
@@ -16,16 +17,17 @@
 (def ^:private zoom 2)
 
 (defn- audio []
-  [:audio
+  (let [src @(rf/subscribe [::sub/audio])]
+    [:audio
    {:ref      #(when % (clock/attach! %))
-    :src      "/audio.wav"
+    :src      src
     :preload  "auto"
     ;; Transport state follows the ELEMENT, not the other way round: the audio
     ;; is the clock, so anything that can change its state — the end of the
     ;; file, the OS media keys, a browser autoplay block — has to be able to
     ;; correct the document rather than be contradicted by it.
     :on-play  #(rf/dispatch [::pb/play])
-    :on-pause #(rf/dispatch [::pb/pause])}])
+    :on-pause #(rf/dispatch [::pb/pause])}]))
 
 (defn- transport []
   (let [playing? @(rf/subscribe [::sub/playing?])
@@ -33,7 +35,8 @@
         frame    @(rf/subscribe [::sub/frame])
         frames   @(rf/subscribe [::sub/frames])
         fps      @(rf/subscribe [::sub/fps])
-        expose   @(rf/subscribe [::render/exposure])]
+        expose   @(rf/subscribe [::render/exposure])
+        {:keys [id label loading? status]} @(rf/subscribe [::sub/footage])]
     [:div.transport
      [:div.row
       [:button {:on-click #(rf/dispatch [::pb/toggle])}
@@ -52,6 +55,13 @@
          [:button {:class    (when (= id @(rf/subscribe [::render/scene-id])) "on")
                    :on-click #(rf/dispatch [::pb/select-scene id])}
           label]))
+      (when id
+        [:button {:class (when (= id @(rf/subscribe [::render/scene-id])) "on")
+                  :on-click #(rf/dispatch [::pb/select-scene id])}
+         (or label "footage")])
+      [:button {:disabled loading?
+                :on-click #(rf/dispatch [::footage/load])}
+       (if loading? "loading…" "load frames")]
       [:span.gap]
       (doall
        (for [r db/rates]
@@ -77,7 +87,8 @@
         [:span {:class (when (and drop (> drop 1.35)) "warn")}
          (str (.toFixed (or fps 0) 1) " paint/s"
               (when (and drop (pos? drop))
-                (str " · " (.toFixed drop 2) " frames/paint")))])]]))
+                (str " · " (.toFixed drop 2) " frames/paint")))])]
+     (when status [:div.load-status status])]))
 
 (defn- stage []
   ;; The canvas is the STAGE's size, and the stage is the clip's — not a constant
@@ -98,5 +109,5 @@
    [audio]
    [transport]
    [:p.note
-    "Audio-clocked: the frame is ⌊currentTime · fps⌋, so a slow loop drops "
-    "frames instead of drifting. ½× and ¼× are playbackRate."]])
+    "Extract a clip with extract.sh, then load frames. The manifest supplies "
+    "the frame count, audio and fps."]])