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

Port steps 2-3: the data model and the player

Browse source 
Steps 2 and 3 land together because the model revisions in the middle changed
code from both, and splitting them now would invent intermediate states that
never built.

  domain/channel  value-at across framed/keyed/dense, plus a cursor
  domain/node     decomposed transform, composition order, time maps
  domain/scene    topological order, z paths, eval-frame and resolver
  clock           audio-clocked frame derivation, outside app-db
  db/events/subs  re-frame arrives; the playhead is document state
  ui/player       the rAF loop; reads, blits, dispatches (almost) nothing
  ui/shell        transport

133 tests, 1158 assertions. The scene plays at 30fps against audio, scrubs, and
runs at 1/4x through 4x; verified by driving a real browser over CDP rather than
by assertion.

Two evaluators, on purpose. `eval-frame` is the specification -- allocating,
order-free, obviously correct. `resolver` is what playback uses: cached topo
order and z paths, a cursor per channel, a preallocated point buffer per node.
Both run the same walk, parameterised only by how a channel is read and where
points are written, because two independent implementations of frame evaluation
would drift and the drift would read as a rendering bug rather than as two
functions disagreeing. scene-test asserts they agree frame for frame in forward,
backward and random order.

Deviations and decisions, each with a reason:

- raster/fill-poly! is now a thin wrapper over fill-poly-buf!, which takes a flat
  preallocated buffer. ONE scanline fill serves the analysis stages, which speak
  {:x :y}, and frame evaluation, which hands over a buffer it owns. The parity
  suite still passes pixel-for-pixel, which is what makes the rewrite safe.

- The state mask carries ABSENCE ONLY. An earlier draft gave it a hidden bit too,
  per architecture.md's "hidden flag + palette index", and that bit was a dense
  [:vis] wearing a different hat -- two mechanisms for one question, which is how
  a part ends up hidden by one and shown by the other.

- The palette is a parameter of evaluation, not a global. A node names a TONE;
  which ramp that tone is read in belongs to the timeline it sits in.

- :over layers and a symbol :rate THROW rather than being ignored. Neither is
  built and nothing can produce one, so this can only fire on data that has run
  ahead of the code. A silently dropped override is a hand correction the user
  made once, watched fail, and has no reason to trust again.

Three findings the model produced rather than received:

- Presence propagates asymmetrically. An absent transform drops the subtree; an
  absent [:geom :pts] drops only that node, because an absent mouth outline has
  nothing to draw but the head it hangs off has not moved. That asymmetry is the
  reason presence is tracked per channel and not per node.

- Z paths need lexicographic compare, not `compare`, which orders vectors by
  count first -- so a cel three levels under "a1" would jump in front of a bare
  "a2" and the layer order would mostly work.

- A node stencilled by something that drew nothing is dropped, not drawn
  unclipped: an iris floating over the cheek is worse than a missing iris.

docs/ revised alongside, and those revisions are the load-bearing part:

- A scene, a timeline and a symbol are one type. The doc had two structures with
  the same fields and never said so. Two axes of nesting are now separated --
  parent/child within a timeline is flat with parent pointers, instance nesting
  is by reference -- which is why "nestable" and "flat" only sounded
  contradictory.

- Palettes are named, live on the project, and are ENABLED on a timeline as a
  channel. Absent inherits; present travels with the timeline, so a symbol
  authored against :night stays night wherever it is placed. The output index
  space is the concatenation of the named ramps, which keeps one buffer and one
  flat table and incidentally stops two nodes in different palettes colliding on
  a stencil.

- Stabilisation is a channel, not a mode: {s, theta, tx, ty} IS [:xform :*], so
  the normalise on/off/per-plate toggle is which of the three channel shapes the
  :head node carries. Always measure and always store factored -- smoothing and
  velocity-minimum key selection both need the split to exist in storage.

- There is no camera node and none is needed. Placement is a node transform, the
  stage clips what hangs off it, and project dimensions are independent of the
  footage. `makeXform` is therefore not to be ported: it bakes a cropping
  decision into every stored vertex.

- Export is removed. The .take writer was for an Animator Pro render script; the
  target is encoding video in the browser, and step 9 now says not to port the
  old one.

demo/swarm is 120 shapes on six orbits, entirely dense blocks behind store
handles -- the shape freeze produces at step 5, and the first thing to exercise
that path under load. It plays at 30fps, and bench-test keeps a deliberately
loose floor under it because a performance regression here does not announce
itself: the picture stays correct and merely arrives late.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
Claude-Session: https://claude.ai/code/session_01PDfHGdV39zu6rvgbBTfDaT
This commit is contained in:
Olive Vaughn 2026-09-27 17:28:05 -04:00
parent eb06be005c
commit 18d6495592
27 changed files with 3395 additions and 90 deletions
Download patch file Download diff file Expand all files Collapse all files

99
frontend/src/arthur/clock.cljs Normal file
View file

@ -0,0 +1,99 @@
(ns arthur.clock
"The audio clock. Lives OUTSIDE app-db, deliberately.
THE FRAME IS DERIVED FROM THE AUDIO, never counted:
frame = ⌊currentTime · fps⌋
A loop that counted frames and hoped to keep up would drift, and drift against
a voice is the one artefact that cannot be fixed downstream — a lip-sync tool
whose sync wanders is not a lip-sync tool. Deriving instead means a slow frame
DROPS the frames it missed and the next one lands where the audio already is.
The failure mode becomes a visible stutter rather than an invisible slide, and
those are very different bugs to own.
½× and ¼× are `playbackRate` and nothing else. The audio slows, `currentTime`
advances proportionally, and the derived frame follows — so slow motion cannot
desync by construction. Implementing rate as a multiplier on a counted frame
would give the picture a rate and the sound another.
It is outside app-db because the audio element is the source of truth and
copying it into the db every frame would make the db a lagging mirror of
something authoritative elsewhere. What DOES belong in the db is the playhead
as a piece of document state — see events/playback — and that is written from
here, not read by here."
(:require [arthur.domain.node :as node]))
(defonce ^:private el (atom nil))
(defn attach!
"Hand the clock its audio element. Idempotent."
[audio-el]
(reset! el audio-el))
(defn element [] @el)
(defn- clamp [f frames]
(-> f (max 0) (min (dec frames))))
(defn frame
"The clip frame the audio is currently on."
[fps frames]
(if-let [a @el]
(clamp (js/Math.floor (* (.-currentTime a) fps)) frames)
0))
(defn playing? []
(boolean (when-let [a @el] (and (not (.-paused a)) (not (.-ended a))))))
(defn rate []
(if-let [a @el] (.-playbackRate a) 1.0))
(defn set-rate! [r]
(when-let [a @el] (set! (.-playbackRate a) r)))
(defn play! []
(when-let [a @el]
;; Returns a promise that rejects if the browser has not seen a gesture yet.
;; Swallowed: the transport button IS the gesture, so this can only fire on a
;; programmatic play, where a console error is noise rather than news.
(some-> (.play a) (.catch (fn [_])))))
(defn pause! []
(when-let [a @el] (.pause a)))
(defn seek!
"Put the audio at the start of frame f. Seeking to the frame's start rather
than its middle keeps `frame` idempotent: seek to f, read back f."
[fps frames f]
(when-let [a @el]
(set! (.-currentTime a) (/ (clamp f frames) fps))))
(defn set-loop!
"Wrap at the end instead of stopping. The frame stays derived — `currentTime`
simply returns to zero — so nothing about the sync changes, which is the point
of not counting frames.
It earns its place at 2x and 4x, where the whole clip is gone in under four
seconds and a profile wants more than that to look at."
[on?]
(when-let [a @el] (set! (.-loop a) (boolean on?))))
(defn set-muted! [on?]
(when-let [a @el] (set! (.-muted a) (boolean on?))))
(defn duration-frames
"How many frames the audio actually covers, which need not be the clip's
length. Reported rather than assumed: a clip longer than its audio is a
legitimate thing to be told about, not a thing to silently truncate."
[fps]
(when-let [a @el]
(let [d (.-duration a)]
(when (and d (js/isFinite d)) (js/Math.ceil (* d fps))))))
(defn exposed-frame
"The frame a clip-level exposure grid holds `f` back onto. The player shows it
as a readout so that `exposure 2` is visibly doing something at the transport
rather than only inside the scene."
[f expose]
(node/expose f expose))

31
frontend/src/arthur/core.cljs
View file

@ -1,19 +1,30 @@
(ns arthur.core
"The app's one entry point. Deliberately almost empty until port-plan step 2:
there is nothing to render until the data model exists, and a shell built
before the model would be a shell built around a guess."
(:require [reagent.dom.client :as rdc]))
"The app's entry point.
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.playback]
[arthur.subs.playback]
[arthur.subs.render]
[arthur.ui.player :as player]
[arthur.ui.shell :as shell]
[re-frame.core :as rf]
[reagent.dom.client :as rdc]))
(defonce root (atom nil))
(defn shell []
[:main
[:h1 "arthur"]
[:p "Scaffold only. The scene renderer arrives with domain/scene."]])
(rf/reg-event-db ::init (fn [_ _] db/default))
(defn ^:dev/after-load mount []
(rdc/render @root [shell]))
;; A hot reload changes the scene or the rasteriser and not the playhead, so
;; the loop would otherwise sit on an unchanged frame number and never redraw.
(rf/clear-subscription-cache!)
(player/refresh-subs!)
(rdc/render @root [shell/view]))
(defn init []
(rf/dispatch-sync [::init])
(reset! root (rdc/create-root (js/document.getElementById "app")))
(mount))
(mount)
(player/start!))

67
frontend/src/arthur/db.cljs Normal file
View file

@ -0,0 +1,67 @@
(ns arthur.db
"app-db: authored data and ids. Nothing derived, and nothing large.
That sounds like hygiene and it is the precondition for two things that are
otherwise unbuildable — spec validation on every event, which is only
affordable over authored data, and cheap writes, since every edit `assoc`es
into this map and every mounted layer-2 sub compares the result.
So the scene is here (it is a document — a human placed every node) and dense
channel blocks are not; they live behind a handle in `store`. Today the demo
scene has no dense blocks and the store is empty, which is why it is a map and
not yet a namespace."
(:require [arthur.demo :as demo]
[arthur.demo.swarm :as swarm]))
(def scenes
"Two hand-made clips, selectable from the transport.
`:swarm` holds its geometry in DENSE blocks behind store handles, which is the
shape freeze produces at step 5 — so the fun one is also the load test."
{:demo {:label "demo" :scene demo/scene :store nil
:fps demo/fps :frames demo/frames}
:swarm {:label "swarm" :scene @swarm/scene :store @swarm/store
:fps swarm/fps :frames swarm/frames}})
(def default
{;; --- the document ---
:scene/current :demo
:palette :arthur/default ; a NAME; the ramp itself is project data
;; --- the clip ---
:clip {:fps demo/fps
:frames demo/frames}
;; --- transport ---
;;
;; The playhead is in app-db like everything else. An earlier draft of
;; docs/architecture.md put it in a standalone ratom to dodge an invalidation
;; storm that does not happen: with layer-2 extractors and layer-3
;; computations, a tick re-runs one cheap extractor per mounted sub, each
;; returning the same value for every subtree the tick did not touch, and
;; therefore notifying nobody. ::resolver does not re-run.
;;
;; Two reasons it belongs here rather than outside: a seek in the event log is
;; how scrubbing becomes inspectable in re-frame-10x, and a collaborator's
;; playhead is a feature — putting it outside app-db puts it outside the
;; machinery that would share it.
:playback {:frame 0
:playing? false
:rate 1.0
;; Both for profiling: loop so a run at 4x lasts longer than the
;; clip, mute so sitting in one does not require enduring it.
:loop? false
:muted? false}})
(def rates
"The transport's rates — all of them `playbackRate` on the audio element, so
the picture cannot drift from the sound at any of them.
2x and 4x are there to be profiled at rather than watched. A 30fps clip at 2x
wants sixty clip frames a second against a 60Hz display, so every animation
frame has to paint a new one: it is the point where the loop stops having
slack. Past that the clock starts dropping frames rather than falling behind,
which is the whole reason the frame is derived from the audio instead of
counted — and the transport reports the drop rate so that it is visible rather
than merely survivable."
[0.25 0.5 1.0 2.0 4.0])

