nlve/src/uProject.pas

{
  uProject — модель монтажа: список файлов, дорожки, клипы.

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

  Клип хранит, откуда берётся материал (SrcIn) и где он стоит на монтаже
  (TlStart), а длительность одна на оба конца. Отдельно помечено, как
  сделан каждый край: притянут к опорному кадру или должен быть точным.

  Отмена сделана снимками: перед каждым изменением состояние сохраняется
  целиком в виде JSON. Расточительно по памяти, но полностью надёжно —
  нет ни одного изменения, которое можно случайно забыть откатить. При
  тысячах клипов снимок весит сотни килобайт, что несопоставимо с
  весом самого видео.
}
unit uProject;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, contnrs, fpjson, uAppTypes, uMediaProbe, uKeyframeIndex,
  uTransform;

type
  { Как сделан край клипа.

    edSnap — рез притянут к опорному кадру, перекодирования нет.
    edPrecise — рез там, где просили; при сборке огрызок до опорного
    кадра придётся перекодировать. }
  TEdgeMode = (edSnap, edPrecise);

  { ckAudio — звуковой клип: картинку из него не берут.

    Отдельный вид, а не признак дорожки, потому что решение принимается по
    клипу: сборка спрашивает у куска, что из него доставать. }
  TClipKind = (ckVideo, ckImage, ckBlack, ckAudio);

  { На какие дорожки действует схлопывание.

    rmCurrentTrack — двигается только та дорожка, где идёт правка.
    rmAllTracks — двигаются все, чтобы дорожки не разъехались друг
    относительно друга. }
  TRippleMode = (rmCurrentTrack, rmAllTracks);

  { Файл, добавленный в проект. }
  TMediaItem = class
  private
    FId: string;
    FPath: string;
    FInfo: TMediaInfo;
    FNormalizedPath: string;
    FIndex: TKeyframeIndex;
    FIndexLoaded: Boolean;
    FTransform: TMediaTransform;
  public
    constructor Create;
    { Откуда реально брать материал: из нормализованной копии, если она
      сделана, иначе из исходника. }
    function EffectivePath: string;
    property Id: string read FId write FId;
    property Path: string read FPath write FPath;
    property Info: TMediaInfo read FInfo write FInfo;
    property NormalizedPath: string read FNormalizedPath write FNormalizedPath;
    property Index: TKeyframeIndex read FIndex write FIndex;
    property IndexLoaded: Boolean read FIndexLoaded write FIndexLoaded;
    { Как кадр этого файла ложится в кадр проекта. }
    property Transform: TMediaTransform read FTransform write FTransform;
  end;

  TClip = class
  private
    FId: string;
    FMediaId: string;
    FSrcIn: Double;
    FTlStart: Double;
    FDuration: Double;
    FEdgeIn: TEdgeMode;
    FEdgeOut: TEdgeMode;
    FKind: TClipKind;
    FSelected: Boolean;
    FVolume: Double;
    FTransform: TMediaTransform;
    FGroupId: string;
    FOpacity: Double;
    FFadeIn: Double;
    FFadeOut: Double;
  public
    constructor Create;
    function TlEnd: Double;
    function SrcOut: Double;
    { Попадает ли момент внутрь клипа. Правый край не включается: там уже
      начинается следующий клип. }
    function Covers(const ATime: Double): Boolean;
    property Id: string read FId write FId;
    property MediaId: string read FMediaId write FMediaId;
    property SrcIn: Double read FSrcIn write FSrcIn;
    property TlStart: Double read FTlStart write FTlStart;
    property Duration: Double read FDuration write FDuration;
    property EdgeIn: TEdgeMode read FEdgeIn write FEdgeIn;
    property EdgeOut: TEdgeMode read FEdgeOut write FEdgeOut;
    property Kind: TClipKind read FKind write FKind;
    { Громкость как множитель: 1 — как в исходнике, 0 — тишина, 2 — вдвое
      громче. Хранится множителем, а не в децибелах, чтобы не переводить
      туда-сюда при каждой отрисовке; в интерфейсе показывается процентами. }
    property Volume: Double read FVolume write FVolume;
    { Как кадр этого клипа ложится в кадр проекта.

      Настройка принадлежит клипу, а не файлу: два куска одного файла
      бывает нужно кадрировать по-разному. У файла остаётся такая же
      настройка, но она лишь заготовка — её берёт новый клип при
      добавлении. }
    property Transform: TMediaTransform read FTransform write FTransform;
    { Непрозрачность клипа картинки: 1 — обычный, 0.5 — сквозь него видно
      то, что ниже.

      Стоит понимать цену: как только клип перестаёт быть непрозрачным,
      его нельзя скопировать — участок приходится пересобирать вместе со
      всем, что под ним. Поэтому по умолчанию единица, и программа
      предупреждает перед сборкой, сколько секунд это займёт. }
    property Opacity: Double read FOpacity write FOpacity;
    { Плавное появление и уход, в секундах от краёв клипа. Для картинки
      это затемнение, для звука — нарастание громкости. }
    property FadeIn: Double read FFadeIn write FFadeIn;
    property FadeOut: Double read FFadeOut write FFadeOut;
    { Связка. Клипы с одинаковым непустым значением двигаются, режутся и
      удаляются вместе. По умолчанию так связаны картинка и её звук;
      Ctrl+G связывает и развязывает что угодно. }
    property GroupId: string read FGroupId write FGroupId;
    { Выделение живёт только в памяти и в файл проекта не пишется. }
    property Selected: Boolean read FSelected write FSelected;
  end;

  { Что живёт на дорожке. Картинка и звук разделены, потому что их можно
    двигать порознь: звук из одного места монтажа под картинкой из
    другого — обычное дело. }
  TTrackKind = (tkVideo, tkAudio);

  TTrack = class
  private
    FId: string;
    FName: string;
    FKind: TTrackKind;
    FMuted: Boolean;
    FSolo: Boolean;
    FClips: TObjectList;
    function GetClip(AIndex: Integer): TClip;
    function GetCount: Integer;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Add(AClip: TClip);
    procedure Remove(AClip: TClip);
    procedure Extract(AClip: TClip);
    procedure Sort;
    function ClipAt(const ATime: Double): TClip;
    function IndexOf(AClip: TClip): Integer;
    function EndTime: Double;
    property Clips[AIndex: Integer]: TClip read GetClip; default;
    property Count: Integer read GetCount;
    property Id: string read FId write FId;
    property Name: string read FName write FName;
    property Kind: TTrackKind read FKind write FKind;
    property Muted: Boolean read FMuted write FMuted;
    { Когда хоть у одной дорожки включено «соло», в результат идут только
      такие дорожки. Удобно, чтобы послушать одну, не выключая остальные
      по очереди. }
    property Solo: Boolean read FSolo write FSolo;
  end;

  TProject = class
  private
    FPool: TObjectList;
    FTracks: TObjectList;
    FMaster: TMediaInfo;
    FRippleMode: TRippleMode;
    FRippleEnabled: Boolean;
    FFileName: string;
    FModified: Boolean;
    FNextId: Integer;
    FUndo: TStringList;
    FRedo: TStringList;
    function GetPoolItem(AIndex: Integer): TMediaItem;
    function GetPoolCount: Integer;
    function GetTrack(AIndex: Integer): TTrack;
    function GetTrackCount: Integer;
    function NewId(const APrefix: string): string;
    function Serialize: string;
    procedure Deserialize(const AText: string);
  public
    constructor Create;
    destructor Destroy; override;

    procedure Clear;
    procedure NewProject;

    function AddMedia(const APath: string; const AInfo: TMediaInfo): TMediaItem;
    function FindMedia(const AId: string): TMediaItem;
    function FindMediaByPath(const APath: string): TMediaItem;
    procedure RemoveMedia(AItem: TMediaItem);

    { Номер новой связки. Отдельным именем, чтобы не пришлось помнить
      префикс в каждом месте, где связка заводится. }
    function NewGroupId: string;
    function AddTrack(const AName: string): TTrack;
    function AddTrackOfKind(const AName: string; AKind: TTrackKind): TTrack;
    function FindTrack(const AId: string): TTrack;
    procedure RemoveTrack(AIndex: Integer);
    procedure MoveTrack(AFrom, ATo: Integer);

    { Сколько дорожек каждого вида и как найти парную.

      Пара определяется порядковым номером: у первой дорожки картинки
      первая дорожка звука. Так связка «картинка плюс её звук» ложится
      напротив друг друга, и монтаж читается взглядом. }
    function TrackCountOf(AKind: TTrackKind): Integer;
    function TrackOfKind(AKind: TTrackKind; AIndex: Integer): TTrack;
    function IndexAmongKind(ATrack: TTrack): Integer;
    { Заводит недостающие звуковые дорожки, чтобы у каждой дорожки
      картинки была парная. }
    procedure EnsureAudioTracks;
    { Перенос проектов, записанных до разделения звука и картинки: там
      звук шёл вместе с клипом картинки, и без пары он бы просто пропал. }
    procedure MigrateAudio;
    { Кладёт клип и, если в файле есть звук, парный звуковой клип на
      соответствующую звуковую дорожку. Возвращает клип картинки. }
    function AddClipPair(ATrack: TTrack; AMedia: TMediaItem;
      const ASrcIn, ADuration, ATlStart: Double): TClip;
    function AddClip(ATrack: TTrack; AMedia: TMediaItem;
      const ASrcIn, ADuration, ATlStart: Double): TClip;
    function FindClipTrack(AClip: TClip): TTrack;
    procedure DeleteClip(AClip: TClip);
    procedure ClearSelection;
    function SelectedCount: Integer;

    { Общая длина монтажа — до конца самого правого клипа. }
    function EndTime: Double;

    { Есть ли хоть одна дорожка в режиме «соло». }
    function AnySolo: Boolean;
    { Участвует ли дорожка в результате с учётом выключения и «соло». }
    function TrackAudible(ATrack: TTrack): Boolean;

    { Параметры проекта берутся у первого добавленного видеофайла. }
    procedure AdoptMasterFrom(const AInfo: TMediaInfo);
    function MasterSet: Boolean;

    { Каталог для нарезки, сгенерированных клипов и кэша индексов. }
    function CacheDir: string;

    { Индекс опорных кадров файла, с запоминанием в памяти и на диске. }
    function KeyframeIndexOf(AItem: TMediaItem; out AIndex: TKeyframeIndex;
      out AError: string): Boolean;

    { --- Отмена --- }
    { Вызывать ПЕРЕД изменением. }
    procedure BeginChange;
    { Отменить заявку на изменение, если оно так и не состоялось.

      Нужно там, где намерение изменить возникает раньше самого изменения:
      нажали кнопку мыши на клипе, но отпустили не сдвинув. Без этого
      каждое такое нажатие оставляло бы в истории пустой шаг, и «отменить»
      приходилось бы жать по многу раз впустую. }
    procedure CancelChange;
    procedure Undo;
    procedure Redo;
    function CanUndo: Boolean;
    function CanRedo: Boolean;

    { --- Файл проекта --- }
    function SaveToFile(const APath: string; out AError: string): Boolean;
    function LoadFromFile(const APath: string; out AError: string): Boolean;

    property Pool[AIndex: Integer]: TMediaItem read GetPoolItem;
    property PoolCount: Integer read GetPoolCount;
    property Tracks[AIndex: Integer]: TTrack read GetTrack;
    property TrackCount: Integer read GetTrackCount;
    property Master: TMediaInfo read FMaster write FMaster;
    { Режим действует всегда, даже когда автосхлопывание выключено:
      он определяет, что сделает Ctrl+Shift+R. }
    property RippleMode: TRippleMode read FRippleMode write FRippleMode;
    { Автоматическое схлопывание при перетаскивании клипов. }
    property RippleEnabled: Boolean read FRippleEnabled write FRippleEnabled;
    property FileName: string read FFileName write FFileName;
    property Modified: Boolean read FModified write FModified;
  end;

