nlve/src/uMpvPlayer.pas

{
  uMpvPlayer — обёртка над libmpv: встраивание видео в окно программы,
  управление воспроизведением, получение позиции.

  Два решения, которые стоит объяснить.

  1. Встраивание через опцию wid. Мы отдаём mpv числовой идентификатор
     окна, и он рисует прямо туда.

     Под Windows это HWND контрола, его можно брать у LCL напрямую.

     Под Linux сложнее, и первая же попытка это показала. Панель LCL
     под gtk2 своего окна не имеет (виджет помечен как NO_WINDOW), и
     запрос окна у неё возвращает окно ближайшего предка — то есть всей
     формы. Отдав такой идентификатор, мы получили видео поверх кнопок
     и журнала: mpv честно занял всё окно, которое ему дали.

     Поэтому под X11 мы заводим собственное дочернее окно ровно по
     границам панели и отдаём mpv его. Заодно исчезает зависимость от
     того, как именно LCL решит устроить виджеты внутри контрола.
     Положение окна поддерживается в согласии с панелью в SyncVideoRect.

  2. Откачка событий таймером, а не колбэком. У libmpv есть
     mpv_set_wakeup_callback, но он вызывается из потока mpv, а трогать
     оттуда интерфейс нельзя — получится редко воспроизводимое падение.
     Поэтому события забираются из главного потока по таймеру: чуть менее
     изящно, зато гонок не бывает в принципе.
}
unit uMpvPlayer;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Types, Controls, ExtCtrls, ctypes,
  {$IFDEF LCLGTK2}
  x, xlib,
  {$ENDIF}
  uAppTypes, uEdl, uMpvLib;

