nlve/src/uMainForm.pas

{
  uMainForm — главное окно редактора.

  Собирает вместе всё остальное: список файлов проекта, монтажный стол,
  предпросмотр через mpv и сборку через ffmpeg.

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

  Время на монтаже и время в предпросмотре совпадают в точности, потому
  что список кусков покрывает отрезок от нуля до конца монтажа без
  пропусков — дыры превращаются в чёрные вставки. Благодаря этому курсор
  можно двигать в обе стороны: щелчок по линейке перематывает плеер, а
  воспроизведение двигает курсор.
}
unit uMainForm;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
  ComCtrls, Menus, Buttons, LCLType, LMessages,
  uAppTypes, uEdl, uMpvLib, uMpvPlayer, uProject, uMediaProbe, uTimelineCtrl,
  uFlatten, uGenerate, uExport, uEncodeForm, uAboutForm, uProgressForm,
  uRemuxForm, uMismatchForm,
  uFfmpegJob, uSettings, uThumbs, uTransform, uPanCropForm,
  uProjectInfoForm, ImgList, uTheme, uLogView, uDepsForm, uWaveform,
  uIconData, uSubtitles, uTextMeasure, uTextForm, uExportForm,
  uColorKeyForm;

const
  { Номера системных сообщений о перерисовке рамки окна. Берём числами, а
    не из модуля Windows: тот переопределяет TRect и Point, и обычные
    вызовы LCL начинают разбираться как системные. }
  MsgNcPaint = $0085;
  MsgNcActivate = $0086;

type

  { TMainForm }

  TMainForm = class(TForm)

    btnSnap: TThemedButton;
    btnGlue: TThemedButton;
    btnRipple: TThemedButton;
    btnRippleMenu: TThemedButton;
    lblPoolInfo: TLabel;
    lblStatus: TLabel;
    lblTime: TLabel;

    lstPool: TListBox;
    memoLog: TLogView;
    OpenMediaDialog: TOpenDialog;
    OpenProjectDialog: TOpenDialog;
    pnlBottom: TPanel;
    pnlLeft: TPanel;
    pnlMain: TPanel;
    pnlTimelineHost: TPanel;
    pnlVideo: TPanel;
    SaveExportDialog: TSaveDialog;
    SaveProjectDialog: TSaveDialog;
    splitVideo: TSplitter;
    procedure btnSnapClick(Sender: TObject);
    procedure btnGlueClick(Sender: TObject);
    procedure btnRippleClick(Sender: TObject);
    procedure btnRippleMenuClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormShow(Sender: TObject);
    {$IFDEF LCLWIN32}
    { Остаток полосы меню закрашивается после того, как система нарисовала
      рамку окна. Раньше — бесполезно: она закрасит поверх. }
    procedure WMNCPaint(var Msg: TLMessage); message MsgNcPaint;
    procedure WMNCActivate(var Msg: TLMessage); message MsgNcActivate;
    {$ENDIF}
    procedure lstPoolClick(Sender: TObject);
    procedure lstPoolMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure lstPoolDrawItem(Control: TWinControl; Index: Integer;
      ARect: TRect; State: TOwnerDrawState);
  private
    FProject: TProject;
    FTimeline: TTimelineControl;
    FPlayer: TMpvPlayer;
    FStarted: Boolean;

    FPreviewTimer: TTimer;
    FPreviewDirty: Boolean;
    FUpdatingFromPlayer: Boolean;
    FLastLoadedEdl: string;
    FLastLoadedAudioEdl: string;
    { Наложение для плеера: список кусков оверлея и окна показа. }
    FPreviewOverlayUrl: string;
    FPreviewOverlayWindows: TOverlayWindows;
    { Списки кусков звуковых дорожек для плеера. }
    FPreviewAudioUrls: array of string;
    { Звуковые дорожки предпросмотра — их номера в проекте, а не сами
      объекты.

      Указатели здесь были ловушкой: отмена и открытие проекта
      пересоздают все дорожки, а этот список продолжал показывать на
      освобождённую память. Обращение к нему идёт на каждое обновление
      времени при воспроизведении, то есть десятки раз в секунду. }
    FPreviewAudioTracks: array of string;
    FLastHwdec: string;
    FLastAudioNote: string;
    FLogFilePath: string;
    FLogFileStarted: Boolean;
    FLogFileBroken: Boolean;
    FMenu: TMainMenu;
    { Отложенный показ списка меню. Номер списка и точка, где его
      раскрыть; таймер срабатывает один раз. }
    { Показ фоновой работы. Пока что-то считается в стороне от окна,
      здесь видно, что именно и сколько осталось. }
    FJobLabel: TLabel;
    FJobBar: TThemedProgress;
    FJobTimer: TTimer;
    { Что выбрали в окне сборки в прошлый раз. Держится между вызовами,
      чтобы не задавать один и тот же вопрос заново. }
    FExportChoice: TExportChoice;
    { Сколько внутренних ошибок уже случилось. Окно показываем только на
      первую. }
    FErrorCount: Integer;
    FLogButton: TThemedButton;
    { Пункт «Ключ и прозрачность в предпросмотре»: галку в нём приходится
      держать за руку — она не следует за настройкой сама. }
    FKeyPreviewItem: TMenuItem;
    { Показанная доля выполнения. Отдельно от настоящей, потому что растёт
      она по своим правилам — см. AdvanceJobBar. }
    FJobShown: Double;
    { Настоящая доля и доля следующей вехи. Между вехами полоска ползёт
      сама, замедляясь. }
    FJobReal: Double;
    FJobNext: Double;
    { Какая именно работа идёт. При смене занятия полоска начинается
      заново: иначе новая работа унаследовала бы почти полную полосу от
      предыдущей и стояла бы на месте до самого конца. }
    FJobKind: Integer;
    { Уплощённый монтаж, отданный плееру. Хранится, чтобы по времени
      находить звучащий кусок и брать у него громкость. }
    FPreviewSegments: TFlatSegmentArray;
    FLastVolumeSent: Double;
    FLastVolumeKey: string;

    FGenerate: TGenerateThread;
    FGenerateBusy: Boolean;

    FExport: TExportThread;
    FExportUi: TProgressForm;

    FNormalize: TFfmpegJob;
    FNormalizeUi: TProgressForm;

    FSettings: TSettings;

    FThumbs: TImageList;
    FThumbThread: TThumbThread;
    FPeaksThread: TPeaksThread;
    FPeaksRestart: Boolean;
    FPeaksFinished: Boolean;
    { Соответствие «путь к файлу -> номер картинки в списке изображений».
      По пути, а не по номеру в списке проекта: пока миниатюра делается,
      файлы могут добавиться или пропасть. Номер хранится увеличенным на
      единицу, потому что ноль в Objects неотличим от «ничего нет». }
    FThumbMap: TStringList;

    { Меню библиотеки и меню выбора режима схлопывания. }
    FPoolMenu: TPopupMenu;
    FPoolAddMenu: TMenuItem;
    FRippleMenu: TPopupMenu;
    { Пункт «Недавние проекты» в меню «Файл». Его содержимое собирается
      заново при каждом изменении списка. }
    FRecentMenu: TMenuItem;

    { Пока плеер не доехал до запрошенного места, его сообщения о позиции
      игнорируются. Без этого перезагрузка предпросмотра после правки
      сбрасывала бы курсор в начало. }
    FSeekPending: Boolean;
    FSeekTarget: Double;
    { Сколько сообщений о позиции ждём прибытия, прежде чем сдаться.

      Без этого ограничения признак «ждём» мог зависнуть навсегда: если
      после правки монтажа запрошенное время оказалось за его концом,
      плеер туда никогда не доедет, и курсор переставал двигаться
      совсем. }
    FSeekWaitTicks: Integer;

    procedure ApplyVolumeAt(const ATime: Double);
    { Переписывает файл субтитров и отдаёт его плееру. }
    procedure UpdateSubtitles;
    procedure UpdateRippleButton;
    procedure UpdateSnapButton;
    procedure UpdateGlueButton;
    procedure RippleModeChosen(Sender: TObject);
    procedure ToggleRipple;
    procedure BuildPoolMenu;
    procedure RefreshRecentMenu;
    procedure OpenRecentProject(Sender: TObject);
    function OpenProjectFile(const APath: string): Boolean;
    procedure PoolMenuPopup(Sender: TObject);
    procedure PoolAddToTrack(Sender: TObject);
    procedure PoolRemoveFromTracks(Sender: TObject);
    procedure PoolRemoveFromProject(Sender: TObject);
    procedure PoolEditTransform(Sender: TObject);
    procedure TimelineClipTransform(Sender: TObject; AClip: TClip);
    procedure MenuProjectInfo(Sender: TObject);
    procedure FormFilesDropped(Sender: TObject; const FileNames: array of string);
    function ThumbIndexFor(const APath: string): Integer;
    procedure ApplySettings;
    procedure CollectSettings;
    procedure StartThumbs;
    procedure StartPeaks;
    procedure PeaksReady(Sender: TObject; const ASourcePath: string);
    procedure PeaksDone(Sender: TObject);
    procedure ThumbReady(Sender: TObject; const ASourcePath,
      AThumbPath: string);
    procedure SeekPlayerTo(const ATime: Double);
    procedure TogglePlayback;

    procedure TimelineMediaDrop(Sender: TObject; ASource: TObject;
      ATrackIndex: Integer; const ATime: Double);
    procedure TimelineTrackAdded(Sender: TObject);
    procedure TimelineActiveTrackChange(Sender: TObject);
    function AddClipFromPool(APoolIndex, ATrackIndex: Integer;
      const ATime: Double): Boolean;

    { --- окно и меню --- }
    procedure BuildMenu;
    { Разбор внутренней ошибки: пишет в журнал место, где она случилась. }
    procedure HandleException(Sender: TObject; E: Exception);
    procedure ApplyWindowIcon;
    procedure BuildJobIndicator;
    procedure JobTimerTick(Sender: TObject);
    procedure AdvanceJobBar;
    procedure LogButtonClick(Sender: TObject);
    procedure MenuToggleLog(Sender: TObject);
    procedure MenuTogglePreviewKey(Sender: TObject);
    procedure MenuAbout(Sender: TObject);
    procedure MenuAddText(Sender: TObject);
    { Открывает редактор текста для клипа. True — что-то изменилось. }
    function EditTextOf(AClip: TClip): Boolean;
    procedure ApplyLogVisible(AVisible: Boolean);
    procedure BuildTimeline;
    procedure StartPlayer;
    { Чего не хватает для работы. Пустая строка — всё на месте. }
    function MissingDeps: string;
    procedure RemindAboutDeps;
    procedure Log(const AText: string);
    procedure LogToFile(const AText: string);
    procedure SetStatus(const AText: string);
    procedure UpdateCaption;
    procedure UpdateTimeLabel;
    procedure RefreshPool;


    { --- предпросмотр --- }
    procedure PrewarmInserts;
    procedure SchedulePreview;
    procedure PreviewTimerTick(Sender: TObject);
    { Есть ли на монтаже файл другого соотношения сторон. Только ради
      таких файлов и нужен фильтр в предпросмотре. }
    function PreviewNeedsFitting: Boolean;
    { Заставляет предпросмотр показывать кадр проекта, а не кадр исходника. }
    procedure ApplyPreviewFrame;
    procedure RebuildPreview;
    procedure LoadPreviewEdl(const ASegments, AAudio: TFlatSegmentArray);
    procedure BuildOverlayPreview(const AOverlays: TPreviewOverlays;
      const ATotal: Double);
    procedure GenerateDone(Sender: TObject);
    procedure GenerateProgress(Sender: TObject);
    procedure GenerateLog(Sender: TObject);

    { --- обработчики компонентов --- }
    procedure TimelinePlayheadChange(Sender: TObject);
    procedure TimelineStructureChange(Sender: TObject);
    procedure TimelineSelectionChange(Sender: TObject);
    procedure PlayerLog(Sender: TObject; const APrefix, ALevel, AText: string);
    procedure PlayerTimePos(Sender: TObject);
    procedure PlayerDuration(Sender: TObject);
    procedure PlayerPauseChange(Sender: TObject);

    { --- пункты меню --- }
    procedure MenuNewProject(Sender: TObject);
    procedure MenuOpenProject(Sender: TObject);
    procedure MenuSaveProject(Sender: TObject);
    procedure MenuSaveProjectAs(Sender: TObject);
    procedure MenuExport(Sender: TObject);
    procedure MenuExportEncode(Sender: TObject);
    procedure DoExport(const AProfile: TEncodeProfile);
    procedure MenuRemux(Sender: TObject);
    procedure MenuDeps(Sender: TObject);
    procedure MenuQuit(Sender: TObject);
    procedure MenuUndo(Sender: TObject);
    procedure MenuRedo(Sender: TObject);
    procedure MenuSplit(Sender: TObject);
    procedure MenuSplitPrecise(Sender: TObject);
    procedure MenuDelete(Sender: TObject);
    procedure MenuColorKey(Sender: TObject);
    procedure MenuRegionIn(Sender: TObject);
    procedure MenuRegionOut(Sender: TObject);
    procedure MenuRegionClear(Sender: TObject);
    { Что и откуда собирать: с учётом отмеченного участка. }
    procedure DescribeRegion(out AFrom, ATo: Double);
    procedure MenuSelectAll(Sender: TObject);
    procedure MenuRipple(Sender: TObject);
    procedure MenuToggleRipple(Sender: TObject);
    procedure MenuGoStart(Sender: TObject);
    procedure MenuGoEnd(Sender: TObject);
    procedure MenuZoomFit(Sender: TObject);
    procedure MenuZoomIn(Sender: TObject);
    procedure MenuZoomOut(Sender: TObject);
    procedure MenuAddTrack(Sender: TObject);
    procedure MenuRemoveTrack(Sender: TObject);

    { --- вспомогательное --- }
    function SaveProjectAs: Boolean;
    function DoSaveProject: Boolean;
    function ConfirmDiscard: Boolean;
    procedure AddMediaFile(const APath: string);
    procedure ChooseAndAddFiles(Sender: TObject);
    procedure ExportProgress(Sender: TObject);
    procedure ExportLog(Sender: TObject);
    procedure ExportDone(Sender: TObject);
    procedure ExportCancel(Sender: TObject);
    procedure ShowExportReport(const AReport: TExportReport);
    procedure NormalizeProgress(Sender: TObject);
    procedure NormalizeLog(Sender: TObject);
    procedure NormalizeDone(Sender: TObject);
    procedure NormalizeCancel(Sender: TObject);
  end;

var
  MainFormInstance: TMainForm;

implementation

{$R *.lfm}

uses
  Math, uProcRunner, uFfmpegCmd;

const
  { Задержка пересборки предпросмотра. Правка монтажа сообщается один раз,
    по окончании перетаскивания, поэтому задержка нужна лишь чтобы склеить
    несколько правок подряд — и должна быть маленькой: пока она идёт,
    предпросмотр играет старую расстановку, а на монтаже уже новая. }
  PreviewDebounceMs = 120;

  { Сколько сообщений о позиции ждать прибытия после перемотки.
    Сообщения приходят на каждый кадр, так что это доли секунды. }
  MaxSeekWaitTicks = 90;

function FormatTimecode(const Seconds: Double): string;
var
  Total, H, M, S, Ms: Integer;
begin
  if Seconds < 0 then
    Exit('--:--:--.---');
  Total := Trunc(Seconds);
  Ms := Round(Frac(Seconds) * 1000);
  if Ms > 999 then
    Ms := 999;
  H := Total div 3600;
  M := (Total mod 3600) div 60;
  S := Total mod 60;
  Result := Format('%.2d:%.2d:%.2d.%.3d', [H, M, S, Ms]);
end;

{ --- Создание окна --- }

