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

Split the shell into topbar, pool, stage, timeline and params panes

Browse source 
Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
This commit is contained in:
Olive Vaughn 2026-09-29 12:25:46 -04:00
parent ddabfbeaa8
commit 179770d7d4
24 changed files with 2138 additions and 611 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -7,9 +7,11 @@
[arthur.events.footage :as footage]
[arthur.events.playback]
[arthur.events.paint]
[arthur.events.project]
[arthur.events.project :as project]
[arthur.events.ui]
[arthur.subs.playback]
[arthur.subs.render]
[arthur.subs.ui]
[arthur.ui.player :as player]
[arthur.ui.shell :as shell]
[re-frame.core :as rf]
@ -28,6 +30,10 @@
(defn init []
(rf/dispatch-sync [::init])
;; A blank document, before the first render. Synchronous for the same reason
;; `::init` is: the shell reads the clip's dimensions, and mounting against a
;; db that has no clip in it yet is a frame of nothing for no reason.
(rf/dispatch-sync [::project/new])
;; What the server already holds, asked for once. The list is small — a row per
;; ingested take — and having it before the first click is what lets the footage
;; picker be a picker rather than a path to type.

53
frontend/src/arthur/db.cljs
View file

@ -54,7 +54,14 @@
(def default
{;; --- the document ---
:clip/current :take
;;
;; NOTHING IS LOADED. `core/init` dispatches `::project/new` before the first
;; render, so the app opens on a blank stage rather than on whichever built-in
;; scene happened to be convenient — the demos, the swarm and the two takes are
;; rows in the media pool like anything else, and reference material is not a
;; default. The values below are what a blank document is; they are replaced by
;; that dispatch and exist so this map is a valid db on its own.
:clip/current nil
:paint/revision 0
:palette :arthur/default ; a NAME; the ramp itself is project data
@ -64,7 +71,10 @@
;; footage's. That is what deleting `makeXform` buys — the framing became a
;; transform on a node, so nothing downstream of the freeze knows the frame
;; size — and it is why ui/player no longer hardcodes 320x200.
:clip (select-keys (clip-entry :take) [:fps :frames :width :height :audio :display-fps])
:clip (let [c (domain-clip/blank)]
{:fps (:fps c) :frames (domain-clip/frames c)
:width (:width c) :height (:height c)
:audio nil :display-fps (:fps c)})
;; Which ingested footage to detect, and what the last load said. The list
;; comes from the server — tier 3 is the backend's since step 9 — so there is
@ -77,6 +87,10 @@
;; is what will make staleness self-healing once there is a broadcast to miss.
:project {:id nil :cid nil :name nil :seq nil :busy? false :status nil}
;; What the server holds, for the open menu. A list of rows and nothing more —
;; opening one fetches the document itself.
:projects {:items [] :loading? false}
;; --- transport ---
;;
;; The playhead is in app-db like everything else. An earlier draft of
@ -105,7 +119,40 @@
;; 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}})
:muted? false}
;; --- the editor's own state ---
;;
;; IN app-db, not in ratoms beside the components that read it. What is
;; selected is asked by four panes at once — the params pane renders it, the
;; timeline highlights its row, the stage draws its handles, the palette says
;; which tone a new shape gets — and a `defonce` atom private to one namespace
;; can only be shared by making the other three require that namespace for its
;; state. It is also small and authored, which is the bar `arthur.db` sets.
;;
;; `:selection` is a vector whose first element says what kind of thing it
;; names, so a pane dispatches on it rather than on which of several
;; "selected-x" keys happens to be non-nil:
;;
;; [:node <timeline> <node>] a shape or a placement
;; [:timeline <id>] a timeline, root or library
;; [:subject <id>] [:feature <id>] [:group <id>] a tracked object
;;
;; `:draft` is the polygon being clicked out, flat [x y x y …] as geometry is
;; stored everywhere. `:expanded` holds timeline row PATHS — a path and not a
;; node id, because one symbol placed twice is two rows that open separately.
;;
;; `:knobs` holds a generated setting's value WHILE THE REGENERATION IS IN
;; FLIGHT, keyed by [scope id knob]. Moving a slider dispatches a preview that
;; re-freezes blocks asynchronously, so until it lands the clip still reports
;; the old value — and a slider reading from the clip would spring back under
;; the user's finger on every frame of the drag.
:ui {:selection nil
:tone :skin-base
:tool nil
:draft []
:knobs {}
:expanded #{}}})
(def rates
"The transport's rates — all of them `playbackRate` on the audio element, so

53
frontend/src/arthur/domain/clip.cljs
View file

@ -83,6 +83,59 @@
[clip]
(:nodes (root clip)))
(def ^:const blank-frames
"How long a new document is before anything says otherwise. Four seconds at 30,
which is long enough to key something into and short enough to scrub by hand."
120)
(defn blank
"A new, empty document.
`:nodes` is empty rather than seeded with a layer, because an empty timeline is
a true statement and a layer nobody asked for is one more thing to delete. The
tracking maps are present and empty for the same reason `clip-keys` exists: a
field that is sometimes absent is a field every reader needs a fallback for."
[]
{:name "untitled"
:fps 30
:width 320 :height 200
:subjects {} :features {} :groups {}
:timelines {root-id {:id root-id :frames blank-frames :nodes {}}}})
(defn place-symbol
"An instance of library timeline `tid`, on the root timeline, at `frame`.
THE UUID IS AN ARGUMENT. A placement's identity is the key it has in the node
map — it is what `:linked-to`, an export target and a saved leaf all name — so
generating one in here would make this function's result depend on when it was
called, and this namespace is the pure one. `demo/stage_8625.edn` authors its
placements' uuids by hand for the same reason, in more words.
The instance's own time starts where it was dropped: `:at frame` with `:in 0`
means local frame 0 of the symbol plays on `frame` of the stage, which is what
dragging something onto a playhead is asking for. `:span` runs to the end of
the root's frame space rather than to the symbol's length, because a symbol
shorter than the space it is placed in should hold its last frame rather than
disappear."
[clip tid frame uuid [x y]]
(let [target (timeline clip tid)
end (frames clip)]
(if (or (nil? target) (= root-id tid) (nil? frame) (neg? frame) (>= frame end))
clip
(update-root
clip assoc-in [:nodes uuid]
{:id uuid
:name (name tid)
:kind :symbol
:of tid
:parent nil
;; Lexicographic draw order, as `domain/paint` does it: a placement made
;; later sits above one made earlier, and neither has to renumber.
:z (str "z" (js/Date.now) "-" (name tid))
:span [frame end]
:time {:mode :map :at frame :in 0 :rate 1}
:channels {[:xform :pos] {:animated? false :value [x y]}}}))))
(defn- transform-op
"Put a symbol's already resolved mark into its instance's parent space."
[op m path]

26
frontend/src/arthur/events/edit.cljs Normal file
View file

@ -0,0 +1,26 @@
(ns arthur.events.edit
"The one way an event changes the loaded document.
Three things have to happen together and the bug is any one of them being
forgotten: the clip in `footage/store` is edited, the id app-db refers to it by
is updated — `edit-clip!` may INSTALL A COPY, because a built-in clip is a
delayed value that must stay reusable — and `:paint/revision` is bumped so the
layer-3 subs downstream of `::render/clip` recompute. The revision exists
because the clip itself is behind a handle: app-db holds an id, the id does not
change when the document does, and a sub keyed only on the id would never see
the edit.
It started life private inside `events/paint`, which was right while polygons
were the only thing anyone could edit. They are not."
(:require [arthur.footage.store :as store]))
(defn edit
"Apply `f` to the loaded clip and return the new db."
[db f]
(let [id (store/edit-clip! (:clip/current db) f)]
(if id
(-> db
(assoc :clip/current id)
(update :paint/revision (fnil inc 0))
(update :project merge {:status "edited · unsaved"}))
db)))

9
frontend/src/arthur/events/footage.cljs
View file

@ -337,9 +337,14 @@
(rf/reg-event-fx
::uploaded
(fn [{:keys [db]} [_ footage-id]]
;; STRAIGHT INTO DETECTION. Dropping a video on the media pool is one
;; intention — get this footage into the tool — and stopping after extraction
;; to wait for a second click only means finding the button that does the
;; obvious next thing. `::load` reads `:chosen`, which this event has just
;; written, because `:dispatch` runs after the db update.
{:db (update db :footage merge {:loading? false :chosen footage-id
:status "video extracted — load frames to analyze"})
:dispatch [::refresh]}))
:status "video extracted"})
:dispatch-n [[::refresh] [::load]]}))
(rf/reg-event-fx
::refresh

21
frontend/src/arthur/events/paint.cljs
View file

@ -1,33 +1,26 @@
(ns arthur.events.paint
"Polygon edits. Every one of them is `edit/edit` plus a pure `domain/paint`
function, which is the shape every document edit in this app should have."
(:require [arthur.domain.paint :as paint]
[arthur.footage.store :as store]
[arthur.events.edit :as edit]
[re-frame.core :as rf]))
(defn- edit [db f]
(let [id (store/edit-clip! (:clip/current db) f)]
(if id
(-> db
(assoc :clip/current id)
(update :paint/revision (fnil inc 0))
(update :project merge {:status "paint edited · unsaved"}))
db)))
(rf/reg-event-db
::new-shape
(fn [db [_ id points color]]
(edit db #(paint/new-shape % id (get-in db [:playback :frame]) points color))))
(edit/edit db #(paint/new-shape % id (get-in db [:playback :frame]) points color))))
(rf/reg-event-db
::add-key
(fn [db [_ id]]
(edit db #(paint/add-key % id (get-in db [:playback :frame])))))
(edit/edit db #(paint/add-key % id (get-in db [:playback :frame])))))
(rf/reg-event-db
::set-vertex
(fn [db [_ id key-frame vertex point]]
(edit db #(paint/set-vertex % id key-frame vertex point))))
(edit/edit db #(paint/set-vertex % id key-frame vertex point))))
(rf/reg-event-db
::set-segment-interp
(fn [db [_ id key-frame interp]]
(edit db #(paint/set-segment-interp % id key-frame interp))))
(edit/edit db #(paint/set-segment-interp % id key-frame interp))))

7
frontend/src/arthur/events/playback.cljs
View file

@ -106,6 +106,13 @@
;; sizes, and the raster the loop paints into is the clip's, not
;; the app's.
(assoc :clip (select-keys clip [:fps :frames :width :height :audio :display-fps]))
;; The document's identity goes with it. A built-in scene has no
;; project on the server, so this CLEARS the id rather than keeping
;; the last one — saving a fixture must create a document of its
;; own, not overwrite whatever happened to be open before it.
(assoc :project {:id nil :cid (:cid clip) :name (:label clip)
:seq nil :busy? false
:status "built-in example · not a saved project"})
(assoc-in [:playback :frame] 0)
(assoc-in [:playback :playing?] false))
::pause! nil

74
frontend/src/arthur/events/project.cljs
View file

@ -21,7 +21,8 @@
Nothing here touches app-db except through events. The promise chain lives in an
fx, which is the only thing in this namespace that is not pure."
(:require [arthur.domain.clip :as clip]
(:require [arthur.db :as db]
[arthur.domain.clip :as clip]
[arthur.audio.mix :as mix]
[arthur.demo.stage :as stage]
[arthur.domain.feature :as feature]
@ -160,6 +161,19 @@
(js/console.error error)
(rf/dispatch [::failed (or (ex-message error) (str error))])))))))
(rf/reg-fx
::list!
(fn [_]
(-> (http/GET "/api/projects")
(.then (fn [^js listed]
(rf/dispatch [::listed
(mapv (fn [^js row]
{:id (.-id row) :name (.-name row)
:seq (.-seq row) :updated (.-updated row)})
(array-seq (.-projects listed)))])))
(.catch (fn [error]
(rf/dispatch [::failed (or (ex-message error) (str error))]))))))
(rf/reg-fx
::open!
(fn [id]
@ -330,6 +344,7 @@
:request request}})))))
(rf/reg-sub ::regeneration (fn [db _] (:regeneration db)))
(rf/reg-sub ::listing (fn [db _] (:projects db)))
(rf/reg-event-fx
::settings-previewed
@ -345,6 +360,46 @@
;; ---------------------------------------------------------------------------
;; events
(def blank-audio
"A new document still needs a clock.
The frame is derived from an audio element and from nothing else — see
`arthur.clock` — so a stage with no sound has no time and `play` is a button
that cannot work. The synthetic take borrows this same asset for exactly this
reason. When a document gets audio of its own, it replaces this."
"/static/arthur/audio.wav")
(defn blank-entry
"A blank clip, in the shape `footage/store` and the transport expect."
[]
(let [c (clip/blank)]
{:label "untitled" :clip c :store nil
:audio blank-audio
;; A content id of its own from the start: `::save!` addresses the clip by
;; it, and two untitled documents saved from two tabs are two documents.
:cid (str (random-uuid))
:display-fps (:fps c)
:frames (clip/frames c)
:fps (:fps c) :width (:width c) :height (:height c)}))
(rf/reg-event-fx
::new
(fn [{:keys [db]} _]
;; A document with no id on the server, so the next `save` creates one. This
;; is also what the app opens on: nothing is loaded until something is asked
;; for, and the built-in scenes are rows in the media pool like anything else.
(let [entry (blank-entry)
id (store/install! entry "new")]
{:db (-> db
(assoc :clip/current id
:clip (select-keys entry [:fps :frames :width :height :audio :display-fps]))
(assoc :project {:id nil :cid (:cid entry) :name nil :seq nil
:busy? false :status "new document"})
(assoc :ui (:ui db/default))
(assoc-in [:playback :frame] 0)
(assoc-in [:playback :playing?] false))
::pb/pause! nil})))
(rf/reg-event-fx
::save
(fn [{:keys [db]} _]
@ -359,13 +414,26 @@
:clip clip}}))))
(rf/reg-event-fx
::open
::list
(fn [{:keys [db]} _]
{:db (assoc-in db [:projects :loading?] true)
::list! nil}))
(rf/reg-event-db
::listed
(fn [db [_ rows]] (assoc db :projects {:items rows :loading? false})))
(rf/reg-event-fx
::open
(fn [{:keys [db]} [_ id]]
;; `id` names which project. Without one it is the open document's own id, and
;; without that the most recently updated — which is what "open" meant when
;; there was no list to pick from.
(if (:busy? (:project db))
{}
{:db (update db :project merge {:busy? true :status "opening…"})
::pb/pause! nil
::open! (:id (:project db))})))
::open! (or id (:id (:project db)))})))
(rf/reg-event-fx
::load-stage

79
frontend/src/arthur/events/ui.cljs Normal file
View file

@ -0,0 +1,79 @@
(ns arthur.events.ui
"Selection, the active tone, the polygon being drawn, and which timeline rows
are open.
All of it is `assoc-in` under `:ui`. There is no effect in this namespace and
there should not be one: an editor's own state is the cheapest thing in the
app to change and the most expensive to have two copies of."
(:require [arthur.domain.clip :as clip]
[arthur.events.edit :as edit]
[arthur.events.paint :as paint]
[re-frame.core :as rf]))
(rf/reg-event-db
::select
(fn [db [_ selection]] (assoc-in db [:ui :selection] selection)))
(rf/reg-event-db
::set-tone
(fn [db [_ tone]] (assoc-in db [:ui :tone] tone)))
(rf/reg-event-db
::toggle-row
(fn [db [_ path]]
(update-in db [:ui :expanded] #(if (contains? % path) (disj % path) (conj % path)))))
;; ---------------------------------------------------------------------------
;; drawing a polygon
;;
;; Three events and a vector of numbers. The draft is in app-db rather than in a
;; ratom because the stage draws it, the palette colours it and the params pane
;; reports its vertex count — and because a half-drawn shape surviving a hot
;; reload is worth more than the handful of dispatches it costs. Clicks are rare;
;; this is not the drag path.
(rf/reg-event-db
::begin-polygon
(fn [db _] (update db :ui merge {:tool :polygon :draft [] :selection nil})))
(rf/reg-event-db
::cancel-polygon
(fn [db _] (update db :ui merge {:tool nil :draft []})))
(rf/reg-event-db
::add-draft-point
(fn [db [_ x y]]
(if (= :polygon (get-in db [:ui :tool]))
(update-in db [:ui :draft] into [x y])
db)))
(rf/reg-event-fx
::finish-polygon
(fn [{:keys [db]} _]
(let [draft (get-in db [:ui :draft])]
(if (< (count draft) 6)
{}
;; `random-uuid` is the one impurity in this namespace, and it is here
;; rather than in `domain/paint` for the reason `clip/place-symbol` spells
;; out: a node's id is its identity in the saved document, so the pure
;; layer must be handed one rather than invent one. If replaying the event
;; log ever has to reproduce a document exactly, this becomes a cofx.
(let [id (keyword (str "paint-" (random-uuid)))]
{:db (update db :ui merge {:tool nil :draft [] :selection [:node :main id]})
:dispatch [::paint/new-shape id draft (get-in db [:ui :tone])]})))))
(rf/reg-event-db
::set-knob
(fn [db [_ scope id knob value]]
(assoc-in db [:ui :knobs [scope id knob]] value)))
;; ---------------------------------------------------------------------------
;; the pool, onto the stage
(rf/reg-event-db
::place-symbol
(fn [db [_ tid [x y]]]
(let [uuid (random-uuid)]
(-> db
(edit/edit #(clip/place-symbol % tid (get-in db [:playback :frame]) uuid [x y]))
(assoc-in [:ui :selection] [:node :main uuid])))))

28
frontend/src/arthur/subs/ui.cljs Normal file
View file

@ -0,0 +1,28 @@
(ns arthur.subs.ui
"Layer-2 extractors over the editor's own state, plus the one layer-3 that
resolves a selection to the thing it names.
Cheap by construction, like `subs/playback`: each reads a path and returns a
value, so clicking a swatch notifies the swatches and nothing else."
(:require [arthur.subs.render :as render]
[re-frame.core :as rf]))
(rf/reg-sub ::selection (fn [db _] (get-in db [:ui :selection])))
(rf/reg-sub ::tone (fn [db _] (get-in db [:ui :tone])))
(rf/reg-sub ::tool (fn [db _] (get-in db [:ui :tool])))
(rf/reg-sub ::draft (fn [db _] (get-in db [:ui :draft])))
(rf/reg-sub ::expanded (fn [db _] (get-in db [:ui :expanded])))
(rf/reg-sub ::knobs (fn [db _] (get-in db [:ui :knobs])))
(rf/reg-sub
::selected-node
:<- [::selection]
:<- [::render/clip]
(fn [[selection clip] _]
;; `[timeline-id node-id node]`, or nil. Returned as a triple rather than as
;; the node alone because every caller that wants the node also wants to know
;; where it lives — an edit names the timeline, and a bare node has forgotten.
(when (and clip (= :node (first selection)))
(let [[_ tid id] selection]
(when-let [n (get-in clip [:timelines tid :nodes id])]
[tid id n])))))

78
frontend/src/arthur/ui/openmenu.cljs Normal file
View file

@ -0,0 +1,78 @@
(ns arthur.ui.openmenu
"File → Open. The projects the server holds, and nothing else.
IT IS NOT THE MEDIA POOL. A project is a whole document — opening one replaces
the stage — and the pool is the open document's own library. Listing documents
beside the symbols inside one of them makes them look like two kinds of the
same thing, which is the confusion this split exists to end.
The built-in scenes are under their own heading and are NOT projects: they are
compiled into the bundle, the server has never heard of them, and `demo/scene`
and the swarm exist to exercise and to profile the model rather than to be
worked on. They are here because there is nowhere else for a fixture to live,
and they are labelled so that nothing about them reads as a saved document."
(:require [arthur.db :as db]
[arthur.events.playback :as pb]
[arthur.events.project :as project]
[arthur.subs.playback :as playback]
[re-frame.core :as rf]
[reagent.core :as r]))
(defn- when-said
"The ISO stamp the server sends, as a date. Truncated rather than formatted:
a list of documents wants to be sorted and scanned, not read to the second."
[iso]
(when iso (subs (str iso) 0 10)))
(defn- item
"One row. `example?` is not decoration: the server is full of documents called
\"take\", so \"the row labelled take\" does not identify one thing — the class is
what lets a reader, and `test/browser`, tell a saved project from the fixture
that shares its name."
[{:keys [label sub on-click disabled? example?]}]
[:button {:class (str "menu-item" (when example? " example"))
:on-click on-click :disabled (boolean disabled?) :title label}
label
(when sub [:span.sub sub])])
(defn view []
(r/with-let [open? (r/atom false)]
(let [{:keys [items loading?]} @(rf/subscribe [::project/listing])
busy? (:busy? @(rf/subscribe [::playback/project]))
choose! (fn [event] (reset! open? false) (rf/dispatch event))]
[:div.menu-wrap
[:button {:disabled busy?
:class (when @open? "on")
:on-click (fn []
(when-not @open? (rf/dispatch [::project/list]))
(swap! open? not))}
"open ▾"]
(when @open?
[:<>
;; A full-page catcher behind the panel, so clicking anywhere else
;; dismisses it. Cheaper and more predictable than a document-level
;; listener that has to be added, removed and told to ignore the click
;; that opened the menu.
[:div.menu-scrim {:on-click #(reset! open? false)}]
[:div.menu
[:h2 "projects"]
(cond
loading? [:div.dim "…"]
(empty? items) [:div.dim "none saved yet"]
:else
(doall
(for [{:keys [id name seq updated]} items]
^{:key id}
[item {:label (or name "untitled")
:sub (str "r" seq " · " (when-said updated))
:on-click #(choose! [::project/open id])}])))
[:h2 "built-in examples"]
[:div.dim "compiled in, not saved documents"]
(doall
(for [[id {:keys [label]}] db/clips]
^{:key id}
[item {:label label :example? true
:on-click #(choose! [::pb/select-clip id])}]))
[item {:label "8625 stage study" :example? true
:sub "composed from a locally saved project"
:on-click #(choose! [::project/load-stage])}]]])])))

149
frontend/src/arthur/ui/paint.cljs
View file

@ -1,149 +0,0 @@
(ns arthur.ui.paint
"Polygon authoring overlay. The raster canvas remains the playback sink; SVG
supplies only editor handles and an unfinished outline."
(:require [arthur.domain.channel :as channel]
[arthur.domain.paint :as paint]
[arthur.domain.palette :as palette]
[arthur.events.paint :as events]
[arthur.events.playback :as pb]
[arthur.subs.playback :as playback]
[arthur.subs.render :as render]
[re-frame.core :as rf]
[reagent.core :as r]))
(defonce ^:private selected (r/atom nil))
(defonce ^:private drawing? (r/atom false))
(defonce ^:private draft (r/atom []))
(defonce ^:private tone (r/atom :skin-base))
(defonce ^:private dragging (atom nil))
(defn- point [event w h]
(let [box (.getBoundingClientRect (.-currentTarget event))]
[(-> (/ (* (- (.-clientX event) (.-left box)) w) (.-width box))
js/Math.round (max 0) (min (dec w)))
(-> (/ (* (- (.-clientY event) (.-top box)) h) (.-height box))
js/Math.round (max 0) (min (dec h)))]))
(defn- pairs [pts]
(mapv vec (partition 2 pts)))
(defn- points-text [pts]
(apply str (interpose " " (map (fn [[x y]] (str x "," y)) (pairs pts)))))
(defn- begin! []
(reset! selected nil)
(reset! draft [])
(reset! drawing? true))
(defn- finish! []
(when (>= (count @draft) 6)
(let [id (keyword (str "paint-" (random-uuid)))]
(rf/dispatch [::events/new-shape id @draft @tone])
(reset! selected id)
(reset! draft [])
(reset! drawing? false))))
(defn toolbar []
(let [clip @(rf/subscribe [::render/clip])
frame @(rf/subscribe [::playback/frame])
shapes (paint/shapes clip)
ids (set (map first shapes))
id (when (contains? ids @selected) @selected)
shape (get-in clip [:timelines :main :nodes id])
geom (get-in shape [:channels paint/geometry])
active (when geom (paint/active-frame geom frame))
keys (when geom (sort (keys (:keys geom))))
next-key (first (filter #(> % active) keys))
tween? (= :linear (channel/segment-interp geom active))]
[:div.paint-tools
[:div.row
[:strong "paint"]
[:button {:class (when @drawing? "on") :on-click begin!} "new polygon"]
(when @drawing?
[:button {:disabled (< (count @draft) 6) :on-click finish!} "finish shape"])
(when @drawing?
[:button {:on-click #(do (reset! drawing? false) (reset! draft []))} "cancel"])
[:label "colour "
[:select {:value (name @tone)
:on-change #(reset! tone (keyword (.. % -target -value)))}
(for [{:keys [name hex]} (rest palette/entries)]
^{:key name} [:option {:value (clojure.core/name name)}
(str (clojure.core/name name) " " hex)])]]]
[:div.row
[:label "shape "
[:select {:value (if id (name id) "")
:on-change #(reset! selected (when-not (= "" (.. % -target -value))
(keyword (.. % -target -value))))}
[:option {:value ""} "select"]
(for [[shape-id node] shapes]
^{:key shape-id} [:option {:value (name shape-id)} (:name node)])]]
(when id
[:button {:disabled (or (< frame (first (:span shape)))
(contains? (:keys geom) frame))
:on-click #(rf/dispatch [::events/add-key id])}
"new drawing key"])
(when (and id next-key)
[:label (str "key " active " → " next-key " ")
[:select {:value (name (or (channel/segment-interp geom active) :hold))
:on-change #(rf/dispatch [::events/set-segment-interp id active
(keyword (.. % -target -value))])}
[:option {:value "hold"} "hold"]
[:option {:value "linear"} "tween shape"]]])]
(when (seq keys)
[:div.row
[:span "drawing keys "]
(for [f keys]
^{:key f}
[:button {:class (when (= frame f) "on")
:on-click #(rf/dispatch [::pb/seek f])}
(str f)])])
[:div.hint
(cond
@drawing? (str "Click vertices on the stage, then Finish shape. "
(quot (count @draft) 2) " points")
(and id tween? (not (contains? (:keys geom) frame)))
"Tweening between drawings. Add a drawing key here, or jump to a key to edit its vertices."
id (str "Drag vertices to edit drawing key " active
". New drawing key copies the visible shape at this frame. The transition control changes only the selected gap.")
:else "Create a polygon, or select one to edit its drawing keys.")]]))
(defn overlay [w h zoom]
(let [clip @(rf/subscribe [::render/clip])
frame @(rf/subscribe [::playback/frame])
shape (get-in clip [:timelines :main :nodes @selected])
geom (get-in shape [:channels paint/geometry])
active (when geom (paint/active-frame geom frame))
visible? (and shape (let [[start end] (:span shape)] (<= start frame) (< frame end)))
pts (when visible? (channel/value-at geom frame))
editable? (or (not= :linear (channel/segment-interp geom active))
(contains? (:keys geom) frame))]
[:svg.paint-overlay
{:width (* zoom w) :height (* zoom h)
:view-box (str "0 0 " w " " h)
:on-pointer-down (fn [event]
(when @drawing?
(let [[x y] (point event w h)]
(swap! draft into [x y]))))
:on-pointer-move (fn [event]
(when-let [[id key-frame vertex] @dragging]
(rf/dispatch [::events/set-vertex id key-frame vertex
(point event w h)])))
:on-pointer-up (fn [_] (reset! dragging nil))
:on-pointer-cancel (fn [_] (reset! dragging nil))}
(when (seq @draft)
[:polyline {:points (points-text @draft) :fill "none"
:stroke "#d0ba86" :stroke-width 1}])
(when (and visible? (not @drawing?) pts)
[:g
[:polygon {:points (points-text pts) :fill "none"
:stroke "#e6ca8b" :stroke-width 1}]
(for [[i [x y]] (map-indexed vector (pairs (when editable? pts)))]
^{:key i}
[:circle {:cx x :cy y :r 2.6 :fill "#fff1be"
:stroke "#161820" :stroke-width 0.7
:on-pointer-down (fn [event]
(.stopPropagation event)
(.preventDefault event)
(.setPointerCapture (.-currentTarget event)
(.-pointerId event))
(reset! dragging [@selected active i]))}])])]))

51
frontend/src/arthur/ui/palette.cljs Normal file
View file

@ -0,0 +1,51 @@
(ns arthur.ui.palette
"The bar above the stage: the tone a new shape gets, and the tool that makes
one.
SIXTEEN SLOTS, and the palette supplies nine of them. The count is the format's
and not the data's — an indexed 320x200 picture in the Animator Pro idiom this
tool inherits has a fixed-size table, and a strip that grew and shrank as tones
were added would make the palette look like a list of colours rather than like
a table with room in it. So the empty slots are drawn, hatched, and refuse the
click.
Slot 0 is the background, which is why it is shown and not selectable: a
polygon filled with index 0 is invisible against a stage cleared to index 0, so
offering it as a fill is offering a shape that vanishes on creation."
(:require [arthur.domain.palette :as pal]
[arthur.events.ui :as ui]
[arthur.subs.ui :as sub]
[re-frame.core :as rf]))
(def ^:const slots 16)
(defn- swatch [i tone]
(let [{slot-tone :name :keys [hex]} (get pal/entries i)
bg? (zero? i)
pick (and slot-tone (not bg?))]
[:button
{:key i
:class (str "swatch"
(when-not slot-tone " empty")
(when bg? " bg")
(when (and pick (= slot-tone tone)) " on"))
:style (when hex {:background hex})
:title (if slot-tone (str i " · " (name slot-tone) " " hex) (str i " · empty"))
:disabled (not pick)
:on-click #(rf/dispatch [::ui/set-tone slot-tone])}]))
(defn bar []
(let [tone @(rf/subscribe [::sub/tone])
tool @(rf/subscribe [::sub/tool])
draft @(rf/subscribe [::sub/draft])]
[:div.palette-bar
[:div.swatches (doall (map #(swatch % tone) (range slots)))]
[:span.dim (name tone)]
[:span {:style {:flex 1}}]
(if (= :polygon tool)
[:<>
[:span.dim (str (quot (count draft) 2) " points")]
[:button {:disabled (< (count draft) 6)
:on-click #(rf/dispatch [::ui/finish-polygon])} "finish"]
[:button {:on-click #(rf/dispatch [::ui/cancel-polygon])} "cancel"]]
[:button {:on-click #(rf/dispatch [::ui/begin-polygon])} "polygon"])]))

249
frontend/src/arthur/ui/params.cljs Normal file
View file

@ -0,0 +1,249 @@
(ns arthur.ui.params
"The right pane: what the selection is, and what can be changed about it.
Sections rather than a mode switch. The clip's facts are always true, so the
clip section is always there; the node and timeline sections appear when
something of that kind is selected; the tracking section appears when the clip
has analysis in it. Nothing here computes — every control dispatches an intent
and every readout comes off a subscription."
(:require [clojure.string :as str]
[arthur.domain.channel :as channel]
[arthur.domain.feature :as feature]
[arthur.domain.node :as node]
[arthur.domain.paint :as paint]
[arthur.domain.params :as params]
[arthur.events.paint :as paint-events]
[arthur.events.playback :as pb]
[arthur.events.project :as project]
[arthur.events.ui :as ui]
[arthur.subs.playback :as playback]
[arthur.subs.render :as render]
[arthur.subs.ui :as sub]
[re-frame.core :as rf]))
(defn- brief
"A value that fits the column. The `facts` list puts the whole thing in a
`title`, so nothing is lost — but a node id is a uuid and a `:z` is a
timestamp joined to one, and either wrapped over three lines pushes every
parameter below it off the pane."
[v]
(let [s (str v)]
(if (> (count s) 22) (str (subs s 0 20) "…") s)))
(defn- facts [& pairs]
(into [:dl.facts]
(mapcat (fn [[k v]] (when v [[:dt k] [:dd {:title (str v)} v]])))
(partition 2 pairs)))
(defn- section [title & body]
(into [:section.section [:h2 title]] body))
;; ---------------------------------------------------------------------------
;; the clip
(defn- clip-section []
(let [clip @(rf/subscribe [::render/clip])
fps @(rf/subscribe [::playback/fps])
picture @(rf/subscribe [::playback/display-fps])
frames @(rf/subscribe [::playback/frames])
expose @(rf/subscribe [::render/exposure])]
[section "clip"
[facts
"name" (:name clip)
"stage" (str (:width clip) "×" (:height clip))
"length" (str frames " frames")
"source" (str fps " fps")
"expose" (str "on " expose "s")]
;; Sampling the frozen roto at a lower rate. The source track, the duration
;; and the audio clock are untouched — a drawing is HELD, the file is never
;; short — which is why this is a picture rate and not a playback rate.
[:div.row {:style {:margin-top "5px"}}
[:span.dim "picture"]
(doall
(for [r (distinct (filter #(<= % fps) [8 12 15 24 fps]))]
^{:key r}
[:button {:class (when (= r picture) "on")
:on-click #(rf/dispatch [::pb/set-picture-fps r])}
(if (= r fps) "source" (str r))]))]]))
;; ---------------------------------------------------------------------------
;; a node
(defn- channel-state
"One line saying how this channel is animated, which is the only thing about it
this pane can say without an editor for its values."
[ch]
(cond
(:dense ch) (str "dense · " (get-in ch [:dense :frames]) " frames")
(:keys ch) (str (count (:keys ch)) " keys · " (name (or (:interp ch) :hold)))
:else (let [v (:value ch)]
(str "framed · " (if (channel/nothing? v) "absent" (pr-str v))))))
(defn- drawing-keys
"The polygon controls: jump to a drawing key, add one here, and choose what the
gap after the current one does. Lifted out of the old stage toolbar unchanged —
a drawing key is a parameter of the shape, and this is where the shape's
parameters are."
[id n frame]
(let [geom (get-in n [:channels paint/geometry])
active (when geom (paint/active-frame geom frame))
ks (when geom (sort (keys (:keys geom))))
next-k (first (filter #(> % active) ks))
[start end] (:span n)]
[:<>
[:div.row {:style {:margin "5px 0"}}
[:button {:disabled (or (< frame start) (>= frame end)
(contains? (:keys geom) frame))
:on-click #(rf/dispatch [::paint-events/add-key id])}
"drawing key here"]]
(when (seq ks)
[:div.row
[:span.dim "keys"]
(doall
(for [f ks]
^{:key f}
[:button {:class (when (= frame f) "on")
:on-click #(rf/dispatch [::pb/seek f])}
(str f)]))])
(when next-k
[:div.row {:style {:margin-top "5px"}}
[:label.dim (str "key " active " → " next-k " ")
[:select {:value (name (or (channel/segment-interp geom active) :hold))
:on-change #(rf/dispatch [::paint-events/set-segment-interp
id active (keyword (.. % -target -value))])}
[:option {:value "hold"} "hold"]
[:option {:value "linear"} "tween"]]]])]))
(defn- node-section [[tid id n]]
(let [frame @(rf/subscribe [::playback/frame])
[start end] (:span n)]
[section (str (name (:kind n)) (when (not= :main tid) (str " · " (name tid))))
[facts
"name" (or (:name n) (brief id))
"id" (brief id)
;; Which library timeline a placement plays. The one fact that makes a
;; symbol instance legible as an instance rather than as a node.
"of" (when (= :symbol (:kind n)) (str (:of n)))
"span" (when start (str start " … " end))]
(when (:paint? n) [drawing-keys id n frame])
[:div.row {:style {:margin-top "6px"}} [:span.dim "channels"]]
[:dl.facts
(doall
(for [[path ch] (sort-by (comp str key) (node/channels n))]
^{:key (str path)}
[:<>
[:dt (str/join " " (map name path))]
[:dd (channel-state ch)]]))]]))
;; ---------------------------------------------------------------------------
;; a timeline
(defn- timeline-section [tid]
(let [tl @(rf/subscribe [::render/clip])
tl (get-in tl [:timelines tid])]
[section "timeline"
[facts
"id" (str tid)
"length" (str (:frames tl) " frames")
"nodes" (str (count (:nodes tl)))]]))
;; ---------------------------------------------------------------------------
;; tracked objects
;;
;; The generated settings. Unlike everything above, moving one of these does real
;; work: `::project/preview-settings` re-freezes whatever blocks the knob
;; invalidates, which is why the slider's value is held in `:ui :knobs` until the
;; regeneration comes back.
(defn- owners [clip]
(vec (for [[scope objects] [[:subject (:subjects clip)]
[:feature (:features clip)]
[:group (:groups clip)]]
id (sort-by str (keys objects))]
[scope id])))
(defn- bounds [knob {:keys [type default min even?] upper :max}]
{:min (or min (if (= knob :blob-grow) -3 0))
:max (or upper (get {:verts 20 :eye-verts 16 :brow-verts 10
:teeth-verts 20 :blob-grow 3 :top-bias 2
:gaze-gain 4} knob)
(max 1 (* 2 default)))
:step (cond even? 2 (= type :integer) 1 :else 0.01)})
(defn- tracking-section []
(let [clip @(rf/subscribe [::render/clip])
selection @(rf/subscribe [::sub/selection])
knobs @(rf/subscribe [::sub/knobs])
busy? (:busy? @(rf/subscribe [::playback/project]))
report @(rf/subscribe [::project/regeneration])
all (owners clip)
[scope id :as owner] (if (some #{selection} all) selection (first all))
area (case scope
:subject :subject
:feature (get-in clip [:features id :area])
:group :eye
nil)
values (case scope
:subject (merge (params/for-area :subject)
(get-in clip [:subjects id :params]))
:feature (when id (feature/effective-params clip id))
:group (merge (params/for-area :eye)
(get-in clip [:groups id :params]))
nil)]
[section "tracking"
;; The option VALUE is the INDEX, not the owner. A `[scope id]` pair written
;; into the DOM comes back as a string that has to be parsed back into a
;; keyword pair, and `subs`/`keyword` on a namespaced id loses its namespace
;; — the same trap `events/export/target-value` exists to avoid. An index
;; into a vector both ends agree on cannot be misread.
[:select {:value (or (first (keep-indexed #(when (= %2 owner) %1) all)) 0)
:on-change #(rf/dispatch
[::ui/select (nth all (js/parseInt (.. % -target -value) 10))])}
(doall
(for [[i [kind object-id]] (map-indexed vector all)]
^{:key i}
[:option {:value i} (str (name kind) " · " (subs (str object-id) 1))]))]
(when area
[:div {:style {:margin-top "6px"}}
(doall
(for [[knob spec] (sort-by (comp str key) params/definitions)
:when (= area (:area spec))]
(let [k (get knobs [scope id knob] (get values knob))
{:keys [min max step]} (bounds knob spec)]
^{:key knob}
[:label.knob
[:span.top-line [:span.name (name knob)] [:span (str k)]]
[:input {:type "range" :min min :max max :step step :value k
:disabled busy?
:on-change
(fn [^js event]
(let [s (.. event -target -value)
v (if (= :integer (:type spec))
(js/parseInt s 10)
(js/parseFloat s))]
(rf/dispatch [::ui/set-knob scope id knob v])
(rf/dispatch [::project/preview-settings
{:scope scope :id id :knob knob :value v}])))}]])))])
(when report
;; `regeneration-debug` is a hook rather than a style: `test/browser` reads
;; this line to assert which feature a knob dirtied and which tier it
;; reached, and that is the one thing on the page that says so.
[:div.dim.regeneration-debug {:style {:margin-top "6px"}}
(str "dirty: " (pr-str (:features report))
" · blocks: " (if (seq (:roles report))
(pr-str (sort (:roles report))) "tier 1 only"))])]))
;; ---------------------------------------------------------------------------
(defn view []
(let [clip @(rf/subscribe [::render/clip])
selection @(rf/subscribe [::sub/selection])
node @(rf/subscribe [::sub/selected-node])
tracked? (seq (owners clip))]
[:section.pane.params
[:div.pane-head "inspector"]
[:div {:style {:min-height 0}}
[clip-section]
(when node [node-section node])
(when (= :timeline (first selection)) [timeline-section (second selection)])
(when tracked? [tracking-section])]]))

130
frontend/src/arthur/ui/pool.cljs Normal file
View file

@ -0,0 +1,130 @@
(ns arthur.ui.pool
"The media pool: the open document's own contents.
TWO GROUPS, AND NEITHER IS A DOCUMENT. Whole projects are `ui/openmenu`'s, and
the split is the point: opening a project REPLACES the stage, where everything
in here is a thing to put ON it. Listing documents beside the symbols inside
one of them made them look like two kinds of the same thing, which is exactly
the confusion this pane should be ending.
A SYMBOL is one timeline out of the open document's library — the thing a
`:kind :symbol` node is an instance of. Dragging one onto the stage places an
instance. Open a different project and this is a different list, because a
library belongs to the document that holds it.
FOOTAGE is source media on the server: uploads that have been probed,
transcoded and cut into frames. Running one through detection produces a
document whose roto IS a symbol — `flow/freeze/clip` gives each tracked subject
its own library timeline and places it on `:main` with one instance — so
footage becomes a row in the group above it by way of being detected.
THE WHOLE PANE IS THE DROP TARGET. A video dropped anywhere in it uploads and
then goes straight into detection, because \"upload\" and \"roto\" are one
intention and splitting them into two clicks only means finding the second
button. The uploaded bytes, the extraction job and the decoded footage stay
separate records on the server, so dropping the same file twice does not decode
it twice."
(:require [arthur.events.footage :as footage]
[arthur.events.ui :as ui]
[arthur.subs.playback :as playback]
[arthur.subs.render :as render]
[arthur.subs.ui :as sub]
[re-frame.core :as rf]
[reagent.core :as r]))
(defn- item
"One row. `opts` is merged last so a caller can add `:draggable` and its
handlers without this function growing a parameter per affordance."
[{:keys [label sub on? disabled?] :as opts}]
[:button (merge {:class (str "pool-item" (when on? " on"))
:disabled (boolean disabled?)
:title label}
(dissoc opts :label :sub :on? :disabled?))
label
(when sub [:span.sub sub])])
(defn- group
"A titled group of rows. The title doubles as the group's class, so `.clips`
and `.footage` are addressable — `test/browser` needs to ask which CLIP is open
without the chosen footage row, which is also marked, answering instead."
[title & children]
(into [:div.pool-group {:class title} [:h2 title]] children))
(defn- symbols []
(let [clip @(rf/subscribe [::render/clip])
selection @(rf/subscribe [::sub/selection])
library (sort-by str (remove #{:main} (keys (:timelines clip))))]
(group "symbols"
[:div.dim "timelines in this document"]
(if (empty? library)
[:div.dim "none yet"]
(doall
(for [tid library
:let [tl (get-in clip [:timelines tid])]]
^{:key tid}
[item {:label (name tid)
:sub (str (:frames tl) "f · " (count (:nodes tl)) " nodes")
:on? (= selection [:timeline tid])
:draggable true
:on-drag-start
(fn [^js event]
(.setData (.-dataTransfer event) "text/plain"
(str "symbol:" (subs (str tid) 1)))
(set! (.. event -dataTransfer -effectAllowed) "copy"))
:on-click #(rf/dispatch [::ui/select [:timeline tid]])}])))
(when (seq library)
[:div.dim "drag onto the stage to place"]))))
(defn- footage []
(let [{:keys [loading? available chosen]} @(rf/subscribe [::playback/footage])]
(group "footage"
[:div.dim "source media on the server"]
(if (empty? available)
[:div.dim "drop a video here"]
(doall
(for [{:keys [id label frames fps]} available]
^{:key id}
[item {:label label
:sub (str frames "f @ " fps)
:on? (= id chosen)
:disabled? loading?
:on-click #(rf/dispatch [::footage/choose id])}]))))))
(defn view []
(r/with-let [;; Counted, not a boolean. `dragenter`/`dragleave` fire for every
;; child element the pointer crosses, so a flag set on enter and
;; cleared on leave flickers off the moment the drag passes over a
;; row — the depth counter is what makes the outline steady.
depth (r/atom 0)]
(let [{:keys [loading? chosen status]} @(rf/subscribe [::playback/footage])]
[:section.pane.pool
{:class (when (pos? @depth) "dropping")
:on-drag-enter (fn [^js e] (.preventDefault e) (swap! depth inc))
:on-drag-leave (fn [_] (swap! depth #(max 0 (dec %))))
:on-drag-over (fn [^js e] (.preventDefault e))
:on-drop (fn [^js e]
(.preventDefault e)
(reset! depth 0)
(when-let [file (aget (.. e -dataTransfer -files) 0)]
(rf/dispatch [::footage/upload file])))}
[:div.pane-head
"media pool"
[:span.spacer]
[:button {:disabled (or loading? (nil? chosen))
:title "detect and freeze the chosen footage"
:on-click #(rf/dispatch [::footage/load])}
(if loading? "…" "roto")]
[:button {:title "add a video"
:disabled loading?
:on-click #(.click (js/document.getElementById "pool-file"))}
"+"]]
[:input {:id "pool-file" :type "file" :accept "video/*"
:style {:display "none"}
:on-change (fn [^js event]
(when-let [file (aget (.. event -target -files) 0)]
(rf/dispatch [::footage/upload file])
(set! (.. event -target -value) "")))}]
[:div.pane-body
[symbols]
[footage]
(when status [:div.dim status])]])))

322
frontend/src/arthur/ui/shell.cljs
View file

@ -1,300 +1,40 @@
(ns arthur.ui.shell
"The page. Transport, canvas, readouts.
"The window: one grid, five panes, and the audio element.
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."
Nothing else. Each pane owns its own subscriptions, so this component re-renders
only when the grid itself would change — which is never. The picture is put on
the canvas by `ui/player`'s loop rather than by anything here re-rendering,
which is why scrubbing at speed does not touch React at all."
(:require [arthur.clock :as clock]
[arthur.db :as db]
[arthur.domain.feature :as feature]
[arthur.domain.params :as params]
[arthur.events.export :as export]
[arthur.events.footage :as footage]
[arthur.events.playback :as pb]
[arthur.events.project :as project]
[arthur.subs.playback :as sub]
[arthur.subs.render :as render]
[arthur.ui.player :as player]
[arthur.ui.paint :as paint]
[re-frame.core :as rf]
[reagent.core :as r]))
(def ^:private zoom 2)
(defonce ^:private selected-owner (r/atom nil))
(defonce ^:private drafts (r/atom {}))
(defn- setting-owners [clip]
(vec (for [[scope objects] [[:subject (:subjects clip)]
[:feature (:features clip)]
[:group (:groups clip)]]
id (sort-by str (keys objects))]
[scope id])))
(defn- slider-bounds [knob {:keys [type default min even?] upper :max}]
{:min (or min (if (= knob :blob-grow) -3 0))
:max (or upper (get {:verts 20 :eye-verts 16 :brow-verts 10
:teeth-verts 20 :blob-grow 3 :top-bias 2
:gaze-gain 4} knob)
(max 1 (* 2 default)))
:step (cond even? 2 (= type :integer) 1 :else 0.01)})
(defn- controls []
(let [clip @(rf/subscribe [::render/clip])
busy? (:busy? @(rf/subscribe [::sub/project]))
report @(rf/subscribe [::project/regeneration])
owners (setting-owners clip)
[scope id :as owner] (if (some #{(deref selected-owner)} owners)
@selected-owner (first owners))
area (case scope
:subject :subject
:feature (get-in clip [:features id :area])
:group :eye
nil)
values (case scope
:subject (merge (params/for-area :subject)
(get-in clip [:subjects id :params]))
:feature (when id (feature/effective-params clip id))
:group (merge (params/for-area :eye)
(get-in clip [:groups id :params]))
nil)]
[:section.controls
[:label "active object "
[:select {:value (or (first (keep-indexed
(fn [i option] (when (= option owner) i)) owners)) 0)
:on-change #(reset! selected-owner
(nth owners (js/parseInt (.. % -target -value) 10)))}
(if (seq owners)
(doall (for [[i [kind object-id]] (map-indexed vector owners)]
^{:key i} [:option {:value i}
(str (name kind) " · " (subs (str object-id) 1))]))
[:option {:value 0} "no tracked objects"])] ]
(when area
[:div.control-list
(doall
(for [[knob spec] (sort-by (comp str key) params/definitions)
:when (= area (:area spec))]
(let [draft-key [scope id knob]
value (get @drafts draft-key (get values knob))
{:keys [min max step]} (slider-bounds knob spec)]
^{:key (str draft-key)}
[:label.control-row
[:span (name knob)]
[:input {:type "range" :min min :max max :step step :value value
:disabled busy?
:on-change (fn [event]
(let [s (.. event -target -value)
v (if (= :integer (:type spec))
(js/parseInt s 10)
(js/parseFloat s))]
(swap! drafts assoc draft-key v)
(rf/dispatch [::project/preview-settings
{:scope scope :id id :knob knob
:value v}]))) }]
[:output (str value)]])))])
(when report
[:pre.regeneration-debug
(str "dirty features: " (pr-str (:features report)) "\n"
"new block roles: " (if (seq (:roles report))
(pr-str (sort (:roles report))) "none (tier 1 only)")
"\n" (get-in @(rf/subscribe [::sub/project]) [:status]))])]))
[arthur.subs.playback :as playback]
[arthur.ui.palette :as palette]
[arthur.ui.params :as params]
[arthur.ui.pool :as pool]
[arthur.ui.stage :as stage]
[arthur.ui.timeline :as timeline]
[arthur.ui.topbar :as topbar]
[re-frame.core :as rf]))
(defn- audio []
(let [src @(rf/subscribe [::sub/audio])]
[:audio
{:ref #(when % (clock/attach! %))
:src src
:preload "auto"
;; Transport state follows the ELEMENT, not the other way round: the audio
;; is the clock, so anything that can change its state — the end of the
;; file, the OS media keys, a browser autoplay block — has to be able to
;; correct the document rather than be contradicted by it.
[:audio
{:ref #(when % (clock/attach! %))
:src @(rf/subscribe [::playback/audio])
: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])
picture-fps @(rf/subscribe [::sub/display-fps])
current @(rf/subscribe [::render/clip-id])
expose @(rf/subscribe [::render/exposure])
{:keys [id label loading? status available chosen]} @(rf/subscribe [::sub/footage])
{project-name :name :keys [busy?] project-status :status
project-seq :seq} @(rf/subscribe [::sub/project])]
[: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/clips]
^{:key id}
[:button {:class (when (= id @(rf/subscribe [::render/clip-id])) "on")
:on-click #(rf/dispatch [::pb/select-clip id])}
label]))
(when id
[:button {:class (when (= id @(rf/subscribe [::render/clip-id])) "on")
:on-click #(rf/dispatch [::pb/select-clip id])}
(or label "footage")])
[:button {:disabled (or loading? (nil? chosen))
:on-click #(rf/dispatch [::footage/load])}
(if loading? "loading…" "load frames")]
[:span.gap]
;; The document, over HTTP. Two buttons, because the round trip is the proof
;; the model serialises and a proof nobody can run is not one.
[:button {:disabled busy? :on-click #(rf/dispatch [::project/save])} "save"]
[:button {:disabled busy? :on-click #(rf/dispatch [::project/open])} "open"]
[:button {:disabled busy? :on-click #(rf/dispatch [::project/load-stage])}
"stage 8625"]
[: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 "source " fps " fps")]
[:span (str "picture " picture-fps " fps")]
[:span (str "pose " (clock/picture-frame frame fps picture-fps 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")))])]
(when (= id current)
[:div.picture-rate
[:span "picture fps "]
(doall
(for [r (distinct (filter #(<= % fps) [8 12 15 24 fps]))]
^{:key r}
[:button {:class (when (= r picture-fps) "on")
:on-click #(rf/dispatch [::pb/set-picture-fps r])}
(if (= r fps) "source" (str r))]))])
;; Upload a video or choose existing server footage. Both routes produce the
;; same immutable frame and audio manifest.
[:label.source-path "footage "
[:input {:type "file" :accept "video/*" :disabled loading?
:on-change (fn [event]
(when-let [file (aget (.. event -target -files) 0)]
(rf/dispatch [::footage/upload file])
(set! (.. event -target -value) "")))}]
[:select {:value (or chosen "") :disabled loading?
:on-change #(rf/dispatch [::footage/choose (.. % -target -value)])}
(if (seq available)
(doall (for [{:keys [id label frames fps]} available]
^{:key id}
[:option {:value id}
(str label " · " frames "f @" fps)]))
[:option {:value ""} "no footage yet"])]
[:button {:disabled loading?
:on-click #(rf/dispatch [::footage/refresh])} "refresh"]]
(when status [:div.load-status status])
(when (or project-name project-status)
[:div.load-status
(when project-name (str "project " project-name
(when project-seq (str " r" project-seq)) " · "))
project-status])]))
(defn- exporter []
(let [{:keys [timeline zoom isolate busy? done total status]} @(rf/subscribe [::export/state])
targets @(rf/subscribe [::export/targets])
{:keys [width height frames fps seconds poses]} @(rf/subscribe [::export/plan])]
[:section.export
[:div.row
[:label "export "
;; ONE SELECT over everything exportable: the clip, each symbol in its
;; library, and each placement on the stage. They are one list because they
;; are one kind of request — render this, alone — and a mode switch beside a
;; picker would only make the same choice twice.
;;
;; The option VALUE is `events/export/target-value`, not `(name id)`: a
;; symbol timeline is `:sym/face-8625` and a placement is a uuid, and
;; writing either through `name` loses what identifies it. That is the bug
;; where the id read back as `:face-8625`, matched no timeline, and the
;; export died inside re-frame's `:do-fx` with the button stuck on
;; "rendering…".
[:select {:value (export/target-value {:timeline (or timeline :main)
:isolate isolate})
:disabled busy?
:on-change #(rf/dispatch [::export/set-target
(export/target-id (.. % -target -value))])}
(doall
(for [{:keys [label] :as target} targets]
^{:key (export/target-value target)}
[:option {:value (export/target-value target)}
;; A placement is indented under the library above it, so that "the
;; drawing" and "that one on the stage" read as different things.
(str (when (:isolate target) "· ") label)]))]]
[:span.gap]
(doall
(for [z export/zooms]
^{:key z}
[:button {:class (when (= z zoom) "on") :disabled busy?
:on-click #(rf/dispatch [::export/set-zoom z])}
(str z "x")]))
[:button {:disabled busy? :on-click #(rf/dispatch [::export/start])}
(if busy? "rendering…" "frames + wav")]]
(when (and width frames)
[:div.readout
[:span (str width "x" height)]
[:span (str frames " frames @ " fps)]
[:span (str (.toFixed seconds 2) "s")]
;; Poses and frames are different numbers at a lower picture rate, and
;; showing both is how "exposure holds a drawing" stops being invisible:
;; the file is never short, the drawing is just held.
(when (not= poses frames) [:span (str poses " poses")])])
(when busy?
[:div.load-status (str "frame " done " / " total)])
(when (and status (not busy?)) [:div.load-status status])
[:p.note
"A lossless PNG sequence at an integer zoom, with the mixed audio, in one "
"zip. Import the sequence and the WAV as separate tracks."]]))
(defn- stage []
;; The canvas is the STAGE's size, and the stage is the clip's — not a constant
;; and not the footage's. Reactive, so selecting a clip of another size resizes
;; it; ui/canvas guards the width assignment, which reallocates the backing
;; store, so this being a re-render costs nothing per frame.
(let [w @(rf/subscribe [::sub/width])
h @(rf/subscribe [::sub/height])]
[:div.stage-wrap
[:canvas.stage
{:ref #(player/set-canvas! %)
:width w :height h
:style {:width (str (* zoom w) "px") :height (str (* zoom h) "px")}}]
[paint/overlay w h zoom]]))
:on-pause #(rf/dispatch [::pb/pause])}])
(defn view []
[:main
[:h1 "arthur"]
[stage]
[paint/toolbar]
[audio]
[transport]
[exporter]
[controls]
[:p.note
"Upload a video, choose its footage, then load frames. Save the project to "
"share the analyzed take without detecting frames again."]])
[:div.app
[topbar/view]
[pool/view]
[:section.view
[palette/bar]
[stage/view]]
[params/view]
[timeline/view]
[audio]])

139
frontend/src/arthur/ui/stage.cljs Normal file
View file

@ -0,0 +1,139 @@
(ns arthur.ui.stage
"The stage: the raster canvas, and the SVG editor over it.
They are one widget and live in one namespace. The canvas is the playback sink
— `ui/player`'s loop writes it from an animation frame, so it has no reactive
content and scrubbing at speed does not re-render this component — and the SVG
is the only thing on the page that draws a shape a human can grab. Splitting
them would mean two namespaces sharing one coordinate transform.
THE CANVAS IS THE RASTER'S OWN SIZE, scaled by CSS. See `ui/canvas` for why
that is load-bearing rather than convenient."
(:require [arthur.domain.channel :as channel]
[arthur.domain.paint :as paint]
[arthur.events.paint :as paint-events]
[arthur.events.ui :as ui]
[arthur.subs.playback :as playback]
[arthur.subs.render :as render]
[arthur.subs.ui :as sub]
[arthur.ui.player :as player]
[re-frame.core :as rf]))
(def ^:const zoom
"Integer, and the browser suite reads the canvas's own pixels rather than a
screenshot because of it."
2)
(defn stage-point
"Where a pointer event landed, in stage pixels. Shared by the vertex editor and
by a drop out of the media pool, which is the whole reason it is public."
[event w h]
(let [box (.getBoundingClientRect (.-currentTarget event))]
[(-> (/ (* (- (.-clientX event) (.-left box)) w) (.-width box))
js/Math.round (max 0) (min (dec w)))
(-> (/ (* (- (.-clientY event) (.-top box)) h) (.-height box))
js/Math.round (max 0) (min (dec h)))]))
(defn- pairs [pts] (mapv vec (partition 2 pts)))
(defn- points-text [pts]
(apply str (interpose " " (map (fn [[x y]] (str x "," y)) (pairs pts)))))
;; Which vertex the pointer has captured. A PLAIN atom, not app-db and not a
;; ratom: it is pointer bookkeeping that lives for the length of one drag, it is
;; written on every pointermove, and nothing renders from it — the moves it
;; produces go straight out as `::set-vertex`, which is where the document
;; changes and where re-frame belongs.
(defonce ^:private dragging (atom nil))
(defn- editing
"The selected node when it is a polygon on the root timeline, as
`[id node geom active-key editable?]`. Nothing else is vertex-editable yet."
[clip frame]
(let [[tid id n] @(rf/subscribe [::sub/selected-node])]
(when (and (= :main tid) (:paint? n))
(let [geom (get-in n [:channels paint/geometry])
active (when geom (paint/active-frame geom frame))
[start end] (:span n)]
[id n geom active
;; A frame between two drawing keys with a tween running has no vertices
;; of its own to move: what is on screen there is interpolated, and
;; dragging it would silently edit the key behind it instead.
(and (<= start frame) (< frame end)
(or (not= :linear (channel/segment-interp geom active))
(contains? (:keys geom) frame)))]))))
(defn- overlay [w h]
(let [clip @(rf/subscribe [::render/clip])
frame @(rf/subscribe [::playback/frame])
tool @(rf/subscribe [::sub/tool])
draft @(rf/subscribe [::sub/draft])
drawing? (= :polygon tool)
[id _ geom active editable?] (editing clip frame)
pts (when geom (channel/value-at geom frame))]
[:svg {:class (str "paint-overlay" (when drawing? " drawing"))
:width (* zoom w) :height (* zoom h)
:view-box (str "0 0 " w " " h)
:on-pointer-down (fn [event]
(when drawing?
(let [[x y] (stage-point event w h)]
(rf/dispatch [::ui/add-draft-point x y]))))
:on-pointer-move (fn [event]
(when-let [[node key-frame vertex] @dragging]
(rf/dispatch [::paint-events/set-vertex
node key-frame vertex
(stage-point event w h)])))
:on-pointer-up (fn [_] (reset! dragging nil))
:on-pointer-cancel (fn [_] (reset! dragging nil))}
(when (seq draft)
[:polyline {:points (points-text draft) :fill "none"
:stroke "#d0ba86" :stroke-width 1}])
(when (and id pts (not drawing?) (not (channel/nothing? pts)))
[:g
[:polygon {:points (points-text pts) :fill "none"
:stroke "#e6ca8b" :stroke-width 1}]
(when editable?
(doall
(for [[i [x y]] (map-indexed vector (pairs pts))]
^{:key i}
[:circle {:cx x :cy y :r 2.6 :fill "#fff1be"
:stroke "#161820" :stroke-width 0.7
:on-pointer-down
(fn [event]
(.stopPropagation event)
(.preventDefault event)
(.setPointerCapture (.-currentTarget event)
(.-pointerId event))
(reset! dragging [id active i]))}])))])]))
(defn- dropped-symbol
"The library timeline a drag out of the media pool is carrying, or nil.
`text/plain` with a prefix rather than a custom MIME type: the payload is one
short string, every browser agrees about this type, and a drag that arrives
from somewhere else simply fails the prefix test."
[^js event]
(let [data (.getData (.-dataTransfer event) "text/plain")]
(when (and data (.startsWith data "symbol:"))
(keyword (subs data (count "symbol:"))))))
(defn view []
;; Reactive on the clip's dimensions, so selecting a clip of another size
;; resizes the canvas. `ui/canvas` guards the width assignment — which
;; reallocates the backing store — so this re-rendering costs nothing per frame.
(let [w @(rf/subscribe [::playback/width])
h @(rf/subscribe [::playback/height])]
[:div.stage-area
[:div.stage-wrap
{:on-drag-over (fn [^js event]
(when (.-types (.-dataTransfer event))
(.preventDefault event)))
:on-drop (fn [^js event]
(.preventDefault event)
(when-let [tid (dropped-symbol event)]
(rf/dispatch [::ui/place-symbol tid (stage-point event w h)])))}
[:canvas.stage {:ref #(player/set-canvas! %)
:width w :height h
:style {:width (str (* zoom w) "px")
:height (str (* zoom h) "px")}}]
[overlay w h]]]))

266
frontend/src/arthur/ui/timeline.cljs Normal file
View file

@ -0,0 +1,266 @@
(ns arthur.ui.timeline
"The bottom pane: the transport, a ruler, and a row per node.
`rows` is the whole of the interesting part and it is a PURE function of the
clip and the set of open paths. It flattens the document's two axes of nesting
— parent/child within a timeline, and instance into a library timeline — into
one depth-tagged list, which is what lets the labels column and the tracks
column render from the same vector and therefore stay aligned without measuring
anything.
EVERY FRAME NUMBER A ROW CARRIES IS IN ROOT FRAME SPACE. A symbol's keys are
its own timeline's, and drawing them against the stage's ruler unmapped would
put a key under the wrong frame — silently, and most convincingly when the
instance starts at 0. So the walk carries a `->root` function and composes one
more mapping into it at each instance. The mapping is the inverse of
`node/local-frame`: `local = in + rate·(parent - at)`, so
`parent = at + (local - in)/rate`.
WHAT IT DOES NOT DO YET: a looping instance repeats its timeline, and only the
first pass is drawn. An expanded loop therefore shows keys where they first
happen and not where they happen again."
(:require [clojure.string :as str]
[arthur.domain.node :as node]
[arthur.events.playback :as pb]
[arthur.events.ui :as ui]
[arthur.subs.playback :as playback]
[arthur.subs.render :as render]
[arthur.subs.ui :as sub]
[arthur.ui.player :as player]
[re-frame.core :as rf]
[reagent.core :as r]))
;; ---------------------------------------------------------------------------
;; the rows
(defn- local->parent
"The inverse of `node/local-frame`: where a frame of this node's OWN time sits
on the timeline it lives in.
Two frame spaces meet at every node and mixing them up is the bug this exists
to prevent. A node's `:span` is checked against the frame its PARENT hands it,
but its channels are read at `local-frame` of that — so a placement `:at 48`
whose scale is keyed at 0 has that key on stage frame 48, and drawing it at 0
puts every placement's keys in the same place however staggered they are.
Exposure is not inverted, because it is a floor and has no inverse: a key on a
frame the exposure grid never samples is still authored on that frame, and that
is where the row should show it."
[n]
(let [{:keys [mode offset at in rate] :or {mode :inherit at 0 in 0 rate 1}} (:time n)]
(if (= mode :inherit)
identity
(fn [f]
(let [f (- f (or offset 0))]
(if (and (#{:symbol :audio} (:kind n)) (not (zero? rate)))
(js/Math.round (+ at (/ (- f in) rate)))
f))))))
(defn- keyed-frames [ch] (some-> (:keys ch) keys sort))
(defn- node-label
"What to call a node in the label column.
A placement's id is a uuid and an authored node's is a keyword, and neither
reads as a name: `(str id)` gives `:face-1` with the colon still on it, or
thirty-six characters of hex that push the column open. `:name` when there is
one, and a legible stand-in when there is not."
[id n]
(or (:name n)
(if (keyword? id) (subs (str id) 1) (subs (str id) 0 8))))
(defn- channel-rows [n path depth ->root span]
(for [[cpath ch] (sort-by (comp str key) (node/channels n))]
{:path (conj path cpath)
:depth depth
:label (str/join " " (map name cpath))
:kind :channel
:select nil
:span (when (or (:dense ch) (seq (:keys ch))) span)
:keys (mapv ->root (keyed-frames ch))
:dense? (boolean (:dense ch))}))
(defn rows
"The visible rows, outermost first. `expanded` is a set of row paths."
[clip expanded]
(letfn [(walk [tid path depth ->root]
(let [tl (get-in clip [:timelines tid])
ordered (->> (:nodes tl)
;; Front-most at the top, as a layer list is drawn
;; everywhere. `:z` is the lexicographic draw key;
;; the id breaks ties so the order is stable.
(sort-by (fn [[id n]] [(or (:z n) "") (str id)]))
reverse)]
(into []
(mapcat
(fn [[id n]]
(let [rpath (conj path id)
open? (contains? expanded rpath)
channels (node/channels n)
;; The span is in the PARENT's space and the channels
;; are in the node's own, so they take different
;; mappings. `self` is also what the symbol's target
;; timeline is resolved in — `clip/resolver` roots the
;; child at this node's local frame — so the nested
;; walk carries it down unchanged.
self (comp ->root (local->parent n))
span (mapv ->root (or (:span n) [0 (:frames tl)]))
row {:path rpath
:depth depth
:label (node-label id n)
:kind :node
:node-kind (:kind n)
:select [:node tid id]
:expandable? true
:expanded? open?
:span span
:keys (into [] (comp (mapcat keyed-frames)
(map self)
(distinct))
(vals channels))
:dense? (boolean (some :dense (vals channels)))}]
(if-not open?
[row]
(-> [row]
(into (channel-rows n rpath (inc depth) self span))
(into (when (= :symbol (:kind n))
(walk (:of n) rpath (inc depth) self)))))))
ordered))))]
(if (get-in clip [:timelines :main])
(walk :main [] 0 identity)
[])))
;; ---------------------------------------------------------------------------
;; geometry
;;
;; Percentages, so nothing has to measure the track column. A frame f occupies
;; [f/frames, (f+1)/frames), and a mark that names one frame sits at its centre.
(defn- at% [f frames] (str (* 100 (/ (+ f 0.5) (max 1 frames))) "%"))
(defn- edge% [f frames] (str (* 100 (/ f (max 1 frames))) "%"))
(defn- frame-at
"Which frame the pointer is over."
[^js event frames]
(let [box (.getBoundingClientRect (.-currentTarget event))
x (- (.-clientX event) (.-left box))]
(-> (/ (* x frames) (.-width box)) js/Math.floor (max 0) (min (dec frames)))))
;; ---------------------------------------------------------------------------
;; the panes
(defn- transport []
(let [playing? @(rf/subscribe [::playback/playing?])
rate @(rf/subscribe [::playback/rate])
frame @(rf/subscribe [::playback/frame])
frames @(rf/subscribe [::playback/frames])
{:keys [fps drop]} @player/meter]
[:div.pane-head
[: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 [::playback/loop?]) "on")
:on-click #(rf/dispatch [::pb/toggle-loop])} "loop"]
[:button {:class (when @(rf/subscribe [::playback/muted?]) "on")
:on-click #(rf/dispatch [::pb/toggle-mute])} "mute"]
(doall
(for [r [0.25 0.5 1.0 2.0 4.0]]
^{:key r}
;; playbackRate on the audio element and nothing else: the sound slows,
;; currentTime advances proportionally, and the derived frame follows. Slow
;; motion cannot desync by construction.
[:button {:class (when (== r rate) "on")
:on-click #(rf/dispatch [::pb/set-rate r])}
(case r 1.0 "1x" 0.5 "½" 0.25 "¼" 2.0 "2x" 4.0 "4x" (str r))]))
[:span.spacer]
[:span.dim (str frame " / " frames)]
;; Measured in the loop, not derived from the clock — the whole question
;; while profiling is whether the painting keeps up with the clock, and a
;; number computed FROM the clock would answer itself.
[:span {:class (if (and drop (> drop 1.35)) "warn" "dim")}
(str (.toFixed (or fps 0) 1) " paint/s"
(when (and drop (pos? drop)) (str " · " (.toFixed drop 2) " f/paint")))]]))
(defn- label-cell [{:keys [path depth label kind node-kind select expandable? expanded?]}
selection]
[:div {:class (str "tl-label" (when (and select (= select selection)) " on"))
:style {:padding-left (str (+ 4 (* 11 depth)) "px")}
:title label
:on-click #(when select (rf/dispatch [::ui/select select]))}
[:button.tl-twist
{:disabled (not expandable?)
:on-click (fn [^js e]
(.stopPropagation e)
(rf/dispatch [::ui/toggle-row path]))}
(when expandable? (if expanded? "▾" "▸"))]
[:span.name label]
(when (= :node kind) [:span.kind (str "·" (name node-kind))])])
(defn- track-cell [{:keys [span keys dense?]} frames]
[:div.tl-track
(when span
[:div {:class (str "tl-span" (when dense? " dense"))
:style {:left (edge% (first span) frames)
:width (str (* 100 (/ (- (second span) (first span))
(max 1 frames))) "%")}}])
;; A dense channel has a value on every frame, so ticking each one is a solid
;; block that says less than the bar behind it already does.
(when-not dense?
(doall
(for [f keys :when (and (<= 0 f) (< f frames))]
^{:key f} [:div.tl-key {:style {:left (at% f frames)}}])))])
(defn view []
(r/with-let [scrubbing (r/atom false)]
(let [clip @(rf/subscribe [::render/clip])
frames (max 1 (or @(rf/subscribe [::playback/frames]) 1))
frame @(rf/subscribe [::playback/frame])
selection @(rf/subscribe [::sub/selection])
expanded @(rf/subscribe [::sub/expanded])
visible (rows clip expanded)
;; Roughly ten labels, on a round number of frames.
step (* 10 (js/Math.ceil (/ frames 100)))]
[:section.pane.time
[transport]
[:div.tl-body
[:div.tl-labels
[:div {:style {:height "var(--ruler)"
:border-bottom "1px solid var(--line)"
:background "var(--chrome)"}}]
(doall (for [row visible]
^{:key (str (:path row))} [label-cell row selection]))]
[:div.tl-tracks
;; Five frames as a percentage of the whole span, handed to the
;; stylesheet so the frame grid can be a repeating background instead of
;; a div per frame. A 900-frame take is 900 elements nobody needs.
{:style {"--tick" (str (* 100 (/ 5 frames)) "%")}}
[:div.tl-ruler
{:on-pointer-down (fn [^js e]
(rf/dispatch [::pb/seek (frame-at e frames)])
(reset! scrubbing true)
;; Capture is what keeps a drag scrubbing once it
;; leaves the ruler, and it is an ENHANCEMENT: it
;; throws on a pointer id the browser does not have
;; an active pointer for, which is every event
;; `test/browser` synthesises. Seeking already
;; happened, so the catch loses the drag and nothing
;; else — where letting it throw would put an
;; uncaught error on the console that the suite
;; rightly fails on.
(try
(.setPointerCapture (.-currentTarget e) (.-pointerId e))
(catch :default _ nil)))
:on-pointer-move (fn [^js e]
(when @scrubbing
(rf/dispatch [::pb/seek (frame-at e frames)])))
:on-pointer-up (fn [_] (reset! scrubbing false))
:on-pointer-cancel (fn [_] (reset! scrubbing false))}
(doall
(for [f (range 0 frames step)]
^{:key f} [:div.tick {:style {:left (edge% f frames)}} f]))]
(if (seq visible)
(doall (for [row visible]
^{:key (str (:path row))} [track-cell row frames]))
[:div.tl-empty "nothing on this timeline"])
[:div.tl-playhead {:style {:left (at% frame frames)}}]]]])))

60
frontend/src/arthur/ui/topbar.cljs Normal file
View file

@ -0,0 +1,60 @@
(ns arthur.ui.topbar
"The strip across the top: what document this is, and the three things you can
do to the whole of it.
Save, open and export are here rather than in a pane because none of them is a
property of a selection — they act on the document, and the document is the
window."
(:require [arthur.events.export :as export]
[arthur.events.project :as project]
[arthur.subs.playback :as playback]
[arthur.ui.openmenu :as openmenu]
[re-frame.core :as rf]))
(defn- exporter []
(let [{:keys [timeline zoom isolate busy? done total]} @(rf/subscribe [::export/state])
targets @(rf/subscribe [::export/targets])]
[:<>
;; ONE SELECT over everything exportable: the clip, each symbol in its
;; library, and each placement on the stage. They are one list because they
;; are one kind of request — render this, alone.
;;
;; The option VALUE goes through `export/target-value`, never `name`: a
;; symbol timeline is `:sym/face-8625` and a placement is a uuid, and writing
;; either through `name` loses what identifies it.
[:select {:value (export/target-value {:timeline (or timeline :main) :isolate isolate})
:disabled busy?
:title "what to render"
:on-change #(rf/dispatch [::export/set-target
(export/target-id (.. % -target -value))])}
(doall
(for [{:keys [label] :as target} targets]
^{:key (export/target-value target)}
[:option {:value (export/target-value target)}
(str (when (:isolate target) "· ") label)]))]
[:select {:value zoom :disabled busy?
:title "integer zoom"
:on-change #(rf/dispatch [::export/set-zoom
(js/parseInt (.. % -target -value) 10)])}
(doall (for [z export/zooms] ^{:key z} [:option {:value z} (str z "x")]))]
[:button {:disabled busy? :on-click #(rf/dispatch [::export/start])
:title "a lossless PNG sequence and the mixed audio, in one zip"}
(if busy? (str "rendering " done "/" total) "export")]]))
(defn view []
(let [{project-name :name :keys [busy? seq] project-status :status}
@(rf/subscribe [::playback/project])
{footage-status :status} @(rf/subscribe [::playback/footage])
{export-status :status} @(rf/subscribe [::export/state])]
[:header.top
[:span.brand "arthur"]
[:span.status
(str (or project-name "untitled") (when seq (str " r" seq))
;; One line, and the most recent thing to have happened wins it. A
;; strip with three status slots is three empty boxes most of the time.
(when-let [said (or export-status project-status footage-status)]
(str " · " said)))]
[exporter]
[:button {:disabled busy? :on-click #(rf/dispatch [::project/new])} "new"]
[openmenu/view]
[:button {:disabled busy? :on-click #(rf/dispatch [::project/save])} "save"]]))