Прилипание сильнее кадровой сетки: наезда в семь миллисекунд больше нет

Клип прилипал к концу соседа, а потом округлялся к ближайшему кадру — и
уезжал с той самой границы, к которой только что прилип. Границы клипов
в монтаже лежат не на сетке: они приходят из исходников. Влево это наезд
в семь миллисекунд: ноль пикселей на экране, а в модели заказ на переход.
Человек ищет, откуда взялся кроссфейд там, где ничего не накладывается.

Замерено: дыра, раздвинутая ровно под клип, давала после перетаскивания
наезд 0.007383 с слева и дыру такого же размера справа.

Теперь решение одно и принимается один раз: прилипло — ставим ровно
туда, не прилипло — на ближайший кадр (PlaceTime). Тем же путём идут и
оба растягивания за край.

Схлопывание больше не округляет каждого соседа по отдельности: все едут
на точную величину сдвига, и расстояния между ними остаются как были.
Иначе связка разъезжалась — картинка садилась на границу, а её звук
уезжал на полкадра.

Сообщение о наезде меряет той же мерой, что и сборка: кусок короче
половины кадра она пропускает, и пугать переходом из него незачем.

Проверка tests/dropgap.sh, на прежней сборке падает.

src/uMainForm.pas

@@ -3835,7 +3835,7 @@ var
   T, C, Count: Integer;
   Track: TTrack;
   A, B: TClip;
-  Over, Worst: Double;
+  Over, Worst, HalfFrame: Double;
   Where, First, What: string;
   WorstKind: TTrackKind;
 
@@ -3865,6 +3865,10 @@ begin
   First := '';
   Where := '';
   WorstKind := tkVideo;
+  if (FProject.Master.FpsNum > 0) and (FProject.Master.FpsDen > 0) then
+    HalfFrame := 0.5 * FProject.Master.FpsDen / FProject.Master.FpsNum
+  else
+    HalfFrame := 0.0005;
   for T := 0 to FProject.TrackCount - 1 do
   begin
     Track := FProject.Tracks[T];
@@ -3872,10 +3876,12 @@ begin
     begin
       A := Track[C];
       B := Track[C + 1];
-      { Полкадра — не наезд, а округление: кадровая сетка не бьётся
+      { Мера та же, какой меряет сборка (`uFlatten`): кусок короче
-        нацело, и доли кадра набегают сами. }
+        половины кадра она пропускает, значит и перехода из него не
+        будет. Говорить о наезде, которого никто не станет собирать,
+        значит пугать зря. }
       Over := A.TlEnd - B.TlStart;
-      if Over <= 0.001 then
+      if Over <= HalfFrame then
         Continue;
       Inc(Count);
       if Over > Worst then

src/uTimelineCtrl.pas

@@ -375,8 +375,15 @@ type
 
       AExclude — клип, который сейчас двигают: сам к себе он не липнет.
       ALength — его длина. Задана — кандидатами становятся и положения,