procedure TMainForm.FormCreate(Sender: TObject);
begin
  FSettings := TSettings.Create;
  FSettings.Load;

  FProject := TProject.Create;
  FProject.NewProject;

  BuildMenu;
  BuildTimeline;
  ApplySettings;

  pnlVideo.Color := clBlack;
  memoLog.Clear;
  FLogFilePath := ProgramDir + 'nlve.log';

  FPlayer := TMpvPlayer.Create(pnlVideo);
  FPlayer.OnLog := @PlayerLog;
  FPlayer.OnTimePos := @PlayerTimePos;
  FPlayer.OnDuration := @PlayerDuration;
  FPlayer.OnPauseChange := @PlayerPauseChange;

  FPreviewTimer := TTimer.Create(Self);
  FPreviewTimer.Enabled := False;
  FPreviewTimer.Interval := PreviewDebounceMs;
  FPreviewTimer.OnTimer := @PreviewTimerTick;

  { Список изображений держит миниатюры. Размер задан жёстко, и ffmpeg
    делает их ровно такими: список изображений в LCL требует одинакового
    размера у всех элементов. }
  FThumbs := TImageList.Create(Self);
  FThumbs.Width := ThumbWidth;
  FThumbs.Height := ThumbHeight;

  FThumbMap := TStringList.Create;
  FThumbMap.Sorted := True;
  FThumbMap.Duplicates := dupIgnore;

  { Список рисуется вручную.

    Готовый режим значков в LCL под gtk2 работает плохо: там TListView
    построен на дереве, и крупные значки он попросту игнорирует. Своя
    отрисовка надёжнее и заодно позволяет показать рядом с кадром
    название и параметры файла. }
  lstPool.Style := lbOwnerDrawFixed;
  lstPool.ItemHeight := ThumbHeight + 10;
  { Перетаскивание из списка на монтаж начинается само. }
  lstPool.DragMode := dmAutomatic;

  BuildPoolMenu;
  RefreshRecentMenu;
  AllowDropFiles := True;
  OnDropFiles := @FormFilesDropped;

  RefreshPool;
  UpdateRippleButton;
  UpdateSnapButton;
  UpdateGlueButton;
  UpdateCaption;
  SetStatus('Готов. Добавьте файлы в проект.');

  { Цвета задаём сами: системная тема может быть светлой, и тогда тёмный
    таймлайн оказался бы в белой рамке. Вызов идёт последним — меню и
    всплывающие меню строятся выше по ходу, и раньше их не существует. }
  ApplyDarkTheme(Self);
end;

{ Каждый шаг закрытия отмечается в журнале.

  Под Wine программа зависала при выходе, и по молчаливому журналу
  понять, на чём именно, нельзя: последняя запись оставалась от работы, а
  не от закрытия. Записи дешёвые, а без них искать пришлось бы наугад. }
procedure TMainForm.FormDestroy(Sender: TObject);
begin
  Log('Закрытие: останавливаю предпросмотр.');
  FPreviewTimer.Enabled := False;
  if Assigned(FThumbThread) then
  begin
    Log('Закрытие: жду поток миниатюр.');
    { Поток обращается к форме через Synchronize, поэтому дожидаться его
      обязательно: иначе он попробует достучаться до уже разрушенного окна. }
    FThumbThread.Terminate;
    FThumbThread.WaitFor;
    FreeAndNil(FThumbThread);
  end;
  if Assigned(FPeaksThread) then
  begin
    Log('Закрытие: жду разбор звука.');
    { При закрытии ждать приходится: поток обращается к окну. Ждать
      недолго — запущенный ffmpeg прерывается по тому же признаку. }
    FPeaksRestart := False;
    FPeaksThread.Terminate;
    FPeaksThread.WaitFor;
    FreeAndNil(FPeaksThread);
  end;
  FreeAndNil(FThumbMap);
  Log('Закрытие: сохраняю настройки.');
  CollectSettings;
  FSettings.Save;
  FreeAndNil(FSettings);
  Log('Закрытие: закрываю плеер.');
  FreeAndNil(FPlayer);

  { Библиотеку не выгружаем.

    Плеер отсоединяется от mpv, не дожидаясь, пока ядро добьёт свои
    потоки, — иначе под Wine ожидание не кончалось вовсе. Значит, в
    момент выхода эти потоки могут ещё жить внутри библиотеки, и
    выгружать её из-под них нельзя. Программа всё равно закрывается,
    и система освободит всё сама. }
  Log('Закрытие: освобождаю проект.');
  FreeAndNil(FProject);
  Log('Закрытие завершено.');
  { Сами списки принадлежат форме и уничтожатся с ней; здесь только
    перечень ссылок на них. }
end;

procedure TMainForm.ApplySettings;
begin
  if (FSettings.WindowLeft >= 0) and (FSettings.WindowTop >= 0) then
  begin
    Position := poDesigned;
    Left := FSettings.WindowLeft;
    Top := FSettings.WindowTop;
  end;
  Width := FSettings.WindowWidth;
  Height := FSettings.WindowHeight;
  if FSettings.WindowMaximized then
    WindowState := wsMaximized;

  pnlVideo.Height := FSettings.VideoPanelHeight;
  FTimeline.TrackHeight := FSettings.TrackHeight;
  FTimeline.WaveGain := FSettings.WaveGain;

  { Режим схлопывания и его состояние переживают перезапуск. }
  if FSettings.RippleAllTracks then
    FProject.RippleMode := rmAllTracks
  else
    FProject.RippleMode := rmCurrentTrack;
  FProject.RippleEnabled := FSettings.RippleEnabled;
  FTimeline.PlayheadSnap := FSettings.PlayheadSnap;

  { Каталоги подставляем в диалоги, чтобы не искать одно и то же место
    заново при каждом запуске. }
  if FSettings.LastMediaDir <> '' then
    OpenMediaDialog.InitialDir := FSettings.LastMediaDir;
  if FSettings.LastProjectDir <> '' then
  begin
    OpenProjectDialog.InitialDir := FSettings.LastProjectDir;
    SaveProjectDialog.InitialDir := FSettings.LastProjectDir;
  end;
  if FSettings.LastExportDir <> '' then
    SaveExportDialog.InitialDir := FSettings.LastExportDir;
end;

procedure TMainForm.CollectSettings;
begin
  FSettings.WindowMaximized := WindowState = wsMaximized;
  { Развёрнутое окно запоминать по координатам бессмысленно: они не те,
    что были до разворачивания. }
  if WindowState = wsNormal then
  begin
    FSettings.WindowLeft := Left;
    FSettings.WindowTop := Top;
    FSettings.WindowWidth := Width;
    FSettings.WindowHeight := Height;
  end;
  FSettings.VideoPanelHeight := pnlVideo.Height;
  FSettings.LogVisible := memoLog.Visible;
  FSettings.RippleAllTracks := FProject.RippleMode = rmAllTracks;
  FSettings.RippleEnabled := FProject.RippleEnabled;
  FSettings.PlayheadSnap := FTimeline.PlayheadSnap;
  FSettings.WaveGain := FTimeline.WaveGain;
end;

procedure TMainForm.BuildTimeline;
begin
  { Компонент создаётся кодом, а не кладётся на форму: он свой, в палитре
    его нет, а регистрировать пакет ради одного контрола незачем. }
  FTimeline := TTimelineControl.Create(Self);
  FTimeline.Parent := pnlTimelineHost;
  FTimeline.Align := alClient;
  FTimeline.Project := FProject;
  FTimeline.OnPlayheadChange := @TimelinePlayheadChange;
  FTimeline.OnStructureChange := @TimelineStructureChange;
  FTimeline.OnSelectionChange := @TimelineSelectionChange;
  FTimeline.OnMediaDrop := @TimelineMediaDrop;
  FTimeline.OnClipTransform := @TimelineClipTransform;
  FTimeline.OnTrackAdded := @TimelineTrackAdded;
  FTimeline.OnActiveTrackChange := @TimelineActiveTrackChange;
end;

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

  Полоса меню — настоящая, TMainMenu.

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

  Цвет решается иначе, на каждой системе своим способом: под gtk2 строкой
  стиля (ApplyMenuStyle), под win32 отрисовкой пунктов своими руками
  (ApplyDarkMenu). Остаток полосы правее последнего названия под Windows
  по-прежнему рисует система — это известная и принятая уступка. }
procedure TMainForm.BuildMenu;

  function AddTop(const ACaption: string): TMenuItem;
  begin
    Result := TMenuItem.Create(Self);
    Result.Caption := ACaption;
    FMenu.Items.Add(Result);
  end;

  { Возвращает созданный пункт: у пунктов с галкой её потом надо ставить
    и снимать, а искать пункт по названию — способ ненадёжный. }
  function AddItem(AParent: TMenuItem; const ACaption: string;
    AHandler: TNotifyEvent; AShortCut: TShortCut = 0): TMenuItem;
  var
    Item: TMenuItem;
  begin
    Item := TMenuItem.Create(Self);
    Item.Caption := ACaption;
    Item.OnClick := AHandler;
    Item.ShortCut := AShortCut;
    AParent.Add(Item);
    Result := Item;
  end;

  procedure AddSep(AParent: TMenuItem);
  var
    Item: TMenuItem;
  begin
    Item := TMenuItem.Create(Self);
    Item.Caption := '-';
    AParent.Add(Item);
  end;

var
  MFile, MEdit, MView, MProject, MHelp: TMenuItem;
begin
  { Подсказки всплывают почти сразу: на кнопке со значком они не
    украшение, а единственный способ узнать, что она делает. Держатся
    долго — читать там больше, чем одно слово. }
  Application.ShowHint := True;
  Application.HintPause := 100;
  Application.HintHidePause := 15000;

  { Точный замер текста ставится до первой сборки субтитров: без него
    размер подбирался бы по грубой оценке. }
  InstallTextMeasure;
  Application.OnException := @HandleException;

  ApplyWindowIcon;

  BuildJobIndicator;
  FMenu := TMainMenu.Create(Self);

  MFile := AddTop('Файл');
  AddItem(MFile, 'Новый проект', @MenuNewProject, ShortCut(VK_N, [ssCtrl]));
  AddItem(MFile, 'Открыть проект...', @MenuOpenProject, ShortCut(VK_O, [ssCtrl]));

  FRecentMenu := TMenuItem.Create(Self);
  FRecentMenu.Caption := 'Недавние проекты';
  MFile.Add(FRecentMenu);

  AddItem(MFile, 'Сохранить проект', @MenuSaveProject, ShortCut(VK_S, [ssCtrl]));
  AddItem(MFile, 'Сохранить проект как...', @MenuSaveProjectAs);
  AddSep(MFile);
  AddItem(MFile, 'Добавить файлы в проект...', @ChooseAndAddFiles,
    ShortCut(VK_I, [ssCtrl]));
  AddSep(MFile);
  AddItem(MFile, 'Собрать ролик...', @MenuExport, ShortCut(VK_E, [ssCtrl]));
  AddItem(MFile, 'Собрать с перекодированием...', @MenuExportEncode,
    ShortCut(VK_E, [ssCtrl, ssShift]));
  AddItem(MFile, 'Перепаковка файлов...', @MenuRemux);
  AddSep(MFile);
  AddItem(MFile, 'Зависимости...', @MenuDeps);
  AddSep(MFile);
  AddItem(MFile, 'Выход', @MenuQuit, ShortCut(VK_Q, [ssCtrl]));

  MEdit := AddTop('Правка');
  AddItem(MEdit, 'Отменить', @MenuUndo, ShortCut(VK_Z, [ssCtrl]));
  AddItem(MEdit, 'Повторить', @MenuRedo, ShortCut(VK_Y, [ssCtrl]));
  AddSep(MEdit);
  AddItem(MEdit, 'Разрезать по курсору', @MenuSplit, ShortCut(VK_S, []));
  AddItem(MEdit, 'Разрезать точно (с перекодированием стыка)',
    @MenuSplitPrecise, ShortCut(VK_S, [ssShift]));
  AddItem(MEdit, 'Удалить выделенное', @MenuDelete, ShortCut(VK_DELETE, []));
  AddItem(MEdit, 'Выделить всё', @MenuSelectAll, ShortCut(VK_A, [ssCtrl]));
  AddItem(MEdit, 'Цветовой ключ клипа...', @MenuColorKey);
  AddSep(MEdit);
  AddItem(MEdit, 'Отметить начало участка', @MenuRegionIn, ShortCut(VK_I, []));
  AddItem(MEdit, 'Отметить конец участка', @MenuRegionOut, ShortCut(VK_O, []));
  AddItem(MEdit, 'Снять отметки участка', @MenuRegionClear);
  AddSep(MEdit);
  AddItem(MEdit, 'Схлопнуть дыру под курсором', @MenuRipple,
    ShortCut(VK_R, [ssCtrl, ssShift]));
  AddItem(MEdit, 'Автосхлопывание при перетаскивании', @MenuToggleRipple,
    ShortCut(VK_K, [ssCtrl]));

  MView := AddTop('Вид');
  { Home и End назначены пунктами меню, а не обрабатываются в компоненте:
    так они работают независимо от того, где сейчас фокус. Иначе их
    перехватывал бы список файлов, переводя в нём выделение. }
  AddItem(MView, 'В начало монтажа', @MenuGoStart, ShortCut(VK_HOME, []));
  AddItem(MView, 'В конец монтажа', @MenuGoEnd, ShortCut(VK_END, []));
  AddSep(MView);
  AddItem(MView, 'Вписать весь проект', @MenuZoomFit, ShortCut(VK_0, [ssCtrl]));
  AddItem(MView, 'Приблизить', @MenuZoomIn, ShortCut(VK_ADD, [ssCtrl]));
  AddItem(MView, 'Отдалить', @MenuZoomOut, ShortCut(VK_SUBTRACT, [ssCtrl]));
  AddSep(MView);
  AddItem(MView, 'Журнал сообщений', @MenuToggleLog, ShortCut(VK_L, [ssCtrl]));
  AddSep(MView);
  FKeyPreviewItem := AddItem(MView, 'Ключ и прозрачность в предпросмотре',
    @MenuTogglePreviewKey);
  FKeyPreviewItem.AutoCheck := False;
  FKeyPreviewItem.Checked := FSettings.PreviewKey;

  MProject := AddTop('Проект');
  AddItem(MProject, 'Сведения о проекте...', @MenuProjectInfo);
  AddSep(MProject);
  AddItem(MProject, 'Добавить текст', @MenuAddText, ShortCut(VK_T, [ssCtrl]));
  AddSep(MProject);
  AddItem(MProject, 'Добавить дорожку', @MenuAddTrack);
  AddItem(MProject, 'Удалить последнюю дорожку', @MenuRemoveTrack);

  MHelp := AddTop('Справка');
  AddItem(MHelp, 'О программе...', @MenuAbout);

  { Дважды, и оба раза нужны.

    До присваивания — чтобы обработчики отрисовки стояли к первому показу.
    После — чтобы задать подложку полосы: она задаётся через SetMenuInfo по
    дескриптору меню, а дескриптор появляется только когда меню отдано
    окну. Первый вызов до этого просто пропускал подложку, и справа от
    последнего названия оставалась светлая полоса. }
  ApplyDarkMenu(FMenu);
  Menu := FMenu;
  ApplyDarkMenu(FMenu);
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 задаётся не здесь, а
  ресурсом при сборке — это отдельная история. }
procedure TMainForm.ApplyWindowIcon;
var
  Stream: TMemoryStream;
begin
  Stream := TMemoryStream.Create;
  try
    Stream.WriteBuffer(IconAppData[0], Length(IconAppData));
    Stream.Position := 0;
    try
      Icon.LoadFromStream(Stream);
      Application.Icon.Assign(Icon);
    except
      { Со значком не вышло — работать это не мешает. }
    end;
  finally
    Stream.Free;
  end;
end;

