{ 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; { Что сейчас выставлено обрезкой на выводе. Хранится, чтобы не переустанавливать свойство на каждом кадре. } FLastCrop: string; FLastRotate: 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); { Обрезка на выводе: показывать только этот кусок кадра исходника. Делает её сама видеокарта, цепочки фильтров тут нет и кадры в обычную память не копируются. Годится на то, чего цепочкой дорого: показать собственное кадрирование клипа. Действует на весь вывод сразу, поэтому включать и снимать её обязан тот, кто знает, где сейчас курсор. Пустой прямоугольник снимает обрезку. Поворот задаётся тем же способом — отдельным свойством, а не фильтром. } procedure SetOutputCrop(const ARect: TRect; ARotation: Integer); { Цепочка фильтров 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.SetOutputCrop(const ARect: TRect; ARotation: Integer); var Value, Rot: string; begin if FHandle = nil then Exit; if (ARect.Right > ARect.Left) and (ARect.Bottom > ARect.Top) then Value := Format('%dx%d+%d+%d', [ARect.Right - ARect.Left, ARect.Bottom - ARect.Top, ARect.Left, ARect.Top]) else Value := ''; Rot := IntToStr(((ARotation mod 360) + 360) mod 360); { Лишний раз не трогаем: смена свойства перестраивает вывод, и на каждом кадре это было бы заметно глазом. } if (Value = FLastCrop) and (Rot = FLastRotate) then Exit; FLastCrop := Value; FLastRotate := Rot; mpv_set_property_string(FHandle, 'video-crop', PAnsiChar(Value)); mpv_set_property_string(FHandle, 'video-rotate', PAnsiChar(Rot)); 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; { В журнал пишется всегда, в том числе пустая: по ней видно, собралось ли наложение. Пустая цепочка при заявленном наложении означает, что дорожки для него у плеера нет. } Note('Цепочка показа: ' + Graph); mpv_set_property_string(FHandle, 'lavfi-complex', PAnsiChar(Graph)); end; { Оверлей подключается второй видеодорожкой. Как и со звуком, через свойство это не делается: нужна команда video-add. Дорожка добавляется без выбора — выбирать её нельзя, иначе она заменила бы картинку. Её дело — быть входом цепочки. } procedure TMpvPlayer.AttachOverlay; var Count, I, Code: Integer; Kind, Ext, Id: string; begin if FHandle = nil then Exit; FBaseVid := ''; FOverlayVid := ''; if (FOverlayUrl <> '') and (Length(FOverlayWindows) > 0) then begin Code := Command(['video-add', FOverlayUrl, 'auto']); if Code < 0 then Note(Format('Дорожку наложения добавить не удалось: video-add вернул %d', [Code])); end; 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; { Пустая дорожка наложения при заявленном наложении — самый частый способ остаться без картинки в окне. Пишем, что увидели. } if (FOverlayUrl <> '') and (Length(FOverlayWindows) > 0) and ((FOverlayVid = '') or (FBaseVid = '')) then Note(Format('Наложение не подключилось: дорожек %d, основа "%s", ' + 'наложение "%s"', [Count, FBaseVid, FOverlayVid])); 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.