-      при которых на границу садится хвост клипа, а не голова. }
+      при которых на границу садится хвост клипа, а не голова.
+      ASnapped — притянулось ли вообще, или время осталось своим. }
     function SnapTime(const ATime: Double; AExclude: TClip;
+      const ALength: Double; out ASnapped: Boolean): Double; overload;
+    function SnapTime(const ATime: Double; AExclude: TClip;
+      const ALength: Double = 0): Double; overload;
+    { Куда встанет край, отпущенный в этом месте: прилипание, а если не
+      прилипло — ближайший кадр. }
+    function PlaceTime(const ATime: Double; AExclude: TClip;
       const ALength: Double = 0): Double;
     procedure DeleteSelected;
     { Связать выделенные клипы или развязать, если они уже связаны.
@@ -1980,6 +1987,37 @@ end;
 
 function TTimelineControl.SnapTime(const ATime: Double; AExclude: TClip;
   const ALength: Double): Double;
+var
+  Snapped: Boolean;
+begin
+  Result := SnapTime(ATime, AExclude, ALength, Snapped);
+end;
+
+{ Прилипание сильнее кадровой сетки.
+
+  Границы клипов в монтаже лежат где угодно: они приходят из исходников,
+  а не из сетки проекта. Округлить прилипшее время к ближайшему кадру
+  значит сдвинуть клип с той самой границы, к которой он только что
+  прилип, — до полукадра в любую сторону. Влево это наезд: на экране ноль
+  пикселей, а в модели заказ на переход, и человек ищет, откуда взялся
+  кроссфейд там, где ничего не накладывается.
+
+  Замерено: дыра, раздвинутая ровно под клип, давала после перетаскивания
+  наезд в 0.007383 с и дыру такого же размера с другой стороны.
+
+  Не прилипло — садимся на сетку: между кадрами времени нет. }
+function TTimelineControl.PlaceTime(const ATime: Double; AExclude: TClip;
+  const ALength: Double): Double;
+var
+  Snapped: Boolean;
+begin
+  Result := SnapTime(ATime, AExclude, ALength, Snapped);
+  if not Snapped then
+    Result := QuantizeTime(Result);
+end;
+
+function TTimelineControl.SnapTime(const ATime: Double; AExclude: TClip;
+  const ALength: Double; out ASnapped: Boolean): Double;
 var
   T, C: Integer;
   Track: TTrack;
@@ -2011,6 +2049,7 @@ var
 
 begin
   Result := ATime;
+  ASnapped := False;
   if FProject = nil then
     Exit;
   { Shift меняет решение на противоположное: при включённом прилипании
@@ -2044,6 +2083,7 @@ begin
     end;
   end;
 
+  ASnapped := Best <> ATime;
   Result := Best;
 end;
 
@@ -2543,7 +2583,7 @@ begin
     taTrimIn:
       if FDragClip <> nil then
       begin
-        NewStart := QuantizeTime(SnapTime(XToTime(X), FDragClip));
+        NewStart := PlaceTime(XToTime(X), FDragClip);
         { Правый край стоит на месте, двигается левый: меняются и позиция
           на монтаже, и то, с какого места берётся материал. }
         Delta := NewStart - FDragOrigStart;
@@ -2568,7 +2608,7 @@ begin
     taTrimOut:
       if FDragClip <> nil then
       begin
-        NewEnd := QuantizeTime(SnapTime(XToTime(X), FDragClip));
+        NewEnd := PlaceTime(XToTime(X), FDragClip);
         Delta := NewEnd - (FDragOrigStart + FDragOrigDuration);
 
         MediaLen := MediaDurationOf(FDragClip);
@@ -2712,13 +2752,20 @@ begin
   Result := False;
 end;
 
+{ Соседи едут ровно на ту же величину, что и сам клип.
+
+  Округлять каждого к сетке по отдельности нельзя: их границы лежат не на
+  кадрах (они пришли из исходников), и округление растаскивает встык
+  стоявшие клипы на полкадра в разные стороны. Сдвиг на точную величину
+  сохраняет все расстояния между ними как были: встык остаётся встыком,
+  дыра — дырой. Куда встанет сам перетаскиваемый клип, решено до этого,
+  и решено один раз. }
 procedure TTimelineControl.ApplyRipple(const ADelta: Double);
 var
   I: Integer;
 begin
   for I := 0 to High(FRippleClips) do
-    FRippleClips[I].TlStart :=
+    FRippleClips[I].TlStart := Max(0, FRippleOrigStarts[I] + ADelta);
-      Max(0, QuantizeTime(FRippleOrigStarts[I] + ADelta));
 end;
 
 procedure TTimelineControl.DragClipTo(const AX, AY: Integer);
@@ -2733,8 +2780,8 @@ begin
   Idx := TrackIndexAt(Y);
   if FDragClip <> nil then
   begin
-    NewStart := QuantizeTime(SnapTime(XToTime(X) - FDragGrabOffset,
+    NewStart := PlaceTime(XToTime(X) - FDragGrabOffset,
-      FDragClip, FDragClip.Duration));
+      FDragClip, FDragClip.Duration);
     FDragClip.TlStart := Max(0, NewStart);
     { Связка едет целиком: звук должен остаться под своей картинкой. }
     ApplyGroupMove(FDragClip.TlStart - FDragOrigStart);

tests/dropgap.sh

@@ -0,0 +1,133 @@
+#!/bin/sh
+# Клип, брошенный в дыру ровно по своему размеру, встаёт в неё без
+# наезда.
+#
+# Границы клипов в монтаже лежат не на кадровой сетке: они приходят из
+# исходников. Клип прилипал к концу соседа, а потом округлялся к
+# ближайшему кадру — и уезжал с этой границы на полкадра. Влево это
+# наезд в семь миллисекунд: на экране ноль пикселей, а в модели заказ на
+# переход, и человек ищет, откуда взялся кроссфейд там, где ничего не
+# накладывается.
+#
+# Монтаж строится числами: клип A с концом не на сетке, дыра ровно по
+# длине клипа D, сам D в конце. D тащится в дыру. Результат читается из
+# сохранённого проекта.
+#
+# Запуск (экран :99 поднят):
+#   tests/dropgap.sh [<путь к nlve>]
+set -e
+cd "$(dirname "$0")/.."
+BIN=${1:-$PWD/nlve}
+DISP=${NLVE_DISPLAY:-:99}
+SRC=$PWD/test/поток/пара.nlve
+PROJ=$PWD/test/поток/дыра-ровно.nlve
+
+[ -f "$SRC" ] || { echo "нет монтажа $SRC"; exit 2; }
+
+export DISPLAY=$DISP
+reachable() { timeout 5 xdotool getdisplaygeometry >/dev/null 2>&1; }
+if ! reachable; then
+  for p in $(pgrep -x Xvfb); do
+    A=$(tr '\0' '\n' < /proc/$p/cmdline | grep -A1 -x -- -auth | tail -1)
+    [ -f "$A" ] || continue
+    XAUTHORITY=$A; export XAUTHORITY
+    reachable && break
+  done
+fi
+reachable ||
+  { echo "нет доступа к экрану $DISP: подними его (xvfb-run) и повтори"; exit 2; }
+
+python3 - "$SRC" "$PROJ" <<'PY'
+import json, sys, copy
+d = json.load(open(sys.argv[1]))
+V = next(t for t in d['tracks'] if t['name'] == 'V1')
+A = next(t for t in d['tracks'] if t['name'] == 'A1')
+ов, оа = copy.deepcopy(V['clips'][0]), copy.deepcopy(A['clips'][0])
+
+def клип(обр, ид, группа, старт, длина, вход):
+    c = copy.deepcopy(обр)
+    c.update(id=ид, group=группа, tl_start=старт, duration=длина,
+             src_in=вход, fade_in=0.0, fade_out=0.0)
+    return c
+
+шаг = 1001/60000
+D = round(3.5/шаг)*шаг      # длина клипа — ровно по кадрам
+конецA = 10.000700          # а граница соседа — нарочно между кадрами
+V['clips'] = [клип(ов, 'a_v', 'ga', 0.0, конецA, 100.0),
+              клип(ов, 'b_v', 'gb', конецA + D, 10.0001, 200.0),
+              клип(ов, 'd_v', 'gd', 30.0, D, 300.0)]
+A['clips'] = [клип(оа, 'a_a', 'ga', 0.0, конецA, 100.0),
+              клип(оа, 'b_a', 'gb', конецA + D, 10.0001, 200.0),
+              клип(оа, 'd_a', 'gd', 30.0, D, 300.0)]
+json.dump(d, open(sys.argv[2], 'w'), ensure_ascii=False)
+print('   дыра %.6f..%.6f, клип длиной %.6f с — ровно по размеру'
+      % (конецA, конецA + D, D))
+PY
+
+for p in $(pgrep -x nlve); do
+  tr '\0' '\n' < /proc/$p/environ 2>/dev/null | grep -qx "DISPLAY=$DISP" && kill $p
+done
+sleep 1
+SP=$PWD/test/поток/профиль-дыра-ровно
+rm -rf "$SP"; mkdir -p "$SP"
+rm -f "$PROJ.autosave"
+XDG_CONFIG_HOME=$SP XDG_CACHE_HOME=$SP XDG_DATA_HOME=$SP \
+  setsid "$BIN" "$PROJ" >/dev/null 2>&1 < /dev/null &
+sleep 14
+
+X="timeout 8 xdotool"
+WID=
+for w in $($X search --name "дыра-ровно.nlve" 2>/dev/null); do
+  xwininfo -id "$w" 2>/dev/null | grep -q IsViewable && { WID=$w; break; }
+done
+[ -n "$WID" ] || { echo "живое окно редактора не найдено"; exit 2; }
+$X windowmove "$WID" 0 0 windowsize "$WID" 1270 990
+sleep 2
+
+ROW=${NLVE_ROW:-505}
+# Два щелчка колесом от себя: в окно должен попасть и конец монтажа, где
+# лежит перетаскиваемый клип, и дыра.
+$X mousemove 700 $ROW
+$X keydown ctrl click 5 keyup ctrl; sleep 0.4
+$X keydown ctrl click 5 keyup ctrl; sleep 1
+
+# Тащим клип с конца к левому краю дыры. Целимся грубо: доводить должно
+# прилипание, в том и смысл.
+$X mousemove 1200 $ROW mousedown 1; sleep 0.4
+$X mousemove 1000 $ROW; sleep 0.3
+$X mousemove 850 $ROW; sleep 0.3
+$X mousemove 815 $ROW; sleep 0.5
+$X mouseup 1; sleep 1.5
+
+$X key ctrl+s; sleep 2
+for p in $(pgrep -x nlve); do
+  tr '\0' '\n' < /proc/$p/environ 2>/dev/null | grep -qx "DISPLAY=$DISP" && kill $p
+done
+rm -f "$PROJ.autosave"
+
+python3 - "$PROJ" <<'PY'
+import json, sys
+d = json.load(open(sys.argv[1]))
+плохо = 0
+for t in d['tracks']:
+    кл = sorted(t['clips'], key=lambda c: c['tl_start'])
+    if len(кл) < 3:
+        continue
+    for a, b in zip(кл, кл[1:]):
+        зазор = b['tl_start'] - (a['tl_start'] + a['duration'])
+        # Спрос строгий, до микросекунд: прилипание на то и прилипание,
+        # чтобы край сел ровно на край. Промах в семь миллисекунд меньше
+        # половины кадра и в ролике ничего не меняет, но монтаж от этого
+        # перестаёт быть встык: наезд рисуется, пишется в строку
+        # состояния и пугает переходом, которого не просили.
+        if abs(зазор) > 1e-6:
+            print('   ПЛОХО: на %s между %s и %s %s %.6f с'
+                  % (t['name'], a['id'], b['id'],
+                     'наезд' if зазор < 0 else 'дыра', abs(зазор)))
+            плохо = 1
+    print('   %s: %s' % (t['name'],
+          ' '.join('%s %.6f' % (c['id'], c['tl_start']) for c in кл)))
+if плохо:
+    raise SystemExit(1)
+print('   ok: клип сел в дыру вплотную, ни наезда, ни остатка')
+PY