procedure TMainForm.BuildJobIndicator;
const
  JobWidth = 330;
  LogButtonWidth = 28;
  LogButtonLeft = 418;
begin
  FJobLabel := TLabel.Create(Self);
  FJobLabel.Parent := pnlBottom;
  FJobLabel.AutoSize := False;
  FJobLabel.Alignment := taRightJustify;
  FJobLabel.Anchors := [akTop, akRight];
  FJobLabel.SetBounds(pnlBottom.ClientWidth - JobWidth - 12, 6,
    JobWidth, 16);
  FJobLabel.ParentColor := False;
  FJobLabel.Font.Color := ThemeTextDim;
  FJobLabel.Visible := False;

  FJobBar := TThemedProgress.Create(Self);
  FJobBar.Parent := pnlBottom;
  FJobBar.Anchors := [akTop, akRight];
  FJobBar.SetBounds(pnlBottom.ClientWidth - JobWidth - 12, 26, JobWidth, 6);
  FJobBar.Visible := False;

  { Переключатель журнала. Стоит рядом с показателем работы: это две
    вещи про одно и то же — что программа делает и что она об этом
    рассказала. }
  FLogButton := TThemedButton.Create(Self);
  FLogButton.Parent := pnlBottom;
  { Рядом с прилипанием и схлопыванием: три переключателя читаются как
    один набор, а не как случайно разбросанные значки. }
  FLogButton.SetBounds(LogButtonLeft, 6, LogButtonWidth, 28);
  FLogButton.Icon := tiLog;
  { Фокус переключателям не нужен: по ним щёлкают, а обходить их клавишей
    Tab при работе с монтажом только мешает. }
  FLogButton.TabStop := False;
  FLogButton.Down := True;
  FLogButton.OnClick := @LogButtonClick;
  FLogButton.ShowHint := True;
  FLogButton.Hint := 'Журнал: спрятать или показать полосу с сообщениями';

  { Строка состояния ужимается, чтобы её длинные сообщения не залезали
    под показатель и под кнопку. }
  lblStatus.Width := pnlBottom.ClientWidth - lblStatus.Left - JobWidth - 24;

  { Сто миллисекунд, а не триста: полоска должна ползти, а не дёргаться
    ступеньками. }
  FJobTimer := TTimer.Create(Self);
  FJobTimer.Interval := 100;
  FJobTimer.OnTimer := @JobTimerTick;
  FJobTimer.Enabled := True;
end;

{ Как растёт полоска — см. AdvanceProgress в uAppTypes: там же она и
  проверяется числами. }
procedure TMainForm.AdvanceJobBar;
const
  { Доля оставшегося до вехи расстояния за один шаг таймера. При ста
    миллисекундах на шаг это примерно половина расстояния за секунду. }
  StepShare = 0.07;
begin
  FJobShown := AdvanceProgress(FJobShown, FJobReal, FJobNext, StepShare);
end;

procedure TMainForm.LogButtonClick(Sender: TObject);
begin
  ApplyLogVisible(not memoLog.Visible);
end;

{ Новая надпись.

  Кладётся на текстовую дорожку в место курсора. Дорожки нет — заводится:
  просить сначала создать дорожку, а потом положить на неё текст значило
  бы заставлять человека знать наше устройство. }
procedure TMainForm.MenuAddText(Sender: TObject);
var
  Track: TTrack;
  Clip: TClip;
  I: Integer;
begin
  Track := nil;
  for I := 0 to FProject.TrackCount - 1 do
    if FProject.Tracks[I].Kind = tkText then
    begin
      Track := FProject.Tracks[I];
      Break;
    end;

  FProject.BeginChange;

  if Track = nil then
    Track := FProject.AddTrackOfKind('Т1', tkText);

  Clip := TClip.Create;
  Clip.Id := FProject.NewId('c');
  Clip.Kind := ckText;
  Clip.TlStart := Max(0, FTimeline.Playhead);
  { Три секунды — столько держится короткая надпись, чтобы её успели
    прочесть. Дальше человек растянет клип как захочет. }
  Clip.Duration := 3;
  Clip.Text := 'Надпись';
  Clip.TextStyle := DefaultTextStyle;
  Track.Add(Clip);
  Track.Sort;

  if not EditTextOf(Clip) then
  begin
    { Передумал — клипа быть не должно, иначе на монтаже останется
      пустая надпись, которую он не заказывал. }
    Track.Remove(Clip);
    FProject.CancelChange;
    FTimeline.Invalidate;
    Exit;
  end;

  FProject.ClearSelection;
  Clip.Selected := True;
  TimelineStructureChange(nil);
end;

function TMainForm.EditTextOf(AClip: TClip): Boolean;
var
  { Не Text: так называется свойство самой формы. }
  Body: string;
  Style: TTextStyle;
  W, H: Integer;
begin
  Result := False;
  if AClip = nil then
    Exit;

  Body := AClip.Text;
  Style := AClip.TextStyle;
  W := FProject.Master.Width;
  H := FProject.Master.Height;
  if (W < 2) or (H < 2) then
  begin
    W := 1920;
    H := 1080;
  end;

  if not EditTextClip(Body, Style, W, H) then
    Exit;

  AClip.Text := Body;
  AClip.TextStyle := Style;
  Result := True;
end;

procedure TMainForm.MenuAbout(Sender: TObject);
begin
  ShowAboutForm;
end;

procedure TMainForm.MenuToggleLog(Sender: TObject);
begin
  ApplyLogVisible(not memoLog.Visible);
end;

procedure TMainForm.ApplyLogVisible(AVisible: Boolean);
begin
  memoLog.Visible := AVisible;
  if not Assigned(FLogButton) then
    Exit;
  FLogButton.Down := AVisible;
  if AVisible then
    FLogButton.Hint := 'Журнал виден. Нажмите, чтобы спрятать.'
  else
    FLogButton.Hint := 'Журнал спрятан. Нажмите, чтобы показать.';
end;

{ Как растёт полоска.

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

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

  Назад она не идёт никогда: доля, единожды показанная, остаётся. }


{ Опрос по таймеру, а не уведомления из потоков: поток сообщает о готовом
  файле, а не о ходе внутри файла, и на шестигигабайтном файле между
  сообщениями проходят десятки секунд. Опрос показывает движение и там. }
procedure TMainForm.JobTimerTick(Sender: TObject);
var
  { Не Text: так называется свойство самой формы, а имена в Паскале
    нечувствительны к регистру. }
  Note: string;
  Frac: Double;
  Total, Done, Kind: Integer;
begin
  {$IFDEF LCLWIN32}
  { Заодно подновляем закраску остатка полосы меню.

    Обработчика перерисовки рамки может не хватить: система трогает
    полосу и по другим поводам, а рисуем мы поверх неё. Прямоугольник тот
    же и цвет тот же, поэтому подновление не видно. }
  PaintMenuBarTail(Self);
  {$ENDIF}

  Note := '';
  Total := 0;
  Done := 0;
  Kind := 0;

  { Порядок важен: показываем то, чего человек ждёт прямо сейчас.

    Сборка вставок держит предпросмотр — до её конца монтаж играет
    по-старому. Разбор звука и миниатюры не держат ничего, они лишь
    дорисовывают то, что уже видно. }
  if FGenerateBusy and Assigned(FGenerate) then
  begin
    Kind := 1;
    Total := FGenerate.Total;
    Done := FGenerate.Done;
    Note := FGenerate.StageText;
    if Note = '' then
      Note := 'Готовлю участки монтажа';
    { Заодно показываем на монтаже, какой именно участок пересобирается. }
    FTimeline.SetBusyRange(FGenerate.BusyFrom, FGenerate.BusyTo);
  end
  else if Assigned(FPeaksThread) and (not FPeaksFinished) then
  begin
    Kind := 2;
    Total := FPeaksThread.Total;
    Done := FPeaksThread.Done;
    if Total > 0 then
      Note := Format('Разбор звука: %d из %d', [Min(Done + 1, Total), Total]);
  end
  else if Assigned(FThumbThread) then
  begin
    Kind := 3;
    Total := FThumbThread.Total;
    Done := FThumbThread.Done;
    if (Total > 0) and (Done < Total) then
      Note := Format('Миниатюры: %d из %d', [Min(Done + 1, Total), Total]);
  end;

  if Note = '' then
  begin
    if FJobLabel.Visible then
    begin
      FJobLabel.Visible := False;
      FJobBar.Visible := False;
    end;
    { Следующая работа начинается с пустой полоски, а не с того места, где
      кончилась прошлая. }
    FJobShown := 0;
    FJobReal := 0;
    FJobNext := 0;
    FJobKind := 0;
    FTimeline.SetBusyRange(0, 0);
    Exit;
  end;

  if Kind <> FJobKind then
  begin
    FJobKind := Kind;
    FJobShown := 0;
  end;

  if Total > 0 then
  begin
    FJobReal := Done / Total;
    FJobNext := (Done + 1) / Total;
  end
  else
  begin
    { Работа без счёта: ползём к концу, никогда его не достигая. }
    FJobReal := 0;
    FJobNext := 1;
  end;
  AdvanceJobBar;
  Frac := FJobShown;

  FJobLabel.Caption := Note;
  FJobBar.Fraction := Frac;
  if not FJobLabel.Visible then
  begin
    FJobLabel.Visible := True;
    FJobBar.Visible := True;
  end;
end;

{$IFDEF LCLWIN32}
procedure TMainForm.WMNCPaint(var Msg: TLMessage);
begin
  inherited;
  PaintMenuBarTail(Self);
end;

procedure TMainForm.WMNCActivate(var Msg: TLMessage);
begin
  inherited;
  PaintMenuBarTail(Self);
end;
{$ENDIF}

procedure TMainForm.FormShow(Sender: TObject);
var
  I: Integer;
  Added: Boolean;
  Err: string;
begin
  if FStarted then
    Exit;
  FStarted := True;

  { Журнал прячется здесь, а не при чтении настроек.

    Спрятанный до первого показа окна, он не получает своего виджета
    вовсе, и вернуть его потом уже нечем: свойство переключается,
    а на экране ничего не меняется. Проверено на невидимом экране:
    щелчок по кнопке журнала не менял ни пикселя, при том что запись в
    журнале показывала Visible=True, высоту 135 и верх 743.

    HandleNeeded — на случай, если до этого места дескриптор всё же не
    создан: прятать можно только то, что уже существует. }
  memoLog.HandleNeeded;
  ApplyLogVisible(FSettings.LogVisible);

  { Подложка полосы меню задаётся здесь, а не при создании формы.

    Она задаётся через SetMenuInfo по дескриптору меню, а тот появляется
    вместе с дескриптором окна — то есть уже после создания формы. Вызов
    из BuildMenu поэтому попадал на несозданный дескриптор и молча ничего
    не делал: пункты рисовались нашими руками, а полоса правее последнего
    названия оставалась светлой. }
  ApplyDarkMenu(Menu);
  PaintMenuBarTail(Self);
  {$IFDEF LCLWIN32}
  Log(MenuBarTailNote);
  {$ENDIF}

  StartPlayer;
  RemindAboutDeps;

  { Файлы из командной строки попадают в список проекта. Так на программу
    можно перетащить файлы из файлового менеджера.

    Файл проекта — особый случай: его надо открыть, а не пытаться
    разобрать как видео. }
  Added := False;
  for I := 1 to ParamCount do
  begin
    if not FileExists(ParamStr(I)) then
      Continue;

    if LowerCase(ExtractFileExt(ParamStr(I))) = '.nlve' then
    begin
      if FProject.LoadFromFile(ExpandFileName(ParamStr(I)), Err) then
      begin
        Log('Открыт проект: ' + FProject.FileName);
        FTimeline.ZoomToFit;
        FLastLoadedEdl := '';
        RefreshPool;
        UpdateRippleButton;
        UpdateCaption;
        SchedulePreview;
      end
      else
        Log('Не удалось открыть проект: ' + Err);
      Continue;
    end;

    AddMediaFile(ExpandFileName(ParamStr(I)));
    Added := True;
  end;
  if Added then
  begin
    RefreshPool;
    UpdateCaption;
    if lstPool.Items.Count > 0 then
      lstPool.ItemIndex := 0;
  end;
end;

{ Проверка не по одному месту, а разом: человеку нужен ответ «чего не
  хватает», а не «на чём именно споткнулись первым». }
function TMainForm.MissingDeps: string;
var
  Err: string;
begin
  Result := '';
  if not MpvLibLoaded then
    Result := 'libmpv — без неё нет предпросмотра';
  if not ToolsAvailable(Err) then
  begin
    if Result <> '' then
      Result := Result + LineEnding;
    Result := Result + 'ffmpeg — без него не собрать ролик';
  end;
end;

{ Напоминание при запуске.

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

  Три кнопки: открыть окно зависимостей, отложить, больше не напоминать.
  Последняя запоминается в настройках. }
procedure TMainForm.RemindAboutDeps;
var
  Missing: string;
  Choice: Integer;
begin
  if not FSettings.DepsReminder then
    Exit;
  Missing := MissingDeps;
  if Missing = '' then
    Exit;

  Choice := ThemedChoiceDlg('nlve',
    'Не хватает того, на чём программа работает:' + LineEnding +
    LineEnding + Missing + LineEnding + LineEnding +
    'Окно «Зависимости» умеет скачать недостающее с официальных сайтов.' +
    LineEnding + 'Открыть его сейчас?',
    ['Открыть', 'Потом', 'Не напоминать']);

  case Choice of
    0: MenuDeps(nil);
    2: FSettings.DepsReminder := False;
  end;
end;

procedure TMainForm.StartPlayer;
var
  Err: string;
begin
  if not LoadMpvLib(Err) then
  begin
    Log('ОШИБКА: ' + Err);
    SetStatus('Предпросмотр недоступен: нет libmpv.');
    Exit;
  end;
  Log('libmpv загружена: ' + MpvLibFileName);

  pnlVideo.HandleNeeded;

  if not FPlayer.Initialize(Err) then
  begin
    Log('ОШИБКА: ' + Err);
    SetStatus('Предпросмотр недоступен.');
    Exit;
  end;
  Log('Предпросмотр готов.');

  if not ToolsAvailable(Err) then
  begin
    Log('ВНИМАНИЕ: ' + Err);
    SetStatus('ffmpeg не найден — сборка и генерация работать не будут.');
  end;
end;

{ --- Мелочи интерфейса --- }

{ Дублирование журнала в файл рядом с программой.

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

  Неудача записи ничего не значит — каталог может быть закрыт на запись,
  и работать это мешать не должно. }
procedure TMainForm.LogToFile(const AText: string);
var
  F: TextFile;
begin
  if FLogFileBroken then
    Exit;
  try
    AssignFile(F, FLogFilePath);
    if FLogFileStarted then
      Append(F)
    else
    begin
      Rewrite(F);
      FLogFileStarted := True;
    end;
    try
      WriteLn(F, AText);
    finally
      CloseFile(F);
    end;
  except
    FLogFileBroken := True;
  end;
end;

procedure TMainForm.Log(const AText: string);
begin
  memoLog.Add(AText);
  LogToFile(AText);
end;

procedure TMainForm.SetStatus(const AText: string);
begin
  lblStatus.Caption := AText;
end;

procedure TMainForm.UpdateCaption;
var
  { Не Name и не Position: оба имени заняты свойствами формы. }
  ProjectName: string;
begin
  if FProject.FileName = '' then
    ProjectName := 'без имени'
  else
    ProjectName := ExtractFileName(FProject.FileName);
  if FProject.Modified then
    ProjectName := ProjectName + ' *';
  Caption := 'nlve — ' + ProjectName;
end;

procedure TMainForm.UpdateTimeLabel;
begin
  lblTime.Caption := FormatTimecode(FTimeline.Playhead) + ' / ' +
    FormatTimecode(FProject.EndTime);
end;

procedure TMainForm.RefreshPool;
var
  I: Integer;
  Item: TMediaItem;
