nlve/src/uFlatten.pas

{
  uFlatten — превращение монтажа в плоский список кусков.

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

  Алгоритм:

  1. Собрать все границы всех клипов со всех дорожек. Внутри промежутка
     между двумя соседними границами набор перекрывающихся клипов не
     меняется — значит и победитель не меняется.
  2. Для каждого промежутка найти клип на самой верхней дорожке.
  3. Промежуток, не покрытый ничем, становится чёрным куском: дыра на
     монтаже — часть замысла, а не ошибка.
  4. Склеить соседние куски, если они идут подряд в одном источнике.
     Без этого рез оставался бы там, где его нет, и сборка резала бы файл
     на лишние части.

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

  Картинки и чёрные куски не берутся из исходников — под них заранее
  создаются небольшие клипы в параметрах проекта. Так и предпросмотр, и
  сборка работают с ними как с обычным видео. Проверено, что подсовывать
  mpv картинку или генератор прямо в списке кусков нельзя: он на этом
  зависает.
}
unit uFlatten;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, uAppTypes, uProject, uMediaProbe, uTransform;

type
  { Набор отрезков времени: им описывают, где оверлей виден. }
  TDoubleArray = array of Double;

  { Клип, который в предпросмотре кладётся поверх основы.

    Место в кадре — то же самое, по чему сборка обкладывает картинку
    полями: считается одним кодом (см. OverlayFilter). }
  TPreviewOverlay = record
    TlStart: Double;
    TlEnd: Double;
    FilePath: string;
    SrcStart: Double;
    { Цепочка фильтров для плеера: без полей, только приведение к нужному
      размеру и повороту. }
    Filter: string;
    X: Integer;
    Y: Integer;
    Width: Integer;
    Height: Integer;
  end;
  TPreviewOverlays = array of TPreviewOverlay;

  { Что нужно создать, чтобы кусок стал воспроизводимым файлом. }
  { gkSilence — вставка тишины без картинки, только для звуковых дорожек.

    Отдельный вид, а не чёрный клип, потому что перемотка внутри чёрного
    клипа откатывается к ближайшему опорному кадру, а те стоят через
    четыре секунды. Дорожка после этого отдаёт звук на несколько секунд
    раньше соседних, смешивание равняется по ней, и содержимое соседней
    дорожки в это окно не попадает — звук пропадал целыми кусками.
    Замерено: на 24-й секунде смешивание трёх дорожек давало -91 dB, то
    есть полную тишину, при том что каждая дорожка по отдельности звучала.
    Со звуковой вставкой в той же точке -11.7 dB.

    В звуковом файле опорным является каждый кадр, и такой беды нет. }
  TGenKind = (gkNone, gkBlack, gkImage, gkSilence, gkLayers);

  TGenRequest = record
    Kind: TGenKind;
    SourcePath: string;
    Duration: Double;
    TargetPath: string;
    { Только для gkLayers: что с чем смешивать. }
    Layers: TSegmentLayers;
    { Место на монтаже, ради которого всё затевается. Нужно только для
      показа: пока участок пересобирается, монтаж помечает его полосой. }
    TlStart: Double;
    TlEnd: Double;
  end;

  TGenRequests = array of TGenRequest;

{ Раскладывает монтаж в последовательность кусков.

  У кусков, требующих генерации, FilePath указывает на будущий файл в кэше;
  сам файл может ещё не существовать. Список того, что надо создать,
  возвращается в AMissing. }
{ Уплощение одного потока: либо картинки, либо звука.

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

  Дорожки другого вида в проходе не участвуют вовсе — ни как источники,
  ни как границы кусков. }
{ AMinLength — до какой длины дотянуть поток. Нужно, чтобы картинка и звук
  всегда были одной длины: если выключить все дорожки картинки, поток
  картинки опустеет, и без этого предпросмотр погас бы вместе со звуком.
  Недостающее заполняется чёрным и тишиной. }
function FlattenStream(AProject: TProject; AKind: TTrackKind;
  const AMinLength: Double;
  out ASegments: TFlatSegmentArray; out AMissing: TGenRequests;
  AHidden: TFPList = nil): Boolean;

{ Уплощение одной звуковой дорожки — для предпросмотра.

  Плеер умеет играть только одну звуковую дорожку за раз, поэтому смесь
  ему приходится собирать самому: каждая дорожка монтажа подаётся своим
  списком кусков, а дальше они складываются его же средствами. }
function FlattenAudioTrack(AProject: TProject; ATrack: TTrack;
  const ATotal: Double;
  out ASegments: TFlatSegmentArray; out AMissing: TGenRequests): Boolean;

{ Длина слышимого материала одного вида дорожек. }
function AudibleEnd(AProject: TProject; AKind: TTrackKind): Double;

{ Оба потока разом. Список того, что надо создать, общий: чёрные вставки
  годятся и картинке, и звуку — в них есть и то, и другое. }
function FlattenProject(AProject: TProject;
  out AVideo, AAudio: TFlatSegmentArray;
  out AMissing: TGenRequests): Boolean;

{ То же для предпросмотра, но клипы, которые кладутся поверх, вынесены
  отдельно.

  Зачем. Клип с ключом или прозрачностью не сплошной, и в готовом ролике
  участок под ним приходится сводить. Оверлей во весь ролик — компас или
  карта поверх всего материала — заставил бы сводить весь фильм на каждую
  правку, ради картинки, которую всё равно надо перепроверять сборкой.

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

  AWithKey — применять ли к оверлею цветовой ключ и прозрачность прямо в
  плеере. Тогда окно показывает то же, что даст сборка. Стоит это
  недорого: фильтр работает по площади самого оверлея, а не всего кадра,
  но на слабой машине лишним не будет, поэтому решает вызывающий.

  Для сборки ролика это не применяется: там всё сводится по-настоящему. }
