Add eyes brows and pixel-derived mouth interior to CLJS take

This commit is contained in:
Olive Vaughn 2026-09-27 19:48:42 -04:00
parent 06cf02db83
commit 663b7c367a
14 changed files with 735 additions and 47 deletions

View file

@ -16,8 +16,9 @@ modern conveniences belong in the workflow, not the output. See
## ClojureScript port
The active port has reached [step 6 of the port plan](docs/port-plan.md): it plays
the synthetic take and can load extracted real footage as a rotoscoped mouth.
The active port has reached [step 7 of the port plan](docs/port-plan.md): it plays
the synthetic take and can load extracted real footage with mouth, eyes, brows,
and pixel-derived teeth.
See [frontend/README.md](frontend/README.md) for setup and the **load frames**
workflow. The rest of this README describes the older JS prototype, which still
runs separately on port 8777.

View file

@ -2,12 +2,13 @@
Self-contained. You should not need any prior conversation to execute this.
**Implementation status (2026-09-27):** steps 0–6 are in the CLJS frontend.
**Implementation status (2026-09-27):** steps 0–7 are in the CLJS frontend.
Step 6 reads extracted footage from the manifest, detects landmarks with local
MediaPipe assets at full source cadence, and runs the same freeze path as the
synthetic take. The scene time map can sample the frozen roto at a lower picture
fps without changing source analysis, duration or audio. Step 7 is next: eyes,
brows and the pixel-derived mouth interior.
fps without changing source analysis, duration or audio. Step 7 adds dense
eyelids, shared gaze, brows and pixel-derived teeth. Step 8 is next: authored
parameter controls and their scoped recomputation.
## What arthur is
@ -320,7 +321,9 @@ measure-the-height-out-and-put-it-back is `[:geom :pts]` plus `[:xform :pos]`, t
channels on one node; and the iris is a `:disc` node parented to the lid ring and
stencilled by the sclera.
**Done:** parity with the JS tool, minus paint.
**Done:** the same face parts are measured and rendered through the CLJS scene,
minus paint. The fixed pixel thresholds remain provisional; step 8 exposes their
parameters for tuning without changing the source track or picture timing.
### 8 — knobs
The parameter UI, as leaf-addressed params in app-db

View file