const
  { Сколько длится картинка, пока её не растянули. }
  DefaultImageDuration = 5.0;

implementation

uses
  jsonparser, jsonscanner, Math;

const
  ProjectFormatVersion = 1;
  MaxUndoDepth = 100;

{ --- TMediaItem --- }

constructor TMediaItem.Create;
begin
  inherited Create;
  FTransform := DefaultTransform;
end;

function TMediaItem.EffectivePath: string;
begin
  if FNormalizedPath <> '' then
    Result := FNormalizedPath
  else
    Result := FPath;
end;

{ --- TClip --- }

constructor TClip.Create;
begin
  inherited Create;
  { Без явного значения множитель был бы нулём, то есть тишиной. }
  FVolume := 1;
  FOpacity := 1;
  FTransform := DefaultTransform;
end;

function TClip.TlEnd: Double;
begin
  Result := FTlStart + FDuration;
end;

function TClip.SrcOut: Double;
begin
  Result := FSrcIn + FDuration;
end;

function TClip.Covers(const ATime: Double): Boolean;
begin
  Result := (ATime >= FTlStart) and (ATime < TlEnd);
end;

{ --- TTrack --- }

constructor TTrack.Create;
begin
  inherited Create;
  FClips := TObjectList.Create(True);
end;

destructor TTrack.Destroy;
begin
  FClips.Free;
  inherited Destroy;