function FlattenPreview(AProject: TProject;
  out AVideo, AAudio: TFlatSegmentArray;
  out AOverlays: TPreviewOverlays;
  out AMissing: TGenRequests;
  AWithKey: Boolean = False): Boolean;

{ Оставляет от списка кусков только то, что попадает в участок.

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

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

  Возвращает, сколько секунд осталось. }
function ClipSegmentsToRange(var ASegments: TFlatSegmentArray;
  const AFrom, ATo: Double): Double;

{ Путь к сгенерированному клипу. Имя выводится из содержимого запроса,
  поэтому одинаковые запросы дают один и тот же файл, и он делается
  один раз. }
function GeneratedPath(const ACacheDir: string; const AReq: TGenRequest): string;

{ Заменяет куски с наложением готовыми файлами — для предпросмотра.

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

  Чего ещё не готово — уходит в AMissing тем же путём, что чёрные вставки:
  окно их закажет и повторит сборку списка.

  Для сборки ролика это не применяется: там наложение считается заново с
  параметрами вывода, и промежуточный файл был бы лишней потерей
  качества. }
procedure ResolveLayers(AProject: TProject; var ASegments: TFlatSegmentArray;
  var AMissing: TGenRequests);

{ Заготовка чёрной вставки самой ходовой длины.

  Делается заранее, сразу после того как стали известны параметры проекта.
  Иначе первая же дыра на монтаже ждала бы генерации, и в это время
  предпросмотр играл бы прежнюю расстановку — выглядело бы так, будто
  удаление клипа или выключение дорожки не действуют. }

function PrewarmRequests(const ACacheDir: string): TGenRequests;

implementation

uses
  Math, md5;

const
  { Длительность округляется до миллисекунд: иначе крошечное расхождение
    в дробной части плодило бы почти одинаковые файлы. }
  DurationQuantum = 0.001;

  { Готовые длины вставок.

    Раньше под каждую дыру делался отдельный чёрный клип ровно её длины.
    Из-за этого любое движение клипа меняло длину дыры, требовало новой
    вставки, и до её готовности предпросмотр играл прежнюю расстановку —
    выглядело так, будто выключение дорожки или удаление клипа не
    действуют.

    Теперь вставка берётся из готового файла подходящей длины, а нужный
    кусок из неё просто вырезается. Файлов получается несколько штук на
    проект, и делаются они один раз. }
  LengthBuckets: array[0..5] of Double = (15, 60, 300, 1800, 7200, 28800);

function QuantizeDuration(const AValue: Double): Double;
begin
  Result := Round(AValue / DurationQuantum) * DurationQuantum;
end;

{ Наименьшая из готовых длин, вмещающая запрошенную. }
function BucketFor(const ADuration: Double): Double;
var
  I: Integer;
begin
  for I := 0 to High(LengthBuckets) do
    if LengthBuckets[I] >= ADuration - 0.0005 then
      Exit(LengthBuckets[I]);
  Result := LengthBuckets[High(LengthBuckets)];
end;

function GeneratedPath(const ACacheDir: string; const AReq: TGenRequest): string;
var
  Key, Name: string;
  Ms: Int64;
begin
  Ms := Round(QuantizeDuration(AReq.Duration) * 1000);
  case AReq.Kind of
    gkBlack:
      Name := Format('black_%d.mkv', [Ms]);
    gkSilence:
      Name := Format('silence_%d.m4a', [Ms]);
    gkLayers:
      { Имя выводится из описания слоёв: одно и то же наложение даёт один
        и тот же файл, и пересчитывать его второй раз не приходится. }
      Name := Format('mix_%s_%d.mkv',
        [Copy(MD5Print(MD5String(AReq.SourcePath)), 1, 12), Ms]);
    gkImage:
      begin
        Key := AReq.SourcePath + '|' + IntToStr(Ms);
        Name := Format('img_%s_%d.mkv', [Copy(MD5Print(MD5String(Key)), 1, 12), Ms]);
      end;
  else
    Name := '';
  end;

  if Name = '' then
    Result := ''
  else
    Result := IncludeTrailingPathDelimiter(ACacheDir) + 'gen' + PathDelim + Name;
end;

{ Описание слоёв одной строкой. Из неё выводится имя файла, поэтому в неё
  входит всё, что влияет на картинку: исходник, место в нём, кадрирование
  и доли прозрачности. }
function LayersKey(const ALayers: TSegmentLayers;
  const ADuration: Double): string;
var
  I: Integer;
begin
  Result := SecondsToStr(ADuration);
  for I := 0 to High(ALayers) do
    Result := Result + '|' + ALayers[I].FilePath +
      '@' + SecondsToStr(ALayers[I].SrcStart) +
      '#' + ALayers[I].Filter +
      '*' + SecondsToStr(ALayers[I].Opacity) +
      '>' + SecondsToStr(ALayers[I].FadeFrom) +
      '<' + SecondsToStr(ALayers[I].FadeTo);
    { Ключ входит в имя готового файла: иначе после правки цвета или
      допуска подставился бы прежний, сведённый по старым числам. }
    if ALayers[I].KeyEnabled then
      Result := Result + Format('~%.6x/%d/%d',
        [ALayers[I].KeyColor and $FFFFFF,
         ALayers[I].KeySimilarity, ALayers[I].KeyBlend]);
end;

function ClipSegmentsToRange(var ASegments: TFlatSegmentArray;
  const AFrom, ATo: Double): Double;
var
  I, J, N: Integer;
  At, SegStart, SegEnd, NewStart, NewEnd, Shift: Double;
  Kept: TFlatSegmentArray;
  Seg: TFlatSegment;