type
  { Имена параметров с префиксом A не для красоты: Text — это свойство
    TControl, и обработчик события внутри формы с таким параметром
    не соберётся. }
  TMpvLogEvent = procedure(Sender: TObject; const APrefix, ALevel, AText: string) of object;

  TMpvPlayer = class
  private
    FHandle: Pmpv_handle;
    FVideoParent: TWinControl;
    FPump: TTimer;
    FTimePos: Double;
    FDuration: Double;
    FPaused: Boolean;
    FHasTimePos: Boolean;
    FInitialized: Boolean;
    FVideoFilter: string;
    FHwdec: string;
    FAudioSource: string;
    FAudioSources: array of string;
    { Наложение: список кусков оверлея и окна, когда и куда его класть. }
    FOverlayUrl: string;
    FOverlayWindows: TOverlayWindows;
    { Номера видеодорожек: своя (основа) и подключённая для наложения.
      Пусто — наложения нет. }
    FBaseVid: string;
    FOverlayVid: string;
    FTrackVolumes: array of Double;
    { Номера подключённых звуковых дорожек, в порядке подключения. }
    FAudioIds: array of string;
    FLastGraph: string;
    FSubtitlePath: string;
    { Что произошло с выбором звуковой дорожки. Читается окном для
      журнала: без этого понять, откуда взялся звук, нечем. }
    FAudioTrackNote: string;
    { Работаем ли под Wine. Там свои правила вывода картинки, и узнать об
      этом надо до создания плеера. }
    FUnderWine: Boolean;
    FOnTimePos: TNotifyEvent;
    FOnDuration: TNotifyEvent;
    FOnPauseChange: TNotifyEvent;
    FOnLog: TMpvLogEvent;
    {$IFDEF LCLGTK2}
    FDisplay: PDisplay;
    FVideoWin: TWindow;
    FLastRect: TRect;
    {$ENDIF}
    { Создаёт (если надо) окно под видео и возвращает идентификатор для wid.
      Ноль означает неудачу, текст причины кладётся в Error. }
    function EnsureVideoWindow(out Error: string): PtrUInt;
    { Подгоняет окно видео под текущие границы панели. Вызывается из
      того же таймера, что откачивает события: так не приходится
      подписываться на изменение размеров и перемещение каждого предка,
      а лишней работы не возникает — координаты сравниваются с прошлыми. }
    procedure SyncVideoRect;
    procedure PumpEvents(Sender: TObject);
    procedure HandlePropertyChange(AProp: Pmpv_event_property);
    procedure HandleLogMessage(AMsg: Pmpv_event_log_message);
    { Выбирает внешнюю звуковую дорожку, если она есть.

      Без этого mpv играет звук, встроенный в саму картинку: внешний файл
      он лишь добавляет ещё одной дорожкой, а выбирает по своему
      усмотрению. Получалось, что звук слышен там, где на монтаже его нет
      вовсе — он приходил из видеофайла, а не с звуковой дорожки. }
    procedure SelectExternalAudio;
    { Подключает оверлей второй видеодорожкой и запоминает её номер. }
    procedure AttachOverlay;
    { Часть цепочки, которая кладёт оверлей на основу. Пусто — нечего
      класть. }
    function OverlayGraph: string;
    { Цепочка смешивания звуковых дорожек с их громкостями. }
    { Собственная запись в журнал программы. Идёт тем же путём, что и
      сообщения самого mpv: у окна для них уже есть обработчик. }
    procedure Note(const AText: string);
    procedure BuildGraph;
    function SetOption(const AName, AValue: string): Integer;
  public
    constructor Create(AVideoParent: TWinControl);
    destructor Destroy; override;

    { Создаёт и настраивает экземпляр mpv. Вызывать после того, как окно
      родительского контрола реально создано, иначе брать идентификатор
      будет неоткуда. }
    function Initialize(out Error: string): Boolean;

    { Команда mpv в виде массива аргументов. Именно массивом, а не одной
      строкой: так не нужно ничего экранировать, и путь с пробелами или
      кавычками не сломает разбор. }
    function Command(const Args: array of string): Integer;

    procedure LoadSegments(const Segments: TFlatSegmentArray);
    { AOptions — настройки для загружаемого файла, например
      'start=12.5,pause=no'. Задать позицию прямо здесь важнее, чем
      кажется: иначе mpv начинает с нуля и лишь потом перематывается,
      и на каждой перезагрузке слышен и виден кусок не оттуда. }
    procedure LoadUrl(const AUrl: string; const AOptions: string = '');
    procedure TogglePause;
    procedure SetPaused(AValue: Boolean);
    procedure SeekAbsolute(const ASeconds: Double);
    procedure Stop;

    { Громкость в процентах: 100 — как в исходнике.

      Отдельной громкости у куска mpv не знает, но она и не нужна:
      композитинга нет, в каждый момент звучит ровно один кусок, поэтому
      громкость текущего куска и есть громкость всего вывода. }
    procedure SetVolume(const APercent: Double);

    { Цепочка фильтров ffmpeg поверх всего, что играет.

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

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

      Пустая строка снимает фильтры. }
    procedure SetVideoFilter(const AFilter: string);

    { Способ декодирования: 'auto-safe' — обычный, кадры остаются в памяти
      видеокарты; 'auto-copy' — с копированием в обычную память.

      Различие важно ровно из-за фильтров: цепочка ffmpeg работает с
      обычной памятью и на кадрах видеокарты просто отказывается
      собираться. Копирование стоит скорости, поэтому включается только
      когда фильтр действительно нужен. }
    procedure SetHwdec(const AMode: string);

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

      Пустая строка снимает внешний звук. }
    procedure SetAudioSource(const AUrl: string);

    { Несколько звуковых дорожек монтажа разом. Плеер играет только одну,
      поэтому смесь собирается его же средствами — см. AttachAudio. }
    procedure SetAudioSources(const AUrls: array of string);
    { Что класть поверх картинки. Пустой список кусков — ничего.

      Наложение делает сам плеер, ничего заранее не собирается: две
      дорожки играются одна поверх другой. }
    procedure SetVideoOverlay(const AUrl: string;
      const AWindows: TOverlayWindows);

    { Громкость каждой звуковой дорожки монтажа. Подставляется в цепочку
      смешивания: одной общей громкостью тут не обойтись. }
    procedure SetTrackVolumes(const AVolumes: array of Double);

    function GetPropString(const AName: string): string;
    function GetPropDouble(const AName: string; out AValue: Double): Boolean;

    { Что в итоге получилось с аппаратным декодированием. Пусто или 'no' —
      значит видео декодируется процессором, и тяжёлый материал поедет
      рывками. Проверять после того, как файл загрузился. }
    function HwdecCurrent: string;

    { Есть ли уже достоверная позиция. До первого сообщения от mpv показывать
      курсор воспроизведения бессмысленно. }
    property HasTimePos: Boolean read FHasTimePos;
    property Initialized: Boolean read FInitialized;
    property UnderWine: Boolean read FUnderWine;
    property AudioTrackNote: string read FAudioTrackNote;
    property TimePos: Double read FTimePos;
    property Duration: Double read FDuration;
    property Paused: Boolean read FPaused;
    property OnTimePos: TNotifyEvent read FOnTimePos write FOnTimePos;
    property OnDuration: TNotifyEvent read FOnDuration write FOnDuration;
    property OnPauseChange: TNotifyEvent read FOnPauseChange write FOnPauseChange;
    property OnLog: TMpvLogEvent read FOnLog write FOnLog;
    { Цепочка смешивания, отданная mpv. Нужна журналу: по ней видно, какая
      дорожка какую громкость получила на самом деле. }
    property AudioGraph: string read FLastGraph;
    { Файл субтитров поверх картинки. Пустая строка снимает его.

      Держится отдельно от списка кусков: текст правится чаще, чем
      монтаж, и перезагружать из-за него картинку незачем. }
    { AForce — перечитать файл, даже если имя прежнее. Нужно всегда, когда
      разметка переписана: имя у неё одно на весь проект, и по имени
      изменение не видно. }
    procedure SetSubtitleFile(const APath: string; AForce: Boolean = False);
  end;

implementation

uses
  DynLibs
  {$IFDEF LCLGTK2}
  , glib2, gtk2, gdk2, gdk2x
  {$ENDIF};

{$IFDEF WINDOWS}
{ Wine честно сообщает о себе: в ntdll у него есть функция
  wine_get_version, которой в настоящей Windows нет. Это признанный
  способ проверки, а не догадка по косвенным признакам. }
function RunningUnderWine: Boolean;
var
  H: TLibHandle;
begin
  Result := False;
  H := LoadLibrary('ntdll.dll');
  if H = NilHandle then
    Exit;
  Result := GetProcAddress(H, 'wine_get_version') <> nil;
end;
{$ENDIF}

const
  { Период откачки событий. 25 мс это 40 обновлений в секунду — курсор
    на таймлайне движется плавно, а нагрузки никакой. }
  PumpIntervalMs = 25;

  { Идентификаторы, по которым потом узнаём, какое свойство изменилось.
    Числа произвольные, важна только уникальность. }
  IdTimePos = 1;
  IdDuration = 2;
  IdPause = 3;