end;

function TTrack.GetClip(AIndex: Integer): TClip;
begin
  Result := TClip(FClips[AIndex]);
end;

function TTrack.GetCount: Integer;
begin
  Result := FClips.Count;
end;

procedure TTrack.Add(AClip: TClip);
begin
  FClips.Add(AClip);
  Sort;
end;

procedure TTrack.Remove(AClip: TClip);
begin
  FClips.Remove(AClip);
end;

procedure TTrack.Extract(AClip: TClip);
begin
  { Именно Extract, а не Remove: список владеет объектами и Remove их
    уничтожает, а при переносе клипа на другую дорожку он нужен живым. }
  FClips.Extract(AClip);
end;

function CompareClips(Item1, Item2: Pointer): Integer;
var
  A, B: TClip;
begin
  A := TClip(Item1);
  B := TClip(Item2);
  if A.TlStart < B.TlStart then
    Result := -1
  else if A.TlStart > B.TlStart then
    Result := 1
  else
    Result := 0;
end;

procedure TTrack.Sort;
begin
  FClips.Sort(@CompareClips);
end;

function TTrack.ClipAt(const ATime: Double): TClip;
var
  I: Integer;
begin
  { Клипы отсортированы и не перекрываются в пределах дорожки, так что
    достаточно линейного прохода. Дорожка редко содержит столько клипов,
    чтобы двоичный поиск дал заметную выгоду. }
  for I := 0 to FClips.Count - 1 do
    if TClip(FClips[I]).Covers(ATime) then
      Exit(TClip(FClips[I]));
  Result := nil;
end;

function TTrack.IndexOf(AClip: TClip): Integer;
begin
  Result := FClips.IndexOf(AClip);
end;

function TTrack.EndTime: Double;
var
  I: Integer;
begin
  Result := 0;
  for I := 0 to FClips.Count - 1 do
    Result := Max(Result, TClip(FClips[I]).TlEnd);
end;

{ --- TProject --- }

constructor TProject.Create;
begin
  inherited Create;
  FPool := TObjectList.Create(True);
  FTracks := TObjectList.Create(True);
  FUndo := TStringList.Create;
  FRedo := TStringList.Create;
  FNextId := 1;
end;

destructor TProject.Destroy;
begin
  FRedo.Free;
  FUndo.Free;
  FTracks.Free;
  FPool.Free;
  inherited Destroy;
end;

procedure TProject.Clear;
begin
  FPool.Clear;
  FTracks.Clear;
  FUndo.Clear;
  FRedo.Clear;
  { Именно Default, а не FillChar: в записи есть строки, и обнуление
    их указателей побайтно оставило бы память занятой навсегда. }
  FMaster := Default(TMediaInfo);
  FRippleMode := rmCurrentTrack;
  FRippleEnabled := False;
  FFileName := '';
  FModified := False;
  FNextId := 1;
end;

procedure TProject.NewProject;
begin
  Clear;
  { Две дорожки с самого начала: одна пустая дорожка не показывает главного —
    что верхняя перекрывает нижнюю. }
  { Две дорожки картинки и две звука. Звук снизу: так принято везде, и
    так он не мешает смотреть на картинку. }
  AddTrack('V1');
  AddTrack('V2');
  AddTrackOfKind('A1', tkAudio);
  AddTrackOfKind('A2', tkAudio);
  FModified := False;
end;

function TProject.GetPoolItem(AIndex: Integer): TMediaItem;
begin
  Result := TMediaItem(FPool[AIndex]);
end;

function TProject.GetPoolCount: Integer;
begin
  Result := FPool.Count;
end;

function TProject.GetTrack(AIndex: Integer): TTrack;
begin
  Result := TTrack(FTracks[AIndex]);
end;

function TProject.GetTrackCount: Integer;
begin
  Result := FTracks.Count;
end;

