Схлопывание при удалении, разбор внутренних ошибок, дорожки по номерам

Схлопывание при удалении. При включённом автосхлопывании удаление куска
сдвигает всё, что правее, влево до первого касания — дыра не остаётся, и
сборке не приходится заполнять её чернотой.

Сдвиг считается по всем дорожкам сразу, а не по каждой отдельно: иначе
развалилось бы выверенное соответствие картинки и звука. Насколько можно
сдвинуть, решает та дорожка, где запас меньше всего. Дыра не обязана быть
пустой везде: клип, который её перекрывает, никуда не едет, и запас на
его дорожке считается от его конца, поэтому сдвиг сам останавливается там,
где упёрся.

Проверено: клип 0..4 с парным звуком разрезан на 2 с, удалён первый
кусок. Хвост уехал в ноль, следующий клип встал вплотную, дыры нет.

Внутренние ошибки. Окно «Access violation» без единого слова о том, где
именно, не даёт ничего, а при воспроизведении оно повторяется на каждый
кадр и его невозможно закрыть. Теперь ошибка перехватывается: в журнал
пишется разбор стека с именами файлов и номерами строк — сборка идёт с
отладочными сведениями. Окно показывается только на первую ошибку,
дальнейшие лишь считаются.

Звуковые дорожки предпросмотра хранятся номерами, а не указателями.
Указатели были ловушкой: отмена и открытие проекта пересоздают все
дорожки, а список продолжал показывать на освобождённую память —
и обращаются к нему на каждое обновление времени, то есть десятки раз в
секунду.

src/uMainForm.pas

@@ -95,7 +95,14 @@ type
     FLastLoadedAudioEdl: string;
     { Списки кусков звуковых дорожек для плеера. }
     FPreviewAudioUrls: array of string;
-    FPreviewAudioTracks: array of TTrack;
+    { Звуковые дорожки предпросмотра — их номера в проекте, а не сами
+      объекты.
+
+      Указатели здесь были ловушкой: отмена и открытие проекта
+      пересоздают все дорожки, а этот список продолжал показывать на
+      освобождённую память. Обращение к нему идёт на каждое обновление
+      времени при воспроизведении, то есть десятки раз в секунду. }
+    FPreviewAudioTracks: array of string;
     FLastHwdec: string;
     FLastAudioNote: string;
     FLogFilePath: string;
@@ -112,6 +119,9 @@ type
     { Что выбрали в окне сборки в прошлый раз. Держится между вызовами,
       чтобы не задавать один и тот же вопрос заново. }
     FExportChoice: TExportChoice;
+    { Сколько внутренних ошибок уже случилось. Окно показываем только на
+      первую. }
+    FErrorCount: Integer;
     FLogButton: TThemedButton;
     { Показанная доля выполнения. Отдельно от настоящей, потому что растёт
       она по своим правилам — см. AdvanceJobBar. }
@@ -213,6 +223,8 @@ type
 
     { --- окно и меню --- }
     procedure BuildMenu;
+    { Разбор внутренней ошибки: пишет в журнал место, где она случилась. }
+    procedure HandleException(Sender: TObject; E: Exception);
     procedure ApplyWindowIcon;
     procedure BuildJobIndicator;
     procedure JobTimerTick(Sender: TObject);
@@ -592,6 +604,7 @@ begin
   { Точный замер текста ставится до первой сборки субтитров: без него
     размер подбирался бы по грубой оценке. }
   InstallTextMeasure;
+  Application.OnException := @HandleException;
 
   ApplyWindowIcon;
 
@@ -681,6 +694,41 @@ end;
   Место справа в нижней полосе отводится сразу и насовсем, а надпись с
   полоской показываются только когда работа есть. Так строка состояния и
   показатель не наезжают друг на друга. }