begin
  Result := 0;
  if ATo <= AFrom then
    Exit;

  N := 0;
  At := 0;
  SetLength(Kept, Length(ASegments));
  for I := 0 to High(ASegments) do
  begin
    SegStart := At;
    SegEnd := At + ASegments[I].Duration;
    At := SegEnd;

    NewStart := Max(SegStart, AFrom);
    NewEnd := Min(SegEnd, ATo);
    if NewEnd <= NewStart + 0.0005 then
      Continue;

    Seg := ASegments[I];
    Shift := NewStart - SegStart;
    Seg.SrcStart := Seg.SrcStart + Shift;
    Seg.Duration := NewEnd - NewStart;
    for J := 0 to High(Seg.Layers) do
      Seg.Layers[J].SrcStart := Seg.Layers[J].SrcStart + Shift;

    Kept[N] := Seg;
    Inc(N);
    Result := Result + Seg.Duration;
  end;

  SetLength(Kept, N);
  ASegments := Kept;
end;

procedure ResolveLayers(AProject: TProject; var ASegments: TFlatSegmentArray;
  var AMissing: TGenRequests);
var
  I: Integer;
  Req: TGenRequest;
  At: Double;
begin
  if AProject = nil then
    Exit;
  At := 0;
  for I := 0 to High(ASegments) do
  begin
    if Length(ASegments[I].Layers) = 0 then
    begin
      At := At + ASegments[I].Duration;
      Continue;
    end;

    Req := Default(TGenRequest);
    Req.Kind := gkLayers;
    Req.Duration := ASegments[I].Duration;
    Req.SourcePath := LayersKey(ASegments[I].Layers, ASegments[I].Duration);
    Req.Layers := ASegments[I].Layers;
    Req.TargetPath := GeneratedPath(AProject.CacheDir, Req);
    Req.TlStart := At;
    Req.TlEnd := At + ASegments[I].Duration;
    At := Req.TlEnd;

    if not FileExists(Req.TargetPath) then
    begin
      SetLength(AMissing, Length(AMissing) + 1);
      AMissing[High(AMissing)] := Req;
      Continue;
    end;

    { Готовый файл встаёт на место куска целиком: слои в нём уже сведены,
      кадрировать и пересобирать больше нечего. }
    ASegments[I].FilePath := Req.TargetPath;
    ASegments[I].SrcStart := 0;
    ASegments[I].Filter := '';
    ASegments[I].Transcode := False;
    ASegments[I].Layers := nil;
  end;
end;


function PrewarmRequests(const ACacheDir: string): TGenRequests;
var
  Req: TGenRequest;
begin
  Result := nil;
  Req.Kind := gkBlack;
  Req.SourcePath := '';
  Req.Duration := LengthBuckets[0];
  Req.TargetPath := GeneratedPath(ACacheDir, Req);
  if FileExists(Req.TargetPath) then
    Exit;
  SetLength(Result, 1);
  Result[0] := Req;
end;

{ Добавляет время в отсортированный список без повторов. }
procedure AddBoundary(var A: array of Double; var ACount: Integer;
  const AValue: Double);
begin
  if ACount >= Length(A) then
    Exit;
  A[ACount] := AValue;
  Inc(ACount);
end;

function CompareDoubles(const A, B: Double): Integer;
begin
  if A < B then
    Result := -1
  else if A > B then
    Result := 1
  else
    Result := 0;
end;

procedure SortDoubles(var A: array of Double; ACount: Integer);
var
  I, J: Integer;
  Tmp: Double;
begin
  { Границ немного (по две на клип), поэтому простая сортировка вставками
    здесь и быстрее по факту, и понятнее. }
  for I := 1 to ACount - 1 do
  begin
    Tmp := A[I];
    J := I - 1;
    while (J >= 0) and (A[J] > Tmp) do
    begin
      A[J + 1] := A[J];
      Dec(J);
    end;
    A[J + 1] := Tmp;
  end;
end;

function AudibleEnd(AProject: TProject; AKind: TTrackKind): Double;
var
  T: Integer;
  Track: TTrack;
begin
  Result := 0;
  if AProject = nil then
    Exit;
  for T := 0 to AProject.TrackCount - 1 do
  begin
    Track := AProject.Tracks[T];
    if Track.Kind <> AKind then
      Continue;
    if not AProject.TrackAudible(Track) then
      Continue;
    if Track.EndTime > Result then
      Result := Track.EndTime;
  end;
end;

{ AHidden — клипы, которых для этого прохода как бы нет. Через них видно
  то, что лежит ниже. Нужны предпросмотру: клип, который плеер положит
  поверх сам, не должен ничего закрывать в основе. }
function FlattenStream(AProject: TProject; AKind: TTrackKind;
  const AMinLength: Double;
  out ASegments: TFlatSegmentArray; out AMissing: TGenRequests;
  AHidden: TFPList = nil): Boolean;