function TProject.NewGroupId: string;
begin
  Result := NewId('g');
end;

function TProject.NewId(const APrefix: string): string;
begin
  Result := APrefix + IntToStr(FNextId);
  Inc(FNextId);
end;

function TProject.AddMedia(const APath: string; const AInfo: TMediaInfo): TMediaItem;
begin
  Result := TMediaItem.Create;
  Result.Id := NewId('m');
  Result.Path := APath;
  Result.Info := AInfo;
  FPool.Add(Result);
  FModified := True;

  { Первый добавленный видеофайл задаёт параметры проекта: с ними будут
    сравниваться все следующие и в них будут генерироваться картинки. }
  if (not MasterSet) and (AInfo.Kind = mkVideo) then
    AdoptMasterFrom(AInfo);
end;

function TProject.FindMedia(const AId: string): TMediaItem;
var
  I: Integer;
begin
  for I := 0 to FPool.Count - 1 do
    if TMediaItem(FPool[I]).Id = AId then
      Exit(TMediaItem(FPool[I]));
  Result := nil;
end;

function TProject.FindMediaByPath(const APath: string): TMediaItem;
var
  I: Integer;
begin
  for I := 0 to FPool.Count - 1 do
    if TMediaItem(FPool[I]).Path = APath then
      Exit(TMediaItem(FPool[I]));
  Result := nil;
end;

procedure TProject.RemoveMedia(AItem: TMediaItem);
var
  T, C: Integer;
  Track: TTrack;
begin
  if AItem = nil then
    Exit;
  { Клипы, которые ссылались на файл, теряют смысл вместе с ним. }
  for T := 0 to FTracks.Count - 1 do
  begin
    Track := TTrack(FTracks[T]);
    for C := Track.Count - 1 downto 0 do
      if Track[C].MediaId = AItem.Id then
        Track.Remove(Track[C]);
  end;
  FPool.Remove(AItem);
  FModified := True;
end;

function TProject.AddTrack(const AName: string): TTrack;
begin
  Result := AddTrackOfKind(AName, tkVideo);
end;

function TProject.AddTrackOfKind(const AName: string;
  AKind: TTrackKind): TTrack;
var
  I, Pos: Integer;
begin
  Result := TTrack.Create;
  Result.Id := NewId('t');
  Result.Name := AName;
  Result.Kind := AKind;

  { Порядок дорожек не только украшение: он задаёт, кто побеждает при
    перекрытии. Картинка всегда выше звука, поэтому новая дорожка
    картинки встаёт перед первой звуковой, а не в самый конец. }
  if AKind = tkVideo then
  begin
    Pos := FTracks.Count;
    for I := 0 to FTracks.Count - 1 do
      if TTrack(FTracks[I]).Kind = tkAudio then
      begin
        Pos := I;
        Break;
      end;
    FTracks.Insert(Pos, Result);
  end
  else
    FTracks.Add(Result);

  FModified := True;
end;

function TProject.FindTrack(const AId: string): TTrack;
var
  I: Integer;
begin
  for I := 0 to FTracks.Count - 1 do
    if TTrack(FTracks[I]).Id = AId then
      Exit(TTrack(FTracks[I]));
  Result := nil;
end;

procedure TProject.RemoveTrack(AIndex: Integer);
begin
  if (AIndex < 0) or (AIndex >= FTracks.Count) then
    Exit;
  FTracks.Delete(AIndex);
  FModified := True;
end;

procedure TProject.MoveTrack(AFrom, ATo: Integer);
begin
  if (AFrom < 0) or (AFrom >= FTracks.Count) then
    Exit;
  if (ATo < 0) or (ATo >= FTracks.Count) then
    Exit;
  FTracks.Move(AFrom, ATo);
  FModified := True;
end;

function TProject.TrackCountOf(AKind: TTrackKind): Integer;
var
  I: Integer;
begin
  Result := 0;
  for I := 0 to FTracks.Count - 1 do
    if TTrack(FTracks[I]).Kind = AKind then
      Inc(Result);
end;

function TProject.TrackOfKind(AKind: TTrackKind; AIndex: Integer): TTrack;
var
  I, N: Integer;
begin
  Result := nil;
  N := 0;
  for I := 0 to FTracks.Count - 1 do
    if TTrack(FTracks[I]).Kind = AKind then
    begin
      if N = AIndex then
        Exit(TTrack(FTracks[I]));
      Inc(N);
    end;
end;

function TProject.IndexAmongKind(ATrack: TTrack): Integer;
var
  I, N: Integer;
begin
  Result := -1;
  N := 0;
  for I := 0 to FTracks.Count - 1 do
    if TTrack(FTracks[I]).Kind = ATrack.Kind then
    begin
      if TTrack(FTracks[I]) = ATrack then
        Exit(N);
      Inc(N);
    end;
end;

procedure TProject.MigrateAudio;
var
  T, C: Integer;
  Track, Dst: TTrack;
  Clip, Snd: TClip;
  Item: TMediaItem;
  Group: string;
  Sources: TFPList;