+{ Внутренняя ошибка не должна оставаться загадкой.
+
+  Окно «Access violation» без единого слова о том, где именно, не даёт
+  ничего: ошибка повторяется на каждый кадр воспроизведения, а найти её
+  негде. Поэтому мы перехватываем её сами и пишем в журнал разбор стека —
+  сборка идёт с отладочными сведениями, поэтому в нём видны имена файлов
+  и номера строк.
+
+  Окно показывается только на первую ошибку. Дальше они лишь считаются:
+  повторяющееся окно поверх воспроизведения невозможно закрыть. }
+procedure TMainForm.HandleException(Sender: TObject; E: Exception);
+var
+  Trace: string;
+  I: Integer;
+  Frames: PPointer;
+begin
+  Inc(FErrorCount);
+
+  Trace := BackTraceStrFunc(ExceptAddr);
+  Frames := ExceptFrames;
+  for I := 0 to ExceptFrameCount - 1 do
+    Trace := Trace + LineEnding + '    ' + BackTraceStrFunc(Frames[I]);
+
+  Log(Format('ВНУТРЕННЯЯ ОШИБКА %d: %s: %s', [FErrorCount, E.ClassName,
+    E.Message]));
+  Log('  где: ' + Trace);
+
+  if FErrorCount = 1 then
+    ThemedMessageDlg('nlve',
+      E.ClassName + ': ' + E.Message + LineEnding + LineEnding +
+      'Разбор записан в журнал (nlve.log рядом с программой). ' +
+      'Следующие такие же ошибки будут только записываться.',
+      mtError, [mbOK], 0);
+end;
+
 { Значок окна. Вшит в программу, потому что рядом с ней может ничего не
   лежать. Значок самого файла программы под Windows задаётся не здесь, а
   ресурсом при сборке — это отдельная история. }
@@ -1864,7 +1912,7 @@ begin
       проходу пропустить дорожку, и громкости съедут на соседние. Тогда
       дорожка с нулевой громкостью заглушила бы чужую. }
     SetLength(FPreviewAudioTracks, Length(FPreviewAudioTracks) + 1);
-    FPreviewAudioTracks[High(FPreviewAudioTracks)] := FProject.Tracks[I];
+    FPreviewAudioTracks[High(FPreviewAudioTracks)] := FProject.Tracks[I].Id;
   end;
 
   if Length(Missing) > 0 then
@@ -2452,6 +2500,7 @@ procedure TMainForm.ApplyVolumeAt(const ATime: Double);
 var
   I: Integer;
   Clip: TClip;
+  Track: TTrack;
   Vols: array of Double;
   Key: string;
 begin
@@ -2464,12 +2513,15 @@ begin
   Key := '';
   for I := 0 to High(FPreviewAudioTracks) do
   begin
-    Clip := FPreviewAudioTracks[I].ClipAt(ATime);
+    Track := FProject.FindTrack(FPreviewAudioTracks[I]);
     SetLength(Vols, Length(Vols) + 1);
-    if Clip <> nil then
-      Vols[High(Vols)] := Clip.Volume
-    else
-      Vols[High(Vols)] := 1;
+    Vols[High(Vols)] := 1;
+    if Track <> nil then
+    begin
+      Clip := Track.ClipAt(ATime);
+      if Clip <> nil then
+        Vols[High(Vols)] := Clip.Volume;
+    end;
     Key := Key + SecondsToStr(Vols[High(Vols)]) + ',';
   end;
 
@@ -2485,7 +2537,12 @@ begin
   begin
     if Key <> '' then
       Key := Key + ', ';
-    Key := Key + FPreviewAudioTracks[I].Name + '=' + SecondsToStr(Vols[I]);
+    Track := FProject.FindTrack(FPreviewAudioTracks[I]);
+    if Track <> nil then
+      Key := Key + Track.Name + '='
+    else
+      Key := Key + '?=';
+    Key := Key + SecondsToStr(Vols[I]);
   end;
   Log(Format('Громкости на %s: %s', [SecondsToStr(ATime), Key]));
 

src/uTimelineCtrl.pas

@@ -155,6 +155,9 @@ type
     procedure DrawOverlaps(ACanvas: TCanvas; ATrack: TTrack; ATop: Integer);
     { Полоса поверх участка, который прямо сейчас пересобирается. }
     procedure DrawBusyRange(ACanvas: TCanvas);
+    { Сдвиг всего, что правее дыры, влево до первого касания. }
+    procedure RippleAfterDelete(const AHoleEnd: Double;
+      const ATracks: TStringList);
   public
     { Отметить участок монтажа, который сейчас пересобирается. Нули
       снимают отметку. }
@@ -2295,11 +2298,80 @@ begin
   StructureChanged;
 end;
 