function TMpvPlayer.EnsureVideoWindow(out Error: string): PtrUInt;
{$IFDEF LCLGTK2}
var
  Widget: PGtkWidget;
  HostWin: PGdkWindow;
  HostXid: TWindow;
  OriginX, OriginY: gint;
  R: TRect;
{$ENDIF}
begin
  Error := '';
  Result := 0;

  if (FVideoParent = nil) or (not FVideoParent.HandleAllocated) then
  begin
    Error := 'Панель предпросмотра ещё не создана.';
    Exit;
  end;

  {$IFDEF LCLWIN32}
  { Под Windows у контрола есть настоящий HWND, ничего изобретать не нужно. }
  Result := PtrUInt(FVideoParent.Handle);
  if Result = 0 then
    Error := 'Не удалось получить HWND панели предпросмотра.';
  {$ENDIF}

  {$IFDEF LCLGTK2}
  if FVideoWin <> 0 then
    Exit(PtrUInt(FVideoWin));

  Widget := {%H-}PGtkWidget(FVideoParent.Handle);
  if Widget = nil then
  begin
    Error := 'У панели предпросмотра нет виджета GTK.';
    Exit;
  end;

  { До реализации виджета никакого окна не существует. }
  gtk_widget_realize(Widget);

  { Это окно почти наверняка принадлежит не панели, а форме — панель
    своего окна не имеет. Нам оно нужно только как родитель и как
    источник указателя на дисплей. }
  HostWin := Widget^.window;
  if HostWin = nil then
  begin
    Error := 'У панели предпросмотра нет окна X11 даже после реализации виджета.';
    Exit;
  end;

  FDisplay := gdk_x11_drawable_get_xdisplay(PGdkDrawable(HostWin));
  HostXid := gdk_x11_drawable_get_xid(PGdkDrawable(HostWin));
  if (FDisplay = nil) or (HostXid = 0) then
  begin
    Error := 'Не удалось получить дисплей или окно X11 для встраивания видео.';
    Exit;
  end;

  { Координаты панели считаем относительно найденного окна, а не формы:
    так работает при любой вложенности контролов. }
  gdk_window_get_origin(HostWin, @OriginX, @OriginY);
  R := Rect(
    FVideoParent.ClientOrigin.X - OriginX,
    FVideoParent.ClientOrigin.Y - OriginY,
    FVideoParent.ClientOrigin.X - OriginX + FVideoParent.ClientWidth,
    FVideoParent.ClientOrigin.Y - OriginY + FVideoParent.ClientHeight);

  { Ширина и высота нулями быть не должны: X11 такое окно не создаст. }
  if R.Right <= R.Left then
    R.Right := R.Left + 1;
  if R.Bottom <= R.Top then
    R.Bottom := R.Top + 1;

  { Последние два нуля — цвет рамки и цвет фона. Ноль в истинноцветном
    режиме это чёрный, то есть то, что нужно под видео. }
  FVideoWin := XCreateSimpleWindow(FDisplay, HostXid,
    R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top, 0, 0, 0);
  if FVideoWin = 0 then
  begin
    Error := 'XCreateSimpleWindow не смог создать окно под видео.';
    Exit;
  end;

  XMapWindow(FDisplay, FVideoWin);
  XSync(FDisplay, 0);

  FLastRect := R;
  Result := PtrUInt(FVideoWin);
  {$ENDIF}
end;

procedure TMpvPlayer.SyncVideoRect;
{$IFDEF LCLGTK2}
var
  Widget: PGtkWidget;
  HostWin: PGdkWindow;
  OriginX, OriginY: gint;
  R: TRect;
{$ENDIF}
begin
  {$IFDEF LCLGTK2}
  if (FVideoWin = 0) or (FDisplay = nil) then
    Exit;
  if (FVideoParent = nil) or (not FVideoParent.HandleAllocated) then
    Exit;

  Widget := {%H-}PGtkWidget(FVideoParent.Handle);
  if Widget = nil then
    Exit;
  HostWin := Widget^.window;
  if HostWin = nil then
    Exit;

  gdk_window_get_origin(HostWin, @OriginX, @OriginY);
  R := Rect(
    FVideoParent.ClientOrigin.X - OriginX,
    FVideoParent.ClientOrigin.Y - OriginY,
    FVideoParent.ClientOrigin.X - OriginX + FVideoParent.ClientWidth,
    FVideoParent.ClientOrigin.Y - OriginY + FVideoParent.ClientHeight);

  if R.Right <= R.Left then
    R.Right := R.Left + 1;
  if R.Bottom <= R.Top then
    R.Bottom := R.Top + 1;

  { Дёргать X11 на каждый тик таймера незачем — только когда
    прямоугольник реально изменился. }
  if (R.Left = FLastRect.Left) and (R.Top = FLastRect.Top) and
     (R.Right = FLastRect.Right) and (R.Bottom = FLastRect.Bottom) then
    Exit;

  FLastRect := R;
  XMoveResizeWindow(FDisplay, FVideoWin,
    R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top);
  XFlush(FDisplay);
  {$ENDIF}
end;

constructor TMpvPlayer.Create(AVideoParent: TWinControl);
begin
  inherited Create;
  FVideoParent := AVideoParent;
  FPump := TTimer.Create(nil);
  FPump.Enabled := False;
  FPump.Interval := PumpIntervalMs;
  FPump.OnTimer := @PumpEvents;
end;

procedure TMpvPlayer.Note(const AText: string);
begin
  if Assigned(FOnLog) then
    FOnLog(Self, 'nlve', 'info', AText);
end;