var
  Bounds: array of Double;
  BoundCount: Integer;
  T, C, I, N: Integer;
  Track: TTrack;
  Winner: TClip;
  Mid, SegStart, SegEnd, MaxLen: Double;
  Item: TMediaItem;
  Seg: TFlatSegment;
  Raw: TFlatSegmentArray;
  RawCount: Integer;
  Req: TGenRequest;
  Path: string;
  Seen: TStringList;
  Partner, Under: TClip;

  { Слой из клипа: где в исходнике брать картинку и с какой
    непрозрачностью её накладывать. }
  function LayerOf(AClip: TClip; const AAt: Double;
    const AFrom, ATo: Double): TSegmentLayer;
  var
    It: TMediaItem;
    W, H: Integer;
  begin
    Result := Default(TSegmentLayer);
    Result.FadeFrom := AFrom;
    Result.FadeTo := ATo;
    Result.Opacity := AFrom;
    It := AProject.FindMedia(AClip.MediaId);
    if It = nil then
      Exit;
    Result.FilePath := It.EffectivePath;
    Result.IsImage := (AClip.Kind = ckImage) or (It.Info.Kind = mkImage);
    Result.SrcStart := AClip.SrcIn + (AAt - AClip.TlStart);
    Result.KeyEnabled := AClip.ColorKey.Enabled;
    Result.KeyColor := AClip.ColorKey.Color;
    Result.KeySimilarity := AClip.ColorKey.Similarity;
    Result.KeyBlend := AClip.ColorKey.Blend;
    Result.Filter := TransformFilter(AClip.Transform,
      It.Info.Width, It.Info.Height,
      AProject.Master.Width, AProject.Master.Height);
    Result.FitFilter := OverlayFilter(AClip.Transform,
      It.Info.Width, It.Info.Height,
      AProject.Master.Width, AProject.Master.Height,
      Result.X, Result.Y, W, H);
    if Result.Filter = '' then
      Result.Filter := PreviewFitFilter(AProject.Master.Width,
        AProject.Master.Height);
  end;

  { Все звучащие клипы в этот момент, со всех слышимых звуковых дорожек.

    Если звучит ровно один и без перехода, слои не нужны — кусок описан
    обычным способом. }
  procedure CollectAudioLayers(AWinner, APartner: TClip;
    const AAt, ASegStart: Double; var ASeg: TFlatSegment);
  var
    Ti, C, N: Integer;
    Track: TTrack;
    Cl: TClip;

    procedure Push(const ALayer: TSegmentLayer);
    begin
      SetLength(ASeg.Layers, N + 1);
      ASeg.Layers[N] := ALayer;
      Inc(N);
    end;

  begin
    N := 0;
    ASeg.Layers := nil;

    if APartner <> nil then
    begin
      { Переход на дорожке победителя: один уходит, другой приходит. }
      if APartner.TlStart < AWinner.TlStart then
      begin
        Push(LayerOf(APartner, ASegStart, APartner.Volume, 0));
        Push(LayerOf(AWinner, ASegStart, 0, AWinner.Volume));
      end
      else
      begin
        Push(LayerOf(AWinner, ASegStart, AWinner.Volume, 0));
        Push(LayerOf(APartner, ASegStart, 0, APartner.Volume));
      end;
    end
    else
      Push(LayerOf(AWinner, ASegStart, AWinner.Volume, AWinner.Volume));

    { Всё, что звучит одновременно на других звуковых дорожках. }
    for Ti := 0 to AProject.TrackCount - 1 do
    begin
      Track := AProject.Tracks[Ti];
      if Track.Kind <> tkAudio then
        Continue;
      if not AProject.TrackAudible(Track) then
        Continue;
      for C := 0 to Track.Count - 1 do
      begin
        Cl := Track[C];
        if not Cl.Covers(AAt) then
          Continue;
        if (Cl = AWinner) or (Cl = APartner) then
          Continue;
        Push(LayerOf(Cl, ASegStart, Cl.Volume, Cl.Volume));
      end;
    end;

    { Звучит ровно один клип и без перехода — смешивать нечего, кусок
      описывается обычным способом и обходится без пересборки. }
    if N < 2 then
      ASeg.Layers := nil;
  end;

  function IsHidden(AClip: TClip): Boolean;
  begin
    Result := (AHidden <> nil) and (AHidden.IndexOf(AClip) >= 0);
  end;

  { Клип дорожки в этот момент, не считая спрятанных. }
  function VisibleClipAt(ATrack: TTrack; const ATime: Double): TClip;
  var
    C: Integer;
    Cl: TClip;
  begin
    Result := nil;
    for C := 0 to ATrack.Count - 1 do
    begin
      Cl := ATrack[C];
      if Cl.Covers(ATime) and (not IsHidden(Cl)) then
        Exit(Cl);
    end;
  end;

  { Клип, побеждающий в указанный момент: с самой верхней дорожки. }
  function WinnerAt(const ATime: Double): TClip;
  var
    Ti: Integer;
    Cl: TClip;
  begin
    Result := nil;
    for Ti := 0 to AProject.TrackCount - 1 do
    begin
      if AProject.Tracks[Ti].Kind <> AKind then
        Continue;
      { Выключенные дорожки пропускаются, а если где-то включено «соло» —
        то и все несолирующие. }
      if not AProject.TrackAudible(AProject.Tracks[Ti]) then
        Continue;
      Cl := VisibleClipAt(AProject.Tracks[Ti], ATime);
      if Cl <> nil then
        Exit(Cl);
    end;
  end;

  { Номер дорожки, на которой стоит клип. }
  function TrackIndexOfClip(AClip: TClip): Integer;
  var
    Ti: Integer;
  begin
    Result := -1;
    for Ti := 0 to AProject.TrackCount - 1 do
      if AProject.Tracks[Ti].IndexOf(AClip) >= 0 then
        Exit(Ti);
  end;

  { Второй клип, покрывающий тот же момент на той же дорожке.

    Два клипа на одной дорожке, наползшие друг на друга, — это переход:
    один перетекает в другой. На разных дорожках такое означает не
    переход, а наложение, и разбирается отдельно. }
  function OverlapPartner(AClip: TClip; const ATime: Double): TClip;
  var
    Ti, C: Integer;
    Track: TTrack;
    Cl: TClip;
  begin
    Result := nil;
    Ti := TrackIndexOfClip(AClip);
    if Ti < 0 then
      Exit;
    Track := AProject.Tracks[Ti];
    for C := 0 to Track.Count - 1 do
    begin
      Cl := Track[C];
      if (Cl <> AClip) and Cl.Covers(ATime) and (not IsHidden(Cl)) then
        Exit(Cl);
    end;
  end;

  { Клип под победителем: нужен, когда победитель полупрозрачен. }
  function BelowAt(AClip: TClip; const ATime: Double): TClip;
  var
    Ti, Start: Integer;
    Cl: TClip;
  begin
    Result := nil;
    Start := TrackIndexOfClip(AClip);
    if Start < 0 then
      Exit;
    for Ti := Start + 1 to AProject.TrackCount - 1 do
    begin
      if AProject.Tracks[Ti].Kind <> AKind then
        Continue;
      if not AProject.TrackAudible(AProject.Tracks[Ti]) then
        Continue;
      Cl := VisibleClipAt(AProject.Tracks[Ti], ATime);
      if Cl <> nil then
        Exit(Cl);
    end;
  end;

