feat: wiggly-paint drawings bound to marks

A drawing is a first-class :type :drawing entity (normalized strokes +
seed), bound to a mark via mark :drawings [gid] — same referrer-pointer
model as notes. It renders as a boiling SVG overlay on the video whenever
the playhead is in the bound mark's span (the same hook that lights an
annotation active), including when that annotation is the pushed context.

- Author in an overlay on the video monitor: pencil, eraser (deletes a
  whole stroke), undo; the 🖼 button on each mark row enters draw mode
  and seeks to the mark's frame.
- Boil is procedural: 3 seeded jitter variants of the base paths cycled
  at ~7fps; only the strokes persist.

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
This commit is contained in:
Your Name 2026-07-01 18:03:44 -04:00
parent b4924aa992
commit 9f06b51f76
5 changed files with 216 additions and 18 deletions

View file

@ -80,8 +80,27 @@ body { overflow: hidden; background: var(--desktop); background-size: 4px 4px;
display: flex; align-items: center; justify-content: center;
background: #000; overflow: hidden; border-right: 1px solid var(--ink);
}
.video-wrap { position: relative; display: inline-block; line-height: 0; max-width: 100%; max-height: 100%; }
.video-pane video { max-width: 100%; max-height: 100%; display: block; background: #000; }
/* wiggly-paint drawing overlay, exactly over the video box */
.draw-overlay { position: absolute; inset: 0; pointer-events: none; }
.draw-overlay.editing { pointer-events: auto; cursor: crosshair; }
.draw-overlay svg { position: absolute; inset: 0; width: 100%; height: 100%; }
.draw-tools { position: absolute; top: 6px; left: 50%; transform: translateX(-50%);
display: flex; align-items: center; gap: 4px; padding: 3px 5px; line-height: 1;
background: var(--paper); border: 1px solid var(--ink); box-shadow: 2px 2px 0 rgba(0,0,0,.4); }
.draw-tools button { font-size: 13px; background: var(--paper); color: var(--ink);
border: 1px solid var(--ink); border-radius: 0; padding: 1px 6px; cursor: pointer; }
.draw-tools button.active { background: var(--ink); }
.draw-tools button:disabled { opacity: .4; cursor: default; }
.draw-tools .draw-spacer { width: 8px; }
.draw-done { font-weight: bold; }
.mark-draw { background: none; border: 1px solid transparent; border-radius: 0;
font-size: 12px; cursor: pointer; padding: 0 3px; line-height: 1; }
.mark-draw:hover { border-color: var(--ink); }
.mark-draw.has { border-color: var(--ink); background: var(--paper); }
.frame-readout {
position: absolute; bottom: 6px; right: 8px; z-index: 4;
display: flex; gap: 8px; align-items: center;

View file

@ -426,6 +426,47 @@
(fn [db [_ gid mark-id note-gid]]
(update-mark db gid mark-id #(update % :notes rm-in note-gid))))
;; --- drawings -------------------------------------------------------------
;; A drawing is a first-class entity (:type :drawing) — a bag of normalized
;; strokes + a seed for its wiggle boil — bound to a mark via mark :drawings
;; [gid], same referrer-pointer model as notes. It shows over the video whenever
;; the playhead is in that mark's span (see subs/active-drawings). Authoring lives
;; in a canvas overlay on the video monitor; only the final strokes persist.
;; enter draw mode for a mark: edit its existing drawing (first bound) or a fresh
;; gid. The entity isn't written until ::save-drawing, so cancel is a clean no-op.
(rf/reg-event-db ::start-drawing
(fn [db [_ ann mark-id]]
(let [existing (first (some (fn [m] (when (= mark-id (:id m)) (:drawings m)))
(get-in db [:scene :groups ann :marks])))]
(assoc-in db [:view :draw]
{:ann ann :mark-id mark-id
:gid (or existing (keyword (str "draw-" (random-uuid))))
:new? (nil? existing)}))))
(rf/reg-event-db ::cancel-drawing (fn [db _] (assoc-in db [:view :draw] nil)))
;; commit strokes: upsert the drawing entity (persist now, it's standalone) and
;; bind it onto the mark (rides the annotation's Save, like note bindings). Empty
;; strokes ⇒ discard (and drop a now-empty existing binding).
(rf/reg-event-fx ::save-drawing
(fn [{:keys [db]} [_ strokes]]
(let [{:keys [ann mark-id gid]} (get-in db [:view :draw])]
(if (empty? strokes)
{:db (-> db (update-mark ann mark-id #(update % :drawings rm-in gid))
(assoc-in [:view :draw] nil))}
(let [drawing (-> (get-in db [:scene :groups gid] {:seed (rand-int 1000000)})
(assoc :type :drawing :strokes (vec strokes)))
db (-> db (assoc-in [:scene :groups gid] drawing)
(update-mark ann mark-id #(update % :drawings add-in gid))
(assoc-in [:view :draw] nil)
(assoc :save-error nil))]
(merge {:db db} (persist-note-fx db gid)))))))
(rf/reg-event-db ::unbind-drawing-mark
(fn [db [_ gid mark-id draw-gid]]
(update-mark db gid mark-id #(update % :drawings rm-in draw-gid))))
;; content edits go through their own event (not put-group) so the contenteditable
;; surface can update :content without re-reading a possibly-stale draft map.
(rf/reg-event-db ::set-content

View file

@ -159,6 +159,14 @@
(recur more (+ off len) (into out shifted)))
(recur more off out)))))
(defn mark-bars
"Local (context) bars for one mark of annotation `ann-gid`, given the context's
content-segments — where that single mark lands in the current timeline. Drives
the per-mark playhead-in-range tests (script-note »»» and drawing visibility)."
[scene ann-gid mark-id ctx-segs]
(merge-bars (mapcat (fn [{[a b] :src}] (pieces ctx-segs a b))
(filter #(= mark-id (:mark %)) (resolve scene ann-gid)))))
(defn broken-marks
"Mark ids in `gid` whose refs no longer resolve."
[scene gid]
@ -256,7 +264,8 @@
(get-in m [:start :ref]) (update-in [:start :ref] keyword)
(get-in m [:end :ref]) (update-in [:end :ref] keyword)
(:track m) (update :track keyword)
(:notes m) (update :notes #(mapv keyword %)))) ; bound script-note gids
(:notes m) (update :notes #(mapv keyword %)) ; bound script-note gids
(:drawings m) (update :drawings #(mapv keyword %)))) ; bound drawing gids
(defn- restore-region
"A script-note region loses keyword-ness through JSON: re-keyword :id and :kind."
@ -294,8 +303,9 @@
[anns]
(into {} (map (fn [[gid g]]
(let [g (-> g (update :type keyword) (update :parent keyword))]
[gid (if (= :script-note (:type g))
(update g :regions #(mapv restore-region (or % [])))
[gid (case (:type g)
:script-note (update g :regions #(mapv restore-region (or % [])))
:drawing g ; pure strokes + seed, JSON round-trips as-is
(-> g
(update :marks #(mapv restore-mark (or % [])))
(update :notes #(when % (mapv keyword %))) ; annotation-level bindings

View file

@ -147,6 +147,32 @@
;; one note by id (for the active-note authoring panel)
(rf/reg-sub ::note :<- [::scene] (fn [scene [_ gid]] (get-in scene [:groups gid])))
;; --- drawings -------------------------------------------------------------
(rf/reg-sub ::draw (fn [db] (get-in db [:view :draw]))) ; draw-mode state or nil
(rf/reg-sub ::drawing :<- [::scene] (fn [scene [_ gid]] (get-in scene [:groups gid])))
;; drawings to render over the video now: those bound to a mark whose span the
;; playhead is inside — the same playhead-in-mark hook that lights an annotation.
(rf/reg-sub
::active-drawings
:<- [::scene] :<- [::context] :<- [::segments] :<- [::playhead]
(fn [[scene ctx segs ph] _]
(let [in? (fn [bars] (some (fn [[lo hi]] (<= lo ph hi)) bars))]
(->> (:groups scene)
;; child annotations of the context OR the context annotation itself
;; (when you push the owner onto the stack, ctx IS that annotation)
(mapcat (fn [[gid g]]
(when (and (= :annotation (:type g)) (or (= ctx (:parent g)) (= ctx gid)))
(mapcat (fn [m]
(when (and (seq (:drawings m))
(in? (scene/mark-bars scene gid (:id m) segs)))
(:drawings m)))
(:marks g)))))
distinct
(keep (fn [dg] (when-let [d (get-in scene [:groups dg])]
(when (= :drawing (:type d)) (assoc d :id dg)))))
vec))))
;; the set of note gids whose bound span currently contains the playhead — drives
;; the >>> "we're in range" indicator. Annotation-level bindings light while the
;; playhead is in ANY of the annotation's bars; a mark-level binding lights only
@ -160,7 +186,7 @@
(mapcat (fn [{[a b] :src}] (scene/pieces segs a b)) src-segs)))]
(reduce
(fn [acc [gid g]]
(if (and (= :annotation (:type g)) (= ctx (:parent g)))
(if (and (= :annotation (:type g)) (or (= ctx (:parent g)) (= ctx gid)))
(let [src-segs (scene/resolve scene gid)
acc (if (and (seq (:notes g)) (in? (bars src-segs)))
(into acc (:notes g)) acc)]

View file

@ -216,6 +216,98 @@
(r/after-render #(do (follow! fps zoom local true) ; smooth on jump/link
(scroll-to-seg-track! segs local)))))))
;; --- drawings: wiggly-paint overlay on the video --------------------------
;; Strokes are normalized [0,1] over the video box. The "boil" is procedural: we
;; jitter every point by a seeded amount per variant and cycle variants on a timer
;; — 3 hand-drawn frames out of one set of paths, nothing extra stored.
(def ^:private wiggle-variants 3)
(def ^:private wiggle-amp 0.0035) ; jitter as a fraction of the frame
(def ^:private draw-width 2.6) ; on-screen stroke px (non-scaling)
(defonce ^:private boil (r/atom 0))
(defonce ^:private _boil-timer (js/setInterval #(swap! boil inc) 140)) ; ~7fps
(defn- hash01 [n]
(let [v (* (js/Math.sin (* n 12.9898)) 43758.5453)]
(- (* 2 (- v (js/Math.floor v))) 1))) ; deterministic [-1,1]
(defn- pts->str [pts seed variant]
(->> pts
(map-indexed (fn [i [x y]]
(let [b (+ (* seed 131) (* i 17) (* variant 977))]
(str (+ x (* wiggle-amp (hash01 b))) ","
(+ y (* wiggle-amp (hash01 (+ b 7))))))))
(str/join " ")))
(defn- drawing-strokes [strokes seed variant]
(for [[i {:keys [pts color w]}] (map-indexed vector strokes)]
^{:key i}
[:polyline {:points (pts->str pts seed variant)
:fill "none" :stroke (or color "#111") :stroke-width (or w draw-width)
:vector-effect "non-scaling-stroke" :stroke-linecap "round" :stroke-linejoin "round"}]))
(defn- pointer-xy [^js svg ^js e]
(let [r (.getBoundingClientRect svg)]
[(/ (- (.-clientX e) (.-left r)) (.-width r))
(/ (- (.-clientY e) (.-top r)) (.-height r))]))
(defn- near-stroke? [[px py] {:keys [pts]}]
(some (fn [[x y]] (< (+ (* (- x px) (- x px)) (* (- y py) (- y py))) 0.0006)) pts))
(defn drawing-layer
"Overlay covering the video box. Passive (pointer-events off) while it just
renders the active drawings; interactive in draw mode (pencil/eraser/undo).
Editing state is local; only the committed strokes persist."
[]
(r/with-let [strokes (r/atom []) undo (r/atom []) cur (r/atom nil)
tool (r/atom :pencil) svg (atom nil) sess (atom nil)]
(let [draw @(rf/subscribe [::subs/draw])
drawing (when draw @(rf/subscribe [::subs/drawing (:gid draw)]))
color (when draw (or (get-in @(rf/subscribe [::subs/scene]) [:groups (:ann draw) :color]) "#111"))
actives @(rf/subscribe [::subs/active-drawings])
tick @boil
variant (mod tick wiggle-variants)]
;; seed local editing state at the start of a draw session
(when (and draw (not= @sess (:gid draw)))
(reset! sess (:gid draw)) (reset! strokes (vec (:strokes drawing)))
(reset! undo []) (reset! cur nil) (reset! tool :pencil))
(when (and (nil? draw) @sess) (reset! sess nil))
(let [push! #(swap! undo conj @strokes)
erase-at (fn [xy] (when-let [i (first (keep-indexed (fn [i s] (when (near-stroke? xy s) i)) @strokes))]
(push!) (swap! strokes #(vec (concat (subvec % 0 i) (subvec % (inc i)))))))]
[:div.draw-overlay {:class (when draw "editing")}
[:svg {:viewBox "0 0 1 1" :preserveAspectRatio "none" :ref #(reset! svg %)
:on-pointer-down
(when draw (fn [^js e] (.preventDefault e)
(let [xy (pointer-xy @svg e)]
(.setPointerCapture (.-target e) (.-pointerId e))
(if (= @tool :eraser) (erase-at xy)
(reset! cur {:pts [xy] :color color :w draw-width})))))
:on-pointer-move
(when draw (fn [^js e]
(let [xy (pointer-xy @svg e)]
(cond (= @tool :eraser) (when (pos? (.-buttons e)) (erase-at xy))
@cur (swap! cur update :pts conj xy)))))
:on-pointer-up
(when draw (fn [_] (when-let [c @cur]
(when (> (count (:pts c)) 1) (push!) (swap! strokes conj c))
(reset! cur nil))))}
(if draw
[:g [:g (drawing-strokes @strokes (or (:seed drawing) 0) variant)]
[:g (when @cur (drawing-strokes [@cur] 0 0))]]
(for [d actives] ^{:key (name (:id d))}
[:g (drawing-strokes (:strokes d) (or (:seed d) 0) variant)]))]
(when draw
[:div.draw-tools
[:button {:class (when (= @tool :pencil) "active") :title "Pencil" :on-click #(reset! tool :pencil)} "✏️"]
[:button {:class (when (= @tool :eraser) "active") :title "Eraser (deletes a stroke)" :on-click #(reset! tool :eraser)} "🧽"]
[:button {:title "Undo" :disabled (empty? @undo)
:on-click #(when (seq @undo) (reset! strokes (peek @undo)) (swap! undo pop))} "↶"]
[:span.draw-spacer]
[:button.draw-done {:title "Done" :on-click #(rf/dispatch [::events/save-drawing @strokes])} "✓"]
[:button {:title "Cancel" :on-click #(rf/dispatch [::events/cancel-drawing])} "✕"]])]))))
(defn video-monitor []
;; The src carries a #t= media fragment for the deep-linked playhead. That is
;; the only thing that reliably starts iOS at the right time: iOS won't load
@ -241,6 +333,7 @@
s (str clip "#t=" (.toFixed t 3))]
(reset! cache {:clip clip :src s})
s))]
[:div.video-wrap
[:video {:src src :controls true :preload "auto"
:plays-inline true :webkit-playsinline "true"
;; desktop / once-loaded: align to the playhead when metadata is
@ -254,7 +347,8 @@
(seek-video! fps (scene/local->source segs ph)))))
:on-play (fn [_] (engage-play!))
:on-pause (fn [_] (disengage!))
:ref (fn [n] (when n (reset! video-el n)))}]))))
:ref (fn [n] (when n (reset! video-el n)))}]
[drawing-layer]]))))
(defn- clip-label
"Track-local clip label for the content segment whose :mark is `mid`."
@ -968,6 +1062,14 @@
[frame-chip scene segs put d i :start (:s row)]
[:span.mark-arrow "→"]
[frame-chip scene segs put d i :end (:e row)]
[:button.mark-draw {:type "button"
:class (when (seq (:drawings mark)) "has")
:title (if (seq (:drawings mark)) "Edit drawing on this shot" "Draw on this shot")
:on-click (fn []
(when-let [s (ffirst (scene/mark-bars scene gid mark-id segs))]
(goto! s true))
(rf/dispatch [::events/start-drawing gid mark-id]))}
(if (seq (:drawings mark)) "🖼" "🖼+")]
[:button.row-x {:type "button" :title "Remove"
:on-click #(put (update d :marks (fn [ms] (vec (concat (subvec ms 0 i) (subvec ms (inc i)))))))} "✕"]]
[note-drop nil (:notes mark) nmap live