{ Закрытие плеера.

  Порядок здесь не случайный, и стоил зависания под Wine.

  mpv_terminate_destroy не просто отпускает клиента — она ждёт, пока ядро
  mpv свернёт всю свою работу и добьёт свои потоки. Под Wine это ожидание
  не кончалось никогда: журнал обрывался на «закрываю плеер», и дальше
  ничего. Под Linux та же функция отрабатывает мгновенно.

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

  Команду «завершиться» перед этим не посылаем намеренно: она тоже
  выполняется ядром и под Wine могла бы встать точно так же. Отсоединение
  ни от чего не зависит.

  Окно, в которое рисовал mpv, убирается только после этого: в обратном
  порядке он успел бы обратиться к уже несуществующему окну. }
destructor TMpvPlayer.Destroy;
begin
  FPump.Enabled := False;
  FreeAndNil(FPump);
  if FHandle <> nil then
  begin
    if Assigned(mpv_destroy) then
    begin
      Note('плеер: отсоединяюсь от mpv');
      mpv_destroy(FHandle);
    end
    else
    begin
      { Старая libmpv без mpv_destroy: другого способа нет, ждём. }
      Note('плеер: закрываю mpv с ожиданием');
      mpv_terminate_destroy(FHandle);
    end;
    FHandle := nil;
    Note('плеер: закрыт');
  end;
  {$IFDEF LCLGTK2}
  if (FVideoWin <> 0) and (FDisplay <> nil) then
  begin
    XDestroyWindow(FDisplay, FVideoWin);
    XFlush(FDisplay);
    FVideoWin := 0;
  end;
  {$ENDIF}
  inherited Destroy;
end;

function TMpvPlayer.SetOption(const AName, AValue: string): Integer;
begin
  Result := mpv_set_option_string(FHandle, PAnsiChar(AName), PAnsiChar(AValue));
end;

function TMpvPlayer.Initialize(out Error: string): Boolean;
var
  Wid: PtrUInt;
  Code: Integer;
begin
  Error := '';
  Result := False;

  if not MpvLibLoaded then
  begin
    Error := 'libmpv не загружена.';
    Exit;
  end;

  Wid := EnsureVideoWindow(Error);
  if Wid = 0 then
  begin
    if Error = '' then
      Error := 'Не удалось получить окно для встраивания видео: виджетсет не поддерживается.';
    Exit;
  end;

  { Обязательно до mpv_create: в локали с запятой в качестве десятичного
    разделителя libmpv просто отказывается создаваться. }
  ForceCNumericLocale;

  FHandle := mpv_create();
  if FHandle = nil then
  begin
    Error := 'mpv_create вернул пустой указатель.' + LineEnding +
      'Обычная причина — числовая локаль процесса не C: libmpv это не поддерживает. ' +
      'Реже — нехватка памяти или несовместимая версия библиотеки.';
    Exit;
  end;

  { Порядок важен: всё это должно быть выставлено до mpv_initialize. }

  { Не читать пользовательские mpv.conf и input.conf. Иначе чужие настройки
    (а у mpv их сотни) будут молча менять поведение редактора. }
  SetOption('config', 'no');
  SetOption('terminal', 'no');
  SetOption('ytdl', 'no');

  SetOption('wid', IntToStr(Wid));
  SetOption('vo', 'gpu');

  {$IFDEF WINDOWS}
  { Под настоящей Windows всё оставляем как есть: там и Direct3D 11, и
    аппаратное декодирование работают. Под Wine ни то, ни другое не
    работает, и настраиваться надо сразу, а не после десятка ошибок. }
  FUnderWine := RunningUnderWine;
  if FUnderWine then
  begin
    { Direct3D 11 в Wine падает при создании контекста, ещё до первого
      кадра. OpenGL там реализован надёжнее. }
    SetOption('gpu-api', 'opengl');
    { Ни DXVA2, ни CUDA в Wine нет, и дело не только в бесполезных
      попытках. Для DXVA2 mpv создаёт устройство Direct3D 9, а Wine при
      его создании сбрасывает гамму экрана в единицу — настройку всей
      системы, а не своего окна. Происходило это на каждой загрузке
      файла, то есть при каждом открытии проекта.

      Проверено на замерах: с auto-safe гамма 0.89 превращалась в 1.0,
      с no остаётся нетронутой. }
    SetOption('hwdec', 'no');
    FHwdec := 'no';
  end
  else
  begin
    SetOption('hwdec', 'auto-safe');
    FHwdec := 'auto-safe';
  end;

  { Управление цветом отключаем явно: снимок профиля экрана нам не нужен,
    а трогать настройку цвета всей системы программа права не имеет. }
  SetOption('icc-profile-auto', 'no');
  {$ELSE}
  { auto-safe вместо auto: берёт только те способы аппаратного
    декодирования, которые не портят картинку. }
  SetOption('hwdec', 'auto-safe');
  FHwdec := 'auto-safe';
  {$ENDIF}

  { keep-open=always — не выгружать файл по достижении конца, иначе после
    конца ролика позиция и длительность пропадут и курсор дёрнется. }
  SetOption('keep-open', 'always');
  SetOption('idle', 'yes');
  { Стартуем на паузе. Иначе первый же загруженный список кусков поедет
    сам: у незагруженного плеера признак паузы снят, и первая загрузка
    начинала воспроизведение без спроса. }
  SetOption('pause', 'yes');
  SetOption('force-window', 'yes');

  { Экранное меню и собственные горячие клавиши плееру не нужны:
    все клавиши обрабатывает редактор. }
  SetOption('osc', 'no');
  SetOption('osd-level', '0');
  SetOption('input-default-bindings', 'no');
  SetOption('input-vo-keyboard', 'no');
  SetOption('input-cursor', 'no');

  { Без этого mpv покажет MJPEG-обложку, которую камеры вроде DJI кладут
    в файл отдельным потоком, как «обложку альбома» вместо видео. }
  SetOption('audio-display', 'no');

  { Точная перемотка: щёлкнув по таймлайну, мы должны попадать в
    указанный кадр, а не в ближайший опорный. }
  SetOption('hr-seek', 'yes');

  { Разрешаем громкость выше обычной: у клипов её можно поднять вдвое. }
  SetOption('volume-max', '200');

  Code := mpv_initialize(FHandle);
  if Code < 0 then
  begin
    Error := 'mpv_initialize: ' + string(mpv_error_string(Code));
    mpv_terminate_destroy(FHandle);
    FHandle := nil;
    Exit;
  end;

  mpv_request_log_messages(FHandle, 'warn');

  mpv_observe_property(FHandle, IdTimePos, 'time-pos', MPV_FORMAT_DOUBLE);
  mpv_observe_property(FHandle, IdDuration, 'duration', MPV_FORMAT_DOUBLE);
  mpv_observe_property(FHandle, IdPause, 'pause', MPV_FORMAT_FLAG);

  FPump.Enabled := True;
  FInitialized := True;
  Result := True;
