commit b59cdb1352f1220230425a2d07bcfc4c1865b363 Author: chaiman Date: Wed Aug 19 18:36:16 2026 +0300 Нелинейный видеоредактор без перекодирования Куски видео вырезаются и склеиваются копированием потока: сборка ролика занимает время копирования файла, а не время рендера. Композитинга нет принципиально — при перекрытии побеждает клип с верхней дорожки целиком, и картинкой, и звуком. Именно это ограничение и делает сборку копированием возможной. Что внутри: - монтажный стол со своей отрисовкой: дорожки, масштаб, прилипание, схлопывание, громкость на клипе; - предпросмотр прямо с монтажа через libmpv и виртуальный список кусков, без промежуточных файлов; - сборка через ffmpeg с точными резами: перекодируется только огрызок от реза до ближайшего опорного кадра, остальное копируется; - разбор заголовка MP4 для поиска опорных кадров — в 500 раз быстрее опроса ffprobe; - перепаковка контейнеров, кадрирование и поворот, сведения о проекте; - свои цвета всего окна: системные элементы под Windows цвет не берут, поэтому кнопки, полоса меню, журнал и полосы прокрутки нарисованы сами; - окно зависимостей: недостающие ffmpeg, ffprobe и libmpv скачиваются с официальных источников; - кросс-сборка под Windows и работа под Wine. Первый коммит: до этого история не велась. diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..e60625a --- /dev/null +++ b/.gitignore @@ -0,0 +1,44 @@ +# Результаты сборки +/lib/ +/nlve +/nlve.exe +/nlve.dbg +/nlve.res +/tests/lib/ +/tests/nlvetool +/tests/nlvetool.exe +*.o +*.ppu +*.compiled +*.or + +# Готовые ролики и материал проверок +/out/ + +# Сессии Lazarus (у каждого разработчика свои) +*.lps + +# Кэш проектов nlve: нарезанные куски и сгенерированные клипы. +# Восстанавливается из файла проекта, в репозиторий не нужен. +*.nlve-cache/ + +# Временные файлы отладки +run*.log +shot*.png + +# Скачанные зависимости. Кладутся рядом с программой окном «Зависимости», +# весят сотни мегабайт и у каждого свои — в репозиторий не нужны. +/ffmpeg.exe +/ffprobe.exe +/ffmpeg +/ffprobe +/libmpv-2.dll +/mpv-2.dll +/libmpv.so.2 +/7zr.exe +/deps-windows.json +/deps-linux.json +/deps-tmp/ + +# Журнал последнего запуска +/nlve.log diff --git a/README.md b/README.md new file mode 100644 index 0000000..9ce520f --- /dev/null +++ b/README.md @@ -0,0 +1,460 @@ +# nlve + +Нелинейный видеоредактор без перекодирования. Куски видео вырезаются и +склеиваются копированием потока, поэтому сборка ролика занимает время +копирования файла, а не время рендера. + +Композитинга нет принципиально: когда клипы перекрываются во времени, +побеждает тот, что на верхней дорожке — целиком, и картинкой, и звуком. +Именно это ограничение и делает возможной сборку копированием. + +## Сборка + +``` +./build.sh редактор под эту систему +./build.sh windows редактор под Windows (кросс-сборка) +./build.sh tool консольный инструмент проверок +./build.sh test инструмент плюс прогон проверок +./build.sh all всё перечисленное +./build.sh run собрать и запустить +./build.sh clean убрать промежуточные файлы +``` + +Используется тулчейн fpcupdeluxe, а не системные fpc и Lazarus: системный +Lazarus другой версии, и собранные им модули LCL с нашими несовместимы. +Другой корень задаётся переменной: `FPCUP=/путь ./build.sh`. + +То же самое вручную: + +``` +/home/chaiman/fpcupdeluxe/lazarus/lazbuild --primary-config-path=/home/chaiman/fpcupdeluxe/config_lazarus nlve.lpi +/home/chaiman/fpcupdeluxe/lazarus/lazbuild --primary-config-path=/home/chaiman/fpcupdeluxe/config_lazarus --cpu=x86_64 --os=win64 --ws=win32 nlve.lpi +``` + +Требования во время работы: `libmpv.so.2` (пакет `mpv`), `ffmpeg` и `ffprobe` +в `PATH`. Линковки с libav* нет — ffmpeg вызывается внешним процессом. + +## Запуск + +``` +./nlve # пустой проект +./nlve <проект.nlve> # открыть проект +./nlve <видео> <картинка> ... # добавить файлы в новый проект +``` + +Окно перепаковки открывается из меню «Файл». Здесь раньше значился запуск +`./nlve remux <файл>...` — в коде этого нет и не было: слово `remux` не +является именем файла и молча пропускалось. + +## Управление + +| Действие | Клавиши | +|---|---| +| Пуск и пауза | Пробел | +| В начало / конец монтажа | Home / End | +| Разрезать по курсору | S | +| Разрезать точно (перекодирует стык) | Shift+S | +| Удалить выделенное | Delete | +| Выделить всё | Ctrl+A | +| Схлопнуть дыру под курсором | Ctrl+Shift+R | +| Отменить, повторить | Ctrl+Z, Ctrl+Y | +| Масштаб таймлайна | Ctrl + колесо мыши | +| Прокрутка по дорожкам | колесо мыши | +| Прокрутка по времени | Shift + колесо, средняя кнопка | +| Прокрутка журнала вбок | Shift + колесо над журналом | +| Выключить дорожку / оставить только её | кнопки М и С в заголовке | +| Громкость клипа | тянуть ручку на клипе вверх-вниз | +| Автосхлопывание вкл/выкл | Ctrl+K | +| Отменить прилипание на время | Shift при перетаскивании | +| Вписать проект целиком | Ctrl+0 | +| Новый, открыть, сохранить проект | Ctrl+N, Ctrl+O, Ctrl+S | +| Добавить файлы | Ctrl+I | +| Собрать ролик | Ctrl+E | + +Файлы попадают в проект через меню «Файл» или перетаскиванием прямо в окно +программы. Место броска решает, что произойдёт: бросили над монтажом — файл +и добавится в проект, и ляжет на дорожку под указателем; в любом другом +месте — только добавится в проект. + +Файл из библиотеки кладётся на монтаж перетаскиванием либо через +контекстное меню списка. В нём: **добавить на дорожку** (подменю со +списком дорожек), **кадрирование и поворот**, **убрать со всех дорожек** +(файл остаётся в проекте), **удалить из проекта**. Дыры при этом намеренно не +схлопываются: убрать клип и переставить всё остальное — два разных +намерения. + +Если бросить клип ниже всех дорожек, заведётся новая. + +В заголовке каждой дорожки слева — её название, число клипов и две кнопки: +**М** выключает дорожку целиком (она не идёт ни в предпросмотр, ни в сборку), +**С** оставляет только её, заглушив остальные. Щелчок по заголовку делает +дорожку выбранной — на неё кладёт файл кнопка. + +Клип переносится перетаскиванием, в том числе на другую дорожку и на +пустое место под последней — тогда дорожка тоже добавится. За края клипа +он растягивается и укорачивается. Картинку можно растянуть на любую +длину, видео — только в пределах исходника. + +Щелчок по клипу переставляет курсор воспроизведения. Именно щелчок: +если кнопку нажали и потянули, курсор остаётся на месте, в том числе во +время воспроизведения. + +**Прилипание.** Края клипов притягиваются друг к другу и к курсору. +Кнопка внизу включает и выключает его, а Shift во время перетаскивания +меняет решение на противоположное: при включённом прилипании временно +отключает, при выключенном — временно включает. Так одна клавиша полезна +в обоих режимах, и не нужно помнить, какой сейчас. + +**Схлопывание.** Кнопка внизу показывает и режим, и состояние: утоплена — +автосхлопывание включено, и тогда при перетаскивании клипа всё, что +начинается не раньше него, едет следом. Стрелка рядом открывает выбор +режима: только текущая дорожка или все. Ctrl+K включает и выключает. + +Режим действует и при выключенном автосхлопывании — по нему работает +Ctrl+Shift+R, который схлопывает дыру под курсором. То есть выключенная +кнопка означает лишь «не двигать ничего само собой при перетаскивании». + +Во время воспроизведения курсор держится посередине окна, а монтаж едет +под ним. При нажатии на пуск, если курсор оказался за краем видимой +части, вид подтягивается к нему — масштаб при этом не меняется. + +На каждом клипе проходит линия громкости с ручкой посередине видимой его +части: тянешь ручку вверх и вниз — меняется громкость, от тишины до +двойной. Ручка стоит посередине именно видимой части, а не всего клипа: +до середины часового клипа, уехавшей за край экрана, мышью не дотянуться. + +Громкость, отличная от обычной, — единственное место, где звук +перекодируется: изменить громкость, не тронув сам звук, нельзя. Видео при +этом по-прежнему копируется. Проверено: клип с громкостью 30% дал в ролике +уровень на 10.5 дБ ниже исходного при ожидаемых 10.46 дБ. + +Полоски по краям клипа показывают тип реза: серая — притянут к опорному +кадру, голубая — точный, стык будет перекодирован при сборке. Если край +подвинуть руками и он не попадёт на опорный кадр, рез сам становится +точным: раз человек выбрал конкретный кадр, притягивать его к соседнему +неправильно. + +В списке файлов слева показывается кадр из каждого файла, его параметры +и длительность. Кадры делаются в фоне и запоминаются в кэше проекта. + +## Файл не совпадает с проектом + +Проект имеет одно разрешение и один набор кодеков на всё — иначе куски не +склеить копированием. Файл с другими параметрами можно добавить, но его +куски скопировать не выйдет. + +Пересобираются **только они**. Остальной материал по-прежнему копируется +без потерь и почти мгновенно. Ролик целиком не перекодируется никогда. + +Как именно кадр такого файла ложится в кадр проекта, решает окно +«Кадрирование и поворот» из контекстного меню библиотеки: вписать целиком +с полями, заполнить кадр с обрезкой или растянуть, плюс поворот на 90, +отражение, увеличение и смещение. Показывается настоящий кадр, пропущенный +через ту же цепочку фильтров, что пойдёт в дело. + +По умолчанию кадр вписывается целиком. Растяжение надо выбрать руками: +раньше оно применялось молча, и вертикальное видео размазывалось по ширине. + +«Приведение к параметрам проекта» делает ту же работу один раз при +добавлении: файл перекодируется целиком, зато каждая последующая сборка +остаётся быстрой. + +Что и почему происходит с каждым файлом, видно в окне «Проект → Сведения +о проекте»: параметры проекта, параметры каждого файла, выбранное +вписывание и вердикт — копируется, пересобирается или из него делается +клип. Там же кнопка полного ответа ffprobe. + +### Что показывает предпросмотр + +Предпросмотр показывает **кадр проекта**, а не кадр исходника. Файл другого +соотношения сторон виден с полями по краям — ровно так, как он попадёт в +готовый ролик. Проверено сравнением: кадр предпросмотра и кадр сборки +совпадают бит в бит. + +Само по себе это не бесплатно, поэтому включается только когда есть что +вписывать. Разное разрешение при одинаковом соотношении сторон (скажем, +3840x2160 в проекте 2688x1512) ничего не требует: mpv сам впишет такой +файл в панель, и картинка совпадёт до пикселя. + +Когда вписывание нужно, декодирование переключается на вариант с +копированием кадров в обычную память — цепочка фильтров не умеет работать +с кадрами, лежащими в памяти видеокарты. Аппаратное декодирование при этом +сохраняется, видно в журнале: `nvdec` без вписывания, `nvdec-copy` с ним. +Замер на материале 2688x1512 при 60 к/с: 327 кадров в секунду без фильтра, +230 с настоящим масштабированием — запас четырёхкратный. + +Чего предпросмотр не умеет: показать собственную настройку кадрирования +файла. Цепочка фильтров у mpv одна на всю склейку, а заполнение с обрезкой, +поворот и смещение задаются для каждого файла отдельно — выбрать между ними +общий фильтр не может, поэтому он всегда вписывает целиком. Точную картинку +для такого файла показывает окно «Кадрирование и поворот». + +## Цвета окна + +Все цвета заданы в `uTheme` и применяются принудительно, а не берутся у +системы. Причина простая: под Linux вид назначает тема GTK, под Windows — +тема оформления, и на светлой теме тёмный таймлайн оказывается вставленным +в белую рамку. + +Что для этого пришлось сделать: + +- **Свои кнопки** (`TThemedButton`). Системная кнопка под Windows свой цвет + не отдаёт: LCL рисует её через службу оформления, и та кладёт светлую + подложку поверх заданного цвета. Проверено по исходникам LCL — + `TCustomSpeedButton.PaintBackground` всегда вызывает + `ThemeServices.DrawElement`. Поведение обычной кнопки сохранено: + `Default`, `Cancel`, `ModalResult`, работа по Enter и Esc. +- **Своя полоса меню** из плоских кнопок со всплывающими списками. + Системную полосу рисует Windows, и её фон нашим цветом не закрашивается: + `SetMenuInfo` меняет подложку пунктов, но не самой полосы. Сочетания + клавиш при этом не теряются — их ищет `TMenu.IsShortCut`, вызываемый из + `TMainForm.FormShortCut`. Ценой стал переход по меню клавишей Alt: его + больше нет. +- **Своё окно сообщения** (`ThemedMessageDlg`) вместо `MessageDlg`. +- **Отрисовка пунктов меню и строк выпадающих списков** своими руками. + +Чего сделать нельзя, и это надо знать: + +- полосы прокрутки рисует система, и цвет им задать нечем. Единственный + способ получить их в своих цветах — не пользоваться системными вовсе. + Так и сделано: журнал (`uLogView`) и таблицы (`uThemedScroll`) обходятся + своими. Осталась системная полоса у списка файлов слева — там её нечем + выключить, не переписав сам список; +- рамка окна и её кнопки принадлежат оконному менеджеру; +- под gtk2 пункты меню своими руками не рисуются — в LCL это прямо + помечено как неподдерживаемое (`interfaces/gtk2/issues.xml`), там их + цвет назначает тема GTK. Под Windows рисуются, там это и нужно. + +## Зависимости и запуск под Wine + +Программе нужны `ffmpeg`, `ffprobe` и `libmpv`. Под Linux они ставятся +пакетным менеджером. Под Windows ставить нечем, поэтому файлы кладутся +рядом с программой, а меню «Файл → Зависимости...» умеет их скачать. + +Список и адреса лежат в `deps-windows.json` или `deps-linux.json` рядом с +программой — имя своё для каждой системы. Общий файл приводил к тому, что +запущенная под Wine программа записывала windows-список, а сборка под +Linux потом искала по нему `.dll`. + +Где имя файла сборки меняется с каждой датой, адрес не задаётся: программа +спрашивает последний выпуск у GitHub. Архивы `.7z` распаковываются внешним +`7zr.exe` — он тоже есть в списке и качается одним файлом, поэтому +замкнутого круга не возникает. + +Под Wine программа узнаёт себя по наличию `wine_get_version` в `ntdll` и +настраивается сразу: + +- **вывод через OpenGL**, а не Direct3D 11: последний в Wine падает при + создании контекста, ещё до первого кадра; +- **аппаратное декодирование выключено**. Дело не в бесполезных попытках: + для DXVA2 mpv создаёт устройство Direct3D 9, а Wine при его создании + сбрасывает гамму экрана в единицу — настройку всей системы. Замерено: + с `auto-safe` гамма 0.89 превращалась в 1.0 при каждом открытии + проекта, с `no` остаётся нетронутой. + +На настоящей Windows обе настройки остаются обычными. + +Журнал дублируется в `nlve.log` рядом с программой. Нужно ровно для +случая, когда программа падает до появления окна: иначе всё, что она о +себе рассказала, пропадает вместе с окном. + +## Как собирается ролик + +1. Монтаж уплощается в последовательность непересекающихся кусков. + Перекрытия разрешаются в пользу верхней дорожки, дыры превращаются в + чёрные вставки. +2. Картинки и дыры материализуются в клипы в параметрах проекта. Иначе их + нечем показать: подсунуть mpv картинку или генератор прямо в списке + кусков нельзя, он на этом зависает. Заготовки делаются готовых длин + (15 с, 60 с, 5 мин и так далее), а нужный кусок из них вырезается — + тогда любое движение клипа не требует новой генерации. +3. Начало каждого куска притягивается к опорному кадру, потому что копировать + можно только с него. Конец притягивать не нужно — при копировании он и так + получается кадроточным. +4. При точном резе огрызок от точки реза до следующего опорного кадра + перекодируется, остальное копируется. +5. Куски склеиваются concat-демультиплексором, результат сверяется: сумма + пакетов кусков обязана совпасть с числом пакетов в готовом файле. + +Напрашивающийся способ — один проход с директивами `inpoint` и `outpoint`, +без временных файлов — проверен и отвергнут: он давал 574 кадра вместо 600 +и не пересчитывал метки времени. + +## Ловушки, на которые уже наступили + +Все перечисленные ниже вещи найдены замерами, а не рассуждениями. + +**Локаль.** libmpv отказывается создаваться, если числовая часть локали +процесса не `C`: `mpv_create` возвращает nil. В русской локали десятичный +разделитель запятая, и разбор чисел внутри mpv ломается. Лечится вызовом +`ForceCNumericLocale` до `mpv_create` (`uMpvLib`). + +**Панель без окна.** Под gtk2 панель LCL не имеет собственного окна X11, и +запрос окна возвращает окно формы. Отдав такой идентификатор mpv, получаем +видео поверх всего интерфейса. Поэтому под X11 создаётся собственное +дочернее окно по границам панели (`EnsureVideoWindow` в `uMpvPlayer`). + +**Относительные пути в списке склейки.** Путь с префиксом `file:` внутри +списка concat разбирается относительно текущего рабочего каталога, а не +относительно самого списка. Все пути приводятся к абсолютным сразу. + +**Смешивание кусков от разных кодировщиков.** MP4 и Matroska хранят набор +параметров кодека один на дорожку. Как только рядом оказываются +скопированный кусок из камеры и созданная нами вставка, декодер применяет +параметры первого ко всем: замерено 384 ошибки декодера HEVC при верном +числе кадров. Лечится склейкой через промежуточный MPEG-TS, где параметры +повторяются перед каждым опорным кадром — стало 0 ошибок. Способ выбирается +автоматически: один источник и никаких точных резов — прямая склейка, +иначе MPEG-TS. + +**Лишний кадр на стыке точного реза.** При копировании `-to` работает как +«строго меньше», при перекодировании — как «меньше либо равно». Кадр на +границе попадал в ролик дважды: 601 вместо 600. Лечится отступом на +полкадра от границы. + +**B-кадры во вставках.** Двунаправленные кадры от NVENC при переносе в +Matroska давали метки декодирования, идущие назад, и двадцать совпадающих +меток на шестьсот кадров. Коротким вставкам B-кадры не нужны, поэтому они +запрещены (`-bf 0`). + +**Вставка под каждую длину дыры.** Сначала под каждую дыру делался чёрный +клип ровно её длины. Любое движение клипа меняло длину дыры, требовало +новой генерации, и до её готовности предпросмотр играл прежнюю расстановку. +Выглядело так, будто выключение дорожки или удаление клипа не действуют. +Лечится заготовками готовых длин, из которых вырезается нужный кусок. + +**Первая загрузка начинала воспроизведение.** У незагруженного mpv признак +паузы снят, поэтому первый же список кусков ехал сам. Лечится опцией +`pause=yes` при создании плеера. + +**Молчаливое растяжение кадра.** Приведение файла к проекту задавало размер +ключом `-s`, а он растягивает кадр не считаясь с соотношением сторон. +Вертикальное видео превращалось в размазанное по ширине. Теперь размер +задаётся цепочкой фильтров, а вписывание выбирается осознанно. + +**Фильтр mpv и кадры в памяти видеокарты.** Цепочка фильтров ffmpeg +работает с обычной памятью, а при аппаратном декодировании кадры остаются +в памяти видеокарты. Граф фильтров тогда просто не собирается: `Impossible +to convert between the formats supported by the filter 'mpv_src_in0'`. +Лечится переключением на `hwdec=auto-copy`, пока фильтр нужен. + +Ловушка была не в этом, а в том, как я это проверял: из командной строки +mpv сам выбрал `nvdec-copy`, всё работало, и ошибки не было видно. Она +вылезла только на снимке окна работающего редактора. Проверять такое надо +там, где оно живёт, а не в удобной обстановке. + +**Скрипт сборки соврал об успехе.** `PIPESTATUS` живёт ровно до следующей +команды, а в разборе результата стояло двоеточие в ветке `then` — оно и +затирало состояние конвейера. Сборка падала, скрипт докладывал «готово». +Читать `PIPESTATUS` надо сразу и в переменную. + +**Модуль Windows конфликтует именами.** Он объявляет свои `TRect`, `Point` +и `RegisterClass`, а имена в Паскале нечувствительны к регистру — обычные +вызовы LCL начинают разбираться как системные, с невнятными ошибками вида +«ожидалось `)`». Подключать его целиком не нужно: `SetMenuInfo` и +`MENUINFO` объявлены в `uTheme` напрямую. + +**Знак «▼» в шрифте Windows.** Вместо стрелки выходил пустой квадрат. +Треугольник рисуется сам (`TThemedButton.Arrow`). + +**Раскраска до построения меню.** `ApplyDarkTheme` вызывался в начале +`FormCreate`, а меню строится в середине — и цветов не получало. Вызов +должен идти последним. + +**Исключения вещественной арифметики.** Паскаль по умолчанию требует +сообщать о каждой неточности вычислений. libmpv и ffmpeg внутри считают +как им удобно и на это не рассчитывают: при создании плеера вылезало +«Invalid floating point operation», и предпросмотр не запускался. Лечится +`SetExceptionMask` после загрузки библиотеки. + +**Аргументы loadfile.** В mpv 0.38 у команды появился четвёртый аргумент — +номер позиции в списке, и настройки файла сдвинулись на пятое место. +Прежний вызов стал ошибкой «The loadfile option must be an integer», и под +Wine с новой библиотекой не грузилось ничего. Гадать по номеру версии не +нужно: те же настройки задаются свойствами перед загрузкой, и называются +они одинаково во всех версиях. + +**Модуль Windows конфликтует именами.** Он объявляет свои `TRect`, +`Point`, `DeleteFile`, `GetTempFileName` и `RegisterClass`, а имена в +Паскале нечувствительны к регистру — обычные вызовы LCL начинают +разбираться как системные, с невнятными ошибками вида «ожидалось `)`». +Подключать его целиком не нужно: `SetMenuInfo` и `MENUINFO` объявлены в +`uTheme` напрямую. За сессию эта ловушка сработала четыре раза. + +**Порядок байт в TColor.** LCL хранит цвет как `$00BBGGRR`, а не как +привычный RGB. Записанный по привычке код даёт цвет с переставленными +красным и синим. + +**Имена, занятые предками.** Локальная переменная перекрывает одноимённое +свойство класса: `Text` и `Position` заняты у `TControl`, `Finished` — у +`TThread`, `Name` и `Caption` — у формы. Компилятор ловит это как +«Duplicate identifier», но причину не объясняет. + +## Консольный инструмент проверок + +Часть вещей проверяется числами, а не глазами. Сборка: `./build.sh tool`. + +``` +./tests/nlvetool kf <файл> индекс опорных кадров +./tests/nlvetool kfcheck <файл> сверка быстрого пути с ffprobe +./tests/nlvetool flattest проверка уплощения монтажа +./tests/nlvetool edl <файл> <старт> <длина> [...] +./tests/nlvetool export <файл> <выход> <старт> <длина> [...] +./tests/nlvetool export --cancel-after=<сек> ... проверка остановки +./tests/nlvetool remux <файл>... <расширение> +./tests/nlvetool build <проект> <видео> [<картинка>] +./tests/nlvetool buildcut <проект> <видео> +./tests/nlvetool render <проект> <выход> +``` + +Команды возвращают ненулевой код при расхождении, поэтому годятся для +автоматической проверки. + +## Структура + +| Файл | Что это | +|---|---| +| `src/uAppTypes.pas` | Базовые типы, форматирование чисел без учёта локали | +| `src/uSettings.pas` | Настройки между запусками (JSON) | +| `src/uProcRunner.pas` | Запуск ffmpeg и ffprobe, разбор вывода, остановка | +| `src/uFfmpegCmd.pas` | Сборка аргументов ffmpeg, разбор его прогресса | +| `src/uMediaProbe.pas` | Что за файл нам дали и чем он отличается от проекта | +| `src/uKeyframeIndex.pas` | Где опорные кадры: разбор заголовка MP4 и запасной путь | +| `src/uProject.pas` | Модель монтажа, JSON проекта, отмена действий | +| `src/uFlatten.pas` | Монтаж в плоский список кусков | +| `src/uGenerate.pas` | Клипы для картинок и дыр | +| `src/uExport.pas` | Вырезание, склейка, сверка числа кадров | +| `src/uRemuxQueue.pas` | Очередь перепаковки | +| `src/uEdl.pas` | Сборка `edl://` для предпросмотра | +| `src/uMpvLib.pas` | Объявления libmpv, динамическая загрузка | +| `src/uMpvPlayer.pas` | Плеер: встраивание в окно, воспроизведение, события | +| `src/uTimelineCtrl.pas` | Компонент монтажного стола | +| `src/uTransform.pas` | Как кадр исходника ложится в кадр проекта | +| `src/uPanCropForm.pas` | Окно кадрирования и поворота | +| `src/uProjectInfoForm.pas` | Сведения о проекте и ответ ffprobe | +| `src/uThumbs.pas` | Кадры-миниатюры для списка файлов | +| `src/uTheme.pas` | Цвета окна, своя кнопка, своё окно сообщения | +| `src/uLogView.pas` | Журнал: своя отрисовка, свои полосы прокрутки | +| `src/uThemedScroll.pas` | Полоса прокрутки и обвязка для таблиц | +| `src/uDeps.pas` | Что нужно программе, где искать, как ставить | +| `src/uDownload.pas` | Загрузка по сети: WinHTTP под Windows, curl под Linux | +| `src/uDepsForm.pas` | Окно «Зависимости» | +| `src/uMainForm.pas` | Главное окно | +| `src/uProgressForm.pas` | Ход долгой операции | +| `src/uRemuxForm.pas` | Окно перепаковки | +| `src/uMismatchForm.pas` | Предупреждение о несовпадении параметров | +| `build.sh` | Сборка целями | +| `tests/` | Консольный инструмент проверок | +| `vendor/mpv-headers/` | Заголовки mpv 0.37.0 — эталон для биндингов | + +## Чего пока нет + +**Раздельные звуковые дорожки.** Звук идёт с того же клипа, что и картинка. +Громкость у клипа своя, но смешивать звук с нескольких дорожек нельзя: +это потребовало бы второго прохода по всему материалу. Модель данных к +разделению готова, само разделение не сделано. + +**Осциллограмма звука на клипах.** + +**Переходы, эффекты, изменение скорости.** Всё это требует перекодирования и +в замысел не входит. diff --git a/build.sh b/build.sh new file mode 100755 index 0000000..7d8b474 --- /dev/null +++ b/build.sh @@ -0,0 +1,176 @@ +#!/bin/bash +# +# Сборка nlve. +# +# ./build.sh редактор под эту систему +# ./build.sh current то же самое +# ./build.sh windows редактор под Windows (кросс-сборка) +# ./build.sh tool консольный инструмент проверок +# ./build.sh test инструмент плюс прогон проверок +# ./build.sh all всё перечисленное +# ./build.sh run собрать под эту систему и запустить +# ./build.sh clean убрать промежуточные файлы сборки +# +# Тулчейн берётся из fpcupdeluxe, а не из системы. Это не придирка: +# системный Lazarus другой версии, и собранные им модули LCL с нашими +# несовместимы — сборка падает на ровном месте. + +set -u + +HERE=$(cd "$(dirname "$0")" && pwd) + +FPCUP=${FPCUP:-/home/chaiman/fpcupdeluxe} +LAZBUILD="$FPCUP/lazarus/lazbuild" +LAZCONF="$FPCUP/config_lazarus" + +# Собранный виджетсет только один — gtk2. Ни qt5, ни gtk3 в этом +# тулчейне нет, подставлять их бессмысленно. +LCL_LINUX=gtk2 + +# Под Windows виджетсет называется win32 и работает в том числе на 64 битах: +# это имя интерфейса, а не разрядности. +LCL_WINDOWS=win32 + +status=0 + +fail() { + echo "ОШИБКА: $*" >&2 + exit 1 +} + +note() { + echo + echo "=== $* ===" +} + +check_toolchain() { + [ -x "$LAZBUILD" ] || fail "не найден lazbuild: $LAZBUILD +Задайте другой корень через переменную FPCUP, например: + FPCUP=/путь/к/fpcupdeluxe ./build.sh" +} + +# Из вывода lazbuild интересны только ошибки и итог. Подсказок о +# неиспользованных параметрах там сотни, и за ними не видно главного. +run_lazbuild() { + local title=$1 + local rc + shift + note "$title" + "$LAZBUILD" --primary-config-path="$LAZCONF" "$@" 2>&1 \ + | grep -viE "^Hint: \(lazbuild\)|^Hint: \(lazarus\)|Start of reading config|End of reading config" \ + | grep -iE "error|fatal|warning|Linking|lines compiled|Compiling package" + # Код возврата берём у lazbuild, а не у grep: grep возвращает 1 просто + # потому, что ничего не нашёл, и это не ошибка сборки. + # + # PIPESTATUS читается сразу же и в переменную. Любая следующая команда + # его затирает — даже двоеточие. На этом скрипт уже один раз соврал: + # сборка падала, а он докладывал «готово». + rc=${PIPESTATUS[0]} + return "$rc" +} + +build_current() { + check_toolchain + if run_lazbuild "Редактор под эту систему ($LCL_LINUX)" \ + --ws="$LCL_LINUX" "$HERE/nlve.lpi"; then + echo "готово: $HERE/nlve" + else + echo "не собралось" >&2 + status=1 + fi +} + +build_windows() { + check_toolchain + if run_lazbuild "Редактор под Windows (x86_64)" \ + --cpu=x86_64 --os=win64 --ws="$LCL_WINDOWS" "$HERE/nlve.lpi"; then + echo "готово: $HERE/nlve.exe" + # Печатаем, что именно получилось: перепутать разрядность легко, а + # заметить это без запуска под Windows нечем. + file "$HERE/nlve.exe" 2>/dev/null | cut -d: -f2- | sed 's/^/ /' + else + echo "не собралось" >&2 + status=1 + fi + + # Кросс-сборка оставляет модули для Windows в том же каталоге, что и + # родные. Следующая сборка под Linux их не тронет и возьмёт как свои, + # после чего компоновщик выдаст непонятную ошибку. Поэтому чистим. + rm -rf "$HERE/lib/x86_64-win64" +} + +build_tool() { + note "Консольный инструмент проверок" + if "$HERE/tests/build.sh"; then + : + else + echo "не собралось" >&2 + status=1 + fi +} + +run_tests() { + build_tool + [ "$status" -eq 0 ] || return + + note "Проверки уплощения монтажа" + if "$HERE/tests/nlvetool" flattest; then + echo "проверки пройдены" + else + echo "проверки не пройдены" >&2 + status=1 + fi +} + +do_clean() { + note "Уборка" + rm -rf "$HERE/lib" "$HERE/tests/lib" + rm -f "$HERE/nlve.dbg" + echo "убраны промежуточные файлы сборки" + echo "готовые двоичные файлы (nlve, nlve.exe, tests/nlvetool) оставлены" +} + +case "${1:-current}" in + current|linux|"") + build_current + ;; + windows|win|win64) + build_windows + ;; + tool) + build_tool + ;; + test|tests) + run_tests + ;; + all) + build_current + build_windows + run_tests + ;; + run) + build_current + [ "$status" -eq 0 ] || exit 1 + note "Запуск" + exec "$HERE/nlve" + ;; + clean) + do_clean + ;; + -h|--help|help) + # Печатаем шапку файла до первой строки, которая уже не комментарий. + awk 'NR>2 { if ($0 !~ /^#/) exit; sub(/^# ?/, ""); print }' "$0" + ;; + *) + fail "неизвестная цель: $1 +Доступны: current, windows, tool, test, all, run, clean" + ;; +esac + +echo +if [ "$status" -eq 0 ]; then + echo "ИТОГ: без ошибок" +else + echo "ИТОГ: были ошибки" +fi +exit "$status" diff --git a/nlve.lpi b/nlve.lpi new file mode 100644 index 0000000..3cb87a4 --- /dev/null +++ b/nlve.lpi @@ -0,0 +1,246 @@ + + + + + + + + + + + <Scaled Value="True"/> + <ResourceType Value="res"/> + <UseXPManifest Value="True"/> + <XPManifest> + <DpiAware Value="True"/> + </XPManifest> + </General> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + <UseFileFilters Value="True"/> + </PublishOptions> + <RunParams> + <FormatVersion Value="2"/> + </RunParams> + <RequiredPackages Count="1"> + <Item1> + <PackageName Value="LCL"/> + </Item1> + </RequiredPackages> + <Units Count="31"> + <Unit0> + <Filename Value="nlve.lpr"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="src/uAppTypes.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="uAppTypes"/> + </Unit1> + <Unit2> + <Filename Value="src/uDeps.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="uDeps"/> + </Unit2> + <Unit3> + <Filename Value="src/uDepsForm.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="DepsForm"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + <UnitName Value="uDepsForm"/> + </Unit3> + <Unit4> + <Filename Value="src/uDownload.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="uDownload"/> + </Unit4> + <Unit5> + <Filename Value="src/uEdl.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="uEdl"/> + </Unit5> + <Unit6> + <Filename Value="src/uExport.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="uExport"/> + </Unit6> + <Unit7> + <Filename Value="src/uFfmpegCmd.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="uFfmpegCmd"/> + </Unit7> + <Unit8> + <Filename Value="src/uFfmpegJob.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="uFfmpegJob"/> + </Unit8> + <Unit9> + <Filename Value="src/uFlatten.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="uFlatten"/> + </Unit9> + <Unit10> + <Filename Value="src/uGenerate.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="uGenerate"/> + </Unit10> + <Unit11> + <Filename Value="src/uKeyframeIndex.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="uKeyframeIndex"/> + </Unit11> + <Unit12> + <Filename Value="src/uLogView.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="uLogView"/> + </Unit12> + <Unit13> + <Filename Value="src/uMainForm.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="MainForm"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + <UnitName Value="uMainForm"/> + </Unit13> + <Unit14> + <Filename Value="src/uMediaProbe.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="uMediaProbe"/> + </Unit14> + <Unit15> + <Filename Value="src/uMismatchForm.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="MismatchForm"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + <UnitName Value="uMismatchForm"/> + </Unit15> + <Unit16> + <Filename Value="src/uMpvLib.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="uMpvLib"/> + </Unit16> + <Unit17> + <Filename Value="src/uMpvPlayer.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="uMpvPlayer"/> + </Unit17> + <Unit18> + <Filename Value="src/uPanCropForm.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="PanCropForm"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + <UnitName Value="uPanCropForm"/> + </Unit18> + <Unit19> + <Filename Value="src/uProcRunner.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="uProcRunner"/> + </Unit19> + <Unit20> + <Filename Value="src/uProgressForm.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="ProgressForm"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + <UnitName Value="uProgressForm"/> + </Unit20> + <Unit21> + <Filename Value="src/uProject.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="uProject"/> + </Unit21> + <Unit22> + <Filename Value="src/uProjectInfoForm.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="ProjectInfoForm"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + <UnitName Value="uProjectInfoForm"/> + </Unit22> + <Unit23> + <Filename Value="src/uRemuxForm.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="RemuxForm"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + <UnitName Value="uRemuxForm"/> + </Unit23> + <Unit24> + <Filename Value="src/uRemuxQueue.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="uRemuxQueue"/> + </Unit24> + <Unit25> + <Filename Value="src/uSettings.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="uSettings"/> + </Unit25> + <Unit26> + <Filename Value="src/uTheme.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="uTheme"/> + </Unit26> + <Unit27> + <Filename Value="src/uThemedScroll.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="uThemedScroll"/> + </Unit27> + <Unit28> + <Filename Value="src/uThumbs.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="uThumbs"/> + </Unit28> + <Unit29> + <Filename Value="src/uTimelineCtrl.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="uTimelineCtrl"/> + </Unit29> + <Unit30> + <Filename Value="src/uTransform.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="uTransform"/> + </Unit30> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <Target> + <Filename Value="nlve"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <OtherUnitFiles Value="src"/> + <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Linking> + <Debugging> + <DebugInfoType Value="dsDwarf3"/> + <UseExternalDbgSyms Value="True"/> + </Debugging> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/nlve.lpr b/nlve.lpr new file mode 100644 index 0000000..a03aaab --- /dev/null +++ b/nlve.lpr @@ -0,0 +1,27 @@ +program nlve; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX} + cthreads, + {$ENDIF} + Interfaces, + Forms, + uTheme, + uMainForm; + +{$R *.res} + +begin + RequireDerivedFormResource := True; + Application.Title := 'nlve'; + Application.Scaled := True; + Application.Initialize; + { Подписка на появление окон: своим окнам цвета задаются в их же + обработчике создания, а это подстраховка на случай окна, созданного + самой библиотекой. } + HookNewForms; + Application.CreateForm(TMainForm, MainFormInstance); + Application.Run; +end. diff --git a/src/uAppTypes.pas b/src/uAppTypes.pas new file mode 100644 index 0000000..060570e --- /dev/null +++ b/src/uAppTypes.pas @@ -0,0 +1,130 @@ +{ + uAppTypes — базовые типы проекта nlve. + + Юнит намеренно не зависит ни от чего, кроме RTL: на него опираются все + остальные модули, поэтому любая зависимость отсюда расползётся по проекту. +} +unit uAppTypes; + +{$mode objfpc}{$H+} + +interface + +uses + SysUtils; + +type + { Чем заполнен сегмент готового ряда. + + skVideo — кусок настоящего исходного файла, копируется без перекодирования. + skImage — сгенерированный из картинки клип (лежит в кэше проекта). + skBlack — чёрный кадр с тишиной: дыра на таймлайне (тоже клип из кэша). } + TSegmentKind = (skVideo, skImage, skBlack); + + { Один сегмент уплощённого таймлайна: «взять из такого-то файла кусок + с SrcStart длиной Duration». Порядок сегментов в массиве и есть порядок + показа. Позиция на таймлайне здесь не хранится намеренно — она равна + сумме длительностей предыдущих сегментов, дублировать её значит + завести источник рассогласования. } + TFlatSegment = record + FilePath: string; + SrcStart: Double; + Duration: Double; + Kind: TSegmentKind; + { Для сгенерированных кусков — из чего их делать. У картинки это путь + к самой картинке, у чёрного пусто. Хранится прямо здесь, чтобы потом + не восстанавливать источник обратным перебором. } + GenSource: string; + { Начало куска должно быть ровно там, где указано, а не на ближайшем + опорном кадре. Тогда огрызок от начала до следующего опорного кадра + перекодируется, а остальное копируется. + + Конца это не касается: при копировании потока конец и так получается + кадроточным — проверено, рез на неопорном кадре дал ровно столько же + кадров, сколько перекодирование. } + PreciseIn: Boolean; + { Громкость куска как множитель. Единица означает «как в исходнике», + и тогда звук копируется без перекодирования. } + Volume: Double; + { Кусок нельзя скопировать: его исходник не совпадает с параметрами + проекта. Перекодируется только он, а не весь ролик — остальные куски + по-прежнему копируются. } + Transcode: Boolean; + { Готовая цепочка фильтров ffmpeg: как кадр этого исходника ложится в + кадр проекта. Считается один раз при уплощении. } + Filter: string; + end; + + TFlatSegmentArray = array of TFlatSegment; + +{ Настройки форматирования чисел, не зависящие от локали. + + Без этого на русской локали FloatToStr выдаст «10,5», а ffmpeg и mpv + понимают только точку. Это классический источник ошибок, которые + воспроизводятся только у части пользователей. } +function InvariantFormat: TFormatSettings; + +{ Число секунд в виде, пригодном для командной строки ffmpeg и для EDL: + точка как разделитель, шесть знаков после запятой, без экспоненты. } +function SecondsToStr(const Value: Double): string; + +{ Суммарная длительность списка сегментов. } +function TotalDuration(const Segments: TFlatSegmentArray): Double; + +{ Правильное окончание существительного при числе. + + Пример: Plural(1, 'кусок', 'куска', 'кусков') даёт «кусок», для 2 — + «куска», для 5 — «кусков». Без этого в интерфейсе появляется «1 кусков». } +function Plural(ACount: Integer; const AOne, AFew, AMany: string): string; + +implementation + +var + FInvariant: TFormatSettings; + FInvariantReady: Boolean = False; + +function InvariantFormat: TFormatSettings; +begin + if not FInvariantReady then + begin + FInvariant := DefaultFormatSettings; + FInvariant.DecimalSeparator := '.'; + FInvariant.ThousandSeparator := #0; + FInvariantReady := True; + end; + Result := FInvariant; +end; + +function SecondsToStr(const Value: Double): string; +begin + Result := FloatToStrF(Value, ffFixed, 15, 6, InvariantFormat); +end; + +function TotalDuration(const Segments: TFlatSegmentArray): Double; +var + I: Integer; +begin + Result := 0; + for I := 0 to High(Segments) do + Result := Result + Segments[I].Duration; +end; + +function Plural(ACount: Integer; const AOne, AFew, AMany: string): string; +var + Last, LastTwo: Integer; +begin + Last := Abs(ACount) mod 10; + LastTwo := Abs(ACount) mod 100; + { Одиннадцать-четырнадцать выбиваются из общего правила: они требуют + формы «многих», хотя оканчиваются на 1..4. } + if (LastTwo >= 11) and (LastTwo <= 14) then + Result := AMany + else if Last = 1 then + Result := AOne + else if (Last >= 2) and (Last <= 4) then + Result := AFew + else + Result := AMany; +end; + +end. diff --git a/src/uDeps.pas b/src/uDeps.pas new file mode 100644 index 0000000..55cb020 --- /dev/null +++ b/src/uDeps.pas @@ -0,0 +1,579 @@ +{ + uDeps — внешние программы и библиотеки, без которых редактор неполон. + + Их три: ffmpeg и ffprobe для работы с файлами и libmpv для предпросмотра. + Под Linux всё это ставится пакетным менеджером одной командой. Под + Windows ставить нечем, и файлы приходится класть рядом с программой. + + Настройки лежат в файле рядом с программой, и имя у него своё для каждой + системы: под Windows нужны .exe и .dll, под Linux — совсем другие имена. + Один общий файл приводил к тому, что запущенная под Wine программа + записывала windows-список, а потом сборка под Linux искала по нему .dll + и докладывала, что ничего нет. + + Адреса вынесены в файл не из любви к настройкам: ссылки на сборки живут + своей жизнью, и зашитый в программу адрес однажды перестанет работать — + а поправить строчку в файле можно и без пересборки. Там же, где имя + файла сборки меняется с каждой датой, адрес не задаётся вовсе: он + спрашивается у GitHub перед загрузкой. +} +unit uDeps; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils; + +type + TStringArray = array of string; + + { Один набор файлов, который ставится за один раз. } + TDepPackage = record + Id: string; + Title: string; + { Как проверять наличие: 'tool' — исполняемый файл рядом или в PATH, + 'library' — библиотека, которую пробуем загрузить. } + Probe: string; + { Что скачается по адресу: 'zip', '7z' или 'file' — сразу нужный файл. } + Kind: string; + Url: string; + { Если адрес пуст, а это заполнено — спрашиваем последний выпуск у + GitHub и берём из него файл, в имени которого есть AssetMatch. } + GithubRepo: string; + AssetMatch: string; + Comment: string; + Files: TStringArray; + end; + + TDepPackages = array of TDepPackage; + +{ Каталог, куда кладутся файлы: рядом с исполняемым файлом программы. } +function DepTargetDir: string; + +{ Путь к файлу настроек. Имя разное для Windows и Linux. } +function DepsConfigPath: string; + +{ Набор пакетов. Если файла нет — встроенный набор, он же и записывается + на диск, чтобы было что править. } +function LoadDepPackages: TDepPackages; + +{ Где найден файл пакета: путь, слово «в системе» либо пустая строка. } +function FindDepFile(const APackage: TDepPackage; const AName: string): string; + +{ Все ли файлы пакета на месте. } +function PackageInstalled(const APackage: TDepPackage): Boolean; + +{ Адрес для загрузки. Если он не задан напрямую, спрашивается у GitHub. } +function ResolveUrl(const APackage: TDepPackage; out AUrl: string; + out AError: string): Boolean; + +{ Достать нужные файлы из скачанного архива и положить рядом с программой. + Для не-архива сам файл и есть нужный. } +function InstallFrom(const ASourcePath: string; const APackage: TDepPackage; + out AError: string): Boolean; + +{ Чем распаковывать .7z. Пустая строка — нечем. } +function SevenZipTool: string; + +{ Сбросить запомненные пути к ffmpeg и ffprobe: после установки их надо + искать заново, иначе программа продолжит считать, что их нет. } +procedure ForgetToolPaths; + +implementation + +uses + fpjson, jsonparser, Zipper, LazFileUtils, FileUtil, DynLibs, + uProcRunner, uFfmpegCmd, uDownload; + +function DepTargetDir: string; +begin + Result := ExtractFilePath(ExpandFileName(ParamStr(0))); +end; + +function DepsConfigPath: string; +begin + {$IFDEF WINDOWS} + Result := DepTargetDir + 'deps-windows.json'; + {$ELSE} + Result := DepTargetDir + 'deps-linux.json'; + {$ENDIF} +end; + +{ Библиотека считается имеющейся, если её удалось загрузить. Искать её + файлом по PATH бесполезно: в системе она лежит в каталогах библиотек, + про которые PATH ничего не знает. } +function LibraryFound(const AName: string): string; +var + H: TLibHandle; +begin + Result := DepTargetDir + AName; + if FileExists(Result) then + Exit; + + H := LoadLibrary(AName); + if H <> NilHandle then + begin + { Счётчик ссылок: если библиотека уже загружена плеером, наш вызов + лишь увеличил его, и уменьшить обратно безопасно. } + UnloadLibrary(H); + Exit('в системе'); + end; + + Result := ''; +end; + +function ToolFound(const AName: string): string; +begin + Result := DepTargetDir + AName; + if FileExists(Result) then + Exit; + Result := FindTool(ChangeFileExt(AName, '')); + if (Result <> '') and FileExists(Result) then + Exit; + Result := ''; +end; + +function FindDepFile(const APackage: TDepPackage; const AName: string): string; +begin + if APackage.Probe = 'library' then + Result := LibraryFound(AName) + else + Result := ToolFound(AName); +end; + +function PackageInstalled(const APackage: TDepPackage): Boolean; +var + I: Integer; +begin + Result := Length(APackage.Files) > 0; + for I := 0 to High(APackage.Files) do + if FindDepFile(APackage, APackage.Files[I]) = '' then + Exit(False); +end; + +function SevenZipTool: string; +{$IFDEF WINDOWS} +begin + Result := DepTargetDir + '7zr.exe'; + if FileExists(Result) then + Exit; + Result := FindTool('7z'); + if Result = '' then + Result := FindTool('7za'); +end; +{$ELSE} +begin + Result := FindTool('7z'); + if Result = '' then + Result := FindTool('7za'); + if Result = '' then + Result := FindTool('7zr'); +end; +{$ENDIF} + +function BuiltinPackages: TDepPackages; +begin + Result := nil; + {$IFDEF WINDOWS} + SetLength(Result, 3); + + Result[0].Id := 'ffmpeg'; + Result[0].Title := 'ffmpeg и ffprobe'; + Result[0].Probe := 'tool'; + Result[0].Kind := 'zip'; + Result[0].Url := 'https://github.com/BtbN/FFmpeg-Builds/releases/download/' + + 'latest/ffmpeg-master-latest-win64-gpl.zip'; + Result[0].Comment := 'Сборки BtbN, архив zip.'; + Result[0].Files := ['ffmpeg.exe', 'ffprobe.exe']; + + Result[1].Id := '7zr'; + Result[1].Title := 'Распаковщик 7z'; + Result[1].Probe := 'tool'; + Result[1].Kind := 'file'; + Result[1].Url := 'https://www.7-zip.org/a/7zr.exe'; + Result[1].Comment := 'Нужен для libmpv: её сборки раздаются архивом .7z, ' + + 'а стандартная библиотека умеет только zip. Отдельной программой ' + + 'это решается в одно нажатие.'; + Result[1].Files := ['7zr.exe']; + + Result[2].Id := 'mpv'; + Result[2].Title := 'libmpv (предпросмотр)'; + Result[2].Probe := 'library'; + Result[2].Kind := '7z'; + Result[2].Url := ''; + Result[2].GithubRepo := 'shinchiro/mpv-winbuild-cmake'; + Result[2].AssetMatch := 'mpv-dev-x86_64'; + Result[2].Comment := 'Адрес спрашивается у GitHub: имя файла сборки ' + + 'меняется с каждой датой. Сначала поставьте распаковщик 7z.'; + Result[2].Files := ['libmpv-2.dll']; + {$ELSE} + SetLength(Result, 2); + + Result[0].Id := 'ffmpeg'; + Result[0].Title := 'ffmpeg и ffprobe'; + Result[0].Probe := 'tool'; + Result[0].Kind := 'zip'; + Result[0].Url := ''; + Result[0].Comment := 'Ставится пакетным менеджером: sudo apt install ffmpeg'; + Result[0].Files := ['ffmpeg', 'ffprobe']; + + Result[1].Id := 'mpv'; + Result[1].Title := 'libmpv (предпросмотр)'; + Result[1].Probe := 'library'; + Result[1].Kind := 'file'; + Result[1].Url := ''; + Result[1].Comment := 'Ставится пакетным менеджером: sudo apt install mpv'; + Result[1].Files := ['libmpv.so.2']; + {$ENDIF} +end; + +procedure SavePackages(const APackages: TDepPackages); +var + Root: TJSONObject; + List, Files: TJSONArray; + Item: TJSONObject; + I, J: Integer; + Text: TStringList; +begin + Root := TJSONObject.Create; + try + List := TJSONArray.Create; + Root.Add('packages', List); + for I := 0 to High(APackages) do + begin + Item := TJSONObject.Create; + Item.Add('id', APackages[I].Id); + Item.Add('title', APackages[I].Title); + Item.Add('probe', APackages[I].Probe); + Item.Add('kind', APackages[I].Kind); + Item.Add('url', APackages[I].Url); + Item.Add('github_repo', APackages[I].GithubRepo); + Item.Add('asset_match', APackages[I].AssetMatch); + Item.Add('comment', APackages[I].Comment); + Files := TJSONArray.Create; + for J := 0 to High(APackages[I].Files) do + Files.Add(APackages[I].Files[J]); + Item.Add('files', Files); + List.Add(Item); + end; + + Text := TStringList.Create; + try + Text.Text := Root.FormatJSON; + try + Text.SaveToFile(DepsConfigPath); + except + { Каталог программы может быть закрыт на запись. Это не повод + отказываться работать: набор всё равно есть в памяти. } + end; + finally + Text.Free; + end; + finally + Root.Free; + end; +end; + +function LoadDepPackages: TDepPackages; +var + Text: TStringList; + Data: TJSONData; + Root: TJSONObject; + List, Files: TJSONArray; + Item: TJSONObject; + I, J: Integer; +begin + if not FileExists(DepsConfigPath) then + begin + Result := BuiltinPackages; + SavePackages(Result); + Exit; + end; + + Result := nil; + Data := nil; + Text := TStringList.Create; + try + try + Text.LoadFromFile(DepsConfigPath); + Data := GetJSON(Text.Text); + if not (Data is TJSONObject) then + raise Exception.Create('ожидался объект'); + Root := TJSONObject(Data); + List := Root.Get('packages', TJSONArray(nil)); + if List = nil then + raise Exception.Create('нет списка packages'); + + SetLength(Result, List.Count); + for I := 0 to List.Count - 1 do + begin + Item := List.Objects[I]; + Result[I].Id := Item.Get('id', ''); + Result[I].Title := Item.Get('title', ''); + Result[I].Probe := Item.Get('probe', 'tool'); + Result[I].Kind := Item.Get('kind', 'zip'); + Result[I].Url := Item.Get('url', ''); + Result[I].GithubRepo := Item.Get('github_repo', ''); + Result[I].AssetMatch := Item.Get('asset_match', ''); + Result[I].Comment := Item.Get('comment', ''); + Files := Item.Get('files', TJSONArray(nil)); + if Files <> nil then + begin + SetLength(Result[I].Files, Files.Count); + for J := 0 to Files.Count - 1 do + Result[I].Files[J] := Files.Strings[J]; + end; + end; + except + { Испорченный файл не должен мешать работе: берём встроенный набор + и оставляем файл как есть, чтобы человек увидел, что в нём. } + Result := BuiltinPackages; + end; + finally + Data.Free; + Text.Free; + end; +end; + +function ResolveUrl(const APackage: TDepPackage; out AUrl: string; + out AError: string): Boolean; +var + Text: string; + Data: TJSONData; + Root: TJSONObject; + Assets: TJSONArray; + Asset: TJSONObject; + I: Integer; + Name: string; +begin + AUrl := APackage.Url; + AError := ''; + if AUrl <> '' then + Exit(True); + + if APackage.GithubRepo = '' then + begin + AError := 'Адрес не задан. Впишите его в ' + DepsConfigPath; + Exit(False); + end; + + Result := DownloadToString( + 'https://api.github.com/repos/' + APackage.GithubRepo + '/releases/latest', + Text, AError); + if not Result then + begin + AError := 'Не удалось спросить GitHub: ' + AError; + Exit; + end; + + Data := nil; + try + try + Data := GetJSON(Text); + if not (Data is TJSONObject) then + raise Exception.Create('ответ не является объектом'); + Root := TJSONObject(Data); + Assets := Root.Get('assets', TJSONArray(nil)); + if Assets = nil then + raise Exception.Create('в ответе нет списка файлов'); + + for I := 0 to Assets.Count - 1 do + begin + Asset := Assets.Objects[I]; + Name := Asset.Get('name', ''); + if (APackage.AssetMatch = '') or (Pos(APackage.AssetMatch, Name) > 0) then + begin + AUrl := Asset.Get('browser_download_url', ''); + if AUrl <> '' then + Exit(True); + end; + end; + + AError := 'В последнем выпуске нет файла с «' + + APackage.AssetMatch + '» в имени.'; + Result := False; + except + on E: Exception do + begin + AError := 'Ответ GitHub разобрать не удалось: ' + E.Message; + Result := False; + end; + end; + finally + Data.Free; + end; +end; + +{ Ищет в распакованном каталоге файлы с нужными именами и копирует их + рядом с программой. Имя сравнивается без учёта каталогов: в архивах + сборок файлы лежат внутри папки с версией, и знать её заранее нельзя. } +function CopyWanted(const ARoot: string; const APackage: TDepPackage; + out AError: string): Boolean; +var + Found: TStringList; + I, J: Integer; + WantName, Src, Dst, Missing: string; +begin + Result := False; + AError := ''; + Missing := ''; + + Found := TStringList.Create; + try + FindAllFiles(Found, ARoot, '', True); + for I := 0 to High(APackage.Files) do + begin + WantName := APackage.Files[I]; + Src := ''; + for J := 0 to Found.Count - 1 do + if CompareText(ExtractFileName(Found[J]), WantName) = 0 then + begin + Src := Found[J]; + Break; + end; + + if Src = '' then + begin + if Missing <> '' then + Missing := Missing + ', '; + Missing := Missing + WantName; + Continue; + end; + + Dst := DepTargetDir + WantName; + if not CopyFile(Src, Dst) then + begin + AError := 'Не удалось записать ' + Dst; + Exit; + end; + end; + + if Missing <> '' then + begin + AError := 'В архиве не нашлось: ' + Missing; + Exit; + end; + + Result := True; + finally + Found.Free; + end; +end; + +function Extract7z(const AArchive, ADestDir: string; out AError: string): Boolean; +var + Tool: string; + Res: TProcResult; +begin + Result := False; + Tool := SevenZipTool; + if Tool = '' then + begin + AError := 'Нечем распаковать .7z. Установите распаковщик 7z ' + + '(он есть в этом же списке).'; + Exit; + end; + + { Ключи: x — распаковать с путями, -y — на все вопросы «да», + -o без пробела — куда. } + Res := RunProcess(Tool, ['x', '-y', '-o' + ExcludeTrailingPathDelimiter(ADestDir), + AArchive], nil, nil, nil); + if not Res.Started then + begin + AError := 'Не удалось запустить ' + Tool + ': ' + Res.ErrorText; + Exit; + end; + if Res.ExitCode <> 0 then + begin + AError := Tool + ' завершился с кодом ' + IntToStr(Res.ExitCode); + Exit; + end; + Result := True; +end; + +function InstallFrom(const ASourcePath: string; const APackage: TDepPackage; + out AError: string): Boolean; +var + TempDir, Ext, Dst: string; + Unzip: TUnZipper; + Unpacked: Boolean; +begin + Result := False; + AError := ''; + + if not FileExists(ASourcePath) then + begin + AError := 'Файл не найден: ' + ASourcePath; + Exit; + end; + + Ext := LowerCase(ExtractFileExt(ASourcePath)); + + { Если это не архив, значит по адресу лежал сам нужный файл — или его + указали вручную. Копируем под первым именем из списка. } + if (Ext <> '.zip') and (Ext <> '.7z') then + begin + if Length(APackage.Files) = 0 then + begin + AError := 'Не указано, как называть файл.'; + Exit; + end; + Dst := DepTargetDir + APackage.Files[0]; + if SameFileName(ExpandFileName(ASourcePath), ExpandFileName(Dst)) then + Exit(True); + if not CopyFile(ASourcePath, Dst) then + begin + AError := 'Не удалось записать ' + Dst; + Exit; + end; + Exit(True); + end; + + { Распаковываем целиком во временный каталог рядом с программой, потом + забираем нужное. Так не приходится угадывать, в какой папке внутри + архива лежат файлы. } + TempDir := DepTargetDir + 'deps-tmp' + PathDelim; + try + if DirectoryExists(TempDir) then + DeleteDirectory(TempDir, False); + if not ForceDirectories(TempDir) then + begin + AError := 'Не удалось создать ' + TempDir; + Exit; + end; + + Unpacked := False; + if Ext = '.zip' then + begin + Unzip := TUnZipper.Create; + try + Unzip.FileName := ASourcePath; + Unzip.OutputPath := TempDir; + Unzip.UnZipAllFiles; + Unpacked := True; + finally + Unzip.Free; + end; + end + else + Unpacked := Extract7z(ASourcePath, TempDir, AError); + + if Unpacked then + Result := CopyWanted(TempDir, APackage, AError); + except + on E: Exception do + AError := 'Не удалось распаковать: ' + E.Message; + end; + + if DirectoryExists(TempDir) then + DeleteDirectory(TempDir, False); +end; + +procedure ForgetToolPaths; +begin + ResetToolSearch; +end; + +end. diff --git a/src/uDepsForm.lfm b/src/uDepsForm.lfm new file mode 100644 index 0000000..82308dd --- /dev/null +++ b/src/uDepsForm.lfm @@ -0,0 +1,112 @@ +object DepsForm: TDepsForm + Left = 300 + Height = 470 + Top = 200 + Width = 900 + Caption = 'Зависимости' + ClientHeight = 470 + ClientWidth = 900 + OnCreate = FormCreate + Position = poOwnerFormCenter + LCLVersion = '4.6' + object lblHead: TLabel + Left = 12 + Height = 40 + Top = 10 + Width = 876 + Anchors = [akTop, akLeft, akRight] + AutoSize = False + Caption = 'Что нужно программе для работы' + ParentColor = False + WordWrap = True + end + object grid: TStringGrid + Left = 12 + Height = 200 + Top = 56 + Width = 876 + Anchors = [akTop, akLeft, akRight] + ColCount = 4 + FixedCols = 0 + Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRowSelect, goSmoothScroll] + RowCount = 1 + TabOrder = 0 + OnSelection = gridSelection + end + object lblComment: TLabel + Left = 12 + Height = 60 + Top = 266 + Width = 876 + Anchors = [akTop, akLeft, akRight] + AutoSize = False + Caption = '' + ParentColor = False + WordWrap = True + end + object lblProgress: TLabel + Left = 12 + Height = 20 + Top = 334 + Width = 876 + Anchors = [akTop, akLeft, akRight] + AutoSize = False + Caption = '' + ParentColor = False + end + object pnlBottom: TPanel + Left = 0 + Height = 56 + Top = 414 + Width = 900 + Align = alBottom + BevelOuter = bvNone + ClientHeight = 56 + ClientWidth = 900 + TabOrder = 1 + object btnDownload: TThemedButton + Left = 12 + Height = 30 + Top = 12 + Width = 220 + Caption = 'Скачать и установить' + OnClick = btnDownloadClick + TabOrder = 0 + end + object btnPick: TThemedButton + Left = 244 + Height = 30 + Top = 12 + Width = 220 + Caption = 'Указать файл...' + OnClick = btnPickClick + TabOrder = 1 + end + object btnRefresh: TThemedButton + Left = 476 + Height = 30 + Top = 12 + Width = 160 + Caption = 'Проверить снова' + OnClick = btnRefreshClick + TabOrder = 2 + end + object btnClose: TThemedButton + Left = 788 + Height = 30 + Top = 12 + Width = 100 + Anchors = [akTop, akRight] + Cancel = True + Caption = 'Закрыть' + OnClick = btnCloseClick + TabOrder = 3 + end + end + object OpenDepDialog: TOpenDialog + Filter = 'Библиотеки и архивы|*.dll;*.so;*.so.2;*.zip;*.exe|Все файлы|*' + Options = [ofFileMustExist, ofEnableSizing, ofViewDetail] + Left = 820 + Top = 60 + end +end diff --git a/src/uDepsForm.pas b/src/uDepsForm.pas new file mode 100644 index 0000000..ba49fd7 --- /dev/null +++ b/src/uDepsForm.pas @@ -0,0 +1,384 @@ +{ + uDepsForm — окно «Зависимости». + + Показывает, что из нужного есть, а чего нет, и позволяет доложить + недостающее: скачать по адресу из deps.json либо указать уже скачанный + файл. + + Загрузка идёт в отдельном потоке: она может занять минуты, и окно всё + это время должно отвечать на нажатия, в том числе на «Закрыть». +} +unit uDepsForm; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Forms, Controls, Graphics, StdCtrls, ExtCtrls, Grids, + Dialogs, uDeps, uTheme, uThemedScroll; + +type + + { Поток загрузки. Сообщает о ходе через Synchronize: трогать окно из + чужого потока нельзя. } + TDepDownloadThread = class(TThread) + private + FUrl: string; + FDestPath: string; + FReceived: Int64; + FTotal: Int64; + FError: string; + FOk: Boolean; + FOnProgress: TNotifyEvent; + procedure ReportProgress; + function Progress(AReceived, ATotal: Int64): Boolean; + protected + procedure Execute; override; + public + constructor Create(const AUrl, ADestPath: string); + property Received: Int64 read FReceived; + property Total: Int64 read FTotal; + property Error: string read FError; + property Ok: Boolean read FOk; + property OnProgress: TNotifyEvent read FOnProgress write FOnProgress; + end; + + { TDepsForm } + + TDepsForm = class(TForm) + btnClose: TThemedButton; + btnDownload: TThemedButton; + btnPick: TThemedButton; + btnRefresh: TThemedButton; + grid: TStringGrid; + lblComment: TLabel; + lblHead: TLabel; + lblProgress: TLabel; + OpenDepDialog: TOpenDialog; + pnlBottom: TPanel; + procedure btnCloseClick(Sender: TObject); + procedure btnDownloadClick(Sender: TObject); + procedure btnPickClick(Sender: TObject); + procedure btnRefreshClick(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); + procedure gridSelection(Sender: TObject; ACol, ARow: Integer); + private + FPackages: TDepPackages; + FThread: TDepDownloadThread; + FDownloadPath: string; + FDownloadIndex: Integer; + procedure Refresh; + function SelectedIndex: Integer; + procedure DownloadProgress(Sender: TObject); + procedure DownloadDone(Sender: TObject); + procedure SetBusy(ABusy: Boolean); + procedure Install(const ASourcePath: string; AIndex: Integer); + end; + +procedure ShowDeps(AOwner: TComponent); + +implementation + +{$R *.lfm} + +uses + uDownload; + +const + ColTitle = 0; + ColFiles = 1; + ColState = 2; + ColWhere = 3; + +{ TDepDownloadThread } + +constructor TDepDownloadThread.Create(const AUrl, ADestPath: string); +begin + inherited Create(True); + FreeOnTerminate := False; + FUrl := AUrl; + FDestPath := ADestPath; +end; + +function TDepDownloadThread.Progress(AReceived, ATotal: Int64): Boolean; +begin + FReceived := AReceived; + FTotal := ATotal; + Synchronize(@ReportProgress); + Result := not Terminated; +end; + +procedure TDepDownloadThread.ReportProgress; +begin + if Assigned(FOnProgress) then + FOnProgress(Self); +end; + +procedure TDepDownloadThread.Execute; +begin + FOk := DownloadToFile(FUrl, FDestPath, @Progress, FError); +end; + +{ TDepsForm } + +procedure TDepsForm.FormCreate(Sender: TObject); +begin + Caption := 'Зависимости'; + OnCloseQuery := @FormCloseQuery; + + grid.ColCount := 4; + grid.RowCount := 1; + grid.FixedRows := 1; + grid.Cells[ColTitle, 0] := 'Что'; + grid.Cells[ColFiles, 0] := 'Файлы'; + grid.Cells[ColState, 0] := 'Состояние'; + grid.Cells[ColWhere, 0] := 'Где найдено'; + grid.ColWidths[ColTitle] := 200; + grid.ColWidths[ColFiles] := 200; + grid.ColWidths[ColState] := 120; + grid.ColWidths[ColWhere] := 340; + + lblHead.Caption := + 'Файлы кладутся рядом с программой: ' + DepTargetDir + LineEnding + + 'Адреса для загрузки берутся из ' + DepsConfigPath + + ' — их можно править вручную.'; + + ApplyDarkTheme(Self); + { Системные полосы прокрутки у таблицы светлые и цвета не берут — + заменяем своими. } + AttachThemedScrollBars(grid); + Refresh; +end; + +procedure TDepsForm.Refresh; +var + I, J: Integer; + Files, Where, First: string; +begin + FPackages := LoadDepPackages; + grid.RowCount := Length(FPackages) + 1; + + for I := 0 to High(FPackages) do + begin + Files := ''; + Where := ''; + for J := 0 to High(FPackages[I].Files) do + begin + if Files <> '' then + Files := Files + ', '; + Files := Files + FPackages[I].Files[J]; + First := FindDepFile(FPackages[I], FPackages[I].Files[J]); + if (First <> '') and (Where = '') then + begin + { Для библиотеки в системе возвращается не путь, а слово: где + именно её нашёл загрузчик, он не рассказывает. } + if Pos(PathDelim, First) > 0 then + Where := ExtractFilePath(First) + else + Where := First; + end; + end; + + grid.Cells[ColTitle, I + 1] := FPackages[I].Title; + grid.Cells[ColFiles, I + 1] := Files; + if PackageInstalled(FPackages[I]) then + grid.Cells[ColState, I + 1] := 'есть' + else + grid.Cells[ColState, I + 1] := 'НЕТ'; + grid.Cells[ColWhere, I + 1] := Where; + end; + + if grid.RowCount > 1 then + begin + if grid.Row < 1 then + grid.Row := 1; + gridSelection(nil, 0, grid.Row); + end; +end; + +function TDepsForm.SelectedIndex: Integer; +begin + Result := grid.Row - 1; + if (Result < 0) or (Result > High(FPackages)) then + Result := -1; +end; + +procedure TDepsForm.gridSelection(Sender: TObject; ACol, ARow: Integer); +var + I: Integer; +begin + I := ARow - 1; + if (I < 0) or (I > High(FPackages)) then + begin + lblComment.Caption := ''; + Exit; + end; + + if FPackages[I].Url <> '' then + lblComment.Caption := 'Адрес: ' + FPackages[I].Url + LineEnding + + FPackages[I].Comment + else + lblComment.Caption := FPackages[I].Comment; + + btnDownload.Enabled := (FThread = nil) and + ((FPackages[I].Url <> '') or (FPackages[I].GithubRepo <> '')); +end; + +procedure TDepsForm.SetBusy(ABusy: Boolean); +begin + btnDownload.Enabled := (not ABusy) and (SelectedIndex >= 0) and + ((FPackages[SelectedIndex].Url <> '') or + (FPackages[SelectedIndex].GithubRepo <> '')); + btnPick.Enabled := not ABusy; + btnRefresh.Enabled := not ABusy; + grid.Enabled := not ABusy; +end; + +procedure TDepsForm.btnDownloadClick(Sender: TObject); +var + I: Integer; + Url, LocalName, Err: string; +begin + I := SelectedIndex; + if (I < 0) or (FThread <> nil) then + Exit; + SetBusy(True); + lblProgress.Caption := 'Узнаю адрес...'; + Application.ProcessMessages; + if not ResolveUrl(FPackages[I], Url, Err) then + begin + SetBusy(False); + lblProgress.Caption := Err; + Exit; + end; + + { Имя временного файла берём из адреса: по нему потом видно, архив это + или сразу нужный файл. } + LocalName := ExtractFileName( + StringReplace(Url, '/', PathDelim, [rfReplaceAll])); + if LocalName = '' then + LocalName := 'download.bin'; + FDownloadPath := DepTargetDir + LocalName; + FDownloadIndex := I; + lblProgress.Caption := 'Соединяюсь...'; + + FThread := TDepDownloadThread.Create(Url, FDownloadPath); + FThread.OnProgress := @DownloadProgress; + FThread.OnTerminate := @DownloadDone; + FThread.Start; +end; + +procedure TDepsForm.DownloadProgress(Sender: TObject); +var + T: TDepDownloadThread; +begin + T := TDepDownloadThread(Sender); + if T.Total > 0 then + lblProgress.Caption := Format('Загружено %.1f из %.1f МБ (%d%%)', + [T.Received / 1048576, T.Total / 1048576, + Round(T.Received * 100 / T.Total)]) + else + lblProgress.Caption := Format('Загружено %.1f МБ', + [T.Received / 1048576]); +end; + +procedure TDepsForm.DownloadDone(Sender: TObject); +var + Ok: Boolean; + Err, Src, Ext: string; + Index: Integer; +begin + Ok := FThread.Ok; + Err := FThread.Error; + Src := FDownloadPath; + Index := FDownloadIndex; + FreeAndNil(FThread); + SetBusy(False); + + if not Ok then + begin + lblProgress.Caption := 'Не удалось: ' + Err; + Exit; + end; + + lblProgress.Caption := 'Устанавливаю...'; + Application.ProcessMessages; + Install(Src, Index); + + { Скачанный архив больше не нужен. Сам нужный файл, если качали его + напрямую, уже лежит на месте и удаляется тем же путём только если + это временная копия. } + Ext := LowerCase(ExtractFileExt(Src)); + if ((Ext = '.zip') or (Ext = '.7z')) and FileExists(Src) then + DeleteFile(Src); +end; + +procedure TDepsForm.Install(const ASourcePath: string; AIndex: Integer); +var + Err: string; +begin + if (AIndex < 0) or (AIndex > High(FPackages)) then + Exit; + if InstallFrom(ASourcePath, FPackages[AIndex], Err) then + begin + ForgetToolPaths; + lblProgress.Caption := 'Готово. Закройте окно — программа попробует ' + + 'подхватить установленное сама.'; + end + else + lblProgress.Caption := 'Не удалось: ' + Err; + Refresh; +end; + +procedure TDepsForm.btnPickClick(Sender: TObject); +var + I: Integer; +begin + I := SelectedIndex; + if I < 0 then + Exit; + if not OpenDepDialog.Execute then + Exit; + lblProgress.Caption := 'Устанавливаю...'; + Application.ProcessMessages; + Install(OpenDepDialog.FileName, I); +end; + +procedure TDepsForm.btnRefreshClick(Sender: TObject); +begin + ForgetToolPaths; + Refresh; + lblProgress.Caption := ''; +end; + +procedure TDepsForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean); +begin + { Пока идёт загрузка, окно не закрываем: поток пишет в его поля. } + CanClose := FThread = nil; + if not CanClose then + begin + FThread.Terminate; + lblProgress.Caption := 'Останавливаю загрузку...'; + end; +end; + +procedure TDepsForm.btnCloseClick(Sender: TObject); +begin + Close; +end; + +procedure ShowDeps(AOwner: TComponent); +var + Form: TDepsForm; +begin + Form := TDepsForm.Create(AOwner); + try + Form.ShowModal; + finally + Form.Free; + end; +end; + +end. diff --git a/src/uDownload.pas b/src/uDownload.pas new file mode 100644 index 0000000..dc2a331 --- /dev/null +++ b/src/uDownload.pas @@ -0,0 +1,351 @@ +{ + uDownload — скачивание файла по адресу. + + Почему не готовая библиотека. Обращение по https требует шифрования, а + в FPC оно берётся из OpenSSL, то есть из двух отдельных библиотек. Под + Windows их пришлось бы класть рядом с программой — и получается курица + и яйцо: чтобы скачать недостающие библиотеки, нужны другие библиотеки. + + Поэтому под Windows берётся WinHTTP: она часть системы и есть всегда, + в том числе в Wine. Под Linux вызывается curl — там ставить зависимости + всё равно правильнее пакетным менеджером, и загрузка нужна разве что + для проверки. + + Работает синхронно и рассчитан на вызов из рабочего потока. +} +unit uDownload; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils; + +type + { Сколько байт получено и сколько всего ожидается. Ноль во втором + означает, что размер сервер не сообщил. Вернуть False, чтобы + прекратить загрузку. } + TDownloadProgress = function(AReceived, ATotal: Int64): Boolean of object; + +{ Скачивает адрес в файл. Возвращает False и текст ошибки при неудаче. + Незавершённый файл удаляется: половина архива хуже, чем его отсутствие, + потому что выглядит как готовый. } +function DownloadToFile(const AUrl, ADestPath: string; + AOnProgress: TDownloadProgress; out AError: string): Boolean; + +{ Скачать небольшой ответ прямо в строку. Нужно для опроса списка выпусков + на GitHub: имя файла сборки меняется с каждой датой, и зашивать его в + программу бессмысленно. } +function DownloadToString(const AUrl: string; out AText: string; + out AError: string): Boolean; + +implementation + +uses + {$IFDEF WINDOWS} + Windows + {$ELSE} + uProcRunner + {$ENDIF}; + +{$IFDEF WINDOWS} + +const + WinHttpLib = 'winhttp.dll'; + + WINHTTP_ACCESS_TYPE_AUTOMATIC_PROXY = 4; + WINHTTP_FLAG_SECURE = $00800000; + WINHTTP_QUERY_STATUS_CODE = 19; + WINHTTP_QUERY_CONTENT_LENGTH = 5; + WINHTTP_QUERY_FLAG_NUMBER = $20000000; + + HttpsPort = 443; + HttpPort = 80; + +function WinHttpOpen(pszAgentW: PWideChar; dwAccessType: DWORD; + pszProxyW, pszProxyBypassW: PWideChar; dwFlags: DWORD): Pointer; + stdcall; external WinHttpLib; +function WinHttpConnect(hSession: Pointer; pswzServerName: PWideChar; + nServerPort: Word; dwReserved: DWORD): Pointer; + stdcall; external WinHttpLib; +function WinHttpOpenRequest(hConnect: Pointer; + pwszVerb, pwszObjectName, pwszVersion, pwszReferrer: PWideChar; + ppwszAcceptTypes: Pointer; dwFlags: DWORD): Pointer; + stdcall; external WinHttpLib; +function WinHttpSendRequest(hRequest: Pointer; pwszHeaders: PWideChar; + dwHeadersLength: DWORD; lpOptional: Pointer; + dwOptionalLength, dwTotalLength: DWORD; dwContext: PtrUInt): LongBool; + stdcall; external WinHttpLib; +function WinHttpReceiveResponse(hRequest, lpReserved: Pointer): LongBool; + stdcall; external WinHttpLib; +function WinHttpQueryHeaders(hRequest: Pointer; dwInfoLevel: DWORD; + pwszName: PWideChar; lpBuffer: Pointer; var lpdwBufferLength: DWORD; + lpdwIndex: Pointer): LongBool; stdcall; external WinHttpLib; +function WinHttpReadData(hRequest, lpBuffer: Pointer; + dwNumberOfBytesToRead: DWORD; var lpdwNumberOfBytesRead: DWORD): LongBool; + stdcall; external WinHttpLib; +function WinHttpCloseHandle(hInternet: Pointer): LongBool; + stdcall; external WinHttpLib; + +{ Разбор адреса вручную. WinHttpCrackUrl умеет то же самое, но требует + описания ещё одной структуры ради трёх строк кода. } +procedure SplitUrl(const AUrl: string; out AHost, APath: string; + out APort: Word; out ASecure: Boolean); +var + Rest: string; + P: Integer; +begin + ASecure := True; + Rest := AUrl; + if Copy(Rest, 1, 8) = 'https://' then + begin + ASecure := True; + Rest := Copy(Rest, 9, Length(Rest)); + end + else if Copy(Rest, 1, 7) = 'http://' then + begin + ASecure := False; + Rest := Copy(Rest, 8, Length(Rest)); + end; + + P := Pos('/', Rest); + if P = 0 then + begin + AHost := Rest; + APath := '/'; + end + else + begin + AHost := Copy(Rest, 1, P - 1); + APath := Copy(Rest, P, Length(Rest)); + end; + + if ASecure then + APort := HttpsPort + else + APort := HttpPort; + + P := Pos(':', AHost); + if P > 0 then + begin + APort := StrToIntDef(Copy(AHost, P + 1, Length(AHost)), APort); + AHost := Copy(AHost, 1, P - 1); + end; +end; + +function DownloadToFile(const AUrl, ADestPath: string; + AOnProgress: TDownloadProgress; out AError: string): Boolean; +var + Host, Path: string; + Port: Word; + Secure: Boolean; + Session, Connect, Request: Pointer; + Flags, Status, Len: DWORD; + Total, Received: Int64; + Buffer: array[0..65535] of Byte; + Read: DWORD; + Stream: TFileStream; + Cancelled: Boolean; +begin + Result := False; + AError := ''; + Session := nil; + Connect := nil; + Request := nil; + Stream := nil; + Cancelled := False; + + SplitUrl(AUrl, Host, Path, Port, Secure); + if Host = '' then + begin + AError := 'Неверный адрес: ' + AUrl; + Exit; + end; + + try + Session := WinHttpOpen(PWideChar(WideString('nlve')), + WINHTTP_ACCESS_TYPE_AUTOMATIC_PROXY, nil, nil, 0); + if Session = nil then + begin + AError := 'WinHttpOpen не удался, код ' + IntToStr(GetLastError); + Exit; + end; + + Connect := WinHttpConnect(Session, PWideChar(WideString(Host)), Port, 0); + if Connect = nil then + begin + AError := 'Не удалось соединиться с ' + Host + + ', код ' + IntToStr(GetLastError); + Exit; + end; + + Flags := 0; + if Secure then + Flags := WINHTTP_FLAG_SECURE; + Request := WinHttpOpenRequest(Connect, PWideChar(WideString('GET')), + PWideChar(WideString(Path)), nil, nil, nil, Flags); + if Request = nil then + begin + AError := 'WinHttpOpenRequest не удался, код ' + IntToStr(GetLastError); + Exit; + end; + + if not WinHttpSendRequest(Request, nil, 0, nil, 0, 0, 0) then + begin + AError := 'Запрос не отправлен, код ' + IntToStr(GetLastError); + Exit; + end; + + if not WinHttpReceiveResponse(Request, nil) then + begin + AError := 'Ответ не получен, код ' + IntToStr(GetLastError); + Exit; + end; + + Status := 0; + Len := SizeOf(Status); + if WinHttpQueryHeaders(Request, + WINHTTP_QUERY_STATUS_CODE or WINHTTP_QUERY_FLAG_NUMBER, + nil, @Status, Len, nil) then + begin + if (Status < 200) or (Status > 299) then + begin + AError := 'Сервер ответил кодом ' + IntToStr(Status); + Exit; + end; + end; + + Total := 0; + Len := SizeOf(DWORD); + Status := 0; + if WinHttpQueryHeaders(Request, + WINHTTP_QUERY_CONTENT_LENGTH or WINHTTP_QUERY_FLAG_NUMBER, + nil, @Status, Len, nil) then + Total := Status; + + Stream := TFileStream.Create(ADestPath, fmCreate); + Received := 0; + repeat + Read := 0; + if not WinHttpReadData(Request, @Buffer[0], SizeOf(Buffer), Read) then + begin + AError := 'Обрыв загрузки, код ' + IntToStr(GetLastError); + Exit; + end; + if Read = 0 then + Break; + Stream.WriteBuffer(Buffer[0], Read); + Inc(Received, Read); + if Assigned(AOnProgress) and (not AOnProgress(Received, Total)) then + begin + Cancelled := True; + AError := 'Загрузка остановлена.'; + Exit; + end; + until False; + + Result := True; + finally + FreeAndNil(Stream); + if Request <> nil then + WinHttpCloseHandle(Request); + if Connect <> nil then + WinHttpCloseHandle(Connect); + if Session <> nil then + WinHttpCloseHandle(Session); + { Недокачанный файл удаляем: он выглядит как готовый архив и потом + непонятно, почему распаковка ломается. } + if (not Result) and FileExists(ADestPath) then + SysUtils.DeleteFile(ADestPath); + if Cancelled then + AError := 'Загрузка остановлена.'; + end; +end; + +function DownloadToString(const AUrl: string; out AText: string; + out AError: string): Boolean; +var + Temp: string; + Text: TStringList; +begin + AText := ''; + Temp := SysUtils.GetTempFileName; + Result := DownloadToFile(AUrl, Temp, nil, AError); + if not Result then + Exit; + Text := TStringList.Create; + try + try + Text.LoadFromFile(Temp); + AText := Text.Text; + except + on E: Exception do + begin + AError := E.Message; + Result := False; + end; + end; + finally + Text.Free; + SysUtils.DeleteFile(Temp); + end; +end; + +{$ELSE} + +function DownloadToFile(const AUrl, ADestPath: string; + AOnProgress: TDownloadProgress; out AError: string): Boolean; +var + Res: TProcResult; +begin + AError := ''; + { curl показывает ход загрузки на своём выводе, но разбирать его смысла + нет: под Linux зависимости ставятся пакетным менеджером, и эта ветка + нужна больше для проверки самого механизма. } + Res := RunProcess('curl', + ['-fSL', '--connect-timeout', '20', '-o', ADestPath, AUrl], + nil, nil, nil); + Result := Res.Started and (Res.ExitCode = 0); + if not Res.Started then + AError := 'Не удалось запустить curl: ' + Res.ErrorText + else if not Result then + AError := 'curl завершился с кодом ' + IntToStr(Res.ExitCode); + if (not Result) and FileExists(ADestPath) then + DeleteFile(ADestPath); + if Assigned(AOnProgress) then + AOnProgress(0, 0); +end; + +function DownloadToString(const AUrl: string; out AText: string; + out AError: string): Boolean; +var + Temp: string; + Text: TStringList; +begin + AText := ''; + Temp := SysUtils.GetTempFileName; + Result := DownloadToFile(AUrl, Temp, nil, AError); + if not Result then + Exit; + Text := TStringList.Create; + try + try + Text.LoadFromFile(Temp); + AText := Text.Text; + except + on E: Exception do + begin + AError := E.Message; + Result := False; + end; + end; + finally + Text.Free; + SysUtils.DeleteFile(Temp); + end; +end; + +{$ENDIF} + +end. diff --git a/src/uEdl.pas b/src/uEdl.pas new file mode 100644 index 0000000..7e90891 --- /dev/null +++ b/src/uEdl.pas @@ -0,0 +1,90 @@ +{ + uEdl — сборка EDL для mpv. + + EDL это способ сказать плееру «сшей мне виртуальный файл вот из таких + кусков таких-то файлов». mpv показывает результат как единый ролик: + с общей длительностью, перемоткой и всем прочим. Именно это даёт + предпросмотр смонтированного без единого перекодирования. + + Формат описан в /usr/share/doc/mpv/edl-mpv.rst.gz, копия рассуждений: + + edl://<файл>,start=<сек>,length=<сек>;<файл>,start=...,length=... + + Подвох в экранировании. Значение параметра не может содержать символы + , ; ! и перевод строки. В путях к файлам запятые встречаются постоянно. + Поэтому предусмотрена форма %<число байт>%<значение>: она говорит + разборщику «дальше ровно столько байт, что бы там ни стояло». + Мы применяем её к путям всегда — так не приходится гадать, какой путь + «опасный», а какой нет. +} +unit uEdl; + +{$mode objfpc}{$H+} + +interface + +uses + SysUtils, uAppTypes; + +{ Значение в форме %<число байт>%<значение>. } +function EdlEscape(const Value: string): string; + +{ Строка edl://... для передачи в mpv команду loadfile. + + NoChapters убирает автоматические главы, которые mpv иначе расставляет + на каждом стыке сегментов — в редакторе они только мешают. } +function BuildEdlUri(const Segments: TFlatSegmentArray; + NoChapters: Boolean = True): string; + +{ То же самое в виде многострочного файла EDL. Нужно исключительно для + отладки: такую строку можно записать в .edl и открыть в mpv руками. } +function BuildEdlText(const Segments: TFlatSegmentArray; + NoChapters: Boolean = True): string; + +implementation + +function EdlEscape(const Value: string): string; +begin + { Length по AnsiString возвращает байты, а не символы — это то, что нужно: + спецификация требует именно число байт, а пути у нас в UTF-8. } + Result := '%' + IntToStr(Length(Value)) + '%' + Value; +end; + +function SegmentEntry(const Seg: TFlatSegment): string; +begin + Result := EdlEscape(Seg.FilePath) + + ',start=' + SecondsToStr(Seg.SrcStart) + + ',length=' + SecondsToStr(Seg.Duration); +end; + +function BuildEdlUri(const Segments: TFlatSegmentArray; + NoChapters: Boolean): string; +var + I: Integer; +begin + Result := 'edl://'; + if NoChapters then + Result := Result + '!no_chapters;'; + for I := 0 to High(Segments) do + begin + if I > 0 then + Result := Result + ';'; + Result := Result + SegmentEntry(Segments[I]); + end; +end; + +function BuildEdlText(const Segments: TFlatSegmentArray; + NoChapters: Boolean): string; +var + I: Integer; +begin + { Перевод строки обязан быть именно LF: спецификация требует + юниксовые концы строк и не прощает CRLF. } + Result := '# mpv EDL v0'#10; + if NoChapters then + Result := Result + '!no_chapters'#10; + for I := 0 to High(Segments) do + Result := Result + SegmentEntry(Segments[I]) + #10; +end; + +end. diff --git a/src/uExport.pas b/src/uExport.pas new file mode 100644 index 0000000..c71fc69 --- /dev/null +++ b/src/uExport.pas @@ -0,0 +1,739 @@ +{ + uExport — сборка готового ролика из сегментов без перекодирования. + + Схема работы и почему она такая. + + Напрашивающийся способ — отдать ffmpeg один список кусков с директивами + inpoint и outpoint и получить результат за один проход, не создавая + временных файлов. На пробе он оказался неточным: запрошенные 600 кадров + превратились в 574, а метки времени не пересчитались. Поэтому каждый + кусок вырезается отдельным запуском ffmpeg с -ss и -to до -i, что даёт + ровно запрошенную длину, и только потом всё склеивается. + + Плата — временные файлы размером с использованный материал. Это принятое + решение: диск дешевле, чем перекодирование, и дешевле, чем неточный рез. + + Второй важный момент — через какой формат идут промежуточные куски. + + Когда все куски происходят из одного файла, у них один и тот же набор + параметров кодека, и склеить их можно напрямую. Но стоит появиться + куску от другого кодировщика — из второго исходника или из созданной + нами вставки под картинку, — как наборы параметров расходятся. MP4 и + Matroska хранят такой набор один на дорожку, поэтому декодер применяет + параметры первого куска ко всем и на стыках сыплет ошибками. + + Замерено на проекте из шести кусков: прямая склейка в Matroska дала + 384 ошибки декодера HEVC при верном числе кадров, склейка через + промежуточный MPEG-TS — ни одной. MPEG-TS повторяет параметры прямо + в потоке перед каждым опорным кадром, поэтому их смена посреди ролика + для него нормальна. + + Отсюда правило: один источник — прямая склейка (быстрее), несколько — + через MPEG-TS. Если кодек в MPEG-TS не помещается, собираем напрямую + и честно предупреждаем. + + Начало каждого куска притягивается к опорному кадру. Без этого начало + вырезки нечем декодировать: кадры в середине группы хранят разницу с + соседями, а не самостоятельное изображение. Конец притягивать не нужно — + оборванная группа воспроизводится нормально. + + Длина куска при этом сохраняется: сдвигается только то, какой участок + исходника показывается. Иначе притягивание одного реза сдвинуло бы всё, + что стоит на монтаже правее. +} +unit uExport; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, uAppTypes, uKeyframeIndex, uMediaProbe; + +type + { Что получилось с одной частью. + + Кусок монтажа обычно даёт одну часть, но при точном резе — две: + перекодированный огрызок до ближайшего опорного кадра и скопированный + остаток. Поэтому частей может быть больше, чем кусков, и у каждой + указано, из какого куска она произошла. } + TSegmentReport = record + Index: Integer; + SourcePath: string; + RequestedStart: Double; + ActualStart: Double; + Duration: Double; + TempPath: string; + Packets: Int64; + Encoded: Boolean; + end; + + TSegmentReports = array of TSegmentReport; + + TExportReport = record + Succeeded: Boolean; + Cancelled: Boolean; + Message: string; + OutputPath: string; + CacheDir: string; + Segments: TSegmentReports; + { Сумма пакетов вырезанных кусков и число пакетов в готовом файле. + Расхождение означает, что склейка что-то потеряла или продублировала. } + ExpectedPackets: Int64; + ActualPackets: Int64; + TotalDuration: Double; + end; + + TExportThread = class(TThread) + private + FSegments: TFlatSegmentArray; + FOutputPath: string; + FCacheDir: string; + FKeepIntermediate: Boolean; + + FCancelRequested: Boolean; + FStageText: string; + FFraction: Double; + FPendingLog: string; + FReport: TExportReport; + + FOnProgress: TNotifyEvent; + FOnLog: TNotifyEvent; + + { Учёт общего прогресса: сколько работы уже позади и сколько весит + текущий шаг. Единица работы — секунда обрабатываемого материала. } + FTotalWork: Double; + FDoneWork: Double; + FStepWork: Double; + FStepPosition: Double; + { Приёмник числа, которое печатает ffprobe при подсчёте пакетов. } + FPacketCount: Int64; + + FMaster: TMediaInfo; + { Формат промежуточных кусков: 'matroska' или 'mpegts'. } + FIntermediateFormat: string; + FIntermediateExt: string; + + function DistinctSourceCount: Integer; + procedure ChooseIntermediateFormat; + + procedure SyncProgress; + procedure SyncLog; + procedure Log(const AText: string); + procedure SetStage(const AText: string); + procedure PublishProgress; + + function CancelQuery: Boolean; + procedure ProgressLine(const ALine: string); + procedure ErrorLine(const ALine: string); + procedure PacketCountLine(const ALine: string); + + function RunFfmpeg(const AArgs: array of string; const AWhat: string): Boolean; + function CountPackets(const APath: string): Int64; + function ExtractSegments: Boolean; + function WriteConcatList(out AListPath: string): Boolean; + function ConcatAll(const AListPath: string): Boolean; + procedure Verify; + protected + procedure Execute; override; + public + { AMaster нужен, чтобы понять, влезут ли кодеки проекта в MPEG-TS. + Можно передать пустую запись — тогда способ склейки выберется + по одному лишь числу источников. } + constructor Create(const ASegments: TFlatSegmentArray; + const AOutputPath: string; AKeepIntermediate: Boolean; + const AMaster: TMediaInfo); + + procedure RequestCancel; + + { Читать из потока интерфейса только внутри обработчиков. } + property StageText: string read FStageText; + property Fraction: Double read FFraction; + property PendingLog: string read FPendingLog; + property Report: TExportReport read FReport; + + property OnProgress: TNotifyEvent read FOnProgress write FOnProgress; + property OnLog: TNotifyEvent read FOnLog write FOnLog; + end; + +{ Каталог для временных кусков рядом с готовым файлом. } +function CacheDirFor(const AOutputPath: string): string; + +implementation + +uses + Math, uFfmpegCmd, uProcRunner; + +function CacheDirFor(const AOutputPath: string): string; +begin + Result := IncludeTrailingPathDelimiter(ExtractFilePath(AOutputPath)) + + ChangeFileExt(ExtractFileName(AOutputPath), '') + '.nlve-cache' + + PathDelim; +end; + +constructor TExportThread.Create(const ASegments: TFlatSegmentArray; + const AOutputPath: string; AKeepIntermediate: Boolean; + const AMaster: TMediaInfo); +var + I: Integer; +begin + FMaster := AMaster; + inherited Create(True); + FreeOnTerminate := False; + + { Все пути приводятся к абсолютным немедленно. + + Иначе получается ловушка: путь в списке склейки с префиксом file: + разбирается относительно текущего рабочего каталога, а не относительно + самого списка. Совпало — работает, не совпало — ffmpeg не находит + куски. Проще не давать относительным путям попасть внутрь вообще. } + SetLength(FSegments, Length(ASegments)); + for I := 0 to High(ASegments) do + begin + FSegments[I] := ASegments[I]; + if FSegments[I].FilePath <> '' then + FSegments[I].FilePath := ExpandFileName(FSegments[I].FilePath); + end; + + FOutputPath := ExpandFileName(AOutputPath); + FCacheDir := CacheDirFor(FOutputPath); + FKeepIntermediate := AKeepIntermediate; + + FReport.Succeeded := False; + FReport.Cancelled := False; + FReport.OutputPath := FOutputPath; + FReport.CacheDir := FCacheDir; + FReport.TotalDuration := TotalDuration(ASegments); +end; + +procedure TExportThread.RequestCancel; +begin + FCancelRequested := True; +end; + +function TExportThread.CancelQuery: Boolean; +begin + Result := FCancelRequested or Terminated; +end; + +{ --- Передача состояния в поток интерфейса --- } + +procedure TExportThread.SyncProgress; +begin + if Assigned(FOnProgress) then + FOnProgress(Self); +end; + +procedure TExportThread.SyncLog; +begin + if Assigned(FOnLog) then + FOnLog(Self); +end; + +procedure TExportThread.Log(const AText: string); +begin + FPendingLog := AText; + Synchronize(@SyncLog); +end; + +procedure TExportThread.PublishProgress; +begin + if FTotalWork > 0 then + FFraction := Min(1, (FDoneWork + FStepPosition) / FTotalWork) + else + FFraction := 0; + Synchronize(@SyncProgress); +end; + +procedure TExportThread.SetStage(const AText: string); +begin + FStageText := AText; + PublishProgress; +end; + +{ --- Разбор вывода ffmpeg --- } + +procedure TExportThread.ProgressLine(const ALine: string); +var + Seconds: Double; + { Именно AtEnd, а не Finished: у TThread уже есть свойство с таким + именем, и локальная переменная его бы перекрыла. } + AtEnd: Boolean; +begin + Seconds := FStepPosition; + AtEnd := False; + if not ParseProgressLine(ALine, Seconds, AtEnd) then + Exit; + { Позиция не может превысить вес шага: у ffmpeg она иногда чуть + забегает вперёд из-за округления меток времени. } + FStepPosition := Min(Seconds, FStepWork); + PublishProgress; +end; + +procedure TExportThread.ErrorLine(const ALine: string); +begin + { Журнал ffmpeg при -loglevel warning короткий: сюда попадают только + настоящие предупреждения и ошибки, их стоит показать. } + Log('ffmpeg: ' + ALine); +end; + +procedure TExportThread.PacketCountLine(const ALine: string); +var + Value: Int64; +begin + { ffprobe печатает ровно одно число — количество пакетов видеопотока. } + if TryStrToInt64(Trim(ALine), Value) then + FPacketCount := Value; +end; + +{ --- Шаги --- } + +function TExportThread.RunFfmpeg(const AArgs: array of string; + const AWhat: string): Boolean; +var + Res: TProcResult; +begin + Log('> ' + CommandToString(FfmpegExe, AArgs)); + + FStepPosition := 0; + Res := RunProcess(FfmpegExe, AArgs, @ProgressLine, @ErrorLine, @CancelQuery); + + if not Res.Started then + begin + FReport.Message := Res.ErrorText; + Exit(False); + end; + if Res.Cancelled then + begin + FReport.Cancelled := True; + FReport.Message := 'Отменено.'; + Exit(False); + end; + if Res.ExitCode <> 0 then + begin + FReport.Message := AWhat + ': ffmpeg завершился с кодом ' + + IntToStr(Res.ExitCode) + '. Подробности в журнале.'; + Exit(False); + end; + + FDoneWork := FDoneWork + FStepWork; + FStepPosition := 0; + PublishProgress; + Result := True; +end; + +function TExportThread.CountPackets(const APath: string): Int64; +var + Res: TProcResult; +begin + FPacketCount := -1; + Res := RunProcess(FfprobeExe, ArgsCountVideoPackets(APath), + @PacketCountLine, nil, @CancelQuery); + if (not Res.Started) or (Res.ExitCode <> 0) then + Exit(-1); + Result := FPacketCount; +end; + +function TExportThread.DistinctSourceCount: Integer; +var + I: Integer; + Seen: TStringList; +begin + Seen := TStringList.Create; + try + Seen.Sorted := True; + Seen.Duplicates := dupIgnore; + for I := 0 to High(FSegments) do + if FSegments[I].FilePath <> '' then + Seen.Add(FSegments[I].FilePath); + Result := Seen.Count; + finally + Seen.Free; + end; +end; + +procedure TExportThread.ChooseIntermediateFormat; +var + Sources, I: Integer; + HasEncoded: Boolean; +begin + Sources := DistinctSourceCount; + + { Точный рез сам по себе создаёт кусок от другого кодировщика, даже если + исходник всего один. } + { Любой кусок, который придётся закодировать заново, — это ещё один + набор параметров кодека рядом со скопированными. } + HasEncoded := False; + for I := 0 to High(FSegments) do + if FSegments[I].PreciseIn or FSegments[I].Transcode then + HasEncoded := True; + + if (Sources <= 1) and (not HasEncoded) then + begin + { Всё из одного файла — параметры кодека заведомо одни и те же, + можно склеивать напрямую и не тратить лишний проход по материалу. } + FIntermediateFormat := 'matroska'; + FIntermediateExt := '.mkv'; + Exit; + end; + + if not TsSupportsCodecs(FMaster.VideoCodec, FMaster.AudioCodec) then + begin + FIntermediateFormat := 'matroska'; + FIntermediateExt := '.mkv'; + Log('ВНИМАНИЕ: кусков от разных кодировщиков несколько, но кодек ' + + FMaster.VideoCodec + ' не переносится в MPEG-TS. Собираю напрямую — ' + + 'на стыках возможны ошибки декодирования.'); + Exit; + end; + + FIntermediateFormat := 'mpegts'; + FIntermediateExt := '.ts'; + if HasEncoded then + Log('Есть куски, которые кодируются заново, склейка идёт через ' + + 'MPEG-TS: иначе декодер применил бы параметры первого куска ко ' + + 'всем остальным.') + else + Log('Источников несколько (' + IntToStr(Sources) + + '), склейка идёт через MPEG-TS: иначе декодер применил бы параметры ' + + 'первого куска ко всем остальным.'); +end; + +{ Первый опорный кадр строго правее указанного времени. Ноль означает, + что правее ничего нет. } +function NextKeyframeAfter(const AIndex: TKeyframeIndex; + const ATime: Double): Double; +var + I: Integer; +begin + Result := 0; + for I := 0 to High(AIndex.Times) do + if AIndex.Times[I] > ATime + 0.0005 then + Exit(AIndex.Times[I]); +end; + +function TExportThread.ExtractSegments: Boolean; +var + I, PartCount: Integer; + Index: TKeyframeIndex; + IndexError: string; + HasIndex: Boolean; + Snapped, NextKey, EncodeUntil: Double; + SegEnd: Double; + Dst: string; + Rep: TSegmentReport; + + procedure AddPart(const APart: TSegmentReport); + begin + if PartCount >= Length(FReport.Segments) then + SetLength(FReport.Segments, PartCount + 8); + FReport.Segments[PartCount] := APart; + Inc(PartCount); + end; + +begin + Result := False; + PartCount := 0; + SetLength(FReport.Segments, Length(FSegments) + 8); + + for I := 0 to High(FSegments) do + begin + if CancelQuery then + begin + FReport.Cancelled := True; + FReport.Message := 'Отменено.'; + Exit; + end; + + SetStage(Format('Вырезаю кусок %d из %d', [I + 1, Length(FSegments)])); + + { Сгенерированные вставки берутся из файла, который заведомо длиннее + нужного: так одна и та же чёрная вставка годится для дыр любой + длины. Значит вырезать надо и из них, но притягивать к опорному + кадру нечего — они начинаются с нуля, а ноль всегда опорный. } + if FSegments[I].Kind <> skVideo then + begin + Dst := FCacheDir + Format('part_%.3d_a%s', [I, FIntermediateExt]); + Rep.Index := I; + Rep.SourcePath := FSegments[I].FilePath; + Rep.RequestedStart := 0; + Rep.ActualStart := 0; + Rep.Duration := FSegments[I].Duration; + Rep.Packets := -1; + Rep.Encoded := False; + + FStepWork := FSegments[I].Duration; + if not RunFfmpeg(ArgsExtract(FSegments[I].FilePath, Dst, + 0, FSegments[I].Duration, FIntermediateFormat, + FSegments[I].Volume, FMaster.AudioCodec), + 'Подготовка вставки ' + IntToStr(I + 1)) then + Exit; + + Rep.TempPath := Dst; + AddPart(Rep); + Continue; + end; + + { Кусок от файла, не совпадающего с параметрами проекта. Скопировать + его нельзя — пересобираем. Но только его: соседние куски, снятые тем + же оборудованием, что и весь проект, по-прежнему копируются. } + if FSegments[I].Transcode then + begin + SetStage(Format('Пересобираю кусок %d из %d (файл не совпадает с проектом)', + [I + 1, Length(FSegments)])); + Dst := FCacheDir + Format('part_%.3d_a%s', [I, FIntermediateExt]); + Rep.Index := I; + Rep.SourcePath := FSegments[I].FilePath; + Rep.RequestedStart := FSegments[I].SrcStart; + Rep.ActualStart := FSegments[I].SrcStart; + Rep.Duration := FSegments[I].Duration; + Rep.Packets := -1; + Rep.Encoded := True; + + FStepWork := FSegments[I].Duration; + if not RunFfmpeg(ArgsTranscodeSegment(FSegments[I].FilePath, Dst, + FSegments[I].SrcStart, FSegments[I].SrcStart + FSegments[I].Duration, + FMaster.Width, FMaster.Height, FMaster.FpsNum, FMaster.FpsDen, + FMaster.VideoCodec, FMaster.PixFmt, FMaster.AudioCodec, + FMaster.SampleRate, FMaster.Channels, FSegments[I].Volume, + FIntermediateFormat, FSegments[I].Filter), + 'Пересборка куска ' + IntToStr(I + 1)) then + Exit; + + Rep.TempPath := Dst; + AddPart(Rep); + Continue; + end; + + HasIndex := BuildKeyframeIndex(FSegments[I].FilePath, Index, IndexError); + if not HasIndex then + Log('Кусок ' + IntToStr(I + 1) + + ': индекс опорных кадров недоступен (' + IndexError + + '), режу как есть — начало может оказаться повреждённым.'); + + SegEnd := FSegments[I].SrcStart + FSegments[I].Duration; + + Rep.Index := I; + Rep.SourcePath := FSegments[I].FilePath; + Rep.RequestedStart := FSegments[I].SrcStart; + Rep.Packets := -1; + + if FSegments[I].PreciseIn and HasIndex then + begin + { Точный рез. Копировать можно только с опорного кадра, поэтому + отрезок от запрошенной точки до следующего опорного кадра + пересобираем заново, а всё, что дальше, копируем как обычно. + Перекодируются доли секунды, а не весь материал. } + NextKey := NextKeyframeAfter(Index, FSegments[I].SrcStart); + if (NextKey <= 0) or (NextKey >= SegEnd) then + EncodeUntil := SegEnd + else + EncodeUntil := NextKey; + + Log(Format('Кусок %d: точный рез, перекодирую %s..%s (%s с), остальное копирую', + [I + 1, SecondsToStr(FSegments[I].SrcStart), SecondsToStr(EncodeUntil), + SecondsToStr(EncodeUntil - FSegments[I].SrcStart)])); + + Dst := FCacheDir + Format('part_%.3d_a%s', [I, FIntermediateExt]); + FStepWork := EncodeUntil - FSegments[I].SrcStart; + if not RunFfmpeg(ArgsEncodeFragment(FSegments[I].FilePath, Dst, + FSegments[I].SrcStart, EncodeUntil, + FMaster.FpsNum, FMaster.FpsDen, + FMaster.VideoCodec, FMaster.PixFmt, FMaster.AudioCodec, + FMaster.SampleRate, FMaster.Channels, FIntermediateFormat), + 'Перекодирование стыка куска ' + IntToStr(I + 1)) then + Exit; + + Rep.ActualStart := FSegments[I].SrcStart; + Rep.Duration := EncodeUntil - FSegments[I].SrcStart; + Rep.TempPath := Dst; + Rep.Encoded := True; + AddPart(Rep); + + if EncodeUntil < SegEnd - 0.0005 then + begin + Dst := FCacheDir + Format('part_%.3d_b%s', [I, FIntermediateExt]); + FStepWork := SegEnd - EncodeUntil; + if not RunFfmpeg(ArgsExtract(FSegments[I].FilePath, Dst, + EncodeUntil, SegEnd, FIntermediateFormat, + FSegments[I].Volume, FMaster.AudioCodec), + 'Вырезание куска ' + IntToStr(I + 1)) then + Exit; + + Rep.ActualStart := EncodeUntil; + Rep.Duration := SegEnd - EncodeUntil; + Rep.TempPath := Dst; + Rep.Encoded := False; + AddPart(Rep); + end; + + Continue; + end; + + { Обычный рез: начало притягивается к ближайшему опорному кадру, + длина сохраняется. } + Snapped := FSegments[I].SrcStart; + if HasIndex then + begin + Snapped := SnapNearest(Index, FSegments[I].SrcStart); + if Abs(Snapped - FSegments[I].SrcStart) > 0.0005 then + Log(Format('Кусок %d: начало притянуто к опорному кадру, %s вместо %s (сдвиг %s с)', + [I + 1, SecondsToStr(Snapped), SecondsToStr(FSegments[I].SrcStart), + SecondsToStr(Snapped - FSegments[I].SrcStart)])); + end; + + Dst := FCacheDir + Format('part_%.3d_a%s', [I, FIntermediateExt]); + + FStepWork := FSegments[I].Duration; + if not RunFfmpeg(ArgsExtract(FSegments[I].FilePath, Dst, + Snapped, Snapped + FSegments[I].Duration, FIntermediateFormat, + FSegments[I].Volume, FMaster.AudioCodec), + 'Вырезание куска ' + IntToStr(I + 1)) then + Exit; + + Rep.ActualStart := Snapped; + Rep.Duration := FSegments[I].Duration; + Rep.TempPath := Dst; + Rep.Encoded := False; + AddPart(Rep); + end; + + SetLength(FReport.Segments, PartCount); + Result := True; +end; + +function TExportThread.WriteConcatList(out AListPath: string): Boolean; +var + List: TStringList; + I: Integer; +begin + AListPath := FCacheDir + 'concat.txt'; + List := TStringList.Create; + try + for I := 0 to High(FReport.Segments) do + List.Add(ConcatListLine(FReport.Segments[I].TempPath)); + try + { Концы строк только LF: список читает разборщик ffmpeg, а не + текстовый редактор, и лишний возврат каретки попадёт в имя файла. } + List.LineBreak := #10; + List.SaveToFile(AListPath); + Result := True; + except + on E: Exception do + begin + FReport.Message := 'Не удалось записать список склейки: ' + E.Message; + Result := False; + end; + end; + finally + List.Free; + end; +end; + +function TExportThread.ConcatAll(const AListPath: string): Boolean; +begin + SetStage('Склеиваю'); + FStepWork := FReport.TotalDuration; + Result := RunFfmpeg(ArgsConcat(AListPath, FOutputPath), 'Склейка'); +end; + +procedure TExportThread.Verify; +var + I: Integer; + Sum, Actual, N: Int64; +begin + SetStage('Проверяю результат'); + + Sum := 0; + for I := 0 to High(FReport.Segments) do + begin + N := CountPackets(FReport.Segments[I].TempPath); + FReport.Segments[I].Packets := N; + if N > 0 then + Inc(Sum, N); + end; + + Actual := CountPackets(FOutputPath); + FReport.ExpectedPackets := Sum; + FReport.ActualPackets := Actual; +end; + +procedure TExportThread.Execute; +var + ListPath: string; + I: Integer; + ToolError: string; +begin + try + if Length(FSegments) = 0 then + begin + FReport.Message := 'Нечего экспортировать: список сегментов пуст.'; + Exit; + end; + + if not ToolsAvailable(ToolError) then + begin + FReport.Message := ToolError; + Exit; + end; + + SetStage('Готовлю'); + + if not ForceDirectories(FCacheDir) then + begin + FReport.Message := 'Не удалось создать каталог для временных кусков: ' + + FCacheDir; + Exit; + end; + Log('Временные куски: ' + FCacheDir); + + ChooseIntermediateFormat; + + { Единица учёта работы — секунда материала. Каждая секунда проходит + через вырезание и через склейку, отсюда двойной вес. } + FTotalWork := FReport.TotalDuration * 2; + FDoneWork := 0; + + if not ExtractSegments then + Exit; + if not WriteConcatList(ListPath) then + Exit; + if not ConcatAll(ListPath) then + Exit; + + Verify; + + if not FileExists(FOutputPath) then + begin + FReport.Message := 'ffmpeg отработал, но выходного файла нет: ' + FOutputPath; + Exit; + end; + + FReport.Succeeded := True; + FReport.Message := 'Готово.'; + + if not FKeepIntermediate then + begin + for I := 0 to High(FReport.Segments) do + { Удаляем только то, что сами создали в своём каталоге. Части, + указывающие на общий кэш сгенерированных вставок, трогать нельзя: + они нужны и предпросмотру, и следующей сборке. } + if Copy(FReport.Segments[I].TempPath, 1, Length(FCacheDir)) = FCacheDir then + DeleteFile(FReport.Segments[I].TempPath); + DeleteFile(ListPath); + RemoveDir(FCacheDir); + Log('Временные куски удалены.'); + end; + except + on E: Exception do + begin + FReport.Succeeded := False; + FReport.Message := 'Внутренняя ошибка: ' + E.Message; + end; + end; + + FFraction := 1; + Synchronize(@SyncProgress); +end; + +end. diff --git a/src/uFfmpegCmd.pas b/src/uFfmpegCmd.pas new file mode 100644 index 0000000..13f4357 --- /dev/null +++ b/src/uFfmpegCmd.pas @@ -0,0 +1,838 @@ +{ + uFfmpegCmd — сборка аргументов для ffmpeg и ffprobe и разбор их вывода. + + Весь знающий про ffmpeg код собран здесь, чтобы команды можно было + прочитать в одном месте и сверить с тем, что реально запускается. + + Про выбор параметров. + + -ss и -to ставятся ДО -i. Это принципиально: в таком порядке ffmpeg + перематывает по индексу файла, а не читает его насквозь, и при + копировании потока даёт точную длину. Обратный порядок на пробе давал + 574 кадра вместо 600. + + Склейка через concat-демультиплексор, но БЕЗ директив inpoint и outpoint: + на пробе они резали неточно и не пересчитывали метки времени. Каждый + кусок вырезается отдельным запуском, и только потом всё склеивается. + + Пути в списке склейки пишутся с явным префиксом file:. Без него ffmpeg + подставляет к ним протокол родительского входа и не находит файлы. + + Явный -map 0:v:0 и -map 0:a:0? обязателен: камеры вроде DJI кладут в файл + потоки телеметрии и MJPEG-обложку, и без отбора в результат попадёт мусор. + Вопросительный знак у аудио делает его необязательным — иначе файл без + звука вообще не обработается. +} +unit uFfmpegCmd; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, uAppTypes, uProcRunner; + +type + TArgs = array of string; + +{ Пути к инструментам. Ищутся один раз и запоминаются. } +function FfmpegExe: string; +function FfprobeExe: string; + +{ Забыть найденные пути. Нужно после того, как файлы доложили рядом с + программой: иначе она до перезапуска считает, что их нет. } +procedure ResetToolSearch; + +{ Проверяет, что оба инструмента на месте. } +function ToolsAvailable(out AError: string): Boolean; + +{ Вырезать кусок исходника без перекодирования. + + AStart обязан попадать на опорный кадр, иначе начало куска будет + испорчено: декодер не сможет восстановить кадры, которые ссылаются на + не попавший в вырезку опорный. Конец на опорный кадр попадать не обязан. + + AFormat — 'matroska' или 'mpegts', см. пояснение к NeedsTsIntermediate. + + AVolume — множитель громкости. При единице звук копируется как есть; + при любом другом значении его приходится пересобрать, потому что + громкость нельзя изменить, не тронув сам звук. Видео при этом + по-прежнему копируется — перекодируется только звуковая дорожка. } +function ArgsExtract(const ASrc, ADst: string; AStart, AEnd: Double; + const AFormat: string; AVolume: Double = 1; + const AAudioCodec: string = ''): TArgs; + +{ Перепаковать файл целиком в заданный формат, копируя потоки. } +function ArgsCopyTo(const ASrc, ADst, AFormat: string): TArgs; + +{ Перекодировать короткий отрезок исходника. + + Нужно для точного реза: копировать можно только начиная с опорного + кадра, поэтому огрызок от запрошенной точки до следующего опорного + кадра приходится пересобрать. Разрешение и формат пикселей берутся + как есть у исходника — их менять не надо, надо лишь заново закодировать + те же кадры. } +function ArgsEncodeFragment(const ASrc, ADst: string; AStart, AEnd: Double; + AFpsNum, AFpsDen: Integer; + const AVideoCodec, APixFmt, AAudioCodec: string; + ASampleRate, AChannels: Integer; const AFormat: string): TArgs; + +{ Пересобрать кусок в параметры проекта. + + Нужно для файлов, которые не совпали с проектом и не были приведены к + нему заранее. Перекодируется только этот кусок; соседние, снятые тем же + оборудованием, что и весь проект, по-прежнему копируются. } +function ArgsTranscodeSegment(const ASrc, ADst: string; AStart, AEnd: Double; + AWidth, AHeight, AFpsNum, AFpsDen: Integer; + const AVideoCodec, APixFmt, AAudioCodec: string; + ASampleRate, AChannels: Integer; AVolume: Double; + const AFormat: string; const AFilter: string = ''): TArgs; + +{ Кадр одиночной картинки для окна кадрирования. } +function ArgsPreviewFrame(const ASrc, ADst: string; const ATime: Double; + const AFilter: string): TArgs; + +{ Годится ли MPEG-TS для этих кодеков. + + Зачем вообще MPEG-TS. Когда в одном ролике встречаются куски от разных + кодировщиков — скопированные из камеры и созданные нами, — их наборы + параметров кодека различаются. MP4 и Matroska хранят такой набор один + на дорожку, поэтому декодер применяет параметры первого куска ко всем + остальным и на стыках сыплет ошибками. Проверено: прямая склейка дала + 384 ошибки декодера HEVC, склейка через MPEG-TS — ни одной. + + MPEG-TS повторяет параметры прямо в потоке перед каждым опорным кадром, + поэтому смена параметров посреди ролика для него обычное дело. Но + вмещает он не всякий кодек. } +function TsSupportsCodecs(const AVideoCodec, AAudioCodec: string): Boolean; + +{ Склеить куски по списку. Формат вывода ffmpeg определит по расширению. } +function ArgsConcat(const AListFile, ADst: string): TArgs; + +{ Перепаковать файл в другой контейнер без перекодирования. } +function ArgsRemux(const ASrc, ADst: string): TArgs; + +{ Сведения о файле в JSON. } +function ArgsProbeJson(const ASrc: string): TArgs; + +{ Только длительность, одним числом. Нужна для пересчёта позиции ffmpeg + в долю выполненного. } +function ArgsProbeDuration(const ASrc: string): TArgs; + +{ Число пакетов видеопотока — быстрый способ посчитать кадры без + декодирования. Читает файл целиком, но не распаковывает. } +function ArgsCountVideoPackets(const ASrc: string): TArgs; + +{ Метки времени и признаки всех видеопакетов. Запасной путь построения + индекса опорных кадров для контейнеров, кроме MP4. } +function ArgsPacketFlags(const ASrc: string): TArgs; + +{ Название кодировщика для кодека. + + Предпочитается аппаратный NVENC: на этой машине он кодирует HEVC в + несколько раз быстрее реального времени, тогда как процессорный x265 + на 2688x1512 работает медленнее реального времени. Если NVENC в сборке + ffmpeg нет, возвращается процессорный. } +function PreferredEncoder(const ACodec: string): string; + +{ Перекодировать файл в параметры проекта. + + Нужно, когда добавляемый файл с ними не совпадает: один раз потратить + время здесь выгоднее, чем перекодировать весь результат при каждой сборке. } +function ArgsNormalize(const ASrc, ADst: string; + AWidth, AHeight, AFpsNum, AFpsDen: Integer; + const AVideoCodec, APixFmt, AAudioCodec: string; + ASampleRate, AChannels: Integer; const AFilter: string = ''): TArgs; + +{ Сделать видеоклип заданной длины из картинки. } +function ArgsImageClip(const ASrc, ADst: string; ADuration: Double; + AWidth, AHeight, AFpsNum, AFpsDen: Integer; + const AVideoCodec, APixFmt, AAudioCodec: string; + ASampleRate, AChannels: Integer): TArgs; + +{ Сделать чёрный клип с тишиной заданной длины. + + Нужен для дыр на монтаже: так дыра становится обычным куском, и её не + приходится обрабатывать особым образом ни в предпросмотре, ни в сборке. } +function ArgsBlackClip(const ADst: string; ADuration: Double; + AWidth, AHeight, AFpsNum, AFpsDen: Integer; + const AVideoCodec, APixFmt, AAudioCodec: string; + ASampleRate, AChannels: Integer): TArgs; + +{ Кадр-миниатюра для списка файлов проекта. + + Кадр берётся не с нуля: у многих съёмок первые секунды это крышка + объектива, разгон экспозиции или просто чернота. Картинка вписывается + в прямоугольник целиком, с чёрными полями — обрезать её нельзя, иначе + по миниатюре не узнать кадр. } +function ArgsThumbnail(const ASrc, ADst: string; const ATime: Double; + AWidth, AHeight: Integer): TArgs; + +{ Строка списка для concat-демультиплексора, с экранированием. } +function ConcatListLine(const APath: string): string; + +{ Разбирает строку из -progress. Возвращает True, если строка узнана. + ASeconds обновляется на позиции, AFinished — на завершении. } +function ParseProgressLine(const ALine: string; var ASeconds: Double; + var AFinished: Boolean): Boolean; + +implementation + +uses + StrUtils; + +{ Общие параметры вывода в формате проекта. Объявлено заранее, потому что + используется выше по тексту, чем определено. } +function MasterOutputArgs(AWidth, AHeight, AFpsNum, AFpsDen: Integer; + const AVideoCodec, APixFmt, AAudioCodec: string; + ASampleRate, AChannels: Integer): TArgs; forward; + +{ Запрет двунаправленных кадров. Объявлено заранее по той же причине. } +function NoBFramesArgs: TArgs; forward; + +var + FFfmpeg: string = ''; + FFprobe: string = ''; + FToolsSearched: Boolean = False; + +{ Сначала рядом с программой, потом в PATH. Под Windows ставить ffmpeg + некуда, и файлы кладут рядом; положенное туда должно побеждать. } +function LocateTool(const AName: string): string; +var + Own: string; +begin + Own := ExtractFilePath(ExpandFileName(ParamStr(0))) + AName + {$IFDEF WINDOWS} + '.exe'{$ENDIF}; + if FileExists(Own) then + Exit(Own); + Result := FindTool(AName); +end; + +procedure SearchTools; +begin + if FToolsSearched then + Exit; + FToolsSearched := True; + FFfmpeg := LocateTool('ffmpeg'); + FFprobe := LocateTool('ffprobe'); +end; + +procedure ResetToolSearch; +begin + FToolsSearched := False; + FFfmpeg := ''; + FFprobe := ''; +end; + +function FfmpegExe: string; +begin + SearchTools; + Result := FFfmpeg; +end; + +function FfprobeExe: string; +begin + SearchTools; + Result := FFprobe; +end; + +function ToolsAvailable(out AError: string): Boolean; +begin + AError := ''; + SearchTools; + if FFfmpeg = '' then + AError := 'Не найден ffmpeg в PATH.'; + if FFprobe = '' then + begin + if AError <> '' then + AError := AError + LineEnding; + AError := AError + 'Не найден ffprobe в PATH.'; + end; + Result := AError = ''; +end; + +{ Общее начало любого запуска ffmpeg. + + -nostdin нужен потому, что иначе ffmpeg считает стандартный ввод своим + и может съесть то, что ему не предназначалось. + -loglevel warning оставляет предупреждения и ошибки, но убирает + многословный разбор потоков, который забивает журнал. } +function CommonFfmpegPrefix: TArgs; +begin + Result := ['-hide_banner', '-nostdin', '-loglevel', 'warning', '-y']; +end; + +{ Хвост, включающий машиночитаемый прогресс. + + -progress pipe:1 шлёт в стандартный вывод блоки вида ключ=значение, + -nostats убирает человекочитаемую строку состояния, которая иначе + дублировала бы ту же информацию в потоке ошибок. } +function ProgressArgs: TArgs; +begin + Result := ['-progress', 'pipe:1', '-nostats']; +end; + +function Concat(const A, B: TArgs): TArgs; +var + I: Integer; +begin + Result := nil; + SetLength(Result, Length(A) + Length(B)); + for I := 0 to High(A) do + Result[I] := A[I]; + for I := 0 to High(B) do + Result[Length(A) + I] := B[I]; +end; + +{ Нужен ли контейнеру перенос заголовка в начало файла. + + Для MP4 это делает файл пригодным для воспроизведения по мере загрузки. + Стоит один дополнительный проход по готовому файлу, но он быстрый. } +function WantsFaststart(const APath: string): Boolean; +var + Ext: string; +begin + Ext := LowerCase(ExtractFileExt(APath)); + Result := (Ext = '.mp4') or (Ext = '.mov') or (Ext = '.m4v'); +end; + +function ArgsExtract(const ASrc, ADst: string; AStart, AEnd: Double; + const AFormat: string; AVolume: Double; const AAudioCodec: string): TArgs; +begin + Result := Concat(CommonFfmpegPrefix, [ + '-ss', SecondsToStr(AStart), + '-to', SecondsToStr(AEnd), + '-i', ASrc, + '-map', '0:v:0', + '-map', '0:a:0?' + ]); + + if Abs(AVolume - 1) < 0.001 then + Result := Concat(Result, ['-c', 'copy']) + else + begin + { Видео копируется, звук пересобирается с новой громкостью. Так + обходится дороже, чем чистое копирование, но несопоставимо дешевле + перекодирования картинки. } + Result := Concat(Result, ['-c:v', 'copy', + '-af', 'volume=' + SecondsToStr(AVolume)]); + if AAudioCodec <> '' then + Result := Concat(Result, ['-c:a', AAudioCodec]) + else + Result := Concat(Result, ['-c:a', 'aac']); + end; + + { Метки времени вырезанного куска должны начинаться с нуля, иначе + при склейке куски разъедутся по времени. } + Result := Concat(Result, ['-avoid_negative_ts', 'make_zero']); + Result := Concat(Result, ProgressArgs); + Result := Concat(Result, ['-f', AFormat, ADst]); +end; + +function ArgsCopyTo(const ASrc, ADst, AFormat: string): TArgs; +begin + Result := Concat(CommonFfmpegPrefix, [ + '-i', ASrc, + '-map', '0:v:0', + '-map', '0:a:0?', + '-c', 'copy' + ]); + Result := Concat(Result, ProgressArgs); + Result := Concat(Result, ['-f', AFormat, ADst]); +end; + +function ArgsEncodeFragment(const ASrc, ADst: string; AStart, AEnd: Double; + AFpsNum, AFpsDen: Integer; + const AVideoCodec, APixFmt, AAudioCodec: string; + ASampleRate, AChannels: Integer; const AFormat: string): TArgs; +var + HalfFrame, StopAt: Double; +begin + { Тонкость, стоившая одного лишнего кадра на стыке. + + При копировании потока -to работает как «строго меньше»: кадр ровно + на границе не попадает. При перекодировании — как «меньше либо равно», + и кадр на границе попадает. А граница у нас — это опорный кадр, с + которого начинается следующая, скопированная часть. В итоге он + оказывался в ролике дважды: замерено 43 + 258 = 301 кадр там, где + эталонное перекодирование всего отрезка даёт 300. + + Поэтому отступаем от границы на полкадра. Полкадра, а не миллисекунду, + чтобы отступ был осмысленным при любой частоте. } + HalfFrame := 0.001; + if (AFpsNum > 0) and (AFpsDen > 0) then + HalfFrame := AFpsDen / AFpsNum / 2; + StopAt := AEnd - HalfFrame; + if StopAt <= AStart then + StopAt := AEnd; + + { -ss до -i при перекодировании тоже работает точно: ffmpeg доходит до + предыдущего опорного кадра, декодирует и выбрасывает лишнее. } + Result := Concat(CommonFfmpegPrefix, [ + '-ss', SecondsToStr(AStart), + '-to', SecondsToStr(StopAt), + '-i', ASrc, + '-map', '0:v:0', + '-map', '0:a:0?' + ]); + { Ни размер, ни частота кадров намеренно не задаются. Отрезок берётся + из того же файла, что и соседние куски, так что менять ему нечего. + Хуже того: принудительная частота включает пересчёт кадров, и на + пробе это добавило один лишний кадр на стыке — 601 вместо 600. } + Result := Concat(Result, MasterOutputArgs(0, 0, 0, 0, + AVideoCodec, APixFmt, AAudioCodec, ASampleRate, AChannels)); + Result := Concat(Result, NoBFramesArgs); + Result := Concat(Result, ['-avoid_negative_ts', 'make_zero']); + Result := Concat(Result, ProgressArgs); + Result := Concat(Result, ['-f', AFormat, ADst]); +end; + +function ArgsTranscodeSegment(const ASrc, ADst: string; AStart, AEnd: Double; + AWidth, AHeight, AFpsNum, AFpsDen: Integer; + const AVideoCodec, APixFmt, AAudioCodec: string; + ASampleRate, AChannels: Integer; AVolume: Double; + const AFormat: string; const AFilter: string): TArgs; +begin + Result := Concat(CommonFfmpegPrefix, [ + '-ss', SecondsToStr(AStart), + '-to', SecondsToStr(AEnd), + '-i', ASrc, + '-map', '0:v:0', + '-map', '0:a:0?' + ]); + + { Как именно кадр ложится в кадр проекта, решено заранее и передано + готовой цепочкой фильтров. } + if AFilter <> '' then + Result := Concat(Result, ['-vf', AFilter]) + else + Result := Concat(Result, ['-vf', Format( + 'scale=%d:%d:force_original_aspect_ratio=decrease,pad=%d:%d:(ow-iw)/2:(oh-ih)/2,setsar=1', + [AWidth, AHeight, AWidth, AHeight])]); + + if Abs(AVolume - 1) >= 0.001 then + Result := Concat(Result, ['-af', 'volume=' + SecondsToStr(AVolume)]); + + Result := Concat(Result, MasterOutputArgs(0, 0, AFpsNum, AFpsDen, + AVideoCodec, APixFmt, AAudioCodec, ASampleRate, AChannels)); + Result := Concat(Result, NoBFramesArgs); + Result := Concat(Result, ['-avoid_negative_ts', 'make_zero']); + Result := Concat(Result, ProgressArgs); + Result := Concat(Result, ['-f', AFormat, ADst]); +end; + +function TsSupportsCodecs(const AVideoCodec, AAudioCodec: string): Boolean; +begin + { Список намеренно короткий: сюда попали только те кодеки, для которых + перенос в MPEG-TS заведомо работает. Всё остальное лучше собрать + привычным способом и предупредить, чем молча выдать битый файл. } + Result := (AVideoCodec = 'h264') or (AVideoCodec = 'hevc') or + (AVideoCodec = 'mpeg2video') or (AVideoCodec = 'mpeg4'); + if not Result then + Exit; + if AAudioCodec = '' then + Exit(True); + Result := (AAudioCodec = 'aac') or (AAudioCodec = 'mp3') or + (AAudioCodec = 'ac3') or (AAudioCodec = 'mp2'); +end; + +function ArgsConcat(const AListFile, ADst: string): TArgs; +begin + Result := Concat(CommonFfmpegPrefix, [ + '-f', 'concat', + { Без -safe 0 демультиплексор откажется брать абсолютные пути. } + '-safe', '0', + '-i', AListFile, + '-map', '0:v:0', + '-map', '0:a:0?', + '-c', 'copy' + ]); + Result := Concat(Result, ProgressArgs); + if WantsFaststart(ADst) then + Result := Concat(Result, ['-movflags', '+faststart']); + Result := Concat(Result, [ADst]); +end; + +function ArgsRemux(const ASrc, ADst: string): TArgs; +begin + Result := Concat(CommonFfmpegPrefix, [ + '-i', ASrc, + { Здесь берём всё, что есть: задача ремукса — сменить контейнер, а не + отбирать содержимое. -ignore_unknown отбрасывает потоки, которые + целевой контейнер не умеет, вместо того чтобы падать с ошибкой. } + '-map', '0', + '-ignore_unknown', + '-c', 'copy' + ]); + Result := Concat(Result, ProgressArgs); + if WantsFaststart(ADst) then + Result := Concat(Result, ['-movflags', '+faststart']); + Result := Concat(Result, [ADst]); +end; + +function ArgsProbeJson(const ASrc: string): TArgs; +begin + Result := ['-v', 'error', '-print_format', 'json', + '-show_format', '-show_streams', ASrc]; +end; + +function ArgsProbeDuration(const ASrc: string): TArgs; +begin + Result := ['-v', 'error', '-show_entries', 'format=duration', + '-of', 'csv=p=0', ASrc]; +end; + +function ArgsCountVideoPackets(const ASrc: string): TArgs; +begin + Result := ['-v', 'error', '-select_streams', 'v:0', '-count_packets', + '-show_entries', 'stream=nb_read_packets', '-of', 'csv=p=0', ASrc]; +end; + +function ArgsPacketFlags(const ASrc: string): TArgs; +begin + Result := ['-v', 'error', '-select_streams', 'v:0', + '-show_entries', 'packet=pts_time,flags', '-of', 'csv=p=0', ASrc]; +end; + +{ --- Выбор кодировщика --- } + +type + TEncoderCollector = class + private + FNames: TStringList; + public + constructor Create; + destructor Destroy; override; + procedure Line(const ALine: string); + property Names: TStringList read FNames; + end; + +constructor TEncoderCollector.Create; +begin + inherited Create; + FNames := TStringList.Create; + FNames.Sorted := True; + FNames.Duplicates := dupIgnore; +end; + +destructor TEncoderCollector.Destroy; +begin + FNames.Free; + inherited Destroy; +end; + +procedure TEncoderCollector.Line(const ALine: string); +var + S: string; + P: Integer; +begin + { Строки списка кодировщиков выглядят так: + V....D hevc_nvenc NVIDIA NVENC hevc encoder + Первое поле — флаги, второе — название. } + S := Trim(ALine); + P := Pos(' ', S); + if P <= 0 then + Exit; + S := Trim(Copy(S, P + 1, Length(S) - P)); + P := Pos(' ', S); + if P > 0 then + S := Copy(S, 1, P - 1); + if S <> '' then + FNames.Add(S); +end; + +var + FEncoders: TStringList = nil; + +{ Список кодировщиков спрашивается у ffmpeg один раз за запуск: он не + меняется, а вызов процесса не бесплатный. } +procedure EnsureEncoderList; +var + Collector: TEncoderCollector; +begin + if FEncoders <> nil then + Exit; + FEncoders := TStringList.Create; + FEncoders.Sorted := True; + FEncoders.Duplicates := dupIgnore; + + if FfmpegExe = '' then + Exit; + + Collector := TEncoderCollector.Create; + try + RunProcess(FfmpegExe, ['-hide_banner', '-encoders'], @Collector.Line, nil, nil); + FEncoders.AddStrings(Collector.Names); + finally + Collector.Free; + end; +end; + +function HasEncoder(const AName: string): Boolean; +var + Dummy: Integer; +begin + EnsureEncoderList; + Result := FEncoders.Find(AName, Dummy); +end; + +function PreferredEncoder(const ACodec: string): string; +begin + if ACodec = 'hevc' then + begin + if HasEncoder('hevc_nvenc') then + Exit('hevc_nvenc'); + Exit('libx265'); + end; + + if (ACodec = 'h264') or (ACodec = 'avc1') then + begin + if HasEncoder('h264_nvenc') then + Exit('h264_nvenc'); + Exit('libx264'); + end; + + if ACodec = 'av1' then + begin + if HasEncoder('av1_nvenc') then + Exit('av1_nvenc'); + if HasEncoder('libsvtav1') then + Exit('libsvtav1'); + Exit('libaom-av1'); + end; + + { Незнакомый кодек — пусть ffmpeg сам подберёт кодировщик по названию. } + Result := ACodec; +end; + +{ Запрет двунаправленных кадров. + + B-кадры хранят разницу и с предыдущим, и со следующим кадром, поэтому + порядок декодирования отличается от порядка показа. Для длинного видео + это экономит место, а для наших коротких вставок экономия ничтожна, зато + переупорядочивание создаёт настоящую проблему: замерено, что метки + декодирования перекодированного огрызка после переноса в Matroska идут + назад (5.101 -> 5.068 -> 5.051), давая двадцать совпадающих меток на + шестьсот кадров. + + Без B-кадров порядок декодирования совпадает с порядком показа, и вопрос + снимается целиком. } +function NoBFramesArgs: TArgs; +begin + Result := ['-bf', '0']; +end; + +{ Реализация объявленной выше функции. } +function MasterOutputArgs(AWidth, AHeight, AFpsNum, AFpsDen: Integer; + const AVideoCodec, APixFmt, AAudioCodec: string; + ASampleRate, AChannels: Integer): TArgs; +var + Fps: string; +begin + Fps := ''; + if (AFpsNum > 0) and (AFpsDen > 0) then + Fps := IntToStr(AFpsNum) + '/' + IntToStr(AFpsDen); + + Result := ['-c:v', PreferredEncoder(AVideoCodec)]; + + if (AWidth > 0) and (AHeight > 0) then + Result := Concat(Result, ['-s', IntToStr(AWidth) + 'x' + IntToStr(AHeight)]); + if Fps <> '' then + Result := Concat(Result, ['-r', Fps]); + if APixFmt <> '' then + Result := Concat(Result, ['-pix_fmt', APixFmt]); + + if AAudioCodec <> '' then + begin + Result := Concat(Result, ['-c:a', AAudioCodec]); + if ASampleRate > 0 then + Result := Concat(Result, ['-ar', IntToStr(ASampleRate)]); + if AChannels > 0 then + Result := Concat(Result, ['-ac', IntToStr(AChannels)]); + end; +end; + +function ArgsNormalize(const ASrc, ADst: string; + AWidth, AHeight, AFpsNum, AFpsDen: Integer; + const AVideoCodec, APixFmt, AAudioCodec: string; + ASampleRate, AChannels: Integer; const AFilter: string): TArgs; +begin + Result := Concat(CommonFfmpegPrefix, ['-i', ASrc, '-map', '0:v:0']); + if AAudioCodec <> '' then + Result := Concat(Result, ['-map', '0:a:0?']); + { Размер задаётся цепочкой фильтров, а не ключом -s: тот растягивает + кадр, не считаясь с соотношением сторон. } + if AFilter <> '' then + Result := Concat(Result, ['-vf', AFilter]); + Result := Concat(Result, MasterOutputArgs(0, 0, AFpsNum, AFpsDen, + AVideoCodec, APixFmt, AAudioCodec, ASampleRate, AChannels)); + Result := Concat(Result, ProgressArgs); + Result := Concat(Result, [ADst]); +end; + +function ArgsImageClip(const ASrc, ADst: string; ADuration: Double; + AWidth, AHeight, AFpsNum, AFpsDen: Integer; + const AVideoCodec, APixFmt, AAudioCodec: string; + ASampleRate, AChannels: Integer): TArgs; +begin + { -loop 1 повторяет единственный кадр, -t задаёт длину. + Картинка вписывается в кадр целиком с чёрными полями по краям: + обрезать её без спроса неправильно, растягивать — тем более. } + Result := Concat(CommonFfmpegPrefix, [ + '-loop', '1', + '-i', ASrc, + '-t', SecondsToStr(ADuration) + ]); + + if AAudioCodec <> '' then + { Клипу нужна звуковая дорожка, иначе при склейке с обычным видео + звук поедет: у одних кусков он есть, у других нет. } + Result := Concat(Result, ['-f', 'lavfi', '-i', + Format('anullsrc=channel_layout=%s:sample_rate=%d', + [IfThen(AChannels = 1, 'mono', 'stereo'), ASampleRate])]); + + Result := Concat(Result, ['-vf', + Format('scale=%d:%d:force_original_aspect_ratio=decrease,pad=%d:%d:(ow-iw)/2:(oh-ih)/2,setsar=1', + [AWidth, AHeight, AWidth, AHeight])]); + + Result := Concat(Result, MasterOutputArgs(0, 0, AFpsNum, AFpsDen, + AVideoCodec, APixFmt, AAudioCodec, ASampleRate, AChannels)); + Result := Concat(Result, NoBFramesArgs); + Result := Concat(Result, ['-shortest']); + Result := Concat(Result, ProgressArgs); + Result := Concat(Result, [ADst]); +end; + +function ArgsBlackClip(const ADst: string; ADuration: Double; + AWidth, AHeight, AFpsNum, AFpsDen: Integer; + const AVideoCodec, APixFmt, AAudioCodec: string; + ASampleRate, AChannels: Integer): TArgs; +var + Fps: string; +begin + Fps := '25'; + if (AFpsNum > 0) and (AFpsDen > 0) then + Fps := IntToStr(AFpsNum) + '/' + IntToStr(AFpsDen); + + Result := Concat(CommonFfmpegPrefix, [ + '-f', 'lavfi', + '-i', Format('color=c=black:s=%dx%d:r=%s:d=%s', + [AWidth, AHeight, Fps, SecondsToStr(ADuration)]) + ]); + + if AAudioCodec <> '' then + Result := Concat(Result, ['-f', 'lavfi', '-i', + Format('anullsrc=channel_layout=%s:sample_rate=%d', + [IfThen(AChannels = 1, 'mono', 'stereo'), ASampleRate])]); + + Result := Concat(Result, MasterOutputArgs(0, 0, AFpsNum, AFpsDen, + AVideoCodec, APixFmt, AAudioCodec, ASampleRate, AChannels)); + Result := Concat(Result, NoBFramesArgs); + Result := Concat(Result, ['-t', SecondsToStr(ADuration)]); + Result := Concat(Result, ProgressArgs); + Result := Concat(Result, [ADst]); +end; + +function ArgsThumbnail(const ASrc, ADst: string; const ATime: Double; + AWidth, AHeight: Integer): TArgs; +begin + Result := Concat(CommonFfmpegPrefix, []); + if ATime > 0 then + { -ss до -i, чтобы не читать файл до нужного места насквозь: на + шестигигабайтном файле это разница между мгновением и минутой. } + Result := Concat(Result, ['-ss', SecondsToStr(ATime)]); + Result := Concat(Result, [ + '-i', ASrc, + '-map', '0:v:0', + '-frames:v', '1', + '-vf', Format( + 'scale=%d:%d:force_original_aspect_ratio=decrease,pad=%d:%d:(ow-iw)/2:(oh-ih)/2', + [AWidth, AHeight, AWidth, AHeight]), + '-f', 'image2', + ADst + ]); +end; + +function ArgsPreviewFrame(const ASrc, ADst: string; const ATime: Double; + const AFilter: string): TArgs; +begin + Result := Concat(CommonFfmpegPrefix, []); + if ATime > 0 then + Result := Concat(Result, ['-ss', SecondsToStr(ATime)]); + Result := Concat(Result, ['-i', ASrc, '-map', '0:v:0', '-frames:v', '1']); + if AFilter <> '' then + Result := Concat(Result, ['-vf', AFilter]); + Result := Concat(Result, ['-f', 'image2', ADst]); +end; + +function ConcatListLine(const APath: string): string; +var + Escaped: string; +begin + { Апостроф внутри пути закрывает строку, поэтому его заменяют + последовательностью «закрыть строку, экранированный апостроф, + открыть строку». Это правило самого concat-демультиплексора. } + Escaped := StringReplace(APath, '''', '''\''''', [rfReplaceAll]); + { Префикс file: обязателен: иначе при чтении списка не из файла ffmpeg + подставит протокол родительского входа и путь не найдётся. } + Result := 'file ''file:' + Escaped + ''''; +end; + +{ Строка вида 00:01:23.456789 в секунды. } +function TimecodeToSeconds(const AValue: string; out ASeconds: Double): Boolean; +var + Parts: TStringArray; + H, M: Integer; + S: Double; +begin + Result := False; + ASeconds := 0; + Parts := AValue.Split([':']); + if Length(Parts) <> 3 then + Exit; + if not TryStrToInt(Parts[0], H) then + Exit; + if not TryStrToInt(Parts[1], M) then + Exit; + if not TryStrToFloat(Parts[2], S, InvariantFormat) then + Exit; + ASeconds := H * 3600 + M * 60 + S; + Result := True; +end; + +function ParseProgressLine(const ALine: string; var ASeconds: Double; + var AFinished: Boolean): Boolean; +var + P: Integer; + Key, Value: string; + Micro: Int64; +begin + Result := False; + P := Pos('=', ALine); + if P <= 1 then + Exit; + Key := Copy(ALine, 1, P - 1); + Value := Copy(ALine, P + 1, Length(ALine) - P); + + if Key = 'out_time_us' then + begin + { Значение бывает N/A, пока первый кадр не обработан. } + if TryStrToInt64(Value, Micro) and (Micro >= 0) then + begin + ASeconds := Micro / 1000000; + Result := True; + end; + end + else if Key = 'out_time' then + begin + if TimecodeToSeconds(Value, ASeconds) then + Result := True; + end + else if Key = 'progress' then + begin + AFinished := Value = 'end'; + Result := True; + end; +end; + +end. diff --git a/src/uFfmpegJob.pas b/src/uFfmpegJob.pas new file mode 100644 index 0000000..3dd1748 --- /dev/null +++ b/src/uFfmpegJob.pas @@ -0,0 +1,183 @@ +{ + uFfmpegJob — один запуск ffmpeg в рабочем потоке, с прогрессом и отменой. + + Нужен для одиночных задач: привести файл к параметрам проекта, сделать + клип из картинки, сделать чёрную заставку. Сборка ролика устроена сложнее + (цепочка запусков со сверкой) и живёт отдельно, в uExport. +} +unit uFfmpegJob; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils; + +type + TFfmpegJob = class(TThread) + private + FArgs: array of string; + FTitle: string; + FTotalSeconds: Double; + FCancelRequested: Boolean; + FFraction: Double; + FPendingLog: string; + FSucceeded: Boolean; + FCancelled: Boolean; + FMessage: string; + FOutputPath: string; + FOnProgress: TNotifyEvent; + FOnLog: TNotifyEvent; + + procedure SyncProgress; + procedure SyncLog; + procedure Log(const AText: string); + function CancelQuery: Boolean; + procedure ProgressLine(const ALine: string); + procedure ErrorLine(const ALine: string); + protected + procedure Execute; override; + public + { ATotalSeconds нужен только для прогресса: ffmpeg сообщает, сколько + материала обработано, а сколько всего — знает лишь вызывающий. + AOutputPath проверяется по завершении: ffmpeg умеет вернуть нулевой + код и при этом не создать файл. } + constructor Create(const AArgs: array of string; ATotalSeconds: Double; + const ATitle, AOutputPath: string); + procedure RequestCancel; + + property Title: string read FTitle; + property Fraction: Double read FFraction; + property PendingLog: string read FPendingLog; + property Succeeded: Boolean read FSucceeded; + property Cancelled: Boolean read FCancelled; + property Message: string read FMessage; + + property OnProgress: TNotifyEvent read FOnProgress write FOnProgress; + property OnLog: TNotifyEvent read FOnLog write FOnLog; + end; + +implementation + +uses + Math, uFfmpegCmd, uProcRunner; + +constructor TFfmpegJob.Create(const AArgs: array of string; ATotalSeconds: Double; + const ATitle, AOutputPath: string); +var + I: Integer; +begin + inherited Create(True); + FreeOnTerminate := False; + SetLength(FArgs, Length(AArgs)); + for I := 0 to High(AArgs) do + FArgs[I] := AArgs[I]; + FTotalSeconds := ATotalSeconds; + FTitle := ATitle; + FOutputPath := AOutputPath; +end; + +procedure TFfmpegJob.RequestCancel; +begin + FCancelRequested := True; +end; + +function TFfmpegJob.CancelQuery: Boolean; +begin + Result := FCancelRequested or Terminated; +end; + +procedure TFfmpegJob.SyncProgress; +begin + if Assigned(FOnProgress) then + FOnProgress(Self); +end; + +procedure TFfmpegJob.SyncLog; +begin + if Assigned(FOnLog) then + FOnLog(Self); +end; + +procedure TFfmpegJob.Log(const AText: string); +begin + FPendingLog := AText; + Synchronize(@SyncLog); +end; + +procedure TFfmpegJob.ProgressLine(const ALine: string); +var + Seconds: Double; + AtEnd: Boolean; +begin + Seconds := 0; + AtEnd := False; + if not ParseProgressLine(ALine, Seconds, AtEnd) then + Exit; + if FTotalSeconds > 0 then + begin + FFraction := Min(1, Seconds / FTotalSeconds); + Synchronize(@SyncProgress); + end; +end; + +procedure TFfmpegJob.ErrorLine(const ALine: string); +begin + Log('ffmpeg: ' + ALine); +end; + +procedure TFfmpegJob.Execute; +var + Res: TProcResult; + ToolError: string; +begin + try + if not ToolsAvailable(ToolError) then + begin + FMessage := ToolError; + Exit; + end; + + Log('> ' + CommandToString(FfmpegExe, FArgs)); + Res := RunProcess(FfmpegExe, FArgs, @ProgressLine, @ErrorLine, @CancelQuery); + + if not Res.Started then + begin + FMessage := Res.ErrorText; + Exit; + end; + if Res.Cancelled then + begin + FCancelled := True; + FMessage := 'Отменено.'; + { Недоделанный файл оставлять нельзя: он выглядит готовым, но + содержит только начало. } + if (FOutputPath <> '') and FileExists(FOutputPath) then + DeleteFile(FOutputPath); + Exit; + end; + if Res.ExitCode <> 0 then + begin + FMessage := 'ffmpeg завершился с кодом ' + IntToStr(Res.ExitCode) + + '. Подробности в журнале.'; + Exit; + end; + if (FOutputPath <> '') and (not FileExists(FOutputPath)) then + begin + FMessage := 'ffmpeg отработал, но файла нет: ' + FOutputPath; + Exit; + end; + + FSucceeded := True; + FMessage := 'Готово.'; + except + on E: Exception do + FMessage := 'Внутренняя ошибка: ' + E.Message; + end; + + FFraction := 1; + Synchronize(@SyncProgress); +end; + +end. diff --git a/src/uFlatten.pas b/src/uFlatten.pas new file mode 100644 index 0000000..8dfcbb2 --- /dev/null +++ b/src/uFlatten.pas @@ -0,0 +1,422 @@ +{ + uFlatten — превращение монтажа в плоский список кусков. + + Композитинга нет: когда клипы перекрываются во времени, побеждает тот, + что на дорожке выше, и побеждает целиком. Поэтому итог всегда + представим как последовательность непересекающихся отрезков, у каждого + из которых ровно один источник. Именно это и делает возможной сборку + копированием потоков. + + Алгоритм: + + 1. Собрать все границы всех клипов со всех дорожек. Внутри промежутка + между двумя соседними границами набор перекрывающихся клипов не + меняется — значит и победитель не меняется. + 2. Для каждого промежутка найти клип на самой верхней дорожке. + 3. Промежуток, не покрытый ничем, становится чёрным куском: дыра на + монтаже — часть замысла, а не ошибка. + 4. Склеить соседние куски, если они идут подряд в одном источнике. + Без этого рез оставался бы там, где его нет, и сборка резала бы файл + на лишние части. + + Случай «верхний клип разрывает нижний надвое» обрабатывается сам собой: + нижний просто выигрывает в двух разных промежутках. + + Картинки и чёрные куски не берутся из исходников — под них заранее + создаются небольшие клипы в параметрах проекта. Так и предпросмотр, и + сборка работают с ними как с обычным видео. Проверено, что подсовывать + mpv картинку или генератор прямо в списке кусков нельзя: он на этом + зависает. +} +unit uFlatten; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, uAppTypes, uProject, uMediaProbe, uTransform; + +type + { Что нужно создать, чтобы кусок стал воспроизводимым файлом. } + TGenKind = (gkNone, gkBlack, gkImage); + + TGenRequest = record + Kind: TGenKind; + SourcePath: string; + Duration: Double; + TargetPath: string; + end; + + TGenRequests = array of TGenRequest; + +{ Раскладывает монтаж в последовательность кусков. + + У кусков, требующих генерации, FilePath указывает на будущий файл в кэше; + сам файл может ещё не существовать. Список того, что надо создать, + возвращается в AMissing. } +function FlattenProject(AProject: TProject; out ASegments: TFlatSegmentArray; + out AMissing: TGenRequests): Boolean; + +{ Путь к сгенерированному клипу. Имя выводится из содержимого запроса, + поэтому одинаковые запросы дают один и тот же файл, и он делается + один раз. } +function GeneratedPath(const ACacheDir: string; const AReq: TGenRequest): string; + +{ Заготовка чёрной вставки самой ходовой длины. + + Делается заранее, сразу после того как стали известны параметры проекта. + Иначе первая же дыра на монтаже ждала бы генерации, и в это время + предпросмотр играл бы прежнюю расстановку — выглядело бы так, будто + удаление клипа или выключение дорожки не действуют. } +function PrewarmRequests(const ACacheDir: string): TGenRequests; + +implementation + +uses + Math, md5; + +const + { Длительность округляется до миллисекунд: иначе крошечное расхождение + в дробной части плодило бы почти одинаковые файлы. } + DurationQuantum = 0.001; + + { Готовые длины вставок. + + Раньше под каждую дыру делался отдельный чёрный клип ровно её длины. + Из-за этого любое движение клипа меняло длину дыры, требовало новой + вставки, и до её готовности предпросмотр играл прежнюю расстановку — + выглядело так, будто выключение дорожки или удаление клипа не + действуют. + + Теперь вставка берётся из готового файла подходящей длины, а нужный + кусок из неё просто вырезается. Файлов получается несколько штук на + проект, и делаются они один раз. } + LengthBuckets: array[0..5] of Double = (15, 60, 300, 1800, 7200, 28800); + +function QuantizeDuration(const AValue: Double): Double; +begin + Result := Round(AValue / DurationQuantum) * DurationQuantum; +end; + +{ Наименьшая из готовых длин, вмещающая запрошенную. } +function BucketFor(const ADuration: Double): Double; +var + I: Integer; +begin + for I := 0 to High(LengthBuckets) do + if LengthBuckets[I] >= ADuration - 0.0005 then + Exit(LengthBuckets[I]); + Result := LengthBuckets[High(LengthBuckets)]; +end; + +function GeneratedPath(const ACacheDir: string; const AReq: TGenRequest): string; +var + Key, Name: string; + Ms: Int64; +begin + Ms := Round(QuantizeDuration(AReq.Duration) * 1000); + case AReq.Kind of + gkBlack: + Name := Format('black_%d.mkv', [Ms]); + gkImage: + begin + Key := AReq.SourcePath + '|' + IntToStr(Ms); + Name := Format('img_%s_%d.mkv', [Copy(MD5Print(MD5String(Key)), 1, 12), Ms]); + end; + else + Name := ''; + end; + + if Name = '' then + Result := '' + else + Result := IncludeTrailingPathDelimiter(ACacheDir) + 'gen' + PathDelim + Name; +end; + +function PrewarmRequests(const ACacheDir: string): TGenRequests; +var + Req: TGenRequest; +begin + Result := nil; + Req.Kind := gkBlack; + Req.SourcePath := ''; + Req.Duration := LengthBuckets[0]; + Req.TargetPath := GeneratedPath(ACacheDir, Req); + if FileExists(Req.TargetPath) then + Exit; + SetLength(Result, 1); + Result[0] := Req; +end; + +{ Добавляет время в отсортированный список без повторов. } +procedure AddBoundary(var A: array of Double; var ACount: Integer; + const AValue: Double); +begin + if ACount >= Length(A) then + Exit; + A[ACount] := AValue; + Inc(ACount); +end; + +function CompareDoubles(const A, B: Double): Integer; +begin + if A < B then + Result := -1 + else if A > B then + Result := 1 + else + Result := 0; +end; + +procedure SortDoubles(var A: array of Double; ACount: Integer); +var + I, J: Integer; + Tmp: Double; +begin + { Границ немного (по две на клип), поэтому простая сортировка вставками + здесь и быстрее по факту, и понятнее. } + for I := 1 to ACount - 1 do + begin + Tmp := A[I]; + J := I - 1; + while (J >= 0) and (A[J] > Tmp) do + begin + A[J + 1] := A[J]; + Dec(J); + end; + A[J + 1] := Tmp; + end; +end; + +function FlattenProject(AProject: TProject; out ASegments: TFlatSegmentArray; + out AMissing: TGenRequests): Boolean; +var + Bounds: array of Double; + BoundCount: Integer; + T, C, I, N: Integer; + Track: TTrack; + Winner: TClip; + Mid, SegStart, SegEnd, MaxLen: Double; + Item: TMediaItem; + Seg: TFlatSegment; + Raw: TFlatSegmentArray; + RawCount: Integer; + Req: TGenRequest; + Path: string; + Seen: TStringList; + + { Клип, побеждающий в указанный момент: с самой верхней дорожки. } + function WinnerAt(const ATime: Double): TClip; + var + Ti: Integer; + Cl: TClip; + begin + Result := nil; + for Ti := 0 to AProject.TrackCount - 1 do + begin + { Выключенные дорожки пропускаются, а если где-то включено «соло» — + то и все несолирующие. } + if not AProject.TrackAudible(AProject.Tracks[Ti]) then + Continue; + Cl := AProject.Tracks[Ti].ClipAt(ATime); + if Cl <> nil then + Exit(Cl); + end; + end; + +begin + ASegments := nil; + AMissing := nil; + Result := False; + if AProject = nil then + Exit; + + { --- Границы --- } + N := 0; + for T := 0 to AProject.TrackCount - 1 do + Inc(N, AProject.Tracks[T].Count * 2); + SetLength(Bounds, N + 2); + BoundCount := 0; + + AddBoundary(Bounds, BoundCount, 0); + for T := 0 to AProject.TrackCount - 1 do + begin + Track := AProject.Tracks[T]; + if not AProject.TrackAudible(Track) then + Continue; + for C := 0 to Track.Count - 1 do + begin + AddBoundary(Bounds, BoundCount, Track[C].TlStart); + AddBoundary(Bounds, BoundCount, Track[C].TlEnd); + end; + end; + + if BoundCount < 2 then + Exit; + + SortDoubles(Bounds, BoundCount); + + { --- Промежутки --- } + SetLength(Raw, BoundCount); + RawCount := 0; + + for I := 0 to BoundCount - 2 do + begin + SegStart := Bounds[I]; + SegEnd := Bounds[I + 1]; + { Совпавшие границы дают промежуток нулевой длины — пропускаем. } + if SegEnd - SegStart < 0.0005 then + Continue; + + { Внутри промежутка победитель не меняется, поэтому достаточно + проверить одну точку. Берём середину: на краях клип может как + начинаться, так и заканчиваться. } + Mid := (SegStart + SegEnd) / 2; + Winner := WinnerAt(Mid); + + { Запись переиспользуется в цикле, поэтому обнуляем её целиком. + Иначе поля вроде громкости достаются от предыдущего куска: чёрная + вставка получала чужой множитель, и звук в ней глушился или нет + в зависимости от того, что было перед ней. } + Seg := Default(TFlatSegment); + Seg.Volume := 1; + Seg.Duration := SegEnd - SegStart; + + if Winner = nil then + begin + { Дыра. Показываем чёрное с тишиной. } + Seg.Kind := skBlack; + Seg.SrcStart := 0; + Seg.GenSource := ''; + Seg.PreciseIn := False; + Req.Kind := gkBlack; + Req.SourcePath := ''; + { Файл делается длиннее нужного, а из него берётся ровно столько, + сколько надо. } + Req.Duration := BucketFor(Seg.Duration); + Seg.FilePath := GeneratedPath(AProject.CacheDir, Req); + end + else if Winner.Kind = ckImage then + begin + Item := AProject.FindMedia(Winner.MediaId); + if Item = nil then + Continue; + Seg.Kind := skImage; + Seg.SrcStart := 0; + Seg.GenSource := Item.EffectivePath; + Seg.PreciseIn := False; + Seg.Volume := Winner.Volume; + Req.Kind := gkImage; + Req.SourcePath := Item.EffectivePath; + Req.Duration := BucketFor(Seg.Duration); + Seg.FilePath := GeneratedPath(AProject.CacheDir, Req); + end + else + begin + Item := AProject.FindMedia(Winner.MediaId); + if Item = nil then + Continue; + Seg.Kind := skVideo; + Seg.GenSource := ''; + Seg.Volume := Winner.Volume; + Seg.FilePath := Item.EffectivePath; + { Сколько от начала клипа прошло, столько же надо отступить и в + исходнике. } + Seg.SrcStart := Winner.SrcIn + (SegStart - Winner.TlStart); + + { Точность требуется только там, где кусок начинается с собственного + левого края клипа. Границы, возникшие из-за перекрытия соседней + дорожкой, притягиваются к опорному кадру: помечать их точными + значило бы перекодировать стык при каждом наложении. } + Seg.PreciseIn := (Winner.EdgeIn = edPrecise) and + (Abs(SegStart - Winner.TlStart) < 0.0005); + + { Файл, не совпадающий с параметрами проекта, скопировать нельзя: + придётся пересобрать. Но только его куски — всё остальное + по-прежнему копируется. } + Seg.Transcode := HasBlocking(CompareToMaster(AProject.Master, Item.Info)); + if Seg.Transcode then + Seg.Filter := TransformFilter(Item.Transform, + Item.Info.Width, Item.Info.Height, + AProject.Master.Width, AProject.Master.Height); + + { Не просим у файла больше, чем в нём есть. + + Когда клип занимает исходник целиком, запрошенная длина совпадает + с длиной файла до последнего знака, и mpv ругается «entry uses + 892.124567 seconds, but file has only 892.124567 seconds» — его + собственный подсчёт отличается на неразличимую величину. Отступаем + на миллисекунду: на монтаже это незаметно, а предупреждение, + выглядящее как ошибка, исчезает. } + if Item.Info.Duration > 0 then + begin + MaxLen := Item.Info.Duration - Seg.SrcStart; + if (MaxLen > 0) and (Seg.Duration > MaxLen - 0.001) then + Seg.Duration := Max(0.001, MaxLen - 0.001); + end; + end; + + Raw[RawCount] := Seg; + Inc(RawCount); + end; + + if RawCount = 0 then + Exit; + + { --- Склейка соседних кусков одного источника --- } + SetLength(ASegments, RawCount); + N := 0; + ASegments[0] := Raw[0]; + for I := 1 to RawCount - 1 do + begin + if (Raw[I].Kind = ASegments[N].Kind) and + (Raw[I].FilePath = ASegments[N].FilePath) and + (Raw[I].Kind = skVideo) and + (Abs(Raw[I].Volume - ASegments[N].Volume) < 0.001) and + (Abs((ASegments[N].SrcStart + ASegments[N].Duration) - Raw[I].SrcStart) < 0.0005) then + { Идут подряд в одном файле — это один кусок, а не два. } + ASegments[N].Duration := ASegments[N].Duration + Raw[I].Duration + else + begin + Inc(N); + ASegments[N] := Raw[I]; + end; + end; + SetLength(ASegments, N + 1); + + { --- Что предстоит создать --- } + Seen := TStringList.Create; + try + Seen.Sorted := True; + Seen.Duplicates := dupIgnore; + + for I := 0 to High(ASegments) do + begin + if ASegments[I].Kind = skVideo then + Continue; + Path := ASegments[I].FilePath; + if (Path = '') or FileExists(Path) then + Continue; + if Seen.IndexOf(Path) >= 0 then + Continue; + Seen.Add(Path); + + N := Length(AMissing); + SetLength(AMissing, N + 1); + AMissing[N].TargetPath := Path; + AMissing[N].Duration := BucketFor(ASegments[I].Duration); + AMissing[N].SourcePath := ASegments[I].GenSource; + if ASegments[I].Kind = skBlack then + AMissing[N].Kind := gkBlack + else + AMissing[N].Kind := gkImage; + end; + finally + Seen.Free; + end; + + Result := True; +end; + +end. diff --git a/src/uGenerate.pas b/src/uGenerate.pas new file mode 100644 index 0000000..6042bd3 --- /dev/null +++ b/src/uGenerate.pas @@ -0,0 +1,239 @@ +{ + uGenerate — создание клипов для картинок и дыр. + + Картинку нельзя просто положить на монтаж: и предпросмотр, и сборка + работают с видеофайлами. Дыра между клипами — та же история: чтобы + чёрный кусок вёл себя как все остальные, он должен быть настоящим + файлом. + + Проверено на mpv 0.37: подсовывать в список кусков саму картинку или + генератор lavfi нельзя — плеер на этом зависает. Поэтому оба случая + сводятся к одному механизму: заранее создать небольшой клип в + параметрах проекта и дальше не делать между ними различий. + + Файлы называются по содержанию запроса, поэтому одинаковые запросы + дают один файл и делаются один раз. +} +unit uGenerate; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, uAppTypes, uFlatten, uMediaProbe; + +type + TGenerateThread = class(TThread) + private + FRequests: TGenRequests; + FMaster: TMediaInfo; + FCancelRequested: Boolean; + FStageText: string; + FFraction: Double; + FPendingLog: string; + FSucceeded: Boolean; + FCancelled: Boolean; + FMessage: string; + FCurrent: Integer; + FOnProgress: TNotifyEvent; + FOnLog: TNotifyEvent; + + procedure SyncProgress; + procedure SyncLog; + procedure Log(const AText: string); + function CancelQuery: Boolean; + procedure ErrorLine(const ALine: string); + procedure Publish; + protected + procedure Execute; override; + public + constructor Create(const ARequests: TGenRequests; const AMaster: TMediaInfo); + procedure RequestCancel; + + property StageText: string read FStageText; + property Fraction: Double read FFraction; + property PendingLog: string read FPendingLog; + property Succeeded: Boolean read FSucceeded; + property Cancelled: Boolean read FCancelled; + property Message: string read FMessage; + + property OnProgress: TNotifyEvent read FOnProgress write FOnProgress; + property OnLog: TNotifyEvent read FOnLog write FOnLog; + end; + +implementation + +uses + uFfmpegCmd, uProcRunner; + +constructor TGenerateThread.Create(const ARequests: TGenRequests; + const AMaster: TMediaInfo); +var + I: Integer; +begin + inherited Create(True); + FreeOnTerminate := False; + SetLength(FRequests, Length(ARequests)); + for I := 0 to High(ARequests) do + FRequests[I] := ARequests[I]; + FMaster := AMaster; +end; + +procedure TGenerateThread.RequestCancel; +begin + FCancelRequested := True; +end; + +function TGenerateThread.CancelQuery: Boolean; +begin + Result := FCancelRequested or Terminated; +end; + +procedure TGenerateThread.SyncProgress; +begin + if Assigned(FOnProgress) then + FOnProgress(Self); +end; + +procedure TGenerateThread.SyncLog; +begin + if Assigned(FOnLog) then + FOnLog(Self); +end; + +procedure TGenerateThread.Log(const AText: string); +begin + FPendingLog := AText; + Synchronize(@SyncLog); +end; + +procedure TGenerateThread.ErrorLine(const ALine: string); +begin + Log('ffmpeg: ' + ALine); +end; + +procedure TGenerateThread.Publish; +begin + if Length(FRequests) > 0 then + FFraction := FCurrent / Length(FRequests) + else + FFraction := 1; + Synchronize(@SyncProgress); +end; + +procedure TGenerateThread.Execute; +var + I: Integer; + Args: TArgs; + Res: TProcResult; + ToolError: string; + AudioCodec: string; +begin + try + if Length(FRequests) = 0 then + begin + FSucceeded := True; + FMessage := 'Создавать нечего.'; + Exit; + end; + + if not ToolsAvailable(ToolError) then + begin + FMessage := ToolError; + Exit; + end; + + if not FMaster.Valid then + begin + FMessage := 'Параметры проекта не заданы: добавьте сначала видеофайл.'; + Exit; + end; + + { Звуковая дорожка добавляется только если она есть у проекта: иначе + при склейке у одних кусков звук будет, у других нет, и результат + развалится. } + if FMaster.HasAudio then + AudioCodec := FMaster.AudioCodec + else + AudioCodec := ''; + + for I := 0 to High(FRequests) do + begin + if CancelQuery then + begin + FCancelled := True; + FMessage := 'Отменено.'; + Exit; + end; + + FCurrent := I; + case FRequests[I].Kind of + gkBlack: + FStageText := Format('Делаю чёрную вставку %d из %d', + [I + 1, Length(FRequests)]); + gkImage: + FStageText := Format('Делаю клип из картинки %d из %d', + [I + 1, Length(FRequests)]); + end; + Publish; + + if not ForceDirectories(ExtractFilePath(FRequests[I].TargetPath)) then + begin + FMessage := 'Не удалось создать каталог для сгенерированных клипов.'; + Exit; + end; + + case FRequests[I].Kind of + gkBlack: + Args := ArgsBlackClip(FRequests[I].TargetPath, FRequests[I].Duration, + FMaster.Width, FMaster.Height, FMaster.FpsNum, FMaster.FpsDen, + FMaster.VideoCodec, FMaster.PixFmt, AudioCodec, + FMaster.SampleRate, FMaster.Channels); + gkImage: + Args := ArgsImageClip(FRequests[I].SourcePath, FRequests[I].TargetPath, + FRequests[I].Duration, + FMaster.Width, FMaster.Height, FMaster.FpsNum, FMaster.FpsDen, + FMaster.VideoCodec, FMaster.PixFmt, AudioCodec, + FMaster.SampleRate, FMaster.Channels); + else + Continue; + end; + + Log('> ' + CommandToString(FfmpegExe, Args)); + Res := RunProcess(FfmpegExe, Args, nil, @ErrorLine, @CancelQuery); + + if Res.Cancelled then + begin + FCancelled := True; + FMessage := 'Отменено.'; + if FileExists(FRequests[I].TargetPath) then + DeleteFile(FRequests[I].TargetPath); + Exit; + end; + if (not Res.Started) or (Res.ExitCode <> 0) then + begin + FMessage := 'Не удалось создать ' + + ExtractFileName(FRequests[I].TargetPath) + '. Подробности в журнале.'; + Exit; + end; + if not FileExists(FRequests[I].TargetPath) then + begin + FMessage := 'ffmpeg отработал, но файла нет: ' + FRequests[I].TargetPath; + Exit; + end; + end; + + FCurrent := Length(FRequests); + FSucceeded := True; + FMessage := 'Готово.'; + except + on E: Exception do + FMessage := 'Внутренняя ошибка: ' + E.Message; + end; + + FFraction := 1; + Synchronize(@SyncProgress); +end; + +end. diff --git a/src/uKeyframeIndex.pas b/src/uKeyframeIndex.pas new file mode 100644 index 0000000..58cc2e5 --- /dev/null +++ b/src/uKeyframeIndex.pas @@ -0,0 +1,760 @@ +{ + uKeyframeIndex — где в файле находятся опорные кадры. + + Зачем это нужно. Видео сжато межкадрово: самостоятельно декодируется + только опорный кадр, остальные хранят разницу с соседями. Поэтому + вырезать кусок без перекодирования можно только начиная с опорного + кадра — иначе первые кадры куска не из чего восстанавливать. + + Быстрый путь: разбор заголовка MP4. + + В MP4 есть таблица stss — номера кадров, которые являются опорными, и + таблица stts — длительность каждого кадра. Вместе они дают точные метки + времени всех опорных кадров, и лежат обе в блоке moov, который занимает + единицы мегабайт независимо от размера файла. + + На пробе: файл 6.28 ГБ, moov 2.9 МБ. Разбор заголовка дал 892 опорных + кадра за 23 мс. Тот же результат через ffprobe требовал 12.2 секунды, + потому что ffprobe читает все 6.28 ГБ насквозь. Разница в 500 раз, при + полном совпадении значений. + + Запасной путь: опрос ffprobe. Медленно, но работает с любым контейнером. + + Чего этот разбор пока не учитывает: блок elst (список правок), который + способен сдвинуть всю дорожку по времени. У обычных записей с камер его + нет. Если появится материал, где метки разъезжаются, начинать копать + надо отсюда. +} +unit uKeyframeIndex; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, uAppTypes; + +type + TDoubleArray = array of Double; + + TKeyframeSource = (kfNone, kfMp4Header, kfFfprobe, kfAllFrames); + + TKeyframeIndex = record + Times: TDoubleArray; + Source: TKeyframeSource; + { Кодек без межкадрового сжатия: опорным является каждый кадр, и + резать можно где угодно. Таблица при этом пуста. } + AllFrames: Boolean; + end; + +{ Строит индекс. Сначала пробует разобрать заголовок MP4, при неудаче + опрашивает ffprobe. Вызывать из рабочего потока: запасной путь читает + файл целиком. } +function BuildKeyframeIndex(const APath: string; out AIndex: TKeyframeIndex; + out AError: string): Boolean; + +{ Только разбор заголовка MP4, без обращения к ffprobe. Отдельно вынесено + ради проверки: так видно, сработал быстрый путь или нет. } +function ReadMp4KeyframeIndex(const APath: string; out AIndex: TKeyframeIndex; + out AError: string): Boolean; + +{ Только опрос ffprobe. Тоже вынесено отдельно, чтобы можно было сверять + быстрый путь с медленным: если они разойдутся, разбору заголовка нельзя + будет доверять. } +function BuildKeyframeIndexViaProbe(const APath: string; out AIndex: TKeyframeIndex; + out AError: string): Boolean; + +{ Индекс с запоминанием на диске. + + Быстрый путь и так укладывается в миллисекунды, но запасной читает файл + целиком: для часового MKV это десятки секунд, и повторять их при каждом + открытии проекта незачем. + + Ключ кэша учитывает размер и время правки файла: подменили файл — кэш + сам перестанет подходить. } +function CachedKeyframeIndex(const ACacheDir, APath: string; + out AIndex: TKeyframeIndex; out AError: string): Boolean; + +{ Ближайший опорный кадр не позже указанного времени. } +function SnapDown(const AIndex: TKeyframeIndex; const ATime: Double): Double; + +{ Ближайший опорный кадр в любую сторону. Именно это поведение ожидается + от реза по умолчанию: промахнуться на полкадра вперёд не хуже, чем назад. } +function SnapNearest(const AIndex: TKeyframeIndex; const ATime: Double): Double; + +implementation + +uses + Math, md5, fpjson, jsonparser, jsonscanner, uFfmpegCmd, uProcRunner; + +type + { Пары «сколько подряд» и «значение» — так в MP4 хранятся и длительности + кадров, и смещения времени показа. } + TRunTable = record + Counts: array of LongWord; + Values: array of Int64; + end; + +{ --- Чтение чисел в сетевом порядке байт --- } + +function ReadU32(AStream: TStream): LongWord; +var + B: array[0..3] of Byte; +begin + AStream.ReadBuffer(B, 4); + Result := (LongWord(B[0]) shl 24) or (LongWord(B[1]) shl 16) or + (LongWord(B[2]) shl 8) or LongWord(B[3]); +end; + +function ReadU64(AStream: TStream): QWord; +var + Hi, Lo: LongWord; +begin + Hi := ReadU32(AStream); + Lo := ReadU32(AStream); + Result := (QWord(Hi) shl 32) or QWord(Lo); +end; + +function ReadFourCC(AStream: TStream): string; +var + B: array[0..3] of Char; +begin + AStream.ReadBuffer(B, 4); + SetLength(Result, 4); + Move(B, Result[1], 4); +end; + +{ Следующий блок в пределах [APos, AEnd). Возвращает False, когда блоки + кончились или структура повреждена. APos сдвигается на начало следующего. } +function NextBox(AStream: TStream; var APos: Int64; AEnd: Int64; + out AType: string; out ABodyStart, ABodyEnd: Int64): Boolean; +var + Size: QWord; + Header: Integer; +begin + Result := False; + AType := ''; + ABodyStart := 0; + ABodyEnd := 0; + + if APos + 8 > AEnd then + Exit; + + AStream.Position := APos; + Size := ReadU32(AStream); + AType := ReadFourCC(AStream); + Header := 8; + + if Size = 1 then + begin + { Размер не поместился в 32 бита — он лежит следом восемью байтами. } + if APos + 16 > AEnd then + Exit; + Size := ReadU64(AStream); + Header := 16; + end + else if Size = 0 then + { Ноль означает «до конца родителя». } + Size := QWord(AEnd - APos); + + if (Size < QWord(Header)) or (APos + Int64(Size) > AEnd) then + Exit; + + ABodyStart := APos + Header; + ABodyEnd := APos + Int64(Size); + APos := ABodyEnd; + Result := True; +end; + +{ Первый дочерний блок нужного типа. } +function FindBox(AStream: TStream; AStart, AEnd: Int64; const AType: string; + out ABodyStart, ABodyEnd: Int64): Boolean; +var + Pos: Int64; + T: string; + BS, BE: Int64; +begin + Result := False; + Pos := AStart; + while NextBox(AStream, Pos, AEnd, T, BS, BE) do + if T = AType then + begin + ABodyStart := BS; + ABodyEnd := BE; + Exit(True); + end; +end; + +{ Читает таблицу пар «количество, значение». ASigned важен для ctts + версии 1, где смещение может быть отрицательным. } +procedure ReadRunTable(AStream: TStream; ABodyStart: Int64; ASigned: Boolean; + out ATable: TRunTable); +var + Version: Byte; + Count, I: LongWord; + Raw: LongWord; +begin + ATable.Counts := nil; + ATable.Values := nil; + + AStream.Position := ABodyStart; + Version := 0; + AStream.ReadBuffer(Version, 1); + AStream.Position := ABodyStart + 4; + Count := ReadU32(AStream); + + { Заведомо неправдоподобный размер — признак повреждения, а не повод + пытаться выделить гигабайты. } + if Count > 100 * 1000 * 1000 then + Exit; + + SetLength(ATable.Counts, Count); + SetLength(ATable.Values, Count); + for I := 0 to Count - 1 do + begin + ATable.Counts[I] := ReadU32(AStream); + Raw := ReadU32(AStream); + if ASigned and (Version = 1) then + ATable.Values[I] := LongInt(Raw) + else + ATable.Values[I] := Int64(Raw); + end; +end; + +{ Курсор по таблице пар: позволяет спрашивать значение для номера кадра, + если номера спрашиваются по возрастанию. Так обход обеих таблиц + выходит линейным, а не квадратичным. } +type + TRunCursor = record + Table: TRunTable; + RunIdx: Integer; + FirstSample: Int64; + AccumulatedBefore: Int64; + end; + +procedure ResetCursor(out ACursor: TRunCursor; const ATable: TRunTable); +begin + ACursor.Table := ATable; + ACursor.RunIdx := 0; + ACursor.FirstSample := 1; + ACursor.AccumulatedBefore := 0; +end; + +{ Сумма значений для кадров до ASample, то есть время начала показа + кадра ASample при обходе таблицы длительностей. } +function CursorSumBefore(var ACursor: TRunCursor; ASample: Int64): Int64; +var + Cnt: Int64; +begin + while (ACursor.RunIdx <= High(ACursor.Table.Counts)) do + begin + Cnt := ACursor.Table.Counts[ACursor.RunIdx]; + if ASample < ACursor.FirstSample + Cnt then + Break; + Inc(ACursor.AccumulatedBefore, Cnt * ACursor.Table.Values[ACursor.RunIdx]); + Inc(ACursor.FirstSample, Cnt); + Inc(ACursor.RunIdx); + end; + + if ACursor.RunIdx > High(ACursor.Table.Counts) then + Exit(ACursor.AccumulatedBefore); + + Result := ACursor.AccumulatedBefore + + (ASample - ACursor.FirstSample) * ACursor.Table.Values[ACursor.RunIdx]; +end; + +{ Значение, приписанное конкретному кадру. Для ctts это смещение времени + показа относительно времени декодирования. } +function CursorValueAt(var ACursor: TRunCursor; ASample: Int64): Int64; +var + Cnt: Int64; +begin + while (ACursor.RunIdx <= High(ACursor.Table.Counts)) do + begin + Cnt := ACursor.Table.Counts[ACursor.RunIdx]; + if ASample < ACursor.FirstSample + Cnt then + Break; + Inc(ACursor.FirstSample, Cnt); + Inc(ACursor.RunIdx); + end; + + if ACursor.RunIdx > High(ACursor.Table.Counts) then + Exit(0); + + Result := ACursor.Table.Values[ACursor.RunIdx]; +end; + +function ReadMp4KeyframeIndex(const APath: string; out AIndex: TKeyframeIndex; + out AError: string): Boolean; +var + Stream: TFileStream; + FileEnd, Pos: Int64; + T: string; + BS, BE: Int64; + MoovStart, MoovEnd: Int64; + TrakStart, TrakEnd: Int64; + MdiaStart, MdiaEnd: Int64; + MinfStart, MinfEnd: Int64; + StblStart, StblEnd: Int64; + MdhdStart, MdhdEnd: Int64; + HdlrStart, HdlrEnd: Int64; + SttsStart, SttsEnd: Int64; + CttsStart, CttsEnd: Int64; + StssStart, StssEnd: Int64; + Version: Byte; + Timescale: LongWord; + Handler: string; + SttsTable, CttsTable: TRunTable; + HasCtts: Boolean; + SyncCount, I: LongWord; + Sample: Int64; + DtsCursor, CttsCursor: TRunCursor; + Pts: Int64; + FoundVideo: Boolean; +begin + Result := False; + AError := ''; + AIndex.Times := nil; + AIndex.Source := kfNone; + AIndex.AllFrames := False; + + if not FileExists(APath) then + begin + AError := 'Файл не найден: ' + APath; + Exit; + end; + + try + Stream := TFileStream.Create(APath, fmOpenRead or fmShareDenyNone); + except + on E: Exception do + begin + AError := 'Не удалось открыть файл: ' + E.Message; + Exit; + end; + end; + + try + FileEnd := Stream.Size; + + { moov может лежать и в начале файла, и в конце — стандарт этого не + предписывает. Записи с камер обычно кладут его в конец. } + MoovStart := -1; + MoovEnd := -1; + Pos := 0; + while NextBox(Stream, Pos, FileEnd, T, BS, BE) do + if T = 'moov' then + begin + MoovStart := BS; + MoovEnd := BE; + Break; + end; + + if MoovStart < 0 then + begin + AError := 'Это не MP4 или MOV: блок moov не найден.'; + Exit; + end; + + FoundVideo := False; + Pos := MoovStart; + while NextBox(Stream, Pos, MoovEnd, T, TrakStart, TrakEnd) do + begin + if T <> 'trak' then + Continue; + + if not FindBox(Stream, TrakStart, TrakEnd, 'mdia', MdiaStart, MdiaEnd) then + Continue; + + { Нас интересует только видеодорожка. У DJI в файле их две — сама + съёмка и MJPEG-обложка, — плюс потоки телеметрии. } + if not FindBox(Stream, MdiaStart, MdiaEnd, 'hdlr', HdlrStart, HdlrEnd) then + Continue; + Stream.Position := HdlrStart + 8; + Handler := ReadFourCC(Stream); + if Handler <> 'vide' then + Continue; + + if not FindBox(Stream, MdiaStart, MdiaEnd, 'mdhd', MdhdStart, MdhdEnd) then + Continue; + + Stream.Position := MdhdStart; + Version := 0; + Stream.ReadBuffer(Version, 1); + if Version = 1 then + { версия 1: два восьмибайтных времени, затем шкала } + Stream.Position := MdhdStart + 4 + 8 + 8 + else + { версия 0: два четырёхбайтных времени, затем шкала } + Stream.Position := MdhdStart + 4 + 4 + 4; + Timescale := ReadU32(Stream); + if Timescale = 0 then + Continue; + + if not FindBox(Stream, MdiaStart, MdiaEnd, 'minf', MinfStart, MinfEnd) then + Continue; + if not FindBox(Stream, MinfStart, MinfEnd, 'stbl', StblStart, StblEnd) then + Continue; + if not FindBox(Stream, StblStart, StblEnd, 'stts', SttsStart, SttsEnd) then + Continue; + + ReadRunTable(Stream, SttsStart, False, SttsTable); + + HasCtts := FindBox(Stream, StblStart, StblEnd, 'ctts', CttsStart, CttsEnd); + if HasCtts then + ReadRunTable(Stream, CttsStart, True, CttsTable); + + FoundVideo := True; + + if not FindBox(Stream, StblStart, StblEnd, 'stss', StssStart, StssEnd) then + begin + { Таблицы опорных кадров нет — по стандарту это значит, что + опорным является каждый кадр. Так бывает у MJPEG и прочих + кодеков без межкадрового сжатия. } + AIndex.AllFrames := True; + AIndex.Source := kfAllFrames; + Exit(True); + end; + + Stream.Position := StssStart + 4; + SyncCount := ReadU32(Stream); + if SyncCount > 50 * 1000 * 1000 then + begin + AError := 'Таблица опорных кадров неправдоподобного размера.'; + Exit; + end; + + SetLength(AIndex.Times, SyncCount); + ResetCursor(DtsCursor, SttsTable); + if HasCtts then + ResetCursor(CttsCursor, CttsTable); + + for I := 0 to SyncCount - 1 do + begin + { Номера кадров в stss начинаются с единицы. } + Sample := ReadU32(Stream); + Pts := CursorSumBefore(DtsCursor, Sample); + if HasCtts then + Inc(Pts, CursorValueAt(CttsCursor, Sample)); + AIndex.Times[I] := Pts / Timescale; + end; + + AIndex.Source := kfMp4Header; + Exit(True); + end; + + if FoundVideo then + AError := 'В видеодорожке нет таблицы длительностей кадров.' + else + AError := 'В файле не нашлось видеодорожки.'; + finally + Stream.Free; + end; +end; + +{ --- Запасной путь через ffprobe --- } + +type + TProbeCollector = class + private + FTimes: TDoubleArray; + FCount: Integer; + public + procedure Line(const ALine: string); + function Take: TDoubleArray; + end; + +procedure TProbeCollector.Line(const ALine: string); +var + P: Integer; + TimeStr, Flags: string; + Value: Double; +begin + { Формат строки: pts_time,flags — например «1.001000,K__». } + P := Pos(',', ALine); + if P <= 1 then + Exit; + TimeStr := Copy(ALine, 1, P - 1); + Flags := Copy(ALine, P + 1, Length(ALine) - P); + if Pos('K', Flags) = 0 then + Exit; + if not TryStrToFloat(TimeStr, Value, InvariantFormat) then + Exit; + + if FCount = Length(FTimes) then + SetLength(FTimes, Max(64, Length(FTimes) * 2)); + FTimes[FCount] := Value; + Inc(FCount); +end; + +function TProbeCollector.Take: TDoubleArray; +begin + SetLength(FTimes, FCount); + Result := FTimes; +end; + +function BuildKeyframeIndexViaProbe(const APath: string; out AIndex: TKeyframeIndex; + out AError: string): Boolean; +var + Collector: TProbeCollector; + Res: TProcResult; +begin + Result := False; + AError := ''; + AIndex.Times := nil; + AIndex.Source := kfNone; + AIndex.AllFrames := False; + + if FfprobeExe = '' then + begin + AError := 'ffprobe не найден, построить индекс опорных кадров нечем.'; + Exit; + end; + + Collector := TProbeCollector.Create; + try + Res := RunProcess(FfprobeExe, ArgsPacketFlags(APath), + @Collector.Line, nil, nil); + if not Res.Started then + begin + AError := Res.ErrorText; + Exit; + end; + if Res.ExitCode <> 0 then + begin + AError := 'ffprobe завершился с кодом ' + IntToStr(Res.ExitCode) + '.'; + Exit; + end; + + AIndex.Times := Collector.Take; + if Length(AIndex.Times) = 0 then + begin + AError := 'ffprobe не нашёл ни одного опорного кадра.'; + Exit; + end; + AIndex.Source := kfFfprobe; + Result := True; + finally + Collector.Free; + end; +end; + +function BuildKeyframeIndex(const APath: string; out AIndex: TKeyframeIndex; + out AError: string): Boolean; +var + Mp4Error: string; +begin + { Сначала быстрый путь. Он работает только с MP4 и MOV, зато на порядки + быстрее и не зависит от наличия ffprobe. } + if ReadMp4KeyframeIndex(APath, AIndex, Mp4Error) then + Exit(True); + + Result := BuildKeyframeIndexViaProbe(APath, AIndex, AError); + if not Result then + AError := 'Разбор заголовка: ' + Mp4Error + LineEnding + 'ffprobe: ' + AError; +end; + +{ --- Запоминание на диске --- } + +{ Имя файла кэша: отпечаток пути, размера и времени правки. } +function CacheFileName(const ACacheDir, APath: string): string; +var + Info: TSearchRec; + Size: Int64; + Stamp: LongInt; + Key: string; +begin + Size := 0; + Stamp := 0; + if FindFirst(APath, faAnyFile, Info) = 0 then + begin + Size := Info.Size; + Stamp := Info.Time; + FindClose(Info); + end; + Key := APath + '|' + IntToStr(Size) + '|' + IntToStr(Stamp); + Result := IncludeTrailingPathDelimiter(ACacheDir) + 'idx' + PathDelim + + MD5Print(MD5String(Key)) + '.json'; +end; + +function LoadIndexFile(const AFile: string; out AIndex: TKeyframeIndex): Boolean; +var + Text: TStringList; + Parser: TJSONParser; + Root: TJSONData; + Obj: TJSONObject; + Arr: TJSONArray; + I: Integer; +begin + Result := False; + AIndex.Times := nil; + AIndex.Source := kfNone; + AIndex.AllFrames := False; + + if not FileExists(AFile) then + Exit; + + Text := TStringList.Create; + try + try + Text.LoadFromFile(AFile); + Parser := TJSONParser.Create(Text.Text, [joUTF8]); + try + Root := Parser.Parse; + finally + Parser.Free; + end; + except + { Испорченный кэш — не повод падать: просто построим индекс заново. } + Exit; + end; + finally + Text.Free; + end; + + if (Root = nil) or (not (Root is TJSONObject)) then + begin + Root.Free; + Exit; + end; + + try + Obj := TJSONObject(Root); + AIndex.AllFrames := Obj.Get('all_frames', False); + if Obj.Get('source', '') = 'mp4' then + AIndex.Source := kfMp4Header + else if Obj.Get('source', '') = 'ffprobe' then + AIndex.Source := kfFfprobe + else if AIndex.AllFrames then + AIndex.Source := kfAllFrames; + + Arr := Obj.Find('times', jtArray) as TJSONArray; + if Arr <> nil then + begin + SetLength(AIndex.Times, Arr.Count); + for I := 0 to Arr.Count - 1 do + AIndex.Times[I] := Arr.Floats[I]; + end; + + Result := AIndex.AllFrames or (Length(AIndex.Times) > 0); + finally + Root.Free; + end; +end; + +procedure SaveIndexFile(const AFile: string; const AIndex: TKeyframeIndex); +var + Root: TJSONObject; + Arr: TJSONArray; + I: Integer; + Text: TStringList; + SourceName: string; +begin + if not ForceDirectories(ExtractFilePath(AFile)) then + Exit; + + case AIndex.Source of + kfMp4Header: SourceName := 'mp4'; + kfFfprobe: SourceName := 'ffprobe'; + kfAllFrames: SourceName := 'all'; + else + SourceName := 'none'; + end; + + Root := TJSONObject.Create; + try + Root.Add('source', SourceName); + Root.Add('all_frames', AIndex.AllFrames); + Arr := TJSONArray.Create; + for I := 0 to High(AIndex.Times) do + Arr.Add(AIndex.Times[I]); + Root.Add('times', Arr); + + Text := TStringList.Create; + try + Text.Text := Root.AsJSON; + try + Text.SaveToFile(AFile); + except + { Не смогли записать кэш — работать это не мешает. } + end; + finally + Text.Free; + end; + finally + Root.Free; + end; +end; + +function CachedKeyframeIndex(const ACacheDir, APath: string; + out AIndex: TKeyframeIndex; out AError: string): Boolean; +var + CacheFile: string; +begin + AError := ''; + CacheFile := CacheFileName(ACacheDir, APath); + + if LoadIndexFile(CacheFile, AIndex) then + Exit(True); + + Result := BuildKeyframeIndex(APath, AIndex, AError); + if Result then + SaveIndexFile(CacheFile, AIndex); +end; + +{ --- Поиск ближайшего опорного кадра --- } + +{ Номер последнего элемента, значение которого не превышает ATime. + Минус один, если таких нет. } +function LowerBoundIdx(const ATimes: TDoubleArray; const ATime: Double): Integer; +var + Lo, Hi, Mid: Integer; +begin + Result := -1; + Lo := 0; + Hi := High(ATimes); + while Lo <= Hi do + begin + Mid := (Lo + Hi) div 2; + if ATimes[Mid] <= ATime then + begin + Result := Mid; + Lo := Mid + 1; + end + else + Hi := Mid - 1; + end; +end; + +function SnapDown(const AIndex: TKeyframeIndex; const ATime: Double): Double; +var + Idx: Integer; +begin + if AIndex.AllFrames or (Length(AIndex.Times) = 0) then + Exit(ATime); + Idx := LowerBoundIdx(AIndex.Times, ATime); + if Idx < 0 then + Exit(AIndex.Times[0]); + Result := AIndex.Times[Idx]; +end; + +function SnapNearest(const AIndex: TKeyframeIndex; const ATime: Double): Double; +var + Idx: Integer; +begin + if AIndex.AllFrames or (Length(AIndex.Times) = 0) then + Exit(ATime); + + Idx := LowerBoundIdx(AIndex.Times, ATime); + if Idx < 0 then + Exit(AIndex.Times[0]); + if Idx >= High(AIndex.Times) then + Exit(AIndex.Times[High(AIndex.Times)]); + + if (ATime - AIndex.Times[Idx]) <= (AIndex.Times[Idx + 1] - ATime) then + Result := AIndex.Times[Idx] + else + Result := AIndex.Times[Idx + 1]; +end; + +end. diff --git a/src/uLogView.pas b/src/uLogView.pas new file mode 100644 index 0000000..dc1734e --- /dev/null +++ b/src/uLogView.pas @@ -0,0 +1,765 @@ +{ + uLogView — журнал сообщений, нарисованный своими силами. + + Зачем не многострочное поле. Полосы прокрутки у него рисует система, и + цвет им задать нечем: на тёмном окне они остаются светлыми. Всё + остальное окно уже в своих цветах, и две светлые полосы внизу — то + единственное, что оставалось. + + Заодно чинится вторая вещь. Прокрутка вбок колесом с Shift была сделана + только под gtk2 через внутренности виджета; в сборке под Windows она + молча не работала. Здесь прокрутка своя и одинаковая везде. + + Что сохранено от прежнего поля: выделение мышью, Ctrl+A, копирование по + Ctrl+C. В журнал попадают команды ffmpeg длиной в несколько экранов, и + забрать их оттуда надо уметь. + + Шрифт предполагается моноширинным: по нему считается, какой столбец под + курсором. С пропорциональным шрифтом выделение будет промахиваться. +} +unit uLogView; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Types, Controls, Graphics, LCLType, LazUTF8; + +type + + TLogView = class(TCustomControl) + private + FLines: TStringList; + FMaxLines: Integer; + { Первая видимая строка и сдвиг содержимого вправо, в пикселях. } + FTopLine: Integer; + FLeftPx: Integer; + FLineHeight: Integer; + FCharWidth: Integer; + { Длина самой длинной строки в знаках. Считается в знаках, а не в + байтах: в кириллице знак занимает два байта, и по длине строки в + байтах ширина вышла бы вдвое больше настоящей. } + FMaxLen: Integer; + { Держаться конца журнала. Сбрасывается, когда пользователь отматывает + назад: он читает старое сообщение, и утаскивать его вниз при каждой + новой строке нельзя. } + FFollowTail: Boolean; + + FDragKind: Integer; + FDragOffset: Integer; + { Начало и конец выделения: X — столбец, Y — номер строки. } + FSelFrom: TPoint; + FSelTo: TPoint; + FHasSel: Boolean; + + procedure UpdateMetrics; + function BarSize: Integer; + function ContentRect: TRect; + function VisibleLines: Integer; + function MaxTopLine: Integer; + function ContentWidthPx: Integer; + function MaxLeftPx: Integer; + function NeedVBar: Boolean; + function NeedHBar: Boolean; + function VBarRect: TRect; + function HBarRect: TRect; + function VThumbRect: TRect; + function HThumbRect: TRect; + procedure SetTopLine(AValue: Integer); + procedure SetLeftPx(AValue: Integer); + function PointToCell(X, Y: Integer): TPoint; + function NormalizedSel(out AFrom, ATo: TPoint): Boolean; + procedure RecalcMaxLen; + protected + procedure Paint; override; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); override; + procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); override; + function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; + MousePos: TPoint): Boolean; override; + procedure KeyDown(var Key: Word; Shift: TShiftState); override; + procedure FontChanged(Sender: TObject); override; + procedure Resize; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + procedure Add(const AText: string); + procedure AddLine(const AText: string); + procedure Clear; + function SelectedText: string; + procedure SelectAll; + procedure CopyToClipboard; + procedure ScrollToBottom; + + property Lines: TStringList read FLines; + published + property Align; + property Anchors; + property Color; + property Font; + property ParentFont; + property PopupMenu; + property TabOrder; + property TabStop default True; + property Visible; + { Сколько строк держать. Старые уходят сверху: журнал за длинную + сборку иначе съел бы всю память. } + property MaxLines: Integer read FMaxLines write FMaxLines default 800; + end; + +implementation + +uses + Clipbrd, uTheme; + +const + { Что сейчас тянут мышью. } + DragNone = 0; + DragVThumb = 1; + DragHThumb = 2; + DragSelect = 3; + + BarWidth = 12; + MinThumb = 24; + TextMarginX = 3; + WheelLines = 3; + WheelChars = 8; + +constructor TLogView.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FLines := TStringList.Create; + FMaxLines := 800; + FFollowTail := True; + FDragKind := DragNone; + TabStop := True; + DoubleBuffered := True; + { Заведомо разумные значения до первой отрисовки: по ним считаются + видимые строки, и ноль тут привёл бы к делению на ноль. } + FCharWidth := 7; + FLineHeight := 14; + Color := ThemeSurface; + Font.Color := ThemeText; + ControlStyle := ControlStyle + [csOpaque]; +end; + +destructor TLogView.Destroy; +begin + FLines.Free; + inherited Destroy; +end; + +procedure TLogView.UpdateMetrics; +begin + { Пока у контрола нет своего окна, холста тоже нет, и обращение к нему + роняет программу сообщением «control has no parent window». Момент + настаёт при чтении формы: там задаётся шрифт, а окна ещё нет. + Поэтому до появления окна остаются значения из конструктора. } + if not HandleAllocated then + Exit; + Canvas.Font.Assign(Font); + FCharWidth := Canvas.TextWidth('0'); + if FCharWidth < 1 then + FCharWidth := 1; + FLineHeight := Canvas.TextHeight('Wg') + 2; + if FLineHeight < 4 then + FLineHeight := 4; +end; + +function TLogView.BarSize: Integer; +begin + Result := BarWidth; +end; + +function TLogView.NeedVBar: Boolean; +begin + Result := (FLineHeight > 0) and + (FLines.Count > (ClientHeight - BarSize) div FLineHeight); +end; + +function TLogView.NeedHBar: Boolean; +begin + Result := FMaxLen * FCharWidth + TextMarginX * 2 > ClientWidth - BarSize; +end; + +function TLogView.ContentRect: TRect; +begin + Result := ClientRect; + if NeedVBar then + Dec(Result.Right, BarSize); + if NeedHBar then + Dec(Result.Bottom, BarSize); + if Result.Right < Result.Left then + Result.Right := Result.Left; + if Result.Bottom < Result.Top then + Result.Bottom := Result.Top; +end; + +function TLogView.VisibleLines: Integer; +var + R: TRect; +begin + R := ContentRect; + if FLineHeight <= 0 then + Exit(1); + Result := (R.Bottom - R.Top) div FLineHeight; + if Result < 1 then + Result := 1; +end; + +function TLogView.MaxTopLine: Integer; +begin + Result := FLines.Count - VisibleLines; + if Result < 0 then + Result := 0; +end; + +function TLogView.ContentWidthPx: Integer; +var + R: TRect; +begin + R := ContentRect; + Result := R.Right - R.Left; + if Result < 1 then + Result := 1; +end; + +function TLogView.MaxLeftPx: Integer; +begin + Result := FMaxLen * FCharWidth + TextMarginX * 2 - ContentWidthPx; + if Result < 0 then + Result := 0; +end; + +function TLogView.VBarRect: TRect; +begin + Result := ClientRect; + Result.Left := Result.Right - BarSize; + if NeedHBar then + Dec(Result.Bottom, BarSize); +end; + +function TLogView.HBarRect: TRect; +begin + Result := ClientRect; + Result.Top := Result.Bottom - BarSize; + if NeedVBar then + Dec(Result.Right, BarSize); +end; + +function TLogView.VThumbRect: TRect; +var + Bar: TRect; + TrackH, ThumbH, Span: Integer; +begin + Bar := VBarRect; + TrackH := Bar.Bottom - Bar.Top; + Span := MaxTopLine; + if (Span <= 0) or (FLines.Count <= 0) then + Exit(Bar); + + ThumbH := Round(TrackH * VisibleLines / FLines.Count); + if ThumbH < MinThumb then + ThumbH := MinThumb; + if ThumbH > TrackH then + ThumbH := TrackH; + + Result := Bar; + Result.Top := Bar.Top + Round((TrackH - ThumbH) * FTopLine / Span); + Result.Bottom := Result.Top + ThumbH; +end; + +function TLogView.HThumbRect: TRect; +var + Bar: TRect; + TrackW, ThumbW, Span, Total: Integer; +begin + Bar := HBarRect; + TrackW := Bar.Right - Bar.Left; + Span := MaxLeftPx; + Total := FMaxLen * FCharWidth + TextMarginX * 2; + if (Span <= 0) or (Total <= 0) then + Exit(Bar); + + ThumbW := Round(TrackW * ContentWidthPx / Total); + if ThumbW < MinThumb then + ThumbW := MinThumb; + if ThumbW > TrackW then + ThumbW := TrackW; + + Result := Bar; + Result.Left := Bar.Left + Round((TrackW - ThumbW) * FLeftPx / Span); + Result.Right := Result.Left + ThumbW; +end; + +procedure TLogView.SetTopLine(AValue: Integer); +begin + if AValue > MaxTopLine then + AValue := MaxTopLine; + if AValue < 0 then + AValue := 0; + if AValue = FTopLine then + Exit; + FTopLine := AValue; + { Держимся конца только когда стоим на конце. } + FFollowTail := FTopLine >= MaxTopLine; + Invalidate; +end; + +procedure TLogView.SetLeftPx(AValue: Integer); +begin + if AValue > MaxLeftPx then + AValue := MaxLeftPx; + if AValue < 0 then + AValue := 0; + if AValue = FLeftPx then + Exit; + FLeftPx := AValue; + Invalidate; +end; + +procedure TLogView.RecalcMaxLen; +var + I, L: Integer; +begin + FMaxLen := 0; + for I := 0 to FLines.Count - 1 do + begin + L := UTF8Length(FLines[I]); + if L > FMaxLen then + FMaxLen := L; + end; +end; + +{ Текст с переносами разбивается на строки. Многострочное поле делало это + само, и без этого сообщение из двух предложений слипалось в одно, а сам + перенос показывался квадратиком. } +procedure TLogView.Add(const AText: string); +var + Rest, Line: string; + P: Integer; +begin + Rest := AText; + repeat + P := 1; + while (P <= Length(Rest)) and (Rest[P] <> #10) and (Rest[P] <> #13) do + Inc(P); + Line := Copy(Rest, 1, P - 1); + AddLine(Line); + if P > Length(Rest) then + Break; + { Пара #13#10 считается одним переносом, иначе выйдет пустая строка. } + if (Rest[P] = #13) and (P < Length(Rest)) and (Rest[P + 1] = #10) then + Inc(P); + Rest := Copy(Rest, P + 1, Length(Rest)); + until False; +end; + +procedure TLogView.AddLine(const AText: string); +var + L: Integer; + Dropped: Boolean; +begin + FLines.Add(AText); + L := UTF8Length(AText); + if L > FMaxLen then + FMaxLen := L; + + Dropped := False; + while FLines.Count > FMaxLines do + begin + FLines.Delete(0); + Dropped := True; + if FTopLine > 0 then + Dec(FTopLine); + end; + { Самая длинная строка могла оказаться выброшенной, и тогда ширина + посчитана с запасом. Пересчёт по 800 строкам стоит копейки, а мерить + надо длину в знаках, что и делает RecalcMaxLen. } + if Dropped then + RecalcMaxLen; + + if FFollowTail then + ScrollToBottom; + Invalidate; +end; + +procedure TLogView.Clear; +begin + FLines.Clear; + FTopLine := 0; + FLeftPx := 0; + FMaxLen := 0; + FHasSel := False; + FFollowTail := True; + Invalidate; +end; + +procedure TLogView.ScrollToBottom; +begin + FTopLine := MaxTopLine; + FFollowTail := True; + Invalidate; +end; + +procedure TLogView.Paint; +var + R, Bar, Thumb: TRect; + I, Y, X, Line: Integer; + SelA, SelB: TPoint; + HasSel: Boolean; + S: string; + StartCol, EndCol: Integer; +begin + UpdateMetrics; + R := ContentRect; + + Canvas.Brush.Color := Color; + Canvas.Brush.Style := bsSolid; + Canvas.FillRect(ClientRect); + + HasSel := NormalizedSel(SelA, SelB); + + Canvas.Font.Assign(Font); + Y := R.Top; + for I := 0 to VisibleLines do + begin + Line := FTopLine + I; + if Line >= FLines.Count then + Break; + S := FLines[Line]; + X := R.Left + TextMarginX - FLeftPx; + + { Подсветка выделенного куска строки. Столбцы переводятся в пиксели + умножением: шрифт моноширинный. } + if HasSel and (Line >= SelA.Y) and (Line <= SelB.Y) then + begin + if Line = SelA.Y then + StartCol := SelA.X + else + StartCol := 0; + if Line = SelB.Y then + EndCol := SelB.X + else + EndCol := UTF8Length(S) + 1; + + if EndCol > StartCol then + begin + Canvas.Brush.Color := ThemeSelection; + Canvas.FillRect(X + StartCol * FCharWidth, Y, + X + EndCol * FCharWidth, Y + FLineHeight); + end; + end; + + Canvas.Brush.Style := bsClear; + Canvas.Font.Color := Font.Color; + Canvas.TextOut(X, Y + 1, S); + + Inc(Y, FLineHeight); + if Y >= R.Bottom then + Break; + end; + + { Полосы рисуются последними: они закрывают текст, вылезший под них. } + Canvas.Brush.Style := bsSolid; + + if NeedVBar then + begin + Bar := VBarRect; + Canvas.Brush.Color := ThemeWindow; + Canvas.FillRect(Bar); + Thumb := VThumbRect; + Canvas.Brush.Color := ThemeButton; + Canvas.FillRect(Thumb.Left + 2, Thumb.Top + 1, + Thumb.Right - 2, Thumb.Bottom - 1); + end; + + if NeedHBar then + begin + Bar := HBarRect; + Canvas.Brush.Color := ThemeWindow; + Canvas.FillRect(Bar); + Thumb := HThumbRect; + Canvas.Brush.Color := ThemeButton; + Canvas.FillRect(Thumb.Left + 1, Thumb.Top + 2, + Thumb.Right - 1, Thumb.Bottom - 2); + end; + + { Угол между полосами. } + if NeedVBar and NeedHBar then + begin + Canvas.Brush.Color := ThemeWindow; + Canvas.FillRect(ClientWidth - BarSize, ClientHeight - BarSize, + ClientWidth, ClientHeight); + end; +end; + +function TLogView.PointToCell(X, Y: Integer): TPoint; +var + R: TRect; +begin + R := ContentRect; + Result.Y := FTopLine + (Y - R.Top) div FLineHeight; + if Result.Y < 0 then + Result.Y := 0; + if Result.Y > FLines.Count - 1 then + Result.Y := FLines.Count - 1; + if Result.Y < 0 then + Result.Y := 0; + + { Полтолщины знака добавляется, чтобы щелчок в правой половине буквы + ставил границу за ней, а не перед: так ведёт себя любой текстовый + редактор. } + Result.X := (X - R.Left - TextMarginX + FLeftPx + FCharWidth div 2) + div FCharWidth; + if Result.X < 0 then + Result.X := 0; +end; + +function TLogView.NormalizedSel(out AFrom, ATo: TPoint): Boolean; +begin + Result := FHasSel; + AFrom := FSelFrom; + ATo := FSelTo; + if not Result then + Exit; + if (ATo.Y < AFrom.Y) or ((ATo.Y = AFrom.Y) and (ATo.X < AFrom.X)) then + begin + AFrom := FSelTo; + ATo := FSelFrom; + end; + Result := (AFrom.Y <> ATo.Y) or (AFrom.X <> ATo.X); +end; + +procedure TLogView.MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +var + Thumb: TRect; +begin + inherited MouseDown(Button, Shift, X, Y); + if Button <> mbLeft then + Exit; + if CanFocus then + SetFocus; + + if NeedVBar and PtInRect(VBarRect, Point(X, Y)) then + begin + Thumb := VThumbRect; + if PtInRect(Thumb, Point(X, Y)) then + begin + FDragKind := DragVThumb; + FDragOffset := Y - Thumb.Top; + end + else if Y < Thumb.Top then + SetTopLine(FTopLine - VisibleLines) + else + SetTopLine(FTopLine + VisibleLines); + Exit; + end; + + if NeedHBar and PtInRect(HBarRect, Point(X, Y)) then + begin + Thumb := HThumbRect; + if PtInRect(Thumb, Point(X, Y)) then + begin + FDragKind := DragHThumb; + FDragOffset := X - Thumb.Left; + end + else if X < Thumb.Left then + SetLeftPx(FLeftPx - ContentWidthPx) + else + SetLeftPx(FLeftPx + ContentWidthPx); + Exit; + end; + + FDragKind := DragSelect; + FSelFrom := PointToCell(X, Y); + FSelTo := FSelFrom; + FHasSel := True; + Invalidate; +end; + +procedure TLogView.MouseMove(Shift: TShiftState; X, Y: Integer); +var + Bar: TRect; + TrackH, TrackW, ThumbH, ThumbW: Integer; +begin + inherited MouseMove(Shift, X, Y); + + case FDragKind of + DragVThumb: + begin + Bar := VBarRect; + TrackH := Bar.Bottom - Bar.Top; + ThumbH := VThumbRect.Bottom - VThumbRect.Top; + if TrackH > ThumbH then + SetTopLine(Round((Y - FDragOffset - Bar.Top) * MaxTopLine / + (TrackH - ThumbH))); + end; + DragHThumb: + begin + Bar := HBarRect; + TrackW := Bar.Right - Bar.Left; + ThumbW := HThumbRect.Right - HThumbRect.Left; + if TrackW > ThumbW then + SetLeftPx(Round((X - FDragOffset - Bar.Left) * MaxLeftPx / + (TrackW - ThumbW))); + end; + DragSelect: + begin + { Выделение за краем окна подматывает содержимое: иначе нельзя + выделить больше того, что видно. } + if Y < ContentRect.Top then + SetTopLine(FTopLine - 1) + else if Y > ContentRect.Bottom then + SetTopLine(FTopLine + 1); + FSelTo := PointToCell(X, Y); + Invalidate; + end; + end; +end; + +procedure TLogView.MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + FDragKind := DragNone; + inherited MouseUp(Button, Shift, X, Y); +end; + +function TLogView.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; + MousePos: TPoint): Boolean; +begin + UpdateMetrics; + if ssShift in Shift then + begin + if WheelDelta > 0 then + SetLeftPx(FLeftPx - WheelChars * FCharWidth) + else + SetLeftPx(FLeftPx + WheelChars * FCharWidth); + end + else + begin + if WheelDelta > 0 then + SetTopLine(FTopLine - WheelLines) + else + SetTopLine(FTopLine + WheelLines); + end; + Result := True; +end; + +procedure TLogView.KeyDown(var Key: Word; Shift: TShiftState); +begin + inherited KeyDown(Key, Shift); + if ssCtrl in Shift then + begin + case Key of + VK_C: + begin + CopyToClipboard; + Key := 0; + end; + VK_A: + begin + SelectAll; + Key := 0; + end; + end; + Exit; + end; + + case Key of + VK_UP: begin SetTopLine(FTopLine - 1); Key := 0; end; + VK_DOWN: begin SetTopLine(FTopLine + 1); Key := 0; end; + VK_PRIOR: begin SetTopLine(FTopLine - VisibleLines); Key := 0; end; + VK_NEXT: begin SetTopLine(FTopLine + VisibleLines); Key := 0; end; + end; +end; + +procedure TLogView.FontChanged(Sender: TObject); +begin + inherited FontChanged(Sender); + UpdateMetrics; + Invalidate; +end; + +procedure TLogView.Resize; +begin + inherited Resize; + if FFollowTail then + FTopLine := MaxTopLine; + Invalidate; +end; + +procedure TLogView.SelectAll; +begin + if FLines.Count = 0 then + Exit; + FSelFrom := Point(0, 0); + FSelTo := Point(UTF8Length(FLines[FLines.Count - 1]), FLines.Count - 1); + FHasSel := True; + Invalidate; +end; + +function TLogView.SelectedText: string; +var + A, B: TPoint; + I, StartCol, EndCol: Integer; + S: string; + Res: TStringList; +begin + Result := ''; + if not NormalizedSel(A, B) then + Exit; + + Res := TStringList.Create; + try + for I := A.Y to B.Y do + begin + if (I < 0) or (I >= FLines.Count) then + Continue; + S := FLines[I]; + if I = A.Y then + StartCol := A.X + else + StartCol := 0; + if I = B.Y then + EndCol := B.X + else + EndCol := UTF8Length(S); + if EndCol < StartCol then + EndCol := StartCol; + { Резать надо по знакам, а не по байтам: иначе кириллица развалится + пополам. } + Res.Add(UTF8Copy(S, StartCol + 1, EndCol - StartCol)); + end; + Result := Res.Text; + { TStringList.Text добавляет перевод строки в конце; для одной + выделенной строки он лишний. } + if (Res.Count = 1) and (Length(Result) >= Length(LineEnding)) then + SetLength(Result, Length(Result) - Length(LineEnding)); + finally + Res.Free; + end; +end; + +procedure TLogView.CopyToClipboard; +var + S: string; +begin + S := SelectedText; + { Ничего не выделено — берём весь журнал: чаще всего копировать хотят + именно его целиком. } + if S = '' then + S := FLines.Text; + if S <> '' then + Clipboard.AsText := S; +end; + +initialization + RegisterClass(TLogView); + +end. diff --git a/src/uMainForm.lfm b/src/uMainForm.lfm new file mode 100644 index 0000000..3e41355 --- /dev/null +++ b/src/uMainForm.lfm @@ -0,0 +1,196 @@ +object MainForm: TMainForm + Left = 160 + Height = 900 + Top = 80 + Width = 1600 + Caption = 'nlve' + ClientHeight = 900 + ClientWidth = 1600 + KeyPreview = True + OnCloseQuery = FormCloseQuery + OnCreate = FormCreate + OnDestroy = FormDestroy + OnKeyDown = FormKeyDown + OnShow = FormShow + LCLVersion = '4.6' + object pnlMenu: TPanel + Left = 0 + Height = 26 + Top = 0 + Width = 1600 + Align = alTop + BevelOuter = bvNone + TabOrder = 4 + end + object memoLog: TLogView + Left = 0 + Height = 130 + Top = 770 + Width = 1600 + Align = alBottom + Font.Height = -11 + Font.Name = 'Monospace' + ParentFont = False + TabOrder = 0 + end + object pnlBottom: TPanel + Left = 0 + Height = 40 + Top = 730 + Width = 1600 + Align = alBottom + BevelOuter = bvNone + ClientHeight = 40 + ClientWidth = 1600 + TabOrder = 1 + object lblTime: TLabel + Left = 12 + Height = 20 + Top = 10 + Width = 260 + Caption = '00:00:00.000 / 00:00:00.000' + Font.Height = -14 + Font.Name = 'Monospace' + ParentColor = False + ParentFont = False + end + object btnSnap: TThemedButton + Left = 290 + Height = 28 + Top = 6 + Width = 170 + Down = True + Caption = 'Прилипание: вкл' + OnClick = btnSnapClick + ShowHint = True + end + object btnRipple: TThemedButton + Left = 470 + Height = 28 + Top = 6 + Width = 280 + Caption = 'Схлопывание: текущая дорожка' + OnClick = btnRippleClick + ShowHint = True + end + object btnRippleMenu: TThemedButton + Left = 752 + Height = 28 + Top = 6 + Width = 26 + Arrow = True + OnClick = btnRippleMenuClick + end + object lblStatus: TLabel + Left = 790 + Height = 20 + Top = 10 + Width = 840 + Anchors = [akTop, akLeft, akRight] + AutoSize = False + Caption = 'Готов.' + ParentColor = False + end + end + object pnlLeft: TPanel + Left = 0 + Height = 730 + Top = 0 + Width = 420 + Align = alLeft + BevelOuter = bvNone + ClientHeight = 730 + ClientWidth = 420 + TabOrder = 2 + object lstPool: TListBox + Left = 0 + Height = 710 + Top = 0 + Width = 420 + Align = alClient + ItemHeight = 100 + OnClick = lstPoolClick + OnDrawItem = lstPoolDrawItem + Style = lbOwnerDrawFixed + TabOrder = 0 + end + object lblPoolInfo: TLabel + Left = 0 + Height = 20 + Top = 710 + Width = 420 + Align = alBottom + Caption = 'Файлов в проекте: 0' + ParentColor = False + end + end + object pnlMain: TPanel + Left = 420 + Height = 730 + Top = 0 + Width = 1180 + Align = alClient + BevelOuter = bvNone + ClientHeight = 730 + ClientWidth = 1180 + TabOrder = 3 + object pnlVideo: TPanel + Left = 0 + Height = 400 + Top = 0 + Width = 1180 + Align = alTop + BevelOuter = bvNone + Caption = '' + Color = clBlack + ParentColor = False + TabOrder = 0 + end + object splitVideo: TSplitter + Cursor = crVSplit + Left = 0 + Height = 6 + Top = 400 + Width = 1180 + Align = alTop + ResizeAnchor = akTop + end + object pnlTimelineHost: TPanel + Left = 0 + Height = 324 + Top = 406 + Width = 1180 + Align = alClient + BevelOuter = bvNone + Caption = '' + TabOrder = 1 + end + end + object OpenMediaDialog: TOpenDialog + Filter = 'Видео и картинки|*.mp4;*.MP4;*.mkv;*.MKV;*.mov;*.MOV;*.avi;*.AVI;*.png;*.PNG;*.jpg;*.JPG;*.jpeg;*.JPEG|Все файлы|*' + Options = [ofAllowMultiSelect, ofFileMustExist, ofEnableSizing, ofViewDetail] + Left = 1500 + Top = 16 + end + object OpenProjectDialog: TOpenDialog + DefaultExt = '.nlve' + Filter = 'Проект nlve|*.nlve|Все файлы|*' + Options = [ofFileMustExist, ofEnableSizing, ofViewDetail] + Left = 1500 + Top = 64 + end + object SaveProjectDialog: TSaveDialog + DefaultExt = '.nlve' + Filter = 'Проект nlve|*.nlve|Все файлы|*' + Options = [ofOverwritePrompt, ofPathMustExist, ofEnableSizing, ofViewDetail] + Left = 1500 + Top = 112 + end + object SaveExportDialog: TSaveDialog + DefaultExt = '.mkv' + Filter = 'Matroska|*.mkv|MP4|*.mp4|Все файлы|*' + Options = [ofOverwritePrompt, ofPathMustExist, ofEnableSizing, ofViewDetail] + Left = 1500 + Top = 160 + end +end diff --git a/src/uMainForm.pas b/src/uMainForm.pas new file mode 100644 index 0000000..a62332e --- /dev/null +++ b/src/uMainForm.pas @@ -0,0 +1,2378 @@ +{ + 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, uProgressForm, uRemuxForm, uMismatchForm, + uFfmpegJob, uSettings, uThumbs, uTransform, uPanCropForm, + uProjectInfoForm, ImgList, uTheme, uLogView, uDepsForm; + +type + + { TMainForm } + + TMainForm = class(TForm) + + btnSnap: TThemedButton; + btnRipple: TThemedButton; + btnRippleMenu: TThemedButton; + lblPoolInfo: TLabel; + lblStatus: TLabel; + lblTime: TLabel; + + lstPool: TListBox; + memoLog: TLogView; + OpenMediaDialog: TOpenDialog; + OpenProjectDialog: TOpenDialog; + pnlBottom: TPanel; + pnlMenu: TPanel; + pnlLeft: TPanel; + pnlMain: TPanel; + pnlTimelineHost: TPanel; + pnlVideo: TPanel; + SaveExportDialog: TSaveDialog; + SaveProjectDialog: TSaveDialog; + splitVideo: TSplitter; + procedure btnSnapClick(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); + procedure lstPoolClick(Sender: TObject); + 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; + FLastHwdec: string; + FLogFilePath: string; + FLogFileStarted: Boolean; + FLogFileBroken: Boolean; + { Списки полосы меню. Хранятся, чтобы искать по ним сочетания клавиш: + системной полосы меню нет, и форма сама их не найдёт. } + FMenus: TFPList; + FMenuX: Integer; + { Уплощённый монтаж, отданный плееру. Хранится, чтобы по времени + находить звучащий кусок и брать у него громкость. } + FPreviewSegments: TFlatSegmentArray; + FLastVolumeSent: Double; + + FGenerate: TGenerateThread; + FGenerateBusy: Boolean; + + FExport: TExportThread; + FExportUi: TProgressForm; + + FNormalize: TFfmpegJob; + FNormalizeUi: TProgressForm; + + FSettings: TSettings; + + FThumbs: TImageList; + FThumbThread: TThumbThread; + { Соответствие «путь к файлу -> номер картинки в списке изображений». + По пути, а не по номеру в списке проекта: пока миниатюра делается, + файлы могут добавиться или пропасть. Номер хранится увеличенным на + единицу, потому что ноль в Objects неотличим от «ничего нет». } + FThumbMap: TStringList; + + { Меню библиотеки и меню выбора режима схлопывания. } + FPoolMenu: TPopupMenu; + FPoolAddMenu: TMenuItem; + FRippleMenu: TPopupMenu; + { Пункт «Недавние проекты» в меню «Файл». Его содержимое собирается + заново при каждом изменении списка. } + FRecentMenu: TMenuItem; + + { Пока плеер не доехал до запрошенного места, его сообщения о позиции + игнорируются. Без этого перезагрузка предпросмотра после правки + сбрасывала бы курсор в начало. } + FSeekPending: Boolean; + FSeekTarget: Double; + { Сколько сообщений о позиции ждём прибытия, прежде чем сдаться. + + Без этого ограничения признак «ждём» мог зависнуть навсегда: если + после правки монтажа запрошенное время оказалось за его концом, + плеер туда никогда не доедет, и курсор переставал двигаться + совсем. } + FSeekWaitTicks: Integer; + + procedure ApplyVolumeAt(const ATime: Double); + procedure UpdateRippleButton; + procedure UpdateSnapButton; + 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 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 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 MenuBarClick(Sender: TObject); + procedure FormShortCut(var Msg: TLMKey; var Handled: Boolean); + procedure BuildTimeline; + procedure StartPlayer; + 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: TFlatSegmentArray); + 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 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 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 := ExtractFilePath(ExpandFileName(ParamStr(0))) + '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; + UpdateCaption; + SetStatus('Готов. Добавьте файлы в проект.'); + + { Цвета задаём сами: системная тема может быть светлой, и тогда тёмный + таймлайн оказался бы в белой рамке. Вызов идёт последним — меню и + всплывающие меню строятся выше по ходу, и раньше их не существует. } + ApplyDarkTheme(Self); +end; + +procedure TMainForm.FormDestroy(Sender: TObject); +begin + FPreviewTimer.Enabled := False; + if Assigned(FThumbThread) then + begin + { Поток обращается к форме через Synchronize, поэтому дожидаться его + обязательно: иначе он попробует достучаться до уже разрушенного окна. } + FThumbThread.Terminate; + FThumbThread.WaitFor; + FreeAndNil(FThumbThread); + end; + FreeAndNil(FThumbMap); + CollectSettings; + FSettings.Save; + FreeAndNil(FSettings); + FreeAndNil(FPlayer); + UnloadMpvLib; + FreeAndNil(FProject); + { Сами списки принадлежат форме и уничтожатся с ней; здесь только + перечень ссылок на них. } + FreeAndNil(FMenus); +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; + + { Режим схлопывания и его состояние переживают перезапуск. } + if FSettings.RippleAllTracks then + FProject.RippleMode := rmAllTracks + else + FProject.RippleMode := rmCurrentTrack; + FProject.RippleEnabled := FSettings.RippleEnabled; + + { Каталоги подставляем в диалоги, чтобы не искать одно и то же место + заново при каждом запуске. } + 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.RippleAllTracks := FProject.RippleMode = rmAllTracks; + FSettings.RippleEnabled := FProject.RippleEnabled; +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.OnTrackAdded := @TimelineTrackAdded; + FTimeline.OnActiveTrackChange := @TimelineActiveTrackChange; +end; + +{ Меню строится кодом: в файле формы оно заняло бы сотню строк описания + вложенных пунктов, где легко ошибиться и трудно что-то найти. + + Полоса меню тоже своя, из обычных кнопок, а не системная. Причина одна: + системную полосу рисует Windows, и её светлый фон нашим цветом не + закрашивается — SetMenuInfo меняет подложку пунктов, но не саму полосу. + Сочетания клавиш от этого не теряются: их ищет TMenu.IsShortCut, и + вызвать его можно самим, что и делает FormShortCut. + + Ценой отказа от системной полосы становится переход по меню клавишей + Alt — его больше нет. Сочетания клавиш работают все. } +procedure TMainForm.BuildMenu; + + function AddTop(const ACaption: string): TMenuItem; + var + Popup: TPopupMenu; + Btn: TThemedButton; + W: Integer; + begin + Popup := TPopupMenu.Create(Self); + FMenus.Add(Popup); + + Btn := TThemedButton.Create(Self); + Btn.Parent := pnlMenu; + W := pnlMenu.Canvas.TextWidth(ACaption) + 24; + Btn.SetBounds(FMenuX, 0, W, pnlMenu.ClientHeight); + Btn.Caption := ACaption; + { Фокус кнопкам меню не нужен: по ним щёлкают, а обходить их клавишей + Tab при работе с монтажом только мешает. } + Btn.TabStop := False; + Btn.Flat := True; + Btn.Tag := FMenus.Count - 1; + Btn.OnClick := @MenuBarClick; + Inc(FMenuX, W); + + Result := Popup.Items; + end; + + procedure AddItem(AParent: TMenuItem; const ACaption: string; + AHandler: TNotifyEvent; AShortCut: TShortCut = 0); + var + Item: TMenuItem; + begin + Item := TMenuItem.Create(Self); + Item.Caption := ACaption; + Item.OnClick := AHandler; + Item.ShortCut := AShortCut; + AParent.Add(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: TMenuItem; +begin + FMenus := TFPList.Create; + FMenuX := 4; + OnShortCut := @FormShortCut; + + 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, 'Перепаковка файлов...', @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])); + 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])); + + MProject := AddTop('Проект'); + AddItem(MProject, 'Сведения о проекте...', @MenuProjectInfo); + AddSep(MProject); + AddItem(MProject, 'Добавить дорожку', @MenuAddTrack); + AddItem(MProject, 'Удалить последнюю дорожку', @MenuRemoveTrack); +end; + +{ Щелчок по названию в полосе меню раскрывает соответствующий список. } +procedure TMainForm.MenuBarClick(Sender: TObject); +var + Btn: TThemedButton; + Popup: TPopupMenu; + P: TPoint; +begin + Btn := Sender as TThemedButton; + if (Btn.Tag < 0) or (Btn.Tag >= FMenus.Count) then + Exit; + Popup := TPopupMenu(FMenus[Btn.Tag]); + ApplyDarkMenu(Popup); + P := Btn.ClientToScreen(Point(0, Btn.Height)); + Popup.PopUp(P.X, P.Y); +end; + +{ Сочетания клавиш ищем сами: системной полосы меню больше нет, а значит + форма их сама не найдёт. } +procedure TMainForm.FormShortCut(var Msg: TLMKey; var Handled: Boolean); +var + I: Integer; +begin + for I := 0 to FMenus.Count - 1 do + if TPopupMenu(FMenus[I]).IsShortCut(Msg) then + begin + Handled := True; + Exit; + end; +end; + +procedure TMainForm.FormShow(Sender: TObject); +var + I: Integer; + Added: Boolean; + Err: string; +begin + if FStarted then + Exit; + FStarted := True; + + StartPlayer; + + { Файлы из командной строки попадают в список проекта. Так на программу + можно перетащить файлы из файлового менеджера. + + Файл проекта — особый случай: его надо открыть, а не пытаться + разобрать как видео. } + 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; + +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; +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.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.TrackCount + 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; + FProject.AddClip(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: TFlatSegmentArray; + Missing: TGenRequests; +begin + if (FPlayer = nil) or (not FPlayer.Initialized) then + Exit; + if FGenerateBusy then + begin + { Пока идёт создание вставок, пересборку откладываем: иначе запустим + второй такой же поток. } + FPreviewDirty := True; + FPreviewTimer.Enabled := True; + Exit; + end; + + if not FlattenProject(FProject, Segments, Missing) then + begin + FPlayer.Stop; + FLastLoadedEdl := ''; + UpdateTimeLabel; + Exit; + end; + + if Length(Missing) > 0 then + begin + FGenerateBusy := True; + SetStatus('Готовлю вставки для предпросмотра...'); + FGenerate := TGenerateThread.Create(Missing, FProject.Master); + FGenerate.OnProgress := @GenerateProgress; + FGenerate.OnLog := @GenerateLog; + FGenerate.OnTerminate := @GenerateDone; + FGenerate.Start; + Exit; + end; + + LoadPreviewEdl(Segments); +end; + +procedure TMainForm.LoadPreviewEdl(const ASegments: TFlatSegmentArray); +var + Edl: string; + Pos, Total: Double; + WasPaused: Boolean; +begin + { Кадр проекта задаётся до загрузки: mpv должен показывать то, что + получится в готовом ролике, а не размер очередного исходника. Файл + другого соотношения сторон иначе выглядел бы в предпросмотре во весь + экран, а в ролике — с полями по краям. } + ApplyPreviewFrame; + + Edl := BuildEdlUri(ASegments); + { Список кусков запоминаем всегда, даже если строка не изменилась: + громкость в неё не входит, а брать её потом неоткуда. } + FPreviewSegments := ASegments; + FLastVolumeSent := -1; + if Edl = FLastLoadedEdl then + Exit; + + Pos := FTimeline.Playhead; + { Курсор мог оказаться за концом монтажа, если правка его укоротила. + Просить у плеера несуществующее время бессмысленно. } + Total := TotalDuration(ASegments); + if Pos > Total then + Pos := Max(0, Total - 0.05); + WasPaused := FPlayer.Paused; + + { Позиция и состояние паузы задаются прямо при загрузке, а не отдельной + перемоткой следом. Иначе mpv успевает начать с нуля, и на каждой + правке монтажа слышен и виден кусок не оттуда. } + FPlayer.LoadUrl(Edl, Format('start=%s,pause=%s', + [SecondsToStr(Pos), BoolToStr(WasPaused, 'yes', 'no')])); + FLastLoadedEdl := Edl; + + { Пока плеер не доедет, его сообщения о позиции игнорируются — иначе + курсор на монтаже прыгнул бы в начало при каждой правке. } + 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.Caption := 'Схлопывание: ' + ModeText; + btnRipple.Down := FProject.RippleEnabled; + btnRipple.Hint := 'Ctrl+K — включить или выключить. ' + + 'Режим действует и при выключенном автосхлопывании: по нему работает Ctrl+Shift+R.'; +end; + +{ Прилипание краёв клипов друг к другу. + + Shift работает как переключатель наоборот: при включённом прилипании + временно отключает его, при выключенном — временно включает. Так одна + клавиша полезна в обоих режимах, и не нужно помнить, какой сейчас. } +procedure TMainForm.UpdateSnapButton; +begin + btnSnap.Down := FTimeline.SnapEnabled; + if FTimeline.SnapEnabled then + btnSnap.Caption := 'Прилипание: вкл' + else + btnSnap.Caption := 'Прилипание: выкл'; + btnSnap.Hint := 'Shift во время перетаскивания меняет решение на противоположное.'; +end; + +procedure TMainForm.btnSnapClick(Sender: TObject); +begin + FTimeline.SnapEnabled := not FTimeline.SnapEnabled; + UpdateSnapButton; +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.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.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.ApplyVolumeAt(const ATime: Double); +var + I: Integer; + Acc, Vol: Double; +begin + if (FPlayer = nil) or (not FPlayer.Initialized) then + Exit; + if Length(FPreviewSegments) = 0 then + Exit; + + Vol := 1; + Acc := 0; + for I := 0 to High(FPreviewSegments) do + begin + if (ATime >= Acc) and (ATime < Acc + FPreviewSegments[I].Duration) then + begin + Vol := FPreviewSegments[I].Volume; + Break; + end; + Acc := Acc + FPreviewSegments[I].Duration; + end; + + if Abs(Vol - FLastVolumeSent) < 0.001 then + Exit; + FLastVolumeSent := Vol; + FPlayer.SetVolume(Vol * 100); +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); +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.MenuSelectAll(Sender: TObject); +begin + FTimeline.SelectAll; +end; + +procedure TMainForm.MenuRipple(Sender: TObject); +begin + FTimeline.RippleCloseGap; +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.TrackCount + 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); +var + Segments: TFlatSegmentArray; + Missing: TGenRequests; + HasPrecise: Boolean; + T, C: Integer; +begin + if not FlattenProject(FProject, Segments, Missing) then + begin + ThemedMessageDlg('nlve', 'На монтаже нечего собирать.', mtInformation, [mbOK], 0); + Exit; + end; + + if Length(Missing) > 0 then + begin + ThemedMessageDlg('nlve', + 'Ещё не готовы вставки для картинок или пустых мест. ' + + 'Подождите, пока они создадутся, и повторите.', + mtInformation, [mbOK], 0); + SchedulePreview; + Exit; + end; + + { Если есть хоть один точный рез, предупреждаем про контейнер: в 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 HasPrecise then + begin + SaveExportDialog.DefaultExt := '.mkv'; + SaveExportDialog.FileName := 'ролик.mkv'; + end + else + begin + SaveExportDialog.DefaultExt := '.mp4'; + SaveExportDialog.FileName := 'ролик.mp4'; + end; + + if not SaveExportDialog.Execute then + Exit; + FSettings.LastExportDir := ExtractFilePath(SaveExportDialog.FileName); + + if HasPrecise and (LowerCase(ExtractFileExt(SaveExportDialog.FileName)) <> '.mkv') then + if ThemedMessageDlg('nlve', + 'В монтаже есть точные резы. В MP4 перекодированный стык может ' + + 'воспроизводиться неправильно — надёжнее MKV.' + LineEnding + + LineEnding + 'Всё равно собрать в выбранный контейнер?', + mtWarning, [mbYes, mbNo], 0) <> mrYes then + Exit; + + Log('Сборка в ' + SaveExportDialog.FileName); + Log(Format('%d %s, длительность %s с', + [Length(Segments), Plural(Length(Segments), 'кусок', 'куска', 'кусков'), + SecondsToStr(TotalDuration(Segments))])); + + FExport := TExportThread.Create(Segments, SaveExportDialog.FileName, True, FProject.Master); + 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. diff --git a/src/uMediaProbe.pas b/src/uMediaProbe.pas new file mode 100644 index 0000000..8d10cb9 --- /dev/null +++ b/src/uMediaProbe.pas @@ -0,0 +1,453 @@ +{ + uMediaProbe — что за файл нам дали. + + Опрашивает ffprobe и раскладывает ответ в запись. Нужно для двух вещей: + чтобы знать длительность и параметры при добавлении файла, и чтобы + сравнить их с параметрами проекта. + + Зачем сравнивать. Склейка без перекодирования возможна только тогда, + когда у кусков совпадают кодек, разрешение, формат пикселей и параметры + звука. Не совпали — либо перекодировать файл один раз при добавлении, + либо перекодировать весь результат при сборке. Предупредить об этом надо + в момент, когда файл кладут на монтаж, а не когда через час выясняется, + что собрать нельзя. + + Отдельно считаются «лишние» потоки. Камеры вроде DJI кладут в файл + телеметрию и MJPEG-обложку: на монтаж они не влияют, но пользователю + стоит знать, что они будут отброшены. +} +unit uMediaProbe; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, uAppTypes; + +type + TMediaKind = (mkUnknown, mkVideo, mkImage); + + TMediaInfo = record + Valid: Boolean; + Kind: TMediaKind; + FormatName: string; + Duration: Double; + + HasVideo: Boolean; + VideoCodec: string; + VideoProfile: string; + PixFmt: string; + Width: Integer; + Height: Integer; + FpsNum: Integer; + FpsDen: Integer; + VideoBitrate: Int64; + + HasAudio: Boolean; + AudioCodec: string; + SampleRate: Integer; + Channels: Integer; + ChannelLayout: string; + AudioBitrate: Int64; + + { Потоки сверх первой видеодорожки и первой звуковой: телеметрия, + обложки, дополнительные дорожки. При сборке они отбрасываются. } + ExtraStreams: Integer; + end; + + { Одно расхождение с параметрами проекта. } + TMismatch = record + What: string; + Expected: string; + Actual: string; + { True означает, что при этом расхождении куски нельзя склеить + копированием и файл придётся перекодировать. } + Blocking: Boolean; + end; + + TMismatches = array of TMismatch; + +{ Опрашивает ffprobe. Вызывать из рабочего потока: на медленном носителе + ответ может прийти не сразу. } +function ProbeMedia(const APath: string; out AInfo: TMediaInfo; + out AError: string): Boolean; + +{ Кадров в секунду одним числом. Ноль, если частота неизвестна. } +function FpsValue(const AInfo: TMediaInfo): Double; + +{ Человекочитаемое описание для списка файлов. } +function DescribeMedia(const AInfo: TMediaInfo): string; + +{ Сравнивает файл с параметрами проекта. Пустой результат — расхождений нет. } +function CompareToMaster(const AMaster, AInfo: TMediaInfo): TMismatches; + +{ Есть ли среди расхождений препятствующие копированию потоков. } +function HasBlocking(const AMismatches: TMismatches): Boolean; + +implementation + +uses + fpjson, jsonparser, jsonscanner, uFfmpegCmd, uProcRunner; + +type + { Собирает весь вывод ffprobe: ответ приходит одним куском JSON, разбирать + его построчно бессмысленно. } + TJsonCollector = class + private + FText: string; + public + procedure Line(const ALine: string); + property Text: string read FText; + end; + +procedure TJsonCollector.Line(const ALine: string); +begin + FText := FText + ALine + LineEnding; +end; + +function JsonStr(AObj: TJSONObject; const AName: string; + const ADefault: string = ''): string; +var + D: TJSONData; +begin + Result := ADefault; + if AObj = nil then + Exit; + D := AObj.Find(AName); + if (D <> nil) and (D.JSONType <> jtNull) then + Result := D.AsString; +end; + +function JsonInt(AObj: TJSONObject; const AName: string; + ADefault: Integer = 0): Integer; +var + S: string; +begin + S := JsonStr(AObj, AName, ''); + if not TryStrToInt(S, Result) then + Result := ADefault; +end; + +function JsonInt64(AObj: TJSONObject; const AName: string; + ADefault: Int64 = 0): Int64; +var + S: string; +begin + S := JsonStr(AObj, AName, ''); + if not TryStrToInt64(S, Result) then + Result := ADefault; +end; + +function JsonFloat(AObj: TJSONObject; const AName: string; + ADefault: Double = 0): Double; +var + S: string; +begin + S := JsonStr(AObj, AName, ''); + { ffprobe всегда печатает числа с точкой, поэтому разбираем без + оглядки на локаль. } + if not TryStrToFloat(S, Result, InvariantFormat) then + Result := ADefault; +end; + +{ Разбирает дробь вида 60000/1001. } +procedure ParseRational(const AValue: string; out ANum, ADen: Integer); +var + P: Integer; +begin + ANum := 0; + ADen := 0; + P := Pos('/', AValue); + if P <= 0 then + begin + if TryStrToInt(AValue, ANum) then + ADen := 1; + Exit; + end; + if not TryStrToInt(Copy(AValue, 1, P - 1), ANum) then + ANum := 0; + if not TryStrToInt(Copy(AValue, P + 1, Length(AValue) - P), ADen) then + ADen := 0; +end; + +{ Кодеки, которые ffprobe показывает как видео, но которые на деле + являются картинкой. } +function IsStillImageCodec(const ACodec: string): Boolean; +begin + Result := (ACodec = 'png') or (ACodec = 'mjpeg') or (ACodec = 'bmp') or + (ACodec = 'webp') or (ACodec = 'tiff') or (ACodec = 'gif'); +end; + +function ProbeMedia(const APath: string; out AInfo: TMediaInfo; + out AError: string): Boolean; +var + Collector: TJsonCollector; + Res: TProcResult; + Parser: TJSONParser; + Root: TJSONData; + Obj, Stream, Format: TJSONObject; + Streams: TJSONArray; + I: Integer; + CodecType, Ext: string; + VideoTaken, AudioTaken: Boolean; +begin + Result := False; + AError := ''; + { Не FillChar: в записи есть строки, и побайтное обнуление их указателей + привело бы к утечке. } + AInfo := Default(TMediaInfo); + AInfo.Kind := mkUnknown; + + if not FileExists(APath) then + begin + AError := 'Файл не найден: ' + APath; + Exit; + end; + if FfprobeExe = '' then + begin + AError := 'ffprobe не найден в PATH.'; + Exit; + end; + + Collector := TJsonCollector.Create; + try + Res := RunProcess(FfprobeExe, ArgsProbeJson(APath), @Collector.Line, nil, nil); + if not Res.Started then + begin + AError := Res.ErrorText; + Exit; + end; + if Res.ExitCode <> 0 then + begin + AError := 'ffprobe завершился с кодом ' + IntToStr(Res.ExitCode) + + '. Похоже, формат файла не распознан.'; + Exit; + end; + + Parser := TJSONParser.Create(Collector.Text, [joUTF8]); + try + try + Root := Parser.Parse; + except + on E: Exception do + begin + AError := 'Не удалось разобрать ответ ffprobe: ' + E.Message; + Exit; + end; + end; + finally + Parser.Free; + end; + finally + Collector.Free; + end; + + if (Root = nil) or (not (Root is TJSONObject)) then + begin + AError := 'Ответ ffprobe пуст.'; + Root.Free; + Exit; + end; + + try + Obj := TJSONObject(Root); + + Format := Obj.Find('format', jtObject) as TJSONObject; + AInfo.FormatName := JsonStr(Format, 'format_name'); + AInfo.Duration := JsonFloat(Format, 'duration', 0); + + Streams := Obj.Find('streams', jtArray) as TJSONArray; + VideoTaken := False; + AudioTaken := False; + + if Streams <> nil then + for I := 0 to Streams.Count - 1 do + begin + if not (Streams.Items[I] is TJSONObject) then + Continue; + Stream := TJSONObject(Streams.Items[I]); + CodecType := JsonStr(Stream, 'codec_type'); + + if (CodecType = 'video') and (not VideoTaken) then + begin + VideoTaken := True; + AInfo.HasVideo := True; + AInfo.VideoCodec := JsonStr(Stream, 'codec_name'); + AInfo.VideoProfile := JsonStr(Stream, 'profile'); + AInfo.PixFmt := JsonStr(Stream, 'pix_fmt'); + AInfo.Width := JsonInt(Stream, 'width'); + AInfo.Height := JsonInt(Stream, 'height'); + ParseRational(JsonStr(Stream, 'r_frame_rate', '0/0'), + AInfo.FpsNum, AInfo.FpsDen); + AInfo.VideoBitrate := JsonInt64(Stream, 'bit_rate'); + end + else if (CodecType = 'audio') and (not AudioTaken) then + begin + AudioTaken := True; + AInfo.HasAudio := True; + AInfo.AudioCodec := JsonStr(Stream, 'codec_name'); + AInfo.SampleRate := JsonInt(Stream, 'sample_rate'); + AInfo.Channels := JsonInt(Stream, 'channels'); + AInfo.ChannelLayout := JsonStr(Stream, 'channel_layout'); + AInfo.AudioBitrate := JsonInt64(Stream, 'bit_rate'); + end + else + Inc(AInfo.ExtraStreams); + end; + + { Картинка от видео отличается не кодеком, а отсутствием длительности: + у PNG кодек png, но и одиночный кадр внутри MP4 бывает mjpeg. + Опираемся на расширение и на нулевую длительность. } + Ext := LowerCase(ExtractFileExt(APath)); + if (Ext = '.png') or (Ext = '.jpg') or (Ext = '.jpeg') or + (Ext = '.bmp') or (Ext = '.webp') then + AInfo.Kind := mkImage + else if AInfo.HasVideo and (AInfo.Duration <= 0) and + IsStillImageCodec(AInfo.VideoCodec) then + AInfo.Kind := mkImage + else if AInfo.HasVideo or AInfo.HasAudio then + AInfo.Kind := mkVideo; + + if AInfo.Kind = mkUnknown then + begin + AError := 'В файле нет ни видео, ни звука.'; + Exit; + end; + + AInfo.Valid := True; + Result := True; + finally + Root.Free; + end; +end; + +function FpsValue(const AInfo: TMediaInfo): Double; +begin + if (AInfo.FpsDen = 0) or (AInfo.FpsNum = 0) then + Exit(0); + Result := AInfo.FpsNum / AInfo.FpsDen; +end; + +function DescribeMedia(const AInfo: TMediaInfo): string; +var + Fps: Double; +begin + if not AInfo.Valid then + Exit('нет сведений'); + + if AInfo.Kind = mkImage then + Exit(Format('картинка %dx%d', [AInfo.Width, AInfo.Height])); + + Result := ''; + if AInfo.HasVideo then + begin + Result := Format('%s %dx%d', [AInfo.VideoCodec, AInfo.Width, AInfo.Height]); + Fps := FpsValue(AInfo); + if Fps > 0 then + Result := Result + Format(' %.3f к/с', [Fps]); + end; + + if AInfo.HasAudio then + begin + if Result <> '' then + Result := Result + ', '; + Result := Result + Format('%s %d Гц %d кан.', + [AInfo.AudioCodec, AInfo.SampleRate, AInfo.Channels]); + end + else + begin + if Result <> '' then + Result := Result + ', '; + Result := Result + 'без звука'; + end; + + if AInfo.ExtraStreams > 0 then + Result := Result + Format(', +%d лишн. потоков', [AInfo.ExtraStreams]); +end; + +procedure AddMismatch(var A: TMismatches; const AWhat, AExpected, AActual: string; + ABlocking: Boolean); +var + N: Integer; +begin + N := Length(A); + SetLength(A, N + 1); + A[N].What := AWhat; + A[N].Expected := AExpected; + A[N].Actual := AActual; + A[N].Blocking := ABlocking; +end; + +function CompareToMaster(const AMaster, AInfo: TMediaInfo): TMismatches; +var + MasterFps, InfoFps: Double; +begin + Result := nil; + MasterFps := 0; + InfoFps := 0; + if (not AMaster.Valid) or (not AInfo.Valid) then + Exit; + + { Картинки сравнивать с видео бессмысленно: под них всё равно + генерируется отдельный клип в параметрах проекта. } + if AInfo.Kind = mkImage then + Exit; + + if AMaster.HasVideo and AInfo.HasVideo then + begin + if AMaster.VideoCodec <> AInfo.VideoCodec then + AddMismatch(Result, 'Кодек видео', AMaster.VideoCodec, AInfo.VideoCodec, True); + + if (AMaster.Width <> AInfo.Width) or (AMaster.Height <> AInfo.Height) then + AddMismatch(Result, 'Разрешение', + Format('%dx%d', [AMaster.Width, AMaster.Height]), + Format('%dx%d', [AInfo.Width, AInfo.Height]), True); + + if AMaster.PixFmt <> AInfo.PixFmt then + AddMismatch(Result, 'Формат пикселей', AMaster.PixFmt, AInfo.PixFmt, True); + + if AMaster.VideoProfile <> AInfo.VideoProfile then + { Профиль кодека сам по себе склейку не ломает, но о нём стоит знать: + разные профили декодируются по-разному на слабой технике. } + AddMismatch(Result, 'Профиль', AMaster.VideoProfile, AInfo.VideoProfile, False); + + MasterFps := FpsValue(AMaster); + InfoFps := FpsValue(AInfo); + if (MasterFps > 0) and (InfoFps > 0) and (Abs(MasterFps - InfoFps) > 0.001) then + AddMismatch(Result, 'Частота кадров', + Format('%.3f', [MasterFps]), Format('%.3f', [InfoFps]), True); + end + else if AMaster.HasVideo <> AInfo.HasVideo then + AddMismatch(Result, 'Видеодорожка', + BoolToStr(AMaster.HasVideo, 'есть', 'нет'), + BoolToStr(AInfo.HasVideo, 'есть', 'нет'), True); + + if AMaster.HasAudio and AInfo.HasAudio then + begin + if AMaster.AudioCodec <> AInfo.AudioCodec then + AddMismatch(Result, 'Кодек звука', AMaster.AudioCodec, AInfo.AudioCodec, True); + if AMaster.SampleRate <> AInfo.SampleRate then + AddMismatch(Result, 'Частота дискретизации', + IntToStr(AMaster.SampleRate), IntToStr(AInfo.SampleRate), True); + if AMaster.Channels <> AInfo.Channels then + AddMismatch(Result, 'Каналов звука', + IntToStr(AMaster.Channels), IntToStr(AInfo.Channels), True); + end + else if AMaster.HasAudio <> AInfo.HasAudio then + AddMismatch(Result, 'Звуковая дорожка', + BoolToStr(AMaster.HasAudio, 'есть', 'нет'), + BoolToStr(AInfo.HasAudio, 'есть', 'нет'), True); +end; + +function HasBlocking(const AMismatches: TMismatches): Boolean; +var + I: Integer; +begin + for I := 0 to High(AMismatches) do + if AMismatches[I].Blocking then + Exit(True); + Result := False; +end; + +end. diff --git a/src/uMismatchForm.lfm b/src/uMismatchForm.lfm new file mode 100644 index 0000000..027c6c3 --- /dev/null +++ b/src/uMismatchForm.lfm @@ -0,0 +1,100 @@ +object MismatchForm: TMismatchForm + Left = 360 + Height = 470 + Top = 240 + Width = 860 + BorderIcons = [biSystemMenu] + Caption = 'Файл не совпадает с проектом' + ClientHeight = 470 + ClientWidth = 860 + OnCreate = FormCreate + Position = poOwnerFormCenter + LCLVersion = '4.6' + object pnlTop: TPanel + Left = 0 + Height = 56 + Top = 0 + Width = 860 + Align = alTop + BevelOuter = bvNone + ClientHeight = 56 + ClientWidth = 860 + TabOrder = 0 + object lblHead: TLabel + Left = 12 + Height = 36 + Top = 12 + Width = 836 + Anchors = [akTop, akLeft, akRight] + AutoSize = False + Caption = 'Файл не совпадает с параметрами проекта.' + Font.Style = [fsBold] + ParentColor = False + ParentFont = False + WordWrap = True + end + end + object grid: TStringGrid + Left = 0 + Height = 244 + Top = 56 + Width = 860 + Align = alClient + ColCount = 4 + FixedCols = 0 + Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goSmoothScroll] + RowCount = 1 + TabOrder = 1 + end + object pnlBottom: TPanel + Left = 0 + Height = 170 + Top = 300 + Width = 860 + Align = alBottom + BevelOuter = bvNone + ClientHeight = 170 + ClientWidth = 860 + TabOrder = 2 + object lblTail: TLabel + Left = 12 + Height = 66 + Top = 10 + Width = 836 + Anchors = [akTop, akLeft, akRight] + AutoSize = False + Caption = '...' + ParentColor = False + WordWrap = True + end + object btnNormalize: TThemedButton + Left = 12 + Height = 34 + Top = 90 + Width = 320 + Caption = 'Привести к параметрам проекта' + OnClick = btnNormalizeClick + TabOrder = 0 + end + object btnAsIs: TThemedButton + Left = 344 + Height = 34 + Top = 90 + Width = 380 + Caption = 'Добавить как есть' + OnClick = btnAsIsClick + TabOrder = 1 + end + object btnCancel: TThemedButton + Left = 736 + Height = 34 + Top = 90 + Width = 112 + Anchors = [akTop, akRight] + Cancel = True + Caption = 'Отмена' + OnClick = btnCancelClick + TabOrder = 2 + end + end +end diff --git a/src/uMismatchForm.pas b/src/uMismatchForm.pas new file mode 100644 index 0000000..7993151 --- /dev/null +++ b/src/uMismatchForm.pas @@ -0,0 +1,166 @@ +{ + uMismatchForm — предупреждение о том, что файл не совпадает с проектом. + + Показывается в момент, когда файл кладут на монтаж, а не когда его + добавляют в проект: до попадания на монтаж он ни с чем не склеивается, + и повода тревожить пользователя нет. + + Три исхода: + + «Добавить как есть» — клип помечается, и при сборке ролика его придётся + перекодировать. Быстро сейчас, медленно потом. + + «Привести к проекту» — файл один раз перекодируется в параметры проекта, + дальше всё копируется. Медленно сейчас, быстро потом и всегда. + + «Отмена» — не добавлять. +} +unit uMismatchForm; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Forms, Controls, Graphics, StdCtrls, Grids, ExtCtrls, + uMediaProbe, uTheme; + +type + TMismatchChoice = (mcCancel, mcAsIs, mcNormalize); + + { TMismatchForm } + + TMismatchForm = class(TForm) + btnAsIs: TThemedButton; + btnCancel: TThemedButton; + btnNormalize: TThemedButton; + grid: TStringGrid; + lblHead: TLabel; + lblTail: TLabel; + pnlBottom: TPanel; + pnlTop: TPanel; + procedure btnAsIsClick(Sender: TObject); + procedure btnCancelClick(Sender: TObject); + procedure btnNormalizeClick(Sender: TObject); + procedure FormCreate(Sender: TObject); + private + FChoice: TMismatchChoice; + public + procedure Fill(const AFileName: string; const AMismatches: TMismatches); + property Choice: TMismatchChoice read FChoice; + end; + +{ Показывает диалог и возвращает решение пользователя. } +function AskAboutMismatch(AOwner: TComponent; const AFileName: string; + const AMismatches: TMismatches): TMismatchChoice; + +implementation + +{$R *.lfm} + +const + ColWhat = 0; + ColExpected = 1; + ColActual = 2; + ColEffect = 3; + +{ TMismatchForm } + +procedure TMismatchForm.FormCreate(Sender: TObject); +begin + { Цвета задаём сами: системная тема может быть светлой, и тогда + тёмный таймлайн оказался бы в белой рамке. } + ApplyDarkTheme(Self); + FChoice := mcCancel; + grid.ColCount := 4; + grid.RowCount := 1; + grid.FixedRows := 1; + grid.Cells[ColWhat, 0] := 'Параметр'; + grid.Cells[ColExpected, 0] := 'В проекте'; + grid.Cells[ColActual, 0] := 'В файле'; + grid.Cells[ColEffect, 0] := 'Последствие'; + grid.ColWidths[ColWhat] := 200; + grid.ColWidths[ColExpected] := 170; + grid.ColWidths[ColActual] := 170; + grid.ColWidths[ColEffect] := 260; +end; + +procedure TMismatchForm.Fill(const AFileName: string; + const AMismatches: TMismatches); +var + I: Integer; + Blocking: Boolean; +begin + lblHead.Caption := 'Файл ' + ExtractFileName(AFileName) + + ' не совпадает с параметрами проекта.'; + + grid.RowCount := Length(AMismatches) + 1; + for I := 0 to High(AMismatches) do + begin + grid.Cells[ColWhat, I + 1] := AMismatches[I].What; + grid.Cells[ColExpected, I + 1] := AMismatches[I].Expected; + grid.Cells[ColActual, I + 1] := AMismatches[I].Actual; + if AMismatches[I].Blocking then + grid.Cells[ColEffect, I + 1] := 'склейка без перекодирования невозможна' + else + grid.Cells[ColEffect, I + 1] := 'к сведению'; + end; + + Blocking := HasBlocking(AMismatches); + if Blocking then + lblTail.Caption := + 'Куски этого файла нельзя будет скопировать — при сборке они будут ' + + 'пересобраны. Пересобираются только они: остальной материал ' + + 'по-прежнему копируется без потерь и почти мгновенно.' + LineEnding + + 'Приведение файла к параметрам проекта делает ту же работу один раз ' + + 'сейчас, зато каждая последующая сборка остаётся быстрой.' + else + lblTail.Caption := + 'Эти расхождения склейке не мешают — они приведены для сведения.'; + + { Приводить к проекту имеет смысл только тогда, когда есть что приводить. } + btnNormalize.Enabled := Blocking; + if Blocking then + btnAsIs.Caption := 'Добавить как есть (пересобирать его куски при сборке)' + else + btnAsIs.Caption := 'Добавить'; +end; + +procedure TMismatchForm.btnAsIsClick(Sender: TObject); +begin + FChoice := mcAsIs; + ModalResult := mrOK; +end; + +procedure TMismatchForm.btnNormalizeClick(Sender: TObject); +begin + FChoice := mcNormalize; + ModalResult := mrOK; +end; + +procedure TMismatchForm.btnCancelClick(Sender: TObject); +begin + FChoice := mcCancel; + ModalResult := mrCancel; +end; + +function AskAboutMismatch(AOwner: TComponent; const AFileName: string; + const AMismatches: TMismatches): TMismatchChoice; +var + Form: TMismatchForm; +begin + { Расхождений нет — спрашивать не о чем. } + if Length(AMismatches) = 0 then + Exit(mcAsIs); + + Form := TMismatchForm.Create(AOwner); + try + Form.Fill(AFileName, AMismatches); + Form.ShowModal; + Result := Form.Choice; + finally + Form.Free; + end; +end; + +end. diff --git a/src/uMpvLib.pas b/src/uMpvLib.pas new file mode 100644 index 0000000..30b2606 --- /dev/null +++ b/src/uMpvLib.pas @@ -0,0 +1,314 @@ +{ + uMpvLib — объявления клиентского API libmpv для FPC. + + Объявления сняты с оригинального заголовка mpv 0.37.0 + (vendor/mpv-headers/client.h), а не написаны по памяти: ошибка в порядке + полей записи или в соглашении о вызове даёт не сообщение об ошибке, + а падение в чужом коде, которое потом ищется часами. + + Библиотека грузится динамически. Смысл: без mpv программа должна + запускаться и внятно объяснять, чего ей не хватает, а не отказываться + стартовать с невнятной ошибкой загрузчика. + + Здесь объявлено только то, что действительно используется. Дописывать + по мере надобности — не «на всякий случай». +} +unit uMpvLib; + +{$mode objfpc}{$H+} + +interface + +uses + SysUtils, Math, ctypes, dynlibs; + +type + Pmpv_handle = Pointer; + +const + { --- mpv_format --- } + MPV_FORMAT_NONE = 0; + MPV_FORMAT_STRING = 1; + MPV_FORMAT_OSD_STRING = 2; + MPV_FORMAT_FLAG = 3; + MPV_FORMAT_INT64 = 4; + MPV_FORMAT_DOUBLE = 5; + MPV_FORMAT_NODE = 6; + + { --- mpv_event_id --- } + MPV_EVENT_NONE = 0; + MPV_EVENT_SHUTDOWN = 1; + MPV_EVENT_LOG_MESSAGE = 2; + MPV_EVENT_GET_PROPERTY_REPLY = 3; + MPV_EVENT_SET_PROPERTY_REPLY = 4; + MPV_EVENT_COMMAND_REPLY = 5; + MPV_EVENT_START_FILE = 6; + MPV_EVENT_END_FILE = 7; + MPV_EVENT_FILE_LOADED = 8; + MPV_EVENT_IDLE = 11; + MPV_EVENT_TICK = 14; + MPV_EVENT_CLIENT_MESSAGE = 16; + MPV_EVENT_VIDEO_RECONFIG = 17; + MPV_EVENT_AUDIO_RECONFIG = 18; + MPV_EVENT_SEEK = 20; + MPV_EVENT_PLAYBACK_RESTART = 21; + MPV_EVENT_PROPERTY_CHANGE = 22; + MPV_EVENT_QUEUE_OVERFLOW = 24; + MPV_EVENT_HOOK = 25; + + { --- mpv_error, только то, что различаем осмысленно --- } + MPV_ERROR_SUCCESS = 0; + MPV_ERROR_UNINITIALIZED = -3; + MPV_ERROR_INVALID_PARAMETER = -4; + MPV_ERROR_OPTION_NOT_FOUND = -5; + MPV_ERROR_PROPERTY_NOT_FOUND = -8; + MPV_ERROR_PROPERTY_UNAVAILABLE = -10; + +type + { Соответствует mpv_event_property из client.h. + data указывает на значение в формате format; при MPV_FORMAT_NONE + свойство недоступно, и трогать data нельзя. } + Pmpv_event_property = ^Tmpv_event_property; + Tmpv_event_property = record + name: PAnsiChar; + format: cint; + data: Pointer; + end; + + { Соответствует mpv_event_log_message из client.h. } + Pmpv_event_log_message = ^Tmpv_event_log_message; + Tmpv_event_log_message = record + prefix: PAnsiChar; + level: PAnsiChar; + text: PAnsiChar; + log_level: cint; + end; + + { Соответствует mpv_event из client.h. + + Указатель, который возвращает mpv_wait_event, принадлежит mpv и живёт + только до следующего вызова mpv_wait_event в том же потоке. Копировать + из него всё нужное надо сразу. } + Pmpv_event = ^Tmpv_event; + Tmpv_event = record + event_id: cint; + error: cint; + reply_userdata: cuint64; + data: Pointer; + end; + +var + mpv_client_api_version: function: culong; cdecl; + mpv_error_string: function(error: cint): PAnsiChar; cdecl; + mpv_free: procedure(data: Pointer); cdecl; + mpv_create: function: Pmpv_handle; cdecl; + mpv_initialize: function(ctx: Pmpv_handle): cint; cdecl; + mpv_terminate_destroy: procedure(ctx: Pmpv_handle); cdecl; + mpv_set_option_string: function(ctx: Pmpv_handle; name, data: PAnsiChar): cint; cdecl; + mpv_set_property: function(ctx: Pmpv_handle; name: PAnsiChar; format: cint; + data: Pointer): cint; cdecl; + mpv_set_property_string: function(ctx: Pmpv_handle; name, data: PAnsiChar): cint; cdecl; + mpv_get_property: function(ctx: Pmpv_handle; name: PAnsiChar; format: cint; + data: Pointer): cint; cdecl; + mpv_get_property_string: function(ctx: Pmpv_handle; name: PAnsiChar): PAnsiChar; cdecl; + mpv_command: function(ctx: Pmpv_handle; args: PPAnsiChar): cint; cdecl; + mpv_command_string: function(ctx: Pmpv_handle; args: PAnsiChar): cint; cdecl; + mpv_observe_property: function(ctx: Pmpv_handle; reply_userdata: cuint64; + name: PAnsiChar; format: cint): cint; cdecl; + mpv_request_log_messages: function(ctx: Pmpv_handle; min_level: PAnsiChar): cint; cdecl; + mpv_wait_event: function(ctx: Pmpv_handle; timeout: cdouble): Pmpv_event; cdecl; + mpv_event_name: function(event: cint): PAnsiChar; cdecl; + +{ Переводит числовую часть локали процесса в режим C. + + Без этого libmpv отказывается создаваться вовсе: mpv_create возвращает nil + и пишет в терминал «Non-C locale detected». Причина в том, что внутри mpv + числа разбираются функциями Си, а те смотрят на локаль — в русской локали + разделитель дробной части запятая, и «10.5» превращается в «10». + + На форматирование чисел в самой программе это не влияет: FPC пользуется + своими TFormatSettings, а не локалью Си. } +procedure ForceCNumericLocale; + +{ Загружает libmpv. Возвращает True, если библиотека найдена и все нужные + функции в ней есть. При False в Error лежит текст для пользователя. } +function LoadMpvLib(out Error: string): Boolean; + +procedure UnloadMpvLib; + +function MpvLibLoaded: Boolean; + +{ Имя файла библиотеки, который в итоге загрузился. Для строки «о программе» + и для сообщений об ошибках. } +function MpvLibFileName: string; + +implementation + +const + { Номера категорий локали разные в glibc и в рантайме Microsoft. + Значения сверены с /usr/include/x86_64-linux-gnu/bits/locale.h + и с locale.h из MSVC — перепутать их значит молча настроить не ту + категорию и получить ту же ошибку, но уже без подсказки. } + {$IFDEF WINDOWS} + LC_NUMERIC_CAT = 4; + {$ELSE} + LC_NUMERIC_CAT = 1; + {$ENDIF} + +function c_setlocale(category: cint; locale: PAnsiChar): PAnsiChar; cdecl; + external {$IFDEF WINDOWS}'msvcrt'{$ELSE}'c'{$ENDIF} name 'setlocale'; + +var + FLibHandle: TLibHandle = NilHandle; + FLibFileName: string = ''; + +procedure ForceCNumericLocale; +begin + c_setlocale(LC_NUMERIC_CAT, 'C'); +end; + +{ Кандидаты перебираются по порядку. На Linux libmpv.so без цифры есть + только когда установлен пакет для разработчиков, поэтому основным + считается вариант с версией. } +function LibCandidates: TStringArray; +begin + {$IFDEF WINDOWS} + Result := ['mpv-2.dll', 'libmpv-2.dll', 'mpv-1.dll', 'mpv.dll']; + {$ELSE} + Result := ['libmpv.so.2', 'libmpv.so.1', 'libmpv.so']; + {$ENDIF} +end; + +function Bind(const AName: string; out Target: Pointer): Boolean; +begin + Target := GetProcedureAddress(FLibHandle, AName); + Result := Assigned(Target); +end; + +function JoinNames(const Items: TStringArray): string; +var + I: Integer; +begin + Result := ''; + for I := 0 to High(Items) do + begin + if I > 0 then + Result := Result + ', '; + Result := Result + Items[I]; + end; +end; + +function LoadMpvLib(out Error: string): Boolean; +var + Candidates: TStringArray; + I: Integer; + Missing: string; + + { Локальная обёртка: копит имена ненайденных функций, чтобы сообщение + об ошибке называло все проблемы разом, а не первую попавшуюся. } + procedure Need(const AName: string; out Target: Pointer); + begin + if not Bind(AName, Target) then + begin + if Missing <> '' then + Missing := Missing + ', '; + Missing := Missing + AName; + end; + end; + +begin + Error := ''; + if FLibHandle <> NilHandle then + Exit(True); + + Candidates := LibCandidates; + for I := 0 to High(Candidates) do + begin + FLibHandle := LoadLibrary(Candidates[I]); + if FLibHandle <> NilHandle then + begin + FLibFileName := Candidates[I]; + Break; + end; + end; + + if FLibHandle = NilHandle then + begin + Error := 'Не удалось загрузить libmpv. Искали: ' + JoinNames(Candidates) + + '.' + LineEnding + + {$IFDEF WINDOWS} + 'Положите библиотеку рядом с программой. ' + + 'Меню «Файл → Зависимости...» умеет скачать её с официального сайта.'; + {$ELSE} + 'Установите пакет mpv (sudo apt install mpv) или положите библиотеку ' + + 'рядом с программой.'; + {$ENDIF} + Exit(False); + end; + + { Отключаем прерывания по ошибкам вещественной арифметики. + + Паскаль по умолчанию требует, чтобы процессор сообщал о каждой + неточности: делении на ноль, потере значимости, переполнении. Свой код + так писать правильно. Но libmpv и ffmpeg внутри считают вещественные + числа как им удобно и на такие мелочи не рассчитывают: у них + неопределённые значения — рабочий случай. + + В итоге при создании плеера вылезало «Invalid floating point + operation», и предпросмотр не запускался вовсе. Проверено под Wine. + + Маска ставится один раз, после загрузки библиотеки. } + SetExceptionMask(GetExceptionMask + [exInvalidOp, exDenormalized, + exZeroDivide, exOverflow, exUnderflow, exPrecision]); + + Missing := ''; + Need('mpv_client_api_version', Pointer(mpv_client_api_version)); + Need('mpv_error_string', Pointer(mpv_error_string)); + Need('mpv_free', Pointer(mpv_free)); + Need('mpv_create', Pointer(mpv_create)); + Need('mpv_initialize', Pointer(mpv_initialize)); + Need('mpv_terminate_destroy', Pointer(mpv_terminate_destroy)); + Need('mpv_set_option_string', Pointer(mpv_set_option_string)); + Need('mpv_set_property', Pointer(mpv_set_property)); + Need('mpv_set_property_string', Pointer(mpv_set_property_string)); + Need('mpv_get_property', Pointer(mpv_get_property)); + Need('mpv_get_property_string', Pointer(mpv_get_property_string)); + Need('mpv_command', Pointer(mpv_command)); + Need('mpv_command_string', Pointer(mpv_command_string)); + Need('mpv_observe_property', Pointer(mpv_observe_property)); + Need('mpv_request_log_messages', Pointer(mpv_request_log_messages)); + Need('mpv_wait_event', Pointer(mpv_wait_event)); + Need('mpv_event_name', Pointer(mpv_event_name)); + + if Missing <> '' then + begin + Error := 'Библиотека ' + FLibFileName + ' загрузилась, но в ней нет функций: ' + + Missing + '.' + LineEnding + 'Скорее всего версия libmpv слишком старая.'; + UnloadMpvLib; + Exit(False); + end; + + Result := True; +end; + +procedure UnloadMpvLib; +begin + if FLibHandle <> NilHandle then + begin + UnloadLibrary(FLibHandle); + FLibHandle := NilHandle; + FLibFileName := ''; + end; +end; + +function MpvLibLoaded: Boolean; +begin + Result := FLibHandle <> NilHandle; +end; + +function MpvLibFileName: string; +begin + Result := FLibFileName; +end; + +end. diff --git a/src/uMpvPlayer.pas b/src/uMpvPlayer.pas new file mode 100644 index 0000000..67f9495 --- /dev/null +++ b/src/uMpvPlayer.pas @@ -0,0 +1,758 @@ +{ + 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; + { Работаем ли под 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); + 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); + + 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 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; + 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; + +destructor TMpvPlayer.Destroy; +begin + FPump.Enabled := False; + FreeAndNil(FPump); + { Сначала гасим mpv, и только потом убираем окно, в которое он рисовал: + в обратном порядке он успел бы обратиться к уже несуществующему окну. } + if FHandle <> nil then + begin + mpv_terminate_destroy(FHandle); + FHandle := nil; + 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. } + 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.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; + +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_SHUTDOWN: + begin + FPump.Enabled := False; + Break; + end; + end; + until False; +end; + +end. diff --git a/src/uPanCropForm.lfm b/src/uPanCropForm.lfm new file mode 100644 index 0000000..be3f746 --- /dev/null +++ b/src/uPanCropForm.lfm @@ -0,0 +1,193 @@ +object PanCropForm: TPanCropForm + Left = 380 + Height = 560 + Top = 220 + Width = 940 + BorderIcons = [biSystemMenu] + Caption = 'Кадрирование и поворот' + ClientHeight = 560 + ClientWidth = 940 + OnCreate = FormCreate + OnDestroy = FormDestroy + Position = poOwnerFormCenter + LCLVersion = '4.6' + object pnlLeft: TPanel + Left = 0 + Height = 560 + Top = 0 + Width = 380 + Align = alLeft + BevelOuter = bvNone + ClientHeight = 560 + ClientWidth = 380 + TabOrder = 0 + object lblSource: TLabel + Left = 12 + Height = 40 + Top = 10 + Width = 356 + AutoSize = False + Caption = 'источник' + ParentColor = False + WordWrap = True + end + object lblFit: TLabel + Left = 12 + Height = 20 + Top = 58 + Width = 160 + Caption = 'Как вписывать кадр:' + ParentColor = False + end + object cbFit: TComboBox + Left = 12 + Height = 28 + Top = 80 + Width = 356 + ItemHeight = 20 + OnChange = ControlChanged + Style = csDropDownList + TabOrder = 0 + end + object lblRotation: TLabel + Left = 12 + Height = 20 + Top = 118 + Width = 70 + Caption = 'Поворот:' + ParentColor = False + end + object cbRotation: TComboBox + Left = 12 + Height = 28 + Top = 140 + Width = 356 + ItemHeight = 20 + OnChange = ControlChanged + Style = csDropDownList + TabOrder = 1 + end + object chkFlipH: TCheckBox + Left = 12 + Height = 24 + Top = 178 + Width = 200 + Caption = 'Отразить по горизонтали' + OnChange = ControlChanged + TabOrder = 2 + end + object chkFlipV: TCheckBox + Left = 12 + Height = 24 + Top = 204 + Width = 200 + Caption = 'Отразить по вертикали' + OnChange = ControlChanged + TabOrder = 3 + end + object lblZoom: TLabel + Left = 12 + Height = 20 + Top = 238 + Width = 160 + Caption = 'Увеличение: 100%' + ParentColor = False + end + object tbZoom: TTrackBar + Left = 12 + Height = 36 + Top = 260 + Width = 356 + Frequency = 25 + Position = 100 + OnChange = ControlChanged + TabOrder = 4 + end + object lblOffsetX: TLabel + Left = 12 + Height = 20 + Top = 302 + Width = 260 + Caption = 'Смещение по горизонтали: 0%' + ParentColor = False + end + object tbOffsetX: TTrackBar + Left = 12 + Height = 36 + Top = 324 + Width = 356 + Frequency = 10 + OnChange = ControlChanged + TabOrder = 5 + end + object lblOffsetY: TLabel + Left = 12 + Height = 20 + Top = 366 + Width = 260 + Caption = 'Смещение по вертикали: 0%' + ParentColor = False + end + object tbOffsetY: TTrackBar + Left = 12 + Height = 36 + Top = 388 + Width = 356 + Frequency = 10 + OnChange = ControlChanged + TabOrder = 6 + end + object lblFilter: TLabel + Left = 12 + Height = 40 + Top = 432 + Width = 356 + AutoSize = False + Caption = '' + Font.Height = -10 + Font.Name = 'Monospace' + ParentColor = False + ParentFont = False + WordWrap = True + end + object btnReset: TThemedButton + Left = 12 + Height = 30 + Top = 488 + Width = 130 + Caption = 'Сбросить' + OnClick = btnResetClick + TabOrder = 7 + end + object btnOk: TThemedButton + Left = 168 + Height = 30 + Top = 488 + Width = 100 + Caption = 'Применить' + Default = True + OnClick = btnOkClick + TabOrder = 8 + end + object btnCancel: TThemedButton + Left = 276 + Height = 30 + Top = 488 + Width = 92 + Cancel = True + Caption = 'Отмена' + OnClick = btnCancelClick + TabOrder = 9 + end + end + object imgPreview: TImage + Left = 380 + Height = 560 + Top = 0 + Width = 560 + Align = alClient + Center = True + Proportional = True + Stretch = True + end +end diff --git a/src/uPanCropForm.pas b/src/uPanCropForm.pas new file mode 100644 index 0000000..7c08b27 --- /dev/null +++ b/src/uPanCropForm.pas @@ -0,0 +1,325 @@ +{ + uPanCropForm — как кадр файла ложится в кадр проекта. + + Проект имеет одно разрешение на всё, иначе куски не склеить копированием. + Файл с другим разрешением или другим соотношением сторон надо во что-то + превратить, и это окно решает, во что именно: вписать с полями, заполнить + с обрезкой или растянуть. Плюс поворот, отражение, увеличение и смещение. + + Показывается настоящий кадр, пропущенный через ту же цепочку фильтров, + что пойдёт в дело. Рисовать приближение своими силами было бы нечестно: + разошлось бы с результатом в мелочах, а именно в мелочах тут вся суть. + + Кадр берётся в отдельном потоке: на большом файле ffmpeg отвечает не + мгновенно, а окно должно оставаться отзывчивым. +} +unit uPanCropForm; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Forms, Controls, Graphics, ExtCtrls, StdCtrls, Spin, + ComCtrls, uTransform, uMediaProbe, uTheme; + +type + + { TPanCropForm } + + TPanCropForm = class(TForm) + btnCancel: TThemedButton; + btnOk: TThemedButton; + btnReset: TThemedButton; + cbFit: TComboBox; + cbRotation: TComboBox; + chkFlipH: TCheckBox; + chkFlipV: TCheckBox; + imgPreview: TImage; + lblFilter: TLabel; + lblFit: TLabel; + lblOffsetX: TLabel; + lblOffsetY: TLabel; + lblRotation: TLabel; + lblSource: TLabel; + lblZoom: TLabel; + pnlLeft: TPanel; + tbOffsetX: TTrackBar; + tbOffsetY: TTrackBar; + tbZoom: TTrackBar; + procedure btnCancelClick(Sender: TObject); + procedure btnOkClick(Sender: TObject); + procedure btnResetClick(Sender: TObject); + procedure ControlChanged(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + private + FTransform: TMediaTransform; + FSourcePath: string; + FSourceInfo: TMediaInfo; + FDstWidth: Integer; + FDstHeight: Integer; + FPreviewFile: string; + FRefreshTimer: TTimer; + FUpdating: Boolean; + procedure ReadControls; + procedure WriteControls; + procedure ScheduleRefresh; + procedure RefreshPreview(Sender: TObject); + public + { Готовит окно. ADstWidth и ADstHeight — кадр проекта. } + procedure Setup(const APath: string; const AInfo: TMediaInfo; + ADstWidth, ADstHeight: Integer; const ATransform: TMediaTransform; + const APreviewFile: string); + property Transform: TMediaTransform read FTransform; + end; + +{ Показывает окно и возвращает True, если настройки приняты. } +function EditTransform(AOwner: TComponent; const APath: string; + const AInfo: TMediaInfo; ADstWidth, ADstHeight: Integer; + var ATransform: TMediaTransform; const APreviewFile: string): Boolean; + +implementation + +{$R *.lfm} + +uses + Math, uAppTypes, uFfmpegCmd, uProcRunner; + +const + { Ширина показываемого кадра. Больше незачем: тут важны пропорции и то, + что попало в кадр, а не разглядывание деталей. } + PreviewWidth = 520; + + { Задержка перед пересчётом кадра. Пока тянут ползунок, гонять ffmpeg на + каждое движение бессмысленно. } + RefreshDelayMs = 300; + + ZoomMin = 50; + ZoomMax = 400; + OffsetRange = 50; + +procedure TPanCropForm.FormCreate(Sender: TObject); +begin + { Цвета задаём сами: системная тема может быть светлой, и тогда + тёмный таймлайн оказался бы в белой рамке. } + ApplyDarkTheme(Self); + Caption := 'Кадрирование и поворот'; + + cbFit.Items.Clear; + cbFit.Items.Add(FitModeCaption(fmFit)); + cbFit.Items.Add(FitModeCaption(fmFill)); + cbFit.Items.Add(FitModeCaption(fmStretch)); + cbFit.ItemIndex := 0; + + cbRotation.Items.Clear; + cbRotation.Items.Add('без поворота'); + cbRotation.Items.Add('90 по часовой'); + cbRotation.Items.Add('180'); + cbRotation.Items.Add('90 против часовой'); + cbRotation.ItemIndex := 0; + + tbZoom.Min := ZoomMin; + tbZoom.Max := ZoomMax; + tbZoom.Position := 100; + + tbOffsetX.Min := -OffsetRange; + tbOffsetX.Max := OffsetRange; + tbOffsetY.Min := -OffsetRange; + tbOffsetY.Max := OffsetRange; + + FRefreshTimer := TTimer.Create(Self); + FRefreshTimer.Enabled := False; + FRefreshTimer.Interval := RefreshDelayMs; + FRefreshTimer.OnTimer := @RefreshPreview; +end; + +procedure TPanCropForm.FormDestroy(Sender: TObject); +begin + FRefreshTimer.Enabled := False; + if (FPreviewFile <> '') and FileExists(FPreviewFile) then + DeleteFile(FPreviewFile); +end; + +procedure TPanCropForm.Setup(const APath: string; const AInfo: TMediaInfo; + ADstWidth, ADstHeight: Integer; const ATransform: TMediaTransform; + const APreviewFile: string); +begin + FSourcePath := APath; + FSourceInfo := AInfo; + FDstWidth := ADstWidth; + FDstHeight := ADstHeight; + FTransform := ATransform; + FPreviewFile := APreviewFile; + + lblSource.Caption := Format('%s: %dx%d → кадр проекта %dx%d', + [ExtractFileName(APath), AInfo.Width, AInfo.Height, ADstWidth, ADstHeight]); + + WriteControls; + RefreshPreview(nil); +end; + +procedure TPanCropForm.WriteControls; +begin + FUpdating := True; + try + case FTransform.Fit of + fmFill: cbFit.ItemIndex := 1; + fmStretch: cbFit.ItemIndex := 2; + else + cbFit.ItemIndex := 0; + end; + case ((FTransform.Rotation mod 360) + 360) mod 360 of + 90: cbRotation.ItemIndex := 1; + 180: cbRotation.ItemIndex := 2; + 270: cbRotation.ItemIndex := 3; + else + cbRotation.ItemIndex := 0; + end; + chkFlipH.Checked := FTransform.FlipH; + chkFlipV.Checked := FTransform.FlipV; + tbZoom.Position := Max(ZoomMin, Min(ZoomMax, Round(FTransform.Zoom * 100))); + tbOffsetX.Position := Max(-OffsetRange, + Min(OffsetRange, Round(FTransform.OffsetX * 100))); + tbOffsetY.Position := Max(-OffsetRange, + Min(OffsetRange, Round(FTransform.OffsetY * 100))); + finally + FUpdating := False; + end; +end; + +procedure TPanCropForm.ReadControls; +begin + case cbFit.ItemIndex of + 1: FTransform.Fit := fmFill; + 2: FTransform.Fit := fmStretch; + else + FTransform.Fit := fmFit; + end; + case cbRotation.ItemIndex of + 1: FTransform.Rotation := 90; + 2: FTransform.Rotation := 180; + 3: FTransform.Rotation := 270; + else + FTransform.Rotation := 0; + end; + FTransform.FlipH := chkFlipH.Checked; + FTransform.FlipV := chkFlipV.Checked; + FTransform.Zoom := tbZoom.Position / 100; + FTransform.OffsetX := tbOffsetX.Position / 100; + FTransform.OffsetY := tbOffsetY.Position / 100; + + lblZoom.Caption := Format('Увеличение: %d%%', [tbZoom.Position]); + lblOffsetX.Caption := Format('Смещение по горизонтали: %d%%', [tbOffsetX.Position]); + lblOffsetY.Caption := Format('Смещение по вертикали: %d%%', [tbOffsetY.Position]); + + { Растяжение не оставляет места ни увеличению, ни смещению: кадр и так + занимает всю площадь. } + tbZoom.Enabled := FTransform.Fit <> fmStretch; + tbOffsetX.Enabled := FTransform.Fit <> fmStretch; + tbOffsetY.Enabled := FTransform.Fit <> fmStretch; +end; + +procedure TPanCropForm.ControlChanged(Sender: TObject); +begin + if FUpdating then + Exit; + ReadControls; + ScheduleRefresh; +end; + +procedure TPanCropForm.btnResetClick(Sender: TObject); +begin + FTransform := DefaultTransform; + WriteControls; + ReadControls; + ScheduleRefresh; +end; + +procedure TPanCropForm.ScheduleRefresh; +begin + FRefreshTimer.Enabled := False; + FRefreshTimer.Enabled := True; +end; + +procedure TPanCropForm.RefreshPreview(Sender: TObject); +var + PrevW, PrevH: Integer; + Filter: string; + Res: TProcResult; + Png: TPortableNetworkGraphic; + AtTime: Double; +begin + FRefreshTimer.Enabled := False; + ReadControls; + + if (FSourcePath = '') or (FDstWidth <= 0) or (FDstHeight <= 0) then + Exit; + + { Кадр показываем в пропорциях проекта и уменьшенным: разглядывать + детали тут не требуется, а ждать обработки полного разрешения на + каждое движение ползунка — тем более. } + PrevW := PreviewWidth; + PrevH := Max(2, Round(PreviewWidth * FDstHeight / FDstWidth)); + Filter := TransformFilter(FTransform, FSourceInfo.Width, FSourceInfo.Height, + PrevW, PrevH); + lblFilter.Caption := Filter; + + if FSourceInfo.Kind = mkImage then + AtTime := 0 + else + AtTime := Min(5, Max(0, FSourceInfo.Duration * 0.1)); + + Res := RunProcess(FfmpegExe, + ArgsPreviewFrame(FSourcePath, FPreviewFile, AtTime, Filter), + nil, nil, nil); + + if (not Res.Started) or (Res.ExitCode <> 0) or (not FileExists(FPreviewFile)) then + begin + imgPreview.Picture.Clear; + lblFilter.Caption := 'Не удалось получить кадр: ' + Filter; + Exit; + end; + + Png := TPortableNetworkGraphic.Create; + try + try + Png.LoadFromFile(FPreviewFile); + imgPreview.Picture.Assign(Png); + except + imgPreview.Picture.Clear; + end; + finally + Png.Free; + end; +end; + +procedure TPanCropForm.btnOkClick(Sender: TObject); +begin + ReadControls; + ModalResult := mrOK; +end; + +procedure TPanCropForm.btnCancelClick(Sender: TObject); +begin + ModalResult := mrCancel; +end; + +function EditTransform(AOwner: TComponent; const APath: string; + const AInfo: TMediaInfo; ADstWidth, ADstHeight: Integer; + var ATransform: TMediaTransform; const APreviewFile: string): Boolean; +var + Form: TPanCropForm; +begin + Form := TPanCropForm.Create(AOwner); + try + Form.Setup(APath, AInfo, ADstWidth, ADstHeight, ATransform, APreviewFile); + Result := Form.ShowModal = mrOK; + if Result then + ATransform := Form.Transform; + finally + Form.Free; + end; +end; + +end. diff --git a/src/uProcRunner.pas b/src/uProcRunner.pas new file mode 100644 index 0000000..6a3dde2 --- /dev/null +++ b/src/uProcRunner.pas @@ -0,0 +1,251 @@ +{ + uProcRunner — запуск ffmpeg и ffprobe как внешних процессов. + + Почему внешний процесс, а не линковка с libav*: команду можно скопировать + из журнала в терминал и разобраться руками, бинарник не пухнет, и можно + подставить свою сборку ffmpeg. + + Функция RunProcess синхронная и вызывается из рабочего потока. Это + сознательный выбор: экспорт — это цепочка из десятка запусков подряд, + и описывать её обычным последовательным кодом внутри одного потока + куда понятнее, чем машиной состояний на колбэках завершения. + + Обработчики строк вызываются в том же рабочем потоке. Переносить их + в поток интерфейса обязан вызывающий — здесь этого не делается намеренно, + иначе на каждой строке журнала ffmpeg был бы Synchronize. + + Аргументы передаются массивом, а не одной строкой: shell не участвует, + поэтому пробелы, кавычки и апострофы в путях никого не волнуют. +} +unit uProcRunner; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Pipes, Process, UTF8Process, FileUtil; + +type + { Вызывается на каждую полную строку вывода процесса. } + TProcLineEvent = procedure(const ALine: string) of object; + + { Должна вернуть True, если работу пора прекратить. Опрашивается + несколько раз в секунду. } + TProcCancelQuery = function: Boolean of object; + + TProcResult = record + Started: Boolean; + Cancelled: Boolean; + ExitCode: Integer; + { Заполняется, только если процесс не удалось запустить. } + ErrorText: string; + end; + +{ Запускает процесс и ждёт его завершения, разбирая вывод на строки. + + AOnStdOut получает поток вывода (туда ffmpeg пишет -progress), + AOnStdErr — поток ошибок (туда идёт обычный журнал ffmpeg). + Любой из обработчиков может быть nil. ACancel тоже может быть nil. } +function RunProcess(const AExe: string; const AArgs: array of string; + AOnStdOut, AOnStdErr: TProcLineEvent; ACancel: TProcCancelQuery): TProcResult; + +{ Путь к исполняемому файлу по имени. Пустая строка — не найден. } +function FindTool(const AName: string): string; + +{ Команда в виде, пригодном для копирования в терминал. Только для журнала: + запуск идёт массивом аргументов, без shell. } +function CommandToString(const AExe: string; const AArgs: array of string): string; + +implementation + +const + { Как часто опрашивать трубы, когда данных нет. Слишком мало — процесс + крутит холостой цикл, слишком много — прогресс дёргается. } + IdleSleepMs = 20; + + ReadChunk = 16 * 1024; + +type + { Накопитель, который режет поток байтов на строки. + + Отдельный класс нужен потому, что ffmpeg заканчивает строки по-разному: + вывод -progress использует перевод строки, а строку состояния в потоке + ошибок он перерисовывает возвратом каретки. Оба символа считаются + концом строки, пустые строки отбрасываются. } + TLineSplitter = class + private + FBuffer: string; + FOnLine: TProcLineEvent; + public + constructor Create(AOnLine: TProcLineEvent); + procedure Feed(const AData: string); + procedure Flush; + end; + +constructor TLineSplitter.Create(AOnLine: TProcLineEvent); +begin + inherited Create; + FOnLine := AOnLine; +end; + +procedure TLineSplitter.Feed(const AData: string); +var + I, Start: Integer; + Line: string; +begin + if not Assigned(FOnLine) then + Exit; + + FBuffer := FBuffer + AData; + Start := 1; + I := 1; + while I <= Length(FBuffer) do + begin + if FBuffer[I] in [#10, #13] then + begin + Line := Copy(FBuffer, Start, I - Start); + if Line <> '' then + FOnLine(Line); + Start := I + 1; + end; + Inc(I); + end; + { Хвост без завершающего символа остаётся до следующей порции. } + FBuffer := Copy(FBuffer, Start, Length(FBuffer) - Start + 1); +end; + +procedure TLineSplitter.Flush; +begin + if Assigned(FOnLine) and (FBuffer <> '') then + FOnLine(FBuffer); + FBuffer := ''; +end; + +function FindTool(const AName: string): string; +begin + Result := FindDefaultExecutablePath(AName); +end; + +function CommandToString(const AExe: string; const AArgs: array of string): string; +var + I: Integer; + + { Кавычим только то, что без кавычек в терминале разберётся неправильно. } + function Quote(const S: string): string; + begin + if (S = '') or (Pos(' ', S) > 0) or (Pos('''', S) > 0) or (Pos('"', S) > 0) then + Result := '''' + StringReplace(S, '''', '''\''''', [rfReplaceAll]) + '''' + else + Result := S; + end; + +begin + Result := Quote(AExe); + for I := 0 to High(AArgs) do + Result := Result + ' ' + Quote(AArgs[I]); +end; + +{ Забирает из трубы всё, что там сейчас есть. Возвращает число прочитанных + байт, чтобы вызывающий понимал, была ли работа или пора поспать. } +function DrainPipe(AStream: TInputPipeStream; ASplitter: TLineSplitter): Integer; +var + Avail, Got: Integer; + Buf: string; +begin + Result := 0; + if AStream = nil then + Exit; + Avail := AStream.NumBytesAvailable; + while Avail > 0 do + begin + if Avail > ReadChunk then + Avail := ReadChunk; + SetLength(Buf, Avail); + Got := AStream.Read(Buf[1], Avail); + if Got <= 0 then + Break; + SetLength(Buf, Got); + ASplitter.Feed(Buf); + Inc(Result, Got); + Avail := AStream.NumBytesAvailable; + end; +end; + +function RunProcess(const AExe: string; const AArgs: array of string; + AOnStdOut, AOnStdErr: TProcLineEvent; ACancel: TProcCancelQuery): TProcResult; +var + P: TProcessUTF8; + OutSplit, ErrSplit: TLineSplitter; + I, Moved: Integer; + Terminated: Boolean; +begin + Result.Started := False; + Result.Cancelled := False; + Result.ExitCode := -1; + Result.ErrorText := ''; + + if not FileExists(AExe) then + begin + Result.ErrorText := 'Не найден исполняемый файл: ' + AExe; + Exit; + end; + + P := TProcessUTF8.Create(nil); + OutSplit := TLineSplitter.Create(AOnStdOut); + ErrSplit := TLineSplitter.Create(AOnStdErr); + try + P.Executable := AExe; + for I := 0 to High(AArgs) do + P.Parameters.Add(AArgs[I]); + { poUsePipes — читаем оба потока сами. Потоки держим раздельно: + в вывод идёт -progress, в ошибки — журнал, смешивать их значит + усложнить разбор без всякой выгоды. } + P.Options := [poUsePipes, poNoConsole]; + P.ShowWindow := swoHIDE; + + try + P.Execute; + except + on E: Exception do + begin + Result.ErrorText := 'Не удалось запустить ' + AExe + ': ' + E.Message; + Exit; + end; + end; + + Result.Started := True; + Terminated := False; + + while P.Running do + begin + Moved := DrainPipe(P.Output, OutSplit) + DrainPipe(P.Stderr, ErrSplit); + + if (not Terminated) and Assigned(ACancel) and ACancel() then + begin + Result.Cancelled := True; + Terminated := True; + P.Terminate(1); + end; + + { Спим только когда данных не было — иначе тормозили бы разбор + длинного вывода на ровном месте. } + if Moved = 0 then + Sleep(IdleSleepMs); + end; + + { После завершения в трубах обычно остаётся непрочитанный хвост. } + while DrainPipe(P.Output, OutSplit) + DrainPipe(P.Stderr, ErrSplit) > 0 do + ; + OutSplit.Flush; + ErrSplit.Flush; + + Result.ExitCode := P.ExitStatus; + finally + ErrSplit.Free; + OutSplit.Free; + P.Free; + end; +end; + +end. diff --git a/src/uProgressForm.lfm b/src/uProgressForm.lfm new file mode 100644 index 0000000..7bc2c6d --- /dev/null +++ b/src/uProgressForm.lfm @@ -0,0 +1,66 @@ +object ProgressForm: TProgressForm + Left = 400 + Height = 420 + Top = 260 + Width = 760 + BorderIcons = [biSystemMenu] + Caption = 'Обработка' + ClientHeight = 420 + ClientWidth = 760 + OnCloseQuery = FormCloseQuery + OnCreate = FormCreate + Position = poOwnerFormCenter + LCLVersion = '4.6' + object pnlTop: TPanel + Left = 0 + Height = 110 + Top = 0 + Width = 760 + Align = alTop + BevelOuter = bvNone + ClientHeight = 110 + ClientWidth = 760 + TabOrder = 0 + object lblStage: TLabel + Left = 12 + Height = 20 + Top = 12 + Width = 736 + Anchors = [akTop, akLeft, akRight] + Caption = 'Готовлю' + ParentColor = False + end + object pbBar: TProgressBar + Left = 12 + Height = 22 + Top = 40 + Width = 736 + Anchors = [akTop, akLeft, akRight] + TabOrder = 0 + end + object btnAction: TThemedButton + Left = 648 + Height = 28 + Top = 72 + Width = 100 + Anchors = [akTop, akRight] + Caption = 'Отмена' + OnClick = btnActionClick + TabOrder = 1 + end + end + object memoLog: TMemo + Left = 0 + Height = 310 + Top = 110 + Width = 760 + Align = alClient + Font.Height = -12 + Font.Name = 'Monospace' + ParentFont = False + ReadOnly = True + ScrollBars = ssAutoBoth + TabOrder = 1 + WordWrap = False + end +end diff --git a/src/uProgressForm.pas b/src/uProgressForm.pas new file mode 100644 index 0000000..55e5dab --- /dev/null +++ b/src/uProgressForm.pas @@ -0,0 +1,139 @@ +{ + uProgressForm — окно хода долгой операции. + + Показывается модально, пока работает рабочий поток. Поток шлёт сюда + состояние через Synchronize, поэтому все методы этого окна вызываются + из потока интерфейса и никакой защиты не требуют. + + Кнопка одна и меняет назначение: пока идёт работа — «Отмена», после + завершения — «Закрыть». Так окно нельзя закрыть, не остановив работу, + и не приходится гадать, что стало с процессом. +} +unit uProgressForm; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Forms, Controls, Graphics, ComCtrls, StdCtrls, ExtCtrls, uTheme; + +type + + { TProgressForm } + + TProgressForm = class(TForm) + btnAction: TThemedButton; + lblStage: TLabel; + memoLog: TMemo; + pbBar: TProgressBar; + pnlTop: TPanel; + procedure btnActionClick(Sender: TObject); + procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); + procedure FormCreate(Sender: TObject); + private + FFinished: Boolean; + FCancelRequested: Boolean; + FOnCancelRequest: TNotifyEvent; + public + procedure SetStage(const AText: string); + procedure SetFraction(AValue: Double); + procedure AddLog(const AText: string); + { Переводит окно в завершённое состояние: прогресс на месте, кнопка + становится «Закрыть». } + procedure Finish(ASuccess: Boolean; const AMessage: string); + + property Finished: Boolean read FFinished; + property OnCancelRequest: TNotifyEvent read FOnCancelRequest + write FOnCancelRequest; + end; + +implementation + +{$R *.lfm} + +const + { Прогресс держим в целых долях от десяти тысяч: с шагом в один процент + полоса на длинной операции выглядит замершей. } + BarScale = 10000; + +{ TProgressForm } + +procedure TProgressForm.FormCreate(Sender: TObject); +begin + { Цвета задаём сами: системная тема может быть светлой, и тогда + тёмный таймлайн оказался бы в белой рамке. } + ApplyDarkTheme(Self); + pbBar.Min := 0; + pbBar.Max := BarScale; + pbBar.Position := 0; + memoLog.Clear; + btnAction.Caption := 'Отмена'; +end; + +procedure TProgressForm.SetStage(const AText: string); +begin + lblStage.Caption := AText; +end; + +procedure TProgressForm.SetFraction(AValue: Double); +begin + if AValue < 0 then + AValue := 0; + if AValue > 1 then + AValue := 1; + pbBar.Position := Round(AValue * BarScale); +end; + +procedure TProgressForm.AddLog(const AText: string); +begin + { Журнал одной операции не должен расти без предела: ffmpeg на битом + файле способен выдать тысячи одинаковых предупреждений. } + if memoLog.Lines.Count > 1000 then + memoLog.Lines.Delete(0); + memoLog.Lines.Add(AText); + { Держим видимой последнюю строку. } + memoLog.SelStart := Length(memoLog.Text); +end; + +procedure TProgressForm.Finish(ASuccess: Boolean; const AMessage: string); +begin + FFinished := True; + btnAction.Caption := 'Закрыть'; + lblStage.Caption := AMessage; + if ASuccess then + lblStage.Font.Color := clDefault + else + lblStage.Font.Color := clRed; +end; + +procedure TProgressForm.btnActionClick(Sender: TObject); +begin + if FFinished then + begin + Close; + Exit; + end; + + { Повторное нажатие ничего не даёт: остановка не мгновенна, надо + дождаться, пока ffmpeg завершится. } + if FCancelRequested then + Exit; + + FCancelRequested := True; + btnAction.Enabled := False; + lblStage.Caption := 'Останавливаю...'; + if Assigned(FOnCancelRequest) then + FOnCancelRequest(Self); +end; + +procedure TProgressForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean); +begin + { Пока работа идёт, закрытие окна означало бы оставить ffmpeg работать + без всякого присмотра. Вместо этого запрашиваем остановку. } + CanClose := FFinished; + if not CanClose then + btnActionClick(nil); +end; + +end. diff --git a/src/uProject.pas b/src/uProject.pas new file mode 100644 index 0000000..c6501b0 --- /dev/null +++ b/src/uProject.pas @@ -0,0 +1,1113 @@ +{ + uProject — модель монтажа: список файлов, дорожки, клипы. + + Порядок дорожек и есть приоритет: дорожка с индексом 0 самая верхняя, + она перекрывает все нижние целиком — и картинкой, и звуком. Никакого + смешивания не предусмотрено, это осознанное ограничение ради того, + чтобы результат собирался копированием потоков. + + Клип хранит, откуда берётся материал (SrcIn) и где он стоит на монтаже + (TlStart), а длительность одна на оба конца. Отдельно помечено, как + сделан каждый край: притянут к опорному кадру или должен быть точным. + + Отмена сделана снимками: перед каждым изменением состояние сохраняется + целиком в виде JSON. Расточительно по памяти, но полностью надёжно — + нет ни одного изменения, которое можно случайно забыть откатить. При + тысячах клипов снимок весит сотни килобайт, что несопоставимо с + весом самого видео. +} +unit uProject; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, contnrs, fpjson, uAppTypes, uMediaProbe, uKeyframeIndex, + uTransform; + +type + { Как сделан край клипа. + + edSnap — рез притянут к опорному кадру, перекодирования нет. + edPrecise — рез там, где просили; при сборке огрызок до опорного + кадра придётся перекодировать. } + TEdgeMode = (edSnap, edPrecise); + + TClipKind = (ckVideo, ckImage, ckBlack); + + { На какие дорожки действует схлопывание. + + rmCurrentTrack — двигается только та дорожка, где идёт правка. + rmAllTracks — двигаются все, чтобы дорожки не разъехались друг + относительно друга. } + TRippleMode = (rmCurrentTrack, rmAllTracks); + + { Файл, добавленный в проект. } + TMediaItem = class + private + FId: string; + FPath: string; + FInfo: TMediaInfo; + FNormalizedPath: string; + FIndex: TKeyframeIndex; + FIndexLoaded: Boolean; + FTransform: TMediaTransform; + public + constructor Create; + { Откуда реально брать материал: из нормализованной копии, если она + сделана, иначе из исходника. } + function EffectivePath: string; + property Id: string read FId write FId; + property Path: string read FPath write FPath; + property Info: TMediaInfo read FInfo write FInfo; + property NormalizedPath: string read FNormalizedPath write FNormalizedPath; + property Index: TKeyframeIndex read FIndex write FIndex; + property IndexLoaded: Boolean read FIndexLoaded write FIndexLoaded; + { Как кадр этого файла ложится в кадр проекта. } + property Transform: TMediaTransform read FTransform write FTransform; + end; + + TClip = class + private + FId: string; + FMediaId: string; + FSrcIn: Double; + FTlStart: Double; + FDuration: Double; + FEdgeIn: TEdgeMode; + FEdgeOut: TEdgeMode; + FKind: TClipKind; + FSelected: Boolean; + FVolume: Double; + public + constructor Create; + function TlEnd: Double; + function SrcOut: Double; + { Попадает ли момент внутрь клипа. Правый край не включается: там уже + начинается следующий клип. } + function Covers(const ATime: Double): Boolean; + property Id: string read FId write FId; + property MediaId: string read FMediaId write FMediaId; + property SrcIn: Double read FSrcIn write FSrcIn; + property TlStart: Double read FTlStart write FTlStart; + property Duration: Double read FDuration write FDuration; + property EdgeIn: TEdgeMode read FEdgeIn write FEdgeIn; + property EdgeOut: TEdgeMode read FEdgeOut write FEdgeOut; + property Kind: TClipKind read FKind write FKind; + { Громкость как множитель: 1 — как в исходнике, 0 — тишина, 2 — вдвое + громче. Хранится множителем, а не в децибелах, чтобы не переводить + туда-сюда при каждой отрисовке; в интерфейсе показывается процентами. } + property Volume: Double read FVolume write FVolume; + { Выделение живёт только в памяти и в файл проекта не пишется. } + property Selected: Boolean read FSelected write FSelected; + end; + + TTrack = class + private + FId: string; + FName: string; + FMuted: Boolean; + FSolo: Boolean; + FClips: TObjectList; + function GetClip(AIndex: Integer): TClip; + function GetCount: Integer; + public + constructor Create; + destructor Destroy; override; + procedure Add(AClip: TClip); + procedure Remove(AClip: TClip); + procedure Extract(AClip: TClip); + procedure Sort; + function ClipAt(const ATime: Double): TClip; + function IndexOf(AClip: TClip): Integer; + function EndTime: Double; + property Clips[AIndex: Integer]: TClip read GetClip; default; + property Count: Integer read GetCount; + property Id: string read FId write FId; + property Name: string read FName write FName; + property Muted: Boolean read FMuted write FMuted; + { Когда хоть у одной дорожки включено «соло», в результат идут только + такие дорожки. Удобно, чтобы послушать одну, не выключая остальные + по очереди. } + property Solo: Boolean read FSolo write FSolo; + end; + + TProject = class + private + FPool: TObjectList; + FTracks: TObjectList; + FMaster: TMediaInfo; + FRippleMode: TRippleMode; + FRippleEnabled: Boolean; + FFileName: string; + FModified: Boolean; + FNextId: Integer; + FUndo: TStringList; + FRedo: TStringList; + function GetPoolItem(AIndex: Integer): TMediaItem; + function GetPoolCount: Integer; + function GetTrack(AIndex: Integer): TTrack; + function GetTrackCount: Integer; + function NewId(const APrefix: string): string; + function Serialize: string; + procedure Deserialize(const AText: string); + public + constructor Create; + destructor Destroy; override; + + procedure Clear; + procedure NewProject; + + function AddMedia(const APath: string; const AInfo: TMediaInfo): TMediaItem; + function FindMedia(const AId: string): TMediaItem; + function FindMediaByPath(const APath: string): TMediaItem; + procedure RemoveMedia(AItem: TMediaItem); + + function AddTrack(const AName: string): TTrack; + function FindTrack(const AId: string): TTrack; + procedure RemoveTrack(AIndex: Integer); + procedure MoveTrack(AFrom, ATo: Integer); + + function AddClip(ATrack: TTrack; AMedia: TMediaItem; + const ASrcIn, ADuration, ATlStart: Double): TClip; + function FindClipTrack(AClip: TClip): TTrack; + procedure DeleteClip(AClip: TClip); + procedure ClearSelection; + function SelectedCount: Integer; + + { Общая длина монтажа — до конца самого правого клипа. } + function EndTime: Double; + + { Есть ли хоть одна дорожка в режиме «соло». } + function AnySolo: Boolean; + { Участвует ли дорожка в результате с учётом выключения и «соло». } + function TrackAudible(ATrack: TTrack): Boolean; + + { Параметры проекта берутся у первого добавленного видеофайла. } + procedure AdoptMasterFrom(const AInfo: TMediaInfo); + function MasterSet: Boolean; + + { Каталог для нарезки, сгенерированных клипов и кэша индексов. } + function CacheDir: string; + + { Индекс опорных кадров файла, с запоминанием в памяти и на диске. } + function KeyframeIndexOf(AItem: TMediaItem; out AIndex: TKeyframeIndex; + out AError: string): Boolean; + + { --- Отмена --- } + { Вызывать ПЕРЕД изменением. } + procedure BeginChange; + { Отменить заявку на изменение, если оно так и не состоялось. + + Нужно там, где намерение изменить возникает раньше самого изменения: + нажали кнопку мыши на клипе, но отпустили не сдвинув. Без этого + каждое такое нажатие оставляло бы в истории пустой шаг, и «отменить» + приходилось бы жать по многу раз впустую. } + procedure CancelChange; + procedure Undo; + procedure Redo; + function CanUndo: Boolean; + function CanRedo: Boolean; + + { --- Файл проекта --- } + function SaveToFile(const APath: string; out AError: string): Boolean; + function LoadFromFile(const APath: string; out AError: string): Boolean; + + property Pool[AIndex: Integer]: TMediaItem read GetPoolItem; + property PoolCount: Integer read GetPoolCount; + property Tracks[AIndex: Integer]: TTrack read GetTrack; + property TrackCount: Integer read GetTrackCount; + property Master: TMediaInfo read FMaster write FMaster; + { Режим действует всегда, даже когда автосхлопывание выключено: + он определяет, что сделает Ctrl+Shift+R. } + property RippleMode: TRippleMode read FRippleMode write FRippleMode; + { Автоматическое схлопывание при перетаскивании клипов. } + property RippleEnabled: Boolean read FRippleEnabled write FRippleEnabled; + property FileName: string read FFileName write FFileName; + property Modified: Boolean read FModified write FModified; + end; + +const + { Сколько длится картинка, пока её не растянули. } + DefaultImageDuration = 5.0; + +implementation + +uses + jsonparser, jsonscanner, Math; + +const + ProjectFormatVersion = 1; + MaxUndoDepth = 100; + +{ --- TMediaItem --- } + +constructor TMediaItem.Create; +begin + inherited Create; + FTransform := DefaultTransform; +end; + +function TMediaItem.EffectivePath: string; +begin + if FNormalizedPath <> '' then + Result := FNormalizedPath + else + Result := FPath; +end; + +{ --- TClip --- } + +constructor TClip.Create; +begin + inherited Create; + { Без явного значения множитель был бы нулём, то есть тишиной. } + FVolume := 1; +end; + +function TClip.TlEnd: Double; +begin + Result := FTlStart + FDuration; +end; + +function TClip.SrcOut: Double; +begin + Result := FSrcIn + FDuration; +end; + +function TClip.Covers(const ATime: Double): Boolean; +begin + Result := (ATime >= FTlStart) and (ATime < TlEnd); +end; + +{ --- TTrack --- } + +constructor TTrack.Create; +begin + inherited Create; + FClips := TObjectList.Create(True); +end; + +destructor TTrack.Destroy; +begin + FClips.Free; + inherited Destroy; +end; + +function TTrack.GetClip(AIndex: Integer): TClip; +begin + Result := TClip(FClips[AIndex]); +end; + +function TTrack.GetCount: Integer; +begin + Result := FClips.Count; +end; + +procedure TTrack.Add(AClip: TClip); +begin + FClips.Add(AClip); + Sort; +end; + +procedure TTrack.Remove(AClip: TClip); +begin + FClips.Remove(AClip); +end; + +procedure TTrack.Extract(AClip: TClip); +begin + { Именно Extract, а не Remove: список владеет объектами и Remove их + уничтожает, а при переносе клипа на другую дорожку он нужен живым. } + FClips.Extract(AClip); +end; + +function CompareClips(Item1, Item2: Pointer): Integer; +var + A, B: TClip; +begin + A := TClip(Item1); + B := TClip(Item2); + if A.TlStart < B.TlStart then + Result := -1 + else if A.TlStart > B.TlStart then + Result := 1 + else + Result := 0; +end; + +procedure TTrack.Sort; +begin + FClips.Sort(@CompareClips); +end; + +function TTrack.ClipAt(const ATime: Double): TClip; +var + I: Integer; +begin + { Клипы отсортированы и не перекрываются в пределах дорожки, так что + достаточно линейного прохода. Дорожка редко содержит столько клипов, + чтобы двоичный поиск дал заметную выгоду. } + for I := 0 to FClips.Count - 1 do + if TClip(FClips[I]).Covers(ATime) then + Exit(TClip(FClips[I])); + Result := nil; +end; + +function TTrack.IndexOf(AClip: TClip): Integer; +begin + Result := FClips.IndexOf(AClip); +end; + +function TTrack.EndTime: Double; +var + I: Integer; +begin + Result := 0; + for I := 0 to FClips.Count - 1 do + Result := Max(Result, TClip(FClips[I]).TlEnd); +end; + +{ --- TProject --- } + +constructor TProject.Create; +begin + inherited Create; + FPool := TObjectList.Create(True); + FTracks := TObjectList.Create(True); + FUndo := TStringList.Create; + FRedo := TStringList.Create; + FNextId := 1; +end; + +destructor TProject.Destroy; +begin + FRedo.Free; + FUndo.Free; + FTracks.Free; + FPool.Free; + inherited Destroy; +end; + +procedure TProject.Clear; +begin + FPool.Clear; + FTracks.Clear; + FUndo.Clear; + FRedo.Clear; + { Именно Default, а не FillChar: в записи есть строки, и обнуление + их указателей побайтно оставило бы память занятой навсегда. } + FMaster := Default(TMediaInfo); + FRippleMode := rmCurrentTrack; + FRippleEnabled := False; + FFileName := ''; + FModified := False; + FNextId := 1; +end; + +procedure TProject.NewProject; +begin + Clear; + { Две дорожки с самого начала: одна пустая дорожка не показывает главного — + что верхняя перекрывает нижнюю. } + AddTrack('V1'); + AddTrack('V2'); + FModified := False; +end; + +function TProject.GetPoolItem(AIndex: Integer): TMediaItem; +begin + Result := TMediaItem(FPool[AIndex]); +end; + +function TProject.GetPoolCount: Integer; +begin + Result := FPool.Count; +end; + +function TProject.GetTrack(AIndex: Integer): TTrack; +begin + Result := TTrack(FTracks[AIndex]); +end; + +function TProject.GetTrackCount: Integer; +begin + Result := FTracks.Count; +end; + +function TProject.NewId(const APrefix: string): string; +begin + Result := APrefix + IntToStr(FNextId); + Inc(FNextId); +end; + +function TProject.AddMedia(const APath: string; const AInfo: TMediaInfo): TMediaItem; +begin + Result := TMediaItem.Create; + Result.Id := NewId('m'); + Result.Path := APath; + Result.Info := AInfo; + FPool.Add(Result); + FModified := True; + + { Первый добавленный видеофайл задаёт параметры проекта: с ними будут + сравниваться все следующие и в них будут генерироваться картинки. } + if (not MasterSet) and (AInfo.Kind = mkVideo) then + AdoptMasterFrom(AInfo); +end; + +function TProject.FindMedia(const AId: string): TMediaItem; +var + I: Integer; +begin + for I := 0 to FPool.Count - 1 do + if TMediaItem(FPool[I]).Id = AId then + Exit(TMediaItem(FPool[I])); + Result := nil; +end; + +function TProject.FindMediaByPath(const APath: string): TMediaItem; +var + I: Integer; +begin + for I := 0 to FPool.Count - 1 do + if TMediaItem(FPool[I]).Path = APath then + Exit(TMediaItem(FPool[I])); + Result := nil; +end; + +procedure TProject.RemoveMedia(AItem: TMediaItem); +var + T, C: Integer; + Track: TTrack; +begin + if AItem = nil then + Exit; + { Клипы, которые ссылались на файл, теряют смысл вместе с ним. } + for T := 0 to FTracks.Count - 1 do + begin + Track := TTrack(FTracks[T]); + for C := Track.Count - 1 downto 0 do + if Track[C].MediaId = AItem.Id then + Track.Remove(Track[C]); + end; + FPool.Remove(AItem); + FModified := True; +end; + +function TProject.AddTrack(const AName: string): TTrack; +begin + Result := TTrack.Create; + Result.Id := NewId('t'); + Result.Name := AName; + FTracks.Add(Result); + FModified := True; +end; + +function TProject.FindTrack(const AId: string): TTrack; +var + I: Integer; +begin + for I := 0 to FTracks.Count - 1 do + if TTrack(FTracks[I]).Id = AId then + Exit(TTrack(FTracks[I])); + Result := nil; +end; + +procedure TProject.RemoveTrack(AIndex: Integer); +begin + if (AIndex < 0) or (AIndex >= FTracks.Count) then + Exit; + FTracks.Delete(AIndex); + FModified := True; +end; + +procedure TProject.MoveTrack(AFrom, ATo: Integer); +begin + if (AFrom < 0) or (AFrom >= FTracks.Count) then + Exit; + if (ATo < 0) or (ATo >= FTracks.Count) then + Exit; + FTracks.Move(AFrom, ATo); + FModified := True; +end; + +function TProject.AddClip(ATrack: TTrack; AMedia: TMediaItem; + const ASrcIn, ADuration, ATlStart: Double): TClip; +begin + Result := TClip.Create; + Result.Id := NewId('c'); + Result.MediaId := AMedia.Id; + Result.SrcIn := ASrcIn; + Result.Duration := ADuration; + Result.TlStart := ATlStart; + Result.EdgeIn := edSnap; + Result.EdgeOut := edSnap; + if AMedia.Info.Kind = mkImage then + Result.Kind := ckImage + else + Result.Kind := ckVideo; + ATrack.Add(Result); + FModified := True; +end; + +function TProject.FindClipTrack(AClip: TClip): TTrack; +var + I: Integer; +begin + for I := 0 to FTracks.Count - 1 do + if TTrack(FTracks[I]).IndexOf(AClip) >= 0 then + Exit(TTrack(FTracks[I])); + Result := nil; +end; + +procedure TProject.DeleteClip(AClip: TClip); +var + Track: TTrack; +begin + Track := FindClipTrack(AClip); + if Track <> nil then + begin + Track.Remove(AClip); + FModified := True; + end; +end; + +procedure TProject.ClearSelection; +var + T, C: Integer; +begin + for T := 0 to FTracks.Count - 1 do + for C := 0 to TTrack(FTracks[T]).Count - 1 do + TTrack(FTracks[T])[C].Selected := False; +end; + +function TProject.SelectedCount: Integer; +var + T, C: Integer; +begin + Result := 0; + for T := 0 to FTracks.Count - 1 do + for C := 0 to TTrack(FTracks[T]).Count - 1 do + if TTrack(FTracks[T])[C].Selected then + Inc(Result); +end; + +function TProject.EndTime: Double; +var + I: Integer; +begin + Result := 0; + for I := 0 to FTracks.Count - 1 do + Result := Max(Result, TTrack(FTracks[I]).EndTime); +end; + +function TProject.AnySolo: Boolean; +var + I: Integer; +begin + for I := 0 to FTracks.Count - 1 do + if TTrack(FTracks[I]).Solo then + Exit(True); + Result := False; +end; + +function TProject.TrackAudible(ATrack: TTrack): Boolean; +begin + Result := False; + if ATrack = nil then + Exit; + if ATrack.Muted then + Exit; + { «Соло» сильнее выключения: раз его включили, всё остальное молчит. } + if AnySolo then + Exit(ATrack.Solo); + Result := True; +end; + +procedure TProject.AdoptMasterFrom(const AInfo: TMediaInfo); +begin + FMaster := AInfo; + { Длительность конкретного файла к параметрам проекта отношения не имеет. } + FMaster.Duration := 0; + FModified := True; +end; + +function TProject.MasterSet: Boolean; +begin + Result := FMaster.Valid; +end; + +function TProject.CacheDir: string; +begin + if FFileName = '' then + { Проект ещё не сохранён — держим кэш рядом с программой, чтобы не + разбрасывать файлы по системным каталогам. } + Result := IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0))) + + 'unsaved.nlve-cache' + PathDelim + else + Result := IncludeTrailingPathDelimiter(ExtractFilePath(FFileName)) + + ChangeFileExt(ExtractFileName(FFileName), '') + '.nlve-cache' + PathDelim; +end; + +function TProject.KeyframeIndexOf(AItem: TMediaItem; out AIndex: TKeyframeIndex; + out AError: string): Boolean; +begin + AError := ''; + if AItem = nil then + begin + AError := 'Файл не задан.'; + Exit(False); + end; + + { Запоминание в памяти: за один экспорт индекс спрашивают столько раз, + сколько кусков взято из файла. } + if AItem.IndexLoaded then + begin + AIndex := AItem.Index; + Exit(True); + end; + + Result := CachedKeyframeIndex(CacheDir, AItem.EffectivePath, AIndex, AError); + if Result then + begin + AItem.Index := AIndex; + AItem.IndexLoaded := True; + end; +end; + +{ --- Отмена --- } + +procedure TProject.BeginChange; +begin + FUndo.Add(Serialize); + while FUndo.Count > MaxUndoDepth do + FUndo.Delete(0); + { Новое действие обрывает ветку повторов: возвращаться уже некуда. } + FRedo.Clear; + FModified := True; +end; + +procedure TProject.CancelChange; +begin + if FUndo.Count = 0 then + Exit; + { Просто выбрасываем последний снимок. Именно выбрасываем, а не + применяем: состояние и так не менялось, а применение засорило бы + историю повторов. } + FUndo.Delete(FUndo.Count - 1); +end; + +function TProject.CanUndo: Boolean; +begin + Result := FUndo.Count > 0; +end; + +function TProject.CanRedo: Boolean; +begin + Result := FRedo.Count > 0; +end; + +procedure TProject.Undo; +var + Snapshot: string; +begin + if FUndo.Count = 0 then + Exit; + FRedo.Add(Serialize); + Snapshot := FUndo[FUndo.Count - 1]; + FUndo.Delete(FUndo.Count - 1); + Deserialize(Snapshot); + FModified := True; +end; + +procedure TProject.Redo; +var + Snapshot: string; +begin + if FRedo.Count = 0 then + Exit; + FUndo.Add(Serialize); + Snapshot := FRedo[FRedo.Count - 1]; + FRedo.Delete(FRedo.Count - 1); + Deserialize(Snapshot); + FModified := True; +end; + +{ --- Чтение и запись --- } + +function JsonToTransform(AObj: TJSONObject): TMediaTransform; +begin + Result := DefaultTransform; + if AObj = nil then + Exit; + Result.Fit := StrToFitMode(AObj.Get('fit', 'fit')); + Result.Rotation := AObj.Get('rotation', 0); + Result.FlipH := AObj.Get('flip_h', False); + Result.FlipV := AObj.Get('flip_v', False); + Result.Zoom := AObj.Get('zoom', Double(1)); + Result.OffsetX := AObj.Get('offset_x', Double(0)); + Result.OffsetY := AObj.Get('offset_y', Double(0)); + if Result.Zoom <= 0 then + Result.Zoom := 1; +end; + +function RippleModeToStr(AMode: TRippleMode): string; +begin + if AMode = rmAllTracks then + Result := 'all' + else + Result := 'current'; +end; + +function StrToRippleMode(const AValue: string): TRippleMode; +begin + if AValue = 'all' then + Result := rmAllTracks + else + Result := rmCurrentTrack; +end; + +function EdgeToStr(AEdge: TEdgeMode): string; +begin + if AEdge = edPrecise then + Result := 'precise' + else + Result := 'snap'; +end; + +function StrToEdge(const AValue: string): TEdgeMode; +begin + if AValue = 'precise' then + Result := edPrecise + else + Result := edSnap; +end; + +function KindToStr(AKind: TClipKind): string; +begin + case AKind of + ckImage: Result := 'image'; + ckBlack: Result := 'black'; + else + Result := 'video'; + end; +end; + +function StrToKind(const AValue: string): TClipKind; +begin + if AValue = 'image' then + Result := ckImage + else if AValue = 'black' then + Result := ckBlack + else + Result := ckVideo; +end; + +function MediaKindToStr(AKind: TMediaKind): string; +begin + case AKind of + mkImage: Result := 'image'; + mkVideo: Result := 'video'; + else + Result := 'unknown'; + end; +end; + +function StrToMediaKind(const AValue: string): TMediaKind; +begin + if AValue = 'image' then + Result := mkImage + else if AValue = 'video' then + Result := mkVideo + else + Result := mkUnknown; +end; + +function InfoToJson(const AInfo: TMediaInfo): TJSONObject; +begin + Result := TJSONObject.Create; + Result.Add('valid', AInfo.Valid); + Result.Add('kind', MediaKindToStr(AInfo.Kind)); + Result.Add('format_name', AInfo.FormatName); + Result.Add('duration', AInfo.Duration); + Result.Add('has_video', AInfo.HasVideo); + Result.Add('video_codec', AInfo.VideoCodec); + Result.Add('video_profile', AInfo.VideoProfile); + Result.Add('pix_fmt', AInfo.PixFmt); + Result.Add('width', AInfo.Width); + Result.Add('height', AInfo.Height); + Result.Add('fps_num', AInfo.FpsNum); + Result.Add('fps_den', AInfo.FpsDen); + Result.Add('video_bitrate', AInfo.VideoBitrate); + Result.Add('has_audio', AInfo.HasAudio); + Result.Add('audio_codec', AInfo.AudioCodec); + Result.Add('sample_rate', AInfo.SampleRate); + Result.Add('channels', AInfo.Channels); + Result.Add('channel_layout', AInfo.ChannelLayout); + Result.Add('audio_bitrate', AInfo.AudioBitrate); + Result.Add('extra_streams', AInfo.ExtraStreams); +end; + +function JsonToInfo(AObj: TJSONObject): TMediaInfo; +begin + Result := Default(TMediaInfo); + if AObj = nil then + Exit; + Result.Valid := AObj.Get('valid', False); + Result.Kind := StrToMediaKind(AObj.Get('kind', 'unknown')); + Result.FormatName := AObj.Get('format_name', ''); + Result.Duration := AObj.Get('duration', Double(0)); + Result.HasVideo := AObj.Get('has_video', False); + Result.VideoCodec := AObj.Get('video_codec', ''); + Result.VideoProfile := AObj.Get('video_profile', ''); + Result.PixFmt := AObj.Get('pix_fmt', ''); + Result.Width := AObj.Get('width', 0); + Result.Height := AObj.Get('height', 0); + Result.FpsNum := AObj.Get('fps_num', 0); + Result.FpsDen := AObj.Get('fps_den', 0); + Result.VideoBitrate := AObj.Get('video_bitrate', Int64(0)); + Result.HasAudio := AObj.Get('has_audio', False); + Result.AudioCodec := AObj.Get('audio_codec', ''); + Result.SampleRate := AObj.Get('sample_rate', 0); + Result.Channels := AObj.Get('channels', 0); + Result.ChannelLayout := AObj.Get('channel_layout', ''); + Result.AudioBitrate := AObj.Get('audio_bitrate', Int64(0)); + Result.ExtraStreams := AObj.Get('extra_streams', 0); +end; + +function TProject.Serialize: string; +var + Root, Obj: TJSONObject; + PoolArr, TracksArr, ClipsArr: TJSONArray; + I, J: Integer; + Item: TMediaItem; + Track: TTrack; + Clip: TClip; +begin + Root := TJSONObject.Create; + try + Root.Add('version', ProjectFormatVersion); + Root.Add('next_id', FNextId); + Root.Add('master', InfoToJson(FMaster)); + + PoolArr := TJSONArray.Create; + for I := 0 to FPool.Count - 1 do + begin + Item := TMediaItem(FPool[I]); + Obj := TJSONObject.Create; + Obj.Add('id', Item.Id); + Obj.Add('path', Item.Path); + Obj.Add('normalized_path', Item.NormalizedPath); + Obj.Add('info', InfoToJson(Item.Info)); + Obj.Add('transform', TJSONObject.Create([ + 'fit', FitModeToStr(Item.Transform.Fit), + 'rotation', Item.Transform.Rotation, + 'flip_h', Item.Transform.FlipH, + 'flip_v', Item.Transform.FlipV, + 'zoom', Item.Transform.Zoom, + 'offset_x', Item.Transform.OffsetX, + 'offset_y', Item.Transform.OffsetY + ])); + PoolArr.Add(Obj); + end; + Root.Add('pool', PoolArr); + + TracksArr := TJSONArray.Create; + for I := 0 to FTracks.Count - 1 do + begin + Track := TTrack(FTracks[I]); + Obj := TJSONObject.Create; + Obj.Add('id', Track.Id); + Obj.Add('name', Track.Name); + Obj.Add('muted', Track.Muted); + Obj.Add('solo', Track.Solo); + + ClipsArr := TJSONArray.Create; + for J := 0 to Track.Count - 1 do + begin + Clip := Track[J]; + ClipsArr.Add(TJSONObject.Create([ + 'id', Clip.Id, + 'media', Clip.MediaId, + 'src_in', Clip.SrcIn, + 'tl_start', Clip.TlStart, + 'duration', Clip.Duration, + 'edge_in', EdgeToStr(Clip.EdgeIn), + 'edge_out', EdgeToStr(Clip.EdgeOut), + 'kind', KindToStr(Clip.Kind), + 'volume', Clip.Volume + ])); + end; + Obj.Add('clips', ClipsArr); + TracksArr.Add(Obj); + end; + Root.Add('tracks', TracksArr); + + Root.Add('settings', TJSONObject.Create([ + 'ripple_mode', RippleModeToStr(FRippleMode), + 'ripple_enabled', FRippleEnabled + ])); + + Result := Root.FormatJSON; + finally + Root.Free; + end; +end; + +procedure TProject.Deserialize(const AText: string); +var + Parser: TJSONParser; + Root: TJSONData; + Obj, ItemObj, TrackObj, ClipObj, Settings: TJSONObject; + Arr, ClipsArr: TJSONArray; + I, J: Integer; + Item: TMediaItem; + Track: TTrack; + Clip: TClip; +begin + FPool.Clear; + FTracks.Clear; + + Parser := TJSONParser.Create(AText, [joUTF8]); + try + Root := Parser.Parse; + finally + Parser.Free; + end; + + if (Root = nil) or (not (Root is TJSONObject)) then + begin + Root.Free; + Exit; + end; + + try + Obj := TJSONObject(Root); + FNextId := Obj.Get('next_id', 1); + FMaster := JsonToInfo(Obj.Find('master', jtObject) as TJSONObject); + + Arr := Obj.Find('pool', jtArray) as TJSONArray; + if Arr <> nil then + for I := 0 to Arr.Count - 1 do + begin + if not (Arr.Items[I] is TJSONObject) then + Continue; + ItemObj := TJSONObject(Arr.Items[I]); + Item := TMediaItem.Create; + Item.Id := ItemObj.Get('id', ''); + Item.Path := ItemObj.Get('path', ''); + Item.NormalizedPath := ItemObj.Get('normalized_path', ''); + Item.Info := JsonToInfo(ItemObj.Find('info', jtObject) as TJSONObject); + Item.Transform := JsonToTransform( + ItemObj.Find('transform', jtObject) as TJSONObject); + FPool.Add(Item); + end; + + Arr := Obj.Find('tracks', jtArray) as TJSONArray; + if Arr <> nil then + for I := 0 to Arr.Count - 1 do + begin + if not (Arr.Items[I] is TJSONObject) then + Continue; + TrackObj := TJSONObject(Arr.Items[I]); + Track := TTrack.Create; + Track.Id := TrackObj.Get('id', ''); + Track.Name := TrackObj.Get('name', ''); + Track.Muted := TrackObj.Get('muted', False); + Track.Solo := TrackObj.Get('solo', False); + FTracks.Add(Track); + + ClipsArr := TrackObj.Find('clips', jtArray) as TJSONArray; + if ClipsArr <> nil then + for J := 0 to ClipsArr.Count - 1 do + begin + if not (ClipsArr.Items[J] is TJSONObject) then + Continue; + ClipObj := TJSONObject(ClipsArr.Items[J]); + Clip := TClip.Create; + Clip.Id := ClipObj.Get('id', ''); + Clip.MediaId := ClipObj.Get('media', ''); + Clip.SrcIn := ClipObj.Get('src_in', Double(0)); + Clip.TlStart := ClipObj.Get('tl_start', Double(0)); + Clip.Duration := ClipObj.Get('duration', Double(0)); + Clip.EdgeIn := StrToEdge(ClipObj.Get('edge_in', 'snap')); + Clip.EdgeOut := StrToEdge(ClipObj.Get('edge_out', 'snap')); + Clip.Kind := StrToKind(ClipObj.Get('kind', 'video')); + Clip.Volume := ClipObj.Get('volume', Double(1)); + Track.Add(Clip); + end; + Track.Sort; + end; + + Settings := Obj.Find('settings', jtObject) as TJSONObject; + if Settings <> nil then + begin + FRippleMode := StrToRippleMode(Settings.Get('ripple_mode', 'current')); + FRippleEnabled := Settings.Get('ripple_enabled', False); + { Старые проекты хранили один флаг «все дорожки». } + if Settings.Get('ripple_all_tracks', False) then + FRippleMode := rmAllTracks; + end; + finally + Root.Free; + end; +end; + +function TProject.SaveToFile(const APath: string; out AError: string): Boolean; +var + Text: TStringList; +begin + AError := ''; + Result := False; + Text := TStringList.Create; + try + { Имя файла назначаем до записи: от него зависит путь к кэшу, который + попадает внутрь проекта косвенно — через сгенерированные клипы. } + FFileName := ExpandFileName(APath); + Text.Text := Serialize; + try + Text.SaveToFile(FFileName); + FModified := False; + Result := True; + except + on E: Exception do + AError := 'Не удалось сохранить проект: ' + E.Message; + end; + finally + Text.Free; + end; +end; + +function TProject.LoadFromFile(const APath: string; out AError: string): Boolean; +var + Text: TStringList; +begin + AError := ''; + Result := False; + if not FileExists(APath) then + begin + AError := 'Файл проекта не найден: ' + APath; + Exit; + end; + + Text := TStringList.Create; + try + try + Text.LoadFromFile(APath); + Clear; + Deserialize(Text.Text); + FFileName := ExpandFileName(APath); + FModified := False; + Result := True; + except + on E: Exception do + AError := 'Не удалось прочитать проект: ' + E.Message; + end; + finally + Text.Free; + end; +end; + +end. diff --git a/src/uProjectInfoForm.lfm b/src/uProjectInfoForm.lfm new file mode 100644 index 0000000..f314d10 --- /dev/null +++ b/src/uProjectInfoForm.lfm @@ -0,0 +1,91 @@ +object ProjectInfoForm: TProjectInfoForm + Left = 260 + Height = 640 + Top = 180 + Width = 1400 + Caption = 'Сведения о проекте' + ClientHeight = 640 + ClientWidth = 1400 + OnCreate = FormCreate + Position = poOwnerFormCenter + LCLVersion = '4.6' + object pnlTop: TPanel + Left = 0 + Height = 70 + Top = 0 + Width = 1400 + Align = alTop + BevelOuter = bvNone + ClientHeight = 70 + ClientWidth = 1400 + TabOrder = 0 + object lblMaster: TLabel + Left = 12 + Height = 52 + Top = 8 + Width = 1376 + Anchors = [akTop, akLeft, akRight] + AutoSize = False + Caption = 'Параметры проекта' + ParentColor = False + WordWrap = True + end + end + object grid: TStringGrid + Left = 0 + Height = 300 + Top = 70 + Width = 1400 + Align = alClient + ColCount = 7 + FixedCols = 0 + Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRowSelect, goSmoothScroll] + RowCount = 1 + TabOrder = 1 + end + object memoRaw: TMemo + Left = 0 + Height = 220 + Top = 370 + Width = 1400 + Align = alBottom + Font.Height = -11 + Font.Name = 'Monospace' + ParentFont = False + ReadOnly = True + ScrollBars = ssAutoBoth + TabOrder = 2 + WordWrap = False + end + object pnlBottom: TPanel + Left = 0 + Height = 50 + Top = 590 + Width = 1400 + Align = alBottom + BevelOuter = bvNone + ClientHeight = 50 + ClientWidth = 1400 + TabOrder = 3 + object btnRaw: TThemedButton + Left = 12 + Height = 30 + Top = 8 + Width = 300 + Caption = 'Полный ответ ffprobe для выбранного файла' + OnClick = btnRawClick + TabOrder = 0 + end + object btnClose: TThemedButton + Left = 1288 + Height = 30 + Top = 8 + Width = 100 + Anchors = [akTop, akRight] + Cancel = True + Caption = 'Закрыть' + OnClick = btnCloseClick + TabOrder = 1 + end + end +end diff --git a/src/uProjectInfoForm.pas b/src/uProjectInfoForm.pas new file mode 100644 index 0000000..beab4c9 --- /dev/null +++ b/src/uProjectInfoForm.pas @@ -0,0 +1,226 @@ +{ + uProjectInfoForm — что за материал лежит в проекте. + + Смысл окна в одном вопросе: почему этот файл нельзя скопировать, а тот + можно. Поэтому рядом с параметрами каждого файла показано, чем он + отличается от параметров проекта и что из этого следует при сборке. + + Отдельно доступен полный ответ ffprobe: иногда причина оказывается в + чём-то, о чём программа не спрашивала. +} +unit uProjectInfoForm; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Forms, Controls, Graphics, StdCtrls, Grids, ExtCtrls, + ComCtrls, uProject, uMediaProbe, uTheme, uThemedScroll; + +type + + { TProjectInfoForm } + + TProjectInfoForm = class(TForm) + btnClose: TThemedButton; + btnRaw: TThemedButton; + grid: TStringGrid; + lblMaster: TLabel; + memoRaw: TMemo; + pnlBottom: TPanel; + pnlTop: TPanel; + procedure btnCloseClick(Sender: TObject); + procedure btnRawClick(Sender: TObject); + procedure FormCreate(Sender: TObject); + private + FProject: TProject; + public + procedure Fill(AProject: TProject); + end; + +procedure ShowProjectInfo(AOwner: TComponent; AProject: TProject); + +implementation + +{$R *.lfm} + +uses + uAppTypes, uTransform, uFfmpegCmd, uProcRunner; + +const + ColFile = 0; + ColKind = 1; + ColVideo = 2; + ColAudio = 3; + ColDuration = 4; + ColFit = 5; + ColVerdict = 6; + +type + { Собирает ответ ffprobe целиком: он приходит одним куском JSON. } + TRawCollector = class + private + FText: string; + public + procedure Line(const ALine: string); + property Text: string read FText; + end; + +procedure TRawCollector.Line(const ALine: string); +begin + FText := FText + ALine + LineEnding; +end; + +{ TProjectInfoForm } + +procedure TProjectInfoForm.FormCreate(Sender: TObject); +begin + { Цвета задаём сами: системная тема может быть светлой, и тогда + тёмный таймлайн оказался бы в белой рамке. } + ApplyDarkTheme(Self); + { Системные полосы прокрутки у таблицы светлые и цвета не берут — + заменяем своими. } + AttachThemedScrollBars(grid); + Caption := 'Сведения о проекте'; + grid.ColCount := 7; + grid.RowCount := 1; + grid.FixedRows := 1; + grid.Cells[ColFile, 0] := 'Файл'; + grid.Cells[ColKind, 0] := 'Вид'; + grid.Cells[ColVideo, 0] := 'Видео'; + grid.Cells[ColAudio, 0] := 'Звук'; + grid.Cells[ColDuration, 0] := 'Длительность'; + grid.Cells[ColFit, 0] := 'Вписывание'; + grid.Cells[ColVerdict, 0] := 'При сборке'; + grid.ColWidths[ColFile] := 260; + grid.ColWidths[ColKind] := 90; + grid.ColWidths[ColVideo] := 260; + grid.ColWidths[ColAudio] := 190; + grid.ColWidths[ColDuration] := 110; + grid.ColWidths[ColFit] := 170; + grid.ColWidths[ColVerdict] := 260; + memoRaw.Clear; +end; + +procedure TProjectInfoForm.Fill(AProject: TProject); +var + I: Integer; + Item: TMediaItem; + Mismatches: TMismatches; + M: TMediaInfo; + Fps: Double; +begin + FProject := AProject; + + M := AProject.Master; + if M.Valid then + begin + Fps := FpsValue(M); + lblMaster.Caption := Format( + 'Параметры проекта: %s %dx%d %.3f к/с, %s, %s %d Гц %d кан.' + LineEnding + + 'С ними сверяется каждый добавляемый файл. Совпал — его куски копируются, ' + + 'не совпал — пересобираются только они.', + [M.VideoCodec, M.Width, M.Height, Fps, M.PixFmt, + M.AudioCodec, M.SampleRate, M.Channels]); + end + else + lblMaster.Caption := 'Параметры проекта ещё не заданы: добавьте видеофайл.'; + + grid.RowCount := AProject.PoolCount + 1; + for I := 0 to AProject.PoolCount - 1 do + begin + Item := AProject.Pool[I]; + grid.Cells[ColFile, I + 1] := ExtractFileName(Item.Path); + + if Item.Info.Kind = mkImage then + grid.Cells[ColKind, I + 1] := 'картинка' + else + grid.Cells[ColKind, I + 1] := 'видео'; + + if Item.Info.HasVideo then + begin + Fps := FpsValue(Item.Info); + grid.Cells[ColVideo, I + 1] := Format('%s %dx%d %.3f к/с %s', + [Item.Info.VideoCodec, Item.Info.Width, Item.Info.Height, + Fps, Item.Info.PixFmt]); + end + else + grid.Cells[ColVideo, I + 1] := 'нет'; + + if Item.Info.HasAudio then + grid.Cells[ColAudio, I + 1] := Format('%s %d Гц %d кан.', + [Item.Info.AudioCodec, Item.Info.SampleRate, Item.Info.Channels]) + else + grid.Cells[ColAudio, I + 1] := 'нет'; + + grid.Cells[ColDuration, I + 1] := SecondsToStr(Item.Info.Duration); + grid.Cells[ColFit, I + 1] := FitModeCaption(Item.Transform.Fit); + + if Item.NormalizedPath <> '' then + grid.Cells[ColVerdict, I + 1] := 'приведён к проекту, копируется' + else + begin + Mismatches := CompareToMaster(AProject.Master, Item.Info); + if Item.Info.Kind = mkImage then + grid.Cells[ColVerdict, I + 1] := 'из него делается клип' + else if HasBlocking(Mismatches) then + grid.Cells[ColVerdict, I + 1] := 'его куски будут пересобраны' + else + grid.Cells[ColVerdict, I + 1] := 'копируется без потерь'; + end; + end; +end; + +procedure TProjectInfoForm.btnRawClick(Sender: TObject); +var + Row: Integer; + Item: TMediaItem; + Collector: TRawCollector; + Res: TProcResult; +begin + Row := grid.Row - 1; + if (FProject = nil) or (Row < 0) or (Row >= FProject.PoolCount) then + begin + memoRaw.Text := 'Выберите файл в таблице.'; + Exit; + end; + Item := FProject.Pool[Row]; + + memoRaw.Text := 'Спрашиваю ffprobe...'; + Application.ProcessMessages; + + Collector := TRawCollector.Create; + try + Res := RunProcess(FfprobeExe, ArgsProbeJson(Item.EffectivePath), + @Collector.Line, nil, nil); + if not Res.Started then + memoRaw.Text := Res.ErrorText + else if Res.ExitCode <> 0 then + memoRaw.Text := 'ffprobe завершился с кодом ' + IntToStr(Res.ExitCode) + else + memoRaw.Text := Collector.Text; + finally + Collector.Free; + end; +end; + +procedure TProjectInfoForm.btnCloseClick(Sender: TObject); +begin + Close; +end; + +procedure ShowProjectInfo(AOwner: TComponent; AProject: TProject); +var + Form: TProjectInfoForm; +begin + Form := TProjectInfoForm.Create(AOwner); + try + Form.Fill(AProject); + Form.ShowModal; + finally + Form.Free; + end; +end; + +end. diff --git a/src/uRemuxForm.lfm b/src/uRemuxForm.lfm new file mode 100644 index 0000000..2c2203d --- /dev/null +++ b/src/uRemuxForm.lfm @@ -0,0 +1,154 @@ +object RemuxForm: TRemuxForm + Left = 320 + Height = 620 + Top = 200 + Width = 940 + Caption = 'Перепаковка файлов' + ClientHeight = 620 + ClientWidth = 940 + OnCloseQuery = FormCloseQuery + OnCreate = FormCreate + OnDropFiles = FormDropFiles + OnShow = FormShow + Position = poScreenCenter + LCLVersion = '4.6' + object pnlTop: TPanel + Left = 0 + Height = 106 + Top = 0 + Width = 940 + Align = alTop + BevelOuter = bvNone + ClientHeight = 106 + ClientWidth = 940 + TabOrder = 0 + object lblHelp: TLabel + Left = 12 + Height = 48 + Top = 8 + Width = 916 + Anchors = [akTop, akLeft, akRight] + AutoSize = False + Caption = 'Смена контейнера без перекодирования.' + ParentColor = False + WordWrap = True + end + object lblTarget: TLabel + Left = 12 + Height = 20 + Top = 68 + Width = 116 + Caption = 'Целевой формат:' + ParentColor = False + end + object cbTargetExt: TComboBox + Left = 136 + Height = 28 + Top = 64 + Width = 100 + ItemHeight = 20 + OnChange = cbTargetExtChange + Style = csDropDownList + TabOrder = 0 + end + object btnAdd: TThemedButton + Left = 252 + Height = 28 + Top = 64 + Width = 120 + Caption = 'Добавить...' + OnClick = btnAddClick + TabOrder = 1 + end + end + object grid: TStringGrid + Left = 0 + Height = 260 + Top = 106 + Width = 940 + Align = alClient + ColCount = 3 + FixedCols = 0 + Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goEditing, goSmoothScroll] + RowCount = 1 + TabOrder = 1 + OnSelectEditor = gridSelectEditor + OnValidateEntry = gridValidateEntry + end + object memoLog: TMemo + Left = 0 + Height = 180 + Top = 366 + Width = 940 + Align = alBottom + Font.Height = -12 + Font.Name = 'Monospace' + ParentFont = False + ReadOnly = True + ScrollBars = ssAutoBoth + TabOrder = 2 + WordWrap = False + end + object pnlBottom: TPanel + Left = 0 + Height = 74 + Top = 546 + Width = 940 + Align = alBottom + BevelOuter = bvNone + ClientHeight = 74 + ClientWidth = 940 + TabOrder = 3 + object pbBar: TProgressBar + Left = 12 + Height = 22 + Top = 8 + Width = 916 + Anchors = [akTop, akLeft, akRight] + TabOrder = 0 + end + object btnStart: TThemedButton + Left = 12 + Height = 30 + Top = 38 + Width = 160 + Caption = 'Перепаковать' + OnClick = btnStartClick + TabOrder = 1 + end + object btnClearDone: TThemedButton + Left = 182 + Height = 30 + Top = 38 + Width = 200 + Caption = 'Очистить завершённые' + OnClick = btnClearDoneClick + TabOrder = 2 + end + object btnClearAll: TThemedButton + Left = 392 + Height = 30 + Top = 38 + Width = 150 + Caption = 'Очистить всё' + OnClick = btnClearAllClick + TabOrder = 3 + end + object btnClose: TThemedButton + Left = 828 + Height = 30 + Top = 38 + Width = 100 + Anchors = [akTop, akRight] + Caption = 'Закрыть' + OnClick = btnCloseClick + TabOrder = 4 + end + end + object OpenDialog: TOpenDialog + Filter = 'Видеофайлы|*.mkv;*.MKV;*.mp4;*.MP4;*.mov;*.MOV;*.avi;*.AVI;*.ts;*.TS|Все файлы|*' + Options = [ofAllowMultiSelect, ofFileMustExist, ofEnableSizing, ofViewDetail] + Left = 860 + Top = 16 + end +end diff --git a/src/uRemuxForm.pas b/src/uRemuxForm.pas new file mode 100644 index 0000000..4936fd2 --- /dev/null +++ b/src/uRemuxForm.pas @@ -0,0 +1,448 @@ +{ + uRemuxForm — окно перепаковки файлов в другой контейнер. + + Устройство повторяет диалог ремукса OBS Studio: таблица со строками + «состояние, исходный файл, целевой файл», последняя строка пустая и + служит приглашением добавить ещё, файлы можно бросать на окно мышью, + кнопка запуска превращается в кнопку остановки. + + Перекодирования здесь нет: меняется только контейнер, потоки копируются + как есть. Поэтому операция упирается в скорость диска. +} +unit uRemuxForm; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ComCtrls, + Grids, ExtCtrls, + uRemuxQueue, uTheme, uThemedScroll; + +type + + { TRemuxForm } + + TRemuxForm = class(TForm) + btnAdd: TThemedButton; + btnClearAll: TThemedButton; + btnClearDone: TThemedButton; + btnClose: TThemedButton; + btnStart: TThemedButton; + cbTargetExt: TComboBox; + grid: TStringGrid; + lblHelp: TLabel; + lblTarget: TLabel; + memoLog: TMemo; + OpenDialog: TOpenDialog; + pbBar: TProgressBar; + pnlBottom: TPanel; + pnlTop: TPanel; + procedure btnAddClick(Sender: TObject); + procedure btnClearAllClick(Sender: TObject); + procedure btnClearDoneClick(Sender: TObject); + procedure btnCloseClick(Sender: TObject); + procedure btnStartClick(Sender: TObject); + procedure cbTargetExtChange(Sender: TObject); + procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); + procedure FormCreate(Sender: TObject); + procedure FormDropFiles(Sender: TObject; const FileNames: array of string); + procedure FormShow(Sender: TObject); + procedure gridSelectEditor(Sender: TObject; aCol, aRow: Integer; + var Editor: TWinControl); + procedure gridValidateEntry(Sender: TObject; aCol, aRow: Integer; + const OldValue: string; var NewValue: string); + private + FEntries: TRemuxEntries; + FThread: TRemuxThread; + FRunning: Boolean; + FStartOnShow: Boolean; + procedure AddFile(const APath: string); + procedure RebuildGrid; + procedure UpdateButtons; + function TargetExt: string; + function HasOverwrites(out AList: string): Boolean; + procedure Log(const AText: string); + procedure ThreadProgress(Sender: TObject); + procedure ThreadLog(Sender: TObject); + procedure ThreadItem(Sender: TObject; AIndex: Integer; + AState: TRemuxState; const AMessage: string); + procedure ThreadDone(Sender: TObject); + public + { Поставить файлы в очередь программно. Используется при запуске + программы с именами файлов: так их можно перетащить на значок + программы или передать из файлового менеджера. } + procedure AddFiles(const APaths: array of string); + { Запустить обработку, как будто нажата кнопка. } + procedure StartQueue; + { Запустить очередь сразу после показа окна. } + property StartQueueOnShow: Boolean read FStartOnShow write FStartOnShow; + property Running: Boolean read FRunning; + end; + +implementation + +{$R *.lfm} + +const + ColState = 0; + ColSource = 1; + ColTarget = 2; + + BarScale = 10000; + +{ TRemuxForm } + +procedure TRemuxForm.FormCreate(Sender: TObject); +begin + { Цвета задаём сами: системная тема может быть светлой, и тогда + тёмный таймлайн оказался бы в белой рамке. } + ApplyDarkTheme(Self); + { Системные полосы прокрутки у таблицы светлые и цвета не берут — + заменяем своими. } + AttachThemedScrollBars(grid); + Caption := 'Перепаковка файлов'; + lblHelp.Caption := + 'Смена контейнера без перекодирования. Перетащите файлы на окно ' + + 'или нажмите «Добавить». Целевой путь можно исправить прямо в таблице.'; + + AllowDropFiles := True; + + grid.ColCount := 3; + grid.RowCount := 1; + grid.FixedRows := 1; + grid.Cells[ColState, 0] := 'Состояние'; + grid.Cells[ColSource, 0] := 'Исходный файл'; + grid.Cells[ColTarget, 0] := 'Целевой файл'; + grid.ColWidths[ColState] := 100; + grid.ColWidths[ColSource] := 380; + grid.ColWidths[ColTarget] := 380; + + cbTargetExt.Items.Clear; + cbTargetExt.Items.Add('.mp4'); + cbTargetExt.Items.Add('.mkv'); + cbTargetExt.Items.Add('.mov'); + cbTargetExt.ItemIndex := 0; + + pbBar.Min := 0; + pbBar.Max := BarScale; + pbBar.Position := 0; + pbBar.Visible := False; + + memoLog.Clear; + RebuildGrid; + UpdateButtons; +end; + +function TRemuxForm.TargetExt: string; +begin + if cbTargetExt.ItemIndex >= 0 then + Result := cbTargetExt.Items[cbTargetExt.ItemIndex] + else + Result := '.mp4'; +end; + +procedure TRemuxForm.AddFile(const APath: string); +var + N: Integer; +begin + N := Length(FEntries); + SetLength(FEntries, N + 1); + FEntries[N].Source := APath; + FEntries[N].Target := SuggestTarget(APath, TargetExt); + FEntries[N].Message := ''; + if FileExists(APath) then + FEntries[N].State := rsReady + else + FEntries[N].State := rsBadPath; +end; + +procedure TRemuxForm.RebuildGrid; +var + I: Integer; + { Не Text: так называется свойство TControl, и внутри метода формы + локальная переменная его перекроет. } + StateText: string; +begin + { Строк на одну больше, чем записей: последняя пустая — приглашение + добавить ещё, как в диалоге OBS. } + grid.RowCount := Length(FEntries) + 2; + for I := 0 to High(FEntries) do + begin + StateText := StateCaption(FEntries[I].State); + if FEntries[I].Message <> '' then + StateText := StateText + ' — ' + FEntries[I].Message; + grid.Cells[ColState, I + 1] := StateText; + grid.Cells[ColSource, I + 1] := FEntries[I].Source; + grid.Cells[ColTarget, I + 1] := FEntries[I].Target; + end; + grid.Cells[ColState, grid.RowCount - 1] := ''; + grid.Cells[ColSource, grid.RowCount - 1] := ''; + grid.Cells[ColTarget, grid.RowCount - 1] := ''; +end; + +procedure TRemuxForm.UpdateButtons; +var + I: Integer; + HasWork, HasDone: Boolean; +begin + HasWork := False; + HasDone := False; + for I := 0 to High(FEntries) do + begin + if FEntries[I].State = rsReady then + HasWork := True; + if FEntries[I].State in [rsDone, rsError, rsBadPath] then + HasDone := True; + end; + + if FRunning then + btnStart.Caption := 'Стоп' + else + btnStart.Caption := 'Перепаковать'; + + btnStart.Enabled := FRunning or HasWork; + btnAdd.Enabled := not FRunning; + btnClearDone.Enabled := (not FRunning) and HasDone; + btnClearAll.Enabled := (not FRunning) and (Length(FEntries) > 0); + cbTargetExt.Enabled := not FRunning; + grid.Enabled := not FRunning; +end; + +procedure TRemuxForm.Log(const AText: string); +begin + if memoLog.Lines.Count > 1000 then + memoLog.Lines.Delete(0); + memoLog.Lines.Add(AText); + memoLog.SelStart := Length(memoLog.Text); +end; + +procedure TRemuxForm.FormShow(Sender: TObject); +begin + if FStartOnShow then + begin + FStartOnShow := False; + StartQueue; + end; +end; + +procedure TRemuxForm.AddFiles(const APaths: array of string); +var + I: Integer; +begin + for I := 0 to High(APaths) do + AddFile(APaths[I]); + RebuildGrid; + UpdateButtons; +end; + +procedure TRemuxForm.StartQueue; +begin + if not FRunning then + btnStartClick(nil); +end; + +procedure TRemuxForm.btnAddClick(Sender: TObject); +var + I: Integer; +begin + if not OpenDialog.Execute then + Exit; + for I := 0 to OpenDialog.Files.Count - 1 do + AddFile(OpenDialog.Files[I]); + RebuildGrid; + UpdateButtons; +end; + +procedure TRemuxForm.FormDropFiles(Sender: TObject; + const FileNames: array of string); +var + I: Integer; +begin + if FRunning then + Exit; + for I := 0 to High(FileNames) do + AddFile(FileNames[I]); + RebuildGrid; + UpdateButtons; +end; + +procedure TRemuxForm.cbTargetExtChange(Sender: TObject); +var + I: Integer; +begin + { Уже обработанные строки не трогаем: их файлы существуют, менять им + имя задним числом бессмысленно. } + for I := 0 to High(FEntries) do + if FEntries[I].State in [rsReady, rsBadPath] then + FEntries[I].Target := SuggestTarget(FEntries[I].Source, TargetExt); + RebuildGrid; +end; + +procedure TRemuxForm.gridSelectEditor(Sender: TObject; aCol, aRow: Integer; + var Editor: TWinControl); +begin + { Править разрешено только целевой путь: состояние вычисляется, а + исходный файл задаётся добавлением. } + if aCol <> ColTarget then + Editor := nil; +end; + +procedure TRemuxForm.gridValidateEntry(Sender: TObject; aCol, aRow: Integer; + const OldValue: string; var NewValue: string); +begin + if (aCol = ColTarget) and (aRow >= 1) and (aRow <= Length(FEntries)) then + FEntries[aRow - 1].Target := NewValue; +end; + +function TRemuxForm.HasOverwrites(out AList: string): Boolean; +var + I: Integer; +begin + AList := ''; + for I := 0 to High(FEntries) do + if (FEntries[I].State = rsReady) and FileExists(FEntries[I].Target) then + AList := AList + LineEnding + FEntries[I].Target; + Result := AList <> ''; +end; + +procedure TRemuxForm.btnStartClick(Sender: TObject); +var + I: Integer; + Overwrites: string; +begin + if FRunning then + begin + if Assigned(FThread) then + begin + FThread.RequestCancel; + btnStart.Enabled := False; + Log('Останавливаю...'); + end; + Exit; + end; + + if HasOverwrites(Overwrites) then + if ThemedMessageDlg('Перепаковка', + 'Эти файлы уже существуют и будут перезаписаны:' + LineEnding + + Overwrites + LineEnding + LineEnding + 'Продолжить?', + mtWarning, [mbYes, mbNo], 0) <> mrYes then + Exit; + + for I := 0 to High(FEntries) do + if FEntries[I].State = rsReady then + begin + FEntries[I].State := rsPending; + FEntries[I].Message := ''; + end; + RebuildGrid; + + FThread := TRemuxThread.Create(FEntries); + FThread.OnProgress := @ThreadProgress; + FThread.OnLog := @ThreadLog; + FThread.OnItem := @ThreadItem; + FThread.OnTerminate := @ThreadDone; + + FRunning := True; + pbBar.Position := 0; + pbBar.Visible := True; + UpdateButtons; + FThread.Start; +end; + +procedure TRemuxForm.ThreadProgress(Sender: TObject); +begin + pbBar.Position := Round(FThread.Fraction * BarScale); +end; + +procedure TRemuxForm.ThreadLog(Sender: TObject); +begin + Log(FThread.PendingLog); +end; + +procedure TRemuxForm.ThreadItem(Sender: TObject; AIndex: Integer; + AState: TRemuxState; const AMessage: string); +begin + { AIndex — номер строки в этом же списке: поток отдаёт исходные номера. } + if (AIndex < 0) or (AIndex > High(FEntries)) then + Exit; + FEntries[AIndex].State := AState; + FEntries[AIndex].Message := AMessage; + RebuildGrid; +end; + +procedure TRemuxForm.ThreadDone(Sender: TObject); +var + I, Ok, Bad: Integer; +begin + FRunning := False; + pbBar.Position := BarScale; + + Ok := 0; + Bad := 0; + for I := 0 to High(FEntries) do + begin + { Всё, что осталось в очереди после остановки, снова становится + готовым к работе. } + if FEntries[I].State in [rsPending, rsInProgress] then + FEntries[I].State := rsReady; + if FEntries[I].State = rsDone then + Inc(Ok); + if FEntries[I].State in [rsError, rsBadPath] then + Inc(Bad); + end; + + RebuildGrid; + UpdateButtons; + + FThread := nil; + + if Bad > 0 then + Log(Format('Завершено. Успешно: %d, с ошибками: %d.', [Ok, Bad])) + else + Log(Format('Завершено. Успешно: %d.', [Ok])); +end; + +procedure TRemuxForm.btnClearDoneClick(Sender: TObject); +var + I, N: Integer; + Kept: TRemuxEntries = nil; +begin + N := 0; + SetLength(Kept, Length(FEntries)); + for I := 0 to High(FEntries) do + if not (FEntries[I].State in [rsDone, rsError, rsBadPath]) then + begin + Kept[N] := FEntries[I]; + Inc(N); + end; + SetLength(Kept, N); + FEntries := Kept; + RebuildGrid; + UpdateButtons; +end; + +procedure TRemuxForm.btnClearAllClick(Sender: TObject); +begin + FEntries := nil; + RebuildGrid; + UpdateButtons; +end; + +procedure TRemuxForm.btnCloseClick(Sender: TObject); +begin + Close; +end; + +procedure TRemuxForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean); +begin + CanClose := not FRunning; + if not CanClose then + begin + ThemedMessageDlg('Перепаковка', + 'Сначала остановите обработку.', mtInformation, [mbOK], 0); + end; +end; + +end. diff --git a/src/uRemuxQueue.pas b/src/uRemuxQueue.pas new file mode 100644 index 0000000..503cc50 --- /dev/null +++ b/src/uRemuxQueue.pas @@ -0,0 +1,372 @@ +{ + uRemuxQueue — перепаковка файлов в другой контейнер без перекодирования. + + Зачем это в видеоредакторе. Когда в монтаже есть хоть один точный рез, + собирать результат приходится в MKV: там перекодированный кусок и + скопированный уживаются, а в MP4 могут не ужиться. Но MKV принимают + не везде, поэтому нужен способ перегнать готовый ролик в MP4 — это + копирование потоков, оно быстрое. + + Устройство очереди повторяет диалог ремукса в OBS Studio + (frontend/dialogs/OBSRemux.cpp): таблица «состояние, исходный файл, + целевой файл», обработка по очереди, остановка на полпути. + + Прогресс по всей очереди считается по размерам файлов, а не по их + количеству и не по длительности: копирование потоков упирается в диск, + поэтому байты — честная мера работы, и узнать их можно мгновенно, не + опрашивая каждый файл заранее. +} +unit uRemuxQueue; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils; + +type + TRemuxState = ( + rsEmpty, // пустая строка-приглашение + rsReady, // готов к обработке + rsPending, // в очереди на этот запуск + rsInProgress, // обрабатывается сейчас + rsDone, // готово + rsBadPath, // исходный файл не найден + rsError // ffmpeg вернул ошибку + ); + + TRemuxEntry = record + State: TRemuxState; + Source: string; + Target: string; + Message: string; + end; + + TRemuxEntries = array of TRemuxEntry; + + { Сообщение потока в интерфейс о смене состояния одной строки. } + TRemuxItemEvent = procedure(Sender: TObject; AIndex: Integer; + AState: TRemuxState; const AMessage: string) of object; + + TRemuxThread = class(TThread) + private + FSources: array of string; + FTargets: array of string; + FSizes: array of Int64; + { Номер записи в исходном списке. Поток берёт в работу не все строки, + и без этого соответствия интерфейсу пришлось бы восстанавливать + его пересчётом — источник ошибок на ровном месте. } + FOrigIndex: array of Integer; + FTotalBytes: Int64; + FDoneBytes: Int64; + + FCancelRequested: Boolean; + FCurrentIndex: Integer; + FCurrentDuration: Double; + FCurrentPosition: Double; + FFraction: Double; + FPendingLog: string; + FPendingMessage: string; + FPendingState: TRemuxState; + FPendingOrigIndex: Integer; + + FOnProgress: TNotifyEvent; + FOnLog: TNotifyEvent; + FOnItem: TRemuxItemEvent; + + FProbeBuf: string; + + procedure SyncProgress; + procedure SyncLog; + procedure SyncItem; + procedure Log(const AText: string); + procedure ReportItem(AIndex: Integer; AState: TRemuxState; + const AMessage: string); + procedure PublishProgress; + + function CancelQuery: Boolean; + procedure ProgressLine(const ALine: string); + procedure ErrorLine(const ALine: string); + procedure ProbeLine(const ALine: string); + function ProbeDuration(const APath: string): Double; + protected + procedure Execute; override; + public + constructor Create(const AEntries: TRemuxEntries); + procedure RequestCancel; + + property Fraction: Double read FFraction; + property CurrentIndex: Integer read FCurrentIndex; + property PendingLog: string read FPendingLog; + + property OnProgress: TNotifyEvent read FOnProgress write FOnProgress; + property OnLog: TNotifyEvent read FOnLog write FOnLog; + property OnItem: TRemuxItemEvent read FOnItem write FOnItem; + end; + +{ Имя целевого файла по исходному: тот же путь, другое расширение. + Если такой файл уже есть, к имени добавляется номер — молча затирать + чужие файлы нельзя. } +function SuggestTarget(const ASource, ATargetExt: string): string; + +function StateCaption(AState: TRemuxState): string; + +implementation + +uses + Math, uAppTypes, uFfmpegCmd, uProcRunner; + +function StateCaption(AState: TRemuxState): string; +begin + case AState of + rsEmpty: Result := ''; + rsReady: Result := 'готов'; + rsPending: Result := 'в очереди'; + rsInProgress: Result := 'идёт'; + rsDone: Result := 'готово'; + rsBadPath: Result := 'нет файла'; + rsError: Result := 'ошибка'; + else + Result := ''; + end; +end; + +function SuggestTarget(const ASource, ATargetExt: string): string; +var + Base, Candidate: string; + N: Integer; +begin + Base := ChangeFileExt(ASource, ''); + Candidate := Base + ATargetExt; + N := 1; + while FileExists(Candidate) or SameText(Candidate, ASource) do + begin + Candidate := Base + ' (' + IntToStr(N) + ')' + ATargetExt; + Inc(N); + end; + Result := Candidate; +end; + +function FileSizeOf(const APath: string): Int64; +var + F: TSearchRec; +begin + Result := 0; + if FindFirst(APath, faAnyFile, F) = 0 then + begin + Result := F.Size; + FindClose(F); + end; +end; + +constructor TRemuxThread.Create(const AEntries: TRemuxEntries); +var + I, N: Integer; +begin + inherited Create(True); + FreeOnTerminate := False; + FCurrentIndex := -1; + + N := 0; + SetLength(FSources, Length(AEntries)); + SetLength(FTargets, Length(AEntries)); + SetLength(FSizes, Length(AEntries)); + SetLength(FOrigIndex, Length(AEntries)); + + for I := 0 to High(AEntries) do + begin + if AEntries[I].State <> rsPending then + Continue; + FSources[N] := AEntries[I].Source; + FTargets[N] := AEntries[I].Target; + FSizes[N] := FileSizeOf(AEntries[I].Source); + FOrigIndex[N] := I; + Inc(FTotalBytes, FSizes[N]); + Inc(N); + end; + + SetLength(FSources, N); + SetLength(FTargets, N); + SetLength(FSizes, N); + SetLength(FOrigIndex, N); +end; + +procedure TRemuxThread.RequestCancel; +begin + FCancelRequested := True; +end; + +function TRemuxThread.CancelQuery: Boolean; +begin + Result := FCancelRequested or Terminated; +end; + +procedure TRemuxThread.SyncProgress; +begin + if Assigned(FOnProgress) then + FOnProgress(Self); +end; + +procedure TRemuxThread.SyncLog; +begin + if Assigned(FOnLog) then + FOnLog(Self); +end; + +procedure TRemuxThread.SyncItem; +begin + if Assigned(FOnItem) then + FOnItem(Self, FPendingOrigIndex, FPendingState, FPendingMessage); +end; + +procedure TRemuxThread.Log(const AText: string); +begin + FPendingLog := AText; + Synchronize(@SyncLog); +end; + +{ AIndex — номер внутри рабочего списка; наружу отдаётся номер строки + исходного списка, чтобы интерфейсу не пришлось ничего пересчитывать. } +procedure TRemuxThread.ReportItem(AIndex: Integer; AState: TRemuxState; + const AMessage: string); +begin + FCurrentIndex := AIndex; + FPendingState := AState; + FPendingMessage := AMessage; + if (AIndex >= 0) and (AIndex <= High(FOrigIndex)) then + FPendingOrigIndex := FOrigIndex[AIndex] + else + FPendingOrigIndex := -1; + Synchronize(@SyncItem); +end; + +procedure TRemuxThread.PublishProgress; +var + CurrentBytes: Int64; + Local: Double; +begin + if FTotalBytes <= 0 then + begin + FFraction := 0; + Synchronize(@SyncProgress); + Exit; + end; + + CurrentBytes := 0; + if (FCurrentIndex >= 0) and (FCurrentIndex <= High(FSizes)) then + CurrentBytes := FSizes[FCurrentIndex]; + + if FCurrentDuration > 0 then + Local := Min(1, FCurrentPosition / FCurrentDuration) + else + Local := 0; + + FFraction := Min(1, (FDoneBytes + Local * CurrentBytes) / FTotalBytes); + Synchronize(@SyncProgress); +end; + +procedure TRemuxThread.ProgressLine(const ALine: string); +var + Seconds: Double; + { Не Finished: у TThread есть одноимённое свойство. } + AtEnd: Boolean; +begin + Seconds := FCurrentPosition; + AtEnd := False; + if not ParseProgressLine(ALine, Seconds, AtEnd) then + Exit; + FCurrentPosition := Seconds; + PublishProgress; +end; + +procedure TRemuxThread.ErrorLine(const ALine: string); +begin + Log('ffmpeg: ' + ALine); +end; + +procedure TRemuxThread.ProbeLine(const ALine: string); +begin + if FProbeBuf = '' then + FProbeBuf := Trim(ALine); +end; + +function TRemuxThread.ProbeDuration(const APath: string): Double; +var + Res: TProcResult; +begin + Result := 0; + FProbeBuf := ''; + Res := RunProcess(FfprobeExe, ArgsProbeDuration(APath), + @ProbeLine, nil, @CancelQuery); + if (not Res.Started) or (Res.ExitCode <> 0) then + Exit; + if not TryStrToFloat(FProbeBuf, Result, InvariantFormat) then + Result := 0; +end; + +procedure TRemuxThread.Execute; +var + I: Integer; + Res: TProcResult; + ToolError: string; +begin + try + if not ToolsAvailable(ToolError) then + begin + Log(ToolError); + Exit; + end; + + for I := 0 to High(FSources) do + begin + if CancelQuery then + Break; + + if not FileExists(FSources[I]) then + begin + ReportItem(I, rsBadPath, 'Файл не найден'); + Inc(FDoneBytes, FSizes[I]); + Continue; + end; + + ReportItem(I, rsInProgress, ''); + FCurrentPosition := 0; + FCurrentDuration := ProbeDuration(FSources[I]); + PublishProgress; + + Log('> ' + CommandToString(FfmpegExe, + ArgsRemux(FSources[I], FTargets[I]))); + + Res := RunProcess(FfmpegExe, ArgsRemux(FSources[I], FTargets[I]), + @ProgressLine, @ErrorLine, @CancelQuery); + + if Res.Cancelled then + begin + ReportItem(I, rsReady, 'Отменено'); + Break; + end + else if not Res.Started then + ReportItem(I, rsError, Res.ErrorText) + else if Res.ExitCode <> 0 then + ReportItem(I, rsError, 'ffmpeg вернул код ' + IntToStr(Res.ExitCode)) + else if not FileExists(FTargets[I]) then + ReportItem(I, rsError, 'Выходного файла нет') + else + ReportItem(I, rsDone, ''); + + Inc(FDoneBytes, FSizes[I]); + FCurrentPosition := 0; + FCurrentDuration := 0; + end; + except + on E: Exception do + Log('Внутренняя ошибка: ' + E.Message); + end; + + FCurrentIndex := -1; + FFraction := 1; + Synchronize(@SyncProgress); +end; + +end. diff --git a/src/uSettings.pas b/src/uSettings.pas new file mode 100644 index 0000000..2b87557 --- /dev/null +++ b/src/uSettings.pas @@ -0,0 +1,236 @@ +{ + uSettings — настройки программы между запусками. + + Хранится то, что раздражает настраивать заново каждый раз: размер окна, + каталоги, из которых последний раз брали файлы, высота дорожек и + положение переключателя схлопывания. + + Формат — JSON, файл лежит в обычном для системы месте для настроек + (~/.config/nlve на Linux, каталог приложения на Windows). Ни одно + значение не является обязательным: испорченный или отсутствующий файл + означает лишь работу со значениями по умолчанию, а не отказ запускаться. +} +unit uSettings; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils; + +type + TSettings = class + private + FWindowLeft: Integer; + FWindowTop: Integer; + FWindowWidth: Integer; + FWindowHeight: Integer; + FWindowMaximized: Boolean; + FLastMediaDir: string; + FLastProjectDir: string; + FLastExportDir: string; + FRippleAllTracks: Boolean; + FRippleEnabled: Boolean; + FTrackHeight: Integer; + FVideoPanelHeight: Integer; + FRecentProjects: TStringList; + function FileName: string; + public + constructor Create; + destructor Destroy; override; + procedure Load; + procedure Save; + + { Заносит проект в начало списка недавних. Повтор поднимается наверх, + а не задваивается. } + procedure NoteRecentProject(const APath: string); + property RecentProjects: TStringList read FRecentProjects; + + property WindowLeft: Integer read FWindowLeft write FWindowLeft; + property WindowTop: Integer read FWindowTop write FWindowTop; + property WindowWidth: Integer read FWindowWidth write FWindowWidth; + property WindowHeight: Integer read FWindowHeight write FWindowHeight; + property WindowMaximized: Boolean read FWindowMaximized write FWindowMaximized; + property LastMediaDir: string read FLastMediaDir write FLastMediaDir; + property LastProjectDir: string read FLastProjectDir write FLastProjectDir; + property LastExportDir: string read FLastExportDir write FLastExportDir; + property RippleAllTracks: Boolean read FRippleAllTracks write FRippleAllTracks; + property RippleEnabled: Boolean read FRippleEnabled write FRippleEnabled; + property TrackHeight: Integer read FTrackHeight write FTrackHeight; + property VideoPanelHeight: Integer read FVideoPanelHeight write FVideoPanelHeight; + end; + +implementation + +uses + fpjson, jsonparser, jsonscanner; + +const + DefaultWidth = 1600; + DefaultHeight = 900; + DefaultTrackHeight = 64; + DefaultVideoHeight = 400; + + { Больше десятка в меню не помещается по-человечески, да и не нужно. } + MaxRecentProjects = 10; + +constructor TSettings.Create; +begin + inherited Create; + FRecentProjects := TStringList.Create; + FWindowLeft := -1; + FWindowTop := -1; + FWindowWidth := DefaultWidth; + FWindowHeight := DefaultHeight; + FTrackHeight := DefaultTrackHeight; + FVideoPanelHeight := DefaultVideoHeight; +end; + +destructor TSettings.Destroy; +begin + FRecentProjects.Free; + inherited Destroy; +end; + +procedure TSettings.NoteRecentProject(const APath: string); +var + Idx: Integer; +begin + if APath = '' then + Exit; + Idx := FRecentProjects.IndexOf(APath); + if Idx >= 0 then + FRecentProjects.Delete(Idx); + FRecentProjects.Insert(0, APath); + while FRecentProjects.Count > MaxRecentProjects do + FRecentProjects.Delete(FRecentProjects.Count - 1); +end; + +function TSettings.FileName: string; +begin + Result := IncludeTrailingPathDelimiter(GetAppConfigDir(False)) + 'settings.json'; +end; + +procedure TSettings.Load; +var + Text: TStringList; + Parser: TJSONParser; + Root: TJSONData; + Obj: TJSONObject; + Arr: TJSONArray; + I: Integer; +begin + if not FileExists(FileName) then + Exit; + + Text := TStringList.Create; + try + try + Text.LoadFromFile(FileName); + Parser := TJSONParser.Create(Text.Text, [joUTF8]); + try + Root := Parser.Parse; + finally + Parser.Free; + end; + except + { Испорченный файл настроек — не повод не запускаться. } + Exit; + end; + finally + Text.Free; + end; + + if (Root = nil) or (not (Root is TJSONObject)) then + begin + Root.Free; + Exit; + end; + + try + Obj := TJSONObject(Root); + FWindowLeft := Obj.Get('window_left', FWindowLeft); + FWindowTop := Obj.Get('window_top', FWindowTop); + FWindowWidth := Obj.Get('window_width', FWindowWidth); + FWindowHeight := Obj.Get('window_height', FWindowHeight); + FWindowMaximized := Obj.Get('window_maximized', FWindowMaximized); + FLastMediaDir := Obj.Get('last_media_dir', FLastMediaDir); + FLastProjectDir := Obj.Get('last_project_dir', FLastProjectDir); + FLastExportDir := Obj.Get('last_export_dir', FLastExportDir); + FRippleAllTracks := Obj.Get('ripple_all_tracks', FRippleAllTracks); + FRippleEnabled := Obj.Get('ripple_enabled', FRippleEnabled); + FTrackHeight := Obj.Get('track_height', FTrackHeight); + FVideoPanelHeight := Obj.Get('video_panel_height', FVideoPanelHeight); + + Arr := Obj.Find('recent_projects', jtArray) as TJSONArray; + FRecentProjects.Clear; + if Arr <> nil then + for I := 0 to Arr.Count - 1 do + { Пропавшие файлы в список не тянем: предлагать открыть то, чего + нет, бессмысленно. } + if FileExists(Arr.Strings[I]) then + FRecentProjects.Add(Arr.Strings[I]); + finally + Root.Free; + end; + + { Заведомо негодные значения приводим к разумным: файл настроек могли + поправить руками, а окно высотой в ноль пикселей не откроешь. } + if FWindowWidth < 640 then + FWindowWidth := DefaultWidth; + if FWindowHeight < 480 then + FWindowHeight := DefaultHeight; + if (FTrackHeight < 24) or (FTrackHeight > 300) then + FTrackHeight := DefaultTrackHeight; + if FVideoPanelHeight < 100 then + FVideoPanelHeight := DefaultVideoHeight; +end; + +procedure TSettings.Save; +var + Root: TJSONObject; + Text: TStringList; + Arr: TJSONArray; + I: Integer; +begin + Root := TJSONObject.Create; + try + Root.Add('window_left', FWindowLeft); + Root.Add('window_top', FWindowTop); + Root.Add('window_width', FWindowWidth); + Root.Add('window_height', FWindowHeight); + Root.Add('window_maximized', FWindowMaximized); + Root.Add('last_media_dir', FLastMediaDir); + Root.Add('last_project_dir', FLastProjectDir); + Root.Add('last_export_dir', FLastExportDir); + Root.Add('ripple_all_tracks', FRippleAllTracks); + Root.Add('ripple_enabled', FRippleEnabled); + Root.Add('track_height', FTrackHeight); + Root.Add('video_panel_height', FVideoPanelHeight); + + Arr := TJSONArray.Create; + for I := 0 to FRecentProjects.Count - 1 do + Arr.Add(FRecentProjects[I]); + Root.Add('recent_projects', Arr); + + if not ForceDirectories(ExtractFilePath(FileName)) then + Exit; + + Text := TStringList.Create; + try + Text.Text := Root.FormatJSON; + try + Text.SaveToFile(FileName); + except + { Не смогли сохранить настройки — работать это не мешает. } + end; + finally + Text.Free; + end; + finally + Root.Free; + end; +end; + +end. diff --git a/src/uTheme.pas b/src/uTheme.pas new file mode 100644 index 0000000..8d8fc34 --- /dev/null +++ b/src/uTheme.pas @@ -0,0 +1,863 @@ +{ + uTheme — собственные цвета для всего окна. + + Зачем это нужно. Обычные элементы управления раскрашивает не программа, + а система: под Linux тема GTK, под Windows тема оформления. Одна и та же + программа поэтому выглядит по-разному, и на светлой теме тёмный таймлайн + оказывается вставленным в белую рамку. Здесь цвета заданы явно и + применяются принудительно, а не наследуются. + + Кнопки пришлось написать свои. Системная кнопка под Windows свой цвет + не отдаёт вообще: LCL рисует её через службу оформления, и та кладёт + светлую подложку поверх любого заданного цвета. Проверено по исходникам + LCL (TCustomSpeedButton.PaintBackground всегда вызывает + ThemeServices.DrawElement). + + Чего сделать нельзя, и это надо знать: + + - полосы прокрутки внутри списков и журнала рисует система; + - рамка окна и её кнопки принадлежат оконному менеджеру; + - меню под gtk2 своими руками не рисуется — в LCL это прямо помечено + как неподдерживаемое (interfaces/gtk2/issues.xml). Под Windows + рисуется, там это и нужно. +} +unit uTheme; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Types, Controls, Graphics, Forms, StdCtrls, ExtCtrls, + ComCtrls, Grids, Menus, Dialogs, LCLType, LCLIntf, LCLProc; + +const + { Порядок байт в TColor — $00BBGGRR, а не привычный RGB. У серых цветов + все три байта равны, и перепутать нечего; у остальных в скобках + написано, что это за цвет на самом деле. } + ThemeWindow = TColor($202020); // фон окна + ThemeSurface = TColor($181818); // списки, журнал, таблицы + ThemePanel = TColor($262626); // полосы с кнопками + ThemeText = TColor($DCDCDC); + ThemeTextDim = TColor($909090); // недоступное и второстепенное + ThemeBorder = TColor($464646); + ThemeButton = TColor($3A3A3A); + ThemeButtonHover = TColor($4A4A4A); + ThemeButtonDown = TColor($2A2A2A); + ThemeAccent = TColor($1E5AC8); // оранжевый: включённый переключатель + ThemeAccentText = TColor($FFFFFF); + ThemeSelection = TColor($785434); // приглушённый синий: выделение + ThemeSelText = TColor($FFFFFF); + ThemeGridLine = TColor($3A3A3A); + +type + + { Кнопка, которая рисует себя сама. + + Свойства Default, Cancel и ModalResult повторяют поведение обычной + кнопки: Enter и Esc в окне должны работать так же, иначе привычка + подводит на ровном месте. } + TThemedButton = class(TCustomControl) + private + FArrow: Boolean; + FFlat: Boolean; + FDown: Boolean; + FHover: Boolean; + FPressed: Boolean; + FDefault: Boolean; + FCancel: Boolean; + FModalResult: TModalResult; + procedure SetArrow(AValue: Boolean); + procedure SetFlat(AValue: Boolean); + procedure SetDown(AValue: Boolean); + procedure SetDefault(AValue: Boolean); + procedure SetCancel(AValue: Boolean); + procedure UpdateFormRoles; + protected + procedure Paint; override; + procedure Loaded; override; + procedure MouseEnter; override; + procedure MouseLeave; override; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); override; + procedure KeyDown(var Key: Word; Shift: TShiftState); override; + procedure KeyUp(var Key: Word; Shift: TShiftState); override; + procedure TextChanged; override; + class function GetControlClassDefaultSize: TSize; override; + public + constructor Create(AOwner: TComponent); override; + procedure Click; override; + procedure ExecuteDefaultAction; override; + procedure ExecuteCancelAction; override; + published + property Align; + property Anchors; + { Рисовать треугольник вместо надписи. Знак «▼» из шрифта брать нельзя: + в системном шрифте Windows его может не оказаться, и вместо стрелки + выйдет пустой квадрат. Проверено под Wine — именно так и вышло. } + property Arrow: Boolean read FArrow write SetArrow default False; + property Cancel: Boolean read FCancel write SetCancel default False; + property Caption; + property Default: Boolean read FDefault write SetDefault default False; + property Down: Boolean read FDown write SetDown default False; + property Enabled; + { Без рамки и без своей подложки, пока на кнопку не навели курсор. + Так выглядят названия в полосе меню: это не кнопки, и рисовать их + кнопками значит врать глазу. } + property Flat: Boolean read FFlat write SetFlat default False; + property Font; + property Hint; + property ModalResult: TModalResult read FModalResult write FModalResult + default mrNone; + property ParentFont; + property ParentShowHint; + property ShowHint; + property TabOrder; + property TabStop default True; + property Visible; + property OnClick; + property OnMouseDown; + property OnMouseUp; + end; + +{ Раскрашивает окно и всё, что в нём, включая вложенные панели. + Вызывается один раз после создания окна. } +procedure ApplyDarkTheme(AComponent: TComponent); + +{ Подписывается на появление новых окон и красит их сама. Нужно, чтобы не + забыть про окно, которое создаётся где-то в глубине. Вызывается один раз + при запуске. } +procedure HookNewForms; + +{ Меню в наших цветах. Под gtk2 не действует — там меню рисует GTK. } +procedure ApplyDarkMenu(AMenu: TMenu); + +{ Окно сообщения в наших цветах вместо системного. + + Кнопки задаются готовым набором, как у MessageDlg, но рисуются нашими. + Возвращает mrOk, mrYes, mrNo или mrCancel. } +function ThemedMessageDlg(const ACaption, AText: string; + ADlgType: TMsgDlgType; AButtons: TMsgDlgButtons; + AHelpCtx: Longint = 0): TModalResult; + +implementation + +{$IFDEF WINDOWS} +{ Модуль Windows целиком подключать нельзя: он объявляет свои TRect и + RegisterClass, а имена в Паскале нечувствительны к регистру — и обычные + вызовы LCL начинают разбираться как системные. Поэтому берём ровно то, + что нужно, и ничего больше. } +type + TMenuInfoRec = record + cbSize: DWORD; + fMask: DWORD; + dwStyle: DWORD; + cyMax: UINT; + hbrBack: HBRUSH; + dwContextHelpID: DWORD; + dwMenuData: PtrUInt; + end; + +const + MIM_BACKGROUND = $00000002; + MIM_APPLYTOSUBMENUS = $80000000; + +function SetMenuInfo(AMenu: HMENU; const AInfo: TMenuInfoRec): LongBool; + stdcall; external 'user32' name 'SetMenuInfo'; +{$ENDIF} + +type + { Обработчики отрисовки живут в объекте: событиям нужны методы, а не + обычные процедуры. } + TThemePainter = class + procedure MenuDraw(Sender: TObject; ACanvas: TCanvas; ARect: TRect; + AState: TOwnerDrawState); + procedure MenuMeasure(Sender: TObject; ACanvas: TCanvas; + var AWidth, AHeight: Integer); + procedure ComboDraw(Control: TWinControl; Index: Integer; ARect: TRect; + State: TOwnerDrawState); + procedure FormAdded(Sender: TObject; AForm: TCustomForm); + end; + +var + Painter: TThemePainter; + {$IFDEF WINDOWS} + { Кисть под полосу меню. Создаётся один раз: Windows держит на неё + ссылку, пока меню живо, и удалять её раньше нельзя. } + MenuBrush: HBRUSH; + {$ENDIF} + +const + MenuTextLeft = 26; { отступ слева: место под галочку } + MenuTextRight = 16; { отступ справа: место под стрелку подменю } + MenuGap = 28; { просвет между названием и сочетанием клавиш } + +{ TThemedButton } + +constructor TThemedButton.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + { csHasDefaultAction говорит форме, что нашу кнопку осмысленно + вызывать по Enter; без этого Enter до неё не дойдёт. } + ControlStyle := ControlStyle + [csHasDefaultAction, csHasCancelAction]; + TabStop := True; + DoubleBuffered := True; + with GetControlClassDefaultSize do + SetInitialBounds(0, 0, cx, cy); +end; + +class function TThemedButton.GetControlClassDefaultSize: TSize; +begin + Result.cx := 100; + Result.cy := 28; +end; + +procedure TThemedButton.Paint; +var + R: TRect; + Back, Fore: TColor; + TS: TSize; + CX, CY: Integer; +begin + R := ClientRect; + + if not Enabled then + begin + Back := ThemeButtonDown; + Fore := ThemeTextDim; + end + else if FPressed then + begin + Back := ThemeButtonDown; + Fore := ThemeText; + end + else if FDown then + begin + Back := ThemeAccent; + Fore := ThemeAccentText; + end + else if FHover then + begin + Back := ThemeButtonHover; + Fore := ThemeText; + end + else if FFlat then + begin + Back := ThemePanel; + Fore := ThemeText; + end + else + begin + Back := ThemeButton; + Fore := ThemeText; + end; + + Canvas.Brush.Color := Back; + Canvas.Brush.Style := bsSolid; + Canvas.FillRect(R); + + if not (FFlat and not (FHover or FPressed or FDown)) then + begin + Canvas.Pen.Color := ThemeBorder; + Canvas.Pen.Style := psSolid; + Canvas.Brush.Style := bsClear; + Canvas.Rectangle(R); + end; + + if FArrow then + begin + Canvas.Brush.Color := Fore; + Canvas.Brush.Style := bsSolid; + Canvas.Pen.Color := Fore; + CX := R.Right div 2; + CY := R.Bottom div 2; + { Types.Point указан явно: модуль Windows объявляет тип POINT, а имена + в Паскале нечувствительны к регистру, и без уточнения Point(x, y) + разбирается как приведение типа с двумя аргументами. } + Canvas.Polygon([Point(CX - 5, CY - 2), Point(CX + 5, CY - 2), + Point(CX, CY + 4)]); + end + else + begin + Canvas.Font.Assign(Font); + Canvas.Font.Color := Fore; + TS := Canvas.TextExtent(Caption); + Canvas.TextOut((R.Right - TS.cx) div 2, (R.Bottom - TS.cy) div 2, Caption); + end; + + if Focused then + begin + Canvas.Pen.Color := ThemeTextDim; + Canvas.Pen.Style := psDot; + Canvas.Rectangle(R.Left + 3, R.Top + 3, R.Right - 3, R.Bottom - 3); + Canvas.Pen.Style := psSolid; + end; +end; + +procedure TThemedButton.Loaded; +begin + inherited Loaded; + { Во время чтения формы родителя ещё нет, поэтому роль «кнопка по + умолчанию» назначается здесь, когда форма уже собрана. } + UpdateFormRoles; +end; + +procedure TThemedButton.UpdateFormRoles; +var + F: TCustomForm; +begin + F := GetParentForm(Self); + if F = nil then + Exit; + if FDefault then + F.DefaultControl := Self + else if F.DefaultControl = Self then + F.DefaultControl := nil; + if FCancel then + F.CancelControl := Self + else if F.CancelControl = Self then + F.CancelControl := nil; +end; + +procedure TThemedButton.SetArrow(AValue: Boolean); +begin + if FArrow = AValue then + Exit; + FArrow := AValue; + Invalidate; +end; + +procedure TThemedButton.SetFlat(AValue: Boolean); +begin + if FFlat = AValue then + Exit; + FFlat := AValue; + Invalidate; +end; + +procedure TThemedButton.SetDown(AValue: Boolean); +begin + if FDown = AValue then + Exit; + FDown := AValue; + Invalidate; +end; + +procedure TThemedButton.SetDefault(AValue: Boolean); +begin + if FDefault = AValue then + Exit; + FDefault := AValue; + UpdateFormRoles; +end; + +procedure TThemedButton.SetCancel(AValue: Boolean); +begin + if FCancel = AValue then + Exit; + FCancel := AValue; + UpdateFormRoles; +end; + +procedure TThemedButton.MouseEnter; +begin + inherited MouseEnter; + FHover := True; + Invalidate; +end; + +procedure TThemedButton.MouseLeave; +begin + inherited MouseLeave; + FHover := False; + FPressed := False; + Invalidate; +end; + +procedure TThemedButton.MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + inherited MouseDown(Button, Shift, X, Y); + if Button <> mbLeft then + Exit; + if Enabled and TabStop and CanFocus then + SetFocus; + FPressed := True; + Invalidate; +end; + +procedure TThemedButton.MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +var + WasPressed: Boolean; +begin + WasPressed := FPressed; + FPressed := False; + Invalidate; + inherited MouseUp(Button, Shift, X, Y); + { Щелчком считается только отпускание внутри кнопки: увёл курсор в + сторону — значит передумал. } + if WasPressed and (Button = mbLeft) and + PtInRect(ClientRect, Point(X, Y)) then + Click; +end; + +procedure TThemedButton.KeyDown(var Key: Word; Shift: TShiftState); +begin + inherited KeyDown(Key, Shift); + if (Key = VK_SPACE) or (Key = VK_RETURN) then + begin + FPressed := True; + Invalidate; + end; +end; + +procedure TThemedButton.KeyUp(var Key: Word; Shift: TShiftState); +begin + inherited KeyUp(Key, Shift); + if FPressed and ((Key = VK_SPACE) or (Key = VK_RETURN)) then + begin + FPressed := False; + Invalidate; + Click; + end; +end; + +procedure TThemedButton.TextChanged; +begin + inherited TextChanged; + Invalidate; +end; + +procedure TThemedButton.Click; +var + F: TCustomForm; +begin + inherited Click; + if FModalResult <> mrNone then + begin + F := GetParentForm(Self); + if (F <> nil) and (fsModal in F.FormState) then + F.ModalResult := FModalResult; + end; +end; + +procedure TThemedButton.ExecuteDefaultAction; +begin + if FDefault and Enabled and Visible then + Click; +end; + +procedure TThemedButton.ExecuteCancelAction; +begin + if FCancel and Enabled and Visible then + Click; +end; + +{ TThemePainter } + +procedure TThemePainter.MenuDraw(Sender: TObject; ACanvas: TCanvas; + ARect: TRect; AState: TOwnerDrawState); +var + Item: TMenuItem; + Back, Fore: TColor; + S: string; + Y, H: Integer; +begin + if not (Sender is TMenuItem) then + Exit; + Item := TMenuItem(Sender); + + Back := ThemePanel; + Fore := ThemeText; + if odSelected in AState then + begin + Back := ThemeAccent; + Fore := ThemeAccentText; + end; + if (odDisabled in AState) or (not Item.Enabled) then + Fore := ThemeTextDim; + + ACanvas.Brush.Color := Back; + ACanvas.Brush.Style := bsSolid; + ACanvas.FillRect(ARect); + + if Item.IsLine then + begin + Y := (ARect.Top + ARect.Bottom) div 2; + ACanvas.Pen.Color := ThemeBorder; + ACanvas.Line(ARect.Left + 6, Y, ARect.Right - 6, Y); + Exit; + end; + + ACanvas.Font.Color := Fore; + ACanvas.Brush.Style := bsClear; + H := ACanvas.TextHeight('Wg'); + Y := ARect.Top + (ARect.Bottom - ARect.Top - H) div 2; + + if Item.Checked then + ACanvas.TextOut(ARect.Left + 8, Y, '•'); + + ACanvas.TextOut(ARect.Left + MenuTextLeft, Y, Item.Caption); + + if Item.ShortCut <> 0 then + begin + S := ShortCutToText(Item.ShortCut); + if not (odSelected in AState) then + ACanvas.Font.Color := ThemeTextDim; + ACanvas.TextOut(ARect.Right - MenuTextRight - ACanvas.TextWidth(S), Y, S); + end; +end; + +procedure TThemePainter.MenuMeasure(Sender: TObject; ACanvas: TCanvas; + var AWidth, AHeight: Integer); +var + Item: TMenuItem; + W: Integer; +begin + if not (Sender is TMenuItem) then + Exit; + Item := TMenuItem(Sender); + + if Item.IsLine then + begin + AHeight := 7; + AWidth := 40; + Exit; + end; + + AHeight := ACanvas.TextHeight('Wg') + 10; + W := MenuTextLeft + ACanvas.TextWidth(Item.Caption) + MenuTextRight; + if Item.ShortCut <> 0 then + Inc(W, MenuGap + ACanvas.TextWidth(ShortCutToText(Item.ShortCut))); + AWidth := W; +end; + +procedure TThemePainter.ComboDraw(Control: TWinControl; Index: Integer; + ARect: TRect; State: TOwnerDrawState); +var + Combo: TComboBox; + Back, Fore: TColor; + S: string; +begin + if not (Control is TComboBox) then + Exit; + Combo := TComboBox(Control); + + if odSelected in State then + begin + Back := ThemeSelection; + Fore := ThemeSelText; + end + else + begin + Back := ThemeSurface; + Fore := ThemeText; + end; + + Combo.Canvas.Brush.Color := Back; + Combo.Canvas.Brush.Style := bsSolid; + Combo.Canvas.FillRect(ARect); + + if (Index >= 0) and (Index < Combo.Items.Count) then + S := Combo.Items[Index] + else + S := ''; + + Combo.Canvas.Font.Color := Fore; + Combo.Canvas.Brush.Style := bsClear; + Combo.Canvas.TextOut(ARect.Left + 4, + ARect.Top + (ARect.Bottom - ARect.Top - Combo.Canvas.TextHeight('Wg')) div 2, + S); +end; + +procedure TThemePainter.FormAdded(Sender: TObject; AForm: TCustomForm); +begin + ApplyDarkTheme(AForm); +end; + +{ Раскрашивание } + +procedure ApplyToControl(AControl: TControl); forward; + +procedure ApplyToChildren(AControl: TWinControl); +var + I: Integer; +begin + for I := 0 to AControl.ControlCount - 1 do + ApplyToControl(AControl.Controls[I]); +end; + +procedure ApplyToControl(AControl: TControl); +var + Grid: TStringGrid; + Combo: TComboBox; +begin + { Свои контролы (таймлайн, наши кнопки) раскрашивают себя сами и трогать + их нельзя: заданный снаружи цвет им ничего не скажет, а сбросить + настройки может. } + if AControl is TThemedButton then + begin + ApplyToChildren(TWinControl(AControl)); + Exit; + end; + + if AControl is TForm then + begin + TForm(AControl).Color := ThemeWindow; + TForm(AControl).Font.Color := ThemeText; + end + else if AControl is TPanel then + begin + TPanel(AControl).ParentColor := False; + TPanel(AControl).Color := ThemePanel; + TPanel(AControl).ParentFont := False; + TPanel(AControl).Font.Color := ThemeText; + { Объёмная рамка рисуется системными светлыми цветами и на тёмном + фоне выглядит грязной полосой. } + TPanel(AControl).BevelOuter := bvNone; + end + else if AControl is TMemo then + begin + TMemo(AControl).ParentColor := False; + TMemo(AControl).Color := ThemeSurface; + TMemo(AControl).ParentFont := False; + TMemo(AControl).Font.Color := ThemeText; + { Рамку поля рисует система светлыми цветами, и на тёмном фоне она + выглядит белым прямоугольником. Границу и так видно по смене + оттенка фона. } + TMemo(AControl).BorderStyle := bsNone; + end + else if AControl is TListBox then + begin + TListBox(AControl).ParentColor := False; + TListBox(AControl).Color := ThemeSurface; + TListBox(AControl).ParentFont := False; + TListBox(AControl).Font.Color := ThemeText; + TListBox(AControl).BorderStyle := bsNone; + end + else if AControl is TComboBox then + begin + Combo := TComboBox(AControl); + Combo.ParentColor := False; + Combo.Color := ThemeSurface; + Combo.ParentFont := False; + Combo.Font.Color := ThemeText; + { Список выпадающего списка система рисует своими цветами, если его не + забрать себе. csOwnerDrawFixed — тот же нередактируемый список, но + строки рисуем мы. } + if Combo.Style = csDropDownList then + Combo.Style := csOwnerDrawFixed; + if not Assigned(Combo.OnDrawItem) then + Combo.OnDrawItem := @Painter.ComboDraw; + end + else if AControl is TStringGrid then + begin + Grid := TStringGrid(AControl); + Grid.ParentColor := False; + Grid.Color := ThemeSurface; + Grid.ParentFont := False; + Grid.Font.Color := ThemeText; + Grid.FixedColor := ThemePanel; + Grid.GridLineColor := ThemeGridLine; + Grid.AlternateColor := ThemeSurface; + Grid.SelectedColor := ThemeSelection; + Grid.BorderStyle := bsNone; + end + else if AControl is TEdit then + begin + TEdit(AControl).ParentColor := False; + TEdit(AControl).Color := ThemeSurface; + TEdit(AControl).ParentFont := False; + TEdit(AControl).Font.Color := ThemeText; + TEdit(AControl).BorderStyle := bsNone; + end + else if AControl is TCheckBox then + begin + TCheckBox(AControl).ParentColor := False; + TCheckBox(AControl).Color := ThemePanel; + TCheckBox(AControl).ParentFont := False; + TCheckBox(AControl).Font.Color := ThemeText; + end + else if AControl is TLabel then + begin + TLabel(AControl).ParentFont := False; + TLabel(AControl).Font.Color := ThemeText; + TLabel(AControl).Transparent := True; + end + else if AControl is TSplitter then + begin + TSplitter(AControl).ParentColor := False; + TSplitter(AControl).Color := ThemeBorder; + end + else if AControl is TTrackBar then + begin + TTrackBar(AControl).ParentColor := False; + TTrackBar(AControl).Color := ThemePanel; + end; + + if AControl is TWinControl then + ApplyToChildren(TWinControl(AControl)); +end; + +procedure ApplyDarkMenu(AMenu: TMenu); + + procedure Walk(AItem: TMenuItem); + var + I: Integer; + begin + AItem.OnDrawItem := @Painter.MenuDraw; + AItem.OnMeasureItem := @Painter.MenuMeasure; + for I := 0 to AItem.Count - 1 do + Walk(AItem.Items[I]); + end; + +{$IFDEF WINDOWS} +var + Info: TMenuInfoRec; +{$ENDIF} +begin + if AMenu = nil then + Exit; + {$IFDEF LCLWIN32} + Walk(AMenu.Items); + + { Сами пункты мы уже рисуем, но полосу меню и подложку раскрытого списка + рисует Windows, и до неё событиями не дотянуться. Цвет подложки + задаётся кистью через SetMenuInfo — другого способа нет. + MIM_APPLYTOSUBMENUS распространяет её на все вложенные списки. } + { Обращение к Handle создаёт дескриптор, если его ещё нет: у + всплывающего списка он появляется только при показе, а покрасить надо + заранее. } + if AMenu.Handle <> 0 then + begin + FillChar(Info{%H-}, SizeOf(Info), 0); + Info.cbSize := SizeOf(Info); + Info.fMask := MIM_BACKGROUND or MIM_APPLYTOSUBMENUS; + Info.hbrBack := MenuBrush; + SetMenuInfo(AMenu.Handle, Info); + end; + {$ENDIF} +end; + +procedure ApplyDarkTheme(AComponent: TComponent); +var + I: Integer; +begin + if AComponent = nil then + Exit; + + if AComponent is TControl then + ApplyToControl(TControl(AComponent)); + + { Меню — не контрол и в дерево контролов не попадает, поэтому его надо + искать среди компонентов окна отдельно. } + for I := 0 to AComponent.ComponentCount - 1 do + if AComponent.Components[I] is TMenu then + ApplyDarkMenu(TMenu(AComponent.Components[I])); +end; + +procedure HookNewForms; +begin + Screen.AddHandlerFormAdded(@Painter.FormAdded); +end; + +{ Окно сообщения } + +function ThemedMessageDlg(const ACaption, AText: string; + ADlgType: TMsgDlgType; AButtons: TMsgDlgButtons; + AHelpCtx: Longint): TModalResult; +const + MarginX = 20; + MarginY = 18; + ButtonW = 120; + ButtonH = 30; + ButtonGap = 10; +var + Dlg: TForm; + Lbl: TLabel; + Btn: TThemedButton; + Order: array[0..3] of TModalResult = (mrOk, mrYes, mrNo, mrCancel); + Names: array[0..3] of string = ('ОК', 'Да', 'Нет', 'Отмена'); + Flags: array[0..3] of TMsgDlgBtn = (mbOK, mbYes, mbNo, mbCancel); + I, Count, X, TextW, TextH, TotalW: Integer; +begin + Dlg := TForm.CreateNew(nil); + try + Dlg.Caption := ACaption; + Dlg.BorderStyle := bsDialog; + Dlg.Position := poScreenCenter; + Dlg.Color := ThemeWindow; + Dlg.Font.Color := ThemeText; + + Count := 0; + for I := 0 to High(Flags) do + if Flags[I] in AButtons then + Inc(Count); + if Count = 0 then + Count := 1; + + Lbl := TLabel.Create(Dlg); + Lbl.Parent := Dlg; + Lbl.Left := MarginX; + Lbl.Top := MarginY; + Lbl.WordWrap := True; + Lbl.AutoSize := False; + Lbl.Width := 520; + Lbl.Caption := AText; + Lbl.Font.Color := ThemeText; + Lbl.Transparent := True; + + { Высоту надписи считаем по её содержимому: сообщения бывают и в одну + строку, и в десять. } + TextH := Dlg.Canvas.TextHeight('Wg'); + TextW := Dlg.Canvas.TextWidth(AText); + Lbl.Height := TextH * (1 + TextW div Lbl.Width) + TextH div 2; + + TotalW := Count * ButtonW + (Count - 1) * ButtonGap; + Dlg.ClientWidth := Lbl.Width + MarginX * 2; + if TotalW + MarginX * 2 > Dlg.ClientWidth then + Dlg.ClientWidth := TotalW + MarginX * 2; + Dlg.ClientHeight := MarginY + Lbl.Height + MarginY + ButtonH + MarginY; + + X := (Dlg.ClientWidth - TotalW) div 2; + for I := 0 to High(Flags) do + begin + if not (Flags[I] in AButtons) then + Continue; + Btn := TThemedButton.Create(Dlg); + Btn.Parent := Dlg; + Btn.SetBounds(X, Dlg.ClientHeight - MarginY - ButtonH, ButtonW, ButtonH); + Btn.Caption := Names[I]; + Btn.ModalResult := Order[I]; + Btn.Default := (Order[I] = mrOk) or (Order[I] = mrYes); + Btn.Cancel := (Order[I] = mrCancel) or + ((Order[I] = mrNo) and not (mbCancel in AButtons)); + Inc(X, ButtonW + ButtonGap); + end; + + Result := Dlg.ShowModal; + finally + Dlg.Free; + end; + { ADlgType пока ни на что не влияет: значков у нас нет, а разный цвет + рамки под сообщение об ошибке только отвлекает. Параметр оставлен, + чтобы вызовы читались как прежние. } + if ADlgType = mtCustom then ; +end; + +initialization + Painter := TThemePainter.Create; + {$IFDEF WINDOWS} + MenuBrush := CreateSolidBrush(ThemePanel); + {$ENDIF} + { Без этого форма не сможет создать нашу кнопку при чтении .lfm: имя + класса ищется в списке зарегистрированных. } + RegisterClass(TThemedButton); + +finalization + Painter.Free; + +end. diff --git a/src/uThemedScroll.pas b/src/uThemedScroll.pas new file mode 100644 index 0000000..14d1c93 --- /dev/null +++ b/src/uThemedScroll.pas @@ -0,0 +1,486 @@ +{ + uThemedScroll — полоса прокрутки, нарисованная своими силами, и обвязка + для таблиц. + + Зачем. Полосы прокрутки у обычных элементов рисует система, и цвет им + задать нечем: на тёмном окне они остаются светлыми. Единственный способ + получить их в своих цветах — не пользоваться системными вовсе. + + Таблица при этом остаётся обычной: у неё выключаются собственные полосы, + а прокрутка задаётся свойствами TopRow и LeftCol. Переписывать саму + таблицу не требуется. + + Ограничение, о котором надо знать: по горизонтали прокрутка идёт + столбцами, а не пикселями. Так устроено свойство LeftCol, и мельче + сдвинуть содержимое нечем. +} +unit uThemedScroll; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Types, Controls, Graphics, StdCtrls, Grids, LCLType; + +type + + TThemedScrollBar = class(TCustomControl) + private + FVertical: Boolean; + FTotal: Integer; + FPage: Integer; + FPosition: Integer; + FHover: Boolean; + FDragging: Boolean; + FDragOffset: Integer; + FOnChange: TNotifyEvent; + function TrackSize: Integer; + function ThumbSize: Integer; + function MaxPosition: Integer; + function ThumbRect: TRect; + procedure SetPosition(AValue: Integer); + protected + procedure Paint; override; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); override; + procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); override; + procedure MouseEnter; override; + procedure MouseLeave; override; + function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; + MousePos: TPoint): Boolean; override; + public + constructor Create(AOwner: TComponent); override; + + { Направление задаётся один раз при создании. } + procedure Setup(AVertical: Boolean); + + { ATotal — сколько всего, APage — сколько видно за раз. Положение + меняется в пределах от нуля до ATotal минус APage. } + procedure SetRange(ATotal, APage: Integer); + + { Нужна ли полоса вообще: если видно всё, она только занимает место. } + function Needed: Boolean; + + property Position: Integer read FPosition write SetPosition; + property OnChange: TNotifyEvent read FOnChange write FOnChange; + end; + +{ Заменяет системные полосы таблицы на свои. + + Таблица переселяется внутрь контейнера, который встаёт на её место и + забирает себе её выравнивание. Так работает и с таблицей, растянутой по + всему окну, и с прикреплённой к краям. } +procedure AttachThemedScrollBars(AGrid: TStringGrid); + +implementation + +uses + uTheme; + +const + BarSize = 12; + MinThumb = 24; + WheelRows = 3; + +type + { Контейнер: таблица плюс две полосы. } + TScrolledGrid = class(TCustomControl) + private + FGrid: TStringGrid; + FVBar: TThemedScrollBar; + FHBar: TThemedScrollBar; + FUpdating: Boolean; + procedure Relayout; + procedure SyncBars; + procedure GridTopLeftChanged(Sender: TObject); + procedure VBarChange(Sender: TObject); + procedure HBarChange(Sender: TObject); + procedure GridWheel(Sender: TObject; Shift: TShiftState; + WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); + protected + procedure Paint; override; + procedure Resize; override; + public + constructor CreateFor(AGrid: TStringGrid); + end; + +{ TThemedScrollBar } + +constructor TThemedScrollBar.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FVertical := True; + FTotal := 0; + FPage := 1; + DoubleBuffered := True; + ControlStyle := ControlStyle + [csOpaque]; +end; + +procedure TThemedScrollBar.Setup(AVertical: Boolean); +begin + FVertical := AVertical; +end; + +function TThemedScrollBar.MaxPosition: Integer; +begin + Result := FTotal - FPage; + if Result < 0 then + Result := 0; +end; + +function TThemedScrollBar.Needed: Boolean; +begin + Result := FTotal > FPage; +end; + +procedure TThemedScrollBar.SetRange(ATotal, APage: Integer); +begin + if APage < 1 then + APage := 1; + if ATotal < 0 then + ATotal := 0; + FTotal := ATotal; + FPage := APage; + if FPosition > MaxPosition then + FPosition := MaxPosition; + Invalidate; +end; + +procedure TThemedScrollBar.SetPosition(AValue: Integer); +begin + if AValue > MaxPosition then + AValue := MaxPosition; + if AValue < 0 then + AValue := 0; + if AValue = FPosition then + Exit; + FPosition := AValue; + Invalidate; + if Assigned(FOnChange) then + FOnChange(Self); +end; + +function TThemedScrollBar.TrackSize: Integer; +begin + if FVertical then + Result := Height + else + Result := Width; + if Result < 1 then + Result := 1; +end; + +function TThemedScrollBar.ThumbSize: Integer; +begin + if FTotal <= 0 then + Exit(TrackSize); + Result := Round(TrackSize * FPage / FTotal); + if Result < MinThumb then + Result := MinThumb; + if Result > TrackSize then + Result := TrackSize; +end; + +function TThemedScrollBar.ThumbRect: TRect; +var + Size, Offset, Span: Integer; +begin + Size := ThumbSize; + Span := MaxPosition; + if Span > 0 then + Offset := Round((TrackSize - Size) * FPosition / Span) + else + Offset := 0; + + if FVertical then + Result := Rect(0, Offset, Width, Offset + Size) + else + Result := Rect(Offset, 0, Offset + Size, Height); +end; + +procedure TThemedScrollBar.Paint; +var + T: TRect; + Fill: TColor; +begin + Canvas.Brush.Style := bsSolid; + Canvas.Brush.Color := ThemeWindow; + Canvas.FillRect(ClientRect); + + if not Needed then + Exit; + + if FDragging or FHover then + Fill := ThemeButtonHover + else + Fill := ThemeButton; + + T := ThumbRect; + Canvas.Brush.Color := Fill; + if FVertical then + Canvas.FillRect(T.Left + 2, T.Top + 1, T.Right - 2, T.Bottom - 1) + else + Canvas.FillRect(T.Left + 1, T.Top + 2, T.Right - 1, T.Bottom - 2); +end; + +procedure TThemedScrollBar.MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +var + T: TRect; + Along: Integer; +begin + inherited MouseDown(Button, Shift, X, Y); + if (Button <> mbLeft) or (not Needed) then + Exit; + + T := ThumbRect; + if PtInRect(T, Point(X, Y)) then + begin + FDragging := True; + if FVertical then + FDragOffset := Y - T.Top + else + FDragOffset := X - T.Left; + Invalidate; + Exit; + end; + + { Щелчок мимо ползунка листает на страницу — так ведёт себя привычная + полоса прокрутки. } + if FVertical then + Along := Y + else + Along := X; + if FVertical then + begin + if Along < T.Top then + Position := FPosition - FPage + else + Position := FPosition + FPage; + end + else + begin + if Along < T.Left then + Position := FPosition - FPage + else + Position := FPosition + FPage; + end; +end; + +procedure TThemedScrollBar.MouseMove(Shift: TShiftState; X, Y: Integer); +var + Size, Span, Along: Integer; +begin + inherited MouseMove(Shift, X, Y); + if not FDragging then + Exit; + + Size := ThumbSize; + Span := TrackSize - Size; + if Span <= 0 then + Exit; + + if FVertical then + Along := Y - FDragOffset + else + Along := X - FDragOffset; + + Position := Round(Along * MaxPosition / Span); +end; + +procedure TThemedScrollBar.MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + FDragging := False; + Invalidate; + inherited MouseUp(Button, Shift, X, Y); +end; + +procedure TThemedScrollBar.MouseEnter; +begin + inherited MouseEnter; + FHover := True; + Invalidate; +end; + +procedure TThemedScrollBar.MouseLeave; +begin + inherited MouseLeave; + FHover := False; + Invalidate; +end; + +function TThemedScrollBar.DoMouseWheel(Shift: TShiftState; + WheelDelta: Integer; MousePos: TPoint): Boolean; +begin + if WheelDelta > 0 then + Position := FPosition - WheelRows + else + Position := FPosition + WheelRows; + Result := True; +end; + +{ TScrolledGrid } + +constructor TScrolledGrid.CreateFor(AGrid: TStringGrid); +begin + inherited Create(AGrid.Owner); + FGrid := AGrid; + + { Контейнер встаёт ровно на место таблицы и забирает её выравнивание: + иначе при изменении размеров окна они разъедутся. } + Parent := AGrid.Parent; + SetBounds(AGrid.Left, AGrid.Top, AGrid.Width, AGrid.Height); + Anchors := AGrid.Anchors; + Align := AGrid.Align; + + { Полосы создаются раньше, чем таблице назначаются обработчики. Иначе + первое же событие таблицы вызовет согласование с полосами, которых + ещё нет, и программа упадёт с «Access violation». } + FVBar := TThemedScrollBar.Create(Self); + FVBar.Parent := Self; + FVBar.Setup(True); + FVBar.OnChange := @VBarChange; + + FHBar := TThemedScrollBar.Create(Self); + FHBar.Parent := Self; + FHBar.Setup(False); + FHBar.OnChange := @HBarChange; + + FGrid.Parent := Self; + FGrid.Align := alNone; + FGrid.Anchors := [akTop, akLeft]; + FGrid.ScrollBars := ssNone; + FGrid.OnTopLeftChanged := @GridTopLeftChanged; + FGrid.OnMouseWheel := @GridWheel; + + Relayout; +end; + +procedure TScrolledGrid.Paint; +begin + { Виден только уголок между полосами. } + Canvas.Brush.Style := bsSolid; + Canvas.Brush.Color := ThemeWindow; + Canvas.FillRect(ClientRect); +end; + +procedure TScrolledGrid.Resize; +begin + inherited Resize; + Relayout; +end; + +procedure TScrolledGrid.Relayout; +var + W, H: Integer; + NeedV, NeedH: Boolean; +begin + if (FGrid = nil) or (FVBar = nil) or (FHBar = nil) or FUpdating then + Exit; + FUpdating := True; + try + W := ClientWidth; + H := ClientHeight; + if (W < 1) or (H < 1) then + Exit; + + { Считаем в два захода: место, занятое одной полосой, может сделать + нужной вторую. } + FGrid.SetBounds(0, 0, W, H); + NeedV := (FGrid.RowCount - FGrid.FixedRows) > FGrid.VisibleRowCount; + if NeedV then + Dec(W, BarSize); + NeedH := FGrid.GridWidth > W; + if NeedH then + Dec(H, BarSize); + + FGrid.SetBounds(0, 0, W, H); + NeedV := (FGrid.RowCount - FGrid.FixedRows) > FGrid.VisibleRowCount; + if NeedV and (W = ClientWidth) then + begin + Dec(W, BarSize); + FGrid.SetBounds(0, 0, W, H); + end; + + FVBar.Visible := NeedV; + if NeedV then + FVBar.SetBounds(W, 0, BarSize, H); + + FHBar.Visible := NeedH; + if NeedH then + FHBar.SetBounds(0, H, W, BarSize); + finally + FUpdating := False; + end; + SyncBars; +end; + +procedure TScrolledGrid.SyncBars; +begin + if (FGrid = nil) or (FVBar = nil) or (FHBar = nil) or FUpdating then + Exit; + FUpdating := True; + try + FVBar.SetRange(FGrid.RowCount - FGrid.FixedRows, FGrid.VisibleRowCount); + FVBar.Position := FGrid.TopRow - FGrid.FixedRows; + FHBar.SetRange(FGrid.ColCount - FGrid.FixedCols, FGrid.VisibleColCount); + FHBar.Position := FGrid.LeftCol - FGrid.FixedCols; + finally + FUpdating := False; + end; +end; + +procedure TScrolledGrid.GridTopLeftChanged(Sender: TObject); +begin + SyncBars; +end; + +procedure TScrolledGrid.VBarChange(Sender: TObject); +begin + if FUpdating then + Exit; + FUpdating := True; + try + FGrid.TopRow := FVBar.Position + FGrid.FixedRows; + finally + FUpdating := False; + end; +end; + +procedure TScrolledGrid.HBarChange(Sender: TObject); +begin + if FUpdating then + Exit; + FUpdating := True; + try + FGrid.LeftCol := FHBar.Position + FGrid.FixedCols; + finally + FUpdating := False; + end; +end; + +procedure TScrolledGrid.GridWheel(Sender: TObject; Shift: TShiftState; + WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); +begin + { Без собственных полос таблица колесо не обрабатывает, поэтому крутим + сами. } + if WheelDelta > 0 then + FGrid.TopRow := FGrid.TopRow - WheelRows + else + FGrid.TopRow := FGrid.TopRow + WheelRows; + Handled := True; + SyncBars; +end; + +procedure AttachThemedScrollBars(AGrid: TStringGrid); +begin + if (AGrid = nil) or (AGrid.Parent = nil) then + Exit; + TScrolledGrid.CreateFor(AGrid); +end; + +end. diff --git a/src/uThumbs.pas b/src/uThumbs.pas new file mode 100644 index 0000000..c9a7e00 --- /dev/null +++ b/src/uThumbs.pas @@ -0,0 +1,149 @@ +{ + uThumbs — кадры-миниатюры для списка файлов проекта. + + По одному имени файла непонятно, что внутри, особенно когда съёмки + называются DJI_20260816134629_0003_D.MP4. Миниатюра решает это сразу. + + Делаются они в отдельном потоке и по одной: список должен работать, + пока картинки готовятся. Готовые складываются в кэш проекта и при + следующем открытии берутся оттуда. +} +unit uThumbs; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils; + +const + ThumbWidth = 160; + ThumbHeight = 90; + +type + TThumbRequest = record + SourcePath: string; + TargetPath: string; + { Момент, с которого брать кадр. Ноль для картинок. } + AtTime: Double; + { Ключ, по которому окно найдёт нужную строку. Совпадает с путём, + который использовался при заказе. } + Key: string; + end; + + TThumbRequests = array of TThumbRequest; + + { Вызывается в потоке интерфейса, когда очередная миниатюра готова. + + Передаётся путь к исходнику, а не номер в списке: пока миниатюра + делалась, список мог измениться, и номер бы уже ничего не значил. } + TThumbReadyEvent = procedure(Sender: TObject; const ASourcePath, + AThumbPath: string) of object; + + TThumbThread = class(TThread) + private + FRequests: TThumbRequests; + FCurrent: Integer; + FOnReady: TThumbReadyEvent; + procedure SyncReady; + function CancelQuery: Boolean; + protected + procedure Execute; override; + public + constructor Create(const ARequests: TThumbRequests); + property OnReady: TThumbReadyEvent read FOnReady write FOnReady; + end; + +{ Путь к миниатюре в кэше проекта. Имя выводится из пути к исходнику, + поэтому один файл всегда даёт одну и ту же миниатюру. } +function ThumbPath(const ACacheDir, ASourcePath: string): string; + +{ С какого места брать кадр для файла такой длительности. } +function ThumbTimeFor(const ADuration: Double): Double; + +implementation + +uses + md5, uFfmpegCmd, uProcRunner; + +function ThumbPath(const ACacheDir, ASourcePath: string): string; +begin + Result := IncludeTrailingPathDelimiter(ACacheDir) + 'thumbs' + PathDelim + + MD5Print(MD5String(ASourcePath)) + '.png'; +end; + +function ThumbTimeFor(const ADuration: Double): Double; +begin + { Первые секунды съёмки часто бесполезны: крышка объектива, разгон + экспозиции, чернота. Берём десятую часть, но не дальше пятой секунды — + иначе на часовом файле пришлось бы перематывать в середину. } + if ADuration <= 0 then + Exit(0); + Result := ADuration * 0.1; + if Result > 5 then + Result := 5; +end; + +constructor TThumbThread.Create(const ARequests: TThumbRequests); +var + I: Integer; +begin + inherited Create(True); + FreeOnTerminate := False; + SetLength(FRequests, Length(ARequests)); + for I := 0 to High(ARequests) do + FRequests[I] := ARequests[I]; +end; + +function TThumbThread.CancelQuery: Boolean; +begin + Result := Terminated; +end; + +procedure TThumbThread.SyncReady; +begin + if Assigned(FOnReady) and (FCurrent >= 0) and (FCurrent <= High(FRequests)) then + FOnReady(Self, FRequests[FCurrent].SourcePath, FRequests[FCurrent].TargetPath); +end; + +procedure TThumbThread.Execute; +var + I: Integer; + Res: TProcResult; + ToolError: string; +begin + if not ToolsAvailable(ToolError) then + Exit; + + for I := 0 to High(FRequests) do + begin + if Terminated then + Exit; + + FCurrent := I; + + { Уже готовая миниатюра — просто сообщаем о ней. } + if FileExists(FRequests[I].TargetPath) then + begin + Synchronize(@SyncReady); + Continue; + end; + + if not ForceDirectories(ExtractFilePath(FRequests[I].TargetPath)) then + Continue; + + Res := RunProcess(FfmpegExe, + ArgsThumbnail(FRequests[I].SourcePath, FRequests[I].TargetPath, + FRequests[I].AtTime, ThumbWidth, ThumbHeight), + nil, nil, @CancelQuery); + + { Не получилось — не беда: список просто останется без картинки для + этого файла. Ронять из-за миниатюры ничего нельзя. } + if Res.Started and (Res.ExitCode = 0) and + FileExists(FRequests[I].TargetPath) then + Synchronize(@SyncReady); + end; +end; + +end. diff --git a/src/uTimelineCtrl.pas b/src/uTimelineCtrl.pas new file mode 100644 index 0000000..2577288 --- /dev/null +++ b/src/uTimelineCtrl.pas @@ -0,0 +1,1809 @@ +{ + uTimelineCtrl — компонент монтажного стола. + + В LCL нет готовой сцены с объектами, поэтому всё рисуется вручную. + Это не недостаток: полный контроль над отрисовкой здесь нужнее, чем + готовые примитивы, а рисовать прямоугольники быстро. + + Устройство координат. Хранятся две величины: сколько пикселей приходится + на секунду и какое время показано у левого края. Всё остальное считается + из них. Зум по Ctrl с колесом мыши сделан так, чтобы точка под курсором + оставалась на месте: меняется масштаб, затем сдвиг подбирается обратным + счётом. Без этого при увеличении уезжает не туда, куда смотришь. + + Отрисовка идёт в теневое изображение и копируется целиком. Иначе при + перетаскивании клипов мерцает. + + Слева отведена полоса под названия дорожек: без неё непонятно, какая + дорожка верхняя, а порядок дорожек здесь определяет, что будет видно. +} +unit uTimelineCtrl; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Controls, Graphics, LCLType, LCLIntf, Forms, Math, + uAppTypes, uProject, uMediaProbe, uKeyframeIndex; + +type + { Что сейчас делает мышь. } + TTimelineAction = ( + taNone, + taDragClip, // перенос клипа + taTrimIn, // растягивание за левый край + taTrimOut, // растягивание за правый край + taScrub, // протяжка курсора воспроизведения + taPan, // прокрутка средней кнопкой + taVolume // тянем ручку громкости клипа + ); + + { Что находится под указателем в полосе заголовков дорожек. } + THeaderPart = (hpNone, hpBody, hpMute, hpSolo); + + { Файл из списка проекта бросили на монтаж. + + ATrackIndex = -1 означает, что бросили ниже всех дорожек и нужна новая. + Само добавление делает окно: компонент не знает, что за объект тащат + и какой файл ему соответствует. } + TMediaDropEvent = procedure(Sender: TObject; ASource: TObject; + ATrackIndex: Integer; const ATime: Double) of object; + + TTimelineControl = class(TCustomControl) + private + FProject: TProject; + FPixelsPerSecond: Double; + FScrollOffset: Double; + FPlayhead: Double; + FBuffer: TBitmap; + + FTrackHeight: Integer; + FRulerHeight: Integer; + FHeaderWidth: Integer; + + FAction: TTimelineAction; + FDragClip: TClip; + FDragTrack: TTrack; + FDragGrabOffset: Double; + FDragOrigStart: Double; + FDragOrigSrcIn: Double; + FDragOrigDuration: Double; + FPanOriginX: Integer; + FPanOriginY: Integer; + FPanOriginTime: Double; + FPanOriginScrollY: Integer; + FHoverTrack: Integer; + { Вертикальная прокрутка в пикселях: дорожек может быть больше, чем + помещается в окно. } + FScrollY: Integer; + { За одно перетаскивание разрешено создать не больше одной дорожки, + иначе таскание мышью вниз наплодит их десяток. } + FTrackAddedDuringDrag: Boolean; + { Где нажали кнопку и сдвинулась ли мышь с тех пор. Нужно, чтобы + отличить щелчок по клипу от начала его перетаскивания. } + FPressX: Integer; + FPressY: Integer; + FMovedWhileDown: Boolean; + { Дорожка, на которую кладут файл кнопкой «На таймлайн». Выбирается + щелчком по заголовку. } + FActiveTrack: Integer; + { Прилипание краёв клипов друг к другу. Shift на время переключает + его в противоположное состояние: включено — временно выключает, + выключено — временно включает. } + FSnapEnabled: Boolean; + FSnapSuspended: Boolean; + FDragOrigVolume: Double; + { Клипы, которые поедут вслед за перетаскиваемым, и их исходные + позиции. Список составляется один раз при нажатии: пересчитывать + его на каждое движение мыши нельзя, иначе в него начнут попадать + клипы, которые уже сдвинулись. } + FRippleClips: array of TClip; + FRippleOrigStarts: array of Double; + + FOnPlayheadChange: TNotifyEvent; + FOnStructureChange: TNotifyEvent; + FOnSelectionChange: TNotifyEvent; + FOnMediaDrop: TMediaDropEvent; + FOnTrackAdded: TNotifyEvent; + FOnActiveTrackChange: TNotifyEvent; + + function GetVisibleWidth: Integer; + function TimeToX(const ATime: Double): Integer; + function XToTime(const AX: Integer): Double; + function TrackTop(AIndex: Integer): Integer; + function TrackIndexAt(const AY: Integer): Integer; + function ClipAtPoint(const AX, AY: Integer; out ATrack: TTrack): TClip; + function EdgeAtPoint(const AX: Integer; AClip: TClip): Integer; + { Что под указателем в полосе заголовков и на какой дорожке. } + function HeaderPartAt(const AX, AY: Integer; out ATrackIndex: Integer): THeaderPart; + { Прямоугольник ручки громкости клипа. Ручка ставится посередине + ВИДИМОЙ части клипа, а не всего клипа: до середины часового клипа, + уехавшей за край экрана, мышью не дотянуться. } + function VolumeHandleRect(AClip: TClip; ATop: Integer): TRect; + function VolumeToY(const AVolume: Double; ATop: Integer): Integer; + function YToVolume(const AY: Integer; ATop: Integer): Double; + + procedure DrawRuler(ACanvas: TCanvas); + procedure DrawTracks(ACanvas: TCanvas); + procedure DrawClip(ACanvas: TCanvas; AClip: TClip; ATop: Integer); + procedure DrawPlayhead(ACanvas: TCanvas); + procedure DrawHeaders(ACanvas: TCanvas); + procedure DrawVolume(ACanvas: TCanvas; AClip: TClip; ATop: Integer; + const ABody: TRect); + + procedure SetPlayhead(const AValue: Double); + procedure SetPixelsPerSecond(const AValue: Double); + procedure ClampScroll; + procedure ClampScrollY; + function TracksBottom: Integer; + function SnapTime(const ATime: Double; AExclude: TClip): Double; + function MediaDurationOf(AClip: TClip): Double; + procedure StructureChanged; + { Помечает край клипа точным, если он не попал на опорный кадр. + + Смысл: пользователь подвинул край руками, значит он хотел именно + этот кадр. Притягивать такой рез к опорному кадру — значит молча + сделать не то, о чём просили. } + procedure UpdateEdgePrecision(AClip: TClip); + { Составляет список клипов правее перетаскиваемого. } + procedure CollectRippleClips(ATrackIndex: Integer; AExclude: TClip; + const AFromTime: Double); + procedure ApplyRipple(const ADelta: Double); + function IsRippling(AClip: TClip): Boolean; + protected + procedure Paint; override; + procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState; + var Accept: Boolean); override; + procedure DragDrop(Source: TObject; X, Y: Integer); override; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); override; + procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); override; + function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; + MousePos: TPoint): Boolean; override; + procedure KeyDown(var Key: Word; Shift: TShiftState); override; + procedure Resize; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + { Показать весь проект целиком. } + procedure ZoomToFit; + procedure ZoomAt(const AFactor: Double; AAnchorX: Integer); + + { Подвинуть окно просмотра так, чтобы курсор воспроизведения был виден. + + ACenter — держать его строго посередине. Так удобно при + воспроизведении: изображение едет, а курсор стоит на месте. + Без ACenter окно двигается только когда курсор ушёл за край. } + procedure ScrollToPlayhead(ACenter: Boolean); + + { Начало самого раннего и конец самого позднего клипа по всем дорожкам. } + function FirstClipTime: Double; + function LastClipTime: Double; + + { Перевод координат для тех, кто снаружи: например, чтобы понять, + куда бросили файл. Номер дорожки минус один означает «ниже всех». } + function TrackIndexAtPoint(const AY: Integer): Integer; + function TimeAtPoint(const AX: Integer): Double; + + { Разрезать клипы под курсором воспроизведения. + + APrecise помечает новые края как требующие точного реза: при сборке + огрызок до опорного кадра будет перекодирован. Без этого рез + притянется к опорному кадру, и точка съедет на величину до + расстояния между опорными кадрами. } + procedure SplitAtPlayhead(APrecise: Boolean; AOnlyCurrentTrack: Boolean); + procedure DeleteSelected; + { Сдвинуть клипы влево, закрыв дыру под курсором. } + procedure RippleCloseGap; + procedure SelectAll; + + { Номер дорожки под указателем мыши, минус один если ни одной. } + property HoverTrack: Integer read FHoverTrack; + { Дорожка, выбранная щелчком по заголовку. } + property ActiveTrack: Integer read FActiveTrack write FActiveTrack; + property SnapEnabled: Boolean read FSnapEnabled write FSnapEnabled; + + property Project: TProject read FProject write FProject; + property Playhead: Double read FPlayhead write SetPlayhead; + property PixelsPerSecond: Double read FPixelsPerSecond write SetPixelsPerSecond; + property ScrollOffset: Double read FScrollOffset write FScrollOffset; + property TrackHeight: Integer read FTrackHeight write FTrackHeight; + + property OnPlayheadChange: TNotifyEvent read FOnPlayheadChange + write FOnPlayheadChange; + property OnStructureChange: TNotifyEvent read FOnStructureChange + write FOnStructureChange; + property OnSelectionChange: TNotifyEvent read FOnSelectionChange + write FOnSelectionChange; + property OnMediaDrop: TMediaDropEvent read FOnMediaDrop write FOnMediaDrop; + { Компонент сам создал дорожку при перетаскивании клипа вниз. } + property OnTrackAdded: TNotifyEvent read FOnTrackAdded write FOnTrackAdded; + property OnActiveTrackChange: TNotifyEvent read FOnActiveTrackChange + write FOnActiveTrackChange; + end; + +implementation + +const + { Ширина зоны у края клипа, где курсор берётся за растягивание. } + EdgeGrabPixels = 6; + + { На сколько пикселей примагничиваются края при перетаскивании. } + SnapPixels = 8; + + { Сдвиг мыши, до которого нажатие считается щелчком, а не перетаскиванием. + Совсем без запаса нельзя: рука дрожит, и попасть кнопкой в один и тот же + пиксель мало кому удаётся. } + ClickSlopPixels = 4; + + { Наибольшая громкость клипа. Двойка, а не что-то большее: дальше + начинаются искажения, и толку от такой прибавки мало. } + MaxClipVolume = 2.0; + + { Размеры ручки громкости и кнопок в заголовке дорожки. } + VolumeHandleWidth = 30; + VolumeHandleHeight = 9; + HeaderButtonSize = 20; + HeaderButtonGap = 4; + + MinPixelsPerSecond = 0.01; + MaxPixelsPerSecond = 4000; + + { Шаг увеличения на один щелчок колеса. } + ZoomStep = 1.25; + + { Возможные шаги делений линейки в секундах. Ниже секунды идут доли, + выше — привычные отрезки времени, а не круглые числа: делить час + на 16 частей неудобно читать. } + RulerSteps: array[0..17] of Double = ( + 0.04, 0.1, 0.2, 0.5, 1, 2, 5, 10, 15, 30, + 60, 120, 300, 600, 900, 1800, 3600, 7200); + + { Меньше этого расстояния деления сливаются в кашу. } + MinTickPixels = 70; + + { Внимание на порядок байт: TColor хранит цвет как $00BBGGRR, то есть + синий в старшем байте, а не красный. Записанный как привычный RGB + код даст цвет с переставленными местами красным и синим — ошибка + незаметная в отладчике и очевидная на экране. Ниже указаны значения + уже в порядке TColor, а в скобках — что это за цвет на самом деле. } + ColorBack = TColor($1E1E1E); // тёмно-серый фон + ColorRuler = TColor($2A2A2A); // линейка + ColorRulerText = TColor($C8C8C8); // подписи делений + ColorHeader = TColor($262626); // полоса с названиями дорожек + ColorTrackOdd = TColor($232323); + ColorTrackEven = TColor($1F1F1F); + ColorGrid = TColor($3A3A3A); // разделители + ColorClip = TColor($2A4A6B); // тёплый коричневый: обычный клип + ColorClipImage = TColor($4A5A2A); // приглушённый зелёный: картинка + ColorClipSelected = TColor($38608A); // тот же коричневый, но светлее + ColorClipBorder = TColor($5080AA); // светлая рамка клипа + ColorClipText = TColor($F0F0F0); + ColorPlayhead = TColor($4040FF); // красный: привычный цвет курсора + ColorEdgeSnap = TColor($909090); // серый: рез притянут к опорному кадру + ColorEdgePrecise = TColor($FFC030); // голубой: рез потребует перекодирования + ColorVolumeLine = TColor($60E0E0); // жёлтый: линия громкости + ColorVolumeHandle = TColor($30C0FF); // оранжевый: ручка громкости + ColorHeaderActive = TColor($3A3A3A); // подсветка выбранной дорожки + ColorButtonOff = TColor($3A3A3A); + ColorMuteOn = TColor($4040D0); // красный: дорожка выключена + ColorSoloOn = TColor($40C0D0); // жёлтый: дорожка солирует + +{ --- Создание --- } + +constructor TTimelineControl.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + ControlStyle := ControlStyle + [csOpaque]; + TabStop := True; + FBuffer := TBitmap.Create; + FBuffer.PixelFormat := pf32bit; + + FPixelsPerSecond := 20; + FScrollOffset := 0; + FTrackHeight := 64; + FRulerHeight := 28; + { Шире, чем раньше: в заголовке теперь живут название, число клипов и + кнопки выключения и «соло». } + FHeaderWidth := 150; + FHoverTrack := -1; + FActiveTrack := 0; + FSnapEnabled := True; +end; + +destructor TTimelineControl.Destroy; +begin + FBuffer.Free; + inherited Destroy; +end; + +{ --- Координаты --- } + +function TTimelineControl.GetVisibleWidth: Integer; +begin + Result := Max(1, ClientWidth - FHeaderWidth); +end; + +function TTimelineControl.TimeToX(const ATime: Double): Integer; +begin + Result := FHeaderWidth + Round((ATime - FScrollOffset) * FPixelsPerSecond); +end; + +function TTimelineControl.XToTime(const AX: Integer): Double; +begin + if FPixelsPerSecond <= 0 then + Exit(FScrollOffset); + Result := FScrollOffset + (AX - FHeaderWidth) / FPixelsPerSecond; +end; + +function TTimelineControl.TrackTop(AIndex: Integer): Integer; +begin + Result := FRulerHeight + AIndex * FTrackHeight - FScrollY; +end; + +{ Нижняя граница последней дорожки на экране. Ниже неё начинается пустое + место, куда можно бросить клип, чтобы завести новую дорожку. } +function TTimelineControl.TracksBottom: Integer; +begin + if FProject = nil then + Exit(FRulerHeight); + Result := TrackTop(FProject.TrackCount - 1) + FTrackHeight; +end; + +function TTimelineControl.TrackIndexAt(const AY: Integer): Integer; +begin + if (FProject = nil) or (AY < FRulerHeight) then + Exit(-1); + Result := (AY - FRulerHeight + FScrollY) div FTrackHeight; + if (Result < 0) or (Result >= FProject.TrackCount) then + Result := -1; +end; + +procedure TTimelineControl.ClampScrollY; +var + Content, View, MaxY: Integer; +begin + if FProject = nil then + begin + FScrollY := 0; + Exit; + end; + Content := FProject.TrackCount * FTrackHeight; + View := Max(1, ClientHeight - FRulerHeight); + { Оставляем полдорожки запаса снизу: туда бросают клип, чтобы завести + новую дорожку, и до этого места надо иметь возможность доскроллить. } + MaxY := Max(0, Content - View + FTrackHeight div 2); + if FScrollY > MaxY then + FScrollY := MaxY; + if FScrollY < 0 then + FScrollY := 0; +end; + +function TTimelineControl.ClipAtPoint(const AX, AY: Integer; + out ATrack: TTrack): TClip; +var + Idx: Integer; +begin + ATrack := nil; + Result := nil; + if (FProject = nil) or (AX < FHeaderWidth) then + Exit; + Idx := TrackIndexAt(AY); + if Idx < 0 then + Exit; + ATrack := FProject.Tracks[Idx]; + Result := ATrack.ClipAt(XToTime(AX)); +end; + +{ Минус один — левый край, плюс один — правый, ноль — середина. } +function TTimelineControl.EdgeAtPoint(const AX: Integer; AClip: TClip): Integer; +var + L, R: Integer; +begin + Result := 0; + if AClip = nil then + Exit; + L := TimeToX(AClip.TlStart); + R := TimeToX(AClip.TlEnd); + { Узкий клип не должен состоять из одних краёв: иначе его нельзя + будет перенести. } + if R - L < EdgeGrabPixels * 3 then + Exit; + if Abs(AX - L) <= EdgeGrabPixels then + Result := -1 + else if Abs(AX - R) <= EdgeGrabPixels then + Result := 1; +end; + +{ Кнопки выключения и «соло» стоят в правой части заголовка, одна под + другой возле нижнего края. } +function TTimelineControl.HeaderPartAt(const AX, AY: Integer; + out ATrackIndex: Integer): THeaderPart; +var + RowTop, BtnTop, BtnLeft: Integer; +begin + Result := hpNone; + ATrackIndex := -1; + if (FProject = nil) or (AX >= FHeaderWidth) or (AY < FRulerHeight) then + Exit; + + ATrackIndex := TrackIndexAt(AY); + if ATrackIndex < 0 then + Exit; + + Result := hpBody; + RowTop := TrackTop(ATrackIndex); + BtnTop := RowTop + FTrackHeight - HeaderButtonSize - 6; + if (AY < BtnTop) or (AY > BtnTop + HeaderButtonSize) then + Exit; + + BtnLeft := FHeaderWidth - 2 * HeaderButtonSize - HeaderButtonGap - 8; + if (AX >= BtnLeft) and (AX < BtnLeft + HeaderButtonSize) then + Result := hpMute + else if (AX >= BtnLeft + HeaderButtonSize + HeaderButtonGap) and + (AX < BtnLeft + 2 * HeaderButtonSize + HeaderButtonGap) then + Result := hpSolo; +end; + +{ Громкость откладывается по высоте клипа: полная тишина внизу, двойная + громкость вверху, обычная ровно посередине. } +function TTimelineControl.VolumeToY(const AVolume: Double; ATop: Integer): Integer; +var + BodyTop, BodyHeight: Integer; + V: Double; +begin + BodyTop := ATop + 3; + BodyHeight := FTrackHeight - 6; + V := AVolume; + if V < 0 then + V := 0; + if V > MaxClipVolume then + V := MaxClipVolume; + Result := BodyTop + Round((1 - V / MaxClipVolume) * BodyHeight); +end; + +function TTimelineControl.YToVolume(const AY: Integer; ATop: Integer): Double; +var + BodyTop, BodyHeight: Integer; +begin + BodyTop := ATop + 3; + BodyHeight := FTrackHeight - 6; + if BodyHeight <= 0 then + Exit(1); + Result := (1 - (AY - BodyTop) / BodyHeight) * MaxClipVolume; + if Result < 0 then + Result := 0; + if Result > MaxClipVolume then + Result := MaxClipVolume; +end; + +function TTimelineControl.VolumeHandleRect(AClip: TClip; ATop: Integer): TRect; +var + L, R, CenterX, Y: Integer; +begin + Result := Rect(0, 0, 0, 0); + if AClip = nil then + Exit; + + L := TimeToX(AClip.TlStart); + R := TimeToX(AClip.TlEnd); + if (R < FHeaderWidth) or (L > ClientWidth) then + Exit; + + { Обрезаем по видимой области и берём её середину: у длинного клипа + настоящая середина может быть далеко за краем экрана. } + if L < FHeaderWidth then + L := FHeaderWidth; + if R > ClientWidth then + R := ClientWidth; + if R - L < VolumeHandleWidth then + Exit; + + CenterX := (L + R) div 2; + Y := VolumeToY(AClip.Volume, ATop); + Result := Rect(CenterX - VolumeHandleWidth div 2, Y - VolumeHandleHeight div 2, + CenterX + VolumeHandleWidth div 2, Y + VolumeHandleHeight div 2); +end; + +function TTimelineControl.MediaDurationOf(AClip: TClip): Double; +var + Item: TMediaItem; +begin + Result := 0; + if (FProject = nil) or (AClip = nil) then + Exit; + Item := FProject.FindMedia(AClip.MediaId); + if Item = nil then + Exit; + Result := Item.Info.Duration; +end; + +{ --- Отрисовка --- } + +procedure TTimelineControl.Paint; +begin + if (FBuffer.Width <> ClientWidth) or (FBuffer.Height <> ClientHeight) then + FBuffer.SetSize(Max(1, ClientWidth), Max(1, ClientHeight)); + + FBuffer.Canvas.Brush.Color := ColorBack; + FBuffer.Canvas.FillRect(0, 0, FBuffer.Width, FBuffer.Height); + + DrawTracks(FBuffer.Canvas); + DrawRuler(FBuffer.Canvas); + DrawHeaders(FBuffer.Canvas); + DrawPlayhead(FBuffer.Canvas); + + Canvas.Draw(0, 0, FBuffer); +end; + +{ Подпись деления. Ниже секунды показываются доли, выше — часы и минуты. } +function TickLabel(const ATime, AStep: Double): string; +var + Total, H, M, S: Integer; +begin + Total := Trunc(ATime); + H := Total div 3600; + M := (Total mod 3600) div 60; + S := Total mod 60; + if AStep < 1 then + Result := Format('%.2d:%.2d.%.2d', [M, S, Round(Frac(ATime) * 100)]) + else if H > 0 then + Result := Format('%d:%.2d:%.2d', [H, M, S]) + else + Result := Format('%.2d:%.2d', [M, S]); +end; + +procedure TTimelineControl.DrawRuler(ACanvas: TCanvas); +var + I, X: Integer; + Step, T, TFirst, TLast: Double; +begin + ACanvas.Brush.Color := ColorRuler; + ACanvas.FillRect(0, 0, ClientWidth, FRulerHeight); + + ACanvas.Pen.Color := ColorGrid; + ACanvas.Line(0, FRulerHeight - 1, ClientWidth, FRulerHeight - 1); + + { Подбираем самый мелкий шаг, при котором деления ещё не слипаются. } + Step := RulerSteps[High(RulerSteps)]; + for I := 0 to High(RulerSteps) do + if RulerSteps[I] * FPixelsPerSecond >= MinTickPixels then + begin + Step := RulerSteps[I]; + Break; + end; + + TFirst := XToTime(FHeaderWidth); + TLast := XToTime(ClientWidth); + if TFirst < 0 then + TFirst := 0; + + ACanvas.Font.Color := ColorRulerText; + ACanvas.Font.Height := -11; + ACanvas.Brush.Style := bsClear; + + T := Int(TFirst / Step) * Step; + while T <= TLast do + begin + X := TimeToX(T); + if X >= FHeaderWidth then + begin + ACanvas.Pen.Color := ColorGrid; + ACanvas.Line(X, FRulerHeight - 8, X, FRulerHeight - 1); + ACanvas.TextOut(X + 3, 4, TickLabel(T, Step)); + end; + T := T + Step; + end; + + ACanvas.Brush.Style := bsSolid; +end; + +procedure TTimelineControl.DrawClip(ACanvas: TCanvas; AClip: TClip; + ATop: Integer); +var + L, R, W: Integer; + Item: TMediaItem; + { Не Caption и не Top: эти имена заняты свойствами TControl, и локальная + переменная их перекроет. Компилятор ловит, но сообщение неочевидное. } + ClipCaption: string; + Body: TRect; +begin + L := TimeToX(AClip.TlStart); + R := TimeToX(AClip.TlEnd); + { Клип целиком за пределами видимой области рисовать незачем. } + if (R < FHeaderWidth) or (L > ClientWidth) then + Exit; + + { Обрезаем по левой границе полосы дорожек, иначе клип наползёт на + названия дорожек. } + if L < FHeaderWidth then + L := FHeaderWidth; + if R > ClientWidth then + R := ClientWidth; + if R <= L then + R := L + 1; + + Body := Rect(L, ATop + 3, R, ATop + FTrackHeight - 3); + + if AClip.Selected then + ACanvas.Brush.Color := ColorClipSelected + else if AClip.Kind = ckImage then + ACanvas.Brush.Color := ColorClipImage + else + ACanvas.Brush.Color := ColorClip; + ACanvas.FillRect(Body); + + ACanvas.Pen.Color := ColorClipBorder; + ACanvas.Brush.Style := bsClear; + ACanvas.Rectangle(Body); + + { Полоски на краях показывают, притянут рез к опорному кадру или + потребует перекодирования. Без этого непонятно, где сборка будет + быстрой, а где нет. } + W := R - L; + if W > 6 then + begin + if AClip.EdgeIn = edPrecise then + ACanvas.Brush.Color := ColorEdgePrecise + else + ACanvas.Brush.Color := ColorEdgeSnap; + ACanvas.Brush.Style := bsSolid; + ACanvas.FillRect(Body.Left + 1, Body.Top + 1, Body.Left + 4, Body.Bottom - 1); + + if AClip.EdgeOut = edPrecise then + ACanvas.Brush.Color := ColorEdgePrecise + else + ACanvas.Brush.Color := ColorEdgeSnap; + ACanvas.FillRect(Body.Right - 4, Body.Top + 1, Body.Right - 1, Body.Bottom - 1); + end; + + { Громкость рисуется до подписей: иначе её линия перечёркивает название + и длительность. } + DrawVolume(ACanvas, AClip, ATop, Body); + + if W > 40 then + begin + Item := nil; + if FProject <> nil then + Item := FProject.FindMedia(AClip.MediaId); + if Item <> nil then + ClipCaption := ExtractFileName(Item.Path) + else + ClipCaption := '(нет файла)'; + + ACanvas.Brush.Style := bsClear; + ACanvas.Font.Color := ColorClipText; + ACanvas.Font.Height := -11; + ACanvas.TextOut(Body.Left + 7, Body.Top + 4, ClipCaption); + ACanvas.TextOut(Body.Left + 7, Body.Top + 20, + SecondsToStr(AClip.Duration) + ' с'); + end; + + ACanvas.Brush.Style := bsSolid; +end; + +{ Линия громкости с ручкой посередине видимой части клипа. + + Сделано как в монтажных программах: линия показывает уровень, за ручку + её тянут вверх и вниз. Смысл линии, а не числа, в том, что уровень + сразу виден у всех клипов разом. } +procedure TTimelineControl.DrawVolume(ACanvas: TCanvas; AClip: TClip; + ATop: Integer; const ABody: TRect); +var + Y: Integer; + H: TRect; + { Не Caption и не Handle: оба имени заняты у предков. } + VolText: string; +begin + if AClip.Kind = ckBlack then + Exit; + if ABody.Right - ABody.Left < 12 then + Exit; + + Y := VolumeToY(AClip.Volume, ATop); + if (Y <= ABody.Top) then + Y := ABody.Top + 1; + if (Y >= ABody.Bottom) then + Y := ABody.Bottom - 1; + + ACanvas.Pen.Color := ColorVolumeLine; + ACanvas.Pen.Width := 1; + ACanvas.Line(ABody.Left + 1, Y, ABody.Right - 1, Y); + + H := VolumeHandleRect(AClip, ATop); + if H.Right <= H.Left then + Exit; + + ACanvas.Brush.Color := ColorVolumeHandle; + ACanvas.Brush.Style := bsSolid; + ACanvas.Pen.Color := ColorClipText; + ACanvas.Rectangle(H); + + { Значение подписываем только когда клип достаточно широк, иначе + надпись налезет на соседние. } + if ABody.Right - ABody.Left > 130 then + begin + VolText := IntToStr(Round(AClip.Volume * 100)) + '%'; + ACanvas.Brush.Style := bsClear; + ACanvas.Font.Color := ColorVolumeLine; + ACanvas.Font.Height := -10; + ACanvas.TextOut(H.Right + 6, Y - 7, VolText); + ACanvas.Brush.Style := bsSolid; + end; +end; + +procedure TTimelineControl.DrawTracks(ACanvas: TCanvas); +var + T, C, RowTop: Integer; + Track: TTrack; +begin + if FProject = nil then + Exit; + + for T := 0 to FProject.TrackCount - 1 do + begin + RowTop := TrackTop(T); + if RowTop > ClientHeight then + Break; + { Дорожки, уехавшие вверх за линейку, рисовать не нужно. } + if RowTop + FTrackHeight < FRulerHeight then + Continue; + + if Odd(T) then + ACanvas.Brush.Color := ColorTrackOdd + else + ACanvas.Brush.Color := ColorTrackEven; + ACanvas.FillRect(FHeaderWidth, RowTop, ClientWidth, RowTop + FTrackHeight); + + ACanvas.Pen.Color := ColorGrid; + ACanvas.Line(FHeaderWidth, RowTop + FTrackHeight - 1, + ClientWidth, RowTop + FTrackHeight - 1); + + Track := FProject.Tracks[T]; + for C := 0 to Track.Count - 1 do + DrawClip(ACanvas, Track[C], RowTop); + end; +end; + +procedure TTimelineControl.DrawHeaders(ACanvas: TCanvas); +var + T, RowTop, BtnTop, BtnLeft: Integer; + Track: TTrack; + + { Маленькая кнопка с буквой. Цвет заливки показывает состояние. } + procedure Button(ALeft, ATop: Integer; const ACaption: string; + AOn: Boolean; AOnColor: TColor); + var + R: TRect; + TextX: Integer; + begin + R := Rect(ALeft, ATop, ALeft + HeaderButtonSize, ATop + HeaderButtonSize); + if AOn then + ACanvas.Brush.Color := AOnColor + else + ACanvas.Brush.Color := ColorButtonOff; + ACanvas.Brush.Style := bsSolid; + ACanvas.Pen.Color := ColorGrid; + ACanvas.Rectangle(R); + + ACanvas.Brush.Style := bsClear; + if AOn then + ACanvas.Font.Color := clBlack + else + ACanvas.Font.Color := ColorRulerText; + ACanvas.Font.Height := -12; + TextX := ALeft + (HeaderButtonSize - ACanvas.TextWidth(ACaption)) div 2; + ACanvas.TextOut(TextX, ATop + 2, ACaption); + ACanvas.Brush.Style := bsSolid; + end; + +begin + ACanvas.Brush.Color := ColorHeader; + ACanvas.FillRect(0, 0, FHeaderWidth, ClientHeight); + ACanvas.Pen.Color := ColorGrid; + ACanvas.Line(FHeaderWidth - 1, 0, FHeaderWidth - 1, ClientHeight); + + if FProject = nil then + Exit; + + for T := 0 to FProject.TrackCount - 1 do + begin + RowTop := TrackTop(T); + if RowTop > ClientHeight then + Break; + if RowTop + FTrackHeight < FRulerHeight then + Continue; + Track := FProject.Tracks[T]; + + { Выбранная дорожка подсвечена: именно на неё кладётся файл кнопкой. } + if T = FActiveTrack then + begin + ACanvas.Brush.Color := ColorHeaderActive; + ACanvas.FillRect(0, RowTop, FHeaderWidth - 1, RowTop + FTrackHeight - 1); + ACanvas.Brush.Color := ColorEdgePrecise; + ACanvas.FillRect(0, RowTop, 3, RowTop + FTrackHeight - 1); + end; + + ACanvas.Pen.Color := ColorGrid; + ACanvas.Line(0, RowTop + FTrackHeight - 1, FHeaderWidth, + RowTop + FTrackHeight - 1); + + ACanvas.Brush.Style := bsClear; + if FProject.TrackAudible(Track) then + ACanvas.Font.Color := ColorRulerText + else + ACanvas.Font.Color := clGray; + ACanvas.Font.Height := -12; + ACanvas.Font.Style := [fsBold]; + ACanvas.TextOut(8, RowTop + 6, Track.Name); + ACanvas.Font.Style := []; + + ACanvas.Font.Color := clGray; + ACanvas.Font.Height := -10; + if T = 0 then + ACanvas.TextOut(8, RowTop + 24, + IntToStr(Track.Count) + ' кл. верх') + else + ACanvas.TextOut(8, RowTop + 24, IntToStr(Track.Count) + ' кл.'); + ACanvas.Brush.Style := bsSolid; + + BtnTop := RowTop + FTrackHeight - HeaderButtonSize - 6; + BtnLeft := FHeaderWidth - 2 * HeaderButtonSize - HeaderButtonGap - 8; + { М — выключить дорожку целиком, С — слушать только её. } + Button(BtnLeft, BtnTop, 'М', Track.Muted, ColorMuteOn); + Button(BtnLeft + HeaderButtonSize + HeaderButtonGap, BtnTop, 'С', + Track.Solo, ColorSoloOn); + end; + + ACanvas.Brush.Style := bsSolid; +end; + +procedure TTimelineControl.DrawPlayhead(ACanvas: TCanvas); +var + X: Integer; +begin + X := TimeToX(FPlayhead); + if (X < FHeaderWidth) or (X > ClientWidth) then + Exit; + ACanvas.Pen.Color := ColorPlayhead; + ACanvas.Pen.Width := 1; + ACanvas.Line(X, 0, X, ClientHeight); + + { Треугольник-указатель на линейке: тонкую линию трудно поймать мышью. } + ACanvas.Brush.Color := ColorPlayhead; + ACanvas.Polygon([Point(X - 5, 0), Point(X + 5, 0), Point(X, 9)]); +end; + +{ --- Масштаб и прокрутка --- } + +procedure TTimelineControl.SetPixelsPerSecond(const AValue: Double); +begin + FPixelsPerSecond := Min(MaxPixelsPerSecond, Max(MinPixelsPerSecond, AValue)); + ClampScroll; + Invalidate; +end; + +procedure TTimelineControl.ClampScroll; +var + MaxTime: Double; +begin + if FScrollOffset < 0 then + FScrollOffset := 0; + if FProject = nil then + Exit; + { Уехать правее конца монтажа можно, но не бесконечно: иначе прокрутка + теряет смысл. Оставляем один экран запаса. } + MaxTime := FProject.EndTime; + if FScrollOffset > MaxTime then + FScrollOffset := Max(0, MaxTime); +end; + +procedure TTimelineControl.ZoomAt(const AFactor: Double; AAnchorX: Integer); +var + TimeAtAnchor: Double; +begin + { Смысл этих трёх строк: запомнить, какое время под курсором, поменять + масштаб, затем подобрать сдвиг так, чтобы это время снова оказалось + под курсором. } + TimeAtAnchor := XToTime(AAnchorX); + FPixelsPerSecond := Min(MaxPixelsPerSecond, + Max(MinPixelsPerSecond, FPixelsPerSecond * AFactor)); + FScrollOffset := TimeAtAnchor - (AAnchorX - FHeaderWidth) / FPixelsPerSecond; + ClampScroll; + Invalidate; +end; + +procedure TTimelineControl.ZoomToFit; +var + Total: Double; +begin + if FProject = nil then + Exit; + Total := FProject.EndTime; + if Total <= 0 then + Total := 60; + FScrollOffset := 0; + FPixelsPerSecond := Min(MaxPixelsPerSecond, + Max(MinPixelsPerSecond, GetVisibleWidth / (Total * 1.05))); + Invalidate; +end; + +procedure TTimelineControl.ScrollToPlayhead(ACenter: Boolean); +var + Span, Target, Old: Double; +begin + if FPixelsPerSecond <= 0 then + Exit; + Span := GetVisibleWidth / FPixelsPerSecond; + Old := FScrollOffset; + + if ACenter then + Target := FPlayhead - Span / 2 + else + begin + { Курсор внутри видимой части — двигать нечего. } + if (FPlayhead >= FScrollOffset) and (FPlayhead <= FScrollOffset + Span) then + Exit; + { Ушёл за край — показываем его посередине, а не впритык: так видно, + что происходит и до, и после. } + Target := FPlayhead - Span / 2; + end; + + if Target < 0 then + Target := 0; + + { Перерисовываем только при заметном сдвиге: при воспроизведении этот + метод зовётся на каждый кадр. } + if Abs(Target - Old) * FPixelsPerSecond < 1 then + Exit; + + FScrollOffset := Target; + Invalidate; +end; + +function TTimelineControl.TrackIndexAtPoint(const AY: Integer): Integer; +begin + Result := TrackIndexAt(AY); +end; + +function TTimelineControl.TimeAtPoint(const AX: Integer): Double; +begin + Result := Max(0, XToTime(AX)); +end; + +function TTimelineControl.FirstClipTime: Double; +var + T, C: Integer; + Found: Boolean; +begin + Result := 0; + Found := False; + if FProject = nil then + Exit; + for T := 0 to FProject.TrackCount - 1 do + for C := 0 to FProject.Tracks[T].Count - 1 do + if (not Found) or (FProject.Tracks[T][C].TlStart < Result) then + begin + Result := FProject.Tracks[T][C].TlStart; + Found := True; + end; + if not Found then + Result := 0; +end; + +function TTimelineControl.LastClipTime: Double; +begin + Result := 0; + if FProject <> nil then + Result := FProject.EndTime; +end; + +procedure TTimelineControl.SetPlayhead(const AValue: Double); +begin + if FPlayhead = AValue then + Exit; + FPlayhead := Max(0, AValue); + Invalidate; + if Assigned(FOnPlayheadChange) then + FOnPlayheadChange(Self); +end; + +procedure TTimelineControl.StructureChanged; +begin + Invalidate; + if Assigned(FOnStructureChange) then + FOnStructureChange(Self); +end; + +{ Примагничивание к краям соседних клипов и к курсору воспроизведения. } +function TTimelineControl.SnapTime(const ATime: Double; AExclude: TClip): Double; +var + T, C: Integer; + Track: TTrack; + Clip: TClip; + Best, BestDist, Dist, Tolerance: Double; + + procedure Consider(const ACandidate: Double); + begin + Dist := Abs(ACandidate - ATime); + if Dist < BestDist then + begin + BestDist := Dist; + Best := ACandidate; + end; + end; + +begin + Result := ATime; + if FProject = nil then + Exit; + { Shift меняет решение на противоположное: при включённом прилипании + временно отключает его, при выключенном — временно включает. Так одна + и та же клавиша полезна в обоих режимах. } + if FSnapEnabled = FSnapSuspended then + Exit; + + Tolerance := SnapPixels / FPixelsPerSecond; + BestDist := Tolerance; + Best := ATime; + + Consider(0); + Consider(FPlayhead); + + for T := 0 to FProject.TrackCount - 1 do + begin + Track := FProject.Tracks[T]; + for C := 0 to Track.Count - 1 do + begin + Clip := Track[C]; + if Clip = AExclude then + Continue; + { Клипы, которые едут вместе с перетаскиваемым, притягивать нельзя: + они движутся синхронно с ним, и примагничивание к ним заставило бы + клип цепляться за собственное следствие. } + if IsRippling(Clip) then + Continue; + Consider(Clip.TlStart); + Consider(Clip.TlEnd); + end; + end; + + Result := Best; +end; + +{ --- Мышь --- } + +procedure TTimelineControl.MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +var + Track: TTrack; + Clip: TClip; + Edge, Idx: Integer; + Part: THeaderPart; + VolHandle: TRect; +begin + inherited MouseDown(Button, Shift, X, Y); + SetFocus; + FSnapSuspended := ssShift in Shift; + + if Button = mbMiddle then + begin + FAction := taPan; + FPanOriginX := X; + FPanOriginY := Y; + FPanOriginTime := FScrollOffset; + FPanOriginScrollY := FScrollY; + Exit; + end; + + if Button <> mbLeft then + Exit; + + { Полоса заголовков: выбор дорожки и её кнопки. } + if X < FHeaderWidth then + begin + Part := HeaderPartAt(X, Y, Idx); + if Idx < 0 then + Exit; + case Part of + hpMute: + begin + FProject.BeginChange; + FProject.Tracks[Idx].Muted := not FProject.Tracks[Idx].Muted; + StructureChanged; + end; + hpSolo: + begin + FProject.BeginChange; + FProject.Tracks[Idx].Solo := not FProject.Tracks[Idx].Solo; + StructureChanged; + end; + hpBody: + begin + FActiveTrack := Idx; + Invalidate; + if Assigned(FOnActiveTrackChange) then + FOnActiveTrackChange(Self); + end; + end; + Exit; + end; + + { Щелчок по линейке ставит курсор воспроизведения. } + if Y < FRulerHeight then + begin + FAction := taScrub; + Playhead := Max(0, XToTime(X)); + Exit; + end; + + Clip := ClipAtPoint(X, Y, Track); + + if Clip = nil then + begin + { По пустому месту дорожки — тоже ставим курсор: так удобнее, чем + тянуться к линейке. } + if not (ssCtrl in Shift) then + begin + FProject.ClearSelection; + if Assigned(FOnSelectionChange) then + FOnSelectionChange(Self); + end; + FAction := taScrub; + Playhead := Max(0, XToTime(X)); + Exit; + end; + + if not (ssCtrl in Shift) then + if not Clip.Selected then + FProject.ClearSelection; + Clip.Selected := True; + if Assigned(FOnSelectionChange) then + FOnSelectionChange(Self); + + FDragClip := Clip; + FDragTrack := Track; + FDragOrigStart := Clip.TlStart; + FDragOrigSrcIn := Clip.SrcIn; + FDragOrigDuration := Clip.Duration; + FTrackAddedDuringDrag := False; + + { Ручка громкости имеет приоритет над переносом клипа: она мелкая, и + промахнуться мимо неё легче, чем мимо всего клипа. } + VolHandle := VolumeHandleRect(Clip, TrackTop(TrackIndexAt(Y))); + Edge := EdgeAtPoint(X, Clip); + + if (Clip.Kind <> ckBlack) and (X >= VolHandle.Left) and (X <= VolHandle.Right) and + (Y >= VolHandle.Top - 3) and (Y <= VolHandle.Bottom + 3) then + begin + FAction := taVolume; + FDragOrigVolume := Clip.Volume; + end + else + case Edge of + -1: FAction := taTrimIn; + 1: FAction := taTrimOut; + else + begin + FAction := taDragClip; + FDragGrabOffset := XToTime(X) - Clip.TlStart; + end; + end; + + { Автосхлопывание: составляем список того, что поедет вслед за клипом. + + Список берётся один раз, при нажатии, и хранит исходные позиции. + Пересчитывать его на каждое движение мыши нельзя: туда начали бы + попадать клипы, которые уже сдвинулись. } + FRippleClips := nil; + FRippleOrigStarts := nil; + if (FAction = taDragClip) and FProject.RippleEnabled then + CollectRippleClips(TrackIndexAt(Y), Clip, Clip.TlStart); + + { Курсор воспроизведения здесь не трогаем. Нажатие на клип — это ещё + не щелчок: с него может начаться перетаскивание, и дёргать курсор в + начале каждого переноса неправильно, особенно во время + воспроизведения. Решение принимается при отпускании кнопки. } + FPressX := X; + FPressY := Y; + FMovedWhileDown := False; + + FProject.BeginChange; + Invalidate; +end; + +procedure TTimelineControl.MouseMove(Shift: TShiftState; X, Y: Integer); +var + NewStart, NewEnd, Delta, MediaLen: Double; + Edge, Idx: Integer; + Clip: TClip; + Track, TargetTrack: TTrack; + VolHandle: TRect; +begin + inherited MouseMove(Shift, X, Y); + VolHandle := Rect(0, 0, 0, 0); + FSnapSuspended := ssShift in Shift; + + Idx := TrackIndexAt(Y); + if Idx <> FHoverTrack then + begin + FHoverTrack := Idx; + Invalidate; + end; + + if (FAction in [taDragClip, taTrimIn, taTrimOut, taVolume]) and + (not FMovedWhileDown) then + if (Abs(X - FPressX) > ClickSlopPixels) or + (Abs(Y - FPressY) > ClickSlopPixels) then + FMovedWhileDown := True; + + { Курсор мыши подсказывает, что произойдёт при нажатии. } + if FAction = taNone then + begin + Clip := ClipAtPoint(X, Y, Track); + Edge := EdgeAtPoint(X, Clip); + if (Clip <> nil) and (Idx >= 0) then + VolHandle := VolumeHandleRect(Clip, TrackTop(Idx)); + if (Clip <> nil) and (Clip.Kind <> ckBlack) and + (X >= VolHandle.Left) and (X <= VolHandle.Right) and + (Y >= VolHandle.Top - 3) and (Y <= VolHandle.Bottom + 3) then + Cursor := crSizeNS + else if Edge <> 0 then + Cursor := crSizeWE + else if Clip <> nil then + Cursor := crHandPoint + else + Cursor := crDefault; + Exit; + end; + + case FAction of + taPan: + begin + FScrollOffset := FPanOriginTime - (X - FPanOriginX) / FPixelsPerSecond; + FScrollY := FPanOriginScrollY - (Y - FPanOriginY); + ClampScroll; + ClampScrollY; + Invalidate; + end; + + taScrub: + Playhead := Max(0, XToTime(X)); + + taVolume: + if FDragClip <> nil then + begin + Idx := TrackIndexAt(FPressY); + if Idx >= 0 then + begin + FDragClip.Volume := YToVolume(Y, TrackTop(Idx)); + Invalidate; + end; + end; + + taDragClip: + if FDragClip <> nil then + begin + NewStart := SnapTime(XToTime(X) - FDragGrabOffset, FDragClip); + FDragClip.TlStart := Max(0, NewStart); + { Всё, что правее, едет на ту же величину. } + if Length(FRippleClips) > 0 then + ApplyRipple(FDragClip.TlStart - FDragOrigStart); + + { Утащили ниже последней дорожки — заводим новую, как в Vegas. + За одно перетаскивание не больше одной: иначе движение мыши + вниз наплодило бы их десяток. } + if (Idx < 0) and (FProject <> nil) and (Y > TracksBottom) and + (not FTrackAddedDuringDrag) then + begin + FProject.AddTrack('V' + IntToStr(FProject.TrackCount + 1)); + FTrackAddedDuringDrag := True; + Idx := FProject.TrackCount - 1; + if Assigned(FOnTrackAdded) then + FOnTrackAdded(Self); + end; + + { Перенос на другую дорожку: клип следует за указателем по + вертикали. Именно перенос, а не копирование. } + if (Idx >= 0) and (FProject <> nil) then + begin + TargetTrack := FProject.Tracks[Idx]; + if TargetTrack <> FDragTrack then + begin + FDragTrack.Extract(FDragClip); + TargetTrack.Add(FDragClip); + FDragTrack := TargetTrack; + end; + end; + + FDragTrack.Sort; + Invalidate; + end; + + taTrimIn: + if FDragClip <> nil then + begin + NewStart := SnapTime(XToTime(X), FDragClip); + { Правый край стоит на месте, двигается левый: меняются и позиция + на монтаже, и то, с какого места берётся материал. } + Delta := NewStart - FDragOrigStart; + + { Дальше начала исходника уйти нельзя — материала там нет. + Для картинки такого ограничения нет: она тянется сколько угодно. } + if FDragClip.Kind <> ckImage then + if FDragOrigSrcIn + Delta < 0 then + Delta := -FDragOrigSrcIn; + + { Клип не может стать короче, чем ничего. } + if FDragOrigDuration - Delta < 0.04 then + Delta := FDragOrigDuration - 0.04; + + FDragClip.TlStart := Max(0, FDragOrigStart + Delta); + if FDragClip.Kind <> ckImage then + FDragClip.SrcIn := FDragOrigSrcIn + Delta; + FDragClip.Duration := FDragOrigDuration - Delta; + Invalidate; + end; + + taTrimOut: + if FDragClip <> nil then + begin + NewEnd := SnapTime(XToTime(X), FDragClip); + Delta := NewEnd - (FDragOrigStart + FDragOrigDuration); + + MediaLen := MediaDurationOf(FDragClip); + if (FDragClip.Kind <> ckImage) and (MediaLen > 0) then + if FDragOrigSrcIn + FDragOrigDuration + Delta > MediaLen then + Delta := MediaLen - FDragOrigSrcIn - FDragOrigDuration; + + if FDragOrigDuration + Delta < 0.04 then + Delta := 0.04 - FDragOrigDuration; + + FDragClip.Duration := FDragOrigDuration + Delta; + Invalidate; + end; + end; +end; + +{ Левый край клипа определяет, откуда копировать материал, а копировать + можно только с опорного кадра. Если человек подвинул край руками и попал + между опорными кадрами, значит ему нужен именно этот кадр — помечаем рез + точным, и при сборке перекодируется огрызок до следующего опорного кадра. + Попал на опорный — перекодировать нечего. + + Правого края это не касается: при копировании потока он и так выходит + кадроточным. } +procedure TTimelineControl.UpdateEdgePrecision(AClip: TClip); +var + Item: TMediaItem; + Index: TKeyframeIndex; + Err: string; + Snapped: Double; +begin + if (FProject = nil) or (AClip = nil) then + Exit; + if AClip.Kind <> ckVideo then + Exit; + + Item := FProject.FindMedia(AClip.MediaId); + if Item = nil then + Exit; + if not FProject.KeyframeIndexOf(Item, Index, Err) then + Exit; + if Index.AllFrames then + begin + { У кодека без межкадрового сжатия опорный каждый кадр, резать можно + где угодно и без перекодирования. } + AClip.EdgeIn := edSnap; + Exit; + end; + + Snapped := SnapNearest(Index, AClip.SrcIn); + if Abs(Snapped - AClip.SrcIn) > 0.0005 then + AClip.EdgeIn := edPrecise + else + AClip.EdgeIn := edSnap; +end; + +{ Клипы правее указанного момента на затронутых дорожках. + + Что считается затронутым, решает режим: только дорожка правки или все. + Сам перетаскиваемый клип в список не попадает — он двигается отдельно. + + Отсчёт идёт от НАЧАЛА перетаскиваемого клипа, а не от его конца. Сначала + было от конца, и получалась несимметричность: клип с верхней дорожки + двигал нижние, а нижний не двигал верхние — те начинались раньше его + конца и в список не попадали. От начала правило читается просто: едет + всё, что начинается не раньше того, за что взялись. } +procedure TTimelineControl.CollectRippleClips(ATrackIndex: Integer; + AExclude: TClip; const AFromTime: Double); +var + T, C, N: Integer; + Track: TTrack; + Clip: TClip; +begin + FRippleClips := nil; + FRippleOrigStarts := nil; + if FProject = nil then + Exit; + + N := 0; + for T := 0 to FProject.TrackCount - 1 do + begin + if (FProject.RippleMode = rmCurrentTrack) and (T <> ATrackIndex) then + Continue; + Track := FProject.Tracks[T]; + for C := 0 to Track.Count - 1 do + begin + Clip := Track[C]; + if Clip = AExclude then + Continue; + if Clip.TlStart < AFromTime - 0.0005 then + Continue; + SetLength(FRippleClips, N + 1); + SetLength(FRippleOrigStarts, N + 1); + FRippleClips[N] := Clip; + FRippleOrigStarts[N] := Clip.TlStart; + Inc(N); + end; + end; +end; + +function TTimelineControl.IsRippling(AClip: TClip): Boolean; +var + I: Integer; +begin + for I := 0 to High(FRippleClips) do + if FRippleClips[I] = AClip then + Exit(True); + Result := False; +end; + +procedure TTimelineControl.ApplyRipple(const ADelta: Double); +var + I: Integer; +begin + for I := 0 to High(FRippleClips) do + FRippleClips[I].TlStart := Max(0, FRippleOrigStarts[I] + ADelta); +end; + +procedure TTimelineControl.MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +var + WasEditing, WasTrimIn, WasClipPress: Boolean; + Clip: TClip; +begin + inherited MouseUp(Button, Shift, X, Y); + WasEditing := FAction in [taDragClip, taTrimIn, taTrimOut, taVolume]; + WasTrimIn := FAction = taTrimIn; + WasClipPress := FAction = taDragClip; + Clip := FDragClip; + + FAction := taNone; + FDragClip := nil; + FDragTrack := nil; + FTrackAddedDuringDrag := False; + FRippleClips := nil; + FRippleOrigStarts := nil; + + if WasEditing and (not FMovedWhileDown) then + begin + { Нажали и отпустили, не сдвинув, — это щелчок. Ничего не изменилось, + поэтому заявку на изменение снимаем, а по щелчку именно на теле клипа + ставим курсор воспроизведения: так удобнее, чем целиться в линейку. } + if FProject <> nil then + FProject.CancelChange; + if WasClipPress then + Playhead := Max(0, XToTime(FPressX)); + Exit; + end; + + { Проверку на опорный кадр делаем один раз в конце, а не на каждое + движение мыши: для не-MP4 она может обойтись в чтение всего файла. } + if WasTrimIn and (Clip <> nil) then + UpdateEdgePrecision(Clip); + + if WasEditing then + StructureChanged; +end; + +function TTimelineControl.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; + MousePos: TPoint): Boolean; +var + Pt: TPoint; +begin + Pt := ScreenToClient(MousePos); + + if ssCtrl in Shift then + begin + { Ctrl с колесом — масштаб, точка под курсором остаётся на месте. } + if WheelDelta > 0 then + ZoomAt(ZoomStep, Pt.X) + else + ZoomAt(1 / ZoomStep, Pt.X); + Exit(True); + end; + + if ssShift in Shift then + begin + { Shift с колесом — прокрутка по времени на треть видимой ширины. } + if WheelDelta > 0 then + FScrollOffset := FScrollOffset - (GetVisibleWidth / 3) / FPixelsPerSecond + else + FScrollOffset := FScrollOffset + (GetVisibleWidth / 3) / FPixelsPerSecond; + ClampScroll; + Invalidate; + Exit(True); + end; + + { Просто колесо — прокрутка по дорожкам. Их бывает больше, чем помещается + в окно, и добираться до нижних важнее, чем ездить по времени: по + времени есть и Shift с колесом, и средняя кнопка. } + if WheelDelta > 0 then + Dec(FScrollY, FTrackHeight) + else + Inc(FScrollY, FTrackHeight); + ClampScrollY; + Invalidate; + Result := True; +end; + +procedure TTimelineControl.Resize; +begin + inherited Resize; + Invalidate; +end; + +{ --- Правки --- } + +procedure TTimelineControl.SplitAtPlayhead(APrecise: Boolean; + AOnlyCurrentTrack: Boolean); +var + T: Integer; + Track: TTrack; + Clip, Tail: TClip; + AnyChange: Boolean; + Offset: Double; +begin + if FProject = nil then + Exit; + + AnyChange := False; + FProject.BeginChange; + + for T := 0 to FProject.TrackCount - 1 do + begin + if AOnlyCurrentTrack and (FHoverTrack >= 0) and (T <> FHoverTrack) then + Continue; + + Track := FProject.Tracks[T]; + Clip := Track.ClipAt(FPlayhead); + if Clip = nil then + Continue; + + Offset := FPlayhead - Clip.TlStart; + { Рез вплотную к краю ничего не даёт, только плодит клипы нулевой длины. } + if (Offset < 0.001) or (Offset > Clip.Duration - 0.001) then + Continue; + + Tail := TClip.Create; + Tail.Id := Clip.Id + '_b'; + Tail.MediaId := Clip.MediaId; + Tail.Kind := Clip.Kind; + Tail.SrcIn := Clip.SrcIn + Offset; + Tail.TlStart := FPlayhead; + Tail.Duration := Clip.Duration - Offset; + Tail.EdgeOut := Clip.EdgeOut; + + { Новый рез описывается одинаково с обеих сторон: конец первой части + и начало второй — это одно и то же место. } + if APrecise then + begin + Clip.EdgeOut := edPrecise; + Tail.EdgeIn := edPrecise; + end + else + begin + Clip.EdgeOut := edSnap; + Tail.EdgeIn := edSnap; + end; + + Clip.Duration := Offset; + + Track.Add(Tail); + AnyChange := True; + end; + + if AnyChange then + StructureChanged + else + { Ничего не разрезали — снимок отмены не нужен, откатываем его. } + FProject.Undo; +end; + +procedure TTimelineControl.DeleteSelected; +var + T, C: Integer; + Track: TTrack; + AnyChange: Boolean; +begin + if FProject = nil then + Exit; + + AnyChange := False; + FProject.BeginChange; + + for T := 0 to FProject.TrackCount - 1 do + begin + Track := FProject.Tracks[T]; + for C := Track.Count - 1 downto 0 do + if Track[C].Selected then + begin + Track.Remove(Track[C]); + AnyChange := True; + end; + end; + + if AnyChange then + StructureChanged + else + FProject.Undo; +end; + +procedure TTimelineControl.RippleCloseGap; +var + T, C: Integer; + Track: TTrack; + GapStart, GapEnd, Shift: Double; + AnyChange: Boolean; + + { Находит дыру под курсором на дорожке: конец предыдущего клипа и + начало следующего. } + function FindGap(ATrack: TTrack; out AFrom, ATo: Double): Boolean; + var + I: Integer; + PrevEnd: Double; + begin + Result := False; + PrevEnd := 0; + for I := 0 to ATrack.Count - 1 do + begin + if ATrack[I].TlStart > PrevEnd + 0.0005 then + if (FPlayhead >= PrevEnd) and (FPlayhead <= ATrack[I].TlStart) then + begin + AFrom := PrevEnd; + ATo := ATrack[I].TlStart; + Exit(True); + end; + PrevEnd := Max(PrevEnd, ATrack[I].TlEnd); + end; + end; + +begin + if FProject = nil then + Exit; + + { Дыру ищем на той дорожке, где стоит указатель мыши: под курсором + воспроизведения дыры бывают сразу на нескольких, и надо знать, какая + имеется в виду. } + if (FHoverTrack < 0) or (FHoverTrack >= FProject.TrackCount) then + Exit; + + if not FindGap(FProject.Tracks[FHoverTrack], GapStart, GapEnd) then + Exit; + + Shift := GapEnd - GapStart; + if Shift <= 0 then + Exit; + + AnyChange := False; + FProject.BeginChange; + + for T := 0 to FProject.TrackCount - 1 do + begin + { Режим решает, сдвигать только эту дорожку или все. Смысл второго: + когда дорожки уже выверены друг относительно друга, сдвиг одной + всё бы разрушил. + + Режим действует и при выключенном автосхлопывании: это осознанная + команда, а не побочный эффект перетаскивания. } + if (FProject.RippleMode = rmCurrentTrack) and (T <> FHoverTrack) then + Continue; + + Track := FProject.Tracks[T]; + for C := 0 to Track.Count - 1 do + if Track[C].TlStart >= GapEnd - 0.0005 then + begin + Track[C].TlStart := Track[C].TlStart - Shift; + AnyChange := True; + end; + Track.Sort; + end; + + if AnyChange then + StructureChanged + else + FProject.Undo; +end; + +procedure TTimelineControl.SelectAll; +var + T, C: Integer; +begin + if FProject = nil then + Exit; + for T := 0 to FProject.TrackCount - 1 do + for C := 0 to FProject.Tracks[T].Count - 1 do + FProject.Tracks[T][C].Selected := True; + Invalidate; + if Assigned(FOnSelectionChange) then + FOnSelectionChange(Self); +end; + +procedure TTimelineControl.KeyDown(var Key: Word; Shift: TShiftState); +begin + inherited KeyDown(Key, Shift); + + case Key of + VK_DELETE: + begin + DeleteSelected; + Key := 0; + end; + VK_A: + if ssCtrl in Shift then + begin + SelectAll; + Key := 0; + end; + VK_HOME: + begin + { К началу самого раннего клипа, а не просто в ноль: если монтаж + начинается с пятой секунды, ноль — не то место, куда хотят + попасть. Когда клипов нет, начало и есть ноль. } + Playhead := FirstClipTime; + ScrollToPlayhead(False); + Key := 0; + end; + VK_END: + begin + Playhead := LastClipTime; + ScrollToPlayhead(False); + Key := 0; + end; + end; +end; + +{ --- Приём файлов из списка проекта --- } + +procedure TTimelineControl.DragOver(Source: TObject; X, Y: Integer; + State: TDragState; var Accept: Boolean); +begin + inherited DragOver(Source, X, Y, State, Accept); + { Берём всё, что тащат из списка, — какой именно файл, разбирается окно. + Бросать можно и ниже дорожек: там заведётся новая. } + Accept := Assigned(FOnMediaDrop) and (X >= FHeaderWidth) and + (Y >= FRulerHeight); +end; + +procedure TTimelineControl.DragDrop(Source: TObject; X, Y: Integer); +var + Idx: Integer; +begin + inherited DragDrop(Source, X, Y); + if not Assigned(FOnMediaDrop) then + Exit; + + Idx := TrackIndexAt(Y); + { Ниже всех дорожек — просим окно завести новую. } + if (Idx < 0) and (Y > TracksBottom) then + Idx := -1; + + FOnMediaDrop(Self, Source, Idx, Max(0, XToTime(X))); +end; + +end. diff --git a/src/uTransform.pas b/src/uTransform.pas new file mode 100644 index 0000000..bff9c7c --- /dev/null +++ b/src/uTransform.pas @@ -0,0 +1,266 @@ +{ + uTransform — как вписать кадр исходника в кадр проекта. + + Зачем это нужно. Проект имеет одно разрешение на всё — иначе куски не + склеить копированием. Файл с другим разрешением или другим соотношением + сторон надо во что-то превратить, и вариантов ровно три: вписать целиком + с полями, заполнить кадр с обрезкой краёв, растянуть с искажением + пропорций. Раньше молча делалось третье, и вертикальное видео + превращалось в размазанное по ширине — это была ошибка. + + Все размеры считаются числами здесь, а не выражениями внутри фильтра + ffmpeg. Выражения там пишутся через экранированные запятые и читаются + тяжело, а проверить посчитанные числа можно глазами прямо в журнале. + + Преобразование хранится у файла, а не у клипа: оно описывает, как этот + материал вообще ложится в проект, и одинаково для всех его кусков. +} +unit uTransform; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils; + +type + { Как соотносятся кадр исходника и кадр проекта. } + TFitMode = ( + fmFit, // вписать целиком, по краям поля + fmFill, // заполнить кадр, лишнее обрезать + fmStretch // растянуть, пропорции исказятся + ); + + TMediaTransform = record + Fit: TFitMode; + { Поворот по часовой стрелке: 0, 90, 180 или 270. } + Rotation: Integer; + FlipH: Boolean; + FlipV: Boolean; + { Дополнительное увеличение поверх выбранного режима. Единица — + без увеличения. } + Zoom: Double; + { Смещение кадра в долях от размера кадра проекта. Ноль — по центру. } + OffsetX: Double; + OffsetY: Double; + end; + +function DefaultTransform: TMediaTransform; + +{ Нужно ли вообще что-то делать: совпадающий по размеру кадр без поворота + и смещений трогать незачем. } +function TransformIsIdentity(const AT: TMediaTransform; + ASrcWidth, ASrcHeight, ADstWidth, ADstHeight: Integer): Boolean; + +{ Цепочка фильтров ffmpeg. Пустая строка означает «ничего делать не надо». } +function TransformFilter(const AT: TMediaTransform; + ASrcWidth, ASrcHeight, ADstWidth, ADstHeight: Integer): string; + +{ Цепочка для предпросмотра: вписать любой кадр в кадр проекта. + + От TransformFilter отличается двумя вещами. Во-первых, размеры исходника + здесь неизвестны — цепочка одна на весь предпросмотр, а куски в нём из + разных файлов, поэтому вместо посчитанных чисел идут выражения самого + ffmpeg. Во-вторых, она знает только вписывание целиком: заполнение с + обрезкой, поворот и смещение задаются для каждого файла отдельно, а + фильтр общий, и выбрать между ними он не может. + + Отсюда честное ограничение: предпросмотр показывает кадр проекта верно, + но собственную настройку кадрирования файла не учитывает. Её видно в + окне кадрирования и в готовом ролике. } +function PreviewFitFilter(ADstWidth, ADstHeight: Integer): string; + +function FitModeToStr(AMode: TFitMode): string; +function StrToFitMode(const AValue: string): TFitMode; +function FitModeCaption(AMode: TFitMode): string; + +implementation + +uses + Math, uAppTypes; + +function DefaultTransform: TMediaTransform; +begin + Result.Fit := fmFit; + Result.Rotation := 0; + Result.FlipH := False; + Result.FlipV := False; + Result.Zoom := 1; + Result.OffsetX := 0; + Result.OffsetY := 0; +end; + +function FitModeToStr(AMode: TFitMode): string; +begin + case AMode of + fmFill: Result := 'fill'; + fmStretch: Result := 'stretch'; + else + Result := 'fit'; + end; +end; + +function StrToFitMode(const AValue: string): TFitMode; +begin + if AValue = 'fill' then + Result := fmFill + else if AValue = 'stretch' then + Result := fmStretch + else + Result := fmFit; +end; + +function FitModeCaption(AMode: TFitMode): string; +begin + case AMode of + fmFill: Result := 'Заполнить кадр (лишнее обрезается)'; + fmStretch: Result := 'Растянуть (пропорции исказятся)'; + else + Result := 'Вписать целиком (по краям поля)'; + end; +end; + +function TransformIsIdentity(const AT: TMediaTransform; + ASrcWidth, ASrcHeight, ADstWidth, ADstHeight: Integer): Boolean; +begin + Result := (AT.Rotation mod 360 = 0) and (not AT.FlipH) and (not AT.FlipV) and + (Abs(AT.Zoom - 1) < 0.001) and (Abs(AT.OffsetX) < 0.001) and + (Abs(AT.OffsetY) < 0.001) and + (ASrcWidth = ADstWidth) and (ASrcHeight = ADstHeight); +end; + +function PreviewFitFilter(ADstWidth, ADstHeight: Integer): string; +var + W, H: string; +begin + Result := ''; + if (ADstWidth < 2) or (ADstHeight < 2) then + Exit; + W := IntToStr(ADstWidth); + H := IntToStr(ADstHeight); + + { force_original_aspect_ratio=decrease вписывает кадр целиком, не искажая + пропорции; pad добавляет поля до размера проекта; setsar=1 убирает + неквадратный пиксель, иначе mpv растянет уже готовый кадр обратно. } + Result := + 'scale=' + W + ':' + H + ':force_original_aspect_ratio=decrease,' + + 'pad=' + W + ':' + H + ':(ow-iw)/2:(oh-ih)/2,' + + 'setsar=1'; +end; + +{ Кодировщики требуют чётных сторон: цветность в yuv420p хранится вдвое + прореженной, и нечётный размер ей некуда деть. } +function MakeEven(AValue: Integer): Integer; +begin + Result := AValue; + if Odd(Result) then + Inc(Result); + if Result < 2 then + Result := 2; +end; + +function TransformFilter(const AT: TMediaTransform; + ASrcWidth, ASrcHeight, ADstWidth, ADstHeight: Integer): string; +var + Chain: string; + W0, H0, Tmp: Integer; + K, KFit, KFill: Double; + SW, SH: Integer; + CW, CH, CX, CY: Integer; + PX, PY: Integer; + Rot: Integer; + + procedure Add(const AFilter: string); + begin + if Chain <> '' then + Chain := Chain + ','; + Chain := Chain + AFilter; + end; + +begin + Result := ''; + if (ASrcWidth <= 0) or (ASrcHeight <= 0) or + (ADstWidth <= 0) or (ADstHeight <= 0) then + Exit; + + Chain := ''; + W0 := ASrcWidth; + H0 := ASrcHeight; + + { --- Поворот и отражение --- } + Rot := ((AT.Rotation mod 360) + 360) mod 360; + case Rot of + 90: + begin + { transpose=1 — поворот на 90 по часовой стрелке. } + Add('transpose=1'); + Tmp := W0; W0 := H0; H0 := Tmp; + end; + 180: + { Два поворота подряд дешевле и точнее, чем поворот на произвольный + угол: последний пересчитывает каждый пиксель. } + Add('transpose=1,transpose=1'); + 270: + begin + Add('transpose=2'); + Tmp := W0; W0 := H0; H0 := Tmp; + end; + end; + if AT.FlipH then + Add('hflip'); + if AT.FlipV then + Add('vflip'); + + { --- Масштаб --- } + if AT.Fit = fmStretch then + begin + SW := MakeEven(ADstWidth); + SH := MakeEven(ADstHeight); + end + else + begin + KFit := Min(ADstWidth / W0, ADstHeight / H0); + KFill := Max(ADstWidth / W0, ADstHeight / H0); + if AT.Fit = fmFill then + K := KFill + else + K := KFit; + if AT.Zoom > 0 then + K := K * AT.Zoom; + SW := MakeEven(Round(W0 * K)); + SH := MakeEven(Round(H0 * K)); + end; + Add(Format('scale=%d:%d', [SW, SH])); + + { --- Обрезка того, что вылезло за кадр --- } + CW := Min(SW, MakeEven(ADstWidth)); + CH := Min(SH, MakeEven(ADstHeight)); + if (CW < SW) or (CH < SH) then + begin + { Смещение задаётся в долях кадра проекта и прижимается к границам: + выйти за пределы картинки нельзя, ffmpeg на это ругается. } + CX := Round((SW - CW) / 2 + AT.OffsetX * ADstWidth); + CY := Round((SH - CH) / 2 + AT.OffsetY * ADstHeight); + CX := Max(0, Min(SW - CW, CX)); + CY := Max(0, Min(SH - CH, CY)); + Add(Format('crop=%d:%d:%d:%d', [CW, CH, CX, CY])); + end; + + { --- Поля, если картинка меньше кадра --- } + if (CW < ADstWidth) or (CH < ADstHeight) then + begin + PX := Round((ADstWidth - CW) / 2 + AT.OffsetX * ADstWidth); + PY := Round((ADstHeight - CH) / 2 + AT.OffsetY * ADstHeight); + PX := Max(0, Min(ADstWidth - CW, PX)); + PY := Max(0, Min(ADstHeight - CH, PY)); + Add(Format('pad=%d:%d:%d:%d', [ADstWidth, ADstHeight, PX, PY])); + end; + + { Пиксель считаем квадратным: иначе плеер растянет кадр по своему + разумению, и результат разойдётся с тем, что видно в предпросмотре. } + Add('setsar=1'); + Result := Chain; +end; + +end. diff --git a/tests/build.sh b/tests/build.sh new file mode 100755 index 0000000..b32b174 --- /dev/null +++ b/tests/build.sh @@ -0,0 +1,24 @@ +#!/bin/sh +# Сборка консольного инструмента проверок. +# +# Отдельно от основного проекта: nlvetool не тянет LCL и его виджеты, +# ему нужны только модули логики и LazUtils ради поиска ffmpeg в PATH. + +set -e + +FPC=/home/chaiman/fpcupdeluxe/fpc/bin/x86_64-linux/fpc.sh +LAZ=/home/chaiman/fpcupdeluxe/lazarus +HERE=$(cd "$(dirname "$0")" && pwd) +ROOT=$(dirname "$HERE") + +mkdir -p "$HERE/lib" + +"$FPC" \ + -FU"$HERE/lib" \ + -Fu"$ROOT/src" \ + -Fu"$LAZ/components/lazutils/lib/x86_64-linux" \ + -Fi"$LAZ/components/lazutils" \ + -o"$HERE/nlvetool" \ + "$HERE/nlvetool.lpr" + +echo "готово: $HERE/nlvetool" diff --git a/tests/nlvetool.lpr b/tests/nlvetool.lpr new file mode 100644 index 0000000..28d0f5e --- /dev/null +++ b/tests/nlvetool.lpr @@ -0,0 +1,1001 @@ +{ + nlvetool — консольный инструмент для проверки внутренностей nlve без + запуска интерфейса. + + Нужен потому, что часть вещей проверяется числами, а не глазами: + совпал ли индекс опорных кадров с тем, что выдаёт ffprobe, сколько + времени это заняло, правильно ли собирается строка EDL. + + Команды: + kf <файл> индекс опорных кадров: способ, количество, время + kfcheck <файл> то же, но со сверкой быстрого пути с ffprobe + edl <файл> <старт> <длина> [<старт> <длина> ...] + собрать и напечатать строку edl:// + export [--cancel-after=<сек>] <файл> <выход> <старт> <длина> [...] + собрать ролик из кусков и сверить число кадров; + с --cancel-after проверяется остановка на полпути + remux <файл> [<файл> ...] <расширение> + перепаковать файлы в другой контейнер + flattest проверить уплощение монтажа на наборе случаев + build <проект.nlve> <видео> [<картинка>] + собрать проект-образец: видео внизу, картинка + сверху посередине, дыра в начале + render <проект.nlve> <выход> + уплотить проект, создать вставки, собрать ролик + и сверить число кадров + buildcut <проект.nlve> <видео> + проект из одного файла с точным резом в заведомо + неопорной точке +} +program nlvetool; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX} + cthreads, + {$ENDIF} + Classes, SysUtils, DateUtils, Math, StrUtils, + uAppTypes, uEdl, uKeyframeIndex, uFfmpegCmd, uExport, uRemuxQueue, + uMediaProbe, uProject, uFlatten, uGenerate; + +procedure PrintUsage; +begin + WriteLn('Использование:'); + WriteLn(' nlvetool kf <файл>'); + WriteLn(' nlvetool kfcheck <файл>'); + WriteLn(' nlvetool edl <файл> <старт> <длина> [<старт> <длина> ...]'); + WriteLn(' nlvetool export <файл> <выход> <старт> <длина> [<старт> <длина> ...]'); +end; + +{ Разбирает пары «старт длина» начиная с указанного номера аргумента. } +function ParseSegments(const APath: string; AFirstArg: Integer; + out ASegments: TFlatSegmentArray): Boolean; +var + I, N: Integer; + StartVal, LenVal: Double; +begin + ASegments := nil; + N := (ParamCount - AFirstArg + 1) div 2; + if N < 1 then + Exit(False); + + SetLength(ASegments, N); + for I := 0 to N - 1 do + begin + if not TryStrToFloat(ParamStr(AFirstArg + I * 2), StartVal, InvariantFormat) or + not TryStrToFloat(ParamStr(AFirstArg + 1 + I * 2), LenVal, InvariantFormat) then + begin + WriteLn('Не удалось разобрать числа сегмента ', I + 1); + Exit(False); + end; + ASegments[I].FilePath := APath; + ASegments[I].SrcStart := StartVal; + ASegments[I].Duration := LenVal; + ASegments[I].Kind := skVideo; + end; + Result := True; +end; + +function SourceName(ASource: TKeyframeSource): string; +begin + case ASource of + kfMp4Header: Result := 'разбор заголовка MP4'; + kfFfprobe: Result := 'опрос ffprobe'; + kfAllFrames: Result := 'каждый кадр опорный'; + else + Result := 'нет'; + end; +end; + +procedure ShowIndex(const AIndex: TKeyframeIndex; const AElapsedMs: Int64); +var + I, N: Integer; + Line: string; + MinGap, MaxGap, Gap: Double; +begin + WriteLn(' способ: ', SourceName(AIndex.Source)); + WriteLn(' время: ', AElapsedMs, ' мс'); + + if AIndex.AllFrames then + begin + WriteLn(' опорных: все кадры, резать можно где угодно'); + Exit; + end; + + N := Length(AIndex.Times); + WriteLn(' опорных: ', N); + if N = 0 then + Exit; + + Line := ''; + for I := 0 to Min(5, N - 1) do + Line := Line + SecondsToStr(AIndex.Times[I]) + ' '; + WriteLn(' первые: ', Trim(Line)); + WriteLn(' последний: ', SecondsToStr(AIndex.Times[N - 1])); + + if N > 1 then + begin + MinGap := AIndex.Times[1] - AIndex.Times[0]; + MaxGap := MinGap; + for I := 2 to N - 1 do + begin + Gap := AIndex.Times[I] - AIndex.Times[I - 1]; + if Gap < MinGap then + MinGap := Gap; + if Gap > MaxGap then + MaxGap := Gap; + end; + WriteLn(' интервал: от ', SecondsToStr(MinGap), ' до ', SecondsToStr(MaxGap), ' с'); + end; +end; + +procedure CmdKf(const APath: string; AFastOnly: Boolean); +var + Index: TKeyframeIndex; + Error: string; + Started: TDateTime; + Elapsed: Int64; + Ok: Boolean; +begin + Started := Now; + if AFastOnly then + Ok := ReadMp4KeyframeIndex(APath, Index, Error) + else + Ok := BuildKeyframeIndex(APath, Index, Error); + Elapsed := MilliSecondsBetween(Now, Started); + + if not Ok then + begin + WriteLn('ОШИБКА: ', Error); + Halt(1); + end; + ShowIndex(Index, Elapsed); +end; + +{ Сверяет быстрый путь с медленным: значения должны совпасть, иначе + разбору заголовка верить нельзя. } +procedure CmdKfCheck(const APath: string); +var + Fast, Slow: TKeyframeIndex; + Error: string; + Started: TDateTime; + FastMs, SlowMs: Int64; + I, N: Integer; + Diff, MaxDiff: Double; +begin + WriteLn('Быстрый путь (заголовок MP4):'); + Started := Now; + if not ReadMp4KeyframeIndex(APath, Fast, Error) then + begin + WriteLn(' недоступен: ', Error); + Halt(1); + end; + FastMs := MilliSecondsBetween(Now, Started); + ShowIndex(Fast, FastMs); + + WriteLn; + WriteLn('Медленный путь (ffprobe):'); + Started := Now; + if not BuildKeyframeIndexViaProbe(APath, Slow, Error) then + begin + WriteLn(' ОШИБКА: ', Error); + Halt(1); + end; + SlowMs := MilliSecondsBetween(Now, Started); + ShowIndex(Slow, SlowMs); + + WriteLn; + WriteLn('Сверка:'); + if Length(Fast.Times) <> Length(Slow.Times) then + begin + WriteLn(' РАСХОЖДЕНИЕ: количество ', Length(Fast.Times), ' против ', + Length(Slow.Times)); + Halt(1); + end; + + N := Length(Fast.Times); + MaxDiff := 0; + for I := 0 to N - 1 do + begin + Diff := Abs(Fast.Times[I] - Slow.Times[I]); + if Diff > MaxDiff then + MaxDiff := Diff; + end; + WriteLn(' количество совпало: ', N); + WriteLn(' наибольшее расхождение меток: ', SecondsToStr(MaxDiff), ' с'); + if FastMs > 0 then + WriteLn(' быстрее в ', (SlowMs div Max(FastMs, 1)), ' раз') + else + WriteLn(' быстрый путь занял меньше миллисекунды'); + + if MaxDiff > 0.001 then + begin + WriteLn(' ВЕРДИКТ: расхождение слишком велико'); + Halt(1); + end; + WriteLn(' ВЕРДИКТ: совпадает'); +end; + +procedure CmdEdl; +var + Segments: TFlatSegmentArray; +begin + if not ParseSegments(ParamStr(2), 3, Segments) then + begin + PrintUsage; + Halt(2); + end; + + WriteLn('сегментов: ', Length(Segments)); + WriteLn('длительность: ', SecondsToStr(TotalDuration(Segments)), ' с'); + WriteLn(BuildEdlUri(Segments)); +end; + +{ Приёмник событий экспорта. Отдельный класс нужен потому, что поток + отдаёт состояние через обработчики-методы. } +type + TExportWatcher = class + private + FThread: TExportThread; + FLastStage: string; + public + constructor Create(AThread: TExportThread); + procedure Progress(Sender: TObject); + procedure LogLine(Sender: TObject); + end; + +constructor TExportWatcher.Create(AThread: TExportThread); +begin + inherited Create; + FThread := AThread; +end; + +procedure TExportWatcher.Progress(Sender: TObject); +begin + { Печатаем только смену этапа: строка на каждый процент забила бы вывод. } + if FThread.StageText <> FLastStage then + begin + FLastStage := FThread.StageText; + WriteLn('[этап] ', FLastStage); + end; +end; + +procedure TExportWatcher.LogLine(Sender: TObject); +begin + WriteLn(' ', FThread.PendingLog); +end; + +procedure CmdExport; +var + Segments: TFlatSegmentArray; + Thread: TExportThread; + Watcher: TExportWatcher; + Rep: TExportReport; + I, FirstArg: Integer; + Shift, CancelAfter, Waited: Double; + ExitCodeValue: Integer; + Cancelled: Boolean; +begin + { Необязательный флаг остановки идёт первым, чтобы не мешать разбору + пар «старт длина», которых может быть сколько угодно. } + CancelAfter := 0; + FirstArg := 4; + if Copy(ParamStr(2), 1, 15) = '--cancel-after=' then + begin + if not TryStrToFloat(Copy(ParamStr(2), 16, MaxInt), CancelAfter, + InvariantFormat) then + begin + WriteLn('Не удалось разобрать значение --cancel-after'); + Halt(2); + end; + FirstArg := 5; + end; + + if not ParseSegments(ParamStr(FirstArg - 2), FirstArg, Segments) then + begin + PrintUsage; + Halt(2); + end; + + WriteLn('исходник: ', ParamStr(FirstArg - 2)); + WriteLn('выход: ', ParamStr(FirstArg - 1)); + WriteLn('сегментов: ', Length(Segments)); + WriteLn('длительность: ', SecondsToStr(TotalDuration(Segments)), ' с'); + if CancelAfter > 0 then + WriteLn('остановка через: ', SecondsToStr(CancelAfter), ' с'); + WriteLn; + + Thread := TExportThread.Create(Segments, ParamStr(FirstArg - 1), True, + Default(TMediaInfo)); + Watcher := TExportWatcher.Create(Thread); + try + Thread.OnProgress := @Watcher.Progress; + Thread.OnLog := @Watcher.LogLine; + Thread.Start; + + { Поток общается через Synchronize, а в консольной программе цикла + сообщений нет. Значит, разбирать очередь обязан главный поток сам. } + Waited := 0; + Cancelled := False; + while not Thread.Finished do + begin + CheckSynchronize(100); + Waited := Waited + 0.1; + if (CancelAfter > 0) and (not Cancelled) and (Waited >= CancelAfter) then + begin + Cancelled := True; + WriteLn('[тест] запрашиваю остановку'); + Thread.RequestCancel; + end; + end; + CheckSynchronize(0); + + Rep := Thread.Report; + finally + Watcher.Free; + Thread.Free; + end; + + if CancelAfter > 0 then + begin + WriteLn; + WriteLn('--- Проверка остановки ---'); + WriteLn(' отмечено как отменённое: ', Rep.Cancelled); + WriteLn(' сообщение: ', Rep.Message); + if Rep.Cancelled and (not Rep.Succeeded) then + begin + WriteLn(' ВЕРДИКТ: остановка отработала'); + Halt(0); + end; + WriteLn(' ВЕРДИКТ: остановка НЕ отработала'); + Halt(1); + end; + + WriteLn; + WriteLn('--- Отчёт ---'); + for I := 0 to High(Rep.Segments) do + begin + Shift := Rep.Segments[I].ActualStart - Rep.Segments[I].RequestedStart; + WriteLn(Format(' кусок %d: старт %s (просили %s, сдвиг %s), длина %s, пакетов %d', + [I + 1, + SecondsToStr(Rep.Segments[I].ActualStart), + SecondsToStr(Rep.Segments[I].RequestedStart), + SecondsToStr(Shift), + SecondsToStr(Rep.Segments[I].Duration), + Rep.Segments[I].Packets])); + end; + + WriteLn(' сумма пакетов кусков: ', Rep.ExpectedPackets); + WriteLn(' пакетов в готовом файле: ', Rep.ActualPackets); + WriteLn(' результат: ', Rep.Message); + + ExitCodeValue := 0; + if not Rep.Succeeded then + ExitCodeValue := 1 + else if Rep.ExpectedPackets <> Rep.ActualPackets then + begin + WriteLn(' ВЕРДИКТ: РАСХОЖДЕНИЕ на ', + Rep.ActualPackets - Rep.ExpectedPackets, ' кадров'); + ExitCodeValue := 1; + end + else + WriteLn(' ВЕРДИКТ: склейка не потеряла и не продублировала ни одного кадра'); + + Halt(ExitCodeValue); +end; + +type + TRemuxWatcher = class + private + FThread: TRemuxThread; + FEntries: TRemuxEntries; + public + constructor Create(AThread: TRemuxThread; const AEntries: TRemuxEntries); + procedure LogLine(Sender: TObject); + procedure Item(Sender: TObject; AIndex: Integer; AState: TRemuxState; + const AMessage: string); + property Entries: TRemuxEntries read FEntries; + end; + +constructor TRemuxWatcher.Create(AThread: TRemuxThread; + const AEntries: TRemuxEntries); +begin + inherited Create; + FThread := AThread; + FEntries := Copy(AEntries); +end; + +procedure TRemuxWatcher.LogLine(Sender: TObject); +begin + WriteLn(' ', FThread.PendingLog); +end; + +procedure TRemuxWatcher.Item(Sender: TObject; AIndex: Integer; + AState: TRemuxState; const AMessage: string); +begin + if (AIndex < 0) or (AIndex > High(FEntries)) then + Exit; + FEntries[AIndex].State := AState; + FEntries[AIndex].Message := AMessage; + WriteLn('[', StateCaption(AState), '] ', FEntries[AIndex].Source, + ' -> ', FEntries[AIndex].Target, + IfThen(AMessage <> '', ' (' + AMessage + ')', '')); +end; + +procedure CmdRemux; +var + Entries: TRemuxEntries = nil; + Thread: TRemuxThread; + Watcher: TRemuxWatcher; + Ext: string; + I, N, Ok, Bad: Integer; +begin + { Последний аргумент — целевое расширение, всё до него — файлы. } + Ext := ParamStr(ParamCount); + if (Ext = '') or (Ext[1] <> '.') then + begin + WriteLn('Последним аргументом должно быть расширение, например .mp4'); + Halt(2); + end; + + N := ParamCount - 2; + SetLength(Entries, N); + for I := 0 to N - 1 do + begin + Entries[I].Source := ExpandFileName(ParamStr(2 + I)); + Entries[I].Target := SuggestTarget(Entries[I].Source, Ext); + Entries[I].Message := ''; + if FileExists(Entries[I].Source) then + Entries[I].State := rsPending + else + Entries[I].State := rsBadPath; + end; + + Thread := TRemuxThread.Create(Entries); + Watcher := TRemuxWatcher.Create(Thread, Entries); + try + Thread.OnLog := @Watcher.LogLine; + Thread.OnItem := @Watcher.Item; + Thread.Start; + while not Thread.Finished do + CheckSynchronize(100); + CheckSynchronize(0); + Entries := Watcher.Entries; + finally + Watcher.Free; + Thread.Free; + end; + + Ok := 0; + Bad := 0; + for I := 0 to High(Entries) do + if Entries[I].State = rsDone then + Inc(Ok) + else + Inc(Bad); + + WriteLn; + WriteLn('Успешно: ', Ok, ', с ошибками: ', Bad); + if Bad > 0 then + Halt(1); +end; + +{ --- Проверка уплощения монтажа --- } + +var + FailCount: Integer = 0; + +procedure Check(ACondition: Boolean; const AWhat: string); +begin + if ACondition then + WriteLn(' ok ', AWhat) + else + begin + WriteLn(' ПЛОХО ', AWhat); + Inc(FailCount); + end; +end; + +{ Проект с одним видеофайлом и нужным числом дорожек. Файл ненастоящий: + уплощение смотрит только на записанные параметры, а не на содержимое. } +function MakeProject(ATracks: Integer; out AMedia: TMediaItem): TProject; +var + Info: TMediaInfo; + I: Integer; +begin + Info := Default(TMediaInfo); + Info.Valid := True; + Info.Kind := mkVideo; + Info.Duration := 600; + Info.HasVideo := True; + Info.VideoCodec := 'hevc'; + Info.Width := 1920; + Info.Height := 1080; + Info.FpsNum := 30; + Info.FpsDen := 1; + Info.PixFmt := 'yuv420p'; + Info.HasAudio := True; + Info.AudioCodec := 'aac'; + Info.SampleRate := 48000; + Info.Channels := 2; + + Result := TProject.Create; + Result.Clear; + for I := 1 to ATracks do + Result.AddTrack('V' + IntToStr(I)); + AMedia := Result.AddMedia('/несуществующий/видео.mp4', Info); +end; + +procedure DumpSegments(const ASegments: TFlatSegmentArray); +var + I: Integer; + KindName: string; +begin + for I := 0 to High(ASegments) do + begin + case ASegments[I].Kind of + skBlack: KindName := 'чёрное'; + skImage: KindName := 'картинка'; + else + KindName := 'видео'; + end; + WriteLn(Format(' [%d] %s из %s длина %s', + [I, KindName, SecondsToStr(ASegments[I].SrcStart), + SecondsToStr(ASegments[I].Duration)])); + end; +end; + +procedure CmdFlatTest; +var + Proj: TProject; + Media: TMediaItem; + Segs: TFlatSegmentArray; + Missing: TGenRequests; + TempFile, Err: string; +begin + WriteLn('Проверка уплощения монтажа'); + WriteLn; + + { --- 1. Два подряд идущих куска одного файла склеиваются в один --- } + WriteLn(' 1. Два куска подряд из одного файла'); + Proj := MakeProject(1, Media); + try + Proj.AddClip(Proj.Tracks[0], Media, 10, 5, 0); + Proj.AddClip(Proj.Tracks[0], Media, 15, 5, 5); + FlattenProject(Proj, Segs, Missing); + DumpSegments(Segs); + Check(Length(Segs) = 1, 'склеились в один кусок'); + if Length(Segs) = 1 then + begin + Check(Abs(Segs[0].SrcStart - 10) < 0.001, 'начало на 10 с'); + Check(Abs(Segs[0].Duration - 10) < 0.001, 'длина 10 с'); + end; + finally + Proj.Free; + end; + WriteLn; + + { --- 2. Куски из разных мест файла не склеиваются --- } + WriteLn(' 2. Два куска из разных мест файла'); + Proj := MakeProject(1, Media); + try + Proj.AddClip(Proj.Tracks[0], Media, 100, 5, 0); + Proj.AddClip(Proj.Tracks[0], Media, 200, 5, 5); + FlattenProject(Proj, Segs, Missing); + DumpSegments(Segs); + Check(Length(Segs) = 2, 'остались двумя кусками'); + finally + Proj.Free; + end; + WriteLn; + + { --- 3. Верхний клип разрывает нижний надвое --- } + WriteLn(' 3. Верхний клип посреди нижнего'); + Proj := MakeProject(2, Media); + try + { Дорожка 0 — верхняя, она побеждает. } + Proj.AddClip(Proj.Tracks[1], Media, 0, 30, 0); + Proj.AddClip(Proj.Tracks[0], Media, 100, 10, 10); + FlattenProject(Proj, Segs, Missing); + DumpSegments(Segs); + Check(Length(Segs) = 3, 'получилось три куска'); + if Length(Segs) = 3 then + begin + Check(Abs(Segs[0].SrcStart - 0) < 0.001, 'первый — начало нижнего'); + Check(Abs(Segs[0].Duration - 10) < 0.001, 'первый длиной 10 с'); + Check(Abs(Segs[1].SrcStart - 100) < 0.001, 'второй — верхний клип'); + Check(Abs(Segs[1].Duration - 10) < 0.001, 'второй длиной 10 с'); + Check(Abs(Segs[2].SrcStart - 20) < 0.001, + 'третий продолжает нижний с 20 с, а не с начала'); + Check(Abs(Segs[2].Duration - 10) < 0.001, 'третий длиной 10 с'); + end; + finally + Proj.Free; + end; + WriteLn; + + { --- 4. Дыра в начале и в середине становится чёрным --- } + WriteLn(' 4. Дыры превращаются в чёрные вставки'); + Proj := MakeProject(1, Media); + try + Proj.AddClip(Proj.Tracks[0], Media, 0, 5, 3); + Proj.AddClip(Proj.Tracks[0], Media, 50, 5, 12); + FlattenProject(Proj, Segs, Missing); + DumpSegments(Segs); + Check(Length(Segs) = 4, 'четыре куска: чёрное, видео, чёрное, видео'); + if Length(Segs) = 4 then + begin + Check(Segs[0].Kind = skBlack, 'первый чёрный'); + Check(Abs(Segs[0].Duration - 3) < 0.001, 'первый длиной 3 с'); + Check(Segs[1].Kind = skVideo, 'второй видео'); + Check(Segs[2].Kind = skBlack, 'третий чёрный'); + Check(Abs(Segs[2].Duration - 4) < 0.001, 'третий длиной 4 с'); + Check(Segs[3].Kind = skVideo, 'четвёртый видео'); + end; + { Обе дыры разной длины берутся из одного файла-заготовки: вставки + делаются готовых длин, а нужный кусок из них вырезается. Раньше на + каждую длину заводился свой файл, и любое движение клипа требовало + новой генерации — из-за этого предпросмотр отставал от монтажа. } + Check(Length(Missing) = 1, 'обе дыры обслуживает одна заготовка'); + Check(Segs[0].FilePath = Segs[2].FilePath, + 'обе чёрные вставки ссылаются на один файл'); + finally + Proj.Free; + end; + WriteLn; + + { --- 5. Полностью перекрытый нижний клип не попадает в итог --- } + WriteLn(' 5. Нижний клип перекрыт целиком'); + Proj := MakeProject(2, Media); + try + Proj.AddClip(Proj.Tracks[1], Media, 0, 10, 0); + Proj.AddClip(Proj.Tracks[0], Media, 200, 10, 0); + FlattenProject(Proj, Segs, Missing); + DumpSegments(Segs); + Check(Length(Segs) = 1, 'остался один кусок'); + if Length(Segs) = 1 then + Check(Abs(Segs[0].SrcStart - 200) < 0.001, 'взят верхний клип'); + finally + Proj.Free; + end; + WriteLn; + + { --- 6. Выключенная дорожка не участвует --- } + WriteLn(' 6. Выключенная верхняя дорожка пропускается'); + Proj := MakeProject(2, Media); + try + Proj.AddClip(Proj.Tracks[1], Media, 0, 10, 0); + Proj.AddClip(Proj.Tracks[0], Media, 200, 10, 0); + Proj.Tracks[0].Muted := True; + FlattenProject(Proj, Segs, Missing); + DumpSegments(Segs); + Check(Length(Segs) = 1, 'остался один кусок'); + if Length(Segs) = 1 then + Check(Abs(Segs[0].SrcStart - 0) < 0.001, 'взят нижний клип'); + finally + Proj.Free; + end; + WriteLn; + + { --- 7. Сохранение и чтение проекта не меняют монтаж --- } + WriteLn(' 7. Проект переживает запись и чтение'); + TempFile := IncludeTrailingPathDelimiter(GetCurrentDir) + 'flattest.nlve'; + Proj := MakeProject(2, Media); + try + Proj.AddClip(Proj.Tracks[1], Media, 0, 30, 0); + Proj.AddClip(Proj.Tracks[0], Media, 100, 10, 10); + Proj.Tracks[0][0].EdgeIn := edPrecise; + Proj.RippleMode := rmAllTracks; + Proj.RippleEnabled := True; + FlattenProject(Proj, Segs, Missing); + Check(Length(Segs) = 3, 'до записи три куска'); + Check(Proj.SaveToFile(TempFile, Err), 'записан: ' + Err); + finally + Proj.Free; + end; + + Proj := TProject.Create; + try + Check(Proj.LoadFromFile(TempFile, Err), 'прочитан: ' + Err); + Check(Proj.TrackCount = 2, 'дорожек снова две'); + Check(Proj.PoolCount = 1, 'файл в списке один'); + Check(Proj.RippleMode = rmAllTracks, 'режим схлопывания сохранился'); + Check(Proj.RippleEnabled, 'состояние схлопывания сохранилось'); + if Proj.TrackCount = 2 then + Check(Proj.Tracks[0][0].EdgeIn = edPrecise, 'признак точного реза сохранился'); + FlattenProject(Proj, Segs, Missing); + DumpSegments(Segs); + Check(Length(Segs) = 3, 'после чтения снова три куска'); + if Length(Segs) = 3 then + Check(Abs(Segs[2].SrcStart - 20) < 0.001, 'третий кусок на том же месте'); + finally + Proj.Free; + end; + DeleteFile(TempFile); + WriteLn; + + WriteLn; + if FailCount = 0 then + begin + WriteLn('ВЕРДИКТ: все проверки пройдены'); + Halt(0); + end; + WriteLn('ВЕРДИКТ: не пройдено проверок: ', FailCount); + Halt(1); +end; + +{ --- Сборка проекта-образца и его отрисовка --- } + +procedure CmdBuild; +var + Proj: TProject; + Info: TMediaInfo; + Video, Image: TMediaItem; + Err: string; +begin + Proj := TProject.Create; + try + Proj.Clear; + Proj.AddTrack('V1'); + Proj.AddTrack('V2'); + + if not ProbeMedia(ExpandFileName(ParamStr(3)), Info, Err) then + begin + WriteLn('Не удалось прочитать видео: ', Err); + Halt(1); + end; + Video := Proj.AddMedia(ExpandFileName(ParamStr(3)), Info); + WriteLn('видео: ', DescribeMedia(Info)); + + { Нижняя дорожка: два куска видео из разных мест, между ними дыра + в две секунды, и ещё дыра в начале. } + Proj.AddClip(Proj.Tracks[1], Video, 100, 6, 1.5); + Proj.AddClip(Proj.Tracks[1], Video, 400, 6, 9.5); + + if ParamCount >= 4 then + begin + if not ProbeMedia(ExpandFileName(ParamStr(4)), Info, Err) then + begin + WriteLn('Не удалось прочитать картинку: ', Err); + Halt(1); + end; + Image := Proj.AddMedia(ExpandFileName(ParamStr(4)), Info); + WriteLn('картинка: ', DescribeMedia(Info)); + { Верхняя дорожка: картинка ровно посередине первого куска — + она должна разорвать его надвое. } + Proj.AddClip(Proj.Tracks[0], Image, 0, 3, 3.5); + end; + + if not Proj.SaveToFile(ExpandFileName(ParamStr(2)), Err) then + begin + WriteLn('Не удалось записать проект: ', Err); + Halt(1); + end; + WriteLn('проект записан: ', Proj.FileName); + WriteLn('длина монтажа: ', SecondsToStr(Proj.EndTime), ' с'); + finally + Proj.Free; + end; +end; + +procedure CmdBuildCut; +var + Proj: TProject; + Info: TMediaInfo; + Video: TMediaItem; + Err: string; + Clip: TClip; +begin + Proj := TProject.Create; + try + Proj.Clear; + Proj.AddTrack('V1'); + + if not ProbeMedia(ExpandFileName(ParamStr(3)), Info, Err) then + begin + WriteLn('Не удалось прочитать видео: ', Err); + Halt(1); + end; + Video := Proj.AddMedia(ExpandFileName(ParamStr(3)), Info); + WriteLn('видео: ', DescribeMedia(Info)); + + { Первый кусок с обычным резом, второй — с точным, причём начало + выбрано заведомо не на опорном кадре: у этого материала они идут + через 1.001 с, а 200.500 между ними. } + Proj.AddClip(Proj.Tracks[0], Video, 100.0, 5, 0); + Clip := Proj.AddClip(Proj.Tracks[0], Video, 200.5, 5, 5); + Clip.EdgeIn := edPrecise; + + if not Proj.SaveToFile(ExpandFileName(ParamStr(2)), Err) then + begin + WriteLn('Не удалось записать проект: ', Err); + Halt(1); + end; + WriteLn('проект записан: ', Proj.FileName); + WriteLn('второй кусок начинается точно с 200.500000 с'); + finally + Proj.Free; + end; +end; + +type + TGenWatcher = class + private + FThread: TGenerateThread; + FLast: string; + public + constructor Create(AThread: TGenerateThread); + procedure Progress(Sender: TObject); + procedure LogLine(Sender: TObject); + end; + +constructor TGenWatcher.Create(AThread: TGenerateThread); +begin + inherited Create; + FThread := AThread; +end; + +procedure TGenWatcher.Progress(Sender: TObject); +begin + if FThread.StageText <> FLast then + begin + FLast := FThread.StageText; + WriteLn('[этап] ', FLast); + end; +end; + +procedure TGenWatcher.LogLine(Sender: TObject); +begin + WriteLn(' ', FThread.PendingLog); +end; + +procedure CmdRender; +var + Proj: TProject; + Segs: TFlatSegmentArray; + Missing: TGenRequests; + Err: string; + Gen: TGenerateThread; + GenWatch: TGenWatcher; + Thread: TExportThread; + Watcher: TExportWatcher; + Rep: TExportReport; + I: Integer; + Ok: Boolean; +begin + Proj := TProject.Create; + try + if not Proj.LoadFromFile(ExpandFileName(ParamStr(2)), Err) then + begin + WriteLn('Не удалось прочитать проект: ', Err); + Halt(1); + end; + WriteLn('проект: ', Proj.FileName); + WriteLn('дорожек: ', Proj.TrackCount); + WriteLn('файлов: ', Proj.PoolCount); + WriteLn('длина: ', SecondsToStr(Proj.EndTime), ' с'); + WriteLn; + + if not FlattenProject(Proj, Segs, Missing) then + begin + WriteLn('Уплотить нечего.'); + Halt(1); + end; + + WriteLn('кусков после уплощения: ', Length(Segs)); + DumpSegments(Segs); + WriteLn('надо создать вставок: ', Length(Missing)); + WriteLn; + + if Length(Missing) > 0 then + begin + Gen := TGenerateThread.Create(Missing, Proj.Master); + GenWatch := TGenWatcher.Create(Gen); + try + Gen.OnProgress := @GenWatch.Progress; + Gen.OnLog := @GenWatch.LogLine; + Gen.Start; + while not Gen.Finished do + CheckSynchronize(100); + CheckSynchronize(0); + Ok := Gen.Succeeded; + Err := Gen.Message; + finally + GenWatch.Free; + Gen.Free; + end; + if not Ok then + begin + WriteLn('Не удалось создать вставки: ', Err); + Halt(1); + end; + WriteLn('вставки созданы.'); + WriteLn; + + { После создания уплощаем заново: теперь все файлы на месте. } + FlattenProject(Proj, Segs, Missing); + if Length(Missing) > 0 then + begin + WriteLn('Часть вставок так и не появилась.'); + Halt(1); + end; + end; + + Thread := TExportThread.Create(Segs, ExpandFileName(ParamStr(3)), True, + Proj.Master); + Watcher := TExportWatcher.Create(Thread); + try + Thread.OnProgress := @Watcher.Progress; + Thread.OnLog := @Watcher.LogLine; + Thread.Start; + while not Thread.Finished do + CheckSynchronize(100); + CheckSynchronize(0); + Rep := Thread.Report; + finally + Watcher.Free; + Thread.Free; + end; + finally + Proj.Free; + end; + + WriteLn; + WriteLn('--- Отчёт ---'); + for I := 0 to High(Rep.Segments) do + WriteLn(Format(' часть %d (из куска %d)%s: старт %s, длина %s, пакетов %d', + [I + 1, Rep.Segments[I].Index + 1, + IfThen(Rep.Segments[I].Encoded, ' ПЕРЕКОДИРОВАНА', ''), + SecondsToStr(Rep.Segments[I].ActualStart), + SecondsToStr(Rep.Segments[I].Duration), Rep.Segments[I].Packets])); + WriteLn(' сумма пакетов кусков: ', Rep.ExpectedPackets); + WriteLn(' пакетов в готовом файле: ', Rep.ActualPackets); + WriteLn(' результат: ', Rep.Message); + + if not Rep.Succeeded then + Halt(1); + if Rep.ExpectedPackets <> Rep.ActualPackets then + begin + WriteLn(' ВЕРДИКТ: РАСХОЖДЕНИЕ на ', + Rep.ActualPackets - Rep.ExpectedPackets, ' кадров'); + Halt(1); + end; + WriteLn(' ВЕРДИКТ: склейка не потеряла и не продублировала ни одного кадра'); +end; + +var + Cmd: string; +begin + if ParamCount < 1 then + begin + PrintUsage; + Halt(2); + end; + + Cmd := LowerCase(ParamStr(1)); + + if (Cmd = 'kf') and (ParamCount >= 2) then + CmdKf(ParamStr(2), False) + else if (Cmd = 'kfcheck') and (ParamCount >= 2) then + CmdKfCheck(ParamStr(2)) + else if (Cmd = 'edl') and (ParamCount >= 4) then + CmdEdl + else if (Cmd = 'export') and (ParamCount >= 5) then + CmdExport + else if (Cmd = 'remux') and (ParamCount >= 3) then + CmdRemux + else if Cmd = 'flattest' then + CmdFlatTest + else if (Cmd = 'build') and (ParamCount >= 3) then + CmdBuild + else if (Cmd = 'buildcut') and (ParamCount >= 3) then + CmdBuildCut + else if (Cmd = 'render') and (ParamCount >= 3) then + CmdRender + else + begin + PrintUsage; + Halt(2); + end; +end. diff --git a/vendor/mpv-headers/client.h b/vendor/mpv-headers/client.h new file mode 100644 index 0000000..0a548a5 --- /dev/null +++ b/vendor/mpv-headers/client.h @@ -0,0 +1,2032 @@ +/* Copyright (C) 2017 the mpv developers + * + * Permission to use, copy, modify, and/or distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + */ + +/* + * Note: the client API is licensed under ISC (see above) to enable + * other wrappers outside of mpv. But keep in mind that the + * mpv core is by default still GPLv2+ - unless built with + * -Dgpl=false, which makes it LGPLv2+. + */ + +#ifndef MPV_CLIENT_API_H_ +#define MPV_CLIENT_API_H_ + +#include <stddef.h> +#include <stdint.h> + +#ifdef _WIN32 +#define MPV_EXPORT __declspec(dllexport) +#define MPV_SELECTANY __declspec(selectany) +#elif defined(__GNUC__) || defined(__clang__) +#define MPV_EXPORT __attribute__((visibility("default"))) +#define MPV_SELECTANY +#else +#define MPV_EXPORT +#define MPV_SELECTANY +#endif + +#ifdef __cpp_decltype +#define MPV_DECLTYPE decltype +#else +#define MPV_DECLTYPE __typeof__ +#endif + +#ifdef __cplusplus +extern "C" { +#endif + +/** + * Mechanisms provided by this API + * ------------------------------- + * + * This API provides general control over mpv playback. It does not give you + * direct access to individual components of the player, only the whole thing. + * It's somewhat equivalent to MPlayer's slave mode. You can send commands, + * retrieve or set playback status or settings with properties, and receive + * events. + * + * The API can be used in two ways: + * 1) Internally in mpv, to provide additional features to the command line + * player. Lua scripting uses this. (Currently there is no plugin API to + * get a client API handle in external user code. It has to be a fixed + * part of the player at compilation time.) + * 2) Using mpv as a library with mpv_create(). This basically allows embedding + * mpv in other applications. + * + * Documentation + * ------------- + * + * The libmpv C API is documented directly in this header. Note that most + * actual interaction with this player is done through + * options/commands/properties, which can be accessed through this API. + * Essentially everything is done with them, including loading a file, + * retrieving playback progress, and so on. + * + * These are documented elsewhere: + * * http://mpv.io/manual/master/#options + * * http://mpv.io/manual/master/#list-of-input-commands + * * http://mpv.io/manual/master/#properties + * + * You can also look at the examples here: + * * https://github.com/mpv-player/mpv-examples/tree/master/libmpv + * + * Event loop + * ---------- + * + * In general, the API user should run an event loop in order to receive events. + * This event loop should call mpv_wait_event(), which will return once a new + * mpv client API is available. It is also possible to integrate client API + * usage in other event loops (e.g. GUI toolkits) with the + * mpv_set_wakeup_callback() function, and then polling for events by calling + * mpv_wait_event() with a 0 timeout. + * + * Note that the event loop is detached from the actual player. Not calling + * mpv_wait_event() will not stop playback. It will eventually congest the + * event queue of your API handle, though. + * + * Synchronous vs. asynchronous calls + * ---------------------------------- + * + * The API allows both synchronous and asynchronous calls. Synchronous calls + * have to wait until the playback core is ready, which currently can take + * an unbounded time (e.g. if network is slow or unresponsive). Asynchronous + * calls just queue operations as requests, and return the result of the + * operation as events. + * + * Asynchronous calls + * ------------------ + * + * The client API includes asynchronous functions. These allow you to send + * requests instantly, and get replies as events at a later point. The + * requests are made with functions carrying the _async suffix, and replies + * are returned by mpv_wait_event() (interleaved with the normal event stream). + * + * A 64 bit userdata value is used to allow the user to associate requests + * with replies. The value is passed as reply_userdata parameter to the request + * function. The reply to the request will have the reply + * mpv_event->reply_userdata field set to the same value as the + * reply_userdata parameter of the corresponding request. + * + * This userdata value is arbitrary and is never interpreted by the API. Note + * that the userdata value 0 is also allowed, but then the client must be + * careful not accidentally interpret the mpv_event->reply_userdata if an + * event is not a reply. (For non-replies, this field is set to 0.) + * + * Asynchronous calls may be reordered in arbitrarily with other synchronous + * and asynchronous calls. If you want a guaranteed order, you need to wait + * until asynchronous calls report completion before doing the next call. + * + * See also the section "Asynchronous command details" in the manpage. + * + * Multithreading + * -------------- + * + * The client API is generally fully thread-safe, unless otherwise noted. + * Currently, there is no real advantage in using more than 1 thread to access + * the client API, since everything is serialized through a single lock in the + * playback core. + * + * Basic environment requirements + * ------------------------------ + * + * This documents basic requirements on the C environment. This is especially + * important if mpv is used as library with mpv_create(). + * + * - The LC_NUMERIC locale category must be set to "C". If your program calls + * setlocale(), be sure not to use LC_ALL, or if you do, reset LC_NUMERIC + * to its sane default: setlocale(LC_NUMERIC, "C"). + * - If a X11 based VO is used, mpv will set the xlib error handler. This error + * handler is process-wide, and there's no proper way to share it with other + * xlib users within the same process. This might confuse GUI toolkits. + * - mpv uses some other libraries that are not library-safe, such as Fribidi + * (used through libass), ALSA, FFmpeg, and possibly more. + * - The FPU precision must be set at least to double precision. + * - On Windows, mpv will call timeBeginPeriod(1). + * - On memory exhaustion, mpv will kill the process. + * - In certain cases, mpv may start sub processes (such as with the ytdl + * wrapper script). + * - Using UNIX IPC (off by default) will override the SIGPIPE signal handler, + * and set it to SIG_IGN. Some invocations of the "subprocess" command will + * also do that. + * - mpv may start sub processes, so overriding SIGCHLD, or waiting on all PIDs + * (such as calling wait()) by the parent process or any other library within + * the process must be avoided. libmpv itself only waits for its own PIDs. + * - If anything in the process registers signal handlers, they must set the + * SA_RESTART flag. Otherwise you WILL get random failures on signals. + * + * Encoding of filenames + * --------------------- + * + * mpv uses UTF-8 everywhere. + * + * On some platforms (like Linux), filenames actually do not have to be UTF-8; + * for this reason libmpv supports non-UTF-8 strings. libmpv uses what the + * kernel uses and does not recode filenames. At least on Linux, passing a + * string to libmpv is like passing a string to the fopen() function. + * + * On Windows, filenames are always UTF-8, libmpv converts between UTF-8 and + * UTF-16 when using win32 API functions. libmpv never uses or accepts + * filenames in the local 8 bit encoding. It does not use fopen() either; + * it uses _wfopen(). + * + * On OS X, filenames and other strings taken/returned by libmpv can have + * inconsistent unicode normalization. This can sometimes lead to problems. + * You have to hope for the best. + * + * Also see the remarks for MPV_FORMAT_STRING. + * + * Embedding the video window + * -------------------------- + * + * Using the render API (in render.h) is recommended. This API requires + * you to create and maintain an OpenGL context, to which you can render + * video using a specific API call. This API does not include keyboard or mouse + * input directly. + * + * There is an older way to embed the native mpv window into your own. You have + * to get the raw window handle, and set it as "wid" option. This works on X11, + * win32, and OSX only. It's much easier to use than the render API, but + * also has various problems. + * + * Also see client API examples and the mpv manpage. There is an extensive + * discussion here: + * https://github.com/mpv-player/mpv-examples/tree/master/libmpv#methods-of-embedding-the-video-window + * + * Compatibility + * ------------- + * + * mpv development doesn't stand still, and changes to mpv internals as well as + * to its interface can cause compatibility issues to client API users. + * + * The API is versioned (see MPV_CLIENT_API_VERSION), and changes to it are + * documented in DOCS/client-api-changes.rst. The C API itself will probably + * remain compatible for a long time, but the functionality exposed by it + * could change more rapidly. For example, it's possible that options are + * renamed, or change the set of allowed values. + * + * Defensive programming should be used to potentially deal with the fact that + * options, commands, and properties could disappear, change their value range, + * or change the underlying datatypes. It might be a good idea to prefer + * MPV_FORMAT_STRING over other types to decouple your code from potential + * mpv changes. + * + * Also see: DOCS/compatibility.rst + * + * Future changes + * -------------- + * + * This are the planned changes that will most likely be done on the next major + * bump of the library: + * + * - remove all symbols that are marked as deprecated + * - reassign enum numerical values to remove gaps + * - disabling all events by default + */ + +/** + * The version is incremented on each API change. The 16 lower bits form the + * minor version number, and the 16 higher bits the major version number. If + * the API becomes incompatible to previous versions, the major version + * number is incremented. This affects only C part, and not properties and + * options. + * + * Every API bump is described in DOCS/client-api-changes.rst + * + * You can use MPV_MAKE_VERSION() and compare the result with integer + * relational operators (<, >, <=, >=). + */ +#define MPV_MAKE_VERSION(major, minor) (((major) << 16) | (minor) | 0UL) +#define MPV_CLIENT_API_VERSION MPV_MAKE_VERSION(2, 2) + +/** + * The API user is allowed to "#define MPV_ENABLE_DEPRECATED 0" before + * including any libmpv headers. Then deprecated symbols will be excluded + * from the headers. (Of course, deprecated properties and commands and + * other functionality will still work.) + */ +#ifndef MPV_ENABLE_DEPRECATED +#define MPV_ENABLE_DEPRECATED 1 +#endif + +/** + * Return the MPV_CLIENT_API_VERSION the mpv source has been compiled with. + */ +MPV_EXPORT unsigned long mpv_client_api_version(void); + +/** + * Client context used by the client API. Every client has its own private + * handle. + */ +typedef struct mpv_handle mpv_handle; + +/** + * List of error codes than can be returned by API functions. 0 and positive + * return values always mean success, negative values are always errors. + */ +typedef enum mpv_error { + /** + * No error happened (used to signal successful operation). + * Keep in mind that many API functions returning error codes can also + * return positive values, which also indicate success. API users can + * hardcode the fact that ">= 0" means success. + */ + MPV_ERROR_SUCCESS = 0, + /** + * The event ringbuffer is full. This means the client is choked, and can't + * receive any events. This can happen when too many asynchronous requests + * have been made, but not answered. Probably never happens in practice, + * unless the mpv core is frozen for some reason, and the client keeps + * making asynchronous requests. (Bugs in the client API implementation + * could also trigger this, e.g. if events become "lost".) + */ + MPV_ERROR_EVENT_QUEUE_FULL = -1, + /** + * Memory allocation failed. + */ + MPV_ERROR_NOMEM = -2, + /** + * The mpv core wasn't configured and initialized yet. See the notes in + * mpv_create(). + */ + MPV_ERROR_UNINITIALIZED = -3, + /** + * Generic catch-all error if a parameter is set to an invalid or + * unsupported value. This is used if there is no better error code. + */ + MPV_ERROR_INVALID_PARAMETER = -4, + /** + * Trying to set an option that doesn't exist. + */ + MPV_ERROR_OPTION_NOT_FOUND = -5, + /** + * Trying to set an option using an unsupported MPV_FORMAT. + */ + MPV_ERROR_OPTION_FORMAT = -6, + /** + * Setting the option failed. Typically this happens if the provided option + * value could not be parsed. + */ + MPV_ERROR_OPTION_ERROR = -7, + /** + * The accessed property doesn't exist. + */ + MPV_ERROR_PROPERTY_NOT_FOUND = -8, + /** + * Trying to set or get a property using an unsupported MPV_FORMAT. + */ + MPV_ERROR_PROPERTY_FORMAT = -9, + /** + * The property exists, but is not available. This usually happens when the + * associated subsystem is not active, e.g. querying audio parameters while + * audio is disabled. + */ + MPV_ERROR_PROPERTY_UNAVAILABLE = -10, + /** + * Error setting or getting a property. + */ + MPV_ERROR_PROPERTY_ERROR = -11, + /** + * General error when running a command with mpv_command and similar. + */ + MPV_ERROR_COMMAND = -12, + /** + * Generic error on loading (usually used with mpv_event_end_file.error). + */ + MPV_ERROR_LOADING_FAILED = -13, + /** + * Initializing the audio output failed. + */ + MPV_ERROR_AO_INIT_FAILED = -14, + /** + * Initializing the video output failed. + */ + MPV_ERROR_VO_INIT_FAILED = -15, + /** + * There was no audio or video data to play. This also happens if the + * file was recognized, but did not contain any audio or video streams, + * or no streams were selected. + */ + MPV_ERROR_NOTHING_TO_PLAY = -16, + /** + * When trying to load the file, the file format could not be determined, + * or the file was too broken to open it. + */ + MPV_ERROR_UNKNOWN_FORMAT = -17, + /** + * Generic error for signaling that certain system requirements are not + * fulfilled. + */ + MPV_ERROR_UNSUPPORTED = -18, + /** + * The API function which was called is a stub only. + */ + MPV_ERROR_NOT_IMPLEMENTED = -19, + /** + * Unspecified error. + */ + MPV_ERROR_GENERIC = -20 +} mpv_error; + +/** + * Return a string describing the error. For unknown errors, the string + * "unknown error" is returned. + * + * @param error error number, see enum mpv_error + * @return A static string describing the error. The string is completely + * static, i.e. doesn't need to be deallocated, and is valid forever. + */ +MPV_EXPORT const char *mpv_error_string(int error); + +/** + * General function to deallocate memory returned by some of the API functions. + * Call this only if it's explicitly documented as allowed. Calling this on + * mpv memory not owned by the caller will lead to undefined behavior. + * + * @param data A valid pointer returned by the API, or NULL. + */ +MPV_EXPORT void mpv_free(void *data); + +/** + * Return the name of this client handle. Every client has its own unique + * name, which is mostly used for user interface purposes. + * + * @return The client name. The string is read-only and is valid until the + * mpv_handle is destroyed. + */ +MPV_EXPORT const char *mpv_client_name(mpv_handle *ctx); + +/** + * Return the ID of this client handle. Every client has its own unique ID. This + * ID is never reused by the core, even if the mpv_handle at hand gets destroyed + * and new handles get allocated. + * + * IDs are never 0 or negative. + * + * Some mpv APIs (not necessarily all) accept a name in the form "@<id>" in + * addition of the proper mpv_client_name(), where "<id>" is the ID in decimal + * form (e.g. "@123"). For example, the "script-message-to" command takes the + * client name as first argument, but also accepts the client ID formatted in + * this manner. + * + * @return The client ID. + */ +MPV_EXPORT int64_t mpv_client_id(mpv_handle *ctx); + +/** + * Create a new mpv instance and an associated client API handle to control + * the mpv instance. This instance is in a pre-initialized state, + * and needs to be initialized to be actually used with most other API + * functions. + * + * Some API functions will return MPV_ERROR_UNINITIALIZED in the uninitialized + * state. You can call mpv_set_property() (or mpv_set_property_string() and + * other variants, and before mpv 0.21.0 mpv_set_option() etc.) to set initial + * options. After this, call mpv_initialize() to start the player, and then use + * e.g. mpv_command() to start playback of a file. + * + * The point of separating handle creation and actual initialization is that + * you can configure things which can't be changed during runtime. + * + * Unlike the command line player, this will have initial settings suitable + * for embedding in applications. The following settings are different: + * - stdin/stdout/stderr and the terminal will never be accessed. This is + * equivalent to setting the --no-terminal option. + * (Technically, this also suppresses C signal handling.) + * - No config files will be loaded. This is roughly equivalent to using + * --config=no. Since libmpv 1.15, you can actually re-enable this option, + * which will make libmpv load config files during mpv_initialize(). If you + * do this, you are strongly encouraged to set the "config-dir" option too. + * (Otherwise it will load the mpv command line player's config.) + * For example: + * mpv_set_option_string(mpv, "config-dir", "/my/path"); // set config root + * mpv_set_option_string(mpv, "config", "yes"); // enable config loading + * (call mpv_initialize() _after_ this) + * - Idle mode is enabled, which means the playback core will enter idle mode + * if there are no more files to play on the internal playlist, instead of + * exiting. This is equivalent to the --idle option. + * - Disable parts of input handling. + * - Most of the different settings can be viewed with the command line player + * by running "mpv --show-profile=libmpv". + * + * All this assumes that API users want a mpv instance that is strictly + * isolated from the command line player's configuration, user settings, and + * so on. You can re-enable disabled features by setting the appropriate + * options. + * + * The mpv command line parser is not available through this API, but you can + * set individual options with mpv_set_property(). Files for playback must be + * loaded with mpv_command() or others. + * + * Note that you should avoid doing concurrent accesses on the uninitialized + * client handle. (Whether concurrent access is definitely allowed or not has + * yet to be decided.) + * + * @return a new mpv client API handle. Returns NULL on error. Currently, this + * can happen in the following situations: + * - out of memory + * - LC_NUMERIC is not set to "C" (see general remarks) + */ +MPV_EXPORT mpv_handle *mpv_create(void); + +/** + * Initialize an uninitialized mpv instance. If the mpv instance is already + * running, an error is returned. + * + * This function needs to be called to make full use of the client API if the + * client API handle was created with mpv_create(). + * + * Only the following options are required to be set _before_ mpv_initialize(): + * - options which are only read at initialization time: + * - config + * - config-dir + * - input-conf + * - load-scripts + * - script + * - player-operation-mode + * - input-app-events (OSX) + * - all encoding mode options + * + * @return error code + */ +MPV_EXPORT int mpv_initialize(mpv_handle *ctx); + +/** + * Disconnect and destroy the mpv_handle. ctx will be deallocated with this + * API call. + * + * If the last mpv_handle is detached, the core player is destroyed. In + * addition, if there are only weak mpv_handles (such as created by + * mpv_create_weak_client() or internal scripts), these mpv_handles will + * be sent MPV_EVENT_SHUTDOWN. This function may block until these clients + * have responded to the shutdown event, and the core is finally destroyed. + */ +MPV_EXPORT void mpv_destroy(mpv_handle *ctx); + +/** + * Similar to mpv_destroy(), but brings the player and all clients down + * as well, and waits until all of them are destroyed. This function blocks. The + * advantage over mpv_destroy() is that while mpv_destroy() merely + * detaches the client handle from the player, this function quits the player, + * waits until all other clients are destroyed (i.e. all mpv_handles are + * detached), and also waits for the final termination of the player. + * + * Since mpv_destroy() is called somewhere on the way, it's not safe to + * call other functions concurrently on the same context. + * + * Since mpv client API version 1.29: + * The first call on any mpv_handle will block until the core is destroyed. + * This means it will wait until other mpv_handle have been destroyed. If you + * want asynchronous destruction, just run the "quit" command, and then react + * to the MPV_EVENT_SHUTDOWN event. + * If another mpv_handle already called mpv_terminate_destroy(), this call will + * not actually block. It will destroy the mpv_handle, and exit immediately, + * while other mpv_handles might still be uninitializing. + * + * Before mpv client API version 1.29: + * If this is called on a mpv_handle that was not created with mpv_create(), + * this function will merely send a quit command and then call + * mpv_destroy(), without waiting for the actual shutdown. + */ +MPV_EXPORT void mpv_terminate_destroy(mpv_handle *ctx); + +/** + * Create a new client handle connected to the same player core as ctx. This + * context has its own event queue, its own mpv_request_event() state, its own + * mpv_request_log_messages() state, its own set of observed properties, and + * its own state for asynchronous operations. Otherwise, everything is shared. + * + * This handle should be destroyed with mpv_destroy() if no longer + * needed. The core will live as long as there is at least 1 handle referencing + * it. Any handle can make the core quit, which will result in every handle + * receiving MPV_EVENT_SHUTDOWN. + * + * This function can not be called before the main handle was initialized with + * mpv_initialize(). The new handle is always initialized, unless ctx=NULL was + * passed. + * + * @param ctx Used to get the reference to the mpv core; handle-specific + * settings and parameters are not used. + * If NULL, this function behaves like mpv_create() (ignores name). + * @param name The client name. This will be returned by mpv_client_name(). If + * the name is already in use, or contains non-alphanumeric + * characters (other than '_'), the name is modified to fit. + * If NULL, an arbitrary name is automatically chosen. + * @return a new handle, or NULL on error + */ +MPV_EXPORT mpv_handle *mpv_create_client(mpv_handle *ctx, const char *name); + +/** + * This is the same as mpv_create_client(), but the created mpv_handle is + * treated as a weak reference. If all mpv_handles referencing a core are + * weak references, the core is automatically destroyed. (This still goes + * through normal uninit of course. Effectively, if the last non-weak mpv_handle + * is destroyed, then the weak mpv_handles receive MPV_EVENT_SHUTDOWN and are + * asked to terminate as well.) + * + * Note if you want to use this like refcounting: you have to be aware that + * mpv_terminate_destroy() _and_ mpv_destroy() for the last non-weak + * mpv_handle will block until all weak mpv_handles are destroyed. + */ +MPV_EXPORT mpv_handle *mpv_create_weak_client(mpv_handle *ctx, const char *name); + +/** + * Load a config file. This loads and parses the file, and sets every entry in + * the config file's default section as if mpv_set_option_string() is called. + * + * The filename should be an absolute path. If it isn't, the actual path used + * is unspecified. (Note: an absolute path starts with '/' on UNIX.) If the + * file wasn't found, MPV_ERROR_INVALID_PARAMETER is returned. + * + * If a fatal error happens when parsing a config file, MPV_ERROR_OPTION_ERROR + * is returned. Errors when setting options as well as other types or errors + * are ignored (even if options do not exist). You can still try to capture + * the resulting error messages with mpv_request_log_messages(). Note that it's + * possible that some options were successfully set even if any of these errors + * happen. + * + * @param filename absolute path to the config file on the local filesystem + * @return error code + */ +MPV_EXPORT int mpv_load_config_file(mpv_handle *ctx, const char *filename); + +/** + * Return the internal time in nanoseconds. This has an arbitrary start offset, + * but will never wrap or go backwards. + * + * Note that this is always the real time, and doesn't necessarily have to do + * with playback time. For example, playback could go faster or slower due to + * playback speed, or due to playback being paused. Use the "time-pos" property + * instead to get the playback status. + * + * Unlike other libmpv APIs, this can be called at absolutely any time (even + * within wakeup callbacks), as long as the context is valid. + * + * Safe to be called from mpv render API threads. + */ +MPV_EXPORT int64_t mpv_get_time_ns(mpv_handle *ctx); + +/** + * Same as mpv_get_time_ns but in microseconds. + */ +MPV_EXPORT int64_t mpv_get_time_us(mpv_handle *ctx); + +/** + * Data format for options and properties. The API functions to get/set + * properties and options support multiple formats, and this enum describes + * them. + */ +typedef enum mpv_format { + /** + * Invalid. Sometimes used for empty values. This is always defined to 0, + * so a normal 0-init of mpv_format (or e.g. mpv_node) is guaranteed to set + * this it to MPV_FORMAT_NONE (which makes some things saner as consequence). + */ + MPV_FORMAT_NONE = 0, + /** + * The basic type is char*. It returns the raw property string, like + * using ${=property} in input.conf (see input.rst). + * + * NULL isn't an allowed value. + * + * Warning: although the encoding is usually UTF-8, this is not always the + * case. File tags often store strings in some legacy codepage, + * and even filenames don't necessarily have to be in UTF-8 (at + * least on Linux). If you pass the strings to code that requires + * valid UTF-8, you have to sanitize it in some way. + * On Windows, filenames are always UTF-8, and libmpv converts + * between UTF-8 and UTF-16 when using win32 API functions. See + * the "Encoding of filenames" section for details. + * + * Example for reading: + * + * char *result = NULL; + * if (mpv_get_property(ctx, "property", MPV_FORMAT_STRING, &result) < 0) + * goto error; + * printf("%s\n", result); + * mpv_free(result); + * + * Or just use mpv_get_property_string(). + * + * Example for writing: + * + * char *value = "the new value"; + * // yep, you pass the address to the variable + * // (needed for symmetry with other types and mpv_get_property) + * mpv_set_property(ctx, "property", MPV_FORMAT_STRING, &value); + * + * Or just use mpv_set_property_string(). + * + */ + MPV_FORMAT_STRING = 1, + /** + * The basic type is char*. It returns the OSD property string, like + * using ${property} in input.conf (see input.rst). In many cases, this + * is the same as the raw string, but in other cases it's formatted for + * display on OSD. It's intended to be human readable. Do not attempt to + * parse these strings. + * + * Only valid when doing read access. The rest works like MPV_FORMAT_STRING. + */ + MPV_FORMAT_OSD_STRING = 2, + /** + * The basic type is int. The only allowed values are 0 ("no") + * and 1 ("yes"). + * + * Example for reading: + * + * int result; + * if (mpv_get_property(ctx, "property", MPV_FORMAT_FLAG, &result) < 0) + * goto error; + * printf("%s\n", result ? "true" : "false"); + * + * Example for writing: + * + * int flag = 1; + * mpv_set_property(ctx, "property", MPV_FORMAT_FLAG, &flag); + */ + MPV_FORMAT_FLAG = 3, + /** + * The basic type is int64_t. + */ + MPV_FORMAT_INT64 = 4, + /** + * The basic type is double. + */ + MPV_FORMAT_DOUBLE = 5, + /** + * The type is mpv_node. + * + * For reading, you usually would pass a pointer to a stack-allocated + * mpv_node value to mpv, and when you're done you call + * mpv_free_node_contents(&node). + * You're expected not to write to the data - if you have to, copy it + * first (which you have to do manually). + * + * For writing, you construct your own mpv_node, and pass a pointer to the + * API. The API will never write to your data (and copy it if needed), so + * you're free to use any form of allocation or memory management you like. + * + * Warning: when reading, always check the mpv_node.format member. For + * example, properties might change their type in future versions + * of mpv, or sometimes even during runtime. + * + * Example for reading: + * + * mpv_node result; + * if (mpv_get_property(ctx, "property", MPV_FORMAT_NODE, &result) < 0) + * goto error; + * printf("format=%d\n", (int)result.format); + * mpv_free_node_contents(&result). + * + * Example for writing: + * + * mpv_node value; + * value.format = MPV_FORMAT_STRING; + * value.u.string = "hello"; + * mpv_set_property(ctx, "property", MPV_FORMAT_NODE, &value); + */ + MPV_FORMAT_NODE = 6, + /** + * Used with mpv_node only. Can usually not be used directly. + */ + MPV_FORMAT_NODE_ARRAY = 7, + /** + * See MPV_FORMAT_NODE_ARRAY. + */ + MPV_FORMAT_NODE_MAP = 8, + /** + * A raw, untyped byte array. Only used only with mpv_node, and only in + * some very specific situations. (Some commands use it.) + */ + MPV_FORMAT_BYTE_ARRAY = 9 +} mpv_format; + +/** + * Generic data storage. + * + * If mpv writes this struct (e.g. via mpv_get_property()), you must not change + * the data. In some cases (mpv_get_property()), you have to free it with + * mpv_free_node_contents(). If you fill this struct yourself, you're also + * responsible for freeing it, and you must not call mpv_free_node_contents(). + */ +typedef struct mpv_node { + union { + char *string; /** valid if format==MPV_FORMAT_STRING */ + int flag; /** valid if format==MPV_FORMAT_FLAG */ + int64_t int64; /** valid if format==MPV_FORMAT_INT64 */ + double double_; /** valid if format==MPV_FORMAT_DOUBLE */ + /** + * valid if format==MPV_FORMAT_NODE_ARRAY + * or if format==MPV_FORMAT_NODE_MAP + */ + struct mpv_node_list *list; + /** + * valid if format==MPV_FORMAT_BYTE_ARRAY + */ + struct mpv_byte_array *ba; + } u; + /** + * Type of the data stored in this struct. This value rules what members in + * the given union can be accessed. The following formats are currently + * defined to be allowed in mpv_node: + * + * MPV_FORMAT_STRING (u.string) + * MPV_FORMAT_FLAG (u.flag) + * MPV_FORMAT_INT64 (u.int64) + * MPV_FORMAT_DOUBLE (u.double_) + * MPV_FORMAT_NODE_ARRAY (u.list) + * MPV_FORMAT_NODE_MAP (u.list) + * MPV_FORMAT_BYTE_ARRAY (u.ba) + * MPV_FORMAT_NONE (no member) + * + * If you encounter a value you don't know, you must not make any + * assumptions about the contents of union u. + */ + mpv_format format; +} mpv_node; + +/** + * (see mpv_node) + */ +typedef struct mpv_node_list { + /** + * Number of entries. Negative values are not allowed. + */ + int num; + /** + * MPV_FORMAT_NODE_ARRAY: + * values[N] refers to value of the Nth item + * + * MPV_FORMAT_NODE_MAP: + * values[N] refers to value of the Nth key/value pair + * + * If num > 0, values[0] to values[num-1] (inclusive) are valid. + * Otherwise, this can be NULL. + */ + mpv_node *values; + /** + * MPV_FORMAT_NODE_ARRAY: + * unused (typically NULL), access is not allowed + * + * MPV_FORMAT_NODE_MAP: + * keys[N] refers to key of the Nth key/value pair. If num > 0, keys[0] to + * keys[num-1] (inclusive) are valid. Otherwise, this can be NULL. + * The keys are in random order. The only guarantee is that keys[N] belongs + * to the value values[N]. NULL keys are not allowed. + */ + char **keys; +} mpv_node_list; + +/** + * (see mpv_node) + */ +typedef struct mpv_byte_array { + /** + * Pointer to the data. In what format the data is stored is up to whatever + * uses MPV_FORMAT_BYTE_ARRAY. + */ + void *data; + /** + * Size of the data pointed to by ptr. + */ + size_t size; +} mpv_byte_array; + +/** + * Frees any data referenced by the node. It doesn't free the node itself. + * Call this only if the mpv client API set the node. If you constructed the + * node yourself (manually), you have to free it yourself. + * + * If node->format is MPV_FORMAT_NONE, this call does nothing. Likewise, if + * the client API sets a node with this format, this function doesn't need to + * be called. (This is just a clarification that there's no danger of anything + * strange happening in these cases.) + */ +MPV_EXPORT void mpv_free_node_contents(mpv_node *node); + +/** + * Set an option. Note that you can't normally set options during runtime. It + * works in uninitialized state (see mpv_create()), and in some cases in at + * runtime. + * + * Using a format other than MPV_FORMAT_NODE is equivalent to constructing a + * mpv_node with the given format and data, and passing the mpv_node to this + * function. + * + * Note: this is semi-deprecated. For most purposes, this is not needed anymore. + * Starting with mpv version 0.21.0 (version 1.23) most options can be set + * with mpv_set_property() (and related functions), and even before + * mpv_initialize(). In some obscure corner cases, using this function + * to set options might still be required (see + * "Inconsistencies between options and properties" in the manpage). Once + * these are resolved, the option setting functions might be fully + * deprecated. + * + * @param name Option name. This is the same as on the mpv command line, but + * without the leading "--". + * @param format see enum mpv_format. + * @param[in] data Option value (according to the format). + * @return error code + */ +MPV_EXPORT int mpv_set_option(mpv_handle *ctx, const char *name, mpv_format format, + void *data); + +/** + * Convenience function to set an option to a string value. This is like + * calling mpv_set_option() with MPV_FORMAT_STRING. + * + * @return error code + */ +MPV_EXPORT int mpv_set_option_string(mpv_handle *ctx, const char *name, const char *data); + +/** + * Send a command to the player. Commands are the same as those used in + * input.conf, except that this function takes parameters in a pre-split + * form. + * + * The commands and their parameters are documented in input.rst. + * + * Does not use OSD and string expansion by default (unlike mpv_command_string() + * and input.conf). + * + * @param[in] args NULL-terminated list of strings. Usually, the first item + * is the command, and the following items are arguments. + * @return error code + */ +MPV_EXPORT int mpv_command(mpv_handle *ctx, const char **args); + +/** + * Same as mpv_command(), but allows passing structured data in any format. + * In particular, calling mpv_command() is exactly like calling + * mpv_command_node() with the format set to MPV_FORMAT_NODE_ARRAY, and + * every arg passed in order as MPV_FORMAT_STRING. + * + * Does not use OSD and string expansion by default. + * + * The args argument can have one of the following formats: + * + * MPV_FORMAT_NODE_ARRAY: + * Positional arguments. Each entry is an argument using an arbitrary + * format (the format must be compatible to the used command). Usually, + * the first item is the command name (as MPV_FORMAT_STRING). The order + * of arguments is as documented in each command description. + * + * MPV_FORMAT_NODE_MAP: + * Named arguments. This requires at least an entry with the key "name" + * to be present, which must be a string, and contains the command name. + * The special entry "_flags" is optional, and if present, must be an + * array of strings, each being a command prefix to apply. All other + * entries are interpreted as arguments. They must use the argument names + * as documented in each command description. Some commands do not + * support named arguments at all, and must use MPV_FORMAT_NODE_ARRAY. + * + * @param[in] args mpv_node with format set to one of the values documented + * above (see there for details) + * @param[out] result Optional, pass NULL if unused. If not NULL, and if the + * function succeeds, this is set to command-specific return + * data. You must call mpv_free_node_contents() to free it + * (again, only if the command actually succeeds). + * Not many commands actually use this at all. + * @return error code (the result parameter is not set on error) + */ +MPV_EXPORT int mpv_command_node(mpv_handle *ctx, mpv_node *args, mpv_node *result); + +/** + * This is essentially identical to mpv_command() but it also returns a result. + * + * Does not use OSD and string expansion by default. + * + * @param[in] args NULL-terminated list of strings. Usually, the first item + * is the command, and the following items are arguments. + * @param[out] result Optional, pass NULL if unused. If not NULL, and if the + * function succeeds, this is set to command-specific return + * data. You must call mpv_free_node_contents() to free it + * (again, only if the command actually succeeds). + * Not many commands actually use this at all. + * @return error code (the result parameter is not set on error) + */ +MPV_EXPORT int mpv_command_ret(mpv_handle *ctx, const char **args, mpv_node *result); + +/** + * Same as mpv_command, but use input.conf parsing for splitting arguments. + * This is slightly simpler, but also more error prone, since arguments may + * need quoting/escaping. + * + * This also has OSD and string expansion enabled by default. + */ +MPV_EXPORT int mpv_command_string(mpv_handle *ctx, const char *args); + +/** + * Same as mpv_command, but run the command asynchronously. + * + * Commands are executed asynchronously. You will receive a + * MPV_EVENT_COMMAND_REPLY event. This event will also have an + * error code set if running the command failed. For commands that + * return data, the data is put into mpv_event_command.result. + * + * The only case when you do not receive an event is when the function call + * itself fails. This happens only if parsing the command itself (or otherwise + * validating it) fails, i.e. the return code of the API call is not 0 or + * positive. + * + * Safe to be called from mpv render API threads. + * + * @param reply_userdata the value mpv_event.reply_userdata of the reply will + * be set to (see section about asynchronous calls) + * @param args NULL-terminated list of strings (see mpv_command()) + * @return error code (if parsing or queuing the command fails) + */ +MPV_EXPORT int mpv_command_async(mpv_handle *ctx, uint64_t reply_userdata, + const char **args); + +/** + * Same as mpv_command_node(), but run it asynchronously. Basically, this + * function is to mpv_command_node() what mpv_command_async() is to + * mpv_command(). + * + * See mpv_command_async() for details. + * + * Safe to be called from mpv render API threads. + * + * @param reply_userdata the value mpv_event.reply_userdata of the reply will + * be set to (see section about asynchronous calls) + * @param args as in mpv_command_node() + * @return error code (if parsing or queuing the command fails) + */ +MPV_EXPORT int mpv_command_node_async(mpv_handle *ctx, uint64_t reply_userdata, + mpv_node *args); + +/** + * Signal to all async requests with the matching ID to abort. This affects + * the following API calls: + * + * mpv_command_async + * mpv_command_node_async + * + * All of these functions take a reply_userdata parameter. This API function + * tells all requests with the matching reply_userdata value to try to return + * as soon as possible. If there are multiple requests with matching ID, it + * aborts all of them. + * + * This API function is mostly asynchronous itself. It will not wait until the + * command is aborted. Instead, the command will terminate as usual, but with + * some work not done. How this is signaled depends on the specific command (for + * example, the "subprocess" command will indicate it by "killed_by_us" set to + * true in the result). How long it takes also depends on the situation. The + * aborting process is completely asynchronous. + * + * Not all commands may support this functionality. In this case, this function + * will have no effect. The same is true if the request using the passed + * reply_userdata has already terminated, has not been started yet, or was + * never in use at all. + * + * You have to be careful of race conditions: the time during which the abort + * request will be effective is _after_ e.g. mpv_command_async() has returned, + * and before the command has signaled completion with MPV_EVENT_COMMAND_REPLY. + * + * @param reply_userdata ID of the request to be aborted (see above) + */ +MPV_EXPORT void mpv_abort_async_command(mpv_handle *ctx, uint64_t reply_userdata); + +/** + * Set a property to a given value. Properties are essentially variables which + * can be queried or set at runtime. For example, writing to the pause property + * will actually pause or unpause playback. + * + * If the format doesn't match with the internal format of the property, access + * usually will fail with MPV_ERROR_PROPERTY_FORMAT. In some cases, the data + * is automatically converted and access succeeds. For example, MPV_FORMAT_INT64 + * is always converted to MPV_FORMAT_DOUBLE, and access using MPV_FORMAT_STRING + * usually invokes a string parser. The same happens when calling this function + * with MPV_FORMAT_NODE: the underlying format may be converted to another + * type if possible. + * + * Using a format other than MPV_FORMAT_NODE is equivalent to constructing a + * mpv_node with the given format and data, and passing the mpv_node to this + * function. (Before API version 1.21, this was different.) + * + * Note: starting with mpv 0.21.0 (client API version 1.23), this can be used to + * set options in general. It even can be used before mpv_initialize() + * has been called. If called before mpv_initialize(), setting properties + * not backed by options will result in MPV_ERROR_PROPERTY_UNAVAILABLE. + * In some cases, properties and options still conflict. In these cases, + * mpv_set_property() accesses the options before mpv_initialize(), and + * the properties after mpv_initialize(). These conflicts will be removed + * in mpv 0.23.0. See mpv_set_option() for further remarks. + * + * @param name The property name. See input.rst for a list of properties. + * @param format see enum mpv_format. + * @param[in] data Option value. + * @return error code + */ +MPV_EXPORT int mpv_set_property(mpv_handle *ctx, const char *name, mpv_format format, + void *data); + +/** + * Convenience function to set a property to a string value. + * + * This is like calling mpv_set_property() with MPV_FORMAT_STRING. + */ +MPV_EXPORT int mpv_set_property_string(mpv_handle *ctx, const char *name, const char *data); + +/** + * Convenience function to delete a property. + * + * This is equivalent to running the command "del [name]". + * + * @param name The property name. See input.rst for a list of properties. + * @return error code + */ +MPV_EXPORT int mpv_del_property(mpv_handle *ctx, const char *name); + +/** + * Set a property asynchronously. You will receive the result of the operation + * as MPV_EVENT_SET_PROPERTY_REPLY event. The mpv_event.error field will contain + * the result status of the operation. Otherwise, this function is similar to + * mpv_set_property(). + * + * Safe to be called from mpv render API threads. + * + * @param reply_userdata see section about asynchronous calls + * @param name The property name. + * @param format see enum mpv_format. + * @param[in] data Option value. The value will be copied by the function. It + * will never be modified by the client API. + * @return error code if sending the request failed + */ +MPV_EXPORT int mpv_set_property_async(mpv_handle *ctx, uint64_t reply_userdata, + const char *name, mpv_format format, void *data); + +/** + * Read the value of the given property. + * + * If the format doesn't match with the internal format of the property, access + * usually will fail with MPV_ERROR_PROPERTY_FORMAT. In some cases, the data + * is automatically converted and access succeeds. For example, MPV_FORMAT_INT64 + * is always converted to MPV_FORMAT_DOUBLE, and access using MPV_FORMAT_STRING + * usually invokes a string formatter. + * + * @param name The property name. + * @param format see enum mpv_format. + * @param[out] data Pointer to the variable holding the option value. On + * success, the variable will be set to a copy of the option + * value. For formats that require dynamic memory allocation, + * you can free the value with mpv_free() (strings) or + * mpv_free_node_contents() (MPV_FORMAT_NODE). + * @return error code + */ +MPV_EXPORT int mpv_get_property(mpv_handle *ctx, const char *name, mpv_format format, + void *data); + +/** + * Return the value of the property with the given name as string. This is + * equivalent to mpv_get_property() with MPV_FORMAT_STRING. + * + * See MPV_FORMAT_STRING for character encoding issues. + * + * On error, NULL is returned. Use mpv_get_property() if you want fine-grained + * error reporting. + * + * @param name The property name. + * @return Property value, or NULL if the property can't be retrieved. Free + * the string with mpv_free(). + */ +MPV_EXPORT char *mpv_get_property_string(mpv_handle *ctx, const char *name); + +/** + * Return the property as "OSD" formatted string. This is the same as + * mpv_get_property_string, but using MPV_FORMAT_OSD_STRING. + * + * @return Property value, or NULL if the property can't be retrieved. Free + * the string with mpv_free(). + */ +MPV_EXPORT char *mpv_get_property_osd_string(mpv_handle *ctx, const char *name); + +/** + * Get a property asynchronously. You will receive the result of the operation + * as well as the property data with the MPV_EVENT_GET_PROPERTY_REPLY event. + * You should check the mpv_event.error field on the reply event. + * + * Safe to be called from mpv render API threads. + * + * @param reply_userdata see section about asynchronous calls + * @param name The property name. + * @param format see enum mpv_format. + * @return error code if sending the request failed + */ +MPV_EXPORT int mpv_get_property_async(mpv_handle *ctx, uint64_t reply_userdata, + const char *name, mpv_format format); + +/** + * Get a notification whenever the given property changes. You will receive + * updates as MPV_EVENT_PROPERTY_CHANGE. Note that this is not very precise: + * for some properties, it may not send updates even if the property changed. + * This depends on the property, and it's a valid feature request to ask for + * better update handling of a specific property. (For some properties, like + * ``clock``, which shows the wall clock, this mechanism doesn't make too + * much sense anyway.) + * + * Property changes are coalesced: the change events are returned only once the + * event queue becomes empty (e.g. mpv_wait_event() would block or return + * MPV_EVENT_NONE), and then only one event per changed property is returned. + * + * You always get an initial change notification. This is meant to initialize + * the user's state to the current value of the property. + * + * Normally, change events are sent only if the property value changes according + * to the requested format. mpv_event_property will contain the property value + * as data member. + * + * Warning: if a property is unavailable or retrieving it caused an error, + * MPV_FORMAT_NONE will be set in mpv_event_property, even if the + * format parameter was set to a different value. In this case, the + * mpv_event_property.data field is invalid. + * + * If the property is observed with the format parameter set to MPV_FORMAT_NONE, + * you get low-level notifications whether the property _may_ have changed, and + * the data member in mpv_event_property will be unset. With this mode, you + * will have to determine yourself whether the property really changed. On the + * other hand, this mechanism can be faster and uses less resources. + * + * Observing a property that doesn't exist is allowed. (Although it may still + * cause some sporadic change events.) + * + * Keep in mind that you will get change notifications even if you change a + * property yourself. Try to avoid endless feedback loops, which could happen + * if you react to the change notifications triggered by your own change. + * + * Only the mpv_handle on which this was called will receive the property + * change events, or can unobserve them. + * + * Safe to be called from mpv render API threads. + * + * @param reply_userdata This will be used for the mpv_event.reply_userdata + * field for the received MPV_EVENT_PROPERTY_CHANGE + * events. (Also see section about asynchronous calls, + * although this function is somewhat different from + * actual asynchronous calls.) + * If you have no use for this, pass 0. + * Also see mpv_unobserve_property(). + * @param name The property name. + * @param format see enum mpv_format. Can be MPV_FORMAT_NONE to omit values + * from the change events. + * @return error code (usually fails only on OOM or unsupported format) + */ +MPV_EXPORT int mpv_observe_property(mpv_handle *mpv, uint64_t reply_userdata, + const char *name, mpv_format format); + +/** + * Undo mpv_observe_property(). This will remove all observed properties for + * which the given number was passed as reply_userdata to mpv_observe_property. + * + * Safe to be called from mpv render API threads. + * + * @param registered_reply_userdata ID that was passed to mpv_observe_property + * @return negative value is an error code, >=0 is number of removed properties + * on success (includes the case when 0 were removed) + */ +MPV_EXPORT int mpv_unobserve_property(mpv_handle *mpv, uint64_t registered_reply_userdata); + +typedef enum mpv_event_id { + /** + * Nothing happened. Happens on timeouts or sporadic wakeups. + */ + MPV_EVENT_NONE = 0, + /** + * Happens when the player quits. The player enters a state where it tries + * to disconnect all clients. Most requests to the player will fail, and + * the client should react to this and quit with mpv_destroy() as soon as + * possible. + */ + MPV_EVENT_SHUTDOWN = 1, + /** + * See mpv_request_log_messages(). + */ + MPV_EVENT_LOG_MESSAGE = 2, + /** + * Reply to a mpv_get_property_async() request. + * See also mpv_event and mpv_event_property. + */ + MPV_EVENT_GET_PROPERTY_REPLY = 3, + /** + * Reply to a mpv_set_property_async() request. + * (Unlike MPV_EVENT_GET_PROPERTY, mpv_event_property is not used.) + */ + MPV_EVENT_SET_PROPERTY_REPLY = 4, + /** + * Reply to a mpv_command_async() or mpv_command_node_async() request. + * See also mpv_event and mpv_event_command. + */ + MPV_EVENT_COMMAND_REPLY = 5, + /** + * Notification before playback start of a file (before the file is loaded). + * See also mpv_event and mpv_event_start_file. + */ + MPV_EVENT_START_FILE = 6, + /** + * Notification after playback end (after the file was unloaded). + * See also mpv_event and mpv_event_end_file. + */ + MPV_EVENT_END_FILE = 7, + /** + * Notification when the file has been loaded (headers were read etc.), and + * decoding starts. + */ + MPV_EVENT_FILE_LOADED = 8, +#if MPV_ENABLE_DEPRECATED + /** + * Idle mode was entered. In this mode, no file is played, and the playback + * core waits for new commands. (The command line player normally quits + * instead of entering idle mode, unless --idle was specified. If mpv + * was started with mpv_create(), idle mode is enabled by default.) + * + * @deprecated This is equivalent to using mpv_observe_property() on the + * "idle-active" property. The event is redundant, and might be + * removed in the far future. As a further warning, this event + * is not necessarily sent at the right point anymore (at the + * start of the program), while the property behaves correctly. + */ + MPV_EVENT_IDLE = 11, + /** + * Sent every time after a video frame is displayed. Note that currently, + * this will be sent in lower frequency if there is no video, or playback + * is paused - but that will be removed in the future, and it will be + * restricted to video frames only. + * + * @deprecated Use mpv_observe_property() with relevant properties instead + * (such as "playback-time"). + */ + MPV_EVENT_TICK = 14, +#endif + /** + * Triggered by the script-message input command. The command uses the + * first argument of the command as client name (see mpv_client_name()) to + * dispatch the message, and passes along all arguments starting from the + * second argument as strings. + * See also mpv_event and mpv_event_client_message. + */ + MPV_EVENT_CLIENT_MESSAGE = 16, + /** + * Happens after video changed in some way. This can happen on resolution + * changes, pixel format changes, or video filter changes. The event is + * sent after the video filters and the VO are reconfigured. Applications + * embedding a mpv window should listen to this event in order to resize + * the window if needed. + * Note that this event can happen sporadically, and you should check + * yourself whether the video parameters really changed before doing + * something expensive. + */ + MPV_EVENT_VIDEO_RECONFIG = 17, + /** + * Similar to MPV_EVENT_VIDEO_RECONFIG. This is relatively uninteresting, + * because there is no such thing as audio output embedding. + */ + MPV_EVENT_AUDIO_RECONFIG = 18, + /** + * Happens when a seek was initiated. Playback stops. Usually it will + * resume with MPV_EVENT_PLAYBACK_RESTART as soon as the seek is finished. + */ + MPV_EVENT_SEEK = 20, + /** + * There was a discontinuity of some sort (like a seek), and playback + * was reinitialized. Usually happens on start of playback and after + * seeking. The main purpose is allowing the client to detect when a seek + * request is finished. + */ + MPV_EVENT_PLAYBACK_RESTART = 21, + /** + * Event sent due to mpv_observe_property(). + * See also mpv_event and mpv_event_property. + */ + MPV_EVENT_PROPERTY_CHANGE = 22, + /** + * Happens if the internal per-mpv_handle ringbuffer overflows, and at + * least 1 event had to be dropped. This can happen if the client doesn't + * read the event queue quickly enough with mpv_wait_event(), or if the + * client makes a very large number of asynchronous calls at once. + * + * Event delivery will continue normally once this event was returned + * (this forces the client to empty the queue completely). + */ + MPV_EVENT_QUEUE_OVERFLOW = 24, + /** + * Triggered if a hook handler was registered with mpv_hook_add(), and the + * hook is invoked. If you receive this, you must handle it, and continue + * the hook with mpv_hook_continue(). + * See also mpv_event and mpv_event_hook. + */ + MPV_EVENT_HOOK = 25, + // Internal note: adjust INTERNAL_EVENT_BASE when adding new events. +} mpv_event_id; + +/** + * Return a string describing the event. For unknown events, NULL is returned. + * + * Note that all events actually returned by the API will also yield a non-NULL + * string with this function. + * + * @param event event ID, see see enum mpv_event_id + * @return A static string giving a short symbolic name of the event. It + * consists of lower-case alphanumeric characters and can include "-" + * characters. This string is suitable for use in e.g. scripting + * interfaces. + * The string is completely static, i.e. doesn't need to be deallocated, + * and is valid forever. + */ +MPV_EXPORT const char *mpv_event_name(mpv_event_id event); + +typedef struct mpv_event_property { + /** + * Name of the property. + */ + const char *name; + /** + * Format of the data field in the same struct. See enum mpv_format. + * This is always the same format as the requested format, except when + * the property could not be retrieved (unavailable, or an error happened), + * in which case the format is MPV_FORMAT_NONE. + */ + mpv_format format; + /** + * Received property value. Depends on the format. This is like the + * pointer argument passed to mpv_get_property(). + * + * For example, for MPV_FORMAT_STRING you get the string with: + * + * char *value = *(char **)(event_property->data); + * + * Note that this is set to NULL if retrieving the property failed (the + * format will be MPV_FORMAT_NONE). + */ + void *data; +} mpv_event_property; + +/** + * Numeric log levels. The lower the number, the more important the message is. + * MPV_LOG_LEVEL_NONE is never used when receiving messages. The string in + * the comment after the value is the name of the log level as used for the + * mpv_request_log_messages() function. + * Unused numeric values are unused, but reserved for future use. + */ +typedef enum mpv_log_level { + MPV_LOG_LEVEL_NONE = 0, /// "no" - disable absolutely all messages + MPV_LOG_LEVEL_FATAL = 10, /// "fatal" - critical/aborting errors + MPV_LOG_LEVEL_ERROR = 20, /// "error" - simple errors + MPV_LOG_LEVEL_WARN = 30, /// "warn" - possible problems + MPV_LOG_LEVEL_INFO = 40, /// "info" - informational message + MPV_LOG_LEVEL_V = 50, /// "v" - noisy informational message + MPV_LOG_LEVEL_DEBUG = 60, /// "debug" - very noisy technical information + MPV_LOG_LEVEL_TRACE = 70, /// "trace" - extremely noisy +} mpv_log_level; + +typedef struct mpv_event_log_message { + /** + * The module prefix, identifies the sender of the message. As a special + * case, if the message buffer overflows, this will be set to the string + * "overflow" (which doesn't appear as prefix otherwise), and the text + * field will contain an informative message. + */ + const char *prefix; + /** + * The log level as string. See mpv_request_log_messages() for possible + * values. The level "no" is never used here. + */ + const char *level; + /** + * The log message. It consists of 1 line of text, and is terminated with + * a newline character. (Before API version 1.6, it could contain multiple + * or partial lines.) + */ + const char *text; + /** + * The same contents as the level field, but as a numeric ID. + * Since API version 1.6. + */ + mpv_log_level log_level; +} mpv_event_log_message; + +/// Since API version 1.9. +typedef enum mpv_end_file_reason { + /** + * The end of file was reached. Sometimes this may also happen on + * incomplete or corrupted files, or if the network connection was + * interrupted when playing a remote file. It also happens if the + * playback range was restricted with --end or --frames or similar. + */ + MPV_END_FILE_REASON_EOF = 0, + /** + * Playback was stopped by an external action (e.g. playlist controls). + */ + MPV_END_FILE_REASON_STOP = 2, + /** + * Playback was stopped by the quit command or player shutdown. + */ + MPV_END_FILE_REASON_QUIT = 3, + /** + * Some kind of error happened that lead to playback abort. Does not + * necessarily happen on incomplete or broken files (in these cases, both + * MPV_END_FILE_REASON_ERROR or MPV_END_FILE_REASON_EOF are possible). + * + * mpv_event_end_file.error will be set. + */ + MPV_END_FILE_REASON_ERROR = 4, + /** + * The file was a playlist or similar. When the playlist is read, its + * entries will be appended to the playlist after the entry of the current + * file, the entry of the current file is removed, and a MPV_EVENT_END_FILE + * event is sent with reason set to MPV_END_FILE_REASON_REDIRECT. Then + * playback continues with the playlist contents. + * Since API version 1.18. + */ + MPV_END_FILE_REASON_REDIRECT = 5, +} mpv_end_file_reason; + +/// Since API version 1.108. +typedef struct mpv_event_start_file { + /** + * Playlist entry ID of the file being loaded now. + */ + int64_t playlist_entry_id; +} mpv_event_start_file; + +typedef struct mpv_event_end_file { + /** + * Corresponds to the values in enum mpv_end_file_reason. + * + * Unknown values should be treated as unknown. + */ + mpv_end_file_reason reason; + /** + * If reason==MPV_END_FILE_REASON_ERROR, this contains a mpv error code + * (one of MPV_ERROR_...) giving an approximate reason why playback + * failed. In other cases, this field is 0 (no error). + * Since API version 1.9. + */ + int error; + /** + * Playlist entry ID of the file that was being played or attempted to be + * played. This has the same value as the playlist_entry_id field in the + * corresponding mpv_event_start_file event. + * Since API version 1.108. + */ + int64_t playlist_entry_id; + /** + * If loading ended, because the playlist entry to be played was for example + * a playlist, and the current playlist entry is replaced with a number of + * other entries. This may happen at least with MPV_END_FILE_REASON_REDIRECT + * (other event types may use this for similar but different purposes in the + * future). In this case, playlist_insert_id will be set to the playlist + * entry ID of the first inserted entry, and playlist_insert_num_entries to + * the total number of inserted playlist entries. Note this in this specific + * case, the ID of the last inserted entry is playlist_insert_id+num-1. + * Beware that depending on circumstances, you may observe the new playlist + * entries before seeing the event (e.g. reading the "playlist" property or + * getting a property change notification before receiving the event). + * Since API version 1.108. + */ + int64_t playlist_insert_id; + /** + * See playlist_insert_id. Only non-0 if playlist_insert_id is valid. Never + * negative. + * Since API version 1.108. + */ + int playlist_insert_num_entries; +} mpv_event_end_file; + +typedef struct mpv_event_client_message { + /** + * Arbitrary arguments chosen by the sender of the message. If num_args > 0, + * you can access args[0] through args[num_args - 1] (inclusive). What + * these arguments mean is up to the sender and receiver. + * None of the valid items are NULL. + */ + int num_args; + const char **args; +} mpv_event_client_message; + +typedef struct mpv_event_hook { + /** + * The hook name as passed to mpv_hook_add(). + */ + const char *name; + /** + * Internal ID that must be passed to mpv_hook_continue(). + */ + uint64_t id; +} mpv_event_hook; + +// Since API version 1.102. +typedef struct mpv_event_command { + /** + * Result data of the command. Note that success/failure is signaled + * separately via mpv_event.error. This field is only for result data + * in case of success. Most commands leave it at MPV_FORMAT_NONE. Set + * to MPV_FORMAT_NONE on failure. + */ + mpv_node result; +} mpv_event_command; + +typedef struct mpv_event { + /** + * One of mpv_event. Keep in mind that later ABI compatible releases might + * add new event types. These should be ignored by the API user. + */ + mpv_event_id event_id; + /** + * This is mainly used for events that are replies to (asynchronous) + * requests. It contains a status code, which is >= 0 on success, or < 0 + * on error (a mpv_error value). Usually, this will be set if an + * asynchronous request fails. + * Used for: + * MPV_EVENT_GET_PROPERTY_REPLY + * MPV_EVENT_SET_PROPERTY_REPLY + * MPV_EVENT_COMMAND_REPLY + */ + int error; + /** + * If the event is in reply to a request (made with this API and this + * API handle), this is set to the reply_userdata parameter of the request + * call. Otherwise, this field is 0. + * Used for: + * MPV_EVENT_GET_PROPERTY_REPLY + * MPV_EVENT_SET_PROPERTY_REPLY + * MPV_EVENT_COMMAND_REPLY + * MPV_EVENT_PROPERTY_CHANGE + * MPV_EVENT_HOOK + */ + uint64_t reply_userdata; + /** + * The meaning and contents of the data member depend on the event_id: + * MPV_EVENT_GET_PROPERTY_REPLY: mpv_event_property* + * MPV_EVENT_PROPERTY_CHANGE: mpv_event_property* + * MPV_EVENT_LOG_MESSAGE: mpv_event_log_message* + * MPV_EVENT_CLIENT_MESSAGE: mpv_event_client_message* + * MPV_EVENT_START_FILE: mpv_event_start_file* (since v1.108) + * MPV_EVENT_END_FILE: mpv_event_end_file* + * MPV_EVENT_HOOK: mpv_event_hook* + * MPV_EVENT_COMMAND_REPLY* mpv_event_command* + * other: NULL + * + * Note: future enhancements might add new event structs for existing or new + * event types. + */ + void *data; +} mpv_event; + +/** + * Convert the given src event to a mpv_node, and set *dst to the result. *dst + * is set to a MPV_FORMAT_NODE_MAP, with fields for corresponding mpv_event and + * mpv_event.data/mpv_event_* fields. + * + * The exact details are not completely documented out of laziness. A start + * is located in the "Events" section of the manpage. + * + * *dst may point to newly allocated memory, or pointers in mpv_event. You must + * copy the entire mpv_node if you want to reference it after mpv_event becomes + * invalid (such as making a new mpv_wait_event() call, or destroying the + * mpv_handle from which it was returned). Call mpv_free_node_contents() to free + * any memory allocations made by this API function. + * + * Safe to be called from mpv render API threads. + * + * @param dst Target. This is not read and fully overwritten. Must be released + * with mpv_free_node_contents(). Do not write to pointers returned + * by it. (On error, this may be left as an empty node.) + * @param src The source event. Not modified (it's not const due to the author's + * prejudice of the C version of const). + * @return error code (MPV_ERROR_NOMEM only, if at all) + */ +MPV_EXPORT int mpv_event_to_node(mpv_node *dst, mpv_event *src); + +/** + * Enable or disable the given event. + * + * Some events are enabled by default. Some events can't be disabled. + * + * (Informational note: currently, all events are enabled by default, except + * MPV_EVENT_TICK.) + * + * Safe to be called from mpv render API threads. + * + * @param event See enum mpv_event_id. + * @param enable 1 to enable receiving this event, 0 to disable it. + * @return error code + */ +MPV_EXPORT int mpv_request_event(mpv_handle *ctx, mpv_event_id event, int enable); + +/** + * Enable or disable receiving of log messages. These are the messages the + * command line player prints to the terminal. This call sets the minimum + * required log level for a message to be received with MPV_EVENT_LOG_MESSAGE. + * + * @param min_level Minimal log level as string. Valid log levels: + * no fatal error warn info v debug trace + * The value "no" disables all messages. This is the default. + * An exception is the value "terminal-default", which uses the + * log level as set by the "--msg-level" option. This works + * even if the terminal is disabled. (Since API version 1.19.) + * Also see mpv_log_level. + * @return error code + */ +MPV_EXPORT int mpv_request_log_messages(mpv_handle *ctx, const char *min_level); + +/** + * Wait for the next event, or until the timeout expires, or if another thread + * makes a call to mpv_wakeup(). Passing 0 as timeout will never wait, and + * is suitable for polling. + * + * The internal event queue has a limited size (per client handle). If you + * don't empty the event queue quickly enough with mpv_wait_event(), it will + * overflow and silently discard further events. If this happens, making + * asynchronous requests will fail as well (with MPV_ERROR_EVENT_QUEUE_FULL). + * + * Only one thread is allowed to call this on the same mpv_handle at a time. + * The API won't complain if more than one thread calls this, but it will cause + * race conditions in the client when accessing the shared mpv_event struct. + * Note that most other API functions are not restricted by this, and no API + * function internally calls mpv_wait_event(). Additionally, concurrent calls + * to different mpv_handles are always safe. + * + * As long as the timeout is 0, this is safe to be called from mpv render API + * threads. + * + * @param timeout Timeout in seconds, after which the function returns even if + * no event was received. A MPV_EVENT_NONE is returned on + * timeout. A value of 0 will disable waiting. Negative values + * will wait with an infinite timeout. + * @return A struct containing the event ID and other data. The pointer (and + * fields in the struct) stay valid until the next mpv_wait_event() + * call, or until the mpv_handle is destroyed. You must not write to + * the struct, and all memory referenced by it will be automatically + * released by the API on the next mpv_wait_event() call, or when the + * context is destroyed. The return value is never NULL. + */ +MPV_EXPORT mpv_event *mpv_wait_event(mpv_handle *ctx, double timeout); + +/** + * Interrupt the current mpv_wait_event() call. This will wake up the thread + * currently waiting in mpv_wait_event(). If no thread is waiting, the next + * mpv_wait_event() call will return immediately (this is to avoid lost + * wakeups). + * + * mpv_wait_event() will receive a MPV_EVENT_NONE if it's woken up due to + * this call. But note that this dummy event might be skipped if there are + * already other events queued. All what counts is that the waiting thread + * is woken up at all. + * + * Safe to be called from mpv render API threads. + */ +MPV_EXPORT void mpv_wakeup(mpv_handle *ctx); + +/** + * Set a custom function that should be called when there are new events. Use + * this if blocking in mpv_wait_event() to wait for new events is not feasible. + * + * Keep in mind that the callback will be called from foreign threads. You + * must not make any assumptions of the environment, and you must return as + * soon as possible (i.e. no long blocking waits). Exiting the callback through + * any other means than a normal return is forbidden (no throwing exceptions, + * no longjmp() calls). You must not change any local thread state (such as + * the C floating point environment). + * + * You are not allowed to call any client API functions inside of the callback. + * In particular, you should not do any processing in the callback, but wake up + * another thread that does all the work. The callback is meant strictly for + * notification only, and is called from arbitrary core parts of the player, + * that make no considerations for reentrant API use or allowing the callee to + * spend a lot of time doing other things. Keep in mind that it's also possible + * that the callback is called from a thread while a mpv API function is called + * (i.e. it can be reentrant). + * + * In general, the client API expects you to call mpv_wait_event() to receive + * notifications, and the wakeup callback is merely a helper utility to make + * this easier in certain situations. Note that it's possible that there's + * only one wakeup callback invocation for multiple events. You should call + * mpv_wait_event() with no timeout until MPV_EVENT_NONE is reached, at which + * point the event queue is empty. + * + * If you actually want to do processing in a callback, spawn a thread that + * does nothing but call mpv_wait_event() in a loop and dispatches the result + * to a callback. + * + * Only one wakeup callback can be set. + * + * @param cb function that should be called if a wakeup is required + * @param d arbitrary userdata passed to cb + */ +MPV_EXPORT void mpv_set_wakeup_callback(mpv_handle *ctx, void (*cb)(void *d), void *d); + +/** + * Block until all asynchronous requests are done. This affects functions like + * mpv_command_async(), which return immediately and return their result as + * events. + * + * This is a helper, and somewhat equivalent to calling mpv_wait_event() in a + * loop until all known asynchronous requests have sent their reply as event, + * except that the event queue is not emptied. + * + * In case you called mpv_suspend() before, this will also forcibly reset the + * suspend counter of the given handle. + */ +MPV_EXPORT void mpv_wait_async_requests(mpv_handle *ctx); + +/** + * A hook is like a synchronous event that blocks the player. You register + * a hook handler with this function. You will get an event, which you need + * to handle, and once things are ready, you can let the player continue with + * mpv_hook_continue(). + * + * Currently, hooks can't be removed explicitly. But they will be implicitly + * removed if the mpv_handle it was registered with is destroyed. This also + * continues the hook if it was being handled by the destroyed mpv_handle (but + * this should be avoided, as it might mess up order of hook execution). + * + * Hook handlers are ordered globally by priority and order of registration. + * Handlers for the same hook with same priority are invoked in order of + * registration (the handler registered first is run first). Handlers with + * lower priority are run first (which seems backward). + * + * See the "Hooks" section in the manpage to see which hooks are currently + * defined. + * + * Some hooks might be reentrant (so you get multiple MPV_EVENT_HOOK for the + * same hook). If this can happen for a specific hook type, it will be + * explicitly documented in the manpage. + * + * Only the mpv_handle on which this was called will receive the hook events, + * or can "continue" them. + * + * @param reply_userdata This will be used for the mpv_event.reply_userdata + * field for the received MPV_EVENT_HOOK events. + * If you have no use for this, pass 0. + * @param name The hook name. This should be one of the documented names. But + * if the name is unknown, the hook event will simply be never + * raised. + * @param priority See remarks above. Use 0 as a neutral default. + * @return error code (usually fails only on OOM) + */ +MPV_EXPORT int mpv_hook_add(mpv_handle *ctx, uint64_t reply_userdata, + const char *name, int priority); + +/** + * Respond to a MPV_EVENT_HOOK event. You must call this after you have handled + * the event. There is no way to "cancel" or "stop" the hook. + * + * Calling this will will typically unblock the player for whatever the hook + * is responsible for (e.g. for the "on_load" hook it lets it continue + * playback). + * + * It is explicitly undefined behavior to call this more than once for each + * MPV_EVENT_HOOK, to pass an incorrect ID, or to call this on a mpv_handle + * different from the one that registered the handler and received the event. + * + * @param id This must be the value of the mpv_event_hook.id field for the + * corresponding MPV_EVENT_HOOK. + * @return error code + */ +MPV_EXPORT int mpv_hook_continue(mpv_handle *ctx, uint64_t id); + +#if MPV_ENABLE_DEPRECATED + +/** + * Return a UNIX file descriptor referring to the read end of a pipe. This + * pipe can be used to wake up a poll() based processing loop. The purpose of + * this function is very similar to mpv_set_wakeup_callback(), and provides + * a primitive mechanism to handle coordinating a foreign event loop and the + * libmpv event loop. The pipe is non-blocking. It's closed when the mpv_handle + * is destroyed. This function always returns the same value (on success). + * + * This is in fact implemented using the same underlying code as for + * mpv_set_wakeup_callback() (though they don't conflict), and it is as if each + * callback invocation writes a single 0 byte to the pipe. When the pipe + * becomes readable, the code calling poll() (or select()) on the pipe should + * read all contents of the pipe and then call mpv_wait_event(c, 0) until + * no new events are returned. The pipe contents do not matter and can just + * be discarded. There is not necessarily one byte per readable event in the + * pipe. For example, the pipes are non-blocking, and mpv won't block if the + * pipe is full. Pipes are normally limited to 4096 bytes, so if there are + * more than 4096 events, the number of readable bytes can not equal the number + * of events queued. Also, it's possible that mpv does not write to the pipe + * once it's guaranteed that the client was already signaled. See the example + * below how to do it correctly. + * + * Example: + * + * int pipefd = mpv_get_wakeup_pipe(mpv); + * if (pipefd < 0) + * error(); + * while (1) { + * struct pollfd pfds[1] = { + * { .fd = pipefd, .events = POLLIN }, + * }; + * // Wait until there are possibly new mpv events. + * poll(pfds, 1, -1); + * if (pfds[0].revents & POLLIN) { + * // Empty the pipe. Doing this before calling mpv_wait_event() + * // ensures that no wakeups are missed. It's not so important to + * // make sure the pipe is really empty (it will just cause some + * // additional wakeups in unlikely corner cases). + * char unused[256]; + * read(pipefd, unused, sizeof(unused)); + * while (1) { + * mpv_event *ev = mpv_wait_event(mpv, 0); + * // If MPV_EVENT_NONE is received, the event queue is empty. + * if (ev->event_id == MPV_EVENT_NONE) + * break; + * // Process the event. + * ... + * } + * } + * } + * + * @deprecated this function will be removed in the future. If you need this + * functionality, use mpv_set_wakeup_callback(), create a pipe + * manually, and call write() on your pipe in the callback. + * + * @return A UNIX FD of the read end of the wakeup pipe, or -1 on error. + * On MS Windows/MinGW, this will always return -1. + */ +MPV_EXPORT int mpv_get_wakeup_pipe(mpv_handle *ctx); + +#endif + +/** + * Defining MPV_CPLUGIN_DYNAMIC_SYM during plugin compilation will replace mpv_* + * functions with function pointers. Those pointer will be initialized when + * loading the plugin. + * + * It is recommended to use this symbol table when targeting Windows. The loader + * does not have notion of global symbols. Loading cplugin into mpv process will + * not allow this plugin to call any of the symbols that may be available in + * other modules. Instead cplugin has to link explicitly to specific PE binary, + * libmpv-2.dll/mpv.exe or any other binary that may have linked mpv statically. + * This limits portability of cplugin as it would need to be compiled separately + * for each of target PE binary that includes mpv's symbols. Which in practice + * is unrealistic, as we want one cplugin to be loaded without those restrictions. + * + * Instead of linking to any PE binary, we create function pointers for all mpv's + * exported symbols. For convenience names of entrypoints are redefined to those + * pointer, so no changes are required in cplugin source code, except of defining + * MPV_CPLUGIN_DYNAMIC_SYM. Those function pointer are exported to make them + * available for mpv to init with correct values during runtime, before calling + * `mpv_open_cplugin`. + * + * Note that those pointers are decorated with `selectany` attribute, so no need + * to worry about multiple definitions, linker will keep only single instance. + */ +#ifdef MPV_CPLUGIN_DYNAMIC_SYM + +#define MPV_DEFINE_SYM_PTR(name) \ + MPV_SELECTANY MPV_EXPORT \ + MPV_DECLTYPE(name) *pfn_##name; + +MPV_DEFINE_SYM_PTR(mpv_client_api_version) +#define mpv_client_api_version pfn_mpv_client_api_version +MPV_DEFINE_SYM_PTR(mpv_error_string) +#define mpv_error_string pfn_mpv_error_string +MPV_DEFINE_SYM_PTR(mpv_free) +#define mpv_free pfn_mpv_free +MPV_DEFINE_SYM_PTR(mpv_client_name) +#define mpv_client_name pfn_mpv_client_name +MPV_DEFINE_SYM_PTR(mpv_client_id) +#define mpv_client_id pfn_mpv_client_id +MPV_DEFINE_SYM_PTR(mpv_create) +#define mpv_create pfn_mpv_create +MPV_DEFINE_SYM_PTR(mpv_initialize) +#define mpv_initialize pfn_mpv_initialize +MPV_DEFINE_SYM_PTR(mpv_destroy) +#define mpv_destroy pfn_mpv_destroy +MPV_DEFINE_SYM_PTR(mpv_terminate_destroy) +#define mpv_terminate_destroy pfn_mpv_terminate_destroy +MPV_DEFINE_SYM_PTR(mpv_create_client) +#define mpv_create_client pfn_mpv_create_client +MPV_DEFINE_SYM_PTR(mpv_create_weak_client) +#define mpv_create_weak_client pfn_mpv_create_weak_client +MPV_DEFINE_SYM_PTR(mpv_load_config_file) +#define mpv_load_config_file pfn_mpv_load_config_file +MPV_DEFINE_SYM_PTR(mpv_get_time_ns) +#define mpv_get_time_ns pfn_mpv_get_time_ns +MPV_DEFINE_SYM_PTR(mpv_get_time_us) +#define mpv_get_time_us pfn_mpv_get_time_us +MPV_DEFINE_SYM_PTR(mpv_free_node_contents) +#define mpv_free_node_contents pfn_mpv_free_node_contents +MPV_DEFINE_SYM_PTR(mpv_set_option) +#define mpv_set_option pfn_mpv_set_option +MPV_DEFINE_SYM_PTR(mpv_set_option_string) +#define mpv_set_option_string pfn_mpv_set_option_string +MPV_DEFINE_SYM_PTR(mpv_command) +#define mpv_command pfn_mpv_command +MPV_DEFINE_SYM_PTR(mpv_command_node) +#define mpv_command_node pfn_mpv_command_node +MPV_DEFINE_SYM_PTR(mpv_command_ret) +#define mpv_command_ret pfn_mpv_command_ret +MPV_DEFINE_SYM_PTR(mpv_command_string) +#define mpv_command_string pfn_mpv_command_string +MPV_DEFINE_SYM_PTR(mpv_command_async) +#define mpv_command_async pfn_mpv_command_async +MPV_DEFINE_SYM_PTR(mpv_command_node_async) +#define mpv_command_node_async pfn_mpv_command_node_async +MPV_DEFINE_SYM_PTR(mpv_abort_async_command) +#define mpv_abort_async_command pfn_mpv_abort_async_command +MPV_DEFINE_SYM_PTR(mpv_set_property) +#define mpv_set_property pfn_mpv_set_property +MPV_DEFINE_SYM_PTR(mpv_set_property_string) +#define mpv_set_property_string pfn_mpv_set_property_string +MPV_DEFINE_SYM_PTR(mpv_del_property) +#define mpv_del_property pfn_mpv_del_property +MPV_DEFINE_SYM_PTR(mpv_set_property_async) +#define mpv_set_property_async pfn_mpv_set_property_async +MPV_DEFINE_SYM_PTR(mpv_get_property) +#define mpv_get_property pfn_mpv_get_property +MPV_DEFINE_SYM_PTR(mpv_get_property_string) +#define mpv_get_property_string pfn_mpv_get_property_string +MPV_DEFINE_SYM_PTR(mpv_get_property_osd_string) +#define mpv_get_property_osd_string pfn_mpv_get_property_osd_string +MPV_DEFINE_SYM_PTR(mpv_get_property_async) +#define mpv_get_property_async pfn_mpv_get_property_async +MPV_DEFINE_SYM_PTR(mpv_observe_property) +#define mpv_observe_property pfn_mpv_observe_property +MPV_DEFINE_SYM_PTR(mpv_unobserve_property) +#define mpv_unobserve_property pfn_mpv_unobserve_property +MPV_DEFINE_SYM_PTR(mpv_event_name) +#define mpv_event_name pfn_mpv_event_name +MPV_DEFINE_SYM_PTR(mpv_event_to_node) +#define mpv_event_to_node pfn_mpv_event_to_node +MPV_DEFINE_SYM_PTR(mpv_request_event) +#define mpv_request_event pfn_mpv_request_event +MPV_DEFINE_SYM_PTR(mpv_request_log_messages) +#define mpv_request_log_messages pfn_mpv_request_log_messages +MPV_DEFINE_SYM_PTR(mpv_wait_event) +#define mpv_wait_event pfn_mpv_wait_event +MPV_DEFINE_SYM_PTR(mpv_wakeup) +#define mpv_wakeup pfn_mpv_wakeup +MPV_DEFINE_SYM_PTR(mpv_set_wakeup_callback) +#define mpv_set_wakeup_callback pfn_mpv_set_wakeup_callback +MPV_DEFINE_SYM_PTR(mpv_wait_async_requests) +#define mpv_wait_async_requests pfn_mpv_wait_async_requests +MPV_DEFINE_SYM_PTR(mpv_hook_add) +#define mpv_hook_add pfn_mpv_hook_add +MPV_DEFINE_SYM_PTR(mpv_hook_continue) +#define mpv_hook_continue pfn_mpv_hook_continue +MPV_DEFINE_SYM_PTR(mpv_get_wakeup_pipe) +#define mpv_get_wakeup_pipe pfn_mpv_get_wakeup_pipe + +#endif + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/vendor/mpv-headers/render.h b/vendor/mpv-headers/render.h new file mode 100644 index 0000000..862ffde --- /dev/null +++ b/vendor/mpv-headers/render.h @@ -0,0 +1,759 @@ +/* Copyright (C) 2018 the mpv developers + * + * Permission to use, copy, modify, and/or distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + */ + +#ifndef MPV_CLIENT_API_RENDER_H_ +#define MPV_CLIENT_API_RENDER_H_ + +#include "client.h" + +#ifdef __cplusplus +extern "C" { +#endif + +/** + * Overview + * -------- + * + * This API can be used to make mpv render using supported graphic APIs (such + * as OpenGL). It can be used to handle video display. + * + * The renderer needs to be created with mpv_render_context_create() before + * you start playback (or otherwise cause a VO to be created). Then (with most + * backends) mpv_render_context_render() can be used to explicitly render the + * current video frame. Use mpv_render_context_set_update_callback() to get + * notified when there is a new frame to draw. + * + * Preferably rendering should be done in a separate thread. If you call + * normal libmpv API functions on the renderer thread, deadlocks can result + * (these are made non-fatal with timeouts, but user experience will obviously + * suffer). See "Threading" section below. + * + * You can output and embed video without this API by setting the mpv "wid" + * option to a native window handle (see "Embedding the video window" section + * in the client.h header). In general, using the render API is recommended, + * because window embedding can cause various issues, especially with GUI + * toolkits and certain platforms. + * + * Supported backends + * ------------------ + * + * OpenGL: via MPV_RENDER_API_TYPE_OPENGL, see render_gl.h header. + * Software: via MPV_RENDER_API_TYPE_SW, see section "Software renderer" + * + * Threading + * --------- + * + * You are recommended to do rendering on a separate thread than normal libmpv + * use. + * + * The mpv_render_* functions can be called from any thread, under the + * following conditions: + * - only one of the mpv_render_* functions can be called at the same time + * (unless they belong to different mpv cores created by mpv_create()) + * - never can be called from within the callbacks set with + * mpv_set_wakeup_callback() or mpv_render_context_set_update_callback() + * - if the OpenGL backend is used, for all functions the OpenGL context + * must be "current" in the calling thread, and it must be the same OpenGL + * context as the mpv_render_context was created with. Otherwise, undefined + * behavior will occur. + * - the thread does not call libmpv API functions other than the mpv_render_* + * functions, except APIs which are declared as safe (see below). Likewise, + * there must be no lock or wait dependency from the render thread to a + * thread using other libmpv functions. Basically, the situation that your + * render thread waits for a "not safe" libmpv API function to return must + * not happen. If you ignore this requirement, deadlocks can happen, which + * are made non-fatal with timeouts; then playback quality will be degraded, + * and the message + * mpv_render_context_render() not being called or stuck. + * is logged. If you set MPV_RENDER_PARAM_ADVANCED_CONTROL, you promise that + * this won't happen, and must absolutely guarantee it, or a real deadlock + * will freeze the mpv core thread forever. + * + * libmpv functions which are safe to call from a render thread are: + * - functions marked with "Safe to be called from mpv render API threads." + * - client.h functions which don't have an explicit or implicit mpv_handle + * parameter + * - mpv_render_* functions; but only for the same mpv_render_context pointer. + * If the pointer is different, mpv_render_context_free() is not safe. (The + * reason is that if MPV_RENDER_PARAM_ADVANCED_CONTROL is set, it may have + * to process still queued requests from the core, which it can do only for + * the current context, while requests for other contexts would deadlock. + * Also, it may have to wait and block for the core to terminate the video + * chain to make sure no resources are used after context destruction.) + * - if the mpv_handle parameter refers to a different mpv core than the one + * you're rendering for (very obscure, but allowed) + * + * Note about old libmpv version: + * + * Before API version 1.105 (basically in mpv 0.29.x), simply enabling + * MPV_RENDER_PARAM_ADVANCED_CONTROL could cause deadlock issues. This can + * be worked around by setting the "vd-lavc-dr" option to "no". + * In addition, you were required to call all mpv_render*() API functions + * from the same thread on which mpv_render_context_create() was originally + * run (for the same the mpv_render_context). Not honoring it led to UB + * (deadlocks, use of invalid mp_thread handles), even if you moved your GL + * context to a different thread correctly. + * These problems were addressed in API version 1.105 (mpv 0.30.0). + * + * Context and handle lifecycle + * ---------------------------- + * + * Video initialization will fail if the render context was not initialized yet + * (with mpv_render_context_create()), or it will revert to a VO that creates + * its own window. + * + * Currently, there can be only 1 mpv_render_context at a time per mpv core. + * + * Calling mpv_render_context_free() while a VO is using the render context is + * active will disable video. + * + * You must free the context with mpv_render_context_free() before the mpv core + * is destroyed. If this doesn't happen, undefined behavior will result. + * + * Software renderer + * ----------------- + * + * MPV_RENDER_API_TYPE_SW provides an extremely simple (but slow) renderer to + * memory surfaces. You probably don't want to use this. Use other render API + * types, or other methods of video embedding. + * + * Use mpv_render_context_create() with MPV_RENDER_PARAM_API_TYPE set to + * MPV_RENDER_API_TYPE_SW. + * + * Call mpv_render_context_render() with various MPV_RENDER_PARAM_SW_* fields + * to render the video frame to an in-memory surface. The following fields are + * required: MPV_RENDER_PARAM_SW_SIZE, MPV_RENDER_PARAM_SW_FORMAT, + * MPV_RENDER_PARAM_SW_STRIDE, MPV_RENDER_PARAM_SW_POINTER. + * + * This method of rendering is very slow, because everything, including color + * conversion, scaling, and OSD rendering, is done on the CPU, single-threaded. + * In particular, large video or display sizes, as well as presence of OSD or + * subtitles can make it too slow for realtime. As with other software rendering + * VOs, setting "sw-fast" may help. Enabling or disabling zimg may help, + * depending on the platform. + * + * In addition, certain multimedia job creation measures like HDR may not work + * properly, and will have to be manually handled by for example inserting + * filters. + * + * This API is not really suitable to extract individual frames from video etc. + * (basically non-playback uses) - there are better libraries for this. It can + * be used this way, but it may be clunky and tricky. + * + * Further notes: + * - MPV_RENDER_PARAM_FLIP_Y is currently ignored (unsupported) + * - MPV_RENDER_PARAM_DEPTH is ignored (meaningless) + */ + +/** + * Opaque context, returned by mpv_render_context_create(). + */ +typedef struct mpv_render_context mpv_render_context; + +/** + * Parameters for mpv_render_param (which is used in a few places such as + * mpv_render_context_create(). + * + * Also see mpv_render_param for conventions and how to use it. + */ +typedef enum mpv_render_param_type { + /** + * Not a valid value, but also used to terminate a params array. Its value + * is always guaranteed to be 0 (even if the ABI changes in the future). + */ + MPV_RENDER_PARAM_INVALID = 0, + /** + * The render API to use. Valid for mpv_render_context_create(). + * + * Type: char* + * + * Defined APIs: + * + * MPV_RENDER_API_TYPE_OPENGL: + * OpenGL desktop 2.1 or later (preferably core profile compatible to + * OpenGL 3.2), or OpenGLES 2.0 or later. + * Providing MPV_RENDER_PARAM_OPENGL_INIT_PARAMS is required. + * It is expected that an OpenGL context is valid and "current" when + * calling mpv_render_* functions (unless specified otherwise). It + * must be the same context for the same mpv_render_context. + */ + MPV_RENDER_PARAM_API_TYPE = 1, + /** + * Required parameters for initializing the OpenGL renderer. Valid for + * mpv_render_context_create(). + * Type: mpv_opengl_init_params* + */ + MPV_RENDER_PARAM_OPENGL_INIT_PARAMS = 2, + /** + * Describes a GL render target. Valid for mpv_render_context_render(). + * Type: mpv_opengl_fbo* + */ + MPV_RENDER_PARAM_OPENGL_FBO = 3, + /** + * Control flipped rendering. Valid for mpv_render_context_render(). + * Type: int* + * If the value is set to 0, render normally. Otherwise, render it flipped, + * which is needed e.g. when rendering to an OpenGL default framebuffer + * (which has a flipped coordinate system). + */ + MPV_RENDER_PARAM_FLIP_Y = 4, + /** + * Control surface depth. Valid for mpv_render_context_render(). + * Type: int* + * This implies the depth of the surface passed to the render function in + * bits per channel. If omitted or set to 0, the renderer will assume 8. + * Typically used to control dithering. + */ + MPV_RENDER_PARAM_DEPTH = 5, + /** + * ICC profile blob. Valid for mpv_render_context_set_parameter(). + * Type: mpv_byte_array* + * Set an ICC profile for use with the "icc-profile-auto" option. (If the + * option is not enabled, the ICC data will not be used.) + */ + MPV_RENDER_PARAM_ICC_PROFILE = 6, + /** + * Ambient light in lux. Valid for mpv_render_context_set_parameter(). + * Type: int* + * This can be used for automatic gamma correction. + */ + MPV_RENDER_PARAM_AMBIENT_LIGHT = 7, + /** + * X11 Display, sometimes used for hwdec. Valid for + * mpv_render_context_create(). The Display must stay valid for the lifetime + * of the mpv_render_context. + * Type: Display* + */ + MPV_RENDER_PARAM_X11_DISPLAY = 8, + /** + * Wayland display, sometimes used for hwdec. Valid for + * mpv_render_context_create(). The wl_display must stay valid for the + * lifetime of the mpv_render_context. + * Type: struct wl_display* + */ + MPV_RENDER_PARAM_WL_DISPLAY = 9, + /** + * Better control about rendering and enabling some advanced features. Valid + * for mpv_render_context_create(). + * + * This conflates multiple requirements the API user promises to abide if + * this option is enabled: + * + * - The API user's render thread, which is calling the mpv_render_*() + * functions, never waits for the core. Otherwise deadlocks can happen. + * See "Threading" section. + * - The callback set with mpv_render_context_set_update_callback() can now + * be called even if there is no new frame. The API user should call the + * mpv_render_context_update() function, and interpret the return value + * for whether a new frame should be rendered. + * - Correct functionality is impossible if the update callback is not set, + * or not set soon enough after mpv_render_context_create() (the core can + * block while waiting for you to call mpv_render_context_update(), and + * if the update callback is not correctly set, it will deadlock, or + * block for too long). + * + * In general, setting this option will enable the following features (and + * possibly more): + * + * - "Direct rendering", which means the player decodes directly to a + * texture, which saves a copy per video frame ("vd-lavc-dr" option + * needs to be enabled, and the rendering backend as well as the + * underlying GPU API/driver needs to have support for it). + * - Rendering screenshots with the GPU API if supported by the backend + * (instead of using a suboptimal software fallback via libswscale). + * + * Warning: do not just add this without reading the "Threading" section + * above, and then wondering that deadlocks happen. The + * requirements are tricky. But also note that even if advanced + * control is disabled, not adhering to the rules will lead to + * playback problems. Enabling advanced controls simply makes + * violating these rules fatal. + * + * Type: int*: 0 for disable (default), 1 for enable + */ + MPV_RENDER_PARAM_ADVANCED_CONTROL = 10, + /** + * Return information about the next frame to render. Valid for + * mpv_render_context_get_info(). + * + * Type: mpv_render_frame_info* + * + * It strictly returns information about the _next_ frame. The implication + * is that e.g. mpv_render_context_update()'s return value will have + * MPV_RENDER_UPDATE_FRAME set, and the user is supposed to call + * mpv_render_context_render(). If there is no next frame, then the + * return value will have is_valid set to 0. + */ + MPV_RENDER_PARAM_NEXT_FRAME_INFO = 11, + /** + * Enable or disable video timing. Valid for mpv_render_context_render(). + * + * Type: int*: 0 for disable, 1 for enable (default) + * + * When video is timed to audio, the player attempts to render video a bit + * ahead, and then do a blocking wait until the target display time is + * reached. This blocks mpv_render_context_render() for up to the amount + * specified with the "video-timing-offset" global option. You can set + * this parameter to 0 to disable this kind of waiting. If you do, it's + * recommended to use the target time value in mpv_render_frame_info to + * wait yourself, or to set the "video-timing-offset" to 0 instead. + * + * Disabling this without doing anything in addition will result in A/V sync + * being slightly off. + */ + MPV_RENDER_PARAM_BLOCK_FOR_TARGET_TIME = 12, + /** + * Use to skip rendering in mpv_render_context_render(). + * + * Type: int*: 0 for rendering (default), 1 for skipping + * + * If this is set, you don't need to pass a target surface to the render + * function (and if you do, it's completely ignored). This can still call + * into the lower level APIs (i.e. if you use OpenGL, the OpenGL context + * must be set). + * + * Be aware that the render API will consider this frame as having been + * rendered. All other normal rules also apply, for example about whether + * you have to call mpv_render_context_report_swap(). It also does timing + * in the same way. + */ + MPV_RENDER_PARAM_SKIP_RENDERING = 13, + /** + * Deprecated. Not supported. Use MPV_RENDER_PARAM_DRM_DISPLAY_V2 instead. + * Type : struct mpv_opengl_drm_params* + */ + MPV_RENDER_PARAM_DRM_DISPLAY = 14, + /** + * DRM draw surface size, contains draw surface dimensions. + * Valid for mpv_render_context_create(). + * Type : struct mpv_opengl_drm_draw_surface_size* + */ + MPV_RENDER_PARAM_DRM_DRAW_SURFACE_SIZE = 15, + /** + * DRM display, contains drm display handles. + * Valid for mpv_render_context_create(). + * Type : struct mpv_opengl_drm_params_v2* + */ + MPV_RENDER_PARAM_DRM_DISPLAY_V2 = 16, + /** + * MPV_RENDER_API_TYPE_SW only: rendering target surface size, mandatory. + * Valid for MPV_RENDER_API_TYPE_SW & mpv_render_context_render(). + * Type: int[2] (e.g.: int s[2] = {w, h}; param.data = &s[0];) + * + * The video frame is transformed as with other VOs. Typically, this means + * the video gets scaled and black bars are added if the video size or + * aspect ratio mismatches with the target size. + */ + MPV_RENDER_PARAM_SW_SIZE = 17, + /** + * MPV_RENDER_API_TYPE_SW only: rendering target surface pixel format, + * mandatory. + * Valid for MPV_RENDER_API_TYPE_SW & mpv_render_context_render(). + * Type: char* (e.g.: char *f = "rgb0"; param.data = f;) + * + * Valid values are: + * "rgb0", "bgr0", "0bgr", "0rgb" + * 4 bytes per pixel RGB, 1 byte (8 bit) per component, component bytes + * with increasing address from left to right (e.g. "rgb0" has r at + * address 0), the "0" component contains uninitialized garbage (often + * the value 0, but not necessarily; the bad naming is inherited from + * FFmpeg) + * Pixel alignment size: 4 bytes + * "rgb24" + * 3 bytes per pixel RGB. This is strongly discouraged because it is + * very slow. + * Pixel alignment size: 1 bytes + * other + * The API may accept other pixel formats, using mpv internal format + * names, as long as it's internally marked as RGB, has exactly 1 + * plane, and is supported as conversion output. It is not a good idea + * to rely on any of these. Their semantics and handling could change. + */ + MPV_RENDER_PARAM_SW_FORMAT = 18, + /** + * MPV_RENDER_API_TYPE_SW only: rendering target surface bytes per line, + * mandatory. + * Valid for MPV_RENDER_API_TYPE_SW & mpv_render_context_render(). + * Type: size_t* + * + * This is the number of bytes between a pixel (x, y) and (x, y + 1) on the + * target surface. It must be a multiple of the pixel size, and have space + * for the surface width as specified by MPV_RENDER_PARAM_SW_SIZE. + * + * Both stride and pointer value should be a multiple of 64 to facilitate + * fast SIMD operation. Lower alignment might trigger slower code paths, + * and in the worst case, will copy the entire target frame. If mpv is built + * with zimg (and zimg is not disabled), the performance impact might be + * less. + * In either cases, the pointer and stride must be aligned at least to the + * pixel alignment size. Otherwise, crashes and undefined behavior is + * possible on platforms which do not support unaligned accesses (either + * through normal memory access or aligned SIMD memory access instructions). + */ + MPV_RENDER_PARAM_SW_STRIDE = 19, + /* + * MPV_RENDER_API_TYPE_SW only: rendering target surface pixel data pointer, + * mandatory. + * Valid for MPV_RENDER_API_TYPE_SW & mpv_render_context_render(). + * Type: void* + * + * This points to the first pixel at the left/top corner (0, 0). In + * particular, each line y starts at (pointer + stride * y). Upon rendering, + * all data between pointer and (pointer + stride * h) is overwritten. + * Whether the padding between (w, y) and (0, y + 1) is overwritten is left + * unspecified (it should not be, but unfortunately some scaler backends + * will do it anyway). It is assumed that even the padding after the last + * line (starting at bytepos(w, h) until (pointer + stride * h)) is + * writable. + * + * See MPV_RENDER_PARAM_SW_STRIDE for alignment requirements. + */ + MPV_RENDER_PARAM_SW_POINTER = 20, +} mpv_render_param_type; + +/** + * For backwards compatibility with the old naming of + * MPV_RENDER_PARAM_DRM_DRAW_SURFACE_SIZE + */ +#define MPV_RENDER_PARAM_DRM_OSD_SIZE MPV_RENDER_PARAM_DRM_DRAW_SURFACE_SIZE + +/** + * Used to pass arbitrary parameters to some mpv_render_* functions. The + * meaning of the data parameter is determined by the type, and each + * MPV_RENDER_PARAM_* documents what type the value must point to. + * + * Each value documents the required data type as the pointer you cast to + * void* and set on mpv_render_param.data. For example, if MPV_RENDER_PARAM_FOO + * documents the type as Something* , then the code should look like this: + * + * Something foo = {...}; + * mpv_render_param param; + * param.type = MPV_RENDER_PARAM_FOO; + * param.data = & foo; + * + * Normally, the data field points to exactly 1 object. If the type is char*, + * it points to a 0-terminated string. + * + * In all cases (unless documented otherwise) the pointers need to remain + * valid during the call only. Unless otherwise documented, the API functions + * will not write to the params array or any data pointed to it. + * + * As a convention, parameter arrays are always terminated by type==0. There + * is no specific order of the parameters required. The order of the 2 fields in + * this struct is guaranteed (even after ABI changes). + */ +typedef struct mpv_render_param { + enum mpv_render_param_type type; + void *data; +} mpv_render_param; + + +/** + * Predefined values for MPV_RENDER_PARAM_API_TYPE. + */ +// See render_gl.h +#define MPV_RENDER_API_TYPE_OPENGL "opengl" +// See section "Software renderer" +#define MPV_RENDER_API_TYPE_SW "sw" + +/** + * Flags used in mpv_render_frame_info.flags. Each value represents a bit in it. + */ +typedef enum mpv_render_frame_info_flag { + /** + * Set if there is actually a next frame. If unset, there is no next frame + * yet, and other flags and fields that require a frame to be queued will + * be unset. + * + * This is set for _any_ kind of frame, even for redraw requests. + * + * Note that when this is unset, it simply means no new frame was + * decoded/queued yet, not necessarily that the end of the video was + * reached. A new frame can be queued after some time. + * + * If the return value of mpv_render_context_render() had the + * MPV_RENDER_UPDATE_FRAME flag set, this flag will usually be set as well, + * unless the frame is rendered, or discarded by other asynchronous events. + */ + MPV_RENDER_FRAME_INFO_PRESENT = 1 << 0, + /** + * If set, the frame is not an actual new video frame, but a redraw request. + * For example if the video is paused, and an option that affects video + * rendering was changed (or any other reason), an update request can be + * issued and this flag will be set. + * + * Typically, redraw frames will not be subject to video timing. + * + * Implies MPV_RENDER_FRAME_INFO_PRESENT. + */ + MPV_RENDER_FRAME_INFO_REDRAW = 1 << 1, + /** + * If set, this is supposed to reproduce the previous frame perfectly. This + * is usually used for certain "video-sync" options ("display-..." modes). + * Typically the renderer will blit the video from a FBO. Unset otherwise. + * + * Implies MPV_RENDER_FRAME_INFO_PRESENT. + */ + MPV_RENDER_FRAME_INFO_REPEAT = 1 << 2, + /** + * If set, the player timing code expects that the user thread blocks on + * vsync (by either delaying the render call, or by making a call to + * mpv_render_context_report_swap() at vsync time). + * + * Implies MPV_RENDER_FRAME_INFO_PRESENT. + */ + MPV_RENDER_FRAME_INFO_BLOCK_VSYNC = 1 << 3, +} mpv_render_frame_info_flag; + +/** + * Information about the next video frame that will be rendered. Can be + * retrieved with MPV_RENDER_PARAM_NEXT_FRAME_INFO. + */ +typedef struct mpv_render_frame_info { + /** + * A bitset of mpv_render_frame_info_flag values (i.e. multiple flags are + * combined with bitwise or). + */ + uint64_t flags; + /** + * Absolute time at which the frame is supposed to be displayed. This is in + * the same unit and base as the time returned by mpv_get_time_us(). For + * frames that are redrawn, or if vsync locked video timing is used (see + * "video-sync" option), then this can be 0. The "video-timing-offset" + * option determines how much "headroom" the render thread gets (but a high + * enough frame rate can reduce it anyway). mpv_render_context_render() will + * normally block until the time is elapsed, unless you pass it + * MPV_RENDER_PARAM_BLOCK_FOR_TARGET_TIME = 0. + */ + int64_t target_time; +} mpv_render_frame_info; + +/** + * Initialize the renderer state. Depending on the backend used, this will + * access the underlying GPU API and initialize its own objects. + * + * You must free the context with mpv_render_context_free(). Not doing so before + * the mpv core is destroyed may result in memory leaks or crashes. + * + * Currently, only at most 1 context can exists per mpv core (it represents the + * main video output). + * + * You should pass the following parameters: + * - MPV_RENDER_PARAM_API_TYPE to select the underlying backend/GPU API. + * - Backend-specific init parameter, like MPV_RENDER_PARAM_OPENGL_INIT_PARAMS. + * - Setting MPV_RENDER_PARAM_ADVANCED_CONTROL and following its rules is + * strongly recommended. + * - If you want to use hwdec, possibly hwdec interop resources. + * + * @param res set to the context (on success) or NULL (on failure). The value + * is never read and always overwritten. + * @param mpv handle used to get the core (the mpv_render_context won't depend + * on this specific handle, only the core referenced by it) + * @param params an array of parameters, terminated by type==0. It's left + * unspecified what happens with unknown parameters. At least + * MPV_RENDER_PARAM_API_TYPE is required, and most backends will + * require another backend-specific parameter. + * @return error code, including but not limited to: + * MPV_ERROR_UNSUPPORTED: the OpenGL version is not supported + * (or required extensions are missing) + * MPV_ERROR_NOT_IMPLEMENTED: an unknown API type was provided, or + * support for the requested API was not + * built in the used libmpv binary. + * MPV_ERROR_INVALID_PARAMETER: at least one of the provided parameters was + * not valid. + */ +MPV_EXPORT int mpv_render_context_create(mpv_render_context **res, mpv_handle *mpv, + mpv_render_param *params); + +/** + * Attempt to change a single parameter. Not all backends and parameter types + * support all kinds of changes. + * + * @param ctx a valid render context + * @param param the parameter type and data that should be set + * @return error code. If a parameter could actually be changed, this returns + * success, otherwise an error code depending on the parameter type + * and situation. + */ +MPV_EXPORT int mpv_render_context_set_parameter(mpv_render_context *ctx, + mpv_render_param param); + +/** + * Retrieve information from the render context. This is NOT a counterpart to + * mpv_render_context_set_parameter(), because you generally can't read + * parameters set with it, and this function is not meant for this purpose. + * Instead, this is for communicating information from the renderer back to the + * user. See mpv_render_param_type; entries which support this function + * explicitly mention it, and for other entries you can assume it will fail. + * + * You pass param with param.type set and param.data pointing to a variable + * of the required data type. The function will then overwrite that variable + * with the returned value (at least on success). + * + * @param ctx a valid render context + * @param param the parameter type and data that should be retrieved + * @return error code. If a parameter could actually be retrieved, this returns + * success, otherwise an error code depending on the parameter type + * and situation. MPV_ERROR_NOT_IMPLEMENTED is used for unknown + * param.type, or if retrieving it is not supported. + */ +MPV_EXPORT int mpv_render_context_get_info(mpv_render_context *ctx, + mpv_render_param param); + +typedef void (*mpv_render_update_fn)(void *cb_ctx); + +/** + * Set the callback that notifies you when a new video frame is available, or + * if the video display configuration somehow changed and requires a redraw. + * Similar to mpv_set_wakeup_callback(), you must not call any mpv API from + * the callback, and all the other listed restrictions apply (such as not + * exiting the callback by throwing exceptions). + * + * This can be called from any thread, except from an update callback. In case + * of the OpenGL backend, no OpenGL state or API is accessed. + * + * Calling this will raise an update callback immediately. + * + * @param callback callback(callback_ctx) is called if the frame should be + * redrawn + * @param callback_ctx opaque argument to the callback + */ +MPV_EXPORT void mpv_render_context_set_update_callback(mpv_render_context *ctx, + mpv_render_update_fn callback, + void *callback_ctx); + +/** + * The API user is supposed to call this when the update callback was invoked + * (like all mpv_render_* functions, this has to happen on the render thread, + * and _not_ from the update callback itself). + * + * This is optional if MPV_RENDER_PARAM_ADVANCED_CONTROL was not set (default). + * Otherwise, it's a hard requirement that this is called after each update + * callback. If multiple update callback happened, and the function could not + * be called sooner, it's OK to call it once after the last callback. + * + * If an update callback happens during or after this function, the function + * must be called again at the soonest possible time. + * + * If MPV_RENDER_PARAM_ADVANCED_CONTROL was set, this will do additional work + * such as allocating textures for the video decoder. + * + * @return a bitset of mpv_render_update_flag values (i.e. multiple flags are + * combined with bitwise or). Typically, this will tell the API user + * what should happen next. E.g. if the MPV_RENDER_UPDATE_FRAME flag is + * set, mpv_render_context_render() should be called. If flags unknown + * to the API user are set, or if the return value is 0, nothing needs + * to be done. + */ +MPV_EXPORT uint64_t mpv_render_context_update(mpv_render_context *ctx); + +/** + * Flags returned by mpv_render_context_update(). Each value represents a bit + * in the function's return value. + */ +typedef enum mpv_render_update_flag { + /** + * A new video frame must be rendered. mpv_render_context_render() must be + * called. + */ + MPV_RENDER_UPDATE_FRAME = 1 << 0, +} mpv_render_context_flag; + +/** + * Render video. + * + * Typically renders the video to a target surface provided via mpv_render_param + * (the details depend on the backend in use). Options like "panscan" are + * applied to determine which part of the video should be visible and how the + * video should be scaled. You can change these options at runtime by using the + * mpv property API. + * + * The renderer will reconfigure itself every time the target surface + * configuration (such as size) is changed. + * + * This function implicitly pulls a video frame from the internal queue and + * renders it. If no new frame is available, the previous frame is redrawn. + * The update callback set with mpv_render_context_set_update_callback() + * notifies you when a new frame was added. The details potentially depend on + * the backends and the provided parameters. + * + * Generally, libmpv will invoke your update callback some time before the video + * frame should be shown, and then lets this function block until the supposed + * display time. This will limit your rendering to video FPS. You can prevent + * this by setting the "video-timing-offset" global option to 0. (This applies + * only to "audio" video sync mode.) + * + * You should pass the following parameters: + * - Backend-specific target object, such as MPV_RENDER_PARAM_OPENGL_FBO. + * - Possibly transformations, such as MPV_RENDER_PARAM_FLIP_Y. + * + * @param ctx a valid render context + * @param params an array of parameters, terminated by type==0. Which parameters + * are required depends on the backend. It's left unspecified what + * happens with unknown parameters. + * @return error code + */ +MPV_EXPORT int mpv_render_context_render(mpv_render_context *ctx, mpv_render_param *params); + +/** + * Tell the renderer that a frame was flipped at the given time. This is + * optional, but can help the player to achieve better timing. + * + * Note that calling this at least once informs libmpv that you will use this + * function. If you use it inconsistently, expect bad video playback. + * + * If this is called while no video is initialized, it is ignored. + * + * @param ctx a valid render context + */ +MPV_EXPORT void mpv_render_context_report_swap(mpv_render_context *ctx); + +/** + * Destroy the mpv renderer state. + * + * If video is still active (e.g. a file playing), video will be disabled + * forcefully. + * + * @param ctx a valid render context. After this function returns, this is not + * a valid pointer anymore. NULL is also allowed and does nothing. + */ +MPV_EXPORT void mpv_render_context_free(mpv_render_context *ctx); + +#ifdef MPV_CPLUGIN_DYNAMIC_SYM + +MPV_DEFINE_SYM_PTR(mpv_render_context_create) +#define mpv_render_context_create pfn_mpv_render_context_create +MPV_DEFINE_SYM_PTR(mpv_render_context_set_parameter) +#define mpv_render_context_set_parameter pfn_mpv_render_context_set_parameter +MPV_DEFINE_SYM_PTR(mpv_render_context_get_info) +#define mpv_render_context_get_info pfn_mpv_render_context_get_info +MPV_DEFINE_SYM_PTR(mpv_render_context_set_update_callback) +#define mpv_render_context_set_update_callback pfn_mpv_render_context_set_update_callback +MPV_DEFINE_SYM_PTR(mpv_render_context_update) +#define mpv_render_context_update pfn_mpv_render_context_update +MPV_DEFINE_SYM_PTR(mpv_render_context_render) +#define mpv_render_context_render pfn_mpv_render_context_render +MPV_DEFINE_SYM_PTR(mpv_render_context_report_swap) +#define mpv_render_context_report_swap pfn_mpv_render_context_report_swap +MPV_DEFINE_SYM_PTR(mpv_render_context_free) +#define mpv_render_context_free pfn_mpv_render_context_free + +#endif + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/vendor/mpv-headers/render_gl.h b/vendor/mpv-headers/render_gl.h new file mode 100644 index 0000000..a2c31f0 --- /dev/null +++ b/vendor/mpv-headers/render_gl.h @@ -0,0 +1,211 @@ +/* Copyright (C) 2018 the mpv developers + * + * Permission to use, copy, modify, and/or distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + */ + +#ifndef MPV_CLIENT_API_RENDER_GL_H_ +#define MPV_CLIENT_API_RENDER_GL_H_ + +#include "render.h" + +#ifdef __cplusplus +extern "C" { +#endif + +/** + * OpenGL backend + * -------------- + * + * This header contains definitions for using OpenGL with the render.h API. + * + * OpenGL interop + * -------------- + * + * The OpenGL backend has some special rules, because OpenGL itself uses + * implicit per-thread contexts, which causes additional API problems. + * + * This assumes the OpenGL context lives on a certain thread controlled by the + * API user. All mpv_render_* APIs have to be assumed to implicitly use the + * OpenGL context if you pass a mpv_render_context using the OpenGL backend, + * unless specified otherwise. + * + * The OpenGL context is indirectly accessed through the OpenGL function + * pointers returned by the get_proc_address callback in mpv_opengl_init_params. + * Generally, mpv will not load the system OpenGL library when using this API. + * + * OpenGL state + * ------------ + * + * OpenGL has a large amount of implicit state. All the mpv functions mentioned + * above expect that the OpenGL state is reasonably set to OpenGL standard + * defaults. Likewise, mpv will attempt to leave the OpenGL context with + * standard defaults. The following state is excluded from this: + * + * - the glViewport state + * - the glScissor state (but GL_SCISSOR_TEST is in its default value) + * - glBlendFuncSeparate() state (but GL_BLEND is in its default value) + * - glClearColor() state + * - mpv may overwrite the callback set with glDebugMessageCallback() + * - mpv always disables GL_DITHER at init + * + * Messing with the state could be avoided by creating shared OpenGL contexts, + * but this is avoided for the sake of compatibility and interoperability. + * + * On OpenGL 2.1, mpv will strictly call functions like glGenTextures() to + * create OpenGL objects. You will have to do the same. This ensures that + * objects created by mpv and the API users don't clash. Also, legacy state + * must be either in its defaults, or not interfere with core state. + * + * API use + * ------- + * + * The mpv_render_* API is used. That API supports multiple backends, and this + * section documents specifics for the OpenGL backend. + * + * Use mpv_render_context_create() with MPV_RENDER_PARAM_API_TYPE set to + * MPV_RENDER_API_TYPE_OPENGL, and MPV_RENDER_PARAM_OPENGL_INIT_PARAMS provided. + * + * Call mpv_render_context_render() with MPV_RENDER_PARAM_OPENGL_FBO to render + * the video frame to an FBO. + * + * Hardware decoding + * ----------------- + * + * Hardware decoding via this API is fully supported, but requires some + * additional setup. (At least if direct hardware decoding modes are wanted, + * instead of copying back surface data from GPU to CPU RAM.) + * + * There may be certain requirements on the OpenGL implementation: + * + * - Windows: ANGLE is required (although in theory GL/DX interop could be used) + * - Intel/Linux: EGL is required, and also the native display resource needs + * to be provided (e.g. MPV_RENDER_PARAM_X11_DISPLAY for X11 and + * MPV_RENDER_PARAM_WL_DISPLAY for Wayland) + * - nVidia/Linux: Both GLX and EGL should work (GLX is required if vdpau is + * used, e.g. due to old drivers.) + * - OSX: CGL is required (CGLGetCurrentContext() returning non-NULL) + * - iOS: EAGL is required (EAGLContext.currentContext returning non-nil) + * + * Once these things are setup, hardware decoding can be enabled/disabled at + * any time by setting the "hwdec" property. + */ + +/** + * For initializing the mpv OpenGL state via MPV_RENDER_PARAM_OPENGL_INIT_PARAMS. + */ +typedef struct mpv_opengl_init_params { + /** + * This retrieves OpenGL function pointers, and will use them in subsequent + * operation. + * Usually, you can simply call the GL context APIs from this callback (e.g. + * glXGetProcAddressARB or wglGetProcAddress), but some APIs do not always + * return pointers for all standard functions (even if present); in this + * case you have to compensate by looking up these functions yourself when + * libmpv wants to resolve them through this callback. + * libmpv will not normally attempt to resolve GL functions on its own, nor + * does it link to GL libraries directly. + */ + void *(*get_proc_address)(void *ctx, const char *name); + /** + * Value passed as ctx parameter to get_proc_address(). + */ + void *get_proc_address_ctx; +} mpv_opengl_init_params; + +/** + * For MPV_RENDER_PARAM_OPENGL_FBO. + */ +typedef struct mpv_opengl_fbo { + /** + * Framebuffer object name. This must be either a valid FBO generated by + * glGenFramebuffers() that is complete and color-renderable, or 0. If the + * value is 0, this refers to the OpenGL default framebuffer. + */ + int fbo; + /** + * Valid dimensions. This must refer to the size of the framebuffer. This + * must always be set. + */ + int w, h; + /** + * Underlying texture internal format (e.g. GL_RGBA8), or 0 if unknown. If + * this is the default framebuffer, this can be an equivalent. + */ + int internal_format; +} mpv_opengl_fbo; + +/** + * Deprecated. For MPV_RENDER_PARAM_DRM_DISPLAY. + */ +typedef struct mpv_opengl_drm_params { + int fd; + int crtc_id; + int connector_id; + struct _drmModeAtomicReq **atomic_request_ptr; + int render_fd; +} mpv_opengl_drm_params; + +/** + * For MPV_RENDER_PARAM_DRM_DRAW_SURFACE_SIZE. + */ +typedef struct mpv_opengl_drm_draw_surface_size { + /** + * size of the draw plane surface in pixels. + */ + int width, height; +} mpv_opengl_drm_draw_surface_size; + +/** + * For MPV_RENDER_PARAM_DRM_DISPLAY_V2. + */ +typedef struct mpv_opengl_drm_params_v2 { + /** + * DRM fd (int). Set to -1 if invalid. + */ + int fd; + + /** + * Currently used crtc id + */ + int crtc_id; + + /** + * Currently used connector id + */ + int connector_id; + + /** + * Pointer to a drmModeAtomicReq pointer that is being used for the renderloop. + * This pointer should hold a pointer to the atomic request pointer + * The atomic request pointer is usually changed at every renderloop. + */ + struct _drmModeAtomicReq **atomic_request_ptr; + + /** + * DRM render node. Used for VAAPI interop. + * Set to -1 if invalid. + */ + int render_fd; +} mpv_opengl_drm_params_v2; + + +/** + * For backwards compatibility with the old naming of mpv_opengl_drm_draw_surface_size + */ +#define mpv_opengl_drm_osd_size mpv_opengl_drm_draw_surface_size + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/vendor/mpv-headers/stream_cb.h b/vendor/mpv-headers/stream_cb.h new file mode 100644 index 0000000..9ae6f31 --- /dev/null +++ b/vendor/mpv-headers/stream_cb.h @@ -0,0 +1,247 @@ +/* Copyright (C) 2017 the mpv developers + * + * Permission to use, copy, modify, and/or distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + */ + +#ifndef MPV_CLIENT_API_STREAM_CB_H_ +#define MPV_CLIENT_API_STREAM_CB_H_ + +#include "client.h" + +#ifdef __cplusplus +extern "C" { +#endif + +/** + * Warning: this API is not stable yet. + * + * Overview + * -------- + * + * This API can be used to make mpv read from a stream with a custom + * implementation. This interface is inspired by funopen on BSD and + * fopencookie on linux. The stream is backed by user-defined callbacks + * which can implement customized open, read, seek, size and close behaviors. + * + * Usage + * ----- + * + * Register your stream callbacks with the mpv_stream_cb_add_ro() function. You + * have to provide a mpv_stream_cb_open_ro_fn callback to it (open_fn argument). + * + * Once registered, you can `loadfile myprotocol://myfile`. Your open_fn will be + * invoked with the URI and you must fill out the provided mpv_stream_cb_info + * struct. This includes your stream callbacks (like read_fn), and an opaque + * cookie, which will be passed as the first argument to all the remaining + * stream callbacks. + * + * Note that your custom callbacks must not invoke libmpv APIs as that would + * cause a deadlock. (Unless you call a different mpv_handle than the one the + * callback was registered for, and the mpv_handles refer to different mpv + * instances.) + * + * Stream lifetime + * --------------- + * + * A stream remains valid until its close callback has been called. It's up to + * libmpv to call the close callback, and the libmpv user cannot close it + * directly with the stream_cb API. + * + * For example, if you consider your custom stream to become suddenly invalid + * (maybe because the underlying stream died), libmpv will continue using your + * stream. All you can do is returning errors from each callback, until libmpv + * gives up and closes it. + * + * Protocol registration and lifetime + * ---------------------------------- + * + * Protocols remain registered until the mpv instance is terminated. This means + * in particular that it can outlive the mpv_handle that was used to register + * it, but once mpv_terminate_destroy() is called, your registered callbacks + * will not be called again. + * + * Protocol unregistration is finished after the mpv core has been destroyed + * (e.g. after mpv_terminate_destroy() has returned). + * + * If you do not call mpv_terminate_destroy() yourself (e.g. plugin-style code), + * you will have to deal with the registration or even streams outliving your + * code. Here are some possible ways to do this: + * - call mpv_terminate_destroy(), which destroys the core, and will make sure + * all streams are closed once this function returns + * - you refcount all resources your stream "cookies" reference, so that it + * doesn't matter if streams live longer than expected + * - create "cancellation" semantics: after your protocol has been unregistered, + * notify all your streams that are still opened, and make them drop all + * referenced resources - then return errors from the stream callbacks as + * long as the stream is still opened + * + */ + +/** + * Read callback used to implement a custom stream. The semantics of the + * callback match read(2) in blocking mode. Short reads are allowed (you can + * return less bytes than requested, and libmpv will retry reading the rest + * with another call). If no data can be immediately read, the callback must + * block until there is new data. A return of 0 will be interpreted as final + * EOF, although libmpv might retry the read, or seek to a different position. + * + * @param cookie opaque cookie identifying the stream, + * returned from mpv_stream_cb_open_fn + * @param buf buffer to read data into + * @param size of the buffer + * @return number of bytes read into the buffer + * @return 0 on EOF + * @return -1 on error + */ +typedef int64_t (*mpv_stream_cb_read_fn)(void *cookie, char *buf, uint64_t nbytes); + +/** + * Seek callback used to implement a custom stream. + * + * Note that mpv will issue a seek to position 0 immediately after opening. This + * is used to test whether the stream is seekable (since seekability might + * depend on the URI contents, not just the protocol). Return + * MPV_ERROR_UNSUPPORTED if seeking is not implemented for this stream. This + * seek also serves to establish the fact that streams start at position 0. + * + * This callback can be NULL, in which it behaves as if always returning + * MPV_ERROR_UNSUPPORTED. + * + * @param cookie opaque cookie identifying the stream, + * returned from mpv_stream_cb_open_fn + * @param offset target absolute stream position + * @return the resulting offset of the stream + * MPV_ERROR_UNSUPPORTED or MPV_ERROR_GENERIC if the seek failed + */ +typedef int64_t (*mpv_stream_cb_seek_fn)(void *cookie, int64_t offset); + +/** + * Size callback used to implement a custom stream. + * + * Return MPV_ERROR_UNSUPPORTED if no size is known. + * + * This callback can be NULL, in which it behaves as if always returning + * MPV_ERROR_UNSUPPORTED. + * + * @param cookie opaque cookie identifying the stream, + * returned from mpv_stream_cb_open_fn + * @return the total size in bytes of the stream + */ +typedef int64_t (*mpv_stream_cb_size_fn)(void *cookie); + +/** + * Close callback used to implement a custom stream. + * + * @param cookie opaque cookie identifying the stream, + * returned from mpv_stream_cb_open_fn + */ +typedef void (*mpv_stream_cb_close_fn)(void *cookie); + +/** + * Cancel callback used to implement a custom stream. + * + * This callback is used to interrupt any current or future read and seek + * operations. It will be called from a separate thread than the demux + * thread, and should not block. + * + * This callback can be NULL. + * + * Available since API 1.106. + * + * @param cookie opaque cookie identifying the stream, + * returned from mpv_stream_cb_open_fn + */ +typedef void (*mpv_stream_cb_cancel_fn)(void *cookie); + +/** + * See mpv_stream_cb_open_ro_fn callback. + */ +typedef struct mpv_stream_cb_info { + /** + * Opaque user-provided value, which will be passed to the other callbacks. + * The close callback will be called to release the cookie. It is not + * interpreted by mpv. It doesn't even need to be a valid pointer. + * + * The user sets this in the mpv_stream_cb_open_ro_fn callback. + */ + void *cookie; + + /** + * Callbacks set by the user in the mpv_stream_cb_open_ro_fn callback. Some + * of them are optional, and can be left unset. + * + * The following callbacks are mandatory: read_fn, close_fn + */ + mpv_stream_cb_read_fn read_fn; + mpv_stream_cb_seek_fn seek_fn; + mpv_stream_cb_size_fn size_fn; + mpv_stream_cb_close_fn close_fn; + mpv_stream_cb_cancel_fn cancel_fn; /* since API 1.106 */ +} mpv_stream_cb_info; + +/** + * Open callback used to implement a custom read-only (ro) stream. The user + * must set the callback fields in the passed info struct. The cookie field + * also can be set to store state associated to the stream instance. + * + * Note that the info struct is valid only for the duration of this callback. + * You can't change the callbacks or the pointer to the cookie at a later point. + * + * Each stream instance created by the open callback can have different + * callbacks. + * + * The close_fn callback will terminate the stream instance. The pointers to + * your callbacks and cookie will be discarded, and the callbacks will not be + * called again. + * + * @param user_data opaque user data provided via mpv_stream_cb_add() + * @param uri name of the stream to be opened (with protocol prefix) + * @param info fields which the user should fill + * @return 0 on success, MPV_ERROR_LOADING_FAILED if the URI cannot be opened. + */ +typedef int (*mpv_stream_cb_open_ro_fn)(void *user_data, char *uri, + mpv_stream_cb_info *info); + +/** + * Add a custom stream protocol. This will register a protocol handler under + * the given protocol prefix, and invoke the given callbacks if an URI with the + * matching protocol prefix is opened. + * + * The "ro" is for read-only - only read-only streams can be registered with + * this function. + * + * The callback remains registered until the mpv core is registered. + * + * If a custom stream with the same name is already registered, then the + * MPV_ERROR_INVALID_PARAMETER error is returned. + * + * @param protocol protocol prefix, for example "foo" for "foo://" URIs + * @param user_data opaque pointer passed into the mpv_stream_cb_open_fn + * callback. + * @return error code + */ +MPV_EXPORT int mpv_stream_cb_add_ro(mpv_handle *ctx, const char *protocol, void *user_data, + mpv_stream_cb_open_ro_fn open_fn); + +#ifdef MPV_CPLUGIN_DYNAMIC_SYM + +MPV_DEFINE_SYM_PTR(mpv_stream_cb_add_ro) +#define mpv_stream_cb_add_ro pfn_mpv_stream_cb_add_ro + +#endif + +#ifdef __cplusplus +} +#endif + +#endif