26
frontend/src/arthur/demo.cljs Normal file
View file

@ -0,0 +1,26 @@
(ns arthur.demo
"The hand-written scene from port-plan step 2, and nothing else.
The EDN is a resource rather than a literal in this file so that the test and
the page read the SAME bytes. If the scene were written twice, the one the test
validates would not be the one that renders, and the model would be validated
against a scene nobody ever looked at."
(:require [arthur.domain.scene :as scene]
[cljs.reader :as reader]
[shadow.resource :as rc]))
(def source (rc/inline "arthur/demo/scene.edn"))
(def scene (reader/read-string source))
(def width 320)
(def height 200)
(def fps (:fps scene))
(def frames (:frames scene))
(defn ops-at
"Draw ops for one frame, via the specification path. The page uses
`scene/resolver` instead; this is here for the REPL."
[f]
(scene/eval-frame scene f))

93
frontend/src/arthur/demo/scene.edn Normal file
View file

@ -0,0 +1,93 @@
;; A scene written by hand, before any analysis exists.
;;
;; port-plan step 2 is deliberately ahead of measurement: the data model has
;; never been validated, and it is worth finding out here, with fifty lines to
;; throw away, rather than after nine hundred lines of measurement have been
;; ported into a shape that does not work.
;;
;; So this is not a demo of a face. It is the smallest scene that exercises every
;; mechanism the model claims to have, chosen so that each one is visible when it
;; breaks:
;;
;; exposure inherited from the clip root the motion steps on 2s
;; a keyed [:xform :pos], sparse, held the card jumps between 4 poses
;; transform composition through a group the eye rides the card
;; rotation about an anchor the card turns, it does not swing
;; a stencil as a colour key the iris cannot leave the card
;; a stencil chain nor can the pupil
;; a keyed [:vis] the bar blinks off and back
;; a :span the bar does not exist at either end
;; fractional z among siblings the bar is behind, the pupil in front
;;
;; Everything is in 320x200 raster space, which is what [:geom :pts] holds.
{:name "step-2 demo"
;; 229 frames at 30fps is 7.63s, which covers audio.wav (7.601s) with a frame to
;; spare. fps belongs to the CLIP rather than to the timeline — a timeline has a
;; frame space, not a rate — and it is here only because there is one clip.
:frames 229
:fps 30
:nodes
{;; The clip root. EXPOSURE LIVES HERE and is inherited, because
;; docs/design.md is emphatic that everything rides one grid: a head cutting on
;; odd frames against a mouth cutting on even ones reads as two performances.
;; Setting it lower on a child is possible and is meant to feel deliberate.
:root
{:id :root :name "clip" :kind :group :parent nil :z "a1"
:time {:mode :map :expose 2}}
;; A bar, behind everything, purely to assert that :vis and :span are different
;; questions. It stops existing outside [6 66) — nothing to hide, nothing to
;; hold — and inside that range it is switched off between frames 76 and 153.
:bar
{:id :bar :name "bar" :kind :poly :parent :root :z "a0"
:span [19 210]
:channels
{[:vis] {:animated? true :interp :hold :keys {0 true, 76 false, 153 true} :over []}
[:geom :pts] {:animated? false :value [20 168 300 168 300 176 20 176]}
[:style :color] {:animated? false :value :brow}}}
;; The group the plan asks for: four sparse keys on [:xform :pos], held. At
;; exposure 2 the card reads its pose from an even frame, so a key landing on
;; an odd frame would be seen on the even frame after it — which is the whole
;; reason exposure is applied before anything else and not folded into keys.
:swing
{:id :swing :name "swing" :kind :group :parent :root :z "a1"
:channels
{[:xform :pos] {:animated? true :interp :hold
:keys {0 [90.0 100.0], 57 [200.0 70.0], 114 [230.0 140.0], 171 [110.0 150.0]}
:over []}
[:xform :rot] {:animated? true :interp :hold
:keys {0 0.0, 57 0.35, 114 0.0, 171 -0.35}
:over []}}}
;; The rectangle. Its points are centred on the origin and its :anchor is the
;; origin too, so :swing's rotation TURNS it rather than swinging it round a
;; corner — which is the failure mode :anchor exists to prevent.
:card
{:id :card :name "card" :kind :poly :parent :swing :z "a1"
:channels
{[:geom :pts] {:animated? false :value [-44 -30 44 -30 44 30 -44 30]}
[:style :color] {:animated? false :value :skin-base}}}
;; A disc stencilled by the card. The stencil is a COLOUR KEY, not a node
;; reference — it is the take format's clip= — so the iris is written only over
;; pixels that currently hold the card's index. Push the radius up and it is
;; cropped by the card's edge rather than spilling, at any position, with no
;; clamp anywhere.
:iris
{:id :iris :name "iris" :kind :disc :parent :card :stencil :card :z "a2"
:channels
{[:xform :pos] {:animated? false :value [14.0 -6.0]}
[:geom :radius] {:animated? false :value 13.0}
[:style :color] {:animated? false :value :iris}}}
;; The pupil is a SQUARE, and three pixels of it. A circle of radius 1.5 is not
;; a circle, it is a plus sign with the corners gnawed off, and it changes shape
;; as it moves. Stencilled by the iris, which is itself already cropped by the
;; card, so the clip composes without the chain being expressed anywhere.
:pupil
{:id :pupil :name "pupil" :kind :rect :parent :iris :stencil :iris :z "a3"
:channels
{[:geom :size] {:animated? false :value 5.0}
[:style :color] {:animated? false :value :pupil}}}}}

163
frontend/src/arthur/demo/swarm.cljs Normal file
View file