end;

function TMpvPlayer.Command(const Args: array of string): Integer;
var
  Holder: array of AnsiString = nil;
  Ptrs: array of PAnsiChar = nil;
  I: Integer;
begin
  if FHandle = nil then
    Exit(MPV_ERROR_UNINITIALIZED);

  { Строки держим в отдельном массиве, чтобы счётчик ссылок не обнулился
    и указатели не протухли до возврата из mpv_command. }
  SetLength(Holder, Length(Args));
  SetLength(Ptrs, Length(Args) + 1);
  for I := 0 to High(Args) do
  begin
    Holder[I] := Args[I];
    Ptrs[I] := PAnsiChar(Holder[I]);
  end;
  Ptrs[High(Ptrs)] := nil;

  Result := mpv_command(FHandle, PPAnsiChar(@Ptrs[0]));
end;

procedure TMpvPlayer.LoadSegments(const Segments: TFlatSegmentArray);
begin
  if Length(Segments) = 0 then
  begin
    Stop;
    Exit;
  end;
  LoadUrl(BuildEdlUri(Segments));
end;

procedure TMpvPlayer.LoadUrl(const AUrl: string; const AOptions: string);
var
  P: Integer;
  Part, Name, Value: string;
  Rest: string;
begin
  { Настройки файла раньше передавались прямо в loadfile четвёртым
    аргументом. В mpv 0.38 туда вставили номер позиции в списке, и старый
    вызов стал ошибкой: «The loadfile option must be an integer». Под
    Wine с новой библиотекой из-за этого не грузилось ничего.

    Гадать по номеру версии не нужно: те же самые настройки можно задать
    свойствами перед загрузкой. Свойства называются одинаково во всех
    версиях, и разбирать строку приходится нам, а не mpv. }
  { Цепочка смешивания снимается ДО загрузки.

    Она ссылается на дорожки по номерам. Оставшаяся от прошлого раза
    цепочка не даёт открыть новый файл вовсе: проверено на живом mpv —
    после такой загрузки дорожек ноль, кадра нет, не играет ничего.
    Снимать её после загрузки поздно. }
  FLastGraph := '';
  FAudioIds := nil;
  FOverlayVid := '';
  mpv_set_property_string(FHandle, 'lavfi-complex', '');

  Rest := AOptions;
  while Rest <> '' do
  begin
    P := Pos(',', Rest);
    if P = 0 then
    begin
      Part := Rest;
      Rest := '';
    end
    else
    begin
      Part := Copy(Rest, 1, P - 1);
      Rest := Copy(Rest, P + 1, Length(Rest));
    end;

    P := Pos('=', Part);
    if P = 0 then
      Continue;
    Name := Trim(Copy(Part, 1, P - 1));
    Value := Trim(Copy(Part, P + 1, Length(Part)));
    if Name <> '' then
      mpv_set_property_string(FHandle, PAnsiChar(Name), PAnsiChar(Value));
  end;

  Command(['loadfile', AUrl, 'replace']);
end;

procedure TMpvPlayer.TogglePause;
begin
  SetPaused(not FPaused);
end;

procedure TMpvPlayer.SetPaused(AValue: Boolean);
var
  Flag: cint;
begin
  if FHandle = nil then
    Exit;
  if AValue then
    Flag := 1
  else
    Flag := 0;
  mpv_set_property(FHandle, 'pause', MPV_FORMAT_FLAG, @Flag);
end;

procedure TMpvPlayer.SeekAbsolute(const ASeconds: Double);
begin
  Command(['seek', SecondsToStr(ASeconds), 'absolute', 'exact']);
end;

procedure TMpvPlayer.Stop;
begin
  Command(['stop']);
end;

procedure TMpvPlayer.SetVolume(const APercent: Double);
var
  V: cdouble;
begin
  if FHandle = nil then
    Exit;
  V := APercent;
  if V < 0 then
    V := 0;
  if V > 200 then
    V := 200;
  mpv_set_property(FHandle, 'volume', MPV_FORMAT_DOUBLE, @V);
end;

procedure TMpvPlayer.SetVideoFilter(const AFilter: string);
var
  Value: string;