begin
  ASegments := nil;
  AMissing := nil;
  Result := False;
  if AProject = nil then
    Exit;

  { --- Границы --- }
  N := 0;
  for T := 0 to AProject.TrackCount - 1 do
    Inc(N, AProject.Tracks[T].Count * 2);
  SetLength(Bounds, N + 3);
  BoundCount := 0;

  AddBoundary(Bounds, BoundCount, 0);
  { Конец задан снаружи: оба потока должны быть одной длины. }
  if AMinLength > 0 then
    AddBoundary(Bounds, BoundCount, AMinLength);
  for T := 0 to AProject.TrackCount - 1 do
  begin
    Track := AProject.Tracks[T];
    if Track.Kind <> AKind then
      Continue;
    if not AProject.TrackAudible(Track) then
      Continue;
    for C := 0 to Track.Count - 1 do
    begin
      AddBoundary(Bounds, BoundCount, Track[C].TlStart);
      AddBoundary(Bounds, BoundCount, Track[C].TlEnd);
      { Границы затуханий: внутри них доля меняется, снаружи нет, значит
        это разные куски. }
      if Track[C].FadeIn > 0 then
        AddBoundary(Bounds, BoundCount,
          Track[C].TlStart + Min(Track[C].FadeIn, Track[C].Duration));
      if Track[C].FadeOut > 0 then
        AddBoundary(Bounds, BoundCount,
          Track[C].TlEnd - Min(Track[C].FadeOut, Track[C].Duration));
    end;
  end;

  if BoundCount < 2 then
    Exit;

  SortDoubles(Bounds, BoundCount);

  { --- Промежутки --- }
  SetLength(Raw, BoundCount);
  RawCount := 0;

  for I := 0 to BoundCount - 2 do
  begin
    SegStart := Bounds[I];
    SegEnd := Bounds[I + 1];
    { Совпавшие границы дают промежуток нулевой длины — пропускаем. }
    if SegEnd - SegStart < 0.0005 then
      Continue;

    { Внутри промежутка победитель не меняется, поэтому достаточно
      проверить одну точку. Берём середину: на краях клип может как
      начинаться, так и заканчиваться. }
    Mid := (SegStart + SegEnd) / 2;
    Winner := WinnerAt(Mid);

    { Запись переиспользуется в цикле, поэтому обнуляем её целиком.
      Иначе поля вроде громкости достаются от предыдущего куска: чёрная
      вставка получала чужой множитель, и звук в ней глушился или нет
      в зависимости от того, что было перед ней. }
    Seg := Default(TFlatSegment);
    Seg.Volume := 1;
    Seg.Duration := SegEnd - SegStart;

    if Winner = nil then
    begin
      { Дыра. Показываем чёрное с тишиной. }
      Seg.Kind := skBlack;
      Seg.SrcStart := 0;
      Seg.GenSource := '';
      Seg.PreciseIn := False;
      Req.Kind := gkBlack;
      Req.SourcePath := '';
      { Файл делается длиннее нужного, а из него берётся ровно столько,
        сколько надо. }
      Req.Duration := BucketFor(Seg.Duration);
      Seg.FilePath := GeneratedPath(AProject.CacheDir, Req);
    end
    else if Winner.Kind = ckImage then
    begin
      Item := AProject.FindMedia(Winner.MediaId);
      if Item = nil then
        Continue;
      Seg.Kind := skImage;
      Seg.SrcStart := 0;
      Seg.GenSource := Item.EffectivePath;
      Seg.PreciseIn := False;
      Seg.Volume := Winner.Volume;
      Req.Kind := gkImage;
      Req.SourcePath := Item.EffectivePath;
      Req.Duration := BucketFor(Seg.Duration);
      Seg.FilePath := GeneratedPath(AProject.CacheDir, Req);
    end
    else
    begin
      Item := AProject.FindMedia(Winner.MediaId);
      if Item = nil then
        Continue;
      Seg.Kind := skVideo;
      Seg.GenSource := '';
      Seg.Volume := Winner.Volume;
      Seg.FilePath := Item.EffectivePath;
      { Сколько от начала клипа прошло, столько же надо отступить и в
        исходнике. }
      Seg.SrcStart := Winner.SrcIn + (SegStart - Winner.TlStart);

      { Точность требуется только там, где кусок начинается с собственного
        левого края клипа. Границы, возникшие из-за перекрытия соседней
        дорожкой, притягиваются к опорному кадру: помечать их точными
        значило бы перекодировать стык при каждом наложении. }
      Seg.PreciseIn := (Winner.EdgeIn = edPrecise) and
        (Abs(SegStart - Winner.TlStart) < 0.0005);

      { Кусок нельзя скопировать по двум причинам: файл не совпадает с
        параметрами проекта, либо у клипа своё кадрирование. И то, и
        другое требует пересборки — но только этого куска, всё остальное
        по-прежнему копируется. }
      Seg.Transcode := HasBlocking(CompareToMaster(AProject.Master, Item.Info))
        or (not TransformIsIdentity(Winner.Transform,
              Item.Info.Width, Item.Info.Height,
              AProject.Master.Width, AProject.Master.Height));
      if Seg.Transcode then
        Seg.Filter := TransformFilter(Winner.Transform,
          Item.Info.Width, Item.Info.Height,
          AProject.Master.Width, AProject.Master.Height);

      { Не просим у файла больше, чем в нём есть.

        Когда клип занимает исходник целиком, запрошенная длина совпадает
        с длиной файла до последнего знака, и mpv ругается «entry uses
        892.124567 seconds, but file has only 892.124567 seconds» — его
        собственный подсчёт отличается на неразличимую величину. Отступаем
        на миллисекунду: на монтаже это незаметно, а предупреждение,
        выглядящее как ошибка, исчезает. }
      if Item.Info.Duration > 0 then
      begin
        MaxLen := Item.Info.Duration - Seg.SrcStart;
        if (MaxLen > 0) and (Seg.Duration > MaxLen - 0.001) then
          Seg.Duration := Max(0.001, MaxLen - 0.001);
      end;

      { --- Наложение --- }

      Partner := OverlapPartner(Winner, Mid);
      Under := nil;
      { Ключ работает так же, как полупрозрачность: клип перестаёт быть
        сплошным, и участок приходится собирать вместе с тем, что под
        ним. }
      if (Partner = nil) and
         ((Winner.Opacity < 0.999) or Winner.ColorKey.Enabled) then
        Under := BelowAt(Winner, Mid);

      { Ручное затухание: кусок попал в зону появления или ухода. Слой
        один, но с меняющейся долей — дальше это обрабатывается тем же
        путём, что и переход между двумя клипами. }
      if (Partner = nil) and (Under = nil) and Winner.ColorKey.Enabled then
      begin
        { Ключ есть, а класть не на что — всё равно пересобираем. }
        SetLength(Seg.Layers, 1);
        Seg.Layers[0] := LayerOf(Winner, SegStart, 1, 1);
        Seg.Transcode := True;
      end
      else if (Partner = nil) and (Under = nil) then
      begin
        if (Winner.FadeIn > 0) and (SegEnd <= Winner.TlStart + Winner.FadeIn + 0.0005) then
        begin
          SetLength(Seg.Layers, 1);
          Seg.Layers[0] := LayerOf(Winner, SegStart,
            (SegStart - Winner.TlStart) / Winner.FadeIn,
            (SegEnd - Winner.TlStart) / Winner.FadeIn);
          Seg.Transcode := True;
        end
        else if (Winner.FadeOut > 0) and
                (SegStart >= Winner.TlEnd - Winner.FadeOut - 0.0005) then
        begin
          SetLength(Seg.Layers, 1);
          Seg.Layers[0] := LayerOf(Winner, SegStart,
            (Winner.TlEnd - SegStart) / Winner.FadeOut,
            (Winner.TlEnd - SegEnd) / Winner.FadeOut);
          Seg.Transcode := True;
        end;
      end;

      { Звуковые дорожки смешиваются, а не побеждают друг друга.

        Правило «верхний побеждает» придумано для картинки: оно и делает
        возможной сборку копированием. Для звука оно бессмысленно — без
        смешивания нельзя положить фоновую музыку под голос. И стоит оно
        ничего: звук у нас всё равно перекодируется. }
      if AKind = tkAudio then
      begin
        CollectAudioLayers(Winner, Partner, Mid, SegStart, Seg);
        if Length(Seg.Layers) > 0 then
          Seg.Transcode := True;
      end
      else if (Partner <> nil) or (Under <> nil) then
      begin
        SetLength(Seg.Layers, 2);
        if Partner <> nil then
        begin
          { Переход на одной дорожке: кто начался раньше, тот уходит.
            Нижним слоем идёт уходящий, верхним приходящий. }
          if Partner.TlStart < Winner.TlStart then
          begin
            Seg.Layers[0] := LayerOf(Partner, SegStart, 1, 0);
            Seg.Layers[1] := LayerOf(Winner, SegStart, 0, 1);
          end
          else
          begin
            Seg.Layers[0] := LayerOf(Winner, SegStart, 1, 0);
            Seg.Layers[1] := LayerOf(Partner, SegStart, 0, 1);
          end;
        end
        else if Under <> nil then
        begin
          { Полупрозрачный клип или клип с ключом поверх нижнего. }
          Seg.Layers[0] := LayerOf(Under, SegStart, 1, 1);
          Seg.Layers[1] := LayerOf(Winner, SegStart,
            Winner.Opacity, Winner.Opacity);
        end
        else
        begin
          { Под клипом ничего нет, но ключ всё равно надо применить:
            вырезанное станет чёрным. }
          SetLength(Seg.Layers, 1);
          Seg.Layers[0] := LayerOf(Winner, SegStart,
            Winner.Opacity, Winner.Opacity);
        end;
        { Собрать такой участок копированием нельзя. }
        Seg.Transcode := True;
      end;
    end;

    Raw[RawCount] := Seg;
    Inc(RawCount);
  end;

  if RawCount = 0 then
    Exit;

  { --- Склейка соседних кусков одного источника --- }
  SetLength(ASegments, RawCount);
  N := 0;
  ASegments[0] := Raw[0];
  for I := 1 to RawCount - 1 do
  begin
    if (Raw[I].Kind = ASegments[N].Kind) and
       (Raw[I].FilePath = ASegments[N].FilePath) and
       (Raw[I].Kind = skVideo) and
       { Участок с наложением склеивать с соседним нельзя: у него свой
         набор слоёв, и в объединённом куске он потерялся бы. }
       (Length(Raw[I].Layers) = 0) and (Length(ASegments[N].Layers) = 0) and
       (Abs(Raw[I].Volume - ASegments[N].Volume) < 0.001) and
       (Abs((ASegments[N].SrcStart + ASegments[N].Duration) - Raw[I].SrcStart) < 0.0005) then
      { Идут подряд в одном файле — это один кусок, а не два. }
      ASegments[N].Duration := ASegments[N].Duration + Raw[I].Duration
    else
    begin
      Inc(N);
      ASegments[N] := Raw[I];
    end;
  end;
  SetLength(ASegments, N + 1);

  { --- Что предстоит создать --- }
  Seen := TStringList.Create;
  try
    Seen.Sorted := True;
    Seen.Duplicates := dupIgnore;

    for I := 0 to High(ASegments) do
    begin
      if ASegments[I].Kind = skVideo then
        Continue;
      Path := ASegments[I].FilePath;
      if (Path = '') or FileExists(Path) then
        Continue;
      if Seen.IndexOf(Path) >= 0 then
        Continue;
      Seen.Add(Path);

      N := Length(AMissing);
      SetLength(AMissing, N + 1);
      AMissing[N].TargetPath := Path;
      AMissing[N].Duration := BucketFor(ASegments[I].Duration);
      AMissing[N].SourcePath := ASegments[I].GenSource;
      if ASegments[I].Kind = skBlack then
        AMissing[N].Kind := gkBlack
      else
        AMissing[N].Kind := gkImage;
    end;
  finally
    Seen.Free;
  end;

  Result := True;