@ -0,0 +1,163 @@
(ns arthur.demo.swarm
"A hundred and twenty shapes, orbiting, spinning, pulsing and blinking.
Not useful. It is here because it is the first thing to exercise the DENSE
channel path end to end — typed-array blocks behind a store handle, one value
per frame, read through a cursor — which until now had tests and no traffic.
Step 5 writes exactly this shape out of the freeze module, so it is worth
knowing the resolver can carry it at rate before anything depends on that.
Everything is generated from deterministic trigonometry rather than from a
random seed: the same scene every load, so a stutter or a wrong pose is
reproducible instead of being a thing that happened once.
Layout of each block is the rectangular one freeze produces — node-major,
frame-minor, no per-frame header and no indirection:
offset(node i) = i · frames · stride
value(i, f) = data[offset(i) + f · stride]"
(:require [arthur.domain.channel :as ch]
[arthur.domain.palette :as pal]))
(def frames 229)
(def fps 30)
(def n-orbits 6)
(def n-shapes 120)
(def ^:private TAU (* 2 js/Math.PI))
;; Every tone except the background, so the swarm uses the whole ramp.
(def ^:private tones
(vec (remove #{:bg} (map :name pal/entries))))
(defn- regular-poly
"A closed n-gon about the origin, flat in [x0 y0 x1 y1 …] — the same layout a
dense block holds, which is the point of geometry being flat everywhere."
[n radius phase]
(vec (mapcat (fn [k]
(let [a (+ phase (/ (* TAU k) n))]
[(* radius (js/Math.cos a))
(* radius (js/Math.sin a))]))
(range n))))
;; ---------------------------------------------------------------------------
;; the dense blocks
(defn- fill-block!
"Write one node's frames into a node-major block."
[^js data i stride f->vals]
(let [base (* i frames stride)]
(dotimes [f frames]
(let [vs (f->vals f)
o (+ base (* f stride))]
(dotimes [k stride]
(aset data (+ o k) (nth vs k)))))))
(defn- orbit-blocks []
(let [pos (js/Float32Array. (* n-orbits frames 2))
rot (js/Float32Array. (* n-orbits frames 1))]
(dotimes [i n-orbits]
(let [ph (/ (* TAU i) n-orbits)
;; Lissajous, so the six orbits drift in and out of phase with each
;; other instead of marching in step.
wx (+ 0.011 (* 0.004 (mod i 3)))
wy (+ 0.017 (* 0.003 (mod i 4)))
spin (* 0.008 (if (even? i) 1 -1) (inc (mod i 3)))]
(fill-block! pos i 2
(fn [f] [(+ 160 (* 104 (js/Math.sin (+ (* f wx) ph))))
(+ 100 (* 64 (js/Math.sin (+ (* f wy) (* 1.7 ph)))))]))
(fill-block! rot i 1 (fn [f] [(* f spin)]))))
{"swarm/orbit-pos" {:data pos :state nil}
"swarm/orbit-rot" {:data rot :state nil}}))
(defn- shape-blocks []
(let [pos (js/Float32Array. (* n-shapes frames 2))
rot (js/Float32Array. (* n-shapes frames 1))
scale (js/Float32Array. (* n-shapes frames 2))
;; The state mask: a handful of shapes wink out entirely for a stretch.
;; ABSENT, not hidden — this is the mask meaning "there is no value on
;; this frame", which is what an occluded subject will mean at step 6.
state (js/Uint8Array. (* n-shapes frames))]
(dotimes [i n-shapes]
(let [ph (/ (* TAU i) n-shapes)
ring (+ 18 (* 26 (js/Math.abs (js/Math.sin (* 2.3 ph)))))
wob (+ 0.03 (* 0.02 (mod i 5)))
spin (* (if (zero? (mod i 3)) -1 1) (+ 0.02 (* 0.011 (mod i 7))))
pulse (+ 0.05 (* 0.013 (mod i 6)))]
(fill-block! pos i 2
(fn [f]
;; Orbit position plus a small independent wobble, so no
;; two neighbours trace the same path.
(let [a (+ ph (* f 0.014 (if (even? i) 1 -1)))]
[(+ (* ring (js/Math.cos a)) (* 5 (js/Math.sin (* f wob))))
(+ (* ring (js/Math.sin a)) (* 5 (js/Math.cos (+ 1.1 (* f wob)))))])))
(fill-block! rot i 1 (fn [f] [(+ ph (* f spin))]))
(fill-block! scale i 2
(fn [f]
(let [s (+ 1.0 (* 0.45 (js/Math.sin (+ ph (* f pulse)))))]
[s s])))
;; Every eleventh shape is absent for a window that moves with i.
(when (zero? (mod i 11))
(let [from (mod (* i 9) frames)
to (min frames (+ from 34))]
(doseq [f (range from to)]
(aset state (+ (* i frames) f) ch/absent-bit))))))
{"swarm/pos" {:data pos :state state}
"swarm/rot" {:data rot :state nil}
"swarm/scale" {:data scale :state nil}}))
;; ---------------------------------------------------------------------------
;; the nodes
(defn- dense [store i stride]
{:animated? true :interp :hold
:dense {:store store :offset (* i frames stride) :stride stride :frames frames}
;; Provenance, which nothing in the renderer reads. Here it is honest about
;; where these numbers came from, the same way :roto/lips-outer will be.
:generated {:by :demo/swarm}
:over []})
(defn- orbit-node [i]
{:id (keyword (str "orbit-" i)) :kind :group :parent :root
:z (str "b" i)
:channels {[:xform :pos] (dense "swarm/orbit-pos" i 2)
[:xform :rot] (dense "swarm/orbit-rot" i 1)}})
(defn- shape-node [i]
(let [orbit (keyword (str "orbit-" (mod i n-orbits)))
tone (nth tones (mod i (count tones)))
kind (case (mod i 7) 5 :disc 6 :rect :poly)
verts (+ 3 (mod i 10))
size (+ 3.5 (* 0.9 (mod i 8)))
base {:id (keyword (str "s-" i)) :kind kind :parent orbit
;; Fractional index among siblings. Zero-padded so the strings
;; sort the way the numbers do — "c9" would otherwise land after
;; "c10", which is the classic way a z order goes subtly wrong.
:z (str "c" (.padStart (str i) 4 "0"))
:channels {[:xform :pos] (dense "swarm/pos" i 2)
[:xform :rot] (dense "swarm/rot" i 1)
[:xform :scale] (dense "swarm/scale" i 2)
[:style :color] (ch/framed tone)}}]
(update base :channels merge
(case kind
:poly {[:geom :pts] (ch/framed (regular-poly verts size (* 0.3 i)))}
:disc {[:geom :radius] (ch/framed (* 0.75 size))}
:rect {[:geom :size] (ch/framed (js/Math.round size))}))))
(def store
(delay (merge (orbit-blocks) (shape-blocks))))
(def scene
(delay
{:name "swarm"
:frames frames
:fps fps
:nodes
(into {:root {:id :root :kind :group :parent nil :z "a1"
;; On 2s, like everything else. A hundred and twenty shapes
;; cutting on one grid reads as animation; the same shapes on
;; their own grids read as a screensaver, which is the whole
;; argument for exposure inheriting strictly.
:time {:mode :map :expose 2}}}
(concat (map (juxt :id identity) (map orbit-node (range n-orbits)))
(map (juxt :id identity) (map shape-node (range n-shapes)))))}))

288
frontend/src/arthur/domain/channel.cljs Normal file
View file

@ -0,0 +1,288 @@
(ns arthur.domain.channel
"A channel is one animatable property, sampled at a frame.
Three shapes, and the uniformity across them is the entire point of the model
— analysis does not produce a different kind of data, it produces keys densely
on the same channels a hand fills in sparsely:
FRAMED {:animated? false :value v}
A thing that simply exists. A painted background cel is this.
KEYED {:animated? true :interp :hold :keys {0 v, 4 v, 12 v}}
Sparse, authored, in the document. Undoable and syncable.
DENSE {:animated? true :interp :hold
:dense {:store \"sha256:…\" :offset 0 :stride 40 :frames 600}
:generated {...}}
Generated, one value per frame, in a typed array outside app-db.
`value-at` reads all three and is the specification. `cursor`/`sample!` is the
fast path for playback and must agree with it exactly; scene-test asserts that
across forward, backward and random frame order, because a cursor that drifts
is a bug you would see as the wrong pose rather than as an error.
KEYS ARE A MAP BY FRAME, NEVER A VECTOR, and the map stored in the document is
a PLAIN map — transit and JSON both lose sortedness, so the sorted index is
built here at read time and never persisted.
:generated is provenance. NOTHING IN HERE READS IT, and nothing downstream may:
it exists so the UI can offer a parameter panel instead of raw keys. It lives
on the channel rather than the node because a mouth wants a rotoscoped
[:geom :pts] and a hand-animated [:xform :pos] at the same time, and putting
the flag on the node would forbid the most useful thing in the model."
(:require [clojure.string :as str]))
;; ---------------------------------------------------------------------------
;; the state mask
;;
;; PRESENCE IS NOT VISIBILITY, and the distinction is free now and expensive to
;; retrofit. A part that is hidden EXISTS and is not drawn, which is `[:vis]`, a
;; channel like any other. A subject that is occluded has NO VALUE on that frame
;; — there is nothing to hide and nothing to fall back on — and that is this.
;;
;; The mask carries ABSENCE ONLY. An earlier draft gave it a hidden bit as well,
;; per docs/architecture.md's "hidden flag + palette index", and that bit was
;; simply a dense `[:vis]` wearing a different hat: two mechanisms for one
;; question, which is how you end up with a part that is hidden by one and shown
;; by the other. Hiding is a channel; absence is a state. Remaining bits are
;; reserved.
(def ^:const present 0)
(def ^:const absent-bit 1)
(def absent
"Sampled value for a frame the subject was not on.
Distinct from a part being switched off, which is `[:vis]` being false, and
distinct from a part having no keys. The identity tracker, when it arrives,
needs somewhere to say \"not on screen\" without inventing a pose."
::absent)
(defn nothing?
"True when there is no value to draw with."
[v]
(identical? v absent))
;; ---------------------------------------------------------------------------
;; constructors, for hand-written scenes and tests
(defn framed [v] {:animated? false :value v})
(defn keyed
([ks] (keyed ks :hold))
([ks interp] {:animated? true :interp interp :keys ks :over []}))
;; ---------------------------------------------------------------------------
(defn component
"Component i of a multi-component channel value.
An authored value is a CLJS vector; a value read out of a dense block is a
typed-array view over the block, because copying it would allocate per node
per frame. Both have to read the same way here or every consumer downstream
grows the same two-way branch."
[v i]
(if (vector? v) (-nth v i) (aget v i)))
(defn frames
"Sorted vector of the frames a keyed channel has keys on, or nil. Built here
and cached by `cursor`; `value-at` rebuilds it, which is why `value-at` is the
specification and not the playback path."
[ch]
(when-let [ks (:keys ch)]
(vec (sort (keys ks)))))
(defn- check-unimplemented!
"An override layer or a retimed symbol instance must fail LOUDLY rather than
be ignored.
Both are specified in docs/animation-model.md and neither is built yet
(port-plan scope: \"leave the :over field present and empty; leave :symbol out
entirely\"). Silently dropping an :over layer would present as a hand
correction that did not take — a correction the user made once, watched fail,
and has no reason to trust again. Nothing can produce one yet, so this can
only fire on a data shape that has run ahead of the code."
[ch]
(when (seq (:over ch))
(throw (ex-info "channel has :over layers and the override layer is not built (port-plan step 2 scope)"
{:over (:over ch) :channel (dissoc ch :dense)}))))
;; ---------------------------------------------------------------------------
;; dense blocks
(defn- dense-state
[state f]
(if (nil? state)
present
(aget state f)))
(defn dense-at
"Read frame f out of a dense block.
`store` is {store-key -> {:data <typed array> :state <Uint8Array or nil>}},
tier 2, behind a handle and never in app-db.
The frame is CLAMPED into the block. A time map with an offset deliberately
reads the future — mouth lead is the whole reason `:offset` exists — so the
last frame of a leading track is asked for a frame past the end on every one
of the last `lead` frames. Clamping there is what the JS `shiftIndex` does and
it is the right answer: the track holds its final pose. Returning nothing
instead would blank the mouth at the end of every take.
stride 1 yields a number; anything wider yields a SUBARRAY VIEW over the
block, not a copy. Fixed topology is what makes that possible — the frame's
data is a rectangular slice at a known offset with no per-frame header."
[{:keys [store offset stride] nf :frames} f st]
(let [{:keys [data state]} (get st store)]
(when (nil? data)
(throw (ex-info "dense channel's store key is not in the store"
{:store store :have (vec (sort (map str (keys st))))})))
(let [f (-> f (max 0) (min (dec nf)))
sm (dense-state state f)]
(cond
(pos? (bit-and sm absent-bit)) absent
:else
(let [o (+ offset (* f stride))]
(if (= 1 stride)
(aget data o)
(.subarray data o (+ o stride))))))))
;; ---------------------------------------------------------------------------
;; the specification
(defn- keyed-at
"The most recent key at or before f, CLAMPED to the first key below it.
Hold is the default and clamping at the low end is the JS `activeKey`'s
behaviour, kept: a channel's first key is the pose the part starts in, so a
frame before it reads that pose rather than having no value. This is not the
same question as presence — a part with no value at all is `absent`, which is
a state bit, not an empty key map."
[ks f]
(let [fr (sort (keys ks))]
(if-let [hit (last (take-while #(<= % f) fr))]
(get ks hit)
(get ks (first fr)))))
(defn value-at
"Sample a channel at frame f. THE SPECIFICATION — correct, allocating, and
O(n) in the keys. `cursor`/`sample!` is what playback uses."
([ch f] (value-at ch f nil))
([ch f store]
(check-unimplemented! ch)
(cond
(not (:animated? ch)) (:value ch)
(:dense ch) (dense-at (:dense ch) f store)
(:keys ch) (let [ks (:keys ch)]
(if (empty? ks) absent (keyed-at ks f)))
:else
(throw (ex-info "animated channel has neither :keys nor :dense" {:channel ch})))))
;; ---------------------------------------------------------------------------
;; the playback path
;;
;; Playback is SEQUENTIAL, so "the most recent key at or before f" is an advance
;; of a saved index rather than a search. The difference at 30fps is a `sort` and
;; a `take-while` allocation per channel per frame against none, which is the
;; difference between the model being usable and being a demo.
(defn- bsearch
"Largest index i with ks[i] <= f, or 0 when f precedes every key (hold clamps
low, see keyed-at)."
[ks f]
(loop [lo 0, hi (dec (count ks)), best 0]
(if (> lo hi)
best
(let [mid (bit-shift-right (+ lo hi) 1)]
(if (<= (nth ks mid) f)
(recur (inc mid) hi mid)
(recur lo (dec mid) best))))))
(deftype Cursor [ch ks store ^:mutable i]
Object
(toString [_] (str "#Cursor{" (pr-str (if ks :keyed (if (:dense ch) :dense :framed))) " i=" i "}")))
(defn cursor
"A reading head on one channel. Build once per channel per resolver, then
`sample!` it per frame. Holds the sorted key index, which is why the index is
built here and not in the document."
([ch] (cursor ch nil))
([ch store]
(check-unimplemented! ch)
(->Cursor ch (when (and (:animated? ch) (not (:dense ch)) (seq (:keys ch)))
(frames ch))
store 0)))
(defn sample!
"Value of the cursor's channel at f. O(1) when f is at or one key past where
the cursor already sits — the playback case — and O(log n) otherwise, which is
a seek. Advancing and seeking are deliberately different costs: a scrub can
afford a binary search and a frame cannot."
[^Cursor cur f]
(let [ch (.-ch cur)
ks (.-ks cur)]
(cond
(not (:animated? ch)) (:value ch)
(:dense ch) (dense-at (:dense ch) f (.-store cur))
(nil? ks) absent ; animated with an empty key map
:else
(let [n (count ks)
i (.-i cur)
last (dec n)
i' (cond
;; still inside the key the cursor sits on
(and (<= (nth ks i) f)
(or (= i last) (> (nth ks (inc i)) f)))
i
;; the next one — one frame of playback crossed one key
(and (< i last)
(<= (nth ks (inc i)) f)
(or (= (inc i) last) (> (nth ks (+ i 2)) f)))
(inc i)
:else (bsearch ks f))]
(set! (.-i cur) i')
(get (:keys ch) (nth ks i'))))))
;; ---------------------------------------------------------------------------
(defn describe
"Which of the three shapes, for error messages and the parameter panel."
[ch]
(cond
(not (:animated? ch)) :framed
(:dense ch) :dense
:else :keyed))
(defn problems
"Human-readable reasons this map is not a channel. Empty means it is one."
[ch]
(cond-> []
(not (map? ch))
(conj "not a map")
(and (map? ch) (not (contains? ch :animated?)))
(conj ":animated? is required — the flag is what makes framed and keyed one type")
(and (map? ch) (:animated? ch) (not (or (:keys ch) (:dense ch))))
(conj "animated but has neither :keys nor :dense")
(and (map? ch) (:animated? ch) (:keys ch) (:dense ch))
(conj "has both :keys and :dense; a channel is one shape at a time")
(and (map? ch) (:keys ch) (not (map? (:keys ch))))
(conj (str ":keys is a " (if (vector? (:keys ch)) "vector" "non-map")
" — keys are a MAP by frame, so a merge can be per-key"))
(and (map? ch) (:keys ch) (map? (:keys ch)) (not (every? number? (keys (:keys ch)))))
(conj ":keys has a non-numeric frame")
(and (map? ch) (:animated? ch) (not (#{:hold nil} (:interp ch))))
(conj (str ":interp " (:interp ch) " — only :hold is implemented; docs/design.md"
" requires hold of every cut part and tweening reads as puppet software"))
(and (map? ch) (seq (:over ch)))
(conj ":over layers are not implemented (port-plan step 2 scope)")))
(defn problems-str [ch]
(str/join "; " (problems ch)))

257
frontend/src/arthur/domain/node.cljs Normal file
View file

@ -0,0 +1,257 @@
(ns arthur.domain.node
"A node is an instance in the scene: what kind of mark it is, who it hangs off,
what clips it, where it sits in draw order, and a bag of channels.
The tree is stored FLAT, WITH PARENT POINTERS, never as nested maps. Four
reasons that all point the same way: any node is addressable without a walk;
reparenting is a one-field write rather than a subtree move; an edit to a leaf
does not change the identity of its ancestors, so re-frame's structural sharing
keeps ancestor subs from invalidating; and it is what lets every node be its own
sync leaf. Flash, Blender and After Effects all store it this way.
Transforms are DECOMPOSED for storage and FLAT AND MUTABLE for evaluation, and
the two forms are allowed to differ. Decomposed because each component has to
be independently keyframable — that is what channels are for — and because
interpolating matrix entries is meaningless: a rotation tweened through its
matrix shears on the way. Flat Float64Array for evaluation because at 30fps
per-frame allocation is the only thing that will make this stutter."
(:require [arthur.domain.channel :as ch]
[clojure.string :as str]))
(def kinds
"`:symbol` and `:bitmap` are in the vocabulary and not implemented; they are
here so that a scene that names one fails as \"not implemented\" rather than as
\"not a kind\"."
#{:poly :disc :rect :group :bitmap :symbol})
(def implemented-kinds #{:poly :disc :rect :group})
(def xform-paths
"In composition order, which is also the order they have to be sampled in.
:skew and :anchor are in here although nothing drives either yet. A
decomposition is not extensible after the fact: adding a component later means
migrating every stored transform, so both are in the shape and in the
composition order from the start."
[[:xform :pos] [:xform :rot] [:xform :scale] [:xform :skew] [:xform :anchor]])
(def valid-paths
"The set of valid channel paths follows from the node's :kind, and that is a
SPEC rather than a schema migration — a node does not grow or lose fields, it
simply has no `[:geom :radius]` unless it is a disc."
(let [base (into #{[:vis]} xform-paths)]
{:group base
:poly (into base [[:geom :pts] [:style :color]])
;; A disc's radius is framed in practice (iris size is a knob, not a
;; performance) but it is a channel like any other so that it can be keyed.
:disc (into base [[:geom :radius] [:style :color]])
;; :size, not a radius: the pupil is a SQUARE, and an exactly size x size
;; block. See raster/fill-rect!.
:rect (into base [[:geom :size] [:style :color]])}))
(def defaults
"The identity transform, as channels. A node's channel map is merged over this,
so a hand-written scene says only what it means to say."
{[:xform :pos] (ch/framed [0.0 0.0])
[:xform :rot] (ch/framed 0.0)
[:xform :scale] (ch/framed [1.0 1.0])
[:xform :skew] (ch/framed [0.0 0.0])
[:xform :anchor] (ch/framed [0.0 0.0])
[:vis] (ch/framed true)})
(defn channels
"The node's channels with the transform defaults filled in."
[n]
(merge defaults (:channels n)))
;; ---------------------------------------------------------------------------
;; time maps
;;
;; Exposure, mouth lead and a symbol instance's timing are ONE mechanism, and
;; seeing that is what keeps them from being three implementations that disagree
;; at the edges.
(defn expose
"Hold a frame back onto an exposure grid: 1 = on 1s, 2 = on 2s. Frame 5 at
exposure 2 reads the pose from frame 4.
FLOOR, NEVER ROUND. Rounding would let an output frame read a pose from the
FUTURE, which is a lead — a separate control, applied after this one, for a
separate reason."
[f n]
(if (and n (> n 1)) (* (js/Math.floor (/ f n)) n) f))
(defn local-frame
"Apply a node's time map to the frame it was handed by its parent.
ORDER IS LOAD-BEARING: expose first, then offset. 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 slider reads as doing nothing at exposures above
1, which is indistinguishable from the slider being unwired.
Composed along the nesting chain, outermost first, by scene/eval-frame. Two
rules fall out and they are different rules: exposure INHERITS STRICTLY,
because a head cutting on odd frames against a mouth cutting on even ones reads
as two performances; offset is PER-NODE by design, because mouth lead applies
to performance nodes and not to the plate, which is the entire point of it."
[n f]
(let [{:keys [mode offset rate] ex :expose :or {mode :inherit}} (:time n)]
(if (= mode :inherit)
f
(do
;; A symbol instance's (f - at)·rate + in is the third face of this
;; mechanism and symbols are out of scope. Loud rather than ignored: a
;; silently dropped rate is a retimed blink playing at the wrong speed,
;; which looks like a bad blink and not like a missing feature.
(when (and rate (not= rate 1.0) (not= rate 1))
(throw (ex-info "time map :rate is symbol timing and symbols are not built (port-plan step 2 scope)"
{:node (:id n) :time (:time n)})))
(cond-> f
ex (expose ex)
offset (+ offset))))))
;; ---------------------------------------------------------------------------
;; the transform
;;
;; A 2x3 affine as a 6-element Float64Array [a b c d e f], the canvas convention:
;;
;; | a c e | x' = a·x + c·y + e
;; | b d f | y' = b·x + d·y + f
;; | 0 0 1 |
(defn mat [] (js/Float64Array. #js [1 0 0 1 0 0]))
(defn set-identity! [^js m]
(aset m 0 1) (aset m 1 0) (aset m 2 0) (aset m 3 1) (aset m 4 0) (aset m 5 0)
m)
(defn mul!
"dest := m · n. Reads both fully before writing, so dest may alias either."
[^js dest ^js m ^js n]
(let [a (+ (* (aget m 0) (aget n 0)) (* (aget m 2) (aget n 1)))
b (+ (* (aget m 1) (aget n 0)) (* (aget m 3) (aget n 1)))
c (+ (* (aget m 0) (aget n 2)) (* (aget m 2) (aget n 3)))
d (+ (* (aget m 1) (aget n 2)) (* (aget m 3) (aget n 3)))
e (+ (* (aget m 0) (aget n 4)) (* (aget m 2) (aget n 5)) (aget m 4))
f (+ (* (aget m 1) (aget n 4)) (* (aget m 3) (aget n 5)) (aget m 5))]
(aset dest 0 a) (aset dest 1 b) (aset dest 2 c)
(aset dest 3 d) (aset dest 4 e) (aset dest 5 f)
dest))
(defn local!
"dest := T(pos) · T(anchor) · R(rot) · K(skew) · S(scale) · T(-anchor)
Written out closed-form rather than as five matrix products, because this runs
per node per frame and the five products would each allocate. The derivation,
so the constants are checkable rather than trusted:
R·K·S = | c -s | · | 1 kx | · | sx 0 |
| s c | | ky 1 | | 0 sy |
K·S = | sx kx·sy |
| ky·sx sy |
R·K·S = | sx(c - s·ky) sy(c·kx - s) |
| sx(s + c·ky) sy(s·kx + c) |
and the translation is anchor + pos - M·anchor, which is what makes rotation
and scale happen ABOUT the anchor. :anchor is Flash's registration point and
Blender's origin, and getting it wrong is why hand-placed parts swing rather
than turn.
:skew is stored as shear FACTORS, not angles — kx is x gained per unit y — so
that the identity is 0 and a decomposition round-trips without a tangent."
[^js dest pos rot scale skew anchor]
(let [c (js/Math.cos rot)
s (js/Math.sin rot)
sx (ch/component scale 0)
sy (ch/component scale 1)
kx (ch/component skew 0)
ky (ch/component skew 1)
ax (ch/component anchor 0)
ay (ch/component anchor 1)
a (* sx (- c (* s ky)))
b (* sx (+ s (* c ky)))
cc (* sy (- (* c kx) s))
d (* sy (+ (* s kx) c))]
(aset dest 0 a)
(aset dest 1 b)
(aset dest 2 cc)
(aset dest 3 d)
(aset dest 4 (+ ax (ch/component pos 0) (- (+ (* a ax) (* cc ay)))))
(aset dest 5 (+ ay (ch/component pos 1) (- (+ (* b ax) (* d ay)))))
dest))
(defn pinv
"The parent-inverse, captured at the moment of parenting so the child does not
jump when it acquires a parent. Blender's `parent_inverse`. Small, and its
absence is the kind of thing that makes a parenting feature feel broken."
[n]
(if-let [p (:pinv n)]
(js/Float64Array.from (clj->js p))
nil))
(defn world!
"dest := parent · pinv · local. `parent` is nil at the root, `pinv-m` nil until
something is reparented. `scratch` is a 6-element Float64Array the caller owns;
it is an argument rather than an allocation because this runs per node per
frame."
[^js dest ^js parent ^js pinv-m ^js local ^js scratch]
(cond
(and parent pinv-m) (mul! dest parent (mul! scratch pinv-m local))
parent (mul! dest parent local)
pinv-m (mul! dest pinv-m local)
:else (doto dest (.set local))))
(defn apply-pt!
"out[2i], out[2i+1] := m · (x, y)."
[^js out i ^js m x y]
(aset out (* 2 i) (+ (* (aget m 0) x) (* (aget m 2) y) (aget m 4)))
(aset out (inc (* 2 i)) (+ (* (aget m 1) x) (* (aget m 3) y) (aget m 5)))
out)
(defn mean-scale
"The geometric-mean scale of a transform, sqrt|det|.
A disc under a non-uniform transform is an ellipse and this rasteriser has no
ellipse — the iris is a disc because at 320x200 it is a few pixels across, and
a few-pixel ellipse is not a shape, it is a stair. So a disc's radius takes the
mean scale. For a similarity, which is the only transform the anchor fit
produces, this is exact."
[^js m]
(js/Math.sqrt (js/Math.abs (- (* (aget m 0) (aget m 3))
(* (aget m 1) (aget m 2))))))
;; ---------------------------------------------------------------------------
(defn problems
"Human-readable reasons this map is not a usable node. Empty means it is one.
Worth having at all because app-db holds only authored data, which is what
makes validating every event affordable; this is the per-node half of that."
[n]
(let [k (:kind n)
valid (get valid-paths k)]
(-> []
(cond->
(nil? (:id n)) (conj "no :id")
(not (contains? kinds k)) (conj (str ":kind " (pr-str k) " is not one of " (pr-str kinds)))
(and (contains? kinds k)
(not (contains? implemented-kinds k)))
(conj (str ":kind " k " is in the vocabulary but not implemented"))
(nil? (:z n)) (conj "no :z — draw order is authored per scene, not implied by the tree")
(and (:span n) (not= 2 (count (:span n))))
(conj ":span must be [in out]"))
(into (when valid
(for [[path _] (:channels n)
:when (not (contains? valid path))]
(str "channel " (pr-str path) " is not valid on a " k " node"))))
(into (for [[path c] (:channels n)
p (ch/problems c)]
(str "channel " (pr-str path) ": " p))))))
(defn problems-str [n]
(str/join "; " (problems n)))

134
frontend/src/arthur/domain/raster.cljs
View file

@ -24,42 +24,75 @@
(.fill buf index)
r)
(defn fill-poly-buf!
"Even-odd scanline fill of a polygon held FLAT in `pts` as [x0 y0 x1 y1 …],
using the first `n` points. Samples at pixel centres (y + 0.5), so a polygon
edge landing exactly on a pixel boundary resolves consistently.
Flat and preallocated because this is the per-frame path: fixed topology means
a node's vertex count is known at freeze time, so scene/resolver hands the same
buffer back every frame and a frame allocates nothing. At 30fps per-frame
allocation is the only thing that will make this stutter.
`pts` may be a CLJS vector or any typed array; scanline crossings are collected
into a plain JS array and sorted in place."
[{:keys [w h buf] :as r} pts n index]
(when (>= n 3)
(let [px (fn [i] (if (vector? pts) (-nth pts (* 2 i)) (aget pts (* 2 i))))
py (fn [i] (if (vector? pts) (-nth pts (inc (* 2 i))) (aget pts (inc (* 2 i)))))
xs (array)]
(let [ymin (loop [i 1, acc (py 0)] (if (< i n) (recur (inc i) (min acc (py i))) acc))
ymax (loop [i 1, acc (py 0)] (if (< i n) (recur (inc i) (max acc (py i))) acc))
y0 (max 0 (js/Math.ceil (- ymin 0.5)))
y1 (min (dec h) (inc (js/Math.floor (- ymax 0.5))))]
(loop [y y0]
(when (<= y y1)
(let [sy (+ y 0.5)]
(set! (.-length xs) 0)
(dotimes [i n]
(let [j (mod (inc i) n)
ay (py i) by (py j)]
;; A horizontal edge contributes no crossing, and dividing by
;; its zero height would emit Infinity.
(when (not= ay by)
(let [lo (min ay by) hi (max ay by)]
;; Half-open in y: >= lo and < hi. A vertex shared by two
;; edges is counted exactly once, so the parity cannot flip
;; at a corner and leak a whole scanline.
(when (and (>= sy lo) (< sy hi))
(.push xs (+ (px i) (* (/ (- sy ay) (- by ay))
(- (px j) (px i))))))))))
(when (>= (.-length xs) 2)
(.sort xs (fn [a b] (- a b)))
(loop [k 0]
(when (< (inc k) (.-length xs))
(let [x-from (max 0 (js/Math.ceil (- (aget xs k) 0.5)))
x-to (min (dec w) (js/Math.floor (- (aget xs (inc k)) 0.5)))
row (* y w)]
(loop [x x-from]
(when (<= x x-to)
(aset buf (+ row x) index)
(recur (inc x)))))
(recur (+ k 2))))))
(recur (inc y)))))))
r)
(defn fill-poly!
"Even-odd scanline fill. Samples at pixel centres (y + 0.5), so a polygon
edge landing exactly on a pixel boundary resolves consistently."
[{:keys [w h buf] :as r} pts index]
(let [n (count pts)]
(when (>= n 3)
(let [ys (map :y pts)
y0 (max 0 (js/Math.ceil (- (apply min ys) 0.5)))
y1 (min (dec h) (inc (js/Math.floor (- (apply max ys) 0.5))))]
(doseq [y (range y0 (inc y1))]
(let [sy (+ y 0.5)
xs (sort
(for [i (range n)
:let [a (nth pts i)
b (nth pts (mod (inc i) n))]
;; A horizontal edge contributes no crossing, and
;; dividing by its zero height would emit Infinity.
:when (not= (:y a) (:y b))
:let [lo (min (:y a) (:y b))
hi (max (:y a) (:y b))]
;; Half-open in y: >= lo and < hi. A vertex shared by
;; two edges is counted exactly once, so the parity
;; cannot flip at a corner and leak a whole scanline.
:when (and (>= sy lo) (< sy hi))]
(+ (:x a) (* (/ (- sy (:y a)) (- (:y b) (:y a)))
(- (:x b) (:x a))))))]
(when (>= (count xs) 2)
(doseq [[xa xb] (partition 2 xs)]
(let [x-from (max 0 (js/Math.ceil (- xa 0.5)))
x-to (min (dec w) (js/Math.floor (- xb 0.5)))
row (* y w)]
(loop [x x-from]
(when (<= x x-to)
(aset buf (+ row x) index)
(recur (inc x)))))))))))
r))
"`fill-poly-buf!` over a seq of {:x :y} points.
The map form is what the analysis stages and the paint tool speak, and what the
JS oracle is diffed against; the flat form is what evaluation produces. ONE
scanline implementation serves both, because two would drift and the drift
would read as a rendering bug rather than as two functions disagreeing."
[r pts index]
(let [n (count pts)
a (js/Float64Array. (* 2 n))]
(loop [i 0, ps (seq pts)]
(when ps
(aset a (* 2 i) (:x (first ps)))
(aset a (inc (* 2 i)) (:y (first ps)))
(recur (inc i) (next ps))))
(fill-poly-buf! r a n index)))
(defn fill-disc!
"`over` is an optional stencil: when given, only pixels that currently hold
@ -127,12 +160,18 @@
Returns {:width :height :data} with :data a Uint8ClampedArray, ready to hand to
an ImageData. An index with no palette entry comes out magenta rather than
transparent or black: writing an index the palette does not have is a bug, and
it should be impossible to miss."
([r palette-rgb] (->rgba r palette-rgb 1))
([{:keys [w h buf]} palette-rgb zoom]
it should be impossible to miss.
`dest` is an optional Uint8ClampedArray to write into instead of allocating
one. At 320x200 the buffer is 256KB, and allocating and discarding that thirty
times a second is exactly the per-frame allocation the model is arranged to
avoid; ui/canvas passes the live ImageData's own array."
([r palette-rgb] (->rgba r palette-rgb 1 nil))
([r palette-rgb zoom] (->rgba r palette-rgb zoom nil))
([{:keys [w h buf]} palette-rgb zoom dest]
(let [W (* w zoom)
H (* h zoom)
d (js/Uint8ClampedArray. (* W H 4))]
d (or dest (js/Uint8ClampedArray. (* W H 4)))]
(loop [y 0]
(when (< y H)
(let [srow (* (js/Math.floor (/ y zoom)) w)]
@ -148,3 +187,20 @@
(recur (inc x)))))
(recur (inc y))))
{:width W :height H :data d})))
(defn draw-ops!
"Paint a list of draw ops, in the order given, into the raster. Stage 7.
This is the boundary the whole model is arranged around: an op carries raster
space points and a PALETTE INDEX, and the rasteriser knows nothing about nodes,
channels, time maps or provenance. Everything above here can be rearranged
without touching a scanline, and a painted cel and a rotoscoped mouth arrive
here indistinguishable from each other, which is the point."
[r ops]
(doseq [{:keys [kind pts n color stencil cx cy size] :as op} ops]
(case kind
:poly (fill-poly-buf! r pts n color)
:disc (fill-disc! r cx cy (:r op) color stencil)
:rect (fill-rect! r cx cy size color stencil)
(throw (ex-info "draw op kind is not rasterisable" {:op (dissoc op :pts)}))))
r)

395
frontend/src/arthur/domain/scene.cljs Normal file
View file

@ -0,0 +1,395 @@
(ns arthur.domain.scene
"The scene: a flat map of id -> node, and the two ways to evaluate it at a
frame.
(eval-frame scene f store) THE SPECIFICATION. Allocating, order-free,
obviously correct. Use it in tests and for a
one-off render.
(resolver scene store) -> (fn [f] ops). What playback uses. Caches the
topological order and the z paths, holds one
CURSOR per channel and one PREALLOCATED point
buffer per node, so a frame allocates the op
maps and nothing else.
Both run the same walk — `eval-into` below — parameterised by how a channel is
read and where points are written. That is deliberate: two independent
implementations of frame evaluation would drift, and the drift would look like
a rendering bug rather than like two functions disagreeing. What differs
between them is exactly the part that can be wrong, and scene-test asserts they
agree frame for frame in forward, backward and random order.
The output is a list of DRAW OPS, and it is the boundary with the rasteriser:
ops carry palette indices and raster-space points, and the rasteriser knows
nothing about nodes, channels or time.
Geometry is stored FLAT — [x0 y0 x1 y1 …] — in authored channels as well as
dense ones. A dense block is a rectangular Int16Array and an authored ring is a
vector of numbers, and they read the same way, which is what makes freezing
fill in the same channel rather than convert into a second format."
(:require [arthur.domain.channel :as ch]
[arthur.domain.node :as node]
[arthur.domain.palette :as pal]
[clojure.string :as str]))
;; ---------------------------------------------------------------------------
;; structure: depth, topological order, draw order
(defn depth
"Number of ancestors. Throws on a parent cycle rather than looping forever — a
cycle is reachable from one bad `:node/set-parent`, and a hung tab is a much
worse diagnostic than a stack trace naming the two nodes."
[nodes id]
(loop [id id, d 0, seen #{}]
(let [p (:parent (get nodes id))]
(cond
(nil? p) d
(contains? seen p)
(throw (ex-info "parent cycle in scene" {:node id :cycle (conj seen p)}))
(nil? (get nodes p))
(throw (ex-info "node's :parent is not in the scene" {:node id :parent p}))
:else (recur p (inc d) (conj seen p))))))
(defn order
"Node ids in topological order: every node after its parent.
Sorting by parent depth is enough — it does not need Kahn's algorithm, because
the only edge is parent, and a node's depth is by definition greater than its
parent's. Ties are broken by id so the order is deterministic across runs,
which matters because the draw-order sort below falls back on this position."
[nodes]
(vec (sort-by (juxt #(depth nodes %) #(str %)) (keys nodes))))
(defn z-path
"The node's z index and every ancestor's, root first.
Draw order is depth-first by sibling z, so the key that sorts it is the chain
of z values from the root. A parent's path is a PREFIX of its child's, which is
why a parent draws before its children without that being a special case.
`:z` values are fractional-index STRINGS (\"a1\", \"a3\") and compare
lexicographically, so a node can always be inserted between two siblings
without renumbering either."
[nodes id]
(loop [id id, acc ()]
(if (nil? id)
(vec acc)
(let [n (get nodes id)]
(recur (:parent n) (conj acc (:z n)))))))
(defn- z-lex
"Lexicographic compare of two z paths, a prefix sorting first.
`compare` on vectors will not do: it compares COUNT first, so a deep
descendant of \"a1\" would sort after a shallow \"a2\" and a painted cel would
jump in front of the head that carries it."
[a b]
(let [na (count a), nb (count b)]
(loop [i 0]
(if (or (= i na) (= i nb))
(- na nb)
(let [c (compare (nth a i) (nth b i))]
(if (zero? c) (recur (inc i)) c))))))
(defn- op-compare [x y]
(let [c (z-lex (:z-path x) (:z-path y))]
(if (zero? c) (- (:i x) (:i y)) c)))
;; ---------------------------------------------------------------------------
;; colour
(defn colour-index
"Tone keyword -> the index the raster writes, in a given palette.
`palette` is a map of tone -> index. It is a PARAMETER, not a global: a tone
names which mark this is, and which ramp it is read in belongs to the timeline
the node sits in, so resolution cannot reach for one ambient answer. Today
there is one palette and it is passed in anyway; when timelines carry a
`:palette` channel, the walk carries the palette in scope exactly as it already
carries the parent transform and the local frame.
An unknown tone resolves to 255, which the palette expansion renders MAGENTA.
Loud rather than fatal, and the same choice raster/->rgba already makes:
naming a colour the ramp does not have is a bug in authored data, and it should
be impossible to miss and should not take the frame down."
[palette k]
(cond
(number? k) k
(nil? k) 255
:else (get palette k 255)))
;; ---------------------------------------------------------------------------
;; the walk
(defn- in-span?
"`:span` is Lottie's ip/op and Flash's PlaceObject/RemoveObject: the range over
which the node EXISTS, tested in the PARENT's frame space and therefore before
the node's own time map runs. Distinct from `[:vis]`, which blinks an existing
node on and off. Half-open, so two adjacent spans do not both own a frame."
[n f]
(if-let [[in out] (:span n)]
(and (>= f in) (< f out))
true))
(defn- finish
"Resolve stencils, then sort into draw order.
A stencil is a COLOUR KEY, not a node reference: it is the take format's
`clip=`, and the indexed buffer being its own clip mask is what keeps the iris
inside the eye at any gaze and any radius without a per-part mask. So the
stencil node's own colour is looked up here, after the walk, because the
stencil may sit anywhere in the order. Two nodes sharing a palette entry share
a stencil, which is inherent to the technique rather than a defect in it.
A node stencilled by something that drew NOTHING is DROPPED, not drawn
unclipped: unclipped would be an iris floating over the cheek on exactly the
frames where the eye is missing."
[ops]
(let [by-id (into {} (map (juxt :node :color)) ops)]
(->> ops
(keep (fn [op]
(if-let [s (:stencil op)]
(when-let [idx (get by-id s)]
(assoc op :stencil idx))
op)))
(sort op-compare)
vec)))
(defn- eval-into
"The one frame evaluation, parameterised by how a channel is read and where its
points are written.
read (fn [id path channel local-frame] -> v)
palette tone -> index, the ramp in scope
mat-for (fn [id] -> Float64Array) the node's world transform
pinv-for (fn [id] -> Float64Array|nil) its parent-inverse
buf-for (fn [id n-points] -> Float64Array)
scratch one spare 6-element matrix
Returns ops in z order."
[nodes ord zpaths read palette mat-for pinv-for buf-for scratch f]
(let [cnt (count ord)]
(loop [i 0, placed {}, ops []]
(if (= i cnt)
(finish ops)
(let [id (nth ord i)
n (get nodes id)
pid (:parent n)
parent (when pid (get placed pid))]
;; A node whose parent was dropped is dropped with it, and so is
;; everything under it. Topological order is what makes that one
;; lookup instead of a subtree walk.
(if (and pid (nil? parent))
(recur (inc i) placed ops)
(let [pf (if parent (:f parent) f)]
(if-not (in-span? n pf)
(recur (inc i) placed ops)
(let [chs (node/channels n)
lf (node/local-frame n pf)
rd (fn [path] (read id path (get chs path) lf))
vis (rd [:vis])
pos (rd [:xform :pos])
rot (rd [:xform :rot])
scl (rd [:xform :scale])
skw (rd [:xform :skew])
anc (rd [:xform :anchor])]
;; [:vis] and the transform gate the DESCENDANTS as well as the
;; node: a switched-off feature takes its parts with it, and a
;; node with no transform gives its children nowhere to be.
;;
;; A missing [:geom :pts] does NOT gate descendants. An absent
;; mouth outline has nothing to draw, but the head it hangs off
;; is still exactly where it was. That asymmetry is the whole
;; reason presence is tracked per channel rather than per node.
(if-not (and (true? vis)
(not (ch/nothing? pos)) (not (ch/nothing? rot))
(not (ch/nothing? scl)) (not (ch/nothing? skw))
(not (ch/nothing? anc)))
(recur (inc i) placed ops)
;; dest aliases `local` here, which mul! allows: it reads both
;; operands fully before writing either.
(let [m (node/local! (mat-for id) pos rot scl skw anc)
m (node/world! m (:m parent) (pinv-for id) m scratch)
base {:i i :z-path (get zpaths id) :node id
:stencil (:stencil n)}
op (case (:kind n)
:group nil
:poly
(let [pts (rd [:geom :pts])]
(when-not (ch/nothing? pts)
(let [np (quot (if (vector? pts) (count pts) (.-length pts)) 2)
out (buf-for id np)]
(dotimes [k np]
(node/apply-pt! out k m
(ch/component pts (* 2 k))
(ch/component pts (inc (* 2 k)))))
(assoc base :kind :poly :pts out :n np
:color (colour-index palette (rd [:style :color]))))))
:disc
(let [rad (rd [:geom :radius])]
(when-not (ch/nothing? rad)
(assoc base :kind :disc
:cx (aget m 4) :cy (aget m 5)
:r (* rad (node/mean-scale m))
:color (colour-index palette (rd [:style :color])))))
:rect
(let [size (rd [:geom :size])]
(when-not (ch/nothing? size)
(assoc base :kind :rect
:cx (aget m 4) :cy (aget m 5)
;; ROUNDED, because :size is a pixel
;; count: a scaled square 3.4px wide
;; would be 3px on one frame and 4 on
;; the next, which reads as the pupil
;; breathing. See raster/fill-rect!.
:size (js/Math.round (* size (node/mean-scale m)))
:color (colour-index palette (rd [:style :color])))))
(throw (ex-info "node kind is not implemented"
{:node id :kind (:kind n)})))]
(recur (inc i)
(assoc placed id {:m m :f lf})
(cond-> ops op (conj op))))))))))))))
;; ---------------------------------------------------------------------------
;; the specification
(defn eval-frame
"Scene at clip frame f -> draw ops in z order. Pure, and allocates freely.
This is the definition of what a frame means. `resolver` is what plays it."
([scene f] (eval-frame scene f nil pal/index-of))
([scene f store] (eval-frame scene f store pal/index-of))
([scene f store palette]
(let [nodes (:nodes scene)
ord (order nodes)
zpaths (into {} (map (fn [id] [id (z-path nodes id)])) ord)]
(eval-into nodes ord zpaths
(fn [_id _path c lf] (ch/value-at c lf store))
palette
(fn [_id] (node/mat))
(fn [id] (node/pinv (get nodes id)))
(fn [_id n] (js/Float64Array. (* 2 n)))
(node/mat)
f))))
;; ---------------------------------------------------------------------------
;; the playback path
(defn- point-capacity
"How many points the widest value of a [:geom :pts] channel holds.
FIXED TOPOLOGY is what makes this a number at all: every key of a part carries
the same vertex count with the same vertex meanings, so the buffer can be
allocated once. A variable vertex count would force a per-frame offset table
and a scan, which is why the aesthetic constraint is a performance asset rather
than a cost."
[c]
(quot (cond
(:dense c) (:stride (:dense c))
(:animated? c) (transduce (map #(if (vector? %) (count %) (.-length %)))
max 0 (vals (:keys c)))
:else (let [v (:value c)] (if (vector? v) (count v) (.-length v))))
2))
(defprotocol IResolver
(world-of [this id]
"The node's world transform AS OF THE LAST FRAME RESOLVED, or nil if it was
not placed on that frame.
The matrices are the ones evaluation mutates in place, so this is a read of
live state rather than a snapshot — which is exactly what the caller wants.
A registered photo underlay has to ride the same transform the vectors went
through or it is merely decorative, and it paints immediately after the frame
it belongs to, so \"as of the last frame\" is the only answer that can be
correct."))
(defn resolver
"(fn [f] -> ops). Holds everything that does not change per frame.
The point buffers are REUSED between frames, so a caller must consume the ops
before asking for the next frame. That is the contract the rAF loop wants
anyway — it reads, blits, and dispatches nothing — and it is what makes a frame
cost a lookup and a blit rather than an allocation per vertex.
The op maps themselves are allocated fresh, and deliberately: there are a dozen
of them per frame against hundreds of points, so pooling them would buy
nothing and cost the ability to hand an op list around as plain data."
([scene] (resolver scene nil pal/index-of))
([scene store] (resolver scene store pal/index-of))
([scene store palette]
(let [nodes (:nodes scene)
ord (order nodes)
zpaths (into {} (map (fn [id] [id (z-path nodes id)])) ord)
cursors (into {}
(map (fn [id]
[id (into {} (map (fn [[p c]] [p (ch/cursor c store)]))
(node/channels (get nodes id)))]))
ord)
mats (into {} (map (fn [id] [id (node/mat)])) ord)
pinvs (into {} (keep (fn [id] (when-let [p (node/pinv (get nodes id))] [id p]))) ord)
bufs (into {}
(keep (fn [id]
(when-let [c (get-in nodes [id :channels [:geom :pts]])]
[id (js/Float64Array. (* 2 (point-capacity c)))])))
ord)
scratch (node/mat)
;; Every call to mat-for is a placement: eval-into reaches it only after
;; the span, visibility and transform gates have all passed. So wrapping
;; it is how the resolver learns which nodes exist this frame without
;; eval-into having to report it — and it covers groups, which are
;; placed but emit no op, and which are exactly what an underlay rides.
placed (volatile! #{})
step (fn [f]
(vreset! placed #{})
(eval-into nodes ord zpaths
(fn [id path _c lf] (ch/sample! (get-in cursors [id path]) lf))
palette
(fn [id] (vswap! placed conj id) (get mats id))
(fn [id] (get pinvs id))
(fn [id _n] (get bufs id))
scratch
f))]
(reify
IFn
(-invoke [_ f] (step f))
IResolver
(world-of [_ id] (when (contains? @placed id) (get mats id)))))))
;; ---------------------------------------------------------------------------
(defn problems
"Human-readable reasons this scene will not evaluate. Empty means it will.
Total by construction — it reports a cycle rather than looping on one — because
its whole job is to be safe to run over authored data before that data is
trusted."
[scene]
(let [nodes (:nodes scene)]
(if-not (map? nodes)
[":nodes must be a map of id -> node"]
(-> []
(into (for [[id n] nodes
:when (not= id (:id n))]
(str "node under key " (pr-str id) " has :id " (pr-str (:id n)))))
(into (for [[id n] nodes
:when (and (:parent n) (not (contains? nodes (:parent n))))]
(str "node " (pr-str id) " has :parent " (pr-str (:parent n))
" which is not in the scene")))
(into (for [[id n] nodes
:when (and (:stencil n) (not (contains? nodes (:stencil n))))]
(str "node " (pr-str id) " has :stencil " (pr-str (:stencil n))
" which is not in the scene")))
(into (for [[id n] nodes
p (node/problems n)]
(str "node " (pr-str id) ": " p)))
(into (try
(doall (map #(depth nodes %) (keys nodes)))
nil
(catch :default e [(ex-message e)])))))))
(defn problems-str [scene]
(str/join "; " (problems scene)))

100
frontend/src/arthur/events/playback.cljs Normal file
View file

@ -0,0 +1,100 @@
(ns arthur.events.playback
"Transport events.
Named for intent rather than for the field they happen to set: `::toggle` is
not `set-playing?`, because what the button means is \"start or stop\", and the
resulting boolean is a consequence.
NO GLOBAL INTERCEPTORS ON ::tick. At 30fps a spec-validating `after` or
`std-interceptors/debug`'s `clojure.data/diff` would be thirty full-db
traversals a second, which is the one genuinely expensive thing you can do to
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]
[re-frame.core :as rf]))
(defn- fps [db] (get-in db [:clip :fps]))
(defn- frames [db] (get-in db [:clip :frames]))
(rf/reg-event-db
::tick
(fn [db [_ f]]
;; Written from the rAF loop when the DERIVED frame changes — not every
;; animation frame, and never as the thing the blit waits on. The picture is
;; painted from the clock directly; this only brings the document's idea of
;; the playhead up to date so the readout and the scrubber agree with it.
(if (= f (get-in db [:playback :frame]))
db
(assoc-in db [:playback :frame] f))))
(rf/reg-event-fx
::play
(fn [{:keys [db]} _]
{:db (assoc-in db [:playback :playing?] true)
::play! nil}))
(rf/reg-event-fx
::pause
(fn [{:keys [db]} _]
{:db (assoc-in db [:playback :playing?] false)
::pause! nil}))
(rf/reg-event-fx
::toggle
(fn [{:keys [db]} _]
(if (get-in db [:playback :playing?])
{:db (assoc-in db [:playback :playing?] false) ::pause! nil}
{:db (assoc-in db [:playback :playing?] true) ::play! nil})))
(rf/reg-event-fx
::seek
(fn [{:keys [db]} [_ f]]
(let [f (-> f (max 0) (min (dec (frames db))))]
{:db (assoc-in db [:playback :frame] f)
::seek! [(fps db) (frames db) f]})))
(rf/reg-event-fx
::step
(fn [{:keys [db]} [_ delta]]
{:fx [[:dispatch [::seek (+ (get-in db [:playback :frame]) delta)]]]}))
(rf/reg-event-fx
::set-rate
(fn [{:keys [db]} [_ r]]
{:db (assoc-in db [:playback :rate] r)
::rate! r}))
;; --- effects: every DOM touch on the audio element is one of these ---
(rf/reg-fx ::play! (fn [_] (clock/play!)))
(rf/reg-fx ::pause! (fn [_] (clock/pause!)))
(rf/reg-fx ::rate! (fn [r] (clock/set-rate! r)))
(rf/reg-fx ::seek! (fn [[fps frames f]] (clock/seek! fps frames f)))
(rf/reg-fx ::loop! (fn [on?] (clock/set-loop! on?)))
(rf/reg-fx ::mute! (fn [on?] (clock/set-muted! on?)))
(rf/reg-event-fx
::toggle-loop
(fn [{:keys [db]} _]
(let [on? (not (get-in db [:playback :loop?]))]
{:db (assoc-in db [:playback :loop?] on?) ::loop! on?})))
(rf/reg-event-fx
::toggle-mute
(fn [{:keys [db]} _]
(let [on? (not (get-in db [:playback :muted?]))]
{:db (assoc-in db [:playback :muted?] on?) ::mute! on?})))
(rf/reg-event-fx
::select-scene
(fn [{:keys [db]} [_ id]]
;; 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]} (get db/scenes id)]
{:db (-> db
(assoc :scene/current id)
(assoc :clip {:fps fps :frames frames})
(assoc-in [:playback :frame] 0))
::seek! [fps frames 0]})))

13
frontend/src/arthur/subs/playback.cljs Normal file
View file

@ -0,0 +1,13 @@
(ns arthur.subs.playback
"Layer-2 extractors over the transport. Cheap by construction: each one reads a
path and returns a value, so a tick that changes only `:frame` notifies only
the things that asked for `:frame`."
(:require [re-frame.core :as rf]))
(rf/reg-sub ::frame (fn [db _] (get-in db [:playback :frame])))
(rf/reg-sub ::playing? (fn [db _] (get-in db [:playback :playing?])))
(rf/reg-sub ::rate (fn [db _] (get-in db [:playback :rate])))
(rf/reg-sub ::loop? (fn [db _] (get-in db [:playback :loop?])))
(rf/reg-sub ::muted? (fn [db _] (get-in db [:playback :muted?])))
(rf/reg-sub ::fps (fn [db _] (get-in db [:clip :fps])))
(rf/reg-sub ::frames (fn [db _] (get-in db [:clip :frames])))

60
frontend/src/arthur/subs/render.cljs Normal file
View file

@ -0,0 +1,60 @@
(ns arthur.subs.render
"Stage 6. The subscription graph IS the staged dataflow — each stage is a
layer-3 sub over the previous one plus the parameters for its stage only,
which is what makes changing one knob recompute one thing.
`::resolver` is the shape that matters. It does not yield geometry; it yields a
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]
[arthur.domain.scene :as scene]
[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
::exposure
:<- [::scene]
(fn [scene _]
;; Exposure lives on the clip root and is INHERITED, so reading it there is
;; reading it everywhere. The transport shows it so that `exposure 2` is
;; visibly doing something at the transport rather than only inside the scene.
(or (get-in scene [:nodes :root :time :expose]) 1)))
(rf/reg-sub
::palette
(fn [db _]
;; A NAME resolves to a ramp. One today; when timelines carry a `:palette`
;; channel this becomes the project's table and the walk carries the ramp in
;; scope, which is why domain/scene takes the palette as a parameter rather
;; than reaching for a global.
(get {:arthur/default pal/index-of} (:palette db) pal/index-of)))
(rf/reg-sub
::ramp
(fn [db _]
;; index -> [r g b]. The other half of the palette: `::palette` says which
;; INDEX a tone resolves to, this says what that index LOOKS LIKE. Two subs
;; because two different consumers — evaluation needs the first, the blit
;; needs the second, and neither wants the other's map.
(get {:arthur/default pal/rgb} (:palette db) pal/rgb)))
(rf/reg-sub
::store
(fn [db _]
;; 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])))
(rf/reg-sub
::resolver
:<- [::scene]
:<- [::store]
:<- [::palette]
(fn [[scene store palette] _]
(scene/resolver scene store palette)))

45
frontend/src/arthur/ui/canvas.cljs Normal file
View file

@ -0,0 +1,45 @@
(ns arthur.ui.canvas
"The one imperative sink.
Everything below here is pure and returns bytes; this is where bytes become
pixels, and it is the only namespace allowed to touch a canvas. domain/raster
deliberately stops at `->rgba` returning plain bytes — an ImageData is a DOM
type, and keeping it out of domain/ is what lets every rasteriser assertion run
under node.
THE CANVAS IS THE RASTER'S OWN SIZE and is scaled up by CSS with
`image-rendering: pixelated`, rather than by expanding in `->rgba`. Two reasons:
a 2x expansion in JS is four times the bytes to write per frame for a result
the GPU gives away, and nearest-neighbour is then the browser's guarantee rather
than something this code has to keep being right about. A browser that smoothed
the upscale would misrepresent the exact thing the preview exists to judge, so
the CSS rule is load-bearing and lives in the host page next to the canvas."
(:require [arthur.domain.palette :as pal]
[arthur.domain.raster :as raster]))
(defonce ^:private cache
;; canvas element -> its ImageData, so a frame writes into the array the
;; canvas already owns instead of allocating a quarter of a megabyte.
(atom {}))
(defn- image-data-for [^js ctx ^js el w h]
(let [have (get @cache el)]
(if (and have (= w (.-width have)) (= h (.-height have)))
have
(let [img (.createImageData ctx w h)]
(swap! cache assoc el img)
img))))
(defn blit!
"Expand an indexed raster through the palette and put it on the canvas."
([el r] (blit! el r pal/rgb))
([^js el {:keys [w h] :as r} palette-rgb]
(when el
;; Guarded: assigning width reallocates the backing store, so doing it
;; unconditionally would throw a canvas away thirty times a second.
(when (not= w (.-width el)) (set! (.-width el) w))
(when (not= h (.-height el)) (set! (.-height el) h))
(let [ctx (.getContext el "2d")
img (image-data-for ctx el w h)]
(raster/->rgba r palette-rgb 1 (.-data img))
(.putImageData ctx img 0 0)))))

189
frontend/src/arthur/ui/player.cljs Normal file
View file

@ -0,0 +1,189 @@
(ns arthur.ui.player
"The rAF loop. Stage 6 and 7, driven.
THE LOOP READS AND BLITS. It does not compute geometry, it does not build a
resolver, and it does not wait on the event queue to paint. Per frame it reads
the audio clock, applies a closure it already has, and writes bytes — a lookup
and a blit, with no allocation beyond the op maps.
It is not a Reagent component and must not become one. Stage 7 writes into a
canvas from an animation frame; it is a sink, not a view that re-renders, and
the actual content of the folklore about re-frame and canvas is that expensive
work must not live in a layer-2 sub. The resolver is a layer-3 sub over the
scene, so the playhead moving cannot invalidate it.
The one dispatch is `::playback/tick`, and it is deliberately NOT what the
picture waits on: the frame is painted from the clock directly, and the tick
only brings the document's playhead up to date so the readout and the scrubber
agree with what is on screen. It fires when the derived frame CHANGES — thirty
times a second at a 30fps clip on a 60Hz display, not sixty — and it carries
no global interceptors."
(:require [arthur.clock :as clock]
[arthur.domain.raster :as raster]
[arthur.events.playback :as pb]
[arthur.subs.playback :as sub]
[arthur.subs.render :as render]
[arthur.ui.canvas :as canvas]
[re-frame.core :as rf]
[reagent.ratom :as ratom]))
(defonce ^:private state
(atom {:raf nil :canvas nil :raster nil :last -1}))
;; ---------------------------------------------------------------------------
;; the snapshot
;;
;; A PLAIN MAP that re-frame pushes into, which the loop reads without doing any
;; reactive work at all.
;;
;; This is not an optimisation, it is a correctness fix. A Reagent reaction
;; caches its value only while it has a watcher; deref it from outside a
;; reactive context — an rAF callback, say — and it RE-RUNS on every deref. So
;; `@(rf/subscribe [::render/resolver])` in the loop was rebuilding the resolver
;; sixty times a second: the topological order, the z paths, a cursor per
;; channel and a preallocated buffer per node, all of it, per frame. On the
;; five-node demo scene that was invisible. On a hundred-and-twenty-node scene
;; it was 3.6fps against a 170fps ceiling, and it presented as "the renderer is
;; slow" rather than as "the caching you assumed is not happening".
;;
;; `ratom/run!` keeps an always-active reaction, so the subscriptions it derefs
;; have a watcher and therefore cache, and the loop reads a plain atom.
;; Measured paint rate and mean clip-frames advanced per paint. A Reagent atom,
;; so the transport re-renders on it.
;;
;; `:drop` is the informative one. At 1.0 the loop is painting every frame the
;; clock asks for. Above it the clock is moving faster than the painting and
;; frames are being DROPPED — which is the designed failure rather than a bug,
;; but it is a thing to see rather than to infer.
(defonce meter (ratom/atom {:fps 0 :drop 0}))
(defonce ^:private meter-state
(atom {:t0 nil :paints 0 :samples 0 :advanced 0 :prev nil}))
(def ^:private ^:const max-credible-advance
;; A jump bigger than this is a seek or a loop wrap, not a dropped frame. Both
;; move the playhead by an arbitrary amount in one tick, and counting either as
;; a drop makes the readout say the renderer is failing whenever the clip
;; restarts — which is exactly when a profile is running.
16)
(defn- meter! [f]
(let [now (js/performance.now)
{:keys [t0 paints samples advanced prev]} @meter-state]
(if (nil? t0)
(reset! meter-state {:t0 now :paints 0 :samples 0 :advanced 0 :prev f})
(let [d (when prev (- f prev))
credible (and d (pos? d) (<= d max-credible-advance))
paints (inc paints)
samples (if credible (inc samples) samples)
advanced (if credible (+ advanced d) advanced)
dt (- now t0)]
(if (>= dt 500)
(do (reset! meter {:fps (/ (* 1000 paints) dt)
:drop (if (pos? samples) (/ advanced samples) 0)})
(reset! meter-state {:t0 now :paints 0 :samples 0 :advanced 0 :prev f}))
(reset! meter-state {:t0 t0 :paints paints :samples samples
:advanced advanced :prev f}))))))
(defonce ^:private snapshot (atom {}))
(defonce ^:private tracker (atom nil))
(defn- repaint! []
(swap! state assoc :last -1))
(defn refresh-subs!
"Build (or rebuild) the tracking reaction. Rebuilt on hot reload, because
clearing the subscription cache orphans the reactions this holds."
[]
(some-> @tracker ratom/dispose!)
(reset! tracker
(ratom/run!
(let [was (:resolver @snapshot)
now @(rf/subscribe [::render/resolver])]
(reset! snapshot
{:resolver now
:palette @(rf/subscribe [::render/palette])
:ramp @(rf/subscribe [::render/ramp])
:fps @(rf/subscribe [::sub/fps])
:frames @(rf/subscribe [::sub/frames])
:frame @(rf/subscribe [::sub/frame])
:playing? @(rf/subscribe [::sub/playing?])})
;; A new resolver means a new scene or a new palette, and neither
;; moves the playhead — so nothing else would ask for a redraw.
(when-not (identical? was now) (repaint!))))))
(defn set-canvas! [el]
(swap! state assoc :canvas el)
;; The :ref fires AFTER the loop has started, so the first tick or two run
;; with nowhere to draw. Without this the loop would record frame 0 as
;; painted, find it unchanged on every subsequent tick, and never draw at all
;; — a blank canvas under a transport reading perfectly correct.
(when el (repaint!)))
(defn- raster-for [w h]
(let [{:keys [raster]} @state]
(if (and raster (= w (:w raster)) (= h (:h raster)))
raster
(:raster (swap! state assoc :raster (raster/make w h))))))
(defn paint!
"Resolve `f` and put it on the canvas. `ops` are consumed here and only here —
the resolver reuses its point buffers between frames, so they have to be
rasterised before the next frame is asked for."
[f]
(let [{:keys [canvas]} @state
{:keys [resolver palette ramp]} @snapshot]
(when (and canvas resolver)
;; User Timing, so a profile in the DevTools performance panel has named
;; spans in the Timings track instead of a wall of anonymous frames. Three
;; lines, and the difference between reading a profile and guessing at one.
(js/performance.mark "arthur/paint:start")
(let [ras (raster-for 320 200)]
(-> ras
(raster/clear! (get palette :bg 0))
(raster/draw-ops! (resolver f)))
(js/performance.mark "arthur/blit:start")
(canvas/blit! canvas ras ramp))
(js/performance.measure "arthur/resolve+draw" "arthur/paint:start" "arthur/blit:start")
(js/performance.measure "arthur/paint" "arthur/paint:start"))))
(defonce ^:private watch
;; A scene swap changes the resolver and not the frame number, so the loop
;; would sit on an unchanged playhead and never redraw. Watching the reaction
;; is cheaper than making every event that can touch the scene remember to.
(atom nil))
(defn- tick! []
(let [{:keys [fps frames frame playing?]} @snapshot
live? (clock/playing?)
ready? (some? (:canvas @state))
;; DERIVED, never counted. A slow frame drops the frames it missed and
;; the next one lands where the audio already is, so the failure mode is
;; a visible stutter rather than an invisible slide out of sync.
f (if live? (clock/frame fps frames) frame)]
;; `ready?` gates the bookkeeping as well as the draw: recording a frame as
;; painted when it was not is how the canvas stays empty forever.
(when (and ready? f (not= f (:last @state)))
(swap! state assoc :last f)
(paint! f)
(meter! f)
(when live? (rf/dispatch [::pb/tick f])))
;; The audio ending is the authority on playback having stopped; nothing
;; counts frames to notice it.
(when (and (not live?) playing?)
(rf/dispatch [::pb/pause]))))
(defn- frame-loop []
(tick!)
(swap! state assoc :raf (js/requestAnimationFrame frame-loop)))
(defn start! []
(refresh-subs!)
(when-not (:raf @state)
(swap! state assoc :raf (js/requestAnimationFrame frame-loop))))
(defn stop! []
(when-let [id (:raf @state)]
(js/cancelAnimationFrame id)
(swap! state assoc :raf nil)))

95
frontend/src/arthur/ui/shell.cljs Normal file
View file

@ -0,0 +1,95 @@
(ns arthur.ui.shell
"The page. Transport, canvas, readouts.
Nothing here computes anything about a frame: it dispatches intents and reads
extractors. The picture is put on the canvas by ui/player's loop, not by this
component re-rendering — which is why the canvas has no reactive content and
why scrubbing at speed does not re-render the page."
(:require [arthur.clock :as clock]
[arthur.db :as db]
[arthur.demo :as demo]
[arthur.events.playback :as pb]
[arthur.subs.playback :as sub]
[arthur.subs.render :as render]
[arthur.ui.player :as player]
[re-frame.core :as rf]))
(def ^:private zoom 2)
(defn- audio []
[:audio
{:ref #(when % (clock/attach! %))
:src "/audio.wav"
: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])}])
(defn- transport []
(let [playing? @(rf/subscribe [::sub/playing?])
rate @(rf/subscribe [::sub/rate])
frame @(rf/subscribe [::sub/frame])
frames @(rf/subscribe [::sub/frames])
fps @(rf/subscribe [::sub/fps])
expose @(rf/subscribe [::render/exposure])]
[:div.transport
[:div.row
[:button {:on-click #(rf/dispatch [::pb/toggle])}
(if playing? "pause" "play")]
[:button {:on-click #(rf/dispatch [::pb/seek 0])} "|<"]
[:button {:on-click #(rf/dispatch [::pb/step -1])} "-1"]
[:button {:on-click #(rf/dispatch [::pb/step 1])} "+1"]
[:button {:class (when @(rf/subscribe [::sub/loop?]) "on")
:on-click #(rf/dispatch [::pb/toggle-loop])} "loop"]
[:button {:class (when @(rf/subscribe [::sub/muted?]) "on")
:on-click #(rf/dispatch [::pb/toggle-mute])} "mute"]
[:span.gap]
(doall
(for [[id {:keys [label]}] db/scenes]
^{:key id}
[:button {:class (when (= id @(rf/subscribe [::render/scene-id])) "on")
:on-click #(rf/dispatch [::pb/select-scene id])}
label]))
[:span.gap]
(doall
(for [r db/rates]
^{:key r}
[:button {:class (when (== r rate) "on")
;; playbackRate and nothing else: the audio slows, currentTime
;; advances proportionally, and the derived frame follows. Slow
;; motion cannot desync by construction.
:on-click #(rf/dispatch [::pb/set-rate r])}
(case r 1.0 "1x" 0.5 "1/2x" 0.25 "1/4x" 2.0 "2x" 4.0 "4x" (str r))]))]
[:input.scrub
{:type "range" :min 0 :max (dec frames) :step 1 :value frame
:on-change #(rf/dispatch [::pb/seek (js/parseInt (.. % -target -value) 10)])}]
[:div.readout
[:span (str "frame " frame " / " frames)]
[:span (str fps " fps")]
[:span (str "exposure " expose " → holds " (clock/exposed-frame frame expose))]
[:span (str (js/Math.round (* 100 rate)) "%")]
;; Measured in the loop, not derived from the clock: the whole question
;; while profiling is whether the painting keeps up with the clock, so a
;; number computed FROM the clock would answer itself.
(let [{:keys [fps drop]} @player/meter]
[: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")))])]]))
(defn view []
[:main
[:h1 "arthur"]
[:canvas.stage
{:ref #(player/set-canvas! %)
:width demo/width :height demo/height
:style {:width (str (* zoom demo/width) "px")
:height (str (* zoom demo/height) "px")}}]
[audio]
[transport]
[:p.note
"Audio-clocked: the frame is ⌊currentTime · fps⌋, so a slow loop drops "
"frames instead of drifting. ½× and ¼× are playbackRate."]])