@ -82,7 +82,7 @@ The demo scene itself is `src/arthur/demo/scene.edn`. Both the synthetic take
and real footage use `src/arthur/flow/take.cljs` for the measurement order and
`src/arthur/flow/freeze.cljs` for the landmark-to-channel conversion.
### Real footage (port step 6)
### Real footage (port steps 6–7)
From the repo root, extract a clip, then click **load frames** in the CLJS app:
@ -105,7 +105,8 @@ directory and enter its manifest path in the app:
`scratch/` is ignored by Git. The directory contains its own frames, audio and
manifest, so extracting it does not replace another take's files.
Loading detects one face per frame, freezes the measured mouth into channels,
Loading detects one face per frame, measures the mouth, eyes and brows from
landmarks and the teeth from source pixels, then freezes them into channels,
and adds a button for the footage clip. Detection happens once when you load;
playback only resolves channels and paints. Frames without a detection remain
marked absent even though their neighbouring poses are used to condition the
@ -135,9 +136,8 @@ it afterwards would bake the prototype's mistakes into the rewrite and make them
permanent. `docs/port-plan.md` says to delete it in one commit once the CLJS
player renders the synthetic take, and that is what happened.
`js/` itself stays. It is not an oracle any more, it is the SOURCE for steps 6
and 7 — the MediaPipe setup, the eye and brow signals, the interior extraction —
and its comments encode bugs that actually happened.
`js/` itself stays as the reference for the MediaPipe setup, face measurements
and pixel extraction. Its comments encode bugs that actually happened.
## Layout
@ -149,9 +149,8 @@ src/arthur/synth.cljs the synthetic track. In src/ because the take PLAYS it
video file before it shows you anything is one you
cannot debug.
src/arthur/demo.cljs the hand-written scene, read from demo/scene.edn
src/arthur/demo/take.cljs the seven stages composed in order, and the only place
they are
src/arthur/ui/canvas.cljs the one imperative sink — the only DOM canvas call
src/arthur/demo/take.cljs the synthetic source for the shared flow/take path
src/arthur/ui/canvas.cljs indexed raster blit to the display canvas
test/browser/ drives a real Chrome over CDP. Not run by `npm test`.
public/index.html dev host page. Django replaces it at step 9.
```

View file

@ -6,9 +6,9 @@
synth ──▶ measure/anchor ──▶ condition/anchor
│ │
└──▶ measure/mouth ◀─┘
└──▶ mouth, eyes, brows ◀─┘
│
condition/contours
condition/parts
│
FREEZE ──▶ channels on nodes
│
@ -56,7 +56,8 @@
(def measured
"Stages 3 and 4, in the order the stage split requires."
(delay (take/measure (assoc take/knobs :aspect aspect) {:dense @analysis})))
(delay (take/measure (assoc take/knobs :aspect aspect :fps fps)
{:dense @analysis})))
(def params
"What the freeze was handed. Public because it is the honest way to re-freeze at

View file

@ -3,14 +3,17 @@
(:require [arthur.events.playback :as pb]
[arthur.flow.detect :as detect]
[arthur.flow.ingest :as ingest]
[arthur.flow.measure.interior :as interior]
[arthur.flow.take :as take]
[arthur.footage.store :as store]
[arthur.domain.landmarks :as lm]
[re-frame.core :as rf]))
(defn- detect-frames! [manifest model]
(let [canvas (.createElement js/document "canvas")
ctx (.getContext canvas "2d")
raw (atom [])
interiors (atom [])
dims (atom nil)
total (:frames manifest)
load-id (.now js/Date)]
@ -19,7 +22,8 @@
(letfn [(next-frame [i]
(if (= i total)
(try
(resolve (assoc (detect/fill-gaps @raw) :dimensions @dims))
(resolve (assoc (detect/fill-gaps @raw)
:dimensions @dims :interior @interiors))
(catch :default error (reject error)))
(-> (ingest/image! (ingest/frame-url manifest i load-id))
(.then
@ -32,7 +36,17 @@
(set! (.-width canvas) (first wh))
(set! (.-height canvas) (second wh))
(.drawImage ctx image 0 0)
(swap! raw conj (detect/detect! model canvas))
(let [face (detect/detect! model canvas)
ring (when face (mapv #(nth face %) lm/LIPS-INNER))
box (when ring
(interior/crop ring wh (:cavity-erode take/knobs)))
measured (if box
(interior/measure take/knobs box
(.getImageData ctx (:x box) (:y box)
(:w box) (:h box)))
{:contour nil :contrast 0 :area 0 :debug nil})]
(swap! raw conj face)
(swap! interiors conj measured))
(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
@ -41,10 +55,10 @@
(.catch reject))))]
(next-frame 0))))))
(defn- build-clip [manifest {:keys [dense detected dimensions missing first-real]}]
(defn- build-clip [manifest {:keys [dense detected dimensions interior missing first-real]}]
(let [[w h] dimensions
frozen (take/footage manifest {:dense dense :detected detected
:dimensions dimensions})
:dimensions dimensions :interior interior})
scene (:scene frozen)]
(assoc (select-keys scene [:fps :frames :width :height])
:display-fps (:fps scene)

View file

@ -1,14 +1,14 @@
(ns arthur.flow.condition
"Stage 4: the two smoothing knobs, and nothing else.
"Stage 4: reusable temporal conditioning of measured signals.
It is a stage of its own for exactly one reason. `anchor avg` and `contour avg`
are knobs and the rest of measure is not, so dragging either must not re-run the
interior extraction — the one part of measure that reads a source pixel, and the
only part that costs seconds.
Neither function knows what it is smoothing. `anchor` smooths four transform
parameters and `contours` smooths a ring track per vertex; a face appears
nowhere in here."
`anchor` smooths four transform parameters and `contours` smooths a ring track
per vertex. Median rest positions, grid dwell and blink holds also operate on
measurements without reading footage pixels or depending on a scene node."
(:require [arthur.domain.geom :as geom]))
(defn anchor
@ -48,3 +48,42 @@
(range (count (first rings))))]
(mapv (fn [t] (mapv (fn [[xs ys]] {:x (nth xs t) :y (nth ys t)}) axes))
(range (count rings))))))
(defn median-point
"A rest position per axis, resistant to a few extreme poses."
[points]
(let [median (fn [xs]
(let [v (vec (sort xs)) n (count v)]
(if (odd? n) (nth v (quot n 2))
(/ (+ (nth v (dec (quot n 2))) (nth v (quot n 2))) 2))))]
{:x (median (map :x points)) :y (median (map :y points))}))
(defn quantize-snap
"Snap a two-axis signal to a grid, accepting a new cell after its dwell."
[points step dwell]
(let [snap (fn [v] (* (js/Math.round (/ v step)) step))]
(if (not (pos? step))
(vec points)
(let [q (mapv (fn [{:keys [x y]}] {:x (snap x) :y (snap y)}) points)]
(loop [remaining q live (first q) pending (first q) run 0 out []]
(if-let [p (first remaining)]
(let [same? (= p pending)
pending (if same? pending p)
run (if same? (inc run) 1)
live (if (and (> run dwell) (not= pending live)) pending live)]
(recur (rest remaining) live pending run (conj out live)))
out))))))
(defn resolve-blink
"Hysteresis, dwell and minimum shut hold. The hold is specified in source
frames and is applied before a lower picture fps samples the result."
[openness {:keys [cut dwell hold]}]
(loop [readings openness live false run 0 held 0 out []]
(if-let [v (first readings)]
(let [reading (< v (if live (* cut 1.35) cut))
run (if (= reading live) 0 (inc run))
change? (and (> run dwell) (or (not live) (>= held hold)))
live (if change? reading live)
held (if change? 1 (inc held))]
(recur (rest readings) live (if change? 0 run) held (conj out live)))
out)))

View file

@ -0,0 +1,46 @@
(ns arthur.flow.condition.brows
"Condition measured brow shape and end heights in head-local space."
(:require [arthur.domain.ring :as ring]
[arthur.flow.condition :as condition]))
(defn- distance [a b]
(js/Math.hypot (- (:x a) (:x b)) (- (:y a) (:y b))))
(defn- clamp01 [x] (max 0 (min 1 x)))
(defn- conditioned-side [rings raises corners
{:keys [fps contour-avg brow-gain brow-step brow-weight]}]
(let [fps (or fps 30)
rings (condition/contours {:contour-avg contour-avg} rings)
w (/ (reduce + (map (fn [[a b]] (distance a b)) corners))
(count corners))
rest (condition/median-point raises)
px (mapv (fn [{:keys [x y]}]
{:x (* (- x (:x rest)) brow-gain w)
:y (* (- y (:y rest)) brow-gain w)}) raises)
cells (condition/quantize-snap px (* brow-step w)
(js/Math.round (* fps 0.08)))]
(let [frames (mapv (fn [shape [outer inner] measured snapped]
(let [d-outer (- (:x measured) (:x snapped))
d-inner (- (:y measured) (:y snapped))
move (/ (+ d-outer d-inner) 2)
span (- (:x inner) (:x outer))
warped (mapv (fn [p]
(let [t (if (< (abs span) 1e-9) 0
(clamp01 (/ (- (:x p) (:x outer)) span)))]
(update p :y + (+ (- d-outer move)
(* (- d-inner d-outer) t)))))
shape)]
{:ring (ring/offset-ring warped (* brow-weight w))
:pos [0 move]}))
rings corners px cells)]
{:rings (mapv :ring frames) :positions (mapv :pos frames)})))
(defn apply-defaults
[params {:keys [ring-r ring-l raise-r raise-l] :as measured}
{:keys [corners-r corners-l]}]
(let [r (conditioned-side ring-r raise-r corners-r params)
l (conditioned-side ring-l raise-l corners-l params)]
(assoc measured
:ring-r (:rings r) :ring-l (:rings l)
:pos-r (:positions r) :pos-l (:positions l))))

View file

@ -0,0 +1,50 @@
(ns arthur.flow.condition.eyes
"Condition measured eyes while preserving every source frame. Lid geometry
stays dense; blink and shared gaze are decisions over those measurements."
(:require [arthur.domain.ring :as ring]
[arthur.flow.condition :as condition]))
(defn- distance [a b]
(js/Math.hypot (- (:x a) (:x b)) (- (:y a) (:y b))))
(defn- socket [lid]
(let [a (first lid) b (nth lid (quot (count lid) 2))]
{:x (/ (+ (:x a) (:x b)) 2)
:y (/ (+ (:y a) (:y b)) 2)
:w (distance a b)}))
(defn- mean-width [lids]
(/ (reduce + (map (comp :w socket) lids)) (count lids)))
(defn apply-defaults
[{:keys [fps contour-avg blink-cut gaze-gain gaze-step iris-size
lash-weight pupil-size]} {:keys [lid-r lid-l open-r open-l gaze]
:as measured}]
(let [fps (or fps 30)
right (condition/contours {:contour-avg contour-avg} lid-r)
left (condition/contours {:contour-avg contour-avg} lid-l)
w-r (mean-width right)
w-l (mean-width left)
w (/ (+ w-r w-l) 2)
rest (condition/median-point gaze)
px (mapv (fn [{:keys [x y]}]
{:x (* (- x (:x rest)) gaze-gain w)
:y (* (- y (:y rest)) gaze-gain w)}) gaze)
cells (condition/quantize-snap px (* gaze-step w)
(js/Math.round (* fps 0.08)))
centres (fn [lids]
(mapv (fn [lid shift]
(let [{:keys [x y]} (socket lid)]
[ (+ x (:x shift)) (+ y (:y shift)) ]))
lids cells))
blink {:cut blink-cut :dwell 0 :hold (max 2 (js/Math.ceil (* fps 0.1)))}]
(assoc measured
:lid-r right :lid-l left
:lash-r (mapv #(ring/offset-ring % (* lash-weight w-r)) right)
:lash-l (mapv #(ring/offset-ring % (* lash-weight w-l)) left)
:shut-r (condition/resolve-blink open-r blink)
:shut-l (condition/resolve-blink open-l blink)
:iris-r (centres right) :iris-l (centres left)
:radius-r (* 0.5 iris-size w-r)
:radius-l (* 0.5 iris-size w-l)
:pupil-size (* pupil-size w))))

View file

@ -0,0 +1,44 @@
(ns arthur.flow.condition.interior
"Teeth presence and temporal contour conditioning. The contrast measurement
remains available for diagnosis; visibility is an editable freeze decision."
(:require [arthur.domain.geom :as geom]))
(defn apply-defaults
[{:keys [fps teeth-on teeth-dwell teeth-smooth aperture-cut]}
measures aperture]
(let [peak (reduce max aperture)
dwell (or teeth-dwell (js/Math.round (* (or fps 30) 0.08)))
raw (mapv (fn [m a]
(if (and (:contour m) (pos? peak)
(>= (/ a peak) aperture-cut))
(:contrast m) 0))
measures aperture)
shown (loop [f 0 live false since 0 out []]
(if (= f (count raw))
out
(let [want (> (nth raw f) (if live (* teeth-on 0.7) teeth-on))
change? (and (not= want live) (>= since dwell))
live (if change? want live)
since (if change? 0 (inc since))]
(recur (inc f) live since
(conj out (and live (some? (:contour (nth measures f)))))))))
contours (mapv :contour measures)
smoothed (mapv (fn [f points]
(if (or (nil? points) (not (nth shown f))
(zero? teeth-smooth))
points
(let [near (keep (fn [j]
(let [k (max 0 (min (dec (count contours)) j))]
(when (and (nth shown k)
(= (count points)
(count (nth contours k))))
(nth contours k))))
(range (- f teeth-smooth)
(inc (+ f teeth-smooth))))]
(if (seq near)
(mapv geom/centroid (apply map vector near))
points))))
(range (count contours)) contours)]
{:contours smoothed :shown shown
:contrast (mapv :contrast measures)
:debug (mapv :debug measures)}))

View file

@ -29,9 +29,9 @@
Project dimensions are therefore independent of the footage — see
`face-placement`, and \"What space geometry is in\" in docs/animation-model.md.
Not `flow/key`. A traced mouth costs nothing, so it gets a key on EVERY frame;
only a plate, which a human draws, is worth decimating. The one stage-5 policy
the mouth does want is the aperture threshold, and that is `visibility` below."
Not `flow/key`. Traced lips, lids and brows keep every source frame; only a
plate, which a human draws, is worth decimating. Sparse visibility keys capture
decisions about the mouth cavity, blink and teeth without thinning geometry."
(:require [arthur.domain.channel :as ch]
[arthur.domain.geom :as geom]
[arthur.domain.ring :as ring]))
@ -272,19 +272,31 @@
(range (count shown))))
:generated generated)))
(defn- keyed-visibility [values generated]
(assoc (ch/keyed (into {} (keep (fn [f]
(when (or (zero? f)
(not= (nth values f) (nth values (dec f))))
[f (nth values f)])))
(range (count values))))
:generated generated))
;; ---------------------------------------------------------------------------
;; the face, onto the stage
(defn- motion-placement
"An editable default framing for a real take. Fit the observed eye/nose and
mouth motion within the stage; otherwise a downward head move can push the
mouth below a fixed 320×200 canvas even while it stays in the source image."
[[w h] {:keys [rigid transforms outer detected]}]
"An editable default framing for a real take. Fit every drawn face feature's
observed motion inside the stage, including raised brows and a moving mouth."
[[w h] {:keys [rigid transforms outer eyes brows detected]}]
(let [points (mapcat (fn [i]
(when (or (nil? detected) (nth detected i))
(let [local (concat (nth outer i)
(when eyes (concat (nth (:lash-r eyes) i)
(nth (:lash-l eyes) i)))
(when brows (concat (nth (:ring-r brows) i)
(nth (:ring-l brows) i))))]
(concat (nth rigid i)
(geom/apply-sim-all (invert (nth transforms i))
(nth outer i)))))
local)))))
(range (count outer)))
xs (map :x points)
ys (map :y points)
@ -310,8 +322,8 @@
vertex, where nothing could ever revise it.
The synthetic take uses the reference rigid configuration for its default.
Real footage can request `:fit-motion?`: its default fits the observed rigid
and lip motion in the stage so a head move does not send the mouth off canvas.
Real footage can request `:fit-motion?`: its default fits the observed mouth,
eyes and brows in the stage across the shot.
Both are ordinary editable transforms on :face, never baked into the geometry.
The face oval is not measured, because its only consumers in the prototype were
the old baked framing transform and the placeholder plate outline.
@ -346,6 +358,107 @@
[:xform :pos] (ch/framed [(- (/ w 2) (:x c))
(- (* 0.25 h) (:y c))])})))
(defn- feature-parts
"Freeze eyes and brows into their own dense blocks and scene nodes. This owns
only representation: the landmark correspondence, blink and pose choices have
already been settled by measure and condition."
[name absent {:keys [eye-verts brow-verts analysis contour-avg anchor-avg]}
{:keys [eyes brows]}]
(let [eye-k (str name "/eyes")
iris-k (str name "/iris-pos")
brow-k (str name "/brows")
brow-pos-k (str name "/brow-pos")
provenance (fn [by extra]
{:by by :analysis analysis
:params (merge {:anchor-avg anchor-avg :contour-avg contour-avg}
extra)})
eye-block (pack {:ctor #(js/Int16Array. %) :scale geom-scale :absent absent}
(mapv #(rings->flat % eye-verts)
[(:lash-r eyes) (:lid-r eyes)
(:lash-l eyes) (:lid-l eyes)]))
iris-block (pack {:ctor #(js/Float32Array. %) :absent absent}
[(:iris-r eyes) (:iris-l eyes)])
brow-block (pack {:ctor #(js/Int16Array. %) :scale geom-scale :absent absent}
(mapv #(rings->flat % brow-verts)
[(:ring-r brows) (:ring-l brows)]))
brow-pos-block (pack {:ctor #(js/Float32Array. %) :absent absent}
[(:pos-r brows) (:pos-l brows)])
eye-node (fn [id z track]
{:id id :name (clojure.core/name id) :kind :poly :parent :head :z z
:channels {[:geom :pts] (dense eye-k eye-block track
(provenance :roto/eyelid {:verts eye-verts}))
[:style :color] (ch/framed :skin-dark)}})
inner-node (fn [id parent z track shut]
{:id id :name (clojure.core/name id) :kind :poly :parent parent :z z
:channels {[:geom :pts] (dense eye-k eye-block track
(provenance :roto/eye-opening
{:verts eye-verts}))
[:style :color] (ch/framed :eye-white)
[:vis] (keyed-visibility (mapv not shut)
(provenance :roto/blink nil))}})
iris-node (fn [id parent track radius]
{:id id :name (clojure.core/name id) :kind :disc :parent parent :z "a1"
:stencil parent
:channels {[:xform :pos] (dense iris-k iris-block track
(provenance :roto/gaze nil))
[:geom :radius] (ch/framed radius)
[:style :color] (ch/framed :iris)}})
pupil-node (fn [id parent]
{:id id :name (clojure.core/name id) :kind :rect :parent parent :z "a1"
:stencil parent
:channels {[:geom :size] (ch/framed (:pupil-size eyes))
[:style :color] (ch/framed :pupil)}})
brow-node (fn [id z track]
{:id id :name (clojure.core/name id) :kind :poly :parent :head :z z
:channels {[:geom :pts] (dense brow-k brow-block track
(provenance :roto/brow {:verts brow-verts}))
[:xform :pos] (dense brow-pos-k brow-pos-block track
(provenance :roto/brow-raise nil))
[:style :color] (ch/framed :brow)}})]
{:nodes {:eye-r (eye-node :eye-r "a2" 0)
:eye-r-in (inner-node :eye-r-in :eye-r "a1" 1 (:shut-r eyes))
:iris-r (iris-node :iris-r :eye-r-in 0 (:radius-r eyes))
:pupil-r (pupil-node :pupil-r :iris-r)
:eye-l (eye-node :eye-l "a3" 2)
:eye-l-in (inner-node :eye-l-in :eye-l "a1" 3 (:shut-l eyes))
:iris-l (iris-node :iris-l :eye-l-in 1 (:radius-l eyes))
:pupil-l (pupil-node :pupil-l :iris-l)
:brow-r (brow-node :brow-r "a4" 0)
:brow-l (brow-node :brow-l "a5" 1)}
:store {eye-k (select-keys eye-block [:data :state])
iris-k (select-keys iris-block [:data :state])
brow-k (select-keys brow-block [:data :state])
brow-pos-k (select-keys brow-pos-block [:data :state])}}))
(defn- interior-part
"Freeze the pixel-derived radial contour under the mouth cavity. Missing
contours use the dense block's absence bit; contrast decides editable :vis."
[name {:keys [analysis teeth-verts cavity-erode tongue-reject blob-grow
top-bias teeth-on teeth-smooth]} detected
{:keys [contours shown]}]
(let [key (str name "/teeth")
absent #(or (nil? (nth contours %))
(and detected (not (nth detected %))))
empty-points (vec (repeat (* 2 teeth-verts) 0))
values (mapv (fn [ring]
(if ring
(into [] (mapcat (juxt :x :y)) ring)
empty-points)) contours)
block (pack {:ctor #(js/Int16Array. %) :scale geom-scale :absent absent}
[values])
generated {:by :pixels/teeth :analysis analysis
:params {:cavity-erode cavity-erode
:tongue-reject tongue-reject :blob-grow blob-grow
:top-bias top-bias :teeth-verts teeth-verts
:teeth-on teeth-on :teeth-smooth teeth-smooth}}]
{:nodes {:teeth
{:id :teeth :name "teeth" :kind :poly :parent :mouth-in :z "a1"
:stencil :mouth-in
:channels {[:geom :pts] (dense key block 0 generated)
[:style :color] (ch/framed :teeth)
[:vis] (keyed-visibility shown generated)}}}
:store {key (select-keys block [:data :state])}}))
;; ---------------------------------------------------------------------------
;; the clip
@ -363,6 +476,8 @@
observed feature motion on stage
:expose the clip root's exposure grid, inherited by everything
:verts the lip rings' vertex budget
:eye-verts the eyelid rings' vertex budget
:brow-verts the brow rings' vertex budget
:aperture-cut fraction of the take's peak aperture below which the mouth
interior is not present
:head :locked | :as-filmed | :per-plate
@ -377,6 +492,8 @@
:ref the Procrustes reference configuration
:transforms the CONDITIONED anchor transforms
:outer :inner the CONDITIONED head-local lip rings
:eyes :brows the CONDITIONED head-local feature measurements
:teeth optional pixel-derived, conditioned radial contour
:aperture head-local aperture per frame
:detected optional per-frame booleans; absent frames get the state mask
@ -388,6 +505,12 @@
:head MEASURED. the head's motion, or identity.
:mouth
:mouth-in
:teeth
:eye-r / :eye-l
:eye-*-in
:iris-*
:pupil-*
:brow-r / :brow-l
`:mouth-in`'s parent is `:mouth` and that transform is identity today, so
composing it is composing identity. It is documented intent, and it is the one
@ -399,7 +522,7 @@
provenance having to be rebuilt."
[{:keys [name fps stage expose verts aperture-cut head kept
analysis anchor-avg contour-avg] :as params}
{:keys [transforms outer inner detected] :as inputs}]
{:keys [transforms outer inner detected eyes brows teeth] :as inputs}]
(let [nf (count outer)
absent (when detected #(not (nth detected % true)))
geom-k (str name "/geom")
@ -425,6 +548,8 @@
;; measure reports the inner ring's own height and nothing smooths it.
anchor-prov (prov :anchor/similarity nil)
roto (fn [by] (prov by {:verts verts :contour-avg contour-avg}))
features (when (and eyes brows) (feature-parts name absent params inputs))
interior (when teeth (interior-part name params detected teeth))
scene {:name name
:frames nf
:fps fps
@ -433,6 +558,7 @@
:width (first stage)
:height (second stage)
:nodes
(merge
{:root
{:id :root :name "clip" :kind :group :parent nil :z "a1"
:time {:mode :map :expose expose}}
@ -463,12 +589,14 @@
[:style :color] (ch/framed :mouth-dark)
[:vis] (visibility params inputs
(prov :roto/mouth-aperture
{:aperture-cut aperture-cut}))}}}}
{:aperture-cut aperture-cut}))}}}
(:nodes features) (:nodes interior))}
;; Tier 2, behind a handle. The keys are descriptive because there is no
;; hashing yet; they become the blocks' sha256 when the backend arrives
;; and nothing above here changes, which is the point of a handle.
store (into {} (map (fn [[k blk]] [k (select-keys blk [:data :state])]))
store (merge (into {} (map (fn [[k blk]] [k (select-keys blk [:data :state])]))
{geom-k rings
(head-k "pos") pos, (head-k "rot") rot, (head-k "scale") scale})]
(head-k "pos") pos, (head-k "rot") rot, (head-k "scale") scale})
(:store features) (:store interior))]
{:store store
:scene (head-mode {:mode head :kept kept} {:scene scene :store store})}))

View file

@ -0,0 +1,62 @@
(ns arthur.flow.measure.brows
"Head-local brow rings and outer/inner raise signals, measured against the
rigid eye corners so blinking cannot masquerade as an eyebrow movement."
(:require [arthur.domain.geom :as geom]
[arthur.domain.landmarks :as lm]
[arthur.flow.measure.anchor :as anchor]))
(defn- midpoint [a b]
{:x (/ (+ (:x a) (:x b)) 2) :y (/ (+ (:y a) (:y b)) 2)})
(defn- distance [a b]
(js/Math.hypot (- (:x a) (:x b)) (- (:y a) (:y b))))
(defn- local-track [dense transforms aspect table]
(mapv (fn [frame tf]
(geom/apply-sim-all tf (anchor/pick frame table aspect)))
dense transforms))
(defn measure
[{:keys [aspect debug?]} {:keys [dense transforms]}]
(let [track (partial local-track dense transforms aspect)
a (track lm/BROW-A-RING)
b (track lm/BROW-B-RING)
corners-r (track lm/EYE-R-CORNERS)
corners-l (track lm/EYE-L-CORNERS)
centre-x (fn [ring] (:x (geom/centroid ring)))
side-votes (reduce +
(map (fn [ar [ro ri] [lo li]]
(if (< (abs (- (centre-x ar) (:x (midpoint ro ri))))
(abs (- (centre-x ar) (:x (midpoint lo li)))))
1 -1))
a corners-r corners-l))
a-right? (pos? side-votes)
right (if a-right? a b)
left (if a-right? b a)
outer-votes (reduce +
(mapcat (fn [rings corners]
(map (fn [ring [outer inner]]
(if (< (distance (first ring) outer)
(distance (first ring) inner))
1 -1))
rings corners))
[right left] [corners-r corners-l]))
outer-at-zero? (pos? outer-votes)
end-outer (if outer-at-zero? lm/BROW-END-0 lm/BROW-END-1)
end-inner (if outer-at-zero? lm/BROW-END-1 lm/BROW-END-0)
signal (fn [rings corners]
(mapv (fn [ring [outer inner]]
(let [c (midpoint outer inner)
w (max 1e-9 (distance outer inner))
at (fn [[i j]] (/ (+ (:y (nth ring i))
(:y (nth ring j))) 2))]
{:x (/ (- (:y c) (at end-outer)) w)
:y (/ (- (:y c) (at end-inner)) w)}))
rings corners))]
{:ring-r right :ring-l left
:raise-r (signal right corners-r)
:raise-l (signal left corners-l)
:outer-at-zero? outer-at-zero? :a-right? a-right?
:debug (when debug? {:side-votes side-votes :outer-votes outer-votes
:raise-r (signal right corners-r)
:raise-l (signal left corners-l)})}))

View file

@ -0,0 +1,73 @@
(ns arthur.flow.measure.eyes
"Head-local eyelid and iris measurements. No blink threshold or drawn gaze
grid belongs here; those decisions are made after measurement."
(:require [arthur.domain.geom :as geom]
[arthur.domain.landmarks :as lm]
[arthur.flow.measure.anchor :as anchor]))
(defn- midpoint [a b]
{:x (/ (+ (:x a) (:x b)) 2) :y (/ (+ (:y a) (:y b)) 2)})
(defn- distance [a b]
(js/Math.hypot (- (:x a) (:x b)) (- (:y a) (:y b))))
(defn- local-track [dense transforms aspect table]
(mapv (fn [frame tf]
(geom/apply-sim-all tf (anchor/pick frame table aspect)))
dense transforms))
(defn- iris-pair [iris-a iris-b corners-r]
(when iris-a
(let [votes (reduce +
(map (fn [a b [outer inner]]
(if (< (distance (first a) (midpoint outer inner))
(distance (first b) (midpoint outer inner)))
1 -1))
iris-a iris-b corners-r))]
(if (pos? votes) {:right :a :left :b} {:right :b :left :a}))))
(defn measure
"All rings and iris coordinates use the anchor's head-local image-height unit.
Eye openness and gaze use each eye's rigid corner width as their unit. Iris
block identity is voted from proximity over the whole take."
[{:keys [aspect debug?]} {:keys [dense transforms]}]
(let [track (partial local-track dense transforms aspect)
lid-r (track lm/EYE-R-RING)
lid-l (track lm/EYE-L-RING)
corners-r (track lm/EYE-R-CORNERS)
corners-l (track lm/EYE-L-CORNERS)
lids-r (track lm/EYE-R-LIDS)
lids-l (track lm/EYE-L-LIDS)
has-iris? (every? #(> (count %) (last lm/IRIS-B)) dense)
iris-a (when has-iris? (track lm/IRIS-A))
iris-b (when has-iris? (track lm/IRIS-B))
pairing (iris-pair iris-a iris-b corners-r)
iris-for (fn [side f]
(first (nth (if (= (get pairing side) :a) iris-a iris-b) f)))
openness (fn [corners lids]
(mapv (fn [[a b] [up down]]
(/ (distance up down) (max 1e-9 (distance a b))))
corners lids))
gaze (if pairing
(mapv (fn [f]
(let [one (fn [side corners]
(let [[a b] (nth corners f)
c (midpoint a b)
w (max 1e-9 (distance a b))
iris (iris-for side f)]
{:x (/ (- (:x iris) (:x c)) w)
:y (/ (- (:y iris) (:y c)) w)}))
r (one :right corners-r)
l (one :left corners-l)]
(midpoint r l)))
(range (count dense)))
(vec (repeat (count dense) {:x 0 :y 0})))]
{:lid-r lid-r :lid-l lid-l
:corners-r corners-r :corners-l corners-l
:open-r (openness corners-r lids-r)
:open-l (openness corners-l lids-l)
:gaze gaze :has-iris? (boolean pairing)
:iris-pair pairing
:debug (when debug? {:open-r (openness corners-r lids-r)
:open-l (openness corners-l lids-l)
:gaze gaze :iris-pair pairing})}))

View file

@ -0,0 +1,206 @@
(ns arthur.flow.measure.interior
"Pixel measurement inside the inner lip ring. The image crop is supplied by
ingestion; this namespace owns Otsu, morphology, component choice and radial
contour correspondence, and never reads a DOM element."
(:require [arthur.domain.geom :as geom]))
(defn- scaled-ring [ring amount]
(let [{:keys [x y]} (geom/centroid ring)]
(mapv (fn [p] {:x (+ x (* amount (- (:x p) x)))
:y (+ y (* amount (- (:y p) y)))}) ring)))
(defn crop
"A clamped source-pixel box for the eroded cavity ring. nil means too small
for a useful contrast measurement."
[ring [width height] cavity-erode]
(let [shape (scaled-ring ring (- 1 cavity-erode))
x0 (max 0 (js/Math.floor (* width (reduce min (map :x shape)))))
y0 (max 0 (js/Math.floor (* height (reduce min (map :y shape)))))
x1 (min width (js/Math.ceil (* width (reduce max (map :x shape)))))
y1 (min height (js/Math.ceil (* height (reduce max (map :y shape)))))
w (- x1 x0) h (- y1 y0)]
(when (and (>= w 5) (>= h 5))
{:x x0 :y y0 :w w :h h :shape shape
:source-width width :source-height height})))
(defn- point-in-poly? [points x y]
(let [n (count points)]
(loop [i 0 j (dec n) inside? false]
(if (= i n)
inside?
(let [a (nth points i) b (nth points j)
cross? (and (not= (> (:y a) y) (> (:y b) y))
(< x (+ (:x a)
(/ (* (- (:x b) (:x a)) (- y (:y a)))
(- (:y b) (:y a))))))]
(recur (inc i) i (if cross? (not inside?) inside?)))))))
(defn- otsu [hist total]
(let [sum (reduce + (map-indexed * hist))]
(loop [t 0 weight 0 sum-dark 0 best-var -1 best {:thr 0 :dark 0 :bright 0}]
(if (= t 256)
best
(let [weight (+ weight (aget hist t))
sum-dark (+ sum-dark (* t (aget hist t)))
remain (- total weight)]
(if (zero? remain)
best
(let [dark (if (pos? weight) (/ sum-dark weight) 0)
bright (/ (- sum sum-dark) remain)
delta (- dark bright)
variance (* weight remain delta delta)]
(recur (inc t) weight sum-dark
(max best-var variance)
(if (and (pos? weight) (> variance best-var))
{:thr t :dark dark :bright bright}
best)))))))))
(defn- morph [mask w h dilate?]
(let [out (js/Uint8Array. (.-length mask))]
(doseq [y (range 1 (dec h)) x (range 1 (dec w))]
(let [i (+ (* y w) x)
values [(aget mask i) (aget mask (dec i)) (aget mask (inc i))
(aget mask (- i w)) (aget mask (+ i w))]]
(aset out i (if (if dilate? (some pos? values) (every? pos? values)) 1 0))))
out))
(defn- best-component [mask w h top-bias]
(let [labels (js/Int32Array. (.-length mask))
stack (array)]
(.fill labels -1)
(loop [seed 0 label 0 best nil]
(if (= seed (.-length mask))
best
(if (or (zero? (aget mask seed)) (>= (aget labels seed) 0))
(recur (inc seed) label best)
(do
(set! (.-length stack) 0)
(.push stack seed)
(aset labels seed label)
(let [{:keys [pixels sum-y]}
(loop [pixels [] sum-y 0]
(if (zero? (.-length stack))
{:pixels pixels :sum-y sum-y}
(let [i (.pop stack)
x (mod i w) y (quot i w)
neighbours (cond-> []
(> x 0) (conj (dec i))
(< x (dec w)) (conj (inc i))
(> y 0) (conj (- i w))
(< y (dec h)) (conj (+ i w)))]
(doseq [j neighbours]
(when (and (pos? (aget mask j)) (neg? (aget labels j)))
(aset labels j label)
(.push stack j)))
(recur (conj pixels i) (+ sum-y y)))))
area (count pixels)
mean-y (/ sum-y area h)
score (* area (- 1 (* top-bias mean-y)))
winner {:pixels pixels :area area :score score :mean-y mean-y}]
(recur (inc seed) (inc label)
(if (or (nil? best) (> score (:score best))) winner best)))))))))
(defn- radial-contour [mask w h cx cy vertices]
(let [maximum (js/Math.hypot w h)]
(loop [k 0 previous 1 out []]
(if (= k vertices)
out
(let [angle (- (* (/ k vertices) js/Math.PI 2))
dx (js/Math.cos angle) dy (js/Math.sin angle)
hit (loop [radius 0.5 last-hit 0]
(if (>= radius maximum)
last-hit
(let [x (js/Math.round (+ cx (* dx radius)))
y (js/Math.round (+ cy (* dy radius)))]
(if (or (< x 0) (< y 0) (>= x w) (>= y h))
last-hit
(if (pos? (aget mask (+ (* y w) x)))
(recur (+ radius 0.5) radius)
(if (and (pos? last-hit) (> radius (+ last-hit 2)))
last-hit
(recur (+ radius 0.5) last-hit)))))))
radius (if (pos? hit) hit (* previous 0.6))]
(recur (inc k) radius
(conj out {:x (+ cx (* dx radius))
:y (+ cy (* dy radius))})))))))
(defn measure
"Measure one cropped RGBA ImageData at `box`. Returns normalized source image
coordinates and optional intermediate masks for a diagnostic view."
[{:keys [cavity-erode tongue-reject blob-grow top-bias teeth-verts min-area
debug?]}
{:keys [x y w h shape source-width source-height] :as box}
image-data]
(let [pixels (.-data image-data)
polygon (mapv (fn [p] {:x (- (* (:x p) source-width) x)
:y (- (* (:y p) source-height) y)}) shape)
hist (js/Uint32Array. 256)
luminance (js/Uint8Array. (* w h))
redness (js/Float32Array. (* w h))
region (js/Uint8Array. (* w h))
samples (volatile! 0)]
(doseq [row (range h) col (range w)]
(when (point-in-poly? polygon (+ col 0.5) (+ row 0.5))
(let [i (+ (* row w) col) o (* i 4)
r (aget pixels o) g (aget pixels (inc o)) b (aget pixels (+ o 2))
lum (js/Math.floor (+ (* 0.299 r) (* 0.587 g) (* 0.114 b)))]
(aset luminance i lum)
(aset redness i (/ (- r (/ (+ g b) 2)) 255))
(aset region i 1)
(aset hist lum (inc (aget hist lum)))
(vswap! samples inc))))
(if (< @samples 24)
{:contour nil :contrast 0 :area 0 :debug (when debug? {:box box :region region})}
(let [{:keys [thr dark bright]} (otsu hist @samples)
contrast (/ (- bright dark) 255)
;; Warm light shifts even the pale teeth toward red. An absolute
;; tongue-rejection cut can exclude every pixel in a real mouth.
;; Calibrate the cut to the least-red bright quarter of THIS cavity,
;; while retaining the authored cut as a floor for neutral footage.
bright-red (->> (range (* w h))
(keep (fn [i]
(when (and (pos? (aget region i))
(> (aget luminance i) bright))
(aget redness i))))
sort vec)
red-cut (if (seq bright-red)
(max tongue-reject
(+ 0.015 (nth bright-red
(js/Math.floor (* 0.25 (dec (count bright-red)))))))
tongue-reject)
candidate (js/Uint8Array. (* w h))]
(dotimes [i (* w h)]
(when (and (pos? (aget region i)) (> (aget luminance i) bright)
(< (aget redness i) red-cut))
(aset candidate i 1)))
(let [opened (morph (morph candidate w h false) w h true)
adjusted (loop [remaining (abs blob-grow) mask opened]
(if (zero? remaining) mask
(recur (dec remaining) (morph mask w h (pos? blob-grow)))))
component (best-component adjusted w h top-bias)
area (or (:area component) 0)
selected (js/Uint8Array. (* w h))]
(when component
(doseq [i (:pixels component)] (aset selected i 1)))
(let [contour (when (>= area min-area)
(let [cx (/ (reduce + (map #(mod % w) (:pixels component))) area)
cy (/ (reduce + (map #(quot % w) (:pixels component))) area)]
(mapv (fn [p] {:x (/ (+ (:x p) x) source-width)
:y (/ (+ (:y p) y) source-height)})
(radial-contour selected w h cx cy teeth-verts))))]
{:contour contour :contrast contrast :area area
:debug (when debug? {:box box :region region :luminance luminance
:redness redness :candidate candidate
:opened opened :selected selected
:threshold thr :dark dark :bright bright
:red-cut red-cut})}))))))
(defn head-local
"Map a pixel-derived contour through the same conditioned similarity as the
lip rings. Both coordinates are normalized by image height first."
[measure transform aspect]
(if-let [contour (:contour measure)]
(assoc measure :contour
(geom/apply-sim-all transform
(mapv (fn [p] (update p :x * aspect)) contour)))
measure))

View file

@ -1,24 +1,46 @@
(ns arthur.flow.take
"The shared landmark-to-channel path for synthetic and detected takes."
(:require [arthur.flow.condition :as condition]
[arthur.flow.condition.brows :as condition-brows]
[arthur.flow.condition.eyes :as condition-eyes]
[arthur.flow.condition.interior :as condition-interior]
[arthur.flow.freeze :as freeze]
[arthur.flow.measure.anchor :as anchor]
[arthur.flow.measure.brows :as brows]
[arthur.flow.measure.eyes :as eyes]
[arthur.flow.measure.interior :as interior]
[arthur.flow.measure.mouth :as mouth]))
(def knobs
{:anchor-avg 2 :contour-avg 1 :verts 8 :aperture-cut 0.12})
{:anchor-avg 2 :contour-avg 1 :verts 8 :aperture-cut 0.12
:eye-verts 8 :blink-cut 0.13 :gaze-gain 1 :gaze-step 0.08
:iris-size 0.42 :lash-weight 0.06 :pupil-size 0.15
:brow-verts 6 :brow-gain 1 :brow-step 0.08 :brow-weight 0.05
:cavity-erode 0.18 :tongue-reject 0.18 :blob-grow 0 :top-bias 0.6
:teeth-verts 10 :min-area 12 :teeth-on 0.12 :teeth-smooth 1})
(defn measure
"Condition the anchor before measuring rings through it."
[{:keys [aspect] :as params} {:keys [dense detected]}]
[{:keys [aspect] :as params} {:keys [dense detected interior]}]
(let [fitted (anchor/fit {:aspect aspect} {:dense dense})
anchored (condition/anchor params fitted)
rings (mouth/measure {:aspect aspect}
{:dense dense :transforms (:transforms anchored)})]
{:dense dense :transforms (:transforms anchored)})
eye-data (eyes/measure params {:dense dense :transforms (:transforms anchored)})
brow-data (brows/measure params {:dense dense :transforms (:transforms anchored)})
inner-data (when interior
(condition-interior/apply-defaults
params
(mapv interior/head-local interior (:transforms anchored)
(repeat aspect))
(:aperture rings)))]
(assoc anchored
:outer (condition/contours params (:outer rings))
:inner (condition/contours params (:inner rings))
:aperture (:aperture rings)
:eyes (condition-eyes/apply-defaults params eye-data)
:brows (condition-brows/apply-defaults params brow-data eye-data)
:teeth inner-data
:detected detected)))
(defn build
@ -29,11 +51,11 @@
"A real manifest and its detected landmarks through the same measurement and
freeze path as the synthetic take. The source cadence stays in :fps; picture
sampling is a root time map applied only after this artifact exists."
[manifest {:keys [dense detected dimensions]}]
[manifest {:keys [dense detected dimensions interior]}]
(let [[w h] dimensions
params (merge knobs
{:name "footage" :fps (:fps manifest) :aspect (/ w h)
:stage [320 200] :fit-motion? true
:expose 1 :head :as-filmed
:analysis (str "mediapipe:1.0.1/" (:source manifest))})]
(build params {:dense dense :detected detected})))
(build params {:dense dense :detected detected :interior interior})))