end;

function FlattenAudioTrack(AProject: TProject; ATrack: TTrack;
  const ATotal: Double;
  out ASegments: TFlatSegmentArray; out AMissing: TGenRequests): Boolean;
var
  C, N: Integer;
  At: Double;
  Clip: TClip;
  Item: TMediaItem;
  Seg: TFlatSegment;
  Req: TGenRequest;
  Path: string;

  procedure PushSilence(const ALen: Double);
  begin
    if ALen <= 0.0005 then
      Exit;
    Seg := Default(TFlatSegment);
    Seg.Volume := 1;
    Seg.Kind := skBlack;
    Seg.Duration := ALen;
    { Тишина без картинки: см. пояснение у gkSilence. }
    Req.Kind := gkSilence;
    Req.SourcePath := '';
    Req.Duration := BucketFor(ALen);
    Req.TargetPath := GeneratedPath(AProject.CacheDir, Req);
    Seg.FilePath := Req.TargetPath;
    if not FileExists(Req.TargetPath) then
    begin
      SetLength(AMissing, Length(AMissing) + 1);
      AMissing[High(AMissing)] := Req;
    end;
    SetLength(ASegments, N + 1);
    ASegments[N] := Seg;
    Inc(N);
  end;

begin
  ASegments := nil;
  AMissing := nil;
  Result := False;
  if (AProject = nil) or (ATrack = nil) then
    Exit;

  N := 0;
  At := 0;
  ATrack.Sort;
  for C := 0 to ATrack.Count - 1 do
  begin
    Clip := ATrack[C];
    { Клипы на дорожке могут наползать друг на друга. В предпросмотре это
      разбирается проще некуда: наползший кусок начинается там, где
      кончился предыдущий. Переход в предпросмотре не показывается — он
      виден в готовом ролике. }
    if Clip.TlEnd <= At + 0.0005 then
      Continue;
    if Clip.TlStart > At then
      PushSilence(Clip.TlStart - At);

    Item := AProject.FindMedia(Clip.MediaId);
    if Item = nil then
      Continue;

    Seg := Default(TFlatSegment);
    Seg.Kind := skVideo;
    Seg.Volume := Clip.Volume;
    Seg.FilePath := Item.EffectivePath;
    Seg.SrcStart := Clip.SrcIn + Max(0, At - Clip.TlStart);
    Seg.Duration := Clip.TlEnd - Max(At, Clip.TlStart);
    SetLength(ASegments, N + 1);
    ASegments[N] := Seg;
    Inc(N);
    At := Clip.TlEnd;
  end;

  if ATotal > At then
    PushSilence(ATotal - At);

  Result := N > 0;
