diff --git a/tl/resources/public/css/app.css b/tl/resources/public/css/app.css index 4524a74..df60675 100644 --- a/tl/resources/public/css/app.css +++ b/tl/resources/public/css/app.css @@ -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; diff --git a/tl/src/tl/events.cljs b/tl/src/tl/events.cljs index 6067a56..ed45901 100644 --- a/tl/src/tl/events.cljs +++ b/tl/src/tl/events.cljs @@ -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 diff --git a/tl/src/tl/scene.cljs b/tl/src/tl/scene.cljs index 9c7e785..0f8cc45 100644 --- a/tl/src/tl/scene.cljs +++ b/tl/src/tl/scene.cljs @@ -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 diff --git a/tl/src/tl/subs.cljs b/tl/src/tl/subs.cljs index 8a58470..f4f063c 100644 --- a/tl/src/tl/subs.cljs +++ b/tl/src/tl/subs.cljs @@ -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)] diff --git a/tl/src/tl/views.cljs b/tl/src/tl/views.cljs index 516ae68..a3ac915 100644 --- a/tl/src/tl/views.cljs +++ b/tl/src/tl/views.cljs @@ -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,20 +333,22 @@ s (str clip "#t=" (.toFixed t 3))] (reset! cache {:clip clip :src s}) s))] - [:video {:src src :controls true :preload "auto" - :plays-inline true :webkit-playsinline "true" - ;; desktop / once-loaded: align to the playhead when metadata is - ;; ready (iOS already arrived there via the #t= fragment). - :on-loaded-metadata - (fn [_] - (when-not @play - (let [segs @(rf/subscribe [::subs/segments]) - fps @(rf/subscribe [::subs/fps]) - ph @(rf/subscribe [::subs/playhead])] - (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)))}])))) + [: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 + ;; ready (iOS already arrived there via the #t= fragment). + :on-loaded-metadata + (fn [_] + (when-not @play + (let [segs @(rf/subscribe [::subs/segments]) + fps @(rf/subscribe [::subs/fps]) + ph @(rf/subscribe [::subs/playhead])] + (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)))}] + [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