begin
  if FHandle = nil then
    Exit;
  { Перестройка цепочки не бесплатна и заметна глазом, поэтому лишний раз
    её не трогаем: правка таймлайна идёт часто, а фильтр меняется редко. }
  if AFilter = FVideoFilter then
    Exit;
  FVideoFilter := AFilter;

  if AFilter = '' then
    Value := ''
  else
    { lavfi=[...] — мост к фильтрам ffmpeg: у mpv свои имена фильтров, и
      напрямую цепочку ffmpeg он не понимает. }
    Value := 'lavfi=[' + AFilter + ']';

  mpv_set_property_string(FHandle, 'vf', PAnsiChar(Value));
end;

procedure TMpvPlayer.SetAudioSource(const AUrl: string);
begin
  SetAudioSources([AUrl]);
end;

procedure TMpvPlayer.SetAudioSources(const AUrls: array of string);
var
  I, N: Integer;
begin
  { Здесь только запоминаем. Подключается звук после загрузки картинки,
    командой audio-add — см. SelectExternalAudio. }
  SetLength(FAudioSources, Length(AUrls));
  N := 0;
  for I := 0 to High(AUrls) do
    if AUrls[I] <> '' then
    begin
      FAudioSources[N] := AUrls[I];
      Inc(N);
    end;
  SetLength(FAudioSources, N);
  if N > 0 then
    FAudioSource := FAudioSources[0]
  else
    FAudioSource := '';
end;

procedure TMpvPlayer.SetVideoOverlay(const AUrl: string;
  const AWindows: TOverlayWindows);
var
  I: Integer;
begin
  FOverlayUrl := AUrl;
  SetLength(FOverlayWindows, Length(AWindows));
  for I := 0 to High(AWindows) do
    FOverlayWindows[I] := AWindows[I];
end;

procedure TMpvPlayer.SetTrackVolumes(const AVolumes: array of Double);
var
  I: Integer;
begin
  SetLength(FTrackVolumes, Length(AVolumes));
  for I := 0 to High(AVolumes) do
    FTrackVolumes[I] := AVolumes[I];
  BuildGraph;
end;

procedure TMpvPlayer.SetHwdec(const AMode: string);
begin
  if FHandle = nil then
    Exit;
  { Под Wine аппаратного декодирования нет вовсе, и включать его обратно
    ради фильтров бессмысленно. }
  if FUnderWine and (AMode <> 'no') then
    Exit;
  if AMode = FHwdec then
    Exit;
  FHwdec := AMode;
  mpv_set_property_string(FHandle, 'hwdec', PAnsiChar(AMode));
end;

function TMpvPlayer.GetPropString(const AName: string): string;
var
  P: PAnsiChar;
begin
  Result := '';
  if FHandle = nil then
    Exit;
  P := mpv_get_property_string(FHandle, PAnsiChar(AName));
  if P = nil then
    Exit;
  Result := string(P);
  { Строку выделила библиотека — освобождать её должна тоже она. }
  mpv_free(P);
end;

function TMpvPlayer.GetPropDouble(const AName: string; out AValue: Double): Boolean;
var
  D: cdouble;
begin
  AValue := 0;
  Result := False;
  if FHandle = nil then
    Exit;
  if mpv_get_property(FHandle, PAnsiChar(AName), MPV_FORMAT_DOUBLE, @D) < 0 then
    Exit;
  AValue := D;
  Result := True;
end;

function TMpvPlayer.HwdecCurrent: string;
begin
  Result := GetPropString('hwdec-current');
end;

procedure TMpvPlayer.HandlePropertyChange(AProp: Pmpv_event_property);
var
  Name: string;
begin
  { format = NONE означает, что свойство сейчас недоступно (например,
    time-pos, когда ничего не загружено). Читать data в этом случае нельзя. }
  if AProp^.format = MPV_FORMAT_NONE then
    Exit;

  Name := string(AProp^.name);

  if (Name = 'time-pos') and (AProp^.format = MPV_FORMAT_DOUBLE) then
  begin
    FTimePos := Pcdouble(AProp^.data)^;
    FHasTimePos := True;
    if Assigned(FOnTimePos) then
      FOnTimePos(Self);
  end
  else if (Name = 'duration') and (AProp^.format = MPV_FORMAT_DOUBLE) then
  begin
    FDuration := Pcdouble(AProp^.data)^;
    if Assigned(FOnDuration) then
      FOnDuration(Self);
  end
  else if (Name = 'pause') and (AProp^.format = MPV_FORMAT_FLAG) then
  begin
    FPaused := Pcint(AProp^.data)^ <> 0;
    if Assigned(FOnPauseChange) then
      FOnPauseChange(Self);
  end;
end;

{ Наложение оверлея на основу.

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

  Окна с одинаковым размером и местом объединяются в одну ветку: масштаб
  во времени не меняется, а вот показывать и прятать можно по времени —
  это и делает enable. }
function TMpvPlayer.OverlayGraph: string;
var
  I, J, N, Count: Integer;
  Filters: array of string;
  Xs, Ys: array of Integer;
  Enables: array of string;
  Src, Prev, Next, Fit: string;

  { Номер ветки для окна: у одинаковых по виду и месту она общая. }
  function GroupOf(const AWin: TOverlayWindow): Integer;
  var
    K: Integer;
  begin
    for K := 0 to Count - 1 do
      if (Filters[K] = AWin.Filter) and (Xs[K] = AWin.X) and
         (Ys[K] = AWin.Y) then
        Exit(K);
    SetLength(Filters, Count + 1);
    SetLength(Xs, Count + 1);
    SetLength(Ys, Count + 1);
    SetLength(Enables, Count + 1);
    Filters[Count] := AWin.Filter;
    Xs[Count] := AWin.X;
    Ys[Count] := AWin.Y;
    Enables[Count] := '';
    Result := Count;
    Inc(Count);
  end;