begin
  lstPool.Items.BeginUpdate;
  try
    lstPool.Items.Clear;
    { Строки только несут номер: всё, что видно, рисуется вручную по
      данным проекта, поэтому дублировать их в списке незачем. }
    for I := 0 to FProject.PoolCount - 1 do
      lstPool.Items.Add(ExtractFileName(FProject.Pool[I].Path));
  finally
    lstPool.Items.EndUpdate;
  end;
  lblPoolInfo.Caption := Format('%d %s в проекте',
    [FProject.PoolCount,
     Plural(FProject.PoolCount, 'файл', 'файла', 'файлов')]);
  StartThumbs;
  StartPeaks;
end;

{ Запускает изготовление недостающих миниатюр.

  Один поток на всю очередь: миниатюры делаются последовательно, чтобы
  не устраивать драку за диск при добавлении десятка файлов сразу. }
function TMainForm.ThumbIndexFor(const APath: string): Integer;
var
  Idx: Integer;
begin
  Result := -1;
  if FThumbMap = nil then
    Exit;
  Idx := FThumbMap.IndexOf(APath);
  if Idx >= 0 then
    Result := PtrUInt(FThumbMap.Objects[Idx]) - 1;
end;

procedure TMainForm.StartThumbs;
var
  Requests: TThumbRequests = nil;
  I, N: Integer;
  Item: TMediaItem;
begin
  if Assigned(FThumbThread) then
  begin
    { Предыдущая очередь ещё идёт — прерываем её: список изменился, и
      часть работы могла стать ненужной. }
    FThumbThread.Terminate;
    FThumbThread.WaitFor;
    FreeAndNil(FThumbThread);
  end;

  if FProject.PoolCount = 0 then
    Exit;

  SetLength(Requests, FProject.PoolCount);
  N := 0;
  for I := 0 to FProject.PoolCount - 1 do
  begin
    Item := FProject.Pool[I];
    if ThumbIndexFor(Item.Path) >= 0 then
      Continue;
    { Кадр берём из исходника, а не из приведённой копии: копии может ещё
      не быть, а миниатюра нужна сразу. Ключом при этом остаётся исходный
      путь — он не меняется. }
    Requests[N].SourcePath := Item.Path;
    Requests[N].TargetPath := ThumbPath(FProject.CacheDir, Item.Path);
    Requests[N].Key := Item.Path;
    if Item.Info.Kind = mkImage then
      Requests[N].AtTime := 0
    else
      Requests[N].AtTime := ThumbTimeFor(Item.Info.Duration);
    Inc(N);
  end;
  SetLength(Requests, N);
  if N = 0 then
    Exit;

  FThumbThread := TThumbThread.Create(Requests);
  FThumbThread.OnReady := @ThumbReady;
  FThumbThread.Start;
end;

{ Разбор звука для формы волны. Отдельная очередь от миниатюр: разбор
  идёт дольше, и держать миниатюры в ожидании звука незачем. }
procedure TMainForm.StartPeaks;
var
  Requests: TPeaksRequests = nil;
  I, N: Integer;
  Item: TMediaItem;
  Dummy: TPeaks;
begin
  { Ждать окончания разбора нельзя: он читает файл целиком, а это
    гигабайты и десяток секунд. Ожидание идёт в главном потоке, и всё это
    время окно не отвечает — меню не открывается вовсе.

    Поэтому просто отмечаем, что список изменился: текущий проход
    доработает и запустится заново. }
  if Assigned(FPeaksThread) then
  begin
    if not FPeaksFinished then
    begin
      FPeaksRestart := True;
      Exit;
    end;
    { Уже завершился — ожидание мгновенное. }
    FPeaksThread.WaitFor;
    FreeAndNil(FPeaksThread);
  end;

  FPeaksRestart := False;
  FPeaksFinished := False;
  if FProject.PoolCount = 0 then
    Exit;

  SetLength(Requests, FProject.PoolCount);
  N := 0;
  for I := 0 to FProject.PoolCount - 1 do
  begin
    Item := FProject.Pool[I];
    if not Item.Info.HasAudio then
      Continue;
    if CachedPeaks(FProject.CacheDir, Item.EffectivePath, Dummy) then
      Continue;
    Requests[N].SourcePath := Item.EffectivePath;
    Requests[N].TargetPath := PeaksPath(FProject.CacheDir, Item.EffectivePath);
    Inc(N);
  end;
  SetLength(Requests, N);
  if N = 0 then
    Exit;

  FPeaksThread := TPeaksThread.Create(Requests);
  FPeaksThread.OnReady := @PeaksReady;
  FPeaksThread.OnTerminate := @PeaksDone;
  { Разбор звука не должен мешать работе: он тяжёлый и никуда не спешит. }
  FPeaksThread.Priority := tpLowest;
  FPeaksThread.Start;
end;

{ Проход разбора закончился. Освобождаем поток и, если за это время
  список файлов менялся, начинаем заново. }
procedure TMainForm.PeaksDone(Sender: TObject);
begin
  { Освобождать поток прямо здесь нельзя: он ещё доживает свой цикл.
    Отмечаем, что он закончил, а освободит его следующий заход. }
  FPeaksFinished := True;
  if FPeaksRestart then
    StartPeaks;
end;

procedure TMainForm.PeaksReady(Sender: TObject; const ASourcePath: string);
begin
  { Запомненную неудачу надо забыть: пики только что появились. }
  ForgetPeaks;
  FTimeline.Invalidate;
end;

procedure TMainForm.ThumbReady(Sender: TObject; const ASourcePath,
  AThumbPath: string);
var
  Png: TPortableNetworkGraphic;
  Bmp: TBitmap;
  ImgIdx: Integer;
begin
  if not FileExists(AThumbPath) then
    Exit;
  if ThumbIndexFor(ASourcePath) >= 0 then
    Exit;

  Png := TPortableNetworkGraphic.Create;
  Bmp := TBitmap.Create;
  try
    try
      Png.LoadFromFile(AThumbPath);
      { Список изображений принимает растр, а не картинку произвольного
        формата, поэтому перерисовываем PNG в растр нужного размера. }
      Bmp.SetSize(ThumbWidth, ThumbHeight);
      Bmp.Canvas.Brush.Color := clBlack;
      Bmp.Canvas.FillRect(0, 0, ThumbWidth, ThumbHeight);
      Bmp.Canvas.Draw(0, 0, Png);
      ImgIdx := FThumbs.Add(Bmp, nil);
    except
      { Битая миниатюра — просто оставляем строку без картинки. }
      Exit;
    end;
  finally
    Bmp.Free;
    Png.Free;
  end;

  FThumbMap.AddObject(ASourcePath, TObject(PtrUInt(ImgIdx + 1)));
  lstPool.Invalidate;
end;

{ Колесо с Shift над журналом прокручивает его вбок.

  Строки там бывают длиной в несколько экранов — команды ffmpeg целиком, —
  и добраться до их конца иначе нечем: полоса прокрутки внизу есть, но
  колесо само по себе на неё не действует. }
{ Своя отрисовка строки: кадр слева, название и параметры справа. }
procedure TMainForm.lstPoolDrawItem(Control: TWinControl; Index: Integer;
  ARect: TRect; State: TOwnerDrawState);
var
  C: TCanvas;
  Item: TMediaItem;
  ImgIdx, TextLeft: Integer;
begin
  C := lstPool.Canvas;

  { Цвета берём свои, а не системные. clWindowText под Windows почти
    чёрный, и на тёмном списке подписи к файлам пропадали. }
  if odSelected in State then
    C.Brush.Color := ThemeSelection
  else
    C.Brush.Color := ThemeSurface;
  C.FillRect(ARect);

  if (Index < 0) or (Index >= FProject.PoolCount) then
    Exit;
  Item := FProject.Pool[Index];

  ImgIdx := ThumbIndexFor(Item.Path);
  if ImgIdx >= 0 then
    FThumbs.Draw(C, ARect.Left + 4, ARect.Top + 5, ImgIdx)
  else
  begin
    { Кадр ещё готовится — рисуем заглушку того же размера, чтобы строки
      не прыгали, когда картинка появится. }
    C.Brush.Color := clBlack;
    C.FillRect(ARect.Left + 4, ARect.Top + 5,
      ARect.Left + 4 + ThumbWidth, ARect.Top + 5 + ThumbHeight);
    C.Font.Color := ThemeTextDim;
    C.Brush.Style := bsClear;
    C.TextOut(ARect.Left + 20, ARect.Top + 5 + ThumbHeight div 2 - 8, 'готовится...');
    C.Brush.Style := bsSolid;
  end;

  TextLeft := ARect.Left + ThumbWidth + 12;
  C.Brush.Style := bsClear;
  if odSelected in State then
    C.Font.Color := ThemeSelText
  else
    C.Font.Color := ThemeText;

  C.Font.Style := [fsBold];
  C.TextOut(TextLeft, ARect.Top + 8, ExtractFileName(Item.Path));
  C.Font.Style := [];
  if not (odSelected in State) then
    C.Font.Color := ThemeTextDim;
  C.TextOut(TextLeft, ARect.Top + 30, DescribeMedia(Item.Info));
  if Item.Info.Duration > 0 then
    C.TextOut(TextLeft, ARect.Top + 50,
      SecondsToStr(Item.Info.Duration) + ' с');
  if Item.NormalizedPath <> '' then
    C.TextOut(TextLeft, ARect.Top + 70, 'приведён к проекту');
  C.Brush.Style := bsSolid;
end;

{ Номер выбранного файла в списке проекта, минус один если ничего не выбрано. }
function SelectedPoolIndex(AList: TListBox): Integer;
begin
  Result := AList.ItemIndex;
end;

procedure TMainForm.lstPoolClick(Sender: TObject);
var
  Item: TMediaItem;
  Idx: Integer;
begin
  Idx := SelectedPoolIndex(lstPool);
  if (Idx < 0) or (Idx >= FProject.PoolCount) then
    Exit;
  Item := FProject.Pool[Idx];
  SetStatus(ExtractFileName(Item.Path) + ' — ' + DescribeMedia(Item.Info) +
    ', ' + SecondsToStr(Item.Info.Duration) + ' с');
end;

{ --- Список файлов --- }

procedure TMainForm.AddMediaFile(const APath: string);
var
  Info: TMediaInfo;
  Err: string;
  Item: TMediaItem;
begin
  if FProject.FindMediaByPath(APath) <> nil then
  begin
    Log('Уже в проекте: ' + ExtractFileName(APath));
    Exit;
  end;

  Screen.Cursor := crHourGlass;
  try
    if not ProbeMedia(APath, Info, Err) then
    begin
      Log('Не удалось прочитать ' + ExtractFileName(APath) + ': ' + Err);
      Exit;
    end;
  finally
    Screen.Cursor := crDefault;
  end;

  FProject.BeginChange;
  Item := FProject.AddMedia(APath, Info);
  Log('Добавлен ' + ExtractFileName(APath) + ' — ' + DescribeMedia(Info));
  if Info.ExtraStreams > 0 then
    Log('  в файле ещё ' + IntToStr(Info.ExtraStreams) +
      ' поток(ов) — телеметрия или обложка, при сборке они отбрасываются');
  if Item = FProject.Pool[0] then
  begin
    Log('  параметры проекта взяты из этого файла');
    PrewarmInserts;
  end;
end;

procedure TMainForm.ChooseAndAddFiles(Sender: TObject);
var
  I: Integer;
begin
  if not OpenMediaDialog.Execute then
    Exit;
  FSettings.LastMediaDir := ExtractFilePath(OpenMediaDialog.FileName);
  for I := 0 to OpenMediaDialog.Files.Count - 1 do
    AddMediaFile(OpenMediaDialog.Files[I]);
  RefreshPool;
  UpdateCaption;
end;

{ Кладёт файл из списка проекта на дорожку.

  Общая точка для кнопки «На таймлайн» и для перетаскивания мышью:
  предупреждение о несовпадении параметров и выбор места должны работать
  одинаково, каким бы способом файл ни попал на монтаж.

  ATrackIndex = -1 означает «завести новую дорожку внизу». }
function TMainForm.AddClipFromPool(APoolIndex, ATrackIndex: Integer;
  const ATime: Double): Boolean;
var
  Item: TMediaItem;
  Track: TTrack;
  Mismatches: TMismatches;
  Duration, PlaceAt: Double;
  NormPath: string;
begin
  Result := False;
  if (APoolIndex < 0) or (APoolIndex >= FProject.PoolCount) then
  begin
    SetStatus('Сначала выберите файл в списке.');
    Exit;
  end;
  Item := FProject.Pool[APoolIndex];

  if ATrackIndex < 0 then
  begin
    FProject.AddTrack('V' +
            IntToStr(FProject.TrackCountOf(tkVideo) + 1));
    ATrackIndex := FProject.TrackCount - 1;
    Log('Заведена дорожка ' + FProject.Tracks[ATrackIndex].Name);
  end;
  if ATrackIndex >= FProject.TrackCount then
    ATrackIndex := FProject.TrackCount - 1;
  Track := FProject.Tracks[ATrackIndex];

  { Предупреждаем именно здесь, при попадании на монтаж: пока файл просто
    лежит в списке, он ни с чем не склеивается. }
  Mismatches := CompareToMaster(FProject.Master, Item.Info);
  if Length(Mismatches) > 0 then
    case AskAboutMismatch(Self, Item.Path, Mismatches) of
      mcCancel:
        Exit;
      mcNormalize:
        begin
          NormPath := FProject.CacheDir + 'norm' + PathDelim +
            ChangeFileExt(ExtractFileName(Item.Path), '') + '.mkv';
          if not ForceDirectories(ExtractFilePath(NormPath)) then
          begin
            Log('Не удалось создать каталог для приведённых файлов.');
            Exit;
          end;

          FNormalize := TFfmpegJob.Create(
            ArgsNormalize(Item.Path, NormPath,
              FProject.Master.Width, FProject.Master.Height,
              FProject.Master.FpsNum, FProject.Master.FpsDen,
              FProject.Master.VideoCodec, FProject.Master.PixFmt,
              FProject.Master.AudioCodec,
              FProject.Master.SampleRate, FProject.Master.Channels,
              TransformFilter(Item.Transform, Item.Info.Width, Item.Info.Height,
                FProject.Master.Width, FProject.Master.Height)),
            Item.Info.Duration, 'Привожу к параметрам проекта', NormPath);

          FNormalize.OnProgress := @NormalizeProgress;
          FNormalize.OnLog := @NormalizeLog;
          FNormalize.OnTerminate := @NormalizeDone;

          FNormalizeUi := TProgressForm.Create(Self);
          try
            FNormalizeUi.Caption := 'Приведение к параметрам проекта';
            FNormalizeUi.OnCancelRequest := @NormalizeCancel;
            FNormalize.Start;
            FNormalizeUi.ShowModal;
          finally
            FreeAndNil(FNormalizeUi);
          end;

          FNormalize.WaitFor;
          if not FNormalize.Succeeded then
          begin
            Log('Приведение не удалось: ' + FNormalize.Message);
            FreeAndNil(FNormalize);
            Exit;
          end;
          FreeAndNil(FNormalize);

          Item.NormalizedPath := NormPath;
          { Индекс опорных кадров относился к исходнику, у приведённой
            копии он свой. }
          Item.IndexLoaded := False;
          Log('Файл приведён к параметрам проекта: ' + NormPath);
        end;
    end;

  if Item.Info.Kind = mkImage then
    Duration := DefaultImageDuration
  else
    Duration := Item.Info.Duration;
  if Duration <= 0 then
    Duration := DefaultImageDuration;

  { Ставим туда, куда попросили. Если там занято — в конец дорожки: молча
    накладывать клипы друг на друга нельзя, порядок перекрытия должен быть
    осознанным. }
  PlaceAt := Max(0, ATime);
  if (Track.ClipAt(PlaceAt) <> nil) or
     (Track.ClipAt(PlaceAt + Duration - 0.001) <> nil) then
  begin
    PlaceAt := Track.EndTime;
    Log('На дорожке ' + Track.Name + ' в этом месте занято — поставил в конец.');
  end;

  FProject.BeginChange;
  { Парой: клип картинки и его звук на соответствующей звуковой дорожке.
    Связка держит их вместе, пока её не развяжут по Ctrl+G. }
  FProject.AddClipPair(Track, Item, 0, Duration, PlaceAt);
  FTimeline.Invalidate;
  SchedulePreview;
  UpdateCaption;
  UpdateTimeLabel;
  SetStatus('Добавлен клип на дорожку ' + Track.Name);
  Result := True;