begin
  { Если звуковые дорожки уже есть, проект новый и переносить нечего. }
  if TrackCountOf(tkAudio) > 0 then
    Exit;
  if TrackCountOf(tkVideo) = 0 then
    Exit;

  EnsureAudioTracks;

  { Клипы собираются заранее: добавление в дорожку меняет её список, и
    перебирать его на ходу нельзя. }
  Sources := TFPList.Create;
  try
    for T := 0 to FTracks.Count - 1 do
    begin
      Track := TTrack(FTracks[T]);
      if Track.Kind <> tkVideo then
        Continue;
      for C := 0 to Track.Count - 1 do
        Sources.Add(Track[C]);
    end;

    for C := 0 to Sources.Count - 1 do
    begin
      Clip := TClip(Sources[C]);
      if Clip.Kind = ckBlack then
        Continue;
      Item := FindMedia(Clip.MediaId);
      if (Item = nil) or (not Item.Info.HasAudio) then
        Continue;

      Dst := nil;
      for T := 0 to FTracks.Count - 1 do
        if TTrack(FTracks[T]).IndexOf(Clip) >= 0 then
        begin
          Dst := TrackOfKind(tkAudio, IndexAmongKind(TTrack(FTracks[T])));
          Break;
        end;
      if Dst = nil then
        Continue;

      Group := NewId('g');
      Clip.GroupId := Group;
      Snd := AddClip(Dst, Item, Clip.SrcIn, Clip.Duration, Clip.TlStart);
      Snd.GroupId := Group;
      Snd.Kind := ckAudio;
      Snd.Volume := Clip.Volume;
    end;
  finally
    Sources.Free;
  end;

  for T := 0 to FTracks.Count - 1 do
    TTrack(FTracks[T]).Sort;
end;

procedure TProject.EnsureAudioTracks;
var
  Need, Have, I: Integer;
  Track: TTrack;
begin
  Need := TrackCountOf(tkVideo);
  Have := TrackCountOf(tkAudio);
  for I := Have to Need - 1 do
  begin
    Track := AddTrackOfKind('A' + IntToStr(I + 1), tkAudio);
  end;
end;

function TProject.AddClipPair(ATrack: TTrack; AMedia: TMediaItem;
  const ASrcIn, ADuration, ATlStart: Double): TClip;
var
  ATrackAudio: TTrack;
  Snd: TClip;
  Group: string;
begin
  Result := AddClip(ATrack, AMedia, ASrcIn, ADuration, ATlStart);
  if (ATrack.Kind <> tkVideo) or (not AMedia.Info.HasAudio) then
    Exit;

  EnsureAudioTracks;
  ATrackAudio := TrackOfKind(tkAudio, IndexAmongKind(ATrack));
  if ATrackAudio = nil then
    Exit;

  Group := NewId('g');
  Result.GroupId := Group;
  Snd := AddClip(ATrackAudio, AMedia, ASrcIn, ADuration, ATlStart);
  Snd.GroupId := Group;
  { Клип звука знает, что он звук: иначе сборка попыталась бы взять из
    него картинку. }
  Snd.Kind := ckAudio;
  Snd.Transform := DefaultTransform;
end;

function TProject.AddClip(ATrack: TTrack; AMedia: TMediaItem;
  const ASrcIn, ADuration, ATlStart: Double): TClip;
begin
  Result := TClip.Create;
  Result.Id := NewId('c');
  Result.MediaId := AMedia.Id;
  Result.SrcIn := ASrcIn;
  Result.Duration := ADuration;
  Result.TlStart := ATlStart;
  Result.EdgeIn := edSnap;
  Result.EdgeOut := edSnap;
  if AMedia.Info.Kind = mkImage then
    Result.Kind := ckImage
  else
    Result.Kind := ckVideo;
  { Настройка файла — заготовка: новый клип берёт её при добавлении и
    дальше живёт своей. }
  Result.Transform := AMedia.Transform;
  ATrack.Add(Result);
  FModified := True;
end;

function TProject.FindClipTrack(AClip: TClip): TTrack;
var
  I: Integer;
begin
  for I := 0 to FTracks.Count - 1 do
    if TTrack(FTracks[I]).IndexOf(AClip) >= 0 then
      Exit(TTrack(FTracks[I]));
  Result := nil;
end;

procedure TProject.DeleteClip(AClip: TClip);
var
  Track: TTrack;
begin
  Track := FindClipTrack(AClip);
  if Track <> nil then
  begin
    Track.Remove(AClip);
    FModified := True;
  end;
end;

procedure TProject.ClearSelection;
var
  T, C: Integer;
begin
  for T := 0 to FTracks.Count - 1 do
    for C := 0 to TTrack(FTracks[T]).Count - 1 do
      TTrack(FTracks[T])[C].Selected := False;
end;

function TProject.SelectedCount: Integer;
var
  T, C: Integer;
begin
  Result := 0;
  for T := 0 to FTracks.Count - 1 do
    for C := 0 to TTrack(FTracks[T]).Count - 1 do
      if TTrack(FTracks[T])[C].Selected then
        Inc(Result);
end;

function TProject.EndTime: Double;
var
  I: Integer;
begin
  Result := 0;
  for I := 0 to FTracks.Count - 1 do
    Result := Max(Result, TTrack(FTracks[I]).EndTime);
end;

function TProject.AnySolo: Boolean;
var
  I: Integer;
begin
  for I := 0 to FTracks.Count - 1 do
    if TTrack(FTracks[I]).Solo then
      Exit(True);
  Result := False;
end;

function TProject.TrackAudible(ATrack: TTrack): Boolean;
begin
  Result := False;
  if ATrack = nil then
    Exit;
  if ATrack.Muted then
    Exit;
  { «Соло» сильнее выключения: раз его включили, всё остальное молчит. }
  if AnySolo then
    Exit(ATrack.Solo);
  Result := True;
end;

procedure TProject.AdoptMasterFrom(const AInfo: TMediaInfo);
begin
  FMaster := AInfo;
  { Длительность конкретного файла к параметрам проекта отношения не имеет. }
  FMaster.Duration := 0;
  FModified := True;
end;

function TProject.MasterSet: Boolean;
begin
  Result := FMaster.Valid;
end;

function TProject.CacheDir: string;
begin
  if FFileName = '' then
    { Проект ещё не сохранён — держим кэш рядом с программой, чтобы не
      разбрасывать файлы по системным каталогам. }
    Result := IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0))) +
      'unsaved.nlve-cache' + PathDelim
  else
    Result := IncludeTrailingPathDelimiter(ExtractFilePath(FFileName)) +
      ChangeFileExt(ExtractFileName(FFileName), '') + '.nlve-cache' + PathDelim;