begin
  Result := '';
  if (FOverlayVid = '') or (FBaseVid = '') or
     (Length(FOverlayWindows) = 0) then
    Exit;

  Count := 0;
  for I := 0 to High(FOverlayWindows) do
  begin
    J := GroupOf(FOverlayWindows[I]);
    if Enables[J] <> '' then
      Enables[J] := Enables[J] + '+';
    Enables[J] := Enables[J] + Format('between(t,%s,%s)',
      [SecondsToStr(FOverlayWindows[I].TlStart),
       SecondsToStr(FOverlayWindows[I].TlEnd)]);
  end;

  { Одна ветка берёт оверлей напрямую, несколько — через split. }
  if Count = 1 then
    Result := Format('[vid%s]', [FOverlayVid])
  else
  begin
    Result := Format('[vid%s]split=%d', [FOverlayVid, Count]);
    for I := 0 to Count - 1 do
      Result := Result + Format('[q%d]', [I]);
    Result := Result + ';';
  end;

  for I := 0 to Count - 1 do
  begin
    if Count = 1 then
      Src := ''
    else
      Src := Format('[q%d]', [I]);
    Fit := Filters[I];
    if Fit = '' then
      Fit := 'null';
    Result := Result + Format('%s%s[ov%d];', [Src, Fit, I]);
  end;

  Prev := Format('[vid%s]', [FBaseVid]);
  for I := 0 to Count - 1 do
  begin
    if I = Count - 1 then
      Next := '[vo]'
    else
      Next := Format('[m%d]', [I]);
    { eof_action=pass и repeatlast=0: оверлей короче основы — обычное
      дело, и после его конца картинка должна идти дальше как ни в чём
      не бывало. }
    Result := Result + Format('%s[ov%d]overlay=%d:%d:enable=''%s''' +
      ':eof_action=pass:repeatlast=0%s;',
      [Prev, I, Xs[I], Ys[I], Enables[I], Next]);
    Prev := Next;
  end;
end;

procedure TMpvPlayer.BuildGraph;
var
  I: Integer;
  Graph, Vol, Video: string;
  NeedAudioPart: Boolean;
begin
  if FHandle = nil then
    Exit;

  Video := OverlayGraph;

  { Цепочка отбирает дорожки: всё, что в ней не упомянуто, mpv снимает с
    выбора. Поэтому при наложении звук приходится вести через неё же,
    даже когда дорожка одна, — иначе он просто пропадёт. }
  NeedAudioPart := (Length(FAudioIds) > 1) or
    ((Video <> '') and (Length(FAudioIds) > 0));

  if Length(FAudioIds) = 0 then
  begin
    { Дорожек нет — снимаем приглушение, иначе оно пережило бы смену
      монтажа и заглушило следующий. }
    SetVolume(100);
    Graph := Video;
    if Graph <> FLastGraph then
    begin
      FLastGraph := Graph;
      mpv_set_property_string(FHandle, 'lavfi-complex', PAnsiChar(Graph));
    end;
    Exit;
  end;

  { Одна дорожка без наложения играется как есть: цепочка тут только
    мешала бы, да и громкость задаётся обычным способом. }
  if not NeedAudioPart then
  begin
    Graph := '';
    if (Length(FTrackVolumes) > 0) and (Abs(FTrackVolumes[0] - 1) > 0.001) then
      SetVolume(FTrackVolumes[0] * 100)
    else
      SetVolume(100);
  end
  else if Length(FAudioIds) = 1 then
  begin
    SetVolume(100);
    if Length(FTrackVolumes) > 0 then
      Vol := SecondsToStr(FTrackVolumes[0])
    else
      Vol := '1';
    Graph := Format('[aid%s]volume=%s[ao];', [FAudioIds[0], Vol]);
  end
  else
  begin
    { Общая громкость возвращается на место обязательно.

      Ветка выше выставляет её по громкости единственной дорожки, и ноль
      там — обычное дело: клип с выключенным звуком. Раньше здесь она не
      трогалась, и плеер, однажды заглушённый, оставался немым до конца
      работы — на всём монтаже сразу, сколько бы дорожек потом ни
      появилось. Здесь громкость каждой дорожки задана в самой цепочке,
      поэтому общая всегда полная. }
    SetVolume(100);
    Graph := '';
    for I := 0 to High(FAudioIds) do
    begin
      if I <= High(FTrackVolumes) then
        Vol := SecondsToStr(FTrackVolumes[I])
      else
        Vol := '1';
      Graph := Graph + Format('[aid%s]volume=%s[t%d];', [FAudioIds[I], Vol, I]);
    end;
    for I := 0 to High(FAudioIds) do
      Graph := Graph + Format('[t%d]', [I]);
    Graph := Graph + Format('amix=inputs=%d:normalize=0[ao];',
      [Length(FAudioIds)]);
  end;

  Graph := Video + Graph;
  if Graph = FLastGraph then
    Exit;
  FLastGraph := Graph;
  mpv_set_property_string(FHandle, 'lavfi-complex', PAnsiChar(Graph));
end;

{ Оверлей подключается второй видеодорожкой.

  Как и со звуком, через свойство это не делается: нужна команда
  video-add. Дорожка добавляется без выбора — выбирать её нельзя, иначе
  она заменила бы картинку. Её дело — быть входом цепочки. }
procedure TMpvPlayer.AttachOverlay;
var
  Count, I: Integer;
  Kind, Ext, Id: string;
