diff --git a/.gitignore b/.gitignore index a13d191..dc3df30 100644 --- a/.gitignore +++ b/.gitignore @@ -51,6 +51,9 @@ shot*.png /tests/lfmcheck/lfmcheck /tests/lfmcheck/units/ +# Снимок, который делает проверка масштаба таймлайна. +/tests/кадры-зума.png + # Проверка хода полоски: двоичный файл и промежуточные модули. /tests/progress/progtest /tests/progress/*.o diff --git a/BACKLOG.md b/BACKLOG.md index 07a84cf..ec4b089 100644 --- a/BACKLOG.md +++ b/BACKLOG.md @@ -76,28 +76,77 @@ ffmpeg проблемой не является: он запускается о MP4/H.264 нельзя — контейнер и кодек альфу не хранят. Для этого нужен отдельный вывод в VP9 или ProRes 4444. -## Предпросмотр не показывает кадрирование обычного клипа +## Предпросмотр: чего он про кадрирование всё ещё не показывает -Кадрирование и поворот видны в окне только у клипов с ключом или -прозрачностью: их плеер кладёт поверх основы сам и применяет к ним -цепочку фильтров. Обычный клип идёт списком кусков, а список фильтровать -нечем — он играется как есть, во весь кадр. В готовом ролике при этом всё -верно: такой кусок помечен на пересборку и обкладывается полями. +Кадрирование обычного клипа окно теперь показывает — обрезкой на выводе +плеера, её делает видеокарта даром. Остались три случая, где оно +по-прежнему играется как есть, и для них точную картинку даёт окно +«Кадрирование и поворот»: -Проверено опытом: у клипа выключен только ключ, кадрирование оставлено — -окно показывает его во весь кадр. +**Отражение.** У вывода mpv нет свойства для отражения, только для +поворота. Понадобится — придётся вести такой клип через цепочку. -Как это делается тем же механизмом, что и наложение: провести такой клип -через ту же дорожку наложения, а под ним заставить основу быть чёрной — -непрозрачный клип с полями в готовом ролике именно так и закрывает всё, -что ниже. Значит, уплощению нужно понятие «здесь дыра, даже если ниже -что-то есть». +**Растяжение.** Кадр жмётся неравномерно, рамкой это не описать. -Чего это стоит: ветка масштабирования в цепочке работает на каждом кадре, -а не только там, где клип виден. Для накладки в 512 точек это пустяк, для -куска 2688x1512 — уже нет. Поэтому сначала замер, потом решение. +**Участок с наложением.** Там кадр уже сведён цепочкой, и обрезка на +выводе резала бы сведённое целиком, вместе с нижним слоем. Такой клип +нужно вести через ту же цепочку, что и само наложение. -## Окно настроек программы +Цена пути через цепочку известна, мерили (DJI 2688x1512, HEVC +55 Мбит/с, 600 кадров, `--vo=null`): + +| | время | кадров в секунду | +|---|---|---| +| без фильтра | 1.82 с | 330 | +| ветка «обрезать и растянуть» с `enable` | 2.81 с | 214 | + +Нужно 60, то есть запас трёхкратный: по деньгам проходит. Устроена она +так: раздвоить поток, одну ветку обрезать и растянуть, и наложить её на +другую с `enable='between(t,...)'`. Иначе никак — из фильтров ffmpeg по +времени переключается только `overlay`, у `crop` и `scale` поддержки +временной шкалы нет. + +## Два видео рядом в одном кадре + +Два ролика 16:9, каждый обрезан до половины кадра: один слева до +середины, другой от середины вправо. Никакого смешивания, просто два +куска рядом. + +Сборке для этого не нужно ничего нового — только числа. Проверено на +настоящих файлах, кадр получается с первого раза: + + [0:v]crop=1344:1512:672:0,pad=2688:1512:0:0,setsar=1[l]; + [1:v]crop=1344:1512:672:0,setsar=1[r]; + [l][r]overlay=1344:0[out] + +То есть каждому источнику своя обрезка, затем оба кладутся на свои места. +Именно такой граф и строит `ArgsRenderLayers`: у слоя уже есть и своя +цепочка фильтров, и координаты, куда его положить. + +Не хватает трёх вещей, и первая — главная. + +**Клипу негде записать, какое место в кадре он занимает.** Преобразование +сейчас описывает только, как источник ложится в кадр целиком: вписать, +заполнить с обрезкой, увеличение, смещение, поворот. Масштаб при этом +всегда равномерный, поэтому из кадра 2688x1512 никакими настройками не +получить полосу 1344x1512 — для неё нужно сжать вдвое по ширине и не +трогать высоту. Нужен прямоугольник назначения: четыре числа в долях +кадра проекта. Тогда всё остальное — вписывание, увеличение, смещение — +начинает работать внутри него, а `BuildTransform` меняется только в +аргументах: размер прямоугольника вместо размера кадра, а возвращаемые +координаты сдвигаются на его начало. + +**Уплощение считает непрозрачный клип закрывающим всё.** Нижний клип +подхватывается, только когда верхний полупрозрачный или с ключом. Значит +половинка на верхней дорожке сегодня закроет собой нижнее видео чёрными +полями. Условие должно смотреть на прямоугольник назначения: не накрывает +кадр — значит под ним видно то, что ниже. + +**Предпросмотру нужна вторая дорожка наложения.** Сейчас плеер добавляет +одну: основа — список кусков, поверх неё одна внешняя дорожка. Для двух +половинок обе должны идти через цепочку над чёрной основой, то есть +внешних дорожек нужно две. Механика та же самая — ещё один `video-add` и +ещё один вход `[vidN]` в цепочке. Переключателей, которые стоят машинного времени, становится больше, а живут они кто где: прилипание и схлопывание — кнопками внизу, ключ в @@ -119,6 +168,35 @@ NVENC, если он есть). Это разрозненно и не даёт неподъёмным. Пока цифры замеряны только на одной машине, у человека должна быть возможность выключить любую из этих трат. +## Сборка потоком: чего она не даёт + +Ролик собирается потоком — куски идут сразу в готовый файл, кэш не +создаётся. За это заплачено тремя вещами, и все три известны заранее. + +**Продолжение стоит места.** Дописать в конец существующего MKV нельзя: +Matroska этого не даёт. Продолжение всегда пишется в новый файл, куда +сперва переливается целая часть старого, так что на диске в этот момент +лежат оба — места нужно вдвое больше готового ролика. Обойти это можно +только разбором и правкой самого контейнера, а это уже своя маленькая +библиотека Matroska. + +**Отступ назад — до целого куска.** Продолжают не с последнего +записанного кадра, а с границы последнего целого куска: кусок — это +неделимая единица, у него свои метки времени и своё число кадров. На +замерах терялось от нуля до нескольких секунд работы. Мельче отступать +можно было бы, храня рядом с файлом карту стыков, но выигрыш в секундах +не стоит нового файла, который надо держать в согласии с роликом. + +**MP4 продолжать нельзя вовсе.** Оглавление пишется в конец, оборванный +файл не открывается — `moov atom not found`. Программа предупреждает об +этом до начала сборки и предлагает MKV. Теоретически недописанный MP4 +можно восстановить, собрав оглавление по кускам самому (так делают +untrunc и подобные), но это отдельная задача другого размера. + +**Потоком идёт не всё.** MPEG-TS несёт не любой кодек, и пересборка +всего ролика под площадку требует списка кусков. В этих случаях сборка +идёт по-старому, через кэш — со всеми его 110 ГБ на часе материала. + ## Мелочи, до которых не дошли руки **Вид дорожки не виден в её заголовке.** Дорожки картинки, звука и текста diff --git a/README.md b/README.md index 9fb31d1..81bbc3b 100644 --- a/README.md +++ b/README.md @@ -76,13 +76,15 @@ xdg-mime query default application/x-nlve-project |---|---| | Пуск и пауза | Пробел | | В начало / конец монтажа | Home / End | -| Разрезать по курсору | S | -| Разрезать точно (перекодирует стык) | Shift+S | +| Показать, где курсор (окно едет к нему) | \ | +| Разрезать по курсору (все дорожки) | S | | Удалить выделенное | Delete | | Выделить всё | Ctrl+A | +| Выделить областью | протяжка по пустому месту дорожек | +| Режим выделения: рамкой или по времени | D | | Схлопнуть дыру под курсором | Ctrl+Shift+R | | Отменить, повторить | Ctrl+Z, Ctrl+Y | -| Масштаб таймлайна | Ctrl + колесо мыши | +| Масштаб таймлайна, от точки под мышкой | Ctrl + колесо мыши | | Прокрутка по дорожкам | колесо мыши | | Прокрутка по времени | Shift + колесо, средняя кнопка | | Прокрутка журнала вбок | Shift + колесо над журналом | @@ -143,7 +145,7 @@ xdg-mime query default application/x-nlve-project липнут при перетаскивании, курсор — при щелчке, и одно бывает нужно без другого. -**Курсор посередине** (кнопка с целью, клавиша `\`). Включено — при +**Курсор посередине** (кнопка с целью). Включено — при воспроизведении монтаж едет под курсором, и всегда видно, что будет дальше. Выключено — окно не двигается вовсе, даже когда курсор ушёл за край: отмотал Shift с колесом — там и останешься. Раньше в выключенном @@ -222,6 +224,13 @@ Ctrl+Shift+R, который схлопывает дыру под курсоро двойной. Ручка стоит посередине именно видимой части, а не всего клипа: до середины часового клипа, уехавшей за край экрана, мышью не дотянуться. +**Затухания тянутся за ручки в верхних углах клипа.** Взять их можно и +промахнувшись: зона захвата шире нарисованного квадратика и уходит внутрь +клипа. Пока затухание нулевое, ручка стоит в самом углу и целиться есть +куда; стоит её сдвинуть — она висит посреди клипа сама по себе, и попасть +в девять точек почти нельзя. Над зоной захвата меняется курсор — по нему +и видно, где взять (`tests/fadegrab.sh`). + Громкость, отличная от обычной, — единственное место, где звук перекодируется: изменить громкость, не тронув сам звук, нельзя. Видео при этом по-прежнему копируется. Проверено: клип с громкостью 30% дал в ролике @@ -250,6 +259,99 @@ Ctrl+Shift+R, который схлопывает дыру под курсоро неправильно. Усиление меняет только рисунок, самого звука не касается, и запоминается между запусками. +## Сохранение и автосохранение + +**Сохранение видно.** После Ctrl+S внизу появляется «Проект сохранён: +имя, время». Раньше об этом говорила только строчка в журнале, а журнал +по умолчанию закрыт: нажал — и непонятно, дошло до файла или нет. + +**Запись не оставляет огрызков.** Проект пишется во временный файл рядом +и подставляется на место настоящего, только когда записан целиком. +Прежний файл при этом становится запасным — `имя.nlve.bak`. Падение или +кончившееся место посреди записи больше не оставляют половину проекта. + +**Копия пишется сама.** Пока в проекте есть несохранённое, раз в полминуты +рядом появляется `имя.nlve.autosave`. Это не сохранение: файл проекта не +трогается, признак «изменён» остаётся. + +При открытии проекта программа смотрит, нет ли рядом копии новее его +самого. Есть — значит прошлая работа до файла не дошла, и программа +показывает оба времени и предлагает открыть копию. Отказ копию не +удаляет: она лежит, пока проект не сохранят заново. После сохранения +копия не нужна и убирается. + +## Кнопки внизу + +Переключатели в нижней полосе — прилипание, прилипание курсора, курсор +посередине, автосхлопывание с выбором режима, режим выделения, журнал. + +**Подсказка идёт в строку состояния, а не во всплывающее окно.** +Всплывающее окно появлялось прямо поверх кнопки, о которой +рассказывало, и перехватывало щелчок: нажать кнопку было нельзя, пока +подсказка не уйдёт. Теперь наведение мыши пишет ту же фразу в строку +состояния справа от кнопок — она ничего не закрывает. Щелчок по кнопке +подсказку тут же переписывает: «Журнал виден» становится «Журнал +спрятан». + +Строка состояния занимает всё свободное место справа и ужимается только +на время, пока рядом показан ход работы. + +**Каждый щелчок считается.** Раньше второй щелчок подряд оконная +библиотека отдавала как двойной, и до кнопки он не доходил: нажимаешь +журнал три раза быстро — срабатывает один. Теперь двойных щелчков +кнопкам не приходит вовсе, и любая очередь щелчков отрабатывается вся +(`tests/lfmcheck`, раздел «Кнопки нижней панели»; `tests/buttonclicks.sh` +проверяет то же самое мышью на невидимом экране). + +## Два режима выделения + +Кнопка внизу (справа от схлопывания) и клавиша `D`. Режим показан +значком: рамка — выделение клипов, промежуток со стрелкой — выделение по +времени. + +**Рамкой по клипам.** Протяжка по пустому месту дорожек выделяет всё, что +рамка задела. Обычное выделение: выделил, нажал Delete. + +**По времени.** Протяжка отмечает промежуток от и до — по всем дорожкам +сразу, сколько бы их ни было. Промежуток виден пунктиром и после того, +как кнопку отпустили: по нему режет `S`. + +Зачем второй режим: вырезать из фильма кусок целиком. Отметил промежуток, +нажал `S` — все дорожки разрезаны в двух местах, по краям промежутка, и +выделенной осталась ровно середина. Дальше Delete, и при включённом +автосхлопывании дыра закрывается сама. + +Края промежутка кладутся на кадровую сетку: между кадрами времени нет. + +**Курсор идёт за резом.** После `S` он встаёт ровно на место реза (в +режиме по времени — на начало промежутка), после удаления куска и +схлопывания — на место стыка. Дальше с этим местом и работают: следующий +рез, схлопывание дыры, просмотр перехода. Раньше курсор оставался там, где +был, и в место реза приходилось попадать мышью заново. + +## Починка проекта + +Меню «Проект» → **Проверить и починить проект...**. Показывает, что нашла, +и чинит только по согласию; отменяется через Ctrl+Z. + +Что ищется: + +- **клипы мимо кадровой сетки.** Между кадрами времени нет, а в старых + проектах времена записаны как попало: 2.457599 с при 59.94 к/с — это + 147.31 кадра. Картинка всё равно выйдет целым числом кадров, звук + наберётся с точностью до отсчёта, и предпросмотр со сборкой не смогут + совпасть в точности. Починка двигает клип не больше чем на полкадра; + на проекте из 82 клипов общая длина изменилась на 0.028 с, то есть на + полтора кадра за два часа; +- **клипы на дорожках чужого вида.** Такой клип нарисован на монтаже, но + в готовый ролик не попадает. То же самое предлагается при открытии + проекта, здесь — по требованию; +- **дорожки с повторяющимися именами.** + +Для синхронности звука с картинкой чинить проект не нужно: рез правится +при сборке, и старый проект соберётся сходящимся. Починка — про то, чтобы +монтаж не хранил невозможных времён. + ## Файл не совпадает с проектом Проект имеет одно разрешение и один набор кодеков на всё — иначе куски не @@ -308,11 +410,22 @@ Ctrl+Shift+R, который схлопывает дыру под курсоро Замер на материале 2688x1512 при 60 к/с: 327 кадров в секунду без фильтра, 230 с настоящим масштабированием — запас четырёхкратный. -Чего предпросмотр не умеет: показать собственную настройку кадрирования -файла. Цепочка фильтров у mpv одна на всю склейку, а заполнение с обрезкой, -поворот и смещение задаются для каждого файла отдельно — выбрать между ними -общий фильтр не может, поэтому он всегда вписывает целиком. Точную картинку -для такого файла показывает окно «Кадрирование и поворот». +**Кадрирование клипа окно показывает.** Цепочка фильтров у mpv одна на всю +склейку, а кадрирование у каждого клипа своё, и включать его по времени в +цепочке нечем: из фильтров ffmpeg по времени переключается только +наложение. Зато у вывода есть своя обрезка, и делает её видеокарта даром. +Курсор зашёл в клип со своим кадрированием — обрезка выставляется, вышел — +снимается. Ни лишней цепочки, ни копирования кадров из памяти видеокарты. + +Рамку считает один и тот же код, что рисует её в окне «Кадрирование и +поворот», — иначе окно обещало бы одно, а предпросмотр показывал другое +(`TransformSourceRect` в `uTransform`, проверка в `tests/lfmcheck`). + +Чего это не покрывает: отражение (свойства для него у вывода нет), +растяжение (там кадр жмётся неравномерно, рамкой не описать) и участки с +наложением — там кадр уже сведён цепочкой, и обрезка резала бы сведённое +целиком, вместе с нижним слоем. Для таких клипов точную картинку +по-прежнему показывает окно «Кадрирование и поворот». ## Цвета окна @@ -487,15 +600,34 @@ Linux потом искала по нему `.dll`. ## Прерванная сборка -Каждый доведённый до конца кусок помечается в списке рядом с самими -кусками (`готово.txt` в кэше). Если сборка не дошла до конца — упала, -была отменена или программу закрыли, — при следующей сборке в тот же файл -программа предложит продолжить с готовых кусков. +Если сборка не дошла до конца — упала, была отменена или программу +закрыли, — при следующей сборке в тот же файл программа предложит +продолжить. -Проверяется не только наличие файла: сборку могли прервать посреди -записи, и файл оказался бы обрезанным. Поэтому куском считается только -тот, который успел попасть в список. +**При сборке потоком** продолжают с самого недописанного файла: он и есть +уже собранная часть фильма, и в нём видно, сколько целых кадров успело +записаться. Программа отступает назад до границы последнего целого куска, +переносит эту часть в новый файл и досылает остаток. Собранное таким +образом совпадает с собранным за один раз попиксельно. +Дописать в конец существующего MKV нельзя — Matroska этого не даёт, — +поэтому продолжение всегда пишется в новый файл, и на диске в этот момент +лежат оба. Места нужно вдвое больше готового ролика. + +**MP4 продолжать нельзя вовсе:** оглавление пишется в конец, и оборванный +файл не открывается — `moov atom not found`. Программа говорит об этом +прямо и собирает заново. Если сборка длинная, лучше собрать в MKV, а потом +переупаковать в MP4 окном ремукса: это копирование потоков, без +перекодирования. + +Готовый файл до последнего цел: сборка идёт в файл рядом и занимает место +готового, только когда дописана. Сорвавшаяся попытка не отбирает то, что +уже было собрано, — из двух недописанных остаётся тот, где кадров больше. + +**При сборке через кэш кусков** продолжают иначе: каждый доведённый до +конца кусок помечается в списке рядом с самими кусками (`готово.txt`). +Проверяется не только наличие файла — сборку могли прервать посреди +записи; куском считается только тот, который успел попасть в список. Первая строка списка — отпечаток плана: пути, места и длины всех кусков. Не совпал — значит монтаж с тех пор менялся, и готовые куски не подойдут; программа скажет об этом и соберёт заново. @@ -509,6 +641,24 @@ Linux потом искала по нему `.dll`. пересчитывается на каждом шаге. Даже такая оценка отвечает на главный вопрос: успею ли я сходить за чаем. +**Полоса и число — одно и то же число.** Показатель работы внизу главного +окна подписан процентами, и это ровно та доля, которую он нарисовал. +Раньше полоса ползла по догадке, а подпись показывала замер: человек +видел полосу, заполненную на девять десятых, рядом с нулём процентов, и +понять по такой паре было нельзя ничего. + +**Доля берётся у ffmpeg, а не угадывается.** Сборка участка с наложением +или затуханием может идти минуту и дольше, и всё это время «кусок 1 из 1» +не меняется. Поэтому ffmpeg спрашивают, докуда он дошёл (`-progress`), и +доля считается по его ответу. Пока он не ответил ни разу, полоса трогается +с места на пару процентов и там стоит: пустая полоса и есть правда о +только что начатой работе. + +**Обе полосы рисует один и тот же код.** Полоса в окне сборки раньше была +системной (`TProgressBar`), и под gtk2 она заполнялась ступенями — восемь +кусков на всю ширину. Теперь и там, и внизу главного окна стоит своя +`TThemedProgress`, которая заполняется сплошь. + ## Как собирается ролик 1. Монтаж уплощается в последовательность непересекающихся кусков. @@ -519,13 +669,40 @@ Linux потом искала по нему `.dll`. кусков нельзя, он на этом зависает. Заготовки делаются готовых длин (15 с, 60 с, 5 мин и так далее), а нужный кусок из них вырезается — тогда любое движение клипа не требует новой генерации. -3. Начало каждого куска притягивается к опорному кадру, потому что копировать - можно только с него. Конец притягивать не нужно — при копировании он и так - получается кадроточным. -4. При точном резе огрызок от точки реза до следующего опорного кадра - перекодируется, остальное копируется. -5. Куски склеиваются concat-демультиплексором, результат сверяется: сумма - пакетов кусков обязана совпасть с числом пакетов в готовом файле. +3. Границы кусков кладутся на кадровую сетку проекта: между кадрами + времени нет, а звук набирается с точностью до отсчёта, и доли кадра + разводят их в стороны. +4. Рез всегда точный: огрызок от точки реза до ближайшего опорного кадра + перекодируется, остальное копируется. Копировать можно только с + опорного кадра, поэтому «резать где угодно и ничего не перекодировать» + не бывает — но платить приходится долями секунды на рез. +5. Каждому куску заказывается точное число кадров (`-frames:v`), а не + только время: при копировании ffmpeg отмеряет конец по времени + декодирования, и у записи с B-кадрами кусок выходит длиннее + запрошенного. +6. Куски идут в готовый файл потоком. Каждый режется своим ffmpeg прямо + в MPEG-TS на стандартный вывод, все потоки подряд переливаются в один + принимающий ffmpeg, а тот пишет готовый файл. Место куску в общем + потоке задаёт `-output_ts_offset`, считаемое в кадрах от начала. На + диск не ложится ничего, кроме результата и звуковой дорожки. +7. Результат сверяется дважды: сумма кадров кусков обязана совпасть с + числом пакетов в готовом файле, а число кадров — с тем, что просил + монтаж. Второе и есть проверка синхронности звука с картинкой; вердикт + пишется в журнал сборки. + +Звук собирается раньше картинки: приёмник берёт его вторым входом. В +кусках картинки звука нет — звуковая дорожка собирается отдельно и точнее, +а лишний поток в куске MPEG-TS ещё и сбивает тайминг склейки: замерено +36 мс на стык. + +**Через кэш кусков** собирается то, что потоком не выходит: когда кодек +проекта не переносится в MPEG-TS или когда весь ролик пересобирается под +площадку одним кодировщиком. Тогда каждый кусок пишется в отдельный файл, +а склейка идёт concat-демультиплексором с явно указанной длительностью +каждого. Этот путь и был единственным раньше; оба дают побитово один и тот +же ролик — сверено на материале с дрона, PSNR бесконечен на каждом кадре. +Разница в цене: на отрывке в 17.5 с кэш весил 152 МБ против 421 КБ, а +времени ушло 17.5 с против 14.2 с. Напрашивающийся способ — один проход с директивами `inpoint` и `outpoint`, без временных файлов — проверен и отвергнут: он давал 574 кадра вместо 600 @@ -556,7 +733,8 @@ Linux потом искала по нему `.dll`. числе кадров. Лечится склейкой через промежуточный MPEG-TS, где параметры повторяются перед каждым опорным кадром — стало 0 ошибок. Способ выбирается автоматически: один источник и никаких точных резов — прямая склейка, -иначе MPEG-TS. +иначе MPEG-TS. Резы теперь всегда точные, так что на деле это почти всегда +MPEG-TS. **Лишний кадр на стыке точного реза.** При копировании `-to` работает как «строго меньше», при перекодировании — как «меньше либо равно». Кадр на @@ -568,6 +746,33 @@ Matroska давали метки декодирования, идущие наз меток на шестьсот кадров. Коротким вставкам B-кадры не нужны, поэтому они запрещены (`-bf 0`). +**Звук отставал от картинки — четыре причины сразу.** Разбор занял день, и +каждая находка мерялась, а не угадывалась (`tests/syncprobe.sh`: исходник +со вспышкой и щелчком на каждой секунде, монтаж с резами не на опорных +кадрах, поиск обоих следов в готовом ролике). + +1. *Притянутый рез.* Начало куска картинки сдвигалось на ближайший опорный + кадр, а звук брался из непритянутой точки: в журналах пользователя + средняя притяжка 0.24 с, худшая 0.99 с. Лечится точным резом всегда. +2. *Список правок MP4.* Разбор заголовка не учитывал блок `elst`, и метки + опорных кадров уезжали на задержку показа — на пробе два кадра. Рез + просил перекодировать до метки, которая опорным кадром не была. +3. *Конец куска при копировании.* `-to` отмеряет по времени декодирования, + и у записи с B-кадрами кусок выходил длиннее запрошенного. Лечится + явным числом кадров (`-frames:v`). +4. *Длительность куска в склейке.* Последний пакет скопированного куска + показывается позже всех прочих, контейнер считает его в длительность, и + склейка растягивала время — 0.05 с на кусок. Лечится директивой + `duration` в списке склейки. Туда же: звук внутри кусков картинки сбивал + выравнивание на 36 мс, теперь его там нет. + +Плюс «разогрев» кодировщика звука: сжатый AAC начинается со служебных +отсчётов, MP4 помечает их пропускаемыми, Matroska такой пометки не хранит — +звук ехал на 21.3 мс позже. Величина меряется пробным сжатием и вычитается. + +Итог замера на образце: было до 0.6 с и росло по ходу ролика, стало 0.02-0.04 с +без накопления, при точности самого измерения 0.017 с. + **Вставка под каждую длину дыры.** Сначала под каждую дыру делался чёрный клип ровно её длины. Любое движение клипа меняло длину дыры, требовало новой генерации, и до её готовности предпросмотр играл прежнюю расстановку. @@ -660,11 +865,90 @@ Wine с новой библиотекой не грузилось ничего. привычный RGB. Записанный по привычке код даёт цвет с переставленными красным и синим. +**Последняя строка блока о ходе работы обнуляет место.** ffmpeg шлёт ход +блоками, и заканчивается блок строкой `progress=continue`, в которой +места нет — она сообщает только, что работа продолжается. Разбор честно +оставляет переданное число как было, поэтому передавать туда надо уже +известное место, а не ноль. С нулём доля обнуляется в конце каждого +блока: показатель стоит на месте и дёргается вверх лишь тогда, когда +опрос попадёт между строкой со временем и этой — «висит на пяти +процентах, потом скачет до семидесяти девяти». Сам ffmpeg при этом +отдаёт ход безупречно ровно: блок каждые полсекунды, замерено. + +**Разбор HEVC на процессоре — самое дорогое в сведении слоёв.** Не +фильтры, как кажется: на десяти секундах 2688x1512 цепочка со сведением +стоит 13.5 с, а без всяких фильтров — 12.7 с. Всё время уходит на разбор +исходника. Ключ `-hwaccel cuda` перед входом убирает его почти целиком: +затухание на семьдесят секунд собирается 18.3 с вместо 75.9 с, картинка +бит в бит та же. Просить его стоит только там, где кодирует та же карта +(выбран NVENC): иначе на машине без неё пришлось бы ловить отказ. + +**Список недостающего — не список нужного.** Недостающее у нас — это то, +чего нет на диске. Но у куска, который делается прямо сейчас, файл уже +есть: ffmpeg создаёт его в первую же секунду и пишет до конца. Проверка +«нужна ли ещё эта работа» спрашивала по списку недостающего — и отвечала +«не нужна» про то, что делается. Работа отменялась в разгаре и начиналась +заново. На коротком затухании это проходило незаметно, на затухании в +семьдесят секунд сборка не заканчивалась никогда: любая правка сбрасывала +её. Теперь уплощение отдельно отдаёт список нужного, независимо от того, +лежит файл на диске или ещё пишется (`tests/genrestart.sh`). + +**MousePos у колеса мыши — не экранный.** По описанию `DoMouseWheel` +получает точку в координатах экрана, но под gtk2 в ней уже клиентские: +`ScreenToClient` переводит их второй раз, и точка уезжает влево ровно на +левый край элемента. У масштаба таймлайна это выглядело так, будто он +берётся не от мыши: замерено на невидимом экране — мышь в 700, 1000 и +1300, опора в 260, 560 и 860, всегда на 440 левее. Лечится обращением к +`Mouse.CursorPos`: он экранный в любой системе, и перевод остаётся один. + **Имена, занятые предками.** Локальная переменная перекрывает одноимённое свойство класса: `Text` и `Position` заняты у `TControl`, `Finished` — у `TThread`, `Name` и `Caption` — у формы. Компилятор ловит это как «Duplicate identifier», но причину не объясняет. +**Стык кусков в потоке выглядит как порча.** Каждый кусок — это +отдельный поток MPEG-TS со своим счётчиком непрерывности, и на стыке +приёмник пишет «Packet corrupt», по паре строк на кусок. Данные при этом +целы, но журнал сборки забивается жалобами, из-за которых не найти +настоящую ошибку. Лечится ключом `-mpegts_flags +initial_discontinuity` +у отправителя: он помечает начало куска как разрыв, жалобы исчезают, а +результат тот же — сверено по кадрам и по md5. + +**Приёмник двигает весь ролик.** `-avoid_negative_ts make_zero` у +приёмника сдвигает поток так, чтобы самая ранняя метка декодирования +стала нулём, — а у первого куска она уходит в минус на задержку +кодировщика, и весь ролик встаёт на 21 мс позже. Само по себе это +безобидно, но продолжение прерванной сборки несёт этот сдвиг в +перенесённой части, и куски за ней, размещённые по счёту кадров от нуля, +налезают на неё на кадр. Поэтому при переносе сдвиг снимается +отрицательным `-output_ts_offset`, а приёмник накладывает его заново. + +**Сдвиг к нулю отменяет сдвиг по времени.** При сборке потоком место +куску задаёт `-output_ts_offset`, но `-avoid_negative_ts make_zero` +считается уже после него и двигает кусок обратно в ноль — ключ просто +перестаёт действовать. Замерено: все шесть кусков встали в начало, +картинка разошлась с эталоном (PSNR 18 дБ) при верном числе кадров и +тех же пакетах. В потоке сдвиг к нулю выключен; отрицательные метки в +самом начале подбирает приёмник, у него make_zero свой. + +**`-fflags +igndts` сминает кадры на стыках.** С ним ffmpeg выбрасывает +пришедшие метки декодирования и считает свои, а материал с B-кадрами +хранится не в том порядке, в каком показывается. На стыке появлялось по +три кадра с одной меткой, картинка расходилась с эталоном. Без этого +ключа метки идут шаг в шаг, и ни одной жалобы на непоследовательность. + +**Двойной щелчок съедает второй щелчок.** Пока у элемента есть +`csDoubleClicks`, второй щелчок подряд приходит не как `Click`, а как +`DblClick`, и обработчик кнопки его не видит: человек щёлкает три раза, +срабатывает один. Лечится двумя строками в конструкторе: +`ControlStyle := ControlStyle - [csDoubleClicks]` и `DblClick`, +переопределённый в `Click`, — на случай, если двойной всё же дойдёт. + +**Всплывающая подсказка перехватывает щелчок.** Окно подсказки в gtk2 +встаёт поверх кнопки, о которой рассказывает, и щелчок попадает в него, +а не в кнопку. У кнопок в тесной полосе `ShowHint` выключен, а текст +подсказки идёт в строку состояния (`UseStatusHints` в `uMainForm`). + ## Консольный инструмент проверок Часть вещей проверяется числами, а не глазами. Сборка: `./build.sh tool`. @@ -680,11 +964,51 @@ Wine с новой библиотекой не грузилось ничего. ./tests/nlvetool build <проект> <видео> [<картинка>] ./tests/nlvetool buildcut <проект> <видео> ./tests/nlvetool render <проект> <выход> +./tests/nlvetool syncproj <проект> <видео> монтаж для замера синхронности ``` Команды возвращают ненулевой код при расхождении, поэтому годятся для автоматической проверки. +Отдельно — замер синхронности звука и картинки: + +``` +./tests/syncprobe.sh весь прогон: образец, сборка, замер +./tests/syncprobe.sh measure ФАЙЛ замер готового файла +``` + +Как он устроен. Делается исходник, где ровно на каждой секунде в кадре +белая вспышка, а в звуке щелчок. Из него собирается монтаж, у которого +начала кусков заведомо не попадают на опорные кадры. В готовом ролике +ищутся времена вспышек и щелчков: если они разошлись — звук уехал от +картинки, и видно, на сколько и с какого куска. + +Времена щелчков считаются по самим отсчётам (`tests/clicktimes.py`), а не +оконным анализом: окно двигается кратно своему размеру, и его собственный +уход выглядит как накапливающийся рассинхрон, которого нет. На это уже +попались один раз. + +Ещё четыре проверки гоняют саму программу на невидимом экране +(`Xvfb :99`). Рабочий экран они не занимают: + +``` +./tests/buttonclicks.sh <окно> каждый щелчок по кнопке считается +./tests/zoomanchor.py <окно> масштаб берётся от точки под мышкой +./tests/genrestart.sh [<путь к nlve>] сборка вставки не сбрасывается зря +./tests/fadegrab.sh [<путь к nlve>] ручку затухания видно и во второй раз +``` + +Двум последним нужен монтаж в `test/поток/`: `длинный-фейд.nlve` — один +клип с затуханием секунд на семьдесят (такой кусок сводится около +полутора минут, и всё это время человек продолжает работать), +`пара.nlve` — два клипа без затуханий. Путь к первому задаётся +переменной `NLVE_FADE_PROJECT`. В репозиторий они не входят, потому что +ссылаются на съёмку, которой здесь нет. + +Каждую из них стоит прогонять и на прежней сборке: проверка, которая +проходит везде, не проверяет ничего. Все четыре на сборке до своей +правки падают. + ## Структура | Файл | Что это | @@ -719,6 +1043,16 @@ Wine с новой библиотекой не грузилось ничего. | `src/uProgressForm.pas` | Ход долгой операции | | `src/uRemuxForm.pas` | Окно перепаковки | | `src/uMismatchForm.pas` | Предупреждение о несовпадении параметров | +| `src/uTextForm.pas` | Надпись на клипе: текст и оформление | +| `src/uTextMeasure.pas` | Точный замер ширины текста для подбора размера | +| `src/uSubtitles.pas` | Текст поверх картинки: разметка для libass | +| `src/uColorKeyForm.pas` | Выбор цвета, который станет прозрачным | +| `src/uEncodeForm.pas` | Настройки сборки с перекодированием | +| `src/uExportForm.pas` | Куда собирать, в каком контейнере, что с текстом | +| `src/uAboutForm.pas` | О программе: возможности и чем она обязана чужому | +| `src/uArticleView.pas` | Страница текста со ссылками | +| `src/uFfmpegJob.pas` | Один запуск ffmpeg в потоке, с ходом работы и отменой | +| `src/uIconData.pas` | Значки, вшитые в программу | | `build.sh` | Сборка целями | | `tests/` | Консольный инструмент проверок | | `vendor/mpv-headers/` | Заголовки mpv 0.37.0 — эталон для биндингов | diff --git a/icons_online/attribution.txt b/icons_online/attribution.txt index 0f3b577..1586d15 100644 --- a/icons_online/attribution.txt +++ b/icons_online/attribution.txt @@ -2,4 +2,6 @@ Log panel: Prop Ripple gaps: Merge Vertical icon by Icons8 Magnet: Magnet icon by Icons8 Playhead snapping: Клей icon by Icons8 -App icon: Showing Video Frames icon by Icons8 \ No newline at end of file +App icon: Showing Video Frames icon by Icons8 +Selection mode, clips: Select All icon by Icons8 +Selection mode, time range: Width icon by Icons8 diff --git a/icons_online/icons8-select-all-90.png b/icons_online/icons8-select-all-90.png new file mode 100644 index 0000000..0bfdc90 Binary files /dev/null and b/icons_online/icons8-select-all-90.png differ diff --git a/icons_online/icons8-width-90.png b/icons_online/icons8-width-90.png new file mode 100644 index 0000000..80a187b Binary files /dev/null and b/icons_online/icons8-width-90.png differ diff --git a/src/uAppTypes.pas b/src/uAppTypes.pas index c7b9144..9571e2c 100644 --- a/src/uAppTypes.pas +++ b/src/uAppTypes.pas @@ -232,12 +232,30 @@ begin end; function AdvanceProgress(AShown, AReal, ANext, AStepShare: Double): Double; +var + Guessed: Double; begin Result := AShown; if AReal > Result then Result := AReal; if ANext > Result then Result := Result + (ANext - Result) * AStepShare; + + { Догадка не закрывает промежуток до вехи целиком. + + Шаги мельчают, но за сотню их полоса подбиралась к вехе вплотную, и + на единственном шаге — когда веха одна и она же конец — доползала до + края. Человек видел заполненную полосу у работы, которая ещё идёт, и + считал программу зависшей. Девять десятых промежутка — предел: + остаток виден глазом и говорит, что веха не достигнута. } + Guessed := AReal + (ANext - AReal) * 0.9; + { Назад полоса не идёт никогда, даже если веха сместилась: предел не + опускается ниже уже показанного. } + if Guessed < AShown then + Guessed := AShown; + if (ANext > AReal) and (Result > Guessed) then + Result := Guessed; + { До самого конца полоска не доходит: конец наступает тогда, когда работа кончилась, а не когда мы досчитали. } if Result > 0.999 then diff --git a/src/uExport.pas b/src/uExport.pas index d7f4beb..13a8a6f 100644 --- a/src/uExport.pas +++ b/src/uExport.pas @@ -48,7 +48,7 @@ unit uExport; interface uses - Classes, SysUtils, uAppTypes, uKeyframeIndex, uMediaProbe; + Classes, SysUtils, uAppTypes, uKeyframeIndex, uMediaProbe, uProcRunner; type { Настройки сборки с перекодированием. @@ -79,6 +79,10 @@ type Duration: Double; TempPath: string; Packets: Int64; + { Сколько кадров в этой части должно быть по замыслу монтажа. Отсюда + берётся её длительность для склейки и с этим же числом сверяется то, + что вышло на самом деле. } + WantFrames: Integer; Encoded: Boolean; end; @@ -135,6 +139,8 @@ type FStepPosition: Double; { Приёмник числа, которое печатает ffprobe при подсчёте пакетов. } FPacketCount: Int64; + { Приёмник метки первого звукового пакета при замере разогрева. } + FFirstAudioPts: Double; FMaster: TMediaInfo; FProfile: TEncodeProfile; @@ -143,8 +149,34 @@ type FIntermediateFormat: string; FIntermediateExt: string; + { Сборка потоком: куски идут в трубу приёмнику, а не в файлы кэша. } + FStreaming: Boolean; + FAllowStream: Boolean; + FSink: TProcSink; + { Сколько кадров уже отправлено. Отсюда берётся время следующего + куска: считать кадрами, а не складывая секунды, — единственный + способ не накопить ошибку округления на тысяче кусков. } + FSentFrames: Int64; + { Продолжение прерванной сборки: недописанный файл прошлого раза, + сколько кадров в нём читается и отправлена ли уже его целая часть. } + FResumeSource: string; + FResumeGood: Int64; + FPrefixSent: Boolean; + { На сколько прошлая сборка сдвинула весь ролик вперёд. Приёмник + двигает поток так, чтобы самая ранняя метка декодирования стала + нулём, а у первого куска она уходит в минус на задержку кодировщика. + При переносе этот сдвиг снимается, иначе продолжение встало бы + на него внахлёст. } + FResumeShift: Double; + { Приёмник метки первого кадра при замере сдвига. } + FFirstVideoPts: Double; + function DistinctSourceCount: Integer; procedure ChooseIntermediateFormat; + { Можно ли собирать потоком и стоит ли. } + function CanStream(out AWhy: string): Boolean; + { Время, на которое встанет следующий отправленный кусок. } + function SentTime: Double; procedure SyncProgress; procedure SyncLog; @@ -157,26 +189,54 @@ type procedure LoadDoneList; function IsDone(const AName: string): Boolean; procedure MarkDone(const AName: string); - { Готов ли кусок с прошлого раза. Заполняет отчёт по нему. } - function TakeReadyPart(AIndex: Integer; out ARep: TSegmentReport): Boolean; procedure SetStage(const AText: string); procedure PublishProgress; function CancelQuery: Boolean; procedure ProgressLine(const ALine: string); procedure ErrorLine(const ALine: string); + { Поток ошибок отправителя: там вперемешку и журнал, и ход работы. } + procedure StreamLine(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; + { Один кусок: в файл кэша или в трубу — смотря как собираем. + AFrames нужен продолжению: по нему видно, лежит ли этот кусок + целиком в том, что успело записаться прошлый раз. } + function RunPart(const AArgs: array of string; const AWhat: string; + AFrames: Integer): Boolean; + { Сколько пакетов картинки в файле. AEvenIfCancelled — считать даже + после того, как работу попросили прекратить: по этому числу + решается, какой из недописанных файлов оставить, и остановка не + повод терять уже собранное. } + function CountPackets(const APath: string; + AEvenIfCancelled: Boolean = False): Int64; function ExtractSegments: Boolean; function WriteConcatList(out AListPath: string): Boolean; function ConcatAll(const AListPath: string): Boolean; + { Сборка потоком: приёмник запускается один раз, куски идут в него + по очереди, на диск ложится только готовый файл. } + function StreamAll: Boolean; + { Готовит продолжение: смотрит недописанный файл прошлого раза. } + procedure PrepareResume; + { Самая ранняя метка картинки в файле. Меньше нуля — не удалось. } + function FirstVideoTime(const APath: string): Double; + procedure FirstVideoLine(const ALine: string); + { Отправляет приёмнику целую часть недописанного файла. } + function SendPrefix: Boolean; + { Решает судьбу двух файлов: собранного сейчас и лежавшего раньше. } + procedure FinishResume(ASucceeded: Boolean; const AWork: string); + { Ставит или снимает отметку «файл недописан». } + procedure MarkUnfinished(AFrames: Int64); procedure Verify; { Сборка звука: куски сводятся в сырой поток и сжимаются одним проходом. Сырой поток нужен для точности — стык получается с точностью до отсчёта, а не до звукового кадра. } function BuildAudio: Boolean; + { Разогрев кодировщика звука: сколько служебных отсчётов он добавляет + в начало. Меряется коротким пробным сжатием. } + function EncoderPriming(ARate, AChannels: Integer): Double; + procedure FirstPtsLine(const ALine: string); function MixLayers(const ASeg: TFlatSegment; ADest: TStream; ANeed: Int64; ARate, AChannels: Integer): Boolean; function MuxFinal: Boolean; @@ -220,6 +280,9 @@ type Проверять по одному только наличию файла нельзя: сборку могли прервать посреди записи, и файл окажется обрезанным. } property Resume: Boolean read FResume write FResume; + { Разрешить сборку потоком. Выключено — собираем через кэш кусков, + как раньше. Нужно для сверки двух способов между собой. } + property AllowStream: Boolean read FAllowStream write FAllowStream; { Сколько кусков взято готовыми. Для отчёта. } property ReusedParts: Integer read FReusedParts; end; @@ -227,10 +290,19 @@ type { Каталог для временных кусков рядом с готовым файлом. } function CacheDirFor(const AOutputPath: string): string; +{ Путь к отметке «сборка оборвалась, файл недописан». Она лежит рядом с + самим файлом: недописанный MKV открывается и играет, и отличить его от + готового больше нечем. Внутри — число кадров, которые в нём есть. } +function UnfinishedMark(const AOutputPath: string): string; + +{ Сколько кадров записано в недописанный файл по его отметке. Ноль — + отметки нет, значит файл готов или его вовсе нет. } +function UnfinishedFrames(const AOutputPath: string): Int64; + implementation uses - Math, md5, FileUtil, uFfmpegCmd, uProcRunner; + Math, md5, FileUtil, uFfmpegCmd; { Размер файла или ноль, если его нет. } function FileSizeOf(const APath: string): Int64; @@ -265,6 +337,32 @@ begin PathDelim; end; +function UnfinishedMark(const AOutputPath: string): string; +begin + Result := AOutputPath + '.недописано'; +end; + +function UnfinishedFrames(const AOutputPath: string): Int64; +var + L: TStringList; +begin + Result := 0; + if not FileExists(UnfinishedMark(AOutputPath)) then + Exit; + L := TStringList.Create; + try + try + L.LoadFromFile(UnfinishedMark(AOutputPath)); + if L.Count > 0 then + Result := StrToInt64Def(Trim(L[0]), 0); + except + Result := 0; + end; + finally + L.Free; + end; +end; + destructor TExportThread.Destroy; begin FDone.Free; @@ -279,6 +377,9 @@ var begin FMaster := AMaster; FProfile := AProfile; + { Потоком — обычный путь; через кэш собираем, только когда потоком + нельзя или когда просят сверить два способа. } + FAllowStream := True; inherited Create(True); FreeOnTerminate := False; @@ -442,42 +543,6 @@ begin end; end; -function TExportThread.TakeReadyPart(AIndex: Integer; - out ARep: TSegmentReport): Boolean; -var - Names: array[0..2] of string; - I: Integer; -begin - Result := False; - ARep := Default(TSegmentReport); - if (FDone = nil) or (FDone.Count = 0) then - Exit; - - { Имя куска зависит от того, каким путём он делался: обычный, с - наложением, с точным резом. Проверяем все три. } - Names[0] := Format('part_%.3d_a%s', [AIndex, FIntermediateExt]); - Names[1] := Format('part_%.3d_x%s', [AIndex, FIntermediateExt]); - Names[2] := Format('part_%.3d_b%s', [AIndex, FIntermediateExt]); - - for I := 0 to 1 do - if IsDone(Names[I]) then - begin - { Кусок с точным резом состоит из двух частей; если вторая тоже - готова, её возьмёт следующий заход — здесь достаточно первой. } - ARep.Index := AIndex; - ARep.SourcePath := FSegments[AIndex].FilePath; - ARep.RequestedStart := FSegments[AIndex].SrcStart; - ARep.ActualStart := FSegments[AIndex].SrcStart; - ARep.Duration := FSegments[AIndex].Duration; - ARep.Packets := -1; - ARep.Encoded := I = 1; - ARep.TempPath := FCacheDir + Names[I]; - Inc(FReusedParts); - Log(Format('Кусок %d уже собран — беру готовый.', [AIndex + 1])); - Exit(True); - end; -end; - procedure TExportThread.Log(const AText: string); begin WriteLogLine(AText); @@ -526,6 +591,23 @@ begin Log('ffmpeg: ' + ALine); end; +{ При сборке потоком стандартный вывод занят материалом, и ход работы + ffmpeg шлёт в поток ошибок — туда же, куда пишет журнал. Строки там + разного вида, и разбираются они по очереди: сперва пробуем прочесть + как ход работы, не вышло — значит это журнал. } +procedure TExportThread.StreamLine(const ALine: string); +var + Seconds: Double; + AtEnd: Boolean; +begin + Seconds := 0; + AtEnd := False; + if ParseProgressLine(ALine, Seconds, AtEnd) then + ProgressLine(ALine) + else + ErrorLine(ALine); +end; + procedure TExportThread.PacketCountLine(const ALine: string); var Value: Int64; @@ -571,13 +653,80 @@ begin Result := True; end; -function TExportThread.CountPackets(const APath: string): Int64; +{ Кусок при сборке потоком. + + Отличий от обычного запуска два: вывод уходит не в файл, а приёмнику, и + журнал с ходом работы приходит одним потоком. Всё остальное — те же + проверки и тот же учёт работы. } +function TExportThread.RunPart(const AArgs: array of string; + const AWhat: string; AFrames: Integer): Boolean; var Res: TProcResult; +begin + if not FStreaming then + Exit(RunFfmpeg(AArgs, AWhat)); + + { Продолжение прерванной сборки. + + Пока очередной кусок целиком помещается в то, что успело записаться + прошлый раз, делать его заново незачем: он придёт вместе с переносом + собранного. Первый же кусок, который не помещается, и есть граница — + перед ним переносим целую часть старого файла и дальше работаем как + обычно. } + if (FResumeGood > 0) and (not FPrefixSent) then + begin + if FSentFrames + AFrames <= FResumeGood then + begin + Inc(FReusedParts); + FDoneWork := FDoneWork + FStepWork; + PublishProgress; + Exit(True); + end; + if not SendPrefix then + Exit(False); + end; + + Log('> ' + CommandToString(FfmpegExe, AArgs)); + + FStepPosition := 0; + Res := RunProcessInto(FfmpegExe, AArgs, FSink, @StreamLine, @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; + AEvenIfCancelled: Boolean): Int64; +var + Res: TProcResult; + Cancel: TProcCancelQuery; begin FPacketCount := -1; + Cancel := @CancelQuery; + if AEvenIfCancelled then + Cancel := nil; Res := RunProcess(FfprobeExe, ArgsCountVideoPackets(APath), - @PacketCountLine, nil, @CancelQuery); + @PacketCountLine, nil, Cancel); if (not Res.Started) or (Res.ExitCode <> 0) then Exit(-1); Result := FPacketCount; @@ -648,6 +797,47 @@ begin 'первого куска ко всем остальным.'); end; +{ Можно ли собрать ролик потоком, без кэша кусков. + + Потоком куски идут в MPEG-TS, поэтому нужны кодеки, которые он несёт. + Пересборка всего ролика под площадку идёт своим путём: там весь + материал проходит через один кодировщик, и куски ему нужны списком. + + Кадровая сетка обязательна: время каждому куску задаётся в кадрах от + начала, и без частоты кадров проекта эти времена не посчитать. } +function TExportThread.CanStream(out AWhy: string): Boolean; +begin + AWhy := ''; + if not FAllowStream then + begin + AWhy := 'так попросили'; + Exit(False); + end; + if FProfile.Enabled then + begin + AWhy := 'ролик пересобирается под площадку'; + Exit(False); + end; + if (FMaster.FpsNum <= 0) or (FMaster.FpsDen <= 0) then + begin + AWhy := 'у проекта не задана частота кадров'; + Exit(False); + end; + if not TsSupportsCodecs(FMaster.VideoCodec, FMaster.AudioCodec) then + begin + AWhy := 'кодек ' + FMaster.VideoCodec + ' не переносится в MPEG-TS'; + Exit(False); + end; + Result := True; +end; + +function TExportThread.SentTime: Double; +begin + if (FMaster.FpsNum <= 0) or (FMaster.FpsDen <= 0) then + Exit(0); + Result := FSentFrames * FMaster.FpsDen / FMaster.FpsNum; +end; + { Первый опорный кадр строго правее указанного времени. Ноль означает, что правее ничего нет. } function NextKeyframeAfter(const AIndex: TKeyframeIndex; @@ -667,11 +857,23 @@ var Index: TKeyframeIndex; IndexError: string; HasIndex: Boolean; - Snapped, NextKey, EncodeUntil: Double; - SegEnd: Double; + NextKey, EncodeUntil: Double; + SegEnd, HalfFrame: Double; + WantFrames, HeadFrames, TailFrames: Integer; + WithAudio: Boolean; Dst: string; Rep: TSegmentReport; + { Сколько кадров занимает это время в кадровой сетке проекта. } + function FrameCount(const ASeconds: Double): Integer; + begin + if (FMaster.FpsNum <= 0) or (FMaster.FpsDen <= 0) then + Exit(0); + Result := Round(ASeconds * FMaster.FpsNum / FMaster.FpsDen); + if Result < 0 then + Result := 0; + end; + procedure AddPart(const APart: TSegmentReport); begin if PartCount >= Length(FReport.Segments) then @@ -680,11 +882,79 @@ var Inc(PartCount); end; + { Надо ли делать эту часть заново. + + Часть, доведённая до конца в прошлый раз, берётся готовой: на длинном + ролике это разница между «собрать заново всё» и «доделать хвост». + Проверка стоит у каждой части отдельно, а не у куска целиком: при + точном резе кусок состоит из двух частей, и прошлая сборка могла + оборваться между ними. Раньше проверялся только кусок, и вторая часть + при продолжении просто терялась. } + function NeedRun(const ADst: string): Boolean; + begin + { Потоком кэша нет вовсе: брать готовое неоткуда, и всё делается + заново. Продолжение прерванной сборки там устроено иначе — по уже + записанной части готового файла. } + if FStreaming then + Exit(True); + Result := not (IsDone(ExtractFileName(ADst)) and FileExists(ADst)); + if not Result then + begin + Inc(FReusedParts); + Log('Часть уже собрана, беру готовую: ' + ExtractFileName(ADst)); + end; + end; + + { Куда пишется эта часть: в файл кэша или в трубу приёмнику. } + function PartDst(const ASuffix: string; AIndex: Integer): string; + begin + if FStreaming then + Result := 'pipe:1' + else + Result := FCacheDir + + Format('part_%.3d_%s%s', [AIndex, ASuffix, FIntermediateExt]); + end; + + { Время, на которое встанет эта часть в общем потоке. NotPiped — + значит пишем в файл, и время куску не нужно: он начинается с нуля. } + function PartAt: Double; + begin + if FStreaming then + Result := SentTime + else + Result := NotPiped; + end; + + { Часть ушла — двигаем счётчик отправленных кадров. } + procedure PartSent(AFrames: Integer); + begin + if FStreaming and (AFrames > 0) then + Inc(FSentFrames, AFrames); + end; + + { Пометка «готово» имеет смысл только для кэша. } + procedure PartDone(const ADst: string); + begin + if not FStreaming then + MarkDone(ExtractFileName(ADst)); + end; + begin Result := False; PartCount := 0; SetLength(FReport.Segments, Length(FSegments) + 8); + { Звук в кусках картинки нужен только тогда, когда своей звуковой + дорожки у ролика нет: обычно она собрана отдельно и точнее, а лишний + поток в куске ещё и сбивает тайминг склейки. } + WithAudio := Length(FAudio) = 0; + + { Полкадра — мера «попали в тот же кадр». Меньше неё разницы во времени + не существует: между кадрами времени нет. } + HalfFrame := 0.001; + if (FMaster.FpsNum > 0) and (FMaster.FpsDen > 0) then + HalfFrame := FMaster.FpsDen / FMaster.FpsNum / 2; + for I := 0 to High(FSegments) do begin if CancelQuery then @@ -694,16 +964,6 @@ begin Exit; end; - { Кусок, доведённый до конца в прошлый раз, берём готовым. На длинном - ролике это разница между «собрать заново всё» и «доделать хвост». } - if TakeReadyPart(I, Rep) then - begin - AddPart(Rep); - FDoneWork := FDoneWork + FSegments[I].Duration; - PublishProgress; - Continue; - end; - SetStage(Format('Вырезаю кусок %d из %d', [I + 1, Length(FSegments)])); { Сгенерированные вставки берутся из файла, который заведомо длиннее @@ -712,25 +972,28 @@ begin кадру нечего — они начинаются с нуля, а ноль всегда опорный. } if (FSegments[I].Kind <> skVideo) and (FSegments[I].SubFile = '') then begin - Dst := FCacheDir + Format('part_%.3d_a%s', [I, FIntermediateExt]); + Dst := PartDst('a', I); Rep.Index := I; Rep.SourcePath := FSegments[I].FilePath; Rep.RequestedStart := 0; Rep.ActualStart := 0; Rep.Duration := FSegments[I].Duration; Rep.Packets := -1; + Rep.WantFrames := FrameCount(FSegments[I].Duration); 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; + if NeedRun(Dst) then + if not RunPart(ArgsExtract(FSegments[I].FilePath, Dst, + 0, FSegments[I].Duration, FIntermediateFormat, + FSegments[I].Volume, FMaster.AudioCodec, Rep.WantFrames, WithAudio, + PartAt), 'Подготовка вставки ' + IntToStr(I + 1), + Rep.WantFrames) then + Exit; Rep.TempPath := Dst; - - MarkDone(ExtractFileName(Dst)); + PartSent(Rep.WantFrames); + PartDone(Dst); AddPart(Rep); Continue; end; @@ -742,32 +1005,44 @@ begin begin SetStage(Format('Собираю наложение, кусок %d из %d', [I + 1, Length(FSegments)])); - Dst := FCacheDir + Format('part_%.3d_x%s', [I, FIntermediateExt]); + Dst := PartDst('x', I); Rep.Index := I; Rep.SourcePath := FSegments[I].Layers[0].FilePath; Rep.RequestedStart := FSegments[I].Layers[0].SrcStart; Rep.ActualStart := Rep.RequestedStart; Rep.Duration := FSegments[I].Duration; Rep.Packets := -1; + Rep.WantFrames := FrameCount(FSegments[I].Duration); Rep.Encoded := True; FStepWork := FSegments[I].Duration; - if not RunFfmpeg(ArgsRenderLayers(FSegments[I].Layers, Dst, + if NeedRun(Dst) then + if not RunPart(ArgsRenderLayers(FSegments[I].Layers, Dst, FSegments[I].Duration, FMaster.Width, FMaster.Height, FMaster.FpsNum, FMaster.FpsDen, FMaster.PixFmt, PreferredEncoder(FMaster.VideoCodec), FIntermediateFormat = 'mpegts', FMaster.VideoBitrate, - FSegments[I].SubFile), - 'Наложение в куске ' + IntToStr(I + 1)) then + FSegments[I].SubFile, PartAt), + 'Наложение в куске ' + IntToStr(I + 1), Rep.WantFrames) then Exit; Rep.TempPath := Dst; - - MarkDone(ExtractFileName(Dst)); + PartSent(Rep.WantFrames); + PartDone(Dst); AddPart(Rep); Continue; end; + { Индекс опорных кадров нужен резу: точно отрезать можно только зная, + где ближайший опорный кадр. Строим его до разбора веток, чтобы + кусок без индекса ушёл на пересборку целиком, а не резался наугад: + наугад — это уехавшее начало и разошедшийся с ним звук. } + HasIndex := BuildKeyframeIndex(FSegments[I].FilePath, Index, IndexError); + if not HasIndex then + Log(Format('Кусок %d: индекс опорных кадров недоступен (%s), ' + + 'кусок пересобирается целиком — без индекса точный рез невозможен.', + [I + 1, IndexError])); + { Кусок от файла, не совпадающего с параметрами проекта, или с вжигаемым текстом. Скопировать его нельзя — пересобираем. Но только его: соседние куски, снятые тем же оборудованием, что и весь @@ -778,17 +1053,19 @@ begin параметрах проекта. Раньше они уходили в ветку выше и копировались вместе с текстом мимо: галка вжигания стояла, а надписи на фотографии не появлялось. } - if FSegments[I].Transcode or (FSegments[I].SubFile <> '') then + if FSegments[I].Transcode or (FSegments[I].SubFile <> '') or + (not HasIndex) then begin SetStage(Format('Пересобираю кусок %d из %d (файл не совпадает с проектом)', [I + 1, Length(FSegments)])); - Dst := FCacheDir + Format('part_%.3d_a%s', [I, FIntermediateExt]); + Dst := PartDst('a', I); 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.WantFrames := FrameCount(FSegments[I].Duration); Rep.Encoded := True; FStepWork := FSegments[I].Duration; @@ -800,117 +1077,135 @@ begin Rep.RequestedStart := FSegments[I].SrcStart; Rep.ActualStart := Rep.RequestedStart; - if not RunFfmpeg(ArgsTranscodeSegment(FSegments[I].FilePath, Dst, + if NeedRun(Dst) then + if not RunPart(ArgsTranscodeSegment(FSegments[I].FilePath, Dst, Rep.RequestedStart, Rep.RequestedStart + 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, FSegments[I].SubFile, - FMaster.VideoBitrate), - 'Пересборка куска ' + IntToStr(I + 1)) then + FMaster.VideoBitrate, PartAt), + 'Пересборка куска ' + IntToStr(I + 1), Rep.WantFrames) then Exit; Rep.TempPath := Dst; - - MarkDone(ExtractFileName(Dst)); + PartSent(Rep.WantFrames); + PartDone(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; + { Сколько кадров должно быть в куске. Дальше это число и правит бал: + ffmpeg получает его прямо, а не вычисляет из времён. } + WantFrames := FrameCount(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 + { Начало уже на опорном кадре — перекодировать нечего, копируем прямо + с него. Это не поблажка точности: результат ровно тот же, просто + достался даром. Так же выходит у материала, где опорный каждый кадр. + + Кадры предыдущей группы за опорным не тянутся — проверено замером + на записи с B-кадрами: первым кадром копии выходит именно он. } + if Abs(SnapNearest(Index, FSegments[I].SrcStart) - + FSegments[I].SrcStart) < HalfFrame then + begin + Dst := PartDst('a', I); + FStepWork := FSegments[I].Duration; + if NeedRun(Dst) then + if not RunPart(ArgsExtract(FSegments[I].FilePath, Dst, + FSegments[I].SrcStart, SegEnd, FIntermediateFormat, + FSegments[I].Volume, FMaster.AudioCodec, WantFrames, WithAudio, + PartAt), 'Вырезание куска ' + IntToStr(I + 1), WantFrames) then + Exit; + + Rep.ActualStart := FSegments[I].SrcStart; + Rep.Duration := FSegments[I].Duration; + Rep.WantFrames := WantFrames; + Rep.TempPath := Dst; + Rep.Encoded := False; + PartSent(WantFrames); + PartDone(Dst); + AddPart(Rep); + Continue; + end; + + { Точный рез. Копировать можно только с опорного кадра, поэтому + отрезок от запрошенной точки до следующего опорного кадра + пересобираем заново, а всё, что дальше, копируем как обычно. + Перекодируются доли секунды, а не весь материал. } 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)])); + { Кадры делятся между огрызком и копией без остатка: сколько не + достанется перекодированию, столько возьмёт копирование. Так стык + не даёт ни дырки, ни задвоенного кадра, а весь кусок выходит ровно + той длины, которую просил монтаж. } + HeadFrames := FrameCount(EncodeUntil - FSegments[I].SrcStart); + if HeadFrames > WantFrames then + HeadFrames := WantFrames; + TailFrames := WantFrames - HeadFrames; - Dst := FCacheDir + Format('part_%.3d_a%s', [I, FIntermediateExt]); + Log(Format('Кусок %d: точный рез, перекодирую %s..%s (%s с, %d кадров), ' + + 'копирую %d кадров', + [I + 1, SecondsToStr(FSegments[I].SrcStart), SecondsToStr(EncodeUntil), + SecondsToStr(EncodeUntil - FSegments[I].SrcStart), + HeadFrames, TailFrames])); + + Dst := PartDst('a', I); FStepWork := EncodeUntil - FSegments[I].SrcStart; - if not RunFfmpeg(ArgsEncodeFragment(FSegments[I].FilePath, Dst, + if NeedRun(Dst) then + if not RunPart(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 + FMaster.SampleRate, FMaster.Channels, FIntermediateFormat, + HeadFrames, WithAudio, FMaster.VideoBitrate, PartAt), + 'Перекодирование стыка куска ' + IntToStr(I + 1), HeadFrames) then Exit; Rep.ActualStart := FSegments[I].SrcStart; Rep.Duration := EncodeUntil - FSegments[I].SrcStart; + Rep.WantFrames := HeadFrames; Rep.TempPath := Dst; Rep.Encoded := True; - MarkDone(ExtractFileName(Dst)); + PartSent(HeadFrames); + PartDone(Dst); AddPart(Rep); - if EncodeUntil < SegEnd - 0.0005 then + if TailFrames > 0 then begin - Dst := FCacheDir + Format('part_%.3d_b%s', [I, FIntermediateExt]); + Dst := PartDst('b', I); FStepWork := SegEnd - EncodeUntil; - if not RunFfmpeg(ArgsExtract(FSegments[I].FilePath, Dst, - EncodeUntil, SegEnd, FIntermediateFormat, - FSegments[I].Volume, FMaster.AudioCodec), - 'Вырезание куска ' + IntToStr(I + 1)) then - Exit; + { Копия начинается ровно с опорного кадра: проверено замером — + первым кадром выходит именно он, кадры предыдущей группы за ним + не тянутся. Значит стык с огрызком получается кадр в кадр. } + if NeedRun(Dst) then + if not RunPart(ArgsExtract(FSegments[I].FilePath, Dst, + EncodeUntil, SegEnd, FIntermediateFormat, + FSegments[I].Volume, FMaster.AudioCodec, TailFrames, WithAudio, + PartAt), 'Вырезание куска ' + IntToStr(I + 1), TailFrames) then + Exit; Rep.ActualStart := EncodeUntil; Rep.Duration := SegEnd - EncodeUntil; + Rep.WantFrames := TailFrames; Rep.TempPath := Dst; Rep.Encoded := False; - MarkDone(ExtractFileName(Dst)); + PartSent(TailFrames); + PartDone(Dst); 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; - MarkDone(ExtractFileName(Dst)); - AddPart(Rep); end; SetLength(FReport.Segments, PartCount); @@ -921,12 +1216,35 @@ function TExportThread.WriteConcatList(out AListPath: string): Boolean; var List: TStringList; I: Integer; + FrameSeconds: Double; begin + FrameSeconds := 0; + if (FMaster.FpsNum > 0) and (FMaster.FpsDen > 0) then + FrameSeconds := FMaster.FpsDen / FMaster.FpsNum; + AListPath := FCacheDir + 'concat.txt'; List := TStringList.Create; try for I := 0 to High(FReport.Segments) do + begin List.Add(ConcatListLine(FReport.Segments[I].TempPath)); + + { Длительность куска задаётся явно, а не берётся из его контейнера. + + Зачем. У скопированного куска последний пакет в порядке + декодирования может показываться позже всех прочих — так устроено + межкадровое сжатие, и оборванная на резе группа кадров оставляет + такой хвост. Контейнер честно считает его в длительность, склейка + сдвигает на неё следующий кусок, и время картинки растягивается: + замерено 0.05 с лишку на кусок, а к концу ролика — секунды. Звук + при этом набран точно по монтажу и никуда не растягивается, вот + картинка от него и уезжает. + + Число кадров нам известно точно — от него и считаем. } + if (FrameSeconds > 0) and (FReport.Segments[I].WantFrames > 0) then + List.Add('duration ' + + SecondsToStr(FReport.Segments[I].WantFrames * FrameSeconds)); + end; try { Концы строк только LF: список читает разборщик ffmpeg, а не текстовый редактор, и лишний возврат каретки попадёт в имя файла. } @@ -982,6 +1300,256 @@ begin FOutputPath), 'Склейка'); end; +{ Сборка потоком. + + Приёмник запускается первым и живёт до конца: он держит открытым + готовый файл. Куски шлются в него по очереди, каждый со своим временем. + Закрытый ввод для приёмника — знак, что материал кончился; только после + этого он дописывает оглавление и завершается. + + Звук должен быть готов заранее: приёмник берёт его вторым входом. } +{ Продолжение прерванной сборки при работе потоком. + + Кэша кусков тут нет, и продолжать не с чего — кроме самого + недописанного файла. Он и есть уже собранная часть фильма: в нём видно, + сколько целых кадров успело записаться. + + Дописать в него нельзя: Matroska не даёт приписывать в конец. Поэтому + он отодвигается в сторону, продолжение собирается в новый файл, и целая + часть старого переливается туда первой — ровно так же, как обычный + кусок. + + MP4 сюда не попадает: его оглавление пишется в конец, и оборванный файл + не открывается вовсе. } +procedure TExportThread.FirstVideoLine(const ALine: string); +var + Value: Double; +begin + if not TryStrToFloat(Trim(ALine), Value, InvariantFormat) then + Exit; + if (FFirstVideoPts < 0) or (Value < FFirstVideoPts) then + FFirstVideoPts := Value; +end; + +function TExportThread.FirstVideoTime(const APath: string): Double; +var + Res: TProcResult; +begin + FFirstVideoPts := -1; + Res := RunProcess(FfprobeExe, ArgsFirstVideoTimes(APath), + @FirstVideoLine, nil, @CancelQuery); + if (not Res.Started) or (Res.ExitCode <> 0) then + Exit(-1); + Result := FFirstVideoPts; +end; + +procedure TExportThread.PrepareResume; +var + Good: Int64; +begin + FResumeSource := ''; + FResumeGood := 0; + FResumeShift := 0; + FPrefixSent := False; + + if CancelQuery or not (FResume and FileExists(FOutputPath)) then + Exit; + + if LowerCase(ExtractFileExt(FOutputPath)) <> '.mkv' then + begin + Log('Продолжить нельзя: оборванный ' + + Copy(ExtractFileExt(FOutputPath), 2, 10) + ' не читается. Собираю заново.'); + Exit; + end; + + if UnfinishedFrames(FOutputPath) <= 0 then + begin + Log('Рядом с файлом нет отметки о незаконченной сборке — считаю его ' + + 'готовым и собираю заново.'); + Exit; + end; + + Good := CountPackets(FOutputPath); + if Good <= 0 then + begin + Log('В недописанном файле читаемых кадров нет, собираю заново.'); + Exit; + end; + + FResumeSource := FOutputPath; + FResumeGood := Good; + FResumeShift := FirstVideoTime(FOutputPath); + if FResumeShift < 0 then + FResumeShift := 0; + Log(Format('В недописанном файле читается %d кадров — продолжаю с ' + + 'ближайшей границы куска. Ролик в нём начинается с %s.', + [Good, SecondsToStr(FResumeShift)])); +end; + +function TExportThread.SendPrefix: Boolean; +var + Upto: Double; +begin + FPrefixSent := True; + if FSentFrames <= 0 then + begin + { Первый же кусок не влез целиком — брать из старого файла нечего. } + Log('Целых кусков в недописанном файле не нашлось, собираю заново.'); + Exit(True); + end; + + SetStage('Переношу собранное прошлый раз'); + { Времени с запасом: длину задаёт число кадров, а -to здесь только + ограничитель на случай, если кадров в файле окажется больше. Отсчёт + от сдвига: в старом файле ролик начинается не с нуля. } + Upto := FResumeShift + (FSentFrames + 2) * FMaster.FpsDen / FMaster.FpsNum; + FStepWork := SentTime; + { Сдвиг снимается: куски, которые пойдут следом, встают на свои места + по счёту кадров от нуля, и перенесённое должно лечь на ту же сетку. + Приёмник потом сдвинет всё обратно — ровно так же, как при сборке с + начала. } + Result := RunPart(ArgsExtract(FResumeSource, 'pipe:1', 0, Upto, + 'mpegts', 1, '', FSentFrames, False, -FResumeShift), + 'Перенос собранного прошлый раз', 0); + if Result then + Log(Format('Перенесено %d кадров, продолжаю с %s.', + [FSentFrames, SecondsToStr(SentTime)])); +end; + +{ Что делать с двумя файлами по итогам сборки: тем, что писали сейчас, и + тем, что лежал раньше. + + Удача — новый занимает место готового. Неудача — остаётся тот из двух, + в котором кадров больше: с него и продолжат в следующий раз. Прошлую + работу нельзя терять из-за того, что новая попытка сорвалась раньше. } +procedure TExportThread.FinishResume(ASucceeded: Boolean; const AWork: string); +var + New_, Old: Int64; +begin + if ASucceeded then + begin + DeleteFile(FOutputPath); + if not RenameFile(AWork, FOutputPath) then + begin + FReport.Message := 'Ролик собран, но переименовать его не удалось: ' + + AWork; + Log(FReport.Message); + end; + DeleteFile(UnfinishedMark(FOutputPath)); + Exit; + end; + + if not FileExists(FOutputPath) then + begin + { Прошлого файла не было — недописанный занимает его место, с него и + продолжат. } + RenameFile(AWork, FOutputPath); + MarkUnfinished(CountPackets(FOutputPath, True)); + Exit; + end; + + New_ := CountPackets(AWork, True); + Old := CountPackets(FOutputPath, True); + if New_ > Old then + begin + DeleteFile(FOutputPath); + RenameFile(AWork, FOutputPath); + Log(Format('Недописанного стало больше: %d кадров против %d.', + [New_, Old])); + MarkUnfinished(New_); + end + else + begin + DeleteFile(AWork); + if Old > 0 then + Log(Format('Прошлый недописанный файл полнее (%d кадров против %d), ' + + 'он и оставлен.', [Old, New_])); + MarkUnfinished(Old); + end; +end; + +{ Отметка «файл недописан» рядом с ним самим. + + Нужна затем, чтобы отличить оборванную сборку от готового ролика: по + самому файлу это не видно — недописанный MKV открывается и играет. + Без отметки программа предлагала бы продолжить сборку поверх готового + фильма. } +procedure TExportThread.MarkUnfinished(AFrames: Int64); +var + F: TextFile; +begin + if AFrames <= 0 then + begin + DeleteFile(UnfinishedMark(FOutputPath)); + Exit; + end; + try + AssignFile(F, UnfinishedMark(FOutputPath)); + Rewrite(F); + try + WriteLn(F, AFrames); + finally + CloseFile(F); + end; + except + { Не записалось — в следующий раз просто соберётся заново. } + end; +end; + +function TExportThread.StreamAll: Boolean; +var + Args: TArgs; + Work: string; + Code: Integer; +begin + Result := False; + PrepareResume; + + { Пишем не сразу в готовый файл, а рядом. + + Так прошлая работа цела до последнего: недописанный файл прошлого + раза — это уже собранная часть фильма, и стереть её новой попыткой, + которая сорвётся раньше, значило бы отобрать у человека то, что уже + посчитано. Место готового новый файл займёт, только когда будет + дописан. } + { Расширение то же, что у готового: по нему ffmpeg выбирает контейнер. } + Work := ChangeFileExt(FOutputPath, '.сборка' + ExtractFileExt(FOutputPath)); + DeleteFile(Work); + + Args := ArgsStreamMux(FAudioPath, FSubtitlePath, Work); + Log('> ' + CommandToString(FfmpegExe, Args) + ' (приёмник)'); + + FSink := TProcSink.Create(FfmpegExe, Args, nil, @ErrorLine); + try + if not FSink.Started then + begin + FReport.Message := FSink.Error; + Exit; + end; + + if not ExtractSegments then + begin + { Приёмнику работать больше не для кого. Недописанный файл остаётся + лежать: с него продолжают прерванную сборку. } + FSink.Stop; + Exit; + end; + + SetStage('Дописываю файл'); + Code := FSink.Wait; + if Code <> 0 then + begin + FReport.Message := 'Сборка потоком: ffmpeg завершился с кодом ' + + IntToStr(Code) + '. Подробности в журнале.'; + Exit; + end; + Result := True; + finally + FreeAndNil(FSink); + FinishResume(Result, Work); + end; +end; + procedure TExportThread.Verify; var I: Integer; @@ -992,7 +1560,13 @@ begin Sum := 0; for I := 0 to High(FReport.Segments) do begin - N := CountPackets(FReport.Segments[I].TempPath); + { Потоком кусков на диске нет, и считать в них нечего: сколько кадров + каждый кусок должен был дать, мы и так знали заранее — именно это + число получал ffmpeg ключом -frames:v. } + if FStreaming then + N := FReport.Segments[I].WantFrames + else + N := CountPackets(FReport.Segments[I].TempPath); FReport.Segments[I].Packets := N; if N > 0 then Inc(Sum, N); @@ -1006,6 +1580,91 @@ end; { --- Звук --- } +{ «Разогрев» кодировщика звука в секундах. + + Сжатый звук начинается с нескольких сотен служебных отсчётов: кодировщик + не может выдать первый кадр, не заглянув вперёд. Контейнер MP4 помечает + их отрицательной меткой времени и проигрыватель их пропускает, а + Matroska такой пометки не хранит — при копировании звук целиком уезжает + позже картинки. Замерено: 21.3 мс, ровно 1024 отсчёта. + + Величина не угадывается и не зашивается числом: кодируется короткая + тишина тем же кодировщиком, и у полученного файла спрашивается метка + первого пакета. Не вышло — возвращаем ноль и ничего не компенсируем: + лучше известная малая погрешность, чем случайный сдвиг. } +function TExportThread.EncoderPriming(ARate, AChannels: Integer): Double; +var + RawPath, OutPath: string; + Stream: TFileStream; + Zero: array[0..4095] of Byte; + I: Integer; + Res: TProcResult; + Value: Double; +begin + Result := 0; + RawPath := FCacheDir + 'priming.raw'; + OutPath := FCacheDir + 'priming.m4a'; + try + try + Stream := TFileStream.Create(RawPath, fmCreate); + try + FillChar(Zero, SizeOf(Zero), 0); + { Полсекунды тишины: кодировщику хватает, а времени это не стоит. } + for I := 1 to Round(ARate * AChannels * 2 * 0.5) div SizeOf(Zero) do + Stream.WriteBuffer(Zero, SizeOf(Zero)); + finally + Stream.Free; + end; + + Res := RunProcess(FfmpegExe, + ArgsEncodeAudio(RawPath, OutPath, ARate, AChannels, + FMaster.AudioCodec), nil, nil, nil); + if (not Res.Started) or (Res.ExitCode <> 0) or (not FileExists(OutPath)) then + Exit; + + FFirstAudioPts := 0; + Res := RunProcess(FfprobeExe, ArgsFirstPacketTime(OutPath), + @FirstPtsLine, nil, nil); + if (not Res.Started) or (Res.ExitCode <> 0) then + Exit; + + Value := -FFirstAudioPts; + { Разумные пределы: отрицательная метка бывает от долей миллисекунды + до кадра звука. Всё, что вне, — не разогрев, а недоразумение. } + if (Value > 0) and (Value < 0.1) then + begin + Result := Value; + Log(Format('Разогрев кодировщика звука: %s с — на столько сдвинулся бы звук, компенсирую.', + [SecondsToStr(Value)])); + end; + except + { Не вышло — просто не компенсируем. } + end; + finally + SysUtils.DeleteFile(RawPath); + SysUtils.DeleteFile(OutPath); + end; +end; + +procedure TExportThread.FirstPtsLine(const ALine: string); +var + Value: Double; + Text: string; +begin + Text := Trim(ALine); + { ffprobe печатает строку с висящей запятой — «-0.021333,». Отрезаем + всё с неё: иначе разбор числа не удаётся, и замер молча не работает. } + if Pos(',', Text) > 0 then + Text := Trim(Copy(Text, 1, Pos(',', Text) - 1)); + if Text = '' then + Exit; + { Первая же разобранная строка и есть метка первого пакета. } + if FFirstAudioPts <> 0 then + Exit; + if TryStrToFloat(Text, Value, InvariantFormat) then + FFirstAudioPts := Value; +end; + function TExportThread.BuildAudio: Boolean; var RawPath, PartPath: string; @@ -1105,7 +1764,8 @@ begin SetStage('Сжимаю звук'); FAudioPath := FCacheDir + 'audio.m4a'; Res := RunProcess(FfmpegExe, - ArgsEncodeAudio(RawPath, FAudioPath, Rate, Channels, FMaster.AudioCodec), + ArgsEncodeAudio(RawPath, FAudioPath, Rate, Channels, FMaster.AudioCodec, + EncoderPriming(Rate, Channels)), @ProgressLine, @ErrorLine, @CancelQuery); if Res.Cancelled then Exit; @@ -1232,7 +1892,7 @@ var ListPath: string; I: Integer; Freed: Int64; - ToolError: string; + ToolError, StreamWhy: string; begin try if Length(FSegments) = 0 then @@ -1258,30 +1918,49 @@ begin Log('Временные куски: ' + FCacheDir); ChooseIntermediateFormat; + + { Потоком или через кэш кусков. + + Потоком на диск не ложится ничего, кроме готового файла, и весь + материал переписывается один раз вместо двух. Куски при этом идут + в MPEG-TS, поэтому формат промежутка здесь не обсуждается. } + FStreaming := CanStream(StreamWhy); + if FStreaming then + begin + FIntermediateFormat := 'mpegts'; + FIntermediateExt := '.ts'; + Log('Собираю потоком: куски идут сразу в готовый файл, кэш не ' + + 'создаётся.'); + end + else + Log('Собираю через кэш кусков: ' + StreamWhy + '.'); + { Список готовых кусков — после выбора промежуточного формата: от него зависят их имена. } LoadDoneList; - if FResume and (FDone.Count > 1) then + if (not FStreaming) and FResume and (FDone.Count > 1) then Log(Format('Продолжаю прерванную сборку: готовых кусков %d.', [FDone.Count - 1])); { Единица учёта работы — секунда материала. Каждая секунда проходит - через вырезание, склейку и сборку звука, отсюда тройной вес. } - FTotalWork := FReport.TotalDuration * 3; + через вырезание, склейку и сборку звука, отсюда тройной вес. + Потоком склейки отдельным проходом нет, и вес вдвое меньше. } + if FStreaming then + FTotalWork := FReport.TotalDuration * 2 + else + FTotalWork := FReport.TotalDuration * 3; FDoneWork := 0; - if not ExtractSegments then - Exit; - if not WriteConcatList(ListPath) then - Exit; - { Звук собирается раньше картинки, и склейка сразу кладёт всё вместе в конечный файл. Так было не всегда: сперва картинка собиралась в отдельный файл, а потом сшивалась со звуком. На часовом ролике это 91 ГБ промежуточного файла и лишний полный проход копирования — места - требовалось вдвое больше готового ролика. } + требовалось вдвое больше готового ролика. + + При сборке потоком порядок ещё и обязателен: приёмник берёт звук + вторым входом и запускается раньше первого куска картинки. } FVideoPath := ''; if not BuildAudio then begin @@ -1292,8 +1971,21 @@ begin FAudioPath := ''; end; - if not ConcatAll(ListPath) then - Exit; + ListPath := ''; + if FStreaming then + begin + if not StreamAll then + Exit; + end + else + begin + if not ExtractSegments then + Exit; + if not WriteConcatList(ListPath) then + Exit; + if not ConcatAll(ListPath) then + Exit; + end; Verify; diff --git a/src/uFfmpegCmd.pas b/src/uFfmpegCmd.pas index 8da9507..d9846ca 100644 --- a/src/uFfmpegCmd.pas +++ b/src/uFfmpegCmd.pas @@ -35,6 +35,13 @@ uses type TArgs = array of string; +const + { Значение AAt у сборщиков аргументов, означающее «пишем в файл, а не в + трубу». Отдельная величина, а не просто «меньше нуля»: время куска в + потоке бывает и отрицательным — так с перенесённого куска снимается + сдвиг, который прошлая сборка наложила на весь ролик. } + NotPiped = -1000000.0; + { Пути к инструментам. Ищутся один раз и запоминаются. } function FfmpegExe: string; function FfprobeExe: string; @@ -57,10 +64,21 @@ function ToolsAvailable(out AError: string): Boolean; AVolume — множитель громкости. При единице звук копируется как есть; при любом другом значении его приходится пересобрать, потому что громкость нельзя изменить, не тронув сам звук. Видео при этом - по-прежнему копируется — перекодируется только звуковая дорожка. } + по-прежнему копируется — перекодируется только звуковая дорожка. + + AFrames — сколько кадров картинки должно оказаться в куске. Ноль — + сколько выйдет. + + Зачем считать кадры, когда есть время начала и конца. При копировании + потока ffmpeg отмеряет конец по времени декодирования, а не показа, и у + записи с B-кадрами это разные вещи: кусок выходит на пару кадров длиннее + запрошенного. Куски идут один за другим, и эта пара кадров копится — + замерено 0.42 с лишней картинки на шести кусках. Число кадров такой + двусмысленности не имеет. } function ArgsExtract(const ASrc, ADst: string; AStart, AEnd: Double; const AFormat: string; AVolume: Double = 1; - const AAudioCodec: string = ''): TArgs; + const AAudioCodec: string = ''; AFrames: Integer = 0; + AWithAudio: Boolean = True; AAt: Double = NotPiped): TArgs; { Перепаковать файл целиком в заданный формат, копируя потоки. } function ArgsCopyTo(const ASrc, ADst, AFormat: string): TArgs; @@ -75,7 +93,9 @@ 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; + ASampleRate, AChannels: Integer; const AFormat: string; + AFrames: Integer = 0; AWithAudio: Boolean = True; + ABitrate: Int64 = 0; AAt: Double = NotPiped): TArgs; { Пересобрать кусок в параметры проекта. @@ -87,7 +107,8 @@ function ArgsTranscodeSegment(const ASrc, ADst: string; AStart, AEnd: Double; const AVideoCodec, APixFmt, AAudioCodec: string; ASampleRate, AChannels: Integer; AVolume: Double; const AFormat: string; const AFilter: string = ''; - const ASubFile: string = ''; ABitrate: Int64 = 0): TArgs; + const ASubFile: string = ''; ABitrate: Int64 = 0; + AAt: Double = NotPiped): TArgs; { Путь внутри строки фильтра. Двоеточие там разделяет настройки, обратная косая и кавычка имеют своё значение — всё это надо обезвредить, иначе @@ -127,6 +148,12 @@ function ArgsConcat(const AListFile, ADst: string): TArgs; надо. Пусто в AAudio — значит звука нет, тогда это обычная склейка. } function ArgsConcatMux(const AListFile, AAudio, ASubFile, ADst: string): TArgs; +{ Приёмник сборки потоком: читает MPEG-TS из трубы и пишет готовый файл. + + То же, что ArgsConcatMux, только куски приходят не списком файлов, а + одним потоком в стандартный ввод. AAudio и ASubFile — как там. } +function ArgsStreamMux(const AAudio, ASubFile, ADst: string): TArgs; + { Склеить куски и сразу перекодировать картинку в заданный размер и поток. Нужно для сборки «под площадку»: когда ролик надо отдать в 1080p с @@ -151,9 +178,17 @@ function ArgsExtractAudioRaw(const ASource, ATarget: string; const AStart, ADuration: Double; ARate, AChannels: Integer; const AVolume: Double): TArgs; -{ Сжатие собранного сырого звука. Один проход на весь ролик. } +{ Сжатие собранного сырого звука. Один проход на весь ролик. + + ASkipSeconds — сколько отбросить от начала. Нужно, чтобы погасить + «разогрев» кодировщика: сжатый звук начинается с нескольких сотен + отсчётов служебного мусора, контейнер MP4 помечает их как пропускаемые, + а Matroska такой пометки не хранит — и при копировании звук уезжает + позже картинки на время разогрева (замерено 21.3 мс). Отбросив ровно + столько же от начала, мы возвращаем содержимое на место. } function ArgsEncodeAudio(const ASource, ATarget: string; - ARate, AChannels: Integer; const ACodec: string): TArgs; + ARate, AChannels: Integer; const ACodec: string; + ASkipSeconds: Double = 0): TArgs; { Пересборка участка с наложением: два слоя сводятся в один кадр. @@ -163,12 +198,19 @@ function ArgsEncodeAudio(const ASource, ATarget: string; ASubFile — разметка текста, которую надо вжечь в этот кусок. Пусто — не вжигать. Без этого текст пропадал везде, где есть наложение: кусок шёл - этой веткой, а она про субтитры не знала. } + этой веткой, а она про субтитры не знала. + + AHwDecode — распаковывать исходники видеокартой. На длинном затухании + это разница между тремя минутами и одной: замерено на HEVC 2688x1512, + 13.5 с против 3.3 с на десяти секундах материала, картинка бит в бит + та же. Признак необязательный: не пойдёт — вызывающий повторит без + него, как это уже делает склейка с перекодированием. } function ArgsRenderLayers(const ALayers: array of TSegmentLayer; const ATarget: string; const ADuration: Double; AWidth, AHeight, AFpsNum, AFpsDen: Integer; const APixFmt, ACodec: string; AIsTs: Boolean; - ABitrate: Int64 = 0; const ASubFile: string = ''): TArgs; + ABitrate: Int64 = 0; const ASubFile: string = ''; + AAt: Double = NotPiped; AHwDecode: Boolean = False): TArgs; { Сшивание готовой картинки с готовым звуком. Оба потока копируются. @@ -190,10 +232,18 @@ function ArgsProbeDuration(const ASrc: string): TArgs; декодирования. Читает файл целиком, но не распаковывает. } function ArgsCountVideoPackets(const ASrc: string): TArgs; +{ Метка времени первого звукового пакета. У сжатого звука она + отрицательная — на величину разогрева кодировщика. } +function ArgsFirstPacketTime(const ASrc: string): TArgs; + { Метки времени и признаки всех видеопакетов. Запасной путь построения индекса опорных кадров для контейнеров, кроме MP4. } function ArgsPacketFlags(const ASrc: string): TArgs; +{ Метки первых кадров картинки: по ним видно, с какого времени начинается + файл. Нужно продолжению прерванной сборки. } +function ArgsFirstVideoTimes(const ASrc: string): TArgs; + { Название кодировщика для кодека. Предпочитается аппаратный NVENC: на этой машине он кодирует HEVC в @@ -259,6 +309,10 @@ uses слоёв, а она по тексту раньше самой функции. } function BitrateArgs(ABitrate: Int64): TArgs; forward; +{ Хвост вывода: куда писать и как докладывать о ходе работы. Объявлено + здесь по той же причине — отрисовка слоёв идёт раньше. } +function TailArgs(const AFormat, ADst: string; AAt: Double): TArgs; forward; + const { Поток для чёрных вставок: мегабит в секунду. } BlackBitrate = 1000000; @@ -289,7 +343,8 @@ begin end; function ArgsEncodeAudio(const ASource, ATarget: string; - ARate, AChannels: Integer; const ACodec: string): TArgs; + ARate, AChannels: Integer; const ACodec: string; + ASkipSeconds: Double): TArgs; var Codec: string; begin @@ -297,20 +352,38 @@ begin if Codec = '' then Codec := 'aac'; Result := ['-hide_banner', '-nostdin', '-loglevel', 'error', '-y', - '-f', 's16le', '-ar', IntToStr(ARate), '-ac', IntToStr(AChannels), - '-i', ASource, '-c:a', Codec, '-b:a', '192k', - '-progress', 'pipe:1', '-nostats', ATarget]; + '-f', 's16le', '-ar', IntToStr(ARate), '-ac', IntToStr(AChannels)]; + if ASkipSeconds > 0 then + Result := Concat(Result, ['-ss', SecondsToStr(ASkipSeconds)]); + Result := Concat(Result, ['-i', ASource, '-c:a', Codec, '-b:a', '192k', + '-progress', 'pipe:1', '-nostats', ATarget]); end; function ArgsRenderLayers(const ALayers: array of TSegmentLayer; const ATarget: string; const ADuration: Double; AWidth, AHeight, AFpsNum, AFpsDen: Integer; const APixFmt, ACodec: string; AIsTs: Boolean; - ABitrate: Int64; const ASubFile: string): TArgs; + ABitrate: Int64; const ASubFile: string; AAt: Double; + AHwDecode: Boolean): TArgs; var I: Integer; Graph, Fit, Src, OutLabel: string; Crossfade: Boolean; + + { Распаковка на видеокарте. Ключ входной, поэтому ставится перед + каждым входом отдельно. + + Просим её только там, где кодировать будет та же карта: раз NVENC + выбран, значит карта есть и драйвер её видит. На машине без неё ключ + не появится вовсе, и просить откат будет не о чем. } + function HwArgs: TArgs; + begin + if AHwDecode and (Pos('nvenc', PreferredEncoder(ACodec)) > 0) then + Result := ['-hwaccel', 'cuda'] + else + Result := nil; + end; + begin Result := ['-hide_banner', '-nostdin', '-loglevel', 'warning', '-y']; @@ -328,7 +401,7 @@ begin '-t', SecondsToStr(ADuration), '-i', ALayers[I].FilePath]) else - Result := Concat(Result, + Result := Concat(Concat(Result, HwArgs), ['-ss', SecondsToStr(ALayers[I].SrcStart), '-t', SecondsToStr(ADuration), '-i', ALayers[I].FilePath]); @@ -420,12 +493,11 @@ begin '-c:v', PreferredEncoder(ACodec), '-r', Format('%d/%d', [AFpsNum, AFpsDen]), '-pix_fmt', APixFmt]); Result := Concat(Result, BitrateArgs(ABitrate)); - Result := Concat(Result, - ['-bf', '0', '-an', '-avoid_negative_ts', 'make_zero', - '-progress', 'pipe:1', '-nostats']); + Result := Concat(Result, ['-bf', '0', '-an']); if AIsTs then - Result := Concat(Result, ['-f', 'mpegts']); - Result := Concat(Result, [ATarget]); + Result := Concat(Result, TailArgs('mpegts', ATarget, AAt)) + else + Result := Concat(Result, TailArgs('', ATarget, AAt)); end; function ArgsMux(const AVideo, AAudio, ATarget: string; @@ -541,6 +613,72 @@ begin Result := ['-progress', 'pipe:1', '-nostats']; end; +{ То же, когда стандартный вывод занят: в него идёт сам материал. + + Прогресс тогда отправляется в поток ошибок, вперемешку с журналом. + Строки там разные и разбираются по-разному, так что смешение не мешает: + ход работы — это «ключ=значение», журнал — обычный текст. } +function ProgressArgsToStderr: TArgs; +begin + Result := ['-progress', 'pipe:2', '-nostats']; +end; + +{ Хвост вывода: файл или труба. + + AAt < 0 — обычный файл в заданном контейнере. AAt >= 0 — труба, и тогда + контейнер всегда MPEG-TS: только он даёт склеивать куски встык, повторяя + параметры кодека перед каждым опорным кадром. + + -output_ts_offset ставит кусок на его место в общем потоке. Без него + каждый кусок начинался бы с нуля, и приёмник свалил бы их в одну точку. + + -muxdelay и -muxpreload в ноль: обычно MPEG-TS откладывает начало на + семь десятых секунды под буфер проигрывателя, и эта задержка сдвинула бы + каждый кусок относительно заданного ему времени. + + -copyts здесь намеренно нет: с ним метки остаются исходными, и на пробе + ролик из шести кусков по четыре секунды вышел длиной 48.7 с вместо + 24.0. } +function OutputTail(const AFormat, ADst: string; AAt: Double): TArgs; +begin + if AAt <= NotPiped then + begin + { Метки времени вырезанного куска должны начинаться с нуля, иначе при + склейке куски разъедутся по времени. } + Result := ['-avoid_negative_ts', 'make_zero']; + { Пустое имя контейнера — значит его выбирает сам ffmpeg по + расширению файла. } + if AFormat = '' then + Result := Concat(Result, [ADst]) + else + Result := Concat(Result, ['-f', AFormat, ADst]); + Exit; + end; + + { А вот в потоке make_zero всё ломает, и это стоило разбирательства. + Сдвиг к нулю считается уже после того, как применён -output_ts_offset, + и сдвигает кусок обратно в ноль — ключ просто перестаёт действовать. + Замерено: все шесть кусков встали в начало, метки времени в готовом + файле перестали расти, а картинка разошлась с эталоном (PSNR 18 дБ + вместо бесконечности при том же числе кадров и тех же пакетах). + + Поэтому здесь сдвиг к нулю выключен: место куску задаёт offset, а + отрицательные метки в самом начале ролика подберёт приёмник — у него + make_zero свой. } + { initial_discontinuity помечает начало куска как разрыв потока. + + Без него приёмник видит, что счётчик непрерывности прыгнул, и на + каждом стыке пишет «Packet corrupt» — по паре строк на кусок. Данные + при этом целы (сверено побитово), но журнал сборки забивается + жалобами, из-за которых потом не найти настоящую ошибку. С флагом + жалоб нет, а результат тот же: 240 кадров и одинаковый md5. } + Result := ['-avoid_negative_ts', 'disabled', + '-output_ts_offset', SecondsToStr(AAt), + '-muxdelay', '0', '-muxpreload', '0', + '-mpegts_flags', '+initial_discontinuity', + '-f', 'mpegts', 'pipe:1']; +end; + function Concat(const A, B: TArgs): TArgs; var I: Integer; @@ -553,6 +691,16 @@ begin Result[Length(A) + I] := B[I]; end; +{ Ход работы и хвост вывода разом: они всегда меняются вместе. } +function TailArgs(const AFormat, ADst: string; AAt: Double): TArgs; +begin + if AAt <= NotPiped then + Result := ProgressArgs + else + Result := ProgressArgsToStderr; + Result := Concat(Result, OutputTail(AFormat, ADst, AAt)); +end; + { Нужен ли контейнеру перенос заголовка в начало файла. Для MP4 это делает файл пригодным для воспроизведения по мере загрузки. @@ -566,17 +714,25 @@ begin end; function ArgsExtract(const ASrc, ADst: string; AStart, AEnd: Double; - const AFormat: string; AVolume: Double; const AAudioCodec: string): TArgs; + const AFormat: string; AVolume: Double; const AAudioCodec: string; + AFrames: Integer; AWithAudio: Boolean; AAt: Double): TArgs; begin Result := Concat(CommonFfmpegPrefix, [ '-ss', SecondsToStr(AStart), '-to', SecondsToStr(AEnd), '-i', ASrc, - '-map', '0:v:0', - '-map', '0:a:0?' + '-map', '0:v:0' ]); - if Abs(AVolume - 1) < 0.001 then + { Звук в куске картинки обычно лишний: звуковая дорожка ролика + собирается отдельно и точнее. Хуже того, он вредит: у кусков + MPEG-TS звуковой поток начинается не там же, где картинка, склейка + равняется по нему, и куски встают со сдвигом — замерено 36 мс на + стык. } + if AWithAudio then + Result := Concat(Result, ['-map', '0:a:0?']); + + if (not AWithAudio) or (Abs(AVolume - 1) < 0.001) then Result := Concat(Result, ['-c', 'copy']) else begin @@ -591,11 +747,13 @@ begin 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]); + { Ровно столько кадров картинки, сколько просили. Время конца остаётся + как было: оно ограничивает звук куска и служит запасом, если кадров в + исходнике не хватит. } + if AFrames > 0 then + Result := Concat(Result, ['-frames:v', IntToStr(AFrames)]); + + Result := Concat(Result, TailArgs(AFormat, ADst, AAt)); end; function ArgsCopyTo(const ASrc, ADst, AFormat: string): TArgs; @@ -613,7 +771,9 @@ 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; + ASampleRate, AChannels: Integer; const AFormat: string; + AFrames: Integer; AWithAudio: Boolean; ABitrate: Int64; + AAt: Double): TArgs; var HalfFrame, StopAt: Double; begin @@ -641,19 +801,27 @@ begin '-ss', SecondsToStr(AStart), '-to', SecondsToStr(StopAt), '-i', ASrc, - '-map', '0:v:0', - '-map', '0:a:0?' + '-map', '0:v:0' ]); + if AWithAudio then + Result := Concat(Result, ['-map', '0:a:0?']); { Ни размер, ни частота кадров намеренно не задаются. Отрезок берётся из того же файла, что и соседние куски, так что менять ему нечего. Хуже того: принудительная частота включает пересчёт кадров, и на пробе это добавило один лишний кадр на стыке — 601 вместо 600. } + { Битрейт обязателен. Без него кодировщик берёт своё умолчание, а у + NVENC оно около двух мегабит: замерено в готовом ролике 5.7 Мбит/с в + огрызке против 54-60 в скопированном материале рядом. Раньше это + задевало редкие точные резы, а теперь точны все — и мутный огрызок + появлялся на каждом. } Result := Concat(Result, MasterOutputArgs(0, 0, 0, 0, - AVideoCodec, APixFmt, AAudioCodec, ASampleRate, AChannels)); + AVideoCodec, APixFmt, AAudioCodec, ASampleRate, AChannels, ABitrate)); Result := Concat(Result, NoBFramesArgs); - Result := Concat(Result, ['-avoid_negative_ts', 'make_zero']); - Result := Concat(Result, ProgressArgs); - Result := Concat(Result, ['-f', AFormat, ADst]); + { Столько кадров, сколько просили: огрызок стыкуется с копией кадр в + кадр, и лишнему взяться неоткуда. } + if AFrames > 0 then + Result := Concat(Result, ['-frames:v', IntToStr(AFrames)]); + Result := Concat(Result, TailArgs(AFormat, ADst, AAt)); end; function EscapeFilterPath(const APath: string): string; @@ -668,7 +836,7 @@ function ArgsTranscodeSegment(const ASrc, ADst: string; AStart, AEnd: Double; const AVideoCodec, APixFmt, AAudioCodec: string; ASampleRate, AChannels: Integer; AVolume: Double; const AFormat: string; const AFilter: string; - const ASubFile: string; ABitrate: Int64): TArgs; + const ASubFile: string; ABitrate: Int64; AAt: Double): TArgs; var Chain: string; begin @@ -704,9 +872,7 @@ begin Result := Concat(Result, MasterOutputArgs(0, 0, AFpsNum, AFpsDen, AVideoCodec, APixFmt, AAudioCodec, ASampleRate, AChannels, ABitrate)); Result := Concat(Result, NoBFramesArgs); - Result := Concat(Result, ['-avoid_negative_ts', 'make_zero']); - Result := Concat(Result, ProgressArgs); - Result := Concat(Result, ['-f', AFormat, ADst]); + Result := Concat(Result, TailArgs(AFormat, ADst, AAt)); end; function TsSupportsCodecs(const AVideoCodec, AAudioCodec: string): Boolean; @@ -847,6 +1013,56 @@ begin Result := Concat(Result, [ADst]); end; +{ Приёмник: один ffmpeg, который читает поток MPEG-TS из трубы и пишет + готовый файл. + + -fflags +igndts здесь был и оказался вреден. С ним ffmpeg выбрасывает + метки декодирования, пришедшие с кусками, и считает свои — а материал с + B-кадрами хранится не в том порядке, в каком показывается, и пересчёт + сминает кадры в кучу: замерено, что на стыке появлялись по три кадра с + одной и той же меткой, а картинка расходилась с эталоном (PSNR 18 дБ + при верном числе кадров). Без этого ключа метки на стыке идут ровно, + шаг в шаг, и ни одной жалобы на непоследовательность в журнале. + + Прогресс отсюда не берётся: ход работы считается по кускам, а их шлём + мы сами. Лишний поток -progress только мешал бы — его труба заполнялась + бы, пока мы заняты переливом. } +function ArgsStreamMux(const AAudio, ASubFile, ADst: string): TArgs; +var + Next: Integer; +begin + Result := Concat(CommonFfmpegPrefix, [ + '-f', 'mpegts', + '-i', 'pipe:0' + ]); + + Next := 1; + if AAudio <> '' then + Result := Concat(Result, ['-i', AAudio]); + if ASubFile <> '' then + Result := Concat(Result, ['-i', ASubFile]); + + Result := Concat(Result, ['-map', '0:v:0']); + if AAudio <> '' then + begin + Result := Concat(Result, ['-map', IntToStr(Next) + ':a:0']); + Inc(Next); + end + else + Result := Concat(Result, ['-map', '0:a:0?']); + + if ASubFile <> '' then + Result := Concat(Result, ['-map', IntToStr(Next) + ':s:0', '-c:s', 'ass', + '-metadata:s:s:0', 'title=Надписи', + '-metadata:s:s:0', 'language=rus']); + + Result := Concat(Result, ['-c:v', 'copy', '-c:a', 'copy', + '-avoid_negative_ts', 'make_zero', '-nostats']); + 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, [ @@ -882,6 +1098,24 @@ begin '-show_entries', 'stream=nb_read_packets', '-of', 'csv=p=0', ASrc]; end; +function ArgsFirstPacketTime(const ASrc: string): TArgs; +begin + Result := ['-v', 'error', '-select_streams', 'a:0', + '-show_entries', 'packet=pts_time', '-of', 'csv=p=0', + '-read_intervals', '%+0.2', ASrc]; +end; + +function ArgsFirstVideoTimes(const ASrc: string): TArgs; +begin + { Первые полсекунды картинки: по ним видно, с какой метки файл + начинается. Не один пакет, а несколько — у записи с B-кадрами первый + по порядку хранения кадр показывается не первым, и самая ранняя метка + может оказаться у второго или третьего. } + Result := ['-v', 'error', '-select_streams', 'v:0', + '-show_entries', 'packet=pts_time', '-of', 'csv=p=0', + '-read_intervals', '%+0.5', ASrc]; +end; + function ArgsPacketFlags(const ASrc: string): TArgs; begin Result := ['-v', 'error', '-select_streams', 'v:0', diff --git a/src/uFlatten.pas b/src/uFlatten.pas index 6d5c53f..7c85c48 100644 --- a/src/uFlatten.pas +++ b/src/uFlatten.pas @@ -119,7 +119,8 @@ function FlattenStream(AProject: TProject; AKind: TTrackKind; списком кусков, а дальше они складываются его же средствами. } function FlattenAudioTrack(AProject: TProject; ATrack: TTrack; const ATotal: Double; - out ASegments: TFlatSegmentArray; out AMissing: TGenRequests): Boolean; + out ASegments: TFlatSegmentArray; out AMissing: TGenRequests; + AWanted: TStrings = nil): Boolean; { Длина слышимого материала одного вида дорожек. } function AudibleEnd(AProject: TProject; AKind: TTrackKind): Double; @@ -166,6 +167,15 @@ function FlattenPreview(AProject: TProject; правку в готовом файле почти невозможно. Возвращает, сколько секунд осталось. } + +{ Клип, который виден в этот момент: с самой верхней включённой дорожки + нужного вида. Тот же отбор победителя, что и при уплощении. + + Нужен предпросмотру: по нему решается, чьё кадрирование показывать + обрезкой на выводе плеера. } +function VisibleClipAtTime(AProject: TProject; AKind: TTrackKind; + const ATime: Double): TClip; + function ClipSegmentsToRange(var ASegments: TFlatSegmentArray; const AFrom, ATo: Double): Double; @@ -187,9 +197,14 @@ function GeneratedPath(const ACacheDir: string; const AReq: TGenRequest): string Для сборки ролика это не применяется: там наложение считается заново с параметрами вывода, и промежуточный файл был бы лишней потерей - качества. } + качества. + + AWanted — куда сложить пути всех сведённых кусков, которые этой + расстановке нужны, независимо от того, лежат они уже на диске или ещё + делаются. По списку недостающего этого не узнать: файл появляется в + первую же секунду работы ffmpeg и пишется до конца. } procedure ResolveLayers(AProject: TProject; var ASegments: TFlatSegmentArray; - var AMissing: TGenRequests); + var AMissing: TGenRequests; AWanted: TStrings = nil); { Заготовка чёрной вставки самой ходовой длины. @@ -304,6 +319,66 @@ begin ALayers[I].KeySimilarity, ALayers[I].KeyBlend]); end; +{ Границы кусков — на кадровую сетку проекта. + + Между кадрами времени не существует, и монтаж не должен просить долей + кадра: картинка всё равно выйдет целым числом кадров, а звук набирается + с точностью до отсчёта — и они разойдутся. Каждая доля кадра, округлённая + в свою сторону, копится от куска к куску. + + Квантуются именно границы, а не длины: накопленное начало кладётся на + сетку, а длина считается разностью соседних границ. Тогда куски остаются + встык и невязка не накапливается. Начало в исходнике двигается на ту же + величину — значит показывается тот же материал. + + Картинка и звук проходят через одну и ту же меру, поэтому их границы + совпадают до отсчёта. } +procedure QuantizeSegments(var ASegments: TFlatSegmentArray; + AFpsNum, AFpsDen: Integer); +var + I: Integer; + Step, At, Next: Double; +begin + if (AFpsNum <= 0) or (AFpsDen <= 0) then + Exit; + Step := AFpsDen / AFpsNum; + + At := 0; + for I := 0 to High(ASegments) do + begin + Next := Round((At + ASegments[I].Duration) / Step) * Step; + if Next <= At then + Next := At + Step; + ASegments[I].SrcStart := Round(ASegments[I].SrcStart / Step) * Step; + ASegments[I].Duration := Next - At; + At := Next; + end; +end; + +function VisibleClipAtTime(AProject: TProject; AKind: TTrackKind; + const ATime: Double): TClip; +var + Ti, C: Integer; + Track: TTrack; +begin + Result := nil; + if AProject = nil then + Exit; + for Ti := 0 to AProject.TrackCount - 1 do + begin + Track := AProject.Tracks[Ti]; + if Track.Kind <> AKind then + Continue; + { Выключенные дорожки пропускаются, а если где-то включено «соло» — + то и все несолирующие. } + if not AProject.TrackAudible(Track) then + Continue; + for C := 0 to Track.Count - 1 do + if Track[C].Covers(ATime) then + Exit(Track[C]); + end; +end; + function ClipSegmentsToRange(var ASegments: TFlatSegmentArray; const AFrom, ATo: Double): Double; var @@ -347,7 +422,7 @@ begin end; procedure ResolveLayers(AProject: TProject; var ASegments: TFlatSegmentArray; - var AMissing: TGenRequests); + var AMissing: TGenRequests; AWanted: TStrings); var I: Integer; Req: TGenRequest; @@ -374,6 +449,16 @@ begin Req.TlEnd := At + ASegments[I].Duration; At := Req.TlEnd; + { Список нужного — это не то же самое, что список недостающего. + + Недостающее — чего нет на диске. Но пока кусок делается, файл уже + есть: ffmpeg создаёт его сразу и пишет в него до самого конца. + Спрашивать «нужен ли ещё тот кусок, что сейчас делается» по списку + недостающего бессмысленно — его там не будет, и работа отменится в + разгаре. } + if AWanted <> nil then + AWanted.Add(Req.TargetPath); + if not FileExists(Req.TargetPath) then begin SetLength(AMissing, Length(AMissing) + 1); @@ -815,12 +900,21 @@ begin исходнике. } Seg.SrcStart := Winner.SrcIn + (SegStart - Winner.TlStart); - { Точность требуется только там, где кусок начинается с собственного - левого края клипа. Границы, возникшие из-за перекрытия соседней - дорожкой, притягиваются к опорному кадру: помечать их точными - значило бы перекодировать стык при каждом наложении. } - Seg.PreciseIn := (Winner.EdgeIn = edPrecise) and - (Abs(SegStart - Winner.TlStart) < 0.0005); + { Начало куска всегда точное. + + Раньше точность просили только у резов, помеченных точными, а + остальные начала притягивались к ближайшему опорному кадру. Звук + при этом брался из непритянутой точки — и картинка внутри куска + показывала материал на величину притяжки позже, чем он звучал. + Замерено по журналам сборки: средняя притяжка 0.24 с, худшая 0.99 с, + и на длинном куске этот сдвиг держится все его минуты. + + Плата за точность — перекодирование от точки реза до ближайшего + опорного кадра, доля секунды на рез. Декодер не умеет начинать с + середины группы кадров, поэтому «резать где угодно и ничего не + перекодировать» не бывает: выбор только между точным резом и + уехавшей точкой реза. } + Seg.PreciseIn := True; { Кусок нельзя скопировать по двум причинам: файл не совпадает с параметрами проекта, либо у клипа своё кадрирование. И то, и @@ -1028,12 +1122,17 @@ begin Seen.Free; end; + { Границы — на кадровую сетку: картинка и звук должны просить одно и то + же время, иначе округление разведёт их на доли кадра за кусок. } + QuantizeSegments(ASegments, AProject.Master.FpsNum, AProject.Master.FpsDen); + Result := True; end; function FlattenAudioTrack(AProject: TProject; ATrack: TTrack; const ATotal: Double; - out ASegments: TFlatSegmentArray; out AMissing: TGenRequests): Boolean; + out ASegments: TFlatSegmentArray; out AMissing: TGenRequests; + AWanted: TStrings): Boolean; var C, N: Integer; At: Double; @@ -1078,6 +1177,11 @@ var Req.Duration := BucketFor(Take); Req.TargetPath := GeneratedPath(AProject.CacheDir, Req); Seg.FilePath := Req.TargetPath; + { Нужное и недостающее — разные списки: см. пояснение у + ResolveLayers. Кусок, который делается прямо сейчас, на диске уже + есть, и в недостающее он не попадёт. } + if AWanted <> nil then + AWanted.Add(Req.TargetPath); { Один и тот же файл не заказываем дважды: длинная тишина набирается повторами, и без этой проверки минутный кусок делался бы столько раз, сколько его повторов. } @@ -1134,6 +1238,9 @@ begin if ATotal > At then PushSilence(ATotal - At); + { Той же мерой, что и картинка. } + QuantizeSegments(ASegments, AProject.Master.FpsNum, AProject.Master.FpsDen); + Result := N > 0; end; diff --git a/src/uGenerate.pas b/src/uGenerate.pas index 3b74307..ba91621 100644 --- a/src/uGenerate.pas +++ b/src/uGenerate.pas @@ -36,6 +36,13 @@ type FCancelled: Boolean; FMessage: string; FCurrent: Integer; + { Насколько сделан кусок, который считается прямо сейчас: 0..1. + Берётся у самого ffmpeg, а не угадывается. } + FStepFraction: Double; + FStepSeconds: Double; + { Сказал ли ffmpeg хоть раз, докуда он дошёл по этому куску. Пока не + сказал, настоящей доли нет и показывать нечего. } + FStepKnown: Boolean; FOnProgress: TNotifyEvent; FOnLog: TNotifyEvent; @@ -44,6 +51,8 @@ type procedure Log(const AText: string); function CancelQuery: Boolean; procedure ErrorLine(const ALine: string); + { Строки «ключ=значение», которые ffmpeg шлёт о ходе работы. } + procedure ProgressLine(const ALine: string); procedure Publish; protected procedure Execute; override; @@ -57,6 +66,13 @@ type работы: по ним он знает, докуда ползти до следующей вехи. } function Total: Integer; property Done: Integer read FCurrent; + { Доля сделанного внутри текущего куска. Показателю работы она нужна, + чтобы полоса ползла по настоящему ходу, а не по догадке: кусок + бывает и на полторы минуты, и всё это время Done не меняется. } + property StepFraction: Double read FStepFraction; + { Есть ли по текущему куску настоящий замер. Нет — показатель работы + не имеет права рисовать заполненную полосу. } + property StepKnown: Boolean read FStepKnown; { Место на монтаже, которое считается прямо сейчас. Ноль в обоих — значит, к монтажу это отношения не имеет. } function BusyFrom: Double; @@ -138,6 +154,45 @@ begin Log('ffmpeg: ' + ALine); end; +{ Ход работы берётся у самого ffmpeg. + + Раньше показатель знал только «кусок такой-то из стольких» и между + кусками полз вслепую. На коротких вставках это проходило, а на + затухании в полторы минуты полоса успевала доползти до края и застыть: + со стороны это выглядело как зависшая программа. Теперь ffmpeg каждые + полсекунды сообщает, до какого места он дошёл, и доля честная. } +procedure TGenerateThread.ProgressLine(const ALine: string); +var + Seconds: Double; + AtEnd: Boolean; +begin + if FStepSeconds <= 0 then + Exit; + { Отсчёт начинается с уже известного места, а не с нуля. + + ffmpeg шлёт ход работы блоками, и последняя строка блока — + «progress=continue». Места в ней нет, она сообщает только, что работа + продолжается, — и разбор оставляет переданное число как было. Начни + мы с нуля, каждый блок заканчивался бы обнулением доли: показатель + стоял бы на месте и дёргался вверх только в те мгновения, когда + опрос попадал между строкой со временем и этой. Со стороны это + выглядело как «висит на пяти процентах, потом скачет до + семидесяти девяти». } + Seconds := FStepFraction * FStepSeconds; + AtEnd := False; + if not ParseProgressLine(ALine, Seconds, AtEnd) then + Exit; + FStepKnown := True; + FStepFraction := Seconds / FStepSeconds; + if FStepFraction < 0 then + FStepFraction := 0; + { Единицу не отдаём: единица — это «кусок готов», а готовым он станет, + когда ffmpeg закончит и файл окажется на месте. } + if FStepFraction > 0.99 then + FStepFraction := 0.99; + Publish; +end; + function TGenerateThread.Total: Integer; begin Result := Length(FRequests); @@ -162,7 +217,7 @@ end; procedure TGenerateThread.Publish; begin if Length(FRequests) > 0 then - FFraction := FCurrent / Length(FRequests) + FFraction := (FCurrent + FStepFraction) / Length(FRequests) else FFraction := 1; Synchronize(@SyncProgress); @@ -214,6 +269,11 @@ begin end; FCurrent := I; + { Длина куска нужна, чтобы перевести «дошёл до такой-то секунды» в + долю. У вставок она и есть длительность заказа. } + FStepFraction := 0; + FStepKnown := False; + FStepSeconds := FRequests[I].Duration; case FRequests[I].Kind of gkBlack: FStageText := Format('Делаю чёрную вставку %d из %d', @@ -262,13 +322,36 @@ begin Args := ArgsRenderLayers(FRequests[I].Layers, FRequests[I].TargetPath, FRequests[I].Duration, FMaster.Width, FMaster.Height, FMaster.FpsNum, FMaster.FpsDen, - FMaster.PixFmt, FMaster.VideoCodec, False, FMaster.VideoBitrate); + FMaster.PixFmt, FMaster.VideoCodec, False, FMaster.VideoBitrate, + '', NotPiped, True); else Continue; end; Log('> ' + CommandToString(FfmpegExe, Args)); - Res := RunProcess(FfmpegExe, Args, nil, @ErrorLine, @CancelQuery); + Res := RunProcess(FfmpegExe, Args, @ProgressLine, @ErrorLine, + @CancelQuery); + + { Распаковка на видеокарте не пошла — повторяем на процессоре. + + Она даёт вчетверо на длинном затухании, но зависит от драйвера и + от того, знаком ли видеокарте кодек исходника. Отказываться из-за + неё от сборки нельзя: медленно лучше, чем никак. } + if (FRequests[I].Kind = gkLayers) and (not Res.Cancelled) and + (Res.Started and (Res.ExitCode <> 0)) then + begin + Log('Распаковка на видеокарте не пошла, повторяю на процессоре.'); + Args := ArgsRenderLayers(FRequests[I].Layers, + FRequests[I].TargetPath, FRequests[I].Duration, + FMaster.Width, FMaster.Height, FMaster.FpsNum, FMaster.FpsDen, + FMaster.PixFmt, FMaster.VideoCodec, False, FMaster.VideoBitrate, + '', NotPiped, False); + Log('> ' + CommandToString(FfmpegExe, Args)); + FStepFraction := 0; + FStepKnown := False; + Res := RunProcess(FfmpegExe, Args, @ProgressLine, @ErrorLine, + @CancelQuery); + end; if Res.Cancelled then begin diff --git a/src/uIconData.pas b/src/uIconData.pas index 2487924..34a8ee4 100644 --- a/src/uIconData.pas +++ b/src/uIconData.pas @@ -32,8 +32,8 @@ const $60, $00, $00, $3A, $98, $00, $00, $17, $70, $9C, $BA, $51, $3C, $00, $00, $00, $02, $62, $4B, $47, $44, $00, $00, $AA, $8D, $23, $32, $00, $00, $00, $09, $70, $48, $59, $73, $00, $00, $0B, $13, $00, $00, $0B, $13, $01, $00, $9A, $9C, $18, - $00, $00, $00, $07, $74, $49, $4D, $45, $07, $EA, $08, $1F, $07, $2E, $1B, $C7, - $2C, $48, $09, $00, $00, $01, $3E, $49, $44, $41, $54, $38, $CB, $BD, $92, $31, + $00, $00, $00, $07, $74, $49, $4D, $45, $07, $EA, $09, $1D, $14, $21, $19, $27, + $B3, $C9, $F8, $00, $00, $01, $3E, $49, $44, $41, $54, $38, $CB, $BD, $92, $31, $4B, $C3, $40, $14, $C7, $7F, $97, $44, $29, $68, $03, $5A, $45, $EA, $D0, $A5, $6B, $41, $44, $5C, $0A, $0E, $3A, $15, $DC, $1D, $DD, $FB, $51, $74, $71, $29, $F8, $39, $EC, $62, $06, $17, $5D, $EA, $22, $D2, $88, $93, $E0, $22, $68, $A1, @@ -66,8 +66,8 @@ const $60, $00, $00, $3A, $98, $00, $00, $17, $70, $9C, $BA, $51, $3C, $00, $00, $00, $02, $62, $4B, $47, $44, $00, $00, $AA, $8D, $23, $32, $00, $00, $00, $09, $70, $48, $59, $73, $00, $00, $0B, $13, $00, $00, $0B, $13, $01, $00, $9A, $9C, $18, - $00, $00, $00, $07, $74, $49, $4D, $45, $07, $EA, $08, $1F, $07, $2E, $1B, $C7, - $2C, $48, $09, $00, $00, $01, $2F, $49, $44, $41, $54, $38, $CB, $CD, $D2, $3D, + $00, $00, $00, $07, $74, $49, $4D, $45, $07, $EA, $09, $1D, $14, $21, $19, $27, + $B3, $C9, $F8, $00, $00, $01, $2F, $49, $44, $41, $54, $38, $CB, $CD, $D2, $3D, $2F, $83, $51, $18, $C6, $F1, $DF, $C3, $63, $31, $34, $11, $B5, $35, $D1, $A9, $C1, $E0, $25, $4C, $66, $49, $F9, $16, $24, $96, $C6, $37, $A8, $18, $7D, $02, $31, $98, $18, $99, $25, $44, $F8, $02, $26, $B1, $30, $30, $78, $D9, $90, $18, @@ -99,8 +99,8 @@ const $60, $00, $00, $3A, $98, $00, $00, $17, $70, $9C, $BA, $51, $3C, $00, $00, $00, $02, $62, $4B, $47, $44, $00, $00, $AA, $8D, $23, $32, $00, $00, $00, $09, $70, $48, $59, $73, $00, $00, $0B, $13, $00, $00, $0B, $13, $01, $00, $9A, $9C, $18, - $00, $00, $00, $07, $74, $49, $4D, $45, $07, $EA, $08, $1F, $07, $2E, $1B, $C7, - $2C, $48, $09, $00, $00, $01, $0F, $49, $44, $41, $54, $38, $CB, $B5, $D3, $BF, + $00, $00, $00, $07, $74, $49, $4D, $45, $07, $EA, $09, $1D, $14, $21, $19, $27, + $B3, $C9, $F8, $00, $00, $01, $0F, $49, $44, $41, $54, $38, $CB, $B5, $D3, $BF, $2E, $83, $51, $18, $C7, $F1, $CF, $5B, $15, $0C, $74, $93, $88, $91, $0B, $E8, $68, $60, $33, $34, $B1, $1A, $F4, $1E, $0C, $66, $8B, $C5, $05, $B8, $01, $89, $2B, $30, $18, $24, $4C, $0D, $8B, $41, $13, $46, $62, $90, $18, $A4, $4B, $55, @@ -130,8 +130,8 @@ const $60, $00, $00, $3A, $98, $00, $00, $17, $70, $9C, $BA, $51, $3C, $00, $00, $00, $02, $62, $4B, $47, $44, $00, $00, $AA, $8D, $23, $32, $00, $00, $00, $09, $70, $48, $59, $73, $00, $00, $0B, $13, $00, $00, $0B, $13, $01, $00, $9A, $9C, $18, - $00, $00, $00, $07, $74, $49, $4D, $45, $07, $EA, $08, $1F, $07, $2E, $1B, $C7, - $2C, $48, $09, $00, $00, $01, $67, $49, $44, $41, $54, $38, $CB, $B5, $D3, $3D, + $00, $00, $00, $07, $74, $49, $4D, $45, $07, $EA, $09, $1D, $14, $21, $19, $27, + $B3, $C9, $F8, $00, $00, $01, $67, $49, $44, $41, $54, $38, $CB, $B5, $D3, $3D, $4F, $93, $61, $14, $C6, $F1, $5F, $AB, $80, $9D, $A8, $A1, $71, $95, $08, $14, $3F, $80, $71, $D2, $8D, $C5, $D8, $A4, $A6, $61, $31, $74, $32, $31, $1A, $99, $89, $B3, $8B, $71, $B0, $7C, $0F, $37, $42, $4B, $07, $07, $D0, $98, $30, $E0, @@ -167,8 +167,8 @@ const $60, $00, $00, $3A, $98, $00, $00, $17, $70, $9C, $BA, $51, $3C, $00, $00, $00, $02, $62, $4B, $47, $44, $00, $00, $AA, $8D, $23, $32, $00, $00, $00, $09, $70, $48, $59, $73, $00, $00, $0B, $13, $00, $00, $0B, $13, $01, $00, $9A, $9C, $18, - $00, $00, $00, $07, $74, $49, $4D, $45, $07, $EA, $08, $1F, $07, $2E, $1B, $C7, - $2C, $48, $09, $00, $00, $02, $71, $49, $44, $41, $54, $38, $CB, $95, $D4, $41, + $00, $00, $00, $07, $74, $49, $4D, $45, $07, $EA, $09, $1D, $14, $21, $19, $27, + $B3, $C9, $F8, $00, $00, $02, $71, $49, $44, $41, $54, $38, $CB, $95, $D4, $41, $68, $DB, $65, $18, $06, $F0, $5F, $E2, $DA, $2A, $2E, $59, $B2, $65, $29, $4B, $B4, $A7, $C9, $B0, $DB, $A0, $8C, $49, $63, $55, $50, $0F, $56, $31, $ED, $68, $BA, $CB, $70, $3B, $C8, $F0, $24, $08, $0A, $1E, $44, $99, $4E, $AA, $B2, $5D, @@ -211,6 +211,76 @@ const $00, $00, $00, $00, $49, $45, $4E, $44, $AE, $42, $60, $82 ); + { icons8-select-all-90.png, 24 на 24 точек } + IconSelectClipsData: array[0..509] of Byte = ( + $89, $50, $4E, $47, $0D, $0A, $1A, $0A, $00, $00, $00, $0D, $49, $48, $44, $52, + $00, $00, $00, $18, $00, $00, $00, $18, $08, $04, $00, $00, $00, $4A, $7E, $F5, + $73, $00, $00, $00, $20, $63, $48, $52, $4D, $00, $00, $7A, $26, $00, $00, $80, + $84, $00, $00, $FA, $00, $00, $00, $80, $E8, $00, $00, $75, $30, $00, $00, $EA, + $60, $00, $00, $3A, $98, $00, $00, $17, $70, $9C, $BA, $51, $3C, $00, $00, $00, + $02, $62, $4B, $47, $44, $00, $00, $AA, $8D, $23, $32, $00, $00, $00, $09, $70, + $48, $59, $73, $00, $00, $0B, $13, $00, $00, $0B, $13, $01, $00, $9A, $9C, $18, + $00, $00, $00, $07, $74, $49, $4D, $45, $07, $EA, $09, $1D, $14, $21, $19, $27, + $B3, $C9, $F8, $00, $00, $01, $63, $49, $44, $41, $54, $38, $CB, $B5, $D3, $BD, + $6E, $13, $41, $14, $05, $E0, $6F, $76, $13, $7B, $17, $21, $A4, $98, $48, $34, + $3C, $00, $05, $0A, $52, $78, $05, $AA, $50, $24, $8F, $C1, $1B, $E4, $1D, $D2, + $51, $41, $49, $43, $EB, $CE, $A9, $90, $A5, $28, $D6, $26, $15, $55, $8A, $3C, + $00, $42, $32, $08, $2A, $62, $25, $CE, $7A, $87, $C2, $E3, $3F, $61, $0A, $17, + $39, $53, $CC, $E8, $9E, $39, $33, $F7, $DC, $99, $CB, $43, $23, $A4, $79, $CB, + $36, $EE, $4D, $B4, $05, $DC, $A1, $8D, $E8, $4E, $6E, $1B, $63, $93, $85, $2C, + $77, $EC, $5C, $E5, $C8, $AE, $AE, $4A, $DF, $9E, $3D, $7D, $95, $AE, $5D, $47, + $2A, $E7, $8E, $E5, $90, $81, $96, $03, $FB, $32, $71, $6D, $16, $51, $66, $DF, + $81, $D6, $22, $54, $1A, $B8, $B0, $23, $17, $14, $4A, $A5, $4C, $A6, $54, $2A, + $04, $B9, $1D, $17, $06, $CA, $69, $32, $53, $FC, $34, $70, $65, $82, $5A, $AD, + $16, $C5, $B4, $22, $AA, $FD, $50, $B9, $D6, $CC, $4C, $07, $4F, $F1, $4B, $14, + $74, $3C, $9E, $A7, $16, $FC, $F1, $5B, $5C, $E2, $13, $0A, $5D, $5D, $05, $3A, + $4E, $0D, $7D, $4F, $63, $E8, $54, $67, $85, $B7, $95, $4E, $7A, $96, $4A, $7C, + $EB, $8B, $6F, $9A, $14, $0D, $AE, $DD, $AE, $F0, $49, $30, $AD, $3B, $8C, $BC, + $9F, $C7, $EE, $93, $70, $99, $4F, $1E, $32, $2F, $71, $A5, $F1, $C4, $89, $57, + $1A, $44, $1F, $7C, $4E, $BB, $16, $7C, $7A, $87, $8D, $51, $EA, $EB, $4F, $EB, + $2C, $D7, $4E, $23, $5B, $C7, $CF, $F2, $6D, $A7, $F9, $91, $77, $5E, $AC, $98, + $FE, $68, $B4, $C4, $27, $41, $34, $44, $44, $E1, $8D, $D7, $F3, $6F, $96, $7B, + $EE, $93, $D1, $12, $BF, $F9, $C3, $85, $74, $CF, $5B, $F4, $D4, $FF, $F1, $F8, + $0F, $BF, $C1, $E7, $9B, $09, $CE, $DC, $B8, $74, $B8, $B6, $1F, $0E, $5D, $BA, + $71, $B6, $5C, $A5, $B1, $9E, $4C, $3E, $EF, $BF, $55, $04, $8D, $AF, $7A, $C6, + $0B, $D3, $E4, $5A, $36, $68, $D1, $87, $C4, $5F, $C8, $81, $83, $A2, $85, $86, + $DA, $DD, $00, $00, $00, $00, $49, $45, $4E, $44, $AE, $42, $60, $82 + ); + + { icons8-width-90.png, 24 на 24 точек } + IconSelectRangeData: array[0..473] of Byte = ( + $89, $50, $4E, $47, $0D, $0A, $1A, $0A, $00, $00, $00, $0D, $49, $48, $44, $52, + $00, $00, $00, $18, $00, $00, $00, $18, $08, $04, $00, $00, $00, $4A, $7E, $F5, + $73, $00, $00, $00, $20, $63, $48, $52, $4D, $00, $00, $7A, $26, $00, $00, $80, + $84, $00, $00, $FA, $00, $00, $00, $80, $E8, $00, $00, $75, $30, $00, $00, $EA, + $60, $00, $00, $3A, $98, $00, $00, $17, $70, $9C, $BA, $51, $3C, $00, $00, $00, + $02, $62, $4B, $47, $44, $00, $00, $AA, $8D, $23, $32, $00, $00, $00, $09, $70, + $48, $59, $73, $00, $00, $0B, $13, $00, $00, $0B, $13, $01, $00, $9A, $9C, $18, + $00, $00, $00, $07, $74, $49, $4D, $45, $07, $EA, $09, $1D, $14, $21, $19, $27, + $B3, $C9, $F8, $00, $00, $01, $3F, $49, $44, $41, $54, $38, $CB, $CD, $D2, $BF, + $4A, $1C, $51, $18, $05, $F0, $DF, $8C, $3B, $8E, $53, $64, $70, $94, $2D, $5D, + $B0, $90, $B0, $C5, $DA, $A6, $14, $C1, $28, $E8, $1B, $F8, $0C, $61, $FB, $7D, + $02, $5F, $40, $D8, $07, $91, $6D, $92, $52, $2D, $6C, $BD, $45, $08, $29, $84, + $ED, $C4, $C2, $90, $26, $8C, $6E, $66, $53, $B8, $7F, $26, $82, $85, $0A, $E2, + $B9, $C5, $2D, $CE, $3D, $DF, $F7, $9D, $F3, $5D, $DE, $1D, $16, $26, $77, $2E, + $55, $CA, $7C, $50, $4A, $14, $4A, $91, $15, $23, $63, $85, $C8, $68, $C2, $CF, + $D0, $D0, $D7, $17, $EB, $3A, $91, $DB, $73, $66, $C3, $86, $33, $7B, $72, $27, + $BA, $62, $7D, $7D, $8D, $87, $A7, $90, $D8, $44, $22, $A0, $34, $34, $F0, $0B, + $03, $43, $A5, $6F, $C2, $8C, $1F, $4D, $3B, $64, $CE, $9D, $CB, $9E, $1C, $BC, + $C6, $C7, $CF, $35, $FD, $2A, $C1, $58, $C7, $BE, $C5, $FF, $F8, $45, $FB, $3A, + $C6, $F5, $7C, $A6, $A8, $7C, $72, $AC, $12, $DC, $88, $66, $25, $9A, $8E, $C4, + $BE, $A8, $A6, $A5, $A3, $89, $A9, $AF, $D6, $FD, $D6, $76, $EB, $87, $BF, $35, + $C1, $82, $8F, $0A, $DF, $E5, $AE, $EC, $FA, $F3, $02, $0F, $F3, $D8, $4E, $6D, + $09, $2E, $AD, $59, $92, $4D, $CE, $92, $35, $97, $82, $2D, $A7, $D3, $58, $E7, + $1E, $62, $17, $0E, $B5, $5C, $BB, $AB, $95, $BA, $D6, $33, $F4, $73, $3E, $49, + $A3, $46, $46, $82, $F0, $A8, $F7, $9D, $01, $F5, $95, $BE, $ED, $E2, $2A, $DB, + $BA, $52, $6D, $3D, $4D, $4D, $3D, $6D, $A9, $AE, $6D, $D5, $63, $C1, $48, $10, + $DC, $EB, $D8, $91, $6A, $39, $B0, $6C, $D9, $81, $96, $D4, $67, $1D, $F7, $82, + $30, $FF, $AB, $90, $CB, $91, $29, $44, $12, $AB, $62, $B1, $55, $89, $48, $21, + $9B, $F1, $EF, $13, $FF, $00, $8F, $00, $4E, $D0, $9E, $28, $A1, $C0, $00, $00, + $00, $00, $49, $45, $4E, $44, $AE, $42, $60, $82 + ); + { icons8-показ-видеокадров-30.png, значок окна, 32 на 32 точек, формат ico } IconAppData: array[0..4285] of Byte = ( $00, $00, $01, $00, $01, $00, $20, $20, $00, $00, $01, $00, $20, $00, $A8, $10, diff --git a/src/uKeyframeIndex.pas b/src/uKeyframeIndex.pas index 58cc2e5..cf05252 100644 --- a/src/uKeyframeIndex.pas +++ b/src/uKeyframeIndex.pas @@ -20,10 +20,13 @@ Запасной путь: опрос ffprobe. Медленно, но работает с любым контейнером. - Чего этот разбор пока не учитывает: блок elst (список правок), который - способен сдвинуть всю дорожку по времени. У обычных записей с камер его - нет. Если появится материал, где метки разъезжаются, начинать копать - надо отсюда. + Блок elst (список правок) разбор учитывает — и это не мелочь. У любой + записи с B-кадрами первый кадр показывается позже, чем декодируется, и + контейнер выправляет это списком правок: «показ начинать с такого-то + места дорожки». ffmpeg правку применяет, а мы раньше нет — и весь + индекс оказывался сдвинут на задержку B-кадров, на пробе это два кадра. + Дальше по цепочке: рез просил перекодировать до метки, которая опорным + кадром не была, копия начиналась раньше, и кадры на стыке удваивались. } unit uKeyframeIndex; @@ -311,6 +314,9 @@ var DtsCursor, CttsCursor: TRunCursor; Pts: Int64; FoundVideo: Boolean; + EdtsStart, EdtsEnd, ElstStart, ElstEnd: Int64; + MediaTime: Int64; + EntryCount: LongWord; begin Result := False; AError := ''; @@ -391,6 +397,40 @@ begin if Timescale = 0 then Continue; + { Список правок. Нас интересует одно число — с какого места + дорожки начинается показ: на него сдвинуты все времена, которые + показывает ffmpeg. У записи с B-кадрами это ровно задержка + показа, у записи без них правки обычно нет вовсе. + + Отрицательное значение (-1) означает пустой промежуток в начале — + он времена не сдвигает, поэтому такие записи пропускаем. } + MediaTime := 0; + if FindBox(Stream, TrakStart, TrakEnd, 'edts', EdtsStart, EdtsEnd) then + if FindBox(Stream, EdtsStart, EdtsEnd, 'elst', ElstStart, ElstEnd) then + begin + Stream.Position := ElstStart; + Version := 0; + Stream.ReadBuffer(Version, 1); + Stream.Position := ElstStart + 4; + EntryCount := ReadU32(Stream); + if EntryCount > 0 then + begin + if Version = 1 then + begin + { версия 1: длительность и время — по восемь байт } + Stream.Position := ElstStart + 8 + 8; + MediaTime := Int64(ReadU64(Stream)); + end + else + begin + Stream.Position := ElstStart + 8 + 4; + MediaTime := Int32(ReadU32(Stream)); + end; + if MediaTime < 0 then + MediaTime := 0; + end; + end; + if not FindBox(Stream, MdiaStart, MdiaEnd, 'minf', MinfStart, MinfEnd) then Continue; if not FindBox(Stream, MinfStart, MinfEnd, 'stbl', StblStart, StblEnd) then @@ -436,6 +476,11 @@ begin Pts := CursorSumBefore(DtsCursor, Sample); if HasCtts then Inc(Pts, CursorValueAt(CttsCursor, Sample)); + { Правка сдвигает начало показа: ffmpeg считает времена от неё, и + индекс должен считать так же. } + Dec(Pts, MediaTime); + if Pts < 0 then + Pts := 0; AIndex.Times[I] := Pts / Timescale; end; @@ -636,6 +681,7 @@ begin AIndex.Times[I] := Arr.Floats[I]; end; + Result := AIndex.AllFrames or (Length(AIndex.Times) > 0); finally Root.Free; diff --git a/src/uMainForm.lfm b/src/uMainForm.lfm index f9902ae..578948e 100644 --- a/src/uMainForm.lfm +++ b/src/uMainForm.lfm @@ -97,11 +97,21 @@ object MainForm: TMainForm OnClick = btnRippleMenuClick TabStop = False end + object btnSelectMode: TThemedButton + Left = 448 + Height = 28 + Top = 6 + Width = 28 + Icon = tiSelectClips + OnClick = btnSelectModeClick + ShowHint = True + TabStop = False + end object lblStatus: TLabel - Left = 488 + Left = 518 Height = 20 Top = 10 - Width = 780 + Width = 750 Anchors = [akTop, akLeft, akRight] AutoSize = False Caption = 'Готов.' diff --git a/src/uMainForm.pas b/src/uMainForm.pas index cc5d244..dfc4510 100644 --- a/src/uMainForm.pas +++ b/src/uMainForm.pas @@ -51,6 +51,7 @@ type btnCenter: TThemedButton; btnRipple: TThemedButton; btnRippleMenu: TThemedButton; + btnSelectMode: TThemedButton; lblPoolInfo: TLabel; lblStatus: TLabel; lblTime: TLabel; @@ -72,6 +73,7 @@ type procedure btnCenterClick(Sender: TObject); procedure btnRippleClick(Sender: TObject); procedure btnRippleMenuClick(Sender: TObject); + procedure btnSelectModeClick(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); @@ -95,6 +97,10 @@ type FStarted: Boolean; FPreviewTimer: TTimer; + { Автосохранение: копия проекта пишется сама собой, пока человек + работает. Нужна ровно на один случай — работа пропала, а сохранить + её забыли или сохранение не дошло до файла. } + FAutoSaveTimer: TTimer; FPreviewDirty: Boolean; FUpdatingFromPlayer: Boolean; FLastLoadedEdl: string; @@ -152,6 +158,7 @@ type { Пункт «Ключ и прозрачность в предпросмотре»: галку в нём приходится держать за руку — она не следует за настройкой сама. } FKeyPreviewItem: TMenuItem; + FSelectModeItem: TMenuItem; { Показанная доля выполнения. Отдельно от настоящей, потому что растёт она по своим правилам — см. AdvanceJobBar. } FJobShown: Double; @@ -168,6 +175,8 @@ type FPreviewSegments: TFlatSegmentArray; FLastVolumeSent: Double; FLastVolumeKey: string; + { Что сейчас показано обрезкой на выводе: лишний раз её не трогаем. } + FLastCropKey: string; FGenerate: TGenerateThread; FGenerateBusy: Boolean; @@ -215,8 +224,21 @@ type плеер туда никогда не доедет, и курсор переставал двигаться совсем. } FSeekWaitTicks: Integer; + { До какого времени ответ на команду держится в строке состояния. } + FStatusHoldUntil: TDateTime; + { Автосохранение не удалось — жалуемся один раз, а не каждые полминуты. } + FAutoSaveBroken: Boolean; + { Что было в строке состояния до того, как её занял рассказ о кнопке + под указателем, и чья именно это подсказка. Кнопка нужна затем, что + при переходе с одной на соседнюю события приходят вперемешку: уход + со старой может прийти после прихода на новую, и без проверки он + затёр бы свежую подсказку. } + FStatusBeforeHint: string; + FHintControl: TControl; procedure ApplyVolumeAt(const ATime: Double); + { Показывает кадрирование клипа, который виден сейчас. } + procedure ApplyCropAt(const ATime: Double); { Переписывает файл субтитров и отдаёт его плееру. } procedure UpdateSubtitles; procedure UpdateRippleButton; @@ -232,6 +254,17 @@ type procedure TrackMenuDown(Sender: TObject); procedure UpdateSnapButton; procedure UpdateGlueButton; + procedure UpdateSelectModeButton; + { Подсказки нижних кнопок показываются строкой состояния, а не + всплывающим окном. } + procedure BarButtonEnter(Sender: TObject); + procedure BarButtonLeave(Sender: TObject); + procedure UseStatusHints(const AButtons: array of TThemedButton); + { Перечитывает подсказку кнопки, над которой стоит указатель. } + procedure RefreshBarHint; + { Ширина строки состояния: до показателя работы или до края панели. } + procedure UpdateStatusWidth; + procedure TimelineSelectModeChange(Sender: TObject); procedure UpdateCenterButton; procedure ToggleCenterPlayhead; procedure RippleModeChosen(Sender: TObject); @@ -247,6 +280,7 @@ type procedure PoolEditTransform(Sender: TObject); procedure TimelineClipTransform(Sender: TObject; AClip: TClip); procedure MenuProjectInfo(Sender: TObject); + procedure MenuRepairProject(Sender: TObject); procedure FormFilesDropped(Sender: TObject; const FileNames: array of string); function ThumbIndexFor(const APath: string): Integer; procedure ApplySettings; @@ -290,7 +324,16 @@ type procedure RemindAboutDeps; procedure Log(const AText: string); procedure LogToFile(const AText: string); - procedure SetStatus(const AText: string); + { Урезает файл журнала, когда он перерос предел. } + procedure TrimLogFile; + { AAnswer — это ответ на команду человека, а не проходное сообщение: + такой ответ держится в строке несколько секунд. } + procedure SetStatus(const AText: string; AAnswer: Boolean = False); + { Автосохранение: копия рядом с проектом. } + function AutoSavePath: string; + procedure DropAutoSave; + procedure AutoSaveTick(Sender: TObject); + procedure OfferAutoSave; procedure UpdateCaption; procedure UpdateTimeLabel; procedure RefreshPool; @@ -338,7 +381,6 @@ type procedure MenuUndo(Sender: TObject); procedure MenuRedo(Sender: TObject); procedure MenuSplit(Sender: TObject); - procedure MenuSplitPrecise(Sender: TObject); procedure MenuDelete(Sender: TObject); procedure MenuColorKey(Sender: TObject); procedure MenuCopyLook(Sender: TObject); @@ -355,6 +397,7 @@ type { Что и откуда собирать: с учётом отмеченного участка. } procedure DescribeRegion(out AFrom, ATo: Double); procedure MenuSelectAll(Sender: TObject); + procedure MenuSelectMode(Sender: TObject); procedure MenuRipple(Sender: TObject); procedure MenuToggleRipple(Sender: TObject); procedure MenuGoStart(Sender: TObject); @@ -379,6 +422,9 @@ type { Строка и в общий журнал программы, и в журнал этой сборки. } procedure LogExport(const AText: string); { Предлагает продолжить прерванную сборку с готовых кусков. } + { Предупреждение о выбранном контейнере. False — человек передумал + собирать. } + function AskContainer(AHasPrecise: Boolean): Boolean; function AskResume(const AOutputPath: string): Boolean; procedure NormalizeProgress(Sender: TObject); procedure NormalizeLog(Sender: TObject); @@ -407,6 +453,22 @@ const Сообщения приходят на каждый кадр, так что это доли секунды. } MaxSeekWaitTicks = 90; + { Сколько ответ на команду держится в строке состояния, не давая себя + затереть проходным сообщением. Четыре секунды — успеть прочесть. } + StatusHoldTime = 4 / (24 * 60 * 60); + + { Как часто пишется копия проекта для восстановления. Полминуты — это + потолок потерь: больше получаса работы человек в неё не вложит, а + запись проекта стоит миллисекунды. } + AutoSaveIntervalMs = 30 * 1000; + + { Приставка к имени файла проекта у автосохранённой копии. } + AutoSaveSuffix = '.autosave'; + + { Предел для файла журнала. Больше двух мегабайт читать всё равно + никто не станет, а место жалко. } + MaxLogFileSize = 2 * 1024 * 1024; + function FormatTimecode(const Seconds: Double): string; var Total, H, M, S, Ms: Integer; @@ -452,6 +514,11 @@ begin FPreviewTimer.Interval := PreviewDebounceMs; FPreviewTimer.OnTimer := @PreviewTimerTick; + FAutoSaveTimer := TTimer.Create(Self); + FAutoSaveTimer.Interval := AutoSaveIntervalMs; + FAutoSaveTimer.OnTimer := @AutoSaveTick; + FAutoSaveTimer.Enabled := True; + { Список изображений держит миниатюры. Размер задан жёстко, и ffmpeg делает их ровно такими: список изображений в LCL требует одинакового размера у всех элементов. } @@ -487,6 +554,7 @@ begin UpdateRippleButton; UpdateSnapButton; UpdateGlueButton; + UpdateSelectModeButton; UpdateCenterButton; UpdateCaption; SetStatus('Готов. Добавьте файлы в проект.'); @@ -624,6 +692,7 @@ begin FTimeline.OnTrackMenu := @TimelineTrackMenu; FTimeline.OnTrackRename := @TimelineTrackRename; FTimeline.OnRegionChange := @TimelineRegionChange; + FTimeline.OnSelectionModeChange := @TimelineSelectModeChange; FTimeline.OnActiveTrackChange := @TimelineActiveTrackChange; end; @@ -723,11 +792,17 @@ begin 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])); + { Пункт держит и подпись режима: по одному значку на кнопке не угадать, + что сейчас делает протяжка мышью. } + FSelectModeItem := AddItem(MEdit, 'Режим выделения', @MenuSelectMode, + ShortCut(VK_D, [])); AddItem(MEdit, 'Цветовой ключ клипа...', @MenuColorKey); AddSep(MEdit); AddItem(MEdit, 'Копировать клипы', @MenuCopyClips, ShortCut(VK_C, [ssCtrl])); @@ -768,6 +843,7 @@ begin MProject := AddTop('Проект'); AddItem(MProject, 'Сведения о проекте...', @MenuProjectInfo); + AddItem(MProject, 'Проверить и починить проект...', @MenuRepairProject); AddSep(MProject); AddItem(MProject, 'Добавить текст', @MenuAddText, ShortCut(VK_T, [ssCtrl])); AddSep(MProject); @@ -859,7 +935,9 @@ procedure TMainForm.BuildJobIndicator; const JobWidth = 330; LogButtonWidth = 28; - LogButtonLeft = 448; + { Журнал стоит после переключателя выделения: сперва то, что меняет + работу с монтажом, потом то, что показывает сообщения. } + LogButtonLeft = 478; begin FJobLabel := TLabel.Create(Self); FJobLabel.Parent := pnlBottom; @@ -892,12 +970,13 @@ begin FLogButton.TabStop := False; FLogButton.Down := True; FLogButton.OnClick := @LogButtonClick; - FLogButton.ShowHint := True; FLogButton.Hint := 'Журнал: спрятать или показать полосу с сообщениями'; - { Строка состояния ужимается, чтобы её длинные сообщения не залезали - под показатель и под кнопку. } - lblStatus.Width := pnlBottom.ClientWidth - lblStatus.Left - JobWidth - 24; + { Все кнопки нижней панели рассказывают о себе строкой состояния. } + UseStatusHints([btnSnap, btnGlue, btnCenter, btnRipple, btnRippleMenu, + btnSelectMode, FLogButton]); + + UpdateStatusWidth; { Сто миллисекунд, а не триста: полоска должна ползти, а не дёргаться ступеньками. } @@ -1023,6 +1102,7 @@ begin FLogButton.Hint := 'Журнал виден. Нажмите, чтобы спрятать.' else FLogButton.Hint := 'Журнал спрятан. Нажмите, чтобы показать.'; + RefreshBarHint; end; { Как растёт полоска. @@ -1048,7 +1128,8 @@ var { Не Text: так называется свойство самой формы, а имена в Паскале нечувствительны к регистру. } Note: string; - Frac: Double; + Frac, Step: Double; + StepKnown: Boolean; Total, Done, Kind: Integer; begin {$IFDEF LCLWIN32} @@ -1064,6 +1145,9 @@ begin Total := 0; Done := 0; Kind := 0; + { Доля сделанного внутри текущего шага и есть ли она вообще. } + Step := 0; + StepKnown := False; { Порядок важен: показываем то, чего человек ждёт прямо сейчас. @@ -1075,6 +1159,8 @@ begin Kind := 1; Total := FGenerate.Total; Done := FGenerate.Done; + Step := FGenerate.StepFraction; + StepKnown := FGenerate.StepKnown; Note := FGenerate.StageText; if Note = '' then Note := 'Готовлю участки монтажа'; @@ -1104,6 +1190,7 @@ begin begin FJobLabel.Visible := False; FJobBar.Visible := False; + UpdateStatusWidth; end; { Следующая работа начинается с пустой полоски, а не с того места, где кончилась прошлая. } @@ -1123,8 +1210,17 @@ begin if Total > 0 then begin - FJobReal := Done / Total; - FJobNext := (Done + 1) / Total; + FJobReal := (Done + Step) / Total; + if StepKnown then + { Работа сама говорит, докуда дошла. Догадываться тут нечего и + нельзя: догадка разойдётся с числом, которое мы же и показываем, + и получится полная полоса рядом с нулём процентов. } + FJobNext := FJobReal + else + { Замера ещё нет — только запустились. Полоса трогается с места, + чтобы было видно, что работа жива, но уходит недалеко: пустая + полоса и есть правда о начале работы. } + FJobNext := FJobReal + 0.05 / Total; end else begin @@ -1135,12 +1231,19 @@ begin AdvanceJobBar; Frac := FJobShown; - FJobLabel.Caption := Note; + { Число и полоса — одно и то же число. + + Раньше полоса показывала догадку, а подпись — замер, и человек видел + полосу, заполненную на девять десятых, рядом с нулём процентов. Что + в этот момент происходит, по такой паре понять нельзя. Теперь + показывается ровно то, что нарисовано. } + FJobLabel.Caption := Note + Format(' — %d%%', [Round(Frac * 100)]); FJobBar.Fraction := Frac; if not FJobLabel.Visible then begin FJobLabel.Visible := True; FJobBar.Visible := True; + UpdateStatusWidth; end; end; @@ -1237,11 +1340,14 @@ begin lstPool.ItemIndex := 0; end; - { Спрашивать про клипы на чужих дорожках можно только теперь: окно - показано, и вопрос не окажется за кадром. } + { Спрашивать можно только теперь: окно показано, и вопрос не окажется + за кадром. Автосохранённая копия — первым делом: если прошлая работа + не дошла до файла, человек должен узнать об этом до того, как начнёт + правку поверх старого. } if FCheckMisplacedOnShow then begin FCheckMisplacedOnShow := False; + OfferAutoSave; CheckMisplacedClips; end; end; @@ -1326,12 +1432,57 @@ end; { --- Мелочи интерфейса --- } +{ Урезание журнала до последних строк, когда файл перерос предел. + + Читается целиком: предел небольшой, и возиться с чтением с конца ради + пары мегабайт незачем. } +procedure TMainForm.TrimLogFile; +var + L: TStringList; + Keep: Integer; + Found: TSearchRec; + Size: Int64; +begin + if not FileExists(FLogFilePath) then + Exit; + Size := 0; + if FindFirst(FLogFilePath, faAnyFile, Found) = 0 then + begin + Size := Found.Size; + FindClose(Found); + end; + if Size <= MaxLogFileSize then + Exit; + L := TStringList.Create; + try + try + L.LoadFromFile(FLogFilePath); + Keep := L.Count div 2; + while L.Count > Keep do + L.Delete(0); + L.Insert(0, '=== начало журнала урезано ==='); + L.SaveToFile(FLogFilePath); + except + { Не вышло урезать — не беда: журнал не работа, ради которой сюда + пришли. } + end; + finally + L.Free; + end; +end; + { Дублирование журнала в файл рядом с программой. Нужно ровно для одного случая: программа падает до того, как окно успело появиться. Тогда всё, что она о себе рассказала, пропадает - вместе с окном, и причина остаётся неизвестной. Файл переписывается - при каждом запуске: интересен последний. + вместе с окном, и причина остаётся неизвестной. + + Файл не переписывается при запуске, а дописывается: разбираться обычно + приходится не с тем запуском, который идёт сейчас, а с прошлым, и + затирать его нельзя — второй запуск программы уносил бы единственное + свидетельство. Каждый запуск отделён строкой с датой и временем. Файл + урезается, когда перерастёт предел: бесконечно растущий журнал никому + не нужен. Неудача записи ничего не значит — каталог может быть закрыт на запись, и работать это мешать не должно. } @@ -1342,14 +1493,19 @@ begin if FLogFileBroken then Exit; try + if not FLogFileStarted then + begin + TrimLogFile; + FLogFileStarted := True; + LogToFile(''); + LogToFile('=== запуск ' + FormatDateTime('dd.mm.yyyy hh:nn:ss', Now) + + ' ==='); + end; AssignFile(F, FLogFilePath); - if FLogFileStarted then + if FileExists(FLogFilePath) then Append(F) else - begin Rewrite(F); - FLogFileStarted := True; - end; try WriteLn(F, AText); finally @@ -1366,9 +1522,31 @@ begin LogToFile(AText); end; -procedure TMainForm.SetStatus(const AText: string); +{ Строка состояния — единственное место, где программа отвечает на + команду. Ответ команды нельзя затирать проходным сообщением: пересборка + предпросмотра случается после каждой правки и приходит через долю + секунды после нажатия, так что «Разрезано 3 клипа» человек просто не + успевал прочесть. + + Поэтому у ответа на команду есть небольшой срок, в течение которого + проходные сообщения его не трогают. Другой ответ на команду его + заменяет сразу: свежий ответ важнее прежнего. } +procedure TMainForm.SetStatus(const AText: string; AAnswer: Boolean); begin - lblStatus.Caption := AText; + if (not AAnswer) and (FStatusHoldUntil > Now) then + Exit; + if AAnswer then + FStatusHoldUntil := Now + StatusHoldTime + else + FStatusHoldUntil := 0; + { Указатель стоит на кнопке нижней панели, и в строке сейчас её + подсказка. Затирать подсказку нельзя: человек читает её ровно + потому, что навёл мышь. Ответ ложится под подсказку и покажется, + как только указатель уйдёт с кнопки. } + if FHintControl <> nil then + FStatusBeforeHint := AText + else + lblStatus.Caption := AText; end; procedure TMainForm.UpdateCaption; @@ -2170,11 +2348,29 @@ end; одна из готовящихся вставок в новом списке не нужна, работу можно прекращать. Ошибиться тут не страшно: отменённое, если оно всё же понадобится, закажут заново на следующей пересборке. } +{ Нужна ли ещё та работа, что идёт сейчас. + + Спрашивать по одному только списку недостающего нельзя, и это стоило + повисшей сборки. Недостающее — то, чего нет на диске; а у куска, + который делается прямо сейчас, файл уже есть: ffmpeg создаёт его в + первую же секунду и пишет до конца. Поэтому сведённый кусок в списке + недостающего не появлялся, проверка отвечала «не нужен», работа + отменялась в разгаре — и начиналась заново с нуля. + + На коротком затухании это проходило незаметно: кусок успевал + посчитаться между правками. На затухании в семьдесят секунд, которое + считается полторы минуты, любая следующая правка сбрасывала работу, и + сборка не заканчивалась никогда. + + Поэтому спрашиваем иначе: нужен ли расстановке сам этот путь — неважно, + лежит он уже на диске или ещё пишется. } function TMainForm.GenerationStillNeeded: Boolean; var - Segs, Auds: TFlatSegmentArray; + Segs, Auds, TrackSegs: TFlatSegmentArray; Ovl: TPreviewOverlays; - Missing: TGenRequests; + Missing, TrackMissing: TGenRequests; + Wanted: TStringList; + TotalLen: Double; I, J: Integer; begin Result := False; @@ -2184,6 +2380,33 @@ begin FSettings.PreviewKey) then Exit; + Wanted := TStringList.Create; + try + ResolveLayers(FProject, Segs, Missing, Wanted); + + { Звуковые дорожки считаются тем же путём, что и при пересборке: + вставки тишины под дыры у каждой дорожки свои, и они тоже могут + делаться прямо сейчас. } + TotalLen := Max(AudibleEnd(FProject, tkVideo), AudibleEnd(FProject, tkAudio)); + for I := 0 to FProject.TrackCount - 1 do + begin + if FProject.Tracks[I].Kind <> tkAudio then + Continue; + if not FProject.TrackAudible(FProject.Tracks[I]) then + Continue; + if FProject.Tracks[I].Count = 0 then + Continue; + FlattenAudioTrack(FProject, FProject.Tracks[I], TotalLen, + TrackSegs, TrackMissing, Wanted); + end; + + for J := 0 to FGenerate.TargetCount - 1 do + if Wanted.IndexOf(FGenerate.TargetPath(J)) >= 0 then + Exit(True); + finally + Wanted.Free; + end; + for I := 0 to High(Missing) do for J := 0 to FGenerate.TargetCount - 1 do if Missing[I].TargetPath = FGenerate.TargetPath(J) then @@ -2251,6 +2474,15 @@ begin FSeekPending := True; FSeekWaitTicks := 0; + { Кадрирование выставляется заново после каждой загрузки. + + Обрезка на выводе — свойство плеера, а не списка кусков: она + переживает загрузку и осталась бы от прошлого монтажа. А при открытии + проекта курсор не двигается вовсе, и без этого вызова первый клип + показывался бы без своего кадрирования до первого щелчка по монтажу. } + FLastCropKey := ''; + ApplyCropAt(Pos); + SetStatus(Format('Предпросмотр: %d %s, %s с', [Length(ASegments), Plural(Length(ASegments), 'кусок', 'куска', 'кусков'), SecondsToStr(TotalDuration(ASegments))])); @@ -2340,6 +2572,9 @@ begin FSettings.NoteRecentProject(FProject.FileName); RefreshRecentMenu; Log('Открыт проект: ' + FProject.FileName); + { Если рядом лежит копия новее проекта — значит прошлая работа не дошла + до файла, и об этом надо сказать сразу при открытии. } + OfferAutoSave; CheckMisplacedClips; end; @@ -2390,7 +2625,7 @@ begin SchedulePreview; UpdateCaption; Log(Format('Перенесено на подходящие дорожки: %d.', [N])); - SetStatus(Format('Перенесено клипов: %d.', [N])); + SetStatus(Format('Перенесено клипов: %d.', [N]), True); end; procedure TMainForm.UpdateRippleButton; @@ -2406,10 +2641,12 @@ begin btnRipple.Hint := 'Автосхлопывание включено, режим: ' + ModeText + '.' else btnRipple.Hint := 'Автосхлопывание выключено, режим: ' + ModeText + '.'; + { Коротко: подсказка идёт одной строкой в нижней панели, и длинный + хвост там просто обрезается. } btnRipple.Hint := btnRipple.Hint + LineEnding + - 'Ctrl+K — включить или выключить. Режим действует и при выключенном ' + - 'автосхлопывании: по нему работает Ctrl+Shift+R.'; + 'Ctrl+K — включить или выключить. Режим действует и на Ctrl+Shift+R.'; btnRippleMenu.Hint := 'Выбрать режим схлопывания'; + RefreshBarHint; end; { Прилипание краёв клипов друг к другу. @@ -2431,6 +2668,7 @@ begin State := 'выключено'; btnSnap.Hint := 'Прилипание: ' + State + '.' + LineEnding + 'Shift во время перетаскивания меняет решение на противоположное.'; + RefreshBarHint; end; procedure TMainForm.btnSnapClick(Sender: TObject); @@ -2455,6 +2693,7 @@ begin State := 'выключено'; btnGlue.Hint := 'Прилипание курсора к границам клипов: ' + State + '.' + LineEnding + 'Shift при щелчке меняет решение на противоположное.'; + RefreshBarHint; end; procedure TMainForm.btnGlueClick(Sender: TObject); @@ -2463,6 +2702,143 @@ begin UpdateGlueButton; end; +{ Подсказка к кнопке нижней панели показывается в строке состояния. + + Всплывающее окно здесь мешало: оно появлялось прямо поверх кнопки, о + которой рассказывает, перехватывало щелчок, и нажать кнопку было нельзя. + Строка состояния стоит в той же панели, ничего не закрывает и читается + без наведения мыши. } +procedure TMainForm.BarButtonEnter(Sender: TObject); +begin + if not (Sender is TControl) then + Exit; + if TControl(Sender).Hint = '' then + Exit; + if FHintControl = nil then + FStatusBeforeHint := lblStatus.Caption; + FHintControl := TControl(Sender); + RefreshBarHint; +end; + +procedure TMainForm.BarButtonLeave(Sender: TObject); +begin + { Ушли не с той кнопки, чья подсказка сейчас показана — значит указатель + уже на соседней, и трогать строку нельзя. } + if (FHintControl = nil) or (Sender <> FHintControl) then + Exit; + FHintControl := nil; + lblStatus.Caption := FStatusBeforeHint; +end; + +{ Подсказка переключателя меняется от щелчка по нему: «спрятан» — + «виден», «включено» — «выключено». Указатель при этом остаётся на + кнопке, второго наведения не будет, и без этого вызова в строке + состояния висел бы прежний текст — прямо противоположный тому, что + кнопка теперь делает. } +procedure TMainForm.RefreshBarHint; +var + Line: string; +begin + if FHintControl = nil then + Exit; + Line := FHintControl.Hint; + if Line = '' then + Line := FStatusBeforeHint + else + { Подсказки писались в несколько строк для всплывающего окна; в + строке состояния они идут одной. } + Line := StringReplace(Line, LineEnding, ' ', [rfReplaceAll]); + lblStatus.Caption := Line; +end; + +{ Строка состояния занимает всё, что свободно справа. + + Показатель работы появляется только пока что-то собирается или + разбирается. Всё остальное время его место пустует, а подсказки к + кнопкам — длинные, и в отведённые под них шестьсот точек не влезали: + человек видел «Переключит…» вместо целой фразы. Поэтому ширина + пересчитывается каждый раз, когда показатель появляется или прячется. } +procedure TMainForm.UpdateStatusWidth; +var + Right: Integer; +begin + if (FJobLabel = nil) or (lblStatus = nil) then + Exit; + if FJobLabel.Visible then + Right := FJobLabel.Left - 12 + else + Right := pnlBottom.ClientWidth - 12; + lblStatus.Width := Max(120, Right - lblStatus.Left); +end; + +{ Переводит кнопки на подсказки в строке состояния. } +procedure TMainForm.UseStatusHints(const AButtons: array of TThemedButton); +var + I: Integer; +begin + for I := 0 to High(AButtons) do + begin + if AButtons[I] = nil then + Continue; + AButtons[I].ShowHint := False; + AButtons[I].OnMouseEnter := @BarButtonEnter; + AButtons[I].OnMouseLeave := @BarButtonLeave; + end; +end; + +{ Кнопка режима выделения. + + Режима два, и кнопка показывает не «включено-выключено», а какой сейчас: + значок рамки — выделение клипов, значок промежутка — выделение по + времени. Поэтому она не утапливается, а меняет картинку. } +procedure TMainForm.UpdateSelectModeButton; +begin + if FSelectModeItem <> nil then + if FTimeline.SelectionMode = smRange then + FSelectModeItem.Caption := 'Режим выделения: по времени (сейчас)' + else + FSelectModeItem.Caption := 'Режим выделения: рамкой по клипам (сейчас)'; + + if FTimeline.SelectionMode = smRange then + begin + btnSelectMode.Icon := tiSelectRange; + btnSelectMode.Hint := 'Выделение по времени: протяжка метит ' + + 'промежуток на всех дорожках, S режет по его краям.' + LineEnding + + 'Переключить (D) на выделение клипов.'; + end + else + begin + btnSelectMode.Icon := tiSelectClips; + btnSelectMode.Hint := 'Выделение клипов: рамка выделяет всё, что ' + + 'задела, S режет по курсору.' + LineEnding + + 'Переключить (D) на выделение промежутка.'; + end; + RefreshBarHint; +end; + +procedure TMainForm.btnSelectModeClick(Sender: TObject); +begin + FTimeline.ToggleSelectionMode; +end; + +procedure TMainForm.MenuSelectMode(Sender: TObject); +begin + FTimeline.ToggleSelectionMode; +end; + +{ Режим сменили — сказать об этом словами: по одному значку не угадать, + что теперь делает протяжка мышью. } +procedure TMainForm.TimelineSelectModeChange(Sender: TObject); +begin + UpdateSelectModeButton; + if FTimeline.SelectionMode = smRange then + SetStatus('Выделение по времени: протяжка отмечает промежуток, ' + + 'S режет по его краям.', True) + else + SetStatus('Выделение клипов: рамка выделяет всё, что задела, ' + + 'S режет по курсору.', True); +end; + { Держать ли курсор посередине при воспроизведении. Включено — монтаж едет под курсором, и всегда видно, что будет дальше. @@ -2480,6 +2856,7 @@ begin State := 'выключено'; btnCenter.Hint := 'Курсор посередине при воспроизведении: ' + State + '.' + LineEnding + 'Клавиша \ переключает.'; + RefreshBarHint; end; procedure TMainForm.ToggleCenterPlayhead; @@ -2489,10 +2866,10 @@ begin if FSettings.CenterPlayhead then begin FTimeline.ScrollToPlayhead(True); - SetStatus('Курсор держится посередине монтажа.'); + SetStatus('Курсор держится посередине монтажа.', True); end else - SetStatus('Монтаж стоит на месте, курсор идёт по нему.'); + SetStatus('Монтаж стоит на месте, курсор идёт по нему.', True); end; procedure TMainForm.btnCenterClick(Sender: TObject); @@ -2505,9 +2882,9 @@ begin FProject.RippleEnabled := not FProject.RippleEnabled; UpdateRippleButton; if FProject.RippleEnabled then - SetStatus('Автосхлопывание включено: клипы правее едут вместе с перетаскиваемым.') + SetStatus('Автосхлопывание включено: клипы правее едут вместе с перетаскиваемым.', True) else - SetStatus('Автосхлопывание выключено: клипы правее остаются на месте.'); + SetStatus('Автосхлопывание выключено: клипы правее остаются на месте.', True); end; procedure TMainForm.btnRippleClick(Sender: TObject); @@ -2554,9 +2931,9 @@ begin UpdateCaption; if FProject.HasRegion then SetStatus(Format('Участок: %s — %s', - [SecondsToStr(FProject.RegionStart), SecondsToStr(FProject.RegionEnd)])) + [SecondsToStr(FProject.RegionStart), SecondsToStr(FProject.RegionEnd)]), True) else - SetStatus('Отметки участка сняты: собирается весь монтаж.'); + SetStatus('Отметки участка сняты: собирается весь монтаж.', True); end; procedure TMainForm.BuildTrackMenu; @@ -2608,7 +2985,7 @@ begin FProject.BeginChange; FProject.MoveTrack(FTrackMenuIndex, FTrackMenuIndex - 1); TimelineStructureChange(nil); - SetStatus('Дорожка поднята.'); + SetStatus('Дорожка поднята.', True); end; procedure TMainForm.TrackMenuDown(Sender: TObject); @@ -2618,7 +2995,7 @@ begin FProject.BeginChange; FProject.MoveTrack(FTrackMenuIndex, FTrackMenuIndex + 1); TimelineStructureChange(nil); - SetStatus('Дорожка опущена.'); + SetStatus('Дорожка опущена.', True); end; { Удаление дорожки. С клипами — только с подтверждением: вместе с @@ -2643,7 +3020,7 @@ begin FProject.EnsureUniqueTrackNames; FTimeline.Invalidate; UpdateCaption; - SetStatus('Дорожка названа: ' + FProject.Tracks[ATrackIndex].Name); + SetStatus('Дорожка названа: ' + FProject.Tracks[ATrackIndex].Name, True); end; procedure TMainForm.TrackMenuRename(Sender: TObject); @@ -2673,7 +3050,7 @@ begin FProject.BeginChange; FProject.RemoveTrack(FTrackMenuIndex); TimelineStructureChange(nil); - SetStatus('Дорожка ' + TrackName + ' удалена.'); + SetStatus('Дорожка ' + TrackName + ' удалена.', True); end; { --- Меню библиотеки --- } @@ -2818,7 +3195,7 @@ begin SchedulePreview; UpdateCaption; SetStatus(Format('Убрано %d %s', - [Removed, Plural(Removed, 'клип', 'клипа', 'клипов')])); + [Removed, Plural(Removed, 'клип', 'клипа', 'клипов')]), True); end; { Кадрирование отдельного клипа. Вызывается кнопкой в углу клипа. @@ -2832,6 +3209,7 @@ var T: TMediaTransform; Key: TColorKey; Applied: Boolean; + At: Double; begin if AClip = nil then Exit; @@ -2861,12 +3239,23 @@ begin end; T := AClip.Transform; + { Кадр окну — из самого клипа, а не из середины исходного файла. + + Клип обычно вырезан из середины долгой съёмки, и кадр «десятая часть + от начала файла» показывал совсем другую сцену: прицелиться + кадрированием было нечем. Берём то место, где стоит курсор, если он + внутри клипа, иначе середину клипа — то, на что человек и смотрит. } + At := FTimeline.Playhead; + if (At < AClip.TlStart) or (At > AClip.TlEnd) then + At := AClip.TlStart + AClip.Duration / 2; + At := AClip.SrcIn + (At - AClip.TlStart); + { Ключ отдаётся окну по ссылке: правку он подтверждает сам, и «Отмена» кадрирования её не отменяет. } Key := AClip.ColorKey; Applied := EditTransform(Self, Item.EffectivePath, Item.Info, FProject.Master.Width, FProject.Master.Height, T, - FProject.CacheDir + 'pancrop.png', @Key); + FProject.CacheDir + 'pancrop.png', @Key, At); if (not Applied) and SameColorKey(Key, AClip.ColorKey) then Exit; @@ -2917,7 +3306,7 @@ begin end; UpdateCaption; SchedulePreview; - SetStatus('Кадрирование обновлено: ' + FitModeCaption(T.Fit)); + SetStatus('Кадрирование обновлено: ' + FitModeCaption(T.Fit), True); end; procedure TMainForm.MenuProjectInfo(Sender: TObject); @@ -2925,6 +3314,112 @@ begin ShowProjectInfo(Self, FProject); end; +{ Проверка и починка проекта. + + Зачем. В проекте копятся вещи, которые сами по себе не видны, а в + готовом ролике оборачиваются сюрпризом: клип на дорожке чужого вида + (нарисован, но в сборку не попадает), одинаковые имена дорожек, времена + мимо кадровой сетки. Последнее — наследство: доли кадра в монтаже + означают, что предпросмотр и сборка округлят их каждый по-своему. + + Молча ничего не правится: сначала показываем, что нашли, и спрашиваем. + Отмена работает как у любой правки — Ctrl+Z. } +procedure TMainForm.MenuRepairProject(Sender: TObject); +var + OffGrid, Misplaced, Renamed, MovedClips, SnappedClips: Integer; + Report: string; + Names: TStringList; + T: Integer; +begin + OffGrid := FProject.OffGridClipCount; + Misplaced := FProject.MisplacedClipCount; + + { Одинаковые имена дорожек: считаем до правки, иначе не о чем говорить. } + Renamed := 0; + Names := TStringList.Create; + try + Names.Sorted := True; + Names.Duplicates := dupAccept; + for T := 0 to FProject.TrackCount - 1 do + begin + if Names.IndexOf(FProject.Tracks[T].Name) >= 0 then + Inc(Renamed); + Names.Add(FProject.Tracks[T].Name); + end; + finally + Names.Free; + end; + + if (OffGrid = 0) and (Misplaced = 0) and (Renamed = 0) then + begin + ThemedMessageDlg('nlve', + 'Проект в порядке: клипы стоят на кадрах, все они на дорожках ' + + 'своего вида, имена дорожек не повторяются.', + mtInformation, [mbOK], 0); + SetStatus('Проект проверен: чинить нечего.', True); + Exit; + end; + + Report := 'Найдено:' + LineEnding + LineEnding; + if OffGrid > 0 then + Report := Report + Format('— клипов мимо кадровой сетки: %d.' + LineEnding + + 'Между кадрами времени нет, и доля кадра означает, что предпросмотр ' + + 'и сборка округлят её каждый по-своему. Сдвиг при починке не больше ' + + 'полкадра.' + LineEnding + LineEnding, [OffGrid]); + if Misplaced > 0 then + Report := Report + Format('— клипов на дорожках чужого вида: %d.' + + LineEnding + 'Такой клип нарисован на монтаже, но в готовый ролик не ' + + 'попадает.' + LineEnding + LineEnding, [Misplaced]); + if Renamed > 0 then + Report := Report + Format('— дорожек с повторяющимся именем: %d.' + + LineEnding + LineEnding, [Renamed]); + Report := Report + 'Починить? Отменить можно будет через Ctrl+Z.'; + + if ThemedMessageDlg('nlve', Report, mtConfirmation, [mbYes, mbNo], 0) <> mrYes then + Exit; + + FProject.BeginChange; + SnappedClips := FProject.SnapClipsToFrameGrid; + MovedClips := FProject.FixMisplacedClips; + FProject.EnsureUniqueTrackNames; + + if (SnappedClips = 0) and (MovedClips = 0) and (Renamed = 0) then + begin + FProject.CancelChange; + SetStatus('Чинить не пришлось.', True); + Exit; + end; + + FProject.Modified := True; + FTimeline.Invalidate; + RefreshPool; + UpdateCaption; + FLastLoadedEdl := ''; + SchedulePreview; + + Report := ''; + if SnappedClips > 0 then + Report := Report + Format('на кадры поставлено %d %s', [SnappedClips, + Plural(SnappedClips, 'клип', 'клипа', 'клипов')]); + if MovedClips > 0 then + begin + if Report <> '' then + Report := Report + ', '; + Report := Report + Format('перенесено %d %s', [MovedClips, + Plural(MovedClips, 'клип', 'клипа', 'клипов')]); + end; + if Renamed > 0 then + begin + if Report <> '' then + Report := Report + ', '; + Report := Report + Format('переименовано %d %s', [Renamed, + Plural(Renamed, 'дорожка', 'дорожки', 'дорожек')]); + end; + + Log('Починка проекта: ' + Report + '.'); + SetStatus('Проект починен: ' + Report + '. Отменить — Ctrl+Z.', True); +end; + procedure TMainForm.PoolRemoveFromProject(Sender: TObject); var Idx: Integer; @@ -3031,6 +3526,75 @@ begin FPlayer.SetSubtitleFile(''); end; +{ Кадрирование клипа в предпросмотре. + + Цепочка фильтров у mpv одна на весь список кусков, а кадрирование у + каждого клипа своё, и включать его по времени в цепочке нечем: из + фильтров ffmpeg по времени переключается только наложение. Зато у + вывода есть своя обрезка, и делает её видеокарта даром. + + Раз она действует на весь вывод, переключать её обязаны мы: курсор + зашёл в клип со своим кадрированием — выставили, вышел — сняли. + + Участки с наложением сюда не попадают: там кадр уже сведён цепочкой, и + обрезка на выводе резала бы сведённое целиком, вместе с нижним слоем. + + Отражения обрезкой не выразить, растяжение — тоже: такие клипы + по-прежнему показываются как есть, точную картинку для них даёт окно + «Кадрирование и поворот». } +procedure TMainForm.ApplyCropAt(const ATime: Double); +var + I: Integer; + Clip: TClip; + Item: TMediaItem; + Sel: TRect; + Rotation: Integer; + Key: string; +begin + if (FPlayer = nil) or (not FPlayer.Initialized) or (FProject = nil) then + Exit; + + Sel := Rect(0, 0, 0, 0); + Rotation := 0; + + for I := 0 to High(FPreviewOverlayWindows) do + if (ATime >= FPreviewOverlayWindows[I].TlStart - 0.0005) and + (ATime <= FPreviewOverlayWindows[I].TlEnd + 0.0005) then + begin + FPlayer.SetOutputCrop(Sel, 0); + Exit; + end; + + Clip := VisibleClipAtTime(FProject, tkVideo, ATime); + if (Clip <> nil) and (Clip.Kind = ckVideo) and + TransformFitsOutputCrop(Clip.Transform) then + begin + Item := FProject.FindMedia(Clip.MediaId); + if (Item <> nil) and Item.Info.Valid and + (Item.Info.Width > 0) and (Item.Info.Height > 0) then + begin + Rotation := Clip.Transform.Rotation; + if not TransformSourceRect(Clip.Transform, + Item.Info.Width, Item.Info.Height, + FProject.Master.Width, FProject.Master.Height, Sel) then + Sel := Rect(0, 0, 0, 0) + { Рамка во весь кадр — это отсутствие обрезки. Ставить её значило бы + зря перестраивать вывод на каждом клипе. } + else if (Sel.Left <= 0) and (Sel.Top <= 0) and + (Sel.Right >= Item.Info.Width) and + (Sel.Bottom >= Item.Info.Height) then + Sel := Rect(0, 0, 0, 0); + end; + end; + + Key := Format('%d,%d,%d,%d,%d', + [Sel.Left, Sel.Top, Sel.Right, Sel.Bottom, Rotation]); + if Key = FLastCropKey then + Exit; + FLastCropKey := Key; + FPlayer.SetOutputCrop(Sel, Rotation); +end; + procedure TMainForm.ApplyVolumeAt(const ATime: Double); var I: Integer; @@ -3152,6 +3716,9 @@ end; procedure TMainForm.TimelinePlayheadChange(Sender: TObject); begin UpdateTimeLabel; + { Кадрирование показывается и на паузе: курсор переставили мышью — + картинка обязана смениться сразу, а не с началом воспроизведения. } + ApplyCropAt(FTimeline.Playhead); { Если курсор двинул сам плеер, перематывать его обратно нельзя — получится бесконечная переброска. } if FUpdatingFromPlayer then @@ -3169,7 +3736,7 @@ end; procedure TMainForm.TimelineSelectionChange(Sender: TObject); begin SetStatus(Format('Выделено %d %s', [FProject.SelectedCount, - Plural(FProject.SelectedCount, 'клип', 'клипа', 'клипов')])); + Plural(FProject.SelectedCount, 'клип', 'клипа', 'клипов')]), True); end; procedure TMainForm.PlayerLog(Sender: TObject; const APrefix, ALevel, AText: string); @@ -3189,6 +3756,15 @@ begin (FSeekWaitTicks < MaxSeekWaitTicks) then Exit; FSeekPending := False; + { Ждать перестали, а плеер так и не доехал. На паузе это значит, что + курсор надо оставить там, куда его поставил человек: при перезагрузке + списка кусков mpv сбрасывает отсчёт времени («Reset playback due to + audio timestamp reset») и сообщает что угодно, вплоть до конца + монтажа. Раньше курсор туда и улетал после каждой правки — например + после схлопывания дыры, и следующее схлопывание приходилось начинать + с прицеливания мышью заново. } + if FPlayer.Paused and (Abs(FPlayer.TimePos - FSeekTarget) > 0.35) then + Exit; end; { Обновляем курсор только при заметном сдвиге: mpv сообщает позицию на @@ -3197,6 +3773,7 @@ begin Exit; ApplyVolumeAt(FPlayer.TimePos); + ApplyCropAt(FPlayer.TimePos); FUpdatingFromPlayer := True; try @@ -3290,12 +3867,21 @@ begin Exit; end; - { Обратная косая: пункта меню для неё нет намеренно — сочетание из - одной такой клавиши в меню выглядит как опечатка, а работать должно. } + { Обратная косая — «покажи, где курсор»: окно едет к нему и ставит его + посередине. Жмут её чаще всего после реза или выделения, когда курсор + стоит на границе и надо к ней вернуться. + + Раньше она переключала режим «курсор посередине». Переключатель + остался кнопкой с целью внизу: включают его раз и надолго, а + подтягивать окно к курсору нужно постоянно. + + Пункта меню для неё нет намеренно — сочетание из одной такой клавиши + в меню выглядит как опечатка, а работать должно. } if (Key = VK_OEM_5) and (Shift = []) then begin Key := 0; - ToggleCenterPlayhead; + FTimeline.ScrollToPlayhead(True); + SetStatus('Окно у курсора: ' + FormatTimecode(FTimeline.Playhead), True); end; end; @@ -3359,10 +3945,134 @@ begin else begin UpdateCaption; - Log('Проект сохранён.'); + { Сохранение должно быть видно. Раньше о нём говорила только строчка + в журнале, а журнал по умолчанию закрыт: человек нажимал Ctrl+S, + ничего не происходило, и понять, дошло сохранение до файла или нет, + было не по чему. } + SetStatus('Проект сохранён: ' + ExtractFileName(FProject.FileName) + + ', ' + FormatDateTime('hh:nn:ss', Now), True); + Log('Проект сохранён: ' + FProject.FileName); + { Копия для восстановления больше не нужна: в файле то же самое. } + DropAutoSave; end; end; +{ Где лежит автосохранённая копия проекта. Рядом с самим проектом, чтобы + она нашлась там же, где его ищут. У безымянного проекта её нет: некуда + положить, и восстанавливать потом нечего. } +function TMainForm.AutoSavePath: string; +begin + if FProject.FileName = '' then + Result := '' + else + Result := FProject.FileName + AutoSaveSuffix; +end; + +procedure TMainForm.DropAutoSave; +var + Path: string; +begin + Path := AutoSavePath; + if (Path <> '') and FileExists(Path) then + DeleteFile(Path); +end; + +{ Копия проекта пишется, пока в нём есть несохранённое. + + Это не замена сохранению: файл проекта не трогается, имя не меняется, + признак «изменён» остаётся. Копия нужна на случай, когда работа всё же + пропала — программу закрыли, она упала, сохранение не дошло до файла. } +procedure TMainForm.AutoSaveTick(Sender: TObject); +var + Path, Err: string; +begin + if FProject = nil then + Exit; + Path := AutoSavePath; + if Path = '' then + Exit; + { Несохранённого нет — писать нечего. Копию при этом не трогаем: она + может быть единственным следом прошлой работы, а спросить о ней ещё + не успели. Убирается она там, где точно больше не нужна: после + сохранения проекта и после ответа на вопрос при открытии. } + if not FProject.Modified then + Exit; + if not FProject.SaveCopyTo(Path, Err) then + begin + { Жалуемся один раз и больше не мешаем: автосохранение — подстраховка, + а не работа, ради которой человек сюда пришёл. } + if not FAutoSaveBroken then + begin + FAutoSaveBroken := True; + Log('Автосохранение не работает: ' + Err); + end; + end + else + FAutoSaveBroken := False; +end; + +{ Проверка при открытии: не осталась ли копия новее самого проекта. + + Так бывает ровно в одном случае — работа не дошла до файла проекта. + Молча подменять файл нельзя, поэтому спрашиваем и показываем время. } +procedure TMainForm.OfferAutoSave; +var + Path, Err: string; + CopyStamp, ProjStamp: LongInt; + CopyTime, ProjTime: TDateTime; +begin + Path := AutoSavePath; + if (Path = '') or (not FileExists(Path)) then + Exit; + CopyStamp := FileAge(Path); + ProjStamp := FileAge(FProject.FileName); + if (CopyStamp < 0) or (ProjStamp < 0) then + Exit; + CopyTime := FileDateToDateTime(CopyStamp); + ProjTime := FileDateToDateTime(ProjStamp); + { Копия старше проекта — значит проект сохранён позже неё, и она уже + ни о чём не говорит. } + if CopyTime <= ProjTime + 1 / (24 * 60 * 60) then + begin + DeleteFile(Path); + Exit; + end; + + Log(Format('Найдена автосохранённая копия от %s, проект сохранён %s.', + [FormatDateTime('dd.mm hh:nn:ss', CopyTime), + FormatDateTime('dd.mm hh:nn:ss', ProjTime)])); + + if ThemedMessageDlg('nlve', + Format('Рядом с проектом лежит автосохранённая копия от %s, ' + + 'а сам проект сохранён %s.' + LineEnding + LineEnding + + 'Похоже, последние правки не дошли до файла проекта. ' + + 'Открыть копию?' + LineEnding + LineEnding + + 'Проект при этом не перезаписывается: копия просто откроется, и ' + + 'сохранить её поверх проекта можно будет самому. Откажетесь — ' + + 'копия останется лежать рядом, пока проект не сохранят заново.', + [FormatDateTime('dd.mm.yyyy hh:nn:ss', CopyTime), + FormatDateTime('dd.mm.yyyy hh:nn:ss', ProjTime)]), + mtConfirmation, [mbYes, mbNo], 0) <> mrYes then + Exit; + + if not FProject.LoadFromFile(Path, Err) then + begin + ThemedMessageDlg('nlve', Err, mtError, [mbOK], 0); + Exit; + end; + + { Имя возвращаем проектное: копия открыта, но работать человек + продолжает с проектом, и Ctrl+S должен писать в него. } + FProject.FileName := Copy(Path, 1, Length(Path) - Length(AutoSaveSuffix)); + FProject.Modified := True; + RefreshPool; + UpdateCaption; + FLastLoadedEdl := ''; + SchedulePreview; + SetStatus('Открыта автосохранённая копия. Проверьте и сохраните: Ctrl+S.', + True); +end; + procedure TMainForm.MenuSaveProject(Sender: TObject); begin DoSaveProject; @@ -3441,7 +4151,7 @@ begin FTimeline.Invalidate; SchedulePreview; UpdateCaption; - SetStatus('Отменено.'); + SetStatus('Отменено.', True); end; procedure TMainForm.MenuRedo(Sender: TObject); @@ -3456,18 +4166,24 @@ begin FTimeline.Invalidate; SchedulePreview; UpdateCaption; - SetStatus('Повторено.'); + SetStatus('Повторено.', True); +end; + +{ Рез отчитывается числом. Молчание после нажатия клавиши читается как + «она не работает»: именно так выглядел рез, когда курсор стоял на стыке + или на пустом месте. } +function SplitReport(ACount: Integer): string; +begin + if ACount = 0 then + Result := 'Резать нечего: под курсором нет клипов или он ровно на стыке.' + else + Result := Format('Разрезано %d %s.', [ACount, + Plural(ACount, 'клип', 'клипа', 'клипов')]); end; procedure TMainForm.MenuSplit(Sender: TObject); begin - FTimeline.SplitAtPlayhead(False, True); -end; - -procedure TMainForm.MenuSplitPrecise(Sender: TObject); -begin - FTimeline.SplitAtPlayhead(True, True); - SetStatus('Точный рез: стык будет перекодирован при сборке.'); + SetStatus(SplitReport(FTimeline.SplitAtPlayhead(False)), True); end; procedure TMainForm.MenuDelete(Sender: TObject); @@ -3527,9 +4243,9 @@ begin SchedulePreview; UpdateCaption; if Key.Enabled then - SetStatus('Цветовой ключ включён: участок будет пересобран.') + SetStatus('Цветовой ключ включён: участок будет пересобран.', True) else - SetStatus('Цветовой ключ выключен.'); + SetStatus('Цветовой ключ выключен.', True); end; { Отметки участка. @@ -3622,7 +4338,7 @@ begin end; SetStatus(Format('Скопировано %d %s. Вставить: Ctrl+V.', - [Taken.Count, Plural(Taken.Count, 'клип', 'клипа', 'клипов')])); + [Taken.Count, Plural(Taken.Count, 'клип', 'клипа', 'клипов')]), True); finally Taken.Free; end; @@ -3725,7 +4441,7 @@ begin UpdateCaption; SetStatus(Format('Вставлено %d %s.', [FClipboard.Count, - Plural(FClipboard.Count, 'клип', 'клипа', 'клипов')])); + Plural(FClipboard.Count, 'клип', 'клипа', 'клипов')]), True); end; { Первый выделенный клип: с него берут свойства. } @@ -3760,7 +4476,7 @@ begin FLookClip := TClip.Create; FLookClip.Kind := Src.Kind; FLookClip.CopyLookFrom(Src); - SetStatus('Свойства клипа скопированы. Применить: Ctrl+Shift+V.'); + SetStatus('Свойства клипа скопированы. Применить: Ctrl+Shift+V.', True); end; procedure TMainForm.MenuPasteLook(Sender: TObject); @@ -3795,7 +4511,7 @@ begin SchedulePreview; UpdateCaption; SetStatus(Format('Свойства применены к %d %s.', - [N, Plural(N, 'клипу', 'клипам', 'клипам')])); + [N, Plural(N, 'клипу', 'клипам', 'клипам')]), True); end; procedure TMainForm.MenuRegionIn(Sender: TObject); @@ -3806,7 +4522,7 @@ begin FTimeline.Invalidate; UpdateCaption; SetStatus(Format('Участок: %s — %s', - [SecondsToStr(FProject.RegionStart), SecondsToStr(FProject.RegionEnd)])); + [SecondsToStr(FProject.RegionStart), SecondsToStr(FProject.RegionEnd)]), True); end; procedure TMainForm.MenuRegionOut(Sender: TObject); @@ -3823,7 +4539,7 @@ begin FTimeline.Invalidate; UpdateCaption; SetStatus(Format('Участок: %s — %s', - [SecondsToStr(FProject.RegionStart), SecondsToStr(FProject.RegionEnd)])); + [SecondsToStr(FProject.RegionStart), SecondsToStr(FProject.RegionEnd)]), True); end; procedure TMainForm.MenuRegionClear(Sender: TObject); @@ -3832,7 +4548,7 @@ begin FProject.RegionEnd := 0; FTimeline.Invalidate; UpdateCaption; - SetStatus('Отметки участка сняты: собирается весь монтаж.'); + SetStatus('Отметки участка сняты: собирается весь монтаж.', True); end; { Границы того, что собираем. Без отметок — весь монтаж. } @@ -3857,11 +4573,13 @@ end; procedure TMainForm.MenuRipple(Sender: TObject); begin - { Команда должна отвечать всегда: молчание читается как «не работает». } + { Команда должна отвечать всегда: молчание читается как «не работает». + Дорожку называем: дыра могла найтись не на той, где стоял указатель, + и сдвиг чужой дорожки должен быть виден. } if FTimeline.RippleCloseGap then - SetStatus('Дыра схлопнута.') + SetStatus('Дыра на дорожке ' + FTimeline.LastGapTrack + ' схлопнута.', True) else - SetStatus('Под курсором дыры нет: схлопывать нечего.'); + SetStatus('Под курсором дыры нет: схлопывать нечего.', True); end; { К началу самого раннего клипа по всем дорожкам. Если монтаж начинается @@ -4033,12 +4751,17 @@ begin { Если есть хоть один точный рез, предупреждаем про контейнер: в MP4 перекодированный кусок и скопированный уживаются не всегда, а MKV - к смене параметров потока терпимее. } + к смене параметров потока терпимее. + + Признак — клип, начинающийся не с начала файла: попасть началом ровно + на опорный кадр можно только случайно, а во всех прочих случаях + огрызок до ближайшего опорного кадра перекодируется. Отметка edPrecise + сюда больше не годится: резы теперь точные всегда, независимо от неё. } 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 + if (FProject.Tracks[T][C].Kind = ckVideo) and + (FProject.Tracks[T][C].SrcIn > 0.0001) then HasPrecise := True; { Куда собирать, в каком контейнере и что делать с текстом — один @@ -4057,6 +4780,11 @@ begin end else begin + { Края участка — тоже на кадровую сетку. Иначе подрезка вернёт в + крайние куски доли кадра, которые уплощение только что убрало, и + картинка с звуком на краях участка разойдутся на полкадра. } + RegionFrom := FrameAlign(RegionFrom, FProject.Master); + RegionTo := FrameAlign(RegionTo, FProject.Master); ClipSegmentsToRange(Segments, RegionFrom, RegionTo); ClipSegmentsToRange(AudioSegs, RegionFrom, RegionTo); if Length(Segments) = 0 then @@ -4067,14 +4795,8 @@ begin end; end; - if HasPrecise and - (LowerCase(ExtractFileExt(FExportChoice.Path)) <> '.mkv') then - if ThemedMessageDlg('nlve', - 'В монтаже есть точные резы. В MP4 перекодированный стык может ' + - 'воспроизводиться неправильно — надёжнее MKV.' + LineEnding + - LineEnding + 'Всё равно собрать в выбранный контейнер?', - mtWarning, [mbYes, mbNo], 0) <> mrYes then - Exit; + if not AskContainer(HasPrecise) then + Exit; { Сколько материала придётся пересобрать — считаем уже по тому списку, который пойдёт в сборку: с участком он короче, и обещать человеку @@ -4276,6 +4998,49 @@ end; попытками, и тогда «готовые» куски — от другой расстановки. Сама сборка это проверит по отпечатку плана и при несовпадении соберёт заново, но знать об этом человек должен заранее. } +{ Выбранный контейнер и что он за собой тянет. + + У MP4 два недостатка, о которых человек узнаёт обычно поздно. Первый: + оглавление пишется в конец файла, и оборванная сборка не открывается + вовсе — продолжить её нельзя, только собрать заново. На четырёхчасовом + фильме это стоит часов работы. Второй: перекодированный стык точного + реза в нём воспроизводится не везде правильно. + + Поэтому предлагается MKV — он лишён обоих, — а переупаковать его в MP4 + можно потом, копированием потоков, без перекодирования. } +function TMainForm.AskContainer(AHasPrecise: Boolean): Boolean; +var + Text_, Ext: string; +begin + Result := True; + Ext := LowerCase(ExtractFileExt(FExportChoice.Path)); + if Ext = '.mkv' then + Exit; + + Ext := Copy(Ext, 2, 10); + Text_ := 'Прерванную сборку в ' + Ext + ' продолжить не удастся: ' + + 'оглавление пишется в конец файла, и оборванный файл не открывается ' + + 'вовсе. На длинном фильме это значит собирать всё заново.' + LineEnding; + if AHasPrecise then + Text_ := Text_ + 'К тому же в монтаже есть точные резы, а ' + + 'перекодированный стык в этом контейнере воспроизводится ' + + 'правильно не везде.' + LineEnding; + Text_ := Text_ + 'MKV этого лишён, а переупаковать его потом в ' + Ext + + ' можно без перекодирования — «Перепаковка файлов...» в меню «Файл».'; + + case ThemedChoiceDlg('nlve', Text_, + ['Собрать в MKV', 'Всё равно ' + Ext, 'Не собирать']) of + 0: + begin + FExportChoice.Path := ChangeFileExt(FExportChoice.Path, '.mkv'); + Log('Собираю в MKV: ' + FExportChoice.Path); + end; + 1: ; + else + Result := False; + end; +end; + function TMainForm.AskResume(const AOutputPath: string): Boolean; var DonePath: string; @@ -4283,6 +5048,28 @@ var N: Integer; begin Result := False; + + { Сборка потоком не оставляет кусков: продолжать там можно с самого + недописанного файла. Что он недописан, видно по отметке рядом — сам + по себе оборванный MKV открывается и играет. } + N := UnfinishedFrames(AOutputPath); + if (N > 0) and FileExists(AOutputPath) and + (LowerCase(ExtractFileExt(AOutputPath)) = '.mkv') then + begin + Result := ThemedMessageDlg('nlve', + Format('Прошлая сборка этого файла оборвалась, в нём %d %s.', + [N, Plural(N, 'кадр', 'кадра', 'кадров')]) + + LineEnding + LineEnding + + 'Да — продолжить с того места, где оборвалось.' + LineEnding + + 'Нет — собрать заново с начала, файл будет заменён.' + LineEnding + + LineEnding + + 'Если монтаж с тех пор менялся, продолжать нечего: собранная часть ' + + 'сделана по прежнему монтажу.', + mtConfirmation, [mbYes, mbNo], 0) = mrYes; + if Result then + Exit; + end; + DonePath := CacheDirFor(AOutputPath) + 'готово.txt'; if not FileExists(DonePath) then Exit; @@ -4313,9 +5100,14 @@ end; procedure TMainForm.ShowExportReport(const AReport: TExportReport); var - I, Encoded: Integer; - Shift: Double; + I, Encoded, Mismatched, WorstPart: Integer; + Shift, FrameSeconds: Double; + WantSum, Diff, WorstDiff: Int64; begin + FrameSeconds := 0; + if (FProject.Master.FpsNum > 0) and (FProject.Master.FpsDen > 0) then + FrameSeconds := FProject.Master.FpsDen / FProject.Master.FpsNum; + if AReport.Cancelled then begin LogExport('Сборка отменена.'); @@ -4362,6 +5154,57 @@ begin else LogExport(Format(' РАСХОЖДЕНИЕ на %d кадров.', [AReport.ActualPackets - AReport.ExpectedPackets])); + + { Сверка с монтажом: одно дело — склейка ничего не потеряла, другое — + получилось ли столько кадров, сколько просил монтаж. Звук набирается + по монтажу с точностью до отсчёта, поэтому лишний или недостающий + кадр картинки — это и есть расхождение звука с картинкой, и о нём + надо говорить числом, а не ждать, пока заметит глаз. } + WantSum := 0; + Mismatched := 0; + WorstPart := -1; + WorstDiff := 0; + for I := 0 to High(AReport.Segments) do + begin + if AReport.Segments[I].WantFrames <= 0 then + Continue; + Inc(WantSum, AReport.Segments[I].WantFrames); + if AReport.Segments[I].Packets < 0 then + Continue; + Diff := AReport.Segments[I].Packets - AReport.Segments[I].WantFrames; + if Diff <> 0 then + begin + Inc(Mismatched); + if Abs(Diff) > Abs(WorstDiff) then + begin + WorstDiff := Diff; + WorstPart := I; + end; + LogExport(Format(' часть %d: кадров %d, а монтаж просил %d (разница %d)', + [I + 1, AReport.Segments[I].Packets, + AReport.Segments[I].WantFrames, Diff])); + end; + end; + + if WantSum > 0 then + begin + LogExport(Format(' картинка: %d кадров, монтаж просил %d', + [AReport.ActualPackets, WantSum])); + Diff := AReport.ActualPackets - WantSum; + if Diff = 0 then + LogExport(' ЗВУК И КАРТИНКА СХОДЯТСЯ: кадров ровно столько, сколько в монтаже.') + else if WorstPart >= 0 then + LogExport(Format(' ЗВУК И КАРТИНКА РАСХОДЯТСЯ на %d %s (%s с), хуже всего часть %d.', + [Abs(Diff), Plural(Abs(Diff), 'кадр', 'кадра', 'кадров'), + SecondsToStr(Abs(Diff) * FrameSeconds), WorstPart + 1])) + else + LogExport(Format(' ЗВУК И КАРТИНКА РАСХОДЯТСЯ на %d %s (%s с).', + [Abs(Diff), Plural(Abs(Diff), 'кадр', 'кадра', 'кадров'), + SecondsToStr(Abs(Diff) * FrameSeconds)])); + if Mismatched > 0 then + LogExport(Format(' частей с неверной длиной: %d', [Mismatched])); + end; + LogExport(' файл: ' + AReport.OutputPath); SetStatus('Готово: ' + AReport.OutputPath); end; diff --git a/src/uMpvPlayer.pas b/src/uMpvPlayer.pas index 8fdc762..9d7ebdd 100644 --- a/src/uMpvPlayer.pas +++ b/src/uMpvPlayer.pas @@ -70,6 +70,10 @@ type { Номера подключённых звуковых дорожек, в порядке подключения. } FAudioIds: array of string; FLastGraph: string; + { Что сейчас выставлено обрезкой на выводе. Хранится, чтобы не + переустанавливать свойство на каждом кадре. } + FLastCrop: string; + FLastRotate: string; FSubtitlePath: string; { Что произошло с выбором звуковой дорожки. Читается окном для журнала: без этого понять, откуда взялся звук, нечем. } @@ -147,6 +151,18 @@ type громкость текущего куска и есть громкость всего вывода. } procedure SetVolume(const APercent: Double); + { Обрезка на выводе: показывать только этот кусок кадра исходника. + + Делает её сама видеокарта, цепочки фильтров тут нет и кадры в + обычную память не копируются. Годится на то, чего цепочкой дорого: + показать собственное кадрирование клипа. Действует на весь вывод + сразу, поэтому включать и снимать её обязан тот, кто знает, где + сейчас курсор. + + Пустой прямоугольник снимает обрезку. Поворот задаётся тем же + способом — отдельным свойством, а не фильтром. } + procedure SetOutputCrop(const ARect: TRect; ARotation: Integer); + { Цепочка фильтров ffmpeg поверх всего, что играет. Нужна ровно для одного: показать кадр проекта, а не кадр исходника. @@ -727,6 +743,32 @@ begin mpv_set_property(FHandle, 'volume', MPV_FORMAT_DOUBLE, @V); end; +procedure TMpvPlayer.SetOutputCrop(const ARect: TRect; ARotation: Integer); +var + Value, Rot: string; +begin + if FHandle = nil then + Exit; + + if (ARect.Right > ARect.Left) and (ARect.Bottom > ARect.Top) then + Value := Format('%dx%d+%d+%d', + [ARect.Right - ARect.Left, ARect.Bottom - ARect.Top, + ARect.Left, ARect.Top]) + else + Value := ''; + Rot := IntToStr(((ARotation mod 360) + 360) mod 360); + + { Лишний раз не трогаем: смена свойства перестраивает вывод, и на + каждом кадре это было бы заметно глазом. } + if (Value = FLastCrop) and (Rot = FLastRotate) then + Exit; + FLastCrop := Value; + FLastRotate := Rot; + + mpv_set_property_string(FHandle, 'video-crop', PAnsiChar(Value)); + mpv_set_property_string(FHandle, 'video-rotate', PAnsiChar(Rot)); +end; + procedure TMpvPlayer.SetVideoFilter(const AFilter: string); var Value: string; diff --git a/src/uPanCropForm.pas b/src/uPanCropForm.pas index dfce88f..b251ca3 100644 --- a/src/uPanCropForm.pas +++ b/src/uPanCropForm.pas @@ -71,6 +71,8 @@ type у заготовки для файла, у которой клипа ещё нет), и кнопки не будет. } FKey: PColorKey; + { Какое место исходника показывать в окне. } + FAtTime: Double; FSourceInfo: TMediaInfo; FDstWidth: Integer; FDstHeight: Integer; @@ -106,11 +108,18 @@ type procedure WriteControls; procedure ScheduleRefresh; procedure RefreshPreview(Sender: TObject); + { Время кадра в исходнике: заданное снаружи или своё. } + function FrameTime: Double; public { Готовит окно. ADstWidth и ADstHeight — кадр проекта. } + { AAtTime — какое место исходника показывать. Меньше нуля — выбрать + самим: десятая часть от начала файла. Для клипа передаётся его + собственное время, иначе прицелиться нечем: клип вырезан из середины + съёмки, а в окне показывалась совсем другая сцена. } procedure Setup(const APath: string; const AInfo: TMediaInfo; ADstWidth, ADstHeight: Integer; const ATransform: TMediaTransform; - const APreviewFile: string; AKey: PColorKey = nil); + const APreviewFile: string; AKey: PColorKey = nil; + AAtTime: Double = -1); property Transform: TMediaTransform read FTransform; end; @@ -124,7 +133,7 @@ type function EditTransform(AOwner: TComponent; const APath: string; const AInfo: TMediaInfo; ADstWidth, ADstHeight: Integer; var ATransform: TMediaTransform; const APreviewFile: string; - AKey: PColorKey = nil): Boolean; + AKey: PColorKey = nil; AAtTime: Double = -1): Boolean; implementation @@ -201,6 +210,21 @@ begin end; +{ Какое место исходника показывать. + + Задано снаружи — берём его: у клипа это его собственное время, и только + по нему можно прицелиться кадрированием. Не задано (кадрирование файла + целиком из списка) — десятая часть от начала, но не дальше пятой + секунды: первые кадры съёмки часто пустые. } +function TPanCropForm.FrameTime: Double; +begin + if FSourceInfo.Kind = mkImage then + Exit(0); + if FAtTime >= 0 then + Exit(Max(0, Min(FAtTime, Max(0, FSourceInfo.Duration - 0.05)))); + Result := Min(5, Max(0, FSourceInfo.Duration * 0.1)); +end; + procedure TPanCropForm.FormDestroy(Sender: TObject); begin FreeAndNil(FSourceBmp); @@ -211,8 +235,9 @@ end; procedure TPanCropForm.Setup(const APath: string; const AInfo: TMediaInfo; ADstWidth, ADstHeight: Integer; const ATransform: TMediaTransform; - const APreviewFile: string; AKey: PColorKey); + const APreviewFile: string; AKey: PColorKey; AAtTime: Double); begin + FAtTime := AAtTime; FKey := AKey; btnKey.Visible := AKey <> nil; FSourcePath := APath; @@ -321,10 +346,7 @@ var begin if FKey = nil then Exit; - if FSourceInfo.Kind = mkImage then - AtTime := 0 - else - AtTime := Min(5, Max(0, FSourceInfo.Duration * 0.1)); + AtTime := FrameTime; EditColorKey(FKey^, FSourcePath, AtTime, FPreviewFile + '.key.png'); end; @@ -407,45 +429,14 @@ end; { Рамка по настройке. Обратное к TransformFromSel: там же и объяснение, откуда берутся числа. } procedure TPanCropForm.SelFromTransform; -var - KFit, KFill, K: Double; - SW, SH, CW, CH, CX, CY: Double; - W, H: Double; begin UpdateRotatedSize; if (FRotW <= 0) or (FRotH <= 0) or (FDstWidth <= 0) or (FDstHeight <= 0) then Exit; - - KFit := Min(FDstWidth / FRotW, FDstHeight / FRotH); - KFill := Max(FDstWidth / FRotW, FDstHeight / FRotH); - if FTransform.Fit = fmFill then - K := KFill - else - K := KFit; - if FTransform.Fit = fmStretch then - begin - { Растяжение рамкой не описывается: берётся весь кадр. } - FSel := Rect(0, 0, FRotW, FRotH); - Exit; - end; - if FTransform.Zoom > 0 then - K := K * FTransform.Zoom; - if K <= 0 then - Exit; - - SW := FRotW * K; - SH := FRotH * K; - CW := Min(SW, FDstWidth); - CH := Min(SH, FDstHeight); - CX := (SW - CW) / 2 + FTransform.OffsetX * FDstWidth; - CY := (SH - CH) / 2 + FTransform.OffsetY * FDstHeight; - CX := Max(0, Min(SW - CW, CX)); - CY := Max(0, Min(SH - CH, CY)); - - W := CW / K; - H := CH / K; - FSel := Rect(Round(CX / K), Round(CY / K), - Round(CX / K + W), Round(CY / K + H)); + { Считает uTransform: той же рамкой пользуется предпросмотр, отдавая её + плееру как обрезку на выводе. Двух расчётов быть не должно — они + разойдутся, и окно начнёт обещать не то, что покажет плеер. } + TransformSourceRect(FTransform, FRotW, FRotH, FDstWidth, FDstHeight, FSel); end; { Настройка по рамке. @@ -515,10 +506,7 @@ begin Exit; Path := FPreviewFile + '.src.png'; - if FSourceInfo.Kind = mkImage then - AtTime := 0 - else - AtTime := Min(5, Max(0, FSourceInfo.Duration * 0.1)); + AtTime := FrameTime; { Пустая цепочка фильтров: нужен именно исходный кадр, без вписывания и полей — иначе рамку не по чему тянуть. } @@ -677,10 +665,7 @@ begin PrevW, PrevH); lblFilter.Caption := Filter; - if FSourceInfo.Kind = mkImage then - AtTime := 0 - else - AtTime := Min(5, Max(0, FSourceInfo.Duration * 0.1)); + AtTime := FrameTime; Res := RunProcess(FfmpegExe, ArgsPreviewFrame(FSourcePath, FPreviewFile, AtTime, Filter), @@ -720,14 +705,14 @@ end; function EditTransform(AOwner: TComponent; const APath: string; const AInfo: TMediaInfo; ADstWidth, ADstHeight: Integer; var ATransform: TMediaTransform; const APreviewFile: string; - AKey: PColorKey): Boolean; + AKey: PColorKey; AAtTime: Double = -1): Boolean; var Form: TPanCropForm; begin Form := TPanCropForm.Create(AOwner); try Form.Setup(APath, AInfo, ADstWidth, ADstHeight, ATransform, APreviewFile, - AKey); + AKey, AAtTime); Result := Form.ShowModal = mrOK; if Result then ATransform := Form.Transform; diff --git a/src/uProcRunner.pas b/src/uProcRunner.pas index 6a3dde2..f7fb8b0 100644 --- a/src/uProcRunner.pas +++ b/src/uProcRunner.pas @@ -34,6 +34,25 @@ type несколько раз в секунду. } TProcCancelQuery = function: Boolean of object; + { Накопитель, который режет поток байтов на строки. + + Отдельный класс нужен потому, что ffmpeg заканчивает строки по-разному: + вывод -progress использует перевод строки, а строку состояния в потоке + ошибок он перерисовывает возвратом каретки. Оба символа считаются + концом строки, пустые строки отбрасываются. + + Наружу вынесен не для чужого пользования, а потому что его держит + приёмник ниже. } + TLineSplitter = class + private + FBuffer: string; + FOnLine: TProcLineEvent; + public + constructor Create(AOnLine: TProcLineEvent); + procedure Feed(const AData: string); + procedure Flush; + end; + TProcResult = record Started: Boolean; Cancelled: Boolean; @@ -42,6 +61,45 @@ type ErrorText: string; end; + { Принимающий процесс: его ввод — труба, в которую мы льём то, что + вышло из процессов-отправителей. + + Зачем класс, а не ещё одна функция: приёмник живёт дольше любого + отправителя. Один ffmpeg пишет готовый файл, а куски в него шлёт + десяток других, запускаемых по очереди. + + Перелив идёт через нашу память, а не настоящей трубой между двумя + чужими процессами: собственные трубы у дочерних процессов есть в + любой системе, а наследование чужого дескриптора — нет. + + Вывод приёмника вычитывается на каждом шаге перелива. Иначе труба + его журнала заполнилась бы, приёмник встал бы на записи в неё, а мы + ждали бы, пока он прочтёт — и оба ждали бы друг друга. } + TProcSink = class + private + FProc: TProcessUTF8; + FOutSplit, FErrSplit: TLineSplitter; + FStarted: Boolean; + FClosed: Boolean; + FError: string; + public + constructor Create(const AExe: string; const AArgs: array of string; + AOnStdOut, AOnStdErr: TProcLineEvent); + destructor Destroy; override; + { Вычитывает журнал приёмника, не дожидаясь его конца. } + procedure Pump; + { Отдаёт приёмнику очередной кусок. False — труба оборвалась, + то есть приёмник умер и слать дальше некуда. } + function Feed(const ABuf; ACount: Integer): Boolean; + { Закрывает ввод: для приёмника это конец материала. } + procedure CloseInput; + { Ждёт конца работы и отдаёт код возврата. } + function Wait: Integer; + procedure Stop; + property Started: Boolean read FStarted; + property Error: string read FError; + end; + { Запускает процесс и ждёт его завершения, разбирая вывод на строки. AOnStdOut получает поток вывода (туда ffmpeg пишет -progress), @@ -50,6 +108,15 @@ type function RunProcess(const AExe: string; const AArgs: array of string; AOnStdOut, AOnStdErr: TProcLineEvent; ACancel: TProcCancelQuery): TProcResult; +{ Запускает процесс и переливает его вывод в приёмник. + + Вывод в трубу, а не в файл: ASink получает байты, а не строки. Поток + ошибок по-прежнему разбирается построчно — туда ffmpeg пишет и журнал, + и ход работы, если его об этом попросить (-progress pipe:2). } +function RunProcessInto(const AExe: string; const AArgs: array of string; + ASink: TProcSink; AOnStdErr: TProcLineEvent; + ACancel: TProcCancelQuery): TProcResult; + { Путь к исполняемому файлу по имени. Пустая строка — не найден. } function FindTool(const AName: string): string; @@ -66,23 +133,6 @@ const 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; @@ -172,6 +222,246 @@ begin end; end; +{ --- Приёмник --- } + +constructor TProcSink.Create(const AExe: string; const AArgs: array of string; + AOnStdOut, AOnStdErr: TProcLineEvent); +var + I: Integer; +begin + inherited Create; + FOutSplit := TLineSplitter.Create(AOnStdOut); + FErrSplit := TLineSplitter.Create(AOnStdErr); + FProc := TProcessUTF8.Create(nil); + + if not FileExists(AExe) then + begin + FError := 'Не найден исполняемый файл: ' + AExe; + Exit; + end; + + FProc.Executable := AExe; + for I := 0 to High(AArgs) do + FProc.Parameters.Add(AArgs[I]); + FProc.Options := [poUsePipes, poNoConsole]; + FProc.ShowWindow := swoHIDE; + try + FProc.Execute; + FStarted := True; + except + on E: Exception do + FError := 'Не удалось запустить ' + AExe + ': ' + E.Message; + end; +end; + +destructor TProcSink.Destroy; +begin + Stop; + FProc.Free; + FErrSplit.Free; + FOutSplit.Free; + inherited Destroy; +end; + +procedure TProcSink.Pump; +begin + if not FStarted then + Exit; + DrainPipe(FProc.Output, FOutSplit); + DrainPipe(FProc.Stderr, FErrSplit); +end; + +function TProcSink.Feed(const ABuf; ACount: Integer): Boolean; +begin + Result := False; + if (not FStarted) or FClosed or (ACount <= 0) then + Exit; + { Приёмник мог умереть — на разбитой трубе запись даёт исключение или + сигнал. Молча считаем это концом работы: настоящую причину скажет код + возврата и журнал. } + if not FProc.Running then + Exit; + try + Result := FProc.Input.Write(ABuf, ACount) = ACount; + except + Result := False; + end; + { Журнал приёмника вычитывается после каждой порции: его труба невелика, + и переполнившись, она остановила бы самого приёмника. } + Pump; +end; + +procedure TProcSink.CloseInput; +begin + if (not FStarted) or FClosed then + Exit; + FClosed := True; + try + FProc.CloseInput; + except + { Труба уже разбита — значит приёмника нет, и закрывать нечего. } + end; +end; + +function TProcSink.Wait: Integer; +begin + if not FStarted then + Exit(-1); + CloseInput; + while FProc.Running do + begin + Pump; + Sleep(IdleSleepMs); + end; + while DrainPipe(FProc.Output, FOutSplit) + + DrainPipe(FProc.Stderr, FErrSplit) > 0 do + ; + FOutSplit.Flush; + FErrSplit.Flush; + Result := FProc.ExitStatus; +end; + +procedure TProcSink.Stop; +begin + if not FStarted then + Exit; + CloseInput; + if FProc.Running then + try + FProc.Terminate(1); + except + { Уже завершился сам. } + end; +end; + +{ Перелив идёт порциями: прочитали у отправителя — отдали приёмнику. + + Порция небольшая по той же причине, по которой мал буфер трубы: между + записями надо успевать вычитывать журналы обоих процессов и смотреть, + не просят ли нас остановиться. } +function RunProcessInto(const AExe: string; const AArgs: array of string; + ASink: TProcSink; AOnStdErr: TProcLineEvent; + ACancel: TProcCancelQuery): TProcResult; +var + P: TProcessUTF8; + ErrSplit: TLineSplitter; + I, Avail, Got: Integer; + Terminated, Broken: Boolean; + Buf: array[0..ReadChunk - 1] of Byte; + + { Забирает у отправителя всё, что уже готово, и отдаёт приёмнику. + Возвращает число перелитых байт. } + function MoveData: Integer; + begin + Result := 0; + if P.Output = nil then + Exit; + Avail := P.Output.NumBytesAvailable; + while Avail > 0 do + begin + if Avail > SizeOf(Buf) then + Avail := SizeOf(Buf); + Got := P.Output.Read(Buf, Avail); + if Got <= 0 then + Break; + if not ASink.Feed(Buf, Got) then + begin + Broken := True; + Break; + end; + Inc(Result, Got); + Avail := P.Output.NumBytesAvailable; + end; + end; + +begin + Result.Started := False; + Result.Cancelled := False; + Result.ExitCode := -1; + Result.ErrorText := ''; + + if ASink = nil then + begin + Result.ErrorText := 'Некуда переливать: приёмник не задан.'; + Exit; + end; + if not ASink.Started then + begin + Result.ErrorText := ASink.Error; + if Result.ErrorText = '' then + Result.ErrorText := 'Приёмник не запущен.'; + Exit; + end; + if not FileExists(AExe) then + begin + Result.ErrorText := 'Не найден исполняемый файл: ' + AExe; + Exit; + end; + + P := TProcessUTF8.Create(nil); + ErrSplit := TLineSplitter.Create(AOnStdErr); + Broken := False; + try + P.Executable := AExe; + for I := 0 to High(AArgs) do + P.Parameters.Add(AArgs[I]); + 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 + I := MoveData + DrainPipe(P.Stderr, ErrSplit); + + if Broken then + begin + { Приёмник кончился — отправителю работать не для кого. } + if not Terminated then + begin + Terminated := True; + P.Terminate(1); + end; + Break; + end; + + if (not Terminated) and Assigned(ACancel) and ACancel() then + begin + Result.Cancelled := True; + Terminated := True; + P.Terminate(1); + end; + + if I = 0 then + Sleep(IdleSleepMs); + end; + + { Хвост: после завершения в трубах обычно остаётся непрочитанное. } + if not Broken then + while MoveData + DrainPipe(P.Stderr, ErrSplit) > 0 do + ; + ErrSplit.Flush; + + Result.ExitCode := P.ExitStatus; + if Broken and (Result.ExitCode = 0) then + Result.ExitCode := -1; + finally + ErrSplit.Free; + P.Free; + end; +end; + function RunProcess(const AExe: string; const AArgs: array of string; AOnStdOut, AOnStdErr: TProcLineEvent; ACancel: TProcCancelQuery): TProcResult; var diff --git a/src/uProgressForm.lfm b/src/uProgressForm.lfm index 0a829ac..6f43c91 100644 --- a/src/uProgressForm.lfm +++ b/src/uProgressForm.lfm @@ -30,13 +30,12 @@ object ProgressForm: TProgressForm Caption = 'Готовлю' ParentColor = False end - object pbBar: TProgressBar + object pbBar: TThemedProgress Left = 12 - Height = 22 - Top = 40 + Height = 10 + Top = 46 Width = 736 Anchors = [akTop, akLeft, akRight] - TabOrder = 0 end object lblEta: TLabel Left = 12 diff --git a/src/uProgressForm.pas b/src/uProgressForm.pas index 269e6c5..4029766 100644 --- a/src/uProgressForm.pas +++ b/src/uProgressForm.pas @@ -28,7 +28,11 @@ type lblStage: TLabel; lblEta: TLabel; memoLog: TLogView; - pbBar: TProgressBar; + { Полоса своя, а не системная: TProgressBar под gtk2 рисуется + ступеньками, по восемь кусков на всю ширину, и ход работы в ней + виден рывками. Эта заполняется сплошь, как та, что внизу главного + окна. } + pbBar: TThemedProgress; pnlTop: TPanel; procedure btnActionClick(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); @@ -59,11 +63,6 @@ implementation {$R *.lfm} -const - { Прогресс держим в целых долях от десяти тысяч: с шагом в один процент - полоса на длинной операции выглядит замершей. } - BarScale = 10000; - { TProgressForm } procedure TProgressForm.FormCreate(Sender: TObject); @@ -71,9 +70,7 @@ begin { Цвета задаём сами: системная тема может быть светлой, и тогда тёмный таймлайн оказался бы в белой рамке. } ApplyDarkTheme(Self); - pbBar.Min := 0; - pbBar.Max := BarScale; - pbBar.Position := 0; + pbBar.Fraction := 0; memoLog.Clear; btnAction.Caption := 'Отмена'; FStartedAt := Now; @@ -121,7 +118,7 @@ begin AValue := 0; if AValue > 1 then AValue := 1; - pbBar.Position := Round(AValue * BarScale); + pbBar.Fraction := AValue; FLastFraction := AValue; Elapsed := (Now - FStartedAt) * SecsPerDay; diff --git a/src/uProject.pas b/src/uProject.pas index 34d4a70..f70c803 100644 --- a/src/uProject.pas +++ b/src/uProject.pas @@ -377,6 +377,9 @@ type { --- Файл проекта --- } function SaveToFile(const APath: string; out AError: string): Boolean; + { Копия проекта в другой файл: имя проекта и признак «изменён» не + трогаются. Для автосохранения. } + function SaveCopyTo(const APath: string; out AError: string): Boolean; function LoadFromFile(const APath: string; out AError: string): Boolean; property Pool[AIndex: Integer]: TMediaItem read GetPoolItem; @@ -419,6 +422,19 @@ type такой нет — заводится новая. Время клипа не меняется: человек ставил его именно туда. } function FixMisplacedClips: Integer; + { Сколько клипов стоит мимо кадровой сетки. + + Доля кадра в монтаже — это не «почти точно»: картинка всё равно + выйдет целым числом кадров, а звук набирается с точностью до + отсчёта. Пока монтаж просит доли кадра, предпросмотр и готовый ролик + не могут совпасть в точности. } + function OffGridClipCount: Integer; + { Ставит клипы на кадровую сетку: начало на монтаже, длину и точку + входа в исходник. Возвращает, сколько клипов подвинулось. + + Сдвиг не превышает полкадра — на глаз и на слух незаметен, но + монтаж перестаёт хранить невозможные времена. } + function SnapClipsToFrameGrid: Integer; { Автоматическое схлопывание при перетаскивании клипов. } property RippleEnabled: Boolean read FRippleEnabled write FRippleEnabled; property FileName: string read FFileName write FFileName; @@ -441,6 +457,14 @@ function SameColorKey(const A, B: TColorKey): Boolean; центру — то, что читается на любой картинке. } function DefaultTextStyle: TTextStyle; +{ Время на кадровую сетку проекта. + + Между кадрами времени не существует: доля кадра в монтаже означает, что + картинка и звук округлят её каждый по-своему и разойдутся. Мера общая + для монтажа, уплощения и подрезки по участку — чтобы все считали + одинаково. } +function FrameAlign(const ATime: Double; const AMaster: TMediaInfo): Double; + { Шрифт по умолчанию. Разный по системам: одинаковых имён у них нет. } const DefaultTextFont = @@ -1122,6 +1146,81 @@ begin end; end; +function TProject.OffGridClipCount: Integer; +var + T, C: Integer; + Track: TTrack; + Clip: TClip; + + function OffGrid(const ATime: Double): Boolean; + begin + Result := Abs(FrameAlign(ATime, FMaster) - ATime) > 0.0005; + end; + +begin + Result := 0; + if (FMaster.FpsNum <= 0) or (FMaster.FpsDen <= 0) then + Exit; + for T := 0 to TrackCount - 1 do + begin + Track := Tracks[T]; + for C := 0 to Track.Count - 1 do + begin + Clip := Track[C]; + if OffGrid(Clip.TlStart) or OffGrid(Clip.Duration) or + OffGrid(Clip.SrcIn) then + Inc(Result); + end; + end; +end; + +function TProject.SnapClipsToFrameGrid: Integer; +var + T, C: Integer; + Track: TTrack; + Clip: TClip; + NewStart, NewDur, NewSrc, Step: Double; +begin + Result := 0; + if (FMaster.FpsNum <= 0) or (FMaster.FpsDen <= 0) then + Exit; + Step := FMaster.FpsDen / FMaster.FpsNum; + + for T := 0 to TrackCount - 1 do + begin + Track := Tracks[T]; + for C := 0 to Track.Count - 1 do + begin + Clip := Track[C]; + NewStart := FrameAlign(Clip.TlStart, FMaster); + NewDur := FrameAlign(Clip.Duration, FMaster); + { Клип короче кадра оставить нельзя: он исчезнет. } + if NewDur < Step then + NewDur := Step; + NewSrc := FrameAlign(Clip.SrcIn, FMaster); + if NewSrc < 0 then + NewSrc := 0; + + if (Abs(NewStart - Clip.TlStart) > 0.0000001) or + (Abs(NewDur - Clip.Duration) > 0.0000001) or + (Abs(NewSrc - Clip.SrcIn) > 0.0000001) then + begin + Clip.TlStart := NewStart; + Clip.Duration := NewDur; + Clip.SrcIn := NewSrc; + Inc(Result); + end; + end; + { Порядок мог измениться на доли кадра — пересортируем, иначе дальше + всё, что полагается на порядок, будет считать неверно. } + Track.Sort; + end; + + { Отметки участка — той же мерой: по ним режется сборка. } + FRegionStart := FrameAlign(FRegionStart, FMaster); + FRegionEnd := FrameAlign(FRegionEnd, FMaster); +end; + function TProject.FixMisplacedClips: Integer; var T, C, K: Integer; @@ -1426,6 +1525,17 @@ end; { Цветовой ключ по умолчанию: выключен, пурпурный, с небольшим запасом по сходству — сжатие видео размывает чистый цвет, и точное совпадение оставило бы кайму. } +function FrameAlign(const ATime: Double; const AMaster: TMediaInfo): Double; +var + Step: Double; +begin + Result := ATime; + if (AMaster.FpsNum <= 0) or (AMaster.FpsDen <= 0) then + Exit; + Step := AMaster.FpsDen / AMaster.FpsNum; + Result := Round(ATime / Step) * Step; +end; + function DefaultColorKey: TColorKey; begin Result.Enabled := False; @@ -1843,7 +1953,10 @@ begin end; end; -function TProject.SaveToFile(const APath: string; out AError: string): Boolean; +{ Запись проекта в произвольный файл, не трогая ни имя проекта, ни признак + «изменён». Нужна для автосохранения: копия пишется сама собой, и проект + от этого не должен считаться сохранённым. } +function TProject.SaveCopyTo(const APath: string; out AError: string): Boolean; var Text: TStringList; begin @@ -1851,23 +1964,75 @@ begin Result := False; Text := TStringList.Create; try - { Имя файла назначаем до записи: от него зависит путь к кэшу, который - попадает внутрь проекта косвенно — через сгенерированные клипы. } - FFileName := ExpandFileName(APath); Text.Text := Serialize; try - Text.SaveToFile(FFileName); - FModified := False; + Text.SaveToFile(APath); Result := True; except on E: Exception do - AError := 'Не удалось сохранить проект: ' + E.Message; + AError := 'Не удалось записать ' + APath + ': ' + E.Message; end; finally Text.Free; end; end; +{ Сохранение проекта. + + Пишем сперва во временный файл рядом, и только когда он записан целиком, + подставляем его на место настоящего. Прежний файл при этом становится + запасным (.bak). Так падение или полный диск посреди записи не оставляют + от проекта огрызок, а испорченное сохранение всегда можно откатить. + + Признак «изменён» снимается только после того, как файл на месте: если + запись не удалась, проект остаётся несохранённым и программа спросит + о нём при выходе. } +function TProject.SaveToFile(const APath: string; out AError: string): Boolean; +var + Full, Temp, Backup: string; +begin + AError := ''; + Result := False; + { Имя файла назначаем до записи: от него зависит путь к кэшу, который + попадает внутрь проекта косвенно — через сгенерированные клипы. } + Full := ExpandFileName(APath); + FFileName := Full; + Temp := Full + '.tmp'; + Backup := Full + '.bak'; + + if not SaveCopyTo(Temp, AError) then + Exit; + + try + if FileExists(Full) then + begin + if FileExists(Backup) then + DeleteFile(Backup); + if not RenameFile(Full, Backup) then + begin + AError := 'Не удалось отложить прежний файл проекта: ' + Backup; + Exit; + end; + end; + + if not RenameFile(Temp, Full) then + begin + { Подстановка не удалась — возвращаем прежний файл на место, чтобы + не остаться вообще без проекта. } + if FileExists(Backup) and (not FileExists(Full)) then + RenameFile(Backup, Full); + AError := 'Не удалось записать проект: ' + Full; + Exit; + end; + + FModified := False; + Result := True; + except + on E: Exception do + AError := 'Не удалось сохранить проект: ' + E.Message; + end; +end; + function TProject.LoadFromFile(const APath: string; out AError: string): Boolean; var Text: TStringList; diff --git a/src/uTheme.pas b/src/uTheme.pas index 08c9e0e..abeae9e 100644 --- a/src/uTheme.pas +++ b/src/uTheme.pas @@ -70,7 +70,9 @@ type tiRipple, // схлопывание: дыра между кусками закрывается tiLog, // журнал: полоса с сообщениями tiGlue, // курсор липнет к границам клипов - tiTarget // курсор держится середины монтажа + tiTarget, // курсор держится середины монтажа + tiSelectClips, // выделение рамкой: что задело, то и выделено + tiSelectRange // выделение по времени: от и до, по всем дорожкам ); { Полоска выполнения, которая рисует себя сама. @@ -91,6 +93,13 @@ type public constructor Create(AOwner: TComponent); override; property Fraction: Double read FFraction write SetFraction; + published + { Опубликовано ради файлов форм: читатель формы берёт только + опубликованные свойства, и без этого «Anchors» в .lfm роняет окно + при открытии — не при сборке. } + property Anchors; + property Align; + property Visible; end; { Кнопка, которая рисует себя сама. @@ -130,6 +139,9 @@ type X, Y: Integer); override; procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure KeyUp(var Key: Word; Shift: TShiftState); override; + { Если двойной щелчок всё же дойдёт (виджетсет может послать его и + без csDoubleClicks), считаем его обычным нажатием. } + procedure DblClick; override; procedure TextChanged; override; class function GetControlClassDefaultSize: TSize; override; public @@ -161,6 +173,10 @@ type property Flat: Boolean read FFlat write SetFlat default False; property Font; property Hint; + { Наведение и уход: главному окну они нужны, чтобы показывать + подсказку строкой состояния, а не всплывающим окном поверх кнопки. } + property OnMouseEnter; + property OnMouseLeave; property ModalResult: TModalResult read FModalResult write FModalResult default mrNone; property ParentFont; @@ -390,6 +406,11 @@ begin { csHasDefaultAction говорит форме, что нашу кнопку осмысленно вызывать по Enter; без этого Enter до неё не дойдёт. } ControlStyle := ControlStyle + [csHasDefaultAction, csHasCancelAction]; + { Двойной щелчок кнопке не нужен, а вреден. Второе нажатие подряд + приходит как двойное и обычным щелчком не считается — нажатие просто + пропадало. Со стороны это выглядело как «нажимаю быстро — не + срабатывает, нажимаю медленно — срабатывает». } + ControlStyle := ControlStyle - [csDoubleClicks]; TabStop := True; DoubleBuffered := True; { Без явного значения образец был бы чёрным (ноль — это clBlack), и @@ -460,6 +481,10 @@ begin tiLog: Stream.WriteBuffer(IconLogData[0], Length(IconLogData)); tiGlue: Stream.WriteBuffer(IconGlueData[0], Length(IconGlueData)); tiTarget: Stream.WriteBuffer(IconTargetData[0], Length(IconTargetData)); + tiSelectClips: Stream.WriteBuffer(IconSelectClipsData[0], + Length(IconSelectClipsData)); + tiSelectRange: Stream.WriteBuffer(IconSelectRangeData[0], + Length(IconSelectRangeData)); else Exit; end; @@ -727,6 +752,11 @@ begin с клавиатуры давало одну. } end; +procedure TThemedButton.DblClick; +begin + Click; +end; + procedure TThemedButton.KeyDown(var Key: Word; Shift: TShiftState); begin inherited KeyDown(Key, Shift); diff --git a/src/uTimelineCtrl.pas b/src/uTimelineCtrl.pas index 6a4d650..3fee7f3 100644 --- a/src/uTimelineCtrl.pas +++ b/src/uTimelineCtrl.pas @@ -41,9 +41,20 @@ type taFadeOut, // тянем уход за верхний правый угол taRegionIn, // тянем начало отмеченного участка taRegionOut, // тянем конец отмеченного участка - taDragTrack // тянем дорожку за заголовок, меняя порядок + taDragTrack, // тянем дорожку за заголовок, меняя порядок + taRubberBand // обтягиваем рамкой клипы по пустому месту ); + { Как понимать протяжку мышью по пустому месту. + + smClips — что рамка задела, то и выделено: привычное выделение + прямоугольником. + + smRange — отмечается промежуток времени по всем дорожкам сразу, от и + до. Нужен, чтобы вырезать кусок фильма целиком: отметил промежуток, + нажал S — и все дорожки разрезаны в двух местах, по краям промежутка. } + TSelectionMode = (smClips, smRange); + { Что находится под указателем в полосе заголовков дорожек. } THeaderPart = (hpNone, hpBody, hpMute, hpSolo, hpUp, hpDown, hpName); @@ -126,6 +137,26 @@ type клипы, которые уже сдвинулись. } FRippleClips: array of TClip; FRippleOrigStarts: array of Double; + { Имя дорожки, где схлопнули дыру в последний раз. } + FLastGapTrack: string; + { Рамка выделения: угол, где нажали, и угол, где мышь сейчас. + + По горизонтали храним время, а не точку экрана: рамку можно тянуть + за край окна, монтаж при этом прокручивается, и запомненная точка + экрана означала бы уже другое место. По вертикали храним отступ от + начала дорожек, а не от верха окна, — по той же причине. } + FBandFromTime: Double; + FBandToTime: Double; + FBandFromY: Integer; + FBandToY: Integer; + { Режим выделения и отмеченный им промежуток времени. + + Промежуток живёт до следующего выделения или щелчка: по нему режет + клавиша S, и человек должен видеть, где именно это произойдёт. } + FSelectionMode: TSelectionMode; + FRangeFrom: Double; + FRangeTo: Double; + FOnSelectionModeChange: TNotifyEvent; FGroupClips: array of TClip; FGroupOrigStarts: array of Double; @@ -180,11 +211,20 @@ type procedure DrawFades(ACanvas: TCanvas; AClip: TClip; const ABody: TRect); { Ручка затухания. AIn = True — появление (левый угол), иначе уход. } function FadeHandleRect(AClip: TClip; ATop: Integer; AIn: Boolean): TRect; + { Зона, в которой ручку затухания можно взять. Она шире нарисованной + ручки: пока затухание нулевое, ручка стоит в углу клипа и целиться + есть куда, а после протяжки она висит посреди клипа сама по себе, и + попасть в девять точек почти нельзя. } + function FadeGrabRect(AClip: TClip; ATop: Integer; AIn: Boolean): TRect; + { Какую из двух ручек затухания берут в этой точке. Пусто — ни одну. } + function FadeAtPoint(AClip: TClip; const AX, AY, ATop: Integer; + out AIn: Boolean): Boolean; { Полоса перекрытия двух клипов одной дорожки: там сам собой выходит переход, и это надо видеть. } procedure DrawOverlaps(ACanvas: TCanvas; ATrack: TTrack; ATop: Integer); { Полоса поверх участка, который прямо сейчас пересобирается. } procedure DrawBusyRange(ACanvas: TCanvas); + procedure DrawRubberBand(ACanvas: TCanvas); { Сдвиг всего, что правее дыры, влево до первого касания. } procedure RippleAfterDelete(const AHoleEnd: Double; const ATracks: TStringList); @@ -224,6 +264,22 @@ type const AFromTime: Double); procedure ApplyRipple(const ADelta: Double); function IsRippling(AClip: TClip): Boolean; + { Ближайшая к ATime дыра на дорожке: конец предыдущего клипа и начало + следующего. Дыра считается найденной, если ATime отстоит от неё не + дальше чем на ATolerance; внутри дыры расстояние нулевое. + + Допуск нужен потому, что курсор прилипает к краям клипов по всем + дорожкам сразу, а края картинки и её звука совпадают не всегда: + курсор, поставленный в дыру, может оказаться на десяток миллисекунд + левее её начала. Требовать точного попадания — значит заставлять + человека целиться. } + function NearestGapOnTrack(ATrackIndex: Integer; + const ATime, ATolerance: Double; out AFrom, ATo: Double): Boolean; + { Допуск прилипания в секундах: те же экранные точки, что у краёв. } + function SnapTolerance: Double; + procedure SetSelectionMode(AValue: TSelectionMode); + { Рез в указанном месте. Возвращает, сколько клипов разрезано. } + function SplitAt(const ATime: Double; APrecise: Boolean): Integer; protected procedure Paint; override; procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState; @@ -262,13 +318,20 @@ type function TrackIndexAtPoint(const AY: Integer): Integer; function TimeAtPoint(const AX: Integer): Double; - { Разрезать клипы под курсором воспроизведения. + { Разрезать клипы под курсором воспроизведения — на всех дорожках + сразу. Возвращает, сколько клипов разрезано: ноль тоже ответ, и + окно должен о нём сказать, иначе клавиша выглядит сломанной. + + Раньше резалась только дорожка под указателем мыши, и стоило + указателю оказаться над пустым местом, как рез молча не делал + ничего. Дорожка под мышью и дорожка, с которой работают, — разные + вещи, и связывать их не следует. APrecise помечает новые края как требующие точного реза: при сборке огрызок до опорного кадра будет перекодирован. Без этого рез притянется к опорному кадру, и точка съедет на величину до расстояния между опорными кадрами. } - procedure SplitAtPlayhead(APrecise: Boolean; AOnlyCurrentTrack: Boolean); + function SplitAtPlayhead(APrecise: Boolean): Integer; procedure DeleteSelected; { Связать выделенные клипы или развязать, если они уже связаны. @@ -286,6 +349,33 @@ type окно скажет об этом, чтобы команда не выглядела сломанной. } function RippleCloseGap: Boolean; procedure SelectAll; + { Выделить клипы, попавшие в область: дорожки с ATrackFrom по ATrackTo, + время с AFrom по ATo. + + Попавшим считается клип, который областью задет, а не целиком в ней + лежит: обтянуть длинный клип целиком на общем плане невозможно, а + убрать его хотят так же, как короткий. + + AAdd — добавить к уже выделенному (Ctrl), иначе прежнее выделение + заменяется. Открыто наружу ещё и затем, чтобы проверять числами. } + procedure SelectInRange(const AFrom, ATo: Double; + ATrackFrom, ATrackTo: Integer; AAdd: Boolean); + + { Режим выделения: рамкой по клипам или промежутком времени по всем + дорожкам. Переключается клавишей D и кнопкой внизу. } + property SelectionMode: TSelectionMode read FSelectionMode + write SetSelectionMode; + procedure ToggleSelectionMode; + { Отмечен ли промежуток времени и какой. } + function HasSelectionRange: Boolean; + property RangeFrom: Double read FRangeFrom; + property RangeTo: Double read FRangeTo; + { Отметить промежуток. Мышь зовёт это же, и проверки тоже: так + поведение реза проверяется числами, без беготни указателем. } + procedure SetSelectionRange(const AFrom, ATo: Double); + procedure ClearSelectionRange; + property OnSelectionModeChange: TNotifyEvent read FOnSelectionModeChange + write FOnSelectionModeChange; { Номер дорожки под указателем мыши, минус один если ни одной. } property HoverTrack: Integer read FHoverTrack; @@ -296,6 +386,10 @@ type { Куда встанет курсор, если поставить его в это время. Открыто, чтобы расчёт можно было проверить числами, не гоняя мышь по окну. } function SnapPlayhead(const ATime: Double): Double; + { Имя дорожки, на которой схлопнули дыру в последний раз. Нужно окну + для строки состояния: дыра могла найтись не на той дорожке, где + стоял указатель, и молча двигать чужую дорожку нельзя. } + property LastGapTrack: string read FLastGapTrack; { Округление к кадровой сетке проекта: между кадрами времени нет. } function QuantizeTime(const ATime: Double): Double; @@ -411,6 +505,7 @@ const ColorFadeFill = TColor($505050); // серый: срезанный угол клипа ColorOverlap = TColor($30C0FF); // оранжевый: полоса перехода ColorBusy = TColor($30C0FF); // оранжевый: участок в работе + ColorBand = TColor($E0E0E0); // белый: рамка выделения ColorHeaderActive = TColor($3A3A3A); // подсветка выбранной дорожки ColorButtonOff = TColor($3A3A3A); ColorMuteOn = TColor($4040D0); // красный: дорожка выключена @@ -705,6 +800,9 @@ begin { Отметка занятого участка идёт после клипов и до линейки: она должна лежать поверх клипов, но не наползать на подписи времени. } DrawBusyRange(FBuffer.Canvas); + { Рамка выделения — поверх клипов, но под линейкой и заголовками: она + про клипы, и наползать на подписи времени ей незачем. } + DrawRubberBand(FBuffer.Canvas); DrawRuler(FBuffer.Canvas); DrawHeaders(FBuffer.Canvas); DrawPlayhead(FBuffer.Canvas); @@ -1102,6 +1200,52 @@ begin Exit(Rect(0, 0, 0, 0)); end; +function TTimelineControl.FadeGrabRect(AClip: TClip; ATop: Integer; + AIn: Boolean): TRect; +const + { По сторонам — чтобы не целиться по горизонтали в девять точек. Вниз — + потому что ручка сидит на верхней грани клипа, и рука уводит курсор + внутрь клипа, а не выше него. } + PadX = 6; + PadDown = 7; +begin + Result := FadeHandleRect(AClip, ATop, AIn); + if Result.Right <= Result.Left then + Exit; + Dec(Result.Left, PadX); + Inc(Result.Right, PadX); + Inc(Result.Bottom, PadDown); + if Result.Left < FHeaderWidth then + Result.Left := FHeaderWidth; +end; + +function TTimelineControl.FadeAtPoint(AClip: TClip; const AX, AY, + ATop: Integer; out AIn: Boolean): Boolean; +var + RIn, ROut: TRect; + HitIn, HitOut: Boolean; +begin + AIn := False; + RIn := FadeGrabRect(AClip, ATop, True); + ROut := FadeGrabRect(AClip, ATop, False); + HitIn := (RIn.Right > RIn.Left) and PtInRect(RIn, Point(AX, AY)); + HitOut := (ROut.Right > ROut.Left) and PtInRect(ROut, Point(AX, AY)); + + { Зоны расширены, и на коротком клипе они могут налезть друг на друга. + Тогда берём ту ручку, к которой ближе: другого разумного ответа нет. } + if HitIn and HitOut then + HitOut := Abs(AX - (ROut.Left + ROut.Right) div 2) < + Abs(AX - (RIn.Left + RIn.Right) div 2); + + if HitOut then + begin + AIn := False; + Exit(True); + end; + Result := HitIn; + AIn := HitIn; +end; + procedure TTimelineControl.DrawFades(ACanvas: TCanvas; AClip: TClip; const ABody: TRect); var @@ -1323,6 +1467,65 @@ begin Invalidate; end; +{ Рамка выделения. Пунктиром и без заливки: клипы внутри и так + подсвечиваются выделением, а заливка поверх них мешала бы это увидеть. } +procedure TTimelineControl.DrawRubberBand(ACanvas: TCanvas); +var + L, R, T, B: Integer; + Pulling: Boolean; +begin + { Имя не Dragging: так называется метод самого элемента управления. } + Pulling := (FAction = taRubberBand) and FMovedWhileDown; + + { Отмеченный промежуток виден и после протяжки: по нему режет клавиша S, + и человек должен знать, где это произойдёт. } + if (not Pulling) and HasSelectionRange then + begin + L := Max(TimeToX(FRangeFrom), FHeaderWidth); + R := Min(TimeToX(FRangeTo), ClientWidth); + if R <= L then + Exit; + ACanvas.Pen.Color := ColorBand; + ACanvas.Pen.Style := psDot; + ACanvas.Brush.Style := bsClear; + ACanvas.Rectangle(L, FRulerHeight, R, ClientHeight); + ACanvas.Pen.Style := psSolid; + Exit; + end; + + if not Pulling then + Exit; + + L := Min(TimeToX(FBandFromTime), TimeToX(FBandToTime)); + R := Max(TimeToX(FBandFromTime), TimeToX(FBandToTime)); + + if FSelectionMode = smRange then + begin + { По времени отмечают промежуток, а не прямоугольник: рамка идёт во + всю высоту дорожек, сколько бы их ни было. } + T := FRulerHeight; + B := ClientHeight; + end + else + begin + T := Min(FBandFromY, FBandToY) - FScrollY; + B := Max(FBandFromY, FBandToY) - FScrollY; + end; + + L := Max(L, FHeaderWidth); + R := Min(R, ClientWidth); + T := Max(T, FRulerHeight); + B := Min(B, ClientHeight); + if (R <= L) or (B <= T) then + Exit; + + ACanvas.Pen.Color := ColorBand; + ACanvas.Pen.Style := psDot; + ACanvas.Brush.Style := bsClear; + ACanvas.Rectangle(L, T, R, B); + ACanvas.Pen.Style := psSolid; +end; + { Участок, который сейчас пересобирается. Помечается косой штриховкой во всю высоту дорожек: сплошная заливка @@ -1820,6 +2023,54 @@ begin Result := Best; end; +function TTimelineControl.SnapTolerance: Double; +begin + if FPixelsPerSecond > 0 then + Result := SnapPixels / FPixelsPerSecond + else + Result := 0; +end; + +function TTimelineControl.NearestGapOnTrack(ATrackIndex: Integer; + const ATime, ATolerance: Double; out AFrom, ATo: Double): Boolean; +var + Track: TTrack; + I: Integer; + PrevEnd, Dist, BestDist: Double; +begin + Result := False; + AFrom := 0; + ATo := 0; + if (FProject = nil) or (ATrackIndex < 0) or + (ATrackIndex >= FProject.TrackCount) then + Exit; + + Track := FProject.Tracks[ATrackIndex]; + BestDist := ATolerance; + PrevEnd := 0; + for I := 0 to Track.Count - 1 do + begin + if Track[I].TlStart > PrevEnd + 0.0005 then + begin + { Расстояние до отрезка дыры: внутри неё — ноль. } + if ATime < PrevEnd then + Dist := PrevEnd - ATime + else if ATime > Track[I].TlStart then + Dist := ATime - Track[I].TlStart + else + Dist := 0; + if Dist <= BestDist then + begin + BestDist := Dist; + AFrom := PrevEnd; + ATo := Track[I].TlStart; + Result := True; + end; + end; + PrevEnd := Max(PrevEnd, Track[I].TlEnd); + end; +end; + { --- Мышь --- } procedure TTimelineControl.MouseDown(Button: TMouseButton; Shift: TShiftState; @@ -1831,7 +2082,7 @@ var Part: THeaderPart; VolHandle: TRect; CropRect: TRect; - FadeHandle: TRect; + FadeIsIn: Boolean; begin inherited MouseDown(Button, Shift, X, Y); SetFocus; @@ -1956,16 +2207,21 @@ begin 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, SnapPlayhead(XToTime(X))); + { По пустому месту дорожек — рамка выделения. Что с ней делать, + решается при отпускании: не сдвинули мышь — это щелчок, и он, как и + раньше, ставит курсор (тянуться к линейке каждый раз неудобно). + Сдвинули — выделяем всё, что рамка задела. + + Выделение пока не трогаем: снимать его на нажатии значило бы терять + его от случайного щелчка мимо клипа. } + FAction := taRubberBand; + FPressX := X; + FPressY := Y; + FMovedWhileDown := False; + FBandFromTime := XToTime(X); + FBandToTime := FBandFromTime; + FBandFromY := Y + FScrollY; + FBandToY := FBandFromY; Exit; end; @@ -2002,23 +2258,12 @@ begin { Ручки затухания стоят в верхних углах, а там же начинается зона растягивания за край. Приоритет у ручек: они мелкие, промахнуться мимо них легче, а растянуть клип можно, взявшись за край ниже. } - FadeHandle := FadeHandleRect(Clip, TrackTop(TrackIndexAt(Y)), True); - if (FadeHandle.Right > FadeHandle.Left) and - PtInRect(FadeHandle, Point(X, Y)) then + if FadeAtPoint(Clip, X, Y, TrackTop(TrackIndexAt(Y)), FadeIsIn) then begin - FAction := taFadeIn; - FProject.BeginChange; - FPressX := X; - FPressY := Y; - FMovedWhileDown := False; - Invalidate; - Exit; - end; - FadeHandle := FadeHandleRect(Clip, TrackTop(TrackIndexAt(Y)), False); - if (FadeHandle.Right > FadeHandle.Left) and - PtInRect(FadeHandle, Point(X, Y)) then - begin - FAction := taFadeOut; + if FadeIsIn then + FAction := taFadeIn + else + FAction := taFadeOut; FProject.BeginChange; FPressX := X; FPressY := Y; @@ -2076,6 +2321,7 @@ var Clip: TClip; Track, TargetTrack: TTrack; VolHandle: TRect; + FadeIsIn: Boolean; begin inherited MouseMove(Shift, X, Y); VolHandle := Rect(0, 0, 0, 0); @@ -2105,6 +2351,12 @@ begin (X >= VolHandle.Left) and (X <= VolHandle.Right) and (Y >= VolHandle.Top - 3) and (Y <= VolHandle.Bottom + 3) then Cursor := crSizeNS + { Ручка затухания мелкая и после протяжки висит посреди клипа, где + её ничем не выдать. Пусть выдаёт курсор: он меняется над зоной + захвата, и становится видно, где взять. } + else if (Clip <> nil) and (Idx >= 0) and + FadeAtPoint(Clip, X, Y, TrackTop(Idx), FadeIsIn) then + Cursor := crSizeWE else if Edge <> 0 then Cursor := crSizeWE else if Clip <> nil then @@ -2129,6 +2381,28 @@ begin на стык, соскакивал бы с него от малейшего движения мыши. } Playhead := Max(0, SnapPlayhead(XToTime(X))); + taRubberBand: + begin + if (Abs(X - FPressX) > ClickSlopPixels) or + (Abs(Y - FPressY) > ClickSlopPixels) then + FMovedWhileDown := True; + { Тянут за край окна — прокручиваем следом: иначе рамкой нельзя + захватить больше, чем помещается на экране. Прокрутка идёт на + каждое движение мыши, само по себе время не течёт: пока мышь + стоит, ничего не происходит. } + if FPixelsPerSecond > 0 then + begin + if X < FHeaderWidth then + FScrollOffset := FScrollOffset - (FHeaderWidth - X) / FPixelsPerSecond + else if X > ClientWidth then + FScrollOffset := FScrollOffset + (X - ClientWidth) / FPixelsPerSecond; + ClampScroll; + end; + FBandToTime := XToTime(Max(FHeaderWidth, Min(ClientWidth, X))); + FBandToY := Max(FRulerHeight, Y) + FScrollY; + Invalidate; + end; + taDragTrack: if (FProject <> nil) and (FDragTrackIndex >= 0) then begin @@ -2456,6 +2730,45 @@ begin Exit; end; + { Рамка выделения. Щелчок без движения — это не рамка, а щелчок по + пустому месту: снимаем выделение и ставим курсор, как было всегда. } + if FAction = taRubberBand then + begin + FAction := taNone; + if FMovedWhileDown then + begin + if FSelectionMode = smRange then + begin + { Промежуток времени: по всем дорожкам, от и до. Края кладутся на + кадровую сетку — по ним потом режет клавиша S. } + SetSelectionRange(FBandFromTime, FBandToTime); + if (FProject <> nil) and (FRangeTo > FRangeFrom) then + SelectInRange(FRangeFrom, FRangeTo, 0, FProject.TrackCount - 1, + ssCtrl in Shift); + end + else + SelectInRange(FBandFromTime, FBandToTime, + (FBandFromY - FRulerHeight) div FTrackHeight, + (FBandToY - FRulerHeight) div FTrackHeight, + ssCtrl in Shift); + end + else + begin + if (FProject <> nil) and not (ssCtrl in Shift) then + begin + FProject.ClearSelection; + if Assigned(FOnSelectionChange) then + FOnSelectionChange(Self); + end; + { Щелчок снимает и отметку промежутка: она про прошлое выделение. } + ClearSelectionRange; + Playhead := Max(0, SnapPlayhead(XToTime(X))); + end; + FMovedWhileDown := False; + Invalidate; + Exit; + end; + WasEditing := FAction in [taDragClip, taTrimIn, taTrimOut, taVolume, taFadeIn, taFadeOut]; WasTrimIn := FAction = taTrimIn; @@ -2495,7 +2808,17 @@ function TTimelineControl.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; var Pt: TPoint; begin - Pt := ScreenToClient(MousePos); + { Точка берётся у самой мыши, а не из MousePos. + + MousePos по описанию приходит в координатах экрана, но под gtk2 в нём + уже клиентские: ScreenToClient переводил их второй раз, и точка опоры + уезжала влево ровно на левый край таймлайна. Замерено на невидимом + экране: мышь в 700, 1000 и 1300 — опора в 260, 560 и 860, то есть + всегда на 440 левее, а 440 — это и есть левый край. При мыши слева + опора и вовсе уходила за пределы окна. + + Mouse.CursorPos экранный в любой системе, и перевод остаётся один. } + Pt := ScreenToClient(Mouse.CursorPos); if ssCtrl in Shift then begin @@ -2539,51 +2862,43 @@ end; { --- Правки --- } -procedure TTimelineControl.SplitAtPlayhead(APrecise: Boolean; - AOnlyCurrentTrack: Boolean); +{ Рез в указанном месте. + + Место кладётся на кадровую сетку: между кадрами времени нет, и рез на + доле кадра оставил бы в монтаже время, которого не бывает. Сдвиг не + больше полкадра. } +function TTimelineControl.SplitAt(const ATime: Double; + APrecise: Boolean): Integer; var T: Integer; Track: TTrack; Clip, Tail: TClip; - AnyChange: Boolean; - Offset: Double; - HoverGroup: string; + Offset, At: Double; { Старый номер связки — новый. Одна связка при резе становится двумя: голова со своей парой и хвост со своей. } NewGroups: TStringList; Idx: Integer; begin + Result := 0; if FProject = nil then Exit; - AnyChange := False; + At := QuantizeTime(ATime); FProject.BeginChange; NewGroups := TStringList.Create; try - { Связка режется целиком. Резать только картинку, оставив звук цельным, - значит развалить пару: дальше они поедут порознь. } - HoverGroup := ''; - if AOnlyCurrentTrack and (FHoverTrack >= 0) and - (FHoverTrack < FProject.TrackCount) then - begin - Clip := FProject.Tracks[FHoverTrack].ClipAt(FPlayhead); - if Clip <> nil then - HoverGroup := Clip.GroupId; - end; - + { Режем все дорожки, где под курсором есть клип. Связка при этом + остаётся целой сама собой: картинка и её звук лежат под одним и тем + же временем, значит режутся оба. } for T := 0 to FProject.TrackCount - 1 do begin Track := FProject.Tracks[T]; - Clip := Track.ClipAt(FPlayhead); + Clip := Track.ClipAt(At); if Clip = nil then Continue; - if AOnlyCurrentTrack and (FHoverTrack >= 0) and (T <> FHoverTrack) then - if (HoverGroup = '') or (Clip.GroupId <> HoverGroup) then - Continue; - - Offset := FPlayhead - Clip.TlStart; + Offset := At - Clip.TlStart; { Рез вплотную к краю ничего не даёт, только плодит клипы нулевой длины. } if (Offset < 0.001) or (Offset > Clip.Duration - 0.001) then Continue; @@ -2592,7 +2907,7 @@ begin Tail.Id := Clip.Id + '_b'; Tail.MediaId := Clip.MediaId; Tail.SrcIn := Clip.SrcIn + Offset; - Tail.TlStart := FPlayhead; + Tail.TlStart := At; Tail.Duration := Clip.Duration - Offset; Tail.EdgeOut := Clip.EdgeOut; { Хвост — тот же клип, только вторая его половина. Всё настроенное @@ -2639,20 +2954,104 @@ begin Clip.Duration := Offset; Track.Add(Tail); - AnyChange := True; + Inc(Result); end; finally NewGroups.Free; end; - if AnyChange then + if Result > 0 then StructureChanged else { Ничего не разрезали — снимок отмены не нужен, откатываем его. } FProject.Undo; end; +{ Режим выделения: рамкой по клипам или промежутком по времени. + + Смена режима снимает отмеченный промежуток: он принадлежит режиму «по + времени», и оставлять его в другом режиме значило бы резать по невидимой + метке. } +procedure TTimelineControl.SetSelectionMode(AValue: TSelectionMode); +begin + if FSelectionMode = AValue then + Exit; + FSelectionMode := AValue; + ClearSelectionRange; + Invalidate; + if Assigned(FOnSelectionModeChange) then + FOnSelectionModeChange(Self); +end; + +procedure TTimelineControl.ToggleSelectionMode; +begin + if FSelectionMode = smClips then + SelectionMode := smRange + else + SelectionMode := smClips; +end; + +function TTimelineControl.HasSelectionRange: Boolean; +begin + Result := (FSelectionMode = smRange) and (FRangeTo - FRangeFrom > 0.0005); +end; + +procedure TTimelineControl.SetSelectionRange(const AFrom, ATo: Double); +begin + FRangeFrom := Max(0, QuantizeTime(Min(AFrom, ATo))); + FRangeTo := Max(0, QuantizeTime(Max(AFrom, ATo))); + Invalidate; +end; + +procedure TTimelineControl.ClearSelectionRange; +begin + if (FRangeFrom = 0) and (FRangeTo = 0) then + Exit; + FRangeFrom := 0; + FRangeTo := 0; + Invalidate; +end; + +{ Рез по команде человека. + + Обычно — по курсору. Если отмечен промежуток времени (режим выделения + «по времени»), режем по обоим его краям: это и есть «вырезать кусок + фильма» — два реза, между ними то, что уйдёт. + + Курсор после реза встаёт ровно на место реза: дальше с этим местом и + работают — удаляют кусок, схлопывают дыру, ставят следующий рез. } +function TTimelineControl.SplitAtPlayhead(APrecise: Boolean): Integer; +var + At: Double; +begin + Result := 0; + if FProject = nil then + Exit; + + if HasSelectionRange then + begin + { Сперва дальний край: рез не двигает то, что левее, но порядок + всё равно понятнее от конца к началу. } + Result := SplitAt(FRangeTo, APrecise); + Result := Result + SplitAt(FRangeFrom, APrecise); + Playhead := Max(0, QuantizeTime(FRangeFrom)); + + { После реза выделенной остаётся ровно середина — то, что между + краями. Иначе Delete убрал бы не её: выделение осталось бы на + клипах, какими они были до реза, а середина оказалась бы новой, + невыделенной половиной. } + if Result > 0 then + SelectInRange(FRangeFrom, FRangeTo, 0, FProject.TrackCount - 1, False); + Exit; + end; + + At := QuantizeTime(FPlayhead); + Result := SplitAt(At, APrecise); + if Result > 0 then + Playhead := Max(0, At); +end; + { Расширяет выделение на всю связку: клипы, связанные с уже выделенными, тоже считаются выделенными. Иначе удаление или перенос разорвали бы связку пополам. } @@ -2808,7 +3207,7 @@ var T, C: Integer; Track: TTrack; AnyChange: Boolean; - HoleEnd: Double; + HoleEnd, HoleStart: Double; Touched: TStringList; begin if FProject = nil then @@ -2820,6 +3219,7 @@ begin AnyChange := False; HoleEnd := 0; + HoleStart := -1; FProject.BeginChange; Touched := TStringList.Create; try @@ -2831,6 +3231,9 @@ begin begin { Правый край дыры: дальше него всё поедет влево. } HoleEnd := Max(HoleEnd, Track[C].TlEnd); + { Левый край — место будущего стыка: туда встанет курсор. } + if (HoleStart < 0) or (Track[C].TlStart < HoleStart) then + HoleStart := Track[C].TlStart; if Touched.IndexOf(IntToStr(T)) < 0 then Touched.Add(IntToStr(T)); Track.Remove(Track[C]); @@ -2848,7 +3251,17 @@ begin end; if AnyChange then - StructureChanged + begin + { Курсор — на место, где был вырезанный кусок: при схлопывании там + теперь стык, без схлопывания — начало дыры. С этим местом и работают + дальше, и искать его мышью заново незачем. } + if HoleStart >= 0 then + Playhead := Max(0, HoleStart); + { Отметка промежутка пережила бы удаление и резала бы потом по + пустому месту. } + ClearSelectionRange; + StructureChanged; + end else FProject.Undo; end; @@ -2857,33 +3270,11 @@ function TTimelineControl.RippleCloseGap: Boolean; var T, C, Source: Integer; Track: TTrack; - GapStart, GapEnd, Shift: Double; + GapStart, GapEnd, Shift, Tolerance: 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 Result := False; + FLastGapTrack := ''; if FProject = nil then Exit; @@ -2895,14 +3286,31 @@ begin клавиатуре, — берём выбранную дорожку. Раньше в этом случае команда молча не делала ничего, и выглядело это как «горячая клавиша не работает». } + Tolerance := Max(SnapTolerance, 0.001); + Source := FHoverTrack; if (Source < 0) or (Source >= FProject.TrackCount) then Source := FActiveTrack; - if (Source < 0) or (Source >= FProject.TrackCount) then - Exit; - if not FindGap(FProject.Tracks[Source], GapStart, GapEnd) then - Exit; + if (Source < 0) or (Source >= FProject.TrackCount) or + (not NearestGapOnTrack(Source, FPlayhead, Tolerance, GapStart, GapEnd)) then + begin + { На своей дорожке дыры нет — ищем на остальных сверху вниз. Указатель + мыши может стоять где угодно, а дыра под курсором обычно одна на весь + монтаж. Какую дорожку схлопнули, окно потом скажет: молча двигать не + ту дорожку, на которую смотрели, нельзя. } + Source := -1; + for T := 0 to FProject.TrackCount - 1 do + if NearestGapOnTrack(T, FPlayhead, Tolerance, GapStart, GapEnd) then + begin + Source := T; + Break; + end; + if Source < 0 then + Exit; + end; + + FLastGapTrack := FProject.Tracks[Source].Name; Shift := GapEnd - GapStart; if Shift <= 0 then @@ -2934,6 +3342,9 @@ begin if AnyChange then begin + { Курсор — на стык: дыры больше нет, а работать дальше будут именно с + этим местом. } + Playhead := Max(0, GapStart); StructureChanged; Result := True; end @@ -2955,6 +3366,46 @@ begin FOnSelectionChange(Self); end; +procedure TTimelineControl.SelectInRange(const AFrom, ATo: Double; + ATrackFrom, ATrackTo: Integer; AAdd: Boolean); +var + T, C, T1, T2: Integer; + From_, To_, Eps: Double; + Clip: TClip; +begin + if FProject = nil then + Exit; + + { Рамку тянут в любую сторону — приводим её к возрастающему виду. } + From_ := Min(AFrom, ATo); + To_ := Max(AFrom, ATo); + + { Нужно настоящее перекрытие, а не касание краями. Сосед, кончающийся + ровно там, где рамка начинается, в неё не попал — но сложение долей + даёт разницу в последнем знаке, и «больше» срабатывает. Порог — + полкадра: перекрытия короче кадра не бывает. } + Eps := 0.0005; + if (FProject.Master.FpsNum > 0) and (FProject.Master.FpsDen > 0) then + Eps := FProject.Master.FpsDen / FProject.Master.FpsNum / 2; + T1 := Max(0, Min(ATrackFrom, ATrackTo)); + T2 := Min(FProject.TrackCount - 1, Max(ATrackFrom, ATrackTo)); + + if not AAdd then + FProject.ClearSelection; + + for T := T1 to T2 do + for C := 0 to FProject.Tracks[T].Count - 1 do + begin + Clip := FProject.Tracks[T][C]; + if (Clip.TlEnd > From_ + Eps) and (Clip.TlStart < To_ - Eps) then + Clip.Selected := True; + end; + + Invalidate; + if Assigned(FOnSelectionChange) then + FOnSelectionChange(Self); +end; + procedure TTimelineControl.KeyDown(var Key: Word; Shift: TShiftState); begin inherited KeyDown(Key, Shift); @@ -2996,6 +3447,7 @@ begin SelectAll; Key := 0; end; + VK_HOME: begin { К началу самого раннего клипа, а не просто в ноль: если монтаж diff --git a/src/uTransform.pas b/src/uTransform.pas index acddee3..bbb07b1 100644 --- a/src/uTransform.pas +++ b/src/uTransform.pas @@ -82,6 +82,27 @@ function OverlayFilter(const AT: TMediaTransform; ASrcWidth, ASrcHeight, ADstWidth, ADstHeight: Integer; out AX, AY, AWidth, AHeight: Integer): string; +{ Какая часть исходника видна в кадре проекта — прямоугольник в точках + самого исходника. + + Та же настройка, записанная с другой стороны: вместо «как вписать» — + «что останется». Окно кадрирования рисует по ней рамку, а плеер отдаёт + её mpv как обрезку на выводе, и оба обязаны считать одинаково — иначе + окно обещает одно, а предпросмотр показывает другое. + + False — прямоугольником не описать: при растяжении берётся весь кадр и + сжимается неравномерно. } +function TransformSourceRect(const AT: TMediaTransform; + ASrcWidth, ASrcHeight, ADstWidth, ADstHeight: Integer; + out ARect: TRect): Boolean; + +{ Можно ли показать это преобразование обрезкой на выводе плеера. + + Обрезка умеет только выбрать кусок кадра. Поворот у mpv задаётся + отдельным свойством и потому разрешён, а отражение — нет: свойства для + него нет, и такой клип по-прежнему показывается как есть. } +function TransformFitsOutputCrop(const AT: TMediaTransform): Boolean; + { Фильтр цветового ключа: этот цвет становится прозрачным. Один на всех: и сборка, и предпросмотр должны выбивать одинаково, иначе @@ -153,6 +174,56 @@ begin (ASrcWidth = ADstWidth) and (ASrcHeight = ADstHeight); end; +function TransformSourceRect(const AT: TMediaTransform; + ASrcWidth, ASrcHeight, ADstWidth, ADstHeight: Integer; + out ARect: TRect): Boolean; +var + KFit, KFill, K: Double; + SW, SH, CW, CH, CX, CY: Double; +begin + ARect := Rect(0, 0, ASrcWidth, ASrcHeight); + Result := False; + if (ASrcWidth <= 0) or (ASrcHeight <= 0) or + (ADstWidth <= 0) or (ADstHeight <= 0) then + Exit; + { Растяжение рамкой не описывается: берётся весь кадр и жмётся + неравномерно. } + if AT.Fit = fmStretch then + Exit; + + KFit := Min(ADstWidth / ASrcWidth, ADstHeight / ASrcHeight); + KFill := Max(ADstWidth / ASrcWidth, ADstHeight / ASrcHeight); + if AT.Fit = fmFill then + K := KFill + else + K := KFit; + if AT.Zoom > 0 then + K := K * AT.Zoom; + if K <= 0 then + Exit; + + { Кадр, растянутый до рабочего масштаба, и та его часть, что помещается + в кадр проекта. Смещение задаётся в долях кадра проекта и прижимается + к краям: выйти за пределы картинки нельзя. } + SW := ASrcWidth * K; + SH := ASrcHeight * K; + CW := Min(SW, ADstWidth); + CH := Min(SH, ADstHeight); + CX := (SW - CW) / 2 + AT.OffsetX * ADstWidth; + CY := (SH - CH) / 2 + AT.OffsetY * ADstHeight; + CX := Max(0, Min(SW - CW, CX)); + CY := Max(0, Min(SH - CH, CY)); + + ARect := Rect(Round(CX / K), Round(CY / K), + Round((CX + CW) / K), Round((CY + CH) / K)); + Result := True; +end; + +function TransformFitsOutputCrop(const AT: TMediaTransform): Boolean; +begin + Result := (not AT.FlipH) and (not AT.FlipV) and (AT.Fit <> fmStretch); +end; + { Дробное число через точку: у ffmpeg разделитель всегда точка, а в русской локали Format вставил бы запятую и развалил бы всю цепочку. } function FilterNum(const AValue: Double): string; diff --git a/tests/buttonclicks.sh b/tests/buttonclicks.sh new file mode 100755 index 0000000..54ac5e1 --- /dev/null +++ b/tests/buttonclicks.sh @@ -0,0 +1,56 @@ +#!/bin/sh +# Проверка того, что каждый быстрый щелчок по кнопке нижней полосы +# доходит до неё. +# +# Кнопки там — переключатели: щелчок меняет вид полосы. Значит, N щелчков +# подряд должны дать N переключений, и снимки с одинаковой чётностью +# числа щелчков обязаны совпасть, с разной — разойтись. Раньше второй +# щелчок подряд приходил как двойной и пропадал. +# +# Запуск (редактор уже должен идти на невидимом экране :99): +# tests/buttonclicks.sh <окно> +# где окно — из `DISPLAY=:99 xdotool search --name nlve`, а x и y — +# точка внутри кнопки. +set -e +cd "$(dirname "$0")/.." +WIN=$1 +X=$2 +Y=$3 +DISP=${DISP:-:99} +SHOT=${SHOT:-test/кадры-кнопок} +rm -rf "$SHOT"; mkdir -p "$SHOT" + +# Снимается низ окна: там и полоса сообщений, и сами кнопки. +H=$(DISPLAY=$DISP xwininfo -id "$WIN" | awk '/Height:/ {print $2}') +W=$(DISPLAY=$DISP xwininfo -id "$WIN" | awk '/Width:/ {print $2}') +CROP="${W}x200+0+$((H - 200))" + +# Мышь уводится с кнопки перед снимком: под курсором подсказка идёт в +# строку состояния, и её текст сам по себе отличал бы снимки. +snap() { + DISPLAY=$DISP xdotool mousemove $((W / 2)) $((H / 3)) + sleep 0.4 + DISPLAY=$DISP import -window "$WIN" -crop "$CROP" +repage "$SHOT/$1.png" +} +same() { compare -metric AE "$SHOT/$1.png" "$SHOT/$2.png" null: 2>&1 | cut -d' ' -f1; } + +snap base +TOTAL=0 +for N in 1 2 3 4 5; do + I=0 + while [ $I -lt $N ]; do + DISPLAY=$DISP xdotool mousemove "$X" "$Y" click 1 + I=$((I + 1)) + sleep 0.12 + done + TOTAL=$((TOTAL + N)) + sleep 1.2 + snap "после$TOTAL" + echo "залпом $N, всего щелчков $TOTAL: отличий от исходной $(same base "после$TOTAL")" +done + +# Полоса сообщений прирастает строками сама по себе, поэтому сверяемся не +# с исходной картинкой, а снимками между собой. +echo " 3 и 15 щелчков (оба нечётные, должны совпасть): $(same после3 после15)" +echo " 6 и 10 щелчков (оба чётные, должны совпасть): $(same после6 после10)" +echo " 6 и 15 щелчков (чётное и нечётное, должны разойтись): $(same после6 после15)" diff --git a/tests/clicktimes.py b/tests/clicktimes.py new file mode 100644 index 0000000..baa5f5c --- /dev/null +++ b/tests/clicktimes.py @@ -0,0 +1,27 @@ +#!/usr/bin/env python3 +"""Времена щелчков в звуковой дорожке — по самим отсчётам. + +Читает сырой звук (16 бит, моно, 48000) со стандартного ввода и печатает +время начала каждого громкого куска. Отсчёты, а не окна анализа: любой +оконный способ уплывает по времени, потому что окно двигается кратно +своему размеру, а не секунде, и на замере синхронности это выглядит как +накапливающийся рассинхрон, которого нет. +""" +import sys +import struct + +RATE = 48000 +THRESHOLD = 3000 # из 32767: щелчок заметно громче тишины +GAP = int(RATE * 0.5) # полсекунды тишины разделяет соседние щелчки + +data = sys.stdin.buffer.read() +count = len(data) // 2 +samples = struct.unpack('<%dh' % count, data[:count * 2]) + +last_loud = -GAP * 2 +for i, value in enumerate(samples): + if abs(value) < THRESHOLD: + continue + if i - last_loud > GAP: + print('%.6f' % (i / RATE)) + last_loud = i diff --git a/tests/fadegrab.sh b/tests/fadegrab.sh new file mode 100755 index 0000000..e83a073 --- /dev/null +++ b/tests/fadegrab.sh @@ -0,0 +1,67 @@ +#!/bin/sh +# Повторный захват рампы затухания. +# +# Первый раз ручка стоит в правом верхнем углу клипа — целиться есть куда. +# Второй раз она висит посреди клипа сама по себе, и целятся в неё на +# глаз: чуть ниже и чуть в стороне от середины. Оба захвата обязаны +# сработать. +# Запуск (редактор должен собираться в этом дереве, экран :99 поднят): +# tests/fadegrab.sh [<путь к nlve>] +BIN=${1:-$PWD/nlve} +cd "$(dirname "$0")/.." +BIN=${1:-$PWD/nlve} +PROJ=$PWD/test/поток/рампа.nlve +# Монтаж для проверки: два клипа без затуханий. В репозиторий не входит — +# ссылается на съёмку, которой здесь нет. +[ -f test/поток/пара.nlve ] || { echo "нет монтажа test/поток/пара.nlve"; exit 2; } +cp test/поток/пара.nlve "$PROJ" +for p in $(pgrep -x nlve); do + tr '\0' '\n' < /proc/$p/environ 2>/dev/null | grep -qx "DISPLAY=:99" && kill $p +done +sleep 1 +rm -rf test/поток/профиль-рампа; mkdir -p test/поток/профиль-рампа +rm -f test/поток/*.autosave +SP=$PWD/test/поток/профиль-рампа +XDG_CONFIG_HOME=$SP XDG_CACHE_HOME=$SP XDG_DATA_HOME=$SP DISPLAY=:99 \ + setsid "$BIN" "$PROJ" >/dev/null 2>&1 < /dev/null & +sleep 14 +X="timeout 8 env DISPLAY=:99 xdotool" +$X windowmove 2097206 0 0 windowsize 2097206 1500 860 2>/dev/null +sleep 2 + +fade() { + $X key ctrl+s + sleep 2 + python3 -c " +import json +d=json.load(open('$PROJ')) +for t in d['tracks']: + for c in t['clips']: + if c['kind']=='video' and c['tl_start']<0.001: + print('%.3f' % c.get('fade_out',0)); raise SystemExit +print('нет клипа') +" +} + +echo " затухание до правок: $(fade) с" +$X mousemove 783 490 mousedown 1; sleep 0.3 +$X mousemove 745 490; sleep 0.2; $X mousemove 720 490; sleep 0.2 +$X mouseup 1; sleep 1.5 +A=$(fade) +echo " после первого захвата (ручка в углу): $A с" + +$X mousemove 724 495 mousedown 1; sleep 0.3 +$X mousemove 700 495; sleep 0.2; $X mousemove 680 495; sleep 0.2 +$X mouseup 1; sleep 1.5 +B=$(fade) +echo " после второго захвата (ручка посреди клипа, мимо центра): $B с" + +python3 -c " +a, b = $A, $B +if a <= 0.01: + print(' ПЛОХО: не сработал даже первый захват') +elif b <= a + 0.01: + print(' ПЛОХО: второй захват не сработал') +else: + print(' ok: обе протяжки сработали') +" diff --git a/tests/genrestart.sh b/tests/genrestart.sh new file mode 100755 index 0000000..77f18a8 --- /dev/null +++ b/tests/genrestart.sh @@ -0,0 +1,130 @@ +#!/bin/sh +# Сборка сведённого куска не должна начинаться заново от каждой правки. +# +# Затухание, наплыв, прозрачность — всё это предпросмотр не умеет играть +# как есть: такой кусок заранее сводится в отдельный файл. На затухании в +# семьдесят секунд файл считается около полутора минут, и всё это время +# человек продолжает работать. +# +# Проверяется два обратных случая: +# 1. Режем монтаж в стороне от затухания. Сам кусок от этого не +# меняется — значит сборка обязана продолжаться, а не начинаться +# заново. +# 2. Удаляем всё. Кусок стал не нужен — сборка обязана прекратиться. +# +# Раньше первый случай отменял работу: «нужен ли ещё этот кусок» +# спрашивалось по списку недостающего, а у куска, который делается прямо +# сейчас, файл уже есть — ffmpeg создаёт его сразу. Кусок в список не +# попадал, работа отменялась в разгаре и начиналась с нуля. +# +# Запуск: tests/genrestart.sh [<путь к nlve>] +# Проект берётся из test/поток/длинный-фейд.nlve (см. README, раздел +# проверок): один клип с затуханием в семьдесят секунд. +set -e +cd "$(dirname "$0")/.." +BIN=${1:-$PWD/nlve} +DISP=${NLVE_DISPLAY:-:99} +# Проект для проверки в репозиторий не входит: он ссылается на съёмку, +# которой в нём нет. Годится любой с одним клипом и долгим затуханием — +# путь можно задать переменной. +PROJ=${NLVE_FADE_PROJECT:-$PWD/test/поток/длинный-фейд.nlve} +LOG=$(dirname "$BIN")/nlve.log + +[ -f "$PROJ" ] || { echo "нет проекта для проверки: $PROJ"; exit 2; } + +start() { + pkill -x nlve 2>/dev/null || true + # Закрытая программа не уносит с собой свой ffmpeg: дочерний процесс + # остаётся и продолжает писать в кэш. Убираем только его — по пути + # этого самого проекта, чтобы не задеть чужую работу. + pkill -f "длинный-фейд.nlve-cache" 2>/dev/null || true + sleep 1 + rm -rf "$PWD/test/поток/длинный-фейд.nlve-cache" "$PWD/test/поток/профиль-$1" + rm -f "$PROJ.autosave" + SP=$PWD/test/поток/профиль-$1 + mkdir -p "$SP" + : > "$LOG" + XDG_CONFIG_HOME=$SP XDG_CACHE_HOME=$SP XDG_DATA_HOME=$SP DISPLAY=$DISP \ + "$BIN" "$PROJ" >/dev/null 2>&1 & + sleep 16 + WIN=$(DISPLAY=$DISP xdotool search --name "длинный-фейд" | tail -1) + DISPLAY=$DISP xdotool windowmove "$WIN" 0 0 windowsize "$WIN" 1500 860 + sleep 2 +} + +runs() { grep -c filter_complex "$LOG" || true; } +stops() { grep -c 'Расстановка изменилась' "$LOG" || true; } + +BAD=0 + +echo "1. Правки в стороне от затухания" +start правки +echo " сборка началась: запусков $(runs)" +X=650 +I=0 +while [ $I -lt 5 ]; do + DISPLAY=$DISP xdotool mousemove $X 640 click 1 + sleep 0.6 + DISPLAY=$DISP xdotool key s + sleep 3 + X=$((X + 40)) + I=$((I + 1)) +done +sleep 5 +N=$(runs) +S=$(stops) +echo " после пяти резов: запусков $N, отмен $S" +case "$(DISPLAY=$DISP xdotool getwindowname "$WIN")" in + *\*) ;; + *) echo " ПЛОХО: монтаж не изменился, правки не дошли — проверка ничего не значит" + BAD=$((BAD + 1)) ;; +esac +if [ "$N" = "1" ] && [ "$S" = "0" ]; then + echo " ok: работа не сбрасывалась" +else + echo " ПЛОХО: сборка начиналась заново" + BAD=$((BAD + 1)) +fi + +echo +echo "2. Кусок стал не нужен" +start отмена +echo " сборка началась: запусков $(runs)" +DISPLAY=$DISP xdotool mousemove 700 600 click 1 +sleep 0.5 +DISPLAY=$DISP xdotool key ctrl+a +sleep 0.8 +DISPLAY=$DISP xdotool key Delete + +# Ждём, пока работа прекратится, а не спим наугад: ffmpeg получает сигнал +# и ещё дописывает то, что у него в руках. Именно -x у pgrep: иначе под +# раздачу попадёт и сама эта оболочка, у которой слово ffmpeg есть в +# командной строке. +ALIVE=1 +WAITED=0 +while [ "$WAITED" -lt 30 ]; do + sleep 1 + WAITED=$((WAITED + 1)) + ALIVE=$(pgrep -a -x ffmpeg | grep -c "длинный-фейд.nlve-cache" || true) + [ "$ALIVE" = "0" ] && break +done +S=$(stops) +echo " отмен $S, живых ffmpeg $ALIVE, ждали $WAITED с" +if [ "$S" -ge 1 ] && [ "$ALIVE" = "0" ]; then + echo " ok: ненужная работа прекращена" +else + echo " ПЛОХО: работа продолжается впустую" + BAD=$((BAD + 1)) +fi + +pkill -x nlve 2>/dev/null || true +pkill -f "длинный-фейд.nlve-cache" 2>/dev/null || true +rm -f "$PROJ.autosave" + +echo +if [ "$BAD" = "0" ]; then + echo "ВЕРДИКТ: сборка вставок не сбрасывается зря и не идёт впустую" +else + echo "ВЕРДИКТ: не пройдено случаев: $BAD" + exit 1 +fi diff --git a/tests/lfmcheck/lfmcheck.lpr b/tests/lfmcheck/lfmcheck.lpr index 28290d6..17d85b2 100644 --- a/tests/lfmcheck/lfmcheck.lpr +++ b/tests/lfmcheck/lfmcheck.lpr @@ -14,7 +14,8 @@ program lfmcheck; uses { Interfaces нужен, чтобы связалась вся LCL и заработала загрузка файлов форм. } - Interfaces, Forms, Classes, SysUtils, Math, TypInfo, uTheme, + Interfaces, Forms, Controls, Classes, SysUtils, Math, TypInfo, uTheme, + uFfmpegCmd, uAppTypes, uMediaProbe, uProject, uTransform, uTimelineCtrl, uPanCropForm, uDepsForm, uMismatchForm, uProgressForm, uProjectInfoForm, uRemuxForm; @@ -209,7 +210,7 @@ begin Timeline.Project := Proj; Timeline.PixelsPerSecond := 100; Timeline.Playhead := 4; - Timeline.SplitAtPlayhead(False, False); + Timeline.SplitAtPlayhead(False); CheckTrue('клипов стало два', Proj.Tracks[0].Count = 2); if Proj.Tracks[0].Count <> 2 then @@ -374,6 +375,592 @@ begin end; end; +{ Общая заготовка: проект с одним файлом и заданной сеткой кадров. } +function TestInfo: TMediaInfo; +begin + Result := Default(TMediaInfo); + Result.Valid := True; + Result.Kind := mkVideo; + Result.Duration := 600; + Result.HasVideo := True; + Result.VideoCodec := 'hevc'; + Result.Width := 1920; + Result.Height := 1080; + Result.FpsNum := 30; + Result.FpsDen := 1; + Result.PixFmt := 'yuv420p'; +end; + +{ Выделение областью. + + Проверяется расчётом, а не мышью: сама протяжка проверена на невидимом + экране, а вот что попадает в рамку — числами, иначе первая же правка + захвата пройдёт незамеченной. } +procedure CheckRubberBand; +var + Proj: TProject; + Info: TMediaInfo; + Media: TMediaItem; + Timeline: TTimelineControl; +begin + WriteLn; + WriteLn('Выделение областью'); + WriteLn; + + Info := TestInfo; + Proj := TProject.Create; + Timeline := TTimelineControl.Create(nil); + try + Proj.Clear; + Proj.AddTrack('V1'); + Proj.AddTrack('V2'); + Proj.AddTrack('V3'); + Media := Proj.AddMedia('/несуществующий/видео.mp4', Info); + Proj.Master := Info; + { V1: клип 0..5 и клип 20..25. V2: длинный клип 0..30. + V3: клип 0..5 — дорожка вне рамки. } + Proj.AddClip(Proj.Tracks[0], Media, 0, 5, 0); + Proj.AddClip(Proj.Tracks[0], Media, 100, 5, 20); + Proj.AddClip(Proj.Tracks[1], Media, 0, 30, 0); + Proj.AddClip(Proj.Tracks[2], Media, 0, 5, 0); + + Timeline.Project := Proj; + Timeline.PixelsPerSecond := 100; + + { Рамка по дорожкам 0 и 1, время 2..10. } + Timeline.SelectInRange(2, 10, 0, 1, False); + CheckTrue('задетый клип выделен', Proj.Tracks[0][0].Selected); + CheckTrue('клип за рамкой не выделен', not Proj.Tracks[0][1].Selected); + CheckTrue('длинный клип задет и выделен', Proj.Tracks[1][0].Selected); + CheckTrue('чужая дорожка не тронута', not Proj.Tracks[2][0].Selected); + + { Рамку тянут и справа налево — это та же рамка. } + Timeline.SelectInRange(25, 18, 0, 0, False); + CheckTrue('обратная протяжка выделила второй клип', + Proj.Tracks[0][1].Selected); + CheckTrue('прежнее выделение снято', not Proj.Tracks[0][0].Selected); + + { С Ctrl прежнее выделение остаётся. } + Timeline.SelectInRange(2, 4, 0, 0, True); + CheckTrue('добавление сохранило прежнее', Proj.Tracks[0][1].Selected); + CheckTrue('добавление выделило новое', Proj.Tracks[0][0].Selected); + + { Рамка, не задевшая ничего, просто снимает выделение. } + Timeline.SelectInRange(6, 8, 0, 0, False); + CheckTrue('пустая рамка ничего не выделила', + Proj.SelectedCount = 0); + finally + Timeline.Free; + Proj.Free; + end; +end; + +{ Рез по курсору режет все дорожки. + + Раньше резалась только дорожка под указателем мыши, и стоило указателю + оказаться над пустым местом, как клавиша S молча не делала ничего. } +procedure CheckSplitAllTracks; +var + Proj: TProject; + Info: TMediaInfo; + Media: TMediaItem; + Timeline: TTimelineControl; +begin + WriteLn; + WriteLn('Рез по курсору на всех дорожках'); + WriteLn; + + Info := TestInfo; + Proj := TProject.Create; + Timeline := TTimelineControl.Create(nil); + try + Proj.Clear; + Proj.AddTrack('V1'); + Proj.AddTrack('V2'); + Proj.AddTrack('A1'); + Media := Proj.AddMedia('/несуществующий/видео.mp4', Info); + Proj.Master := Info; + { Клипы 0..10 на первой и третьей дорожках, на второй — 20..30: + под курсором её нет, и резать там нечего. } + Proj.AddClip(Proj.Tracks[0], Media, 0, 10, 0); + Proj.AddClip(Proj.Tracks[1], Media, 0, 10, 20); + Proj.AddClip(Proj.Tracks[2], Media, 0, 10, 0); + + Timeline.Project := Proj; + Timeline.PixelsPerSecond := 100; + Timeline.ActiveTrack := 1; + Timeline.Playhead := 4; + + CheckTrue('разрезаны обе задетые дорожки', + Timeline.SplitAtPlayhead(False) = 2); + CheckTrue('на первой дорожке два клипа', Proj.Tracks[0].Count = 2); + CheckTrue('на звуковой дорожке два клипа', Proj.Tracks[2].Count = 2); + CheckTrue('нетронутая дорожка осталась с одним клипом', + Proj.Tracks[1].Count = 1); + + { Курсор ровно на стыке — резать нечего, и клипов нулевой длины + появиться не должно. } + CheckTrue('на стыке рез отвечает нулём', + Timeline.SplitAtPlayhead(False) = 0); + CheckTrue('лишних клипов не появилось', + (Proj.Tracks[0].Count = 2) and (Proj.Tracks[2].Count = 2)); + finally + Timeline.Free; + Proj.Free; + end; +end; + +{ Схлопывание дыры не требует попадать в тайминг. + + Курсор может стоять не точно на краю дыры: во время воспроизведения он + останавливается там, где успел, а после перезагрузки предпросмотра — + где оказался плеер. Раньше дыра при этом не находилась. } +procedure CheckGapTolerance; +var + Proj: TProject; + Info: TMediaInfo; + Media: TMediaItem; + Timeline: TTimelineControl; +begin + WriteLn; + WriteLn('Схлопывание дыры с допуском'); + WriteLn; + + Info := TestInfo; + Proj := TProject.Create; + Timeline := TTimelineControl.Create(nil); + try + Proj.Clear; + Proj.AddTrack('V1'); + Proj.AddTrack('A1'); + Media := Proj.AddMedia('/несуществующий/видео.mp4', Info); + Proj.Master := Info; + { Дыра на картинке с 5 по 12. У звука дыры нет вовсе. } + Proj.AddClip(Proj.Tracks[0], Media, 0, 5, 0); + Proj.AddClip(Proj.Tracks[0], Media, 20, 5, 12); + Proj.AddClip(Proj.Tracks[1], Media, 0, 17, 0); + + Timeline.Project := Proj; + Timeline.PixelsPerSecond := 100; + { Указатель и выбранная дорожка — звуковая, дыры на ней нет. } + Timeline.ActiveTrack := 1; + { Курсор не в дыре, а на четыре сотых раньше её начала. } + Timeline.Playhead := 4.96; + + CheckTrue('дыра найдена, хотя курсор чуть раньше края', + Timeline.RippleCloseGap); + CheckTrue('названа дорожка, где схлопнули', + Timeline.LastGapTrack = 'V1'); + CheckTrue('клип придвинут вплотную', + Abs(Proj.Tracks[0][1].TlStart - 5) < 0.001); + + { Курсор далеко от дыры — ничего не двигаем. } + Proj.Tracks[0][1].TlStart := 12; + Timeline.Playhead := 2; + CheckTrue('далеко от дыры — не схлопываем', + not Timeline.RippleCloseGap); + finally + Timeline.Free; + Proj.Free; + end; +end; + +{ Починка проекта: клипы на кадровую сетку. + + Между кадрами времени нет, и монтаж не должен хранить доли кадра: + картинка выйдет целым числом кадров, звук наберётся до отсчёта, и + округление разведёт их. Правка двигает клип не больше чем на полкадра, + но сама сетка обязана получиться ровной. } +procedure CheckFrameGridRepair; +var + Proj: TProject; + Info: TMediaInfo; + Media: TMediaItem; + Step: Double; + I: Integer; + Clip: TClip; + OnGrid: Boolean; +begin + WriteLn; + WriteLn('Починка: клипы на кадровую сетку'); + WriteLn; + + Info := TestInfo; + { 59.94 к/с — та самая сетка, на которой доли кадра особенно заметны. } + Info.FpsNum := 60000; + Info.FpsDen := 1001; + + Proj := TProject.Create; + try + Proj.Clear; + Proj.AddTrack('V1'); + Media := Proj.AddMedia('/несуществующий/видео.mp4', Info); + Proj.Master := Info; + Step := Info.FpsDen / Info.FpsNum; + + { Времена как в настоящем проекте: ни одно не попадает на кадр. } + Proj.AddClip(Proj.Tracks[0], Media, 48.558521, 2.457599, 0); + Proj.AddClip(Proj.Tracks[0], Media, 56.054198, 1.469934, 2.457599); + { И клип короче кадра: его нельзя схлопнуть в ничто. } + Proj.AddClip(Proj.Tracks[0], Media, 62.710196, 0.004, 3.927533); + + CheckTrue('все три клипа мимо сетки', Proj.OffGridClipCount = 3); + CheckTrue('починка подвинула три клипа', Proj.SnapClipsToFrameGrid = 3); + CheckTrue('мимо сетки не осталось', Proj.OffGridClipCount = 0); + + OnGrid := True; + for I := 0 to Proj.Tracks[0].Count - 1 do + begin + Clip := Proj.Tracks[0][I]; + if Abs(Clip.TlStart / Step - Round(Clip.TlStart / Step)) > 0.001 then + OnGrid := False; + if Abs(Clip.Duration / Step - Round(Clip.Duration / Step)) > 0.001 then + OnGrid := False; + if Abs(Clip.SrcIn / Step - Round(Clip.SrcIn / Step)) > 0.001 then + OnGrid := False; + end; + CheckTrue('начала, длины и точки входа — целые кадры', OnGrid); + + CheckTrue('короткий клип остался длиной в кадр', + Abs(Proj.Tracks[0][2].Duration - Step) < 0.0001); + CheckTrue('клипы не разъехались больше чем на полкадра', + Abs(Proj.Tracks[0][0].TlStart - 0) < Step); + CheckTrue('повторная починка ничего не двигает', + Proj.SnapClipsToFrameGrid = 0); + finally + Proj.Free; + end; +end; + +{ Рез и курсор: где режет S и куда после этого встаёт курсор. + + Раньше курсор оставался там, где был, а рез мог попасть на долю кадра. + Теперь рез кладётся на кадровую сетку, а курсор встаёт ровно на место + реза — с ним и работают дальше. } +procedure CheckSplitAndPlayhead; +var + Proj: TProject; + Info: TMediaInfo; + Media: TMediaItem; + Timeline: TTimelineControl; + Step: Double; + I, N: Integer; +begin + WriteLn; + WriteLn('Рез, промежуток и курсор'); + WriteLn; + + Info := TestInfo; + Info.FpsNum := 60000; + Info.FpsDen := 1001; + Step := Info.FpsDen / Info.FpsNum; + + Proj := TProject.Create; + Timeline := TTimelineControl.Create(nil); + try + Proj.Clear; + Proj.AddTrack('V1'); + Proj.AddTrack('A1'); + Media := Proj.AddMedia('/несуществующий/видео.mp4', Info); + Proj.Master := Info; + { По два клипа на каждой дорожке, встык: 0..10 и 10..20. } + Proj.AddClip(Proj.Tracks[0], Media, 0, 10, 0); + Proj.AddClip(Proj.Tracks[0], Media, 20, 10, 10); + Proj.AddClip(Proj.Tracks[1], Media, 0, 10, 0); + Proj.AddClip(Proj.Tracks[1], Media, 20, 10, 10); + + Timeline.Project := Proj; + Timeline.PixelsPerSecond := 100; + + { Рез по курсору: место кладётся на кадр, курсор встаёт на него. } + Timeline.Playhead := 3.3177; + CheckTrue('разрезаны обе дорожки', Timeline.SplitAtPlayhead(False) = 2); + CheckTrue('курсор встал на место реза', + Abs(Timeline.Playhead - Round(3.3177 / Step) * Step) < 0.0001); + CheckTrue('курсор на кадровой сетке', + Abs(Timeline.Playhead / Step - Round(Timeline.Playhead / Step)) < 0.001); + N := 0; + for I := 0 to Proj.Tracks[0].Count - 1 do + if Abs(Proj.Tracks[0][I].TlStart - Timeline.Playhead) < 0.0001 then + Inc(N); + CheckTrue('рез пришёлся ровно туда, где курсор', N = 1); + + { Промежуток по времени: рез по обоим краям, курсор — на начало. } + Timeline.SelectionMode := smRange; + Timeline.SetSelectionRange(12.13, 16.77); + CheckTrue('промежуток отмечен', Timeline.HasSelectionRange); + CheckTrue('разрезано по два клипа на дорожке', + Timeline.SplitAtPlayhead(False) = 4); + CheckTrue('курсор — на начале промежутка', + Abs(Timeline.Playhead - Timeline.RangeFrom) < 0.0001); + + N := 0; + for I := 0 to Proj.Tracks[1].Count - 1 do + if (Abs(Proj.Tracks[1][I].TlStart - Timeline.RangeFrom) < 0.0001) or + (Abs(Proj.Tracks[1][I].TlStart - Timeline.RangeTo) < 0.0001) then + Inc(N); + CheckTrue('на звуковой дорожке резы по обоим краям', N = 2); + + { После реза выделена середина — то, что между краями: следующим + действием её обычно удаляют. } + N := 0; + for I := 0 to Proj.Tracks[0].Count - 1 do + if Proj.Tracks[0][I].Selected then + begin + Inc(N); + CheckTrue('выделенное лежит внутри промежутка', + (Proj.Tracks[0][I].TlStart >= Timeline.RangeFrom - 0.0001) and + (Proj.Tracks[0][I].TlEnd <= Timeline.RangeTo + 0.0001)); + end; + CheckTrue('на дорожке картинки выделена одна середина', N = 1); + + { Смена режима снимает промежуток: резать по невидимой метке нельзя. } + Timeline.SelectionMode := smClips; + CheckTrue('смена режима сняла промежуток', + not Timeline.HasSelectionRange); + + { Удаление со схлопыванием: курсор встаёт на место стыка. } + Proj.Clear; + Proj.AddTrack('V1'); + Media := Proj.AddMedia('/несуществующий/видео.mp4', Info); + Proj.Master := Info; + Proj.RippleEnabled := True; + Proj.AddClip(Proj.Tracks[0], Media, 0, 5, 0); + Proj.AddClip(Proj.Tracks[0], Media, 10, 5, 5); + Proj.AddClip(Proj.Tracks[0], Media, 20, 5, 10); + Timeline.Playhead := 0; + Proj.Tracks[0][1].Selected := True; + Timeline.DeleteSelected; + CheckTrue('после удаления клипов стало два', Proj.Tracks[0].Count = 2); + CheckTrue('курсор — на месте вырезанного куска', + Abs(Timeline.Playhead - 5) < 0.0001); + CheckTrue('хвост придвинут к стыку', + Abs(Proj.Tracks[0][1].TlStart - 5) < 0.0001); + + { Схлопывание дыры с клавиатуры: курсор тоже на стык. } + Proj.Clear; + Proj.AddTrack('V1'); + Media := Proj.AddMedia('/несуществующий/видео.mp4', Info); + Proj.Master := Info; + Proj.AddClip(Proj.Tracks[0], Media, 0, 5, 0); + Proj.AddClip(Proj.Tracks[0], Media, 20, 5, 12); + Timeline.ActiveTrack := 0; + Timeline.Playhead := 8; + CheckTrue('дыра схлопнута', Timeline.RippleCloseGap); + CheckTrue('курсор — на стыке', Abs(Timeline.Playhead - 5) < 0.0001); + finally + Timeline.Free; + Proj.Free; + end; +end; + +{ Кнопка нижней панели и быстрые щелчки. + + Второй щелчок подряд оконная библиотека отдаёт не как щелчок, а как + двойной — и обработчик кнопки его не видел. Человек нажимал кнопку + дважды, а срабатывало один раз. + + Проверяется двумя способами: у кнопки нет csDoubleClicks (тогда + двойных щелчков к ней вообще не приходит), и даже если двойной + придёт, он считается за щелчок. } +type + TButtonProbe = class(TThemedButton) + public + procedure Twice; + end; + +procedure TButtonProbe.Twice; +begin + DblClick; +end; + +var + ClickCount: Integer = 0; + +type + TClickCounter = class + procedure Clicked(Sender: TObject); + end; + +procedure TClickCounter.Clicked(Sender: TObject); +begin + Inc(ClickCount); +end; + +{ Рамка источника и фильтр сборки должны говорить об одном. + + Одна и та же настройка записана двумя способами: сборка растягивает + кадр и вырезает из него кусок, а окно кадрирования и предпросмотр + говорят, какая часть исходника видна. Разойдутся — окно начнёт обещать + не то, что покажет плеер, а плеер не то, что даст сборка. } +procedure CheckSourceRect; +var + T: TMediaTransform; + R: TRect; + Chain: string; +begin + WriteLn; + WriteLn('Рамка источника и фильтр сборки'); + WriteLn; + + T := DefaultTransform; + T.Zoom := 2.77; + + CheckTrue('увеличение описывается рамкой', + TransformSourceRect(T, 2688, 1512, 2688, 1512, R)); + { Растянули в 2.77 раза — значит видна 1/2.77 часть кадра, посередине. } + CheckTrue('ширина рамки: ' + IntToStr(R.Right - R.Left), + Abs((R.Right - R.Left) - Round(2688 / 2.77)) <= 2); + CheckTrue('высота рамки: ' + IntToStr(R.Bottom - R.Top), + Abs((R.Bottom - R.Top) - Round(1512 / 2.77)) <= 2); + CheckTrue('рамка посередине по горизонтали', + Abs((R.Left + R.Right) - 2688) <= 3); + CheckTrue('рамка посередине по вертикали', + Abs((R.Top + R.Bottom) - 1512) <= 3); + + { Тот же расчёт с другой стороны: сборка растягивает до 7446x4188 и + вырезает 2688x1512 с отступом 2379:1338. Делим отступ на масштаб — + обязано выйти начало рамки. } + Chain := TransformFilter(T, 2688, 1512, 2688, 1512); + CheckTrue('сборка растягивает и вырезает: ' + Chain, + (Pos('scale=7446:4188', Chain) > 0) and + (Pos('crop=2688:1512:2379:1338', Chain) > 0)); + CheckTrue('начало рамки совпадает с отступом обрезки', + Abs(R.Left - Round(2379 / 2.77)) <= 2); + + { Растяжение рамкой не описывается: там кадр жмётся неравномерно. } + T := DefaultTransform; + T.Fit := fmStretch; + CheckTrue('растяжение рамкой не описывается', + not TransformSourceRect(T, 2688, 1512, 1920, 1080, R)); + + { Отражение обрезкой на выводе не показать — свойства для него нет. } + T := DefaultTransform; + T.FlipH := True; + CheckTrue('отражение обрезкой на выводе не показывается', + not TransformFitsOutputCrop(T)); + T := DefaultTransform; + T.Rotation := 90; + CheckTrue('поворот показать можно: у него своё свойство', + TransformFitsOutputCrop(T)); +end; + +{ Сведение слоёв просит распаковку у видеокарты. + + На длинном затухании это разница между тремя минутами и одной, а + ключ входной: ffmpeg принимает его только перед тем входом, к которому + он относится. Забыть его легко и незаметно — команда останется рабочей, + просто медленной. } +{ Разбор строк о ходе работы ffmpeg. + + Ход приходит блоками, и последняя строка блока — «progress=continue». + Места в ней нет: она сообщает только, что работа продолжается. Разбор + обязан оставить переданное число как было, а вызывающий — передавать + туда уже известное место, а не ноль. Иначе каждый блок заканчивается + обнулением доли, и показатель стоит на месте, дёргаясь вверх лишь + тогда, когда опрос попадёт между строкой со временем и этой. } +procedure CheckProgressParsing; +var + Seconds: Double; + AtEnd: Boolean; +begin + WriteLn; + WriteLn('Разбор хода работы ffmpeg'); + WriteLn; + + Seconds := 0; + AtEnd := False; + CheckTrue('время узнаётся', ParseProgressLine('out_time_us=2500000', + Seconds, AtEnd)); + CheckTrue('и разбирается верно: ' + FloatToStrF(Seconds, ffFixed, 8, 3), + Abs(Seconds - 2.5) < 0.001); + + CheckTrue('«продолжается» — тоже знакомая строка', + ParseProgressLine('progress=continue', Seconds, AtEnd)); + CheckTrue('и она не трогает время: ' + FloatToStrF(Seconds, ffFixed, 8, 3), + Abs(Seconds - 2.5) < 0.001); + CheckTrue('и не объявляет конец', not AtEnd); + + CheckTrue('конец узнаётся', ParseProgressLine('progress=end', + Seconds, AtEnd) and AtEnd); + CheckTrue('время и тут осталось прежним', + Abs(Seconds - 2.5) < 0.001); + + CheckTrue('незнакомая строка не узнаётся', + not ParseProgressLine('bitrate= 12.3kbits/s', Seconds, AtEnd)); +end; + +procedure CheckLayerHwDecode; +var + Layers: array[0..0] of TSegmentLayer; + A: TArgs; + I, Hw, Input: Integer; +begin + WriteLn; + WriteLn('Распаковка слоёв видеокартой'); + WriteLn; + + Layers[0] := Default(TSegmentLayer); + Layers[0].FilePath := '/несуществующий/видео.mp4'; + Layers[0].SrcStart := 10; + Layers[0].FadeFrom := 1; + Layers[0].FadeTo := 0; + + A := ArgsRenderLayers(Layers, '/выход.mkv', 70, 2688, 1512, 60000, 1001, + 'yuv420p', 'hevc', False, 0, '', NotPiped, False); + Hw := -1; + for I := 0 to High(A) do + if A[I] = '-hwaccel' then + Hw := I; + CheckTrue('без просьбы ключа нет', Hw < 0); + + A := ArgsRenderLayers(Layers, '/выход.mkv', 70, 2688, 1512, 60000, 1001, + 'yuv420p', 'hevc', False, 0, '', NotPiped, True); + Hw := -1; + Input := -1; + for I := 0 to High(A) do + begin + if A[I] = '-hwaccel' then + Hw := I; + if (A[I] = '-i') and (Input < 0) then + Input := I; + end; + + { Просьба выполняется только там, где кодировать будет та же карта. На + машине без неё проверять нечего, и это не поломка. } + if Pos('nvenc', PreferredEncoder('hevc')) = 0 then + WriteLn(' -- видеокарты для кодирования нет, проверять нечего') + else + begin + CheckTrue('по просьбе ключ появляется', Hw >= 0); + CheckTrue('и стоит перед входом, а не после', (Hw >= 0) and (Hw < Input)); + end; +end; + +procedure CheckButtonClicks; +var + Btn: TButtonProbe; + Counter: TClickCounter; +begin + WriteLn; + WriteLn('Кнопки нижней панели'); + WriteLn; + + Counter := TClickCounter.Create; + Btn := TButtonProbe.Create(nil); + try + Btn.OnClick := @Counter.Clicked; + CheckTrue('двойные щелчки кнопке не приходят', + not (csDoubleClicks in Btn.ControlStyle)); + ClickCount := 0; + Btn.Twice; + CheckTrue('двойной щелчок считается за щелчок', ClickCount = 1); + finally + Btn.Free; + Counter.Free; + end; +end; + begin WriteLn('Свойства из файлов форм'); WriteLn; @@ -404,6 +991,15 @@ begin CheckSplitKeepsSettings; CheckRippleWithoutMouse; CheckClipCopy; + CheckRubberBand; + CheckFrameGridRepair; + CheckSplitAndPlayhead; + CheckSplitAllTracks; + CheckGapTolerance; + CheckSourceRect; + CheckProgressParsing; + CheckLayerHwDecode; + CheckButtonClicks; WriteLn; if Failed = 0 then diff --git a/tests/nlvetool.lpr b/tests/nlvetool.lpr index 5453504..9f586e9 100644 --- a/tests/nlvetool.lpr +++ b/tests/nlvetool.lpr @@ -20,9 +20,13 @@ build <проект.nlve> <видео> [<картинка>] собрать проект-образец: видео внизу, картинка сверху посередине, дыра в начале - render <проект.nlve> <выход> + render <проект.nlve> <выход> [burn|keep|resume|cache] + [--cancel-after=<сек>] уплотить проект, создать вставки, собрать ролик - и сверить число кадров + и сверить число кадров; cache — собрать + по-старому, через кэш кусков; --cancel-after + оборвёт сборку на полпути, а resume продолжит + её с недописанного файла subs <проект.nlve> собрать разметку субтитров из текстовых клипов и напечатать её @@ -285,6 +289,7 @@ var I, FirstArg: Integer; Shift, CancelAfter, Waited: Double; ExitCodeValue: Integer; + WantSum: Int64; Cancelled: Boolean; begin { Необязательный флаг остановки идёт первым, чтобы не мешать разбору @@ -379,6 +384,23 @@ begin WriteLn(' сумма пакетов кусков: ', Rep.ExpectedPackets); WriteLn(' пакетов в готовом файле: ', Rep.ActualPackets); + + { Сверка с монтажом: столько ли кадров, сколько он просил. Звук набран по + монтажу с точностью до отсчёта, поэтому лишний кадр картинки — это и + есть расхождение звука с картинкой. } + WantSum := 0; + for I := 0 to High(Rep.Segments) do + Inc(WantSum, Rep.Segments[I].WantFrames); + if WantSum > 0 then + begin + WriteLn(' картинка: ', Rep.ActualPackets, ' кадров, монтаж просил ', WantSum); + if Rep.ActualPackets = WantSum then + WriteLn(' ЗВУК И КАРТИНКА СХОДЯТСЯ') + else + WriteLn(' ЗВУК И КАРТИНКА РАСХОДЯТСЯ на ', + Rep.ActualPackets - WantSum, ' кадров'); + end; + WriteLn(' результат: ', Rep.Message); ExitCodeValue := 0; @@ -568,6 +590,7 @@ var Key: TColorKey; Tr: TMediaTransform; I, N: Integer; + Step, At, Total: Double; TempFile, Err: string; begin WriteLn('Проверка уплощения монтажа'); @@ -1004,6 +1027,47 @@ begin end; WriteLn; + { --- 16. Границы кусков лежат на кадровой сетке --- } + WriteLn(' 16. Кадровая сетка и точный рез'); + Proj := MakeProject(2, Media); + try + Proj.Master := Media.Info; + Proj.EnsureAudioTracks; + { Времена намеренно «некруглые»: столько кадров не бывает. } + Proj.AddClipPair(Proj.Tracks[0], Media, 3.3177, 4.4413, 0); + Proj.AddClipPair(Proj.Tracks[0], Media, 12.1301, 5.2077, 4.4413); + + FlattenStream(Proj, tkVideo, 0, Segs, Missing); + DumpSegments(Segs); + + Step := Proj.Master.FpsDen / Proj.Master.FpsNum; + At := 0; + for I := 0 to High(Segs) do + begin + Check(Abs(Segs[I].Duration / Step - Round(Segs[I].Duration / Step)) < 0.001, + Format('кусок %d — целое число кадров: %s с', [I, SecondsToStr(Segs[I].Duration)])); + Check(Abs(Segs[I].SrcStart / Step - Round(Segs[I].SrcStart / Step)) < 0.001, + Format('кусок %d — начало на кадре: %s с', [I, SecondsToStr(Segs[I].SrcStart)])); + if Segs[I].Kind = skVideo then + Check(Segs[I].PreciseIn, + Format('кусок %d режется точно', [I])); + At := At + Segs[I].Duration; + end; + + { Звук уплощается той же мерой: границы обязаны совпасть с картинкой, + иначе звук поедет относительно неё. } + FlattenAudioTrack(Proj, Proj.Tracks[2], At, AudioSegs, Missing); + Total := 0; + for I := 0 to High(AudioSegs) do + Total := Total + AudioSegs[I].Duration; + Check(Abs(Total - At) < 0.0005, + Format('звук и картинка одной длины: %s и %s', + [SecondsToStr(Total), SecondsToStr(At)])); + finally + Proj.Free; + end; + WriteLn; + WriteLn; if FailCount = 0 then begin @@ -1014,6 +1078,67 @@ begin Halt(1); end; +{ --- Проект для замера синхронности звука и картинки --- } + +{ Монтаж из кусков, начала которых заведомо не попадают на опорные кадры. + + Зачем отдельная команда: обычный проект-образец берёт два куска, а тут + нужно много резов подряд и в разных местах группы кадров — иначе не + видно, накапливается ли расхождение и зависит ли оно от того, далеко ли + до опорного кадра. } +procedure CmdSyncProj; +var + Proj: TProject; + Info: TMediaInfo; + Video: TMediaItem; + Err: string; + I: Integer; + At, Len, SrcAt: Double; +const + { Начала кусков в исходнике. Опорные кадры в образце стоят через две + секунды, поэтому точки выбраны с разным отступом от них: почти на + опорном кадре, посередине группы, у самого её конца. } + Starts: array[0..5] of Double = (3.3, 7.77, 12.13, 18.95, 25.02, 31.61); + Piece = 4.0; +begin + Proj := TProject.Create; + try + Proj.Clear; + Proj.AddTrack('V1'); + Proj.EnsureAudioTracks; + + if not ProbeMedia(ExpandFileName(ParamStr(3)), Info, Err) then + begin + WriteLn('Не удалось прочитать видео: ', Err); + Halt(1); + end; + Video := Proj.AddMedia(ExpandFileName(ParamStr(3)), Info); + Proj.Master := Info; + WriteLn('видео: ', DescribeMedia(Info)); + + At := 0; + for I := Low(Starts) to High(Starts) do + begin + SrcAt := Starts[I]; + Len := Piece; + Proj.AddClipPair(Proj.Tracks[0], Video, SrcAt, Len, At); + WriteLn(Format(' кусок %d: из %s, длина %s, на монтаже с %s', + [I + 1, SecondsToStr(SrcAt), SecondsToStr(Len), SecondsToStr(At)])); + At := At + Len; + 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 CmdBuild; @@ -1402,8 +1527,35 @@ var Watcher: TExportWatcher; Rep: TExportReport; I: Integer; - Ok: Boolean; + WantSum: Int64; + Ok, Stopped: Boolean; + CancelAfter, Waited: Double; + + { Слова после выхода идут в любом порядке и сочетаются: cache resume — + это «по-старому и продолжая». } + function HasWord(const AWord: string): Boolean; + var + J: Integer; + begin + Result := False; + for J := 4 to ParamCount do + if LowerCase(ParamStr(J)) = AWord then + Exit(True); + end; + begin + { Отдельно от слов может стоять --cancel-after=<сек>: оборвать сборку + на полпути, чтобы было что продолжать. } + CancelAfter := 0; + for I := 4 to ParamCount do + if Copy(ParamStr(I), 1, 15) = '--cancel-after=' then + if not TryStrToFloat(Copy(ParamStr(I), 16, MaxInt), CancelAfter, + InvariantFormat) then + begin + WriteLn('Не удалось разобрать значение --cancel-after'); + Halt(2); + end; + Proj := TProject.Create; try if not Proj.LoadFromFile(ExpandFileName(ParamStr(2)), Err) then @@ -1465,7 +1617,7 @@ begin { Вжигание текста — последним, уже по окончательному списку кусков: повторное уплощение стёрло бы отметки о разметке. Так же устроено и окно сборки. } - if (ParamCount >= 4) and (LowerCase(ParamStr(4)) = 'burn') then + if HasWord('burn') then WriteLn('вжигаю текст, пересобрать придётся ', SecondsToStr(BurnTextIntoSegments(Proj, Segs, Proj.CacheDir)), ' с'); @@ -1474,18 +1626,34 @@ begin чего собрался ролик. } Thread := TExportThread.Create(Segs, AudioSegs, ExpandFileName(ParamStr(3)), - (ParamCount >= 4) and (LowerCase(ParamStr(4)) = 'keep'), + HasWord('keep'), Proj.Master, Default(TEncodeProfile)); { Словом resume просят продолжить прерванную сборку: готовые куски берутся с диска, а не считаются заново. } - Thread.Resume := (ParamCount >= 4) and (LowerCase(ParamStr(4)) = 'resume'); + Thread.Resume := HasWord('resume'); + { Словом cache просят собрать по-старому, через кэш кусков: так два + способа сверяются между собой на одном и том же монтаже. } + Thread.AllowStream := not HasWord('cache'); Watcher := TExportWatcher.Create(Thread); try Thread.OnProgress := @Watcher.Progress; Thread.OnLog := @Watcher.LogLine; Thread.Start; + { Остановка на полпути: так получается недописанный файл, с + которого потом просят продолжить. } + Waited := 0; + Stopped := False; while not Thread.Finished do + begin CheckSynchronize(100); + Waited := Waited + 0.1; + if (CancelAfter > 0) and (not Stopped) and (Waited >= CancelAfter) then + begin + Stopped := True; + WriteLn('[тест] запрашиваю остановку'); + Thread.RequestCancel; + end; + end; CheckSynchronize(0); Rep := Thread.Report; finally @@ -1506,6 +1674,23 @@ begin SecondsToStr(Rep.Segments[I].Duration), Rep.Segments[I].Packets])); WriteLn(' сумма пакетов кусков: ', Rep.ExpectedPackets); WriteLn(' пакетов в готовом файле: ', Rep.ActualPackets); + + { Сверка с монтажом: столько ли кадров, сколько он просил. Звук набран по + монтажу с точностью до отсчёта, поэтому лишний кадр картинки — это и + есть расхождение звука с картинкой. } + WantSum := 0; + for I := 0 to High(Rep.Segments) do + Inc(WantSum, Rep.Segments[I].WantFrames); + if WantSum > 0 then + begin + WriteLn(' картинка: ', Rep.ActualPackets, ' кадров, монтаж просил ', WantSum); + if Rep.ActualPackets = WantSum then + WriteLn(' ЗВУК И КАРТИНКА СХОДЯТСЯ') + else + WriteLn(' ЗВУК И КАРТИНКА РАСХОДЯТСЯ на ', + Rep.ActualPackets - WantSum, ' кадров'); + end; + WriteLn(' результат: ', Rep.Message); if not Rep.Succeeded then @@ -1544,6 +1729,8 @@ begin CmdFlatTest else if (Cmd = 'build') and (ParamCount >= 3) then CmdBuild + else if (Cmd = 'syncproj') and (ParamCount >= 3) then + CmdSyncProj else if (Cmd = 'keytest') and (ParamCount >= 4) then CmdKeyTest else if (Cmd = 'buildcut') and (ParamCount >= 3) then diff --git a/tests/progress/progtest.lpr b/tests/progress/progtest.lpr index 7706b25..4a96e76 100644 --- a/tests/progress/progtest.lpr +++ b/tests/progress/progtest.lpr @@ -99,6 +99,22 @@ begin end; Check('ход монотонный', V >= Prev); + { 7. Одна-единственная веха — и та конец. + + Так выглядит сборка одного куска: сделано ноль из одного. Полоса + ползёт к единице и раньше подбиралась к ней вплотную — заполненная + полоса у работы, которая ещё идёт, читается как зависшая программа. + Теперь догадка не закрывает промежуток целиком, и остаток виден. } + V := 0; + for I := 1 to 1000 do + V := AdvanceProgress(V, 0, 1, Step); + Check('без замеров полоса не доходит до края: ' + + FloatToStrF(V, ffFixed, 8, 3), V <= 0.91); + + { А как только приходит настоящий замер, полоса слушается его. } + V := AdvanceProgress(V, 0.95, 1, Step); + Check('настоящий замер перекрывает догадку', V >= 0.95); + WriteLn; if Failed = 0 then WriteLn('ВЕРДИКТ: все проверки пройдены') diff --git a/tests/syncprobe.sh b/tests/syncprobe.sh new file mode 100755 index 0000000..a1f7698 --- /dev/null +++ b/tests/syncprobe.sh @@ -0,0 +1,123 @@ +#!/bin/sh +# Замер расхождения звука и картинки в собранном ролике. +# +# Как меряется. Делается исходник с метками: ровно на каждой секунде в +# кадре белая вспышка, а в звуке щелчок. Из него собирается монтаж, у +# которого начала кусков заведомо не попадают на опорные кадры. В готовом +# ролике ищутся времена вспышек и времена щелчков; если звук и картинка +# сходятся, каждая вспышка совпадает со щелчком. +# +# Сравнение идёт с поправкой на сам способ измерения: щелчок в сжатом +# звуке размазывается на десяток-другой миллисекунд, и эта поправка +# берётся замером того же исходника. +# +# Запуск: tests/syncprobe.sh — весь прогон +# tests/syncprobe.sh measure ФАЙЛ — только замер готового файла + +set -e + +HERE=$(cd "$(dirname "$0")" && pwd) +ROOT=$(dirname "$HERE") +WORK="$ROOT/test/sync" +SRC="$WORK/метки.mp4" +PROJ="$WORK/синхро.nlve" +OUT="$WORK/синхро.mkv" + +# Времена вспышек: кадры, у которых средняя яркость выше порога. Берётся +# первый кадр каждой вспышки — она длится несколько кадров. +flashes() { + ffprobe -v error -f lavfi "movie=$1,signalstats" \ + -show_entries frame=pts_time:frame_tags=lavfi.signalstats.YAVG \ + -of csv=p=0 2>/dev/null | + awk -F, '$2>150 { if ($1 - prev > 0.5 || NR == 1) print $1; prev = $1 }' +} + +# Времена щелчков: по самим отсчётам, без оконного анализа. Оконный +# уплывает (окно двигается кратно своему размеру), и на замере это +# выглядит как накапливающийся рассинхрон, которого нет. +clicks() { + ffmpeg -v error -i "$1" -vn -ac 1 -ar 48000 -f s16le - | + python3 "$HERE/clicktimes.py" +} + +# Сводит два списка времён и печатает расхождение по каждой метке. +# +# Пара ищется по близости, а не по порядку: при резе не на опорном кадре +# в куске может оказаться лишняя вспышка без своего щелчка, и сравнение +# «первый с первым» после такого куска поехало бы всё. +compare() { + awk ' + FNR == NR { v[++nv] = $1; next } + { + a = $1; best = 1e9; + for (i = 1; i <= nv; i++) { + d = a - v[i]; ad = (d < 0) ? -d : d; + if (ad < best) { best = ad; bd = d } + } + { n++ } + { # Щелчок, у которого вспышки рядом нет вообще, — это край куска: + # метка попала в звук, а её кадр остался за резом. Такую пару + # считать нельзя, иначе итог перевирает сам себя. + if (best > 0.5) { skipped++; next } + } + printf " метка %2d: звук %8.3f ближайшая вспышка %+7.3f с\n", n, a, -bd; + paired++; + s += bd; if (best > worst) { worst = best; wi = n } + } + END { + if (paired == 0) { print " пар не нашлось"; exit 1 } + printf " ИТОГ: среднее расхождение %+.3f с, худшее %.3f с (метка %d)", + s / paired, worst, wi + if (skipped > 0) printf ", одиноких меток %d", skipped + printf "\n" + }' "$1" "$2" +} + +measure() { + FILE="$1" + flashes "$FILE" > "$WORK/вспышки.txt" + clicks "$FILE" > "$WORK/щелчки.txt" + echo " вспышек: $(wc -l < "$WORK/вспышки.txt"), щелчков: $(wc -l < "$WORK/щелчки.txt")" + compare "$WORK/вспышки.txt" "$WORK/щелчки.txt" +} + +if [ "$1" = "measure" ]; then + mkdir -p "$WORK" + measure "$2" + exit 0 +fi + +mkdir -p "$WORK" + +if [ ! -f "$SRC" ]; then + echo "=== Исходник с метками ===" + # Опорные кадры через две секунды: тогда рез почти всегда приходится на + # середину группы, как на настоящей съёмке с камеры. + ffmpeg -y -v error \ + -f lavfi -i "color=c=black:s=640x360:r=60000/1001:d=60" \ + -f lavfi -i "aevalsrc=sin(1000*2*PI*t)*lt(mod(t\,1)\,0.05):s=48000:c=stereo:d=60" \ + -vf "drawbox=x=0:y=0:w=640:h=360:color=white:t=fill:enable='lt(mod(t\,1)\,0.02)'" \ + -c:v libx264 -preset veryfast -g 120 -keyint_min 120 -sc_threshold 0 \ + -pix_fmt yuv420p -c:a aac -b:a 128k "$SRC" + echo "готово: $SRC" +fi + +echo "=== Поправка на способ измерения (сам исходник) ===" +measure "$SRC" + +echo "=== Монтаж с резами не на опорных кадрах ===" +"$HERE/nlvetool" syncproj "$PROJ" "$SRC" + +echo "=== Сборка ===" +rm -f "$OUT" +"$HERE/nlvetool" render "$PROJ" "$OUT" | tail -5 + +echo "=== Замер готового ролика ===" +measure "$OUT" + +echo "=== Длительности потоков готового ролика ===" +ffprobe -v error -select_streams v:0 -count_packets \ + -show_entries stream=r_frame_rate,nb_read_packets -of csv=p=0 "$OUT" | + awk -F, '{ split($1, r, "/"); printf " картинка: %s кадров = %.3f с\n", $2, $2 * r[2] / r[1] }' +ffprobe -v error -show_entries format=duration -of csv=p=0 "$OUT" | + awk -F, '{ printf " файл целиком: %.3f с\n", $2 }' diff --git a/tests/zoomanchor.py b/tests/zoomanchor.py new file mode 100755 index 0000000..1bcf126 --- /dev/null +++ b/tests/zoomanchor.py @@ -0,0 +1,107 @@ +#!/usr/bin/env python3 +"""Проверка того, что масштаб таймлайна берётся от точки под мышкой. + +Ctrl с колесом меняет масштаб. Точка монтажа, на которую смотрит мышь, +обязана остаться на месте: иначе прицелиться масштабом нельзя — картинка +уезжает из-под курсора. + +Как меряется. Курсор воспроизведения ставится в известное место и служит +меткой: он привязан ко времени, а не к пикселям, и при смене масштаба +едет вместе с монтажом. Зная, что один щелчок колеса меняет масштаб ровно +в 1.25 раза, неподвижную точку считаем по двум положениям метки: + + p1 - a = k * (p0 - a) => a = (k * p0 - p1) / (k - 1) + +Ошибку это не прячет: если опора уедет, a разойдётся с положением мыши. + +Запуск (редактор уже должен идти на невидимом экране :99): + tests/zoomanchor.py <окно> +где окно — из `DISPLAY=:99 xdotool search --name nlve`. +""" + +import os +import subprocess +import sys +import time + +from PIL import Image + +DISP = os.environ.get('ЭКРАН', ':99') +ENV = {'DISPLAY': DISP, 'PATH': '/usr/bin:/bin'} +# Один щелчок колеса. Должен совпадать с ZoomStep в uTimelineCtrl. +STEP = 1.25 +# Полоса окна, по которой всё и меряется: линейка и первая дорожка. +BAND = '1500x120+0+450' +SHOT = os.path.join(os.path.dirname(os.path.abspath(__file__)), + 'кадры-зума.png') + + +def run(*args): + subprocess.run(list(args), env=ENV, check=True) + + +def playhead(win): + """Где сейчас курсор воспроизведения. Он единственный красный.""" + run('import', '-window', win, '-crop', BAND, '+repage', SHOT) + im = Image.open(SHOT).convert('RGB') + px = im.load() + w, h = im.size + best = (0, None) + for x in range(10, w - 10): + red = sum(1 for y in range(h) + if px[x, y][0] > 120 + and px[x, y][0] - px[x, y][1] > 40 + and px[x, y][0] - px[x, y][2] > 40) + if red > best[0]: + best = (red, x) + return best[1] if best[0] > 60 else None + + +def measure(win, mouse_x): + before = playhead(win) + run('xdotool', 'mousemove', str(mouse_x), '520') + time.sleep(0.4) + run('xdotool', 'keydown', 'ctrl', 'click', '4', 'keyup', 'ctrl') + time.sleep(0.9) + after = playhead(win) + run('xdotool', 'keydown', 'ctrl', 'click', '5', 'keyup', 'ctrl') + time.sleep(0.9) + if before is None or after is None: + return None + return (STEP * before - after) / (STEP - 1) + + +def main(): + if len(sys.argv) < 2: + print(__doc__) + return 2 + win = sys.argv[1] + + # Метку ставим щелчком по пустому месту под дорожками. + run('xdotool', 'mousemove', '900', '600', 'click', '1') + time.sleep(0.8) + + bad = 0 + for mouse_x in (700, 1000, 1300): + anchor = measure(win, mouse_x) + if anchor is None: + print('мышь %4d: метку не видно, замер не вышел' % mouse_x) + bad += 1 + continue + off = anchor - mouse_x + ok = abs(off) <= 2 + print('мышь %4d: опора %6.0f, промах %+.0f точек — %s' + % (mouse_x, anchor, off, 'ok' if ok else 'ПЛОХО')) + if not ok: + bad += 1 + + print() + if bad: + print('ВЕРДИКТ: масштаб берётся не от мыши, случаев: %d' % bad) + return 1 + print('ВЕРДИКТ: точка под мышкой остаётся на месте') + return 0 + + +if __name__ == '__main__': + sys.exit(main()) diff --git a/tools/make_icons.py b/tools/make_icons.py index 7ccf0a8..a26d691 100644 --- a/tools/make_icons.py +++ b/tools/make_icons.py @@ -31,6 +31,8 @@ ICONS = [ ('Log', 'icons8-property-30.png', 24), ('Glue', 'icons8-клей-30.png', 24), ('Target', 'icons8-цель-30.png', 24), + ('SelectClips', 'icons8-select-all-90.png', 24), + ('SelectRange', 'icons8-width-90.png', 24), ] # Значок самой программы: отдельно, потому что окну нужен формат ico —