end;

function TProject.KeyframeIndexOf(AItem: TMediaItem; out AIndex: TKeyframeIndex;
  out AError: string): Boolean;
begin
  AError := '';
  if AItem = nil then
  begin
    AError := 'Файл не задан.';
    Exit(False);
  end;

  { Запоминание в памяти: за один экспорт индекс спрашивают столько раз,
    сколько кусков взято из файла. }
  if AItem.IndexLoaded then
  begin
    AIndex := AItem.Index;
    Exit(True);
  end;

  Result := CachedKeyframeIndex(CacheDir, AItem.EffectivePath, AIndex, AError);
  if Result then
  begin
    AItem.Index := AIndex;
    AItem.IndexLoaded := True;
  end;
end;

{ --- Отмена --- }

procedure TProject.BeginChange;
begin
  FUndo.Add(Serialize);
  while FUndo.Count > MaxUndoDepth do
    FUndo.Delete(0);
  { Новое действие обрывает ветку повторов: возвращаться уже некуда. }
  FRedo.Clear;
  FModified := True;
end;

procedure TProject.CancelChange;
begin
  if FUndo.Count = 0 then
    Exit;
  { Просто выбрасываем последний снимок. Именно выбрасываем, а не
    применяем: состояние и так не менялось, а применение засорило бы
    историю повторов. }
  FUndo.Delete(FUndo.Count - 1);
end;

function TProject.CanUndo: Boolean;
begin
  Result := FUndo.Count > 0;
end;

function TProject.CanRedo: Boolean;
begin
  Result := FRedo.Count > 0;
end;

procedure TProject.Undo;
var
  Snapshot: string;
begin
  if FUndo.Count = 0 then
    Exit;
  FRedo.Add(Serialize);
  Snapshot := FUndo[FUndo.Count - 1];
  FUndo.Delete(FUndo.Count - 1);
  Deserialize(Snapshot);
  FModified := True;
end;

procedure TProject.Redo;
var
  Snapshot: string;
begin
  if FRedo.Count = 0 then
    Exit;
  FUndo.Add(Serialize);
  Snapshot := FRedo[FRedo.Count - 1];
  FRedo.Delete(FRedo.Count - 1);
  Deserialize(Snapshot);
  FModified := True;
end;

{ --- Чтение и запись --- }

function JsonToTransform(AObj: TJSONObject): TMediaTransform;
begin
  Result := DefaultTransform;
  if AObj = nil then
    Exit;
  Result.Fit := StrToFitMode(AObj.Get('fit', 'fit'));
  Result.Rotation := AObj.Get('rotation', 0);
  Result.FlipH := AObj.Get('flip_h', False);
  Result.FlipV := AObj.Get('flip_v', False);
  Result.Zoom := AObj.Get('zoom', Double(1));
  Result.OffsetX := AObj.Get('offset_x', Double(0));
  Result.OffsetY := AObj.Get('offset_y', Double(0));
  if Result.Zoom <= 0 then
    Result.Zoom := 1;
end;

function RippleModeToStr(AMode: TRippleMode): string;
begin
  if AMode = rmAllTracks then
    Result := 'all'
  else
    Result := 'current';
end;

function StrToRippleMode(const AValue: string): TRippleMode;
begin
  if AValue = 'all' then
    Result := rmAllTracks
  else
    Result := rmCurrentTrack;
end;

function EdgeToStr(AEdge: TEdgeMode): string;
begin
  if AEdge = edPrecise then
    Result := 'precise'
  else
    Result := 'snap';
end;

function StrToEdge(const AValue: string): TEdgeMode;
begin
  if AValue = 'precise' then
    Result := edPrecise
  else
    Result := edSnap;
end;

function TrackKindToStr(AKind: TTrackKind): string;
begin
  if AKind = tkAudio then
    Result := 'audio'
  else
    Result := 'video';
end;

function StrToTrackKind(const AValue: string): TTrackKind;
begin
  if AValue = 'audio' then
    Result := tkAudio
  else
    Result := tkVideo;
end;

function KindToStr(AKind: TClipKind): string;
begin
  case AKind of
    ckImage: Result := 'image';
    ckBlack: Result := 'black';
  else
    Result := 'video';
  end;
end;

function StrToKind(const AValue: string): TClipKind;
begin
  if AValue = 'image' then
    Result := ckImage
  else if AValue = 'black' then
    Result := ckBlack
  else
    Result := ckVideo;
end;

function MediaKindToStr(AKind: TMediaKind): string;
begin
  case AKind of
    mkImage: Result := 'image';
    mkVideo: Result := 'video';
  else
    Result := 'unknown';
  end;
end;

function StrToMediaKind(const AValue: string): TMediaKind;
begin
  if AValue = 'image' then
    Result := mkImage
  else if AValue = 'video' then
    Result := mkVideo
  else
    Result := mkUnknown;
end;

function InfoToJson(const AInfo: TMediaInfo): TJSONObject;
begin
  Result := TJSONObject.Create;
  Result.Add('valid', AInfo.Valid);
  Result.Add('kind', MediaKindToStr(AInfo.Kind));
  Result.Add('format_name', AInfo.FormatName);
  Result.Add('duration', AInfo.Duration);
  Result.Add('has_video', AInfo.HasVideo);
  Result.Add('video_codec', AInfo.VideoCodec);
  Result.Add('video_profile', AInfo.VideoProfile);
  Result.Add('pix_fmt', AInfo.PixFmt);
  Result.Add('width', AInfo.Width);
  Result.Add('height', AInfo.Height);
  Result.Add('fps_num', AInfo.FpsNum);
  Result.Add('fps_den', AInfo.FpsDen);
  Result.Add('video_bitrate', AInfo.VideoBitrate);
  Result.Add('has_audio', AInfo.HasAudio);
  Result.Add('audio_codec', AInfo.AudioCodec);
  Result.Add('sample_rate', AInfo.SampleRate);
  Result.Add('channels', AInfo.Channels);
  Result.Add('channel_layout', AInfo.ChannelLayout);
  Result.Add('audio_bitrate', AInfo.AudioBitrate);
  Result.Add('extra_streams', AInfo.ExtraStreams);