end;

procedure TMainForm.TimelineActiveTrackChange(Sender: TObject);
begin
  if (FTimeline.ActiveTrack >= 0) and
     (FTimeline.ActiveTrack < FProject.TrackCount) then
    SetStatus('Выбрана дорожка ' +
      FProject.Tracks[FTimeline.ActiveTrack].Name);
end;

{ Файл притащили мышью прямо на дорожку. }
procedure TMainForm.TimelineMediaDrop(Sender: TObject; ASource: TObject;
  ATrackIndex: Integer; const ATime: Double);
begin
  if ASource <> lstPool then
    Exit;
  AddClipFromPool(SelectedPoolIndex(lstPool), ATrackIndex, ATime);
end;

{ Дорожку завёл сам компонент, когда клип утащили ниже последней. }
procedure TMainForm.TimelineTrackAdded(Sender: TObject);
begin
  UpdateCaption;
end;

{ --- Предпросмотр --- }

{ Готовит заготовку чёрной вставки заранее, чтобы первая дыра на монтаже
  появилась мгновенно. }
procedure TMainForm.PrewarmInserts;
var
  Requests: TGenRequests;
begin
  if FGenerateBusy or (not FProject.MasterSet) then
    Exit;
  Requests := PrewarmRequests(FProject.CacheDir);
  if Length(Requests) = 0 then
    Exit;

  FGenerateBusy := True;
  FGenerate := TGenerateThread.Create(Requests, FProject.Master);
  FGenerate.OnProgress := @GenerateProgress;
  FGenerate.OnLog := @GenerateLog;
  FGenerate.OnTerminate := @GenerateDone;
  FGenerate.Start;
end;

procedure TMainForm.SchedulePreview;
begin
  FPreviewDirty := True;
  FPreviewTimer.Enabled := False;
  FPreviewTimer.Enabled := True;
end;

procedure TMainForm.PreviewTimerTick(Sender: TObject);
begin
  FPreviewTimer.Enabled := False;
  if FPreviewDirty then
  begin
    FPreviewDirty := False;
    RebuildPreview;
  end;
end;

function TMainForm.PreviewNeedsFitting: Boolean;
var
  T, C: Integer;
  Track: TTrack;
  Item: TMediaItem;
begin
  Result := False;
  if not FProject.MasterSet then
    Exit;

  for T := 0 to FProject.TrackCount - 1 do
  begin
    Track := FProject.Tracks[T];
    for C := 0 to Track.Count - 1 do
    begin
      Item := FProject.FindMedia(Track.Clips[C].MediaId);
      if (Item = nil) or (not Item.Info.HasVideo) then
        Continue;
      if (Item.Info.Width <= 0) or (Item.Info.Height <= 0) then
        Continue;

      { Сравниваем именно соотношение сторон, а не размеры: файл 3840x2160
        в проекте 2688x1512 показывается верно и без всякого фильтра —
        mpv сам впишет его в панель, и картинка совпадёт до пикселя.
        Умножение вместо деления, чтобы не ловить погрешность дробей. }
      if Item.Info.Width * FProject.Master.Height <>
         Item.Info.Height * FProject.Master.Width then
        Exit(True);
    end;
  end;
end;

procedure TMainForm.ApplyPreviewFrame;
begin
  if (FPlayer = nil) or (not FPlayer.Initialized) then
    Exit;

  if PreviewNeedsFitting then
  begin
    { Порядок важен: сначала переводим декодирование в обычную память,
      иначе фильтру нечего будет обрабатывать и он откажется собираться. }
    FPlayer.SetHwdec('auto-copy');
    FPlayer.SetVideoFilter(
      PreviewFitFilter(FProject.Master.Width, FProject.Master.Height));
  end
  else
  begin
    { И обратно: сначала снимаем фильтр, потом возвращаем быстрый путь. }
    FPlayer.SetVideoFilter('');
    FPlayer.SetHwdec('auto-safe');
  end;
end;

procedure TMainForm.RebuildPreview;
var
  Segments, AudioSegs, TrackSegs: TFlatSegmentArray;
  Overlays: TPreviewOverlays;
  GenMaster: TMediaInfo;
  Missing, TrackMissing: TGenRequests;
  I, J: Integer;
  TotalLen: Double;
begin
  if (FPlayer = nil) or (not FPlayer.Initialized) then
    Exit;
  if FGenerateBusy then
  begin
    { Пока идёт создание вставок, пересборку откладываем: иначе запустим
      второй такой же поток. }
    FPreviewDirty := True;
    FPreviewTimer.Enabled := True;
    Exit;
  end;

  { Уплощение для предпросмотра: клипы, которые кладутся поверх, идут
    отдельно. Плеер положит их сам, ничего не собирая. }
  if not FlattenPreview(FProject, Segments, AudioSegs, Overlays, Missing,
    FSettings.PreviewKey) then
  begin
    FPlayer.Stop;
    FLastLoadedEdl := '';
    FPreviewOverlayUrl := '';
    FPreviewOverlayWindows := nil;
    UpdateTimeLabel;
    Exit;
  end;

  BuildOverlayPreview(Overlays, TotalDuration(Segments));

  { Текст поверх картинки рисует сам плеер: ему отдаётся файл разметки,
    а не пересобранный кусок. Поэтому правка текста видна сразу. }
  UpdateSubtitles;

  { Участки с прозрачностью и переходами плееру не по зубам: список
    кусков накладывать не умеет. Подставляем вместо них заранее
    посчитанные файлы, а чего ещё нет — заказываем. }
  ResolveLayers(FProject, Segments, Missing);

  { Каждая звуковая дорожка идёт своим списком кусков: они смешиваются, а
    не побеждают друг друга. Дыры в каждой дорожке свои, и вставки тишины
    под них нужны свои — без этого список ссылается на несуществующий
    файл, плеер его не открывает, и дорожка молчит целиком. }
  FPreviewAudioUrls := nil;
  FPreviewAudioTracks := nil;
  TotalLen := Max(AudibleEnd(FProject, tkVideo), AudibleEnd(FProject, tkAudio));
  for I := 0 to FProject.TrackCount - 1 do
  begin
    if FProject.Tracks[I].Kind <> tkAudio then
      Continue;
    if not FProject.TrackAudible(FProject.Tracks[I]) then
      Continue;
    if FProject.Tracks[I].Count = 0 then
      Continue;
    if not FlattenAudioTrack(FProject, FProject.Tracks[I], TotalLen,
      TrackSegs, TrackMissing) then
      Continue;
    for J := 0 to High(TrackMissing) do
    begin
      SetLength(Missing, Length(Missing) + 1);
      Missing[High(Missing)] := TrackMissing[J];
    end;
    SetLength(FPreviewAudioUrls, Length(FPreviewAudioUrls) + 1);
    FPreviewAudioUrls[High(FPreviewAudioUrls)] := BuildEdlUri(TrackSegs);
    { Запоминаем сами дорожки: громкости потом берутся ровно по этому
      списку. Пересчитывать его отдельным проходом нельзя — стоит одному
      проходу пропустить дорожку, и громкости съедут на соседние. Тогда
      дорожка с нулевой громкостью заглушила бы чужую. }
    SetLength(FPreviewAudioTracks, Length(FPreviewAudioTracks) + 1);
    FPreviewAudioTracks[High(FPreviewAudioTracks)] := FProject.Tracks[I].Id;
  end;

  if Length(Missing) > 0 then
  begin
    FGenerateBusy := True;
    SetStatus('Готовлю вставки для предпросмотра...');
    { Вставки — картинки и связки — попадают в ролик наравне со съёмкой,
      поэтому целятся в тот же битрейт. }
    GenMaster := FProject.Master;
    GenMaster.VideoBitrate := FProject.MaxVideoBitrate;
    FGenerate := TGenerateThread.Create(Missing, GenMaster);
    FGenerate.OnProgress := @GenerateProgress;
    FGenerate.OnLog := @GenerateLog;
    FGenerate.OnTerminate := @GenerateDone;
    FGenerate.Start;
    Exit;
  end;

  LoadPreviewEdl(Segments, AudioSegs);
end;

{ Список кусков оверлея и окна его показа.

  Список должен покрывать монтаж от начала и без разрывов: плеер
  выравнивает дорожки по времени, и дыра сдвинула бы всё, что после неё.
  Промежутки заполняются тем же файлом — показывать его там всё равно
  никто не будет, за это отвечают окна. }
procedure TMainForm.BuildOverlayPreview(const AOverlays: TPreviewOverlays;
  const ATotal: Double);
var
  Segs: TFlatSegmentArray;
  Win: TOverlayWindow;
  I, N: Integer;
  At: Double;

  procedure Push(const APath: string; const AStart, ADuration: Double);
  begin
    if ADuration <= 0.001 then
      Exit;
    SetLength(Segs, N + 1);
    Segs[N] := Default(TFlatSegment);
    Segs[N].FilePath := APath;
    Segs[N].SrcStart := AStart;
    Segs[N].Duration := ADuration;
    Inc(N);
  end;

begin
  FPreviewOverlayUrl := '';
  FPreviewOverlayWindows := nil;
  if Length(AOverlays) = 0 then
    Exit;

  N := 0;
  At := 0;
  for I := 0 to High(AOverlays) do
  begin
    { Промежуток до этого куска — заполнитель из того же файла. }
    if AOverlays[I].TlStart > At + 0.001 then
      Push(AOverlays[I].FilePath, 0, AOverlays[I].TlStart - At);
    Push(AOverlays[I].FilePath, AOverlays[I].SrcStart,
      AOverlays[I].TlEnd - AOverlays[I].TlStart);
    At := AOverlays[I].TlEnd;

    Win := Default(TOverlayWindow);
    Win.TlStart := AOverlays[I].TlStart;
    Win.TlEnd := AOverlays[I].TlEnd;
    Win.Filter := AOverlays[I].Filter;
    Win.X := AOverlays[I].X;
    Win.Y := AOverlays[I].Y;
    Win.Width := AOverlays[I].Width;
    Win.Height := AOverlays[I].Height;
    SetLength(FPreviewOverlayWindows, Length(FPreviewOverlayWindows) + 1);
    FPreviewOverlayWindows[High(FPreviewOverlayWindows)] := Win;
  end;

  { Хвост после последнего куска не нужен: наложение там выключено, а
    плеер спокойно доигрывает основу без второй дорожки. }
  if N = 0 then
  begin
    FPreviewOverlayWindows := nil;
    Exit;
  end;
  FPreviewOverlayUrl := BuildEdlUri(Segs);
end;

procedure TMainForm.LoadPreviewEdl(const ASegments, AAudio: TFlatSegmentArray);
var
  Edl, AudioEdl: string;
  Pos, Total: Double;
  WasPaused: Boolean;
  I: Integer;
begin
  { Кадр проекта задаётся до загрузки: mpv должен показывать то, что
    получится в готовом ролике, а не размер очередного исходника. Файл
    другого соотношения сторон иначе выглядел бы в предпросмотре во весь
    экран, а в ролике — с полями по краям. }
  ApplyPreviewFrame;

  Edl := BuildEdlUri(ASegments);
  { Списки кусков звуковых дорожек уже построены при пересборке: там же
    проверено, что все вставки тишины существуют. }
  AudioEdl := '';
  for I := 0 to High(FPreviewAudioUrls) do
    AudioEdl := AudioEdl + FPreviewAudioUrls[I] + '|';
  { Наложение входит в сравнение наравне со звуком: сдвинули оверлей —
    список кусков основы мог не измениться, а показывать надо иначе. }
  AudioEdl := AudioEdl + '#' + FPreviewOverlayUrl;
  for I := 0 to High(FPreviewOverlayWindows) do
    AudioEdl := AudioEdl + Format('|%s@%d:%d:%s-%s',
      [FPreviewOverlayWindows[I].Filter,
       FPreviewOverlayWindows[I].X, FPreviewOverlayWindows[I].Y,
       SecondsToStr(FPreviewOverlayWindows[I].TlStart),
       SecondsToStr(FPreviewOverlayWindows[I].TlEnd)]);

  { Список кусков запоминаем всегда, даже если строка не изменилась:
    громкость в неё не входит, а брать её потом неоткуда. }
  FPreviewSegments := AAudio;
  FLastVolumeSent := -1;
  if (Edl = FLastLoadedEdl) and (AudioEdl = FLastLoadedAudioEdl) then
    Exit;

  Pos := FTimeline.Playhead;
  { Курсор мог оказаться за концом монтажа, если правка его укоротила.
    Просить у плеера несуществующее время бессмысленно. }
  Total := TotalDuration(ASegments);
  if Pos > Total then
    Pos := Max(0, Total - 0.05);
  WasPaused := FPlayer.Paused;

  { Позиция и состояние паузы задаются прямо при загрузке, а не отдельной
    перемоткой следом. Иначе mpv успевает начать с нуля, и на каждой
    правке монтажа слышен и виден кусок не оттуда. }
  { Внешний звук назначается до загрузки: он часть того, что открывается. }
  FPlayer.SetAudioSources(FPreviewAudioUrls);
  FPlayer.SetVideoOverlay(FPreviewOverlayUrl, FPreviewOverlayWindows);
  FPlayer.LoadUrl(Edl, Format('start=%s,pause=%s',
    [SecondsToStr(Pos), BoolToStr(WasPaused, 'yes', 'no')]));
  FLastLoadedEdl := Edl;
  FLastLoadedAudioEdl := AudioEdl;

  { Пока плеер не доедет, его сообщения о позиции игнорируются — иначе
    курсор на монтаже прыгнул бы в начало при каждой правке. }
  FSeekTarget := Pos;
  FSeekPending := True;
  FSeekWaitTicks := 0;

  SetStatus(Format('Предпросмотр: %d %s, %s с',
    [Length(ASegments), Plural(Length(ASegments), 'кусок', 'куска', 'кусков'),
     SecondsToStr(TotalDuration(ASegments))]));
  UpdateTimeLabel;
end;

{ Ставит плееру громкость того куска, который звучит сейчас.

  Композитинга нет, поэтому в каждый момент звучит ровно один кусок, и
  громкость всего вывода можно просто приравнять его громкости. Ставим
  только при изменении: команда на каждый кадр была бы напрасной. }
{ --- Недавние проекты --- }

procedure TMainForm.RefreshRecentMenu;
var
  I: Integer;
  Item: TMenuItem;
begin
  if FRecentMenu = nil then
    Exit;
  FRecentMenu.Clear;

  for I := 0 to FSettings.RecentProjects.Count - 1 do
  begin
    Item := TMenuItem.Create(FRecentMenu);
    { Номер в начале даёт быстрый выбор глазами, а полный путь в подсказке
      различает одноимённые проекты из разных папок. }
    Item.Caption := Format('%d. %s',
      [I + 1, ExtractFileName(FSettings.RecentProjects[I])]);
    Item.Hint := FSettings.RecentProjects[I];
    Item.Tag := I;
    Item.OnClick := @OpenRecentProject;
    FRecentMenu.Add(Item);
  end;

  FRecentMenu.Enabled := FSettings.RecentProjects.Count > 0;

  { Пункты добавлены только что, своих цветов у них ещё нет. }
  ApplyDarkMenu(FRecentMenu.GetParentMenu);