begin
  if FHandle = nil then
    Exit;

  FBaseVid := '';
  FOverlayVid := '';

  if (FOverlayUrl <> '') and (Length(FOverlayWindows) > 0) then
    Command(['video-add', FOverlayUrl, 'auto']);

  Count := StrToIntDef(GetPropString('track-list/count'), 0);
  for I := 0 to Count - 1 do
  begin
    Kind := GetPropString(Format('track-list/%d/type', [I]));
    if Kind <> 'video' then
      Continue;
    Id := GetPropString(Format('track-list/%d/id', [I]));
    if Id = '' then
      Continue;
    Ext := GetPropString(Format('track-list/%d/external', [I]));
    if (Ext = 'yes') or (Ext = 'true') then
    begin
      if FOverlayVid = '' then
        FOverlayVid := Id;
    end
    else if FBaseVid = '' then
      FBaseVid := Id;
  end;
end;

{ Субтитры подключаются двумя путями, и оба нужны.

  Здесь — когда файл поменялся, а картинка та же: снимаем прежние и
  подключаем новые, не трогая воспроизведение. При загрузке нового списка
  кусков mpv забывает все внешние дорожки, поэтому там подключение
  повторяется — см. SelectExternalAudio. }
procedure TMpvPlayer.SetSubtitleFile(const APath: string; AForce: Boolean);
begin
  if (FSubtitlePath = APath) and (not AForce) then
    Exit;
  FSubtitlePath := APath;
  if FHandle = nil then
    Exit;

  Command(['sub-remove']);
  if APath <> '' then
    Command(['sub-add', APath, 'select']);
end;

procedure TMpvPlayer.SelectExternalAudio;
var
  Count, I, Found: Integer;
  Kind, Ext, Id: string;
begin
  if FHandle = nil then
    Exit;

  { Своего звука нет — пусть играет как есть. }
  if FAudioSource = '' then
    Exit;

  { Подключаем каждую звуковую дорожку монтажа отдельным списком кусков.

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

    Команда audio-add с признаком select делает ровно то, что нужно:
    добавляет дорожку, выбирает её и снимает выбор с внутренней. }
  for I := 0 to High(FAudioSources) do
    if I = 0 then
      Command(['audio-add', FAudioSources[I], 'select'])
    else
      Command(['audio-add', FAudioSources[I], 'auto']);

  { Собираем номера всех подключённых звуковых дорожек. }
  FAudioIds := nil;
  Found := 0;
  Count := StrToIntDef(GetPropString('track-list/count'), 0);
  for I := 0 to Count - 1 do
  begin
    Kind := GetPropString(Format('track-list/%d/type', [I]));
    if Kind <> 'audio' then
      Continue;
    Ext := GetPropString(Format('track-list/%d/external', [I]));
    if (Ext <> 'yes') and (Ext <> 'true') then
      Continue;
    Id := GetPropString(Format('track-list/%d/id', [I]));
    if Id = '' then
      Continue;
    if Found = 0 then
      mpv_set_property_string(FHandle, 'aid', PAnsiChar(Id));
    SetLength(FAudioIds, Found + 1);
    FAudioIds[Found] := Id;
    Inc(Found);
  end;

  if Found > 0 then
  begin
    FAudioTrackNote := 'Звук: дорожек монтажа ' + IntToStr(Found) + '.';
    { Цепочка строится отдельно: она зависит ещё и от громкостей, а те
      меняются по ходу воспроизведения. }
    BuildGraph;
    Exit;
  end;

  { Внешней дорожки не нашлось.

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

    Поэтому оставляем выбор ему, но записываем в журнал: если звук вдруг
    окажется не тот, будет с чего начинать. }
  FAudioTrackNote := 'ВНИМАНИЕ: внешняя звуковая дорожка не подключилась ' +
    '(дорожек: ' + IntToStr(Count) + '). Звук может идти не с монтажа.';
end;

procedure TMpvPlayer.HandleLogMessage(AMsg: Pmpv_event_log_message);
begin
  if Assigned(FOnLog) then
    FOnLog(Self, string(AMsg^.prefix), string(AMsg^.level), string(AMsg^.text));
end;

procedure TMpvPlayer.PumpEvents(Sender: TObject);
var
  Ev: Pmpv_event;
begin
  SyncVideoRect;

  if FHandle = nil then
    Exit;

  { Забираем всё, что накопилось. Нулевой таймаут: если событий нет,
    mpv_wait_event возвращается немедленно с MPV_EVENT_NONE. }
  repeat
    Ev := mpv_wait_event(FHandle, 0);
    if Ev = nil then
      Break;

    case Ev^.event_id of
      MPV_EVENT_NONE:
        Break;
      MPV_EVENT_PROPERTY_CHANGE:
        HandlePropertyChange(Pmpv_event_property(Ev^.data));
      MPV_EVENT_LOG_MESSAGE:
        HandleLogMessage(Pmpv_event_log_message(Ev^.data));
      MPV_EVENT_FILE_LOADED:
        begin
          { Оверлей подключается до звука: цепочка строится один раз, и в
            ней должно быть сразу всё. }
          AttachOverlay;
          SelectExternalAudio;
          { Звуковых дорожек может не оказаться вовсе, а наложение при
            этом есть — тогда цепочку никто больше не соберёт. }
          BuildGraph;
          { Загрузка нового списка кусков сбрасывает все внешние дорожки,
            в том числе субтитры. Подключаем заново. }
          if FSubtitlePath <> '' then
            Command(['sub-add', FSubtitlePath, 'select']);
        end;
      MPV_EVENT_SHUTDOWN:
        begin
          FPump.Enabled := False;
          Break;
        end;
    end;
  until False;
end;

end.