end;

function JsonToInfo(AObj: TJSONObject): TMediaInfo;
begin
  Result := Default(TMediaInfo);
  if AObj = nil then
    Exit;
  Result.Valid := AObj.Get('valid', False);
  Result.Kind := StrToMediaKind(AObj.Get('kind', 'unknown'));
  Result.FormatName := AObj.Get('format_name', '');
  Result.Duration := AObj.Get('duration', Double(0));
  Result.HasVideo := AObj.Get('has_video', False);
  Result.VideoCodec := AObj.Get('video_codec', '');
  Result.VideoProfile := AObj.Get('video_profile', '');
  Result.PixFmt := AObj.Get('pix_fmt', '');
  Result.Width := AObj.Get('width', 0);
  Result.Height := AObj.Get('height', 0);
  Result.FpsNum := AObj.Get('fps_num', 0);
  Result.FpsDen := AObj.Get('fps_den', 0);
  Result.VideoBitrate := AObj.Get('video_bitrate', Int64(0));
  Result.HasAudio := AObj.Get('has_audio', False);
  Result.AudioCodec := AObj.Get('audio_codec', '');
  Result.SampleRate := AObj.Get('sample_rate', 0);
  Result.Channels := AObj.Get('channels', 0);
  Result.ChannelLayout := AObj.Get('channel_layout', '');
  Result.AudioBitrate := AObj.Get('audio_bitrate', Int64(0));
  Result.ExtraStreams := AObj.Get('extra_streams', 0);
end;

function TProject.Serialize: string;
var
  Root, Obj: TJSONObject;
  PoolArr, TracksArr, ClipsArr: TJSONArray;
  I, J: Integer;
  Item: TMediaItem;
  Track: TTrack;
  Clip: TClip;
begin
  Root := TJSONObject.Create;
  try
    Root.Add('version', ProjectFormatVersion);
    Root.Add('next_id', FNextId);
    Root.Add('master', InfoToJson(FMaster));

    PoolArr := TJSONArray.Create;
    for I := 0 to FPool.Count - 1 do
    begin
      Item := TMediaItem(FPool[I]);
      Obj := TJSONObject.Create;
      Obj.Add('id', Item.Id);
      Obj.Add('path', Item.Path);
      Obj.Add('normalized_path', Item.NormalizedPath);
      Obj.Add('info', InfoToJson(Item.Info));
      Obj.Add('transform', TJSONObject.Create([
        'fit', FitModeToStr(Item.Transform.Fit),
        'rotation', Item.Transform.Rotation,
        'flip_h', Item.Transform.FlipH,
        'flip_v', Item.Transform.FlipV,
        'zoom', Item.Transform.Zoom,
        'offset_x', Item.Transform.OffsetX,
        'offset_y', Item.Transform.OffsetY
      ]));
      PoolArr.Add(Obj);
    end;
    Root.Add('pool', PoolArr);

    TracksArr := TJSONArray.Create;
    for I := 0 to FTracks.Count - 1 do
    begin
      Track := TTrack(FTracks[I]);
      Obj := TJSONObject.Create;
      Obj.Add('id', Track.Id);
      Obj.Add('name', Track.Name);
      Obj.Add('kind', TrackKindToStr(Track.Kind));
      Obj.Add('muted', Track.Muted);
      Obj.Add('solo', Track.Solo);

      ClipsArr := TJSONArray.Create;
      for J := 0 to Track.Count - 1 do
      begin
        Clip := Track[J];
        ClipsArr.Add(TJSONObject.Create([
          'id', Clip.Id,
          'media', Clip.MediaId,
          'src_in', Clip.SrcIn,
          'tl_start', Clip.TlStart,
          'duration', Clip.Duration,
          'edge_in', EdgeToStr(Clip.EdgeIn),
          'edge_out', EdgeToStr(Clip.EdgeOut),
          'kind', KindToStr(Clip.Kind),
          'group', Clip.GroupId,
          'volume', Clip.Volume,
          'opacity', Clip.Opacity,
          'fade_in', Clip.FadeIn,
          'fade_out', Clip.FadeOut,
          'transform', TJSONObject.Create([
            'fit', FitModeToStr(Clip.Transform.Fit),
            'rotation', Clip.Transform.Rotation,
            'flip_h', Clip.Transform.FlipH,
            'flip_v', Clip.Transform.FlipV,
            'zoom', Clip.Transform.Zoom,
            'offset_x', Clip.Transform.OffsetX,
            'offset_y', Clip.Transform.OffsetY
          ])
        ]));
      end;
      Obj.Add('clips', ClipsArr);
      TracksArr.Add(Obj);
    end;
    Root.Add('tracks', TracksArr);

    Root.Add('settings', TJSONObject.Create([
      'ripple_mode', RippleModeToStr(FRippleMode),
      'ripple_enabled', FRippleEnabled
    ]));

    Result := Root.FormatJSON;
  finally
    Root.Free;
  end;
end;

procedure TProject.Deserialize(const AText: string);
var
  Parser: TJSONParser;
  Root: TJSONData;
  Obj, ItemObj, TrackObj, ClipObj, Settings: TJSONObject;
  Arr, ClipsArr: TJSONArray;
  I, J: Integer;
  Item, Media: TMediaItem;
  Track: TTrack;
  Clip: TClip;