end;

procedure TMainForm.OpenRecentProject(Sender: TObject);
var
  Idx: Integer;
  Path: string;
begin
  Idx := TMenuItem(Sender).Tag;
  if (Idx < 0) or (Idx >= FSettings.RecentProjects.Count) then
    Exit;
  Path := FSettings.RecentProjects[Idx];

  if not FileExists(Path) then
  begin
    ThemedMessageDlg('nlve', 'Файл больше не существует:' + LineEnding + Path,
      mtWarning, [mbOK], 0);
    FSettings.RecentProjects.Delete(Idx);
    RefreshRecentMenu;
    Exit;
  end;

  if not ConfirmDiscard then
    Exit;
  OpenProjectFile(Path);
end;

{ Открытие проекта из файла. Общая точка для меню, списка недавних и
  командной строки: иначе часть из них забывала бы что-нибудь обновить. }
function TMainForm.OpenProjectFile(const APath: string): Boolean;
var
  Err: string;
begin
  Result := FProject.LoadFromFile(APath, Err);
  if not Result then
  begin
    ThemedMessageDlg('nlve', Err, mtError, [mbOK], 0);
    Exit;
  end;

  FTimeline.Playhead := 0;
  FTimeline.ZoomToFit;
  FLastLoadedEdl := '';
  RefreshPool;
  UpdateRippleButton;
  UpdateCaption;
  SchedulePreview;

  FSettings.NoteRecentProject(FProject.FileName);
  RefreshRecentMenu;
  Log('Открыт проект: ' + FProject.FileName);
end;

{ --- Схлопывание --- }

{ Кнопка показывает и состояние, и режим: утоплена — автосхлопывание
  включено, надпись говорит, на какие дорожки оно действует. }
procedure TMainForm.UpdateRippleButton;
var
  ModeText: string;
begin
  if FProject.RippleMode = rmAllTracks then
    ModeText := 'все дорожки'
  else
    ModeText := 'текущая дорожка';
  btnRipple.Down := FProject.RippleEnabled;
  if FProject.RippleEnabled then
    btnRipple.Hint := 'Автосхлопывание включено, режим: ' + ModeText + '.'
  else
    btnRipple.Hint := 'Автосхлопывание выключено, режим: ' + ModeText + '.';
  btnRipple.Hint := btnRipple.Hint + LineEnding +
    'Ctrl+K — включить или выключить. Режим действует и при выключенном ' +
    'автосхлопывании: по нему работает Ctrl+Shift+R.';
  btnRippleMenu.Hint := 'Выбрать режим схлопывания';
end;

{ Прилипание краёв клипов друг к другу.

  Shift работает как переключатель наоборот: при включённом прилипании
  временно отключает его, при выключенном — временно включает. Так одна
  клавиша полезна в обоих режимах, и не нужно помнить, какой сейчас. }
{ Кнопка со значком не может сказать словами, что она делает и в каком
  она состоянии. Слова переезжают в подсказку — целиком, вместе с
  состоянием: иначе о состоянии пришлось бы догадываться по цвету. }
procedure TMainForm.UpdateSnapButton;
var
  State: string;
begin
  btnSnap.Down := FTimeline.SnapEnabled;
  if FTimeline.SnapEnabled then
    State := 'включено'
  else
    State := 'выключено';
  btnSnap.Hint := 'Прилипание: ' + State + '.' + LineEnding +
    'Shift во время перетаскивания меняет решение на противоположное.';
end;

procedure TMainForm.btnSnapClick(Sender: TObject);
begin
  FTimeline.SnapEnabled := not FTimeline.SnapEnabled;
  UpdateSnapButton;
end;

{ Прилипание курсора — отдельный переключатель, а не общий с клипами.

  Это разные привычки: клипы прилипают при перетаскивании, курсор — при
  щелчке. Одному нужно одно, другому другое, и объединять их в один
  выключатель значило бы навязывать связь, которой нет. }
procedure TMainForm.UpdateGlueButton;
var
  State: string;
begin
  btnGlue.Down := FTimeline.PlayheadSnap;
  if FTimeline.PlayheadSnap then
    State := 'включено'
  else
    State := 'выключено';
  btnGlue.Hint := 'Прилипание курсора к границам клипов: ' + State + '.' +
    LineEnding + 'Shift при щелчке меняет решение на противоположное.';
end;

procedure TMainForm.btnGlueClick(Sender: TObject);
begin
  FTimeline.PlayheadSnap := not FTimeline.PlayheadSnap;
  UpdateGlueButton;
end;

procedure TMainForm.ToggleRipple;
begin
  FProject.RippleEnabled := not FProject.RippleEnabled;
  UpdateRippleButton;
  if FProject.RippleEnabled then
    SetStatus('Автосхлопывание включено: клипы правее едут вместе с перетаскиваемым.')
  else
    SetStatus('Автосхлопывание выключено: клипы правее остаются на месте.');
end;

procedure TMainForm.btnRippleClick(Sender: TObject);
begin
  ToggleRipple;
end;

procedure TMainForm.RippleModeChosen(Sender: TObject);
begin
  if TMenuItem(Sender).Tag = 1 then
    FProject.RippleMode := rmAllTracks
  else
    FProject.RippleMode := rmCurrentTrack;
  { Выбор режима из списка заодно включает автосхлопывание: иначе выбор
    выглядел бы так, будто ничего не произошло. }
  FProject.RippleEnabled := True;
  UpdateRippleButton;
end;

procedure TMainForm.btnRippleMenuClick(Sender: TObject);
var
  P: TPoint;
  I: Integer;
begin
  for I := 0 to FRippleMenu.Items.Count - 1 do
    FRippleMenu.Items[I].Checked :=
      (FRippleMenu.Items[I].Tag = 1) = (FProject.RippleMode = rmAllTracks);
  P := btnRippleMenu.ClientToScreen(Point(0, btnRippleMenu.Height));
  FRippleMenu.PopUp(P.X, P.Y);
end;

{ --- Меню библиотеки --- }

procedure TMainForm.BuildPoolMenu;
var
  Item: TMenuItem;
begin
  FPoolMenu := TPopupMenu.Create(Self);
  FPoolMenu.OnPopup := @PoolMenuPopup;

  FPoolAddMenu := TMenuItem.Create(FPoolMenu);
  FPoolAddMenu.Caption := 'Добавить на дорожку';
  FPoolMenu.Items.Add(FPoolAddMenu);

  Item := TMenuItem.Create(FPoolMenu);
  Item.Caption := '-';
  FPoolMenu.Items.Add(Item);

  Item := TMenuItem.Create(FPoolMenu);
  Item.Caption := 'Кадрирование и поворот...';
  Item.OnClick := @PoolEditTransform;
  FPoolMenu.Items.Add(Item);

  Item := TMenuItem.Create(FPoolMenu);
  Item.Caption := '-';
  FPoolMenu.Items.Add(Item);

  Item := TMenuItem.Create(FPoolMenu);
  Item.Caption := 'Убрать со всех дорожек';
  Item.OnClick := @PoolRemoveFromTracks;
  FPoolMenu.Items.Add(Item);

  Item := TMenuItem.Create(FPoolMenu);
  Item.Caption := 'Удалить из проекта';
  Item.OnClick := @PoolRemoveFromProject;
  FPoolMenu.Items.Add(Item);

  lstPool.PopupMenu := FPoolMenu;

  { Меню режимов схлопывания. }
  FRippleMenu := TPopupMenu.Create(Self);

  Item := TMenuItem.Create(FRippleMenu);
  Item.Caption := 'Только текущая дорожка';
  Item.RadioItem := True;
  Item.Tag := 0;
  Item.OnClick := @RippleModeChosen;
  FRippleMenu.Items.Add(Item);

  Item := TMenuItem.Create(FRippleMenu);
  Item.Caption := 'Все дорожки';
  Item.RadioItem := True;
  Item.Tag := 1;
  Item.OnClick := @RippleModeChosen;
  FRippleMenu.Items.Add(Item);
end;

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

  Сам по себе список этого не делает: правая кнопка выделение не меняет.
  А меню без выделенного файла отключается целиком и выглядит так, будто
  оно не работает вовсе. }
procedure TMainForm.lstPoolMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  Idx: Integer;
begin
  if Button <> mbRight then
    Exit;
  Idx := lstPool.ItemAtPos(Point(X, Y), True);
  if Idx >= 0 then
    lstPool.ItemIndex := Idx;
end;

procedure TMainForm.PoolMenuPopup(Sender: TObject);
var
  I: Integer;
  Item: TMenuItem;
  { Не Enabled: это имя занято свойством формы. }
  HasSelection: Boolean;
begin
  FPoolAddMenu.Clear;
  for I := 0 to FProject.TrackCount - 1 do
  begin
    Item := TMenuItem.Create(FPoolAddMenu);
    Item.Caption := FProject.Tracks[I].Name;
    Item.Tag := I;
    Item.OnClick := @PoolAddToTrack;
    FPoolAddMenu.Add(Item);
  end;

  HasSelection := SelectedPoolIndex(lstPool) >= 0;
  for I := 0 to FPoolMenu.Items.Count - 1 do
    FPoolMenu.Items[I].Enabled := HasSelection;
end;

procedure TMainForm.PoolAddToTrack(Sender: TObject);
begin
  AddClipFromPool(SelectedPoolIndex(lstPool), TMenuItem(Sender).Tag,
    FTimeline.Playhead);
end;

{ Убирает клипы файла со всех дорожек, оставляя сам файл в проекте.
  Дыры намеренно не схлопываются: убрать клип и переставить всё остальное —
  два разных намерения. }
procedure TMainForm.PoolRemoveFromTracks(Sender: TObject);
var
  Idx, T, C, Removed: Integer;
  Item: TMediaItem;
  Track: TTrack;
begin
  Idx := SelectedPoolIndex(lstPool);
  if (Idx < 0) or (Idx >= FProject.PoolCount) then
    Exit;
  Item := FProject.Pool[Idx];

  FProject.BeginChange;
  Removed := 0;
  for T := 0 to FProject.TrackCount - 1 do
  begin
    Track := FProject.Tracks[T];
    for C := Track.Count - 1 downto 0 do
      if Track[C].MediaId = Item.Id then
      begin
        Track.Remove(Track[C]);
        Inc(Removed);
      end;
  end;

  if Removed = 0 then
  begin
    FProject.CancelChange;
    SetStatus('Клипов этого файла на монтаже нет.');
    Exit;
  end;

  FTimeline.Invalidate;
  SchedulePreview;
  UpdateCaption;
  SetStatus(Format('Убрано %d %s',
    [Removed, Plural(Removed, 'клип', 'клипа', 'клипов')]));
end;

{ Кадрирование отдельного клипа. Вызывается кнопкой в углу клипа.

  Настройка принадлежит клипу: два куска одного файла бывает нужно
  кадрировать по-разному. У файла хранится такая же, но она лишь
  заготовка для новых клипов. }
procedure TMainForm.TimelineClipTransform(Sender: TObject; AClip: TClip);
var
  Item: TMediaItem;
  T: TMediaTransform;
  Key: TColorKey;
  Applied: Boolean;
begin
  if AClip = nil then
    Exit;

  { У надписи кнопка на клипе открывает не кадрирование, а правку текста:
    кадрировать там нечего. }
  if AClip.Kind = ckText then
  begin
    FProject.BeginChange;
    if EditTextOf(AClip) then
      TimelineStructureChange(nil)
    else
      FProject.CancelChange;
    Exit;
  end;

  Item := FProject.FindMedia(AClip.MediaId);
  if Item = nil then
    Exit;

  if not FProject.MasterSet then
  begin
    ThemedMessageDlg('nlve',
      'Параметры проекта ещё не заданы: добавьте сначала видеофайл.',
      mtInformation, [mbOK], 0);
    Exit;
  end;

  T := AClip.Transform;
  { Ключ отдаётся окну по ссылке: правку он подтверждает сам, и «Отмена»
    кадрирования её не отменяет. }
  Key := AClip.ColorKey;
  Applied := EditTransform(Self, Item.EffectivePath, Item.Info,
    FProject.Master.Width, FProject.Master.Height, T,
    FProject.CacheDir + 'pancrop.png', @Key);
  if (not Applied) and SameColorKey(Key, AClip.ColorKey) then
    Exit;

  FProject.BeginChange;
  if Applied then
    AClip.Transform := T;
  AClip.ColorKey := Key;
  FTimeline.Invalidate;
  FLastLoadedEdl := '';
  SchedulePreview;
  UpdateCaption;
end;

{ Заготовка кадрирования для файла: её берёт новый клип при добавлении. }
procedure TMainForm.PoolEditTransform(Sender: TObject);
var
  Idx: Integer;
  Item: TMediaItem;
  T: TMediaTransform;
begin
  Idx := SelectedPoolIndex(lstPool);
  if (Idx < 0) or (Idx >= FProject.PoolCount) then
    Exit;
  Item := FProject.Pool[Idx];

  if not FProject.MasterSet then
  begin
    ThemedMessageDlg('nlve',
      'Параметры проекта ещё не заданы: добавьте сначала видеофайл.',
      mtInformation, [mbOK], 0);
    Exit;
  end;

  T := Item.Transform;
  if not EditTransform(Self, Item.Path, Item.Info,
    FProject.Master.Width, FProject.Master.Height, T,
    FProject.CacheDir + 'pancrop.png') then
    Exit;

  FProject.BeginChange;
  Item.Transform := T;
  { Приведённая копия сделана со старыми настройками и больше не годится. }
  if Item.NormalizedPath <> '' then
  begin
    Item.NormalizedPath := '';
    Item.IndexLoaded := False;
    Log('Настройки кадра изменились — приведённую копию надо сделать заново.');
  end;
  UpdateCaption;
  SchedulePreview;
  SetStatus('Кадрирование обновлено: ' + FitModeCaption(T.Fit));
end;

procedure TMainForm.MenuProjectInfo(Sender: TObject);
begin
  ShowProjectInfo(Self, FProject);
end;

procedure TMainForm.PoolRemoveFromProject(Sender: TObject);
var
  Idx: Integer;
  Item: TMediaItem;
begin
  Idx := SelectedPoolIndex(lstPool);
  if (Idx < 0) or (Idx >= FProject.PoolCount) then
    Exit;
  Item := FProject.Pool[Idx];

  if ThemedMessageDlg('nlve', 'Удалить ' + ExtractFileName(Item.Path) +
    ' из проекта? Его клипы пропадут со всех дорожек.',
    mtConfirmation, [mbYes, mbNo], 0) <> mrYes then
    Exit;

  FProject.BeginChange;
  FProject.RemoveMedia(Item);
  RefreshPool;
  FTimeline.Invalidate;
  SchedulePreview;
  UpdateCaption;
end;

{ Файлы бросили на окно программы.

  Место броска решает, что с ними делать: над монтажом — сразу и в проект,
  и на дорожку под указателем; в любом другом месте — только в проект.
  Своих координат обработчик не получает, поэтому берём положение
  указателя. }
procedure TMainForm.FormFilesDropped(Sender: TObject;
  const FileNames: array of string);
var
  I, TrackIdx: Integer;
  Pt: TPoint;
  OverTimeline: Boolean;
  DropTime: Double;
  Added: Boolean;