end;

function FlattenProject(AProject: TProject;
  out AVideo, AAudio: TFlatSegmentArray;
  out AMissing: TGenRequests): Boolean;
var
  MissA: TGenRequests;
  I: Integer;
  Total: Double;
begin
  AAudio := nil;
  MissA := nil;
  { Длина берётся по обоим видам дорожек сразу: иначе выключенная
    картинка укоротила бы ролик, хотя звук ещё идёт. }
  Total := Max(AudibleEnd(AProject, tkVideo), AudibleEnd(AProject, tkAudio));
  if Total <= 0 then
    Exit;

  Result := FlattenStream(AProject, tkVideo, Total, AVideo, AMissing);
  if not Result then
    Exit;
  FlattenStream(AProject, tkAudio, Total, AAudio, MissA);

  for I := 0 to High(MissA) do
  begin
    SetLength(AMissing, Length(AMissing) + 1);
    AMissing[High(AMissing)] := MissA[I];
  end;
end;

{ Вырезает из набора отрезков указанный. Отрезок посередине делит тот, в
  который попал, надвое: оверлей, закрытый в середине, показывается двумя
  окнами. }
procedure CutRange(var AFrom, ATo: TDoubleArray; var ACount: Integer;
  const ACutFrom, ACutTo: Double);
var
  I, N: Integer;
  NewFrom, NewTo: array of Double;

  procedure Push(const A, B: Double);
  begin
    if B <= A + 0.001 then
      Exit;
    NewFrom[N] := A;
    NewTo[N] := B;
    Inc(N);
  end;

begin
  if ACutTo <= ACutFrom then
    Exit;
  SetLength(NewFrom, ACount * 2 + 2);
  SetLength(NewTo, ACount * 2 + 2);
  N := 0;
  for I := 0 to ACount - 1 do
  begin
    { Не пересекаются — отрезок остаётся как был. }
    if (ACutTo <= AFrom[I] + 0.001) or (ACutFrom >= ATo[I] - 0.001) then
      Push(AFrom[I], ATo[I])
    else
    begin
      Push(AFrom[I], ACutFrom);
      Push(ACutTo, ATo[I]);
    end;
  end;

  ACount := N;
  SetLength(AFrom, N);
  SetLength(ATo, N);
  for I := 0 to N - 1 do
  begin
    AFrom[I] := NewFrom[I];
    ATo[I] := NewTo[I];
  end;