begin
  FPool.Clear;
  FTracks.Clear;

  Parser := TJSONParser.Create(AText, [joUTF8]);
  try
    Root := Parser.Parse;
  finally
    Parser.Free;
  end;

  if (Root = nil) or (not (Root is TJSONObject)) then
  begin
    Root.Free;
    Exit;
  end;

  try
    Obj := TJSONObject(Root);
    FNextId := Obj.Get('next_id', 1);
    FMaster := JsonToInfo(Obj.Find('master', jtObject) as TJSONObject);

    Arr := Obj.Find('pool', jtArray) as TJSONArray;
    if Arr <> nil then
      for I := 0 to Arr.Count - 1 do
      begin
        if not (Arr.Items[I] is TJSONObject) then
          Continue;
        ItemObj := TJSONObject(Arr.Items[I]);
        Item := TMediaItem.Create;
        Item.Id := ItemObj.Get('id', '');
        Item.Path := ItemObj.Get('path', '');
        Item.NormalizedPath := ItemObj.Get('normalized_path', '');
        Item.Info := JsonToInfo(ItemObj.Find('info', jtObject) as TJSONObject);
        Item.Transform := JsonToTransform(
          ItemObj.Find('transform', jtObject) as TJSONObject);
        FPool.Add(Item);
      end;

    Arr := Obj.Find('tracks', jtArray) as TJSONArray;
    if Arr <> nil then
      for I := 0 to Arr.Count - 1 do
      begin
        if not (Arr.Items[I] is TJSONObject) then
          Continue;
        TrackObj := TJSONObject(Arr.Items[I]);
        Track := TTrack.Create;
        Track.Id := TrackObj.Get('id', '');
        Track.Name := TrackObj.Get('name', '');
        Track.Kind := StrToTrackKind(TrackObj.Get('kind', 'video'));
        Track.Muted := TrackObj.Get('muted', False);
        Track.Solo := TrackObj.Get('solo', False);
        FTracks.Add(Track);

        ClipsArr := TrackObj.Find('clips', jtArray) as TJSONArray;
        if ClipsArr <> nil then
          for J := 0 to ClipsArr.Count - 1 do
          begin
            if not (ClipsArr.Items[J] is TJSONObject) then
              Continue;
            ClipObj := TJSONObject(ClipsArr.Items[J]);
            Clip := TClip.Create;
            Clip.Id := ClipObj.Get('id', '');
            Clip.MediaId := ClipObj.Get('media', '');
            Clip.SrcIn := ClipObj.Get('src_in', Double(0));
            Clip.TlStart := ClipObj.Get('tl_start', Double(0));
            Clip.Duration := ClipObj.Get('duration', Double(0));
            Clip.EdgeIn := StrToEdge(ClipObj.Get('edge_in', 'snap'));
            Clip.EdgeOut := StrToEdge(ClipObj.Get('edge_out', 'snap'));
            Clip.Kind := StrToKind(ClipObj.Get('kind', 'video'));
            Clip.Volume := ClipObj.Get('volume', Double(1));
            Clip.GroupId := ClipObj.Get('group', '');
            Clip.Opacity := ClipObj.Get('opacity', Double(1));
            Clip.FadeIn := ClipObj.Get('fade_in', Double(0));
            Clip.FadeOut := ClipObj.Get('fade_out', Double(0));
            { Проекты, записанные до появления кадрирования у клипа,
              берут его у файла — там оно и хранилось раньше. }
            if ClipObj.Find('transform') <> nil then
              Clip.Transform := JsonToTransform(
                ClipObj.Get('transform', TJSONObject(nil)))
            else
            begin
              Media := FindMedia(Clip.MediaId);
              if Media <> nil then
                Clip.Transform := Media.Transform;
            end;
            Track.Add(Clip);
          end;
        Track.Sort;
      end;

    MigrateAudio;

    Settings := Obj.Find('settings', jtObject) as TJSONObject;
    if Settings <> nil then
    begin
      FRippleMode := StrToRippleMode(Settings.Get('ripple_mode', 'current'));
      FRippleEnabled := Settings.Get('ripple_enabled', False);
      { Старые проекты хранили один флаг «все дорожки». }
      if Settings.Get('ripple_all_tracks', False) then
        FRippleMode := rmAllTracks;
    end;
  finally
    Root.Free;
  end;
end;

function TProject.SaveToFile(const APath: string; out AError: string): Boolean;
var
  Text: TStringList;
begin
  AError := '';
  Result := False;
  Text := TStringList.Create;
  try
    { Имя файла назначаем до записи: от него зависит путь к кэшу, который
      попадает внутрь проекта косвенно — через сгенерированные клипы. }
    FFileName := ExpandFileName(APath);
    Text.Text := Serialize;
    try
      Text.SaveToFile(FFileName);
      FModified := False;
      Result := True;
    except
      on E: Exception do
        AError := 'Не удалось сохранить проект: ' + E.Message;
    end;
  finally
    Text.Free;
  end;
end;

function TProject.LoadFromFile(const APath: string; out AError: string): Boolean;
var
  Text: TStringList;
begin
  AError := '';
  Result := False;
  if not FileExists(APath) then
  begin
    AError := 'Файл проекта не найден: ' + APath;
    Exit;
  end;

  Text := TStringList.Create;
  try
    try
      Text.LoadFromFile(APath);
      Clear;
      Deserialize(Text.Text);
      FFileName := ExpandFileName(APath);
      FModified := False;
      Result := True;
    except
      on E: Exception do
        AError := 'Не удалось прочитать проект: ' + E.Message;
    end;
  finally
    Text.Free;
  end;
end;

end.