begin
  Pt := FTimeline.ScreenToClient(Mouse.CursorPos);
  OverTimeline := (Pt.X >= 0) and (Pt.Y >= 0) and
    (Pt.X < FTimeline.Width) and (Pt.Y < FTimeline.Height);

  Added := False;
  for I := 0 to High(FileNames) do
    if FileExists(FileNames[I]) then
    begin
      AddMediaFile(ExpandFileName(FileNames[I]));
      Added := True;
    end;
  if not Added then
    Exit;

  RefreshPool;
  UpdateCaption;

  if not OverTimeline then
  begin
    SetStatus('Файлы добавлены в проект.');
    Exit;
  end;

  { Бросили над монтажом — кладём последний добавленный на дорожку под
    указателем. }
  lstPool.ItemIndex := FProject.PoolCount - 1;
  TrackIdx := FTimeline.TrackIndexAtPoint(Pt.Y);
  DropTime := FTimeline.TimeAtPoint(Pt.X);
  AddClipFromPool(FProject.PoolCount - 1, TrackIdx, DropTime);
end;

{ Громкость клипов в предпросмотре.

  Дорожки смешиваются, поэтому одной общей громкостью не обойтись: у
  каждой дорожки под курсором свой клип со своей громкостью. Значения
  собираются по дорожкам и отдаются плееру; он подставляет их в свою
  цепочку смешивания.

  Пересобирать цепочку на каждый кадр нельзя — она создаётся заново и
  звук щёлкает. Поэтому только при изменении. }
procedure TMainForm.UpdateSubtitles;
var
  Path: string;
begin
  if (FProject = nil) or (FPlayer = nil) then
    Exit;
  if FProject.CacheDir = '' then
    Exit;

  Path := IncludeTrailingPathDelimiter(FProject.CacheDir) + 'subs.ass';
  if WriteAssFile(FProject, Path) then
    FPlayer.SetSubtitleFile(Path)
  else
    FPlayer.SetSubtitleFile('');
end;

procedure TMainForm.ApplyVolumeAt(const ATime: Double);
var
  I: Integer;
  Clip: TClip;
  Track: TTrack;
  Vols: array of Double;
  Key: string;
begin
  if (FPlayer = nil) or (not FPlayer.Initialized) then
    Exit;
  if FProject = nil then
    Exit;

  Vols := nil;
  Key := '';
  for I := 0 to High(FPreviewAudioTracks) do
  begin
    Track := FProject.FindTrack(FPreviewAudioTracks[I]);
    SetLength(Vols, Length(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;

  if Key = FLastVolumeKey then
    Exit;
  FLastVolumeKey := Key;

  { Кто какую громкость получил — в журнал. Иначе разбираться, почему в
    одном месте звук есть, а в соседнем нет, приходится по снимкам
    экрана. }
  Key := '';
  for I := 0 to High(FPreviewAudioTracks) do
  begin
    if Key <> '' then
      Key := Key + ', ';
    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]));

  FPlayer.SetTrackVolumes(Vols);
  if FPlayer.AudioGraph <> '' then
    Log('Цепочка звука: ' + FPlayer.AudioGraph);
end;

procedure TMainForm.GenerateProgress(Sender: TObject);
begin
  SetStatus(FGenerate.StageText);
end;

procedure TMainForm.GenerateLog(Sender: TObject);
begin
  Log(FGenerate.PendingLog);
end;

procedure TMainForm.GenerateDone(Sender: TObject);
var
  Ok: Boolean;
  Msg: string;
begin
  Ok := FGenerate.Succeeded;
  Msg := FGenerate.Message;
  FGenerate := nil;
  FGenerateBusy := False;

  if not Ok then
  begin
    Log('Не удалось подготовить вставки: ' + Msg);
    SetStatus('Вставки подготовить не удалось.');
    Exit;
  end;

  { Файлы появились — теперь список кусков соберётся целиком. }
  SchedulePreview;
end;

{ --- Обработчики компонентов --- }

{ Перемотка с отметкой «ждём прибытия».

  Плеер после перемотки, а тем более после перезагрузки списка кусков,
  какое-то время сообщает старую позицию или ноль. Если верить этим
  сообщениям, курсор на монтаже прыгнет в начало — именно это и
  происходило при перетаскивании клипа. Поэтому до тех пор, пока плеер
  не окажется рядом с запрошенным местом, его сообщения о позиции
  игнорируются. }
procedure TMainForm.SeekPlayerTo(const ATime: Double);
begin
  if (FPlayer = nil) or (not FPlayer.Initialized) then
    Exit;
  FSeekTarget := ATime;
  FSeekPending := True;
  FSeekWaitTicks := 0;
  FPlayer.SeekAbsolute(ATime);
end;

procedure TMainForm.TimelinePlayheadChange(Sender: TObject);
begin
  UpdateTimeLabel;
  { Если курсор двинул сам плеер, перематывать его обратно нельзя —
    получится бесконечная переброска. }
  if FUpdatingFromPlayer then
    Exit;
  SeekPlayerTo(FTimeline.Playhead);
end;

procedure TMainForm.TimelineStructureChange(Sender: TObject);
begin
  SchedulePreview;
  UpdateCaption;
  UpdateTimeLabel;
end;

procedure TMainForm.TimelineSelectionChange(Sender: TObject);
begin
  SetStatus(Format('Выделено %d %s', [FProject.SelectedCount,
    Plural(FProject.SelectedCount, 'клип', 'клипа', 'клипов')]));
end;

procedure TMainForm.PlayerLog(Sender: TObject; const APrefix, ALevel, AText: string);
begin
  Log('[' + ALevel + '] ' + APrefix + ': ' + TrimRight(AText));
end;

procedure TMainForm.PlayerTimePos(Sender: TObject);
begin
  if FSeekPending then
  begin
    Inc(FSeekWaitTicks);
    { Ещё не доехали до запрошенного места — не трогаем курсор.
      Но ждём не бесконечно: запрошенное время может оказаться за концом
      монтажа, и тогда плеер до него не доедет никогда. }
    if (Abs(FPlayer.TimePos - FSeekTarget) > 0.35) and
       (FSeekWaitTicks < MaxSeekWaitTicks) then
      Exit;
    FSeekPending := False;
  end;

  { Обновляем курсор только при заметном сдвиге: mpv сообщает позицию на
    каждый кадр, и перерисовывать монтаж 60 раз в секунду незачем. }
  if Abs(FPlayer.TimePos - FTimeline.Playhead) < 0.01 then
    Exit;

  ApplyVolumeAt(FPlayer.TimePos);

  FUpdatingFromPlayer := True;
  try
    FTimeline.Playhead := FPlayer.TimePos;
    { Во время воспроизведения держим курсор посередине: так видно, что
      будет дальше, и не приходится гоняться за ним прокруткой. }
    if not FPlayer.Paused then
      FTimeline.ScrollToPlayhead(True);
  finally
    FUpdatingFromPlayer := False;
  end;
end;

procedure TMainForm.PlayerDuration(Sender: TObject);
var
  Hw: string;
begin
  UpdateTimeLabel;

  { Момент, когда файл уже открыт и про декодирование известно всё.
    Сообщаем один раз на загрузку и только при смене: если декодирует
    процессор, тяжёлый материал поедет рывками, и знать об этом надо
    заранее, а не гадать, почему предпросмотр дёргается. }
  Hw := FPlayer.HwdecCurrent;
  if Hw = FLastHwdec then
    Exit;
  FLastHwdec := Hw;

  if (Hw = '') or (Hw = 'no') then
  begin
    Log('Внимание: видео декодирует процессор. ' +
      'Тяжёлый материал может идти рывками.');
    { Больше не пробуем. Иначе на каждой правке монтажа mpv заново
      перебирает способы аппаратного декодирования, каждый раз впустую и
      каждый раз с десятком строк ошибок в журнале. Так ведёт себя Wine,
      где ни DXVA2, ни CUDA не работают. }
    FPlayer.SetHwdec('no');
  end
  else
    Log('Декодирование видео: ' + Hw);

  { Откуда взялся звук. Строка меняется редко, поэтому пишется только при
    изменении — иначе журнал забился бы повторами. }
  if FPlayer.AudioTrackNote <> FLastAudioNote then
  begin
    FLastAudioNote := FPlayer.AudioTrackNote;
    if FLastAudioNote <> '' then
      Log(FLastAudioNote);
  end;
end;

procedure TMainForm.PlayerPauseChange(Sender: TObject);
begin
  { Отдельной кнопки пуска нет — пробел делает то же самое, а состояние
    видно по тому, едет ли курсор. Здесь остаётся только отметка в
    строке состояния. }
  if FPlayer.Paused then
    SetStatus('Пауза')
  else
    SetStatus('Воспроизведение');
end;

{ Пуск и пауза. При запуске подтягиваем окно просмотра к курсору: если
  он уехал за край, воспроизведение шло бы вслепую. Масштаб при этом не
  трогаем — он выставлен осознанно. }
procedure TMainForm.TogglePlayback;
begin
  if (FPlayer = nil) or (not FPlayer.Initialized) then
    Exit;
  if FPlayer.Paused then
    FTimeline.ScrollToPlayhead(False);
  FPlayer.TogglePause;
end;



procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  { Пробел обрабатываем здесь, а не пунктом меню: пункт меню с пробелом
    в качестве сочетания мешает вводу текста в других полях. }
  if (Key = VK_SPACE) and (Shift = []) then
  begin
    Key := 0;
    TogglePlayback;
  end;
end;

{ --- Пункты меню --- }

procedure TMainForm.MenuNewProject(Sender: TObject);
begin
  if not ConfirmDiscard then
    Exit;
  FProject.NewProject;
  FTimeline.Playhead := 0;
  FTimeline.ZoomToFit;
  FLastLoadedEdl := '';
  RefreshPool;
  UpdateCaption;
  SchedulePreview;
  Log('Новый проект.');
end;

procedure TMainForm.MenuOpenProject(Sender: TObject);
var
  Err: string;
begin
  if not ConfirmDiscard then
    Exit;
  if not OpenProjectDialog.Execute then
    Exit;
  FSettings.LastProjectDir := ExtractFilePath(OpenProjectDialog.FileName);
  OpenProjectFile(OpenProjectDialog.FileName);
end;

function TMainForm.SaveProjectAs: Boolean;
var
  Err: string;
begin
  Result := False;
  if not SaveProjectDialog.Execute then
    Exit;
  FSettings.LastProjectDir := ExtractFilePath(SaveProjectDialog.FileName);
  if not FProject.SaveToFile(SaveProjectDialog.FileName, Err) then
  begin
    ThemedMessageDlg('nlve', Err, mtError, [mbOK], 0);
    Exit;
  end;
  UpdateCaption;
  FSettings.NoteRecentProject(FProject.FileName);
  RefreshRecentMenu;
  Log('Проект сохранён: ' + FProject.FileName);
  Result := True;
end;

function TMainForm.DoSaveProject: Boolean;
var
  Err: string;
begin
  if FProject.FileName = '' then
    Exit(SaveProjectAs);
  Result := FProject.SaveToFile(FProject.FileName, Err);
  if not Result then
    ThemedMessageDlg('nlve', Err, mtError, [mbOK], 0)
  else
  begin
    UpdateCaption;
    Log('Проект сохранён.');
  end;
end;

procedure TMainForm.MenuSaveProject(Sender: TObject);
begin
  DoSaveProject;
end;

procedure TMainForm.MenuSaveProjectAs(Sender: TObject);
begin
  SaveProjectAs;
end;

function TMainForm.ConfirmDiscard: Boolean;
begin
  Result := True;
  if not FProject.Modified then
    Exit;
  case ThemedMessageDlg('nlve', 'Проект изменён. Сохранить?',
    mtConfirmation, [mbYes, mbNo, mbCancel], 0) of
    mrYes: Result := DoSaveProject;
    mrNo: Result := True;
  else
    Result := False;
  end;
end;

procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose := ConfirmDiscard;
end;

procedure TMainForm.MenuQuit(Sender: TObject);
begin
  Close;
end;

procedure TMainForm.MenuDeps(Sender: TObject);
begin
  ShowDeps(Self);

  { Библиотека могла появиться только что. Перезапуск ради этого требовать
    незачем: загрузка идёт по имени, и вторая попытка ничем не хуже
    первой. }
  if (FPlayer <> nil) and (not FPlayer.Initialized) then
  begin
    Log('Проверяю, появилась ли libmpv...');
    StartPlayer;
    if FPlayer.Initialized then
    begin
      FLastLoadedEdl := '';
      SchedulePreview;
      SetStatus('Предпросмотр заработал.');
    end;
  end;
end;

procedure TMainForm.MenuRemux(Sender: TObject);
var
  Form: TRemuxForm;
begin
  Form := TRemuxForm.Create(Self);
  try
    Form.ShowModal;
  finally
    Form.Free;
  end;
end;

procedure TMainForm.MenuUndo(Sender: TObject);
begin
  if not FProject.CanUndo then
  begin
    SetStatus('Отменять нечего.');
    Exit;
  end;
  FProject.Undo;
  RefreshPool;
  FTimeline.Invalidate;
  SchedulePreview;
  UpdateCaption;
  SetStatus('Отменено.');
end;

procedure TMainForm.MenuRedo(Sender: TObject);
begin
  if not FProject.CanRedo then
  begin
    SetStatus('Повторять нечего.');
    Exit;
  end;
  FProject.Redo;
  RefreshPool;
  FTimeline.Invalidate;
  SchedulePreview;
  UpdateCaption;
  SetStatus('Повторено.');
end;

procedure TMainForm.MenuSplit(Sender: TObject);
begin
  FTimeline.SplitAtPlayhead(False, True);
end;

procedure TMainForm.MenuSplitPrecise(Sender: TObject);
begin
  FTimeline.SplitAtPlayhead(True, True);
  SetStatus('Точный рез: стык будет перекодирован при сборке.');
end;

procedure TMainForm.MenuDelete(Sender: TObject);
begin
  FTimeline.DeleteSelected;
end;

{ Цветовой ключ выделенного клипа.

  Ключ принадлежит клипу, а не файлу: один и тот же кусок может лежать в
  монтаже дважды, и выбивать цвет нужно не всегда.

  Клип с ключом перестаёт быть сплошным, и участок под ним собирается
  слоями — тем же способом, что и полупрозрачный. Значит, эти секунды
  придётся пересчитать; об этом окно предупреждает. }
procedure TMainForm.MenuColorKey(Sender: TObject);
var
  T, C: Integer;
  Track: TTrack;
  Found: TClip;
  Item: TMediaItem;
  Key: TColorKey;
begin
  Found := nil;
  for T := 0 to FProject.TrackCount - 1 do
  begin
    Track := FProject.Tracks[T];
    for C := 0 to Track.Count - 1 do
      if Track[C].Selected and (Track[C].Kind in [ckVideo, ckImage]) then
      begin
        Found := Track[C];
        Break;
      end;
    if Found <> nil then
      Break;
  end;

  if Found = nil then
  begin
    SetStatus('Выделите клип с картинкой: ключ выбивает цвет из неё.');
    Exit;
  end;

  Item := FProject.FindMedia(Found.MediaId);
  if Item = nil then
    Exit;

  Key := Found.ColorKey;
  if not EditColorKey(Key, Item.EffectivePath,
    Found.SrcIn + Found.Duration / 2, FProject.CacheDir + 'colorkey.png') then
    Exit;

  FProject.BeginChange;
  Found.ColorKey := Key;
  FTimeline.Invalidate;
  FLastLoadedEdl := '';
  SchedulePreview;
  UpdateCaption;
  if Key.Enabled then
    SetStatus('Цветовой ключ включён: участок будет пересобран.')
  else
    SetStatus('Цветовой ключ выключен.');
end;

{ Отметки участка.

  Участок нужен, чтобы собрать кусок монтажа, а не весь ролик: на длинном
  материале проверить правку иначе почти невозможно — сборка занимает
  столько же, сколько сам ролик, а то и больше.

  Отметки ставятся по курсору, как в монтажных программах. Перепутанные
  местами меняются сами: требовать от человека помнить порядок — лишняя
  строгость там, где всё однозначно. }