+{ Сдвиг всего, что правее дыры, влево до первого касания.
+
+  Считается по всем дорожкам сразу, а не по каждой отдельно: сдвинуть
+  одну дорожку значило бы развалить выверенное соответствие картинки и
+  звука. Насколько можно сдвинуть — решает та дорожка, где запас меньше
+  всего: до стыка с ближайшим клипом слева от дыры.
+
+  Дыра при этом не обязана быть пустой на всех дорожках. Клип, который её
+  перекрывает, никуда не едет, и запас на его дорожке считается от его
+  конца — так сдвиг сам собой останавливается там, где упёрся. }
+procedure TTimelineControl.RippleAfterDelete(const AHoleEnd: Double;
+  const ATracks: TStringList);
+var
+  T, C: Integer;
+  Track: TTrack;
+  PrevEnd, NextStart, Shift, Room: Double;
+  HasMoving: Boolean;
+begin
+  if FProject = nil then
+    Exit;
+
+  Shift := -1;
+  for T := 0 to FProject.TrackCount - 1 do
+  begin
+    if (FProject.RippleMode = rmCurrentTrack) and
+       (ATracks.IndexOf(IntToStr(T)) < 0) then
+      Continue;
+
+    Track := FProject.Tracks[T];
+    PrevEnd := 0;
+    NextStart := 0;
+    HasMoving := False;
+    for C := 0 to Track.Count - 1 do
+      if Track[C].TlStart >= AHoleEnd - 0.0005 then
+      begin
+        if (not HasMoving) or (Track[C].TlStart < NextStart) then
+          NextStart := Track[C].TlStart;
+        HasMoving := True;
+      end
+      else
+        PrevEnd := Max(PrevEnd, Track[C].TlEnd);
+
+    if not HasMoving then
+      Continue;
+
+    Room := NextStart - PrevEnd;
+    if (Shift < 0) or (Room < Shift) then
+      Shift := Room;
+  end;
+
+  if Shift <= 0.0005 then
+    Exit;
+
+  for T := 0 to FProject.TrackCount - 1 do
+  begin
+    if (FProject.RippleMode = rmCurrentTrack) and
+       (ATracks.IndexOf(IntToStr(T)) < 0) then
+      Continue;
+
+    Track := FProject.Tracks[T];
+    for C := 0 to Track.Count - 1 do
+      if Track[C].TlStart >= AHoleEnd - 0.0005 then
+        Track[C].TlStart := Track[C].TlStart - Shift;
+    Track.Sort;
+  end;
+end;
+
 procedure TTimelineControl.DeleteSelected;
 var
   T, C: Integer;
   Track: TTrack;
   AnyChange: Boolean;
+  HoleEnd: Double;
+  Touched: TStringList;
 begin
   if FProject = nil then
     Exit;
@@ -2309,17 +2381,32 @@ begin
   SelectWholeGroups;
 
   AnyChange := False;
+  HoleEnd := 0;
   FProject.BeginChange;
+  Touched := TStringList.Create;
+  try
+    for T := 0 to FProject.TrackCount - 1 do
+    begin
+      Track := FProject.Tracks[T];
+      for C := Track.Count - 1 downto 0 do
+        if Track[C].Selected then
+        begin
+          { Правый край дыры: дальше него всё поедет влево. }
+          HoleEnd := Max(HoleEnd, Track[C].TlEnd);
+          if Touched.IndexOf(IntToStr(T)) < 0 then
+            Touched.Add(IntToStr(T));
+          Track.Remove(Track[C]);
+          AnyChange := True;
+        end;
+    end;
 
-  for T := 0 to FProject.TrackCount - 1 do
-  begin
-    Track := FProject.Tracks[T];
-    for C := Track.Count - 1 downto 0 do
-      if Track[C].Selected then
-      begin
-        Track.Remove(Track[C]);
-        AnyChange := True;
-      end;
+    { Схлопывание после удаления — то же самое автосхлопывание, что и при
+      перетаскивании: если оно выключено, дыра остаётся, и сборка потом
+      заполнит её чернотой. }
+    if AnyChange and FProject.RippleEnabled then
+      RippleAfterDelete(HoleEnd, Touched);
+  finally
+    Touched.Free;
   end;
 
   if AnyChange then