diff --git a/tl/src/tl/events.cljs b/tl/src/tl/events.cljs index 67a47b6..969047a 100644 --- a/tl/src/tl/events.cljs +++ b/tl/src/tl/events.cljs @@ -75,7 +75,7 @@ (let [stack (vec (valid-stack scene stack)) ctx (peek stack)] (cond-> (assoc view :stack stack) - playhead (assoc-in [:playheads ctx] playhead)))) + playhead (assoc-in [:playheads ctx] (scene/assert-frame "route playhead" playhead))))) (defn- route-state [db] (let [ctx (peek (get-in db [:view :stack]))] @@ -601,7 +601,8 @@ ;; moved the stack, so snap back to the editing context before seeking the frame. (rf/reg-event-fx ::preview-frame (fn [{:keys [db]} [_ local]] - (let [stack (get-in db [:view :linking :stack]) + (let [local (scene/assert-frame "preview frame" local) + stack (get-in db [:view :linking :stack]) ctx (peek stack) db (-> db (assoc-in [:view :stack] stack) (assoc-in [:view :playheads ctx] local)) @@ -611,7 +612,8 @@ (rf/reg-event-fx ::set-playhead (fn [{:keys [db]} [_ ctx lf]] - (let [next-db (-> db + (let [lf (scene/assert-frame "playhead" lf) + next-db (-> db (assoc-in [:view :playheads ctx] lf) (sync-draft-mark-for-playhead ctx lf))] (sync-route {:db next-db} next-db)))) @@ -841,8 +843,8 @@ (scene/seg-local segs seg-id (or frame 0)) (scene/seg-local segs seg-id (or frame (scene/seg-length segs seg-id)))) keep (:keep pt) - lo (js/Math.round (min new-local keep)) - hi (js/Math.round (max new-local keep))] + lo (scene/assert-frame "proxy range start" (min new-local keep)) + hi (scene/assert-frame "proxy range end" (max new-local keep))] {:db (-> db (assoc-in [:scene :groups (:proxy pt)] (scene/roll-proxy scene (:parent g) proxy lo (max (inc lo) hi))) (assoc-in [:view :pt] :new))}) @@ -903,9 +905,8 @@ ;; For a normal (non-transcluded) mark the two are the same. ctx (peek (get-in db [:view :stack])) len (scene/length (scene/content-segments scene ctx)) - ;; the dragged endpoint is a whole frame; the FIXED endpoint arrives - ;; EXACT (fractional) so its mark re-derives identically. Only the fixed - ;; end must avoid rounding here — the clamp keeps [la lb) valid half-open. + la (scene/assert-frame "proxy roll start" la) + lb (scene/assert-frame "proxy roll end" lb) la* (max 0 (min la (dec len))) lb* (max (inc la*) (min lb len))] (if (= :proxy (:type proxy)) @@ -918,7 +919,8 @@ (rf/reg-event-db ::set-proxy-frame (fn [db [_ pid which frame]] - (let [marks (get-in db [:scene :groups pid :marks]) + (let [frame (scene/assert-frame "proxy endpoint frame" frame) + marks (get-in db [:scene :groups pid :marks]) idx (if (= which :start) 0 (dec (count marks)))] (assoc-in db [:scene :groups pid :marks idx which :at] frame)))) diff --git a/tl/src/tl/otio.cljs b/tl/src/tl/otio.cljs index e1d7883..7600a33 100644 --- a/tl/src/tl/otio.cljs +++ b/tl/src/tl/otio.cljs @@ -13,14 +13,20 @@ (defn- clip? [item] (str/starts-with? (:OTIO_SCHEMA item "") "Clip")) -(defn- frames - "Frame number of a RationalTime, as a WHOLE frame. This is the ONE place a - fraction can enter: a rate conform (e.g. 23.976 NTSC) gives fractional source - positions (start_time). A frame is absolute and integer — you can't seek to half - a frame — so we snap here, at the boundary. Everything downstream is integer and - nothing else rounds (durations are already whole, so timeline tiling is exact)." +(defn- timeline-frames + "Frame count/position for timeline math. These must already be integer frames." [rational-time] - (js/Math.round (:value rational-time))) + (let [v (:value rational-time)] + (when-not (integer? v) + (throw (js/Error. (str "OTIO RationalTime value must be an integer frame, got " v)))) + v)) + +(defn- media-frame + "Source media position as an integer frame index. Some OTIO exports carry + rate-conformed source starts as sub-frame RationalTime values; the app model is + frame-index based, so source starts are normalized once at this import boundary." + [rational-time] + (int (:value rational-time))) (defn- clip-starts "Source start_time (frames) of every clip across all tracks." @@ -28,15 +34,15 @@ (for [t tracks c (:children t) :when (clip? c)] - (frames (get-in c [:source_range :start_time])))) + (media-frame (get-in c [:source_range :start_time])))) (defn- parse-track [media-offset idx track] - (loop [pos 0.0 + (loop [pos 0 items (:children track) ci 0 clips (transient [])] (if-let [item (first items)] - (let [dur (frames (get-in item [:source_range :duration])) + (let [dur (timeline-frames (get-in item [:source_range :duration])) is-clip (clip? item)] (recur (+ pos dur) (rest items) @@ -46,7 +52,7 @@ :name (:name item) :start pos ; timeline frame, 0-based :duration dur - :media-in (- (frames (get-in item [:source_range :start_time])) + :media-in (- (media-frame (get-in item [:source_range :start_time])) media-offset)}) ; frame into local .mov clips))) {:id idx @@ -62,11 +68,11 @@ (let [tracks (get-in otio [:tracks :children]) fps (get-in otio [:global_start_time :rate] 24) starts (clip-starts tracks) - media-offset (if (seq starts) (apply min starts) 0.0) + media-offset (if (seq starts) (apply min starts) 0) parsed (vec (map-indexed (partial parse-track media-offset) tracks))] {:fps fps :media-offset media-offset - :duration (reduce max 0.0 (for [t parsed - c (:clips t)] - (+ (:media-in c) (:duration c)))) + :duration (reduce max 0 (for [t parsed + c (:clips t)] + (+ (:media-in c) (:duration c)))) :tracks parsed})) diff --git a/tl/src/tl/routes.cljs b/tl/src/tl/routes.cljs index b2bf1fe..e277b5d 100644 --- a/tl/src/tl/routes.cljs +++ b/tl/src/tl/routes.cljs @@ -2,7 +2,8 @@ (:require [clojure.string :as str] [reitit.frontend :as reitit] - [reitit.frontend.easy :as rfe])) + [reitit.frontend.easy :as rfe] + [tl.scene :as scene])) (def routes [["/" {:name :projects}] @@ -54,15 +55,18 @@ (into {} (map (fn [[k v]] [(keyword k) v]) (:query-params match)))) stack (some-> (:stack qp) (str/split #",")) - f (some-> (:f qp) js/parseFloat)] + fstr (some-> (:f qp) str) + f (when (and fstr (re-matches #"\d+" fstr)) + (scene/assert-frame "route playhead" (js/parseInt fstr 10)))] (cond-> {} (seq stack) (assoc :stack (mapv keyword stack)) - (and f (not (js/isNaN f))) (assoc :playhead f)))) + f (assoc :playhead f)))) (defn project-url [id stack playhead] (let [stack-param (->> (rest stack) (map name) (str/join ",")) query (query-string {:stack stack-param - :f (some-> playhead js/Math.round)})] + :f (when (some? playhead) + (scene/assert-frame "route playhead" playhead))})] (str (href :project/show {:id id}) query))) (defonce ^:private last-replaced (atom nil)) diff --git a/tl/src/tl/scene.cljs b/tl/src/tl/scene.cljs index 8aea34c..79a3551 100644 --- a/tl/src/tl/scene.cljs +++ b/tl/src/tl/scene.cljs @@ -16,6 +16,28 @@ (defn- grp [scene gid] (get-in scene [:groups gid])) +(defn frame? + "True when `n` is a concrete integer frame coordinate." + [n] + (and (number? n) (integer? n) (not (js/isNaN n)))) + +(defn assert-frame + "Return `n` after asserting it is an integer frame. This is intentionally a + runtime check, not cljs.core/assert, so production builds keep the invariant." + [label n] + (when-not (frame? n) + (throw (js/Error. (str label " must be an integer frame, got " (pr-str n))))) + n) + +(defn assert-range + "Return `[lo hi]` after asserting a valid integer half-open frame range." + [label [lo hi]] + (assert-frame (str label " start") lo) + (assert-frame (str label " end") hi) + (when (> lo hi) + (throw (js/Error. (str label " must be ordered, got " (pr-str [lo hi]))))) + [lo hi]) + (defn- find-mark "[owning-gid mark] for a mark id anywhere in the scene, or nil." [scene mid] @@ -31,7 +53,10 @@ (defn local->source "The source frame shown at local frame `lf` (clamped to the end)." [segs lf] + (assert-frame "local frame" lf) (or (some (fn [{:keys [src local]}] + (assert-range "segment source" src) + (assert-range "segment local" local) (let [[c d] local [a _] src] (when (and (<= c lf) (< lf d)) (+ a (- lf c))))) segs) @@ -40,7 +65,10 @@ (defn source->local "Local frame for source frame `sf` (first segment containing it), or nil." [segs sf] + (assert-frame "source frame" sf) (some (fn [{:keys [src local]}] + (assert-range "segment source" src) + (assert-range "segment local" local) (let [[a b] src [c _] local] (when (and (<= a sf) (< sf b)) (+ c (- sf a))))) segs)) @@ -48,7 +76,10 @@ (defn pieces "Where source range [sa sb) lands in local coords: a list of [lo hi)." [segs sa sb] + (assert-range "source range" [sa sb]) (vec (keep (fn [{:keys [src local]}] + (assert-range "segment source" src) + (assert-range "segment local" local) (let [[a b] src [c _] local lo (max sa a) hi (min sb b)] (when (< lo hi) [(+ c (- lo a)) (+ c (- hi a))]))) @@ -58,13 +89,11 @@ "Coalesce [lo hi) ranges that meet at a boundary into single bars, so a continuous run spanning several clips reads as one piece. Ranges are half-open, so adjacent clips share a boundary (A.hi == B.lo) and merge exactly — no gap to - fudge. Endpoints snap to whole frames first (a bar covers the frames it - touches); only a real (≥1 frame) gap splits. Called per-mark, so it never fuses - two distinct marks." + fudge. Called per-mark, so it never fuses two distinct marks." [bars] (reduce (fn [acc [lo hi]] - (let [lo (js/Math.floor lo) hi (js/Math.ceil hi) - [plo phi] (peek acc)] + (assert-range "bar" [lo hi]) + (let [[plo phi] (peek acc)] (if (and plo (<= lo phi)) (conj (pop acc) [plo (max phi hi)]) (conj acc [lo hi])))) @@ -74,8 +103,11 @@ (defn slice "Sub-segments of `segs` covering local range [la lb), src + local re-cut." [segs la lb] + (assert-range "slice" [la lb]) (vec (keep (fn [{:keys [src local] :as seg}] + (assert-range "segment source" src) + (assert-range "segment local" local) (let [[a _] src [c d] local lo (max la c) hi (min lb d)] (when (< lo hi) @@ -323,9 +355,9 @@ (defn mark-extent "EXACT context-local [lo hi] of mark `mark-id` of annotation `gid` — the true - min piece-start / max piece-end, WITHOUT merge-bars' floor/ceil. Endpoint - editing must use this (not a rounded lane bar) or the fixed end drifts a frame - per re-roll. `ctx-segs` = content-segments of ctx." + min piece-start / max piece-end, without merge-bars. Endpoint editing must use + this exact lane extent or the fixed end drifts a frame per edit. `ctx-segs` = + content-segments of ctx." [scene gid mark-id ctx-segs] (let [pcs (->> (resolve scene gid) (filter #(= mark-id (:mark %))) @@ -402,10 +434,10 @@ (defn selection->marks "Split local range [la lb) of context `ctx` into a run of single-clip ref marks, one per content segment it crosses (the 'no cross-clip marks' rule). - Each references the segment's source id with the right offsets. Offsets are - ROUNDED to whole frames here — this is where user frame-accuracy is applied - (clips stay exact for tiling; the mark snaps to a whole frame of its clip)." + Each references the segment's source id with the right offsets. Inputs and + derived offsets must already be integer frames." [scene ctx la lb] + (assert-range "selection" [la lb]) (mapv (fn [{:keys [mark src]}] ;; :at is the target's OWN local frame (src->at), matching resolve-mark's ;; slice — correct even when the target is a scattered multi-clip proxy. @@ -413,8 +445,8 @@ (let [[a b] src a' (src->at scene mark a)] {:id (str (random-uuid)) ; string so it survives JSON - :start {:ref mark :at (js/Math.round a')} - :end {:ref mark :at (js/Math.round (+ a' (- b a)))}})) + :start {:ref mark :at (assert-frame "selection start offset" a')} + :end {:ref mark :at (assert-frame "selection end offset" (+ a' (- b a)))}})) (slice (content-segments scene ctx) la lb))) (defn reconcile-run @@ -542,7 +574,7 @@ shared basis for both the annotation editor rows and the jump popover, so they can never disagree on how a point reads." [scene {:keys [ref at]}] - {:seg ref :f (js/Math.round (at->local scene ref at))}) + {:seg ref :f (assert-frame "display point" (at->local scene ref at))}) (defn- clip-row "Editor row {:s … :e …} for a single-clip/subclip ref mark, in mark time." @@ -580,22 +612,23 @@ clip mark-group per clip (source range + track), and the root timeline. The otio is only a seed — nothing here reads it again. - Clip ranges are kept EXACT (OTIO's fractional RationalTime), NOT rounded: - adjacent clips must share their half-open boundary exactly to tile without a - gap, and independently rounding :start vs length breaks that. Frame-accuracy is - applied where it belongs — at the mark the user creates (selection->marks - rounds :at) — and at display, never by rounding clips or bars." + Clip ranges are integer frame ranges. Fractional OTIO input is rejected before + this point; from here on, frame math asserts instead of snapping." [{:keys [duration tracks]}] + (assert-frame "OTIO duration" duration) (let [vtracks (filter #(= :video (:kind %)) tracks) track-map (into {} (map (fn [t] [(keyword (str "t" (:index t))) {:name (:name t)}])) vtracks) clips (into {} (for [t vtracks c (:clips t)] - [(keyword (:id c)) - {:type :clip :parent nil :name (:name c) - :start (:start c) ; timeline position (frames) - :marks [{:id (keyword (str (:id c) "-m")) - :start (:media-in c) - :end (+ (:media-in c) (:duration c)) - :track (keyword (str "t" (:index t)))}]}]))] + (let [start (assert-frame "clip timeline start" (:start c)) + media-in (assert-frame "clip media-in" (:media-in c)) + duration (assert-frame "clip duration" (:duration c))] + [(keyword (:id c)) + {:type :clip :parent nil :name (:name c) + :start start ; timeline position (frames) + :marks [{:id (keyword (str (:id c) "-m")) + :start media-in + :end (+ media-in duration) + :track (keyword (str "t" (:index t)))}]}])))] {:tracks track-map :groups (assoc clips :root {:type :timeline :parent nil :marks [{:id :root-m :start 0 :end duration}]})})) @@ -684,7 +717,7 @@ (last csegs))] {:local lo :seg (:mark seg) - :f (js/Math.round (- lo (first (:local seg [0 0]))))})) + :f (assert-frame "jump target frame" (- lo (first (:local seg [0 0]))))})) (runs scene ctx gid)))) (defn linkables diff --git a/tl/src/tl/subs.cljs b/tl/src/tl/subs.cljs index 56bb6f1..342dfdb 100644 --- a/tl/src/tl/subs.cljs +++ b/tl/src/tl/subs.cljs @@ -183,7 +183,7 @@ :hidden (boolean hidden) :tags (vec (get-in g [:meta :tags])) ;; jump targets labelled from the marks' clip refs (same as - ;; the editor) — not re-derived from a floored bar frame + ;; the editor) — not re-derived from a display bar frame :jumps jumps :start (or (ffirst bars) 0) :bars bars})))))) (sort-by (juxt :broken :start)) ; broken annotations sink to the bottom diff --git a/tl/src/tl/views.cljs b/tl/src/tl/views.cljs index 5e28053..8daf1f8 100644 --- a/tl/src/tl/views.cljs +++ b/tl/src/tl/views.cljs @@ -38,6 +38,14 @@ (defn- px [local fps zoom] (* (/ local fps) zoom)) +(defn- frame-index + "Convert a continuous UI/video coordinate to the integer frame index it is over. + After this edge conversion, frame values are asserted, not snapped." + [label n] + (when-not (and (number? n) (not (js/isNaN n))) + (throw (js/Error. (str label " must be numeric, got " (pr-str n))))) + (scene/assert-frame label (int n))) + (defn- clip-thumbnail-layer [thumbs fps zoom row-h {:keys [mark thumb thumb-start local]}] (when-let [tiles (seq (get-in thumbs [:clips (or thumb mark)]))] (let [[c d] local @@ -125,7 +133,7 @@ (defn- play-tick [] (when-let [{:keys [ctx segs fps idx]} @play] (let [v @video-el - sf (* (.-currentTime v) fps) + sf (frame-index "video source frame" (* (.-currentTime v) fps)) {:keys [pending-ns]} @play {[ss se] :src [ls _] :local} (nth segs idx)] (cond @@ -206,7 +214,8 @@ clip under the landing frame into view vertically — jumps always do both." ([local] (goto! local false)) ([local follow?] - (let [ctx @(rf/subscribe [::subs/context]) + (let [local (scene/assert-frame "goto frame" local) + ctx @(rf/subscribe [::subs/context]) segs @(rf/subscribe [::subs/segments]) fps @(rf/subscribe [::subs/fps]) zoom @(rf/subscribe [::subs/zoom])] @@ -399,10 +408,10 @@ linking @(rf/subscribe [::subs/linking]) auth? (some? @(rf/subscribe [::subs/draft-group])) seg (some (fn [{[c d] :local :as s}] (when (and (<= c ph) (< ph d)) s)) segs) - cf (when seg (js/Math.round (- ph (first (:local seg))))) + cf (when seg (scene/assert-frame "clip frame" (- ph (first (:local seg))))) click? (and auth? seg)] [:div.frame-readout - [:span.fr-abs (str (js/Math.round ph) "f")] + [:span.fr-abs (str (scene/assert-frame "playhead" ph) "f")] (when seg [:span.fr-clip {:class (when click? "clickable") :title (when click? (if linking "Click to link this frame" @@ -449,7 +458,7 @@ (.preventDefault ev) (let [to (fn [clientX] (let [x (- clientX (.-left (.getBoundingClientRect content)))] - (goto! (max 0 (* (/ x zoom) fps))))) + (goto! (frame-index "scrub frame" (max 0 (* (/ x zoom) fps)))))) move (fn [e] (to (.-clientX e))) up (fn up [_] (.removeEventListener js/document "mousemove" move) (.removeEventListener js/document "mouseup" up))] @@ -471,12 +480,11 @@ (let [d (d-of e)] (when (or @moved? (> (js/Math.abs d) 3)) (reset! moved? true) - ;; round ONLY the dragged endpoint; the fixed endpoint stays - ;; exact so selection->marks re-derives its mark identically. (let [[la lb] (case mode - :move [(js/Math.round (+ lo d)) (js/Math.round (+ hi d))] - :start [(js/Math.round (+ lo d)) hi] - :end [lo (js/Math.round (+ hi d))])] + :move [(frame-index "drag start frame" (+ lo d)) + (frame-index "drag end frame" (+ hi d))] + :start [(frame-index "drag start frame" (+ lo d)) hi] + :end [lo (frame-index "drag end frame" (+ hi d))])] (rf/dispatch [::events/reroll-proxy ann mark-id la lb]))))) up (fn up [_] (.removeEventListener js/document "mousemove" move) @@ -500,7 +508,7 @@ (.preventDefault ev) (let [rect (.getBoundingClientRect content) sx (.-clientX ev) - to (fn [cx] (max 0 (* (/ (- cx (.-left rect)) zoom) fps))) + to (fn [cx] (frame-index "selection frame" (max 0 (* (/ (- cx (.-left rect)) zoom) fps)))) a (to sx) moved? (atom false) mv (fn [e] @@ -513,7 +521,7 @@ (let [was @moved? b (to (.-clientX e)) lo (min a b) hi (max a b)] (reset! region-sel nil) (if (and was (> (- hi lo) 0.5)) - (rf/dispatch [::events/draft-select-range (js/Math.round lo) (js/Math.round hi)]) + (rf/dispatch [::events/draft-select-range lo hi]) (on-click a))))] ; click (no drag) (.addEventListener js/document "mousemove" mv) (.addEventListener js/document "mouseup" up))) @@ -693,9 +701,8 @@ ;; visual pieces the mark has, it gets one handle pair, at its ends. (for [a visible :when (:draft a) mid (distinct (map #(nth % 2) (:bars a))) - ;; EXACT context-local extent (never the rounded bar). The drag - ;; keeps the FIXED endpoint at this exact value so its mark - ;; re-derives identically — that's what stops the other end drifting. + ;; Exact context-local extent. The drag keeps the fixed endpoint + ;; at this value so its mark re-derives identically. :let [ext (scene/mark-extent scene (:id a) mid segs)] :when ext :let [[lo hi] ext @@ -833,7 +840,7 @@ :title (when-not lf "linked clip no longer in this timeline") :on-click #(goto-link! lf)} (when-not lf "△ ") label - (when lf [:span.link-f (str " " (js/Math.round lf) "f")])]))))) + (when lf [:span.link-f (str " " (scene/assert-frame "link frame" lf) "f")])]))))) (defn- build-chip [{:keys [label ref at kind]}] (let [span (js/document.createElement "span") @@ -865,7 +872,7 @@ (when lf (let [f (js/document.createElement "span")] (set! (.-className f) "link-f") - (set! (.-textContent f) (str " " (js/Math.round lf) "f")) + (set! (.-textContent f) (str " " (scene/assert-frame "link frame" lf) "f")) (.appendChild span f))) span)) @@ -953,7 +960,7 @@ :point {:kind :script-note :ref id}}))))))))) (defn- point-label [cand off local] - (str (:label cand) " @" (js/Math.round local) "f" + (str (:label cand) " @" (scene/assert-frame "point label frame" local) "f" (when (and (not (:abs cand)) (pos? off)) (str " +" off)))) @@ -1066,18 +1073,18 @@ [:span.cand-label (:label c)] (when (:group c) [:span.cand-group (str " " (:group c))]) (when-not (contains? #{:timeline :script-note} (:kind c)) - [:span.link-f (str " " (js/Math.round (:local c)) "f")])])))]))) + [:span.link-f (str " " (scene/assert-frame "candidate frame" (:local c)) "f")])])))]))) (defn- local->draft-point [segs local] (some (fn [{m :mark [c d] :local}] (when (and (<= c local) (< local d)) - {:seg m :f (js/Math.round (- local c))})) + {:seg m :f (scene/assert-frame "draft point frame" (- local c))})) segs)) (defn- local->draft-end-point [segs local] (some (fn [{m :mark [c d] :local}] (when (and (<= c local) (<= local d)) - {:seg m :f (js/Math.round (- local c))})) + {:seg m :f (scene/assert-frame "draft endpoint frame" (- local c))})) segs)) ;; --- shared string autocomplete ------------------------------------------ @@ -1369,7 +1376,7 @@ (let [len (pt-len scene segs seg)] [:div.pt-chip.pending [:span.pt-chip-name (pt-name scene segs seg)] - [:input.pt-frame {:type "number" :value (js/Math.round f) :disabled true}] + [:input.pt-frame {:type "number" :value (scene/assert-frame "pending frame" f) :disabled true}] [:span.pt-dur (str "/" len)]])) (defn- empty-frame-chip [label] @@ -1741,7 +1748,7 @@ len @(rf/subscribe [::subs/length]) authed? @(rf/subscribe [::subs/authed?]) authoring? (some? @(rf/subscribe [::subs/draft-group])) - ph-now #(js/Math.round @(rf/subscribe [::subs/playhead]))] + ph-now #(scene/assert-frame "playhead" @(rf/subscribe [::subs/playhead]))] [:div.toolbar [:div.transport [:button.step-btn {:title "Previous frame" :disabled start? @@ -2083,7 +2090,7 @@ (when (and url (seq @pages)) [:div.script-controls [:button {:title "Zoom out" :on-click #(bump (fn [z] (* z 0.9)))} "−"] - [:span.zoom-read (str (js/Math.round (* scale 100)) "%")] + [:span.zoom-read (str (int (* scale 100)) "%")] [:button {:title "Zoom in" :on-click #(bump (fn [z] (* z 1.1)))} "+"] [:button {:title "Fit width" :on-click fit!} "Fit"]])])))) @@ -2271,7 +2278,7 @@ (when uploading? [:div.upload-progress [:div.upload-track [:div.upload-fill {:style {:width (str (* 100 prog) "%")}}]] - [:span.upload-pct (str (js/Math.round (* 100 prog)) "%")]]) + [:span.upload-pct (str (int (* 100 prog)) "%")]]) [:div.form-actions [:button.save {:disabled (or uploading? (str/blank? @pname) (not @otio) (not @clip)) :on-click #(rf/dispatch [::events/create-project @pname @otio @clip])} diff --git a/tl/test/tl/flow_test.cljs b/tl/test/tl/flow_test.cljs index f0da29a..079f461 100644 --- a/tl/test/tl/flow_test.cljs +++ b/tl/test/tl/flow_test.cljs @@ -127,3 +127,35 @@ (let [bars (bars-in :annB :annC)] (is (some #(= bid (nth % 2)) bars) "after the drag the B-mark still resolves in annB (no vanish)") (is (= [50 140] (some (fn [[lo hi m]] (when (= m bid) [lo hi])) bars)) "handle moved end to 140")))))) + +(deftest draft-range-events-keep-integer-frames + (testing "basic drag selection through the real event path stores only integer frames" + (setup! clips-scene [:root]) + (rf/dispatch-sync [::ev/open-draft]) + (rf/dispatch-sync [::ev/draft-select-range 25 175]) + (let [[gid g] (some (fn [[gid g]] (when (:draft g) [gid g])) (:groups (scene*))) + mark (first (:marks g)) + pid (get-in mark [:start :ref]) + proxy (get-in (scene*) [:groups pid]) + ats (mapcat (fn [m] [(get-in m [:start :at]) (get-in m [:end :at])]) (:marks proxy))] + (is gid "draft exists") + (is (= :proxy (:type proxy))) + (is (every? integer? ats)) + (is (= [[25 175 (:id mark)]] (bars-in :root gid))))) + (testing "fractional drag selection fails instead of being changed into nearby frames" + (setup! clips-scene [:root]) + (rf/dispatch-sync [::ev/open-draft]) + (is (thrown-with-msg? js/Error #"integer frame" + (rf/dispatch-sync [::ev/draft-select-range 25.5 175]))))) + +(deftest reroll-proxy-rejects-fractional-frames + (testing "live proxy reroll accepts integer handle positions and rejects fractional ones" + (setup! clips-scene [:root]) + (rf/dispatch-sync [::ev/open-draft]) + (rf/dispatch-sync [::ev/draft-select-range 25 175]) + (let [[gid g] (some (fn [[gid g]] (when (:draft g) [gid g])) (:groups (scene*))) + mark-id (:id (first (:marks g)))] + (rf/dispatch-sync [::ev/reroll-proxy gid mark-id 30 170]) + (is (= [[30 170 mark-id]] (bars-in :root gid))) + (is (thrown-with-msg? js/Error #"integer frame" + (rf/dispatch-sync [::ev/reroll-proxy gid mark-id 30.25 170])))))) diff --git a/tl/test/tl/frame_policy_test.cljs b/tl/test/tl/frame_policy_test.cljs new file mode 100644 index 0000000..3c6a7f0 --- /dev/null +++ b/tl/test/tl/frame_policy_test.cljs @@ -0,0 +1,27 @@ +(ns tl.frame-policy-test + (:require [cljs.test :refer-macros [deftest is testing]] + [clojure.string :as str])) + +(def fs (js/require "fs")) +(def path (js/require "path")) + +(defn- cljs-files [dir] + (mapcat (fn [name] + (let [p (.join path dir name) + st (.statSync fs p)] + (cond + (.isDirectory st) (cljs-files p) + (str/ends-with? name ".cljs") [p] + :else []))) + (array-seq (.readdirSync fs dir)))) + +(deftest no-math-round-in-frame-code + (testing "frame code must not use the JS rounding API" + (let [needle (str "Math" "." "round") + hits (->> (concat (cljs-files "src") (cljs-files "test")) + (remove #(str/ends-with? % "frame_policy_test.cljs")) + (keep (fn [p] + (when (str/includes? (.readFileSync fs p "utf8") needle) + p))) + vec)] + (is (= [] hits))))) diff --git a/tl/test/tl/routes_test.cljs b/tl/test/tl/routes_test.cljs new file mode 100644 index 0000000..fd0c111 --- /dev/null +++ b/tl/test/tl/routes_test.cljs @@ -0,0 +1,15 @@ +(ns tl.routes-test + (:require [cljs.test :refer-macros [deftest is testing]] + [tl.routes :as routes])) + +(deftest view-state-parses-integer-frame-query + (testing "route playhead accepts string and numeric integer query params" + (set! (.. js/window -location -hash) "") + (is (= {:playhead 42} + (routes/view-state {:query-params {"f" "42"}}))) + (is (= {:playhead 42} + (routes/view-state {:query-params {"f" 42}})))) + (testing "fractional route playhead is ignored instead of changed" + (set! (.. js/window -location -hash) "") + (is (= {} + (routes/view-state {:query-params {"f" "42.5"}}))))) diff --git a/tl/test/tl/scene_test.cljs b/tl/test/tl/scene_test.cljs index aa8616c..aca12f9 100644 --- a/tl/test/tl/scene_test.cljs +++ b/tl/test/tl/scene_test.cljs @@ -1,6 +1,7 @@ (ns tl.scene-test (:require [cljs.test :refer-macros [deftest is testing]] [tl.md :as md] + [tl.otio :as otio] [tl.scene :as s])) ;; --- shared fixture ------------------------------------------------------- @@ -16,6 +17,8 @@ (defn with-group [scene gid g] (assoc-in scene [:groups gid] g)) (defn refm [id clip a b] {:id id :start {:ref clip :at a} :end {:ref clip :at b}}) +(defn err-msg [f] + (try (f) nil (catch js/Error e (.-message e)))) ;; X = inter-x: B[50,100), A[0,50), B[0,50), A[50,100) — four 50-frame subclips. (def inter-x @@ -408,26 +411,55 @@ (is (= #{:t0 :t1} (s/tracks segs))) (is (= 200 (s/length segs))))))) -(deftest from-otio-keeps-clip-ranges-exact - (testing "clips keep OTIO's exact fractional ranges (so adjacent clips tile); - frame-accuracy is applied at mark creation, not here" - (let [parsed {:fps 24 :duration 199.6 - :tracks [{:index 0 :kind :video :name "W" - :clips [{:id "t0-c0" :name "a" :start 0.2 :media-in 188.87 :duration 100.4}]}]} - mark (first (get-in (s/from-otio parsed) [:groups :t0-c0 :marks]))] - (is (= 188.87 (:start mark))) ; exact, not rounded - (is (= 289.27 (:end mark)))))) +(deftest otio-normalizes-source-starts-and-rejects-fractional-durations + (testing "fractional OTIO source starts are normalized at import" + (let [clip {:OTIO_SCHEMA "Clip.2" + :name "a" + :source_range {:start_time {:value 10.5 :rate 24} + :duration {:value 5 :rate 24}}} + otio {:global_start_time {:rate 24} + :tracks {:children [{:name "V" :kind "Video" :children [clip]}]}} + parsed (otio/parse otio)] + (is (= 10 (:media-offset parsed))) + (is (= 0 (get-in parsed [:tracks 0 :clips 0 :media-in]))) + (is (integer? (get-in parsed [:tracks 0 :clips 0 :media-in]))))) + (testing "fractional OTIO durations still fail because timeline math is integer" + (let [clip {:OTIO_SCHEMA "Clip.2" + :name "a" + :source_range {:start_time {:value 10 :rate 24} + :duration {:value 5.5 :rate 24}}} + otio {:global_start_time {:rate 24} + :tracks {:children [{:name "V" :kind "Video" :children [clip]}]}} + msg (err-msg #(otio/parse otio))] + (is (re-find #"integer frame" msg)))) + (testing "from-otio also asserts parsed frame fields are integers" + (let [clip {:id "t0-c0" :name "a" :start 0.2 :media-in 188.87 :duration 100.4} + parsed {:fps 24 :duration 199.6 + :tracks [{:index 0 :kind :video :name "W" :clips [clip]}]} + msg (err-msg #(s/from-otio parsed))] + (is (re-find #"integer frame" msg))))) -(deftest selection-rounds-at-to-whole-frames - (testing "a selection over a clip with fractional layout still yields whole-frame - :at offsets (clip stays exact, the mark snaps)" +(deftest real-otio-source-starts-import-as-integer-media-frames + (testing "the bundled Challengers OTIO has fractional source starts but imports into integer model frames" + (let [raw (js->clj (js/JSON.parse (.readFileSync (js/require "fs") "resources/public/one_two_three.otio" "utf8")) + :keywordize-keys true) + parsed (otio/parse raw) + scene (s/from-otio parsed) + media-ins (for [t (:tracks parsed) c (:clips t)] (:media-in c))] + (is (seq media-ins)) + (is (every? integer? media-ins)) + (is (every? integer? (mapcat (fn [[_ g]] + (mapcat (juxt :start :end) (:marks g))) + (:groups scene))))))) + +(deftest selection-rejects-fractional-frames + (testing "a selection over fractional clip layout fails instead of changing frames" (let [scene {:tracks {:t0 {:name "W"}} :groups {:root {:type :timeline :parent nil :marks [{:id :m/r :start 0 :end 100}]} :fr {:type :clip :parent nil :start 0.3 ; fractional timeline pos :marks [{:id :m/fr :start 10.4 :end 110.4 :track :t0}]}}} - run (s/selection->marks scene :root 20 60)] - (is (seq run)) - (is (every? integer? (mapcat (juxt #(get-in % [:start :at]) #(get-in % [:end :at])) run)))))) + msg (err-msg #(s/selection->marks scene :root 20 60))] + (is (re-find #"integer frame" msg))))) ;; ========================================================================= ;; Suite 4 — draft rows <-> marks (the two-input editor) @@ -460,13 +492,13 @@ (is (= 0 (get-in (first marks) [:start :at]))) (is (= 30 (get-in (first marks) [:end :at]))))))) -(deftest merge-bars-coalesces-continuous-run - (testing "sub-frame OTIO gaps collapse to one bar; a real gap stays split" - ;; foobar's real bars (continuous 5-clip selection, ~0.9-frame source gaps) +(deftest merge-bars-coalesces-continuous-integer-runs + (testing "integer-adjacent bars merge; fractional bars fail" (is (= [[128 542]] - (s/merge-bars [[128.87 190.87] [191.80 265.80] [266.73 384.73] - [385.61 413.61] [414.58 541.58]]))) + (s/merge-bars [[128 191] [191 266] [266 386] + [386 414] [414 542]]))) (is (= [[0 50] [200 260]] (s/merge-bars [[0 50] [200 260]]))) ; real gap → two + (is (re-find #"integer frame" (err-msg #(s/merge-bars [[0.2 50]])))) (is (= [] (s/merge-bars []))))) (deftest restore-annotations-rekeywordizes-json