procedure TMainForm.MenuRegionIn(Sender: TObject);
begin
  FProject.RegionStart := FTimeline.Playhead;
  if FProject.RegionEnd <= FProject.RegionStart then
    FProject.RegionEnd := FProject.EndTime;
  FTimeline.Invalidate;
  UpdateCaption;
  SetStatus(Format('Участок: %s — %s',
    [SecondsToStr(FProject.RegionStart), SecondsToStr(FProject.RegionEnd)]));
end;

procedure TMainForm.MenuRegionOut(Sender: TObject);
var
  Tmp: Double;
begin
  FProject.RegionEnd := FTimeline.Playhead;
  if FProject.RegionEnd < FProject.RegionStart then
  begin
    Tmp := FProject.RegionStart;
    FProject.RegionStart := FProject.RegionEnd;
    FProject.RegionEnd := Tmp;
  end;
  FTimeline.Invalidate;
  UpdateCaption;
  SetStatus(Format('Участок: %s — %s',
    [SecondsToStr(FProject.RegionStart), SecondsToStr(FProject.RegionEnd)]));
end;

procedure TMainForm.MenuRegionClear(Sender: TObject);
begin
  FProject.RegionStart := 0;
  FProject.RegionEnd := 0;
  FTimeline.Invalidate;
  UpdateCaption;
  SetStatus('Отметки участка сняты: собирается весь монтаж.');
end;

{ Границы того, что собираем. Без отметок — весь монтаж. }
procedure TMainForm.DescribeRegion(out AFrom, ATo: Double);
begin
  if FProject.HasRegion then
  begin
    AFrom := Max(0, FProject.RegionStart);
    ATo := FProject.RegionEnd;
  end
  else
  begin
    AFrom := 0;
    ATo := FProject.EndTime;
  end;
end;

procedure TMainForm.MenuSelectAll(Sender: TObject);
begin
  FTimeline.SelectAll;
end;

procedure TMainForm.MenuRipple(Sender: TObject);
begin
  FTimeline.RippleCloseGap;
end;

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

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

  Считается это не бесплатно, хотя и недорого: фильтр работает по площади
  оверлея, а не всего кадра. Замерено на 2688x1512: наложение стоит 0.36 с
  на десять секунд материала, ключ добавляет ещё 0.23 с. }
procedure TMainForm.MenuTogglePreviewKey(Sender: TObject);
begin
  FSettings.PreviewKey := not FSettings.PreviewKey;
  FKeyPreviewItem.Checked := FSettings.PreviewKey;
  { Список кусков не изменился, а показывать надо иначе — заставляем
    пересобрать цепочку. }
  FLastLoadedEdl := '';
  SchedulePreview;
  if FSettings.PreviewKey then
    SetStatus('Предпросмотр показывает ключ и прозрачность.')
  else
    SetStatus('Предпросмотр показывает оверлей как есть.');
end;

procedure TMainForm.MenuToggleRipple(Sender: TObject);
begin
  ToggleRipple;
end;

procedure TMainForm.MenuGoStart(Sender: TObject);
begin
  FTimeline.Playhead := FTimeline.FirstClipTime;
  FTimeline.ScrollToPlayhead(False);
end;

{ К концу самого позднего клипа по всем дорожкам. }
procedure TMainForm.MenuGoEnd(Sender: TObject);
begin
  FTimeline.Playhead := FTimeline.LastClipTime;
  FTimeline.ScrollToPlayhead(False);
end;

procedure TMainForm.MenuZoomFit(Sender: TObject);
begin
  FTimeline.ZoomToFit;
end;

procedure TMainForm.MenuZoomIn(Sender: TObject);
begin
  FTimeline.ZoomAt(1.5, FTimeline.ClientWidth div 2);
end;

procedure TMainForm.MenuZoomOut(Sender: TObject);
begin
  FTimeline.ZoomAt(1 / 1.5, FTimeline.ClientWidth div 2);
end;

procedure TMainForm.MenuAddTrack(Sender: TObject);
begin
  FProject.BeginChange;
  FProject.AddTrack('V' +
            IntToStr(FProject.TrackCountOf(tkVideo) + 1));
  FTimeline.Invalidate;
  UpdateCaption;
end;

procedure TMainForm.MenuRemoveTrack(Sender: TObject);
begin
  if FProject.TrackCount <= 1 then
  begin
    SetStatus('Последнюю дорожку удалить нельзя.');
    Exit;
  end;
  FProject.BeginChange;
  FProject.RemoveTrack(FProject.TrackCount - 1);
  if FTimeline.ActiveTrack >= FProject.TrackCount then
    FTimeline.ActiveTrack := FProject.TrackCount - 1;
  FTimeline.Invalidate;
  SchedulePreview;
  UpdateCaption;
end;

{ --- Приведение файла к параметрам проекта --- }

procedure TMainForm.NormalizeProgress(Sender: TObject);
begin
  if Assigned(FNormalizeUi) then
  begin
    FNormalizeUi.SetStage(FNormalize.Title);
    FNormalizeUi.SetFraction(FNormalize.Fraction);
  end;
end;

procedure TMainForm.NormalizeLog(Sender: TObject);
begin
  if Assigned(FNormalizeUi) then
    FNormalizeUi.AddLog(FNormalize.PendingLog);
end;

procedure TMainForm.NormalizeDone(Sender: TObject);
begin
  if Assigned(FNormalizeUi) then
    FNormalizeUi.Finish(FNormalize.Succeeded, FNormalize.Message);
end;

procedure TMainForm.NormalizeCancel(Sender: TObject);
begin
  if Assigned(FNormalize) then
    FNormalize.RequestCancel;
end;

{ --- Сборка ролика --- }

{ Обычная сборка: копирование потоков, ради чего редактор и делался. }
procedure TMainForm.MenuExport(Sender: TObject);
begin
  DoExport(Default(TEncodeProfile));
end;

{ Сборка с перекодированием: отдельный пункт, потому что это осознанный
  выбор — ролик пересобирается целиком, и быстрым это уже не будет. }
procedure TMainForm.MenuExportEncode(Sender: TObject);
var
  Profile: TEncodeProfile;
begin
  if not AskEncodeProfile(Profile, FProject.Master.VideoCodec) then
    Exit;
  DoExport(Profile);
end;

procedure TMainForm.DoExport(const AProfile: TEncodeProfile);
var
  Segments, AudioSegs: TFlatSegmentArray;
  Missing: TGenRequests;
  HasPrecise: Boolean;
  T, C: Integer;
  Rebuilt, RegionFrom, RegionTo: Double;
  SubsPath, RegionCaption: string;
  Master: TMediaInfo;
begin
  if not FlattenProject(FProject, Segments, AudioSegs, Missing) then
  begin
    ThemedMessageDlg('nlve', 'На монтаже нечего собирать.', mtInformation, [mbOK], 0);
    Exit;
  end;

  if Length(Missing) > 0 then
  begin
    ThemedMessageDlg('nlve',
      'Ещё не готовы вставки для картинок или пустых мест. ' +
      'Подождите, пока они создадутся, и повторите.',
      mtInformation, [mbOK], 0);
    SchedulePreview;
    Exit;
  end;

  { Отмеченный участок: от списка кусков остаётся только он. Куски,
    задетые краем, подрезаются — картинка и звук режутся по одному и тому
    же времени, иначе они разъедутся. }
  DescribeRegion(RegionFrom, RegionTo);
  RegionCaption := '';
  if FProject.HasRegion then
  begin
    RegionCaption := SecondsToStr(RegionFrom) + ' — ' + SecondsToStr(RegionTo);
    ClipSegmentsToRange(Segments, RegionFrom, RegionTo);
    ClipSegmentsToRange(AudioSegs, RegionFrom, RegionTo);
    if Length(Segments) = 0 then
    begin
      ThemedMessageDlg('nlve',
        'В отмеченном участке нечего собирать.', mtInformation, [mbOK], 0);
      Exit;
    end;
  end;

  { Сколько материала придётся пересобрать. Наложение, переход,
    полупрозрачность и чужие параметры файла — всё это перекодирование, и
    человек должен знать цену заранее, а не обнаружить её по времени
    сборки. }
  Rebuilt := 0;
  for T := 0 to High(Segments) do
    if Segments[T].Transcode or (Length(Segments[T].Layers) > 0) then
      Rebuilt := Rebuilt + Segments[T].Duration;

  { Если есть хоть один точный рез, предупреждаем про контейнер: в MP4
    перекодированный кусок и скопированный уживаются не всегда, а MKV
    к смене параметров потока терпимее. }
  HasPrecise := False;
  for T := 0 to FProject.TrackCount - 1 do
    for C := 0 to FProject.Tracks[T].Count - 1 do
      if (FProject.Tracks[T][C].EdgeIn = edPrecise) or
         (FProject.Tracks[T][C].EdgeOut = edPrecise) then
        HasPrecise := True;

  { Куда собирать, в каком контейнере и что делать с текстом — один
    вопрос: ответ на любую его часть меняет допустимое в остальных. }
  if not AskExport(FExportChoice, HasText(FProject), HasPrecise,
    FSettings.LastExportDir, RegionCaption) then
    Exit;
  FSettings.LastExportDir := ExtractFilePath(FExportChoice.Path);

  if HasPrecise and
     (LowerCase(ExtractFileExt(FExportChoice.Path)) <> '.mkv') then
    if ThemedMessageDlg('nlve',
      'В монтаже есть точные резы. В MP4 перекодированный стык может ' +
      'воспроизводиться неправильно — надёжнее MKV.' + LineEnding +
      LineEnding + 'Всё равно собрать в выбранный контейнер?',
      mtWarning, [mbYes, mbNo], 0) <> mrYes then
      Exit;

  { Вжигание меняет расклад: куски с текстом перестают копироваться.
    Готовим их до подсчёта того, сколько придётся пересобрать. }
  SubsPath := '';
  if HasText(FProject) then
  begin
    if FExportChoice.BurnText then
      { Начало списка — не обязательно начало монтажа: при отмеченном
        участке текст надо брать с его начала. }
      Rebuilt := Rebuilt +
        BurnTextIntoSegments(FProject, Segments, FProject.CacheDir, RegionFrom)
    else
    begin
      SubsPath := IncludeTrailingPathDelimiter(FProject.CacheDir) +
        'export.ass';
      { Разметка тоже по участку: иначе субтитры в готовом файле
        появлялись бы со сдвигом на его начало. }
      if not WriteAssForRange(FProject, RegionFrom, RegionTo, SubsPath) then
        SubsPath := '';
    end;
  end;

  if Rebuilt > 0.5 then
    if ThemedMessageDlg('nlve',
      Format('Часть ролика придётся пересобрать: %s с из %s.' + LineEnding +
        LineEnding +
        'Пересобираются участки с наложением, переходами, прозрачностью, ' +
        'вжигаемым текстом и куски файлов, не совпадающих с параметрами ' +
        'проекта. Остальное копируется без потерь и почти мгновенно.' +
        LineEnding + LineEnding +
        'Продолжить?',
        [SecondsToStr(Rebuilt), SecondsToStr(TotalDuration(Segments))]),
      mtConfirmation, [mbYes, mbNo], 0) <> mrYes then
      Exit;

  if FProject.HasRegion then
    Log(Format('Собирается отмеченный участок: %s — %s',
      [SecondsToStr(RegionFrom), SecondsToStr(RegionTo)]));
  Log('Сборка в ' + FExportChoice.Path);
  Log(Format('%d %s, длительность %s с',
    [Length(Segments), Plural(Length(Segments), 'кусок', 'куска', 'кусков'),
     SecondsToStr(TotalDuration(Segments))]));

  { Пересобираемые куски целятся в битрейт самого щедрого исходника, а не
    в то, что кодировщик выберет сам: его выбор скромнее в разы, и
    пересобранный кусок оказывается заметно хуже соседних скопированных. }
  Master := FProject.Master;
  Master.VideoBitrate := FProject.MaxVideoBitrate;

  FExport := TExportThread.Create(Segments, AudioSegs,
    FExportChoice.Path, True, Master, AProfile);
  FExport.SubtitlePath := SubsPath;
  FExport.OnProgress := @ExportProgress;
  FExport.OnLog := @ExportLog;
  FExport.OnTerminate := @ExportDone;

  FExportUi := TProgressForm.Create(Self);
  try
    { Не «Сборка ролика»: так называется окно настроек, и два окна с
      одинаковым заголовком путают. }
    FExportUi.Caption := 'Ход сборки';
    FExportUi.OnCancelRequest := @ExportCancel;
    FExport.Start;
    FExportUi.ShowModal;
  finally
    FreeAndNil(FExportUi);
  end;

  if Assigned(FExport) then
  begin
    FExport.WaitFor;
    ShowExportReport(FExport.Report);
    FreeAndNil(FExport);
  end;
end;

procedure TMainForm.ExportProgress(Sender: TObject);
begin
  if Assigned(FExportUi) then
  begin
    FExportUi.SetStage(FExport.StageText);
    FExportUi.SetFraction(FExport.Fraction);
  end;
end;

procedure TMainForm.ExportLog(Sender: TObject);
begin
  if Assigned(FExportUi) then
    FExportUi.AddLog(FExport.PendingLog);
end;

procedure TMainForm.ExportCancel(Sender: TObject);
begin
  if Assigned(FExport) then
    FExport.RequestCancel;
end;

procedure TMainForm.ExportDone(Sender: TObject);
var
  Rep: TExportReport;
begin
  if not Assigned(FExportUi) then
    Exit;
  Rep := FExport.Report;
  FExportUi.Finish(Rep.Succeeded, Rep.Message);
  if Rep.Succeeded then
    FExportUi.AddLog('Файл: ' + Rep.OutputPath);
end;

procedure TMainForm.ShowExportReport(const AReport: TExportReport);
var
  I, Encoded: Integer;
  Shift: Double;
begin
  if AReport.Cancelled then
  begin
    Log('Сборка отменена.');
    Exit;
  end;

  if not AReport.Succeeded then
  begin
    Log('Сборка не удалась: ' + AReport.Message);
    Exit;
  end;

  Log('--- Отчёт о сборке ---');
  Encoded := 0;
  for I := 0 to High(AReport.Segments) do
  begin
    Shift := AReport.Segments[I].ActualStart - AReport.Segments[I].RequestedStart;
    if AReport.Segments[I].Encoded then
    begin
      Inc(Encoded);
      Log(Format('  часть %d (кусок %d, ПЕРЕКОДИРОВАНА): старт %s, длина %s, пакетов %d',
        [I + 1, AReport.Segments[I].Index + 1,
         SecondsToStr(AReport.Segments[I].ActualStart),
         SecondsToStr(AReport.Segments[I].Duration),
         AReport.Segments[I].Packets]));
    end
    else
      Log(Format('  часть %d (кусок %d): старт %s (просили %s, сдвиг %s), длина %s, пакетов %d',
        [I + 1, AReport.Segments[I].Index + 1,
         SecondsToStr(AReport.Segments[I].ActualStart),
         SecondsToStr(AReport.Segments[I].RequestedStart),
         SecondsToStr(Shift),
         SecondsToStr(AReport.Segments[I].Duration),
         AReport.Segments[I].Packets]));
  end;
  if Encoded > 0 then
    Log(Format('  перекодировано частей: %d, остальное скопировано без потерь',
      [Encoded]));

  Log(Format('  сумма пакетов кусков: %d', [AReport.ExpectedPackets]));
  Log(Format('  пакетов в готовом файле: %d', [AReport.ActualPackets]));
  if AReport.ExpectedPackets = AReport.ActualPackets then
    Log('  СВЕРКА ПРОЙДЕНА: склейка не потеряла и не продублировала ни одного кадра.')
  else
    Log(Format('  РАСХОЖДЕНИЕ на %d кадров.',
      [AReport.ActualPackets - AReport.ExpectedPackets]));
  Log('  файл: ' + AReport.OutputPath);
  SetStatus('Готово: ' + AReport.OutputPath);
end;

end.