end;

{ Клип кладётся поверх, а не побеждает целиком, если он не сплошной:
  с выбитым цветом или полупрозрачный. }
function IsOverlayClip(AClip: TClip): Boolean;
begin
  Result := (AClip <> nil) and (AClip.Kind in [ckVideo, ckImage]) and
    (AClip.ColorKey.Enabled or (AClip.Opacity < 0.999));
end;

function FlattenPreview(AProject: TProject;
  out AVideo, AAudio: TFlatSegmentArray;
  out AOverlays: TPreviewOverlays;
  out AMissing: TGenRequests;
  AWithKey: Boolean): Boolean;
var
  Hidden: TFPList;
  MissA: TGenRequests;
  T, C, I, J, K, N: Integer;
  Track, Above: TTrack;
  Clip: TClip;
  Item: TMediaItem;
  Total: Double;
  RangeA, RangeB: TDoubleArray;
  RangeCount: Integer;
  Ov: TPreviewOverlay;

  { Занято ли это время другим оверлеем. }
  function OverlapsTaken(const AFrom, ATo: Double): Boolean;
  var
    K: Integer;
  begin
    Result := False;
    for K := 0 to High(AOverlays) do
      if (AFrom < AOverlays[K].TlEnd - 0.001) and
         (ATo > AOverlays[K].TlStart + 0.001) then
        Exit(True);
  end;

begin
  AVideo := nil;
  AAudio := nil;
  AOverlays := nil;
  AMissing := nil;
  MissA := nil;
  Result := False;
  if AProject = nil then
    Exit;

  Total := Max(AudibleEnd(AProject, tkVideo), AudibleEnd(AProject, tkAudio));
  if Total <= 0 then
    Exit;

  Hidden := TFPList.Create;
  try
    N := 0;
    for T := 0 to AProject.TrackCount - 1 do
    begin
      Track := AProject.Tracks[T];
      if Track.Kind <> tkVideo then
        Continue;
      if not AProject.TrackAudible(Track) then
        Continue;
      for C := 0 to Track.Count - 1 do
      begin
        Clip := Track[C];
        if not IsOverlayClip(Clip) then
          Continue;
        Item := AProject.FindMedia(Clip.MediaId);
        if Item = nil then
          Continue;

        { Оверлей играется одной дорожкой поверх основы, а одна дорожка
          не может показывать два куска разом. Если такой клип наложился
          на уже взятый, он остаётся в основе и сводится по-старому:
          потерять его было бы хуже. }
        if OverlapsTaken(Clip.TlStart, Clip.TlEnd) then
          Continue;

        Hidden.Add(Clip);

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

          Закрывать могут и посередине — тогда от оверлея остаётся
          несколько отрезков, и каждый становится своим окном показа. }
        RangeCount := 1;
        SetLength(RangeA, 1);
        SetLength(RangeB, 1);
        RangeA[0] := Clip.TlStart;
        RangeB[0] := Clip.TlEnd;

        for K := 0 to T - 1 do
        begin
          Above := AProject.Tracks[K];
          if Above.Kind <> tkVideo then
            Continue;
          if not AProject.TrackAudible(Above) then
            Continue;
          for J := 0 to Above.Count - 1 do
            { Клип с ключом или прозрачностью сам ничего не закрывает. }
            if not IsOverlayClip(Above[J]) then
              CutRange(RangeA, RangeB, RangeCount,
                Above[J].TlStart, Above[J].TlEnd);
        end;

        for J := 0 to RangeCount - 1 do
        begin
          if RangeB[J] <= RangeA[J] + 0.001 then
            Continue;
          if OverlapsTaken(RangeA[J], RangeB[J]) then
            Continue;

          Ov := Default(TPreviewOverlay);
          Ov.TlStart := RangeA[J];
          Ov.TlEnd := RangeB[J];
          Ov.FilePath := Item.EffectivePath;
          Ov.SrcStart := Clip.SrcIn + (RangeA[J] - Clip.TlStart);
          Ov.Filter := OverlayFilter(Clip.Transform,
            Item.Info.Width, Item.Info.Height,
            AProject.Master.Width, AProject.Master.Height,
            Ov.X, Ov.Y, Ov.Width, Ov.Height);
          { Порядок тот же, что при сборке: сперва вписали в кадр, потом
            выбили цвет, потом приглушили. Иначе смягчение края разошлось
            бы с тем, что даст готовый ролик. }
          if AWithKey then
          begin
            if Clip.ColorKey.Enabled then
              Ov.Filter := Ov.Filter + ',' + ColorKeyFilter(Clip.ColorKey.Color,
                Clip.ColorKey.Similarity, Clip.ColorKey.Blend);
            if OpacityFilter(Clip.Opacity) <> '' then
              Ov.Filter := Ov.Filter + ',' + OpacityFilter(Clip.Opacity);
          end;

          SetLength(AOverlays, N + 1);
          AOverlays[N] := Ov;
          Inc(N);
        end;
      end;
    end;

    { По времени: список кусков оверлея строится подряд, дырами между
      ними. }
    for I := 1 to High(AOverlays) do
    begin
      Ov := AOverlays[I];
      C := I - 1;
      while (C >= 0) and (AOverlays[C].TlStart > Ov.TlStart) do
      begin
        AOverlays[C + 1] := AOverlays[C];
        Dec(C);
      end;
      AOverlays[C + 1] := Ov;
    end;

    Result := FlattenStream(AProject, tkVideo, Total, AVideo, AMissing, Hidden);
    if not Result then
      Exit;
    FlattenStream(AProject, tkAudio, Total, AAudio, MissA);
  finally
    Hidden.Free;
  end;

  for I := 0 to High(MissA) do
  begin
    SetLength(AMissing, Length(AMissing) + 1);
    AMissing[High(AMissing)] := MissA[I];
  end;
end;

end.